From 5de52ec2b0f0521e121d73dc78a6663bab51b7d6 Mon Sep 17 00:00:00 2001 From: = <=> Date: Tue, 24 Mar 2026 14:13:53 -0400 Subject: [PATCH 01/18] FDS Source: WIP refactor of cut-cell grid setup. --- Source/ccib.f90 | 3 +- Source/geom.f90 | 2170 ++++++++++++++--------------------------------- Source/init.f90 | 2 +- Source/mesh.f90 | 2 + Source/part.f90 | 5 +- 5 files changed, 625 insertions(+), 1557 deletions(-) diff --git a/Source/ccib.f90 b/Source/ccib.f90 index eafbe5b069e..67db9d0e82c 100644 --- a/Source/ccib.f90 +++ b/Source/ccib.f90 @@ -6,7 +6,8 @@ ! MODULE CC_SCALARS -USE COMPLEX_GEOMETRY +USE COMPLEX_GEOMETRY, SET_CUTCELLS_3D_FROM_GEOM => SET_CUTCELLS_3D +USE COMPLEX_GEOMETRY_GRID, ONLY: SET_CUTCELLS_3D USE PRECISION_PARAMETERS USE GLOBAL_CONSTANTS USE MESH_POINTERS diff --git a/Source/geom.f90 b/Source/geom.f90 index db30b109da9..80ea58a6bab 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -314,7 +314,7 @@ MODULE COMPLEX_GEOMETRY PUBLIC :: BLOCK_CC_SOLID_EXTWALLCELLS,GEOFCT,CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,CCGUARD,CC_MATVEC_DEFINED,GEOMEPS,& DELTA_INT,DELTA_VERT,DEBUG_SET_CUTCELLS,DEBUG_WAIT,DIST_THRES,& - GET_CARTCELL_CUTCELLS_TIME_INDEX,GET_CFACE_INDEX,GETU,& + GET_CARTCELL_CUTCELLS_TIME_INDEX,GET_CFACE_INDEX,& INTERSECT_CONE_AABB,INTERSECT_CYLINDER_AABB,INTERSECT_OBB_AABB,INTERSECT_SPHERE_AABB, & POINT_IN_CFACE,RANDOM_CFACE_XYZ,& READ_GEOM,ROTATION_MATRIX, & @@ -731,7 +731,6 @@ SUBROUTINE SET_CUTCELLS_3D INTEGER, DIMENSION(MAX_DIM) :: INDX1 REAL(EB) :: X1PLN, X3RAY LOGICAL :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY -LOGICAL, SAVE :: FIRST_CALL = .TRUE. INTEGER :: NCUTFACE_IAXIS, NCUTFACE_JAXIS, NCUTFACE_KAXIS, ICE1, ICF1, NFACE, IERR, & NCUTEDGE_IBCC, NCUTEDGE_IBCF REAL(EB):: CF_AREA_IAXIS=0._EB, CF_AREA_JAXIS=0._EB, CF_AREA_KAXIS=0._EB, & @@ -770,6 +769,7 @@ SUBROUTINE SET_CUTCELLS_3D REAL(EB) :: TNOW LOGICAL :: WRITE_CFACE_STATS = .FALSE. +LOGICAL :: EARLY_RETURN_FROM_SET_CUTCELLS INTEGER, SAVE :: CALL_COUNT = 0 @@ -792,6 +792,56 @@ SUBROUTINE SET_CUTCELLS_3D INTEGER :: ING,INOD,IWSEL,IEL,FACE_AUX(NOD1:NOD3),VOL_AUX(NOD1:NOD4),N_SPCELLCF_TOT,N_SPCELL_TOT CHARACTER(100) :: FILENAME +CALL CC_GRID_GLOBAL_INIT +IF (STOP_STATUS==SETUP_STOP) RETURN + +CALL CC_GRID_ALLOCATE_BUILD_SCRATCH + +! Main Loop over Meshes: +MAIN_MESH_LOOP : DO NM=1,NMESHES + CALL CC_GRID_BUILD_CUTCELL_MESH(NM) + IF (STOP_STATUS==SETUP_STOP) RETURN +ENDDO MAIN_MESH_LOOP + +CALL CC_GRID_RELEASE_BUILD_SCRATCH + +POSTBUILD_MESH_LOOP : DO NM=1,NMESHES + CALL CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) + IF (STOP_STATUS==SETUP_STOP) RETURN +ENDDO POSTBUILD_MESH_LOOP + +CALL CC_GRID_EXCHANGE_AND_REBLOCK + +MAIN_MESH_LOOP_3 : DO NM=1,NMESHES + CALL CC_GRID_POSTPROCESS_AND_CLEANUP(NM) +ENDDO MAIN_MESH_LOOP_3 + +! Finally allocate Face and cell variables, compute area and volume factors: +MAIN_MESH_LOOP_4 : DO NM=1,NMESHES + CALL CC_GRID_ALLOCATE_STATE_VARS(NM) +ENDDO MAIN_MESH_LOOP_4 + +CALL CC_GRID_LOG_PROCESSING_TIME + +CALL CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST + +! Fill Guardcells for CCVAR CC_CGSC and CUT_CELL for meshes assigned to MPI process: +CALL SET_GC_CUTCELLS_3D + +! Allocate and define entries for solid side CFACES: +IF(PERIODIC_TEST/=105) CALL GET_EXT_INB_CUTFACES_TO_CFACE + +CALL CC_GRID_FINALIZE_BOOKKEEPING(EARLY_RETURN_FROM_SET_CUTCELLS) +IF (EARLY_RETURN_FROM_SET_CUTCELLS) RETURN + +CALL CC_GRID_WRITE_VERBOSE_SUMMARY + +RETURN + +CONTAINS + +SUBROUTINE CC_GRID_GLOBAL_INIT + IF (MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN WRITE(LU_ERR,*) ' ' WRITE(LU_ERR,*) 'SET_CUTCELLS_3D : Cut-Cell computation in VERBOSE mode, 4 tasks to perform:' @@ -803,22 +853,17 @@ SUBROUTINE SET_CUTCELLS_3D CC_NCUTFACE = 0 CC_NCUTCELL = 0 -IF (FIRST_CALL) THEN - - ! Check Meshes Boundaries match, requirement to get consistent ghost and internal cut-cells. - CALL CHECK_WALL_CELL_PLANE_MATCH; IF (STOP_STATUS==SETUP_STOP) RETURN - - ! Get geometry triangle bins in Cartesian directions: - CALL GET_GEOM_TRIBIN +! Check Meshes Boundaries match, requirement to get consistent ghost and internal cut-cells. +CALL CHECK_WALL_CELL_PLANE_MATCH; IF (STOP_STATUS==SETUP_STOP) RETURN - ! Snap to grid planes node positions in the work volume of this process: - CALL SNAP_GEOM_NODES +! Get geometry triangle bins in Cartesian directions: +CALL GET_GEOM_TRIBIN - ! Initialize GEOMETRY fields used by CC_IBM: - CALL CC_INIT_GEOM; IF (STOP_STATUS==SETUP_STOP) RETURN - FIRST_CALL = .FALSE. +! Snap to grid planes node positions in the work volume of this process: +CALL SNAP_GEOM_NODES -ENDIF +! Initialize GEOMETRY fields used by CC_IBM: +CALL CC_INIT_GEOM; IF (STOP_STATUS==SETUP_STOP) RETURN TNOW=CURRENT_TIME() @@ -1005,110 +1050,60 @@ SUBROUTINE SET_CUTCELLS_3D CALL CPU_TIME(CPUTIME_START_MESH) ENDIF +IF(N_GEOMETRY>0) THEN + ALLOCATE(GEOM_AREA_SURF_OLD(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_OLD=0._EB + ALLOCATE(GEOM_AREA_SURF_NEW(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_NEW=0._EB +ENDIF + +END SUBROUTINE CC_GRID_GLOBAL_INIT + +SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH + ! Allocate BODINT_PLANE for plane intersections on X1AXIS loop: IF(PERIODIC_TEST/=7 .AND. PERIODIC_TEST/=11) THEN - CALL ALLOC_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) ! To be used in SET_CUTCELLS_3D, GET_CARTCELL_CUTFACES. - CALL ALLOC_BODINT_PLANE(BODINT_PLANE2,FIRST_CALL_ARG2) ! To be used in GET_IS_SOLID_3D. + CALL ALLOCATE_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) ! To be used in SET_CUTCELLS_3D, GET_CARTCELL_CUTFACES. + CALL ALLOCATE_BODINT_PLANE(BODINT_PLANE2,FIRST_CALL_ARG2) ! To be used in GET_IS_SOLID_3D. ENDIF ! Allocate Intersection variables: ALLOCATE(CC_SVAR_CRS(CC_MAXCROSS_X2),CC_IS_CRS(CC_MAXCROSS_X2),CC_SEG_CRS(CC_MAXCROSS_X2)) ALLOCATE(CC_BDNUM_CRS(0:CC_MAXCROSS_X2),CC_BDNUM_CRS_AUX(0:CC_MAXCROSS_X2)) ALLOCATE(CC_IS_CRS2(LOW_IND:HIGH_IND+1,CC_MAXCROSS_X2),CC_SEG_TAN(IAXIS:JAXIS,CC_MAXCROSS_X2)) -IF(N_GEOMETRY>0) THEN - ALLOCATE(GEOM_AREA_SURF_OLD(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_OLD=0._EB - ALLOCATE(GEOM_AREA_SURF_NEW(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_NEW=0._EB -ENDIF -! Main Loop over Meshes: -MAIN_MESH_LOOP : DO NM=1,NMESHES - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 - - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - ! Mesh sizes: - NXB=IBAR - NYB=JBAR - NZB=KBAR +END SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) +SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH - ! Initialize CC_IBM arrays for mesh NM: - ! Vertices: - IF (.NOT. ALLOCATED(MESHES(NM)%VERTVAR)) & - ALLOCATE(MESHES(NM)%VERTVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NVVARS)) - MESHES(NM)%VERTVAR = 0 - MESHES(NM)%VERTVAR(:,:,:,CC_VGSC) = CC_GASPHASE - - ! Cartesian Edges: - IF (.NOT. ALLOCATED(MESHES(NM)%ECVAR)) & - ALLOCATE(MESHES(NM)%ECVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NEVARS,MAX_DIM)) - MESHES(NM)%ECVAR = 0 - MESHES(NM)%ECVAR(:,:,:,CC_EGSC,:) = CC_GASPHASE - - ! Cartesian Faces: - IF (.NOT. ALLOCATED(MESHES(NM)%FCVAR)) & - ALLOCATE(MESHES(NM)%FCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NFVARS,MAX_DIM)) - MESHES(NM)%FCVAR = 0 - MESHES(NM)%FCVAR(:,:,:,CC_FGSC,:) = CC_GASPHASE - - ! Cartesian cells: - IF (.NOT. ALLOCATED(MESHES(NM)%CCVAR)) & - ALLOCATE(MESHES(NM)%CCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NCVARS)) - MESHES(NM)%CCVAR = 0 - MESHES(NM)%CCVAR(:,:,:,CC_CGSC) = CC_GASPHASE - - ! When TERRAIN_CASE = TRUE, allocate GEOM_ZMAX for the mesh: - IF (TERRAIN_CASE) THEN - ALLOCATE(GEOM_ZMAX_AUX(ISTR:IEND,JSTR:JEND)); GEOM_ZMAX_AUX = -1._EB/GEOMEPS - ENDIF +CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE) +CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE2) - ! Write Mesh number allocation if GET_CUTCELLS_VERBOSE: - IF(GET_CUTCELLS_VERBOSE) THEN - WRITE(LU_SETCC,'(A)') ' ' - WRITE(LU_SETCC,'(A,I5,A,I10)') ' Processing Mesh : ',NM - IF(MY_RANK==0) THEN - WRITE(LU_ERR,'(A)') ' ' - WRITE(LU_ERR,'(A,I5,A,I10)') ' Processing Mesh : ',NM - ENDIF - ENDIF +! Deallocate Intersection variables: +DEALLOCATE(CC_SVAR_CRS,CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX,CC_IS_CRS2,CC_SEG_TAN) - ! Here we have to allocate the size of MESHES(NM)%EDGE_CROSS: - MESHES(NM)%N_EDGE_CROSS = 0 ! Reset EDCROSS counter for mesh NM. - IF (ALLOCATED(MESHES(NM)%EDGE_CROSS)) DEALLOCATE(MESHES(NM)%EDGE_CROSS) - ALLOCATE( MESHES(NM)%EDGE_CROSS( GLOBAL_DELTA_EDGE ) ) +END SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH - ! Here we have to allocate the size of MESHES(NM)%CUT_EDGE: - MESHES(NM)%N_CUTEDGE_MESH = 0 ! Reset CUTEDGE counter for mesh NM. - IF (ALLOCATED(MESHES(NM)%CUT_EDGE)) DEALLOCATE(MESHES(NM)%CUT_EDGE) - ALLOCATE( MESHES(NM)%CUT_EDGE( GLOBAL_DELTA_EDGE ) ) +SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH(NM) - ! Here we have to allocate the size of MESHES(NM)%CUT_FACE: - MESHES(NM)%N_CUTFACE_MESH = 0 ! Reset CUTFACE counter for mesh NM. - MESHES(NM)%N_BBCUTFACE_MESH = 0; MESHES(NM)%N_GCCUTFACE_MESH = 0 - IF (ALLOCATED(MESHES(NM)%CUT_FACE)) DEALLOCATE(MESHES(NM)%CUT_FACE) - ALLOCATE( MESHES(NM)%CUT_FACE( GLOBAL_DELTA_FACE ) ) +INTEGER, INTENT(IN) :: NM - ! Here we have to allocate the size of MESHES(NM)%CUT_CELL: - MESHES(NM)%N_CUTCELL_MESH = 0 ! Reset CUTCELL counter for mesh NM. - MESHES(NM)%N_GCCUTCELL_MESH = 0 - IF (ALLOCATED(MESHES(NM)%CUT_CELL)) DEALLOCATE(MESHES(NM)%CUT_CELL) - ALLOCATE( MESHES(NM)%CUT_CELL( GLOBAL_DELTA_CELL ) ) +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 - ! Allocate array for special cells containing geometry intersections: - ALLOCATE(CELLRT(ISTR:IEND,JSTR:JEND,KSTR:KEND)); CELLRT(:,:,:)=.FALSE. +CALL POINT_TO_MESH(NM) +M => MESHES(NM) +! Mesh sizes: +NXB=IBAR +NYB=JBAR +NZB=KBAR - ! List of special cells to block (either from GET_CARTCELL_CUTCELLS or - ! cells flagged as polyline could not be built in GET_CARTCELL_CUTFACES): - ALLOCATE(SPCELLS_TO_BLOCK(1:GLOBAL_DELTA_CELL)) - N_SPCELLS_TO_BLOCK = 0 +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) +CALL CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) - REGCC_REGION_IF : IF(PERIODIC_TEST==7 .OR. PERIODIC_TEST==11) THEN +REGCC_REGION_IF : IF(PERIODIC_TEST==7 .OR. PERIODIC_TEST==11) THEN CALL GET_REGULAR_CUTCELLS_BOX - ELSE +ELSE ! Do Loop for different x1 planes: X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS @@ -1372,131 +1367,120 @@ SUBROUTINE SET_CUTCELLS_3D MESHES(NM)%N_SPCELL_CF = MESHES(NM)%N_SPCELL CALL GET_CARTCELL_CUTCELLS(NM) - ENDIF REGCC_REGION_IF +ENDIF REGCC_REGION_IF - ! Case of terrain, populate GEOM_ZMAX: - IF (TERRAIN_CASE) THEN - IF(ALLOCATED(MESHES(NM)%GEOM_ZMAX)) DEALLOCATE(MESHES(NM)%GEOM_ZMAX) - ALLOCATE(MESHES(NM)%GEOM_ZMAX(0:IBAR,0:JBAR)) - DO J=0,JBAR - DO I=0,IBAR - ! Clip at ZS-DZ(1): - MESHES(NM)%GEOM_ZMAX(I,J) = MAX(ZFACE(-1),GEOM_ZMAX_AUX(I,J)) - ENDDO - ENDDO - DEALLOCATE(GEOM_ZMAX_AUX) - ENDIF +CALL CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) +CALL CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +IF (ALLOCATED(CELLRT)) DEALLOCATE(CELLRT) +END SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH - ! Block SPCELLS, cells in cut-cell region where cut-cells could not be built: - DO ICC=1,N_SPCELLS_TO_BLOCK - I=MESHES(NM)%SPCELL_LIST(IAXIS,SPCELLS_TO_BLOCK(ICC)) - J=MESHES(NM)%SPCELL_LIST(JAXIS,SPCELLS_TO_BLOCK(ICC)) - K=MESHES(NM)%SPCELL_LIST(KAXIS,SPCELLS_TO_BLOCK(ICC)) - ICC1=MESHES(NM)%CCVAR(I,J,K,CC_IDCC) - IF(ICC1 > 0) THEN - CC=>MESHES(NM)%CUT_CELL(ICC1) - CC%NOADVANCE(1:CC%NCELL) = BLOCKED_SPECIAL_CELL - ENDIF - ENDDO +SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) +INTEGER, INTENT(IN) :: NM - IF (ONE_CC_PER_CARTESIAN_CELL) THEN - ! Here Block all cells that have volume less (or equal) than the first largest cell found. - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%CUT_CELL(ICC1) - NCELL=0 - DO J=1,CC%NCELL - IF(CC%NOADVANCE(J)==NOT_BLOCKED) NCELL=NCELL+1 - ENDDO - IF(NCELL<2) CYCLE - ! Find if any GEOMETRY related to CC_INBOUNDARY faces has CELL_BLOCK_IOR>0: - CELL_BLOCK_IOR=0; CELL_BLOCK_ORIENTATION = 0._EB - NCELL_LOOP_1 : DO J=1,CC%NCELL - DO I=2,CC%CCELEM(1,J)+1 - IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN - ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) - IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) - IF(IG>0) THEN - IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN - CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION - ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN - CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR - EXIT NCELL_LOOP_1 - ENDIF +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 + +CALL POINT_TO_MESH(NM) +M => MESHES(NM) +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + +CALL CC_GRID_BLOCK_SPECIAL_CELLS(NM) +CALL CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) + +IF (ONE_CC_PER_CARTESIAN_CELL) THEN + ! Here Block all cells that have volume less (or equal) than the first largest cell found. + DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + CC=>MESHES(NM)%CUT_CELL(ICC1) + NCELL=0 + DO J=1,CC%NCELL + IF(CC%NOADVANCE(J)==NOT_BLOCKED) NCELL=NCELL+1 + ENDDO + IF(NCELL<2) CYCLE + ! Find if any GEOMETRY related to CC_INBOUNDARY faces has CELL_BLOCK_IOR>0: + CELL_BLOCK_IOR=0; CELL_BLOCK_ORIENTATION = 0._EB + NCELL_LOOP_1 : DO J=1,CC%NCELL + DO I=2,CC%CCELEM(1,J)+1 + IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN + ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) + IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) + IF(IG>0) THEN + IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN + CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION + ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN + CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR + EXIT NCELL_LOOP_1 ENDIF ENDIF - ENDDO - ENDDO NCELL_LOOP_1 - ALLOCATE(VOLUME(1:CC%NCELL)); VOLUME(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) + ENDIF + ENDDO + ENDDO NCELL_LOOP_1 + ALLOCATE(VOLUME(1:CC%NCELL)); VOLUME(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN + ! Cell Block Orientation: + DO J=1,CC%NCELL; VOLUME(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)); ENDDO DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN - ! Cell Block Orientation: - DO J=1,CC%NCELL; VOLUME(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)); ENDDO - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN - ! Make search for double precision min/max unambiguous. - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS,IAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) - CASE(-JAXIS,JAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) - CASE(-KAXIS,KAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) - END SELECT - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( IAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-JAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( JAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-KAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( KAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - END SELECT - ENDIF - DEALLOCATE(VOLUME) - NCELL_LOOP_2 : DO J=1,CC%NCELL - IF(J==I) CYCLE NCELL_LOOP_2 - IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL - ENDDO NCELL_LOOP_2 - ENDDO - ENDIF + I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN + ! Make search for double precision min/max unambiguous. + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS,IAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) + CASE(-JAXIS,JAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) + CASE(-KAXIS,KAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) + END SELECT + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( IAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE(-JAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( JAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE(-KAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( KAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + END SELECT + ENDIF + DEALLOCATE(VOLUME) + NCELL_LOOP_2 : DO J=1,CC%NCELL + IF(J==I) CYCLE NCELL_LOOP_2 + IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL + ENDDO NCELL_LOOP_2 + ENDDO +ENDIF - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) +CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) - ! Here: 1,2. Define Linking information for cut-cells. - CALL GET_CELL_LINK_INFO(NM) +! Here: 1,2. Define Linking information for cut-cells. +CALL GET_CELL_LINK_INFO(NM) - IF(PROCESS(NM)==MY_RANK) THEN ! Here Add Blocked Areas per SURF_ID: - ALLOCATE(MESHES(NM)%INBCF_AREA(0:MESHES(NM)%IBP1,0:MESHES(NM)%JBP1,0:MESHES(NM)%KBP1)) - DO K=1,M%KBAR - DO J=1,M%JBAR - DO I=1,M%IBAR - ICC = MESHES(NM)%CCVAR(I,J,K,CC_IDCC); IF(ICC<1) CYCLE - CC =>MESHES(NM)%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)<1) CYCLE - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE=CC%CCELEM(IFC,JCC) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE - ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) - ENDDO +IF(PROCESS(NM)==MY_RANK) THEN ! Here Add Blocked Areas per SURF_ID: + ALLOCATE(MESHES(NM)%INBCF_AREA(0:MESHES(NM)%IBP1,0:MESHES(NM)%JBP1,0:MESHES(NM)%KBP1)) + DO K=1,M%KBAR + DO J=1,M%JBAR + DO I=1,M%IBAR + ICC = MESHES(NM)%CCVAR(I,J,K,CC_IDCC); IF(ICC<1) CYCLE + CC =>MESHES(NM)%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + IF(CC%NOADVANCE(JCC)<1) CYCLE + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE=CC%CCELEM(IFC,JCC) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) ENDDO ENDDO ENDDO ENDDO - ENDIF - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) - IF (ALLOCATED(CELLRT)) DEALLOCATE(CELLRT) - IF (ALLOCATED(SPCELLS_TO_BLOCK)) DEALLOCATE(SPCELLS_TO_BLOCK) -ENDDO MAIN_MESH_LOOP + ENDDO +ENDIF +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE) -CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE2) +END SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH -! Deallocate Intersection variables: -DEALLOCATE(CC_SVAR_CRS,CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX,CC_IS_CRS2,CC_SEG_TAN) +SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK DO IDIM=1,MAX_DIM @@ -1554,25 +1538,7 @@ SUBROUTINE SET_CUTCELLS_3D ENDDO -! WRITE A file per process and mesh with the NOADVANCE cut-cells: -! DO NM=1,NMESHES -! M => MESHES(NM) -! IF(N_MPI_PROCESSES>1) THEN -! WRITE(VERBOSE_FILE,'(A,A,I0,A,I0,A)') TRIM(CHID),'_NOADVANCE_',MY_RANK,'_',NM,'.2log' -! ELSE -! WRITE(VERBOSE_FILE,'(A,A,I0,A,I0,A)') TRIM(CHID),'_NOADVANCE_',MY_RANK,'_',NM,'.1log' -! ENDIF -! OPEN(UNIT=787,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') -! DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH -! CC=>M%CUT_CELL(ICC) -! DO JCC=1,CC%NCELL -! IF(CC%NOADVANCE(JCC)>0) WRITE(787,*) 'B',NM,';',ICC,JCC,CC%IJK(IAXIS:KAXIS),CC%NCELL -! ENDDO -! ENDDO -! CLOSE(787) -! ENDDO - -MAIN_MESH_LOOP_3 : DO NM=1,NMESHES +FINAL_BLOCK_MESH_LOOP : DO NM=1,NMESHES IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 @@ -1593,176 +1559,187 @@ SUBROUTINE SET_CUTCELLS_3D CALL GET_CELL_LINK_INFO(NM) ENDIF - ! Here Add Areas per SURF_ID: - IF (PROCESS(NM)==MY_RANK) THEN - DO ICF=1,M%N_CUTFACE_MESH - CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE - DO J=1,CF%NFACE - IF(.NOT.CF%BLK_TAG(J)) CYCLE - GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & - GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) - ENDDO + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +ENDDO FINAL_BLOCK_MESH_LOOP + +END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK + +SUBROUTINE CC_GRID_POSTPROCESS_AND_CLEANUP(NM) + +INTEGER, INTENT(IN) :: NM + +CALL CC_GRID_RELEASE_BLOCKED_CELL_LISTS(NM) + +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 + +CALL POINT_TO_MESH(NM) +M => MESHES(NM) + +! Here Add Areas per SURF_ID: +IF (PROCESS(NM)==MY_RANK) THEN + DO ICF=1,M%N_CUTFACE_MESH + CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE + DO J=1,CF%NFACE + IF(.NOT.CF%BLK_TAG(J)) CYCLE + GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & + GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) ENDDO - ENDIF - ! Deallocate arrays: - IF (GET_CUTCELLS_VERBOSE) THEN - IF(M%N_CUTCELL_MESH > 0) THEN - MIN_FACES_PER_CUTCELL = 1000000 !HUGE(MIN_FACES_PER_CUTCELL) - MAX_FACES_PER_CUTCELL = 0 - MEAN_FACES_PER_CUTCELL= 0 - SUM_FACE = 0 - SUM_CCELL= 0 - DO ICC1=1,M%N_CUTCELL_MESH - IF (M%CUT_CELL(ICC1)%NCELL==0) CYCLE - SUM_CCELL = SUM_CCELL + M%CUT_CELL(ICC1)%NCELL - DO ICC2=1,M%CUT_CELL(ICC1)%NCELL - MAX_FACES_PER_CUTCELL = MAX(MAX_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) - MIN_FACES_PER_CUTCELL = MIN(MIN_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) - SUM_FACE = SUM_FACE + M%CUT_CELL(ICC1)%CCELEM(1,ICC2) - ENDDO + ENDDO +ENDIF +! Deallocate arrays: +IF (GET_CUTCELLS_VERBOSE) THEN + IF(M%N_CUTCELL_MESH > 0) THEN + MIN_FACES_PER_CUTCELL = 1000000 !HUGE(MIN_FACES_PER_CUTCELL) + MAX_FACES_PER_CUTCELL = 0 + MEAN_FACES_PER_CUTCELL= 0 + SUM_FACE = 0 + SUM_CCELL= 0 + DO ICC1=1,M%N_CUTCELL_MESH + IF (M%CUT_CELL(ICC1)%NCELL==0) CYCLE + SUM_CCELL = SUM_CCELL + M%CUT_CELL(ICC1)%NCELL + DO ICC2=1,M%CUT_CELL(ICC1)%NCELL + MAX_FACES_PER_CUTCELL = MAX(MAX_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) + MIN_FACES_PER_CUTCELL = MIN(MIN_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) + SUM_FACE = SUM_FACE + M%CUT_CELL(ICC1)%CCELEM(1,ICC2) ENDDO - IF(SUM_CCELL > TWENTY_EPSILON_EB) MEAN_FACES_PER_CUTCELL = SUM_FACE / SUM_CCELL - ! Write to file: - WRITE(LU_SETCC,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& + ENDDO + IF(SUM_CCELL > TWENTY_EPSILON_EB) MEAN_FACES_PER_CUTCELL = SUM_FACE / SUM_CCELL + ! Write to file: + WRITE(LU_SETCC,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& + MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL + IF (MEAN_FACES_PER_CUTCELL > 30) THEN + WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN + WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ENDIF + ! Write to ERR file: + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL IF (MEAN_FACES_PER_CUTCELL > 30) THEN - WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' + WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN - WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' + WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' ENDIF - ! Write to ERR file: - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& - MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL - IF (MEAN_FACES_PER_CUTCELL > 30) THEN - WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN - WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ENDIF - ENDIF - ENDIF - WRITE(LU_SETCC,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' - WRITE(LU_SETCC,'(A)') ' ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' - WRITE(LU_ERR ,'(A)') ' ' ENDIF ENDIF - - ! Here we have to deallocate if no geometric entities were defined: - ! EDGE_CROSS is deallocated: - IF (ALLOCATED(M%EDGE_CROSS)) DEALLOCATE(M%EDGE_CROSS) - IF (M%N_CUTEDGE_MESH == 0 .OR. PROCESS(NM)/=MY_RANK) THEN - IF (ALLOCATED(M%CUT_EDGE)) DEALLOCATE(M%CUT_EDGE) - ENDIF - IF (M%N_CUTFACE_MESH+M%N_BBCUTFACE_MESH+M%N_GCCUTFACE_MESH == 0) THEN - IF (ALLOCATED(M%CUT_FACE)) DEALLOCATE(M%CUT_FACE) - ENDIF - IF(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH == 0) THEN - IF (ALLOCATED(M%CUT_CELL)) DEALLOCATE(M%CUT_CELL) + WRITE(LU_SETCC,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' + WRITE(LU_SETCC,'(A)') ' ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' + WRITE(LU_ERR ,'(A)') ' ' ENDIF +ENDIF - ! Sanity tests on cut-faces, cut-cells: - IF (DEBUG_SET_CUTCELLS) THEN - CUTFACE_TEST_LOOP : DO ICF=1,M%N_CUTFACE_MESH - NFACE = M%CUT_FACE(ICF)%NFACE - I = M%CUT_FACE(ICF)%IJK(IAXIS) - J = M%CUT_FACE(ICF)%IJK(JAXIS) - K = M%CUT_FACE(ICF)%IJK(KAXIS) - X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) - DO I=1,NFACE - IF(M%CUT_FACE(ICF)%AREA(I) MESHES(NM) +INTEGER, INTENT(IN) :: NM - DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CF => M%CUT_FACE(ICF); IF(CF%NFACE==0) CYCLE - ICF1=3 ! BLOCK boundary flag, when == 1,2. - IF (CF%STATUS == CC_GASPHASE) THEN - I = CF%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE - J = CF%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE - K = CF%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE - SELECT CASE(CF%IJK(KAXIS+1)) ! X1AXIS - CASE(IAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DY(J)*DZ(K)); IF(I==0 .OR. I==M%IBAR) ICF1=1 - CASE(JAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DZ(K)*DX(I)); IF(J==0 .OR. J==M%JBAR) ICF1=1 - CASE(KAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DX(I)*DY(J)); IF(K==0 .OR. K==M%KBAR) ICF1=1 - END SELECT - ENDIF - CALL ALLOC_FACE_STATE_VARS(NM,ICF,CF%NFACE,ICF1) - ENDDO +MESHES(NM)%N_CC_BLOCKED = 0 +IF(ALLOCATED(MESHES(NM)%XYZ_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED) +IF(ALLOCATED(MESHES(NM)%JBT_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%JBT_CC_BLOCKED) - DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC); IF(CC%NCELL==0) CYCLE - I = CC%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE - J = CC%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE - K = CC%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE - CC%ALPHA_CC = SUM(CC%VOLUME(1:CC%NCELL))/(DX(I)*DY(J)*DZ(K)) - CALL ALLOC_CELL_STATE_VARS(NM,ICC,CC%NCELL) - ENDDO +END SUBROUTINE CC_GRID_RELEASE_BLOCKED_CELL_LISTS - ! Allocate array of indexes of chemically active cut-cells - SUM_CC = 0 - DO ICC=1,M%N_CUTCELL_MESH - SUM_CC = SUM_CC + CC%NCELL - ENDDO - ALLOCATE(M%CHEM_ACTIVE_CC(SUM_CC,3)) - M%CHEM_ACTIVE_CC=-1 +SUBROUTINE CC_GRID_ALLOCATE_STATE_VARS(NM) -ENDDO MAIN_MESH_LOOP_4 +INTEGER, INTENT(IN) :: NM -! Add to SET_CUTCELLS_3D loop time: -T_CC_USED(SET_CUTCELLS_TIME_INDEX) = T_CC_USED(SET_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 +CALL POINT_TO_MESH(NM) +M => MESHES(NM) -IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_MESH) - WRITE(LU_SETCC,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' - WRITE(LU_SETCC,'(A)') ' ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' - WRITE(LU_ERR,'(A)') ' ' +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + CF => M%CUT_FACE(ICF); IF(CF%NFACE==0) CYCLE + ICF1=3 ! BLOCK boundary flag, when == 1,2. + IF (CF%STATUS == CC_GASPHASE) THEN + I = CF%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE + J = CF%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE + K = CF%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE + SELECT CASE(CF%IJK(KAXIS+1)) ! X1AXIS + CASE(IAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DY(J)*DZ(K)); IF(I==0 .OR. I==M%IBAR) ICF1=1 + CASE(JAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DZ(K)*DX(I)); IF(J==0 .OR. J==M%JBAR) ICF1=1 + CASE(KAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DX(I)*DY(J)); IF(K==0 .OR. K==M%KBAR) ICF1=1 + END SELECT ENDIF -ENDIF + CALL ALLOC_FACE_STATE_VARS(NM,ICF,CF%NFACE,ICF1) +ENDDO + +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC => M%CUT_CELL(ICC); IF(CC%NCELL==0) CYCLE + I = CC%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE + J = CC%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE + K = CC%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE + CC%ALPHA_CC = SUM(CC%VOLUME(1:CC%NCELL))/(DX(I)*DY(J)*DZ(K)) + CALL ALLOC_CELL_STATE_VARS(NM,ICC,CC%NCELL) +ENDDO + +! Allocate array of indexes of chemically active cut-cells +SUM_CC = 0 +DO ICC=1,M%N_CUTCELL_MESH + SUM_CC = SUM_CC + CC%NCELL +ENDDO +ALLOCATE(M%CHEM_ACTIVE_CC(SUM_CC,3)) +M%CHEM_ACTIVE_CC=-1 + +END SUBROUTINE CC_GRID_ALLOCATE_STATE_VARS + +SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST ! ALL REDUCE areas per surface: IF(N_GEOMETRY>0) THEN @@ -1808,11 +1785,30 @@ SUBROUTINE SET_CUTCELLS_3D ! ENDDO IF(ALLOCATED(GEOM_AREA_SURF_OLD)) DEALLOCATE(GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) -! Fill Guardcells for CCVAR CC_CGSC and CUT_CELL for meshes assigned to MPI process: -CALL SET_GC_CUTCELLS_3D +END SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST -! Allocate and define entries for solid side CFACES: -IF(PERIODIC_TEST/=105) CALL GET_EXT_INB_CUTFACES_TO_CFACE +SUBROUTINE CC_GRID_LOG_PROCESSING_TIME + +! Add to SET_CUTCELLS_3D loop time: +T_CC_USED(SET_CUTCELLS_TIME_INDEX) = T_CC_USED(SET_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW + +IF(GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_MESH) + WRITE(LU_SETCC,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' + WRITE(LU_SETCC,'(A)') ' ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' + WRITE(LU_ERR,'(A)') ' ' + ENDIF +ENDIF + +END SUBROUTINE CC_GRID_LOG_PROCESSING_TIME + +SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING(EARLY_RETURN) + +LOGICAL, INTENT(OUT) :: EARLY_RETURN + +EARLY_RETURN = .FALSE. IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) @@ -1830,9 +1826,16 @@ SUBROUTINE SET_CUTCELLS_3D CALL_COUNT = CALL_COUNT + 1 IF(PERIODIC_TEST==105) THEN CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) - IF(CALL_COUNT > 1) RETURN + IF(CALL_COUNT > 1) THEN + EARLY_RETURN = .TRUE. + RETURN + ENDIF ENDIF +END SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING + +SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY + ! Loop over geometry: CCVERBOSE_COND : IF(GET_CUTCELLS_VERBOSE) THEN SLEN_GEOM = 0._EB; AREA_GEOM = 0._EB; VOLUME_GEOM = 0._EB; XYZCEN_GEOM(IAXIS:KAXIS) = 0._EB @@ -2177,9 +2180,7 @@ SUBROUTINE SET_CUTCELLS_3D ENDIF WRITE_CFACE_STATS_COND ENDIF CCVERBOSE_COND -RETURN - -CONTAINS +END SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS @@ -2425,7 +2426,6 @@ END SUBROUTINE DEFINE_XYZFACE_CELL SUBROUTINE TAG_CC_BLOCKING_REFINEMENT - LOGICAL, PARAMETER :: DO_RAY_TRACING=.TRUE. INTEGER :: DUM,II1,JJ1,KK1,IIO1,JJO1,KKO1,IIO2,JJO2,KKO2,IIG,JJG,KKG,IIOG,JJOG,KKOG @@ -2850,7 +2850,6 @@ SUBROUTINE TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL) ENDIF - END SUBROUTINE TAG_BLOCK_CELL SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) @@ -3129,7 +3128,6 @@ SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) RETURN END SUBROUTINE TEST_CC_FOR_BLOCKING - SUBROUTINE GET_CC_FACE_CELL_LIST_INFO(NM,PHASE) INTEGER, INTENT(IN) :: NM @@ -4763,6 +4761,7 @@ SUBROUTINE GET_GEOM_TRIBIN ! Define boundary region of Meshes handled by MPI process and their connected meshes: ! Select MESHES assigned to processor and OMESHES of these. Cut-cells will be computed for all of them. +IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) ALLOCATE(CC_COMPUTE_MESH(1:NMESHES)); CC_COMPUTE_MESH = .FALSE. MINMAX_MESHES( LOW_IND,:)= 1._EB/TWENTY_EPSILON_EB MINMAX_MESHES(HIGH_IND,:)= -1._EB/TWENTY_EPSILON_EB @@ -5006,17 +5005,179 @@ END SUBROUTINE SNAP_GEOM_NODES END SUBROUTINE SET_CUTCELLS_3D -! ----------------------- CHECK_WALL_CELL_PLANE_MATCH ---------------------------- - -SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH - -! Routine checks that external boundaries match among neighboring meshes. This is not strictly enforced -! by FDS but is required to compute same cut-cells on mesh ghost-cells and other mesh internal cells. -USE MPI_F08 +SUBROUTINE CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) + +INTEGER, INTENT(IN) :: NM,ISTR,IEND,JSTR,JEND,KSTR,KEND +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX + +! Initialize CC_IBM arrays for mesh NM: +! Vertices: +IF (.NOT. ALLOCATED(MESHES(NM)%VERTVAR)) & + ALLOCATE(MESHES(NM)%VERTVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NVVARS)) +MESHES(NM)%VERTVAR = 0 +MESHES(NM)%VERTVAR(:,:,:,CC_VGSC) = CC_GASPHASE + +! Cartesian Edges: +IF (.NOT. ALLOCATED(MESHES(NM)%ECVAR)) & + ALLOCATE(MESHES(NM)%ECVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NEVARS,MAX_DIM)) +MESHES(NM)%ECVAR = 0 +MESHES(NM)%ECVAR(:,:,:,CC_EGSC,:) = CC_GASPHASE + +! Cartesian Faces: +IF (.NOT. ALLOCATED(MESHES(NM)%FCVAR)) & + ALLOCATE(MESHES(NM)%FCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NFVARS,MAX_DIM)) +MESHES(NM)%FCVAR = 0 +MESHES(NM)%FCVAR(:,:,:,CC_FGSC,:) = CC_GASPHASE + +! Cartesian Cells: +IF (.NOT. ALLOCATED(MESHES(NM)%CCVAR)) & + ALLOCATE(MESHES(NM)%CCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NCVARS)) +MESHES(NM)%CCVAR = 0 +MESHES(NM)%CCVAR(:,:,:,CC_CGSC) = CC_GASPHASE + +! When TERRAIN_CASE = TRUE, allocate GEOM_ZMAX for the mesh: +IF (TERRAIN_CASE) THEN + ALLOCATE(GEOM_ZMAX_AUX(ISTR:IEND,JSTR:JEND)) + GEOM_ZMAX_AUX = -1._EB/GEOMEPS +ENDIF -! Local variables: -INTEGER :: NM,NOM,IW,IOR,IERR +! Write mesh number allocation if GET_CUTCELLS_VERBOSE: +IF (GET_CUTCELLS_VERBOSE) THEN + WRITE(LU_SETCC,'(A)') ' ' + WRITE(LU_SETCC,'(A,I5,A,I10)') ' Processing Mesh : ',NM + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A)') ' ' + WRITE(LU_ERR,'(A,I5,A,I10)') ' Processing Mesh : ',NM + ENDIF +ENDIF + +! Here we have to allocate the size of MESHES(NM)%EDGE_CROSS: +MESHES(NM)%N_EDGE_CROSS = 0 ! Reset EDCROSS counter for mesh NM. +IF (ALLOCATED(MESHES(NM)%EDGE_CROSS)) DEALLOCATE(MESHES(NM)%EDGE_CROSS) +ALLOCATE(MESHES(NM)%EDGE_CROSS(GLOBAL_DELTA_EDGE)) + +! Here we have to allocate the size of MESHES(NM)%CUT_EDGE: +MESHES(NM)%N_CUTEDGE_MESH = 0 ! Reset CUTEDGE counter for mesh NM. +IF (ALLOCATED(MESHES(NM)%CUT_EDGE)) DEALLOCATE(MESHES(NM)%CUT_EDGE) +ALLOCATE(MESHES(NM)%CUT_EDGE(GLOBAL_DELTA_EDGE)) + +! Here we have to allocate the size of MESHES(NM)%CUT_FACE: +MESHES(NM)%N_CUTFACE_MESH = 0 ! Reset CUTFACE counter for mesh NM. +MESHES(NM)%N_BBCUTFACE_MESH = 0 +MESHES(NM)%N_GCCUTFACE_MESH = 0 +IF (ALLOCATED(MESHES(NM)%CUT_FACE)) DEALLOCATE(MESHES(NM)%CUT_FACE) +ALLOCATE(MESHES(NM)%CUT_FACE(GLOBAL_DELTA_FACE)) + +! Here we have to allocate the size of MESHES(NM)%CUT_CELL: +MESHES(NM)%N_CUTCELL_MESH = 0 ! Reset CUTCELL counter for mesh NM. +MESHES(NM)%N_GCCUTCELL_MESH = 0 +IF (ALLOCATED(MESHES(NM)%CUT_CELL)) DEALLOCATE(MESHES(NM)%CUT_CELL) +ALLOCATE(MESHES(NM)%CUT_CELL(GLOBAL_DELTA_CELL)) + +! Allocate array for special cells containing geometry intersections: +ALLOCATE(CELLRT(ISTR:IEND,JSTR:JEND,KSTR:KEND)) +CELLRT(:,:,:) = .FALSE. + +! List of special cells to block (either from GET_CARTCELL_CUTCELLS or +! cells flagged as polyline could not be built in GET_CARTCELL_CUTFACES): +ALLOCATE(SPCELLS_TO_BLOCK(1:GLOBAL_DELTA_CELL)) +N_SPCELLS_TO_BLOCK = 0 +MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) + +END SUBROUTINE CC_GRID_INIT_MESH_STORAGE + + +SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) + +INTEGER, INTENT(IN) :: NM +INTEGER, ALLOCATABLE, DIMENSION(:) :: SPCELLS_TO_BLOCK_TMP + +MESHES(NM)%N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) + +IF (N_SPCELLS_TO_BLOCK < 1) THEN + IF (ALLOCATED(SPCELLS_TO_BLOCK)) DEALLOCATE(SPCELLS_TO_BLOCK) + RETURN +ENDIF + +IF (SIZE(SPCELLS_TO_BLOCK,DIM=1) > N_SPCELLS_TO_BLOCK) THEN + ALLOCATE(SPCELLS_TO_BLOCK_TMP(1:N_SPCELLS_TO_BLOCK)) + SPCELLS_TO_BLOCK_TMP(1:N_SPCELLS_TO_BLOCK) = SPCELLS_TO_BLOCK(1:N_SPCELLS_TO_BLOCK) + DEALLOCATE(SPCELLS_TO_BLOCK) + CALL MOVE_ALLOC(FROM=SPCELLS_TO_BLOCK_TMP,TO=MESHES(NM)%SPCELLS_TO_BLOCK) +ELSE + CALL MOVE_ALLOC(FROM=SPCELLS_TO_BLOCK,TO=MESHES(NM)%SPCELLS_TO_BLOCK) +ENDIF + +END SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK + + +SUBROUTINE CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) + +INTEGER, INTENT(IN) :: NM +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX +INTEGER :: I,J + +! Case of terrain, populate GEOM_ZMAX: +IF (.NOT.TERRAIN_CASE) RETURN + +IF (ALLOCATED(MESHES(NM)%GEOM_ZMAX)) DEALLOCATE(MESHES(NM)%GEOM_ZMAX) +ALLOCATE(MESHES(NM)%GEOM_ZMAX(0:IBAR,0:JBAR)) +DO J=0,JBAR + DO I=0,IBAR + ! Clip at ZS-DZ(1): + MESHES(NM)%GEOM_ZMAX(I,J) = MAX(ZFACE(-1),GEOM_ZMAX_AUX(I,J)) + ENDDO +ENDDO +DEALLOCATE(GEOM_ZMAX_AUX) + +END SUBROUTINE CC_GRID_FINALIZE_TERRAIN + + +SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS(NM) + +INTEGER, INTENT(IN) :: NM +INTEGER :: ICC,ICC1,I,J,K + +! Block SPCELLS, cells in cut-cell region where cut-cells could not be built: +IF (MESHES(NM)%N_SPCELLS_TO_BLOCK < 1 .OR. .NOT.ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) RETURN + +DO ICC=1,MESHES(NM)%N_SPCELLS_TO_BLOCK + I = MESHES(NM)%SPCELL_LIST(IAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + J = MESHES(NM)%SPCELL_LIST(JAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + K = MESHES(NM)%SPCELL_LIST(KAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + ICC1 = MESHES(NM)%CCVAR(I,J,K,CC_IDCC) + IF (ICC1 > 0) THEN + CC => MESHES(NM)%CUT_CELL(ICC1) + CC%NOADVANCE(1:CC%NCELL) = BLOCKED_SPECIAL_CELL + ENDIF +ENDDO + +END SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS + + +SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) + +INTEGER, INTENT(IN) :: NM + +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) +MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 + +END SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK + +! ----------------------- CHECK_WALL_CELL_PLANE_MATCH ---------------------------- + +SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH + +! Routine checks that external boundaries match among neighboring meshes. This is not strictly enforced +! by FDS but is required to compute same cut-cells on mesh ghost-cells and other mesh internal cells. + +USE MPI_F08 + +! Local variables: +INTEGER :: NM,NOM,IW,IOR,IERR REAL(EB):: XM,XOM,MSIZE INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BUFF TYPE(WALL_TYPE), POINTER :: WC @@ -10565,9 +10726,9 @@ SUBROUTINE GET_SOLID_CUTCELL_EDGES_BC(NM) RETURN END SUBROUTINE GET_SOLID_CUTCELL_EDGES_BC -! ------------------------- ALLOC_BODINT_PLANE ---------------------------------- +! ----------------------- ALLOCATE_BODINT_PLANE -------------------------------- -SUBROUTINE ALLOC_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) +SUBROUTINE ALLOCATE_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE LOGICAL, INTENT (INOUT) :: FIRST_CALL_ARG @@ -10629,7 +10790,7 @@ SUBROUTINE ALLOC_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) FIRST_CALL_ARG=.FALSE. -END SUBROUTINE ALLOC_BODINT_PLANE +END SUBROUTINE ALLOCATE_BODINT_PLANE ! -------------------------- GET_BODINT_PLANE ----------------------------------- @@ -25015,126 +25176,6 @@ INTEGER FUNCTION GET_GEOM_ID(ID,N_LAST) ENDDO END FUNCTION GET_GEOM_ID -! ---------------------------- SETUP_TRANSFORM ---------------------------------------- - -! SUBROUTINE SETUP_TRANSFORM(SCALE,AZ,ELEV,GAXIS,GROTATE,M) -! -! ! construct a rotation matrix M that rotates a vector by -! ! AZ degrees around the Z axis then ELEV degrees around -! ! the (cos AZ, sin AZ, 0) axis -! -! REAL(EB), INTENT(IN) :: SCALE(3), AZ, ELEV, GAXIS(3), GROTATE -! REAL(EB), DIMENSION(3,3), INTENT(OUT) :: M -! -! REAL(EB) :: AXIS(3), M0(3,3), M1(3,3), M2(3,3), M3(3,3), MTEMP(3,3), MTEMP2(3,3) -! -! M0 = RESHAPE ((/& -! SCALE(1), 0.0_EB, 0.0_EB,& -! 0.0_EB,SCALE(2), 0.0_EB,& -! 0.0_EB, 0.0_EB,SCALE(3) & -! /),(/3,3/)) -! -! AXIS = (/0.0_EB, 0.0_EB, 1.0_EB/) -! CALL SETUP_ROTATE(AZ,AXIS,M1) -! -! AXIS = (/COS(DEG2RAD*AZ), SIN(DEG2RAD*AZ), 0.0_EB/) -! CALL SETUP_ROTATE(ELEV,AXIS,M2) -! -! CALL SETUP_ROTATE(GROTATE,GAXIS,M3) -! -! MTEMP = MATMUL(M1,M0) -! MTEMP2 = MATMUL(M2,MTEMP) -! M = MATMUL(M3,MTEMP2) -! -! END SUBROUTINE SETUP_TRANSFORM - -! ---------------------------- SETUP_ROTATE ---------------------------------------- - -! SUBROUTINE SETUP_ROTATE(ALPHA,U,M) -! -! ! construct a rotation matrix M that rotates a vector by -! ! ALPHA degrees about an axis U -! -! REAL(EB), INTENT(IN) :: ALPHA, U(3) -! REAL(EB), INTENT(OUT) :: M(3,3) -! -! REAL(EB) :: UP(3,1), S(3,3), UUT(3,3), IDENTITY(3,3) -! -! UP = RESHAPE(U/SQRT(DOT_PRODUCT(U,U)),(/3,1/)) -! S = RESHAPE( (/& -! 0.0_EB, -UP(3,1), UP(2,1),& -! UP(3,1), 0.0_EB, -UP(1,1),& -! -UP(2,1), UP(1,1), 0.0_EB & -! /),(/3,3/)) -! UUT = MATMUL(UP,TRANSPOSE(UP)) -! IDENTITY = RESHAPE ((/& -! 1.0_EB,0.0_EB,0.0_EB,& -! 0.0_EB,1.0_EB,0.0_EB,& -! 0.0_EB,0.0_EB,1.0_EB & -! /),(/3,3/)) -! M = UUT + COS(ALPHA*DEG2RAD)*(IDENTITY - UUT) + SIN(ALPHA*DEG2RAD)*S -! -! END SUBROUTINE SETUP_ROTATE - -! ! ---------------------------- `TRANSLATE_VEC` ---------------------------------------- -! -! SUBROUTINE TRANSLATE_VEC(XYZ,N,XIN,XOUT) -! -! ! translate a geometry by the vector XYZ -! -! INTEGER, INTENT(IN) :: N -! REAL(EB), INTENT(IN) :: XYZ(3), XIN(3*N) -! REAL(EB), INTENT(OUT) :: XOUT(3*N) -! -! REAL(EB) :: VEC(3) -! INTEGER :: I -! -! DO I = 1, N -! VEC(1:3) = XYZ(1:3) + XIN(3*I-2:3*I) ! copy into a temp array so XIN and XOUT can point to same space -! XOUT(3*I-2:3*I) = VEC(1:3) -! ENDDO -! -! END SUBROUTINE TRANSLATE_VEC - -! ---------------------------- `TRANSLATE_VEC_INPLACE` ---------------------------------------- - -! SUBROUTINE TRANSLATE_VEC_INPLACE(XYZ,N,XINOUT) -! -! ! translate a geometry by the vector XYZ -! -! INTEGER, INTENT(IN) :: N -! REAL(EB), INTENT(IN) :: XYZ(3) -! REAL(EB), INTENT(INOUT) :: XINOUT(3*N) -! -! REAL(EB) :: VEC(3) -! INTEGER :: I -! -! DO I = 1, N -! VEC(1:3) = XYZ(1:3) + XINOUT(3*I-2:3*I) ! copy into a temp array so XIN and XOUT can point to same space -! XINOUT(3*I-2:3*I) = VEC(1:3) -! ENDDO -! -! END SUBROUTINE TRANSLATE_VEC_INPLACE - -! ---------------------------- ROTATE_VEC ---------------------------------------- - -! SUBROUTINE ROTATE_VEC(M,N,XYZ0,XIN,XOUT) -! -! ! rotate the vector XIN about the origin XYZ0 -! -! INTEGER, INTENT(IN) :: N -! REAL(EB), INTENT(IN) :: M(3,3), XIN(3*N), XYZ0(3) -! REAL(EB), INTENT(OUT) :: XOUT(3*N) -! -! REAL(EB) :: VEC(3) -! INTEGER :: I -! -! DO I = 1, N -! VEC(1:3) = MATMUL(M,XIN(3*I-2:3*I)-XYZ0(1:3)) ! copy into a temp array so XIN and XOUT can point to same space -! XOUT(3*I-2:3*I) = VEC(1:3) + XYZ0(1:3) -! ENDDO -! END SUBROUTINE ROTATE_VEC - ! ---------------------------- GEOMCLIPS ---------------------------------------- SUBROUTINE GEOMCLIPS @@ -25246,7 +25287,6 @@ SUBROUTINE PROCESS_GEOM(IS_DYNAMIC,TIME, N_VERTS, N_FACES, N_VOLUS) N_VOLUS = N_VOLUS + G%N_VOLUS ENDDO - END SUBROUTINE PROCESS_GEOM ! ---------------------------- GEOM2TEXTURE ---------------------------------------- @@ -25513,149 +25553,6 @@ SUBROUTINE WRITE_GEOM(TIME) END SUBROUTINE WRITE_GEOM -! ---------------------------- WRITE_GEOM_DATA----------------------------------- - -! SUBROUTINE WRITE_GEOM_DATA(VERTS, NVERTS, TRIANGLES, NTRIANGLES, VERTDATA, NVERTDATA, TRIDATA, NTRIDATA) -! INTEGER, INTENT(IN) :: NVERTS, NTRIANGLES, NVERTDATA, NTRIDATA -! REAL(FB), INTENT(IN) :: VERTS(3*NVERTS), VERTDATA(NVERTDATA), TRIDATA(NTRIDATA) -! INTEGER, INTENT(IN) :: TRIANGLES(3*NTRIANGLES) -! -! INTEGER :: ONE=1, VERSION=2 -! INTEGER :: N_FLOATS=0, N_INTS=0, FIRST_FRAME_STATIC=1 -! INTEGER :: NVOLS=0, HAS_VERT_ID=0,NVOLDATA=0 -! REAL(FB) :: STIME=0.0_FB -! INTEGER :: I -! -! IF (NVERTS.EQ.0.OR.NTRIANGLES.EQ.0) RETURN -! OPEN(LU_GEOM_DIAG(1),FILE=TRIM(FN_GEOM_DIAG(1)),FORM='UNFORMATTED',STATUS='REPLACE') -! WRITE(LU_GEOM_DIAG(1)) ONE -! WRITE(LU_GEOM_DIAG(1)) VERSION -! WRITE(LU_GEOM_DIAG(1)) N_FLOATS, N_INTS, FIRST_FRAME_STATIC -! -! WRITE(LU_GEOM_DIAG(1)) STIME -! WRITE(LU_GEOM_DIAG(1)) NVERTS, NTRIANGLES, NVOLS -! IF (NVERTS>0) WRITE(LU_GEOM_DIAG(1))(VERTS(I),I=1,3*NVERTS) -! IF (NTRIANGLES>0) THEN -! WRITE(LU_GEOM_DIAG(1)) (TRIANGLES(I),I=1,3*NTRIANGLES) -! WRITE(LU_GEOM_DIAG(1)) (-1,I=1,NTRIANGLES) -! WRITE(LU_GEOM_DIAG(1)) (-1.0_FB,-1.0_FB,I=1,3*NTRIANGLES) -! ENDIF -! CLOSE(LU_GEOM_DIAG(1)) -! -! OPEN(LU_GEOM_DIAG(2),FILE=TRIM(FN_GEOM_DIAG(2)),FORM='UNFORMATTED',STATUS='REPLACE') -! WRITE(LU_GEOM_DIAG(2)) ONE -! WRITE(LU_GEOM_DIAG(2)) VERSION -! WRITE(LU_GEOM_DIAG(2)) N_FLOATS -! WRITE(LU_GEOM_DIAG(2)) N_INTS -! -! WRITE(LU_GEOM_DIAG(2)) STIME -! WRITE(LU_GEOM_DIAG(1)) NVERTDATA, NTRIDATA, NVOLDATA -! WRITE(LU_GEOM_DIAG(2)) HAS_VERT_ID -! IF (NVERTDATA>0)WRITE(LU_GEOM_DIAG(2))(VERTDATA(I),I=1,NVERTDATA) -! IF (NTRIDATA>0) WRITE(LU_GEOM_DIAG(2))(TRIDATA(I),I=1,NTRIDATA) -! CLOSE(LU_GEOM_DIAG(2)) -! -! END SUBROUTINE WRITE_GEOM_DATA - -! ! ---------------------------- TRIANGLE_BOX_INTERSECT ---------------------------------------- -! -! SUBROUTINE TRIANGLE_BOX_INTERSECT(IERR,V1,V2,V3,BB) -! -! INTEGER, INTENT(OUT) :: IERR -! REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3),BB(6) -! REAL(EB) :: PLANE(4),P0(3),P1(3) -! -! IERR=0 -! -! !! Filter small triangles -! ! -! !A_TRI = TRIANGLE_AREA(V1,V2,V3) -! !A_BB = MIN( (BB(2)-BB(1))*(BB(4)-BB(3)), (BB(2)-BB(1))*(BB(6)-BB(5)), (BB(4)-BB(3))*(BB(6)-BB(5)) ) -! !IF (A_TRI < 0.01*A_BB) RETURN -! -! ! Are vertices outside of bounding planes? -! -! IF (MAX(V1(1),V2(1),V3(1))BB(2)) RETURN -! IF (MAX(V1(2),V2(2),V3(2))BB(4)) RETURN -! IF (MAX(V1(3),V2(3),V3(3))BB(6)) RETURN -! -! ! Any vertices inside bounding box? -! -! IF ( V1(1)>=BB(1) .AND. V1(1)<=BB(2) .AND. & -! V1(2)>=BB(3) .AND. V1(2)<=BB(4) .AND. & -! V1(3)>=BB(5) .AND. V1(3)<=BB(6) ) THEN -! IERR=1 -! RETURN -! ENDIF -! IF ( V2(1)>=BB(1) .AND. V2(1)<=BB(2) .AND. & -! V2(2)>=BB(3) .AND. V2(2)<=BB(4) .AND. & -! V2(3)>=BB(5) .AND. V2(3)<=BB(6) ) THEN -! IERR=1 -! RETURN -! ENDIF -! IF ( V3(1)>=BB(1) .AND. V3(1)<=BB(2) .AND. & -! V3(2)>=BB(3) .AND. V3(2)<=BB(4) .AND. & -! V3(3)>=BB(5) .AND. V3(3)<=BB(6) ) THEN -! IERR=1 -! RETURN -! ENDIF -! -! ! There are a couple other trivial rejection tests we could employ. -! ! But for now we jump straight to line segment--plane intersection. -! -! ! Test edge V1,V2 for intersection with each face of box -! PLANE = (/-1._EB,0._EB,0._EB, BB(1)/); CALL LINE_PLANE_INTERSECT(IERR,V1,V2,PLANE,BB,-1); IF (IERR==1) RETURN -! PLANE = (/ 1._EB,0._EB,0._EB,-BB(2)/); CALL LINE_PLANE_INTERSECT(IERR,V1,V2,PLANE,BB, 1); IF (IERR==1) RETURN -! PLANE = (/0._EB,-1._EB,0._EB, BB(3)/); CALL LINE_PLANE_INTERSECT(IERR,V1,V2,PLANE,BB,-2); IF (IERR==1) RETURN -! PLANE = (/0._EB, 1._EB,0._EB,-BB(4)/); CALL LINE_PLANE_INTERSECT(IERR,V1,V2,PLANE,BB, 2); IF (IERR==1) RETURN -! PLANE = (/0._EB,0._EB,-1._EB, BB(5)/); CALL LINE_PLANE_INTERSECT(IERR,V1,V2,PLANE,BB,-3); IF (IERR==1) RETURN -! PLANE = (/0._EB,0._EB, 1._EB,-BB(6)/); CALL LINE_PLANE_INTERSECT(IERR,V1,V2,PLANE,BB, 3); IF (IERR==1) RETURN -! -! ! Test edge V2,V3 for intersection with each face of box -! PLANE = (/-1._EB,0._EB,0._EB, BB(1)/); CALL LINE_PLANE_INTERSECT(IERR,V2,V3,PLANE,BB,-1); IF (IERR==1) RETURN -! PLANE = (/ 1._EB,0._EB,0._EB,-BB(2)/); CALL LINE_PLANE_INTERSECT(IERR,V2,V3,PLANE,BB, 1); IF (IERR==1) RETURN -! PLANE = (/0._EB,-1._EB,0._EB, BB(3)/); CALL LINE_PLANE_INTERSECT(IERR,V2,V3,PLANE,BB,-2); IF (IERR==1) RETURN -! PLANE = (/0._EB, 1._EB,0._EB,-BB(4)/); CALL LINE_PLANE_INTERSECT(IERR,V2,V3,PLANE,BB, 2); IF (IERR==1) RETURN -! PLANE = (/0._EB,0._EB,-1._EB, BB(5)/); CALL LINE_PLANE_INTERSECT(IERR,V2,V3,PLANE,BB,-3); IF (IERR==1) RETURN -! PLANE = (/0._EB,0._EB, 1._EB,-BB(6)/); CALL LINE_PLANE_INTERSECT(IERR,V2,V3,PLANE,BB, 3); IF (IERR==1) RETURN -! -! ! Test edge V3,V1 for intersection with each face of box -! PLANE = (/-1._EB,0._EB,0._EB, BB(1)/); CALL LINE_PLANE_INTERSECT(IERR,V3,V1,PLANE,BB,-1); IF (IERR==1) RETURN -! PLANE = (/ 1._EB,0._EB,0._EB,-BB(2)/); CALL LINE_PLANE_INTERSECT(IERR,V3,V1,PLANE,BB, 1); IF (IERR==1) RETURN -! PLANE = (/0._EB,-1._EB,0._EB, BB(3)/); CALL LINE_PLANE_INTERSECT(IERR,V3,V1,PLANE,BB,-2); IF (IERR==1) RETURN -! PLANE = (/0._EB, 1._EB,0._EB,-BB(4)/); CALL LINE_PLANE_INTERSECT(IERR,V3,V1,PLANE,BB, 2); IF (IERR==1) RETURN -! PLANE = (/0._EB,0._EB,-1._EB, BB(5)/); CALL LINE_PLANE_INTERSECT(IERR,V3,V1,PLANE,BB,-3); IF (IERR==1) RETURN -! PLANE = (/0._EB,0._EB, 1._EB,-BB(6)/); CALL LINE_PLANE_INTERSECT(IERR,V3,V1,PLANE,BB, 3); IF (IERR==1) RETURN -! -! ! The remaining possibility for tri-box intersection is that the corner of the box pokes through -! ! the triangle such that neither the vertices nor the edges of tri intersect any of the box faces. -! ! In this case the diagonal of the box corner intersects the plane formed by the tri. The diagonal -! ! is defined as the line segment from point P0 to P1, formed from the corners of the bounding box. -! -! ! Test the four box diagonals: -! -! P0 = (/BB(1),BB(3),BB(5)/) -! P1 = (/BB(2),BB(4),BB(6)/) -! CALL LINE_SEGMENT_TRIANGLE_INTERSECT(IERR,V1,V2,V3,P0,P1); IF (IERR==1) RETURN -! -! P0 = (/BB(2),BB(3),BB(5)/) -! P1 = (/BB(1),BB(4),BB(6)/) -! CALL LINE_SEGMENT_TRIANGLE_INTERSECT(IERR,V1,V2,V3,P0,P1); IF (IERR==1) RETURN -! -! P0 = (/BB(1),BB(3),BB(6)/) -! P1 = (/BB(2),BB(4),BB(5)/) -! CALL LINE_SEGMENT_TRIANGLE_INTERSECT(IERR,V1,V2,V3,P0,P1); IF (IERR==1) RETURN -! -! P0 = (/BB(1),BB(4),BB(5)/) -! P1 = (/BB(2),BB(3),BB(6)/) -! CALL LINE_SEGMENT_TRIANGLE_INTERSECT(IERR,V1,V2,V3,P0,P1); IF (IERR==1) RETURN -! -! ! test commit from Charles Luo -! -! END SUBROUTINE TRIANGLE_BOX_INTERSECT ! ---------------------------- TRIANGLE_AREA ---------------------------------------- @@ -25673,74 +25570,6 @@ REAL(EB) FUNCTION TRIANGLE_AREA(V1,V2,V3) END FUNCTION TRIANGLE_AREA -! ! ---------------------------- LINE_SEGMENT_TRIANGLE_INTERSECT ---------------------------------------- -! -! SUBROUTINE LINE_SEGMENT_TRIANGLE_INTERSECT(IERR,V1,V2,V3,P0,P1) -! USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -! -! INTEGER, INTENT(OUT) :: IERR -! REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3),P0(3),P1(3) -! REAL(EB) :: E1(3),E2(3),S(3),Q(3),U,V,TMP,T,D(3),P(3) -! REAL(EB), PARAMETER :: EPS=1.E-10_EB -! -! IERR=0 -! -! ! Schneider and Eberly, Section 11.1 -! -! D = P1-P0 -! -! E1 = V2-V1 -! E2 = V3-V1 -! -! CALL CROSS_PRODUCT(P,D,E2) -! -! TMP = DOT_PRODUCT(P,E1) -! -! IF ( ABS(TMP)1._EB) RETURN -! -! CALL CROSS_PRODUCT(Q,S,E1) -! V = TMP*DOT_PRODUCT(D,Q) -! IF (V<0._EB .OR. (U+V)>1._EB) RETURN -! -! T = TMP*DOT_PRODUCT(E2,Q) -! !XI = P0 + T*D ! the intersection point -! -! IF (T>=0._EB .AND. T<=1._EB) IERR=1 -! -! END SUBROUTINE LINE_SEGMENT_TRIANGLE_INTERSECT - -! ! ---------------------------- LINE_PLANE_INTERSECT ---------------------------------------- -! -! SUBROUTINE LINE_PLANE_INTERSECT(IERR,P0,P1,PP,BB,IOR) -! -! INTEGER, INTENT(OUT) :: IERR -! REAL(EB), INTENT(IN) :: P0(3),P1(3),PP(4),BB(6) -! INTEGER, INTENT(IN) :: IOR -! REAL(EB) :: D(3),T,DENOM, Q0(3) -! REAL(EB), PARAMETER :: EPS=1.E-10_EB -! -! IERR=0 -! Q0=-999._EB -! T=0._EB -! -! D = P1-P0 -! DENOM = DOT_PRODUCT(PP(1:3),D) -! -! IF (ABS(DENOM)>EPS) THEN -! T = -( DOT_PRODUCT(PP(1:3),P0)+PP(4) )/DENOM -! IF (T>=0._EB .AND. T<=1._EB) THEN -! Q0 = P0 + T*D ! instersection point -! IF (POINT_IN_BOX_2D(Q0,BB,IOR)) IERR=1 -! ENDIF -! ENDIF -! -! END SUBROUTINE LINE_PLANE_INTERSECT ! ---------------------------- POINT_IN_BOX_2D ---------------------------------------- @@ -25830,75 +25659,7 @@ LOGICAL FUNCTION POINT_IN_TETRAHEDRON(XP,V1,V2,V3,V4,BB) END FUNCTION POINT_IN_TETRAHEDRON -! ! ---------------------------- POINT_IN_POLYHEDRON ---------------------------------------- -! -! LOGICAL FUNCTION POINT_IN_POLYHEDRON(XP,BB) -! -! REAL(EB) :: XP(3),BB(6),XX(3),YY(3),ZZ(3),RAY_DIRECTION(3) -! INTEGER :: I,J,N_INTERSECTIONS,IRAY -! REAL(EB), PARAMETER :: EPS=1.E-6_EB -! -! ! Schneider and Eberly, Geometric Tools for Computer Graphics, Morgan Kaufmann, 2003. Section 13.4 -! -! POINT_IN_POLYHEDRON=.FALSE. -! -! ! test global bounding box -! -! IF ( XP(1)BB(2) ) RETURN -! IF ( XP(2)BB(4) ) RETURN -! IF ( XP(3)BB(6) ) RETURN -! -! N_INTERSECTIONS=0 -! -! RAY_DIRECTION = (/0._EB,0._EB,1._EB/) -! -! FACE_LOOP: DO I=1,N_FACE -! -! ! test bounding box -! XX(1) = VERTEX(FACET(I)%VERTEX(1))%X -! XX(2) = VERTEX(FACET(I)%VERTEX(2))%X -! XX(3) = VERTEX(FACET(I)%VERTEX(3))%X -! -! IF (XP(1)MAXVAL(XX)) CYCLE FACE_LOOP -! -! YY(1) = VERTEX(FACET(I)%VERTEX(1))%Y -! YY(2) = VERTEX(FACET(I)%VERTEX(2))%Y -! YY(3) = VERTEX(FACET(I)%VERTEX(3))%Y -! -! IF (XP(2)MAXVAL(YY)) CYCLE FACE_LOOP -! -! ZZ(1) = VERTEX(FACET(I)%VERTEX(1))%Z -! ZZ(2) = VERTEX(FACET(I)%VERTEX(2))%Z -! ZZ(3) = VERTEX(FACET(I)%VERTEX(3))%Z -! -! IF (XP(3)>MAXVAL(ZZ)) CYCLE FACE_LOOP -! -! RAY_TEST_LOOP: DO J=1,3 -! IRAY = RAY_TRIANGLE_INTERSECT(I,XP,RAY_DIRECTION) -! SELECT CASE(IRAY) -! CASE(0) -! ! does not intersect -! EXIT RAY_TEST_LOOP -! CASE(1) -! ! ray intersects triangle -! N_INTERSECTIONS=N_INTERSECTIONS+1 -! EXIT RAY_TEST_LOOP -! CASE(2) -! ! ray intersects edge, try new ray (shift origin) -! IF (J==1) XP=XP+(/EPS,0._EB,0._EB/) ! shift in x direction -! IF (J==2) XP=XP+(/0._EB,EPS,0._EB/) ! shift in y direction -! IF (J==3) WRITE(LU_ERR,*) 'WARNING: ray test failed' -! END SELECT -! ENDDO RAY_TEST_LOOP -! -! ENDDO FACE_LOOP -! -! IF ( MOD(N_INTERSECTIONS,2)/=0 ) POINT_IN_POLYHEDRON=.TRUE. -! -! END FUNCTION POINT_IN_POLYHEDRON -! + ! ---------------------------- VALID_TRIANGLE ---------------------------------------- LOGICAL FUNCTION VALID_TRIANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3,VERT_FLAG) @@ -25961,37 +25722,6 @@ LOGICAL FUNCTION VALID_TRIANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3,VERT_FLAG) VALID_TRIANGLE = .TRUE. END FUNCTION VALID_TRIANGLE -! ------------------------- PT_LINE_DISTANCE_2D ------------------------------------ - -! REAL(FB) FUNCTION PT_LINE_DISTANCE_2D(X0,Y0,X1,Y1,X2,Y2) -! -! REAL(FB), INTENT(IN) :: X0,Y0,X1,Y1,X2,Y2 -! -! ! Local Variables: -! REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB -! REAL(FB) :: X3,Y3 -! REAL(FB) :: DX01,DY01,DX21,DY21,DSQ -! REAL(FB) :: DPRM = -1._FB -! -! DX01 = X0 - X1 -! DY01 = Y0 - Y1 -! DX21 = X2 - X1 -! DY21 = Y2 - Y1 -! DSQ = DX21**2._FB + DY21**2._FB -! IF (DSQ > EPS_FB**2) DPRM=(DX01*DX21+DY01*DY21)/DSQ -! IF (DPRM < EPS_FB) THEN -! X3=X1; Y3=Y1 -! ELSE IF (DPRM > (1._FB+EPS_FB)) THEN -! X3=X2; Y3=Y2 -! ELSE -! X3 = X1 + DPRM*DX21 -! Y3 = Y1 + DPRM*DY21 -! ENDIF -! -! PT_LINE_DISTANCE_2D = SQRT( (X0-X3)**2._FB + (Y0-Y3)**2._FB ) -! -! END FUNCTION PT_LINE_DISTANCE_2D - ! ----------------------------- DIFF_ANGLE ----------------------------------------- @@ -26402,108 +26132,6 @@ SUBROUTINE TRIANGULATE(DIR,VERTS,NVERTS,VERT_OFFSET,FACES,LOCTYPE) RETURN END SUBROUTINE TRIANGULATE -! ! ---------------------------- TRIANGULATE2 ---------------------------------------- -! -! SUBROUTINE TRIANGULATE2(DIR, VERTS,NVERTS,VERT_OFFSET,FACES) -! INTEGER, INTENT(IN) :: DIR, NVERTS, VERT_OFFSET -! REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) -! INTEGER, INTENT(OUT) :: FACES(3*(NVERTS-2)) -! INTEGER :: IVERT -! -! -! IF (VERTS(1)*VERTS(1)<0.0 .OR. DIR==4) THEN -! ! a dummy checks to prevent compiler warnings for unused variables -! ! (we need VERTS eventually but don't need VERTS now) -! RETURN -! ENDIF -! DO IVERT = 1, NVERTS - 2 ! for now assume face is convex -! ! vertex indices 1, 2, ..., NVF -! ! faces (1,2,3), (1,3,4), ..., (1,NVF-1,NVF) -! FACES(3*IVERT-2) = VERT_OFFSET+1 -! FACES(3*IVERT-1) = VERT_OFFSET+1+IVERT -! FACES(3*IVERT) = VERT_OFFSET+2+IVERT -! ENDDO -! END SUBROUTINE TRIANGULATE2 - -! ! ---------------------------- RAY_TRIANGLE_INTERSECT ---------------------------------------- -! -! INTEGER FUNCTION RAY_TRIANGLE_INTERSECT(TRI,XP,D) -! USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -! -! INTEGER, INTENT(IN) :: TRI -! REAL(EB), INTENT(IN) :: XP(3),D(3) -! REAL(EB) :: E1(3),E2(3),P(3),S(3),Q(3),U,V,TMP,V1(3),V2(3),V3(3),T !,XI(3) -! REAL(EB), PARAMETER :: EPS=1.E-10_EB -! -! ! Schneider and Eberly, Section 11.1 -! -! V1(1) = VERTEX(FACET(TRI)%VERTEX(1))%X -! V1(2) = VERTEX(FACET(TRI)%VERTEX(1))%Y -! V1(3) = VERTEX(FACET(TRI)%VERTEX(1))%Z -! -! V2(1) = VERTEX(FACET(TRI)%VERTEX(2))%X -! V2(2) = VERTEX(FACET(TRI)%VERTEX(2))%Y -! V2(3) = VERTEX(FACET(TRI)%VERTEX(2))%Z -! -! V3(1) = VERTEX(FACET(TRI)%VERTEX(3))%X -! V3(2) = VERTEX(FACET(TRI)%VERTEX(3))%Y -! V3(3) = VERTEX(FACET(TRI)%VERTEX(3))%Z -! -! E1 = V2-V1 -! E2 = V3-V1 -! -! CALL CROSS_PRODUCT(P,D,E2) -! -! TMP = DOT_PRODUCT(P,E1) -! -! IF ( ABS(TMP)(1._EB+EPS)) THEN -! ! ray does not intersect triangle -! RAY_TRIANGLE_INTERSECT=0 -! RETURN -! ENDIF -! -! IF (U(1._EB-EPS)) THEN -! ! ray intersects edge -! RAY_TRIANGLE_INTERSECT=2 -! RETURN -! ENDIF -! -! CALL CROSS_PRODUCT(Q,S,E1) -! V = TMP*DOT_PRODUCT(D,Q) -! IF (V<-EPS .OR. (U+V)>(1._EB+EPS)) THEN -! ! ray does not intersect triangle -! RAY_TRIANGLE_INTERSECT=0 -! RETURN -! ENDIF -! -! IF (V(1._EB-EPS)) THEN -! ! ray intersects edge -! RAY_TRIANGLE_INTERSECT=2 -! RETURN -! ENDIF -! -! T = TMP*DOT_PRODUCT(E2,Q) -! !XI = XP + T*D ! the intersection point -! -! IF (T>0._EB) THEN -! RAY_TRIANGLE_INTERSECT=1 -! ELSE -! RAY_TRIANGLE_INTERSECT=0 -! ENDIF -! RETURN -! -! END FUNCTION RAY_TRIANGLE_INTERSECT -! - ! ---------------------------- RAY_TRIANGLE_INTERSECT_PT ---------------------------------------- SUBROUTINE RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,D,IS_INTERSECT,POS) @@ -26598,503 +26226,6 @@ REAL(EB) FUNCTION TRILINEAR(UU,DXI,LL) END FUNCTION TRILINEAR -! ---------------------------- GETU ---------------------------------------- - -SUBROUTINE GETU(U_DATA,DXI,XI_IN,I_VEL,NM) - -REAL(EB), INTENT(OUT) :: U_DATA(0:1,0:1,0:1),DXI(3) -REAL(EB), INTENT(IN) :: XI_IN(3) -INTEGER, INTENT(IN) :: I_VEL,NM -TYPE(MESH_TYPE), POINTER :: M -REAL(EB), POINTER, DIMENSION(:,:,:) :: UU,VV,WW -INTEGER :: II,JJ,KK -REAL(EB) :: XI(3) - -M=>MESHES(NM) -IF (PREDICTOR) THEN - UU => M%U - VV => M%V - WW => M%W -ELSE - UU => M%US - VV => M%VS - WW => M%WS -ENDIF - -!II = INDU(1) -!JJ = INDU(2) -!KK = INDU(3) -! -!IF (XI(1) 6) THEN -! WRITE(LU_OUTPUT,*)"*** Triangle box intersections" -! DO I = 1, NP -! WRITE(LU_OUTPUT,*)I,PC_TMP(3*I-2),PC_TMP(3*I-1),PC_TMP(3*I) -! ENDDO -! CALL SHUTDOWN("ERROR: more than 6 triangle box intersections") -! ENDIF -! IF (NP > 3) THEN -! CALL SORT_POLYGON_CORNERS(NP,V1,V2,V3,PC_TMP) -! ENDIF -! DO I=1,NP*3 -! PC(I) = PC_TMP(I) -! ENDDO -! -! RETURN -! END SUBROUTINE TRI_PLANE_BOX_INTERSECT - -! ! ---------------------------- SORT_POLYGON_CORNERS ---------------------------------------- -! -! SUBROUTINE SORT_POLYGON_CORNERS(NP,V1,V2,V3,PC) -! USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -! ! Sort all the corners of a polygon -! ! Ref: Gernot Hoffmann, Cube Plane Intersection. -! -! INTEGER, INTENT(IN) :: NP -! REAL(EB), INTENT(INOUT) :: PC(60) -! REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3) -! REAL(EB) :: MEAN_VALUE(3),POLY_NORM(3),R1,R2,TMP(3),U(3),W(3) -! INTEGER :: I,J,K,IOR,NA,NB -! -! IF (NP <=3 ) RETURN -! -! U = V2-V1 -! W = V3-V1 -! CALL CROSS_PRODUCT(POLY_NORM,U,W) -! -! DO I=1,3 -! MEAN_VALUE(I) = 0._EB -! DO J=1,NP -! MEAN_VALUE(I) = MEAN_VALUE(I) + PC((J-1)*3+I)/REAL(NP) -! ENDDO -! ENDDO -! -! !get normal of ploygan -! IF (ABS(POLY_NORM(1)) >= ABS(POLY_NORM(2)) .AND. ABS(POLY_NORM(1)) >= ABS(POLY_NORM(3)) ) THEN -! IOR = 1 -! NA = 2 -! NB = 3 -! ELSE IF (ABS(POLY_NORM(2)) >= ABS(POLY_NORM(3)) ) THEN -! IOR = 2 -! NA = 1 -! NB = 3 -! ELSE -! IOR = 3 -! NA = 1 -! NB = 2 -! ENDIF -! -! DO I=1,NP-1 -! R1 = ATAN2(PC((I-1)*3+NB)-MEAN_VALUE(NB), PC((I-1)*3+NA)-MEAN_VALUE(NA)) -! DO J=I+1, NP -! R2 = ATAN2(PC((J-1)*3+NB)-MEAN_VALUE(NB), PC((J-1)*3+NA)-MEAN_VALUE(NA)) -! IF (R2 < R1) THEN -! DO K=1,3 -! TMP(K) = PC((J-1)*3+K) -! PC((J-1)*3+K) = PC((I-1)*3+K) -! PC((I-1)*3+K) = TMP(K) -! R1 = R2 -! ENDDO -! ENDIF -! ENDDO -! ENDDO -! -! RETURN -! END SUBROUTINE SORT_POLYGON_CORNERS - -! ! ---------------------------- TRIANGLE_POLYGON_POINTS ---------------------------------------- -! -! SUBROUTINE TRIANGLE_POLYGON_POINTS(IERR,NXP,XPC,V1,V2,V3,NP,PC,BB) -! ! Calculate the intersection points of a triangle and a polygon, if intersected. -! ! http://softsurfer.com/Archive/algorithm_0106/algorithm_0106.htm -! -! INTEGER, INTENT(IN) :: NP -! INTEGER, INTENT(OUT) :: NXP,IERR -! REAL(EB), INTENT(OUT) :: XPC(60) -! REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3),PC(18),BB(6) -! INTEGER :: I,J,K -! REAL(EB) :: U(3),V(3),W(3),S1P0(3),XC(3) -! REAL(EB) :: A,B,C,D,E,DD,SC,TC -! REAL(EB), PARAMETER :: EPS=1.E-20_EB,TOL=1.E-12_EB -! !LOGICAL :: POINT_IN_BB, POINT_IN_TRIANGLE -! -! IERR = 0 -! SC = 0._EB -! TC = 0._EB -! NXP = 0 -! TRIANGLE_LOOP: DO I=1,3 -! SELECT CASE(I) -! CASE(1) -! U = V2-V1 -! S1P0 = V1 -! CASE(2) -! U = V3-V2 -! S1P0 = V2 -! CASE(3) -! U = V1-V3 -! S1P0 = V3 -! END SELECT -! -! POLYGON_LOOP: DO J=1,NP -! IF (J < NP) THEN -! DO K=1,3 -! V(K) = PC(J*3+K)-PC((J-1)*3+K) -! ENDDO -! ELSE -! DO K=1,3 -! V(K) = PC(K)-PC((J-1)*3+K) -! ENDDO -! ENDIF -! -! DO K=1,3 -! W(K) = S1P0(K)-PC((J-1)*3+K) -! ENDDO -! -! A = DOT_PRODUCT(U,U) -! B = DOT_PRODUCT(U,V) -! C = DOT_PRODUCT(V,V) -! D = DOT_PRODUCT(U,W) -! E = DOT_PRODUCT(V,W) -! DD = A*C-B*B -! -! IF (DD < EPS) THEN ! almost parallel -! IERR = 0 -! CYCLE -! ELSE -! SC = (B*E-C*D)/DD -! TC = (A*E-B*D)/DD -! IF (SC>-TOL .AND. SC<1._EB+TOL .AND. TC>-TOL .AND. TC<1._EB+TOL ) THEN -! NXP = NXP+1 -! XC = S1P0+SC*U -! DO K=1,3 -! XPC((NXP-1)*3+K) = XC(K) -! ENDDO -! ENDIF -! ENDIF -! -! ENDDO POLYGON_LOOP -! ENDDO TRIANGLE_LOOP -! -! !WRITE(LU_ERR,*) 'A', NXP -! ! add triangle vertices in polygon -! DO I=1,3 -! SELECT CASE(I) -! CASE(1) -! V = V1 -! CASE(2) -! V = V2 -! CASE(3) -! V = V3 -! END SELECT -! -! IF (POINT_IN_BB(V,BB)) THEN -! NXP = NXP+1 -! DO K=1,3 -! XPC((NXP-1)*3+K) = V(K) -! ENDDO -! ENDIF -! ENDDO -! -! !WRITE(LU_ERR,*) 'B', NXP -! ! add polygon vertices in triangle -! DO I=1,NP -! DO J=1,3 -! V(J) = PC((I-1)*3+J) -! ENDDO -! IF (POINT_IN_TRIANGLE(V,V1,V2,V3)) THEN -! NXP = NXP+1 -! DO J=1,3 -! XPC((NXP-1)*3+J) = V(J) -! ENDDO -! ENDIF -! ENDDO -! -! !WRITE(LU_ERR,*) 'C', NXP -! -! CALL ELIMATE_REPEATED_POINTS(NXP,XPC) -! -! !WRITE(LU_ERR,*) 'D', NXP -! -! IF (NXP > 3) THEN -! CALL SORT_POLYGON_CORNERS(NXP,V1,V2,V3,XPC) -! ENDIF -! -! !WRITE(LU_ERR,*) 'E', NXP -! -! IF (NXP >= 1) THEN -! IERR = 1 ! index for intersecting -! ELSE -! IERR = 0 -! ENDIF -! -! RETURN -! END SUBROUTINE TRIANGLE_POLYGON_POINTS - -! ! ---------------------------- ELIMATE_REPEATED_POINTS ---------------------------------------- -! -! SUBROUTINE ELIMATE_REPEATED_POINTS(NP,PC) -! -! INTEGER, INTENT(INOUT):: NP -! REAL(EB), INTENT(INOUT) :: PC(60) -! INTEGER :: NP2,I,J,K -! REAL(EB) :: U(3),V(3),W(3) -! REAL(EB), PARAMETER :: EPS_DIFF=1.0E-8_EB -! -! I = 1 -! DO WHILE (I <= NP-1) -! DO K=1,3 -! U(K) = PC(3*(I-1)+K) -! ENDDO -! -! J = I+1 -! NP2 = NP -! DO WHILE (J <= NP2) -! DO K=1,3 -! V(K) = PC(3*(J-1)+K) -! ENDDO -! W = U-V -! ! use hybrid comparison test -! ! absolute for small values -! ! relative for large values -! IF (NORM2(W) <= MAX(1.0_EB,NORM2(U),NORM2(V))*EPS_DIFF) THEN -! DO K=3*J+1,3*NP -! PC(K-3) = PC(K) -! ENDDO -! NP = NP-1 -! J = J-1 -! ENDIF -! J = J+1 -! IF (J > NP) EXIT -! ENDDO -! I = I+1 -! ENDDO -! -! RETURN -! END SUBROUTINE ELIMATE_REPEATED_POINTS - ! ---------------------------- POINT_IN_BB ---------------------------------------- LOGICAL FUNCTION POINT_IN_BB(V1,BB) @@ -27112,53 +26243,6 @@ LOGICAL FUNCTION POINT_IN_BB(V1,BB) RETURN END FUNCTION POINT_IN_BB -! ! ---------------------------- LINE_SEG_TRI_PLANE_INTERSECT ---------------------------------------- -! -! SUBROUTINE LINE_SEG_TRI_PLANE_INTERSECT(IERR,IERR2,Q,V1,V2,V3,P0,P1) -! USE MATH_FUNCTIONS, ONLY:CROSS_PRODUCT -! -! INTEGER, INTENT(OUT) :: IERR -! REAL(EB), INTENT(OUT) :: Q(3) -! REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3),P0(3),P1(3) -! REAL(EB) :: E1(3),E2(3),S(3),U,V,TMP,T,D(3),P(3) -! REAL(EB), PARAMETER :: EPS=1.E-10_EB,TOL=1.E-15 -! INTEGER :: IERR2 -! -! IERR = 0 -! IERR2 = 1 -! ! IERR=1: line segment intersect with the plane -! ! IERR2=1: the intersection point is in the triangle -! -! ! Schneider and Eberly, Section 11.1 -! -! D = P1-P0 -! E1 = V2-V1 -! E2 = V3-V1 -! -! CALL CROSS_PRODUCT(P,D,E2) -! -! TMP = DOT_PRODUCT(P,E1) -! -! IF ( ABS(TMP)1._EB) IERR2=0 -! -! CALL CROSS_PRODUCT(Q,S,E1) -! V = TMP*DOT_PRODUCT(D,Q) -! IF (V<0._EB .OR. (U+V)>1._EB) IERR2=0 -! -! T = TMP*DOT_PRODUCT(E2,Q) -! Q = P0 + T*D ! the intersection point -! -! IF (T>=0._EB-TOL .AND. T<=1._EB+TOL) IERR=1 -! -! RETURN -! END SUBROUTINE LINE_SEG_TRI_PLANE_INTERSECT - ! ---------------------------- POLYGON_AREA ---------------------------------------- REAL(EB) FUNCTION POLYGON_AREA(NP,PC) @@ -27437,86 +26521,6 @@ LOGICAL FUNCTION INTERSECT_OBB_AABB(X_IN,L,W,H,ROTMAT,XB) RETURN END FUNCTION INTERSECT_OBB_AABB -! ! ---------------------------- TRIANGLE_ON_CELL_SURF ---------------------------------------- -! -! SUBROUTINE TRIANGLE_ON_CELL_SURF(IERR1,N_VEC,V,XC,YC,ZC,DX,DY,DZ) -! -! INTEGER, INTENT(OUT) :: IERR1 -! REAL(EB), INTENT(IN) :: N_VEC(3),V(3),XC,YC,ZC,DX,DY,DZ -! REAL(EB) :: DIST(3),TOL=1.E-15_EB -! -! IERR1 = 1 -! DIST = 0._EB -! !IF (NORM2(N_VEC)>1._EB) N_VEC = N_VEC/NORM2(N_VEC) -! -! IF (N_VEC(1)==1._EB .OR. N_VEC(1)==-1._EB) THEN -! DIST(1) = XC-V(1) -! IF ( ABS(ABS(DIST(1))-DX*0.5_EB)= ABS(DIST(2)/DY) .AND. ABS(DIST(1)/DX) >= ABS(DIST(3)/DZ)) THEN -! DMAX = ABS(DIST(1)/DX*2._EB) -! IF (DMAX < (1._EB-TOLERANCE) .OR. DOT_PRODUCT(DIST,N_VEC) > 0._EB) RETURN -! IF (DIST(1) < 0._EB) THEN -! IOR = 1 -! ELSE -! IOR = -1 -! ENDIF -! ELSEIF (ABS(DIST(2)/DY) >= ABS(DIST(3)/DZ)) THEN -! DMAX = ABS(DIST(2)/DY*2._EB) -! IF (DMAX < (1._EB-TOLERANCE) .OR. DOT_PRODUCT(DIST,N_VEC) > 0._EB) RETURN -! IF (DIST(2) < 0._EB) THEN -! IOR = 2 -! ELSE -! IOR = -2 -! ENDIF -! ELSE -! DMAX = ABS(DIST(3)/DZ*2._EB) -! IF (DMAX < (1._EB-TOLERANCE) .OR. DOT_PRODUCT(DIST,N_VEC) > 0._EB) RETURN -! IF (DIST(3) < 0._EB) THEN -! IOR = 3 -! ELSE -! IOR = -3 -! ENDIF -! ENDIF -! -! END SUBROUTINE POLYGON_CLOSE_TO_EDGE - ! ---------------------------- AVERAGE_FACE_VALUES ---------------------------------------- ! for each node, compute the average values of faces connected to that node @@ -27682,3 +26686,63 @@ RECURSIVE SUBROUTINE MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, FIRST, LAST) END SUBROUTINE MAKE_PERMUTATION_ARRAY END MODULE COMPLEX_GEOMETRY + + +!> \brief Grid related complex-geometry routines. + +MODULE COMPLEX_GEOMETRY_GRID + +USE PRECISION_PARAMETERS, ONLY: EB +USE TYPES, ONLY: CFACE_TYPE +USE COMPLEX_GEOMETRY, ONLY: SET_CUTCELLS_3D_FROM_GEOM => SET_CUTCELLS_3D, & + GET_CFACE_INDEX_FROM_GEOM => GET_CFACE_INDEX, & + RANDOM_CFACE_XYZ_FROM_GEOM => RANDOM_CFACE_XYZ, & + POINT_IN_CFACE_FROM_GEOM => POINT_IN_CFACE + +IMPLICIT NONE (TYPE,EXTERNAL) +PRIVATE + +PUBLIC :: GET_CFACE_INDEX, POINT_IN_CFACE, RANDOM_CFACE_XYZ, SET_CUTCELLS_3D + +CONTAINS + +SUBROUTINE SET_CUTCELLS_3D + +CALL SET_CUTCELLS_3D_FROM_GEOM + +END SUBROUTINE SET_CUTCELLS_3D + + +SUBROUTINE GET_CFACE_INDEX(NM,I,J,K,XPT,YPT,ZPT,ICF) + +INTEGER, INTENT(IN) :: NM,I,J,K +REAL(EB),INTENT(IN) :: XPT,YPT,ZPT +INTEGER, INTENT(OUT):: ICF + +CALL GET_CFACE_INDEX_FROM_GEOM(NM,I,J,K,XPT,YPT,ZPT,ICF) + +END SUBROUTINE GET_CFACE_INDEX + + +SUBROUTINE RANDOM_CFACE_XYZ(NM,CFA,CFA_X,CFA_Y,CFA_Z) + +INTEGER, INTENT(IN) :: NM +TYPE(CFACE_TYPE), INTENT(IN) :: CFA +REAL(EB), INTENT(OUT) :: CFA_X,CFA_Y,CFA_Z + +CALL RANDOM_CFACE_XYZ_FROM_GEOM(NM,CFA,CFA_X,CFA_Y,CFA_Z) + +END SUBROUTINE RANDOM_CFACE_XYZ + + +SUBROUTINE POINT_IN_CFACE(NM,XP,YP,ZP,CFACE_INDEX,IN_CFACE) + +REAL(EB), INTENT(IN) :: XP,YP,ZP +INTEGER, INTENT(IN) :: NM,CFACE_INDEX +LOGICAL, INTENT(OUT) :: IN_CFACE + +CALL POINT_IN_CFACE_FROM_GEOM(NM,XP,YP,ZP,CFACE_INDEX,IN_CFACE) + +END SUBROUTINE POINT_IN_CFACE + +END MODULE COMPLEX_GEOMETRY_GRID \ No newline at end of file diff --git a/Source/init.f90 b/Source/init.f90 index 46912a85a91..03b29c985ea 100644 --- a/Source/init.f90 +++ b/Source/init.f90 @@ -2557,7 +2557,7 @@ END SUBROUTINE INITIALIZE_POISSON_SOLVER SUBROUTINE INITIALIZE_DEVICES(NM) -USE COMPLEX_GEOMETRY, ONLY : GET_CFACE_INDEX +USE COMPLEX_GEOMETRY_GRID, ONLY : GET_CFACE_INDEX INTEGER, INTENT(IN) :: NM INTEGER :: III,N,II,JJ,KK,IW,SURF_INDEX,ICF,N_CELLS_INI REAL(EB) :: DEPTH,THICKNESS diff --git a/Source/mesh.f90 b/Source/mesh.f90 index c61f96eb051..2ee0f79069b 100644 --- a/Source/mesh.f90 +++ b/Source/mesh.f90 @@ -266,6 +266,8 @@ MODULE MESH_VARIABLES ! Arrays for special cut-cells: INTEGER :: N_SPCELL=0, N_SPCELL_CF=0 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SPCELL_LIST + INTEGER :: N_SPCELLS_TO_BLOCK=0 + INTEGER, ALLOCATABLE, DIMENSION(:) :: SPCELLS_TO_BLOCK ! Linked face velocity arrays: REAL(EB), ALLOCATABLE, DIMENSION(:) :: EWC_UN_LNK, UN_LNK, UN_ULNK diff --git a/Source/part.f90 b/Source/part.f90 index ad3f015f0b1..bf7d2595927 100644 --- a/Source/part.f90 +++ b/Source/part.f90 @@ -615,7 +615,7 @@ END SUBROUTINE INSERT_VENT_PARTICLES SUBROUTINE PARTICLE_FACE_INSERT(WALL_INDEX,CFACE_INDEX) -USE COMPLEX_GEOMETRY, ONLY : RANDOM_CFACE_XYZ +USE COMPLEX_GEOMETRY_GRID, ONLY : RANDOM_CFACE_XYZ USE PHYSICAL_FUNCTIONS, ONLY: GET_PARTICLE_ENTHALPY USE MEMORY_FUNCTIONS, ONLY: ALLOCATE_STORAGE INTEGER, INTENT(IN), OPTIONAL :: WALL_INDEX,CFACE_INDEX @@ -1821,7 +1821,8 @@ END SUBROUTINE INSERT_ALL_PARTICLES SUBROUTINE MOVE_PARTICLES(T,DT,NM) USE TRAN, ONLY: GET_IJK -USE COMPLEX_GEOMETRY, ONLY: CC_CGSC,CC_FGSC,CC_IDCF,CC_GASPHASE,CC_SOLID,CC_CUTCFE,POINT_IN_CFACE +USE COMPLEX_GEOMETRY, ONLY: CC_CGSC,CC_FGSC,CC_IDCF,CC_GASPHASE,CC_SOLID,CC_CUTCFE +USE COMPLEX_GEOMETRY_GRID, ONLY: POINT_IN_CFACE USE CC_SCALARS, ONLY: CUTFACE_VELOCITIES USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT USE PHYSICAL_FUNCTIONS, ONLY: EMBER_IGNITION_MODEL From 04c94cf255f650bb30391376d0d99f8ee2c0ff75 Mon Sep 17 00:00:00 2001 From: Marcos Vanella Date: Wed, 25 Mar 2026 09:33:33 -0400 Subject: [PATCH 02/18] FDS Source: WIP, move SET_CUTCELLS_3D to COMPLEX_GEOMETRY_GRID. --- Source/ccib.f90 | 18 +- Source/geom.f90 | 45823 +++++++++++++++++++++++----------------------- 2 files changed, 22927 insertions(+), 22914 deletions(-) diff --git a/Source/ccib.f90 b/Source/ccib.f90 index 67db9d0e82c..3b98313d5ea 100644 --- a/Source/ccib.f90 +++ b/Source/ccib.f90 @@ -6,7 +6,23 @@ ! MODULE CC_SCALARS -USE COMPLEX_GEOMETRY, SET_CUTCELLS_3D_FROM_GEOM => SET_CUTCELLS_3D +USE COMPLEX_GEOMETRY, ONLY: BLOCK_CC_SOLID_EXTWALLCELLS,GEOFCT,CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,CCGUARD, & + CC_MATVEC_DEFINED,GEOMEPS,DELTA_INT,DELTA_VERT,DIST_THRES,GET_CARTCELL_CUTCELLS_TIME_INDEX, & + CC_SOLID,CC_VGSC,CC_CGSC,CC_FGSC,CC_IDCF,CC_UNKZ,CC_GASPHASE,CC_CUTCFE,CC_IDRC,CC_FTYPE_CFGAS, & + CC_FTYPE_CFINB,CC_FTYPE_RGGAS,CC_IDCC,CC_EGSC,CC_IDCE,CC_INBOUNDARY,CC_UNDEFINED,CC_UNKH,CC_UNKF, & + FDS_AREA_GEOM,INDEX_UNDEFINED,INIT_CFACE_CELL,INT_N_EXT_PTS,INT_P_IND,INT_TMP_IND,INT_VEL_IND, & + INT_RHO_IND,INT_H_IND,INT_RSUM_IND,INT_MU_IND,INT_MUDNS_IND,INT_RHO0_IND,INT_WCEN_IND,INT_VELS_IND, & + CC_ETYPE_EP,CC_ETYPE_SCINB,CC_FTYPE_SVERT,CC_ETYPE_RCGAS,CC_ETYPE_RGGAS,CC_ETYPE_CFGAS,CC_FTYPE_RCGAS, & + CC_FTYPE_CCGAS,GET_REGULAR_CUT_EDGES_BC,GET_SOLID_CUTCELL_EDGES_BC,LOOSEPS,LU_SETCC,MAX_INTERP_POINTS, & + MESH_CC_EXCHANGE_TIME_INDEX,CCCOMPUTE_RADIATION_TIME_INDEX,CC_DENSITY_TIME_INDEX, & + CC_SET_DATA_TIME_INDEX,INIT_CUTCELL_DATA_TIME_INDEX,CC_VELOCITY_FLUX_TIME_INDEX, & + CC_COMPUTE_VISCOSITY_TIME_INDEX,CC_DIVERGENCE_PART_1_TIME_INDEX,CC_END_STEP_TIME_INDEX, & + CC_NO_FLUX_TIME_INDEX,CC_COMPUTE_VELOCITY_ERROR_TIME_INDEX,NQT2C,N_CUTCELLS_PROC,NGUARD, & + N_INB_CUTFACES_PROC,N_INT_CVARS,N_INT_CCVARS,N_REG_CUTFACES_PROC,N_LINK_ATTMP_F, & + N_SET_CUTCELLS_3D_CALLS,NM_START,N_REQ11,N_REQ12,N_REQ112,N_REQ13,REQ11,REQ112,REQ12,REQ13, & + POINT_IN_POLYGON,SEARCH_OTHER_MESHES_FACE,SET_CUTCELLS_TIME_INDEX,VAL_TESTX_LOW, & + VAL_TESTX_HIGH,VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH,T_CC_USED, & + WRITE_SET_CUTCELLS_TIMINGS USE COMPLEX_GEOMETRY_GRID, ONLY: SET_CUTCELLS_3D USE PRECISION_PARAMETERS USE GLOBAL_CONSTANTS diff --git a/Source/geom.f90 b/Source/geom.f90 index 80ea58a6bab..909825037b9 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -312,156 +312,46 @@ MODULE COMPLEX_GEOMETRY ! End Variable declaration for CC_IBM. ! --------------------------------------------------------------------------------- -PUBLIC :: BLOCK_CC_SOLID_EXTWALLCELLS,GEOFCT,CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,CCGUARD,CC_MATVEC_DEFINED,GEOMEPS,& - DELTA_INT,DELTA_VERT,DEBUG_SET_CUTCELLS,DEBUG_WAIT,DIST_THRES,& - GET_CARTCELL_CUTCELLS_TIME_INDEX,GET_CFACE_INDEX,& - INTERSECT_CONE_AABB,INTERSECT_CYLINDER_AABB,INTERSECT_OBB_AABB,INTERSECT_SPHERE_AABB, & - POINT_IN_CFACE,RANDOM_CFACE_XYZ,& - READ_GEOM,ROTATION_MATRIX, & - WRITE_GEOM,WRITE_GEOM_ALL, & - CC_SOLID,CC_VGSC,CC_CGSC,CC_FGSC,CC_IDCF,CC_UNKZ,CC_GASPHASE,CC_CUTCFE,CC_IDRC,& - CC_FTYPE_CFGAS,CC_FTYPE_CFINB,CC_FTYPE_RGGAS, & - CC_IDCC,CC_EGSC,CC_IDCE,CC_INBOUNDARY,CC_UNDEFINED, & - CC_NCVARS, CC_UNKH, CC_UNKF, FDS_AREA_GEOM, INDEX_UNDEFINED, INIT_CFACE_CELL, INT_N_EXT_PTS, & - INT_P_IND, INT_TMP_IND, INT_VEL_IND, INT_RHO_IND, INT_H_IND, INT_RSUM_IND, INT_MU_IND, INT_MUDNS_IND, INT_RHO0_IND, & - INT_FV_IND, INT_DHDX_IND, INT_WCEN_IND, INT_VELS_IND, CC_ETYPE_EP, CC_ETYPE_SCINB, CC_FTYPE_SVERT, & - CC_ETYPE_RCGAS, CC_ETYPE_RGGAS, CC_ETYPE_CFGAS, & - CC_FTYPE_RCGAS, CC_FTYPE_CCGAS,GET_REGULAR_CUT_EDGES_BC,GET_SOLID_CUTCELL_EDGES_BC,& - LOOSEPS,LU_SETCC,MAX_INTERP_POINTS,& - MESH_CC_EXCHANGE_TIME_INDEX,CCCOMPUTE_RADIATION_TIME_INDEX,CC_DENSITY_TIME_INDEX,& - CC_SET_DATA_TIME_INDEX,INIT_CUTCELL_DATA_TIME_INDEX,& - CC_VELOCITY_FLUX_TIME_INDEX,CC_COMPUTE_VISCOSITY_TIME_INDEX,CC_INTERP_FACE_VEL_TIME_INDEX,& - CC_DIVERGENCE_PART_1_TIME_INDEX,CC_END_STEP_TIME_INDEX,CC_TARGET_VELOCITY_TIME_INDEX,& - CC_NO_FLUX_TIME_INDEX,CC_COMPUTE_VELOCITY_ERROR_TIME_INDEX,MIN_VOL_FACTOR,& - NQT2C,N_CUTCELLS_PROC,NGUARD,N_INB_CUTFACES_PROC,N_INT_CVARS,N_INT_CCVARS,N_REG_CUTFACES_PROC,& - NNZ_ROW_H,N_INT_FVARS,N_LINK_ATTMP_F,N_SET_CUTCELLS_3D_CALLS,NM_START, & - N_REQ11,N_REQ12,N_REQ112,N_REQ13,REQ11,REQ112,REQ12,REQ13, & - IPARM, POINT_IN_POLYGON,SEARCH_OTHER_MESHES_FACE,& - SET_CUTCELLS_TIME_INDEX,SET_CUTCELLS_3D,TRIANGULATE,TRILINEAR, VALID_TRIANGLE, & - VAL_TESTX_LOW,VAL_TESTX_HIGH,VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH, & - T_CC_USED, WRITE_SET_CUTCELLS_TIMINGS, & - MAKE_UNIQUE_VERT_ARRAY, AVERAGE_FACE_VALUES +PUBLIC :: BLOCK_CC_SOLID_EXTWALLCELLS,GEOFCT,CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,CCGUARD,CC_MATVEC_DEFINED, & + GEOMEPS,DELTA_INT,DELTA_VERT,DEBUG_SET_CUTCELLS,DEBUG_WAIT,DIST_THRES, & + GET_CARTCELL_CUTCELLS_TIME_INDEX,BODINT_PLANE_TYPE,INTERSECT_CONE_AABB,INTERSECT_CYLINDER_AABB, & + INTERSECT_OBB_AABB,INTERSECT_SPHERE_AABB,READ_GEOM,ROTATION_MATRIX,WRITE_GEOM,WRITE_GEOM_ALL, & + CC_SOLID,CC_VGSC,CC_CGSC,CC_FGSC,CC_IDCF,CC_UNKZ,CC_GASPHASE,CC_CUTCFE,CC_IDRC,CC_FTYPE_CFGAS, & + CC_FTYPE_CFINB,CC_FTYPE_RGGAS,CC_IDCC,CC_EGSC,CC_IDCE,CC_INBOUNDARY,CC_UNDEFINED,CC_NCVARS, & + CC_UNKH,CC_UNKF,FDS_AREA_GEOM,INDEX_UNDEFINED,INIT_CFACE_CELL,INT_N_EXT_PTS,INT_P_IND,INT_TMP_IND, & + INT_VEL_IND,INT_RHO_IND,INT_H_IND,INT_RSUM_IND,INT_MU_IND,INT_MUDNS_IND,INT_RHO0_IND,INT_FV_IND, & + INT_DHDX_IND,INT_WCEN_IND,INT_VELS_IND,CC_ETYPE_EP,CC_ETYPE_SCINB,CC_FTYPE_SVERT,CC_ETYPE_RCGAS, & + CC_ETYPE_RGGAS,CC_ETYPE_CFGAS,CC_FTYPE_RCGAS,CC_FTYPE_CCGAS,GET_REGULAR_CUT_EDGES_BC, & + GET_SOLID_CUTCELL_EDGES_BC,LOOSEPS,LU_SETCC,MAX_INTERP_POINTS,MESH_CC_EXCHANGE_TIME_INDEX, & + CCCOMPUTE_RADIATION_TIME_INDEX,CC_DENSITY_TIME_INDEX,CC_SET_DATA_TIME_INDEX, & + INIT_CUTCELL_DATA_TIME_INDEX,CC_VELOCITY_FLUX_TIME_INDEX,CC_COMPUTE_VISCOSITY_TIME_INDEX, & + CC_INTERP_FACE_VEL_TIME_INDEX,CC_DIVERGENCE_PART_1_TIME_INDEX,CC_END_STEP_TIME_INDEX, & + CC_TARGET_VELOCITY_TIME_INDEX,CC_NO_FLUX_TIME_INDEX,CC_COMPUTE_VELOCITY_ERROR_TIME_INDEX, & + MIN_VOL_FACTOR,NQT2C,N_CUTCELLS_PROC,NGUARD,N_INB_CUTFACES_PROC,N_INT_CVARS,N_INT_CCVARS, & + N_REG_CUTFACES_PROC,NNZ_ROW_H,N_INT_FVARS,N_LINK_ATTMP_F,N_SET_CUTCELLS_3D_CALLS,NM_START,N_REQ11, & + N_REQ12,N_REQ112,N_REQ13,REQ11,REQ112,REQ12,REQ13,BODINT_PLANE,BODINT_PLANE2,CELLRT,FACERT,XFACE, & + YFACE,ZFACE,XCELL,YCELL,ZCELL,DXFACE,DYFACE,DZFACE,DXCELL,DYCELL,DZCELL,X1FACE,X2FACE,X3FACE, & + X2CELL,X3CELL,DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL,CC_N_CRS,CC_MAXCROSS_X2,CC_SVAR_CRS, & + CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX,CC_IS_CRS2,CC_SEG_TAN,X1NOC,X2NOC,X3NOC, & + SPCELLS_TO_BLOCK,SPCELLS_TO_BLOCK_AUX,N_SPCELLS_TO_BLOCK,IPARM,POINT_IN_POLYGON, & + SEARCH_OTHER_MESHES_FACE,CHECK_WALL_CELL_PLANE_MATCH,CC_INIT_GEOM,ALLOCATE_BODINT_PLANE, & + GET_BODINT_PLANE,GET_X2_INTERSECTIONS,GET_X2_VERTVAR,GET_CARTEDGE_CUTEDGES, & + GET_BODX2_INTERSECTIONS,GET_BODX3_INTERSECTIONS,GET_CARTFACE_CUTEDGES,GET_CARTCELL_CUTEDGES, & + GET_CARTFACE_CUTFACES,GET_CARTCELL_CUTFACES,GET_CARTCELL_CUTCELLS,GET_CELL_LINK_INFO, & + EXCHANGE_CC_NOADVANCE_INFO,BLOCK_SMALL_UNLINKED_CUTCELLS,ALLOC_FACE_STATE_VARS, & + ALLOC_CELL_STATE_VARS,SET_CUTCELLS_TIME_INDEX,TRIANGULATE,TRILINEAR,VALID_TRIANGLE,VAL_TESTX_LOW, & + VAL_TESTX_HIGH,VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH,T_CC_USED, & + WRITE_SET_CUTCELLS_TIMINGS,MAKE_UNIQUE_VERT_ARRAY,AVERAGE_FACE_VALUES,ADIFF_INFO_FACTOR, & + SNAP_DIST_FACTOR,CC_INBOUNDCC,CC_INBOUNDCF,CC_NVVARS,CC_NEVARS,CC_NFVARS,CC_ETYPE_CFINB,NODS_WSEL, & + EDGS_WSEL,NODS_VLEL,GAMMA_MULT,DELTA_TBIN,GLOBAL_DELTA_CELL,GLOBAL_DELTA_EDGE,GLOBAL_DELTA_FACE, & + BLOCKED_SPECIAL_CELL,CC_NEDGECROSS,CC_NCUTEDGE,CC_NCUTFACE,CC_NCUTCELL,ILO_CELL,IHI_CELL,JLO_CELL, & + JHI_CELL,KLO_CELL,KHI_CELL,ILO_FACE,IHI_FACE,JLO_FACE,JHI_FACE,KLO_FACE,KHI_FACE,NXB,NYB,NZB, & + INSERT_CUT_CELL,INSERT_CUT_FACE,CUT_EDGE_ARRAY_REALLOC,NEW_EDGE_ALLOC,CUT_FACE_ARRAY_REALLOC, & + FACE_DEALLOC,NEW_FACE_ALLOC,CUT_CELL_ARRAY_REALLOC,CELL_DEALLOC,NEW_CELL_ALLOC,NOT_BLOCKED, & + BLOCKED_SPLIT_CELL,BLOCKED_REFI_INTER,BLOCKED_CAVITY_CELL CONTAINS -! ----------------------------------- GET_CFACE_INDEX ------------------------------- - -SUBROUTINE GET_CFACE_INDEX(NM,I,J,K,XPT,YPT,ZPT,ICF) - -INTEGER, INTENT(IN) :: NM,I,J,K -REAL(EB),INTENT(IN) :: XPT,YPT,ZPT -INTEGER, INTENT(OUT):: ICF - -! Local Variables: -INTEGER, PARAMETER :: DELTA_IJK = 1 -INTEGER :: ILO, IHI, JLO, JHI, KLO, KHI, II, JJ, KK, ICF2, JCF -REAL(EB):: DIST, DIST_CLOSE -LOGICAL :: CFACE_FOUND - -ICF = 0 -IF(.NOT.ALLOCATED(MESHES(NM)%CCVAR)) RETURN ! Case of NO GEOMs, return and give an error. - - -ILO = MAX(I-DELTA_IJK,1) -IHI = MIN(I+DELTA_IJK,MESHES(NM)%IBAR) - -JLO = MAX(J-DELTA_IJK,1) -JHI = MIN(J+DELTA_IJK,MESHES(NM)%JBAR) - -KLO = MAX(K-DELTA_IJK,1) -KHI = MIN(K+DELTA_IJK,MESHES(NM)%KBAR) - -CFACE_FOUND = .FALSE. -DO KK=KLO,KHI - DO JJ=JLO,JHI - DO II=ILO,IHI - ICF2 = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCF) - IF (ICF2 <= 0) CYCLE - DO JCF=1,MESHES(NM)%CUT_FACE(ICF2)%NFACE - DIST = SQRT( (XPT-MESHES(NM)%CUT_FACE(ICF2)%XYZCEN(IAXIS,JCF))**2._EB + & - (YPT-MESHES(NM)%CUT_FACE(ICF2)%XYZCEN(JAXIS,JCF))**2._EB + & - (ZPT-MESHES(NM)%CUT_FACE(ICF2)%XYZCEN(KAXIS,JCF))**2._EB ) - IF (.NOT.CFACE_FOUND) THEN - ICF = MESHES(NM)%CUT_FACE(ICF2)%CFACE_INDEX(JCF) - DIST_CLOSE = DIST - CFACE_FOUND = .TRUE. - ELSE - IF (DIST > DIST_CLOSE) CYCLE - ICF = MESHES(NM)%CUT_FACE(ICF2)%CFACE_INDEX(JCF) - DIST_CLOSE = DIST - ENDIF - ENDDO - ENDDO - ENDDO -ENDDO -! WRITE(LU_ERR,*) 'Found device location=',I,J,K,ICF,CFACE(ICF)%X,CFACE(ICF)%Y,CFACE(ICF)%Z - -RETURN -END SUBROUTINE GET_CFACE_INDEX - - -! --------------------------------- RANDOM_CFACE_XYZ ------------------------------- - -SUBROUTINE RANDOM_CFACE_XYZ(NM,CFA,CFA_X,CFA_Y,CFA_Z) - -INTEGER, INTENT(IN) :: NM -TYPE(CFACE_TYPE), INTENT(IN) :: CFA -REAL(EB), INTENT(OUT) :: CFA_X,CFA_Y,CFA_Z - -! Local Variables: -INTEGER :: IND1, IND2, ITRI, N_TRI, INOD_2, INOD_3 -REAL(EB):: RN, RN_I, E1, E2, E3, V12(IAXIS:KAXIS), V13(IAXIS:KAXIS) - -IND1 = CFA%CUT_FACE_IND1 -IND2 = CFA%CUT_FACE_IND2 - -! Number of triangles that will cover the boundary cut-face convex polygon is same as NVERT for the cut-face: -N_TRI= MESHES(NM)%CUT_FACE(IND1)%CFELEM(1,IND2) - -! First pick randomly one triangle weighting by area: -CALL RANDOM_NUMBER(RN) -RN_I = 0._EB -CFTRI_LOOP : DO ITRI=1,N_TRI - ! Compute triangle Area: - ! INOD_1 is polygon centroid, CFA%X, CFA%Y, CFA%Z - ! VERTEX locations: - ! Vertex 2 and 3 of triangle in local CFELEM indexing - INOD_2 = ITRI - INOD_3 = 1; IF (ITRI /= N_TRI) INOD_3 = ITRI+1 - ! Vertex 2 and 3 of traingle in XYZVERT indexing - INOD_2 = MESHES(NM)%CUT_FACE(IND1)%CFELEM(1+INOD_2,IND2) - INOD_3 = MESHES(NM)%CUT_FACE(IND1)%CFELEM(1+INOD_3,IND2) - - ! Compute triangles Area / AreaTOT for CFACE polygon: - V12(IAXIS:KAXIS) = (/ MESHES(NM)%CUT_FACE(IND1)%XYZVERT(IAXIS,INOD_2)-BOUNDARY_COORD(CFA%BC_INDEX)%X, & - MESHES(NM)%CUT_FACE(IND1)%XYZVERT(JAXIS,INOD_2)-BOUNDARY_COORD(CFA%BC_INDEX)%Y, & - MESHES(NM)%CUT_FACE(IND1)%XYZVERT(KAXIS,INOD_2)-BOUNDARY_COORD(CFA%BC_INDEX)%Z /) - V13(IAXIS:KAXIS) = (/ MESHES(NM)%CUT_FACE(IND1)%XYZVERT(IAXIS,INOD_3)-BOUNDARY_COORD(CFA%BC_INDEX)%X, & - MESHES(NM)%CUT_FACE(IND1)%XYZVERT(JAXIS,INOD_3)-BOUNDARY_COORD(CFA%BC_INDEX)%Y, & - MESHES(NM)%CUT_FACE(IND1)%XYZVERT(KAXIS,INOD_3)-BOUNDARY_COORD(CFA%BC_INDEX)%Z /) - - RN_I = RN_I + 0.5_EB/CFA%AREA * SQRT( (V12(JAXIS)*V13(KAXIS)-V12(KAXIS)*V13(JAXIS))**2 + & - (V12(KAXIS)*V13(IAXIS)-V12(IAXIS)*V13(KAXIS))**2 + & - (V12(IAXIS)*V13(JAXIS)-V12(JAXIS)*V13(IAXIS))**2 ) - IF (RN_I > RN) EXIT CFTRI_LOOP -ENDDO CFTRI_LOOP - -! Randomly define natural coordinates for the triangle: -CALL RANDOM_NUMBER(E2) -CALL RANDOM_NUMBER(E3) -E3 = (1._EB-E2)*E3 -E1 = 1._EB-E2-E3 - -! Compute physical coordinates of point: -BC => MESHES(NM)%BOUNDARY_COORD(CFA%BC_INDEX) -CFA_X = E1*BC%X+E2*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(IAXIS,INOD_2)+E3*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(IAXIS,INOD_3) -CFA_Y = E1*BC%Y+E2*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(JAXIS,INOD_2)+E3*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(JAXIS,INOD_3) -CFA_Z = E1*BC%Z+E2*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(KAXIS,INOD_2)+E3*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(KAXIS,INOD_3) - -RETURN -END SUBROUTINE RANDOM_CFACE_XYZ - - ! ----------------------------- GET_CARTCELL_CFACE_LIST ---------------------------- ! SUBROUTINE GET_CARTCELL_CFACE_LIST(I,J,K,ICF_START,NCFACE) @@ -652,26074 +542,26091 @@ SUBROUTINE POINT_IN_POLYGON(PT,CFELEM_SIZE,CFELEM,NVERT,IAXLOC,JAXLOC,XYZVERT,IN END SUBROUTINE POINT_IN_POLYGON -! --------------------------- POINT_IN_CFACE ------------------------------------ - -SUBROUTINE POINT_IN_CFACE(NM,XP,YP,ZP,CFACE_INDEX,IN_CFACE) +! ---------------------------- SET_CUTCELLS_3D ------------------------------------- -REAL(EB), INTENT(IN) :: XP,YP,ZP -INTEGER, INTENT(IN) :: NM,CFACE_INDEX -LOGICAL, INTENT(OUT) :: IN_CFACE -! Local Variables -INTEGER :: INBFC,INBFC_LOC,VERT_CUTFACE,NVERT,X1AXIS,X2AXIS,X3AXIS -REAL(EB), POINTER, DIMENSION(:) :: NVEC -INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM -REAL(EB):: ANVEC(MAX_DIM),P0(MAX_DIM),A,B,C,D,PROJ_COEFF,XYZ_P(MAX_DIM),PTCEN(IAXIS:JAXIS),I_SGN !,ATEST +! ----------------------- CHECK_WALL_CELL_PLANE_MATCH ---------------------------- -INBFC = CFACE(CFACE_INDEX)%CUT_FACE_IND1 -INBFC_LOC = CFACE(CFACE_INDEX)%CUT_FACE_IND2 +SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH -! Normal, max normal component, define plane X2AXIS,X3AXIS to do search: -VERT_CUTFACE = SIZE(MESHES(NM)%CUT_FACE(INBFC)%CFELEM, DIM=1); ALLOCATE(CFELEM(1:VERT_CUTFACE)) -CFELEM(1:VERT_CUTFACE) = MESHES(NM)%CUT_FACE(INBFC)%CFELEM(1:VERT_CUTFACE,INBFC_LOC) -NVEC(IAXIS:KAXIS) => MESHES(NM)%BOUNDARY_COORD(CFACE(CFACE_INDEX)%BC_INDEX)%NVEC(IAXIS:KAXIS) +! Routine checks that external boundaries match among neighboring meshes. This is not strictly enforced +! by FDS but is required to compute same cut-cells on mesh ghost-cells and other mesh internal cells. -! Plane equation for INBOUNDARY cut-face plane: -! Location of first point in cf polygon is P0: -P0(IAXIS:KAXIS) = MESHES(NM)%CUT_FACE(INBFC)%XYZVERT(IAXIS:KAXIS,CFELEM(2)) -A = NVEC(IAXIS) -B = NVEC(JAXIS) -C = NVEC(KAXIS) -D = -(A*P0(IAXIS) + B*P0(JAXIS) + C*P0(KAXIS)) -! Project XP,YP,ZP point into plane of cf polygon: -PROJ_COEFF = (A*XP+B*YP+C*ZP) + D ! /dot(n,n) = 1 -XYZ_P(IAXIS:KAXIS) = (/XP,YP,ZP/) - PROJ_COEFF*NVEC(IAXIS:KAXIS) +USE MPI_F08 -! Which Cartesian plane we project to? -ANVEC(IAXIS) = ABS(NVEC(IAXIS)); ANVEC(JAXIS) = ABS(NVEC(JAXIS)); ANVEC(KAXIS) = ABS(NVEC(KAXIS)) -IF ( MAX(ANVEC(IAXIS),MAX(ANVEC(JAXIS),ANVEC(KAXIS))) == ANVEC(IAXIS) ) THEN - X1AXIS = IAXIS; X2AXIS = JAXIS; X3AXIS = KAXIS -ELSEIF ( MAX(ANVEC(IAXIS),MAX(ANVEC(JAXIS),ANVEC(KAXIS))) == ANVEC(JAXIS) ) THEN - X1AXIS = JAXIS; X2AXIS = KAXIS; X3AXIS = IAXIS -ELSE - X1AXIS = KAXIS; X2AXIS = IAXIS; X3AXIS = JAXIS -ENDIF -PTCEN(IAXIS:JAXIS) = XYZ_P( (/ X2AXIS, X3AXIS /) ) +! Local variables: +INTEGER :: NM,NOM,IW,IOR,IERR +REAL(EB):: XM,XOM,MSIZE +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BUFF +TYPE(WALL_TYPE), POINTER :: WC +TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC +TYPE(MESH_TYPE), POINTER :: M2 -NVERT = SIZE(MESHES(NM)%CUT_FACE(INBFC)%XYZVERT,DIM=2) -I_SGN = SIGN(1._EB,NVEC(X1AXIS)) -CALL POINT_IN_POLYGON(PTCEN,VERT_CUTFACE,CFELEM,NVERT,X2AXIS,X3AXIS,MESHES(NM)%CUT_FACE(INBFC)%XYZVERT,IN_CFACE) +ALLOCATE(BUFF(2,NMESHES)); BUFF=0 +MESH_LP : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + EXT_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS + WC=>WALL(IW); IF (WC%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY) CYCLE EXT_WALL_LOOP_1 + EWC=>EXTERNAL_WALL(IW) + BC =>BOUNDARY_COORD(WC%BC_INDEX) + IOR = BC%IOR; NOM = EWC%NOM; IF(NOM<1 .OR. NOM==NM) CYCLE EXT_WALL_LOOP_1 + M2 => MESHES(NOM) + SELECT CASE(IOR) + CASE( IAXIS); XM=X(0); XOM=M2%X(M2%IBAR); MSIZE=X(IBAR)-X(0) ! Low X for mesh NM, high X for mesh NOM + CASE(-IAXIS); XM=X(IBAR); XOM=M2%X(0) ; MSIZE=X(IBAR)-X(0) ! High X for mesh NM, low X for mesh NOM + CASE( JAXIS); XM=Y(0); XOM=M2%Y(M2%JBAR); MSIZE=Y(JBAR)-Y(0) ! Low Y for mesh NM, high Y for mesh NOM + CASE(-JAXIS); XM=Y(JBAR); XOM=M2%Y(0) ; MSIZE=Y(JBAR)-Y(0) ! High Y for mesh NM, low Y for mesh NOM + CASE( KAXIS); XM=Z(0); XOM=M2%Z(M2%KBAR); MSIZE=Z(KBAR)-Z(0) ! Low Z for mesh NM, high Z for mesh NOM + CASE(-KAXIS); XM=Z(KBAR); XOM=M2%Z(0) ; MSIZE=Z(KBAR)-Z(0) ! High Z for mesh NM, low Z for mesh NOM + END SELECT + IF(ABS(XM-XOM)>10._EB*GEOMEPS .AND. ABS(XM-XOM)<0.5_EB*MSIZE) THEN + BUFF(1:2,NM) = (/NM,NOM/) + CYCLE MESH_LP + ENDIF + ENDDO EXT_WALL_LOOP_1 +ENDDO MESH_LP -! ATEST = MESHES(NM)%CUT_FACE(INBFC)%AREA(INBFC_LOC)*ANVEC(X1AXIS) -! CALL POINT_IN_POLYGON(PTCEN,VERT_CUTFACE,CFELEM,NVERT,X2AXIS,X3AXIS,& -! MESHES(NM)%CUT_FACE(INBFC)%XYZVERT,IN_CFACE,ATEST=ATEST) +! Now All-Reduce mismatch +CALL MPI_ALLREDUCE(MPI_IN_PLACE,BUFF(1,1),2*NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) -DEALLOCATE(CFELEM) +DO NM=1,NMESHES + IF(BUFF(1,NM)>0) THEN ! First Mismatched meshes found. + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A,I5,A,I5,A)') "ERROR(734): Mismatched mesh boundary location between meshes ",BUFF(1,NM),& + " and ",BUFF(2,NM),". Check your mesh MULT line. Mesh boundary locations must strictly match with &GEOM." + ENDIF + DEALLOCATE(BUFF) + CALL SHUTDOWN("") ; RETURN + ENDIF +ENDDO +DEALLOCATE(BUFF) +END SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH -RETURN -END SUBROUTINE POINT_IN_CFACE +! ----------------------- EXCHANGE_CC_NOADVANCE_INFO ---------------------------- +SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO -! ---------------------------- SET_CUTCELLS_3D ------------------------------------- + USE MPI_F08 -SUBROUTINE SET_CUTCELLS_3D -USE MPI_F08 -USE TRAN, ONLY : TRANS + ! Local Variables: + INTEGER :: NM,NOM,N,IERR,I,J,K,ICC,JCC + TYPE(MESH_TYPE), POINTER :: M + TYPE (MPI_REQUEST), ALLOCATABLE, DIMENSION(:) :: REQ0,REQ0DUM + INTEGER :: N_REQ0 + LOGICAL :: PROCESS_SENDREC -! Local indexes: -INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI -INTEGER :: I,J,K,KK -INTEGER :: X1AXIS, X2AXIS, X3AXIS -INTEGER :: XIAXIS, XJAXIS, XKAXIS -INTEGER :: X2LO, X2HI, X3LO, X3HI -INTEGER :: X2LO_CELL, X2HI_CELL, X3LO_CELL, X3HI_CELL -INTEGER :: ISTR, IEND, JSTR, JEND, KSTR, KEND -INTEGER :: NM, NOM + ! Define cut-cells to be blocked for exchange: + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + ! Count cut-cells for blocking in mesh: + M%N_CC_BLOCKED = 0 + DO ICC=1,MESHES(NM)%N_CUTCELL_MESH + CC => CUT_CELL(ICC) + DO JCC=1,CC%NCELL + IF(CC%NOADVANCE(JCC)>0) M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 + ENDDO + ENDDO + IF (M%N_CC_BLOCKED>0) THEN + IF(ALLOCATED(M%XYZ_CC_BLOCKED)) DEALLOCATE(M%XYZ_CC_BLOCKED) + IF(ALLOCATED(M%JBT_CC_BLOCKED)) DEALLOCATE(M%JBT_CC_BLOCKED) + ALLOCATE(M%XYZ_CC_BLOCKED(3,M%N_CC_BLOCKED)) + ALLOCATE(M%JBT_CC_BLOCKED(2,M%N_CC_BLOCKED)) + ! Fill in blocked cut-cell info: + M%N_CC_BLOCKED = 0 + DO ICC=1,MESHES(NM)%N_CUTCELL_MESH + CC => CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + DO JCC=1,CC%NCELL + IF(CC%NOADVANCE(JCC)>0) THEN + M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 + M%XYZ_CC_BLOCKED(1:3,M%N_CC_BLOCKED) = (/XC(I),YC(J),ZC(K)/) + M%JBT_CC_BLOCKED(1:2,M%N_CC_BLOCKED) = (/JCC,CC%NOADVANCE(JCC)/) + ENDIF + ENDDO + ENDDO + ENDIF + ENDDO -! Miscellaneous: -REAL(EB), DIMENSION(MAX_DIM) :: PLNORMAL -INTEGER, DIMENSION(MAX_DIM) :: INDX1 -REAL(EB) :: X1PLN, X3RAY -LOGICAL :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY -INTEGER :: NCUTFACE_IAXIS, NCUTFACE_JAXIS, NCUTFACE_KAXIS, ICE1, ICF1, NFACE, IERR, & - NCUTEDGE_IBCC, NCUTEDGE_IBCF -REAL(EB):: CF_AREA_IAXIS=0._EB, CF_AREA_JAXIS=0._EB, CF_AREA_KAXIS=0._EB, & - CF_INXAREA_IAXIS=0._EB,CF_INXAREA_JAXIS=0._EB,CF_INXAREA_KAXIS=0._EB, & - CF_INXSQAREA_IAXIS=0._EB,CF_INXSQAREA_JAXIS=0._EB,CF_INXSQAREA_KAXIS=0._EB, & - CF_JNYSQAREA_IAXIS=0._EB,CF_JNYSQAREA_JAXIS=0._EB,CF_JNYSQAREA_KAXIS=0._EB, & - CF_KNZSQAREA_IAXIS=0._EB,CF_KNZSQAREA_JAXIS=0._EB,CF_KNZSQAREA_KAXIS=0._EB -REAL(EB):: SLEN_GEOM, AREA_GEOM, VOLUME_GEOM, SLEN_IBCC, SLEN, DV(MAX_DIM), XYZCEN_GEOM(MAX_DIM), & - DM_XYZCEN(MAX_DIM), CCGP_XYZCEN(MAX_DIM), DM_XYZCEN_AUX(MAX_DIM), CCGP_XYZCEN_AUX(MAX_DIM) -INTEGER :: SEG(NOD1:NOD2), NEDGE, IEDGE, IFACE, IG - -INTEGER :: NCUTFACE_INB, ICC1, ICC2, NCELL, IGC, ICF2, JCF2, JCF, FTYPE, ILH, CELL_BLOCK_IOR -REAL(EB):: CF_AREA_INB=0._EB, CF_INXAREA_INB=0._EB, CF_INXSQAREA_INB=0._EB, & - CF_JNYSQAREA_INB=0._EB, CF_KNZSQAREA_INB=0._EB, CF_AREA_INB_AUX=0._EB, ACRT -REAL(EB):: CC_VOLUME_INB=0._EB, DM_VOLUME=0._EB, GP_VOLUME=0._EB, & - CC_VOLUME_INB_AUX=0._EB, DM_VOLUME_AUX=0._EB, GP_VOLUME_AUX=0._EB -INTEGER, DIMENSION(5) :: MIN_CC_IJK_ICCJCC, MAX_CC_IJK_ICCJCC -REAL(EB):: MIN_CC_VOL, MAX_CC_VOL, MIN_ALPHA_CV, MAX_ALPHA_CV -LOGICAL, ALLOCATABLE, DIMENSION(:) :: CC_COMPUTE_MESH, CC_COMPUTE_MESH_AUX -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_ZMAX_AUX - -INTEGER :: IW,II,JJ,IIF,JJF,KKF,IIOF,JJOF,KKOF,LOHIF,IOR,CT,NCFACE_CUTCELL,NFACE_CELL,AX,SIDE,ICC,JCC,ICFC,IFC -TYPE(MESH_TYPE), POINTER :: M, M2 -TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC -TYPE(WALL_TYPE), POINTER :: WC -TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME -INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) -INTEGER :: IIO,JJO,KKO,IOGC,JOGC,KOGC - -REAL(EB) :: TNOW - -LOGICAL :: WRITE_CFACE_STATS = .FALSE. -LOGICAL :: EARLY_RETURN_FROM_SET_CUTCELLS - -INTEGER, SAVE :: CALL_COUNT = 0 - -! GET_CUTCELL_VERBOSE variables: -INTEGER :: IPROC, NMESH_CC, NMESH_CC_AUX, TAG -TYPE (MPI_STATUS) :: MPISTATUS -CHARACTER(MESSAGE_LENGTH) :: VERBOSE_FILE, VERBOSE_FILE_AUX -CHARACTER(1), DIMENSION(3), PARAMETER :: AXSTR(1:3) = (/ 'X', 'Y', 'Z' /) -REAL(EB) :: CPUTIME, CPUTIME_START, CPUTIME_MESH, CPUTIME_START_MESH -INTEGER :: MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL, SUM_FACE, SUM_CCELL=0 -TYPE(CFACE_TYPE), POINTER :: CFA -REAL(EB), ALLOCATABLE, DIMENSION(:) :: GEOM_AREA_SURF -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW -INTEGER, ALLOCATABLE, DIMENSION(:) :: GEOM_SURF -INTEGER :: ICF, SURF_INDEX, SUM_CC, IDIM - -LOGICAL, SAVE :: FIRST_CALL_ARG=.TRUE., FIRST_CALL_ARG2=.TRUE. - -REAL(EB):: VERT_AUX(IAXIS:KAXIS),CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) -INTEGER :: ING,INOD,IWSEL,IEL,FACE_AUX(NOD1:NOD3),VOL_AUX(NOD1:NOD4),N_SPCELLCF_TOT,N_SPCELL_TOT -CHARACTER(100) :: FILENAME - -CALL CC_GRID_GLOBAL_INIT -IF (STOP_STATUS==SETUP_STOP) RETURN - -CALL CC_GRID_ALLOCATE_BUILD_SCRATCH - -! Main Loop over Meshes: -MAIN_MESH_LOOP : DO NM=1,NMESHES - CALL CC_GRID_BUILD_CUTCELL_MESH(NM) - IF (STOP_STATUS==SETUP_STOP) RETURN -ENDDO MAIN_MESH_LOOP - -CALL CC_GRID_RELEASE_BUILD_SCRATCH - -POSTBUILD_MESH_LOOP : DO NM=1,NMESHES - CALL CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) - IF (STOP_STATUS==SETUP_STOP) RETURN -ENDDO POSTBUILD_MESH_LOOP - -CALL CC_GRID_EXCHANGE_AND_REBLOCK - -MAIN_MESH_LOOP_3 : DO NM=1,NMESHES - CALL CC_GRID_POSTPROCESS_AND_CLEANUP(NM) -ENDDO MAIN_MESH_LOOP_3 - -! Finally allocate Face and cell variables, compute area and volume factors: -MAIN_MESH_LOOP_4 : DO NM=1,NMESHES - CALL CC_GRID_ALLOCATE_STATE_VARS(NM) -ENDDO MAIN_MESH_LOOP_4 - -CALL CC_GRID_LOG_PROCESSING_TIME - -CALL CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST - -! Fill Guardcells for CCVAR CC_CGSC and CUT_CELL for meshes assigned to MPI process: -CALL SET_GC_CUTCELLS_3D - -! Allocate and define entries for solid side CFACES: -IF(PERIODIC_TEST/=105) CALL GET_EXT_INB_CUTFACES_TO_CFACE - -CALL CC_GRID_FINALIZE_BOOKKEEPING(EARLY_RETURN_FROM_SET_CUTCELLS) -IF (EARLY_RETURN_FROM_SET_CUTCELLS) RETURN + ! MPI Exchange: + IF (N_MPI_PROCESSES>1) THEN + ALLOCATE(REQ0(NMESHES)); N_REQ0 = 0 + ! Exchange number of cut-cells information to be exchanged between MESH and OMESHES: + ! Receive from neighbors: + DO NM=1,NMESHES + DO NOM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + PROCESS_SENDREC = .FALSE. + DO N=1,MESHES(NM)%N_NEIGHBORING_MESHES + IF (NOM==MESHES(NM)%NEIGHBORING_MESH(N)) PROCESS_SENDREC = .TRUE. + ENDDO + IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NM)/=MY_RANK .AND. PROCESS_SENDREC) THEN + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_IRECV(MESHES(NM)%N_CC_BLOCKED,1,MPI_INTEGER,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + ENDIF + ENDDO + ENDDO + ! Send to neighbors: + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + DO NOM=1,NMESHES + PROCESS_SENDREC = .FALSE. + DO N=1,MESHES(NOM)%N_NEIGHBORING_MESHES + IF (NM==MESHES(NOM)%NEIGHBORING_MESH(N)) PROCESS_SENDREC = .TRUE. + ENDDO + IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NOM)/=MY_RANK .AND. PROCESS_SENDREC) THEN + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_ISEND(MESHES(NM)%N_CC_BLOCKED,1,MPI_INTEGER,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + ENDIF + ENDDO + ENDDO + IF (N_REQ0>0) CALL MPI_WAITALL(N_REQ0,REQ0(1:N_REQ0),MPI_STATUSES_IGNORE,IERR) -CALL CC_GRID_WRITE_VERBOSE_SUMMARY + ! At this point values of MESHES(NM)%N_CC_BLOCKED are populated for PROCESSSED and NEIGNBORING meshes. + DO NM=1,NMESHES + IF (PROCESS(NM)==MY_RANK) CYCLE ! already done for this mesh at the beginning of the routine. + IF(MESHES(NM)%N_CC_BLOCKED>0) THEN + IF(ALLOCATED(MESHES(NM)%XYZ_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED) + IF(ALLOCATED(MESHES(NM)%JBT_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%JBT_CC_BLOCKED) + ALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED(3,MESHES(NM)%N_CC_BLOCKED)) + ALLOCATE(MESHES(NM)%JBT_CC_BLOCKED(2,MESHES(NM)%N_CC_BLOCKED)) + ENDIF + ENDDO -RETURN + ! Exchange blocked cutcells lists: + ! Receive from neighbors: + N_REQ0 = 0 + DO NM=1,NMESHES + DO NOM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + PROCESS_SENDREC = .FALSE. + DO N=1,MESHES(NM)%N_NEIGHBORING_MESHES + IF (NOM==MESHES(NM)%NEIGHBORING_MESH(N) .AND. MESHES(NM)%N_CC_BLOCKED>0) PROCESS_SENDREC=.TRUE. + ENDDO + IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NM)/=MY_RANK .AND. PROCESS_SENDREC) THEN + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_IRECV(MESHES(NM)%XYZ_CC_BLOCKED(1,1),3*MESHES(NM)%N_CC_BLOCKED,& + MPI_DOUBLE_PRECISION,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_IRECV(MESHES(NM)%JBT_CC_BLOCKED(1,1),2*MESHES(NM)%N_CC_BLOCKED,& + MPI_INTEGER,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + ENDIF + ENDDO + ENDDO + ! Send to neighbors: + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + DO NOM=1,NMESHES + PROCESS_SENDREC = .FALSE. + DO N=1,MESHES(NOM)%N_NEIGHBORING_MESHES + IF (NM==MESHES(NOM)%NEIGHBORING_MESH(N) .AND. MESHES(NM)%N_CC_BLOCKED>0) PROCESS_SENDREC=.TRUE. + ENDDO + IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NOM)/=MY_RANK .AND. PROCESS_SENDREC) THEN + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_ISEND(MESHES(NM)%XYZ_CC_BLOCKED(1,1),3*MESHES(NM)%N_CC_BLOCKED,& + MPI_DOUBLE_PRECISION,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_ISEND(MESHES(NM)%JBT_CC_BLOCKED(1,1),2*MESHES(NM)%N_CC_BLOCKED,& + MPI_INTEGER,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + ENDIF + ENDDO + ENDDO + IF (N_REQ0>0) CALL MPI_WAITALL(N_REQ0,REQ0(1:N_REQ0),MPI_STATUSES_IGNORE,IERR) -CONTAINS + ! Deallocate REQ0: + IF(ALLOCATED(REQ0)) DEALLOCATE(REQ0) + ENDIF -SUBROUTINE CC_GRID_GLOBAL_INIT + CONTAINS + SUBROUTINE CHECK_REQ0_SIZE + IF(N_REQ0>SIZE(REQ0,DIM=1)) THEN + ALLOCATE(REQ0DUM(SIZE(REQ0,DIM=1)+NMESHES)) + REQ0DUM(1:N_REQ0-1) = REQ0(1:N_REQ0-1) + CALL MOVE_ALLOC(REQ0DUM,REQ0) + ENDIF + END SUBROUTINE CHECK_REQ0_SIZE -IF (MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN - WRITE(LU_ERR,*) ' ' - WRITE(LU_ERR,*) 'SET_CUTCELLS_3D : Cut-Cell computation in VERBOSE mode, 4 tasks to perform:' -ENDIF + END SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO -! Reset variables: -CC_NEDGECROSS = 0 -CC_NCUTEDGE = 0 -CC_NCUTFACE = 0 -CC_NCUTCELL = 0 +! ----------------------- BLOCK_SMALL_UNLINKED_CUTCELLS ---------------------------- -! Check Meshes Boundaries match, requirement to get consistent ghost and internal cut-cells. -CALL CHECK_WALL_CELL_PLANE_MATCH; IF (STOP_STATUS==SETUP_STOP) RETURN +SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS(NM,NBLKCELLS) -! Get geometry triangle bins in Cartesian directions: -CALL GET_GEOM_TRIBIN +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(OUT):: NBLKCELLS -! Snap to grid planes node positions in the work volume of this process: -CALL SNAP_GEOM_NODES +INTEGER :: ICC,JCC,I,J,K,IFC,IEC,JEC,IVR,DUM,NSEG,ISEG,JFC,INOD1,INOD2,X1AXIS,COUNT,NCELL +TYPE(MESH_TYPE), POINTER :: M +CHARACTER(100) :: FILENAME -! Initialize GEOMETRY fields used by CC_IBM: -CALL CC_INIT_GEOM; IF (STOP_STATUS==SETUP_STOP) RETURN +M => MESHES(NM) +NBLKCELLS = 0 -TNOW=CURRENT_TIME() +IF(DEBUG_SET_CUTCELLS) THEN -DEBUG_SET_CUTCELLS_COND : IF (DEBUG_SET_CUTCELLS) THEN - ! Write meshes file: - WRITE(FILENAME,'(A,A)') TRIM(CHID),'_meshes.dat' + ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges1.dat' OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8)') NMESHES - MESH_LOOP : DO NM=1,NMESHES - - IF (PROCESS(NM)/=MY_RANK) CYCLE - - ! Mesh sizes: - NXB=MESHES(NM)%IBAR - NYB=MESHES(NM)%JBAR - NZB=MESHES(NM)%KBAR - - WRITE(33,'(4I8,6F24.16)') NM,NXB,NYB,NZB,MESHES(NM)%X(0),MESHES(NM)%X(NXB),& - MESHES(NM)%Y(0),MESHES(NM)%Y(NYB),& - MESHES(NM)%Z(0),MESHES(NM)%Z(NZB) - DO I=0,NXB - WRITE(33,'(4F24.16)') MESHES(NM)%X(I),MESHES(NM)%XC(I),MESHES(NM)%DXN(I),MESHES(NM)%DX(I) + WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH + DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH + CE=>MESHES(NM)%CUT_EDGE(IEC) + WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) + DO IVR=1,CE%NVERT + WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) ENDDO - DO J=0,NYB - WRITE(33,'(4F24.16)') MESHES(NM)%Y(J),MESHES(NM)%YC(J),MESHES(NM)%DYN(J),MESHES(NM)%DY(J) + DO IVR=1,CE%NVERT + WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) ENDDO - DO K=0,NZB - WRITE(33,'(4F24.16)') MESHES(NM)%Z(K),MESHES(NM)%ZC(K),MESHES(NM)%DZN(K),MESHES(NM)%DZ(K) + DO JEC=1,CE%NEDGE + WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) ENDDO - - ENDDO MESH_LOOP + DO JEC=1,CE%NEDGE + WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& + CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) + ENDDO + ENDDO CLOSE(33) - ! Write geometry files: - WRITE(FILENAME,'(A,A)') TRIM(CHID),'_num_geometries.dat' + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces1.dat' OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I6,4F24.16)') N_GEOMETRY, GEOMEPS + WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH + DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 + IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 + WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) + DO IVR=1,CF%NVERT + WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(I6,I6)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) + DO DUM=1,CF%CFELEM(1,JFC) + WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) + ENDDO + DO DUM=1,CF%CEDGES(1,JFC) + WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) + ENDDO + ENDDO + DO ISEG=1,NSEG + WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) + ENDDO + ENDDO CLOSE(33) - GEOM_LOOP : DO ING=1,N_GEOMETRY +ENDIF - ! Write Vertices: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_verts.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO INOD=1,GEOMETRY(ING)%N_VERTS - VERT_AUX(IAXIS:KAXIS) = GEOMETRY(ING)%VERTS(MAX_DIM*(INOD-1)+1:MAX_DIM*INOD) - WRITE(33,'(3F24.16)') VERT_AUX(IAXIS:KAXIS) +! Create new cut-edges and faces: +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + JCC_LOOP : DO JCC=1,M%CUT_CELL(ICC)%NCELL + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP + NBLKCELLS = NBLKCELLS + 1 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,1) + ENDDO JCC_LOOP ENDDO - CLOSE(33) + ENDDO +ENDDO - ! Write faces: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_faces.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IWSEL=1,GEOMETRY(ING)%N_FACES - FACE_AUX(NOD1:NOD3)=GEOMETRY(ING)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) - WRITE(33,'(4I10)') FACE_AUX(NOD1:NOD3),GEOMETRY(ING)%SURFS(IWSEL) +! Drop cut-edges and faces that were gas or boundary of blocked cells. +COUNT=0 +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + NCELL = M%CUT_CELL(ICC)%NCELL + JCC_LOOP_2 : DO JCC=1,NCELL + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_2 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,2) + ENDDO JCC_LOOP_2 ENDDO - CLOSE(33) + ENDDO +ENDDO - ! Write Volumes: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_volus.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_VOLUS - VOL_AUX(NOD1:NOD4)=GEOMETRY(ING)%VOLUS(NODS_VLEL*(IEL-1)+1:NODS_VLEL*IEL) - WRITE(33,'(4I10)') VOL_AUX(NOD1:NOD4) +! Drop blocked cells: +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + NCELL = M%CUT_CELL(ICC)%NCELL + JCC_LOOP_3 : DO JCC=NCELL,1,-1 + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_3 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,3) + ENDDO JCC_LOOP_3 ENDDO - CLOSE(33) + ENDDO +ENDDO +! Build remaining Regular shaped GASPHASE cut-faces: +CALL GET_REMAINING_CUTFACES(NM) +! Build remaining Regular shaped GASPHASE cut-cells: +CALL GET_REMAINING_CUTCELLS(NM) +! Clean up CUT_CELL, CUT_FACE arrays: +CALL CUT_CELL_FACE_ARRAYS_CLEANUP(NM) - ! Write Edges: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edges.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_EDGES - WRITE(33,'(2I10)') GEOMETRY(ING)%EDGES(NOD1:NOD2,IEL) +IF(DEBUG_SET_CUTCELLS) THEN + ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges2.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH + DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH + CE=>MESHES(NM)%CUT_EDGE(IEC) + WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) + DO IVR=1,CE%NVERT + WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) ENDDO - CLOSE(33) + DO IVR=1,CE%NVERT + WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& + CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) + ENDDO + ENDDO + CLOSE(33) - ! Write FACE_EDGES: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_fcedg.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_FACES - WRITE(33,'(3I10)') GEOMETRY(ING)%FACE_EDGES(NOD1:NOD3,IEL) + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces2.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH + DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 + IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 + WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) + DO IVR=1,CF%NVERT + WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) ENDDO - CLOSE(33) + DO JFC=1,CF%NFACE + WRITE(33,'(I8,I8)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) + DO DUM=1,CF%CFELEM(1,JFC) + WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) + ENDDO + DO DUM=1,CF%CEDGES(1,JFC) + WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) + ENDDO + ENDDO + DO ISEG=1,NSEG + WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) + ENDDO + ENDDO + CLOSE(33) - ! Write EDGE_FACES: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edfac.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_EDGES - WRITE(33,'(5I10)') GEOMETRY(ING)%EDGE_FACES(NOD1:NOD4+1,IEL) + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeECVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%ECVAR(I,J,K,CC_EGSC,IAXIS),& + M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) + DO X1AXIS=IAXIS,KAXIS + IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN + IEC=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) + IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT EDGE does not match ECVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE + DO JEC=1,CE%NEDGE + INOD1=CE%CEELEM(NOD1,JEC) + INOD2=CE%CEELEM(NOD2,JEC) + WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) + WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) + IF(CE%VERT_LIST(1,INOD1)==CE%VERT_LIST(1,INOD2) .AND. & + CE%VERT_LIST(2,INOD1)==CE%VERT_LIST(2,INOD2) .AND. & + CE%VERT_LIST(3,INOD1)==CE%VERT_LIST(3,INOD2) .AND. & + CE%VERT_LIST(4,INOD1)==CE%VERT_LIST(4,INOD2)) THEN + IF(CE%VERT_LIST(1,INOD1)/=CC_VTYPE_NINB) & + WRITE(LU_ERR,*) 'Edge with same node types=',IEC,JEC,CE%NEDGE,CE%XYZVERT(:,INOD1),& + CE%XYZVERT(:,INOD2),CE%VERT_LIST(1:4,INOD1) + ENDIF + ENDDO + ENDIF + ENDDO + ENDDO ENDDO - CLOSE(33) + ENDDO + CLOSE(33) - ENDDO GEOM_LOOP -ENDIF DEBUG_SET_CUTCELLS_COND + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + DO X1AXIS=IAXIS,KAXIS + IF(M%FCVAR(I,J,K,CC_IDCE,X1AXIS)>0)THEN + IEC=M%FCVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) + IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT EDGE does not match FCVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE + DO JEC=1,CE%NEDGE + INOD1=CE%CEELEM(NOD1,JEC) + INOD2=CE%CEELEM(NOD2,JEC) + WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) + WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CLOSE(33) -! Select MESHES assigned to MY_RANK and OMESHES of these. Cut-cells computed for all of them. Done in GET_GEOM_TRIBIN -IF (GET_CUTCELLS_VERBOSE) THEN - NMESH_CC=0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH(NOM)) NMESH_CC = NMESH_CC + 1 + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaceFCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%FCVAR(I,J,K,CC_FGSC,IAXIS),& + M%FCVAR(I,J,K,CC_FGSC,JAXIS),M%FCVAR(I,J,K,CC_FGSC,KAXIS) + DO X1AXIS=IAXIS,KAXIS + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)==CC_CUTCFE)THEN + IEC=M%FCVAR(I,J,K,CC_IDCF,X1AXIS); CF=>M%CUT_FACE(IEC) + IF(CF%IJK(IAXIS)/=I .OR. CF%IJK(JAXIS)/=J .OR. CF%IJK(KAXIS)/=K .OR. CF%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT FACE does not match FCVAR',I,J,K,X1AXIS,':',CF%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE + DO JEC=1,CF%NFACE + WRITE(33,'(I8,3F16.8,F16.8)') CF%IJK(4),CF%XYZCEN(:,JEC),CF%AREA(JEC) + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO ENDDO - ! MY_RANK = 0 writes first: - IF (MY_RANK==0) THEN - ! Open file to write SET_CUTCELLS_3D progress: - WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' - OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') - WRITE(LU_ERR,*) ' ' - WRITE(LU_ERR,*) '2. Generate Cut-cells in Meshes :' - WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC, & - ' meshes in file ',TRIM(VERBOSE_FILE),'.' - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' - WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC,' meshes.' - WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' - WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process : ' - NMESH_CC_AUX = 0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH(NOM)) THEN - NMESH_CC_AUX = NMESH_CC_AUX + 1 - IF(NMESH_CC_AUX < NMESH_CC) THEN - WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' - WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' - ELSE - WRITE(LU_ERR,'(I4.4,A)') NOM,'.' - WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' + CLOSE(33) + + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutcellCCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8)') I,J,K,M%CCVAR(I,J,K,CC_CGSC) + IF(M%CCVAR(I,J,K,CC_CGSC)==CC_CUTCFE)THEN + IEC=M%CCVAR(I,J,K,CC_IDCC); CC=>M%CUT_CELL(IEC) + IF(CC%IJK(IAXIS)/=I .OR. CC%IJK(JAXIS)/=J .OR. CC%IJK(KAXIS)/=K) & + WRITE(LU_ERR,*) 'CUT CELL does not match CCVAR',I,J,K,':',CC%IJK(IAXIS:KAXIS) + WRITE(33,'(I8,I8,I8,I8,I8)') CC%IJK(1:3),CC%NCELL + DO JEC=1,CC%NCELL + WRITE(33,'(I8,3F16.8,F16.8)') JEC,CC%XYZCEN(:,JEC),CC%VOLUME(JEC) + ENDDO ENDIF - ENDIF - ENDDO - ENDIF - IF (N_MPI_PROCESSES > 1) THEN - IF (MY_RANK==0) ALLOCATE(CC_COMPUTE_MESH_AUX(1:NMESHES)) - ! Now rest of processes pass their mesh info to process 0: - DO IPROC=1,N_MPI_PROCESSES-1 - TAG = 0 - IF (MY_RANK==IPROC) THEN ! Send CC_COMPUTE_MESH array. - TAG=IPROC - CALL MPI_SEND(CC_COMPUTE_MESH(1),NMESHES,MPI_LOGICAL,0,TAG,MPI_COMM_WORLD,IERR) - ! Open file to write SET_CUTCELLS_3D progress: - WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' - OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' - WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC,' meshes.' - WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process :' - NMESH_CC_AUX = 0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH(NOM)) THEN - NMESH_CC_AUX = NMESH_CC_AUX + 1 - IF ( NMESH_CC_AUX < NMESH_CC ) THEN - WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' - ELSE - WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' - ENDIF - ENDIF - ENDDO - ELSEIF (MY_RANK==0) THEN ! Receive CC_COMPUTE_MESH array and write. - TAG=IPROC - CALL MPI_RECV(CC_COMPUTE_MESH_AUX(1),NMESHES,MPI_LOGICAL,IPROC,TAG,MPI_COMM_WORLD,MPISTATUS,IERR) - ! Write to LU_ERR: - NMESH_CC=0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH_AUX(NOM)) NMESH_CC = NMESH_CC + 1 - ENDDO - WRITE(VERBOSE_FILE_AUX,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',IPROC,'.log' - WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC, & - ' meshes in file ',TRIM(VERBOSE_FILE_AUX),'.' - WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' - NMESH_CC_AUX = 0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH_AUX(NOM)) THEN - NMESH_CC_AUX = NMESH_CC_AUX + 1 - IF ( NMESH_CC_AUX < NMESH_CC ) THEN - WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' - ELSE - WRITE(LU_ERR,'(I4.4,A)') NOM,'.' - ENDIF - ENDIF - ENDDO - ENDIF - CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) + ENDDO ENDDO - IF (MY_RANK==0) DEALLOCATE(CC_COMPUTE_MESH_AUX) - ENDIF - CALL CPU_TIME(CPUTIME_START_MESH) -ENDIF - -IF(N_GEOMETRY>0) THEN - ALLOCATE(GEOM_AREA_SURF_OLD(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_OLD=0._EB - ALLOCATE(GEOM_AREA_SURF_NEW(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_NEW=0._EB -ENDIF - -END SUBROUTINE CC_GRID_GLOBAL_INIT - -SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH - -! Allocate BODINT_PLANE for plane intersections on X1AXIS loop: -IF(PERIODIC_TEST/=7 .AND. PERIODIC_TEST/=11) THEN - CALL ALLOCATE_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) ! To be used in SET_CUTCELLS_3D, GET_CARTCELL_CUTFACES. - CALL ALLOCATE_BODINT_PLANE(BODINT_PLANE2,FIRST_CALL_ARG2) ! To be used in GET_IS_SOLID_3D. + ENDDO + CLOSE(33) ENDIF -! Allocate Intersection variables: -ALLOCATE(CC_SVAR_CRS(CC_MAXCROSS_X2),CC_IS_CRS(CC_MAXCROSS_X2),CC_SEG_CRS(CC_MAXCROSS_X2)) -ALLOCATE(CC_BDNUM_CRS(0:CC_MAXCROSS_X2),CC_BDNUM_CRS_AUX(0:CC_MAXCROSS_X2)) -ALLOCATE(CC_IS_CRS2(LOW_IND:HIGH_IND+1,CC_MAXCROSS_X2),CC_SEG_TAN(IAXIS:JAXIS,CC_MAXCROSS_X2)) - -END SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH - -SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH - -CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE) -CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE2) - -! Deallocate Intersection variables: -DEALLOCATE(CC_SVAR_CRS,CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX,CC_IS_CRS2,CC_SEG_TAN) +RETURN +END SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS -END SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH +! ------------------------- GET_REMAINING_CUTCELLS -------------------------------- -SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH(NM) +SUBROUTINE GET_REMAINING_CUTCELLS(NM) +! Define regular cut-cells for regular cartesian cells surrounded by a gas cut-face. INTEGER, INTENT(IN) :: NM -IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. -IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 +! Local Variables: +INTEGER :: I,J,K,CT,X1AXIS,SIDE,ICC,JCC,IFACE,ICF,JCF,ICFC,ICFINB,NCFACE_CUTCELL,NCELL,NFACE_CELL +INTEGER :: NCC_MESH,NGC_MESH,NCELL_IN,NCELL_GC,COUNT_CC,COUNT_GC +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME +INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX +LOGICAL, PARAMETER :: OPT=.TRUE. -CALL POINT_TO_MESH(NM) M => MESHES(NM) -! Mesh sizes: -NXB=IBAR -NYB=JBAR -NZB=KBAR -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) -CALL CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) - -REGCC_REGION_IF : IF(PERIODIC_TEST==7 .OR. PERIODIC_TEST==11) THEN +! First thing is, for known cut-cells with reg faces that have changed to cut-faces to change the +! FACE_LIST incidence: +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_CUTCFE) CYCLE + ICC=M%CCVAR(I,J,K,CC_IDCC) + CC=>M%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + DO ICF=2,CC%CCELEM(1,JCC)+1 + IFACE = CC%CCELEM(ICF,JCC) + SIDE = CC%FACE_LIST(2,IFACE) + X1AXIS= CC%FACE_LIST(3,IFACE) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE + ICFC = M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS) + IF(ICFC>0) CC%FACE_LIST(:,IFACE) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) ! New cut-face. + ENDDO + ENDDO + ENDDO + ENDDO +ENDDO - CALL GET_REGULAR_CUTCELLS_BOX +IF (OPT) THEN -ELSE +NCC_MESH = M%N_CUTCELL_MESH +NGC_MESH = M%N_GCCUTCELL_MESH - ! Do Loop for different x1 planes: - X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS +! First count how many new cells are goint to be created inside, and in ghost cell region: +NCELL_IN=0 +NCELL_GC=0 +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE + ! Test for gas cut-faces: + CT=0 + IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + IF(K<1 .OR. K>M%KBAR .OR. J<1 .OR. J>M%JBAR .OR. I<1 .OR. I>M%IBAR) THEN + NCELL_GC = NCELL_GC + 1 + ELSE + NCELL_IN = NCELL_IN + 1 + ENDIF + ENDDO + ENDDO +ENDDO - SELECT CASE(X1AXIS) - CASE(IAXIS) +! Reset CCVAR, CELL_LIST indexes: +DO K=-CCGUARD,M%KBAR+CCGUARD + DO J=-CCGUARD,M%JBAR+CCGUARD + DO I=-CCGUARD,M%IBAR+CCGUARD + ! All GC cut-cells get their index + NCELL_IN + IF(M%CCVAR(I,J,K,CC_IDCC)<=NCC_MESH) CYCLE + M%CCVAR(I,J,K,CC_IDCC)=M%CCVAR(I,J,K,CC_IDCC) + NCELL_IN + ENDDO + ENDDO +ENDDO +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + DO JCF=1,M%CUT_FACE(ICF)%NFACE + IF(M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>NCC_MESH) & + M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + NCELL_IN + IF(M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>NCC_MESH) & + M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + NCELL_IN + ENDDO +ENDDO - PLNORMAL = (/ 1._EB, 0._EB, 0._EB/) - ILO = ILO_FACE-CCGUARD; IHI = IHI_FACE+CCGUARD - JLO = JLO_FACE; JHI = JLO_FACE - KLO = KLO_FACE; KHI = KLO_FACE +! Make space for NCELL_IN, NCELL_GC cut-cell entries. +ALLOCATE(CUT_CELL_AUX( MAX(SIZE(M%CUT_CELL,DIM=1),NCC_MESH + NCELL_IN +NGC_MESH + NCELL_GC) )) +CUT_CELL_AUX(1:NCC_MESH) = M%CUT_CELL(1:NCC_MESH) +CUT_CELL_AUX(NCC_MESH+NCELL_IN+1:NCC_MESH+NCELL_IN+NGC_MESH) = M%CUT_CELL(NCC_MESH+1:NCC_MESH+NGC_MESH) +CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL); M=> MESHES(NM) - ! x2, x3 axes parameters: - X2AXIS = JAXIS; X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD - X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD +! Then build new regular cut-cells: +COUNT_CC = 0 +COUNT_GC = 0 +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE + ! Test for gas cut-faces: + CT=0 + IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS - - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(ISTR:IEND),DX1FACE(ISTR:IEND)) - X1FACE = XFACE; DX1FACE = DXFACE - ALLOCATE(X2FACE(JSTR:JEND),DX2FACE(JSTR:JEND)) - X2FACE = YFACE; DX2FACE = DYFACE - ALLOCATE(X3FACE(KSTR:KEND),DX3FACE(KSTR:KEND)) - X3FACE = ZFACE; DX3FACE = DZFACE - - ! x2 cell center parameters: - X2LO_CELL = JLO_CELL-CCGUARD; X2HI_CELL = JHI_CELL+CCGUARD - ALLOCATE(X2CELL(JSTR:JEND),DX2CELL(JSTR:JEND)) - X2CELL = YCELL; DX2CELL = DYCELL - - ! x3 cell center parameters: - X3LO_CELL = KLO_CELL-CCGUARD; X3HI_CELL = KHI_CELL+CCGUARD - ALLOCATE(X3CELL(KSTR:KEND),DX3CELL(KSTR:KEND)) - X3CELL = ZCELL; DX3CELL = DZCELL - - CASE(JAXIS) + ! Count allocation number for faces boundary of this cut-cell: + CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT - PLNORMAL = (/ 0._EB, 1._EB, 0._EB/) - ILO = ILO_FACE; IHI = ILO_FACE - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - KLO = KLO_FACE; KHI = KLO_FACE + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - ! x2, x3 axes parameters: - X2AXIS = KAXIS; X2LO = KLO_FACE-CCGUARD; X2HI = KHI_FACE+CCGUARD - X3AXIS = IAXIS; X3LO = ILO_FACE-CCGUARD; X3HI = IHI_FACE+CCGUARD + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO X1AXIS=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND + ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS + ! Add INB cut-face if any present: + IF(ICFINB>0) THEN + DO JCF=1,M%CUT_FACE(ICFINB)%NFACE + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDDO + ENDIF - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(JSTR:JEND),DX1FACE(JSTR:JEND)) - X1FACE = YFACE; DX1FACE = DYFACE - ALLOCATE(X2FACE(KSTR:KEND),DX2FACE(KSTR:KEND)) - X2FACE = ZFACE; DX2FACE = DZFACE - ALLOCATE(X3FACE(ISTR:IEND),DX3FACE(ISTR:IEND)) - X3FACE = XFACE; DX3FACE = DXFACE + ! Insert cut_cell: + IF(K<1 .OR. K>MESHES(NM)%KBAR .OR. J<1 .OR. J>MESHES(NM)%JBAR .OR. I<1 .OR. I>MESHES(NM)%IBAR) THEN + COUNT_GC = COUNT_GC + 1 + ICC = NCC_MESH + NCELL_IN + NGC_MESH + COUNT_GC + ELSE + COUNT_CC = COUNT_CC + 1 + ICC = NCC_MESH + COUNT_CC + ENDIF + CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M%CUT_CELL(ICC)%NCELL = NCELL + M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + M%CUT_CELL(ICC)%NFACE_DROPPED = 0 + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) + M%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) + M%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE + M%CCVAR(I,J,K,CC_IDCC) = ICC + ENDDO + ENDDO +ENDDO - ! x2 cell center parameters: - X2LO_CELL = KLO_CELL-CCGUARD; X2HI_CELL = KHI_CELL+CCGUARD - ALLOCATE(X2CELL(KSTR:KEND),DX2CELL(KSTR:KEND)) - X2CELL = ZCELL; DX2CELL = DZCELL +M%N_CUTCELL_MESH = NCC_MESH + NCELL_IN +M%N_GCCUTCELL_MESH = NGC_MESH + NCELL_GC - ! x3 cell center parameters: - X3LO_CELL = ILO_CELL-CCGUARD; X3HI_CELL = IHI_CELL+CCGUARD - ALLOCATE(X3CELL(ISTR:IEND),DX3CELL(ISTR:IEND)) - X3CELL = XCELL; DX3CELL = DXCELL +ELSE - CASE(KAXIS) +! Then build new regular cut-cells: +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE + ! Test for gas cut-faces: + CT=0 + IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE - PLNORMAL = (/ 0._EB, 0._EB, 1._EB/) - ILO = ILO_FACE; IHI = ILO_FACE - JLO = JLO_FACE; JHI = JLO_FACE - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD + ! Count allocation number for faces boundary of this cut-cell: + CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT - ! x2, x3 axes parameters: - X2AXIS = IAXIS; X2LO = ILO_FACE-CCGUARD; X2HI = IHI_FACE+CCGUARD - X3AXIS = JAXIS; X3LO = JLO_FACE-CCGUARD; X3HI = JHI_FACE+CCGUARD + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO X1AXIS=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND + ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)) - X1FACE = ZFACE; DX1FACE = DZFACE - ALLOCATE(X2FACE(ISTR:IEND),DX2FACE(ISTR:IEND)) - X2FACE = XFACE; DX2FACE = DXFACE - ALLOCATE(X3FACE(JSTR:JEND),DX3FACE(JSTR:JEND)) - X3FACE = YFACE; DX3FACE = DYFACE + ! Add INB cut-face if any present: + IF(ICFINB>0) THEN + DO JCF=1,M%CUT_FACE(ICFINB)%NFACE + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDDO + ENDIF - ! x2 cell center parameters: - X2LO_CELL = ILO_CELL-CCGUARD; X2HI_CELL = IHI_CELL+CCGUARD - ALLOCATE(X2CELL(ISTR:IEND),DX2CELL(ISTR:IEND)) - X2CELL = XCELL; DX2CELL = DXCELL + ! Insert cut_cell: + CALL INSERT_CUT_CELL(NM,I,J,K,ICC); M => MESHES(NM) + CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M%CUT_CELL(ICC)%NCELL = NCELL + M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) + ENDDO + ENDDO +ENDDO - ! x3 cell center parameters: - X3LO_CELL = JLO_CELL-CCGUARD; X3HI_CELL = JHI_CELL+CCGUARD - ALLOCATE(X3CELL(JSTR:JEND),DX3CELL(JSTR:JEND)) - X3CELL = YCELL; DX3CELL = DYCELL +ENDIF - END SELECT +END SUBROUTINE GET_REMAINING_CUTCELLS - ! Variable that states if raytracing is necessary to define segments - ! status in a cartesian face. - ALLOCATE(FACERT(X2LO_CELL:X2HI_CELL,X3LO_CELL:X3HI_CELL)); - ! Stretched grid vars: - X1NOC=TRANS(NM)%NOC(X1AXIS) - X2NOC=TRANS(NM)%NOC(X2AXIS) - X3NOC=TRANS(NM)%NOC(X3AXIS) +! ------------------------- GET_REMAINING_CUTFACES -------------------------------- - IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - IF(X1AXIS < KAXIS) THEN - WRITE(LU_SETCC,'(A,A,A,3I2,A)') ' Computing GEOMs-grid planes intersections for planes in ', & - AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A,A,A,3I2,A)') ' Computing GEOMs-grid planes intersections for planes in ', & - AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' - ENDIF - ELSE - WRITE(LU_SETCC,'(A,A,A,3I2,A)',advance="no") ' Computing GEOMs-grid planes intersections for planes in ', & - AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A,A,A,3I2,A)',advance="no") ' Computing GEOMs-grid planes intersections for planes in ', & - AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' - ENDIF - ENDIF - ENDIF +SUBROUTINE GET_REMAINING_CUTFACES(NM) - ! Loop Coordinate Planes: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI +! Running by axes define regular cut-faces, add to CUT_FACE array. - ! Which Plane? - INDX1(IAXIS:KAXIS) = (/ I, J, K /) - X1PLN = X1FACE(INDX1(X1AXIS)) +INTEGER, INTENT(IN) :: NM - ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: - TRI_ONPLANE_ONLY =.FALSE. - RAYTRACE_X2_ONLY =.FALSE. - FACERT(:,:) =.FALSE. - CALL GET_BODINT_PLANE(X1AXIS,X1PLN,INDX1(X1AXIS),PLNORMAL,X2AXIS,X3AXIS,& - X2LO,X2HI,X3LO,X3HI,X2FACE,X3FACE,X2LO_CELL,& - X2HI_CELL,X3LO_CELL,X3HI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE) +! Local Variables: +INTEGER :: I,J,K,CT,X1AXIS,X2AXIS,X3AXIS,IFC,CEI,CEIF,ICC,JCC,ICE,IEDGE,ILOC,IFACE +INTEGER :: NBD_MESH,NCF_MESH,NGF_MESH,NFC_BND,NFC_MSH,NFC_GCR,CT_BND,CT_MSH,CT_GCR,FCINDEX +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES,EDGE_LIST +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZVERT,XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA +TYPE(MESH_TYPE), POINTER :: M +LOGICAL, PARAMETER :: OPT=.TRUE. - ! Test that there is an intersection: - IF ((BODINT_PLANE%NSGLS+BODINT_PLANE%NSEGS+BODINT_PLANE%NTRIS) == 0) CYCLE +M => MESHES(NM) - ! Drop if node locations outside block plane area: - IF ((X2FACE(X2LO)-MAXVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE - IF ((MINVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))-X2FACE(X2HI)) > GEOMEPS) CYCLE - IF ((X3FACE(X3LO)-MAXVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE - IF ((MINVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))-X3FACE(X3HI)) > GEOMEPS) CYCLE +IF (OPT) THEN - ! IF (GET_CUTCELLS_VERBOSE) THEN - ! WRITE(LU_SETCC,'(I2,A,F14.8,A,3I8)') X1AXIS,', position :',X1PLN, & - ! '; Single Points, Segments, Triangles :', BODINT_PLANE%NSGLS,BODINT_PLANE%NSEGS,BODINT_PLANE%NTRIS - ! IF (MY_RANK==0) & - ! WRITE(LU_ERR ,'(I2,A,F14.8,A,3I8)') X1AXIS,', position :',X1PLN, & - ! '; Single Points, Segments, Triangles :', BODINT_PLANE%NSGLS,BODINT_PLANE%NSEGS,BODINT_PLANE%NTRIS - ! ENDIF +NBD_MESH = M%N_BBCUTFACE_MESH +NCF_MESH = M%N_CUTFACE_MESH +NGF_MESH = M%N_GCCUTFACE_MESH - ! For plane normal to X1AXIS, shoot rays along X2AXIS on all X3AXIS gridline - ! locations, get intersection data: Loop x3 axis locations - DO KK=X3LO,X3HI - - ! x3 location of ray along x2, on the x2-x3 plane: - X3RAY = X3FACE(KK) - - ! Intersections along x2 for X3RAY x3 location: - CALL GET_X2_INTERSECTIONS(X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN) - IF (STOP_STATUS==SETUP_STOP) RETURN - - ! Drop x2 ray if all intersections are outside of the MESH block domain: - IF (CC_N_CRS > 0) THEN - IF ((X2FACE(X2LO)-CC_SVAR_CRS(CC_N_CRS)) > GEOMEPS) THEN - CYCLE - ELSEIF (CC_SVAR_CRS(1)-X2FACE(X2HI) > GEOMEPS) THEN - CYCLE - ENDIF - ENDIF - - ! Highest Z crossing for I,J=KK,INDX1(X1AXIS) location, clip at ZF+DZ(KBAR): - IF(TERRAIN_CASE .AND. X2AXIS==KAXIS .AND. CC_N_CRS>0) & - GEOM_ZMAX_AUX(KK,INDX1(X1AXIS)) = MIN(X2FACE(KBP1),CC_SVAR_CRS(CC_N_CRS)) - - ! Now for this ray, set vertex types in MESHES(NM)%VERTVAR(:,:,:,CC_VGSC): - CALL GET_X2_VERTVAR(X1AXIS,X2LO,X2HI,NM,I,KK) - - ! Now define Crossings on Cartesian Edges and Body segments: - ! Cartesian cut-edges: - CALL GET_CARTEDGE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & - NM,X2LO_CELL,X2HI_CELL,INDX1,KK) - - ! Set segment crossings: - ! This data is defined by plane, add to current: - ! - BODINT_PLANE : Data structure with information for crossings on - ! body segments. - ! % NBCROSS(1:NSEGS) = Number of crossings - ! on the segment. - ! % SVAR(1:NBCROSS,1:NSEGS) = distance from node 1 - ! along the segment. - CALL GET_BODX2_INTERSECTIONS(X2AXIS,X3AXIS,X3RAY) - - ENDDO ! KK - x3 gridlines. - - ! Now for segments not aligned with x3, define - ! intersections with grid line vertices: - CALL GET_BODX3_INTERSECTIONS(X2AXIS,X3AXIS,X2LO,X2HI) - - ! After these loops all segments should contain points from Node1, - ! cross 1, cross 2, ..., Node2, in ascending sbod order. - ! Time to generate the body CC_INBOUNDARY edges on faces and add - ! to MESHES(NM)%CUT_EDGE: - CALL GET_CARTFACE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS, & - XIAXIS,XJAXIS,XKAXIS,NM, & - X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL,& - X3LO_CELL,X3HI_CELL,INDX1,X1PLN) - - ENDDO ! I index - ENDDO ! J index - ENDDO ! K index - - ! Deallocate local plane arrays: - DEALLOCATE(X1FACE,X2FACE,X3FACE,X2CELL,X3CELL) - DEALLOCATE(DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL) - DEALLOCATE(FACERT) - - ENDDO X1AXIS_LOOP - - IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' - IF (MY_RANK==0) WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' - ENDIF - - ! Now Define the INBOUNDARY cut-edge inside Cartesian cells: - CALL GET_CARTCELL_CUTEDGES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) - - ! 1. Cartesian GASPHASE cut-faces: - ! Loops for IAXIS, JAXIS, KAXIS faces: For FCVAR i,j,k, axis - ! - Define Cartesian Boundary Edges indexes. - ! - From ECVAR(i,j,k,IDCE,axis) figure out Entries in CUT_EDGE (GASPHASE segs). - ! - From FCVAR(i,j,k,IDCE,axis) figure out entries in CUT_EDGE (INBOUNDCF segs). - ! - Reorder Edges, figure out if there are disjoint areas present. - ! - Load into CUT_FACE <=> FCVAR(i,j,k,IDCF,axis). - CALL GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.TRUE.) - - ! 2. INBOUNDARY cut-faces: - CALL GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.TRUE.) - - ! Guard-cell Cartesian GASPHASE and INBOUNDARY cut-faces: - CALL GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.FALSE.) - CALL GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.FALSE.) - - ! Finally: Definition of cut-cells: - CELLRT = .FALSE. - MESHES(NM)%N_SPCELL_CF = MESHES(NM)%N_SPCELL - CALL GET_CARTCELL_CUTCELLS(NM) - -ENDIF REGCC_REGION_IF - -CALL CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) -CALL CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -IF (ALLOCATED(CELLRT)) DEALLOCATE(CELLRT) - -END SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH - -SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) - -INTEGER, INTENT(IN) :: NM - -IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. -IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 - -CALL POINT_TO_MESH(NM) -M => MESHES(NM) -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) - -CALL CC_GRID_BLOCK_SPECIAL_CELLS(NM) -CALL CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) - -IF (ONE_CC_PER_CARTESIAN_CELL) THEN - ! Here Block all cells that have volume less (or equal) than the first largest cell found. - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%CUT_CELL(ICC1) - NCELL=0 - DO J=1,CC%NCELL - IF(CC%NOADVANCE(J)==NOT_BLOCKED) NCELL=NCELL+1 - ENDDO - IF(NCELL<2) CYCLE - ! Find if any GEOMETRY related to CC_INBOUNDARY faces has CELL_BLOCK_IOR>0: - CELL_BLOCK_IOR=0; CELL_BLOCK_ORIENTATION = 0._EB - NCELL_LOOP_1 : DO J=1,CC%NCELL - DO I=2,CC%CCELEM(1,J)+1 - IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN - ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) - IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) - IF(IG>0) THEN - IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN - CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION - ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN - CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR - EXIT NCELL_LOOP_1 - ENDIF - ENDIF +! First count EXT Boundary, In meshm and ghost cell region cut-faces: +NFC_BND = 0 +NFC_MSH = 0 +NFC_GCR = 0 +! IAXIS cut-faces: +X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-2,M%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%IBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External + ELSEIF(I==0 .OR. I==M%IBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary ENDIF - ENDDO - ENDDO NCELL_LOOP_1 - ALLOCATE(VOLUME(1:CC%NCELL)); VOLUME(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN - ! Cell Block Orientation: - DO J=1,CC%NCELL; VOLUME(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)); ENDDO - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN - ! Make search for double precision min/max unambiguous. - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS,IAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) - CASE(-JAXIS,JAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) - CASE(-KAXIS,KAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) - END SELECT - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( IAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-JAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( JAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-KAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( KAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - END SELECT - ENDIF - DEALLOCATE(VOLUME) - NCELL_LOOP_2 : DO J=1,CC%NCELL - IF(J==I) CYCLE NCELL_LOOP_2 - IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL - ENDDO NCELL_LOOP_2 + ELSE; NFC_GCR = NFC_GCR + 1 ! External + ENDIF + ENDDO ENDDO -ENDIF - -CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) - -! Here: 1,2. Define Linking information for cut-cells. -CALL GET_CELL_LINK_INFO(NM) - -IF(PROCESS(NM)==MY_RANK) THEN ! Here Add Blocked Areas per SURF_ID: - ALLOCATE(MESHES(NM)%INBCF_AREA(0:MESHES(NM)%IBP1,0:MESHES(NM)%JBP1,0:MESHES(NM)%KBP1)) - DO K=1,M%KBAR - DO J=1,M%JBAR - DO I=1,M%IBAR - ICC = MESHES(NM)%CCVAR(I,J,K,CC_IDCC); IF(ICC<1) CYCLE - CC =>MESHES(NM)%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)<1) CYCLE - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE=CC%CCELEM(IFC,JCC) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE - ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) - ENDDO - ENDDO - ENDDO +ENDDO +! JAXIS cut-faces: +X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS +DO K=-1,M%KBAR+2 + DO J=-2,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%JBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External + ELSEIF(J==0 .OR. J==M%JBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary + ENDIF + ELSE; NFC_GCR = NFC_GCR + 1 ! External + ENDIF ENDDO ENDDO -ENDIF -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) - -END SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH - -SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK - -DO IDIM=1,MAX_DIM - -! Exchange CC%NOADVANCE(JCC)>0 information among NEIGHBOURING meshes: -CALL EXCHANGE_CC_NOADVANCE_INFO -! Add CC%NOADVANCE(JCC) where needed: -CALL ADD_NEIGHBOR_BLOCKED_CELLS - -MAIN_MESH_LOOP_1 : DO NM=1,NMESHES - - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 - - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) - - ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) - - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) - ENDIF +ENDDO +! KAXIS cut-faces: +X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS +DO K=-2,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%KBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External + ELSEIF(K==0 .OR. K==M%KBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary + ENDIF + ELSE; NFC_GCR = NFC_GCR + 1 ! External + ENDIF + ENDDO + ENDDO +ENDDO - ! Block any cells that contain only one gas cut-face (cavity type cut-cells): - K = 0 - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%CUT_CELL(ICC1) - DO J=1,CC%NCELL - SUM_FACE=0; SUM_CCELL=0 - DO I=2,CC%CCELEM(1,J) - SELECT CASE(CC%FACE_LIST(1,CC%CCELEM(I,J))) - CASE(CC_FTYPE_CFGAS); SUM_FACE = SUM_FACE+1 - CASE(CC_FTYPE_RCGAS); SUM_CCELL=SUM_CCELL+1 - END SELECT +! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): +DO K=-CCGUARD,M%KBAR+CCGUARD + DO J=-CCGUARD,M%JBAR+CCGUARD + DO I=-CCGUARD,M%IBAR+CCGUARD + FCINDEX = M%CCVAR(I,J,K,CC_IDCF) + IF(M%CCVAR(I,J,K,CC_IDCF)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(M%CCVAR(I,J,K,CC_IDCF)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + M%CCVAR(I,J,K,CC_IDCF) = FCINDEX + DO X1AXIS=IAXIS,KAXIS + FCINDEX = M%FCVAR(I,J,K,CC_IDCF,X1AXIS) + IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = FCINDEX ENDDO - IF(SUM_FACE>1 .OR. SUM_CCELL>0) CYCLE - IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J)=BLOCKED_CAVITY_CELL - K=K+1 ENDDO ENDDO - IF (K>0) THEN - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) - ENDIF - ENDIF - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -ENDDO MAIN_MESH_LOOP_1 - -! Call tag boundary cut-cells for blocking in refinement interfaces: -CALL TAG_CC_BLOCKING_REFINEMENT - ENDDO - -FINAL_BLOCK_MESH_LOOP : DO NM=1,NMESHES - - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 - - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) - - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - - ! Here: 1,2. Define Linking information for cut-cells. - CALL GET_CELL_LINK_INFO(NM) - - ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) - ENDIF - - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -ENDDO FINAL_BLOCK_MESH_LOOP - -END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK - -SUBROUTINE CC_GRID_POSTPROCESS_AND_CLEANUP(NM) - -INTEGER, INTENT(IN) :: NM - -CALL CC_GRID_RELEASE_BLOCKED_CELL_LISTS(NM) - -IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. -IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 - -CALL POINT_TO_MESH(NM) -M => MESHES(NM) - -! Here Add Areas per SURF_ID: -IF (PROCESS(NM)==MY_RANK) THEN - DO ICF=1,M%N_CUTFACE_MESH - CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE - DO J=1,CF%NFACE - IF(.NOT.CF%BLK_TAG(J)) CYCLE - GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & - GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC => M%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + SELECT CASE(CC%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_RCGAS); CYCLE + CASE DEFAULT + FCINDEX = CC%FACE_LIST(4,IFACE) + IF(CC%FACE_LIST(4,IFACE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(CC%FACE_LIST(4,IFACE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + CC%FACE_LIST(4,IFACE) = FCINDEX + END SELECT ENDDO ENDDO -ENDIF -! Deallocate arrays: -IF (GET_CUTCELLS_VERBOSE) THEN - IF(M%N_CUTCELL_MESH > 0) THEN - MIN_FACES_PER_CUTCELL = 1000000 !HUGE(MIN_FACES_PER_CUTCELL) - MAX_FACES_PER_CUTCELL = 0 - MEAN_FACES_PER_CUTCELL= 0 - SUM_FACE = 0 - SUM_CCELL= 0 - DO ICC1=1,M%N_CUTCELL_MESH - IF (M%CUT_CELL(ICC1)%NCELL==0) CYCLE - SUM_CCELL = SUM_CCELL + M%CUT_CELL(ICC1)%NCELL - DO ICC2=1,M%CUT_CELL(ICC1)%NCELL - MAX_FACES_PER_CUTCELL = MAX(MAX_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) - MIN_FACES_PER_CUTCELL = MIN(MIN_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) - SUM_FACE = SUM_FACE + M%CUT_CELL(ICC1)%CCELEM(1,ICC2) - ENDDO +ENDDO +DO ICE=1,M%N_CUTEDGE_MESH + CE=>M%CUT_EDGE(ICE) + DO IEDGE=1,CE%NEDGE + DO ILOC=-2,2 + FCINDEX = CE%FACE_LIST(1,ILOC,IEDGE) + IF(CE%FACE_LIST(1,ILOC,IEDGE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(CE%FACE_LIST(1,ILOC,IEDGE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + CE%FACE_LIST(1,ILOC,IEDGE) = FCINDEX ENDDO - IF(SUM_CCELL > TWENTY_EPSILON_EB) MEAN_FACES_PER_CUTCELL = SUM_FACE / SUM_CCELL - ! Write to file: - WRITE(LU_SETCC,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& - MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL - IF (MEAN_FACES_PER_CUTCELL > 30) THEN - WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN - WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ENDIF - ! Write to ERR file: - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& - MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL - IF (MEAN_FACES_PER_CUTCELL > 30) THEN - WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN - WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ENDIF - ENDIF - ENDIF - WRITE(LU_SETCC,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' - WRITE(LU_SETCC,'(A)') ' ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' - WRITE(LU_ERR ,'(A)') ' ' - ENDIF -ENDIF + ENDDO +ENDDO -! Here we have to deallocate if no geometric entities were defined: -! EDGE_CROSS is deallocated: -IF (ALLOCATED(M%EDGE_CROSS)) DEALLOCATE(M%EDGE_CROSS) -IF (M%N_CUTEDGE_MESH == 0 .OR. PROCESS(NM)/=MY_RANK) THEN - IF (ALLOCATED(M%CUT_EDGE)) DEALLOCATE(M%CUT_EDGE) -ENDIF -IF (M%N_CUTFACE_MESH+M%N_BBCUTFACE_MESH+M%N_GCCUTFACE_MESH == 0) THEN - IF (ALLOCATED(M%CUT_FACE)) DEALLOCATE(M%CUT_FACE) -ENDIF -IF(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH == 0) THEN - IF (ALLOCATED(M%CUT_CELL)) DEALLOCATE(M%CUT_CELL) -ENDIF +! Reallocate CUT_FACE: +ALLOCATE(CUT_FACE_AUX( MAX(SIZE(MESHES(NM)%CUT_FACE,DIM=1), NCF_MESH+NFC_BND+NFC_MSH + NGF_MESH+NFC_GCR ) )) +CUT_FACE_AUX(1:NBD_MESH) = M%CUT_FACE(1:NBD_MESH) +CUT_FACE_AUX(NBD_MESH+NFC_BND+1:NCF_MESH+NFC_BND) = M%CUT_FACE(NBD_MESH+1:NCF_MESH) +CUT_FACE_AUX(NCF_MESH+NFC_BND+NFC_MSH+1:NCF_MESH+NFC_BND+NFC_MSH+NGF_MESH) = M%CUT_FACE(NCF_MESH+1:NCF_MESH+NGF_MESH) +CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE); M => MESHES(NM) -! Sanity tests on cut-faces, cut-cells: -IF (DEBUG_SET_CUTCELLS) THEN - CUTFACE_TEST_LOOP : DO ICF=1,M%N_CUTFACE_MESH - NFACE = M%CUT_FACE(ICF)%NFACE - I = M%CUT_FACE(ICF)%IJK(IAXIS) - J = M%CUT_FACE(ICF)%IJK(JAXIS) - K = M%CUT_FACE(ICF)%IJK(KAXIS) - X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) - DO I=1,NFACE - IF(M%CUT_FACE(ICF)%AREA(I)M%IBAR) THEN ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ELSEIF(I==0 .OR. I==M%IBAR) THEN ! Block boundary + CT_BND = CT_BND + 1 + IFC = NBD_MESH + CT_BND + ENDIF + ELSE ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR ENDIF - ENDDO - ENDDO CUTFACE_TEST_LOOP - CUTCELL_TEST_LOOP : DO ICF=1,M%N_CUTCELL_MESH - NCELL = M%CUT_CELL(ICF)%NCELL - DO I=1,NCELL - IF(M%CUT_CELL(ICF)%VOLUME(I) MESHES(NM) - -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CF => M%CUT_FACE(ICF); IF(CF%NFACE==0) CYCLE - ICF1=3 ! BLOCK boundary flag, when == 1,2. - IF (CF%STATUS == CC_GASPHASE) THEN - I = CF%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE - J = CF%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE - K = CF%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE - SELECT CASE(CF%IJK(KAXIS+1)) ! X1AXIS - CASE(IAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DY(J)*DZ(K)); IF(I==0 .OR. I==M%IBAR) ICF1=1 - CASE(JAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DZ(K)*DX(I)); IF(J==0 .OR. J==M%JBAR) ICF1=1 - CASE(KAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DX(I)*DY(J)); IF(K==0 .OR. K==M%KBAR) ICF1=1 - END SELECT - ENDIF - CALL ALLOC_FACE_STATE_VARS(NM,ICF,CF%NFACE,ICF1) + ENDDO ENDDO -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC); IF(CC%NCELL==0) CYCLE - I = CC%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE - J = CC%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE - K = CC%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE - CC%ALPHA_CC = SUM(CC%VOLUME(1:CC%NCELL))/(DX(I)*DY(J)*DZ(K)) - CALL ALLOC_CELL_STATE_VARS(NM,ICC,CC%NCELL) +! JAXIS cut-faces: +X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-2,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%JBAR) THEN ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ELSEIF(J==0 .OR. J==M%JBAR) THEN ! Block boundary + CT_BND = CT_BND + 1 + IFC = NBD_MESH + CT_BND + ENDIF + ELSE ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ENDIF + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC + M%CUT_FACE(IFC)%STATUS = CC_GASPHASE + M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) + ENDDO + ENDDO ENDDO -! Allocate array of indexes of chemically active cut-cells -SUM_CC = 0 -DO ICC=1,M%N_CUTCELL_MESH - SUM_CC = SUM_CC + CC%NCELL +! KAXIS cut-faces: +X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS +DO K=-2,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%KBAR) THEN ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ELSEIF(K==0 .OR. K==M%KBAR) THEN ! Block boundary + CT_BND = CT_BND + 1 + IFC = NBD_MESH + CT_BND + ENDIF + ELSE ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ENDIF + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC + M%CUT_FACE(IFC)%STATUS = CC_GASPHASE + M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) + ENDDO + ENDDO ENDDO -ALLOCATE(M%CHEM_ACTIVE_CC(SUM_CC,3)) -M%CHEM_ACTIVE_CC=-1 -END SUBROUTINE CC_GRID_ALLOCATE_STATE_VARS +M%N_BBCUTFACE_MESH = NBD_MESH + NFC_BND +M%N_CUTFACE_MESH = NCF_MESH + NFC_BND + NFC_MSH +M%N_GCCUTFACE_MESH = NGF_MESH + NFC_GCR -SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST +ELSE -! ALL REDUCE areas per surface: -IF(N_GEOMETRY>0) THEN -CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_OLD(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) -CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) -ENDIF -! Define AREA_ADJUST per SURF_ID: -DO J=1,N_GEOMETRY - DO I=0,N_SURF - IF(GEOM_AREA_SURF_NEW(I,J)>TWENTY_EPSILON_EB) THEN - GEOM_AREA_SURF_NEW(I,J) = GEOM_AREA_SURF_OLD(I,J)/GEOM_AREA_SURF_NEW(I,J) - ELSE; GEOM_AREA_SURF_NEW(I,J) = 1._EB - ENDIF +! IAXIS cut-faces: +X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-2,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + ! Insert cut-face in CUT_FACE array: + CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XFACE(I), YCELL(J), ZCELL(K) /); AREA(1) = DYCELL(J)*DZCELL(K) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I,J,K-1,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I,J ,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I,J,K ,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I,J-1,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + ENDDO ENDDO ENDDO -DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE - DO J=1,CF%NFACE - IF(.NOT.CF%BLK_TAG(J)) CYCLE - CF%AREA_ADJUST(J) = CF%AREA_ADJUST(J)*GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + +! JAXIS cut-faces: +X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-2,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + ! Insert cut-face in CUT_FACE array: + CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) ENDDO ENDDO - DEALLOCATE(MESHES(NM)%INBCF_AREA) ENDDO -! GEOM_AREA_SURF_NEW = 0._EB -! DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX -! DO ICF=1,MESHES(NM)%N_CUTFACE_MESH -! CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE -! DO J=1,CF%NFACE -! IF(.NOT.CF%BLK_TAG(J)) CYCLE -! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & -! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) -! ENDDO -! ENDDO -! ENDDO -! CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW,(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) -! DO J=1,N_GEOMETRY -! DO I=0,N_SURF -! IF(MY_RANK==0) WRITE(LU_ERR,*) 'IG,N_SURF,AOLD,ANEW=',J,I,GEOM_AREA_SURF_OLD(I,J),GEOM_AREA_SURF_NEW(I,J) -! ENDDO -! ENDDO -IF(ALLOCATED(GEOM_AREA_SURF_OLD)) DEALLOCATE(GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) - -END SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST - -SUBROUTINE CC_GRID_LOG_PROCESSING_TIME - -! Add to SET_CUTCELLS_3D loop time: -T_CC_USED(SET_CUTCELLS_TIME_INDEX) = T_CC_USED(SET_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW +! KAXIS cut-faces: +X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS +DO K=-2,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + ! Insert cut-face in CUT_FACE array: + CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + ENDDO + ENDDO +ENDDO -IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_MESH) - WRITE(LU_SETCC,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' - WRITE(LU_SETCC,'(A)') ' ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' - WRITE(LU_ERR,'(A)') ' ' - ENDIF ENDIF -END SUBROUTINE CC_GRID_LOG_PROCESSING_TIME - -SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING(EARLY_RETURN) +END SUBROUTINE GET_REMAINING_CUTFACES -LOGICAL, INTENT(OUT) :: EARLY_RETURN -EARLY_RETURN = .FALSE. +! ---------------------- CUT_CELL_FACE_ARRAYS_CLEANUP ----------------------------- -IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) +SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP(NM) -IF(GET_CUTCELLS_VERBOSE) THEN - WRITE(LU_SETCC,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' - WRITE(LU_SETCC,'(A)') ' ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' - WRITE(LU_ERR ,'(A)') ' ' - ENDIF -ENDIF +INTEGER, INTENT(IN) :: NM -! Write out: -! Increase SET_CUTCELLS_3D call counter by 1: -CALL_COUNT = CALL_COUNT + 1 -IF(PERIODIC_TEST==105) THEN - CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) - IF(CALL_COUNT > 1) THEN - EARLY_RETURN = .TRUE. - RETURN - ENDIF -ENDIF +INTEGER, ALLOCATABLE, DIMENSION(:) :: CCIND,CFIND,AUXV +INTEGER :: I,J,K,X1AXIS,ICC,JCC,IFC,IFACE,ICF,JCF,IFC1,CT,CTC,CTF,ILH,& + N_CUTCELL_MESH_NEW,N_GCCUTCELL_MESH_NEW,N_CUTFACE_MESH_NEW,N_GCCUTFACE_MESH_NEW,N_BBCUTFACE_MESH_NEW,& + NEDG,IEDG,LOHI,DIR,ICE +TYPE(MESH_TYPE), POINTER :: M +M => MESHES(NM) +ALLOCATE(CCIND(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH),CFIND(M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH)); CCIND=0; CFIND=0 -END SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING +! Count cut-cells and face entries with NCELL, NFACE > 0: +CTC=0; N_CUTCELL_MESH_NEW=0; N_GCCUTCELL_MESH_NEW=0 +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + IF(M%CUT_CELL(ICC)%NCELL<1) CYCLE + CTC=CTC+1 + CCIND(ICC) = CTC + IF (ICC<=M%N_CUTCELL_MESH) THEN; N_CUTCELL_MESH_NEW = N_CUTCELL_MESH_NEW + 1 + ELSE; N_GCCUTCELL_MESH_NEW = N_GCCUTCELL_MESH_NEW + 1; ENDIF +ENDDO +CTF=0; N_CUTFACE_MESH_NEW=0; N_GCCUTFACE_MESH_NEW=0; N_BBCUTFACE_MESH_NEW=0 +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + IF(M%CUT_FACE(ICF)%NFACE<1) CYCLE + CTF=CTF+1 + CFIND(ICF) = CTF + IF (ICF<=M%N_BBCUTFACE_MESH) N_BBCUTFACE_MESH_NEW = N_BBCUTFACE_MESH_NEW + 1 + IF (ICF<=M%N_CUTFACE_MESH) THEN; N_CUTFACE_MESH_NEW = N_CUTFACE_MESH_NEW + 1 + ELSE; N_GCCUTFACE_MESH_NEW = N_GCCUTFACE_MESH_NEW + 1; ENDIF +ENDDO -SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY +! Move Cut-cells to new location, NCELL=0 entries are dropped: +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + IF(M%CUT_CELL(ICC)%NCELL<1 .OR. ICC==CCIND(ICC)) CYCLE + CALL CUT_CELL_MOVE(M%CUT_CELL(ICC),M%CUT_CELL(CCIND(ICC))) +ENDDO +M%N_CUTCELL_MESH = N_CUTCELL_MESH_NEW +M%N_GCCUTCELL_MESH = N_GCCUTCELL_MESH_NEW -! Loop over geometry: -CCVERBOSE_COND : IF(GET_CUTCELLS_VERBOSE) THEN - SLEN_GEOM = 0._EB; AREA_GEOM = 0._EB; VOLUME_GEOM = 0._EB; XYZCEN_GEOM(IAXIS:KAXIS) = 0._EB - DO IG=1,N_GEOMETRY - ! Add length of wet surface edges: - DO IEDGE=1,GEOMETRY(IG)%N_EDGES - SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IEDGE) - DV(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - & - GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) - SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) - SLEN_GEOM = SLEN_GEOM + SLEN - ENDDO - ! Add to wet surface Areas: - AREA_GEOM = AREA_GEOM + GEOMETRY(IG)%GEOM_AREA - ! Add to GEOMETRY volume: - VOLUME_GEOM = VOLUME_GEOM + GEOMETRY(IG)%GEOM_VOLUME - ! Add to XYZCEN for geometries: - XYZCEN_GEOM(IAXIS:KAXIS)= XYZCEN_GEOM(IAXIS:KAXIS) + GEOMETRY(IG)%GEOM_VOLUME * GEOMETRY(IG)%GEOM_XYZCEN(IAXIS:KAXIS) - ENDDO - IF(N_GEOMETRY > 0) XYZCEN_GEOM(IAXIS:KAXIS)=XYZCEN_GEOM(IAXIS:KAXIS)/VOLUME_GEOM +! Now Cut-faces: +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + IF(M%CUT_FACE(ICF)%NFACE<1 .OR. ICF==CFIND(ICF)) CYCLE + CALL CUT_FACE_MOVE(M%CUT_FACE(ICF),M%CUT_FACE(CFIND(ICF))) +ENDDO +M%N_CUTFACE_MESH = N_CUTFACE_MESH_NEW +M%N_GCCUTFACE_MESH = N_GCCUTFACE_MESH_NEW +M%N_BBCUTFACE_MESH = N_BBCUTFACE_MESH_NEW - ! Loop over meshes: - NCUTFACE_INB = 0 - CF_AREA_INB=0._EB - CC_VOLUME_INB=0._EB - GP_VOLUME=0._EB - DM_XYZCEN(IAXIS:KAXIS) = 0._EB - CCGP_XYZCEN(IAXIS:KAXIS) = 0._EB - TESTS_MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - DO ICF1 = 1,MESHES(NM)%N_CUTFACE_MESH - IF (CUT_FACE(ICF1)%STATUS == CC_INBOUNDARY) THEN - NFACE = CUT_FACE(ICF1)%NFACE - CF_AREA_INB = CF_AREA_INB + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - ENDIF +! Finally fix ICC and ICF in CCVAR, FCVAR, CELL_LIST and FACE_LIST arrays +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC=>M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS); + M%CCVAR(I,J,K,CC_IDCC) = ICC; + DO JCC=1,CC%NCELL + ALLOCATE(AUXV(CC%CCELEM(1,JCC))); AUXV = 0 + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + AUXV(IFC) = 1 + IF ( .NOT.(CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB .OR. & + CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) ) CYCLE + IFC1 = CC%FACE_LIST(4,IFACE) + CC%FACE_LIST(4,IFACE) = 0; IF(IFC1>0) CC%FACE_LIST(4,IFACE) = CFIND(IFC1) + IF(CC%FACE_LIST(4,IFACE)<1) AUXV(IFC) = 0 ENDDO - DO ICC1 = 1,MESHES(NM)%N_CUTCELL_MESH - NCELL = CUT_CELL(ICC1)%NCELL - DO ICC2=1,NCELL - CCGP_XYZCEN(IAXIS:KAXIS) = CCGP_XYZCEN(IAXIS:KAXIS) + CUT_CELL(ICC1)%VOLUME(ICC2) * & - CUT_CELL(ICC1)%XYZCEN(IAXIS:KAXIS,ICC2) - IF (CUT_CELL(ICC1)%VOLUME(ICC2)0) THEN + ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 + DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE + DO DUM=1,COUNT + IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & + BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT ENDDO + IF(DUM > COUNT) THEN ! No match in previous loop DUM=COUNT+1 + BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) + COUNT = DUM + ENDIF + AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) + ENDDO + IF (COUNT>0) THEN + ! Now set IBOD, ITRI + DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. + IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) ENDIF - DEALLOCATE(GEOM_AREA_SURF, GEOM_SURF) - - ! Write out special cells info: - N_SPCELLCF_TOT=0; N_SPCELL_TOT=0 - DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - N_SPCELLCF_TOT = N_SPCELLCF_TOT + MESHES(NM)%N_SPCELL_CF - N_SPCELL_TOT = N_SPCELL_TOT + MESHES(NM)%N_SPCELL - WRITE(LU_SETCC,"(A,3I8)") 'MESH, Number of Special Cells CF, Total=',NM,MESHES(NM)%N_SPCELL_CF,MESHES(NM)%N_SPCELL - DO ICC1=1,MESHES(NM)%N_SPCELL - WRITE(LU_SETCC,"(A,2I8,A,3I8)") 'NM,CELL IJK=',NM,ICC1,':',MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,ICC1) + DEALLOCATE(BODTRI,AREA) +ELSE + ! Look in surrounding cells: + DO KK=K-1,K+1 + DO JJ=J-1,J+1 + DO II=I-1,I+1 + ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) + IF (ICC2>0) THEN + DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) + IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 + ENDDO + ENDDO + ENDIF + ENDDO ENDDO ENDDO - CALL MPI_ALLREDUCE(MPI_IN_PLACE, N_SPCELLCF_TOT, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, IERR) - CALL MPI_ALLREDUCE(MPI_IN_PLACE, N_SPCELL_TOT, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, IERR) - IF (MY_RANK==0) WRITE(LU_ERR,"(A,2I8)") 'Total Number of Special Cells CF, Total=',N_SPCELLCF_TOT,N_SPCELL_TOT - - ! Write out more detailed stats: - WRITE_CFACE_STATS_COND : IF (WRITE_CFACE_STATS) THEN - ! Loop over meshes: - TESTS_MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - NCUTEDGE_IBCC = 0; SLEN_IBCC = 0._EB - NCUTEDGE_IBCF = 0 - ! Number of CUT_EDGE for this mesh: - IF(ALLOCATED(MESHES(NM)%CUT_EDGE)) THEN - DO ICE1 = 1,MESHES(NM)%N_CUTEDGE_MESH - SELECT CASE(MESHES(NM)%CUT_EDGE(ICE1)%STATUS) - CASE(CC_INBOUNDCC) - NEDGE = MESHES(NM)%CUT_EDGE(ICE1)%NEDGE - NCUTEDGE_IBCC = NCUTEDGE_IBCC + NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(ICE1)%CEELEM(NOD1:NOD2,IEDGE) - DV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(ICE1)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - & - MESHES(NM)%CUT_EDGE(ICE1)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) - SLEN_IBCC = SLEN_IBCC + SLEN + IF (COUNT>0) THEN + ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 + DO KK=K-1,K+1 + DO JJ=J-1,J+1 + DO II=I-1,I+1 + ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) + IF (ICC2>0) THEN + DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) + IFC1 = M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE) + JFC1 = M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE) + IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE + DO DUM=1,COUNT + IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & + BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT + ENDDO + IF(DUM > COUNT) THEN + BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) + COUNT = DUM + ENDIF + AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) + ENDDO ENDDO - CASE(CC_INBOUNDCF) - SELECT CASE(MESHES(NM)%CUT_EDGE(ICE1)%IJK(4)) - CASE(IAXIS) - IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(IAXIS) == IBAR) CYCLE - CASE(JAXIS) - IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(JAXIS) == JBAR) CYCLE - CASE(KAXIS) - IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(KAXIS) == KBAR) CYCLE - END SELECT - NCUTEDGE_IBCF = NCUTEDGE_IBCF + MESHES(NM)%CUT_EDGE(ICE1)%NEDGE - END SELECT - ENDDO - ENDIF - - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'MESH=',NM - WRITE(LU_SETCC,*) 'CUTEDGE=',PROCESS(NM),NM,MESHES(NM)%N_CUTEDGE_MESH,MESHES(NM)%N_EDGE_CROSS - !WRITE(LU_SETCC,*) 'NCUTEDGE_IBCF =',NCUTEDGE_IBCF - !WRITE(LU_SETCC,*) 'NCUTEDGE_IBCC =',NCUTEDGE_IBCC, ', SLEN_IBCC =',SLEN_IBCC,', SLEN_GEOM =',SLEN_GEOM - - NCUTFACE_IAXIS = 0 - NCUTFACE_JAXIS = 0 - NCUTFACE_KAXIS = 0 - CF_AREA_IAXIS=0._EB; CF_AREA_JAXIS=0._EB; CF_AREA_KAXIS=0._EB - CF_INXAREA_IAXIS=0._EB; CF_INXAREA_JAXIS=0._EB; CF_INXAREA_KAXIS=0._EB - CF_INXSQAREA_IAXIS=0._EB; CF_INXSQAREA_JAXIS=0._EB; CF_INXSQAREA_KAXIS=0._EB - CF_JNYSQAREA_IAXIS=0._EB; CF_JNYSQAREA_JAXIS=0._EB; CF_JNYSQAREA_KAXIS=0._EB - CF_KNZSQAREA_IAXIS=0._EB; CF_KNZSQAREA_JAXIS=0._EB; CF_KNZSQAREA_KAXIS=0._EB - NCUTFACE_INB = 0 - CF_AREA_INB=0._EB; CF_INXAREA_INB=0._EB; - CF_INXSQAREA_INB=0._EB; CF_JNYSQAREA_INB=0._EB; CF_KNZSQAREA_INB=0._EB - DO ICF1 = 1,MESHES(NM)%N_CUTFACE_MESH - IF (CUT_FACE(ICF1)%STATUS == CC_GASPHASE) THEN - NFACE = CUT_FACE(ICF1)%NFACE - X1AXIS= CUT_FACE(ICF1)%IJK(MAX_DIM+1) - SELECT CASE(X1AXIS) - CASE(IAXIS) - NCUTFACE_IAXIS = NCUTFACE_IAXIS + NFACE - CF_AREA_IAXIS = CF_AREA_IAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_IAXIS = CF_INXAREA_IAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_IAXIS=CF_INXSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_IAXIS=CF_JNYSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_IAXIS=CF_KNZSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - CASE(JAXIS) - NCUTFACE_JAXIS = NCUTFACE_JAXIS + NFACE - CF_AREA_JAXIS = CF_AREA_JAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_JAXIS = CF_INXAREA_JAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_JAXIS=CF_INXSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_JAXIS=CF_JNYSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_JAXIS=CF_KNZSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - CASE(KAXIS) - NCUTFACE_KAXIS = NCUTFACE_KAXIS + NFACE - CF_AREA_KAXIS = CF_AREA_KAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_KAXIS = CF_INXAREA_KAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_KAXIS=CF_INXSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_KAXIS=CF_JNYSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_KAXIS=CF_KNZSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - END SELECT - ELSE ! CC_INBOUNDARY.. - NFACE = CUT_FACE(ICF1)%NFACE - CF_AREA_INB = CF_AREA_INB + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_INB = CF_INXAREA_INB + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_INB=CF_INXSQAREA_INB+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_INB=CF_JNYSQAREA_INB+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_INB=CF_KNZSQAREA_INB+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - ENDIF - ENDDO - !WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'CUTFACE=',PROCESS(NM),NM,MESHES(NM)%N_CUTFACE_MESH - WRITE(LU_SETCC,*) 'CUTFACE X Y Z=',NCUTFACE_IAXIS,NCUTFACE_JAXIS,NCUTFACE_KAXIS - !WRITE(LU_SETCC,*) 'CF_AREA X Y Z=',CF_AREA_IAXIS,CF_AREA_JAXIS,CF_AREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_INXAREA X Y Z=',CF_INXAREA_IAXIS,CF_INXAREA_JAXIS,CF_INXAREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_INXSQAREA X Y Z=',CF_INXSQAREA_IAXIS,CF_INXSQAREA_JAXIS,CF_INXSQAREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_JNYSQAREA X Y Z=',CF_JNYSQAREA_IAXIS,CF_JNYSQAREA_JAXIS,CF_JNYSQAREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_KNZSQAREA X Y Z=',CF_KNZSQAREA_IAXIS,CF_KNZSQAREA_JAXIS,CF_KNZSQAREA_KAXIS - !WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'CUTFACE INB=',NCUTFACE_INB - !WRITE(LU_SETCC,*) 'CF_AREA, CF_INXAREA INB=',CF_AREA_INB,CF_INXAREA_INB - !WRITE(LU_SETCC,*) 'CF_INXSQAREA INB =',CF_INXSQAREA_INB,CF_JNYSQAREA_INB,CF_KNZSQAREA_INB - - ! Cut-cells: - MIN_CC_IJK_ICCJCC(1:5) = 0 - MAX_CC_IJK_ICCJCC(1:5) = 0 - MIN_CC_VOL = 1.E20_EB; MIN_ALPHA_CV = 1.E20_EB - MAX_CC_VOL =-1.E20_EB; MAX_ALPHA_CV =-1.E20_EB - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH - CC => CUT_CELL(ICC1) - DO ICC2=1,CC%NCELL - IF(CC%VOLUME(ICC2) < MIN_CC_VOL) THEN - MIN_CC_VOL = CC%VOLUME(ICC2) - MIN_ALPHA_CV = MIN_CC_VOL / ( DX(CC%IJK(IAXIS))*DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) ) - MIN_CC_IJK_ICCJCC(1:5) = (/ CC%IJK(1:3), ICC1, ICC2 /) - ENDIF - IF(CC%VOLUME(ICC2) > MAX_CC_VOL) THEN - MAX_CC_VOL = CC%VOLUME(ICC2) - MAX_ALPHA_CV = MAX_CC_VOL / ( DX(CC%IJK(IAXIS))*DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) ) - MAX_CC_IJK_ICCJCC(1:5) = (/ CC%IJK(1:3), ICC1, ICC2 /) ENDIF ENDDO ENDDO - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'CUTCELL=',PROCESS(NM),NM,MESHES(NM)%N_CUTCELL_MESH - WRITE(LU_SETCC,*) 'MIN VOL=',MIN_CC_IJK_ICCJCC(1:5),MIN_CC_VOL,MIN_ALPHA_CV - WRITE(LU_SETCC,*) 'MAX VOL=',MAX_CC_IJK_ICCJCC(1:5),MAX_CC_VOL,MAX_ALPHA_CV + ENDDO + IF (COUNT>0) THEN + ! Now set IBOD, ITRI + DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. + IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) + ENDIF + DEALLOCATE(BODTRI,AREA) + ENDIF +ENDIF - ! Dump info for Max Size Cut-cell: - DO IG=1,2 - IF(IG==1) THEN; ICC1 = MIN_CC_IJK_ICCJCC(4); ICC2 = MIN_CC_IJK_ICCJCC(5); ENDIF - IF(IG==2) THEN; ICC1 = MAX_CC_IJK_ICCJCC(4); ICC2 = MAX_CC_IJK_ICCJCC(5); ENDIF - IF(ICC1==0) CYCLE - CC => CUT_CELL(ICC1) - I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF(IG==1) THEN; WRITE(LU_SETCC,*) 'MIN VOL CC cut-faces:',I,J,K; ENDIF - IF(IG==2) THEN; WRITE(LU_SETCC,*) 'MAX VOL CC cut-faces:',I,J,K; ENDIF - DO JCF=2,CC%CCELEM(1,ICC2)+1 - IFACE = CC%CCELEM(JCF,ICC2) - FTYPE = CC%FACE_LIST(1,IFACE) - ILH = CC%FACE_LIST(2,IFACE) - 2 ! -1 for LOW_IND, 0 for HIGH_IND - X1AXIS= CC%FACE_LIST(3,IFACE) - SELECT CASE(FTYPE) - CASE(CC_FTYPE_RCGAS) - SELECT CASE(X1AXIS) - CASE(IAXIS); I=CC%IJK(IAXIS)+ILH; ACRT = DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) - CASE(JAXIS); J=CC%IJK(JAXIS)+ILH; ACRT = DX(CC%IJK(IAXIS))*DZ(CC%IJK(KAXIS)) - CASE(KAXIS); K=CC%IJK(KAXIS)+ILH; ACRT = DY(CC%IJK(JAXIS))*DX(CC%IJK(IAXIS)) - END SELECT - WRITE(LU_SETCC,*) JCF-1,' RCGAS ',I,J,K,X1AXIS,ACRT,ACRT/ACRT - CASE(CC_FTYPE_CFGAS) - SELECT CASE(X1AXIS) - CASE(IAXIS); ACRT = DY(J)*DZ(K) - CASE(JAXIS); ACRT = DX(I)*DZ(K) - CASE(KAXIS); ACRT = DY(J)*DX(I) - END SELECT - ICF2 = CC%FACE_LIST(4,IFACE) - JCF2 = CC%FACE_LIST(5,IFACE) - WRITE(LU_SETCC,*) JCF-1,' CFGAS ',CUT_FACE(ICF2)%IJK(1:KAXIS+1),CUT_FACE(ICF2)%AREA(JCF2),& - CUT_FACE(ICF2)%AREA(JCF2)/ACRT - CASE(CC_FTYPE_CFINB) - ICF2 = CC%FACE_LIST(4,IFACE) - JCF2 = CC%FACE_LIST(5,IFACE) - ACRT = 1._EB/3._EB*(DY(J)*DZ(K)+DX(I)*DZ(K)+DY(J)*DX(I)) - WRITE(LU_SETCC,*) JCF-1,' CFINB ',CUT_FACE(ICF2)%IJK(1:KAXIS+1),CUT_FACE(ICF2)%AREA(JCF2) - END SELECT - ENDDO - ENDDO +! For cut-cell ICC, JCC run through its boundary faces and generate new boundary EDGES, CUT-FACES and cells: +BLOCK_PHASE_IF : IF(BLOCK_PHASE==1) THEN - ENDDO TESTS_MESH_LOOP_2 - ENDIF WRITE_CFACE_STATS_COND -ENDIF CCVERBOSE_COND +! Add areas of corresponding INB faces: +INZONE = (I>=0 .AND. I<=M%IBP1 .AND. J>=0 .AND. J<=M%JBP1 .AND. K>=0 .AND. K<=M%KBP1) .AND. MY_RANK==PROCESS(NM) +IF(INZONE) THEN + INBCF_AREA => M%INBCF_AREA(I,J,K) + IF(INBCF_AREA%NCELL == 0) THEN + INBCF_AREA%NCELL = M%CUT_CELL(ICC)%NCELL + ALLOCATE(INBCF_AREA%AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%AINB = 0._EB + ALLOCATE(INBCF_AREA%NEW_AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%NEW_AINB = 0._EB + ALLOCATE(INBCF_AREA%SURF_INDEX(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%SURF_INDEX = 0 + ALLOCATE(INBCF_AREA%IJCF(M%CUT_CELL(ICC)%NCELL)) + ENDIF + IF(IBOD>0) M%INBCF_AREA(I,J,K)%SURF_INDEX(JCC) = GEOMETRY(IBOD)%SURFS(ITRI) + DUM = 0; M%INBCF_AREA(I,J,K)%AINB(JCC) = 0._EB + DO IFC=2,M%CUT_CELL(ICC)%CCELEM(1,JCC)+1 + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC,JCC) + IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_CFINB) + M%INBCF_AREA(I,J,K)%AINB(JCC) = M%INBCF_AREA(I,J,K)%AINB(JCC) + & + M%CUT_FACE(IFC1)%AREA(JFC1)*M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1) + CASE(CC_FTYPE_CFGAS,CC_FTYPE_RCGAS) + DUM=DUM+1 + END SELECT + ENDDO + IF(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE>0) THEN + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = 0; + DEALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB) + ENDIF + IF(.NOT.ALLOCATED(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB)) THEN + ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB = 0 + ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB = 0 + ENDIF +ENDIF -END SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY +IFC_LOOP : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) + HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND + ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND + ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND + X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) + IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) -SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS + FACE_TYPE_IF : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & + M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN -USE TRAN, ONLY: GET_IJK -INTEGER :: NM2,ICELL,I2,J2,K2,BLOCK_TAG -LOGICAL :: IND_FOUND -REAL(EB):: XCO,YCO,ZCO,VOL_NM,VOL_NOM,X1,Y1,Z1 -TYPE(MESH_TYPE), POINTER :: M2 + ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: + IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN + LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) + HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) + LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) + HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) + IF(LOWI>0 .AND. LOWJ>0) THEN + IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) CYCLE IFC_LOOP + ENDIF + ENDIF -MESH_LOOP : DO NM=1,NMESHES + ! If needed reallocate CUT_FACE to accomodate INBOUNDARY face in neighbor cell. + SELECT CASE(X1AXIS) + CASE(IAXIS); II=I+ILH; JJ=J; KK=K + CASE(JAXIS); II=I; JJ=J+ILH; KK=K + CASE(KAXIS); II=I; JJ=J; KK=K+ILH + END SELECT + IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP + ICCNXT=0; IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) ICCNXT=1 - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 + IFC1 = M%CCVAR(II,JJ,KK,CC_IDCF) ! INBOUNDARY cut-faces in neighbor cartesian cell. + NEW_FACE_FLG = .FALSE. + IF (IFC1 < 1) THEN + ! Insert IFC1: + CALL INSERT_CUT_FACE(NM,II,JJ,KK,0,IFC1,INZONE=INZONE); M => MESHES(NM) ! Make space for INBOUNDARY cut-face + NEW_FACE_FLG = .TRUE. + ENDIF - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + REALLOC_FLG = .FALSE. + NSVERT = 0; NSFACE = 0; + IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) NVERTFACE_NEW = 5 + IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) NVERTFACE_NEW = M%CUT_FACE(IFCX)%CFELEM(1,JFCX)+1 + SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CFELEM)) SZDUM = SIZE(M%CUT_FACE(IFC1)%CFELEM, DIM=1) + IF(SZDUM < NVERTFACE_NEW) REALLOC_FLG = .TRUE. + SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%XYZVERT)) SZDUM = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) + IF(SZDUM < M%CUT_FACE(IFC1)%NVERT+NVERTFACE_NEW-1) THEN + REALLOC_FLG = .TRUE. + NSVERT = NVERTFACE_NEW-1 + ENDIF + SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%AREA)) SZDUM = SIZE(M%CUT_FACE(IFC1)%AREA,DIM=1) + IF(SZDUM < M%CUT_FACE(IFC1)%NFACE+1) THEN + REALLOC_FLG = .TRUE. + NSFACE = 1 + ENDIF + JFC1 = M%CUT_FACE(IFC1)%NFACE+1 - ! Compute average cell volume for mesh NM - VOL_NM = (M%XF-M%XS)*(M%YF-M%YS)*(M%ZF-M%ZS) / REAL(M%IBAR*M%JBAR*M%KBAR,EB) + ! Reallocate CUT_FACE(IFC1) entry: + IF(NEW_FACE_FLG) THEN + CALL FACE_DEALLOC(NM,IFC1); CALL NEW_FACE_ALLOC(NM,IFC1,NSVERT,NSFACE,NVERTFACE_NEW) + ELSEIF(REALLOC_FLG) THEN + CALL FACE_REALLOC(NM,IFC1,M%CUT_FACE(IFC1)%NVERT,M%CUT_FACE(IFC1)%NFACE,NSVERT,NSFACE,NVERTFACE_NEW) + ENDIF - ! Process blocked cut-cells from neighboring meshes: - NEIGHBORING_MESHES_DO : DO NM2=1,M%N_NEIGHBORING_MESHES - NOM = M%NEIGHBORING_MESH(NM2); IF (NOM==NM) CYCLE - M2 => MESHES(NOM) + M=>MESHES(NM) + ! Provide GEOM surface information to newly created INBOUNDARY face: + M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) = (/ IBOD, ITRI /) + M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = 0 ! Default surf. + M%CUT_FACE(IFC1)%CFACE_ORIGIN(JFC1) = M%CUT_CELL(ICC)%NOADVANCE(JCC) + IF(IBOD>0) M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = GEOMETRY(IBOD)%SURFS(ITRI) + M%CUT_FACE(IFC1)%NFACE = JFC1 + ENDIF FACE_TYPE_IF - ICELL_DO : DO ICELL=1,M2%N_CC_BLOCKED - XCO = M2%XYZ_CC_BLOCKED(IAXIS,ICELL) - YCO = M2%XYZ_CC_BLOCKED(JAXIS,ICELL) - ZCO = M2%XYZ_CC_BLOCKED(KAXIS,ICELL) - BLOCK_TAG = M2%JBT_CC_BLOCKED(2,ICELL) + SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_RCGAS) ! This regular face has to be connecting two small cut-cells. + ! Scheme: + ! 0. Add REG edges as INB cut-edges in corresponding cartesian cut faces. Define normal edges to new INB cut-edge + ! as CFGAS cut-edges. Set VERTVAR to SOLID in EDGE corners: + EDGE_LIST_REG(1:3,1:4) = CC_UNDEFINED; EDGE_LIST_REG(1,1:4) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. + SELECT CASE(X1AXIS) + CASE(IAXIS) + ! First INB cut edges in surrounding faces: + ! I+ILHF location. + ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 + XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) + XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) + ! Edge 1: V1-V2 add to face (I+2*ILHF+1,J ,K-1,KAXIS) + ! side on blocked cell,[I,J,K,X1EDGE], [I,J,K,X1FACE] + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K-1,JAXIS,I+2*ILHF+1,J ,K-1,KAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) + ! Edge 2: V2-V3 add to face (I+2*ILHF+1,J ,K ,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,KAXIS,I+2*ILHF+1,J ,K ,JAXIS,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) + ! Edge 3: V4-V3 add to face (I+2*ILHF+1,J ,K ,KAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,JAXIS,I+2*ILHF+1,J ,K ,KAXIS,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) + ! Edge 4: V1-V4 add to face (I+2*ILHF+1,J-1,K ,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J-1,K ,KAXIS,I+2*ILHF+1,J-1,K ,JAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) - CALL GET_IJK(XCO,YCO,ZCO,NOM,X1,Y1,Z1,I2,J2,K2) - VOL_NOM = M2%DX(I2)*M2%DY(J2)*M2%DZ(K2) + ! Second CFGAS cut-edges in edges normal to face: + DO KADD=-1,0 + DO JADD=-1,0 + ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO - IF (VOL_NM > 1.5_EB * VOL_NOM) THEN ! NM is COARSE, NOM is FINE - IF(XCO < M2%XS .OR. XCO > M2%XF .OR. & - YCO < M2%YS .OR. YCO > M2%YF .OR. & - ZCO < M2%ZS .OR. ZCO > M2%ZF) CYCLE ICELL_DO - IF(XCO > M2%X(1) .AND. XCO < M2%X(M2%IBAR-1) .AND. & - YCO > M2%Y(1) .AND. YCO < M2%Y(M2%JBAR-1) .AND. & - ZCO > M2%Z(1) .AND. ZCO < M2%Z(M2%KBAR-1)) CYCLE ICELL_DO + CASE(JAXIS) + ! J+ILHF location. + ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) + ! Edge 1: V1-V2 add to face (I-1,J+2*ILHF+1,K ,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J+ILHF,K ,KAXIS,I-1,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) + ! Edge 2: V2-V3 add to face (I ,J+2*ILHF+1,K ,KAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,IAXIS,I ,J+2*ILHF+1,K ,KAXIS,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) + ! Edge 3: V4-V3 add to face (I ,J+2*ILHF+1,K ,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,KAXIS,I ,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) + ! Edge 4: V1-V4 add to face (I ,J+2*ILHF+1,K-1,KAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K-1,IAXIS,I ,J+2*ILHF+1,K-1,KAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) - ! Find I,J,K in NM where (XCO,YCO,ZCO) falls within cell bounds - IND_FOUND = .FALSE. - DO I=ILO_CELL-1,IHI_CELL+1 - IF (XCO < XFACE(I-1)-GEOMEPS .OR. XCO > XFACE(I)+GEOMEPS) CYCLE - DO J=JLO_CELL-1,JHI_CELL+1 - IF (YCO < YFACE(J-1)-GEOMEPS .OR. YCO > YFACE(J)+GEOMEPS) CYCLE - DO K=KLO_CELL-1,KHI_CELL+1 - IF (ZCO < ZFACE(K-1)-GEOMEPS .OR. ZCO > ZFACE(K)+GEOMEPS) CYCLE - IF (I > ILO_CELL-1 .AND. I < IHI_CELL+1 .AND. & - J > JLO_CELL-1 .AND. J < JHI_CELL+1 .AND. & - K > KLO_CELL-1 .AND. K < KHI_CELL+1) CYCLE - IND_FOUND = .TRUE. - EXIT - ENDDO - IF (IND_FOUND) EXIT - ENDDO - IF (IND_FOUND) EXIT + ! Second CFGAS cut-edges in edges normal to face: + DO KADD=-1,0 + DO IADD=-1,0 + ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) ENDDO - IF (.NOT.IND_FOUND) CYCLE ICELL_DO - - ! Tag the coarse ghost-cell in NM that contains the blocked fine cell. - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF (ICC > 0) THEN - DO JCC = 1, M%CUT_CELL(ICC)%NCELL - IF (M%CUT_CELL(ICC)%NOADVANCE(JCC) == NOT_BLOCKED) & - M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCK_TAG - ENDDO - ENDIF + ENDDO + CASE(KAXIS) + ! K+ILHF location. + ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /) + XYZVERT(:,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /) + XYZVERT(:,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /) + XYZVERT(:,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) + ! Edge 1: V1-V2 add to face (I,J-1,K+2*ILHF+1,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J-1,K+ILHF,IAXIS,I ,J-1,K+2*ILHF+1,JAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) + ! Edge 2: V2-V3 add to face (I,J ,K+2*ILHF+1,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,JAXIS,I ,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) + ! Edge 3: V4-V3 add to face (I,J ,K+2*ILHF+1,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,IAXIS,I ,J ,K+2*ILHF+1,JAXIS,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) + ! Edge 4: V1-V4 add to face (I-1,J,K+2*ILHF+1,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J ,K+ILHF,JAXIS,I-1,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) - ELSE - ! ===================================================== - ! Same refinement level (or refinement handled by EXT_WALL_LOOP) - use centroid matching - ! ===================================================== - IND_FOUND = .FALSE. - DO I=ILO_CELL-1,IHI_CELL+1 - IF (ABS(XCO-XCELL(I))0) M%CUT_CELL(ICC)%NOADVANCE(M2%JBT_CC_BLOCKED(1,ICELL)) = BLOCK_TAG + END SELECT - ENDIF - ENDDO ICELL_DO - ENDDO NEIGHBORING_MESHES_DO - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -ENDDO MESH_LOOP -END SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS + ! 1. Add INBOUNDARY cut-face with size of RGGAS in CUT_FACE for this face (IFC1,JFC1). + DUM = M%CUT_FACE(IFC1)%NVERT + 1 + SELECT CASE(X1AXIS) + CASE(IAXIS) + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) + M%CUT_FACE(IFC1)%AREA(JFC1) = DYCELL(J)*DZCELL(K) + M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XFACE(I+ILHF), YCELL(J), ZCELL(K) /) + CASE(JAXIS) + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) + M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DZCELL(K) + M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YFACE(J+ILHF), ZCELL(K) /) + CASE(KAXIS) + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) + M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DYCELL(J) + M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YCELL(J), ZFACE(K+ILHF) /) + END SELECT + INDFC(1:4) = (/ 1, 2, 3, 4 /); INDFC = INDFC + M%CUT_FACE(IFC1)%NVERT + M%CUT_FACE(IFC1)%NVERT = DUM + ! All faces connectivities: (/ NNODS, NOD1, NOD2, NOD3, NOD4 /) ! Conn. into gas region of new cell. + IF (LOHI==HIGH_IND) THEN; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(2), INDFC(3), INDFC(4) /) + ELSE; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(4), INDFC(3), INDFC(2) /); ENDIF -SUBROUTINE DEFINE_XYZFACE_CELL(ALLOC_FLG) + ! Add new edges to EDGE_LIST: + DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) + ALLOCATE(EDGE_LIST_AUX(3,DUM+4)); + IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) + EDGE_LIST_AUX(1:3,DUM+1:DUM+4) = EDGE_LIST_REG(1:3,1:4); + CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) + ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) + DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN + DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) + ENDIF + IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) + IF (LOHI==HIGH_IND) THEN; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+2, DUM+3, DUM+4 /) + ELSE; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+4, DUM+3, DUM+2 /); ENDIF + CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) -LOGICAL, INTENT(IN) :: ALLOC_FLG + IF(INZONE) THEN + M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 + ENDIF -IF (ALLOC_FLG) THEN + ! 2. Find cut-cell sharing this RGGAS face, and where in FACE_LIST this face is. + IF( ICCNXT==0 ) THEN + ! 3. Change in FACE_LIST -> (/CC_FTYPE_RCGAS,SIDE,MYAXIS,0,0/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/). + ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) + JCC2_LOOP_1 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) + IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_RCGAS .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(2,IFACE2)==HILO .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(3,IFACE2)==X1AXIS) THEN + M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) + M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1)= (/ CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) + EXIT JCC2_LOOP_1 + ENDIF + ENDDO + ENDDO JCC2_LOOP_1 + ENDIF - ! X direction bounds: - ILO_FACE = 0 ! Low mesh boundary face index. - IHI_FACE = M%IBAR ! High mesh boundary face index. - ILO_CELL = ILO_FACE + 1 ! First internal cell index. See notes. - IHI_CELL = IHI_FACE ! Last internal cell index. - ISTR = ILO_FACE - NGUARD ! Allocation start x arrays. - IEND = IHI_FACE + NGUARD ! Allocation end x arrays. + CASE(CC_FTYPE_CFGAS) - ! Y direction bounds: - JLO_FACE = 0 ! Low mesh boundary face index. - JHI_FACE = M%JBAR ! High mesh boundary face index. - JLO_CELL = JLO_FACE + 1 ! First internal cell index. See notes. - JHI_CELL = JHI_FACE ! Last internal cell index. - JSTR = JLO_FACE - NGUARD ! Allocation start y arrays. - JEND = JHI_FACE + NGUARD ! Allocation end y arrays. + ! Scheme: + ! 0. Add REG and CFGAS cut edges as INB cut edges for the normal faces where it corresponds: + DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) + ALLOCATE(EDGE_LIST_AUX(3,DUM+M%CUT_FACE(IFCX)%CEDGES(1,JFCX))); + EDGE_LIST_AUX = CC_UNDEFINED; EDGE_LIST_REG(1,:) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. + IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) + ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) + DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN + DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) + ENDIF + IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) + CEDGES_AUX(1,JFC1) = M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + SELECT CASE(X1AXIS) + CASE(IAXIS) + XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) + XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) + ! Loop face edges/cut-edges: + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) + ENDIF + CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! First INB cut edges in surrounding faces: + ! I+ILHF location. + ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 + LOWJ=-1; HIGJ=0; LOWK=-1; HIGK=0; + IF(AXISF==JAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J-1; KEG=K ; HIGJ=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J-1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; LOWJ= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ENDIF + ELSEIF(AXISF==KAXIS) THEN + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J ; KEG=K-1; HIGK=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K-1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; LOWK= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ENDIF + ENDIF + DO KADD=LOWK,HIGK + DO JADD=LOWJ,HIGJ + ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO + CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge + ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; + ! Find Edge: + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. + SELECT CASE(AXISE) + CASE(KAXIS) ! Edge in z dir. For surrounding faces in X dir -> 2*ILHF+1 = -1 or 1. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=JAXIS + CASE(JAXIS) ! Edge in y dir. For surrounding faces in X dir -> 4*ILHF+2 = -2 or 2. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=KAXIS + END SELECT + ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: + ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: + CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) - ! Z direction bounds: - KLO_FACE = 0 ! Low mesh boundary face index. - KHI_FACE = M%KBAR ! High mesh boundary face index. - KLO_CELL = KLO_FACE + 1 ! First internal cell index. See notes. - KHI_CELL = KHI_FACE ! Last internal cell index. - KSTR = KLO_FACE - NGUARD ! Allocation start z arrays. - KEND = KHI_FACE + NGUARD ! Allocation end z arrays. + ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: + EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) - ! Define grid arrays for this mesh: - ! Populate position and cell size arrays: Uniform grid implementation. - ! X direction: - ALLOCATE(DXCELL(ISTR:IEND)); DXCELL(ILO_CELL-1:IHI_CELL+1) = M%DX(ILO_CELL-1:IHI_CELL+1) - DO IGC=2,NGUARD - DXCELL(ILO_CELL-IGC)=DXCELL(ILO_CELL-IGC+1) - DXCELL(IHI_CELL+IGC)=DXCELL(IHI_CELL+IGC-1) - ENDDO - ALLOCATE(DXFACE(ISTR:IEND)); DXFACE(ILO_FACE:IHI_FACE)= M%DXN(ILO_FACE:IHI_FACE) - DO IGC=1,NGUARD - DXFACE(ILO_FACE-IGC)=DXFACE(ILO_FACE-IGC+1) - DXFACE(IHI_FACE+IGC)=DXFACE(ILO_FACE+IGC-1) - ENDDO - ALLOCATE(XCELL(ISTR:IEND)); XCELL = 1._EB/GEOMEPS ! Initialize huge. - XCELL(ILO_CELL-1:IHI_CELL+1) = M%XC(ILO_CELL-1:IHI_CELL+1) - DO IGC=2,NGUARD - XCELL(ILO_CELL-IGC)=XCELL(ILO_CELL-IGC+1)-DXFACE(ILO_FACE-IGC+1) - XCELL(IHI_CELL+IGC)=XCELL(IHI_CELL+IGC-1)+DXFACE(IHI_FACE+IGC-1) - ENDDO - ALLOCATE(XFACE(ISTR:IEND)); XFACE = 1._EB/GEOMEPS ! Initialize huge. - XFACE(ILO_FACE:IHI_FACE) = M%X(ILO_FACE:IHI_FACE) - DO IGC=1,NGUARD - XFACE(ILO_FACE-IGC)=XFACE(ILO_FACE-IGC+1)-DXCELL(ILO_CELL-IGC) - XFACE(IHI_FACE+IGC)=XFACE(IHI_FACE+IGC-1)+DXCELL(IHI_CELL+IGC) - ENDDO - - ! Y direction: - ALLOCATE(DYCELL(JSTR:JEND)); DYCELL(JLO_CELL-1:JHI_CELL+1)= M%DY(JLO_CELL-1:JHI_CELL+1) - DO IGC=2,NGUARD - DYCELL(JLO_CELL-IGC)=DYCELL(JLO_CELL-IGC+1) - DYCELL(JHI_CELL+IGC)=DYCELL(JHI_CELL+IGC-1) - ENDDO - ALLOCATE(DYFACE(JSTR:JEND)); DYFACE(JLO_FACE:JHI_FACE)= M%DYN(JLO_FACE:JHI_FACE) - DO IGC=1,NGUARD - DYFACE(JLO_FACE-IGC)=DYFACE(JLO_FACE-IGC+1) - DYFACE(JHI_FACE+IGC)=DYFACE(JHI_FACE+IGC-1) - ENDDO - ALLOCATE(YCELL(JSTR:JEND)); YCELL = 1._EB/GEOMEPS ! Initialize huge. - YCELL(JLO_CELL-1:JHI_CELL+1) = M%YC(JLO_CELL-1:JHI_CELL+1) - DO IGC=2,NGUARD - YCELL(JLO_CELL-IGC)=YCELL(JLO_CELL-IGC+1)-DYFACE(JLO_FACE-IGC+1) - YCELL(JHI_CELL+IGC)=YCELL(JHI_CELL+IGC-1)+DYFACE(JHI_FACE+IGC-1) - ENDDO - ALLOCATE(YFACE(JSTR:JEND)); YFACE = 1._EB/GEOMEPS ! Initialize huge. - YFACE(JLO_FACE:JHI_FACE) = M%Y(JLO_FACE:JHI_FACE) - DO IGC=1,NGUARD - YFACE(JLO_FACE-IGC)=YFACE(JLO_FACE-IGC+1)-DYCELL(JLO_CELL-IGC) - YFACE(JHI_FACE+IGC)=YFACE(JHI_FACE+IGC-1)+DYCELL(JHI_CELL+IGC) - ENDDO - - ! Z direction: - ALLOCATE(DZCELL(KSTR:KEND)); DZCELL(KLO_CELL-1:KHI_CELL+1)= M%DZ(KLO_CELL-1:KHI_CELL+1) - DO IGC=2,NGUARD - DZCELL(KLO_CELL-IGC)=DZCELL(KLO_CELL-IGC+1) - DZCELL(KHI_CELL+IGC)=DZCELL(KHI_CELL+IGC-1) - ENDDO - ALLOCATE(DZFACE(KSTR:KEND)); DZFACE(KLO_FACE:KHI_FACE)= M%DZN(KLO_FACE:KHI_FACE) - DO IGC=1,NGUARD - DZFACE(KLO_FACE-IGC)=DZFACE(KLO_FACE-IGC+1) - DZFACE(KHI_FACE+IGC)=DZFACE(KHI_FACE+IGC-1) - ENDDO - ALLOCATE(ZCELL(KSTR:KEND)); ZCELL = 1._EB/GEOMEPS ! Initialize huge. - ZCELL(KLO_CELL-1:KHI_CELL+1) = M%ZC(KLO_CELL-1:KHI_CELL+1) - DO IGC=2,NGUARD - ZCELL(KLO_CELL-IGC)=ZCELL(KLO_CELL-IGC+1)-DZFACE(KLO_FACE-IGC+1) - ZCELL(KHI_CELL+IGC)=ZCELL(KHI_CELL+IGC-1)+DZFACE(KHI_FACE+IGC-1) - ENDDO - ALLOCATE(ZFACE(KSTR:KEND)); ZFACE = 1._EB/GEOMEPS ! Initialize huge. - ZFACE(KLO_FACE:KHI_FACE) = M%Z(KLO_FACE:KHI_FACE) - DO IGC=1,NGUARD - ZFACE(KLO_FACE-IGC)=ZFACE(KLO_FACE-IGC+1)-DZCELL(KLO_CELL-IGC) - ZFACE(KHI_FACE+IGC)=ZFACE(KHI_FACE+IGC-1)+DZCELL(KHI_CELL+IGC) - ENDDO - -ELSE - - ! Face centered positions and cell sizes: - IF (ALLOCATED(XFACE)) DEALLOCATE(XFACE) - IF (ALLOCATED(YFACE)) DEALLOCATE(YFACE) - IF (ALLOCATED(ZFACE)) DEALLOCATE(ZFACE) - IF (ALLOCATED(DXFACE)) DEALLOCATE(DXFACE) - IF (ALLOCATED(DYFACE)) DEALLOCATE(DYFACE) - IF (ALLOCATED(DZFACE)) DEALLOCATE(DZFACE) - - ! Cell centered positions and cell sizes: - IF (ALLOCATED(XCELL)) DEALLOCATE(XCELL) - IF (ALLOCATED(YCELL)) DEALLOCATE(YCELL) - IF (ALLOCATED(ZCELL)) DEALLOCATE(ZCELL) - IF (ALLOCATED(DXCELL)) DEALLOCATE(DXCELL) - IF (ALLOCATED(DYCELL)) DEALLOCATE(DYCELL) - IF (ALLOCATED(DZCELL)) DEALLOCATE(DZCELL) - -ENDIF - -RETURN -END SUBROUTINE DEFINE_XYZFACE_CELL - - -SUBROUTINE TAG_CC_BLOCKING_REFINEMENT - -LOGICAL, PARAMETER :: DO_RAY_TRACING=.TRUE. -INTEGER :: DUM,II1,JJ1,KK1,IIO1,JJO1,KKO1,IIO2,JJO2,KKO2,IIG,JJG,KKG,IIOG,JJOG,KKOG - -IF ( DO_RAY_TRACING) THEN + ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: + VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + IF(VL1(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL1(3)), ZFACE(VL1(4)) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL1(3)), ZFACE(VL1(4)) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL1(3),VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + IF(VL2(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL2(3)), ZFACE(VL2(4)) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL2(3)), ZFACE(VL2(4)) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL2(3),VL2(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge + ! New edge list for the heighboring cell Boundary cut-faces is inherited. + EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) + END SELECT + ENDDO - ! This loop is to block cut-cells on fine side grids for which coarse grid cut-cells have been blocked. - MAIN_MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CASE(JAXIS) + XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) + ! Loop face edges/cut-edges: + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) + ENDIF + CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! First INB cut edges in surrounding faces: + ! J+ILHF location. + ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + LOWI=-1; HIGI=0; LOWK=-1; HIGK=0; + IF(AXISF==KAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J+ILHF; KEG=K-1; HIGK=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K-1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ELSE + IEG=I; JEG=J+ILHF; KEG=K ; LOWK= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ENDIF + ELSEIF(AXISF==IAXIS) THEN + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J+ILHF; KEG=K ; HIGI=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ELSE + IEG=I ; JEG=J+ILHF; KEG=K ; LOWI= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ENDIF + ENDIF + DO KADD=LOWK,HIGK + DO IADD=LOWI,HIGI + ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO + CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge + ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; + ! Find Edge: + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. + SELECT CASE(AXISE) + CASE(IAXIS) ! Edge in x dir. For surrounding faces in Y dir -> 2*ILHF+1 = -1 or 1. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=KAXIS + CASE(KAXIS) ! Edge in z dir. For surrounding faces in Y dir -> 4*ILHF+2 = -2 or 2. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=IAXIS + END SELECT - CALL POINT_TO_MESH(NM) - M => MESHES(NM) + ! IF(ICF2<1) THEN + ! WRITE(LU_ERR,*) 'ADD CUT_EDGE TO FACE IFCX,JFCX,I,J,K,X1AXIS=',& + ! IFCX,JFCX,M%CUT_FACE(IFCX)%IJK(1:4),':',M%FCVAR(7,7,7,CC_IDCF,2),M%FCVAR(7,7,7,CC_FGSC,2) + ! WRITE(LU_ERR,*) 'IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4)=',& + ! IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4),4*ILHF+2 + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-2,JCE) + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-1,JCE) + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 1,JCE) + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 2,JCE) + ! ENDIF - ! Set all fine side cut-cells in cells next to external boundaries which have SOLID coarse mesh faces - ! to CC%NOADVANCE(J)=BLOCKED_REFI_INTER and block them. - EXT_WALL_LOOP_1 : DO IW=1,M%N_EXTERNAL_WALL_CELLS - WC=>WALL(IW) - EWC=>EXTERNAL_WALL(IW) - BC =>BOUNDARY_COORD(WC%BC_INDEX) - IIG = BC%IIG;JJG = BC%JJG;KKG = BC%KKG; - II = BC%II; JJ = BC%JJ; KK = BC%KK; IOR = BC%IOR; X1AXIS=ABS(IOR) - NOM = EWC%NOM; IF(NOM<1 .OR. NOM==NM) CYCLE EXT_WALL_LOOP_1 - M2 => MESHES(NOM) - IIF=II; JJF=JJ; KKF=KK - SELECT CASE(IOR) - CASE(-IAXIS); IIF=IIF-1; - CASE(-JAXIS); JJF=JJF-1; - CASE(-KAXIS); KKF=KKF-1; - END SELECT - IF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)==1) THEN + ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: + ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: + CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) - ! Find if omesh cells under both IIG,JJG,KKG, and II,JJ,KK cells - ! are of type CC_CUTCFE and test if these small size cells have centroids within the SOLID. - IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN - IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN - SELECT CASE(IOR) - CASE( IAXIS); IIOG=IIO+1 - CASE(-IAXIS); IIOG=IIO-1 - CASE( JAXIS); JJOG=JJO+1 - CASE(-JAXIS); JJOG=JJO-1 - CASE( KAXIS); KKOG=KKO+1 - CASE(-KAXIS); KKOG=KKO-1 - END SELECT + ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: + EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) - ! Test for cut/reg-cells in II,JJ,KK, respect to IIO,JJO,KKO, AND IIG,JJG,KKG respect to IIOG,JJOG,KKOG: - DO DUM=1,2 - IF(DUM==1) THEN; II1 = II; JJ1 = JJ; KK1 = KK; IIO1= IIO; JJO1= JJO; KKO1= KKO - ELSE; II1 = IIG; JJ1 = JJG; KK1 = KKG; IIO1=IIOG; JJO1=JJOG; KKO1=KKOG + ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: + VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + IF(VL1(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF ), ZFACE(VL1(4)) /) + XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF+1), ZFACE(VL1(4)) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),J+2*ILHF+1,VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) ENDIF - CALL TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL=.TRUE.) - ENDDO - - ! Test for cut/reg-cells in corner respect to OMESH undelying cell if needed: - IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN - IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(KKG>1 .AND. KKG1 .AND. IIG1 .AND. JJGSIZE(CEDGES_AUX,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) + ENDIF + CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! First INB cut edges in surrounding faces: + ! K+ILHF location. + ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + LOWI=-1; HIGI=0; LOWJ=-1; HIGJ=0; + IF(AXISF==IAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J; KEG=K+ILHF; HIGI=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ELSE + IEG=I ; JEG=J; KEG=K+ILHF; LOWI= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ENDIF + ELSEIF(AXISF==JAXIS) THEN + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J-1; KEG=K+ILHF; HIGJ=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J-1,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ELSE + IEG=I; JEG=J ; KEG=K+ILHF; LOWJ= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ENDIF ENDIF - CALL TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL=.TRUE.) - ENDDO - - ELSEIF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)>1) THEN - - ! If needed, block ghost cells of the other mesh which has finer cells. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - IIOG=IIO; JJOG=JJO; KKOG=KKO; II=BC%II; JJ=BC%JJ; KK=BC%KK; IIG=BC%IIG; JJG=BC%JJG; KKG=BC%KKG - SELECT CASE(IOR) - CASE( IAXIS); IIOG=IIO+1 - CASE(-IAXIS); IIOG=IIO-1 - CASE( JAXIS); JJOG=JJO+1 - CASE(-JAXIS); JJOG=JJO-1 - CASE( KAXIS); KKOG=KKO+1 - CASE(-KAXIS); KKOG=KKO-1 - END SELECT - DO DUM=1,2 - IF(DUM==1) THEN; II1 = II; JJ1 = JJ; KK1 = KK; IIO1= IIO; JJO1= JJO; KKO1= KKO - ELSE; II1 = IIG; JJ1 = JJG; KK1 = KKG; IIO1=IIOG; JJO1=JJOG; KKO1=KKOG - ENDIF - CALL TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL=.FALSE.) - ENDDO - - ! Test for OMESH cut/reg-cells in corner respect to this mesh undelying cell if needed: - IIO2=IIO; JJO2=JJO; KKO2=KKO - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(KKOG>1 .AND. KKOG1 .AND. IIOG1 .AND. JJOG 2*ILHF+1 = -1 or 1. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; + X1AXIN=IAXIS + CASE(IAXIS) ! Edge in x dir. For surrounding faces in Z dir -> 4*ILHF+2 = -2 or 2. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; + X1AXIN=JAXIS + END SELECT -ELSE + ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: + ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: + CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) - ! This loop is to block cut-cells on fine side grids for which coarse grid cut-cells have been blocked. - MAIN_MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: + EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) - CALL POINT_TO_MESH(NM) - M => MESHES(NM) + ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: + VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + IF(VL1(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF ) /) + XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF+1) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),VL1(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + IF(VL2(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + XYZVERT(:,1) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF ) /) + XYZVERT(:,2) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF+1) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL2(2),VL2(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge + ! New edge list for the heighboring cell Boundary cut-faces is inherited. + EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) + END SELECT + ENDDO + END SELECT + CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) - ! Set all fine side cut-cells in cells next to external boundaries which have SOLID coarse mesh faces - ! to CC%NOADVANCE(J)=BLOCKED_REFI_INTER and block them. - EXT_WALL_LOOP : DO IW=1,M%N_EXTERNAL_WALL_CELLS - WC=>WALL(IW); IF (WC%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY) CYCLE EXT_WALL_LOOP - EWC=>EXTERNAL_WALL(IW) - BC =>BOUNDARY_COORD(WC%BC_INDEX) - II = BC%II; JJ = BC%JJ; KK = BC%KK; IOR = BC%IOR; X1AXIS=ABS(IOR) - NOM = EWC%NOM - M2 => MESHES(NOM) - IIF=II; JJF=JJ; KKF=KK - SELECT CASE(IOR) - CASE(-IAXIS); IIF=IIF-1; - CASE(-JAXIS); JJF=JJF-1; - CASE(-KAXIS); KKF=KKF-1; - END SELECT - IF (EWC%AREA_RATIO<0.9_EB) THEN + ! 1. Add INBOUNDARY cut-face in CUT_FACE for this face (IFC1,JFC1). + ! Add XYZVERT, AREA, XYZCEN and CFELEM entry in CUT_FACE(IFC1) for this (IFCX,JFCX) CFGAS face. + M%CUT_FACE(IFC1)%CFELEM(1,JFC1) = M%CUT_FACE(IFCX)%CFELEM(1,JFCX) + MAXVERTS = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) + COUNT=1 + DO IVERT=1,M%CUT_FACE(IFCX)%CFELEM(1,JFCX) + IV=M%CUT_FACE(IFCX)%CFELEM(IVERT+1,JFCX) + XYZV(IAXIS:KAXIS) =M%CUT_FACE(IFCX)%XYZVERT(IAXIS:KAXIS,IV) + CALL INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,M%CUT_FACE(IFC1)%NVERT,INOD,M%CUT_FACE(IFC1)%XYZVERT) + COUNT=COUNT+1 + IF(COUNT>SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(COUNT+1,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:COUNT-1,:)=M%CUT_FACE(IFC1)%CFELEM(1:COUNT-1,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=M%CUT_FACE(IFC1)%CFELEM) + ENDIF + M%CUT_FACE(IFC1)%CFELEM(COUNT,JFC1)=INOD + ENDDO + IF (HILO==HIGH_IND) THEN ! Mirror the connectivity, s.t. normal pointing inside: + COUNT=M%CUT_FACE(IFC1)%CFELEM(1,JFC1) + ALLOCATE(CFELEM(COUNT)); CFELEM(1:COUNT) = M%CUT_FACE(IFC1)%CFELEM(COUNT+1:2:-1,JFC1) + M%CUT_FACE(IFC1)%CFELEM(2:COUNT+1,JFC1) = CFELEM(1:COUNT) + DEALLOCATE(CFELEM) + ENDIF + M%CUT_FACE(IFC1)%AREA(JFC1) = M%CUT_FACE(IFCX)%AREA(JFCX) + M%CUT_FACE(IFC1)%XYZCEN(:,JFC1) = M%CUT_FACE(IFCX)%XYZCEN(:,JFCX) - ! Check if other mesh boundary face set to SOLID and current mesh face set to .NOT.SOLID: - IIOF=EWC%IIO_MIN; JJOF=EWC%JJO_MIN; KKOF=EWC%KKO_MIN; LOHIF=HIGH_IND - SELECT CASE(IOR) - CASE(-IAXIS); IIOF=IIOF-1; LOHIF=LOW_IND - CASE(-JAXIS); JJOF=JJOF-1; LOHIF=LOW_IND - CASE(-KAXIS); KKOF=KKOF-1; LOHIF=LOW_IND - END SELECT - IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) CYCLE EXT_WALL_LOOP ! No need to do anything. - IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_SOLID) THEN ! Coarse side face is solid. - ! Set II,JJ,KK fine cells next to this EWC for blocking. - IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell in this location, set to Block. - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II)*M%DY(JJ)*M%DZ(KK) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II),M%YC(JJ),M%ZC(KK) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = BLOCKED_REFI_INTER - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_FGSC,AX) == & - CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NM,II,JJ,KK,ICC); M => MESHES(NM) - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) - ELSEIF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_CUTCFE) THEN - ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. - ICC=M%CCVAR(II,JJ,KK,CC_IDCC); CC=> M%CUT_CELL(ICC) - JCC_LOOP_1 : DO JCC=1,CC%NCELL - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE = CC%CCELEM(IFC,JCC) - IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & - CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN - IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER - CYCLE JCC_LOOP_1 - ENDIF - ENDDO - ENDDO JCC_LOOP_1 + ! 2. Find cut-cell sharing this CFGAS face (IFCX,JFCX), find where in saids cell FACE_LIST this face is. + ! 3. Change in FACE_LIST -> (/CC_FTYPE_CFGAS,SIDE,MYAXIS,IFCX,JFCX/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/) + ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) + JCC2_LOOP_2 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) + IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_CFGAS .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE2)==IFCX .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE2)==JFCX) THEN + ! Add to FACE_LIST_DROPPED: + M%CUT_CELL(ICC2)%NFACE_DROPPED = M%CUT_CELL(ICC2)%NFACE_DROPPED + 1 + NFCD=0; IF(ALLOCATED(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED)) NFCD=SIZE(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED,DIM=2) + IF(M%CUT_CELL(ICC2)%NFACE_DROPPED>NFCD) THEN + ALLOCATE(FACE_LIST_DROPPED(6,M%CUT_CELL(ICC2)%NFACE_DROPPED)) + IF(NFCD>0) FACE_LIST_DROPPED(1:6,1:NFCD) = M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1:6,1:NFCD) + FACE_LIST_DROPPED(1:6,NFCD+1) = M%CUT_CELL(ICC2)%FACE_LIST(1:6,IFACE2) + CALL MOVE_ALLOC(FROM=FACE_LIST_DROPPED,TO=M%CUT_CELL(ICC2)%FACE_LIST_DROPPED) ENDIF - !ELSEIF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_CUTCFE) THEN - ! Coarse side is a cut-face in the boundary. + ! Now write CC_FTYPE_CFINB entry: + M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) + M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1) =(/CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) + IF(INZONE) THEN + M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 + ENDIF + EXIT JCC2_LOOP_2 ENDIF - ELSEIF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)>1) THEN - - IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) THEN ! Coarse side face is solid. - ! If needed, block ghost cells of the other mesh which has finer cells. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - IIOF=IIO; JJOF=JJO; KKOF=KKO; IOGC=IIO; JOGC=JJO; KOGC=KKO; LOHIF=LOW_IND - SELECT CASE(IOR) - CASE( IAXIS); IOGC=IOGC+1; - CASE(-IAXIS); IIOF= IIO-1; LOHIF=HIGH_IND - CASE( JAXIS); JOGC=JOGC+1; - CASE(-JAXIS); JJOF= JJO-1; LOHIF=HIGH_IND - CASE( KAXIS); KOGC=KOGC+1; - CASE(-KAXIS); KKOF= KKO-1; LOHIF=HIGH_IND - END SELECT - IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_SOLID) CYCLE ! No need to do anything. + ENDDO + ENDDO JCC2_LOOP_2 + END SELECT - ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking. - IF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell in this location, set to Block. - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M2%DX(IOGC)*M2%DY(JOGC)*M2%DZ(KOGC) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M2%XC(IOGC),M2%YC(JOGC),M2%ZC(KOGC) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = BLOCKED_REFI_INTER - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND; ICFC=& - M2%FCVAR(IOGC+ADDI(SIDE,AX),JOGC+ADDJ(SIDE,AX),KOGC+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF( & - M2%FCVAR(IOGC+ADDI(SIDE,AX),JOGC+ADDJ(SIDE,AX),KOGC+ADDK(SIDE,AX),CC_FGSC,AX)& - == CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NOM,IOGC,JOGC,KOGC,ICC); M2 => MESHES(NOM) - CALL NEW_CELL_ALLOC(NOM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M2%CUT_CELL(ICC)%NCELL = NCELL - M2%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M2%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M2%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M2%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M2%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M2%CUT_CELL(ICC)%NOADVANCE) - ELSEIF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_CUTCFE) THEN - ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. - ICC=M2%CCVAR(IOGC,JOGC,KOGC,CC_IDCC); CC=> M2%CUT_CELL(ICC) - JCC_LOOP_3 : DO JCC=1,CC%NCELL - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE = CC%CCELEM(IFC,JCC) - IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & - CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN - IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER - CYCLE JCC_LOOP_3 - ENDIF - ENDDO - ENDDO JCC_LOOP_3 - ENDIF - ENDDO - ENDDO - ENDDO - !ELSEIF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_CUTCFE) THEN - ! Coarse side is a cut-face in the boundary. - ENDIF - ENDIF - ENDDO EXT_WALL_LOOP - ENDDO MAIN_MESH_LOOP_2 +ENDDO IFC_LOOP +IF(INZONE) THEN + DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) + JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) + M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) = M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) + M%CUT_FACE(IFC1)%AREA(JFC1) + ENDDO + DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) + JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) + M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)= & + M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)*M%INBCF_AREA(I,J,K)%AINB(JCC)/M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) + ENDDO ENDIF -RETURN -END SUBROUTINE TAG_CC_BLOCKING_REFINEMENT -SUBROUTINE TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL) +ELSEIF(BLOCK_PHASE==2) THEN BLOCK_PHASE_IF -INTEGER, INTENT(IN) :: NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1 -LOGICAL, INTENT(IN) :: FINE_CELL -TYPE(MESH_TYPE), POINTER :: M,M2 -M =>MESHES( NM) -M2=>MESHES(NOM) +! Drop Edges and Faces: +IFC_LOOP_2 : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) + HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND + ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND + ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND + X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) + IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) -IF (FINE_CELL) THEN + FACE_TYPE_IF_2 : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & + M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN - ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC); ICC = 0 - IF ( ICC2 > 0 .OR. M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN ! There are cut-cells in omesh cartesian cell. - IF(M%CCVAR(II1,JJ1,KK1,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell is this location: - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II1)*M%DY(JJ1)*M%DZ(KK1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II1),M%YC(JJ1),M%ZC(KK1) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) NOADVANCE(1) = BLOCKED_REFI_INTER - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_FGSC,AX) == & - CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN + LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) + HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) + LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) + HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) + IF(LOWI>0 .AND. LOWJ>0) THEN + IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. & ! This is to drop this cut-face on the second hit. + M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0 .AND. M%CUT_FACE(IFCX)%SHARED(JFCX)) THEN + M%CUT_FACE(IFCX)%SHARED(JFCX) =.FALSE. + CYCLE IFC_LOOP_2 ENDIF - ENDDO - ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NM,II1,JJ1,KK1,ICC); M => MESHES(NM) - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) - ELSEIF(M%CCVAR(II1,JJ1,KK1,CC_IDCC)>0) THEN - ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC) - ENDIF - ! Here Test if cut-cells in II,KK,KK are blocked or not in IIO,JJO,KKO: - IF(ICC>0) THEN - IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN - WHERE(M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL)==NOT_BLOCKED) & - M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL) = BLOCKED_REFI_INTER - ELSE; CALL TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) ENDIF ENDIF - ENDIF -ELSE + SELECT CASE(X1AXIS) + CASE(IAXIS); II=I+ILH; JJ=J; KK=K + CASE(JAXIS); II=I; JJ=J+ILH; KK=K + CASE(KAXIS); II=I; JJ=J; KK=K+ILH + END SELECT + IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP_2 - ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC); ICC2 = 0 - IF(ICC>0) THEN - ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking. - IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell in this location, set to Block. - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M2%DX(IIO1)*M2%DY(JJO1)*M2%DZ(KKO1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M2%XC(IIO1),M2%YC(JJO1),M2%ZC(KKO1) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND; ICFC=& - M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF( & - M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_FGSC,AX)& - == CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF FACE_TYPE_IF_2 + + SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_RCGAS) + ! 4. Make FCVAR(I,J,K,CC_CGSC,X1AXIS)=CC_SOLID, ECVAR and VERTVAR CC_SOLID where corresponds: + CALL DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) + CASE(CC_FTYPE_CFGAS) + ! Drop Face and Edges test: + DROP_FACE=.FALSE. + ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: + LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) + HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) + LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) + HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) + IF(LOWI>0 .AND. LOWJ>0) THEN + IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) THEN + DROP_FACE=.TRUE. + M%CUT_FACE(IFCX)%SHARED(JFCX) =.TRUE. + ENDIF ENDIF + + ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) + JCC2_LOOP_3 : DO IFACE2=1,M%CUT_CELL(ICC2)%NFACE_DROPPED + IF(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & + M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(4,IFACE2)==IFCX .AND. & + M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(5,IFACE2)==JFCX) THEN + DROP_FACE=.TRUE. + EXIT JCC2_LOOP_3 + ENDIF + ENDDO JCC2_LOOP_3 + + DROP_FACE_IF : IF (DROP_FACE) THEN + SELECT CASE(X1AXIS) + CASE(IAXIS) + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + IF(AXISF==KAXIS) THEN + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J ; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ELSEIF(AXISF==JAXIS) THEN + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J-1; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ENDIF + CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! Drop edge JCE: + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + END SELECT + ENDDO + + CASE(JAXIS) + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + IF(AXISF==KAXIS) THEN + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J+ILHF; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I; JEG=J+ILHF; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ELSEIF(AXISF==IAXIS) THEN + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I ; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ENDIF + CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! Drop edge JCE: + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + END SELECT + ENDDO + CASE(KAXIS) + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + IF(AXISF==IAXIS) THEN + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I ; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ELSEIF(AXISF==JAXIS) THEN + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J-1; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I; JEG=J ; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ENDIF + CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! Drop edge JCE: + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + END SELECT + ENDDO + END SELECT + + ! Drop (IFCX,JFCX) from CUT_FACE(IFCX): + CALL DROP_CUTFACE(NM,CC_FTYPE_CFGAS,I,J,K,ILHF,X1AXIS,IFCX,JFCX) + ENDIF DROP_FACE_IF + CASE(CC_FTYPE_CFINB) + + ! Drop cut-edges whithin the Cartesian cell I,J,K that belong to this INBOUNDARY cut-face: + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + IF(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)/=CC_ETYPE_CFINB) CYCLE + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + AXISE=M%CUT_EDGE(ICE)%IJK(4) + IF(AXISE>0) CYCLE + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) ENDDO - ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NOM,IIO1,JJO1,KKO1,ICC2); M2 => MESHES(NOM) - CALL NEW_CELL_ALLOC(NOM,ICC2,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M2%CUT_CELL(ICC2)%NCELL = NCELL - M2%CUT_CELL(ICC2)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M2%CUT_CELL(ICC2)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M2%CUT_CELL(ICC2)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M2%CUT_CELL(ICC2)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M2%CUT_CELL(ICC2)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M2%CUT_CELL(ICC2)%NOADVANCE) - ELSEIF(M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC)>0) THEN - ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC) - ENDIF - ! Here Test if cut-cells in IIO,JJO,KKO are blocked or not in II,JJ,KK: - IF(ICC2>0) CALL TEST_CC_FOR_BLOCKING(NOM,ICC2,NM,II1,JJ1,KK1,ICC) - ENDIF -ENDIF + ! Scheme: + ! 1. Drop (IFC2,JFC2) from CUT_FACE(IFC2). Note this changes the face arrays, so FACE_LIST face indexes + ! for cut-cells on this CUT_CELL(ICC) entry need to be updated. + CALL DROP_CUTFACE(NM,CC_FTYPE_CFINB,I,J,K,ILHF,X1AXIS,IFCX,JFCX) -END SUBROUTINE TAG_BLOCK_CELL + END SELECT -SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) +ENDDO IFC_LOOP_2 -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +ELSEIF(BLOCK_PHASE==3) THEN BLOCK_PHASE_IF -INTEGER, INTENT(IN) :: NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2 +! At this point all faces defining the ICC,JCC cut-cell have been dropped in the CUT_FACE, CUT_CELL trees. +! We can drop JCC from CUT_CELL(ICC)%CCELEM, etc. +CALL DROP_CUTCELL(NM,ICC,JCC) -INTEGER :: JCC,FC_FOUND,FC_TYPE,INBFC,INBFC_LOC,VERT_CUTFACE,NVERT,X1AXIS,X2AXIS,X3AXIS,NCROSS,DIRRAY,IFC1,JFC1,& - NVERT2,VERT_CUTFACE2,IV,IFCC,IFACE2,IFC2,JFC2 -TYPE(MESH_TYPE), POINTER :: M,M2 -TYPE(CC_CUTCELL_TYPE), POINTER :: CC,CC2 -TYPE(CC_CUTFACE_TYPE), POINTER :: CF2 -INTEGER, PARAMETER :: EAST=1,WEST=2,FRONT=3,BACK=4,SOUTH=5,NORTH=6 -INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM,CFELEM2 -REAL(EB),ALLOCATABLE, DIMENSION(:,:):: XYZVERTIJK,XYZVERTSTN -REAL(EB):: XYZCEN(MAX_DIM),NVEC(MAX_DIM),P0(MAX_DIM),A,B,C,D,XYZ_P(MAX_DIM),PTCEN(IAXIS:JAXIS),X1F,XC2(MAX_DIM),XC3(MAX_DIM),& - XLO,XHI,YLO,YHI,ZLO,ZHI,XLO2,XHI2,YLO2,YHI2,ZLO2,ZHI2,CFCEN(MAX_DIM),XYZC(MAX_DIM,1),N(MAX_DIM,1),S(MAX_DIM,1),& - T(MAX_DIM,1),TBN(MAX_DIM,MAX_DIM),XYZCSTN(MAX_DIM,1),NN(MAX_DIM,1),XN_CEN,XN_INT,XYZC2(IAXIS:KAXIS,1) -REAL(EB), PARAMETER :: SCALE_FCT=1.E-4_EB -LOGICAL :: IN_CFACE,BLOCK_CELL,FGPOINT -! INTEGER :: LU_CCELL -! CHARACTER(50) :: FILENAME +ENDIF BLOCK_PHASE_IF -M =>MESHES( NM) -M2=>MESHES(NOM) +RETURN +END SUBROUTINE BLOCK_CUT_CELL -INBFC=M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCF); IF(INBFC<1) RETURN ! No CC_INBOUNDARY faces in this cartesian cell. -CC =>M%CUT_CELL( ICC) -CC2=>M2%CUT_CELL(ICC2) -CF2=>M2%CUT_FACE(INBFC) -VERT_CUTFACE = SIZE(CF2%CFELEM, DIM=1); ALLOCATE(CFELEM(1:VERT_CUTFACE)) -NVERT = SIZE(CF2%XYZVERT,DIM=2) -! For each cut-cell in CC, test if its centroid Xc is in the SOLID region of CC2: -! We do this by finding a direction to a Cartesian face type CC_GASPHASE or CC_SOLID and intersection point XE, -FC_FOUND=0; FC_TYPE=CC_UNDEFINED; DIRRAY=CC_UNDEFINED -! Then counting INBOUNDARY cut-face intersections from XE point to Xc. -SELECT CASE(M2%FCVAR(IIO1-1,JJO1,KKO1,CC_FGSC,IAXIS)) -CASE(CC_GASPHASE) -FC_FOUND=WEST; FC_TYPE =CC_GASPHASE; DIRRAY=IAXIS -IF(IIO1==0) THEN; X1F=M2%X(IIO1)-M2%DX(IIO1); ELSE; X1F=M2%X(IIO1-1); ENDIF -CASE(CC_SOLID ) -FC_FOUND=WEST; FC_TYPE =CC_SOLID; DIRRAY=IAXIS -IF(IIO1==0) THEN; X1F=M2%X(IIO1)-M2%DX(IIO1); ELSE; X1F=M2%X(IIO1-1); ENDIF -END SELECT -IF(FC_FOUND<1) THEN - SELECT CASE(M2%FCVAR(IIO1 ,JJO1,KKO1,CC_FGSC,IAXIS)) - CASE(CC_GASPHASE) - FC_FOUND=EAST; FC_TYPE =CC_GASPHASE; DIRRAY=-IAXIS - IF(IIO1==M2%IBP1) THEN; X1F=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; X1F=M2%X(IIO1); ENDIF - CASE(CC_SOLID ) - FC_FOUND=EAST; FC_TYPE =CC_SOLID; DIRRAY=-IAXIS - IF(IIO1==M2%IBP1) THEN; X1F=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; X1F=M2%X(IIO1); ENDIF - END SELECT -ENDIF -IF(FC_FOUND<1) THEN - SELECT CASE(M2%FCVAR(IIO1,JJO1-1,KKO1,CC_FGSC,JAXIS)) - CASE(CC_GASPHASE) - FC_FOUND=FRONT; FC_TYPE =CC_GASPHASE; DIRRAY=JAXIS - IF(JJO1==0) THEN; X1F=M2%Y(JJO1)-M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1-1); ENDIF - CASE(CC_SOLID ) - FC_FOUND=FRONT; FC_TYPE =CC_SOLID; DIRRAY=JAXIS - IF(JJO1==0) THEN; X1F=M2%Y(JJO1)-M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1-1); ENDIF - END SELECT -ENDIF -IF(FC_FOUND<1) THEN - SELECT CASE(M2%FCVAR(IIO1,JJO1 ,KKO1,CC_FGSC,JAXIS)) - CASE(CC_GASPHASE) - FC_FOUND=BACK; FC_TYPE =CC_GASPHASE; DIRRAY=-JAXIS - IF(JJO1==M2%JBP1) THEN; X1F=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1); ENDIF - CASE(CC_SOLID ) - FC_FOUND=BACK; FC_TYPE =CC_SOLID; DIRRAY=-JAXIS - IF(JJO1==M2%JBP1) THEN; X1F=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1); ENDIF - END SELECT +! ------------------------------ ADD_CUTEDGE_TO_FACE -------------------------------- + +SUBROUTINE ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IEC2,JEC2,IFC,JFC,KFC,X1AXFC) + +INTEGER, INTENT(IN) :: NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IFC,JFC,KFC,X1AXFC +INTEGER, INTENT(OUT):: IEC2,JEC2 + +! Local variables: +INTEGER :: INOD1,INOD2,VL1(1:4),VL2(1:4),NVERT,NEDGE,IEDGE +INTEGER, ALLOCATABLE :: EDGE_LIST_AUX(:,:) +REAL(EB):: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) +TYPE(MESH_TYPE), POINTER :: M + +IEDGE=JCF2 ! Dummy for now FACE_LIST not filled for ETYPE_CFINB edges. + +M =>MESHES(NM) +IEC2=M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) +IF(IEC2<1) THEN ! Allocate space for CFINB cut-edge on this cut-face. + + ! Allocate space for cut-edge in CUT_EDGE: + IEC2 = M%N_CUTEDGE_MESH + 1 + M%N_CUTEDGE_MESH = IEC2 + M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = IEC2 + CALL CUT_EDGE_ARRAY_REALLOC(NM,IEC2) + M%CUT_EDGE(IEC2)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,IEC2,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + M%CUT_EDGE(IEC2)%NEDGE = 0 + M%CUT_EDGE(IEC2)%NEDGE1 = 0 + M%CUT_EDGE(IEC2)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. + M%CUT_EDGE(IEC2)%STATUS = CC_INBOUNDCF + ALLOCATE(M%CUT_EDGE(IEC2)%DXX(1:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%DXX = 0._EB + ALLOCATE(M%CUT_EDGE(IEC2)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%FACE_LIST = CC_UNDEFINED + ENDIF -IF(FC_FOUND<1) THEN - SELECT CASE(M2%FCVAR(IIO1,JJO1,KKO1-1,CC_FGSC,KAXIS)) - CASE(CC_GASPHASE) - FC_FOUND=SOUTH; FC_TYPE =CC_GASPHASE; DIRRAY=KAXIS - IF(KKO1==0) THEN; X1F=M2%Z(KKO1)-M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1-1); ENDIF - CASE(CC_SOLID ) - FC_FOUND=SOUTH; FC_TYPE =CC_SOLID; DIRRAY=KAXIS - IF(KKO1==0) THEN; X1F=M2%Z(KKO1)-M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1-1); ENDIF - END SELECT + +! Edge nodes location and type: +INOD1 = M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE) +INOD2 = M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE) +XV1(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD1) +XV2(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD2) +VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD1) ! [CC_VTYPE I J K] +VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD2) + +! Add cut-edge: +NVERT = M%CUT_EDGE(IEC2)%NVERT +CALL REALLOCATE_EDGE_VERT(NM,IEC2,NVERT+2) +CALL INSERT_FACE_VERT(XV1,NM,IEC2,NVERT,INOD1) +CALL INSERT_FACE_VERT(XV2,NM,IEC2,NVERT,INOD2) + +DO NEDGE=1,M%CUT_EDGE(IEC2)%NEDGE + IF( (INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) .OR. & + (INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) ) THEN + JEC2=NEDGE; RETURN ! Edge already in Face cut-edges list. + ENDIF +ENDDO +JEC2=NEDGE +CALL REALLOCATE_EDGE_ELEM(NM,IEC2,NEDGE) + +! Check first node type, if gas vertex make it boundary vertex and change VERTVAR to CC_SOLID: +M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = VL1(1:4) +IF(VL1(1)==CC_VTYPE_VGAS) THEN + M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,VL1(2),VL1(3),VL1(4)/) + M%VERTVAR(VL1(2),VL1(3),VL1(4),CC_VGSC) = CC_SOLID ENDIF -IF(FC_FOUND<1) THEN - SELECT CASE(M2%FCVAR(IIO1,JJO1,KKO1 ,CC_FGSC,KAXIS)) - CASE(CC_GASPHASE) - FC_FOUND=NORTH; FC_TYPE =CC_GASPHASE; DIRRAY=-KAXIS - IF(KKO1==M2%KBP1) THEN; X1F=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1); ENDIF - CASE(CC_SOLID ) - FC_FOUND=NORTH; FC_TYPE =CC_SOLID; DIRRAY=-KAXIS - IF(KKO1==M2%KBP1) THEN; X1F=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1); ENDIF - END SELECT +M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = VL2(1:4) +IF(VL2(1)==CC_VTYPE_VGAS) THEN + M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,VL2(2),VL2(3),VL2(4)/) + M%VERTVAR(VL2(2),VL2(3),VL2(4),CC_VGSC) = CC_SOLID ENDIF -IF(FC_FOUND<1) RETURN ! Here or before we can switch to a point in polygon test whithin JCC_LOOP. +! Add edge: Assumes XV1 < XV2 in X1AXEG direction: +M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) +IF(ILHF==-1) M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) -SELECT CASE(ABS(DIRRAY)) -CASE(IAXIS); X1AXIS = IAXIS; X2AXIS = JAXIS; X3AXIS = KAXIS -CASE(JAXIS); X1AXIS = JAXIS; X2AXIS = KAXIS; X3AXIS = IAXIS -CASE(KAXIS); X1AXIS = KAXIS; X2AXIS = IAXIS; X3AXIS = JAXIS -END SELECT +M%CUT_EDGE(IEC2)%NVERT = NVERT +M%CUT_EDGE(IEC2)%NEDGE = NEDGE -! IF(NM==1 .AND. ICC<30) THEN -! LU_CCELL = 797 -! WRITE(FILENAME,'(A,I6.6,A)') 'FACESBLK_',ICC,'.txt' -! OPEN(UNIT=LU_CCELL,FILE=FILENAME,STATUS='UNKNOWN') -! WRITE(LU_CCELL,*) NVERT,VERT_CUTFACE,X1AXIS,X2AXIS,X3AXIS,CF2%NFACE -! ENDIF +M%CUT_EDGE(IEC2)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) -I=CC%IJK(IAXIS); J=CC%IJK(JAXIS); K=CC%IJK(KAXIS) -IF(I== 0) THEN; XLO=M%X( I)-M%DX( I); ELSE; XLO=M%X(I-1); ENDIF -IF(I==M%IBP1) THEN; XHI=M%X(I-1)+M%DX( I); ELSE; XHI=M%X( I); ENDIF -IF(J== 0) THEN; YLO=M%Y( J)-M%DY( J); ELSE; YLO=M%Y(J-1); ENDIF -IF(J==M%JBP1) THEN; YHI=M%Y(J-1)+M%DY( J); ELSE; YHI=M%Y( J); ENDIF -IF(K== 0) THEN; ZLO=M%Z( K)-M%DZ( K); ELSE; ZLO=M%Z(K-1); ENDIF -IF(K==M%KBP1) THEN; ZHI=M%Z(K-1)+M%DZ( K); ELSE; ZHI=M%Z( K); ENDIF +! Define Edge as INB CUT_EDGE, find corresponding CFGAS EDGE associated cut-face and replace it +IF(ICF2>0) THEN + ! Reallocate EDGE_LIST if JCE2 exceeds current size + NVERT = 0 + IF(ALLOCATED(M%CUT_FACE(ICF2)%EDGE_LIST)) NVERT = SIZE(M%CUT_FACE(ICF2)%EDGE_LIST,DIM=2)-1 + IF(JCE2 > NVERT) THEN + ALLOCATE(EDGE_LIST_AUX(3,0:JCE2)) + EDGE_LIST_AUX = CC_UNDEFINED + IF(NVERT > 0) EDGE_LIST_AUX(1:3,0:NVERT) = M%CUT_FACE(ICF2)%EDGE_LIST(1:3,0:NVERT) + CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX, TO=M%CUT_FACE(ICF2)%EDGE_LIST) + ENDIF + M%CUT_FACE(ICF2)%EDGE_LIST(1:3,JCE2) = (/CC_ETYPE_CFINB, IEC2, JEC2/) +ENDIF -IF(IIO1== 0) THEN; XLO2=M2%X( IIO1)-M2%DX(IIO1); ELSE; XLO2=M2%X(IIO1-1); ENDIF -IF(IIO1==M2%IBP1) THEN; XHI2=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; XHI2=M2%X( IIO1); ENDIF -IF(JJO1== 0) THEN; YLO2=M2%Y( JJO1)-M2%DY(JJO1); ELSE; YLO2=M2%Y(JJO1-1); ENDIF -IF(JJO1==M2%JBP1) THEN; YHI2=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; YHI2=M2%Y( JJO1); ENDIF -IF(KKO1== 0) THEN; ZLO2=M2%Z( KKO1)-M2%DZ(KKO1); ELSE; ZLO2=M2%Z(KKO1-1); ENDIF -IF(KKO1==M2%KBP1) THEN; ZHI2=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; ZHI2=M2%Z( KKO1); ENDIF +END SUBROUTINE ADD_CUTEDGE_TO_FACE -IFC1 = M%CCVAR(I,J,K,CC_IDCF) -IF(IFC1>0) THEN - NVERT2 = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) - ALLOCATE(XYZVERTIJK(MAX_DIM,NVERT2)); XYZVERTIJK = M%CUT_FACE(IFC1)%XYZVERT - ALLOCATE(XYZVERTSTN(MAX_DIM,NVERT2)) - VERT_CUTFACE2 = SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1); ALLOCATE(CFELEM2(VERT_CUTFACE2)) -ENDIF -JCC_LOOP : DO JCC=1,CC%NCELL - ! Get point within gas region of cut-cell: - FGPOINT=.FALSE. - IFC_LOOP : DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - IFC1 = CC%FACE_LIST(4,IFACE) - JFC1 = CC%FACE_LIST(5,IFACE) - IF (CC%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE - CFCEN(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) - CFELEM(1:3) = M%CUT_FACE(IFC1)%CFELEM(1:3,JFC1) - XC2(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,CFELEM(2))-CFCEN(IAXIS:KAXIS) - XC3(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,CFELEM(3))-CFCEN(IAXIS:KAXIS) - CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) - IF (NORM2(NVEC) XHI-GEOMEPS) CYCLE - IF(XYZC(JAXIS,1) < YLO+GEOMEPS .OR. XYZC(JAXIS,1) > YHI-GEOMEPS) CYCLE - IF(XYZC(KAXIS,1) < ZLO+GEOMEPS .OR. XYZC(KAXIS,1) > ZHI-GEOMEPS) CYCLE - IF(XYZC(IAXIS,1) < XLO2+GEOMEPS .OR. XYZC(IAXIS,1) > XHI2-GEOMEPS) CYCLE - IF(XYZC(JAXIS,1) < YLO2+GEOMEPS .OR. XYZC(JAXIS,1) > YHI2-GEOMEPS) CYCLE - IF(XYZC(KAXIS,1) < ZLO2+GEOMEPS .OR. XYZC(KAXIS,1) > ZHI2-GEOMEPS) CYCLE +SUBROUTINE ADD_CUTEDGE_TO_EDGE(NM,ILHF,IEG,JEG,KEG,X1AXEG,XV1,XV2) - ! Build S,T,N transformation matrix: - N(:,1) = -NVEC; S(:,1) = XC2/NORM2(XC2); CALL CROSS_PRODUCT(T(:,1),N(:,1),S(:,1)) - TBN(1,:)= S(:,1); TBN(2,:)= T(:,1); TBN(3,:)= N(:,1) +INTEGER, INTENT(IN) :: NM,ILHF,IEG,JEG,KEG,X1AXEG +REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) - ! Check that cut-face centroid is within its polygon. - XYZC2(IAXIS:KAXIS,1) = CFCEN(IAXIS:KAXIS); XYZCSTN = MATMUL(TBN,XYZC2) - DO IV = 1,NVERT2; XYZVERTSTN(:,IV) = MATMUL(TBN,XYZVERTIJK(:,IV))-XYZCSTN(:,1); ENDDO - CFELEM2(1:VERT_CUTFACE2) =M%CUT_FACE(IFC1)%CFELEM(1:VERT_CUTFACE2,JFC1) - PTCEN(IAXIS:JAXIS) = 0._EB; CALL POINT_IN_POLYGON(PTCEN,VERT_CUTFACE2,CFELEM2,NVERT2,1,2,XYZVERTSTN,IN_CFACE) - IF(.NOT.IN_CFACE) CYCLE +! Local Variables: +INTEGER :: NVERT,INOD1,INOD2,ICF,CEI,NEDGE,NOD1_TYPE,NOD2_TYPE,LOHI,AXIS +TYPE(MESH_TYPE), POINTER :: M - ! Run again over all CFACES of the JCC cut-cell (except IFC) and check for other intersections within their polygons: - ! 1. First of all compute XYZCENSTN, allocate XYZVERTSTN and populate it. Compute XYZVERTSTN-XYZCENSTN. - XYZCSTN = MATMUL(TBN,XYZC) - DO IV = 1,NVERT2 - XYZVERTSTN(:,IV) = MATMUL(TBN,XYZVERTIJK(:,IV))-XYZCSTN(:,1) - ENDDO +M=>MESHES(NM) +IF(M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG)==CC_SOLID) RETURN - ! 2. Run over CFACEs, copy CFELEM and find if intersection point in CFACE + point location: - DO IFCC=1,CC%CCELEM(1,JCC) - IF(IFCC==IFC) CYCLE - IFACE2 = CC%CCELEM(IFCC+1,JCC) - IFC2 = CC%FACE_LIST(4,IFACE2) - JFC2 = CC%FACE_LIST(5,IFACE2) - IF (CC%FACE_LIST(1,IFACE2) /= CC_FTYPE_CFINB) CYCLE +! Define Gas Cut-edge: +CEI = M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) +IF(CEI<1) THEN + ! Allocate space for cut-edge in CUT_EDGE: + CEI = M%N_CUTEDGE_MESH + 1 + M%N_CUTEDGE_MESH = CEI + M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG) = CC_CUTCFE + M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + M%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + M%CUT_EDGE(CEI)%NEDGE = 0 + M%CUT_EDGE(CEI)%NEDGE1 = 0 + M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+1) = (/ IEG,JEG,KEG,X1AXEG /) ! Gas right to solid left. + M%CUT_EDGE(CEI)%STATUS = CC_GASPHASE + ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB + ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED - CFCEN(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZCEN(IAXIS:KAXIS,JFC2) - CFELEM2(1:VERT_CUTFACE2) = M%CUT_FACE(IFC2)%CFELEM(1:VERT_CUTFACE2,JFC2) - XC2(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZVERT(IAXIS:KAXIS,CFELEM2(2))-CFCEN(IAXIS:KAXIS) - XC3(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZVERT(IAXIS:KAXIS,CFELEM2(3))-CFCEN(IAXIS:KAXIS) - CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) - IF (NORM2(NVEC)XN_CEN+GEOMEPS) CYCLE - ! Found an intersection in a face closer to XYZC than original CF centroid, try another point. - CYCLE IFC_LOOP - ENDIF - ENDDO - ! Did not find intersection, XYZC is inside the cut-cell, use as XYZCEN: - FGPOINT=.TRUE. - XYZCEN(IAXIS:KAXIS) = XYZC(IAXIS:KAXIS,1) - EXIT IFC_LOOP - ENDDO IFC_LOOP - ! If point in inside cut-cell not found - fall back to using cut-cell centroid: - IF(.NOT.FGPOINT) XYZCEN(IAXIS:KAXIS) = CC%XYZCEN(IAXIS:KAXIS,JCC) - PTCEN(IAXIS:JAXIS) = XYZCEN( (/ X2AXIS, X3AXIS /) ) +! Add new cut-edge created from regular edge: +NVERT = M%CUT_EDGE(CEI)%NVERT +CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) +CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) +CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) - NCROSS=0; - IF(FC_TYPE==CC_SOLID ) BLOCK_CELL=.TRUE. - IF(FC_TYPE==CC_GASPHASE) BLOCK_CELL=.FALSE. - ! Here do ray-tracing from FC_FOUND to centroid location for this cut cell, use point in poly to note the - ! intersections with CC_INBOUNDARY cut-faces: - ! IF(NM==1 .AND. ICC<30) THEN - ! WRITE(LU_CCELL,*) PTCEN(IAXIS:JAXIS) - ! DO I=1,NVERT - ! WRITE(LU_CCELL,*) CF2%XYZVERT(:,I) +NEDGE = M%CUT_EDGE(CEI)%NEDGE+1 +CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) + +! Define Vert List for newly defined cut-edge: +IF (ILHF==-1) THEN + NOD1_TYPE = CC_VTYPE_VGAS + NOD2_TYPE = CC_VTYPE_VINB +ELSE + NOD1_TYPE = CC_VTYPE_VINB + NOD2_TYPE = CC_VTYPE_VGAS +ENDIF +SELECT CASE(X1AXEG) +CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG-1,JEG ,KEG /) +CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG-1,KEG /) +CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG ,KEG-1/) +END SELECT +M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/NOD2_TYPE,IEG ,JEG ,KEG /) + +! Add edge: Assumes XV1 < XV2 in X1AXEG direction: +M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) + +M%CUT_EDGE(CEI)%NVERT = NVERT +M%CUT_EDGE(CEI)%NEDGE = NEDGE + +! There might be cut-faces that note this EDGE as a regular Gas edge, change incidence in their EDGE_LIST: +SELECT CASE(X1AXEG) +CASE(IAXIS) + ! Face at LOC=-2, located at low Z normal to Y axis: + ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC=-1, located at low Y normal to Z axis: + ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 1, located at high Y normal to Z axis: + ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 2, located at high Z normal to Y axis: + ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) +CASE(JAXIS) + ! Face at LOC=-2, located at low X normal to Z axis: + ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC=-1, located at low Z normal to X axis: + ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 1, located at high Z normal to X axis: + ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 2, located at high X normal to Z axis: + ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) +CASE(KAXIS) + ! Face at LOC=-2, located at low Y normal to X axis: + ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC=-1, located at low X normal to Y axis: + ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! IF(IEG==7 .AND. JEG==4 .AND. KEG==4) THEN + ! WRITE(LU_ERR,*) 'Found EDGE IN CUTEDGE To EDGE IF,JF,KF,AXIS,ICF=',IEG,JEG,KEG,JAXIS,ICF,CEI + ! DO INOD1=1,SIZE(M%CUT_FACE(ICF)%EDGE_LIST,DIM=2)-1 + ! WRITE(LU_ERR,*) M%CUT_FACE(ICF)%EDGE_LIST(:,INOD1) ! ENDDO ! ENDIF - INBFC_LOC_LOOP : DO INBFC_LOC=1,CF2%NFACE - ! Normal, max normal component, define plane X2AXIS,X3AXIS to do search: - CFELEM(1:VERT_CUTFACE) = CF2%CFELEM(1:VERT_CUTFACE,INBFC_LOC) - XC2(IAXIS:KAXIS) = CF2%XYZVERT(IAXIS:KAXIS,CFELEM(2))-CF2%XYZCEN(IAXIS:KAXIS,INBFC_LOC) - XC3(IAXIS:KAXIS) = CF2%XYZVERT(IAXIS:KAXIS,CFELEM(3))-CF2%XYZCEN(IAXIS:KAXIS,INBFC_LOC) - CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) + ! Face at LOC= 1, located at high X normal to Y axis: + ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 2, located at high Y normal to X axis: + ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) +END SELECT - IF (NORM2(NVEC)X1F +GEOMEPS) CYCLE INBFC_LOC_LOOP - ELSE - IF(XYZ_P(X1AXIS)XYZCEN(X1AXIS)+GEOMEPS) CYCLE INBFC_LOC_LOOP - ENDIF - NCROSS = NCROSS + 1 ! Add crossing between face and cut-cell centroid. - BLOCK_CELL=.NOT.BLOCK_CELL - ENDIF - ! IF(NM==1 .AND. ICC<30) THEN - ! IF(MY_RANK==0) WRITE(0,*) 'TESTS INBFC_LOC_LOOP',INBFC_LOC,PTCEN(IAXIS:JAXIS),XYZCEN(X1AXIS),XYZ_P(X1AXIS),& - ! NVEC(2),D,IN_CFACE,BLOCK_CELL - ! ENDIF - ENDDO INBFC_LOC_LOOP - ! Here set no ADVANCE if BLOCK_CELL=T: - IF(BLOCK_CELL .AND. CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC) = BLOCKED_REFI_INTER -ENDDO JCC_LOOP +END SUBROUTINE ADD_CUTEDGE_TO_EDGE -! IF(NM==1 .AND. ICC<30) CLOSE(LU_CCELL) +! --------------------------- REPL_CUTEDGE_IN_LIST_EDGES --------------------------- -DEALLOCATE(CFELEM) -IF(ALLOCATED(XYZVERTIJK)) DEALLOCATE(XYZVERTIJK,XYZVERTSTN,CFELEM2) -RETURN -END SUBROUTINE TEST_CC_FOR_BLOCKING +SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,IEC,JEC,LOHI,AXIS) -SUBROUTINE GET_CC_FACE_CELL_LIST_INFO(NM,PHASE) +INTEGER, INTENT(IN) :: NM,ICF,IEC,JEC,LOHI,AXIS +INTEGER :: IEDGE,DUM -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: PHASE +IF(ICF>0) THEN + DUM=0; IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST)) DUM=SIZE(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST,DIM=2) + DO IEDGE=1,DUM-1 + IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE + IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE + IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(3,IEDGE)/=AXIS) CYCLE + MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFGAS,IEC,JEC/) + RETURN + ENDDO +ENDIF +END SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES -! Local Vars: -INTEGER :: ICC,JCC,IFC,IFACE,ICF1,ICF2,JCF,ICE,JCE,IIE,JJE,KKE,IIF,JJF,KKF,X1AXIS,EAXIS,IEDG_LOC,IEDGE +! ------------------------------ ADD_REGEDGE_TO_FACE ------------------------------- + +SUBROUTINE ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD,XV1,XV2,CEI,NEDGE,IV_LIST) + + +! ILHF -1 face in low side of edge, 0 face on high side of edge. + +INTEGER, INTENT(IN) :: NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD +REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) +INTEGER, INTENT(OUT):: CEI,NEDGE +LOGICAL, INTENT(IN) :: IV_LIST + +! Local Variables: +INTEGER :: NVERT,INOD1,INOD2,ICF,IEDGE,LOHI TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTFACE_TYPE), POINTER :: CF + M=>MESHES(NM) +IF(M%FCVAR(IFC,JFC,KFC,CC_FGSC,X1AXFC)==CC_SOLID) RETURN -! FACE-CELL incidence: -CUT_CELL_LOOP : DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC) - IF(PHASE==2) THEN - IF(CC%IJK(IAXIS)<-1 .OR. CC%IJK(IAXIS)>M%IBAR+2) CYCLE CUT_CELL_LOOP - IF(CC%IJK(JAXIS)<-1 .OR. CC%IJK(JAXIS)>M%JBAR+2) CYCLE CUT_CELL_LOOP - IF(CC%IJK(KAXIS)<-1 .OR. CC%IJK(KAXIS)>M%KBAR+2) CYCLE CUT_CELL_LOOP - ENDIF - DO JCC=1,CC%NCELL - ! Loop faces and test: - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - SELECT CASE(CC%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_CFGAS) ! GASPHASE cut-face: - ICF1 = CC%FACE_LIST(4,IFACE) - ICF2 = CC%FACE_LIST(5,IFACE); CF => M%CUT_FACE(ICF1) - IF (CC%FACE_LIST(2,IFACE) == LOW_IND) THEN ! Cut-face on low side of cut-cell: - CF%CELL_LIST(IAXIS:KAXIS+1,HIGH_IND,ICF2) = & - (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) - ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. - CF%XCENHIGH(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) - ELSE ! HIGH - CF%CELL_LIST(IAXIS:KAXIS+1,LOW_IND,ICF2) = & - (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) - ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. - CF%XCENLOW(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) - ENDIF - CASE(CC_FTYPE_CFINB) ! INBOUNDARY cut-face: - ICF1 = CC%FACE_LIST(4,IFACE) - ICF2 = CC%FACE_LIST(5,IFACE); CF => M%CUT_FACE(ICF1) - ! We add the cut-cell related info in LOW_IND - CF%CELL_LIST(IAXIS:KAXIS+1,LOW_IND,ICF2) = & - (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) - ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. - CF%XCENLOW(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) - END SELECT - ENDDO - ENDDO -ENDDO CUT_CELL_LOOP +! Define Edge as INB cut-edge, add to CUT_EDGE: +CEI = M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) +IF (CEI < 1) THEN + ! Allocate space for cut-edge in CUT_EDGE: + CEI = M%N_CUTEDGE_MESH + 1 + M%N_CUTEDGE_MESH = CEI + M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + M%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + M%CUT_EDGE(CEI)%NEDGE = 0 + M%CUT_EDGE(CEI)%NEDGE1 = 0 + M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. + M%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF + ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB + ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED +ENDIF -! EDGE-FACE incidence: -! First Allocate DXX and FACE_LIST for CUT_EDGEs: -DO ICE=1,M%N_CUTEDGE_MESH - CE => M%CUT_EDGE(ICE) - IF(ALLOCATED(CE%DXX)) DEALLOCATE(CE%DXX) - IF(ALLOCATED(CE%FACE_LIST)) DEALLOCATE(CE%FACE_LIST) - IF(ALLOCATED(CE%DUIDXJ)) DEALLOCATE(CE%DUIDXJ) - IF(ALLOCATED(CE%MU_DUIDXJ)) DEALLOCATE(CE%MU_DUIDXJ) - ! DXX(1), DXX(2) - ALLOCATE(CE%DXX(1:2,SIZE(CE%CEELEM,DIM=2))); CE%DXX = 0._EB - ! ! ICF JCF, dir -2 -1 1 2, JCE. - ALLOCATE(CE%FACE_LIST(1:3,-2:2,SIZE(CE%CEELEM,DIM=2))); CE%FACE_LIST = CC_UNDEFINED -ENDDO +! Add cut-edge: +NVERT = M%CUT_EDGE(CEI)%NVERT +CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) +CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) +CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) -CUTFACE_LOOP : DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CF => M%CUT_FACE(ICF); IF(CF%STATUS/=CC_GASPHASE) CYCLE - IIF= CF%IJK(IAXIS); JJF= CF%IJK(JAXIS); KKF= CF%IJK(KAXIS); X1AXIS= CF%IJK(KAXIS+1) - IF(PHASE==2) THEN - SELECT CASE (X1AXIS) - CASE(IAXIS) - IF(IIF<-2 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP - IF(JJF<-1 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP - IF(KKF<-1 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP - CASE(JAXIS) - IF(IIF<-1 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP - IF(JJF<-2 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP - IF(KKF<-1 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP - CASE(KAXIS) - IF(IIF<-1 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP - IF(JJF<-1 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP - IF(KKF<-2 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP - END SELECT +DO NEDGE=1,M%CUT_EDGE(CEI)%NEDGE + IF( (INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) .OR. & + (INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) ) THEN + RETURN ! Edge already in Face cut-edges list. ENDIF - DO JCF=1,CF%NFACE - DO IEDG_LOC=2,CF%CEDGES(1,JCF)+1 - IEDGE = CF%CEDGES(IEDG_LOC,JCF) - SELECT CASE(CF%EDGE_LIST(1,IEDGE)) - CASE(CC_ETYPE_RGGAS) ! RCEDGE to be defined in .. - ! LOHI = CF%EDGE_LIST(2,IEDGE) - ! AXIS = CF%EDGE_LIST(3,IEDGE) - ! CC_RCEDGE.. Filled once RCEDGES are built. - CASE(CC_ETYPE_CFGAS) ! Gas cut-edge - ICE = CF%EDGE_LIST(2,IEDGE) - JCE = CF%EDGE_LIST(3,IEDGE) - CE => M%CUT_EDGE(ICE) - IIE = CE%IJK(IAXIS); JJE = CE%IJK(JAXIS); KKE = CE%IJK(KAXIS) - EAXIS= CE%IJK(KAXIS+1) - SELECT CASE(EAXIS) - CASE(IAXIS) ! Edge in x dir. - IF(X1AXIS==KAXIS) THEN ! Face in z dir, +/- y. - CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(YFACE(JJE)-CF%XYZCEN(JAXIS,JCF)) - IF(JJF==JJE) THEN ! Face -1, resp to IEDGE. - CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(JJF==JJE+1) THEN - CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) - ENDIF - ELSEIF(X1AXIS==JAXIS) THEN ! Face in y dir, +/- z: - CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(ZFACE(KKE)-CF%XYZCEN(KAXIS,JCF)) - IF(KKF==KKE) THEN ! Face -2, resp to IEDGE. - CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(KKF==KKE+1) THEN - CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) - ENDIF - ENDIF - CASE(JAXIS) ! Edge in y dir. - IF(X1AXIS==IAXIS) THEN ! Face in x dir, +/- z. - CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(ZFACE(KKE)-CF%XYZCEN(KAXIS,JCF)) - IF(KKF==KKE) THEN ! Face -1, resp to IEDGE. - CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(KKF==KKE+1) THEN - CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) - ENDIF - ELSEIF(X1AXIS==KAXIS) THEN ! Face in z dir, +/- x - CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(XFACE(IIE)-CF%XYZCEN(IAXIS,JCF)) - IF(IIF==IIE) THEN ! Face -2, resp to IEDGE. - CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(IIF==IIE+1) THEN - CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) - ENDIF - ENDIF - CASE(KAXIS) ! Edge in z dir. - IF(X1AXIS==JAXIS) THEN ! Face in y dir, +/- x. - CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(XFACE(IIE)-CF%XYZCEN(IAXIS,JCF)) - IF(IIF==IIE) THEN ! Face -1, resp to IEDGE. - CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(IIF==IIE+1) THEN - CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) - ENDIF - ELSEIF(X1AXIS==IAXIS) THEN ! Face in x dir, +/- y. - CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(YFACE(JJE)-CF%XYZCEN(JAXIS,JCF)) - IF(JJF==JJE) THEN ! Face -2, resp to IEDGE. - CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(JJF==JJE+1) THEN - CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) - ENDIF - ENDIF - END SELECT - - CASE(CC_ETYPE_CFINB) ! Inboundary cut-edge (face) - - END SELECT - ENDDO - ENDDO -ENDDO CUTFACE_LOOP - -! Allocate for gas CUT_EDGEs DUIDXJ, MU_DUIDXJ -DO ICE=1,M%N_CUTEDGE_MESH - CE => M%CUT_EDGE(ICE); IF(CE%STATUS/=CC_GASPHASE) CYCLE - IF(.NOT.ALLOCATED(CE%DUIDXJ)) THEN - ALLOCATE(CE%DUIDXJ( -2:2,1:SIZE(CE%CEELEM,DIM=2))); CE%DUIDXJ = 0._EB - ALLOCATE(CE%MU_DUIDXJ(-2:2,1:SIZE(CE%CEELEM,DIM=2))); CE%MU_DUIDXJ = 0._EB - ENDIF - ! Assign DXX to grid size for cut-edges with unassigned deltas: - I=CE%IJK(IAXIS); J=CE%IJK(JAXIS); K=CE%IJK(KAXIS); X1AXIS=CE%IJK(KAXIS+1) - DO JCE=1,CE%NEDGE - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(CE%DXX(1,JCE)M%CUT_FACE(ICF1) - WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE,CF%STATUS - DO ICF2=1,CF%NFACE - WRITE(33,'(I8,3F16.8,F16.8)') ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) - ICC=CF%CELL_LIST(2,LOW_IND,ICF2); JCC=CF%CELL_LIST(3,LOW_IND,ICF2) - WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& - M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) - CC=>M%CUT_CELL(ICC) - IFACE = CC%CCELEM(CF%CELL_LIST(4,LOW_IND,ICF2)+1,JCC) - IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN - WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& - ICF2,CC%FACE_LIST(5,IFACE) - ENDIF +SELECT CASE(X1AXEG) +CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG-1,JEG ,KEG /) +CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG-1,KEG /) +CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG ,KEG-1/) +END SELECT +M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,IEG ,JEG ,KEG /) +IF(IV_LIST) THEN + ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: + M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) + IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) +ELSE + ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: + M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) + IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) +ENDIF - IF(CF%STATUS==CC_GASPHASE) THEN - ICC=CF%CELL_LIST(2,HIGH_IND,ICF2); JCC=CF%CELL_LIST(3,HIGH_IND,ICF2) - WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& - M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) - CC=>M%CUT_CELL(ICC) - IFACE = CC%CCELEM(CF%CELL_LIST(4,HIGH_IND,ICF2)+1,JCC) - IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN - WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& - ICF2,CC%FACE_LIST(5,IFACE) - ENDIF +M%CUT_EDGE(CEI)%NVERT = NVERT +M%CUT_EDGE(CEI)%NEDGE = NEDGE - ENDIF - ENDDO - ENDIF - ENDDO - X1AXIS=0 - IF(M%CCVAR(I,J,K,CC_IDCF)>0)THEN - ICF1=M%CCVAR(I,J,K,CC_IDCF); CF=>M%CUT_FACE(ICF1) - WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE,CF%STATUS - DO ICF2=1,CF%NFACE - WRITE(33,'(I8,3F16.8,F16.8)') ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) - ICC=CF%CELL_LIST(2,LOW_IND,ICF2); JCC=CF%CELL_LIST(3,LOW_IND,ICF2) - WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& - M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) - CC=>M%CUT_CELL(ICC) - IFACE = CC%CCELEM(CF%CELL_LIST(4,LOW_IND,ICF2)+1,JCC) - IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN - WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& - ICF2,CC%FACE_LIST(5,IFACE) - ENDIF - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - CLOSE(33) +M%CUT_EDGE(CEI)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFACES.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,A,I8,I8,I8,I8)') I,J,K,':',& - M%ECVAR(I,J,K,CC_EGSC,IAXIS),M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) - DO X1AXIS=IAXIS,KAXIS - IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN - ICE=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(ICE) - WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE - DO JCE=1,CE%NEDGE - WRITE(33,'(I8,F12.8,F12.8)') JCE,CE%DXX(1,JCE),CE%DXX(2,JCE) - DO JCF=-2,2 - IF(JCF==0) CYCLE - ! Face JCF: - ICF1=CE%FACE_LIST(1,JCF,JCE); ICF2=CE%FACE_LIST(2,JCF,JCE) - CF=>M%CUT_FACE(ICF1) - WRITE(33,'(4I8,I8,3F16.8,F16.8)') CF%IJK(1:4),ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) - ENDDO - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO +ICF = M%FCVAR(IFC,JFC,KFC,CC_IDCF,X1AXFC) +IF (ICF>0) THEN ! There are cut-faces in this face + LOHI= LOW_IND; IF(ILHF==-1) LOHI=HIGH_IND + ! Define Edge as INB CUT_EDGE, find corresponding RGGAS EDGE associated cut-face and replace it + CF=>M%CUT_FACE(ICF); + INOD1=0; IF(ALLOCATED(CF%EDGE_LIST)) INOD1=SIZE(CF%EDGE_LIST,DIM=2) + DO IEDGE=1,INOD1-1 + IF(CF%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE + IF(CF%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE + IF(CF%EDGE_LIST(3,IEDGE)/=X1AXIS) CYCLE + CF%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFINB, CEI, NEDGE/) + RETURN ENDDO - CLOSE(33) ENDIF -RETURN -END SUBROUTINE GET_CC_FACE_CELL_LIST_INFO - - -! ---------------------- GET_REGULAR_CUTCELLS_BOX ------------------------------ +END SUBROUTINE ADD_REGEDGE_TO_FACE -SUBROUTINE GET_REGULAR_CUTCELLS_BOX -! Local Variables: -INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: GEOMCELL -INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: GEOMFACE -INTEGER :: IBNDINT,INTGC_FLG,BNDINT_LOW,BNDINT_HIGH,II,JJ,KK,X1LO,X1HI,X2LO,X2HI,X3LO,X3HI,INDXI(IAXIS:KAXIS) -INTEGER :: INDI,INDJ,INDK,INDI1,INDJ1,INDK1,INDI2,INDJ2,INDK2,INDI3,INDJ3,INDK3,INDI4,INDJ4,INDK4 -INTEGER :: INDXI1(IAXIS:KAXIS),INDXI2(IAXIS:KAXIS),INDXI3(IAXIS:KAXIS),INDXI4(IAXIS:KAXIS) -INTEGER :: NVERT,NFACE,NVERTFACE,NCUTFACE,NCUTCELL,FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS),CFELEM(1:NOD4+1,6),& - IDCF_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) -INTEGER :: LOHI,IWSEL,I1,I2,I3,IBOD(6),ITRI(6),FACE_LIST(1:CC_NPARAM_CCFACE,1:6),CEI_AXIS(LOW_IND:HIGH_IND),& - CEI,SIDE,NCFACE_CUTCELL,NFACE_CELL -REAL(EB):: DIST, DIST2, VOL(1) -REAL(EB):: XYZLC(IAXIS:KAXIS),XYZVERT(IAXIS:KAXIS,NOD1:NOD4+20),AREA(6),XYZCEN(IAXIS:KAXIS,6),XCEN(IAXIS:KAXIS) -REAL(EB):: INXAREA(IAXIS:KAXIS,1:6)=0._EB,INXSQAREA(IAXIS:KAXIS,1:6)=0._EB -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNTED2,IJK_COUNT +! --------------------------------- DROP_REG_FACE ------------------------------------------- +SUBROUTINE DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) -! Allocate Face - Geom numbering and Cell - Geom numbering arrays -ALLOCATE(GEOMFACE(ISTR:IEND,JSTR:JEND,KSTR:KEND,MAX_DIM)); GEOMFACE = CC_GASPHASE -ALLOCATE(GEOMCELL(ISTR:IEND,JSTR:JEND,KSTR:KEND)); GEOMCELL = CC_GASPHASE +INTEGER, INTENT(IN) :: NM,I,J,K,ILHF,X1AXIS -! First tag cells: NM is set and we have all the mesh info in MESHES(NM) -DO K=KLO_CELL-NGUARD,KHI_CELL+NGUARD - DO J=JLO_CELL-NGUARD,JHI_CELL+NGUARD - DO I=ILO_CELL-NGUARD,IHI_CELL+NGUARD - DO IG=1,N_GEOMETRY - IF(XCELL(I) < GEOMETRY(IG)%XB(1)) CYCLE - IF(XCELL(I) > GEOMETRY(IG)%XB(2)) CYCLE - IF(YCELL(J) < GEOMETRY(IG)%XB(3)) CYCLE - IF(YCELL(J) > GEOMETRY(IG)%XB(4)) CYCLE - IF(ZCELL(K) < GEOMETRY(IG)%XB(5)) CYCLE - IF(ZCELL(K) > GEOMETRY(IG)%XB(6)) CYCLE - GEOMCELL(I,J,K) = IG - MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_SOLID - EXIT - ENDDO - ENDDO - ENDDO -ENDDO +SELECT CASE(X1AXIS) +CASE(IAXIS) + ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: + MESHES(NM)%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID + MESHES(NM)%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: + MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_EGSC,JAXIS)= CC_SOLID ! X2 + MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_IDCE,JAXIS)= CC_UNDEFINED + MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_EGSC,KAXIS)= CC_SOLID ! X3 + MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_IDCE,KAXIS)= CC_UNDEFINED + ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: + MESHES(NM)%VERTVAR(I+ILHF, J-1:J, K-1:K,CC_VGSC) = CC_SOLID +CASE(JAXIS) + ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: + MESHES(NM)%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID + MESHES(NM)%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: + MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_EGSC,KAXIS)= CC_SOLID ! X2 + MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_IDCE,KAXIS)= CC_UNDEFINED + MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_EGSC,IAXIS)= CC_SOLID ! X3 + MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_IDCE,IAXIS)= CC_UNDEFINED + ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: + MESHES(NM)%VERTVAR( I-1:I,J+ILHF, K-1:K,CC_VGSC) = CC_SOLID +CASE(KAXIS) + ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: + MESHES(NM)%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID + MESHES(NM)%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED + ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: + MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_EGSC,IAXIS)= CC_SOLID ! X2 + MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_IDCE,IAXIS)= CC_UNDEFINED + MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_EGSC,JAXIS)= CC_SOLID ! X3 + MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_IDCE,JAXIS)= CC_UNDEFINED + ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: + MESHES(NM)%VERTVAR( I-1:I, J-1:J,K+ILHF,CC_VGSC) = CC_SOLID +END SELECT -! Now Tag cut-cells: The -2, +2 is to be able to define cut-face types below on boundary of GC cut-cells. -DO K=KLO_CELL-NGUARD+1,KHI_CELL+NGUARD-1 - DO J=JLO_CELL-NGUARD+1,JHI_CELL+NGUARD-1 - DO I=ILO_CELL-NGUARD+1,IHI_CELL+NGUARD-1 - IF(MESHES(NM)%CCVAR(I,J,K,CC_CGSC)==CC_SOLID) THEN - ! Set all vertices to Solid: - MESHES(NM)%VERTVAR(I-1,J ,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I-1,J-1,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I-1,J-1,K-1,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I-1,J ,K-1,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J ,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J-1,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J-1,K-1,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J ,K-1,CC_VGSC) = CC_SOLID - CYCLE - ENDIF - IF(ANY(MESHES(NM)%CCVAR(I-1:I+1,J-1:J+1,K-1:K+1,CC_CGSC) == CC_SOLID)) & - MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE - ENDDO - ENDDO -ENDDO +END SUBROUTINE DROP_REG_FACE -! Then tag faces: -! X Faces: -DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD - DO J=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD - DO I=ILO_FACE-CCGUARD,IHI_FACE+CCGUARD - ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: - IF(ANY(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_GASPHASE)) CYCLE - ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: - IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_SOLID)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID - GEOMFACE(I,J,K,IAXIS) = GEOMCELL(I,J,K) - CYCLE - ENDIF +! --------------------------- INSERT_CUT_CELL ----------------------------------------------- - ! Now Gasphase cut-faces: All CCVAR == CUTCFE - IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_CUTCFE)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_CUTCFE - ! GEOMFACE(I,J,K,IAXIS) stays CC_GASPHASE - CYCLE - ENDIF +SUBROUTINE INSERT_CUT_CELL(NM,I,J,K,ICC) - ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: - IF (GEOMCELL(I,J,K)*GEOMCELL(I+1,J,K) < 0) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID - GEOMFACE(I,J,K,IAXIS) = MAXVAL(GEOMCELL(I:I+1,J,K)) ! This is because one is ==CC_GASPHASE==-1 - CYCLE - ENDIF - ENDDO - ENDDO -ENDDO +! Adds a cut-cell entry ICF in the CUT_CELL array, assumes no cut-cell defined in cell I,J,K. +INTEGER, INTENT(IN) :: NM,I,J,K +INTEGER, INTENT(OUT):: ICC -! Y Faces: -DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD - DO J=JLO_FACE-CCGUARD,JHI_FACE+CCGUARD - DO I=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD - ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: - IF(ANY(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_GASPHASE)) CYCLE +INTEGER :: DUM,KDUM,JDUM,IDUM,ICF,JCF - ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: - IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_SOLID)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_SOLID - GEOMFACE(I,J,K,JAXIS) = GEOMCELL(I,J,K) - CYCLE - ENDIF +TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX - ! Now Gasphase cut-faces: All CCVAR == CUTCFE - IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_CUTCFE)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_CUTCFE - ! GEOMFACE(I,J,K,JAXIS) stays CC_GASPHASE - CYCLE - ENDIF +IF( 0=ICC) & + MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC) + 1 ENDDO ENDDO ENDDO +DO ICF=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + DO JCF=1,MESHES(NM)%CUT_FACE(ICF)%NFACE + IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>ICC) & + MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + 1 + IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>ICC) & + MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + 1 + ENDDO +ENDDO +MESHES(NM)%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) +MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE +MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = ICC -! Now define Gasphase and boundary cut-faces: 1 Boundary, 2 internal, 3 guard cell faces: -INTGC_FLG_LOOP : DO INTGC_FLG=LOW_IND,HIGH_IND +RETURN +END SUBROUTINE INSERT_CUT_CELL - ! GASPHASE cut-faces: - NVERT = 4; NFACE = 1; NVERTFACE = 5 - IF (INTGC_FLG==LOW_IND) THEN - ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. - BNDINT_LOW = 1; BNDINT_HIGH = 3 - ELSE - BNDINT_LOW = 4; BNDINT_HIGH = 4 - ENDIF +! --------------------------- INSERT_CUT_FACE ----------------------------------------------- - IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, - ! 4 guard-cell faces. +SUBROUTINE INSERT_CUT_FACE(NM,I,J,K,AXIS,ICF,INZONE) - ! When switching to internal faces, copy number of external faces already computed. - IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH +! This routine add a cut-face entry ICF in the CUT_FACE array: +! 1. IF AXIS = 0 INBOUNDARY face: +! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK is an interior cell. +! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK is a guard cell. +! 2. IF AXIS = 1,2,3 GASPHASE face: +! ICF = MESHES(NM)%N_BBCUTFACE_MESH+1 if II,JJ,KK,AXIS is a boundary face. +! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK,AXIS is an interior face. +! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK,AXIS is a guard face. +INTEGER, INTENT(IN) :: NM,I,J,K,AXIS +INTEGER, INTENT(OUT):: ICF +LOGICAL, OPTIONAL, INTENT(IN) :: INZONE - X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS - SELECT CASE(X1AXIS) - CASE(IAXIS) - X2AXIS = JAXIS; X3AXIS = KAXIS - ! IAXIS gasphase cut-faces: - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - ILO = ILO_FACE; IHI = ILO_FACE - CASE(2) - ILO = IHI_FACE; IHI = IHI_FACE - CASE(3) - ILO = ILO_FACE+1; IHI = IHI_FACE-1 - CASE(4) - ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS - ! Local indexing in x1, x2, x3: - X1LO = ILO; X1HI = IHI - X2LO = JLO; X2HI = JHI - X3LO = KLO; X3HI = KHI - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE - ALLOCATE(X2FACE(JSTR:JEND)); X2FACE = YFACE - ALLOCATE(X3FACE(KSTR:KEND)); X3FACE = ZFACE - CASE(JAXIS) - X2AXIS = KAXIS; X3AXIS = IAXIS - ! JAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - JLO = JLO_FACE; JHI = JLO_FACE - CASE(2) - JLO = JHI_FACE; JHI = JHI_FACE - CASE(3) - JLO = JLO_FACE+1; JHI = JHI_FACE-1 - CASE(4) - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS - ! Local indexing in x1, x2, x3: - X1LO = JLO; X1HI = JHI - X2LO = KLO; X2HI = KHI - X3LO = ILO; X3HI = IHI - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE - ALLOCATE(X2FACE(KSTR:KEND)); X2FACE = ZFACE - ALLOCATE(X3FACE(ISTR:IEND)); X3FACE = XFACE - - CASE(KAXIS) - X2AXIS = IAXIS; X3AXIS = JAXIS - ! KAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - KLO = KLO_FACE; KHI = KLO_FACE - CASE(2) - KLO = KHI_FACE; KHI = KHI_FACE - CASE(3) - KLO = KLO_FACE+1; KHI = KHI_FACE-1 - CASE(4) - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - END SELECT - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS - ! Local indexing in x1, x2, x3: - X1LO = KLO; X1HI = KHI - X2LO = ILO; X2HI = IHI - X3LO = JLO; X3HI = JHI - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE - ALLOCATE(X2FACE(ISTR:IEND)); X2FACE = XFACE - ALLOCATE(X3FACE(JSTR:JEND)); X3FACE = YFACE - - END SELECT +INTEGER :: ICC,JCC,IFC,IFACE,IFCX,DUM,IDUM,JDUM,KDUM,X1AXIS,ICE,ILOC,IEDGE +TYPE(CC_CUTFACE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_FACE_AUX - ! Loop on Cartesian faces, local x1, x2, x3 indexes: - DO II=X1LO,X1HI - DO KK=X3LO,X3HI - DO JJ=X2LO,X2HI - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI = INDXI(XIAXIS) - INDJ = INDXI(XJAXIS) - INDK = INDXI(XKAXIS) - ! Drop if not CUTCFE: - IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE; IJK_COUNTED(INDI,INDJ,INDK,X1AXIS)=.TRUE. - IF(MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE +IF(AXIS==0) THEN + IF( 0MESHES(NM)%IBAR) THEN ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ELSEIF(I==0 .OR. I==MESHES(NM)%IBAR) THEN ! Block boundary + MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 + MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 + ICF = MESHES(NM)%N_BBCUTFACE_MESH + ENDIF + ELSE ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ENDIF + CASE(JAXIS) + IF(0MESHES(NM)%JBAR) THEN ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ELSEIF(J==0 .OR. J==MESHES(NM)%JBAR) THEN ! Block boundary + MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 + MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 + ICF = MESHES(NM)%N_BBCUTFACE_MESH + ENDIF + ELSE ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ENDIF + CASE(KAXIS) + IF(0MESHES(NM)%KBAR) THEN ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ELSEIF(K==0 .OR. K==MESHES(NM)%KBAR) THEN ! Block boundary + MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 + MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 + ICF = MESHES(NM)%N_BBCUTFACE_MESH + ENDIF + ELSE ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ENDIF + END SELECT +ENDIF +! Reallocate CUT_FACE: +ALLOCATE(CUT_FACE_AUX( MAX(SIZE(MESHES(NM)%CUT_FACE,DIM=1),MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH) )) +DO DUM=1,ICF-1 + CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM)) +ENDDO +DO DUM=ICF,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH-1 + CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM+1)) +ENDDO +CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE) - ! Vertex at index II,JJ-1,KK-1: - INDXI1(IAXIS:KAXIS) = (/ II, JJ-1, KK-1 /) ! Local x1,x2,x3 - INDI1 = INDXI1(XIAXIS) - INDJ1 = INDXI1(XJAXIS) - INDK1 = INDXI1(XKAXIS) - ! Vertex at index II,JJ,KK-1: - INDXI2(IAXIS:KAXIS) = (/ II, JJ, KK-1 /) ! Local x1,x2,x3 - INDI2 = INDXI2(XIAXIS) - INDJ2 = INDXI2(XJAXIS) - INDK2 = INDXI2(XKAXIS) - ! Vertex at index II,JJ,KK: - INDXI3(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI3 = INDXI3(XIAXIS) - INDJ3 = INDXI3(XJAXIS) - INDK3 = INDXI3(XKAXIS) - ! Vertex at index II,JJ-1,KK: - INDXI4(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 - INDI4 = INDXI4(XIAXIS) - INDJ4 = INDXI4(XJAXIS) - INDK4 = INDXI4(XKAXIS) +! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): +DO KDUM=-CCGUARD,MESHES(NM)%KBAR+CCGUARD + DO JDUM=-CCGUARD,MESHES(NM)%JBAR+CCGUARD + DO IDUM=-CCGUARD,MESHES(NM)%IBAR+CCGUARD + IF(MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)>=ICF) & + MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF) + 1 + DO X1AXIS=IAXIS,KAXIS + IF(MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS)>=ICF) & + MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) = MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) + 1 + ENDDO + ENDDO + ENDDO +ENDDO +DO ICC=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + DO JCC=1,MESHES(NM)%CUT_CELL(ICC)%NCELL + DO IFC=1,MESHES(NM)%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = MESHES(NM)%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + IF(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) CYCLE + IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) = IFCX+1 + ENDDO + ENDDO + DO IFACE=1,MESHES(NM)%CUT_CELL(ICC)%NFACE_DROPPED + IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) + IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) = IFCX+1 + ENDDO +ENDDO +DO ICE=1,MESHES(NM)%N_CUTEDGE_MESH + CE=>MESHES(NM)%CUT_EDGE(ICE) + DO IEDGE=1,CE%NEDGE + DO ILOC=-2,2 + IF(CE%FACE_LIST(1,ILOC,IEDGE)>=ICF) CE%FACE_LIST(1,ILOC,IEDGE)=CE%FACE_LIST(1,ILOC,IEDGE)+1 + ENDDO + ENDDO +ENDDO +IF(PRESENT(INZONE)) THEN + IF (INZONE) THEN + DO KDUM=0,MESHES(NM)%KBP1 + DO JDUM=0,MESHES(NM)%JBP1 + DO IDUM=0,MESHES(NM)%IBP1 + DO JCC=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%NCELL + DO IFACE=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NWFACE + IF(MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE)>=ICF) & + MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) = & + MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) + 1 + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDIF +ENDIF - ! First, normal direction in x1 direction. - ! For this face: XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - ! Vert 1: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI1(IAXIS)), X2FACE(INDXI1(JAXIS)), X3FACE(INDXI1(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) - ! Vert 2: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI2(IAXIS)), X2FACE(INDXI2(JAXIS)), X3FACE(INDXI2(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) - ! Vert 3: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI3(IAXIS)), X2FACE(INDXI3(JAXIS)), X3FACE(INDXI3(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) - ! Vert 4: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI4(IAXIS)), X2FACE(INDXI4(JAXIS)), X3FACE(INDXI4(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) +IF(AXIS==0) THEN + MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = ICF + MESHES(NM)%CUT_FACE(ICF)%STATUS = CC_INBOUNDARY +ELSE + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,AXIS) = CC_CUTCFE + MESHES(NM)%FCVAR(I,J,K,CC_IDCF,AXIS) = ICF + MESHES(NM)%CUT_FACE(ICF)%STATUS = CC_GASPHASE +ENDIF +MESHES(NM)%CUT_FACE(ICF)%IJK(1:4) = (/I, J, K, AXIS/) - CFELEM(1:5,1) = (/ 4, NOD1, NOD2, NOD3, NOD4 /) +RETURN +END SUBROUTINE INSERT_CUT_FACE - ! Area: - AREA(1) = (X2FACE(INDXI2(JAXIS))-X2FACE(INDXI1(JAXIS)))*(X3FACE(INDXI4(KAXIS))-X3FACE(INDXI1(KAXIS))) +! --------------------------------- DROP_CUT_EDGE ------------------------------------------- - ! XYZCEN in Local Coords: - XYZCEN(IAXIS:KAXIS,1)= (/ X1FACE(II), 0.5_EB*(X2FACE(INDXI2(JAXIS))+X2FACE(INDXI1(JAXIS))), & - 0.5_EB*(X3FACE(INDXI4(KAXIS))+X3FACE(INDXI1(KAXIS))) /) +SUBROUTINE DROP_CUT_EDGE(NM,ICE,JCE,ETYPE) - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(IAXIS,1) = 1._EB * X1FACE(II) * AREA(1) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(IAXIS,1) = 1._EB * X1FACE(II)**2._EB * AREA(1) +INTEGER, INTENT(IN) :: NM,ICE,JCE,ETYPE - ! This is a new cut-face, allocate space: - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (INTGC_FLG==LOW_IND) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCF,X1AXIS) = NCUTFACE +INTEGER :: CT,DUM,ILH,ICF1,IEDGE +INTEGER, ALLOCATABLE, DIMENSION(:) :: IND +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTEDGE_TYPE), POINTER :: CE - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +IF(ICE<1) RETURN +M =>MESHES(NM) +CE=>M%CUT_EDGE(ICE) - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ INDI, INDJ, INDK, X1AXIS /) - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE,IBNDINT) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) +NEDGE_IF_1 : IF(CE%NEDGE>1) THEN + ALLOCATE(IND(CE%NEDGE)); IND = 0 + CT=0; + DO DUM=1,CE%NEDGE + IF(DUM==JCE) CYCLE + CT = CT + 1 + IND(DUM) = CT + ENDDO + ! Collapse NEDGE variables: + DO DUM=1,CE%NEDGE + IF(DUM==JCE) CYCLE + CE%CEELEM( :,IND(DUM)) = CE%CEELEM( :,DUM) + CE%INDSEG( :,IND(DUM)) = CE%INDSEG( :,DUM) + CE%FACE_LIST(:,:,IND(DUM)) = CE%FACE_LIST(:,:,DUM) + CE%DXX( :,IND(DUM)) = CE%DXX( :,DUM) - ! Connectivity: - CF%CFELEM(1:NVERTFACE,NFACE) = CFELEM(1:NVERTFACE,1) - ! Geom Properties: - CF%AREA(NFACE) = AREA(1) - CF%XYZCEN(IAXIS:KAXIS,NFACE) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,1) + ! Finally change EDGE_LIST of involved faces: + DO ILH=-2,2 + ICF1 = CE%FACE_LIST(1,ILH,IND(DUM)); IF(ICF1<1) CYCLE + IEDGE = CE%FACE_LIST(3,ILH,IND(DUM)) + M%CUT_FACE(ICF1)%EDGE_LIST(3,IEDGE) = IND(DUM) + ENDDO + ENDDO +ENDIF NEDGE_IF_1 - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: - CF%INXAREA(NFACE) = INXAREA(XIAXIS,1) - ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: - CF%INXSQAREA(NFACE) = INXSQAREA(XIAXIS,1) - ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: - CF%JNYSQAREA(NFACE) = INXSQAREA(XJAXIS,1) - ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: - CF%KNZSQAREA(NFACE) = INXSQAREA(XKAXIS,1) +CE%NEDGE = CE%NEDGE - 1 +IF(CE%NEDGE < 1) THEN + IF(ETYPE==CC_ETYPE_CFGAS) THEN + M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_EGSC,CE%IJK(KAXIS+1)) = CC_SOLID + M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED + ELSEIF(ETYPE==CC_ETYPE_CFINB) THEN + IF(CE%IJK(KAXIS+1)>0) THEN + M%FCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED + ELSE + M%CCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE) = CC_UNDEFINED + ENDIF + ENDIF + CE%STATUS = CC_SOLID +ENDIF - ENDDO - ENDDO - ENDDO - DEALLOCATE(X1FACE,X2FACE,X3FACE) - ENDDO X1AXIS_LOOP - ENDDO IBNDINT_LOOP +END SUBROUTINE DROP_CUT_EDGE - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED ) - ! INBOUNDARY cut-faces: - IF (INTGC_FLG==LOW_IND) THEN - ALLOCATE( IJK_COUNTED2(ISTR:IEND,JSTR:JEND,KSTR:KEND) ); IJK_COUNTED2=.FALSE. - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - ELSE - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD - ENDIF +! ----------------------------- DROP_CUTFACE -------------------------------------- - ! Loop on Cartesian cells: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI +SUBROUTINE DROP_CUTFACE(NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC) - IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE +! Drop cut-face CUT_FACE(ICF)%CFELEM(:,JCF): +! 0. For garphase cut-faces, move gas edges (reg and cut) to INB face CUT_EDGEs where it corresponds. +! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). +! 2. Change second index for cut-faces of cells attached to ICF,JCF +! 3. If zero remaining cut-faces in CUT_FACE(ICF) => make FCVAR,CCVAR GSC and IDCF indexes SOLID and INDEFINED. - IF(IJK_COUNTED2(I,J,K)) CYCLE; IJK_COUNTED2(I,J,K)=.TRUE. +INTEGER, INTENT(IN) :: NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) +INTEGER :: CT,DUM,ILH,ICC1,JCC1,IFACE,IFC1,IFACE2 +INTEGER, ALLOCATABLE, DIMENSION(:) :: IND +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTFACE_TYPE), POINTER :: CF - IF ( ALL(FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) /= CC_SOLID) ) CYCLE +M => MESHES(NM) +CF=> M%CUT_FACE(IFC) - NVERT = 0; NFACE = 0 - INXAREA = 0._EB - INXSQAREA = 0._EB - ! XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - X1AXIS_LOOP2 : DO X1AXIS=IAXIS,KAXIS - LOHI_DO : DO LOHI=LOW_IND,HIGH_IND - IF (FSID_XYZ(LOHI,X1AXIS) /= CC_SOLID) CYCLE - NFACE = NFACE + 1 - SELECT CASE(X1AXIS) - CASE(IAXIS) +! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). +NFACE_IF_1 : IF(CF%NFACE>1) THEN + ALLOCATE(IND(CF%NFACE)); IND = 0 + CT=0; + DO DUM=1,CF%NFACE + IF(DUM==JFC) CYCLE + CT = CT + 1 + IND(DUM) = CT + ENDDO + ! Collapse NFACE variables: + DO DUM=1,CF%NFACE + IF(DUM==JFC) CYCLE + CF%CFELEM( :,IND(DUM)) = CF%CFELEM( :,DUM) + CF%CEDGES( :,IND(DUM)) = CF%CEDGES( :,DUM) + CF%AREA( IND(DUM)) = CF%AREA( DUM) + CF%XYZCEN( :,IND(DUM)) = CF%XYZCEN( :,DUM) + CF%SHARED( IND(DUM)) = CF%SHARED( DUM) + CF%CELL_LIST(:,:,IND(DUM)) = CF%CELL_LIST(:,:,DUM) + ! Finally change FACE_LIST of involved cells: + CT = HIGH_IND + IF(FTYPE==CC_FTYPE_CFINB) THEN + CT = LOW_IND + CF%BODTRI( :,IND(DUM)) = CF%BODTRI( :,DUM) + CF%SURF_INDEX( IND(DUM)) = CF%SURF_INDEX( DUM) + CF%BLK_TAG( IND(DUM)) = CF%BLK_TAG( DUM) + CF%CFACE_ORIGIN( IND(DUM)) = CF%CFACE_ORIGIN( DUM) + CF%AREA_ADJUST( IND(DUM)) = CF%AREA_ADJUST( DUM) + ENDIF + DO ILH=LOW_IND,CT + ICC1 = CF%CELL_LIST(2,ILH,IND(DUM)) + JCC1 = CF%CELL_LIST(3,ILH,IND(DUM)) + IFC1 = CF%CELL_LIST(4,ILH,IND(DUM)) + IFACE= M%CUT_CELL(ICC1)%CCELEM(IFC1+1,JCC1) + ! Dropping gas-cut cells, do not reindex local JCF for INBOUNDARY faces. These have been changed already. + IF(FTYPE==CC_FTYPE_CFINB .OR. (FTYPE==CC_FTYPE_CFGAS .AND. M%CUT_CELL(ICC1)%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB)) & + M%CUT_CELL(ICC1)%FACE_LIST(5,IFACE) = IND(DUM) + DO IFACE2=1,M%CUT_CELL(ICC1)%NFACE_DROPPED + IF(M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & + M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(4,IFACE2)==IFC .AND. & + M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)==DUM) & + M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)=IND(DUM) + ENDDO + ENDDO + ENDDO + CF%CFELEM( :,CF%NFACE) = CC_UNDEFINED + CF%CEDGES( :,CF%NFACE) = CC_UNDEFINED + CF%AREA( CF%NFACE) = 0._EB + CF%XYZCEN( :,CF%NFACE) = 0._EB + CF%SHARED( CF%NFACE) = .FALSE. + CF%BLK_TAG( CF%NFACE) = .FALSE. + CF%CELL_LIST(:,:,CF%NFACE) = CC_UNDEFINED + IF(FTYPE==CC_FTYPE_CFINB) THEN + CF%BODTRI( :,CF%NFACE) = CC_UNDEFINED + CF%SURF_INDEX( CF%NFACE) = CC_UNDEFINED + CF%CFACE_ORIGIN( CF%NFACE) = CC_UNDEFINED + ENDIF + DEALLOCATE(IND) +ENDIF NFACE_IF_1 - ! Vertices: - XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K ) /) - IF(LOHI==LOW_IND)THEN - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) - ELSE - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) - ENDIF - ! Area: - AREA(NFACE) = (YFACE(J )-YFACE(J-1))*(ZFACE(K )-ZFACE(K-1)) - ! XYZCEN: - XYZCEN(IAXIS:KAXIS,NFACE) = (/ XFACE(I-2+LOHI), 0.5_EB*(YFACE(J )+YFACE(J-1)), & - 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI) * AREA(NFACE) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI)**2._EB * AREA(NFACE) +CF%NFACE = MAX(0,CF%NFACE - 1) - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I-2+LOHI,J,K,X1AXIS) - CASE(JAXIS) +IF(FTYPE==CC_FTYPE_CFGAS .AND. CF%NSFACE>0) THEN ! Bring down SOLID faces used for SLCF plotting. + CT=CF%NFACE + DO DUM=1,CF%NSFACE + CT=CT+1 + CF%CFELEM( :,CT) = CF%CFELEM( :,CT+1) + CF%CEDGES( :,CT) = CF%CEDGES( :,CT+1) + CF%AREA( CT) = CF%AREA( CT+1) + CF%XYZCEN( :,CT) = CF%XYZCEN( :,CT+1) + ENDDO +ENDIF - ! Vertices: - XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K-1) /) - IF(LOHI==LOW_IND)THEN - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) - ELSE - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) - ENDIF - ! Area: - AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(ZFACE(K )-ZFACE(K-1)) - ! XYZCEN: - XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), YFACE(J-2+LOHI), & - 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI) * AREA(NFACE) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI)**2._EB * AREA(NFACE) +IF(CF%NFACE < 1) THEN + CF%STATUS = CC_SOLID + CF%NSFACE = 0 + IF (FTYPE == CC_FTYPE_CFGAS) THEN + SELECT CASE(X1AXIS) + CASE(IAXIS) + M%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + M%ECVAR(I+ILHF,J-1:J,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J-1:J,K,CC_IDCE,KAXIS) = CC_UNDEFINED + M%ECVAR(I+ILHF,J,K-1:K,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J,K-1:K,CC_IDCE,JAXIS) = CC_UNDEFINED + CASE(JAXIS) + M%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + M%ECVAR(I-1:I,J+ILHF,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I-1:I,J+ILHF,K,CC_IDCE,KAXIS) = CC_UNDEFINED + M%ECVAR(I,J+ILHF,K-1:K,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J+ILHF,K-1:K,CC_IDCE,IAXIS) = CC_UNDEFINED + CASE(KAXIS) + M%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED + M%ECVAR(I-1:I,J,K+ILHF,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I-1:I,J,K+ILHF,CC_IDCE,JAXIS) = CC_UNDEFINED + M%ECVAR(I,J-1:J,K+ILHF,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J-1:J,K+ILHF,CC_IDCE,IAXIS) = CC_UNDEFINED + END SELECT + ELSEIF (FTYPE == CC_FTYPE_CFINB) THEN + M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED + ENDIF +ENDIF - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I,J-2+LOHI,K,X1AXIS) - CASE(KAXIS) +RETURN +END SUBROUTINE DROP_CUTFACE - ! Vertices: - XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K-2+LOHI) /) - XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K-2+LOHI) /) - XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J ), ZFACE(K-2+LOHI) /) - XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K-2+LOHI) /) - IF(LOHI==LOW_IND)THEN - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) - ELSE - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) - ENDIF - ! Area: - AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(YFACE(J )-YFACE(J-1)) - ! XYZCEN: - XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), 0.5_EB*(YFACE(J )+YFACE(J-1)), & - ZFACE(K-2+LOHI) /) - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI) * AREA(NFACE) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI)**2._EB * AREA(NFACE) - - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I,J,K-2+LOHI,X1AXIS) - END SELECT - - ! With IBOD and cut-face XYZCEN defined, find closest triangle: - DIST = 1.E20_EB - ITRI(NFACE) = 1 - DO IWSEL=1,GEOMETRY(IBOD(NFACE))%N_FACES - I1 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-2) - I2 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-1) - I3 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL ) - XCEN(IAXIS:KAXIS) = 1._EB/3._EB * ( GEOMETRY(IBOD(NFACE))%VERTS(3*(I1-1)+IAXIS:3*(I1-1)+KAXIS)+ & - GEOMETRY(IBOD(NFACE))%VERTS(3*(I2-1)+IAXIS:3*(I2-1)+KAXIS)+ & - GEOMETRY(IBOD(NFACE))%VERTS(3*(I3-1)+IAXIS:3*(I3-1)+KAXIS) ) - ! Drop Triangles not on the face: - IF (ABS(XYZCEN(X1AXIS,NFACE)-XCEN(X1AXIS)) > GEOMEPS) CYCLE - DIST2 = NORM2(XYZCEN(IAXIS:KAXIS,NFACE)-XCEN(IAXIS:KAXIS)) - IF (DIST > DIST2) THEN - DIST = DIST2 - ITRI(NFACE) = IWSEL - ENDIF - ENDDO - NVERT = NVERT + 4 +! ----------------------------- DROP_CUTCELL -------------------------------------- - ENDDO LOHI_DO - ENDDO X1AXIS_LOOP2 +SUBROUTINE DROP_CUTCELL(NM,ICC,JCC) +! Remove cut-cell CUT_CELL(ICC)%CCELEM(:,JCC): +! 1. If CUT_CELL(ICC)%NCELL==1 drop INBOUNDARY faces of ICC,JCC, make CCVAR CGSC SOLID and IDCC,IDCF undefined. +! 2. If more than 1 NCELL, drop JCc from CCELEM, IJK_LINK, LINK_LEV, VOLUME, XYZCEN lists and NCELL=NCELL-1 - ! This is a cut-face, allocate space: - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (INTGC_FLG==LOW_IND) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE +INTEGER, INTENT(IN) :: NM,ICC,JCC - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +! Local Variables +INTEGER :: I,J,K,JCC2,IFC,CT +INTEGER, ALLOCATABLE, DIMENSION(:) :: IND +TYPE(MESH_TYPE), POINTER :: M +M => MESHES(NM) - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, 0 /) ! No axis = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_INBOUNDARY - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - CF%CFELEM(1:5,1:NFACE) = CFELEM(1:5,1:NFACE) +I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS) - CF%AREA(1:NFACE) = AREA(1:NFACE) - CF%XYZCEN(IAXIS:KAXIS,1:NFACE) = XYZCEN(IAXIS:KAXIS,1:NFACE) +! Check if JCC is the only cut-cell in CUT_CELL(ICC): +IF (M%CUT_CELL(ICC)%NCELL==1) THEN + ! Set cut-cell to solid + M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID + M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED + M%CUT_CELL(ICC)%NCELL = 0 + ! Then drop INBOUNDARY cut-faces in I,J,K if there are any left: + IFC=M%CCVAR(I,J,K,CC_IDCF) + IF (IFC>0) THEN + M%CUT_FACE(IFC)%STATUS = CC_SOLID + M%CUT_FACE(IFC)%NFACE = 0 + ENDIF + M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED + RETURN +ENDIF - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA: - CF%INXAREA(1:NFACE) = INXAREA(IAXIS,1:NFACE) - ! dot(i,nc)*int(x^2)dA: - CF%INXSQAREA(1:NFACE) = INXSQAREA(IAXIS,NFACE) - ! dot(j,nc)*int(y^2)dA: - CF%JNYSQAREA(1:NFACE) = INXSQAREA(JAXIS,NFACE) - ! dot(k,nc)*int(z^2)dA: - CF%KNZSQAREA(1:NFACE) = INXSQAREA(KAXIS,NFACE) +! First count: +ALLOCATE(IND(1:M%CUT_CELL(ICC)%NCELL)); IND=0 +CT=0 +DO JCC2=1,M%CUT_CELL(ICC)%NCELL + IF (JCC2==JCC) CYCLE + CT = CT + 1 + IND(JCC2) = CT +ENDDO - ! Define Body-triangle reference: - CF%BODTRI(1,1:NFACE)= IBOD(1:NFACE) - CF%BODTRI(2,1:NFACE)= ITRI(1:NFACE) +! Then drop JCC: +DO JCC2=1,M%CUT_CELL(ICC)%NCELL + IF (JCC2==JCC) CYCLE + M%CUT_CELL(ICC)%CCELEM(:,IND(JCC2)) = M%CUT_CELL(ICC)%CCELEM(:,JCC2) + M%CUT_CELL(ICC)%IJK_LINK(:,IND(JCC2)) = M%CUT_CELL(ICC)%IJK_LINK(:,JCC2) + M%CUT_CELL(ICC)%LINK_LEV(IND(JCC2)) = M%CUT_CELL(ICC)%LINK_LEV(JCC2) + M%CUT_CELL(ICC)%VOLUME(IND(JCC2)) = M%CUT_CELL(ICC)%VOLUME(JCC2) + M%CUT_CELL(ICC)%XYZCEN(:,IND(JCC2)) = M%CUT_CELL(ICC)%XYZCEN(:,JCC2) + M%CUT_CELL(ICC)%NOADVANCE(IND(JCC2)) = M%CUT_CELL(ICC)%NOADVANCE(JCC2) +ENDDO - ! Assign surf-index: Depending on GEOMETRY: - DO IFACE=1,NFACE - CF%SURF_INDEX(IFACE) = GEOMETRY(IBOD(IFACE))%SURFS(ITRI(IFACE)) - ENDDO +M%CUT_CELL(ICC)%NCELL = M%CUT_CELL(ICC)%NCELL - 1 - ENDDO - ENDDO - ENDDO +DEALLOCATE(IND) - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED2 ) +RETURN +END SUBROUTINE DROP_CUTCELL -ENDDO INTGC_FLG_LOOP +! -------------------------- GET_CELL_LINK_INFO ----------------------------------- +SUBROUTINE GET_CELL_LINK_INFO(NM) -! Finally Build cut-cells: -NCFACE_CUTCELL = 7; NFACE_CELL = 6; NCELL = 1 -INTGC_FLG_LOOP2 : DO INTGC_FLG=LOW_IND,HIGH_IND ! 1 refers to blocks internal cells, 2 refers to block guard cells. +! Small cell linking subroutine in the mesh. Builds linking information for cutcell ICC,JCC: +! CUT_CELL(ICC)%IJK_LINK(1:KAXIS+2,JCC) of cell linked to, and CUT_CELL(ICC)%LINK_LEV(JCC) level within link tree. - SELECT CASE(INTGC_FLG) - CASE(LOW_IND) - ALLOCATE(IJK_COUNT(ILO_CELL-NGUARD:IHI_CELL+NGUARD,JLO_CELL-NGUARD:JHI_CELL+NGUARD, & - KLO_CELL-NGUARD:KHI_CELL+NGUARD)) - IJK_COUNT = .FALSE. - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - CASE(HIGH_IND) - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD - END SELECT +INTEGER, INTENT(IN) :: NM - ! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI +! Local Variables: +INTEGER :: ICC,JCC,ICC2,JCC2,JCC_LNK,I,J,K,I_LNK,J_LNK,K_LNK,IFC,IFC2,IFACE,IFACE2,IFACE3,IBOD,IWSEL,VAL_UNKZ,& + LINK_ITER,INGH,JNGH,KNGH,X1AXIS,ILH,INRM(1:3),DUM,LNK_LEV,ULINK_COUNT,LINK_LEV_UP,AX_MIN,AX_OTHERS(2) +REAL(EB):: AREA,AF,NRML(IAXIS:KAXIS),VAL_CVOL,CCVOL_THRES, XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND),& + MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND:HIGH_IND),CELL_DELTA(IAXIS:KAXIS) +LOGICAL :: QUITLINK_FLG,CRTCELL_FLG,MASK(IAXIS:KAXIS),BLOCK_SLIM_IF,SOLID_FACES +CHARACTER(MESSAGE_LENGTH) :: UNLINKED_FILE +INTEGER, SAVE :: LU_UNLNK +LOGICAL, SAVE :: UNLINKED_1ST_CALL=.TRUE. +TYPE (MESH_TYPE), POINTER :: M +TYPE (CC_CUTCELL_TYPE), POINTER :: CC - IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE +M => MESHES(NM) - IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. +! Initialize UNKZ, used here to define if cell has been noted in linking hierarchy. Assume CCVAR has been allocated: +M%CCVAR(:,:,:,CC_UNKZ) = CC_UNDEFINED +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC => M%CUT_CELL(ICC); I=CC%IJK(IAXIS); J=CC%IJK(JAXIS); K=CC%IJK(KAXIS) + ! Test for sliver trapped cells blocking: + XYZCELL(IAXIS,LOW_IND) = XFACE(I-1); XYZCELL(IAXIS,HIGH_IND) = XFACE(I); + XYZCELL(JAXIS,LOW_IND) = YFACE(J-1); XYZCELL(JAXIS,HIGH_IND) = YFACE(J); + XYZCELL(KAXIS,LOW_IND) = ZFACE(K-1); XYZCELL(KAXIS,HIGH_IND) = ZFACE(K); + MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) + MINMAX_XYZ_CC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) + DO JCC=1,CC%NCELL + ! Get cut-cell bounding box: + CALL CUT_CELL_BOUNDING_BOX(NM,ICC,JCC,XYZCELL,MINMAX_XYZ_CC) + ! Perform Tests: + DO DUM=IAXIS,KAXIS + CELL_DELTA(DUM) = ABS(MINMAX_XYZ_CC(DUM,HIGH_IND)-MINMAX_XYZ_CC(DUM,LOW_IND)) + ENDDO + ! Axis with minimum width: + AX_MIN = MINLOC(CELL_DELTA(IAXIS:KAXIS),DIM=1) + SELECT CASE(AX_MIN) + CASE(IAXIS); AX_OTHERS(1:2) = (/ JAXIS, KAXIS /); SOLID_FACES = ALL(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_SOLID) + CASE(JAXIS); AX_OTHERS(1:2) = (/ IAXIS, KAXIS /); SOLID_FACES = ALL(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_SOLID) + CASE(KAXIS); AX_OTHERS(1:2) = (/ IAXIS, JAXIS /); SOLID_FACES = ALL(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_SOLID) + END SELECT + ! Perform Test: + BLOCK_SLIM_IF = (CELL_DELTA(AX_MIN)<10._EB*MIN_LENGTH_FACTOR*CELL_DELTA(AX_OTHERS(1))) .AND. & + (CELL_DELTA(AX_MIN)<10._EB*MIN_LENGTH_FACTOR*CELL_DELTA(AX_OTHERS(2))) + IF(BLOCK_SLIM_IF .AND. SOLID_FACES) CC%NOADVANCE(JCC) = BLOCKED_SMALL_CELL + ENDDO + CC%UNKZ(:) = CC_UNDEFINED + DO JCC=1,CC%NCELL + IF (CC%NOADVANCE(JCC)>0) CC%IJK_LINK(1,JCC) = CC_SOLID + ENDDO +ENDDO - ! Start with Cartesian Faces: - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) +! Loop on Cartesian cells, number unknowns for cells type CC_CUTCFE and surrounding CC_GASPHASE: +DO K=0,M%KBP1 + DO J=0,M%JBP1 + DO I=0,M%IBP1 + IF ( M%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE + ! First Add the Cut-Cell + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF (ICC <= M%N_CUTCELL_MESH .AND. .NOT. M%CELL(M%CELL_INDEX(I,J,K))%SOLID ) THEN ! Don't number GC cut-cells, + ! or cutcells inside an OBST. + CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) + DO JCC=1,M%CUT_CELL(ICC)%NCELL + IF ( M%CUT_CELL(ICC)%NOADVANCE(JCC)>0 ) CYCLE + IF ( M%CUT_CELL(ICC)%VOLUME(JCC) > CCVOL_THRES) M%CUT_CELL(ICC)%UNKZ(JCC) = 1 + ENDDO + ENDIF + ! Run over Neighbors: Case 27 cells. Only Internal cells for the mesh in the stencil (I-1:I+1,J-1:J+1,K-1:K+1) + ! around Cartesian cell I,J,K of type CC_CUTCFE: + DO KNGH=K-1,K+1 + IF ( (KNGH < 1) .OR. (KNGH > M%KBAR) ) CYCLE + DO JNGH=J-1,J+1 + IF ( (JNGH < 1) .OR. (JNGH > M%JBAR) ) CYCLE + DO INGH=I-1,I+1 + ! Either not GASPHASE or already counted: + IF ((M%CCVAR(INGH,JNGH,KNGH,CC_CGSC)/=CC_GASPHASE) .OR. (M%CCVAR(INGH,JNGH,KNGH,CC_UNKZ)>0)) CYCLE + IF ( (INGH < 1) .OR. (INGH > M%IBAR) ) CYCLE + IF (M%CELL(CELL_INDEX(INGH,JNGH,KNGH))%SOLID) CYCLE + M%CCVAR(INGH,JNGH,KNGH,CC_UNKZ) = 1 + ENDDO + ENDDO + ENDDO - ! Cut-face number of bounding Cartesian faces: - IDCF_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCF,IAXIS) - IDCF_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCF,IAXIS) - IDCF_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCF,JAXIS) - IDCF_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCF,JAXIS) - IDCF_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCF,KAXIS) - IDCF_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCF,KAXIS) + ENDDO + ENDDO +ENDDO - NFACE_CELL = 0 +! Now link small cells to surrounding cells in the mesh: +! NOTE: This scheme links two unknowns local to the mesh, therefore parallel consistency is not maintained. +! 1. Try linking them to adjacent regular cell with UNKZ > 0. Attempt going in surface normal direction first. +! 2. Try linking to adjacent cut-cell with UNKZ > 0. Attempt going in surface normal direction first. +! 3. If cut-cell could not be linked after N_LINK_ATTMP, block it. +LINK_ITER = 0; LINK_LEV_UP = 0 +LINK_LOOP : DO ! Cut-cell linking loop for small cells. -> Algo defined by CCVOL_LINK. + QUITLINK_FLG = .TRUE. - X1AXIS_LOOP3 : DO X1AXIS=IAXIS,KAXIS - CEI_AXIS(LOW_IND:HIGH_IND) = IDCF_XYZ(LOW_IND:HIGH_IND,X1AXIS) - DO SIDE=LOW_IND,HIGH_IND - ! Low High face: - IF ( FSID_XYZ(SIDE,X1AXIS) == CC_GASPHASE ) THEN - ! Regular Face, build 4 vertices + face: - NFACE_CELL = NFACE_CELL + 1 - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED/) - ! CC_FTYPE_RCGAS=0, regular face. - ELSEIF (FSID_XYZ(SIDE,X1AXIS) == CC_CUTCFE ) THEN - ! GasPhase CUT_FACE, add all cut-faces on these Cartesian cell + nodes - CEI = CEI_AXIS(SIDE) - DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE - NFACE_CELL = NFACE_CELL + 1 - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL)=(/ CC_FTYPE_CFGAS,SIDE,X1AXIS,CEI,ICF,CC_UNDEFINED/) - ! CC_FTYPE_CFGAS=1 - ENDDO - ENDIF - ENDDO - ENDDO X1AXIS_LOOP3 - - ! Now add INBOUNDARY faces of the cell: - CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) - IF ( CEI > 0 ) THEN - DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE - NFACE_CELL = NFACE_CELL + 1 - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB, 0, 0, CEI, ICF, CC_UNDEFINED /) - ! CC_FTYPE_CFINB in Cart-cell. - ENDDO - ENDIF - - VOL(1) = DXCELL(I)*DYCELL(J)*DZCELL(K) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZCELL(K) /) - - ! Load into CUT_CELL data structure - NCUTCELL = MESHES(NM)%N_CUTCELL_MESH + MESHES(NM)%N_GCCUTCELL_MESH + 1 - IF (INTGC_FLG==LOW_IND) THEN - MESHES(NM)%N_CUTCELL_MESH = NCUTCELL - ELSE - MESHES(NM)%N_GCCUTCELL_MESH = MESHES(NM)%N_GCCUTCELL_MESH + 1 - ENDIF - MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = NCUTCELL - - ! Resize array MESHES(NM)%CUT_CELL if necessary: - CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) - - ! Add cut-cell NCUTCELL entry: - MESHES(NM)%CUT_CELL(NCUTCELL)%IJK(IAXIS:KAXIS) = (/ I, J, K /) - MESHES(NM)%CUT_CELL(NCUTCELL)%NCELL = NCELL - MESHES(NM)%CUT_CELL(NCUTCELL)%NFACE_CELL= NFACE_CELL - CALL NEW_CELL_ALLOC(NM,NCUTCELL,NCELL,NFACE_CELL,NCFACE_CUTCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%CCELEM(1:NCFACE_CUTCELL,1) = (/ 6, 1, 2, 3, 4, 5, 6 /) - MESHES(NM)%CUT_CELL(NCUTCELL)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) = & - FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%VOLUME(1:NCELL) = VOL(1:NCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%XYZCEN(IAXIS:KAXIS,1:NCELL) = XYZCEN(IAXIS:KAXIS,1:NCELL) + IF (LINK_ITER==0) THEN + ICC_LOOP_1 : DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) + JCC_LOOP_1 : DO JCC=1,CC%NCELL + IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE + CRTCELL_FLG = .FALSE. + VAL_UNKZ = CC_UNDEFINED + VAL_CVOL = CCVOL_THRES + ! Find area averaged body surface normal: + NRML(IAXIS:KAXIS) = 0._EB; AREA = 0._EB + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + IFC2 = CC%FACE_LIST(4,IFACE) + IFACE2 = CC%FACE_LIST(5,IFACE) + IBOD = M%CUT_FACE(IFC2)%BODTRI(1,IFACE2) + IWSEL = M%CUT_FACE(IFC2)%BODTRI(2,IFACE2) + AF = M%CUT_FACE(IFC2)%AREA( IFACE2) + NRML(IAXIS:KAXIS) = NRML(IAXIS:KAXIS) + GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL)*AF + AREA = AREA + AF ENDDO - ENDDO - ENDDO - - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNT ) - -ENDDO INTGC_FLG_LOOP2 - - -DEALLOCATE(GEOMFACE,GEOMCELL) - -END SUBROUTINE GET_REGULAR_CUTCELLS_BOX + ! With the surface normal search for a Regular Gasphase face in that direction. + AREA_IF_1 : IF (AREA > TWENTY_EPSILON_EB) THEN + NRML = NRML / AREA ! Normalize unit vector: + ! Normalize NRML vector to LINK_DIGITS: + DO DUM=IAXIS,KAXIS + NRML(DUM) = REAL(INT(LINK_FCT*NRML(DUM)),EB)/LINK_FCT + ENDDO + MASK(IAXIS:KAXIS) = .TRUE. + INRM(1) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(1))=.FALSE. + INRM(2) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(2))=.FALSE. + INRM(3) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1) + AXIS_LOOP_1 : DO DUM=IAXIS,KAXIS + X1AXIS=INRM(DUM) + IFC_LOOP_1 : DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND + IF( (X1AXIS /= CC%FACE_LIST(3,IFACE)) .OR. & + (CC%FACE_LIST(1,IFACE) /= CC_FTYPE_RCGAS) .OR. & + (ILH /= INT(SIGN(1._EB,NRML(X1AXIS)))) ) CYCLE IFC_LOOP_1 + SELECT CASE(X1AXIS) + CASE(IAXIS) + I_LNK = I+ILH; J_LNK = J; K_LNK = K + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + CASE(JAXIS) + I_LNK = I; J_LNK = J+ILH; K_LNK = K + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + CASE(KAXIS) + I_LNK = I; J_LNK = J; K_LNK = K+ILH + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + END SELECT + IF ( CRTCELL_FLG ) EXIT AXIS_LOOP_1 + ENDDO IFC_LOOP_1 + ENDDO AXIS_LOOP_1 + ENDIF AREA_IF_1 -! --------------------- DEALLOCATE_CUTCELLS_CONN_MESH -------------------------- - -SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH(NM) - -INTEGER, INTENT(IN) :: NM - -INTEGER :: ICC, ICF, I, J, K, DO_BNCF=1 -INTEGER, PARAMETER :: LOIN=-1 -INTEGER, PARAMETER :: HIIN= 2 - -! Cut-cells and GASPHASE cut-faces: -DO K=-CCGUARD,MESHES(NM)%KBAR+CCGUARD - IF(K>LOIN .AND. KMESHES(NM)%KBAR+LOIN .AND. KLOIN .AND. JMESHES(NM)%JBAR+LOIN .AND. JLOIN .AND. IMESHES(NM)%IBAR+LOIN .AND. I0) CALL CELL_DEALLOC(NM,ICC) ! Deallocate this CUT_CELL array container: - ! IAXIS cut-face: - ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,IAXIS) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) - ! JAXIS cut-face: - ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,JAXIS) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) - ! KAXIS cut-face: - ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,KAXIS) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) - ENDDO - ENDDO -ENDDO -! INBOUNDARY cut-faces: -DO K=-CCGUARD,MESHES(NM)%KBAR+CCGUARD - DO J=-CCGUARD,MESHES(NM)%JBAR+CCGUARD - DO I=-CCGUARD,MESHES(NM)%IBAR+CCGUARD - ICF = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF,DO_BNCF) ! Deallocate this CUT_FACE array fields, except NFACE, XYZCEN. - ENDDO - ENDDO -ENDDO -IF(ALLOCATED(MESHES(NM)%VERTVAR)) DEALLOCATE(MESHES(NM)%VERTVAR) -IF(ALLOCATED(MESHES(NM)%ECVAR)) DEALLOCATE(MESHES(NM)%ECVAR) -RETURN -END SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH + ! If not successful try any Regular Gasphase face. + ! Small cells, get CC_UNKZ from a large cell neighbor: + IF (.NOT. CRTCELL_FLG) THEN + IFC_LOOP_2 : DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + ILH = 2*CC%FACE_LIST(2,IFACE) - 3 + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE IFC_LOOP_2 + X1AXIS = CC%FACE_LIST(3,IFACE) + SELECT CASE(X1AXIS) + CASE(IAXIS) + I_LNK = I+ILH; J_LNK = J; K_LNK = K + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + CASE(JAXIS) + I_LNK = I; J_LNK = J+ILH; K_LNK = K + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + CASE(KAXIS) + I_LNK = I; J_LNK = J; K_LNK = K+ILH + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + END SELECT + IF ( CRTCELL_FLG ) EXIT IFC_LOOP_2 + ENDDO IFC_LOOP_2 + ENDIF + IF (VAL_UNKZ>0) THEN + CC%FACE_LIST(6,IFACE) = INTEGER_ONE ! This face is shared with master. + CC%UNKZ(JCC) = VAL_UNKZ !(/ Cell Type, I, J, K, JCC_LNK /) + CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_GASPHASE, I_LNK, J_LNK, K_LNK, 0 /) + CC%LINK_LEV(JCC) = -1 ! One link hierarchy level below regular cells (at LNK_LEV=0). + ENDIF + ENDDO JCC_LOOP_1 + ENDDO ICC_LOOP_1 + ENDIF -! ----------------------- DEALLOCATE_BODINT_PLANE ------------------------------ + ! Then attempt to connect to large cut-cells, or already connected small cells (CUT_CELL(ICC)%UNKZ(JCC) > 0): + ICC_LOOP_2 : DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) -SUBROUTINE DEALLOCATE_BODINT_PLANE(BODINT_PLANE) + JCC_LOOP_2 : DO JCC=1,CC%NCELL + IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE + VAL_UNKZ = CC_UNDEFINED + VAL_CVOL = -GEOMEPS -TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE + ! Find area averaged body surface normal: + NRML(IAXIS:KAXIS) = 0._EB; AREA = 0._EB + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + IFC2 = CC%FACE_LIST(4,IFACE) + IFACE2 = CC%FACE_LIST(5,IFACE) + IBOD = M%CUT_FACE(IFC2)%BODTRI(1,IFACE2) + IWSEL = M%CUT_FACE(IFC2)%BODTRI(2,IFACE2) + AF = M%CUT_FACE(IFC2)%AREA( IFACE2) + NRML(IAXIS:KAXIS) = NRML(IAXIS:KAXIS) + GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL)*AF + AREA = AREA + AF + ENDDO -IF ( ALLOCATED(BODINT_PLANE%XYZ) ) DEALLOCATE(BODINT_PLANE%XYZ) -IF ( ALLOCATED(BODINT_PLANE%SGLS) ) DEALLOCATE(BODINT_PLANE%SGLS) -IF ( ALLOCATED(BODINT_PLANE%SEGS) ) DEALLOCATE(BODINT_PLANE%SEGS) -IF ( ALLOCATED(BODINT_PLANE%TRIS) ) DEALLOCATE(BODINT_PLANE%TRIS) -IF ( ALLOCATED(BODINT_PLANE%INDSEG) ) DEALLOCATE(BODINT_PLANE%INDSEG) -IF ( ALLOCATED(BODINT_PLANE%INDTRI) ) DEALLOCATE(BODINT_PLANE%INDTRI) -IF ( ALLOCATED(BODINT_PLANE%X2ALIGNED) ) DEALLOCATE(BODINT_PLANE%X2ALIGNED) -IF ( ALLOCATED(BODINT_PLANE%X3ALIGNED) ) DEALLOCATE(BODINT_PLANE%X3ALIGNED) -IF ( ALLOCATED(BODINT_PLANE%SEGTYPE) ) DEALLOCATE(BODINT_PLANE%SEGTYPE) -IF ( ALLOCATED(BODINT_PLANE%NOD_PERM) ) DEALLOCATE(BODINT_PLANE%NOD_PERM) -IF ( ALLOCATED(BODINT_PLANE%NBCROSS) ) DEALLOCATE(BODINT_PLANE%NBCROSS) -IF ( ALLOCATED(BODINT_PLANE%SVAR) ) DEALLOCATE(BODINT_PLANE%SVAR) -IF ( ALLOCATED(BODINT_PLANE%X1NVEC) ) DEALLOCATE(BODINT_PLANE%X1NVEC) -IF ( ALLOCATED(BODINT_PLANE%AINV) ) DEALLOCATE(BODINT_PLANE%AINV) -IF ( ALLOCATED(BODINT_PLANE%TBAXIS(IAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(IAXIS)%TRIBIN) -IF ( ALLOCATED(BODINT_PLANE%TBAXIS(JAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(JAXIS)%TRIBIN) -IF ( ALLOCATED(BODINT_PLANE%TBAXIS(KAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(KAXIS)%TRIBIN) - -RETURN -END SUBROUTINE DEALLOCATE_BODINT_PLANE + AREA_IF_2 : IF (AREA > TWENTY_EPSILON_EB) THEN + NRML = NRML / AREA ! Normalize unit vector: + ! Normalize NRML vector to LINK_DIGITS: + DO DUM=IAXIS,KAXIS + NRML(DUM) = REAL(INT(LINK_FCT*NRML(DUM)),EB)/LINK_FCT + ENDDO + MASK(IAXIS:KAXIS) = .TRUE. + INRM(1) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(1))=.FALSE. + INRM(2) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(2))=.FALSE. + INRM(3) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1) + AXIS_LOOP_2 : DO DUM=IAXIS,KAXIS + X1AXIS=INRM(DUM) + IFC_LOOP_3 : DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + IF((CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB) .OR. & + (CC%FACE_LIST(1,IFACE)==CC_FTYPE_SVERT)) CYCLE IFC_LOOP_3 + ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND + IF( (X1AXIS /= CC%FACE_LIST(3,IFACE)) .OR. & + (ILH /= INT(SIGN(1._EB,NRML(X1AXIS)))) ) CYCLE IFC_LOOP_3 + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF( (I+ILH < 1) .OR. (I+ILH > M%IBAR) ) CYCLE IFC_LOOP_3 ! Drop if outside the mesh. + CASE(JAXIS) + IF( (J+ILH < 1) .OR. (J+ILH > M%JBAR) ) CYCLE IFC_LOOP_3 + CASE(KAXIS) + IF( (K+ILH < 1) .OR. (K+ILH > M%KBAR) ) CYCLE IFC_LOOP_3 + END SELECT + SELECT CASE(CC%FACE_LIST(1,IFACE)) ! 1. Check if a surrounding cell is a regular cell: + CASE(CC_FTYPE_RCGAS) ! REGULAR GASPHASE + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(M%CCVAR(I+ILH,J,K,CC_UNKZ) <= 0) THEN ! Cut - cell. + CALL GET_ICC2_JCC2(ICC,IFACE,I+ILH,J,K,ICC2,JCC2) + IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 + IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 + I_LNK = I+ILH; J_LNK = J; K_LNK = K; JCC_LNK = JCC2 + VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); + EXIT AXIS_LOOP_2 + ENDIF + CASE(JAXIS) + IF(M%CCVAR(I,J+ILH,K,CC_UNKZ) <= 0) THEN ! Cut - cell. + CALL GET_ICC2_JCC2(ICC,IFACE,I,J+ILH,K,ICC2,JCC2) + IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 + IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 + I_LNK = I; J_LNK = J+ILH; K_LNK = K; JCC_LNK = JCC2 + VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); + EXIT AXIS_LOOP_2 + ENDIF + CASE(KAXIS) + IF(M%CCVAR(I,J,K+ILH,CC_UNKZ) <= 0) THEN ! Cut - cell. + CALL GET_ICC2_JCC2(ICC,IFACE,I,J,K+ILH,ICC2,JCC2) + IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 + IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 + I_LNK = I; J_LNK = J; K_LNK = K+ILH; JCC_LNK = JCC2 + VAL_UNKZ=M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); + EXIT AXIS_LOOP_2 + ENDIF + END SELECT + CASE(CC_FTYPE_CFGAS) ! 2. Check for large surrounding cut-cells: + IFC2 = CC%FACE_LIST(4,IFACE) + IFACE2 = CC%FACE_LIST(5,IFACE) + ICC2 = M%CUT_FACE(IFC2)%CELL_LIST(2,CC%FACE_LIST(2,IFACE),IFACE2) + JCC2 = M%CUT_FACE(IFC2)%CELL_LIST(3,CC%FACE_LIST(2,IFACE),IFACE2) + IF (M%CUT_CELL(ICC2)%UNKZ(JCC2)<1) CYCLE IFC_LOOP_3 + IF (M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 + I_LNK = M%CUT_CELL(ICC2)%IJK(IAXIS); J_LNK = M%CUT_CELL(ICC2)%IJK(JAXIS); + K_LNK = M%CUT_CELL(ICC2)%IJK(KAXIS); JCC_LNK = JCC2 + VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); EXIT AXIS_LOOP_2 + END SELECT + ENDDO IFC_LOOP_3 + ENDDO AXIS_LOOP_2 + IF (VAL_UNKZ > 0) THEN + CC%FACE_LIST(6,IFACE) = INTEGER_ONE ! This face is shared with master. + CC%UNKZ(JCC) = VAL_UNKZ + CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I_LNK, J_LNK, K_LNK, JCC_LNK /) + CC%LINK_LEV(JCC) = LNK_LEV-1 ! One link hierarchy level below master cell. + CYCLE JCC_LOOP_2 + ENDIF + ENDIF AREA_IF_2 -! ---------------------- GET_EXT_INB_CUTFACES_TO_CFACE -------------------------------- + ! Small cells, get CC_UNKZ from a large cell neighbor: + IFACE3 = CC_UNDEFINED + IFC_LOOP_4 : DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + IF((CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB) .OR. & + (CC%FACE_LIST(1,IFACE)==CC_FTYPE_SVERT)) CYCLE IFC_LOOP_4 + ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND -SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE + ! Cycle if surrounding cell is located in the guard-cell region, if so drop, as we don't have + ! at this point unknown numbers on guard-cells/guard-cell ccs: + X1AXIS = CC%FACE_LIST(3,IFACE) + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF( (I+ILH < 1) .OR. (I+ILH > M%IBAR) ) CYCLE IFC_LOOP_4 + CASE(JAXIS) + IF( (J+ILH < 1) .OR. (J+ILH > M%JBAR) ) CYCLE IFC_LOOP_4 + CASE(KAXIS) + IF( (K+ILH < 1) .OR. (K+ILH > M%KBAR) ) CYCLE IFC_LOOP_4 + END SELECT -! Local Variables: -INTEGER :: ICF, CFACE_INDEX_LOCAL, SURF_INDEX -INTEGER :: IVENT -REAL(EB):: ADDMAT(IAXIS:KAXIS,LOW_IND:HIGH_IND) + SELECT CASE(CC%FACE_LIST(1,IFACE)) ! 1. Check if a surrounding cell is a regular cell: + CASE(CC_FTYPE_RCGAS) ! REGULAR GASPHASE + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(M%CCVAR(I+ILH,J,K,CC_UNKZ) <= 0) THEN ! Cut - cell. + CALL GET_ICC2_JCC2(ICC,IFACE,I+ILH,J,K,ICC2,JCC2) + IF(ANY((/ ICC2, JCC2 /) == 0)) CYCLE IFC_LOOP_4 + IF(M%CUT_CELL(ICC2)%VOLUME(JCC2) 0) THEN + CC%FACE_LIST(6,IFACE3) = INTEGER_ONE ! This face is shared with master. + CC%UNKZ(JCC) = VAL_UNKZ + CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I_LNK, J_LNK, K_LNK, JCC_LNK /) + CC%LINK_LEV(JCC) = LNK_LEV-1 ! One link hierarchy level below master cell. + ELSE + QUITLINK_FLG = .FALSE. + ENDIF + ENDDO JCC_LOOP_2 + ENDDO ICC_LOOP_2 -TYPE(VENTS_TYPE), POINTER :: VT -TYPE(CFACE_TYPE), POINTER :: CFA + ! Then fuse cut-cell unknowns if several ccs in one Cartesian cell and one of them has CUT_CELL(ICC)%UNKZ(JCC)>0: + ! IF(.NOT. ONE_UNKH_PER_CUTCELL) THEN + ! DO ICC=1,M%N_CUTCELL_MESH + ! CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + ! ! Don't attempt to link cut-cells inside an OBST: + ! IF ( M%CELL(M%CELL_INDEX(I,J,K))%SOLID ) CYCLE + ! ! Cases with more than one cut-cell: define UNKZ of all cells to be the one of first cut-cell with UNKZ > 0: + ! DO JCC=1,CC%NCELL; IF(CC%UNKZ(JCC)>0) EXIT; ENDDO + ! JCC_LNK = JCC + ! IF (JCC_LNK <= CC%NCELL) THEN + ! DO JCC=1,CC%NCELL + ! IF ( CC%NOADVANCE(JCC)>0 .OR. JCC==JCC_LNK ) CYCLE + ! CC%UNKZ(JCC) = CC%UNKZ(JCC_LNK) + ! CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I, J, K, JCC_LNK /) + ! CC%LINK_LEV(JCC) = CC%LINK_LEV(JCC_LNK) - 1 + ! ENDDO + ! ENDIF + ! ENDDO + ! ENDIF -IF(GET_CUTCELLS_VERBOSE) CALL CPU_TIME(CPUTIME_START) + IF (QUITLINK_FLG) EXIT LINK_LOOP -ALLOCATE(NCFACE_BY_MESH(1:NMESHES)); NCFACE_BY_MESH(1:NMESHES) = 0 -MESH_LOOP_0 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - ! First N_EXTERNAL_CFACE_CELLS: - DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE - CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE - CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE - END SELECT - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO - ! Second N_INTWALL_CFACE_CELLS: - DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - CASE(JAXIS) - IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - CASE(KAXIS) - IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - END SELECT - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO - ! Second N_INTERNAL_CFACE_CELLS: - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE - ! Don't count INB cut-faces inside an OBST: - IF (CELL(CELL_INDEX(CF%IJK(IAXIS),CF%IJK(JAXIS),CF%IJK(KAXIS)))%SOLID) CYCLE - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO -ENDDO MESH_LOOP_0 + LINK_LEV_UP = LINK_LEV_UP - 1 -IF(GET_CUTCELLS_VERBOSE) THEN - CALL MPI_ALLREDUCE(MPI_IN_PLACE,NCFACE_BY_MESH(1),NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) - WRITE(LU_SETCC,'(A,I10)',advance='no') ' 4. Generating CFACES from cut-faces, total CFACE_CELLS=', & - SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,I10)') ' Total number of CFACES in all processes=', & - SUM(NCFACE_BY_MESH(1:NMESHES)) - WRITE(LU_ERR ,'(A,I10)',advance='no') & - ' 4. Process 0 Generating CFACES from cut-faces, total CFACE_CELLS=', & - SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) - ENDIF -ENDIF + LINK_ITER = LINK_ITER + 1 + BLOCK_CELL_IF : IF (LINK_ITER > N_LINK_ATTMP) THEN + ! Count how many unlinked cells we have in this mesh: + ULINK_COUNT = 0 + DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + DO JCC=1,CC%NCELL + IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE + ULINK_COUNT = ULINK_COUNT + 1 + ENDDO + ENDDO -! First mesh Loop, Allocate storage for CFACES, CFACE geometric info: -MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) + IF (GET_CUTCELLS_VERBOSE) THEN + ! Write out unlinked cells properties: + ! Open file to write unlinked cells: + WRITE(UNLINKED_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_unlinked_',MY_RANK,'.log' + ! Create file: + IF (UNLINKED_1ST_CALL) THEN + LU_UNLNK = GET_FILE_NUMBER() + OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='UNKNOWN') + WRITE(LU_UNLNK,*) 'Unlinked cut-cell Information for Process=',MY_RANK + CLOSE(LU_UNLNK) + UNLINKED_1ST_CALL = .FALSE. + ENDIF + ! Open file to write unlinked cell information: + OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='OLD',POSITION='APPEND') + WRITE(LU_UNLNK,*) ' ' + WRITE(LU_UNLNK,'(A,I4,A,I4)') ' Mesh NM=',NM,', number of unlinked cells=',ULINK_COUNT - ! ALLOCATE to zero size - IF(ALLOCATED(MESHES(NM)%CFACE)) DEALLOCATE(MESHES(NM)%CFACE) - MESHES(NM)%N_CFACE_CELLS_DIM = NCFACE_BY_MESH(NM) - ALLOCATE(MESHES(NM)%CFACE(0:MESHES(NM)%N_CFACE_CELLS_DIM)) + ! Dump info: + ULINK_COUNT = 0 + DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + DO JCC=1,CC%NCELL + IF (CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0) CYCLE + ULINK_COUNT = ULINK_COUNT + 1 + WRITE(LU_UNLNK,'(I8,A,5I8,A,5F22.8)') & + ULINK_COUNT,', I,J,K,ICC,JCC=',I,J,K,ICC,JCC,', X,Y,Z,CCVOL,CCVOL_CRT=',M%X(I),M%Y(J),M%Z(K), & + CC%VOLUME(JCC),M%DX(I)*M%DY(J)*M%DZ(K) + ENDDO + ENDDO + CLOSE(LU_UNLNK) + ENDIF - ALLOCATE(MESHES(NM)%FACE_WORK1(MESHES(NM)%N_CFACE_CELLS_DIM)) - ALLOCATE(MESHES(NM)%FACE_WORK2(MESHES(NM)%N_CFACE_CELLS_DIM)) - ALLOCATE(MESHES(NM)%FACE_WORK3(MESHES(NM)%N_CFACE_CELLS_DIM)) + ! Unlinked cells get blocked, inboundary cut-faces are dropped, shared gas cut-faces are made inboundary faces + ! for neighbors. If no cut-cells left in location I,J,K => CCVAR(I,J,K,CC_CGSC) is set to CC_SOLID. + DO ICC=1,M%N_CUTCELL_MESH + DO JCC=1,M%CUT_CELL(ICC)%NCELL + IF ( M%CUT_CELL(ICC)%UNKZ(JCC) > 0 ) CYCLE + M%CUT_CELL(ICC)%IJK_LINK(1,JCC) = CC_SOLID ! Flag for Blocking after main mesh loop in SET_CUTCELLS_3D + ENDDO + ENDDO - ! Define pointers among External CC_GASPHASE CUT_FACE and CFACE (N_EXTERNAL_CFACE_CELLS): - CFACE_INDEX_LOCAL = 0 - DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE - CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE - CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE - END SELECT - ! Now get WALL cell SURF_INDEX: - IW = 0 - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (I==0 ) IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-1) - IF (I==IBAR) IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( 1) - CASE(JAXIS) - IF (J==0 ) IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-2) - IF (J==JBAR) IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( 2) - CASE(KAXIS) - IF (K==0 ) IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-3) - IF (K==KBAR) IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( 3) - END SELECT - SURF_INDEX = WALL(IW)%SURF_INDEX - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) - ENDDO - ENDDO - MESHES(NM)%N_EXTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - ! Define pointers among internal CC_GASPHASE CUT_FACE and CFACE (N_INTWALL_CFACE_CELLS): - DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST, or don't lay on a WALL_CELL: - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE - ENDIF - CASE(JAXIS) - IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE - ENDIF - CASE(KAXIS) - IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE - ENDIF - END SELECT - SURF_INDEX = WALL(IW)%SURF_INDEX - IF(.NOT.ALLOCATED(CF%CFACE_INDEX)) THEN; ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) - ELSEIF (SIZE(CF%CFACE_INDEX,DIM=1)/=CF%NFACE)THEN - DEALLOCATE(CF%CFACE_INDEX); ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) - ENDIF - IF(.NOT.ALLOCATED(CF%SURF_INDEX)) THEN; ALLOCATE(CF%SURF_INDEX(CF%NFACE)) - ELSEIF (SIZE(CF%SURF_INDEX,DIM=1)/=CF%NFACE)THEN - DEALLOCATE(CF%SURF_INDEX); ALLOCATE(CF%SURF_INDEX(CF%NFACE)) - ENDIF + ! Recount unlinked cells (i.e. no other viable cells in the mesh). + ULINK_COUNT = 0 + DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + DO JCC=1,CC%NCELL + IF ( CC%UNKZ(JCC) > 0 .OR. CC%IJK_LINK(1,JCC)==CC_SOLID) CYCLE + ULINK_COUNT = ULINK_COUNT + 1 + ENDDO + ENDDO - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) - ENDDO + IF (GET_CUTCELLS_VERBOSE) THEN + ! Write out remaining unlinked cells properties. + ! Open file to write unlinked cell information: + OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='OLD',POSITION='APPEND') + WRITE(LU_UNLNK,*) ' ' + WRITE(LU_UNLNK,*) 'STATUS AFTER BLOCKING SMALL UNLINKED CUT-CELLS:' + WRITE(LU_UNLNK,'(A,I4,A,I4)') ' Mesh NM=',NM,', number of unlinked cells after blocking=',ULINK_COUNT + IF(ULINK_COUNT > 0) THEN + ! Dump info: + ULINK_COUNT = 0 + DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + DO JCC=1,CC%NCELL + IF (CC%UNKZ(JCC)>0) CYCLE + ULINK_COUNT = ULINK_COUNT + 1 + WRITE(LU_UNLNK,'(I8,A,5I8,A,5F22.8)') & + ULINK_COUNT,', I,J,K,ICC,JCC=',I,J,K,ICC,JCC,', X,Y,Z,CCVOL,CCVOL_CRT=',M%X(I),M%Y(J),M%Z(K), & + CC%VOLUME(JCC),M%DX(I)*M%DY(J)*M%DZ(K) + ENDDO + ENDDO + ENDIF + CLOSE(LU_UNLNK) + ENDIF + EXIT LINK_LOOP + ENDIF BLOCK_CELL_IF +ENDDO LINK_LOOP + +! Finally compute M%FINEST_LINK_LEV: +DO ICC=1,M%N_CUTCELL_MESH + DO JCC=1,M%CUT_CELL(ICC)%NCELL + IF(M%CUT_CELL(ICC)%IJK_LINK(1,JCC)==CC_SOLID) THEN + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)==NOT_BLOCKED) M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCKED_UNLINK_CELL + M%CUT_CELL(ICC)%LINK_LEV(JCC) = CC_UNDEFINED + M%CUT_CELL(ICC)%IJK_LINK(2:5,JCC)= CC_UNDEFINED + ELSEIF(M%CUT_CELL(ICC)%LINK_LEV(JCC) < M%FINEST_LINK_LEV) THEN + M%FINEST_LINK_LEV = M%CUT_CELL(ICC)%LINK_LEV(JCC) + ENDIF ENDDO - MESHES(NM)%N_INTWALL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%N_EXTERNAL_CFACE_CELLS - MESHES(NM)%INTERNAL_CFACE_CELLS_LB = MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%N_INTWALL_CFACE_CELLS - ! Define pointers among CC_INBOUNDARY CUT_FACE and CFACE (N_INTERNAL_CFACE_CELLS): - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - CF => MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS) - ! Don't count INB cut-faces inside an OBST: - IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - SURF_INDEX = CF%SURF_INDEX(IFACE) - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.TRUE.) - ENDDO - IF(ALLOCATED(CF%CFACE_ORIGIN)) DEALLOCATE(CF%CFACE_ORIGIN) +ENDDO + +RETURN + +CONTAINS + +SUBROUTINE GET_ICC2_JCC2(ICC,IFACE,INXT,JNXT,KNXT,ICC2,JCC2) +INTEGER, INTENT(IN) :: ICC,IFACE,INXT,JNXT,KNXT +INTEGER, INTENT(OUT):: ICC2, JCC2 + +INTEGER :: IFC, IFACE2 +TYPE(CC_CUTCELL_TYPE), POINTER :: CC2 +ICC2=M%CCVAR(INXT,JNXT,KNXT,CC_IDCC); IF (ICC2<=0) RETURN +CC2 => M%CUT_CELL(ICC2) +DO JCC2=1,CC2%NCELL + ! Loop faces and test: + DO IFC=1,CC2%CCELEM(1,JCC2) + IFACE2 = CC2%CCELEM(IFC+1,JCC2) + ! If face type in face_list is not CC_FTYPE_RCGAS, drop: + IF(CC2%FACE_LIST(1,IFACE2) /= CC_FTYPE_RCGAS) CYCLE + ! Does X1AXIS match and LOWHIGH are different? + IF( CC2%FACE_LIST(3,IFACE2) /= M%CUT_CELL(ICC)%FACE_LIST(3,IFACE)) CYCLE ! X1AXIS is different. + IF(ABS(CC2%FACE_LIST(2,IFACE2) - M%CUT_CELL(ICC)%FACE_LIST(2,IFACE)) < 1) CYCLE ! Same LOWHIGH. + ! Found the cut-cell ICC2,JCC2 on the other side of IFACE for cut-cell ICC,JCC. + RETURN ENDDO - MESHES(NM)%N_INTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%INTERNAL_CFACE_CELLS_LB -ENDDO MESH_LOOP_1 +ENDDO +JCC2=0 +RETURN +END SUBROUTINE GET_ICC2_JCC2 -! Second loop, apply VENTS to change SURF_ID associated with CFACEs: -MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - ! ! Currently : Modify CFACE SURF_INDEX with VENT information: This needs more development. +END SUBROUTINE GET_CELL_LINK_INFO - VENT_LOOP : DO IVENT=1,MESHES(NM)%N_VENT - VT => VENTS(IVENT) - IF(.NOT.VT%GEOM) CYCLE VENT_LOOP ! Do not apply vent to Geometries. - ! This test is a simplified test for VENTS changing the CFACE SURF_ID to VENT SURF_ID for all CFACEs whose - ! centroid locations lay within the frame of the IOR grid aligned VENT: - ADDMAT = 0._EB; - SELECT CASE(ABS(VT%IOR)) - CASE(IAXIS) - ADDMAT(IAXIS,LOW_IND) = -(XF_MAX-XS_MIN) ! -DX(VT%I1) Set normal size to 2 times domain size. - ADDMAT(IAXIS,HIGH_IND) = (XF_MAX-XS_MIN) ! DX(VT%I2) XF_MAX, etc. defined in cons.f90. - CASE(JAXIS) - ADDMAT(JAXIS,LOW_IND) = -(YF_MAX-YS_MIN) ! -DY(VT%J1) - ADDMAT(JAXIS,HIGH_IND) = (YF_MAX-YS_MIN) ! DY(VT%J2) - CASE(KAXIS) - ADDMAT(KAXIS,LOW_IND) = -(ZF_MAX-ZS_MIN) ! -DZ(VT%K1) - ADDMAT(KAXIS,HIGH_IND) = (ZF_MAX-ZS_MIN) ! DZ(VT%K2) - END SELECT - ! CFACE Loop to modify SURF_INDEX in INTERNAL_CFACE_CELLS: - CFACE_LOOP_2 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - CFA => CFACE(CFACE_INDEX_LOCAL) - BC => BOUNDARY_COORD(CFA%BC_INDEX) - IF (BC%X < X(VT%I1)+ADDMAT(IAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%X > X(VT%I2)+ADDMAT(IAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - IF (BC%Y < Y(VT%J1)+ADDMAT(JAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%Y > Y(VT%J2)+ADDMAT(JAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - IF (BC%Z < Z(VT%K1)+ADDMAT(KAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%Z > Z(VT%K2)+ADDMAT(KAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - CFA%VENT_INDEX = IVENT - CFA%SURF_INDEX = VT%SURF_INDEX - ENDDO CFACE_LOOP_2 - ENDDO VENT_LOOP -ENDDO MESH_LOOP_2 -! - At this pont all final values of SURF_INDEX have been given to CFACEs. - -! Third loop, 1. Compute final FDS area integrals by SURF_ID and GEOM. -! 2. Compute input areas by SURF_ID and GEOM. First sum over GEOM FACES SURF_IDs, -! then VENTS input surfaces are assigned to corresponding GEOMs and SURF_IDs if present (VENTs take precedence). -IF(N_GEOMETRY>0) THEN - ALLOCATE(FDS_AREA_GEOM(0:N_SURF,N_GEOMETRY)); FDS_AREA_GEOM = 0._EB -ENDIF -MESH_LOOP_3 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - CFA => CFACE(CFACE_INDEX_LOCAL) - ICF = CFA%CUT_FACE_IND1; IFACE= CFA%CUT_FACE_IND2 - I = CUT_FACE(ICF)%BODTRI(1,IFACE) - IF(I>0) FDS_AREA_GEOM(CFA%SURF_INDEX,I) = FDS_AREA_GEOM(CFA%SURF_INDEX,I) + CFA%AREA - ENDDO -ENDDO MESH_LOOP_3 -! Sum FDS and INPUT areas per SURF_ID and GEOM (all reduce sum): -IF(N_GEOMETRY>0) & -CALL MPI_ALLREDUCE(MPI_IN_PLACE, FDS_AREA_GEOM(0,1), (N_SURF+1)*N_GEOMETRY, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) - -! Fourth Loop: Assign AREA_ADJUST for CFACEs, and assign BC info to CFACEs: -MESH_LOOP_4 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - - ! BCs related information for INTERNAL CFACE CELLS: - CFACE_LOOP_4 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - ICF = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND1 - IFACE = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND2 - SURF_INDEX = CFACE(CFACE_INDEX_LOCAL)%SURF_INDEX - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_TWO,IS_INB=.TRUE.) - ENDDO CFACE_LOOP_4 - -ENDDO MESH_LOOP_4 - -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' - IF (MY_RANK==0) WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' -ENDIF - -RETURN -END SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE +! --------------------- BLOCK_CC_SOLID_EXTWALLCELLS ----------------------------- -! ------------------------- SET_GC_CUTCELLS_3D ----------------------------------- +SUBROUTINE BLOCK_CC_SOLID_EXTWALLCELLS(FIRST_CALL) -SUBROUTINE SET_GC_CUTCELLS_3D +LOGICAL, INTENT(IN) :: FIRST_CALL -! Local Variables: -INTEGER :: IW,II,JJ,KK,IOR,IIO,JJO,KKO,IIF,JJF,KKF,IIOF,JJOF,KKOF,ICF,ICOF,X1AXIS,ICC,NMICC,NOFC,N_CF,N_CRT -REAL(EB):: XNM, XNOM +! Local variables: +INTEGER :: NM,IW,IIF,JJF,KKF,II,JJ,KK,IOR,X1AXIS TYPE (WALL_TYPE), POINTER :: WC -TYPE (EXTERNAL_WALL_TYPE), POINTER :: EWC -LOGICAL :: WC_PERIODIC, TEST_ICC -REAL(EB):: AREA_NM, AREA_NOM, AREA_CRT - - -IF (CCGUARD == 0) RETURN - -IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' - ENDIF -ENDIF - -! Meshes Loop: -! First Mesh Loop: -! Test if NOM mesh cells are of the same size or smaller than NM mesh that areas match: -MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - IF (MESHES(NM)%N_CUTFACE_MESH==0) CYCLE MESH_LOOP_1 +MESH_LOOP : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX CALL POINT_TO_MESH(NM) - - EXTERNAL_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS - + EXTERNAL_WALL_LOOP : DO IW=1,N_EXTERNAL_WALL_CELLS WC=>WALL(IW) - EWC=>EXTERNAL_WALL(IW) BC=>BOUNDARY_COORD(WC%BC_INDEX) - B1=>BOUNDARY_PROP1(WC%B1_INDEX) - IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & - WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_1 - + IF (FIRST_CALL) THEN + IF (.NOT.(WC%BOUNDARY_TYPE==INTERPOLATED_BOUNDARY)) CYCLE EXTERNAL_WALL_LOOP + ELSE + ! Here we might need to add other EXT wall cell types. + IF (.NOT.(WC%BOUNDARY_TYPE==OPEN_BOUNDARY .OR. WC%BOUNDARY_TYPE==SOLID_BOUNDARY)) CYCLE EXTERNAL_WALL_LOOP + ENDIF II = BC%II JJ = BC%JJ KK = BC%KK IOR = BC%IOR - - ! Skip if no cut-faces present on this WC: + X1AXIS = ABS(IOR) ! Define underlying Cartesian faces indexes: SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-IAXIS) ! Higher X boundary for Mesh NM. - IIF = II - 1; JJF = JJ ; KKF = KK - CASE( JAXIS) ! Lower Y boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-JAXIS) ! Higher Y boundary for Mesh NM. - IIF = II ; JJF = JJ - 1; KKF = KK - CASE( KAXIS) ! Lower Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-KAXIS) ! Higher Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - 1 + CASE( IAXIS) ! Lower X boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-IAXIS) ! Higher X boundary for Mesh NM. + IIF = II - 1; JJF = JJ ; KKF = KK + CASE( JAXIS) ! Lower Y boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-JAXIS) ! Higher Y boundary for Mesh NM. + IIF = II ; JJF = JJ - 1; KKF = KK + CASE( KAXIS) ! Lower Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-KAXIS) ! Higher Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK - 1 END SELECT - X1AXIS = ABS(IOR) - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE EXTERNAL_WALL_LOOP_1 + ! Change BOUNDARY_TYPE to null: + IF (FIRST_CALL) THEN + IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) WC%BOUNDARY_TYPE = SOLID_BOUNDARY + ELSE + IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) WC%BOUNDARY_TYPE = NULL_BOUNDARY + ENDIF + ENDDO EXTERNAL_WALL_LOOP +ENDDO MESH_LOOP - ! Gas cut-face area in wall-cell IW face: - ICF = FCVAR(IIF,JJF,KKF,CC_IDCF,X1AXIS) - AREA_NM = SUM(CUT_FACE(ICF)%AREA(1:CUT_FACE(ICF)%NFACE)) +RETURN +END SUBROUTINE BLOCK_CC_SOLID_EXTWALLCELLS - IF(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN - NOM = EWC%NOM ! Use Other Mesh Data. - IF(MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_1 - ! Now Obtain the CUT_FACE for the same face on NM-NOM: - AREA_NOM = 0._EB; N_CF=0; N_CRT=0 - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) - CASE(-IAXIS) ! Higher X boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO- 1; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) - CASE( JAXIS) ! Lower Y boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) - CASE(-JAXIS) ! Higher Y boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO ; JJOF= JJO- 1; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) - CASE( KAXIS) ! Lower Z boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) - CASE(-KAXIS) ! Higher Z boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO- 1; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) - END SELECT - IF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_FGSC,X1AXIS) == CC_GASPHASE) THEN - AREA_NOM = AREA_NOM + AREA_CRT - N_CRT = N_CRT + 1 - ELSEIF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) > 0) THEN ! there are gasphase cut-faces - ICOF = MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) - AREA_NOM = AREA_NOM + SUM(MESHES(NOM)%CUT_FACE(ICOF)%AREA(1:MESHES(NOM)%CUT_FACE(ICOF)%NFACE)) - N_CF = N_CF + 1 - ENDIF - ENDDO - ENDDO - ENDDO +! ----------------------- INIT_CFACE_CELL ----------------------------- - ! Check if: - ! 1. other mesh faces are more than one -> areas match. - ! 2. other mesh face and size of cartesian faces the same -> areas match. - ! 3. Left the case of fine mesh face with OMESH face coarse. - NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 - IF ( (NOFC > 1) .OR. (ABS(B1%AREA-AREA_CRT) < GEOMEPS) )THEN - IF(ABS(AREA_NM-AREA_NOM) > ADIFF_INFO_FACTOR*AREA_CRT) THEN - WRITE(LU_ERR,*) 'SET_GC_CUTCELLS_3D Error: MESH=',NM,', CUT_FACE=',ICF,' does not match OMESH=',& - NOM,', with CUT_FACEs,CRT_FACEs=',N_CF,N_CRT,', area difference=',& - ABS(AREA_NM-AREA_NOM),', GEOMEPS=',GEOMEPS - WRITE(LU_ERR,*) 'CUT FACE=',ICF,MESHES(NM)%CUT_FACE(ICF)%IJK(1:4),':',MESHES(NM)%CUT_FACE(ICF)%STATUS - ENDIF - ENDIF +SUBROUTINE INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX,SURF_INDEX,STAGE_FLG,IS_INB,IW) - ENDIF +USE GEOMETRY_FUNCTIONS, ONLY : SEARCH_OTHER_MESHES +USE MEMORY_FUNCTIONS, ONLY: ALLOCATE_STORAGE +USE MATH_FUNCTIONS, ONLY : CROSS_PRODUCT - ENDDO EXTERNAL_WALL_LOOP_1 +! Routine that initializes new CFACE with index CFACE_INDEX. +! Geometry information for CFACE is loaded from MESHES(NM)%CUT_FACE(ICF)%AREA(IFACE), etc. +! Assumes POINT_TO_MESH has been called. -ENDDO MESH_LOOP_1 +INTEGER, INTENT(IN) :: NM,ICF,IFACE,CFACE_INDEX,SURF_INDEX,STAGE_FLG +LOGICAL, INTENT(IN) :: IS_INB +INTEGER, OPTIONAL, INTENT(IN) :: IW +! Local Variables: +INTEGER :: IBOD, IWSEL, ICC, JCC -! Second mesh loop: -! Define cut-cell data on guard-cell region to be communicated: -MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX +INTEGER :: IG, TRI, WSELEM(NOD1:NOD3), NOM, IIO, JJO, KKO, IIV(3), JJV(3), KKV(3), ICF2, JCF2, JCF22, ICF3, JCF3, & + II, JJ, KK, III, JJJ, KKK, ICFACE, ICFF, IOR, X1AXIS +REAL(EB):: XP(IAXIS:KAXIS),RDIR(IAXIS:KAXIS),V1(IAXIS:KAXIS),V2(IAXIS:KAXIS),V3(IAXIS:KAXIS),POS(IAXIS:KAXIS),DIST,DIST2 +LOGICAL :: IS_INTERSECT=.FALSE., BACK_CFACE_FOUND=.FALSE. +TYPE (SURFACE_TYPE), POINTER :: SF +TYPE (WALL_TYPE), POINTER :: WC +TYPE (MESH_TYPE), POINTER :: M +TYPE (CFACE_TYPE), POINTER :: CFA +TYPE (CC_CUTFACE_TYPE), POINTER :: CF - IF ((MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH)==0) CYCLE MESH_LOOP_2 +M => MESHES(NM) +SF=> SURFACE(SURF_INDEX) +CF=> CUT_FACE(ICF) - CALL POINT_TO_MESH(NM) +STAGE_FLG_BRANCH : SELECT CASE(STAGE_FLG) - EXTERNAL_WALL_LOOP_2 : DO IW=1,N_EXTERNAL_WALL_CELLS +CASE(INTEGER_ONE) ! Geometry information for CFACE. - WC=>WALL(IW) - BC=>BOUNDARY_COORD(WC%BC_INDEX) - EWC=>EXTERNAL_WALL(IW) - IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & - WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_2 + CALL ALLOCATE_STORAGE(NM,SURF_INDEX=SURF_INDEX,CFACE_INDEX=CFACE_INDEX) - II = BC%II - JJ = BC%JJ - KK = BC%KK - IOR = BC%IOR - NOM = EWC%NOM ! Use Other Mesh Data. + CFA => M%CFACE(CFACE_INDEX) + BC => M%BOUNDARY_COORD(CFA%BC_INDEX) + B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) - IF (NOM>0) THEN - IF (MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_2 - ENDIF + CFA%SURF_INDEX = SURF_INDEX + CFA%NODE_INDEX = SURFACE(SURF_INDEX)%NODE_INDEX + B1%NODE_INDEX = CFA%NODE_INDEX - IF (WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN + BC%X = CF%XYZCEN(IAXIS,IFACE) + BC%Y = CF%XYZCEN(JAXIS,IFACE) + BC%Z = CF%XYZCEN(KAXIS,IFACE) + CFA%AREA = CF%AREA(IFACE) - ! Skip if no cut-faces present on this WC: - ! Define underlying Cartesian faces indexes: - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-IAXIS) ! Higher X boundary for Mesh NM. - IIF = II - 1; JJF = JJ ; KKF = KK - CASE( JAXIS) ! Lower Y boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-JAXIS) ! Higher Y boundary for Mesh NM. - IIF = II ; JJF = JJ - 1; KKF = KK - CASE( KAXIS) ! Lower Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-KAXIS) ! Higher Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - 1 - END SELECT - X1AXIS = ABS(IOR) - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) CYCLE EXTERNAL_WALL_LOOP_2 + ! Now populate cut-face information: + CFA%CUT_FACE_IND1 = ICF + CFA%CUT_FACE_IND2 = IFACE - IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN - TEST_ICC = .TRUE. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - TEST_ICC = TEST_ICC .AND. (MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) <= 0) - ENDDO - ENDDO - ENDDO + INS_INB_COND_1 : IF (IS_INB) THEN + B1%VEL_ERR_NEW=CF%VEL(IFACE) - 0._EB ! Assumes zero velocity of solid. - NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) - ! Do test for PERIODIC boundaries. Note: PERIODIC boundaries at this point have been redefined as INTERPOLATED_BOUNDARY, - ! so we test using the Mesh center relative locations. - IF (WC%BOUNDARY_TYPE==INTERPOLATED_BOUNDARY .AND. NMICC > 0 .AND. TEST_ICC) THEN - WC_PERIODIC=.FALSE. - SELECT CASE(IOR) - CASE(-IAXIS) ! High X wall cell. - XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( IAXIS) ! Low X wall cell. - XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE(-JAXIS) ! High Y wall cell. - XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( JAXIS) ! Low Y wall cell. - XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE(-KAXIS) ! High Z wall cell. - XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( KAXIS) ! Low Z wall cell. - XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - END SELECT - IF (WC_PERIODIC) THEN - MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) = 0 ! Set NMICC = 0. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - IF(MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_CGSC)==CC_SOLID) THEN - MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC)=CC_SOLID ! set to Solid. - CYCLE EXTERNAL_WALL_LOOP_2 - ENDIF - ENDDO - ENDDO - ENDDO - ENDIF - ENDIF + ! Normal to cut-face: + V2(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(2,IFACE))-CF%XYZCEN(IAXIS:KAXIS,IFACE) + V3(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(3,IFACE))-CF%XYZCEN(IAXIS:KAXIS,IFACE) + CALL CROSS_PRODUCT(BC%NVEC(IAXIS:KAXIS),V2,V3) + IF(NORM2(BC%NVEC)>TWENTY_EPSILON_EB .AND. CF%CFACE_ORIGIN(IFACE)==BLOCKED_SPLIT_CELL) THEN + BC%NVEC(IAXIS:KAXIS) = BC%NVEC(IAXIS:KAXIS)/NORM2(BC%NVEC) + ELSE + IBOD =CF%BODTRI(1,IFACE) + IWSEL=CF%BODTRI(2,IFACE) + BC%NVEC(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) + ENDIF + X1AXIS = MAXLOC(ABS(BC%NVEC(IAXIS:KAXIS)),DIM=1) + BC%IOR = INT(SIGN(1._EB,BC%NVEC(X1AXIS)))*X1AXIS - NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 - ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 - N_CF = 0 - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) - IF (ICC > 0) THEN - N_CF = N_CF + 1 - MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,N_CF) = (/ NOM, ICC /) - NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL - ! Add NCELL cut-cells to OM%NCC_R: - MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 - MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL - ENDIF - ENDDO - ENDDO - ENDDO - MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = N_CF - ENDIF + ! Boundary CFACES processed are defined of type SOLID_BOUNDARY + CFA%BOUNDARY_TYPE = SOLID_BOUNDARY - ! Here add cut or regular faces to every face on this wall cell: - ! This requires defining the sets of cut and regular faces within the area of each cut or - ! regular face. Option : Use POINT_IN_POLYGON with centroids. To do. + ! Might need to rethink this, but for the time being... + BC%II = CF%IJK(IAXIS) + BC%JJ = CF%IJK(JAXIS) + BC%KK = CF%IJK(KAXIS) - ELSEIF(WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) THEN - NOM = NM ! Use gas cell data, same mesh. - IIO = BC%IIG - JJO = BC%JJG - KKO = BC%KKG - ! CYCLE if OBJECT face is in the Mirror Boundary, normal out into ghost-cell: - SELECT CASE(IOR) - CASE( IAXIS) - IF(FCVAR(IIO-1,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE - CASE(-IAXIS) - IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE - CASE( JAXIS) - IF(FCVAR(IIO ,JJO-1,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE - CASE(-JAXIS) - IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE - CASE( KAXIS) - IF(FCVAR(IIO ,JJO ,KKO-1,CC_FGSC,KAXIS) == CC_SOLID) CYCLE - CASE(-KAXIS) - IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,KAXIS) == CC_SOLID) CYCLE - END SELECT - IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN - ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC); IF (ICC<1) CYCLE - NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) - NOFC = 1 - ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 - MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,NOFC) = (/ NOM, ICC /) - MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = NOFC - NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL - ! Add NCELL cut-cells to OM%NCC_R: - MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 - MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL - ENDIF - ENDIF + BC%IIG = CF%IJK(IAXIS) + BC%JJG = CF%IJK(JAXIS) + BC%KKG = CF%IJK(KAXIS) + ELSE INS_INB_COND_1 ! External mesh boundary CFACE - ENDDO EXTERNAL_WALL_LOOP_2 + IF (PRESENT(IW)) THEN + WC => M%WALL(IW) + WC_BC => M%BOUNDARY_COORD(WC%BC_INDEX) + IOR = WC_BC%IOR + SELECT CASE(ABS(IOR)) + CASE(IAXIS); BC%NVEC(IAXIS:KAXIS) = (/ REAL(SIGN(1,IOR),EB), 0._EB, 0._EB /) + CASE(JAXIS); BC%NVEC(IAXIS:KAXIS) = (/ 0._EB, REAL(SIGN(1,IOR),EB), 0._EB /) + CASE(KAXIS); BC%NVEC(IAXIS:KAXIS) = (/ 0._EB, 0._EB, REAL(SIGN(1,IOR),EB) /) + END SELECT + BC%IOR = IOR -ENDDO MESH_LOOP_2 + ! External mesh boundary CFACES inherit the underlaying WALL type. + CFA%BOUNDARY_TYPE = WC%BOUNDARY_TYPE + CFA%NODE_INDEX = SURFACE(WC%SURF_INDEX)%NODE_INDEX + CFA%VENT_INDEX = WC%VENT_INDEX -IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' - ENDIF -ENDIF + BC%II = WC_BC%II + BC%JJ = WC_BC%JJ + BC%KK = WC_BC%KK -RETURN + BC%IIG = WC_BC%IIG + BC%JJG = WC_BC%JJG + BC%KKG = WC_BC%KKG -END SUBROUTINE SET_GC_CUTCELLS_3D + ENDIF + ENDIF INS_INB_COND_1 + B1%AREA = CF%AREA(IFACE) ! Init to CFACE AREA. -! --------------------------- GET_GEOM_TRIBIN -------------------------------------- +CASE(INTEGER_TWO) ! Assign AREA_ADJUST for CFACE, BCs information for CFACE. -SUBROUTINE GET_GEOM_TRIBIN + CFA => M%CFACE(CFACE_INDEX) + BC => M%BOUNDARY_COORD(CFA%BC_INDEX) + B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) + ! First: Assign AREA_ADJUST for CFACEs. + B1%AREA_ADJUST = CF%AREA_ADJUST(IFACE) -! This routine separates lists of triangles for each GEOMETRY in interval -! bins in each direction. They are used in SET_CUTCELLS_3D/GET_BODINT_PLANE to optimize -! cut-cell generation. + ! Case of exposed Backing we need to find CFACE_INDEX of BACK CFACE. + IF (SF%BACKING==EXPOSED .AND. SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN + IG = CF%BODTRI(1,IFACE) + TRI = CF%BODTRI(2,IFACE) + XP(IAXIS:KAXIS) = (/ BC%X, BC%Y, BC%Z /) ! CFACE centroid location. + RDIR(IAXIS:KAXIS)= - GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,TRI) ! Normal into the body. + TRI_LOOP : DO IWSEL=1,GEOMETRY(IG)%N_FACES + IF (IWSEL==TRI) CYCLE + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + ! Triangles NODES coordinates: + V1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) + V2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) + V3(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD3)-1)+1:MAX_DIM*WSELEM(NOD3)) -! Local Variables: -INTEGER :: IG, IWSEL, IEDGE, NTL, SZE, IBIN, ILO_BIN, IHI_BIN, WSELEM(NOD1:NOD3) -REAL(EB):: LEDGE, DXYZE(MAX_DIM), LX1, DELBIN, X1V_LO, X1V_HI, X1V(NOD1:NOD3) -INTEGER, ALLOCATABLE, DIMENSION(:) :: TRI_LIST -REAL(EB):: MINMAX_MESHES(LOW_IND:HIGH_IND,IAXIS:KAXIS),MIN_MESHGEOM,MAX_MESHGEOM -TYPE(GEOMETRY_TYPE), POINTER :: G -INTEGER :: DELTA_TBIN2 + ! Fast triangle discard method: To do. + ! Search for intersection point in POS(IAXIS:KAXIS): + CALL RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,RDIR,IS_INTERSECT,POS) -! Define boundary region of Meshes handled by MPI process and their connected meshes: -! Select MESHES assigned to processor and OMESHES of these. Cut-cells will be computed for all of them. -IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) -ALLOCATE(CC_COMPUTE_MESH(1:NMESHES)); CC_COMPUTE_MESH = .FALSE. -MINMAX_MESHES( LOW_IND,:)= 1._EB/TWENTY_EPSILON_EB -MINMAX_MESHES(HIGH_IND,:)= -1._EB/TWENTY_EPSILON_EB -DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CC_COMPUTE_MESH(NM)=.TRUE. ! Compute cut-cells for my meshes. - ! Min-max locations of MESH + halo region. - IG = MESHES(NM)%IBAR - MINMAX_MESHES( LOW_IND,IAXIS) = MIN(MINMAX_MESHES( LOW_IND,IAXIS),MESHES(NM)%XS-REAL(NGUARD,EB)*MESHES(NM)%DX( 1)) - MINMAX_MESHES(HIGH_IND,IAXIS) = MAX(MINMAX_MESHES(HIGH_IND,IAXIS),MESHES(NM)%XF+REAL(NGUARD,EB)*MESHES(NM)%DX(IG)) - IG = MESHES(NM)%JBAR - MINMAX_MESHES( LOW_IND,JAXIS) = MIN(MINMAX_MESHES( LOW_IND,JAXIS),MESHES(NM)%YS-REAL(NGUARD,EB)*MESHES(NM)%DY( 1)) - MINMAX_MESHES(HIGH_IND,JAXIS) = MAX(MINMAX_MESHES(HIGH_IND,JAXIS),MESHES(NM)%YF+REAL(NGUARD,EB)*MESHES(NM)%DY(IG)) - IG = MESHES(NM)%KBAR - MINMAX_MESHES( LOW_IND,KAXIS) = MIN(MINMAX_MESHES( LOW_IND,KAXIS),MESHES(NM)%ZS-REAL(NGUARD,EB)*MESHES(NM)%DZ( 1)) - MINMAX_MESHES(HIGH_IND,KAXIS) = MAX(MINMAX_MESHES(HIGH_IND,KAXIS),MESHES(NM)%ZF+REAL(NGUARD,EB)*MESHES(NM)%DZ(IG)) - DO NOM=1,NMESHES - IF (MESHES(NM)%OMESH(NOM)%NIC_R > 0) THEN - CC_COMPUTE_MESH(NOM)=.TRUE. ! There are cells from mesh NOM that are guardcells of mesh NM. - ! Min-max locations of MESH + halo region. - IG = MESHES(NOM)%IBAR - MINMAX_MESHES( LOW_IND,IAXIS) = MIN(MINMAX_MESHES( LOW_IND,IAXIS),MESHES(NOM)%XS-REAL(NGUARD,EB)*MESHES(NOM)%DX( 1)) - MINMAX_MESHES(HIGH_IND,IAXIS) = MAX(MINMAX_MESHES(HIGH_IND,IAXIS),MESHES(NOM)%XF+REAL(NGUARD,EB)*MESHES(NOM)%DX(IG)) - IG = MESHES(NOM)%JBAR - MINMAX_MESHES( LOW_IND,JAXIS) = MIN(MINMAX_MESHES( LOW_IND,JAXIS),MESHES(NOM)%YS-REAL(NGUARD,EB)*MESHES(NOM)%DY( 1)) - MINMAX_MESHES(HIGH_IND,JAXIS) = MAX(MINMAX_MESHES(HIGH_IND,JAXIS),MESHES(NOM)%YF+REAL(NGUARD,EB)*MESHES(NOM)%DY(IG)) - IG = MESHES(NOM)%KBAR - MINMAX_MESHES( LOW_IND,KAXIS) = MIN(MINMAX_MESHES( LOW_IND,KAXIS),MESHES(NOM)%ZS-REAL(NGUARD,EB)*MESHES(NOM)%DZ( 1)) - MINMAX_MESHES(HIGH_IND,KAXIS) = MAX(MINMAX_MESHES(HIGH_IND,KAXIS),MESHES(NOM)%ZF+REAL(NGUARD,EB)*MESHES(NOM)%DZ(IG)) - ENDIF - ENDDO -ENDDO + IF (IS_INTERSECT) EXIT TRI_LOOP + ENDDO TRI_LOOP -! Loop geometries: -LOOP_GEOM : DO IG = 1, N_GEOMETRY + IF (IS_INTERSECT) THEN - G=>GEOMETRY(IG) + ! Check that distance is less than cell diagonal size: + ! For longer distances from CFACE to BACK CFACE BC is 'VOID'. + IF(NORM2(XP-POS) > SQRT(DX(BC%IIG)**2 + DY(BC%JJG)**2 + DZ(BC%KKG)**2)) RETURN - ! Define EDGE sizes and FACE cointaining boxes: - G%MAX_LEDGE = GEOMEPS ! Initialize to a small number. - G%MIN_LEDGE = 1._EB/GEOMEPS ! Initialize to a large number. - G%MEAN_LEDGE= 0._EB ! Initialize to 0. + ! We Found an intersection with IWSEL in position POS(IAXIS:KAXIS): + ! Find indexes and mesh of cell containing intersection point: + CALL SEARCH_OTHER_MESHES(POS(IAXIS),POS(JAXIS),POS(KAXIS),NOM,IIO,JJO,KKO) - ! Loop Faces: - DO IWSEL = 0,G%N_FACES-1 - WSELEM(NOD1:NOD3) = G%FACES(3*IWSEL+1:3*IWSEL+3) + ! This test and restriction of NOM==NM is temporary. Discard when parallel CFACE info is in place. + IF (NOM/=NM) THEN + IF(NOM==0) RETURN + WRITE(LU_ERR,*) 'WARNING: BACK CFACE search, other mesh NOM not equal to working mesh NM. NM=',NM,& + ', NOM and other cell IIO,JJO,KKO=',NOM,IIO,JJO,KKO,', intersection pt=',POS(IAXIS:KAXIS) + RETURN + ENDIF - ! Obtain edges length, test against MAX_LEDGE: - DO IEDGE=1,3 - ! DX = XYZ2 - XYZ1: - DXYZE(IAXIS:KAXIS) = G%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) - & - G%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) - LEDGE = sqrt( DXYZE(IAXIS)**2._EB + DXYZE(JAXIS)**2._EB + DXYZE(KAXIS)**2._EB ) + IF (NOM>0) THEN + IF (ALLOCATED(MESHES(NOM)%CCVAR)) THEN + IIV(1:3) = (/ IIO, MAX(IIO-1,1), MIN(IIO+1,MESHES(NOM)%IBAR) /) + JJV(1:3) = (/ JJO, MAX(JJO-1,1), MIN(JJO+1,MESHES(NOM)%JBAR) /) + KKV(1:3) = (/ KKO, MAX(KKO-1,1), MIN(KKO+1,MESHES(NOM)%KBAR) /) - G%MAX_LEDGE = MAX(G%MAX_LEDGE,LEDGE) - G%MIN_LEDGE = MIN(G%MIN_LEDGE,LEDGE) - G%MEAN_LEDGE= G%MEAN_LEDGE + LEDGE + DIST= 1._EB/TWENTY_EPSILON_EB; ICFF=0; JCF2=0 + K_LOOP : DO KKK=1,3 + KK=KKV(KKK) + DO JJJ=1,3 + JJ=JJV(JJJ) + DO III=1,3 + II=IIV(III) + ICF2 = MESHES(NOM)%CCVAR(II,JJ,KK,CC_IDCF) + ICF2_COND : IF (ICF2>0) THEN - WSELEM=CSHIFT(WSELEM,1) ! Shift cyclically array by 1 entry. This rotates nodes connectivities. - ! i.e: initially WSELEM=(/1,2,3/), 1st call gives WSELEM=(/2,3,1/), 2nd - ! call gives WSELEM=(/3,1,2/). - ENDDO + ! Use cut-face with closest centroid to POS: + DO JCF22=1,MESHES(NOM)%CUT_FACE(ICF2)%NFACE + IF(ICF==ICF2 .AND. IFACE==JCF22) CYCLE + DIST2 = (POS(IAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(IAXIS,JCF22))**2._EB + & + (POS(JAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(JAXIS,JCF22))**2._EB + & + (POS(KAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(KAXIS,JCF22))**2._EB + IF (DIST20 .AND. CFA%OD_INDEX>0) THEN + M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_MESH = NOM + M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_INDEX = ICFACE + ENDIF - ! Define number of bins in direction X1AXIS: - G%TBAXIS(X1AXIS)%N_BINS = CEILING(LX1/(GAMMA_MULT*G%MEAN_LEDGE)) + ! Write error for testing: + ELSE + WRITE(LU_ERR,*) 'WARNING: BACK CFACE search, MESH, CFACE_INDEX=',NM,CFACE_INDEX,& + ', back CFACE not found in mesh NOM,IIO,JJO,KKO=',NOM,IIO,JJO,KKO + RETURN + ENDIF + ELSE ! Intersection in mesh furher away than neighboring meshes. + ! To Do stop. - ! No overlap between procs meshes and Geometry, cycle: - IF (G%TBAXIS(X1AXIS)%N_BINS < 1) THEN; G%TBAXIS(X1AXIS)%N_BINS = 0; CYCLE; ENDIF + ENDIF - DELTA_TBIN2 = MAX(DELTA_TBIN,CEILING(0.05_EB*LX1/(G%GEOM_BOX(HIGH_IND,X1AXIS)-G%GEOM_BOX(LOW_IND,X1AXIS))*& - REAL(G%N_FACES,EB)/REAL(G%TBAXIS(X1AXIS)%N_BINS+1,EB))) + ELSE ! Intersection outside of domain. + ! To Do stop. - ! Allocate TRIBIN field: - IF(ALLOCATED(G%TBAXIS(X1AXIS)%TRIBIN)) DEALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN) - ALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN(1:G%TBAXIS(X1AXIS)%N_BINS)) + ENDIF - ! Set BIN boundaries and make initial allocation of TRI_LIST for each bin: - DELBIN = LX1 / REAL(G%TBAXIS(X1AXIS)%N_BINS,EB) - G%TBAXIS(X1AXIS)%DELBIN = DELBIN - DO IBIN=1,G%TBAXIS(X1AXIS)%N_BINS - G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW = MIN_MESHGEOM + REAL(IBIN-1,EB)*DELBIN - G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH = MIN_MESHGEOM + REAL(IBIN ,EB)*DELBIN - G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL = 0 - ALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(DELTA_TBIN2)) - ENDDO + ELSE ! Did not find intersection with other triangles. + ! To Do : Here we can add a test to check if CFACE is indeed within geometry IG. Geometry intersection and + ! linearization lead need to CFACES lay outside of the geometry. + WRITE(LU_ERR,*) 'WARNING: BACK CFACE search did NOT Find Intersection. MESH=',NM,', GEOM=',IG,& + ', CFACE_INDEX, Centroid location=',CFACE_INDEX,XP(:) + RETURN + ENDIF - ! Finally, populate TRI_LIST for X1AXIS bins: - DO IWSEL = 0,G%N_FACES-1 - WSELEM(NOD1:NOD3) = G%FACES(3*IWSEL+1:3*IWSEL+3) - X1V(NOD1:NOD3) = G%VERTS(MAX_DIM*(WSELEM(NOD1:NOD3)-1)+X1AXIS) - X1V_LO = MINVAL(X1V(NOD1:NOD3)); - X1V_HI = MAXVAL(X1V(NOD1:NOD3)); - ILO_BIN = MAX(1,CEILING((X1V_LO-GEOMEPS-MIN_MESHGEOM)/DELBIN)) - IHI_BIN = MIN(G%TBAXIS(X1AXIS)%N_BINS,CEILING((X1V_HI+GEOMEPS-MIN_MESHGEOM)/DELBIN)) - DO IBIN=ILO_BIN,IHI_BIN - NTL = G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL + 1 - SZE = SIZE(G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST,DIM=1) - IF (NTL > SZE) THEN - ! Reallocate: - ALLOCATE(TRI_LIST(1:SZE+DELTA_TBIN2)); - TRI_LIST(1:SZE)=G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) - CALL MOVE_ALLOC(FROM=TRI_LIST,TO=G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST) - ENDIF - ! Add Triangle index to BINs TRI_LIST - G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL = NTL - G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(NTL) = IWSEL+1 + ENDIF - ENDDO - ENDDO - END DO +CASE(INTEGER_THREE) - ! WRITE(LU_ERR,*) 'GEOMETRY=',IG,'NBINS=',G%TBAXIS(IAXIS)%N_BINS,G%TBAXIS(JAXIS)%N_BINS,G%TBAXIS(KAXIS)%N_BINS - ! DO X1AXIS=IAXIS,KAXIS - ! DO IBIN=1,G%TBAXIS(X1AXIS)%N_BINS - ! WRITE(LU_ERR,*) X1AXIS,'IBIN, NTL=',IBIN,G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL, & - ! G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW,G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH - ! END DO - ! END DO + CFA => M%CFACE(CFACE_INDEX) + BC => M%BOUNDARY_COORD(CFA%BC_INDEX) + B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) -ENDDO LOOP_GEOM + INS_INB_COND_3 : IF (IS_INB) THEN -RETURN -END SUBROUTINE GET_GEOM_TRIBIN + ! Associated cut-cell location in CUT_CELL array. + ! This CFACE initialization assumes TMP,RHO,ZZ have been initialized in cut-cell ICC,JCC. + ICC = CF%CELL_LIST(2,LOW_IND,IFACE) + JCC = CF%CELL_LIST(3,LOW_IND,IFACE) + ! Set TMP_F to Surface value and rest to ambient in underlying cartesian cell. + B1%TMP_G = TMP_0(CF%IJK(KAXIS)) + IF (SF%TMP_FRONT > 0._EB) THEN + B1%TMP_F = SF%TMP_FRONT + ELSE + B1%TMP_F = B1%TMP_G + ENDIF -! --------------------------- SNAP_GEOM_NODES -------------------------------------- + B1%RHO_F = CUT_CELL(ICC)%RHO(JCC) + B1%RHO_G = CUT_CELL(ICC)%RHO(JCC) + B1%ZZ_F(1:N_TOTAL_SCALARS) = CUT_CELL(ICC)%ZZ(1:N_TOTAL_SCALARS,JCC) + ! Reinitialize CFACE cell outgoing radiation for change in TMP_F + IF (RADIATION) THEN + B1%Q_RAD_OUT = B1%EMISSIVITY*SIGMA*B1%TMP_F**4 + ELSE + B1%Q_RAD_OUT = 0._EB + ENDIF + ! Assign normal velocity to CFACE from SURF input: + B1%U_NORMAL_0 = SF%VEL + ! Assign normal velocity from VOLUME_FLOW : + IBOD =CF%BODTRI(1,IFACE) + IF(IBOD>0 .AND. ABS(SF%VOLUME_FLOW)>=TWENTY_EPSILON_EB) B1%U_NORMAL_0 = SF%VOLUME_FLOW / FDS_AREA_GEOM(SURF_INDEX,IBOD) + ! Assign normal velocity from MASS_FLUX_TOTAL : + IF(ABS(SF%MASS_FLUX_TOTAL)>=TWENTY_EPSILON_EB) B1%U_NORMAL_0 = SF%MASS_FLUX_TOTAL / RHOA * B1%AREA_ADJUST + ! Vegetation T_IGN setup: Check if fire spreads radially over this surface type + IF (SF%FIRE_SPREAD_RATE>0._EB) THEN + B1%T_IGN = T_BEGIN + SQRT((BC%X-SF%XYZ(1))**2 + & + (BC%Y-SF%XYZ(2))**2 + & + (BC%Z-SF%XYZ(3))**2)/SF%FIRE_SPREAD_RATE + ELSE + B1%T_IGN = SF%T_IGN + ENDIF -SUBROUTINE SNAP_GEOM_NODES + ELSE INS_INB_COND_3 ! External mesh boundary CFACE -INTEGER :: IBIN,IWSELDUM,IWSEL,WSELEM(NOD1:NOD3),X1LO,X1HI,X1IND,ILO_BIN,IHI_BIN -REAL(EB):: MIN_MESHGEOM,DELBIN -REAL(EB) :: CPUTIME_START, CPUTIME + IF (PRESENT(IW)) THEN + WC => M%WALL(IW) + IOR = M%BOUNDARY_COORD(WC%BC_INDEX)%IOR + WC_B1 => M%BOUNDARY_PROP1(WC%B1_INDEX) + WC_BC => M%BOUNDARY_COORD(WC%BC_INDEX) + ! Set TMP_F to Surface value and rest to ambient in underlying cartesian cell. + B1%TMP_G = TMP(WC_BC%IIG,WC_BC%JJG,WC_BC%KKG) + B1%TMP_F = WC_B1%TMP_F + B1%RHO_F = WC_B1%RHO_F + B1%RHO_G = RHO(WC_BC%IIG,WC_BC%JJG,WC_BC%KKG) + B1%ZZ_F(1:N_TOTAL_SCALARS) = WC_B1%ZZ_F(1:N_TOTAL_SCALARS) -IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_ERR,'(A)',advance="no") ' 1a. Snap node position to grid planes : SNAP_GEOM_NODES' -ENDIF + ! Assign normal velocity to CFACE from wall cell: + B1%U_NORMAL_0 = WC_B1%U_NORMAL_0 -! Main Loop over Geometries, set nodes to SNAP_NODE=T: -MAIN_GEOM_LOOP_1 : DO IG=1,N_GEOMETRY - ALLOCATE(GEOMETRY(IG)%SNAP_NODE(IAXIS:KAXIS,1:GEOMETRY(IG)%N_VERTS)); GEOMETRY(IG)%SNAP_NODE = .FALSE. - AXIS_LOOP_1 : DO X1AXIS=IAXIS,KAXIS - IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE - ! Run all bin on this geometry and set nodes involved to SNAP_NODE=T: - IBIN_DO_1 : DO IBIN=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS - ! Loop surface triangles: - DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL - IWSEL=GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(IWSELDUM) - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(MAX_DIM*(IWSEL-1)+1:MAX_DIM*IWSEL) - GEOMETRY(IG)%SNAP_NODE(X1AXIS, (/WSELEM(NOD1:NOD3)/) ) = .TRUE. ! Set nodes to test for snapping to grid planes. - ENDDO - ENDDO IBIN_DO_1 - ENDDO AXIS_LOOP_1 -ENDDO MAIN_GEOM_LOOP_1 + ! Here downscale velocity: + IF (IFACE==CF%NFACE) WC_B1%U_NORMAL_0 = & + WC_B1%U_NORMAL_0 * SUM(CF%AREA(1:CF%NFACE))/WC_B1%AREA -! Now Mesh loop on mesh + guard planes to test against -! Main Loop over Meshes: -MAIN_MESH_LOOP : DO NM=1,NMESHES + ! Vegetation T_IGN setup: + B1%T_IGN = WC_B1%T_IGN + ! Back wall cells: + IF (WC%OD_INDEX>0 .AND. CFA%OD_INDEX>0) THEN + M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_MESH = M%BOUNDARY_ONE_D(WC%OD_INDEX)%BACK_MESH + M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_INDEX = M%BOUNDARY_ONE_D(WC%OD_INDEX)%BACK_INDEX + ENDIF + ENDIF - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) - ! Run by coordinate direction, define planes X1PLN on this mesh, look for involved GEOMETRY vertices using TBAXIS and - ! after positive test of SNAP_NODE check if node is to be snapped to plane. - AXIS_LOOP_2 : DO X1AXIS=IAXIS,KAXIS - - SELECT CASE(X1AXIS) - CASE(IAXIS) - X1LO = ILO_FACE-CCGUARD; X1HI = IHI_FACE+CCGUARD - ALLOCATE(X1FACE(ISTR:IEND),DX1FACE(ISTR:IEND)); X1FACE = XFACE; DX1FACE = DXFACE - CASE(JAXIS) - X1LO = JLO_FACE-CCGUARD; X1HI = JHI_FACE+CCGUARD - ALLOCATE(X1FACE(JSTR:JEND),DX1FACE(JSTR:JEND)); X1FACE = YFACE; DX1FACE = DYFACE - CASE(KAXIS) - X1LO = KLO_FACE-CCGUARD; X1HI = KHI_FACE+CCGUARD - ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)); X1FACE = ZFACE; DX1FACE = DZFACE - END SELECT - - ! Loop planes in X1AXIS direction: - X1PLN_LOOP : DO X1IND=X1LO,X1HI - X1PLN = X1FACE(X1IND) ! Plane position. - MAIN_GEOM_LOOP_2 : DO IG=1,N_GEOMETRY - IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE - DELBIN = GEOMETRY(IG)%TBAXIS(X1AXIS)%DELBIN - MIN_MESHGEOM = GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(1)%X1_LOW - ILO_BIN = MAX(1,CEILING((X1PLN-GEOMEPS-MIN_MESHGEOM)/DELBIN)) - IHI_BIN = MIN(GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS,CEILING((X1PLN+GEOMEPS-MIN_MESHGEOM)/DELBIN)) - IBIN_DO_2 : DO IBIN=ILO_BIN,IHI_BIN - IF ( X1PLN < GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE - IF ( X1PLN > GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE - ! Loop surface triangles: - DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL - IWSEL=GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(IWSELDUM) - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(MAX_DIM*(IWSEL-1)+1:MAX_DIM*IWSEL) - ! Triangles NODES coordinates: - DO INOD=NOD1,NOD3 - IF(.NOT.GEOMETRY(IG)%SNAP_NODE(X1AXIS,WSELEM(INOD))) CYCLE - ! Do test to snap to: - IF(ABS(GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+X1AXIS)-X1PLN) < SNAP_DIST_FACTOR*DX1FACE(X1IND) ) THEN - GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+X1AXIS) = X1PLN ! Set node position to plane value. - GEOMETRY(IG)%SNAP_NODE(X1AXIS,WSELEM(INOD)) = .FALSE. ! No need to snap again. - ENDIF - ENDDO - ENDDO - ENDDO IBIN_DO_2 - ENDDO MAIN_GEOM_LOOP_2 - ENDDO X1PLN_LOOP - - DEALLOCATE(X1FACE,DX1FACE) + ENDIF INS_INB_COND_3 - ENDDO AXIS_LOOP_2 - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -ENDDO MAIN_MESH_LOOP +END SELECT STAGE_FLG_BRANCH -! Deallocate SNAP_NODE in geometries: -DO IG=1,N_GEOMETRY - DEALLOCATE(GEOMETRY(IG)%SNAP_NODE) -ENDDO +END SUBROUTINE INIT_CFACE_CELL -IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN - WRITE(LU_ERR,'(A)',advance="no") '.. done.' - CALL CPU_TIME(CPUTIME) - WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken : ',CPUTIME-CPUTIME_START,' sec.' -ENDIF -END SUBROUTINE SNAP_GEOM_NODES +! --------------------- GET_REGULAR_CUT_EDGES_BC -------------------------------- -END SUBROUTINE SET_CUTCELLS_3D +SUBROUTINE GET_REGULAR_CUT_EDGES_BC(NM) +! This routine adds to FDS EDGE array +! the sum of regular edges that are boundary at least a neighboring CC_CUTCFE face and +! one CC_GASPHASE face. -SUBROUTINE CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) +USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_CELL,REALLOCATE_EDGE +INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: NM,ISTR,IEND,JSTR,JEND,KSTR,KEND -REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX +! Local variables: +INTEGER :: ECOUNT, CC_ECOUNT_RC, CC_ECOUNT_CE, CCOUNT, I, J, K, N_CC, N_RG, IE, IADD, JADD, KADD, IEC, N1, N2 +LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: CELL_ADDED +INTEGER :: ICMM,ICPM,ICPP,ICMP +INTEGER :: IDUM,IOR,IW1,IW2,CELL_COUNT_OLD +INTEGER, PARAMETER :: IAXIS_WALL_INDS(1:4) = (/ -3, -2, 2, 3 /) +INTEGER, PARAMETER :: JAXIS_WALL_INDS(1:4) = (/ -3, -1, 1, 3 /) +INTEGER, PARAMETER :: KAXIS_WALL_INDS(1:4) = (/ -2, -1, 1, 2 /) +LOGICAL :: DO_EDGE_FLG +TYPE(MESH_TYPE), POINTER :: M -! Initialize CC_IBM arrays for mesh NM: -! Vertices: -IF (.NOT. ALLOCATED(MESHES(NM)%VERTVAR)) & - ALLOCATE(MESHES(NM)%VERTVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NVVARS)) -MESHES(NM)%VERTVAR = 0 -MESHES(NM)%VERTVAR(:,:,:,CC_VGSC) = CC_GASPHASE +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +CHARACTER(100) :: MSEGS_FILE -! Cartesian Edges: -IF (.NOT. ALLOCATED(MESHES(NM)%ECVAR)) & - ALLOCATE(MESHES(NM)%ECVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NEVARS,MAX_DIM)) -MESHES(NM)%ECVAR = 0 -MESHES(NM)%ECVAR(:,:,:,CC_EGSC,:) = CC_GASPHASE +M => MESHES(NM) -! Cartesian Faces: -IF (.NOT. ALLOCATED(MESHES(NM)%FCVAR)) & - ALLOCATE(MESHES(NM)%FCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NFVARS,MAX_DIM)) -MESHES(NM)%FCVAR = 0 -MESHES(NM)%FCVAR(:,:,:,CC_FGSC,:) = CC_GASPHASE +IF (DEBUG_SET_CUTCELLS) THEN + ! Write out: + WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_rcsegs_mesh_',NM,'.dat' + OPEN(333,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') + CLOSE(333) +ENDIF -! Cartesian Cells: -IF (.NOT. ALLOCATED(MESHES(NM)%CCVAR)) & - ALLOCATE(MESHES(NM)%CCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NCVARS)) -MESHES(NM)%CCVAR = 0 -MESHES(NM)%CCVAR(:,:,:,CC_CGSC) = CC_GASPHASE +CALL POINT_TO_MESH(NM) -! When TERRAIN_CASE = TRUE, allocate GEOM_ZMAX for the mesh: -IF (TERRAIN_CASE) THEN - ALLOCATE(GEOM_ZMAX_AUX(ISTR:IEND,JSTR:JEND)) - GEOM_ZMAX_AUX = -1._EB/GEOMEPS -ENDIF +! Return if nothing to do for the mesh: +IF(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH == 0) RETURN -! Write mesh number allocation if GET_CUTCELLS_VERBOSE: IF (GET_CUTCELLS_VERBOSE) THEN - WRITE(LU_SETCC,'(A)') ' ' - WRITE(LU_SETCC,'(A,I5,A,I10)') ' Processing Mesh : ',NM - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A)') ' ' - WRITE(LU_ERR,'(A,I5,A,I10)') ' Processing Mesh : ',NM - ENDIF + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating REGULAR_CUTCELL_EDGES_BC for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating REGULAR_CUTCELL_EDGES_BC for mesh :',NM,' ..' ENDIF -! Here we have to allocate the size of MESHES(NM)%EDGE_CROSS: -MESHES(NM)%N_EDGE_CROSS = 0 ! Reset EDCROSS counter for mesh NM. -IF (ALLOCATED(MESHES(NM)%EDGE_CROSS)) DEALLOCATE(MESHES(NM)%EDGE_CROSS) -ALLOCATE(MESHES(NM)%EDGE_CROSS(GLOBAL_DELTA_EDGE)) - -! Here we have to allocate the size of MESHES(NM)%CUT_EDGE: -MESHES(NM)%N_CUTEDGE_MESH = 0 ! Reset CUTEDGE counter for mesh NM. -IF (ALLOCATED(MESHES(NM)%CUT_EDGE)) DEALLOCATE(MESHES(NM)%CUT_EDGE) -ALLOCATE(MESHES(NM)%CUT_EDGE(GLOBAL_DELTA_EDGE)) - -! Here we have to allocate the size of MESHES(NM)%CUT_FACE: -MESHES(NM)%N_CUTFACE_MESH = 0 ! Reset CUTFACE counter for mesh NM. -MESHES(NM)%N_BBCUTFACE_MESH = 0 -MESHES(NM)%N_GCCUTFACE_MESH = 0 -IF (ALLOCATED(MESHES(NM)%CUT_FACE)) DEALLOCATE(MESHES(NM)%CUT_FACE) -ALLOCATE(MESHES(NM)%CUT_FACE(GLOBAL_DELTA_FACE)) - -! Here we have to allocate the size of MESHES(NM)%CUT_CELL: -MESHES(NM)%N_CUTCELL_MESH = 0 ! Reset CUTCELL counter for mesh NM. -MESHES(NM)%N_GCCUTCELL_MESH = 0 -IF (ALLOCATED(MESHES(NM)%CUT_CELL)) DEALLOCATE(MESHES(NM)%CUT_CELL) -ALLOCATE(MESHES(NM)%CUT_CELL(GLOBAL_DELTA_CELL)) - -! Allocate array for special cells containing geometry intersections: -ALLOCATE(CELLRT(ISTR:IEND,JSTR:JEND,KSTR:KEND)) -CELLRT(:,:,:) = .FALSE. - -! List of special cells to block (either from GET_CARTCELL_CUTCELLS or -! cells flagged as polyline could not be built in GET_CARTCELL_CUTFACES): -ALLOCATE(SPCELLS_TO_BLOCK(1:GLOBAL_DELTA_CELL)) -N_SPCELLS_TO_BLOCK = 0 -MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 -IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) - -END SUBROUTINE CC_GRID_INIT_MESH_STORAGE +ALLOCATE(CELL_ADDED(0:IBP1,0:JBP1,0:KBP1)); CELL_ADDED = .FALSE. +! Now count added edge number for mesh N_EDGES_DIM_CC(2,NM), and added non zero cell indexes for mesh -SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) +ECOUNT = 0; CC_ECOUNT_RC=0; CC_ECOUNT_CE = 0; CCOUNT = 0; -INTEGER, INTENT(IN) :: NM -INTEGER, ALLOCATABLE, DIMENSION(:) :: SPCELLS_TO_BLOCK_TMP +! X axis edges: +DO K=0,KBAR + DO J=0,JBAR + IX_LOOP_1 : DO I=1,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in Y. + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO JADD=0,1 ! Faces aligned in Z. + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,IAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IX_LOOP_1 + DO_EDGE_FLG = .TRUE. + ELSE + CYCLE IX_LOOP_1 + ENDIF + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO KADD=0,1 + DO JADD=0,1 + IF(CELL_INDEX(I ,J+JADD,K+KADD)==0 .AND. .NOT.CELL_ADDED(I ,J+JADD,K+KADD)) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I ,J+JADD,K+KADD) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=IAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-2) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) + CASE( 2) + IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) + CASE(-3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 + ENDIF + ENDDO + ENDIF + IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE + ELSE + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE + ENDIF + ENDIF + ENDDO IX_LOOP_1 + ENDDO +ENDDO -MESHES(NM)%N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK -IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) - -IF (N_SPCELLS_TO_BLOCK < 1) THEN - IF (ALLOCATED(SPCELLS_TO_BLOCK)) DEALLOCATE(SPCELLS_TO_BLOCK) - RETURN -ENDIF - -IF (SIZE(SPCELLS_TO_BLOCK,DIM=1) > N_SPCELLS_TO_BLOCK) THEN - ALLOCATE(SPCELLS_TO_BLOCK_TMP(1:N_SPCELLS_TO_BLOCK)) - SPCELLS_TO_BLOCK_TMP(1:N_SPCELLS_TO_BLOCK) = SPCELLS_TO_BLOCK(1:N_SPCELLS_TO_BLOCK) - DEALLOCATE(SPCELLS_TO_BLOCK) - CALL MOVE_ALLOC(FROM=SPCELLS_TO_BLOCK_TMP,TO=MESHES(NM)%SPCELLS_TO_BLOCK) -ELSE - CALL MOVE_ALLOC(FROM=SPCELLS_TO_BLOCK,TO=MESHES(NM)%SPCELLS_TO_BLOCK) -ENDIF - -END SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK - - -SUBROUTINE CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) - -INTEGER, INTENT(IN) :: NM -REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX -INTEGER :: I,J - -! Case of terrain, populate GEOM_ZMAX: -IF (.NOT.TERRAIN_CASE) RETURN - -IF (ALLOCATED(MESHES(NM)%GEOM_ZMAX)) DEALLOCATE(MESHES(NM)%GEOM_ZMAX) -ALLOCATE(MESHES(NM)%GEOM_ZMAX(0:IBAR,0:JBAR)) -DO J=0,JBAR - DO I=0,IBAR - ! Clip at ZS-DZ(1): - MESHES(NM)%GEOM_ZMAX(I,J) = MAX(ZFACE(-1),GEOM_ZMAX_AUX(I,J)) +! Y axis edges: +DO K=0,KBAR + DO J=1,JBAR + IY_LOOP_1 : DO I=0,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in X. + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Z. + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,JAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IY_LOOP_1 + DO_EDGE_FLG = .TRUE. + ELSE + CYCLE IY_LOOP_1 + ENDIF + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO KADD=0,1 + DO IADD=0,1 + IF(CELL_INDEX(I+IADD,J ,K+KADD)==0 .AND. .NOT.CELL_ADDED(I+IADD,J ,K+KADD)) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I+IADD,J ,K+KADD) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=JAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) + CASE( 1) + IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) + CASE(-3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 + ENDIF + ENDDO + ENDIF + IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE + ELSE + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE + ENDIF + ENDIF + ENDDO IY_LOOP_1 ENDDO ENDDO -DEALLOCATE(GEOM_ZMAX_AUX) - -END SUBROUTINE CC_GRID_FINALIZE_TERRAIN - - -SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS(NM) - -INTEGER, INTENT(IN) :: NM -INTEGER :: ICC,ICC1,I,J,K -! Block SPCELLS, cells in cut-cell region where cut-cells could not be built: -IF (MESHES(NM)%N_SPCELLS_TO_BLOCK < 1 .OR. .NOT.ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) RETURN - -DO ICC=1,MESHES(NM)%N_SPCELLS_TO_BLOCK - I = MESHES(NM)%SPCELL_LIST(IAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) - J = MESHES(NM)%SPCELL_LIST(JAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) - K = MESHES(NM)%SPCELL_LIST(KAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) - ICC1 = MESHES(NM)%CCVAR(I,J,K,CC_IDCC) - IF (ICC1 > 0) THEN - CC => MESHES(NM)%CUT_CELL(ICC1) - CC%NOADVANCE(1:CC%NCELL) = BLOCKED_SPECIAL_CELL - ENDIF +! Z axis edges: +DO K=1,KBAR + DO J=0,JBAR + IZ_LOOP_1 : DO I=0,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO JADD=0,1 ! Faces aligned in X. + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Y. + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,KAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IZ_LOOP_1 + DO_EDGE_FLG = .TRUE. + ELSE + CYCLE IZ_LOOP_1 + ENDIF + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO JADD=0,1 + DO IADD=0,1 + IF(CELL_INDEX(I+IADD,J+JADD,K )==0 .AND. .NOT.CELL_ADDED(I+IADD,J+JADD,K )) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I+IADD,J+JADD,K ) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=KAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) + CASE( 1) + IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) + CASE(-2) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) + CASE( 2) + IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 + ENDIF + ENDDO + ENDIF + IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE + ELSE + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE + ENDIF + ENDIF + ENDDO IZ_LOOP_1 + ENDDO ENDDO -END SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS - - -SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) - -INTEGER, INTENT(IN) :: NM +IF (CC_ECOUNT_RC+CC_ECOUNT_CE==0) THEN + DEALLOCATE(CELL_ADDED) + RETURN +ENDIF -IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) -MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 +! Allocate CC_RCEDGE: +M%CC_NRCEDGE = CC_ECOUNT_RC +ALLOCATE(M%CC_RCEDGE(1:CC_ECOUNT_RC)) -END SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK +! Reallocate EDGE variables -! ----------------------- CHECK_WALL_CELL_PLANE_MATCH ---------------------------- +N1 = UBOUND(MESHES(NM)%EDGE,DIM=1) +N2 = EDGE_COUNT(NM) + ECOUNT +IF (ECOUNT>0 .AND. N2>N1) CALL REALLOCATE_EDGE(NM,N1,N2) -SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH +! Reallocate CELL variables -! Routine checks that external boundaries match among neighboring meshes. This is not strictly enforced -! by FDS but is required to compute same cut-cells on mesh ghost-cells and other mesh internal cells. +CELL_COUNT_OLD = CELL_COUNT(NM) +IF (CCOUNT > 0) CALL REALLOCATE_CELL(NM,CELL_COUNT(NM),CELL_COUNT(NM)+CCOUNT) +CCOUNT = CELL_COUNT_OLD -USE MPI_F08 +! Finally repeat search process and assign edge and cell values to cut-cell region entities: -! Local variables: -INTEGER :: NM,NOM,IW,IOR,IERR -REAL(EB):: XM,XOM,MSIZE -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BUFF -TYPE(WALL_TYPE), POINTER :: WC -TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC -TYPE(MESH_TYPE), POINTER :: M2 +CC_ECOUNT_RC=0; CC_ECOUNT_CE = 0 -ALLOCATE(BUFF(2,NMESHES)); BUFF=0 -MESH_LP : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - EXT_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS - WC=>WALL(IW); IF (WC%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY) CYCLE EXT_WALL_LOOP_1 - EWC=>EXTERNAL_WALL(IW) - BC =>BOUNDARY_COORD(WC%BC_INDEX) - IOR = BC%IOR; NOM = EWC%NOM; IF(NOM<1 .OR. NOM==NM) CYCLE EXT_WALL_LOOP_1 - M2 => MESHES(NOM) - SELECT CASE(IOR) - CASE( IAXIS); XM=X(0); XOM=M2%X(M2%IBAR); MSIZE=X(IBAR)-X(0) ! Low X for mesh NM, high X for mesh NOM - CASE(-IAXIS); XM=X(IBAR); XOM=M2%X(0) ; MSIZE=X(IBAR)-X(0) ! High X for mesh NM, low X for mesh NOM - CASE( JAXIS); XM=Y(0); XOM=M2%Y(M2%JBAR); MSIZE=Y(JBAR)-Y(0) ! Low Y for mesh NM, high Y for mesh NOM - CASE(-JAXIS); XM=Y(JBAR); XOM=M2%Y(0) ; MSIZE=Y(JBAR)-Y(0) ! High Y for mesh NM, low Y for mesh NOM - CASE( KAXIS); XM=Z(0); XOM=M2%Z(M2%KBAR); MSIZE=Z(KBAR)-Z(0) ! Low Z for mesh NM, high Z for mesh NOM - CASE(-KAXIS); XM=Z(KBAR); XOM=M2%Z(0) ; MSIZE=Z(KBAR)-Z(0) ! High Z for mesh NM, low Z for mesh NOM - END SELECT - IF(ABS(XM-XOM)>10._EB*GEOMEPS .AND. ABS(XM-XOM)<0.5_EB*MSIZE) THEN - BUFF(1:2,NM) = (/NM,NOM/) - CYCLE MESH_LP - ENDIF - ENDDO EXT_WALL_LOOP_1 -ENDDO MESH_LP - -! Now All-Reduce mismatch -CALL MPI_ALLREDUCE(MPI_IN_PLACE,BUFF(1,1),2*NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) - -DO NM=1,NMESHES - IF(BUFF(1,NM)>0) THEN ! First Mismatched meshes found. - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A,I5,A,I5,A)') "ERROR(734): Mismatched mesh boundary location between meshes ",BUFF(1,NM),& - " and ",BUFF(2,NM),". Check your mesh MULT line. Mesh boundary locations must strictly match with &GEOM." - ENDIF - DEALLOCATE(BUFF) - CALL SHUTDOWN("") ; RETURN - ENDIF -ENDDO -DEALLOCATE(BUFF) -END SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH - -! ----------------------- EXCHANGE_CC_NOADVANCE_INFO ---------------------------- - -SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO - - USE MPI_F08 - - ! Local Variables: - INTEGER :: NM,NOM,N,IERR,I,J,K,ICC,JCC - TYPE(MESH_TYPE), POINTER :: M - TYPE (MPI_REQUEST), ALLOCATABLE, DIMENSION(:) :: REQ0,REQ0DUM - INTEGER :: N_REQ0 - LOGICAL :: PROCESS_SENDREC - - ! Define cut-cells to be blocked for exchange: - DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - ! Count cut-cells for blocking in mesh: - M%N_CC_BLOCKED = 0 - DO ICC=1,MESHES(NM)%N_CUTCELL_MESH - CC => CUT_CELL(ICC) - DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)>0) M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 - ENDDO - ENDDO - IF (M%N_CC_BLOCKED>0) THEN - IF(ALLOCATED(M%XYZ_CC_BLOCKED)) DEALLOCATE(M%XYZ_CC_BLOCKED) - IF(ALLOCATED(M%JBT_CC_BLOCKED)) DEALLOCATE(M%JBT_CC_BLOCKED) - ALLOCATE(M%XYZ_CC_BLOCKED(3,M%N_CC_BLOCKED)) - ALLOCATE(M%JBT_CC_BLOCKED(2,M%N_CC_BLOCKED)) - ! Fill in blocked cut-cell info: - M%N_CC_BLOCKED = 0 - DO ICC=1,MESHES(NM)%N_CUTCELL_MESH - CC => CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)>0) THEN - M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 - M%XYZ_CC_BLOCKED(1:3,M%N_CC_BLOCKED) = (/XC(I),YC(J),ZC(K)/) - M%JBT_CC_BLOCKED(1:2,M%N_CC_BLOCKED) = (/JCC,CC%NOADVANCE(JCC)/) - ENDIF +! X axis edges: +DO K=0,KBAR + DO J=0,JBAR + IX_LOOP_2 : DO I=1,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in Y. + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 ENDDO - ENDDO - ENDIF - ENDDO - - ! MPI Exchange: - IF (N_MPI_PROCESSES>1) THEN - ALLOCATE(REQ0(NMESHES)); N_REQ0 = 0 - ! Exchange number of cut-cells information to be exchanged between MESH and OMESHES: - ! Receive from neighbors: - DO NM=1,NMESHES - DO NOM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - PROCESS_SENDREC = .FALSE. - DO N=1,MESHES(NM)%N_NEIGHBORING_MESHES - IF (NOM==MESHES(NM)%NEIGHBORING_MESH(N)) PROCESS_SENDREC = .TRUE. + DO JADD=0,1 ! Faces aligned in Z. + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 ENDDO - IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NM)/=MY_RANK .AND. PROCESS_SENDREC) THEN - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_IRECV(MESHES(NM)%N_CC_BLOCKED,1,MPI_INTEGER,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,IAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IX_LOOP_2 + DO_EDGE_FLG = .TRUE. + ELSE + CYCLE IX_LOOP_2 + ENDIF + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO KADD=0,1 + DO JADD=0,1 + IF(M%CELL_INDEX(I ,J+JADD,K+KADD)==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + M%CELL_INDEX(I ,J+JADD,K+KADD) = CCOUNT + M%CELL(CCOUNT)%I = I + M%CELL(CCOUNT)%J = J+JADD + M%CELL(CCOUNT)%K = K+KADD + ENDIF + ENDDO + ENDDO + ICMM = M%CELL_INDEX(I ,J ,K ) + ICPM = M%CELL_INDEX(I ,J+1,K ) + ICPP = M%CELL_INDEX(I ,J+1,K+1) + ICMP = M%CELL_INDEX(I ,J ,K+1) + M%EDGE(IE)%I = I + M%EDGE(IE)%J = J + M%EDGE(IE)%K = K + M%EDGE(IE)%AXIS = IAXIS + M%EDGE(IE)%CELL_INDEX_MM = ICMM + M%EDGE(IE)%CELL_INDEX_PM = ICPM + M%EDGE(IE)%CELL_INDEX_MP = ICMP + M%EDGE(IE)%CELL_INDEX_PP = ICPP + M%CELL(ICPP)%EDGE_INDEX(1) = IE + M%CELL(ICMP)%EDGE_INDEX(2) = IE + M%CELL(ICPM)%EDGE_INDEX(3) = IE + M%CELL(ICMM)%EDGE_INDEX(4) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=IAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-2) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) + CASE( 2) + IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) + CASE(-3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 + ENDIF + ENDDO ENDIF - ENDDO - ENDDO - ! Send to neighbors: - DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - DO NOM=1,NMESHES - PROCESS_SENDREC = .FALSE. - DO N=1,MESHES(NOM)%N_NEIGHBORING_MESHES - IF (NM==MESHES(NOM)%NEIGHBORING_MESH(N)) PROCESS_SENDREC = .TRUE. - ENDDO - IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NOM)/=MY_RANK .AND. PROCESS_SENDREC) THEN - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_ISEND(MESHES(NM)%N_CC_BLOCKED,1,MPI_INTEGER,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 + ! Add info to CC_RCEDGE: + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS + M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE + ! Note RCEDGE number in ECVAR: + M%ECVAR(I,J,K,CC_IDCE,IAXIS) = CC_ECOUNT_RC + ELSE ! CUT_EDGE: + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 + IEC = M%ECVAR(I,J,K,CC_IDCE,IAXIS) + M%CUT_EDGE(IEC)%IE = IE ENDIF - ENDDO - ENDDO - IF (N_REQ0>0) CALL MPI_WAITALL(N_REQ0,REQ0(1:N_REQ0),MPI_STATUSES_IGNORE,IERR) - - ! At this point values of MESHES(NM)%N_CC_BLOCKED are populated for PROCESSSED and NEIGNBORING meshes. - DO NM=1,NMESHES - IF (PROCESS(NM)==MY_RANK) CYCLE ! already done for this mesh at the beginning of the routine. - IF(MESHES(NM)%N_CC_BLOCKED>0) THEN - IF(ALLOCATED(MESHES(NM)%XYZ_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED) - IF(ALLOCATED(MESHES(NM)%JBT_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%JBT_CC_BLOCKED) - ALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED(3,MESHES(NM)%N_CC_BLOCKED)) - ALLOCATE(MESHES(NM)%JBT_CC_BLOCKED(2,MESHES(NM)%N_CC_BLOCKED)) ENDIF - ENDDO + ENDDO IX_LOOP_2 + ENDDO +ENDDO - ! Exchange blocked cutcells lists: - ! Receive from neighbors: - N_REQ0 = 0 - DO NM=1,NMESHES - DO NOM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - PROCESS_SENDREC = .FALSE. - DO N=1,MESHES(NM)%N_NEIGHBORING_MESHES - IF (NOM==MESHES(NM)%NEIGHBORING_MESH(N) .AND. MESHES(NM)%N_CC_BLOCKED>0) PROCESS_SENDREC=.TRUE. +! Y axis edges: +DO K=0,KBAR + DO J=1,JBAR + IY_LOOP_2 : DO I=0,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in X. + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 ENDDO - IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NM)/=MY_RANK .AND. PROCESS_SENDREC) THEN - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_IRECV(MESHES(NM)%XYZ_CC_BLOCKED(1,1),3*MESHES(NM)%N_CC_BLOCKED,& - MPI_DOUBLE_PRECISION,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_IRECV(MESHES(NM)%JBT_CC_BLOCKED(1,1),2*MESHES(NM)%N_CC_BLOCKED,& - MPI_INTEGER,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) - ENDIF - ENDDO - ENDDO - ! Send to neighbors: - DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - DO NOM=1,NMESHES - PROCESS_SENDREC = .FALSE. - DO N=1,MESHES(NOM)%N_NEIGHBORING_MESHES - IF (NM==MESHES(NOM)%NEIGHBORING_MESH(N) .AND. MESHES(NM)%N_CC_BLOCKED>0) PROCESS_SENDREC=.TRUE. + DO IADD=0,1 ! Faces aligned in Z. + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 ENDDO - IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NOM)/=MY_RANK .AND. PROCESS_SENDREC) THEN - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_ISEND(MESHES(NM)%XYZ_CC_BLOCKED(1,1),3*MESHES(NM)%N_CC_BLOCKED,& - MPI_DOUBLE_PRECISION,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_ISEND(MESHES(NM)%JBT_CC_BLOCKED(1,1),2*MESHES(NM)%N_CC_BLOCKED,& - MPI_INTEGER,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) - ENDIF - ENDDO - ENDDO - IF (N_REQ0>0) CALL MPI_WAITALL(N_REQ0,REQ0(1:N_REQ0),MPI_STATUSES_IGNORE,IERR) - - ! Deallocate REQ0: - IF(ALLOCATED(REQ0)) DEALLOCATE(REQ0) - ENDIF + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,JAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IY_LOOP_2 + DO_EDGE_FLG = .TRUE. + ELSE + CYCLE IY_LOOP_2 + ENDIF + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO KADD=0,1 + DO IADD=0,1 + IF(M%CELL_INDEX(I+IADD,J ,K+KADD)==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + M%CELL_INDEX(I+IADD,J ,K+KADD) = CCOUNT + M%CELL(CCOUNT)%I = I+IADD + M%CELL(CCOUNT)%J = J + M%CELL(CCOUNT)%K = K+KADD + ENDIF + ENDDO + ENDDO + ICMM = M%CELL_INDEX(I ,J ,K ) + ICMP = M%CELL_INDEX(I+1,J ,K ) + ICPP = M%CELL_INDEX(I+1,J ,K+1) + ICPM = M%CELL_INDEX(I ,J ,K+1) + M%EDGE(IE)%I = I + M%EDGE(IE)%J = J + M%EDGE(IE)%K = K + M%EDGE(IE)%AXIS = JAXIS + M%EDGE(IE)%CELL_INDEX_MM = ICMM + M%EDGE(IE)%CELL_INDEX_PM = ICPM + M%EDGE(IE)%CELL_INDEX_MP = ICMP + M%EDGE(IE)%CELL_INDEX_PP = ICPP + M%CELL(ICPP)%EDGE_INDEX(5) = IE + M%CELL(ICPM)%EDGE_INDEX(6) = IE + M%CELL(ICMP)%EDGE_INDEX(7) = IE + M%CELL(ICMM)%EDGE_INDEX(8) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=JAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) + CASE( 1) + IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) + CASE(-3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 + ENDIF + ENDDO + ENDIF + IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 + ! Add info to CC_RCEDGE: + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS + M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE + ! Note RCEDGE number in ECVAR: + M%ECVAR(I,J,K,CC_IDCE,JAXIS) = CC_ECOUNT_RC + ELSE ! CUT_EDGE: + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 + IEC = M%ECVAR(I,J,K,CC_IDCE,JAXIS) + M%CUT_EDGE(IEC)%IE = IE + ENDIF + ENDIF + ENDDO IY_LOOP_2 + ENDDO +ENDDO - CONTAINS - SUBROUTINE CHECK_REQ0_SIZE - IF(N_REQ0>SIZE(REQ0,DIM=1)) THEN - ALLOCATE(REQ0DUM(SIZE(REQ0,DIM=1)+NMESHES)) - REQ0DUM(1:N_REQ0-1) = REQ0(1:N_REQ0-1) - CALL MOVE_ALLOC(REQ0DUM,REQ0) - ENDIF - END SUBROUTINE CHECK_REQ0_SIZE +! Z axis edges: +DO K=1,KBAR + DO J=0,JBAR + IZ_LOOP_2 : DO I=0,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO JADD=0,1 ! Faces aligned in X. + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Y. + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,KAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IZ_LOOP_2 + DO_EDGE_FLG = .TRUE. + ELSE + CYCLE IZ_LOOP_2 + ENDIF + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO JADD=0,1 + DO IADD=0,1 + IF(M%CELL_INDEX(I+IADD,J+JADD,K )==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + M%CELL_INDEX(I+IADD,J+JADD,K ) = CCOUNT + M%CELL(CCOUNT)%I = I+IADD + M%CELL(CCOUNT)%J = J+JADD + M%CELL(CCOUNT)%K = K + ENDIF + ENDDO + ENDDO + ICMM = M%CELL_INDEX(I ,J ,K ) + ICPM = M%CELL_INDEX(I+1,J ,K ) + ICPP = M%CELL_INDEX(I+1,J+1,K ) + ICMP = M%CELL_INDEX(I ,J+1,K ) + M%EDGE(IE)%I = I + M%EDGE(IE)%J = J + M%EDGE(IE)%K = K + M%EDGE(IE)%AXIS = KAXIS + M%EDGE(IE)%CELL_INDEX_MM = ICMM + M%EDGE(IE)%CELL_INDEX_PM = ICPM + M%EDGE(IE)%CELL_INDEX_MP = ICMP + M%EDGE(IE)%CELL_INDEX_PP = ICPP + M%CELL(ICPP)%EDGE_INDEX( 9) = IE + M%CELL(ICMP)%EDGE_INDEX(10) = IE + M%CELL(ICPM)%EDGE_INDEX(11) = IE + M%CELL(ICMM)%EDGE_INDEX(12) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=KAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) + CASE( 1) + IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) + CASE(-2) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) + CASE( 2) + IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 + ENDIF + ENDDO + ENDIF + IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 + ! Add info to CC_RCEDGE: + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS + M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE + ! Note RCEDGE number in ECVAR: + M%ECVAR(I,J,K,CC_IDCE,KAXIS) = CC_ECOUNT_RC + ELSE ! CUT_EDGE: + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 + IEC = M%ECVAR(I,J,K,CC_IDCE,KAXIS) + M%CUT_EDGE(IEC)%IE = IE + ENDIF + ENDIF + ENDDO IZ_LOOP_2 + ENDDO +ENDDO - END SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO +DEALLOCATE(CELL_ADDED) -! ----------------------- BLOCK_SMALL_UNLINKED_CUTCELLS ---------------------------- +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + WRITE(LU_SETCC,'(A,F8.3,A,7I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Reg-CC edges for BC : ',CC_ECOUNT_RC,M%CC_NRCEDGE,CC_ECOUNT_CE, & + EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A,7I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Reg-CC edges for BC : ',CC_ECOUNT_RC,M%CC_NRCEDGE,CC_ECOUNT_CE, & + EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' + ENDIF + ! DO I=1,M%CC_NRCEDGE + ! WRITE(LU_ERR,*) 'IE,I,J,K,IAXIS=',M%CC_RCEDGE(I)%IE,M%CC_RCEDGE(I)%IJK(IAXIS:KAXIS+1) + ! ENDDO +ENDIF -SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS(NM,NBLKCELLS) +IF (DEBUG_SET_CUTCELLS) THEN + ! Write segment information for the mesh if it belongs to the process: + ! Write out: + WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_rcsegs_mesh_',NM,'.dat' + LU_DB_SETCC = GET_FILE_NUMBER() + OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') + !WRITE(LU_ERR,*) TRIM(MSEGS_FILE),M%CC_NRCEDGE,CC_ECOUNT_RC + DO ECOUNT=1,M%CC_NRCEDGE + I=M%CC_RCEDGE(ECOUNT)%IJK(IAXIS) + J=M%CC_RCEDGE(ECOUNT)%IJK(JAXIS) + K=M%CC_RCEDGE(ECOUNT)%IJK(KAXIS) + IE=M%CC_RCEDGE(ECOUNT)%IJK(KAXIS+1) + SELECT CASE(IE) + CASE(IAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DX(I),XC(I),Y(J),Z(K) + CASE(JAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DY(J),X(I),YC(J),Z(K) + CASE(KAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DZ(K),X(I),Y(J),ZC(K) + END SELECT + ENDDO + CLOSE(LU_DB_SETCC) +ENDIF -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(OUT):: NBLKCELLS +RETURN +END SUBROUTINE GET_REGULAR_CUT_EDGES_BC -INTEGER :: ICC,JCC,I,J,K,IFC,IEC,JEC,IVR,DUM,NSEG,ISEG,JFC,INOD1,INOD2,X1AXIS,COUNT,NCELL -TYPE(MESH_TYPE), POINTER :: M -CHARACTER(100) :: FILENAME -M => MESHES(NM) -NBLKCELLS = 0 +! --------------------- GET_SOLID_CUTCELL_EDGES_BC -------------------------------- -IF(DEBUG_SET_CUTCELLS) THEN +SUBROUTINE GET_SOLID_CUTCELL_EDGES_BC(NM) - ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges1.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH - DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH - CE=>MESHES(NM)%CUT_EDGE(IEC) - WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) - DO IVR=1,CE%NVERT - WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO IVR=1,CE%NVERT - WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& - CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) - ENDDO - ENDDO - CLOSE(33) +! This routine adds to FDS EDGE array +! the sum of regular edges that are boundary at least a neighboring CC_CUTCFE face and +! one CC_SOLID face. - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces1.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH - DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 - IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 - WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) - DO IVR=1,CF%NVERT - WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(I6,I6)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) - DO DUM=1,CF%CFELEM(1,JFC) - WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) - ENDDO - DO DUM=1,CF%CEDGES(1,JFC) - WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) - ENDDO - ENDDO - DO ISEG=1,NSEG - WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) - ENDDO - ENDDO - CLOSE(33) -ENDIF +USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_CELL,REALLOCATE_EDGE +INTEGER, INTENT(IN) :: NM -! Create new cut-edges and faces: -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - JCC_LOOP : DO JCC=1,M%CUT_CELL(ICC)%NCELL - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP - NBLKCELLS = NBLKCELLS + 1 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,1) - ENDDO JCC_LOOP - ENDDO - ENDDO -ENDDO +! Local variables: +INTEGER :: ECOUNT, CC_ECOUNT, CCOUNT, I, J, K, N_CC, N_RG, IE, IADD, JADD, KADD, CELL_COUNT_OLD, N1, N2 +LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: CELL_ADDED +INTEGER :: ICMM,ICPM,ICPP,ICMP +INTEGER :: IDUM,IOR,IW1,IW2 +INTEGER, PARAMETER :: IAXIS_WALL_INDS(1:4) = (/ -3, -2, 2, 3 /) +INTEGER, PARAMETER :: JAXIS_WALL_INDS(1:4) = (/ -3, -1, 1, 3 /) +INTEGER, PARAMETER :: KAXIS_WALL_INDS(1:4) = (/ -2, -1, 1, 2 /) +INTEGER :: IN1,IN2,JN1,JN2,KN1,KN2 +LOGICAL :: INI,INJ,INK,INMESH -! Drop cut-edges and faces that were gas or boundary of blocked cells. -COUNT=0 -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - NCELL = M%CUT_CELL(ICC)%NCELL - JCC_LOOP_2 : DO JCC=1,NCELL - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_2 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,2) - ENDDO JCC_LOOP_2 - ENDDO - ENDDO -ENDDO +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +CHARACTER(100) :: MSEGS_FILE -! Drop blocked cells: -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - NCELL = M%CUT_CELL(ICC)%NCELL - JCC_LOOP_3 : DO JCC=NCELL,1,-1 - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_3 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,3) - ENDDO JCC_LOOP_3 - ENDDO - ENDDO -ENDDO -! Build remaining Regular shaped GASPHASE cut-faces: -CALL GET_REMAINING_CUTFACES(NM) -! Build remaining Regular shaped GASPHASE cut-cells: -CALL GET_REMAINING_CUTCELLS(NM) -! Clean up CUT_CELL, CUT_FACE arrays: -CALL CUT_CELL_FACE_ARRAYS_CLEANUP(NM) +IF (DEBUG_SET_CUTCELLS) THEN + ! Write out: + WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_ibsegs_mesh_',NM,'.dat' + LU_DB_SETCC = GET_FILE_NUMBER() + OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') + CLOSE(LU_DB_SETCC) +ENDIF -IF(DEBUG_SET_CUTCELLS) THEN - ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges2.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH - DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH - CE=>MESHES(NM)%CUT_EDGE(IEC) - WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) - DO IVR=1,CE%NVERT - WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO IVR=1,CE%NVERT - WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& - CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) - ENDDO - ENDDO - CLOSE(33) +CALL POINT_TO_MESH(NM) - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces2.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH - DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 - IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 - WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) - DO IVR=1,CF%NVERT - WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(I8,I8)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) - DO DUM=1,CF%CFELEM(1,JFC) - WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) - ENDDO - DO DUM=1,CF%CEDGES(1,JFC) - WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) - ENDDO - ENDDO - DO ISEG=1,NSEG - WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) - ENDDO - ENDDO - CLOSE(33) +! Return if nothing to do for the mesh: +IF(MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH == 0) RETURN - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeECVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%ECVAR(I,J,K,CC_EGSC,IAXIS),& - M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) - DO X1AXIS=IAXIS,KAXIS - IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN - IEC=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) - IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT EDGE does not match ECVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE - DO JEC=1,CE%NEDGE - INOD1=CE%CEELEM(NOD1,JEC) - INOD2=CE%CEELEM(NOD2,JEC) - WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) - WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) - IF(CE%VERT_LIST(1,INOD1)==CE%VERT_LIST(1,INOD2) .AND. & - CE%VERT_LIST(2,INOD1)==CE%VERT_LIST(2,INOD2) .AND. & - CE%VERT_LIST(3,INOD1)==CE%VERT_LIST(3,INOD2) .AND. & - CE%VERT_LIST(4,INOD1)==CE%VERT_LIST(4,INOD2)) THEN - IF(CE%VERT_LIST(1,INOD1)/=CC_VTYPE_NINB) & - WRITE(LU_ERR,*) 'Edge with same node types=',IEC,JEC,CE%NEDGE,CE%XYZVERT(:,INOD1),& - CE%XYZVERT(:,INOD2),CE%VERT_LIST(1:4,INOD1) - ENDIF - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating SOLID_CUTCELL_EDGES_BC for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating SOLID_CUTCELL_EDGES_BC for mesh :',NM,' ..' +ENDIF - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - DO X1AXIS=IAXIS,KAXIS - IF(M%FCVAR(I,J,K,CC_IDCE,X1AXIS)>0)THEN - IEC=M%FCVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) - IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT EDGE does not match FCVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE - DO JEC=1,CE%NEDGE - INOD1=CE%CEELEM(NOD1,JEC) - INOD2=CE%CEELEM(NOD2,JEC) - WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) - WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) +ALLOCATE(CELL_ADDED(0:IBP1,0:JBP1,0:KBP1)); CELL_ADDED = .FALSE. +! Now count added edge number for EDGE and CELL - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaceFCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%FCVAR(I,J,K,CC_FGSC,IAXIS),& - M%FCVAR(I,J,K,CC_FGSC,JAXIS),M%FCVAR(I,J,K,CC_FGSC,KAXIS) - DO X1AXIS=IAXIS,KAXIS - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)==CC_CUTCFE)THEN - IEC=M%FCVAR(I,J,K,CC_IDCF,X1AXIS); CF=>M%CUT_FACE(IEC) - IF(CF%IJK(IAXIS)/=I .OR. CF%IJK(JAXIS)/=J .OR. CF%IJK(KAXIS)/=K .OR. CF%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT FACE does not match FCVAR',I,J,K,X1AXIS,':',CF%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE - DO JEC=1,CF%NFACE - WRITE(33,'(I8,3F16.8,F16.8)') CF%IJK(4),CF%XYZCEN(:,JEC),CF%AREA(JEC) - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) +ECOUNT = 0; CC_ECOUNT=0 +CCOUNT = 0; - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutcellCCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8)') I,J,K,M%CCVAR(I,J,K,CC_CGSC) - IF(M%CCVAR(I,J,K,CC_CGSC)==CC_CUTCFE)THEN - IEC=M%CCVAR(I,J,K,CC_IDCC); CC=>M%CUT_CELL(IEC) - IF(CC%IJK(IAXIS)/=I .OR. CC%IJK(JAXIS)/=J .OR. CC%IJK(KAXIS)/=K) & - WRITE(LU_ERR,*) 'CUT CELL does not match CCVAR',I,J,K,':',CC%IJK(IAXIS:KAXIS) - WRITE(33,'(I8,I8,I8,I8,I8)') CC%IJK(1:3),CC%NCELL - DO JEC=1,CC%NCELL - WRITE(33,'(I8,3F16.8,F16.8)') JEC,CC%XYZCEN(:,JEC),CC%VOLUME(JEC) - ENDDO - ENDIF +! X axis edges: +DO K=0,KBAR + INK = .FALSE. + KN1 = K; KN2 = K+1 + IF (K==0) THEN; KN1=K+1 + ELSEIF(K==KBAR) THEN; KN2=K + ELSE + INK = .TRUE. + ENDIF + DO J=0,JBAR + INJ = .FALSE. + JN1 = J; JN2 = J+1 + IF (J==0) THEN; JN1=J+1 + ELSEIF(J==JBAR) THEN; JN2=J + ELSE + INJ = .TRUE. + ENDIF + INMESH = INK .AND. INJ + IX_LOOP_1 : DO I=1,IBAR + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,IAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in Y. + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 ENDDO - ENDDO - ENDDO - CLOSE(33) -ENDIF - -RETURN -END SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS - -! ------------------------- GET_REMAINING_CUTCELLS -------------------------------- - -SUBROUTINE GET_REMAINING_CUTCELLS(NM) - -! Define regular cut-cells for regular cartesian cells surrounded by a gas cut-face. -INTEGER, INTENT(IN) :: NM - -! Local Variables: -INTEGER :: I,J,K,CT,X1AXIS,SIDE,ICC,JCC,IFACE,ICF,JCF,ICFC,ICFINB,NCFACE_CUTCELL,NCELL,NFACE_CELL -INTEGER :: NCC_MESH,NGC_MESH,NCELL_IN,NCELL_GC,COUNT_CC,COUNT_GC -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME -INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX -LOGICAL, PARAMETER :: OPT=.TRUE. - -M => MESHES(NM) - -! First thing is, for known cut-cells with reg faces that have changed to cut-faces to change the -! FACE_LIST incidence: -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_CUTCFE) CYCLE - ICC=M%CCVAR(I,J,K,CC_IDCC) - CC=>M%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - DO ICF=2,CC%CCELEM(1,JCC)+1 - IFACE = CC%CCELEM(ICF,JCC) - SIDE = CC%FACE_LIST(2,IFACE) - X1AXIS= CC%FACE_LIST(3,IFACE) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE - ICFC = M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS) - IF(ICFC>0) CC%FACE_LIST(:,IFACE) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) ! New cut-face. - ENDDO + DO JADD=0,1 ! Faces aligned in Z. + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 ENDDO - ENDDO + ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(I,JN1:JN2,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. + ENDIF + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-face, and a solid face. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO KADD=0,1 + DO JADD=0,1 + IF(CELL_INDEX(I ,J+JADD,K+KADD)==0 .AND. .NOT.CELL_ADDED(I ,J+JADD,K+KADD)) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I ,J+JADD,K+KADD) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=IAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K ))%WALL_INDEX( 2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K+1))%WALL_INDEX( 2) + CASE( 2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K ))%WALL_INDEX(-2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K+1))%WALL_INDEX(-2) + CASE(-3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K ))%WALL_INDEX( 3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K+1))%WALL_INDEX(-3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 + ENDIF + ENDDO + ENDIF + CC_ECOUNT = CC_ECOUNT + 1 + ENDIF + ENDDO IX_LOOP_1 ENDDO ENDDO -IF (OPT) THEN - -NCC_MESH = M%N_CUTCELL_MESH -NGC_MESH = M%N_GCCUTCELL_MESH - -! First count how many new cells are goint to be created inside, and in ghost cell region: -NCELL_IN=0 -NCELL_GC=0 -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE - ! Test for gas cut-faces: - CT=0 - IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - IF(K<1 .OR. K>M%KBAR .OR. J<1 .OR. J>M%JBAR .OR. I<1 .OR. I>M%IBAR) THEN - NCELL_GC = NCELL_GC + 1 +! Y axis edges: +DO K=0,KBAR + INK = .FALSE. + KN1 = K; KN2 = K+1 + IF (K==0) THEN; KN1=K+1 + ELSEIF(K==KBAR) THEN; KN2=K + ELSE + INK = .TRUE. + ENDIF + DO J=1,JBAR + IY_LOOP_1 : DO I=0,IBAR + INI = .FALSE. + IN1 = I; IN2 = I+1 + IF (I==0) THEN; IN1=I+1 + ELSEIF(I==IBAR) THEN; IN2=I ELSE - NCELL_IN = NCELL_IN + 1 + INI = .TRUE. ENDIF - ENDDO + INMESH = INK .AND. INI + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,JAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in X. + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Z. + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,J,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. + ENDIF + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO KADD=0,1 + DO IADD=0,1 + IF(CELL_INDEX(I+IADD,J ,K+KADD)==0 .AND. .NOT.CELL_ADDED(I+IADD,J ,K+KADD)) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I+IADD,J ,K+KADD) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=JAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) + CASE( 1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) + CASE(-3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 + ENDIF + ENDDO + ENDIF + CC_ECOUNT = CC_ECOUNT + 1 + ENDIF + ENDDO IY_LOOP_1 ENDDO ENDDO -! Reset CCVAR, CELL_LIST indexes: -DO K=-CCGUARD,M%KBAR+CCGUARD - DO J=-CCGUARD,M%JBAR+CCGUARD - DO I=-CCGUARD,M%IBAR+CCGUARD - ! All GC cut-cells get their index + NCELL_IN - IF(M%CCVAR(I,J,K,CC_IDCC)<=NCC_MESH) CYCLE - M%CCVAR(I,J,K,CC_IDCC)=M%CCVAR(I,J,K,CC_IDCC) + NCELL_IN - ENDDO - ENDDO -ENDDO -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - DO JCF=1,M%CUT_FACE(ICF)%NFACE - IF(M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>NCC_MESH) & - M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + NCELL_IN - IF(M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>NCC_MESH) & - M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + NCELL_IN - ENDDO -ENDDO - -! Make space for NCELL_IN, NCELL_GC cut-cell entries. -ALLOCATE(CUT_CELL_AUX( MAX(SIZE(M%CUT_CELL,DIM=1),NCC_MESH + NCELL_IN +NGC_MESH + NCELL_GC) )) -CUT_CELL_AUX(1:NCC_MESH) = M%CUT_CELL(1:NCC_MESH) -CUT_CELL_AUX(NCC_MESH+NCELL_IN+1:NCC_MESH+NCELL_IN+NGC_MESH) = M%CUT_CELL(NCC_MESH+1:NCC_MESH+NGC_MESH) -CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL); M=> MESHES(NM) - -! Then build new regular cut-cells: -COUNT_CC = 0 -COUNT_GC = 0 -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE - ! Test for gas cut-faces: - CT=0 - IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - - ! Count allocation number for faces boundary of this cut-cell: - CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO X1AXIS=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO - - ! Add INB cut-face if any present: - IF(ICFINB>0) THEN - DO JCF=1,M%CUT_FACE(ICFINB)%NFACE - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDDO - ENDIF - - ! Insert cut_cell: - IF(K<1 .OR. K>MESHES(NM)%KBAR .OR. J<1 .OR. J>MESHES(NM)%JBAR .OR. I<1 .OR. I>MESHES(NM)%IBAR) THEN - COUNT_GC = COUNT_GC + 1 - ICC = NCC_MESH + NCELL_IN + NGC_MESH + COUNT_GC +! Z axis edges: +DO K=1,KBAR + DO J=0,JBAR + INJ = .FALSE. + JN1 = J; JN2 = J+1 + IF (J==0) THEN; JN1=J+1 + ELSEIF(J==JBAR) THEN; JN2=J + ELSE + INJ = .TRUE. + ENDIF + IZ_LOOP_1 : DO I=0,IBAR + INI = .FALSE. + IN1 = I; IN2 = I+1 + IF (I==0) THEN; IN1=I+1 + ELSEIF(I==IBAR) THEN; IN2=I ELSE - COUNT_CC = COUNT_CC + 1 - ICC = NCC_MESH + COUNT_CC + INI = .TRUE. ENDIF - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - M%CUT_CELL(ICC)%NFACE_DROPPED = 0 - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) - M%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) - M%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE - M%CCVAR(I,J,K,CC_IDCC) = ICC - ENDDO - ENDDO -ENDDO - -M%N_CUTCELL_MESH = NCC_MESH + NCELL_IN -M%N_GCCUTCELL_MESH = NGC_MESH + NCELL_GC - -ELSE - -! Then build new regular cut-cells: -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE - ! Test for gas cut-faces: - CT=0 - IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - - ! Count allocation number for faces boundary of this cut-cell: - CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO X1AXIS=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO + INMESH = INJ .AND. INI + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,KAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO JADD=0,1 ! Faces aligned in X. + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 ENDDO - - ! Add INB cut-face if any present: - IF(ICFINB>0) THEN - DO JCF=1,M%CUT_FACE(ICFINB)%NFACE - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDDO + DO IADD=0,1 ! Faces aligned in Y. + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,JN1:JN2,K,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. ENDIF - - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NM,I,J,K,ICC); M => MESHES(NM) - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) - ENDDO + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO JADD=0,1 + DO IADD=0,1 + IF(CELL_INDEX(I+IADD,J+JADD,K )==0 .AND. .NOT.CELL_ADDED(I+IADD,J+JADD,K )) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I+IADD,J+JADD,K ) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=KAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) + CASE( 1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) + CASE(-2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) + CASE( 2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 + ENDIF + ENDDO + ENDIF + CC_ECOUNT = CC_ECOUNT + 1 + ENDIF + ENDDO IZ_LOOP_1 ENDDO ENDDO +IF (CC_ECOUNT==0) THEN + DEALLOCATE(CELL_ADDED) + RETURN ENDIF -END SUBROUTINE GET_REMAINING_CUTCELLS - +! Allocate CC_IBEDGE: +MESHES(NM)%CC_NIBEDGE = CC_ECOUNT +ALLOCATE(MESHES(NM)%CC_IBEDGE(1:CC_ECOUNT)) -! ------------------------- GET_REMAINING_CUTFACES -------------------------------- +! Reallocate EDGE variables -SUBROUTINE GET_REMAINING_CUTFACES(NM) +N1 = UBOUND(MESHES(NM)%EDGE,DIM=1) +N2 = EDGE_COUNT(NM) + ECOUNT +IF (ECOUNT>0 .AND. N2>N1) CALL REALLOCATE_EDGE(NM,N1,N2) -! Running by axes define regular cut-faces, add to CUT_FACE array. +! Reallocate derived type array CELL which contains SOLID, OBST_INDEX, WALL_INDEX, EDGE_INDEX, EXTERIOR, I, J, K: -INTEGER, INTENT(IN) :: NM +CELL_COUNT_OLD = CELL_COUNT(NM) +IF (CCOUNT > 0) CALL REALLOCATE_CELL(NM,CELL_COUNT(NM),CELL_COUNT(NM)+CCOUNT) +CCOUNT = CELL_COUNT_OLD -! Local Variables: -INTEGER :: I,J,K,CT,X1AXIS,X2AXIS,X3AXIS,IFC,CEI,CEIF,ICC,JCC,ICE,IEDGE,ILOC,IFACE -INTEGER :: NBD_MESH,NCF_MESH,NGF_MESH,NFC_BND,NFC_MSH,NFC_GCR,CT_BND,CT_MSH,CT_GCR,FCINDEX -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES,EDGE_LIST -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZVERT,XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA -TYPE(MESH_TYPE), POINTER :: M -LOGICAL, PARAMETER :: OPT=.TRUE. +! Finally repeat search process and assign edge and cell values to cut-cell region entities: -M => MESHES(NM) +CC_ECOUNT=0 -IF (OPT) THEN +! X axis edges: +DO K=0,KBAR + INK = .FALSE. + KN1 = K; KN2 = K+1 + IF (K==0) THEN; KN1=K+1 + ELSEIF(K==KBAR) THEN; KN2=K + ELSE + INK = .TRUE. + ENDIF + DO J=0,JBAR + INJ = .FALSE. + JN1 = J; JN2 = J+1 + IF (J==0) THEN; JN1=J+1 + ELSEIF(J==JBAR) THEN; JN2=J + ELSE + INJ = .TRUE. + ENDIF + INMESH = INK .AND. INJ + IX_LOOP_2 : DO I=1,IBAR + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,IAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in Y. + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + DO JADD=0,1 ! Faces aligned in Z. + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(I,JN1:JN2,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. + ENDIF + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells, NEW edge to force. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO KADD=0,1 + DO JADD=0,1 + IF(MESHES(NM)%CELL_INDEX(I ,J+JADD,K+KADD)==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + MESHES(NM)%CELL_INDEX(I ,J+JADD,K+KADD) = CCOUNT + MESHES(NM)%CELL(CCOUNT)%I = I + MESHES(NM)%CELL(CCOUNT)%J = J+JADD + MESHES(NM)%CELL(CCOUNT)%K = K+KADD + ENDIF + ENDDO + ENDDO + ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) + ICPM = MESHES(NM)%CELL_INDEX(I ,J+1,K ) + ICPP = MESHES(NM)%CELL_INDEX(I ,J+1,K+1) + ICMP = MESHES(NM)%CELL_INDEX(I ,J ,K+1) + MESHES(NM)%EDGE(IE)%I = I + MESHES(NM)%EDGE(IE)%J = J + MESHES(NM)%EDGE(IE)%K = K + MESHES(NM)%EDGE(IE)%AXIS = IAXIS + MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM + MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM + MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP + MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP + MESHES(NM)%CELL(ICPP)%EDGE_INDEX(1) = IE + MESHES(NM)%CELL(ICMP)%EDGE_INDEX(2) = IE + MESHES(NM)%CELL(ICPM)%EDGE_INDEX(3) = IE + MESHES(NM)%CELL(ICMM)%EDGE_INDEX(4) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=IAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) + CASE( 2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) + CASE(-3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 + ENDIF + ENDDO + ENDIF -NBD_MESH = M%N_BBCUTFACE_MESH -NCF_MESH = M%N_CUTFACE_MESH -NGF_MESH = M%N_GCCUTFACE_MESH + CC_ECOUNT = CC_ECOUNT + 1 + + ! Add info to CC_IBEDGE: + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE -! First count EXT Boundary, In meshm and ghost cell region cut-faces: -NFC_BND = 0 -NFC_MSH = 0 -NFC_GCR = 0 -! IAXIS cut-faces: -X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-2,M%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%IBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External - ELSEIF(I==0 .OR. I==M%IBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary - ENDIF - ELSE; NFC_GCR = NFC_GCR + 1 ! External ENDIF - ENDDO + ENDDO IX_LOOP_2 ENDDO ENDDO -! JAXIS cut-faces: -X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS -DO K=-1,M%KBAR+2 - DO J=-2,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%JBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External - ELSEIF(J==0 .OR. J==M%JBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary + +! Y axis edges: +DO K=0,KBAR + INK = .FALSE. + KN1 = K; KN2 = K+1 + IF (K==0) THEN; KN1=K+1 + ELSEIF(K==KBAR) THEN; KN2=K + ELSE + INK = .TRUE. + ENDIF + DO J=1,JBAR + IY_LOOP_2 : DO I=0,IBAR + INI = .FALSE. + IN1 = I; IN2 = I+1 + IF (I==0) THEN; IN1=I+1 + ELSEIF(I==IBAR) THEN; IN2=I + ELSE + INI = .TRUE. + ENDIF + INMESH = INK .AND. INI + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,JAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in X. + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Z. + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,J,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. + ENDIF + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO KADD=0,1 + DO IADD=0,1 + IF(MESHES(NM)%CELL_INDEX(I+IADD,J ,K+KADD)==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + MESHES(NM)%CELL_INDEX(I+IADD,J ,K+KADD) = CCOUNT + MESHES(NM)%CELL(CCOUNT)%I = I+IADD + MESHES(NM)%CELL(CCOUNT)%J = J + MESHES(NM)%CELL(CCOUNT)%K = K+KADD + ENDIF + ENDDO + ENDDO + ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) + ICMP = MESHES(NM)%CELL_INDEX(I+1,J ,K ) + ICPP = MESHES(NM)%CELL_INDEX(I+1,J ,K+1) + ICPM = MESHES(NM)%CELL_INDEX(I ,J ,K+1) + MESHES(NM)%EDGE(IE)%I = I + MESHES(NM)%EDGE(IE)%J = J + MESHES(NM)%EDGE(IE)%K = K + MESHES(NM)%EDGE(IE)%AXIS = JAXIS + MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM + MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM + MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP + MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP + MESHES(NM)%CELL(ICPP)%EDGE_INDEX(5) = IE + MESHES(NM)%CELL(ICPM)%EDGE_INDEX(6) = IE + MESHES(NM)%CELL(ICMP)%EDGE_INDEX(7) = IE + MESHES(NM)%CELL(ICMM)%EDGE_INDEX(8) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=JAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) + CASE( 1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) + CASE(-3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 + ENDIF + ENDDO ENDIF - ELSE; NFC_GCR = NFC_GCR + 1 ! External + + CC_ECOUNT = CC_ECOUNT + 1 + + ! Add info to CC_IBEDGE: + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE + ENDIF - ENDDO + ENDDO IY_LOOP_2 ENDDO ENDDO -! KAXIS cut-faces: -X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS -DO K=-2,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%KBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External - ELSEIF(K==0 .OR. K==M%KBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary + +! Z axis edges: +DO K=1,KBAR + DO J=0,JBAR + INJ = .FALSE. + JN1 = J; JN2 = J+1 + IF (J==0) THEN; JN1=J+1 + ELSEIF(J==JBAR) THEN; JN2=J + ELSE + INJ = .TRUE. + ENDIF + IZ_LOOP_2 : DO I=0,IBAR + INI = .FALSE. + IN1 = I; IN2 = I+1 + IF (I==0) THEN; IN1=I+1 + ELSEIF(I==IBAR) THEN; IN2=I + ELSE + INI = .TRUE. + ENDIF + INMESH = INJ .AND. INI + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,KAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO JADD=0,1 ! Faces aligned in X. + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Y. + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,JN1:JN2,K,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. + ENDIF + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO JADD=0,1 + DO IADD=0,1 + IF(MESHES(NM)%CELL_INDEX(I+IADD,J+JADD,K )==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + MESHES(NM)%CELL_INDEX(I+IADD,J+JADD,K ) = CCOUNT + MESHES(NM)%CELL(CCOUNT)%I = I+IADD + MESHES(NM)%CELL(CCOUNT)%J = J+JADD + MESHES(NM)%CELL(CCOUNT)%K = K + ENDIF + ENDDO + ENDDO + ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) + ICPM = MESHES(NM)%CELL_INDEX(I+1,J ,K ) + ICPP = MESHES(NM)%CELL_INDEX(I+1,J+1,K ) + ICMP = MESHES(NM)%CELL_INDEX(I ,J+1,K ) + MESHES(NM)%EDGE(IE)%I = I + MESHES(NM)%EDGE(IE)%J = J + MESHES(NM)%EDGE(IE)%K = K + MESHES(NM)%EDGE(IE)%AXIS = KAXIS + MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM + MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM + MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP + MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP + MESHES(NM)%CELL(ICPP)%EDGE_INDEX( 9) = IE + MESHES(NM)%CELL(ICMP)%EDGE_INDEX(10) = IE + MESHES(NM)%CELL(ICPM)%EDGE_INDEX(11) = IE + MESHES(NM)%CELL(ICMM)%EDGE_INDEX(12) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=KAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) + CASE( 1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) + CASE(-2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) + CASE( 2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 + ENDIF + ENDDO ENDIF - ELSE; NFC_GCR = NFC_GCR + 1 ! External + + CC_ECOUNT = CC_ECOUNT + 1 + + ! Add info to CC_IBEDGE: + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE + ENDIF - ENDDO + ENDDO IZ_LOOP_2 ENDDO ENDDO -! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): -DO K=-CCGUARD,M%KBAR+CCGUARD - DO J=-CCGUARD,M%JBAR+CCGUARD - DO I=-CCGUARD,M%IBAR+CCGUARD - FCINDEX = M%CCVAR(I,J,K,CC_IDCF) - IF(M%CCVAR(I,J,K,CC_IDCF)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(M%CCVAR(I,J,K,CC_IDCF)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - M%CCVAR(I,J,K,CC_IDCF) = FCINDEX - DO X1AXIS=IAXIS,KAXIS - FCINDEX = M%FCVAR(I,J,K,CC_IDCF,X1AXIS) - IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = FCINDEX - ENDDO - ENDDO +DEALLOCATE(CELL_ADDED) + +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + WRITE(LU_SETCC,'(A,F8.3,A,6I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Sol-CC edges for BC : ', & + CC_ECOUNT,MESHES(NM)%CC_NIBEDGE,EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A,6I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Sol-CC edges for BC : ', & + CC_ECOUNT,MESHES(NM)%CC_NIBEDGE,EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' + ENDIF + ! DO I=1,MESHES(NM)%CC_NRCEDGE + ! WRITE(LU_ERR,*) 'IE,I,J,K,IAXIS=',MESHES(NM)%CC_RCEDGE(I)%IE,MESHES(NM)%CC_RCEDGE(I)%IJK(IAXIS:KAXIS+1) + ! ENDDO +ENDIF + +IF (DEBUG_SET_CUTCELLS) THEN + ! Write segment information for the mesh if it belongs to the process: + ! Write out: + WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_ibsegs_mesh_',NM,'.dat' + LU_DB_SETCC = GET_FILE_NUMBER() + OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') + !WRITE(LU_ERR,*) TRIM(MSEGS_FILE),MESHES(NM)%CC_NRCEDGE,CC_ECOUNT + DO ECOUNT=1,MESHES(NM)%CC_NIBEDGE + I=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(IAXIS) + J=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(JAXIS) + K=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(KAXIS) + IE=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(KAXIS+1) + SELECT CASE(IE) + CASE(IAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DX(I),XC(I),Y(J),Z(K) + CASE(JAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DY(J),X(I),YC(J),Z(K) + CASE(KAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DZ(K),X(I),Y(J),ZC(K) + END SELECT ENDDO -ENDDO -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - SELECT CASE(CC%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_RCGAS); CYCLE - CASE DEFAULT - FCINDEX = CC%FACE_LIST(4,IFACE) - IF(CC%FACE_LIST(4,IFACE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(CC%FACE_LIST(4,IFACE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - CC%FACE_LIST(4,IFACE) = FCINDEX - END SELECT - ENDDO + CLOSE(LU_DB_SETCC) +ENDIF + +RETURN +END SUBROUTINE GET_SOLID_CUTCELL_EDGES_BC + +! ----------------------- ALLOCATE_BODINT_PLANE -------------------------------- + +SUBROUTINE ALLOCATE_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) + +TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE +LOGICAL, INTENT (INOUT) :: FIRST_CALL_ARG + +! Local Variables: +INTEGER, SAVE :: N_VERTS_TOT, N_FACES_TOT +LOGICAL, SAVE :: FIRST_CALL=.TRUE. +REAL(EB) :: LEDGE +INTEGER :: IG + +IF (FIRST_CALL) THEN + ! Define BODINT_PLANE allocation sizes, hard wired for now: + ! Maximum number of vertices and elements in BODINT_PLANE: + N_VERTS_TOT=0; N_FACES_TOT=0 + DO IG=1,N_GEOMETRY + N_VERTS_TOT = N_VERTS_TOT + GEOMETRY(IG)%N_VERTS + N_FACES_TOT = N_FACES_TOT + GEOMETRY(IG)%N_FACES ENDDO -ENDDO -DO ICE=1,M%N_CUTEDGE_MESH - CE=>M%CUT_EDGE(ICE) - DO IEDGE=1,CE%NEDGE - DO ILOC=-2,2 - FCINDEX = CE%FACE_LIST(1,ILOC,IEDGE) - IF(CE%FACE_LIST(1,ILOC,IEDGE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(CE%FACE_LIST(1,ILOC,IEDGE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - CE%FACE_LIST(1,ILOC,IEDGE) = FCINDEX - ENDDO + + ! Conservative estimate: + CC_MAX_NNODS = 2 * N_VERTS_TOT + CC_MAX_NSGLS = N_VERTS_TOT + CC_MAX_NSEGS = N_FACES_TOT + CC_MAX_NTRIS = N_FACES_TOT + + ! Maximum number of grid crossings on BODINT_PLANE segments, MAX_LEDGE is a module variable: + MAX_LEDGE = GEOMEPS ! Initialize to a small number. + DO IG=1,N_GEOMETRY + LEDGE = GEOMETRY(IG)%MAX_LEDGE ! This has been computed at setup in GET_GEOM_TRIBIN + MAX_LEDGE = MAX(MAX_LEDGE,LEDGE) ENDDO -ENDDO -! Reallocate CUT_FACE: -ALLOCATE(CUT_FACE_AUX( MAX(SIZE(MESHES(NM)%CUT_FACE,DIM=1), NCF_MESH+NFC_BND+NFC_MSH + NGF_MESH+NFC_GCR ) )) -CUT_FACE_AUX(1:NBD_MESH) = M%CUT_FACE(1:NBD_MESH) -CUT_FACE_AUX(NBD_MESH+NFC_BND+1:NCF_MESH+NFC_BND) = M%CUT_FACE(NBD_MESH+1:NCF_MESH) -CUT_FACE_AUX(NCF_MESH+NFC_BND+NFC_MSH+1:NCF_MESH+NFC_BND+NFC_MSH+NGF_MESH) = M%CUT_FACE(NCF_MESH+1:NCF_MESH+NGF_MESH) -CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE); M => MESHES(NM) + FIRST_CALL =.FALSE. +ENDIF -! Finally, add new cut-faces: -CT_BND = 0 -CT_MSH = 0 -CT_GCR = 0 -! IAXIS cut-faces: -X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-2,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%IBAR) THEN ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ELSEIF(I==0 .OR. I==M%IBAR) THEN ! Block boundary - CT_BND = CT_BND + 1 - IFC = NBD_MESH + CT_BND - ENDIF - ELSE ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ENDIF - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XFACE(I), YCELL(J), ZCELL(K) /); AREA(1) = DYCELL(J)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC - M%CUT_FACE(IFC)%STATUS = CC_GASPHASE - M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) - ENDDO - ENDDO -ENDDO +IF (.NOT.FIRST_CALL_ARG) RETURN -! JAXIS cut-faces: -X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-2,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%JBAR) THEN ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ELSEIF(J==0 .OR. J==M%JBAR) THEN ! Block boundary - CT_BND = CT_BND + 1 - IFC = NBD_MESH + CT_BND - ENDIF - ELSE ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ENDIF - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC - M%CUT_FACE(IFC)%STATUS = CC_GASPHASE - M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) - ENDDO - ENDDO -ENDDO +IF ( ALLOCATED(BODINT_PLANE%XYZ) ) DEALLOCATE(BODINT_PLANE%XYZ) +IF ( ALLOCATED(BODINT_PLANE%SGLS) ) DEALLOCATE(BODINT_PLANE%SGLS) +IF ( ALLOCATED(BODINT_PLANE%SEGS) ) DEALLOCATE(BODINT_PLANE%SEGS) +IF ( ALLOCATED(BODINT_PLANE%TRIS) ) DEALLOCATE(BODINT_PLANE%TRIS) +IF ( ALLOCATED(BODINT_PLANE%INDSEG) ) DEALLOCATE(BODINT_PLANE%INDSEG) +IF ( ALLOCATED(BODINT_PLANE%INDTRI) ) DEALLOCATE(BODINT_PLANE%INDTRI) +IF ( ALLOCATED(BODINT_PLANE%X2ALIGNED) ) DEALLOCATE(BODINT_PLANE%X2ALIGNED) +IF ( ALLOCATED(BODINT_PLANE%X3ALIGNED) ) DEALLOCATE(BODINT_PLANE%X3ALIGNED) +IF ( ALLOCATED(BODINT_PLANE%SEGTYPE) ) DEALLOCATE(BODINT_PLANE%SEGTYPE) +IF ( ALLOCATED(BODINT_PLANE%NOD_PERM) ) DEALLOCATE(BODINT_PLANE%NOD_PERM) -! KAXIS cut-faces: -X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS -DO K=-2,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%KBAR) THEN ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ELSEIF(K==0 .OR. K==M%KBAR) THEN ! Block boundary - CT_BND = CT_BND + 1 - IFC = NBD_MESH + CT_BND - ENDIF - ELSE ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ENDIF - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC - M%CUT_FACE(IFC)%STATUS = CC_GASPHASE - M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) - ENDDO - ENDDO -ENDDO +ALLOCATE(BODINT_PLANE% XYZ(IAXIS:KAXIS, CC_MAX_NNODS)) +ALLOCATE(BODINT_PLANE% NOD_PERM(CC_MAX_NNODS)) +ALLOCATE(BODINT_PLANE% SGLS(NOD1, CC_MAX_NSGLS)) +ALLOCATE(BODINT_PLANE% SEGS(NOD1:NOD2, CC_MAX_NSEGS)) +ALLOCATE(BODINT_PLANE% TRIS(NOD1:NOD3, CC_MAX_NTRIS)) +ALLOCATE(BODINT_PLANE% INDSEG(CC_MAX_WSTRIANG_SEG+2, CC_MAX_NSEGS)) +ALLOCATE(BODINT_PLANE% INDTRI(CC_MAX_WSTRIANG_TRI+1, CC_MAX_NTRIS)) +ALLOCATE(BODINT_PLANE%X2ALIGNED(CC_MAX_NSEGS)) +ALLOCATE(BODINT_PLANE%X3ALIGNED(CC_MAX_NSEGS)) +ALLOCATE(BODINT_PLANE% SEGTYPE(LOW_IND:HIGH_IND, CC_MAX_NSEGS)) -M%N_BBCUTFACE_MESH = NBD_MESH + NFC_BND -M%N_CUTFACE_MESH = NCF_MESH + NFC_BND + NFC_MSH -M%N_GCCUTFACE_MESH = NGF_MESH + NFC_GCR +FIRST_CALL_ARG=.FALSE. -ELSE +END SUBROUTINE ALLOCATE_BODINT_PLANE -! IAXIS cut-faces: -X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-2,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - ! Insert cut-face in CUT_FACE array: - CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XFACE(I), YCELL(J), ZCELL(K) /); AREA(1) = DYCELL(J)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - ENDDO - ENDDO -ENDDO - -! JAXIS cut-faces: -X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-2,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - ! Insert cut-face in CUT_FACE array: - CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - ENDDO - ENDDO -ENDDO +! -------------------------- GET_BODINT_PLANE ----------------------------------- -! KAXIS cut-faces: -X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS -DO K=-2,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - ! Insert cut-face in CUT_FACE array: - CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - ENDDO - ENDDO -ENDDO +SUBROUTINE GET_BODINT_PLANE(X1AXIS,X1PLN,INDX1,PLNORMAL,X2AXIS,X3AXIS,& + X2LO,X2HI,X3LO,X3HI,X2FACE,X3FACE,X2LO_CELL,& + X2HI_CELL,X3LO_CELL,X3HI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE) -ENDIF +INTEGER, INTENT(IN) :: X1AXIS, X2AXIS, X3AXIS, INDX1, X2LO, X2HI, X3LO, X3HI, X2LO_CELL,& + X2HI_CELL,X3LO_CELL,X3HI_CELL +REAL(EB),INTENT(IN) :: X1PLN, PLNORMAL(MAX_DIM) +REAL(EB), ALLOCATABLE, DIMENSION(:), INTENT(IN) :: X2FACE,X3FACE +LOGICAL, INTENT(IN) :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY +TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE -END SUBROUTINE GET_REMAINING_CUTFACES +! Local variables: +INTEGER :: IG, IBIN, IWSEL, IWSELDUM, IEDGE, ISGL, ISEG, ITRI, EDGE_TRI +REAL(EB):: XYZV(MAX_DIM,NODS_WSEL) +INTEGER :: ELEM(NODS_WSEL), IND_P(NODS_WSEL), NTRIS, NSEGS +REAL(EB):: DOT1, DOT2, DOT3 +LOGICAL :: INTFLG, INLIST +REAL(EB):: LN1(MAX_DIM,NOD1:NOD2), LN2(MAX_DIM,NOD1:NOD2) +REAL(EB):: XYZ_INT1(MAX_DIM), XYZ_INT2(MAX_DIM) +INTEGER :: SEG(NOD1:NOD2), EDGES(NOD1:NOD2,3), VEC3(3) +REAL(EB):: X2X3(IAXIS:JAXIS,NODS_WSEL), AREALOC +REAL(EB):: XP1(IAXIS:JAXIS), XP2(IAXIS:JAXIS), TX2P(IAXIS:JAXIS), TX3P(IAXIS:JAXIS) +REAL(EB):: NMTX2P +INTEGER :: IWSEL1, IWSEL2, ELEM1(NODS_WSEL), ELEM2(NODS_WSEL) +REAL(EB):: XYZ1(MAX_DIM), NXYZ1(MAX_DIM), NX3P1, N1(IAXIS:JAXIS), NMNL +REAL(EB):: XYZ2(MAX_DIM), NXYZ2(MAX_DIM), NX3P2, N2(IAXIS:JAXIS) +REAL(EB):: X3PVERT, PVERT(IAXIS:JAXIS), X3P1, P1CEN(IAXIS:JAXIS), X3P2, P2CEN(IAXIS:JAXIS) +INTEGER :: VCT(2) +REAL(EB):: PCT(IAXIS:JAXIS,1:2), V1(IAXIS:JAXIS), V2(IAXIS:JAXIS), CRSSNV, CTST +REAL(EB):: VEC(IAXIS:JAXIS,1:2) +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEGAUX, INDSEGAUX, SEGTYPEAUX, ISEG_NODE +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: ANGS_NODE +REAL(EB):: X3_1, X2_1, X3_2, X2_2, SLEN, SBOD +INTEGER :: INOD, ISEG_NEW, NBCROSS, NBCROSS_SVAR +REAL(EB):: DELBIN +INTEGER :: ILO_BIN, IHI_BIN +INTEGER :: AXIS, NTL, SZE, IBCR, ICROSS, IDUM, ISVAR, ISX, JJ2, KK2, BISEG, BIISEG, JJ2_LO, JJ2_HI, KK2_LO, KK2_HI +INTEGER :: VAXIS(IAXIS:JAXIS), I +REAL(EB):: LXI, MEAN_SLEN, XIV(NOD1:NOD2), XIV_LO, XIV_HI, MIN_MESHGEOM +INTEGER, ALLOCATABLE, DIMENSION(:) :: TRI_LIST, SEGS_NODE, CIRC_MED +INTEGER :: SEGV(NOD1:NOD2,EDG1:EDG2), ISEGV(EDG1:EDG2), INT_FLG, MAX_SEG_NODE, ISEG2, ISEG3, NSN, COUNT +REAL(EB):: XPOS, XY(IAXIS:JAXIS), S1_X2_MIN, S1_X3_MIN, S1_X2_MAX, S1_X3_MAX, AVAL, ANG, DX2, DX3 +REAL(EB):: D1(IAXIS:JAXIS),P1(IAXIS:JAXIS),D2(IAXIS:JAXIS),P2(IAXIS:JAXIS),SLENV(EDG1:EDG2),SVARV(NOD1:NOD2,EDG1:EDG2) +REAL(EB) :: TNOW +LOGICAL :: LO_X2_TEST, HI_X2_TEST, LO_X3_TEST, HI_X3_TEST, FOUND_SEG, CRS_FLG +CHARACTER(100) :: BIPL_FILE +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX -! ---------------------- CUT_CELL_FACE_ARRAYS_CLEANUP ----------------------------- +INTEGER :: WSELEM(NOD1:NOD3), MYAXIS +REAL(EB):: FACECUBE(LOW_IND:HIGH_IND,IAXIS:KAXIS) -SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP(NM) +IG = INDX1 +TNOW = CURRENT_TIME() -INTEGER, INTENT(IN) :: NM +! Now allocate BODINT_PLANE: +BODINT_PLANE%NNODS = 0 +BODINT_PLANE%NSGLS = 0 +BODINT_PLANE%NSEGS = 0 +BODINT_PLANE%NTRIS = 0 -INTEGER, ALLOCATABLE, DIMENSION(:) :: CCIND,CFIND,AUXV -INTEGER :: I,J,K,X1AXIS,ICC,JCC,IFC,IFACE,ICF,JCF,IFC1,CT,CTC,CTF,ILH,& - N_CUTCELL_MESH_NEW,N_GCCUTCELL_MESH_NEW,N_CUTFACE_MESH_NEW,N_GCCUTFACE_MESH_NEW,N_BBCUTFACE_MESH_NEW,& - NEDG,IEDG,LOHI,DIR,ICE -TYPE(MESH_TYPE), POINTER :: M -M => MESHES(NM) -ALLOCATE(CCIND(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH),CFIND(M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH)); CCIND=0; CFIND=0 +! Main Loop over Geometries: +MAIN_GEOM_LOOP : DO IG=1,N_GEOMETRY -! Count cut-cells and face entries with NCELL, NFACE > 0: -CTC=0; N_CUTCELL_MESH_NEW=0; N_GCCUTCELL_MESH_NEW=0 -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - IF(M%CUT_CELL(ICC)%NCELL<1) CYCLE - CTC=CTC+1 - CCIND(ICC) = CTC - IF (ICC<=M%N_CUTCELL_MESH) THEN; N_CUTCELL_MESH_NEW = N_CUTCELL_MESH_NEW + 1 - ELSE; N_GCCUTCELL_MESH_NEW = N_GCCUTCELL_MESH_NEW + 1; ENDIF -ENDDO -CTF=0; N_CUTFACE_MESH_NEW=0; N_GCCUTFACE_MESH_NEW=0; N_BBCUTFACE_MESH_NEW=0 -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - IF(M%CUT_FACE(ICF)%NFACE<1) CYCLE - CTF=CTF+1 - CFIND(ICF) = CTF - IF (ICF<=M%N_BBCUTFACE_MESH) N_BBCUTFACE_MESH_NEW = N_BBCUTFACE_MESH_NEW + 1 - IF (ICF<=M%N_CUTFACE_MESH) THEN; N_CUTFACE_MESH_NEW = N_CUTFACE_MESH_NEW + 1 - ELSE; N_GCCUTFACE_MESH_NEW = N_GCCUTFACE_MESH_NEW + 1; ENDIF -ENDDO + IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE + DELBIN = GEOMETRY(IG)%TBAXIS(X1AXIS)%DELBIN + MIN_MESHGEOM = GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(1)%X1_LOW + ILO_BIN = MAX(1,CEILING((X1PLN-GEOMEPS-MIN_MESHGEOM)/DELBIN)) + IHI_BIN = MIN(GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS,CEILING((X1PLN+GEOMEPS-MIN_MESHGEOM)/DELBIN)) -! Move Cut-cells to new location, NCELL=0 entries are dropped: -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - IF(M%CUT_CELL(ICC)%NCELL<1 .OR. ICC==CCIND(ICC)) CYCLE - CALL CUT_CELL_MOVE(M%CUT_CELL(ICC),M%CUT_CELL(CCIND(ICC))) -ENDDO -M%N_CUTCELL_MESH = N_CUTCELL_MESH_NEW -M%N_GCCUTCELL_MESH = N_GCCUTCELL_MESH_NEW + ! Find for this geometry where does the plane lay on triangle bins: + IBIN_DO : DO IBIN=ILO_BIN,IHI_BIN !1,GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS -! Now Cut-faces: -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - IF(M%CUT_FACE(ICF)%NFACE<1 .OR. ICF==CFIND(ICF)) CYCLE - CALL CUT_FACE_MOVE(M%CUT_FACE(ICF),M%CUT_FACE(CFIND(ICF))) -ENDDO -M%N_CUTFACE_MESH = N_CUTFACE_MESH_NEW -M%N_GCCUTFACE_MESH = N_GCCUTFACE_MESH_NEW -M%N_BBCUTFACE_MESH = N_BBCUTFACE_MESH_NEW + IF ( X1PLN < GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE + IF ( X1PLN > GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE -! Finally fix ICC and ICF in CCVAR, FCVAR, CELL_LIST and FACE_LIST arrays -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC=>M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS); - M%CCVAR(I,J,K,CC_IDCC) = ICC; - DO JCC=1,CC%NCELL - ALLOCATE(AUXV(CC%CCELEM(1,JCC))); AUXV = 0 - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - AUXV(IFC) = 1 - IF ( .NOT.(CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB .OR. & - CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) ) CYCLE - IFC1 = CC%FACE_LIST(4,IFACE) - CC%FACE_LIST(4,IFACE) = 0; IF(IFC1>0) CC%FACE_LIST(4,IFACE) = CFIND(IFC1) - IF(CC%FACE_LIST(4,IFACE)<1) AUXV(IFC) = 0 + ! Loop surface triangles: +! DO IWSEL =1,GEOMETRY(IG)%N_FACES + DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL + + IWSEL=GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(IWSELDUM) + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(MAX_DIM*(IWSEL-1)+1:MAX_DIM*IWSEL) + ! Triangles NODES coordinates: + DO INOD=NOD1,NOD3 + XYZV(IAXIS:KAXIS,INOD) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+1:MAX_DIM*WSELEM(INOD)) ENDDO - IFC1=0 - DO IFC=1,CC%CCELEM(1,JCC) - IF(AUXV(IFC)<1) CYCLE - IFC1 = IFC1+1 - CC%CCELEM(IFC1+1,JCC) = CC%CCELEM(IFC+1,JCC) + ! FACECUBE: + DO MYAXIS=IAXIS,KAXIS + FACECUBE( LOW_IND,MYAXIS) = MINVAL(XYZV(MYAXIS,NOD1:NOD3)) + FACECUBE(HIGH_IND,MYAXIS) = MAXVAL(XYZV(MYAXIS,NOD1:NOD3)) ENDDO - CC%CCELEM(1,JCC) = SUM(AUXV(:)) - DEALLOCATE(AUXV) - ENDDO - ! Deallocate FACE_LIST_DROPPED - CC%NFACE_DROPPED = 0 - IF(ALLOCATED(CC%FACE_LIST_DROPPED)) DEALLOCATE(CC%FACE_LIST_DROPPED) -ENDDO -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CT = HIGH_IND - I = M%CUT_FACE(ICF)%IJK(IAXIS); J = M%CUT_FACE(ICF)%IJK(JAXIS); K = M%CUT_FACE(ICF)%IJK(KAXIS) - X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) - SELECT CASE(M%CUT_FACE(ICF)%STATUS) - CASE(CC_INBOUNDARY) - CT = LOW_IND - M%CCVAR(I,J,K,CC_IDCF) = ICF - CASE(CC_GASPHASE) - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = ICF - END SELECT - DO JCF=1,M%CUT_FACE(ICF)%NFACE - DO ILH=LOW_IND,CT - IF (M%CUT_FACE(ICF)%CELL_LIST(1,ILH,JCF)==CC_FTYPE_CFGAS) THEN - ICC = M%CUT_FACE(ICF)%CELL_LIST(2,ILH,JCF) - M%CUT_FACE(ICF)%CELL_LIST(2,ILH,JCF) = CCIND(ICC) - ENDIF - ENDDO - ENDDO -ENDDO + ! Test low-high vertices of triangle along x1axis vs plane (O(NT) operation): + IF( (FACECUBE( LOW_IND,X1AXIS)-X1PLN) > GEOMEPS) CYCLE + IF( (X1PLN-FACECUBE(HIGH_IND,X1AXIS)) > GEOMEPS) CYCLE -! Finally, some cut-faces might have regular Edges which are in CUT_EDGE, renumber in EDGE_LIST: -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_GASPHASE) CYCLE - NEDG=SIZE(CF%EDGE_LIST,DIM=2); I=CF%IJK(IAXIS); J=CF%IJK(JAXIS); K=CF%IJK(KAXIS); X1AXIS=CF%IJK(KAXIS+1) - DO IEDG=1,NEDG-1 - IF(CF%EDGE_LIST(1,IEDG)/=CC_ETYPE_RGGAS) CYCLE - LOHI=CF%EDGE_LIST(2,IEDG)-2 ! -1 for LOW_IND, 0 for HIGH_IND - DIR =CF%EDGE_LIST(3,IEDG) - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(DIR==JAXIS) THEN - ICE=M%ECVAR(I,J+LOHI,K,CC_IDCE,KAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ELSEIF(DIR==KAXIS) THEN - ICE=M%ECVAR(I,J,K+LOHI,CC_IDCE,JAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ENDIF - CASE(JAXIS) - IF(DIR==IAXIS) THEN - ICE=M%ECVAR(I+LOHI,J,K,CC_IDCE,KAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ELSEIF(DIR==KAXIS) THEN - ICE=M%ECVAR(I,J,K+LOHI,CC_IDCE,IAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ENDIF - CASE(KAXIS) - IF(DIR==IAXIS) THEN - ICE=M%ECVAR(I+LOHI,J,K,CC_IDCE,JAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ELSEIF(DIR==JAXIS) THEN - ICE=M%ECVAR(I,J+LOHI,K,CC_IDCE,IAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ENDIF - END SELECT - ENDDO -ENDDO + IF(RAYTRACE_X2_ONLY) THEN + IF( (X3LO_RT-FACECUBE(HIGH_IND,X3AXIS)) > GEOMEPS) CYCLE + IF( (FACECUBE( LOW_IND,X3AXIS)-X3HI_RT) > GEOMEPS) CYCLE + ELSE + LO_X2_TEST=(X2FACE(X2LO)-FACECUBE(HIGH_IND,X2AXIS)) > GEOMEPS + LO_X3_TEST=(X3FACE(X3LO)-FACECUBE(HIGH_IND,X3AXIS)) > GEOMEPS + IF( LO_X2_TEST .AND. LO_X3_TEST ) CYCLE + HI_X2_TEST=(FACECUBE( LOW_IND,X2AXIS)-X2FACE(X2HI)) > GEOMEPS + IF( HI_X2_TEST .AND. LO_X3_TEST ) CYCLE + HI_X3_TEST=(FACECUBE( LOW_IND,X3AXIS)-X3FACE(X3HI)) > GEOMEPS + IF( LO_X2_TEST .AND. HI_X3_TEST ) CYCLE + IF( HI_X2_TEST .AND. HI_X3_TEST ) CYCLE + ENDIF -DEALLOCATE(CCIND,CFIND) + ! Compute simplified dot(PLNORMAL,XYZV-XYZPLANE): + DOT1 = XYZV(X1AXIS,NOD1) - X1PLN + DOT2 = XYZV(X1AXIS,NOD2) - X1PLN + DOT3 = XYZV(X1AXIS,NOD3) - X1PLN + IF ( ABS(DOT1) <= GEOMEPS ) DOT1 = 0._EB + IF ( ABS(DOT2) <= GEOMEPS ) DOT2 = 0._EB + IF ( ABS(DOT3) <= GEOMEPS ) DOT3 = 0._EB -RETURN -END SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP + ! Test if IWSEL lays in X1PLN: + IF ( (ABS(DOT1)+ABS(DOT2)+ABS(DOT3)) == 0._EB ) THEN -! ---------------------------- BLOCK_CUT_CELL ------------------------------------- + ! Force nodes location in X1PLN plane: + XYZV(X1AXIS,NOD1:NOD3) = X1PLN -SUBROUTINE BLOCK_CUT_CELL(NM,ICC,JCC,BLOCK_PHASE) + ! Index to point 1 of triangle in BODINT_PLANE%XYZ list: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD1),IND_P(NOD1)) -! 1. Find Body and triangle with largest boundary cut-face area in cut-cell ICC,JCC. -! 2. Loop on faces of ICC,JCC (IFC_LOOP): -! a. If face is regular face, define it as Boundary cut-face of cell sharing it with ICC,JCC. -! a1. Make space for all surrounding Cartesian cells that will turn into cut-cells. -! a2. Make space for CFINB cut-edges and cut-faces in cell sharing with ICC,JCC, define cut-cell in said -! Cartesian cell. -! a3. Drop regular face, set FCVAR, ECVAR for edges involved => SOLID. Make VERTVAR for vertices involved SOLID. -! b. If face is type CFGAS. -! b1. Make space for all surrounding Cartesain cells that will turn into cut-cells. -! b2. Make space for CFINB cut-edges and cut-faces in CUT_CELL sharing with ICC,JCC. -! b3. Add INB cut-face to surrounding cut-cell, drop regular face, set FCVAR, ECVAR for edges involved => SOLID. -! Make VERTVAR for vertices involved SOLID. + ! Index to point 2 of triangle in BODINT_PLANE%XYZ list: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD2),IND_P(NOD2)) -INTEGER, INTENT(IN) :: NM,ICC,JCC,BLOCK_PHASE + ! Index to point 3 of triangle in BODINT_PLANE%XYZ list: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD3),IND_P(NOD3)) -INTEGER :: I,J,K,II,JJ,KK,IFC,IFC1,JFC1,IFACE,LOHI,ILH,X1AXIS,NSVERT,NSFACE,NVERTFACE_NEW,COUNT,DUM,IBOD,ITRI,& - HILO,ILHF,ICC2,JCC2,IFC2,IFACE2,IFCX,JFCX,IV,IVERT,MAXVERTS,INOD,INDFC(1:4),ICCNXT,& - IADD,JADD,KADD,EDGE_LIST_REG(1:3,1:4),DIMCE(2),IEDGE,CEI,LOHIE,AXISF,AXISE,LOWI,HIGI,LOWJ,HIGJ,LOWK,HIGK,& - IEG,JEG,KEG,ICE,JCE,ICF2,JCF2,JCE2,IEC2,JEC2,VL1(4),VL2(4),NFCD,IFCIN,JFCIN,KFCIN,X1AXIN,SZDUM -REAL(EB):: XYZV(IAXIS:KAXIS),XYZVERT(MAX_DIM,4) -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BODTRI,EDGE_LIST_AUX,CEDGES_AUX,CEDGES_AUX2,FACE_LIST_DROPPED -INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM -REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA -LOGICAL :: REALLOC_FLG, NEW_FACE_FLG, DROP_FACE, INZONE -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_INBCF_AREA_TYPE), POINTER :: INBCF_AREA -M => MESHES(NM) + ! Do we need to test if we already have this triangle on + ! the list? Shouldn't unless repeated -> Possibility for + ! zero thickness. + NTRIS = BODINT_PLANE % NTRIS + 1 + BODINT_PLANE % NTRIS = NTRIS + BODINT_PLANE % TRIS(NOD1:NOD3,NTRIS) = IND_P + BODINT_PLANE % INDTRI(1:2,NTRIS) = (/ IWSEL, IG /) -I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS); -! Find Body and triangle to associate to the cell to be blocked: -IBOD = 0; ITRI = 0 -COUNT= 0; DUM = 0 -DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 -ENDDO -IF (COUNT>0) THEN - ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 - DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE - DO DUM=1,COUNT - IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & - BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT - ENDDO - IF(DUM > COUNT) THEN ! No match in previous loop DUM=COUNT+1 - BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) - COUNT = DUM - ENDIF - AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) - ENDDO - IF (COUNT>0) THEN - ! Now set IBOD, ITRI - DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. - IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) - ENDIF - DEALLOCATE(BODTRI,AREA) -ELSE - ! Look in surrounding cells: - DO KK=K-1,K+1 - DO JJ=J-1,J+1 - DO II=I-1,I+1 - ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) - IF (ICC2>0) THEN - DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) - IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 - ENDDO - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - IF (COUNT>0) THEN - ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 - DO KK=K-1,K+1 - DO JJ=J-1,J+1 - DO II=I-1,I+1 - ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) - IF (ICC2>0) THEN - DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) - IFC1 = M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE) - JFC1 = M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE) - IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE - DO DUM=1,COUNT - IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & - BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT - ENDDO - IF(DUM > COUNT) THEN - BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) - COUNT = DUM - ENDIF - AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) - ENDDO - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - IF (COUNT>0) THEN - ! Now set IBOD, ITRI - DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. - IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) - ENDIF - DEALLOCATE(BODTRI,AREA) - ENDIF -ENDIF + CYCLE ! Next WSELEM -! For cut-cell ICC, JCC run through its boundary faces and generate new boundary EDGES, CUT-FACES and cells: -BLOCK_PHASE_IF : IF(BLOCK_PHASE==1) THEN + ENDIF -! Add areas of corresponding INB faces: -INZONE = (I>=0 .AND. I<=M%IBP1 .AND. J>=0 .AND. J<=M%JBP1 .AND. K>=0 .AND. K<=M%KBP1) .AND. MY_RANK==PROCESS(NM) -IF(INZONE) THEN - INBCF_AREA => M%INBCF_AREA(I,J,K) - IF(INBCF_AREA%NCELL == 0) THEN - INBCF_AREA%NCELL = M%CUT_CELL(ICC)%NCELL - ALLOCATE(INBCF_AREA%AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%AINB = 0._EB - ALLOCATE(INBCF_AREA%NEW_AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%NEW_AINB = 0._EB - ALLOCATE(INBCF_AREA%SURF_INDEX(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%SURF_INDEX = 0 - ALLOCATE(INBCF_AREA%IJCF(M%CUT_CELL(ICC)%NCELL)) - ENDIF - IF(IBOD>0) M%INBCF_AREA(I,J,K)%SURF_INDEX(JCC) = GEOMETRY(IBOD)%SURFS(ITRI) - DUM = 0; M%INBCF_AREA(I,J,K)%AINB(JCC) = 0._EB - DO IFC=2,M%CUT_CELL(ICC)%CCELEM(1,JCC)+1 - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC,JCC) - IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) - SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_CFINB) - M%INBCF_AREA(I,J,K)%AINB(JCC) = M%INBCF_AREA(I,J,K)%AINB(JCC) + & - M%CUT_FACE(IFC1)%AREA(JFC1)*M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1) - CASE(CC_FTYPE_CFGAS,CC_FTYPE_RCGAS) - DUM=DUM+1 - END SELECT - ENDDO - IF(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE>0) THEN - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = 0; - DEALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB) - ENDIF - IF(.NOT.ALLOCATED(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB)) THEN - ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB = 0 - ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB = 0 - ENDIF -ENDIF + ! Test if we are looking for intersection triangles only: + ONLY_TRIANG_EDGES_COND : IF (.NOT.TRI_ONPLANE_ONLY) THEN + ! Case a: Typical intersections: + ! Points 1,2 on on side of plane, point 3 on the other: + IF ( ((DOT1 > 0._EB) .AND. (DOT2 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT2 < 0._EB) .AND. (DOT3 > 0._EB)) ) THEN -IFC_LOOP : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) - HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND - ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND - ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND - X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) - IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + ! Line 1, from node 2 to 3: + LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) + LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - FACE_TYPE_IF : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & - M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) - ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN - LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) - HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) - LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) - HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) - IF(LOWI>0 .AND. LOWJ>0) THEN - IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) CYCLE IFC_LOOP - ENDIF - ENDIF + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - ! If needed reallocate CUT_FACE to accomodate INBOUNDARY face in neighbor cell. - SELECT CASE(X1AXIS) - CASE(IAXIS); II=I+ILH; JJ=J; KK=K - CASE(JAXIS); II=I; JJ=J+ILH; KK=K - CASE(KAXIS); II=I; JJ=J; KK=K+ILH - END SELECT - IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP - ICCNXT=0; IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) ICCNXT=1 + ! Line 2, from node 1 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - IFC1 = M%CCVAR(II,JJ,KK,CC_IDCF) ! INBOUNDARY cut-faces in neighbor cartesian cell. - NEW_FACE_FLG = .FALSE. - IF (IFC1 < 1) THEN - ! Insert IFC1: - CALL INSERT_CUT_FACE(NM,II,JJ,KK,0,IFC1,INZONE=INZONE); M => MESHES(NM) ! Make space for INBOUNDARY cut-face - NEW_FACE_FLG = .TRUE. - ENDIF + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) - REALLOC_FLG = .FALSE. - NSVERT = 0; NSFACE = 0; - IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) NVERTFACE_NEW = 5 - IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) NVERTFACE_NEW = M%CUT_FACE(IFCX)%CFELEM(1,JFCX)+1 - SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CFELEM)) SZDUM = SIZE(M%CUT_FACE(IFC1)%CFELEM, DIM=1) - IF(SZDUM < NVERTFACE_NEW) REALLOC_FLG = .TRUE. - SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%XYZVERT)) SZDUM = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) - IF(SZDUM < M%CUT_FACE(IFC1)%NVERT+NVERTFACE_NEW-1) THEN - REALLOC_FLG = .TRUE. - NSVERT = NVERTFACE_NEW-1 - ENDIF - SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%AREA)) SZDUM = SIZE(M%CUT_FACE(IFC1)%AREA,DIM=1) - IF(SZDUM < M%CUT_FACE(IFC1)%NFACE+1) THEN - REALLOC_FLG = .TRUE. - NSFACE = 1 - ENDIF - JFC1 = M%CUT_FACE(IFC1)%NFACE+1 + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) - ! Reallocate CUT_FACE(IFC1) entry: - IF(NEW_FACE_FLG) THEN - CALL FACE_DEALLOC(NM,IFC1); CALL NEW_FACE_ALLOC(NM,IFC1,NSVERT,NSFACE,NVERTFACE_NEW) - ELSEIF(REALLOC_FLG) THEN - CALL FACE_REALLOC(NM,IFC1,M%CUT_FACE(IFC1)%NVERT,M%CUT_FACE(IFC1)%NFACE,NSVERT,NSFACE,NVERTFACE_NEW) - ENDIF + ! Now add segment: + NSEGS = BODINT_PLANE % NSEGS + 1 + BODINT_PLANE % NSEGS = NSEGS + IF ( DOT1 > 0._EB ) THEN ! First case, counterclockwise p1 to p2 + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) + ENDIF + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) - M=>MESHES(NM) - ! Provide GEOM surface information to newly created INBOUNDARY face: - M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) = (/ IBOD, ITRI /) - M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = 0 ! Default surf. - M%CUT_FACE(IFC1)%CFACE_ORIGIN(JFC1) = M%CUT_CELL(ICC)%NOADVANCE(JCC) - IF(IBOD>0) M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = GEOMETRY(IBOD)%SURFS(ITRI) - M%CUT_FACE(IFC1)%NFACE = JFC1 - ENDIF FACE_TYPE_IF + CYCLE ! Next WSELEM - SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_RCGAS) ! This regular face has to be connecting two small cut-cells. - ! Scheme: - ! 0. Add REG edges as INB cut-edges in corresponding cartesian cut faces. Define normal edges to new INB cut-edge - ! as CFGAS cut-edges. Set VERTVAR to SOLID in EDGE corners: - EDGE_LIST_REG(1:3,1:4) = CC_UNDEFINED; EDGE_LIST_REG(1,1:4) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. - SELECT CASE(X1AXIS) - CASE(IAXIS) - ! First INB cut edges in surrounding faces: - ! I+ILHF location. - ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 - XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) - XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) - ! Edge 1: V1-V2 add to face (I+2*ILHF+1,J ,K-1,KAXIS) - ! side on blocked cell,[I,J,K,X1EDGE], [I,J,K,X1FACE] - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K-1,JAXIS,I+2*ILHF+1,J ,K-1,KAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) - ! Edge 2: V2-V3 add to face (I+2*ILHF+1,J ,K ,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,KAXIS,I+2*ILHF+1,J ,K ,JAXIS,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) - ! Edge 3: V4-V3 add to face (I+2*ILHF+1,J ,K ,KAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,JAXIS,I+2*ILHF+1,J ,K ,KAXIS,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) - ! Edge 4: V1-V4 add to face (I+2*ILHF+1,J-1,K ,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J-1,K ,KAXIS,I+2*ILHF+1,J-1,K ,JAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) + ENDIF + ! Points 2,3 on one side of plane, point 1 on the other: + IF ( ((DOT2 > 0._EB) .AND. (DOT3 > 0._EB) .AND. (DOT1 < 0._EB)) .OR. & + ((DOT2 < 0._EB) .AND. (DOT3 < 0._EB) .AND. (DOT1 > 0._EB)) ) THEN - ! Second CFGAS cut-edges in edges normal to face: - DO KADD=-1,0 - DO JADD=-1,0 - ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO + ! Line 1, from node 1 to 2: + LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) - CASE(JAXIS) - ! J+ILHF location. - ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) - ! Edge 1: V1-V2 add to face (I-1,J+2*ILHF+1,K ,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J+ILHF,K ,KAXIS,I-1,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) - ! Edge 2: V2-V3 add to face (I ,J+2*ILHF+1,K ,KAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,IAXIS,I ,J+2*ILHF+1,K ,KAXIS,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) - ! Edge 3: V4-V3 add to face (I ,J+2*ILHF+1,K ,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,KAXIS,I ,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) - ! Edge 4: V1-V4 add to face (I ,J+2*ILHF+1,K-1,KAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K-1,IAXIS,I ,J+2*ILHF+1,K-1,KAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) - ! Second CFGAS cut-edges in edges normal to face: - DO KADD=-1,0 - DO IADD=-1,0 - ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - CASE(KAXIS) - ! K+ILHF location. - ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /) - XYZVERT(:,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) - ! Edge 1: V1-V2 add to face (I,J-1,K+2*ILHF+1,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J-1,K+ILHF,IAXIS,I ,J-1,K+2*ILHF+1,JAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) - ! Edge 2: V2-V3 add to face (I,J ,K+2*ILHF+1,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,JAXIS,I ,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) - ! Edge 3: V4-V3 add to face (I,J ,K+2*ILHF+1,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,IAXIS,I ,J ,K+2*ILHF+1,JAXIS,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) - ! Edge 4: V1-V4 add to face (I-1,J,K+2*ILHF+1,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J ,K+ILHF,JAXIS,I-1,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) + ! Line 2, from node 1 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - ! Second CFGAS cut-edges in edges normal to face: - DO JADD=-1,0 - DO IADD=-1,0 - ! Edge (I+IADD,J+JADD,K+2*ILHF+1,KAXIS): From V(I+IADD,J+JADD,K+2*ILHF) to V(I+IADD,J+JADD,K+2*ILHF+1) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+JADD,K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) - END SELECT + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + ! Now add segment: + NSEGS = BODINT_PLANE % NSEGS + 1 + BODINT_PLANE % NSEGS = NSEGS + IF ( DOT2 > 0._EB ) THEN ! Second case, counterclockwise p2 to p1 + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + ENDIF + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) - ! 1. Add INBOUNDARY cut-face with size of RGGAS in CUT_FACE for this face (IFC1,JFC1). - DUM = M%CUT_FACE(IFC1)%NVERT + 1 - SELECT CASE(X1AXIS) - CASE(IAXIS) - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) - M%CUT_FACE(IFC1)%AREA(JFC1) = DYCELL(J)*DZCELL(K) - M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XFACE(I+ILHF), YCELL(J), ZCELL(K) /) - CASE(JAXIS) - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) - M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DZCELL(K) - M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YFACE(J+ILHF), ZCELL(K) /) - CASE(KAXIS) - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) - M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DYCELL(J) - M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YCELL(J), ZFACE(K+ILHF) /) - END SELECT - INDFC(1:4) = (/ 1, 2, 3, 4 /); INDFC = INDFC + M%CUT_FACE(IFC1)%NVERT - M%CUT_FACE(IFC1)%NVERT = DUM + CYCLE ! Next WSELEM - ! All faces connectivities: (/ NNODS, NOD1, NOD2, NOD3, NOD4 /) ! Conn. into gas region of new cell. - IF (LOHI==HIGH_IND) THEN; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(2), INDFC(3), INDFC(4) /) - ELSE; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(4), INDFC(3), INDFC(2) /); ENDIF + ENDIF + ! Points 1,3 on one side of plane, point 2 on the other: + IF ( ((DOT1 > 0._EB) .AND. (DOT3 > 0._EB) .AND. (DOT2 < 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT3 < 0._EB) .AND. (DOT2 > 0._EB)) ) THEN - ! Add new edges to EDGE_LIST: - DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) - ALLOCATE(EDGE_LIST_AUX(3,DUM+4)); - IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) - EDGE_LIST_AUX(1:3,DUM+1:DUM+4) = EDGE_LIST_REG(1:3,1:4); - CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) - ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) - DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN - DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) - ENDIF - IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) - IF (LOHI==HIGH_IND) THEN; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+2, DUM+3, DUM+4 /) - ELSE; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+4, DUM+3, DUM+2 /); ENDIF - CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) + ! Line 1, from node 1 to 2: + LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) - IF(INZONE) THEN - M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 - ENDIF + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) - ! 2. Find cut-cell sharing this RGGAS face, and where in FACE_LIST this face is. - IF( ICCNXT==0 ) THEN - ! 3. Change in FACE_LIST -> (/CC_FTYPE_RCGAS,SIDE,MYAXIS,0,0/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/). - ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) - JCC2_LOOP_1 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) - IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_RCGAS .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(2,IFACE2)==HILO .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(3,IFACE2)==X1AXIS) THEN - M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) - M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1)= (/ CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) - EXIT JCC2_LOOP_1 + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + + ! Line 2, from node 2 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) + + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) + + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + + ! Now add segment: + NSEGS = BODINT_PLANE % NSEGS + 1 + BODINT_PLANE % NSEGS = NSEGS + IF ( DOT1 > 0._EB ) THEN ! Third case, counterclockwise p1 to p2 + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) + ENDIF + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) + + CYCLE ! Next WSELEM + + ENDIF + + ! Case b: only one point intersection. They will be used to define + ! Solid vertex points in case of coincidence. + ! Point 1 is on the plane: + IF ( (DOT1 == 0._EB) .AND. ( ((DOT2 > 0._EB) .AND. (DOT3 > 0._EB)) .OR. & + ((DOT2 < 0._EB) .AND. (DOT3 < 0._EB)) ) ) THEN + + ! First node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN + + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + + ! Add index to singles: + ! Find if oriented segment is in list: + INLIST = .FALSE. + DO ISGL=1,BODINT_PLANE%NSGLS + IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN + INLIST = .TRUE. + EXIT ENDIF ENDDO - ENDDO JCC2_LOOP_1 - ENDIF + IF (.NOT.INLIST) THEN + ISGL = BODINT_PLANE%NSGLS + 1 + BODINT_PLANE % NSGLS = ISGL + BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) + ENDIF - CASE(CC_FTYPE_CFGAS) + CYCLE ! Next WSELEM - ! Scheme: - ! 0. Add REG and CFGAS cut edges as INB cut edges for the normal faces where it corresponds: - DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) - ALLOCATE(EDGE_LIST_AUX(3,DUM+M%CUT_FACE(IFCX)%CEDGES(1,JFCX))); - EDGE_LIST_AUX = CC_UNDEFINED; EDGE_LIST_REG(1,:) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. - IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) - ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) - DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN - DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) - ENDIF - IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) - CEDGES_AUX(1,JFC1) = M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - SELECT CASE(X1AXIS) - CASE(IAXIS) - XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) - XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) - ! Loop face edges/cut-edges: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) - ENDIF - CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! First INB cut edges in surrounding faces: - ! I+ILHF location. - ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 - LOWJ=-1; HIGJ=0; LOWK=-1; HIGK=0; - IF(AXISF==JAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J-1; KEG=K ; HIGJ=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J-1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; LOWJ= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ENDIF - ELSEIF(AXISF==KAXIS) THEN - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J ; KEG=K-1; HIGK=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K-1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; LOWK= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ENDIF - ENDIF - DO KADD=LOWK,HIGK - DO JADD=LOWJ,HIGJ - ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO - CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge - ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; - ! Find Edge: - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. - SELECT CASE(AXISE) - CASE(KAXIS) ! Edge in z dir. For surrounding faces in X dir -> 2*ILHF+1 = -1 or 1. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=JAXIS - CASE(JAXIS) ! Edge in y dir. For surrounding faces in X dir -> 4*ILHF+2 = -2 or 2. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=KAXIS - END SELECT - ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: - ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: - CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) + ENDIF + ! Point 2 is on the plane: + IF ( (DOT2 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT3 > 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT3 < 0._EB)) ) ) THEN - ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: - EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) + ! Second node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN - ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: - VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - IF(VL1(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL1(3)), ZFACE(VL1(4)) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL1(3)), ZFACE(VL1(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL1(3),VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - IF(VL2(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL2(3)), ZFACE(VL2(4)) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL2(3)), ZFACE(VL2(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL2(3),VL2(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + + ! Add index to singles: + ! Find if oriented segment is in list: + INLIST = .FALSE. + DO ISGL=1,BODINT_PLANE%NSGLS + IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN + INLIST = .TRUE. + EXIT ENDIF - CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge - ! New edge list for the heighboring cell Boundary cut-faces is inherited. - EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) - END SELECT - ENDDO + ENDDO + IF (.NOT.INLIST) THEN + ISGL = BODINT_PLANE%NSGLS + 1 + BODINT_PLANE % NSGLS = ISGL + BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) + ENDIF - CASE(JAXIS) - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) - ! Loop face edges/cut-edges: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) - ENDIF - CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! First INB cut edges in surrounding faces: - ! J+ILHF location. - ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - LOWI=-1; HIGI=0; LOWK=-1; HIGK=0; - IF(AXISF==KAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J+ILHF; KEG=K-1; HIGK=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K-1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ELSE - IEG=I; JEG=J+ILHF; KEG=K ; LOWK= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ENDIF - ELSEIF(AXISF==IAXIS) THEN - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J+ILHF; KEG=K ; HIGI=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ELSE - IEG=I ; JEG=J+ILHF; KEG=K ; LOWI= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ENDIF - ENDIF - DO KADD=LOWK,HIGK - DO IADD=LOWI,HIGI - ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO - CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge - ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; - ! Find Edge: - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. - SELECT CASE(AXISE) - CASE(IAXIS) ! Edge in x dir. For surrounding faces in Y dir -> 2*ILHF+1 = -1 or 1. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=KAXIS - CASE(KAXIS) ! Edge in z dir. For surrounding faces in Y dir -> 4*ILHF+2 = -2 or 2. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=IAXIS - END SELECT + CYCLE ! Next WSELEM - ! IF(ICF2<1) THEN - ! WRITE(LU_ERR,*) 'ADD CUT_EDGE TO FACE IFCX,JFCX,I,J,K,X1AXIS=',& - ! IFCX,JFCX,M%CUT_FACE(IFCX)%IJK(1:4),':',M%FCVAR(7,7,7,CC_IDCF,2),M%FCVAR(7,7,7,CC_FGSC,2) - ! WRITE(LU_ERR,*) 'IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4)=',& - ! IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4),4*ILHF+2 - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-2,JCE) - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-1,JCE) - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 1,JCE) - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 2,JCE) - ! ENDIF + ENDIF + ! Point 3 is on the plane: + IF ( (DOT3 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT2 > 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT2 < 0._EB)) ) ) THEN - ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: - ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: - CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) + ! Third node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN - ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: - EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: - VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - IF(VL1(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF ), ZFACE(VL1(4)) /) - XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF+1), ZFACE(VL1(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),J+2*ILHF+1,VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - IF(VL2(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - XYZVERT(:,1) = (/ XFACE(VL2(2)), YFACE(J+2*ILHF ), ZFACE(VL2(4)) /) - XYZVERT(:,2) = (/ XFACE(VL2(2)), YFACE(J+2*ILHF+1), ZFACE(VL2(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL2(2),J+2*ILHF+1,VL2(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ! Add index to singles: + ! Find if single element is in list: + INLIST = .FALSE. + DO ISGL=1,BODINT_PLANE%NSGLS + IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN + INLIST = .TRUE. + EXIT ENDIF - CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge - ! New edge list for the heighboring cell Boundary cut-faces is inherited. - EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) - END SELECT - ENDDO - CASE(KAXIS) - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /) - XYZVERT(:,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) - ! Loop face edges/cut-edges: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) + ENDDO + IF (.NOT.INLIST) THEN + ISGL = BODINT_PLANE%NSGLS + 1 + BODINT_PLANE % NSGLS = ISGL + BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) ENDIF - CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! First INB cut edges in surrounding faces: - ! K+ILHF location. - ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - LOWI=-1; HIGI=0; LOWJ=-1; HIGJ=0; - IF(AXISF==IAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J; KEG=K+ILHF; HIGI=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ELSE - IEG=I ; JEG=J; KEG=K+ILHF; LOWI= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ENDIF - ELSEIF(AXISF==JAXIS) THEN - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J-1; KEG=K+ILHF; HIGJ=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J-1,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ELSE - IEG=I; JEG=J ; KEG=K+ILHF; LOWJ= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ENDIF - ENDIF - DO JADD=LOWJ,HIGJ - DO IADD=LOWI,HIGI - ! Edge (I+IADD,J+JADD,K+2*ILHF+1,KAXIS): From V(I+IADD,J+JADD,K+2*ILHF) to V(I+IADD,J+JADD,K+2*ILHF+1) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+JADD,K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO - CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge - ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; - ! Find Edge: - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. - SELECT CASE(AXISE) - CASE(JAXIS) ! Edge in y dir. For surrounding faces in Z dir -> 2*ILHF+1 = -1 or 1. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; - X1AXIN=IAXIS - CASE(IAXIS) ! Edge in x dir. For surrounding faces in Z dir -> 4*ILHF+2 = -2 or 2. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; - X1AXIN=JAXIS - END SELECT - - ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: - ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: - CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) - - ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: - EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) - ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: - VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - IF(VL1(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),VL1(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - IF(VL2(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - XYZVERT(:,1) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL2(2),VL2(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge - ! New edge list for the heighboring cell Boundary cut-faces is inherited. - EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) - END SELECT - ENDDO - END SELECT - CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) + CYCLE ! Next WSELEM - ! 1. Add INBOUNDARY cut-face in CUT_FACE for this face (IFC1,JFC1). - ! Add XYZVERT, AREA, XYZCEN and CFELEM entry in CUT_FACE(IFC1) for this (IFCX,JFCX) CFGAS face. - M%CUT_FACE(IFC1)%CFELEM(1,JFC1) = M%CUT_FACE(IFCX)%CFELEM(1,JFCX) - MAXVERTS = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) - COUNT=1 - DO IVERT=1,M%CUT_FACE(IFCX)%CFELEM(1,JFCX) - IV=M%CUT_FACE(IFCX)%CFELEM(IVERT+1,JFCX) - XYZV(IAXIS:KAXIS) =M%CUT_FACE(IFCX)%XYZVERT(IAXIS:KAXIS,IV) - CALL INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,M%CUT_FACE(IFC1)%NVERT,INOD,M%CUT_FACE(IFC1)%XYZVERT) - COUNT=COUNT+1 - IF(COUNT>SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(COUNT+1,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:COUNT-1,:)=M%CUT_FACE(IFC1)%CFELEM(1:COUNT-1,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=M%CUT_FACE(IFC1)%CFELEM) ENDIF - M%CUT_FACE(IFC1)%CFELEM(COUNT,JFC1)=INOD - ENDDO - IF (HILO==HIGH_IND) THEN ! Mirror the connectivity, s.t. normal pointing inside: - COUNT=M%CUT_FACE(IFC1)%CFELEM(1,JFC1) - ALLOCATE(CFELEM(COUNT)); CFELEM(1:COUNT) = M%CUT_FACE(IFC1)%CFELEM(COUNT+1:2:-1,JFC1) - M%CUT_FACE(IFC1)%CFELEM(2:COUNT+1,JFC1) = CFELEM(1:COUNT) - DEALLOCATE(CFELEM) - ENDIF - M%CUT_FACE(IFC1)%AREA(JFC1) = M%CUT_FACE(IFCX)%AREA(JFCX) - M%CUT_FACE(IFC1)%XYZCEN(:,JFC1) = M%CUT_FACE(IFCX)%XYZCEN(:,JFCX) - ! 2. Find cut-cell sharing this CFGAS face (IFCX,JFCX), find where in saids cell FACE_LIST this face is. - ! 3. Change in FACE_LIST -> (/CC_FTYPE_CFGAS,SIDE,MYAXIS,IFCX,JFCX/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/) - ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) - JCC2_LOOP_2 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) - IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_CFGAS .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE2)==IFCX .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE2)==JFCX) THEN - ! Add to FACE_LIST_DROPPED: - M%CUT_CELL(ICC2)%NFACE_DROPPED = M%CUT_CELL(ICC2)%NFACE_DROPPED + 1 - NFCD=0; IF(ALLOCATED(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED)) NFCD=SIZE(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED,DIM=2) - IF(M%CUT_CELL(ICC2)%NFACE_DROPPED>NFCD) THEN - ALLOCATE(FACE_LIST_DROPPED(6,M%CUT_CELL(ICC2)%NFACE_DROPPED)) - IF(NFCD>0) FACE_LIST_DROPPED(1:6,1:NFCD) = M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1:6,1:NFCD) - FACE_LIST_DROPPED(1:6,NFCD+1) = M%CUT_CELL(ICC2)%FACE_LIST(1:6,IFACE2) - CALL MOVE_ALLOC(FROM=FACE_LIST_DROPPED,TO=M%CUT_CELL(ICC2)%FACE_LIST_DROPPED) - ENDIF - ! Now write CC_FTYPE_CFINB entry: - M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) - M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1) =(/CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) - IF(INZONE) THEN - M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 - ENDIF - EXIT JCC2_LOOP_2 - ENDIF - ENDDO - ENDDO JCC2_LOOP_2 - END SELECT + ! Case c: one node is part of the intersection: + ! Node 1 is in the plane: + IF ( (DOT1 == 0._EB) .AND. ( ((DOT2 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & + ((DOT2 < 0._EB) .AND. (DOT3 > 0._EB)) ) ) THEN -ENDDO IFC_LOOP + ! First node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN -IF(INZONE) THEN - DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE - IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) - JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) - M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) = M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) + M%CUT_FACE(IFC1)%AREA(JFC1) - ENDDO - DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE - IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) - JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) - M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)= & - M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)*M%INBCF_AREA(I,J,K)%AINB(JCC)/M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) - ENDDO -ENDIF + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -ELSEIF(BLOCK_PHASE==2) THEN BLOCK_PHASE_IF + ! Line 2, from node 2 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) -! Drop Edges and Faces: -IFC_LOOP_2 : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) - HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND - ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND - ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND - X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) - IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) - FACE_TYPE_IF_2 : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & - M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN - LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) - HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) - LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) - HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) - IF(LOWI>0 .AND. LOWJ>0) THEN - IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. & ! This is to drop this cut-face on the second hit. - M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0 .AND. M%CUT_FACE(IFCX)%SHARED(JFCX)) THEN - M%CUT_FACE(IFCX)%SHARED(JFCX) =.FALSE. - CYCLE IFC_LOOP_2 + ! Now add segment: + NSEGS = BODINT_PLANE % NSEGS + 1 + BODINT_PLANE % NSEGS = NSEGS + IF ( DOT2 > 0._EB ) THEN ! Second case, counterclockwise p2 to p1 + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) ENDIF + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) + + CYCLE ! Next WSELEM + ENDIF - ENDIF + ! Node 2 is in the plane: + IF ( (DOT2 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT3 > 0._EB)) ) ) THEN - SELECT CASE(X1AXIS) - CASE(IAXIS); II=I+ILH; JJ=J; KK=K - CASE(JAXIS); II=I; JJ=J+ILH; KK=K - CASE(KAXIS); II=I; JJ=J; KK=K+ILH - END SELECT - IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP_2 + ! Second node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN - ENDIF FACE_TYPE_IF_2 + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_RCGAS) - ! 4. Make FCVAR(I,J,K,CC_CGSC,X1AXIS)=CC_SOLID, ECVAR and VERTVAR CC_SOLID where corresponds: - CALL DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) - CASE(CC_FTYPE_CFGAS) - ! Drop Face and Edges test: - DROP_FACE=.FALSE. - ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: - LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) - HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) - LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) - HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) - IF(LOWI>0 .AND. LOWJ>0) THEN - IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) THEN - DROP_FACE=.TRUE. - M%CUT_FACE(IFCX)%SHARED(JFCX) =.TRUE. - ENDIF - ENDIF + ! Line 2, from node 1 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) - JCC2_LOOP_3 : DO IFACE2=1,M%CUT_CELL(ICC2)%NFACE_DROPPED - IF(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & - M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(4,IFACE2)==IFCX .AND. & - M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(5,IFACE2)==JFCX) THEN - DROP_FACE=.TRUE. - EXIT JCC2_LOOP_3 + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) + + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + + ! Now add segment: + NSEGS = BODINT_PLANE % NSEGS + 1 + BODINT_PLANE % NSEGS = NSEGS + IF ( DOT1 > 0._EB ) THEN + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) ENDIF - ENDDO JCC2_LOOP_3 + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) - DROP_FACE_IF : IF (DROP_FACE) THEN - SELECT CASE(X1AXIS) - CASE(IAXIS) - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - IF(AXISF==KAXIS) THEN - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J ; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ELSEIF(AXISF==JAXIS) THEN - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J-1; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ENDIF - CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! Drop edge JCE: - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - END SELECT - ENDDO + CYCLE ! Next WSELEM - CASE(JAXIS) - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - IF(AXISF==KAXIS) THEN - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J+ILHF; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I; JEG=J+ILHF; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ELSEIF(AXISF==IAXIS) THEN - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I ; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ENDIF - CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! Drop edge JCE: - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - END SELECT - ENDDO - CASE(KAXIS) - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - IF(AXISF==IAXIS) THEN - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I ; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ELSEIF(AXISF==JAXIS) THEN - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J-1; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I; JEG=J ; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ENDIF - CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! Drop edge JCE: - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - END SELECT - ENDDO - END SELECT + ENDIF + ! Node 3 is in the plane: + IF ( (DOT3 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT2 < 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT2 > 0._EB)) ) ) THEN - ! Drop (IFCX,JFCX) from CUT_FACE(IFCX): - CALL DROP_CUTFACE(NM,CC_FTYPE_CFGAS,I,J,K,ILHF,X1AXIS,IFCX,JFCX) - ENDIF DROP_FACE_IF - CASE(CC_FTYPE_CFINB) + ! Third node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN - ! Drop cut-edges whithin the Cartesian cell I,J,K that belong to this INBOUNDARY cut-face: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)/=CC_ETYPE_CFINB) CYCLE - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) - IF(AXISE>0) CYCLE - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - ENDDO + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - ! Scheme: - ! 1. Drop (IFC2,JFC2) from CUT_FACE(IFC2). Note this changes the face arrays, so FACE_LIST face indexes - ! for cut-cells on this CUT_CELL(ICC) entry need to be updated. - CALL DROP_CUTFACE(NM,CC_FTYPE_CFINB,I,J,K,ILHF,X1AXIS,IFCX,JFCX) + ! Line 2, from node 1 to 2: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) - END SELECT + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) -ENDDO IFC_LOOP_2 + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -ELSEIF(BLOCK_PHASE==3) THEN BLOCK_PHASE_IF + ! Now add segment: + NSEGS = BODINT_PLANE % NSEGS + 1 + BODINT_PLANE % NSEGS = NSEGS + IF ( DOT1 > 0._EB ) THEN + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + ENDIF + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) -! At this point all faces defining the ICC,JCC cut-cell have been dropped in the CUT_FACE, CUT_CELL trees. -! We can drop JCC from CUT_CELL(ICC)%CCELEM, etc. -CALL DROP_CUTCELL(NM,ICC,JCC) + CYCLE ! Next WSELEM -ENDIF BLOCK_PHASE_IF + ENDIF + ENDIF ONLY_TRIANG_EDGES_COND -RETURN -END SUBROUTINE BLOCK_CUT_CELL + ! Case D: A triangle segment is in the plane. + ! Intersection is line 1-2: + IF ( (DOT1 == 0._EB) .AND. (DOT2 == 0._EB) ) THEN + ! First node: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN -! ------------------------------ ADD_CUTEDGE_TO_FACE -------------------------------- + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -SUBROUTINE ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IEC2,JEC2,IFC,JFC,KFC,X1AXFC) + ! Second node: + XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT2(X1AXIS) = X1PLN -INTEGER, INTENT(IN) :: NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IFC,JFC,KFC,X1AXFC -INTEGER, INTENT(OUT):: IEC2,JEC2 + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -! Local variables: -INTEGER :: INOD1,INOD2,VL1(1:4),VL2(1:4),NVERT,NEDGE,IEDGE -INTEGER, ALLOCATABLE :: EDGE_LIST_AUX(:,:) -REAL(EB):: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) -TYPE(MESH_TYPE), POINTER :: M + ! Set oriented segment regarding plane: + IF ( DOT3 > 0._EB ) THEN + SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) + ENDIF + ! Find if oriented segment is in list: + EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG1,IWSEL) ! 1st edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. + VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) + VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) + VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) + INLIST = .FALSE. + DO ISEG=1,BODINT_PLANE%NSEGS + FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & + ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) + IF ( FOUND_SEG .AND. & + (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & + (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & + (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + ISEG = BODINT_PLANE%NSEGS + 1 + BODINT_PLANE%NSEGS = ISEG + BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG + BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) + ENDIF -IEDGE=JCF2 ! Dummy for now FACE_LIST not filled for ETYPE_CFINB edges. + CYCLE ! Next WSELEM -M =>MESHES(NM) -IEC2=M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) -IF(IEC2<1) THEN ! Allocate space for CFINB cut-edge on this cut-face. + ENDIF + ! Intersection is line 2-3: + IF ( (DOT2 == 0._EB) .AND. (DOT3 == 0._EB) ) THEN - ! Allocate space for cut-edge in CUT_EDGE: - IEC2 = M%N_CUTEDGE_MESH + 1 - M%N_CUTEDGE_MESH = IEC2 - M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = IEC2 - CALL CUT_EDGE_ARRAY_REALLOC(NM,IEC2) - M%CUT_EDGE(IEC2)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,IEC2,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - M%CUT_EDGE(IEC2)%NEDGE = 0 - M%CUT_EDGE(IEC2)%NEDGE1 = 0 - M%CUT_EDGE(IEC2)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. - M%CUT_EDGE(IEC2)%STATUS = CC_INBOUNDCF - ALLOCATE(M%CUT_EDGE(IEC2)%DXX(1:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%DXX = 0._EB - ALLOCATE(M%CUT_EDGE(IEC2)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%FACE_LIST = CC_UNDEFINED + ! Second node: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN -ENDIF + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -! Edge nodes location and type: -INOD1 = M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE) -INOD2 = M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE) -XV1(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD1) -XV2(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD2) -VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD1) ! [CC_VTYPE I J K] -VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD2) + ! Third node: + XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT2(X1AXIS) = X1PLN -! Add cut-edge: -NVERT = M%CUT_EDGE(IEC2)%NVERT -CALL REALLOCATE_EDGE_VERT(NM,IEC2,NVERT+2) -CALL INSERT_FACE_VERT(XV1,NM,IEC2,NVERT,INOD1) -CALL INSERT_FACE_VERT(XV2,NM,IEC2,NVERT,INOD2) + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -DO NEDGE=1,M%CUT_EDGE(IEC2)%NEDGE - IF( (INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) .OR. & - (INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) ) THEN - JEC2=NEDGE; RETURN ! Edge already in Face cut-edges list. - ENDIF -ENDDO -JEC2=NEDGE -CALL REALLOCATE_EDGE_ELEM(NM,IEC2,NEDGE) + ! Set oriented segment regarding plane: + IF ( DOT1 > 0._EB ) THEN + SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) + ENDIF + ! Find if oriented segment is in list: + EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG2,IWSEL) ! 2nd edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. + VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) + VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) + VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) + INLIST = .FALSE. + DO ISEG=1,BODINT_PLANE%NSEGS + FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & + ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) + IF ( FOUND_SEG .AND. & + (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & + (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & + (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + ISEG = BODINT_PLANE%NSEGS + 1 + BODINT_PLANE%NSEGS = ISEG + BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG + BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) + ENDIF -! Check first node type, if gas vertex make it boundary vertex and change VERTVAR to CC_SOLID: -M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = VL1(1:4) -IF(VL1(1)==CC_VTYPE_VGAS) THEN - M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,VL1(2),VL1(3),VL1(4)/) - M%VERTVAR(VL1(2),VL1(3),VL1(4),CC_VGSC) = CC_SOLID -ENDIF -M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = VL2(1:4) -IF(VL2(1)==CC_VTYPE_VGAS) THEN - M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,VL2(2),VL2(3),VL2(4)/) - M%VERTVAR(VL2(2),VL2(3),VL2(4),CC_VGSC) = CC_SOLID -ENDIF + CYCLE ! Next WSELEM -! Add edge: Assumes XV1 < XV2 in X1AXEG direction: -M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) -IF(ILHF==-1) M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) + ENDIF + ! Intersection is line 3-1: + IF ( (DOT3 == 0._EB) .AND. (DOT1 == 0._EB) ) THEN -M%CUT_EDGE(IEC2)%NVERT = NVERT -M%CUT_EDGE(IEC2)%NEDGE = NEDGE + ! Third node: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN -M%CUT_EDGE(IEC2)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -! Define Edge as INB CUT_EDGE, find corresponding CFGAS EDGE associated cut-face and replace it -IF(ICF2>0) THEN - ! Reallocate EDGE_LIST if JCE2 exceeds current size - NVERT = 0 - IF(ALLOCATED(M%CUT_FACE(ICF2)%EDGE_LIST)) NVERT = SIZE(M%CUT_FACE(ICF2)%EDGE_LIST,DIM=2)-1 - IF(JCE2 > NVERT) THEN - ALLOCATE(EDGE_LIST_AUX(3,0:JCE2)) - EDGE_LIST_AUX = CC_UNDEFINED - IF(NVERT > 0) EDGE_LIST_AUX(1:3,0:NVERT) = M%CUT_FACE(ICF2)%EDGE_LIST(1:3,0:NVERT) - CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX, TO=M%CUT_FACE(ICF2)%EDGE_LIST) - ENDIF - M%CUT_FACE(ICF2)%EDGE_LIST(1:3,JCE2) = (/CC_ETYPE_CFINB, IEC2, JEC2/) -ENDIF + ! First node: + XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT2(X1AXIS) = X1PLN -END SUBROUTINE ADD_CUTEDGE_TO_FACE + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + ! Set oriented segment regarding plane: + IF ( DOT2 > 0._EB ) THEN + SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) + ENDIF + ! Find if oriented segment is in list: + EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG3,IWSEL) ! 3rd edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. + VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) + VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) + VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) + INLIST = .FALSE. + DO ISEG=1,BODINT_PLANE%NSEGS + FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & + ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) + IF ( FOUND_SEG .AND. & + (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & + (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & + (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + ISEG = BODINT_PLANE%NSEGS + 1 + BODINT_PLANE%NSEGS = ISEG + BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG + BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) + ENDIF -! ------------------------------ ADD_CUTEDGE_TO_EDGE ------------------------------- + CYCLE ! Next WSELEM -SUBROUTINE ADD_CUTEDGE_TO_EDGE(NM,ILHF,IEG,JEG,KEG,X1AXEG,XV1,XV2) + ENDIF -INTEGER, INTENT(IN) :: NM,ILHF,IEG,JEG,KEG,X1AXEG -REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) + ! If you get to this point -> you have a problem: + IF (.NOT.TRI_ONPLANE_ONLY) print*, "Error GET_BODINT_PLANE: Missed wet surface Triangle =",IWSEL -! Local Variables: -INTEGER :: NVERT,INOD1,INOD2,ICF,CEI,NEDGE,NOD1_TYPE,NOD2_TYPE,LOHI,AXIS -TYPE(MESH_TYPE), POINTER :: M - -M=>MESHES(NM) -IF(M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG)==CC_SOLID) RETURN + ENDDO ! IWSEL -! Define Gas Cut-edge: -CEI = M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) -IF(CEI<1) THEN - ! Allocate space for cut-edge in CUT_EDGE: - CEI = M%N_CUTEDGE_MESH + 1 - M%N_CUTEDGE_MESH = CEI - M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG) = CC_CUTCFE - M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - M%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - M%CUT_EDGE(CEI)%NEDGE = 0 - M%CUT_EDGE(CEI)%NEDGE1 = 0 - M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+1) = (/ IEG,JEG,KEG,X1AXEG /) ! Gas right to solid left. - M%CUT_EDGE(CEI)%STATUS = CC_GASPHASE - ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB - ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED + EXIT IBIN_DO ! No need to test more bins. -ELSE ! CUT_EDGE - IF(ILHF==-1) THEN - INOD2 = M%CUT_EDGE(CEI)%CEELEM(NOD2,M%CUT_EDGE(CEI)%NEDGE) ! High node of last gas segment. - M%CUT_EDGE(CEI)%VERT_LIST(1,INOD2) = CC_VTYPE_VINB - ELSE - INOD1 = M%CUT_EDGE(CEI)%CEELEM(NOD1,1) ! Low node of first gas segment. - M%CUT_EDGE(CEI)%VERT_LIST(1,INOD1) = CC_VTYPE_VINB - ENDIF - RETURN -ENDIF + ENDDO IBIN_DO -! Add new cut-edge created from regular edge: -NVERT = M%CUT_EDGE(CEI)%NVERT -CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) -CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) -CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) +ENDDO MAIN_GEOM_LOOP -NEDGE = M%CUT_EDGE(CEI)%NEDGE+1 -CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) -! Define Vert List for newly defined cut-edge: -IF (ILHF==-1) THEN - NOD1_TYPE = CC_VTYPE_VGAS - NOD2_TYPE = CC_VTYPE_VINB -ELSE - NOD1_TYPE = CC_VTYPE_VINB - NOD2_TYPE = CC_VTYPE_VGAS -ENDIF -SELECT CASE(X1AXEG) -CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG-1,JEG ,KEG /) -CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG-1,KEG /) -CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG ,KEG-1/) -END SELECT -M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/NOD2_TYPE,IEG ,JEG ,KEG /) +! Next step is to Test triangles sides normals on plane against the obtained +! segments normals. If two identical segments found contain oposite +! normals, drop the segment in BODINT_PLANE%SEGS: +IF ( BODINT_PLANE%NTRIS > 0 ) THEN -! Add edge: Assumes XV1 < XV2 in X1AXEG direction: -M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) + DO ITRI=1,BODINT_PLANE%NTRIS -M%CUT_EDGE(CEI)%NVERT = NVERT -M%CUT_EDGE(CEI)%NEDGE = NEDGE + ! Triang conectivities: + ELEM(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) -! There might be cut-faces that note this EDGE as a regular Gas edge, change incidence in their EDGE_LIST: -SELECT CASE(X1AXEG) -CASE(IAXIS) - ! Face at LOC=-2, located at low Z normal to Y axis: - ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC=-1, located at low Y normal to Z axis: - ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 1, located at high Y normal to Z axis: - ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 2, located at high Z normal to Y axis: - ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) -CASE(JAXIS) - ! Face at LOC=-2, located at low X normal to Z axis: - ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC=-1, located at low Z normal to X axis: - ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 1, located at high Z normal to X axis: - ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 2, located at high X normal to Z axis: - ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) -CASE(KAXIS) - ! Face at LOC=-2, located at low Y normal to X axis: - ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC=-1, located at low X normal to Y axis: - ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! IF(IEG==7 .AND. JEG==4 .AND. KEG==4) THEN - ! WRITE(LU_ERR,*) 'Found EDGE IN CUTEDGE To EDGE IF,JF,KF,AXIS,ICF=',IEG,JEG,KEG,JAXIS,ICF,CEI - ! DO INOD1=1,SIZE(M%CUT_FACE(ICF)%EDGE_LIST,DIM=2)-1 - ! WRITE(LU_ERR,*) M%CUT_FACE(ICF)%EDGE_LIST(:,INOD1) - ! ENDDO - ! ENDIF - ! Face at LOC= 1, located at high X normal to Y axis: - ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 2, located at high Y normal to X axis: - ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) -END SELECT + ! Coordinates in x2, x3 directions: + X2X3(IAXIS,NOD1:NOD3) = (/ BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD1)), & + BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD2)), & + BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD3)) /) + X2X3(JAXIS,NOD1:NOD3) = (/ BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD1)), & + BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD2)), & + BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD3)) /) -END SUBROUTINE ADD_CUTEDGE_TO_EDGE + ! Test Area sign, if -ve switch node order: + AREALOC = 0.5_EB*(X2X3(IAXIS,NOD1)*X2X3(JAXIS,NOD2) - X2X3(IAXIS,NOD2)*X2X3(JAXIS,NOD1) + & + X2X3(IAXIS,NOD2)*X2X3(JAXIS,NOD3) - X2X3(IAXIS,NOD3)*X2X3(JAXIS,NOD2) + & + X2X3(IAXIS,NOD3)*X2X3(JAXIS,NOD1) - X2X3(IAXIS,NOD1)*X2X3(JAXIS,NOD3)) + IF (AREALOC < 0._EB) THEN + ISEG = ELEM(3) + ELEM(3) = ELEM(2) + ELEM(2) = ISEG + ENDIF -! --------------------------- REPL_CUTEDGE_IN_LIST_EDGES --------------------------- + ! Now corresponding segments, ordered normal outside of plane x2-x3. + EDGES(NOD1:NOD2,1) = (/ ELEM(1), ELEM(2) /) ! edge 1. + EDGES(NOD1:NOD2,2) = (/ ELEM(2), ELEM(3) /) ! edge 2. + EDGES(NOD1:NOD2,3) = (/ ELEM(3), ELEM(1) /) -SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,IEC,JEC,LOHI,AXIS) + ! Now Test against segments, Beast approach: + DO IEDGE=1,3 + DO ISEG=1,BODINT_PLANE%NSEGS + IF ( (BODINT_PLANE%SEGS(NOD1,ISEG) == EDGES(NOD2,IEDGE)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == EDGES(NOD1,IEDGE)) ) THEN ! Edge normals + ! oriented in opposite dirs. + ! Set to SOLID SOLID segtype from BODINT_PLANE.SEGS + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG)=(/ CC_SOLID, CC_SOLID /) -INTEGER, INTENT(IN) :: NM,ICF,IEC,JEC,LOHI,AXIS -INTEGER :: IEDGE,DUM + ENDIF + ENDDO + ENDDO -IF(ICF>0) THEN - DUM=0; IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST)) DUM=SIZE(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST,DIM=2) - DO IEDGE=1,DUM-1 - IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE - IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE - IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(3,IEDGE)/=AXIS) CYCLE - MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFGAS,IEC,JEC/) - RETURN ENDDO ENDIF -END SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES -! ------------------------------ ADD_REGEDGE_TO_FACE ------------------------------- - -SUBROUTINE ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD,XV1,XV2,CEI,NEDGE,IV_LIST) +! For segments that are related to 2 Wet Surface triangles, test if they are of type GG or SS: +DO ISEG=1,BODINT_PLANE%NSEGS + IF (BODINT_PLANE%INDSEG(1,ISEG) > 1) THEN ! Related to 2 WS triangles: + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) -! ILHF -1 face in low side of edge, 0 face on high side of edge. + ! Segment nodes positions: + XP1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/X2AXIS,X3AXIS/) ,SEG(NOD1)) + XP2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/X2AXIS,X3AXIS/) ,SEG(NOD2)) -INTEGER, INTENT(IN) :: NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD -REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) -INTEGER, INTENT(OUT):: CEI,NEDGE -LOGICAL, INTENT(IN) :: IV_LIST + ! Unit normal versor along x2p (axis directed from NOD2 to NOD1): + NMTX2P = SQRT( (XP1(IAXIS)-XP2(IAXIS))**2._EB + (XP1(JAXIS)-XP2(JAXIS))**2._EB ) + TX2P(IAXIS:JAXIS) = (XP1(IAXIS:JAXIS)-XP2(IAXIS:JAXIS)) * NMTX2P**(-1._EB) + ! Versor along x3p. + TX3P(IAXIS:JAXIS) = (/ -TX2P(JAXIS), TX2P(IAXIS) /) -! Local Variables: -INTEGER :: NVERT,INOD1,INOD2,ICF,IEDGE,LOHI -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTFACE_TYPE), POINTER :: CF + ! Now related WS triangles centroids: + IWSEL1 = BODINT_PLANE%INDSEG(2,ISEG) + IWSEL2 = BODINT_PLANE%INDSEG(3,ISEG) + IG = BODINT_PLANE%INDSEG(4,ISEG) -M=>MESHES(NM) -IF(M%FCVAR(IFC,JFC,KFC,CC_FGSC,X1AXFC)==CC_SOLID) RETURN + ! Centroid of WS elem 1: + ELEM1(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL1-1)+1:NODS_WSEL*IWSEL1) + XYZ1(IAXIS:KAXIS) = ( GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD1)-1)+1:MAX_DIM*ELEM1(NOD1)) + & + GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD2)-1)+1:MAX_DIM*ELEM1(NOD2)) + & + GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD3)-1)+1:MAX_DIM*ELEM1(NOD3)) ) / 3._EB + NXYZ1(IAXIS:KAXIS)= GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL1) + ! Normal versor in x3p-x1 direction: + NX3P1 = TX3P(IAXIS)*NXYZ1(X2AXIS) + TX3P(JAXIS)*NXYZ1(X3AXIS) + N1(IAXIS:JAXIS) = (/ NX3P1, NXYZ1(X1AXIS) /) + NMNL = SQRT( N1(IAXIS)**2._EB + N1(JAXIS)**2._EB ) + N1 = N1 * NMNL**(-1._EB) -! Define Edge as INB cut-edge, add to CUT_EDGE: -CEI = M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) -IF (CEI < 1) THEN - ! Allocate space for cut-edge in CUT_EDGE: - CEI = M%N_CUTEDGE_MESH + 1 - M%N_CUTEDGE_MESH = CEI - M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - M%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - M%CUT_EDGE(CEI)%NEDGE = 0 - M%CUT_EDGE(CEI)%NEDGE1 = 0 - M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. - M%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF - ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB - ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED -ENDIF + ! Centroid of WS elem 2: + ELEM2(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL2-1)+1:NODS_WSEL*IWSEL2) + XYZ2(IAXIS:KAXIS) = ( GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD1)-1)+1:MAX_DIM*ELEM2(NOD1)) + & + GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD2)-1)+1:MAX_DIM*ELEM2(NOD2)) + & + GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD3)-1)+1:MAX_DIM*ELEM2(NOD3)) ) / 3._EB + NXYZ2(IAXIS:KAXIS)= GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL2) + ! Normal versor in x3p-x1 direction: + NX3P2 = TX3P(IAXIS)*NXYZ2(X2AXIS) + TX3P(JAXIS)*NXYZ2(X3AXIS) + N2(IAXIS:JAXIS) = (/ NX3P2, NXYZ2(X1AXIS) /) + NMNL = SQRT( N2(IAXIS)**2._EB + N2(JAXIS)**2._EB ) + N2 = N2 * NMNL**(-1._EB) -! Add cut-edge: -NVERT = M%CUT_EDGE(CEI)%NVERT -CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) -CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) -CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) + ! Define points in plane x3p-x1: + ! vertex point: + X3PVERT = TX3P(IAXIS)*XP1(IAXIS) + TX3P(JAXIS)*XP1(JAXIS) + PVERT(IAXIS:JAXIS) = (/ X3PVERT, X1PLN /) + ! First triangle centroid: + X3P1 = TX3P(IAXIS)*XYZ1(X2AXIS) + TX3P(JAXIS)*XYZ1(X3AXIS) + P1CEN(IAXIS:JAXIS) = (/ X3P1, XYZ1(X1AXIS) /) + ! Second triangle centroid: + X3P2 = TX3P(IAXIS)*XYZ2(X2AXIS) + TX3P(JAXIS)*XYZ2(X3AXIS) + P2CEN(IAXIS:JAXIS) = (/ X3P2, XYZ2(X1AXIS) /) -DO NEDGE=1,M%CUT_EDGE(CEI)%NEDGE - IF( (INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) .OR. & - (INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) ) THEN - RETURN ! Edge already in Face cut-edges list. - ENDIF -ENDDO -CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) + VCT(1:2) = 0 + PCT(IAXIS:JAXIS,1:2) = 0._EB -SELECT CASE(X1AXEG) -CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG-1,JEG ,KEG /) -CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG-1,KEG /) -CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG ,KEG-1/) -END SELECT -M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,IEG ,JEG ,KEG /) -IF(IV_LIST) THEN - ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: - M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) - IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) -ELSE - ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: - M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) - IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) -ENDIF + ! Segment on triangle 1: + V1(IAXIS:JAXIS) = P1CEN(IAXIS:JAXIS) - PVERT(IAXIS:JAXIS) + CRSSNV = N1(IAXIS)*V1(JAXIS) - N1(JAXIS)*V1(IAXIS) + IF (CRSSNV > 0._EB) THEN + ! v1 stays as is, and is second segment: + VEC(IAXIS:JAXIS,2) = V1(IAXIS:JAXIS) + PCT(IAXIS:JAXIS,2) = P1CEN(IAXIS:JAXIS) + VCT(2) = 1 + ELSE + ! -v1 is the first segment: + VEC(IAXIS:JAXIS,1) = -V1(IAXIS:JAXIS) + PCT(IAXIS:JAXIS,1) = P1CEN(IAXIS:JAXIS) + VCT(1) = 1 + ENDIF -M%CUT_EDGE(CEI)%NVERT = NVERT -M%CUT_EDGE(CEI)%NEDGE = NEDGE + ! Segment on triangle 2: + V2(IAXIS:JAXIS) = P2CEN(IAXIS:JAXIS) - PVERT(IAXIS:JAXIS) + CRSSNV = N2(IAXIS)*V2(JAXIS) - N2(JAXIS)*V2(IAXIS) + IF (CRSSNV > 0._EB) THEN + ! v2 stays as is, and is second segment: + VEC(IAXIS:JAXIS,2) = V2(IAXIS:JAXIS) + PCT(IAXIS:JAXIS,2) = P2CEN(IAXIS:JAXIS) + VCT(2) = 1 + ELSE + ! -v2 is the first segment: + VEC(IAXIS:JAXIS,1) = -V2(IAXIS:JAXIS) + PCT(IAXIS:JAXIS,1) = P2CEN(IAXIS:JAXIS) + VCT(1) = 1 + ENDIF -M%CUT_EDGE(CEI)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) + IF ( (VCT(1) == 0) .OR. (VCT(2) == 0) ) THEN + print*, "Error GET_BODINT_PLANE: One component of vct == 0." + ENDIF -ICF = M%FCVAR(IFC,JFC,KFC,CC_IDCF,X1AXFC) -IF (ICF>0) THEN ! There are cut-faces in this face - LOHI= LOW_IND; IF(ILHF==-1) LOHI=HIGH_IND - ! Define Edge as INB CUT_EDGE, find corresponding RGGAS EDGE associated cut-face and replace it - CF=>M%CUT_FACE(ICF); - INOD1=0; IF(ALLOCATED(CF%EDGE_LIST)) INOD1=SIZE(CF%EDGE_LIST,DIM=2) - DO IEDGE=1,INOD1-1 - IF(CF%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE - IF(CF%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE - IF(CF%EDGE_LIST(3,IEDGE)/=X1AXIS) CYCLE - CF%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFINB, CEI, NEDGE/) - RETURN - ENDDO -ENDIF + ! Cross product of v1 and v2 gives magnitude along x2p axis: + CTST = VEC(IAXIS,1)*VEC(JAXIS,2) - VEC(JAXIS,1)*VEC(IAXIS,2) -END SUBROUTINE ADD_REGEDGE_TO_FACE + ! Now tests: + ! Start with SOLID GASPHASE definition for segtype: + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_GASPHASE /) + ! Test for SOLID SOLID condition: + IF ( ((PCT(JAXIS,1)-X1PLN) > -GEOMEPS) .AND. & + ((PCT(JAXIS,2)-X1PLN) > -GEOMEPS) .AND. (CTST < GEOMEPS) ) THEN + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_SOLID /) + CYCLE + ELSEIF (((PCT(JAXIS,1)-X1PLN) < GEOMEPS) .AND. & + ((PCT(JAXIS,2)-X1PLN) < GEOMEPS) .AND. (CTST < GEOMEPS) ) THEN + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_SOLID /) + CYCLE + ENDIF -! --------------------------------- DROP_REG_FACE ------------------------------------------- + ! Test for GASPHASE GASPHASE condition: + IF ( ((PCT(JAXIS,1)-X1PLN) > GEOMEPS) .AND. & + ((PCT(JAXIS,2)-X1PLN) > GEOMEPS) .AND. (CTST > GEOMEPS) ) THEN + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_GASPHASE, CC_GASPHASE /) + CYCLE + ELSEIF (((PCT(JAXIS,1)-X1PLN) < -GEOMEPS) .AND. & + ((PCT(JAXIS,2)-X1PLN) < -GEOMEPS) .AND. (CTST > GEOMEPS) ) THEN + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_GASPHASE, CC_GASPHASE /) + CYCLE + ENDIF -SUBROUTINE DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) + ENDIF +ENDDO -INTEGER, INTENT(IN) :: NM,I,J,K,ILHF,X1AXIS -SELECT CASE(X1AXIS) -CASE(IAXIS) - ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: - MESHES(NM)%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID - MESHES(NM)%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: - MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_EGSC,JAXIS)= CC_SOLID ! X2 - MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_IDCE,JAXIS)= CC_UNDEFINED - MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_EGSC,KAXIS)= CC_SOLID ! X3 - MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_IDCE,KAXIS)= CC_UNDEFINED - ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: - MESHES(NM)%VERTVAR(I+ILHF, J-1:J, K-1:K,CC_VGSC) = CC_SOLID -CASE(JAXIS) - ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: - MESHES(NM)%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID - MESHES(NM)%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: - MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_EGSC,KAXIS)= CC_SOLID ! X2 - MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_IDCE,KAXIS)= CC_UNDEFINED - MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_EGSC,IAXIS)= CC_SOLID ! X3 - MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_IDCE,IAXIS)= CC_UNDEFINED - ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: - MESHES(NM)%VERTVAR( I-1:I,J+ILHF, K-1:K,CC_VGSC) = CC_SOLID -CASE(KAXIS) - ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: - MESHES(NM)%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID - MESHES(NM)%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED - ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: - MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_EGSC,IAXIS)= CC_SOLID ! X2 - MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_IDCE,IAXIS)= CC_UNDEFINED - MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_EGSC,JAXIS)= CC_SOLID ! X3 - MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_IDCE,JAXIS)= CC_UNDEFINED - ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: - MESHES(NM)%VERTVAR( I-1:I, J-1:J,K+ILHF,CC_VGSC) = CC_SOLID -END SELECT +! For the time being, as BODINT_PLANE is used to create Cartesian face cut-faces +! We eliminate from the list the SEGTYPE=[SOLID SOLID] segments: +ALLOCATE(SEGAUX(NOD1:NOD2,BODINT_PLANE%NSEGS)) +ALLOCATE(INDSEGAUX(CC_MAX_WSTRIANG_SEG+2,BODINT_PLANE%NSEGS)) +ALLOCATE(SEGTYPEAUX(NOD1:NOD2,BODINT_PLANE%NSEGS)) -END SUBROUTINE DROP_REG_FACE +ISEG_NEW = 0 +IF(.NOT.TRI_ONPLANE_ONLY) THEN + DO ISEG=1,BODINT_PLANE%NSEGS + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) + IF( NORM2(XYZ2((/X2AXIS,X3AXIS/))-XYZ1((/X2AXIS,X3AXIS/))) < 0.1_EB*GEOMEPS) CYCLE + IF ( (BODINT_PLANE%SEGTYPE(NOD1,ISEG) == CC_SOLID) .AND. & + (BODINT_PLANE%SEGTYPE(NOD2,ISEG) == CC_SOLID) ) CYCLE + ISEG_NEW = ISEG_NEW + 1 + SEGAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+2,ISEG_NEW) = & + BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) + SEGTYPEAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) + ENDDO +ELSE + DO ISEG=1,BODINT_PLANE%NSEGS + IF ( (BODINT_PLANE%SEGTYPE(NOD1,ISEG) == CC_SOLID) .AND. & + (BODINT_PLANE%SEGTYPE(NOD2,ISEG) == CC_SOLID) ) THEN -! --------------------------- INSERT_CUT_CELL ----------------------------------------------- + ISEG_NEW = ISEG_NEW + 1 + SEGAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+2,ISEG_NEW) = & + BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) + SEGTYPEAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) + ENDIF + ENDDO +ENDIF -SUBROUTINE INSERT_CUT_CELL(NM,I,J,K,ICC) +BODINT_PLANE%NSEGS = ISEG_NEW +BODINT_PLANE%SEGS(NOD1:NOD2,1:ISEG_NEW) = SEGAUX(NOD1:NOD2,1:ISEG_NEW) +BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:ISEG_NEW) = INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+2,1:ISEG_NEW) +BODINT_PLANE%SEGTYPE(NOD1:NOD2,1:ISEG_NEW) = SEGTYPEAUX(NOD1:NOD2,1:ISEG_NEW) -! Adds a cut-cell entry ICF in the CUT_CELL array, assumes no cut-cell defined in cell I,J,K. -INTEGER, INTENT(IN) :: NM,I,J,K -INTEGER, INTENT(OUT):: ICC +DEALLOCATE(SEGAUX,INDSEGAUX,SEGTYPEAUX) -INTEGER :: DUM,KDUM,JDUM,IDUM,ICF,JCF +IF(TRI_ONPLANE_ONLY .OR. (BODINT_PLANE%NSEGS == 0)) THEN + T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) = T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) + CURRENT_TIME() - TNOW + RETURN +ENDIF -TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX +! Segments Crossings fields: +! Initialize nbcross with segment nodes locations: +IF ( ALLOCATED(BODINT_PLANE%NBCROSS) ) DEALLOCATE(BODINT_PLANE%NBCROSS) +IF ( ALLOCATED(BODINT_PLANE%SVAR) ) DEALLOCATE(BODINT_PLANE%SVAR) +ALLOCATE(BODINT_PLANE%NBCROSS(1:BODINT_PLANE%NSEGS),BODINT_PLANE%SVAR(1:CC_DELTA_NBCROSS,1:BODINT_PLANE%NSEGS)) +BODINT_PLANE%NBCROSS(1:BODINT_PLANE%NSEGS) = 0 +BODINT_PLANE%SVAR(1:CC_DELTA_NBCROSS,1:BODINT_PLANE%NSEGS) = -1._EB -IF( 0=ICC) & - MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC) + 1 - ENDDO - ENDDO -ENDDO -DO ICF=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - DO JCF=1,MESHES(NM)%CUT_FACE(ICF)%NFACE - IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>ICC) & - MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + 1 - IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>ICC) & - MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + 1 - ENDDO -ENDDO -MESHES(NM)%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) -MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE -MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = ICC +! Initialize nbcross with segment nodes locations: +! Add segment ends as crossings: +ALLOCATE(SEGS_NODE(BODINT_PLANE%NNODS)); SEGS_NODE = 0 +MEAN_SLEN=0._EB +DO ISEG=1,BODINT_PLANE%NSEGS -RETURN -END SUBROUTINE INSERT_CUT_CELL + ! End nodes to cross: + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) -! --------------------------- INSERT_CUT_FACE ----------------------------------------------- + IF(ANY(BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG)/=CC_GASPHASE)) THEN + SEGS_NODE(SEG(NOD1)) = SEGS_NODE(SEG(NOD1)) + 1 + SEGS_NODE(SEG(NOD2)) = SEGS_NODE(SEG(NOD2)) + 1 + ENDIF -SUBROUTINE INSERT_CUT_FACE(NM,I,J,K,AXIS,ICF,INZONE) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) -! This routine add a cut-face entry ICF in the CUT_FACE array: -! 1. IF AXIS = 0 INBOUNDARY face: -! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK is an interior cell. -! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK is a guard cell. -! 2. IF AXIS = 1,2,3 GASPHASE face: -! ICF = MESHES(NM)%N_BBCUTFACE_MESH+1 if II,JJ,KK,AXIS is a boundary face. -! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK,AXIS is an interior face. -! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK,AXIS is a guard face. -INTEGER, INTENT(IN) :: NM,I,J,K,AXIS -INTEGER, INTENT(OUT):: ICF -LOGICAL, OPTIONAL, INTENT(IN) :: INZONE + ! Is segment aligned with x3 direction? + BODINT_PLANE%X3ALIGNED(ISEG) = (ABS(XYZ2(X2AXIS)-XYZ1(X2AXIS)) < GEOMEPS) + ! Is segment aligned with x2 rays?: + BODINT_PLANE%X2ALIGNED(ISEG) = (ABS(XYZ2(X3AXIS)-XYZ1(X3AXIS)) < GEOMEPS) + ! x2_x3 of segment point 1: + X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) + ! x2_x3 of segment point 2: + X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) -INTEGER :: ICC,JCC,IFC,IFACE,IFCX,DUM,IDUM,JDUM,KDUM,X1AXIS,ICE,ILOC,IEDGE -TYPE(CC_CUTFACE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_FACE_AUX + ! Segment length: + SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) + MEAN_SLEN = MEAN_SLEN + SLEN -IF(AXIS==0) THEN - IF( 0MESHES(NM)%IBAR) THEN ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ELSEIF(I==0 .OR. I==MESHES(NM)%IBAR) THEN ! Block boundary - MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 - MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 - ICF = MESHES(NM)%N_BBCUTFACE_MESH - ENDIF - ELSE ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ENDIF - CASE(JAXIS) - IF(0MESHES(NM)%JBAR) THEN ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ELSEIF(J==0 .OR. J==MESHES(NM)%JBAR) THEN ! Block boundary - MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 - MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 - ICF = MESHES(NM)%N_BBCUTFACE_MESH - ENDIF - ELSE ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ENDIF - CASE(KAXIS) - IF(0MESHES(NM)%KBAR) THEN ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ELSEIF(K==0 .OR. K==MESHES(NM)%KBAR) THEN ! Block boundary - MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 - MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 - ICF = MESHES(NM)%N_BBCUTFACE_MESH - ENDIF - ELSE ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ENDIF - END SELECT -ENDIF -! Reallocate CUT_FACE: -ALLOCATE(CUT_FACE_AUX( MAX(SIZE(MESHES(NM)%CUT_FACE,DIM=1),MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH) )) -DO DUM=1,ICF-1 - CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM)) -ENDDO -DO DUM=ICF,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH-1 - CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM+1)) -ENDDO -CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE) + ! Allocate TRIBIN field: + IF(ALLOCATED(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN)) DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN) + ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(1:BODINT_PLANE%TBAXIS(AXIS)%N_BINS)) -! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): -DO KDUM=-CCGUARD,MESHES(NM)%KBAR+CCGUARD - DO JDUM=-CCGUARD,MESHES(NM)%JBAR+CCGUARD - DO IDUM=-CCGUARD,MESHES(NM)%IBAR+CCGUARD - IF(MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)>=ICF) & - MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF) + 1 - DO X1AXIS=IAXIS,KAXIS - IF(MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS)>=ICF) & - MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) = MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) + 1 - ENDDO - ENDDO - ENDDO -ENDDO -DO ICC=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - DO JCC=1,MESHES(NM)%CUT_CELL(ICC)%NCELL - DO IFC=1,MESHES(NM)%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = MESHES(NM)%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - IF(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) CYCLE - IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) = IFCX+1 - ENDDO - ENDDO - DO IFACE=1,MESHES(NM)%CUT_CELL(ICC)%NFACE_DROPPED - IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) - IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) = IFCX+1 + ! Set BIN boundaries and make initial allocation of TRI_LIST (here for SEGS) for each bin: + DELBIN = LXI / REAL(BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB) + BODINT_PLANE%TBAXIS(AXIS)%DELBIN = DELBIN + DO IBIN=1,BODINT_PLANE%TBAXIS(AXIS)%N_BINS + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_LOW = BODINT_PLANE%BOX( LOW_IND,AXIS) + REAL(IBIN-1,EB)*DELBIN + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_HIGH = BODINT_PLANE%BOX( LOW_IND,AXIS) + REAL(IBIN ,EB)*DELBIN + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL = 0 + IF(ALLOCATED(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST)) & + DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST) + ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(DELTA_SEGBIN)) ENDDO -ENDDO -DO ICE=1,MESHES(NM)%N_CUTEDGE_MESH - CE=>MESHES(NM)%CUT_EDGE(ICE) - DO IEDGE=1,CE%NEDGE - DO ILOC=-2,2 - IF(CE%FACE_LIST(1,ILOC,IEDGE)>=ICF) CE%FACE_LIST(1,ILOC,IEDGE)=CE%FACE_LIST(1,ILOC,IEDGE)+1 + ! Finally, populate TRI_LIST (here for SEGS) for AXIS bins: + DO ISEG=1,BODINT_PLANE%NSEGS + XIV(NOD1:NOD2) = BODINT_PLANE%XYZ(AXIS,BODINT_PLANE%SEGS(NOD1:NOD2,ISEG)) + XIV_LO = MINVAL(XIV(NOD1:NOD2)); XIV_HI = MAXVAL(XIV(NOD1:NOD2)) + AVAL = (XIV_LO-GEOMEPS-BODINT_PLANE%BOX(LOW_IND,AXIS))/DELBIN + ILO_BIN= MAX(1, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB),ABS(AVAL)) )) + AVAL = (XIV_HI+GEOMEPS-BODINT_PLANE%BOX(LOW_IND,AXIS))/DELBIN + IHI_BIN= MIN(BODINT_PLANE%TBAXIS(AXIS)%N_BINS, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB),ABS(AVAL)) )) + DO IBIN=ILO_BIN,IHI_BIN + NTL = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL + 1 + SZE = SIZE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST,DIM=1) + IF (NTL > SZE) THEN + ! Reallocate: + ALLOCATE(TRI_LIST(1:SZE)); TRI_LIST(1:SZE)=BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) + DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST) + ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE+DELTA_SEGBIN)) + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) = TRI_LIST(1:SZE) + DEALLOCATE(TRI_LIST) + ENDIF + ! Add Triangle index to BINs TRI_LIST + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL = NTL + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(NTL) = ISEG ENDDO ENDDO ENDDO -IF(PRESENT(INZONE)) THEN - IF (INZONE) THEN - DO KDUM=0,MESHES(NM)%KBP1 - DO JDUM=0,MESHES(NM)%JBP1 - DO IDUM=0,MESHES(NM)%IBP1 - DO JCC=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%NCELL - DO IFACE=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NWFACE - IF(MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE)>=ICF) & - MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) = & - MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) + 1 - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDIF -ENDIF - -IF(AXIS==0) THEN - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = ICF - MESHES(NM)%CUT_FACE(ICF)%STATUS = CC_INBOUNDARY -ELSE - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,AXIS) = CC_CUTCFE - MESHES(NM)%FCVAR(I,J,K,CC_IDCF,AXIS) = ICF - MESHES(NM)%CUT_FACE(ICF)%STATUS = CC_GASPHASE -ENDIF -MESHES(NM)%CUT_FACE(ICF)%IJK(1:4) = (/I, J, K, AXIS/) - -RETURN -END SUBROUTINE INSERT_CUT_FACE - -! --------------------------------- DROP_CUT_EDGE ------------------------------------------- - -SUBROUTINE DROP_CUT_EDGE(NM,ICE,JCE,ETYPE) -INTEGER, INTENT(IN) :: NM,ICE,JCE,ETYPE +! Add Segments intersections: +DO IBIN=1,BODINT_PLANE%TBAXIS(AXIS)%N_BINS + NTL = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL + ! Now double loop, cost O(1/2*NTL^2): + DO BISEG=1,NTL + ISEGV(EDG1) = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(BISEG) + SEGV(NOD1:NOD2,EDG1) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEGV(EDG1)) + P1(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1,EDG1)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1,EDG1))/) + D1(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD2,EDG1)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD2,EDG1))/) + D1 = D1 - P1 + S1_X2_MIN=MINVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG1))) + S1_X2_MAX=MAXVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG1))) + S1_X3_MIN=MINVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG1))) + S1_X3_MAX=MAXVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG1))) + DO BIISEG=BISEG+1,NTL + ! Test for segment-segment intersection: + ISEGV(EDG2) = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(BIISEG) + SEGV(NOD1:NOD2,EDG2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEGV(EDG2)) + P2(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1,EDG2)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1,EDG2))/) + D2(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD2,EDG2)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD2,EDG2))/) + D2 = D2 - P2 -INTEGER :: CT,DUM,ILH,ICF1,IEDGE -INTEGER, ALLOCATABLE, DIMENSION(:) :: IND -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTEDGE_TYPE), POINTER :: CE + ! Tests for quick discard: + IF( MAXVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG2)))+GEOMEPS < S1_X2_MIN) CYCLE + IF( MINVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG2)))-GEOMEPS > S1_X2_MAX) CYCLE + IF( MAXVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG2)))+GEOMEPS < S1_X3_MIN) CYCLE + IF( MINVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG2)))-GEOMEPS > S1_X3_MAX) CYCLE -IF(ICE<1) RETURN -M =>MESHES(NM) -CE=>M%CUT_EDGE(ICE) + ! Test for segment-segment intersection: + CALL GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) -NEDGE_IF_1 : IF(CE%NEDGE>1) THEN - ALLOCATE(IND(CE%NEDGE)); IND = 0 - CT=0; - DO DUM=1,CE%NEDGE - IF(DUM==JCE) CYCLE - CT = CT + 1 - IND(DUM) = CT - ENDDO - ! Collapse NEDGE variables: - DO DUM=1,CE%NEDGE - IF(DUM==JCE) CYCLE - CE%CEELEM( :,IND(DUM)) = CE%CEELEM( :,DUM) - CE%INDSEG( :,IND(DUM)) = CE%INDSEG( :,DUM) - CE%FACE_LIST(:,:,IND(DUM)) = CE%FACE_LIST(:,:,DUM) - CE%DXX( :,IND(DUM)) = CE%DXX( :,DUM) - - ! Finally change EDGE_LIST of involved faces: - DO ILH=-2,2 - ICF1 = CE%FACE_LIST(1,ILH,IND(DUM)); IF(ICF1<1) CYCLE - IEDGE = CE%FACE_LIST(3,ILH,IND(DUM)) - M%CUT_FACE(ICF1)%EDGE_LIST(3,IEDGE) = IND(DUM) - ENDDO - ENDDO -ENDIF NEDGE_IF_1 - -CE%NEDGE = CE%NEDGE - 1 -IF(CE%NEDGE < 1) THEN - IF(ETYPE==CC_ETYPE_CFGAS) THEN - M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_EGSC,CE%IJK(KAXIS+1)) = CC_SOLID - M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED - ELSEIF(ETYPE==CC_ETYPE_CFINB) THEN - IF(CE%IJK(KAXIS+1)>0) THEN - M%FCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED - ELSE - M%CCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE) = CC_UNDEFINED - ENDIF - ENDIF - CE%STATUS = CC_SOLID -ENDIF - -END SUBROUTINE DROP_CUT_EDGE - - -! ----------------------------- DROP_CUTFACE -------------------------------------- - -SUBROUTINE DROP_CUTFACE(NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC) + ! Now discard repeated intersections: + ! If crossing is already defined in SEG don't add: + DO ICROSS=1,INT_FLG + DO ISX = EDG1,EDG2 + SBOD = SVARV(ICROSS,ISX) + ! Discard intersections already present in segment, including ends: + INLIST = .FALSE. + DO ISVAR=1,BODINT_PLANE%NBCROSS(ISEGV(ISX)) + IF ( ABS(SBOD-BODINT_PLANE%SVAR(ISVAR,ISEGV(ISX))) < GEOMEPS ) THEN + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (INLIST) CYCLE -! Drop cut-face CUT_FACE(ICF)%CFELEM(:,JCF): -! 0. For garphase cut-faces, move gas edges (reg and cut) to INB face CUT_EDGEs where it corresponds. -! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). -! 2. Change second index for cut-faces of cells attached to ICF,JCF -! 3. If zero remaining cut-faces in CUT_FACE(ICF) => make FCVAR,CCVAR GSC and IDCF indexes SOLID and INDEFINED. + ! Add crossing to BODINT_PLANE, insertion sort: + NBCROSS = BODINT_PLANE%NBCROSS(ISEGV(ISX)) + 1 + ! Test-reallocate BODINT_PLANE%SVAR + NBCROSS_SVAR = SIZE(BODINT_PLANE%SVAR,DIM=1) + IF (NBCROSS > NBCROSS_SVAR) THEN + ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB + SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) + CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) + ENDIF + BODINT_PLANE%SVAR(NBCROSS,ISEGV(ISX)) = 1._EB/GEOMEPS + DO IBCR=1,NBCROSS + IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEGV(ISX)) ) EXIT + ENDDO + IBCR = MIN(IBCR,NBCROSS) -INTEGER, INTENT(IN) :: NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC + ! Here copy from the back (updated nbcross) to the ibcr location: + DO IDUM = NBCROSS,IBCR+1,-1 + BODINT_PLANE%SVAR(IDUM,ISEGV(ISX)) = BODINT_PLANE%SVAR(IDUM-1,ISEGV(ISX)) + ENDDO + BODINT_PLANE%SVAR(IBCR,ISEGV(ISX)) = SBOD + BODINT_PLANE%NBCROSS(ISEGV(ISX)) = NBCROSS -INTEGER :: CT,DUM,ILH,ICC1,JCC1,IFACE,IFC1,IFACE2 -INTEGER, ALLOCATABLE, DIMENSION(:) :: IND -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTFACE_TYPE), POINTER :: CF + ! Here we have an intersection inside a segment, note it in FACERT: + IF ( ISX==EDG1 ) THEN + ! X2AXIS, X3AXIS location of intersection: + XY(IAXIS:JAXIS) = P1(IAXIS:JAXIS) + SBOD*D1(IAXIS:JAXIS)/NORM2(D1(IAXIS:JAXIS)) + ELSE + ! X2AXIS, X3AXIS location of intersection: + XY(IAXIS:JAXIS) = P2(IAXIS:JAXIS) + SBOD*D2(IAXIS:JAXIS)/NORM2(D2(IAXIS:JAXIS)) + ENDIF + XPOS = XY(IAXIS) + IF ( X2NOC==0 ) THEN + JJ2_LO = FLOOR((XPOS-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + JJ2_HI = FLOOR((XPOS+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + IF (ALL((/JJ2_LO,JJ2_HI/) < X2LO_CELL) .OR. ALL((/JJ2_LO,JJ2_HI/) > X2HI_CELL)) CYCLE + JJ2_LO = MAX(JJ2_LO,X2LO_CELL); JJ2_HI = MIN(JJ2_HI,X2HI_CELL) + ELSE + FOUND_SEG = .FALSE.; JJ2_LO = -100; JJ2_HI = -100 + DO JJ2=X2LO_CELL,X2HI_CELL + ! Check if XPOS is within this segment JJ2: + IF ( ((XPOS-X2FACE(JJ2-1))>-GEOMEPS) .AND. ((X2FACE(JJ2)-XPOS)>-GEOMEPS) ) THEN + IF (JJ2_LO > -100) THEN + JJ2_HI = JJ2 + EXIT + ELSE + JJ2_LO = JJ2 + JJ2_HI = JJ2 + ENDIF + FOUND_SEG = .TRUE. + ENDIF + ENDDO + IF (.NOT.FOUND_SEG) CYCLE + ENDIF + XPOS = XY(JAXIS) + IF ( X3NOC==0 ) THEN + KK2_LO = FLOOR((XPOS-GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + KK2_HI = FLOOR((XPOS+GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + IF (ALL((/KK2_LO,KK2_HI/) < X3LO_CELL) .OR. ALL((/KK2_LO,KK2_HI/) > X3HI_CELL)) CYCLE + KK2_LO = MAX(KK2_LO,X3LO_CELL); KK2_HI = MIN(KK2_HI,X3HI_CELL) + ELSE + FOUND_SEG = .FALSE.; KK2_LO = -100; KK2_HI = -100 + DO KK2=X3LO_CELL,X3HI_CELL + ! Check if XPOS is within this segment KK2: + IF ( ((XPOS-X3FACE(KK2-1))>-GEOMEPS) .AND. ((X3FACE(KK2)-XPOS)>-GEOMEPS) ) THEN + IF (KK2_LO > -100) THEN + KK2_HI = KK2 + EXIT + ELSE + KK2_LO = KK2 + KK2_HI = KK2 + ENDIF + FOUND_SEG = .TRUE. + ENDIF + ENDDO + IF (.NOT.FOUND_SEG) CYCLE + ENDIF -M => MESHES(NM) -CF=> M%CUT_FACE(IFC) + ! Here JJ2 and KK2 have the face containing the intersection: + DO KK2=KK2_LO,KK2_HI + DO JJ2=JJ2_LO,JJ2_HI + FACERT(JJ2,KK2) = .TRUE. + ENDDO + ENDDO -! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). -NFACE_IF_1 : IF(CF%NFACE>1) THEN - ALLOCATE(IND(CF%NFACE)); IND = 0 - CT=0; - DO DUM=1,CF%NFACE - IF(DUM==JFC) CYCLE - CT = CT + 1 - IND(DUM) = CT - ENDDO - ! Collapse NFACE variables: - DO DUM=1,CF%NFACE - IF(DUM==JFC) CYCLE - CF%CFELEM( :,IND(DUM)) = CF%CFELEM( :,DUM) - CF%CEDGES( :,IND(DUM)) = CF%CEDGES( :,DUM) - CF%AREA( IND(DUM)) = CF%AREA( DUM) - CF%XYZCEN( :,IND(DUM)) = CF%XYZCEN( :,DUM) - CF%SHARED( IND(DUM)) = CF%SHARED( DUM) - CF%CELL_LIST(:,:,IND(DUM)) = CF%CELL_LIST(:,:,DUM) - ! Finally change FACE_LIST of involved cells: - CT = HIGH_IND - IF(FTYPE==CC_FTYPE_CFINB) THEN - CT = LOW_IND - CF%BODTRI( :,IND(DUM)) = CF%BODTRI( :,DUM) - CF%SURF_INDEX( IND(DUM)) = CF%SURF_INDEX( DUM) - CF%BLK_TAG( IND(DUM)) = CF%BLK_TAG( DUM) - CF%CFACE_ORIGIN( IND(DUM)) = CF%CFACE_ORIGIN( DUM) - CF%AREA_ADJUST( IND(DUM)) = CF%AREA_ADJUST( DUM) - ENDIF - DO ILH=LOW_IND,CT - ICC1 = CF%CELL_LIST(2,ILH,IND(DUM)) - JCC1 = CF%CELL_LIST(3,ILH,IND(DUM)) - IFC1 = CF%CELL_LIST(4,ILH,IND(DUM)) - IFACE= M%CUT_CELL(ICC1)%CCELEM(IFC1+1,JCC1) - ! Dropping gas-cut cells, do not reindex local JCF for INBOUNDARY faces. These have been changed already. - IF(FTYPE==CC_FTYPE_CFINB .OR. (FTYPE==CC_FTYPE_CFGAS .AND. M%CUT_CELL(ICC1)%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB)) & - M%CUT_CELL(ICC1)%FACE_LIST(5,IFACE) = IND(DUM) - DO IFACE2=1,M%CUT_CELL(ICC1)%NFACE_DROPPED - IF(M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & - M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(4,IFACE2)==IFC .AND. & - M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)==DUM) & - M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)=IND(DUM) + ENDDO ENDDO ENDDO ENDDO - CF%CFELEM( :,CF%NFACE) = CC_UNDEFINED - CF%CEDGES( :,CF%NFACE) = CC_UNDEFINED - CF%AREA( CF%NFACE) = 0._EB - CF%XYZCEN( :,CF%NFACE) = 0._EB - CF%SHARED( CF%NFACE) = .FALSE. - CF%BLK_TAG( CF%NFACE) = .FALSE. - CF%CELL_LIST(:,:,CF%NFACE) = CC_UNDEFINED - IF(FTYPE==CC_FTYPE_CFINB) THEN - CF%BODTRI( :,CF%NFACE) = CC_UNDEFINED - CF%SURF_INDEX( CF%NFACE) = CC_UNDEFINED - CF%CFACE_ORIGIN( CF%NFACE) = CC_UNDEFINED - ENDIF - DEALLOCATE(IND) -ENDIF NFACE_IF_1 +ENDDO -CF%NFACE = MAX(0,CF%NFACE - 1) -IF(FTYPE==CC_FTYPE_CFGAS .AND. CF%NSFACE>0) THEN ! Bring down SOLID faces used for SLCF plotting. - CT=CF%NFACE - DO DUM=1,CF%NSFACE - CT=CT+1 - CF%CFELEM( :,CT) = CF%CFELEM( :,CT+1) - CF%CEDGES( :,CT) = CF%CEDGES( :,CT+1) - CF%AREA( CT) = CF%AREA( CT+1) - CF%XYZCEN( :,CT) = CF%XYZCEN( :,CT+1) - ENDDO -ENDIF +! Loop nodes and test in SEG_NODES: if more than 2 segments end in the +! node, note it in FACERT. +MAX_SEG_NODE = MAXVAL(SEGS_NODE(1:BODINT_PLANE%NNODS)) +ALLOCATE(ISEG_NODE(MAX_SEG_NODE+1,BODINT_PLANE%NNODS)); ISEG_NODE = 0 +ALLOCATE(ANGS_NODE(MAX_SEG_NODE ,BODINT_PLANE%NNODS)); ANGS_NODE = 0._EB +ANGNODE_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS + ! End nodes to cross: + IF( ANY(BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG)/=CC_GASPHASE) ) THEN + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + DX2 = BODINT_PLANE%XYZ(X2AXIS,SEG(NOD2))-BODINT_PLANE%XYZ(X2AXIS,SEG(NOD1)) + DX3 = BODINT_PLANE%XYZ(X3AXIS,SEG(NOD2))-BODINT_PLANE%XYZ(X3AXIS,SEG(NOD1)) + NOD_LOOP : DO INOD=NOD1,NOD2 + ! Compute angle, for NOD2 the seg andgle is -ANG. + ANG=REAL(NOD2-INOD,EB)*ATAN2(DX3,DX2) + REAL(INOD-NOD1,EB)*ATAN2(-DX3,-DX2) + IF(ANG < 0._EB) ANG = ANG + TWOPI ! Make angle from 0 to 2*pi. + ! Insert-add segment into ISEG_NODE depending on angle value: + NSN = ISEG_NODE(1,SEG(INOD)) + ISEG_NODE(1 ,SEG(INOD)) = NSN+1 + FOUND_SEG=.FALSE.; ISEG2=1 + IF (NSN>0) THEN + DO ISEG2=1,NSN + IF (ANGS_NODE(ISEG2,SEG(INOD)) > ANG) THEN + FOUND_SEG=.TRUE.; EXIT + ENDIF + ENDDO + ENDIF + IF (FOUND_SEG) THEN + DO ISEG3=NSN+1,ISEG2+1,-1 + ISEG_NODE(ISEG3+1,SEG(INOD)) = ISEG_NODE(ISEG3 ,SEG(INOD)) + ANGS_NODE(ISEG3 ,SEG(INOD)) = ANGS_NODE(ISEG3-1,SEG(INOD)) + ENDDO + ENDIF + ISEG_NODE(ISEG2+1,SEG(INOD)) = ISEG + ANGS_NODE(ISEG2 ,SEG(INOD)) = ANG + ENDDO NOD_LOOP + ENDIF +ENDDO ANGNODE_LOOP -IF(CF%NFACE < 1) THEN - CF%STATUS = CC_SOLID - CF%NSFACE = 0 - IF (FTYPE == CC_FTYPE_CFGAS) THEN - SELECT CASE(X1AXIS) - CASE(IAXIS) - M%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - M%ECVAR(I+ILHF,J-1:J,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J-1:J,K,CC_IDCE,KAXIS) = CC_UNDEFINED - M%ECVAR(I+ILHF,J,K-1:K,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J,K-1:K,CC_IDCE,JAXIS) = CC_UNDEFINED - CASE(JAXIS) - M%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - M%ECVAR(I-1:I,J+ILHF,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I-1:I,J+ILHF,K,CC_IDCE,KAXIS) = CC_UNDEFINED - M%ECVAR(I,J+ILHF,K-1:K,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J+ILHF,K-1:K,CC_IDCE,IAXIS) = CC_UNDEFINED - CASE(KAXIS) - M%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED - M%ECVAR(I-1:I,J,K+ILHF,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I-1:I,J,K+ILHF,CC_IDCE,JAXIS) = CC_UNDEFINED - M%ECVAR(I,J-1:J,K+ILHF,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J-1:J,K+ILHF,CC_IDCE,IAXIS) = CC_UNDEFINED - END SELECT - ELSEIF (FTYPE == CC_FTYPE_CFINB) THEN - M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED - ENDIF -ENDIF - -RETURN -END SUBROUTINE DROP_CUTFACE - - -! ----------------------------- DROP_CUTCELL -------------------------------------- - -SUBROUTINE DROP_CUTCELL(NM,ICC,JCC) +ALLOCATE(CIRC_MED(MAX_SEG_NODE+1)) +INOD_LOOP : DO INOD = 1,BODINT_PLANE%NNODS + IF (SEGS_NODE(INOD) < 3) CYCLE INOD_LOOP -! Remove cut-cell CUT_CELL(ICC)%CCELEM(:,JCC): -! 1. If CUT_CELL(ICC)%NCELL==1 drop INBOUNDARY faces of ICC,JCC, make CCVAR CGSC SOLID and IDCC,IDCF undefined. -! 2. If more than 1 NCELL, drop JCc from CCELEM, IJK_LINK, LINK_LEV, VOLUME, XYZCEN lists and NCELL=NCELL-1 + ! Test case of even number of segments: + IF (MOD(SEGS_NODE(INOD),2)==0) THEN ! Case of even number of segments. + ! Test if circling around the node we have media discontinuity. + NSN=ISEG_NODE(1,INOD); COUNT=0 + DO ISEG2=2,NSN+1 + ISEG =ISEG_NODE(ISEG2,INOD) + COUNT=COUNT+1 + SEG = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + IF (INOD==SEG(NOD2)) THEN + CIRC_MED(COUNT) = BODINT_PLANE%SEGTYPE(NOD2,ISEG) + ELSE + CIRC_MED(COUNT) = BODINT_PLANE%SEGTYPE(NOD1,ISEG) + ENDIF + ENDDO + CIRC_MED(COUNT+1)=CIRC_MED(1) + CRS_FLG=.FALSE. + DO COUNT=1,NSN + IF(CIRC_MED(COUNT)==CIRC_MED(COUNT+1)) THEN + CRS_FLG=.TRUE.; EXIT + ENDIF + ENDDO + IF (.NOT.CRS_FLG) CYCLE INOD_LOOP + ENDIF -INTEGER, INTENT(IN) :: NM,ICC,JCC + ! X2AXIS, X3AXIS location of intersection: + XY(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,INOD), BODINT_PLANE%XYZ(X3AXIS,INOD)/) + XPOS = XY(IAXIS) + IF ( X2NOC==0 ) THEN + JJ2_LO = FLOOR((XPOS-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + JJ2_HI = FLOOR((XPOS+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + IF (ALL((/JJ2_LO,JJ2_HI/) < X2LO_CELL) .OR. ALL((/JJ2_LO,JJ2_HI/) > X2HI_CELL)) CYCLE INOD_LOOP + JJ2_LO = MAX(JJ2_LO,X2LO_CELL); JJ2_HI = MIN(JJ2_HI,X2HI_CELL) + ELSE + FOUND_SEG = .FALSE.; JJ2_LO = -100; JJ2_HI = -100 + DO JJ2=X2LO_CELL,X2HI_CELL + ! Check if XPOS is within this segment JJ2: + IF ( ((XPOS-X2FACE(JJ2-1))>-GEOMEPS) .AND. ((X2FACE(JJ2)-XPOS)>-GEOMEPS) ) THEN + IF (JJ2_LO > -100) THEN + JJ2_HI = JJ2 + EXIT + ELSE + JJ2_LO = JJ2 + JJ2_HI = JJ2 + ENDIF + FOUND_SEG = .TRUE. + ENDIF + ENDDO + IF (.NOT.FOUND_SEG) CYCLE INOD_LOOP + ENDIF + XPOS = XY(JAXIS) + IF ( X3NOC==0 ) THEN + KK2_LO = FLOOR((XPOS-GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + KK2_HI = FLOOR((XPOS+GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + IF (ALL((/KK2_LO,KK2_HI/) < X3LO_CELL) .OR. ALL((/KK2_LO,KK2_HI/) > X3HI_CELL)) CYCLE INOD_LOOP + KK2_LO = MAX(KK2_LO,X3LO_CELL); KK2_HI = MIN(KK2_HI,X3HI_CELL) + ELSE + FOUND_SEG = .FALSE.; KK2_LO = -100; KK2_HI = -100 + DO KK2=X3LO_CELL,X3HI_CELL + ! Check if XPOS is within this segment KK2: + IF ( ((XPOS-X3FACE(KK2-1))>-GEOMEPS) .AND. ((X3FACE(KK2)-XPOS)>-GEOMEPS) ) THEN + IF (KK2_LO > -100) THEN + KK2_HI = KK2 + EXIT + ELSE + KK2_LO = KK2 + KK2_HI = KK2 + ENDIF + FOUND_SEG = .TRUE. + ENDIF + ENDDO + IF (.NOT.FOUND_SEG) CYCLE INOD_LOOP + ENDIF -! Local Variables -INTEGER :: I,J,K,JCC2,IFC,CT -INTEGER, ALLOCATABLE, DIMENSION(:) :: IND -TYPE(MESH_TYPE), POINTER :: M -M => MESHES(NM) + ! Here JJ2 and KK2 have the face containing the intersection: + DO KK2=KK2_LO,KK2_HI + DO JJ2=JJ2_LO,JJ2_HI + FACERT(JJ2,KK2) = .TRUE. + ENDDO + ENDDO +ENDDO INOD_LOOP +DEALLOCATE(SEGS_NODE,ISEG_NODE,ANGS_NODE,CIRC_MED) -I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS) +T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) = T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) + CURRENT_TIME() - TNOW -! Check if JCC is the only cut-cell in CUT_CELL(ICC): -IF (M%CUT_CELL(ICC)%NCELL==1) THEN - ! Set cut-cell to solid - M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID - M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED - M%CUT_CELL(ICC)%NCELL = 0 - ! Then drop INBOUNDARY cut-faces in I,J,K if there are any left: - IFC=M%CCVAR(I,J,K,CC_IDCF) - IF (IFC>0) THEN - M%CUT_FACE(IFC)%STATUS = CC_SOLID - M%CUT_FACE(IFC)%NFACE = 0 +IF (DEBUG_SET_CUTCELLS) THEN + ! Write out: + IF(INDX1 < 0) THEN + WRITE(BIPL_FILE,'(A,A,I3.3,A,I1.1,A,I2.1,A)') TRIM(CHID),'_BODINT_PLANE_',MY_RANK,'_',X1AXIS,'_',INDX1,'.csv' + ELSE + WRITE(BIPL_FILE,'(A,A,I3.3,A,I1.1,A,I2.2,A)') TRIM(CHID),'_BODINT_PLANE_',MY_RANK,'_',X1AXIS,'_',INDX1,'.csv' ENDIF - M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED - RETURN + LU_DB_SETCC = GET_FILE_NUMBER() + OPEN(LU_DB_SETCC,FILE=TRIM(BIPL_FILE),STATUS='UNKNOWN') + WRITE(LU_DB_SETCC,*) 'X1AXIS,X2AXIS,X3AXIS,X1PLN,GEOMEPS' + WRITE(LU_DB_SETCC,*) X1AXIS,X2AXIS,X3AXIS,X1PLN,GEOMEPS + WRITE(LU_DB_SETCC,*) 'NNODS, NSEGS, NSGLS, NTRIS' + WRITE(LU_DB_SETCC,*) BODINT_PLANE%NNODS,BODINT_PLANE%NSEGS,BODINT_PLANE%NSGLS,BODINT_PLANE%NTRIS + DO INOD=1,BODINT_PLANE%NNODS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%XYZ(IAXIS:KAXIS,INOD) + END DO + DO INOD=1,BODINT_PLANE%NNODS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%NOD_PERM(INOD) + ENDDO + DO ISEG=1,BODINT_PLANE%NSEGS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + END DO + DO ISEG=1,BODINT_PLANE%NSEGS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) + END DO + DO ISGL=1,BODINT_PLANE%NSGLS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%SGLS(NOD1,ISGL) + END DO + DO ITRI=1,BODINT_PLANE%NTRIS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) + ENDDO + CLOSE(333) ENDIF -! First count: -ALLOCATE(IND(1:M%CUT_CELL(ICC)%NCELL)); IND=0 -CT=0 -DO JCC2=1,M%CUT_CELL(ICC)%NCELL - IF (JCC2==JCC) CYCLE - CT = CT + 1 - IND(JCC2) = CT -ENDDO - -! Then drop JCC: -DO JCC2=1,M%CUT_CELL(ICC)%NCELL - IF (JCC2==JCC) CYCLE - M%CUT_CELL(ICC)%CCELEM(:,IND(JCC2)) = M%CUT_CELL(ICC)%CCELEM(:,JCC2) - M%CUT_CELL(ICC)%IJK_LINK(:,IND(JCC2)) = M%CUT_CELL(ICC)%IJK_LINK(:,JCC2) - M%CUT_CELL(ICC)%LINK_LEV(IND(JCC2)) = M%CUT_CELL(ICC)%LINK_LEV(JCC2) - M%CUT_CELL(ICC)%VOLUME(IND(JCC2)) = M%CUT_CELL(ICC)%VOLUME(JCC2) - M%CUT_CELL(ICC)%XYZCEN(:,IND(JCC2)) = M%CUT_CELL(ICC)%XYZCEN(:,JCC2) - M%CUT_CELL(ICC)%NOADVANCE(IND(JCC2)) = M%CUT_CELL(ICC)%NOADVANCE(JCC2) -ENDDO - -M%CUT_CELL(ICC)%NCELL = M%CUT_CELL(ICC)%NCELL - 1 - -DEALLOCATE(IND) - RETURN -END SUBROUTINE DROP_CUTCELL +END SUBROUTINE GET_BODINT_PLANE -! -------------------------- GET_CELL_LINK_INFO ----------------------------------- -SUBROUTINE GET_CELL_LINK_INFO(NM) +! ------------------------ GET_SEGSEG_INTERSECTION ------------------------------ -! Small cell linking subroutine in the mesh. Builds linking information for cutcell ICC,JCC: -! CUT_CELL(ICC)%IJK_LINK(1:KAXIS+2,JCC) of cell linked to, and CUT_CELL(ICC)%LINK_LEV(JCC) level within link tree. +SUBROUTINE GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) -INTEGER, INTENT(IN) :: NM +REAL(EB), INTENT(IN) :: P1(IAXIS:JAXIS),D1(IAXIS:JAXIS),P2(IAXIS:JAXIS),D2(IAXIS:JAXIS) +REAL(EB), INTENT(OUT):: SVARV(NOD1:NOD2,EDG1:EDG2), SLENV(EDG1:EDG2) +INTEGER, INTENT(OUT):: INT_FLG ! Local Variables: -INTEGER :: ICC,JCC,ICC2,JCC2,JCC_LNK,I,J,K,I_LNK,J_LNK,K_LNK,IFC,IFC2,IFACE,IFACE2,IFACE3,IBOD,IWSEL,VAL_UNKZ,& - LINK_ITER,INGH,JNGH,KNGH,X1AXIS,ILH,INRM(1:3),DUM,LNK_LEV,ULINK_COUNT,LINK_LEV_UP,AX_MIN,AX_OTHERS(2) -REAL(EB):: AREA,AF,NRML(IAXIS:KAXIS),VAL_CVOL,CCVOL_THRES, XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND),& - MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND:HIGH_IND),CELL_DELTA(IAXIS:KAXIS) -LOGICAL :: QUITLINK_FLG,CRTCELL_FLG,MASK(IAXIS:KAXIS),BLOCK_SLIM_IF,SOLID_FACES -CHARACTER(MESSAGE_LENGTH) :: UNLINKED_FILE -INTEGER, SAVE :: LU_UNLNK -LOGICAL, SAVE :: UNLINKED_1ST_CALL=.TRUE. -TYPE (MESH_TYPE), POINTER :: M -TYPE (CC_CUTCELL_TYPE), POINTER :: CC +REAL(EB) :: SVR, TVR, KRS, KRS2, E2, L12, L22, E(IAXIS:JAXIS), S1, S2, SMIN, SMAX -M => MESHES(NM) +! Test for segment-segment intersection: +E(IAXIS:JAXIS) = P2(IAXIS:JAXIS) - P1(IAXIS:JAXIS) +KRS = D1(IAXIS)*D2(JAXIS) - D1(JAXIS)*D2(IAXIS); KRS2=KRS**2._EB +L12 = D1(IAXIS)**2._EB + D1(JAXIS)**2._EB +L22 = D2(IAXIS)**2._EB + D2(JAXIS)**2._EB +! Case of segments not parallel. +IF ( KRS2 > GEOMEPS**2._EB*L12*L22) THEN + SVR = (E(IAXIS)*D2(JAXIS)-E(JAXIS)*D2(IAXIS))/ KRS + IF ( (SVR<-GEOMEPS) .OR. ((SVR-1._EB)>GEOMEPS) ) THEN + ! intersection not a point of segment SEG. + INT_FLG = 0 + RETURN + ENDIF + TVR = (E(IAXIS)*D1(JAXIS)-E(JAXIS)*D1(IAXIS))/ KRS + IF ( (TVR<-GEOMEPS) .OR. ((TVR-1._EB)>GEOMEPS) ) THEN + ! intersection not a point of segment SEG2. + INT_FLG = 0 + RETURN + ENDIF + ! Intersection a point on SEG and SEG2. + SLENV(EDG1) = SQRT(L12) + SLENV(EDG2) = SQRT(L22) + SVARV(NOD1,EDG1) = SVR*SLENV(EDG1) + SVARV(NOD1,EDG2) = TVR*SLENV(EDG2) + INT_FLG=1 + RETURN +ENDIF -! Initialize UNKZ, used here to define if cell has been noted in linking hierarchy. Assume CCVAR has been allocated: -M%CCVAR(:,:,:,CC_UNKZ) = CC_UNDEFINED -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC); I=CC%IJK(IAXIS); J=CC%IJK(JAXIS); K=CC%IJK(KAXIS) - ! Test for sliver trapped cells blocking: - XYZCELL(IAXIS,LOW_IND) = XFACE(I-1); XYZCELL(IAXIS,HIGH_IND) = XFACE(I); - XYZCELL(JAXIS,LOW_IND) = YFACE(J-1); XYZCELL(JAXIS,HIGH_IND) = YFACE(J); - XYZCELL(KAXIS,LOW_IND) = ZFACE(K-1); XYZCELL(KAXIS,HIGH_IND) = ZFACE(K); - MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) - MINMAX_XYZ_CC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) - DO JCC=1,CC%NCELL - ! Get cut-cell bounding box: - CALL CUT_CELL_BOUNDING_BOX(NM,ICC,JCC,XYZCELL,MINMAX_XYZ_CC) - ! Perform Tests: - DO DUM=IAXIS,KAXIS - CELL_DELTA(DUM) = ABS(MINMAX_XYZ_CC(DUM,HIGH_IND)-MINMAX_XYZ_CC(DUM,LOW_IND)) - ENDDO - ! Axis with minimum width: - AX_MIN = MINLOC(CELL_DELTA(IAXIS:KAXIS),DIM=1) - SELECT CASE(AX_MIN) - CASE(IAXIS); AX_OTHERS(1:2) = (/ JAXIS, KAXIS /); SOLID_FACES = ALL(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_SOLID) - CASE(JAXIS); AX_OTHERS(1:2) = (/ IAXIS, KAXIS /); SOLID_FACES = ALL(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_SOLID) - CASE(KAXIS); AX_OTHERS(1:2) = (/ IAXIS, JAXIS /); SOLID_FACES = ALL(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_SOLID) - END SELECT - ! Perform Test: - BLOCK_SLIM_IF = (CELL_DELTA(AX_MIN)<10._EB*MIN_LENGTH_FACTOR*CELL_DELTA(AX_OTHERS(1))) .AND. & - (CELL_DELTA(AX_MIN)<10._EB*MIN_LENGTH_FACTOR*CELL_DELTA(AX_OTHERS(2))) - IF(BLOCK_SLIM_IF .AND. SOLID_FACES) CC%NOADVANCE(JCC) = BLOCKED_SMALL_CELL - ENDDO - CC%UNKZ(:) = CC_UNDEFINED - DO JCC=1,CC%NCELL - IF (CC%NOADVANCE(JCC)>0) CC%IJK_LINK(1,JCC) = CC_SOLID - ENDDO -ENDDO +! Parallel Segments: +E2 = E(IAXIS)**2._EB + E(JAXIS)**2._EB +KRS= E(IAXIS)*D1(JAXIS) - E(JAXIS)*D1(IAXIS); KRS2=KRS**2._EB +IF ( KRS2 > GEOMEPS**2._EB*L12*E2 ) THEN + ! Segments are different. + INT_FLG = 0 + RETURN +ENDIF +! Segment lines are the same. +S1 = DOT_PRODUCT(D1,E)/L12; S2 = S1+DOT_PRODUCT(D1,D2)/L12 +SMIN=MIN(S1,S2); SMAX=MAX(S1,S2) +IF ( (1._EB+GEOMEPS) < SMIN .OR. (0._EB-GEOMEPS) > SMAX) THEN + INT_FLG = 0 + RETURN +ENDIF +! Overlap tests: +SLENV(EDG1) = SQRT(L12) +SLENV(EDG2) = SQRT(L22) +IF ( (1._EB+GEOMEPS) > SMIN ) THEN ! SMIN between P1 and P1+D1 + IF ( (0._EB-GEOMEPS) < SMAX) THEN ! SMAX greater that P1 + IF (0._EB < SMIN) THEN ! SMIN higher that P1 + SVARV(NOD1,EDG1) = SMIN*SLENV(EDG1) ! First crossing on P1-P1+D1 + IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN ! SMIN is P2 + SVARV(NOD1,EDG2)=0._EB ! First crossing in P2-P2+D2 + ELSE ! SMIN is P2+D2 + SVARV(NOD2,EDG2)=1._EB*SLENV(EDG2) ! Second crossing in P2-P2+D2 + ENDIF + ELSE ! SMIN lower than P1 + SVARV(NOD1,EDG1) = 0._EB ! First crossing in P1-P1+D1 + IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN ! SMIN os P2 + SVARV(NOD1,EDG2)=-SMIN*SLENV(EDG1) ! First crossing in P2-P2-D2 + ELSE + SVARV(NOD2,EDG2)=SMAX*SLENV(EDG1) + ENDIF + ENDIF + IF (1._EB > SMAX) THEN + SVARV(NOD2,EDG1) = SMAX*SLENV(EDG1) + IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN ! SMAX is P2 + SVARV(NOD1,EDG2)=0._EB*SLENV(EDG2) + ELSE + SVARV(NOD2,EDG2)=1._EB*SLENV(EDG2) + ENDIF + ELSE + SVARV(NOD2,EDG1) = 1._EB*SLENV(EDG1) + IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN ! SMAX is P2 + SVARV(NOD1,EDG2)=(SMAX-1._EB)*SLENV(EDG1) + ELSE + SVARV(NOD2,EDG2)=(1._EB-SMIN)*SLENV(EDG1) + ENDIF + ENDIF + INT_FLG = 2 + ELSE + ! SMAX = 0._EB + SVARV(NOD1,EDG1) = 0._EB + IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN + SVARV(NOD1,EDG2) = 0._EB + ELSE + SVARV(NOD1,EDG2) = 1._EB*SLENV(EDG2) + ENDIF + INT_FLG = 1 + ENDIF +ELSE + ! SMIN = 1._EB + SVARV(NOD1,EDG1) = 1._EB*SLENV(EDG1) + IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN + SVARV(NOD1,EDG2) = 0._EB + ELSE + SVARV(NOD1,EDG2) = 1._EB*SLENV(EDG2) + ENDIF + INT_FLG = 1 +ENDIF -! Loop on Cartesian cells, number unknowns for cells type CC_CUTCFE and surrounding CC_GASPHASE: -DO K=0,M%KBP1 - DO J=0,M%JBP1 - DO I=0,M%IBP1 - IF ( M%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE - ! First Add the Cut-Cell - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF (ICC <= M%N_CUTCELL_MESH .AND. .NOT. M%CELL(M%CELL_INDEX(I,J,K))%SOLID ) THEN ! Don't number GC cut-cells, - ! or cutcells inside an OBST. - CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) - DO JCC=1,M%CUT_CELL(ICC)%NCELL - IF ( M%CUT_CELL(ICC)%NOADVANCE(JCC)>0 ) CYCLE - IF ( M%CUT_CELL(ICC)%VOLUME(JCC) > CCVOL_THRES) M%CUT_CELL(ICC)%UNKZ(JCC) = 1 - ENDDO - ENDIF - ! Run over Neighbors: Case 27 cells. Only Internal cells for the mesh in the stencil (I-1:I+1,J-1:J+1,K-1:K+1) - ! around Cartesian cell I,J,K of type CC_CUTCFE: - DO KNGH=K-1,K+1 - IF ( (KNGH < 1) .OR. (KNGH > M%KBAR) ) CYCLE - DO JNGH=J-1,J+1 - IF ( (JNGH < 1) .OR. (JNGH > M%JBAR) ) CYCLE - DO INGH=I-1,I+1 - ! Either not GASPHASE or already counted: - IF ((M%CCVAR(INGH,JNGH,KNGH,CC_CGSC)/=CC_GASPHASE) .OR. (M%CCVAR(INGH,JNGH,KNGH,CC_UNKZ)>0)) CYCLE - IF ( (INGH < 1) .OR. (INGH > M%IBAR) ) CYCLE - IF (M%CELL(CELL_INDEX(INGH,JNGH,KNGH))%SOLID) CYCLE - M%CCVAR(INGH,JNGH,KNGH,CC_UNKZ) = 1 - ENDDO - ENDDO - ENDDO +RETURN +END SUBROUTINE GET_SEGSEG_INTERSECTION - ENDDO - ENDDO -ENDDO +! -------------------------- GET_X2INTERSECTIONS -------------------------------- -! Now link small cells to surrounding cells in the mesh: -! NOTE: This scheme links two unknowns local to the mesh, therefore parallel consistency is not maintained. -! 1. Try linking them to adjacent regular cell with UNKZ > 0. Attempt going in surface normal direction first. -! 2. Try linking to adjacent cut-cell with UNKZ > 0. Attempt going in surface normal direction first. -! 3. If cut-cell could not be linked after N_LINK_ATTMP, block it. -LINK_ITER = 0; LINK_LEV_UP = 0 -LINK_LOOP : DO ! Cut-cell linking loop for small cells. -> Algo defined by CCVOL_LINK. - QUITLINK_FLG = .TRUE. +SUBROUTINE GET_X2_INTERSECTIONS(X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN) - IF (LINK_ITER==0) THEN - ICC_LOOP_1 : DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) +INTEGER, INTENT(IN) :: X1AXIS, X2AXIS, X3AXIS +REAL(EB),INTENT(IN) :: X3RAY,X1PLN - JCC_LOOP_1 : DO JCC=1,CC%NCELL - IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE - CRTCELL_FLG = .FALSE. - VAL_UNKZ = CC_UNDEFINED - VAL_CVOL = CCVOL_THRES - ! Find area averaged body surface normal: - NRML(IAXIS:KAXIS) = 0._EB; AREA = 0._EB - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE - IFC2 = CC%FACE_LIST(4,IFACE) - IFACE2 = CC%FACE_LIST(5,IFACE) - IBOD = M%CUT_FACE(IFC2)%BODTRI(1,IFACE2) - IWSEL = M%CUT_FACE(IFC2)%BODTRI(2,IFACE2) - AF = M%CUT_FACE(IFC2)%AREA( IFACE2) - NRML(IAXIS:KAXIS) = NRML(IAXIS:KAXIS) + GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL)*AF - AREA = AREA + AF - ENDDO +! Local Variables: +INTEGER :: ISGL, SGL, ISEG, SEG(NOD1:NOD2) +REAL(EB):: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, DOT1, DOT2 +REAL(EB):: SVARI, STANI(IAXIS:JAXIS) +INTEGER :: ICRSI(LOW_IND:HIGH_IND+1), SCRSI, ISSEG(LOW_IND:HIGH_IND), GAM(LOW_IND:HIGH_IND) +REAL(EB):: X3MIN, X3MAX, DV12(MAX_DIM), MODTI, NOMLI(IAXIS:JAXIS) +LOGICAL :: OUTRAY +REAL(EB):: DELBIN, AVAL +INTEGER :: ILO_BIN,IHI_BIN,IBIN,IISEG,ICR - ! With the surface normal search for a Regular Gasphase face in that direction. - AREA_IF_1 : IF (AREA > TWENTY_EPSILON_EB) THEN - NRML = NRML / AREA ! Normalize unit vector: - ! Normalize NRML vector to LINK_DIGITS: - DO DUM=IAXIS,KAXIS - NRML(DUM) = REAL(INT(LINK_FCT*NRML(DUM)),EB)/LINK_FCT - ENDDO - MASK(IAXIS:KAXIS) = .TRUE. - INRM(1) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(1))=.FALSE. - INRM(2) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(2))=.FALSE. - INRM(3) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1) - AXIS_LOOP_1 : DO DUM=IAXIS,KAXIS - X1AXIS=INRM(DUM) - IFC_LOOP_1 : DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND - IF( (X1AXIS /= CC%FACE_LIST(3,IFACE)) .OR. & - (CC%FACE_LIST(1,IFACE) /= CC_FTYPE_RCGAS) .OR. & - (ILH /= INT(SIGN(1._EB,NRML(X1AXIS)))) ) CYCLE IFC_LOOP_1 - SELECT CASE(X1AXIS) - CASE(IAXIS) - I_LNK = I+ILH; J_LNK = J; K_LNK = K - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - CASE(JAXIS) - I_LNK = I; J_LNK = J+ILH; K_LNK = K - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - CASE(KAXIS) - I_LNK = I; J_LNK = J; K_LNK = K+ILH - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - END SELECT - IF ( CRTCELL_FLG ) EXIT AXIS_LOOP_1 - ENDDO IFC_LOOP_1 - ENDDO AXIS_LOOP_1 - ENDIF AREA_IF_1 +REAL(EB) :: TNOW +! INTEGER :: IAUX - ! If not successful try any Regular Gasphase face. - ! Small cells, get CC_UNKZ from a large cell neighbor: - IF (.NOT. CRTCELL_FLG) THEN - IFC_LOOP_2 : DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - ILH = 2*CC%FACE_LIST(2,IFACE) - 3 - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE IFC_LOOP_2 - X1AXIS = CC%FACE_LIST(3,IFACE) - SELECT CASE(X1AXIS) - CASE(IAXIS) - I_LNK = I+ILH; J_LNK = J; K_LNK = K - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - CASE(JAXIS) - I_LNK = I; J_LNK = J+ILH; K_LNK = K - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - CASE(KAXIS) - I_LNK = I; J_LNK = J; K_LNK = K+ILH - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - END SELECT - IF ( CRTCELL_FLG ) EXIT IFC_LOOP_2 - ENDDO IFC_LOOP_2 - ENDIF - IF (VAL_UNKZ>0) THEN - CC%FACE_LIST(6,IFACE) = INTEGER_ONE ! This face is shared with master. - CC%UNKZ(JCC) = VAL_UNKZ !(/ Cell Type, I, J, K, JCC_LNK /) - CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_GASPHASE, I_LNK, J_LNK, K_LNK, 0 /) - CC%LINK_LEV(JCC) = -1 ! One link hierarchy level below regular cells (at LNK_LEV=0). - ENDIF - ENDDO JCC_LOOP_1 - ENDDO ICC_LOOP_1 - ENDIF +TNOW = CURRENT_TIME() +! Initialize crossings arrays: +CC_N_CRS = 0 +CC_SVAR_CRS = 1._EB / GEOMEPS +CC_IS_CRS = CC_UNDEFINED +CC_IS_CRS2 = CC_UNDEFINED +CC_SEG_TAN = 0._EB +CC_SEG_CRS = 0 +CC_BDNUM_CRS = 0 ! Size (0:CC_MAXCROSS_X2) +CC_BDNUM_CRS_AUX= 0 ! Size (0:CC_MAXCROSS_X2) - ! Then attempt to connect to large cut-cells, or already connected small cells (CUT_CELL(ICC)%UNKZ(JCC) > 0): - ICC_LOOP_2 : DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) - - JCC_LOOP_2 : DO JCC=1,CC%NCELL - IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE - VAL_UNKZ = CC_UNDEFINED - VAL_CVOL = -GEOMEPS +! First Single points: +! Treat them as [GASPHASE GASPHASE] crossings: +DO ISGL=1,BODINT_PLANE%NSGLS + SGL = BODINT_PLANE%SGLS(NOD1,ISGL) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SGL) + ! x2-x3 coordinates of point: + X2_1 = XYZ1(X2AXIS) + X3_1 = XYZ1(X3AXIS) - ! Find area averaged body surface normal: - NRML(IAXIS:KAXIS) = 0._EB; AREA = 0._EB - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE - IFC2 = CC%FACE_LIST(4,IFACE) - IFACE2 = CC%FACE_LIST(5,IFACE) - IBOD = M%CUT_FACE(IFC2)%BODTRI(1,IFACE2) - IWSEL = M%CUT_FACE(IFC2)%BODTRI(2,IFACE2) - AF = M%CUT_FACE(IFC2)%AREA( IFACE2) - NRML(IAXIS:KAXIS) = NRML(IAXIS:KAXIS) + GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL)*AF - AREA = AREA + AF - ENDDO + ! Dot product dot(X_1-XRAY,e3) + DOT1 = X3_1-X3RAY + IF (ABS(DOT1) <= GEOMEPS) DOT1=0._EB + IF ( ABS(DOT1) == 0._EB ) THEN + ! Point 1: + SVARI = X2_1 + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_GASPHASE, CC_UNDEFINED /) + SCRSI = -ISGL + STANI(IAXIS:JAXIS) = 0._EB - AREA_IF_2 : IF (AREA > TWENTY_EPSILON_EB) THEN - NRML = NRML / AREA ! Normalize unit vector: - ! Normalize NRML vector to LINK_DIGITS: - DO DUM=IAXIS,KAXIS - NRML(DUM) = REAL(INT(LINK_FCT*NRML(DUM)),EB)/LINK_FCT - ENDDO - MASK(IAXIS:KAXIS) = .TRUE. - INRM(1) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(1))=.FALSE. - INRM(2) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(2))=.FALSE. - INRM(3) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1) - AXIS_LOOP_2 : DO DUM=IAXIS,KAXIS - X1AXIS=INRM(DUM) - IFC_LOOP_3 : DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - IF((CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB) .OR. & - (CC%FACE_LIST(1,IFACE)==CC_FTYPE_SVERT)) CYCLE IFC_LOOP_3 - ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND - IF( (X1AXIS /= CC%FACE_LIST(3,IFACE)) .OR. & - (ILH /= INT(SIGN(1._EB,NRML(X1AXIS)))) ) CYCLE IFC_LOOP_3 - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF( (I+ILH < 1) .OR. (I+ILH > M%IBAR) ) CYCLE IFC_LOOP_3 ! Drop if outside the mesh. - CASE(JAXIS) - IF( (J+ILH < 1) .OR. (J+ILH > M%JBAR) ) CYCLE IFC_LOOP_3 - CASE(KAXIS) - IF( (K+ILH < 1) .OR. (K+ILH > M%KBAR) ) CYCLE IFC_LOOP_3 - END SELECT - SELECT CASE(CC%FACE_LIST(1,IFACE)) ! 1. Check if a surrounding cell is a regular cell: - CASE(CC_FTYPE_RCGAS) ! REGULAR GASPHASE - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(M%CCVAR(I+ILH,J,K,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I+ILH,J,K,ICC2,JCC2) - IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 - IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 - I_LNK = I+ILH; J_LNK = J; K_LNK = K; JCC_LNK = JCC2 - VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); - EXIT AXIS_LOOP_2 - ENDIF - CASE(JAXIS) - IF(M%CCVAR(I,J+ILH,K,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I,J+ILH,K,ICC2,JCC2) - IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 - IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 - I_LNK = I; J_LNK = J+ILH; K_LNK = K; JCC_LNK = JCC2 - VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); - EXIT AXIS_LOOP_2 - ENDIF - CASE(KAXIS) - IF(M%CCVAR(I,J,K+ILH,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I,J,K+ILH,ICC2,JCC2) - IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 - IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 - I_LNK = I; J_LNK = J; K_LNK = K+ILH; JCC_LNK = JCC2 - VAL_UNKZ=M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); - EXIT AXIS_LOOP_2 - ENDIF - END SELECT - CASE(CC_FTYPE_CFGAS) ! 2. Check for large surrounding cut-cells: - IFC2 = CC%FACE_LIST(4,IFACE) - IFACE2 = CC%FACE_LIST(5,IFACE) - ICC2 = M%CUT_FACE(IFC2)%CELL_LIST(2,CC%FACE_LIST(2,IFACE),IFACE2) - JCC2 = M%CUT_FACE(IFC2)%CELL_LIST(3,CC%FACE_LIST(2,IFACE),IFACE2) - IF (M%CUT_CELL(ICC2)%UNKZ(JCC2)<1) CYCLE IFC_LOOP_3 - IF (M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 - I_LNK = M%CUT_CELL(ICC2)%IJK(IAXIS); J_LNK = M%CUT_CELL(ICC2)%IJK(JAXIS); - K_LNK = M%CUT_CELL(ICC2)%IJK(KAXIS); JCC_LNK = JCC2 - VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); EXIT AXIS_LOOP_2 - END SELECT - ENDDO IFC_LOOP_3 - ENDDO AXIS_LOOP_2 - IF (VAL_UNKZ > 0) THEN - CC%FACE_LIST(6,IFACE) = INTEGER_ONE ! This face is shared with master. - CC%UNKZ(JCC) = VAL_UNKZ - CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I_LNK, J_LNK, K_LNK, JCC_LNK /) - CC%LINK_LEV(JCC) = LNK_LEV-1 ! One link hierarchy level below master cell. - CYCLE JCC_LOOP_2 - ENDIF - ENDIF AREA_IF_2 + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) ! Modifies crossings arrays. + ENDIF +ENDDO - ! Small cells, get CC_UNKZ from a large cell neighbor: - IFACE3 = CC_UNDEFINED - IFC_LOOP_4 : DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - IF((CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB) .OR. & - (CC%FACE_LIST(1,IFACE)==CC_FTYPE_SVERT)) CYCLE IFC_LOOP_4 - ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND +! Now Segments: +NSEGS_COND : IF (BODINT_PLANE%NSEGS > 0) THEN - ! Cycle if surrounding cell is located in the guard-cell region, if so drop, as we don't have - ! at this point unknown numbers on guard-cells/guard-cell ccs: - X1AXIS = CC%FACE_LIST(3,IFACE) - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF( (I+ILH < 1) .OR. (I+ILH > M%IBAR) ) CYCLE IFC_LOOP_4 - CASE(JAXIS) - IF( (J+ILH < 1) .OR. (J+ILH > M%JBAR) ) CYCLE IFC_LOOP_4 - CASE(KAXIS) - IF( (K+ILH < 1) .OR. (K+ILH > M%KBAR) ) CYCLE IFC_LOOP_4 - END SELECT +DELBIN = BODINT_PLANE%TBAXIS(X3AXIS)%DELBIN +AVAL = (X3RAY-GEOMEPS-BODINT_PLANE%BOX(LOW_IND,X3AXIS))/DELBIN +ILO_BIN= MAX(1, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS,EB),ABS(AVAL)) )) +AVAL = (X3RAY+GEOMEPS-BODINT_PLANE%BOX(LOW_IND,X3AXIS))/DELBIN +IHI_BIN= MIN(BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS,EB),ABS(AVAL)) )) +IBIN_DO : DO IBIN=ILO_BIN,IHI_BIN - SELECT CASE(CC%FACE_LIST(1,IFACE)) ! 1. Check if a surrounding cell is a regular cell: - CASE(CC_FTYPE_RCGAS) ! REGULAR GASPHASE - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(M%CCVAR(I+ILH,J,K,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I+ILH,J,K,ICC2,JCC2) - IF(ANY((/ ICC2, JCC2 /) == 0)) CYCLE IFC_LOOP_4 - IF(M%CUT_CELL(ICC2)%VOLUME(JCC2) BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE - ! This small cut-cell still has an undefined unknown, redo link-loop to test for updated unknown number on - ! neighbors: - IF (VAL_UNKZ > 0) THEN - CC%FACE_LIST(6,IFACE3) = INTEGER_ONE ! This face is shared with master. - CC%UNKZ(JCC) = VAL_UNKZ - CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I_LNK, J_LNK, K_LNK, JCC_LNK /) - CC%LINK_LEV(JCC) = LNK_LEV-1 ! One link hierarchy level below master cell. - ELSE - QUITLINK_FLG = .FALSE. - ENDIF - ENDDO JCC_LOOP_2 - ENDDO ICC_LOOP_2 + TRIBIN_DO : DO IISEG=1,BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%NTL - ! Then fuse cut-cell unknowns if several ccs in one Cartesian cell and one of them has CUT_CELL(ICC)%UNKZ(JCC)>0: - ! IF(.NOT. ONE_UNKH_PER_CUTCELL) THEN - ! DO ICC=1,M%N_CUTCELL_MESH - ! CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - ! ! Don't attempt to link cut-cells inside an OBST: - ! IF ( M%CELL(M%CELL_INDEX(I,J,K))%SOLID ) CYCLE - ! ! Cases with more than one cut-cell: define UNKZ of all cells to be the one of first cut-cell with UNKZ > 0: - ! DO JCC=1,CC%NCELL; IF(CC%UNKZ(JCC)>0) EXIT; ENDDO - ! JCC_LNK = JCC - ! IF (JCC_LNK <= CC%NCELL) THEN - ! DO JCC=1,CC%NCELL - ! IF ( CC%NOADVANCE(JCC)>0 .OR. JCC==JCC_LNK ) CYCLE - ! CC%UNKZ(JCC) = CC%UNKZ(JCC_LNK) - ! CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I, J, K, JCC_LNK /) - ! CC%LINK_LEV(JCC) = CC%LINK_LEV(JCC_LNK) - 1 - ! ENDDO - ! ENDIF - ! ENDDO - ! ENDIF + ISEG = BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) +!SEGMENTS_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS - IF (QUITLINK_FLG) EXIT LINK_LOOP + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) - LINK_LEV_UP = LINK_LEV_UP - 1 + ! x2,x3 coordinates of segment: + X2_1 = XYZ1(X2AXIS) + X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. + X2_2 = XYZ2(X2AXIS) + X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. - LINK_ITER = LINK_ITER + 1 - BLOCK_CELL_IF : IF (LINK_ITER > N_LINK_ATTMP) THEN - ! Count how many unlinked cells we have in this mesh: - ULINK_COUNT = 0 - DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - DO JCC=1,CC%NCELL - IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE - ULINK_COUNT = ULINK_COUNT + 1 - ENDDO - ENDDO - - IF (GET_CUTCELLS_VERBOSE) THEN - ! Write out unlinked cells properties: - ! Open file to write unlinked cells: - WRITE(UNLINKED_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_unlinked_',MY_RANK,'.log' - ! Create file: - IF (UNLINKED_1ST_CALL) THEN - LU_UNLNK = GET_FILE_NUMBER() - OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='UNKNOWN') - WRITE(LU_UNLNK,*) 'Unlinked cut-cell Information for Process=',MY_RANK - CLOSE(LU_UNLNK) - UNLINKED_1ST_CALL = .FALSE. - ENDIF - ! Open file to write unlinked cell information: - OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='OLD',POSITION='APPEND') - WRITE(LU_UNLNK,*) ' ' - WRITE(LU_UNLNK,'(A,I4,A,I4)') ' Mesh NM=',NM,', number of unlinked cells=',ULINK_COUNT + ! First Test if the whole segment is on one side of the Ray: + ! Test segment crosses the ray, or is in geomepsilon proximity + ! of it: + X3MIN = MIN(X3_1,X3_2) + X3MAX = MAX(X3_1,X3_2) + OUTRAY=(((X3RAY-X3MAX) > GEOMEPS) .OR. ((X3MIN-X3RAY) > GEOMEPS)) - ! Dump info: - ULINK_COUNT = 0 - DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - DO JCC=1,CC%NCELL - IF (CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0) CYCLE - ULINK_COUNT = ULINK_COUNT + 1 - WRITE(LU_UNLNK,'(I8,A,5I8,A,5F22.8)') & - ULINK_COUNT,', I,J,K,ICC,JCC=',I,J,K,ICC,JCC,', X,Y,Z,CCVOL,CCVOL_CRT=',M%X(I),M%Y(J),M%Z(K), & - CC%VOLUME(JCC),M%DX(I)*M%DY(J)*M%DZ(K) - ENDDO - ENDDO - CLOSE(LU_UNLNK) - ENDIF + IF (OUTRAY) CYCLE - ! Unlinked cells get blocked, inboundary cut-faces are dropped, shared gas cut-faces are made inboundary faces - ! for neighbors. If no cut-cells left in location I,J,K => CCVAR(I,J,K,CC_CGSC) is set to CC_SOLID. - DO ICC=1,M%N_CUTCELL_MESH - DO JCC=1,M%CUT_CELL(ICC)%NCELL - IF ( M%CUT_CELL(ICC)%UNKZ(JCC) > 0 ) CYCLE - M%CUT_CELL(ICC)%IJK_LINK(1,JCC) = CC_SOLID ! Flag for Blocking after main mesh loop in SET_CUTCELLS_3D - ENDDO - ENDDO + DOT1 = X3_1-X3RAY + DOT2 = X3_2-X3RAY - ! Recount unlinked cells (i.e. no other viable cells in the mesh). - ULINK_COUNT = 0 - DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - DO JCC=1,CC%NCELL - IF ( CC%UNKZ(JCC) > 0 .OR. CC%IJK_LINK(1,JCC)==CC_SOLID) CYCLE - ULINK_COUNT = ULINK_COUNT + 1 - ENDDO - ENDDO + IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB + IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB - IF (GET_CUTCELLS_VERBOSE) THEN - ! Write out remaining unlinked cells properties. - ! Open file to write unlinked cell information: - OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='OLD',POSITION='APPEND') - WRITE(LU_UNLNK,*) ' ' - WRITE(LU_UNLNK,*) 'STATUS AFTER BLOCKING SMALL UNLINKED CUT-CELLS:' - WRITE(LU_UNLNK,'(A,I4,A,I4)') ' Mesh NM=',NM,', number of unlinked cells after blocking=',ULINK_COUNT - IF(ULINK_COUNT > 0) THEN - ! Dump info: - ULINK_COUNT = 0 - DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - DO JCC=1,CC%NCELL - IF (CC%UNKZ(JCC)>0) CYCLE - ULINK_COUNT = ULINK_COUNT + 1 - WRITE(LU_UNLNK,'(I8,A,5I8,A,5F22.8)') & - ULINK_COUNT,', I,J,K,ICC,JCC=',I,J,K,ICC,JCC,', X,Y,Z,CCVOL,CCVOL_CRT=',M%X(I),M%Y(J),M%Z(K), & - CC%VOLUME(JCC),M%DX(I)*M%DY(J)*M%DZ(K) - ENDDO - ENDDO - ENDIF - CLOSE(LU_UNLNK) - ENDIF - EXIT LINK_LOOP - ENDIF BLOCK_CELL_IF -ENDDO LINK_LOOP + ! Segment tangent unit vector. + DV12(IAXIS:JAXIS) = XYZ2( (/ X2AXIS, X3AXIS /) ) - XYZ1( (/ X2AXIS, X3AXIS /) ) + MODTI = SQRT( DV12(IAXIS)**2._EB + DV12(JAXIS)**2._EB ) + STANI(IAXIS:JAXIS) = DV12(IAXIS:JAXIS) * MODTI**(-1._EB) + NOMLI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) + ISSEG(LOW_IND:HIGH_IND) = BODINT_PLANE%SEGTYPE(LOW_IND:HIGH_IND,ISEG) -! Finally compute M%FINEST_LINK_LEV: -DO ICC=1,M%N_CUTCELL_MESH - DO JCC=1,M%CUT_CELL(ICC)%NCELL - IF(M%CUT_CELL(ICC)%IJK_LINK(1,JCC)==CC_SOLID) THEN - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)==NOT_BLOCKED) M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCKED_UNLINK_CELL - M%CUT_CELL(ICC)%LINK_LEV(JCC) = CC_UNDEFINED - M%CUT_CELL(ICC)%IJK_LINK(2:5,JCC)= CC_UNDEFINED - ELSEIF(M%CUT_CELL(ICC)%LINK_LEV(JCC) < M%FINEST_LINK_LEV) THEN - M%FINEST_LINK_LEV = M%CUT_CELL(ICC)%LINK_LEV(JCC) - ENDIF - ENDDO -ENDDO + ! For x2, in local x2-x3 coords e2=(1,0): + GAM(LOW_IND) = (1 + NINT(SIGN( 1._EB, NOMLI(IAXIS))) ) / 2 !(1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; + GAM(HIGH_IND)= (1 - NINT(SIGN( 1._EB, NOMLI(IAXIS))) ) / 2 !(1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; -RETURN + ! Test if whole segment is in ray, if so add segment nodes as crossings: + IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN -CONTAINS + ! Count both points as crossings: + ! Point 1: + SVARI = MIN(X2_1,X2_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) + SCRSI = ISEG -SUBROUTINE GET_ICC2_JCC2(ICC,IFACE,INXT,JNXT,KNXT,ICC2,JCC2) -INTEGER, INTENT(IN) :: ICC,IFACE,INXT,JNXT,KNXT -INTEGER, INTENT(OUT):: ICC2, JCC2 + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) -INTEGER :: IFC, IFACE2 -TYPE(CC_CUTCELL_TYPE), POINTER :: CC2 -ICC2=M%CCVAR(INXT,JNXT,KNXT,CC_IDCC); IF (ICC2<=0) RETURN -CC2 => M%CUT_CELL(ICC2) -DO JCC2=1,CC2%NCELL - ! Loop faces and test: - DO IFC=1,CC2%CCELEM(1,JCC2) - IFACE2 = CC2%CCELEM(IFC+1,JCC2) - ! If face type in face_list is not CC_FTYPE_RCGAS, drop: - IF(CC2%FACE_LIST(1,IFACE2) /= CC_FTYPE_RCGAS) CYCLE - ! Does X1AXIS match and LOWHIGH are different? - IF( CC2%FACE_LIST(3,IFACE2) /= M%CUT_CELL(ICC)%FACE_LIST(3,IFACE)) CYCLE ! X1AXIS is different. - IF(ABS(CC2%FACE_LIST(2,IFACE2) - M%CUT_CELL(ICC)%FACE_LIST(2,IFACE)) < 1) CYCLE ! Same LOWHIGH. - ! Found the cut-cell ICC2,JCC2 on the other side of IFACE for cut-cell ICC,JCC. - RETURN - ENDDO -ENDDO -JCC2=0 -RETURN -END SUBROUTINE GET_ICC2_JCC2 + DO ICR=2,BODINT_PLANE%NBCROSS(ISEG)-1 + SVARI = X2_1 + BODINT_PLANE%SVAR(ICR,ISEG)*STANI(IAXIS) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ENDDO + ! Point 2: + SVARI = MAX(X2_1,X2_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) + SCRSI = ISEG -END SUBROUTINE GET_CELL_LINK_INFO + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF -! --------------------- BLOCK_CC_SOLID_EXTWALLCELLS ----------------------------- + ! Now nodes individually: + IF ( ABS(DOT1) == 0._EB ) THEN -SUBROUTINE BLOCK_CC_SOLID_EXTWALLCELLS(FIRST_CALL) + ! Point 1: + SVARI = X2_1 -LOGICAL, INTENT(IN) :: FIRST_CALL + ! LOW and HIGH media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND) = GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)= CC_UNDEFINED + SCRSI = ISEG -! Local variables: -INTEGER :: NM,IW,IIF,JJF,KKF,II,JJ,KK,IOR,X1AXIS -TYPE (WALL_TYPE), POINTER :: WC + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) -MESH_LOOP : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - EXTERNAL_WALL_LOOP : DO IW=1,N_EXTERNAL_WALL_CELLS - WC=>WALL(IW) - BC=>BOUNDARY_COORD(WC%BC_INDEX) - IF (FIRST_CALL) THEN - IF (.NOT.(WC%BOUNDARY_TYPE==INTERPOLATED_BOUNDARY)) CYCLE EXTERNAL_WALL_LOOP - ELSE - ! Here we might need to add other EXT wall cell types. - IF (.NOT.(WC%BOUNDARY_TYPE==OPEN_BOUNDARY .OR. WC%BOUNDARY_TYPE==SOLID_BOUNDARY)) CYCLE EXTERNAL_WALL_LOOP - ENDIF - II = BC%II - JJ = BC%JJ - KK = BC%KK - IOR = BC%IOR - X1AXIS = ABS(IOR) - ! Define underlying Cartesian faces indexes: - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-IAXIS) ! Higher X boundary for Mesh NM. - IIF = II - 1; JJF = JJ ; KKF = KK - CASE( JAXIS) ! Lower Y boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-JAXIS) ! Higher Y boundary for Mesh NM. - IIF = II ; JJF = JJ - 1; KKF = KK - CASE( KAXIS) ! Lower Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-KAXIS) ! Higher Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - 1 - END SELECT - ! Change BOUNDARY_TYPE to null: - IF (FIRST_CALL) THEN - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) WC%BOUNDARY_TYPE = SOLID_BOUNDARY - ELSE - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) WC%BOUNDARY_TYPE = NULL_BOUNDARY - ENDIF - ENDDO EXTERNAL_WALL_LOOP -ENDDO MESH_LOOP + CYCLE -RETURN -END SUBROUTINE BLOCK_CC_SOLID_EXTWALLCELLS + ENDIF + IF ( ABS(DOT2) == 0._EB ) THEN + ! Point 2: + SVARI = X2_2 -! ----------------------- INIT_CFACE_CELL ----------------------------- + ! LOW and HIGH_IND media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND) = GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1) = CC_UNDEFINED + SCRSI = ISEG -SUBROUTINE INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX,SURF_INDEX,STAGE_FLG,IS_INB,IW) + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) -USE GEOMETRY_FUNCTIONS, ONLY : SEARCH_OTHER_MESHES -USE MEMORY_FUNCTIONS, ONLY: ALLOCATE_STORAGE -USE MATH_FUNCTIONS, ONLY : CROSS_PRODUCT + CYCLE -! Routine that initializes new CFACE with index CFACE_INDEX. -! Geometry information for CFACE is loaded from MESHES(NM)%CUT_FACE(ICF)%AREA(IFACE), etc. -! Assumes POINT_TO_MESH has been called. + ENDIF -INTEGER, INTENT(IN) :: NM,ICF,IFACE,CFACE_INDEX,SURF_INDEX,STAGE_FLG -LOGICAL, INTENT(IN) :: IS_INB -INTEGER, OPTIONAL, INTENT(IN) :: IW + ! Finally regular case: + ! Points 1 on one side of ray, point 2 on the other: + ! IF ((DOT1 > 0. .AND. DOT2 < 0.) .OR. (DOT1 < 0. .AND. DOT2 > 0.)) + IF ( DOT1*DOT2 < 0._EB ) THEN -! Local Variables: -INTEGER :: IBOD, IWSEL, ICC, JCC - -INTEGER :: IG, TRI, WSELEM(NOD1:NOD3), NOM, IIO, JJO, KKO, IIV(3), JJV(3), KKV(3), ICF2, JCF2, JCF22, ICF3, JCF3, & - II, JJ, KK, III, JJJ, KKK, ICFACE, ICFF, IOR, X1AXIS -REAL(EB):: XP(IAXIS:KAXIS),RDIR(IAXIS:KAXIS),V1(IAXIS:KAXIS),V2(IAXIS:KAXIS),V3(IAXIS:KAXIS),POS(IAXIS:KAXIS),DIST,DIST2 -LOGICAL :: IS_INTERSECT=.FALSE., BACK_CFACE_FOUND=.FALSE. -TYPE (SURFACE_TYPE), POINTER :: SF -TYPE (WALL_TYPE), POINTER :: WC -TYPE (MESH_TYPE), POINTER :: M -TYPE (CFACE_TYPE), POINTER :: CFA -TYPE (CC_CUTFACE_TYPE), POINTER :: CF - -M => MESHES(NM) -SF=> SURFACE(SURF_INDEX) -CF=> CUT_FACE(ICF) - -STAGE_FLG_BRANCH : SELECT CASE(STAGE_FLG) - -CASE(INTEGER_ONE) ! Geometry information for CFACE. - - CALL ALLOCATE_STORAGE(NM,SURF_INDEX=SURF_INDEX,CFACE_INDEX=CFACE_INDEX) - - CFA => M%CFACE(CFACE_INDEX) - BC => M%BOUNDARY_COORD(CFA%BC_INDEX) - B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) + ! Intersection Point along segment: + !DS = (X3RAY-X3_1) / (X3_2-X3_1) + !SVARI = X2_1 + DS*(X2_2-X2_1) + SVARI = X2_1 + (X3RAY-X3_1) * (X2_2-X2_1) / (X3_2-X3_1) - CFA%SURF_INDEX = SURF_INDEX - CFA%NODE_INDEX = SURFACE(SURF_INDEX)%NODE_INDEX - B1%NODE_INDEX = CFA%NODE_INDEX + ! LOW and HIGH media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND) = GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1) = CC_UNDEFINED + SCRSI = ISEG - BC%X = CF%XYZCEN(IAXIS,IFACE) - BC%Y = CF%XYZCEN(JAXIS,IFACE) - BC%Z = CF%XYZCEN(KAXIS,IFACE) - CFA%AREA = CF%AREA(IFACE) + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - ! Now populate cut-face information: - CFA%CUT_FACE_IND1 = ICF - CFA%CUT_FACE_IND2 = IFACE + CYCLE - INS_INB_COND_1 : IF (IS_INB) THEN - B1%VEL_ERR_NEW=CF%VEL(IFACE) - 0._EB ! Assumes zero velocity of solid. + ENDIF - ! Normal to cut-face: - V2(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(2,IFACE))-CF%XYZCEN(IAXIS:KAXIS,IFACE) - V3(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(3,IFACE))-CF%XYZCEN(IAXIS:KAXIS,IFACE) - CALL CROSS_PRODUCT(BC%NVEC(IAXIS:KAXIS),V2,V3) - IF(NORM2(BC%NVEC)>TWENTY_EPSILON_EB .AND. CF%CFACE_ORIGIN(IFACE)==BLOCKED_SPLIT_CELL) THEN - BC%NVEC(IAXIS:KAXIS) = BC%NVEC(IAXIS:KAXIS)/NORM2(BC%NVEC) - ELSE - IBOD =CF%BODTRI(1,IFACE) - IWSEL=CF%BODTRI(2,IFACE) - BC%NVEC(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) - ENDIF - X1AXIS = MAXLOC(ABS(BC%NVEC(IAXIS:KAXIS)),DIM=1) - BC%IOR = INT(SIGN(1._EB,BC%NVEC(X1AXIS)))*X1AXIS + print*, "Error GET_X2INTERSECTIONS: Missed segment=",ISEG - ! Boundary CFACES processed are defined of type SOLID_BOUNDARY - CFA%BOUNDARY_TYPE = SOLID_BOUNDARY + ENDDO TRIBIN_DO +ENDDO IBIN_DO +!ENDDO SEGMENTS_LOOP - ! Might need to rethink this, but for the time being... - BC%II = CF%IJK(IAXIS) - BC%JJ = CF%IJK(JAXIS) - BC%KK = CF%IJK(KAXIS) +ENDIF NSEGS_COND - BC%IIG = CF%IJK(IAXIS) - BC%JJG = CF%IJK(JAXIS) - BC%KKG = CF%IJK(KAXIS) +! Do we have any intersections? +IF ( CC_N_CRS == 0 ) RETURN - ELSE INS_INB_COND_1 ! External mesh boundary CFACE +! Collapse crossings to single SVARs: +CALL COLLAPSE_CROSSINGS(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,1) - IF (PRESENT(IW)) THEN - WC => M%WALL(IW) - WC_BC => M%BOUNDARY_COORD(WC%BC_INDEX) - IOR = WC_BC%IOR - SELECT CASE(ABS(IOR)) - CASE(IAXIS); BC%NVEC(IAXIS:KAXIS) = (/ REAL(SIGN(1,IOR),EB), 0._EB, 0._EB /) - CASE(JAXIS); BC%NVEC(IAXIS:KAXIS) = (/ 0._EB, REAL(SIGN(1,IOR),EB), 0._EB /) - CASE(KAXIS); BC%NVEC(IAXIS:KAXIS) = (/ 0._EB, 0._EB, REAL(SIGN(1,IOR),EB) /) - END SELECT - BC%IOR = IOR - ! External mesh boundary CFACES inherit the underlaying WALL type. - CFA%BOUNDARY_TYPE = WC%BOUNDARY_TYPE - CFA%NODE_INDEX = SURFACE(WC%SURF_INDEX)%NODE_INDEX - CFA%VENT_INDEX = WC%VENT_INDEX +! Write out: +! print*, "X3RAY=",X3RAY,", Intersect X2=",CC_N_CRS +! DO ICRS=1,CC_N_CRS +! print*, ICRS,", ",CC_SVAR_CRS(ICRS),", ",CC_IS_CRS(ICRS) +! ENDDO - BC%II = WC_BC%II - BC%JJ = WC_BC%JJ - BC%KK = WC_BC%KK +T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW - BC%IIG = WC_BC%IIG - BC%JJG = WC_BC%JJG - BC%KKG = WC_BC%KKG +RETURN +END SUBROUTINE GET_X2_INTERSECTIONS - ENDIF - ENDIF INS_INB_COND_1 - B1%AREA = CF%AREA(IFACE) ! Init to CFACE AREA. +! ------------------------ COLLAPSE_CROSSINGS ----------------------------------- -CASE(INTEGER_TWO) ! Assign AREA_ADJUST for CFACE, BCs information for CFACE. +SUBROUTINE COLLAPSE_CROSSINGS(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,ITITLE) - CFA => M%CFACE(CFACE_INDEX) - BC => M%BOUNDARY_COORD(CFA%BC_INDEX) - B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) - ! First: Assign AREA_ADJUST for CFACEs. - B1%AREA_ADJUST = CF%AREA_ADJUST(IFACE) +TYPE(BODINT_PLANE_TYPE), INTENT(IN) :: BODINT_PLANE2 +INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,ITITLE +REAL(EB), INTENT(IN) :: X3RAY,X1PLN - ! Case of exposed Backing we need to find CFACE_INDEX of BACK CFACE. - IF (SF%BACKING==EXPOSED .AND. SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN - IG = CF%BODTRI(1,IFACE) - TRI = CF%BODTRI(2,IFACE) - XP(IAXIS:KAXIS) = (/ BC%X, BC%Y, BC%Z /) ! CFACE centroid location. - RDIR(IAXIS:KAXIS)= - GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,TRI) ! Normal into the body. - TRI_LOOP : DO IWSEL=1,GEOMETRY(IG)%N_FACES - IF (IWSEL==TRI) CYCLE - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) - ! Triangles NODES coordinates: - V1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) - V2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) - V3(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD3)-1)+1:MAX_DIM*WSELEM(NOD3)) +! Local Variables: +INTEGER :: CC_N_CRS_AUX +REAL(EB):: CC_SVAR_CRS_AUX(CC_MAXCROSS_X2) +INTEGER :: CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_MAXCROSS_X2),BODNUM(CC_MAXCROSS_X2) +REAL(EB):: CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_MAXCROSS_X2) +INTEGER :: CC_SEG_CRS_AUX(CC_MAXCROSS_X2) +INTEGER :: CRS_NUM(CC_MAXCROSS_X2),IND_CRS(LOW_IND:HIGH_IND,CC_MAXCROSS_X2) +INTEGER :: LEFT_MEDIA, NCRS_REMAIN +INTEGER :: ICRS, ICRS1, ICRS2, IDCR, IDCR2, IND_LEFT, IND_RIGHT, NUBD, IBDNUM, ISEG, IUBD, SBOD +LOGICAL :: DROP_SS_GG, FOUND_LEFT, NOT_COUNTED(CC_MAXCROSS_X2), USE_INT_POINT(CC_MAXCROSS_X2), ALGN_CROSS +INTEGER, ALLOCATABLE, DIMENSION(:) :: UBOD - ! Fast triangle discard method: To do. +CC_N_CRS_AUX = 0 +CC_SVAR_CRS_AUX = 1._EB/GEOMEPS ! svar = x2_intersection +CC_IS_CRS2_AUX = CC_UNDEFINED ! Is the intersection an actual GS. +CC_SEG_CRS_AUX = 0 ! Segment containing the crossing. +CC_SEG_TAN_AUX = 0._EB ! Segment orientation for each intersection. - ! Search for intersection point in POS(IAXIS:KAXIS): - CALL RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,RDIR,IS_INTERSECT,POS) +! Count how many crossings with different SVAR: +CRS_NUM(:) = 0 +ICRS = 1 +CRS_NUM(ICRS) = 1 +IND_CRS(:,:) = 0 +IND_CRS(LOW_IND, CRS_NUM(ICRS)) = ICRS-1 +IND_CRS(HIGH_IND,CRS_NUM(ICRS)) = IND_CRS(HIGH_IND,ICRS)+1 - IF (IS_INTERSECT) EXIT TRI_LOOP +DO ICRS=2,CC_N_CRS + IF ( ABS(CC_SVAR_CRS(ICRS)-CC_SVAR_CRS(ICRS-1)) < GEOMEPS ) THEN + CRS_NUM(ICRS) = CRS_NUM(ICRS-1) + ELSE + CRS_NUM(ICRS) = CRS_NUM(ICRS-1)+1 + IND_CRS(LOW_IND,CRS_NUM(ICRS)) = ICRS-1 + ENDIF + IND_CRS(HIGH_IND,CRS_NUM(ICRS)) = IND_CRS(HIGH_IND,CRS_NUM(ICRS))+1 +ENDDO - ENDDO TRI_LOOP +! Computation of CC_BDNUM_CRS_AUX requires knowledge of how many different +! bodies reach an intersection: +BODNUM(:) = 0 +ALLOCATE(UBOD(N_GEOMETRY)); UBOD=0 +IDCR_DO_1 : DO IDCR=1,CRS_NUM(CC_N_CRS) + ! Load body numbers: + DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + ISEG=CC_SEG_CRS(IDCR2) + IF (ISEG > 0) BODNUM(IDCR2)=BODINT_PLANE2%INDSEG(4,ISEG) + ENDDO + ! Unique bodies: + NUBD = 0 + DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF ( BODNUM(IDCR2)<1 ) CYCLE + IF ((NUBD > 0) .AND. ANY(UBOD(1:NUBD)==BODNUM(IDCR2))) CYCLE + NUBD = NUBD + 1 + UBOD(NUBD) = BODNUM(IDCR2) + ENDDO + ! Now assign CC_BDNUM_CRS_AUX(IDCR): + SBOD = 0 + DO IUBD=1,NUBD + ! Drop extra intersections (same intersection type, same body): + USE_INT_POINT(IND_CRS(LOW_IND,IDCR)+1:IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR)) = .TRUE. + DO ICRS1=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF (.NOT.USE_INT_POINT(ICRS1)) CYCLE ! Don't use collapsed point as pivot. + ! Collapse GS or SG points: + DO ICRS2 = IND_CRS(LOW_IND,IDCR)+1 , IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF ( (ICRS2==ICRS1) .OR. .NOT.USE_INT_POINT(ICRS2) ) CYCLE ! Don't use pivot, or collapsed point. + IF ((CC_IS_CRS2(LOW_IND ,ICRS1) == CC_IS_CRS2(LOW_IND ,ICRS2)) .AND. & + (CC_IS_CRS2(HIGH_IND,ICRS1) == CC_IS_CRS2(HIGH_IND,ICRS2)) .AND. & + (BODNUM(ICRS1) == BODNUM(ICRS2))) THEN + USE_INT_POINT(ICRS2) = .FALSE. + ENDIF + ENDDO + ENDDO + IBDNUM=0 + DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF (BODNUM(IDCR2) /= UBOD(IUBD)) CYCLE + IF ( .NOT.USE_INT_POINT(IDCR2) ) CYCLE + IBDNUM = IBDNUM + CC_BDNUM_CRS(IDCR2) + ENDDO + IF (IBDNUM /= 0) SBOD = SBOD + SIGN(1,IBDNUM) + ENDDO + IF (IDCR == 1) THEN + CC_BDNUM_CRS_AUX(IDCR) = SBOD + ELSE + CC_BDNUM_CRS_AUX(IDCR) = CC_BDNUM_CRS_AUX(IDCR-1) + SBOD + ENDIF +ENDDO IDCR_DO_1 +DEALLOCATE(UBOD) - IF (IS_INTERSECT) THEN - ! Check that distance is less than cell diagonal size: - ! For longer distances from CFACE to BACK CFACE BC is 'VOID'. - IF(NORM2(XP-POS) > SQRT(DX(BC%IIG)**2 + DY(BC%JJG)**2 + DZ(BC%KKG)**2)) RETURN +! This is where we merge intersections at same svar location (i.e. same CRS_NUM value): +! Loop over different crossings: +LEFT_MEDIA = CC_GASPHASE ! Here we could change the initial LEFT_MEDIA to CC_SOLID if needed. Would require adding + ! CC_BDNUM_CRS(LOW_IND,0) = 1, i.e crossed into SOLID at x2 -> -Inf. +IDCR_DO_2 : DO IDCR=1,CRS_NUM(CC_N_CRS) - ! We Found an intersection with IWSEL in position POS(IAXIS:KAXIS): - ! Find indexes and mesh of cell containing intersection point: - CALL SEARCH_OTHER_MESHES(POS(IAXIS),POS(JAXIS),POS(KAXIS),NOM,IIO,JJO,KKO) + CC_N_CRS_AUX = CC_N_CRS_AUX + 1 + ! Case of single crossing with new svar: + SNGL_CRS_IF : IF ( IND_CRS(HIGH_IND,IDCR) == 1 ) THEN - ! This test and restriction of NOM==NM is temporary. Discard when parallel CFACE info is in place. - IF (NOM/=NM) THEN - IF(NOM==0) RETURN - WRITE(LU_ERR,*) 'WARNING: BACK CFACE search, other mesh NOM not equal to working mesh NM. NM=',NM,& - ', NOM and other cell IIO,JJO,KKO=',NOM,IIO,JJO,KKO,', intersection pt=',POS(IAXIS:KAXIS) - RETURN - ENDIF + ICRS =IND_CRS(LOW_IND,IDCR) + 1 - IF (NOM>0) THEN - IF (ALLOCATED(MESHES(NOM)%CCVAR)) THEN - IIV(1:3) = (/ IIO, MAX(IIO-1,1), MIN(IIO+1,MESHES(NOM)%IBAR) /) - JJV(1:3) = (/ JJO, MAX(JJO-1,1), MIN(JJO+1,MESHES(NOM)%JBAR) /) - KKV(1:3) = (/ KKO, MAX(KKO-1,1), MIN(KKO+1,MESHES(NOM)%KBAR) /) + IF ( (ICRS>1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN + ! Test if already inside an Object. + CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) = CC_SOLID + ELSEIF ( CC_IS_CRS2(LOW_IND,ICRS) /= LEFT_MEDIA ) THEN - DIST= 1._EB/TWENTY_EPSILON_EB; ICFF=0; JCF2=0 - K_LOOP : DO KKK=1,3 - KK=KKV(KKK) - DO JJJ=1,3 - JJ=JJV(JJJ) - DO III=1,3 - II=IIV(III) - ICF2 = MESHES(NOM)%CCVAR(II,JJ,KK,CC_IDCF) - ICF2_COND : IF (ICF2>0) THEN - - ! Use cut-face with closest centroid to POS: - DO JCF22=1,MESHES(NOM)%CUT_FACE(ICF2)%NFACE - IF(ICF==ICF2 .AND. IFACE==JCF22) CYCLE - DIST2 = (POS(IAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(IAXIS,JCF22))**2._EB + & - (POS(JAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(JAXIS,JCF22))**2._EB + & - (POS(KAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(KAXIS,JCF22))**2._EB - IF (DIST20 .AND. CFA%OD_INDEX>0) THEN - M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_MESH = NOM - M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_INDEX = ICFACE - ENDIF - - ! Write error for testing: + ! Check if this is a single point SGLS which was initially tagged as CC_GASPHASE, + ! if so switch media type to LEFT_MEDIA + IF (CC_SEG_CRS(ICRS) < 0) THEN + CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) = LEFT_MEDIA + ELSE + IF (ITITLE==1) THEN + WRITE(LU_ERR,*) "Error GET_X2INTERSECTIONS: IS_CRS(LOW_IND,ICRS) ~= LEFT_MEDIA, media continuity problem" + WRITE(LU_ERR,*) "X1AXIS,X1PLN=",X1AXIS,X1PLN,", X2AXIS,X3AXIS=",X2AXIS,X3AXIS,", RAY X3 POSITION=",X3RAY + ELSEIF (ITITLE==2) THEN + WRITE(LU_ERR,*) "Error GET_IS_SOLID_PT: IS_CRS(LOW_IND,ICRS) ~= LEFT_MEDIA, media continuity problem" + WRITE(LU_ERR,*) "X1AXIS,X1PLN=",X1AXIS,X1PLN,", X2AXIS,X3AXIS=",X2AXIS,X3AXIS,", RAY X3 POSITION=",X3RAY + ENDIF + IF (IDCR==1) THEN + ! FIXME: this should be the error message, IG should be made available here + ! WRITE(MESSAGE,'(A,A,A)') "ERROR: GEOM ID='", TRIM(GEOMETRY(IG)%ID), & + ! "': Face normals are probably pointing in the wrong direction. Check they point towards the gas phase." + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A)') " SUCCESS: GEOM ID Unknown:" ELSE - WRITE(LU_ERR,*) 'WARNING: BACK CFACE search, MESH, CFACE_INDEX=',NM,CFACE_INDEX,& - ', back CFACE not found in mesh NOM,IIO,JJO,KKO=',NOM,IIO,JJO,KKO - RETURN + WRITE(LU_ERR,'(A)') " ERROR(726): GEOM ID Unknown:" ENDIF - ELSE ! Intersection in mesh furher away than neighboring meshes. - ! To Do stop. - + WRITE(LU_ERR,'(A)') " Face normals are probably pointing in the wrong direction. " + WRITE(LU_ERR,'(A)') " Check they point towards the gas phase." ENDIF - - ELSE ! Intersection outside of domain. - ! To Do stop. - + CALL SHUTDOWN("") ; RETURN ENDIF - - ELSE ! Did not find intersection with other triangles. - ! To Do : Here we can add a test to check if CFACE is indeed within geometry IG. Geometry intersection and - ! linearization lead need to CFACES lay outside of the geometry. - WRITE(LU_ERR,*) 'WARNING: BACK CFACE search did NOT Find Intersection. MESH=',NM,', GEOM=',IG,& - ', CFACE_INDEX, Centroid location=',CFACE_INDEX,XP(:) - RETURN ENDIF - ENDIF + CC_SVAR_CRS_AUX(CC_N_CRS_AUX) = CC_SVAR_CRS(ICRS) + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) + CC_SEG_CRS_AUX(CC_N_CRS_AUX) = CC_SEG_CRS(ICRS) + CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_N_CRS_AUX) = CC_SEG_TAN(IAXIS:JAXIS,ICRS) + LEFT_MEDIA = CC_IS_CRS2(HIGH_IND,ICRS) -CASE(INTEGER_THREE) + CYCLE - CFA => M%CFACE(CFACE_INDEX) - BC => M%BOUNDARY_COORD(CFA%BC_INDEX) - B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) + ENDIF SNGL_CRS_IF - INS_INB_COND_3 : IF (IS_INB) THEN + ! Case of several crossings with new svar: + DROP_SS_GG = .FALSE. + DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF ( CC_IS_CRS2(LOW_IND,ICRS) /= CC_IS_CRS2(HIGH_IND,ICRS) ) THEN + DROP_SS_GG = .TRUE. + EXIT + ENDIF + ENDDO - ! Associated cut-cell location in CUT_CELL array. - ! This CFACE initialization assumes TMP,RHO,ZZ have been initialized in cut-cell ICC,JCC. - ICC = CF%CELL_LIST(2,LOW_IND,IFACE) - JCC = CF%CELL_LIST(3,LOW_IND,IFACE) + ! Variables related to new svar crossing: + ICRS = IND_CRS(LOW_IND,IDCR) + 1 + CC_SVAR_CRS_AUX(CC_N_CRS_AUX) = CC_SVAR_CRS(ICRS) + CC_SEG_CRS_AUX(CC_N_CRS_AUX) = CC_SEG_CRS(ICRS) + CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_N_CRS_AUX) = CC_SEG_TAN(IAXIS:JAXIS,ICRS) - ! Set TMP_F to Surface value and rest to ambient in underlying cartesian cell. - B1%TMP_G = TMP_0(CF%IJK(KAXIS)) - IF (SF%TMP_FRONT > 0._EB) THEN - B1%TMP_F = SF%TMP_FRONT - ELSE - B1%TMP_F = B1%TMP_G - ENDIF + ! Case of intersection inside segment aligned with SVAR location, i.e. + ! intersection among two bodies or self intersection: + ALGN_CROSS=.FALSE. + DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF ( CC_IS_CRS2(HIGH_IND+1,ICRS) /= CC_SOLID ) CYCLE + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID + ALGN_CROSS=.TRUE. + EXIT + ENDDO + IF ( ALGN_CROSS ) CYCLE - B1%RHO_F = CUT_CELL(ICC)%RHO(JCC) - B1%RHO_G = CUT_CELL(ICC)%RHO(JCC) - B1%ZZ_F(1:N_TOTAL_SCALARS) = CUT_CELL(ICC)%ZZ(1:N_TOTAL_SCALARS,JCC) - ! Reinitialize CFACE cell outgoing radiation for change in TMP_F - IF (RADIATION) THEN - B1%Q_RAD_OUT = B1%EMISSIVITY*SIGMA*B1%TMP_F**4 - ELSE - B1%Q_RAD_OUT = 0._EB - ENDIF - ! Assign normal velocity to CFACE from SURF input: - B1%U_NORMAL_0 = SF%VEL - ! Assign normal velocity from VOLUME_FLOW : - IBOD =CF%BODTRI(1,IFACE) - IF(IBOD>0 .AND. ABS(SF%VOLUME_FLOW)>=TWENTY_EPSILON_EB) B1%U_NORMAL_0 = SF%VOLUME_FLOW / FDS_AREA_GEOM(SURF_INDEX,IBOD) - ! Assign normal velocity from MASS_FLUX_TOTAL : - IF(ABS(SF%MASS_FLUX_TOTAL)>=TWENTY_EPSILON_EB) B1%U_NORMAL_0 = SF%MASS_FLUX_TOTAL / RHOA * B1%AREA_ADJUST - ! Vegetation T_IGN setup: Check if fire spreads radially over this surface type - IF (SF%FIRE_SPREAD_RATE>0._EB) THEN - B1%T_IGN = T_BEGIN + SQRT((BC%X-SF%XYZ(1))**2 + & - (BC%Y-SF%XYZ(2))**2 + & - (BC%Z-SF%XYZ(3))**2)/SF%FIRE_SPREAD_RATE - ELSE - B1%T_IGN = SF%T_IGN - ENDIF + ! Now figure out the type of crossing: + NOT_COUNTED = .TRUE. + NCRS_REMAIN = IND_CRS(HIGH_IND,IDCR) + DROP_SS_GG_IF : IF (DROP_SS_GG) THEN - ELSE INS_INB_COND_3 ! External mesh boundary CFACE + ! Points of the same type are collapsed: + USE_INT_POINT(IND_CRS(LOW_IND,IDCR)+1:IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR)) = .TRUE. + DO ICRS1 = IND_CRS(LOW_IND,IDCR)+1, IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) ! Pivot Loop + IF(.NOT.USE_INT_POINT(ICRS1)) CYCLE ! Don't use collapsed point as pivot. + DO ICRS2 = IND_CRS(LOW_IND,IDCR)+1, IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF( (ICRS2==ICRS1) .OR. .NOT.USE_INT_POINT(ICRS2) ) CYCLE ! Don't use pivot, or collapsed point. + IF( (CC_IS_CRS2(LOW_IND ,ICRS1) == CC_IS_CRS2(LOW_IND ,ICRS2)) .AND. & + (CC_IS_CRS2(HIGH_IND,ICRS1) == CC_IS_CRS2(HIGH_IND,ICRS2)) .AND. & + (BODNUM(ICRS1) == BODNUM(ICRS2)) ) USE_INT_POINT(ICRS2) = .FALSE. + ENDDO + ENDDO - IF (PRESENT(IW)) THEN - WC => M%WALL(IW) - IOR = M%BOUNDARY_COORD(WC%BC_INDEX)%IOR - WC_B1 => M%BOUNDARY_PROP1(WC%B1_INDEX) - WC_BC => M%BOUNDARY_COORD(WC%BC_INDEX) - ! Set TMP_F to Surface value and rest to ambient in underlying cartesian cell. - B1%TMP_G = TMP(WC_BC%IIG,WC_BC%JJG,WC_BC%KKG) - B1%TMP_F = WC_B1%TMP_F - B1%RHO_F = WC_B1%RHO_F - B1%RHO_G = RHO(WC_BC%IIG,WC_BC%JJG,WC_BC%KKG) - B1%ZZ_F(1:N_TOTAL_SCALARS) = WC_B1%ZZ_F(1:N_TOTAL_SCALARS) + ! Left Side: + FOUND_LEFT = .FALSE. + IND_LEFT = 0 + IND_RIGHT = 0 + DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + ! Case crossing type GG or SS, drop: + IF (CC_IS_CRS2(LOW_IND,ICRS) == CC_IS_CRS2(HIGH_IND,ICRS)) CYCLE + ! Case collapsed point, drop: + IF (.NOT.USE_INT_POINT(ICRS)) CYCLE - ! Assign normal velocity to CFACE from wall cell: - B1%U_NORMAL_0 = WC_B1%U_NORMAL_0 + IND_LEFT = IND_LEFT + CC_IS_CRS2(LOW_IND,ICRS) + IND_RIGHT = IND_RIGHT + CC_IS_CRS2(HIGH_IND,ICRS) + ENDDO - ! Here downscale velocity: - IF (IFACE==CF%NFACE) WC_B1%U_NORMAL_0 = & - WC_B1%U_NORMAL_0 * SUM(CF%AREA(1:CF%NFACE))/WC_B1%AREA + IF (IND_LEFT /= 0) IND_LEFT = SIGN(1,IND_LEFT) + IF (IND_RIGHT /= 0) IND_RIGHT = SIGN(1,IND_RIGHT) - ! Vegetation T_IGN setup: - B1%T_IGN = WC_B1%T_IGN - ! Back wall cells: - IF (WC%OD_INDEX>0 .AND. CFA%OD_INDEX>0) THEN - M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_MESH = M%BOUNDARY_ONE_D(WC%OD_INDEX)%BACK_MESH - M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_INDEX = M%BOUNDARY_ONE_D(WC%OD_INDEX)%BACK_INDEX + IF ( (IDCR>1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN + ! Test if we are inside an Object. + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID; ! GS or SG. + + ELSEIF (ABS(IND_LEFT)+ABS(IND_RIGHT) == 0) THEN ! Same number of SG and GS crossings, + ! both sides of the crossing + ! defined as left_media: + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = LEFT_MEDIA + ELSEIF (IND_LEFT == LEFT_MEDIA) THEN + CC_IS_CRS2_AUX((/ LOW_IND, HIGH_IND/),CC_N_CRS_AUX) = (/ IND_LEFT, IND_RIGHT /) ! GS or SG. + ELSE + IF (ITITLE==1) THEN + WRITE(LU_ERR,*) "Error GET_X2INTERSECTIONS: DROP_SS_GG = .TRUE., Didn't find left side continuity." + ELSEIF (ITITLE==2) THEN + WRITE(LU_ERR,*) "Error GET_IS_SOLID_PT: DROP_SS_GG = .TRUE., Didn't find left side continuity." ENDIF + ! WRITE(LU_ERR,*) "BODINT_PLANE, NSGLS, NSEGS=",BODINT_PLANE%NSGLS,BODINT_PLANE%NSEGS + ! WRITE(LU_ERR,*) "X1PLN, X2AXIS, X3AXIS, X3RAY=",X1PLN,X2AXIS,X3AXIS,X3RAY + ! WRITE(LU_ERR,*) "CC_N_CRS=",CC_N_CRS,", IDCR=",IDCR + ! WRITE(LU_ERR,*) ICRS,"IND_LEFT=",IND_LEFT,", IND_RIGHT=",IND_RIGHT + ! WRITE(LU_ERR,*) "CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS)",CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) + ! DO IAUX=1,CC_N_CRS + ! WRITE(LU_ERR,*) IAUX,CRS_NUM(CC_N_CRS),IND_LEFT,IND_RIGHT,CC_SVAR_CRS(IND_CRS(LOW_IND,IAUX)+1) + ! ENDDO + ! WRITE(LU_ERR,*) ' ' + ! CALL DEBUG_WAIT ENDIF + LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) - ENDIF INS_INB_COND_3 - -END SELECT STAGE_FLG_BRANCH - -END SUBROUTINE INIT_CFACE_CELL + ELSE ! Intersections are either GG or SS + ! Left side: + FOUND_LEFT = .FALSE. + DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) -! --------------------- GET_REGULAR_CUT_EDGES_BC -------------------------------- + ! Case GG or SS with CC_IS_CRS2(LOW_IND,ICRS) == LEFT_MEDIA: + ! This collapses all types SS or GG that have the left side + ! type. Note they should all be one type (either GG or SS): + IF (CC_IS_CRS2(LOW_IND,ICRS) == LEFT_MEDIA) THEN + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) + NOT_COUNTED(ICRS) = .FALSE. + NCRS_REMAIN = NCRS_REMAIN-1 + FOUND_LEFT = .TRUE. + ENDIF + ENDDO -SUBROUTINE GET_REGULAR_CUT_EDGES_BC(NM) + IF ( (IDCR>1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN + ! Test if we are inside an Object. + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID + LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) + CYCLE + ENDIF -! This routine adds to FDS EDGE array -! the sum of regular edges that are boundary at least a neighboring CC_CUTCFE face and -! one CC_GASPHASE face. + IF (.NOT.FOUND_LEFT) print*, "Error GET_X2INTERSECTIONS: DROP_SS_GG = .FALSE., Didn't find left side continuity." + IF ( NCRS_REMAIN /= 0) print*, "Error GET_X2INTERSECTIONS: DROP_SS_GG = .FALSE., NCRS_REMAIN /= 0." -USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_CELL,REALLOCATE_EDGE -INTEGER, INTENT(IN) :: NM + LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) -! Local variables: -INTEGER :: ECOUNT, CC_ECOUNT_RC, CC_ECOUNT_CE, CCOUNT, I, J, K, N_CC, N_RG, IE, IADD, JADD, KADD, IEC, N1, N2 -LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: CELL_ADDED -INTEGER :: ICMM,ICPM,ICPP,ICMP -INTEGER :: IDUM,IOR,IW1,IW2,CELL_COUNT_OLD -INTEGER, PARAMETER :: IAXIS_WALL_INDS(1:4) = (/ -3, -2, 2, 3 /) -INTEGER, PARAMETER :: JAXIS_WALL_INDS(1:4) = (/ -3, -1, 1, 3 /) -INTEGER, PARAMETER :: KAXIS_WALL_INDS(1:4) = (/ -2, -1, 1, 2 /) -LOGICAL :: DO_EDGE_FLG -TYPE(MESH_TYPE), POINTER :: M + ENDIF DROP_SS_GG_IF -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -CHARACTER(100) :: MSEGS_FILE +ENDDO IDCR_DO_2 -M => MESHES(NM) +! Copy final results: +CC_N_CRS = CC_N_CRS_AUX +CC_SVAR_CRS(1:CC_MAXCROSS_X2) = CC_SVAR_CRS_AUX(1:CC_MAXCROSS_X2) +CC_SEG_CRS(1:CC_MAXCROSS_X2) = CC_SEG_CRS_AUX(1:CC_MAXCROSS_X2) +CC_SEG_TAN(IAXIS:JAXIS,1:CC_MAXCROSS_X2) = CC_SEG_TAN_AUX(IAXIS:JAXIS,1:CC_MAXCROSS_X2) +! CC_IS_CRS2(LOW_IND:HIGH_IND,1:CC_MAXCROSS_X2) = CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,1:CC_MAXCROSS_X2) -IF (DEBUG_SET_CUTCELLS) THEN - ! Write out: - WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_rcsegs_mesh_',NM,'.dat' - OPEN(333,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') - CLOSE(333) +DO ICRS=1,CC_N_CRS + CC_IS_CRS(ICRS) = 2*( CC_IS_CRS2_AUX(LOW_IND,ICRS) + 1 ) - CC_IS_CRS2_AUX(HIGH_IND,ICRS) +ENDDO + +RETURN +END SUBROUTINE COLLAPSE_CROSSINGS + + +! ------------------------- INSERT_RAY_CROSS ------------------------------------ + +SUBROUTINE INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + +REAL(EB), INTENT(IN) :: SVARI, STANI(IAXIS:JAXIS) +INTEGER, INTENT(IN) :: ICRSI(LOW_IND:HIGH_IND+1), SCRSI + +! Local Variables: +INTEGER :: ICRS, IDUM +REAL(EB), ALLOCATABLE, DIMENSION(:) :: CC_SVAR_CRS_DUM +INTEGER, ALLOCATABLE, DIMENSION(:) :: CC_IS_CRS_DUM,CC_SEG_CRS_DUM,CC_BDNUM_CRS_DUM,CC_BDNUM_CRS_AUX_DUM +INTEGER, ALLOCATABLE, DIMENSION(:,:):: CC_IS_CRS2_DUM +REAL(EB), ALLOCATABLE, DIMENSION(:,:):: CC_SEG_TAN_DUM + + +CC_N_CRS = CC_N_CRS + 1 + +! Test maximum crossings defined: +IF ( CC_N_CRS > CC_MAXCROSS_X2) THEN + IDUM = CC_MAXCROSS_X2 + CC_MAXCROSS_X2 = IDUM + DELTA_CROSS_X2 + ! Allocate Intersection variables: + ALLOCATE(CC_SVAR_CRS_DUM(CC_MAXCROSS_X2),CC_IS_CRS_DUM(CC_MAXCROSS_X2),CC_SEG_CRS_DUM(CC_MAXCROSS_X2)) + CC_SVAR_CRS_DUM = 1._EB/GEOMEPS; CC_SVAR_CRS_DUM(1:IDUM) = CC_SVAR_CRS(1:IDUM) + CC_IS_CRS_DUM = CC_UNDEFINED; + CC_SEG_CRS_DUM = 0; CC_SEG_CRS_DUM(1:IDUM) = CC_SEG_CRS(1:IDUM) + ALLOCATE(CC_BDNUM_CRS_DUM(0:CC_MAXCROSS_X2),CC_BDNUM_CRS_AUX_DUM(0:CC_MAXCROSS_X2)) + CC_BDNUM_CRS_DUM = 0; CC_BDNUM_CRS_DUM(0:IDUM) = CC_BDNUM_CRS(0:IDUM) + CC_BDNUM_CRS_AUX_DUM= 0; CC_BDNUM_CRS_AUX_DUM(0:IDUM) = CC_BDNUM_CRS_AUX(0:IDUM) + ALLOCATE(CC_IS_CRS2_DUM(LOW_IND:HIGH_IND+1,CC_MAXCROSS_X2),CC_SEG_TAN_DUM(IAXIS:JAXIS,CC_MAXCROSS_X2)) + CC_IS_CRS2_DUM = CC_UNDEFINED; CC_IS_CRS2_DUM(LOW_IND:HIGH_IND+1,1:IDUM) = CC_IS_CRS2(LOW_IND:HIGH_IND+1,1:IDUM) + CC_SEG_TAN_DUM = 0._EB; CC_SEG_TAN_DUM(IAXIS:JAXIS,1:IDUM) = CC_SEG_TAN(IAXIS:JAXIS,1:IDUM) + CALL MOVE_ALLOC(FROM=CC_SVAR_CRS_DUM,TO=CC_SVAR_CRS) + CALL MOVE_ALLOC(FROM=CC_IS_CRS_DUM,TO=CC_IS_CRS) + CALL MOVE_ALLOC(FROM=CC_SEG_CRS_DUM,TO=CC_SEG_CRS) + CALL MOVE_ALLOC(FROM=CC_BDNUM_CRS_DUM,TO=CC_BDNUM_CRS) + CALL MOVE_ALLOC(FROM=CC_BDNUM_CRS_AUX_DUM,TO=CC_BDNUM_CRS_AUX) + CALL MOVE_ALLOC(FROM=CC_IS_CRS2_DUM,TO=CC_IS_CRS2) + CALL MOVE_ALLOC(FROM=CC_SEG_TAN_DUM,TO=CC_SEG_TAN) ENDIF -CALL POINT_TO_MESH(NM) +! Add in place, ascending value order: +DO ICRS=1,CC_N_CRS ! The updated CC_N_CRS is for ICRS to reach the + ! initialization value CC_SVAR_CRS(ICRS)=1/GEOMEPS. + IF ( SVARI < CC_SVAR_CRS(ICRS) ) EXIT +ENDDO -! Return if nothing to do for the mesh: -IF(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH == 0) RETURN +! Here copy from the back (updated CC_N_CRS) to the ICRS location: +! if ICRS=CC_N_CRS -> nothing gets copied: +DO IDUM = CC_N_CRS,ICRS+1,-1 + CC_SVAR_CRS(IDUM) = CC_SVAR_CRS(IDUM-1) + CC_IS_CRS2(LOW_IND:HIGH_IND+1,IDUM) = CC_IS_CRS2(LOW_IND:HIGH_IND+1,IDUM-1) + CC_SEG_CRS(IDUM) = CC_SEG_CRS(IDUM-1); + CC_SEG_TAN(IAXIS:JAXIS,IDUM)= CC_SEG_TAN(IAXIS:JAXIS,IDUM-1); + CC_BDNUM_CRS(IDUM) = CC_BDNUM_CRS(IDUM-1) +ENDDO -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating REGULAR_CUTCELL_EDGES_BC for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating REGULAR_CUTCELL_EDGES_BC for mesh :',NM,' ..' +CC_SVAR_CRS(ICRS) = SVARI ! x2 location. +CC_IS_CRS2(LOW_IND:HIGH_IND+1,ICRS) = ICRSI(LOW_IND:HIGH_IND+1) ! Does point separate GASPHASE from SOLID? +CC_SEG_CRS(ICRS) = SCRSI ! Segment on BOINT_PLANE the crossing belongs to. +CC_SEG_TAN(IAXIS:JAXIS,ICRS) = STANI(IAXIS:JAXIS) ! CC_SEG_TAN might not be needed in new implementation. +CC_BDNUM_CRS(ICRS) = 0 +IF (SCRSI > 0) THEN + IF(ICRSI(LOW_IND) == CC_GASPHASE .AND. ICRSI(HIGH_IND) == CC_SOLID) THEN + CC_BDNUM_CRS(ICRS) = 1 + ELSEIF(ICRSI(LOW_IND) == CC_SOLID .AND. ICRSI(HIGH_IND) == CC_GASPHASE) THEN + CC_BDNUM_CRS(ICRS) =-1 + ENDIF ENDIF +RETURN +END SUBROUTINE INSERT_RAY_CROSS -ALLOCATE(CELL_ADDED(0:IBP1,0:JBP1,0:KBP1)); CELL_ADDED = .FALSE. +! ----------------------- GET_BODINT_NODE_INDEX ---------------------------------- -! Now count added edge number for mesh N_EDGES_DIM_CC(2,NM), and added non zero cell indexes for mesh +SUBROUTINE GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ,IND_PI) -ECOUNT = 0; CC_ECOUNT_RC=0; CC_ECOUNT_CE = 0; CCOUNT = 0; +TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE +INTEGER, INTENT(IN) :: X2AXIS,X3AXIS +REAL(EB), INTENT(IN) :: XYZ(MAX_DIM) +INTEGER, INTENT(OUT) :: IND_PI -! X axis edges: -DO K=0,KBAR - DO J=0,JBAR - IX_LOOP_1 : DO I=1,IBAR - DO_EDGE_FLG = .FALSE. - IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in Y. - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO JADD=0,1 ! Faces aligned in Z. - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,IAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IX_LOOP_1 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IX_LOOP_1 +! Local variables: +INTEGER :: INOD=1, PIVOT(LOW_IND:HIGH_IND), INOD2 +REAL(EB):: DIFFX2, DIFFX3 + +! Test if XYZ is already on BODINT_PLANE%XYZ: +IND_PI = -1 ! Initialize to negative index. +IF (BODINT_PLANE%NNODS < LINSEARCH_LIMIT) THEN + ! Linear Search: + DO INOD=1,BODINT_PLANE%NNODS + DIFFX2 = BODINT_PLANE%XYZ(X2AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X2AXIS) + IF( DIFFX2 > GEOMEPS ) THEN + EXIT + ELSEIF( ABS(DIFFX2) <= GEOMEPS) THEN + DIFFX3 = BODINT_PLANE%XYZ(X3AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X3AXIS) + IF ( DIFFX3 > GEOMEPS ) THEN + EXIT + ELSEIF ( ABS(DIFFX3) <= GEOMEPS ) THEN + IND_PI = BODINT_PLANE%NOD_PERM(INOD) + RETURN ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO KADD=0,1 - DO JADD=0,1 - IF(CELL_INDEX(I ,J+JADD,K+KADD)==0 .AND. .NOT.CELL_ADDED(I ,J+JADD,K+KADD)) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I ,J+JADD,K+KADD) = .TRUE. - ENDIF - ENDDO - ENDDO - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=IAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-2) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) - CASE( 2) - IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) - CASE(-3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 - ENDIF - ENDDO - ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE - ELSE - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE - ENDIF + ENDIF + ENDDO +ELSE + ! Binary Search: + PIVOT(LOW_IND) = 0 + PIVOT(HIGH_IND)= BODINT_PLANE%NNODS + 1 + DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) + INOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 + DIFFX2 = BODINT_PLANE%XYZ(X2AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X2AXIS) + IF( DIFFX2 < -GEOMEPS ) THEN + PIVOT(LOW_IND) = INOD + ELSEIF( DIFFX2 > GEOMEPS ) THEN + PIVOT(HIGH_IND)= INOD + ELSE ! ABS(DIFFX2) < GEOMEPS + DIFFX3 = BODINT_PLANE%XYZ(X3AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X3AXIS) + IF ( DIFFX3 < -GEOMEPS ) THEN + PIVOT(LOW_IND) = INOD + ELSEIF( DIFFX3 > GEOMEPS ) THEN + PIVOT(HIGH_IND)= INOD + ELSE ! ABS(DIFFX3) < GEOMEPS + IND_PI = BODINT_PLANE%NOD_PERM(INOD) + RETURN ENDIF - ENDDO IX_LOOP_1 + ENDIF ENDDO + INOD=PIVOT(HIGH_IND) +ENDIF + +! Insert add NOD_PERM permutation array, O(NP) operation: +DO INOD2=BODINT_PLANE%NNODS+1,INOD+1,-1 + BODINT_PLANE%NOD_PERM(INOD2) = BODINT_PLANE%NOD_PERM(INOD2-1) ENDDO +IND_PI = BODINT_PLANE%NNODS + 1 +BODINT_PLANE%NNODS = IND_PI +BODINT_PLANE%NOD_PERM(INOD) = IND_PI +BODINT_PLANE%XYZ(IAXIS:KAXIS,IND_PI) = XYZ(IAXIS:KAXIS) -! Y axis edges: -DO K=0,KBAR - DO J=1,JBAR - IY_LOOP_1 : DO I=0,IBAR - DO_EDGE_FLG = .FALSE. - IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in X. - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Z. - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,JAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IY_LOOP_1 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IY_LOOP_1 - ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO KADD=0,1 - DO IADD=0,1 - IF(CELL_INDEX(I+IADD,J ,K+KADD)==0 .AND. .NOT.CELL_ADDED(I+IADD,J ,K+KADD)) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I+IADD,J ,K+KADD) = .TRUE. - ENDIF - ENDDO - ENDDO - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=JAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) - CASE( 1) - IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) - CASE(-3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 - ENDIF - ENDDO - ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE - ELSE - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE - ENDIF - ENDIF - ENDDO IY_LOOP_1 - ENDDO -ENDDO +RETURN +END SUBROUTINE GET_BODINT_NODE_INDEX -! Z axis edges: -DO K=1,KBAR - DO J=0,JBAR - IZ_LOOP_1 : DO I=0,IBAR - DO_EDGE_FLG = .FALSE. - IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN - N_CC = 0; N_RG = 0 - DO JADD=0,1 ! Faces aligned in X. - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Y. - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,KAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IZ_LOOP_1 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IZ_LOOP_1 - ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO JADD=0,1 - DO IADD=0,1 - IF(CELL_INDEX(I+IADD,J+JADD,K )==0 .AND. .NOT.CELL_ADDED(I+IADD,J+JADD,K )) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I+IADD,J+JADD,K ) = .TRUE. - ENDIF - ENDDO - ENDDO - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=KAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) - CASE( 1) - IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) - CASE(-2) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) - CASE( 2) - IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 - ENDIF - ENDDO - ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE - ELSE - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE - ENDIF - ENDIF - ENDDO IZ_LOOP_1 - ENDDO -ENDDO -IF (CC_ECOUNT_RC+CC_ECOUNT_CE==0) THEN - DEALLOCATE(CELL_ADDED) - RETURN -ENDIF +! ---------------------- GET_BODINT_NODE_INDEX ---------------------------------- -! Allocate CC_RCEDGE: -M%CC_NRCEDGE = CC_ECOUNT_RC -ALLOCATE(M%CC_RCEDGE(1:CC_ECOUNT_RC)) +! SUBROUTINE GET_BODINT_NODE_INDEX(X2AXIS,X3AXIS,XYZ,IND_PI) +! +! INTEGER, INTENT(IN) :: X2AXIS,X3AXIS +! REAL(EB), INTENT(IN) :: XYZ(MAX_DIM) +! INTEGER, INTENT(OUT) :: IND_PI +! +! ! Local variables: +! !LOGICAL :: INLIST +! INTEGER :: INOD +! +! ! Test if XYZ is already on BODINT_PLANE%XYZ: +! ! INLIST = .FALSE. +! IND_PI = -1 ! Initialize to negative index. +! DO INOD=1,BODINT_PLANE%NNODS +! IF(ABS(BODINT_PLANE%XYZ(X2AXIS,INOD)-XYZ(X2AXIS)) > GEOMEPS) CYCLE +! IF(ABS(BODINT_PLANE%XYZ(X3AXIS,INOD)-XYZ(X3AXIS)) > GEOMEPS) CYCLE +! IND_PI = INOD +! RETURN +! ENDDO +! +! WRITE(LU_ERR,*) 'X2AXIS,X3AXIS',X2AXIS,X3AXIS,BODINT_PLANE%NNODS,INOD +! IND_PI = BODINT_PLANE%NNODS + 1 +! BODINT_PLANE%NNODS = IND_PI +! BODINT_PLANE%XYZ(IAXIS:KAXIS,IND_PI) = XYZ +! DO INOD=1,BODINT_PLANE%NNODS +! WRITE(LU_ERR,*) INOD,BODINT_PLANE%XYZ(IAXIS:KAXIS,INOD) +! ENDDO +! RETURN +! END SUBROUTINE GET_BODINT_NODE_INDEX -! Reallocate EDGE variables -N1 = UBOUND(MESHES(NM)%EDGE,DIM=1) -N2 = EDGE_COUNT(NM) + ECOUNT -IF (ECOUNT>0 .AND. N2>N1) CALL REALLOCATE_EDGE(NM,N1,N2) +! -------------------- LINE_INTERSECT_COORDPLANE -------------------------------- -! Reallocate CELL variables +SUBROUTINE LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LNC,XYZ_INT,INTFLG) -CELL_COUNT_OLD = CELL_COUNT(NM) -IF (CCOUNT > 0) CALL REALLOCATE_CELL(NM,CELL_COUNT(NM),CELL_COUNT(NM)+CCOUNT) -CCOUNT = CELL_COUNT_OLD +INTEGER, INTENT(IN) :: X1AXIS +REAL(EB), INTENT(IN) :: X1PLN,PLNORMAL(MAX_DIM),LNC(MAX_DIM,NOD1:NOD2) +REAL(EB), INTENT(OUT):: XYZ_INT(MAX_DIM) +LOGICAL, INTENT(OUT) :: INTFLG -! Finally repeat search process and assign edge and cell values to cut-cell region entities: +! Local variables: +REAL(EB) :: DVEC(MAX_DIM), DIRV(MAX_DIM), NMDV, DENOM, PLNEQ, TLINE +! REAL(QB) :: DVECQ(MAX_DIM), DIRVQ(MAX_DIM), NMDVQ, DENOMQ, PLNEQQ, TLINEQ -CC_ECOUNT_RC=0; CC_ECOUNT_CE = 0 -! X axis edges: -DO K=0,KBAR - DO J=0,JBAR - IX_LOOP_2 : DO I=1,IBAR - DO_EDGE_FLG = .FALSE. - IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in Y. - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO JADD=0,1 ! Faces aligned in Z. - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,IAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IX_LOOP_2 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IX_LOOP_2 - ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO KADD=0,1 - DO JADD=0,1 - IF(M%CELL_INDEX(I ,J+JADD,K+KADD)==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - M%CELL_INDEX(I ,J+JADD,K+KADD) = CCOUNT - M%CELL(CCOUNT)%I = I - M%CELL(CCOUNT)%J = J+JADD - M%CELL(CCOUNT)%K = K+KADD - ENDIF - ENDDO - ENDDO - ICMM = M%CELL_INDEX(I ,J ,K ) - ICPM = M%CELL_INDEX(I ,J+1,K ) - ICPP = M%CELL_INDEX(I ,J+1,K+1) - ICMP = M%CELL_INDEX(I ,J ,K+1) - M%EDGE(IE)%I = I - M%EDGE(IE)%J = J - M%EDGE(IE)%K = K - M%EDGE(IE)%AXIS = IAXIS - M%EDGE(IE)%CELL_INDEX_MM = ICMM - M%EDGE(IE)%CELL_INDEX_PM = ICPM - M%EDGE(IE)%CELL_INDEX_MP = ICMP - M%EDGE(IE)%CELL_INDEX_PP = ICPP - M%CELL(ICPP)%EDGE_INDEX(1) = IE - M%CELL(ICMP)%EDGE_INDEX(2) = IE - M%CELL(ICPM)%EDGE_INDEX(3) = IE - M%CELL(ICMM)%EDGE_INDEX(4) = IE - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=IAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-2) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) - CASE( 2) - IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) - CASE(-3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 - ENDIF - ENDDO - ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 - ! Add info to CC_RCEDGE: - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS - M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE - ! Note RCEDGE number in ECVAR: - M%ECVAR(I,J,K,CC_IDCE,IAXIS) = CC_ECOUNT_RC - ELSE ! CUT_EDGE: - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 - IEC = M%ECVAR(I,J,K,CC_IDCE,IAXIS) - M%CUT_EDGE(IEC)%IE = IE - ENDIF - ENDIF - ENDDO IX_LOOP_2 - ENDDO -ENDDO +! Initialize: +INTFLG = .FALSE. +XYZ_INT(IAXIS:KAXIS) = 0._EB -! Y axis edges: -DO K=0,KBAR - DO J=1,JBAR - IY_LOOP_2 : DO I=0,IBAR - DO_EDGE_FLG = .FALSE. - IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in X. - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Z. - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,JAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IY_LOOP_2 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IY_LOOP_2 - ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO KADD=0,1 - DO IADD=0,1 - IF(M%CELL_INDEX(I+IADD,J ,K+KADD)==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - M%CELL_INDEX(I+IADD,J ,K+KADD) = CCOUNT - M%CELL(CCOUNT)%I = I+IADD - M%CELL(CCOUNT)%J = J - M%CELL(CCOUNT)%K = K+KADD - ENDIF - ENDDO - ENDDO - ICMM = M%CELL_INDEX(I ,J ,K ) - ICMP = M%CELL_INDEX(I+1,J ,K ) - ICPP = M%CELL_INDEX(I+1,J ,K+1) - ICPM = M%CELL_INDEX(I ,J ,K+1) - M%EDGE(IE)%I = I - M%EDGE(IE)%J = J - M%EDGE(IE)%K = K - M%EDGE(IE)%AXIS = JAXIS - M%EDGE(IE)%CELL_INDEX_MM = ICMM - M%EDGE(IE)%CELL_INDEX_PM = ICPM - M%EDGE(IE)%CELL_INDEX_MP = ICMP - M%EDGE(IE)%CELL_INDEX_PP = ICPP - M%CELL(ICPP)%EDGE_INDEX(5) = IE - M%CELL(ICPM)%EDGE_INDEX(6) = IE - M%CELL(ICMP)%EDGE_INDEX(7) = IE - M%CELL(ICMM)%EDGE_INDEX(8) = IE - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=JAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) - CASE( 1) - IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) - CASE(-3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 - ENDIF - ENDDO - ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 - ! Add info to CC_RCEDGE: - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS - M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE - ! Note RCEDGE number in ECVAR: - M%ECVAR(I,J,K,CC_IDCE,JAXIS) = CC_ECOUNT_RC - ELSE ! CUT_EDGE: - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 - IEC = M%ECVAR(I,J,K,CC_IDCE,JAXIS) - M%CUT_EDGE(IEC)%IE = IE - ENDIF - ENDIF - ENDDO IY_LOOP_2 +! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN +! Preliminary calculations: +DVEC(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD2) - LNC(IAXIS:KAXIS,NOD1) +NMDV = SQRT( DVEC(IAXIS)**2._EB + DVEC(JAXIS)**2._EB + DVEC(KAXIS)**2._EB ) +DIRV = DVEC(IAXIS:KAXIS) * NMDV**(-1._EB) +DENOM = DIRV(IAXIS)*PLNORMAL(IAXIS) +DIRV(JAXIS)*PLNORMAL(JAXIS) +DIRV(KAXIS)*PLNORMAL(KAXIS) +PLNEQ = LNC(IAXIS,NOD1)*PLNORMAL(IAXIS) + & + LNC(JAXIS,NOD1)*PLNORMAL(JAXIS) + & + LNC(KAXIS,NOD1)*PLNORMAL(KAXIS) - X1PLN + +! Line parallel to plane: +IF ( ABS(DENOM) < GEOMEPS ) THEN + ! Check if seg lies on plane or not. + ! Do this by checking if node one of segment is on plane. + IF ( ABS(PLNEQ) < GEOMEPS ) THEN + XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1); XYZ_INT(X1AXIS) = X1PLN + INTFLG = .TRUE. + ENDIF + RETURN +ENDIF + +! Non parallel case: +TLINE = -PLNEQ/DENOM ! Coordinate along the line LNC. +XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1) + TLINE*DIRV(IAXIS:KAXIS) ! Intersection point. +XYZ_INT(X1AXIS) = X1PLN ! Force X1AXIS coordinate to be the planes value. +! ELSE +! ! Preliminary calculations: +! DVECQ(IAXIS:KAXIS) = REAL(LNC(IAXIS:KAXIS,NOD2),QB) - REAL(LNC(IAXIS:KAXIS,NOD1),QB) +! NMDVQ = SQRT( DVECQ(IAXIS)**2._QB + DVECQ(JAXIS)**2._QB + DVECQ(KAXIS)**2._QB ) +! DIRVQ = DVECQ(IAXIS:KAXIS) * NMDVQ**(-1._QB) +! DENOMQ = DIRVQ(IAXIS)*REAL(PLNORMAL(IAXIS),QB) + & +! DIRVQ(JAXIS)*REAL(PLNORMAL(JAXIS),QB) + & +! DIRVQ(KAXIS)*REAL(PLNORMAL(KAXIS),QB) +! PLNEQQ = REAL(LNC(IAXIS,NOD1),QB)*REAL(PLNORMAL(IAXIS),QB) + & +! REAL(LNC(JAXIS,NOD1),QB)*REAL(PLNORMAL(JAXIS),QB) + & +! REAL(LNC(KAXIS,NOD1),QB)*REAL(PLNORMAL(KAXIS),QB) - REAL(X1PLN,QB) +! +! ! Line parallel to plane: +! IF ( ABS(REAL(DENOMQ,EB)) < GEOMEPS ) THEN +! ! Check if seg lies on plane or not. +! ! Do this by checking if node one of segment is on plane. +! IF ( ABS(REAL(PLNEQ,EB)) < GEOMEPS ) THEN +! XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1); XYZ_INT(X1AXIS) = X1PLN +! INTFLG = .TRUE. +! ENDIF +! RETURN +! ENDIF +! +! ! Non parallel case: +! TLINEQ = -PLNEQQ/DENOMQ ! Coordinate along the line LNC. +! XYZ_INT(IAXIS:KAXIS) = REAL(REAL(LNC(IAXIS:KAXIS,NOD1),QB)+TLINEQ*DIRVQ(IAXIS:KAXIS),EB) ! Intersection pt. +! XYZ_INT(X1AXIS) = X1PLN ! Force X1AXIS coordinate to be the planes value. +! ENDIF + +INTFLG = .TRUE. + +RETURN +END SUBROUTINE LINE_INTERSECT_COORDPLANE + + +! ------------------------- CC_INIT_GEOM --------------------------------------- + +SUBROUTINE CC_INIT_GEOM + +! Local Variables: +INTEGER :: IG, IWSEL, INOD, IEDGE, NVERT, NWSEL, NWSEDG, IEDLIST, IX, N_TENT_EDGES +INTEGER :: WSELEM(NOD1:NOD3),SEG(NOD1:NOD2) +REAL(EB):: XYZV(MAX_DIM,NODS_WSEL), V12(MAX_DIM), V23(MAX_DIM), V31(MAX_DIM), WSNORM(MAX_DIM) +REAL(EB):: X12(MAX_DIM), X23(MAX_DIM), X31(MAX_DIM), SQAREA(MAX_DIM), INT2 +REAL(EB):: MGNRM, XCEN +REAL(EB):: GEOMEPSSQ ! Local epsilon for GEOM quality check +INTEGER, ALLOCATABLE, DIMENSION(:,:):: EDGES2 +LOGICAL, ALLOCATABLE, DIMENSION(:) :: COUNTED_VERT +! REAL(QB) :: V12Q(IAXIS:KAXIS),V23Q(IAXIS:KAXIS),V31Q(IAXIS:KAXIS),WSNORMQ(IAXIS:KAXIS),MGNRMQ + +REAL(EB) :: CPUTIME_START, CPUTIME + +IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_ERR,'(A,I5,A)',advance="no") ' 1b. Number of Geometries : ',N_GEOMETRY,& + ', CC_INIT_GEOM, processed GEOMETRY : ' +ENDIF + +! In this subroutine the quality of the GEOM lines is checked +! Calc local squared epsilon for GEOM quality check +GEOMEPSSQ = (GEOMEPS * GEOMQUALITYFCT)**2._EB + +! Geometry loop: +GEOMETRY_LOOP : DO IG=1,N_GEOMETRY + + NWSEL = GEOMETRY(IG)%N_FACES + NVERT = GEOMETRY(IG)%N_VERTS + + IF (GEOMETRY(IG)%IS_TERRAIN) THEN ! Terrain is always manifold with volume. + N_TENT_EDGES = INT(1.55_EB*REAL(NWSEL,EB)) ! Number of edges is 1.5 number of triangles. + ELSE + N_TENT_EDGES = 3*NWSEL + ENDIF + + ! Allocate fields of Geometry used by IBM: + ! WS Faces normal unit vectors: + IF (ALLOCATED(GEOMETRY(IG)%FACES_NORMAL)) DEALLOCATE(GEOMETRY(IG)%FACES_NORMAL) + ALLOCATE(GEOMETRY(IG)%FACES_NORMAL(MAX_DIM,NWSEL)) + ! WS Faces areas: + IF (ALLOCATED(GEOMETRY(IG)%FACES_AREA)) DEALLOCATE(GEOMETRY(IG)%FACES_AREA) + ALLOCATE(GEOMETRY(IG)%FACES_AREA(NWSEL)) + ! WS Faces edges: + IF (ALLOCATED(GEOMETRY(IG)%EDGES)) DEALLOCATE(GEOMETRY(IG)%EDGES) + ALLOCATE(GEOMETRY(IG)%EDGES(NOD1:NOD2,N_TENT_EDGES)) ! Size large enough to take care of surfaces + ! (zero thickness immersed solids) and 3D domains + ! boundaries (what we call wet surfaces). + ! WS Faces edges: + IF (ALLOCATED(GEOMETRY(IG)%FACE_EDGES)) DEALLOCATE(GEOMETRY(IG)%FACE_EDGES) + ALLOCATE(GEOMETRY(IG)%FACE_EDGES(EDG1:EDG3,NWSEL)) ! Edges in GEOMETRY(IG)%EDGES for this triangle. + ! WS Edges faces: + IF (ALLOCATED(GEOMETRY(IG)%EDGE_FACES)) DEALLOCATE(GEOMETRY(IG)%EDGE_FACES) + ALLOCATE(GEOMETRY(IG)%EDGE_FACES(5,N_TENT_EDGES)) ! Triangles sharing this edge [niel iwel1 LocEdge1 iwel2 LocEdge2] + + ! COUNTED_VERT used for test of loose vertices: + ALLOCATE(COUNTED_VERT(1:NVERT)); COUNTED_VERT = .FALSE. + + GEOMETRY(IG)%GEOM_VOLUME = 0._EB + GEOMETRY(IG)%GEOM_AREA = 0._EB + GEOMETRY(IG)%GEOM_XYZCEN(:) = 0._EB + + ! Compute normal, area and volume: + SQAREA(IAXIS:KAXIS) = 0._EB + DO IWSEL=1,NWSEL + + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + + COUNTED_VERT(WSELEM(NOD1:NOD3)) = .TRUE. + + ! Triangles NODES coordinates: + DO INOD=NOD1,NOD3 + XYZV(IAXIS:KAXIS,INOD) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+1:MAX_DIM*WSELEM(INOD)) + ENDDO + + V12(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD2) - XYZV(IAXIS:KAXIS,NOD1) + V23(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD3) - XYZV(IAXIS:KAXIS,NOD2) + V31(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD1) - XYZV(IAXIS:KAXIS,NOD3) + + ! Check that face edges are not too small + IF ((V12(IAXIS)**2._EB + V12(JAXIS)**2._EB + V12(KAXIS)**2._EB ) < GEOMEPSSQ) THEN + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD2) + WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD1),', ',WSELEM(NOD2),' are not equal.' + ENDIF + CALL SHUTDOWN("") ; RETURN + ENDIF + IF ((V23(IAXIS)**2._EB + V23(JAXIS)**2._EB + V23(KAXIS)**2._EB ) < GEOMEPSSQ) THEN + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD3) + WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD2),', ',WSELEM(NOD3),' are not equal.' + END IF + CALL SHUTDOWN("") ; RETURN + ENDIF + IF ((V31(IAXIS)**2._EB + V31(JAXIS)**2._EB + V31(KAXIS)**2._EB ) < GEOMEPSSQ) THEN + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(MESSAGE,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD1) + WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD1),', ',WSELEM(NOD3),' are not equal.' + ENDIF + CALL SHUTDOWN("") ; RETURN + END IF + + ! Cross V12 x V23: + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + WSNORM(IAXIS) = V12(JAXIS)*V23(KAXIS) - V12(KAXIS)*V23(JAXIS) + WSNORM(JAXIS) = V12(KAXIS)*V23(IAXIS) - V12(IAXIS)*V23(KAXIS) + WSNORM(KAXIS) = V12(IAXIS)*V23(JAXIS) - V12(JAXIS)*V23(IAXIS) + MGNRM = SQRT( WSNORM(IAXIS)**2._EB + WSNORM(JAXIS)**2._EB + WSNORM(KAXIS)**2._EB ) + ! ELSE + ! V12Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD2),QB) - REAL(XYZV(IAXIS:KAXIS,NOD1),QB) + ! V23Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD3),QB) - REAL(XYZV(IAXIS:KAXIS,NOD2),QB) + ! V31Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD1),QB) - REAL(XYZV(IAXIS:KAXIS,NOD3),QB) + ! WSNORMQ(IAXIS) = V12Q(JAXIS)*V23Q(KAXIS) - V12Q(KAXIS)*V23Q(JAXIS) + ! WSNORMQ(JAXIS) = V12Q(KAXIS)*V23Q(IAXIS) - V12Q(IAXIS)*V23Q(KAXIS) + ! WSNORMQ(KAXIS) = V12Q(IAXIS)*V23Q(JAXIS) - V12Q(JAXIS)*V23Q(IAXIS) + ! MGNRMQ = SQRT( WSNORMQ(IAXIS)**2._QB + WSNORMQ(JAXIS)**2._QB + WSNORMQ(KAXIS)**2._QB ) + ! MGNRM = REAL(MGNRMQ,EB) + ! ENDIF + + XCEN = (XYZV(IAXIS,NOD1) + XYZV(IAXIS,NOD2) + XYZV(IAXIS,NOD3)) / 3._EB + + ! Check that face area is not too small + IF(MGNRM < GEOMEPSSQ) THEN + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(728): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,3F12.3)') " Face area too small at:", XYZV(IAXIS:KAXIS,NOD1) + WRITE(LU_ERR,*) ' Face IWSEL=', IWSEL, ', Connectivity=', WSELEM(NOD1:NOD3),', Norm Cross=', MGNRM + ENDIF + CALL SHUTDOWN("") ; RETURN + ENDIF + + ! Assign to GEOMETRY: + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) = WSNORM(IAXIS:KAXIS) * MGNRM**(-1._EB) + GEOMETRY(IG)%FACES_AREA(IWSEL) = MGNRM/2._EB + ! ELSE + ! GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) = REAL(WSNORMQ(IAXIS:KAXIS)*MGNRMQ**(-1._QB),EB) + ! GEOMETRY(IG)%FACES_AREA(IWSEL) = REAL(MGNRMQ/2._QB,EB) + ! ENDIF + + ! Total Area and Volume for GEOMETRY(IG). + GEOMETRY(IG)%GEOM_AREA = GEOMETRY(IG)%GEOM_AREA + GEOMETRY(IG)%FACES_AREA(IWSEL) + GEOMETRY(IG)%GEOM_VOLUME= GEOMETRY(IG)%GEOM_VOLUME+ & ! Divergence theorem with F = x i, assumes we have a volume. + GEOMETRY(IG)%FACES_NORMAL(IAXIS,IWSEL)*XCEN*GEOMETRY(IG)%FACES_AREA(IWSEL) + + ! Define Centroid: + X12(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD1) + XYZV(IAXIS:KAXIS,NOD2)) + X23(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD2) + XYZV(IAXIS:KAXIS,NOD3)) + X31(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD3) + XYZV(IAXIS:KAXIS,NOD1)) + ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA + DO IX=IAXIS,KAXIS + INT2 = (X12(IX)**2._EB + X23(IX)**2._EB + X31(IX)**2._EB) / 3._EB + SQAREA(IX) = SQAREA(IX) + GEOMETRY(IG)%FACES_NORMAL(IX,IWSEL)*INT2*GEOMETRY(IG)%FACES_AREA(IWSEL) ! Midpt rule. + ENDDO ENDDO -ENDDO -! Z axis edges: -DO K=1,KBAR - DO J=0,JBAR - IZ_LOOP_2 : DO I=0,IBAR - DO_EDGE_FLG = .FALSE. - IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN - N_CC = 0; N_RG = 0 - DO JADD=0,1 ! Faces aligned in X. - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Y. - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,KAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IZ_LOOP_2 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IZ_LOOP_2 + ! In the broken case where GEOM normals are wrong, GEOM_VOLUME can become too small + IF(GEOMETRY(IG)%GEOM_VOLUME < GEOMEPSSQ) THEN + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(729): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A)') " Geometry volume too small." + WRITE(LU_ERR,'(A)') " Face normals are probably pointing in the wrong direction. " + WRITE(LU_ERR,'(A)') " Check they point towards the gas phase." + ENDIF + CALL SHUTDOWN("") ; RETURN + ENDIF + + ! Geometry Centroid: + DO IX=IAXIS,KAXIS + GEOMETRY(IG)%GEOM_XYZCEN(IX) = SQAREA(IX) / (2._EB * GEOMETRY(IG)%GEOM_VOLUME) + ENDDO + + ! Build geometry connectivity + ! While building, check that the triangulated surface is manifold and oriented + NWSEDG = 0 + IX = SIZE(GEOMETRY(IG)%FACES,DIM=1) + CALL GET_GEOM_EDGES(NVERT,NWSEL,IX,GEOMETRY(IG)%FACES,NWSEDG,GEOMETRY(IG)%EDGES,& + GEOMETRY(IG)%FACE_EDGES,GEOMETRY(IG)%EDGE_FACES) + + ! Perform manifoldness tests: + ALLOCATE(EDGES2(2,NWSEDG)); EDGES2=0 + DO IWSEL=1,NWSEL + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + DO IEDGE=EDG1,EDG3 + IEDLIST = GEOMETRY(IG)%FACE_EDGES(IEDGE,IWSEL) + IF(WSELEM(IEDGE) == GEOMETRY(IG)%EDGES(NOD1,IEDLIST)) THEN ! First node of face edge equals first node of seg. + EDGES2(1,IEDLIST)=EDGES2(1,IEDLIST)+1 + ELSEIF(WSELEM(IEDGE) == GEOMETRY(IG)%EDGES(NOD2,IEDLIST)) THEN ! Inverted. + EDGES2(2,IEDLIST)=EDGES2(2,IEDLIST)+1 ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO JADD=0,1 - DO IADD=0,1 - IF(M%CELL_INDEX(I+IADD,J+JADD,K )==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - M%CELL_INDEX(I+IADD,J+JADD,K ) = CCOUNT - M%CELL(CCOUNT)%I = I+IADD - M%CELL(CCOUNT)%J = J+JADD - M%CELL(CCOUNT)%K = K - ENDIF - ENDDO - ENDDO - ICMM = M%CELL_INDEX(I ,J ,K ) - ICPM = M%CELL_INDEX(I+1,J ,K ) - ICPP = M%CELL_INDEX(I+1,J+1,K ) - ICMP = M%CELL_INDEX(I ,J+1,K ) - M%EDGE(IE)%I = I - M%EDGE(IE)%J = J - M%EDGE(IE)%K = K - M%EDGE(IE)%AXIS = KAXIS - M%EDGE(IE)%CELL_INDEX_MM = ICMM - M%EDGE(IE)%CELL_INDEX_PM = ICPM - M%EDGE(IE)%CELL_INDEX_MP = ICMP - M%EDGE(IE)%CELL_INDEX_PP = ICPP - M%CELL(ICPP)%EDGE_INDEX( 9) = IE - M%CELL(ICMP)%EDGE_INDEX(10) = IE - M%CELL(ICPM)%EDGE_INDEX(11) = IE - M%CELL(ICMM)%EDGE_INDEX(12) = IE + ENDDO + ENDDO + DO IWSEL=1,NWSEDG + IF(SUM(EDGES2(1:2,IWSEL)) < 2) THEN ! Less that two faces have this edge as boundary: + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEL) + XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) + XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=KAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) - CASE( 1) - IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) - CASE(-2) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) - CASE( 2) - IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 - ENDIF - ENDDO + WRITE(LU_ERR,'(A,A,A)') "ERROR(730): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 - ! Add info to CC_RCEDGE: - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS - M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE - ! Note RCEDGE number in ECVAR: - M%ECVAR(I,J,K,CC_IDCE,KAXIS) = CC_ECOUNT_RC - ELSE ! CUT_EDGE: - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 - IEC = M%ECVAR(I,J,K,CC_IDCE,KAXIS) - M%CUT_EDGE(IEC)%IE = IE + WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') " Open geometry at edge with nodes: NOD1",SEG(NOD1),& + " (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",SEG(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" + ENDIF + CALL SHUTDOWN("") ; RETURN + + ELSEIF(SUM(EDGES2(1:2,IWSEL)) > 2) THEN ! More than two faces share this edge: + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEL) + XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) + XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(731): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" ENDIF + WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') " Non manifold geometry in adjacent faces at edge with nodes: NOD1",& + SEG(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",SEG(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" ENDIF - ENDDO IZ_LOOP_2 - ENDDO -ENDDO + CALL SHUTDOWN("") ; RETURN -DEALLOCATE(CELL_ADDED) + ELSEIF(ANY(EDGES2(1:2,IWSEL) > 1)) THEN ! half edge counted more than once, opposite normals on triangles + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEL) + XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) + XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(732): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') & + " Opposite normals on triangles sharing edge with nodes: NOD1",& + SEG(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",SEG(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" + ENDIF + CALL SHUTDOWN("") ; RETURN -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - WRITE(LU_SETCC,'(A,F8.3,A,7I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Reg-CC edges for BC : ',CC_ECOUNT_RC,M%CC_NRCEDGE,CC_ECOUNT_CE, & - EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,7I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Reg-CC edges for BC : ',CC_ECOUNT_RC,M%CC_NRCEDGE,CC_ECOUNT_CE, & - EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' - ENDIF - ! DO I=1,M%CC_NRCEDGE - ! WRITE(LU_ERR,*) 'IE,I,J,K,IAXIS=',M%CC_RCEDGE(I)%IE,M%CC_RCEDGE(I)%IJK(IAXIS:KAXIS+1) - ! ENDDO -ENDIF + ENDIF + ENDDO + DEALLOCATE(EDGES2) -IF (DEBUG_SET_CUTCELLS) THEN - ! Write segment information for the mesh if it belongs to the process: - ! Write out: - WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_rcsegs_mesh_',NM,'.dat' - LU_DB_SETCC = GET_FILE_NUMBER() - OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') - !WRITE(LU_ERR,*) TRIM(MSEGS_FILE),M%CC_NRCEDGE,CC_ECOUNT_RC - DO ECOUNT=1,M%CC_NRCEDGE - I=M%CC_RCEDGE(ECOUNT)%IJK(IAXIS) - J=M%CC_RCEDGE(ECOUNT)%IJK(JAXIS) - K=M%CC_RCEDGE(ECOUNT)%IJK(KAXIS) - IE=M%CC_RCEDGE(ECOUNT)%IJK(KAXIS+1) - SELECT CASE(IE) - CASE(IAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DX(I),XC(I),Y(J),Z(K) - CASE(JAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DY(J),X(I),YC(J),Z(K) - CASE(KAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DZ(K),X(I),Y(J),ZC(K) - END SELECT + ! Check if the surface is closed + ! Each halfedge should be coupled with an opposite halfedge + DO IEDLIST=1,NWSEDG + IF (GEOMETRY(IG)%EDGE_FACES(1,IEDLIST) == 1) THEN + XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) + XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(733): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') " Open geometry at edge with nodes: NOD1",& + WSELEM(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",WSELEM(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" + ENDIF + CALL SHUTDOWN("") ; RETURN + ENDIF ENDDO - CLOSE(LU_DB_SETCC) -ENDIF -RETURN -END SUBROUTINE GET_REGULAR_CUT_EDGES_BC + ! Check that all vertices are counted: + DO INOD=1,NVERT + IF (.NOT.COUNTED_VERT(INOD) .AND. MY_RANK==0) & + WRITE(LU_ERR,'(A,A,A,I8,A)') " WARNING: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "': Vertex ",INOD," not connected." + ENDDO + DEALLOCATE(COUNTED_VERT) + GEOMETRY(IG)%N_EDGES = NWSEDG -! --------------------- GET_SOLID_CUTCELL_EDGES_BC -------------------------------- + ! At this point the surface is manifold, well oriented, and closed. -SUBROUTINE GET_SOLID_CUTCELL_EDGES_BC(NM) + IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN + IF (IG==N_GEOMETRY) THEN + WRITE(LU_ERR,'(I4.4,A,I9.9,A,I9.9,A)',advance="no") IG,', VERTS=',GEOMETRY(IG)%N_VERTS,& + ', FACES=',GEOMETRY(IG)%N_FACES,'.. done.' + CALL CPU_TIME(CPUTIME) + WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken : ',CPUTIME-CPUTIME_START,' sec.' + ELSE + WRITE(LU_ERR,'(I4.4,A)',advance="no") IG,', ' + ENDIF + ENDIF -! This routine adds to FDS EDGE array -! the sum of regular edges that are boundary at least a neighboring CC_CUTCFE face and -! one CC_SOLID face. +ENDDO GEOMETRY_LOOP -USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_CELL,REALLOCATE_EDGE -INTEGER, INTENT(IN) :: NM +! Print out of computed result: +! DO IG=1,N_GEOMETRY +! NWSEL = GEOMETRY(IG)%N_FACES +! DO IWSEL=1,NWSEL +! print*, IWSEL,GEOMETRY(IG)%FACES_AREA(IWSEL) +! ENDDO +! DO IWSEL=1,NWSEL +! print*, IWSEL,GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) +! ENDDO +! print*, "EDGES=" +! DO NWSEDG=1,GEOMETRY(IG)%N_EDGES +! print*, NWSEDG,GEOMETRY(IG)%EDGES(NOD1:NOD2,NWSEDG) +! ENDDO +! DO NWSEDG=1,GEOMETRY(IG)%N_EDGES +! print*, GEOMETRY(IG)%EDGE_FACES(1:5,NWSEDG) +! ENDDO +! print*, "FACES=" +! DO IWSEL=1,NWSEL +! print*, IWSEL,GEOMETRY(IG)%FACE_EDGES(EDG1:EDG3,IWSEL) +! ENDDO +! ENDDO -! Local variables: -INTEGER :: ECOUNT, CC_ECOUNT, CCOUNT, I, J, K, N_CC, N_RG, IE, IADD, JADD, KADD, CELL_COUNT_OLD, N1, N2 -LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: CELL_ADDED -INTEGER :: ICMM,ICPM,ICPP,ICMP -INTEGER :: IDUM,IOR,IW1,IW2 -INTEGER, PARAMETER :: IAXIS_WALL_INDS(1:4) = (/ -3, -2, 2, 3 /) -INTEGER, PARAMETER :: JAXIS_WALL_INDS(1:4) = (/ -3, -1, 1, 3 /) -INTEGER, PARAMETER :: KAXIS_WALL_INDS(1:4) = (/ -2, -1, 1, 2 /) -INTEGER :: IN1,IN2,JN1,JN2,KN1,KN2 -LOGICAL :: INI,INJ,INK,INMESH +RETURN +END SUBROUTINE CC_INIT_GEOM -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -CHARACTER(100) :: MSEGS_FILE +! ------------------------ GET_GEOM_EDGES --------------------------------------- -IF (DEBUG_SET_CUTCELLS) THEN - ! Write out: - WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_ibsegs_mesh_',NM,'.dat' - LU_DB_SETCC = GET_FILE_NUMBER() - OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') - CLOSE(LU_DB_SETCC) -ENDIF +SUBROUTINE GET_GEOM_EDGES(NVERT,NWSEL,SIZEFC,FACES,NWSEDG,EDGES,FACE_EDGES,EDGE_FACES) -CALL POINT_TO_MESH(NM) +INTEGER, INTENT(IN) :: NVERT,NWSEL,SIZEFC +INTEGER, INTENT(IN) :: FACES(1:SIZEFC) +INTEGER, INTENT(OUT):: NWSEDG,EDGES(NOD1:NOD2,3*NWSEL),FACE_EDGES(EDG1:EDG3,NWSEL),EDGE_FACES(5,3*NWSEL) -! Return if nothing to do for the mesh: -IF(MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH == 0) RETURN +! Local Variables: +INTEGER :: IWSEL,IVERT,IEDGE,TOT_ELVERT,IEDLIST,WSELEM(NOD1:NOD3),SEG(NOD1:NOD2) +LOGICAL :: INLIST +LOGICAL :: FLG_LOHI +INTEGER, ALLOCATABLE, DIMENSION(:) :: NELVERT,ISTVERT,EDGE_RNK +INTEGER, ALLOCATABLE, DIMENSION(:,:):: EDGES2,EDGE_FACES2 -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating SOLID_CUTCELL_EDGES_BC for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating SOLID_CUTCELL_EDGES_BC for mesh :',NM,' ..' -ENDIF +NWSEDG = 0 -ALLOCATE(CELL_ADDED(0:IBP1,0:JBP1,0:KBP1)); CELL_ADDED = .FALSE. +! Populate NELVERT with the number of elements associated per node: +ALLOCATE(NELVERT(NVERT)); NELVERT(:) = 0 +ALLOCATE(ISTVERT(NVERT)); ISTVERT(:) = 0 +DO IWSEL=1,NWSEL + NELVERT(FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL)) = NELVERT(FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL)) + 1 +ENDDO +NELVERT = NELVERT + 1 ! Add buffer. +DO IVERT=2,NVERT + ISTVERT(IVERT) = ISTVERT(IVERT-1) + NELVERT(IVERT-1) +ENDDO -! Now count added edge number for EDGE and CELL +! First pass build unique list of segments per VERTEX where: +! SEG_IJ = [ni nj] with ni < nj +TOT_ELVERT = SUM(NELVERT(1:NVERT)) +ALLOCATE(EDGES2(NOD1:NOD2,TOT_ELVERT)); EDGES2(:,:) = 0 +ALLOCATE(EDGE_FACES2( 5,TOT_ELVERT)); EDGE_FACES2(:,:) = 0 +ALLOCATE(EDGE_RNK( TOT_ELVERT)); EDGE_RNK(:) = 0 +NELVERT(:) = 0 ! Reset NELVERT. -ECOUNT = 0; CC_ECOUNT=0 -CCOUNT = 0; +DO IWSEL=1,NWSEL + WSELEM(NOD1:NOD3) = FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) -! X axis edges: -DO K=0,KBAR - INK = .FALSE. - KN1 = K; KN2 = K+1 - IF (K==0) THEN; KN1=K+1 - ELSEIF(K==KBAR) THEN; KN2=K - ELSE - INK = .TRUE. - ENDIF - DO J=0,JBAR - INJ = .FALSE. - JN1 = J; JN2 = J+1 - IF (J==0) THEN; JN1=J+1 - ELSEIF(J==JBAR) THEN; JN2=J - ELSE - INJ = .TRUE. - ENDIF - INMESH = INK .AND. INJ - IX_LOOP_1 : DO I=1,IBAR - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,IAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in Y. - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - DO JADD=0,1 ! Faces aligned in Z. - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(I,JN1:JN2,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. + DO IEDGE=EDG1,EDG3 + SEG(NOD1:NOD2) = (/ MINVAL(WSELEM(NOD1:NOD2)), MAXVAL(WSELEM(NOD1:NOD2)) /) + FLG_LOHI = .TRUE.; IF(SEG(NOD2) /= WSELEM(NOD2)) FLG_LOHI = .FALSE. + + IF(NELVERT(SEG(NOD2)) == 0) THEN + NELVERT(SEG(NOD2)) = NELVERT(SEG(NOD2)) + 1 + FACE_EDGES(IEDGE,IWSEL) = ISTVERT(SEG(NOD2)) + NELVERT(SEG(NOD2)) + EDGES2(NOD1:NOD2,FACE_EDGES(IEDGE,IWSEL)) = SEG(NOD1:NOD2) + EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) = & + EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) + 1 + IF(FLG_LOHI) THEN + EDGE_FACES2(2,FACE_EDGES(IEDGE,IWSEL)) = IWSEL + EDGE_FACES2(3,FACE_EDGES(IEDGE,IWSEL)) = IEDGE + ELSE + EDGE_FACES2(4,FACE_EDGES(IEDGE,IWSEL)) = IWSEL + EDGE_FACES2(5,FACE_EDGES(IEDGE,IWSEL)) = IEDGE ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-face, and a solid face. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO KADD=0,1 - DO JADD=0,1 - IF(CELL_INDEX(I ,J+JADD,K+KADD)==0 .AND. .NOT.CELL_ADDED(I ,J+JADD,K+KADD)) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I ,J+JADD,K+KADD) = .TRUE. - ENDIF - ENDDO - ENDDO - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=IAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K ))%WALL_INDEX( 2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K+1))%WALL_INDEX( 2) - CASE( 2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K ))%WALL_INDEX(-2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K+1))%WALL_INDEX(-2) - CASE(-3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K ))%WALL_INDEX( 3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K+1))%WALL_INDEX(-3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 - ENDIF - ENDDO - ENDIF - CC_ECOUNT = CC_ECOUNT + 1 + WSELEM=CSHIFT(WSELEM,1) + CYCLE ! IEDGE + ENDIF + + INLIST = .FALSE. + DO IEDLIST=ISTVERT(SEG(NOD2))+1,ISTVERT(SEG(NOD2))+NELVERT(SEG(NOD2)) + ! Here SEG(NOD2) is by construction the same as + ! EDGES2(NOD2,IEDLIST), search only NOD1 component. + IF(SEG(NOD1) == EDGES2(NOD1,IEDLIST)) THEN + INLIST = .TRUE. + EXIT ! IEDLIST ENDIF - ENDDO IX_LOOP_1 + ENDDO + IF(INLIST) THEN + FACE_EDGES(IEDGE,IWSEL) = IEDLIST + ELSE + NELVERT(SEG(NOD2)) = NELVERT(SEG(NOD2)) + 1 + FACE_EDGES(IEDGE,IWSEL) = ISTVERT(SEG(NOD2)) + NELVERT(SEG(NOD2)) + EDGES2(NOD1:NOD2,FACE_EDGES(IEDGE,IWSEL)) = SEG(NOD1:NOD2) + ENDIF + + EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) = & + EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) + 1 + IF(FLG_LOHI) THEN + EDGE_FACES2(2,FACE_EDGES(IEDGE,IWSEL)) = IWSEL + EDGE_FACES2(3,FACE_EDGES(IEDGE,IWSEL)) = IEDGE + ELSE + EDGE_FACES2(4,FACE_EDGES(IEDGE,IWSEL)) = IWSEL + EDGE_FACES2(5,FACE_EDGES(IEDGE,IWSEL)) = IEDGE + ENDIF + + WSELEM=CSHIFT(WSELEM,1) + ENDDO +ENDDO + +! Second pass get segments ranking: +DO IVERT=1,NVERT + DO IEDLIST=ISTVERT(IVERT)+1,ISTVERT(IVERT)+NELVERT(IVERT) + NWSEDG = NWSEDG + 1 + EDGE_RNK(IEDLIST) = NWSEDG + EDGES(NOD1:NOD2,NWSEDG) = EDGES2(NOD1:NOD2,IEDLIST) + EDGE_FACES(1:5,NWSEDG) = EDGE_FACES2(1:5,IEDLIST) ENDDO ENDDO -! Y axis edges: -DO K=0,KBAR - INK = .FALSE. - KN1 = K; KN2 = K+1 - IF (K==0) THEN; KN1=K+1 - ELSEIF(K==KBAR) THEN; KN2=K - ELSE - INK = .TRUE. - ENDIF - DO J=1,JBAR - IY_LOOP_1 : DO I=0,IBAR - INI = .FALSE. - IN1 = I; IN2 = I+1 - IF (I==0) THEN; IN1=I+1 - ELSEIF(I==IBAR) THEN; IN2=I - ELSE - INI = .TRUE. - ENDIF - INMESH = INK .AND. INI - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,JAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in X. - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Z. - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,J,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. - ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO KADD=0,1 - DO IADD=0,1 - IF(CELL_INDEX(I+IADD,J ,K+KADD)==0 .AND. .NOT.CELL_ADDED(I+IADD,J ,K+KADD)) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I+IADD,J ,K+KADD) = .TRUE. - ENDIF - ENDDO - ENDDO - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=JAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) - CASE( 1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) - CASE(-3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 - ENDIF - ENDDO - ENDIF - CC_ECOUNT = CC_ECOUNT + 1 - ENDIF - ENDDO IY_LOOP_1 +! Third pass populate FACE_EDGES data: +DO IWSEL=1,NWSEL + DO IEDGE=EDG1,EDG3 + IEDLIST = EDGE_RNK(FACE_EDGES(IEDGE,IWSEL)) + FACE_EDGES(IEDGE,IWSEL) = IEDLIST ENDDO ENDDO -! Z axis edges: -DO K=1,KBAR - DO J=0,JBAR - INJ = .FALSE. - JN1 = J; JN2 = J+1 - IF (J==0) THEN; JN1=J+1 - ELSEIF(J==JBAR) THEN; JN2=J - ELSE - INJ = .TRUE. - ENDIF - IZ_LOOP_1 : DO I=0,IBAR - INI = .FALSE. - IN1 = I; IN2 = I+1 - IF (I==0) THEN; IN1=I+1 - ELSEIF(I==IBAR) THEN; IN2=I - ELSE - INI = .TRUE. +DEALLOCATE(NELVERT,ISTVERT,EDGES2,EDGE_FACES2,EDGE_RNK) + +RETURN +END SUBROUTINE GET_GEOM_EDGES + +! ------------------------- GET_X2_VERTVAR -------------------------------------- + +SUBROUTINE GET_X2_VERTVAR(X1AXIS,X2LO,X2HI,NM,I,KK) + +INTEGER, INTENT(IN) :: X1AXIS,X2LO,X2HI,NM,I,KK + +! Local Variables: +INTEGER :: ICRS,ICRS1,JSTR,JEND,JJ,X2LO_LOC,X2HI_LOC +REAL(EB):: TNOW + +TNOW=CURRENT_TIME() + +! Work By Edge, Only one X1AXIS=IAXIS needs to be used: +SELECT CASE(X1AXIS) +CASE(IAXIS) + X2LO_LOC = X2LO + X2HI_LOC = X2HI + ! Case of GG, SS points: + DO ICRS=1,CC_N_CRS + ! If is_crs(icrs) == GG, SS, SGG see if crossing is + ! exactly on a Cartesian cell vertex: + SELECT CASE(CC_IS_CRS(ICRS)) + CASE(CC_GG,CC_SS) + JSTR = X2LO_LOC; JEND = X2HI_LOC + IF(X2NOC==0) THEN + ! Optimized and will ONLY work for Uniform Grids: + JSTR = MAX(X2LO_LOC, FLOOR((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) + JEND = MIN(X2HI_LOC, CEILING((CC_SVAR_CRS(ICRS)+GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) ENDIF - INMESH = INJ .AND. INI - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,KAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO JADD=0,1 ! Faces aligned in X. - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 + + DO JJ=JSTR,JEND + ! Crossing on Vertex? + IF ( ABS(X2FACE(JJ)-CC_SVAR_CRS(ICRS)) < GEOMEPS ) THEN + MESHES(NM)%VERTVAR(I,JJ,KK,CC_VGSC) = CC_SOLID + EXIT + ENDIF ENDDO - DO IADD=0,1 ! Faces aligned in Y. - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 + + END SELECT + ENDDO + + ! Other cases: + DO ICRS=1,CC_N_CRS-1 + ! Case GS-SG: All Cartesian vertices are set to CC_SOLID. + IF (CC_IS_CRS(ICRS) == CC_GS) THEN + ! Find corresponding SG intersection: + DO ICRS1=ICRS+1,CC_N_CRS + IF (CC_IS_CRS(ICRS1) == CC_SG) EXIT ENDDO - ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,JN1:JN2,K,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. - ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO JADD=0,1 - DO IADD=0,1 - IF(CELL_INDEX(I+IADD,J+JADD,K )==0 .AND. .NOT.CELL_ADDED(I+IADD,J+JADD,K )) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I+IADD,J+JADD,K ) = .TRUE. + JSTR = X2LO_LOC; JEND = X2HI_LOC + IF(X2NOC==0) THEN + ! Optimized for UG: + JSTR = MAX(X2LO_LOC, CEILING(( CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) + JEND = MIN(X2HI_LOC, FLOOR((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) + ELSE + IF ((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC)) < 0._EB) THEN + JSTR=X2LO_LOC + ELSEIF((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2HI_LOC)) >= 0._EB) THEN + JSTR=X2HI_LOC+1 + ELSE + DO JJ=X2LO_LOC,X2HI_LOC + IF((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. & + (CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN + JSTR = JJ+1 + EXIT ENDIF - ENDDO ENDDO + ENDIF + IF ((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2LO_LOC)) < 0._EB) THEN + JEND=X2LO_LOC-1 + ELSEIF((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2HI)) >= 0._EB) THEN + JEND=X2HI_LOC ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=KAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) - CASE( 1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) - CASE(-2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) - CASE( 2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 + DO JJ=X2LO_LOC,X2HI_LOC + IF((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. & + (CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN + JEND = JJ + EXIT ENDIF ENDDO ENDIF - CC_ECOUNT = CC_ECOUNT + 1 ENDIF - ENDDO IZ_LOOP_1 + + DO JJ=JSTR,JEND + MESHES(NM)%VERTVAR(I,JJ,KK,CC_VGSC) = CC_SOLID + ENDDO + ENDIF ENDDO +END SELECT + +T_CC_USED(GET_X2_VERTVAR_TIME_INDEX) = T_CC_USED(GET_X2_VERTVAR_TIME_INDEX) + CURRENT_TIME() - TNOW + +RETURN +END SUBROUTINE GET_X2_VERTVAR + +! -------------------------- GET_CARTEDGE_CUTEDGES ------------------------------ + +SUBROUTINE GET_CARTEDGE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & + NM,X2LO_CELL,X2HI_CELL,INDX1,KK) + +INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & + NM,X2LO_CELL,X2HI_CELL,INDX1(MAX_DIM),KK + +! Local Variables: +INTEGER :: NEDGECROSS, NEDGECROSS_OLD, NCUTEDGE, JJ, INDXI(MAX_DIM), INDI, INDJ, INDK +INTEGER :: INDI1, INDJ1, INDK1, INDIE, INDJE, INDKE, NCROSS, ICROSS, ICRS, JSTR +INTEGER :: JJLOW, JJHIGH, JJADD +REAL(EB):: DELJJ +LOGICAL :: VSOLID, DIF, VFLUID +REAL(EB):: X123VERT(MAX_DIM,CC_MAXCROSS_EDGE), XCEN, YCEN, ZCEN, SCEN, XYZCEN(IAXIS:KAXIS) +INTEGER :: VERT_LIST(4,CC_MAXCROSS_EDGE),NEDGE, NVERT, IVERT +LOGICAL :: IS_GASPHASE +REAL(EB):: TNOW + +LOGICAL :: FOUND_EDGE +REAL(EB):: XVJJ, DELJJ1 + +TNOW=CURRENT_TIME() + +! INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CEELEMAUX, INDSEGAUX +! INTEGER :: NEDGE_SIZE + +! Now define Crossings on Cartesian Edges and Body segments: +! - Edges: MESHES(NM) % ECVAR(:,:,:,CC_EGSC,IAXIS) = +! ECVAR(:,:,:,CC_EGSC,JAXIS) = CC_GASPHASE, CC_SOLID or CC_CUTCFE +! ECVAR(:,:,:,CC_EGSC,KAXIS) = +! ECVAR(:,:,:,CC_ECRS,IAXIS) = +! ECVAR(:,:,:,CC_ECRS,JAXIS) = Index to Corresponding EDGE_CROSS array. +! ECVAR(:,:,:,CC_ECRS,KAXIS) = +! MESHES(NM) % EDGE_CROSS: Data structure with +! crossings per cartesian edge information. +! .NCROSS = Number of crossings. +! .SVAR(1:NCROSS) = distances along edge from lower +! Cartesian vertex. +! Note: Crossings right on vertices do not need to be added, +! they are taken care of by setting VERTVAR(iv,jv,kv,CC_VGSC,lb)=CC_SOLID. +! MESHES(NM) % CUT_EDGE: Data structure with info on CC_GASPHASE cut-edges, +! per Cartesian Edge and CC_INBOUNDARY cut-edges, per +! Cartesian Face: +! .NVERT = number of vertices on cut-edges. +! .NEDGE = number of cut-edges. +! .XYZVERT(IAXIS:KAXIS,1:NVERT) = Segments Vertices +! .CEELEM(NOD1:NOD2,1:NEDGE) = Segments connectivity list. +! .STATUS = CC_GASPHASE or CC_INBOUNDARY; if latter +! .IJK = [I J K AXIS] for Cartesian Edge if status = CC_GASPHASE +! = [I J K AXIS] for Cartesian Face if status = CC_INBOUNDARY +! .INDSEG(1:4,1:NEDGE) = [nwel iwel1 iwel2 ibod] if status = CC_INBOUNDARY +! Also: +! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = +! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = index on CUT_EDGE location. +! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = +! +! Now figure out which segment the intersections belong to, also +! add intersections to body segments. +! As defined, a Cartesian CUT_EDGE is defined by: +! 1. A crossing. +! 2. A VERTVAR(iv,jv,kv,CC_VGSC,lb) = CC_SOLID and another +! VERTVAR(iv,jv,kv,CC_VGSC,lb) = CC_GASPHASE + +! Set initially edges with MESHES(NM)%VERTVAR vertices == CC_SOLID to CC_SOLID status: +DO JJ=X2LO_CELL,X2HI_CELL + + ! Vert at index JJ-1: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ-1, KK /) ! Local x1,x2,x3 + INDI=INDXI(XIAXIS) + INDJ=INDXI(XJAXIS) + INDK=INDXI(XKAXIS) + ! Vert at index JJ: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ, KK /) ! Local x1,x2,x3 + INDI1=INDXI(XIAXIS) + INDJ1=INDXI(XJAXIS) + INDK1=INDXI(XKAXIS) + ! Edge at index JJ: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ, KK /) ! Local x1,x2,x3 + INDIE=INDXI(XIAXIS) + INDJE=INDXI(XJAXIS) + INDKE=INDXI(XKAXIS) + + IF ((MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & + (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) ) & + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID + ENDDO -IF (CC_ECOUNT==0) THEN - DEALLOCATE(CELL_ADDED) - RETURN -ENDIF -! Allocate CC_IBEDGE: -MESHES(NM)%CC_NIBEDGE = CC_ECOUNT -ALLOCATE(MESHES(NM)%CC_IBEDGE(1:CC_ECOUNT)) +NEDGECROSS_OLD = MESHES(NM) % N_EDGE_CROSS +! Edges with Crossings not on VERTICES: +ICRS_DO : DO ICRS=1,CC_N_CRS -! Reallocate EDGE variables + ! Skip SOLID-SOLID intersections, as there is no media crossing: + IF (CC_IS_CRS(ICRS) == CC_SS) CYCLE -N1 = UBOUND(MESHES(NM)%EDGE,DIM=1) -N2 = EDGE_COUNT(NM) + ECOUNT -IF (ECOUNT>0 .AND. N2>N1) CALL REALLOCATE_EDGE(NM,N1,N2) + ! Check location on grid of crossing: + ! See if crossing is exactly on a Cartesian cell vertex: + IF (X2NOC==0) THEN + ! Optimized for UG: + JSTR = FLOOR( (CC_SVAR_CRS(ICRS)-GEOMEPS-X2CELL(X2LO_CELL))/DX2CELL(X2LO_CELL) ) + X2LO_CELL + ! Discard cut-edges on Cartesian edges laying > X2HI_CELL. + IF (JSTR < X2LO_CELL-1) CYCLE + IF (JSTR > X2HI_CELL+1) CYCLE -! Reallocate derived type array CELL which contains SOLID, OBST_INDEX, WALL_INDEX, EDGE_INDEX, EXTERIOR, I, J, K: + JJ = JSTR + DELJJ = ABS(X2CELL(JJ)-CC_SVAR_CRS(ICRS)) - DX2CELL(X2LO_CELL)/2._EB + ! Crossing on Vertex? + IF ( ABS(DELJJ) < GEOMEPS ) THEN ! Add crossing to two edges: + JJLOW=0; JJHIGH=1 + ELSEIF ( DELJJ < -GEOMEPS ) THEN ! Crossing in jj Edge. + JJLOW=0; JJHIGH=0 + ELSEIF ( DELJJ > GEOMEPS ) THEN ! Crossing in jj+1 Edge. + JJLOW=1; JJHIGH=1 + ENDIF + ELSE + FOUND_EDGE=.FALSE. + JJLOW = -1000000 + JJHIGH= 1000000 + DO JJ=X2LO_CELL-1,X2HI_CELL + DELJJ = CC_SVAR_CRS(ICRS)-X2CELL(JJ) + XVJJ = X2CELL(JJ) + DX2CELL(JJ)/2._EB + DELJJ1= CC_SVAR_CRS(ICRS)-X2CELL(JJ+1) + ! First two edges: + IF(ABS(CC_SVAR_CRS(ICRS)-XVJJ) < GEOMEPS) THEN ! Both JJ and JJ+1 + FOUND_EDGE=.TRUE. + JJLOW=0; JJHIGH=1 + EXIT + ELSEIF (ABS(DELJJ) < DX2CELL(JJ)/2._EB) THEN ! JJ + FOUND_EDGE=.TRUE. + JJLOW=0; JJHIGH=0 + EXIT + ELSEIF (ABS(DELJJ1)< DX2CELL(JJ+1)/2._EB) THEN ! JJ+1 + FOUND_EDGE=.TRUE. + JJLOW=1; JJHIGH=1 + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_EDGE) CYCLE + ENDIF -CELL_COUNT_OLD = CELL_COUNT(NM) -IF (CCOUNT > 0) CALL REALLOCATE_CELL(NM,CELL_COUNT(NM),CELL_COUNT(NM)+CCOUNT) -CCOUNT = CELL_COUNT_OLD + DO JJADD=JJLOW,JJHIGH + ! Edge in the left: + ! Edge at index JJ or JJ+1: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ+JJADD, KK /) ! Local x1,x2,x3 + INDIE=INDXI(XIAXIS) + INDJE=INDXI(XJAXIS) + INDKE=INDXI(XKAXIS) -! Finally repeat search process and assign edge and cell values to cut-cell region entities: + ! Set MESHES(NM)%ECVAR(IE,JE,KE,CC_EGSC,X2AXIS) = CC_CUTCFE: + ICROSS = MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_ECRS,X2AXIS) -CC_ECOUNT=0 + IF ( ICROSS > 0 ) THEN ! Edge has crossings already. -! X axis edges: -DO K=0,KBAR - INK = .FALSE. - KN1 = K; KN2 = K+1 - IF (K==0) THEN; KN1=K+1 - ELSEIF(K==KBAR) THEN; KN2=K - ELSE - INK = .TRUE. - ENDIF - DO J=0,JBAR - INJ = .FALSE. - JN1 = J; JN2 = J+1 - IF (J==0) THEN; JN1=J+1 - ELSEIF(J==JBAR) THEN; JN2=J - ELSE - INJ = .TRUE. - ENDIF - INMESH = INK .AND. INJ - IX_LOOP_2 : DO I=1,IBAR - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,IAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in Y. - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - DO JADD=0,1 ! Faces aligned in Z. - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(I,JN1:JN2,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. - ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells, NEW edge to force. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO KADD=0,1 - DO JADD=0,1 - IF(MESHES(NM)%CELL_INDEX(I ,J+JADD,K+KADD)==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - MESHES(NM)%CELL_INDEX(I ,J+JADD,K+KADD) = CCOUNT - MESHES(NM)%CELL(CCOUNT)%I = I - MESHES(NM)%CELL(CCOUNT)%J = J+JADD - MESHES(NM)%CELL(CCOUNT)%K = K+KADD - ENDIF - ENDDO - ENDDO - ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) - ICPM = MESHES(NM)%CELL_INDEX(I ,J+1,K ) - ICPP = MESHES(NM)%CELL_INDEX(I ,J+1,K+1) - ICMP = MESHES(NM)%CELL_INDEX(I ,J ,K+1) - MESHES(NM)%EDGE(IE)%I = I - MESHES(NM)%EDGE(IE)%J = J - MESHES(NM)%EDGE(IE)%K = K - MESHES(NM)%EDGE(IE)%AXIS = IAXIS - MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM - MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM - MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP - MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP - MESHES(NM)%CELL(ICPP)%EDGE_INDEX(1) = IE - MESHES(NM)%CELL(ICMP)%EDGE_INDEX(2) = IE - MESHES(NM)%CELL(ICPM)%EDGE_INDEX(3) = IE - MESHES(NM)%CELL(ICMM)%EDGE_INDEX(4) = IE - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=IAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) - CASE( 2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) - CASE(-3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 - ENDIF - ENDDO - ENDIF + ! Populate EDGECROSS struct: + NCROSS = MESHES(NM)%EDGE_CROSS(ICROSS)%NCROSS + 1 + MESHES(NM)%EDGE_CROSS(ICROSS) % NCROSS = NCROSS + MESHES(NM)%EDGE_CROSS(ICROSS) % SVAR(NCROSS) = CC_SVAR_CRS(ICRS) + MESHES(NM)%EDGE_CROSS(ICROSS) % ISVAR(NCROSS)= CC_IS_CRS(ICRS) + + ELSE ! No crossings yet. + + NEDGECROSS = MESHES(NM)%N_EDGE_CROSS + 1 + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_CUTCFE + MESHES(NM)%N_EDGE_CROSS = NEDGECROSS + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_ECRS,X2AXIS) = NEDGECROSS + + CALL EDGE_CROSS_ARRAY_REALLOCATE(NM,NEDGECROSS) - CC_ECOUNT = CC_ECOUNT + 1 + ! Populate EDGECROSS struct: + NCROSS = 1 + MESHES(NM)%EDGE_CROSS(NEDGECROSS) % NCROSS = NCROSS + MESHES(NM)%EDGE_CROSS(NEDGECROSS) % SVAR(NCROSS) = CC_SVAR_CRS(ICRS) + MESHES(NM)%EDGE_CROSS(NEDGECROSS) % ISVAR(NCROSS)= CC_IS_CRS(ICRS) + MESHES(NM)%EDGE_CROSS(NEDGECROSS) % IJK(1:4) = (/ INDIE, INDJE, INDKE, X2AXIS /) - ! Add info to CC_IBEDGE: - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE + ENDIF - ENDIF - ENDDO IX_LOOP_2 - ENDDO -ENDDO + ENDDO -! Y axis edges: -DO K=0,KBAR - INK = .FALSE. - KN1 = K; KN2 = K+1 - IF (K==0) THEN; KN1=K+1 - ELSEIF(K==KBAR) THEN; KN2=K - ELSE - INK = .TRUE. - ENDIF - DO J=1,JBAR - IY_LOOP_2 : DO I=0,IBAR - INI = .FALSE. - IN1 = I; IN2 = I+1 - IF (I==0) THEN; IN1=I+1 - ELSEIF(I==IBAR) THEN; IN2=I - ELSE - INI = .TRUE. - ENDIF - INMESH = INK .AND. INI - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,JAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in X. - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Z. - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,J,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. - ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO KADD=0,1 - DO IADD=0,1 - IF(MESHES(NM)%CELL_INDEX(I+IADD,J ,K+KADD)==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - MESHES(NM)%CELL_INDEX(I+IADD,J ,K+KADD) = CCOUNT - MESHES(NM)%CELL(CCOUNT)%I = I+IADD - MESHES(NM)%CELL(CCOUNT)%J = J - MESHES(NM)%CELL(CCOUNT)%K = K+KADD - ENDIF - ENDDO - ENDDO - ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) - ICMP = MESHES(NM)%CELL_INDEX(I+1,J ,K ) - ICPP = MESHES(NM)%CELL_INDEX(I+1,J ,K+1) - ICPM = MESHES(NM)%CELL_INDEX(I ,J ,K+1) - MESHES(NM)%EDGE(IE)%I = I - MESHES(NM)%EDGE(IE)%J = J - MESHES(NM)%EDGE(IE)%K = K - MESHES(NM)%EDGE(IE)%AXIS = JAXIS - MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM - MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM - MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP - MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP - MESHES(NM)%CELL(ICPP)%EDGE_INDEX(5) = IE - MESHES(NM)%CELL(ICPM)%EDGE_INDEX(6) = IE - MESHES(NM)%CELL(ICMP)%EDGE_INDEX(7) = IE - MESHES(NM)%CELL(ICMM)%EDGE_INDEX(8) = IE - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=JAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) - CASE( 1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) - CASE(-3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 - ENDIF - ENDDO - ENDIF +ENDDO ICRS_DO - CC_ECOUNT = CC_ECOUNT + 1 +! Now Define MESHES(NM)%CUT_EDGE for CC_GASPHASE cut-edges: +DO ICROSS=NEDGECROSS_OLD+1,MESHES(NM)%N_EDGE_CROSS - ! Add info to CC_IBEDGE: - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE + ! Discard edge outside of blocks ranges for ray on x2axis: + IF ( (MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS) < X2LO_CELL) .OR. & + (MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS) > X2HI_CELL) ) CYCLE - ENDIF - ENDDO IY_LOOP_2 - ENDDO -ENDDO + NCROSS = MESHES(NM)%EDGE_CROSS(ICROSS)%NCROSS -! Z axis edges: -DO K=1,KBAR - DO J=0,JBAR - INJ = .FALSE. - JN1 = J; JN2 = J+1 - IF (J==0) THEN; JN1=J+1 - ELSEIF(J==JBAR) THEN; JN2=J - ELSE - INJ = .TRUE. - ENDIF - IZ_LOOP_2 : DO I=0,IBAR - INI = .FALSE. - IN1 = I; IN2 = I+1 - IF (I==0) THEN; IN1=I+1 - ELSEIF(I==IBAR) THEN; IN2=I - ELSE - INI = .TRUE. - ENDIF - INMESH = INJ .AND. INI - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,KAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO JADD=0,1 ! Faces aligned in X. - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Y. - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,JN1:JN2,K,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. - ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO JADD=0,1 - DO IADD=0,1 - IF(MESHES(NM)%CELL_INDEX(I+IADD,J+JADD,K )==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - MESHES(NM)%CELL_INDEX(I+IADD,J+JADD,K ) = CCOUNT - MESHES(NM)%CELL(CCOUNT)%I = I+IADD - MESHES(NM)%CELL(CCOUNT)%J = J+JADD - MESHES(NM)%CELL(CCOUNT)%K = K - ENDIF - ENDDO - ENDDO - ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) - ICPM = MESHES(NM)%CELL_INDEX(I+1,J ,K ) - ICPP = MESHES(NM)%CELL_INDEX(I+1,J+1,K ) - ICMP = MESHES(NM)%CELL_INDEX(I ,J+1,K ) - MESHES(NM)%EDGE(IE)%I = I - MESHES(NM)%EDGE(IE)%J = J - MESHES(NM)%EDGE(IE)%K = K - MESHES(NM)%EDGE(IE)%AXIS = KAXIS - MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM - MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM - MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP - MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP - MESHES(NM)%CELL(ICPP)%EDGE_INDEX( 9) = IE - MESHES(NM)%CELL(ICMP)%EDGE_INDEX(10) = IE - MESHES(NM)%CELL(ICPM)%EDGE_INDEX(11) = IE - MESHES(NM)%CELL(ICMM)%EDGE_INDEX(12) = IE - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=KAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) - CASE( 1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) - CASE(-2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) - CASE( 2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 - ENDIF - ENDDO - ENDIF + ! Edge Location in x1,x2,x3 axes: + ! Vert at index JJ-1: + INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)-1, & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 + INDI=INDXI(XIAXIS) + INDJ=INDXI(XJAXIS) + INDK=INDXI(XKAXIS) + ! Vert at index JJ: + INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS), & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 + INDI1=INDXI(XIAXIS) + INDJ1=INDXI(XJAXIS) + INDK1=INDXI(XKAXIS) + ! Edge at index jj: + INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS), & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 + INDIE=INDXI(XIAXIS) ! i.e. MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(IAXIS), etc. + INDJE=INDXI(XJAXIS) + INDKE=INDXI(XKAXIS) + + ! Discard Edge with one EDGECROSS and both vertices having VERTVAR = CC_SOLID: + ! The crossing is on one of the edge vertices. + IF ( (NCROSS == 1) .AND. & + (MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & + (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) ) THEN + + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID + CYCLE + + ENDIF - CC_ECOUNT = CC_ECOUNT + 1 + ! Discard cases for edge with two crossings: + IF ( NCROSS == 2 ) THEN - ! Add info to CC_IBEDGE: - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE + VSOLID = (MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & + (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) - ENDIF - ENDDO IZ_LOOP_2 - ENDDO -ENDDO + ! Test if crossings lay on same location + solid vertices: + DIF = ( MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(2) - & + MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(1) ) < GEOMEPS + IF (DIF .AND. VSOLID) THEN + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID + CYCLE + ENDIF -DEALLOCATE(CELL_ADDED) + DIF = (ABS(X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)-1 ) - & + MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(1)) < GEOMEPS) .AND. & + (ABS(X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)) - & + MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(2)) < GEOMEPS) + + VFLUID = (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(1) == CC_GS) .AND. & + (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(2) == CC_SG) + + IF (DIF .AND. VSOLID .AND. VFLUID) THEN + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID + CYCLE + ENDIF -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - WRITE(LU_SETCC,'(A,F8.3,A,6I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Sol-CC edges for BC : ', & - CC_ECOUNT,MESHES(NM)%CC_NIBEDGE,EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,6I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Sol-CC edges for BC : ', & - CC_ECOUNT,MESHES(NM)%CC_NIBEDGE,EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' ENDIF - ! DO I=1,MESHES(NM)%CC_NRCEDGE - ! WRITE(LU_ERR,*) 'IE,I,J,K,IAXIS=',MESHES(NM)%CC_RCEDGE(I)%IE,MESHES(NM)%CC_RCEDGE(I)%IJK(IAXIS:KAXIS+1) - ! ENDDO -ENDIF -IF (DEBUG_SET_CUTCELLS) THEN - ! Write segment information for the mesh if it belongs to the process: - ! Write out: - WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_ibsegs_mesh_',NM,'.dat' - LU_DB_SETCC = GET_FILE_NUMBER() - OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') - !WRITE(LU_ERR,*) TRIM(MSEGS_FILE),MESHES(NM)%CC_NRCEDGE,CC_ECOUNT - DO ECOUNT=1,MESHES(NM)%CC_NIBEDGE - I=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(IAXIS) - J=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(JAXIS) - K=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(KAXIS) - IE=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(KAXIS+1) - SELECT CASE(IE) - CASE(IAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DX(I),XC(I),Y(J),Z(K) - CASE(JAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DY(J),X(I),YC(J),Z(K) - CASE(KAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DZ(K),X(I),Y(J),ZC(K) - END SELECT + ! New CUT_EDGE struct for this edge: + NCUTEDGE = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = NCUTEDGE + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_IDCE,X2AXIS)= NCUTEDGE + + CALL CUT_EDGE_ARRAY_REALLOC(NM,NCUTEDGE) + + MESHES(NM)%CUT_EDGE(NCUTEDGE)%STATUS = CC_GASPHASE + MESHES(NM)%CUT_EDGE(NCUTEDGE)%IJK(1:MAX_DIM+1) = MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(1:MAX_DIM+1) + MESHES(NM)%CUT_EDGE(NCUTEDGE)%IJK(MAX_DIM+2) = CC_UNDEFINED ! No need to define CUT_EDGE type (is CC_GASPHASE). + ! First Vertices: + NVERT = NCROSS + 2 + MESHES(NM)%CUT_EDGE(NCUTEDGE)%NVERT = NVERT + X123VERT(IAXIS:KAXIS,1:NVERT) = 0._EB + X123VERT(IAXIS,1:NVERT) = X1FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS)) + X123VERT(JAXIS,1) = X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)-1) + X123VERT(JAXIS,2:NCROSS+1)= MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(1:NCROSS) + X123VERT(JAXIS,NVERT) = X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)) + X123VERT(KAXIS,1:NVERT) = X3FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS)) + + ! Allocate new edge XYZVERT, CEELEM, INDSEG + CALL NEW_EDGE_ALLOC(NM,NCUTEDGE,NVERT,CC_ALLOC_DELEM) + DO IVERT=1,MESHES(NM)%CUT_EDGE(NCUTEDGE)%NVERT + MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT(IAXIS:KAXIS,IVERT) = & + X123VERT( (/ XIAXIS, XJAXIS, XKAXIS /) ,IVERT) ENDDO - CLOSE(LU_DB_SETCC) -ENDIF -RETURN -END SUBROUTINE GET_SOLID_CUTCELL_EDGES_BC + ! Now Cut Edges: + ! Node List: + VERT_LIST(:,:) = CC_UNDEFINED + VERT_LIST(1,:) = CC_VTYPE_NINB ! Nodes by default are in boundary. + CE=>MESHES(NM)%CUT_EDGE(NCUTEDGE) + DO IVERT=1,CE%NVERT + ! NOD1: + IF(ABS(CE%XYZVERT(IAXIS,IVERT)-XFACE(INDI )) SIZE_EDGE_CROSS) THEN + ALLOCATE(EDGE_CROSS_AUX(SIZE_EDGE_CROSS+GLOBAL_DELTA_EDGE)) + DO CEI1=1,CEI-1 + EDGE_CROSS_AUX(CEI1)%NCROSS = MESHES(NM)%EDGE_CROSS(CEI1)%NCROSS + EDGE_CROSS_AUX(CEI1)%SVAR = MESHES(NM)%EDGE_CROSS(CEI1)%SVAR + EDGE_CROSS_AUX(CEI1)%ISVAR = MESHES(NM)%EDGE_CROSS(CEI1)%ISVAR + EDGE_CROSS_AUX(CEI1)%IJK = MESHES(NM)%EDGE_CROSS(CEI1)%IJK + ENDDO + CALL MOVE_ALLOC(FROM=EDGE_CROSS_AUX, TO=MESHES(NM)%EDGE_CROSS) ENDIF -IF (.NOT.FIRST_CALL_ARG) RETURN +RETURN +END SUBROUTINE EDGE_CROSS_ARRAY_REALLOCATE -IF ( ALLOCATED(BODINT_PLANE%XYZ) ) DEALLOCATE(BODINT_PLANE%XYZ) -IF ( ALLOCATED(BODINT_PLANE%SGLS) ) DEALLOCATE(BODINT_PLANE%SGLS) -IF ( ALLOCATED(BODINT_PLANE%SEGS) ) DEALLOCATE(BODINT_PLANE%SEGS) -IF ( ALLOCATED(BODINT_PLANE%TRIS) ) DEALLOCATE(BODINT_PLANE%TRIS) -IF ( ALLOCATED(BODINT_PLANE%INDSEG) ) DEALLOCATE(BODINT_PLANE%INDSEG) -IF ( ALLOCATED(BODINT_PLANE%INDTRI) ) DEALLOCATE(BODINT_PLANE%INDTRI) -IF ( ALLOCATED(BODINT_PLANE%X2ALIGNED) ) DEALLOCATE(BODINT_PLANE%X2ALIGNED) -IF ( ALLOCATED(BODINT_PLANE%X3ALIGNED) ) DEALLOCATE(BODINT_PLANE%X3ALIGNED) -IF ( ALLOCATED(BODINT_PLANE%SEGTYPE) ) DEALLOCATE(BODINT_PLANE%SEGTYPE) -IF ( ALLOCATED(BODINT_PLANE%NOD_PERM) ) DEALLOCATE(BODINT_PLANE%NOD_PERM) -ALLOCATE(BODINT_PLANE% XYZ(IAXIS:KAXIS, CC_MAX_NNODS)) -ALLOCATE(BODINT_PLANE% NOD_PERM(CC_MAX_NNODS)) -ALLOCATE(BODINT_PLANE% SGLS(NOD1, CC_MAX_NSGLS)) -ALLOCATE(BODINT_PLANE% SEGS(NOD1:NOD2, CC_MAX_NSEGS)) -ALLOCATE(BODINT_PLANE% TRIS(NOD1:NOD3, CC_MAX_NTRIS)) -ALLOCATE(BODINT_PLANE% INDSEG(CC_MAX_WSTRIANG_SEG+2, CC_MAX_NSEGS)) -ALLOCATE(BODINT_PLANE% INDTRI(CC_MAX_WSTRIANG_TRI+1, CC_MAX_NTRIS)) -ALLOCATE(BODINT_PLANE%X2ALIGNED(CC_MAX_NSEGS)) -ALLOCATE(BODINT_PLANE%X3ALIGNED(CC_MAX_NSEGS)) -ALLOCATE(BODINT_PLANE% SEGTYPE(LOW_IND:HIGH_IND, CC_MAX_NSEGS)) +! --------------------------CUT_EDGE_ARRAY_REALLOC------------------------------- -FIRST_CALL_ARG=.FALSE. +SUBROUTINE CUT_EDGE_ARRAY_REALLOC(NM,CEI) -END SUBROUTINE ALLOCATE_BODINT_PLANE +INTEGER, INTENT(IN) :: NM, CEI + +! Local Variables: +INTEGER :: CEI1, SIZE_CUT_EDGE + +SIZE_CUT_EDGE = SIZE(MESHES(NM)%CUT_EDGE,DIM=1) +IF (CEI > SIZE_CUT_EDGE) THEN + ALLOCATE(CUT_EDGE_AUX(SIZE_CUT_EDGE+GLOBAL_DELTA_EDGE)) + DO CEI1=1,CEI-1 + CUT_EDGE_AUX(CEI1)%NVERT = MESHES(NM)%CUT_EDGE(CEI1)%NVERT + CUT_EDGE_AUX(CEI1)%NEDGE = MESHES(NM)%CUT_EDGE(CEI1)%NEDGE + CUT_EDGE_AUX(CEI1)%NEDGE1 = MESHES(NM)%CUT_EDGE(CEI1)%NEDGE1 + CUT_EDGE_AUX(CEI1)%STATUS = MESHES(NM)%CUT_EDGE(CEI1)%STATUS + CUT_EDGE_AUX(CEI1)%IJK = MESHES(NM)%CUT_EDGE(CEI1)%IJK + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%XYZVERT, TO=CUT_EDGE_AUX(CEI1)%XYZVERT) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%CEELEM, TO=CUT_EDGE_AUX(CEI1)%CEELEM) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%INDSEG, TO=CUT_EDGE_AUX(CEI1)%INDSEG) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%VERT_LIST, TO=CUT_EDGE_AUX(CEI1)%VERT_LIST) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%NOD_PERM, TO=CUT_EDGE_AUX(CEI1)%NOD_PERM) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%DXX, TO=CUT_EDGE_AUX(CEI1)%DXX) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%FACE_LIST, TO=CUT_EDGE_AUX(CEI1)%FACE_LIST) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%DUIDXJ, TO=CUT_EDGE_AUX(CEI1)%DUIDXJ) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%MU_DUIDXJ, TO=CUT_EDGE_AUX(CEI1)%MU_DUIDXJ) + ENDDO + CALL MOVE_ALLOC(FROM=CUT_EDGE_AUX, TO=MESHES(NM)%CUT_EDGE) +ENDIF -! -------------------------- GET_BODINT_PLANE ----------------------------------- +RETURN +END SUBROUTINE CUT_EDGE_ARRAY_REALLOC -SUBROUTINE GET_BODINT_PLANE(X1AXIS,X1PLN,INDX1,PLNORMAL,X2AXIS,X3AXIS,& - X2LO,X2HI,X3LO,X3HI,X2FACE,X3FACE,X2LO_CELL,& - X2HI_CELL,X3LO_CELL,X3HI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE) -INTEGER, INTENT(IN) :: X1AXIS, X2AXIS, X3AXIS, INDX1, X2LO, X2HI, X3LO, X3HI, X2LO_CELL,& - X2HI_CELL,X3LO_CELL,X3HI_CELL -REAL(EB),INTENT(IN) :: X1PLN, PLNORMAL(MAX_DIM) -REAL(EB), ALLOCATABLE, DIMENSION(:), INTENT(IN) :: X2FACE,X3FACE -LOGICAL, INTENT(IN) :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY -TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE +! ----------------------------- NEW_EDGE_ALLOC ---------------------------------- -! Local variables: -INTEGER :: IG, IBIN, IWSEL, IWSELDUM, IEDGE, ISGL, ISEG, ITRI, EDGE_TRI -REAL(EB):: XYZV(MAX_DIM,NODS_WSEL) -INTEGER :: ELEM(NODS_WSEL), IND_P(NODS_WSEL), NTRIS, NSEGS -REAL(EB):: DOT1, DOT2, DOT3 -LOGICAL :: INTFLG, INLIST -REAL(EB):: LN1(MAX_DIM,NOD1:NOD2), LN2(MAX_DIM,NOD1:NOD2) -REAL(EB):: XYZ_INT1(MAX_DIM), XYZ_INT2(MAX_DIM) -INTEGER :: SEG(NOD1:NOD2), EDGES(NOD1:NOD2,3), VEC3(3) -REAL(EB):: X2X3(IAXIS:JAXIS,NODS_WSEL), AREALOC -REAL(EB):: XP1(IAXIS:JAXIS), XP2(IAXIS:JAXIS), TX2P(IAXIS:JAXIS), TX3P(IAXIS:JAXIS) -REAL(EB):: NMTX2P -INTEGER :: IWSEL1, IWSEL2, ELEM1(NODS_WSEL), ELEM2(NODS_WSEL) -REAL(EB):: XYZ1(MAX_DIM), NXYZ1(MAX_DIM), NX3P1, N1(IAXIS:JAXIS), NMNL -REAL(EB):: XYZ2(MAX_DIM), NXYZ2(MAX_DIM), NX3P2, N2(IAXIS:JAXIS) -REAL(EB):: X3PVERT, PVERT(IAXIS:JAXIS), X3P1, P1CEN(IAXIS:JAXIS), X3P2, P2CEN(IAXIS:JAXIS) -INTEGER :: VCT(2) -REAL(EB):: PCT(IAXIS:JAXIS,1:2), V1(IAXIS:JAXIS), V2(IAXIS:JAXIS), CRSSNV, CTST -REAL(EB):: VEC(IAXIS:JAXIS,1:2) -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEGAUX, INDSEGAUX, SEGTYPEAUX, ISEG_NODE -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: ANGS_NODE -REAL(EB):: X3_1, X2_1, X3_2, X2_2, SLEN, SBOD -INTEGER :: INOD, ISEG_NEW, NBCROSS, NBCROSS_SVAR -REAL(EB):: DELBIN -INTEGER :: ILO_BIN, IHI_BIN +SUBROUTINE NEW_EDGE_ALLOC(NM,CEI,NVERTALLOC,NEDGEALLOC) -INTEGER :: AXIS, NTL, SZE, IBCR, ICROSS, IDUM, ISVAR, ISX, JJ2, KK2, BISEG, BIISEG, JJ2_LO, JJ2_HI, KK2_LO, KK2_HI -INTEGER :: VAXIS(IAXIS:JAXIS), I -REAL(EB):: LXI, MEAN_SLEN, XIV(NOD1:NOD2), XIV_LO, XIV_HI, MIN_MESHGEOM -INTEGER, ALLOCATABLE, DIMENSION(:) :: TRI_LIST, SEGS_NODE, CIRC_MED -INTEGER :: SEGV(NOD1:NOD2,EDG1:EDG2), ISEGV(EDG1:EDG2), INT_FLG, MAX_SEG_NODE, ISEG2, ISEG3, NSN, COUNT -REAL(EB):: XPOS, XY(IAXIS:JAXIS), S1_X2_MIN, S1_X3_MIN, S1_X2_MAX, S1_X3_MAX, AVAL, ANG, DX2, DX3 -REAL(EB):: D1(IAXIS:JAXIS),P1(IAXIS:JAXIS),D2(IAXIS:JAXIS),P2(IAXIS:JAXIS),SLENV(EDG1:EDG2),SVARV(NOD1:NOD2,EDG1:EDG2) -REAL(EB) :: TNOW -LOGICAL :: LO_X2_TEST, HI_X2_TEST, LO_X3_TEST, HI_X3_TEST, FOUND_SEG, CRS_FLG -CHARACTER(100) :: BIPL_FILE -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX +INTEGER, INTENT(IN) :: NM, CEI, NVERTALLOC, NEDGEALLOC -INTEGER :: WSELEM(NOD1:NOD3), MYAXIS -REAL(EB):: FACECUBE(LOW_IND:HIGH_IND,IAXIS:KAXIS) +IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT) +IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM) +IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%CEELEM)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM) +IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%INDSEG)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%INDSEG) +IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST) -IG = INDX1 -TNOW = CURRENT_TIME() +ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:NVERTALLOC)) +ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(1:NVERTALLOC)) +ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGEALLOC)) +ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%INDSEG(CC_MAX_WSTRIANG_SEG+3,1:NEDGEALLOC)) +ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(CC_MAX_WSTRIANG_SEG+2,1:NVERTALLOC)) -! Now allocate BODINT_PLANE: -BODINT_PLANE%NNODS = 0 -BODINT_PLANE%NSGLS = 0 -BODINT_PLANE%NSEGS = 0 -BODINT_PLANE%NTRIS = 0 +MESHES(NM)%CUT_EDGE(CEI)%XYZVERT = 0._EB +MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM = CC_UNDEFINED +MESHES(NM)%CUT_EDGE(CEI)%CEELEM = CC_UNDEFINED +MESHES(NM)%CUT_EDGE(CEI)%INDSEG = CC_UNDEFINED +MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST= CC_UNDEFINED -! Main Loop over Geometries: -MAIN_GEOM_LOOP : DO IG=1,N_GEOMETRY +RETURN - IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE - DELBIN = GEOMETRY(IG)%TBAXIS(X1AXIS)%DELBIN - MIN_MESHGEOM = GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(1)%X1_LOW - ILO_BIN = MAX(1,CEILING((X1PLN-GEOMEPS-MIN_MESHGEOM)/DELBIN)) - IHI_BIN = MIN(GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS,CEILING((X1PLN+GEOMEPS-MIN_MESHGEOM)/DELBIN)) +END SUBROUTINE NEW_EDGE_ALLOC - ! Find for this geometry where does the plane lay on triangle bins: - IBIN_DO : DO IBIN=ILO_BIN,IHI_BIN !1,GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS +! ------------------ REALLOCATE_EDGE_VERT(NM,CEI,NVERT) ------------------------- - IF ( X1PLN < GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE - IF ( X1PLN > GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE +SUBROUTINE REALLOCATE_EDGE_VERT(NM,CEI,NVERT) - ! Loop surface triangles: -! DO IWSEL =1,GEOMETRY(IG)%N_FACES - DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL +INTEGER, INTENT(IN) :: NM, CEI, NVERT - IWSEL=GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(IWSELDUM) - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(MAX_DIM*(IWSEL-1)+1:MAX_DIM*IWSEL) - ! Triangles NODES coordinates: - DO INOD=NOD1,NOD3 - XYZV(IAXIS:KAXIS,INOD) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+1:MAX_DIM*WSELEM(INOD)) - ENDDO - ! FACECUBE: - DO MYAXIS=IAXIS,KAXIS - FACECUBE( LOW_IND,MYAXIS) = MINVAL(XYZV(MYAXIS,NOD1:NOD3)) - FACECUBE(HIGH_IND,MYAXIS) = MAXVAL(XYZV(MYAXIS,NOD1:NOD3)) - ENDDO +! Local Variables: +INTEGER :: NVERT_SIZE +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZVERTAUX +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: VERT_LISTAUX +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOD_PERMAUX - ! Test low-high vertices of triangle along x1axis vs plane (O(NT) operation): - IF( (FACECUBE( LOW_IND,X1AXIS)-X1PLN) > GEOMEPS) CYCLE - IF( (X1PLN-FACECUBE(HIGH_IND,X1AXIS)) > GEOMEPS) CYCLE +NVERT_SIZE = SIZE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT, DIM=2) - IF(RAYTRACE_X2_ONLY) THEN - IF( (X3LO_RT-FACECUBE(HIGH_IND,X3AXIS)) > GEOMEPS) CYCLE - IF( (FACECUBE( LOW_IND,X3AXIS)-X3HI_RT) > GEOMEPS) CYCLE - ELSE - LO_X2_TEST=(X2FACE(X2LO)-FACECUBE(HIGH_IND,X2AXIS)) > GEOMEPS - LO_X3_TEST=(X3FACE(X3LO)-FACECUBE(HIGH_IND,X3AXIS)) > GEOMEPS - IF( LO_X2_TEST .AND. LO_X3_TEST ) CYCLE - HI_X2_TEST=(FACECUBE( LOW_IND,X2AXIS)-X2FACE(X2HI)) > GEOMEPS - IF( HI_X2_TEST .AND. LO_X3_TEST ) CYCLE - HI_X3_TEST=(FACECUBE( LOW_IND,X3AXIS)-X3FACE(X3HI)) > GEOMEPS - IF( LO_X2_TEST .AND. HI_X3_TEST ) CYCLE - IF( HI_X2_TEST .AND. HI_X3_TEST ) CYCLE - ENDIF +IF (NVERT > NVERT_SIZE) THEN ! Reallocate XYZVERT + ALLOCATE(XYZVERTAUX(IAXIS:KAXIS,1:NVERT_SIZE+CC_ALLOC_DVERT)); XYZVERTAUX = 0._EB + XYZVERTAUX(IAXIS:KAXIS,1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:NVERT_SIZE) + CALL MOVE_ALLOC(FROM=XYZVERTAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%XYZVERT) - ! Compute simplified dot(PLNORMAL,XYZV-XYZPLANE): - DOT1 = XYZV(X1AXIS,NOD1) - X1PLN - DOT2 = XYZV(X1AXIS,NOD2) - X1PLN - DOT3 = XYZV(X1AXIS,NOD3) - X1PLN - IF ( ABS(DOT1) <= GEOMEPS ) DOT1 = 0._EB - IF ( ABS(DOT2) <= GEOMEPS ) DOT2 = 0._EB - IF ( ABS(DOT3) <= GEOMEPS ) DOT3 = 0._EB + ALLOCATE(NOD_PERMAUX(1:NVERT_SIZE+CC_ALLOC_DVERT)); NOD_PERMAUX = CC_UNDEFINED + NOD_PERMAUX(1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(1:NVERT_SIZE) + CALL MOVE_ALLOC(FROM=NOD_PERMAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM) - ! Test if IWSEL lays in X1PLN: - IF ( (ABS(DOT1)+ABS(DOT2)+ABS(DOT3)) == 0._EB ) THEN + ALLOCATE(VERT_LISTAUX(1:4,1:NVERT_SIZE+CC_ALLOC_DVERT)); VERT_LISTAUX = CC_UNDEFINED + VERT_LISTAUX(1:4,1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,1:NVERT_SIZE) + CALL MOVE_ALLOC(FROM=VERT_LISTAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST) +ENDIF - ! Force nodes location in X1PLN plane: - XYZV(X1AXIS,NOD1:NOD3) = X1PLN +RETURN - ! Index to point 1 of triangle in BODINT_PLANE%XYZ list: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD1),IND_P(NOD1)) +END SUBROUTINE REALLOCATE_EDGE_VERT - ! Index to point 2 of triangle in BODINT_PLANE%XYZ list: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD2),IND_P(NOD2)) +! ------------------ REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) ------------------------- - ! Index to point 3 of triangle in BODINT_PLANE%XYZ list: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD3),IND_P(NOD3)) +SUBROUTINE REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) - ! Do we need to test if we already have this triangle on - ! the list? Shouldn't unless repeated -> Possibility for - ! zero thickness. - NTRIS = BODINT_PLANE % NTRIS + 1 - BODINT_PLANE % NTRIS = NTRIS - BODINT_PLANE % TRIS(NOD1:NOD3,NTRIS) = IND_P - BODINT_PLANE % INDTRI(1:2,NTRIS) = (/ IWSEL, IG /) +INTEGER, INTENT(IN) :: NM, CEI, NEDGE - CYCLE ! Next WSELEM +! Local Variables: +INTEGER :: NEDGE_SIZE, CC_ALLOC_ELEM +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CEELEMAUX, INDSEGAUX +INTEGER, ALLOCATABLE, DIMENSION(:,:,:):: FACE_LIST_AUX +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: DXX_AUX,DUIDXJ_AUX,MU_DUIDXJ_AUX - ENDIF +NEDGE_SIZE = SIZE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM, DIM=2) - ! Test if we are looking for intersection triangles only: - ONLY_TRIANG_EDGES_COND : IF (.NOT.TRI_ONPLANE_ONLY) THEN - ! Case a: Typical intersections: - ! Points 1,2 on on side of plane, point 3 on the other: - IF ( ((DOT1 > 0._EB) .AND. (DOT2 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT2 < 0._EB) .AND. (DOT3 > 0._EB)) ) THEN +IF (NEDGE > NEDGE_SIZE) THEN ! Reallocate CEELEM, - ! Line 1, from node 2 to 3: - LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) - LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) + CC_ALLOC_ELEM = MAX(NEDGE-NEDGE_SIZE,CC_ALLOC_DELEM) - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) + ALLOCATE(CEELEMAUX(NOD1:NOD2,1:NEDGE_SIZE+CC_ALLOC_ELEM), INDSEGAUX(CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE+CC_ALLOC_ELEM)) + CEELEMAUX = CC_UNDEFINED; INDSEGAUX = CC_UNDEFINED - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + CEELEMAUX(NOD1:NOD2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGE_SIZE) + INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE) - ! Line 2, from node 1 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) + CALL MOVE_ALLOC(FROM=CEELEMAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%CEELEM) + CALL MOVE_ALLOC(FROM=INDSEGAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%INDSEG) - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) + IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST)) THEN + ! FACE_LIST, DXX, DUIDXJ, MU_DUIDXJ: + ALLOCATE(FACE_LIST_AUX(1:3,-2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); FACE_LIST_AUX=CC_UNDEFINED + FACE_LIST_AUX(1:3,-2:2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,1:NEDGE_SIZE) + CALL MOVE_ALLOC(FROM=FACE_LIST_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST) - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + ALLOCATE(DXX_AUX(1:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); DXX_AUX=0._EB + DXX_AUX(1:2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%DXX(1:2,1:NEDGE_SIZE) + CALL MOVE_ALLOC(FROM=DXX_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%DXX) - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT1 > 0._EB ) THEN ! First case, counterclockwise p1 to p2 - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) + ALLOCATE(DUIDXJ_AUX( -2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); DUIDXJ_AUX = 0._EB + ALLOCATE(MU_DUIDXJ_AUX(-2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); MU_DUIDXJ_AUX= 0._EB - CYCLE ! Next WSELEM + CALL MOVE_ALLOC(FROM=DUIDXJ_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%DUIDXJ) + CALL MOVE_ALLOC(FROM=MU_DUIDXJ_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%MU_DUIDXJ) + ENDIF - ENDIF - ! Points 2,3 on one side of plane, point 1 on the other: - IF ( ((DOT2 > 0._EB) .AND. (DOT3 > 0._EB) .AND. (DOT1 < 0._EB)) .OR. & - ((DOT2 < 0._EB) .AND. (DOT3 < 0._EB) .AND. (DOT1 > 0._EB)) ) THEN +ENDIF - ! Line 1, from node 1 to 2: - LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) +RETURN - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) +END SUBROUTINE REALLOCATE_EDGE_ELEM - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +! -------------------------- GET_ISGASPHASE ------------------------------------- - ! Line 2, from node 1 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) +SUBROUTINE GET_IS_GASPHASE(SCEN,IS_GASPHASE) - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) +REAL(EB), INTENT(IN) :: SCEN +LOGICAL, INTENT(OUT) :: IS_GASPHASE - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +! Local Variables: +LOGICAL :: IS_GASPHASE_LEFT, IS_GASPHASE_RIGHT +INTEGER :: ICRS - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT2 > 0._EB ) THEN ! Second case, counterclockwise p2 to p1 - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) - ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) +! Count GS,SG intersections from both sides: +IS_GASPHASE_LEFT = .TRUE. +DO ICRS=1,CC_N_CRS + IF (SCEN < CC_SVAR_CRS(ICRS)-GEOMEPS/2._EB) CYCLE + ! If solid change state: + IF ( (CC_IS_CRS(ICRS) == CC_GS) .OR. (CC_IS_CRS(ICRS) == CC_SG) ) THEN + IS_GASPHASE_LEFT = .NOT.IS_GASPHASE_LEFT + ENDIF +ENDDO - CYCLE ! Next WSELEM +IS_GASPHASE_RIGHT = .TRUE. +DO ICRS=CC_N_CRS,1,-1 + IF (SCEN > CC_SVAR_CRS(ICRS)+GEOMEPS/2._EB) CYCLE + ! If solid change state: + IF ( (CC_IS_CRS(ICRS) == CC_GS) .OR. (CC_IS_CRS(ICRS) == CC_SG) ) THEN + IS_GASPHASE_RIGHT = .NOT.IS_GASPHASE_RIGHT + ENDIF +ENDDO - ENDIF - ! Points 1,3 on one side of plane, point 2 on the other: - IF ( ((DOT1 > 0._EB) .AND. (DOT3 > 0._EB) .AND. (DOT2 < 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT3 < 0._EB) .AND. (DOT2 > 0._EB)) ) THEN +! If at least one of left and right are true -> add +! CC_GASPHASE cut-edge: +IS_GASPHASE = IS_GASPHASE_LEFT .OR. IS_GASPHASE_RIGHT - ! Line 1, from node 1 to 2: - LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) +RETURN +END SUBROUTINE GET_IS_GASPHASE - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) +! --------------------- GET_BODX2_INTERSECTIONS --------------------------------- - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +SUBROUTINE GET_BODX2_INTERSECTIONS(X2AXIS,X3AXIS,X3RAY) - ! Line 2, from node 2 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) +INTEGER, INTENT(IN) :: X2AXIS,X3AXIS +REAL(EB),INTENT(IN) :: X3RAY - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) +! Local Variables: +REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN, SBOD +REAL(EB) :: STANI(IAXIS:JAXIS), DV(IAXIS:JAXIS) +INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IBCR, IDUM, NBCROSS_SVAR +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX +REAL(EB) :: DX3_1, DX3_2, XI1, XI2 +REAL(EB) :: TNOW - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX3_1Q,DX3_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT1 > 0._EB ) THEN ! Third case, counterclockwise p1 to p2 - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) +TNOW=CURRENT_TIME() - CYCLE ! Next WSELEM - ENDIF +IF ( BODINT_PLANE%NSEGS == 0) RETURN - ! Case b: only one point intersection. They will be used to define - ! Solid vertex points in case of coincidence. - ! Point 1 is on the plane: - IF ( (DOT1 == 0._EB) .AND. ( ((DOT2 > 0._EB) .AND. (DOT3 > 0._EB)) .OR. & - ((DOT2 < 0._EB) .AND. (DOT3 < 0._EB)) ) ) THEN +DO ISEG=1,BODINT_PLANE%NSEGS - ! First node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN + IF (BODINT_PLANE%X2ALIGNED(ISEG)) CYCLE + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + IF( (X3RAY-MAX(BODINT_PLANE%XYZ(X3AXIS,SEG(NOD1)),BODINT_PLANE%XYZ(X3AXIS,SEG(NOD2)))) > GEOMEPS) CYCLE + IF( (MIN(BODINT_PLANE%XYZ(X3AXIS,SEG(NOD1)),BODINT_PLANE%XYZ(X3AXIS,SEG(NOD2)))-X3RAY) > GEOMEPS) CYCLE + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + ! x2_x3 of segment point 1: + X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) + ! x2_x3 of segment point 2: + X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) - ! Add index to singles: - ! Find if oriented segment is in list: - INLIST = .FALSE. - DO ISGL=1,BODINT_PLANE%NSGLS - IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ISGL = BODINT_PLANE%NSGLS + 1 - BODINT_PLANE % NSGLS = ISGL - BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) - ENDIF + ! IF (.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + ! Segment length: + SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) - CYCLE ! Next WSELEM + ! Unit vector along segment: + STANI(IAXIS:JAXIS) = 1._EB/SLEN * (/ (X2_2-X2_1), (X3_2-X3_1) /) - ENDIF - ! Point 2 is on the plane: - IF ( (DOT2 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT3 > 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT3 < 0._EB)) ) ) THEN + ! S coordinate along segment: + DX3_1 = X3_2 - X3RAY + DX3_2 = X3RAY- X3_1 + XI1 = DX3_1 / (X3_2-X3_1) + XI2 = DX3_2 / (X3_2-X3_1) + DV(IAXIS:JAXIS) = (/ (XI1-1._EB)*X2_1+XI2*X2_2 , DX3_2 /) + SBOD = DV(IAXIS)*STANI(IAXIS)+DV(JAXIS)*STANI(JAXIS) + ! ELSE + ! ! Segment length: + ! X2_21Q = (REAL(X2_2,QB)-REAL(X2_1,QB)) + ! X3_21Q = (REAL(X3_2,QB)-REAL(X3_1,QB)) + ! SLENQ = SQRT( X2_21Q**2._QB + X3_21Q**2._QB ) + ! + ! ! Unit vector along segment: + ! STANIQ(IAXIS:JAXIS) = 1._QB/SLENQ * (/ X2_21Q, X3_21Q /) + ! + ! ! S coordinate along segment: + ! DX3_1Q = REAL(X3_2,QB) - REAL(X3RAY,QB) + ! DX3_2Q = REAL(X3RAY,QB)- REAL(X3_1,QB) + ! XI1Q = DX3_1Q / X3_21Q + ! XI2Q = DX3_2Q / X3_21Q + ! DVQ(IAXIS:JAXIS) = (/ (XI1Q-1._QB)*REAL(X2_1,QB)+XI2Q*REAL(X2_2,QB) , DX3_2Q /) + ! SBOD = REAL(DVQ(IAXIS)*STANIQ(IAXIS)+DVQ(JAXIS)*STANIQ(JAXIS),EB) + ! ENDIF - ! Second node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN + ! If crossing is already defined, cycle: + DO IBCR=1,BODINT_PLANE%NBCROSS(ISEG) + IF ( ABS(SBOD-BODINT_PLANE%SVAR(IBCR,ISEG)) < GEOMEPS ) EXIT + ENDDO + IF (IBCR NBCROSS_SVAR) THEN + ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB + SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) + CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) + ENDIF + BODINT_PLANE%SVAR(NBCROSS,ISEG) = 1._EB/GEOMEPS + DO IBCR=1,NBCROSS + IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEG) ) EXIT + ENDDO - ! Add index to singles: - ! Find if oriented segment is in list: - INLIST = .FALSE. - DO ISGL=1,BODINT_PLANE%NSGLS - IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ISGL = BODINT_PLANE%NSGLS + 1 - BODINT_PLANE % NSGLS = ISGL - BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) - ENDIF + ! Here copy from the back (updated nbcross) to the ibcr location: + DO IDUM = NBCROSS,IBCR+1,-1 + BODINT_PLANE%SVAR(IDUM,ISEG) = BODINT_PLANE%SVAR(IDUM-1,ISEG) + ENDDO + BODINT_PLANE%SVAR(IBCR,ISEG) = SBOD + BODINT_PLANE%NBCROSS(ISEG) = NBCROSS - CYCLE ! Next WSELEM +ENDDO - ENDIF - ! Point 3 is on the plane: - IF ( (DOT3 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT2 > 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT2 < 0._EB)) ) ) THEN +T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW +RETURN +END SUBROUTINE GET_BODX2_INTERSECTIONS - ! Third node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN +! ----------------------- GET_BODX3_INTERSECTIONS ------------------------------- - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +SUBROUTINE GET_BODX3_INTERSECTIONS(X2AXIS,X3AXIS,X2LO,X2HI) - ! Add index to singles: - ! Find if single element is in list: - INLIST = .FALSE. - DO ISGL=1,BODINT_PLANE%NSGLS - IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ISGL = BODINT_PLANE%NSGLS + 1 - BODINT_PLANE % NSGLS = ISGL - BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) - ENDIF +INTEGER, INTENT(IN) :: X2AXIS,X3AXIS,X2LO,X2HI - CYCLE ! Next WSELEM +! Local Variables: +REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN, SBOD +REAL(EB) :: STANI(IAXIS:JAXIS), DV(IAXIS:JAXIS), MINX, MAXX, XI1, XI2, DX2_1, DX2_2 +INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IBCR, IDUM, JSTR, JEND, JJ, NBCROSS_SVAR +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX +LOGICAL :: ISCONT +REAL(EB) :: TNOW - ENDIF +! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX2_1Q,DX2_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) - ! Case c: one node is part of the intersection: - ! Node 1 is in the plane: - IF ( (DOT1 == 0._EB) .AND. ( ((DOT2 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & - ((DOT2 < 0._EB) .AND. (DOT3 > 0._EB)) ) ) THEN +TNOW=CURRENT_TIME() - ! First node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN +DO ISEG=1,BODINT_PLANE%NSEGS - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + IF (BODINT_PLANE%X3ALIGNED(ISEG)) CYCLE ! This segment is not aligned with x3. - ! Line 2, from node 2 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) + ! x2_x3 of segment point 1: + X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) + ! x2_x3 of segment point 2: + X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + ! Segment length: + SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) + ! Unit vector along segment: + STANI(IAXIS:JAXIS) = (/ (X2_2-X2_1), (X3_2-X3_1) /)*SLEN**(-1._EB) + ! ELSE + ! ! Segment length: + ! X2_21Q = (REAL(X2_2,QB)-REAL(X2_1,QB)) + ! X3_21Q = (REAL(X3_2,QB)-REAL(X3_1,QB)) + ! SLENQ = SQRT( X2_21Q**2._QB + X3_21Q**2._QB ) + ! ! Unit vector along segment: + ! STANIQ(IAXIS:JAXIS) = 1._QB/SLENQ * (/ X2_21Q, X3_21Q /) + ! ENDIF - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT2 > 0._EB ) THEN ! Second case, counterclockwise p2 to p1 - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + MINX = MIN(X2_1,X2_2) + MAXX = MAX(X2_1,X2_2) + IF(X2NOC==0) THEN + ! Optimized for UG: + JSTR = MAX(X2LO, CEILING(( MINX-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO))+X2LO) + JEND = MIN(X2HI, FLOOR(( MAXX+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO))+X2LO) + ELSE + IF ((MINX-GEOMEPS-X2FACE(X2LO)) < 0._EB) THEN + JSTR=X2LO + ELSEIF((MINX-GEOMEPS-X2FACE(X2HI)) >= 0._EB) THEN + JSTR=X2HI+1 + ELSE + DO JJ=X2LO,X2HI + IF((MINX-GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. (MINX-GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN + JSTR = JJ+1 + EXIT ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) + ENDDO + ENDIF + IF ((MAXX+GEOMEPS-X2FACE(X2LO)) < 0._EB) THEN + JEND=X2LO-1 + ELSEIF((MAXX+GEOMEPS-X2FACE(X2HI)) >= 0._EB) THEN + JEND=X2HI + ELSE + DO JJ=X2LO,X2HI + IF((MAXX+GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. (MAXX+GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN + JEND = JJ + EXIT + ENDIF + ENDDO + ENDIF + ENDIF - CYCLE ! Next WSELEM + DO JJ=JSTR,JEND - ENDIF - ! Node 2 is in the plane: - IF ( (DOT2 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT3 > 0._EB)) ) ) THEN + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + ! S coordinate along segment: + DX2_1 = X2_2 - X2FACE(JJ) + DX2_2 = X2FACE(JJ) - X2_1 + XI1 = DX2_1 / (X2_2-X2_1) + XI2 = DX2_2 / (X2_2-X2_1) + DV(IAXIS:JAXIS) = (/ DX2_2, (XI1-1._EB)*X3_1+XI2*X3_2 /) + SBOD = DV(IAXIS)*STANI(IAXIS)+DV(JAXIS)*STANI(JAXIS) + ! ELSE + ! ! S coordinate along segment: + ! DX2_1Q = REAL(X2_2,QB) - REAL(X2FACE(JJ),QB) + ! DX2_2Q = REAL(X2FACE(JJ),QB)- REAL(X2_1,QB) + ! XI1Q = DX2_1Q / X2_21Q + ! XI2Q = DX2_2Q / X2_21Q + ! DVQ(IAXIS:JAXIS) = (/ DX2_2Q, (XI1Q-1._QB)*REAL(X3_1,QB)+XI2Q*REAL(X3_2,QB) /) + ! SBOD = REAL(DVQ(IAXIS)*STANIQ(IAXIS)+DVQ(JAXIS)*STANIQ(JAXIS),EB) + ! ENDIF - ! Second node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + ! If crossing is already defined, cycle: + NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + ISCONT = .FALSE. + DO IBCR=1,NBCROSS + IF ( ABS(SBOD-BODINT_PLANE%SVAR(IBCR,ISEG)) < GEOMEPS ) THEN + ISCONT = .TRUE. + EXIT + ENDIF + ENDDO + IF (ISCONT) CYCLE - ! Line 2, from node 1 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) + ! Add crossing to BODINT_PLANE, insertion sort: + NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + 1 + ! Test-reallocate BODINT_PLANE%SVAR + NBCROSS_SVAR = SIZE(BODINT_PLANE%SVAR,DIM=1) + IF (NBCROSS > NBCROSS_SVAR) THEN + ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB + SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) + CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) + ENDIF + BODINT_PLANE%SVAR(NBCROSS,ISEG) = 1._EB/GEOMEPS + DO IBCR=1,NBCROSS + IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEG) ) EXIT + ENDDO - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) + ! Here copy from the back (updated nbcross) to the ibcr location: + DO IDUM = NBCROSS,IBCR+1,-1 + BODINT_PLANE%SVAR(IDUM,ISEG) = BODINT_PLANE%SVAR(IDUM-1,ISEG) + ENDDO + BODINT_PLANE%SVAR(IBCR,ISEG) = SBOD + BODINT_PLANE%NBCROSS(ISEG) = NBCROSS - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + ENDDO - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT1 > 0._EB ) THEN - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) +ENDDO - CYCLE ! Next WSELEM +T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW - ENDIF - ! Node 3 is in the plane: - IF ( (DOT3 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT2 < 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT2 > 0._EB)) ) ) THEN +RETURN +END SUBROUTINE GET_BODX3_INTERSECTIONS - ! Third node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN +! ----------------------- GET_CARTFACE_CUTEDGES --------------------------------- - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +SUBROUTINE GET_CARTFACE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS, & + XIAXIS,XJAXIS,XKAXIS,NM , & + X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL, & + X3LO_CELL,X3HI_CELL,INDX1,X1PLN) - ! Line 2, from node 1 to 2: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) +INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS,NM, & + X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL, & + X3LO_CELL,X3HI_CELL,INDX1(MAX_DIM) +REAL(EB), INTENT(IN) :: X1PLN - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) +! Local Variables: +REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN +REAL(EB) :: STANI(IAXIS:JAXIS), SNORI(IAXIS:JAXIS), X2RAY, X3RAY +INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IEDGE, JJ, KK, JJ2, KK2, IPFACE, NPFACE, INOD1, INOD2 +LOGICAL :: ADD2FACES, INRAY, CONDAX +INTEGER :: INDSEG(1:CC_MAX_WSTRIANG_SEG+2), NTRISEG, CETYPE, JJ2VEC(LOW_IND:HIGH_IND), KK2VEC(LOW_IND:HIGH_IND) +REAL(EB) :: SVAR1, SVAR2, SVAR12, XPOS, XY(IAXIS:JAXIS) +INTEGER :: INDXI(IAXIS:KAXIS), INDIF, INDJF, INDKF, CEI, NVERT, NEDGE, DIRAXIS, IDG +REAL(EB) :: XYZV1(IAXIS:KAXIS), XYZV1LC(IAXIS:KAXIS) +REAL(EB) :: XYZV2(IAXIS:KAXIS), XYZV2LC(IAXIS:KAXIS) +REAL(EB) :: TNOW +INTEGER :: INIT_CUT_EDGES,IVERT,IADD,JADD,KADD +LOGICAL :: FOUND_SEG, IS_SOLID - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +TNOW=CURRENT_TIME() - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT1 > 0._EB ) THEN - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) - ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) +INIT_CUT_EDGES = MESHES(NM)%N_CUTEDGE_MESH+1 - CYCLE ! Next WSELEM +! Segment by segment define the INBOUNDARY MESHES(NM)%CUT_EDGEs between crossings +! and individualize the Cartesian face they belong to. +! NCUTEDGEOLD = MESHES(NM)%N_CUTEDGE_MESH + 1 +SEGS_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS - ENDIF - ENDIF ONLY_TRIANG_EDGES_COND + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) - ! Case D: A triangle segment is in the plane. - ! Intersection is line 1-2: - IF ( (DOT1 == 0._EB) .AND. (DOT2 == 0._EB) ) THEN + IF (MAX(XYZ1(X2AXIS),XYZ2(X2AXIS)) < X2FACE(X2LO)-GEOMEPS) CYCLE + IF (MIN(XYZ1(X2AXIS),XYZ2(X2AXIS)) > X2FACE(X2HI)+GEOMEPS) CYCLE + IF (MAX(XYZ1(X3AXIS),XYZ2(X3AXIS)) < X3FACE(X3LO)-GEOMEPS) CYCLE + IF (MIN(XYZ1(X3AXIS),XYZ2(X3AXIS)) > X3FACE(X3HI)+GEOMEPS) CYCLE - ! First node: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN + NBCROSS = BODINT_PLANE%NBCROSS(ISEG) ! Cross points include Node1, Node2 - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + ! x2_x3 of segment point 1: + X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) + ! x2_x3 of segment point 2: + X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) - ! Second node: - XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT2(X1AXIS) = X1PLN + ! Normal out: + SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) + STANI(IAXIS:JAXIS) = (/ (X2_2-X2_1), (X3_2-X3_1) /)*SLEN**(-1._EB) + SNORI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + INDSEG(1:CC_MAX_WSTRIANG_SEG+2) = BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2, ISEG) + NTRISEG = INDSEG(1) - ! Set oriented segment regarding plane: - IF ( DOT3 > 0._EB ) THEN - SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - ! Find if oriented segment is in list: - EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG1,IWSEL) ! 1st edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. - VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) - VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) - VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) - INLIST = .FALSE. - DO ISEG=1,BODINT_PLANE%NSEGS - FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & - ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) - IF ( FOUND_SEG .AND. & - (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & - (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & - (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ISEG = BODINT_PLANE%NSEGS + 1 - BODINT_PLANE%NSEGS = ISEG - BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG - BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) + ADD2FACES = .FALSE. + ! Type to be assigned to cut edges: + CETYPE = 2*(BODINT_PLANE%SEGTYPE(LOW_IND,ISEG)+1) - BODINT_PLANE%SEGTYPE(HIGH_IND,ISEG) + IF ( CETYPE == CC_GG ) ADD2FACES = .TRUE. + + INRAY = .FALSE. + + ! Different cases: + ! First check if segment geomepsilon aligned with x2: + IF (BODINT_PLANE%X2ALIGNED(ISEG)) THEN + + ! Test if node1 of segment is in geomepsilon vicinity of an x2 ray + DO KK=X3LO,X3HI + ! x3 location of ray along x2, on the x2-x3 plane: + X3RAY = X3FACE(KK) + IF ( ABS(X3RAY-X3_1) < GEOMEPS ) THEN + INRAY = .TRUE. + EXIT ENDIF + ENDDO - CYCLE ! Next WSELEM + IF (INRAY) THEN ! Segment in x2 ray defined by x3 face index kk. - ENDIF - ! Intersection is line 2-3: - IF ( (DOT2 == 0._EB) .AND. (DOT3 == 0._EB) ) THEN + ! 1. INB cut-edges on top of an x2 gridline, assign to cut-face + ! defined by normal out. + KK2VEC(LOW_IND:HIGH_IND) = 0 + IF (ADD2FACES) THEN + NPFACE = 2 + KK2VEC(LOW_IND) = KK + 1 + KK2VEC(HIGH_IND)= KK + ELSE + NPFACE = 1 + if ( SNORI(JAXIS) > 0._EB ) THEN ! add 1 to index kk (i.e. lower face index) + KK2VEC(LOW_IND) = KK + 1 + ELSE + KK2VEC(LOW_IND)= KK + ENDIF + ENDIF - ! Second node: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN + DO IPFACE=1,NPFACE - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + KK2 = KK2VEC(IPFACE) - ! Third node: - XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT2(X1AXIS) = X1PLN + ! Figure out which cut faces the inboundary cut-edges of + ! this segment belong to: + ! We have nbcross-1 INBOUNDARY CUT_EDGEs to generate. + DO IEDGE=1,NBCROSS-1 - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + ! Location along Segment: + SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) + SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) + ! Location of midpoint of cut-edge: + SVAR12 = 0.5_EB * (SVAR1+SVAR2) + ! Define Cartesian segment this cut-edge belongs: + XPOS = X2_1 + SVAR12*STANI(IAXIS) + IF (X2NOC==0) THEN + JJ2 = FLOOR((XPOS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + ! Discard cut-edges on faces laying on x2hi. + IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO JJ2=X2LO_CELL,X2HI_CELL + ! Check if XPOS is within this segment JJ2: + IF((XPOS-X2FACE(JJ2-1)) >= 0._EB .AND. (X2FACE(JJ2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF - ! Set oriented segment regarding plane: - IF ( DOT1 > 0._EB ) THEN - SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - ! Find if oriented segment is in list: - EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG2,IWSEL) ! 2nd edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. - VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) - VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) - VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) - INLIST = .FALSE. - DO ISEG=1,BODINT_PLANE%NSEGS - FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & - ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) - IF ( FOUND_SEG .AND. & - (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & - (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & - (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ISEG = BODINT_PLANE%NSEGS + 1 - BODINT_PLANE%NSEGS = ISEG - BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG - BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) - ENDIF + IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE - CYCLE ! Next WSELEM + ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. + ! If segment is inside the solid region mark cells surrounding face + ! to be treated in special manner (only if they happen to be type CUTCFE), + ! then drop segment. + XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) + CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) + IF (IS_SOLID) CYCLE - ENDIF - ! Intersection is line 3-1: - IF ( (DOT3 == 0._EB) .AND. (DOT1 == 0._EB) ) THEN + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 + INDIF=INDXI(XIAXIS) + INDJF=INDXI(XJAXIS) + INDKF=INDXI(XKAXIS) - ! Third node: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN + ! Now the face is, FCVAR (x1axis): + IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already + ! an entry in CUT_EDGE. + CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) + ELSE ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF + ENDIF - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + ! Add vertices, non repeated vertex entries at this point. + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT + ! Define vertices for this segment: + ! xv1 yv1 zv1 + XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) + XYZV1(IAXIS) = XYZV1LC(XIAXIS) + XYZV1(JAXIS) = XYZV1LC(XJAXIS) + XYZV1(KAXIS) = XYZV1LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) + ! xv2 yv2 zv2 + XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) + XYZV2(IAXIS) = XYZV2LC(XIAXIS) + XYZV2(JAXIS) = XYZV2LC(XJAXIS) + XYZV2(KAXIS) = XYZV2LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) - ! First node: - XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT2(X1AXIS) = X1PLN + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) + IF ( NPFACE == 1 ) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ELSE + DIRAXIS = X2AXIS + CONDAX = (XYZV2(DIRAXIS)-XYZV1(DIRAXIS)) > 0 + IF ( KK2 == KK ) THEN + IF (CONDAX) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ELSE + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) + ENDIF + ELSE + IF (CONDAX) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) + ELSE + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ENDIF + ENDIF + ENDIF + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & + BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = 0 !Edges in face boundary counted once. + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + ! Test for Repeated edge -> If so note FACERT: + DO IDG=1,NEDGE + IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & + ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN + FACERT(JJ2,KK2) =.TRUE. + EXIT + ENDIF + ENDDO - ! Set oriented segment regarding plane: - IF ( DOT2 > 0._EB ) THEN - SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - ! Find if oriented segment is in list: - EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG3,IWSEL) ! 3rd edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. - VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) - VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) - VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) - INLIST = .FALSE. - DO ISEG=1,BODINT_PLANE%NSEGS - FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & - ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) - IF ( FOUND_SEG .AND. & - (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & - (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & - (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN - INLIST = .TRUE. - EXIT - ENDIF + ENDDO ENDDO - IF (.NOT.INLIST) THEN - ISEG = BODINT_PLANE%NSEGS + 1 - BODINT_PLANE%NSEGS = ISEG - BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG - BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) - ENDIF + CYCLE ! Skips rest of iseg loop, for this ISEG. + ENDIF - CYCLE ! Next WSELEM + ! Second check if segment geomepsilon aligned with x3: + ELSEIF (BODINT_PLANE%X3ALIGNED(ISEG)) THEN - ENDIF + ! Test if node1 of segment is in geomepsilon vicinity of an x3 ray + DO JJ=X2LO,X2HI + ! x2 location of ray along x3, on the x2-x3 plane: + X2RAY = X2FACE(JJ) + IF ( ABS(X2RAY-X2_1) < GEOMEPS ) THEN + INRAY = .TRUE. + EXIT + ENDIF + ENDDO - ! If you get to this point -> you have a problem: - IF (.NOT.TRI_ONPLANE_ONLY) print*, "Error GET_BODINT_PLANE: Missed wet surface Triangle =",IWSEL + IF (INRAY) THEN ! Segment in x3 ray defined by x2 face index JJ + + ! 1. INB cut-edges on top of an x3 gridline, assign to cut-face + ! defined by normal out. + JJ2VEC(LOW_IND:HIGH_IND) = 0 + IF (ADD2FACES) THEN + NPFACE = 2 + JJ2VEC(LOW_IND) = JJ + 1 + JJ2VEC(HIGH_IND) = JJ + ELSE + NPFACE = 1 + IF ( SNORI(IAXIS) > 0._EB ) THEN ! add 1 to index jj (i.e. lower face index) + JJ2VEC(LOW_IND) = JJ + 1 + ELSE + JJ2VEC(LOW_IND) = JJ + ENDIF + ENDIF - ENDDO ! IWSEL + DO IPFACE=1,NPFACE - EXIT IBIN_DO ! No need to test more bins. + JJ2 = JJ2VEC(IPFACE) - ENDDO IBIN_DO + ! Figure out which cut faces the inboundary cut-edges of + ! this segment belong to: + ! We have NBCROSS-1 INBOUNDARY CUT_EDGEs to generate. + DO IEDGE=1,NBCROSS-1 -ENDDO MAIN_GEOM_LOOP + ! Location along Segment: + SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) + SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) + ! Location of midpoint of cut-edge: + SVAR12 = 0.5_EB * (SVAR1+SVAR2) + ! Define Cartesian segment this cut-edge belongs: + XPOS = X3_1 + SVAR12*STANI(JAXIS) + IF (X3NOC==0) THEN + KK2 = FLOOR((XPOS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + ! Discard cut-edges on faces laying on x3hi. + IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO KK2=X3LO_CELL,X3HI_CELL + ! Check if XPOS is within this segment KK2: + IF((XPOS-X3FACE(KK2-1)) >= 0._EB .AND. (X3FACE(KK2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF -! Next step is to Test triangles sides normals on plane against the obtained -! segments normals. If two identical segments found contain oposite -! normals, drop the segment in BODINT_PLANE%SEGS: -IF ( BODINT_PLANE%NTRIS > 0 ) THEN + IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE - DO ITRI=1,BODINT_PLANE%NTRIS + ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. + ! If segment is inside the solid region mark cells surrounding face + ! to be treated in special manner (only if they happen to be type CUTCFE), + ! then drop segment. + XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) + CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) + IF (IS_SOLID) CYCLE - ! Triang conectivities: - ELEM(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 + INDIF=INDXI(XIAXIS) + INDJF=INDXI(XJAXIS) + INDKF=INDXI(XKAXIS) - ! Coordinates in x2, x3 directions: - X2X3(IAXIS,NOD1:NOD3) = (/ BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD1)), & - BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD2)), & - BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD3)) /) - X2X3(JAXIS,NOD1:NOD3) = (/ BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD1)), & - BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD2)), & - BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD3)) /) + ! Now the face is, FCVAR (x1axis): + IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already + ! an entry in CUT_EDGE. + CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) + ELSE ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF + ENDIF - ! Test Area sign, if -ve switch node order: - AREALOC = 0.5_EB*(X2X3(IAXIS,NOD1)*X2X3(JAXIS,NOD2) - X2X3(IAXIS,NOD2)*X2X3(JAXIS,NOD1) + & - X2X3(IAXIS,NOD2)*X2X3(JAXIS,NOD3) - X2X3(IAXIS,NOD3)*X2X3(JAXIS,NOD2) + & - X2X3(IAXIS,NOD3)*X2X3(JAXIS,NOD1) - X2X3(IAXIS,NOD1)*X2X3(JAXIS,NOD3)) - IF (AREALOC < 0._EB) THEN - ISEG = ELEM(3) - ELEM(3) = ELEM(2) - ELEM(2) = ISEG - ENDIF + ! Add vertices, non repeated vertex entries at this point. + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT + ! Define vertices for this segment: + ! xv1 yv1 zv1 + XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) + XYZV1(IAXIS) = XYZV1LC(XIAXIS) + XYZV1(JAXIS) = XYZV1LC(XJAXIS) + XYZV1(KAXIS) = XYZV1LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) + ! xv2 yv2 zv2 + XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) + XYZV2(IAXIS) = XYZV2LC(XIAXIS) + XYZV2(JAXIS) = XYZV2LC(XJAXIS) + XYZV2(KAXIS) = XYZV2LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) - ! Now corresponding segments, ordered normal outside of plane x2-x3. - EDGES(NOD1:NOD2,1) = (/ ELEM(1), ELEM(2) /) ! edge 1. - EDGES(NOD1:NOD2,2) = (/ ELEM(2), ELEM(3) /) ! edge 2. - EDGES(NOD1:NOD2,3) = (/ ELEM(3), ELEM(1) /) + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) + IF ( NPFACE == 1 ) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ELSE + DIRAXIS = X3AXIS + CONDAX = (XYZV2(DIRAXIS)-XYZV1(DIRAXIS)) > 0 + IF ( JJ2 == JJ ) THEN + IF (CONDAX) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) + ELSE + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ENDIF + ELSE + IF (CONDAX) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ELSE + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) + ENDIF + ENDIF + ENDIF + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & + BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = 0 !Edges in face boundary counted once. + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE - ! Now Test against segments, Beast approach: - DO IEDGE=1,3 - DO ISEG=1,BODINT_PLANE%NSEGS - IF ( (BODINT_PLANE%SEGS(NOD1,ISEG) == EDGES(NOD2,IEDGE)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == EDGES(NOD1,IEDGE)) ) THEN ! Edge normals - ! oriented in opposite dirs. - ! Set to SOLID SOLID segtype from BODINT_PLANE.SEGS - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG)=(/ CC_SOLID, CC_SOLID /) + ! Test for Repeated edge -> If so note FACERT + DO IDG=1,NEDGE + IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & + ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN + FACERT(JJ2,KK2) =.TRUE. + EXIT + ENDIF + ENDDO - ENDIF + ENDDO ENDDO - ENDDO - - ENDDO -ENDIF - -! For segments that are related to 2 Wet Surface triangles, test if they are of type GG or SS: -DO ISEG=1,BODINT_PLANE%NSEGS - IF (BODINT_PLANE%INDSEG(1,ISEG) > 1) THEN ! Related to 2 WS triangles: - - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - - ! Segment nodes positions: - XP1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/X2AXIS,X3AXIS/) ,SEG(NOD1)) - XP2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/X2AXIS,X3AXIS/) ,SEG(NOD2)) + CYCLE ! Skips rest of iseg loop, for this ISEG. + ENDIF - ! Unit normal versor along x2p (axis directed from NOD2 to NOD1): - NMTX2P = SQRT( (XP1(IAXIS)-XP2(IAXIS))**2._EB + (XP1(JAXIS)-XP2(JAXIS))**2._EB ) - TX2P(IAXIS:JAXIS) = (XP1(IAXIS:JAXIS)-XP2(IAXIS:JAXIS)) * NMTX2P**(-1._EB) - ! Versor along x3p. - TX3P(IAXIS:JAXIS) = (/ -TX2P(JAXIS), TX2P(IAXIS) /) + ENDIF - ! Now related WS triangles centroids: - IWSEL1 = BODINT_PLANE%INDSEG(2,ISEG) - IWSEL2 = BODINT_PLANE%INDSEG(3,ISEG) - IG = BODINT_PLANE%INDSEG(4,ISEG) + ! 3. Regular case: INB cut-edge with centroid inside a + ! Cartesian face, assign to corresponding FCVAR CC_IDCE variable. + ! This is the most common case, INBOUNDARY edges defined inside x1 faces. + ! We have NBCROSS-1 INBOUNDARY CUT_EDGEs to generate. + DO IEDGE=1,NBCROSS-1 - ! Centroid of WS elem 1: - ELEM1(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL1-1)+1:NODS_WSEL*IWSEL1) - XYZ1(IAXIS:KAXIS) = ( GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD1)-1)+1:MAX_DIM*ELEM1(NOD1)) + & - GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD2)-1)+1:MAX_DIM*ELEM1(NOD2)) + & - GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD3)-1)+1:MAX_DIM*ELEM1(NOD3)) ) / 3._EB - NXYZ1(IAXIS:KAXIS)= GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL1) - ! Normal versor in x3p-x1 direction: - NX3P1 = TX3P(IAXIS)*NXYZ1(X2AXIS) + TX3P(JAXIS)*NXYZ1(X3AXIS) - N1(IAXIS:JAXIS) = (/ NX3P1, NXYZ1(X1AXIS) /) - NMNL = SQRT( N1(IAXIS)**2._EB + N1(JAXIS)**2._EB ) - N1 = N1 * NMNL**(-1._EB) + ! Location along Segment: + SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) + SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) + ! Location of midpoint of cut-edge: + SVAR12 = 0.5_EB * (SVAR1+SVAR2) - ! Centroid of WS elem 2: - ELEM2(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL2-1)+1:NODS_WSEL*IWSEL2) - XYZ2(IAXIS:KAXIS) = ( GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD1)-1)+1:MAX_DIM*ELEM2(NOD1)) + & - GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD2)-1)+1:MAX_DIM*ELEM2(NOD2)) + & - GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD3)-1)+1:MAX_DIM*ELEM2(NOD3)) ) / 3._EB - NXYZ2(IAXIS:KAXIS)= GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL2) - ! Normal versor in x3p-x1 direction: - NX3P2 = TX3P(IAXIS)*NXYZ2(X2AXIS) + TX3P(JAXIS)*NXYZ2(X3AXIS) - N2(IAXIS:JAXIS) = (/ NX3P2, NXYZ2(X1AXIS) /) - NMNL = SQRT( N2(IAXIS)**2._EB + N2(JAXIS)**2._EB ) - N2 = N2 * NMNL**(-1._EB) + ! Define Cartesian face this cut-edge belongs: + XPOS = X2_1 + SVAR12*STANI(IAXIS) + IF (X2NOC==0) THEN + JJ2 = FLOOR((XPOS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO JJ2=X2LO_CELL,X2HI_CELL + ! Check if XPOS is within this segment JJ2: + IF((XPOS-X2FACE(JJ2-1)) >= 0._EB .AND. (X2FACE(JJ2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF + XPOS = X3_1 + SVAR12*STANI(JAXIS) + IF(X3NOC==0) THEN + KK2 = FLOOR((XPOS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO KK2=X3LO_CELL,X3HI_CELL + ! Check if XPOS is within this segment KK2: + IF((XPOS-X3FACE(KK2-1)) >= 0._EB .AND. (X3FACE(KK2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF - ! Define points in plane x3p-x1: - ! vertex point: - X3PVERT = TX3P(IAXIS)*XP1(IAXIS) + TX3P(JAXIS)*XP1(JAXIS) - PVERT(IAXIS:JAXIS) = (/ X3PVERT, X1PLN /) - ! First triangle centroid: - X3P1 = TX3P(IAXIS)*XYZ1(X2AXIS) + TX3P(JAXIS)*XYZ1(X3AXIS) - P1CEN(IAXIS:JAXIS) = (/ X3P1, XYZ1(X1AXIS) /) - ! Second triangle centroid: - X3P2 = TX3P(IAXIS)*XYZ2(X2AXIS) + TX3P(JAXIS)*XYZ2(X3AXIS) - P2CEN(IAXIS:JAXIS) = (/ X3P2, XYZ2(X1AXIS) /) + ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. + ! If segment is inside the solid region mark cells surrounding face + ! to be treated in special manner (only if they happen to be type CUTCFE), + ! then drop segment. + XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) + CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) + IF (IS_SOLID) CYCLE - VCT(1:2) = 0 - PCT(IAXIS:JAXIS,1:2) = 0._EB + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 + INDIF=INDXI(XIAXIS) + INDJF=INDXI(XJAXIS) + INDKF=INDXI(XKAXIS) - ! Segment on triangle 1: - V1(IAXIS:JAXIS) = P1CEN(IAXIS:JAXIS) - PVERT(IAXIS:JAXIS) - CRSSNV = N1(IAXIS)*V1(JAXIS) - N1(JAXIS)*V1(IAXIS) - IF (CRSSNV > 0._EB) THEN - ! v1 stays as is, and is second segment: - VEC(IAXIS:JAXIS,2) = V1(IAXIS:JAXIS) - PCT(IAXIS:JAXIS,2) = P1CEN(IAXIS:JAXIS) - VCT(2) = 1 - ELSE - ! -v1 is the first segment: - VEC(IAXIS:JAXIS,1) = -V1(IAXIS:JAXIS) - PCT(IAXIS:JAXIS,1) = P1CEN(IAXIS:JAXIS) - VCT(1) = 1 - ENDIF + ! Now the face is, FCVAR (x1axis): + IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already + ! an entry in CUT_EDGE. + CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) + ELSE ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF + ENDIF - ! Segment on triangle 2: - V2(IAXIS:JAXIS) = P2CEN(IAXIS:JAXIS) - PVERT(IAXIS:JAXIS) - CRSSNV = N2(IAXIS)*V2(JAXIS) - N2(JAXIS)*V2(IAXIS) - IF (CRSSNV > 0._EB) THEN - ! v2 stays as is, and is second segment: - VEC(IAXIS:JAXIS,2) = V2(IAXIS:JAXIS) - PCT(IAXIS:JAXIS,2) = P2CEN(IAXIS:JAXIS) - VCT(2) = 1 - ELSE - ! -v2 is the first segment: - VEC(IAXIS:JAXIS,1) = -V2(IAXIS:JAXIS) - PCT(IAXIS:JAXIS,1) = P2CEN(IAXIS:JAXIS) - VCT(1) = 1 - ENDIF + ! Add vertices, non repeated vertex entries at this point. + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - IF ( (VCT(1) == 0) .OR. (VCT(2) == 0) ) THEN - print*, "Error GET_BODINT_PLANE: One component of vct == 0." - ENDIF + ! Define vertices for this segment: + ! xv1 yv1 zv1 + XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) + XYZV1(IAXIS) = XYZV1LC(XIAXIS) + XYZV1(JAXIS) = XYZV1LC(XJAXIS) + XYZV1(KAXIS) = XYZV1LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) + ! xv2 yv2 zv2 + XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) + XYZV2(IAXIS) = XYZV2LC(XIAXIS) + XYZV2(JAXIS) = XYZV2LC(XJAXIS) + XYZV2(KAXIS) = XYZV2LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) - ! Cross product of v1 and v2 gives magnitude along x2p axis: - CTST = VEC(IAXIS,1)*VEC(JAXIS,2) - VEC(JAXIS,1)*VEC(IAXIS,2) + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & + BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = & + -SUM(BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG))/2 + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE - ! Now tests: - ! Start with SOLID GASPHASE definition for segtype: - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_GASPHASE /) + ! Test for Repeated edge -> If so note FACERT + DO IDG=1,NEDGE + IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & + ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN + FACERT(JJ2,KK2) =.TRUE. + EXIT + ENDIF + ENDDO - ! Test for SOLID SOLID condition: - IF ( ((PCT(JAXIS,1)-X1PLN) > -GEOMEPS) .AND. & - ((PCT(JAXIS,2)-X1PLN) > -GEOMEPS) .AND. (CTST < GEOMEPS) ) THEN - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_SOLID /) - CYCLE - ELSEIF (((PCT(JAXIS,1)-X1PLN) < GEOMEPS) .AND. & - ((PCT(JAXIS,2)-X1PLN) < GEOMEPS) .AND. (CTST < GEOMEPS) ) THEN - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_SOLID /) - CYCLE - ENDIF + ENDDO - ! Test for GASPHASE GASPHASE condition: - IF ( ((PCT(JAXIS,1)-X1PLN) > GEOMEPS) .AND. & - ((PCT(JAXIS,2)-X1PLN) > GEOMEPS) .AND. (CTST > GEOMEPS) ) THEN - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_GASPHASE, CC_GASPHASE /) - CYCLE - ELSEIF (((PCT(JAXIS,1)-X1PLN) < -GEOMEPS) .AND. & - ((PCT(JAXIS,2)-X1PLN) < -GEOMEPS) .AND. (CTST > GEOMEPS) ) THEN - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_GASPHASE, CC_GASPHASE /) - CYCLE - ENDIF +ENDDO SEGS_LOOP - ENDIF +! Here TAG any CUT_EDGE vertices in VERT_LIST that lay in cartesian cell vertices: +DO CEI=INIT_CUT_EDGES,MESHES(NM)%N_CUTEDGE_MESH + INDIF = MESHES(NM)%CUT_EDGE(CEI)%IJK(IAXIS) + INDJF = MESHES(NM)%CUT_EDGE(CEI)%IJK(JAXIS) + INDKF = MESHES(NM)%CUT_EDGE(CEI)%IJK(KAXIS) + SELECT CASE(X1AXIS) ! INBOUNDCF edge, X1AXIS axis normal to face that edge is assigned to. + CASE(IAXIS) + IVERT_DOI : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB + ! INDJF-1:INDJF,INDKF-1:INDKF + DO KADD=-1,0 + DO JADD=-1,0 + IF(ABS(YFACE(INDJF+JADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,IVERT))>GEOMEPS) CYCLE + IF(ABS(ZFACE(INDKF+KADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,IVERT))>GEOMEPS) CYCLE + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF, INDJF+JADD, INDKF+KADD /) + CYCLE IVERT_DOI + ENDDO + ENDDO + ENDDO IVERT_DOI + CASE(JAXIS) + IVERT_DOJ : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB + ! INDIF-1:INDIF,INDKF-1:INDKF + DO KADD=-1,0 + DO IADD=-1,0 + IF(ABS(XFACE(INDIF+IADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,IVERT))>GEOMEPS) CYCLE + IF(ABS(ZFACE(INDKF+KADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,IVERT))>GEOMEPS) CYCLE + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF+IADD, INDJF, INDKF+KADD /) + CYCLE IVERT_DOJ + ENDDO + ENDDO + ENDDO IVERT_DOJ + CASE(KAXIS) + IVERT_DOK : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB + ! INDJF-1:INDJF,INDKF-1:INDKF + DO IADD=-1,0 + DO JADD=-1,0 + IF(ABS(YFACE(INDJF+JADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,IVERT))>GEOMEPS) CYCLE + IF(ABS(XFACE(INDIF+IADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,IVERT))>GEOMEPS) CYCLE + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF+IADD, INDJF+JADD, INDKF /) + CYCLE IVERT_DOK + ENDDO + ENDDO + ENDDO IVERT_DOK + END SELECT ENDDO +! Note cells in CELLRT due to FCERT intersections in GET_BODINT_PLANE: +DO KK2=X3LO_CELL,X3HI_CELL + DO JJ2=X2LO_CELL,X2HI_CELL + IF(.NOT.FACERT(JJ2,KK2)) CYCLE + ! Low cell indexes: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 + INDIF=INDXI(XIAXIS); INDJF=INDXI(XJAXIS); INDKF=INDXI(XKAXIS) + CELLRT(INDIF,INDJF,INDKF) =.TRUE. -! For the time being, as BODINT_PLANE is used to create Cartesian face cut-faces -! We eliminate from the list the SEGTYPE=[SOLID SOLID] segments: -ALLOCATE(SEGAUX(NOD1:NOD2,BODINT_PLANE%NSEGS)) -ALLOCATE(INDSEGAUX(CC_MAX_WSTRIANG_SEG+2,BODINT_PLANE%NSEGS)) -ALLOCATE(SEGTYPEAUX(NOD1:NOD2,BODINT_PLANE%NSEGS)) + ! High cell indexes: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS)+1, JJ2, KK2 /) ! Local x1,x2,x3 + INDIF=INDXI(XIAXIS); INDJF=INDXI(XJAXIS); INDKF=INDXI(XKAXIS) + CELLRT(INDIF,INDJF,INDKF) =.TRUE. + ENDDO +ENDDO -ISEG_NEW = 0 -IF(.NOT.TRI_ONPLANE_ONLY) THEN - DO ISEG=1,BODINT_PLANE%NSEGS - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) - IF( NORM2(XYZ2((/X2AXIS,X3AXIS/))-XYZ1((/X2AXIS,X3AXIS/))) < 0.1_EB*GEOMEPS) CYCLE - IF ( (BODINT_PLANE%SEGTYPE(NOD1,ISEG) == CC_SOLID) .AND. & - (BODINT_PLANE%SEGTYPE(NOD2,ISEG) == CC_SOLID) ) CYCLE +T_CC_USED(GET_CARTFACE_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTEDGES_TIME_INDEX) + CURRENT_TIME() - TNOW - ISEG_NEW = ISEG_NEW + 1 - SEGAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+2,ISEG_NEW) = & - BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) - SEGTYPEAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) - ENDDO -ELSE - DO ISEG=1,BODINT_PLANE%NSEGS - IF ( (BODINT_PLANE%SEGTYPE(NOD1,ISEG) == CC_SOLID) .AND. & - (BODINT_PLANE%SEGTYPE(NOD2,ISEG) == CC_SOLID) ) THEN +RETURN +END SUBROUTINE GET_CARTFACE_CUTEDGES - ISEG_NEW = ISEG_NEW + 1 - SEGAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+2,ISEG_NEW) = & - BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) - SEGTYPEAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) - ENDIF - ENDDO -ENDIF +! -------------------------- GET_IS_SOLID_PT ------------------------------------ -BODINT_PLANE%NSEGS = ISEG_NEW -BODINT_PLANE%SEGS(NOD1:NOD2,1:ISEG_NEW) = SEGAUX(NOD1:NOD2,1:ISEG_NEW) -BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:ISEG_NEW) = INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+2,1:ISEG_NEW) -BODINT_PLANE%SEGTYPE(NOD1:NOD2,1:ISEG_NEW) = SEGTYPEAUX(NOD1:NOD2,1:ISEG_NEW) +SUBROUTINE GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) -DEALLOCATE(SEGAUX,INDSEGAUX,SEGTYPEAUX) +TYPE(BODINT_PLANE_TYPE), INTENT(IN) :: BODINT_PLANE2 +INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS +REAL(EB), INTENT(IN) :: XY(IAXIS:JAXIS),NVEC(IAXIS:JAXIS),X1PLN +LOGICAL, INTENT(OUT):: IS_SOLID -IF(TRI_ONPLANE_ONLY .OR. (BODINT_PLANE%NSEGS == 0)) THEN - T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) = T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) + CURRENT_TIME() - TNOW - RETURN -ENDIF +! Local Variables +REAL(EB):: XYZ1(IAXIS:KAXIS), XYZ2(IAXIS:KAXIS), SCEN, XRAY +REAL(EB):: X2_1, X2_2, X3_1, X3_2, X2MIN, X2MAX, X3MIN, X3MAX, DOT1, DOT2, DELBIN, MODTI, SVARI, AVAL +REAL(EB):: STANI(IAXIS:JAXIS), NOMLI(IAXIS:JAXIS), DV12(IAXIS:JAXIS) +INTEGER :: SEG(NOD1:NOD2), ISSEG(LOW_IND:HIGH_IND), ISEG, IISEG, XAXIS, IBIN, ICR, SCRSI, ILO_BIN, IHI_BIN,& + ICRSI(LOW_IND:HIGH_IND+1), GAM(LOW_IND:HIGH_IND) +LOGICAL :: OUTRAY, IS_GASPHASE -! Segments Crossings fields: -! Initialize nbcross with segment nodes locations: -IF ( ALLOCATED(BODINT_PLANE%NBCROSS) ) DEALLOCATE(BODINT_PLANE%NBCROSS) -IF ( ALLOCATED(BODINT_PLANE%SVAR) ) DEALLOCATE(BODINT_PLANE%SVAR) -ALLOCATE(BODINT_PLANE%NBCROSS(1:BODINT_PLANE%NSEGS),BODINT_PLANE%SVAR(1:CC_DELTA_NBCROSS,1:BODINT_PLANE%NSEGS)) -BODINT_PLANE%NBCROSS(1:BODINT_PLANE%NSEGS) = 0 -BODINT_PLANE%SVAR(1:CC_DELTA_NBCROSS,1:BODINT_PLANE%NSEGS) = -1._EB +! Initialize crossings arrays: +CC_N_CRS = 0 +CC_SVAR_CRS(:) = 1._EB/GEOMEPS +CC_IS_CRS(:) = CC_UNDEFINED +CC_IS_CRS2(:,:)= CC_UNDEFINED +CC_SEG_TAN(:,:)= 0._EB +CC_SEG_CRS(:) = 0 +CC_BDNUM_CRS(:)= 0 +CC_BDNUM_CRS_AUX(:)= 0 + +! Define crossings: +IF(ABS(NVEC(IAXIS)) > ABS(NVEC(JAXIS))) THEN ! Do X2 ray + SCEN = XY(IAXIS); XRAY=XY(JAXIS); XAXIS=X3AXIS -BODINT_PLANE%BOX(LOW_IND:HIGH_IND,IAXIS:KAXIS) = 0._EB -BODINT_PLANE%BOX(LOW_IND, X2AXIS) = MINVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))-10._EB*GEOMEPS -BODINT_PLANE%BOX(HIGH_IND,X2AXIS) = MAXVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))+10._EB*GEOMEPS -BODINT_PLANE%BOX(LOW_IND, X3AXIS) = MINVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))-10._EB*GEOMEPS -BODINT_PLANE%BOX(HIGH_IND,X3AXIS) = MAXVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))+10._EB*GEOMEPS -IF (RAYTRACE_X2_ONLY) THEN - AXIS = X3AXIS - BODINT_PLANE%TBAXIS(AXIS)%DELBIN = BODINT_PLANE%BOX(HIGH_IND,AXIS)-BODINT_PLANE%BOX(LOW_IND,AXIS) - IBIN = 1 - BODINT_PLANE%TBAXIS(AXIS)%N_BINS = IBIN - ! If needed, deallocate the TRIBIN container for this AXIS: - IF(ALLOCATED(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN)) DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN) - ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)) - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_LOW = BODINT_PLANE%BOX( LOW_IND,AXIS) - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_HIGH = BODINT_PLANE%BOX(HIGH_IND,AXIS) - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL = BODINT_PLANE%NSEGS - ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(BODINT_PLANE%NSEGS)) - DO ISEG=1,BODINT_PLANE%NSEGS; BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(ISEG) = ISEG; ENDDO - RETURN -ENDIF + DELBIN = BODINT_PLANE2%TBAXIS(XAXIS)%DELBIN + AVAL = (XRAY-GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN + ILO_BIN= MAX(1, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) + AVAL = (XRAY+GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN + IHI_BIN= MIN(BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) + DO IBIN=ILO_BIN,IHI_BIN + IF (XRAY < BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE + IF (XRAY > BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE + DO IISEG=1,BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%NTL + ISEG = BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) + SEG(NOD1:NOD2) = BODINT_PLANE2%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD2)) + ! x2,x3 coordinates of segment: + X2_1 = XYZ1(X2AXIS) + X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. + X2_2 = XYZ2(X2AXIS) + X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. -! Initialize nbcross with segment nodes locations: -! Add segment ends as crossings: -ALLOCATE(SEGS_NODE(BODINT_PLANE%NNODS)); SEGS_NODE = 0 -MEAN_SLEN=0._EB -DO ISEG=1,BODINT_PLANE%NSEGS + ! First Test if the whole segment is on one side of the Ray: + ! Test segment crosses the ray, or is in geomepsilon proximity + ! of it: + X3MIN = MIN(X3_1,X3_2); X3MAX = MAX(X3_1,X3_2); + OUTRAY=(((XRAY-X3MAX) > GEOMEPS) .OR. ((X3MIN-XRAY) > GEOMEPS)) - ! End nodes to cross: - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + IF (OUTRAY) CYCLE + DOT1 = X3_1-XRAY; DOT2 = X3_2-XRAY + IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB + IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB - IF(ANY(BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG)/=CC_GASPHASE)) THEN - SEGS_NODE(SEG(NOD1)) = SEGS_NODE(SEG(NOD1)) + 1 - SEGS_NODE(SEG(NOD2)) = SEGS_NODE(SEG(NOD2)) + 1 - ENDIF + ! Segment tangent unit vector. + DV12(IAXIS:JAXIS) = XYZ2( (/ X2AXIS, X3AXIS /) ) - XYZ1( (/ X2AXIS, X3AXIS /) ) + MODTI = SQRT( DV12(IAXIS)**2._EB + DV12(JAXIS)**2._EB ) + STANI(IAXIS:JAXIS) = DV12(IAXIS:JAXIS) * MODTI**(-1._EB) + NOMLI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) + ISSEG(LOW_IND:HIGH_IND) = BODINT_PLANE2%SEGTYPE(LOW_IND:HIGH_IND,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) + ! For x2, in local x2-x3 coords e2=(1,0): + GAM(LOW_IND) = (1 + NINT(SIGN(1._EB,NOMLI(IAXIS)))) / 2 ! (1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; + GAM(HIGH_IND)= (1 - NINT(SIGN(1._EB,NOMLI(IAXIS)))) / 2 ! (1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; - ! Is segment aligned with x3 direction? - BODINT_PLANE%X3ALIGNED(ISEG) = (ABS(XYZ2(X2AXIS)-XYZ1(X2AXIS)) < GEOMEPS) - ! Is segment aligned with x2 rays?: - BODINT_PLANE%X2ALIGNED(ISEG) = (ABS(XYZ2(X3AXIS)-XYZ1(X3AXIS)) < GEOMEPS) + ! Test if whole segment is in ray, if so add segment nodes as crossings: + IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN + ! Count both points as crossings: + ! Point 1: + SVARI = MIN(X2_1,X2_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + DO ICR=2,BODINT_PLANE2%NBCROSS(ISEG)-1 + SVARI = X2_1 + BODINT_PLANE2%SVAR(ICR,ISEG)*STANI(IAXIS) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ENDDO + ! Point 2: + SVARI = max(X2_1,X2_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + ! Now nodes individually: + IF ( ABS(DOT1) == 0._EB ) THEN + ! Point 1: + SVARI = X2_1 + ! LOW and HIGH media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + IF ( ABS(DOT2) == 0._EB ) THEN + ! Point 2: + SVARI = X2_2 + ! LOW and HIGH_IND media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + ! Finally regular case: + ! Points 1 on one side of ray, point 2 on the other: + IF ( DOT1*DOT2 < 0._EB ) THEN + ! Intersection Point along segment: + ! DS = (XRAY-X3_1) / (X3_2-X3_1) + ! SVARI = X2_1 + DS*(X2_2-X2_1) + SVARI = X2_1 + (XRAY-X3_1) * (X2_2-X2_1) / (X3_2-X3_1) + ! LOW and HIGH media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + WRITE(LU_ERR,*) 'Error GET_IS_SOLID_PT NVEC(IAXIS): Missed segment=',ISEG + ENDDO + ENDDO - ! x2_x3 of segment point 1: - X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) - ! x2_x3 of segment point 2: - X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) +ELSE ! Do X3 ray + SCEN=XY(JAXIS); XRAY=XY(IAXIS); XAXIS=X2AXIS; - ! Segment length: - SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) - MEAN_SLEN = MEAN_SLEN + SLEN + DELBIN = BODINT_PLANE2%TBAXIS(XAXIS)%DELBIN + AVAL = (XRAY-GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN + ILO_BIN= MAX(1, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) + AVAL = (XRAY+GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN + IHI_BIN= MIN(BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) + DO IBIN=ILO_BIN,IHI_BIN + IF (XRAY < BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE + IF (XRAY > BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE + DO IISEG=1,BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%NTL + ISEG = BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) + SEG(NOD1:NOD2) = BODINT_PLANE2%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD2)) - ! First node: - SBOD = 0._EB - ! Add crossing to BODINT_PLANE: - NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + 1 - BODINT_PLANE%NBCROSS(ISEG) = NBCROSS - BODINT_PLANE%SVAR(NBCROSS,ISEG) = SBOD + ! x2,x3 coordinates of segment: + X2_1 = XYZ1(X2AXIS) + X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. + X2_2 = XYZ2(X2AXIS) + X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. - ! Second node: - SBOD = SLEN - ! Add crossing to BODINT_PLANE: - NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + 1 - BODINT_PLANE%NBCROSS(ISEG) = NBCROSS - BODINT_PLANE%SVAR(NBCROSS,ISEG) = SBOD + ! First Test if the whole segment is on one side of the Ray: + ! Test segment crosses the ray, or is in geomepsilon proximity + ! of it: + X2MIN = MIN(X2_1,X2_2) + X2MAX = MAX(X2_1,X2_2) + OUTRAY=(((XRAY-X2MAX) > GEOMEPS) .OR. ((X2MIN-XRAY) > GEOMEPS)) -ENDDO + IF (OUTRAY) CYCLE + DOT1 = X2_1-XRAY; DOT2 = X2_2-XRAY + IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB + IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB -! Spread Segments in BINs in the x2-x3 directions: -MEAN_SLEN = MEAN_SLEN / REAL(BODINT_PLANE%NSEGS,EB) -VAXIS(IAXIS:JAXIS) = (/ X2AXIS, X3AXIS /) -DO I = 1,2 - AXIS = VAXIS(I) - LXI = BODINT_PLANE%BOX(HIGH_IND,AXIS)-BODINT_PLANE%BOX(LOW_IND,AXIS) - IF (BODINT_PLANE%NSEGS < 100) THEN - BODINT_PLANE%TBAXIS(AXIS)%N_BINS = MAX(1 ,CEILING(LXI/(MEAN_SLEN))) - ELSE - BODINT_PLANE%TBAXIS(AXIS)%N_BINS = MAX(10,CEILING(LXI/(MEAN_SLEN))) - ENDIF + ! Segment tangent unit vector. + DV12(IAXIS:JAXIS) = XYZ2( (/ X2AXIS, X3AXIS /) ) - XYZ1( (/ X2AXIS, X3AXIS /) ) + MODTI = SQRT( DV12(IAXIS)**2._EB + DV12(JAXIS)**2._EB ) + STANI(IAXIS:JAXIS) = DV12(IAXIS:JAXIS) * MODTI**(-1._EB) + NOMLI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) + ISSEG(LOW_IND:HIGH_IND) = BODINT_PLANE2%SEGTYPE(LOW_IND:HIGH_IND,ISEG) - ! Allocate TRIBIN field: - IF(ALLOCATED(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN)) DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN) - ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(1:BODINT_PLANE%TBAXIS(AXIS)%N_BINS)) + ! For x3, in local x2-x3 coords e2=(0,1): + GAM(LOW_IND) = (1 + NINT(SIGN(1._EB,NOMLI(JAXIS)))) / 2 ! (1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; + GAM(HIGH_IND)= (1 - NINT(SIGN(1._EB,NOMLI(JAXIS)))) / 2 ! (1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; - ! Set BIN boundaries and make initial allocation of TRI_LIST (here for SEGS) for each bin: - DELBIN = LXI / REAL(BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB) - BODINT_PLANE%TBAXIS(AXIS)%DELBIN = DELBIN - DO IBIN=1,BODINT_PLANE%TBAXIS(AXIS)%N_BINS - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_LOW = BODINT_PLANE%BOX( LOW_IND,AXIS) + REAL(IBIN-1,EB)*DELBIN - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_HIGH = BODINT_PLANE%BOX( LOW_IND,AXIS) + REAL(IBIN ,EB)*DELBIN - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL = 0 - IF(ALLOCATED(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST)) & - DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST) - ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(DELTA_SEGBIN)) - ENDDO - ! Finally, populate TRI_LIST (here for SEGS) for AXIS bins: - DO ISEG=1,BODINT_PLANE%NSEGS - XIV(NOD1:NOD2) = BODINT_PLANE%XYZ(AXIS,BODINT_PLANE%SEGS(NOD1:NOD2,ISEG)) - XIV_LO = MINVAL(XIV(NOD1:NOD2)); XIV_HI = MAXVAL(XIV(NOD1:NOD2)) - AVAL = (XIV_LO-GEOMEPS-BODINT_PLANE%BOX(LOW_IND,AXIS))/DELBIN - ILO_BIN= MAX(1, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB),ABS(AVAL)) )) - AVAL = (XIV_HI+GEOMEPS-BODINT_PLANE%BOX(LOW_IND,AXIS))/DELBIN - IHI_BIN= MIN(BODINT_PLANE%TBAXIS(AXIS)%N_BINS, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB),ABS(AVAL)) )) - DO IBIN=ILO_BIN,IHI_BIN - NTL = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL + 1 - SZE = SIZE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST,DIM=1) - IF (NTL > SZE) THEN - ! Reallocate: - ALLOCATE(TRI_LIST(1:SZE)); TRI_LIST(1:SZE)=BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) - DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST) - ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE+DELTA_SEGBIN)) - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) = TRI_LIST(1:SZE) - DEALLOCATE(TRI_LIST) + ! Test if whole segment is in ray, if so add segment nodes as crossings: + IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN + ! Count both points as crossings: + ! Point 1: + SVARI = MIN(X3_1,X3_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + DO ICR=2,BODINT_PLANE2%NBCROSS(ISEG)-1 + SVARI = X3_1 + BODINT_PLANE2%SVAR(ICR,ISEG)*STANI(JAXIS) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ENDDO + ! Point 2: + SVARI = MAX(X3_1,X3_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE ENDIF - ! Add Triangle index to BINs TRI_LIST - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL = NTL - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(NTL) = ISEG + ! Now nodes individually: + IF ( ABS(DOT1) == 0._EB ) THEN + ! Point 1: + SVARI = X3_1 + ! LOW and HIGH media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + IF ( ABS(DOT2) == 0._EB ) THEN + ! Point 2: + SVARI = X3_2 + ! LOW and HIGH_IND media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + ! Finally regular case: + ! Points 1 on one side of ray, point 2 on the other: + IF ( DOT1*DOT2 < 0._EB ) THEN + ! Intersection Point along segment: + ! DS = (XRAY-X2_1) / (X2_2-X2_1) + ! SVARI = X3_1 + DS*(X3_2-X3_1) + SVARI = X3_1 + (XRAY-X2_1) * (X3_2-X3_1) / (X2_2-X2_1) + ! LOW and HIGH media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + WRITE(LU_ERR,*) 'Error GET_IS_SOLID_PT NVEC(JAXIS): Missed segment=',ISEG ENDDO - ENDDO -ENDDO + ENDDO -! Add Segments intersections: -DO IBIN=1,BODINT_PLANE%TBAXIS(AXIS)%N_BINS - NTL = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL - ! Now double loop, cost O(1/2*NTL^2): - DO BISEG=1,NTL - ISEGV(EDG1) = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(BISEG) - SEGV(NOD1:NOD2,EDG1) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEGV(EDG1)) - P1(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1,EDG1)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1,EDG1))/) - D1(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD2,EDG1)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD2,EDG1))/) - D1 = D1 - P1 - S1_X2_MIN=MINVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG1))) - S1_X2_MAX=MAXVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG1))) - S1_X3_MIN=MINVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG1))) - S1_X3_MAX=MAXVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG1))) - DO BIISEG=BISEG+1,NTL - ! Test for segment-segment intersection: - ISEGV(EDG2) = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(BIISEG) - SEGV(NOD1:NOD2,EDG2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEGV(EDG2)) - P2(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1,EDG2)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1,EDG2))/) - D2(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD2,EDG2)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD2,EDG2))/) - D2 = D2 - P2 +ENDIF - ! Tests for quick discard: - IF( MAXVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG2)))+GEOMEPS < S1_X2_MIN) CYCLE - IF( MINVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG2)))-GEOMEPS > S1_X2_MAX) CYCLE - IF( MAXVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG2)))+GEOMEPS < S1_X3_MIN) CYCLE - IF( MINVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG2)))-GEOMEPS > S1_X3_MAX) CYCLE +! Do we have any intersections? +IF ( CC_N_CRS == 0 ) THEN + IS_SOLID =.FALSE. + RETURN +ENDIF +CALL COLLAPSE_CROSSINGS(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XRAY,X1PLN,2) +CALL GET_IS_GASPHASE(SCEN,IS_GASPHASE) - ! Test for segment-segment intersection: - CALL GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) +IS_SOLID = .NOT.IS_GASPHASE - ! Now discard repeated intersections: - ! If crossing is already defined in SEG don't add: - DO ICROSS=1,INT_FLG - DO ISX = EDG1,EDG2 - SBOD = SVARV(ICROSS,ISX) - ! Discard intersections already present in segment, including ends: - INLIST = .FALSE. - DO ISVAR=1,BODINT_PLANE%NBCROSS(ISEGV(ISX)) - IF ( ABS(SBOD-BODINT_PLANE%SVAR(ISVAR,ISEGV(ISX))) < GEOMEPS ) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (INLIST) CYCLE +RETURN +END SUBROUTINE GET_IS_SOLID_PT - ! Add crossing to BODINT_PLANE, insertion sort: - NBCROSS = BODINT_PLANE%NBCROSS(ISEGV(ISX)) + 1 - ! Test-reallocate BODINT_PLANE%SVAR - NBCROSS_SVAR = SIZE(BODINT_PLANE%SVAR,DIM=1) - IF (NBCROSS > NBCROSS_SVAR) THEN - ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB - SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) - CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) - ENDIF - BODINT_PLANE%SVAR(NBCROSS,ISEGV(ISX)) = 1._EB/GEOMEPS - DO IBCR=1,NBCROSS - IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEGV(ISX)) ) EXIT - ENDDO - IBCR = MIN(IBCR,NBCROSS) - ! Here copy from the back (updated nbcross) to the ibcr location: - DO IDUM = NBCROSS,IBCR+1,-1 - BODINT_PLANE%SVAR(IDUM,ISEGV(ISX)) = BODINT_PLANE%SVAR(IDUM-1,ISEGV(ISX)) - ENDDO - BODINT_PLANE%SVAR(IBCR,ISEGV(ISX)) = SBOD - BODINT_PLANE%NBCROSS(ISEGV(ISX)) = NBCROSS +! ------------------------- INSERT_FACE_VERT ------------------------------------ - ! Here we have an intersection inside a segment, note it in FACERT: - IF ( ISX==EDG1 ) THEN - ! X2AXIS, X3AXIS location of intersection: - XY(IAXIS:JAXIS) = P1(IAXIS:JAXIS) + SBOD*D1(IAXIS:JAXIS)/NORM2(D1(IAXIS:JAXIS)) - ELSE - ! X2AXIS, X3AXIS location of intersection: - XY(IAXIS:JAXIS) = P2(IAXIS:JAXIS) + SBOD*D2(IAXIS:JAXIS)/NORM2(D2(IAXIS:JAXIS)) - ENDIF - XPOS = XY(IAXIS) - IF ( X2NOC==0 ) THEN - JJ2_LO = FLOOR((XPOS-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - JJ2_HI = FLOOR((XPOS+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - IF (ALL((/JJ2_LO,JJ2_HI/) < X2LO_CELL) .OR. ALL((/JJ2_LO,JJ2_HI/) > X2HI_CELL)) CYCLE - JJ2_LO = MAX(JJ2_LO,X2LO_CELL); JJ2_HI = MIN(JJ2_HI,X2HI_CELL) - ELSE - FOUND_SEG = .FALSE.; JJ2_LO = -100; JJ2_HI = -100 - DO JJ2=X2LO_CELL,X2HI_CELL - ! Check if XPOS is within this segment JJ2: - IF ( ((XPOS-X2FACE(JJ2-1))>-GEOMEPS) .AND. ((X2FACE(JJ2)-XPOS)>-GEOMEPS) ) THEN - IF (JJ2_LO > -100) THEN - JJ2_HI = JJ2 - EXIT - ELSE - JJ2_LO = JJ2 - JJ2_HI = JJ2 - ENDIF - FOUND_SEG = .TRUE. - ENDIF - ENDDO - IF (.NOT.FOUND_SEG) CYCLE - ENDIF - XPOS = XY(JAXIS) - IF ( X3NOC==0 ) THEN - KK2_LO = FLOOR((XPOS-GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - KK2_HI = FLOOR((XPOS+GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - IF (ALL((/KK2_LO,KK2_HI/) < X3LO_CELL) .OR. ALL((/KK2_LO,KK2_HI/) > X3HI_CELL)) CYCLE - KK2_LO = MAX(KK2_LO,X3LO_CELL); KK2_HI = MIN(KK2_HI,X3HI_CELL) - ELSE - FOUND_SEG = .FALSE.; KK2_LO = -100; KK2_HI = -100 - DO KK2=X3LO_CELL,X3HI_CELL - ! Check if XPOS is within this segment KK2: - IF ( ((XPOS-X3FACE(KK2-1))>-GEOMEPS) .AND. ((X3FACE(KK2)-XPOS)>-GEOMEPS) ) THEN - IF (KK2_LO > -100) THEN - KK2_HI = KK2 - EXIT - ELSE - KK2_LO = KK2 - KK2_HI = KK2 - ENDIF - FOUND_SEG = .TRUE. - ENDIF - ENDDO - IF (.NOT.FOUND_SEG) CYCLE - ENDIF +SUBROUTINE INSERT_FACE_VERT(XYZV,NM,CEI,NVERT,INOD) - ! Here JJ2 and KK2 have the face containing the intersection: - DO KK2=KK2_LO,KK2_HI - DO JJ2=JJ2_LO,JJ2_HI - FACERT(JJ2,KK2) = .TRUE. - ENDDO - ENDDO +REAL(EB), INTENT(IN) :: XYZV(MAX_DIM) +INTEGER, INTENT(IN) :: NM,CEI +INTEGER, INTENT(INOUT):: NVERT +INTEGER, INTENT(OUT) :: INOD + +! Local Variables: +! INTEGER :: JNOD, JNOD2, PIVOT(LOW_IND:HIGH_IND) +! REAL(EB) :: DV(MAX_DIM) +! IF (NVERT < LINSEARCH_LIMIT) THEN +! ! Linear Search: +! DO JNOD=1,NVERT +! DV(IAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(IAXIS) +! IF( DV(IAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF( ABS(DV(IAXIS)) <= GEOMEPS) THEN +! DV(JAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(JAXIS) +! IF ( DV(JAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF ( ABS(DV(JAXIS)) <= GEOMEPS ) THEN +! DV(KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(KAXIS) +! IF ( DV(KAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF ( ABS(DV(KAXIS)) <= GEOMEPS ) THEN +! INOD = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) +! RETURN ! XYZV is in XYZVERT(IAXIS:KAXIS,NOD_PERM(JNOD)) +! ENDIF +! ENDIF +! ENDIF +! ENDDO +! ELSE +! ! Binary Search: +! PIVOT(LOW_IND) = 0 +! PIVOT(HIGH_IND)= NVERT + 1 +! DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) +! JNOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 +! DV(IAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(IAXIS) +! IF( DV(IAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(IAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(IAXIS)) < GEOMEPS +! DV(JAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(JAXIS) +! IF ( DV(JAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(JAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(JAXIS)) < GEOMEPS +! DV(KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(KAXIS) +! IF ( DV(KAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(KAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(KAXIS)) < GEOMEPS +! INOD = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) +! RETURN +! ENDIF +! ENDIF +! ENDIF +! ENDDO +! JNOD=PIVOT(HIGH_IND) +! ENDIF +! ! Insert add NOD_PERM permutation array, O(NP) operation: +! INOD = NVERT + 1 +! NVERT = INOD +! CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT) +! DO JNOD2=NVERT,JNOD+1,-1 +! MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD2) = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD2-1) +! ENDDO +! MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) = INOD +! MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) - ENDDO - ENDDO - ENDDO - ENDDO +DO INOD=1,NVERT + IF( ABS(XYZV(IAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,INOD)) > GEOMEPS ) CYCLE + IF( ABS(XYZV(JAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,INOD)) > GEOMEPS ) CYCLE + IF( ABS(XYZV(KAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,INOD)) > GEOMEPS ) CYCLE + RETURN ENDDO +NVERT = NVERT + 1 +INOD = NVERT +CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT) +MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) +RETURN +END SUBROUTINE INSERT_FACE_VERT -! Loop nodes and test in SEG_NODES: if more than 2 segments end in the -! node, note it in FACERT. -MAX_SEG_NODE = MAXVAL(SEGS_NODE(1:BODINT_PLANE%NNODS)) -ALLOCATE(ISEG_NODE(MAX_SEG_NODE+1,BODINT_PLANE%NNODS)); ISEG_NODE = 0 -ALLOCATE(ANGS_NODE(MAX_SEG_NODE ,BODINT_PLANE%NNODS)); ANGS_NODE = 0._EB -ANGNODE_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS - ! End nodes to cross: - IF( ANY(BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG)/=CC_GASPHASE) ) THEN - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - DX2 = BODINT_PLANE%XYZ(X2AXIS,SEG(NOD2))-BODINT_PLANE%XYZ(X2AXIS,SEG(NOD1)) - DX3 = BODINT_PLANE%XYZ(X3AXIS,SEG(NOD2))-BODINT_PLANE%XYZ(X3AXIS,SEG(NOD1)) - NOD_LOOP : DO INOD=NOD1,NOD2 - ! Compute angle, for NOD2 the seg andgle is -ANG. - ANG=REAL(NOD2-INOD,EB)*ATAN2(DX3,DX2) + REAL(INOD-NOD1,EB)*ATAN2(-DX3,-DX2) - IF(ANG < 0._EB) ANG = ANG + TWOPI ! Make angle from 0 to 2*pi. - ! Insert-add segment into ISEG_NODE depending on angle value: - NSN = ISEG_NODE(1,SEG(INOD)) - ISEG_NODE(1 ,SEG(INOD)) = NSN+1 - FOUND_SEG=.FALSE.; ISEG2=1 - IF (NSN>0) THEN - DO ISEG2=1,NSN - IF (ANGS_NODE(ISEG2,SEG(INOD)) > ANG) THEN - FOUND_SEG=.TRUE.; EXIT - ENDIF - ENDDO - ENDIF - IF (FOUND_SEG) THEN - DO ISEG3=NSN+1,ISEG2+1,-1 - ISEG_NODE(ISEG3+1,SEG(INOD)) = ISEG_NODE(ISEG3 ,SEG(INOD)) - ANGS_NODE(ISEG3 ,SEG(INOD)) = ANGS_NODE(ISEG3-1,SEG(INOD)) - ENDDO - ENDIF - ISEG_NODE(ISEG2+1,SEG(INOD)) = ISEG - ANGS_NODE(ISEG2 ,SEG(INOD)) = ANG - ENDDO NOD_LOOP - ENDIF -ENDDO ANGNODE_LOOP - -ALLOCATE(CIRC_MED(MAX_SEG_NODE+1)) -INOD_LOOP : DO INOD = 1,BODINT_PLANE%NNODS - IF (SEGS_NODE(INOD) < 3) CYCLE INOD_LOOP +! ------------------------- INSERT_FACE_VERT_LOC(XYZ,NVERT,INOD1,XYZVERT) - ! Test case of even number of segments: - IF (MOD(SEGS_NODE(INOD),2)==0) THEN ! Case of even number of segments. - ! Test if circling around the node we have media discontinuity. - NSN=ISEG_NODE(1,INOD); COUNT=0 - DO ISEG2=2,NSN+1 - ISEG =ISEG_NODE(ISEG2,INOD) - COUNT=COUNT+1 - SEG = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - IF (INOD==SEG(NOD2)) THEN - CIRC_MED(COUNT) = BODINT_PLANE%SEGTYPE(NOD2,ISEG) - ELSE - CIRC_MED(COUNT) = BODINT_PLANE%SEGTYPE(NOD1,ISEG) - ENDIF - ENDDO - CIRC_MED(COUNT+1)=CIRC_MED(1) - CRS_FLG=.FALSE. - DO COUNT=1,NSN - IF(CIRC_MED(COUNT)==CIRC_MED(COUNT+1)) THEN - CRS_FLG=.TRUE.; EXIT - ENDIF - ENDDO - IF (.NOT.CRS_FLG) CYCLE INOD_LOOP - ENDIF +SUBROUTINE INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,NVERT,INOD,XYZVERT) - ! X2AXIS, X3AXIS location of intersection: - XY(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,INOD), BODINT_PLANE%XYZ(X3AXIS,INOD)/) - XPOS = XY(IAXIS) - IF ( X2NOC==0 ) THEN - JJ2_LO = FLOOR((XPOS-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - JJ2_HI = FLOOR((XPOS+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - IF (ALL((/JJ2_LO,JJ2_HI/) < X2LO_CELL) .OR. ALL((/JJ2_LO,JJ2_HI/) > X2HI_CELL)) CYCLE INOD_LOOP - JJ2_LO = MAX(JJ2_LO,X2LO_CELL); JJ2_HI = MIN(JJ2_HI,X2HI_CELL) - ELSE - FOUND_SEG = .FALSE.; JJ2_LO = -100; JJ2_HI = -100 - DO JJ2=X2LO_CELL,X2HI_CELL - ! Check if XPOS is within this segment JJ2: - IF ( ((XPOS-X2FACE(JJ2-1))>-GEOMEPS) .AND. ((X2FACE(JJ2)-XPOS)>-GEOMEPS) ) THEN - IF (JJ2_LO > -100) THEN - JJ2_HI = JJ2 - EXIT - ELSE - JJ2_LO = JJ2 - JJ2_HI = JJ2 - ENDIF - FOUND_SEG = .TRUE. - ENDIF - ENDDO - IF (.NOT.FOUND_SEG) CYCLE INOD_LOOP - ENDIF - XPOS = XY(JAXIS) - IF ( X3NOC==0 ) THEN - KK2_LO = FLOOR((XPOS-GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - KK2_HI = FLOOR((XPOS+GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - IF (ALL((/KK2_LO,KK2_HI/) < X3LO_CELL) .OR. ALL((/KK2_LO,KK2_HI/) > X3HI_CELL)) CYCLE INOD_LOOP - KK2_LO = MAX(KK2_LO,X3LO_CELL); KK2_HI = MIN(KK2_HI,X3HI_CELL) - ELSE - FOUND_SEG = .FALSE.; KK2_LO = -100; KK2_HI = -100 - DO KK2=X3LO_CELL,X3HI_CELL - ! Check if XPOS is within this segment KK2: - IF ( ((XPOS-X3FACE(KK2-1))>-GEOMEPS) .AND. ((X3FACE(KK2)-XPOS)>-GEOMEPS) ) THEN - IF (KK2_LO > -100) THEN - KK2_HI = KK2 - EXIT - ELSE - KK2_LO = KK2 - KK2_HI = KK2 - ENDIF - FOUND_SEG = .TRUE. - ENDIF - ENDDO - IF (.NOT.FOUND_SEG) CYCLE INOD_LOOP - ENDIF +INTEGER, INTENT(IN) :: MAXVERTS +REAL(EB), INTENT(IN) :: XYZV(MAX_DIM) +REAL(EB), INTENT(INOUT), DIMENSION(IAXIS:KAXIS,1:MAXVERTS) :: XYZVERT ! Locations of vertices. +INTEGER, INTENT(INOUT):: NVERT +INTEGER, INTENT(OUT) :: INOD - ! Here JJ2 and KK2 have the face containing the intersection: - DO KK2=KK2_LO,KK2_HI - DO JJ2=JJ2_LO,JJ2_HI - FACERT(JJ2,KK2) = .TRUE. - ENDDO - ENDDO -ENDDO INOD_LOOP -DEALLOCATE(SEGS_NODE,ISEG_NODE,ANGS_NODE,CIRC_MED) +REAL(EB), PARAMETER :: VERT_PROX_FCT = 1000._EB -T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) = T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) + CURRENT_TIME() - TNOW +! Local Variables: +! INTEGER :: JNOD, JNOD2, PIVOT(LOW_IND:HIGH_IND) +! REAL(EB) :: DV(MAX_DIM) +! INTEGER, SAVE :: NOD_PERM(CC_MAXVERTS_CELL) +! IF (NVERT < LINSEARCH_LIMIT) THEN +! ! Linear Search: +! DO JNOD=1,NVERT +! DV(IAXIS) = XYZVERT(IAXIS,NOD_PERM(JNOD)) - XYZV(IAXIS) +! IF( DV(IAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF( ABS(DV(IAXIS)) <= GEOMEPS) THEN +! DV(JAXIS) = XYZVERT(JAXIS,NOD_PERM(JNOD)) - XYZV(JAXIS) +! IF ( DV(JAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF ( ABS(DV(JAXIS)) <= GEOMEPS ) THEN +! DV(KAXIS) = XYZVERT(KAXIS,NOD_PERM(JNOD)) - XYZV(KAXIS) +! IF ( DV(KAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF ( ABS(DV(KAXIS)) <= GEOMEPS ) THEN +! INOD = NOD_PERM(JNOD) +! RETURN ! XYZV is in XYZVERT(IAXIS:KAXIS,NOD_PERM(JNOD)) +! ENDIF +! ENDIF +! ENDIF +! ENDDO +! ELSE +! ! Binary Search: +! PIVOT(LOW_IND) = 0 +! PIVOT(HIGH_IND)= NVERT + 1 +! DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) +! JNOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 +! DV(IAXIS) = XYZVERT(IAXIS,NOD_PERM(JNOD)) - XYZV(IAXIS) +! IF( DV(IAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(IAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(IAXIS)) < GEOMEPS +! DV(JAXIS) = XYZVERT(JAXIS,NOD_PERM(JNOD)) - XYZV(JAXIS) +! IF ( DV(JAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(JAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(JAXIS)) < GEOMEPS +! DV(KAXIS) = XYZVERT(KAXIS,NOD_PERM(JNOD)) - XYZV(KAXIS) +! IF ( DV(KAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(KAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(KAXIS)) < GEOMEPS +! INOD = NOD_PERM(JNOD) +! RETURN +! ENDIF +! ENDIF +! ENDIF +! ENDDO +! JNOD=PIVOT(HIGH_IND) +! ENDIF +! ! Insert add NOD_PERM permutation array, O(NP) operation: +! INOD = NVERT + 1 +! NVERT = INOD +! IF (NVERT>MAXVERTS) WRITE(LU_ERR,*) 'geom.f90: INSERT_FACE_VERT_LOC, NVERT',NVERT,', higher than CC_MAXVERTS',MAXVERTS +! DO JNOD2=NVERT,JNOD+1,-1 +! NOD_PERM(JNOD2) = NOD_PERM(JNOD2-1) +! ENDDO +! NOD_PERM(JNOD) = INOD +! XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) -IF (DEBUG_SET_CUTCELLS) THEN - ! Write out: - IF(INDX1 < 0) THEN - WRITE(BIPL_FILE,'(A,A,I3.3,A,I1.1,A,I2.1,A)') TRIM(CHID),'_BODINT_PLANE_',MY_RANK,'_',X1AXIS,'_',INDX1,'.csv' - ELSE - WRITE(BIPL_FILE,'(A,A,I3.3,A,I1.1,A,I2.2,A)') TRIM(CHID),'_BODINT_PLANE_',MY_RANK,'_',X1AXIS,'_',INDX1,'.csv' - ENDIF - LU_DB_SETCC = GET_FILE_NUMBER() - OPEN(LU_DB_SETCC,FILE=TRIM(BIPL_FILE),STATUS='UNKNOWN') - WRITE(LU_DB_SETCC,*) 'X1AXIS,X2AXIS,X3AXIS,X1PLN,GEOMEPS' - WRITE(LU_DB_SETCC,*) X1AXIS,X2AXIS,X3AXIS,X1PLN,GEOMEPS - WRITE(LU_DB_SETCC,*) 'NNODS, NSEGS, NSGLS, NTRIS' - WRITE(LU_DB_SETCC,*) BODINT_PLANE%NNODS,BODINT_PLANE%NSEGS,BODINT_PLANE%NSGLS,BODINT_PLANE%NTRIS - DO INOD=1,BODINT_PLANE%NNODS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%XYZ(IAXIS:KAXIS,INOD) - END DO - DO INOD=1,BODINT_PLANE%NNODS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%NOD_PERM(INOD) - ENDDO - DO ISEG=1,BODINT_PLANE%NSEGS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - END DO - DO ISEG=1,BODINT_PLANE%NSEGS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) - END DO - DO ISGL=1,BODINT_PLANE%NSGLS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%SGLS(NOD1,ISGL) - END DO - DO ITRI=1,BODINT_PLANE%NTRIS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) - ENDDO - CLOSE(333) -ENDIF +DO INOD=1,NVERT + IF( ABS(XYZV(IAXIS)-XYZVERT(IAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE + IF( ABS(XYZV(JAXIS)-XYZVERT(JAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE + IF( ABS(XYZV(KAXIS)-XYZVERT(KAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE + RETURN +ENDDO +NVERT = NVERT + 1 +INOD = NVERT +IF (NVERT>MAXVERTS) WRITE(LU_ERR,*) 'geom.f90: INSERT_FACE_VERT_LOC, NVERT',NVERT,', higher than CC_MAXVERTS',MAXVERTS +XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) RETURN -END SUBROUTINE GET_BODINT_PLANE - +END SUBROUTINE INSERT_FACE_VERT_LOC -! ------------------------ GET_SEGSEG_INTERSECTION ------------------------------ +! ----------------------- GET_CARTFACE_CUTFACES --------------------------------- -SUBROUTINE GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) +SUBROUTINE GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) -REAL(EB), INTENT(IN) :: P1(IAXIS:JAXIS),D1(IAXIS:JAXIS),P2(IAXIS:JAXIS),D2(IAXIS:JAXIS) -REAL(EB), INTENT(OUT):: SVARV(NOD1:NOD2,EDG1:EDG2), SLENV(EDG1:EDG2) -INTEGER, INTENT(OUT):: INT_FLG +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN) :: BNDINT_FLAG ! Local Variables: -REAL(EB) :: SVR, TVR, KRS, KRS2, E2, L12, L22, E(IAXIS:JAXIS), S1, S2, SMIN, SMAX +INTEGER :: X1AXIS, X2AXIS, X3AXIS +INTEGER :: XIAXIS, XJAXIS, XKAXIS +INTEGER :: X1LO, X1HI, X2LO, X2HI, X3LO, X3HI +INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI +INTEGER :: II,II2,JJ,KK, CEI +INTEGER :: INDXI(MAX_DIM), INDI, INDJ, INDK +INTEGER :: INDXI1(MAX_DIM), INDI1, INDJ1, INDK1 +INTEGER :: INDXI2(MAX_DIM), INDI2, INDJ2, INDK2 +INTEGER :: INDXI3(MAX_DIM), INDI3, INDJ3, INDK3 +INTEGER :: INDXI4(MAX_DIM), INDI4, INDJ4, INDK4 +INTEGER :: INDLC(MAX_DIM), IEDG, JEDG, KEDG +INTEGER :: NSEG, ISEG, ISEG2, NVERT, NFACE, NEDGE, IEDGE, NVERT_CART, NSEG_CART +LOGICAL :: OUTFACE1, OUTFACE2, NOTDONE -! Test for segment-segment intersection: -E(IAXIS:JAXIS) = P2(IAXIS:JAXIS) - P1(IAXIS:JAXIS) -KRS = D1(IAXIS)*D2(JAXIS) - D1(JAXIS)*D2(IAXIS); KRS2=KRS**2._EB -L12 = D1(IAXIS)**2._EB + D1(JAXIS)**2._EB -L22 = D2(IAXIS)**2._EB + D2(JAXIS)**2._EB -! Case of segments not parallel. -IF ( KRS2 > GEOMEPS**2._EB*L12*L22) THEN - SVR = (E(IAXIS)*D2(JAXIS)-E(JAXIS)*D2(IAXIS))/ KRS - IF ( (SVR<-GEOMEPS) .OR. ((SVR-1._EB)>GEOMEPS) ) THEN - ! intersection not a point of segment SEG. - INT_FLG = 0 - RETURN - ENDIF - TVR = (E(IAXIS)*D1(JAXIS)-E(JAXIS)*D1(IAXIS))/ KRS - IF ( (TVR<-GEOMEPS) .OR. ((TVR-1._EB)>GEOMEPS) ) THEN - ! intersection not a point of segment SEG2. - INT_FLG = 0 - RETURN - ENDIF - ! Intersection a point on SEG and SEG2. - SLENV(EDG1) = SQRT(L12) - SLENV(EDG2) = SQRT(L22) - SVARV(NOD1,EDG1) = SVR*SLENV(EDG1) - SVARV(NOD1,EDG2) = TVR*SLENV(EDG2) - INT_FLG=1 - RETURN -ENDIF +INTEGER, DIMENSION(NOD1:NOD2+3,1:CC_MAXCEELEM_FACE) :: SEG_FACE, SEG_FACE_CART, SEG_FACEAUX +INTEGER, DIMENSION(NOD1:NOD3+1,1:CC_MAXCEELEM_FACE) :: SEG_FACE2 +REAL(EB), DIMENSION(CC_MAXCEELEM_FACE) :: ANGSEG, ANGSEGAUX +REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) :: XYZVERT, XYZVERT_CART ! Locations of vertices. -! Parallel Segments: -E2 = E(IAXIS)**2._EB + E(JAXIS)**2._EB -KRS= E(IAXIS)*D1(JAXIS) - E(JAXIS)*D1(IAXIS); KRS2=KRS**2._EB -IF ( KRS2 > GEOMEPS**2._EB*L12*E2 ) THEN - ! Segments are different. - INT_FLG = 0 - RETURN -ENDIF -! Segment lines are the same. -S1 = DOT_PRODUCT(D1,E)/L12; S2 = S1+DOT_PRODUCT(D1,D2)/L12 -SMIN=MIN(S1,S2); SMAX=MAX(S1,S2) -IF ( (1._EB+GEOMEPS) < SMIN .OR. (0._EB-GEOMEPS) > SMAX) THEN - INT_FLG = 0 - RETURN -ENDIF -! Overlap tests: -SLENV(EDG1) = SQRT(L12) -SLENV(EDG2) = SQRT(L22) -IF ( (1._EB+GEOMEPS) > SMIN ) THEN ! SMIN between P1 and P1+D1 - IF ( (0._EB-GEOMEPS) < SMAX) THEN ! SMAX greater that P1 - IF (0._EB < SMIN) THEN ! SMIN higher that P1 - SVARV(NOD1,EDG1) = SMIN*SLENV(EDG1) ! First crossing on P1-P1+D1 - IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN ! SMIN is P2 - SVARV(NOD1,EDG2)=0._EB ! First crossing in P2-P2+D2 - ELSE ! SMIN is P2+D2 - SVARV(NOD2,EDG2)=1._EB*SLENV(EDG2) ! Second crossing in P2-P2+D2 - ENDIF - ELSE ! SMIN lower than P1 - SVARV(NOD1,EDG1) = 0._EB ! First crossing in P1-P1+D1 - IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN ! SMIN os P2 - SVARV(NOD1,EDG2)=-SMIN*SLENV(EDG1) ! First crossing in P2-P2-D2 - ELSE - SVARV(NOD2,EDG2)=SMAX*SLENV(EDG1) - ENDIF - ENDIF - IF (1._EB > SMAX) THEN - SVARV(NOD2,EDG1) = SMAX*SLENV(EDG1) - IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN ! SMAX is P2 - SVARV(NOD1,EDG2)=0._EB*SLENV(EDG2) - ELSE - SVARV(NOD2,EDG2)=1._EB*SLENV(EDG2) - ENDIF - ELSE - SVARV(NOD2,EDG1) = 1._EB*SLENV(EDG1) - IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN ! SMAX is P2 - SVARV(NOD1,EDG2)=(SMAX-1._EB)*SLENV(EDG1) - ELSE - SVARV(NOD2,EDG2)=(1._EB-SMIN)*SLENV(EDG1) - ENDIF - ENDIF - INT_FLG = 2 - ELSE - ! SMAX = 0._EB - SVARV(NOD1,EDG1) = 0._EB - IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN - SVARV(NOD1,EDG2) = 0._EB - ELSE - SVARV(NOD1,EDG2) = 1._EB*SLENV(EDG2) - ENDIF - INT_FLG = 1 - ENDIF -ELSE - ! SMIN = 1._EB - SVARV(NOD1,EDG1) = 1._EB*SLENV(EDG1) - IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN - SVARV(NOD1,EDG2) = 0._EB - ELSE - SVARV(NOD1,EDG2) = 1._EB*SLENV(EDG2) - ENDIF - INT_FLG = 1 -ENDIF +INTEGER, SAVE :: SIZE_CFACES_CFELEM, SIZE_VERTS_CFELEM +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CFELEM2,CEDGES,CEDGES2 +INTEGER, ALLOCATABLE, DIMENSION(:) :: CFE, CFEL -RETURN -END SUBROUTINE GET_SEGSEG_INTERSECTION +INTEGER, SAVE :: SIZE_EDGES_NODEDG, SIZE_VERTS_NODEDG +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NODEDG_FACE -! -------------------------- GET_X2INTERSECTIONS -------------------------------- +LOGICAL :: SEG_FLAG(CC_MAXCEELEM_FACE) +INTEGER :: NUMEDG_NODE(CC_MAXVERTS_FACE) -SUBROUTINE GET_X2_INTERSECTIONS(X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN) +INTEGER :: INOD, INOD1, INOD2, SEG(NOD1:NOD2) +REAL(EB):: X1, X2, X3, DX2, DX3, XYZV(MAX_DIM), XYZLC(MAX_DIM) +INTEGER :: NUMNOD1, NUMNOD2, NEDI, ICF, ISS, NEWSEG, COUNT, N2COUNT, CTSTART, NSEG_LEFT +REAL(EB):: ANGCOUNT, DANG, DANGI +LOGICAL :: FOUNDSEG, PTSFLAG +INTEGER :: ICF1, ICF2, ICF_PT, IPT, NP, NP1, NP2, NFACE2, NCUTFACE, NVERTFACE +REAL(EB), DIMENSION(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) :: XY +REAL(EB):: AREA, AREA1, AREA2, AREAH, CX2, CX3, DIST12, D12 +REAL(EB), DIMENSION(IAXIS:JAXIS) :: XYC1, XYC2, XYH -INTEGER, INTENT(IN) :: X1AXIS, X2AXIS, X3AXIS -REAL(EB),INTENT(IN) :: X3RAY,X1PLN +REAL(EB), DIMENSION(CC_MAXCFELEM_FACE) :: AREAV ! Cut-faces areas. +REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXCFELEM_FACE) :: XYZCEN ! Cut-faces centroid locations. +REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXCFELEM_FACE) :: INXAREA, INXSQAREA +INTEGER, DIMENSION(CC_MAXCFELEM_FACE) :: FINFACE +INTEGER :: IBNDINT,BNDINT_LOW,BNDINT_HIGH,ILOC,BODNUM(1:CC_MAXCEELEM_FACE),& +SEGTYPE(CC_MAXCEELEM_FACE),SEGTYPEAUX(CC_MAXCEELEM_FACE),VEC(2),IDUM,IBOD,STYPE +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED -! Local Variables: -INTEGER :: ISGL, SGL, ISEG, SEG(NOD1:NOD2) -REAL(EB):: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, DOT1, DOT2 -REAL(EB):: SVARI, STANI(IAXIS:JAXIS) -INTEGER :: ICRSI(LOW_IND:HIGH_IND+1), SCRSI, ISSEG(LOW_IND:HIGH_IND), GAM(LOW_IND:HIGH_IND) -REAL(EB):: X3MIN, X3MAX, DV12(MAX_DIM), MODTI, NOMLI(IAXIS:JAXIS) -LOGICAL :: OUTRAY -REAL(EB):: DELBIN, AVAL -INTEGER :: ILO_BIN,IHI_BIN,IBIN,IISEG,ICR +INTEGER :: NSSEG, NSVERT, NSFACE, NSFACE2 +LOGICAL :: ASCDESC, INLIST +INTEGER :: NV,IV,V(1:CC_MAXVERTS_FACE) +REAL(EB):: XVERT1(1:CC_MAXVERTS_FACE),XVERT2(1:CC_MAXVERTS_FACE) +INTEGER, PARAMETER :: NODC1(1:4) = (/ 1, 2, 1, 2 /) +INTEGER, PARAMETER :: NODC2(1:4) = (/ 1, 2, 2, 1 /) +INTEGER :: SNOD1(NOD1:NOD2), SNOD2(NOD1:NOD2) +REAL(EB) :: XYZ_SEG1(IAXIS:KAXIS,NOD1:NOD2), XYZ_SEG2(IAXIS:KAXIS,NOD1:NOD2) +LOGICAL :: DIFF(1:4) +LOGICAL :: GET_SOLID_CUTFACES = .TRUE. +LOGICAL, ALLOCATABLE, DIMENSION(:) :: DROPFACE REAL(EB) :: TNOW -! INTEGER :: IAUX -TNOW = CURRENT_TIME() +! INTEGER :: ETYPE, AXIS, SIDE, IEC, JEC, CEIJK(4), IIF, JJF ,KKF +! REAL(EB):: X1E(IAXIS:KAXIS), X1V(IAXIS:KAXIS), X2E(IAXIS:KAXIS), X2V(IAXIS:KAXIS) -! Initialize crossings arrays: -CC_N_CRS = 0 -CC_SVAR_CRS = 1._EB / GEOMEPS -CC_IS_CRS = CC_UNDEFINED -CC_IS_CRS2 = CC_UNDEFINED -CC_SEG_TAN = 0._EB -CC_SEG_CRS = 0 -CC_BDNUM_CRS = 0 ! Size (0:CC_MAXCROSS_X2) -CC_BDNUM_CRS_AUX= 0 ! Size (0:CC_MAXCROSS_X2) +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +INTEGER :: NCUTFCE + +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + IF (BNDINT_FLAG) THEN ! Boundary and internal cartface cut-faces: + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating internal CARTFACE_CUTFACES for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating internal CARTFACE_CUTFACES for mesh :',NM,' ..' + ELSE + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTFACE_CUTFACES for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTFACE_CUTFACES for mesh :',NM,' ..' + ENDIF +ENDIF + +TNOW=CURRENT_TIME() + +! Allocate local Arrays: +SIZE_EDGES_NODEDG = DELTA_EDGE +SIZE_VERTS_NODEDG = DELTA_VERT +ALLOCATE(NODEDG_FACE(1:SIZE_EDGES_NODEDG,1:SIZE_VERTS_NODEDG)) +SIZE_CFACES_CFELEM = DELTA_FACE +SIZE_VERTS_CFELEM = DELTA_VERT +ALLOCATE(CFELEM(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) +ALLOCATE(CEDGES(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) +ALLOCATE(CFE(1:SIZE_VERTS_CFELEM),CFEL(1:SIZE_VERTS_CFELEM)) + +! Build a set of regular cut-cells in the middle of the domain to do testing. +IF (PERIODIC_TEST == 103 .OR. PERIODIC_TEST == 11 .OR. PERIODIC_TEST == 7) THEN + CALL DEFINE_REGULAR_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) + T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW + RETURN +ENDIF + +! Test to check cut-cell definition scaling: +IF (PERIODIC_TEST == 105) GET_SOLID_CUTFACES = .FALSE. + +! Main Loop on block NM: +IF (BNDINT_FLAG) THEN + ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. + BNDINT_LOW = 1 + BNDINT_HIGH = 3 +ELSE + IF (CCGUARD==0) THEN + DEALLOCATE( IJK_COUNTED ) + RETURN + ENDIF + BNDINT_LOW = 4 + BNDINT_HIGH = 4 +ENDIF + +IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, + ! 4 guard-cell faces. + + ! When switching to internal faces, copy number of external faces already computed. + IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH -! First Single points: -! Treat them as [GASPHASE GASPHASE] crossings: -DO ISGL=1,BODINT_PLANE%NSGLS - SGL = BODINT_PLANE%SGLS(NOD1,ISGL) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SGL) - ! x2-x3 coordinates of point: - X2_1 = XYZ1(X2AXIS) - X3_1 = XYZ1(X3AXIS) + XIAXIS_LOOP : DO X1AXIS=IAXIS,KAXIS - ! Dot product dot(X_1-XRAY,e3) - DOT1 = X3_1-X3RAY - IF (ABS(DOT1) <= GEOMEPS) DOT1=0._EB - IF ( ABS(DOT1) == 0._EB ) THEN - ! Point 1: - SVARI = X2_1 - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_GASPHASE, CC_UNDEFINED /) - SCRSI = -ISGL - STANI(IAXIS:JAXIS) = 0._EB + SELECT CASE(X1AXIS) + case(IAXIS) - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) ! Modifies crossings arrays. - ENDIF -ENDDO + X2AXIS = JAXIS + X3AXIS = KAXIS -! Now Segments: -NSEGS_COND : IF (BODINT_PLANE%NSEGS > 0) THEN + ! IAXIS gasphase cut-faces: + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + ILO = ILO_FACE; IHI = ILO_FACE + CASE(2) + ILO = IHI_FACE; IHI = IHI_FACE + CASE(3) + ILO = ILO_FACE+1; IHI = IHI_FACE-1 + CASE(4) + ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT -DELBIN = BODINT_PLANE%TBAXIS(X3AXIS)%DELBIN -AVAL = (X3RAY-GEOMEPS-BODINT_PLANE%BOX(LOW_IND,X3AXIS))/DELBIN -ILO_BIN= MAX(1, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS,EB),ABS(AVAL)) )) -AVAL = (X3RAY+GEOMEPS-BODINT_PLANE%BOX(LOW_IND,X3AXIS))/DELBIN -IHI_BIN= MIN(BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS,EB),ABS(AVAL)) )) -IBIN_DO : DO IBIN=ILO_BIN,IHI_BIN + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS - IF (X3RAY < BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%X1_LOW -GEOMEPS) CYCLE - IF (X3RAY > BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE + ! Local indexing in x1, x2, x3: + X1LO = ILO; X1HI = IHI + X2LO = JLO; X2HI = JHI + X3LO = KLO; X3HI = KHI - TRIBIN_DO : DO IISEG=1,BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%NTL + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE + ALLOCATE(X2FACE(JSTR:JEND)); X2FACE = YFACE + ALLOCATE(X3FACE(KSTR:KEND)); X3FACE = ZFACE - ISEG = BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) -!SEGMENTS_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS + CASE(JAXIS) - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) + X2AXIS = KAXIS + X3AXIS = IAXIS - ! x2,x3 coordinates of segment: - X2_1 = XYZ1(X2AXIS) - X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. - X2_2 = XYZ2(X2AXIS) - X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. + ! JAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + JLO = JLO_FACE; JHI = JLO_FACE + CASE(2) + JLO = JHI_FACE; JHI = JHI_FACE + CASE(3) + JLO = JLO_FACE+1; JHI = JHI_FACE-1 + CASE(4) + JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT - ! First Test if the whole segment is on one side of the Ray: - ! Test segment crosses the ray, or is in geomepsilon proximity - ! of it: - X3MIN = MIN(X3_1,X3_2) - X3MAX = MAX(X3_1,X3_2) - OUTRAY=(((X3RAY-X3MAX) > GEOMEPS) .OR. ((X3MIN-X3RAY) > GEOMEPS)) + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS - IF (OUTRAY) CYCLE + ! Local indexing in x1, x2, x3: + X1LO = JLO; X1HI = JHI + X2LO = KLO; X2HI = KHI + X3LO = ILO; X3HI = IHI - DOT1 = X3_1-X3RAY - DOT2 = X3_2-X3RAY + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE + ALLOCATE(X2FACE(KSTR:KEND)); X2FACE = ZFACE + ALLOCATE(X3FACE(ISTR:IEND)); X3FACE = XFACE - IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB - IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB + CASE(KAXIS) - ! Segment tangent unit vector. - DV12(IAXIS:JAXIS) = XYZ2( (/ X2AXIS, X3AXIS /) ) - XYZ1( (/ X2AXIS, X3AXIS /) ) - MODTI = SQRT( DV12(IAXIS)**2._EB + DV12(JAXIS)**2._EB ) - STANI(IAXIS:JAXIS) = DV12(IAXIS:JAXIS) * MODTI**(-1._EB) - NOMLI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) - ISSEG(LOW_IND:HIGH_IND) = BODINT_PLANE%SEGTYPE(LOW_IND:HIGH_IND,ISEG) + X2AXIS = IAXIS + X3AXIS = JAXIS - ! For x2, in local x2-x3 coords e2=(1,0): - GAM(LOW_IND) = (1 + NINT(SIGN( 1._EB, NOMLI(IAXIS))) ) / 2 !(1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; - GAM(HIGH_IND)= (1 - NINT(SIGN( 1._EB, NOMLI(IAXIS))) ) / 2 !(1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; + ! KAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + KLO = KLO_FACE; KHI = KLO_FACE + CASE(2) + KLO = KHI_FACE; KHI = KHI_FACE + CASE(3) + KLO = KLO_FACE+1; KHI = KHI_FACE-1 + CASE(4) + KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + END SELECT - ! Test if whole segment is in ray, if so add segment nodes as crossings: - IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS - ! Count both points as crossings: - ! Point 1: - SVARI = MIN(X2_1,X2_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) - SCRSI = ISEG + ! Local indexing in x1, x2, x3: + X1LO = KLO; X1HI = KHI + X2LO = ILO; X2HI = IHI + X3LO = JLO; X3HI = JHI - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE + ALLOCATE(X2FACE(ISTR:IEND)); X2FACE = XFACE + ALLOCATE(X3FACE(JSTR:JEND)); X3FACE = YFACE - DO ICR=2,BODINT_PLANE%NBCROSS(ISEG)-1 - SVARI = X2_1 + BODINT_PLANE%SVAR(ICR,ISEG)*STANI(IAXIS) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - ENDDO + END SELECT - ! Point 2: - SVARI = MAX(X2_1,X2_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) - SCRSI = ISEG + ! Loop on Cartesian faces, local x1, x2, x3 indexes: + DO II=X1LO,X1HI + DO KK=X3LO,X3HI + DO JJ=X2LO,X2HI - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI = INDXI(XIAXIS) + INDJ = INDXI(XJAXIS) + INDK = INDXI(XKAXIS) - CYCLE + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE; IJK_COUNTED(INDI,INDJ,INDK,X1AXIS)=.TRUE. + IF(MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) == CC_SOLID) CYCLE - ENDIF + ! Drop if face not cut-face: + ! Test for FACE Cartesian edges being cut: + ! If outface1 is true -> All regular edges for this face: + ! Edge at index KK-1: + INDXI1(IAXIS:KAXIS) = (/ II, JJ, KK-1 /) ! Local x1,x2,x3 + INDI1 = INDXI1(XIAXIS) + INDJ1 = INDXI1(XJAXIS) + INDK1 = INDXI1(XKAXIS) + ! Edge at index KK: + INDXI2(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI2 = INDXI2(XIAXIS) + INDJ2 = INDXI2(XJAXIS) + INDK2 = INDXI2(XKAXIS) + ! Edge at index JJ-1: + INDXI3(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 + INDI3 = INDXI3(XIAXIS) + INDJ3 = INDXI3(XJAXIS) + INDK3 = INDXI3(XKAXIS) + ! Edge at index jj: + INDXI4(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI4 = INDXI4(XIAXIS) + INDJ4 = INDXI4(XJAXIS) + INDK4 = INDXI4(XKAXIS) - ! Now nodes individually: - IF ( ABS(DOT1) == 0._EB ) THEN + OUTFACE1 = (MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) /= CC_CUTCFE) - ! Point 1: - SVARI = X2_1 + ! Test for face with INB edges: + ! If outface2 is true -> no INB Edges associated with this face: + OUTFACE2 = (MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) <= 0) - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND) = GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)= CC_UNDEFINED - SCRSI = ISEG + ! Drop if outface1 & outface2 + IF (OUTFACE1 .AND. OUTFACE2) THEN + ! Test if face is SOLID: + IF ((MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) == CC_SOLID) ) THEN + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID + ENDIF + CYCLE + ENDIF - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_CUTCFE - CYCLE + ! Build segment list: + NSEG = 0 + NVERT = 0 + NFACE = 0 - ENDIF - IF ( ABS(DOT2) == 0._EB ) THEN + SEG_FACE (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED + XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) = 0._EB + ANGSEG(1:CC_MAXCEELEM_FACE) = 0._EB + BODNUM(1:CC_MAXCEELEM_FACE) = 1000000000 + SEGTYPE(1:CC_MAXCEELEM_FACE) = 0 - ! Point 2: - SVARI = X2_2 - ! LOW and HIGH_IND media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND) = GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1) = CC_UNDEFINED - SCRSI = ISEG + ! 1. Cartesian CC_GASPHASE edges, cut-edges: + ! a. Make a list of segments: + ! Low x2 cut-edges: + INDLC(IAXIS:KAXIS) = INDXI3(IAXIS:KAXIS) + IEDG=INDI3; JEDG=INDJ3; KEDG=INDK3 + CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X3AXIS) + IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: + IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X3AXIS) /= CC_SOLID) THEN + ! x,y,z of node 1: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + + ! x,y,z of node 2: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)-1) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, LOW_IND, X2AXIS /) + ANGSEG(NSEG) = - PI / 2._EB + ENDIF + ELSE ! Cut-edge, load CUT_EDGE(CEI) segments + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - CYCLE + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) - ENDIF + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) - ! Finally regular case: - ! Points 1 on one side of ray, point 2 on the other: - ! IF ((DOT1 > 0. .AND. DOT2 < 0.) .OR. (DOT1 < 0. .AND. DOT2 > 0.)) - IF ( DOT1*DOT2 < 0._EB ) THEN + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) + ANGSEG(NSEG) = - PI / 2._EB + ENDDO + ENDIF - ! Intersection Point along segment: - !DS = (X3RAY-X3_1) / (X3_2-X3_1) - !SVARI = X2_1 + DS*(X2_2-X2_1) - SVARI = X2_1 + (X3RAY-X3_1) * (X2_2-X2_1) / (X3_2-X3_1) + ! High x2 cut-edges: + INDLC(IAXIS:KAXIS) = INDXI4(IAXIS:KAXIS) + IEDG=INDI4; JEDG=INDJ4; KEDG=INDK4 + CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X3AXIS) + IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: + IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X3AXIS) /= CC_SOLID) THEN + ! x,y,z of node 1: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)-1) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND) = GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1) = CC_UNDEFINED - SCRSI = ISEG + ! x,y,z of node 2: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, HIGH_IND, X2AXIS /) + ANGSEG(NSEG) = PI / 2._EB + ENDIF + ELSE ! Cut-edge, load CUT_EDGE(CEI) segments + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - CYCLE + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) - ENDIF + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) - print*, "Error GET_X2INTERSECTIONS: Missed segment=",ISEG + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) + ANGSEG(NSEG) = PI / 2._EB + ENDDO + ENDIF - ENDDO TRIBIN_DO -ENDDO IBIN_DO -!ENDDO SEGMENTS_LOOP + ! Low x3 cut-edges: + INDLC(IAXIS:KAXIS) = INDXI1(IAXIS:KAXIS) + IEDG=INDI1; JEDG=INDJ1; KEDG=INDK1 + CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X2AXIS) + IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: + IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X2AXIS) /= CC_SOLID) THEN + ! x,y,z of node 1: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)-1), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -ENDIF NSEGS_COND + ! x,y,z of node 2: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) -! Do we have any intersections? -IF ( CC_N_CRS == 0 ) RETURN + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, LOW_IND, X3AXIS /) + ANGSEG(NSEG) = 0._EB + ENDIF + ELSE ! Cut-edge, load CUT_EDGE(CEI) segments + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) -! Collapse crossings to single SVARs: -CALL COLLAPSE_CROSSINGS(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,1) + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) -! Write out: -! print*, "X3RAY=",X3RAY,", Intersect X2=",CC_N_CRS -! DO ICRS=1,CC_N_CRS -! print*, ICRS,", ",CC_SVAR_CRS(ICRS),", ",CC_IS_CRS(ICRS) -! ENDDO + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) + ANGSEG(NSEG) = 0._EB + ENDDO + ENDIF -T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW + ! High x3 cut-edges: + INDLC(IAXIS:KAXIS) = INDXI2(IAXIS:KAXIS) + IEDG=INDI2; JEDG=INDJ2; KEDG=INDK2 + CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X2AXIS) + IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: + IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X2AXIS) /= CC_SOLID) THEN + ! x,y,z of node 1: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -RETURN -END SUBROUTINE GET_X2_INTERSECTIONS + ! x,y,z of node 2: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)-1), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, HIGH_IND, X3AXIS /) + ANGSEG(NSEG) = PI + ENDIF + ELSE ! Cut-edge, load CUT_EDGE(CEI) segments + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) -! ------------------------ COLLAPSE_CROSSINGS ----------------------------------- + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -SUBROUTINE COLLAPSE_CROSSINGS(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,ITITLE) + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) -TYPE(BODINT_PLANE_TYPE), INTENT(IN) :: BODINT_PLANE2 -INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,ITITLE -REAL(EB), INTENT(IN) :: X3RAY,X1PLN + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) + ANGSEG(NSEG) = PI + ENDDO + ENDIF -! Local Variables: -INTEGER :: CC_N_CRS_AUX -REAL(EB):: CC_SVAR_CRS_AUX(CC_MAXCROSS_X2) -INTEGER :: CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_MAXCROSS_X2),BODNUM(CC_MAXCROSS_X2) -REAL(EB):: CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_MAXCROSS_X2) -INTEGER :: CC_SEG_CRS_AUX(CC_MAXCROSS_X2) -INTEGER :: CRS_NUM(CC_MAXCROSS_X2),IND_CRS(LOW_IND:HIGH_IND,CC_MAXCROSS_X2) -INTEGER :: LEFT_MEDIA, NCRS_REMAIN -INTEGER :: ICRS, ICRS1, ICRS2, IDCR, IDCR2, IND_LEFT, IND_RIGHT, NUBD, IBDNUM, ISEG, IUBD, SBOD -LOGICAL :: DROP_SS_GG, FOUND_LEFT, NOT_COUNTED(CC_MAXCROSS_X2), USE_INT_POINT(CC_MAXCROSS_X2), ALGN_CROSS -INTEGER, ALLOCATABLE, DIMENSION(:) :: UBOD + ! Store Segment and Vertex list from Cartesian face boundary: + XYZVERT_CART(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) + SEG_FACE_CART(NOD1:NOD2+3,1:NSEG) = SEG_FACE(NOD1:NOD2+3,1:NSEG) + NVERT_CART=NVERT; NSEG_CART = NSEG -CC_N_CRS_AUX = 0 -CC_SVAR_CRS_AUX = 1._EB/GEOMEPS ! svar = x2_intersection -CC_IS_CRS2_AUX = CC_UNDEFINED ! Is the intersection an actual GS. -CC_SEG_CRS_AUX = 0 ! Segment containing the crossing. -CC_SEG_TAN_AUX = 0._EB ! Segment orientation for each intersection. + ! 2. CC_INBOUNDARY cut-edges assigned to this face: + CEI = MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) + IF ( CEI > 0 ) THEN ! There are inboundary cut-edges + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) -! Count how many crossings with different SVAR: -CRS_NUM(:) = 0 -ICRS = 1 -CRS_NUM(ICRS) = 1 -IND_CRS(:,:) = 0 -IND_CRS(LOW_IND, CRS_NUM(ICRS)) = ICRS-1 -IND_CRS(HIGH_IND,CRS_NUM(ICRS)) = IND_CRS(HIGH_IND,ICRS)+1 + IBOD = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) + STYPE = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(5,IEDGE) -DO ICRS=2,CC_N_CRS - IF ( ABS(CC_SVAR_CRS(ICRS)-CC_SVAR_CRS(ICRS-1)) < GEOMEPS ) THEN - CRS_NUM(ICRS) = CRS_NUM(ICRS-1) - ELSE - CRS_NUM(ICRS) = CRS_NUM(ICRS-1)+1 - IND_CRS(LOW_IND,CRS_NUM(ICRS)) = ICRS-1 - ENDIF - IND_CRS(HIGH_IND,CRS_NUM(ICRS)) = IND_CRS(HIGH_IND,CRS_NUM(ICRS))+1 -ENDDO + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -! Computation of CC_BDNUM_CRS_AUX requires knowledge of how many different -! bodies reach an intersection: -BODNUM(:) = 0 -ALLOCATE(UBOD(N_GEOMETRY)); UBOD=0 -IDCR_DO_1 : DO IDCR=1,CRS_NUM(CC_N_CRS) - ! Load body numbers: - DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - ISEG=CC_SEG_CRS(IDCR2) - IF (ISEG > 0) BODNUM(IDCR2)=BODINT_PLANE2%INDSEG(4,ISEG) - ENDDO - ! Unique bodies: - NUBD = 0 - DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF ( BODNUM(IDCR2)<1 ) CYCLE - IF ((NUBD > 0) .AND. ANY(UBOD(1:NUBD)==BODNUM(IDCR2))) CYCLE - NUBD = NUBD + 1 - UBOD(NUBD) = BODNUM(IDCR2) - ENDDO - ! Now assign CC_BDNUM_CRS_AUX(IDCR): - SBOD = 0 - DO IUBD=1,NUBD - ! Drop extra intersections (same intersection type, same body): - USE_INT_POINT(IND_CRS(LOW_IND,IDCR)+1:IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR)) = .TRUE. - DO ICRS1=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF (.NOT.USE_INT_POINT(ICRS1)) CYCLE ! Don't use collapsed point as pivot. - ! Collapse GS or SG points: - DO ICRS2 = IND_CRS(LOW_IND,IDCR)+1 , IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF ( (ICRS2==ICRS1) .OR. .NOT.USE_INT_POINT(ICRS2) ) CYCLE ! Don't use pivot, or collapsed point. - IF ((CC_IS_CRS2(LOW_IND ,ICRS1) == CC_IS_CRS2(LOW_IND ,ICRS2)) .AND. & - (CC_IS_CRS2(HIGH_IND,ICRS1) == CC_IS_CRS2(HIGH_IND,ICRS2)) .AND. & - (BODNUM(ICRS1) == BODNUM(ICRS2))) THEN - USE_INT_POINT(ICRS2) = .FALSE. - ENDIF - ENDDO - ENDDO - IBDNUM=0 - DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF (BODNUM(IDCR2) /= UBOD(IUBD)) CYCLE - IF ( .NOT.USE_INT_POINT(IDCR2) ) CYCLE - IBDNUM = IBDNUM + CC_BDNUM_CRS(IDCR2) - ENDDO - IF (IBDNUM /= 0) SBOD = SBOD + SIGN(1,IBDNUM) - ENDDO - IF (IDCR == 1) THEN - CC_BDNUM_CRS_AUX(IDCR) = SBOD - ELSE - CC_BDNUM_CRS_AUX(IDCR) = CC_BDNUM_CRS_AUX(IDCR-1) + SBOD - ENDIF -ENDDO IDCR_DO_1 -DEALLOCATE(UBOD) + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + ! ADD segment: + VEC(NOD1:NOD2) = (/ INOD1, INOD2 /) + ! Insertion ADD segment: + INLIST =.FALSE. + DO IDUM = 1,NSEG + IF ( (SEG_FACE(NOD1,IDUM)==VEC(NOD1)) .AND. (SEG_FACE(NOD2,IDUM)==VEC(NOD2)) ) THEN + IF ( (STYPE >= SEGTYPE(IDUM)) .AND. (BODNUM(IDUM) > IBOD) ) THEN + BODNUM(IDUM) = IBOD + SEGTYPE(IDUM)=STYPE + ENDIF + INLIST =.TRUE. + EXIT + ENDIF + IF ( (SEG_FACE(NOD2,IDUM)==VEC(NOD1)) .AND. (SEG_FACE(NOD1,IDUM)==VEC(NOD2)) ) THEN + IF ( (STYPE >= SEGTYPE(IDUM)) .AND. (BODNUM(IDUM) > IBOD) ) THEN + SEG_FACE(NOD1:NOD2,IDUM) = VEC(NOD1:NOD2) + BODNUM(IDUM) = IBOD + SEGTYPE(IDUM) =STYPE + ENDIF + INLIST =.TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ VEC(NOD1:NOD2), CC_ETYPE_CFINB, CEI, IEDGE /) + BODNUM(NSEG) = IBOD + SEGTYPE(NSEG) = STYPE + DX3 = XYZVERT(X3AXIS,INOD2)-XYZVERT(X3AXIS,INOD1) + DX2 = XYZVERT(X2AXIS,INOD2)-XYZVERT(X2AXIS,INOD1) + ANGSEG(NSEG) = ATAN2(DX3,DX2) + ENDIF + ENDDO + ENDIF -! This is where we merge intersections at same svar location (i.e. same CRS_NUM value): -! Loop over different crossings: -LEFT_MEDIA = CC_GASPHASE ! Here we could change the initial LEFT_MEDIA to CC_SOLID if needed. Would require adding - ! CC_BDNUM_CRS(LOW_IND,0) = 1, i.e crossed into SOLID at x2 -> -Inf. -IDCR_DO_2 : DO IDCR=1,CRS_NUM(CC_N_CRS) - CC_N_CRS_AUX = CC_N_CRS_AUX + 1 - ! Case of single crossing with new svar: - SNGL_CRS_IF : IF ( IND_CRS(HIGH_IND,IDCR) == 1 ) THEN + ! IF(INDI==14 .AND. INDJ==2 .AND. INDK==5 .AND. X1AXIS==KAXIS) THEN + ! OPEN(666,FILE='VERTS_FC0.txt',STATUS='REPLACE') + ! DO IDUM=1,NVERT + ! WRITE(666,*) XYZVERT(1:3,IDUM) + ! ENDDO + ! CLOSE(666) + ! OPEN(666,FILE='SEGS_FC0.txt',STATUS='REPLACE') + ! DO ISEG=1,NSEG + ! WRITE(666,*) SEG_FACE(NOD1:NOD2,ISEG),ANGSEG(ISEG),SEGTYPE(ISEG) + ! ENDDO + ! CLOSE(666) + ! ENDIF - ICRS =IND_CRS(LOW_IND,IDCR) + 1 + NOTDONE = .TRUE. + DO WHILE(NOTDONE) + NOTDONE = .FALSE. + ! Counts edges that reach nodes: + NUMEDG_NODE(1:CC_MAXVERTS_FACE) = 0 + DO ISEG=1,NSEG + DO II2=NOD1,NOD2 + INOD = SEG_FACE(II2,ISEG) + NUMEDG_NODE(INOD) = NUMEDG_NODE(INOD) + 1 + ENDDO + ENDDO - IF ( (ICRS>1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN - ! Test if already inside an Object. - CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) = CC_SOLID - ELSEIF ( CC_IS_CRS2(LOW_IND,ICRS) /= LEFT_MEDIA ) THEN + ! Drop segments with NUMEDG_NODE(INOD)=1: + ! The assumption here is that they are CC_GG CC_INBOUNDCF + ! segments with one node inside the Cartface i.e. case Fig + ! 9(a) in the CompGeom3D notes): + COUNT = 0 + SEG_FACEAUX (NOD1:NOD2+3,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED + ANGSEGAUX(1:CC_MAXCEELEM_FACE) = 0._EB + SEGTYPEAUX(1:CC_MAXCEELEM_FACE) = CC_UNDEFINED + DO ISEG=1,NSEG + NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) + NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) + IF ((NUMNOD1 > 1) .AND. (NUMNOD2 > 1)) THEN + COUNT = COUNT + 1 + SEG_FACEAUX(NOD1:NOD2+3,COUNT) = SEG_FACE(NOD1:NOD2+3,ISEG) + ANGSEGAUX(COUNT) = ANGSEG(ISEG) + SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) + ELSE + NOTDONE = .TRUE. + ENDIF + ENDDO + NSEG = COUNT + SEG_FACE = SEG_FACEAUX + ANGSEG = ANGSEGAUX + SEGTYPE = SEGTYPEAUX + ENDDO - ! Check if this is a single point SGLS which was initially tagged as CC_GASPHASE, - ! if so switch media type to LEFT_MEDIA - IF (CC_SEG_CRS(ICRS) < 0) THEN - CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) = LEFT_MEDIA - ELSE - IF (ITITLE==1) THEN - WRITE(LU_ERR,*) "Error GET_X2INTERSECTIONS: IS_CRS(LOW_IND,ICRS) ~= LEFT_MEDIA, media continuity problem" - WRITE(LU_ERR,*) "X1AXIS,X1PLN=",X1AXIS,X1PLN,", X2AXIS,X3AXIS=",X2AXIS,X3AXIS,", RAY X3 POSITION=",X3RAY - ELSEIF (ITITLE==2) THEN - WRITE(LU_ERR,*) "Error GET_IS_SOLID_PT: IS_CRS(LOW_IND,ICRS) ~= LEFT_MEDIA, media continuity problem" - WRITE(LU_ERR,*) "X1AXIS,X1PLN=",X1AXIS,X1PLN,", X2AXIS,X3AXIS=",X2AXIS,X3AXIS,", RAY X3 POSITION=",X3RAY - ENDIF - IF (IDCR==1) THEN - ! FIXME: this should be the error message, IG should be made available here - ! WRITE(MESSAGE,'(A,A,A)') "ERROR: GEOM ID='", TRIM(GEOMETRY(IG)%ID), & - ! "': Face normals are probably pointing in the wrong direction. Check they point towards the gas phase." - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A)') " SUCCESS: GEOM ID Unknown:" - ELSE - WRITE(LU_ERR,'(A)') " ERROR(726): GEOM ID Unknown:" - ENDIF - WRITE(LU_ERR,'(A)') " Face normals are probably pointing in the wrong direction. " - WRITE(LU_ERR,'(A)') " Check they point towards the gas phase." - ENDIF - CALL SHUTDOWN("") ; RETURN - ENDIF - ENDIF + ! Discard face with no conected edges: + IF ( (NSEG==0) .OR. (NSEG==2 .AND. ( ANY(SEG_FACE(NOD1:NOD2,1)==SEG_FACE(NOD2,2)) .AND. & + ANY(SEG_FACE(NOD1:NOD2,1)==SEG_FACE(NOD1,2)) )) ) THEN + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID + CYCLE + ENDIF - CC_SVAR_CRS_AUX(CC_N_CRS_AUX) = CC_SVAR_CRS(ICRS) - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) - CC_SEG_CRS_AUX(CC_N_CRS_AUX) = CC_SEG_CRS(ICRS) - CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_N_CRS_AUX) = CC_SEG_TAN(IAXIS:JAXIS,ICRS) - LEFT_MEDIA = CC_IS_CRS2(HIGH_IND,ICRS) + ! Add segments which have both ends attached to more than two segs: + count = 0 + DO ISEG=1,NSEG + COUNT = COUNT + 1 + SEG_FACEAUX (NOD1:NOD2+3,COUNT) = SEG_FACE(NOD1:NOD2+3,ISEG) + ANGSEGAUX(COUNT) = ANGSEG(ISEG) + !SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) + IF (SEGTYPE(ISEG)==1) THEN + COUNT = COUNT + 1 + SEG_FACEAUX (NOD1:NOD2+3,COUNT) = SEG_FACE( (/ NOD2, NOD1, 3, 4, 5 /),ISEG) + !SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) + IF (ANGSEG(ISEG) > 0._EB) THEN + ANGSEGAUX(COUNT) = ANGSEG(ISEG) - PI + ELSE + ANGSEGAUX(COUNT) = ANGSEG(ISEG) + PI + ENDIF + ENDIF + ENDDO + NSEG = COUNT + SEG_FACE = SEG_FACEAUX + ANGSEG = ANGSEGAUX + !SEGTYPE = SEGTYPEAUX - CYCLE + ! Fill NODEDG_FACE(IEDGE,INOD), where iedge are edges + ! that contain inod as first node. This assumes edges are + ! ordered using the right hand rule on x2-x3 plane. + ! Also compute the edges angles in x2-x3 plane: + ! Reallocate NODEDG_FACE if NSEG+1 > SIZE_EDGES_NODEDG, or NVERT > SIZE_VERTS_NODEDG: + CALL REALLOCATE_NODEDG_FACE(NSEG,NVERT) + NODEDG_FACE(:,:) = 0 + DO ISEG=1,NSEG + INOD1 = SEG_FACE(NOD1,ISEG) + NEDI = NODEDG_FACE(1,INOD1) + 1 ! Increase number of edges connected to node by 1. + NODEDG_FACE( 1,INOD1) = NEDI + NODEDG_FACE(NEDI+1,INOD1) = ISEG + ENDDO - ENDIF SNGL_CRS_IF + ! Now Reorder Segments, do tests: + SEG_FACE2(NOD1:NOD3+1,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED ! [INOD1 INOD2 ICF] + SEG_FLAG(1:CC_MAXCEELEM_FACE) = .TRUE. - ! Case of several crossings with new svar: - DROP_SS_GG = .FALSE. - DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF ( CC_IS_CRS2(LOW_IND,ICRS) /= CC_IS_CRS2(HIGH_IND,ICRS) ) THEN - DROP_SS_GG = .TRUE. - EXIT - ENDIF - ENDDO + ICF = 1 + ISEG = 1 + NEWSEG = ISEG + COUNT= 1 + CTSTART=COUNT + SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG), SEG_FACE(NOD2,NEWSEG), ICF, NEWSEG /) + SEG_FLAG(ISEG) = .FALSE. + NSEG_LEFT = NSEG - 1 - ! Variables related to new svar crossing: - ICRS = IND_CRS(LOW_IND,IDCR) + 1 - CC_SVAR_CRS_AUX(CC_N_CRS_AUX) = CC_SVAR_CRS(ICRS) - CC_SEG_CRS_AUX(CC_N_CRS_AUX) = CC_SEG_CRS(ICRS) - CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_N_CRS_AUX) = CC_SEG_TAN(IAXIS:JAXIS,ICRS) + ! Infamous infinite loop: + INF_LOOP : DO - ! Case of intersection inside segment aligned with SVAR location, i.e. - ! intersection among two bodies or self intersection: - ALGN_CROSS=.FALSE. - DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF ( CC_IS_CRS2(HIGH_IND+1,ICRS) /= CC_SOLID ) CYCLE - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID - ALGN_CROSS=.TRUE. - EXIT - ENDDO - IF ( ALGN_CROSS ) CYCLE + FOUNDSEG = .FALSE. + N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. + ANGCOUNT = ANGSEG(NEWSEG) - ! Now figure out the type of crossing: - NOT_COUNTED = .TRUE. - NCRS_REMAIN = IND_CRS(HIGH_IND,IDCR) - DROP_SS_GG_IF : IF (DROP_SS_GG) THEN + ! Find Segment starting on Node 2 with smaller ANGSEG respect to COUNT. + DANG = -1._EB / GEOMEPS + DO ISS=2,NODEDG_FACE(1,N2COUNT)+1 + ISEG = NODEDG_FACE(ISS,N2COUNT) + IF ( SEG_FLAG(ISEG) ) THEN ! This seg hasn't been added to SEG_FACE2 + ! Drop if seg is the opposite of count seg, only when 2nd node is connected to more than 2 segments: + IF ( (SEG_FACE2(NOD1,COUNT)==SEG_FACE(NOD2,ISEG)) .AND. (NUMEDG_NODE(N2COUNT)>2) ) CYCLE + DANGI = ANGSEG(ISEG) - ANGCOUNT + IF ( DANGI < 0._EB ) DANGI = DANGI + 2._EB * PI + IF ( DANGI > DANG ) THEN + NEWSEG = ISEG + DANG = DANGI + FOUNDSEG = .TRUE. + ENDIF + ENDIF + ENDDO - ! Points of the same type are collapsed: - USE_INT_POINT(IND_CRS(LOW_IND,IDCR)+1:IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR)) = .TRUE. - DO ICRS1 = IND_CRS(LOW_IND,IDCR)+1, IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) ! Pivot Loop - IF(.NOT.USE_INT_POINT(ICRS1)) CYCLE ! Don't use collapsed point as pivot. - DO ICRS2 = IND_CRS(LOW_IND,IDCR)+1, IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF( (ICRS2==ICRS1) .OR. .NOT.USE_INT_POINT(ICRS2) ) CYCLE ! Don't use pivot, or collapsed point. - IF( (CC_IS_CRS2(LOW_IND ,ICRS1) == CC_IS_CRS2(LOW_IND ,ICRS2)) .AND. & - (CC_IS_CRS2(HIGH_IND,ICRS1) == CC_IS_CRS2(HIGH_IND,ICRS2)) .AND. & - (BODNUM(ICRS1) == BODNUM(ICRS2)) ) USE_INT_POINT(ICRS2) = .FALSE. - ENDDO - ENDDO + ! Found a seg add to SEG_FACE2: + IF ( FOUNDSEG ) THEN + COUNT = COUNT + 1 + SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG),SEG_FACE(NOD2,NEWSEG),ICF,NEWSEG /) + SEG_FLAG(NEWSEG) = .FALSE. + NSEG_LEFT = NSEG_LEFT - 1 + ENDIF - ! Left Side: - FOUND_LEFT = .FALSE. - IND_LEFT = 0 - IND_RIGHT = 0 - DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - ! Case crossing type GG or SS, drop: - IF (CC_IS_CRS2(LOW_IND,ICRS) == CC_IS_CRS2(HIGH_IND,ICRS)) CYCLE - ! Case collapsed point, drop: - IF (.NOT.USE_INT_POINT(ICRS)) CYCLE + ! Test if line has closed on point shared any other cutface: + IF ( SEG_FACE2(NOD2,COUNT) == SEG_FACE2(NOD1,CTSTART) ) THEN + ! Go for new cut-face on this Cartesian face. + ELSEIF ( FOUNDSEG ) THEN + CYCLE + ENDIF - IND_LEFT = IND_LEFT + CC_IS_CRS2(LOW_IND,ICRS) - IND_RIGHT = IND_RIGHT + CC_IS_CRS2(HIGH_IND,ICRS) - ENDDO + ! Break loop: + IF ( NSEG_LEFT == 0 ) EXIT - IF (IND_LEFT /= 0) IND_LEFT = SIGN(1,IND_LEFT) - IF (IND_RIGHT /= 0) IND_RIGHT = SIGN(1,IND_RIGHT) + ! Start a new cut-face on this Cartesian face: + ICF = ICF + 1 + DO ISEG=1,NSEG + IF ( SEG_FLAG(ISEG) ) THEN + COUNT = COUNT + 1 + CTSTART= COUNT + SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,ISEG), SEG_FACE(NOD2,ISEG), ICF, ISEG /) + SEG_FLAG(ISEG) = .FALSE. + NSEG_LEFT = NSEG_LEFT - 1 + EXIT + ENDIF + ENDDO - IF ( (IDCR>1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN - ! Test if we are inside an Object. - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID; ! GS or SG. + ENDDO INF_LOOP - ELSEIF (ABS(IND_LEFT)+ABS(IND_RIGHT) == 0) THEN ! Same number of SG and GS crossings, - ! both sides of the crossing - ! defined as left_media: - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = LEFT_MEDIA - ELSEIF (IND_LEFT == LEFT_MEDIA) THEN - CC_IS_CRS2_AUX((/ LOW_IND, HIGH_IND/),CC_N_CRS_AUX) = (/ IND_LEFT, IND_RIGHT /) ! GS or SG. - ELSE - IF (ITITLE==1) THEN - WRITE(LU_ERR,*) "Error GET_X2INTERSECTIONS: DROP_SS_GG = .TRUE., Didn't find left side continuity." - ELSEIF (ITITLE==2) THEN - WRITE(LU_ERR,*) "Error GET_IS_SOLID_PT: DROP_SS_GG = .TRUE., Didn't find left side continuity." - ENDIF - ! WRITE(LU_ERR,*) "BODINT_PLANE, NSGLS, NSEGS=",BODINT_PLANE%NSGLS,BODINT_PLANE%NSEGS - ! WRITE(LU_ERR,*) "X1PLN, X2AXIS, X3AXIS, X3RAY=",X1PLN,X2AXIS,X3AXIS,X3RAY - ! WRITE(LU_ERR,*) "CC_N_CRS=",CC_N_CRS,", IDCR=",IDCR - ! WRITE(LU_ERR,*) ICRS,"IND_LEFT=",IND_LEFT,", IND_RIGHT=",IND_RIGHT - ! WRITE(LU_ERR,*) "CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS)",CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) - ! DO IAUX=1,CC_N_CRS - ! WRITE(LU_ERR,*) IAUX,CRS_NUM(CC_N_CRS),IND_LEFT,IND_RIGHT,CC_SVAR_CRS(IND_CRS(LOW_IND,IAUX)+1) - ! ENDDO - ! WRITE(LU_ERR,*) ' ' - ! CALL DEBUG_WAIT - ENDIF - LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) + ! Load ordered nodes to CFELEM: + NFACE = ICF + ! Reallocate CFELEM ARRAY if necessary: + CALL REALLOCATE_LOCAL_CFELEM(NSEG,NFACE) + CFELEM(:,:) = CC_UNDEFINED; CEDGES(:,:) = CC_UNDEFINED + DO ICF=1,NFACE + NP = 0 + DO ISEG=1,NSEG + IF ( SEG_FACE2(NOD3,ISEG) == ICF ) THEN + NP = NP + 1 + CFELEM(1,ICF) = NP + CFELEM(NP+1,ICF) = SEG_FACE2(NOD1,ISEG) + CEDGES(1,ICF) = CFELEM(1,ICF); CEDGES(NP+1,ICF) = SEG_FACE2(NOD3+1,ISEG) ! Index in SEG_FACE. + ENDIF + ENDDO + ENDDO - ELSE ! Intersections are either GG or SS + ALLOCATE(CFELEM2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CFELEM2 = CC_UNDEFINED + ALLOCATE(CEDGES2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CEDGES2 = CC_UNDEFINED + NP=0 + DO ICF=1,NFACE + IF(CFELEM(1,ICF)>2) THEN + NP=NP+1 + CFELEM2(:,NP) = CFELEM(:,ICF) + CEDGES2(:,NP) = CEDGES(:,ICF) + ENDIF + ENDDO + CALL MOVE_ALLOC(FROM=CFELEM2,TO=CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES2,TO=CEDGES) + NFACE = NP - ! Left side: - FOUND_LEFT = .FALSE. - DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + ! Compute area and Centroid, in local x1, x2, x3 coords: + ALLOCATE(DROPFACE(1:NFACE)); DROPFACE=.FALSE. + AREAV(1:NFACE) = 0._EB + XYZCEN(IAXIS:KAXIS,1:NFACE) = 0._EB + INXAREA(IAXIS:KAXIS,1:NFACE) = 0._EB + INXSQAREA(IAXIS:KAXIS,1:NFACE) = 0._EB + DO ICF=1,NFACE + NP = CFELEM(1,ICF) + DO IPT=2,NP+1 + ICF_PT = CFELEM(IPT,ICF) + ! Define closed Polygon centered in First Point: + XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & + XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) + ENDDO + ICF_PT = CFELEM(2,ICF) + XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & + XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) - ! Case GG or SS with CC_IS_CRS2(LOW_IND,ICRS) == LEFT_MEDIA: - ! This collapses all types SS or GG that have the left side - ! type. Note they should all be one type (either GG or SS): - IF (CC_IS_CRS2(LOW_IND,ICRS) == LEFT_MEDIA) THEN - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) - NOT_COUNTED(ICRS) = .FALSE. - NCRS_REMAIN = NCRS_REMAIN-1 - FOUND_LEFT = .TRUE. - ENDIF - ENDDO + ! Get Area and Centroid properties of Cut-face: + AREA = 0._EB + DO II2=1,NP + AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & + XY(JAXIS,II2) * XY(IAXIS,II2+1) ) + ENDDO + AREA = AREA / 2._EB + IF ( (AREA1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN - ! Test if we are inside an Object. - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID - LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) - CYCLE - ENDIF + IF ( ABS(AREA) < TWENTY_EPSILON_EB ) THEN + AREA = TWENTY_EPSILON_EB + ! Now Centroids, arithmetic average of nodes positions: + ! In x2: + CX2 = 0._EB; DO II2=1,NP; CX2 = CX2 + XY(IAXIS,II2); ENDDO + CX2 = CX2 / REAL(NP,EB) + ! In x3: + CX3 = 0._EB; DO II2=1,NP; CX3 = CX3 + XY(JAXIS,II2); ENDDO + CX3 = CX3 / REAL(NP,EB) + ELSE + ! Now Centroids, use formula for non-convex polygons: + ! In x2: + CX2 = 0._EB + DO II2=1,NP + CX2 = CX2 + ( XY(IAXIS,II2)+XY(IAXIS,II2+1)) * ( XY(IAXIS,II2)*XY(JAXIS,II2+1) - & + XY(JAXIS,II2)*XY(IAXIS,II2+1) ) + ENDDO + CX2 = CX2 / (6._EB * AREA) + XYZVERT(X2AXIS,CFELEM(2,ICF)) + ! In x3: + CX3 = 0._EB + DO II2=1,NP + CX3 = CX3 + ( XY(JAXIS,II2)+XY(JAXIS,II2+1)) * ( XY(IAXIS,II2)*XY(JAXIS,II2+1) - & + XY(JAXIS,II2)*XY(IAXIS,II2+1) ) + ENDDO + CX3 = CX3 / (6._EB * AREA) + XYZVERT(X3AXIS,CFELEM(2,ICF)) + ENDIF - IF (.NOT.FOUND_LEFT) print*, "Error GET_X2INTERSECTIONS: DROP_SS_GG = .FALSE., Didn't find left side continuity." - IF ( NCRS_REMAIN /= 0) print*, "Error GET_X2INTERSECTIONS: DROP_SS_GG = .FALSE., NCRS_REMAIN /= 0." + ! Add to cut-face: + AREAV(ICF) = AREA + XYZCEN((/IAXIS,JAXIS,KAXIS/),ICF) = (/ X1FACE(II), CX2, CX3 /) - LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) + ! Fields for cut-cell volume/centroid computation: + ! dot(e1,nc)*int(x1)dA, where x=x1face(ii) constant and nc=e1: + INXAREA(IAXIS,ICF) = 1._EB * X1FACE(II) * AREA + INXAREA(JAXIS,ICF) = 0._EB + INXAREA(KAXIS,ICF) = 0._EB + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(IAXIS,ICF) = 1._EB * X1FACE(II)**2._EB * AREA + ! dot(e2,nc)*int(x2^2)dA, where nc=e1 => dot(e2,nc)=0: + INXSQAREA(JAXIS,ICF) = 0._EB + ! dot(e3,nc)*int(x3^2)dA, where nc=e1 => dot(e3,nc)=0: + INXSQAREA(KAXIS,ICF) = 0._EB - ENDIF DROP_SS_GG_IF + ENDDO -ENDDO IDCR_DO_2 + ALLOCATE(CFELEM2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CFELEM2 = CC_UNDEFINED + ALLOCATE(CEDGES2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CEDGES2 = CC_UNDEFINED + NP=0 + DO ICF=1,NFACE + IF(.NOT.DROPFACE(ICF)) THEN + NP=NP+1 + CFELEM2(:,NP) = CFELEM(:,ICF) + CEDGES2(:,NP) = CEDGES(:,ICF) + ENDIF + ENDDO + CALL MOVE_ALLOC(FROM=CFELEM2,TO=CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES2,TO=CEDGES) + DEALLOCATE(DROPFACE) + IF (NP==0) THEN + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID + CYCLE + ENDIF + NFACE = NP -! Copy final results: -CC_N_CRS = CC_N_CRS_AUX -CC_SVAR_CRS(1:CC_MAXCROSS_X2) = CC_SVAR_CRS_AUX(1:CC_MAXCROSS_X2) -CC_SEG_CRS(1:CC_MAXCROSS_X2) = CC_SEG_CRS_AUX(1:CC_MAXCROSS_X2) -CC_SEG_TAN(IAXIS:JAXIS,1:CC_MAXCROSS_X2) = CC_SEG_TAN_AUX(IAXIS:JAXIS,1:CC_MAXCROSS_X2) -! CC_IS_CRS2(LOW_IND:HIGH_IND,1:CC_MAXCROSS_X2) = CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,1:CC_MAXCROSS_X2) + ! Figure out if a cut-face is completely inside any of the + ! others (that is, it is a hole on the GASPHASE): + FINFACE = 0 + NFACE2 = NFACE + DO ICF1=1,NFACE2 + ! Test that ICF1 has a negative area (case of holes) + AREA1 = AREAV(ICF1) + IF ( AREA1 < -GEOMEPS ) THEN + DO ICF2=1,NFACE2 + ! Drop if same face: + IF ( ICF1 == ICF2 ) CYCLE -DO ICRS=1,CC_N_CRS - CC_IS_CRS(ICRS) = 2*( CC_IS_CRS2_AUX(LOW_IND,ICRS) + 1 ) - CC_IS_CRS2_AUX(HIGH_IND,ICRS) -ENDDO + ! Centroid node for ICF1: + XYC1(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF1 ) ! [x2axis x3axis] -RETURN -END SUBROUTINE COLLAPSE_CROSSINGS + ! Polygon nodes for ICF2: + NP2 = CFELEM(1,ICF2) + DO IPT=2,NP2+1 + ICF_PT = CFELEM(IPT,ICF2) + ! Define closed Polygon: + XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) + ENDDO + CALL TEST_PT_INPOLY(NP2,XY,XYC1,PTSFLAG) -! ------------------------- INSERT_RAY_CROSS ------------------------------------ + IF ( PTSFLAG ) THEN ! Centroid of face 1 inside Face 2. -SUBROUTINE INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + FINFACE(ICF1) = ICF2 + NFACE = NFACE - 1 -REAL(EB), INTENT(IN) :: SVARI, STANI(IAXIS:JAXIS) -INTEGER, INTENT(IN) :: ICRSI(LOW_IND:HIGH_IND+1), SCRSI + ! Redefine areas in case of faces with holes: + AREA2 = AREAV(ICF2) -! Local Variables: -INTEGER :: ICRS, IDUM -REAL(EB), ALLOCATABLE, DIMENSION(:) :: CC_SVAR_CRS_DUM -INTEGER, ALLOCATABLE, DIMENSION(:) :: CC_IS_CRS_DUM,CC_SEG_CRS_DUM,CC_BDNUM_CRS_DUM,CC_BDNUM_CRS_AUX_DUM -INTEGER, ALLOCATABLE, DIMENSION(:,:):: CC_IS_CRS2_DUM -REAL(EB), ALLOCATABLE, DIMENSION(:,:):: CC_SEG_TAN_DUM + ! Area with hole, AREA1 has negative sign: + AREAH = AREA2 + AREA1 + IF (ABS(AREAH) < GEOMEPS) THEN ! Hole of same size as cut-face, drop both. + FINFACE(ICF2) = ICF1 + CYCLE + ENDIF -CC_N_CRS = CC_N_CRS + 1 + ! Centroid with hole: + XYC2(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF2 ) ! [x2axis x3axis] + XYH(1:2) = (AREA1 * XYC1(1:2) + AREA2 * XYC2(1:2)) / AREAH -! Test maximum crossings defined: -IF ( CC_N_CRS > CC_MAXCROSS_X2) THEN - IDUM = CC_MAXCROSS_X2 - CC_MAXCROSS_X2 = IDUM + DELTA_CROSS_X2 - ! Allocate Intersection variables: - ALLOCATE(CC_SVAR_CRS_DUM(CC_MAXCROSS_X2),CC_IS_CRS_DUM(CC_MAXCROSS_X2),CC_SEG_CRS_DUM(CC_MAXCROSS_X2)) - CC_SVAR_CRS_DUM = 1._EB/GEOMEPS; CC_SVAR_CRS_DUM(1:IDUM) = CC_SVAR_CRS(1:IDUM) - CC_IS_CRS_DUM = CC_UNDEFINED; - CC_SEG_CRS_DUM = 0; CC_SEG_CRS_DUM(1:IDUM) = CC_SEG_CRS(1:IDUM) - ALLOCATE(CC_BDNUM_CRS_DUM(0:CC_MAXCROSS_X2),CC_BDNUM_CRS_AUX_DUM(0:CC_MAXCROSS_X2)) - CC_BDNUM_CRS_DUM = 0; CC_BDNUM_CRS_DUM(0:IDUM) = CC_BDNUM_CRS(0:IDUM) - CC_BDNUM_CRS_AUX_DUM= 0; CC_BDNUM_CRS_AUX_DUM(0:IDUM) = CC_BDNUM_CRS_AUX(0:IDUM) - ALLOCATE(CC_IS_CRS2_DUM(LOW_IND:HIGH_IND+1,CC_MAXCROSS_X2),CC_SEG_TAN_DUM(IAXIS:JAXIS,CC_MAXCROSS_X2)) - CC_IS_CRS2_DUM = CC_UNDEFINED; CC_IS_CRS2_DUM(LOW_IND:HIGH_IND+1,1:IDUM) = CC_IS_CRS2(LOW_IND:HIGH_IND+1,1:IDUM) - CC_SEG_TAN_DUM = 0._EB; CC_SEG_TAN_DUM(IAXIS:JAXIS,1:IDUM) = CC_SEG_TAN(IAXIS:JAXIS,1:IDUM) - CALL MOVE_ALLOC(FROM=CC_SVAR_CRS_DUM,TO=CC_SVAR_CRS) - CALL MOVE_ALLOC(FROM=CC_IS_CRS_DUM,TO=CC_IS_CRS) - CALL MOVE_ALLOC(FROM=CC_SEG_CRS_DUM,TO=CC_SEG_CRS) - CALL MOVE_ALLOC(FROM=CC_BDNUM_CRS_DUM,TO=CC_BDNUM_CRS) - CALL MOVE_ALLOC(FROM=CC_BDNUM_CRS_AUX_DUM,TO=CC_BDNUM_CRS_AUX) - CALL MOVE_ALLOC(FROM=CC_IS_CRS2_DUM,TO=CC_IS_CRS2) - CALL MOVE_ALLOC(FROM=CC_SEG_TAN_DUM,TO=CC_SEG_TAN) -ENDIF + ! So ICF2 has the area with hole properties: + AREAV(ICF2) = AREAH + XYZCEN(JAXIS,ICF2) = XYH(IAXIS) + XYZCEN(KAXIS,ICF2) = XYH(JAXIS) -! Add in place, ascending value order: -DO ICRS=1,CC_N_CRS ! The updated CC_N_CRS is for ICRS to reach the - ! initialization value CC_SVAR_CRS(ICRS)=1/GEOMEPS. - IF ( SVARI < CC_SVAR_CRS(ICRS) ) EXIT -ENDDO + ! Other geom variables: + INXAREA(IAXIS:KAXIS,ICF2) = INXAREA(IAXIS:KAXIS,ICF2)+ INXAREA(IAXIS:KAXIS,ICF1) + INXSQAREA(IAXIS:KAXIS,ICF2)=INXSQAREA(IAXIS:KAXIS,ICF2)+INXSQAREA(IAXIS:KAXIS,ICF1) -! Here copy from the back (updated CC_N_CRS) to the ICRS location: -! if ICRS=CC_N_CRS -> nothing gets copied: -DO IDUM = CC_N_CRS,ICRS+1,-1 - CC_SVAR_CRS(IDUM) = CC_SVAR_CRS(IDUM-1) - CC_IS_CRS2(LOW_IND:HIGH_IND+1,IDUM) = CC_IS_CRS2(LOW_IND:HIGH_IND+1,IDUM-1) - CC_SEG_CRS(IDUM) = CC_SEG_CRS(IDUM-1); - CC_SEG_TAN(IAXIS:JAXIS,IDUM)= CC_SEG_TAN(IAXIS:JAXIS,IDUM-1); - CC_BDNUM_CRS(IDUM) = CC_BDNUM_CRS(IDUM-1) -ENDDO + EXIT + ENDIF + ENDDO + ENDIF + ENDDO -CC_SVAR_CRS(ICRS) = SVARI ! x2 location. -CC_IS_CRS2(LOW_IND:HIGH_IND+1,ICRS) = ICRSI(LOW_IND:HIGH_IND+1) ! Does point separate GASPHASE from SOLID? -CC_SEG_CRS(ICRS) = SCRSI ! Segment on BOINT_PLANE the crossing belongs to. -CC_SEG_TAN(IAXIS:JAXIS,ICRS) = STANI(IAXIS:JAXIS) ! CC_SEG_TAN might not be needed in new implementation. -CC_BDNUM_CRS(ICRS) = 0 -IF (SCRSI > 0) THEN - IF(ICRSI(LOW_IND) == CC_GASPHASE .AND. ICRSI(HIGH_IND) == CC_SOLID) THEN - CC_BDNUM_CRS(ICRS) = 1 - ELSEIF(ICRSI(LOW_IND) == CC_SOLID .AND. ICRSI(HIGH_IND) == CC_GASPHASE) THEN - CC_BDNUM_CRS(ICRS) =-1 - ENDIF -ENDIF -RETURN -END SUBROUTINE INSERT_RAY_CROSS + ! Now enhance CFELEM for faces with holes nodes: + DO ICF1=1,NFACE2 + ICF2 = FINFACE(ICF1) + IF ( ICF2 > 0 ) THEN ! Allows for up to one hole per CC_GASPHASE cut-face. + ! Load points + NP1 = CFELEM(1,ICF1) + NP2 = CFELEM(1,ICF2) + NP = (NP1+1) + (NP2+1) -! ----------------------- GET_BODINT_NODE_INDEX ---------------------------------- + ! Here reallocate CFELEM, CEDGES CFE, CFEL if NP > SIZE_VERTS_CFELEM: + CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) + CFE(1) = NP -SUBROUTINE GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ,IND_PI) + DO II2=2,NP1+1 + CFE(II2) = CFELEM(II2,ICF1) + ENDDO + II2 = (NP1+1) + 1 + CFE(II2) = CFELEM(2,ICF1) -TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE -INTEGER, INTENT(IN) :: X2AXIS,X3AXIS -REAL(EB), INTENT(IN) :: XYZ(MAX_DIM) -INTEGER, INTENT(OUT) :: IND_PI + ! Load last point location: + ILOC = 2 + DIST12 = 1._EB / GEOMEPS + XYC1(1:2) = (/ XYZVERT(X2AXIS,CFE(II2)), XYZVERT(X3AXIS,CFE(II2)) /) + DO COUNT=2,NP2+1 + XYC2(1:2) = (/ XYZVERT(X2AXIS,CFELEM(COUNT,ICF2)), XYZVERT(X3AXIS,CFELEM(COUNT,ICF2)) /) + D12 = SQRT( (XYC1(1)-XYC2(1))**2._EB + (XYC1(2)-XYC2(2))**2._EB ) + IF( D12 < DIST12 ) THEN + DIST12 = D12 + ILOC = COUNT + ENDIF + ENDDO + IF (ILOC > 2) THEN + ! Rebuild CFELEM(:,ICF2) such that the first point is ILOC: + CFEL(2:2+(NP2+1)-ILOC) = CFELEM(ILOC:NP2+1,ICF2) + CFEL(3+(NP2+1)-ILOC:NP2+1)= CFELEM(2:ILOC-1 ,ICF2) + CFELEM(2:NP2+1 ,ICF2) = CFEL(2:NP2+1) + CFEL(2:2+(NP2+1)-ILOC) = CEDGES(ILOC:NP2+1,ICF2) + CFEL(3+(NP2+1)-ILOC:NP2+1)= CEDGES(2:ILOC-1 ,ICF2) + CEDGES(2:NP2+1 ,ICF2) = CFEL(2:NP2+1) + ENDIF -! Local variables: -INTEGER :: INOD=1, PIVOT(LOW_IND:HIGH_IND), INOD2 -REAL(EB):: DIFFX2, DIFFX3 + COUNT = 1 + DO II2=(NP1+1)+2,(NP1+1)+1+NP2 + COUNT = COUNT + 1 + CFE(II2) = CFELEM(COUNT,ICF2) + ENDDO + II2 = NP + 1 + CFE(II2) = CFELEM(2,ICF2) -! Test if XYZ is already on BODINT_PLANE%XYZ: -IND_PI = -1 ! Initialize to negative index. -IF (BODINT_PLANE%NNODS < LINSEARCH_LIMIT) THEN - ! Linear Search: - DO INOD=1,BODINT_PLANE%NNODS - DIFFX2 = BODINT_PLANE%XYZ(X2AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X2AXIS) - IF( DIFFX2 > GEOMEPS ) THEN - EXIT - ELSEIF( ABS(DIFFX2) <= GEOMEPS) THEN - DIFFX3 = BODINT_PLANE%XYZ(X3AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X3AXIS) - IF ( DIFFX3 > GEOMEPS ) THEN - EXIT - ELSEIF ( ABS(DIFFX3) <= GEOMEPS ) THEN - IND_PI = BODINT_PLANE%NOD_PERM(INOD) - RETURN - ENDIF - ENDIF - ENDDO -ELSE - ! Binary Search: - PIVOT(LOW_IND) = 0 - PIVOT(HIGH_IND)= BODINT_PLANE%NNODS + 1 - DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) - INOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 - DIFFX2 = BODINT_PLANE%XYZ(X2AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X2AXIS) - IF( DIFFX2 < -GEOMEPS ) THEN - PIVOT(LOW_IND) = INOD - ELSEIF( DIFFX2 > GEOMEPS ) THEN - PIVOT(HIGH_IND)= INOD - ELSE ! ABS(DIFFX2) < GEOMEPS - DIFFX3 = BODINT_PLANE%XYZ(X3AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X3AXIS) - IF ( DIFFX3 < -GEOMEPS ) THEN - PIVOT(LOW_IND) = INOD - ELSEIF( DIFFX3 > GEOMEPS ) THEN - PIVOT(HIGH_IND)= INOD - ELSE ! ABS(DIFFX3) < GEOMEPS - IND_PI = BODINT_PLANE%NOD_PERM(INOD) - RETURN - ENDIF - ENDIF - ENDDO - INOD=PIVOT(HIGH_IND) -ENDIF + ! Copy CFE into CFELEM(1:np+1,icf2): + CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) -! Insert add NOD_PERM permutation array, O(NP) operation: -DO INOD2=BODINT_PLANE%NNODS+1,INOD+1,-1 - BODINT_PLANE%NOD_PERM(INOD2) = BODINT_PLANE%NOD_PERM(INOD2-1) -ENDDO -IND_PI = BODINT_PLANE%NNODS + 1 -BODINT_PLANE%NNODS = IND_PI -BODINT_PLANE%NOD_PERM(INOD) = IND_PI -BODINT_PLANE%XYZ(IAXIS:KAXIS,IND_PI) = XYZ(IAXIS:KAXIS) + ! Rearrange CEDGES + CFEL(1) = NP + CFEL(2:NP1+1) = CEDGES(2:NP1+1,ICF1) + CFEL(NP1+2) = 0 ! ENTRY 0 in EDGE_LIST, EDGE inside the SOLID. + CFEL(NP1+3:NP1+2+NP2)= CEDGES(2:NP2+1,ICF2) + CFEL(NP+1) = 0 ! ENTRY 0 in EDGE_LIST, EDGE inside the SOLID. + CEDGES(1:NP+1,ICF2) = CFEL(1:NP+1) -RETURN -END SUBROUTINE GET_BODINT_NODE_INDEX + ENDIF + ENDDO + NVERTFACE = MAXVAL(CFELEM(1,1:NFACE)) + 1 -! ---------------------- GET_BODINT_NODE_INDEX ---------------------------------- + ! This is a cut-face, allocate space: + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (BNDINT_FLAG) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCF,X1AXIS) = NCUTFACE -! SUBROUTINE GET_BODINT_NODE_INDEX(X2AXIS,X3AXIS,XYZ,IND_PI) -! -! INTEGER, INTENT(IN) :: X2AXIS,X3AXIS -! REAL(EB), INTENT(IN) :: XYZ(MAX_DIM) -! INTEGER, INTENT(OUT) :: IND_PI -! -! ! Local variables: -! !LOGICAL :: INLIST -! INTEGER :: INOD -! -! ! Test if XYZ is already on BODINT_PLANE%XYZ: -! ! INLIST = .FALSE. -! IND_PI = -1 ! Initialize to negative index. -! DO INOD=1,BODINT_PLANE%NNODS -! IF(ABS(BODINT_PLANE%XYZ(X2AXIS,INOD)-XYZ(X2AXIS)) > GEOMEPS) CYCLE -! IF(ABS(BODINT_PLANE%XYZ(X3AXIS,INOD)-XYZ(X3AXIS)) > GEOMEPS) CYCLE -! IND_PI = INOD -! RETURN -! ENDDO -! -! WRITE(LU_ERR,*) 'X2AXIS,X3AXIS',X2AXIS,X3AXIS,BODINT_PLANE%NNODS,INOD -! IND_PI = BODINT_PLANE%NNODS + 1 -! BODINT_PLANE%NNODS = IND_PI -! BODINT_PLANE%XYZ(IAXIS:KAXIS,IND_PI) = XYZ -! DO INOD=1,BODINT_PLANE%NNODS -! WRITE(LU_ERR,*) INOD,BODINT_PLANE%XYZ(IAXIS:KAXIS,INOD) -! ENDDO -! RETURN -! END SUBROUTINE GET_BODINT_NODE_INDEX + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ INDI, INDJ, INDK, X1AXIS /) + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE,IBNDINT) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) + ALLOCATE(CF%EDGE_LIST(3,0:NSEG)); + CF%EDGE_LIST( : , 0) = CC_UNDEFINED ! Segment inside the solid volume. + CF%EDGE_LIST(1:3,1:NSEG) = SEG_FACE(3:5,1:NSEG) + ALLOCATE(CF%CEDGES(SIZE(CEDGES,DIM=1),SIZE(CEDGES,DIM=2))) + CF%CEDGES = CC_UNDEFINED + ! Load Ordered nodes to CFELEM and geom properties: + COUNT = 0 + DO ICF=1,NFACE2 + IF ( FINFACE(ICF) > 0 ) CYCLE ! icf is a hole on another cut-face. + COUNT = COUNT + 1 + ! Connectivity: + CF%CFELEM(1:NVERTFACE,COUNT) = CFELEM(1:NVERTFACE, ICF) + CF%CEDGES(1:NVERTFACE,COUNT) = CEDGES(1:NVERTFACE, ICF) + ! Geom Properties: + CF%AREA(COUNT) = AREAV(ICF) + CF%XYZCEN(IAXIS:KAXIS,COUNT) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,ICF) + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: + CF%INXAREA(COUNT) = INXAREA(XIAXIS,ICF) + ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: + CF%INXSQAREA(COUNT) = INXSQAREA(XIAXIS,ICF) + ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: + CF%JNYSQAREA(COUNT) = INXSQAREA(XJAXIS,ICF) + ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: + CF%KNZSQAREA(COUNT) = INXSQAREA(XKAXIS,ICF) + ENDDO + ! Final number of cut-faces in the gas region of the face: + NFACE = COUNT + CF%NFACE = NFACE -! -------------------- LINE_INTERSECT_COORDPLANE -------------------------------- + ! ! Test that cut-edge nodes in EDGE list match nodes defined in CF XYZVERT: + ! IIF= CF%IJK(IAXIS) + ! JJF= CF%IJK(JAXIS) + ! KKF= CF%IJK(KAXIS) + ! DO ICF = 1, CF%NFACE + ! DO ISEG=1,CF%CEDGES(1,ICF) + ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) + ! IF (ISEGGEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN + ! WRITE(LU_ERR,*) 'Found difference in RGGAS SEGMENT=',NCUTFACE,ICF,ISEG,':',X1AXIS,AXIS,SIDE + ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) + ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) + ! ENDIF + ! CASE(CC_ETYPE_CFGAS) + ! IEC=CF%EDGE_LIST(2,IEDGE); JEC=CF%EDGE_LIST(3,IEDGE) + ! INOD1 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(1,JEC) + ! INOD2 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(2,JEC) + ! CEIJK(1:4) = MESHES(NM)%CUT_EDGE(IEC)%IJK(1:4) + ! SELECT CASE(X1AXIS) + ! CASE(IAXIS) + ! IF (CEIJK(4)==JAXIS) THEN + ! IF(CEIJK(KAXIS)==KKF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ELSEIF(CEIJK(KAXIS)==KKF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ENDIF + ! ELSEIF(CEIJK(4)==KAXIS) THEN + ! IF(CEIJK(JAXIS)==JJF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ELSEIF(CEIJK(JAXIS)==JJF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ENDIF + ! ENDIF + ! CASE(JAXIS) + ! IF (CEIJK(4)==IAXIS) THEN + ! IF(CEIJK(KAXIS)==KKF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ELSEIF(CEIJK(KAXIS)==KKF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ENDIF + ! ELSEIF(CEIJK(4)==KAXIS) THEN + ! IF(CEIJK(IAXIS)==IIF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ELSEIF(CEIJK(IAXIS)==IIF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ENDIF + ! ENDIF + ! CASE(KAXIS) + ! IF (CEIJK(4)==IAXIS) THEN + ! IF(CEIJK(JAXIS)==JJF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ELSEIF(CEIJK(JAXIS)==JJF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ENDIF + ! ELSEIF(CEIJK(4)==JAXIS) THEN + ! IF(CEIJK(IAXIS)==IIF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ELSEIF(CEIJK(IAXIS)==IIF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ENDIF + ! ENDIF + ! END SELECT + ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN + ! WRITE(LU_ERR,*) 'Found difference in CFGAS SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC + ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) + ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) + ! ENDIF + ! CASE(CC_ETYPE_CFINB) + ! IEC=CF%EDGE_LIST(2,IEDGE); JEC=CF%EDGE_LIST(3,IEDGE) + ! INOD1 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(1,JEC) + ! INOD2 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(2,JEC) + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! IF(NORM2(X1E-X1V)>GEOMEPS) THEN + ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT + ! ENDIF + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN + ! WRITE(LU_ERR,*) 'CARTF Found difference in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC + ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) + ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) + ! ENDIF + ! END SELECT + ! ENDDO + ! ENDDO -SUBROUTINE LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LNC,XYZ_INT,INTFLG) + ! HERE WE LOAD CARTESIAN CUT FACES THAT BELONG TO THE SOLID REGION, FOR SLICE PLOTTING + ! PURPOSES: + ! ------------------------------------------------------------------------------------ + SOLID_FACE_IF : IF (GET_SOLID_CUTFACES) THEN + ! Build segment list: + NSSEG = 0 + NSVERT = 0 + NSFACE = 0 -INTEGER, INTENT(IN) :: X1AXIS -REAL(EB), INTENT(IN) :: X1PLN,PLNORMAL(MAX_DIM),LNC(MAX_DIM,NOD1:NOD2) -REAL(EB), INTENT(OUT):: XYZ_INT(MAX_DIM) -LOGICAL, INTENT(OUT) :: INTFLG + SEG_FACE (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED + XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) = 0._EB + ANGSEG(1:CC_MAXCEELEM_FACE) = 0._EB -! Local variables: -REAL(EB) :: DVEC(MAX_DIM), DIRV(MAX_DIM), NMDV, DENOM, PLNEQ, TLINE -! REAL(QB) :: DVECQ(MAX_DIM), DIRVQ(MAX_DIM), NMDVQ, DENOMQ, PLNEQQ, TLINEQ + ! First Add to vertex list INBOUNDARY vertices and SOLID Cartesian vertices: + CEI = MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) + IF ( CEI > 0 ) THEN ! There are inboundary cut-edges + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + ! Here we use the SOLID orientation NOD1:NOD2 for right hand rule (inverse of GASPHASE cut-faces) + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) -! Initialize: -INTFLG = .FALSE. -XYZ_INT(IAXIS:KAXIS) = 0._EB + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD2,XYZVERT) -! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN -! Preliminary calculations: -DVEC(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD2) - LNC(IAXIS:KAXIS,NOD1) -NMDV = SQRT( DVEC(IAXIS)**2._EB + DVEC(JAXIS)**2._EB + DVEC(KAXIS)**2._EB ) -DIRV = DVEC(IAXIS:KAXIS) * NMDV**(-1._EB) -DENOM = DIRV(IAXIS)*PLNORMAL(IAXIS) +DIRV(JAXIS)*PLNORMAL(JAXIS) +DIRV(KAXIS)*PLNORMAL(KAXIS) -PLNEQ = LNC(IAXIS,NOD1)*PLNORMAL(IAXIS) + & - LNC(JAXIS,NOD1)*PLNORMAL(JAXIS) + & - LNC(KAXIS,NOD1)*PLNORMAL(KAXIS) - X1PLN + ! ADD segment: + NSSEG = NSSEG + 1 + SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ INOD1, INOD2 /) + DX3 = XYZVERT(X3AXIS,INOD2)-XYZVERT(X3AXIS,INOD1) + DX2 = XYZVERT(X2AXIS,INOD2)-XYZVERT(X2AXIS,INOD1) + ANGSEG(NSSEG) = ATAN2(DX3,DX2) -! Line parallel to plane: -IF ( ABS(DENOM) < GEOMEPS ) THEN - ! Check if seg lies on plane or not. - ! Do this by checking if node one of segment is on plane. - IF ( ABS(PLNEQ) < GEOMEPS ) THEN - XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1); XYZ_INT(X1AXIS) = X1PLN - INTFLG = .TRUE. - ENDIF - RETURN -ENDIF + ENDDO + ENDIF -! Non parallel case: -TLINE = -PLNEQ/DENOM ! Coordinate along the line LNC. -XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1) + TLINE*DIRV(IAXIS:KAXIS) ! Intersection point. -XYZ_INT(X1AXIS) = X1PLN ! Force X1AXIS coordinate to be the planes value. -! ELSE -! ! Preliminary calculations: -! DVECQ(IAXIS:KAXIS) = REAL(LNC(IAXIS:KAXIS,NOD2),QB) - REAL(LNC(IAXIS:KAXIS,NOD1),QB) -! NMDVQ = SQRT( DVECQ(IAXIS)**2._QB + DVECQ(JAXIS)**2._QB + DVECQ(KAXIS)**2._QB ) -! DIRVQ = DVECQ(IAXIS:KAXIS) * NMDVQ**(-1._QB) -! DENOMQ = DIRVQ(IAXIS)*REAL(PLNORMAL(IAXIS),QB) + & -! DIRVQ(JAXIS)*REAL(PLNORMAL(JAXIS),QB) + & -! DIRVQ(KAXIS)*REAL(PLNORMAL(KAXIS),QB) -! PLNEQQ = REAL(LNC(IAXIS,NOD1),QB)*REAL(PLNORMAL(IAXIS),QB) + & -! REAL(LNC(JAXIS,NOD1),QB)*REAL(PLNORMAL(JAXIS),QB) + & -! REAL(LNC(KAXIS,NOD1),QB)*REAL(PLNORMAL(KAXIS),QB) - REAL(X1PLN,QB) -! -! ! Line parallel to plane: -! IF ( ABS(REAL(DENOMQ,EB)) < GEOMEPS ) THEN -! ! Check if seg lies on plane or not. -! ! Do this by checking if node one of segment is on plane. -! IF ( ABS(REAL(PLNEQ,EB)) < GEOMEPS ) THEN -! XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1); XYZ_INT(X1AXIS) = X1PLN -! INTFLG = .TRUE. -! ENDIF -! RETURN -! ENDIF -! -! ! Non parallel case: -! TLINEQ = -PLNEQQ/DENOMQ ! Coordinate along the line LNC. -! XYZ_INT(IAXIS:KAXIS) = REAL(REAL(LNC(IAXIS:KAXIS,NOD1),QB)+TLINEQ*DIRVQ(IAXIS:KAXIS),EB) ! Intersection pt. -! XYZ_INT(X1AXIS) = X1PLN ! Force X1AXIS coordinate to be the planes value. -! ENDIF + ! Now add CC_SOLID Type vertices: + ! Vertex at index JJ-1,KK-1: + INDXI1(IAXIS:KAXIS) = (/ II, JJ-1, KK-1 /) ! Local x1,x2,x3 + INDI1 = INDXI1(XIAXIS) + INDJ1 = INDXI1(XJAXIS) + INDK1 = INDXI1(XKAXIS) + ! Vertex at index JJ,KK-1: + INDXI2(IAXIS:KAXIS) = (/ II, JJ , KK-1 /) ! Local x1,x2,x3 + INDI2 = INDXI2(XIAXIS) + INDJ2 = INDXI2(XJAXIS) + INDK2 = INDXI2(XKAXIS) + ! Vertex at index JJ,KK: + INDXI3(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 + INDI3 = INDXI3(XIAXIS) + INDJ3 = INDXI3(XJAXIS) + INDK3 = INDXI3(XKAXIS) + ! Vertex at index JJ-1,KK: + INDXI4(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 + INDI4 = INDXI4(XIAXIS) + INDJ4 = INDXI4(XJAXIS) + INDK4 = INDXI4(XKAXIS) -INTFLG = .TRUE. + IF(MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID ) THEN + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI1(IAXIS)), X2FACE(INDXI1(JAXIS)), X3FACE(INDXI1(KAXIS)) /) + X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) + ENDIF -RETURN -END SUBROUTINE LINE_INTERSECT_COORDPLANE + IF(MESHES(NM)%VERTVAR(INDI2,INDJ2,INDK2,CC_VGSC) == CC_SOLID ) THEN + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI2(IAXIS)), X2FACE(INDXI2(JAXIS)), X3FACE(INDXI2(KAXIS)) /) + X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) + ENDIF + IF(MESHES(NM)%VERTVAR(INDI3,INDJ3,INDK3,CC_VGSC) == CC_SOLID ) THEN + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI3(IAXIS)), X2FACE(INDXI3(JAXIS)), X3FACE(INDXI3(KAXIS)) /) + X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) + ENDIF -! ------------------------- CC_INIT_GEOM --------------------------------------- + IF(MESHES(NM)%VERTVAR(INDI4,INDJ4,INDK4,CC_VGSC) == CC_SOLID ) THEN + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI4(IAXIS)), X2FACE(INDXI4(JAXIS)), X3FACE(INDXI4(KAXIS)) /) + X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) + ENDIF -SUBROUTINE CC_INIT_GEOM + ! Make List of HIGH X2 vertices, in ascending X3 order. Add segments: + ASCDESC=.TRUE. + XVERT1(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) + XVERT2(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) + CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X2FACE(JJ),ASCDESC,NV,V) + DO IV=1,NV-1 + NSSEG=NSSEG + 1 + SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) + ANGSEG(NSSEG) = PI / 2._EB + ENDDO -! Local Variables: -INTEGER :: IG, IWSEL, INOD, IEDGE, NVERT, NWSEL, NWSEDG, IEDLIST, IX, N_TENT_EDGES -INTEGER :: WSELEM(NOD1:NOD3),SEG(NOD1:NOD2) -REAL(EB):: XYZV(MAX_DIM,NODS_WSEL), V12(MAX_DIM), V23(MAX_DIM), V31(MAX_DIM), WSNORM(MAX_DIM) -REAL(EB):: X12(MAX_DIM), X23(MAX_DIM), X31(MAX_DIM), SQAREA(MAX_DIM), INT2 -REAL(EB):: MGNRM, XCEN -REAL(EB):: GEOMEPSSQ ! Local epsilon for GEOM quality check -INTEGER, ALLOCATABLE, DIMENSION(:,:):: EDGES2 -LOGICAL, ALLOCATABLE, DIMENSION(:) :: COUNTED_VERT -! REAL(QB) :: V12Q(IAXIS:KAXIS),V23Q(IAXIS:KAXIS),V31Q(IAXIS:KAXIS),WSNORMQ(IAXIS:KAXIS),MGNRMQ + ! Make list of HIGH X3 vertices, in descending X2 order. Add segments: + ASCDESC=.FALSE. + XVERT1(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) + XVERT2(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) + CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X3FACE(KK),ASCDESC,NV,V) + DO IV=1,NV-1 + NSSEG=NSSEG + 1 + SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) + ANGSEG(NSSEG) = PI + ENDDO -REAL(EB) :: CPUTIME_START, CPUTIME + ! Make list of LOW X2 vertices, in descending X3 order. Add segments: + ASCDESC=.FALSE. + XVERT1(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) + XVERT2(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) + CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X2FACE(JJ-1),ASCDESC,NV,V) + DO IV=1,NV-1 + NSSEG=NSSEG + 1 + SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) + ANGSEG(NSSEG) = - PI / 2._EB + ENDDO -IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_ERR,'(A,I5,A)',advance="no") ' 1b. Number of Geometries : ',N_GEOMETRY,& - ', CC_INIT_GEOM, processed GEOMETRY : ' -ENDIF + ! Make list of LOW X3 vertices, in ascending X2 order. Add segments: + ASCDESC=.TRUE. + XVERT1(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) + XVERT2(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) + CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X3FACE(KK-1),ASCDESC,NV,V) + DO IV=1,NV-1 + NSSEG=NSSEG + 1 + SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) + ANGSEG(NSSEG) = 0._EB + ENDDO -! In this subroutine the quality of the GEOM lines is checked -! Calc local squared epsilon for GEOM quality check -GEOMEPSSQ = (GEOMEPS * GEOMQUALITYFCT)**2._EB + ! Use list of segments on gasphase region from CUT_EDGE: + ! These are to discard from SEGS computed before: + COUNT=0 + SEG_FACEAUX(NOD1:NOD2,1:NSSEG) = SEG_FACE(NOD1:NOD2,1:NSSEG) + ANGSEGAUX(1:NSSEG)=ANGSEG(1:NSSEG) + SEG_FLAG(1:NSSEG) = .FALSE. + OUTER : DO ISEG=1,NSSEG + ! Test against GASPHASE segments: + INNER1 : DO ISEG2=1,NSEG_CART + SNOD1(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG) + SNOD2(NOD1:NOD2)= SEG_FACE_CART(NOD1:NOD2,ISEG2) + XYZ_SEG1(IAXIS:KAXIS,NOD1:NOD2) = XYZVERT(IAXIS:KAXIS,SNOD1(NOD1:NOD2)) + XYZ_SEG2(IAXIS:KAXIS,NOD1:NOD2) = XYZVERT_CART(IAXIS:KAXIS,SNOD2(NOD1:NOD2)) + ! Test for possible node combination: + DO INOD=1,4 + INOD1=NODC1(INOD) ! [ 1 2 1 2 ] + INOD2=NODC2(INOD) ! [ 1 2 2 1] + DIFF(INOD) = SQRT((XYZ_SEG1(IAXIS,INOD1)-XYZ_SEG2(IAXIS,INOD2))**2._EB + & + (XYZ_SEG1(JAXIS,INOD1)-XYZ_SEG2(JAXIS,INOD2))**2._EB + & + (XYZ_SEG1(KAXIS,INOD1)-XYZ_SEG2(KAXIS,INOD2))**2._EB ) < GEOMEPS + ENDDO + IF(DIFF(1) .AND. DIFF(2)) SEG_FLAG(ISEG)=.TRUE. ! Nodes of two segs coincide, its a GASPHASE segment. + IF(DIFF(3) .AND. DIFF(4)) SEG_FLAG(ISEG)=.TRUE. ! Nodes of two segs coincide, its a GASPHASE segment. + ENDDO INNER1 + ! Test against itself: + INNER2 : DO ISEG2=1,NSSEG + IF (ISEG==ISEG2) CYCLE + SNOD1(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG) + SNOD2(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG2) + IF(SNOD1(NOD1)==SNOD2(NOD2) .AND. SNOD1(NOD2)==SNOD2(NOD1)) SEG_FLAG(ISEG)=.TRUE. + ENDDO INNER2 + ENDDO OUTER + DO ISEG=1,NSSEG + IF(SEG_FLAG(ISEG)) CYCLE + COUNT=COUNT+1 + SEG_FACE(NOD1:NOD2,COUNT)=SEG_FACEAUX(NOD1:NOD2,ISEG) + ANGSEG(COUNT) = ANGSEGAUX(ISEG) + ENDDO -! Geometry loop: -GEOMETRY_LOOP : DO IG=1,N_GEOMETRY + NSSEG=COUNT - NWSEL = GEOMETRY(IG)%N_FACES - NVERT = GEOMETRY(IG)%N_VERTS + ! Build Solid side faces: + NOTDONE = .TRUE. + DO WHILE(NOTDONE) + NOTDONE = .FALSE. + ! Counts edges that reach nodes: + NUMEDG_NODE(1:CC_MAXVERTS_FACE) = 0 + DO ISEG=1,NSSEG + DO II2=NOD1,NOD2 + INOD = SEG_FACE(II2,ISEG) + NUMEDG_NODE(INOD) = NUMEDG_NODE(INOD) + 1 + ENDDO + ENDDO - IF (GEOMETRY(IG)%IS_TERRAIN) THEN ! Terrain is always manifold with volume. - N_TENT_EDGES = INT(1.55_EB*REAL(NWSEL,EB)) ! Number of edges is 1.5 number of triangles. - ELSE - N_TENT_EDGES = 3*NWSEL - ENDIF + ! Drop segments with NUMEDG_NODE(INOD)=1: + ! The assumption here is that they are CC_SS CC_INBOUNDCF + ! segments with one node inside the Cartface i.e. case Fig + ! 9(a) in the CompGeom3D notes): + COUNT = 0 + SEG_FACEAUX (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED + ANGSEGAUX(1:CC_MAXCEELEM_FACE) = 0._EB + DO ISEG=1,NSSEG + NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) + NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) + IF ((NUMNOD1 > 1) .AND. (NUMNOD2 > 1)) THEN + COUNT = COUNT + 1 + SEG_FACEAUX(NOD1:NOD2,COUNT) = SEG_FACE(NOD1:NOD2,ISEG) + ANGSEGAUX(COUNT) = ANGSEG(ISEG) + ELSE + NOTDONE = .TRUE. + ENDIF + ENDDO + NSSEG = COUNT + SEG_FACE = SEG_FACEAUX + ANGSEG = ANGSEGAUX + ENDDO - ! Allocate fields of Geometry used by IBM: - ! WS Faces normal unit vectors: - IF (ALLOCATED(GEOMETRY(IG)%FACES_NORMAL)) DEALLOCATE(GEOMETRY(IG)%FACES_NORMAL) - ALLOCATE(GEOMETRY(IG)%FACES_NORMAL(MAX_DIM,NWSEL)) - ! WS Faces areas: - IF (ALLOCATED(GEOMETRY(IG)%FACES_AREA)) DEALLOCATE(GEOMETRY(IG)%FACES_AREA) - ALLOCATE(GEOMETRY(IG)%FACES_AREA(NWSEL)) - ! WS Faces edges: - IF (ALLOCATED(GEOMETRY(IG)%EDGES)) DEALLOCATE(GEOMETRY(IG)%EDGES) - ALLOCATE(GEOMETRY(IG)%EDGES(NOD1:NOD2,N_TENT_EDGES)) ! Size large enough to take care of surfaces - ! (zero thickness immersed solids) and 3D domains - ! boundaries (what we call wet surfaces). - ! WS Faces edges: - IF (ALLOCATED(GEOMETRY(IG)%FACE_EDGES)) DEALLOCATE(GEOMETRY(IG)%FACE_EDGES) - ALLOCATE(GEOMETRY(IG)%FACE_EDGES(EDG1:EDG3,NWSEL)) ! Edges in GEOMETRY(IG)%EDGES for this triangle. - ! WS Edges faces: - IF (ALLOCATED(GEOMETRY(IG)%EDGE_FACES)) DEALLOCATE(GEOMETRY(IG)%EDGE_FACES) - ALLOCATE(GEOMETRY(IG)%EDGE_FACES(5,N_TENT_EDGES)) ! Triangles sharing this edge [niel iwel1 LocEdge1 iwel2 LocEdge2] + ! Discard face with less than 3 edges (triangle): + IF ( NSSEG < 3 ) CYCLE - ! COUNTED_VERT used for test of loose vertices: - ALLOCATE(COUNTED_VERT(1:NVERT)); COUNTED_VERT = .FALSE. + ! Add segments which have both ends attached to more than two segs: + count = 0 + DO ISEG=1,NSSEG + NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) + NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) + IF ((NUMNOD1 > 2) .AND. (NUMNOD2 > 2)) THEN + COUNT = COUNT + 1 + SEG_FACE(NOD1:NOD2,NSSEG+COUNT) = SEG_FACE( (/ NOD2, NOD1 /) ,ISEG) + IF (ANGSEG(ISEG) >= 0._EB) THEN + ANGSEG(NSSEG+COUNT) = ANGSEG(ISEG) - PI + ELSE + ANGSEG(NSSEG+COUNT) = ANGSEG(ISEG) + PI + ENDIF + ENDIF + ENDDO + NSSEG = NSSEG + COUNT - GEOMETRY(IG)%GEOM_VOLUME = 0._EB - GEOMETRY(IG)%GEOM_AREA = 0._EB - GEOMETRY(IG)%GEOM_XYZCEN(:) = 0._EB + ! Fill NODEDG_FACE(IEDGE,INOD), where iedge are edges + ! that contain inod as first node. This assumes edges are + ! ordered using the right hand rule on x2-x3 plane. + ! Also compute the edges angles in x2-x3 plane + CALL REALLOCATE_NODEDG_FACE(NSSEG,NSVERT) + NODEDG_FACE(:,:) = 0 + DO ISEG=1,NSSEG + INOD1 = SEG_FACE(NOD1,ISEG) + NEDI = NODEDG_FACE(1,INOD1) + 1 ! Increase number of edges connected to node by 1. + NODEDG_FACE( 1,INOD1) = NEDI + NODEDG_FACE(NEDI+1,INOD1) = ISEG + ENDDO - ! Compute normal, area and volume: - SQAREA(IAXIS:KAXIS) = 0._EB - DO IWSEL=1,NWSEL + ! Now Reorder Segments, do tests: + SEG_FACE2(NOD1:NOD3,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED ! [INOD1 INOD2 ICF] + SEG_FLAG(1:CC_MAXCEELEM_FACE) = .TRUE. - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + ICF = 1 + ISEG = 1 + NEWSEG = ISEG + COUNT= 1 + CTSTART=COUNT + SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG),SEG_FACE(NOD2,NEWSEG),ICF /) + SEG_FLAG(ISEG) = .FALSE. + NSEG_LEFT = NSSEG - 1 - COUNTED_VERT(WSELEM(NOD1:NOD3)) = .TRUE. + ! Infamous infinite loop: + INF_LOOP2 : DO - ! Triangles NODES coordinates: - DO INOD=NOD1,NOD3 - XYZV(IAXIS:KAXIS,INOD) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+1:MAX_DIM*WSELEM(INOD)) - ENDDO + FOUNDSEG = .FALSE. + N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. + ANGCOUNT = ANGSEG(NEWSEG) - V12(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD2) - XYZV(IAXIS:KAXIS,NOD1) - V23(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD3) - XYZV(IAXIS:KAXIS,NOD2) - V31(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD1) - XYZV(IAXIS:KAXIS,NOD3) + ! Find Segment starting on Node 2 with smaller ANGSEG respect to COUNT. + DANG = -1._EB / GEOMEPS + DO ISS=2,NODEDG_FACE(1,N2COUNT)+1 + ISEG = NODEDG_FACE(ISS,N2COUNT) + IF ( SEG_FLAG(ISEG) ) THEN ! This seg hasn't been added to SEG_FACE2 + ! Drop if seg is the opposite of count seg: + IF ( SEG_FACE2(NOD1,COUNT) == SEG_FACE(NOD2,ISEG) ) CYCLE + DANGI = ANGSEG(ISEG) - ANGCOUNT + IF ( DANGI < 0._EB ) DANGI = DANGI + 2._EB * PI - ! Check that face edges are not too small - IF ((V12(IAXIS)**2._EB + V12(JAXIS)**2._EB + V12(KAXIS)**2._EB ) < GEOMEPSSQ) THEN - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD2) - WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD1),', ',WSELEM(NOD2),' are not equal.' - ENDIF - CALL SHUTDOWN("") ; RETURN - ENDIF - IF ((V23(IAXIS)**2._EB + V23(JAXIS)**2._EB + V23(KAXIS)**2._EB ) < GEOMEPSSQ) THEN - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD3) - WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD2),', ',WSELEM(NOD3),' are not equal.' - END IF - CALL SHUTDOWN("") ; RETURN - ENDIF - IF ((V31(IAXIS)**2._EB + V31(JAXIS)**2._EB + V31(KAXIS)**2._EB ) < GEOMEPSSQ) THEN - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(MESSAGE,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD1) - WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD1),', ',WSELEM(NOD3),' are not equal.' - ENDIF - CALL SHUTDOWN("") ; RETURN - END IF + IF ( DANGI > DANG ) THEN + NEWSEG = ISEG + DANG = DANGI + FOUNDSEG = .TRUE. + ENDIF + ENDIF + ENDDO - ! Cross V12 x V23: - ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - WSNORM(IAXIS) = V12(JAXIS)*V23(KAXIS) - V12(KAXIS)*V23(JAXIS) - WSNORM(JAXIS) = V12(KAXIS)*V23(IAXIS) - V12(IAXIS)*V23(KAXIS) - WSNORM(KAXIS) = V12(IAXIS)*V23(JAXIS) - V12(JAXIS)*V23(IAXIS) - MGNRM = SQRT( WSNORM(IAXIS)**2._EB + WSNORM(JAXIS)**2._EB + WSNORM(KAXIS)**2._EB ) - ! ELSE - ! V12Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD2),QB) - REAL(XYZV(IAXIS:KAXIS,NOD1),QB) - ! V23Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD3),QB) - REAL(XYZV(IAXIS:KAXIS,NOD2),QB) - ! V31Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD1),QB) - REAL(XYZV(IAXIS:KAXIS,NOD3),QB) - ! WSNORMQ(IAXIS) = V12Q(JAXIS)*V23Q(KAXIS) - V12Q(KAXIS)*V23Q(JAXIS) - ! WSNORMQ(JAXIS) = V12Q(KAXIS)*V23Q(IAXIS) - V12Q(IAXIS)*V23Q(KAXIS) - ! WSNORMQ(KAXIS) = V12Q(IAXIS)*V23Q(JAXIS) - V12Q(JAXIS)*V23Q(IAXIS) - ! MGNRMQ = SQRT( WSNORMQ(IAXIS)**2._QB + WSNORMQ(JAXIS)**2._QB + WSNORMQ(KAXIS)**2._QB ) - ! MGNRM = REAL(MGNRMQ,EB) - ! ENDIF + ! Found a seg add to SEG_FACE2: + IF ( FOUNDSEG ) THEN + COUNT = COUNT + 1 + SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG), SEG_FACE(NOD2,NEWSEG), ICF /) + SEG_FLAG(NEWSEG) = .FALSE. + NSEG_LEFT = NSEG_LEFT - 1 + ENDIF - XCEN = (XYZV(IAXIS,NOD1) + XYZV(IAXIS,NOD2) + XYZV(IAXIS,NOD3)) / 3._EB + ! Test if line has closed on point shared any other cutface: + IF ( SEG_FACE2(NOD2,COUNT) == SEG_FACE2(NOD1,CTSTART) ) THEN + ! Go for new cut-face on this Cartesian face. + ELSEIF ( FOUNDSEG ) THEN + CYCLE + ENDIF - ! Check that face area is not too small - IF(MGNRM < GEOMEPSSQ) THEN - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(728): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,3F12.3)') " Face area too small at:", XYZV(IAXIS:KAXIS,NOD1) - WRITE(LU_ERR,*) ' Face IWSEL=', IWSEL, ', Connectivity=', WSELEM(NOD1:NOD3),', Norm Cross=', MGNRM - ENDIF - CALL SHUTDOWN("") ; RETURN - ENDIF + ! Break loop: + IF ( NSEG_LEFT == 0 ) EXIT - ! Assign to GEOMETRY: - ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) = WSNORM(IAXIS:KAXIS) * MGNRM**(-1._EB) - GEOMETRY(IG)%FACES_AREA(IWSEL) = MGNRM/2._EB - ! ELSE - ! GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) = REAL(WSNORMQ(IAXIS:KAXIS)*MGNRMQ**(-1._QB),EB) - ! GEOMETRY(IG)%FACES_AREA(IWSEL) = REAL(MGNRMQ/2._QB,EB) - ! ENDIF + ! Start a new cut-face on this Cartesian face: + ICF = ICF + 1 + DO ISEG=1,NSSEG + IF ( SEG_FLAG(ISEG) ) THEN + COUNT = COUNT + 1 + CTSTART= COUNT + SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,ISEG), SEG_FACE(NOD2,ISEG), ICF /) + SEG_FLAG(ISEG) = .FALSE. + NSEG_LEFT = NSEG_LEFT - 1 + EXIT + ENDIF + ENDDO - ! Total Area and Volume for GEOMETRY(IG). - GEOMETRY(IG)%GEOM_AREA = GEOMETRY(IG)%GEOM_AREA + GEOMETRY(IG)%FACES_AREA(IWSEL) - GEOMETRY(IG)%GEOM_VOLUME= GEOMETRY(IG)%GEOM_VOLUME+ & ! Divergence theorem with F = x i, assumes we have a volume. - GEOMETRY(IG)%FACES_NORMAL(IAXIS,IWSEL)*XCEN*GEOMETRY(IG)%FACES_AREA(IWSEL) + ENDDO INF_LOOP2 - ! Define Centroid: - X12(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD1) + XYZV(IAXIS:KAXIS,NOD2)) - X23(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD2) + XYZV(IAXIS:KAXIS,NOD3)) - X31(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD3) + XYZV(IAXIS:KAXIS,NOD1)) - ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA - DO IX=IAXIS,KAXIS - INT2 = (X12(IX)**2._EB + X23(IX)**2._EB + X31(IX)**2._EB) / 3._EB - SQAREA(IX) = SQAREA(IX) + GEOMETRY(IG)%FACES_NORMAL(IX,IWSEL)*INT2*GEOMETRY(IG)%FACES_AREA(IWSEL) ! Midpt rule. - ENDDO - ENDDO + ! Load ordered nodes to CFELEM: + NSFACE = ICF + ! Reallocate CFELEM ARRAY if necessary: + CALL REALLOCATE_LOCAL_CFELEM(NSSEG,NSFACE) + CFELEM(:,:) = CC_UNDEFINED + COUNT = 0 + DO ICF=1,NSFACE + NP = 0 + DO ISEG=1,NSSEG + IF ( SEG_FACE2(NOD3,ISEG) == ICF ) NP = NP + 1 + ENDDO + IF (NP < 3) CYCLE ! Drop face if it has less than 2 3 vertices + COUNT=COUNT+1 + NP = 0 + DO ISEG=1,NSSEG + IF ( SEG_FACE2(NOD3,ISEG) == ICF ) THEN + NP = NP + 1 + CFELEM(1,COUNT) = NP + CFELEM(NP+1,COUNT) = SEG_FACE2(NOD1,ISEG) + ENDIF + ENDDO + ! Does Face Have zero Area? If so drop, rewind: + DO IPT=2,NP+1 + ICF_PT = CFELEM(IPT,COUNT) + ! Define closed Polygon: + XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) + ENDDO + ICF_PT = CFELEM(2,COUNT) + XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) ! Close Polygon. + AREA = 0._EB + DO II2=1,NP + AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & + XY(JAXIS,II2) * XY(IAXIS,II2+1) ) + ENDDO + IF (ABS(AREA) < GEOMEPS**2._EB) THEN + CFELEM(:,COUNT) = CC_UNDEFINED + COUNT = COUNT - 1 + ENDIF + ENDDO + NSFACE = COUNT; IF(NSFACE==0) CYCLE - ! In the broken case where GEOM normals are wrong, GEOM_VOLUME can become too small - IF(GEOMETRY(IG)%GEOM_VOLUME < GEOMEPSSQ) THEN - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(729): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A)') " Geometry volume too small." - WRITE(LU_ERR,'(A)') " Face normals are probably pointing in the wrong direction. " - WRITE(LU_ERR,'(A)') " Check they point towards the gas phase." - ENDIF - CALL SHUTDOWN("") ; RETURN - ENDIF + ! Compute area and Centroid, in local x1, x2, x3 coords: + ALLOCATE(DROPFACE(1:NSFACE)); DROPFACE=.FALSE. + AREAV(1:NSFACE) = 0._EB + XYZCEN(IAXIS:KAXIS,1:NSFACE) = 0._EB + DO ICF=1,NSFACE + NP = CFELEM(1,ICF) + DO IPT=2,NP+1 + ICF_PT = CFELEM(IPT,ICF) + ! Define closed Polygon centered in First Point: + XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & + XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) + ENDDO + ICF_PT = CFELEM(2,ICF) + XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & + XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) - ! Geometry Centroid: - DO IX=IAXIS,KAXIS - GEOMETRY(IG)%GEOM_XYZCEN(IX) = SQAREA(IX) / (2._EB * GEOMETRY(IG)%GEOM_VOLUME) - ENDDO + ! Get Area and Centroid properties of Cut-face: + AREA = 0._EB + DO II2=1,NP + AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & + XY(JAXIS,II2) * XY(IAXIS,II2+1) ) + ENDDO + AREA = AREA / 2._EB + IF ( (AREA 2) THEN ! More than two faces share this edge: - SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEL) - XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) - XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(731): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') " Non manifold geometry in adjacent faces at edge with nodes: NOD1",& - SEG(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",SEG(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" - ENDIF - CALL SHUTDOWN("") ; RETURN + ENDDO - ELSEIF(ANY(EDGES2(1:2,IWSEL) > 1)) THEN ! half edge counted more than once, opposite normals on triangles - SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEL) - XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) - XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(732): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') & - " Opposite normals on triangles sharing edge with nodes: NOD1",& - SEG(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",SEG(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" - ENDIF - CALL SHUTDOWN("") ; RETURN + ALLOCATE(CFELEM2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CFELEM2 = CC_UNDEFINED + NP=0 + DO ICF=1,NSFACE + IF(.NOT.DROPFACE(ICF)) THEN + NP=NP+1 + CFELEM2(:,NP) = CFELEM(:,ICF) + ENDIF + ENDDO + CFELEM = CFELEM2 + DEALLOCATE(CFELEM2,DROPFACE) + IF (NP==0) CYCLE + NSFACE = NP - ENDIF - ENDDO - DEALLOCATE(EDGES2) + ! Figure out if a cut-face is completely inside any of the + ! others (that is, it is a hole on the GASPHASE): + FINFACE = 0 + NSFACE2 = NSFACE + DO ICF1=1,NSFACE2 + ! Test that ICF1 has a negative area (case of holes) + AREA1 = AREAV(ICF1) + IF ( AREA1 < -GEOMEPS ) THEN + DO ICF2=1,NSFACE2 + ! Drop if same face: + IF ( ICF1 == ICF2 ) CYCLE - ! Check if the surface is closed - ! Each halfedge should be coupled with an opposite halfedge - DO IEDLIST=1,NWSEDG - IF (GEOMETRY(IG)%EDGE_FACES(1,IEDLIST) == 1) THEN - XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) - XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(733): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') " Open geometry at edge with nodes: NOD1",& - WSELEM(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",WSELEM(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" - ENDIF - CALL SHUTDOWN("") ; RETURN - ENDIF - ENDDO + ! Centroid node for ICF1: + XYC1(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF1 ) ! [x2axis x3axis] - ! Check that all vertices are counted: - DO INOD=1,NVERT - IF (.NOT.COUNTED_VERT(INOD) .AND. MY_RANK==0) & - WRITE(LU_ERR,'(A,A,A,I8,A)') " WARNING: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "': Vertex ",INOD," not connected." - ENDDO - DEALLOCATE(COUNTED_VERT) + ! Polygon nodes for ICF2: + NP2 = CFELEM(1,ICF2) + DO IPT=2,NP2+1 + ICF_PT = CFELEM(IPT,ICF2) + ! Define closed Polygon: + XY(IAXIS:JAXIS,IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) + ENDDO - GEOMETRY(IG)%N_EDGES = NWSEDG + CALL TEST_PT_INPOLY(NP2,XY,XYC1,PTSFLAG) - ! At this point the surface is manifold, well oriented, and closed. + IF ( PTSFLAG ) THEN ! Centroid of face 1 inside Face 2. - IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN - IF (IG==N_GEOMETRY) THEN - WRITE(LU_ERR,'(I4.4,A,I9.9,A,I9.9,A)',advance="no") IG,', VERTS=',GEOMETRY(IG)%N_VERTS,& - ', FACES=',GEOMETRY(IG)%N_FACES,'.. done.' - CALL CPU_TIME(CPUTIME) - WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken : ',CPUTIME-CPUTIME_START,' sec.' - ELSE - WRITE(LU_ERR,'(I4.4,A)',advance="no") IG,', ' - ENDIF - ENDIF + FINFACE(ICF1) = ICF2 + NSFACE = NSFACE - 1 -ENDDO GEOMETRY_LOOP + ! Redefine areas in case of faces with holes: + AREA2 = AREAV(ICF2) -! Print out of computed result: -! DO IG=1,N_GEOMETRY -! NWSEL = GEOMETRY(IG)%N_FACES -! DO IWSEL=1,NWSEL -! print*, IWSEL,GEOMETRY(IG)%FACES_AREA(IWSEL) -! ENDDO -! DO IWSEL=1,NWSEL -! print*, IWSEL,GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) -! ENDDO -! print*, "EDGES=" -! DO NWSEDG=1,GEOMETRY(IG)%N_EDGES -! print*, NWSEDG,GEOMETRY(IG)%EDGES(NOD1:NOD2,NWSEDG) -! ENDDO -! DO NWSEDG=1,GEOMETRY(IG)%N_EDGES -! print*, GEOMETRY(IG)%EDGE_FACES(1:5,NWSEDG) -! ENDDO -! print*, "FACES=" -! DO IWSEL=1,NWSEL -! print*, IWSEL,GEOMETRY(IG)%FACE_EDGES(EDG1:EDG3,IWSEL) -! ENDDO -! ENDDO + ! Area with hole, AREA1 has negative sign: + AREAH = AREA2 + AREA1 -RETURN -END SUBROUTINE CC_INIT_GEOM + IF (ABS(AREAH) < GEOMEPS) THEN ! Hole of same size as cut-face, drop both. + FINFACE(ICF2) = ICF1 + CYCLE + ENDIF -! ------------------------ GET_GEOM_EDGES --------------------------------------- + ! Centroid with hole: + XYC2(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF2 ) ! [x2axis x3axis] + XYH(1:2) = (AREA1 * XYC1(1:2) + AREA2 * XYC2(1:2)) / AREAH -SUBROUTINE GET_GEOM_EDGES(NVERT,NWSEL,SIZEFC,FACES,NWSEDG,EDGES,FACE_EDGES,EDGE_FACES) + ! So ICF2 has the area with hole properties: + AREAV(ICF2) = AREAH + XYZCEN(JAXIS,ICF2) = XYH(IAXIS) + XYZCEN(KAXIS,ICF2) = XYH(JAXIS) + EXIT + ENDIF + ENDDO + ENDIF + ENDDO + + ! Now enhance CFELEM for faces with holes nodes: + DO ICF1=1,NSFACE2 + ICF2 = FINFACE(ICF1) + IF ( ICF2 > 0 ) THEN ! Allows for up to one hole per CC_GASPHASE cut-face. + ! Load points + NP1 = CFELEM(1,ICF1) + NP2 = CFELEM(1,ICF2) + NP = (NP1+1) + (NP2+1) -INTEGER, INTENT(IN) :: NVERT,NWSEL,SIZEFC -INTEGER, INTENT(IN) :: FACES(1:SIZEFC) -INTEGER, INTENT(OUT):: NWSEDG,EDGES(NOD1:NOD2,3*NWSEL),FACE_EDGES(EDG1:EDG3,NWSEL),EDGE_FACES(5,3*NWSEL) + ! Here reallocate CFELEM, CFE, CFEL if NP > SIZE_VERTS_CFELEM: + CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) -! Local Variables: -INTEGER :: IWSEL,IVERT,IEDGE,TOT_ELVERT,IEDLIST,WSELEM(NOD1:NOD3),SEG(NOD1:NOD2) -LOGICAL :: INLIST -LOGICAL :: FLG_LOHI -INTEGER, ALLOCATABLE, DIMENSION(:) :: NELVERT,ISTVERT,EDGE_RNK -INTEGER, ALLOCATABLE, DIMENSION(:,:):: EDGES2,EDGE_FACES2 + CFE(1) = NP -NWSEDG = 0 + DO II2=2,np1+1 + CFE(II2) = CFELEM(II2,icf1) + ENDDO + II2 = (np1+1) + 1 + CFE(II2) = CFELEM(2,icf1) -! Populate NELVERT with the number of elements associated per node: -ALLOCATE(NELVERT(NVERT)); NELVERT(:) = 0 -ALLOCATE(ISTVERT(NVERT)); ISTVERT(:) = 0 -DO IWSEL=1,NWSEL - NELVERT(FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL)) = NELVERT(FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL)) + 1 -ENDDO -NELVERT = NELVERT + 1 ! Add buffer. -DO IVERT=2,NVERT - ISTVERT(IVERT) = ISTVERT(IVERT-1) + NELVERT(IVERT-1) -ENDDO + COUNT = 1 + DO II2=(NP1+1)+2,(NP1+1)+1+NP2 + COUNT = COUNT + 1 + CFE(II2) = CFELEM(COUNT,ICF2) + ENDDO + II2 = NP + 1 + CFE(II2) = CFELEM(2,ICF2) -! First pass build unique list of segments per VERTEX where: -! SEG_IJ = [ni nj] with ni < nj -TOT_ELVERT = SUM(NELVERT(1:NVERT)) -ALLOCATE(EDGES2(NOD1:NOD2,TOT_ELVERT)); EDGES2(:,:) = 0 -ALLOCATE(EDGE_FACES2( 5,TOT_ELVERT)); EDGE_FACES2(:,:) = 0 -ALLOCATE(EDGE_RNK( TOT_ELVERT)); EDGE_RNK(:) = 0 -NELVERT(:) = 0 ! Reset NELVERT. + ! Copy CFE into CFELEM(1:np+1,icf2): + CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) -DO IWSEL=1,NWSEL - WSELEM(NOD1:NOD3) = FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + ENDIF + ENDDO - DO IEDGE=EDG1,EDG3 - SEG(NOD1:NOD2) = (/ MINVAL(WSELEM(NOD1:NOD2)), MAXVAL(WSELEM(NOD1:NOD2)) /) - FLG_LOHI = .TRUE.; IF(SEG(NOD2) /= WSELEM(NOD2)) FLG_LOHI = .FALSE. + NVERTFACE = MAXVAL(CFELEM(1,1:NSFACE2)) + 1 - IF(NELVERT(SEG(NOD2)) == 0) THEN - NELVERT(SEG(NOD2)) = NELVERT(SEG(NOD2)) + 1 - FACE_EDGES(IEDGE,IWSEL) = ISTVERT(SEG(NOD2)) + NELVERT(SEG(NOD2)) - EDGES2(NOD1:NOD2,FACE_EDGES(IEDGE,IWSEL)) = SEG(NOD1:NOD2) - EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) = & - EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) + 1 - IF(FLG_LOHI) THEN - EDGE_FACES2(2,FACE_EDGES(IEDGE,IWSEL)) = IWSEL - EDGE_FACES2(3,FACE_EDGES(IEDGE,IWSEL)) = IEDGE - ELSE - EDGE_FACES2(4,FACE_EDGES(IEDGE,IWSEL)) = IWSEL - EDGE_FACES2(5,FACE_EDGES(IEDGE,IWSEL)) = IEDGE - ENDIF - WSELEM=CSHIFT(WSELEM,1) - CYCLE ! IEDGE - ENDIF + ! Up to this point we have all SOLID side cut-faces in CFELEM, SOLID_SIDE nodes in XYZVERT and + ! Area properties: Add these to Existing CUT_FACE info: + MESHES(NM)%CUT_FACE(NCUTFACE)%NSVERT = NSVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NSFACE = NSFACE + CALL FACE_REALLOC(NM,NCUTFACE,NVERT,NFACE,NSVERT,NSFACE,NVERTFACE) + MESHES(NM)%CUT_FACE(NCUTFACE)%XYZVERT(IAXIS:KAXIS,NVERT+1:NVERT+NSVERT)=XYZVERT(IAXIS:KAXIS,1:NSVERT) - INLIST = .FALSE. - DO IEDLIST=ISTVERT(SEG(NOD2))+1,ISTVERT(SEG(NOD2))+NELVERT(SEG(NOD2)) - ! Here SEG(NOD2) is by construction the same as - ! EDGES2(NOD2,IEDLIST), search only NOD1 component. - IF(SEG(NOD1) == EDGES2(NOD1,IEDLIST)) THEN - INLIST = .TRUE. - EXIT ! IEDLIST - ENDIF - ENDDO - IF(INLIST) THEN - FACE_EDGES(IEDGE,IWSEL) = IEDLIST - ELSE - NELVERT(SEG(NOD2)) = NELVERT(SEG(NOD2)) + 1 - FACE_EDGES(IEDGE,IWSEL) = ISTVERT(SEG(NOD2)) + NELVERT(SEG(NOD2)) - EDGES2(NOD1:NOD2,FACE_EDGES(IEDGE,IWSEL)) = SEG(NOD1:NOD2) - ENDIF + ! Load Ordered nodes to CFELEM and geom properties: + COUNT = NFACE + DO ICF=1,NSFACE2 + IF ( FINFACE(ICF) > 0 ) CYCLE ! icf is a hole on another cut-face. + COUNT = COUNT + 1 + ! Connectivity: + NV=CFELEM(1, ICF) + CFELEM(2:NV+1,ICF)=CFELEM(2:NV+1,ICF) + NVERT ! Re-index to total number of vertices. + MESHES(NM)%CUT_FACE(NCUTFACE)%CFELEM(1:NVERTFACE,COUNT) = CFELEM(1:NVERTFACE, ICF) + ! Geom Properties SOLID: + MESHES(NM)%CUT_FACE(NCUTFACE)%AREA(COUNT) = AREAV(ICF) + MESHES(NM)%CUT_FACE(NCUTFACE)%XYZCEN(IAXIS:KAXIS,COUNT) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,ICF) + ENDDO + ! Final number of cut-faces in the solid region of the face: + MESHES(NM)%CUT_FACE(NCUTFACE)%NSFACE = COUNT-NFACE - EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) = & - EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) + 1 - IF(FLG_LOHI) THEN - EDGE_FACES2(2,FACE_EDGES(IEDGE,IWSEL)) = IWSEL - EDGE_FACES2(3,FACE_EDGES(IEDGE,IWSEL)) = IEDGE - ELSE - EDGE_FACES2(4,FACE_EDGES(IEDGE,IWSEL)) = IWSEL - EDGE_FACES2(5,FACE_EDGES(IEDGE,IWSEL)) = IEDGE - ENDIF + ENDIF SOLID_FACE_IF - WSELEM=CSHIFT(WSELEM,1) - ENDDO -ENDDO + ENDDO ! JJ + ENDDO ! KK + ENDDO ! II -! Second pass get segments ranking: -DO IVERT=1,NVERT - DO IEDLIST=ISTVERT(IVERT)+1,ISTVERT(IVERT)+NELVERT(IVERT) - NWSEDG = NWSEDG + 1 - EDGE_RNK(IEDLIST) = NWSEDG - EDGES(NOD1:NOD2,NWSEDG) = EDGES2(NOD1:NOD2,IEDLIST) - EDGE_FACES(1:5,NWSEDG) = EDGE_FACES2(1:5,IEDLIST) - ENDDO -ENDDO + DEALLOCATE(X1FACE,X2FACE,X3FACE) -! Third pass populate FACE_EDGES data: -DO IWSEL=1,NWSEL - DO IEDGE=EDG1,EDG3 - IEDLIST = EDGE_RNK(FACE_EDGES(IEDGE,IWSEL)) - FACE_EDGES(IEDGE,IWSEL) = IEDLIST - ENDDO -ENDDO + ENDDO XIAXIS_LOOP -DEALLOCATE(NELVERT,ISTVERT,EDGES2,EDGE_FACES2,EDGE_RNK) +ENDDO IBNDINT_LOOP -RETURN -END SUBROUTINE GET_GEOM_EDGES +IF (BNDINT_FLAG) THEN + ! Here we mark faces on the guard-cell region for the computaiton of grid aligned INBOUNDARY faces + ! on CARTCELL_CUTFACES to work correctly: + XIAXIS_LOOP_2 : DO X1AXIS=IAXIS,KAXIS -! ------------------------- GET_X2_VERTVAR -------------------------------------- + SELECT CASE(X1AXIS) + case(IAXIS) -SUBROUTINE GET_X2_VERTVAR(X1AXIS,X2LO,X2HI,NM,I,KK) + X2AXIS = JAXIS + X3AXIS = KAXIS -INTEGER, INTENT(IN) :: X1AXIS,X2LO,X2HI,NM,I,KK + ! IAXIS gasphase cut-faces: + ILO = ILO_FACE-CCGUARD; IHI = IHI_FACE+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD -! Local Variables: -INTEGER :: ICRS,ICRS1,JSTR,JEND,JJ,X2LO_LOC,X2HI_LOC -REAL(EB):: TNOW + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS -TNOW=CURRENT_TIME() + ! Local indexing in x1, x2, x3: + X1LO = ILO; X1HI = IHI + X2LO = JLO; X2HI = JHI + X3LO = KLO; X3HI = KHI -! Work By Edge, Only one X1AXIS=IAXIS needs to be used: -SELECT CASE(X1AXIS) -CASE(IAXIS) - X2LO_LOC = X2LO - X2HI_LOC = X2HI - ! Case of GG, SS points: - DO ICRS=1,CC_N_CRS - ! If is_crs(icrs) == GG, SS, SGG see if crossing is - ! exactly on a Cartesian cell vertex: - SELECT CASE(CC_IS_CRS(ICRS)) - CASE(CC_GG,CC_SS) - JSTR = X2LO_LOC; JEND = X2HI_LOC - IF(X2NOC==0) THEN - ! Optimized and will ONLY work for Uniform Grids: - JSTR = MAX(X2LO_LOC, FLOOR((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) - JEND = MIN(X2HI_LOC, CEILING((CC_SVAR_CRS(ICRS)+GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) - ENDIF + CASE(JAXIS) - DO JJ=JSTR,JEND - ! Crossing on Vertex? - IF ( ABS(X2FACE(JJ)-CC_SVAR_CRS(ICRS)) < GEOMEPS ) THEN - MESHES(NM)%VERTVAR(I,JJ,KK,CC_VGSC) = CC_SOLID - EXIT - ENDIF - ENDDO + X2AXIS = KAXIS + X3AXIS = IAXIS - END SELECT - ENDDO + ! JAXIS gasphase cut-faces: + JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD - ! Other cases: - DO ICRS=1,CC_N_CRS-1 - ! Case GS-SG: All Cartesian vertices are set to CC_SOLID. - IF (CC_IS_CRS(ICRS) == CC_GS) THEN - ! Find corresponding SG intersection: - DO ICRS1=ICRS+1,CC_N_CRS - IF (CC_IS_CRS(ICRS1) == CC_SG) EXIT - ENDDO - JSTR = X2LO_LOC; JEND = X2HI_LOC - IF(X2NOC==0) THEN - ! Optimized for UG: - JSTR = MAX(X2LO_LOC, CEILING(( CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) - JEND = MIN(X2HI_LOC, FLOOR((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) - ELSE - IF ((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC)) < 0._EB) THEN - JSTR=X2LO_LOC - ELSEIF((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2HI_LOC)) >= 0._EB) THEN - JSTR=X2HI_LOC+1 - ELSE - DO JJ=X2LO_LOC,X2HI_LOC - IF((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. & - (CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN - JSTR = JJ+1 - EXIT - ENDIF - ENDDO - ENDIF - IF ((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2LO_LOC)) < 0._EB) THEN - JEND=X2LO_LOC-1 - ELSEIF((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2HI)) >= 0._EB) THEN - JEND=X2HI_LOC - ELSE - DO JJ=X2LO_LOC,X2HI_LOC - IF((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. & - (CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN - JEND = JJ - EXIT - ENDIF - ENDDO - ENDIF - ENDIF + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS - DO JJ=JSTR,JEND - MESHES(NM)%VERTVAR(I,JJ,KK,CC_VGSC) = CC_SOLID - ENDDO - ENDIF - ENDDO -END SELECT + ! Local indexing in x1, x2, x3: + X1LO = JLO; X1HI = JHI + X2LO = KLO; X2HI = KHI + X3LO = ILO; X3HI = IHI -T_CC_USED(GET_X2_VERTVAR_TIME_INDEX) = T_CC_USED(GET_X2_VERTVAR_TIME_INDEX) + CURRENT_TIME() - TNOW + CASE(KAXIS) -RETURN -END SUBROUTINE GET_X2_VERTVAR + X2AXIS = IAXIS + X3AXIS = JAXIS -! -------------------------- GET_CARTEDGE_CUTEDGES ------------------------------ + ! KAXIS gasphase cut-faces: + KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD -SUBROUTINE GET_CARTEDGE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & - NM,X2LO_CELL,X2HI_CELL,INDX1,KK) + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS -INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & - NM,X2LO_CELL,X2HI_CELL,INDX1(MAX_DIM),KK + ! Local indexing in x1, x2, x3: + X1LO = KLO; X1HI = KHI + X2LO = ILO; X2HI = IHI + X3LO = JLO; X3HI = JHI -! Local Variables: -INTEGER :: NEDGECROSS, NEDGECROSS_OLD, NCUTEDGE, JJ, INDXI(MAX_DIM), INDI, INDJ, INDK -INTEGER :: INDI1, INDJ1, INDK1, INDIE, INDJE, INDKE, NCROSS, ICROSS, ICRS, JSTR -INTEGER :: JJLOW, JJHIGH, JJADD -REAL(EB):: DELJJ -LOGICAL :: VSOLID, DIF, VFLUID -REAL(EB):: X123VERT(MAX_DIM,CC_MAXCROSS_EDGE), XCEN, YCEN, ZCEN, SCEN, XYZCEN(IAXIS:KAXIS) -INTEGER :: VERT_LIST(4,CC_MAXCROSS_EDGE),NEDGE, NVERT, IVERT -LOGICAL :: IS_GASPHASE -REAL(EB):: TNOW + END SELECT -LOGICAL :: FOUND_EDGE -REAL(EB):: XVJJ, DELJJ1 + ! Loop on Cartesian faces, local x1, x2, x3 indexes: + DO II=X1LO,X1HI + DO KK=X3LO,X3HI + DO JJ=X2LO,X2HI -TNOW=CURRENT_TIME() + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI = INDXI(XIAXIS) + INDJ = INDXI(XJAXIS) + INDK = INDXI(XKAXIS) -! INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CEELEMAUX, INDSEGAUX -! INTEGER :: NEDGE_SIZE + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE -! Now define Crossings on Cartesian Edges and Body segments: -! - Edges: MESHES(NM) % ECVAR(:,:,:,CC_EGSC,IAXIS) = -! ECVAR(:,:,:,CC_EGSC,JAXIS) = CC_GASPHASE, CC_SOLID or CC_CUTCFE -! ECVAR(:,:,:,CC_EGSC,KAXIS) = -! ECVAR(:,:,:,CC_ECRS,IAXIS) = -! ECVAR(:,:,:,CC_ECRS,JAXIS) = Index to Corresponding EDGE_CROSS array. -! ECVAR(:,:,:,CC_ECRS,KAXIS) = -! MESHES(NM) % EDGE_CROSS: Data structure with -! crossings per cartesian edge information. -! .NCROSS = Number of crossings. -! .SVAR(1:NCROSS) = distances along edge from lower -! Cartesian vertex. -! Note: Crossings right on vertices do not need to be added, -! they are taken care of by setting VERTVAR(iv,jv,kv,CC_VGSC,lb)=CC_SOLID. -! MESHES(NM) % CUT_EDGE: Data structure with info on CC_GASPHASE cut-edges, -! per Cartesian Edge and CC_INBOUNDARY cut-edges, per -! Cartesian Face: -! .NVERT = number of vertices on cut-edges. -! .NEDGE = number of cut-edges. -! .XYZVERT(IAXIS:KAXIS,1:NVERT) = Segments Vertices -! .CEELEM(NOD1:NOD2,1:NEDGE) = Segments connectivity list. -! .STATUS = CC_GASPHASE or CC_INBOUNDARY; if latter -! .IJK = [I J K AXIS] for Cartesian Edge if status = CC_GASPHASE -! = [I J K AXIS] for Cartesian Face if status = CC_INBOUNDARY -! .INDSEG(1:4,1:NEDGE) = [nwel iwel1 iwel2 ibod] if status = CC_INBOUNDARY -! Also: -! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = -! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = index on CUT_EDGE location. -! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = -! -! Now figure out which segment the intersections belong to, also -! add intersections to body segments. -! As defined, a Cartesian CUT_EDGE is defined by: -! 1. A crossing. -! 2. A VERTVAR(iv,jv,kv,CC_VGSC,lb) = CC_SOLID and another -! VERTVAR(iv,jv,kv,CC_VGSC,lb) = CC_GASPHASE + ! Drop if face not cut-face: + ! Test for FACE Cartesian edges being cut: + ! If outface1 is true -> All regular edges for this face: + ! Edge at index KK-1: + INDXI1(IAXIS:KAXIS) = (/ II, JJ , KK-1 /) ! Local x1,x2,x3 + INDI1 = INDXI1(XIAXIS) + INDJ1 = INDXI1(XJAXIS) + INDK1 = INDXI1(XKAXIS) + ! Edge at index KK: + INDXI2(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 + INDI2 = INDXI2(XIAXIS) + INDJ2 = INDXI2(XJAXIS) + INDK2 = INDXI2(XKAXIS) + ! Edge at index JJ-1: + INDXI3(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 + INDI3 = INDXI3(XIAXIS) + INDJ3 = INDXI3(XJAXIS) + INDK3 = INDXI3(XKAXIS) + ! Edge at index jj: + INDXI4(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 + INDI4 = INDXI4(XIAXIS) + INDJ4 = INDXI4(XJAXIS) + INDK4 = INDXI4(XKAXIS) -! Set initially edges with MESHES(NM)%VERTVAR vertices == CC_SOLID to CC_SOLID status: -DO JJ=X2LO_CELL,X2HI_CELL + OUTFACE1 = (MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) /= CC_CUTCFE) - ! Vert at index JJ-1: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ-1, KK /) ! Local x1,x2,x3 - INDI=INDXI(XIAXIS) - INDJ=INDXI(XJAXIS) - INDK=INDXI(XKAXIS) - ! Vert at index JJ: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ, KK /) ! Local x1,x2,x3 - INDI1=INDXI(XIAXIS) - INDJ1=INDXI(XJAXIS) - INDK1=INDXI(XKAXIS) - ! Edge at index JJ: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ, KK /) ! Local x1,x2,x3 - INDIE=INDXI(XIAXIS) - INDJE=INDXI(XJAXIS) - INDKE=INDXI(XKAXIS) + ! Test for face with INB edges: + ! If outface2 is true -> no INB Edges associated with this face: + OUTFACE2 = (MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) <= 0) - IF ((MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & - (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) ) & - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID + ! Drop if outface1 & outface2 + IF (OUTFACE1 .AND. OUTFACE2) THEN + ! Test if face is SOLID: + IF ((MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) == CC_SOLID) ) THEN + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID + ENDIF + CYCLE + ENDIF -ENDDO + ENDDO ! JJ + ENDDO ! KK + ENDDO ! II + ENDDO XIAXIS_LOOP_2 -NEDGECROSS_OLD = MESHES(NM) % N_EDGE_CROSS -! Edges with Crossings not on VERTICES: -ICRS_DO : DO ICRS=1,CC_N_CRS +ELSE + DEALLOCATE(IJK_COUNTED) +ENDIF - ! Skip SOLID-SOLID intersections, as there is no media crossing: - IF (CC_IS_CRS(ICRS) == CC_SS) CYCLE +DEALLOCATE(NODEDG_FACE) +DEALLOCATE(CFELEM,CEDGES,CFE,CFEL) - ! Check location on grid of crossing: - ! See if crossing is exactly on a Cartesian cell vertex: - IF (X2NOC==0) THEN - ! Optimized for UG: - JSTR = FLOOR( (CC_SVAR_CRS(ICRS)-GEOMEPS-X2CELL(X2LO_CELL))/DX2CELL(X2LO_CELL) ) + X2LO_CELL - ! Discard cut-edges on Cartesian edges laying > X2HI_CELL. - IF (JSTR < X2LO_CELL-1) CYCLE - IF (JSTR > X2HI_CELL+1) CYCLE +T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW - JJ = JSTR - DELJJ = ABS(X2CELL(JJ)-CC_SVAR_CRS(ICRS)) - DX2CELL(X2LO_CELL)/2._EB - ! Crossing on Vertex? - IF ( ABS(DELJJ) < GEOMEPS ) THEN ! Add crossing to two edges: - JJLOW=0; JJHIGH=1 - ELSEIF ( DELJJ < -GEOMEPS ) THEN ! Crossing in jj Edge. - JJLOW=0; JJHIGH=0 - ELSEIF ( DELJJ > GEOMEPS ) THEN ! Crossing in jj+1 Edge. - JJLOW=1; JJHIGH=1 - ENDIF - ELSE - FOUND_EDGE=.FALSE. - JJLOW = -1000000 - JJHIGH= 1000000 - DO JJ=X2LO_CELL-1,X2HI_CELL - DELJJ = CC_SVAR_CRS(ICRS)-X2CELL(JJ) - XVJJ = X2CELL(JJ) + DX2CELL(JJ)/2._EB - DELJJ1= CC_SVAR_CRS(ICRS)-X2CELL(JJ+1) - ! First two edges: - IF(ABS(CC_SVAR_CRS(ICRS)-XVJJ) < GEOMEPS) THEN ! Both JJ and JJ+1 - FOUND_EDGE=.TRUE. - JJLOW=0; JJHIGH=1 - EXIT - ELSEIF (ABS(DELJJ) < DX2CELL(JJ)/2._EB) THEN ! JJ - FOUND_EDGE=.TRUE. - JJLOW=0; JJHIGH=0 - EXIT - ELSEIF (ABS(DELJJ1)< DX2CELL(JJ+1)/2._EB) THEN ! JJ+1 - FOUND_EDGE=.TRUE. - JJLOW=1; JJHIGH=1 - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_EDGE) CYCLE - ENDIF +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + NCUTFCE = 0 + IF (BNDINT_FLAG) THEN + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_GASPHASE) CYCLE + NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE + ENDDO + ELSE + DO ICF=MESHES(NM)%N_CUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_GASPHASE) CYCLE + NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE + ENDDO + ENDIF + WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-faces : ',NCUTFCE,'. ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-faces : ',NCUTFCE,'. ' + ENDIF +ENDIF - DO JJADD=JJLOW,JJHIGH - ! Edge in the left: - ! Edge at index JJ or JJ+1: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ+JJADD, KK /) ! Local x1,x2,x3 - INDIE=INDXI(XIAXIS) - INDJE=INDXI(XJAXIS) - INDKE=INDXI(XKAXIS) +RETURN - ! Set MESHES(NM)%ECVAR(IE,JE,KE,CC_EGSC,X2AXIS) = CC_CUTCFE: - ICROSS = MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_ECRS,X2AXIS) +CONTAINS - IF ( ICROSS > 0 ) THEN ! Edge has crossings already. +SUBROUTINE REALLOCATE_NODEDG_FACE(N_SEG_CFACE,N_VERT_CFACE) - ! Populate EDGECROSS struct: - NCROSS = MESHES(NM)%EDGE_CROSS(ICROSS)%NCROSS + 1 - MESHES(NM)%EDGE_CROSS(ICROSS) % NCROSS = NCROSS - MESHES(NM)%EDGE_CROSS(ICROSS) % SVAR(NCROSS) = CC_SVAR_CRS(ICRS) - MESHES(NM)%EDGE_CROSS(ICROSS) % ISVAR(NCROSS)= CC_IS_CRS(ICRS) +INTEGER, INTENT(IN) :: N_SEG_CFACE,N_VERT_CFACE +INTEGER :: DFCTE,DFCTV - ELSE ! No crossings yet. +IF ( (N_SEG_CFACE+1 > SIZE_EDGES_NODEDG) .OR. (N_VERT_CFACE > SIZE_VERTS_NODEDG)) THEN + ! Allocation factors: + DFCTE = MAX(0,CEILING(REAL(N_SEG_CFACE+1-SIZE_EDGES_NODEDG,EB)/REAL(DELTA_EDGE,EB))) + DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE -SIZE_VERTS_NODEDG,EB)/REAL(DELTA_VERT,EB))) + DEALLOCATE(NODEDG_FACE) + SIZE_VERTS_NODEDG = SIZE_VERTS_NODEDG + DFCTV*DELTA_VERT + SIZE_EDGES_NODEDG = SIZE_EDGES_NODEDG + DFCTE*DELTA_EDGE + ALLOCATE(NODEDG_FACE(1:SIZE_EDGES_NODEDG,1:SIZE_VERTS_NODEDG)) +ENDIF +RETURN +END SUBROUTINE REALLOCATE_NODEDG_FACE - NEDGECROSS = MESHES(NM)%N_EDGE_CROSS + 1 - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_CUTCFE - MESHES(NM)%N_EDGE_CROSS = NEDGECROSS - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_ECRS,X2AXIS) = NEDGECROSS +SUBROUTINE REALLOCATE_LOCAL_CFELEM(N_VERT_CFACE,N_FACE_CFACE) - CALL EDGE_CROSS_ARRAY_REALLOCATE(NM,NEDGECROSS) +INTEGER, INTENT(IN) :: N_VERT_CFACE, N_FACE_CFACE +INTEGER :: DFCTF,DFCTV - ! Populate EDGECROSS struct: - NCROSS = 1 - MESHES(NM)%EDGE_CROSS(NEDGECROSS) % NCROSS = NCROSS - MESHES(NM)%EDGE_CROSS(NEDGECROSS) % SVAR(NCROSS) = CC_SVAR_CRS(ICRS) - MESHES(NM)%EDGE_CROSS(NEDGECROSS) % ISVAR(NCROSS)= CC_IS_CRS(ICRS) - MESHES(NM)%EDGE_CROSS(NEDGECROSS) % IJK(1:4) = (/ INDIE, INDJE, INDKE, X2AXIS /) +IF ( (N_FACE_CFACE > SIZE_CFACES_CFELEM) .OR. (N_VERT_CFACE+1 > SIZE_VERTS_CFELEM)) THEN + DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE+1-SIZE_VERTS_CFELEM,EB)/REAL(DELTA_VERT,EB))) + DFCTF = MAX(0,CEILING(REAL(N_FACE_CFACE-SIZE_CFACES_CFELEM,EB)/REAL(DELTA_FACE,EB))) + DEALLOCATE(CFELEM) + SIZE_CFACES_CFELEM = SIZE_CFACES_CFELEM + DFCTF*DELTA_FACE + SIZE_VERTS_CFELEM = SIZE_VERTS_CFELEM + DFCTV*DELTA_VERT + ALLOCATE(CFELEM(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) + DEALLOCATE(CFE,CFEL); ALLOCATE(CFE(1:SIZE_VERTS_CFELEM),CFEL(1:SIZE_VERTS_CFELEM)) + IF(ALLOCATED(CEDGES)) DEALLOCATE(CEDGES); ALLOCATE(CEDGES(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) +ENDIF +RETURN +END SUBROUTINE REALLOCATE_LOCAL_CFELEM - ENDIF - ENDDO +SUBROUTINE REALLOCATE_LOCAL_VERT_CFELEM(N_VERT_CFACE) -ENDDO ICRS_DO +INTEGER, INTENT(IN) :: N_VERT_CFACE +INTEGER :: DFCTV +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM_AUX,CEDGES_AUX -! Now Define MESHES(NM)%CUT_EDGE for CC_GASPHASE cut-edges: -DO ICROSS=NEDGECROSS_OLD+1,MESHES(NM)%N_EDGE_CROSS +IF( N_VERT_CFACE > SIZE_VERTS_CFELEM ) THEN + DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE-SIZE_VERTS_CFELEM,EB)/REAL(DELTA_VERT,EB))) + ALLOCATE(CFELEM_AUX(1:SIZE_VERTS_CFELEM+DFCTV*DELTA_VERT,1:SIZE_CFACES_CFELEM)) + CFELEM_AUX(:,:) = CC_UNDEFINED + CFELEM_AUX(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) = CFELEM(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) + ALLOCATE(CEDGES_AUX(1:SIZE_VERTS_CFELEM+DFCTV*DELTA_VERT,1:SIZE_CFACES_CFELEM)) + CEDGES_AUX(:,:) = CC_UNDEFINED + CEDGES_AUX(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) = CEDGES(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) + SIZE_VERTS_CFELEM = SIZE_VERTS_CFELEM + DFCTV*DELTA_VERT + CALL MOVE_ALLOC(FROM=CFELEM_AUX,TO=CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=CEDGES) + ! Now Reallocate CFE, CFEL: + DEALLOCATE(CFE,CFEL); ALLOCATE(CFE(1:SIZE_VERTS_CFELEM),CFEL(1:SIZE_VERTS_CFELEM)) +ENDIF +RETURN +END SUBROUTINE REALLOCATE_LOCAL_VERT_CFELEM - ! Discard edge outside of blocks ranges for ray on x2axis: - IF ( (MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS) < X2LO_CELL) .OR. & - (MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS) > X2HI_CELL) ) CYCLE +END SUBROUTINE GET_CARTFACE_CUTFACES - NCROSS = MESHES(NM)%EDGE_CROSS(ICROSS)%NCROSS - ! Edge Location in x1,x2,x3 axes: - ! Vert at index JJ-1: - INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)-1, & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 - INDI=INDXI(XIAXIS) - INDJ=INDXI(XJAXIS) - INDK=INDXI(XKAXIS) - ! Vert at index JJ: - INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS), & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 - INDI1=INDXI(XIAXIS) - INDJ1=INDXI(XJAXIS) - INDK1=INDXI(XKAXIS) - ! Edge at index jj: - INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS), & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 - INDIE=INDXI(XIAXIS) ! i.e. MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(IAXIS), etc. - INDJE=INDXI(XJAXIS) - INDKE=INDXI(XKAXIS) +! ---------------- DEFINE_REGULAR_CUTFACES -------------------------- - ! Discard Edge with one EDGECROSS and both vertices having VERTVAR = CC_SOLID: - ! The crossing is on one of the edge vertices. - IF ( (NCROSS == 1) .AND. & - (MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & - (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) ) THEN +SUBROUTINE DEFINE_REGULAR_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID - CYCLE +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN) :: BNDINT_FLAG - ENDIF +! Local Variables: +INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI,X1AXIS,NVERT,NFACE,I,J,K,NCUTFACE +INTEGER :: IBNDINT,BNDINT_LOW,BNDINT_HIGH - ! Discard cases for edge with two crossings: - IF ( NCROSS == 2 ) THEN +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED - VSOLID = (MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & - (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) +CALL POINT_TO_MESH(NM) - ! Test if crossings lay on same location + solid vertices: - DIF = ( MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(2) - & - MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(1) ) < GEOMEPS - IF (DIF .AND. VSOLID) THEN - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID - CYCLE - ENDIF +! Mesh sizes: +NXB=IBAR +NYB=JBAR +NZB=KBAR - DIF = (ABS(X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)-1 ) - & - MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(1)) < GEOMEPS) .AND. & - (ABS(X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)) - & - MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(2)) < GEOMEPS) +! Test Sizes: +IF (PERIODIC_TEST == 7 ) THEN + VAL_TESTX_LOW =-.5_EB + VAL_TESTX_HIGH= .5_EB + VAL_TESTY_LOW = YS + VAL_TESTY_HIGH= YF + VAL_TESTZ_LOW =-.5_EB + VAL_TESTZ_HIGH= .5_EB +ELSEIF (PERIODIC_TEST == 11) THEN + VAL_TESTX_LOW =-.5_EB + VAL_TESTX_HIGH= .5_EB + VAL_TESTY_LOW = YS + VAL_TESTY_HIGH= YF + VAL_TESTZ_LOW = ZS + VAL_TESTZ_HIGH= ZF +ELSEIF (PERIODIC_TEST == 103) THEN + VAL_TESTX_LOW =-1.0_EB + VAL_TESTX_HIGH= 1.0_EB + VAL_TESTY_LOW =-1.0_EB + VAL_TESTY_HIGH= 1.0_EB + VAL_TESTZ_LOW = 1.0_EB + VAL_TESTZ_HIGH= 3.0_EB +ENDIF - VFLUID = (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(1) == CC_GS) .AND. & - (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(2) == CC_SG) - IF (DIF .AND. VSOLID .AND. VFLUID) THEN - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID - CYCLE - ENDIF +! Main Loop on block NM: +IF (BNDINT_FLAG) THEN + ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. + BNDINT_LOW = 1 + BNDINT_HIGH = 3 +ELSE + BNDINT_LOW = 4 + BNDINT_HIGH = 4 +ENDIF - ENDIF +IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, + ! 4 guard-cell faces. - ! New CUT_EDGE struct for this edge: - NCUTEDGE = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = NCUTEDGE - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_IDCE,X2AXIS)= NCUTEDGE + ! When switching to internal faces, copy number of external faces already computed. + IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH - CALL CUT_EDGE_ARRAY_REALLOC(NM,NCUTEDGE) + ! First tag and define Gasphase cut-faces in X,Y,Z directions. + ! X direction: + ! IAXIS gasphase cut-faces: + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + ILO = ILO_FACE; IHI = ILO_FACE + CASE(2) + ILO = IHI_FACE; IHI = IHI_FACE + CASE(3) + ILO = ILO_FACE+1; IHI = IHI_FACE-1 + CASE(4) + ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT + X1AXIS=IAXIS + NVERT = 4 + NFACE = 1 + DO I=ILO,IHI + DO J=JLO,JHI + DO K=KLO,KHI - MESHES(NM)%CUT_EDGE(NCUTEDGE)%STATUS = CC_GASPHASE - MESHES(NM)%CUT_EDGE(NCUTEDGE)%IJK(1:MAX_DIM+1) = MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(1:MAX_DIM+1) - MESHES(NM)%CUT_EDGE(NCUTEDGE)%IJK(MAX_DIM+2) = CC_UNDEFINED ! No need to define CUT_EDGE type (is CC_GASPHASE). - ! First Vertices: - NVERT = NCROSS + 2 - MESHES(NM)%CUT_EDGE(NCUTEDGE)%NVERT = NVERT - X123VERT(IAXIS:KAXIS,1:NVERT) = 0._EB - X123VERT(IAXIS,1:NVERT) = X1FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS)) - X123VERT(JAXIS,1) = X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)-1) - X123VERT(JAXIS,2:NCROSS+1)= MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(1:NCROSS) - X123VERT(JAXIS,NVERT) = X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)) - X123VERT(KAXIS,1:NVERT) = X3FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS)) + ! If cut-cell centroid is outside the test box -> drop: + IF(XFACE(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XFACE(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE + IF(YCELL(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YCELL(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE + IF(ZCELL(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZCELL(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE - ! Allocate new edge XYZVERT, CEELEM, INDSEG - CALL NEW_EDGE_ALLOC(NM,NCUTEDGE,NVERT,CC_ALLOC_DELEM) - DO IVERT=1,MESHES(NM)%CUT_EDGE(NCUTEDGE)%NVERT - MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT(IAXIS:KAXIS,IVERT) = & - X123VERT( (/ XIAXIS, XJAXIS, XKAXIS /) ,IVERT) - ENDDO + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. - ! Now Cut Edges: - ! Node List: - VERT_LIST(:,:) = CC_UNDEFINED - VERT_LIST(1,:) = CC_VTYPE_NINB ! Nodes by default are in boundary. - CE=>MESHES(NM)%CUT_EDGE(NCUTEDGE) - DO IVERT=1,CE%NVERT - ! NOD1: - IF(ABS(CE%XYZVERT(IAXIS,IVERT)-XFACE(INDI )) MESHES(NM)%CUT_FACE(NCUTFACE) - ! Do a SOLID crossing count up to XYZcen(x2axis): - SCEN=XYZCEN(X2AXIS) - CALL GET_IS_GASPHASE(SCEN,IS_GASPHASE) + ! Vertices: + CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) + CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) + CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) + CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) - IF ( IS_GASPHASE ) THEN - NEDGE = NEDGE + 1 - ! Test for size of CEELEM, INDSEG, if smaller than NEDGE reallocate: - CALL REALLOCATE_EDGE_ELEM(NM,NCUTEDGE,NEDGE) - MESHES(NM)%CUT_EDGE(NCUTEDGE)%NEDGE = NEDGE - MESHES(NM)%CUT_EDGE(NCUTEDGE)%CEELEM(NOD1:NOD2,NEDGE) = (/ IVERT, IVERT+1 /) - ENDIF + ! Centroid: + CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & + (/ XFACE(I )+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) + + ! Load Ordered nodes to CFELEM and geom properties: + CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) + CF%AREA(NFACE) = DYCELL(J)*DZCELL(K) + + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: + CF%INXAREA(NFACE) = XFACE(I)*CF%AREA(NFACE) + ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: + CF%INXSQAREA(NFACE) = XFACE(I)**2._EB*CF%AREA(NFACE) + ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: + CF%JNYSQAREA(NFACE) = 0._EB + ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: + CF%KNZSQAREA(NFACE) = 0._EB + ENDDO + ENDDO ENDDO - IF (MESHES(NM)%CUT_EDGE(NCUTEDGE)%NEDGE == 0) THEN ! REWIND - DEALLOCATE(MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT) - DEALLOCATE(MESHES(NM)%CUT_EDGE(NCUTEDGE)%CEELEM) - DEALLOCATE(MESHES(NM)%CUT_EDGE(NCUTEDGE)%INDSEG) - DEALLOCATE(MESHES(NM)%CUT_EDGE(NCUTEDGE)%VERT_LIST) - NCUTEDGE = NCUTEDGE - 1 - MESHES(NM)%N_CUTEDGE_MESH = NCUTEDGE - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_IDCE,X2AXIS) = 0 - ENDIF + ! Y direction: + ! JAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + JLO = JLO_FACE; JHI = JLO_FACE + CASE(2) + JLO = JHI_FACE; JHI = JHI_FACE + CASE(3) + JLO = JLO_FACE+1; JHI = JHI_FACE-1 + CASE(4) + JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT + X1AXIS=JAXIS + NVERT = 4 + NFACE = 1 + DO I=ILO,IHI + DO J=JLO,JHI + DO K=KLO,KHI -ENDDO + ! If cut-cell centroid is outside the test box -> drop: + IF(XCELL(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XCELL(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE + IF(YFACE(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YFACE(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE + IF(ZCELL(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZCELL(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE -T_CC_USED(GET_CARTEDGE_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTEDGE_CUTEDGES_TIME_INDEX) + CURRENT_TIME() - TNOW + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. -RETURN -END SUBROUTINE GET_CARTEDGE_CUTEDGES + FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (BNDINT_FLAG) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF -! ------------------------EDGE_CROSS_ARRAY_REALLOCATE---------------------------- + FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE -SUBROUTINE EDGE_CROSS_ARRAY_REALLOCATE(NM,CEI) + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -INTEGER, INTENT(IN) :: NM, CEI + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, X1AXIS /) + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERT+1,IBNDINT) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) -! Local Variables: -INTEGER :: CEI1, SIZE_EDGE_CROSS + ! Vertices: + CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) + CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) + CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) + CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) -SIZE_EDGE_CROSS = SIZE(MESHES(NM)%EDGE_CROSS,DIM=1) -IF(CEI > SIZE_EDGE_CROSS) THEN - ALLOCATE(EDGE_CROSS_AUX(SIZE_EDGE_CROSS+GLOBAL_DELTA_EDGE)) - DO CEI1=1,CEI-1 - EDGE_CROSS_AUX(CEI1)%NCROSS = MESHES(NM)%EDGE_CROSS(CEI1)%NCROSS - EDGE_CROSS_AUX(CEI1)%SVAR = MESHES(NM)%EDGE_CROSS(CEI1)%SVAR - EDGE_CROSS_AUX(CEI1)%ISVAR = MESHES(NM)%EDGE_CROSS(CEI1)%ISVAR - EDGE_CROSS_AUX(CEI1)%IJK = MESHES(NM)%EDGE_CROSS(CEI1)%IJK - ENDDO - CALL MOVE_ALLOC(FROM=EDGE_CROSS_AUX, TO=MESHES(NM)%EDGE_CROSS) -ENDIF + ! Centroid: + CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & + (/ XFACE(I-1)+XFACE(I ), YFACE(J )+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) -RETURN -END SUBROUTINE EDGE_CROSS_ARRAY_REALLOCATE + ! Load Ordered nodes to CFELEM and geom properties: + CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) + CF%AREA(NFACE) = DXCELL(I)*DZCELL(K) + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: + CF%INXAREA(NFACE) = 0._EB + ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: + CF%INXSQAREA(NFACE) = 0._EB + ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: + CF%JNYSQAREA(NFACE) = YFACE(J)**2._EB*CF%AREA(NFACE) + ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: + CF%KNZSQAREA(NFACE) = 0._EB + ENDDO + ENDDO + ENDDO -! --------------------------CUT_EDGE_ARRAY_REALLOC------------------------------- + ! Z direction: + ! KAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + KLO = KLO_FACE; KHI = KLO_FACE + CASE(2) + KLO = KHI_FACE; KHI = KHI_FACE + CASE(3) + KLO = KLO_FACE+1; KHI = KHI_FACE-1 + CASE(4) + KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + END SELECT + X1AXIS=KAXIS + NVERT = 4 + NFACE = 1 + DO I=ILO,IHI + DO J=JLO,JHI + DO K=KLO,KHI -SUBROUTINE CUT_EDGE_ARRAY_REALLOC(NM,CEI) + ! If cut-cell centroid is outside the test box -> drop: + IF(XCELL(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XCELL(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE + IF(YCELL(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YCELL(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE + IF(ZFACE(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZFACE(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE -INTEGER, INTENT(IN) :: NM, CEI + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. -! Local Variables: -INTEGER :: CEI1, SIZE_CUT_EDGE + FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE -SIZE_CUT_EDGE = SIZE(MESHES(NM)%CUT_EDGE,DIM=1) -IF (CEI > SIZE_CUT_EDGE) THEN - ALLOCATE(CUT_EDGE_AUX(SIZE_CUT_EDGE+GLOBAL_DELTA_EDGE)) - DO CEI1=1,CEI-1 - CUT_EDGE_AUX(CEI1)%NVERT = MESHES(NM)%CUT_EDGE(CEI1)%NVERT - CUT_EDGE_AUX(CEI1)%NEDGE = MESHES(NM)%CUT_EDGE(CEI1)%NEDGE - CUT_EDGE_AUX(CEI1)%NEDGE1 = MESHES(NM)%CUT_EDGE(CEI1)%NEDGE1 - CUT_EDGE_AUX(CEI1)%STATUS = MESHES(NM)%CUT_EDGE(CEI1)%STATUS - CUT_EDGE_AUX(CEI1)%IJK = MESHES(NM)%CUT_EDGE(CEI1)%IJK - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%XYZVERT, TO=CUT_EDGE_AUX(CEI1)%XYZVERT) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%CEELEM, TO=CUT_EDGE_AUX(CEI1)%CEELEM) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%INDSEG, TO=CUT_EDGE_AUX(CEI1)%INDSEG) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%VERT_LIST, TO=CUT_EDGE_AUX(CEI1)%VERT_LIST) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%NOD_PERM, TO=CUT_EDGE_AUX(CEI1)%NOD_PERM) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%DXX, TO=CUT_EDGE_AUX(CEI1)%DXX) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%FACE_LIST, TO=CUT_EDGE_AUX(CEI1)%FACE_LIST) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%DUIDXJ, TO=CUT_EDGE_AUX(CEI1)%DUIDXJ) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%MU_DUIDXJ, TO=CUT_EDGE_AUX(CEI1)%MU_DUIDXJ) - ENDDO - CALL MOVE_ALLOC(FROM=CUT_EDGE_AUX, TO=MESHES(NM)%CUT_EDGE) -ENDIF + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (BNDINT_FLAG) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF -RETURN -END SUBROUTINE CUT_EDGE_ARRAY_REALLOC + FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -! ----------------------------- NEW_EDGE_ALLOC ---------------------------------- + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, X1AXIS /) + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERT+1,IBNDINT) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) -SUBROUTINE NEW_EDGE_ALLOC(NM,CEI,NVERTALLOC,NEDGEALLOC) + ! Vertices: + CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) + CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) + CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) + CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) -INTEGER, INTENT(IN) :: NM, CEI, NVERTALLOC, NEDGEALLOC + ! Centroid: + CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & + (/ XFACE(I-1)+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K )+ZFACE(K ) /) -IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT) -IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM) -IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%CEELEM)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM) -IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%INDSEG)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%INDSEG) -IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST) + ! Load Ordered nodes to CFELEM and geom properties: + CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) + CF%AREA(NFACE) = DXCELL(I)*DYCELL(J) + + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: + CF%INXAREA(NFACE) = 0._EB + ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: + CF%INXSQAREA(NFACE) = 0._EB + ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: + CF%JNYSQAREA(NFACE) = 0._EB + ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: + CF%KNZSQAREA(NFACE) = ZFACE(K)**2._EB*CF%AREA(NFACE) + ENDDO + ENDDO + ENDDO -ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:NVERTALLOC)) -ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(1:NVERTALLOC)) -ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGEALLOC)) -ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%INDSEG(CC_MAX_WSTRIANG_SEG+3,1:NEDGEALLOC)) -ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(CC_MAX_WSTRIANG_SEG+2,1:NVERTALLOC)) +ENDDO IBNDINT_LOOP -MESHES(NM)%CUT_EDGE(CEI)%XYZVERT = 0._EB -MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM = CC_UNDEFINED -MESHES(NM)%CUT_EDGE(CEI)%CEELEM = CC_UNDEFINED -MESHES(NM)%CUT_EDGE(CEI)%INDSEG = CC_UNDEFINED -MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST= CC_UNDEFINED +IF (.NOT.BNDINT_FLAG) DEALLOCATE( IJK_COUNTED ) RETURN +END SUBROUTINE DEFINE_REGULAR_CUTFACES -END SUBROUTINE NEW_EDGE_ALLOC -! ------------------ REALLOCATE_EDGE_VERT(NM,CEI,NVERT) ------------------------- +! ---------------------------- SORT_VERTS --------------------------------------- -SUBROUTINE REALLOCATE_EDGE_VERT(NM,CEI,NVERT) +SUBROUTINE SORT_VERTS(MAXVERTS,NVERTS,VERTS1,VERTS2,XV,ASCDESC,NV,V) -INTEGER, INTENT(IN) :: NM, CEI, NVERT +INTEGER, INTENT(IN) :: MAXVERTS, NVERTS +REAL(EB),INTENT(IN) :: VERTS1(MAXVERTS),VERTS2(MAXVERTS),XV +LOGICAL, INTENT(IN) :: ASCDESC +INTEGER, INTENT(OUT):: NV,V(MAXVERTS) ! Local Variables: -INTEGER :: NVERT_SIZE -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZVERTAUX -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: VERT_LISTAUX -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOD_PERMAUX +INTEGER :: IV, IIV, JJV +INTEGER :: V2(MAXVERTS) +LOGICAL :: FOUND -NVERT_SIZE = SIZE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT, DIM=2) +V(:) = 0 +NV = 0 +DO IV=1,NVERTS + IF (ABS(VERTS1(IV)-XV) < GEOMEPS) THEN + IF (NV==0) THEN + NV=1; V(NV)=IV + ELSE + ! Insert add IV, using ascending X3: + FOUND=.FALSE. + DO IIV=1,NV + IF ( (VERTS2(IV)-VERTS2(V(IIV))) < 0._EB ) THEN + FOUND=.TRUE. + EXIT + ENDIF + ENDDO + IF (FOUND) THEN + DO JJV=NV+1,IIV+1,-1 + V(JJV) = V(JJV-1) + ENDDO + V(IIV) = IV + ELSE + V(IIV) = IV ! Here IIV = NV+1, as loop leaves it to that value. + ENDIF + NV=NV+1 + ENDIF + ENDIF +ENDDO +IF (.NOT.ASCDESC) THEN + V2(1:NV) = V(1:NV) + DO IV=1,NV; V(NV+1-IV)=V2(IV); ENDDO +ENDIF -IF (NVERT > NVERT_SIZE) THEN ! Reallocate XYZVERT - ALLOCATE(XYZVERTAUX(IAXIS:KAXIS,1:NVERT_SIZE+CC_ALLOC_DVERT)); XYZVERTAUX = 0._EB - XYZVERTAUX(IAXIS:KAXIS,1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:NVERT_SIZE) - CALL MOVE_ALLOC(FROM=XYZVERTAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%XYZVERT) +RETURN +END SUBROUTINE SORT_VERTS - ALLOCATE(NOD_PERMAUX(1:NVERT_SIZE+CC_ALLOC_DVERT)); NOD_PERMAUX = CC_UNDEFINED - NOD_PERMAUX(1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(1:NVERT_SIZE) - CALL MOVE_ALLOC(FROM=NOD_PERMAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM) +! ----------------------------- FACE_REALLOC ------------------------------------- - ALLOCATE(VERT_LISTAUX(1:4,1:NVERT_SIZE+CC_ALLOC_DVERT)); VERT_LISTAUX = CC_UNDEFINED - VERT_LISTAUX(1:4,1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,1:NVERT_SIZE) - CALL MOVE_ALLOC(FROM=VERT_LISTAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST) -ENDIF +SUBROUTINE FACE_REALLOC(NM,ICF,NVERT,NFACE,NSVERT,NSFACE,NVERTFACE_NEW) -RETURN +INTEGER, INTENT(IN) :: NM,ICF,NVERT,NFACE,NSVERT,NSFACE +INTEGER, INTENT(INOUT) :: NVERTFACE_NEW -END SUBROUTINE REALLOCATE_EDGE_VERT +! Local Variables: +INTEGER :: NVERTFACE +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZVERT, XYZCEN, REAL2D +REAL(EB), ALLOCATABLE, DIMENSION(:) :: AREA, REAL1D +INTEGER, ALLOCATABLE, DIMENSION(:) :: INT1D +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM, INT2D ! Cut-faces connectivities. +INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: INT3D +LOGICAL, ALLOCATABLE, DIMENSION(:) :: SHARED -! ------------------ REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) ------------------------- +NVERTFACE=SIZE(MESHES(NM)%CUT_FACE(ICF)%CFELEM,DIM=1) +NVERTFACE_NEW = MAX(NVERTFACE_NEW,NVERTFACE) -SUBROUTINE REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) +IF(SIZE(MESHES(NM)%CUT_FACE(ICF)%XYZVERT,DIM=2) < NVERT+NSVERT) THEN + ! Allocate and initialize NVERT related fields: + ALLOCATE(XYZVERT(IAXIS:KAXIS,1:NVERT+NSVERT)); XYZVERT = 0._EB + XYZVERT(IAXIS:KAXIS,1:NVERT)=MESHES(NM)%CUT_FACE(ICF)%XYZVERT(IAXIS:KAXIS,1:NVERT) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=MESHES(NM)%CUT_FACE(ICF)%XYZVERT) +ENDIF -INTEGER, INTENT(IN) :: NM, CEI, NEDGE +IF(SIZE(MESHES(NM)%CUT_FACE(ICF)%AREA,DIM=1) NEDGE_SIZE) THEN ! Reallocate CEELEM, + ALLOCATE(SHARED(1:NFACE+NSFACE)); SHARED = .FALSE. + SHARED(1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%SHARED(1:NFACE) + CALL MOVE_ALLOC(FROM=SHARED,TO=MESHES(NM)%CUT_FACE(ICF)%SHARED) - CC_ALLOC_ELEM = MAX(NEDGE-NEDGE_SIZE,CC_ALLOC_DELEM) + ALLOCATE(SHARED(1:NFACE+NSFACE)); SHARED = .FALSE. + SHARED(1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%BLK_TAG(1:NFACE) + CALL MOVE_ALLOC(FROM=SHARED,TO=MESHES(NM)%CUT_FACE(ICF)%BLK_TAG) - ALLOCATE(CEELEMAUX(NOD1:NOD2,1:NEDGE_SIZE+CC_ALLOC_ELEM), INDSEGAUX(CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE+CC_ALLOC_ELEM)) - CEELEMAUX = CC_UNDEFINED; INDSEGAUX = CC_UNDEFINED + ALLOCATE(INT2D(1:2,1:NFACE+NSFACE)); INT2D=CC_UNDEFINED + INT2D(1:2,1:NFACE)=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1:2,1:NFACE) + CALL MOVE_ALLOC(FROM=INT2D,TO=MESHES(NM)%CUT_FACE(ICF)%BODTRI) - CEELEMAUX(NOD1:NOD2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGE_SIZE) - INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE) + ALLOCATE(INT2D(LOW_IND:HIGH_IND,1:NFACE+NSFACE)); INT2D = CC_UNDEFINED + INT2D(LOW_IND:HIGH_IND,1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%UNKZ(LOW_IND:HIGH_IND,1:NFACE) + CALL MOVE_ALLOC(FROM=INT2D,TO=MESHES(NM)%CUT_FACE(ICF)%UNKZ) - CALL MOVE_ALLOC(FROM=CEELEMAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%CEELEM) - CALL MOVE_ALLOC(FROM=INDSEGAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%INDSEG) + ALLOCATE(REAL2D(IAXIS:KAXIS,1:NFACE+NSFACE)); REAL2D = 0._EB + REAL2D(IAXIS:KAXIS,1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%XCENLOW(IAXIS:KAXIS,1:NFACE) + CALL MOVE_ALLOC(FROM=REAL2D,TO=MESHES(NM)%CUT_FACE(ICF)%XCENLOW) + ALLOCATE(REAL2D(IAXIS:KAXIS,1:NFACE+NSFACE)); REAL2D = 0._EB + REAL2D(IAXIS:KAXIS,1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%XCENHIGH(IAXIS:KAXIS,1:NFACE) + CALL MOVE_ALLOC(FROM=REAL2D,TO=MESHES(NM)%CUT_FACE(ICF)%XCENHIGH) - IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST)) THEN - ! FACE_LIST, DXX, DUIDXJ, MU_DUIDXJ: - ALLOCATE(FACE_LIST_AUX(1:3,-2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); FACE_LIST_AUX=CC_UNDEFINED - FACE_LIST_AUX(1:3,-2:2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,1:NEDGE_SIZE) - CALL MOVE_ALLOC(FROM=FACE_LIST_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST) + ALLOCATE(INT3D(MAX_DIM+1,LOW_IND:HIGH_IND,1:NFACE+NSFACE)); INT3D = CC_UNDEFINED + INT3D(1:MAX_DIM+1,LOW_IND:HIGH_IND,1:NFACE) = & + MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(1:MAX_DIM+1,LOW_IND:HIGH_IND,1:NFACE) + CALL MOVE_ALLOC(FROM=INT3D,TO=MESHES(NM)%CUT_FACE(ICF)%CELL_LIST) - ALLOCATE(DXX_AUX(1:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); DXX_AUX=0._EB - DXX_AUX(1:2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%DXX(1:2,1:NEDGE_SIZE) - CALL MOVE_ALLOC(FROM=DXX_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%DXX) + ALLOCATE(INT1D(1:NFACE+NSFACE)); INT1D=CC_UNDEFINED + INT1D(1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX(1:NFACE) + CALL MOVE_ALLOC(FROM=INT1D,TO=MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX) - ALLOCATE(DUIDXJ_AUX( -2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); DUIDXJ_AUX = 0._EB - ALLOCATE(MU_DUIDXJ_AUX(-2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); MU_DUIDXJ_AUX= 0._EB + ALLOCATE(REAL1D(1:NFACE+NSFACE)); REAL1D = 1._EB + CALL MOVE_ALLOC(FROM=REAL1D,TO=MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST) - CALL MOVE_ALLOC(FROM=DUIDXJ_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%DUIDXJ) - CALL MOVE_ALLOC(FROM=MU_DUIDXJ_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%MU_DUIDXJ) - ENDIF + ALLOCATE(INT1D(1:NFACE+NSFACE)); INT1D=NOT_BLOCKED + INT1D(1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN(1:NFACE) + CALL MOVE_ALLOC(FROM=INT1D,TO=MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN) + ENDIF ENDIF RETURN -END SUBROUTINE REALLOCATE_EDGE_ELEM +END SUBROUTINE FACE_REALLOC -! -------------------------- GET_ISGASPHASE ------------------------------------- -SUBROUTINE GET_IS_GASPHASE(SCEN,IS_GASPHASE) +! ---------------------- CUT_FACE_ARRAY_REALLOC ------------------------------- -REAL(EB), INTENT(IN) :: SCEN -LOGICAL, INTENT(OUT) :: IS_GASPHASE +SUBROUTINE CUT_FACE_ARRAY_REALLOC(NM,ICF) + +INTEGER, INTENT(IN) :: NM,ICF ! Local Variables: -LOGICAL :: IS_GASPHASE_LEFT, IS_GASPHASE_RIGHT -INTEGER :: ICRS +INTEGER :: ICF1, SIZE_CUT_FACE -! Count GS,SG intersections from both sides: -IS_GASPHASE_LEFT = .TRUE. -DO ICRS=1,CC_N_CRS - IF (SCEN < CC_SVAR_CRS(ICRS)-GEOMEPS/2._EB) CYCLE - ! If solid change state: - IF ( (CC_IS_CRS(ICRS) == CC_GS) .OR. (CC_IS_CRS(ICRS) == CC_SG) ) THEN - IS_GASPHASE_LEFT = .NOT.IS_GASPHASE_LEFT - ENDIF -ENDDO +SIZE_CUT_FACE = SIZE(MESHES(NM)%CUT_FACE,DIM=1) -IS_GASPHASE_RIGHT = .TRUE. -DO ICRS=CC_N_CRS,1,-1 - IF (SCEN > CC_SVAR_CRS(ICRS)+GEOMEPS/2._EB) CYCLE - ! If solid change state: - IF ( (CC_IS_CRS(ICRS) == CC_GS) .OR. (CC_IS_CRS(ICRS) == CC_SG) ) THEN - IS_GASPHASE_RIGHT = .NOT.IS_GASPHASE_RIGHT - ENDIF -ENDDO +IF(ICF > SIZE_CUT_FACE) THEN -! If at least one of left and right are true -> add -! CC_GASPHASE cut-edge: -IS_GASPHASE = IS_GASPHASE_LEFT .OR. IS_GASPHASE_RIGHT + ALLOCATE(CUT_FACE_AUX(SIZE_CUT_FACE+GLOBAL_DELTA_FACE)) + + DO ICF1=1,ICF-1 + CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(ICF1),CUT_FACE_AUX(ICF1)) + ENDDO + CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE) +ENDIF RETURN -END SUBROUTINE GET_IS_GASPHASE +END SUBROUTINE CUT_FACE_ARRAY_REALLOC -! --------------------- GET_BODX2_INTERSECTIONS --------------------------------- -SUBROUTINE GET_BODX2_INTERSECTIONS(X2AXIS,X3AXIS,X3RAY) +! --------------------------- CUT_FACE_MOVE ------------------------------------- -INTEGER, INTENT(IN) :: X2AXIS,X3AXIS -REAL(EB),INTENT(IN) :: X3RAY +SUBROUTINE CUT_FACE_MOVE(CUT_FACE_FROM,CUT_FACE_TO) -! Local Variables: -REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN, SBOD -REAL(EB) :: STANI(IAXIS:JAXIS), DV(IAXIS:JAXIS) -INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IBCR, IDUM, NBCROSS_SVAR -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX -REAL(EB) :: DX3_1, DX3_2, XI1, XI2 -REAL(EB) :: TNOW +TYPE(CC_CUTFACE_TYPE), INTENT(INOUT) :: CUT_FACE_FROM, CUT_FACE_TO -! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX3_1Q,DX3_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) +CUT_FACE_TO%IWC = CUT_FACE_FROM%IWC +CUT_FACE_TO%PRES_ZONE = CUT_FACE_FROM%PRES_ZONE +CUT_FACE_TO%NVERT = CUT_FACE_FROM%NVERT +CUT_FACE_TO%NSVERT = CUT_FACE_FROM%NSVERT +CUT_FACE_TO%NFACE = CUT_FACE_FROM%NFACE +CUT_FACE_TO%NSFACE = CUT_FACE_FROM%NSFACE +CUT_FACE_TO%STATUS = CUT_FACE_FROM%STATUS +CUT_FACE_TO%IJK = CUT_FACE_FROM%IJK + +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XYZVERT, TO=CUT_FACE_TO%XYZVERT) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CFELEM, TO=CUT_FACE_TO%CFELEM) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CEDGES, TO=CUT_FACE_TO%CEDGES) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%AREA, TO=CUT_FACE_TO%AREA) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%AREA_ADJUST, TO=CUT_FACE_TO%AREA_ADJUST) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XYZCEN, TO=CUT_FACE_TO%XYZCEN) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%SHARED, TO=CUT_FACE_TO%SHARED) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%BLK_TAG, TO=CUT_FACE_TO%BLK_TAG) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CFACE_ORIGIN, TO=CUT_FACE_TO%CFACE_ORIGIN) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%LINK_LEV, TO=CUT_FACE_TO%LINK_LEV) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INXAREA, TO=CUT_FACE_TO%INXAREA) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INXSQAREA, TO=CUT_FACE_TO%INXSQAREA) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%JNYSQAREA, TO=CUT_FACE_TO%JNYSQAREA) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%KNZSQAREA, TO=CUT_FACE_TO%KNZSQAREA) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%BODTRI, TO=CUT_FACE_TO%BODTRI) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%UNKH, TO=CUT_FACE_TO%UNKH) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%UNKZ, TO=CUT_FACE_TO%UNKZ) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XCENLOW, TO=CUT_FACE_TO%XCENLOW) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XCENHIGH, TO=CUT_FACE_TO%XCENHIGH) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%ZZ_FACE, TO=CUT_FACE_TO%ZZ_FACE) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%TMP_FACE, TO=CUT_FACE_TO%TMP_FACE) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%RHO_D_DZDN, TO=CUT_FACE_TO%RHO_D_DZDN) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%H_RHO_D_DZDN, TO=CUT_FACE_TO%H_RHO_D_DZDN) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL, TO=CUT_FACE_TO%VEL) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VELS, TO=CUT_FACE_TO%VELS) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%FN, TO=CUT_FACE_TO%FN) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%FN_B, TO=CUT_FACE_TO%FN_B) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_SAVE, TO=CUT_FACE_TO%VEL_SAVE) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_LNK, TO=CUT_FACE_TO%VEL_LNK) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_OMESH, TO=CUT_FACE_TO%VEL_OMESH) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VELS_OMESH, TO=CUT_FACE_TO%VELS_OMESH) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_LNK_OMESH, TO=CUT_FACE_TO%VEL_LNK_OMESH) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%FN_OMESH, TO=CUT_FACE_TO%FN_OMESH) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%JDH, TO=CUT_FACE_TO%JDH) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%EDGE_LIST, TO=CUT_FACE_TO%EDGE_LIST) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CELL_LIST, TO=CUT_FACE_TO%CELL_LIST) -TNOW=CURRENT_TIME() +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_IJK, TO=CUT_FACE_TO%INT_IJK) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_COEF, TO=CUT_FACE_TO%INT_COEF) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_DCOEF, TO=CUT_FACE_TO%INT_DCOEF) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_XYZBF, TO=CUT_FACE_TO%INT_XYZBF) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NOUT, TO=CUT_FACE_TO%INT_NOUT) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_INBFC, TO=CUT_FACE_TO%INT_INBFC) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NPE, TO=CUT_FACE_TO%INT_NPE) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_XN, TO=CUT_FACE_TO%INT_XN) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_CN, TO=CUT_FACE_TO%INT_CN) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_FVARS, TO=CUT_FACE_TO%INT_FVARS) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NOMIND, TO=CUT_FACE_TO%INT_NOMIND) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_CVARS, TO=CUT_FACE_TO%INT_CVARS) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%UNKF, TO=CUT_FACE_TO%UNKF) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CFACE_INDEX, TO=CUT_FACE_TO%CFACE_INDEX) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%SURF_INDEX, TO=CUT_FACE_TO%SURF_INDEX) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%NOMICF, TO=CUT_FACE_TO%NOMICF) -IF ( BODINT_PLANE%NSEGS == 0) RETURN +RETURN +END SUBROUTINE CUT_FACE_MOVE -DO ISEG=1,BODINT_PLANE%NSEGS - IF (BODINT_PLANE%X2ALIGNED(ISEG)) CYCLE - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - IF( (X3RAY-MAX(BODINT_PLANE%XYZ(X3AXIS,SEG(NOD1)),BODINT_PLANE%XYZ(X3AXIS,SEG(NOD2)))) > GEOMEPS) CYCLE - IF( (MIN(BODINT_PLANE%XYZ(X3AXIS,SEG(NOD1)),BODINT_PLANE%XYZ(X3AXIS,SEG(NOD2)))-X3RAY) > GEOMEPS) CYCLE - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) +! ---------------------------- FACE_DEALLOC ------------------------------------- - ! x2_x3 of segment point 1: - X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) - ! x2_x3 of segment point 2: - X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) +SUBROUTINE FACE_DEALLOC(NM,ICF,DO_BNCF) - ! IF (.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - ! Segment length: - SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) +INTEGER, INTENT(IN) :: NM,ICF +INTEGER, OPTIONAL, INTENT(IN) :: DO_BNCF - ! Unit vector along segment: - STANI(IAXIS:JAXIS) = 1._EB/SLEN * (/ (X2_2-X2_1), (X3_2-X3_1) /) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XYZVERT)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZVERT) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CFELEM)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFELEM) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CEDGES)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CEDGES) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%AREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST) +IF(.NOT.PRESENT(DO_BNCF)) THEN + MESHES(NM)%CUT_FACE(ICF)%NFACE = 0 + IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XYZCEN)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZCEN) +ENDIF +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%SHARED)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SHARED) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA) - ! S coordinate along segment: - DX3_1 = X3_2 - X3RAY - DX3_2 = X3RAY- X3_1 - XI1 = DX3_1 / (X3_2-X3_1) - XI2 = DX3_2 / (X3_2-X3_1) - DV(IAXIS:JAXIS) = (/ (XI1-1._EB)*X2_1+XI2*X2_2 , DX3_2 /) - SBOD = DV(IAXIS)*STANI(IAXIS)+DV(JAXIS)*STANI(JAXIS) - ! ELSE - ! ! Segment length: - ! X2_21Q = (REAL(X2_2,QB)-REAL(X2_1,QB)) - ! X3_21Q = (REAL(X3_2,QB)-REAL(X3_1,QB)) - ! SLENQ = SQRT( X2_21Q**2._QB + X3_21Q**2._QB ) - ! - ! ! Unit vector along segment: - ! STANIQ(IAXIS:JAXIS) = 1._QB/SLENQ * (/ X2_21Q, X3_21Q /) - ! - ! ! S coordinate along segment: - ! DX3_1Q = REAL(X3_2,QB) - REAL(X3RAY,QB) - ! DX3_2Q = REAL(X3RAY,QB)- REAL(X3_1,QB) - ! XI1Q = DX3_1Q / X3_21Q - ! XI2Q = DX3_2Q / X3_21Q - ! DVQ(IAXIS:JAXIS) = (/ (XI1Q-1._QB)*REAL(X2_1,QB)+XI2Q*REAL(X2_2,QB) , DX3_2Q /) - ! SBOD = REAL(DVQ(IAXIS)*STANIQ(IAXIS)+DVQ(JAXIS)*STANIQ(JAXIS),EB) - ! ENDIF +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%BODTRI)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI) - ! If crossing is already defined, cycle: - DO IBCR=1,BODINT_PLANE%NBCROSS(ISEG) - IF ( ABS(SBOD-BODINT_PLANE%SVAR(IBCR,ISEG)) < GEOMEPS ) EXIT - ENDDO - IF (IBCR NBCROSS_SVAR) THEN - ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB - SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) - CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) - ENDIF - BODINT_PLANE%SVAR(NBCROSS,ISEG) = 1._EB/GEOMEPS - DO IBCR=1,NBCROSS - IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEG) ) EXIT - ENDDO +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XCENLOW)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENLOW) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH) - ! Here copy from the back (updated nbcross) to the ibcr location: - DO IDUM = NBCROSS,IBCR+1,-1 - BODINT_PLANE%SVAR(IDUM,ISEG) = BODINT_PLANE%SVAR(IDUM-1,ISEG) - ENDDO - BODINT_PLANE%SVAR(IBCR,ISEG) = SBOD - BODINT_PLANE%NBCROSS(ISEG) = NBCROSS +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX) -ENDDO -T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW RETURN -END SUBROUTINE GET_BODX2_INTERSECTIONS +END SUBROUTINE FACE_DEALLOC -! ----------------------- GET_BODX3_INTERSECTIONS ------------------------------- +! -------------------------- NEW_FACE_ALLOC ------------------------------------- -SUBROUTINE GET_BODX3_INTERSECTIONS(X2AXIS,X3AXIS,X2LO,X2HI) +SUBROUTINE NEW_FACE_ALLOC(NM,ICF,NVERT,NFACE,NVERTFACE,IBNDINT) -INTEGER, INTENT(IN) :: X2AXIS,X3AXIS,X2LO,X2HI +INTEGER, INTENT(IN) :: NM,ICF,NVERT,NFACE,NVERTFACE +INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT -! Local Variables: -REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN, SBOD -REAL(EB) :: STANI(IAXIS:JAXIS), DV(IAXIS:JAXIS), MINX, MAXX, XI1, XI2, DX2_1, DX2_2 -INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IBCR, IDUM, JSTR, JEND, JJ, NBCROSS_SVAR -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX -LOGICAL :: ISCONT -REAL(EB) :: TNOW +! Allocate and initialize NVERT related fields: +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZVERT(IAXIS:KAXIS,1:NVERT)); MESHES(NM)%CUT_FACE(ICF)%XYZVERT = 0._EB -! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX2_1Q,DX2_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) +! Allocate and initialize NFACE, NVERTFACE related fields: +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFELEM(1:NVERTFACE,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFELEM = CC_UNDEFINED +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%AREA = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZCEN(IAXIS:KAXIS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%XYZCEN = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SHARED(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%SHARED = .FALSE. +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG(1:NFACE));MESHES(NM)%CUT_FACE(ICF)%BLK_TAG= .FALSE. +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%LINK_LEV = CC_UNDEFINED -TNOW=CURRENT_TIME() +!Integrals to be used in cut-cell volume and centroid computations. +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%INXAREA = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%INXSQAREA = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA = 0._EB -DO ISEG=1,BODINT_PLANE%NSEGS +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI(1:2,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%BODTRI = CC_UNDEFINED - IF (BODINT_PLANE%X3ALIGNED(ISEG)) CYCLE ! This segment is not aligned with x3. +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKZ(LOW_IND:HIGH_IND,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%UNKZ = CC_UNDEFINED - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENLOW(IAXIS:KAXIS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%XCENLOW = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH(IAXIS:KAXIS,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%XCENHIGH = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(MAX_DIM+1,LOW_IND:HIGH_IND,1:NFACE)) +MESHES(NM)%CUT_FACE(ICF)%CELL_LIST = CC_UNDEFINED - ! x2_x3 of segment point 1: - X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) - ! x2_x3 of segment point 2: - X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) +IF(MESHES(NM)%CUT_FACE(ICF)%STATUS==CC_INBOUNDARY) THEN + ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST = 1._EB + ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN = NOT_BLOCKED +ELSE + IF(PRESENT(IBNDINT)) THEN + IF(IBNDINT>2) RETURN ! Gas cut-face not in block boundary. + ENDIF +ENDIF +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX = CC_UNDEFINED - ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - ! Segment length: - SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) - ! Unit vector along segment: - STANI(IAXIS:JAXIS) = (/ (X2_2-X2_1), (X3_2-X3_1) /)*SLEN**(-1._EB) - ! ELSE - ! ! Segment length: - ! X2_21Q = (REAL(X2_2,QB)-REAL(X2_1,QB)) - ! X3_21Q = (REAL(X3_2,QB)-REAL(X3_1,QB)) - ! SLENQ = SQRT( X2_21Q**2._QB + X3_21Q**2._QB ) - ! ! Unit vector along segment: - ! STANIQ(IAXIS:JAXIS) = 1._QB/SLENQ * (/ X2_21Q, X3_21Q /) - ! ENDIF +RETURN +END SUBROUTINE NEW_FACE_ALLOC - MINX = MIN(X2_1,X2_2) - MAXX = MAX(X2_1,X2_2) - IF(X2NOC==0) THEN - ! Optimized for UG: - JSTR = MAX(X2LO, CEILING(( MINX-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO))+X2LO) - JEND = MIN(X2HI, FLOOR(( MAXX+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO))+X2LO) - ELSE - IF ((MINX-GEOMEPS-X2FACE(X2LO)) < 0._EB) THEN - JSTR=X2LO - ELSEIF((MINX-GEOMEPS-X2FACE(X2HI)) >= 0._EB) THEN - JSTR=X2HI+1 - ELSE - DO JJ=X2LO,X2HI - IF((MINX-GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. (MINX-GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN - JSTR = JJ+1 - EXIT - ENDIF - ENDDO - ENDIF - IF ((MAXX+GEOMEPS-X2FACE(X2LO)) < 0._EB) THEN - JEND=X2LO-1 - ELSEIF((MAXX+GEOMEPS-X2FACE(X2HI)) >= 0._EB) THEN - JEND=X2HI - ELSE - DO JJ=X2LO,X2HI - IF((MAXX+GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. (MAXX+GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN - JEND = JJ - EXIT - ENDIF - ENDDO - ENDIF - ENDIF - DO JJ=JSTR,JEND +! -------------------------- ALLOC_FACE_STATE_VARS ------------------------------------- - ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - ! S coordinate along segment: - DX2_1 = X2_2 - X2FACE(JJ) - DX2_2 = X2FACE(JJ) - X2_1 - XI1 = DX2_1 / (X2_2-X2_1) - XI2 = DX2_2 / (X2_2-X2_1) - DV(IAXIS:JAXIS) = (/ DX2_2, (XI1-1._EB)*X3_1+XI2*X3_2 /) - SBOD = DV(IAXIS)*STANI(IAXIS)+DV(JAXIS)*STANI(JAXIS) - ! ELSE - ! ! S coordinate along segment: - ! DX2_1Q = REAL(X2_2,QB) - REAL(X2FACE(JJ),QB) - ! DX2_2Q = REAL(X2FACE(JJ),QB)- REAL(X2_1,QB) - ! XI1Q = DX2_1Q / X2_21Q - ! XI2Q = DX2_2Q / X2_21Q - ! DVQ(IAXIS:JAXIS) = (/ DX2_2Q, (XI1Q-1._QB)*REAL(X3_1,QB)+XI2Q*REAL(X3_2,QB) /) - ! SBOD = REAL(DVQ(IAXIS)*STANIQ(IAXIS)+DVQ(JAXIS)*STANIQ(JAXIS),EB) - ! ENDIF +SUBROUTINE ALLOC_FACE_STATE_VARS(NM,ICF,NFACE,IBNDINT) +INTEGER, INTENT(IN) :: NM,ICF,NFACE +INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT - ! If crossing is already defined, cycle: - NBCROSS = BODINT_PLANE%NBCROSS(ISEG) - ISCONT = .FALSE. - DO IBCR=1,NBCROSS - IF ( ABS(SBOD-BODINT_PLANE%SVAR(IBCR,ISEG)) < GEOMEPS ) THEN - ISCONT = .TRUE. - EXIT - ENDIF - ENDDO - IF (ISCONT) CYCLE - ! Add crossing to BODINT_PLANE, insertion sort: - NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + 1 - ! Test-reallocate BODINT_PLANE%SVAR - NBCROSS_SVAR = SIZE(BODINT_PLANE%SVAR,DIM=1) - IF (NBCROSS > NBCROSS_SVAR) THEN - ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB - SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) - CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) - ENDIF - BODINT_PLANE%SVAR(NBCROSS,ISEG) = 1._EB/GEOMEPS - DO IBCR=1,NBCROSS - IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEG) ) EXIT - ENDDO +! !Integrals to be used in cut-cell volume and centroid computations. +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA) - ! Here copy from the back (updated nbcross) to the ibcr location: - DO IDUM = NBCROSS,IBCR+1,-1 - BODINT_PLANE%SVAR(IDUM,ISEG) = BODINT_PLANE%SVAR(IDUM-1,ISEG) - ENDDO - BODINT_PLANE%SVAR(IBCR,ISEG) = SBOD - BODINT_PLANE%NBCROSS(ISEG) = NBCROSS +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKH(LOW_IND:HIGH_IND,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%UNKH = CC_UNDEFINED +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%RHO_D_DZDN(1:N_TOTAL_SCALARS,1:NFACE)) +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%H_RHO_D_DZDN(1:N_TOTAL_SCALARS,1:NFACE)) +MESHES(NM)%CUT_FACE(ICF)%RHO_D_DZDN = 0._EB +MESHES(NM)%CUT_FACE(ICF)%H_RHO_D_DZDN = 0._EB - ENDDO +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%ZZ_FACE(1:N_TOTAL_SCALARS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%ZZ_FACE = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%TMP_FACE(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%TMP_FACE = 0._EB -ENDDO +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%VEL(1:NFACE), MESHES(NM)%CUT_FACE(ICF)%VELS(1:NFACE), & + MESHES(NM)%CUT_FACE(ICF)%FN(1:NFACE), MESHES(NM)%CUT_FACE(ICF)%FN_B(1:NFACE), & + MESHES(NM)%CUT_FACE(ICF)%VEL_SAVE(1:NFACE)) +MESHES(NM)%CUT_FACE(ICF)%VEL = 0._EB; MESHES(NM)%CUT_FACE(ICF)%VELS = 0._EB +MESHES(NM)%CUT_FACE(ICF)%FN = 0._EB; MESHES(NM)%CUT_FACE(ICF)%VEL_SAVE = 0._EB +MESHES(NM)%CUT_FACE(ICF)%FN_B = 0._EB; -T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JDH(1:2,1:2,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%JDH = CC_UNDEFINED +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKF(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%UNKF = CC_UNDEFINED + +IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) THEN + IF(PRESENT(IBNDINT)) THEN + IF(IBNDINT>2) RETURN ! Gas cut-face not in block boundary. + ENDIF +ENDIF +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_INDEX(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFACE_INDEX = CC_UNDEFINED RETURN -END SUBROUTINE GET_BODX3_INTERSECTIONS +END SUBROUTINE ALLOC_FACE_STATE_VARS -! ----------------------- GET_CARTFACE_CUTEDGES --------------------------------- +! -------------------------- TEST_PT_INPOLY ------------------------------------- -SUBROUTINE GET_CARTFACE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS, & - XIAXIS,XJAXIS,XKAXIS,NM , & - X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL, & - X3LO_CELL,X3HI_CELL,INDX1,X1PLN) +SUBROUTINE TEST_PT_INPOLY(NP,XY,XY1,PTSFLAG) -INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS,NM, & - X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL, & - X3LO_CELL,X3HI_CELL,INDX1(MAX_DIM) -REAL(EB), INTENT(IN) :: X1PLN +INTEGER, INTENT(IN) :: NP +REAL(EB), INTENT(INOUT) :: XY(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) +REAL(EB), INTENT(IN) :: XY1(IAXIS:JAXIS) +LOGICAL, INTENT(OUT) :: PTSFLAG ! Local Variables: -REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN -REAL(EB) :: STANI(IAXIS:JAXIS), SNORI(IAXIS:JAXIS), X2RAY, X3RAY -INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IEDGE, JJ, KK, JJ2, KK2, IPFACE, NPFACE, INOD1, INOD2 -LOGICAL :: ADD2FACES, INRAY, CONDAX -INTEGER :: INDSEG(1:CC_MAX_WSTRIANG_SEG+2), NTRISEG, CETYPE, JJ2VEC(LOW_IND:HIGH_IND), KK2VEC(LOW_IND:HIGH_IND) -REAL(EB) :: SVAR1, SVAR2, SVAR12, XPOS, XY(IAXIS:JAXIS) -INTEGER :: INDXI(IAXIS:KAXIS), INDIF, INDJF, INDKF, CEI, NVERT, NEDGE, DIRAXIS, IDG -REAL(EB) :: XYZV1(IAXIS:KAXIS), XYZV1LC(IAXIS:KAXIS) -REAL(EB) :: XYZV2(IAXIS:KAXIS), XYZV2LC(IAXIS:KAXIS) -REAL(EB) :: TNOW -INTEGER :: INIT_CUT_EDGES,IVERT,IADD,JADD,KADD -LOGICAL :: FOUND_SEG, IS_SOLID +INTEGER :: RCROSS, LCROSS, IP +REAL(EB):: XPT +LOGICAL :: RS, LS -TNOW=CURRENT_TIME() +PTSFLAG = .FALSE. +RCROSS = 0 +LCROSS = 0 -INIT_CUT_EDGES = MESHES(NM)%N_CUTEDGE_MESH+1 +! ADD first point location at the end of XY (assumes CC_MAXVERTS_FACE > NP): +XY(IAXIS:JAXIS,NP+1) = XY(IAXIS:JAXIS,1) -! Segment by segment define the INBOUNDARY MESHES(NM)%CUT_EDGEs between crossings -! and individualize the Cartesian face they belong to. -! NCUTEDGEOLD = MESHES(NM)%N_CUTEDGE_MESH + 1 -SEGS_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS +! Shift origin to XY1: +DO IP=1,NP+1 + XY(IAXIS:JAXIS,IP) = XY(IAXIS:JAXIS,IP) - XY1(IAXIS:JAXIS) +enddo - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) +! For each edge test against rays x=0, y=0: +DO IP=1,NP + ! Check if edges first point is vertex: + IF ( (ABS(XY(IAXIS,IP)) < GEOMEPS) .AND. & + (ABS(XY(JAXIS,IP)) < GEOMEPS) ) THEN + PTSFLAG = .TRUE. + RETURN + ENDIF + ! Check if edge crosses x axis: + RS = (XY(JAXIS,IP) > 0._EB) .NEQV. (XY(JAXIS,IP+1) > 0._EB) + LS = (XY(JAXIS,IP) < 0._EB) .NEQV. (XY(JAXIS,IP+1) < 0._EB) - IF (MAX(XYZ1(X2AXIS),XYZ2(X2AXIS)) < X2FACE(X2LO)-GEOMEPS) CYCLE - IF (MIN(XYZ1(X2AXIS),XYZ2(X2AXIS)) > X2FACE(X2HI)+GEOMEPS) CYCLE - IF (MAX(XYZ1(X3AXIS),XYZ2(X3AXIS)) < X3FACE(X3LO)-GEOMEPS) CYCLE - IF (MIN(XYZ1(X3AXIS),XYZ2(X3AXIS)) > X3FACE(X3HI)+GEOMEPS) CYCLE + IF ( RS .OR. LS ) THEN + ! Intersection: + XPT = (XY(IAXIS,IP )*XY(JAXIS,IP+1) - XY(JAXIS,IP )*XY(IAXIS,IP+1)) / (XY(JAXIS,IP+1)-XY(JAXIS,IP)) - NBCROSS = BODINT_PLANE%NBCROSS(ISEG) ! Cross points include Node1, Node2 + IF (RS .AND. (XPT > 0._EB)) RCROSS = RCROSS + 1 + IF (LS .AND. (XPT < 0._EB)) LCROSS = LCROSS + 1 + ENDIF +ENDDO - ! x2_x3 of segment point 1: - X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) - ! x2_x3 of segment point 2: - X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) +IF ( MOD(RCROSS,2) /= MOD(LCROSS,2) ) THEN ! Point on edge + PTSFLAG = .TRUE. + RETURN +ENDIF - ! Normal out: - SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) - STANI(IAXIS:JAXIS) = (/ (X2_2-X2_1), (X3_2-X3_1) /)*SLEN**(-1._EB) - SNORI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) +IF ( MOD(RCROSS,2) == 1) THEN ! Point inside + PTSFLAG = .TRUE. + RETURN +ENDIF - INDSEG(1:CC_MAX_WSTRIANG_SEG+2) = BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2, ISEG) - NTRISEG = INDSEG(1) +RETURN +END SUBROUTINE TEST_PT_INPOLY - ADD2FACES = .FALSE. - ! Type to be assigned to cut edges: - CETYPE = 2*(BODINT_PLANE%SEGTYPE(LOW_IND,ISEG)+1) - BODINT_PLANE%SEGTYPE(HIGH_IND,ISEG) - IF ( CETYPE == CC_GG ) ADD2FACES = .TRUE. - INRAY = .FALSE. +! ---------------------- GET_CARTCELL_CUTEDGES ---------------------------------- - ! Different cases: - ! First check if segment geomepsilon aligned with x2: - IF (BODINT_PLANE%X2ALIGNED(ISEG)) THEN +SUBROUTINE GET_CARTCELL_CUTEDGES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) - ! Test if node1 of segment is in geomepsilon vicinity of an x2 ray - DO KK=X3LO,X3HI - ! x3 location of ray along x2, on the x2-x3 plane: - X3RAY = X3FACE(KK) - IF ( ABS(X3RAY-X3_1) < GEOMEPS ) THEN - INRAY = .TRUE. - EXIT - ENDIF - ENDDO +USE TRAN, ONLY : TRANS - IF (INRAY) THEN ! Segment in x2 ray defined by x3 face index kk. +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND - ! 1. INB cut-edges on top of an x2 gridline, assign to cut-face - ! defined by normal out. - KK2VEC(LOW_IND:HIGH_IND) = 0 - IF (ADD2FACES) THEN - NPFACE = 2 - KK2VEC(LOW_IND) = KK + 1 - KK2VEC(HIGH_IND)= KK - ELSE - NPFACE = 1 - if ( SNORI(JAXIS) > 0._EB ) THEN ! add 1 to index kk (i.e. lower face index) - KK2VEC(LOW_IND) = KK + 1 - ELSE - KK2VEC(LOW_IND)= KK - ENDIF - ENDIF +! Local Variables: +INTEGER :: II2, JJ2, KK2, IG, IWSEDG, SEG(NOD1:NOD2),X1AXIS, X1LO, X1HI, IPLN, LSTR, LEND +REAL(EB):: XYZ1(IAXIS:KAXIS), XYZ2(IAXIS:KAXIS), PLNORMAL(IAXIS:KAXIS), X1PLN, MINX, MAXX +LOGICAL :: DROPSEG, OUTPLANE, SAMEINT +REAL(EB):: DOT1, DOT2, DENOM, PLANEEQ, SVARI, XYZV1(IAXIS:KAXIS), XYZV2(IAXIS:KAXIS), SLEN, STANI(IAXIS:KAXIS) +INTEGER :: NWCROSS, IBCR, IDUM, INOD1, INOD2, NVERT, NEDGE, IEDGE, CEI, NWCROSS_SVAR, X1NOC +REAL(EB):: SVAR1, SVAR2, SVAR12, XPOS, DV(IAXIS:KAXIS) +REAL(EB), ALLOCATABLE, DIMENSION(:) :: SVAR_AUX +INTEGER :: X2AXIS, EDGE_START, COUNT, CEI2, I, J, K, I_NP, IFCELL, ITRI, IG1 +REAL(EB):: XP(IAXIS:KAXIS), NP(IAXIS:KAXIS), ADD_XSEG(IAXIS:KAXIS), X1X2(IAXIS:KAXIS), X1O1(IAXIS:KAXIS), X1O2(IAXIS:KAXIS), & + X1T1_OPNOD, X1T2_OPNOD +LOGICAL :: TWOBOD_EDG, INPL_TEST, ANG_FLG1, ANG_FLG2, ANG_FLG3 +INTEGER, PARAMETER :: AXIS(1:6)=(/ IAXIS, IAXIS, JAXIS, JAXIS, KAXIS, KAXIS /) +INTEGER, PARAMETER :: IADD(1:6)=(/ -1, 0, 0, 0, 0, 0 /) +INTEGER, PARAMETER :: JADD(1:6)=(/ 0, 0, -1, 0, 0, 0 /) +INTEGER, PARAMETER :: KADD(1:6)=(/ 0, 0, 0, 0, -1, 0 /) +LOGICAL, ALLOCATABLE, DIMENSION(:) :: SOLID_EDGE +INTEGER, PARAMETER :: ON(1:3) =(/ 3, 1, 2 /) +INTEGER :: T1, E1, ON1, T2, E2, ON2 +REAL(EB) :: TNOW, EDGECUBE(LOW_IND:HIGH_IND,IAXIS:KAXIS) +TYPE(BODINT_CELL_EDGE_TYPE) :: BODINT_CELL_EDGE +LOGICAL :: FOUND_SEG - DO IPFACE=1,NPFACE +! REAL(QB) :: DVQ(IAXIS:KAXIS), SLENQ, STANIQ(IAXIS:KAXIS), DENOMQ, PLANEEQQ - KK2 = KK2VEC(IPFACE) +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +INTEGER :: NCUTEDG - ! Figure out which cut faces the inboundary cut-edges of - ! this segment belong to: - ! We have nbcross-1 INBOUNDARY CUT_EDGEs to generate. - DO IEDGE=1,NBCROSS-1 +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTEDGES for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTEDGES for mesh :',NM,' ..' +ENDIF - ! Location along Segment: - SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) - SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) - ! Location of midpoint of cut-edge: - SVAR12 = 0.5_EB * (SVAR1+SVAR2) - ! Define Cartesian segment this cut-edge belongs: - XPOS = X2_1 + SVAR12*STANI(IAXIS) - IF (X2NOC==0) THEN - JJ2 = FLOOR((XPOS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - ! Discard cut-edges on faces laying on x2hi. - IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO JJ2=X2LO_CELL,X2HI_CELL - ! Check if XPOS is within this segment JJ2: - IF((XPOS-X2FACE(JJ2-1)) >= 0._EB .AND. (X2FACE(JJ2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF +TNOW=CURRENT_TIME() + +EDGE_START= MESHES(NM)%N_CUTEDGE_MESH + 1 + +! BODINT_CELL: +GEOM_LOOP : DO IG=1,N_GEOMETRY - IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE + ! The IG wet surface edges will be used to obtain intersections with grid planes on + ! increasing svar order. + ALLOCATE(BODINT_CELL_EDGE%SVAR(CC_DELTA_NBCROSS)) - ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. - ! If segment is inside the solid region mark cells surrounding face - ! to be treated in special manner (only if they happen to be type CUTCFE), - ! then drop segment. - XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) - CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) - IF (IS_SOLID) CYCLE + IWSEDG_LOOP : DO IWSEDG=1,GEOMETRY(IG)%N_EDGES - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS) - INDJF=INDXI(XJAXIS) - INDKF=INDXI(XKAXIS) + ! Seg Nodes location: + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEDG) - ! Now the face is, FCVAR (x1axis): - IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already - ! an entry in CUT_EDGE. - CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) - ELSE ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF - ENDIF + XYZ1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - ! Add vertices, non repeated vertex entries at this point. - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - ! Define vertices for this segment: - ! xv1 yv1 zv1 - XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) - XYZV1(IAXIS) = XYZV1LC(XIAXIS) - XYZV1(JAXIS) = XYZV1LC(XJAXIS) - XYZV1(KAXIS) = XYZV1LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) - ! xv2 yv2 zv2 - XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) - XYZV2(IAXIS) = XYZV2LC(XIAXIS) - XYZV2(JAXIS) = XYZV2LC(XJAXIS) - XYZV2(KAXIS) = XYZV2LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) + DO X1AXIS=IAXIS,KAXIS + EDGECUBE( LOW_IND,X1AXIS) = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) + EDGECUBE(HIGH_IND,X1AXIS) = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) + ENDDO - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) - IF ( NPFACE == 1 ) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ELSE - DIRAXIS = X2AXIS - CONDAX = (XYZV2(DIRAXIS)-XYZV1(DIRAXIS)) > 0 - IF ( KK2 == KK ) THEN - IF (CONDAX) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ELSE - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) - ENDIF - ELSE - IF (CONDAX) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) - ELSE - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ENDIF - ENDIF - ENDIF - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & - BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = 0 !Edges in face boundary counted once. - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE + ! Discard if segment is outside of volume of interest: + IF (EDGECUBE( LOW_IND,IAXIS) > X(IBAR)+REAL(NGUARD,EB)*DX(IBAR)) CYCLE + IF (EDGECUBE(HIGH_IND,IAXIS) < X( 0)-REAL(NGUARD,EB)*DX( 1)) CYCLE + IF (EDGECUBE( LOW_IND,JAXIS) > Y(JBAR)+REAL(NGUARD,EB)*DY(JBAR)) CYCLE + IF (EDGECUBE(HIGH_IND,JAXIS) < Y( 0)-REAL(NGUARD,EB)*DY( 1)) CYCLE + IF (EDGECUBE( LOW_IND,KAXIS) > Z(KBAR)+REAL(NGUARD,EB)*DZ(KBAR)) CYCLE + IF (EDGECUBE(HIGH_IND,KAXIS) < Z( 0)-REAL(NGUARD,EB)*DZ( 1)) CYCLE - ! Test for Repeated edge -> If so note FACERT: - DO IDG=1,NEDGE - IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & - ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN - FACERT(JJ2,KK2) =.TRUE. - EXIT - ENDIF - ENDDO + ! Test if Segment lays on plane, If so drop, unless SOLID-SOLID with triangles off plane, it was taken care of + ! previously: This is expensive think of switching to pointer X1FACEP. + DROPSEG = .FALSE. + ADD_XSEG= 0._EB + X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS + SELECT CASE(X1AXIS) + CASE(IAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) + ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE + ALLOCATE(DX1FACE(ISTR:IEND)); DX1FACE = DXFACE + X1LO = ILO_FACE-CCGUARD; X1HI = IHI_FACE+CCGUARD + CASE(JAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 1._EB, 0._EB /) + ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE + ALLOCATE(DX1FACE(JSTR:JEND)); DX1FACE = DYFACE + X1LO = JLO_FACE-CCGUARD; X1HI = JHI_FACE+CCGUARD + CASE(KAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 0._EB, 1._EB /) + ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE + ALLOCATE(DX1FACE(KSTR:KEND)); DX1FACE = DZFACE + X1LO = KLO_FACE-CCGUARD; X1HI = KHI_FACE+CCGUARD + END SELECT - ENDDO - ENDDO - CYCLE ! Skips rest of iseg loop, for this ISEG. - ENDIF + ! Optimized for UG: + X1NOC=TRANS(NM)%NOC(X1AXIS) + MINX = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) + MAXX = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) - ! Second check if segment geomepsilon aligned with x3: - ELSEIF (BODINT_PLANE%X3ALIGNED(ISEG)) THEN + IF (MAXX-MINX < GEOMEPS) THEN ! SEGMENT ALIGNED WITH PLANE. + LSTR = X1LO; LEND = X1HI + IF(X1NOC==0) THEN ! Optimized for Uniform Grid. + LSTR = MAX(X1LO, FLOOR((MINX-GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) + LEND = MIN(X1HI,CEILING((MAXX+GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) + ENDIF + X1X2(IAXIS:KAXIS) = XYZ2(IAXIS:KAXIS)-XYZ1(IAXIS:KAXIS); X1X2=X1X2/NORM2(X1X2) + T1 = GEOMETRY(IG)%EDGE_FACES(2,IWSEDG) + E1 = GEOMETRY(IG)%EDGE_FACES(3,IWSEDG) + ON1= GEOMETRY(IG)%FACES(3*(T1-1)+ON(E1)) + X1T1_OPNOD = GEOMETRY(IG)%VERTS(MAX_DIM*(ON1-1)+X1AXIS) + T2 = GEOMETRY(IG)%EDGE_FACES(4,IWSEDG) + E2 = GEOMETRY(IG)%EDGE_FACES(5,IWSEDG) + ON2= GEOMETRY(IG)%FACES(3*(T2-1)+ON(E2)) + X1T2_OPNOD = GEOMETRY(IG)%VERTS(MAX_DIM*(ON2-1)+X1AXIS) - ! Test if node1 of segment is in geomepsilon vicinity of an x3 ray - DO JJ=X2LO,X2HI - ! x2 location of ray along x3, on the x2-x3 plane: - X2RAY = X2FACE(JJ) - IF ( ABS(X2RAY-X2_1) < GEOMEPS ) THEN - INRAY = .TRUE. - EXIT + X1O1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(ON1-1)+IAXIS:MAX_DIM*(ON1-1)+KAXIS)-XYZ1(IAXIS:KAXIS) + X1O2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(ON2-1)+IAXIS:MAX_DIM*(ON2-1)+KAXIS)-XYZ1(IAXIS:KAXIS) + X1O1 = X1O1/NORM2(X1O1); X1O2 = X1O2/NORM2(X1O2) + DO IPLN=LSTR,LEND + X1PLN = X1FACE(IPLN) + INPL_TEST = ABS(X1PLN-MAXX) < GEOMEPS + SPECIAL_SEG_IF : IF (INPL_TEST) THEN + ! Test that nodes on seg triangles not part of SEG are on + ! on side of X1PLN, and both normals have component in -X1AXIS dir. + IF ( (X1T1_OPNOD-X1PLN)<-GEOMEPS .AND. (X1T2_OPNOD-X1PLN)<-GEOMEPS ) THEN !-X1AXIS + ANG_FLG1 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T1)GEOMEPS .AND. X1O2(X1AXIS)GEOMEPS .AND. X1O1(X1AXIS)GEOMEPS .AND. (X1T2_OPNOD-X1PLN)>GEOMEPS ) THEN !+X1AXIS + ANG_FLG1 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T1)>-GEOMEPS .AND. GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T2)>-GEOMEPS + ANG_FLG2 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T2)<-GEOMEPS .AND. X1O2(X1AXIS)>X1O1(X1AXIS) + ANG_FLG3 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T1)<-GEOMEPS .AND. X1O1(X1AXIS)>X1O2(X1AXIS) + IF (ANG_FLG1 .OR. ANG_FLG2 .OR. ANG_FLG3) THEN + ADD_XSEG(X1AXIS)= 10._EB*GEOMEPS + INPL_TEST =.FALSE. + ENDIF + ENDIF + ENDIF SPECIAL_SEG_IF + DROPSEG=( INPL_TEST .OR. ((X1FACE(X1LO)-MAXX)>GEOMEPS) .OR. ((MAXX-X1FACE(X1HI))>GEOMEPS)) + IF (DROPSEG) EXIT + ENDDO ENDIF - ENDDO + IF (DROPSEG) THEN + DEALLOCATE(X1FACE,DX1FACE) + EXIT ! EXIT X1AXIS=IAXIS:KAXIS LOOP + ENDIF + DEALLOCATE(X1FACE,DX1FACE) + ENDDO X1AXIS_LOOP + IF (DROPSEG) CYCLE - IF (INRAY) THEN ! Segment in x3 ray defined by x2 face index JJ + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + ! Edge length and tangent unit vector: + DV(IAXIS:KAXIS) = XYZ2(IAXIS:KAXIS) - XYZ1(IAXIS:KAXIS) + SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) ! Segment length. + STANI(IAXIS:KAXIS) = DV(IAXIS:KAXIS) * SLEN**(-1._EB) ! Segment tangent versor. + ! ELSE + ! ! Edge length and tangent unit vector: + ! DVQ(IAXIS:KAXIS) = REAL(XYZ2(IAXIS:KAXIS),QB) - REAL(XYZ1(IAXIS:KAXIS),QB) + ! SLENQ = SQRT( DVQ(IAXIS)**2._QB + DVQ(JAXIS)**2._QB + DVQ(KAXIS)**2._QB ) ! Segment length. + ! STANIQ(IAXIS:KAXIS) = DVQ(IAXIS:KAXIS) * SLENQ**(-1._QB) ! Segment tangent versor. + ! SLEN = REAL(SLENQ,EB) + ! STANI(IAXIS:KAXIS) = REAL(STANIQ(IAXIS:KAXIS),EB) + ! ENDIF - ! 1. INB cut-edges on top of an x3 gridline, assign to cut-face - ! defined by normal out. - JJ2VEC(LOW_IND:HIGH_IND) = 0 - IF (ADD2FACES) THEN - NPFACE = 2 - JJ2VEC(LOW_IND) = JJ + 1 - JJ2VEC(HIGH_IND) = JJ - ELSE - NPFACE = 1 - IF ( SNORI(IAXIS) > 0._EB ) THEN ! add 1 to index jj (i.e. lower face index) - JJ2VEC(LOW_IND) = JJ + 1 - ELSE - JJ2VEC(LOW_IND) = JJ - ENDIF + ! Add segment ends as intersections: + BODINT_CELL_EDGE%NWCROSS = 2 ! Nodes 1,2 of segment are considered intersection. + BODINT_CELL_EDGE%SVAR(1) = 0 ! Coordinate along stani of Node 1. + BODINT_CELL_EDGE%SVAR(2) = SLEN ! Coordinate along stani of Node 2. + + + ! Now find intersections: + X1AXIS_LOOP2 : DO X1AXIS=IAXIS,KAXIS + SELECT CASE(X1AXIS) + CASE(IAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) + ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE + ALLOCATE(DX1FACE(ISTR:IEND)); DX1FACE = DXFACE + X1LO = ILO_FACE-CCGUARD; X1HI = IHI_FACE+CCGUARD + CASE(JAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 1._EB, 0._EB /) + ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE + ALLOCATE(DX1FACE(JSTR:JEND)); DX1FACE = DYFACE + X1LO = JLO_FACE-CCGUARD; X1HI = JHI_FACE+CCGUARD + CASE(KAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 0._EB, 1._EB /) + ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE + ALLOCATE(DX1FACE(KSTR:KEND)); DX1FACE = DZFACE + X1LO = KLO_FACE-CCGUARD; X1HI = KHI_FACE+CCGUARD + END SELECT + + ! Optimized for UG: + X1NOC=TRANS(NM)%NOC(X1AXIS) + MINX = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) + MAXX = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) + LSTR = X1LO; LEND = X1HI + IF(X1NOC==0) THEN ! Optimized for Uniform Grid. + LSTR = MAX(X1LO, FLOOR((MINX-GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) + LEND = MIN(X1HI,CEILING((MAXX+GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) ENDIF - DO IPFACE=1,NPFACE + DO IPLN=LSTR,LEND + X1PLN = X1FACE(IPLN); + OUTPLANE = ((X1PLN-MAXX) > GEOMEPS) .OR. ((MINX-X1PLN) > GEOMEPS) + IF (OUTPLANE) CYCLE ! Make sure to drop jstr, jend if out of segment length. - JJ2 = JJ2VEC(IPFACE) + ! Drop intersections in segment nodes: + ! Compute: dot(plnormal, xyzv - xypl): + DOT1 = XYZ1(X1AXIS) - X1PLN + DOT2 = XYZ2(X1AXIS) - X1PLN + IF (ABS(DOT1) <= GEOMEPS) CYCLE + IF (ABS(DOT2) <= GEOMEPS) CYCLE - ! Figure out which cut faces the inboundary cut-edges of - ! this segment belong to: - ! We have NBCROSS-1 INBOUNDARY CUT_EDGEs to generate. - DO IEDGE=1,NBCROSS-1 - ! Location along Segment: - SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) - SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) - ! Location of midpoint of cut-edge: - SVAR12 = 0.5_EB * (SVAR1+SVAR2) + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + ! Now regular case: Find svar and insert in BODINT_CELL%SVAR(:,IWSEDG): + DENOM = STANI(X1AXIS) ! dot(stani,plnormal) + PLANEEQ= DOT1 ! dot(xyz1(IAXIS:KAXIS),plnormal) - x1pln + SVARI = - PLANEEQ / DENOM + ! ELSE + ! DENOMQ = STANIQ(X1AXIS) ! dot(stani,plnormal) + ! PLANEEQQ = REAL(DOT1,QB) ! dot(xyz1(IAXIS:KAXIS),plnormal) - x1pln + ! SVARI = REAL(-PLANEEQQ/DENOMQ,EB) + ! ENDIF - ! Define Cartesian segment this cut-edge belongs: - XPOS = X3_1 + SVAR12*STANI(JAXIS) - IF (X3NOC==0) THEN - KK2 = FLOOR((XPOS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - ! Discard cut-edges on faces laying on x3hi. - IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO KK2=X3LO_CELL,X3HI_CELL - ! Check if XPOS is within this segment KK2: - IF((XPOS-X3FACE(KK2-1)) >= 0._EB .AND. (X3FACE(KK2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE + + ! Insertion sort, discard repeated intersections: + NWCROSS = BODINT_CELL_EDGE%NWCROSS + 1 + NWCROSS_SVAR = SIZE(BODINT_CELL_EDGE%SVAR,DIM=1) + IF (NWCROSS > NWCROSS_SVAR) THEN + ALLOCATE(SVAR_AUX(NWCROSS_SVAR+CC_DELTA_NBCROSS)); SVAR_AUX = -1._EB + SVAR_AUX(1:NWCROSS-1) = BODINT_CELL_EDGE%SVAR(1:NWCROSS-1) + CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_CELL_EDGE%SVAR) + ENDIF + BODINT_CELL_EDGE%SVAR(NWCROSS) = 1._EB / GEOMEPS + SAMEINT = .FALSE. + DO IBCR=1,NWCROSS + IF (ABS(SVARI - BODINT_CELL_EDGE%SVAR(IBCR)) < GEOMEPS) THEN + SAMEINT = .TRUE. + EXIT ENDIF + IF ( SVARI < BODINT_CELL_EDGE%SVAR(IBCR) ) EXIT + ENDDO + IF (SAMEINT) CYCLE - IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE + ! Here copy from the back (updated nbcross) to the ibcr location: + DO IDUM = NWCROSS,IBCR+1,-1 + BODINT_CELL_EDGE%SVAR(IDUM) = BODINT_CELL_EDGE%SVAR(IDUM-1) + ENDDO + BODINT_CELL_EDGE%SVAR(IBCR) = SVARI + BODINT_CELL_EDGE%NWCROSS = NWCROSS - ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. - ! If segment is inside the solid region mark cells surrounding face - ! to be treated in special manner (only if they happen to be type CUTCFE), - ! then drop segment. - XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) - CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) - IF (IS_SOLID) CYCLE + ENDDO + DEALLOCATE(X1FACE,DX1FACE) + ENDDO X1AXIS_LOOP2 - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS) - INDJF=INDXI(XJAXIS) - INDKF=INDXI(XKAXIS) + ! 3. The increasing svar intersections are used to define the INBOUNDCC type + ! cut-edges and Cartesian Cells containing them. Add to CUT_EDGE, define the + ! CUT_EDGE entry in CCVAR(i,j,k,CC_IDCE): + DO IEDGE=1,BODINT_CELL_EDGE%NWCROSS-1 - ! Now the face is, FCVAR (x1axis): - IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already - ! an entry in CUT_EDGE. - CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) - ELSE ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF - ENDIF + ! Location along Segment: + SVAR1 = BODINT_CELL_EDGE%SVAR(IEDGE ) + SVAR2 = BODINT_CELL_EDGE%SVAR(IEDGE+1) - ! Add vertices, non repeated vertex entries at this point. - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - ! Define vertices for this segment: - ! xv1 yv1 zv1 - XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) - XYZV1(IAXIS) = XYZV1LC(XIAXIS) - XYZV1(JAXIS) = XYZV1LC(XJAXIS) - XYZV1(KAXIS) = XYZV1LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) - ! xv2 yv2 zv2 - XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) - XYZV2(IAXIS) = XYZV2LC(XIAXIS) - XYZV2(JAXIS) = XYZV2LC(XJAXIS) - XYZV2(KAXIS) = XYZV2LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) + ! Location of midpoint of cut-edge: + SVAR12 = 0.5_EB * (SVAR1+SVAR2) - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) - IF ( NPFACE == 1 ) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ELSE - DIRAXIS = X3AXIS - CONDAX = (XYZV2(DIRAXIS)-XYZV1(DIRAXIS)) > 0 - IF ( JJ2 == JJ ) THEN - IF (CONDAX) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) - ELSE - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ENDIF - ELSE - IF (CONDAX) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ELSE - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) - ENDIF - ENDIF + ! Define Cartesian cell this cut-edge belongs: + ! Optimized for UG version: + XPOS = XYZ1(IAXIS) + SVAR12*STANI(IAXIS) + ADD_XSEG(IAXIS) + IF(TRANS(NM)%NOC(IAXIS)==0)THEN + II2 = FLOOR( (XPOS-XFACE(ILO_FACE))/DXFACE(ILO_FACE) ) + ILO_CELL + ! Discard cut-edges on faces laying on x2hi and x3hi. + IF ( (II2 < ILO_CELL-CCGUARD) .OR. (II2 > IHI_CELL+CCGUARD) ) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO II2=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD + IF((XPOS-XFACE(II2-1)) >= 0._EB .AND. (XFACE(II2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT ENDIF - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & - BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = 0 !Edges in face boundary counted once. - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE - - ! Test for Repeated edge -> If so note FACERT - DO IDG=1,NEDGE - IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & - ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN - FACERT(JJ2,KK2) =.TRUE. - EXIT - ENDIF - ENDDO + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF + XPOS = XYZ1(JAXIS) + SVAR12*STANI(JAXIS) + ADD_XSEG(JAXIS) + IF(TRANS(NM)%NOC(JAXIS)==0)THEN + JJ2 = FLOOR( (XPOS-YFACE(JLO_FACE))/DYFACE(JLO_FACE) ) + JLO_CELL + IF ( (JJ2 < JLO_CELL-CCGUARD) .OR. (JJ2 > JHI_CELL+CCGUARD) ) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO JJ2=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD + IF((XPOS-YFACE(JJ2-1)) >= 0._EB .AND. (YFACE(JJ2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF ENDDO - ENDDO - CYCLE ! Skips rest of iseg loop, for this ISEG. - ENDIF + IF(.NOT.FOUND_SEG) CYCLE + ENDIF - ENDIF + XPOS = XYZ1(KAXIS) + SVAR12*STANI(KAXIS) + ADD_XSEG(KAXIS) + IF(TRANS(NM)%NOC(KAXIS)==0)THEN + KK2 = FLOOR( (XPOS-ZFACE(KLO_FACE))/DZFACE(KLO_FACE) ) + KLO_CELL + IF ( (KK2 < KLO_CELL-CCGUARD) .OR. (KK2 > KHI_CELL+CCGUARD) ) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO KK2=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD + IF((XPOS-ZFACE(KK2-1)) >= 0._EB .AND. (ZFACE(KK2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF - ! 3. Regular case: INB cut-edge with centroid inside a - ! Cartesian face, assign to corresponding FCVAR CC_IDCE variable. - ! This is the most common case, INBOUNDARY edges defined inside x1 faces. - ! We have NBCROSS-1 INBOUNDARY CUT_EDGEs to generate. - DO IEDGE=1,NBCROSS-1 + ! CCVAR edge number: + IF ( MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) > 0 ) THEN ! There is already + ! an entry in CUT_EDGE. + CEI = MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) + ELSE ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ II2, JJ2, KK2, 0, CC_GS /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCC + ENDIF - ! Location along Segment: - SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) - SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) - ! Location of midpoint of cut-edge: - SVAR12 = 0.5_EB * (SVAR1+SVAR2) + ! Add vertices, non repeated vertex entries at this point. + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT + ! Define vertices for this segment: + ! xv1 yv1 zv1 + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + XYZV1(IAXIS:KAXIS) = (/ XYZ1(IAXIS)+SVAR1*STANI(IAXIS), & + XYZ1(JAXIS)+SVAR1*STANI(JAXIS), & + XYZ1(KAXIS)+SVAR1*STANI(KAXIS) /) + CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) + ! xv2 yv2 zv2 + XYZV2(IAXIS:KAXIS) = (/ XYZ1(IAXIS)+SVAR2*STANI(IAXIS), & + XYZ1(JAXIS)+SVAR2*STANI(JAXIS), & + XYZ1(KAXIS)+SVAR2*STANI(KAXIS) /) + CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) + ! ELSE + ! XYZV1(IAXIS:KAXIS) = REAL((/ REAL(XYZ1(IAXIS),QB)+REAL(SVAR1,QB)*STANIQ(IAXIS), & + ! REAL(XYZ1(JAXIS),QB)+REAL(SVAR1,QB)*STANIQ(JAXIS), & + ! REAL(XYZ1(KAXIS),QB)+REAL(SVAR1,QB)*STANIQ(KAXIS) /),EB) + ! CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) + ! ! xv2 yv2 zv2 + ! XYZV2(IAXIS:KAXIS) = REAL((/ REAL(XYZ1(IAXIS),QB)+REAL(SVAR2,QB)*STANIQ(IAXIS), & + ! REAL(XYZ1(JAXIS),QB)+REAL(SVAR2,QB)*STANIQ(JAXIS), & + ! REAL(XYZ1(KAXIS),QB)+REAL(SVAR2,QB)*STANIQ(KAXIS) /),EB) + ! CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) + ! ENDIF - ! Define Cartesian face this cut-edge belongs: - XPOS = X2_1 + SVAR12*STANI(IAXIS) - IF (X2NOC==0) THEN - JJ2 = FLOOR((XPOS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO JJ2=X2LO_CELL,X2HI_CELL - ! Check if XPOS is within this segment JJ2: - IF((XPOS-X2FACE(JJ2-1)) >= 0._EB .AND. (X2FACE(JJ2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF - XPOS = X3_1 + SVAR12*STANI(JAXIS) - IF(X3NOC==0) THEN - KK2 = FLOOR((XPOS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO KK2=X3LO_CELL,X3HI_CELL - ! Check if XPOS is within this segment KK2: - IF((XPOS-X3FACE(KK2-1)) >= 0._EB .AND. (X3FACE(KK2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + 1 + CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE) = (/ INOD1, INOD2 /) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE) = & + (/ GEOMETRY(IG)%EDGE_FACES(1,IWSEDG), & + GEOMETRY(IG)%EDGE_FACES(2,IWSEDG), & + GEOMETRY(IG)%EDGE_FACES(4,IWSEDG), IG /) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE + ENDDO - ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. - ! If segment is inside the solid region mark cells surrounding face - ! to be treated in special manner (only if they happen to be type CUTCFE), - ! then drop segment. - XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) - CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) - IF (IS_SOLID) CYCLE + ENDDO IWSEDG_LOOP - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS) - INDJF=INDXI(XJAXIS) - INDKF=INDXI(XKAXIS) + ! Deallocate BODINT_CELL_EDGE: + DEALLOCATE(BODINT_CELL_EDGE%SVAR) - ! Now the face is, FCVAR (x1axis): - IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already - ! an entry in CUT_EDGE. - CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) - ELSE ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF - ENDIF +ENDDO GEOM_LOOP - ! Add vertices, non repeated vertex entries at this point. - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT +! Now filter out CC_INBOUNDCC cut-edges that lay within the SOLID: +DO CEI=EDGE_START,MESHES(NM)%N_CUTEDGE_MESH + ! Here we have cut-edges on the cell belonging to two or more bodies: + I = MESHES(NM)%CUT_EDGE(CEI)%IJK(IAXIS) + J = MESHES(NM)%CUT_EDGE(CEI)%IJK(JAXIS) + K = MESHES(NM)%CUT_EDGE(CEI)%IJK(KAXIS) - ! Define vertices for this segment: - ! xv1 yv1 zv1 - XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) - XYZV1(IAXIS) = XYZV1LC(XIAXIS) - XYZV1(JAXIS) = XYZV1LC(XJAXIS) - XYZV1(KAXIS) = XYZV1LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) - ! xv2 yv2 zv2 - XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) - XYZV2(IAXIS) = XYZV2LC(XIAXIS) - XYZV2(JAXIS) = XYZV2LC(XJAXIS) - XYZV2(KAXIS) = XYZV2LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) + ! First cut-edges in the cell: + NEDGE =MESHES(NM)%CUT_EDGE(CEI)%NEDGE + TWOBOD_EDG=.FALSE. + IF (NEDGE > 0) IG1 = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,1) + DO IEDGE=2,NEDGE + IF (MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) /= IG1) THEN + TWOBOD_EDG =.TRUE. + EXIT + ENDIF + ENDDO + ! Low-High x,y,z face Edges: + IF(.NOT.TWOBOD_EDG) THEN + IFCELL_DO : DO IFCELL=1,6 + CEI2 = MESHES(NM)%FCVAR(I+IADD(IFCELL),J+JADD(IFCELL),K+KADD(IFCELL),CC_IDCE,AXIS(IFCELL)) + IF (CEI2 < 1) CYCLE + DO IEDGE=1,MESHES(NM)%CUT_EDGE(CEI2)%NEDGE + IF (MESHES(NM)%CUT_EDGE(CEI2)%INDSEG(4,IEDGE) /= IG1) THEN + TWOBOD_EDG =.TRUE. + EXIT IFCELL_DO + ENDIF + ENDDO + ENDDO IFCELL_DO + ENDIF + IF(.NOT.TWOBOD_EDG) CYCLE - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & - BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = & - -SUM(BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG))/2 - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE + ! Here we have cut-edges on the cell belonging to two or more bodies: + ! First discard if CELLRT=true, we won't be using cut-edges: + IF (CELLRT(I,J,K)) CYCLE - ! Test for Repeated edge -> If so note FACERT - DO IDG=1,NEDGE - IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & - ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN - FACERT(JJ2,KK2) =.TRUE. - EXIT - ENDIF + ! Now figure out which edges are inside other SOLIDS: + ! Ray tracing in either X, Y or Z directions: + ! 1. For the segment center point P provide: + ! a. Its coordinates P={xp,yp,zp}. + ! b. Direction X1 for Ray shooting (IAXIS,JAXIS,KAXIS). + ALLOCATE(SOLID_EDGE(1:NEDGE)); SOLID_EDGE(1:NEDGE)=.FALSE. + DO IEDGE=1,NEDGE + ! No body associated with segment. Might not be needed. + IG = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) + IF ( IG < 1 ) CYCLE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + XP(IAXIS:KAXIS) = 0.5_EB*(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + & + MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2))) + ! Direction NP: + NP(IAXIS:KAXIS) = 0._EB + DO I_NP=1,MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,IEDGE) + ITRI = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1+I_NP,IEDGE) + NP(IAXIS:KAXIS) = NP(IAXIS:KAXIS) + GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,ITRI) ENDDO - + X2AXIS = MAXLOC(ABS(NP(IAXIS:KAXIS)),DIM=1) + CALL GET_IS_SOLID_3D(X2AXIS,XP,I,J,K,SOLID_EDGE(IEDGE)) ENDDO -ENDDO SEGS_LOOP + ! Now drop SEGS with SOLID_EDGE(IEDGE)=true: + COUNT = 0 + DO IEDGE=1,NEDGE + IF (SOLID_EDGE(IEDGE)) CYCLE + COUNT=COUNT+1 + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,COUNT) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,COUNT) = & + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,IEDGE) + ENDDO -! Here TAG any CUT_EDGE vertices in VERT_LIST that lay in cartesian cell vertices: -DO CEI=INIT_CUT_EDGES,MESHES(NM)%N_CUTEDGE_MESH - INDIF = MESHES(NM)%CUT_EDGE(CEI)%IJK(IAXIS) - INDJF = MESHES(NM)%CUT_EDGE(CEI)%IJK(JAXIS) - INDKF = MESHES(NM)%CUT_EDGE(CEI)%IJK(KAXIS) - SELECT CASE(X1AXIS) ! INBOUNDCF edge, X1AXIS axis normal to face that edge is assigned to. - CASE(IAXIS) - IVERT_DOI : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB - ! INDJF-1:INDJF,INDKF-1:INDKF - DO KADD=-1,0 - DO JADD=-1,0 - IF(ABS(YFACE(INDJF+JADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,IVERT))>GEOMEPS) CYCLE - IF(ABS(ZFACE(INDKF+KADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,IVERT))>GEOMEPS) CYCLE - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF, INDJF+JADD, INDKF+KADD /) - CYCLE IVERT_DOI - ENDDO - ENDDO - ENDDO IVERT_DOI - CASE(JAXIS) - IVERT_DOJ : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB - ! INDIF-1:INDIF,INDKF-1:INDKF - DO KADD=-1,0 - DO IADD=-1,0 - IF(ABS(XFACE(INDIF+IADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,IVERT))>GEOMEPS) CYCLE - IF(ABS(ZFACE(INDKF+KADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,IVERT))>GEOMEPS) CYCLE - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF+IADD, INDJF, INDKF+KADD /) - CYCLE IVERT_DOJ - ENDDO - ENDDO - ENDDO IVERT_DOJ - CASE(KAXIS) - IVERT_DOK : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB - ! INDJF-1:INDJF,INDKF-1:INDKF - DO IADD=-1,0 - DO JADD=-1,0 - IF(ABS(YFACE(INDJF+JADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,IVERT))>GEOMEPS) CYCLE - IF(ABS(XFACE(INDIF+IADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,IVERT))>GEOMEPS) CYCLE - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF+IADD, INDJF+JADD, INDKF /) - CYCLE IVERT_DOK - ENDDO - ENDDO - ENDDO IVERT_DOK - END SELECT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = COUNT + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,COUNT+1:NEDGE) = CC_UNDEFINED + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,COUNT+1:NEDGE) = CC_UNDEFINED + DEALLOCATE(SOLID_EDGE) ENDDO -! Note cells in CELLRT due to FCERT intersections in GET_BODINT_PLANE: -DO KK2=X3LO_CELL,X3HI_CELL - DO JJ2=X2LO_CELL,X2HI_CELL - IF(.NOT.FACERT(JJ2,KK2)) CYCLE - ! Low cell indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS); INDJF=INDXI(XJAXIS); INDKF=INDXI(XKAXIS) - CELLRT(INDIF,INDJF,INDKF) =.TRUE. - - ! High cell indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS)+1, JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS); INDJF=INDXI(XJAXIS); INDKF=INDXI(XKAXIS) - CELLRT(INDIF,INDJF,INDKF) =.TRUE. - ENDDO -ENDDO +T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX ) + CURRENT_TIME() - TNOW -T_CC_USED(GET_CARTFACE_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTEDGES_TIME_INDEX) + CURRENT_TIME() - TNOW +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + NCUTEDG = 0 + DO CEI=1,MESHES(NM)%N_CUTEDGE_MESH + NCUTEDG = NCUTEDG + MESHES(NM)%CUT_EDGE(CEI)%NEDGE + ENDDO + WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-edges in mesh : ',NCUTEDG,'. ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-edges in mesh : ',NCUTEDG,'. ' + ENDIF +ENDIF RETURN -END SUBROUTINE GET_CARTFACE_CUTEDGES +END SUBROUTINE GET_CARTCELL_CUTEDGES -! -------------------------- GET_IS_SOLID_PT ------------------------------------ +! ------------------------- GET_IS_SOLID_3D ------------------------------------- -SUBROUTINE GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) +SUBROUTINE GET_IS_SOLID_3D(X2AXIS,XP,I,J,K,IS_SOLID) -TYPE(BODINT_PLANE_TYPE), INTENT(IN) :: BODINT_PLANE2 -INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS -REAL(EB), INTENT(IN) :: XY(IAXIS:JAXIS),NVEC(IAXIS:JAXIS),X1PLN +INTEGER, INTENT(IN) :: X2AXIS,I,J,K +REAL(EB), INTENT(IN) :: XP(IAXIS:KAXIS) LOGICAL, INTENT(OUT):: IS_SOLID -! Local Variables -REAL(EB):: XYZ1(IAXIS:KAXIS), XYZ2(IAXIS:KAXIS), SCEN, XRAY -REAL(EB):: X2_1, X2_2, X3_1, X3_2, X2MIN, X2MAX, X3MIN, X3MAX, DOT1, DOT2, DELBIN, MODTI, SVARI, AVAL -REAL(EB):: STANI(IAXIS:JAXIS), NOMLI(IAXIS:JAXIS), DV12(IAXIS:JAXIS) -INTEGER :: SEG(NOD1:NOD2), ISSEG(LOW_IND:HIGH_IND), ISEG, IISEG, XAXIS, IBIN, ICR, SCRSI, ILO_BIN, IHI_BIN,& - ICRSI(LOW_IND:HIGH_IND+1), GAM(LOW_IND:HIGH_IND) -LOGICAL :: OUTRAY, IS_GASPHASE +! Logical Variables: +INTEGER :: IJK(IAXIS:KAXIS) +REAL(EB):: NVEC(IAXIS:JAXIS)=(/ 1._EB, 0._EB /), XY(IAXIS:JAXIS), PLNORMAL(IAXIS:KAXIS), X1PLN, X3RAY +INTEGER :: X1AXIS, X3AXIS, X2LO, X2HI, X3LO, X3HI +LOGICAL :: TRI_ONPLANE_ONLY =.FALSE., RAYTRACE_X2_ONLY =.TRUE. -! Initialize crossings arrays: -CC_N_CRS = 0 -CC_SVAR_CRS(:) = 1._EB/GEOMEPS -CC_IS_CRS(:) = CC_UNDEFINED -CC_IS_CRS2(:,:)= CC_UNDEFINED -CC_SEG_TAN(:,:)= 0._EB -CC_SEG_CRS(:) = 0 -CC_BDNUM_CRS(:)= 0 -CC_BDNUM_CRS_AUX(:)= 0 +IJK(IAXIS:KAXIS) = (/ I, J, K /) -! Define crossings: -IF(ABS(NVEC(IAXIS)) > ABS(NVEC(JAXIS))) THEN ! Do X2 ray - SCEN = XY(IAXIS); XRAY=XY(JAXIS); XAXIS=X3AXIS +SELECT CASE(X2AXIS) + CASE(JAXIS) + X1AXIS = IAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) + ! x2, x3 axes parameters: + X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD + X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD + X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) + ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: + X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS + CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & + X2LO,X2HI,X3LO,X3HI,YFACE,ZFACE,JLO_CELL,JHI_CELL,& + KLO_CELL,KHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) + CASE(KAXIS) + X1AXIS = JAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 1._EB, 0._EB /) + ! x2, x3 axes parameters: + X2LO = KLO_FACE-CCGUARD; X2HI = KHI_FACE+CCGUARD + X3AXIS = IAXIS; X3LO = ILO_FACE-CCGUARD; X3HI = IHI_FACE+CCGUARD + X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) + ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: + X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS + CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & + X2LO,X2HI,X3LO,X3HI,ZFACE,XFACE,KLO_CELL,KHI_CELL,& + ILO_CELL,IHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) + CASE(IAXIS) + X1AXIS = KAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 0._EB, 1._EB /) + ! x2, x3 axes parameters: + X2LO = ILO_FACE-CCGUARD; X2HI = IHI_FACE+CCGUARD + X3AXIS = JAXIS; X3LO = JLO_FACE-CCGUARD; X3HI = JHI_FACE+CCGUARD + X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) + ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: + X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS + CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & + X2LO,X2HI,X3LO,X3HI,XFACE,YFACE,ILO_CELL,IHI_CELL,& + JLO_CELL,JHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) +END SELECT - DELBIN = BODINT_PLANE2%TBAXIS(XAXIS)%DELBIN - AVAL = (XRAY-GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN - ILO_BIN= MAX(1, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) - AVAL = (XRAY+GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN - IHI_BIN= MIN(BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) - DO IBIN=ILO_BIN,IHI_BIN - IF (XRAY < BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE - IF (XRAY > BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE - DO IISEG=1,BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%NTL - ISEG = BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) - SEG(NOD1:NOD2) = BODINT_PLANE2%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD2)) +IF (BODINT_PLANE2%NSEGS == 0) THEN + IS_SOLID =.FALSE. + RETURN +ENDIF - ! x2,x3 coordinates of segment: - X2_1 = XYZ1(X2AXIS) - X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. - X2_2 = XYZ2(X2AXIS) - X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. +XY(IAXIS:JAXIS) = (/ XP(X2AXIS), X3RAY /) +CALL GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) - ! First Test if the whole segment is on one side of the Ray: - ! Test segment crosses the ray, or is in geomepsilon proximity - ! of it: - X3MIN = MIN(X3_1,X3_2); X3MAX = MAX(X3_1,X3_2); - OUTRAY=(((XRAY-X3MAX) > GEOMEPS) .OR. ((X3MIN-XRAY) > GEOMEPS)) +RETURN +END SUBROUTINE GET_IS_SOLID_3D - IF (OUTRAY) CYCLE - DOT1 = X3_1-XRAY; DOT2 = X3_2-XRAY - IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB - IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB - ! Segment tangent unit vector. - DV12(IAXIS:JAXIS) = XYZ2( (/ X2AXIS, X3AXIS /) ) - XYZ1( (/ X2AXIS, X3AXIS /) ) - MODTI = SQRT( DV12(IAXIS)**2._EB + DV12(JAXIS)**2._EB ) - STANI(IAXIS:JAXIS) = DV12(IAXIS:JAXIS) * MODTI**(-1._EB) - NOMLI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) - ISSEG(LOW_IND:HIGH_IND) = BODINT_PLANE2%SEGTYPE(LOW_IND:HIGH_IND,ISEG) +! ---------------------- GET_CARTCELL_CUTFACES ---------------------------------- - ! For x2, in local x2-x3 coords e2=(1,0): - GAM(LOW_IND) = (1 + NINT(SIGN(1._EB,NOMLI(IAXIS)))) / 2 ! (1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; - GAM(HIGH_IND)= (1 - NINT(SIGN(1._EB,NOMLI(IAXIS)))) / 2 ! (1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; +SUBROUTINE GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) - ! Test if whole segment is in ray, if so add segment nodes as crossings: - IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN - ! Count both points as crossings: - ! Point 1: - SVARI = MIN(X2_1,X2_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - DO ICR=2,BODINT_PLANE2%NBCROSS(ISEG)-1 - SVARI = X2_1 + BODINT_PLANE2%SVAR(ICR,ISEG)*STANI(IAXIS) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - ENDDO - ! Point 2: - SVARI = max(X2_1,X2_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - ! Now nodes individually: - IF ( ABS(DOT1) == 0._EB ) THEN - ! Point 1: - SVARI = X2_1 - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - IF ( ABS(DOT2) == 0._EB ) THEN - ! Point 2: - SVARI = X2_2 - ! LOW and HIGH_IND media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - ! Finally regular case: - ! Points 1 on one side of ray, point 2 on the other: - IF ( DOT1*DOT2 < 0._EB ) THEN - ! Intersection Point along segment: - ! DS = (XRAY-X3_1) / (X3_2-X3_1) - ! SVARI = X2_1 + DS*(X2_2-X2_1) - SVARI = X2_1 + (XRAY-X3_1) * (X2_2-X2_1) / (X3_2-X3_1) - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - WRITE(LU_ERR,*) 'Error GET_IS_SOLID_PT NVEC(IAXIS): Missed segment=',ISEG - ENDDO - ENDDO +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -ELSE ! Do X3 ray - SCEN=XY(JAXIS); XRAY=XY(IAXIS); XAXIS=X2AXIS; +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN) :: BNDINT_FLAG - DELBIN = BODINT_PLANE2%TBAXIS(XAXIS)%DELBIN - AVAL = (XRAY-GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN - ILO_BIN= MAX(1, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) - AVAL = (XRAY+GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN - IHI_BIN= MIN(BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) - DO IBIN=ILO_BIN,IHI_BIN - IF (XRAY < BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE - IF (XRAY > BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE - DO IISEG=1,BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%NTL - ISEG = BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) - SEG(NOD1:NOD2) = BODINT_PLANE2%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD2)) + ! Local Variables: +INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI +INTEGER :: I,J,K, JJ, KK +INTEGER, DIMENSION(LOW_IND:HIGH_IND,IAXIS:KAXIS) :: FSID_XYZ, CEIB_XYZ +LOGICAL :: OUTCELL1 +INTEGER :: X1AXIS, X2AXIS, X3AXIS +INTEGER :: XIAXIS, XJAXIS, XKAXIS +INTEGER :: X2LO, X2HI, X3LO, X3HI +INTEGER :: X2LO_CELL, X2HI_CELL, X3LO_CELL, X3HI_CELL +REAL(EB), DIMENSION(MAX_DIM) :: PLNORMAL +INTEGER, DIMENSION(MAX_DIM) :: IJK +REAL(EB) :: X1PLN +LOGICAL :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY +INTEGER :: NVERT, NEDGE, NFACE, NSEG, NCF, FNVERT, FNEDGE, CEI, NSEG_FACE +REAL(EB) :: FVERT(IAXIS:JAXIS,NOD1:NOD4) +LOGICAL :: INB_FLG +INTEGER :: CEELEM(NOD1:NOD2,1:CC_MAXCEELEM_FACE) +INTEGER :: INDSEG(CC_MAX_WSTRIANG_SEG+3,CC_MAXCEELEM_FACE) +REAL(EB) :: XYVERT(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) +INTEGER :: TRIS(NOD1:NOD3), ITRI +REAL(EB) :: XYEL(IAXIS:JAXIS,NOD1:NOD3), VAL, DUMMY(IAXIS:JAXIS) +REAL(EB) :: A_COEF, B_COEF, C_COEF, D_COEF, DENOM +INTEGER :: INDXI(IAXIS:KAXIS), INDIF, INDJF, INDKF +REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) :: XYZVERT, XYZVERTF - ! x2,x3 coordinates of segment: - X2_1 = XYZ1(X2AXIS) - X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. - X2_2 = XYZ2(X2AXIS) - X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL,SEG_CELL_AUX +INTEGER, SAVE :: SIZE_CEELEM_SEG_CELL + +INTEGER, DIMENSION(NOD1:NOD2+1,1:CC_MAXCEELEM_FACE) :: SEG_FACE, SEG_FACE2 +INTEGER, DIMENSION(1:2,1:CC_MAXCFELEM_FACE) :: BOD_TRI +LOGICAL :: SEG_FLAG(1:CC_MAXCEELEM_FACE), INLIST, EQUAL1, EQUAL2, RH_ORIENTED +INTEGER :: COUNTR, CTR, CTSTART, FAXIS, ILH, IEDGE, SEG(NOD1:NOD2), STRI(1:CC_MAX_WSTRIANG_SEG+2), ISEG +INTEGER :: INOD1, INOD2, VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5), IDUM, IEQ1, IEQ2, NBODTRI +REAL(EB), DIMENSION(IAXIS:KAXIS) :: XYZ, NORMTRI, XCENI, XCEN, X1, X2, XC1, XC2, X12, VC1, V12, CROSSV +INTEGER, PARAMETER :: INDVERTBOD(1:3) = (/ 1, 2, 6 /) +INTEGER, PARAMETER :: INDVERTBOD2(1:3) = (/ 2, 1, 6 /) +INTEGER :: NCUTFACE, ICF, NSEG_LEFT, ISEG_FACE, IBOD, NP, IX, IBODTRI, NVSIZE +REAL(EB) :: AREAI, AREA, INXAREA, INT2 +REAL(EB), DIMENSION(IAXIS:KAXIS) :: ACEN, SQAREA + +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNTED +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:):: IJK_COUNTF + +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES - ! First Test if the whole segment is on one side of the Ray: - ! Test segment crosses the ray, or is in geomepsilon proximity - ! of it: - X2MIN = MIN(X2_1,X2_2) - X2MAX = MAX(X2_1,X2_2) - OUTRAY=(((XRAY-X2MAX) > GEOMEPS) .OR. ((X2MIN-XRAY) > GEOMEPS)) +INTEGER :: NVERT_AUX, NEDGE_OLD, IVERT, COUNT, IEOLD, INOD, NPOLY, CT_EDGES +INTEGER :: NSG_POLY(1:MAX_CELL_POLYLINES), ILO_POLY(1:MAX_CELL_POLYLINES) +LOGICAL :: FOUND +REAL(EB):: XYZV(IAXIS:KAXIS), NXP(IAXIS:KAXIS), XP(IAXIS:KAXIS), D12(IAXIS:KAXIS), D23(IAXIS:KAXIS), NNORM - IF (OUTRAY) CYCLE - DOT1 = X2_1-XRAY; DOT2 = X2_2-XRAY - IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB - IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB +INTEGER :: I_NP, IG, XAXIS, NSPCELL_LIST +LOGICAL, ALLOCATABLE, DIMENSION(:) :: SOLID_EDGE +INTEGER, ALLOCATABLE, DIMENSION(:) :: VERT_SEGS, SEG_POS +INTEGER, ALLOCATABLE, DIMENSION(:,:):: SPCELL_LIST +LOGICAL :: CYCLE_CELL, IFLG +REAL(EB) :: XMIN(IAXIS:KAXIS),XMAX(IAXIS:KAXIS) - ! Segment tangent unit vector. - DV12(IAXIS:JAXIS) = XYZ2( (/ X2AXIS, X3AXIS /) ) - XYZ1( (/ X2AXIS, X3AXIS /) ) - MODTI = SQRT( DV12(IAXIS)**2._EB + DV12(JAXIS)**2._EB ) - STANI(IAXIS:JAXIS) = DV12(IAXIS:JAXIS) * MODTI**(-1._EB) - NOMLI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) - ISSEG(LOW_IND:HIGH_IND) = BODINT_PLANE2%SEGTYPE(LOW_IND:HIGH_IND,ISEG) +REAL(EB) :: TNOW - ! For x3, in local x2-x3 coords e2=(0,1): - GAM(LOW_IND) = (1 + NINT(SIGN(1._EB,NOMLI(JAXIS)))) / 2 ! (1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; - GAM(HIGH_IND)= (1 - NINT(SIGN(1._EB,NOMLI(JAXIS)))) / 2 ! (1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; +INTEGER :: ETYPE,JEC +REAL(EB) :: X1V(IAXIS:KAXIS), X2V(IAXIS:KAXIS) +! INTEGER :: IEC +! REAL(EB) :: X1E(IAXIS:KAXIS), X2E(IAXIS:KAXIS) - ! Test if whole segment is in ray, if so add segment nodes as crossings: - IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN - ! Count both points as crossings: - ! Point 1: - SVARI = MIN(X3_1,X3_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - DO ICR=2,BODINT_PLANE2%NBCROSS(ISEG)-1 - SVARI = X3_1 + BODINT_PLANE2%SVAR(ICR,ISEG)*STANI(JAXIS) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - ENDDO - ! Point 2: - SVARI = MAX(X3_1,X3_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - ! Now nodes individually: - IF ( ABS(DOT1) == 0._EB ) THEN - ! Point 1: - SVARI = X3_1 - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - IF ( ABS(DOT2) == 0._EB ) THEN - ! Point 2: - SVARI = X3_2 - ! LOW and HIGH_IND media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - ! Finally regular case: - ! Points 1 on one side of ray, point 2 on the other: - IF ( DOT1*DOT2 < 0._EB ) THEN - ! Intersection Point along segment: - ! DS = (XRAY-X2_1) / (X2_2-X2_1) - ! SVARI = X3_1 + DS*(X3_2-X3_1) - SVARI = X3_1 + (XRAY-X2_1) * (X3_2-X3_1) / (X2_2-X2_1) - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - WRITE(LU_ERR,*) 'Error GET_IS_SOLID_PT NVEC(JAXIS): Missed segment=',ISEG - ENDDO - ENDDO +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +INTEGER :: NCUTFCE +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + IF (BNDINT_FLAG) THEN ! Boundary and internal cartface cut-faces: + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating internal CARTCELL_CUTFACES for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating internal CARTCELL_CUTFACES for mesh :',NM,' ..' + ELSE + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTCELL_CUTFACES for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTCELL_CUTFACES for mesh :',NM,' ..' + ENDIF ENDIF -! Do we have any intersections? -IF ( CC_N_CRS == 0 ) THEN - IS_SOLID =.FALSE. - RETURN -ENDIF -CALL COLLAPSE_CROSSINGS(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XRAY,X1PLN,2) -CALL GET_IS_GASPHASE(SCEN,IS_GASPHASE) +TNOW=CURRENT_TIME() -IS_SOLID = .NOT.IS_GASPHASE +SIZE_CEELEM_SEG_CELL = DELTA_EDGE +ALLOCATE(SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL),SEG_POS(1:SIZE_CEELEM_SEG_CELL)) -RETURN -END SUBROUTINE GET_IS_SOLID_PT +! Define which cells are cut-cell, and which are solid: +IF (BNDINT_FLAG) THEN + ALLOCATE( MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,DELTA_CELL) ); MESHES(NM)%SPCELL_LIST = CC_UNDEFINED + ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND) ); IJK_COUNTED=.FALSE. + ALLOCATE( IJK_COUNTF(ISTR:IEND,JSTR:JEND,KSTR:KEND,MAX_DIM) ); IJK_COUNTF=.FALSE. + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL +ELSE + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD +ENDIF +! Loop on Cartesian cells, define cut cells and solid cells ISSO: +DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -! ------------------------- INSERT_FACE_VERT ------------------------------------ + IF(IJK_COUNTED(I,J,K)) CYCLE -SUBROUTINE INSERT_FACE_VERT(XYZV,NM,CEI,NVERT,INOD) + ! Face type of bounding Cartesian faces: + FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) + FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) + FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) + FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) + FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) + FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) -REAL(EB), INTENT(IN) :: XYZV(MAX_DIM) -INTEGER, INTENT(IN) :: NM,CEI -INTEGER, INTENT(INOUT):: NVERT -INTEGER, INTENT(OUT) :: INOD + ! For this cell check if no Cartesian boundary faces are CC_CUTCFE: + ! If outcell1 is true -> All regular faces for this face: + OUTCELL1 = (FSID_XYZ(LOW_IND ,IAXIS) /= CC_CUTCFE) .AND. & + (FSID_XYZ(HIGH_IND,IAXIS) /= CC_CUTCFE) .AND. & + (FSID_XYZ(LOW_IND ,JAXIS) /= CC_CUTCFE) .AND. & + (FSID_XYZ(HIGH_IND,JAXIS) /= CC_CUTCFE) .AND. & + (FSID_XYZ(LOW_IND ,KAXIS) /= CC_CUTCFE) .AND. & + (FSID_XYZ(HIGH_IND,KAXIS) /= CC_CUTCFE) -! Local Variables: -! INTEGER :: JNOD, JNOD2, PIVOT(LOW_IND:HIGH_IND) -! REAL(EB) :: DV(MAX_DIM) -! IF (NVERT < LINSEARCH_LIMIT) THEN -! ! Linear Search: -! DO JNOD=1,NVERT -! DV(IAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(IAXIS) -! IF( DV(IAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF( ABS(DV(IAXIS)) <= GEOMEPS) THEN -! DV(JAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(JAXIS) -! IF ( DV(JAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF ( ABS(DV(JAXIS)) <= GEOMEPS ) THEN -! DV(KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(KAXIS) -! IF ( DV(KAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF ( ABS(DV(KAXIS)) <= GEOMEPS ) THEN -! INOD = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) -! RETURN ! XYZV is in XYZVERT(IAXIS:KAXIS,NOD_PERM(JNOD)) -! ENDIF -! ENDIF -! ENDIF -! ENDDO -! ELSE -! ! Binary Search: -! PIVOT(LOW_IND) = 0 -! PIVOT(HIGH_IND)= NVERT + 1 -! DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) -! JNOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 -! DV(IAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(IAXIS) -! IF( DV(IAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(IAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(IAXIS)) < GEOMEPS -! DV(JAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(JAXIS) -! IF ( DV(JAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(JAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(JAXIS)) < GEOMEPS -! DV(KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(KAXIS) -! IF ( DV(KAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(KAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(KAXIS)) < GEOMEPS -! INOD = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) -! RETURN -! ENDIF -! ENDIF -! ENDIF -! ENDDO -! JNOD=PIVOT(HIGH_IND) -! ENDIF -! ! Insert add NOD_PERM permutation array, O(NP) operation: -! INOD = NVERT + 1 -! NVERT = INOD -! CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT) -! DO JNOD2=NVERT,JNOD+1,-1 -! MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD2) = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD2-1) -! ENDDO -! MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) = INOD -! MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) + ! Drop if outcell1 & outcell2 + IF (OUTCELL1) THEN + IF ( (FSID_XYZ(LOW_IND ,IAXIS) == CC_SOLID) .AND. & + (FSID_XYZ(HIGH_IND,IAXIS) == CC_SOLID) .AND. & + (FSID_XYZ(LOW_IND ,JAXIS) == CC_SOLID) .AND. & + (FSID_XYZ(HIGH_IND,JAXIS) == CC_SOLID) .AND. & + (FSID_XYZ(LOW_IND ,KAXIS) == CC_SOLID) .AND. & + (FSID_XYZ(HIGH_IND,KAXIS) == CC_SOLID) ) THEN + MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_SOLID + ENDIF + CYCLE + ENDIF -DO INOD=1,NVERT - IF( ABS(XYZV(IAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,INOD)) > GEOMEPS ) CYCLE - IF( ABS(XYZV(JAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,INOD)) > GEOMEPS ) CYCLE - IF( ABS(XYZV(KAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,INOD)) > GEOMEPS ) CYCLE - RETURN -ENDDO -NVERT = NVERT + 1 -INOD = NVERT -CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT) -MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) + MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE + + ENDDO + ENDDO +ENDDO -RETURN -END SUBROUTINE INSERT_FACE_VERT -! ------------------------- INSERT_FACE_VERT_LOC(XYZ,NVERT,INOD1,XYZVERT) +! First add edges stemming from triangles laying on gridline planes: +! Dump triangle aligned segments as cut-cell cut-edges, on face cases: +! BNDINT_COND : IF (BNDINT_FLAG) THEN + ! Do Loop for different x1 planes: + X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS -SUBROUTINE INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,NVERT,INOD,XYZVERT) + SELECT CASE(X1AXIS) + CASE(IAXIS) -INTEGER, INTENT(IN) :: MAXVERTS -REAL(EB), INTENT(IN) :: XYZV(MAX_DIM) -REAL(EB), INTENT(INOUT), DIMENSION(IAXIS:KAXIS,1:MAXVERTS) :: XYZVERT ! Locations of vertices. -INTEGER, INTENT(INOUT):: NVERT -INTEGER, INTENT(OUT) :: INOD + PLNORMAL = (/ 1._EB, 0._EB, 0._EB/) + ILO = ILO_FACE-CCGUARD; IHI = IHI_FACE+CCGUARD + JLO = JLO_FACE; JHI = JLO_FACE + KLO = KLO_FACE; KHI = KLO_FACE -REAL(EB), PARAMETER :: VERT_PROX_FCT = 1000._EB + ! x2, x3 axes parameters: + X2AXIS = JAXIS; X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD + X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD -! Local Variables: -! INTEGER :: JNOD, JNOD2, PIVOT(LOW_IND:HIGH_IND) -! REAL(EB) :: DV(MAX_DIM) -! INTEGER, SAVE :: NOD_PERM(CC_MAXVERTS_CELL) -! IF (NVERT < LINSEARCH_LIMIT) THEN -! ! Linear Search: -! DO JNOD=1,NVERT -! DV(IAXIS) = XYZVERT(IAXIS,NOD_PERM(JNOD)) - XYZV(IAXIS) -! IF( DV(IAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF( ABS(DV(IAXIS)) <= GEOMEPS) THEN -! DV(JAXIS) = XYZVERT(JAXIS,NOD_PERM(JNOD)) - XYZV(JAXIS) -! IF ( DV(JAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF ( ABS(DV(JAXIS)) <= GEOMEPS ) THEN -! DV(KAXIS) = XYZVERT(KAXIS,NOD_PERM(JNOD)) - XYZV(KAXIS) -! IF ( DV(KAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF ( ABS(DV(KAXIS)) <= GEOMEPS ) THEN -! INOD = NOD_PERM(JNOD) -! RETURN ! XYZV is in XYZVERT(IAXIS:KAXIS,NOD_PERM(JNOD)) -! ENDIF -! ENDIF -! ENDIF -! ENDDO -! ELSE -! ! Binary Search: -! PIVOT(LOW_IND) = 0 -! PIVOT(HIGH_IND)= NVERT + 1 -! DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) -! JNOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 -! DV(IAXIS) = XYZVERT(IAXIS,NOD_PERM(JNOD)) - XYZV(IAXIS) -! IF( DV(IAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(IAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(IAXIS)) < GEOMEPS -! DV(JAXIS) = XYZVERT(JAXIS,NOD_PERM(JNOD)) - XYZV(JAXIS) -! IF ( DV(JAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(JAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(JAXIS)) < GEOMEPS -! DV(KAXIS) = XYZVERT(KAXIS,NOD_PERM(JNOD)) - XYZV(KAXIS) -! IF ( DV(KAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(KAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(KAXIS)) < GEOMEPS -! INOD = NOD_PERM(JNOD) -! RETURN -! ENDIF -! ENDIF -! ENDIF -! ENDDO -! JNOD=PIVOT(HIGH_IND) -! ENDIF -! ! Insert add NOD_PERM permutation array, O(NP) operation: -! INOD = NVERT + 1 -! NVERT = INOD -! IF (NVERT>MAXVERTS) WRITE(LU_ERR,*) 'geom.f90: INSERT_FACE_VERT_LOC, NVERT',NVERT,', higher than CC_MAXVERTS',MAXVERTS -! DO JNOD2=NVERT,JNOD+1,-1 -! NOD_PERM(JNOD2) = NOD_PERM(JNOD2-1) -! ENDDO -! NOD_PERM(JNOD) = INOD -! XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) + ! location in I,J,K of x2,x2,x3 axes: + XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS -DO INOD=1,NVERT - IF( ABS(XYZV(IAXIS)-XYZVERT(IAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE - IF( ABS(XYZV(JAXIS)-XYZVERT(JAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE - IF( ABS(XYZV(KAXIS)-XYZVERT(KAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE - RETURN -ENDDO -NVERT = NVERT + 1 -INOD = NVERT -IF (NVERT>MAXVERTS) WRITE(LU_ERR,*) 'geom.f90: INSERT_FACE_VERT_LOC, NVERT',NVERT,', higher than CC_MAXVERTS',MAXVERTS -XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(ISTR:IEND),DX1FACE(ISTR:IEND)) + X1FACE = XFACE; DX1FACE = DXFACE + ALLOCATE(X2FACE(JSTR:JEND),DX2FACE(JSTR:JEND)) + X2FACE = YFACE; DX2FACE = DYFACE + ALLOCATE(X3FACE(KSTR:KEND),DX3FACE(KSTR:KEND)) + X3FACE = ZFACE; DX3FACE = DZFACE -RETURN -END SUBROUTINE INSERT_FACE_VERT_LOC + ! x2 cell center parameters: + X2LO_CELL = JLO_CELL-CCGUARD; X2HI_CELL = JHI_CELL+CCGUARD + ALLOCATE(X2CELL(JSTR:JEND),DX2CELL(JSTR:JEND)) + X2CELL = YCELL; DX2CELL = DYCELL -! ----------------------- GET_CARTFACE_CUTFACES --------------------------------- + ! x3 cell center parameters: + X3LO_CELL = KLO_CELL-CCGUARD; X3HI_CELL = KHI_CELL+CCGUARD + ALLOCATE(X3CELL(KSTR:KEND),DX3CELL(KSTR:KEND)) + X3CELL = ZCELL; DX3CELL = DZCELL -SUBROUTINE GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) + CASE(JAXIS) -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -LOGICAL, INTENT(IN) :: BNDINT_FLAG + PLNORMAL = (/ 0._EB, 1._EB, 0._EB/) + ILO = ILO_FACE; IHI = ILO_FACE + JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD + KLO = KLO_FACE; KHI = KLO_FACE -! Local Variables: -INTEGER :: X1AXIS, X2AXIS, X3AXIS -INTEGER :: XIAXIS, XJAXIS, XKAXIS -INTEGER :: X1LO, X1HI, X2LO, X2HI, X3LO, X3HI -INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI -INTEGER :: II,II2,JJ,KK, CEI -INTEGER :: INDXI(MAX_DIM), INDI, INDJ, INDK -INTEGER :: INDXI1(MAX_DIM), INDI1, INDJ1, INDK1 -INTEGER :: INDXI2(MAX_DIM), INDI2, INDJ2, INDK2 -INTEGER :: INDXI3(MAX_DIM), INDI3, INDJ3, INDK3 -INTEGER :: INDXI4(MAX_DIM), INDI4, INDJ4, INDK4 -INTEGER :: INDLC(MAX_DIM), IEDG, JEDG, KEDG -INTEGER :: NSEG, ISEG, ISEG2, NVERT, NFACE, NEDGE, IEDGE, NVERT_CART, NSEG_CART -LOGICAL :: OUTFACE1, OUTFACE2, NOTDONE + ! x2, x3 axes parameters: + X2AXIS = KAXIS; X2LO = KLO_FACE-CCGUARD; X2HI = KHI_FACE+CCGUARD + X3AXIS = IAXIS; X3LO = ILO_FACE-CCGUARD; X3HI = IHI_FACE+CCGUARD -INTEGER, DIMENSION(NOD1:NOD2+3,1:CC_MAXCEELEM_FACE) :: SEG_FACE, SEG_FACE_CART, SEG_FACEAUX -INTEGER, DIMENSION(NOD1:NOD3+1,1:CC_MAXCEELEM_FACE) :: SEG_FACE2 -REAL(EB), DIMENSION(CC_MAXCEELEM_FACE) :: ANGSEG, ANGSEGAUX -REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) :: XYZVERT, XYZVERT_CART ! Locations of vertices. + ! location in I,J,K of x2,x2,x3 axes: + XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS -INTEGER, SAVE :: SIZE_CFACES_CFELEM, SIZE_VERTS_CFELEM -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CFELEM2,CEDGES,CEDGES2 -INTEGER, ALLOCATABLE, DIMENSION(:) :: CFE, CFEL + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(JSTR:JEND),DX1FACE(JSTR:JEND)) + X1FACE = YFACE; DX1FACE = DYFACE + ALLOCATE(X2FACE(KSTR:KEND),DX2FACE(KSTR:KEND)) + X2FACE = ZFACE; DX2FACE = DZFACE + ALLOCATE(X3FACE(ISTR:IEND),DX3FACE(ISTR:IEND)) + X3FACE = XFACE; DX3FACE = DXFACE -INTEGER, SAVE :: SIZE_EDGES_NODEDG, SIZE_VERTS_NODEDG -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NODEDG_FACE + ! x2 cell center parameters: + X2LO_CELL = KLO_CELL-CCGUARD; X2HI_CELL = KHI_CELL+CCGUARD + ALLOCATE(X2CELL(KSTR:KEND),DX2CELL(KSTR:KEND)) + X2CELL = ZCELL; DX2CELL = DZCELL -LOGICAL :: SEG_FLAG(CC_MAXCEELEM_FACE) -INTEGER :: NUMEDG_NODE(CC_MAXVERTS_FACE) + ! x3 cell center parameters: + X3LO_CELL = ILO_CELL-CCGUARD; X3HI_CELL = IHI_CELL+CCGUARD + ALLOCATE(X3CELL(ISTR:IEND),DX3CELL(ISTR:IEND)) + X3CELL = XCELL; DX3CELL = DXCELL -INTEGER :: INOD, INOD1, INOD2, SEG(NOD1:NOD2) -REAL(EB):: X1, X2, X3, DX2, DX3, XYZV(MAX_DIM), XYZLC(MAX_DIM) -INTEGER :: NUMNOD1, NUMNOD2, NEDI, ICF, ISS, NEWSEG, COUNT, N2COUNT, CTSTART, NSEG_LEFT -REAL(EB):: ANGCOUNT, DANG, DANGI -LOGICAL :: FOUNDSEG, PTSFLAG -INTEGER :: ICF1, ICF2, ICF_PT, IPT, NP, NP1, NP2, NFACE2, NCUTFACE, NVERTFACE -REAL(EB), DIMENSION(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) :: XY -REAL(EB):: AREA, AREA1, AREA2, AREAH, CX2, CX3, DIST12, D12 -REAL(EB), DIMENSION(IAXIS:JAXIS) :: XYC1, XYC2, XYH + CASE(KAXIS) -REAL(EB), DIMENSION(CC_MAXCFELEM_FACE) :: AREAV ! Cut-faces areas. -REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXCFELEM_FACE) :: XYZCEN ! Cut-faces centroid locations. -REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXCFELEM_FACE) :: INXAREA, INXSQAREA -INTEGER, DIMENSION(CC_MAXCFELEM_FACE) :: FINFACE -INTEGER :: IBNDINT,BNDINT_LOW,BNDINT_HIGH,ILOC,BODNUM(1:CC_MAXCEELEM_FACE),& -SEGTYPE(CC_MAXCEELEM_FACE),SEGTYPEAUX(CC_MAXCEELEM_FACE),VEC(2),IDUM,IBOD,STYPE -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED + PLNORMAL = (/ 0._EB, 0._EB, 1._EB/) + ILO = ILO_FACE; IHI = ILO_FACE + JLO = JLO_FACE; JHI = JLO_FACE + KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD -INTEGER :: NSSEG, NSVERT, NSFACE, NSFACE2 -LOGICAL :: ASCDESC, INLIST -INTEGER :: NV,IV,V(1:CC_MAXVERTS_FACE) -REAL(EB):: XVERT1(1:CC_MAXVERTS_FACE),XVERT2(1:CC_MAXVERTS_FACE) + ! x2, x3 axes parameters: + X2AXIS = IAXIS; X2LO = ILO_FACE-CCGUARD; X2HI = IHI_FACE+CCGUARD + X3AXIS = JAXIS; X3LO = JLO_FACE-CCGUARD; X3HI = JHI_FACE+CCGUARD -INTEGER, PARAMETER :: NODC1(1:4) = (/ 1, 2, 1, 2 /) -INTEGER, PARAMETER :: NODC2(1:4) = (/ 1, 2, 2, 1 /) -INTEGER :: SNOD1(NOD1:NOD2), SNOD2(NOD1:NOD2) -REAL(EB) :: XYZ_SEG1(IAXIS:KAXIS,NOD1:NOD2), XYZ_SEG2(IAXIS:KAXIS,NOD1:NOD2) -LOGICAL :: DIFF(1:4) -LOGICAL :: GET_SOLID_CUTFACES = .TRUE. -LOGICAL, ALLOCATABLE, DIMENSION(:) :: DROPFACE -REAL(EB) :: TNOW + ! location in I,J,K of x2,x2,x3 axes: + XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS -! INTEGER :: ETYPE, AXIS, SIDE, IEC, JEC, CEIJK(4), IIF, JJF ,KKF -! REAL(EB):: X1E(IAXIS:KAXIS), X1V(IAXIS:KAXIS), X2E(IAXIS:KAXIS), X2V(IAXIS:KAXIS) + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)) + X1FACE = ZFACE; DX1FACE = DZFACE + ALLOCATE(X2FACE(ISTR:IEND),DX2FACE(ISTR:IEND)) + X2FACE = XFACE; DX2FACE = DXFACE + ALLOCATE(X3FACE(JSTR:JEND),DX3FACE(JSTR:JEND)) + X3FACE = YFACE; DX3FACE = DYFACE -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -INTEGER :: NCUTFCE + ! x2 cell center parameters: + X2LO_CELL = ILO_CELL-CCGUARD; X2HI_CELL = IHI_CELL+CCGUARD + ALLOCATE(X2CELL(ISTR:IEND),DX2CELL(ISTR:IEND)) + X2CELL = XCELL; DX2CELL = DXCELL -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - IF (BNDINT_FLAG) THEN ! Boundary and internal cartface cut-faces: - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating internal CARTFACE_CUTFACES for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating internal CARTFACE_CUTFACES for mesh :',NM,' ..' - ELSE - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTFACE_CUTFACES for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTFACE_CUTFACES for mesh :',NM,' ..' - ENDIF -ENDIF + ! x3 cell center parameters: + X3LO_CELL = JLO_CELL-CCGUARD; X3HI_CELL = JHI_CELL+CCGUARD + ALLOCATE(X3CELL(JSTR:JEND),DX3CELL(JSTR:JEND)) + X3CELL = YCELL; DX3CELL = DYCELL -TNOW=CURRENT_TIME() + END SELECT -! Allocate local Arrays: -SIZE_EDGES_NODEDG = DELTA_EDGE -SIZE_VERTS_NODEDG = DELTA_VERT -ALLOCATE(NODEDG_FACE(1:SIZE_EDGES_NODEDG,1:SIZE_VERTS_NODEDG)) -SIZE_CFACES_CFELEM = DELTA_FACE -SIZE_VERTS_CFELEM = DELTA_VERT -ALLOCATE(CFELEM(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) -ALLOCATE(CEDGES(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) -ALLOCATE(CFE(1:SIZE_VERTS_CFELEM),CFEL(1:SIZE_VERTS_CFELEM)) + ! Loop Slices: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -! Build a set of regular cut-cells in the middle of the domain to do testing. -IF (PERIODIC_TEST == 103 .OR. PERIODIC_TEST == 11 .OR. PERIODIC_TEST == 7) THEN - CALL DEFINE_REGULAR_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) - T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW - RETURN -ENDIF + IJK(IAXIS:KAXIS) = (/ I, J, K /) -! Test to check cut-cell definition scaling: -IF (PERIODIC_TEST == 105) GET_SOLID_CUTFACES = .FALSE. + ! Plane: + X1PLN = X1FACE(IJK(X1AXIS)) -! Main Loop on block NM: -IF (BNDINT_FLAG) THEN - ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. - BNDINT_LOW = 1 - BNDINT_HIGH = 3 -ELSE - IF (CCGUARD==0) THEN - DEALLOCATE( IJK_COUNTED ) - RETURN - ENDIF - BNDINT_LOW = 4 - BNDINT_HIGH = 4 -ENDIF + ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: + TRI_ONPLANE_ONLY = .TRUE. + RAYTRACE_X2_ONLY = .FALSE. + CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS,& + X2LO,X2HI,X3LO,X3HI,X2FACE,X3FACE,X2LO_CELL,& + X2HI_CELL,X3LO_CELL,X3HI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE) -IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, - ! 4 guard-cell faces. + ! Test that there is an intersection: + IF ((BODINT_PLANE%NTRIS) == 0) CYCLE - ! When switching to internal faces, copy number of external faces already computed. - IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + ! Drop if node locations outside block plane area: + IF ((X2FACE(X2LO)-MAXVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE + IF ((MINVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))-X2FACE(X2HI)) > GEOMEPS) CYCLE + IF ((X3FACE(X3LO)-MAXVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE + IF ((MINVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))-X3FACE(X3HI)) > GEOMEPS) CYCLE - XIAXIS_LOOP : DO X1AXIS=IAXIS,KAXIS + ! Allocate triangles variables: + ALLOCATE(BODINT_PLANE%X1NVEC(1:BODINT_PLANE%NTRIS), & + BODINT_PLANE%AINV(1:2,1:2,1:BODINT_PLANE%NTRIS)) - SELECT CASE(X1AXIS) - case(IAXIS) + ! Triangles inverses: + DO ITRI=1,BODINT_PLANE%NTRIS - X2AXIS = JAXIS - X3AXIS = KAXIS + TRIS(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) - ! IAXIS gasphase cut-faces: - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - ILO = ILO_FACE; IHI = ILO_FACE - CASE(2) - ILO = IHI_FACE; IHI = IHI_FACE - CASE(3) - ILO = ILO_FACE+1; IHI = IHI_FACE-1 - CASE(4) - ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT + ! This is local IAXIS:JAXIS + XYEL(IAXIS:JAXIS,NOD1) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD1)), & + BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD1)) /) + XYEL(IAXIS:JAXIS,NOD2) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD2)), & + BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD2)) /) + XYEL(IAXIS:JAXIS,NOD3) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD3)), & + BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD3)) /) - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS + ! Test that x1-x2-x3 obeys right hand rule: + VAL = (XYEL(IAXIS,NOD2)-XYEL(IAXIS,NOD1)) * (XYEL(JAXIS,NOD3)-XYEL(JAXIS,NOD1))- & + (XYEL(JAXIS,NOD2)-XYEL(JAXIS,NOD1)) * (XYEL(IAXIS,NOD3)-XYEL(IAXIS,NOD1)) + BODINT_PLANE%X1NVEC(ITRI) = SIGN(1._EB,VAL) - ! Local indexing in x1, x2, x3: - X1LO = ILO; X1HI = IHI - X2LO = JLO; X2HI = JHI - X3LO = KLO; X3HI = KHI + ! Transformation Matrix for this triangle in x2x3 plane: + IF (BODINT_PLANE%X1NVEC(ITRI) < 0._EB) THEN ! Rotate node 2 and 3 locations + DUMMY(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,NOD2) + XYEL(IAXIS:JAXIS,NOD2) = XYEL(IAXIS:JAXIS,NOD3) + XYEL(IAXIS:JAXIS,NOD3) = DUMMY(IAXIS:JAXIS) + ENDIF - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE - ALLOCATE(X2FACE(JSTR:JEND)); X2FACE = YFACE - ALLOCATE(X3FACE(KSTR:KEND)); X3FACE = ZFACE + ! Inverse of Master to physical triangle transform matrix: + A_COEF = XYEL(IAXIS,NOD1) - XYEL(IAXIS,NOD3) + B_COEF = XYEL(IAXIS,NOD2) - XYEL(IAXIS,NOD3) + C_COEF = XYEL(JAXIS,NOD1) - XYEL(JAXIS,NOD3) + D_COEF = XYEL(JAXIS,NOD2) - XYEL(JAXIS,NOD3) + DENOM = A_COEF * D_COEF - B_COEF * C_COEF + BODINT_PLANE%AINV(1,1,ITRI) = D_COEF / DENOM + BODINT_PLANE%AINV(2,1,ITRI) = -C_COEF / DENOM + BODINT_PLANE%AINV(1,2,ITRI) = -B_COEF / DENOM + BODINT_PLANE%AINV(2,2,ITRI) = A_COEF / DENOM - CASE(JAXIS) + ENDDO - X2AXIS = KAXIS - X3AXIS = IAXIS + ! There are triangles aligned with this x1pln: + ! Run by Face: + ! First solid Faces: x1 Faces, Check where they lay: + DO KK=X3LO_CELL,X3HI_CELL + DO JJ=X2LO_CELL,X2HI_CELL - ! JAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - JLO = JLO_FACE; JHI = JLO_FACE - CASE(2) - JLO = JHI_FACE; JHI = JHI_FACE - CASE(3) - JLO = JLO_FACE+1; JHI = JHI_FACE-1 - CASE(4) - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ IJK(X1AXIS), JJ, KK /) ! Local x1,x2,x3 + INDIF = INDXI(XIAXIS) + INDJF = INDXI(XJAXIS) + INDKF = INDXI(XKAXIS) - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS + IF (IJK_COUNTF(INDIF,INDJF,INDKF,X1AXIS)) CYCLE - ! Local indexing in x1, x2, x3: - X1LO = JLO; X1HI = JHI - X2LO = KLO; X2HI = KHI - X3LO = ILO; X3HI = IHI + IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_FGSC,X1AXIS) /= CC_GASPHASE ) THEN - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE - ALLOCATE(X2FACE(KSTR:KEND)); X2FACE = ZFACE - ALLOCATE(X3FACE(ISTR:IEND)); X3FACE = XFACE + FVERT(IAXIS:JAXIS,NOD1) = (/ X2FACE(JJ-1), X3FACE(KK-1) /) + FVERT(IAXIS:JAXIS,NOD2) = (/ X2FACE(JJ ), X3FACE(KK-1) /) + FVERT(IAXIS:JAXIS,NOD3) = (/ X2FACE(JJ ), X3FACE(KK ) /) + FVERT(IAXIS:JAXIS,NOD4) = (/ X2FACE(JJ-1), X3FACE(KK ) /) - CASE(KAXIS) + ! Get triangle face intersection: + CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) - X2AXIS = IAXIS - X3AXIS = JAXIS + ! Triangle - face intersection vertices and edges: + CALL GET_TRIANG_FACE_INT(X2AXIS,X3AXIS,FVERT,CEI,NM, & + INB_FLG,FNVERT,XYVERT,FNEDGE,CEELEM,INDSEG) - ! KAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - KLO = KLO_FACE; KHI = KLO_FACE - CASE(2) - KLO = KHI_FACE; KHI = KHI_FACE - CASE(3) - KLO = KLO_FACE+1; KHI = KHI_FACE-1 - CASE(4) - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - END SELECT + ! XYvert to XYZvert: + IF ( INB_FLG ) THEN + XYZVERTF = 0._EB + XYZVERTF(X1AXIS,1:FNVERT) = X1PLN + XYZVERTF(X2AXIS,1:FNVERT) = XYVERT(IAXIS,1:FNVERT) + XYZVERTF(X3AXIS,1:FNVERT) = XYVERT(JAXIS,1:FNVERT) - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS + ! Test for edges inside SOLID Region: + ALLOCATE(SOLID_EDGE(1:FNEDGE)); SOLID_EDGE(1:FNEDGE)=.FALSE. + DO IEDGE=1,FNEDGE + ! No body associated with segment. Might not be needed. + IG = INDSEG(4,IEDGE) + IF ( IG < 1) CYCLE + SEG(NOD1:NOD2) = CEELEM(NOD1:NOD2,IEDGE) + XP(IAXIS:KAXIS)= 0.5_EB*(XYZVERTF(IAXIS:KAXIS,SEG(NOD1))+XYZVERTF(IAXIS:KAXIS,SEG(NOD2))) + ! Direction NP: + NXP(IAXIS:KAXIS) = 0._EB + DO I_NP=1,INDSEG(1,IEDGE) + ITRI = INDSEG(1+I_NP,IEDGE) + NXP(IAXIS:KAXIS) = NXP(IAXIS:KAXIS) + GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,ITRI) + ENDDO + NXP = NXP/NORM2(NXP); XAXIS=MAXLOC(ABS(NXP(IAXIS:KAXIS)),DIM=1) + ! Perturb XP in the average normal NP direction: + IF (INDSEG(1,IEDGE) > 1) XP = XP + 10._EB*GEOMEPS*NXP + CALL GET_IS_SOLID_3D(XAXIS,XP,INDIF,INDJF,INDKF,SOLID_EDGE(IEDGE)) + ENDDO + ! Now drop SEGS with SOLID_EDGE(IEDGE)=true: + COUNT = 0 + DO IEDGE=1,FNEDGE + IF (SOLID_EDGE(IEDGE)) CYCLE + COUNT=COUNT+1 + CEELEM(NOD1:NOD2,COUNT) = CEELEM(NOD1:NOD2,IEDGE) + INDSEG(1:CC_MAX_WSTRIANG_SEG+2,COUNT) = INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) + ENDDO + CEELEM(NOD1:NOD2,COUNT+1:FNEDGE) = CC_UNDEFINED + INDSEG(1:CC_MAX_WSTRIANG_SEG+2,COUNT+1:FNEDGE) = CC_UNDEFINED + FNEDGE = COUNT + DEALLOCATE(SOLID_EDGE) - ! Local indexing in x1, x2, x3: - X1LO = KLO; X1HI = KHI - X2LO = ILO; X2HI = IHI - X3LO = JLO; X3HI = JHI + ! Here ADD nodes and vertices to what is already + ! there: + IF (CEI == 0) THEN ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = FNVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = FNEDGE + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,FNVERT,FNEDGE) + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = & + (/ INDIF, INDJF, INDKF, X1AXIS, CC_GS /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF + MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:FNVERT) = & + XYZVERTF(IAXIS:KAXIS,1:FNVERT) + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:FNEDGE) = & + CEELEM(NOD1:NOD2,1:FNEDGE) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:FNEDGE) = & + INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:FNEDGE) + ELSE - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE - ALLOCATE(X2FACE(ISTR:IEND)); X2FACE = XFACE - ALLOCATE(X3FACE(JSTR:JEND)); X3FACE = YFACE + NVERT_AUX=MESHES(NM)%CUT_EDGE(CEI)%NVERT + NEDGE_OLD=MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IVERT=1,FNVERT + XYZV(IAXIS:KAXIS) = XYZVERTF(IAXIS:KAXIS,IVERT) + CALL INSERT_FACE_VERT(XYZV,NM,CEI,NVERT_AUX,INOD) + DO IEDGE=1,FNEDGE + IF(CEELEM(NOD1,IEDGE)==IVERT) CEELEM(NOD1,IEDGE)=INOD + IF(CEELEM(NOD2,IEDGE)==IVERT) CEELEM(NOD2,IEDGE)=INOD + ENDDO + ENDDO + CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE_OLD+FNEDGE) + COUNT = NEDGE_OLD + OUTER :DO IEDGE=1,FNEDGE + FOUND=.FALSE. + INNER1 : DO IEOLD=1,NEDGE_OLD + IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IEOLD) /= CEELEM(NOD1,IEDGE)) CYCLE INNER1 + IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IEOLD) /= CEELEM(NOD2,IEDGE)) CYCLE INNER1 + IF(MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEOLD) /= INDSEG(4,IEDGE)) CYCLE INNER1 + FOUND=.TRUE. + ENDDO INNER1 + INNER2 : DO IEOLD=1,NEDGE_OLD + IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IEOLD) /= CEELEM(NOD1,IEDGE)) CYCLE INNER2 + IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IEOLD) /= CEELEM(NOD2,IEDGE)) CYCLE INNER2 + IF(MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEOLD) /= INDSEG(4,IEDGE)) CYCLE INNER2 + FOUND=.TRUE. + ENDDO INNER2 + IF(FOUND) CYCLE OUTER + COUNT=COUNT+1 + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,COUNT) = CEELEM(NOD1:NOD2,IEDGE) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,COUNT)=& + INDSEG(1:CC_MAX_WSTRIANG_SEG+3,IEDGE) + ENDDO OUTER + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT_AUX + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = COUNT - END SELECT + ENDIF - ! Loop on Cartesian faces, local x1, x2, x3 indexes: - DO II=X1LO,X1HI - DO KK=X3LO,X3HI - DO JJ=X2LO,X2HI + ! MESHES(NM)%CUT_EDGE(CEI)%NVERT = FNVERT + ! MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:FNVERT) = & + ! XYZVERTF(IAXIS:KAXIS,1:FNVERT) + ! MESHES(NM)%CUT_EDGE(CEI)%NEDGE = FNEDGE + ! WRITE(LU_ERR,*) 'CUT_EDGE=',CEI,SIZE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM,DIM=2),FNEDGE + ! WRITE(LU_ERR,*) 'CEELEM=',SIZE(CEELEM,DIM=2) + ! MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:FNEDGE) = & + ! CEELEM(NOD1,IEDGE)) CYCLE:NOD2,1:FNEDGE) + ! MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:FNEDGE) = & + ! INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:FNEDGE) - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI = INDXI(XIAXIS) - INDJ = INDXI(XJAXIS) - INDK = INDXI(XKAXIS) + ENDIF + IJK_COUNTF(INDIF,INDJF,INDKF,X1AXIS)=.TRUE. - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE; IJK_COUNTED(INDI,INDJ,INDK,X1AXIS)=.TRUE. - IF(MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) == CC_SOLID) CYCLE + ENDIF + ENDDO + ENDDO - ! Drop if face not cut-face: - ! Test for FACE Cartesian edges being cut: - ! If outface1 is true -> All regular edges for this face: - ! Edge at index KK-1: - INDXI1(IAXIS:KAXIS) = (/ II, JJ, KK-1 /) ! Local x1,x2,x3 - INDI1 = INDXI1(XIAXIS) - INDJ1 = INDXI1(XJAXIS) - INDK1 = INDXI1(XKAXIS) - ! Edge at index KK: - INDXI2(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI2 = INDXI2(XIAXIS) - INDJ2 = INDXI2(XJAXIS) - INDK2 = INDXI2(XKAXIS) - ! Edge at index JJ-1: - INDXI3(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 - INDI3 = INDXI3(XIAXIS) - INDJ3 = INDXI3(XJAXIS) - INDK3 = INDXI3(XKAXIS) - ! Edge at index jj: - INDXI4(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI4 = INDXI4(XIAXIS) - INDJ4 = INDXI4(XJAXIS) - INDK4 = INDXI4(XKAXIS) + DEALLOCATE(BODINT_PLANE%X1NVEC,BODINT_PLANE%AINV) + ENDDO ! I + ENDDO ! J + ENDDO ! K - OUTFACE1 = (MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) /= CC_CUTCFE) + ! Deallocate local plane arrays: + DEALLOCATE(X1FACE,X2FACE,X3FACE,X2CELL,X3CELL) + DEALLOCATE(DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL) - ! Test for face with INB edges: - ! If outface2 is true -> no INB Edges associated with this face: - OUTFACE2 = (MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) <= 0) + ENDDO X1AXIS_LOOP +! ENDIF BNDINT_COND - ! Drop if outface1 & outface2 - IF (OUTFACE1 .AND. OUTFACE2) THEN - ! Test if face is SOLID: - IF ((MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) == CC_SOLID) ) THEN - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID - ENDIF - CYCLE - ENDIF +! Second: Loop over cut-cells: For cut-cell i,j,k,lb +! - From cut-cell Cartesian faces, figure out INBOUNDCF segments (CUT_EDGE) +! and the wet surface triangles related to them. +! - From CCVAR(I,J,K,CC_IDCE), figure out INBOUNDCC segments in CUT_EDGE +! and triangles they belong to. +! - Working by triangle -> reorient segments using triangle normal outside +! of body (no disjoint areas are expected) +! - Load into CUT_FACE <=> CCVAR(I,J,K,CC_IDCF). +IF (BNDINT_FLAG) THEN + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL +ELSE + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD +ENDIF +! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: +DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_CUTCFE + IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE - ! Build segment list: - NSEG = 0 - NVERT = 0 - NFACE = 0 + IF (CELLRT(I,J,K)) CYCLE ! Special cell with bod-bod or self intersection. - SEG_FACE (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED - XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) = 0._EB - ANGSEG(1:CC_MAXCEELEM_FACE) = 0._EB - BODNUM(1:CC_MAXCEELEM_FACE) = 1000000000 - SEGTYPE(1:CC_MAXCEELEM_FACE) = 0 + IF(IJK_COUNTED(I,J,K)) CYCLE; IJK_COUNTED(I,J,K)=.TRUE. + ! Face type of bounding Cartesian faces: + FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) + FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) + FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) + FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) + FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) + FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) - ! 1. Cartesian CC_GASPHASE edges, cut-edges: - ! a. Make a list of segments: - ! Low x2 cut-edges: - INDLC(IAXIS:KAXIS) = INDXI3(IAXIS:KAXIS) - IEDG=INDI3; JEDG=INDJ3; KEDG=INDK3 - CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X3AXIS) - IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: - IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X3AXIS) /= CC_SOLID) THEN - ! x,y,z of node 1: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + ! Start cut-cell INB cut-faces computation: + ! Loop local arrays to cell: + NSEG = 0 + SEG_CELL = CC_UNDEFINED - ! x,y,z of node 2: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)-1) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + NVERT = 0 + NFACE = 0 + XYZVERT = 0._EB - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, LOW_IND, X2AXIS /) - ANGSEG(NSEG) = - PI / 2._EB - ENDIF - ELSE ! Cut-edge, load CUT_EDGE(CEI) segments - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + ! CUT_EDGE index of bounding Cartesian faces: + CEIB_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCE,IAXIS) + CEIB_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCE,IAXIS) + CEIB_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCE,JAXIS) + CEIB_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCE,JAXIS) + CEIB_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCE,KAXIS) + CEIB_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCE,KAXIS) - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + ! Cartesian Faces INBOUNDARY segments: + DO FAXIS=IAXIS,KAXIS + DO ILH=LOW_IND,HIGH_IND + ! By segment: Add Vertices/Segments to local arrays: + CEI = CEIB_XYZ(ILH,FAXIS) + IF ( CEI > 0 ) THEN ! There are inboundary cut-edges + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + STRI(1:CC_MAX_WSTRIANG_SEG+2) = & + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) - ANGSEG(NSEG) = - PI / 2._EB - ENDDO - ENDIF + ! x,y,z of node 1: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD1,XYZVERT) + ! x,y,z of node 2: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD2,XYZVERT) - ! High x2 cut-edges: - INDLC(IAXIS:KAXIS) = INDXI4(IAXIS:KAXIS) - IEDG=INDI4; JEDG=INDJ4; KEDG=INDK4 - CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X3AXIS) - IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: - IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X3AXIS) /= CC_SOLID) THEN - ! x,y,z of node 1: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)-1) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + VEC(NOD1:NOD2) = (/ INOD1, INOD2 /) + VEC(NOD2+1:NOD2+CC_MAX_WSTRIANG_SEG+2) = STRI(1:CC_MAX_WSTRIANG_SEG+2) + VEC(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7) = (/ CC_ETYPE_CFINB, CEI, IEDGE /) + ! Insertion ADD segment: + INLIST = .FALSE. + DO IDUM = 1,NSEG + DO IEQ1=1,3 + EQUAL1 = SEG_CELL(INDVERTBOD(IEQ1),IDUM) == VEC(INDVERTBOD(IEQ1)) + IF (.NOT.EQUAL1) EXIT + ENDDO + DO IEQ2=1,3 + EQUAL2 = SEG_CELL(INDVERTBOD(IEQ2),IDUM) == VEC(INDVERTBOD2(IEQ2)) + IF (.NOT.EQUAL2) EXIT + ENDDO + IF ( EQUAL1 .OR. EQUAL2 ) THEN + IF ( SEG_CELL(3,IDUM) > VEC(3) ) THEN + ! DO NOTHING: + ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN + SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 + SEG_CELL(5,IDUM) = VEC(4) + ENDIF + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + NSEG = NSEG + 1 + CALL REALLOCATE_SEG_CELL + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + ENDIF + ENDDO + ENDIF + ENDDO + ENDDO - ! x,y,z of node 2: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + ! Cells INBOUNDARY segments: + CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCE) + IF ( CEI > 0 ) THEN ! There are inboundary cut-edges + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, HIGH_IND, X2AXIS /) - ANGSEG(NSEG) = PI / 2._EB - ENDIF - ELSE ! Cut-edge, load CUT_EDGE(CEI) segments - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + STRI(1:CC_MAX_WSTRIANG_SEG+2) = & + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + ! x,y,z of node 1: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD1,XYZVERT) + ! x,y,z of node 2: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD2,XYZVERT) - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + IF (INOD1 == INOD2) CYCLE - ! ADD segment: + VEC(NOD1:NOD2) = (/ INOD1, INOD2 /) + VEC(NOD2+1:NOD2+CC_MAX_WSTRIANG_SEG+2) = STRI(1:CC_MAX_WSTRIANG_SEG+2) + VEC(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7) = (/ CC_ETYPE_CFINB, CEI, IEDGE /) + ! Insertion ADD segment: + INLIST = .FALSE. + DO IDUM = 1,NSEG + DO IEQ1=1,3 + EQUAL1 = SEG_CELL(INDVERTBOD(IEQ1),IDUM) == VEC(INDVERTBOD(IEQ1)) + IF (.NOT.EQUAL1) EXIT + ENDDO + DO IEQ2=1,3 + EQUAL2 = SEG_CELL(INDVERTBOD(IEQ2),IDUM) == VEC(INDVERTBOD2(IEQ2)) + IF (.NOT.EQUAL2) EXIT + ENDDO + IF ( EQUAL1 .OR. EQUAL2 ) THEN + IF ( SEG_CELL(3,IDUM) > VEC(3) ) THEN + ! DO NOTHING: + ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN + SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 + SEG_CELL(5,IDUM) = VEC(4) + ENDIF + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) - ANGSEG(NSEG) = PI / 2._EB - ENDDO - ENDIF + CALL REALLOCATE_SEG_CELL + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + ENDIF + ENDDO + ENDIF - ! Low x3 cut-edges: - INDLC(IAXIS:KAXIS) = INDXI1(IAXIS:KAXIS) - IEDG=INDI1; JEDG=INDJ1; KEDG=INDK1 - CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X2AXIS) - IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: - IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X2AXIS) /= CC_SOLID) THEN - ! x,y,z of node 1: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)-1), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + ! Drop segments that are unconnected: + ALLOCATE(VERT_SEGS(1:NVERT)); VERT_SEGS(1:NVERT)=0 + DO IDUM = 1,NSEG + IF (SEG_CELL(NOD1,IDUM) == SEG_CELL(NOD2,IDUM)) CYCLE + VERT_SEGS(SEG_CELL(NOD1,IDUM)) = VERT_SEGS(SEG_CELL(NOD1,IDUM)) + 1 + VERT_SEGS(SEG_CELL(NOD2,IDUM)) = VERT_SEGS(SEG_CELL(NOD2,IDUM)) + 1 + ENDDO + ALLOCATE(SEG_CELL_AUX(SIZE(SEG_CELL,DIM=1),SIZE(SEG_CELL,DIM=2))) + SEG_CELL_AUX = SEG_CELL + COUNT = 0 + DO IDUM = 1,NSEG + IF ( (SEG_CELL_AUX(NOD1,IDUM) /= SEG_CELL_AUX(NOD2,IDUM)) .AND. & + (VERT_SEGS(SEG_CELL_AUX(NOD1,IDUM))>1) .AND. (VERT_SEGS(SEG_CELL_AUX(NOD2,IDUM))>1) ) THEN + COUNT = COUNT + 1 + SEG_CELL(:,COUNT) = SEG_CELL_AUX(:,IDUM) + CYCLE + ENDIF + ENDDO + NSEG = COUNT + DEALLOCATE(SEG_CELL_AUX,VERT_SEGS) - ! x,y,z of node 2: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + ! Now obtain body-triangle combinations present: + BOD_TRI = CC_UNDEFINED + NBODTRI = 0 + DO ISEG=1,NSEG - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, LOW_IND, X3AXIS /) - ANGSEG(NSEG) = 0._EB - ENDIF - ELSE ! Cut-edge, load CUT_EDGE(CEI) segments - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + ! First triangle location (Assume one body and at + ! most two triangs per seg). + INLIST = .FALSE. + DO IBODTRI=1,NBODTRI + IF ( (BOD_TRI(1,IBODTRI) == SEG_CELL(6,ISEG)) .AND. & + (BOD_TRI(2,IBODTRI) == SEG_CELL(4,ISEG)) ) THEN + ! Body/triang already on list. + INLIST = .TRUE. + CYCLE + ENDIF + enddo + IF (.NOT.INLIST) THEN + ! Add first triang to list: + NBODTRI = NBODTRI + 1 + BOD_TRI(1:2,NBODTRI) = SEG_CELL( (/ 6, 4 /) , ISEG) + ENDIF - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + ! No second triangle associated: + IF ( SEG_CELL(3,ISEG) < 2 ) CYCLE - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + ! Second triangle location + INLIST = .FALSE. + DO IBODTRI=1,NBODTRI + IF ( (BOD_TRI(1,IBODTRI) == SEG_CELL(6,ISEG)) .AND. & + (BOD_TRI(2,IBODTRI) == SEG_CELL(5,ISEG)) ) THEN + ! Body/triang already on list. + INLIST = .TRUE. + CYCLE + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + ! Add first triang to list: + NBODTRI = NBODTRI + 1 + BOD_TRI(1:2,NBODTRI) = SEG_CELL( (/ 6, 5 /) , ISEG) + ENDIF + ENDDO ! ISEG. - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) - ANGSEG(NSEG) = 0._EB - ENDDO - ENDIF + ! Do Test for cycling when all body-triangle combinations produce two or less segments: + SEG_FLAG(1)=.TRUE. + DO ICF=1,NBODTRI + IBOD = BOD_TRI(1,ICF) + ITRI = BOD_TRI(2,ICF) + NSEG_FACE = 0 + DO ISEG=1,NSEG + IF ((SEG_CELL(6,ISEG) == IBOD) .AND. & + ((SEG_CELL(4,ISEG) == ITRI) .OR. (SEG_CELL(5,ISEG) == ITRI)) ) THEN + NSEG_FACE = NSEG_FACE + 1 + ENDIF + ENDDO + ! If only one or two seg => continue: + IF ( NSEG_FACE <= 2 ) CYCLE + SEG_FLAG(1)=.FALSE. + EXIT + ENDDO + IF (SEG_FLAG(1)) CYCLE ! CYCLES I,J,K loop. - ! High x3 cut-edges: - INDLC(IAXIS:KAXIS) = INDXI2(IAXIS:KAXIS) - IEDG=INDI2; JEDG=INDJ2; KEDG=INDK2 - CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X2AXIS) - IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: - IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X2AXIS) /= CC_SOLID) THEN - ! x,y,z of node 1: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + ! This is a cut-face, allocate space: + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (BNDINT_FLAG) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF + MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE - ! x,y,z of node 2: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)-1), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, 0 /) ! No axis = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_INBOUNDARY + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NBODTRI,CC_MAXVERT_CUTFACE) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) + ALLOCATE(CF%EDGE_LIST(3,NSEG)) + CF%EDGE_LIST(1:3,1:NSEG) = SEG_CELL(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7,1:NSEG) + ALLOCATE(CF%CEDGES(SIZE(CF%CFELEM,DIM=1),SIZE(CF%CFELEM,DIM=2))); CF%CEDGES = CC_UNDEFINED - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, HIGH_IND, X3AXIS /) - ANGSEG(NSEG) = PI - ENDIF - ELSE ! Cut-edge, load CUT_EDGE(CEI) segments - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + ! Running by body-triangle combination, define list of + ! segments that belong to each pair. + ICF_LOOP : DO ICF=1,NBODTRI - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + IBOD = BOD_TRI(1,ICF) + ITRI = BOD_TRI(2,ICF) - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + SEG_FACE = CC_UNDEFINED + NSEG_FACE = 0 + DO ISEG=1,NSEG + IF ((SEG_CELL(6,ISEG) == IBOD) .AND. & + ((SEG_CELL(4,ISEG) == ITRI) .OR. (SEG_CELL(5,ISEG) == ITRI)) ) THEN + NSEG_FACE = NSEG_FACE + 1 + SEG_FACE(NOD1:NOD2+1,NSEG_FACE) = (/ SEG_CELL(NOD1:NOD2,ISEG), ISEG /) + ENDIF + ENDDO - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) - ANGSEG(NSEG) = PI - ENDDO - ENDIF + ! If only one or two seg => continue: + IF ( NSEG_FACE <= 2 ) CYCLE - ! Store Segment and Vertex list from Cartesian face boundary: - XYZVERT_CART(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - SEG_FACE_CART(NOD1:NOD2+3,1:NSEG) = SEG_FACE(NOD1:NOD2+3,1:NSEG) - NVERT_CART=NVERT; NSEG_CART = NSEG + ! Now build sequential list of segments: + SEG_FACE2 = CC_UNDEFINED !zeros(nseg_face,2); %[nod1 nod2] + SEG_FLAG = .TRUE. !ones(1,nseg_face); + ISEG_FACE = 1 + COUNTR = 1 + CTSTART = COUNTR + SEG_FACE2(NOD1:NOD2+1,COUNTR) = SEG_FACE(NOD1:NOD2+1,ISEG_FACE) + SEG_FLAG(ISEG_FACE) = .FALSE. + NSEG_LEFT = NSEG_FACE - 1 + CTR = 0 + CYCLE_CELL= .FALSE. + ! Infinite Loop: + INF_LOOP : DO + DO ISEG_FACE=1,NSEG_FACE - ! 2. CC_INBOUNDARY cut-edges assigned to this face: - CEI = MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) - IF ( CEI > 0 ) THEN ! There are inboundary cut-edges - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + IF (SEG_FLAG(ISEG_FACE)) THEN ! This seg hasn't been added to seg_face2 + ! Test for common node: + IF ( SEG_FACE2(NOD2,COUNTR) == SEG_FACE(NOD1,ISEG_FACE) ) THEN + COUNTR = COUNTR + 1 + SEG_FACE2(NOD1:NOD2+1,COUNTR) = SEG_FACE(NOD1:NOD2+1,ISEG_FACE) + SEG_FLAG(ISEG_FACE) = .FALSE. + NSEG_LEFT = NSEG_LEFT - 1 + EXIT + ELSEIF ( SEG_FACE2(NOD2,COUNTR) == SEG_FACE(NOD2,ISEG_FACE) ) THEN - IBOD = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) - STYPE = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(5,IEDGE) + IF ( SEG_FACE2(NOD1,COUNTR) == SEG_FACE(NOD1,ISEG_FACE) ) & + PRINT*, "Building INBOUND faces, repeated index." + COUNTR = COUNTR + 1 + SEG_FACE2(NOD1:NOD2+1,COUNTR) = SEG_FACE( (/ NOD2, NOD1, NOD2+1 /) ,ISEG_FACE) + SEG_FLAG(ISEG_FACE) = .FALSE. + NSEG_LEFT = NSEG_LEFT - 1 + EXIT + ENDIF + ENDIF + ENDDO + ! Break loop: + IF ( NSEG_LEFT == 0 ) EXIT + CTR = CTR + 1 - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + ! Plot cell and cut-faces if there is no convergence: + IF ( CTR > NSEG_FACE**3 ) THEN + CYCLE_CELL = .TRUE. + MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 + NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) + IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN + ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) + DEALLOCATE(MESHES(NM)%SPCELL_LIST) + ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED + DEALLOCATE(SPCELL_LIST) + ENDIF + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) + EXIT INF_LOOP - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + IF (DEBUG_SET_CUTCELLS) THEN + WRITE(LU_ERR,*) "Error GET_CARTCELL_CUTFACES: ctr > nseg_face^3 ,",BNDINT_FLAG,I,J,K,NCUTFACE,& + CF%NFACE + WRITE(LU_ERR,*) "Cannot build boundary cut faces in cell (NM,I,J,K):",NM,I,J,K + WRITE(LU_ERR,*) "Located in position:",XCELL(I),YCELL(J),ZCELL(K) + WRITE(LU_ERR,*) "Check for Geometry surface inconsistencies at said location." + WRITE(LU_ERR,*) 'Cartesian CELL:',BNDINT_FLAG,MESHES(NM)%CCVAR(I,J,K,CC_CGSC),CC_CUTCFE,I,J,K + LU_DB_SETCC = GET_FILE_NUMBER() + OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_cutfaces.dat", STATUS='REPLACE') + ! Info pertaining to the Cartesian Cell: + WRITE(LU_DB_SETCC,*) 'I,J,K:' + WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS + WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' + WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) ! MESHES(NM)%XC(I),MESHES(NM)%DX(I) + WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) ! MESHES(NM)%YC(J),MESHES(NM)%DY(J) + WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) ! MESHES(NM)%ZC(K),MESHES(NM)%DZ(K) + WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT:' + WRITE(LU_DB_SETCC,*) NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT + WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' + DO IDUM=1,NVERT + WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) + ENDDO + WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' + DO IDUM=1,NSEG + WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(NOD1:NOD2,IDUM),SEG_CELL(3:6,IDUM) + ENDDO + WRITE(LU_DB_SETCC,*) 'SEG_FACE(NOD1:NOD2,1:NSEG_FACE):' + DO IDUM=1,NSEG_FACE + WRITE(LU_DB_SETCC,*) IDUM,SEG_FACE(NOD1:NOD2,IDUM) + ENDDO + WRITE(LU_DB_SETCC,*) 'SEG_FACE2(NOD1:NOD21:COUNTR):' + DO IDUM=1,COUNTR + WRITE(33,*) IDUM,SEG_FACE2(NOD1:NOD2,IDUM) + ENDDO + WRITE(LU_DB_SETCC,*) 'ICF,BOD_TRI:' + WRITE(LU_DB_SETCC,*) ICF,NBODTRI + DO IDUM=1,NBODTRI + WRITE(LU_DB_SETCC,*) BOD_TRI(1:2,IDUM) + ENDDO + CLOSE(LU_DB_SETCC) + CALL DEBUG_WAIT + ENDIF - ! ADD segment: - VEC(NOD1:NOD2) = (/ INOD1, INOD2 /) - ! Insertion ADD segment: - INLIST =.FALSE. - DO IDUM = 1,NSEG - IF ( (SEG_FACE(NOD1,IDUM)==VEC(NOD1)) .AND. (SEG_FACE(NOD2,IDUM)==VEC(NOD2)) ) THEN - IF ( (STYPE >= SEGTYPE(IDUM)) .AND. (BODNUM(IDUM) > IBOD) ) THEN - BODNUM(IDUM) = IBOD - SEGTYPE(IDUM)=STYPE - ENDIF - INLIST =.TRUE. - EXIT - ENDIF - IF ( (SEG_FACE(NOD2,IDUM)==VEC(NOD1)) .AND. (SEG_FACE(NOD1,IDUM)==VEC(NOD2)) ) THEN - IF ( (STYPE >= SEGTYPE(IDUM)) .AND. (BODNUM(IDUM) > IBOD) ) THEN - SEG_FACE(NOD1:NOD2,IDUM) = VEC(NOD1:NOD2) - BODNUM(IDUM) = IBOD - SEGTYPE(IDUM) =STYPE - ENDIF - INLIST =.TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ VEC(NOD1:NOD2), CC_ETYPE_CFINB, CEI, IEDGE /) - BODNUM(NSEG) = IBOD - SEGTYPE(NSEG) = STYPE - DX3 = XYZVERT(X3AXIS,INOD2)-XYZVERT(X3AXIS,INOD1) - DX2 = XYZVERT(X2AXIS,INOD2)-XYZVERT(X2AXIS,INOD1) - ANGSEG(NSEG) = ATAN2(DX3,DX2) - ENDIF - ENDDO - ENDIF + ENDIF + ENDDO INF_LOOP + IF (CYCLE_CELL) EXIT ICF_LOOP - ! IF(INDI==14 .AND. INDJ==2 .AND. INDK==5 .AND. X1AXIS==KAXIS) THEN - ! OPEN(666,FILE='VERTS_FC0.txt',STATUS='REPLACE') - ! DO IDUM=1,NVERT - ! WRITE(666,*) XYZVERT(1:3,IDUM) - ! ENDDO - ! CLOSE(666) - ! OPEN(666,FILE='SEGS_FC0.txt',STATUS='REPLACE') - ! DO ISEG=1,NSEG - ! WRITE(666,*) SEG_FACE(NOD1:NOD2,ISEG),ANGSEG(ISEG),SEGTYPE(ISEG) - ! ENDDO - ! CLOSE(666) - ! ENDIF + IF ( COUNTR /= NSEG_FACE) & + PRINT*, "Building INBOUND faces: ~isequal(countr,nseg)" - NOTDONE = .TRUE. - DO WHILE(NOTDONE) - NOTDONE = .FALSE. - ! Counts edges that reach nodes: - NUMEDG_NODE(1:CC_MAXVERTS_FACE) = 0 - DO ISEG=1,NSEG - DO II2=NOD1,NOD2 - INOD = SEG_FACE(II2,ISEG) - NUMEDG_NODE(INOD) = NUMEDG_NODE(INOD) + 1 - ENDDO - ENDDO + ! Using triangles normal, reorder nodes as in right hand rule. + NORMTRI(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,ITRI) - ! Drop segments with NUMEDG_NODE(INOD)=1: - ! The assumption here is that they are CC_GG CC_INBOUNDCF - ! segments with one node inside the Cartface i.e. case Fig - ! 9(a) in the CompGeom3D notes): - COUNT = 0 - SEG_FACEAUX (NOD1:NOD2+3,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED - ANGSEGAUX(1:CC_MAXCEELEM_FACE) = 0._EB - SEGTYPEAUX(1:CC_MAXCEELEM_FACE) = CC_UNDEFINED - DO ISEG=1,NSEG - NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) - NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) - IF ((NUMNOD1 > 1) .AND. (NUMNOD2 > 1)) THEN - COUNT = COUNT + 1 - SEG_FACEAUX(NOD1:NOD2+3,COUNT) = SEG_FACE(NOD1:NOD2+3,ISEG) - ANGSEGAUX(COUNT) = ANGSEG(ISEG) - SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) - ELSE - NOTDONE = .TRUE. - ENDIF - ENDDO - NSEG = COUNT - SEG_FACE = SEG_FACEAUX - ANGSEG = ANGSEGAUX - SEGTYPE = SEGTYPEAUX - ENDDO + ! First test if INB face is on Cartesian face and pointing + ! outside of Cartesian cell. If so drop: + ! Get min max in face for VERTS x,y,z: + XMIN(IAXIS:KAXIS)= 1._EB/TWENTY_EPSILON_EB + XMAX(IAXIS:KAXIS)=-1._EB/TWENTY_EPSILON_EB + DO ISEG_FACE=1,NSEG_FACE + XMIN(IAXIS) = MIN(XMIN(IAXIS), XYZVERT(IAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + XMIN(JAXIS) = MIN(XMIN(JAXIS), XYZVERT(JAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + XMIN(KAXIS) = MIN(XMIN(KAXIS), XYZVERT(KAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + XMAX(IAXIS) = MAX(XMAX(IAXIS), XYZVERT(IAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + XMAX(JAXIS) = MAX(XMAX(JAXIS), XYZVERT(JAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + XMAX(KAXIS) = MAX(XMAX(KAXIS), XYZVERT(KAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + ENDDO + ! IAXIS: + IF ( (ABS(NORMTRI(IAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(XFACE(I-1)-XMIN(IAXIS)) < GEOMEPS) .AND. & + (ABS(XFACE(I-1)-XMAX(IAXIS)) < GEOMEPS)) CYCLE ! Low Face + IF ( (ABS(NORMTRI(IAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(XFACE(I )-XMIN(IAXIS)) < GEOMEPS) .AND. & + (ABS(XFACE(I )-XMAX(IAXIS)) < GEOMEPS)) CYCLE ! High Face + ! JAXIS: + IF ( (ABS(NORMTRI(JAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(YFACE(J-1)-XMIN(JAXIS)) < GEOMEPS) .AND. & + (ABS(YFACE(J-1)-XMAX(JAXIS)) < GEOMEPS)) CYCLE ! Low Face + IF ( (ABS(NORMTRI(JAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(YFACE(J )-XMIN(JAXIS)) < GEOMEPS) .AND. & + (ABS(YFACE(J )-XMAX(JAXIS)) < GEOMEPS)) CYCLE ! High Face + ! KAXIS: + IF ( (ABS(NORMTRI(KAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(ZFACE(K-1)-XMIN(KAXIS)) < GEOMEPS) .AND. & + (ABS(ZFACE(K-1)-XMAX(KAXIS)) < GEOMEPS)) CYCLE ! Low Face + IF ( (ABS(NORMTRI(KAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(ZFACE(K )-XMIN(KAXIS)) < GEOMEPS) .AND. & + (ABS(ZFACE(K )-XMAX(KAXIS)) < GEOMEPS)) CYCLE ! High Face - ! Discard face with no conected edges: - IF ( (NSEG==0) .OR. (NSEG==2 .AND. ( ANY(SEG_FACE(NOD1:NOD2,1)==SEG_FACE(NOD2,2)) .AND. & - ANY(SEG_FACE(NOD1:NOD2,1)==SEG_FACE(NOD1,2)) )) ) THEN - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID - CYCLE - ENDIF + ! Face Vertices average location: + XCEN(IAXIS:KAXIS) = 0._EB + DO ISEG_FACE=1,NSEG_FACE + XCEN(IAXIS:KAXIS) = XCEN(IAXIS:KAXIS) + XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE)) + ENDDO + XCEN(IAXIS:KAXIS) = XCEN(IAXIS:KAXIS) / REAL(NSEG_FACE,EB) - ! Add segments which have both ends attached to more than two segs: - count = 0 - DO ISEG=1,NSEG - COUNT = COUNT + 1 - SEG_FACEAUX (NOD1:NOD2+3,COUNT) = SEG_FACE(NOD1:NOD2+3,ISEG) - ANGSEGAUX(COUNT) = ANGSEG(ISEG) - !SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) - IF (SEGTYPE(ISEG)==1) THEN - COUNT = COUNT + 1 - SEG_FACEAUX (NOD1:NOD2+3,COUNT) = SEG_FACE( (/ NOD2, NOD1, 3, 4, 5 /),ISEG) - !SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) - IF (ANGSEG(ISEG) > 0._EB) THEN - ANGSEGAUX(COUNT) = ANGSEG(ISEG) - PI - ELSE - ANGSEGAUX(COUNT) = ANGSEG(ISEG) + PI - ENDIF - ENDIF - ENDDO - NSEG = COUNT - SEG_FACE = SEG_FACEAUX - ANGSEG = ANGSEGAUX - !SEGTYPE = SEGTYPEAUX + ISEG_FACE = 1 + VC1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE )) - XCEN(IAXIS:KAXIS) + V12(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE+1)) - & + XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE )) - ! Fill NODEDG_FACE(IEDGE,INOD), where iedge are edges - ! that contain inod as first node. This assumes edges are - ! ordered using the right hand rule on x2-x3 plane. - ! Also compute the edges angles in x2-x3 plane: - ! Reallocate NODEDG_FACE if NSEG+1 > SIZE_EDGES_NODEDG, or NVERT > SIZE_VERTS_NODEDG: - CALL REALLOCATE_NODEDG_FACE(NSEG,NVERT) - NODEDG_FACE(:,:) = 0 - DO ISEG=1,NSEG - INOD1 = SEG_FACE(NOD1,ISEG) - NEDI = NODEDG_FACE(1,INOD1) + 1 ! Increase number of edges connected to node by 1. - NODEDG_FACE( 1,INOD1) = NEDI - NODEDG_FACE(NEDI+1,INOD1) = ISEG - ENDDO + CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) + CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) + CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) - ! Now Reorder Segments, do tests: - SEG_FACE2(NOD1:NOD3+1,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED ! [INOD1 INOD2 ICF] - SEG_FLAG(1:CC_MAXCEELEM_FACE) = .TRUE. + RH_ORIENTED = ( NORMTRI(IAXIS)*CROSSV(IAXIS) + & + NORMTRI(JAXIS)*CROSSV(JAXIS) + & + NORMTRI(KAXIS)*CROSSV(KAXIS) ) > 0._EB - ICF = 1 - ISEG = 1 - NEWSEG = ISEG - COUNT= 1 - CTSTART=COUNT - SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG), SEG_FACE(NOD2,NEWSEG), ICF, NEWSEG /) - SEG_FLAG(ISEG) = .FALSE. - NSEG_LEFT = NSEG - 1 + NP = NSEG_FACE + NCF = CF%NFACE + 1 + NVSIZE=SIZE(CF%CFELEM,DIM=1) + IF(NP+1 > NVSIZE) THEN + ALLOCATE(CFELEM(1:NP+1+DELTA_VERT,1:NBODTRI)); CFELEM = CC_UNDEFINED + CFELEM(1:NVSIZE,1:NBODTRI) = CF%CFELEM(1:NVSIZE,1:NBODTRI) + CALL MOVE_ALLOC(FROM=CFELEM,TO=CF%CFELEM) + ALLOCATE(CFELEM(1:NP+1+DELTA_VERT,1:NBODTRI)); CFELEM = CC_UNDEFINED + CFELEM(1:NVSIZE,1:NBODTRI) = CF%CEDGES(1:NVSIZE,1:NBODTRI) + CALL MOVE_ALLOC(FROM=CFELEM,TO=CF%CEDGES) + ENDIF + CF%CFELEM(1,NCF) = NP; CF%CEDGES(1,NCF) = NP + IF (RH_ORIENTED) THEN + DO IDUM=1,NP + CF%CFELEM(IDUM+1,NCF) = SEG_FACE2(NOD1 ,IDUM) + CF%CEDGES(IDUM+1,NCF) = SEG_FACE2(NOD2+1,IDUM) ! Segment index in SEG_CELL/EDGE_LIST + ENDDO + ELSE + DO IDUM=1,NP + CF%CFELEM(IDUM+1,NCF) = SEG_FACE2(NOD1 ,NP+1-IDUM) + CF%CEDGES(IDUM+1,NCF) = SEG_FACE2(NOD2+1,NP+1-IDUM) ! Segment index in SEG_CELL/EDGE_LIST + ENDDO + IDUM = CF%CEDGES(2,NCF) + CF%CEDGES(2:NP,NCF) = CF%CEDGES(3:NP+1,NCF); CF%CEDGES(NP+1,NCF) = IDUM + ENDIF + CF%NFACE = NCF - ! Infamous infinite loop: - INF_LOOP : DO + ! Compute Sections area and centroid: + AREA = 0._EB + ACEN(IAXIS:KAXIS) = 0._EB + INXAREA = 0._EB + SQAREA(IAXIS:KAXIS) = 0._EB + DO ISEG_FACE=1,NSEG_FACE-1 - FOUNDSEG = .FALSE. - N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. - ANGCOUNT = ANGSEG(NEWSEG) + IDUM = CF%CFELEM(1+ISEG_FACE,NCF) + X1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) + IDUM = CF%CFELEM(2+ISEG_FACE,NCF) + X2(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) + VC1(IAXIS:KAXIS) = X1(IAXIS:KAXIS) - XCEN(IAXIS:KAXIS) + V12(IAXIS:KAXIS) = X2(IAXIS:KAXIS) - X1(IAXIS:KAXIS) + XCENI(IAXIS:KAXIS) = (XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) / 3._EB - ! Find Segment starting on Node 2 with smaller ANGSEG respect to COUNT. - DANG = -1._EB / GEOMEPS - DO ISS=2,NODEDG_FACE(1,N2COUNT)+1 - ISEG = NODEDG_FACE(ISS,N2COUNT) - IF ( SEG_FLAG(ISEG) ) THEN ! This seg hasn't been added to SEG_FACE2 - ! Drop if seg is the opposite of count seg, only when 2nd node is connected to more than 2 segments: - IF ( (SEG_FACE2(NOD1,COUNT)==SEG_FACE(NOD2,ISEG)) .AND. (NUMEDG_NODE(N2COUNT)>2) ) CYCLE - DANGI = ANGSEG(ISEG) - ANGCOUNT - IF ( DANGI < 0._EB ) DANGI = DANGI + 2._EB * PI - IF ( DANGI > DANG ) THEN - NEWSEG = ISEG - DANG = DANGI - FOUNDSEG = .TRUE. - ENDIF - ENDIF - ENDDO + CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) + CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) + CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) - ! Found a seg add to SEG_FACE2: - IF ( FOUNDSEG ) THEN - COUNT = COUNT + 1 - SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG),SEG_FACE(NOD2,NEWSEG),ICF,NEWSEG /) - SEG_FLAG(NEWSEG) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - ENDIF + AREAI = 0.5_EB * SQRT( CROSSV(IAXIS)**2._EB + CROSSV(JAXIS)**2._EB + CROSSV(KAXIS)**2._EB ) + AREA = AREA + AREAI + ACEN(IAXIS:KAXIS) = ACEN(IAXIS:KAXIS) + AREAI * XCENI(IAXIS:KAXIS) + ! volume computation variables: + XC1(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS)) + XC2(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) + X12(IAXIS:KAXIS) = 0.5_EB*( X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) + ! dot(i,nc) int(x)dA + INXAREA = INXAREA + NORMTRI(IAXIS)*XCENI(IAXIS)*AREAI ! Single Gauss pt integration. + ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA + DO IX=IAXIS,KAXIS + INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB + SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREAI ! Midpoint rule. + ENDDO + ENDDO + ! Final seg: + IDUM = CF%CFELEM(1+NSEG_FACE,NCF) + X1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) + IDUM = CF%CFELEM(1+1 ,NCF) + X2(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) - ! Test if line has closed on point shared any other cutface: - IF ( SEG_FACE2(NOD2,COUNT) == SEG_FACE2(NOD1,CTSTART) ) THEN - ! Go for new cut-face on this Cartesian face. - ELSEIF ( FOUNDSEG ) THEN - CYCLE - ENDIF + VC1(IAXIS:KAXIS) = X1(IAXIS:KAXIS) - XCEN(IAXIS:KAXIS) + V12(IAXIS:KAXIS) = X2(IAXIS:KAXIS) - X1(IAXIS:KAXIS) + XCENI(IAXIS:KAXIS) = (XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) / 3._EB - ! Break loop: - IF ( NSEG_LEFT == 0 ) EXIT + CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) + CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) + CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) - ! Start a new cut-face on this Cartesian face: - ICF = ICF + 1 - DO ISEG=1,NSEG - IF ( SEG_FLAG(ISEG) ) THEN - COUNT = COUNT + 1 - CTSTART= COUNT - SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,ISEG), SEG_FACE(NOD2,ISEG), ICF, ISEG /) - SEG_FLAG(ISEG) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - EXIT - ENDIF - ENDDO + AREAI = 0.5_EB * SQRT( CROSSV(IAXIS)**2._EB + CROSSV(JAXIS)**2._EB + CROSSV(KAXIS)**2._EB ) + AREA = AREA + AREAI + ACEN(IAXIS:KAXIS) = (ACEN(IAXIS:KAXIS) + AREAI * XCENI(IAXIS:KAXIS))/AREA + ! volume computation variables: + XC1(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS)) + XC2(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) + X12(IAXIS:KAXIS) = 0.5_EB*( X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) + ! dot(i,nc) int(x)dA + INXAREA = INXAREA + NORMTRI(IAXIS)*XCENI(IAXIS)*AREAI ! Single Gauss pt integration. + ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA + DO IX=IAXIS,KAXIS + INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB + SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREAI ! Midpoint rule. + ENDDO + CF%AREA(NCF) = AREA + CF%XYZCEN(IAXIS:KAXIS,NCF) = ACEN(IAXIS:KAXIS) + ! Fields for cut-cell volume/centroid computation: + CF%INXAREA(NCF) = INXAREA ! dot(i,nc)*int(x)dA + CF%INXSQAREA(NCF) = SQAREA(IAXIS) ! dot(i,nc)*int(x^2)dA + CF%JNYSQAREA(NCF) = SQAREA(JAXIS) ! dot(j,nc)*int(y^2)dA + CF%KNZSQAREA(NCF) = SQAREA(KAXIS) ! dot(k,nc)*int(z^2)dA + ! Define Body-triangle reference: + CF%BODTRI(1:2,NCF)= (/ IBOD, ITRI /) + ! Assign surf-index: Depending on GEOMETRY: + CF%SURF_INDEX(NCF) = GEOMETRY(IBOD)%SURFS(ITRI) + + ENDDO ICF_LOOP + + ! IF((NM==3 .AND. I==4 .AND. J==6 .AND. K==36)) THEN + ! LU_DB_SETCC = GET_FILE_NUMBER() + ! WRITE(LU_ERR,*) 'Writing Cartcell_cutfaces.dat... 11111' + ! OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_cutfaces.dat", STATUS='REPLACE') + ! ! Info pertaining to the Cartesian Cell: + ! WRITE(LU_DB_SETCC,*) 'I,J,K:',CF%NFACE + ! WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS + ! WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' + ! WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) ! MESHES(NM)%XC(I),MESHES(NM)%DX(I) + ! WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) ! MESHES(NM)%YC(J),MESHES(NM)%DY(J) + ! WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) ! MESHES(NM)%ZC(K),MESHES(NM)%DZ(K) + ! WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT:' + ! WRITE(LU_DB_SETCC,*) NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT,CF%NFACE + ! WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' + ! DO IDUM=1,NVERT + ! WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' + ! DO IDUM=1,NSEG + ! WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(NOD1:NOD2,IDUM),SEG_CELL(3:6,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'ICF,BOD_TRI:' + ! WRITE(LU_DB_SETCC,*) ICF,NBODTRI + ! DO IDUM=1,NBODTRI + ! WRITE(LU_DB_SETCC,*) BOD_TRI(1:2,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'CFELEM:' + ! DO IDUM=1,CF%NFACE + ! WRITE(LU_DB_SETCC,*) IDUM,CF%CFELEM(1:CF%CFELEM(1,IDUM)+1,IDUM) + ! ENDDO + ! CLOSE(LU_DB_SETCC) + ! ENDIF - ENDDO INF_LOOP + ! IF(.NOT.CYCLE_CELL) THEN + ! DO ICF = 1, CF%NFACE + ! DO ISEG=1,CF%CEDGES(1,ICF) + ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) + ! IF (ISEGGEOMEPS) THEN + ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT + ! ENDIF + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN + ! WRITE(LU_ERR,*) 'CARTC Found difference in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC,CYCLE_CELL + ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) + ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) + ! ENDIF + ! END SELECT + ! ENDDO + ! ENDDO + ! ENDIF + ! WRITE(LU_ERR,*) 'CORRECT CELL I,J,K CUT_FACES',I,J,K,CF%NFACE,NSEG,RH_ORIENTED + ! DO ICF = 1, CF%NFACE + ! WRITE(LU_ERR,*) CF%CEDGES(1:CF%CEDGES(1,ICF)+1,ICF),':',CF%CFELEM(2:CF%CFELEM(1,ICF)+1,ICF) + ! ITRI = CF%EDGE_LIST(2,CF%CEDGES(2,ICF)); IBOD = CF%EDGE_LIST(3,CF%CEDGES(2,ICF)) + ! WRITE(LU_ERR,*) 'E1 N1=',MESHES(NM)%CUT_EDGE(ITRI)%XYZVERT(:,MESHES(NM)%CUT_EDGE(ITRI)%CEELEM(1,IBOD)),& + ! CF%XYZVERT(:,CF%CFELEM(2,ICF)) + ! ITRI = CF%EDGE_LIST(2,CF%CEDGES(2,ICF)); IBOD = CF%EDGE_LIST(3,CF%CEDGES(2,ICF)) + ! WRITE(LU_ERR,*) 'E1 N2=',MESHES(NM)%CUT_EDGE(ITRI)%XYZVERT(:,MESHES(NM)%CUT_EDGE(ITRI)%CEELEM(2,IBOD)),& + ! CF%XYZVERT(:,CF%CFELEM(3,ICF)) + ! ENDDO + ! DO ICF = 1, NSEG + ! WRITE(LU_ERR,*) ICF,CF%EDGE_LIST(1:3,ICF) + ! ENDDO - ! Load ordered nodes to CFELEM: - NFACE = ICF - ! Reallocate CFELEM ARRAY if necessary: - CALL REALLOCATE_LOCAL_CFELEM(NSEG,NFACE) - CFELEM(:,:) = CC_UNDEFINED; CEDGES(:,:) = CC_UNDEFINED - DO ICF=1,NFACE - NP = 0 - DO ISEG=1,NSEG - IF ( SEG_FACE2(NOD3,ISEG) == ICF ) THEN - NP = NP + 1 - CFELEM(1,ICF) = NP - CFELEM(NP+1,ICF) = SEG_FACE2(NOD1,ISEG) - CEDGES(1,ICF) = CFELEM(1,ICF); CEDGES(NP+1,ICF) = SEG_FACE2(NOD3+1,ISEG) ! Index in SEG_FACE. - ENDIF - ENDDO - ENDDO + ! Here if CFACES could not be built, flag the cell as SPECIAL & reduce NCUTFACE by one: + IF (CYCLE_CELL) THEN + CELLRT(I,J,K) =.TRUE. + IJK_COUNTED(I,J,K)=.FALSE. + MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED; + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = 0 ! No axis = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_UNDEFINED + CALL FACE_DEALLOC(NM,NCUTFACE) + ! This is a cut-face, allocate space: + NCUTFACE = NCUTFACE-1 + IF (BNDINT_FLAG) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH - 1 + ENDIF + ! Now cleanup CUT_EDGES that live on this cell: This space will be used later when trying to linearize the + ! surface. + CEI=MESHES(NM)%CCVAR(I,J,K,CC_IDCE); + IF ( CEI > 0 ) THEN + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + MESHES(NM)%CUT_EDGE(CEI)%INDSEG = 0 + ENDIF + ENDIF - ALLOCATE(CFELEM2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CFELEM2 = CC_UNDEFINED - ALLOCATE(CEDGES2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CEDGES2 = CC_UNDEFINED - NP=0 - DO ICF=1,NFACE - IF(CFELEM(1,ICF)>2) THEN - NP=NP+1 - CFELEM2(:,NP) = CFELEM(:,ICF) - CEDGES2(:,NP) = CEDGES(:,ICF) - ENDIF - ENDDO - CALL MOVE_ALLOC(FROM=CFELEM2,TO=CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES2,TO=CEDGES) - NFACE = NP + ENDDO ! I + ENDDO ! J +ENDDO ! K - ! Compute area and Centroid, in local x1, x2, x3 coords: - ALLOCATE(DROPFACE(1:NFACE)); DROPFACE=.FALSE. - AREAV(1:NFACE) = 0._EB - XYZCEN(IAXIS:KAXIS,1:NFACE) = 0._EB - INXAREA(IAXIS:KAXIS,1:NFACE) = 0._EB - INXSQAREA(IAXIS:KAXIS,1:NFACE) = 0._EB - DO ICF=1,NFACE - NP = CFELEM(1,ICF) - DO IPT=2,NP+1 - ICF_PT = CFELEM(IPT,ICF) - ! Define closed Polygon centered in First Point: - XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & - XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) - ENDDO - ICF_PT = CFELEM(2,ICF) - XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & - XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) +! Now process special cells of type CELLRT=T: +! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: +DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI - ! Get Area and Centroid properties of Cut-face: - AREA = 0._EB - DO II2=1,NP - AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & - XY(JAXIS,II2) * XY(IAXIS,II2+1) ) - ENDDO - AREA = AREA / 2._EB - IF ( (AREA dot(e2,nc)=0: - INXSQAREA(JAXIS,ICF) = 0._EB - ! dot(e3,nc)*int(x3^2)dA, where nc=e1 => dot(e3,nc)=0: - INXSQAREA(KAXIS,ICF) = 0._EB + ! Start cut-cell INB cut-faces computation: + ! Loop local arrays to cell: + NSEG = 0 + SEG_CELL = CC_UNDEFINED - ENDDO + NVERT = 0 + NFACE = 0 + XYZVERT = 0._EB - ALLOCATE(CFELEM2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CFELEM2 = CC_UNDEFINED - ALLOCATE(CEDGES2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CEDGES2 = CC_UNDEFINED - NP=0 - DO ICF=1,NFACE - IF(.NOT.DROPFACE(ICF)) THEN - NP=NP+1 - CFELEM2(:,NP) = CFELEM(:,ICF) - CEDGES2(:,NP) = CEDGES(:,ICF) - ENDIF - ENDDO - CALL MOVE_ALLOC(FROM=CFELEM2,TO=CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES2,TO=CEDGES) - DEALLOCATE(DROPFACE) - IF (NP==0) THEN - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID - CYCLE - ENDIF - NFACE = NP + ! CUT_EDGE index of bounding Cartesian faces: + CEIB_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCE,IAXIS) + CEIB_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCE,IAXIS) + CEIB_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCE,JAXIS) + CEIB_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCE,JAXIS) + CEIB_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCE,KAXIS) + CEIB_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCE,KAXIS) - ! Figure out if a cut-face is completely inside any of the - ! others (that is, it is a hole on the GASPHASE): - FINFACE = 0 - NFACE2 = NFACE - DO ICF1=1,NFACE2 - ! Test that ICF1 has a negative area (case of holes) - AREA1 = AREAV(ICF1) - IF ( AREA1 < -GEOMEPS ) THEN - DO ICF2=1,NFACE2 - ! Drop if same face: - IF ( ICF1 == ICF2 ) CYCLE + ! Cartesian Faces INBOUNDARY segments: + DO FAXIS=IAXIS,KAXIS + DO ILH=LOW_IND,HIGH_IND + ! By segment: Add Vertices/Segments to local arrays: + CEI = CEIB_XYZ(ILH,FAXIS) + IF ( CEI > 0 ) THEN ! There are inboundary cut-edges + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 + DO IEDGE=1,NEDGE - ! Centroid node for ICF1: - XYC1(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF1 ) ! [x2axis x3axis] + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + STRI(1:CC_MAX_WSTRIANG_SEG+2) = & + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) - ! Polygon nodes for ICF2: - NP2 = CFELEM(1,ICF2) - DO IPT=2,NP2+1 - ICF_PT = CFELEM(IPT,ICF2) - ! Define closed Polygon: - XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) - ENDDO + ! x,y,z of node 1: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD1,XYZVERT) + ! x,y,z of node 2: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD2,XYZVERT) + + VEC(NOD1:NOD2) = (HIGH_IND-ILH)*(/ INOD1, INOD2 /) + (ILH-LOW_IND)*(/ INOD2, INOD1 /) + VEC(NOD2+1:NOD2+CC_MAX_WSTRIANG_SEG+2) = STRI(1:CC_MAX_WSTRIANG_SEG+2) + VEC(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7) = (/ CC_ETYPE_CFINB, CEI, IEDGE /) + ! Insertion ADD segment: + INLIST = .FALSE. + DO IDUM = 1,NSEG + DO IEQ1=1,3 + EQUAL1 = SEG_CELL(INDVERTBOD(IEQ1),IDUM) == VEC(INDVERTBOD(IEQ1)) + IF (.NOT.EQUAL1) EXIT + ENDDO + DO IEQ2=1,3 + EQUAL2 = SEG_CELL(INDVERTBOD(IEQ2),IDUM) == VEC(INDVERTBOD2(IEQ2)) + IF (.NOT.EQUAL2) EXIT + ENDDO + IF ( EQUAL1 .OR. EQUAL2 ) THEN + IF ( SEG_CELL(3,IDUM) > VEC(3) ) THEN + ! DO NOTHING: + ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN + SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 + SEG_CELL(5,IDUM) = VEC(4) + ENDIF + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + NSEG = NSEG + 1 + CALL REALLOCATE_SEG_CELL + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + SEG_POS(NSEG) = (2*ILH-3)*FAXIS + ENDIF + ENDDO + ENDIF + ENDDO + ENDDO - CALL TEST_PT_INPOLY(NP2,XY,XYC1,PTSFLAG) + ! Drop segments that are unconnected: + ALLOCATE(VERT_SEGS(1:NVERT)); VERT_SEGS(1:NVERT)=0 + DO IDUM = 1,NSEG + VERT_SEGS(SEG_CELL(NOD1,IDUM)) = VERT_SEGS(SEG_CELL(NOD1,IDUM)) + 1 + VERT_SEGS(SEG_CELL(NOD2,IDUM)) = VERT_SEGS(SEG_CELL(NOD2,IDUM)) + 1 + ENDDO + ALLOCATE(SEG_CELL_AUX(SIZE(SEG_CELL,DIM=1),SIZE(SEG_CELL,DIM=2))) + SEG_CELL_AUX = SEG_CELL + COUNT = 0 + DO IDUM = 1,NSEG + IF ( SEG_CELL_AUX(NOD1,IDUM)==SEG_CELL_AUX(NOD2,IDUM) ) CYCLE + IF ( (VERT_SEGS(SEG_CELL_AUX(NOD1,IDUM))>1) .AND. (VERT_SEGS(SEG_CELL_AUX(NOD2,IDUM))>1) ) THEN + COUNT = COUNT + 1 + SEG_CELL(:,COUNT) = SEG_CELL_AUX(:,IDUM) + CYCLE + ENDIF + ENDDO + NSEG = COUNT + DEALLOCATE(SEG_CELL_AUX,VERT_SEGS) - IF ( PTSFLAG ) THEN ! Centroid of face 1 inside Face 2. + IF (NSEG < 3 ) CYCLE - FINFACE(ICF1) = ICF2 - NFACE = NFACE - 1 + ! IF(NM==1 .AND. I==37 .AND. J==6 .AND. K==32) THEN + ! LU_DB_SETCC = GET_FILE_NUMBER() + ! WRITE(LU_ERR,*) 'Writing Cartcell_SEGCELL.dat...' + ! OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_SEGCELL.dat", STATUS='REPLACE') + ! ! Info pertaining to the Cartesian Cell: + ! WRITE(LU_DB_SETCC,*) 'I,J,K:',CF%NFACE + ! WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS + ! WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' + ! WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) + ! WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) + ! WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) + ! WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,SIZE_CEELEM_SEG_CELL,CC_MAX_WSTRIANG_SEG:' + ! WRITE(LU_DB_SETCC,*) NVERT,NSEG,SIZE_CEELEM_SEG_CELL,CC_MAX_WSTRIANG_SEG + ! WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' + ! DO IDUM=1,NVERT + ! WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' + ! DO IDUM=1,NSEG + ! WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM),SEG_POS(IDUM) + ! ENDDO + ! CLOSE(LU_DB_SETCC) + ! ENDIF - ! Redefine areas in case of faces with holes: - AREA2 = AREAV(ICF2) - ! Area with hole, AREA1 has negative sign: - AREAH = AREA2 + AREA1 + ! Ear clipping algorithm by TRIANGLE and BODY: + ! 1. Define closed 3D polyline: + CALL GET_CLOSED_POLYLINES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,SEG_POS,IFLG,NPOLY,ILO_POLY,NSG_POLY) - IF (ABS(AREAH) < GEOMEPS) THEN ! Hole of same size as cut-face, drop both. - FINFACE(ICF2) = ICF1 - CYCLE - ENDIF + IF (IFLG) THEN + IF(DEBUG_SET_CUTCELLS .AND. MY_RANK==PROCESS(NM)) WRITE(LU_ERR,*) 'IFLG ~=0, could not close polyline, ',& + BNDINT_FLAG,': ',NM,I,J,K,' NPOLY=',NPOLY,IFLG,'NSEG=',NSEG + MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 + NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) + IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN + ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) + DEALLOCATE(MESHES(NM)%SPCELL_LIST) + ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED + DEALLOCATE(SPCELL_LIST) + ENDIF + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) + ! Add to cells to block list: + N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK + 1 + COUNT = SIZE(SPCELLS_TO_BLOCK,DIM=1) + IF( COUNT MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) + ALLOCATE(CF%EDGE_LIST(3,CT_EDGES),CF%CEDGES(NOD3+1,NFACE)); CF%CEDGES = CC_UNDEFINED + CF%EDGE_LIST(1:3,1:CT_EDGES) = SEG_CELL_AUX(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7,1:CT_EDGES) - ! Now enhance CFELEM for faces with holes nodes: - DO ICF1=1,NFACE2 - ICF2 = FINFACE(ICF1) - IF ( ICF2 > 0 ) THEN ! Allows for up to one hole per CC_GASPHASE cut-face. - ! Load points - NP1 = CFELEM(1,ICF1) - NP2 = CFELEM(1,ICF2) - NP = (NP1+1) + (NP2+1) + ! Assign surf-index: Depending on GEOMETRY: + NCF = 0 + DO ICF=1,NFACE + IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) - ! Here reallocate CFELEM, CEDGES CFE, CFEL if NP > SIZE_VERTS_CFELEM: - CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) - CFE(1) = NP + ! Area properties for special cfaces: + ! Computed from the cross product: + D23 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + D12 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + CALL CROSS_PRODUCT(NORMTRI,D12,D23) + ! Test RH rule for CFACE normal outside of body (into gas phase): + RH_ORIENTED = ( GEOMETRY(IBOD)%FACES_NORMAL(IAXIS,ITRI)*NORMTRI(IAXIS) + & + GEOMETRY(IBOD)%FACES_NORMAL(JAXIS,ITRI)*NORMTRI(JAXIS) + & + GEOMETRY(IBOD)%FACES_NORMAL(KAXIS,ITRI)*NORMTRI(KAXIS) ) > -TWENTY_EPSILON_EB + IF(.NOT.RH_ORIENTED) THEN ! Swap normal for triangle: + IDUM = CFELEM(1+NOD2,ICF); CFELEM(1+NOD2,ICF) = CFELEM(1+NOD1,ICF); CFELEM(1+NOD1,ICF) = IDUM + D23 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + D12 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + CALL CROSS_PRODUCT(NORMTRI,D12,D23) + ENDIF + NNORM = NORM2(NORMTRI) + IF (NNORM < 2._EB*GEOMEPS**2._EB) CYCLE + NORMTRI(IAXIS:KAXIS) = NORMTRI(IAXIS:KAXIS) / NNORM - DO II2=2,NP1+1 - CFE(II2) = CFELEM(II2,ICF1) - ENDDO - II2 = (NP1+1) + 1 - CFE(II2) = CFELEM(2,ICF1) + ! First test if INB face is on Cartesian face and pointing + ! outside of Cartesian cell. If so drop: + ! Face Vertices average location: + ACEN(IAXIS:KAXIS) = 1._EB/3._EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & + XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + & + XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) + ! IAXIS: + IF ( (ABS(NORMTRI(IAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(XFACE(I-1)-ACEN(IAXIS)) < GEOMEPS) ) CYCLE ! Low Face + IF ( (ABS(NORMTRI(IAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(XFACE(I )-ACEN(IAXIS)) < GEOMEPS) ) CYCLE ! High Face + ! JAXIS: + IF ( (ABS(NORMTRI(JAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(YFACE(J-1)-ACEN(JAXIS)) < GEOMEPS) ) CYCLE ! Low Face + IF ( (ABS(NORMTRI(JAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(YFACE(J )-ACEN(JAXIS)) < GEOMEPS) ) CYCLE ! High Face + ! KAXIS: + IF ( (ABS(NORMTRI(KAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(ZFACE(K-1)-ACEN(KAXIS)) < GEOMEPS) ) CYCLE ! Low Face + IF ( (ABS(NORMTRI(KAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(ZFACE(K )-ACEN(KAXIS)) < GEOMEPS) ) CYCLE ! High Face - ! Load last point location: - ILOC = 2 - DIST12 = 1._EB / GEOMEPS - XYC1(1:2) = (/ XYZVERT(X2AXIS,CFE(II2)), XYZVERT(X3AXIS,CFE(II2)) /) - DO COUNT=2,NP2+1 - XYC2(1:2) = (/ XYZVERT(X2AXIS,CFELEM(COUNT,ICF2)), XYZVERT(X3AXIS,CFELEM(COUNT,ICF2)) /) - D12 = SQRT( (XYC1(1)-XYC2(1))**2._EB + (XYC1(2)-XYC2(2))**2._EB ) - IF( D12 < DIST12 ) THEN - DIST12 = D12 - ILOC = COUNT - ENDIF - ENDDO - IF (ILOC > 2) THEN - ! Rebuild CFELEM(:,ICF2) such that the first point is ILOC: - CFEL(2:2+(NP2+1)-ILOC) = CFELEM(ILOC:NP2+1,ICF2) - CFEL(3+(NP2+1)-ILOC:NP2+1)= CFELEM(2:ILOC-1 ,ICF2) - CFELEM(2:NP2+1 ,ICF2) = CFEL(2:NP2+1) - CFEL(2:2+(NP2+1)-ILOC) = CEDGES(ILOC:NP2+1,ICF2) - CFEL(3+(NP2+1)-ILOC:NP2+1)= CEDGES(2:ILOC-1 ,ICF2) - CEDGES(2:NP2+1 ,ICF2) = CFEL(2:NP2+1) - ENDIF + ! Area: + AREA = 0.5_EB*NNORM - COUNT = 1 - DO II2=(NP1+1)+2,(NP1+1)+1+NP2 - COUNT = COUNT + 1 - CFE(II2) = CFELEM(COUNT,ICF2) - ENDDO - II2 = NP + 1 - CFE(II2) = CFELEM(2,ICF2) + ! dot(i,nc) int(x)dA + INXAREA = NORMTRI(IAXIS)*ACEN(IAXIS)*AREA ! Single Gauss pt integration. - ! Copy CFE into CFELEM(1:np+1,icf2): - CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) + XC1(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + & + XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) ! X23 + XC2(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & + XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) + X12(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & + XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF))) + ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA + SQAREA(IAXIS:KAXIS) = 0._EB + DO IX=IAXIS,KAXIS + INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB + SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREA ! Midpoint rule. + ENDDO - ! Rearrange CEDGES - CFEL(1) = NP - CFEL(2:NP1+1) = CEDGES(2:NP1+1,ICF1) - CFEL(NP1+2) = 0 ! ENTRY 0 in EDGE_LIST, EDGE inside the SOLID. - CFEL(NP1+3:NP1+2+NP2)= CEDGES(2:NP2+1,ICF2) - CFEL(NP+1) = 0 ! ENTRY 0 in EDGE_LIST, EDGE inside the SOLID. - CEDGES(1:NP+1,ICF2) = CFEL(1:NP+1) + NCF = NCF + 1 + CF%AREA(NCF) = AREA + CF%XYZCEN(IAXIS:KAXIS,NCF) = ACEN(IAXIS:KAXIS) - ENDIF - ENDDO + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA: + CF%INXAREA(NCF) = INXAREA + ! dot(i,nc)*int(x^2)dA: + CF%INXSQAREA(NCF) = SQAREA(IAXIS) + ! dot(j,nc)*int(y^2)dA: + CF%JNYSQAREA(NCF) = SQAREA(JAXIS) + ! dot(k,nc)*int(z^2)dA: + CF%KNZSQAREA(NCF) = SQAREA(KAXIS) - NVERTFACE = MAXVAL(CFELEM(1,1:NFACE)) + 1 + ! Define Body-triangle reference: + CF%BODTRI(1:2,NCF)= (/ IBOD, ITRI /) - ! This is a cut-face, allocate space: - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCF,X1AXIS) = NCUTFACE + CF%SURF_INDEX(NCF) = GEOMETRY(IBOD)%SURFS(ITRI) - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + ! All faces connectivities: + CF%CFELEM(1:1+NOD3,NCF) = CFELEM(1:1+NOD3,ICF) + CF%CEDGES(1:1+NOD3,NCF) = CEDGES(1:1+NOD3,ICF) - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ INDI, INDJ, INDK, X1AXIS /) - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE,IBNDINT) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - ALLOCATE(CF%EDGE_LIST(3,0:NSEG)); - CF%EDGE_LIST( : , 0) = CC_UNDEFINED ! Segment inside the solid volume. - CF%EDGE_LIST(1:3,1:NSEG) = SEG_FACE(3:5,1:NSEG) - ALLOCATE(CF%CEDGES(SIZE(CEDGES,DIM=1),SIZE(CEDGES,DIM=2))) - CF%CEDGES = CC_UNDEFINED - ! Load Ordered nodes to CFELEM and geom properties: - COUNT = 0 - DO ICF=1,NFACE2 - IF ( FINFACE(ICF) > 0 ) CYCLE ! icf is a hole on another cut-face. - COUNT = COUNT + 1 - ! Connectivity: - CF%CFELEM(1:NVERTFACE,COUNT) = CFELEM(1:NVERTFACE, ICF) - CF%CEDGES(1:NVERTFACE,COUNT) = CEDGES(1:NVERTFACE, ICF) - ! Geom Properties: - CF%AREA(COUNT) = AREAV(ICF) - CF%XYZCEN(IAXIS:KAXIS,COUNT) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,ICF) - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: - CF%INXAREA(COUNT) = INXAREA(XIAXIS,ICF) - ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: - CF%INXSQAREA(COUNT) = INXSQAREA(XIAXIS,ICF) - ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: - CF%JNYSQAREA(COUNT) = INXSQAREA(XJAXIS,ICF) - ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: - CF%KNZSQAREA(COUNT) = INXSQAREA(XKAXIS,ICF) - ENDDO - ! Final number of cut-faces in the gas region of the face: - NFACE = COUNT - CF%NFACE = NFACE + ENDDO + DEALLOCATE(CFELEM,SEG_CELL_AUX,CEDGES) + CF%NFACE = NCF - ! ! Test that cut-edge nodes in EDGE list match nodes defined in CF XYZVERT: - ! IIF= CF%IJK(IAXIS) - ! JJF= CF%IJK(JAXIS) - ! KKF= CF%IJK(KAXIS) - ! DO ICF = 1, CF%NFACE - ! DO ISEG=1,CF%CEDGES(1,ICF) - ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) - ! IF (ISEGGEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN - ! WRITE(LU_ERR,*) 'Found difference in RGGAS SEGMENT=',NCUTFACE,ICF,ISEG,':',X1AXIS,AXIS,SIDE - ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) - ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) - ! ENDIF - ! CASE(CC_ETYPE_CFGAS) - ! IEC=CF%EDGE_LIST(2,IEDGE); JEC=CF%EDGE_LIST(3,IEDGE) - ! INOD1 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(1,JEC) - ! INOD2 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(2,JEC) - ! CEIJK(1:4) = MESHES(NM)%CUT_EDGE(IEC)%IJK(1:4) - ! SELECT CASE(X1AXIS) - ! CASE(IAXIS) - ! IF (CEIJK(4)==JAXIS) THEN - ! IF(CEIJK(KAXIS)==KKF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ELSEIF(CEIJK(KAXIS)==KKF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ENDIF - ! ELSEIF(CEIJK(4)==KAXIS) THEN - ! IF(CEIJK(JAXIS)==JJF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ELSEIF(CEIJK(JAXIS)==JJF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ENDIF - ! ENDIF - ! CASE(JAXIS) - ! IF (CEIJK(4)==IAXIS) THEN - ! IF(CEIJK(KAXIS)==KKF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ELSEIF(CEIJK(KAXIS)==KKF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ENDIF - ! ELSEIF(CEIJK(4)==KAXIS) THEN - ! IF(CEIJK(IAXIS)==IIF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ELSEIF(CEIJK(IAXIS)==IIF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ENDIF - ! ENDIF - ! CASE(KAXIS) - ! IF (CEIJK(4)==IAXIS) THEN - ! IF(CEIJK(JAXIS)==JJF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ELSEIF(CEIJK(JAXIS)==JJF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ENDIF - ! ELSEIF(CEIJK(4)==JAXIS) THEN - ! IF(CEIJK(IAXIS)==IIF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ELSEIF(CEIJK(IAXIS)==IIF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ENDIF - ! ENDIF - ! END SELECT - ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN - ! WRITE(LU_ERR,*) 'Found difference in CFGAS SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC - ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) - ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) - ! ENDIF - ! CASE(CC_ETYPE_CFINB) - ! IEC=CF%EDGE_LIST(2,IEDGE); JEC=CF%EDGE_LIST(3,IEDGE) - ! INOD1 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(1,JEC) - ! INOD2 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(2,JEC) - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! IF(NORM2(X1E-X1V)>GEOMEPS) THEN - ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT - ! ENDIF - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN - ! WRITE(LU_ERR,*) 'CARTF Found difference in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC - ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) - ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) - ! ENDIF - ! END SELECT - ! ENDDO - ! ENDDO + ! IF((NM==1 .AND. I==37 .AND. J==6 .AND. K==32)) THEN + ! LU_DB_SETCC = GET_FILE_NUMBER() + ! WRITE(LU_ERR,*) 'Writing Cartcell_cutfaces.dat...' + ! OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_cutfaces.dat", STATUS='REPLACE') + ! ! Info pertaining to the Cartesian Cell: + ! WRITE(LU_DB_SETCC,*) 'I,J,K:',CF%NFACE + ! WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS + ! WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' + ! WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) ! MESHES(NM)%XC(I),MESHES(NM)%DX(I) + ! WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) ! MESHES(NM)%YC(J),MESHES(NM)%DY(J) + ! WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) ! MESHES(NM)%ZC(K),MESHES(NM)%DZ(K) + ! WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT:' + ! WRITE(LU_DB_SETCC,*) NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT,CF%NFACE + ! WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' + ! DO IDUM=1,NVERT + ! WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG),SEG_POS(NSEG):' + ! DO IDUM=1,NSEG + ! WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(NOD1:NOD2,IDUM),SEG_CELL(3:6,IDUM),SEG_POS(IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'ICF,BOD_TRI:' + ! WRITE(LU_DB_SETCC,*) ICF,NBODTRI + ! DO IDUM=1,NBODTRI + ! WRITE(LU_DB_SETCC,*) BOD_TRI(1:2,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'CFELEM:' + ! DO IDUM=1,CF%NFACE + ! WRITE(LU_DB_SETCC,*) IDUM,CF%CFELEM(1:CF%CFELEM(1,IDUM)+1,IDUM) + ! ENDDO + ! CLOSE(LU_DB_SETCC) + ! ENDIF - ! HERE WE LOAD CARTESIAN CUT FACES THAT BELONG TO THE SOLID REGION, FOR SLICE PLOTTING - ! PURPOSES: - ! ------------------------------------------------------------------------------------ - SOLID_FACE_IF : IF (GET_SOLID_CUTFACES) THEN - ! Build segment list: - NSSEG = 0 - NSVERT = 0 - NSFACE = 0 + ! Now add cut-edges product of linearization to CUT_EDGE: + DO ICF = 1, CF%NFACE + IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) + DO ISEG=1,CF%CEDGES(1,ICF) + X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) + IF (ISEG 0 ) THEN + CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCE) + ELSE ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%CCVAR(I,J,K,CC_IDCE) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ I, J, K, 0, CC_GS /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCC + ENDIF - SEG_FACE (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED - XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) = 0._EB - ANGSEG(1:CC_MAXCEELEM_FACE) = 0._EB + ! Add vertices, non repeated vertex entries at this point. + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + ! Define vertices for this segment: + CALL INSERT_FACE_VERT(X1V,NM,CEI,NVERT,INOD1) + CALL INSERT_FACE_VERT(X2V,NM,CEI,NVERT,INOD2) + DO JEC=1,MESHES(NM)%CUT_EDGE(CEI)%NEDGE + IEQ1 = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,JEC) + IEQ2 = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,JEC) + IF((IEQ1==INOD1 .AND. IEQ2==INOD2) .OR. (IEQ1==INOD2 .AND. IEQ2==INOD1)) THEN ! SEG NODES found + EXIT + ENDIF + ENDDO + IF(JEC > MESHES(NM)%CUT_EDGE(CEI)%NEDGE) THEN ! JEC can be NEDGE+1, new cut-edge. + NEDGE = JEC; CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE) = (/ INOD1, INOD2 /) + ENDIF + CF%EDGE_LIST(1:3,IEDGE) = (/CC_ETYPE_CFINB, CEI, JEC /) - ! First Add to vertex list INBOUNDARY vertices and SOLID Cartesian vertices: - CEI = MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) - IF ( CEI > 0 ) THEN ! There are inboundary cut-edges - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + NCF = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) + IF (NCF==0) THEN + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) = NCF+1 + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(2,JEC) = ITRI + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,JEC) = IBOD + ELSEIF(NCF==1) THEN + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) = NCF+1 + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(3,JEC) = ITRI + ENDIF + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE - ! Here we use the SOLID orientation NOD1:NOD2 for right hand rule (inverse of GASPHASE cut-faces) - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) + ENDIF + ENDDO + ENDDO - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD2,XYZVERT) + ! DO ICF = 1, CF%NFACE + ! IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) + ! DO ISEG=1,CF%CEDGES(1,ICF) + ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) + ! IF (ISEGGEOMEPS) THEN + ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT + ! ENDIF + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN + ! WRITE(LU_ERR,*) 'CARTC CYC CELL Found diff in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC,CYCLE_CELL + ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) + ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) + ! ENDIF + ! ENDDO + ! ENDDO + ! WRITE(LU_ERR,*) 'ERR CELL I,J,K CUT_FACES',I,J,K,CF%NFACE,CT_EDGES + ! DO ICF = 1, CF%NFACE + ! WRITE(LU_ERR,*) CF%CEDGES(1:4,ICF),':',CF%CFELEM(2:4,ICF) + ! ENDDO + ! DO ICF = 1, CT_EDGES + ! WRITE(LU_ERR,*) ICF,CF%EDGE_LIST(1:3,ICF) + ! ENDDO - ! ADD segment: - NSSEG = NSSEG + 1 - SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ INOD1, INOD2 /) - DX3 = XYZVERT(X3AXIS,INOD2)-XYZVERT(X3AXIS,INOD1) - DX2 = XYZVERT(X2AXIS,INOD2)-XYZVERT(X2AXIS,INOD1) - ANGSEG(NSSEG) = ATAN2(DX3,DX2) + ENDDO ! I + ENDDO ! J +ENDDO ! K - ENDDO - ENDIF +IF (.NOT.BNDINT_FLAG) DEALLOCATE(IJK_COUNTED,IJK_COUNTF) +DEALLOCATE(SEG_CELL,SEG_POS) - ! Now add CC_SOLID Type vertices: - ! Vertex at index JJ-1,KK-1: - INDXI1(IAXIS:KAXIS) = (/ II, JJ-1, KK-1 /) ! Local x1,x2,x3 - INDI1 = INDXI1(XIAXIS) - INDJ1 = INDXI1(XJAXIS) - INDK1 = INDXI1(XKAXIS) - ! Vertex at index JJ,KK-1: - INDXI2(IAXIS:KAXIS) = (/ II, JJ , KK-1 /) ! Local x1,x2,x3 - INDI2 = INDXI2(XIAXIS) - INDJ2 = INDXI2(XJAXIS) - INDK2 = INDXI2(XKAXIS) - ! Vertex at index JJ,KK: - INDXI3(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 - INDI3 = INDXI3(XIAXIS) - INDJ3 = INDXI3(XJAXIS) - INDK3 = INDXI3(XKAXIS) - ! Vertex at index JJ-1,KK: - INDXI4(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 - INDI4 = INDXI4(XIAXIS) - INDJ4 = INDXI4(XJAXIS) - INDK4 = INDXI4(XKAXIS) +T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW - IF(MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID ) THEN - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI1(IAXIS)), X2FACE(INDXI1(JAXIS)), X3FACE(INDXI1(KAXIS)) /) - X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) - ENDIF +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + NCUTFCE = 0 + IF (BNDINT_FLAG) THEN + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) CYCLE + NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE + ENDDO + ELSE + DO ICF=MESHES(NM)%N_CUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) CYCLE + NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE + ENDDO + ENDIF + WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-faces : ',NCUTFCE,'. ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-faces : ',NCUTFCE,'. ' + ENDIF +ENDIF - IF(MESHES(NM)%VERTVAR(INDI2,INDJ2,INDK2,CC_VGSC) == CC_SOLID ) THEN - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI2(IAXIS)), X2FACE(INDXI2(JAXIS)), X3FACE(INDXI2(KAXIS)) /) - X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) - ENDIF +RETURN - IF(MESHES(NM)%VERTVAR(INDI3,INDJ3,INDK3,CC_VGSC) == CC_SOLID ) THEN - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI3(IAXIS)), X2FACE(INDXI3(JAXIS)), X3FACE(INDXI3(KAXIS)) /) - X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) - ENDIF +CONTAINS - IF(MESHES(NM)%VERTVAR(INDI4,INDJ4,INDK4,CC_VGSC) == CC_SOLID ) THEN - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI4(IAXIS)), X2FACE(INDXI4(JAXIS)), X3FACE(INDXI4(KAXIS)) /) - X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) - ENDIF +SUBROUTINE REALLOCATE_SEG_CELL + +IF(NSEG > SIZE_CEELEM_SEG_CELL) THEN + ! First SEG_CELL + ALLOCATE(SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)); SEG_CELL_AUX = CC_UNDEFINED + SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) = & + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) + DEALLOCATE(SEG_CELL); ALLOCATE(SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)) + SEG_CELL(:,:) = SEG_CELL_AUX(:,:) + ! Then SEG_POS: + SEG_CELL_AUX(1,1:SIZE_CEELEM_SEG_CELL) = SEG_POS(1:SIZE_CEELEM_SEG_CELL) + DEALLOCATE(SEG_POS); ALLOCATE(SEG_POS(1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)) + SEG_POS(:) = SEG_CELL_AUX(1,:) + SIZE_CEELEM_SEG_CELL = SIZE_CEELEM_SEG_CELL + DELTA_EDGE + DEALLOCATE(SEG_CELL_AUX) +ENDIF + +RETURN +END SUBROUTINE REALLOCATE_SEG_CELL + +END SUBROUTINE GET_CARTCELL_CUTFACES + + +! ------------------------ GET_CLOSED_POLYLINES --------------------------------- + +SUBROUTINE GET_CLOSED_POLYLINES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,SEG_POS,IFLG,NPOLY,ILO_POLY,NSG_POLY) + +INTEGER, INTENT(IN) :: SIZE_CEELEM_SEG_CELL +INTEGER, INTENT(INOUT) :: NSEG +INTEGER, INTENT(INOUT) :: SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) +INTEGER, INTENT(INOUT) :: SEG_POS(1:SIZE_CEELEM_SEG_CELL) +LOGICAL, INTENT(OUT):: IFLG +INTEGER, INTENT(OUT):: NPOLY,ILO_POLY(1:MAX_CELL_POLYLINES),NSG_POLY(1:MAX_CELL_POLYLINES) + +! Local Variables: +INTEGER :: ISEG, ISEG2, CISEG, MIBOD, NBOD, NEWSEG, SEG_LEFT, ILO, IHI, CT, IBOD, IPOLY, PIVNOD, STNOD, COUNT +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL2 +INTEGER, ALLOCATABLE, DIMENSION(:) :: SEG_POS2, COUNTED, BOD, SEG_POLY, CTBOD +LOGICAL :: FOUNDSEG, FOUND_CHG, INLIST + +IFLG=.TRUE. +ALLOCATE(SEG_CELL2(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:NSEG),SEG_POS2(1:NSEG),COUNTED(1:NSEG),& + BOD(1:N_GEOMETRY),SEG_POLY(1:NSEG)) +SEG_CELL2 = 0; SEG_POS2 =0; COUNTED = 0; BOD=0 - ! Make List of HIGH X2 vertices, in ascending X3 order. Add segments: - ASCDESC=.TRUE. - XVERT1(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) - XVERT2(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) - CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X2FACE(JJ),ASCDESC,NV,V) - DO IV=1,NV-1 - NSSEG=NSSEG + 1 - SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) - ANGSEG(NSSEG) = PI / 2._EB - ENDDO +! First collapse segments to most frequent body: +NBOD = 1 +BOD(NBOD) = SEG_CELL(6,1) +DO ISEG=2,NSEG + INLIST =.FALSE. + DO IBOD=1,NBOD + IF (SEG_CELL(6,ISEG) == BOD(IBOD)) THEN + INLIST=.TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + NBOD=NBOD+1 + BOD(NBOD)=SEG_CELL(6,ISEG) + ENDIF +ENDDO +ALLOCATE(CTBOD(1:NBOD)); CTBOD = 0 +DO IBOD=1,NBOD + DO ISEG=1,NSEG + IF (SEG_CELL(6,ISEG) == BOD(IBOD)) CTBOD(IBOD) = CTBOD(IBOD) + 1 + ENDDO +ENDDO +MIBOD=MAXLOC(CTBOD(1:NBOD),DIM=1); DEALLOCATE(CTBOD) - ! Make list of HIGH X3 vertices, in descending X2 order. Add segments: - ASCDESC=.FALSE. - XVERT1(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) - XVERT2(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) - CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X3FACE(KK),ASCDESC,NV,V) - DO IV=1,NV-1 - NSSEG=NSSEG + 1 - SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) - ANGSEG(NSSEG) = PI - ENDDO +DO ISEG=1,NSEG + IF (COUNTED(ISEG)/=0) CYCLE + CISEG = 0 + DO ISEG2=1,NSEG + IF (COUNTED(ISEG2)/=0) CYCLE + IF ( ISEG2==ISEG ) CYCLE + IF ( (SEG_CELL(NOD1,ISEG)==SEG_CELL(NOD1,ISEG2)) .AND. (SEG_CELL(NOD2,ISEG)==SEG_CELL(NOD2,ISEG2)) ) THEN + IF (SEG_CELL(6,ISEG)==BOD(MIBOD)) THEN + ! ISEG should be COUNTED +1; ISEG2 -1. + COUNTED(ISEG) = 1 + COUNTED(ISEG2)=-1 + CISEG = 1 + ELSE + ! ISEG should be COUNTED -1; ISEG2 +1. + COUNTED(ISEG) =-1 + COUNTED(ISEG2)= 1 + CISEG = 1 + ENDIF + ENDIF + ENDDO + IF (CISEG==0) COUNTED(ISEG) = 1 +ENDDO - ! Make list of LOW X2 vertices, in descending X3 order. Add segments: - ASCDESC=.FALSE. - XVERT1(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) - XVERT2(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) - CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X2FACE(JJ-1),ASCDESC,NV,V) - DO IV=1,NV-1 - NSSEG=NSSEG + 1 - SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) - ANGSEG(NSSEG) = - PI / 2._EB - ENDDO +NEWSEG = 0 +DO ISEG=1,NSEG + IF (COUNTED(ISEG)/=1) CYCLE + NEWSEG = NEWSEG + 1 + SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) + SEG_POS2(NEWSEG) = SEG_POS(ISEG) +ENDDO +NSEG = NEWSEG +SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:NSEG) = SEG_CELL2(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:NSEG) +SEG_POS(1:NSEG) = SEG_POS2(1:NSEG) - ! Make list of LOW X3 vertices, in ascending X2 order. Add segments: - ASCDESC=.TRUE. - XVERT1(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) - XVERT2(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) - CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X3FACE(KK-1),ASCDESC,NV,V) - DO IV=1,NV-1 - NSSEG=NSSEG + 1 - SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) - ANGSEG(NSSEG) = 0._EB - ENDDO +! Now make closed polylines: +SEG_CELL2 = 0; SEG_POS2 =0; COUNTED = 0; +NPOLY = 0; ILO_POLY = 0; NSG_POLY = 0; SEG_POLY = 0; ! Polyline number for the segment. +SEG_LEFT = NSEG +DO ! This exterior while loop defined closed polylines in the cell. + ! Count one more polyline: + NPOLY = NPOLY + 1 + IF (NPOLY==1) THEN + ILO_POLY(NPOLY) = 0 + ELSE + ILO_POLY(NPOLY) = ILO_POLY(NPOLY-1) + NSG_POLY(NPOLY-1) + ENDIF - ! Use list of segments on gasphase region from CUT_EDGE: - ! These are to discard from SEGS computed before: - COUNT=0 - SEG_FACEAUX(NOD1:NOD2,1:NSSEG) = SEG_FACE(NOD1:NOD2,1:NSSEG) - ANGSEGAUX(1:NSSEG)=ANGSEG(1:NSSEG) - SEG_FLAG(1:NSSEG) = .FALSE. - OUTER : DO ISEG=1,NSSEG - ! Test against GASPHASE segments: - INNER1 : DO ISEG2=1,NSEG_CART - SNOD1(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG) - SNOD2(NOD1:NOD2)= SEG_FACE_CART(NOD1:NOD2,ISEG2) - XYZ_SEG1(IAXIS:KAXIS,NOD1:NOD2) = XYZVERT(IAXIS:KAXIS,SNOD1(NOD1:NOD2)) - XYZ_SEG2(IAXIS:KAXIS,NOD1:NOD2) = XYZVERT_CART(IAXIS:KAXIS,SNOD2(NOD1:NOD2)) - ! Test for possible node combination: - DO INOD=1,4 - INOD1=NODC1(INOD) ! [ 1 2 1 2 ] - INOD2=NODC2(INOD) ! [ 1 2 2 1] - DIFF(INOD) = SQRT((XYZ_SEG1(IAXIS,INOD1)-XYZ_SEG2(IAXIS,INOD2))**2._EB + & - (XYZ_SEG1(JAXIS,INOD1)-XYZ_SEG2(JAXIS,INOD2))**2._EB + & - (XYZ_SEG1(KAXIS,INOD1)-XYZ_SEG2(KAXIS,INOD2))**2._EB ) < GEOMEPS - ENDDO - IF(DIFF(1) .AND. DIFF(2)) SEG_FLAG(ISEG)=.TRUE. ! Nodes of two segs coincide, its a GASPHASE segment. - IF(DIFF(3) .AND. DIFF(4)) SEG_FLAG(ISEG)=.TRUE. ! Nodes of two segs coincide, its a GASPHASE segment. - ENDDO INNER1 - ! Test against itself: - INNER2 : DO ISEG2=1,NSSEG - IF (ISEG==ISEG2) CYCLE - SNOD1(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG) - SNOD2(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG2) - IF(SNOD1(NOD1)==SNOD2(NOD2) .AND. SNOD1(NOD2)==SNOD2(NOD1)) SEG_FLAG(ISEG)=.TRUE. - ENDDO INNER2 - ENDDO OUTER - DO ISEG=1,NSSEG - IF(SEG_FLAG(ISEG)) CYCLE - COUNT=COUNT+1 - SEG_FACE(NOD1:NOD2,COUNT)=SEG_FACEAUX(NOD1:NOD2,ISEG) - ANGSEG(COUNT) = ANGSEGAUX(ISEG) - ENDDO + ! Find first segment of next polyline: + FOUNDSEG = .FALSE. + DO ISEG=1,NSEG + IF (COUNTED(ISEG) == 0) THEN + FOUNDSEG = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.FOUNDSEG) EXIT ! Escape if there are no new segments. - NSSEG=COUNT + ! Create new closed polyline: + NEWSEG = ILO_POLY(NPOLY) + 1 + SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) + SEG_POS2(NEWSEG) = SEG_POS(ISEG) + COUNTED(ISEG) = 1 + STNOD = SEG_CELL2(NOD1,NEWSEG) + PIVNOD = SEG_CELL2(NOD2,NEWSEG) ! Pivot Vertex, used to find next segment. + NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 + SEG_POLY(NEWSEG) = NPOLY + SEG_LEFT = SEG_LEFT - 1 + DO NEWSEG = ILO_POLY(NPOLY)+2,NSEG + FOUNDSEG = .FALSE. + DO ISEG=1,NSEG + IF (COUNTED(ISEG) > 0) CYCLE + IF (SEG_CELL(NOD1,ISEG)==PIVNOD) THEN ! Found the next segment + FOUNDSEG = .TRUE. + SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) + SEG_POS2(NEWSEG) = SEG_POS(ISEG) + COUNTED(ISEG) = 1 + PIVNOD = SEG_CELL2(NOD2,NEWSEG); ! Pivot Vertex, used to find next segment. + NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 + SEG_POLY(NEWSEG) = NPOLY; + SEG_LEFT = SEG_LEFT - 1 + EXIT + ELSEIF (SEG_CELL(NOD2,ISEG)==PIVNOD) THEN ! Found the next segment + FOUNDSEG = .TRUE. + SEG_CELL2(:,NEWSEG) = (/ SEG_CELL(NOD2,ISEG), SEG_CELL(NOD1,ISEG), SEG_CELL(3:9,ISEG) /) + SEG_POS2(NEWSEG) = SEG_POS(ISEG) + COUNTED(ISEG) = 1 + PIVNOD = SEG_CELL2(NOD2,NEWSEG) ! Pivot Vertex, used to find next segment. + NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 + SEG_POLY(NEWSEG) = NPOLY + SEG_LEFT = SEG_LEFT - 1 + EXIT + ENDIF + ENDDO + ! Check if for this NEWSEG we didn't find an ISEG: + IF (.NOT.FOUNDSEG) EXIT + ENDDO + ! Finally, test if polyline is closed: + IF ( SEG_CELL2(NOD2,ILO_POLY(NPOLY)+NSG_POLY(NPOLY)) /= STNOD ) RETURN - ! Build Solid side faces: - NOTDONE = .TRUE. - DO WHILE(NOTDONE) - NOTDONE = .FALSE. - ! Counts edges that reach nodes: - NUMEDG_NODE(1:CC_MAXVERTS_FACE) = 0 - DO ISEG=1,NSSEG - DO II2=NOD1,NOD2 - INOD = SEG_FACE(II2,ISEG) - NUMEDG_NODE(INOD) = NUMEDG_NODE(INOD) + 1 - ENDDO - ENDDO + ! End of new polyline creation. + ! Here if we have less that 3 segments not counted exit while loop. + IF (SEG_LEFT < 3) EXIT +ENDDO - ! Drop segments with NUMEDG_NODE(INOD)=1: - ! The assumption here is that they are CC_SS CC_INBOUNDCF - ! segments with one node inside the Cartface i.e. case Fig - ! 9(a) in the CompGeom3D notes): - COUNT = 0 - SEG_FACEAUX (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED - ANGSEGAUX(1:CC_MAXCEELEM_FACE) = 0._EB - DO ISEG=1,NSSEG - NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) - NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) - IF ((NUMNOD1 > 1) .AND. (NUMNOD2 > 1)) THEN - COUNT = COUNT + 1 - SEG_FACEAUX(NOD1:NOD2,COUNT) = SEG_FACE(NOD1:NOD2,ISEG) - ANGSEGAUX(COUNT) = ANGSEG(ISEG) - ELSE - NOTDONE = .TRUE. - ENDIF - ENDDO - NSSEG = COUNT - SEG_FACE = SEG_FACEAUX - ANGSEG = ANGSEGAUX - ENDDO +! Per polyline, move last SEG if SEG-1 is different body number: +DO IPOLY=1,NPOLY + FOUND_CHG=.FALSE. + ILO =ILO_POLY(IPOLY)+1 + IHI =ILO_POLY(IPOLY)+NSG_POLY(IPOLY) + CT =0 + DO ISEG=ILO,IHI-1 + CT=CT+1 + IF (SEG_CELL2(6,ISEG) /= SEG_CELL2(6,ISEG+1)) THEN + FOUND_CHG=.TRUE. + EXIT + ENDIF + ENDDO + IF (FOUND_CHG) THEN + SEG_CELL(:,ILO:IHI-CT) = SEG_CELL2(:,ISEG+1:IHI) + SEG_POS(ILO:IHI-CT) = SEG_POS2(ISEG+1:IHI) + SEG_CELL(:,IHI-CT+1:IHI) = SEG_CELL2(:,ILO:ISEG) + SEG_POS(IHI-CT+1:IHI) = SEG_POS2(ILO:ISEG) + ELSE + SEG_CELL(:,ILO:IHI) = SEG_CELL2(:,ILO:IHI) + SEG_POS(ILO:IHI) = SEG_POS2(ILO:IHI) + ENDIF +ENDDO - ! Discard face with less than 3 edges (triangle): - IF ( NSSEG < 3 ) CYCLE +! Finally cycle segments to redefine polylines (case of two or more polys +! sharing one point. +STNOD=SEG_CELL(NOD1,1) +NPOLY=1; COUNT=1 +DO ISEG=2,NSEG + COUNT=COUNT+1 + SEG_POLY(ISEG)=NPOLY + IF (SEG_CELL(NOD2,ISEG)==STNOD) THEN + NSG_POLY(NPOLY) = COUNT + IF (ISEG==NSEG) EXIT + NPOLY=NPOLY+1 + ILO_POLY(NPOLY) = ILO_POLY(NPOLY-1) + NSG_POLY(NPOLY-1) + COUNT=0; STNOD=SEG_CELL(NOD1,ISEG+1) + ENDIF +ENDDO - ! Add segments which have both ends attached to more than two segs: - count = 0 - DO ISEG=1,NSSEG - NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) - NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) - IF ((NUMNOD1 > 2) .AND. (NUMNOD2 > 2)) THEN - COUNT = COUNT + 1 - SEG_FACE(NOD1:NOD2,NSSEG+COUNT) = SEG_FACE( (/ NOD2, NOD1 /) ,ISEG) - IF (ANGSEG(ISEG) >= 0._EB) THEN - ANGSEG(NSSEG+COUNT) = ANGSEG(ISEG) - PI - ELSE - ANGSEG(NSSEG+COUNT) = ANGSEG(ISEG) + PI - ENDIF - ENDIF - ENDDO - NSSEG = NSSEG + COUNT +DEALLOCATE(SEG_CELL2,SEG_POS2,COUNTED,BOD,SEG_POLY) - ! Fill NODEDG_FACE(IEDGE,INOD), where iedge are edges - ! that contain inod as first node. This assumes edges are - ! ordered using the right hand rule on x2-x3 plane. - ! Also compute the edges angles in x2-x3 plane - CALL REALLOCATE_NODEDG_FACE(NSSEG,NSVERT) - NODEDG_FACE(:,:) = 0 - DO ISEG=1,NSSEG - INOD1 = SEG_FACE(NOD1,ISEG) - NEDI = NODEDG_FACE(1,INOD1) + 1 ! Increase number of edges connected to node by 1. - NODEDG_FACE( 1,INOD1) = NEDI - NODEDG_FACE(NEDI+1,INOD1) = ISEG - ENDDO +IFLG=.FALSE. - ! Now Reorder Segments, do tests: - SEG_FACE2(NOD1:NOD3,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED ! [INOD1 INOD2 ICF] - SEG_FLAG(1:CC_MAXCEELEM_FACE) = .TRUE. +RETURN +END SUBROUTINE GET_CLOSED_POLYLINES - ICF = 1 - ISEG = 1 - NEWSEG = ISEG - COUNT= 1 - CTSTART=COUNT - SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG),SEG_FACE(NOD2,NEWSEG),ICF /) - SEG_FLAG(ISEG) = .FALSE. - NSEG_LEFT = NSSEG - 1 - ! Infamous infinite loop: - INF_LOOP2 : DO +! --------------------------- EAR_CLIP_CFACES ----------------------------------- - FOUNDSEG = .FALSE. - N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. - ANGCOUNT = ANGSEG(NEWSEG) +SUBROUTINE EAR_CLIP_CFACES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,XYZVERT,& + INDIF,INDJF,INDKF,NPOLY,ILO_POLY,NSG_POLY,NFACE,& + CFELEM,BOD_TRI,CEDGES,SEG_CELL_AUX,COUNT_CEDGE) - ! Find Segment starting on Node 2 with smaller ANGSEG respect to COUNT. - DANG = -1._EB / GEOMEPS - DO ISS=2,NODEDG_FACE(1,N2COUNT)+1 - ISEG = NODEDG_FACE(ISS,N2COUNT) - IF ( SEG_FLAG(ISEG) ) THEN ! This seg hasn't been added to SEG_FACE2 - ! Drop if seg is the opposite of count seg: - IF ( SEG_FACE2(NOD1,COUNT) == SEG_FACE(NOD2,ISEG) ) CYCLE - DANGI = ANGSEG(ISEG) - ANGCOUNT - IF ( DANGI < 0._EB ) DANGI = DANGI + 2._EB * PI +INTEGER, INTENT(IN) :: SIZE_CEELEM_SEG_CELL +INTEGER, INTENT(IN) :: NSEG, INDIF, INDJF, INDKF, NPOLY +INTEGER, INTENT(IN) :: ILO_POLY(1:MAX_CELL_POLYLINES),NSG_POLY(1:MAX_CELL_POLYLINES) +INTEGER, INTENT(IN) :: SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) +REAL(EB),INTENT(IN) :: XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) +INTEGER, INTENT(OUT):: NFACE,CFELEM(4,3*NSEG),BOD_TRI(1:2,1:CC_MAXCFELEM_FACE),CEDGES(4,3*NSEG) +INTEGER, INTENT(INOUT) :: SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:3*NSEG) +INTEGER, INTENT(OUT):: COUNT_CEDGE - IF ( DANGI > DANG ) THEN - NEWSEG = ISEG - DANG = DANGI - FOUNDSEG = .TRUE. - ENDIF - ENDIF - ENDDO +! Local Variables: +REAL(EB) :: DV(IAXIS:KAXIS), NP(IAXIS:KAXIS), XP(IAXIS:KAXIS) +REAL(EB), ALLOCATABLE, DIMENSION(:) :: LEN_SEG +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: N +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL2 +LOGICAL :: SEG_FLAG(1:MAX_CELL_POLYLINES), FOUND_ISEG1, IS_SOLID, TWOTRI +INTEGER :: ILO, IHI, NSGP, LEFT_SEGS, COUNTEXT, COUNT, BOD, TRI, ISEG, ISEG1, IPOLY, XAXIS, IFACE +INTEGER :: CONN(1:3),CONN2(1:6) - ! Found a seg add to SEG_FACE2: - IF ( FOUNDSEG ) THEN - COUNT = COUNT + 1 - SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG), SEG_FACE(NOD2,NEWSEG), ICF /) - SEG_FLAG(NEWSEG) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - ENDIF +ALLOCATE(LEN_SEG(1:3*NSEG)); LEN_SEG = 0._EB +ALLOCATE(N(IAXIS:KAXIS,1:3*NSEG)); N = 0._EB +ALLOCATE(SEG_CELL2(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:3*NSEG)); SEG_CELL2 = 0 +COUNT_CEDGE = 0 - ! Test if line has closed on point shared any other cutface: - IF ( SEG_FACE2(NOD2,COUNT) == SEG_FACE2(NOD1,CTSTART) ) THEN - ! Go for new cut-face on this Cartesian face. - ELSEIF ( FOUNDSEG ) THEN - CYCLE - ENDIF +! Compute segments director unit vectors and normals: +!DO ISEG=1,NSEG +! DV = XYZVERT(IAXIS:KAXIS,SEG_CELL(NOD2,ISEG)) - XYZVERT(IAXIS:KAXIS,SEG_CELL(NOD1,ISEG)) +! LEN_SEG(ISEG) = NORM2(DV) +! N(IAXIS:KAXIS,ISEG) = 1._EB/LEN_SEG(ISEG) * DV +!ENDDO - ! Break loop: - IF ( NSEG_LEFT == 0 ) EXIT +! First sweep across segments defining triangles for all consecutive segments with same triangle and body: +NFACE = 0 +! Ear clipping algorithm by polyline: +DO IPOLY=1,NPOLY + ILO = ILO_POLY(IPOLY)+1 + NSGP = NSG_POLY(IPOLY) + IHI = ILO_POLY(IPOLY)+NSGP + SEG_CELL2(:,1:NSGP) = SEG_CELL(:,ILO:IHI) + DO ISEG=1,NSGP ! Compute segments director unit vectors and normals + DV = XYZVERT(IAXIS:KAXIS,SEG_CELL2(NOD2,ISEG)) - XYZVERT(IAXIS:KAXIS,SEG_CELL2(NOD1,ISEG)) + LEN_SEG(ISEG) = NORM2(DV) + N(IAXIS:KAXIS,ISEG) = 1._EB/LEN_SEG(ISEG) * DV + ENDDO + SEG_CELL_AUX(:,COUNT_CEDGE+1:COUNT_CEDGE+NSGP) = SEG_CELL(:,ILO:IHI) + COUNT_CEDGE = COUNT_CEDGE + NSGP + SEG_FLAG(1:NSGP) = .FALSE. + LEFT_SEGS = NSGP + DO COUNTEXT=1,3 ! Search segmets first that belong to same triangle (1), + ! second that belong to same body (2), third all the rest. + DO COUNT=1,2 ! Search first last uncounted segment (1), second the rest. + IF (LEFT_SEGS < 3) EXIT ! should break out of COUNTEXT loop. + IF (COUNT==1) THEN + ISEG = NSGP-1 + DO ISEG1=1,NSGP + IF (.NOT.SEG_FLAG(ISEG1)) EXIT + ENDDO + ELSE + ISEG = 0 + ENDIF + DO WHILE (ISEG < NSGP) + ISEG = ISEG + 1 + IF (SEG_FLAG(ISEG)) CYCLE + FOUND_ISEG1 =.FALSE. + IF (COUNT==1) THEN + IF (.NOT.SEG_FLAG(ISEG1)) FOUND_ISEG1 =.TRUE. + ELSE + DO ISEG1=ISEG+1,NSGP + IF (.NOT.SEG_FLAG(ISEG1)) THEN + FOUND_ISEG1 =.TRUE. + EXIT + ENDIF + ENDDO + ENDIF + IF(.NOT.FOUND_ISEG1) CYCLE - ! Start a new cut-face on this Cartesian face: - ICF = ICF + 1 - DO ISEG=1,NSSEG - IF ( SEG_FLAG(ISEG) ) THEN - COUNT = COUNT + 1 - CTSTART= COUNT - SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,ISEG), SEG_FACE(NOD2,ISEG), ICF /) - SEG_FLAG(ISEG) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - EXIT - ENDIF - ENDDO + TRI = 0 + ! Test if triangle given by ISEG ISEG+1 DIAG is valid. + ! First, drop if Body not the same: + IF ( (COUNTEXT<3) .AND. (SEG_CELL2(6,ISEG)/=SEG_CELL2(6,ISEG1)) ) CYCLE - ENDDO INF_LOOP2 + ! Second, drop if segments are on the same line: + IF (ABS(ABS(DOT_PRODUCT(N(IAXIS:KAXIS,ISEG),N(IAXIS:KAXIS,ISEG1)))-1._EB) < 1.e-12_EB) CYCLE - ! Load ordered nodes to CFELEM: - NSFACE = ICF - ! Reallocate CFELEM ARRAY if necessary: - CALL REALLOCATE_LOCAL_CFELEM(NSSEG,NSFACE) - CFELEM(:,:) = CC_UNDEFINED - COUNT = 0 - DO ICF=1,NSFACE - NP = 0 - DO ISEG=1,NSSEG - IF ( SEG_FACE2(NOD3,ISEG) == ICF ) NP = NP + 1 - ENDDO - IF (NP < 3) CYCLE ! Drop face if it has less than 2 3 vertices - COUNT=COUNT+1 - NP = 0 - DO ISEG=1,NSSEG - IF ( SEG_FACE2(NOD3,ISEG) == ICF ) THEN - NP = NP + 1 - CFELEM(1,COUNT) = NP - CFELEM(NP+1,COUNT) = SEG_FACE2(NOD1,ISEG) - ENDIF - ENDDO - ! Does Face Have zero Area? If so drop, rewind: - DO IPT=2,NP+1 - ICF_PT = CFELEM(IPT,COUNT) - ! Define closed Polygon: - XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) - ENDDO - ICF_PT = CFELEM(2,COUNT) - XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) ! Close Polygon. - AREA = 0._EB - DO II2=1,NP - AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & - XY(JAXIS,II2) * XY(IAXIS,II2+1) ) - ENDDO - IF (ABS(AREA) < GEOMEPS**2._EB) THEN - CFELEM(:,COUNT) = CC_UNDEFINED - COUNT = COUNT - 1 - ENDIF - ENDDO - NSFACE = COUNT; IF(NSFACE==0) CYCLE + ! Now drop if triangles don't match: + TWOTRI = .FALSE. + IF (COUNTEXT<3) THEN + IF( (SEG_CELL2(4,ISEG)/=0) .AND. (SEG_CELL2(4,ISEG)==SEG_CELL2(4,ISEG1) .OR. & + SEG_CELL2(4,ISEG)==SEG_CELL2(5,ISEG1)) ) THEN + TWOTRI = .TRUE. + TRI = SEG_CELL2(4,ISEG) + BOD = SEG_CELL2(6,ISEG) + ELSEIF ( (SEG_CELL2(5,ISEG)/=0) .AND. (SEG_CELL2(5,ISEG)==SEG_CELL2(4,ISEG1) .OR. & + SEG_CELL2(5,ISEG)==SEG_CELL2(5,ISEG1)) ) THEN + TWOTRI = .TRUE. + TRI = SEG_CELL2(5,ISEG) + BOD = SEG_CELL2(6,ISEG) + ENDIF + ENDIF + IF ( (COUNTEXT/=1) .AND. (TRI==0) ) THEN + ! Define TRI as the longest seg one: + IF ( LEN_SEG(ISEG) >= LEN_SEG(ISEG1) ) THEN + TRI = SEG_CELL2(4,ISEG) + BOD = SEG_CELL2(6,ISEG) + ELSE + TRI = SEG_CELL2(4,ISEG1) + BOD = SEG_CELL2(6,ISEG1) + ENDIF + ENDIF - ! Compute area and Centroid, in local x1, x2, x3 coords: - ALLOCATE(DROPFACE(1:NSFACE)); DROPFACE=.FALSE. - AREAV(1:NSFACE) = 0._EB - XYZCEN(IAXIS:KAXIS,1:NSFACE) = 0._EB - DO ICF=1,NSFACE - NP = CFELEM(1,ICF) - DO IPT=2,NP+1 - ICF_PT = CFELEM(IPT,ICF) - ! Define closed Polygon centered in First Point: - XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & - XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) - ENDDO - ICF_PT = CFELEM(2,ICF) - XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & - XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) + IF ( TRI == 0 ) THEN + CYCLE + ELSE ! Found two segments with matching triangle. - ! Get Area and Centroid properties of Cut-face: - AREA = 0._EB - DO II2=1,NP - AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & - XY(JAXIS,II2) * XY(IAXIS,II2+1) ) - ENDDO - AREA = AREA / 2._EB - IF ( (AREA 0 ) THEN ! Allows for up to one hole per CC_GASPHASE cut-face. - ! Load points - NP1 = CFELEM(1,ICF1) - NP2 = CFELEM(1,ICF2) - NP = (NP1+1) + (NP2+1) +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +INTEGER :: NCUTCEL - ! Here reallocate CFELEM, CFE, CFEL if NP > SIZE_VERTS_CFELEM: - CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTCELLS for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTCELLS for mesh :',NM,' ..' +ENDIF - CFE(1) = NP +TNOW=CURRENT_TIME() - DO II2=2,np1+1 - CFE(II2) = CFELEM(II2,icf1) - ENDDO - II2 = (np1+1) + 1 - CFE(II2) = CFELEM(2,icf1) +! Allocate work arrays for this mesh: +SIZE_CEELEM_EDGFAC = DELTA_EDGE +SIZE_CFELEM_EDGFAC = DELTA_FACE +ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) +ALLOCATE(SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC)) - COUNT = 1 - DO II2=(NP1+1)+2,(NP1+1)+1+NP2 - COUNT = COUNT + 1 - CFE(II2) = CFELEM(COUNT,ICF2) - ENDDO - II2 = NP + 1 - CFE(II2) = CFELEM(2,ICF2) +SIZE_CEELEM_FACEDG = DELTA_EDGE +SIZE_CFELEM_FACEDG = DELTA_FACE +ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) +ALLOCATE(IPTS(1:SIZE_CEELEM_FACEDG+1)) ! Note that SIZE_CEELEM_FACEDG should be ~= SIZE_VERTS_FC. + ! (we have equal number of vertices and edges for a closed polygon.) - ! Copy CFE into CFELEM(1:np+1,icf2): - CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) +SIZE_VERTS_FC = DELTA_VERT +SIZE_CFELEM_FC = DELTA_FACE +ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) +ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)) +ALLOCATE(AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC)) +ALLOCATE(FACECELL_NUM(1:SIZE_CFELEM_FC)) +ALLOCATE(FACE_CELL_DUM(1:SIZE_VERTS_FC)) - ENDIF - ENDDO +SIZE_FACE_CCELEM = DELTA_FACE +SIZE_CELL_CCELEM = DELTA_CELL +ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) +ALLOCATE(NOADVANCE(1:SIZE_CELL_CCELEM),VOL(1:SIZE_CELL_CCELEM),XYZCEN(IAXIS:KAXIS,1:SIZE_CELL_CCELEM)) - NVERTFACE = MAXVAL(CFELEM(1,1:NSFACE2)) + 1 +! Definition of cut-cells: +! For each cartesian cell being cut into one or several cut-cells (NCELL), fill +! entries on a MESHES(NM)%CUT_CELL struct. On each local entry ICC: +! - Add number of faces that are boundary of cut-cell. +! MESHES(NM)%CUT_CELL(ICELL)%CCELEM(1:NFACE_CELL+1,ICC), ICC=1,...,MESHES(NM)%CUT_CELL(ICELL)%NCELL +! - Add list of corresponding regular faces, or cut-faces in CUT_FACE: +! + 5 Indexes: +! MESHES(NM)%CUT_CELL(ICELL)%FACES_LIST = [ FACE_TYPE LOW/HIGH AXIS cei icf ] +! where in MESHES(NM)%CUT_FACE(CEI), which icf. +! - Compute Volume properties for each disjoint volume, add an unknown +! number for scalars, pressure, etc. - ! Up to this point we have all SOLID side cut-faces in CFELEM, SOLID_SIDE nodes in XYZVERT and - ! Area properties: Add these to Existing CUT_FACE info: - MESHES(NM)%CUT_FACE(NCUTFACE)%NSVERT = NSVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NSFACE = NSFACE - CALL FACE_REALLOC(NM,NCUTFACE,NVERT,NFACE,NSVERT,NSFACE,NVERTFACE) - MESHES(NM)%CUT_FACE(NCUTFACE)%XYZVERT(IAXIS:KAXIS,NVERT+1:NVERT+NSVERT)=XYZVERT(IAXIS:KAXIS,1:NSVERT) +IBNDINT_LOOP : DO IBNDINT=LOW_IND,HIGH_IND ! 1 refers to blocks internal cells, 2 refers to block guard cells. - ! Load Ordered nodes to CFELEM and geom properties: - COUNT = NFACE - DO ICF=1,NSFACE2 - IF ( FINFACE(ICF) > 0 ) CYCLE ! icf is a hole on another cut-face. - COUNT = COUNT + 1 - ! Connectivity: - NV=CFELEM(1, ICF) - CFELEM(2:NV+1,ICF)=CFELEM(2:NV+1,ICF) + NVERT ! Re-index to total number of vertices. - MESHES(NM)%CUT_FACE(NCUTFACE)%CFELEM(1:NVERTFACE,COUNT) = CFELEM(1:NVERTFACE, ICF) - ! Geom Properties SOLID: - MESHES(NM)%CUT_FACE(NCUTFACE)%AREA(COUNT) = AREAV(ICF) - MESHES(NM)%CUT_FACE(NCUTFACE)%XYZCEN(IAXIS:KAXIS,COUNT) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,ICF) - ENDDO - ! Final number of cut-faces in the solid region of the face: - MESHES(NM)%CUT_FACE(NCUTFACE)%NSFACE = COUNT-NFACE +SELECT CASE(IBNDINT) +CASE(LOW_IND) + ALLOCATE(IJK_COUNT(ILO_CELL-NGUARD:IHI_CELL+NGUARD,JLO_CELL-NGUARD:JHI_CELL+NGUARD,KLO_CELL-NGUARD:KHI_CELL+NGUARD)) + IJK_COUNT = .FALSE. + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL +CASE(HIGH_IND) + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD +END SELECT - ENDIF SOLID_FACE_IF +! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: +DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI - ENDDO ! JJ - ENDDO ! KK - ENDDO ! II + IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE - DEALLOCATE(X1FACE,X2FACE,X3FACE) + IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. - ENDDO XIAXIS_LOOP + ! Start with Cartesian Faces: + ! Face type of bounding Cartesian faces: + FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) + FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) + FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) + FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) + FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) + FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) -ENDDO IBNDINT_LOOP + ! Cut-face number of bounding Cartesian faces: + IDCF_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCF,IAXIS) + IDCF_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCF,IAXIS) + IDCF_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCF,JAXIS) + IDCF_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCF,JAXIS) + IDCF_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCF,KAXIS) + IDCF_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCF,KAXIS) -IF (BNDINT_FLAG) THEN - ! Here we mark faces on the guard-cell region for the computaiton of grid aligned INBOUNDARY faces - ! on CARTCELL_CUTFACES to work correctly: - XIAXIS_LOOP_2 : DO X1AXIS=IAXIS,KAXIS + ! Local variables: + ! Geometric entities related to the Cartesian cell: + NVERT_CELL = 0 + NSEG_CELL = 0 + NFACE_CELL = 0 + SEG_CELL = CC_UNDEFINED + FACE_CELL = CC_UNDEFINED + FACE_LIST = CC_UNDEFINED + XYZVERT = 0._EB + AREAVARS = 0._EB - SELECT CASE(X1AXIS) - case(IAXIS) + ! Add Cartesian Regular faces + GASPHASE cut-faces + vertices: + IED = I-1; JED = J-1; KED = K-1 + MYAXIS_LOOP : DO MYAXIS=IAXIS,KAXIS + SELECT CASE(MYAXIS) + CASE(IAXIS) - X2AXIS = JAXIS - X3AXIS = KAXIS + XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - ! IAXIS gasphase cut-faces: - ILO = ILO_FACE-CCGUARD; IHI = IHI_FACE+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS + AREAI = DYCELL(J) * DZCELL(K) + AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/-XFACE(IED )*AREAI, -XFACE(IED )**2._EB*AREAI, 0._EB, 0._EB /) + AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ XFACE(IED+1)*AREAI, XFACE(IED+1)**2._EB*AREAI, 0._EB, 0._EB /) + CASE(JAXIS) - ! Local indexing in x1, x2, x3: - X1LO = ILO; X1HI = IHI - X2LO = JLO; X2HI = JHI - X3LO = KLO; X3HI = KHI + XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) - CASE(JAXIS) + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - X2AXIS = KAXIS - X3AXIS = IAXIS + AREAI = DXCELL(I) * DZCELL(K) + AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/ 0._EB, 0._EB, -YFACE(JED )**2._EB*AREAI, 0._EB /) + AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ 0._EB, 0._EB, YFACE(JED+1)**2._EB*AREAI, 0._EB /) + CASE(KAXIS) - ! JAXIS gasphase cut-faces: - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD + XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) - ! Local indexing in x1, x2, x3: - X1LO = JLO; X1HI = JHI - X2LO = KLO; X2HI = KHI - X3LO = ILO; X3HI = IHI + AREAI = DXCELL(I) * DYCELL(J) + AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/ 0._EB, 0._EB, 0._EB, -ZFACE(KED )**2._EB*AREAI /) + AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ 0._EB, 0._EB, 0._EB, ZFACE(KED+1)**2._EB*AREAI /) + END SELECT - CASE(KAXIS) + CEI_AXIS(LOW_IND:HIGH_IND) = IDCF_XYZ(LOW_IND:HIGH_IND,MYAXIS) - X2AXIS = IAXIS - X3AXIS = JAXIS + DO SIDE=LOW_IND,HIGH_IND + ! Low High face: + IF ( FSID_XYZ(SIDE,MYAXIS) == CC_GASPHASE ) THEN - ! KAXIS gasphase cut-faces: - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + ! Regular Face, build 4 vertices + face: + NP = 0 + NFACE_CELL = NFACE_CELL + 1 - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS + ! Here, reallocate FACE_LIST, AREAVARS, FACE_CELL if NFACE_CELL > SIZE_CFELEM_FC: + ! Also no need to reallocate FACE_CELL vert dimension, as for regular cells vert size = 5. + CALL REALLOCATE_LOCAL_FC_VARS + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_RCGAS, SIDE, MYAXIS, 0, 0, CC_UNDEFINED /) + ! CC_FTYPE_RCGAS=0, regular face. + AREAVARS(1:MAX_DIM+1,NFACE_CELL) = AREAVARSI(1:MAX_DIM+1,SIDE) - ! Local indexing in x1, x2, x3: - X1LO = KLO; X1HI = KHI - X2LO = ILO; X2HI = IHI - X3LO = JLO; X3HI = JHI + ! Vertices arranged normal out of cartesian cell: + DO IP=NOD1,NOD4 + ! xl,yl,zl + XYZ(IAXIS:KAXIS) = XYZLH(IAXIS:KAXIS,IP,SIDE) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) - END SELECT + NP = NP + 1 + FACE_CELL(1,NFACE_CELL) = NP + FACE_CELL(NP+1,NFACE_CELL) = INOD + ENDDO - ! Loop on Cartesian faces, local x1, x2, x3 indexes: - DO II=X1LO,X1HI - DO KK=X3LO,X3HI - DO JJ=X2LO,X2HI + ELSEIF (FSID_XYZ(SIDE,MYAXIS) == CC_CUTCFE ) THEN - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI = INDXI(XIAXIS) - INDJ = INDXI(XJAXIS) - INDK = INDXI(XKAXIS) + FCT = REAL(2*SIDE-3,EB) !2*(side-3/2); + ! GasPhase CUT_FACE, add all cut-faces on these Cartesian cell + nodes: + CEI = CEI_AXIS(SIDE) + DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE + NFACE_CELL = NFACE_CELL + 1 + ! Here, reallocate FACE_LIST, AREAVARS, FACE_CELL if NFACE_CELL > SIZE_CFELEM_FC: + CALL REALLOCATE_LOCAL_FC_VARS + ! Also reallocate FACE_CELL vert dimension, if needed. + NP = MESHES(NM)%CUT_FACE(CEI)%CFELEM(1,ICF) + CALL REALLOCATE_FACE_CELL_VERTS - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFGAS,SIDE,MYAXIS,CEI,ICF,CC_UNDEFINED /) + ! CC_FTYPE_CFGAS=1 + AREAVARS(1:MAX_DIM+1,NFACE_CELL) =(/ MESHES(NM)%CUT_FACE(CEI)%INXAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%INXSQAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%JNYSQAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%KNZSQAREA(ICF) /)*FCT + ! FCT considers Normal out. + FACE_CELL(1,NFACE_CELL) = NP + DO IP=2,NP+1 + FNOD = MESHES(NM)%CUT_FACE(CEI)%CFELEM(IP,ICF) + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_FACE(CEI)%XYZVERT(IAXIS:KAXIS,FNOD) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) + FACE_CELL(IP,NFACE_CELL) = INOD + ENDDO + ENDDO + ENDIF + ENDDO + ENDDO MYAXIS_LOOP - ! Drop if face not cut-face: - ! Test for FACE Cartesian edges being cut: - ! If outface1 is true -> All regular edges for this face: - ! Edge at index KK-1: - INDXI1(IAXIS:KAXIS) = (/ II, JJ , KK-1 /) ! Local x1,x2,x3 - INDI1 = INDXI1(XIAXIS) - INDJ1 = INDXI1(XJAXIS) - INDK1 = INDXI1(XKAXIS) - ! Edge at index KK: - INDXI2(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 - INDI2 = INDXI2(XIAXIS) - INDJ2 = INDXI2(XJAXIS) - INDK2 = INDXI2(XKAXIS) - ! Edge at index JJ-1: - INDXI3(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 - INDI3 = INDXI3(XIAXIS) - INDJ3 = INDXI3(XJAXIS) - INDK3 = INDXI3(XKAXIS) - ! Edge at index jj: - INDXI4(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 - INDI4 = INDXI4(XIAXIS) - INDJ4 = INDXI4(XJAXIS) - INDK4 = INDXI4(XKAXIS) + N_GAS_CFACES = NFACE_CELL - OUTFACE1 = (MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) /= CC_CUTCFE) + ! Now add INBOUNDARY faces of the cell: + CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) + IF ( CEI > 0 ) THEN + FCT = -1._EB + DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE + NFACE_CELL = NFACE_CELL + 1 + ! Here, reallocate FACE_LIST, AREAVARS, FACE_CELL if NFACE_CELL > SIZE_CFELEM_FC: + CALL REALLOCATE_LOCAL_FC_VARS + ! Also reallocate FACE_CELL, FACE_CELL_DUM vert dimension, if needed. + NP = MESHES(NM)%CUT_FACE(CEI)%CFELEM(1,ICF) + CALL REALLOCATE_FACE_CELL_VERTS + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB, 0, 0, CEI, ICF, CC_UNDEFINED /) + ! CC_FTYPE_CFINB in Cart-cell. + AREAVARS(1:MAX_DIM+1,NFACE_CELL) = (/ MESHES(NM)%CUT_FACE(CEI)%INXAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%INXSQAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%JNYSQAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%KNZSQAREA(ICF) /)*FCT + ! Normal out of cut-cell. + FACE_CELL(1,NFACE_CELL) = NP + DO IP=2,NP+1 + FNOD = MESHES(NM)%CUT_FACE(CEI)%CFELEM(IP,ICF) + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_FACE(CEI)%XYZVERT(IAXIS:KAXIS,FNOD) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) + FACE_CELL(IP,NFACE_CELL) = INOD + ENDDO + ! At this point the face in face cell is ordered + ! throught the normal outside the body. Reorganize + ! to normal outside cut-cell (inside body). + FACE_CELL_DUM(1:NP+1) = FACE_CELL(1:NP+1,NFACE_CELL) + DO IP=2,NP+1 + FACE_CELL(IP,NFACE_CELL) = FACE_CELL_DUM( (NP+1)+2-IP ) + ENDDO + ENDDO + ENDIF - ! Test for face with INB edges: - ! If outface2 is true -> no INB Edges associated with this face: - OUTFACE2 = (MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) <= 0) + ! IF(I==14 .AND. J==2 .AND. K==6) THEN + ! WRITE(LU_ERR,*) 'CC 1 I,J,K,INB NFACE,NFACE_CELL=',I,J,K,& + ! MESHES(NM)%CUT_FACE(CEI)%NFACE,NFACE_CELL + ! OPEN(666,FILE='VERTS.txt',STATUS='REPLACE') + ! DO IP=1,NVERT_CELL + ! WRITE(666,*) XYZVERT(1:3,IP) + ! ENDDO + ! CLOSE(666) + ! IFACE=MAXVAL(FACE_CELL(1,1:NFACE_CELL)) + ! OPEN(666,FILE='FACES.txt',STATUS='REPLACE') + ! DO IP=1,NFACE_CELL + ! WRITE(666,*) FACE_CELL(1:IFACE+1,IP),FACE_LIST(1,IP) + ! ENDDO + ! CLOSE(666) + ! ENDIF - ! Drop if outface1 & outface2 - IF (OUTFACE1 .AND. OUTFACE2) THEN - ! Test if face is SOLID: - IF ((MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) == CC_SOLID) ) THEN - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID - ENDIF - CYCLE - ENDIF + ! Here we have in XYZvert all the vertices that define the + ! cut-cells within Cartesian cell I,J,K. We have the faces, + ! boundary of said cut-cells in face_cell. + ! We have in face_list the list of cut-cell boundary faces + ! and if they are regular or cut-face. + ! We want to reorder face list, such that we have the + ! subgroups of faces that make cut-cells. - ENDDO ! JJ - ENDDO ! KK - ENDDO ! II + ! Make list of edges: + EDGFAC_CELL(:,:) = CC_UNDEFINED + FACEDG_CELL(:,:) = CC_UNDEFINED - ENDDO XIAXIS_LOOP_2 + ! Here reallocate FACEDG_CELL if NFACE_CELL > SIZE_CFELEM_FACEDG: + IF (NFACE_CELL > SIZE_CFELEM_FACEDG) THEN + DFCT = CEILING(REAL(NFACE_CELL-SIZE_CFELEM_FACEDG,EB)/REAL(DELTA_FACE,EB)) + ALLOCATE(FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG+DFCT*DELTA_FACE)); + FACEDG_CELL_AUX = CC_UNDEFINED + ! Copy data into FACEDG_CELL_AUX: + FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & + FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) + ! New SIZE_CFELEM_FACEDG: + SIZE_CFELEM_FACEDG = SIZE_CFELEM_FACEDG + DFCT*DELTA_FACE + DEALLOCATE(FACEDG_CELL); ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) + ! Dump data back into FACEDG_CELL: + FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & + FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) + DEALLOCATE(FACEDG_CELL_AUX) + ENDIF -ELSE - DEALLOCATE(IJK_COUNTED) -ENDIF + DO IFACE=1,NFACE_CELL + NIEDGE = FACE_CELL(1,IFACE) -DEALLOCATE(NODEDG_FACE) -DEALLOCATE(CFELEM,CEDGES,CFE,CFEL) + ! Here reallocate if NIEDGE > SIZE_CEELEM_FACEDG: + IF (NIEDGE > SIZE_CEELEM_FACEDG) THEN + DFCT = CEILING(REAL(NIEDGE-SIZE_CEELEM_FACEDG,EB)/REAL(DELTA_EDGE,EB)) + ALLOCATE(FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG+DFCT*DELTA_EDGE,1:SIZE_CFELEM_FACEDG)); + FACEDG_CELL_AUX = CC_UNDEFINED + ! Copy data into FACEDG_CELL_AUX: + FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & + FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) + ! New SIZE_CEELEM_FACEDG: + SIZE_CEELEM_FACEDG = SIZE_CEELEM_FACEDG + DFCT*DELTA_EDGE + DEALLOCATE(FACEDG_CELL); ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) + ! Dump data back into FACEDG_CELL: + FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & + FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) + DEALLOCATE(FACEDG_CELL_AUX) + DEALLOCATE(IPTS); ALLOCATE(IPTS(1:SIZE_CEELEM_FACEDG+1)) + ENDIF -T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW + IPTS(1:NIEDGE) = FACE_CELL(2:NIEDGE+1,IFACE); IPTS(NIEDGE+1) = FACE_CELL(2,IFACE) + DO IEDGE=1,NIEDGE + SEG(NOD1:NOD2)= (/ IPTS(IEDGE), IPTS(IEDGE+1) /) + INLIST = .FALSE. + DO ISEG=1,NSEG_CELL + TEST1 = (SEG_CELL(NOD1,ISEG) == SEG(NOD1)) .AND. (SEG_CELL(NOD2,ISEG) == SEG(NOD2)) + TEST2 = (SEG_CELL(NOD2,ISEG) == SEG(NOD1)) .AND. (SEG_CELL(NOD1,ISEG) == SEG(NOD2)) -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - NCUTFCE = 0 - IF (BNDINT_FLAG) THEN - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_GASPHASE) CYCLE - NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE - ENDDO - ELSE - DO ICF=MESHES(NM)%N_CUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_GASPHASE) CYCLE - NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE - ENDDO - ENDIF - WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-faces : ',NCUTFCE,'. ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-faces : ',NCUTFCE,'. ' - ENDIF -ENDIF + IF ( TEST1 .OR. TEST2 ) THEN + INLIST = .TRUE. + EXIT + ENDIF + enddo + IF (.NOT.INLIST) THEN + NSEG_CELL = NSEG_CELL + 1 -RETURN + ! Test the NSEG_CELL doesn't overrun SIZE_CEELEM_EDGFAC, if so reallocate EDGFAC_CELL: + IF(NSEG_CELL > SIZE_CEELEM_EDGFAC) THEN + ! 1. EDGFAC_CELL: + ALLOCATE(EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC+DELTA_EDGE)); + EDGFAC_CELL_AUX = CC_UNDEFINED + ! Copy data into EDGFAC_CELL_AUX: + EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & + EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) + ! 1. SEG_CELL: + ALLOCATE(SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC+DELTA_EDGE)); SEG_CELL_AUX = CC_UNDEFINED + ! Copy data to SEG_CELL_AUX: + SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) = SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) -CONTAINS + ! New SIZE_CEELEM_EDGFAC: + SIZE_CEELEM_EDGFAC = SIZE_CEELEM_EDGFAC + DELTA_EDGE -SUBROUTINE REALLOCATE_NODEDG_FACE(N_SEG_CFACE,N_VERT_CFACE) + ! 2. EDGFAC_CELL: + DEALLOCATE(EDGFAC_CELL); ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) + ! Dump data back into EDGFAC_CELL: + EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & + EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) + DEALLOCATE(EDGFAC_CELL_AUX) + ! 2. SEG_CELL: + DEALLOCATE(SEG_CELL); ALLOCATE(SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC)) + ! Dump data back into SEG_CELL: + SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) = SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) + DEALLOCATE(SEG_CELL_AUX) + ENDIF + SEG_CELL(NOD1:NOD2,NSEG_CELL) = SEG(NOD1:NOD2) + NEF = 1 + EDGFAC_CELL(1,NSEG_CELL) = NEF + EDGFAC_CELL(NEF+1,NSEG_CELL)= IFACE + FACEDG_CELL(IEDGE,IFACE) = NSEG_CELL + ELSE + NEF = EDGFAC_CELL(1,ISEG) + 1 + ! Test NEF+1 doesn't overrun SIZE_CFELEM_EDGFAC, if so reallocate EDGFAC_CELL: + IF(NEF+1 > SIZE_CFELEM_EDGFAC) THEN + ALLOCATE(EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC+DELTA_FACE,1:SIZE_CEELEM_EDGFAC)); + EDGFAC_CELL_AUX = CC_UNDEFINED + ! Copy data into EDGFAC_CELL_AUX: + EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & + EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) + ! New SIZE_CFELEM_EDGFAC: + SIZE_CFELEM_EDGFAC = SIZE_CFELEM_EDGFAC + DELTA_FACE + DEALLOCATE(EDGFAC_CELL); ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) + ! Dump data back into EDGFAC_CELL: + EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & + EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) + DEALLOCATE(EDGFAC_CELL_AUX) + ENDIF + EDGFAC_CELL(1,ISEG) = NEF + EDGFAC_CELL(NEF+1,ISEG) = IFACE + FACEDG_CELL(IEDGE,IFACE) = ISEG + ENDIF + ENDDO + ENDDO -INTEGER, INTENT(IN) :: N_SEG_CFACE,N_VERT_CFACE -INTEGER :: DFCTE,DFCTV + ! Then loop is on faces that have all regular edges, + ! that is, edges shared with only one another face: + ! Reallocate FACECELL_NUM if NFACE_CELL > SIZE(FACECELL_NUM,DIM=1): + NUM_FACE = SIZE(FACECELL_NUM,DIM=1) + IF (NFACE_CELL > NUM_FACE) THEN + DFCT = CEILING(REAL(NFACE_CELL-NUM_FACE,EB)/REAL(DELTA_FACE,EB)) + DEALLOCATE(FACECELL_NUM); ALLOCATE(FACECELL_NUM(1:NFACE_CELL+DFCT*DELTA_FACE)) + ENDIF -IF ( (N_SEG_CFACE+1 > SIZE_EDGES_NODEDG) .OR. (N_VERT_CFACE > SIZE_VERTS_NODEDG)) THEN - ! Allocation factors: - DFCTE = MAX(0,CEILING(REAL(N_SEG_CFACE+1-SIZE_EDGES_NODEDG,EB)/REAL(DELTA_EDGE,EB))) - DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE -SIZE_VERTS_NODEDG,EB)/REAL(DELTA_VERT,EB))) - DEALLOCATE(NODEDG_FACE) - SIZE_VERTS_NODEDG = SIZE_VERTS_NODEDG + DFCTV*DELTA_VERT - SIZE_EDGES_NODEDG = SIZE_EDGES_NODEDG + DFCTE*DELTA_EDGE - ALLOCATE(NODEDG_FACE(1:SIZE_EDGES_NODEDG,1:SIZE_VERTS_NODEDG)) -ENDIF -RETURN -END SUBROUTINE REALLOCATE_NODEDG_FACE + FACECELL_NUM = 0 + ICELL = 1 + IFACE = 1 + NUM_FACE = NFACE_CELL + CTVAL2 = 0 + MAXSEG = MAXVAL(FACE_CELL(1,1:NFACE_CELL)) + THRES = HUGE(1); IF(REAL(MAXSEG*NFACE_CELL,EB)**2 0 ) CYCLE -IF ( (N_FACE_CFACE > SIZE_CFACES_CFELEM) .OR. (N_VERT_CFACE+1 > SIZE_VERTS_CFELEM)) THEN - DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE+1-SIZE_VERTS_CFELEM,EB)/REAL(DELTA_VERT,EB))) - DFCTF = MAX(0,CEILING(REAL(N_FACE_CFACE-SIZE_CFACES_CFELEM,EB)/REAL(DELTA_FACE,EB))) - DEALLOCATE(CFELEM) - SIZE_CFACES_CFELEM = SIZE_CFACES_CFELEM + DFCTF*DELTA_FACE - SIZE_VERTS_CFELEM = SIZE_VERTS_CFELEM + DFCTV*DELTA_VERT - ALLOCATE(CFELEM(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) - DEALLOCATE(CFE,CFEL); ALLOCATE(CFE(1:SIZE_VERTS_CFELEM),CFEL(1:SIZE_VERTS_CFELEM)) - IF(ALLOCATED(CEDGES)) DEALLOCATE(CEDGES); ALLOCATE(CEDGES(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) -ENDIF -RETURN -END SUBROUTINE REALLOCATE_LOCAL_CFELEM + ! New face, not counted: + FACECELL_NUM(JFACE) = ICELL + NEWFACE = .TRUE. + NUM_FACE = NUM_FACE-1 + EXIT + ENDDO + ENDIF + IF (NEWFACE) THEN + IFACE = JFACE + EXIT + ENDIF + ENDDO + ! Test for all faces that have regular edges with faces that belong to icell: + IF (.NOT.NEWFACE) THEN + KFACE_LOOP : DO KFACE=1,NFACE_CELL + IF ( FACECELL_NUM(KFACE) == 0 ) THEN ! Not associated yet + NFACEK = FACE_CELL(1,KFACE) + DO ISEG=1,NFACEK + LOCSEG = FACEDG_CELL(ISEG,KFACE) + IF ( EDGFAC_CELL(1,LOCSEG) == 2) THEN ! Found a regular edge + DO JJ=2,EDGFAC_CELL(1,LOCSEG)+1 + JFACE = EDGFAC_CELL(JJ,LOCSEG) + IF ( KFACE == JFACE ) CYCLE + IF ( FACECELL_NUM(JFACE) /= ICELL) CYCLE + ! New face, not counted: + FACECELL_NUM(KFACE) = FACECELL_NUM(JFACE) + NEWFACE = .TRUE. + IFACE = KFACE + NUM_FACE = NUM_FACE-1 + EXIT KFACE_LOOP + ENDDO + ENDIF + ENDDO + ENDIF + ENDDO KFACE_LOOP + ENDIF -SUBROUTINE REALLOCATE_LOCAL_VERT_CFELEM(N_VERT_CFACE) + ! Haven't found new face, either num_face=0, or we need a new icell: + IF (.NOT.NEWFACE) EXIT INF_LOOP2 + CTVAL = CTVAL + 1 + IF (CTVAL > THRES) THEN + CYCLE_CELL = .TRUE. + EXIT INF_LOOP2 + ENDIF -INTEGER, INTENT(IN) :: N_VERT_CFACE -INTEGER :: DFCTV -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM_AUX,CEDGES_AUX + ENDDO INF_LOOP2 + ! Test if there are any faces left: + IF ( NUM_FACE <= 0 ) THEN + EXIT + ELSE ! New cell, find new face set iface + DO IFACE=1,NFACE_CELL + IF (FACECELL_NUM(IFACE) == 0) THEN ! NOT COUNTED YET. + ! ASSUMES IT HAS AT LEAST ONE REGULAR EDGE. + ICELL = ICELL + 1 + EXIT + ENDIF + ENDDO + IF(IFACE > NFACE_CELL) EXIT INF_LOOP1 ! Case all faces associated. + ENDIF + CTVAL2 = CTVAL2 + 1 + IF (CTVAL2 > THRES) CYCLE_CELL = .TRUE. + IF (CYCLE_CELL) EXIT INF_LOOP1 + ENDDO INF_LOOP1 -IF( N_VERT_CFACE > SIZE_VERTS_CFELEM ) THEN - DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE-SIZE_VERTS_CFELEM,EB)/REAL(DELTA_VERT,EB))) - ALLOCATE(CFELEM_AUX(1:SIZE_VERTS_CFELEM+DFCTV*DELTA_VERT,1:SIZE_CFACES_CFELEM)) - CFELEM_AUX(:,:) = CC_UNDEFINED - CFELEM_AUX(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) = CFELEM(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) - ALLOCATE(CEDGES_AUX(1:SIZE_VERTS_CFELEM+DFCTV*DELTA_VERT,1:SIZE_CFACES_CFELEM)) - CEDGES_AUX(:,:) = CC_UNDEFINED - CEDGES_AUX(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) = CEDGES(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) - SIZE_VERTS_CFELEM = SIZE_VERTS_CFELEM + DFCTV*DELTA_VERT - CALL MOVE_ALLOC(FROM=CFELEM_AUX,TO=CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=CEDGES) - ! Now Reallocate CFE, CFEL: - DEALLOCATE(CFE,CFEL); ALLOCATE(CFE(1:SIZE_VERTS_CFELEM),CFEL(1:SIZE_VERTS_CFELEM)) -ENDIF -RETURN -END SUBROUTINE REALLOCATE_LOCAL_VERT_CFELEM + CYCLE_CELL_COND : IF (CYCLE_CELL) THEN + CELLRT(I,J,K) = .TRUE. + MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 + ! Here if needed reallocate SPCELL_LIST: + NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) + IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN + ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) + DEALLOCATE(MESHES(NM)%SPCELL_LIST) + ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED + DEALLOCATE(SPCELL_LIST) + ENDIF + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) + ! Add to cells to block list: + N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK + 1 + CTVAL = SIZE(SPCELLS_TO_BLOCK,DIM=1) + IF( CTVAL 0) THEN + IBOD = 1; ITRI = 1 + IF (MESHES(NM)%CUT_FACE(IDCF)%NFACE > 0) THEN + IBOD = MESHES(NM)%CUT_FACE(IDCF)%BODTRI(1,1) + ITRI = MESHES(NM)%CUT_FACE(IDCF)%BODTRI(2,1) + ENDIF + CALL FACE_DEALLOC(NM,IDCF) + CALL NEW_FACE_ALLOC(NM,IDCF,8,6,4+1) ! Reallocate CUT_FACE entry with 8 vertices, 6 faces, 4 verts per face. + NIBFACE = 0 + XYZVERT = 0._EB + NVERT_CELL = 0 + CFELEM = 0 + ! Define from SOLID FACES CFACES for the cell: + IED = I-1; JED = J-1; KED = K-1 + AXIS_LOOP : DO MYAXIS=IAXIS,KAXIS + SELECT CASE(MYAXIS) + CASE(IAXIS) + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) + AREAI = DYCELL(J) * DZCELL(K) + CASE(JAXIS) + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) + AREAI = DXCELL(I) * DZCELL(K) + CASE(KAXIS) + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) + AREAI = DXCELL(I) * DYCELL(J) + END SELECT + SIDE_LOOP : DO SIDE=LOW_IND,HIGH_IND + IF (FSID_XYZ(SIDE ,MYAXIS) /= CC_SOLID) CYCLE SIDE_LOOP + NIBFACE = NIBFACE + 1 + ! Define vertices of CFACE and insert add to MESHES(NM)%CUT_FACE(IDCF)%XYZVERT + NP = 0 + XYZC(IAXIS:KAXIS) = 0._EB + DO IP=NOD1,NOD4 + ! xl,yl,zl + XYZ(IAXIS:KAXIS) = XYZLH(IAXIS:KAXIS,IP,SIDE) + XYZC(IAXIS:KAXIS)= XYZC(IAXIS:KAXIS) + XYZ(IAXIS:KAXIS) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) + NP = NP + 1 + CFELEM(1) = NP + CFELEM(NP+1) = INOD + ENDDO -! ---------------- DEFINE_REGULAR_CUTFACES -------------------------- + ! Define CFELEM connectivity, also CFACE area and Centroid add to corresponding CUT_FACE(IDCF) entries. + MESHES(NM)%CUT_FACE(IDCF)%CFELEM(1:5,NIBFACE) = CFELEM(1:5) + MESHES(NM)%CUT_FACE(IDCF)%AREA(NIBFACE) = AREAI + MESHES(NM)%CUT_FACE(IDCF)%XYZCEN(IAXIS:KAXIS,NIBFACE) = 0.25_EB*XYZC(IAXIS:KAXIS) + ! Fields for cut-cell volume/centroid computation: + MESHES(NM)%CUT_FACE(IDCF)%INXAREA(NIBFACE) = 0._EB + MESHES(NM)%CUT_FACE(IDCF)%INXSQAREA(NIBFACE) = 0._EB + MESHES(NM)%CUT_FACE(IDCF)%JNYSQAREA(NIBFACE) = 0._EB + MESHES(NM)%CUT_FACE(IDCF)%KNZSQAREA(NIBFACE) = 0._EB -SUBROUTINE DEFINE_REGULAR_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) + ! Define Body-triangle reference: + MESHES(NM)%CUT_FACE(IDCF)%BODTRI(1:2,NIBFACE)= (/ IBOD, ITRI /) -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -LOGICAL, INTENT(IN) :: BNDINT_FLAG + ! Assign surf-index: Depending on GEOMETRY: + ! Here we might just add the INERT SURF_ID: + MESHES(NM)%CUT_FACE(IDCF)%SURF_INDEX(NIBFACE) = GEOMETRY(IBOD)%SURFS(ITRI) -! Local Variables: -INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI,X1AXIS,NVERT,NFACE,I,J,K,NCUTFACE -INTEGER :: IBNDINT,BNDINT_LOW,BNDINT_HIGH + ! Finally add to FACE_LIST from N_GAS_CFACES on: + NFACE_CELL = N_GAS_CFACES + NIBFACE + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB,0,0,IDCF, NIBFACE,CC_UNDEFINED /) + ENDDO SIDE_LOOP + ENDDO AXIS_LOOP + IF(NIBFACE==0) THEN + MESHES(NM)%CUT_FACE(IDCF)%STATUS = CC_SOLID + MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED + ELSE + MESHES(NM)%CUT_FACE(IDCF)%NFACE = NIBFACE + MESHES(NM)%CUT_FACE(IDCF)%NVERT = NVERT_CELL + MESHES(NM)%CUT_FACE(IDCF)%XYZVERT(IAXIS:KAXIS,1:NVERT_CELL) = XYZVERT(IAXIS:KAXIS,1:NVERT_CELL) + ENDIF + ENDIF IDCF_COND -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED + ! Now define a coarse cut-cell (no INBOUNDARY cut-faces): + NCELL = 1 + ! Test NFACE_CELL not > SIZE_FACE_CCELEM: + IF (NFACE_CELL > SIZE_FACE_CCELEM) THEN + DFCT = CEILING(REAL(NFACE_CELL-SIZE_FACE_CCELEM,EB)/REAL(DELTA_FACE,EB)) + SIZE_FACE_CCELEM = SIZE_FACE_CCELEM + DFCT*DELTA_FACE + DEALLOCATE(CCELEM) + ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) + ENDIF + CCELEM(1:NFACE_CELL+1,NCELL) = (/ NFACE_CELL, (IFACE, IFACE=1,NFACE_CELL) /) + VOL(NCELL) = DXCELL(I)*DYCELL(J)*DZCELL(K) + NOADVANCE(NCELL) = NOT_BLOCKED + XYZCEN(IAXIS:KAXIS,NCELL) = (/ XCELL(I), YCELL(J), ZCELL(K) /) -CALL POINT_TO_MESH(NM) + ELSE CYCLE_CELL_COND -! Mesh sizes: -NXB=IBAR -NYB=JBAR -NZB=KBAR + ! Create CCELEM array: + NCELL = MAXVAL(FACECELL_NUM(:)) + ! Test NCELL not > SIZE_CELL_CCELEM; NFACE_CELL not > SIZE_FACE_CCELEM: + IF (NFACE_CELL > SIZE_FACE_CCELEM) THEN + DFCT = CEILING(REAL(NFACE_CELL-SIZE_FACE_CCELEM,EB)/REAL(DELTA_FACE,EB)) + SIZE_FACE_CCELEM = SIZE_FACE_CCELEM + DFCT*DELTA_FACE + DEALLOCATE(CCELEM) + ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) + ENDIF + IF (NCELL > SIZE_CELL_CCELEM) THEN + DFCT = CEILING(REAL(NCELL-SIZE_CELL_CCELEM,EB)/REAL(DELTA_CELL,EB)) + SIZE_CELL_CCELEM = SIZE_CELL_CCELEM + DFCT*DELTA_CELL + DEALLOCATE(CCELEM,NOADVANCE,VOL,XYZCEN) + ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) + ALLOCATE(NOADVANCE(1:SIZE_CELL_CCELEM),VOL(1:SIZE_CELL_CCELEM),XYZCEN(IAXIS:KAXIS,1:SIZE_CELL_CCELEM)) + ENDIF + CCELEM= CC_UNDEFINED + DO ICELL=1,NCELL + NP = 0 + DO IFACE=1,NFACE_CELL + IF ( FACECELL_NUM(IFACE) == ICELL ) THEN + NP = NP + 1 + CCELEM(1,ICELL) = NP + CCELEM(NP+1,ICELL) = IFACE + ENDIF + ENDDO + ENDDO -! Test Sizes: -IF (PERIODIC_TEST == 7 ) THEN - VAL_TESTX_LOW =-.5_EB - VAL_TESTX_HIGH= .5_EB - VAL_TESTY_LOW = YS - VAL_TESTY_HIGH= YF - VAL_TESTZ_LOW =-.5_EB - VAL_TESTZ_HIGH= .5_EB -ELSEIF (PERIODIC_TEST == 11) THEN - VAL_TESTX_LOW =-.5_EB - VAL_TESTX_HIGH= .5_EB - VAL_TESTY_LOW = YS - VAL_TESTY_HIGH= YF - VAL_TESTZ_LOW = ZS - VAL_TESTZ_HIGH= ZF -ELSEIF (PERIODIC_TEST == 103) THEN - VAL_TESTX_LOW =-1.0_EB - VAL_TESTX_HIGH= 1.0_EB - VAL_TESTY_LOW =-1.0_EB - VAL_TESTY_HIGH= 1.0_EB - VAL_TESTZ_LOW = 1.0_EB - VAL_TESTZ_HIGH= 3.0_EB -ENDIF + ! Compute volumes and centroids for the found cut-cells: + VOL(1:NCELL) = 0._EB + NOADVANCE(1:NCELL) = NOT_BLOCKED + XYZCEN(IAXIS:KAXIS,1:NCELL) = 0._EB + DO ICELL=1,NCELL + NP = CCELEM(1,ICELL) + DO II=2,NP+1 + IFACE = CCELEM(II,ICELL) + ! Volume: + VOL(ICELL) = VOL(ICELL) + AREAVARS(1,IFACE) + ! xyzcen: + XYZCEN(IAXIS:KAXIS,ICELL) = XYZCEN(IAXIS:KAXIS,ICELL)+AREAVARS(2:4,IFACE) + ENDDO + VOL(ICELL) = ABS(VOL(ICELL)) + ! Define if cut-cell is very small -> NOADVANCE(ICELL)=BLOCKED_SMALL_CELL: + IF(DO_NOADVANCE .AND. VOL(ICELL)/(DXCELL(I)*DYCELL(J)*DZCELL(K))DXCELL(I)*DYCELL(J)*DZCELL(K)) VOL(ICELL) = DXCELL(I)*DYCELL(J)*DZCELL(K) + IF(VOL(ICELL) < GEOMEPS) THEN ! Volume too small for correct calculation of XYZCEN-> take cartcell centroid. + IF(.NOT.DO_NOADVANCE .AND. VOL(ICELL)XFACE(I)) XYZCEN(IAXIS,ICELL) = XCELL(I) + IF(XYZCEN(JAXIS,ICELL)YFACE(J)) XYZCEN(JAXIS,ICELL) = YCELL(J) + IF(XYZCEN(KAXIS,ICELL)ZFACE(K)) XYZCEN(KAXIS,ICELL) = ZCELL(K) + ENDIF + ENDDO -! Main Loop on block NM: -IF (BNDINT_FLAG) THEN - ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. - BNDINT_LOW = 1 - BNDINT_HIGH = 3 -ELSE - BNDINT_LOW = 4 - BNDINT_HIGH = 4 -ENDIF + ENDIF CYCLE_CELL_COND -IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, - ! 4 guard-cell faces. + ! Load into CUT_CELL data structure + NCUTCELL = MESHES(NM)%N_CUTCELL_MESH + MESHES(NM)%N_GCCUTCELL_MESH + 1 + IF (IBNDINT==LOW_IND) THEN + MESHES(NM)%N_CUTCELL_MESH = NCUTCELL + ELSE + MESHES(NM)%N_GCCUTCELL_MESH = MESHES(NM)%N_GCCUTCELL_MESH + 1 + ENDIF + MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = NCUTCELL - ! When switching to internal faces, copy number of external faces already computed. - IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + ! Resize array MESHES(NM)%CUT_CELL if necessary: + CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) - ! First tag and define Gasphase cut-faces in X,Y,Z directions. - ! X direction: - ! IAXIS gasphase cut-faces: - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - ILO = ILO_FACE; IHI = ILO_FACE - CASE(2) - ILO = IHI_FACE; IHI = IHI_FACE - CASE(3) - ILO = ILO_FACE+1; IHI = IHI_FACE-1 - CASE(4) - ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT - X1AXIS=IAXIS - NVERT = 4 - NFACE = 1 - DO I=ILO,IHI - DO J=JLO,JHI - DO K=KLO,KHI + ! Add cut-cell NCUTCELL entry: + MESHES(NM)%CUT_CELL(NCUTCELL)%IJK(IAXIS:KAXIS) = (/ I, J, K /) + MESHES(NM)%CUT_CELL(NCUTCELL)%NCELL = NCELL + MESHES(NM)%CUT_CELL(NCUTCELL)%NFACE_CELL= NFACE_CELL + NCFACE_CUTCELL = MAXVAL(CCELEM(1,1:NCELL)) + 1 + CALL NEW_CELL_ALLOC(NM,NCUTCELL,NCELL,NFACE_CELL,NCFACE_CUTCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%CCELEM(1:NCFACE_CUTCELL,1:NCELL) = CCELEM(1:NCFACE_CUTCELL,1:NCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) = & + FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%VOLUME(1:NCELL) = VOL(1:NCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%XYZCEN(IAXIS:KAXIS,1:NCELL) = XYZCEN(IAXIS:KAXIS,1:NCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%NOADVANCE(1:NCELL) = NOADVANCE(1:NCELL) - ! If cut-cell centroid is outside the test box -> drop: - IF(XFACE(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XFACE(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE - IF(YCELL(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YCELL(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE - IF(ZCELL(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZCELL(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE + ! Test for sliver cells blocking: + XYZCELL(IAXIS,LOW_IND) = XFACE(I-1); XYZCELL(IAXIS,HIGH_IND) = XFACE(I); + XYZCELL(JAXIS,LOW_IND) = YFACE(J-1); XYZCELL(JAXIS,HIGH_IND) = YFACE(J); + XYZCELL(KAXIS,LOW_IND) = ZFACE(K-1); XYZCELL(KAXIS,HIGH_IND) = ZFACE(K); + MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) + MINMAX_XYZ_CC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) + DO JCC=1,NCELL + ! Get cut-cell bounding box: + CALL CUT_CELL_BOUNDING_BOX(NM,NCUTCELL,JCC,XYZCELL,MINMAX_XYZ_CC) + ! Perform Tests: + DO MYAXIS=IAXIS,KAXIS + CELL_DELTA(MYAXIS) = ABS(MINMAX_XYZ_CC(MYAXIS,HIGH_IND)-MINMAX_XYZ_CC(MYAXIS,LOW_IND)) + ENDDO + ! Axis with minimum width: + AX_MIN = MINLOC(CELL_DELTA(IAXIS:KAXIS),DIM=1) + SELECT CASE(AX_MIN) + CASE(IAXIS); AX_OTHERS(1:2) = (/ JAXIS, KAXIS /); + CASE(JAXIS); AX_OTHERS(1:2) = (/ IAXIS, KAXIS /); + CASE(KAXIS); AX_OTHERS(1:2) = (/ IAXIS, JAXIS /); + END SELECT + ! Perform Test: + BLOCK_SLIM_IF = (CELL_DELTA(AX_MIN) MESHES(NM)%CUT_FACE(NCUTFACE) +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + NCUTCEL = 0 + DO ICELL=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + NCUTCEL = NCUTCEL + MESHES(NM)%CUT_CELL(ICELL)%NCELL + ENDDO + WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-cells mesh/gc : ',NCUTCEL,'. ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-cells mesh/gc : ',NCUTCEL,'. ' + ENDIF +ENDIF - ! Vertices: - CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) - CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) - CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) - CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) +RETURN - ! Centroid: - CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & - (/ XFACE(I )+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) +CONTAINS - ! Load Ordered nodes to CFELEM and geom properties: - CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) - CF%AREA(NFACE) = DYCELL(J)*DZCELL(K) +SUBROUTINE REALLOCATE_LOCAL_FC_VARS - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: - CF%INXAREA(NFACE) = XFACE(I)*CF%AREA(NFACE) - ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: - CF%INXSQAREA(NFACE) = XFACE(I)**2._EB*CF%AREA(NFACE) - ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: - CF%JNYSQAREA(NFACE) = 0._EB - ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: - CF%KNZSQAREA(NFACE) = 0._EB - ENDDO - ENDDO - ENDDO +IF (NFACE_CELL > SIZE_CFELEM_FC) THEN + ! FACE_LIST, AREAVARS, FACE_CELL + ALLOCATE(FACE_LIST_AUX(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC+DELTA_FACE)); + FACE_LIST_AUX=CC_UNDEFINED + ALLOCATE(AREAVARS_AUX(1:MAX_DIM+1,1:SIZE_CFELEM_FC+DELTA_FACE)); AREAVARS_AUX = 0._EB + ALLOCATE(FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC+DELTA_FACE)); + FACE_CELL_AUX=CC_UNDEFINED + ! Assign: + FACE_LIST_AUX(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)= & + FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC) + AREAVARS_AUX(1:MAX_DIM+1,1:SIZE_CFELEM_FC) = AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC) + FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) = & + FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) + ! Reallocate: + SIZE_CFELEM_FC = SIZE_CFELEM_FC + DELTA_FACE + DEALLOCATE(FACE_LIST,AREAVARS,FACE_CELL); + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)) + ALLOCATE(AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC)) + ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) + ! Dump back data: + FACE_LIST(:,:) = FACE_LIST_AUX(:,:) + AREAVARS(:,:) = AREAVARS_AUX(:,:) + FACE_CELL(:,:) = FACE_CELL_AUX(:,:) + DEALLOCATE(FACE_LIST_AUX,AREAVARS_AUX,FACE_CELL_AUX) +ENDIF +RETURN +END SUBROUTINE REALLOCATE_LOCAL_FC_VARS - ! Y direction: - ! JAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - JLO = JLO_FACE; JHI = JLO_FACE - CASE(2) - JLO = JHI_FACE; JHI = JHI_FACE - CASE(3) - JLO = JLO_FACE+1; JHI = JHI_FACE-1 - CASE(4) - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT - X1AXIS=JAXIS - NVERT = 4 - NFACE = 1 - DO I=ILO,IHI - DO J=JLO,JHI - DO K=KLO,KHI +SUBROUTINE REALLOCATE_FACE_CELL_VERTS - ! If cut-cell centroid is outside the test box -> drop: - IF(XCELL(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XCELL(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE - IF(YFACE(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YFACE(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE - IF(ZCELL(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZCELL(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE +IF (NP+1 > SIZE_VERTS_FC) THEN + DFCT=CEILING(REAL(NP+1-SIZE_VERTS_FC,EB)/REAL(DELTA_VERT,EB)) + ALLOCATE(FACE_CELL_AUX(1:SIZE_VERTS_FC+DFCT*DELTA_VERT,1:SIZE_CFELEM_FC)); + FACE_CELL_AUX=CC_UNDEFINED + ! Assign: + FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) = & + FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) + ! Reallocate: + SIZE_VERTS_FC = SIZE_VERTS_FC + DFCT*DELTA_VERT + DEALLOCATE(FACE_CELL); ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) + FACE_CELL(:,:) = FACE_CELL_AUX(:,:) + DEALLOCATE(FACE_CELL_AUX) + ! Now FACE_CELL_DUM: + DEALLOCATE(FACE_CELL_DUM); ALLOCATE(FACE_CELL_DUM(1:SIZE_VERTS_FC)) +ENDIF - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. +RETURN +END SUBROUTINE REALLOCATE_FACE_CELL_VERTS - FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE +END SUBROUTINE GET_CARTCELL_CUTCELLS - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE +! ------------------------ CUT_CELL_BOUNDING_BOX ------------------------------------ - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +SUBROUTINE CUT_CELL_BOUNDING_BOX(NM,ICC,JCC,XYZCELL,MINMAX_XYZ_JCC) - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, X1AXIS /) - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERT+1,IBNDINT) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) +! Computes bounding box for cut-cell (ICC,JCC) in mesh NM. +! Underlaying cartesian cell bounds XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND) has to be provided. - ! Vertices: - CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) - CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) - CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) - CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) +INTEGER, INTENT(IN) :: NM,ICC,JCC +REAL(EB),INTENT(IN) :: XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND) +REAL(EB),INTENT(OUT):: MINMAX_XYZ_JCC(IAXIS:KAXIS,LOW_IND:HIGH_IND) - ! Centroid: - CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & - (/ XFACE(I-1)+XFACE(I ), YFACE(J )+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) +! Local Variables: +INTEGER :: IFC,IFACE,LOHI,HILO,X1AXIS,IFCX,JFCX,IVERT,AXIS +REAL(EB):: XYZFACE(IAXIS:KAXIS,LOW_IND:HIGH_IND),XYZ(IAXIS:KAXIS) +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTFACE_TYPE), POINTER :: CF - ! Load Ordered nodes to CFELEM and geom properties: - CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) - CF%AREA(NFACE) = DXCELL(I)*DZCELL(K) +CC => MESHES(NM)%CUT_CELL(ICC) - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: - CF%INXAREA(NFACE) = 0._EB - ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: - CF%INXSQAREA(NFACE) = 0._EB - ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: - CF%JNYSQAREA(NFACE) = YFACE(J)**2._EB*CF%AREA(NFACE) - ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: - CF%KNZSQAREA(NFACE) = 0._EB +! Get cut-cell bounding box: +MINMAX_XYZ_JCC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) +MINMAX_XYZ_JCC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) +DO IFC=1,CC%CCELEM(1,JCC) ! Loop over cut-faces boundary of this cell. + IFACE=CC%CCELEM(IFC+1,JCC) + LOHI = CC%FACE_LIST(2,IFACE) + HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND + X1AXIS = CC%FACE_LIST(3,IFACE) + IFCX = CC%FACE_LIST(4,IFACE) + JFCX = CC%FACE_LIST(5,IFACE) + + SELECT CASE(CC%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_RCGAS) ! Regular Gas face with a regular cell on one side and a cut-cell on the other. + XYZFACE = XYZCELL; XYZFACE(X1AXIS,HILO) = XYZFACE(X1AXIS,LOHI) ! Same location in X1AXIS for both sides of face. + DO AXIS=IAXIS,KAXIS + MINMAX_XYZ_JCC(AXIS,LOW_IND) = MIN(MINMAX_XYZ_JCC(AXIS,LOW_IND) ,XYZFACE(AXIS,LOW_IND)) + MINMAX_XYZ_JCC(AXIS,HIGH_IND)= MAX(MINMAX_XYZ_JCC(AXIS,HIGH_IND),XYZFACE(AXIS,HIGH_IND)) + ENDDO + + CASE(CC_FTYPE_CFGAS,CC_FTYPE_CFINB) ! GAS or Boundary cut-face: + CF => MESHES(NM)%CUT_FACE(IFCX) + DO IVERT=1,CF%CFELEM(1,JFCX) + XYZ(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(IVERT+1,JFCX)) + DO AXIS=IAXIS,KAXIS + MINMAX_XYZ_JCC(AXIS,LOW_IND) = MIN(MINMAX_XYZ_JCC(AXIS,LOW_IND) ,XYZ(AXIS)) + MINMAX_XYZ_JCC(AXIS,HIGH_IND)= MAX(MINMAX_XYZ_JCC(AXIS,HIGH_IND),XYZ(AXIS)) ENDDO ENDDO - ENDDO - ! Z direction: - ! KAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - KLO = KLO_FACE; KHI = KLO_FACE - CASE(2) - KLO = KHI_FACE; KHI = KHI_FACE - CASE(3) - KLO = KLO_FACE+1; KHI = KHI_FACE-1 - CASE(4) - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD END SELECT - X1AXIS=KAXIS - NVERT = 4 - NFACE = 1 - DO I=ILO,IHI - DO J=JLO,JHI - DO K=KLO,KHI +ENDDO - ! If cut-cell centroid is outside the test box -> drop: - IF(XCELL(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XCELL(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE - IF(YCELL(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YCELL(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE - IF(ZFACE(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZFACE(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE +END SUBROUTINE CUT_CELL_BOUNDING_BOX - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. - FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE +! -------------------------CUT_CELL_ARRAY_REALLOC------------------------------------ - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF +SUBROUTINE CUT_CELL_ARRAY_REALLOC(NM,ICC) - FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE +INTEGER, INTENT(IN) :: NM,ICC - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +! Local Variables: +INTEGER :: ICC1,SIZE_CUT_CELL - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, X1AXIS /) - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERT+1,IBNDINT) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) +! Here test if we need to reallocate cut-cell: +SIZE_CUT_CELL = SIZE(MESHES(NM)%CUT_CELL,DIM=1) +IF (ICC > SIZE_CUT_CELL) THEN + ALLOCATE(CUT_CELL_AUX(SIZE_CUT_CELL+GLOBAL_DELTA_CELL)) + DO ICC1=1,ICC-1 + CALL CUT_CELL_MOVE(MESHES(NM)%CUT_CELL(ICC1),CUT_CELL_AUX(ICC1)) + ENDDO + CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL) +ENDIF - ! Vertices: - CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) - CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) - CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) - CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) +RETURN +END SUBROUTINE CUT_CELL_ARRAY_REALLOC - ! Centroid: - CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & - (/ XFACE(I-1)+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K )+ZFACE(K ) /) +! ------------------------ CUT_CELL_MOVE ----------------------------------- - ! Load Ordered nodes to CFELEM and geom properties: - CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) - CF%AREA(NFACE) = DXCELL(I)*DYCELL(J) +SUBROUTINE CUT_CELL_MOVE(CUT_CELL_FROM,CUT_CELL_TO) - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: - CF%INXAREA(NFACE) = 0._EB - ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: - CF%INXSQAREA(NFACE) = 0._EB - ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: - CF%JNYSQAREA(NFACE) = 0._EB - ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: - CF%KNZSQAREA(NFACE) = ZFACE(K)**2._EB*CF%AREA(NFACE) - ENDDO - ENDDO - ENDDO +TYPE(CC_CUTCELL_TYPE), INTENT(INOUT) :: CUT_CELL_FROM,CUT_CELL_TO + +CUT_CELL_TO%NCELL = CUT_CELL_FROM%NCELL +CUT_CELL_TO%NFACE_CELL = CUT_CELL_FROM%NFACE_CELL +CUT_CELL_TO%NFACE_DROPPED = CUT_CELL_FROM%NFACE_DROPPED +CUT_CELL_TO%IJK = CUT_CELL_FROM%IJK + +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%CCELEM ,TO=CUT_CELL_TO%CCELEM) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%FACE_LIST ,TO=CUT_CELL_TO%FACE_LIST) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%FACE_LIST_DROPPED,TO=CUT_CELL_TO%FACE_LIST_DROPPED) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%IJK_LINK ,TO=CUT_CELL_TO%IJK_LINK) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%LINK_LEV ,TO=CUT_CELL_TO%LINK_LEV) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%VOLUME ,TO=CUT_CELL_TO%VOLUME) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%XYZCEN ,TO=CUT_CELL_TO%XYZCEN) + +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHO ,TO=CUT_CELL_TO%RHO) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHOS ,TO=CUT_CELL_TO%RHOS) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RSUM ,TO=CUT_CELL_TO%RSUM) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%TMP ,TO=CUT_CELL_TO%TMP) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%D ,TO=CUT_CELL_TO%D) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DS ,TO=CUT_CELL_TO%DS) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DVOL ,TO=CUT_CELL_TO%DVOL) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DVOL_PR ,TO=CUT_CELL_TO%DVOL_PR) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%Q ,TO=CUT_CELL_TO%Q) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%QR ,TO=CUT_CELL_TO%QR) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%D_SOURCE ,TO=CUT_CELL_TO%D_SOURCE) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%CHI_R ,TO=CUT_CELL_TO%CHI_R) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%MIX_TIME ,TO=CUT_CELL_TO%MIX_TIME) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%Q_REAC ,TO=CUT_CELL_TO%Q_REAC) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%REAC_SOURCE_TERM ,TO=CUT_CELL_TO%REAC_SOURCE_TERM) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%ZZ ,TO=CUT_CELL_TO%ZZ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%ZZS ,TO=CUT_CELL_TO%ZZS) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%M_DOT_PPP ,TO=CUT_CELL_TO%M_DOT_PPP) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%UNKH ,TO=CUT_CELL_TO%UNKH) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%UNKZ ,TO=CUT_CELL_TO%UNKZ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%KRES ,TO=CUT_CELL_TO%KRES) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%H ,TO=CUT_CELL_TO%H) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%HS ,TO=CUT_CELL_TO%HS) + +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RTRM ,TO=CUT_CELL_TO%RTRM) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%R_H_G ,TO=CUT_CELL_TO%R_H_G) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHO_0 ,TO=CUT_CELL_TO%RHO_0) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%WVEL ,TO=CUT_CELL_TO%WVEL) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DDDTVOL ,TO=CUT_CELL_TO%DDDTVOL) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DELTA_RHO ,TO=CUT_CELL_TO%DELTA_RHO) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DELTA_RHO_ZZ ,TO=CUT_CELL_TO%DELTA_RHO_ZZ) -ENDDO IBNDINT_LOOP +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_IJK ,TO=CUT_CELL_TO%INT_IJK ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_COEF ,TO=CUT_CELL_TO%INT_COEF ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_XYZBF ,TO=CUT_CELL_TO%INT_XYZBF ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NOUT ,TO=CUT_CELL_TO%INT_NOUT ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_INBFC ,TO=CUT_CELL_TO%INT_INBFC ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NPE ,TO=CUT_CELL_TO%INT_NPE ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_XN ,TO=CUT_CELL_TO%INT_XN ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_CN ,TO=CUT_CELL_TO%INT_CN ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_CCVARS ,TO=CUT_CELL_TO%INT_CCVARS) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NOMIND ,TO=CUT_CELL_TO%INT_NOMIND) -IF (.NOT.BNDINT_FLAG) DEALLOCATE( IJK_COUNTED ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DEL_RHO_D_DEL_Z_VOL ,TO=CUT_CELL_TO%DEL_RHO_D_DEL_Z_VOL) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%U_DOT_DEL_RHO_Z_VOL ,TO=CUT_CELL_TO%U_DOT_DEL_RHO_Z_VOL) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%NOADVANCE ,TO=CUT_CELL_TO%NOADVANCE) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%NOMICC ,TO=CUT_CELL_TO%NOMICC) RETURN -END SUBROUTINE DEFINE_REGULAR_CUTFACES - +END SUBROUTINE CUT_CELL_MOVE -! ---------------------------- SORT_VERTS --------------------------------------- +! ------------------------- CELL_DEALLOC ----------------------------------- -SUBROUTINE SORT_VERTS(MAXVERTS,NVERTS,VERTS1,VERTS2,XV,ASCDESC,NV,V) +SUBROUTINE CELL_DEALLOC(NM,ICC) -INTEGER, INTENT(IN) :: MAXVERTS, NVERTS -REAL(EB),INTENT(IN) :: VERTS1(MAXVERTS),VERTS2(MAXVERTS),XV -LOGICAL, INTENT(IN) :: ASCDESC -INTEGER, INTENT(OUT):: NV,V(MAXVERTS) +INTEGER, INTENT(IN) :: NM,ICC -! Local Variables: -INTEGER :: IV, IIV, JJV -INTEGER :: V2(MAXVERTS) -LOGICAL :: FOUND +MESHES(NM)%CUT_CELL(ICC)%NCELL = 0 +IF (.NOT.ALLOCATED(MESHES(NM)%CUT_CELL(ICC)%CCELEM)) RETURN -V(:) = 0 -NV = 0 -DO IV=1,NVERTS - IF (ABS(VERTS1(IV)-XV) < GEOMEPS) THEN - IF (NV==0) THEN - NV=1; V(NV)=IV - ELSE - ! Insert add IV, using ascending X3: - FOUND=.FALSE. - DO IIV=1,NV - IF ( (VERTS2(IV)-VERTS2(V(IIV))) < 0._EB ) THEN - FOUND=.TRUE. - EXIT - ENDIF - ENDDO - IF (FOUND) THEN - DO JJV=NV+1,IIV+1,-1 - V(JJV) = V(JJV-1) - ENDDO - V(IIV) = IV - ELSE - V(IIV) = IV ! Here IIV = NV+1, as loop leaves it to that value. - ENDIF - NV=NV+1 - ENDIF - ENDIF -ENDDO -IF (.NOT.ASCDESC) THEN - V2(1:NV) = V(1:NV) - DO IV=1,NV; V(NV+1-IV)=V2(IV); ENDDO -ENDIF +! Deallocate ICC entries: +DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%CCELEM) +DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST) +DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%IJK_LINK,MESHES(NM)%CUT_CELL(ICC)%LINK_LEV) +DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%VOLUME, MESHES(NM)%CUT_CELL(ICC)%XYZCEN) +DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%NOADVANCE,MESHES(NM)%CUT_CELL(ICC)%UNKZ) RETURN -END SUBROUTINE SORT_VERTS -! ----------------------------- FACE_REALLOC ------------------------------------- - -SUBROUTINE FACE_REALLOC(NM,ICF,NVERT,NFACE,NSVERT,NSFACE,NVERTFACE_NEW) +END SUBROUTINE CELL_DEALLOC -INTEGER, INTENT(IN) :: NM,ICF,NVERT,NFACE,NSVERT,NSFACE -INTEGER, INTENT(INOUT) :: NVERTFACE_NEW +! -------------------------- NEW_CELL_ALLOC ------------------------------------- -! Local Variables: -INTEGER :: NVERTFACE -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZVERT, XYZCEN, REAL2D -REAL(EB), ALLOCATABLE, DIMENSION(:) :: AREA, REAL1D -INTEGER, ALLOCATABLE, DIMENSION(:) :: INT1D -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM, INT2D ! Cut-faces connectivities. -INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: INT3D -LOGICAL, ALLOCATABLE, DIMENSION(:) :: SHARED +SUBROUTINE NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) -NVERTFACE=SIZE(MESHES(NM)%CUT_FACE(ICF)%CFELEM,DIM=1) -NVERTFACE_NEW = MAX(NVERTFACE_NEW,NVERTFACE) +INTEGER, INTENT(IN) :: NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL -IF(SIZE(MESHES(NM)%CUT_FACE(ICF)%XYZVERT,DIM=2) < NVERT+NSVERT) THEN - ! Allocate and initialize NVERT related fields: - ALLOCATE(XYZVERT(IAXIS:KAXIS,1:NVERT+NSVERT)); XYZVERT = 0._EB - XYZVERT(IAXIS:KAXIS,1:NVERT)=MESHES(NM)%CUT_FACE(ICF)%XYZVERT(IAXIS:KAXIS,1:NVERT) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=MESHES(NM)%CUT_FACE(ICF)%XYZVERT) -ENDIF +! Allocate ICC entries: +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%CCELEM(1:NCFACE_CUTCELL,1:NCELL)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%IJK_LINK(IAXIS:KAXIS+2,1:NCELL),MESHES(NM)%CUT_CELL(ICC)%LINK_LEV(1:NCELL)) +MESHES(NM)%CUT_CELL(ICC)%CCELEM = CC_UNDEFINED +MESHES(NM)%CUT_CELL(ICC)%FACE_LIST = CC_UNDEFINED +MESHES(NM)%CUT_CELL(ICC)%IJK_LINK = CC_UNDEFINED +MESHES(NM)%CUT_CELL(ICC)%LINK_LEV = 0 ! Root of link Hierarchy is zero. -IF(SIZE(MESHES(NM)%CUT_FACE(ICF)%AREA,DIM=1) SIZE_CUT_FACE) THEN + IF (NVERT > SIZE_X2X3VERT) THEN + DEALLOCATE(X2X3VERT) + SIZE_X2X3VERT = NVERT + DELTA_VERT + ALLOCATE(X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT)); X2X3VERT = 0._EB + ENDIF - ALLOCATE(CUT_FACE_AUX(SIZE_CUT_FACE+GLOBAL_DELTA_FACE)) + X2X3VERT(IAXIS,1:NVERT) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(X2AXIS,1:NVERT) + X2X3VERT(JAXIS,1:NVERT) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(X3AXIS,1:NVERT) - DO ICF1=1,ICF-1 - CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(ICF1),CUT_FACE_AUX(ICF1)) - ENDDO - CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE) + CEELEM(NOD1:NOD2,1:NEDGE) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGE) + INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:NEDGE) = & + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:NEDGE) + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1=NEDGE ENDIF -RETURN -END SUBROUTINE CUT_FACE_ARRAY_REALLOC +! Quick discard test: +X2FMIN = MINVAL(FVERT(IAXIS,NOD1:NOD4)); X2FMAX = MAXVAL(FVERT(IAXIS,NOD1:NOD4)) +X3FMIN = MINVAL(FVERT(JAXIS,NOD1:NOD4)); X3FMAX = MAXVAL(FVERT(JAXIS,NOD1:NOD4)) +! Loop in-plane Surface Elements: +INTEST = .FALSE. +DO ITRI=1,BODINT_PLANE%NTRIS + ! Elements nodes location, in x2-x3 coordinates: + TRI(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) + DO INOD=NOD1,NOD3 + XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,TRI(INOD)) + ENDDO + OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(IAXIS,NOD1:NOD3))-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir + OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(JAXIS,NOD1:NOD3))-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 + IF (.NOT.OUTFACE) THEN + INTEST = .TRUE. + EXIT + ENDIF +ENDDO +! Run on Triangle edges found: +DO ISEG=1,BODINT_PLANE%NSEGS + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + DO INOD=NOD1,NOD2 + XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,SEG(INOD)) + ENDDO + OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(IAXIS,NOD1:NOD2))-X2FMAX) > GEOMEPS) ! Segment out of Face in x2 dir + OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(JAXIS,NOD1:NOD2))-X3FMAX) > GEOMEPS) ! Segment out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 + IF (.NOT.OUTFACE) THEN + INTEST = .TRUE. + EXIT + ENDIF +ENDDO +IF (.NOT.INTEST) RETURN -! --------------------------- CUT_FACE_MOVE ------------------------------------- +! Now if intest is true figure out if there are triangles-face intersection +! Polygons: +NFVERT = 4 +NTVERT = 3 +NSVERT = 2 -SUBROUTINE CUT_FACE_MOVE(CUT_FACE_FROM,CUT_FACE_TO) +! First Vertices: +ALLOCATE(FVERT_IN_TRIANG(1:NFVERT,BODINT_PLANE%NTRIS)); FVERT_IN_TRIANG = 0 +ALLOCATE(TRIVERT_IN_FACE(1:NTVERT,BODINT_PLANE%NTRIS)); TRIVERT_IN_FACE = 0 -TYPE(CC_CUTFACE_TYPE), INTENT(INOUT) :: CUT_FACE_FROM, CUT_FACE_TO +NINTP = NVERT -CUT_FACE_TO%IWC = CUT_FACE_FROM%IWC -CUT_FACE_TO%PRES_ZONE = CUT_FACE_FROM%PRES_ZONE -CUT_FACE_TO%NVERT = CUT_FACE_FROM%NVERT -CUT_FACE_TO%NSVERT = CUT_FACE_FROM%NSVERT -CUT_FACE_TO%NFACE = CUT_FACE_FROM%NFACE -CUT_FACE_TO%NSFACE = CUT_FACE_FROM%NSFACE -CUT_FACE_TO%STATUS = CUT_FACE_FROM%STATUS -CUT_FACE_TO%IJK = CUT_FACE_FROM%IJK +! Loop in-plane Surface Elements: +DO ITRI=1,BODINT_PLANE%NTRIS -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XYZVERT, TO=CUT_FACE_TO%XYZVERT) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CFELEM, TO=CUT_FACE_TO%CFELEM) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CEDGES, TO=CUT_FACE_TO%CEDGES) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%AREA, TO=CUT_FACE_TO%AREA) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%AREA_ADJUST, TO=CUT_FACE_TO%AREA_ADJUST) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XYZCEN, TO=CUT_FACE_TO%XYZCEN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%SHARED, TO=CUT_FACE_TO%SHARED) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%BLK_TAG, TO=CUT_FACE_TO%BLK_TAG) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CFACE_ORIGIN, TO=CUT_FACE_TO%CFACE_ORIGIN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%LINK_LEV, TO=CUT_FACE_TO%LINK_LEV) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INXAREA, TO=CUT_FACE_TO%INXAREA) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INXSQAREA, TO=CUT_FACE_TO%INXSQAREA) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%JNYSQAREA, TO=CUT_FACE_TO%JNYSQAREA) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%KNZSQAREA, TO=CUT_FACE_TO%KNZSQAREA) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%BODTRI, TO=CUT_FACE_TO%BODTRI) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%UNKH, TO=CUT_FACE_TO%UNKH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%UNKZ, TO=CUT_FACE_TO%UNKZ) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XCENLOW, TO=CUT_FACE_TO%XCENLOW) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XCENHIGH, TO=CUT_FACE_TO%XCENHIGH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%ZZ_FACE, TO=CUT_FACE_TO%ZZ_FACE) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%TMP_FACE, TO=CUT_FACE_TO%TMP_FACE) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%RHO_D_DZDN, TO=CUT_FACE_TO%RHO_D_DZDN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%H_RHO_D_DZDN, TO=CUT_FACE_TO%H_RHO_D_DZDN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL, TO=CUT_FACE_TO%VEL) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VELS, TO=CUT_FACE_TO%VELS) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%FN, TO=CUT_FACE_TO%FN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%FN_B, TO=CUT_FACE_TO%FN_B) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_SAVE, TO=CUT_FACE_TO%VEL_SAVE) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_LNK, TO=CUT_FACE_TO%VEL_LNK) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_OMESH, TO=CUT_FACE_TO%VEL_OMESH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VELS_OMESH, TO=CUT_FACE_TO%VELS_OMESH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_LNK_OMESH, TO=CUT_FACE_TO%VEL_LNK_OMESH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%FN_OMESH, TO=CUT_FACE_TO%FN_OMESH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%JDH, TO=CUT_FACE_TO%JDH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%EDGE_LIST, TO=CUT_FACE_TO%EDGE_LIST) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CELL_LIST, TO=CUT_FACE_TO%CELL_LIST) + NINTP_TRI = 0 + TRINODS = CC_UNDEFINED -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_IJK, TO=CUT_FACE_TO%INT_IJK) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_COEF, TO=CUT_FACE_TO%INT_COEF) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_DCOEF, TO=CUT_FACE_TO%INT_DCOEF) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_XYZBF, TO=CUT_FACE_TO%INT_XYZBF) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NOUT, TO=CUT_FACE_TO%INT_NOUT) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_INBFC, TO=CUT_FACE_TO%INT_INBFC) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NPE, TO=CUT_FACE_TO%INT_NPE) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_XN, TO=CUT_FACE_TO%INT_XN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_CN, TO=CUT_FACE_TO%INT_CN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_FVARS, TO=CUT_FACE_TO%INT_FVARS) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NOMIND, TO=CUT_FACE_TO%INT_NOMIND) + ! Elements nodes location, in x2-x3 coordinates: + TRI(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) + DO INOD=NOD1,NOD3 + XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,TRI(INOD)) + ENDDO -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_CVARS, TO=CUT_FACE_TO%INT_CVARS) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%UNKF, TO=CUT_FACE_TO%UNKF) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CFACE_INDEX, TO=CUT_FACE_TO%CFACE_INDEX) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%SURF_INDEX, TO=CUT_FACE_TO%SURF_INDEX) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%NOMICF, TO=CUT_FACE_TO%NOMICF) + ! Cycle if Triangles BBOX not intersecting face: + OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(IAXIS,NOD1:NOD3))-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir + OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(JAXIS,NOD1:NOD3))-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 + IF (OUTFACE) CYCLE -RETURN -END SUBROUTINE CUT_FACE_MOVE + IF (BODINT_PLANE%X1NVEC(ITRI) < 0) THEN ! ROTATE NODE 2 AND 3 LOCATIONS + DUMMY(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,NOD2) + XYEL(IAXIS:JAXIS,NOD2) = XYEL(IAXIS:JAXIS,NOD3) + XYEL(IAXIS:JAXIS,NOD3) = DUMMY(IAXIS:JAXIS) + TSEGS(NOD1:NOD2,EDG1) = BODINT_PLANE%TRIS( (/ 2, 1 /) ,ITRI) + TSEGS(NOD1:NOD2,EDG2) = BODINT_PLANE%TRIS( (/ 3, 2 /) ,ITRI) + TSEGS(NOD1:NOD2,EDG3) = BODINT_PLANE%TRIS( (/ 1, 3 /) ,ITRI) + ELSE + TSEGS(NOD1:NOD2,EDG1) = BODINT_PLANE%TRIS( (/ 1, 2 /) ,ITRI) + TSEGS(NOD1:NOD2,EDG2) = BODINT_PLANE%TRIS( (/ 2, 3 /) ,ITRI) + TSEGS(NOD1:NOD2,EDG3) = BODINT_PLANE%TRIS( (/ 3, 1 /) ,ITRI) + ENDIF -! ---------------------------- FACE_DEALLOC ------------------------------------- + ! a. Test if Triangles vertices Lay on Faces area, including face boundary: + DO IPT=1,NTVERT + OUTX2= ((X2FMIN-XYEL(IAXIS,IPT)) > GEOMEPS) .OR. & + ((XYEL(IAXIS,IPT)-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir + OUTX3= ((X3FMIN-XYEL(JAXIS,IPT)) > GEOMEPS) .OR. & + ((XYEL(JAXIS,IPT)-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 -SUBROUTINE FACE_DEALLOC(NM,ICF,DO_BNCF) + IF ( OUTFACE ) CYCLE -INTEGER, INTENT(IN) :: NM,ICF -INTEGER, OPTIONAL, INTENT(IN) :: DO_BNCF + ! Insertion add point to intersection list: + XP(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,IPT) + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XYZVERT)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZVERT) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CFELEM)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFELEM) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CEDGES)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CEDGES) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%AREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST) -IF(.NOT.PRESENT(DO_BNCF)) THEN - MESHES(NM)%CUT_FACE(ICF)%NFACE = 0 - IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XYZCEN)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZCEN) -ENDIF -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%SHARED)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SHARED) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA) + ! Insert sort node to triangles local list + TRUETHAT = .TRUE. + DO INP=1,NINTP_TRI + IF (TRINODS(INP) == INOD) THEN + TRUETHAT = .FALSE. + EXIT + ENDIF + ENDDO + IF ( TRUETHAT ) THEN ! new inod entry on list + NINTP_TRI = NINTP_TRI + 1 + TRINODS(NINTP_TRI) = INOD + ENDIF -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%BODTRI)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI) + TRIVERT_IN_FACE(IPT,ITRI) = 1 -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%UNKH)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKH) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%UNKZ)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKZ) + ENDDO -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XCENLOW)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENLOW) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH) + ! b. Test if Face vertices lay on triangle, including triangle edges: + DO IPF=1,NFVERT + ! Transform back to master Element coordinates + ! location of point i,j in x2-x3 coordinates: + FD(1:2) = (/ FVERT(IAXIS,IPF)-XYEL(IAXIS,NOD3), FVERT(JAXIS,IPF)-XYEL(JAXIS,NOD3) /) + ! Here xi in vec(1) and eta in vec(2) + VEC(IAXIS) = BODINT_PLANE%AINV(1,1,ITRI)*FD(1) + BODINT_PLANE%AINV(1,2,ITRI)*FD(2) + VEC(JAXIS) = BODINT_PLANE%AINV(2,1,ITRI)*FD(1) + BODINT_PLANE%AINV(2,2,ITRI)*FD(2) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX) + ! Test for vertex point within triangle, considers Triangle Edges: + IF ( (VEC(IAXIS) >= (0._EB-GEOMEPS)) .AND. & + (VEC(JAXIS) >= (0._EB-GEOMEPS)) .AND. & + (1._EB-VEC(IAXIS)-VEC(JAXIS) >= (0._EB-GEOMEPS)) ) THEN + ! Insertion add point to intersection list: + XP(IAXIS:JAXIS) = FVERT(IAXIS:JAXIS,IPF) + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) -RETURN -END SUBROUTINE FACE_DEALLOC + ! Insert sort node to triangles local list + TRUETHAT = .TRUE. + DO INP=1,NINTP_TRI + IF (TRINODS(INP) == INOD) THEN + TRUETHAT = .FALSE. + EXIT + ENDIF + ENDDO + IF ( TRUETHAT ) THEN ! new inod entry on list + NINTP_TRI = NINTP_TRI + 1 + TRINODS(NINTP_TRI) = INOD + ENDIF -! -------------------------- NEW_FACE_ALLOC ------------------------------------- + FVERT_IN_TRIANG(IPF,ITRI) = 1 -SUBROUTINE NEW_FACE_ALLOC(NM,ICF,NVERT,NFACE,NVERTFACE,IBNDINT) + ENDIF + ENDDO -INTEGER, INTENT(IN) :: NM,ICF,NVERT,NFACE,NVERTFACE -INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT + ! Now add face edge - triangle edge intersection points: + ! x2 segments: + DO MYAXIS=IAXIS,JAXIS + SELECT CASE(MYAXIS) + CASE(IAXIS) + XIAXIS = IAXIS + XJAXIS = JAXIS + XIPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) + XJPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) + CASE(JAXIS) + XIAXIS = JAXIS + XJAXIS = IAXIS + XIPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) + XJPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) + END SELECT -! Allocate and initialize NVERT related fields: -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZVERT(IAXIS:KAXIS,1:NVERT)); MESHES(NM)%CUT_FACE(ICF)%XYZVERT = 0._EB + DO JPL=LOW_IND,HIGH_IND -! Allocate and initialize NFACE, NVERTFACE related fields: -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFELEM(1:NVERTFACE,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFELEM = CC_UNDEFINED -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%AREA = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZCEN(IAXIS:KAXIS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%XYZCEN = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SHARED(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%SHARED = .FALSE. -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG(1:NFACE));MESHES(NM)%CUT_FACE(ICF)%BLK_TAG= .FALSE. -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%LINK_LEV = CC_UNDEFINED + XJPLN = XJPLNS(JPL) -!Integrals to be used in cut-cell volume and centroid computations. -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%INXAREA = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%INXSQAREA = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA = 0._EB + DO IPT=1,NTVERT -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI(1:2,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%BODTRI = CC_UNDEFINED + XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD1,IPT) ) + XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD2,IPT) ) -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKZ(LOW_IND:HIGH_IND,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%UNKZ = CC_UNDEFINED + ! Drop if Triangle edge on one side of segment ray: + MAXXJ = MAX(XY1(XJAXIS),XY2(XJAXIS)) + MINXJ = MIN(XY1(XJAXIS),XY2(XJAXIS)) + OUTPLANE1 = ((XJPLN-MAXXJ) > GEOMEPS) .OR. ((MINXJ-XJPLN) > GEOMEPS) + IF ( OUTPLANE1 ) CYCLE -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENLOW(IAXIS:KAXIS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%XCENLOW = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH(IAXIS:KAXIS,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%XCENHIGH = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(MAX_DIM+1,LOW_IND:HIGH_IND,1:NFACE)) -MESHES(NM)%CUT_FACE(ICF)%CELL_LIST = CC_UNDEFINED + ! Also drop if Triangle edge ouside of face edge limits: + MAXXI = MAX(XY1(XIAXIS),XY2(XIAXIS)) + MINXI = MIN(XY1(XIAXIS),XY2(XIAXIS)) + OUTPLANE2 = ((XIPLNS(LOW_IND)-MAXXI) > GEOMEPS) .OR. ((MINXI-XIPLNS(HIGH_IND)) > GEOMEPS) + IF ( OUTPLANE2 ) CYCLE -IF(MESHES(NM)%CUT_FACE(ICF)%STATUS==CC_INBOUNDARY) THEN - ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST = 1._EB - ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN = NOT_BLOCKED -ELSE - IF(PRESENT(IBNDINT)) THEN - IF(IBNDINT>2) RETURN ! Gas cut-face not in block boundary. - ENDIF -ENDIF -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX = CC_UNDEFINED + ! Test if segment aligned with xi + XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) + IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. -RETURN -END SUBROUTINE NEW_FACE_ALLOC + ! Drop intersections in triangle segment nodes: already added. + ! Compute: dot(plnormal, xyzv - xypl): + DOT1 = XY1(XJAXIS) - XJPLN + DOT2 = XY2(XJAXIS) - XJPLN + IF ( ABS(DOT1) <= GEOMEPS ) CYCLE + IF ( ABS(DOT2) <= GEOMEPS ) CYCLE -! -------------------------- ALLOC_FACE_STATE_VARS ------------------------------------- + ! Finally regular case: + ! Points 1 on one side of x2 segment, point 2 on the other: + !IF ((DOT1 > 0._EB & DOT2 < 0._EB) .OR. (DOT1 < 0._EB & DOT2 > 0._EB)) + IF ( DOT1*DOT2 < 0._EB ) THEN -SUBROUTINE ALLOC_FACE_STATE_VARS(NM,ICF,NFACE,IBNDINT) + ! Intersection Point along segment: + DS = (XJPLN-XY1(XJAXIS))/(XY2(XJAXIS)-XY1(XJAXIS)) + SVARI = XY1(XIAXIS) + DS*(XY2(XIAXIS)-XY1(XIAXIS)) -INTEGER, INTENT(IN) :: NM,ICF,NFACE -INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT + OUTSEG= ((XIPLNS(LOW_IND)-SVARI) > -GEOMEPS) .OR. ((SVARI-XIPLNS(HIGH_IND)) > -GEOMEPS) + IF ( OUTSEG ) CYCLE + ! Insertion add point to intersection list: + XP(XIAXIS) = SVARI + XP(XJAXIS) = XJPLN + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) -! !Integrals to be used in cut-cell volume and centroid computations. -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA) + ! Insert sort node to triangles local list + TRUETHAT = .TRUE. + DO INP=1,NINTP_TRI + IF (TRINODS(INP) == INOD) THEN + TRUETHAT = .FALSE. + EXIT + ENDIF + ENDDO + IF (TRUETHAT) THEN ! new inod entry on list + NINTP_TRI = NINTP_TRI + 1 + TRINODS(NINTP_TRI) = INOD + ENDIF + CYCLE + ENDIF + ENDDO + ENDDO + ENDDO -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKH(LOW_IND:HIGH_IND,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%UNKH = CC_UNDEFINED -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%RHO_D_DZDN(1:N_TOTAL_SCALARS,1:NFACE)) -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%H_RHO_D_DZDN(1:N_TOTAL_SCALARS,1:NFACE)) -MESHES(NM)%CUT_FACE(ICF)%RHO_D_DZDN = 0._EB -MESHES(NM)%CUT_FACE(ICF)%H_RHO_D_DZDN = 0._EB + IF ( NINTP_TRI == 0 ) CYCLE -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%ZZ_FACE(1:N_TOTAL_SCALARS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%ZZ_FACE = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%TMP_FACE(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%TMP_FACE = 0._EB + ! Reorder points given normal on x1 direction: + ! Centroid: + XCEN(IAXIS:JAXIS) = 0._EB + DO INTP=1,NINTP_TRI + XCEN(IAXIS:JAXIS) = XCEN(IAXIS:JAXIS) + X2X3VERT(IAXIS:JAXIS,TRINODS(INTP)) + ENDDO + XCEN(IAXIS:JAXIS)= XCEN(IAXIS:JAXIS) * REAL(NINTP_TRI,EB)**(-1._EB) -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%VEL(1:NFACE), MESHES(NM)%CUT_FACE(ICF)%VELS(1:NFACE), & - MESHES(NM)%CUT_FACE(ICF)%FN(1:NFACE), MESHES(NM)%CUT_FACE(ICF)%FN_B(1:NFACE), & - MESHES(NM)%CUT_FACE(ICF)%VEL_SAVE(1:NFACE)) -MESHES(NM)%CUT_FACE(ICF)%VEL = 0._EB; MESHES(NM)%CUT_FACE(ICF)%VELS = 0._EB -MESHES(NM)%CUT_FACE(ICF)%FN = 0._EB; MESHES(NM)%CUT_FACE(ICF)%VEL_SAVE = 0._EB -MESHES(NM)%CUT_FACE(ICF)%FN_B = 0._EB; + ATANTRI(1:CC_MAXVERTS_FACE+1) = 1._EB / GEOMEPS + II(1:CC_MAXVERTS_FACE+1) = CC_UNDEFINED + DO INTP=1,NINTP_TRI + ATTRI = ATAN2(X2X3VERT(JAXIS,TRINODS(INTP))-XCEN(JAXIS), & + X2X3VERT(IAXIS,TRINODS(INTP))-XCEN(IAXIS)) + PI + ! Insertion sort: + DO IINS=1,INTP+1 + IF (ATTRI < ATANTRI(IINS)) EXIT + ENDDO + ! copy from the back: + DO IDUM=INTP+1,IINS+1,-1 + ATANTRI(IDUM) = ATANTRI(IDUM-1) + II(IDUM) = II(IDUM-1) + ENDDO + ATANTRI(IINS) = ATTRI + II(IINS) = INTP + ENDDO -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JDH(1:2,1:2,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%JDH = CC_UNDEFINED -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKF(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%UNKF = CC_UNDEFINED + ! Reorder nodes: + TRINODS(1:NINTP_TRI) = TRINODS(II(1:NINTP_TRI)) -IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) THEN - IF(PRESENT(IBNDINT)) THEN - IF(IBNDINT>2) RETURN ! Gas cut-face not in block boundary. - ENDIF -ENDIF -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_INDEX(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFACE_INDEX = CC_UNDEFINED + ! Define and Insertion add segments to CFELEM, indseg + EDGETRI = CC_UNDEFINED + DO IEDGE=1,NINTP_TRI-1 + EDGETRI((/NOD1,NOD2/),IEDGE) = (/ TRINODS(IEDGE), TRINODS(IEDGE+1) /) + ENDDO + EDGETRI((/NOD1,NOD2/),NINTP_TRI) = (/ TRINODS(NINTP_TRI), TRINODS(1) /) -RETURN -END SUBROUTINE ALLOC_FACE_STATE_VARS + LOCTRI = BODINT_PLANE%INDTRI(1,ITRI) + LOCBOD = BODINT_PLANE%INDTRI(2,ITRI) -! -------------------------- TEST_PT_INPOLY ------------------------------------- + DO IEDGE=1,NINTP_TRI -SUBROUTINE TEST_PT_INPOLY(NP,XY,XY1,PTSFLAG) + IF ( EDGETRI(NOD1,IEDGE) == EDGETRI(NOD2,IEDGE) ) CYCLE -INTEGER, INTENT(IN) :: NP -REAL(EB), INTENT(INOUT) :: XY(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) -REAL(EB), INTENT(IN) :: XY1(IAXIS:JAXIS) -LOGICAL, INTENT(OUT) :: PTSFLAG + ! Test if Edge already on list: + INLIST = .FALSE. + DO ISEG=1,NEDGE -! Local Variables: -INTEGER :: RCROSS, LCROSS, IP -REAL(EB):: XPT -LOGICAL :: RS, LS + IF ( (EDGETRI(NOD1,IEDGE) == CEELEM(NOD1,ISEG)) .AND. & ! same inod1 + (EDGETRI(NOD2,IEDGE) == CEELEM(NOD2,ISEG)) .AND. & ! same inod2 + (LOCBOD == INDSEG(4,ISEG)) ) THEN ! same ibod -PTSFLAG = .FALSE. -RCROSS = 0 -LCROSS = 0 + SELECT CASE(INDSEG(1,ISEG)) + ! Only one triangle in list: + CASE(1) + IF ( LOCTRI /= INDSEG(2,ISEG) ) THEN + INDSEG(1,ISEG) = 2 + INDSEG(3,ISEG) = LOCTRI ! add triangle 2nd. + ENDIF + INLIST = .TRUE. + EXIT + ! Two triangles in list: + CASE(2) + IF ( (LOCTRI == INDSEG(2,ISEG)) .OR. & + (LOCTRI == INDSEG(3,ISEG)) ) THEN + INLIST = .TRUE. + EXIT + ENDIF + END SELECT + ENDIF + ENDDO -! ADD first point location at the end of XY (assumes CC_MAXVERTS_FACE > NP): -XY(IAXIS:JAXIS,NP+1) = XY(IAXIS:JAXIS,1) + IF ( .NOT.INLIST ) THEN ! Edge not in list. + NEDGE = NEDGE + 1 + CEELEM(NOD1:NOD2,NEDGE) = EDGETRI(NOD1:NOD2,IEDGE) -! Shift origin to XY1: -DO IP=1,NP+1 - XY(IAXIS:JAXIS,IP) = XY(IAXIS:JAXIS,IP) - XY1(IAXIS:JAXIS) -enddo + ! Here we have to figure out if segment belongs to a triangles side: + SEG_IN_SIDE = .FALSE. + DO IPT=1,NTVERT -! For each edge test against rays x=0, y=0: -DO IP=1,NP - ! Check if edges first point is vertex: - IF ( (ABS(XY(IAXIS,IP)) < GEOMEPS) .AND. & - (ABS(XY(JAXIS,IP)) < GEOMEPS) ) THEN - PTSFLAG = .TRUE. - RETURN - ENDIF - ! Check if edge crosses x axis: - RS = (XY(JAXIS,IP) > 0._EB) .NEQV. (XY(JAXIS,IP+1) > 0._EB) - LS = (XY(JAXIS,IP) < 0._EB) .NEQV. (XY(JAXIS,IP+1) < 0._EB) + ! Triangle side nodes: + XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD1,IPT) ) + XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD2,IPT) ) - IF ( RS .OR. LS ) THEN - ! Intersection: - XPT = (XY(IAXIS,IP )*XY(JAXIS,IP+1) - XY(JAXIS,IP )*XY(IAXIS,IP+1)) / (XY(JAXIS,IP+1)-XY(JAXIS,IP)) + ! Segment points: + XP1(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD1,NEDGE)) + XP2(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD2,NEDGE)) + + VECS(IAXIS:JAXIS) = XY2(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) + VECP1(IAXIS:JAXIS) = XP1(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) + VECP2(IAXIS:JAXIS) = XP2(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) + + CROSSP1 = ABS(VECS(IAXIS)*VECP1(JAXIS)-VECS(JAXIS)*VECP1(IAXIS)) + CROSSP2 = ABS(VECS(IAXIS)*VECP2(JAXIS)-VECS(JAXIS)*VECP2(IAXIS)) + + IF ( (CROSSP1+CROSSP2) < GEOMEPS ) THEN + SEG_IN_SIDE = .TRUE. + EXIT + ENDIF + ENDDO + IF ( SEG_IN_SIDE ) THEN + EDGE_TRI = GEOMETRY(LOCBOD)%FACE_EDGES(IPT,LOCTRI) ! WSTRIED + VEC3(1) = GEOMETRY(LOCBOD)%EDGE_FACES(1,EDGE_TRI) ! WSEDTRI + VEC3(2) = GEOMETRY(LOCBOD)%EDGE_FACES(2,EDGE_TRI) + VEC3(3) = GEOMETRY(LOCBOD)%EDGE_FACES(4,EDGE_TRI) + INDSEG((/1,2,3,4/),NEDGE) = (/ VEC3(1), VEC3(2), VEC3(3), LOCBOD /) + ELSE + INDSEG((/1,2,3,4/),NEDGE) = (/ 1, LOCTRI, 0, LOCBOD /) + ENDIF + ENDIF + ENDDO - IF (RS .AND. (XPT > 0._EB)) RCROSS = RCROSS + 1 - IF (LS .AND. (XPT < 0._EB)) LCROSS = LCROSS + 1 - ENDIF ENDDO -IF ( MOD(RCROSS,2) /= MOD(LCROSS,2) ) THEN ! Point on edge - PTSFLAG = .TRUE. - RETURN -ENDIF +! Now define cut-edges from solid-solid segments: +DO IWSSEG=1,BODINT_PLANE%NSEGS -IF ( MOD(RCROSS,2) == 1) THEN ! Point inside - PTSFLAG = .TRUE. - RETURN -ENDIF + NINTP_SEG = 0 + SEGNODS = CC_UNDEFINED -RETURN -END SUBROUTINE TEST_PT_INPOLY + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,IWSSEG) + DO INOD=NOD1,NOD2 + XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,SEG(INOD)) + ENDDO + ! Cycle if Edges BBOX not intersecting face: + OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(IAXIS,NOD1:NOD2))-X2FMAX) > GEOMEPS) ! Segment out of Face in x2 dir + OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(JAXIS,NOD1:NOD2))-X3FMAX) > GEOMEPS) ! Segment out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 + IF (OUTFACE) CYCLE + ! Now define nodes for this CEELEM: + ! a-1. Test if Segments vertices Lay on Faces area, including face boundary: + DO IPT=1,NSVERT + OUTX2= ((X2FMIN-XYEL(IAXIS,IPT)) > GEOMEPS) .OR. & + ((XYEL(IAXIS,IPT)-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir + OUTX3= ((X3FMIN-XYEL(JAXIS,IPT)) > GEOMEPS) .OR. & + ((XYEL(JAXIS,IPT)-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 + IF ( OUTFACE ) CYCLE -! ---------------------- GET_CARTCELL_CUTEDGES ---------------------------------- + ! Insertion add point to intersection list: + XP(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,IPT) + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) -SUBROUTINE GET_CARTCELL_CUTEDGES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) + ! Insert sort node to triangles local list + TRUETHAT = .TRUE. + DO INP=1,NINTP_SEG + IF (SEGNODS(INP) == INOD) THEN + TRUETHAT = .FALSE. + EXIT + ENDIF + ENDDO + IF ( TRUETHAT ) THEN ! new inod entry on list + NINTP_SEG = NINTP_SEG + 1 + SEGNODS(NINTP_SEG) = INOD + ENDIF + ENDDO -USE TRAN, ONLY : TRANS + IF(NINTP_SEG < 2) THEN + ! b. Now add face edge - SS edge intersection points: + ! x2 segments: + DO MYAXIS=IAXIS,JAXIS + SELECT CASE(MYAXIS) + CASE(IAXIS) + XIAXIS = IAXIS + XJAXIS = JAXIS + XIPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) + XJPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) + CASE(JAXIS) + XIAXIS = JAXIS + XJAXIS = IAXIS + XIPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) + XJPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) + END SELECT -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND + DO JPL=LOW_IND,HIGH_IND -! Local Variables: -INTEGER :: II2, JJ2, KK2, IG, IWSEDG, SEG(NOD1:NOD2),X1AXIS, X1LO, X1HI, IPLN, LSTR, LEND -REAL(EB):: XYZ1(IAXIS:KAXIS), XYZ2(IAXIS:KAXIS), PLNORMAL(IAXIS:KAXIS), X1PLN, MINX, MAXX -LOGICAL :: DROPSEG, OUTPLANE, SAMEINT -REAL(EB):: DOT1, DOT2, DENOM, PLANEEQ, SVARI, XYZV1(IAXIS:KAXIS), XYZV2(IAXIS:KAXIS), SLEN, STANI(IAXIS:KAXIS) -INTEGER :: NWCROSS, IBCR, IDUM, INOD1, INOD2, NVERT, NEDGE, IEDGE, CEI, NWCROSS_SVAR, X1NOC -REAL(EB):: SVAR1, SVAR2, SVAR12, XPOS, DV(IAXIS:KAXIS) -REAL(EB), ALLOCATABLE, DIMENSION(:) :: SVAR_AUX -INTEGER :: X2AXIS, EDGE_START, COUNT, CEI2, I, J, K, I_NP, IFCELL, ITRI, IG1 -REAL(EB):: XP(IAXIS:KAXIS), NP(IAXIS:KAXIS), ADD_XSEG(IAXIS:KAXIS), X1X2(IAXIS:KAXIS), X1O1(IAXIS:KAXIS), X1O2(IAXIS:KAXIS), & - X1T1_OPNOD, X1T2_OPNOD -LOGICAL :: TWOBOD_EDG, INPL_TEST, ANG_FLG1, ANG_FLG2, ANG_FLG3 -INTEGER, PARAMETER :: AXIS(1:6)=(/ IAXIS, IAXIS, JAXIS, JAXIS, KAXIS, KAXIS /) -INTEGER, PARAMETER :: IADD(1:6)=(/ -1, 0, 0, 0, 0, 0 /) -INTEGER, PARAMETER :: JADD(1:6)=(/ 0, 0, -1, 0, 0, 0 /) -INTEGER, PARAMETER :: KADD(1:6)=(/ 0, 0, 0, 0, -1, 0 /) -LOGICAL, ALLOCATABLE, DIMENSION(:) :: SOLID_EDGE -INTEGER, PARAMETER :: ON(1:3) =(/ 3, 1, 2 /) -INTEGER :: T1, E1, ON1, T2, E2, ON2 -REAL(EB) :: TNOW, EDGECUBE(LOW_IND:HIGH_IND,IAXIS:KAXIS) -TYPE(BODINT_CELL_EDGE_TYPE) :: BODINT_CELL_EDGE -LOGICAL :: FOUND_SEG + XJPLN = XJPLNS(JPL) -! REAL(QB) :: DVQ(IAXIS:KAXIS), SLENQ, STANIQ(IAXIS:KAXIS), DENOMQ, PLANEEQQ + XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD1) ) + XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD2) ) -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -INTEGER :: NCUTEDG + ! b-1. Drop if Edge on one side of segment ray: + MAXXJ = MAX(XY1(XJAXIS),XY2(XJAXIS)) + MINXJ = MIN(XY1(XJAXIS),XY2(XJAXIS)) + OUTPLANE1 = ((XJPLN-MAXXJ) > GEOMEPS) .OR. ((MINXJ-XJPLN) > GEOMEPS) + IF ( OUTPLANE1 ) CYCLE -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTEDGES for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTEDGES for mesh :',NM,' ..' -ENDIF + ! b-2. Also drop if Edge ouside of face edge limits: + MAXXI = MAX(XY1(XIAXIS),XY2(XIAXIS)) + MINXI = MIN(XY1(XIAXIS),XY2(XIAXIS)) + OUTPLANE2 = ((XIPLNS(LOW_IND)-MAXXI) > GEOMEPS) .OR. ((MINXI-XIPLNS(HIGH_IND)) > GEOMEPS) + IF ( OUTPLANE2 ) CYCLE -TNOW=CURRENT_TIME() + ! Test if segment aligned with xi + XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) + IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. -EDGE_START= MESHES(NM)%N_CUTEDGE_MESH + 1 + ! Drop intersections in EDGE nodes: already added. + ! Compute: dot(plnormal, xyzv - xypl): + DOT1 = XY1(XJAXIS) - XJPLN + DOT2 = XY2(XJAXIS) - XJPLN -! BODINT_CELL: -GEOM_LOOP : DO IG=1,N_GEOMETRY + IF ( ABS(DOT1) <= GEOMEPS ) CYCLE + IF ( ABS(DOT2) <= GEOMEPS ) CYCLE - ! The IG wet surface edges will be used to obtain intersections with grid planes on - ! increasing svar order. - ALLOCATE(BODINT_CELL_EDGE%SVAR(CC_DELTA_NBCROSS)) + ! Finally regular case: + ! Points 1 on one side of x2 segment, point 2 on the other: + IF ( DOT1*DOT2 < 0._EB ) THEN - IWSEDG_LOOP : DO IWSEDG=1,GEOMETRY(IG)%N_EDGES + ! Intersection Point along segment: + DS = (XJPLN-XY1(XJAXIS))/(XY2(XJAXIS)-XY1(XJAXIS)) + SVARI = XY1(XIAXIS) + DS*(XY2(XIAXIS)-XY1(XIAXIS)) - ! Seg Nodes location: - SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEDG) + OUTSEG= ((XIPLNS(LOW_IND)-SVARI) > -GEOMEPS) .OR. ((SVARI-XIPLNS(HIGH_IND)) > -GEOMEPS) + IF ( OUTSEG ) CYCLE - XYZ1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) + ! Insertion add point to intersection list: + XP(XIAXIS) = SVARI + XP(XJAXIS) = XJPLN + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) - DO X1AXIS=IAXIS,KAXIS - EDGECUBE( LOW_IND,X1AXIS) = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) - EDGECUBE(HIGH_IND,X1AXIS) = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) + ! Insert sort node to EDGES local list + TRUETHAT = .TRUE. + DO INP=1,NINTP_SEG + IF (SEGNODS(INP) == INOD) THEN + TRUETHAT = .FALSE. + EXIT + ENDIF + ENDDO + IF (TRUETHAT) THEN ! new inod entry on list + NINTP_SEG = NINTP_SEG + 1 + SEGNODS(NINTP_SEG) = INOD + ENDIF + CYCLE + ENDIF + ENDDO ENDDO + ENDIF - ! Discard if segment is outside of volume of interest: - IF (EDGECUBE( LOW_IND,IAXIS) > X(IBAR)+REAL(NGUARD,EB)*DX(IBAR)) CYCLE - IF (EDGECUBE(HIGH_IND,IAXIS) < X( 0)-REAL(NGUARD,EB)*DX( 1)) CYCLE - IF (EDGECUBE( LOW_IND,JAXIS) > Y(JBAR)+REAL(NGUARD,EB)*DY(JBAR)) CYCLE - IF (EDGECUBE(HIGH_IND,JAXIS) < Y( 0)-REAL(NGUARD,EB)*DY( 1)) CYCLE - IF (EDGECUBE( LOW_IND,KAXIS) > Z(KBAR)+REAL(NGUARD,EB)*DZ(KBAR)) CYCLE - IF (EDGECUBE(HIGH_IND,KAXIS) < Z( 0)-REAL(NGUARD,EB)*DZ( 1)) CYCLE + IF ( (NINTP_SEG < 2) .OR. (SEGNODS(NOD1) == SEGNODS(NOD2)) ) CYCLE - ! Test if Segment lays on plane, If so drop, unless SOLID-SOLID with triangles off plane, it was taken care of - ! previously: This is expensive think of switching to pointer X1FACEP. - DROPSEG = .FALSE. - ADD_XSEG= 0._EB - X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS - SELECT CASE(X1AXIS) - CASE(IAXIS) - PLNORMAL(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) - ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE - ALLOCATE(DX1FACE(ISTR:IEND)); DX1FACE = DXFACE - X1LO = ILO_FACE-CCGUARD; X1HI = IHI_FACE+CCGUARD - CASE(JAXIS) - PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 1._EB, 0._EB /) - ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE - ALLOCATE(DX1FACE(JSTR:JEND)); DX1FACE = DYFACE - X1LO = JLO_FACE-CCGUARD; X1HI = JHI_FACE+CCGUARD - CASE(KAXIS) - PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 0._EB, 1._EB /) - ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE - ALLOCATE(DX1FACE(KSTR:KEND)); DX1FACE = DZFACE - X1LO = KLO_FACE-CCGUARD; X1HI = KHI_FACE+CCGUARD - END SELECT + ! Test if Edge already on list: + INLIST = .FALSE. + DO ISEG=1,NEDGE + + IF ( (SEGNODS(NOD1) == CEELEM(NOD1,ISEG)) .AND. & ! same inod1 + (SEGNODS(NOD2) == CEELEM(NOD2,ISEG)) .AND. & ! same inod2 + (BODINT_PLANE%INDSEG(4,IWSSEG) == INDSEG(4,ISEG)) ) THEN ! same ibod + + IF (ANY(BODINT_PLANE%INDSEG(2:3,IWSSEG) == INDSEG(2,ISEG))) THEN + ! Edge already in list, Use SS Edge INDSEG: + INDSEG(1:4,ISEG) = BODINT_PLANE%INDSEG(1:4,IWSSEG) + INLIST = .TRUE. + EXIT + ELSE + WRITE(LU_ERR,*) "Error in GET_TRIANG_FACE_INT: SS EDGE Triangles not on 2 WS triang list INDSEG." + ENDIF + ENDIF + ENDDO + + IF ( .NOT.INLIST ) THEN ! Edge not in list. + NEDGE = NEDGE + 1 + CEELEM(NOD1:NOD2,NEDGE) = SEGNODS(NOD1:NOD2) + INDSEG(1:4,NEDGE) = BODINT_PLANE%INDSEG(1:4,IWSSEG) + ENDIF +ENDDO - ! Optimized for UG: - X1NOC=TRANS(NM)%NOC(X1AXIS) - MINX = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) - MAXX = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) +! Populate XYVERT points array: +IF(SIZE_X2X3VERT > SIZE(XYVERT,DIM=2)) THEN + WRITE(LU_ERR,*) 'Error in GET_TRIANG_FACE_INT : SIZE_X2X3VERT in greater than SIZE(XYVERT,DIM=2).' + CALL SHUTDOWN('Shutting down..') +ENDIF +XYVERT = 0._EB +XYVERT(IAXIS:JAXIS,1:SIZE_X2X3VERT) = X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT) +NVERT = NINTP +IF (NVERT > 0) INB_FLG = .TRUE. - IF (MAXX-MINX < GEOMEPS) THEN ! SEGMENT ALIGNED WITH PLANE. - LSTR = X1LO; LEND = X1HI - IF(X1NOC==0) THEN ! Optimized for Uniform Grid. - LSTR = MAX(X1LO, FLOOR((MINX-GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) - LEND = MIN(X1HI,CEILING((MAXX+GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) - ENDIF - X1X2(IAXIS:KAXIS) = XYZ2(IAXIS:KAXIS)-XYZ1(IAXIS:KAXIS); X1X2=X1X2/NORM2(X1X2) - T1 = GEOMETRY(IG)%EDGE_FACES(2,IWSEDG) - E1 = GEOMETRY(IG)%EDGE_FACES(3,IWSEDG) - ON1= GEOMETRY(IG)%FACES(3*(T1-1)+ON(E1)) - X1T1_OPNOD = GEOMETRY(IG)%VERTS(MAX_DIM*(ON1-1)+X1AXIS) - T2 = GEOMETRY(IG)%EDGE_FACES(4,IWSEDG) - E2 = GEOMETRY(IG)%EDGE_FACES(5,IWSEDG) - ON2= GEOMETRY(IG)%FACES(3*(T2-1)+ON(E2)) - X1T2_OPNOD = GEOMETRY(IG)%VERTS(MAX_DIM*(ON2-1)+X1AXIS) +DEALLOCATE(FVERT_IN_TRIANG, TRIVERT_IN_FACE) - X1O1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(ON1-1)+IAXIS:MAX_DIM*(ON1-1)+KAXIS)-XYZ1(IAXIS:KAXIS) - X1O2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(ON2-1)+IAXIS:MAX_DIM*(ON2-1)+KAXIS)-XYZ1(IAXIS:KAXIS) - X1O1 = X1O1/NORM2(X1O1); X1O2 = X1O2/NORM2(X1O2) - DO IPLN=LSTR,LEND - X1PLN = X1FACE(IPLN) - INPL_TEST = ABS(X1PLN-MAXX) < GEOMEPS - SPECIAL_SEG_IF : IF (INPL_TEST) THEN - ! Test that nodes on seg triangles not part of SEG are on - ! on side of X1PLN, and both normals have component in -X1AXIS dir. - IF ( (X1T1_OPNOD-X1PLN)<-GEOMEPS .AND. (X1T2_OPNOD-X1PLN)<-GEOMEPS ) THEN !-X1AXIS - ANG_FLG1 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T1)GEOMEPS .AND. X1O2(X1AXIS)GEOMEPS .AND. X1O1(X1AXIS)GEOMEPS .AND. (X1T2_OPNOD-X1PLN)>GEOMEPS ) THEN !+X1AXIS - ANG_FLG1 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T1)>-GEOMEPS .AND. GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T2)>-GEOMEPS - ANG_FLG2 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T2)<-GEOMEPS .AND. X1O2(X1AXIS)>X1O1(X1AXIS) - ANG_FLG3 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T1)<-GEOMEPS .AND. X1O1(X1AXIS)>X1O2(X1AXIS) - IF (ANG_FLG1 .OR. ANG_FLG2 .OR. ANG_FLG3) THEN - ADD_XSEG(X1AXIS)= 10._EB*GEOMEPS - INPL_TEST =.FALSE. - ENDIF - ENDIF - ENDIF SPECIAL_SEG_IF - DROPSEG=( INPL_TEST .OR. ((X1FACE(X1LO)-MAXX)>GEOMEPS) .OR. ((MAXX-X1FACE(X1HI))>GEOMEPS)) - IF (DROPSEG) EXIT - ENDDO - ENDIF - IF (DROPSEG) THEN - DEALLOCATE(X1FACE,DX1FACE) - EXIT ! EXIT X1AXIS=IAXIS:KAXIS LOOP - ENDIF - DEALLOCATE(X1FACE,DX1FACE) - ENDDO X1AXIS_LOOP - IF (DROPSEG) CYCLE +RETURN +END SUBROUTINE GET_TRIANG_FACE_INT - ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - ! Edge length and tangent unit vector: - DV(IAXIS:KAXIS) = XYZ2(IAXIS:KAXIS) - XYZ1(IAXIS:KAXIS) - SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) ! Segment length. - STANI(IAXIS:KAXIS) = DV(IAXIS:KAXIS) * SLEN**(-1._EB) ! Segment tangent versor. - ! ELSE - ! ! Edge length and tangent unit vector: - ! DVQ(IAXIS:KAXIS) = REAL(XYZ2(IAXIS:KAXIS),QB) - REAL(XYZ1(IAXIS:KAXIS),QB) - ! SLENQ = SQRT( DVQ(IAXIS)**2._QB + DVQ(JAXIS)**2._QB + DVQ(KAXIS)**2._QB ) ! Segment length. - ! STANIQ(IAXIS:KAXIS) = DVQ(IAXIS:KAXIS) * SLENQ**(-1._QB) ! Segment tangent versor. - ! SLEN = REAL(SLENQ,EB) - ! STANI(IAXIS:KAXIS) = REAL(STANIQ(IAXIS:KAXIS),EB) - ! ENDIF +! ------------------------- INSERT_POINT_2D ------------------------------------- - ! Add segment ends as intersections: - BODINT_CELL_EDGE%NWCROSS = 2 ! Nodes 1,2 of segment are considered intersection. - BODINT_CELL_EDGE%SVAR(1) = 0 ! Coordinate along stani of Node 1. - BODINT_CELL_EDGE%SVAR(2) = SLEN ! Coordinate along stani of Node 2. +SUBROUTINE INSERT_POINT_2D(XP,NVERT,SIZE_XYVERT,XYVERT,INOD) +REAL(EB), INTENT(IN) :: XP(IAXIS:JAXIS) +INTEGER, INTENT(INOUT) :: NVERT +INTEGER, INTENT(INOUT) :: SIZE_XYVERT +REAL(EB), ALLOCATABLE, INTENT(INOUT) :: XYVERT(:,:) +INTEGER, INTENT(OUT) :: INOD - ! Now find intersections: - X1AXIS_LOOP2 : DO X1AXIS=IAXIS,KAXIS - SELECT CASE(X1AXIS) - CASE(IAXIS) - PLNORMAL(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) - ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE - ALLOCATE(DX1FACE(ISTR:IEND)); DX1FACE = DXFACE - X1LO = ILO_FACE-CCGUARD; X1HI = IHI_FACE+CCGUARD - CASE(JAXIS) - PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 1._EB, 0._EB /) - ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE - ALLOCATE(DX1FACE(JSTR:JEND)); DX1FACE = DYFACE - X1LO = JLO_FACE-CCGUARD; X1HI = JHI_FACE+CCGUARD - CASE(KAXIS) - PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 0._EB, 1._EB /) - ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE - ALLOCATE(DX1FACE(KSTR:KEND)); DX1FACE = DZFACE - X1LO = KLO_FACE-CCGUARD; X1HI = KHI_FACE+CCGUARD - END SELECT +! Local Variables: +LOGICAL :: INLIST +REAL(EB):: DV(IAXIS:JAXIS), DVNORM +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYVERT_AUX - ! Optimized for UG: - X1NOC=TRANS(NM)%NOC(X1AXIS) - MINX = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) - MAXX = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) - LSTR = X1LO; LEND = X1HI - IF(X1NOC==0) THEN ! Optimized for Uniform Grid. - LSTR = MAX(X1LO, FLOOR((MINX-GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) - LEND = MIN(X1HI,CEILING((MAXX+GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) - ENDIF +INLIST = .FALSE. +DO INOD=1,NVERT + DV(IAXIS:JAXIS) = XP(IAXIS:JAXIS) - XYVERT(IAXIS:JAXIS,INOD) + DVNORM = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB ) + IF ( DVNORM < GEOMEPS ) THEN + INLIST = .TRUE. + EXIT + ENDIF +ENDDO +IF ( .NOT.INLIST ) THEN + NVERT = NVERT + 1 + INOD = NVERT + ! If NVERT > SIZE(XYVERT,DIM=2) reallocate: + IF(NVERT > SIZE_XYVERT) THEN + ALLOCATE(XYVERT_AUX(IAXIS:JAXIS,1:SIZE_XYVERT)); XYVERT_AUX(:,:) = XYVERT(:,:) + DEALLOCATE(XYVERT); ALLOCATE(XYVERT(IAXIS:JAXIS,SIZE_XYVERT+DELTA_VERT)); XYVERT = 0._EB + XYVERT(IAXIS:JAXIS,1:SIZE_XYVERT) = XYVERT_AUX(IAXIS:JAXIS,1:SIZE_XYVERT) + SIZE_XYVERT = SIZE_XYVERT + DELTA_VERT + ENDIF + XYVERT(IAXIS:JAXIS,INOD) = XP(IAXIS:JAXIS) +ENDIF - DO IPLN=LSTR,LEND - X1PLN = X1FACE(IPLN); - OUTPLANE = ((X1PLN-MAXX) > GEOMEPS) .OR. ((MINX-X1PLN) > GEOMEPS) - IF (OUTPLANE) CYCLE ! Make sure to drop jstr, jend if out of segment length. +RETURN +END SUBROUTINE INSERT_POINT_2D - ! Drop intersections in segment nodes: - ! Compute: dot(plnormal, xyzv - xypl): - DOT1 = XYZ1(X1AXIS) - X1PLN - DOT2 = XYZ2(X1AXIS) - X1PLN - IF (ABS(DOT1) <= GEOMEPS) CYCLE - IF (ABS(DOT2) <= GEOMEPS) CYCLE +! ---------------------------- DEBUG_WAIT --------------------------------------- +SUBROUTINE DEBUG_WAIT +USE COMP_FUNCTIONS, ONLY: FDS_SLEEP +INTEGER I +INTEGER, PARAMETER :: N_SEG=20 +WRITE(LU_ERR,'(A,I6,A,I2,A)') 'Process ID=',MY_RANK,'; execution halted for ',N_SEG,' seconds : ' +DO I=1,N_SEG + CALL FDS_SLEEP(1._EB) + IF (I NWCROSS_SVAR) THEN - ALLOCATE(SVAR_AUX(NWCROSS_SVAR+CC_DELTA_NBCROSS)); SVAR_AUX = -1._EB - SVAR_AUX(1:NWCROSS-1) = BODINT_CELL_EDGE%SVAR(1:NWCROSS-1) - CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_CELL_EDGE%SVAR) - ENDIF - BODINT_CELL_EDGE%SVAR(NWCROSS) = 1._EB / GEOMEPS - SAMEINT = .FALSE. - DO IBCR=1,NWCROSS - IF (ABS(SVARI - BODINT_CELL_EDGE%SVAR(IBCR)) < GEOMEPS) THEN - SAMEINT = .TRUE. - EXIT - ENDIF - IF ( SVARI < BODINT_CELL_EDGE%SVAR(IBCR) ) EXIT - ENDDO - IF (SAMEINT) CYCLE +CHARACTER(LABEL_LENGTH) :: ID,MATL_ID,TEXTURE_MAPPING, & + DEVC_ID,CTRL_ID,SURF_IDS(3),SURF_ID6(6),MOVE_ID +CHARACTER(FN_LENGTH) :: BUFFER,FN_BINGEOM,BINARY_FILE +CHARACTER(LABEL_LENGTH), ALLOCATABLE, DIMENSION(:) :: SURF_ID +CHARACTER(MESSAGE_LENGTH) :: FYI +REAL(EB), ALLOCATABLE, DIMENSION(:) :: ZVALS,TFACES +REAL(EB), ALLOCATABLE, TARGET, DIMENSION(:) :: VERTS,VERTS_AUX +INTEGER, ALLOCATABLE, DIMENSION(:) :: SURF_ID_IND,POLY +INTEGER, ALLOCATABLE, TARGET, DIMENSION(:) :: FACES,FACES_AUX,VOLUS,OFACES,SURFS,SURFS2 +LOGICAL, ALLOCATABLE, DIMENSION(:) :: IS_EXTERNAL - ! Here copy from the back (updated nbcross) to the ibcr location: - DO IDUM = NWCROSS,IBCR+1,-1 - BODINT_CELL_EDGE%SVAR(IDUM) = BODINT_CELL_EDGE%SVAR(IDUM-1) - ENDDO - BODINT_CELL_EDGE%SVAR(IBCR) = SVARI - BODINT_CELL_EDGE%NWCROSS = NWCROSS +REAL(EB) :: SPHERE_ORIGIN(3),SPHERE_RADIUS,TEXTURE_ORIGIN(3),TEXTURE_SCALE(2),XB(6),DX,BOX_XYZ(3),& + ZMIN,VOLUME,TXMIN,TXMAX,TYMIN,TYMAX,TX,TY,DV1(MAX_DIM),DV2(MAX_DIM),& + NVECI(MAX_DIM),DXCEN(MAX_DIM),DOTI,TRANSPARENCY,CYLINDER_ORIGIN(3),CYLINDER_AXIS(3),& + CYLINDER_RADIUS,CYLINDER_LENGTH,EXTRUDE,CELL_BLOCK_ORIENTATION(3) - ENDDO - DEALLOCATE(X1FACE,DX1FACE) - ENDDO X1AXIS_LOOP2 +INTEGER :: MAX_IDS=0,MAX_SURF_IDS=0,MAX_ZVALS=0,MAX_VERTS=0,MAX_FACES=0,MAX_VOLUS=0,MAX_POLY_VERTS=0,& + N_VERTS,N_FACES,N_FACES_TEMP,N_VOLUS,N_ZVALS,N_SURF_ID,N_SURF_ID2,N_POLY_VERTS,& + MATL_INDEX,IOS,IZERO,N,I,J,K,IJ,FIRST_FACE_INDEX,I1,I2,I3,I4,& + GEOM_TYPE,NXB,IJK(3),N_LEVELS,N_LAT,N_LONG,SPHERE_TYPE,BOXVERTLIST(8),NI,NIJ,IVOL,SORT_FACES,II,II1,II2,II3,& + X1AXIS,NNN,CYLINDER_NSEG_THETA,CYLINDER_NSEG_AXIS,CYL_FIND(LOW_IND:HIGH_IND,1:3),CELL_BLOCK_IOR - ! 3. The increasing svar intersections are used to define the INBOUNDCC type - ! cut-edges and Cartesian Cells containing them. Add to CUT_EDGE, define the - ! CUT_EDGE entry in CCVAR(i,j,k,CC_IDCE): - DO IEDGE=1,BODINT_CELL_EDGE%NWCROSS-1 +LOGICAL :: HAVE_SURF,HAVE_MATL,IN_LIST,SURF_INDEX_PER_FACE,BNDF_GEOM,LOGTEST +REAL(EB), POINTER, DIMENSION(:) :: V1,V2,V3,V4 +INTEGER, POINTER, DIMENSION(:) :: FACEI,FACEJ,FACE_FROM,FACE_TO,VOL +TYPE(MESH_TYPE), POINTER :: M +TYPE(GEOMETRY_TYPE), POINTER :: G - ! Location along Segment: - SVAR1 = BODINT_CELL_EDGE%SVAR(IEDGE ) - SVAR2 = BODINT_CELL_EDGE%SVAR(IEDGE+1) +INTEGER, PARAMETER :: CAD_GEOM_TYPE=1,TERRAIN_GEOM_TYPE=2,& + BOX_GEOM_TYPE=3,SPHERE_GEOM_TYPE=4,CYLINDER_GEOM_TYPE=5 ! These 4 are for internal use. - ! Location of midpoint of cut-edge: - SVAR12 = 0.5_EB * (SVAR1+SVAR2) +REAL(EB), PARAMETER :: MAX_VAL=1.0E20_EB - ! Define Cartesian cell this cut-edge belongs: - ! Optimized for UG version: - XPOS = XYZ1(IAXIS) + SVAR12*STANI(IAXIS) + ADD_XSEG(IAXIS) - IF(TRANS(NM)%NOC(IAXIS)==0)THEN - II2 = FLOOR( (XPOS-XFACE(ILO_FACE))/DXFACE(ILO_FACE) ) + ILO_CELL - ! Discard cut-edges on faces laying on x2hi and x3hi. - IF ( (II2 < ILO_CELL-CCGUARD) .OR. (II2 > IHI_CELL+CCGUARD) ) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO II2=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD - IF((XPOS-XFACE(II2-1)) >= 0._EB .AND. (XFACE(II2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF +LOGICAL :: READ_BINARY - XPOS = XYZ1(JAXIS) + SVAR12*STANI(JAXIS) + ADD_XSEG(JAXIS) - IF(TRANS(NM)%NOC(JAXIS)==0)THEN - JJ2 = FLOOR( (XPOS-YFACE(JLO_FACE))/DYFACE(JLO_FACE) ) + JLO_CELL - IF ( (JJ2 < JLO_CELL-CCGUARD) .OR. (JJ2 > JHI_CELL+CCGUARD) ) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO JJ2=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD - IF((XPOS-YFACE(JJ2-1)) >= 0._EB .AND. (YFACE(JJ2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF +INTEGER :: IJF, IJB, IJE, NM +INTEGER, ALLOCATABLE, DIMENSION(:) :: B_IND,E_IND,F_IND +REAL(EB) :: XLOW,XHI,YLOW,YHI,ZLOW,ZHI,DELX,DELY,DELTZ - XPOS = XYZ1(KAXIS) + SVAR12*STANI(KAXIS) + ADD_XSEG(KAXIS) - IF(TRANS(NM)%NOC(KAXIS)==0)THEN - KK2 = FLOOR( (XPOS-ZFACE(KLO_FACE))/DZFACE(KLO_FACE) ) + KLO_CELL - IF ( (KK2 < KLO_CELL-CCGUARD) .OR. (KK2 > KHI_CELL+CCGUARD) ) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO KK2=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD - IF((XPOS-ZFACE(KK2-1)) >= 0._EB .AND. (ZFACE(KK2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF +LOGICAL :: IS_TERRAIN,EXTEND_TERRAIN,WRITE_WARNING +REAL(EB):: ZVAL_HORIZON, ZVAL_FACTOR - ! CCVAR edge number: - IF ( MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) > 0 ) THEN ! There is already - ! an entry in CUT_EDGE. - CEI = MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) - ELSE ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ II2, JJ2, KK2, 0, CC_GS /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCC - ENDIF +INTEGER :: START_FACE_LO, START_FACE_MID, START_FACE_HI - ! Add vertices, non repeated vertex entries at this point. - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - ! Define vertices for this segment: - ! xv1 yv1 zv1 - ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - XYZV1(IAXIS:KAXIS) = (/ XYZ1(IAXIS)+SVAR1*STANI(IAXIS), & - XYZ1(JAXIS)+SVAR1*STANI(JAXIS), & - XYZ1(KAXIS)+SVAR1*STANI(KAXIS) /) - CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) - ! xv2 yv2 zv2 - XYZV2(IAXIS:KAXIS) = (/ XYZ1(IAXIS)+SVAR2*STANI(IAXIS), & - XYZ1(JAXIS)+SVAR2*STANI(JAXIS), & - XYZ1(KAXIS)+SVAR2*STANI(KAXIS) /) - CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) - ! ELSE - ! XYZV1(IAXIS:KAXIS) = REAL((/ REAL(XYZ1(IAXIS),QB)+REAL(SVAR1,QB)*STANIQ(IAXIS), & - ! REAL(XYZ1(JAXIS),QB)+REAL(SVAR1,QB)*STANIQ(JAXIS), & - ! REAL(XYZ1(KAXIS),QB)+REAL(SVAR1,QB)*STANIQ(KAXIS) /),EB) - ! CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) - ! ! xv2 yv2 zv2 - ! XYZV2(IAXIS:KAXIS) = REAL((/ REAL(XYZ1(IAXIS),QB)+REAL(SVAR2,QB)*STANIQ(IAXIS), & - ! REAL(XYZ1(JAXIS),QB)+REAL(SVAR2,QB)*STANIQ(JAXIS), & - ! REAL(XYZ1(KAXIS),QB)+REAL(SVAR2,QB)*STANIQ(KAXIS) /),EB) - ! CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) - ! ENDIF +INTEGER :: N_EDGES,N_BEDGES,N_FACES_ORIG,N_VERTS_ORIG,N_VOLUS_ORIG,ICPT,CLOSE_PT(NOD1:NOD4+1), RGB(3)=-1 +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: EDGES,FACE_EDGES,EDGE_FACES,BOUND_EDGES,BOUND_EDGES2 +INTEGER, ALLOCATABLE, DIMENSION(:) :: NBND_EDGE,COUNTED_EDGES +REAL(EB) :: X_CEN,Y_CEN,ZMIN2,CORNER_PT(IAXIS:JAXIS,NOD1:NOD4+1),DIST,DISTI +REAL(EB), PARAMETER :: VERXY(IAXIS:JAXIS,NOD1:NOD4) = & + RESHAPE((/0._EB,1._EB,-1._EB,0._EB,0._EB,-1._EB,1._EB,0._EB/),(/ 2, 4 /)) +CHARACTER(25) :: COLOR='null' - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + 1 - CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE) = (/ INOD1, INOD2 /) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE) = & - (/ GEOMETRY(IG)%EDGE_FACES(1,IWSEDG), & - GEOMETRY(IG)%EDGE_FACES(2,IWSEDG), & - GEOMETRY(IG)%EDGE_FACES(4,IWSEDG), IG /) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE - ENDDO +LOGICAL :: DONE - ENDDO IWSEDG_LOOP +INTEGER :: ILINE, IERR +INTEGER :: IG, IVERT - ! Deallocate BODINT_CELL_EDGE: - DEALLOCATE(BODINT_CELL_EDGE%SVAR) +INTEGER, ALLOCATABLE, DIMENSION(:) :: GEOM_LINE,GEOM_LINE2 +INTEGER, PARAMETER :: DELTA_GEOM_LINE=1000 +INTEGER :: GEOM_LINE_SIZE -ENDDO GEOM_LOOP +NAMELIST /GEOM/ BNDF_GEOM,BINARY_FILE,CELL_BLOCK_IOR,CELL_BLOCK_ORIENTATION,COLOR,CYLINDER_ORIGIN,CYLINDER_AXIS,& + CYLINDER_RADIUS,CYLINDER_LENGTH,CYLINDER_NSEG_THETA,CYLINDER_NSEG_AXIS,& + EXTRUDE,EXTEND_TERRAIN,FACES,FYI,ID,IJK,IS_TERRAIN,MOVE_ID,N_LAT,N_LEVELS,N_LONG,POLY,& + RGB,SPHERE_ORIGIN,SPHERE_RADIUS,SPHERE_TYPE,SURF_ID,SURF_IDS,SURF_ID6,& + TEXTURE_MAPPING,TEXTURE_ORIGIN,TEXTURE_SCALE,TRANSPARENCY,& + VERTS,XB,ZMIN,ZVALS,ZVAL_HORIZON -! Now filter out CC_INBOUNDCC cut-edges that lay within the SOLID: -DO CEI=EDGE_START,MESHES(NM)%N_CUTEDGE_MESH - ! Here we have cut-edges on the cell belonging to two or more bodies: - I = MESHES(NM)%CUT_EDGE(CEI)%IJK(IAXIS) - J = MESHES(NM)%CUT_EDGE(CEI)%IJK(JAXIS) - K = MESHES(NM)%CUT_EDGE(CEI)%IJK(KAXIS) +! first pass - count number of &GEOM lines. - ! First cut-edges in the cell: - NEDGE =MESHES(NM)%CUT_EDGE(CEI)%NEDGE - TWOBOD_EDG=.FALSE. - IF (NEDGE > 0) IG1 = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,1) - DO IEDGE=2,NEDGE - IF (MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) /= IG1) THEN - TWOBOD_EDG =.TRUE. - EXIT - ENDIF - ENDDO - ! Low-High x,y,z face Edges: - IF(.NOT.TWOBOD_EDG) THEN - IFCELL_DO : DO IFCELL=1,6 - CEI2 = MESHES(NM)%FCVAR(I+IADD(IFCELL),J+JADD(IFCELL),K+KADD(IFCELL),CC_IDCE,AXIS(IFCELL)) - IF (CEI2 < 1) CYCLE - DO IEDGE=1,MESHES(NM)%CUT_EDGE(CEI2)%NEDGE - IF (MESHES(NM)%CUT_EDGE(CEI2)%INDSEG(4,IEDGE) /= IG1) THEN - TWOBOD_EDG =.TRUE. - EXIT IFCELL_DO - ENDIF - ENDDO - ENDDO IFCELL_DO +N_GEOMETRY=0 +ALLOCATE(GEOM_LINE(DELTA_GEOM_LINE)); GEOM_LINE = 0 +GEOM_LINE_SIZE = SIZE(GEOM_LINE,DIM=1) +REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 +COUNT_GEOM_LOOP: DO + CALL CHECKREAD('GEOM',LU_INPUT,IOS) ; IF (STOP_STATUS==SETUP_STOP) RETURN + IF (IOS==1) EXIT COUNT_GEOM_LOOP + IF(N_GEOMETRY+1 > GEOM_LINE_SIZE) THEN + ALLOCATE(GEOM_LINE2(GEOM_LINE_SIZE)) + GEOM_LINE2(1:GEOM_LINE_SIZE) = GEOM_LINE(1:GEOM_LINE_SIZE) + DEALLOCATE(GEOM_LINE) + ALLOCATE(GEOM_LINE(GEOM_LINE_SIZE+DELTA_GEOM_LINE)); GEOM_LINE = 0 + GEOM_LINE(1:GEOM_LINE_SIZE) = GEOM_LINE2(1:GEOM_LINE_SIZE) + GEOM_LINE_SIZE = SIZE(GEOM_LINE,DIM=1) + DEALLOCATE(GEOM_LINE2) ENDIF - IF(.NOT.TWOBOD_EDG) CYCLE + READ(LU_INPUT,'(A)')BUFFER + N_GEOMETRY=N_GEOMETRY+1 + GEOM_LINE(N_GEOMETRY) = INPUT_FILE_LINE_NUMBER +ENDDO COUNT_GEOM_LOOP +REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 +IF (N_GEOMETRY==0) RETURN - ! Here we have cut-edges on the cell belonging to two or more bodies: - ! First discard if CELLRT=true, we won't be using cut-edges: - IF (CELLRT(I,J,K)) CYCLE +! Allocate GEOMETRY array - ! Now figure out which edges are inside other SOLIDS: - ! Ray tracing in either X, Y or Z directions: - ! 1. For the segment center point P provide: - ! a. Its coordinates P={xp,yp,zp}. - ! b. Direction X1 for Ray shooting (IAXIS,JAXIS,KAXIS). - ALLOCATE(SOLID_EDGE(1:NEDGE)); SOLID_EDGE(1:NEDGE)=.FALSE. - DO IEDGE=1,NEDGE - ! No body associated with segment. Might not be needed. - IG = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) - IF ( IG < 1 ) CYCLE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - XP(IAXIS:KAXIS) = 0.5_EB*(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + & - MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2))) - ! Direction NP: - NP(IAXIS:KAXIS) = 0._EB - DO I_NP=1,MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,IEDGE) - ITRI = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1+I_NP,IEDGE) - NP(IAXIS:KAXIS) = NP(IAXIS:KAXIS) + GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,ITRI) - ENDDO - X2AXIS = MAXLOC(ABS(NP(IAXIS:KAXIS)),DIM=1) - CALL GET_IS_SOLID_3D(X2AXIS,XP,I,J,K,SOLID_EDGE(IEDGE)) - ENDDO +ALLOCATE(GEOMETRY(0:N_GEOMETRY),STAT=IZERO) +CALL ChkMemErr('READ_GEOM','GEOMETRY',IZERO) - ! Now drop SEGS with SOLID_EDGE(IEDGE)=true: - COUNT = 0 - DO IEDGE=1,NEDGE - IF (SOLID_EDGE(IEDGE)) CYCLE - COUNT=COUNT+1 - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,COUNT) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,COUNT) = & - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,IEDGE) - ENDDO +! third pass - read GEOM data - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = COUNT - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,COUNT+1:NEDGE) = CC_UNDEFINED - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,COUNT+1:NEDGE) = CC_UNDEFINED - DEALLOCATE(SOLID_EDGE) -ENDDO +READ_GEOM_LOOP: DO N=1,N_GEOMETRY + G=>GEOMETRY(N) -T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX ) + CURRENT_TIME() - TNOW + CALL CHECKREAD('GEOM',LU_INPUT,IOS) ; IF (STOP_STATUS==SETUP_STOP) RETURN + IF (IOS==1) EXIT READ_GEOM_LOOP -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - NCUTEDG = 0 - DO CEI=1,MESHES(NM)%N_CUTEDGE_MESH - NCUTEDG = NCUTEDG + MESHES(NM)%CUT_EDGE(CEI)%NEDGE - ENDDO - WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-edges in mesh : ',NCUTEDG,'. ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-edges in mesh : ',NCUTEDG,'. ' + IF(MAX_ZVALS/=MAXIMUM_GEOMETRY_ZVALS) THEN ! Reset to default GEOMETRY values and allocate ARRAYS. + MAX_ZVALS=0; MAX_VERTS=0; MAX_FACES=0; MAX_VOLUS=0; MAX_IDS=0; MAX_SURF_IDS=0; MAX_POLY_VERTS=0 + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + CALL ALLOCATE_BUFFERS ENDIF -ENDIF -RETURN -END SUBROUTINE GET_CARTCELL_CUTEDGES - -! ------------------------- GET_IS_SOLID_3D ------------------------------------- - -SUBROUTINE GET_IS_SOLID_3D(X2AXIS,XP,I,J,K,IS_SOLID) + GEOM_RESIZE_DO : DO + DONE=.TRUE. + CALL SET_GEOM_DEFAULTS + READ(LU_INPUT,GEOM,END=35,ERR=22,IOSTAT=IOS) + 22 IF (IOS>0) THEN + IF ( (ZVALS(MAX_ZVALS+1) < MAX_VAL) .OR. (VERTS(3*MAX_VERTS+1) < MAX_VAL) .OR.& + (FACES(4*MAX_FACES+1) > 0) .OR. (VOLUS(4*MAX_VOLUS+1) > 0)) THEN + ! Resize MAX_ZVALS, MAX_VERTS, MAX_FACES, MAX_VOLUS: + MAX_ZVALS = MAX_ZVALS + 25000 + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + CALL ALLOCATE_BUFFERS + DONE=.FALSE. + ELSE + WRITE(BUFFER,'(A,A,A)') 'ERROR(101): GEOM ID=',TRIM(ID),'. Check &GEOM input line.' + CALL SHUTDOWN(TRIM(BUFFER)) + RETURN + ENDIF + REWIND(LU_INPUT); DO ILINE=1,GEOM_LINE(N)-1; READ(LU_INPUT,'(A)') BUFFER; ENDDO + ENDIF + IF (DONE) EXIT GEOM_RESIZE_DO + ENDDO GEOM_RESIZE_DO -INTEGER, INTENT(IN) :: X2AXIS,I,J,K -REAL(EB), INTENT(IN) :: XP(IAXIS:KAXIS) -LOGICAL, INTENT(OUT):: IS_SOLID + IF (COLOR/='null') THEN + CALL COLOR2RGB(RGB,COLOR) + ENDIF + G%CELL_BLOCK_IOR = CELL_BLOCK_IOR + G%CELL_BLOCK_ORIENTATION = CELL_BLOCK_ORIENTATION + G%RGB = RGB + G%TRANSPARENCY = TRANSPARENCY + N_VERTS=0 + N_FACES=0 + TFACES(1:6*MAX_FACES) = -1.0_EB + N_VOLUS=0 + N_ZVALS=0 + N_POLY_VERTS=0 + IF(TRIM(BINARY_FILE)/='null') READ_BINARY = .TRUE. ! In case a binary name is provided, read the binary. + G%READ_BINARY = READ_BINARY -! Logical Variables: -INTEGER :: IJK(IAXIS:KAXIS) -REAL(EB):: NVEC(IAXIS:JAXIS)=(/ 1._EB, 0._EB /), XY(IAXIS:JAXIS), PLNORMAL(IAXIS:KAXIS), X1PLN, X3RAY -INTEGER :: X1AXIS, X3AXIS, X2LO, X2HI, X3LO, X3HI -LOGICAL :: TRI_ONPLANE_ONLY =.FALSE., RAYTRACE_X2_ONLY =.TRUE. + ! Get number of SURF_IDs defined for the GEOM: + N_SURF_ID = 0 + DO I = 1, MAX_SURF_IDS + IF( SURF_ID(I)=='null' ) EXIT ! First 'null' + N_SURF_ID = N_SURF_ID + 1 + ENDDO -IJK(IAXIS:KAXIS) = (/ I, J, K /) + READ_BIN_COND : IF (.NOT.READ_BINARY) THEN + ! count VERTS + DO I = 1, MAX_VERTS + IF (ANY(VERTS(3*I-2:3*I)>=MAX_VAL)) EXIT + N_VERTS = N_VERTS+1 + ENDDO -SELECT CASE(X2AXIS) - CASE(JAXIS) - X1AXIS = IAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) - ! x2, x3 axes parameters: - X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD - X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD - X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) - ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: - X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS - CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & - X2LO,X2HI,X3LO,X3HI,YFACE,ZFACE,JLO_CELL,JHI_CELL,& - KLO_CELL,KHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) - CASE(KAXIS) - X1AXIS = JAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 1._EB, 0._EB /) - ! x2, x3 axes parameters: - X2LO = KLO_FACE-CCGUARD; X2HI = KHI_FACE+CCGUARD - X3AXIS = IAXIS; X3LO = ILO_FACE-CCGUARD; X3HI = IHI_FACE+CCGUARD - X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) - ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: - X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS - CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & - X2LO,X2HI,X3LO,X3HI,ZFACE,XFACE,KLO_CELL,KHI_CELL,& - ILO_CELL,IHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) - CASE(IAXIS) - X1AXIS = KAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 0._EB, 1._EB /) - ! x2, x3 axes parameters: - X2LO = ILO_FACE-CCGUARD; X2HI = IHI_FACE+CCGUARD - X3AXIS = JAXIS; X3LO = JLO_FACE-CCGUARD; X3HI = JHI_FACE+CCGUARD - X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) - ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: - X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS - CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & - X2LO,X2HI,X3LO,X3HI,XFACE,YFACE,ILO_CELL,IHI_CELL,& - JLO_CELL,JHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) -END SELECT + ! count POLY Verts: + DO I = 1,MAX_POLY_VERTS + IF (POLY(I)==0) EXIT + N_POLY_VERTS = N_POLY_VERTS+1 + ENDDO -IF (BODINT_PLANE2%NSEGS == 0) THEN - IS_SOLID =.FALSE. - RETURN -ENDIF + ! count FACES + DO I = 1, MAX_FACES + IF (ALL(FACES(4*(I-1)+1:4*(I-1)+3)==0)) EXIT + N_FACES = N_FACES+1 + ENDDO -XY(IAXIS:JAXIS) = (/ XP(X2AXIS), X3RAY /) -CALL GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) + ! Now split FACES array into FACES (connectivity), and SURFS, i.e. local surf ID: + IF(N_FACES > 0) THEN + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)) + DO I = 1, N_FACES + FACES(3*(I-1)+1:3*(I-1)+3) = FACES(4*(I-1)+1:4*(I-1)+3) + SURFS(I) = FACES(4*(I-1)+4) + IF(SURFS(I) > N_SURF_ID) THEN + WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(701): problem with GEOM ',TRIM(ID),& + ', local SURF_ID index for FACE ',I,'out of bounds.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ENDIF -RETURN -END SUBROUTINE GET_IS_SOLID_3D + ! count VOLUS + DO I = 1, MAX_VOLUS + IF (ANY(VOLUS(4*I-3:4*I)==0)) EXIT + N_VOLUS = N_VOLUS+1 + ENDDO + ! count ZVALS + DO I = 1, MAX_ZVALS + IF (ZVALS(I)>MAX_VAL) EXIT + N_ZVALS=N_ZVALS+1 + ENDDO -! ---------------------- GET_CARTCELL_CUTFACES ---------------------------------- + ELSE READ_BIN_COND + ! Read Binary file, reset values of other geometry types to default: + ! Defaults for terrain, sphere, cylinder, box, etc. + XB=1.001_EB*MAX_VAL + SPHERE_ORIGIN = 1.001_EB*MAX_VAL + SPHERE_RADIUS = 1.001_EB*MAX_VAL + CYLINDER_LENGTH = 1.001_EB*MAX_VAL + CYLINDER_RADIUS = 1.001_EB*MAX_VAL + CYLINDER_ORIGIN = 1.001_EB*MAX_VAL + CYLINDER_AXIS = 1.001_EB*MAX_VAL + CYLINDER_NSEG_THETA = -1 + CYLINDER_NSEG_AXIS = -1 + N_LEVELS=-1 + N_LAT=-1 + N_LONG=-1 + SPHERE_TYPE=-1 -SUBROUTINE GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) + ! This is to add the SURF_IDS to SURF_ID for analytical geometries being read from bingeom: + IF (TRIM(SURF_ID(1))=='null' .AND. TRIM(SURF_IDS(1))/='null') THEN ! Case of cylinders. + SURF_ID(1:3) = SURF_IDS(1:3) + N_SURF_ID = 3 + DO I=2,3 + IF (TRIM(SURF_ID(I))=='null') THEN + WRITE(MESSAGE,'(A,A,A)') 'ERROR(702): problem with GEOM ',TRIM(ID),', SURF_IDS not defined properly.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ENDIF -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT + ! Read Binary + OPEN(UNIT=731,FILE=TRIM(BINARY_FILE),STATUS='OLD',FORM='UNFORMATTED',ACTION='READ',ERR=221,IOSTAT=IOS) + IF (IOS==0) THEN + READ(731) GEOM_TYPE + READ(731) N_VERTS,N_FACES,N_SURF_ID2,N_VOLUS + IF(GEOM_TYPE==TERRAIN_GEOM_TYPE) THEN + IS_TERRAIN=.TRUE. + ELSE ! If GEOM is of any type other than terrains, set it to CAD type. + GEOM_TYPE=CAD_GEOM_TYPE + ENDIF + ! Now reallocate if necessary, twice size is to make sure terrains have sufficient array size allocated: + IF (2*N_VERTS > MAX_VERTS) THEN; MAX_VERTS=2*N_VERTS; DEALLOCATE(VERTS); ALLOCATE(VERTS(1:3*MAX_VERTS)); ENDIF + IF (2*N_FACES > MAX_FACES) THEN + MAX_FACES=2*N_FACES + DEALLOCATE(FACES); ALLOCATE(FACES(1:3*MAX_FACES)) + DEALLOCATE(TFACES); ALLOCATE(TFACES(1:6*MAX_FACES)) + ENDIF + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(MAX_FACES)) + IF (2*N_VOLUS > MAX_VOLUS) THEN; MAX_VOLUS=2*N_VOLUS; DEALLOCATE(VOLUS); ALLOCATE(VOLUS(1:4*N_VOLUS)); ENDIF + ! Read Vertices, Faces, Surfs and Volus: + IF (N_VERTS > 0 ) READ(731) VERTS(1:3*N_VERTS) + IF (N_FACES > 0 ) THEN + READ(731) FACES(1:3*N_FACES) + READ(731) SURFS(1:N_FACES) + ENDIF + IF (N_VOLUS > 0 ) READ(731) VOLUS(1:4*N_VOLUS) + CLOSE(731) + IF (ANY(SURFS(1:N_FACES)>0) .AND. TRIM(SURF_ID(1))=='null') THEN + WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR(703): missing SURF_ID in &GEOM line ',TRIM(ID),& + ' for binary file ',TRIM(BINARY_FILE),& + '. Add SURF_ID in said &GEOM line.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + IF(N_SURF_ID2 /= N_SURF_ID) THEN + WRITE(MESSAGE,'(A,A,A,I8,A,I8,A,A,A)') 'ERROR(704): problem with GEOM ',TRIM(ID),& + ', number of surfaces in SURF_ID field (',N_SURF_ID, & + ') not equal to number of surfaces (',N_SURF_ID2,& + ') defined in bingeom ',TRIM(BINARY_FILE),'.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + DO I = 1, N_FACES + IF(SURFS(I) > N_SURF_ID) THEN + WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(701): problem with GEOM ',TRIM(ID),& + ', local SURF_ID index for FACE ',I,'out of bounds.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ENDIF +221 IF(IOS > 0) THEN + WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR(705): could not read binary connectivity for GEOM ',TRIM(ID),& + ' in binary file ',TRIM(BINARY_FILE),& + '. Check file exists.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDIF READ_BIN_COND -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -LOGICAL, INTENT(IN) :: BNDINT_FLAG + N_VERTS_ORIG = N_VERTS + N_FACES_ORIG = N_FACES + N_VOLUS_ORIG = N_VOLUS - ! Local Variables: -INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI -INTEGER :: I,J,K, JJ, KK -INTEGER, DIMENSION(LOW_IND:HIGH_IND,IAXIS:KAXIS) :: FSID_XYZ, CEIB_XYZ -LOGICAL :: OUTCELL1 -INTEGER :: X1AXIS, X2AXIS, X3AXIS -INTEGER :: XIAXIS, XJAXIS, XKAXIS -INTEGER :: X2LO, X2HI, X3LO, X3HI -INTEGER :: X2LO_CELL, X2HI_CELL, X3LO_CELL, X3HI_CELL -REAL(EB), DIMENSION(MAX_DIM) :: PLNORMAL -INTEGER, DIMENSION(MAX_DIM) :: IJK -REAL(EB) :: X1PLN -LOGICAL :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY -INTEGER :: NVERT, NEDGE, NFACE, NSEG, NCF, FNVERT, FNEDGE, CEI, NSEG_FACE -REAL(EB) :: FVERT(IAXIS:JAXIS,NOD1:NOD4) -LOGICAL :: INB_FLG -INTEGER :: CEELEM(NOD1:NOD2,1:CC_MAXCEELEM_FACE) -INTEGER :: INDSEG(CC_MAX_WSTRIANG_SEG+3,CC_MAXCEELEM_FACE) -REAL(EB) :: XYVERT(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) -INTEGER :: TRIS(NOD1:NOD3), ITRI -REAL(EB) :: XYEL(IAXIS:JAXIS,NOD1:NOD3), VAL, DUMMY(IAXIS:JAXIS) -REAL(EB) :: A_COEF, B_COEF, C_COEF, D_COEF, DENOM -INTEGER :: INDXI(IAXIS:KAXIS), INDIF, INDJF, INDKF -REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) :: XYZVERT, XYZVERTF + !--- setup a 2D surface (terrain) object (ZVALS keyword ) + ZVALS_IF: IF (N_ZVALS>0) THEN + GEOM_TYPE = TERRAIN_GEOM_TYPE + TERRAIN_CASE= .TRUE. + CALL CHECK_XB(XB) + IF (N_ZVALS/=IJK(1)*IJK(2) ) THEN + WRITE(MESSAGE,'(A,I4,A,I4)') 'ERROR(706): Expected ',IJK(1)*IJK(2),' Z values, found ',N_ZVALS + CALL SHUTDOWN(MESSAGE) + ENDIF + IF (IJK(1)<2 .OR. IJK(2)<2) THEN + CALL SHUTDOWN('ERROR(707): IJK(1) and IJK(2) on &GEOM line needs to be at least 2.') + ENDIF + NXB=0 + DO I = 1, 4 ! first 4 XB values must be set, don't care about 5th and 6th + IF (XB(I)=XHI)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF((XB(3)<=YLOW) .OR. (XB(4)>=YHI)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF(MY_RANK==0 .AND. WRITE_WARNING) WRITE(LU_ERR,'(A,A,A)') 'Warning : Terrain &GEOM ',TRIM(ID),& + ' cannot be extended. When setting EXTEND_TERRAIN=T, make sure it lays entirely within the computational domain.' + ENDIF -INTEGER, DIMENSION(NOD1:NOD2+1,1:CC_MAXCEELEM_FACE) :: SEG_FACE, SEG_FACE2 -INTEGER, DIMENSION(1:2,1:CC_MAXCFELEM_FACE) :: BOD_TRI -LOGICAL :: SEG_FLAG(1:CC_MAXCEELEM_FACE), INLIST, EQUAL1, EQUAL2, RH_ORIENTED -INTEGER :: COUNTR, CTR, CTSTART, FAXIS, ILH, IEDGE, SEG(NOD1:NOD2), STRI(1:CC_MAX_WSTRIANG_SEG+2), ISEG -INTEGER :: INOD1, INOD2, VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5), IDUM, IEQ1, IEQ2, NBODTRI -REAL(EB), DIMENSION(IAXIS:KAXIS) :: XYZ, NORMTRI, XCENI, XCEN, X1, X2, XC1, XC2, X12, VC1, V12, CROSSV -INTEGER, PARAMETER :: INDVERTBOD(1:3) = (/ 1, 2, 6 /) -INTEGER, PARAMETER :: INDVERTBOD2(1:3) = (/ 2, 1, 6 /) -INTEGER :: NCUTFACE, ICF, NSEG_LEFT, ISEG_FACE, IBOD, NP, IX, IBODTRI, NVSIZE -REAL(EB) :: AREAI, AREA, INXAREA, INT2 -REAL(EB), DIMENSION(IAXIS:KAXIS) :: ACEN, SQAREA + ! Move Low Z position of terrain to less that number od cutcells, s.t. they don't get computed on the bottom. + ZMIN2= 1.E10_EB + DO NM=1,NMESHES + ZMIN2 = MIN( ZMIN2 , MESHES(NM)%ZS-REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) + ENDDO + ZHI = MAXVAL(ZVALS(1:N_ZVALS)) + ZLOW = MINVAL(ZVALS(1:N_ZVALS)) + ZLOW = MIN(REAL(FLOOR(ZLOW-0.1_EB*(ZHI-ZLOW)),EB),ZMIN,ZMIN2) -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNTED -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:):: IJK_COUNTF + ZVAL_FACTOR = 1._EB + IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES + N_VOLUS = 0; N_VOLUS_ORIG = N_VOLUS -INTEGER :: NVERT_AUX, NEDGE_OLD, IVERT, COUNT, IEOLD, INOD, NPOLY, CT_EDGES -INTEGER :: NSG_POLY(1:MAX_CELL_POLYLINES), ILO_POLY(1:MAX_CELL_POLYLINES) -LOGICAL :: FOUND -REAL(EB):: XYZV(IAXIS:KAXIS), NXP(IAXIS:KAXIS), XP(IAXIS:KAXIS), D12(IAXIS:KAXIS), D23(IAXIS:KAXIS), NNORM + ALLOCATE(B_IND(2*(IJK(1)+IJK(2))-3)); B_IND=-1 + ALLOCATE(E_IND(2*(IJK(1)+IJK(2))-3)); E_IND=-1 + ALLOCATE(F_IND(2*(IJK(1)+IJK(2))-3)); F_IND=-1 -INTEGER :: I_NP, IG, XAXIS, NSPCELL_LIST -LOGICAL, ALLOCATABLE, DIMENSION(:) :: SOLID_EDGE -INTEGER, ALLOCATABLE, DIMENSION(:) :: VERT_SEGS, SEG_POS -INTEGER, ALLOCATABLE, DIMENSION(:,:):: SPCELL_LIST -LOGICAL :: CYCLE_CELL, IFLG -REAL(EB) :: XMIN(IAXIS:KAXIS),XMAX(IAXIS:KAXIS) + ! First add terrain IJK(1)*IJK(2) vertices: + IJ = 1 + DO J = 1, IJK(2) + DO I = 1, IJK(1) + VERTS(3*IJ-2) = (XB(1)*REAL(IJK(1)-I,EB) + XB(2)*REAL(I-1,EB))/REAL(IJK(1)-1,EB) + VERTS(3*IJ-1) = (XB(3)*REAL(IJK(2)-J,EB) + XB(4)*REAL(J-1,EB))/REAL(IJK(2)-1,EB) + VERTS(3*IJ) = ZVALS(IJ) + IJ = IJ + 1 + ENDDO + ENDDO + N_VERTS_ORIG = IJ-1 -REAL(EB) :: TNOW + ! Boundary indexes: + IJB = 1 + DO J=1,1 + DO I=1,IJK(1) + B_IND(IJB)=(J-1)*IJK(1)+I + IJB = IJB + 1 + ENDDO + ENDDO + DO J=2,IJK(2) + DO I=IJK(1),IJK(1) + B_IND(IJB)=(J-1)*IJK(1)+I + IJB = IJB + 1 + ENDDO + ENDDO + DO J=IJK(2),IJK(2) + DO I=IJK(1)-1,1,-1 + B_IND(IJB)=(J-1)*IJK(1)+I + IJB = IJB + 1 + ENDDO + ENDDO + DO J=IJK(2)-1,2,-1 + DO I=1,1 + B_IND(IJB)=(J-1)*IJK(1)+I + IJB = IJB + 1 + ENDDO + ENDDO + B_IND(IJB)= B_IND(1) ! Last point equal to first. -INTEGER :: ETYPE,JEC -REAL(EB) :: X1V(IAXIS:KAXIS), X2V(IAXIS:KAXIS) -! INTEGER :: IEC -! REAL(EB) :: X1E(IAXIS:KAXIS), X2E(IAXIS:KAXIS) + ! Now add terrain 2*(IJK(1)-1)*(IJK(2)-1) faces: + IJF = 1 + DO J = 1, IJK(2) - 1 + DO I = 1, IJK(1) - 1 + I1 = (J-1)*IJK(1) + I + I2 = I1 + 1 + I3 = I2 + IJK(1) + I4 = I3 - 1 -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -INTEGER :: NCUTFCE + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - IF (BNDINT_FLAG) THEN ! Boundary and internal cartface cut-faces: - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating internal CARTCELL_CUTFACES for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating internal CARTCELL_CUTFACES for mesh :',NM,' ..' - ELSE - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTCELL_CUTFACES for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTCELL_CUTFACES for mesh :',NM,' ..' - ENDIF -ENDIF + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO + ENDDO + N_FACES_ORIG = IJF-1 -TNOW=CURRENT_TIME() + IF (EXTEND_TERRAIN) THEN + ! Then add 2*(IJK(1)+IJK(2))-4 extended points: + DELX = (XHI - XLOW)/REAL(IJK(1)-1,EB) + DELY = (YHI - YLOW)/REAL(IJK(2)-1,EB) -SIZE_CEELEM_SEG_CELL = DELTA_EDGE -ALLOCATE(SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL),SEG_POS(1:SIZE_CEELEM_SEG_CELL)) + IJE = 1 + ! Low Y along X: from IJK(1)*IJK(2)+1 : IJK(1)*IJK(2) + IJK(1) + DO J=1,1 + DO I=1,IJK(1) + VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) + VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) + VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON + E_IND(IJE) = IJ + IJE= IJE + 1 + IJ = IJ + 1 + ENDDO + ENDDO -! Define which cells are cut-cell, and which are solid: -IF (BNDINT_FLAG) THEN - ALLOCATE( MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,DELTA_CELL) ); MESHES(NM)%SPCELL_LIST = CC_UNDEFINED - ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND) ); IJK_COUNTED=.FALSE. - ALLOCATE( IJK_COUNTF(ISTR:IEND,JSTR:JEND,KSTR:KEND,MAX_DIM) ); IJK_COUNTF=.FALSE. - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL -ELSE - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD -ENDIF + ! Hi X along Y: from IJK(1)*IJK(2) + IJK(1) + 1 : IJK(1)*IJK(2) + IJK(1) + IJK(2) - 2 + DO J=2,IJK(2) + DO I=IJK(1),IJK(1) + VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) + VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) + VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON + E_IND(IJE) = IJ + IJE= IJE + 1 + IJ = IJ + 1 + ENDDO + ENDDO -! Loop on Cartesian cells, define cut cells and solid cells ISSO: -DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI + ! Hi Y along X: from IJK(1)*IJK(2) + IJK(1) + IJK(2) - 1 : IJK(1)*IJK(2) + 2*IJK(1) + IJK(2) - 2 + DO J=IJK(2),IJK(2) + DO I=IJK(1)-1,1,-1 + VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) + VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) + VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON + E_IND(IJE) = IJ + IJE= IJE + 1 + IJ = IJ + 1 + ENDDO + ENDDO - IF(IJK_COUNTED(I,J,K)) CYCLE + ! Low X Along Y: from IJK(1)*IJK(2) + 2*IJK(1) + IJK(2) - 1 : IJK(1)*IJK(2) + 2*(IJK(1)+IJK(2)) - 4 + DO J=IJK(2)-1,2,-1 + DO I=1,1 + VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) + VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) + VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON + E_IND(IJE) = IJ + IJE= IJE + 1 + IJ = IJ + 1 + ENDDO + ENDDO + E_IND(IJE) = E_IND(1) ! Last point equal to first. - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) + DO I=1,IJE-1 + VERTS(3*IJ-2) = VERTS(3*E_IND(I)-2) + VERTS(3*IJ-1) = VERTS(3*E_IND(I)-1) + VERTS(3*IJ) = ZLOW + F_IND(I) = IJ + IJ = IJ + 1 + ENDDO + F_IND(IJE) = F_IND(1) ! Last lower point equal to the first. - ! For this cell check if no Cartesian boundary faces are CC_CUTCFE: - ! If outcell1 is true -> All regular faces for this face: - OUTCELL1 = (FSID_XYZ(LOW_IND ,IAXIS) /= CC_CUTCFE) .AND. & - (FSID_XYZ(HIGH_IND,IAXIS) /= CC_CUTCFE) .AND. & - (FSID_XYZ(LOW_IND ,JAXIS) /= CC_CUTCFE) .AND. & - (FSID_XYZ(HIGH_IND,JAXIS) /= CC_CUTCFE) .AND. & - (FSID_XYZ(LOW_IND ,KAXIS) /= CC_CUTCFE) .AND. & - (FSID_XYZ(HIGH_IND,KAXIS) /= CC_CUTCFE) + ! Remaining Faces: + ! Extension faces: + DO I=1,2*(IJK(1)+IJK(2))-4 + I1 = E_IND(I) + I2 = E_IND(I+1) + I3 = B_IND(I+1) + I4 = B_IND(I) - ! Drop if outcell1 & outcell2 - IF (OUTCELL1) THEN - IF ( (FSID_XYZ(LOW_IND ,IAXIS) == CC_SOLID) .AND. & - (FSID_XYZ(HIGH_IND,IAXIS) == CC_SOLID) .AND. & - (FSID_XYZ(LOW_IND ,JAXIS) == CC_SOLID) .AND. & - (FSID_XYZ(HIGH_IND,JAXIS) == CC_SOLID) .AND. & - (FSID_XYZ(LOW_IND ,KAXIS) == CC_SOLID) .AND. & - (FSID_XYZ(HIGH_IND,KAXIS) == CC_SOLID) ) THEN - MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_SOLID - ENDIF - CYCLE - ENDIF + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 - MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO - ENDDO - ENDDO -ENDDO + ! Side faces: + DO I=1,2*(IJK(1)+IJK(2))-4 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = E_IND(I+1) + I4 = E_IND(I) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 -! First add edges stemming from triangles laying on gridline planes: -! Dump triangle aligned segments as cut-cell cut-edges, on face cases: -! BNDINT_COND : IF (BNDINT_FLAG) THEN - ! Do Loop for different x1 planes: - X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO - SELECT CASE(X1AXIS) - CASE(IAXIS) + ELSE + ! Do not Extend to domain boundary: + DO I=1,IJB-1 + VERTS(3*IJ-2) = VERTS(3*B_IND(I)-2) + VERTS(3*IJ-1) = VERTS(3*B_IND(I)-1) + VERTS(3*IJ) = ZLOW + F_IND(I) = IJ + IJ = IJ + 1 + ENDDO + F_IND(IJB) = F_IND(1) ! Last lower point equal to the first. - PLNORMAL = (/ 1._EB, 0._EB, 0._EB/) - ILO = ILO_FACE-CCGUARD; IHI = IHI_FACE+CCGUARD - JLO = JLO_FACE; JHI = JLO_FACE - KLO = KLO_FACE; KHI = KLO_FACE + ! Side faces: + DO I=1,2*(IJK(1)+IJK(2))-4 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = B_IND(I+1) + I4 = B_IND(I) - ! x2, x3 axes parameters: - X2AXIS = JAXIS; X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD - X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(ISTR:IEND),DX1FACE(ISTR:IEND)) - X1FACE = XFACE; DX1FACE = DXFACE - ALLOCATE(X2FACE(JSTR:JEND),DX2FACE(JSTR:JEND)) - X2FACE = YFACE; DX2FACE = DYFACE - ALLOCATE(X3FACE(KSTR:KEND),DX3FACE(KSTR:KEND)) - X3FACE = ZFACE; DX3FACE = DZFACE + ENDIF - ! x2 cell center parameters: - X2LO_CELL = JLO_CELL-CCGUARD; X2HI_CELL = JHI_CELL+CCGUARD - ALLOCATE(X2CELL(JSTR:JEND),DX2CELL(JSTR:JEND)) - X2CELL = YCELL; DX2CELL = DYCELL + ! Bottom Faces: + ! First Face: + I = 1 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = F_IND(2*(IJK(1)+IJK(2))-3-I) + FACES(3*IJF-2) = I2 + FACES(3*IJF-1) = I1 + FACES(3*IJF) = I3 + IJF = IJF + 1 - ! x3 cell center parameters: - X3LO_CELL = KLO_CELL-CCGUARD; X3HI_CELL = KHI_CELL+CCGUARD - ALLOCATE(X3CELL(KSTR:KEND),DX3CELL(KSTR:KEND)) - X3CELL = ZCELL; DX3CELL = DZCELL + DO I=2,(2*(IJK(1)+IJK(2))-6)/2 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = F_IND(2*(IJK(1)+IJK(2))-3-I) + I4 = F_IND(2*(IJK(1)+IJK(2))-2-I) - CASE(JAXIS) + FACES(3*IJF-2) = I2 + FACES(3*IJF-1) = I1 + FACES(3*IJF) = I4 + IJF = IJF + 1 - PLNORMAL = (/ 0._EB, 1._EB, 0._EB/) - ILO = ILO_FACE; IHI = ILO_FACE - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - KLO = KLO_FACE; KHI = KLO_FACE + FACES(3*IJF-2) = I2 + FACES(3*IJF-1) = I4 + FACES(3*IJF) = I3 + IJF = IJF + 1 + ENDDO - ! x2, x3 axes parameters: - X2AXIS = KAXIS; X2LO = KLO_FACE-CCGUARD; X2HI = KHI_FACE+CCGUARD - X3AXIS = IAXIS; X3LO = ILO_FACE-CCGUARD; X3HI = IHI_FACE+CCGUARD + ! Last Face: + I = (2*(IJK(1)+IJK(2))-4)/2 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = F_IND(I+2) + FACES(3*IJF-2) = I2 + FACES(3*IJF-1) = I1 + FACES(3*IJF) = I3 + IJF = IJF + 1 - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS + N_VERTS = IJ - 1 + N_FACES = IJF - 1 - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(JSTR:JEND),DX1FACE(JSTR:JEND)) - X1FACE = YFACE; DX1FACE = DYFACE - ALLOCATE(X2FACE(KSTR:KEND),DX2FACE(KSTR:KEND)) - X2FACE = ZFACE; DX2FACE = DZFACE - ALLOCATE(X3FACE(ISTR:IEND),DX3FACE(ISTR:IEND)) - X3FACE = XFACE; DX3FACE = DXFACE + DEALLOCATE(B_IND,E_IND,F_IND) - ! x2 cell center parameters: - X2LO_CELL = KLO_CELL-CCGUARD; X2HI_CELL = KHI_CELL+CCGUARD - ALLOCATE(X2CELL(KSTR:KEND),DX2CELL(KSTR:KEND)) - X2CELL = ZCELL; DX2CELL = DZCELL + ELSEIF(IS_TERRAIN) THEN ZVALS_IF - ! x3 cell center parameters: - X3LO_CELL = ILO_CELL-CCGUARD; X3HI_CELL = IHI_CELL+CCGUARD - ALLOCATE(X3CELL(ISTR:IEND),DX3CELL(ISTR:IEND)) - X3CELL = XCELL; DX3CELL = DXCELL + GEOM_TYPE = TERRAIN_GEOM_TYPE + TERRAIN_CASE= .TRUE. - CASE(KAXIS) + ! Here estimate final number of Faces and if necessary reallocate FACE, VERTS, SURFS arrays: + IF ( (2*N_FACES>MAX_FACES) .AND. .NOT.READ_BINARY) THEN + ALLOCATE(VERTS_AUX(3*N_VERTS)); VERTS_AUX(1:3*N_VERTS)= VERTS(1:3*N_VERTS) + ALLOCATE(FACES_AUX(4*N_FACES)); FACES_AUX(1:4*N_FACES)= FACES(1:4*N_FACES) + ALLOCATE(SURFS2(N_FACES)); SURFS2(1:N_FACES) = SURFS(1:N_FACES) + MAX_FACES = 2*N_FACES ! Enough for square structured triangulations of more that 200 triangs with domain extension. + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + DEALLOCATE(VERTS,FACES,TFACES); + ALLOCATE(VERTS(3*MAX_VERTS+1)); ALLOCATE(TFACES(6*MAX_FACES+1)); ALLOCATE(FACES(4*MAX_FACES+1)) + VERTS=1.001_EB*MAX_VAL; FACES=0 + VERTS(1:3*N_VERTS) = VERTS_AUX(1:3*N_VERTS) + FACES(1:4*N_FACES) = FACES_AUX(1:4*N_FACES) + DEALLOCATE(SURFS); ALLOCATE(SURFS(MAX_FACES)); + IF(SURF_INDEX_PER_FACE) THEN + SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). + ELSE + SURFS(:) = 0 ! All external faces point to default surf ID. + ENDIF + SURFS(1:N_FACES) = SURFS2(1:N_FACES) + DEALLOCATE(VERTS_AUX,FACES_AUX,SURFS2) + ENDIF - PLNORMAL = (/ 0._EB, 0._EB, 1._EB/) - ILO = ILO_FACE; IHI = ILO_FACE - JLO = JLO_FACE; JHI = JLO_FACE - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD - ! x2, x3 axes parameters: - X2AXIS = IAXIS; X2LO = ILO_FACE-CCGUARD; X2HI = IHI_FACE+CCGUARD - X3AXIS = JAXIS; X3LO = JLO_FACE-CCGUARD; X3HI = JHI_FACE+CCGUARD + ! First get EDGES arrays to find edges attached to only one face: + I = SIZE(FACES,DIM=1) + ALLOCATE(EDGES(NOD1:NOD2,3*N_FACES),FACE_EDGES(EDG1:EDG3,N_FACES),EDGE_FACES(5,3*N_FACES)) + CALL GET_GEOM_EDGES(N_VERTS,N_FACES,I,FACES,N_EDGES,EDGES,FACE_EDGES,EDGE_FACES) - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS + ! FIND SET OF EDGES: + ALLOCATE(NBND_EDGE(1:N_EDGES)); NBND_EDGE(1:N_EDGES) = 2 - EDGE_FACES(1,1:N_EDGES) ! 0 if interior edge, 1 bnd. + N_BEDGES = SUM(NBND_EDGE(1:N_EDGES)) + ALLOCATE(BOUND_EDGES(2,N_BEDGES),BOUND_EDGES2(2,N_BEDGES)); BOUND_EDGES = 0; BOUND_EDGES2 = 0 + ALLOCATE(COUNTED_EDGES(1:N_BEDGES)); COUNTED_EDGES = 0 + ! Reorder Edges in counter-clockwise (x-y plane) direction: + ! First copy edges in correct counter-clockwise outside node order: + J=0 + DO I=1,N_EDGES + IF(NBND_EDGE(I)/=1) CYCLE + J=J+1 + IF(EDGE_FACES(2,I)>0) THEN + BOUND_EDGES(NOD1:NOD2,J) = EDGES( (/ NOD1,NOD2 /) , I ) + ELSEIF(EDGE_FACES(4,I)>0) THEN + BOUND_EDGES(NOD1:NOD2,J) = EDGES( (/ NOD2,NOD1 /) , I ) + ENDIF + ENDDO - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)) - X1FACE = ZFACE; DX1FACE = DZFACE - ALLOCATE(X2FACE(ISTR:IEND),DX2FACE(ISTR:IEND)) - X2FACE = XFACE; DX2FACE = DXFACE - ALLOCATE(X3FACE(JSTR:JEND),DX3FACE(JSTR:JEND)) - X3FACE = YFACE; DX3FACE = DYFACE + ! Then reorder-copy edges: + J = 1; I = 1 + BOUND_EDGES2(NOD1:NOD2,J) = BOUND_EDGES(NOD1:NOD2,I); COUNTED_EDGES(I) = 1 + DO J=2,N_BEDGES + DO I=1,N_BEDGES + IF(COUNTED_EDGES(I)==1) CYCLE + IF(BOUND_EDGES2(NOD2,J-1)==BOUND_EDGES(NOD1,I)) THEN ! Found new edge: + BOUND_EDGES2(NOD1:NOD2,J) = BOUND_EDGES(NOD1:NOD2,I); COUNTED_EDGES(I) = 1 + EXIT + ENDIF + ENDDO + IF(I>N_BEDGES) THEN ! Error + WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(709): For terrain GEOM ',TRIM(ID),& + ' unconnected boundary edge at node number,',BOUND_EDGES2(NOD2,J-1),'.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + DO I=1,N_BEDGES + IF (COUNTED_EDGES(I) /= 1) THEN + WRITE(MESSAGE,'(A,A,A,2I8,A)') 'ERROR(710): For terrain GEOM ',TRIM(ID),& + ' unconnected boundary edge at nodes,',BOUND_EDGES(NOD1:NOD2,I),'.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ! Here all edges are counted and SUM(COUNTED_EDGES(1:N_BEDGES)==N_BEDGES): + BOUND_EDGES(NOD1:NOD2,1:N_BEDGES) = BOUND_EDGES2(NOD1:NOD2,1:N_BEDGES); + DEALLOCATE(NBND_EDGE,COUNTED_EDGES,BOUND_EDGES2) - ! x2 cell center parameters: - X2LO_CELL = ILO_CELL-CCGUARD; X2HI_CELL = IHI_CELL+CCGUARD - ALLOCATE(X2CELL(ISTR:IEND),DX2CELL(ISTR:IEND)) - X2CELL = XCELL; DX2CELL = DXCELL + IF (EXTEND_TERRAIN) THEN + ! Find XLOW,XHI,YLOW,YHI for the set of NM meshes defined: + XLOW = 1.E10_EB + XHI =-1.E10_EB + YLOW = 1.E10_EB + YHI =-1.E10_EB + DO NM=1,NMESHES + XLOW = MIN(XLOW,MESHES(NM)%XS) + XHI = MAX(XHI ,MESHES(NM)%XF) + YLOW = MIN(YLOW,MESHES(NM)%YS) + YHI = MAX(YHI ,MESHES(NM)%YF) + ENDDO + WRITE_WARNING=.FALSE. + IF(ANY(VERTS(1:3:3*N_VERTS-2) <= XLOW)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF(ANY(VERTS(1:3:3*N_VERTS-2) >= XHI )) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF(ANY(VERTS(2:3:3*N_VERTS-1) <= YLOW)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF(ANY(VERTS(2:3:3*N_VERTS-1) >= YHI )) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF(MY_RANK==0 .AND. WRITE_WARNING) WRITE(LU_ERR,'(A,A,A)') 'Warning : Terrain &GEOM ',TRIM(ID),& + ' cannot be extended. When setting EXTEND_TERRAIN=T, make sure it lays entirely within the computational domain.' + ENDIF + ! Move Low Z position of terrain to less that number od cutcells, s.t. they don't get computed on the bottom. + ZMIN2= 1.E10_EB + DELTZ= 0._EB + DO NM=1,NMESHES + DELTZ = MAX( DELTZ , REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) + ZMIN2 = MIN( ZMIN2 , MESHES(NM)%ZS-REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) + ENDDO + ZHI =-1.E10_EB + ZLOW = 1.E10_EB + DO I=1,N_VERTS + ZLOW = MIN(ZLOW,VERTS(3*I)) + ZHI = MAX(ZHI ,VERTS(3*I)) + ENDDO + ! Take the min of LOWZ_VERTS-NGUARD*DZ, ZMIN from input, ZMIN_MESH-NGUARD*DZ: + ZLOW = MIN(ZLOW-DELTZ,ZMIN,ZMIN2) - ! x3 cell center parameters: - X3LO_CELL = JLO_CELL-CCGUARD; X3HI_CELL = JHI_CELL+CCGUARD - ALLOCATE(X3CELL(JSTR:JEND),DX3CELL(JSTR:JEND)) - X3CELL = YCELL; DX3CELL = DYCELL + ZVAL_FACTOR = 1._EB + IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. - END SELECT + N_VOLUS = 0 - ! Loop Slices: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI + ALLOCATE(B_IND(2*N_BEDGES+1)); B_IND=-1 + ALLOCATE(E_IND(2*N_BEDGES+1)); E_IND=-1 + ALLOCATE(F_IND(2*N_BEDGES+1)); F_IND=-1 - IJK(IAXIS:KAXIS) = (/ I, J, K /) + B_IND(1:N_BEDGES) = BOUND_EDGES(NOD1,1:N_BEDGES); B_IND(N_BEDGES+1) = B_IND(1) ! Last equal to first - ! Plane: - X1PLN = X1FACE(IJK(X1AXIS)) + ! All vertices in counter-clockwise dir are in BOUND_EDGES(NOD1,1:N_BEDGES) + ! IF EXTEND_TERRAIN, of this vertex list find the 4 points SW, SE, NW, NE closest to the boundary of the domain. + IF (EXTEND_TERRAIN) THEN - ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: - TRI_ONPLANE_ONLY = .TRUE. - RAYTRACE_X2_ONLY = .FALSE. - CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS,& - X2LO,X2HI,X3LO,X3HI,X2FACE,X3FACE,X2LO_CELL,& - X2HI_CELL,X3LO_CELL,X3HI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE) + B_IND(N_BEDGES+1:2*N_BEDGES) = B_IND(1:N_BEDGES) + B_IND(2*N_BEDGES+1) = B_IND(1) - ! Test that there is an intersection: - IF ((BODINT_PLANE%NTRIS) == 0) CYCLE + ! Find the 4 points closest to SE, NE, NW, SW corners. + CORNER_PT(IAXIS:JAXIS,NOD1) = (/ XHI , YLOW /) ! SE + CORNER_PT(IAXIS:JAXIS,NOD2) = (/ XHI , YHI /) ! NE + CORNER_PT(IAXIS:JAXIS,NOD3) = (/ XLOW, YHI /) ! NW + CORNER_PT(IAXIS:JAXIS,NOD4) = (/ XLOW, YLOW /) ! SW + CORNER_PT(IAXIS:JAXIS,NOD4+1)= CORNER_PT(IAXIS:JAXIS,NOD1) ! SE + CLOSE_PT(:) = 0 + DO ICPT=NOD1,NOD4 + ! Search in B_IND vertices which is closest: + DIST=1.E10_EB + DO I=1,N_BEDGES + DISTI = SQRT( ( CORNER_PT(IAXIS,ICPT)-VERTS(3*B_IND(I)-2) )**2._EB + & + ( CORNER_PT(JAXIS,ICPT)-VERTS(3*B_IND(I)-1) )**2._EB ) + IF(DISTI >= DIST) CYCLE + CLOSE_PT(ICPT) = I + DIST = DISTI + ENDDO + ENDDO + DO ICPT=NOD2,NOD4 + IF(CLOSE_PT(ICPT) < CLOSE_PT(ICPT-1)) CLOSE_PT(ICPT) = CLOSE_PT(ICPT) + N_BEDGES ! Pad corner nodes. + ENDDO + CLOSE_PT(NOD4+1) = CLOSE_PT(NOD1) + N_BEDGES - ! Drop if node locations outside block plane area: - IF ((X2FACE(X2LO)-MAXVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE - IF ((MINVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))-X2FACE(X2HI)) > GEOMEPS) CYCLE - IF ((X3FACE(X3LO)-MAXVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE - IF ((MINVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))-X3FACE(X3HI)) > GEOMEPS) CYCLE + ! These points are mapped to domain external corners, rest of the points are mapped to corresponding domain + ! External boundaries. + IJ = N_VERTS + 1 + DO ICPT=NOD1,NOD4 + IJE = CLOSE_PT(ICPT+1) - CLOSE_PT(ICPT); + IF (IJE <= 0) THEN + WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(711): For terrain GEOM ',TRIM(ID),& + ' same boundary vertex ',B_IND(CLOSE_PT(ICPT)),' closest to 2 domain corners.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + DISTI = SQRT( ( CORNER_PT(IAXIS,ICPT+1)-CORNER_PT(IAXIS,ICPT) )**2._EB + & + ( CORNER_PT(JAXIS,ICPT+1)-CORNER_PT(JAXIS,ICPT) )**2._EB ) / REAL(IJE,EB) + ! Place points in extended domain: + J = 0 + DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 + VERTS(3*IJ-2) = CORNER_PT(IAXIS,ICPT) + DISTI*VERXY(IAXIS,ICPT)*REAL(J,EB) + VERTS(3*IJ-1) = CORNER_PT(JAXIS,ICPT) + DISTI*VERXY(JAXIS,ICPT)*REAL(J,EB) + VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*VERTS(3*B_IND(I)) + ZVAL_FACTOR*ZVAL_HORIZON + E_IND(I) = IJ + IJ = IJ + 1 + J = J + 1 + ENDDO + ENDDO + E_IND(CLOSE_PT(NOD4+1)) = E_IND(CLOSE_PT(NOD1)) - ! Allocate triangles variables: - ALLOCATE(BODINT_PLANE%X1NVEC(1:BODINT_PLANE%NTRIS), & - BODINT_PLANE%AINV(1:2,1:2,1:BODINT_PLANE%NTRIS)) + ! Add the floor F_IND Vertices: + X_CEN = 0 + Y_CEN = 0 + DO ICPT=NOD1,NOD4 + DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 + VERTS(3*IJ-2) = VERTS(3*E_IND(I)-2) + VERTS(3*IJ-1) = VERTS(3*E_IND(I)-1) + VERTS(3*IJ) = ZLOW + F_IND(I) = IJ + X_CEN = X_CEN + VERTS(3*E_IND(I)-2) + Y_CEN = Y_CEN + VERTS(3*E_IND(I)-1) + IJ = IJ + 1 + ENDDO + ENDDO + F_IND(CLOSE_PT(NOD4+1)) = F_IND(CLOSE_PT(NOD1)) - ! Triangles inverses: - DO ITRI=1,BODINT_PLANE%NTRIS + ! Add center point: + VERTS(3*IJ-2) = X_CEN / REAL(N_BEDGES,EB) + VERTS(3*IJ-1) = Y_CEN / REAL(N_BEDGES,EB) + VERTS(3*IJ) = ZLOW + IJ = IJ + 1 - TRIS(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) + ! Add extend faces: + IJF = N_FACES + 1 + DO ICPT=NOD1,NOD4 + DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 + I1 = E_IND(I) + I2 = E_IND(I+1) + I3 = B_IND(I+1) + I4 = B_IND(I) - ! This is local IAXIS:JAXIS - XYEL(IAXIS:JAXIS,NOD1) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD1)), & - BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD1)) /) - XYEL(IAXIS:JAXIS,NOD2) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD2)), & - BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD2)) /) - XYEL(IAXIS:JAXIS,NOD3) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD3)), & - BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD3)) /) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 - ! Test that x1-x2-x3 obeys right hand rule: - VAL = (XYEL(IAXIS,NOD2)-XYEL(IAXIS,NOD1)) * (XYEL(JAXIS,NOD3)-XYEL(JAXIS,NOD1))- & - (XYEL(JAXIS,NOD2)-XYEL(JAXIS,NOD1)) * (XYEL(IAXIS,NOD3)-XYEL(IAXIS,NOD1)) - BODINT_PLANE%X1NVEC(ITRI) = SIGN(1._EB,VAL) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO + ENDDO - ! Transformation Matrix for this triangle in x2x3 plane: - IF (BODINT_PLANE%X1NVEC(ITRI) < 0._EB) THEN ! Rotate node 2 and 3 locations - DUMMY(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,NOD2) - XYEL(IAXIS:JAXIS,NOD2) = XYEL(IAXIS:JAXIS,NOD3) - XYEL(IAXIS:JAXIS,NOD3) = DUMMY(IAXIS:JAXIS) - ENDIF + ! Add side faces: + DO ICPT=NOD1,NOD4 + DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = E_IND(I+1) + I4 = E_IND(I) - ! Inverse of Master to physical triangle transform matrix: - A_COEF = XYEL(IAXIS,NOD1) - XYEL(IAXIS,NOD3) - B_COEF = XYEL(IAXIS,NOD2) - XYEL(IAXIS,NOD3) - C_COEF = XYEL(JAXIS,NOD1) - XYEL(JAXIS,NOD3) - D_COEF = XYEL(JAXIS,NOD2) - XYEL(JAXIS,NOD3) - DENOM = A_COEF * D_COEF - B_COEF * C_COEF - BODINT_PLANE%AINV(1,1,ITRI) = D_COEF / DENOM - BODINT_PLANE%AINV(2,1,ITRI) = -C_COEF / DENOM - BODINT_PLANE%AINV(1,2,ITRI) = -B_COEF / DENOM - BODINT_PLANE%AINV(2,2,ITRI) = A_COEF / DENOM + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 - ENDDO + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO + ENDDO - ! There are triangles aligned with this x1pln: - ! Run by Face: - ! First solid Faces: x1 Faces, Check where they lay: - DO KK=X3LO_CELL,X3HI_CELL - DO JJ=X2LO_CELL,X2HI_CELL + ! Add bottom faces: + DO ICPT=NOD1,NOD4 + DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 + I1 = F_IND(I) + I2 = IJ - 1 ! ZLOW center vert. + I3 = F_IND(I+1) - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ IJK(X1AXIS), JJ, KK /) ! Local x1,x2,x3 - INDIF = INDXI(XIAXIS) - INDJF = INDXI(XJAXIS) - INDKF = INDXI(XKAXIS) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 + ENDDO + ENDDO - IF (IJK_COUNTF(INDIF,INDJF,INDKF,X1AXIS)) CYCLE + ELSE - IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_FGSC,X1AXIS) /= CC_GASPHASE ) THEN + ! Add the floor F_IND Vertices: + IJ = N_VERTS + 1 + X_CEN = 0 + Y_CEN = 0 + DO I=1,N_BEDGES + VERTS(3*IJ-2) = VERTS(3*B_IND(I)-2) + VERTS(3*IJ-1) = VERTS(3*B_IND(I)-1) + VERTS(3*IJ) = ZLOW + F_IND(I) = IJ + X_CEN = X_CEN + VERTS(3*B_IND(I)-2) + Y_CEN = Y_CEN + VERTS(3*B_IND(I)-1) + IJ = IJ + 1 + ENDDO + F_IND(N_BEDGES+1) = F_IND(1) ! Last lower point equal to the first. - FVERT(IAXIS:JAXIS,NOD1) = (/ X2FACE(JJ-1), X3FACE(KK-1) /) - FVERT(IAXIS:JAXIS,NOD2) = (/ X2FACE(JJ ), X3FACE(KK-1) /) - FVERT(IAXIS:JAXIS,NOD3) = (/ X2FACE(JJ ), X3FACE(KK ) /) - FVERT(IAXIS:JAXIS,NOD4) = (/ X2FACE(JJ-1), X3FACE(KK ) /) + ! Add center point: + VERTS(3*IJ-2) = X_CEN / REAL(N_BEDGES,EB) + VERTS(3*IJ-1) = Y_CEN / REAL(N_BEDGES,EB) + VERTS(3*IJ) = ZLOW + IJ = IJ + 1 - ! Get triangle face intersection: - CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) + ! Add side faces: + IJF = N_FACES + 1 + DO I=1,N_BEDGES + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = B_IND(I+1) + I4 = B_IND(I) - ! Triangle - face intersection vertices and edges: - CALL GET_TRIANG_FACE_INT(X2AXIS,X3AXIS,FVERT,CEI,NM, & - INB_FLG,FNVERT,XYVERT,FNEDGE,CEELEM,INDSEG) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 - ! XYvert to XYZvert: - IF ( INB_FLG ) THEN - XYZVERTF = 0._EB - XYZVERTF(X1AXIS,1:FNVERT) = X1PLN - XYZVERTF(X2AXIS,1:FNVERT) = XYVERT(IAXIS,1:FNVERT) - XYZVERTF(X3AXIS,1:FNVERT) = XYVERT(JAXIS,1:FNVERT) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO - ! Test for edges inside SOLID Region: - ALLOCATE(SOLID_EDGE(1:FNEDGE)); SOLID_EDGE(1:FNEDGE)=.FALSE. - DO IEDGE=1,FNEDGE - ! No body associated with segment. Might not be needed. - IG = INDSEG(4,IEDGE) - IF ( IG < 1) CYCLE - SEG(NOD1:NOD2) = CEELEM(NOD1:NOD2,IEDGE) - XP(IAXIS:KAXIS)= 0.5_EB*(XYZVERTF(IAXIS:KAXIS,SEG(NOD1))+XYZVERTF(IAXIS:KAXIS,SEG(NOD2))) - ! Direction NP: - NXP(IAXIS:KAXIS) = 0._EB - DO I_NP=1,INDSEG(1,IEDGE) - ITRI = INDSEG(1+I_NP,IEDGE) - NXP(IAXIS:KAXIS) = NXP(IAXIS:KAXIS) + GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,ITRI) - ENDDO - NXP = NXP/NORM2(NXP); XAXIS=MAXLOC(ABS(NXP(IAXIS:KAXIS)),DIM=1) - ! Perturb XP in the average normal NP direction: - IF (INDSEG(1,IEDGE) > 1) XP = XP + 10._EB*GEOMEPS*NXP - CALL GET_IS_SOLID_3D(XAXIS,XP,INDIF,INDJF,INDKF,SOLID_EDGE(IEDGE)) - ENDDO - ! Now drop SEGS with SOLID_EDGE(IEDGE)=true: - COUNT = 0 - DO IEDGE=1,FNEDGE - IF (SOLID_EDGE(IEDGE)) CYCLE - COUNT=COUNT+1 - CEELEM(NOD1:NOD2,COUNT) = CEELEM(NOD1:NOD2,IEDGE) - INDSEG(1:CC_MAX_WSTRIANG_SEG+2,COUNT) = INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) - ENDDO - CEELEM(NOD1:NOD2,COUNT+1:FNEDGE) = CC_UNDEFINED - INDSEG(1:CC_MAX_WSTRIANG_SEG+2,COUNT+1:FNEDGE) = CC_UNDEFINED - FNEDGE = COUNT - DEALLOCATE(SOLID_EDGE) + ! Add bottom faces: + DO I=1,N_BEDGES + I1 = F_IND(I) + I2 = IJ - 1 ! ZLOW center vert. + I3 = F_IND(I+1) - ! Here ADD nodes and vertices to what is already - ! there: - IF (CEI == 0) THEN ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = FNVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = FNEDGE - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,FNVERT,FNEDGE) - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = & - (/ INDIF, INDJF, INDKF, X1AXIS, CC_GS /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF - MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:FNVERT) = & - XYZVERTF(IAXIS:KAXIS,1:FNVERT) - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:FNEDGE) = & - CEELEM(NOD1:NOD2,1:FNEDGE) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:FNEDGE) = & - INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:FNEDGE) - ELSE + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 + ENDDO - NVERT_AUX=MESHES(NM)%CUT_EDGE(CEI)%NVERT - NEDGE_OLD=MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IVERT=1,FNVERT - XYZV(IAXIS:KAXIS) = XYZVERTF(IAXIS:KAXIS,IVERT) - CALL INSERT_FACE_VERT(XYZV,NM,CEI,NVERT_AUX,INOD) - DO IEDGE=1,FNEDGE - IF(CEELEM(NOD1,IEDGE)==IVERT) CEELEM(NOD1,IEDGE)=INOD - IF(CEELEM(NOD2,IEDGE)==IVERT) CEELEM(NOD2,IEDGE)=INOD - ENDDO - ENDDO - CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE_OLD+FNEDGE) - COUNT = NEDGE_OLD - OUTER :DO IEDGE=1,FNEDGE - FOUND=.FALSE. - INNER1 : DO IEOLD=1,NEDGE_OLD - IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IEOLD) /= CEELEM(NOD1,IEDGE)) CYCLE INNER1 - IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IEOLD) /= CEELEM(NOD2,IEDGE)) CYCLE INNER1 - IF(MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEOLD) /= INDSEG(4,IEDGE)) CYCLE INNER1 - FOUND=.TRUE. - ENDDO INNER1 - INNER2 : DO IEOLD=1,NEDGE_OLD - IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IEOLD) /= CEELEM(NOD1,IEDGE)) CYCLE INNER2 - IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IEOLD) /= CEELEM(NOD2,IEDGE)) CYCLE INNER2 - IF(MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEOLD) /= INDSEG(4,IEDGE)) CYCLE INNER2 - FOUND=.TRUE. - ENDDO INNER2 - IF(FOUND) CYCLE OUTER - COUNT=COUNT+1 - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,COUNT) = CEELEM(NOD1:NOD2,IEDGE) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,COUNT)=& - INDSEG(1:CC_MAX_WSTRIANG_SEG+3,IEDGE) - ENDDO OUTER - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT_AUX - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = COUNT + ENDIF - ENDIF + N_VERTS = IJ - 1 + N_FACES = IJF - 1 - ! MESHES(NM)%CUT_EDGE(CEI)%NVERT = FNVERT - ! MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:FNVERT) = & - ! XYZVERTF(IAXIS:KAXIS,1:FNVERT) - ! MESHES(NM)%CUT_EDGE(CEI)%NEDGE = FNEDGE - ! WRITE(LU_ERR,*) 'CUT_EDGE=',CEI,SIZE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM,DIM=2),FNEDGE - ! WRITE(LU_ERR,*) 'CEELEM=',SIZE(CEELEM,DIM=2) - ! MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:FNEDGE) = & - ! CEELEM(NOD1,IEDGE)) CYCLE:NOD2,1:FNEDGE) - ! MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:FNEDGE) = & - ! INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:FNEDGE) + DEALLOCATE(B_IND,E_IND,F_IND,BOUND_EDGES) - ENDIF - IJK_COUNTF(INDIF,INDJF,INDKF,X1AXIS)=.TRUE. + ENDIF ZVALS_IF - ENDIF - ENDDO - ENDDO + !--- setup a block object (XB keyword ) - DEALLOCATE(BODINT_PLANE%X1NVEC,BODINT_PLANE%AINV) - ENDDO ! I - ENDDO ! J - ENDDO ! K + NXB=0 + DO I = 1, 6 + IF (XB(I) MAX_VOLUS) THEN + MAX_VOLUS = N_VOLUS + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + DEALLOCATE(VERTS,FACES,TFACES,VOLUS); + ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1),VOLUS(4*MAX_VOLUS+1)) + VERTS=1.001_EB*MAX_VAL; FACES=0; VOLUS = 0; + ENDIF - ENDDO X1AXIS_LOOP -! ENDIF BNDINT_COND + ! define verts in box -! Second: Loop over cut-cells: For cut-cell i,j,k,lb -! - From cut-cell Cartesian faces, figure out INBOUNDCF segments (CUT_EDGE) -! and the wet surface triangles related to them. -! - From CCVAR(I,J,K,CC_IDCE), figure out INBOUNDCC segments in CUT_EDGE -! and triangles they belong to. -! - Working by triangle -> reorient segments using triangle normal outside -! of body (no disjoint areas are expected) -! - Load into CUT_FACE <=> CCVAR(I,J,K,CC_IDCF). -IF (BNDINT_FLAG) THEN - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL -ELSE - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD -ENDIF -! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: -DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI + N_VERTS = 0 + DO K = 0, IJK(3)-1 + BOX_XYZ(3) = (REAL(IJK(3)-1-K,EB)*XB(5) + REAL(K,EB)*XB(6))/REAL(IJK(3)-1,EB) + DO J = 0, IJK(2)-1 + BOX_XYZ(2) = (REAL(IJK(2)-1-J,EB)*XB(3) + REAL(J,EB)*XB(4))/REAL(IJK(2)-1,EB) + DO I = 0, IJK(1)-1 + BOX_XYZ(1) = (REAL(IJK(1)-1-I,EB)*XB(1) + REAL(I,EB)*XB(2))/REAL(IJK(1)-1,EB) + VERTS(3*N_VERTS+1:3*N_VERTS+3) = BOX_XYZ(1:3) + N_VERTS = N_VERTS + 1 + ENDDO + ENDDO + ENDDO - IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE + ! define tetrahedrons in box - IF (CELLRT(I,J,K)) CYCLE ! Special cell with bod-bod or self intersection. + N_VOLUS = 0 + NI = IJK(1) + NIJ = IJK(1)*IJK(2) + DO K = 0, IJK(3)-2 + DO J = 0, IJK(2)-2 + DO I = 0, IJK(1)-2 - IF(IJK_COUNTED(I,J,K)) CYCLE; IJK_COUNTED(I,J,K)=.TRUE. + ! 8-------7 + ! / . / | + ! 5-------6 | + ! | . | | + ! | . | | + ! | 4-------3 + ! | / | / + ! 1-------2 + BOXVERTLIST(1) = K*NIJ + J*NI + I + 1 + BOXVERTLIST(2) = BOXVERTLIST(1) + 1 + BOXVERTLIST(3) = BOXVERTLIST(2) + NI + BOXVERTLIST(4) = BOXVERTLIST(3) - 1 + BOXVERTLIST(5) = BOXVERTLIST(1) + NIJ + BOXVERTLIST(6) = BOXVERTLIST(2) + NIJ + BOXVERTLIST(7) = BOXVERTLIST(3) + NIJ + BOXVERTLIST(8) = BOXVERTLIST(4) + NIJ + CALL BOX2TETRA(BOXVERTLIST,VOLUS(4*N_VOLUS+1:4*N_VOLUS+24)) + N_VOLUS = N_VOLUS + 6 + ENDDO + ENDDO + ENDDO + N_FACES=0 + ENDIF NXB_IF - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) + ! setup a sphere object (SPHERE_RADIUS and SPHERE_ORIGIN keywords) - ! Start cut-cell INB cut-faces computation: - ! Loop local arrays to cell: - NSEG = 0 - SEG_CELL = CC_UNDEFINED + IF (SPHERE_RADIUS MESHES(1) + DX = M%DXMIN - ! CUT_EDGE index of bounding Cartesian faces: - CEIB_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCE,IAXIS) - CEIB_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCE,IAXIS) - CEIB_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCE,JAXIS) - CEIB_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCE,JAXIS) - CEIB_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCE,KAXIS) - CEIB_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCE,KAXIS) + ! 2*PI*R/(5*2^N_LEVELS) ~= DX, solve for N_LEVELS - ! Cartesian Faces INBOUNDARY segments: - DO FAXIS=IAXIS,KAXIS - DO ILH=LOW_IND,HIGH_IND - ! By segment: Add Vertices/Segments to local arrays: - CEI = CEIB_XYZ(ILH,FAXIS) - IF ( CEI > 0 ) THEN ! There are inboundary cut-edges - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE + IF (SPHERE_RADIUS<100.0_EB*TWENTY_EPSILON_EB) SPHERE_RADIUS = 100.0_EB*TWENTY_EPSILON_EB + + IF (SPHERE_TYPE/=2) SPHERE_TYPE = 1 + IF (N_LEVELS<0 .AND. N_LAT>0 .AND. N_LONG>0) SPHERE_TYPE = 2 + IF (SPHERE_TYPE==1) THEN + IF (N_LEVELS==-1) N_LEVELS = INT(LOG(2.0_EB*PI*SPHERE_RADIUS/(5.0_EB*DX))/LOG(2.0_EB)) + N_LEVELS = MIN(7,MAX(0,N_LEVELS)) + N_FACES = 20*(4**N_LEVELS+1) ! NOTE : Number larger than actual value. + ELSE + IF (N_LONG<6) N_LONG = MAX(6,INT(2.0_EB*PI*SPHERE_RADIUS/DX)+1) + IF (N_LAT<3) N_LAT = MAX(3,INT(PI*SPHERE_RADIUS/DX)+1) + N_FACES = 2*N_LAT*N_LONG ! NOTE : Number larger than actual value. + ENDIF + IF (N_FACES > MAX_FACES) THEN + MAX_FACES = N_FACES + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + DEALLOCATE(VERTS,FACES,TFACES); + ALLOCATE(VERTS(3*MAX_VERTS+1)); ALLOCATE(TFACES(6*MAX_FACES+1)); ALLOCATE(FACES(4*MAX_FACES+1)) + VERTS=1.001_EB*MAX_VAL; FACES=0 + ENDIF + IF (SPHERE_TYPE==1) THEN + CALL INIT_SPHERE(N_LEVELS,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,VERTS,FACES) + ELSE + CALL INIT_SPHERE2(N_VERTS,N_FACES,N_LAT,N_LONG,VERTS,FACES) + ENDIF + DO I = 0, N_VERTS-1 + VERTS(3*I+1:3*I+3) = SPHERE_ORIGIN(1:3) + SPHERE_RADIUS*VERTS(3*I+1:3*I+3) + ENDDO + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 + IF (TRIM(SURF_ID(1))/='null') SURFS = 1 ! First single SURF_ID entry takes precedence. + ENDIF - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - STRI(1:CC_MAX_WSTRIANG_SEG+2) = & - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) + ! Setup a cylinder object (CYLINDER_RADIUS, CYLINDER_LENGTH, CYLINDER_ORIGIN, CYLINDER_AXIS keywords): + DEFINE_CYLINDER_IF: IF ( CYLINDER_LENGTH VEC(3) ) THEN - ! DO NOTHING: - ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN - SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 - SEG_CELL(5,IDUM) = VEC(4) - ENDIF - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - NSEG = NSEG + 1 - CALL REALLOCATE_SEG_CELL - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - ENDIF - ENDDO - ENDIF - ENDDO - ENDDO + IF (CYLINDER_NSEG_THETA ==-1) CYLINDER_NSEG_THETA = 8 + IF (CYLINDER_NSEG_AXIS ==-1) CYLINDER_NSEG_AXIS = 1 - ! Cells INBOUNDARY segments: - CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCE) - IF ( CEI > 0 ) THEN ! There are inboundary cut-edges - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE + N_FACES = 2*CYLINDER_NSEG_THETA*(CYLINDER_NSEG_AXIS+2) ! NOTE : Number larger than actual value. + IF (N_FACES > MAX_FACES) THEN + MAX_FACES = N_FACES + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + DEALLOCATE(VERTS,FACES,TFACES); ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1)) + VERTS=1.001_EB*MAX_VAL; FACES=0 + ENDIF - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - STRI(1:CC_MAX_WSTRIANG_SEG+2) = & - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) + ! Call routine to create cylinder: + CALL DEFINE_CYLINDER(VERTS,MAX_VERTS,N_VERTS,FACES,MAX_FACES,N_FACES,VOLUS,MAX_VOLUS,N_VOLUS,CYL_FIND) - ! x,y,z of node 1: - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD1,XYZVERT) - ! x,y,z of node 2: - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD2,XYZVERT) + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 - IF (INOD1 == INOD2) CYCLE + IF (TRIM(SURF_ID(1))/='null') THEN ! First single SURF_ID entry takes precedence. + SURFS = 1 + ELSEIF (TRIM(SURF_IDS(1))/='null' .AND. TRIM(SURF_IDS(2))/='null' .AND. TRIM(SURF_IDS(3))/='null') THEN + SURF_ID(1:3) = SURF_IDS(1:3) + ! Then SURF_IDS(1:3), where (1) is top, (2) sides (3) bottom. + SURFS(CYL_FIND(LOW_IND,1):CYL_FIND(HIGH_IND,1)) = 1 + SURFS(CYL_FIND(LOW_IND,2):CYL_FIND(HIGH_IND,2)) = 2 + SURFS(CYL_FIND(LOW_IND,3):CYL_FIND(HIGH_IND,3)) = 3 + ENDIF - VEC(NOD1:NOD2) = (/ INOD1, INOD2 /) - VEC(NOD2+1:NOD2+CC_MAX_WSTRIANG_SEG+2) = STRI(1:CC_MAX_WSTRIANG_SEG+2) - VEC(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7) = (/ CC_ETYPE_CFINB, CEI, IEDGE /) - ! Insertion ADD segment: - INLIST = .FALSE. - DO IDUM = 1,NSEG - DO IEQ1=1,3 - EQUAL1 = SEG_CELL(INDVERTBOD(IEQ1),IDUM) == VEC(INDVERTBOD(IEQ1)) - IF (.NOT.EQUAL1) EXIT - ENDDO - DO IEQ2=1,3 - EQUAL2 = SEG_CELL(INDVERTBOD(IEQ2),IDUM) == VEC(INDVERTBOD2(IEQ2)) - IF (.NOT.EQUAL2) EXIT - ENDDO - IF ( EQUAL1 .OR. EQUAL2 ) THEN - IF ( SEG_CELL(3,IDUM) > VEC(3) ) THEN - ! DO NOTHING: - ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN - SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 - SEG_CELL(5,IDUM) = VEC(4) - ENDIF - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - NSEG = NSEG + 1 - CALL REALLOCATE_SEG_CELL - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - ENDIF - ENDDO - ENDIF + ENDIF DEFINE_CYLINDER_IF - ! Drop segments that are unconnected: - ALLOCATE(VERT_SEGS(1:NVERT)); VERT_SEGS(1:NVERT)=0 - DO IDUM = 1,NSEG - IF (SEG_CELL(NOD1,IDUM) == SEG_CELL(NOD2,IDUM)) CYCLE - VERT_SEGS(SEG_CELL(NOD1,IDUM)) = VERT_SEGS(SEG_CELL(NOD1,IDUM)) + 1 - VERT_SEGS(SEG_CELL(NOD2,IDUM)) = VERT_SEGS(SEG_CELL(NOD2,IDUM)) + 1 - ENDDO - ALLOCATE(SEG_CELL_AUX(SIZE(SEG_CELL,DIM=1),SIZE(SEG_CELL,DIM=2))) - SEG_CELL_AUX = SEG_CELL - COUNT = 0 - DO IDUM = 1,NSEG - IF ( (SEG_CELL_AUX(NOD1,IDUM) /= SEG_CELL_AUX(NOD2,IDUM)) .AND. & - (VERT_SEGS(SEG_CELL_AUX(NOD1,IDUM))>1) .AND. (VERT_SEGS(SEG_CELL_AUX(NOD2,IDUM))>1) ) THEN - COUNT = COUNT + 1 - SEG_CELL(:,COUNT) = SEG_CELL_AUX(:,IDUM) - CYCLE - ENDIF - ENDDO - NSEG = COUNT - DEALLOCATE(SEG_CELL_AUX,VERT_SEGS) + ! Setup an extruded POLYGON object: + POLY_COND : IF (N_POLY_VERTS > 0) THEN + IF ( ABS(EXTRUDE) < GEOMEPS ) THEN + WRITE(MESSAGE,'(A,A,A)') 'ERROR(712): For extruded Polygon GEOM ',TRIM(ID),& + ' : extrusion distance in EXTRUDE field not defined or zero. Define EXTRUDE value in &GEOM.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF - ! Now obtain body-triangle combinations present: - BOD_TRI = CC_UNDEFINED - NBODTRI = 0 - DO ISEG=1,NSEG + ! Do some tests in POLY, Repeated vertex, etc.: + IF (N_POLY_VERTS > N_VERTS) THEN + WRITE(MESSAGE,'(A,A,A,I6,A,I6,A)') 'ERROR(713): For extruded Polygon GEOM ',TRIM(ID),& + ' : Number of POLY indexes ',N_POLY_VERTS,' greater than Number of VERTS ',N_VERTS,'.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + DO J=1,N_POLY_VERTS + DO I=J+1,N_POLY_VERTS + IF (POLY(I)==POLY(J)) THEN + WRITE(MESSAGE,'(A,A,A,I6,A)') 'ERROR(714): For extruded Polygon GEOM ',TRIM(ID),& + ' : Repeated vertex ',POLY(I),' in Polyline.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + IF (NORM2(VERTS(3*POLY(I)-2:3*POLY(I))-VERTS(3*POLY(J)-2:3*POLY(J))) < GEOMEPS) THEN + WRITE(MESSAGE,'(A,A,A,I6,A,I6,A)') 'ERROR(715): For extruded Polygon GEOM ',TRIM(ID),& + ' : Vertices ',POLY(I),' and ',POLY(J),' have same position.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ENDDO - ! First triangle location (Assume one body and at - ! most two triangs per seg). - INLIST = .FALSE. - DO IBODTRI=1,NBODTRI - IF ( (BOD_TRI(1,IBODTRI) == SEG_CELL(6,ISEG)) .AND. & - (BOD_TRI(2,IBODTRI) == SEG_CELL(4,ISEG)) ) THEN - ! Body/triang already on list. - INLIST = .TRUE. - CYCLE - ENDIF - enddo - IF (.NOT.INLIST) THEN - ! Add first triang to list: - NBODTRI = NBODTRI + 1 - BOD_TRI(1:2,NBODTRI) = SEG_CELL( (/ 6, 4 /) , ISEG) - ENDIF + N_FACES = 5*N_POLY_VERTS ! NOTE : Number larger than actual value. + IF (N_FACES > MAX_FACES) THEN + MAX_FACES = N_FACES + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + DEALLOCATE(VERTS,FACES,TFACES); ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1)) + VERTS=1.001_EB*MAX_VAL; FACES=0 + ENDIF - ! No second triangle associated: - IF ( SEG_CELL(3,ISEG) < 2 ) CYCLE + CALL DEFINE_EXTRUDED_POLY(MAX_VERTS,N_VERTS,VERTS,MAX_POLY_VERTS,N_POLY_VERTS,POLY,& + EXTRUDE,MAX_FACES,N_FACES,START_FACE_LO,START_FACE_HI,START_FACE_MID,FACES,IERR) - ! Second triangle location - INLIST = .FALSE. - DO IBODTRI=1,NBODTRI - IF ( (BOD_TRI(1,IBODTRI) == SEG_CELL(6,ISEG)) .AND. & - (BOD_TRI(2,IBODTRI) == SEG_CELL(5,ISEG)) ) THEN - ! Body/triang already on list. - INLIST = .TRUE. - CYCLE - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ! Add first triang to list: - NBODTRI = NBODTRI + 1 - BOD_TRI(1:2,NBODTRI) = SEG_CELL( (/ 6, 5 /) , ISEG) - ENDIF - ENDDO ! ISEG. + IF(IERR /= 0) RETURN - ! Do Test for cycling when all body-triangle combinations produce two or less segments: - SEG_FLAG(1)=.TRUE. - DO ICF=1,NBODTRI - IBOD = BOD_TRI(1,ICF) - ITRI = BOD_TRI(2,ICF) - NSEG_FACE = 0 - DO ISEG=1,NSEG - IF ((SEG_CELL(6,ISEG) == IBOD) .AND. & - ((SEG_CELL(4,ISEG) == ITRI) .OR. (SEG_CELL(5,ISEG) == ITRI)) ) THEN - NSEG_FACE = NSEG_FACE + 1 - ENDIF - ENDDO - ! If only one or two seg => continue: - IF ( NSEG_FACE <= 2 ) CYCLE - SEG_FLAG(1)=.FALSE. - EXIT - ENDDO - IF (SEG_FLAG(1)) CYCLE ! CYCLES I,J,K loop. + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 - ! This is a cut-face, allocate space: - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE + IF (TRIM(SURF_ID(1))/='null') THEN ! First single SURF_ID entry takes precedence. + SURFS = 1 + ELSEIF (TRIM(SURF_IDS(1))/='null' .AND. TRIM(SURF_IDS(2))/='null' .AND. TRIM(SURF_IDS(3))/='null') THEN + SURF_ID(1:3) = SURF_IDS(1:3) + ! Then SURF_IDS(1:3), where (1) is top, (2) sides (3) bottom. + SURFS(START_FACE_HI +1:START_FACE_HI+START_FACE_MID) = 1 + SURFS(START_FACE_MID+1:N_FACES) = 2 + SURFS(START_FACE_LO +1:START_FACE_LO+START_FACE_HI) = 3 + ENDIF - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + ENDIF POLY_COND - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, 0 /) ! No axis = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_INBOUNDARY - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NBODTRI,CC_MAXVERT_CUTFACE) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - ALLOCATE(CF%EDGE_LIST(3,NSEG)) - CF%EDGE_LIST(1:3,1:NSEG) = SEG_CELL(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7,1:NSEG) - ALLOCATE(CF%CEDGES(SIZE(CF%CFELEM,DIM=1),SIZE(CF%CFELEM,DIM=2))); CF%CEDGES = CC_UNDEFINED + G%N_LEVELS = N_LEVELS + G%SPHERE_ORIGIN = SPHERE_ORIGIN + G%SPHERE_RADIUS = SPHERE_RADIUS + G%CYLINDER_LENGTH = CYLINDER_LENGTH + G%CYLINDER_RADIUS = CYLINDER_RADIUS + G%CYLINDER_ORIGIN = CYLINDER_ORIGIN + G%CYLINDER_AXIS = CYLINDER_AXIS + G%IJK = IJK + G%GEOM_TYPE = GEOM_TYPE + ! If terrain GEOM and CELL_BLOCK_IOR not set in input line, block in the -3 direction: + IF(GEOM_TYPE==TERRAIN_GEOM_TYPE .AND. CELL_BLOCK_IOR==0) G%CELL_BLOCK_IOR = -KAXIS - ! Running by body-triangle combination, define list of - ! segments that belong to each pair. - ICF_LOOP : DO ICF=1,NBODTRI + LOGTEST = GEOM_TYPE==CAD_GEOM_TYPE .OR. GEOM_TYPE==TERRAIN_GEOM_TYPE + IF (.NOT.LOGTEST) THEN + ! The geometry has been constructed from predefined object : Terrain, cube, sphere, etc. + ! This requires removing duplicate verts. + ! For geometries where VERTS, FACES are being read, GEOM_TYPE=CAD_GEOM_TYPE, it is assumed duplicate vertices + ! have already been removed. + FIRST_FACE_INDEX=1 + CALL REMOVE_DUPLICATE_VERTS(N_VERTS,N_FACES,N_VOLUS,MAX_VERTS,MAX_FACES,MAX_VOLUS,FIRST_FACE_INDEX,& + VERTS,FACES,VOLUS,GEOMEPS) + ENDIF - IBOD = BOD_TRI(1,ICF) - ITRI = BOD_TRI(2,ICF) + ! wrap up - SEG_FACE = CC_UNDEFINED - NSEG_FACE = 0 - DO ISEG=1,NSEG - IF ((SEG_CELL(6,ISEG) == IBOD) .AND. & - ((SEG_CELL(4,ISEG) == ITRI) .OR. (SEG_CELL(5,ISEG) == ITRI)) ) THEN - NSEG_FACE = NSEG_FACE + 1 - SEG_FACE(NOD1:NOD2+1,NSEG_FACE) = (/ SEG_CELL(NOD1:NOD2,ISEG), ISEG /) - ENDIF - ENDDO + G%ID = ID + G%N_VOLUS_BASE = N_VOLUS + G%N_FACES_BASE = N_FACES + G%N_VERTS_BASE = N_VERTS - ! If only one or two seg => continue: - IF ( NSEG_FACE <= 2 ) CYCLE + ! Check if SURF_ID(1) has been defined: + N_SURF_ID = 0 + IF (TRIM(SURF_ID(1))=='null') THEN + SURF_INDEX_PER_FACE = .FALSE. + HAVE_SURF = .FALSE. + ALLOCATE(G%SURF_ID(1)) + G%SURF_ID(1) = 'null' + ELSE + SURF_INDEX_PER_FACE = .TRUE. + ! Check that elements of the list of SURF_IDs are in list of SURFS: + ! How many SURF_ID entries are different than Null, where in SURFACE they belong: + DO I = 1, MAX_SURF_IDS + IF( SURF_ID(I)=='null' ) EXIT ! First 'null' + N_SURF_ID = N_SURF_ID + 1 + ENDDO + ALLOCATE(G%SURF_ID(1:N_SURF_ID)) + G%SURF_ID(1:N_SURF_ID) = SURF_ID(1:N_SURF_ID) - ! Now build sequential list of segments: - SEG_FACE2 = CC_UNDEFINED !zeros(nseg_face,2); %[nod1 nod2] - SEG_FLAG = .TRUE. !ones(1,nseg_face); - ISEG_FACE = 1 - COUNTR = 1 - CTSTART = COUNTR - SEG_FACE2(NOD1:NOD2+1,COUNTR) = SEG_FACE(NOD1:NOD2+1,ISEG_FACE) - SEG_FLAG(ISEG_FACE) = .FALSE. - NSEG_LEFT = NSEG_FACE - 1 - CTR = 0 - CYCLE_CELL= .FALSE. - ! Infinite Loop: - INF_LOOP : DO - DO ISEG_FACE=1,NSEG_FACE + ! Now find correspondence with SURFACE(N)%ID: + IF (ALLOCATED(SURF_ID_IND)) DEALLOCATE(SURF_ID_IND) + ALLOCATE(SURF_ID_IND(N_SURF_ID)) + DO I = 1, N_SURF_ID + ! Get Surf Index: + IN_LIST = .FALSE. + DO J = 0, N_SURF + IF (TRIM(SURF_ID(I))/=TRIM(SURFACE(J)%ID)) CYCLE + SURF_ID_IND(I)=J + IN_LIST = .TRUE. + EXIT + ENDDO + IF(.NOT.IN_LIST) THEN + WRITE(MESSAGE,'(A,I4,3A)') 'ERROR(716): problem with GEOM, the surface ID(',I,') =',& + TRIM(SURF_ID(I)),' is not defined.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ENDIF + G%HAVE_SURF = HAVE_SURF - IF (SEG_FLAG(ISEG_FACE)) THEN ! This seg hasn't been added to seg_face2 - ! Test for common node: - IF ( SEG_FACE2(NOD2,COUNTR) == SEG_FACE(NOD1,ISEG_FACE) ) THEN - COUNTR = COUNTR + 1 - SEG_FACE2(NOD1:NOD2+1,COUNTR) = SEG_FACE(NOD1:NOD2+1,ISEG_FACE) - SEG_FLAG(ISEG_FACE) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - EXIT - ELSEIF ( SEG_FACE2(NOD2,COUNTR) == SEG_FACE(NOD2,ISEG_FACE) ) THEN + IF (MATL_ID=='null') THEN + HAVE_MATL = .FALSE. + ENDIF + G%MATL_ID = MATL_ID + G%HAVE_MATL = HAVE_MATL - IF ( SEG_FACE2(NOD1,COUNTR) == SEG_FACE(NOD1,ISEG_FACE) ) & - PRINT*, "Building INBOUND faces, repeated index." - COUNTR = COUNTR + 1 - SEG_FACE2(NOD1:NOD2+1,COUNTR) = SEG_FACE( (/ NOD2, NOD1, NOD2+1 /) ,ISEG_FACE) - SEG_FLAG(ISEG_FACE) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - EXIT - ENDIF - ENDIF - ENDDO - ! Break loop: - IF ( NSEG_LEFT == 0 ) EXIT - CTR = CTR + 1 + IF (N_VERTS>0) THEN - ! Plot cell and cut-faces if there is no convergence: - IF ( CTR > NSEG_FACE**3 ) THEN - CYCLE_CELL = .TRUE. - MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 - NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) - IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN - ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) - DEALLOCATE(MESHES(NM)%SPCELL_LIST) - ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED - DEALLOCATE(SPCELL_LIST) - ENDIF - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) - EXIT INF_LOOP + TXMIN = VERTS(1) + TXMAX = TXMIN + TYMIN = VERTS(2) + TYMAX = TYMIN + DO I = 1, N_VERTS + TX = VERTS(3*I-2) + TY = VERTS(3*I-1) + IF (TXTXMAX)TXMAX=TX + IF (TYTYMAX)TYMAX=TY + ENDDO + TEXTURE_ORIGIN(1)=TXMIN + TEXTURE_ORIGIN(2)=TYMIN + TEXTURE_SCALE(1)=TXMAX-TXMIN + TEXTURE_SCALE(2)=TYMAX-TYMIN + ENDIF - IF (DEBUG_SET_CUTCELLS) THEN - WRITE(LU_ERR,*) "Error GET_CARTCELL_CUTFACES: ctr > nseg_face^3 ,",BNDINT_FLAG,I,J,K,NCUTFACE,& - CF%NFACE - WRITE(LU_ERR,*) "Cannot build boundary cut faces in cell (NM,I,J,K):",NM,I,J,K - WRITE(LU_ERR,*) "Located in position:",XCELL(I),YCELL(J),ZCELL(K) - WRITE(LU_ERR,*) "Check for Geometry surface inconsistencies at said location." - WRITE(LU_ERR,*) 'Cartesian CELL:',BNDINT_FLAG,MESHES(NM)%CCVAR(I,J,K,CC_CGSC),CC_CUTCFE,I,J,K - LU_DB_SETCC = GET_FILE_NUMBER() - OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_cutfaces.dat", STATUS='REPLACE') - ! Info pertaining to the Cartesian Cell: - WRITE(LU_DB_SETCC,*) 'I,J,K:' - WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS - WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' - WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) ! MESHES(NM)%XC(I),MESHES(NM)%DX(I) - WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) ! MESHES(NM)%YC(J),MESHES(NM)%DY(J) - WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) ! MESHES(NM)%ZC(K),MESHES(NM)%DZ(K) - WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT:' - WRITE(LU_DB_SETCC,*) NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT - WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' - DO IDUM=1,NVERT - WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) - ENDDO - WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' - DO IDUM=1,NSEG - WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(NOD1:NOD2,IDUM),SEG_CELL(3:6,IDUM) - ENDDO - WRITE(LU_DB_SETCC,*) 'SEG_FACE(NOD1:NOD2,1:NSEG_FACE):' - DO IDUM=1,NSEG_FACE - WRITE(LU_DB_SETCC,*) IDUM,SEG_FACE(NOD1:NOD2,IDUM) - ENDDO - WRITE(LU_DB_SETCC,*) 'SEG_FACE2(NOD1:NOD21:COUNTR):' - DO IDUM=1,COUNTR - WRITE(33,*) IDUM,SEG_FACE2(NOD1:NOD2,IDUM) - ENDDO - WRITE(LU_DB_SETCC,*) 'ICF,BOD_TRI:' - WRITE(LU_DB_SETCC,*) ICF,NBODTRI - DO IDUM=1,NBODTRI - WRITE(LU_DB_SETCC,*) BOD_TRI(1:2,IDUM) - ENDDO - CLOSE(LU_DB_SETCC) - CALL DEBUG_WAIT - ENDIF + G%TEXTURE_ORIGIN = TEXTURE_ORIGIN + G%TEXTURE_SCALE = TEXTURE_SCALE + IF ( TRIM(TEXTURE_MAPPING)/='SPHERICAL' .AND. TRIM(TEXTURE_MAPPING)/='RECTANGULAR') TEXTURE_MAPPING = 'RECTANGULAR' + G%TEXTURE_MAPPING = TEXTURE_MAPPING + G%IS_TERRAIN = IS_TERRAIN + + ! setup volumes + + N_VOLUS_IF: IF (N_VOLUS>0) THEN + ALLOCATE(G%VOLUS(4*N_VOLUS),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%VOLUS',IZERO) + DO I = 0, N_VOLUS-1 + VOL(1:4)=> VOLUS(4*I+1:4*I+4) + V1(1:3) => VERTS(3*VOL(1)-2:3*VOL(1)) + V2(1:3) => VERTS(3*VOL(2)-2:3*VOL(2)) + V3(1:3) => VERTS(3*VOL(3)-2:3*VOL(3)) + V4(1:3) => VERTS(3*VOL(4)-2:3*VOL(4)) + VOLUME = TETRAHEDRON_VOLUME(V3,V4,V2,V1) + IF ( VOLUME<0.0_EB ) THEN ! reorder vertices if tetrahedron volume is negative + IVOL=VOL(3) + VOL(3)=VOL(4) + VOL(4)=IVOL + ENDIF + ENDDO + G%VOLUS(1: 4*N_VOLUS) = VOLUS(1:4*N_VOLUS) + IF (ANY(VOLUS(1:4*N_VOLUS)<1 .OR. VOLUS(1:4*N_VOLUS)>N_VERTS)) THEN + CALL SHUTDOWN('ERROR(717): problem with GEOM, vertex index out of bounds.') + ENDIF + + ALLOCATE(G%MATLS(N_VOLUS),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%MATLS',IZERO) + MATL_INDEX = GET_MATL_INDEX(MATL_ID) + ! The following constraint is removed for the time being. When Tetrahedrons are actually used for heat transfer + ! and pyrolysis this will be needed. + !IF (MATL_INDEX==0) THEN + ! IF (TRIM(MATL_ID)=='null') THEN + ! WRITE(MESSAGE,'(A)') 'ERROR: problem with GEOM, the material keyword, MATL_ID, is not defined.' + ! ELSE + ! WRITE(MESSAGE,'(3A)') 'ERROR: problem with GEOM, the material ',TRIM(MATL_ID),' is not defined.' + ! ENDIF + ! CALL SHUTDOWN(MESSAGE) + !ENDIF + G%MATLS(1:N_VOLUS) = MATL_INDEX - ENDIF + ! construct an array of external faces - ENDDO INF_LOOP - IF (CYCLE_CELL) EXIT ICF_LOOP + ! determine which tetrahedron faces are external - IF ( COUNTR /= NSEG_FACE) & - PRINT*, "Building INBOUND faces: ~isequal(countr,nseg)" + IF (N_FACES==0) THEN + N_FACES = 4*N_VOLUS + IF(ALLOCATED(IS_EXTERNAL)) DEALLOCATE(IS_EXTERNAL) + ALLOCATE(IS_EXTERNAL(0:N_FACES-1),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','IS_EXTERNAL',IZERO) - ! Using triangles normal, reorder nodes as in right hand rule. - NORMTRI(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,ITRI) + IS_EXTERNAL(0:N_FACES-1)=.TRUE. ! start off by assuming all faces are external - ! First test if INB face is on Cartesian face and pointing - ! outside of Cartesian cell. If so drop: - ! Get min max in face for VERTS x,y,z: - XMIN(IAXIS:KAXIS)= 1._EB/TWENTY_EPSILON_EB - XMAX(IAXIS:KAXIS)=-1._EB/TWENTY_EPSILON_EB - DO ISEG_FACE=1,NSEG_FACE - XMIN(IAXIS) = MIN(XMIN(IAXIS), XYZVERT(IAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - XMIN(JAXIS) = MIN(XMIN(JAXIS), XYZVERT(JAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - XMIN(KAXIS) = MIN(XMIN(KAXIS), XYZVERT(KAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - XMAX(IAXIS) = MAX(XMAX(IAXIS), XYZVERT(IAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - XMAX(JAXIS) = MAX(XMAX(JAXIS), XYZVERT(JAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - XMAX(KAXIS) = MAX(XMAX(KAXIS), XYZVERT(KAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - ENDDO - ! IAXIS: - IF ( (ABS(NORMTRI(IAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(XFACE(I-1)-XMIN(IAXIS)) < GEOMEPS) .AND. & - (ABS(XFACE(I-1)-XMAX(IAXIS)) < GEOMEPS)) CYCLE ! Low Face - IF ( (ABS(NORMTRI(IAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(XFACE(I )-XMIN(IAXIS)) < GEOMEPS) .AND. & - (ABS(XFACE(I )-XMAX(IAXIS)) < GEOMEPS)) CYCLE ! High Face - ! JAXIS: - IF ( (ABS(NORMTRI(JAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(YFACE(J-1)-XMIN(JAXIS)) < GEOMEPS) .AND. & - (ABS(YFACE(J-1)-XMAX(JAXIS)) < GEOMEPS)) CYCLE ! Low Face - IF ( (ABS(NORMTRI(JAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(YFACE(J )-XMIN(JAXIS)) < GEOMEPS) .AND. & - (ABS(YFACE(J )-XMAX(JAXIS)) < GEOMEPS)) CYCLE ! High Face - ! KAXIS: - IF ( (ABS(NORMTRI(KAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(ZFACE(K-1)-XMIN(KAXIS)) < GEOMEPS) .AND. & - (ABS(ZFACE(K-1)-XMAX(KAXIS)) < GEOMEPS)) CYCLE ! Low Face - IF ( (ABS(NORMTRI(KAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(ZFACE(K )-XMIN(KAXIS)) < GEOMEPS) .AND. & - (ABS(ZFACE(K )-XMAX(KAXIS)) < GEOMEPS)) CYCLE ! High Face + ! reorder face indices so the the first index is always the smallest - ! Face Vertices average location: - XCEN(IAXIS:KAXIS) = 0._EB - DO ISEG_FACE=1,NSEG_FACE - XCEN(IAXIS:KAXIS) = XCEN(IAXIS:KAXIS) + XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE)) - ENDDO - XCEN(IAXIS:KAXIS) = XCEN(IAXIS:KAXIS) / REAL(NSEG_FACE,EB) + ! 1 + ! /|\ . + ! / | \ . + ! / | \ . + ! / | \ . + ! / | \ . + ! / 4 \ . + ! / . . \ . + ! / . . \ . + ! / . . \ . + ! / . . \ . + ! / . . \ . + ! / . .\ . + ! 2-------------------------3 - ISEG_FACE = 1 - VC1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE )) - XCEN(IAXIS:KAXIS) - V12(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE+1)) - & - XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE )) + DO I = 0, N_VOLUS-1 + FACES(12*I+1) = VOLUS(4*I+1) + FACES(12*I+2) = VOLUS(4*I+2) + FACES(12*I+3) = VOLUS(4*I+3) + CALL REORDER_VERTS(FACES(12*I+1:12*I+3)) - CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) - CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) - CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) + FACES(12*I+4) = VOLUS(4*I+1) + FACES(12*I+5) = VOLUS(4*I+3) + FACES(12*I+6) = VOLUS(4*I+4) + CALL REORDER_VERTS(FACES(12*I+4:12*I+6)) - RH_ORIENTED = ( NORMTRI(IAXIS)*CROSSV(IAXIS) + & - NORMTRI(JAXIS)*CROSSV(JAXIS) + & - NORMTRI(KAXIS)*CROSSV(KAXIS) ) > 0._EB + FACES(12*I+7) = VOLUS(4*I+1) + FACES(12*I+8) = VOLUS(4*I+4) + FACES(12*I+9) = VOLUS(4*I+2) + CALL REORDER_VERTS(FACES(12*I+7:12*I+9)) - NP = NSEG_FACE - NCF = CF%NFACE + 1 - NVSIZE=SIZE(CF%CFELEM,DIM=1) - IF(NP+1 > NVSIZE) THEN - ALLOCATE(CFELEM(1:NP+1+DELTA_VERT,1:NBODTRI)); CFELEM = CC_UNDEFINED - CFELEM(1:NVSIZE,1:NBODTRI) = CF%CFELEM(1:NVSIZE,1:NBODTRI) - CALL MOVE_ALLOC(FROM=CFELEM,TO=CF%CFELEM) - ALLOCATE(CFELEM(1:NP+1+DELTA_VERT,1:NBODTRI)); CFELEM = CC_UNDEFINED - CFELEM(1:NVSIZE,1:NBODTRI) = CF%CEDGES(1:NVSIZE,1:NBODTRI) - CALL MOVE_ALLOC(FROM=CFELEM,TO=CF%CEDGES) - ENDIF - CF%CFELEM(1,NCF) = NP; CF%CEDGES(1,NCF) = NP - IF (RH_ORIENTED) THEN - DO IDUM=1,NP - CF%CFELEM(IDUM+1,NCF) = SEG_FACE2(NOD1 ,IDUM) - CF%CEDGES(IDUM+1,NCF) = SEG_FACE2(NOD2+1,IDUM) ! Segment index in SEG_CELL/EDGE_LIST - ENDDO - ELSE - DO IDUM=1,NP - CF%CFELEM(IDUM+1,NCF) = SEG_FACE2(NOD1 ,NP+1-IDUM) - CF%CEDGES(IDUM+1,NCF) = SEG_FACE2(NOD2+1,NP+1-IDUM) ! Segment index in SEG_CELL/EDGE_LIST - ENDDO - IDUM = CF%CEDGES(2,NCF) - CF%CEDGES(2:NP,NCF) = CF%CEDGES(3:NP+1,NCF); CF%CEDGES(NP+1,NCF) = IDUM - ENDIF - CF%NFACE = NCF + FACES(12*I+10) = VOLUS(4*I+2) + FACES(12*I+11) = VOLUS(4*I+4) + FACES(12*I+12) = VOLUS(4*I+3) + CALL REORDER_VERTS(FACES(12*I+10:12*I+12)) + ENDDO - ! Compute Sections area and centroid: - AREA = 0._EB - ACEN(IAXIS:KAXIS) = 0._EB - INXAREA = 0._EB - SQAREA(IAXIS:KAXIS) = 0._EB - DO ISEG_FACE=1,NSEG_FACE-1 + ! find faces that match - IDUM = CF%CFELEM(1+ISEG_FACE,NCF) - X1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) - IDUM = CF%CFELEM(2+ISEG_FACE,NCF) - X2(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) - VC1(IAXIS:KAXIS) = X1(IAXIS:KAXIS) - XCEN(IAXIS:KAXIS) - V12(IAXIS:KAXIS) = X2(IAXIS:KAXIS) - X1(IAXIS:KAXIS) - XCENI(IAXIS:KAXIS) = (XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) / 3._EB + SORT_FACES=2 + IF (GEOM_TYPE == SPHERE_GEOM_TYPE) SORT_FACES = 3 ! Case of sphere. - CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) - CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) - CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) + SORT_FACES_IF: IF (SORT_FACES==1 ) THEN ! O(n*log(n)) algorithm for determining external faces + ALLOCATE(OFACES(N_FACES),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','OFACES',IZERO) + CALL ORDER_FACES(OFACES,N_FACES) + DO I = 1, N_FACES-1 + FACEI=>FACES(3*OFACES(I)-2:3*OFACES(I)) + FACEJ=>FACES(3*OFACES(I)+1:3*OFACES(I)+3) + IF (FACEI(1)==FACEJ(1) .AND. & + MIN(FACEI(2),FACEI(3))==MIN(FACEJ(2),FACEJ(3)) .AND. & + MAX(FACEI(2),FACEI(3))==MAX(FACEJ(2),FACEJ(3))) THEN + IS_EXTERNAL(OFACES(I))=.FALSE. + IS_EXTERNAL(OFACES(I-1))=.FALSE. + IF (FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(3)) THEN + WRITE(LU_ERR,*) 'WARNING: duplicate faces found:', FACEI(1),FACEI(2),FACEI(3) + ENDIF + ENDIF + ENDDO + DEALLOCATE(OFACES) + ELSEIF(SORT_FACES==2 ) THEN + DO I = 0, N_FACES-1 ! O(n^2) algorithm for determining external faces + FACEI=>FACES(3*I+1:3*I+3) + ! Sort FACEI: + DO J = 0, N_FACES-1 + IF (I==J) CYCLE + FACEJ=>FACES(3*J+1:3*J+3) + IF (FACEI(1)==FACEJ(1)) THEN + IF ((FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(3)) .OR. & + (FACEI(2)==FACEJ(3) .AND. FACEI(3)==FACEJ(2))) THEN + IS_EXTERNAL(I) = .FALSE. + IS_EXTERNAL(J) = .FALSE. + ENDIF + ELSEIF (FACEI(1)==FACEJ(2)) THEN + IF ((FACEI(2)==FACEJ(1) .AND. FACEI(3)==FACEJ(3)) .OR. & + (FACEI(2)==FACEJ(3) .AND. FACEI(3)==FACEJ(1))) THEN + IS_EXTERNAL(I) = .FALSE. + IS_EXTERNAL(J) = .FALSE. + ENDIF + ELSEIF (FACEI(1)==FACEJ(3)) THEN + IF ((FACEI(2)==FACEJ(1) .AND. FACEI(3)==FACEJ(2)) .OR. & + (FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(1))) THEN + IS_EXTERNAL(I) = .FALSE. + IS_EXTERNAL(J) = .FALSE. + ENDIF + ENDIF + ENDDO + ENDDO + ELSEIF(SORT_FACES==3 ) THEN + DO I = 0,N_FACES-1 + ! Check that no verts are at the spheres center: + DO II=1,3 + II1=FACES(3*I+II) + IF ( SQRT((VERTS(3*II1-2)-SPHERE_ORIGIN(IAXIS))**2 + & + (VERTS(3*II1-1)-SPHERE_ORIGIN(JAXIS))**2 + & + (VERTS(3*II1 )-SPHERE_ORIGIN(KAXIS))**2) < GEOMEPS) & + IS_EXTERNAL(I) = .FALSE. + ENDDO + ENDDO + ENDIF SORT_FACES_IF - AREAI = 0.5_EB * SQRT( CROSSV(IAXIS)**2._EB + CROSSV(JAXIS)**2._EB + CROSSV(KAXIS)**2._EB ) - AREA = AREA + AREAI - ACEN(IAXIS:KAXIS) = ACEN(IAXIS:KAXIS) + AREAI * XCENI(IAXIS:KAXIS) - ! volume computation variables: - XC1(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS)) - XC2(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) - X12(IAXIS:KAXIS) = 0.5_EB*( X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) - ! dot(i,nc) int(x)dA - INXAREA = INXAREA + NORMTRI(IAXIS)*XCENI(IAXIS)*AREAI ! Single Gauss pt integration. - ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA - DO IX=IAXIS,KAXIS - INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB - SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREAI ! Midpoint rule. + ! create new FACES index array keeping only external faces + + N_FACES_TEMP = N_FACES + N_FACES=0 + DO I = 0, N_FACES_TEMP-1 + FACE_FROM=>FACES(3*I+1:3*I+3) + ! Drop triangles with zero area: + IF ( (FACE_FROM(1)==FACE_FROM(2)).OR.(FACE_FROM(1)==FACE_FROM(3)).OR.(FACE_FROM(2)==FACE_FROM(3)) ) CYCLE + IF (IS_EXTERNAL(I)) THEN + FACE_TO=>FACES(3*N_FACES+1:3*N_FACES+3) + FACE_TO(1:3) = FACE_FROM(1:3) + N_FACES=N_FACES+1 + ENDIF + ENDDO + G%N_FACES_BASE = N_FACES + + IF (GEOM_TYPE == SPHERE_GEOM_TYPE) THEN + DO I = 0,N_FACES-1 + ! Check that no verts are at the spheres center: + DO II=1,3 + II1=FACES(3*I+II) + IF ( SQRT((VERTS(3*II1-2)-SPHERE_ORIGIN(IAXIS))**2 + & + (VERTS(3*II1-1)-SPHERE_ORIGIN(JAXIS))**2 + & + (VERTS(3*II1 )-SPHERE_ORIGIN(KAXIS))**2) < GEOMEPS) & + WRITE(LU_ERR,*) 'On External Faces, face/vertex ',I,II,II1,' located at center.' ENDDO + II1=FACES(3*I+1) + II2=FACES(3*I+2) + II3=FACES(3*I+3) + DV1(IAXIS:KAXIS)= VERTS(3*II2-2:3*II2) - VERTS(3*II1-2:3*II1) + DV2(IAXIS:KAXIS)= VERTS(3*II3-2:3*II3) - VERTS(3*II1-2:3*II1) + CALL CROSS_PRODUCT(NVECI,DV1,DV2) + DXCEN= 1._EB/3._EB*(VERTS(3*II1-2:3*II1)+VERTS(3*II2-2:3*II2)+VERTS(3*II3-2:3*II3)) - & + SPHERE_ORIGIN(IAXIS:KAXIS) + DOTI = NVECI(IAXIS)*DXCEN(IAXIS) + NVECI(JAXIS)*DXCEN(JAXIS) + NVECI(KAXIS)*DXCEN(KAXIS) + + IF (SIGN(1._EB,DOTI) < 0._EB) THEN + WRITE(LU_ERR,*) I,' has (-) sign normal.' + FACES(3*I+2) = II3 + FACES(3*I+3) = II2 + ENDIF ENDDO - ! Final seg: - IDUM = CF%CFELEM(1+NSEG_FACE,NCF) - X1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) - IDUM = CF%CFELEM(1+1 ,NCF) - X2(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) + ENDIF + CALL COMPUTE_TEXTURES(VERTS,FACES,TFACES,MAX_VERTS,MAX_FACES,N_FACES) - VC1(IAXIS:KAXIS) = X1(IAXIS:KAXIS) - XCEN(IAXIS:KAXIS) - V12(IAXIS:KAXIS) = X2(IAXIS:KAXIS) - X1(IAXIS:KAXIS) - XCENI(IAXIS:KAXIS) = (XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) / 3._EB + ! Surf IDs for generated GEOM: + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) + ALLOCATE(SURFS(N_FACES)) + IF(SURF_INDEX_PER_FACE) THEN + SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). + ELSE + SURFS(:) = 0 ! All external faces point to default surf ID. + ENDIF + ENDIF + ENDIF N_VOLUS_IF - CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) - CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) - CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) + ! Terrain case built with ZVALS, optimized way, define SURFS(:): + IF (N_ZVALS > 0) THEN + ! Surf IDs for generated GEOM: + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) + ALLOCATE(SURFS(N_FACES)) + IF(SURF_INDEX_PER_FACE) THEN + SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). + ELSE + SURFS(:) = 0 ! All external faces point to default surf ID. + ENDIF + ELSEIF(IS_TERRAIN) THEN + ! Finally Enhance SURFS to accomodate new faces. + ALLOCATE(SURFS2(N_FACES)); + ! Here define what SURF to assign to added faces. + IF(SURF_INDEX_PER_FACE) THEN + SURFS2(:) = 1 ! All external faces point to only entry SURF_ID(1). + ELSE + SURFS2(:) = 0 ! All external faces point to default surf ID. + ENDIF + SURFS2(1:N_FACES_ORIG) = SURFS(1:N_FACES_ORIG) + CALL MOVE_ALLOC(FROM=SURFS2,TO=SURFS) + ENDIF - AREAI = 0.5_EB * SQRT( CROSSV(IAXIS)**2._EB + CROSSV(JAXIS)**2._EB + CROSSV(KAXIS)**2._EB ) - AREA = AREA + AREAI - ACEN(IAXIS:KAXIS) = (ACEN(IAXIS:KAXIS) + AREAI * XCENI(IAXIS:KAXIS))/AREA - ! volume computation variables: - XC1(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS)) - XC2(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) - X12(IAXIS:KAXIS) = 0.5_EB*( X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) - ! dot(i,nc) int(x)dA - INXAREA = INXAREA + NORMTRI(IAXIS)*XCENI(IAXIS)*AREAI ! Single Gauss pt integration. - ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA - DO IX=IAXIS,KAXIS - INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB - SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREAI ! Midpoint rule. - ENDDO - CF%AREA(NCF) = AREA - CF%XYZCEN(IAXIS:KAXIS,NCF) = ACEN(IAXIS:KAXIS) - ! Fields for cut-cell volume/centroid computation: - CF%INXAREA(NCF) = INXAREA ! dot(i,nc)*int(x)dA - CF%INXSQAREA(NCF) = SQAREA(IAXIS) ! dot(i,nc)*int(x^2)dA - CF%JNYSQAREA(NCF) = SQAREA(JAXIS) ! dot(j,nc)*int(y^2)dA - CF%KNZSQAREA(NCF) = SQAREA(KAXIS) ! dot(k,nc)*int(z^2)dA - ! Define Body-triangle reference: - CF%BODTRI(1:2,NCF)= (/ IBOD, ITRI /) - ! Assign surf-index: Depending on GEOMETRY: - CF%SURF_INDEX(NCF) = GEOMETRY(IBOD)%SURFS(ITRI) + N_FACES_IF: IF (N_FACES>0) THEN + ALLOCATE(G%FACES(3*N_FACES),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%FACES',IZERO) + G%FACES(1:3*N_FACES) = FACES(1:3*N_FACES) - ENDDO ICF_LOOP + ! Check FACES for out of bounds indexes: + I = MINVAL(FACES(1:3*N_FACES)); II= MINLOC(FACES(1:3*N_FACES),DIM=1) + IF (I < 1) THEN + WRITE(MESSAGE,'(3A,I8,A,I8,A)') 'ERROR(718): Out of Bounds. GEOM: ',TRIM(ID), ', FACE=',& + II/3+1,', has vertex index ',I,' less than 1.' + CALL SHUTDOWN(MESSAGE) + RETURN + ENDIF + I = MAXVAL(FACES(1:3*N_FACES)); II= MAXLOC(FACES(1:3*N_FACES),DIM=1) + IF (I > N_VERTS) THEN + WRITE(MESSAGE,'(3A,I8,A,I8,A,I8,A)') 'ERROR(719): Out of Bounds. GEOM: ',TRIM(ID), ', FACE=',& + II/3+1,', has vertex index ',I,', higher than number of vertices defined ',N_VERTS,'.' + CALL SHUTDOWN(MESSAGE) + RETURN + ENDIF - ! IF((NM==3 .AND. I==4 .AND. J==6 .AND. K==36)) THEN - ! LU_DB_SETCC = GET_FILE_NUMBER() - ! WRITE(LU_ERR,*) 'Writing Cartcell_cutfaces.dat... 11111' - ! OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_cutfaces.dat", STATUS='REPLACE') - ! ! Info pertaining to the Cartesian Cell: - ! WRITE(LU_DB_SETCC,*) 'I,J,K:',CF%NFACE - ! WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS - ! WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' - ! WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) ! MESHES(NM)%XC(I),MESHES(NM)%DX(I) - ! WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) ! MESHES(NM)%YC(J),MESHES(NM)%DY(J) - ! WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) ! MESHES(NM)%ZC(K),MESHES(NM)%DZ(K) - ! WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT:' - ! WRITE(LU_DB_SETCC,*) NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT,CF%NFACE - ! WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' - ! DO IDUM=1,NVERT - ! WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) - ! ENDDO - ! WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' - ! DO IDUM=1,NSEG - ! WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(NOD1:NOD2,IDUM),SEG_CELL(3:6,IDUM) - ! ENDDO - ! WRITE(LU_DB_SETCC,*) 'ICF,BOD_TRI:' - ! WRITE(LU_DB_SETCC,*) ICF,NBODTRI - ! DO IDUM=1,NBODTRI - ! WRITE(LU_DB_SETCC,*) BOD_TRI(1:2,IDUM) - ! ENDDO - ! WRITE(LU_DB_SETCC,*) 'CFELEM:' - ! DO IDUM=1,CF%NFACE - ! WRITE(LU_DB_SETCC,*) IDUM,CF%CFELEM(1:CF%CFELEM(1,IDUM)+1,IDUM) - ! ENDDO - ! CLOSE(LU_DB_SETCC) - ! ENDIF + ALLOCATE(G%TFACES(6*N_FACES),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%TFACES',IZERO) + G%TFACES(1:6*N_FACES) = TFACES(1:6*N_FACES) - ! IF(.NOT.CYCLE_CELL) THEN - ! DO ICF = 1, CF%NFACE - ! DO ISEG=1,CF%CEDGES(1,ICF) - ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) - ! IF (ISEGGEOMEPS) THEN - ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT - ! ENDIF - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN - ! WRITE(LU_ERR,*) 'CARTC Found difference in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC,CYCLE_CELL - ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) - ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) - ! ENDIF - ! END SELECT - ! ENDDO - ! ENDDO - ! ENDIF - ! WRITE(LU_ERR,*) 'CORRECT CELL I,J,K CUT_FACES',I,J,K,CF%NFACE,NSEG,RH_ORIENTED - ! DO ICF = 1, CF%NFACE - ! WRITE(LU_ERR,*) CF%CEDGES(1:CF%CEDGES(1,ICF)+1,ICF),':',CF%CFELEM(2:CF%CFELEM(1,ICF)+1,ICF) - ! ITRI = CF%EDGE_LIST(2,CF%CEDGES(2,ICF)); IBOD = CF%EDGE_LIST(3,CF%CEDGES(2,ICF)) - ! WRITE(LU_ERR,*) 'E1 N1=',MESHES(NM)%CUT_EDGE(ITRI)%XYZVERT(:,MESHES(NM)%CUT_EDGE(ITRI)%CEELEM(1,IBOD)),& - ! CF%XYZVERT(:,CF%CFELEM(2,ICF)) - ! ITRI = CF%EDGE_LIST(2,CF%CEDGES(2,ICF)); IBOD = CF%EDGE_LIST(3,CF%CEDGES(2,ICF)) - ! WRITE(LU_ERR,*) 'E1 N2=',MESHES(NM)%CUT_EDGE(ITRI)%XYZVERT(:,MESHES(NM)%CUT_EDGE(ITRI)%CEELEM(2,IBOD)),& - ! CF%XYZVERT(:,CF%CFELEM(3,ICF)) - ! ENDDO - ! DO ICF = 1, NSEG - ! WRITE(LU_ERR,*) ICF,CF%EDGE_LIST(1:3,ICF) - ! ENDDO + ALLOCATE(G%SURFS(N_FACES),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%SURFS',IZERO) - ! Here if CFACES could not be built, flag the cell as SPECIAL & reduce NCUTFACE by one: - IF (CYCLE_CELL) THEN - CELLRT(I,J,K) =.TRUE. - IJK_COUNTED(I,J,K)=.FALSE. - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED; - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = 0 ! No axis = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_UNDEFINED - CALL FACE_DEALLOC(NM,NCUTFACE) - ! This is a cut-face, allocate space: - NCUTFACE = NCUTFACE-1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH - 1 - ENDIF - ! Now cleanup CUT_EDGES that live on this cell: This space will be used later when trying to linearize the - ! surface. - CEI=MESHES(NM)%CCVAR(I,J,K,CC_IDCE); - IF ( CEI > 0 ) THEN - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - MESHES(NM)%CUT_EDGE(CEI)%INDSEG = 0 - ENDIF - ENDIF + PER_FACE_IF: IF (SURF_INDEX_PER_FACE) THEN + DO I=1,N_FACES + IF ( SURFS(I) <= 0 ) THEN + G%SURFS(I) = DEFAULT_SURF_INDEX ! If local SURF ID index <= 0, use default surf ID. + ELSE + G%SURFS(I) = SURF_ID_IND(SURFS(I)) + ENDIF + ENDDO + DEALLOCATE(SURF_ID_IND) + ELSE + G%SURFS(1:N_FACES) = DEFAULT_SURF_INDEX + BOX_TYPE_IF: IF ( GEOM_TYPE==BOX_GEOM_TYPE .AND. & + (SURF_ID(1)/='null' .OR. ALL(SURF_IDS/='null') .OR. ALL(SURF_ID6/='null')) )THEN + ! This loop allows GEOM to behave similarly to OBST + FACE_LOOP: DO I=1,N_FACES + II1=G%FACES(3*(I-1)+1) + II2=G%FACES(3*(I-1)+2) + II3=G%FACES(3*(I-1)+3) + DV1(IAXIS:KAXIS)= VERTS(3*II2-2:3*II2) - VERTS(3*II1-2:3*II1) + DV2(IAXIS:KAXIS)= VERTS(3*II3-2:3*II3) - VERTS(3*II1-2:3*II1) + CALL CROSS_PRODUCT(NVECI,DV1,DV2) + SURF_LOOP: DO NNN=0,N_SURF + IF (SURF_ID(1)==SURFACE(NNN)%ID .AND. ANY(ABS(NVECI(:))>TWENTY_EPSILON_EB)) G%SURFS(I) = NNN ! all sides + IF (SURF_IDS(2)==SURFACE(NNN)%ID .AND. (ABS(NVECI(1))>TWENTY_EPSILON_EB .OR. ABS(NVECI(2))>TWENTY_EPSILON_EB) ) & + G%SURFS(I) = NNN ! sides + IF (SURF_IDS(1)==SURFACE(NNN)%ID .AND. NVECI(3)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! top + IF (SURF_IDS(3)==SURFACE(NNN)%ID .AND. NVECI(3)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! bottom + IF (SURF_ID6(1)==SURFACE(NNN)%ID .AND. NVECI(1)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! X1 + IF (SURF_ID6(2)==SURFACE(NNN)%ID .AND. NVECI(1)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! X2 + IF (SURF_ID6(3)==SURFACE(NNN)%ID .AND. NVECI(2)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Y1 + IF (SURF_ID6(4)==SURFACE(NNN)%ID .AND. NVECI(2)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Y2 + IF (SURF_ID6(5)==SURFACE(NNN)%ID .AND. NVECI(3)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Z1 + IF (SURF_ID6(6)==SURFACE(NNN)%ID .AND. NVECI(3)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Z2 + ENDDO SURF_LOOP + ENDDO FACE_LOOP + ENDIF BOX_TYPE_IF + ENDIF PER_FACE_IF + + ! Test for Unsupported surfaces: + DO I=1,N_FACES + ! HERE do tests on surfaces, is not supported by GEOMs throw error: + UNSUPPORTED_SURF_FIELD : IF(SURFACE(G%SURFS(I))%BURN_AWAY) THEN + WRITE(MESSAGE,'(5A)') 'ERROR(720): GEOM: ',TRIM(ID),& + ', has currently unsupported BURN_AWAY feature in surface : ',TRIM(SURFACE(G%SURFS(I))%ID),'.' + CALL SHUTDOWN(MESSAGE) + RETURN + ENDIF UNSUPPORTED_SURF_FIELD + ! Others.. + ENDDO + + ENDIF N_FACES_IF - ENDDO ! I - ENDDO ! J -ENDDO ! K + IF (N_VERTS>0) THEN + ALLOCATE(G%VERTS_BASE(3*N_VERTS),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%VERTS_BASE',IZERO) + G%VERTS_BASE(1:3*N_VERTS) = VERTS(1:3*N_VERTS) -! Now process special cells of type CELLRT=T: -! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: -DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI + ALLOCATE(G%VERTS(3*N_VERTS),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%VERTS',IZERO) + ENDIF - IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE + G%MOVE_ID = MOVE_ID + G%IS_DYNAMIC = .FALSE. - IF (.NOT.CELLRT(I,J,K)) CYCLE ! Special cell with bod-bod or self intersection. + ! Prevent drawing of boundary info if desired - IF (IJK_COUNTED(I,J,K)) CYCLE; IJK_COUNTED(I,J,K)=.TRUE. + G%SHOW_BNDF = BNDF_GEOM - ! Start cut-cell INB cut-faces computation: - ! Loop local arrays to cell: - NSEG = 0 - SEG_CELL = CC_UNDEFINED + ! Case of false READ_BINARY, Process 0 writes a binary file with the geom: + IF(MY_RANK == 0 .AND. .NOT.READ_BINARY) THEN + WRITE(FN_BINGEOM,'(A,A,A,A,A)') './',TRIM(BINGEOM_DIR)//TRIM(CHID),'_',TRIM(ID),'.bingeom' + OPEN(UNIT=LU_BINGEOM,FILE=TRIM(FN_BINGEOM),STATUS='UNKNOWN',ACTION='WRITE',FORM='UNFORMATTED') + WRITE(LU_BINGEOM) GEOM_TYPE + IF (GEOM_TYPE==TERRAIN_GEOM_TYPE) THEN + WRITE(LU_BINGEOM) N_VERTS_ORIG,N_FACES_ORIG,N_SURF_ID,N_VOLUS_ORIG + WRITE(LU_BINGEOM) VERTS(1:3*N_VERTS_ORIG) + WRITE(LU_BINGEOM) FACES(1:3*N_FACES_ORIG) + WRITE(LU_BINGEOM) SURFS(1:N_FACES_ORIG) + WRITE(LU_BINGEOM) VOLUS(1:4*N_VOLUS_ORIG) + ELSE + WRITE(LU_BINGEOM) N_VERTS,N_FACES,N_SURF_ID,N_VOLUS + WRITE(LU_BINGEOM) VERTS(1:3*N_VERTS) + WRITE(LU_BINGEOM) FACES(1:3*N_FACES) + WRITE(LU_BINGEOM) SURFS(1:N_FACES) + WRITE(LU_BINGEOM) VOLUS(1:4*N_VOLUS) + ENDIF + CLOSE(LU_BINGEOM) + ENDIF - NVERT = 0 - NFACE = 0 - XYZVERT = 0._EB +ENDDO READ_GEOM_LOOP +35 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 - ! CUT_EDGE index of bounding Cartesian faces: - CEIB_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCE,IAXIS) - CEIB_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCE,IAXIS) - CEIB_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCE,JAXIS) - CEIB_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCE,JAXIS) - CEIB_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCE,KAXIS) - CEIB_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCE,KAXIS) +CALL CONVERTGEOM(T_BEGIN) - ! Cartesian Faces INBOUNDARY segments: - DO FAXIS=IAXIS,KAXIS - DO ILH=LOW_IND,HIGH_IND - ! By segment: Add Vertices/Segments to local arrays: - CEI = CEIB_XYZ(ILH,FAXIS) - IF ( CEI > 0 ) THEN ! There are inboundary cut-edges - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 - DO IEDGE=1,NEDGE +DO IG = 1, N_GEOMETRY - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - STRI(1:CC_MAX_WSTRIANG_SEG+2) = & - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) + G=>GEOMETRY(IG) - ! x,y,z of node 1: - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD1,XYZVERT) - ! x,y,z of node 2: - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD2,XYZVERT) + ! Define box containing Geometry: + DO X1AXIS=IAXIS,KAXIS + G%GEOM_BOX( LOW_IND,X1AXIS) = 1._EB/GEOMEPS ! Initialize min location in X1AXIS dir to large (+) number. + G%GEOM_BOX(HIGH_IND,X1AXIS) =-1._EB/GEOMEPS ! Initialize max location in X1AXIS dir to large (-) number. + DO IVERT=1,G%N_VERTS + G%GEOM_BOX( LOW_IND,X1AXIS) = MIN(G%GEOM_BOX( LOW_IND,X1AXIS),G%VERTS(MAX_DIM*(IVERT-1)+X1AXIS)) + G%GEOM_BOX(HIGH_IND,X1AXIS) = MAX(G%GEOM_BOX(HIGH_IND,X1AXIS),G%VERTS(MAX_DIM*(IVERT-1)+X1AXIS)) + ENDDO + ENDDO - VEC(NOD1:NOD2) = (HIGH_IND-ILH)*(/ INOD1, INOD2 /) + (ILH-LOW_IND)*(/ INOD2, INOD1 /) - VEC(NOD2+1:NOD2+CC_MAX_WSTRIANG_SEG+2) = STRI(1:CC_MAX_WSTRIANG_SEG+2) - VEC(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7) = (/ CC_ETYPE_CFINB, CEI, IEDGE /) - ! Insertion ADD segment: - INLIST = .FALSE. - DO IDUM = 1,NSEG - DO IEQ1=1,3 - EQUAL1 = SEG_CELL(INDVERTBOD(IEQ1),IDUM) == VEC(INDVERTBOD(IEQ1)) - IF (.NOT.EQUAL1) EXIT - ENDDO - DO IEQ2=1,3 - EQUAL2 = SEG_CELL(INDVERTBOD(IEQ2),IDUM) == VEC(INDVERTBOD2(IEQ2)) - IF (.NOT.EQUAL2) EXIT - ENDDO - IF ( EQUAL1 .OR. EQUAL2 ) THEN - IF ( SEG_CELL(3,IDUM) > VEC(3) ) THEN - ! DO NOTHING: - ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN - SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 - SEG_CELL(5,IDUM) = VEC(4) - ENDIF - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - NSEG = NSEG + 1 - CALL REALLOCATE_SEG_CELL - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - SEG_POS(NSEG) = (2*ILH-3)*FAXIS - ENDIF - ENDDO - ENDIF - ENDDO - ENDDO + ! Check for duct nodes - ! Drop segments that are unconnected: - ALLOCATE(VERT_SEGS(1:NVERT)); VERT_SEGS(1:NVERT)=0 - DO IDUM = 1,NSEG - VERT_SEGS(SEG_CELL(NOD1,IDUM)) = VERT_SEGS(SEG_CELL(NOD1,IDUM)) + 1 - VERT_SEGS(SEG_CELL(NOD2,IDUM)) = VERT_SEGS(SEG_CELL(NOD2,IDUM)) + 1 - ENDDO - ALLOCATE(SEG_CELL_AUX(SIZE(SEG_CELL,DIM=1),SIZE(SEG_CELL,DIM=2))) - SEG_CELL_AUX = SEG_CELL - COUNT = 0 - DO IDUM = 1,NSEG - IF ( SEG_CELL_AUX(NOD1,IDUM)==SEG_CELL_AUX(NOD2,IDUM) ) CYCLE - IF ( (VERT_SEGS(SEG_CELL_AUX(NOD1,IDUM))>1) .AND. (VERT_SEGS(SEG_CELL_AUX(NOD2,IDUM))>1) ) THEN - COUNT = COUNT + 1 - SEG_CELL(:,COUNT) = SEG_CELL_AUX(:,IDUM) - CYCLE - ENDIF - ENDDO - NSEG = COUNT - DEALLOCATE(SEG_CELL_AUX,VERT_SEGS) + DO J = 1,G%N_FACES + IF (SURFACE(G%SURFS(J))%NODE_ID/='null') THEN + G%HAVE_NODE = .TRUE. + EXIT + ENDIF + ENDDO - IF (NSEG < 3 ) CYCLE +ENDDO - ! IF(NM==1 .AND. I==37 .AND. J==6 .AND. K==32) THEN - ! LU_DB_SETCC = GET_FILE_NUMBER() - ! WRITE(LU_ERR,*) 'Writing Cartcell_SEGCELL.dat...' - ! OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_SEGCELL.dat", STATUS='REPLACE') - ! ! Info pertaining to the Cartesian Cell: - ! WRITE(LU_DB_SETCC,*) 'I,J,K:',CF%NFACE - ! WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS - ! WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' - ! WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) - ! WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) - ! WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) - ! WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,SIZE_CEELEM_SEG_CELL,CC_MAX_WSTRIANG_SEG:' - ! WRITE(LU_DB_SETCC,*) NVERT,NSEG,SIZE_CEELEM_SEG_CELL,CC_MAX_WSTRIANG_SEG - ! WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' - ! DO IDUM=1,NVERT - ! WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) - ! ENDDO - ! WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' - ! DO IDUM=1,NSEG - ! WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM),SEG_POS(IDUM) - ! ENDDO - ! CLOSE(LU_DB_SETCC) - ! ENDIF +IF(ALLOCATED(VOLUS)) DEALLOCATE(VOLUS) +IF(ALLOCATED(FACES)) DEALLOCATE(FACES) +IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) +IF(ALLOCATED(VERTS)) DEALLOCATE(VERTS) +IF(ALLOCATED(ZVALS)) DEALLOCATE(ZVALS) +IF(ALLOCATED(TFACES))DEALLOCATE(TFACES) +DEALLOCATE(GEOM_LINE) - ! Ear clipping algorithm by TRIANGLE and BODY: - ! 1. Define closed 3D polyline: - CALL GET_CLOSED_POLYLINES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,SEG_POS,IFLG,NPOLY,ILO_POLY,NSG_POLY) +IF( (T_END-T_BEGIN) < TWENTY_EPSILON_EB) RETURN - IF (IFLG) THEN - IF(DEBUG_SET_CUTCELLS .AND. MY_RANK==PROCESS(NM)) WRITE(LU_ERR,*) 'IFLG ~=0, could not close polyline, ',& - BNDINT_FLAG,': ',NM,I,J,K,' NPOLY=',NPOLY,IFLG,'NSEG=',NSEG - MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 - NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) - IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN - ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) - DEALLOCATE(MESHES(NM)%SPCELL_LIST) - ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED - DEALLOCATE(SPCELL_LIST) - ENDIF - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) - ! Add to cells to block list: - N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK + 1 - COUNT = SIZE(SPCELLS_TO_BLOCK,DIM=1) - IF( COUNT MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - ALLOCATE(CF%EDGE_LIST(3,CT_EDGES),CF%CEDGES(NOD3+1,NFACE)); CF%CEDGES = CC_UNDEFINED - CF%EDGE_LIST(1:3,1:CT_EDGES) = SEG_CELL_AUX(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7,1:CT_EDGES) +SUBROUTINE DEFINE_EXTRUDED_POLY(MAX_VERTS,N_VERTS,VERTS,MAX_POLY_VERTS,N_POLY_VERTS,POLY,& + EXTRUDE,MAX_FACES,N_FACES,START_FACE_LO,START_FACE_HI,START_FACE_MID,FACES,IERR) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +INTEGER, INTENT(IN) :: MAX_VERTS, MAX_POLY_VERTS, N_POLY_VERTS, POLY(MAX_POLY_VERTS), MAX_FACES +REAL(EB),INTENT(IN) :: EXTRUDE +INTEGER, INTENT(INOUT) :: N_VERTS +REAL(EB),INTENT(INOUT) :: VERTS(3*MAX_VERTS) +INTEGER, INTENT(OUT) :: N_FACES,START_FACE_LO,START_FACE_HI,START_FACE_MID,FACES(4*MAX_FACES),IERR + +! Local Variables: +REAL(EB), ALLOCATABLE, DIMENSION(:) :: PVERTS,PVERTS2 +REAL(EB):: XYZCEN(IAXIS:KAXIS), NVEC(IAXIS:KAXIS), DV1(IAXIS:KAXIS), DV2(IAXIS:KAXIS), N(IAXIS:KAXIS), SINANG +LOGICAL :: IS_CONVEX, VERT_DROPPED, NOPT_INTRI +INTEGER :: IM1, IP1, NVERTS2, V0, V1, V2, COUNT, COUNT_OUT, NLIST, NLIST_OLD, VERT_START, IVERT, IVM1, IV, IVP1, & + I1, I2, I3, I4, IDUM, IFACE, JP1, JEND, INT_FLG +INTEGER, ALLOCATABLE, DIMENSION(:) :: NODE_FLG, VERT_LIST +LOGICAL, ALLOCATABLE, DIMENSION(:) :: NODE_EXISTS +REAL(EB):: BBLEN, THLEN, MINMAX_POS(LOW_IND:HIGH_IND,IAXIS:KAXIS), P1(IAXIS:JAXIS), D1(IAXIS:JAXIS), & + P2(IAXIS:JAXIS), D2(IAXIS:JAXIS), SVEC(IAXIS:KAXIS), PVEC(IAXIS:KAXIS), SVARV(NOD1:NOD2,EDG1:EDG2), SLENV(EDG1:EDG2) + +IERR = 1 - ! Assign surf-index: Depending on GEOMETRY: - NCF = 0 - DO ICF=1,NFACE - IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) +! Define PVERTS: +ALLOCATE(PVERTS(1:2*MAX_DIM*N_POLY_VERTS)); PVERTS=0._EB +MINMAX_POS( LOW_IND,IAXIS:KAXIS) = 1._EB/GEOMEPS +MINMAX_POS(HIGH_IND,IAXIS:KAXIS) =-1._EB/GEOMEPS +DO I=1,N_POLY_VERTS + PVERTS(3*I-2:3*I) = VERTS(3*POLY(I)-2:3*POLY(I)) + MINMAX_POS( LOW_IND,IAXIS) = MIN(MINMAX_POS( LOW_IND,IAXIS),PVERTS(3*I-2)) + MINMAX_POS( LOW_IND,JAXIS) = MIN(MINMAX_POS( LOW_IND,JAXIS),PVERTS(3*I-1)) + MINMAX_POS( LOW_IND,KAXIS) = MIN(MINMAX_POS( LOW_IND,KAXIS),PVERTS(3*I )) + MINMAX_POS(HIGH_IND,IAXIS) = MAX(MINMAX_POS(HIGH_IND,IAXIS),PVERTS(3*I-2)) + MINMAX_POS(HIGH_IND,JAXIS) = MAX(MINMAX_POS(HIGH_IND,JAXIS),PVERTS(3*I-1)) + MINMAX_POS(HIGH_IND,KAXIS) = MAX(MINMAX_POS(HIGH_IND,KAXIS),PVERTS(3*I )) +ENDDO +PVERTS(3*(N_POLY_VERTS+1)-2:3*(N_POLY_VERTS+1)) = PVERTS(1:3) +! Define average normal: +XYZCEN(IAXIS:KAXIS)=0._EB +DO I=1,N_POLY_VERTS + XYZCEN(IAXIS:KAXIS) = XYZCEN(IAXIS:KAXIS) + PVERTS(3*I-2:3*I) +ENDDO +XYZCEN = XYZCEN / REAL(N_POLY_VERTS,EB) +! Define an area averaged normal vector (note: this might need to change to average normal to the set of points in a +! least squares sense, i.e. eigenvector associated with smallest eigenvalue of the covariance matrix of vertices positions +! respect to XYZCEN): +NVEC(IAXIS:KAXIS)=0._EB +DO I=1,N_POLY_VERTS + DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - XYZCEN(IAXIS:KAXIS) + DV2(IAXIS:KAXIS) = PVERTS(3*I+1:3*(I+1)) - XYZCEN(IAXIS:KAXIS) + CALL CROSS_PRODUCT(N,DV1,DV2) + NVEC(IAXIS:KAXIS) = NVEC(IAXIS:KAXIS) + N(IAXIS:KAXIS) +ENDDO +IF(NORM2(NVEC) > TWENTY_EPSILON_EB) NVEC=NVEC/NORM2(NVEC) - ! Area properties for special cfaces: - ! Computed from the cross product: - D23 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - D12 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) - CALL CROSS_PRODUCT(NORMTRI,D12,D23) - ! Test RH rule for CFACE normal outside of body (into gas phase): - RH_ORIENTED = ( GEOMETRY(IBOD)%FACES_NORMAL(IAXIS,ITRI)*NORMTRI(IAXIS) + & - GEOMETRY(IBOD)%FACES_NORMAL(JAXIS,ITRI)*NORMTRI(JAXIS) + & - GEOMETRY(IBOD)%FACES_NORMAL(KAXIS,ITRI)*NORMTRI(KAXIS) ) > -TWENTY_EPSILON_EB - IF(.NOT.RH_ORIENTED) THEN ! Swap normal for triangle: - IDUM = CFELEM(1+NOD2,ICF); CFELEM(1+NOD2,ICF) = CFELEM(1+NOD1,ICF); CFELEM(1+NOD1,ICF) = IDUM - D23 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - D12 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) - CALL CROSS_PRODUCT(NORMTRI,D12,D23) - ENDIF - NNORM = NORM2(NORMTRI) - IF (NNORM < 2._EB*GEOMEPS**2._EB) CYCLE - NORMTRI(IAXIS:KAXIS) = NORMTRI(IAXIS:KAXIS) / NNORM +! Test all segments are in plane normal to NVEC, tolerance for distance to plane given by XYZCEN, NVEC is +! 5% of the bounding box diagonal for the polygon: +BBLEN = SQRT( (MINMAX_POS(HIGH_IND,IAXIS)-MINMAX_POS( LOW_IND,IAXIS))**2._EB + & + (MINMAX_POS(HIGH_IND,JAXIS)-MINMAX_POS( LOW_IND,JAXIS))**2._EB + & + (MINMAX_POS(HIGH_IND,KAXIS)-MINMAX_POS( LOW_IND,KAXIS))**2._EB ) +THLEN = 0.05_EB * BBLEN ! Threshold distance to polygon average plane. +DO I=1,N_POLY_VERTS + DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - XYZCEN(IAXIS:KAXIS) + IF (ABS(DOT_PRODUCT(DV1,NVEC)) > THLEN) THEN + WRITE(MESSAGE,'(A,A,A,I3,A)') 'ERROR(721): For extruded Polygon GEOM ',TRIM(ID),& + ' : Node (',POLY(I),') not in the plane of the polygon. Check VERTS.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF +ENDDO - ! First test if INB face is on Cartesian face and pointing - ! outside of Cartesian cell. If so drop: - ! Face Vertices average location: - ACEN(IAXIS:KAXIS) = 1._EB/3._EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + & - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) - ! IAXIS: - IF ( (ABS(NORMTRI(IAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(XFACE(I-1)-ACEN(IAXIS)) < GEOMEPS) ) CYCLE ! Low Face - IF ( (ABS(NORMTRI(IAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(XFACE(I )-ACEN(IAXIS)) < GEOMEPS) ) CYCLE ! High Face - ! JAXIS: - IF ( (ABS(NORMTRI(JAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(YFACE(J-1)-ACEN(JAXIS)) < GEOMEPS) ) CYCLE ! Low Face - IF ( (ABS(NORMTRI(JAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(YFACE(J )-ACEN(JAXIS)) < GEOMEPS) ) CYCLE ! High Face - ! KAXIS: - IF ( (ABS(NORMTRI(KAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(ZFACE(K-1)-ACEN(KAXIS)) < GEOMEPS) ) CYCLE ! Low Face - IF ( (ABS(NORMTRI(KAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(ZFACE(K )-ACEN(KAXIS)) < GEOMEPS) ) CYCLE ! High Face +! Here project all points to average plane. Do seg-seg intersection tests: +DO I=1,N_POLY_VERTS + DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I)-XYZCEN(IAXIS:KAXIS) + DV2(IAXIS:KAXIS) = DV1(IAXIS:KAXIS) - DOT_PRODUCT(DV1,NVEC) * NVEC(IAXIS:KAXIS) + PVERTS(3*(I+N_POLY_VERTS)-2:3*(I+N_POLY_VERTS)) = XYZCEN(IAXIS:KAXIS) + DV2(IAXIS:KAXIS) +ENDDO +! Define local coordinate system SVEC,PVEC,NVEC: +IF(ABS(NVEC(IAXIS))>TWENTY_EPSILON_EB .OR. ABS(NVEC(JAXIS))>TWENTY_EPSILON_EB) PVEC(IAXIS:KAXIS)=(/NVEC(JAXIS),-NVEC(IAXIS),0._EB/) +IF(ABS(NVEC(IAXIS))0) THEN + WRITE(MESSAGE,'(A,I3,A,I3,A,I3,A,I3,A)') 'ERROR(722): Segments (',POLY(I-N_POLY_VERTS),'-',POLY(IP1-N_POLY_VERTS),& + ') and (',POLY(J-N_POLY_VERTS),'-',POLY(JP1-N_POLY_VERTS),') intersect in average POLY plane.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO +ENDDO - ! Area: - AREA = 0.5_EB*NNORM - ! dot(i,nc) int(x)dA - INXAREA = NORMTRI(IAXIS)*ACEN(IAXIS)*AREA ! Single Gauss pt integration. +IS_CONVEX=.TRUE. +ALLOCATE(NODE_FLG(1:N_POLY_VERTS+1)); NODE_FLG=1 +DO I=1,N_POLY_VERTS + IM1 = I - 1 + IF (I==1) IM1=N_POLY_VERTS + IP1 = I + 1 + IF (I==N_POLY_VERTS) IP1=1 + DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - PVERTS(3*IM1-2:3*IM1 ); DV1=DV1/NORM2(DV1) + DV2(IAXIS:KAXIS) = PVERTS(3*IP1-2:3*IP1) - PVERTS(3*I-2:3*I ); DV2=DV2/NORM2(DV2) + CALL CROSS_PRODUCT(N,DV1,DV2) + SINANG = NORM2(N) + IF ( DOT_PRODUCT(NVEC,N) < -GEOMEPS ) IS_CONVEX=.FALSE. + IF ( SINANG < GEOMEPS ) NODE_FLG(I)= 0 ! Vertex located in line joining neighbors. +ENDDO - XC1(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + & - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) ! X23 - XC2(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) - X12(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF))) - ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA - SQAREA(IAXIS:KAXIS) = 0._EB - DO IX=IAXIS,KAXIS - INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB - SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREA ! Midpoint rule. - ENDDO +NVERTS2 = SUM(NODE_FLG(1:N_POLY_VERTS)); +IF (NVERTS2 < 3) THEN + WRITE(MESSAGE,'(A,A,A)') 'ERROR(723): For extruded Polygon GEOM ',TRIM(ID),' : Not enough valid vertices on the polygon.' + CALL SHUTDOWN(MESSAGE); RETURN +ENDIF +ALLOCATE(PVERTS2(1:2*MAX_DIM*N_POLY_VERTS)); PVERTS2=0._EB +ALLOCATE(VERT_LIST(NVERTS2+1)); VERT_LIST=0 +ALLOCATE(NODE_EXISTS(NVERTS2+1)); NODE_EXISTS=.TRUE. +COUNT = 0 +DO I=1,N_POLY_VERTS + IF (NODE_FLG(I)==0) CYCLE + COUNT= COUNT + 1 + PVERTS2(3*COUNT-2:3*COUNT) = PVERTS(3*I-2:3*I) + VERT_LIST(COUNT) = COUNT +ENDDO +PVERTS(1:3*NVERTS2) = PVERTS2(1:3*NVERTS2) +VERT_LIST(NVERTS2+1) = VERT_LIST(1) +DEALLOCATE(PVERTS2) - NCF = NCF + 1 - CF%AREA(NCF) = AREA - CF%XYZCEN(IAXIS:KAXIS,NCF) = ACEN(IAXIS:KAXIS) - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA: - CF%INXAREA(NCF) = INXAREA - ! dot(i,nc)*int(x^2)dA: - CF%INXSQAREA(NCF) = SQAREA(IAXIS) - ! dot(j,nc)*int(y^2)dA: - CF%JNYSQAREA(NCF) = SQAREA(JAXIS) - ! dot(k,nc)*int(z^2)dA: - CF%KNZSQAREA(NCF) = SQAREA(KAXIS) +! Now do the Ear clip: +N_FACES = 0 +START_FACE_LO = N_FACES +IS_CONVEX_IF : IF (IS_CONVEX) THEN ! Convex POLY. + VERT_START = VERT_LIST(1) + DO I = 1,NVERTS2 + IP1 = I+1; IF (I==NVERTS2) IP1=1 + IF (I==VERT_START .OR. IP1==VERT_START) CYCLE + N_FACES = N_FACES + 1 + FACES(3*N_FACES-2) = VERT_LIST(VERT_START) + FACES(3*N_FACES-1) = VERT_LIST(I) + FACES(3*N_FACES ) = VERT_LIST(IP1) + ENDDO +ELSE IS_CONVEX_IF ! Simple polygon, ear clipping. + NLIST = NVERTS2 + COUNT_OUT = 0 + OUTER_LOOP : DO WHILE(NLIST>=3) ! OUTER LOOP + COUNT_OUT = COUNT_OUT + 1 + IF (COUNT_OUT > NVERTS2**4) THEN + WRITE(MESSAGE,'(A,A,A)') 'ERROR(724): For extruded Polygon GEOM ',TRIM(ID),' : Could not triangulate polygon.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + IVERT = 1 + INNER_LOOP : DO WHILE(IVERT<=NLIST) ! INNER LOOP + IVM1 = IVERT-1; IV=IVERT; IVP1=IVERT+1 + IF (IVERT==1) IVM1=NLIST + V0 = VERT_LIST(IVM1); V1 = VERT_LIST(IV ); V2 = VERT_LIST(IVP1); + IF (.NOT.NODE_EXISTS(IVP1)) EXIT INNER_LOOP + DV1(IAXIS:KAXIS) = PVERTS(3*V1-2:3*V1)-PVERTS(3*V0-2:3*V0) + IF (NORM2(DV1)GEOMEPS + IF (NOPT_INTRI) THEN + DO I=1,NVERTS2 + IF(ANY( (/V0,V1,V2/) == I)) CYCLE + IF (POINT_IN_TRIANGLE(PVERTS(3*I-2:3*I), PVERTS(3*V0-2:3*V0), PVERTS(3*V1-2:3*V1), PVERTS(3*V2-2:3*V2))) THEN + NOPT_INTRI=.FALSE. + EXIT + ENDIF + ENDDO + ENDIF + IF ( NLIST==3 .OR. NOPT_INTRI ) THEN + N_FACES = N_FACES + 1 + FACES(3*N_FACES-2) = V0 + FACES(3*N_FACES-1) = V1 + FACES(3*N_FACES ) = V2 + IF (NLIST == 3) EXIT OUTER_LOOP + NODE_EXISTS(IVERT) =.FALSE. + IF (IVERT==1) NODE_EXISTS(NLIST+1)=.FALSE. + IVERT = IVERT + 2 + ELSE + IVERT = IVERT + 1 + ENDIF + ENDDO INNER_LOOP + NLIST_OLD = NLIST + NLIST = 0 + DO I = 1,NLIST_OLD + IF (NODE_EXISTS(I)) THEN + NLIST = NLIST + 1 + VERT_LIST(NLIST) = VERT_LIST(I) + ENDIF + ENDDO + VERT_LIST(NLIST+1) = VERT_LIST(1) + NODE_EXISTS(1:NLIST+1) =.TRUE. - ! Define Body-triangle reference: - CF%BODTRI(1:2,NCF)= (/ IBOD, ITRI /) + ! Test for nodes connecting parallel edges, if found drop them: + VERT_DROPPED=.FALSE. + DO I=1,NLIST + IVM1 = I-1; IV=I; IVP1=I+1; IF (I==1) IVM1=NLIST + V0 = VERT_LIST(IVM1); V1 = VERT_LIST(IV ); V2 = VERT_LIST(IVP1) + DV1(IAXIS:KAXIS) = PVERTS(3*V1-2:3*V1)-PVERTS(3*V0-2:3*V0) + IF (NORM2(DV1) 0 ) THEN - CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCE) - ELSE ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%CCVAR(I,J,K,CC_IDCE) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ I, J, K, 0, CC_GS /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCC - ENDIF +DEALLOCATE(PVERTS,NODE_FLG,VERT_LIST,NODE_EXISTS) - ! Add vertices, non repeated vertex entries at this point. - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - ! Define vertices for this segment: - CALL INSERT_FACE_VERT(X1V,NM,CEI,NVERT,INOD1) - CALL INSERT_FACE_VERT(X2V,NM,CEI,NVERT,INOD2) - DO JEC=1,MESHES(NM)%CUT_EDGE(CEI)%NEDGE - IEQ1 = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,JEC) - IEQ2 = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,JEC) - IF((IEQ1==INOD1 .AND. IEQ2==INOD2) .OR. (IEQ1==INOD2 .AND. IEQ2==INOD1)) THEN ! SEG NODES found - EXIT - ENDIF - ENDDO - IF(JEC > MESHES(NM)%CUT_EDGE(CEI)%NEDGE) THEN ! JEC can be NEDGE+1, new cut-edge. - NEDGE = JEC; CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE) = (/ INOD1, INOD2 /) - ENDIF - CF%EDGE_LIST(1:3,IEDGE) = (/CC_ETYPE_CFINB, CEI, JEC /) +IERR = 0 - NCF = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) - IF (NCF==0) THEN - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) = NCF+1 - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(2,JEC) = ITRI - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,JEC) = IBOD - ELSEIF(NCF==1) THEN - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) = NCF+1 - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(3,JEC) = ITRI - ENDIF - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE +RETURN - ENDIF - ENDDO - ENDDO +END SUBROUTINE DEFINE_EXTRUDED_POLY - ! DO ICF = 1, CF%NFACE - ! IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) - ! DO ISEG=1,CF%CEDGES(1,ICF) - ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) - ! IF (ISEGGEOMEPS) THEN - ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT - ! ENDIF - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN - ! WRITE(LU_ERR,*) 'CARTC CYC CELL Found diff in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC,CYCLE_CELL - ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) - ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) - ! ENDIF - ! ENDDO - ! ENDDO - ! WRITE(LU_ERR,*) 'ERR CELL I,J,K CUT_FACES',I,J,K,CF%NFACE,CT_EDGES - ! DO ICF = 1, CF%NFACE - ! WRITE(LU_ERR,*) CF%CEDGES(1:4,ICF),':',CF%CFELEM(2:4,ICF) - ! ENDDO - ! DO ICF = 1, CT_EDGES - ! WRITE(LU_ERR,*) ICF,CF%EDGE_LIST(1:3,ICF) - ! ENDDO - ENDDO ! I - ENDDO ! J -ENDDO ! K -IF (.NOT.BNDINT_FLAG) DEALLOCATE(IJK_COUNTED,IJK_COUNTF) -DEALLOCATE(SEG_CELL,SEG_POS) +SUBROUTINE DEFINE_CYLINDER(VERTS,MAXVERTS,NVERTS,FACES,MAXFACES,NFACES,VOLS,MAXVOLS,NVOLS,CYL_FIND) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW +INTEGER, INTENT(IN) :: MAXVERTS,MAXFACES,MAXVOLS +INTEGER, INTENT(OUT) :: NFACES, NVERTS +REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) +INTEGER, INTENT(OUT) :: FACES(4*MAXFACES) +INTEGER, INTENT(OUT) :: NVOLS +INTEGER, INTENT(OUT) :: VOLS(4*MAXVOLS) +INTEGER, INTENT(OUT) :: CYL_FIND(LOW_IND:HIGH_IND,1:3) -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - NCUTFCE = 0 - IF (BNDINT_FLAG) THEN - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) CYCLE - NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE - ENDDO - ELSE - DO ICF=MESHES(NM)%N_CUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) CYCLE - NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE - ENDDO - ENDIF - WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-faces : ',NCUTFCE,'. ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-faces : ',NCUTFCE,'. ' - ENDIF -ENDIF +! Local Variables: +REAL(EB), PARAMETER :: EX(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) +REAL(EB) :: E1(IAXIS:KAXIS), E2(IAXIS:KAXIS), E3(IAXIS:KAXIS), TGL(3,3), V(IAXIS:KAXIS,1), R(IAXIS:KAXIS,1) +INTEGER :: NP_L,NP_T,IVERT,IFACE,ILE,ITH,IFC +REAL(EB):: DELTA_L,DELTA_T,THETA,POS_1,POS_2,POS_3, LEN -RETURN -CONTAINS -SUBROUTINE REALLOCATE_SEG_CELL +! Check if CYLINDER axis is any of IAXIS, JAXIS, KAXIS: +IF (ABS(CYLINDER_AXIS(JAXIS)) SIZE_CEELEM_SEG_CELL) THEN - ! First SEG_CELL - ALLOCATE(SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)); SEG_CELL_AUX = CC_UNDEFINED - SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) = & - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) - DEALLOCATE(SEG_CELL); ALLOCATE(SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)) - SEG_CELL(:,:) = SEG_CELL_AUX(:,:) - ! Then SEG_POS: - SEG_CELL_AUX(1,1:SIZE_CEELEM_SEG_CELL) = SEG_POS(1:SIZE_CEELEM_SEG_CELL) - DEALLOCATE(SEG_POS); ALLOCATE(SEG_POS(1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)) - SEG_POS(:) = SEG_CELL_AUX(1,:) - SIZE_CEELEM_SEG_CELL = SIZE_CEELEM_SEG_CELL + DELTA_EDGE - DEALLOCATE(SEG_CELL_AUX) + ! E3 in direction of E1 x E2 + CALL CROSS_PRODUCT(E3,E1,E2) ENDIF -RETURN -END SUBROUTINE REALLOCATE_SEG_CELL - -END SUBROUTINE GET_CARTCELL_CUTFACES - - -! ------------------------ GET_CLOSED_POLYLINES --------------------------------- +! Define transformation matrix from local to global axes: +TGL(IAXIS:KAXIS,IAXIS) = E1(IAXIS:KAXIS) +TGL(IAXIS:KAXIS,JAXIS) = E2(IAXIS:KAXIS) +TGL(IAXIS:KAXIS,KAXIS) = E3(IAXIS:KAXIS) -SUBROUTINE GET_CLOSED_POLYLINES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,SEG_POS,IFLG,NPOLY,ILO_POLY,NSG_POLY) +! Now define cylinder in local axes E1,E2,E3, using CYLINDER_RADIUS and CYLINDER_LENGTH, centered at zero origin: +! Define vertices: +NP_L = CYLINDER_NSEG_AXIS + 1 +NP_T = CYLINDER_NSEG_THETA +DELTA_L = CYLINDER_LENGTH / REAL(CYLINDER_NSEG_AXIS,EB) +DELTA_T = 2._EB*PI / REAL(CYLINDER_NSEG_THETA,EB) +IVERT= 0 -INTEGER, INTENT(IN) :: SIZE_CEELEM_SEG_CELL -INTEGER, INTENT(INOUT) :: NSEG -INTEGER, INTENT(INOUT) :: SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) -INTEGER, INTENT(INOUT) :: SEG_POS(1:SIZE_CEELEM_SEG_CELL) -LOGICAL, INTENT(OUT):: IFLG -INTEGER, INTENT(OUT):: NPOLY,ILO_POLY(1:MAX_CELL_POLYLINES),NSG_POLY(1:MAX_CELL_POLYLINES) +! Low plane center vertex: +POS_1 = -CYLINDER_LENGTH/2._EB +POS_2 = 0._EB; POS_3 = 0._EB; +IVERT = IVERT + 1 +VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) -! Local Variables: -INTEGER :: ISEG, ISEG2, CISEG, MIBOD, NBOD, NEWSEG, SEG_LEFT, ILO, IHI, CT, IBOD, IPOLY, PIVNOD, STNOD, COUNT -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL2 -INTEGER, ALLOCATABLE, DIMENSION(:) :: SEG_POS2, COUNTED, BOD, SEG_POLY, CTBOD -LOGICAL :: FOUNDSEG, FOUND_CHG, INLIST +VERTEX_LOOP : DO ILE=1,NP_L + POS_1 = -CYLINDER_LENGTH/2._EB + REAL(ILE-1,EB)*DELTA_L + DO ITH=1,NP_T -IFLG=.TRUE. -ALLOCATE(SEG_CELL2(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:NSEG),SEG_POS2(1:NSEG),COUNTED(1:NSEG),& - BOD(1:N_GEOMETRY),SEG_POLY(1:NSEG)) -SEG_CELL2 = 0; SEG_POS2 =0; COUNTED = 0; BOD=0 + THETA = REAL(ITH-1,EB)*DELTA_T + POS_2 = CYLINDER_RADIUS*COS(THETA) + POS_3 = CYLINDER_RADIUS*SIN(THETA) -! First collapse segments to most frequent body: -NBOD = 1 -BOD(NBOD) = SEG_CELL(6,1) -DO ISEG=2,NSEG - INLIST =.FALSE. - DO IBOD=1,NBOD - IF (SEG_CELL(6,ISEG) == BOD(IBOD)) THEN - INLIST=.TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - NBOD=NBOD+1 - BOD(NBOD)=SEG_CELL(6,ISEG) - ENDIF -ENDDO -ALLOCATE(CTBOD(1:NBOD)); CTBOD = 0 -DO IBOD=1,NBOD - DO ISEG=1,NSEG - IF (SEG_CELL(6,ISEG) == BOD(IBOD)) CTBOD(IBOD) = CTBOD(IBOD) + 1 - ENDDO -ENDDO -MIBOD=MAXLOC(CTBOD(1:NBOD),DIM=1); DEALLOCATE(CTBOD) + IVERT = IVERT + 1 + VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) -DO ISEG=1,NSEG - IF (COUNTED(ISEG)/=0) CYCLE - CISEG = 0 - DO ISEG2=1,NSEG - IF (COUNTED(ISEG2)/=0) CYCLE - IF ( ISEG2==ISEG ) CYCLE - IF ( (SEG_CELL(NOD1,ISEG)==SEG_CELL(NOD1,ISEG2)) .AND. (SEG_CELL(NOD2,ISEG)==SEG_CELL(NOD2,ISEG2)) ) THEN - IF (SEG_CELL(6,ISEG)==BOD(MIBOD)) THEN - ! ISEG should be COUNTED +1; ISEG2 -1. - COUNTED(ISEG) = 1 - COUNTED(ISEG2)=-1 - CISEG = 1 - ELSE - ! ISEG should be COUNTED -1; ISEG2 +1. - COUNTED(ISEG) =-1 - COUNTED(ISEG2)= 1 - CISEG = 1 - ENDIF - ENDIF ENDDO - IF (CISEG==0) COUNTED(ISEG) = 1 -ENDDO +ENDDO VERTEX_LOOP -NEWSEG = 0 -DO ISEG=1,NSEG - IF (COUNTED(ISEG)/=1) CYCLE - NEWSEG = NEWSEG + 1 - SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) - SEG_POS2(NEWSEG) = SEG_POS(ISEG) -ENDDO -NSEG = NEWSEG -SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:NSEG) = SEG_CELL2(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:NSEG) -SEG_POS(1:NSEG) = SEG_POS2(1:NSEG) +! High plane center vertex: +POS_1 = CYLINDER_LENGTH/2._EB +POS_2 = 0._EB; POS_3 = 0._EB; +IVERT = IVERT + 1 +VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) -! Now make closed polylines: -SEG_CELL2 = 0; SEG_POS2 =0; COUNTED = 0; -NPOLY = 0; ILO_POLY = 0; NSG_POLY = 0; SEG_POLY = 0; ! Polyline number for the segment. -SEG_LEFT = NSEG -DO ! This exterior while loop defined closed polylines in the cell. - ! Count one more polyline: - NPOLY = NPOLY + 1 - IF (NPOLY==1) THEN - ILO_POLY(NPOLY) = 0 +NVERTS = IVERT + +! Define faces: +! Low axis plane: +IFACE=0 +IVERT=1 +CYL_FIND(LOW_IND,3) = IFACE + 1 +DO IFC=1,NP_T + IF (IFC < NP_T) THEN + I1 = 1 + IFC + 1 + I2 = 1 + IFC + I3 = IVERT ELSE - ILO_POLY(NPOLY) = ILO_POLY(NPOLY-1) + NSG_POLY(NPOLY-1) + I1 = IVERT + 1 + I2 = IFC + 1 + I3 = IVERT ENDIF + IFACE=IFACE+1 + FACES(3*IFACE-2:3*IFACE) = (/I1, I2, I3 /) +ENDDO +CYL_FIND(HIGH_IND,3) = IFACE - ! Find first segment of next polyline: - FOUNDSEG = .FALSE. - DO ISEG=1,NSEG - IF (COUNTED(ISEG) == 0) THEN - FOUNDSEG = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.FOUNDSEG) EXIT ! Escape if there are no new segments. +! Cylinder side faces: +CYL_FIND(LOW_IND,2) = IFACE + 1 +FACE_LOOP : DO ILE=2,NP_L + DO IFC=1,NP_T - ! Create new closed polyline: - NEWSEG = ILO_POLY(NPOLY) + 1 - SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) - SEG_POS2(NEWSEG) = SEG_POS(ISEG) - COUNTED(ISEG) = 1 - STNOD = SEG_CELL2(NOD1,NEWSEG) - PIVNOD = SEG_CELL2(NOD2,NEWSEG) ! Pivot Vertex, used to find next segment. - NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 - SEG_POLY(NEWSEG) = NPOLY - SEG_LEFT = SEG_LEFT - 1 - DO NEWSEG = ILO_POLY(NPOLY)+2,NSEG - FOUNDSEG = .FALSE. - DO ISEG=1,NSEG - IF (COUNTED(ISEG) > 0) CYCLE - IF (SEG_CELL(NOD1,ISEG)==PIVNOD) THEN ! Found the next segment - FOUNDSEG = .TRUE. - SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) - SEG_POS2(NEWSEG) = SEG_POS(ISEG) - COUNTED(ISEG) = 1 - PIVNOD = SEG_CELL2(NOD2,NEWSEG); ! Pivot Vertex, used to find next segment. - NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 - SEG_POLY(NEWSEG) = NPOLY; - SEG_LEFT = SEG_LEFT - 1 - EXIT - ELSEIF (SEG_CELL(NOD2,ISEG)==PIVNOD) THEN ! Found the next segment - FOUNDSEG = .TRUE. - SEG_CELL2(:,NEWSEG) = (/ SEG_CELL(NOD2,ISEG), SEG_CELL(NOD1,ISEG), SEG_CELL(3:9,ISEG) /) - SEG_POS2(NEWSEG) = SEG_POS(ISEG) - COUNTED(ISEG) = 1 - PIVNOD = SEG_CELL2(NOD2,NEWSEG) ! Pivot Vertex, used to find next segment. - NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 - SEG_POLY(NEWSEG) = NPOLY - SEG_LEFT = SEG_LEFT - 1 - EXIT - ENDIF - ENDDO - ! Check if for this NEWSEG we didn't find an ISEG: - IF (.NOT.FOUNDSEG) EXIT - ENDDO - ! Finally, test if polyline is closed: - IF ( SEG_CELL2(NOD2,ILO_POLY(NPOLY)+NSG_POLY(NPOLY)) /= STNOD ) RETURN + ! Locate first vertex index: + IF (IFC < NP_T) THEN + I1 = (ILE-1)*NP_T + 1 + IFC + I2 = (ILE-1)*NP_T + 1 + IFC + 1 + I3 = (ILE-2)*NP_T + 1 + IFC + I4 = (ILE-2)*NP_T + 1 + IFC + 1 + ELSE + I1 = (ILE-1)*NP_T + 1 + IFC + I2 = (ILE-1)*NP_T + 1 + 1 + I3 = (ILE-2)*NP_T + 1 + IFC + I4 = (ILE-2)*NP_T + 1 + 1 + ENDIF - ! End of new polyline creation. - ! Here if we have less that 3 segments not counted exit while loop. - IF (SEG_LEFT < 3) EXIT -ENDDO + IFACE=IFACE+1 + FACES(3*IFACE-2:3*IFACE) = (/I1, I3, I2/) + IFACE=IFACE+1 + FACES(3*IFACE-2:3*IFACE) = (/I3, I4, I2/) -! Per polyline, move last SEG if SEG-1 is different body number: -DO IPOLY=1,NPOLY - FOUND_CHG=.FALSE. - ILO =ILO_POLY(IPOLY)+1 - IHI =ILO_POLY(IPOLY)+NSG_POLY(IPOLY) - CT =0 - DO ISEG=ILO,IHI-1 - CT=CT+1 - IF (SEG_CELL2(6,ISEG) /= SEG_CELL2(6,ISEG+1)) THEN - FOUND_CHG=.TRUE. - EXIT - ENDIF ENDDO - IF (FOUND_CHG) THEN - SEG_CELL(:,ILO:IHI-CT) = SEG_CELL2(:,ISEG+1:IHI) - SEG_POS(ILO:IHI-CT) = SEG_POS2(ISEG+1:IHI) - SEG_CELL(:,IHI-CT+1:IHI) = SEG_CELL2(:,ILO:ISEG) - SEG_POS(IHI-CT+1:IHI) = SEG_POS2(ILO:ISEG) +ENDDO FACE_LOOP +CYL_FIND(HIGH_IND,2) = IFACE + +! High axis plane: +IVERT=NVERTS +CYL_FIND(LOW_IND,1) = IFACE + 1 +DO IFC=1,NP_T + IF (IFC < NP_T) THEN + I1 = (NP_L-1)*NP_T + 1 + IFC + I2 = (NP_L-1)*NP_T + 1 + IFC + 1 + I3 = IVERT ELSE - SEG_CELL(:,ILO:IHI) = SEG_CELL2(:,ILO:IHI) - SEG_POS(ILO:IHI) = SEG_POS2(ILO:IHI) + I1 = (NP_L-1)*NP_T + 1 + IFC + I2 = (NP_L-1)*NP_T + 1 + 1 + I3 = IVERT ENDIF + IFACE=IFACE+1 + FACES(3*IFACE-2:3*IFACE) = (/I1, I2, I3 /) ENDDO +CYL_FIND(HIGH_IND,1) = IFACE +NFACES = IFACE -! Finally cycle segments to redefine polylines (case of two or more polys -! sharing one point. -STNOD=SEG_CELL(NOD1,1) -NPOLY=1; COUNT=1 -DO ISEG=2,NSEG - COUNT=COUNT+1 - SEG_POLY(ISEG)=NPOLY - IF (SEG_CELL(NOD2,ISEG)==STNOD) THEN - NSG_POLY(NPOLY) = COUNT - IF (ISEG==NSEG) EXIT - NPOLY=NPOLY+1 - ILO_POLY(NPOLY) = ILO_POLY(NPOLY-1) + NSG_POLY(NPOLY-1) - COUNT=0; STNOD=SEG_CELL(NOD1,ISEG+1) - ENDIF +! Transform vertices to global axes: +DO IVERT=1,NVERTS + V(IAXIS:KAXIS,1) = VERTS(3*IVERT-2:3*IVERT) + R = MATMUL(TGL,V) + VERTS(3*IVERT-2:3*IVERT) = R(IAXIS:KAXIS,1) + CYLINDER_ORIGIN(IAXIS:KAXIS) ENDDO -DEALLOCATE(SEG_CELL2,SEG_POS2,COUNTED,BOD,SEG_POLY) +! No volumes being defined. +NVOLS = 0 +VOLS = 0 -IFLG=.FALSE. +! WRITE(LU_ERR,*) 'Vertices:' +! DO IVERT=1,NVERTS +! WRITE(LU_ERR,*) VERTS(3*IVERT-2:3*IVERT) +! ENDDO +! WRITE(LU_ERR,*) ' ' +! WRITE(LU_ERR,*) 'Faces:' +! DO IFACE=1,NFACES +! WRITE(LU_ERR,*) FACES(3*IFACE-2:3*IFACE) +! ENDDO RETURN -END SUBROUTINE GET_CLOSED_POLYLINES +END SUBROUTINE DEFINE_CYLINDER +! ---------------------------- GET_GEOM_INFO ---------------------------------------- -! --------------------------- EAR_CLIP_CFACES ----------------------------------- +SUBROUTINE GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) ! LU_INPUT not used for now. -SUBROUTINE EAR_CLIP_CFACES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,XYZVERT,& - INDIF,INDJF,INDKF,NPOLY,ILO_POLY,NSG_POLY,NFACE,& - CFELEM,BOD_TRI,CEDGES,SEG_CELL_AUX,COUNT_CEDGE) +! Count number of various geometry types on the current &GEOM line +! Assume a maximum number of faces and ZVALS, which can be modified in the &MISC line. -INTEGER, INTENT(IN) :: SIZE_CEELEM_SEG_CELL -INTEGER, INTENT(IN) :: NSEG, INDIF, INDJF, INDKF, NPOLY -INTEGER, INTENT(IN) :: ILO_POLY(1:MAX_CELL_POLYLINES),NSG_POLY(1:MAX_CELL_POLYLINES) -INTEGER, INTENT(IN) :: SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) -REAL(EB),INTENT(IN) :: XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) -INTEGER, INTENT(OUT):: NFACE,CFELEM(4,3*NSEG),BOD_TRI(1:2,1:CC_MAXCFELEM_FACE),CEDGES(4,3*NSEG) -INTEGER, INTENT(INOUT) :: SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:3*NSEG) -INTEGER, INTENT(OUT):: COUNT_CEDGE +INTEGER, INTENT(INOUT) :: MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS -! Local Variables: -REAL(EB) :: DV(IAXIS:KAXIS), NP(IAXIS:KAXIS), XP(IAXIS:KAXIS) -REAL(EB), ALLOCATABLE, DIMENSION(:) :: LEN_SEG -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: N -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL2 -LOGICAL :: SEG_FLAG(1:MAX_CELL_POLYLINES), FOUND_ISEG1, IS_SOLID, TWOTRI -INTEGER :: ILO, IHI, NSGP, LEFT_SEGS, COUNTEXT, COUNT, BOD, TRI, ISEG, ISEG1, IPOLY, XAXIS, IFACE -INTEGER :: CONN(1:3),CONN2(1:6) +MAX_ZVALS = MAX(MAX_ZVALS, MAXIMUM_GEOMETRY_ZVALS) +MAX_VOLUS = MAX(MAX_VOLUS,6*MAX_ZVALS, MAXIMUM_GEOMETRY_VOLUS) +MAX_FACES = MAX(MAX_FACES,4*MAX_VOLUS, MAXIMUM_GEOMETRY_FACES) +MAX_VERTS = MAX(MAX_VERTS,4*MAX_VOLUS,3*MAX_FACES, MAXIMUM_GEOMETRY_VERTS) +MAX_IDS = MAX(MAX_IDS, MAXIMUM_GEOMETRY_IDS) +MAX_SURF_IDS = MAX(MAX_SURF_IDS, MAXIMUM_GEOMETRY_SURFIDS) +MAX_POLY_VERTS= MAX(MAX_POLY_VERTS, MAXIMUM_POLY_VERTS) -ALLOCATE(LEN_SEG(1:3*NSEG)); LEN_SEG = 0._EB -ALLOCATE(N(IAXIS:KAXIS,1:3*NSEG)); N = 0._EB -ALLOCATE(SEG_CELL2(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:3*NSEG)); SEG_CELL2 = 0 -COUNT_CEDGE = 0 +END SUBROUTINE GET_GEOM_INFO -! Compute segments director unit vectors and normals: -!DO ISEG=1,NSEG -! DV = XYZVERT(IAXIS:KAXIS,SEG_CELL(NOD2,ISEG)) - XYZVERT(IAXIS:KAXIS,SEG_CELL(NOD1,ISEG)) -! LEN_SEG(ISEG) = NORM2(DV) -! N(IAXIS:KAXIS,ISEG) = 1._EB/LEN_SEG(ISEG) * DV -!ENDDO +! ---------------------------- ALLOCATE_BUFFERS ---------------------------------------- -! First sweep across segments defining triangles for all consecutive segments with same triangle and body: -NFACE = 0 -! Ear clipping algorithm by polyline: -DO IPOLY=1,NPOLY - ILO = ILO_POLY(IPOLY)+1 - NSGP = NSG_POLY(IPOLY) - IHI = ILO_POLY(IPOLY)+NSGP - SEG_CELL2(:,1:NSGP) = SEG_CELL(:,ILO:IHI) - DO ISEG=1,NSGP ! Compute segments director unit vectors and normals - DV = XYZVERT(IAXIS:KAXIS,SEG_CELL2(NOD2,ISEG)) - XYZVERT(IAXIS:KAXIS,SEG_CELL2(NOD1,ISEG)) - LEN_SEG(ISEG) = NORM2(DV) - N(IAXIS:KAXIS,ISEG) = 1._EB/LEN_SEG(ISEG) * DV - ENDDO - SEG_CELL_AUX(:,COUNT_CEDGE+1:COUNT_CEDGE+NSGP) = SEG_CELL(:,ILO:IHI) - COUNT_CEDGE = COUNT_CEDGE + NSGP - SEG_FLAG(1:NSGP) = .FALSE. - LEFT_SEGS = NSGP - DO COUNTEXT=1,3 ! Search segmets first that belong to same triangle (1), - ! second that belong to same body (2), third all the rest. - DO COUNT=1,2 ! Search first last uncounted segment (1), second the rest. - IF (LEFT_SEGS < 3) EXIT ! should break out of COUNTEXT loop. - IF (COUNT==1) THEN - ISEG = NSGP-1 - DO ISEG1=1,NSGP - IF (.NOT.SEG_FLAG(ISEG1)) EXIT - ENDDO - ELSE - ISEG = 0 - ENDIF - DO WHILE (ISEG < NSGP) - ISEG = ISEG + 1 - IF (SEG_FLAG(ISEG)) CYCLE - FOUND_ISEG1 =.FALSE. - IF (COUNT==1) THEN - IF (.NOT.SEG_FLAG(ISEG1)) FOUND_ISEG1 =.TRUE. - ELSE - DO ISEG1=ISEG+1,NSGP - IF (.NOT.SEG_FLAG(ISEG1)) THEN - FOUND_ISEG1 =.TRUE. - EXIT - ENDIF - ENDDO - ENDIF - IF(.NOT.FOUND_ISEG1) CYCLE +SUBROUTINE ALLOCATE_BUFFERS - TRI = 0 - ! Test if triangle given by ISEG ISEG+1 DIAG is valid. - ! First, drop if Body not the same: - IF ( (COUNTEXT<3) .AND. (SEG_CELL2(6,ISEG)/=SEG_CELL2(6,ISEG1)) ) CYCLE +IF(ALLOCATED(SURF_ID)) DEALLOCATE(SURF_ID) +ALLOCATE(SURF_ID(MAX_SURF_IDS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','SURF_ID',IZERO) - ! Second, drop if segments are on the same line: - IF (ABS(ABS(DOT_PRODUCT(N(IAXIS:KAXIS,ISEG),N(IAXIS:KAXIS,ISEG1)))-1._EB) < 1.e-12_EB) CYCLE +IF(ALLOCATED(ZVALS)) DEALLOCATE(ZVALS) +ALLOCATE(ZVALS(MAX_ZVALS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','ZVALS',IZERO) - ! Now drop if triangles don't match: - TWOTRI = .FALSE. - IF (COUNTEXT<3) THEN - IF( (SEG_CELL2(4,ISEG)/=0) .AND. (SEG_CELL2(4,ISEG)==SEG_CELL2(4,ISEG1) .OR. & - SEG_CELL2(4,ISEG)==SEG_CELL2(5,ISEG1)) ) THEN - TWOTRI = .TRUE. - TRI = SEG_CELL2(4,ISEG) - BOD = SEG_CELL2(6,ISEG) - ELSEIF ( (SEG_CELL2(5,ISEG)/=0) .AND. (SEG_CELL2(5,ISEG)==SEG_CELL2(4,ISEG1) .OR. & - SEG_CELL2(5,ISEG)==SEG_CELL2(5,ISEG1)) ) THEN - TWOTRI = .TRUE. - TRI = SEG_CELL2(5,ISEG) - BOD = SEG_CELL2(6,ISEG) - ENDIF - ENDIF - IF ( (COUNTEXT/=1) .AND. (TRI==0) ) THEN - ! Define TRI as the longest seg one: - IF ( LEN_SEG(ISEG) >= LEN_SEG(ISEG1) ) THEN - TRI = SEG_CELL2(4,ISEG) - BOD = SEG_CELL2(6,ISEG) - ELSE - TRI = SEG_CELL2(4,ISEG1) - BOD = SEG_CELL2(6,ISEG1) - ENDIF - ENDIF +IF(ALLOCATED(VERTS)) DEALLOCATE(VERTS) +ALLOCATE(VERTS(3*MAX_VERTS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','VERTS',IZERO) + +IF(ALLOCATED(TFACES)) DEALLOCATE(TFACES) +ALLOCATE(TFACES(6*MAX_FACES+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','TFACES',IZERO) + +IF(ALLOCATED(FACES)) DEALLOCATE(FACES) +ALLOCATE(FACES(4*MAX_FACES+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','FACES',IZERO) + +IF(ALLOCATED(VOLUS)) DEALLOCATE(VOLUS) +ALLOCATE(VOLUS(4*MAX_VOLUS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','VOLUS',IZERO) + +IF(ALLOCATED(POLY)) DEALLOCATE(POLY) +ALLOCATE(POLY(MAX_POLY_VERTS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','POLY',IZERO) +END SUBROUTINE ALLOCATE_BUFFERS + +! ---------------------------- SET_GEOM_DEFAULTS ---------------------------------------- + +SUBROUTINE SET_GEOM_DEFAULTS + + ! Set defaults + + ZMIN=ZS_MIN + WRITE(ID,'(A,I0)') 'geom_',N + SURF_ID(:)='null' + SURF_IDS = 'null' + SURF_ID6 = 'null' + MATL_ID = 'null' + MOVE_ID = 'null' + DEVC_ID = 'null' + CTRL_ID = 'null' + FYI = 'null' + HAVE_SURF = .TRUE. + HAVE_MATL = .TRUE. + TEXTURE_ORIGIN = 0.0_EB + TEXTURE_MAPPING = 'RECTANGULAR' + TEXTURE_SCALE = 1.0_EB + TRANSPARENCY = -1._EB + VERTS=1.001_EB*MAX_VAL + ZVALS=1.001_EB*MAX_VAL + XB=1.001_EB*MAX_VAL + FACES=0 + VOLUS=0 + POLY =0 + IJK = 2 ! minimize number of triangles by default + IS_GEOMETRY_DYNAMIC = .FALSE. + EXTEND_TERRAIN = .FALSE. + IS_TERRAIN = .FALSE. + ZVAL_HORIZON = 1.001_EB*MAX_VAL + SPHERE_ORIGIN = 1.001_EB*MAX_VAL + SPHERE_RADIUS = 1.001_EB*MAX_VAL + CYLINDER_LENGTH = 1.001_EB*MAX_VAL + CYLINDER_RADIUS = 1.001_EB*MAX_VAL + CYLINDER_ORIGIN = 1.001_EB*MAX_VAL + CYLINDER_AXIS = 1.001_EB*MAX_VAL + EXTRUDE = 0._EB + CYLINDER_NSEG_THETA = -1 + CYLINDER_NSEG_AXIS = -1 + N_LEVELS=-1 + N_LAT=-1 + N_LONG=-1 + SPHERE_TYPE=-1 + GEOM_TYPE=CAD_GEOM_TYPE + BNDF_GEOM=BNDF_DEFAULT + READ_BINARY = .FALSE. + BINARY_FILE = 'null' + RGB=-1 + CELL_BLOCK_IOR=0 + CELL_BLOCK_ORIENTATION = 0._EB + COLOR='null' + +END SUBROUTINE SET_GEOM_DEFAULTS + +! ! ---------------------------- EXTRUDE_SPHERE ---------------------------------------- +! +! SUBROUTINE EXTRUDE_SPHERE(ZCENTER,VERTS,MAXVERTS,NVERTS,FACES,NFACES,VOLS,MAXVOLS, NVOLS) +! +! ! convert a closed surface defined by VERTS and FACES into a solid +! +! INTEGER, INTENT(IN) :: NFACES, MAXVERTS,MAXVOLS +! INTEGER, INTENT(INOUT) :: NVERTS +! REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) +! INTEGER, INTENT(IN) :: FACES(3*NFACES) +! INTEGER, INTENT(OUT) :: NVOLS +! INTEGER, INTENT(OUT) :: VOLS(4*MAXVOLS) +! REAL(EB), INTENT(IN) :: ZCENTER(3) +! +! INTEGER :: I +! +! ! define a new vertex at ZCENTER +! VERTS(3*NVERTS+1:3*NVERTS+3)=ZCENTER(1:3) +! +! ! form a tetrahedron using each face and the vertex ZCENTER +! DO I = 1, NFACES +! VOLS(4*I-3:4*I)=(/FACES(3*I-2:3*I),NVERTS+1/) +! ENDDO +! NVERTS=NVERTS+1 +! NVOLS=NFACES +! +! END SUBROUTINE EXTRUDE_SPHERE - IF ( TRI == 0 ) THEN - CYCLE - ELSE ! Found two segments with matching triangle. +! ! ---------------------------- EXTRUDE_SURFACE ---------------------------------------- +! +! SUBROUTINE EXTRUDE_SURFACE(ZMIN,VERTS,MAXVERTS,NVERTS,FACES,NFACES,VOLS,MAXVOLS, NVOLS) +! +! ! extend a 2D surface defined by VERTS and FACES to a plane defined by ZMIN +! +! INTEGER, INTENT(IN) :: NFACES, MAXVERTS,MAXVOLS +! INTEGER, INTENT(INOUT) :: NVERTS +! REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) +! INTEGER, INTENT(IN) :: FACES(3*NFACES) +! INTEGER, INTENT(OUT) :: NVOLS +! INTEGER, INTENT(OUT) :: VOLS(4*MAXVOLS) +! REAL(EB), INTENT(IN) :: ZMIN +! INTEGER :: PRISM(6) +! +! INTEGER :: I +! REAL(EB), POINTER, DIMENSION(:) :: VNEW, VOLD +! +! ! define a new vertex on the plane z=ZMIN for each vertex in original list +! DO I = 1, NVERTS +! VNEW=>VERTS(3*NVERTS+3*I-2:3*NVERTS+3*I) +! VOLD=>VERTS(3*I-2:3*I) +! VNEW(1:3)=(/VOLD(1:2),ZMIN/) +! ENDDO +! ! construct 3 tetrahedrons for each prism (solid between original face and face on plane z=zplane) +! DO I = 1, NFACES +! PRISM(1:3)=FACES(3*I-2:3*I) +! PRISM(4:6)=FACES(3*I-2:3*I)+NVERTS +! CALL PRISM2TETRA(PRISM,VOLS(12*I-11:12*I)) +! ENDDO +! NVOLS=3*NFACES +! NVERTS=2*NVERTS +! +! END SUBROUTINE EXTRUDE_SURFACE - ! Test that triangle found is not internal to GEOMs: - CONN(1:3) = (/ SEG_CELL2(1:2,ISEG), SEG_CELL2(2,ISEG1) /) - IF (TWOTRI) THEN - NP(IAXIS:KAXIS)=GEOMETRY(BOD)%FACES_NORMAL(IAXIS:KAXIS,TRI) - XP(IAXIS:KAXIS)=1._EB/3._EB*(XYZVERT(IAXIS:KAXIS,CONN(NOD1)) + & - XYZVERT(IAXIS:KAXIS,CONN(NOD2)) + & - XYZVERT(IAXIS:KAXIS,CONN(NOD3))) + 10._EB*GEOMEPS*NP(IAXIS:KAXIS) - XAXIS = MAXLOC(ABS(NP(IAXIS:KAXIS)),DIM=1) - CALL GET_IS_SOLID_3D(XAXIS,XP,INDIF,INDJF,INDKF,IS_SOLID) - IF (IS_SOLID) CYCLE - ENDIF +! ---------------------------- BOX2TETRA ---------------------------------------- - NFACE = NFACE + 1 - CFELEM(1:4,NFACE) = (/ 3, CONN(1:3) /) - BOD_TRI(1:2,NFACE) = (/ BOD, TRI /) - SEG_CELL2(1:6,ISEG) = (/ SEG_CELL2(1,ISEG), SEG_CELL2(2,ISEG1), 1, TRI, 0, BOD /) - SEG_CELL_AUX(1:6,COUNT_CEDGE+1) = SEG_CELL2(1:6,ISEG) - COUNT_CEDGE = COUNT_CEDGE + 1 - DV = XYZVERT(IAXIS:KAXIS,SEG_CELL2(2,ISEG))-XYZVERT(IAXIS:KAXIS,SEG_CELL2(1,ISEG)) - LEN_SEG(ISEG) = NORM2(DV) - IF(LEN_SEG(ISEG) < GEOMEPS) CYCLE - N(IAXIS:KAXIS,ISEG) = 1._EB/LEN_SEG(ISEG) * DV +SUBROUTINE BOX2TETRA(BOX,TETRAS) - ! Erase Segment ISEG1: - SEG_CELL2(:,ISEG1) = 0 - SEG_FLAG(ISEG1) = .TRUE. - N(IAXIS:KAXIS,ISEG1)= 0._EB - LEFT_SEGS = LEFT_SEGS - 1 - IF (COUNT/=1) ISEG = ISEG - 1 - ENDIF - ENDDO - ENDDO - ENDDO -ENDDO -DEALLOCATE(LEN_SEG,N,SEG_CELL2) +! split a box defined by a list of 8 vertices (not necessarily cubic) into 6 stackable tetrahedrons -! Finally define CEDGES: -CEDGES(1,1:NFACE) = 3 -DO IFACE=1,NFACE - CONN2(1:6) = (/ CFELEM(2:3,IFACE), CFELEM(3:4,IFACE), CFELEM(2,IFACE), CFELEM(4,IFACE) /) - DO ISEG=1,3 - CONN(1:2) = CONN2(2*ISEG-1:2*ISEG) - DO ISEG1=1,COUNT_CEDGE - IF(SEG_CELL_AUX(1,ISEG1)==CONN(1) .AND. SEG_CELL_AUX(2,ISEG1)==CONN(2)) THEN - CEDGES(ISEG+1,IFACE) = ISEG1 - EXIT - ENDIF - ENDDO - ENDDO -ENDDO +! 8-------7 +! / . / | +! 5-------6 | +! | . | | +! | . | | +! | 4-------3 +! | / | / +! 1-------2 -RETURN -END SUBROUTINE EAR_CLIP_CFACES -! ----------------------- GET_CARTCELL_CUTCELLS --------------------------------- +INTEGER, INTENT(IN) :: BOX(8) +INTEGER, INTENT(OUT) :: TETRAS(1:24) -SUBROUTINE GET_CARTCELL_CUTCELLS(NM) +TETRAS(1:4) = (/BOX(1),BOX(2),BOX(4),BOX(5)/) +TETRAS(5:8) = (/BOX(4),BOX(5),BOX(2),BOX(6)/) +TETRAS(9:12) = (/BOX(4),BOX(5),BOX(6),BOX(8)/) +TETRAS(13:16) = (/BOX(2),BOX(3),BOX(4),BOX(6)/) +TETRAS(17:20) = (/BOX(4),BOX(6),BOX(3),BOX(8)/) +TETRAS(21:24) = (/BOX(6),BOX(3),BOX(8),BOX(7)/) -INTEGER, INTENT(IN) :: NM +END SUBROUTINE BOX2TETRA -! Local Variables: -INTEGER :: I, II, J, JJ, K, ILO, IHI, JLO, JHI, KLO, KHI -INTEGER, DIMENSION(LOW_IND:HIGH_IND,IAXIS:KAXIS) :: FSID_XYZ, IDCF_XYZ -INTEGER :: NVERT_CELL, NSEG_CELL, NFACE_CELL, NCELL -INTEGER :: IED, JED, KED, MYAXIS, SIDE -REAL(EB), DIMENSION(IAXIS:KAXIS,NOD1:NOD4,LOW_IND:HIGH_IND) :: XYZLH -REAL(EB) :: AREAI, AREAVARSI(1:MAX_DIM+1,LOW_IND:HIGH_IND), FCT, XYZ(IAXIS:KAXIS), XYZC(IAXIS:KAXIS) -INTEGER :: CEI_AXIS(LOW_IND:HIGH_IND) -INTEGER :: IP, NP, ICF, CEI, INOD, FNOD -REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXVERTS_CELL) :: XYZVERT +! ! ---------------------------- PRISM2TETRA ---------------------------------------- +! +! SUBROUTINE PRISM2TETRA(PRISM,TETRAS) +! +! ! split a prism defined by a list of 6 vertices into 3 tetrahedrons +! +! ! 6 +! ! /.\ . +! ! / . \ . +! ! / . \ . +! ! 4-----------5 +! ! | . | +! ! | . | +! ! | 3 | +! ! | / \ | +! ! | / \ | +! ! |/ \| +! ! 1-----------2 +! INTEGER, INTENT(IN) :: PRISM(6) +! INTEGER, INTENT(OUT) :: TETRAS(1:12) +! +! TETRAS(1:4) = (/PRISM(1),PRISM(6),PRISM(4),PRISM(5)/) +! TETRAS(5:8) = (/PRISM(1),PRISM(3),PRISM(6),PRISM(5)/) +! TETRAS(9:12) = (/PRISM(1),PRISM(2),PRISM(3),PRISM(5)/) +! +! END SUBROUTINE PRISM2TETRA -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL,SEG_CELL_AUX,EDGFAC_CELL,EDGFAC_CELL_AUX -INTEGER, SAVE :: SIZE_CEELEM_EDGFAC, SIZE_CFELEM_EDGFAC -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FACEDG_CELL,FACEDG_CELL_AUX -INTEGER, SAVE :: SIZE_CEELEM_FACEDG, SIZE_CFELEM_FACEDG +! ! ---------------------------- SPLIT_TETRA ---------------------------------------- +! +! SUBROUTINE SPLIT_TETRA(VERTS,MAXVERTS,NVERTS,TETRAS) +! ! split a tetrahedron defined by a list of 4 vertices into 4 tetrahedrons +! +! ! 1 +! ! | +! ! .|. +! ! .|. +! ! . | . +! ! . 7 . +! ! . | . +! ! . 4 . +! ! 5 / \ 6 +! ! . / \ . +! ! . / \ . +! ! . / \ . +! ! ./ \. +! ! / \. +! ! 2-------------3 +! +! INTEGER, INTENT(IN) :: MAXVERTS +! INTEGER, INTENT(INOUT) :: NVERTS +! REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) +! INTEGER, INTENT(INOUT) :: TETRAS(16) +! +! REAL(EB), POINTER, DIMENSION(:) :: VERT1, VERT2, VERT3, VERT4, VERT5, VERT6, VERT7 +! INTEGER :: TETRANEW(16) +! +! VERT1=>VERTS(3*TETRAS(1)-2:3*TETRAS(1)) +! VERT2=>VERTS(3*TETRAS(2)-2:3*TETRAS(2)) +! VERT3=>VERTS(3*TETRAS(3)-2:3*TETRAS(3)) +! VERT4=>VERTS(3*TETRAS(4)-2:3*TETRAS(4)) +! VERT5=>VERTS(3*NVERTS+1:3*NVERTS+3) +! VERT6=>VERTS(3*NVERTS+4:3*NVERTS+6) +! VERT7=>VERTS(3*NVERTS+7:3*NVERTS+9) +! +! ! add 3 vertices +! VERT5(1:3) = ( VERT1(1:3)+VERT2(1:3) )/2.0_EB +! VERT6(1:3) = ( VERT1(1:3)+VERT3(1:3) )/2.0_EB +! VERT7(1:3) = ( VERT1(1:3)+VERT4(1:3) )/2.0_EB +! TETRAS(5)=NVERTS+1 +! TETRAS(6)=NVERTS+2 +! TETRAS(7)=NVERTS+3 +! NVERTS=NVERTS+3 +! +! TETRANEW(1:4)=(/TETRAS(1),TETRAS(5),TETRAS(6),TETRAS(7)/) +! CALL PRISM2TETRA(TETRAS(2:7),TETRANEW(5:16)) +! TETRAS(1:16)=TETRANEW(1:16) +! +! END SUBROUTINE SPLIT_TETRA -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FACE_CELL,FACE_CELL_AUX -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FACE_LIST,FACE_LIST_AUX,SPCELL_LIST -REAL(EB), ALLOCATABLE, DIMENSION(:,:):: AREAVARS,AREAVARS_AUX -INTEGER, ALLOCATABLE, DIMENSION(:) :: FACECELL_NUM -INTEGER, ALLOCATABLE, DIMENSION(:) :: FACE_CELL_DUM -INTEGER, SAVE :: SIZE_VERTS_FC, SIZE_CFELEM_FC +! ---------------------------- ORDER_FACES ---------------------------------------- -INTEGER, ALLOCATABLE, DIMENSION(:) :: IPTS +SUBROUTINE ORDER_FACES(ORDER,N) ! +INTEGER, INTENT(IN) :: N +INTEGER, INTENT(OUT) :: ORDER(1:N) -INTEGER, SAVE :: SIZE_FACE_CCELEM, SIZE_CELL_CCELEM -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOL ! Cut-cell volumes. -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE +INTEGER, ALLOCATABLE, DIMENSION(:) :: WORK +INTEGER :: I, IZERO -REAL(EB) :: XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND),MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND:HIGH_IND),CELL_DELTA(IAXIS:KAXIS) +DO I = 1, N + ORDER(I) = I +ENDDO +ALLOCATE(WORK(N),STAT=IZERO) +CALL ChkMemErr('ORDER_FACES','WORK',IZERO) +CALL ORDER_FACES1(ORDER,WORK,1,N,N) +END SUBROUTINE ORDER_FACES -INTEGER :: IFACE, IEDGE, ISEG, SEG(NOD1:NOD2), ICELL, NFACEI, JCC, AX_MIN, AX_OTHERS(2) -LOGICAL :: INLIST, TEST1, TEST2, NEWFACE -INTEGER :: NIEDGE, NEF, LOCSEG, JFACE, KFACE, NFACEK, NUM_FACE, NCUTCELL, NCFACE_CUTCELL -INTEGER :: DFCT, CFELEM(5), CTVAL, CTVAL2, IBOD, ITRI, IDCF, MAXSEG, N_GAS_CFACES, NIBFACE, THRES, NSPCELL_LIST -LOGICAL :: CYCLE_CELL, BLOCK_SLIM_IF +! ---------------------------- ORDER_FACES1 ---------------------------------------- -INTEGER :: IBNDINT -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNT -REAL(EB) :: TNOW +RECURSIVE SUBROUTINE ORDER_FACES1(ORDER,WORK,LEFT,RIGHT,N) +INTEGER, INTENT(IN) :: N, LEFT, RIGHT +INTEGER, INTENT(INOUT) :: ORDER(1:N) +INTEGER :: TEMP +INTEGER :: I1, I2 +INTEGER, INTENT(OUT) :: WORK(N) +INTEGER :: ICOUNT -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -INTEGER :: NCUTCEL +INTEGER :: NMID -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTCELLS for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTCELLS for mesh :',NM,' ..' +IF (RIGHT-LEFT>1) THEN + NMID = (LEFT+RIGHT)/2 + CALL ORDER_FACES1(ORDER,WORK,LEFT,NMID,N) + CALL ORDER_FACES1(ORDER,WORK,NMID+1,RIGHT,N) + I1=LEFT + I2=NMID+1 + ICOUNT=LEFT + DO WHILE (I1<=NMID .OR. I2<=RIGHT) + IF (I1<=NMID .AND. I2<=RIGHT) THEN + IF (COMPARE_FACES(ORDER(I1),ORDER(I2))==-1) THEN + WORK(ICOUNT)=ORDER(I1) + I1=I1+1 + ELSE + WORK(ICOUNT)=ORDER(I2) + I2=I2+1 + ENDIF + ELSE IF (I1<=NMID .AND. I2>RIGHT) THEN + WORK(ICOUNT)=ORDER(I1) + I1=I1+1 + ELSE IF (I1>NMID .AND. I2<=RIGHT) THEN + WORK(ICOUNT)=ORDER(I2) + I2=I2+1 + ENDIF + ICOUNT=ICOUNT+1 + ENDDO + ORDER(LEFT:RIGHT)=WORK(LEFT:RIGHT) +ELSE IF (RIGHT-LEFT==1) THEN + IF (COMPARE_FACES(ORDER(LEFT),ORDER(RIGHT))==1) RETURN + TEMP=ORDER(LEFT) + ORDER(LEFT) = ORDER(RIGHT) + ORDER(RIGHT) = TEMP ENDIF +END SUBROUTINE ORDER_FACES1 -TNOW=CURRENT_TIME() +! ---------------------------- COMPARE_FACES ---------------------------------------- -! Allocate work arrays for this mesh: -SIZE_CEELEM_EDGFAC = DELTA_EDGE -SIZE_CFELEM_EDGFAC = DELTA_FACE -ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) -ALLOCATE(SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC)) +INTEGER FUNCTION COMPARE_FACES(INDEX1,INDEX2) +INTEGER, INTENT(IN) :: INDEX1, INDEX2 +INTEGER, POINTER, DIMENSION(:) :: FACE1, FACE2 +INTEGER :: F1(3), F2(3) -SIZE_CEELEM_FACEDG = DELTA_EDGE -SIZE_CFELEM_FACEDG = DELTA_FACE -ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) -ALLOCATE(IPTS(1:SIZE_CEELEM_FACEDG+1)) ! Note that SIZE_CEELEM_FACEDG should be ~= SIZE_VERTS_FC. - ! (we have equal number of vertices and edges for a closed polygon.) +FACE1=>FACES(3*INDEX1-2:3*INDEX1) +FACE2=>FACES(3*INDEX2-2:3*INDEX2) +F1(1:3) = (/FACE1(1),MIN(FACE1(2),FACE1(3)),MAX(FACE1(2),FACE1(3))/) +F2(1:3) = (/FACE2(1),MIN(FACE2(2),FACE2(3)),MAX(FACE2(2),FACE2(3))/) -SIZE_VERTS_FC = DELTA_VERT -SIZE_CFELEM_FC = DELTA_FACE -ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) -ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)) -ALLOCATE(AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC)) -ALLOCATE(FACECELL_NUM(1:SIZE_CFELEM_FC)) -ALLOCATE(FACE_CELL_DUM(1:SIZE_VERTS_FC)) +COMPARE_FACES=0 +IF (F1(1)F2(1)) THEN + COMPARE_FACES=-1 +ENDIF +IF (COMPARE_FACES/=0) RETURN -SIZE_FACE_CCELEM = DELTA_FACE -SIZE_CELL_CCELEM = DELTA_CELL -ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) -ALLOCATE(NOADVANCE(1:SIZE_CELL_CCELEM),VOL(1:SIZE_CELL_CCELEM),XYZCEN(IAXIS:KAXIS,1:SIZE_CELL_CCELEM)) +IF (F1(2)F2(2)) THEN + COMPARE_FACES=-1 +ENDIF +IF (COMPARE_FACES/=0) RETURN -! Definition of cut-cells: -! For each cartesian cell being cut into one or several cut-cells (NCELL), fill -! entries on a MESHES(NM)%CUT_CELL struct. On each local entry ICC: -! - Add number of faces that are boundary of cut-cell. -! MESHES(NM)%CUT_CELL(ICELL)%CCELEM(1:NFACE_CELL+1,ICC), ICC=1,...,MESHES(NM)%CUT_CELL(ICELL)%NCELL -! - Add list of corresponding regular faces, or cut-faces in CUT_FACE: -! + 5 Indexes: -! MESHES(NM)%CUT_CELL(ICELL)%FACES_LIST = [ FACE_TYPE LOW/HIGH AXIS cei icf ] -! where in MESHES(NM)%CUT_FACE(CEI), which icf. -! - Compute Volume properties for each disjoint volume, add an unknown -! number for scalars, pressure, etc. +IF (F1(3)F2(3)) THEN + COMPARE_FACES=-1 +ENDIF +END FUNCTION COMPARE_FACES -IBNDINT_LOOP : DO IBNDINT=LOW_IND,HIGH_IND ! 1 refers to blocks internal cells, 2 refers to block guard cells. +END SUBROUTINE READ_GEOM -SELECT CASE(IBNDINT) -CASE(LOW_IND) - ALLOCATE(IJK_COUNT(ILO_CELL-NGUARD:IHI_CELL+NGUARD,JLO_CELL-NGUARD:JHI_CELL+NGUARD,KLO_CELL-NGUARD:KHI_CELL+NGUARD)) - IJK_COUNT = .FALSE. - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL -CASE(HIGH_IND) - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD -END SELECT -! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: -DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI +! ---------------------------- INIT_SPHERE ---------------------------------------- - IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE +SUBROUTINE INIT_SPHERE(N_LEVELS,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) - IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. +INTEGER, INTENT(IN) :: N_LEVELS +INTEGER, INTENT(OUT) :: N_VERTS, N_FACES +INTEGER, INTENT(IN) :: MAX_VERTS, MAX_FACES +REAL(EB), TARGET, INTENT(OUT) :: SPHERE_VERTS(3*MAX_VERTS) +INTEGER, TARGET, INTENT(OUT) :: SPHERE_FACES(3*MAX_FACES) - ! Start with Cartesian Faces: - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) +REAL(EB) :: ARG +REAL(EB), DIMENSION(3) :: VERT +INTEGER :: I,IFACE +INTEGER, DIMENSION(60) :: FACE_LIST - ! Cut-face number of bounding Cartesian faces: - IDCF_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCF,IAXIS) - IDCF_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCF,IAXIS) - IDCF_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCF,JAXIS) - IDCF_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCF,JAXIS) - IDCF_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCF,KAXIS) - IDCF_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCF,KAXIS) +DATA (FACE_LIST(I),I=1,60) / & + 1, 2, 3, 1, 3, 4, 1, 4, 5, 1, 5, 6, 1, 6,2, & + 2, 7, 3, 3, 7, 8, 3, 8, 4, 4, 8, 9, 4, 9,5, & + 5, 9,10, 5,10, 6, 6,10,11, 6,11, 2, 2,11,7, & + 12, 8,7, 12, 9,8, 12,10,9, 12,11,10, 12,7,11 & + / - ! Local variables: - ! Geometric entities related to the Cartesian cell: - NVERT_CELL = 0 - NSEG_CELL = 0 - NFACE_CELL = 0 - SEG_CELL = CC_UNDEFINED - FACE_CELL = CC_UNDEFINED - FACE_LIST = CC_UNDEFINED - XYZVERT = 0._EB - AREAVARS = 0._EB +N_VERTS = 12 +N_FACES = 20 - ! Add Cartesian Regular faces + GASPHASE cut-faces + vertices: - IED = I-1; JED = J-1; KED = K-1 - MYAXIS_LOOP : DO MYAXIS=IAXIS,KAXIS - SELECT CASE(MYAXIS) - CASE(IAXIS) +SPHERE_VERTS(1:3) = (/0.0,0.0,1.0/) ! 1 +DO I=2, 6 + ARG = REAL(I-2,EB)*72.0_EB + ARG = 2.0_EB*PI*ARG/360.0_EB + VERT = (/COS(ARG),SIN(ARG),1.0_EB/SQRT(5.0_EB)/) + SPHERE_VERTS(3*I-2:3*I) = VERT/NORM2(VERT) ! 2-6 +ENDDO +DO I=7, 11 + ARG = 36.0_EB+REAL(I-7,EB)*72.0_EB + ARG = 2.0_EB*PI*ARG/360.0_EB + VERT = (/COS(ARG),SIN(ARG),-1.0_EB/SQRT(5.0_EB)/) + SPHERE_VERTS(3*I-2:3*I) = VERT/NORM2(VERT) ! 7-11 +ENDDO +SPHERE_VERTS(34:36) = (/0.0,0.0,-1.0/) ! 12 - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) +SPHERE_FACES(1:60) = FACE_LIST(1:60) - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) +! refine each triangle of the icosahedron recursively until the +! refined triangle sides are the same size as the grid mesh - AREAI = DYCELL(J) * DZCELL(K) - AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/-XFACE(IED )*AREAI, -XFACE(IED )**2._EB*AREAI, 0._EB, 0._EB /) - AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ XFACE(IED+1)*AREAI, XFACE(IED+1)**2._EB*AREAI, 0._EB, 0._EB /) - CASE(JAXIS) +DO IFACE = 1, 20 ! can't use N_FACES since N_FACES is altered by each call to REFINE_FACE + CALL REFINE_FACE(N_LEVELS,IFACE,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +ENDDO +END SUBROUTINE INIT_SPHERE - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) +! ---------------------------- COMPUTE_TEXTURES ---------------------------------------- - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) +SUBROUTINE COMPUTE_TEXTURES(SPHERE_VERTS,SPHERE_FACES,SPHERE_TFACES,MAX_VERTS,MAX_FACES,N_FACES) +INTEGER, INTENT(IN) :: N_FACES,MAX_VERTS,MAX_FACES +REAL(EB), TARGET, INTENT(IN) :: SPHERE_VERTS(3*MAX_VERTS) +REAL(EB), INTENT(OUT), TARGET :: SPHERE_TFACES(6*MAX_FACES) +INTEGER, TARGET, INTENT(IN) :: SPHERE_FACES(3*MAX_FACES) - AREAI = DXCELL(I) * DZCELL(K) - AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/ 0._EB, 0._EB, -YFACE(JED )**2._EB*AREAI, 0._EB /) - AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ 0._EB, 0._EB, YFACE(JED+1)**2._EB*AREAI, 0._EB /) - CASE(KAXIS) +INTEGER :: IFACE +REAL(EB) :: EPS_TEXTURE +REAL(EB), POINTER, DIMENSION(:) :: TFACE, VERTPTR +INTEGER, POINTER, DIMENSION(:) :: FACEPTR - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) +EPS_TEXTURE=0.25_EB +IFACE_LOOP: DO IFACE=0, N_FACES-1 - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + FACEPTR=>SPHERE_FACES(3*IFACE+1:3*IFACE+3) + TFACE=>SPHERE_TFACES(6*IFACE+1:6*IFACE+6) - AREAI = DXCELL(I) * DYCELL(J) - AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/ 0._EB, 0._EB, 0._EB, -ZFACE(KED )**2._EB*AREAI /) - AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ 0._EB, 0._EB, 0._EB, ZFACE(KED+1)**2._EB*AREAI /) - END SELECT + VERTPTR=>SPHERE_VERTS(3*FACEPTR(1)-2:3*FACEPTR(1)) + CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(1:2)) + + VERTPTR=>SPHERE_VERTS(3*FACEPTR(2)-2:3*FACEPTR(2)) + CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(3:4)) + + VERTPTR=>SPHERE_VERTS(3*FACEPTR(3)-2:3*FACEPTR(3)) + CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(5:6)) - CEI_AXIS(LOW_IND:HIGH_IND) = IDCF_XYZ(LOW_IND:HIGH_IND,MYAXIS) + ! adjust texture coordinates when a triangle crosses the "prime meridian" - DO SIDE=LOW_IND,HIGH_IND - ! Low High face: - IF ( FSID_XYZ(SIDE,MYAXIS) == CC_GASPHASE ) THEN + IF (TFACE(1)>1.0_EB-EPS_TEXTURE .AND. TFACE(3)1.0_EB-EPS_TEXTURE .AND. TFACE(5)1.0_EB-EPS_TEXTURE .AND. TFACE(1)1.0_EB-EPS_TEXTURE .AND. TFACE(5) SIZE_CFELEM_FC: - ! Also no need to reallocate FACE_CELL vert dimension, as for regular cells vert size = 5. - CALL REALLOCATE_LOCAL_FC_VARS - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_RCGAS, SIDE, MYAXIS, 0, 0, CC_UNDEFINED /) - ! CC_FTYPE_RCGAS=0, regular face. - AREAVARS(1:MAX_DIM+1,NFACE_CELL) = AREAVARSI(1:MAX_DIM+1,SIDE) + IF (TFACE(5)>1.0_EB-EPS_TEXTURE .AND. TFACE(1)1.0_EB-EPS_TEXTURE .AND. TFACE(3) SIZE_CFELEM_FC: - CALL REALLOCATE_LOCAL_FC_VARS - ! Also reallocate FACE_CELL vert dimension, if needed. - NP = MESHES(NM)%CUT_FACE(CEI)%CFELEM(1,ICF) - CALL REALLOCATE_FACE_CELL_VERTS +ENDDO IFACE_LOOP +END SUBROUTINE COMPUTE_TEXTURES - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFGAS,SIDE,MYAXIS,CEI,ICF,CC_UNDEFINED /) - ! CC_FTYPE_CFGAS=1 - AREAVARS(1:MAX_DIM+1,NFACE_CELL) =(/ MESHES(NM)%CUT_FACE(CEI)%INXAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%INXSQAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%JNYSQAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%KNZSQAREA(ICF) /)*FCT - ! FCT considers Normal out. - FACE_CELL(1,NFACE_CELL) = NP - DO IP=2,NP+1 - FNOD = MESHES(NM)%CUT_FACE(CEI)%CFELEM(IP,ICF) - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_FACE(CEI)%XYZVERT(IAXIS:KAXIS,FNOD) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) - FACE_CELL(IP,NFACE_CELL) = INOD - ENDDO - ENDDO - ENDIF - ENDDO - ENDDO MYAXIS_LOOP +! ---------------------------- INIT_SPHERE2 ---------------------------------------- - N_GAS_CFACES = NFACE_CELL +SUBROUTINE INIT_SPHERE2(N_VERTS, N_FACES, NLAT,NLONG,SPHERE_VERTS,SPHERE_FACES) +INTEGER, INTENT(IN) :: NLAT, NLONG +REAL(EB), INTENT(OUT), TARGET, DIMENSION(3*(NLONG*(NLAT-2) + 2)) :: SPHERE_VERTS +INTEGER, INTENT(OUT), TARGET, DIMENSION(3*(NLAT-1)*NLONG*2*2) :: SPHERE_FACES +INTEGER, INTENT(OUT) :: N_VERTS, N_FACES +REAL(EB) :: LAT, LONG +INTEGER :: ILONG, ILAT +REAL(EB) :: COSLAT(NLAT), SINLAT(NLAT) +REAL(EB) :: COSLONG(NLONG), SINLONG(NLONG) - ! Now add INBOUNDARY faces of the cell: - CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) - IF ( CEI > 0 ) THEN - FCT = -1._EB - DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE - NFACE_CELL = NFACE_CELL + 1 - ! Here, reallocate FACE_LIST, AREAVARS, FACE_CELL if NFACE_CELL > SIZE_CFELEM_FC: - CALL REALLOCATE_LOCAL_FC_VARS - ! Also reallocate FACE_CELL, FACE_CELL_DUM vert dimension, if needed. - NP = MESHES(NM)%CUT_FACE(CEI)%CFELEM(1,ICF) - CALL REALLOCATE_FACE_CELL_VERTS - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB, 0, 0, CEI, ICF, CC_UNDEFINED /) - ! CC_FTYPE_CFINB in Cart-cell. - AREAVARS(1:MAX_DIM+1,NFACE_CELL) = (/ MESHES(NM)%CUT_FACE(CEI)%INXAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%INXSQAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%JNYSQAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%KNZSQAREA(ICF) /)*FCT - ! Normal out of cut-cell. - FACE_CELL(1,NFACE_CELL) = NP - DO IP=2,NP+1 - FNOD = MESHES(NM)%CUT_FACE(CEI)%CFELEM(IP,ICF) - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_FACE(CEI)%XYZVERT(IAXIS:KAXIS,FNOD) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) - FACE_CELL(IP,NFACE_CELL) = INOD - ENDDO - ! At this point the face in face cell is ordered - ! throught the normal outside the body. Reorganize - ! to normal outside cut-cell (inside body). - FACE_CELL_DUM(1:NP+1) = FACE_CELL(1:NP+1,NFACE_CELL) - DO IP=2,NP+1 - FACE_CELL(IP,NFACE_CELL) = FACE_CELL_DUM( (NP+1)+2-IP ) - ENDDO - ENDDO - ENDIF +INTEGER :: I , J, IJ, I11, I12, I21, I22 - ! IF(I==14 .AND. J==2 .AND. K==6) THEN - ! WRITE(LU_ERR,*) 'CC 1 I,J,K,INB NFACE,NFACE_CELL=',I,J,K,& - ! MESHES(NM)%CUT_FACE(CEI)%NFACE,NFACE_CELL - ! OPEN(666,FILE='VERTS.txt',STATUS='REPLACE') - ! DO IP=1,NVERT_CELL - ! WRITE(666,*) XYZVERT(1:3,IP) - ! ENDDO - ! CLOSE(666) - ! IFACE=MAXVAL(FACE_CELL(1,1:NFACE_CELL)) - ! OPEN(666,FILE='FACES.txt',STATUS='REPLACE') - ! DO IP=1,NFACE_CELL - ! WRITE(666,*) FACE_CELL(1:IFACE+1,IP),FACE_LIST(1,IP) - ! ENDDO - ! CLOSE(666) - ! ENDIF +N_VERTS = NLONG*(NLAT-2) + 2 +N_FACES = (NLAT-2)*NLONG*2 - ! Here we have in XYZvert all the vertices that define the - ! cut-cells within Cartesian cell I,J,K. We have the faces, - ! boundary of said cut-cells in face_cell. - ! We have in face_list the list of cut-cell boundary faces - ! and if they are regular or cut-face. - ! We want to reorder face list, such that we have the - ! subgroups of faces that make cut-cells. +IJ = 0 +DO I = 1, NLAT + LAT = PI/2.0_EB - PI*REAL(I-1,EB)/REAL(NLAT-1,EB) + COSLAT(I) = COS(LAT) + SINLAT(I) = SIN(LAT) +ENDDO +DO I = 1, NLONG + LONG = -PI + 2.0_EB*PI*REAL(I-1,EB)/REAL(NLONG,EB) + COSLONG(I) = COS(LONG) + SINLONG(I) = SIN(LONG) +ENDDO - ! Make list of edges: - EDGFAC_CELL(:,:) = CC_UNDEFINED - FACEDG_CELL(:,:) = CC_UNDEFINED +! define vertices - ! Here reallocate FACEDG_CELL if NFACE_CELL > SIZE_CFELEM_FACEDG: - IF (NFACE_CELL > SIZE_CFELEM_FACEDG) THEN - DFCT = CEILING(REAL(NFACE_CELL-SIZE_CFELEM_FACEDG,EB)/REAL(DELTA_FACE,EB)) - ALLOCATE(FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG+DFCT*DELTA_FACE)); - FACEDG_CELL_AUX = CC_UNDEFINED - ! Copy data into FACEDG_CELL_AUX: - FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & - FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) - ! New SIZE_CFELEM_FACEDG: - SIZE_CFELEM_FACEDG = SIZE_CFELEM_FACEDG + DFCT*DELTA_FACE - DEALLOCATE(FACEDG_CELL); ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) - ! Dump data back into FACEDG_CELL: - FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & - FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) - DEALLOCATE(FACEDG_CELL_AUX) - ENDIF +! north pole - DO IFACE=1,NFACE_CELL - NIEDGE = FACE_CELL(1,IFACE) +SPHERE_VERTS(1:3) = (/0.0_EB,0.0_EB,1.0_EB/) - ! Here reallocate if NIEDGE > SIZE_CEELEM_FACEDG: - IF (NIEDGE > SIZE_CEELEM_FACEDG) THEN - DFCT = CEILING(REAL(NIEDGE-SIZE_CEELEM_FACEDG,EB)/REAL(DELTA_EDGE,EB)) - ALLOCATE(FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG+DFCT*DELTA_EDGE,1:SIZE_CFELEM_FACEDG)); - FACEDG_CELL_AUX = CC_UNDEFINED - ! Copy data into FACEDG_CELL_AUX: - FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & - FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) - ! New SIZE_CEELEM_FACEDG: - SIZE_CEELEM_FACEDG = SIZE_CEELEM_FACEDG + DFCT*DELTA_EDGE - DEALLOCATE(FACEDG_CELL); ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) - ! Dump data back into FACEDG_CELL: - FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & - FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) - DEALLOCATE(FACEDG_CELL_AUX) - DEALLOCATE(IPTS); ALLOCATE(IPTS(1:SIZE_CEELEM_FACEDG+1)) - ENDIF +! middle latitudes - IPTS(1:NIEDGE) = FACE_CELL(2:NIEDGE+1,IFACE); IPTS(NIEDGE+1) = FACE_CELL(2,IFACE) - DO IEDGE=1,NIEDGE - SEG(NOD1:NOD2)= (/ IPTS(IEDGE), IPTS(IEDGE+1) /) - INLIST = .FALSE. - DO ISEG=1,NSEG_CELL - TEST1 = (SEG_CELL(NOD1,ISEG) == SEG(NOD1)) .AND. (SEG_CELL(NOD2,ISEG) == SEG(NOD2)) - TEST2 = (SEG_CELL(NOD2,ISEG) == SEG(NOD1)) .AND. (SEG_CELL(NOD1,ISEG) == SEG(NOD2)) +IJ = 4 +DO I = 2, NLAT-1 + DO J = 1, NLONG + SPHERE_VERTS(IJ:IJ+2) = (/COSLONG(J)*COSLAT(I),SINLONG(J)*COSLAT(I),SINLAT(I)/) + IJ = IJ + 3 + ENDDO +ENDDO - IF ( TEST1 .OR. TEST2 ) THEN - INLIST = .TRUE. - EXIT - ENDIF - enddo - IF (.NOT.INLIST) THEN - NSEG_CELL = NSEG_CELL + 1 +! south pole - ! Test the NSEG_CELL doesn't overrun SIZE_CEELEM_EDGFAC, if so reallocate EDGFAC_CELL: - IF(NSEG_CELL > SIZE_CEELEM_EDGFAC) THEN - ! 1. EDGFAC_CELL: - ALLOCATE(EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC+DELTA_EDGE)); - EDGFAC_CELL_AUX = CC_UNDEFINED - ! Copy data into EDGFAC_CELL_AUX: - EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & - EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) - ! 1. SEG_CELL: - ALLOCATE(SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC+DELTA_EDGE)); SEG_CELL_AUX = CC_UNDEFINED - ! Copy data to SEG_CELL_AUX: - SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) = SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) +SPHERE_VERTS(IJ:IJ+2) = (/0.0_EB,0.0_EB,-1.0_EB/) + +! define faces + +! faces connected to north pole +IJ=1 +DO ILONG = 1, NLONG + I11 = ILONG+1 + I12 = ILONG+2 + I22 = 1 + IF (ILONG==NLONG)I12=2 + SPHERE_FACES(IJ:IJ+2) = (/I22, I11,I12/) + IJ = IJ + 3 +ENDDO - ! New SIZE_CEELEM_EDGFAC: - SIZE_CEELEM_EDGFAC = SIZE_CEELEM_EDGFAC + DELTA_EDGE +DO ILAT = 2, NLAT - 2 + DO ILONG = 1, NLONG - ! 2. EDGFAC_CELL: - DEALLOCATE(EDGFAC_CELL); ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) - ! Dump data back into EDGFAC_CELL: - EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & - EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) - DEALLOCATE(EDGFAC_CELL_AUX) - ! 2. SEG_CELL: - DEALLOCATE(SEG_CELL); ALLOCATE(SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC)) - ! Dump data back into SEG_CELL: - SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) = SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) - DEALLOCATE(SEG_CELL_AUX) - ENDIF - SEG_CELL(NOD1:NOD2,NSEG_CELL) = SEG(NOD1:NOD2) - NEF = 1 - EDGFAC_CELL(1,NSEG_CELL) = NEF - EDGFAC_CELL(NEF+1,NSEG_CELL)= IFACE - FACEDG_CELL(IEDGE,IFACE) = NSEG_CELL - ELSE - NEF = EDGFAC_CELL(1,ISEG) + 1 - ! Test NEF+1 doesn't overrun SIZE_CFELEM_EDGFAC, if so reallocate EDGFAC_CELL: - IF(NEF+1 > SIZE_CFELEM_EDGFAC) THEN - ALLOCATE(EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC+DELTA_FACE,1:SIZE_CEELEM_EDGFAC)); - EDGFAC_CELL_AUX = CC_UNDEFINED - ! Copy data into EDGFAC_CELL_AUX: - EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & - EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) - ! New SIZE_CFELEM_EDGFAC: - SIZE_CFELEM_EDGFAC = SIZE_CFELEM_EDGFAC + DELTA_FACE - DEALLOCATE(EDGFAC_CELL); ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) - ! Dump data back into EDGFAC_CELL: - EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & - EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) - DEALLOCATE(EDGFAC_CELL_AUX) - ENDIF - EDGFAC_CELL(1,ISEG) = NEF - EDGFAC_CELL(NEF+1,ISEG) = IFACE - FACEDG_CELL(IEDGE,IFACE) = ISEG - ENDIF - ENDDO - ENDDO + I11 = 1+ILONG+NLONG*(ILAT+1-2) + I21 = I11 + 1 + I12 = 1+ILONG+NLONG*(ILAT-2) + I22 = I12 + 1 + IF ( ILONG==NLONG) THEN + I21 = 1+1+NLONG*(ILAT+1-2) + I22 = 1+1+NLONG*(ILAT-2) + ENDIF - ! Then loop is on faces that have all regular edges, - ! that is, edges shared with only one another face: - ! Reallocate FACECELL_NUM if NFACE_CELL > SIZE(FACECELL_NUM,DIM=1): - NUM_FACE = SIZE(FACECELL_NUM,DIM=1) - IF (NFACE_CELL > NUM_FACE) THEN - DFCT = CEILING(REAL(NFACE_CELL-NUM_FACE,EB)/REAL(DELTA_FACE,EB)) - DEALLOCATE(FACECELL_NUM); ALLOCATE(FACECELL_NUM(1:NFACE_CELL+DFCT*DELTA_FACE)) - ENDIF + SPHERE_FACES(IJ:IJ+2) = (/I12,I11,I22/) + SPHERE_FACES(IJ+3:IJ+5) = (/I22,I11,I21/) + IJ = IJ + 6 + ENDDO +ENDDO - FACECELL_NUM = 0 - ICELL = 1 - IFACE = 1 - NUM_FACE = NFACE_CELL - CTVAL2 = 0 - MAXSEG = MAXVAL(FACE_CELL(1,1:NFACE_CELL)) - THRES = HUGE(1); IF(REAL(MAXSEG*NFACE_CELL,EB)**2 0 ) CYCLE +! ---------------------------- REFINE_FACE ---------------------------------------- - ! New face, not counted: - FACECELL_NUM(JFACE) = ICELL - NEWFACE = .TRUE. - NUM_FACE = NUM_FACE-1 - EXIT - ENDDO - ENDIF - IF (NEWFACE) THEN - IFACE = JFACE - EXIT - ENDIF - ENDDO +RECURSIVE SUBROUTINE REFINE_FACE(N_LEVELS,IFACE,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) - ! Test for all faces that have regular edges with faces that belong to icell: - IF (.NOT.NEWFACE) THEN - KFACE_LOOP : DO KFACE=1,NFACE_CELL - IF ( FACECELL_NUM(KFACE) == 0 ) THEN ! Not associated yet - NFACEK = FACE_CELL(1,KFACE) - DO ISEG=1,NFACEK - LOCSEG = FACEDG_CELL(ISEG,KFACE) - IF ( EDGFAC_CELL(1,LOCSEG) == 2) THEN ! Found a regular edge - DO JJ=2,EDGFAC_CELL(1,LOCSEG)+1 - JFACE = EDGFAC_CELL(JJ,LOCSEG) - IF ( KFACE == JFACE ) CYCLE - IF ( FACECELL_NUM(JFACE) /= ICELL) CYCLE - ! New face, not counted: - FACECELL_NUM(KFACE) = FACECELL_NUM(JFACE) - NEWFACE = .TRUE. - IFACE = KFACE - NUM_FACE = NUM_FACE-1 - EXIT KFACE_LOOP - ENDDO - ENDIF - ENDDO - ENDIF - ENDDO KFACE_LOOP - ENDIF +INTEGER, INTENT(IN) :: N_LEVELS +INTEGER, INTENT(IN) :: IFACE +INTEGER, INTENT(INOUT) :: N_VERTS, N_FACES +INTEGER, INTENT(IN) :: MAX_VERTS, MAX_FACES +REAL(EB), INTENT(INOUT), TARGET :: SPHERE_VERTS(3*MAX_VERTS) +INTEGER, INTENT(INOUT), TARGET :: SPHERE_FACES(3*MAX_FACES) - ! Haven't found new face, either num_face=0, or we need a new icell: - IF (.NOT.NEWFACE) EXIT INF_LOOP2 - CTVAL = CTVAL + 1 - IF (CTVAL > THRES) THEN - CYCLE_CELL = .TRUE. - EXIT INF_LOOP2 - ENDIF +INTEGER, POINTER, DIMENSION(:) :: FACE1, FACE2, FACE3, FACE4 +REAL(EB), POINTER, DIMENSION(:) :: V1, V2, V3 +REAL(EB), POINTER, DIMENSION(:) :: V12, V13, V23 +INTEGER :: N1, N2, N3, N4 - ENDDO INF_LOOP2 - ! Test if there are any faces left: - IF ( NUM_FACE <= 0 ) THEN - EXIT - ELSE ! New cell, find new face set iface - DO IFACE=1,NFACE_CELL - IF (FACECELL_NUM(IFACE) == 0) THEN ! NOT COUNTED YET. - ! ASSUMES IT HAS AT LEAST ONE REGULAR EDGE. - ICELL = ICELL + 1 - EXIT - ENDIF - ENDDO - IF(IFACE > NFACE_CELL) EXIT INF_LOOP1 ! Case all faces associated. - ENDIF - CTVAL2 = CTVAL2 + 1 - IF (CTVAL2 > THRES) CYCLE_CELL = .TRUE. - IF (CYCLE_CELL) EXIT INF_LOOP1 - ENDDO INF_LOOP1 +IF (N_LEVELS==0 .OR. N_FACES+3>MAX_FACES .OR. N_VERTS+3>MAX_VERTS) RETURN ! prevent memory overwrites - CYCLE_CELL_COND : IF (CYCLE_CELL) THEN - CELLRT(I,J,K) = .TRUE. - MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 - ! Here if needed reallocate SPCELL_LIST: - NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) - IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN - ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) - DEALLOCATE(MESHES(NM)%SPCELL_LIST) - ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED - DEALLOCATE(SPCELL_LIST) - ENDIF - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) - ! Add to cells to block list: - N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK + 1 - CTVAL = SIZE(SPCELLS_TO_BLOCK,DIM=1) - IF( CTVALSPHERE_FACES(3*IFACE-2:3*IFACE) ! original face and 1st new face +FACE2(1:3)=>SPHERE_FACES(3*N_FACES+1:3*N_FACES+3) ! 2nd new face +FACE3(1:3)=>SPHERE_FACES(3*N_FACES+4:3*N_FACES+6) ! 3rd new face +FACE4(1:3)=>SPHERE_FACES(3*N_FACES+7:3*N_FACES+9) ! 4th new face - IDCF = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) - NIBFACE = 0 - NFACE_CELL = N_GAS_CFACES + NIBFACE - IDCF_COND : IF (IDCF > 0) THEN - IBOD = 1; ITRI = 1 - IF (MESHES(NM)%CUT_FACE(IDCF)%NFACE > 0) THEN - IBOD = MESHES(NM)%CUT_FACE(IDCF)%BODTRI(1,1) - ITRI = MESHES(NM)%CUT_FACE(IDCF)%BODTRI(2,1) - ENDIF - CALL FACE_DEALLOC(NM,IDCF) - CALL NEW_FACE_ALLOC(NM,IDCF,8,6,4+1) ! Reallocate CUT_FACE entry with 8 vertices, 6 faces, 4 verts per face. - NIBFACE = 0 - XYZVERT = 0._EB - NVERT_CELL = 0 - CFELEM = 0 - ! Define from SOLID FACES CFACES for the cell: - IED = I-1; JED = J-1; KED = K-1 - AXIS_LOOP : DO MYAXIS=IAXIS,KAXIS - SELECT CASE(MYAXIS) - CASE(IAXIS) - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) - AREAI = DYCELL(J) * DZCELL(K) - CASE(JAXIS) - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) - AREAI = DXCELL(I) * DZCELL(K) - CASE(KAXIS) - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - AREAI = DXCELL(I) * DYCELL(J) - END SELECT +V1(1:3)=>SPHERE_VERTS(3*FACE1(1)-2:3*FACE1(1)) ! FACE1(1) +V2(1:3)=>SPHERE_VERTS(3*FACE1(2)-2:3*FACE1(2)) ! FACE1(2) +V3(1:3)=>SPHERE_VERTS(3*FACE1(3)-2:3*FACE1(3)) ! FACE1(3) - SIDE_LOOP : DO SIDE=LOW_IND,HIGH_IND - IF (FSID_XYZ(SIDE ,MYAXIS) /= CC_SOLID) CYCLE SIDE_LOOP - NIBFACE = NIBFACE + 1 - ! Define vertices of CFACE and insert add to MESHES(NM)%CUT_FACE(IDCF)%XYZVERT - NP = 0 - XYZC(IAXIS:KAXIS) = 0._EB - DO IP=NOD1,NOD4 - ! xl,yl,zl - XYZ(IAXIS:KAXIS) = XYZLH(IAXIS:KAXIS,IP,SIDE) - XYZC(IAXIS:KAXIS)= XYZC(IAXIS:KAXIS) + XYZ(IAXIS:KAXIS) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) - NP = NP + 1 - CFELEM(1) = NP - CFELEM(NP+1) = INOD - ENDDO +V12(1:3)=>SPHERE_VERTS(3*N_VERTS+1:3*N_VERTS+3) +V13(1:3)=>SPHERE_VERTS(3*N_VERTS+4:3*N_VERTS+6) +V23(1:3)=>SPHERE_VERTS(3*N_VERTS+7:3*N_VERTS+9) - ! Define CFELEM connectivity, also CFACE area and Centroid add to corresponding CUT_FACE(IDCF) entries. - MESHES(NM)%CUT_FACE(IDCF)%CFELEM(1:5,NIBFACE) = CFELEM(1:5) - MESHES(NM)%CUT_FACE(IDCF)%AREA(NIBFACE) = AREAI - MESHES(NM)%CUT_FACE(IDCF)%XYZCEN(IAXIS:KAXIS,NIBFACE) = 0.25_EB*XYZC(IAXIS:KAXIS) - ! Fields for cut-cell volume/centroid computation: - MESHES(NM)%CUT_FACE(IDCF)%INXAREA(NIBFACE) = 0._EB - MESHES(NM)%CUT_FACE(IDCF)%INXSQAREA(NIBFACE) = 0._EB - MESHES(NM)%CUT_FACE(IDCF)%JNYSQAREA(NIBFACE) = 0._EB - MESHES(NM)%CUT_FACE(IDCF)%KNZSQAREA(NIBFACE) = 0._EB +V12 = (V1+V2)/2.0_EB +V13 = (V1+V3)/2.0_EB +V23 = (V2+V3)/2.0_EB +V12 = V12/NORM2(V12) ! N_VERTS + 1 +V13 = V13/NORM2(V13) ! N_VERTS + 2 +V23 = V23/NORM2(V23) ! N_VERTS + 3 - ! Define Body-triangle reference: - MESHES(NM)%CUT_FACE(IDCF)%BODTRI(1:2,NIBFACE)= (/ IBOD, ITRI /) +! split triangle 123 into 4 triangles - ! Assign surf-index: Depending on GEOMETRY: - ! Here we might just add the INERT SURF_ID: - MESHES(NM)%CUT_FACE(IDCF)%SURF_INDEX(NIBFACE) = GEOMETRY(IBOD)%SURFS(ITRI) +! 1 +! /F1\ . +! 12----13 +! /F2\F3/F4\ i. +! 2 --- 23----3 - ! Finally add to FACE_LIST from N_GAS_CFACES on: - NFACE_CELL = N_GAS_CFACES + NIBFACE - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB,0,0,IDCF, NIBFACE,CC_UNDEFINED /) - ENDDO SIDE_LOOP - ENDDO AXIS_LOOP - IF(NIBFACE==0) THEN - MESHES(NM)%CUT_FACE(IDCF)%STATUS = CC_SOLID - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED - ELSE - MESHES(NM)%CUT_FACE(IDCF)%NFACE = NIBFACE - MESHES(NM)%CUT_FACE(IDCF)%NVERT = NVERT_CELL - MESHES(NM)%CUT_FACE(IDCF)%XYZVERT(IAXIS:KAXIS,1:NVERT_CELL) = XYZVERT(IAXIS:KAXIS,1:NVERT_CELL) - ENDIF - ENDIF IDCF_COND +FACE2(1:3) = (/N_VERTS+1,FACE1(2),N_VERTS+3/) +FACE3(1:3) = (/N_VERTS+1,N_VERTS+3,N_VERTS+2/) +FACE4(1:3) = (/N_VERTS+2,N_VERTS+3,FACE1(3)/) +FACE1(1:3) = (/ FACE1(1),N_VERTS+1,N_VERTS+2/) - ! Now define a coarse cut-cell (no INBOUNDARY cut-faces): - NCELL = 1 - ! Test NFACE_CELL not > SIZE_FACE_CCELEM: - IF (NFACE_CELL > SIZE_FACE_CCELEM) THEN - DFCT = CEILING(REAL(NFACE_CELL-SIZE_FACE_CCELEM,EB)/REAL(DELTA_FACE,EB)) - SIZE_FACE_CCELEM = SIZE_FACE_CCELEM + DFCT*DELTA_FACE - DEALLOCATE(CCELEM) - ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) - ENDIF - CCELEM(1:NFACE_CELL+1,NCELL) = (/ NFACE_CELL, (IFACE, IFACE=1,NFACE_CELL) /) - VOL(NCELL) = DXCELL(I)*DYCELL(J)*DZCELL(K) - NOADVANCE(NCELL) = NOT_BLOCKED - XYZCEN(IAXIS:KAXIS,NCELL) = (/ XCELL(I), YCELL(J), ZCELL(K) /) +N1 = IFACE +N2 = N_FACES+1 +N3 = N_FACES+2 +N4 = N_FACES+3 - ELSE CYCLE_CELL_COND +N_FACES = N_FACES + 3 +N_VERTS = N_VERTS + 3 +IF (N_LEVELS==1) RETURN ! stop recursion - ! Create CCELEM array: - NCELL = MAXVAL(FACECELL_NUM(:)) - ! Test NCELL not > SIZE_CELL_CCELEM; NFACE_CELL not > SIZE_FACE_CCELEM: - IF (NFACE_CELL > SIZE_FACE_CCELEM) THEN - DFCT = CEILING(REAL(NFACE_CELL-SIZE_FACE_CCELEM,EB)/REAL(DELTA_FACE,EB)) - SIZE_FACE_CCELEM = SIZE_FACE_CCELEM + DFCT*DELTA_FACE - DEALLOCATE(CCELEM) - ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) - ENDIF - IF (NCELL > SIZE_CELL_CCELEM) THEN - DFCT = CEILING(REAL(NCELL-SIZE_CELL_CCELEM,EB)/REAL(DELTA_CELL,EB)) - SIZE_CELL_CCELEM = SIZE_CELL_CCELEM + DFCT*DELTA_CELL - DEALLOCATE(CCELEM,NOADVANCE,VOL,XYZCEN) - ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) - ALLOCATE(NOADVANCE(1:SIZE_CELL_CCELEM),VOL(1:SIZE_CELL_CCELEM),XYZCEN(IAXIS:KAXIS,1:SIZE_CELL_CCELEM)) - ENDIF - CCELEM= CC_UNDEFINED - DO ICELL=1,NCELL - NP = 0 - DO IFACE=1,NFACE_CELL - IF ( FACECELL_NUM(IFACE) == ICELL ) THEN - NP = NP + 1 - CCELEM(1,ICELL) = NP - CCELEM(NP+1,ICELL) = IFACE - ENDIF - ENDDO - ENDDO +CALL REFINE_FACE(N_LEVELS-1,N1,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +CALL REFINE_FACE(N_LEVELS-1,N2,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +CALL REFINE_FACE(N_LEVELS-1,N3,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +CALL REFINE_FACE(N_LEVELS-1,N4,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) - ! Compute volumes and centroids for the found cut-cells: - VOL(1:NCELL) = 0._EB - NOADVANCE(1:NCELL) = NOT_BLOCKED - XYZCEN(IAXIS:KAXIS,1:NCELL) = 0._EB - DO ICELL=1,NCELL - NP = CCELEM(1,ICELL) - DO II=2,NP+1 - IFACE = CCELEM(II,ICELL) - ! Volume: - VOL(ICELL) = VOL(ICELL) + AREAVARS(1,IFACE) - ! xyzcen: - XYZCEN(IAXIS:KAXIS,ICELL) = XYZCEN(IAXIS:KAXIS,ICELL)+AREAVARS(2:4,IFACE) - ENDDO - VOL(ICELL) = ABS(VOL(ICELL)) +END SUBROUTINE REFINE_FACE - ! Define if cut-cell is very small -> NOADVANCE(ICELL)=BLOCKED_SMALL_CELL: - IF(DO_NOADVANCE .AND. VOL(ICELL)/(DXCELL(I)*DYCELL(J)*DZCELL(K))DXCELL(I)*DYCELL(J)*DZCELL(K)) VOL(ICELL) = DXCELL(I)*DYCELL(J)*DZCELL(K) - IF(VOL(ICELL) < GEOMEPS) THEN ! Volume too small for correct calculation of XYZCEN-> take cartcell centroid. - IF(.NOT.DO_NOADVANCE .AND. VOL(ICELL)XFACE(I)) XYZCEN(IAXIS,ICELL) = XCELL(I) - IF(XYZCEN(JAXIS,ICELL)YFACE(J)) XYZCEN(JAXIS,ICELL) = YCELL(J) - IF(XYZCEN(KAXIS,ICELL)ZFACE(K)) XYZCEN(KAXIS,ICELL) = ZCELL(K) - ENDIF - ENDDO +! ---------------------------- COMPUTE_TEXTURE ---------------------------------------- - ENDIF CYCLE_CELL_COND +SUBROUTINE COMPUTE_TEXTURE(XYZ,TEXT_COORDS) +REAL(EB), INTENT(IN), DIMENSION(3) :: XYZ +REAL(EB), INTENT(OUT), DIMENSION(2) :: TEXT_COORDS +REAL(EB), DIMENSION(2) :: ANGLES +REAL(EB) :: NORM2_XYZ, Z_ANGLE - ! Load into CUT_CELL data structure - NCUTCELL = MESHES(NM)%N_CUTCELL_MESH + MESHES(NM)%N_GCCUTCELL_MESH + 1 - IF (IBNDINT==LOW_IND) THEN - MESHES(NM)%N_CUTCELL_MESH = NCUTCELL - ELSE - MESHES(NM)%N_GCCUTCELL_MESH = MESHES(NM)%N_GCCUTCELL_MESH + 1 - ENDIF - MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = NCUTCELL +NORM2_XYZ = NORM2(XYZ) +IF (NORM2_XYZ < TWENTY_EPSILON_EB) THEN + Z_ANGLE = 0.0_EB +ELSE + Z_ANGLE = ASIN(XYZ(3)/NORM2_XYZ) +ENDIF +ANGLES = (/ATAN2(XYZ(2),XYZ(1)),Z_ANGLE/) - ! Resize array MESHES(NM)%CUT_CELL if necessary: - CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) +!convert back to texture coordinates +TEXT_COORDS = (/ 0.5_EB + 0.5_EB*ANGLES(1)/PI,0.5_EB + ANGLES(2)/PI /) +END SUBROUTINE COMPUTE_TEXTURE - ! Add cut-cell NCUTCELL entry: - MESHES(NM)%CUT_CELL(NCUTCELL)%IJK(IAXIS:KAXIS) = (/ I, J, K /) - MESHES(NM)%CUT_CELL(NCUTCELL)%NCELL = NCELL - MESHES(NM)%CUT_CELL(NCUTCELL)%NFACE_CELL= NFACE_CELL - NCFACE_CUTCELL = MAXVAL(CCELEM(1,1:NCELL)) + 1 - CALL NEW_CELL_ALLOC(NM,NCUTCELL,NCELL,NFACE_CELL,NCFACE_CUTCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%CCELEM(1:NCFACE_CUTCELL,1:NCELL) = CCELEM(1:NCFACE_CUTCELL,1:NCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) = & - FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%VOLUME(1:NCELL) = VOL(1:NCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%XYZCEN(IAXIS:KAXIS,1:NCELL) = XYZCEN(IAXIS:KAXIS,1:NCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%NOADVANCE(1:NCELL) = NOADVANCE(1:NCELL) +! ---------------------------- GET_GEOM_ID ---------------------------------------- - ! Test for sliver cells blocking: - XYZCELL(IAXIS,LOW_IND) = XFACE(I-1); XYZCELL(IAXIS,HIGH_IND) = XFACE(I); - XYZCELL(JAXIS,LOW_IND) = YFACE(J-1); XYZCELL(JAXIS,HIGH_IND) = YFACE(J); - XYZCELL(KAXIS,LOW_IND) = ZFACE(K-1); XYZCELL(KAXIS,HIGH_IND) = ZFACE(K); - MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) - MINMAX_XYZ_CC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) - DO JCC=1,NCELL - ! Get cut-cell bounding box: - CALL CUT_CELL_BOUNDING_BOX(NM,NCUTCELL,JCC,XYZCELL,MINMAX_XYZ_CC) - ! Perform Tests: - DO MYAXIS=IAXIS,KAXIS - CELL_DELTA(MYAXIS) = ABS(MINMAX_XYZ_CC(MYAXIS,HIGH_IND)-MINMAX_XYZ_CC(MYAXIS,LOW_IND)) - ENDDO - ! Axis with minimum width: - AX_MIN = MINLOC(CELL_DELTA(IAXIS:KAXIS),DIM=1) - SELECT CASE(AX_MIN) - CASE(IAXIS); AX_OTHERS(1:2) = (/ JAXIS, KAXIS /); - CASE(JAXIS); AX_OTHERS(1:2) = (/ IAXIS, KAXIS /); - CASE(KAXIS); AX_OTHERS(1:2) = (/ IAXIS, JAXIS /); - END SELECT - ! Perform Test: - BLOCK_SLIM_IF = (CELL_DELTA(AX_MIN)GEOMETRY(N) + IF (TRIM(G%ID)==TRIM(ID)) THEN + GET_GEOM_ID = N + RETURN + ENDIF +ENDDO +END FUNCTION GET_GEOM_ID + +! ---------------------------- GEOMCLIPS ---------------------------------------- + +SUBROUTINE GEOMCLIPS +USE BOXTETRA_ROUTINES, ONLY : GEOMCLIP +REAL(EB) :: XB(6) +INTEGER :: I +TYPE(GEOMETRY_TYPE), POINTER :: G + + ! clip geometries to mesh + +XB(1)=-1.0 +XB(2)=0.0 +XB(3)=-1.0 +XB(4)=0.0 +XB(5)=0.0 +XB(6)=1.0 +DO I = 1, N_GEOMETRY + G=>GEOMETRY(I) + CALL GEOMCLIP(G%VERTS, G%N_VERTS, G%FACES, G%N_FACES, XB) +END DO +END SUBROUTINE GEOMCLIPS + +! ---------------------------- PROCESS_GEOM ---------------------------------------- + +SUBROUTINE PROCESS_GEOM(IS_DYNAMIC,TIME, N_VERTS, N_FACES, N_VOLUS) - ! IF((NM==3 .AND. I==4 .AND. J==6 .AND. K==36)) THEN - ! WRITE(LU_ERR,*) 'Found LARGE CUTCELL=',& - ! MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH+1,VOL(1),SIZE(XYZVERT,DIM=2) - ! WRITE(LU_ERR,*) 'CC 1 I,J,K,INB NFACE,NFACE_CELL=',I,J,K,& - ! MESHES(NM)%CUT_FACE(CEI)%NFACE,NFACE_CELL,':',MESHES(NM)%CUT_CELL(NCUTCELL)%NCELL,CYCLE_CELL - ! OPEN(666,FILE='VERTS.txt',STATUS='REPLACE') - ! DO IP=1,NVERT_CELL - ! WRITE(666,*) XYZVERT(1:3,IP) - ! ENDDO - ! CLOSE(666) - ! IFACE=MAXVAL(FACE_CELL(1,1:NFACE_CELL)) - ! OPEN(666,FILE='FACES.txt',STATUS='REPLACE') - ! DO IP=1,NFACE_CELL - ! WRITE(666,*) FACE_CELL(1:IFACE+1,IP),FACE_LIST(1,IP) - ! ENDDO - ! CLOSE(666) - ! ENDIF +USE GEOMETRY_FUNCTIONS, ONLY: TRANSFORM_COORDINATES - ENDDO ! I - ENDDO ! J -ENDDO ! K +! transform (scale, rotate and translate) vectors found on each &GEOM line -ENDDO IBNDINT_LOOP + LOGICAL, INTENT(IN) :: IS_DYNAMIC + REAL(EB), INTENT(IN) :: TIME + INTEGER, INTENT(OUT) :: N_VERTS, N_FACES, N_VOLUS -DEALLOCATE(IJK_COUNT) -DEALLOCATE(EDGFAC_CELL, SEG_CELL) -DEALLOCATE(FACEDG_CELL, IPTS) -DEALLOCATE(CCELEM,VOL,XYZCEN) -DEALLOCATE(FACE_CELL,FACE_LIST,AREAVARS,FACECELL_NUM,FACE_CELL_DUM) + INTEGER :: I, IVERT, IMOVE, MOVE_INDEX, IFACE + TYPE(GEOMETRY_TYPE), POINTER :: G + REAL(EB) :: DELTA_T, VEC(1:3) ! M(3,3) + TYPE(MOVEMENT_TYPE), POINTER :: MV -T_CC_USED(GET_CARTCELL_CUTCELLS_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW + IF (IS_DYNAMIC) THEN + DELTA_T = TIME - T_BEGIN + ELSE + DELTA_T = 0.0_EB + ENDIF -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - NCUTCEL = 0 - DO ICELL=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - NCUTCEL = NCUTCEL + MESHES(NM)%CUT_CELL(ICELL)%NCELL + DO I = 1, N_GEOMETRY + G=>GEOMETRY(I) + IF ((IS_DYNAMIC .AND. G%IS_DYNAMIC) .OR. (.NOT.IS_DYNAMIC .AND. .NOT.G%IS_DYNAMIC)) THEN + G%N_VERTS = G%N_VERTS_BASE + G%N_FACES = G%N_FACES_BASE + G%N_VOLUS = G%N_VOLUS_BASE + ENDIF ENDDO - WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-cells mesh/gc : ',NCUTCEL,'. ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-cells mesh/gc : ',NCUTCEL,'. ' - ENDIF -ENDIF -RETURN + DO I = 1, N_GEOMETRY + G=>GEOMETRY(I) + IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE + IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE + MOVE_INDEX = 0 + IF (TRIM(G%MOVE_ID)/='null') THEN + DO IMOVE=1,N_MOVE + IF (TRIM(G%MOVE_ID)==TRIM(MOVEMENT(IMOVE)%ID)) THEN + MOVE_INDEX = MOVEMENT(IMOVE)%INDEX + EXIT + ENDIF + ENDDO + IF (MOVE_INDEX==0) THEN + WRITE(MESSAGE,'(A,A,A)') 'ERROR(725): &GEOM ',TRIM(G%ID),' MOVE_ID is not recognized' + CALL SHUTDOWN(MESSAGE) ; RETURN + ENDIF + DO IVERT=1,G%N_VERTS + VEC(1:3) = G%VERTS_BASE(3*IVERT-2:3*IVERT) + CALL TRANSFORM_COORDINATES(VEC(1),VEC(2),VEC(3),MOVE_INDEX,1) ! Eventually, time varying motion dealt with here. + G%VERTS(3*IVERT-2:3*IVERT) = VEC(1:3) + ENDDO + ! Swap face connectivities if we have reflections: + MV => MOVEMENT(MOVE_INDEX) + IF (MV%DET < -TWENTY_EPSILON_EB) THEN ! Swap vertices 2 and 3: + DO IFACE=1,G%N_FACES + IVERT = G%FACES(3*(IFACE-1)+2) + G%FACES(3*(IFACE-1)+2) = G%FACES(3*(IFACE-1)+3) + G%FACES(3*(IFACE-1)+3) = IVERT + ENDDO + ENDIF + ELSE + DO IVERT=1,G%N_VERTS + G%VERTS(3*IVERT-2:3*IVERT) = G%VERTS_BASE(3*IVERT-2:3*IVERT) + ENDDO + ENDIF -CONTAINS + ENDDO -SUBROUTINE REALLOCATE_LOCAL_FC_VARS + ! remove this if statement when GEOMCLIPS is ready for use + IF ( I .EQ. 0 ) THEN + CALL GEOMCLIPS + ENDIF -IF (NFACE_CELL > SIZE_CFELEM_FC) THEN - ! FACE_LIST, AREAVARS, FACE_CELL - ALLOCATE(FACE_LIST_AUX(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC+DELTA_FACE)); - FACE_LIST_AUX=CC_UNDEFINED - ALLOCATE(AREAVARS_AUX(1:MAX_DIM+1,1:SIZE_CFELEM_FC+DELTA_FACE)); AREAVARS_AUX = 0._EB - ALLOCATE(FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC+DELTA_FACE)); - FACE_CELL_AUX=CC_UNDEFINED - ! Assign: - FACE_LIST_AUX(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)= & - FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC) - AREAVARS_AUX(1:MAX_DIM+1,1:SIZE_CFELEM_FC) = AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC) - FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) = & - FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) - ! Reallocate: - SIZE_CFELEM_FC = SIZE_CFELEM_FC + DELTA_FACE - DEALLOCATE(FACE_LIST,AREAVARS,FACE_CELL); - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)) - ALLOCATE(AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC)) - ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) - ! Dump back data: - FACE_LIST(:,:) = FACE_LIST_AUX(:,:) - AREAVARS(:,:) = AREAVARS_AUX(:,:) - FACE_CELL(:,:) = FACE_CELL_AUX(:,:) - DEALLOCATE(FACE_LIST_AUX,AREAVARS_AUX,FACE_CELL_AUX) -ENDIF -RETURN -END SUBROUTINE REALLOCATE_LOCAL_FC_VARS + CALL GEOM2TEXTURE -SUBROUTINE REALLOCATE_FACE_CELL_VERTS + N_VERTS = 0 + N_FACES = 0 + N_VOLUS = 0 + DO I = 1, N_GEOMETRY ! count vertices and faces + G=>GEOMETRY(I) + IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE + IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE + N_VERTS = N_VERTS + G%N_VERTS + N_FACES = N_FACES + G%N_FACES + N_VOLUS = N_VOLUS + G%N_VOLUS + ENDDO -IF (NP+1 > SIZE_VERTS_FC) THEN - DFCT=CEILING(REAL(NP+1-SIZE_VERTS_FC,EB)/REAL(DELTA_VERT,EB)) - ALLOCATE(FACE_CELL_AUX(1:SIZE_VERTS_FC+DFCT*DELTA_VERT,1:SIZE_CFELEM_FC)); - FACE_CELL_AUX=CC_UNDEFINED - ! Assign: - FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) = & - FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) - ! Reallocate: - SIZE_VERTS_FC = SIZE_VERTS_FC + DFCT*DELTA_VERT - DEALLOCATE(FACE_CELL); ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) - FACE_CELL(:,:) = FACE_CELL_AUX(:,:) - DEALLOCATE(FACE_CELL_AUX) - ! Now FACE_CELL_DUM: - DEALLOCATE(FACE_CELL_DUM); ALLOCATE(FACE_CELL_DUM(1:SIZE_VERTS_FC)) -ENDIF +END SUBROUTINE PROCESS_GEOM -RETURN -END SUBROUTINE REALLOCATE_FACE_CELL_VERTS +! ---------------------------- GEOM2TEXTURE ---------------------------------------- -END SUBROUTINE GET_CARTCELL_CUTCELLS +SUBROUTINE GEOM2TEXTURE + INTEGER :: I,J,K,JJ + TYPE(GEOMETRY_TYPE), POINTER :: G + REAL(EB), POINTER, DIMENSION(:) :: XYZ, TFACES + INTEGER, POINTER, DIMENSION(:) :: FACES + INTEGER :: SURF_INDEX + TYPE(SURFACE_TYPE), POINTER :: SF + DO I = 1, N_GEOMETRY + G=>GEOMETRY(I) + IF (G%TEXTURE_MAPPING/='RECTANGULAR') CYCLE + DO J = 0, G%N_FACES-1 + SURF_INDEX = G%SURFS(1+J) + SF=>SURFACE(SURF_INDEX) + IF (TRIM(SF%TEXTURE_MAP)=='null') CYCLE + FACES(1:3)=>G%FACES(1+3*J:3+3*J) + TFACES(1:6)=>G%TFACES(1+6*J:6+6*J) + DO K = 0, 2 + JJ = FACES(1+K) -! ------------------------ CUT_CELL_BOUNDING_BOX ------------------------------------ + XYZ(1:3) => G%VERTS(3*JJ-2:3*JJ) + TFACES(1+2*K:2+2*K) = (XYZ(1:2) - G%TEXTURE_ORIGIN(1:2))/G%TEXTURE_SCALE(1:2) + ENDDO + ENDDO + ENDDO +END SUBROUTINE GEOM2TEXTURE -SUBROUTINE CUT_CELL_BOUNDING_BOX(NM,ICC,JCC,XYZCELL,MINMAX_XYZ_JCC) +! ---------------------------- MERGE_GEOMS ---------------------------------------- -! Computes bounding box for cut-cell (ICC,JCC) in mesh NM. -! Underlaying cartesian cell bounds XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND) has to be provided. +SUBROUTINE MERGE_GEOMS(VERTS,N_VERTS,FACES,TFACES,GEOM_IDS,SURF_IDS,N_FACES,VOLUS,MATL_IDS,N_VOLUS,IS_DYNAMIC) -INTEGER, INTENT(IN) :: NM,ICC,JCC -REAL(EB),INTENT(IN) :: XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND) -REAL(EB),INTENT(OUT):: MINMAX_XYZ_JCC(IAXIS:KAXIS,LOW_IND:HIGH_IND) +! combine vectors and faces found on all &GEOM lines into one set of VECTOR and FACE arrays -! Local Variables: -INTEGER :: IFC,IFACE,LOHI,HILO,X1AXIS,IFCX,JFCX,IVERT,AXIS -REAL(EB):: XYZFACE(IAXIS:KAXIS,LOW_IND:HIGH_IND),XYZ(IAXIS:KAXIS) -TYPE(CC_CUTCELL_TYPE), POINTER :: CC -TYPE(CC_CUTFACE_TYPE), POINTER :: CF +INTEGER, INTENT(IN) :: N_VERTS, N_FACES, N_VOLUS +LOGICAL, INTENT(IN) :: IS_DYNAMIC +REAL(EB), DIMENSION(:), INTENT(OUT) :: VERTS(3*N_VERTS), TFACES(6*N_FACES) +INTEGER, DIMENSION(:), INTENT(OUT) :: FACES(3*N_FACES), VOLUS(4*N_VOLUS), MATL_IDS(N_VOLUS), GEOM_IDS(N_FACES), SURF_IDS(N_FACES) -CC => MESHES(NM)%CUT_CELL(ICC) +INTEGER :: I +TYPE(GEOMETRY_TYPE), POINTER :: G +INTEGER :: IVERT, ITFACE, IFACE, IVOLUS, IMATL, IGEOM, ISURF, OFFSET -! Get cut-cell bounding box: -MINMAX_XYZ_JCC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) -MINMAX_XYZ_JCC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) -DO IFC=1,CC%CCELEM(1,JCC) ! Loop over cut-faces boundary of this cell. - IFACE=CC%CCELEM(IFC+1,JCC) - LOHI = CC%FACE_LIST(2,IFACE) - HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND - X1AXIS = CC%FACE_LIST(3,IFACE) - IFCX = CC%FACE_LIST(4,IFACE) - JFCX = CC%FACE_LIST(5,IFACE) +IVERT = 0 +ITFACE = 0 +IFACE = 0 +IVOLUS = 0 +IGEOM = 0 +ISURF = 0 +IMATL = 0 +OFFSET = 0 +DO I = 1, N_GEOMETRY + G=>GEOMETRY(I) + IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE + IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE - SELECT CASE(CC%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_RCGAS) ! Regular Gas face with a regular cell on one side and a cut-cell on the other. - XYZFACE = XYZCELL; XYZFACE(X1AXIS,HILO) = XYZFACE(X1AXIS,LOHI) ! Same location in X1AXIS for both sides of face. - DO AXIS=IAXIS,KAXIS - MINMAX_XYZ_JCC(AXIS,LOW_IND) = MIN(MINMAX_XYZ_JCC(AXIS,LOW_IND) ,XYZFACE(AXIS,LOW_IND)) - MINMAX_XYZ_JCC(AXIS,HIGH_IND)= MAX(MINMAX_XYZ_JCC(AXIS,HIGH_IND),XYZFACE(AXIS,HIGH_IND)) - ENDDO + IF (G%N_VERTS>0) THEN + VERTS(1+IVERT:3*G%N_VERTS+IVERT) = G%VERTS(1:3*G%N_VERTS) + IVERT = IVERT + 3*G%N_VERTS + ENDIF + IF (G%N_FACES>0) THEN + FACES(1+IFACE:3*G%N_FACES + IFACE) = G%FACES(1:3*G%N_FACES)+OFFSET + IFACE = IFACE + 3*G%N_FACES - CASE(CC_FTYPE_CFGAS,CC_FTYPE_CFINB) ! GAS or Boundary cut-face: - CF => MESHES(NM)%CUT_FACE(IFCX) - DO IVERT=1,CF%CFELEM(1,JFCX) - XYZ(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(IVERT+1,JFCX)) - DO AXIS=IAXIS,KAXIS - MINMAX_XYZ_JCC(AXIS,LOW_IND) = MIN(MINMAX_XYZ_JCC(AXIS,LOW_IND) ,XYZ(AXIS)) - MINMAX_XYZ_JCC(AXIS,HIGH_IND)= MAX(MINMAX_XYZ_JCC(AXIS,HIGH_IND),XYZ(AXIS)) - ENDDO - ENDDO + TFACES(1+ITFACE:6*G%N_FACES + ITFACE) = G%TFACES(1:6*G%N_FACES) + ITFACE = ITFACE + 6*G%N_FACES - END SELECT -ENDDO + GEOM_IDS(1+IGEOM:G%N_FACES+IGEOM) = I + IGEOM = IGEOM + G%N_FACES -END SUBROUTINE CUT_CELL_BOUNDING_BOX + SURF_IDS(1+ISURF:G%N_FACES+ISURF) = G%SURFS(1:G%N_FACES) + ISURF = ISURF + G%N_FACES + ENDIF + IF (G%N_VOLUS>0) THEN + VOLUS(1+IVOLUS:4*G%N_VOLUS + IVOLUS) = G%VOLUS(1:4*G%N_VOLUS)+OFFSET + IVOLUS = IVOLUS + 4*G%N_VOLUS + MATL_IDS(1+IMATL:G%N_VOLUS+IMATL) = G%MATLS(1:G%N_VOLUS) + IMATL = IMATL + G%N_VOLUS + ENDIF + OFFSET = OFFSET + G%N_VERTS +ENDDO -! -------------------------CUT_CELL_ARRAY_REALLOC------------------------------------ +END SUBROUTINE MERGE_GEOMS -SUBROUTINE CUT_CELL_ARRAY_REALLOC(NM,ICC) +! ---------------------------- CONVERTGEOM ---------------------------------------- -INTEGER, INTENT(IN) :: NM,ICC +SUBROUTINE CONVERTGEOM(TIME) -! Local Variables: -INTEGER :: ICC1,SIZE_CUT_CELL +REAL(EB), INTENT(IN) :: TIME -! Here test if we need to reallocate cut-cell: -SIZE_CUT_CELL = SIZE(MESHES(NM)%CUT_CELL,DIM=1) -IF (ICC > SIZE_CUT_CELL) THEN - ALLOCATE(CUT_CELL_AUX(SIZE_CUT_CELL+GLOBAL_DELTA_CELL)) - DO ICC1=1,ICC-1 - CALL CUT_CELL_MOVE(MESHES(NM)%CUT_CELL(ICC1),CUT_CELL_AUX(ICC1)) - ENDDO - CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL) -ENDIF +INTEGER :: N_VERTS, N_FACES, N_VOLUS +INTEGER :: N_VERTS_S, N_FACES_S, N_VOLUS_S +INTEGER :: N_VERTS_D, N_FACES_D, N_VOLUS_D +INTEGER, ALLOCATABLE, DIMENSION(:) :: VOLUS, FACES, MATL_IDS, SURF_IDS, GEOM_IDS +REAL(EB), ALLOCATABLE, DIMENSION(:) :: VERTS, TFACES +INTEGER :: IZERO -RETURN -END SUBROUTINE CUT_CELL_ARRAY_REALLOC +CALL PROCESS_GEOM(.FALSE.,TIME, N_VERTS_S, N_FACES_S, N_VOLUS_S) ! scale, rotate, translate static GEOM vertices +CALL PROCESS_GEOM( .TRUE.,TIME, N_VERTS_D, N_FACES_D, N_VOLUS_D) ! scale, rotate, translate dynamic GEOM vertices -! ------------------------ CUT_CELL_MOVE ----------------------------------- +N_VERTS = N_VERTS_S + N_VERTS_D +N_FACES = N_FACES_S + N_FACES_D +N_VOLUS = N_VOLUS_S + N_VOLUS_D -SUBROUTINE CUT_CELL_MOVE(CUT_CELL_FROM,CUT_CELL_TO) +ALLOCATE(VERTS(MAX(1,3*N_VERTS)),STAT=IZERO) ! create arrays to contain all vertices and faces +CALL ChkMemErr('CONVERTGEOM','VERTS',IZERO) -TYPE(CC_CUTCELL_TYPE), INTENT(INOUT) :: CUT_CELL_FROM,CUT_CELL_TO +ALLOCATE(TFACES(MAX(1,6*N_FACES)),STAT=IZERO) ! create arrays to contain all vertices and faces +CALL ChkMemErr('CONVERTGEOM','TVERTS',IZERO) -CUT_CELL_TO%NCELL = CUT_CELL_FROM%NCELL -CUT_CELL_TO%NFACE_CELL = CUT_CELL_FROM%NFACE_CELL -CUT_CELL_TO%NFACE_DROPPED = CUT_CELL_FROM%NFACE_DROPPED -CUT_CELL_TO%IJK = CUT_CELL_FROM%IJK +ALLOCATE(FACES(MAX(1,3*N_FACES)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','FACES',IZERO) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%CCELEM ,TO=CUT_CELL_TO%CCELEM) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%FACE_LIST ,TO=CUT_CELL_TO%FACE_LIST) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%FACE_LIST_DROPPED,TO=CUT_CELL_TO%FACE_LIST_DROPPED) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%IJK_LINK ,TO=CUT_CELL_TO%IJK_LINK) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%LINK_LEV ,TO=CUT_CELL_TO%LINK_LEV) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%VOLUME ,TO=CUT_CELL_TO%VOLUME) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%XYZCEN ,TO=CUT_CELL_TO%XYZCEN) +ALLOCATE(SURF_IDS(MAX(1,N_FACES)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','SURF_IDS',IZERO) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHO ,TO=CUT_CELL_TO%RHO) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHOS ,TO=CUT_CELL_TO%RHOS) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RSUM ,TO=CUT_CELL_TO%RSUM) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%TMP ,TO=CUT_CELL_TO%TMP) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%D ,TO=CUT_CELL_TO%D) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DS ,TO=CUT_CELL_TO%DS) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DVOL ,TO=CUT_CELL_TO%DVOL) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DVOL_PR ,TO=CUT_CELL_TO%DVOL_PR) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%Q ,TO=CUT_CELL_TO%Q) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%QR ,TO=CUT_CELL_TO%QR) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%D_SOURCE ,TO=CUT_CELL_TO%D_SOURCE) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%CHI_R ,TO=CUT_CELL_TO%CHI_R) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%MIX_TIME ,TO=CUT_CELL_TO%MIX_TIME) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%Q_REAC ,TO=CUT_CELL_TO%Q_REAC) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%REAC_SOURCE_TERM ,TO=CUT_CELL_TO%REAC_SOURCE_TERM) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%ZZ ,TO=CUT_CELL_TO%ZZ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%ZZS ,TO=CUT_CELL_TO%ZZS) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%M_DOT_PPP ,TO=CUT_CELL_TO%M_DOT_PPP) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%UNKH ,TO=CUT_CELL_TO%UNKH) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%UNKZ ,TO=CUT_CELL_TO%UNKZ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%KRES ,TO=CUT_CELL_TO%KRES) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%H ,TO=CUT_CELL_TO%H) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%HS ,TO=CUT_CELL_TO%HS) +ALLOCATE(GEOM_IDS(MAX(1,N_FACES)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','SURF_IDS',IZERO) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RTRM ,TO=CUT_CELL_TO%RTRM) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%R_H_G ,TO=CUT_CELL_TO%R_H_G) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHO_0 ,TO=CUT_CELL_TO%RHO_0) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%WVEL ,TO=CUT_CELL_TO%WVEL) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DDDTVOL ,TO=CUT_CELL_TO%DDDTVOL) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DELTA_RHO ,TO=CUT_CELL_TO%DELTA_RHO) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DELTA_RHO_ZZ ,TO=CUT_CELL_TO%DELTA_RHO_ZZ) +ALLOCATE(VOLUS(MAX(1,4*N_VOLUS)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','VOLUS',IZERO) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_IJK ,TO=CUT_CELL_TO%INT_IJK ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_COEF ,TO=CUT_CELL_TO%INT_COEF ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_XYZBF ,TO=CUT_CELL_TO%INT_XYZBF ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NOUT ,TO=CUT_CELL_TO%INT_NOUT ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_INBFC ,TO=CUT_CELL_TO%INT_INBFC ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NPE ,TO=CUT_CELL_TO%INT_NPE ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_XN ,TO=CUT_CELL_TO%INT_XN ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_CN ,TO=CUT_CELL_TO%INT_CN ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_CCVARS ,TO=CUT_CELL_TO%INT_CCVARS) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NOMIND ,TO=CUT_CELL_TO%INT_NOMIND) +ALLOCATE(MATL_IDS(MAX(1,N_VOLUS)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','MATL_IDS',IZERO) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DEL_RHO_D_DEL_Z_VOL ,TO=CUT_CELL_TO%DEL_RHO_D_DEL_Z_VOL) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%U_DOT_DEL_RHO_Z_VOL ,TO=CUT_CELL_TO%U_DOT_DEL_RHO_Z_VOL) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%NOADVANCE ,TO=CUT_CELL_TO%NOADVANCE) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%NOMICC ,TO=CUT_CELL_TO%NOMICC) +IF (N_VERTS_S>0 .AND. (N_FACES_S>0 .OR. N_VOLUS_S>0)) THEN ! merge static geometry + CALL MERGE_GEOMS(VERTS(1:3*N_VERTS_S),N_VERTS_S,& + FACES(1:3*N_FACES_S),TFACES(1:3*N_FACES_S),GEOM_IDS(1:N_FACES_S),SURF_IDS(1:N_FACES_S),N_FACES_S,& + VOLUS(1:3*N_VOLUS_S),MATL_IDS(1:N_VOLUS_S),N_VOLUS_S,.FALSE.) +ENDIF +IF (N_VERTS_D>0 .AND. (N_FACES_D>0 .OR. N_VOLUS_D>0)) THEN ! merge dynamic geometry + CALL MERGE_GEOMS(VERTS(3*N_VERTS_S+1:3*N_VERTS),N_VERTS_D,& + FACES(3*N_FACES_S+1:3*N_FACES),TFACES(3*N_FACES_S+1:3*N_FACES),GEOM_IDS,SURF_IDS(N_FACES_S+1:N_FACES),N_FACES_D,& + VOLUS(3*N_VOLUS_S+1:3*N_VOLUS),MATL_IDS(N_VOLUS_S+1:N_VOLUS),N_VOLUS_D,.TRUE.) +ENDIF RETURN -END SUBROUTINE CUT_CELL_MOVE - -! ------------------------- CELL_DEALLOC ----------------------------------- +END SUBROUTINE CONVERTGEOM -SUBROUTINE CELL_DEALLOC(NM,ICC) +! ---------------------------- REORDER_FACE ---------------------------------------- -INTEGER, INTENT(IN) :: NM,ICC +SUBROUTINE REORDER_VERTS(VERTS) +! the VERTS triplet V1, V2, V3 defines a face +! reorder V1,V2,V3 so that V1 has the smallest index +INTEGER, INTENT(INOUT) :: VERTS(3) -MESHES(NM)%CUT_CELL(ICC)%NCELL = 0 -IF (.NOT.ALLOCATED(MESHES(NM)%CUT_CELL(ICC)%CCELEM)) RETURN +INTEGER :: VERTS_TEMP(5) -! Deallocate ICC entries: -DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%CCELEM) -DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST) -DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%IJK_LINK,MESHES(NM)%CUT_CELL(ICC)%LINK_LEV) -DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%VOLUME, MESHES(NM)%CUT_CELL(ICC)%XYZCEN) -DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%NOADVANCE,MESHES(NM)%CUT_CELL(ICC)%UNKZ) +IF ( VERTS(1)0 .AND. (N_FACES>0 .OR. N_VOLUS>0)) THEN + CALL MERGE_GEOMS(VERTS,N_VERTS,FACES,TFACES,GEOM_IDS,SURF_IDS,N_FACES,VOLUS,MATL_IDS,N_VOLUS,IS_DYNAMIC) + ENDIF -MESHES(NM)%CUT_CELL(ICC)%RHO = 0._EB -MESHES(NM)%CUT_CELL(ICC)%RHOS = 0._EB -MESHES(NM)%CUT_CELL(ICC)%RSUM = 0._EB -MESHES(NM)%CUT_CELL(ICC)%TMP = 0._EB -MESHES(NM)%CUT_CELL(ICC)%D = 0._EB -MESHES(NM)%CUT_CELL(ICC)%DS = 0._EB -MESHES(NM)%CUT_CELL(ICC)%DVOL = 0._EB -MESHES(NM)%CUT_CELL(ICC)%DVOL_PR = 0._EB -MESHES(NM)%CUT_CELL(ICC)%Q = 0._EB -MESHES(NM)%CUT_CELL(ICC)%QR = 0._EB -MESHES(NM)%CUT_CELL(ICC)%D_SOURCE = 0._EB -MESHES(NM)%CUT_CELL(ICC)%CHI_R = 0._EB -MESHES(NM)%CUT_CELL(ICC)%MIX_TIME = 0._EB -MESHES(NM)%CUT_CELL(ICC)%KRES = 0._EB -MESHES(NM)%CUT_CELL(ICC)%H = 0._EB -MESHES(NM)%CUT_CELL(ICC)%HS = 0._EB -MESHES(NM)%CUT_CELL(ICC)%RTRM = 0._EB -MESHES(NM)%CUT_CELL(ICC)%R_H_G = 0._EB -MESHES(NM)%CUT_CELL(ICC)%RHO_0 = 0._EB -MESHES(NM)%CUT_CELL(ICC)%WVEL = 0._EB -MESHES(NM)%CUT_CELL(ICC)%DDDTVOL = 0._EB -MESHES(NM)%CUT_CELL(ICC)%DELTA_RHO= 0._EB -MESHES(NM)%CUT_CELL(ICC)%DELTA_RHO_ZZ= 0._EB + WRITE(LUNIT) REAL(TIME,FB) + WRITE(LUNIT) N_VERTS, N_FACES, N_VOLUS + IF (N_VERTS>0) THEN + IF (APPLY_TRAN) THEN + DO I = 1, N_VERTS + VERTS(3*I) = VERTS(3*I) + TRAN%Z_OFFSET + ENDDO + ENDIF + WRITE(LUNIT) (REAL(VERTS(I),FB), I=1,3*N_VERTS) + ENDIF + IF (N_FACES>0) THEN + WRITE(LUNIT) (FACES(I), I=1,3*N_FACES) + WRITE(LUNIT) (SURF_IDS(I), I=1,N_FACES) + WRITE(LUNIT) (REAL(TFACES(I),FB), I=1,6*N_FACES) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%Q_REAC(1:N_REACTIONS,1:NCELL)) -MESHES(NM)%CUT_CELL(ICC)%Q_REAC = 0._EB + WRITE(LUNIT2) N_FACES + WRITE(LUNIT2) (GEOM_IDS(I), I=1,N_FACES) + ENDIF + IF (N_VOLUS>0) THEN + WRITE(LUNIT) (VOLUS(I), I=1,4*N_VOLUS) + WRITE(LUNIT) (MATL_IDS(I), I=1,N_VOLUS) + ENDIF -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%REAC_SOURCE_TERM(1:N_TOTAL_SCALARS,1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%ZZ(1:N_TOTAL_SCALARS,1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%ZZS(1:N_TOTAL_SCALARS,1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%M_DOT_PPP(1:N_TOTAL_SCALARS,1:NCELL)) -MESHES(NM)%CUT_CELL(ICC)%REAC_SOURCE_TERM = 0._EB -MESHES(NM)%CUT_CELL(ICC)%ZZ = 0._EB -MESHES(NM)%CUT_CELL(ICC)%ZZS = 0._EB -MESHES(NM)%CUT_CELL(ICC)%M_DOT_PPP = 0._EB +END SUBROUTINE OUTGEOM -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%UNKH(1:NCELL)); MESHES(NM)%CUT_CELL(ICC)%UNKH = CC_UNDEFINED -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_IJK(IAXIS:KAXIS,(NCELL+1)*DELTA_INT)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_COEF((NCELL+1)*DELTA_INT)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_XYZBF(IAXIS:KAXIS,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_NOUT(IAXIS:KAXIS,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_INBFC(1:3,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_NPE(LOW_IND:HIGH_IND,0:KAXIS,1:INT_N_EXT_PTS,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_XN(0:INT_N_EXT_PTS,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_CN(0:INT_N_EXT_PTS,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_CCVARS(1:N_INT_FVARS,(NCELL+1)*DELTA_INT)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_NOMIND(LOW_IND:HIGH_IND,(NCELL+1)*DELTA_INT)) +! ---------------------------- WRITE_GEOM_ALL ------------------------------------ -MESHES(NM)%CUT_CELL(ICC)%INT_IJK = CC_UNDEFINED -MESHES(NM)%CUT_CELL(ICC)%INT_COEF = 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_XYZBF = 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_NOUT = 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_INBFC = CC_UNDEFINED -MESHES(NM)%CUT_CELL(ICC)%INT_NPE = 0 -MESHES(NM)%CUT_CELL(ICC)%INT_XN = 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_CN = 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_CCVARS= 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_NOMIND= CC_UNDEFINED +SUBROUTINE WRITE_GEOM_ALL +CALL WRITE_GEOM(T_BEGIN) ! write out both static and dynamic data at t=T_BEGIN +END SUBROUTINE WRITE_GEOM_ALL -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%DEL_RHO_D_DEL_Z_VOL(1:N_TOTAL_SCALARS,1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%U_DOT_DEL_RHO_Z_VOL(1:N_TOTAL_SCALARS,1:NCELL)) -MESHES(NM)%CUT_CELL(ICC)%DEL_RHO_D_DEL_Z_VOL = 0._EB; MESHES(NM)%CUT_CELL(ICC)%U_DOT_DEL_RHO_Z_VOL = 0._EB +! ---------------------------- WRITE_GEOM ---------------------------------------- -RETURN +SUBROUTINE WRITE_GEOM(TIME) -END SUBROUTINE ALLOC_CELL_STATE_VARS +! output geometries to a .ge file +REAL(EB), INTENT(IN) :: TIME +INTEGER :: ONE=1, ZERO=0, VERSION=2 +TYPE(TRANSFORM_TYPE), POINTER :: T -! ------------------------ GET_TRIANG_FACE_INT ---------------------------------- +IF (N_GEOMETRY<=0) RETURN -SUBROUTINE GET_TRIANG_FACE_INT(X2AXIS,X3AXIS,FVERT,CEI,NM, & - INB_FLG,NVERT,XYVERT,NEDGE,CEELEM,INDSEG) +IF (WRITE_GEOM_FIRST) THEN + OPEN(LU_GEOM(1),FILE=TRIM(FN_GEOM(1)),FORM='UNFORMATTED',STATUS='REPLACE') + OPEN(LU_GEOM(2),FILE=TRIM(FN_GEOM(2)),FORM='UNFORMATTED',STATUS='REPLACE') + WRITE(LU_GEOM(1)) ONE + WRITE(LU_GEOM(1)) VERSION + WRITE(LU_GEOM(1)) ZERO, ZERO, ONE ! n floats, n ints, first frame static + CALL OUTGEOM(LU_GEOM(1),LU_GEOM(2),.FALSE.,TIME,.FALSE.,T) ! write out static data +ELSE + OPEN(LU_GEOM(1),FILE=TRIM(FN_GEOM(1)),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND') + OPEN(LU_GEOM(2),FILE=TRIM(FN_GEOM(2)),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND') +ENDIF +CALL OUTGEOM(LU_GEOM(1),LU_GEOM(2),.TRUE.,TIME,.FALSE.,T) ! write out dynamic data +CLOSE(LU_GEOM(1)) +CLOSE(LU_GEOM(2)) -INTEGER, INTENT(IN) :: X2AXIS, X3AXIS, CEI, NM -REAL(EB), INTENT(IN) :: FVERT(IAXIS:JAXIS,NOD1:NOD4) -LOGICAL, INTENT(OUT):: INB_FLG -INTEGER, INTENT(OUT):: NVERT,NEDGE,CEELEM(NOD1:NOD2,1:CC_MAXCEELEM_FACE) -INTEGER, INTENT(OUT):: INDSEG(CC_MAX_WSTRIANG_SEG+3,CC_MAXCEELEM_FACE) -REAL(EB), INTENT(OUT):: XYVERT(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) +WRITE_GEOM_FIRST = .FALSE. -! Local Variables: -REAL(EB) :: X2FMIN, X2FMAX, X3FMIN, X3FMAX, DUMMY(IAXIS:JAXIS) -INTEGER :: SEG(NOD1:NOD2), TRI(NOD1:NOD3), ITRI, INOD -LOGICAL :: INTEST, OUTX2, OUTX3, OUTFACE, TRUETHAT, XIALIGNED, OUTSEG, SEG_IN_SIDE -INTEGER :: TSEGS(NOD1:NOD2,EDG1:EDG3) -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FVERT_IN_TRIANG, TRIVERT_IN_FACE -INTEGER :: NFVERT, NTVERT, NINTP -INTEGER :: TRINODS(CC_MAXVERTS_FACE) -REAL(EB) :: ATANTRI(1:CC_MAXVERTS_FACE+1), ATTRI -INTEGER :: II(1:CC_MAXVERTS_FACE+1), INTP, IINS, IDUM, INP, NINTP_TRI, IPT, JPL, IEDGE, IPF, ISEG -INTEGER :: LOCTRI, LOCBOD, EDGETRI(NOD1:NOD2,1:CC_MAXCEELEM_FACE), VEC3(1:3) -REAL(EB) :: XY1(IAXIS:JAXIS), XY2(IAXIS:JAXIS), XP1(IAXIS:JAXIS), XP2(IAXIS:JAXIS) -REAL(EB) :: XP(IAXIS:JAXIS), FD(1:2), VEC(IAXIS:JAXIS) -INTEGER :: MYAXIS, XIAXIS, XJAXIS -REAL(EB) :: XIPLNS(LOW_IND:HIGH_IND), XJPLNS(LOW_IND:HIGH_IND), DOT1, DOT2 -REAL(EB) :: MINXI, MAXXI, MINXJ, MAXXJ, DS, SVARI, XJPLN, XCEN(IAXIS:JAXIS) -REAL(EB) :: VECS(IAXIS:JAXIS), VECP1(IAXIS:JAXIS), VECP2(IAXIS:JAXIS), CROSSP1, CROSSP2 -REAL(EB) :: XYEL(IAXIS:JAXIS,NOD1:NOD3) -LOGICAL :: INLIST, OUTPLANE1, OUTPLANE2 -INTEGER :: EDGE_TRI +END SUBROUTINE WRITE_GEOM -REAL(EB), ALLOCATABLE, SAVE, DIMENSION(:,:) :: X2X3VERT -INTEGER, SAVE :: SIZE_X2X3VERT -INTEGER :: IWSSEG,NSVERT,NINTP_SEG,SEGNODS(NOD1:NOD2) +! ---------------------------- TRIANGLE_AREA ---------------------------------------- -! Default return values: -INB_FLG = .FALSE. -NVERT = 0 -NEDGE = 0 -IF(.NOT.ALLOCATED(X2X3VERT)) THEN - SIZE_X2X3VERT = DELTA_VERT - ALLOCATE(X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT)) -ENDIF -X2X3VERT = 0._EB -CEELEM = CC_UNDEFINED -INDSEG = CC_UNDEFINED -IF ( CEI /= 0 ) THEN - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE +REAL(EB) FUNCTION TRIANGLE_AREA(V1,V2,V3) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - IF (NVERT > SIZE_X2X3VERT) THEN - DEALLOCATE(X2X3VERT) - SIZE_X2X3VERT = NVERT + DELTA_VERT - ALLOCATE(X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT)); X2X3VERT = 0._EB - ENDIF +REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3) +REAL(EB) :: N(3),R1(3),R2(3) - X2X3VERT(IAXIS,1:NVERT) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(X2AXIS,1:NVERT) - X2X3VERT(JAXIS,1:NVERT) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(X3AXIS,1:NVERT) +R1 = V2-V1 +R2 = V3-V1 +CALL CROSS_PRODUCT(N,R1,R2) - CEELEM(NOD1:NOD2,1:NEDGE) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGE) - INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:NEDGE) = & - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:NEDGE) - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1=NEDGE -ENDIF +TRIANGLE_AREA = 0.5_EB*NORM2(N) -! Quick discard test: -X2FMIN = MINVAL(FVERT(IAXIS,NOD1:NOD4)); X2FMAX = MAXVAL(FVERT(IAXIS,NOD1:NOD4)) -X3FMIN = MINVAL(FVERT(JAXIS,NOD1:NOD4)); X3FMAX = MAXVAL(FVERT(JAXIS,NOD1:NOD4)) +END FUNCTION TRIANGLE_AREA -! Loop in-plane Surface Elements: -INTEST = .FALSE. -DO ITRI=1,BODINT_PLANE%NTRIS - ! Elements nodes location, in x2-x3 coordinates: - TRI(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) - DO INOD=NOD1,NOD3 - XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,TRI(INOD)) - ENDDO - OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(IAXIS,NOD1:NOD3))-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir - OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(JAXIS,NOD1:NOD3))-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 - IF (.NOT.OUTFACE) THEN - INTEST = .TRUE. - EXIT - ENDIF -ENDDO -! Run on Triangle edges found: -DO ISEG=1,BODINT_PLANE%NSEGS - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - DO INOD=NOD1,NOD2 - XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,SEG(INOD)) - ENDDO - OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(IAXIS,NOD1:NOD2))-X2FMAX) > GEOMEPS) ! Segment out of Face in x2 dir - OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(JAXIS,NOD1:NOD2))-X3FMAX) > GEOMEPS) ! Segment out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 - IF (.NOT.OUTFACE) THEN - INTEST = .TRUE. - EXIT - ENDIF -ENDDO -IF (.NOT.INTEST) RETURN -! Now if intest is true figure out if there are triangles-face intersection -! Polygons: -NFVERT = 4 -NTVERT = 3 -NSVERT = 2 +! ---------------------------- POINT_IN_BOX_2D ---------------------------------------- -! First Vertices: -ALLOCATE(FVERT_IN_TRIANG(1:NFVERT,BODINT_PLANE%NTRIS)); FVERT_IN_TRIANG = 0 -ALLOCATE(TRIVERT_IN_FACE(1:NTVERT,BODINT_PLANE%NTRIS)); TRIVERT_IN_FACE = 0 +LOGICAL FUNCTION POINT_IN_BOX_2D(P,BB,IOR) -NINTP = NVERT +REAL(EB), INTENT(IN) :: P(3),BB(6) +INTEGER, INTENT(IN) :: IOR -! Loop in-plane Surface Elements: -DO ITRI=1,BODINT_PLANE%NTRIS +POINT_IN_BOX_2D=.FALSE. - NINTP_TRI = 0 - TRINODS = CC_UNDEFINED +SELECT CASE(ABS(IOR)) + CASE(1) ! YZ plane + IF ( P(2)>=BB(3) .AND. P(2)<=BB(4) .AND. & + P(3)>=BB(5) .AND. P(3)<=BB(6) ) POINT_IN_BOX_2D=.TRUE. + CASE(2) ! XZ plane + IF ( P(1)>=BB(1) .AND. P(1)<=BB(2) .AND. & + P(3)>=BB(5) .AND. P(3)<=BB(6) ) POINT_IN_BOX_2D=.TRUE. + CASE(3) ! XY plane + IF ( P(1)>=BB(1) .AND. P(1)<=BB(2) .AND. & + P(2)>=BB(3) .AND. P(2)<=BB(4) ) POINT_IN_BOX_2D=.TRUE. +END SELECT - ! Elements nodes location, in x2-x3 coordinates: - TRI(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) - DO INOD=NOD1,NOD3 - XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,TRI(INOD)) - ENDDO +END FUNCTION POINT_IN_BOX_2D - ! Cycle if Triangles BBOX not intersecting face: - OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(IAXIS,NOD1:NOD3))-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir - OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(JAXIS,NOD1:NOD3))-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 - IF (OUTFACE) CYCLE +! ---------------------------- POINT_IN_TETRAHEDRON ---------------------------------------- - IF (BODINT_PLANE%X1NVEC(ITRI) < 0) THEN ! ROTATE NODE 2 AND 3 LOCATIONS - DUMMY(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,NOD2) - XYEL(IAXIS:JAXIS,NOD2) = XYEL(IAXIS:JAXIS,NOD3) - XYEL(IAXIS:JAXIS,NOD3) = DUMMY(IAXIS:JAXIS) +LOGICAL FUNCTION POINT_IN_TETRAHEDRON(XP,V1,V2,V3,V4,BB) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - TSEGS(NOD1:NOD2,EDG1) = BODINT_PLANE%TRIS( (/ 2, 1 /) ,ITRI) - TSEGS(NOD1:NOD2,EDG2) = BODINT_PLANE%TRIS( (/ 3, 2 /) ,ITRI) - TSEGS(NOD1:NOD2,EDG3) = BODINT_PLANE%TRIS( (/ 1, 3 /) ,ITRI) - ELSE - TSEGS(NOD1:NOD2,EDG1) = BODINT_PLANE%TRIS( (/ 1, 2 /) ,ITRI) - TSEGS(NOD1:NOD2,EDG2) = BODINT_PLANE%TRIS( (/ 2, 3 /) ,ITRI) - TSEGS(NOD1:NOD2,EDG3) = BODINT_PLANE%TRIS( (/ 3, 1 /) ,ITRI) - ENDIF +REAL(EB), INTENT(IN) :: XP(3),V1(3),V2(3),V3(3),V4(3),BB(6) +REAL(EB) :: U_VEC(3),V_VEC(3),N_VEC(3),Q_VEC(3),R_VEC(3) +INTEGER :: I - ! a. Test if Triangles vertices Lay on Faces area, including face boundary: - DO IPT=1,NTVERT - OUTX2= ((X2FMIN-XYEL(IAXIS,IPT)) > GEOMEPS) .OR. & - ((XYEL(IAXIS,IPT)-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir - OUTX3= ((X3FMIN-XYEL(JAXIS,IPT)) > GEOMEPS) .OR. & - ((XYEL(JAXIS,IPT)-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 +! In this routine, we test all four faces of the tet volume defined by the points X(i),Y(i),Z(i); i=1:4. +! If the point is on the negative side of all the faces, it is inside the volume. - IF ( OUTFACE ) CYCLE +POINT_IN_TETRAHEDRON=.FALSE. - ! Insertion add point to intersection list: - XP(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,IPT) - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) +! first test bounding box - ! Insert sort node to triangles local list - TRUETHAT = .TRUE. - DO INP=1,NINTP_TRI - IF (TRINODS(INP) == INOD) THEN - TRUETHAT = .FALSE. - EXIT - ENDIF - ENDDO - IF ( TRUETHAT ) THEN ! new inod entry on list - NINTP_TRI = NINTP_TRI + 1 - TRINODS(NINTP_TRI) = INOD - ENDIF +IF (XP(1)BB(2)) RETURN +IF (XP(2)BB(4)) RETURN +IF (XP(3)BB(6)) RETURN - TRIVERT_IN_FACE(IPT,ITRI) = 1 +POINT_IN_TETRAHEDRON=.TRUE. - ENDDO +FACE_LOOP: DO I=1,4 - ! b. Test if Face vertices lay on triangle, including triangle edges: - DO IPF=1,NFVERT - ! Transform back to master Element coordinates - ! location of point i,j in x2-x3 coordinates: - FD(1:2) = (/ FVERT(IAXIS,IPF)-XYEL(IAXIS,NOD3), FVERT(JAXIS,IPF)-XYEL(JAXIS,NOD3) /) - ! Here xi in vec(1) and eta in vec(2) - VEC(IAXIS) = BODINT_PLANE%AINV(1,1,ITRI)*FD(1) + BODINT_PLANE%AINV(1,2,ITRI)*FD(2) - VEC(JAXIS) = BODINT_PLANE%AINV(2,1,ITRI)*FD(1) + BODINT_PLANE%AINV(2,2,ITRI)*FD(2) + SELECT CASE(I) + CASE(1) + ! vertex ordering = 1,2,3,4 + Q_VEC = XP-(/V1(1),V1(2),V1(3)/) ! form a vector from a point on the triangular surface to the point XP + R_VEC = (/V4(1),V4(2),V4(3)/)-(/V1(1),V1(2),V1(3)/) ! vector from the tri to other point of volume defining inside + U_VEC = (/V2(1)-V1(1),V2(2)-V1(2),V2(3)-V1(3)/) ! vectors forming the sides of the triangle + V_VEC = (/V3(1)-V1(1),V3(2)-V1(2),V3(3)-V1(3)/) + CASE(2) + ! vertex ordering = 1,3,4,2 + Q_VEC = XP-(/V1(1),V1(2),V1(3)/) + R_VEC = (/V2(1),V2(2),V2(3)/)-(/V1(1),V1(2),V1(3)/) + U_VEC = (/V3(1)-V1(1),V3(2)-V1(2),V3(3)-V1(3)/) + V_VEC = (/V4(1)-V1(1),V4(2)-V1(2),V4(3)-V1(3)/) + CASE(3) + ! vertex ordering = 1,4,2,3 + Q_VEC = XP-(/V1(1),V1(2),V1(3)/) + R_VEC = (/V2(1),V2(2),V2(3)/)-(/V1(1),V1(2),V1(3)/) + U_VEC = (/V4(1)-V1(1),V4(2)-V1(2),V4(3)-V1(3)/) + V_VEC = (/V2(1)-V1(1),V2(2)-V1(2),V2(3)-V1(3)/) + CASE(4) + ! vertex ordering = 2,4,3,1 + Q_VEC = XP-(/V2(1),V2(2),V2(3)/) + R_VEC = (/V1(1),V1(2),V1(3)/)-(/V2(1),V2(2),V2(3)/) + U_VEC = (/V4(1)-V2(1),V4(2)-V2(2),V4(3)-V2(3)/) + V_VEC = (/V3(1)-V2(1),V3(2)-V2(2),V3(3)-V2(3)/) + END SELECT - ! Test for vertex point within triangle, considers Triangle Edges: - IF ( (VEC(IAXIS) >= (0._EB-GEOMEPS)) .AND. & - (VEC(JAXIS) >= (0._EB-GEOMEPS)) .AND. & - (1._EB-VEC(IAXIS)-VEC(JAXIS) >= (0._EB-GEOMEPS)) ) THEN + ! if the sign of the dot products are equal, the point is inside, else it is outside and we return - ! Insertion add point to intersection list: - XP(IAXIS:JAXIS) = FVERT(IAXIS:JAXIS,IPF) - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) + IF ( ABS( SIGN(1._EB,DOT_PRODUCT(Q_VEC,N_VEC))-SIGN(1._EB,DOT_PRODUCT(R_VEC,N_VEC)) )>TWENTY_EPSILON_EB ) THEN + POINT_IN_TETRAHEDRON=.FALSE. + RETURN + ENDIF - ! Insert sort node to triangles local list - TRUETHAT = .TRUE. - DO INP=1,NINTP_TRI - IF (TRINODS(INP) == INOD) THEN - TRUETHAT = .FALSE. - EXIT - ENDIF - ENDDO - IF ( TRUETHAT ) THEN ! new inod entry on list - NINTP_TRI = NINTP_TRI + 1 - TRINODS(NINTP_TRI) = INOD - ENDIF +ENDDO FACE_LOOP - FVERT_IN_TRIANG(IPF,ITRI) = 1 +END FUNCTION POINT_IN_TETRAHEDRON - ENDIF - ENDDO - ! Now add face edge - triangle edge intersection points: - ! x2 segments: - DO MYAXIS=IAXIS,JAXIS - SELECT CASE(MYAXIS) - CASE(IAXIS) - XIAXIS = IAXIS - XJAXIS = JAXIS - XIPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) - XJPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) - CASE(JAXIS) - XIAXIS = JAXIS - XJAXIS = IAXIS - XIPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) - XJPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) - END SELECT +! ---------------------------- VALID_TRIANGLE ---------------------------------------- - DO JPL=LOW_IND,HIGH_IND +LOGICAL FUNCTION VALID_TRIANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3,VERT_FLAG) - XJPLN = XJPLNS(JPL) +INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3, VERT_FLAG(0:300) +REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) - DO IPT=1,NTVERT +REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB +REAL(FB), POINTER, DIMENSION(:) :: V, V1, V2, V3 +REAL(FB) :: U1(3), U2(3), U1XU2, D123 - XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD1,IPT) ) - XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD2,IPT) ) +INTEGER :: I - ! Drop if Triangle edge on one side of segment ray: - MAXXJ = MAX(XY1(XJAXIS),XY2(XJAXIS)) - MINXJ = MIN(XY1(XJAXIS),XY2(XJAXIS)) - OUTPLANE1 = ((XJPLN-MAXXJ) > GEOMEPS) .OR. ((MINXJ-XJPLN) > GEOMEPS) - IF ( OUTPLANE1 ) CYCLE +VALID_TRIANGLE = .FALSE. - ! Also drop if Triangle edge ouside of face edge limits: - MAXXI = MAX(XY1(XIAXIS),XY2(XIAXIS)) - MINXI = MIN(XY1(XIAXIS),XY2(XIAXIS)) - OUTPLANE2 = ((XIPLNS(LOW_IND)-MAXXI) > GEOMEPS) .OR. ((MINXI-XIPLNS(HIGH_IND)) > GEOMEPS) - IF ( OUTPLANE2 ) CYCLE +V1(1:3)=>VERTS(3*IV1-2:3*IV1) +V2(1:3)=>VERTS(3*IV2-2:3*IV2) +V3(1:3)=>VERTS(3*IV3-2:3*IV3) - ! Test if segment aligned with xi - XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) - IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. +U1 = V2 - V1; +U2 = V3 - V2; - ! Drop intersections in triangle segment nodes: already added. - ! Compute: dot(plnormal, xyzv - xypl): - DOT1 = XY1(XJAXIS) - XJPLN - DOT2 = XY2(XJAXIS) - XJPLN +! triangle is invalid if angle at V2 is > 180 deg - IF ( ABS(DOT1) <= GEOMEPS ) CYCLE - IF ( ABS(DOT2) <= GEOMEPS ) CYCLE +IF(DIR==1) THEN + U1(1) = U1(2) + U1(2) = U1(3) + U2(1) = U2(2) + U2(2) = U2(3) +ELSE IF(DIR==2) THEN + U1(2) = U1(1) + U1(1) = U1(3) + U2(2) = U2(1) + U2(1) = U2(3) +ELSE + U1(1) = U1(1) + U1(2) = U1(2) + U2(1) = U2(1) + U2(2) = U2(2) +ENDIF +U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize +U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize +U1XU2 = U1(1)*U2(2)-U1(2)*U2(1) ! U1 x U2 +IF (U1XU2 < EPS_FB) RETURN - ! Finally regular case: - ! Points 1 on one side of x2 segment, point 2 on the other: - !IF ((DOT1 > 0._EB & DOT2 < 0._EB) .OR. (DOT1 < 0._EB & DOT2 > 0._EB)) - IF ( DOT1*DOT2 < 0._EB ) THEN +DO I = 1, NVERTS + IF (VERT_FLAG(I) == 0) CYCLE + IF (I == IV1 .OR. I == IV2 .OR.I == IV3 ) CYCLE + V(1:3)=>VERTS(3*I-2:3*I) + ! These CYCLE tests are done to treat holes properly: + D123=SQRT( (V(1)-V1(1))**2._FB + (V(2)-V1(2))**2._FB + (V(3)-V1(3))**2._FB ) + IF (D123 < EPS_FB) CYCLE + D123=SQRT( (V(1)-V2(1))**2._FB + (V(2)-V2(2))**2._FB + (V(3)-V2(3))**2._FB ) + IF (D123 < EPS_FB) CYCLE + D123=SQRT( (V(1)-V3(1))**2._FB + (V(2)-V3(2))**2._FB + (V(3)-V3(3))**2._FB ) + IF (D123 < EPS_FB) CYCLE + IF (POINT_IN_TRIANGLE_FB(V, V1, V2, V3)) RETURN +ENDDO - ! Intersection Point along segment: - DS = (XJPLN-XY1(XJAXIS))/(XY2(XJAXIS)-XY1(XJAXIS)) - SVARI = XY1(XIAXIS) + DS*(XY2(XIAXIS)-XY1(XIAXIS)) +VALID_TRIANGLE = .TRUE. +END FUNCTION VALID_TRIANGLE - OUTSEG= ((XIPLNS(LOW_IND)-SVARI) > -GEOMEPS) .OR. ((SVARI-XIPLNS(HIGH_IND)) > -GEOMEPS) - IF ( OUTSEG ) CYCLE - ! Insertion add point to intersection list: - XP(XIAXIS) = SVARI - XP(XJAXIS) = XJPLN - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) +! ----------------------------- DIFF_ANGLE ----------------------------------------- - ! Insert sort node to triangles local list - TRUETHAT = .TRUE. - DO INP=1,NINTP_TRI - IF (TRINODS(INP) == INOD) THEN - TRUETHAT = .FALSE. - EXIT - ENDIF - ENDDO - IF (TRUETHAT) THEN ! new inod entry on list - NINTP_TRI = NINTP_TRI + 1 - TRINODS(NINTP_TRI) = INOD - ENDIF - CYCLE - ENDIF - ENDDO - ENDDO - ENDDO +LOGICAL FUNCTION DIFF_ANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3, ABS_FLG) - IF ( NINTP_TRI == 0 ) CYCLE +INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3 +REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) +LOGICAL, INTENT(IN) :: ABS_FLG - ! Reorder points given normal on x1 direction: - ! Centroid: - XCEN(IAXIS:JAXIS) = 0._EB - DO INTP=1,NINTP_TRI - XCEN(IAXIS:JAXIS) = XCEN(IAXIS:JAXIS) + X2X3VERT(IAXIS:JAXIS,TRINODS(INTP)) - ENDDO - XCEN(IAXIS:JAXIS)= XCEN(IAXIS:JAXIS) * REAL(NINTP_TRI,EB)**(-1._EB) +REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB +REAL(FB), PARAMETER :: EPS_MID= 1.E-4_FB +REAL(FB), POINTER, DIMENSION(:) :: V1, V2, V3 +REAL(FB) :: U1(3), U2(3), CRPD(3), NORMU(2) +LOGICAL :: TEST_FLAG=.FALSE. - ATANTRI(1:CC_MAXVERTS_FACE+1) = 1._EB / GEOMEPS - II(1:CC_MAXVERTS_FACE+1) = CC_UNDEFINED - DO INTP=1,NINTP_TRI - ATTRI = ATAN2(X2X3VERT(JAXIS,TRINODS(INTP))-XCEN(JAXIS), & - X2X3VERT(IAXIS,TRINODS(INTP))-XCEN(IAXIS)) + PI - ! Insertion sort: - DO IINS=1,INTP+1 - IF (ATTRI < ATANTRI(IINS)) EXIT - ENDDO - ! copy from the back: - DO IDUM=INTP+1,IINS+1,-1 - ATANTRI(IDUM) = ATANTRI(IDUM-1) - II(IDUM) = II(IDUM-1) - ENDDO - ATANTRI(IINS) = ATTRI - II(IINS) = INTP - ENDDO +DIFF_ANGLE = .FALSE. - ! Reorder nodes: - TRINODS(1:NINTP_TRI) = TRINODS(II(1:NINTP_TRI)) +V1(1:3)=>VERTS(3*IV1-2:3*IV1) +V2(1:3)=>VERTS(3*IV2-2:3*IV2) +V3(1:3)=>VERTS(3*IV3-2:3*IV3) - ! Define and Insertion add segments to CFELEM, indseg - EDGETRI = CC_UNDEFINED - DO IEDGE=1,NINTP_TRI-1 - EDGETRI((/NOD1,NOD2/),IEDGE) = (/ TRINODS(IEDGE), TRINODS(IEDGE+1) /) - ENDDO - EDGETRI((/NOD1,NOD2/),NINTP_TRI) = (/ TRINODS(NINTP_TRI), TRINODS(1) /) +U1 = V2 - V1; +U2 = V3 - V2; - LOCTRI = BODINT_PLANE%INDTRI(1,ITRI) - LOCBOD = BODINT_PLANE%INDTRI(2,ITRI) +NORMU(1)=SQRT(U1(1)**2._FB+U1(2)**2._FB+U1(3)**2._FB) +NORMU(2)=SQRT(U2(1)**2._FB+U2(2)**2._FB+U2(3)**2._FB) - DO IEDGE=1,NINTP_TRI +IF(ANY(NORMU(1:2) 180 deg +SELECT CASE(DIR) +CASE(IAXIS) + U1(1) = U1(2) + U1(2) = U1(3) + U2(1) = U2(2) + U2(2) = U2(3) +CASE(JAXIS) + U1(2) = U1(1) + U1(1) = U1(3) + U2(2) = U2(1) + U2(1) = U2(3) +CASE(KAXIS) + U1(1) = U1(1) + U1(2) = U1(2) + U2(1) = U2(1) + U2(2) = U2(2) +CASE(0) ! 3D Cross for Inboundary faces: + U1(1:3) = U1(1:3) / NORMU(1) ! Normalize + U2(1:3) = U2(1:3) / NORMU(2) ! Normalize + CRPD(1) = U1(2)*U2(3)-U1(3)*U2(2) + CRPD(2) = U1(3)*U2(1)-U1(1)*U2(3) + CRPD(3) = U1(1)*U2(2)-U1(2)*U2(1) + ! ABS_FLG always .TRUE. in the 3D case: + IF (SQRT(CRPD(1)**2._FB+CRPD(2)**2._FB+CRPD(3)**2._FB) < EPS_FB) DIFF_ANGLE = .TRUE. + RETURN +END SELECT - ! Test if Edge already on list: - INLIST = .FALSE. - DO ISEG=1,NEDGE +U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize +U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize +IF (ABS_FLG) THEN + TEST_FLAG=ABS(U1(1)*U2(2)-U1(2)*U2(1)) < EPS_MID +ELSE + TEST_FLAG= U1(1)*U2(2)-U1(2)*U2(1) < EPS_FB +ENDIF +IF (TEST_FLAG) DIFF_ANGLE = .TRUE. - IF ( (EDGETRI(NOD1,IEDGE) == CEELEM(NOD1,ISEG)) .AND. & ! same inod1 - (EDGETRI(NOD2,IEDGE) == CEELEM(NOD2,ISEG)) .AND. & ! same inod2 - (LOCBOD == INDSEG(4,ISEG)) ) THEN ! same ibod +RETURN - SELECT CASE(INDSEG(1,ISEG)) - ! Only one triangle in list: - CASE(1) - IF ( LOCTRI /= INDSEG(2,ISEG) ) THEN - INDSEG(1,ISEG) = 2 - INDSEG(3,ISEG) = LOCTRI ! add triangle 2nd. - ENDIF - INLIST = .TRUE. - EXIT - ! Two triangles in list: - CASE(2) - IF ( (LOCTRI == INDSEG(2,ISEG)) .OR. & - (LOCTRI == INDSEG(3,ISEG)) ) THEN - INLIST = .TRUE. - EXIT - ENDIF - END SELECT - ENDIF - ENDDO +END FUNCTION DIFF_ANGLE - IF ( .NOT.INLIST ) THEN ! Edge not in list. - NEDGE = NEDGE + 1 - CEELEM(NOD1:NOD2,NEDGE) = EDGETRI(NOD1:NOD2,IEDGE) +! ---------------------------- POINT_IN_TRIANGLE_FB ---------------------------------------- - ! Here we have to figure out if segment belongs to a triangles side: - SEG_IN_SIDE = .FALSE. - DO IPT=1,NTVERT +LOGICAL FUNCTION POINT_IN_TRIANGLE_FB(P_FB,V1_FB,V2_FB,V3_FB) - ! Triangle side nodes: - XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD1,IPT) ) - XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD2,IPT) ) +REAL(FB), INTENT(IN) :: P_FB(3),V1_FB(3),V2_FB(3),V3_FB(3) +REAL(EB) :: P_EB(3),V1_EB(3),V2_EB(3),V3_EB(3) - ! Segment points: - XP1(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD1,NEDGE)) - XP2(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD2,NEDGE)) + P_EB = REAL( P_FB,EB) +V1_EB = REAL(V1_FB,EB) +V2_EB = REAL(V2_FB,EB) +V3_EB = REAL(V3_FB,EB) +POINT_IN_TRIANGLE_FB = POINT_IN_TRIANGLE(P_EB,V1_EB,V2_EB,V3_EB) - VECS(IAXIS:JAXIS) = XY2(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) - VECP1(IAXIS:JAXIS) = XP1(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) - VECP2(IAXIS:JAXIS) = XP2(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) +END FUNCTION POINT_IN_TRIANGLE_FB - CROSSP1 = ABS(VECS(IAXIS)*VECP1(JAXIS)-VECS(JAXIS)*VECP1(IAXIS)) - CROSSP2 = ABS(VECS(IAXIS)*VECP2(JAXIS)-VECS(JAXIS)*VECP2(IAXIS)) +! ---------------------------- POINT_IN_TRIANGLE ---------------------------------------- - IF ( (CROSSP1+CROSSP2) < GEOMEPS ) THEN - SEG_IN_SIDE = .TRUE. - EXIT - ENDIF - ENDDO - IF ( SEG_IN_SIDE ) THEN - EDGE_TRI = GEOMETRY(LOCBOD)%FACE_EDGES(IPT,LOCTRI) ! WSTRIED - VEC3(1) = GEOMETRY(LOCBOD)%EDGE_FACES(1,EDGE_TRI) ! WSEDTRI - VEC3(2) = GEOMETRY(LOCBOD)%EDGE_FACES(2,EDGE_TRI) - VEC3(3) = GEOMETRY(LOCBOD)%EDGE_FACES(4,EDGE_TRI) - INDSEG((/1,2,3,4/),NEDGE) = (/ VEC3(1), VEC3(2), VEC3(3), LOCBOD /) - ELSE - INDSEG((/1,2,3,4/),NEDGE) = (/ 1, LOCTRI, 0, LOCBOD /) - ENDIF - ENDIF - ENDDO +LOGICAL FUNCTION POINT_IN_TRIANGLE(P,V1,V2,V3) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -ENDDO +REAL(EB), INTENT(IN) :: P(3),V1(3),V2(3),V3(3) +REAL(EB) :: E(3),E1(3),E2(3),N(3),R(3),Q(3) +INTEGER :: I +REAL(EB), PARAMETER :: EPS=1.E-16_EB -! Now define cut-edges from solid-solid segments: -DO IWSSEG=1,BODINT_PLANE%NSEGS +! This routine tests whether the projection of P, in the plane normal +! direction, onto to the plane defined by the triangle (V1,V2,V3) is +! inside the triangle. - NINTP_SEG = 0 - SEGNODS = CC_UNDEFINED +POINT_IN_TRIANGLE=.TRUE. ! start by assuming the point is inside - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,IWSSEG) - DO INOD=NOD1,NOD2 - XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,SEG(INOD)) - ENDDO - ! Cycle if Edges BBOX not intersecting face: - OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(IAXIS,NOD1:NOD2))-X2FMAX) > GEOMEPS) ! Segment out of Face in x2 dir - OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(JAXIS,NOD1:NOD2))-X3FMAX) > GEOMEPS) ! Segment out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 - IF (OUTFACE) CYCLE +! compute face normal +E1 = V2-V1 +E2 = V3-V1 +CALL CROSS_PRODUCT(N,E1,E2) - ! Now define nodes for this CEELEM: - ! a-1. Test if Segments vertices Lay on Faces area, including face boundary: - DO IPT=1,NSVERT - OUTX2= ((X2FMIN-XYEL(IAXIS,IPT)) > GEOMEPS) .OR. & - ((XYEL(IAXIS,IPT)-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir - OUTX3= ((X3FMIN-XYEL(JAXIS,IPT)) > GEOMEPS) .OR. & - ((XYEL(JAXIS,IPT)-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 - IF ( OUTFACE ) CYCLE +EDGE_LOOP: DO I=1,3 + SELECT CASE(I) + CASE(1) + E = V2-V1 + R = P-V1 + CASE(2) + E = V3-V2 + R = P-V2 + CASE(3) + E = V1-V3 + R = P-V3 + END SELECT + CALL CROSS_PRODUCT(Q,E,R) + IF ( DOT_PRODUCT(Q,N) < -EPS ) THEN + POINT_IN_TRIANGLE=.FALSE. + RETURN + ENDIF +ENDDO EDGE_LOOP - ! Insertion add point to intersection list: - XP(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,IPT) - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) +END FUNCTION POINT_IN_TRIANGLE - ! Insert sort node to triangles local list - TRUETHAT = .TRUE. - DO INP=1,NINTP_SEG - IF (SEGNODS(INP) == INOD) THEN - TRUETHAT = .FALSE. - EXIT - ENDIF - ENDDO - IF ( TRUETHAT ) THEN ! new inod entry on list - NINTP_SEG = NINTP_SEG + 1 - SEGNODS(NINTP_SEG) = INOD - ENDIF - ENDDO +! ---------------------------- TRIANGULATE ---------------------------------------- - IF(NINTP_SEG < 2) THEN - ! b. Now add face edge - SS edge intersection points: - ! x2 segments: - DO MYAXIS=IAXIS,JAXIS - SELECT CASE(MYAXIS) - CASE(IAXIS) - XIAXIS = IAXIS - XJAXIS = JAXIS - XIPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) - XJPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) - CASE(JAXIS) - XIAXIS = JAXIS - XJAXIS = IAXIS - XIPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) - XJPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) - END SELECT +SUBROUTINE TRIANGULATE(DIR,VERTS,NVERTS,VERT_OFFSET,FACES,LOCTYPE) - DO JPL=LOW_IND,HIGH_IND +INTEGER, INTENT(IN) :: DIR, NVERTS, VERT_OFFSET +REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) +INTEGER, INTENT(OUT) :: FACES(3*(NVERTS-2)) +INTEGER, INTENT(OUT) :: LOCTYPE(NVERTS-2) - XJPLN = XJPLNS(JPL) +INTEGER :: IFACE, NLIST, NLIST_OLD +INTEGER :: VERT_LIST(0:1024), VERT_FLAG(0:1023), EDGE_LIST(2,1:1024) +LOGICAL :: NODE_EXISTS(1024) +INTEGER :: IM1, I, IP1, V0, V1, V2, IVERT, IEDGE +LOGICAL HAVE_TRIANGLE +REAL(FB), POINTER, DIMENSION(:) :: VV1, VV2, VV3 +REAL(FB) :: U1(3), U2(3), U1XU2 +REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB +INTEGER :: NBIG_ANGLES, VERT_START +LOGICAL :: VERT_DROPPED, FLAG - XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD1) ) - XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD2) ) +INTEGER :: HIDEDGE(3), EDGEI(1:2), NVERTS2, NEDGES, COUNT +INTEGER, PARAMETER :: SHFT_NODE(1:4) = (/ 2, 1, 0, 2 /) - ! b-1. Drop if Edge on one side of segment ray: - MAXXJ = MAX(XY1(XJAXIS),XY2(XJAXIS)) - MINXJ = MIN(XY1(XJAXIS),XY2(XJAXIS)) - OUTPLANE1 = ((XJPLN-MAXXJ) > GEOMEPS) .OR. ((MINXJ-XJPLN) > GEOMEPS) - IF ( OUTPLANE1 ) CYCLE +INTEGER :: COUNT_OUT - ! b-2. Also drop if Edge ouside of face edge limits: - MAXXI = MAX(XY1(XIAXIS),XY2(XIAXIS)) - MINXI = MIN(XY1(XIAXIS),XY2(XIAXIS)) - OUTPLANE2 = ((XIPLNS(LOW_IND)-MAXXI) > GEOMEPS) .OR. ((MINXI-XIPLNS(HIGH_IND)) > GEOMEPS) - IF ( OUTPLANE2 ) CYCLE +FLAG = .TRUE. - ! Test if segment aligned with xi - XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) - IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. +! Drop vertices that are repeated, close verts in EB precision that are fused in FB: +VERT_FLAG(1:NVERTS)=1 +I = 1 +VV1(1:3)=>VERTS(3*NVERTS-2:3*NVERTS) +VV2(1:3)=>VERTS(3*I-2:3*I) +IF ( ABS(VV1(1)-VV2(1))+ABS(VV1(2)-VV2(2))+ABS(VV1(3)-VV2(3)) < 10._FB*EPS_FB) VERT_FLAG(I)=0 +DO I = 2, NVERTS + VV1(1:3)=>VERTS(3*(I-1)-2:3*(I-1)) + VV2(1:3)=>VERTS(3*I-2:3*I) + IF ( ABS(VV1(1)-VV2(1))+ABS(VV1(2)-VV2(2))+ABS(VV1(3)-VV2(3)) < 10._FB*EPS_FB) VERT_FLAG(I)=0 +ENDDO +NLIST = SUM(VERT_FLAG(1:NVERTS)) +NVERTS2= NLIST +COUNT = 0 +DO I = 1, NVERTS + IF(VERT_FLAG(I)==0) CYCLE + COUNT= COUNT + 1 + VERT_LIST(COUNT) = I +ENDDO +VERT_LIST(0) = VERT_LIST(NLIST) +VERT_LIST(NLIST+1) = VERT_LIST(1) - ! Drop intersections in EDGE nodes: already added. - ! Compute: dot(plnormal, xyzv - xypl): - DOT1 = XY1(XJAXIS) - XJPLN - DOT2 = XY2(XJAXIS) - XJPLN +! Now drop vertices contained whithin lines of the polygon: +DO I=1,NLIST + IM1 = VERT_LIST(I-1) + IVERT = VERT_LIST(I) + IP1 = VERT_LIST(I+1) + IF ( DIFF_ANGLE(DIR,VERTS,NVERTS,IM1,IVERT,IP1,.TRUE.) ) VERT_FLAG(IVERT)=0 +ENDDO - IF ( ABS(DOT1) <= GEOMEPS ) CYCLE - IF ( ABS(DOT2) <= GEOMEPS ) CYCLE +! Redo List: +NLIST = SUM(VERT_FLAG(1:NVERTS)) - ! Finally regular case: - ! Points 1 on one side of x2 segment, point 2 on the other: - IF ( DOT1*DOT2 < 0._EB ) THEN +IF (NLIST < 3) THEN + FACES(1:3*(NVERTS-2)) = VERT_OFFSET + 1 + LOCTYPE(1:NVERTS-2) = 4+8+16 + RETURN +ENDIF - ! Intersection Point along segment: - DS = (XJPLN-XY1(XJAXIS))/(XY2(XJAXIS)-XY1(XJAXIS)) - SVARI = XY1(XIAXIS) + DS*(XY2(XIAXIS)-XY1(XIAXIS)) +NVERTS2= NLIST +NEDGES = NLIST +COUNT = 0 +DO I = 1, NVERTS + IF(VERT_FLAG(I)==0) CYCLE + COUNT= COUNT + 1 + VERT_LIST(COUNT) = I +ENDDO +VERT_LIST(0) = VERT_LIST(NLIST) +VERT_LIST(NLIST+1) = VERT_LIST(1) +NODE_EXISTS(1:NLIST+1) = .TRUE. +DO I = 1, NLIST-1 + EDGE_LIST((/1,2/),I) = (/ VERT_LIST(I), VERT_LIST(I+1) /) +ENDDO +EDGE_LIST((/1,2/),NLIST) = (/ VERT_LIST(NEDGES), VERT_LIST(1) /) +FACES(1:3*(NVERTS-2)) = VERT_OFFSET+VERT_LIST(NLIST) - OUTSEG= ((XIPLNS(LOW_IND)-SVARI) > -GEOMEPS) .OR. ((SVARI-XIPLNS(HIGH_IND)) > -GEOMEPS) - IF ( OUTSEG ) CYCLE +IF (DIR == 0) THEN ! INBOUNDARY cut-face, always convex polygon. + VERT_START = VERT_LIST(1) + IFACE = 0 + DO I = 1, NVERTS2 + IP1 = I + 1 + IF (I==NVERTS2) IP1=1 + IF (I==VERT_START .OR. IP1==VERT_START) CYCLE + FACES(3*IFACE+1) = VERT_OFFSET+VERT_LIST(VERT_START) + FACES(3*IFACE+2) = VERT_OFFSET+VERT_LIST(I) + FACES(3*IFACE+3) = VERT_OFFSET+VERT_LIST(IP1) + IFACE = IFACE + 1 + ENDDO + ! Here test edges to define LOCTYPE: + LOCTYPE(:) = 4+8+16 + DO IFACE=1,NVERTS2-2 + HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. + DO IEDGE=1,3 + ! Nodes i,i+1: + EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) + DO I=1,NEDGES + IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN + HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. + EXIT + ENDIF + ENDDO + ENDDO + LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) + ENDDO + RETURN +ENDIF - ! Insertion add point to intersection list: - XP(XIAXIS) = SVARI - XP(XJAXIS) = XJPLN - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) +IF (FLAG) THEN ! find number of angles > 180 deg + NBIG_ANGLES = 0 + VERT_START = VERT_LIST(1) + DO I = 1, NVERTS2 + IM1 = I - 1 + IF (I==1)IM1 = NVERTS2 + IP1 = I + 1 + IF (I==NVERTS2)IP1 = 1 + IF ( DIFF_ANGLE(DIR,VERTS,NVERTS,VERT_LIST(IM1),VERT_LIST(I),VERT_LIST(IP1),.FALSE.) ) THEN + NBIG_ANGLES = NBIG_ANGLES + 1 + VERT_START = I + ENDIF + END DO - ! Insert sort node to EDGES local list - TRUETHAT = .TRUE. - DO INP=1,NINTP_SEG - IF (SEGNODS(INP) == INOD) THEN - TRUETHAT = .FALSE. - EXIT - ENDIF - ENDDO - IF (TRUETHAT) THEN ! new inod entry on list - NINTP_SEG = NINTP_SEG + 1 - SEGNODS(NINTP_SEG) = INOD + ! if 0 angles (convex) or 1 angle (simple concave) then triangulate using a fan + IF ( NBIG_ANGLES <= 1 ) THEN + IFACE = 0 + DO I = 1, NVERTS2 + IP1 = I + 1 + IF (I==NVERTS2) IP1=1 + IF (I==VERT_START .OR. IP1==VERT_START) CYCLE + FACES(3*IFACE+1) = VERT_OFFSET+VERT_LIST(VERT_START) + FACES(3*IFACE+2) = VERT_OFFSET+VERT_LIST(I) + FACES(3*IFACE+3) = VERT_OFFSET+VERT_LIST(IP1) + IFACE = IFACE + 1 + ENDDO + ! Here test edges to define LOCTYPE: + LOCTYPE(:) = 4+8+16 + DO IFACE=1,NVERTS2-2 + HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. + DO IEDGE=1,3 + ! Nodes i,i+1: + EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) + DO I=1,NEDGES + IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN + HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. + EXIT ENDIF - CYCLE - ENDIF + ENDDO ENDDO + LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) ENDDO + RETURN ENDIF +ENDIF - IF ( (NINTP_SEG < 2) .OR. (SEGNODS(NOD1) == SEGNODS(NOD2)) ) CYCLE - - ! Test if Edge already on list: - INLIST = .FALSE. - DO ISEG=1,NEDGE +! more than 1 angles in polygon > 180 deg +COUNT_OUT = 0 +IFACE = 1 +OUTER: DO WHILE (NLIST>=3) + COUNT_OUT = COUNT_OUT + 1 + IF(COUNT_OUT > NVERTS**4) THEN + ! Revert to Convex poly solution: + DO IVERT = 1, NVERTS - 2 ! for now assume face is convex + ! vertex indices 1, 2, ..., NVF + ! faces (1,2,3), (1,3,4), ..., (1,NVF-1,NVF) + FACES(3*IVERT-2) = VERT_OFFSET+1 + FACES(3*IVERT-1) = VERT_OFFSET+1+IVERT + FACES(3*IVERT) = VERT_OFFSET+2+IVERT + ENDDO + EXIT + ENDIF + IVERT = 1 + HAVE_TRIANGLE = .FALSE. + INNER: DO WHILE (IVERT<=NLIST) + V0 = VERT_LIST(IVERT-1) + V1 = VERT_LIST(IVERT) + V2 = VERT_LIST(IVERT+1) + IF(.NOT.NODE_EXISTS(IVERT+1))EXIT INNER + IF(NLIST==3.OR.VALID_TRIANGLE(DIR,VERTS,NVERTS,V0,V1,V2,VERT_FLAG)) THEN + FACES(IFACE ) = VERT_OFFSET+V0 + FACES(IFACE+1) = VERT_OFFSET+V1 + FACES(IFACE+2) = VERT_OFFSET+V2 + IF (NLIST == 3) EXIT OUTER + IFACE = IFACE + 3 + NODE_EXISTS(IVERT) = .FALSE. + IF(IVERT==1) NODE_EXISTS(NLIST+1) = .FALSE. + HAVE_TRIANGLE = .TRUE. + IVERT = IVERT + 2 + ELSE + IVERT = IVERT + 1 + ENDIF + ENDDO INNER + NLIST_OLD = NLIST + NLIST = 0 + DO I = 1, NLIST_OLD + IF(NODE_EXISTS(I))THEN + NLIST = NLIST + 1 + VERT_LIST(NLIST) = VERT_LIST(I) + ENDIF + ENDDO + VERT_LIST(0) = VERT_LIST(NLIST) + VERT_LIST(NLIST+1) = VERT_LIST(1) + NODE_EXISTS(1:NLIST+1) = .TRUE. - IF ( (SEGNODS(NOD1) == CEELEM(NOD1,ISEG)) .AND. & ! same inod1 - (SEGNODS(NOD2) == CEELEM(NOD2,ISEG)) .AND. & ! same inod2 - (BODINT_PLANE%INDSEG(4,IWSSEG) == INDSEG(4,ISEG)) ) THEN ! same ibod + ! Test for nodes connecting parallel edges, if found drop them: + VERT_DROPPED=.FALSE. + DO I=1,NLIST + V0=VERT_LIST(I-1); V1=VERT_LIST(I); V2=VERT_LIST(I+1); + VV1(1:3)=>VERTS(3*V0-2:3*V0) + VV2(1:3)=>VERTS(3*V1-2:3*V1) + VV3(1:3)=>VERTS(3*V2-2:3*V2) + U1 = VV2 - VV1; + U2 = VV3 - VV2; + SELECT CASE(DIR) + CASE(IAXIS) + U1(1) = U1(2); U1(2) = U1(3) + U2(1) = U2(2); U2(2) = U2(3) + CASE(JAXIS) + U1(2) = U1(1); U1(1) = U1(3) + U2(2) = U2(1); U2(1) = U2(3) + CASE(KAXIS) + U1(1) = U1(1); U1(2) = U1(2) + U2(1) = U2(1); U2(2) = U2(2) + END SELECT + U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize + U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize + IF (U1(1)*U2(1)+U1(2)*U2(2) > -EPS_FB) CYCLE + U1XU2 = U1(1)*U2(2)-U1(2)*U2(1) ! U1 x U2 + IF (ABS(U1XU2) < EPS_FB) THEN ! Triple product less than EPS + VERT_DROPPED=.TRUE.; NODE_EXISTS(I)=.FALSE. + IF (IFACE < 3*(NVERTS2-2)) THEN + FACES(IFACE ) = VERT_OFFSET+V0 + FACES(IFACE+1) = VERT_OFFSET+V1 + FACES(IFACE+2) = VERT_OFFSET+V2 + IFACE = IFACE + 3 + ENDIF + IF (NLIST == 3) EXIT OUTER + ENDIF + ENDDO + IF (VERT_DROPPED) THEN + ! Repeat List generation: + NLIST_OLD = NLIST + NLIST = 0 + DO I = 1, NLIST_OLD + IF(NODE_EXISTS(I))THEN + NLIST = NLIST + 1 + VERT_LIST(NLIST) = VERT_LIST(I) + ENDIF + ENDDO + VERT_LIST(0) = VERT_LIST(NLIST) + VERT_LIST(NLIST+1) = VERT_LIST(1) + NODE_EXISTS(1:NLIST+1) = .TRUE. + ENDIF +ENDDO OUTER - IF (ANY(BODINT_PLANE%INDSEG(2:3,IWSSEG) == INDSEG(2,ISEG))) THEN - ! Edge already in list, Use SS Edge INDSEG: - INDSEG(1:4,ISEG) = BODINT_PLANE%INDSEG(1:4,IWSSEG) - INLIST = .TRUE. +! Here test edges to define LOCTYPE: +LOCTYPE(:) = 4+8+16 +DO IFACE=1,NVERTS2-2 + HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. + DO IEDGE=1,3 + ! Nodes i,i+1: + EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) + DO I=1,NEDGES + IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN + HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. EXIT - ELSE - WRITE(LU_ERR,*) "Error in GET_TRIANG_FACE_INT: SS EDGE Triangles not on 2 WS triang list INDSEG." ENDIF - ENDIF + ENDDO ENDDO - - IF ( .NOT.INLIST ) THEN ! Edge not in list. - NEDGE = NEDGE + 1 - CEELEM(NOD1:NOD2,NEDGE) = SEGNODS(NOD1:NOD2) - INDSEG(1:4,NEDGE) = BODINT_PLANE%INDSEG(1:4,IWSSEG) - ENDIF + LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) ENDDO -! Populate XYVERT points array: -IF(SIZE_X2X3VERT > SIZE(XYVERT,DIM=2)) THEN - WRITE(LU_ERR,*) 'Error in GET_TRIANG_FACE_INT : SIZE_X2X3VERT in greater than SIZE(XYVERT,DIM=2).' - CALL SHUTDOWN('Shutting down..') -ENDIF -XYVERT = 0._EB -XYVERT(IAXIS:JAXIS,1:SIZE_X2X3VERT) = X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT) -NVERT = NINTP -IF (NVERT > 0) INB_FLG = .TRUE. +RETURN +END SUBROUTINE TRIANGULATE -DEALLOCATE(FVERT_IN_TRIANG, TRIVERT_IN_FACE) +! ---------------------------- RAY_TRIANGLE_INTERSECT_PT ---------------------------------------- -RETURN -END SUBROUTINE GET_TRIANG_FACE_INT +SUBROUTINE RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,D,IS_INTERSECT,POS) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -! ------------------------- INSERT_POINT_2D ------------------------------------- +! V1(3), V2(3), V3(3) triangle vertices coordinates. +! XP(3) -> Ray origin coordinates. +! D(3) -> Ray direction. +! OUTPUT : +! IS_INTERSECT, .TRUE. if these is intersection. +! POS(3), coordinates of intersection point. -SUBROUTINE INSERT_POINT_2D(XP,NVERT,SIZE_XYVERT,XYVERT,INOD) +REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3),XP(3),D(3) +LOGICAL, INTENT(OUT):: IS_INTERSECT +REAL(EB), INTENT(OUT):: POS(3) -REAL(EB), INTENT(IN) :: XP(IAXIS:JAXIS) -INTEGER, INTENT(INOUT) :: NVERT -INTEGER, INTENT(INOUT) :: SIZE_XYVERT -REAL(EB), ALLOCATABLE, INTENT(INOUT) :: XYVERT(:,:) -INTEGER, INTENT(OUT) :: INOD +REAL(EB) :: E1(3),E2(3),P(3),S(3),Q(3),U,V,TMP,T +REAL(EB), PARAMETER :: EPS=1.E-10_EB -! Local Variables: -LOGICAL :: INLIST -REAL(EB):: DV(IAXIS:JAXIS), DVNORM -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYVERT_AUX +! Schneider and Eberly, Section 11.1 +IS_INTERSECT = .FALSE. +POS(1:3) = 1._EB/TWENTY_EPSILON_EB -INLIST = .FALSE. -DO INOD=1,NVERT - DV(IAXIS:JAXIS) = XP(IAXIS:JAXIS) - XYVERT(IAXIS:JAXIS,INOD) - DVNORM = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB ) - IF ( DVNORM < GEOMEPS ) THEN - INLIST = .TRUE. - EXIT - ENDIF -ENDDO -IF ( .NOT.INLIST ) THEN - NVERT = NVERT + 1 - INOD = NVERT - ! If NVERT > SIZE(XYVERT,DIM=2) reallocate: - IF(NVERT > SIZE_XYVERT) THEN - ALLOCATE(XYVERT_AUX(IAXIS:JAXIS,1:SIZE_XYVERT)); XYVERT_AUX(:,:) = XYVERT(:,:) - DEALLOCATE(XYVERT); ALLOCATE(XYVERT(IAXIS:JAXIS,SIZE_XYVERT+DELTA_VERT)); XYVERT = 0._EB - XYVERT(IAXIS:JAXIS,1:SIZE_XYVERT) = XYVERT_AUX(IAXIS:JAXIS,1:SIZE_XYVERT) - SIZE_XYVERT = SIZE_XYVERT + DELTA_VERT - ENDIF - XYVERT(IAXIS:JAXIS,INOD) = XP(IAXIS:JAXIS) -ENDIF +E1 = V2-V1 +E2 = V3-V1 -RETURN -END SUBROUTINE INSERT_POINT_2D +CALL CROSS_PRODUCT(P,D,E2) -! ---------------------------- DEBUG_WAIT --------------------------------------- +TMP = DOT_PRODUCT(P,E1) -SUBROUTINE DEBUG_WAIT -USE COMP_FUNCTIONS, ONLY: FDS_SLEEP -INTEGER I -INTEGER, PARAMETER :: N_SEG=20 -WRITE(LU_ERR,'(A,I6,A,I2,A)') 'Process ID=',MY_RANK,'; execution halted for ',N_SEG,' seconds : ' -DO I=1,N_SEG - CALL FDS_SLEEP(1._EB) - IF (I(1._EB+EPS)) RETURN ! No intersection. -SUBROUTINE READ_GEOM -USE BOXTETRA_ROUTINES, ONLY: TETRAHEDRON_VOLUME, REMOVE_DUPLICATE_VERTS -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -USE MISC_FUNCTIONS, ONLY: GET_MATL_INDEX -USE MPI_F08 -USE OUTPUT_DATA, ONLY: COLOR2RGB +CALL CROSS_PRODUCT(Q,S,E1) +V = TMP*DOT_PRODUCT(D,Q) +IF (V<-EPS .OR. (U+V)>(1._EB+EPS)) RETURN ! No intersection. -CHARACTER(LABEL_LENGTH) :: ID,MATL_ID,TEXTURE_MAPPING, & - DEVC_ID,CTRL_ID,SURF_IDS(3),SURF_ID6(6),MOVE_ID -CHARACTER(FN_LENGTH) :: BUFFER,FN_BINGEOM,BINARY_FILE -CHARACTER(LABEL_LENGTH), ALLOCATABLE, DIMENSION(:) :: SURF_ID -CHARACTER(MESSAGE_LENGTH) :: FYI -REAL(EB), ALLOCATABLE, DIMENSION(:) :: ZVALS,TFACES -REAL(EB), ALLOCATABLE, TARGET, DIMENSION(:) :: VERTS,VERTS_AUX -INTEGER, ALLOCATABLE, DIMENSION(:) :: SURF_ID_IND,POLY -INTEGER, ALLOCATABLE, TARGET, DIMENSION(:) :: FACES,FACES_AUX,VOLUS,OFACES,SURFS,SURFS2 -LOGICAL, ALLOCATABLE, DIMENSION(:) :: IS_EXTERNAL +T = TMP*DOT_PRODUCT(E2,Q) +IF (T <= 0._EB) RETURN ! No intersection. -REAL(EB) :: SPHERE_ORIGIN(3),SPHERE_RADIUS,TEXTURE_ORIGIN(3),TEXTURE_SCALE(2),XB(6),DX,BOX_XYZ(3),& - ZMIN,VOLUME,TXMIN,TXMAX,TYMIN,TYMAX,TX,TY,DV1(MAX_DIM),DV2(MAX_DIM),& - NVECI(MAX_DIM),DXCEN(MAX_DIM),DOTI,TRANSPARENCY,CYLINDER_ORIGIN(3),CYLINDER_AXIS(3),& - CYLINDER_RADIUS,CYLINDER_LENGTH,EXTRUDE,CELL_BLOCK_ORIENTATION(3) +IS_INTERSECT = .TRUE. +POS = XP + T*D ! the intersection point -INTEGER :: MAX_IDS=0,MAX_SURF_IDS=0,MAX_ZVALS=0,MAX_VERTS=0,MAX_FACES=0,MAX_VOLUS=0,MAX_POLY_VERTS=0,& - N_VERTS,N_FACES,N_FACES_TEMP,N_VOLUS,N_ZVALS,N_SURF_ID,N_SURF_ID2,N_POLY_VERTS,& - MATL_INDEX,IOS,IZERO,N,I,J,K,IJ,FIRST_FACE_INDEX,I1,I2,I3,I4,& - GEOM_TYPE,NXB,IJK(3),N_LEVELS,N_LAT,N_LONG,SPHERE_TYPE,BOXVERTLIST(8),NI,NIJ,IVOL,SORT_FACES,II,II1,II2,II3,& - X1AXIS,NNN,CYLINDER_NSEG_THETA,CYLINDER_NSEG_AXIS,CYL_FIND(LOW_IND:HIGH_IND,1:3),CELL_BLOCK_IOR +RETURN +END SUBROUTINE RAY_TRIANGLE_INTERSECT_PT -LOGICAL :: HAVE_SURF,HAVE_MATL,IN_LIST,SURF_INDEX_PER_FACE,BNDF_GEOM,LOGTEST -REAL(EB), POINTER, DIMENSION(:) :: V1,V2,V3,V4 -INTEGER, POINTER, DIMENSION(:) :: FACEI,FACEJ,FACE_FROM,FACE_TO,VOL -TYPE(MESH_TYPE), POINTER :: M -TYPE(GEOMETRY_TYPE), POINTER :: G +! ---------------------------- TRILINEAR ---------------------------------------- -INTEGER, PARAMETER :: CAD_GEOM_TYPE=1,TERRAIN_GEOM_TYPE=2,& - BOX_GEOM_TYPE=3,SPHERE_GEOM_TYPE=4,CYLINDER_GEOM_TYPE=5 ! These 4 are for internal use. +REAL(EB) FUNCTION TRILINEAR(UU,DXI,LL) -REAL(EB), PARAMETER :: MAX_VAL=1.0E20_EB +REAL(EB), INTENT(IN) :: UU(0:1,0:1,0:1),DXI(3),LL(3) +REAL(EB) :: XX,YY,ZZ -LOGICAL :: READ_BINARY +! Comments: +! +! see http://local.wasp.uwa.edu.au/~pbourke/miscellaneous/interpolation/index.html +! with appropriate scaling. LL is length of side. +! +! UU(1,1,1) +! z /----------/ +! ^/ / | +! ------------ | Particle position +! | | | +! LL(3) | o<-----|------- DXI = [DXI(1),DXI(2),DXI(3)] +! | | / +! | |/ Particle property at XX = TRILINEAR +! ------------> x +! ^ +! | +! X0 = [0,0,0] +! +! UU(0,0,0) +! +!=========================================================== -INTEGER :: IJF, IJB, IJE, NM -INTEGER, ALLOCATABLE, DIMENSION(:) :: B_IND,E_IND,F_IND -REAL(EB) :: XLOW,XHI,YLOW,YHI,ZLOW,ZHI,DELX,DELY,DELTZ +XX = DXI(1)/LL(1) +YY = DXI(2)/LL(2) +ZZ = DXI(3)/LL(3) -LOGICAL :: IS_TERRAIN,EXTEND_TERRAIN,WRITE_WARNING -REAL(EB):: ZVAL_HORIZON, ZVAL_FACTOR +TRILINEAR = UU(0,0,0)*(1._EB-XX)*(1._EB-YY)*(1._EB-ZZ) + & + UU(1,0,0)*XX*(1._EB-YY)*(1._EB-ZZ) + & + UU(0,1,0)*(1._EB-XX)*YY*(1._EB-ZZ) + & + UU(0,0,1)*(1._EB-XX)*(1._EB-YY)*ZZ + & + UU(1,0,1)*XX*(1._EB-YY)*ZZ + & + UU(0,1,1)*(1._EB-XX)*YY*ZZ + & + UU(1,1,0)*XX*YY*(1._EB-ZZ) + & + UU(1,1,1)*XX*YY*ZZ -INTEGER :: START_FACE_LO, START_FACE_MID, START_FACE_HI +END FUNCTION TRILINEAR -INTEGER :: N_EDGES,N_BEDGES,N_FACES_ORIG,N_VERTS_ORIG,N_VOLUS_ORIG,ICPT,CLOSE_PT(NOD1:NOD4+1), RGB(3)=-1 -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: EDGES,FACE_EDGES,EDGE_FACES,BOUND_EDGES,BOUND_EDGES2 -INTEGER, ALLOCATABLE, DIMENSION(:) :: NBND_EDGE,COUNTED_EDGES -REAL(EB) :: X_CEN,Y_CEN,ZMIN2,CORNER_PT(IAXIS:JAXIS,NOD1:NOD4+1),DIST,DISTI -REAL(EB), PARAMETER :: VERXY(IAXIS:JAXIS,NOD1:NOD4) = & - RESHAPE((/0._EB,1._EB,-1._EB,0._EB,0._EB,-1._EB,1._EB,0._EB/),(/ 2, 4 /)) -CHARACTER(25) :: COLOR='null' +! ---------------------------- POINT_IN_BB ---------------------------------------- -LOGICAL :: DONE +LOGICAL FUNCTION POINT_IN_BB(V1,BB) -INTEGER :: ILINE, IERR -INTEGER :: IG, IVERT +REAL(EB), INTENT(IN) :: V1(3),BB(6) -INTEGER, ALLOCATABLE, DIMENSION(:) :: GEOM_LINE,GEOM_LINE2 -INTEGER, PARAMETER :: DELTA_GEOM_LINE=1000 -INTEGER :: GEOM_LINE_SIZE +POINT_IN_BB=.FALSE. +IF ( V1(1)>=BB(1) .AND. V1(1)<=BB(2) .AND. & + V1(2)>=BB(3) .AND. V1(2)<=BB(4) .AND. & + V1(3)>=BB(5) .AND. V1(3)<=BB(6) ) THEN + POINT_IN_BB=.TRUE. + RETURN +ENDIF -NAMELIST /GEOM/ BNDF_GEOM,BINARY_FILE,CELL_BLOCK_IOR,CELL_BLOCK_ORIENTATION,COLOR,CYLINDER_ORIGIN,CYLINDER_AXIS,& - CYLINDER_RADIUS,CYLINDER_LENGTH,CYLINDER_NSEG_THETA,CYLINDER_NSEG_AXIS,& - EXTRUDE,EXTEND_TERRAIN,FACES,FYI,ID,IJK,IS_TERRAIN,MOVE_ID,N_LAT,N_LEVELS,N_LONG,POLY,& - RGB,SPHERE_ORIGIN,SPHERE_RADIUS,SPHERE_TYPE,SURF_ID,SURF_IDS,SURF_ID6,& - TEXTURE_MAPPING,TEXTURE_ORIGIN,TEXTURE_SCALE,TRANSPARENCY,& - VERTS,XB,ZMIN,ZVALS,ZVAL_HORIZON +RETURN +END FUNCTION POINT_IN_BB -! first pass - count number of &GEOM lines. +! ---------------------------- POLYGON_AREA ---------------------------------------- -N_GEOMETRY=0 -ALLOCATE(GEOM_LINE(DELTA_GEOM_LINE)); GEOM_LINE = 0 -GEOM_LINE_SIZE = SIZE(GEOM_LINE,DIM=1) -REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 -COUNT_GEOM_LOOP: DO - CALL CHECKREAD('GEOM',LU_INPUT,IOS) ; IF (STOP_STATUS==SETUP_STOP) RETURN - IF (IOS==1) EXIT COUNT_GEOM_LOOP - IF(N_GEOMETRY+1 > GEOM_LINE_SIZE) THEN - ALLOCATE(GEOM_LINE2(GEOM_LINE_SIZE)) - GEOM_LINE2(1:GEOM_LINE_SIZE) = GEOM_LINE(1:GEOM_LINE_SIZE) - DEALLOCATE(GEOM_LINE) - ALLOCATE(GEOM_LINE(GEOM_LINE_SIZE+DELTA_GEOM_LINE)); GEOM_LINE = 0 - GEOM_LINE(1:GEOM_LINE_SIZE) = GEOM_LINE2(1:GEOM_LINE_SIZE) - GEOM_LINE_SIZE = SIZE(GEOM_LINE,DIM=1) - DEALLOCATE(GEOM_LINE2) - ENDIF - READ(LU_INPUT,'(A)')BUFFER - N_GEOMETRY=N_GEOMETRY+1 - GEOM_LINE(N_GEOMETRY) = INPUT_FILE_LINE_NUMBER -ENDDO COUNT_GEOM_LOOP -REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 -IF (N_GEOMETRY==0) RETURN +REAL(EB) FUNCTION POLYGON_AREA(NP,PC) +! Calculate the area of a polygon + +INTEGER, INTENT(IN) :: NP +REAL(EB), INTENT(IN) :: PC(60) +INTEGER :: I,K +REAL(EB) :: V1(3),V2(3),V3(3) + +POLYGON_AREA = 0._EB +V3 = POLYGON_CENTROID(NP,PC) -! Allocate GEOMETRY array +DO I=1,NP + IF (I < NP) THEN + DO K=1,3 + V1(K) = PC((I-1)*3+K) + V2(K) = PC(I*3+K) + ENDDO + ELSE + DO K=1,3 + V1(K) = PC((I-1)*3+K) + V2(K) = PC(K) + ENDDO + ENDIF + POLYGON_AREA = POLYGON_AREA+TRIANGLE_AREA(V1,V2,V3) +ENDDO -ALLOCATE(GEOMETRY(0:N_GEOMETRY),STAT=IZERO) -CALL ChkMemErr('READ_GEOM','GEOMETRY',IZERO) +RETURN +END FUNCTION POLYGON_AREA -! third pass - read GEOM data +! ---------------------------- POLYGON_CENTROID ---------------------------------------- -READ_GEOM_LOOP: DO N=1,N_GEOMETRY - G=>GEOMETRY(N) +REAL(EB) FUNCTION POLYGON_CENTROID(NP,PC) +! Calculate the centroid of polygon vertices - CALL CHECKREAD('GEOM',LU_INPUT,IOS) ; IF (STOP_STATUS==SETUP_STOP) RETURN - IF (IOS==1) EXIT READ_GEOM_LOOP +DIMENSION :: POLYGON_CENTROID(3) +INTEGER, INTENT(IN) :: NP +REAL(EB), INTENT(IN) :: PC(60) +INTEGER :: I,K - IF(MAX_ZVALS/=MAXIMUM_GEOMETRY_ZVALS) THEN ! Reset to default GEOMETRY values and allocate ARRAYS. - MAX_ZVALS=0; MAX_VERTS=0; MAX_FACES=0; MAX_VOLUS=0; MAX_IDS=0; MAX_SURF_IDS=0; MAX_POLY_VERTS=0 - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - CALL ALLOCATE_BUFFERS - ENDIF +POLYGON_CENTROID = 0._EB +DO I=1,NP + DO K=1,3 + POLYGON_CENTROID(K) = POLYGON_CENTROID(K)+PC((I-1)*3+K)/NP + ENDDO +ENDDO - GEOM_RESIZE_DO : DO - DONE=.TRUE. - CALL SET_GEOM_DEFAULTS - READ(LU_INPUT,GEOM,END=35,ERR=22,IOSTAT=IOS) - 22 IF (IOS>0) THEN - IF ( (ZVALS(MAX_ZVALS+1) < MAX_VAL) .OR. (VERTS(3*MAX_VERTS+1) < MAX_VAL) .OR.& - (FACES(4*MAX_FACES+1) > 0) .OR. (VOLUS(4*MAX_VOLUS+1) > 0)) THEN - ! Resize MAX_ZVALS, MAX_VERTS, MAX_FACES, MAX_VOLUS: - MAX_ZVALS = MAX_ZVALS + 25000 - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - CALL ALLOCATE_BUFFERS - DONE=.FALSE. - ELSE - WRITE(BUFFER,'(A,A,A)') 'ERROR(101): GEOM ID=',TRIM(ID),'. Check &GEOM input line.' - CALL SHUTDOWN(TRIM(BUFFER)) - RETURN - ENDIF - REWIND(LU_INPUT); DO ILINE=1,GEOM_LINE(N)-1; READ(LU_INPUT,'(A)') BUFFER; ENDDO - ENDIF - IF (DONE) EXIT GEOM_RESIZE_DO - ENDDO GEOM_RESIZE_DO +RETURN +END FUNCTION POLYGON_CENTROID - IF (COLOR/='null') THEN - CALL COLOR2RGB(RGB,COLOR) - ENDIF - G%CELL_BLOCK_IOR = CELL_BLOCK_IOR - G%CELL_BLOCK_ORIENTATION = CELL_BLOCK_ORIENTATION - G%RGB = RGB - G%TRANSPARENCY = TRANSPARENCY - N_VERTS=0 - N_FACES=0 - TFACES(1:6*MAX_FACES) = -1.0_EB - N_VOLUS=0 - N_ZVALS=0 - N_POLY_VERTS=0 - IF(TRIM(BINARY_FILE)/='null') READ_BINARY = .TRUE. ! In case a binary name is provided, read the binary. - G%READ_BINARY = READ_BINARY +! ---------------------------- INTERSECT_SPHERE_AABB ---------------------------------------- - ! Get number of SURF_IDs defined for the GEOM: - N_SURF_ID = 0 - DO I = 1, MAX_SURF_IDS - IF( SURF_ID(I)=='null' ) EXIT ! First 'null' - N_SURF_ID = N_SURF_ID + 1 - ENDDO +! Algorithm from Schneider and Eberly, p. 644 +! Intersection of Sphere and Axis-Aligned Bounding Box - READ_BIN_COND : IF (.NOT.READ_BINARY) THEN - ! count VERTS - DO I = 1, MAX_VERTS - IF (ANY(VERTS(3*I-2:3*I)>=MAX_VAL)) EXIT - N_VERTS = N_VERTS+1 - ENDDO +LOGICAL FUNCTION INTERSECT_SPHERE_AABB(X0,RADIUS,XB) - ! count POLY Verts: - DO I = 1,MAX_POLY_VERTS - IF (POLY(I)==0) EXIT - N_POLY_VERTS = N_POLY_VERTS+1 - ENDDO +REAL(EB), INTENT(IN) :: X0(3),RADIUS,XB(6) +REAL(EB) :: DIST_SQUARED - ! count FACES - DO I = 1, MAX_FACES - IF (ALL(FACES(4*(I-1)+1:4*(I-1)+3)==0)) EXIT - N_FACES = N_FACES+1 - ENDDO +INTERSECT_SPHERE_AABB=.TRUE. - ! Now split FACES array into FACES (connectivity), and SURFS, i.e. local surf ID: - IF(N_FACES > 0) THEN - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)) - DO I = 1, N_FACES - FACES(3*(I-1)+1:3*(I-1)+3) = FACES(4*(I-1)+1:4*(I-1)+3) - SURFS(I) = FACES(4*(I-1)+4) - IF(SURFS(I) > N_SURF_ID) THEN - WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(701): problem with GEOM ',TRIM(ID),& - ', local SURF_ID index for FACE ',I,'out of bounds.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - ENDIF +! Compute distance in each direction, summing as we go +DIST_SQUARED = 0._EB +IF (X0(1)XB(2)) THEN + DIST_SQUARED = DIST_SQUARED + (X0(1)-XB(2))**2 +ENDIF +IF (X0(2)XB(4)) THEN + DIST_SQUARED = DIST_SQUARED + (X0(2)-XB(4))**2 +ENDIF +IF (X0(3)XB(6)) THEN + DIST_SQUARED = DIST_SQUARED + (X0(3)-XB(6))**2 +ENDIF - ! count VOLUS - DO I = 1, MAX_VOLUS - IF (ANY(VOLUS(4*I-3:4*I)==0)) EXIT - N_VOLUS = N_VOLUS+1 - ENDDO +! Compare squared distance to radius squared +IF (DIST_SQUARED > (RADIUS*RADIUS-TWENTY_EPSILON_EB)) INTERSECT_SPHERE_AABB=.FALSE. - ! count ZVALS - DO I = 1, MAX_ZVALS - IF (ZVALS(I)>MAX_VAL) EXIT - N_ZVALS=N_ZVALS+1 - ENDDO +RETURN +END FUNCTION INTERSECT_SPHERE_AABB - ELSE READ_BIN_COND - ! Read Binary file, reset values of other geometry types to default: - ! Defaults for terrain, sphere, cylinder, box, etc. - XB=1.001_EB*MAX_VAL - SPHERE_ORIGIN = 1.001_EB*MAX_VAL - SPHERE_RADIUS = 1.001_EB*MAX_VAL - CYLINDER_LENGTH = 1.001_EB*MAX_VAL - CYLINDER_RADIUS = 1.001_EB*MAX_VAL - CYLINDER_ORIGIN = 1.001_EB*MAX_VAL - CYLINDER_AXIS = 1.001_EB*MAX_VAL - CYLINDER_NSEG_THETA = -1 - CYLINDER_NSEG_AXIS = -1 - N_LEVELS=-1 - N_LAT=-1 - N_LONG=-1 - SPHERE_TYPE=-1 +! ---------------------------- INTERSECT_CYLINDER_AABB ---------------------------------------- - ! This is to add the SURF_IDS to SURF_ID for analytical geometries being read from bingeom: - IF (TRIM(SURF_ID(1))=='null' .AND. TRIM(SURF_IDS(1))/='null') THEN ! Case of cylinders. - SURF_ID(1:3) = SURF_IDS(1:3) - N_SURF_ID = 3 - DO I=2,3 - IF (TRIM(SURF_ID(I))=='null') THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR(702): problem with GEOM ',TRIM(ID),', SURF_IDS not defined properly.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - ENDIF +! Intersection of Cylinder and Axis-Aligned Bounding Box +! +! Cylinder is represented by: +! X_IN = bottom-center of cylinder (X,Y,Z) in grid reference frame +! H = length of cylinder +! RADIUS = radius of cylinder +! AX_VEC = unit vector pointing along cylinder axis (which leads to ROT_MAT using ROTATION_MATRIX) +! +! The basic algorithm is: +! 1. rotate the cylinder into a frame where the axis points in the vertical direction (+zbar in new frame) +! 2. find the vertex point locations of AABB in this new frame +! 3. test each vertex location against the end caps of cylinder +! 4. test each vertex against radius of cylinder - ! Read Binary - OPEN(UNIT=731,FILE=TRIM(BINARY_FILE),STATUS='OLD',FORM='UNFORMATTED',ACTION='READ',ERR=221,IOSTAT=IOS) - IF (IOS==0) THEN - READ(731) GEOM_TYPE - READ(731) N_VERTS,N_FACES,N_SURF_ID2,N_VOLUS - IF(GEOM_TYPE==TERRAIN_GEOM_TYPE) THEN - IS_TERRAIN=.TRUE. - ELSE ! If GEOM is of any type other than terrains, set it to CAD type. - GEOM_TYPE=CAD_GEOM_TYPE - ENDIF - ! Now reallocate if necessary, twice size is to make sure terrains have sufficient array size allocated: - IF (2*N_VERTS > MAX_VERTS) THEN; MAX_VERTS=2*N_VERTS; DEALLOCATE(VERTS); ALLOCATE(VERTS(1:3*MAX_VERTS)); ENDIF - IF (2*N_FACES > MAX_FACES) THEN - MAX_FACES=2*N_FACES - DEALLOCATE(FACES); ALLOCATE(FACES(1:3*MAX_FACES)) - DEALLOCATE(TFACES); ALLOCATE(TFACES(1:6*MAX_FACES)) - ENDIF - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(MAX_FACES)) - IF (2*N_VOLUS > MAX_VOLUS) THEN; MAX_VOLUS=2*N_VOLUS; DEALLOCATE(VOLUS); ALLOCATE(VOLUS(1:4*N_VOLUS)); ENDIF - ! Read Vertices, Faces, Surfs and Volus: - IF (N_VERTS > 0 ) READ(731) VERTS(1:3*N_VERTS) - IF (N_FACES > 0 ) THEN - READ(731) FACES(1:3*N_FACES) - READ(731) SURFS(1:N_FACES) - ENDIF - IF (N_VOLUS > 0 ) READ(731) VOLUS(1:4*N_VOLUS) - CLOSE(731) - IF (ANY(SURFS(1:N_FACES)>0) .AND. TRIM(SURF_ID(1))=='null') THEN - WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR(703): missing SURF_ID in &GEOM line ',TRIM(ID),& - ' for binary file ',TRIM(BINARY_FILE),& - '. Add SURF_ID in said &GEOM line.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - IF(N_SURF_ID2 /= N_SURF_ID) THEN - WRITE(MESSAGE,'(A,A,A,I8,A,I8,A,A,A)') 'ERROR(704): problem with GEOM ',TRIM(ID),& - ', number of surfaces in SURF_ID field (',N_SURF_ID, & - ') not equal to number of surfaces (',N_SURF_ID2,& - ') defined in bingeom ',TRIM(BINARY_FILE),'.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - DO I = 1, N_FACES - IF(SURFS(I) > N_SURF_ID) THEN - WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(701): problem with GEOM ',TRIM(ID),& - ', local SURF_ID index for FACE ',I,'out of bounds.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - ENDIF -221 IF(IOS > 0) THEN - WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR(705): could not read binary connectivity for GEOM ',TRIM(ID),& - ' in binary file ',TRIM(BINARY_FILE),& - '. Check file exists.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDIF READ_BIN_COND +LOGICAL FUNCTION INTERSECT_CYLINDER_AABB(X_IN,H,RADIUS,ROTMAT,XB) - N_VERTS_ORIG = N_VERTS - N_FACES_ORIG = N_FACES - N_VOLUS_ORIG = N_VOLUS +REAL(EB), INTENT(IN) :: X_IN(3),H,RADIUS,ROTMAT(3,3),XB(6) +REAL(EB) :: X(3),U(3),V(3),DUX(2),Z0,ZH,R2,DIST_SQUARED - !--- setup a 2D surface (terrain) object (ZVALS keyword ) - ZVALS_IF: IF (N_ZVALS>0) THEN - GEOM_TYPE = TERRAIN_GEOM_TYPE - TERRAIN_CASE= .TRUE. - CALL CHECK_XB(XB) - IF (N_ZVALS/=IJK(1)*IJK(2) ) THEN - WRITE(MESSAGE,'(A,I4,A,I4)') 'ERROR(706): Expected ',IJK(1)*IJK(2),' Z values, found ',N_ZVALS - CALL SHUTDOWN(MESSAGE) - ENDIF - IF (IJK(1)<2 .OR. IJK(2)<2) THEN - CALL SHUTDOWN('ERROR(707): IJK(1) and IJK(2) on &GEOM line needs to be at least 2.') - ENDIF - NXB=0 - DO I = 1, 4 ! first 4 XB values must be set, don't care about 5th and 6th - IF (XB(I)=XHI)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF((XB(3)<=YLOW) .OR. (XB(4)>=YHI)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF(MY_RANK==0 .AND. WRITE_WARNING) WRITE(LU_ERR,'(A,A,A)') 'Warning : Terrain &GEOM ',TRIM(ID),& - ' cannot be extended. When setting EXTEND_TERRAIN=T, make sure it lays entirely within the computational domain.' - ENDIF +X = MATMUL(ROTMAT,X_IN) ! transform center +Z0 = X(3) ! lower cap in new reference frame +ZH = X(3) + H ! upper cap in new reference frame - ! Move Low Z position of terrain to less that number od cutcells, s.t. they don't get computed on the bottom. - ZMIN2= 1.E10_EB - DO NM=1,NMESHES - ZMIN2 = MIN( ZMIN2 , MESHES(NM)%ZS-REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) - ENDDO - ZHI = MAXVAL(ZVALS(1:N_ZVALS)) - ZLOW = MINVAL(ZVALS(1:N_ZVALS)) - ZLOW = MIN(REAL(FLOOR(ZLOW-0.1_EB*(ZHI-ZLOW)),EB),ZMIN,ZMIN2) +! transform vertices and test against end caps, then radius +R2 = RADIUS*RADIUS +V = (/0.5_EB*(XB(1)+XB(2)),0.5_EB*(XB(3)+XB(4)),0.5_EB*(XB(5)+XB(6))/) +U = MATMUL(ROTMAT,V) +IF (U(3)>=Z0 .AND. U(3)<=ZH) THEN + ! centroid is within end-cap range, now test against radius + ! in new frame the distance from centroid to cylinder axis only requires the 1st and 2nd vector components + DUX = U(1:2) - X(1:2) + DIST_SQUARED = DOT_PRODUCT(DUX,DUX) + IF (DIST_SQUARED < R2+TWENTY_EPSILON_EB) THEN + INTERSECT_CYLINDER_AABB = .TRUE. + RETURN + ENDIF +ENDIF - ZVAL_FACTOR = 1._EB - IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. +RETURN +END FUNCTION INTERSECT_CYLINDER_AABB - N_VOLUS = 0; N_VOLUS_ORIG = N_VOLUS +! ---------------------------- ROTATION_MATRIX ---------------------------------------- - ALLOCATE(B_IND(2*(IJK(1)+IJK(2))-3)); B_IND=-1 - ALLOCATE(E_IND(2*(IJK(1)+IJK(2))-3)); E_IND=-1 - ALLOCATE(F_IND(2*(IJK(1)+IJK(2))-3)); F_IND=-1 +SUBROUTINE ROTATION_MATRIX(R_OUT,A_IN,THETA) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - ! First add terrain IJK(1)*IJK(2) vertices: - IJ = 1 - DO J = 1, IJK(2) - DO I = 1, IJK(1) - VERTS(3*IJ-2) = (XB(1)*REAL(IJK(1)-I,EB) + XB(2)*REAL(I-1,EB))/REAL(IJK(1)-1,EB) - VERTS(3*IJ-1) = (XB(3)*REAL(IJK(2)-J,EB) + XB(4)*REAL(J-1,EB))/REAL(IJK(2)-1,EB) - VERTS(3*IJ) = ZVALS(IJ) - IJ = IJ + 1 - ENDDO - ENDDO - N_VERTS_ORIG = IJ-1 +REAL(EB), INTENT(OUT) :: R_OUT(3,3) +REAL(EB), INTENT(IN) :: A_IN(3),THETA +REAL(EB) :: A(3),C,DENOM,V(3),A1(3),A2(3),A3(3),B1(3),B2(3),B3(3),R_THETA(3,3) - ! Boundary indexes: - IJB = 1 - DO J=1,1 - DO I=1,IJK(1) - B_IND(IJB)=(J-1)*IJK(1)+I - IJB = IJB + 1 - ENDDO - ENDDO - DO J=2,IJK(2) - DO I=IJK(1),IJK(1) - B_IND(IJB)=(J-1)*IJK(1)+I - IJB = IJB + 1 - ENDDO - ENDDO - DO J=IJK(2),IJK(2) - DO I=IJK(1)-1,1,-1 - B_IND(IJB)=(J-1)*IJK(1)+I - IJB = IJB + 1 - ENDDO - ENDDO - DO J=IJK(2)-1,2,-1 - DO I=1,1 - B_IND(IJB)=(J-1)*IJK(1)+I - IJB = IJB + 1 - ENDDO - ENDDO - B_IND(IJB)= B_IND(1) ! Last point equal to first. +! initialize 2D rotation matrix +! this is a counterclockwise rotation +R_THETA = 0._EB +R_THETA(1,1) = COS(THETA*DEG2RAD); R_THETA(1,2) = SIN(THETA*DEG2RAD) +R_THETA(2,1) = -SIN(THETA*DEG2RAD); R_THETA(2,2) = COS(THETA*DEG2RAD) +R_THETA(3,3) = 1._EB - ! Now add terrain 2*(IJK(1)-1)*(IJK(2)-1) faces: - IJF = 1 - DO J = 1, IJK(2) - 1 - DO I = 1, IJK(1) - 1 - I1 = (J-1)*IJK(1) + I - I2 = I1 + 1 - I3 = I2 + IJK(1) - I4 = I3 - 1 +! initialize R_OUT as 2D rotation matrix +R_OUT = R_THETA - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +! normalize input vector +DENOM = SQRT(DOT_PRODUCT(A_IN,A_IN)) +IF (DENOM0._EB) THEN + RETURN + ELSE + R_OUT = -R_OUT + RETURN + ENDIF +ENDIF - ! Hi X along Y: from IJK(1)*IJK(2) + IJK(1) + 1 : IJK(1)*IJK(2) + IJK(1) + IJK(2) - 2 - DO J=2,IJK(2) - DO I=IJK(1),IJK(1) - VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) - VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) - VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON - E_IND(IJE) = IJ - IJE= IJE + 1 - IJ = IJ + 1 - ENDDO - ENDDO +! find orthnormal basis for A=A3 in old system - ! Hi Y along X: from IJK(1)*IJK(2) + IJK(1) + IJK(2) - 1 : IJK(1)*IJK(2) + 2*IJK(1) + IJK(2) - 2 - DO J=IJK(2),IJK(2) - DO I=IJK(1)-1,1,-1 - VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) - VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) - VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON - E_IND(IJE) = IJ - IJE= IJE + 1 - IJ = IJ + 1 - ENDDO - ENDDO +A3 = A +CALL CROSS_PRODUCT(A2,B3,A3) +CALL CROSS_PRODUCT(A1,A2,A3) - ! Low X Along Y: from IJK(1)*IJK(2) + 2*IJK(1) + IJK(2) - 1 : IJK(1)*IJK(2) + 2*(IJK(1)+IJK(2)) - 4 - DO J=IJK(2)-1,2,-1 - DO I=1,1 - VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) - VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) - VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON - E_IND(IJE) = IJ - IJE= IJE + 1 - IJ = IJ + 1 - ENDDO - ENDDO - E_IND(IJE) = E_IND(1) ! Last point equal to first. +! rotation matrix (direction cosines), Pope (2000), Eq. (A.11) - DO I=1,IJE-1 - VERTS(3*IJ-2) = VERTS(3*E_IND(I)-2) - VERTS(3*IJ-1) = VERTS(3*E_IND(I)-1) - VERTS(3*IJ) = ZLOW - F_IND(I) = IJ - IJ = IJ + 1 - ENDDO - F_IND(IJE) = F_IND(1) ! Last lower point equal to the first. +R_OUT(1,1) = DOT_PRODUCT(A1,B1); R_OUT(1,2) = DOT_PRODUCT(A1,B2); R_OUT(1,3) = DOT_PRODUCT(A1,B3) +R_OUT(2,1) = DOT_PRODUCT(A2,B1); R_OUT(2,2) = DOT_PRODUCT(A2,B2); R_OUT(2,3) = DOT_PRODUCT(A2,B3) +R_OUT(3,1) = DOT_PRODUCT(A3,B1); R_OUT(3,2) = DOT_PRODUCT(A3,B2); R_OUT(3,3) = DOT_PRODUCT(A3,B3) - ! Remaining Faces: - ! Extension faces: - DO I=1,2*(IJK(1)+IJK(2))-4 - I1 = E_IND(I) - I2 = E_IND(I+1) - I3 = B_IND(I+1) - I4 = B_IND(I) +R_OUT = MATMUL(R_OUT,R_THETA) - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +! ! test +! print *,R_OUT(1,:) +! print *,R_OUT(2,:) +! print *,R_OUT(3,:) +! print *,MATMUL(R_OUT,A) ! result should be B3 +! stop - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO +END SUBROUTINE ROTATION_MATRIX + +! ---------------------------- INTERSECT_CONE_AABB ---------------------------------------- - ! Side faces: - DO I=1,2*(IJK(1)+IJK(2))-4 - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = E_IND(I+1) - I4 = E_IND(I) +! This routine basically follows the INTERSECT_CYLINDER_AABB algorithm, with radius = R(Z) - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +LOGICAL FUNCTION INTERSECT_CONE_AABB(X_IN,H,RADIUS,ROTMAT,XB) - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO +REAL(EB), INTENT(IN) :: X_IN(3),H,RADIUS,ROTMAT(3,3),XB(6) +REAL(EB) :: X(3),U(3),V(3),DUX(2),Z0,ZH,DIST_SQUARED,R_Z +INTEGER :: II,JJ,KK - ELSE - ! Do not Extend to domain boundary: - DO I=1,IJB-1 - VERTS(3*IJ-2) = VERTS(3*B_IND(I)-2) - VERTS(3*IJ-1) = VERTS(3*B_IND(I)-1) - VERTS(3*IJ) = ZLOW - F_IND(I) = IJ - IJ = IJ + 1 - ENDDO - F_IND(IJB) = F_IND(1) ! Last lower point equal to the first. +INTERSECT_CONE_AABB=.FALSE. - ! Side faces: - DO I=1,2*(IJK(1)+IJK(2))-4 - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = B_IND(I+1) - I4 = B_IND(I) +X = MATMUL(ROTMAT,X_IN) ! transform center +Z0 = X(3) ! lower cap in new reference frame +ZH = X(3) + H ! upper cap in new reference frame - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +! transform vertices and test against end caps, then radius +DO KK=5,6 + DO JJ=3,4 + DO II=1,2 + V = (/XB(II),XB(JJ),XB(KK)/) + U = MATMUL(ROTMAT,V) + IF (U(3)>=Z0 .AND. U(3)<=ZH) THEN + ! vertex is within end-cap range, now test against radius + ! in new frame the distance from vertex to CONE axis only requires the 1st and 2nd vector components + DUX = U(1:2) - X(1:2) + DIST_SQUARED = DOT_PRODUCT(DUX,DUX) + R_Z = RADIUS*(1._EB-(U(3)-Z0)/H) + IF (DIST_SQUARED < R_Z*R_Z+TWENTY_EPSILON_EB) THEN + INTERSECT_CONE_AABB = .TRUE. + RETURN + ENDIF + ENDIF + ENDDO + ENDDO +ENDDO - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO +RETURN +END FUNCTION INTERSECT_CONE_AABB - ENDIF +! ---------------------------- INTERSECT_OBB_AABB ---------------------------------------- - ! Bottom Faces: - ! First Face: - I = 1 - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = F_IND(2*(IJK(1)+IJK(2))-3-I) - FACES(3*IJF-2) = I2 - FACES(3*IJF-1) = I1 - FACES(3*IJF) = I3 - IJF = IJF + 1 +! Intersect an Oriented Bounding Box (OBB) with an Axis-Aligned Bounding Box (AABB) +! First, rotate AABB into OBB frame. +! Then test each vertex. - DO I=2,(2*(IJK(1)+IJK(2))-6)/2 - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = F_IND(2*(IJK(1)+IJK(2))-3-I) - I4 = F_IND(2*(IJK(1)+IJK(2))-2-I) +LOGICAL FUNCTION INTERSECT_OBB_AABB(X_IN,L,W,H,ROTMAT,XB) - FACES(3*IJF-2) = I2 - FACES(3*IJF-1) = I1 - FACES(3*IJF) = I4 - IJF = IJF + 1 +REAL(EB), INTENT(IN) :: X_IN(3),L,W,H,ROTMAT(3,3),XB(6) +REAL(EB) :: X(3),U(3),V(3),X0,XL,Y0,YW,Z0,ZH +INTEGER :: II,JJ,KK - FACES(3*IJF-2) = I2 - FACES(3*IJF-1) = I4 - FACES(3*IJF) = I3 - IJF = IJF + 1 +INTERSECT_OBB_AABB=.FALSE. + +X = MATMUL(ROTMAT,X_IN) ! transform center +X0 = X(1) - 0.5_EB*L - TWENTY_EPSILON_EB +XL = X(1) + 0.5_EB*L + TWENTY_EPSILON_EB +Y0 = X(2) - 0.5_EB*W - TWENTY_EPSILON_EB +YW = X(2) + 0.5_EB*W + TWENTY_EPSILON_EB +Z0 = X(3) - 0.5_EB*H - TWENTY_EPSILON_EB +ZH = X(3) + 0.5_EB*H + TWENTY_EPSILON_EB + +! transform and test vertices (probably a more efficient way, but just to get going...) +DO KK=5,6 + DO JJ=3,4 + DO II=1,2 + V = (/XB(II),XB(JJ),XB(KK)/) + U = MATMUL(ROTMAT,V) + IF (U(1)>X0 .AND. U(1)Y0 .AND. U(2)Z0 .AND. U(3)MAX_FACES) .AND. .NOT.READ_BINARY) THEN - ALLOCATE(VERTS_AUX(3*N_VERTS)); VERTS_AUX(1:3*N_VERTS)= VERTS(1:3*N_VERTS) - ALLOCATE(FACES_AUX(4*N_FACES)); FACES_AUX(1:4*N_FACES)= FACES(1:4*N_FACES) - ALLOCATE(SURFS2(N_FACES)); SURFS2(1:N_FACES) = SURFS(1:N_FACES) - MAX_FACES = 2*N_FACES ! Enough for square structured triangulations of more that 200 triangs with domain extension. - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - DEALLOCATE(VERTS,FACES,TFACES); - ALLOCATE(VERTS(3*MAX_VERTS+1)); ALLOCATE(TFACES(6*MAX_FACES+1)); ALLOCATE(FACES(4*MAX_FACES+1)) - VERTS=1.001_EB*MAX_VAL; FACES=0 - VERTS(1:3*N_VERTS) = VERTS_AUX(1:3*N_VERTS) - FACES(1:4*N_FACES) = FACES_AUX(1:4*N_FACES) - DEALLOCATE(SURFS); ALLOCATE(SURFS(MAX_FACES)); - IF(SURF_INDEX_PER_FACE) THEN - SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). - ELSE - SURFS(:) = 0 ! All external faces point to default surf ID. - ENDIF - SURFS(1:N_FACES) = SURFS2(1:N_FACES) - DEALLOCATE(VERTS_AUX,FACES_AUX,SURFS2) - ENDIF +VERT_VALS(1:NVERTS) = 0.0_FB +COUNT(1:NVERTS) = 0 +DO I = 1, NFACES + V(1:3) => FACES(3*I-2:3*I) + V(1:3) = VERT_UNIQUE(V(1:3)) + VERT_VALS(V(1)) = VERT_VALS(V(1)) + FACE_VALS(I) + COUNT(V(1)) = COUNT(V(1)) + 1 + VERT_VALS(V(2)) = VERT_VALS(V(2)) + FACE_VALS(I) + COUNT(V(2)) = COUNT(V(2)) + 1 + VERT_VALS(V(3)) = VERT_VALS(V(3)) + FACE_VALS(I) + COUNT(V(3)) = COUNT(V(3)) + 1 +ENDDO +DO I = 1, NVERTS + IF (COUNT(I) .GT. 1) VERT_VALS(I) = VERT_VALS(I)/REAL(COUNT(I), FB) +ENDDO +DO I = 1, NVERTS + IF (VERT_UNIQUE(I) .NE. I) VERT_VALS(I) = VERT_VALS(VERT_UNIQUE(I)) +ENDDO + +END SUBROUTINE AVERAGE_FACE_VALUES - ! First get EDGES arrays to find edges attached to only one face: - I = SIZE(FACES,DIM=1) - ALLOCATE(EDGES(NOD1:NOD2,3*N_FACES),FACE_EDGES(EDG1:EDG3,N_FACES),EDGE_FACES(5,3*N_FACES)) - CALL GET_GEOM_EDGES(N_VERTS,N_FACES,I,FACES,N_EDGES,EDGES,FACE_EDGES,EDGE_FACES) +! ---------------------------- MAKE_UNIQUE_VERT_ARRAY ---------------------------------------- - ! FIND SET OF EDGES: - ALLOCATE(NBND_EDGE(1:N_EDGES)); NBND_EDGE(1:N_EDGES) = 2 - EDGE_FACES(1,1:N_EDGES) ! 0 if interior edge, 1 bnd. - N_BEDGES = SUM(NBND_EDGE(1:N_EDGES)) - ALLOCATE(BOUND_EDGES(2,N_BEDGES),BOUND_EDGES2(2,N_BEDGES)); BOUND_EDGES = 0; BOUND_EDGES2 = 0 - ALLOCATE(COUNTED_EDGES(1:N_BEDGES)); COUNTED_EDGES = 0 - ! Reorder Edges in counter-clockwise (x-y plane) direction: - ! First copy edges in correct counter-clockwise outside node order: - J=0 - DO I=1,N_EDGES - IF(NBND_EDGE(I)/=1) CYCLE - J=J+1 - IF(EDGE_FACES(2,I)>0) THEN - BOUND_EDGES(NOD1:NOD2,J) = EDGES( (/ NOD1,NOD2 /) , I ) - ELSEIF(EDGE_FACES(4,I)>0) THEN - BOUND_EDGES(NOD1:NOD2,J) = EDGES( (/ NOD2,NOD1 /) , I ) - ENDIF - ENDDO +! construct an array that points to first vertex in a vertex array when one or more vertices are identical - ! Then reorder-copy edges: - J = 1; I = 1 - BOUND_EDGES2(NOD1:NOD2,J) = BOUND_EDGES(NOD1:NOD2,I); COUNTED_EDGES(I) = 1 - DO J=2,N_BEDGES - DO I=1,N_BEDGES - IF(COUNTED_EDGES(I)==1) CYCLE - IF(BOUND_EDGES2(NOD2,J-1)==BOUND_EDGES(NOD1,I)) THEN ! Found new edge: - BOUND_EDGES2(NOD1:NOD2,J) = BOUND_EDGES(NOD1:NOD2,I); COUNTED_EDGES(I) = 1 - EXIT - ENDIF - ENDDO - IF(I>N_BEDGES) THEN ! Error - WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(709): For terrain GEOM ',TRIM(ID),& - ' unconnected boundary edge at node number,',BOUND_EDGES2(NOD2,J-1),'.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - DO I=1,N_BEDGES - IF (COUNTED_EDGES(I) /= 1) THEN - WRITE(MESSAGE,'(A,A,A,2I8,A)') 'ERROR(710): For terrain GEOM ',TRIM(ID),& - ' unconnected boundary edge at nodes,',BOUND_EDGES(NOD1:NOD2,I),'.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - ! Here all edges are counted and SUM(COUNTED_EDGES(1:N_BEDGES)==N_BEDGES): - BOUND_EDGES(NOD1:NOD2,1:N_BEDGES) = BOUND_EDGES2(NOD1:NOD2,1:N_BEDGES); - DEALLOCATE(NBND_EDGE,COUNTED_EDGES,BOUND_EDGES2) +SUBROUTINE MAKE_UNIQUE_VERT_ARRAY(VERTS, VERT_UNIQUE, NVERTS) +INTEGER, INTENT(IN) :: NVERTS +REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) +INTEGER, INTENT(OUT) :: VERT_UNIQUE(NVERTS) + +INTEGER :: PERM(NVERTS) +INTEGER :: I, RESULT + +DO I = 1, NVERTS + PERM(I) = I + VERT_UNIQUE(I) = I +ENDDO +CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, 1, NVERTS) - IF (EXTEND_TERRAIN) THEN - ! Find XLOW,XHI,YLOW,YHI for the set of NM meshes defined: - XLOW = 1.E10_EB - XHI =-1.E10_EB - YLOW = 1.E10_EB - YHI =-1.E10_EB - DO NM=1,NMESHES - XLOW = MIN(XLOW,MESHES(NM)%XS) - XHI = MAX(XHI ,MESHES(NM)%XF) - YLOW = MIN(YLOW,MESHES(NM)%YS) - YHI = MAX(YHI ,MESHES(NM)%YF) - ENDDO - WRITE_WARNING=.FALSE. - IF(ANY(VERTS(1:3:3*N_VERTS-2) <= XLOW)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF(ANY(VERTS(1:3:3*N_VERTS-2) >= XHI )) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF(ANY(VERTS(2:3:3*N_VERTS-1) <= YLOW)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF(ANY(VERTS(2:3:3*N_VERTS-1) >= YHI )) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF(MY_RANK==0 .AND. WRITE_WARNING) WRITE(LU_ERR,'(A,A,A)') 'Warning : Terrain &GEOM ',TRIM(ID),& - ' cannot be extended. When setting EXTEND_TERRAIN=T, make sure it lays entirely within the computational domain.' - ENDIF - ! Move Low Z position of terrain to less that number od cutcells, s.t. they don't get computed on the bottom. - ZMIN2= 1.E10_EB - DELTZ= 0._EB - DO NM=1,NMESHES - DELTZ = MAX( DELTZ , REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) - ZMIN2 = MIN( ZMIN2 , MESHES(NM)%ZS-REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) - ENDDO - ZHI =-1.E10_EB - ZLOW = 1.E10_EB - DO I=1,N_VERTS - ZLOW = MIN(ZLOW,VERTS(3*I)) - ZHI = MAX(ZHI ,VERTS(3*I)) - ENDDO - ! Take the min of LOWZ_VERTS-NGUARD*DZ, ZMIN from input, ZMIN_MESH-NGUARD*DZ: - ZLOW = MIN(ZLOW-DELTZ,ZMIN,ZMIN2) +DO I = 1, NVERTS - 1 + CALL COMPARE_VERTS(VERTS, NVERTS, PERM(I), PERM(I+1), RESULT) + IF (RESULT == 0) VERT_UNIQUE(PERM(I+1)) = VERT_UNIQUE(PERM(I)) +END DO - ZVAL_FACTOR = 1._EB - IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. +END SUBROUTINE MAKE_UNIQUE_VERT_ARRAY - N_VOLUS = 0 +! ---------------------------- COMPARE_VERTS ---------------------------------------- - ALLOCATE(B_IND(2*N_BEDGES+1)); B_IND=-1 - ALLOCATE(E_IND(2*N_BEDGES+1)); E_IND=-1 - ALLOCATE(F_IND(2*N_BEDGES+1)); F_IND=-1 +! returns -1, 0, 1 when a vertex I is less than, the same or greater than vertex J - B_IND(1:N_BEDGES) = BOUND_EDGES(NOD1,1:N_BEDGES); B_IND(N_BEDGES+1) = B_IND(1) ! Last equal to first +SUBROUTINE COMPARE_VERTS(VERTS, NVERTS, I, J, RESULT) +INTEGER, INTENT(IN) :: NVERTS +REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) +INTEGER, INTENT(IN) :: I, J +INTEGER, INTENT(OUT) :: RESULT +REAL(FB) :: TOLERANCE=0.00001_FB - ! All vertices in counter-clockwise dir are in BOUND_EDGES(NOD1,1:N_BEDGES) - ! IF EXTEND_TERRAIN, of this vertex list find the 4 points SW, SE, NW, NE closest to the boundary of the domain. - IF (EXTEND_TERRAIN) THEN +IF (VERTS(3*I-2) < VERTS(3*J-2) - TOLERANCE) THEN + RESULT = -1 + RETURN +ENDIF +IF (VERTS(3*I-2) > VERTS(3*J-2) + TOLERANCE) THEN + RESULT = 1 + RETURN +ENDIF +IF (VERTS(3*I-1) < VERTS(3*J-1) - TOLERANCE) THEN + RESULT = -1 + RETURN +ENDIF +IF (VERTS(3*I-1) > VERTS(3*J-1) + TOLERANCE) THEN + RESULT = 1 + RETURN +ENDIF +IF (VERTS(3*I ) < VERTS(3*J ) - TOLERANCE) THEN + RESULT = -1 + RETURN +ENDIF +IF (VERTS(3*I ) > VERTS(3*J ) + TOLERANCE) THEN + RESULT = 1 + RETURN +ENDIF +RESULT = 0 +RETURN +END SUBROUTINE COMPARE_VERTS - B_IND(N_BEDGES+1:2*N_BEDGES) = B_IND(1:N_BEDGES) - B_IND(2*N_BEDGES+1) = B_IND(1) +! ---------------------------- MAKE_PERMUTATION_ARRAY ---------------------------------------- - ! Find the 4 points closest to SE, NE, NW, SW corners. - CORNER_PT(IAXIS:JAXIS,NOD1) = (/ XHI , YLOW /) ! SE - CORNER_PT(IAXIS:JAXIS,NOD2) = (/ XHI , YHI /) ! NE - CORNER_PT(IAXIS:JAXIS,NOD3) = (/ XLOW, YHI /) ! NW - CORNER_PT(IAXIS:JAXIS,NOD4) = (/ XLOW, YLOW /) ! SW - CORNER_PT(IAXIS:JAXIS,NOD4+1)= CORNER_PT(IAXIS:JAXIS,NOD1) ! SE - CLOSE_PT(:) = 0 - DO ICPT=NOD1,NOD4 - ! Search in B_IND vertices which is closest: - DIST=1.E10_EB - DO I=1,N_BEDGES - DISTI = SQRT( ( CORNER_PT(IAXIS,ICPT)-VERTS(3*B_IND(I)-2) )**2._EB + & - ( CORNER_PT(JAXIS,ICPT)-VERTS(3*B_IND(I)-1) )**2._EB ) - IF(DISTI >= DIST) CYCLE - CLOSE_PT(ICPT) = I - DIST = DISTI - ENDDO - ENDDO - DO ICPT=NOD2,NOD4 - IF(CLOSE_PT(ICPT) < CLOSE_PT(ICPT-1)) CLOSE_PT(ICPT) = CLOSE_PT(ICPT) + N_BEDGES ! Pad corner nodes. - ENDDO - CLOSE_PT(NOD4+1) = CLOSE_PT(NOD1) + N_BEDGES +! sort a vertex array in increasing order and store the order in a permutation array +! PERM(1) is the 1st vertex, PERM(2) is the 2nd and so on - ! These points are mapped to domain external corners, rest of the points are mapped to corresponding domain - ! External boundaries. - IJ = N_VERTS + 1 - DO ICPT=NOD1,NOD4 - IJE = CLOSE_PT(ICPT+1) - CLOSE_PT(ICPT); - IF (IJE <= 0) THEN - WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(711): For terrain GEOM ',TRIM(ID),& - ' same boundary vertex ',B_IND(CLOSE_PT(ICPT)),' closest to 2 domain corners.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - DISTI = SQRT( ( CORNER_PT(IAXIS,ICPT+1)-CORNER_PT(IAXIS,ICPT) )**2._EB + & - ( CORNER_PT(JAXIS,ICPT+1)-CORNER_PT(JAXIS,ICPT) )**2._EB ) / REAL(IJE,EB) - ! Place points in extended domain: - J = 0 - DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 - VERTS(3*IJ-2) = CORNER_PT(IAXIS,ICPT) + DISTI*VERXY(IAXIS,ICPT)*REAL(J,EB) - VERTS(3*IJ-1) = CORNER_PT(JAXIS,ICPT) + DISTI*VERXY(JAXIS,ICPT)*REAL(J,EB) - VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*VERTS(3*B_IND(I)) + ZVAL_FACTOR*ZVAL_HORIZON - E_IND(I) = IJ - IJ = IJ + 1 - J = J + 1 - ENDDO - ENDDO - E_IND(CLOSE_PT(NOD4+1)) = E_IND(CLOSE_PT(NOD1)) +RECURSIVE SUBROUTINE MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, FIRST, LAST) +INTEGER, INTENT(IN) :: NVERTS +REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) +INTEGER, INTENT(INOUT) :: PERM(NVERTS) +INTEGER, INTENT(IN) :: FIRST, LAST +INTEGER :: PERM_COPY(NVERTS) +INTEGER RESULT - ! Add the floor F_IND Vertices: - X_CEN = 0 - Y_CEN = 0 - DO ICPT=NOD1,NOD4 - DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 - VERTS(3*IJ-2) = VERTS(3*E_IND(I)-2) - VERTS(3*IJ-1) = VERTS(3*E_IND(I)-1) - VERTS(3*IJ) = ZLOW - F_IND(I) = IJ - X_CEN = X_CEN + VERTS(3*E_IND(I)-2) - Y_CEN = Y_CEN + VERTS(3*E_IND(I)-1) - IJ = IJ + 1 - ENDDO - ENDDO - F_IND(CLOSE_PT(NOD4+1)) = F_IND(CLOSE_PT(NOD1)) +INTEGER :: MID, I, I1, I2, IP1, IP2, N, N1, N2 - ! Add center point: - VERTS(3*IJ-2) = X_CEN / REAL(N_BEDGES,EB) - VERTS(3*IJ-1) = Y_CEN / REAL(N_BEDGES,EB) - VERTS(3*IJ) = ZLOW - IJ = IJ + 1 +IF (FIRST .EQ. LAST)RETURN ! only one element in list so don't need to sort - ! Add extend faces: - IJF = N_FACES + 1 - DO ICPT=NOD1,NOD4 - DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 - I1 = E_IND(I) - I2 = E_IND(I+1) - I3 = B_IND(I+1) - I4 = B_IND(I) +! FIRST .... LAST original list +! FIRST ... MID first half of list +! MID+1 ... LAST 2nd half of list - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +MID = (FIRST + LAST)/2 - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO - ENDDO +CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, FIRST, MID) ! sort first half of list +CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, MID+1, LAST) ! sort 2nd half of list - ! Add side faces: - DO ICPT=NOD1,NOD4 - DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = E_IND(I+1) - I4 = E_IND(I) +! combine two lists into one +I1 = 1 +I2 = 1 +N1 = MID + 1 - FIRST +N2 = LAST - MID +N = LAST + 1 - FIRST +DO I = 1, N + IF (I1 .GT. N1 ) THEN ! no more in 1st half so copy item from 2nd half + IP2 = PERM(MID + I2) + PERM_COPY(I) = IP2 + I2 = I2 + 1 + CYCLE + ENDIF - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 + IF (I2 .GT. N2 ) THEN ! no more in 2nd half so copy item from first half + IP1 = PERM(FIRST + I1 - 1) + PERM_COPY(I) = IP1 + I1 = I1 + 1 + CYCLE + ENDIF - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO - ENDDO + IP1 = PERM(FIRST + I1 - 1) + IP2 = PERM(MID + I2) + CALL COMPARE_VERTS(VERTS, NVERTS, IP1, IP2, RESULT) + IF (RESULT .EQ. -1) THEN ! sort in increasing order + PERM_COPY(I) = IP1 + I1 = I1 + 1 + ELSE + PERM_COPY(I) = IP2 + I2 = I2 + 1 + ENDIF +END DO +DO I = 1, N + PERM(FIRST + I - 1) = PERM_COPY(I) +END DO - ! Add bottom faces: - DO ICPT=NOD1,NOD4 - DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 - I1 = F_IND(I) - I2 = IJ - 1 ! ZLOW center vert. - I3 = F_IND(I+1) +END SUBROUTINE MAKE_PERMUTATION_ARRAY - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 - ENDDO - ENDDO +END MODULE COMPLEX_GEOMETRY + + +!> \brief Grid related complex-geometry routines. - ELSE +MODULE COMPLEX_GEOMETRY_GRID - ! Add the floor F_IND Vertices: - IJ = N_VERTS + 1 - X_CEN = 0 - Y_CEN = 0 - DO I=1,N_BEDGES - VERTS(3*IJ-2) = VERTS(3*B_IND(I)-2) - VERTS(3*IJ-1) = VERTS(3*B_IND(I)-1) - VERTS(3*IJ) = ZLOW - F_IND(I) = IJ - X_CEN = X_CEN + VERTS(3*B_IND(I)-2) - Y_CEN = Y_CEN + VERTS(3*B_IND(I)-1) - IJ = IJ + 1 - ENDDO - F_IND(N_BEDGES+1) = F_IND(1) ! Last lower point equal to the first. +USE PRECISION_PARAMETERS, ONLY: EB +USE GLOBAL_CONSTANTS +USE MESH_POINTERS +USE COMP_FUNCTIONS, ONLY: CURRENT_TIME +USE TYPES, ONLY: BOUNDARY_COORD_TYPE, BOUNDARY_PROP1_TYPE, CFACE_TYPE, CC_CUTCELL_TYPE, CC_CUTFACE_TYPE, & + CC_CUTEDGE_TYPE, WALL_TYPE, EXTERNAL_WALL_TYPE +USE COMPLEX_GEOMETRY, ONLY: BLOCK_CC_SOLID_EXTWALLCELLS,GEOFCT,CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,CCGUARD, & + CC_MATVEC_DEFINED,GEOMEPS,DELTA_INT,DELTA_VERT,DEBUG_SET_CUTCELLS,DEBUG_WAIT,DIST_THRES, & + GET_CARTCELL_CUTCELLS_TIME_INDEX,BODINT_PLANE_TYPE,INTERSECT_CONE_AABB,INTERSECT_CYLINDER_AABB, & + INTERSECT_OBB_AABB,INTERSECT_SPHERE_AABB,READ_GEOM,ROTATION_MATRIX,WRITE_GEOM,WRITE_GEOM_ALL,CC_SOLID, & + CC_VGSC,CC_CGSC,CC_FGSC,CC_IDCF,CC_UNKZ,CC_GASPHASE,CC_CUTCFE,CC_IDRC,CC_FTYPE_CFGAS,CC_FTYPE_CFINB, & + CC_FTYPE_RGGAS,CC_IDCC,CC_EGSC,CC_IDCE,CC_INBOUNDARY,CC_UNDEFINED,CC_NCVARS,CC_UNKH,CC_UNKF, & + FDS_AREA_GEOM,INDEX_UNDEFINED,INIT_CFACE_CELL,INT_N_EXT_PTS,INT_P_IND,INT_TMP_IND,INT_VEL_IND, & + INT_RHO_IND,INT_H_IND,INT_RSUM_IND,INT_MU_IND,INT_MUDNS_IND,INT_RHO0_IND,INT_FV_IND,INT_DHDX_IND, & + INT_WCEN_IND,INT_VELS_IND,CC_ETYPE_EP,CC_ETYPE_SCINB,CC_FTYPE_SVERT,CC_ETYPE_RCGAS,CC_ETYPE_RGGAS, & + CC_ETYPE_CFGAS,CC_FTYPE_RCGAS,CC_FTYPE_CCGAS,GET_REGULAR_CUT_EDGES_BC,GET_SOLID_CUTCELL_EDGES_BC, & + LOOSEPS,LU_SETCC,MAX_INTERP_POINTS,MESH_CC_EXCHANGE_TIME_INDEX,CCCOMPUTE_RADIATION_TIME_INDEX, & + CC_DENSITY_TIME_INDEX,CC_SET_DATA_TIME_INDEX,INIT_CUTCELL_DATA_TIME_INDEX,CC_VELOCITY_FLUX_TIME_INDEX, & + CC_COMPUTE_VISCOSITY_TIME_INDEX,CC_INTERP_FACE_VEL_TIME_INDEX,CC_DIVERGENCE_PART_1_TIME_INDEX, & + CC_END_STEP_TIME_INDEX,CC_TARGET_VELOCITY_TIME_INDEX,CC_NO_FLUX_TIME_INDEX, & + CC_COMPUTE_VELOCITY_ERROR_TIME_INDEX,MIN_VOL_FACTOR,NQT2C,N_CUTCELLS_PROC,NGUARD,N_INB_CUTFACES_PROC, & + N_INT_CVARS,N_INT_CCVARS,N_REG_CUTFACES_PROC,NNZ_ROW_H,N_INT_FVARS,N_LINK_ATTMP_F, & + N_SET_CUTCELLS_3D_CALLS,NM_START,N_REQ11,N_REQ12,N_REQ112,N_REQ13,REQ11,REQ112,REQ12,REQ13, & + BODINT_PLANE,BODINT_PLANE2,CELLRT,FACERT,XFACE,YFACE,ZFACE,XCELL,YCELL,ZCELL,DXFACE,DYFACE,DZFACE, & + DXCELL,DYCELL,DZCELL,X1FACE,X2FACE,X3FACE,X2CELL,X3CELL,DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL, & + CC_N_CRS,CC_MAXCROSS_X2,CC_SVAR_CRS,CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX,CC_IS_CRS2, & + CC_SEG_TAN,X1NOC,X2NOC,X3NOC,SPCELLS_TO_BLOCK,SPCELLS_TO_BLOCK_AUX,N_SPCELLS_TO_BLOCK,IPARM, & + POINT_IN_POLYGON,SEARCH_OTHER_MESHES_FACE,CHECK_WALL_CELL_PLANE_MATCH,CC_INIT_GEOM, & + ALLOCATE_BODINT_PLANE,GET_BODINT_PLANE,GET_X2_INTERSECTIONS,GET_X2_VERTVAR,GET_CARTEDGE_CUTEDGES, & + GET_BODX2_INTERSECTIONS,GET_BODX3_INTERSECTIONS,GET_CARTFACE_CUTEDGES,GET_CARTCELL_CUTEDGES, & + GET_CARTFACE_CUTFACES,GET_CARTCELL_CUTFACES,GET_CARTCELL_CUTCELLS,GET_CELL_LINK_INFO, & + EXCHANGE_CC_NOADVANCE_INFO,BLOCK_SMALL_UNLINKED_CUTCELLS,ALLOC_FACE_STATE_VARS,ALLOC_CELL_STATE_VARS, & + SET_CUTCELLS_TIME_INDEX,TRIANGULATE,TRILINEAR,VALID_TRIANGLE,VAL_TESTX_LOW,VAL_TESTX_HIGH, & + VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH,T_CC_USED,WRITE_SET_CUTCELLS_TIMINGS, & + MAKE_UNIQUE_VERT_ARRAY,AVERAGE_FACE_VALUES,ADIFF_INFO_FACTOR,SNAP_DIST_FACTOR,CC_INBOUNDCC, & + CC_INBOUNDCF,CC_NVVARS,CC_NEVARS,CC_NFVARS,CC_ETYPE_CFINB,NODS_WSEL,EDGS_WSEL,NODS_VLEL,GAMMA_MULT, & + DELTA_TBIN,GLOBAL_DELTA_CELL,GLOBAL_DELTA_EDGE,GLOBAL_DELTA_FACE,BLOCKED_SPECIAL_CELL,CC_NEDGECROSS, & + CC_NCUTEDGE,CC_NCUTFACE,CC_NCUTCELL,ILO_CELL,IHI_CELL,JLO_CELL,JHI_CELL,KLO_CELL,KHI_CELL,ILO_FACE, & + IHI_FACE,JLO_FACE,JHI_FACE,KLO_FACE,KHI_FACE,NXB,NYB,NZB,INSERT_CUT_CELL,INSERT_CUT_FACE, & + CUT_EDGE_ARRAY_REALLOC,NEW_EDGE_ALLOC,CUT_FACE_ARRAY_REALLOC,FACE_DEALLOC,NEW_FACE_ALLOC, & + CUT_CELL_ARRAY_REALLOC,CELL_DEALLOC,NEW_CELL_ALLOC,NOT_BLOCKED,BLOCKED_SPLIT_CELL,BLOCKED_REFI_INTER, & + BLOCKED_CAVITY_CELL - ! Add center point: - VERTS(3*IJ-2) = X_CEN / REAL(N_BEDGES,EB) - VERTS(3*IJ-1) = Y_CEN / REAL(N_BEDGES,EB) - VERTS(3*IJ) = ZLOW - IJ = IJ + 1 +IMPLICIT NONE (TYPE,EXTERNAL) +PRIVATE - ! Add side faces: - IJF = N_FACES + 1 - DO I=1,N_BEDGES - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = B_IND(I+1) - I4 = B_IND(I) +PUBLIC :: GET_CFACE_INDEX, POINT_IN_CFACE, RANDOM_CFACE_XYZ, SET_CUTCELLS_3D - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +CONTAINS - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO +SUBROUTINE SET_CUTCELLS_3D +USE MPI_F08 +USE TRAN, ONLY : TRANS - ! Add bottom faces: - DO I=1,N_BEDGES - I1 = F_IND(I) - I2 = IJ - 1 ! ZLOW center vert. - I3 = F_IND(I+1) +! Local indexes: +INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI +INTEGER :: I,J,K,KK +INTEGER :: X1AXIS, X2AXIS, X3AXIS +INTEGER :: XIAXIS, XJAXIS, XKAXIS +INTEGER :: X2LO, X2HI, X3LO, X3HI +INTEGER :: X2LO_CELL, X2HI_CELL, X3LO_CELL, X3HI_CELL +INTEGER :: ISTR, IEND, JSTR, JEND, KSTR, KEND +INTEGER :: NM, NOM - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 - ENDDO +! Miscellaneous: +REAL(EB), DIMENSION(MAX_DIM) :: PLNORMAL +INTEGER, DIMENSION(MAX_DIM) :: INDX1 +REAL(EB) :: X1PLN, X3RAY +LOGICAL :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY +INTEGER :: NCUTFACE_IAXIS, NCUTFACE_JAXIS, NCUTFACE_KAXIS, ICE1, ICF1, NFACE, IERR, & + NCUTEDGE_IBCC, NCUTEDGE_IBCF +REAL(EB):: CF_AREA_IAXIS=0._EB, CF_AREA_JAXIS=0._EB, CF_AREA_KAXIS=0._EB, & + CF_INXAREA_IAXIS=0._EB,CF_INXAREA_JAXIS=0._EB,CF_INXAREA_KAXIS=0._EB, & + CF_INXSQAREA_IAXIS=0._EB,CF_INXSQAREA_JAXIS=0._EB,CF_INXSQAREA_KAXIS=0._EB, & + CF_JNYSQAREA_IAXIS=0._EB,CF_JNYSQAREA_JAXIS=0._EB,CF_JNYSQAREA_KAXIS=0._EB, & + CF_KNZSQAREA_IAXIS=0._EB,CF_KNZSQAREA_JAXIS=0._EB,CF_KNZSQAREA_KAXIS=0._EB +REAL(EB):: SLEN_GEOM, AREA_GEOM, VOLUME_GEOM, SLEN_IBCC, SLEN, DV(MAX_DIM), XYZCEN_GEOM(MAX_DIM), & + DM_XYZCEN(MAX_DIM), CCGP_XYZCEN(MAX_DIM), DM_XYZCEN_AUX(MAX_DIM), CCGP_XYZCEN_AUX(MAX_DIM) +INTEGER :: SEG(NOD1:NOD2), NEDGE, IEDGE, IFACE, IG - ENDIF +INTEGER :: NCUTFACE_INB, ICC1, ICC2, NCELL, IGC, ICF2, JCF2, JCF, FTYPE, ILH, CELL_BLOCK_IOR +REAL(EB):: CF_AREA_INB=0._EB, CF_INXAREA_INB=0._EB, CF_INXSQAREA_INB=0._EB, & + CF_JNYSQAREA_INB=0._EB, CF_KNZSQAREA_INB=0._EB, CF_AREA_INB_AUX=0._EB, ACRT +REAL(EB):: CC_VOLUME_INB=0._EB, DM_VOLUME=0._EB, GP_VOLUME=0._EB, & + CC_VOLUME_INB_AUX=0._EB, DM_VOLUME_AUX=0._EB, GP_VOLUME_AUX=0._EB +INTEGER, DIMENSION(5) :: MIN_CC_IJK_ICCJCC, MAX_CC_IJK_ICCJCC +REAL(EB):: MIN_CC_VOL, MAX_CC_VOL, MIN_ALPHA_CV, MAX_ALPHA_CV +LOGICAL, ALLOCATABLE, DIMENSION(:) :: CC_COMPUTE_MESH, CC_COMPUTE_MESH_AUX +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_ZMAX_AUX - N_VERTS = IJ - 1 - N_FACES = IJF - 1 +INTEGER :: IW,II,JJ,IIF,JJF,KKF,IIOF,JJOF,KKOF,LOHIF,IOR,CT,NCFACE_CUTCELL,NFACE_CELL,AX,SIDE,ICC,JCC,ICFC,IFC +TYPE(MESH_TYPE), POINTER :: M, M2 +TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC +TYPE(WALL_TYPE), POINTER :: WC +TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC +TYPE(BOUNDARY_PROP1_TYPE), POINTER :: B1 +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTFACE_TYPE), POINTER :: CF +TYPE(CC_CUTEDGE_TYPE), POINTER :: CE +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME +INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) +INTEGER :: IIO,JJO,KKO,IOGC,JOGC,KOGC - DEALLOCATE(B_IND,E_IND,F_IND,BOUND_EDGES) +REAL(EB) :: TNOW - ENDIF ZVALS_IF +LOGICAL :: WRITE_CFACE_STATS = .FALSE. +LOGICAL :: EARLY_RETURN_FROM_SET_CUTCELLS - !--- setup a block object (XB keyword ) +INTEGER, SAVE :: CALL_COUNT = 0 - NXB=0 - DO I = 1, 6 - IF (XB(I) MAX_VOLUS) THEN - MAX_VOLUS = N_VOLUS - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - DEALLOCATE(VERTS,FACES,TFACES,VOLUS); - ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1),VOLUS(4*MAX_VOLUS+1)) - VERTS=1.001_EB*MAX_VAL; FACES=0; VOLUS = 0; - ENDIF +LOGICAL, SAVE :: FIRST_CALL_ARG=.TRUE., FIRST_CALL_ARG2=.TRUE. - ! define verts in box +REAL(EB):: VERT_AUX(IAXIS:KAXIS),CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) +INTEGER :: ING,INOD,IWSEL,IEL,FACE_AUX(NOD1:NOD3),VOL_AUX(NOD1:NOD4),N_SPCELLCF_TOT,N_SPCELL_TOT +CHARACTER(100) :: FILENAME - N_VERTS = 0 - DO K = 0, IJK(3)-1 - BOX_XYZ(3) = (REAL(IJK(3)-1-K,EB)*XB(5) + REAL(K,EB)*XB(6))/REAL(IJK(3)-1,EB) - DO J = 0, IJK(2)-1 - BOX_XYZ(2) = (REAL(IJK(2)-1-J,EB)*XB(3) + REAL(J,EB)*XB(4))/REAL(IJK(2)-1,EB) - DO I = 0, IJK(1)-1 - BOX_XYZ(1) = (REAL(IJK(1)-1-I,EB)*XB(1) + REAL(I,EB)*XB(2))/REAL(IJK(1)-1,EB) - VERTS(3*N_VERTS+1:3*N_VERTS+3) = BOX_XYZ(1:3) - N_VERTS = N_VERTS + 1 - ENDDO - ENDDO - ENDDO +CALL CC_GRID_GLOBAL_INIT +IF (STOP_STATUS==SETUP_STOP) RETURN - ! define tetrahedrons in box +CALL CC_GRID_ALLOCATE_BUILD_SCRATCH - N_VOLUS = 0 - NI = IJK(1) - NIJ = IJK(1)*IJK(2) - DO K = 0, IJK(3)-2 - DO J = 0, IJK(2)-2 - DO I = 0, IJK(1)-2 +! Main Loop over Meshes: +MAIN_MESH_LOOP : DO NM=1,NMESHES + CALL CC_GRID_BUILD_CUTCELL_MESH(NM) + IF (STOP_STATUS==SETUP_STOP) RETURN +ENDDO MAIN_MESH_LOOP - ! 8-------7 - ! / . / | - ! 5-------6 | - ! | . | | - ! | . | | - ! | 4-------3 - ! | / | / - ! 1-------2 - BOXVERTLIST(1) = K*NIJ + J*NI + I + 1 - BOXVERTLIST(2) = BOXVERTLIST(1) + 1 - BOXVERTLIST(3) = BOXVERTLIST(2) + NI - BOXVERTLIST(4) = BOXVERTLIST(3) - 1 - BOXVERTLIST(5) = BOXVERTLIST(1) + NIJ - BOXVERTLIST(6) = BOXVERTLIST(2) + NIJ - BOXVERTLIST(7) = BOXVERTLIST(3) + NIJ - BOXVERTLIST(8) = BOXVERTLIST(4) + NIJ - CALL BOX2TETRA(BOXVERTLIST,VOLUS(4*N_VOLUS+1:4*N_VOLUS+24)) - N_VOLUS = N_VOLUS + 6 - ENDDO - ENDDO - ENDDO - N_FACES=0 - ENDIF NXB_IF +CALL CC_GRID_RELEASE_BUILD_SCRATCH - ! setup a sphere object (SPHERE_RADIUS and SPHERE_ORIGIN keywords) +POSTBUILD_MESH_LOOP : DO NM=1,NMESHES + CALL CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) + IF (STOP_STATUS==SETUP_STOP) RETURN +ENDDO POSTBUILD_MESH_LOOP - IF (SPHERE_RADIUS MESHES(1) - DX = M%DXMIN +MAIN_MESH_LOOP_3 : DO NM=1,NMESHES + CALL CC_GRID_POSTPROCESS_AND_CLEANUP(NM) +ENDDO MAIN_MESH_LOOP_3 - ! 2*PI*R/(5*2^N_LEVELS) ~= DX, solve for N_LEVELS +! Finally allocate Face and cell variables, compute area and volume factors: +MAIN_MESH_LOOP_4 : DO NM=1,NMESHES + CALL CC_GRID_ALLOCATE_STATE_VARS(NM) +ENDDO MAIN_MESH_LOOP_4 - IF (SPHERE_RADIUS<100.0_EB*TWENTY_EPSILON_EB) SPHERE_RADIUS = 100.0_EB*TWENTY_EPSILON_EB +CALL CC_GRID_LOG_PROCESSING_TIME - IF (SPHERE_TYPE/=2) SPHERE_TYPE = 1 - IF (N_LEVELS<0 .AND. N_LAT>0 .AND. N_LONG>0) SPHERE_TYPE = 2 - IF (SPHERE_TYPE==1) THEN - IF (N_LEVELS==-1) N_LEVELS = INT(LOG(2.0_EB*PI*SPHERE_RADIUS/(5.0_EB*DX))/LOG(2.0_EB)) - N_LEVELS = MIN(7,MAX(0,N_LEVELS)) - N_FACES = 20*(4**N_LEVELS+1) ! NOTE : Number larger than actual value. - ELSE - IF (N_LONG<6) N_LONG = MAX(6,INT(2.0_EB*PI*SPHERE_RADIUS/DX)+1) - IF (N_LAT<3) N_LAT = MAX(3,INT(PI*SPHERE_RADIUS/DX)+1) - N_FACES = 2*N_LAT*N_LONG ! NOTE : Number larger than actual value. - ENDIF - IF (N_FACES > MAX_FACES) THEN - MAX_FACES = N_FACES - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - DEALLOCATE(VERTS,FACES,TFACES); - ALLOCATE(VERTS(3*MAX_VERTS+1)); ALLOCATE(TFACES(6*MAX_FACES+1)); ALLOCATE(FACES(4*MAX_FACES+1)) - VERTS=1.001_EB*MAX_VAL; FACES=0 - ENDIF - IF (SPHERE_TYPE==1) THEN - CALL INIT_SPHERE(N_LEVELS,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,VERTS,FACES) - ELSE - CALL INIT_SPHERE2(N_VERTS,N_FACES,N_LAT,N_LONG,VERTS,FACES) - ENDIF - DO I = 0, N_VERTS-1 - VERTS(3*I+1:3*I+3) = SPHERE_ORIGIN(1:3) + SPHERE_RADIUS*VERTS(3*I+1:3*I+3) - ENDDO - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 - IF (TRIM(SURF_ID(1))/='null') SURFS = 1 ! First single SURF_ID entry takes precedence. - ENDIF +CALL CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST - ! Setup a cylinder object (CYLINDER_RADIUS, CYLINDER_LENGTH, CYLINDER_ORIGIN, CYLINDER_AXIS keywords): - DEFINE_CYLINDER_IF: IF ( CYLINDER_LENGTH MAX_FACES) THEN - MAX_FACES = N_FACES - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - DEALLOCATE(VERTS,FACES,TFACES); ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1)) - VERTS=1.001_EB*MAX_VAL; FACES=0 - ENDIF +CALL CC_GRID_WRITE_VERBOSE_SUMMARY - ! Call routine to create cylinder: - CALL DEFINE_CYLINDER(VERTS,MAX_VERTS,N_VERTS,FACES,MAX_FACES,N_FACES,VOLUS,MAX_VOLUS,N_VOLUS,CYL_FIND) +RETURN - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 +CONTAINS - IF (TRIM(SURF_ID(1))/='null') THEN ! First single SURF_ID entry takes precedence. - SURFS = 1 - ELSEIF (TRIM(SURF_IDS(1))/='null' .AND. TRIM(SURF_IDS(2))/='null' .AND. TRIM(SURF_IDS(3))/='null') THEN - SURF_ID(1:3) = SURF_IDS(1:3) - ! Then SURF_IDS(1:3), where (1) is top, (2) sides (3) bottom. - SURFS(CYL_FIND(LOW_IND,1):CYL_FIND(HIGH_IND,1)) = 1 - SURFS(CYL_FIND(LOW_IND,2):CYL_FIND(HIGH_IND,2)) = 2 - SURFS(CYL_FIND(LOW_IND,3):CYL_FIND(HIGH_IND,3)) = 3 - ENDIF +SUBROUTINE CC_GRID_GLOBAL_INIT - ENDIF DEFINE_CYLINDER_IF +IF (MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN + WRITE(LU_ERR,*) ' ' + WRITE(LU_ERR,*) 'SET_CUTCELLS_3D : Cut-Cell computation in VERBOSE mode, 4 tasks to perform:' +ENDIF - ! Setup an extruded POLYGON object: - POLY_COND : IF (N_POLY_VERTS > 0) THEN - IF ( ABS(EXTRUDE) < GEOMEPS ) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR(712): For extruded Polygon GEOM ',TRIM(ID),& - ' : extrusion distance in EXTRUDE field not defined or zero. Define EXTRUDE value in &GEOM.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF +! Reset variables: +CC_NEDGECROSS = 0 +CC_NCUTEDGE = 0 +CC_NCUTFACE = 0 +CC_NCUTCELL = 0 - ! Do some tests in POLY, Repeated vertex, etc.: - IF (N_POLY_VERTS > N_VERTS) THEN - WRITE(MESSAGE,'(A,A,A,I6,A,I6,A)') 'ERROR(713): For extruded Polygon GEOM ',TRIM(ID),& - ' : Number of POLY indexes ',N_POLY_VERTS,' greater than Number of VERTS ',N_VERTS,'.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - DO J=1,N_POLY_VERTS - DO I=J+1,N_POLY_VERTS - IF (POLY(I)==POLY(J)) THEN - WRITE(MESSAGE,'(A,A,A,I6,A)') 'ERROR(714): For extruded Polygon GEOM ',TRIM(ID),& - ' : Repeated vertex ',POLY(I),' in Polyline.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - IF (NORM2(VERTS(3*POLY(I)-2:3*POLY(I))-VERTS(3*POLY(J)-2:3*POLY(J))) < GEOMEPS) THEN - WRITE(MESSAGE,'(A,A,A,I6,A,I6,A)') 'ERROR(715): For extruded Polygon GEOM ',TRIM(ID),& - ' : Vertices ',POLY(I),' and ',POLY(J),' have same position.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - ENDDO +! Check Meshes Boundaries match, requirement to get consistent ghost and internal cut-cells. +CALL CHECK_WALL_CELL_PLANE_MATCH; IF (STOP_STATUS==SETUP_STOP) RETURN - N_FACES = 5*N_POLY_VERTS ! NOTE : Number larger than actual value. - IF (N_FACES > MAX_FACES) THEN - MAX_FACES = N_FACES - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - DEALLOCATE(VERTS,FACES,TFACES); ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1)) - VERTS=1.001_EB*MAX_VAL; FACES=0 - ENDIF +! Get geometry triangle bins in Cartesian directions: +CALL GET_GEOM_TRIBIN - CALL DEFINE_EXTRUDED_POLY(MAX_VERTS,N_VERTS,VERTS,MAX_POLY_VERTS,N_POLY_VERTS,POLY,& - EXTRUDE,MAX_FACES,N_FACES,START_FACE_LO,START_FACE_HI,START_FACE_MID,FACES,IERR) +! Snap to grid planes node positions in the work volume of this process: +CALL SNAP_GEOM_NODES - IF(IERR /= 0) RETURN +! Initialize GEOMETRY fields used by CC_IBM: +CALL CC_INIT_GEOM; IF (STOP_STATUS==SETUP_STOP) RETURN - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 +TNOW=CURRENT_TIME() - IF (TRIM(SURF_ID(1))/='null') THEN ! First single SURF_ID entry takes precedence. - SURFS = 1 - ELSEIF (TRIM(SURF_IDS(1))/='null' .AND. TRIM(SURF_IDS(2))/='null' .AND. TRIM(SURF_IDS(3))/='null') THEN - SURF_ID(1:3) = SURF_IDS(1:3) - ! Then SURF_IDS(1:3), where (1) is top, (2) sides (3) bottom. - SURFS(START_FACE_HI +1:START_FACE_HI+START_FACE_MID) = 1 - SURFS(START_FACE_MID+1:N_FACES) = 2 - SURFS(START_FACE_LO +1:START_FACE_LO+START_FACE_HI) = 3 - ENDIF +DEBUG_SET_CUTCELLS_COND : IF (DEBUG_SET_CUTCELLS) THEN + ! Write meshes file: + WRITE(FILENAME,'(A,A)') TRIM(CHID),'_meshes.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8)') NMESHES + MESH_LOOP : DO NM=1,NMESHES - ENDIF POLY_COND + IF (PROCESS(NM)/=MY_RANK) CYCLE - G%N_LEVELS = N_LEVELS - G%SPHERE_ORIGIN = SPHERE_ORIGIN - G%SPHERE_RADIUS = SPHERE_RADIUS - G%CYLINDER_LENGTH = CYLINDER_LENGTH - G%CYLINDER_RADIUS = CYLINDER_RADIUS - G%CYLINDER_ORIGIN = CYLINDER_ORIGIN - G%CYLINDER_AXIS = CYLINDER_AXIS - G%IJK = IJK - G%GEOM_TYPE = GEOM_TYPE - ! If terrain GEOM and CELL_BLOCK_IOR not set in input line, block in the -3 direction: - IF(GEOM_TYPE==TERRAIN_GEOM_TYPE .AND. CELL_BLOCK_IOR==0) G%CELL_BLOCK_IOR = -KAXIS + ! Mesh sizes: + NXB=MESHES(NM)%IBAR + NYB=MESHES(NM)%JBAR + NZB=MESHES(NM)%KBAR - LOGTEST = GEOM_TYPE==CAD_GEOM_TYPE .OR. GEOM_TYPE==TERRAIN_GEOM_TYPE - IF (.NOT.LOGTEST) THEN - ! The geometry has been constructed from predefined object : Terrain, cube, sphere, etc. - ! This requires removing duplicate verts. - ! For geometries where VERTS, FACES are being read, GEOM_TYPE=CAD_GEOM_TYPE, it is assumed duplicate vertices - ! have already been removed. - FIRST_FACE_INDEX=1 - CALL REMOVE_DUPLICATE_VERTS(N_VERTS,N_FACES,N_VOLUS,MAX_VERTS,MAX_FACES,MAX_VOLUS,FIRST_FACE_INDEX,& - VERTS,FACES,VOLUS,GEOMEPS) - ENDIF + WRITE(33,'(4I8,6F24.16)') NM,NXB,NYB,NZB,MESHES(NM)%X(0),MESHES(NM)%X(NXB),& + MESHES(NM)%Y(0),MESHES(NM)%Y(NYB),& + MESHES(NM)%Z(0),MESHES(NM)%Z(NZB) + DO I=0,NXB + WRITE(33,'(4F24.16)') MESHES(NM)%X(I),MESHES(NM)%XC(I),MESHES(NM)%DXN(I),MESHES(NM)%DX(I) + ENDDO + DO J=0,NYB + WRITE(33,'(4F24.16)') MESHES(NM)%Y(J),MESHES(NM)%YC(J),MESHES(NM)%DYN(J),MESHES(NM)%DY(J) + ENDDO + DO K=0,NZB + WRITE(33,'(4F24.16)') MESHES(NM)%Z(K),MESHES(NM)%ZC(K),MESHES(NM)%DZN(K),MESHES(NM)%DZ(K) + ENDDO - ! wrap up + ENDDO MESH_LOOP + CLOSE(33) - G%ID = ID - G%N_VOLUS_BASE = N_VOLUS - G%N_FACES_BASE = N_FACES - G%N_VERTS_BASE = N_VERTS + ! Write geometry files: + WRITE(FILENAME,'(A,A)') TRIM(CHID),'_num_geometries.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I6,4F24.16)') N_GEOMETRY, GEOMEPS + CLOSE(33) + GEOM_LOOP : DO ING=1,N_GEOMETRY - ! Check if SURF_ID(1) has been defined: - N_SURF_ID = 0 - IF (TRIM(SURF_ID(1))=='null') THEN - SURF_INDEX_PER_FACE = .FALSE. - HAVE_SURF = .FALSE. - ALLOCATE(G%SURF_ID(1)) - G%SURF_ID(1) = 'null' - ELSE - SURF_INDEX_PER_FACE = .TRUE. - ! Check that elements of the list of SURF_IDs are in list of SURFS: - ! How many SURF_ID entries are different than Null, where in SURFACE they belong: - DO I = 1, MAX_SURF_IDS - IF( SURF_ID(I)=='null' ) EXIT ! First 'null' - N_SURF_ID = N_SURF_ID + 1 + ! Write Vertices: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_verts.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO INOD=1,GEOMETRY(ING)%N_VERTS + VERT_AUX(IAXIS:KAXIS) = GEOMETRY(ING)%VERTS(MAX_DIM*(INOD-1)+1:MAX_DIM*INOD) + WRITE(33,'(3F24.16)') VERT_AUX(IAXIS:KAXIS) ENDDO - ALLOCATE(G%SURF_ID(1:N_SURF_ID)) - G%SURF_ID(1:N_SURF_ID) = SURF_ID(1:N_SURF_ID) + CLOSE(33) - ! Now find correspondence with SURFACE(N)%ID: - IF (ALLOCATED(SURF_ID_IND)) DEALLOCATE(SURF_ID_IND) - ALLOCATE(SURF_ID_IND(N_SURF_ID)) - DO I = 1, N_SURF_ID - ! Get Surf Index: - IN_LIST = .FALSE. - DO J = 0, N_SURF - IF (TRIM(SURF_ID(I))/=TRIM(SURFACE(J)%ID)) CYCLE - SURF_ID_IND(I)=J - IN_LIST = .TRUE. - EXIT - ENDDO - IF(.NOT.IN_LIST) THEN - WRITE(MESSAGE,'(A,I4,3A)') 'ERROR(716): problem with GEOM, the surface ID(',I,') =',& - TRIM(SURF_ID(I)),' is not defined.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF + ! Write faces: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_faces.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IWSEL=1,GEOMETRY(ING)%N_FACES + FACE_AUX(NOD1:NOD3)=GEOMETRY(ING)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + WRITE(33,'(4I10)') FACE_AUX(NOD1:NOD3),GEOMETRY(ING)%SURFS(IWSEL) ENDDO - ENDIF - G%HAVE_SURF = HAVE_SURF + CLOSE(33) - IF (MATL_ID=='null') THEN - HAVE_MATL = .FALSE. - ENDIF - G%MATL_ID = MATL_ID - G%HAVE_MATL = HAVE_MATL + ! Write Volumes: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_volus.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_VOLUS + VOL_AUX(NOD1:NOD4)=GEOMETRY(ING)%VOLUS(NODS_VLEL*(IEL-1)+1:NODS_VLEL*IEL) + WRITE(33,'(4I10)') VOL_AUX(NOD1:NOD4) + ENDDO + CLOSE(33) - IF (N_VERTS>0) THEN + ! Write Edges: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edges.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_EDGES + WRITE(33,'(2I10)') GEOMETRY(ING)%EDGES(NOD1:NOD2,IEL) + ENDDO + CLOSE(33) - TXMIN = VERTS(1) - TXMAX = TXMIN - TYMIN = VERTS(2) - TYMAX = TYMIN - DO I = 1, N_VERTS - TX = VERTS(3*I-2) - TY = VERTS(3*I-1) - IF (TXTXMAX)TXMAX=TX - IF (TYTYMAX)TYMAX=TY + ! Write FACE_EDGES: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_fcedg.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_FACES + WRITE(33,'(3I10)') GEOMETRY(ING)%FACE_EDGES(NOD1:NOD3,IEL) ENDDO - TEXTURE_ORIGIN(1)=TXMIN - TEXTURE_ORIGIN(2)=TYMIN - TEXTURE_SCALE(1)=TXMAX-TXMIN - TEXTURE_SCALE(2)=TYMAX-TYMIN - ENDIF + CLOSE(33) + + ! Write EDGE_FACES: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edfac.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_EDGES + WRITE(33,'(5I10)') GEOMETRY(ING)%EDGE_FACES(NOD1:NOD4+1,IEL) + ENDDO + CLOSE(33) - G%TEXTURE_ORIGIN = TEXTURE_ORIGIN - G%TEXTURE_SCALE = TEXTURE_SCALE - IF ( TRIM(TEXTURE_MAPPING)/='SPHERICAL' .AND. TRIM(TEXTURE_MAPPING)/='RECTANGULAR') TEXTURE_MAPPING = 'RECTANGULAR' - G%TEXTURE_MAPPING = TEXTURE_MAPPING - G%IS_TERRAIN = IS_TERRAIN + ENDDO GEOM_LOOP +ENDIF DEBUG_SET_CUTCELLS_COND - ! setup volumes +! Select MESHES assigned to MY_RANK and OMESHES of these. Cut-cells computed for all of them. Done in GET_GEOM_TRIBIN - N_VOLUS_IF: IF (N_VOLUS>0) THEN - ALLOCATE(G%VOLUS(4*N_VOLUS),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%VOLUS',IZERO) - DO I = 0, N_VOLUS-1 - VOL(1:4)=> VOLUS(4*I+1:4*I+4) - V1(1:3) => VERTS(3*VOL(1)-2:3*VOL(1)) - V2(1:3) => VERTS(3*VOL(2)-2:3*VOL(2)) - V3(1:3) => VERTS(3*VOL(3)-2:3*VOL(3)) - V4(1:3) => VERTS(3*VOL(4)-2:3*VOL(4)) - VOLUME = TETRAHEDRON_VOLUME(V3,V4,V2,V1) - IF ( VOLUME<0.0_EB ) THEN ! reorder vertices if tetrahedron volume is negative - IVOL=VOL(3) - VOL(3)=VOL(4) - VOL(4)=IVOL +IF (GET_CUTCELLS_VERBOSE) THEN + NMESH_CC=0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH(NOM)) NMESH_CC = NMESH_CC + 1 + ENDDO + ! MY_RANK = 0 writes first: + IF (MY_RANK==0) THEN + ! Open file to write SET_CUTCELLS_3D progress: + WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' + OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') + WRITE(LU_ERR,*) ' ' + WRITE(LU_ERR,*) '2. Generate Cut-cells in Meshes :' + WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC, & + ' meshes in file ',TRIM(VERBOSE_FILE),'.' + WRITE(LU_SETCC,*) ' ' + WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' + WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC,' meshes.' + WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' + WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process : ' + NMESH_CC_AUX = 0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH(NOM)) THEN + NMESH_CC_AUX = NMESH_CC_AUX + 1 + IF(NMESH_CC_AUX < NMESH_CC) THEN + WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' + WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' + ELSE + WRITE(LU_ERR,'(I4.4,A)') NOM,'.' + WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' + ENDIF ENDIF ENDDO - G%VOLUS(1: 4*N_VOLUS) = VOLUS(1:4*N_VOLUS) - IF (ANY(VOLUS(1:4*N_VOLUS)<1 .OR. VOLUS(1:4*N_VOLUS)>N_VERTS)) THEN - CALL SHUTDOWN('ERROR(717): problem with GEOM, vertex index out of bounds.') - ENDIF - - ALLOCATE(G%MATLS(N_VOLUS),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%MATLS',IZERO) - MATL_INDEX = GET_MATL_INDEX(MATL_ID) - ! The following constraint is removed for the time being. When Tetrahedrons are actually used for heat transfer - ! and pyrolysis this will be needed. - !IF (MATL_INDEX==0) THEN - ! IF (TRIM(MATL_ID)=='null') THEN - ! WRITE(MESSAGE,'(A)') 'ERROR: problem with GEOM, the material keyword, MATL_ID, is not defined.' - ! ELSE - ! WRITE(MESSAGE,'(3A)') 'ERROR: problem with GEOM, the material ',TRIM(MATL_ID),' is not defined.' - ! ENDIF - ! CALL SHUTDOWN(MESSAGE) - !ENDIF - G%MATLS(1:N_VOLUS) = MATL_INDEX - - ! construct an array of external faces + ENDIF + IF (N_MPI_PROCESSES > 1) THEN + IF (MY_RANK==0) ALLOCATE(CC_COMPUTE_MESH_AUX(1:NMESHES)) + ! Now rest of processes pass their mesh info to process 0: + DO IPROC=1,N_MPI_PROCESSES-1 + TAG = 0 + IF (MY_RANK==IPROC) THEN ! Send CC_COMPUTE_MESH array. + TAG=IPROC + CALL MPI_SEND(CC_COMPUTE_MESH(1),NMESHES,MPI_LOGICAL,0,TAG,MPI_COMM_WORLD,IERR) + ! Open file to write SET_CUTCELLS_3D progress: + WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' + OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') + WRITE(LU_SETCC,*) ' ' + WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' + WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC,' meshes.' + WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process :' + NMESH_CC_AUX = 0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH(NOM)) THEN + NMESH_CC_AUX = NMESH_CC_AUX + 1 + IF ( NMESH_CC_AUX < NMESH_CC ) THEN + WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' + ELSE + WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' + ENDIF + ENDIF + ENDDO + ELSEIF (MY_RANK==0) THEN ! Receive CC_COMPUTE_MESH array and write. + TAG=IPROC + CALL MPI_RECV(CC_COMPUTE_MESH_AUX(1),NMESHES,MPI_LOGICAL,IPROC,TAG,MPI_COMM_WORLD,MPISTATUS,IERR) + ! Write to LU_ERR: + NMESH_CC=0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH_AUX(NOM)) NMESH_CC = NMESH_CC + 1 + ENDDO + WRITE(VERBOSE_FILE_AUX,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',IPROC,'.log' + WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC, & + ' meshes in file ',TRIM(VERBOSE_FILE_AUX),'.' + WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' + NMESH_CC_AUX = 0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH_AUX(NOM)) THEN + NMESH_CC_AUX = NMESH_CC_AUX + 1 + IF ( NMESH_CC_AUX < NMESH_CC ) THEN + WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' + ELSE + WRITE(LU_ERR,'(I4.4,A)') NOM,'.' + ENDIF + ENDIF + ENDDO + ENDIF + CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) + ENDDO + IF (MY_RANK==0) DEALLOCATE(CC_COMPUTE_MESH_AUX) + ENDIF + CALL CPU_TIME(CPUTIME_START_MESH) +ENDIF - ! determine which tetrahedron faces are external +IF(N_GEOMETRY>0) THEN + ALLOCATE(GEOM_AREA_SURF_OLD(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_OLD=0._EB + ALLOCATE(GEOM_AREA_SURF_NEW(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_NEW=0._EB +ENDIF - IF (N_FACES==0) THEN - N_FACES = 4*N_VOLUS - IF(ALLOCATED(IS_EXTERNAL)) DEALLOCATE(IS_EXTERNAL) - ALLOCATE(IS_EXTERNAL(0:N_FACES-1),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','IS_EXTERNAL',IZERO) +END SUBROUTINE CC_GRID_GLOBAL_INIT - IS_EXTERNAL(0:N_FACES-1)=.TRUE. ! start off by assuming all faces are external +SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH - ! reorder face indices so the the first index is always the smallest +! Allocate BODINT_PLANE for plane intersections on X1AXIS loop: +IF(PERIODIC_TEST/=7 .AND. PERIODIC_TEST/=11) THEN + CALL ALLOCATE_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) ! To be used in SET_CUTCELLS_3D, GET_CARTCELL_CUTFACES. + CALL ALLOCATE_BODINT_PLANE(BODINT_PLANE2,FIRST_CALL_ARG2) ! To be used in GET_IS_SOLID_3D. +ENDIF - ! 1 - ! /|\ . - ! / | \ . - ! / | \ . - ! / | \ . - ! / | \ . - ! / 4 \ . - ! / . . \ . - ! / . . \ . - ! / . . \ . - ! / . . \ . - ! / . . \ . - ! / . .\ . - ! 2-------------------------3 +! Allocate Intersection variables: +ALLOCATE(CC_SVAR_CRS(CC_MAXCROSS_X2),CC_IS_CRS(CC_MAXCROSS_X2),CC_SEG_CRS(CC_MAXCROSS_X2)) +ALLOCATE(CC_BDNUM_CRS(0:CC_MAXCROSS_X2),CC_BDNUM_CRS_AUX(0:CC_MAXCROSS_X2)) +ALLOCATE(CC_IS_CRS2(LOW_IND:HIGH_IND+1,CC_MAXCROSS_X2),CC_SEG_TAN(IAXIS:JAXIS,CC_MAXCROSS_X2)) - DO I = 0, N_VOLUS-1 - FACES(12*I+1) = VOLUS(4*I+1) - FACES(12*I+2) = VOLUS(4*I+2) - FACES(12*I+3) = VOLUS(4*I+3) - CALL REORDER_VERTS(FACES(12*I+1:12*I+3)) +END SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH - FACES(12*I+4) = VOLUS(4*I+1) - FACES(12*I+5) = VOLUS(4*I+3) - FACES(12*I+6) = VOLUS(4*I+4) - CALL REORDER_VERTS(FACES(12*I+4:12*I+6)) +SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH - FACES(12*I+7) = VOLUS(4*I+1) - FACES(12*I+8) = VOLUS(4*I+4) - FACES(12*I+9) = VOLUS(4*I+2) - CALL REORDER_VERTS(FACES(12*I+7:12*I+9)) +CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE) +CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE2) - FACES(12*I+10) = VOLUS(4*I+2) - FACES(12*I+11) = VOLUS(4*I+4) - FACES(12*I+12) = VOLUS(4*I+3) - CALL REORDER_VERTS(FACES(12*I+10:12*I+12)) - ENDDO +! Deallocate Intersection variables: +DEALLOCATE(CC_SVAR_CRS,CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX,CC_IS_CRS2,CC_SEG_TAN) - ! find faces that match +END SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH - SORT_FACES=2 - IF (GEOM_TYPE == SPHERE_GEOM_TYPE) SORT_FACES = 3 ! Case of sphere. +SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH(NM) - SORT_FACES_IF: IF (SORT_FACES==1 ) THEN ! O(n*log(n)) algorithm for determining external faces - ALLOCATE(OFACES(N_FACES),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','OFACES',IZERO) - CALL ORDER_FACES(OFACES,N_FACES) - DO I = 1, N_FACES-1 - FACEI=>FACES(3*OFACES(I)-2:3*OFACES(I)) - FACEJ=>FACES(3*OFACES(I)+1:3*OFACES(I)+3) - IF (FACEI(1)==FACEJ(1) .AND. & - MIN(FACEI(2),FACEI(3))==MIN(FACEJ(2),FACEJ(3)) .AND. & - MAX(FACEI(2),FACEI(3))==MAX(FACEJ(2),FACEJ(3))) THEN - IS_EXTERNAL(OFACES(I))=.FALSE. - IS_EXTERNAL(OFACES(I-1))=.FALSE. - IF (FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(3)) THEN - WRITE(LU_ERR,*) 'WARNING: duplicate faces found:', FACEI(1),FACEI(2),FACEI(3) - ENDIF - ENDIF - ENDDO - DEALLOCATE(OFACES) - ELSEIF(SORT_FACES==2 ) THEN - DO I = 0, N_FACES-1 ! O(n^2) algorithm for determining external faces - FACEI=>FACES(3*I+1:3*I+3) - ! Sort FACEI: - DO J = 0, N_FACES-1 - IF (I==J) CYCLE - FACEJ=>FACES(3*J+1:3*J+3) - IF (FACEI(1)==FACEJ(1)) THEN - IF ((FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(3)) .OR. & - (FACEI(2)==FACEJ(3) .AND. FACEI(3)==FACEJ(2))) THEN - IS_EXTERNAL(I) = .FALSE. - IS_EXTERNAL(J) = .FALSE. - ENDIF - ELSEIF (FACEI(1)==FACEJ(2)) THEN - IF ((FACEI(2)==FACEJ(1) .AND. FACEI(3)==FACEJ(3)) .OR. & - (FACEI(2)==FACEJ(3) .AND. FACEI(3)==FACEJ(1))) THEN - IS_EXTERNAL(I) = .FALSE. - IS_EXTERNAL(J) = .FALSE. - ENDIF - ELSEIF (FACEI(1)==FACEJ(3)) THEN - IF ((FACEI(2)==FACEJ(1) .AND. FACEI(3)==FACEJ(2)) .OR. & - (FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(1))) THEN - IS_EXTERNAL(I) = .FALSE. - IS_EXTERNAL(J) = .FALSE. - ENDIF - ENDIF - ENDDO - ENDDO - ELSEIF(SORT_FACES==3 ) THEN - DO I = 0,N_FACES-1 - ! Check that no verts are at the spheres center: - DO II=1,3 - II1=FACES(3*I+II) - IF ( SQRT((VERTS(3*II1-2)-SPHERE_ORIGIN(IAXIS))**2 + & - (VERTS(3*II1-1)-SPHERE_ORIGIN(JAXIS))**2 + & - (VERTS(3*II1 )-SPHERE_ORIGIN(KAXIS))**2) < GEOMEPS) & - IS_EXTERNAL(I) = .FALSE. - ENDDO - ENDDO - ENDIF SORT_FACES_IF +INTEGER, INTENT(IN) :: NM - ! create new FACES index array keeping only external faces +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 - N_FACES_TEMP = N_FACES - N_FACES=0 - DO I = 0, N_FACES_TEMP-1 - FACE_FROM=>FACES(3*I+1:3*I+3) - ! Drop triangles with zero area: - IF ( (FACE_FROM(1)==FACE_FROM(2)).OR.(FACE_FROM(1)==FACE_FROM(3)).OR.(FACE_FROM(2)==FACE_FROM(3)) ) CYCLE - IF (IS_EXTERNAL(I)) THEN - FACE_TO=>FACES(3*N_FACES+1:3*N_FACES+3) - FACE_TO(1:3) = FACE_FROM(1:3) - N_FACES=N_FACES+1 - ENDIF - ENDDO - G%N_FACES_BASE = N_FACES +CALL POINT_TO_MESH(NM) +M => MESHES(NM) +! Mesh sizes: +NXB=IBAR +NYB=JBAR +NZB=KBAR - IF (GEOM_TYPE == SPHERE_GEOM_TYPE) THEN - DO I = 0,N_FACES-1 - ! Check that no verts are at the spheres center: - DO II=1,3 - II1=FACES(3*I+II) - IF ( SQRT((VERTS(3*II1-2)-SPHERE_ORIGIN(IAXIS))**2 + & - (VERTS(3*II1-1)-SPHERE_ORIGIN(JAXIS))**2 + & - (VERTS(3*II1 )-SPHERE_ORIGIN(KAXIS))**2) < GEOMEPS) & - WRITE(LU_ERR,*) 'On External Faces, face/vertex ',I,II,II1,' located at center.' - ENDDO - II1=FACES(3*I+1) - II2=FACES(3*I+2) - II3=FACES(3*I+3) - DV1(IAXIS:KAXIS)= VERTS(3*II2-2:3*II2) - VERTS(3*II1-2:3*II1) - DV2(IAXIS:KAXIS)= VERTS(3*II3-2:3*II3) - VERTS(3*II1-2:3*II1) - CALL CROSS_PRODUCT(NVECI,DV1,DV2) - DXCEN= 1._EB/3._EB*(VERTS(3*II1-2:3*II1)+VERTS(3*II2-2:3*II2)+VERTS(3*II3-2:3*II3)) - & - SPHERE_ORIGIN(IAXIS:KAXIS) - DOTI = NVECI(IAXIS)*DXCEN(IAXIS) + NVECI(JAXIS)*DXCEN(JAXIS) + NVECI(KAXIS)*DXCEN(KAXIS) +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) +CALL CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) - IF (SIGN(1._EB,DOTI) < 0._EB) THEN - WRITE(LU_ERR,*) I,' has (-) sign normal.' - FACES(3*I+2) = II3 - FACES(3*I+3) = II2 - ENDIF - ENDDO - ENDIF - CALL COMPUTE_TEXTURES(VERTS,FACES,TFACES,MAX_VERTS,MAX_FACES,N_FACES) +REGCC_REGION_IF : IF(PERIODIC_TEST==7 .OR. PERIODIC_TEST==11) THEN - ! Surf IDs for generated GEOM: - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) - ALLOCATE(SURFS(N_FACES)) - IF(SURF_INDEX_PER_FACE) THEN - SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). - ELSE - SURFS(:) = 0 ! All external faces point to default surf ID. - ENDIF - ENDIF - ENDIF N_VOLUS_IF + CALL GET_REGULAR_CUTCELLS_BOX - ! Terrain case built with ZVALS, optimized way, define SURFS(:): - IF (N_ZVALS > 0) THEN - ! Surf IDs for generated GEOM: - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) - ALLOCATE(SURFS(N_FACES)) - IF(SURF_INDEX_PER_FACE) THEN - SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). - ELSE - SURFS(:) = 0 ! All external faces point to default surf ID. - ENDIF - ELSEIF(IS_TERRAIN) THEN - ! Finally Enhance SURFS to accomodate new faces. - ALLOCATE(SURFS2(N_FACES)); - ! Here define what SURF to assign to added faces. - IF(SURF_INDEX_PER_FACE) THEN - SURFS2(:) = 1 ! All external faces point to only entry SURF_ID(1). - ELSE - SURFS2(:) = 0 ! All external faces point to default surf ID. - ENDIF - SURFS2(1:N_FACES_ORIG) = SURFS(1:N_FACES_ORIG) - CALL MOVE_ALLOC(FROM=SURFS2,TO=SURFS) - ENDIF +ELSE - N_FACES_IF: IF (N_FACES>0) THEN - ALLOCATE(G%FACES(3*N_FACES),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%FACES',IZERO) - G%FACES(1:3*N_FACES) = FACES(1:3*N_FACES) + ! Do Loop for different x1 planes: + X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS - ! Check FACES for out of bounds indexes: - I = MINVAL(FACES(1:3*N_FACES)); II= MINLOC(FACES(1:3*N_FACES),DIM=1) - IF (I < 1) THEN - WRITE(MESSAGE,'(3A,I8,A,I8,A)') 'ERROR(718): Out of Bounds. GEOM: ',TRIM(ID), ', FACE=',& - II/3+1,', has vertex index ',I,' less than 1.' - CALL SHUTDOWN(MESSAGE) - RETURN - ENDIF - I = MAXVAL(FACES(1:3*N_FACES)); II= MAXLOC(FACES(1:3*N_FACES),DIM=1) - IF (I > N_VERTS) THEN - WRITE(MESSAGE,'(3A,I8,A,I8,A,I8,A)') 'ERROR(719): Out of Bounds. GEOM: ',TRIM(ID), ', FACE=',& - II/3+1,', has vertex index ',I,', higher than number of vertices defined ',N_VERTS,'.' - CALL SHUTDOWN(MESSAGE) - RETURN - ENDIF + SELECT CASE(X1AXIS) + CASE(IAXIS) - ALLOCATE(G%TFACES(6*N_FACES),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%TFACES',IZERO) - G%TFACES(1:6*N_FACES) = TFACES(1:6*N_FACES) + PLNORMAL = (/ 1._EB, 0._EB, 0._EB/) + ILO = ILO_FACE-CCGUARD; IHI = IHI_FACE+CCGUARD + JLO = JLO_FACE; JHI = JLO_FACE + KLO = KLO_FACE; KHI = KLO_FACE - ALLOCATE(G%SURFS(N_FACES),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%SURFS',IZERO) + ! x2, x3 axes parameters: + X2AXIS = JAXIS; X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD + X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD - PER_FACE_IF: IF (SURF_INDEX_PER_FACE) THEN - DO I=1,N_FACES - IF ( SURFS(I) <= 0 ) THEN - G%SURFS(I) = DEFAULT_SURF_INDEX ! If local SURF ID index <= 0, use default surf ID. - ELSE - G%SURFS(I) = SURF_ID_IND(SURFS(I)) - ENDIF - ENDDO - DEALLOCATE(SURF_ID_IND) - ELSE - G%SURFS(1:N_FACES) = DEFAULT_SURF_INDEX - BOX_TYPE_IF: IF ( GEOM_TYPE==BOX_GEOM_TYPE .AND. & - (SURF_ID(1)/='null' .OR. ALL(SURF_IDS/='null') .OR. ALL(SURF_ID6/='null')) )THEN - ! This loop allows GEOM to behave similarly to OBST - FACE_LOOP: DO I=1,N_FACES - II1=G%FACES(3*(I-1)+1) - II2=G%FACES(3*(I-1)+2) - II3=G%FACES(3*(I-1)+3) - DV1(IAXIS:KAXIS)= VERTS(3*II2-2:3*II2) - VERTS(3*II1-2:3*II1) - DV2(IAXIS:KAXIS)= VERTS(3*II3-2:3*II3) - VERTS(3*II1-2:3*II1) - CALL CROSS_PRODUCT(NVECI,DV1,DV2) - SURF_LOOP: DO NNN=0,N_SURF - IF (SURF_ID(1)==SURFACE(NNN)%ID .AND. ANY(ABS(NVECI(:))>TWENTY_EPSILON_EB)) G%SURFS(I) = NNN ! all sides - IF (SURF_IDS(2)==SURFACE(NNN)%ID .AND. (ABS(NVECI(1))>TWENTY_EPSILON_EB .OR. ABS(NVECI(2))>TWENTY_EPSILON_EB) ) & - G%SURFS(I) = NNN ! sides - IF (SURF_IDS(1)==SURFACE(NNN)%ID .AND. NVECI(3)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! top - IF (SURF_IDS(3)==SURFACE(NNN)%ID .AND. NVECI(3)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! bottom - IF (SURF_ID6(1)==SURFACE(NNN)%ID .AND. NVECI(1)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! X1 - IF (SURF_ID6(2)==SURFACE(NNN)%ID .AND. NVECI(1)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! X2 - IF (SURF_ID6(3)==SURFACE(NNN)%ID .AND. NVECI(2)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Y1 - IF (SURF_ID6(4)==SURFACE(NNN)%ID .AND. NVECI(2)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Y2 - IF (SURF_ID6(5)==SURFACE(NNN)%ID .AND. NVECI(3)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Z1 - IF (SURF_ID6(6)==SURFACE(NNN)%ID .AND. NVECI(3)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Z2 - ENDDO SURF_LOOP - ENDDO FACE_LOOP - ENDIF BOX_TYPE_IF - ENDIF PER_FACE_IF + ! location in I,J,K of x2,x2,x3 axes: + XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS - ! Test for Unsupported surfaces: - DO I=1,N_FACES - ! HERE do tests on surfaces, is not supported by GEOMs throw error: - UNSUPPORTED_SURF_FIELD : IF(SURFACE(G%SURFS(I))%BURN_AWAY) THEN - WRITE(MESSAGE,'(5A)') 'ERROR(720): GEOM: ',TRIM(ID),& - ', has currently unsupported BURN_AWAY feature in surface : ',TRIM(SURFACE(G%SURFS(I))%ID),'.' - CALL SHUTDOWN(MESSAGE) - RETURN - ENDIF UNSUPPORTED_SURF_FIELD - ! Others.. - ENDDO + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(ISTR:IEND),DX1FACE(ISTR:IEND)) + X1FACE = XFACE; DX1FACE = DXFACE + ALLOCATE(X2FACE(JSTR:JEND),DX2FACE(JSTR:JEND)) + X2FACE = YFACE; DX2FACE = DYFACE + ALLOCATE(X3FACE(KSTR:KEND),DX3FACE(KSTR:KEND)) + X3FACE = ZFACE; DX3FACE = DZFACE - ENDIF N_FACES_IF + ! x2 cell center parameters: + X2LO_CELL = JLO_CELL-CCGUARD; X2HI_CELL = JHI_CELL+CCGUARD + ALLOCATE(X2CELL(JSTR:JEND),DX2CELL(JSTR:JEND)) + X2CELL = YCELL; DX2CELL = DYCELL - IF (N_VERTS>0) THEN - ALLOCATE(G%VERTS_BASE(3*N_VERTS),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%VERTS_BASE',IZERO) - G%VERTS_BASE(1:3*N_VERTS) = VERTS(1:3*N_VERTS) + ! x3 cell center parameters: + X3LO_CELL = KLO_CELL-CCGUARD; X3HI_CELL = KHI_CELL+CCGUARD + ALLOCATE(X3CELL(KSTR:KEND),DX3CELL(KSTR:KEND)) + X3CELL = ZCELL; DX3CELL = DZCELL - ALLOCATE(G%VERTS(3*N_VERTS),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%VERTS',IZERO) - ENDIF + CASE(JAXIS) - G%MOVE_ID = MOVE_ID - G%IS_DYNAMIC = .FALSE. + PLNORMAL = (/ 0._EB, 1._EB, 0._EB/) + ILO = ILO_FACE; IHI = ILO_FACE + JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD + KLO = KLO_FACE; KHI = KLO_FACE - ! Prevent drawing of boundary info if desired + ! x2, x3 axes parameters: + X2AXIS = KAXIS; X2LO = KLO_FACE-CCGUARD; X2HI = KHI_FACE+CCGUARD + X3AXIS = IAXIS; X3LO = ILO_FACE-CCGUARD; X3HI = IHI_FACE+CCGUARD - G%SHOW_BNDF = BNDF_GEOM + ! location in I,J,K of x2,x2,x3 axes: + XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS - ! Case of false READ_BINARY, Process 0 writes a binary file with the geom: - IF(MY_RANK == 0 .AND. .NOT.READ_BINARY) THEN - WRITE(FN_BINGEOM,'(A,A,A,A,A)') './',TRIM(BINGEOM_DIR)//TRIM(CHID),'_',TRIM(ID),'.bingeom' - OPEN(UNIT=LU_BINGEOM,FILE=TRIM(FN_BINGEOM),STATUS='UNKNOWN',ACTION='WRITE',FORM='UNFORMATTED') - WRITE(LU_BINGEOM) GEOM_TYPE - IF (GEOM_TYPE==TERRAIN_GEOM_TYPE) THEN - WRITE(LU_BINGEOM) N_VERTS_ORIG,N_FACES_ORIG,N_SURF_ID,N_VOLUS_ORIG - WRITE(LU_BINGEOM) VERTS(1:3*N_VERTS_ORIG) - WRITE(LU_BINGEOM) FACES(1:3*N_FACES_ORIG) - WRITE(LU_BINGEOM) SURFS(1:N_FACES_ORIG) - WRITE(LU_BINGEOM) VOLUS(1:4*N_VOLUS_ORIG) - ELSE - WRITE(LU_BINGEOM) N_VERTS,N_FACES,N_SURF_ID,N_VOLUS - WRITE(LU_BINGEOM) VERTS(1:3*N_VERTS) - WRITE(LU_BINGEOM) FACES(1:3*N_FACES) - WRITE(LU_BINGEOM) SURFS(1:N_FACES) - WRITE(LU_BINGEOM) VOLUS(1:4*N_VOLUS) - ENDIF - CLOSE(LU_BINGEOM) - ENDIF + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(JSTR:JEND),DX1FACE(JSTR:JEND)) + X1FACE = YFACE; DX1FACE = DYFACE + ALLOCATE(X2FACE(KSTR:KEND),DX2FACE(KSTR:KEND)) + X2FACE = ZFACE; DX2FACE = DZFACE + ALLOCATE(X3FACE(ISTR:IEND),DX3FACE(ISTR:IEND)) + X3FACE = XFACE; DX3FACE = DXFACE + + ! x2 cell center parameters: + X2LO_CELL = KLO_CELL-CCGUARD; X2HI_CELL = KHI_CELL+CCGUARD + ALLOCATE(X2CELL(KSTR:KEND),DX2CELL(KSTR:KEND)) + X2CELL = ZCELL; DX2CELL = DZCELL + + ! x3 cell center parameters: + X3LO_CELL = ILO_CELL-CCGUARD; X3HI_CELL = IHI_CELL+CCGUARD + ALLOCATE(X3CELL(ISTR:IEND),DX3CELL(ISTR:IEND)) + X3CELL = XCELL; DX3CELL = DXCELL + + CASE(KAXIS) + + PLNORMAL = (/ 0._EB, 0._EB, 1._EB/) + ILO = ILO_FACE; IHI = ILO_FACE + JLO = JLO_FACE; JHI = JLO_FACE + KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD + + ! x2, x3 axes parameters: + X2AXIS = IAXIS; X2LO = ILO_FACE-CCGUARD; X2HI = IHI_FACE+CCGUARD + X3AXIS = JAXIS; X3LO = JLO_FACE-CCGUARD; X3HI = JHI_FACE+CCGUARD -ENDDO READ_GEOM_LOOP -35 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 + ! location in I,J,K of x2,x2,x3 axes: + XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS -CALL CONVERTGEOM(T_BEGIN) + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)) + X1FACE = ZFACE; DX1FACE = DZFACE + ALLOCATE(X2FACE(ISTR:IEND),DX2FACE(ISTR:IEND)) + X2FACE = XFACE; DX2FACE = DXFACE + ALLOCATE(X3FACE(JSTR:JEND),DX3FACE(JSTR:JEND)) + X3FACE = YFACE; DX3FACE = DYFACE -DO IG = 1, N_GEOMETRY + ! x2 cell center parameters: + X2LO_CELL = ILO_CELL-CCGUARD; X2HI_CELL = IHI_CELL+CCGUARD + ALLOCATE(X2CELL(ISTR:IEND),DX2CELL(ISTR:IEND)) + X2CELL = XCELL; DX2CELL = DXCELL - G=>GEOMETRY(IG) + ! x3 cell center parameters: + X3LO_CELL = JLO_CELL-CCGUARD; X3HI_CELL = JHI_CELL+CCGUARD + ALLOCATE(X3CELL(JSTR:JEND),DX3CELL(JSTR:JEND)) + X3CELL = YCELL; DX3CELL = DYCELL - ! Define box containing Geometry: - DO X1AXIS=IAXIS,KAXIS - G%GEOM_BOX( LOW_IND,X1AXIS) = 1._EB/GEOMEPS ! Initialize min location in X1AXIS dir to large (+) number. - G%GEOM_BOX(HIGH_IND,X1AXIS) =-1._EB/GEOMEPS ! Initialize max location in X1AXIS dir to large (-) number. - DO IVERT=1,G%N_VERTS - G%GEOM_BOX( LOW_IND,X1AXIS) = MIN(G%GEOM_BOX( LOW_IND,X1AXIS),G%VERTS(MAX_DIM*(IVERT-1)+X1AXIS)) - G%GEOM_BOX(HIGH_IND,X1AXIS) = MAX(G%GEOM_BOX(HIGH_IND,X1AXIS),G%VERTS(MAX_DIM*(IVERT-1)+X1AXIS)) - ENDDO - ENDDO + END SELECT - ! Check for duct nodes + ! Variable that states if raytracing is necessary to define segments + ! status in a cartesian face. + ALLOCATE(FACERT(X2LO_CELL:X2HI_CELL,X3LO_CELL:X3HI_CELL)); - DO J = 1,G%N_FACES - IF (SURFACE(G%SURFS(J))%NODE_ID/='null') THEN - G%HAVE_NODE = .TRUE. - EXIT - ENDIF - ENDDO + ! Stretched grid vars: + X1NOC=TRANS(NM)%NOC(X1AXIS) + X2NOC=TRANS(NM)%NOC(X2AXIS) + X3NOC=TRANS(NM)%NOC(X3AXIS) -ENDDO + IF(GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + IF(X1AXIS < KAXIS) THEN + WRITE(LU_SETCC,'(A,A,A,3I2,A)') ' Computing GEOMs-grid planes intersections for planes in ', & + AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A,A,A,3I2,A)') ' Computing GEOMs-grid planes intersections for planes in ', & + AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' + ENDIF + ELSE + WRITE(LU_SETCC,'(A,A,A,3I2,A)',advance="no") ' Computing GEOMs-grid planes intersections for planes in ', & + AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A,A,A,3I2,A)',advance="no") ' Computing GEOMs-grid planes intersections for planes in ', & + AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' + ENDIF + ENDIF + ENDIF -IF(ALLOCATED(VOLUS)) DEALLOCATE(VOLUS) -IF(ALLOCATED(FACES)) DEALLOCATE(FACES) -IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) -IF(ALLOCATED(VERTS)) DEALLOCATE(VERTS) -IF(ALLOCATED(ZVALS)) DEALLOCATE(ZVALS) -IF(ALLOCATED(TFACES))DEALLOCATE(TFACES) + ! Loop Coordinate Planes: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -DEALLOCATE(GEOM_LINE) + ! Which Plane? + INDX1(IAXIS:KAXIS) = (/ I, J, K /) + X1PLN = X1FACE(INDX1(X1AXIS)) -IF( (T_END-T_BEGIN) < TWENTY_EPSILON_EB) RETURN + ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: + TRI_ONPLANE_ONLY =.FALSE. + RAYTRACE_X2_ONLY =.FALSE. + FACERT(:,:) =.FALSE. + CALL GET_BODINT_PLANE(X1AXIS,X1PLN,INDX1(X1AXIS),PLNORMAL,X2AXIS,X3AXIS,& + X2LO,X2HI,X3LO,X3HI,X2FACE,X3FACE,X2LO_CELL,& + X2HI_CELL,X3LO_CELL,X3HI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE) -CC_IBM = .TRUE. + ! Test that there is an intersection: + IF ((BODINT_PLANE%NSGLS+BODINT_PLANE%NSEGS+BODINT_PLANE%NTRIS) == 0) CYCLE -! If unstructured projection defined set Pressure solver on unstructured grid. -IF (PRES_FLAG/=UGLMAT_FLAG) THEN - PRES_METHOD = 'ULMAT' - PRES_FLAG = ULMAT_FLAG -ENDIF -PRES_ON_WHOLE_DOMAIN = .FALSE. -IF (ABS(CCVOL_LINK-0.95_EB) GEOMEPS) CYCLE + IF ((MINVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))-X2FACE(X2HI)) > GEOMEPS) CYCLE + IF ((X3FACE(X3LO)-MAXVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE + IF ((MINVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))-X3FACE(X3HI)) > GEOMEPS) CYCLE -CONTAINS + ! IF (GET_CUTCELLS_VERBOSE) THEN + ! WRITE(LU_SETCC,'(I2,A,F14.8,A,3I8)') X1AXIS,', position :',X1PLN, & + ! '; Single Points, Segments, Triangles :', BODINT_PLANE%NSGLS,BODINT_PLANE%NSEGS,BODINT_PLANE%NTRIS + ! IF (MY_RANK==0) & + ! WRITE(LU_ERR ,'(I2,A,F14.8,A,3I8)') X1AXIS,', position :',X1PLN, & + ! '; Single Points, Segments, Triangles :', BODINT_PLANE%NSGLS,BODINT_PLANE%NSEGS,BODINT_PLANE%NTRIS + ! ENDIF + ! For plane normal to X1AXIS, shoot rays along X2AXIS on all X3AXIS gridline + ! locations, get intersection data: Loop x3 axis locations + DO KK=X3LO,X3HI -SUBROUTINE DEFINE_EXTRUDED_POLY(MAX_VERTS,N_VERTS,VERTS,MAX_POLY_VERTS,N_POLY_VERTS,POLY,& - EXTRUDE,MAX_FACES,N_FACES,START_FACE_LO,START_FACE_HI,START_FACE_MID,FACES,IERR) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -INTEGER, INTENT(IN) :: MAX_VERTS, MAX_POLY_VERTS, N_POLY_VERTS, POLY(MAX_POLY_VERTS), MAX_FACES -REAL(EB),INTENT(IN) :: EXTRUDE -INTEGER, INTENT(INOUT) :: N_VERTS -REAL(EB),INTENT(INOUT) :: VERTS(3*MAX_VERTS) -INTEGER, INTENT(OUT) :: N_FACES,START_FACE_LO,START_FACE_HI,START_FACE_MID,FACES(4*MAX_FACES),IERR + ! x3 location of ray along x2, on the x2-x3 plane: + X3RAY = X3FACE(KK) -! Local Variables: -REAL(EB), ALLOCATABLE, DIMENSION(:) :: PVERTS,PVERTS2 -REAL(EB):: XYZCEN(IAXIS:KAXIS), NVEC(IAXIS:KAXIS), DV1(IAXIS:KAXIS), DV2(IAXIS:KAXIS), N(IAXIS:KAXIS), SINANG -LOGICAL :: IS_CONVEX, VERT_DROPPED, NOPT_INTRI -INTEGER :: IM1, IP1, NVERTS2, V0, V1, V2, COUNT, COUNT_OUT, NLIST, NLIST_OLD, VERT_START, IVERT, IVM1, IV, IVP1, & - I1, I2, I3, I4, IDUM, IFACE, JP1, JEND, INT_FLG -INTEGER, ALLOCATABLE, DIMENSION(:) :: NODE_FLG, VERT_LIST -LOGICAL, ALLOCATABLE, DIMENSION(:) :: NODE_EXISTS -REAL(EB):: BBLEN, THLEN, MINMAX_POS(LOW_IND:HIGH_IND,IAXIS:KAXIS), P1(IAXIS:JAXIS), D1(IAXIS:JAXIS), & - P2(IAXIS:JAXIS), D2(IAXIS:JAXIS), SVEC(IAXIS:KAXIS), PVEC(IAXIS:KAXIS), SVARV(NOD1:NOD2,EDG1:EDG2), SLENV(EDG1:EDG2) + ! Intersections along x2 for X3RAY x3 location: + CALL GET_X2_INTERSECTIONS(X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN) + IF (STOP_STATUS==SETUP_STOP) RETURN -IERR = 1 + ! Drop x2 ray if all intersections are outside of the MESH block domain: + IF (CC_N_CRS > 0) THEN + IF ((X2FACE(X2LO)-CC_SVAR_CRS(CC_N_CRS)) > GEOMEPS) THEN + CYCLE + ELSEIF (CC_SVAR_CRS(1)-X2FACE(X2HI) > GEOMEPS) THEN + CYCLE + ENDIF + ENDIF -! Define PVERTS: -ALLOCATE(PVERTS(1:2*MAX_DIM*N_POLY_VERTS)); PVERTS=0._EB -MINMAX_POS( LOW_IND,IAXIS:KAXIS) = 1._EB/GEOMEPS -MINMAX_POS(HIGH_IND,IAXIS:KAXIS) =-1._EB/GEOMEPS -DO I=1,N_POLY_VERTS - PVERTS(3*I-2:3*I) = VERTS(3*POLY(I)-2:3*POLY(I)) - MINMAX_POS( LOW_IND,IAXIS) = MIN(MINMAX_POS( LOW_IND,IAXIS),PVERTS(3*I-2)) - MINMAX_POS( LOW_IND,JAXIS) = MIN(MINMAX_POS( LOW_IND,JAXIS),PVERTS(3*I-1)) - MINMAX_POS( LOW_IND,KAXIS) = MIN(MINMAX_POS( LOW_IND,KAXIS),PVERTS(3*I )) - MINMAX_POS(HIGH_IND,IAXIS) = MAX(MINMAX_POS(HIGH_IND,IAXIS),PVERTS(3*I-2)) - MINMAX_POS(HIGH_IND,JAXIS) = MAX(MINMAX_POS(HIGH_IND,JAXIS),PVERTS(3*I-1)) - MINMAX_POS(HIGH_IND,KAXIS) = MAX(MINMAX_POS(HIGH_IND,KAXIS),PVERTS(3*I )) -ENDDO -PVERTS(3*(N_POLY_VERTS+1)-2:3*(N_POLY_VERTS+1)) = PVERTS(1:3) -! Define average normal: -XYZCEN(IAXIS:KAXIS)=0._EB -DO I=1,N_POLY_VERTS - XYZCEN(IAXIS:KAXIS) = XYZCEN(IAXIS:KAXIS) + PVERTS(3*I-2:3*I) -ENDDO -XYZCEN = XYZCEN / REAL(N_POLY_VERTS,EB) -! Define an area averaged normal vector (note: this might need to change to average normal to the set of points in a -! least squares sense, i.e. eigenvector associated with smallest eigenvalue of the covariance matrix of vertices positions -! respect to XYZCEN): -NVEC(IAXIS:KAXIS)=0._EB -DO I=1,N_POLY_VERTS - DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - XYZCEN(IAXIS:KAXIS) - DV2(IAXIS:KAXIS) = PVERTS(3*I+1:3*(I+1)) - XYZCEN(IAXIS:KAXIS) - CALL CROSS_PRODUCT(N,DV1,DV2) - NVEC(IAXIS:KAXIS) = NVEC(IAXIS:KAXIS) + N(IAXIS:KAXIS) -ENDDO -IF(NORM2(NVEC) > TWENTY_EPSILON_EB) NVEC=NVEC/NORM2(NVEC) + ! Highest Z crossing for I,J=KK,INDX1(X1AXIS) location, clip at ZF+DZ(KBAR): + IF(TERRAIN_CASE .AND. X2AXIS==KAXIS .AND. CC_N_CRS>0) & + GEOM_ZMAX_AUX(KK,INDX1(X1AXIS)) = MIN(X2FACE(KBP1),CC_SVAR_CRS(CC_N_CRS)) -! Test all segments are in plane normal to NVEC, tolerance for distance to plane given by XYZCEN, NVEC is -! 5% of the bounding box diagonal for the polygon: -BBLEN = SQRT( (MINMAX_POS(HIGH_IND,IAXIS)-MINMAX_POS( LOW_IND,IAXIS))**2._EB + & - (MINMAX_POS(HIGH_IND,JAXIS)-MINMAX_POS( LOW_IND,JAXIS))**2._EB + & - (MINMAX_POS(HIGH_IND,KAXIS)-MINMAX_POS( LOW_IND,KAXIS))**2._EB ) -THLEN = 0.05_EB * BBLEN ! Threshold distance to polygon average plane. -DO I=1,N_POLY_VERTS - DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - XYZCEN(IAXIS:KAXIS) - IF (ABS(DOT_PRODUCT(DV1,NVEC)) > THLEN) THEN - WRITE(MESSAGE,'(A,A,A,I3,A)') 'ERROR(721): For extruded Polygon GEOM ',TRIM(ID),& - ' : Node (',POLY(I),') not in the plane of the polygon. Check VERTS.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF -ENDDO + ! Now for this ray, set vertex types in MESHES(NM)%VERTVAR(:,:,:,CC_VGSC): + CALL GET_X2_VERTVAR(X1AXIS,X2LO,X2HI,NM,I,KK) -! Here project all points to average plane. Do seg-seg intersection tests: -DO I=1,N_POLY_VERTS - DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I)-XYZCEN(IAXIS:KAXIS) - DV2(IAXIS:KAXIS) = DV1(IAXIS:KAXIS) - DOT_PRODUCT(DV1,NVEC) * NVEC(IAXIS:KAXIS) - PVERTS(3*(I+N_POLY_VERTS)-2:3*(I+N_POLY_VERTS)) = XYZCEN(IAXIS:KAXIS) + DV2(IAXIS:KAXIS) -ENDDO -! Define local coordinate system SVEC,PVEC,NVEC: -IF(ABS(NVEC(IAXIS))>TWENTY_EPSILON_EB .OR. ABS(NVEC(JAXIS))>TWENTY_EPSILON_EB) PVEC(IAXIS:KAXIS)=(/NVEC(JAXIS),-NVEC(IAXIS),0._EB/) -IF(ABS(NVEC(IAXIS))0) THEN - WRITE(MESSAGE,'(A,I3,A,I3,A,I3,A,I3,A)') 'ERROR(722): Segments (',POLY(I-N_POLY_VERTS),'-',POLY(IP1-N_POLY_VERTS),& - ') and (',POLY(J-N_POLY_VERTS),'-',POLY(JP1-N_POLY_VERTS),') intersect in average POLY plane.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO -ENDDO + ! Now define Crossings on Cartesian Edges and Body segments: + ! Cartesian cut-edges: + CALL GET_CARTEDGE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & + NM,X2LO_CELL,X2HI_CELL,INDX1,KK) + ! Set segment crossings: + ! This data is defined by plane, add to current: + ! - BODINT_PLANE : Data structure with information for crossings on + ! body segments. + ! % NBCROSS(1:NSEGS) = Number of crossings + ! on the segment. + ! % SVAR(1:NBCROSS,1:NSEGS) = distance from node 1 + ! along the segment. + CALL GET_BODX2_INTERSECTIONS(X2AXIS,X3AXIS,X3RAY) -IS_CONVEX=.TRUE. -ALLOCATE(NODE_FLG(1:N_POLY_VERTS+1)); NODE_FLG=1 -DO I=1,N_POLY_VERTS - IM1 = I - 1 - IF (I==1) IM1=N_POLY_VERTS - IP1 = I + 1 - IF (I==N_POLY_VERTS) IP1=1 - DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - PVERTS(3*IM1-2:3*IM1 ); DV1=DV1/NORM2(DV1) - DV2(IAXIS:KAXIS) = PVERTS(3*IP1-2:3*IP1) - PVERTS(3*I-2:3*I ); DV2=DV2/NORM2(DV2) - CALL CROSS_PRODUCT(N,DV1,DV2) - SINANG = NORM2(N) - IF ( DOT_PRODUCT(NVEC,N) < -GEOMEPS ) IS_CONVEX=.FALSE. - IF ( SINANG < GEOMEPS ) NODE_FLG(I)= 0 ! Vertex located in line joining neighbors. -ENDDO + ENDDO ! KK - x3 gridlines. -NVERTS2 = SUM(NODE_FLG(1:N_POLY_VERTS)); -IF (NVERTS2 < 3) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR(723): For extruded Polygon GEOM ',TRIM(ID),' : Not enough valid vertices on the polygon.' - CALL SHUTDOWN(MESSAGE); RETURN -ENDIF -ALLOCATE(PVERTS2(1:2*MAX_DIM*N_POLY_VERTS)); PVERTS2=0._EB -ALLOCATE(VERT_LIST(NVERTS2+1)); VERT_LIST=0 -ALLOCATE(NODE_EXISTS(NVERTS2+1)); NODE_EXISTS=.TRUE. -COUNT = 0 -DO I=1,N_POLY_VERTS - IF (NODE_FLG(I)==0) CYCLE - COUNT= COUNT + 1 - PVERTS2(3*COUNT-2:3*COUNT) = PVERTS(3*I-2:3*I) - VERT_LIST(COUNT) = COUNT -ENDDO -PVERTS(1:3*NVERTS2) = PVERTS2(1:3*NVERTS2) -VERT_LIST(NVERTS2+1) = VERT_LIST(1) -DEALLOCATE(PVERTS2) + ! Now for segments not aligned with x3, define + ! intersections with grid line vertices: + CALL GET_BODX3_INTERSECTIONS(X2AXIS,X3AXIS,X2LO,X2HI) + ! After these loops all segments should contain points from Node1, + ! cross 1, cross 2, ..., Node2, in ascending sbod order. + ! Time to generate the body CC_INBOUNDARY edges on faces and add + ! to MESHES(NM)%CUT_EDGE: + CALL GET_CARTFACE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS, & + XIAXIS,XJAXIS,XKAXIS,NM, & + X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL,& + X3LO_CELL,X3HI_CELL,INDX1,X1PLN) -! Now do the Ear clip: -N_FACES = 0 -START_FACE_LO = N_FACES -IS_CONVEX_IF : IF (IS_CONVEX) THEN ! Convex POLY. - VERT_START = VERT_LIST(1) - DO I = 1,NVERTS2 - IP1 = I+1; IF (I==NVERTS2) IP1=1 - IF (I==VERT_START .OR. IP1==VERT_START) CYCLE - N_FACES = N_FACES + 1 - FACES(3*N_FACES-2) = VERT_LIST(VERT_START) - FACES(3*N_FACES-1) = VERT_LIST(I) - FACES(3*N_FACES ) = VERT_LIST(IP1) - ENDDO -ELSE IS_CONVEX_IF ! Simple polygon, ear clipping. - NLIST = NVERTS2 - COUNT_OUT = 0 - OUTER_LOOP : DO WHILE(NLIST>=3) ! OUTER LOOP - COUNT_OUT = COUNT_OUT + 1 - IF (COUNT_OUT > NVERTS2**4) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR(724): For extruded Polygon GEOM ',TRIM(ID),' : Could not triangulate polygon.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - IVERT = 1 - INNER_LOOP : DO WHILE(IVERT<=NLIST) ! INNER LOOP - IVM1 = IVERT-1; IV=IVERT; IVP1=IVERT+1 - IF (IVERT==1) IVM1=NLIST - V0 = VERT_LIST(IVM1); V1 = VERT_LIST(IV ); V2 = VERT_LIST(IVP1); - IF (.NOT.NODE_EXISTS(IVP1)) EXIT INNER_LOOP - DV1(IAXIS:KAXIS) = PVERTS(3*V1-2:3*V1)-PVERTS(3*V0-2:3*V0) - IF (NORM2(DV1)GEOMEPS - IF (NOPT_INTRI) THEN - DO I=1,NVERTS2 - IF(ANY( (/V0,V1,V2/) == I)) CYCLE - IF (POINT_IN_TRIANGLE(PVERTS(3*I-2:3*I), PVERTS(3*V0-2:3*V0), PVERTS(3*V1-2:3*V1), PVERTS(3*V2-2:3*V2))) THEN - NOPT_INTRI=.FALSE. - EXIT - ENDIF - ENDDO - ENDIF - IF ( NLIST==3 .OR. NOPT_INTRI ) THEN - N_FACES = N_FACES + 1 - FACES(3*N_FACES-2) = V0 - FACES(3*N_FACES-1) = V1 - FACES(3*N_FACES ) = V2 - IF (NLIST == 3) EXIT OUTER_LOOP - NODE_EXISTS(IVERT) =.FALSE. - IF (IVERT==1) NODE_EXISTS(NLIST+1)=.FALSE. - IVERT = IVERT + 2 - ELSE - IVERT = IVERT + 1 - ENDIF - ENDDO INNER_LOOP - NLIST_OLD = NLIST - NLIST = 0 - DO I = 1,NLIST_OLD - IF (NODE_EXISTS(I)) THEN - NLIST = NLIST + 1 - VERT_LIST(NLIST) = VERT_LIST(I) - ENDIF - ENDDO - VERT_LIST(NLIST+1) = VERT_LIST(1) - NODE_EXISTS(1:NLIST+1) =.TRUE. + ENDDO ! I index + ENDDO ! J index + ENDDO ! K index - ! Test for nodes connecting parallel edges, if found drop them: - VERT_DROPPED=.FALSE. - DO I=1,NLIST - IVM1 = I-1; IV=I; IVP1=I+1; IF (I==1) IVM1=NLIST - V0 = VERT_LIST(IVM1); V1 = VERT_LIST(IV ); V2 = VERT_LIST(IVP1) - DV1(IAXIS:KAXIS) = PVERTS(3*V1-2:3*V1)-PVERTS(3*V0-2:3*V0) - IF (NORM2(DV1) FCVAR(i,j,k,IDCF,axis). + CALL GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.TRUE.) -DEALLOCATE(PVERTS,NODE_FLG,VERT_LIST,NODE_EXISTS) + ! 2. INBOUNDARY cut-faces: + CALL GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.TRUE.) -IERR = 0 + ! Guard-cell Cartesian GASPHASE and INBOUNDARY cut-faces: + CALL GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.FALSE.) + CALL GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.FALSE.) -RETURN + ! Finally: Definition of cut-cells: + CELLRT = .FALSE. + MESHES(NM)%N_SPCELL_CF = MESHES(NM)%N_SPCELL + CALL GET_CARTCELL_CUTCELLS(NM) -END SUBROUTINE DEFINE_EXTRUDED_POLY +ENDIF REGCC_REGION_IF +CALL CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) +CALL CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +IF (ALLOCATED(CELLRT)) DEALLOCATE(CELLRT) +END SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH -SUBROUTINE DEFINE_CYLINDER(VERTS,MAXVERTS,NVERTS,FACES,MAXFACES,NFACES,VOLS,MAXVOLS,NVOLS,CYL_FIND) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) -INTEGER, INTENT(IN) :: MAXVERTS,MAXFACES,MAXVOLS -INTEGER, INTENT(OUT) :: NFACES, NVERTS -REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) -INTEGER, INTENT(OUT) :: FACES(4*MAXFACES) -INTEGER, INTENT(OUT) :: NVOLS -INTEGER, INTENT(OUT) :: VOLS(4*MAXVOLS) -INTEGER, INTENT(OUT) :: CYL_FIND(LOW_IND:HIGH_IND,1:3) +INTEGER, INTENT(IN) :: NM -! Local Variables: -REAL(EB), PARAMETER :: EX(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) -REAL(EB) :: E1(IAXIS:KAXIS), E2(IAXIS:KAXIS), E3(IAXIS:KAXIS), TGL(3,3), V(IAXIS:KAXIS,1), R(IAXIS:KAXIS,1) -INTEGER :: NP_L,NP_T,IVERT,IFACE,ILE,ITH,IFC -REAL(EB):: DELTA_L,DELTA_T,THETA,POS_1,POS_2,POS_3, LEN +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 + +CALL POINT_TO_MESH(NM) +M => MESHES(NM) +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) +CALL CC_GRID_BLOCK_SPECIAL_CELLS(NM) +CALL CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) +IF (ONE_CC_PER_CARTESIAN_CELL) THEN + ! Here Block all cells that have volume less (or equal) than the first largest cell found. + DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + CC=>MESHES(NM)%CUT_CELL(ICC1) + NCELL=0 + DO J=1,CC%NCELL + IF(CC%NOADVANCE(J)==NOT_BLOCKED) NCELL=NCELL+1 + ENDDO + IF(NCELL<2) CYCLE + ! Find if any GEOMETRY related to CC_INBOUNDARY faces has CELL_BLOCK_IOR>0: + CELL_BLOCK_IOR=0; CELL_BLOCK_ORIENTATION = 0._EB + NCELL_LOOP_1 : DO J=1,CC%NCELL + DO I=2,CC%CCELEM(1,J)+1 + IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN + ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) + IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) + IF(IG>0) THEN + IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN + CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION + ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN + CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR + EXIT NCELL_LOOP_1 + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO NCELL_LOOP_1 + ALLOCATE(VOLUME(1:CC%NCELL)); VOLUME(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN + ! Cell Block Orientation: + DO J=1,CC%NCELL; VOLUME(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)); ENDDO + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN + ! Make search for double precision min/max unambiguous. + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS,IAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) + CASE(-JAXIS,JAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) + CASE(-KAXIS,KAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) + END SELECT + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( IAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE(-JAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( JAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE(-KAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( KAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + END SELECT + ENDIF + DEALLOCATE(VOLUME) + NCELL_LOOP_2 : DO J=1,CC%NCELL + IF(J==I) CYCLE NCELL_LOOP_2 + IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL + ENDDO NCELL_LOOP_2 + ENDDO +ENDIF -! Check if CYLINDER axis is any of IAXIS, JAXIS, KAXIS: -IF (ABS(CYLINDER_AXIS(JAXIS))MESHES(NM)%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + IF(CC%NOADVANCE(JCC)<1) CYCLE + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE=CC%CCELEM(IFC,JCC) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO ENDIF +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -! Define transformation matrix from local to global axes: -TGL(IAXIS:KAXIS,IAXIS) = E1(IAXIS:KAXIS) -TGL(IAXIS:KAXIS,JAXIS) = E2(IAXIS:KAXIS) -TGL(IAXIS:KAXIS,KAXIS) = E3(IAXIS:KAXIS) +END SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH -! Now define cylinder in local axes E1,E2,E3, using CYLINDER_RADIUS and CYLINDER_LENGTH, centered at zero origin: -! Define vertices: -NP_L = CYLINDER_NSEG_AXIS + 1 -NP_T = CYLINDER_NSEG_THETA -DELTA_L = CYLINDER_LENGTH / REAL(CYLINDER_NSEG_AXIS,EB) -DELTA_T = 2._EB*PI / REAL(CYLINDER_NSEG_THETA,EB) -IVERT= 0 +SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK -! Low plane center vertex: -POS_1 = -CYLINDER_LENGTH/2._EB -POS_2 = 0._EB; POS_3 = 0._EB; -IVERT = IVERT + 1 -VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) +DO IDIM=1,MAX_DIM -VERTEX_LOOP : DO ILE=1,NP_L - POS_1 = -CYLINDER_LENGTH/2._EB + REAL(ILE-1,EB)*DELTA_L - DO ITH=1,NP_T +! Exchange CC%NOADVANCE(JCC)>0 information among NEIGHBOURING meshes: +CALL EXCHANGE_CC_NOADVANCE_INFO +! Add CC%NOADVANCE(JCC) where needed: +CALL ADD_NEIGHBOR_BLOCKED_CELLS - THETA = REAL(ITH-1,EB)*DELTA_T - POS_2 = CYLINDER_RADIUS*COS(THETA) - POS_3 = CYLINDER_RADIUS*SIN(THETA) +MAIN_MESH_LOOP_1 : DO NM=1,NMESHES - IVERT = IVERT + 1 - VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) + IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. + IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 - ENDDO -ENDDO VERTEX_LOOP + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) -! High plane center vertex: -POS_1 = CYLINDER_LENGTH/2._EB -POS_2 = 0._EB; POS_3 = 0._EB; -IVERT = IVERT + 1 -VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) + ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: + CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) -NVERTS = IVERT + IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + CALL GET_CELL_LINK_INFO(NM) + ENDIF -! Define faces: -! Low axis plane: -IFACE=0 -IVERT=1 -CYL_FIND(LOW_IND,3) = IFACE + 1 -DO IFC=1,NP_T - IF (IFC < NP_T) THEN - I1 = 1 + IFC + 1 - I2 = 1 + IFC - I3 = IVERT - ELSE - I1 = IVERT + 1 - I2 = IFC + 1 - I3 = IVERT + ! Block any cells that contain only one gas cut-face (cavity type cut-cells): + K = 0 + DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + CC=>MESHES(NM)%CUT_CELL(ICC1) + DO J=1,CC%NCELL + SUM_FACE=0; SUM_CCELL=0 + DO I=2,CC%CCELEM(1,J) + SELECT CASE(CC%FACE_LIST(1,CC%CCELEM(I,J))) + CASE(CC_FTYPE_CFGAS); SUM_FACE = SUM_FACE+1 + CASE(CC_FTYPE_RCGAS); SUM_CCELL=SUM_CCELL+1 + END SELECT + ENDDO + IF(SUM_FACE>1 .OR. SUM_CCELL>0) CYCLE + IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J)=BLOCKED_CAVITY_CELL + K=K+1 + ENDDO + ENDDO + IF (K>0) THEN + CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) + IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + CALL GET_CELL_LINK_INFO(NM) + ENDIF ENDIF - IFACE=IFACE+1 - FACES(3*IFACE-2:3*IFACE) = (/I1, I2, I3 /) -ENDDO -CYL_FIND(HIGH_IND,3) = IFACE + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +ENDDO MAIN_MESH_LOOP_1 -! Cylinder side faces: -CYL_FIND(LOW_IND,2) = IFACE + 1 -FACE_LOOP : DO ILE=2,NP_L - DO IFC=1,NP_T +! Call tag boundary cut-cells for blocking in refinement interfaces: +CALL TAG_CC_BLOCKING_REFINEMENT - ! Locate first vertex index: - IF (IFC < NP_T) THEN - I1 = (ILE-1)*NP_T + 1 + IFC - I2 = (ILE-1)*NP_T + 1 + IFC + 1 - I3 = (ILE-2)*NP_T + 1 + IFC - I4 = (ILE-2)*NP_T + 1 + IFC + 1 - ELSE - I1 = (ILE-1)*NP_T + 1 + IFC - I2 = (ILE-1)*NP_T + 1 + 1 - I3 = (ILE-2)*NP_T + 1 + IFC - I4 = (ILE-2)*NP_T + 1 + 1 - ENDIF +ENDDO - IFACE=IFACE+1 - FACES(3*IFACE-2:3*IFACE) = (/I1, I3, I2/) - IFACE=IFACE+1 - FACES(3*IFACE-2:3*IFACE) = (/I3, I4, I2/) +FINAL_BLOCK_MESH_LOOP : DO NM=1,NMESHES - ENDDO -ENDDO FACE_LOOP -CYL_FIND(HIGH_IND,2) = IFACE + IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. + IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 -! High axis plane: -IVERT=NVERTS -CYL_FIND(LOW_IND,1) = IFACE + 1 -DO IFC=1,NP_T - IF (IFC < NP_T) THEN - I1 = (NP_L-1)*NP_T + 1 + IFC - I2 = (NP_L-1)*NP_T + 1 + IFC + 1 - I3 = IVERT - ELSE - I1 = (NP_L-1)*NP_T + 1 + IFC - I2 = (NP_L-1)*NP_T + 1 + 1 - I3 = IVERT - ENDIF - IFACE=IFACE+1 - FACES(3*IFACE-2:3*IFACE) = (/I1, I2, I3 /) -ENDDO -CYL_FIND(HIGH_IND,1) = IFACE -NFACES = IFACE + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) -! Transform vertices to global axes: -DO IVERT=1,NVERTS - V(IAXIS:KAXIS,1) = VERTS(3*IVERT-2:3*IVERT) - R = MATMUL(TGL,V) - VERTS(3*IVERT-2:3*IVERT) = R(IAXIS:KAXIS,1) + CYLINDER_ORIGIN(IAXIS:KAXIS) -ENDDO + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) -! No volumes being defined. -NVOLS = 0 -VOLS = 0 + ! Here: 1,2. Define Linking information for cut-cells. + CALL GET_CELL_LINK_INFO(NM) -! WRITE(LU_ERR,*) 'Vertices:' -! DO IVERT=1,NVERTS -! WRITE(LU_ERR,*) VERTS(3*IVERT-2:3*IVERT) -! ENDDO -! WRITE(LU_ERR,*) ' ' -! WRITE(LU_ERR,*) 'Faces:' -! DO IFACE=1,NFACES -! WRITE(LU_ERR,*) FACES(3*IFACE-2:3*IFACE) -! ENDDO + ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: + CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) + IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + CALL GET_CELL_LINK_INFO(NM) + ENDIF -RETURN -END SUBROUTINE DEFINE_CYLINDER + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +ENDDO FINAL_BLOCK_MESH_LOOP -! ---------------------------- GET_GEOM_INFO ---------------------------------------- +END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK -SUBROUTINE GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) ! LU_INPUT not used for now. +SUBROUTINE CC_GRID_POSTPROCESS_AND_CLEANUP(NM) -! Count number of various geometry types on the current &GEOM line -! Assume a maximum number of faces and ZVALS, which can be modified in the &MISC line. +INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(INOUT) :: MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS +CALL CC_GRID_RELEASE_BLOCKED_CELL_LISTS(NM) -MAX_ZVALS = MAX(MAX_ZVALS, MAXIMUM_GEOMETRY_ZVALS) -MAX_VOLUS = MAX(MAX_VOLUS,6*MAX_ZVALS, MAXIMUM_GEOMETRY_VOLUS) -MAX_FACES = MAX(MAX_FACES,4*MAX_VOLUS, MAXIMUM_GEOMETRY_FACES) -MAX_VERTS = MAX(MAX_VERTS,4*MAX_VOLUS,3*MAX_FACES, MAXIMUM_GEOMETRY_VERTS) -MAX_IDS = MAX(MAX_IDS, MAXIMUM_GEOMETRY_IDS) -MAX_SURF_IDS = MAX(MAX_SURF_IDS, MAXIMUM_GEOMETRY_SURFIDS) -MAX_POLY_VERTS= MAX(MAX_POLY_VERTS, MAXIMUM_POLY_VERTS) +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 -END SUBROUTINE GET_GEOM_INFO +CALL POINT_TO_MESH(NM) +M => MESHES(NM) -! ---------------------------- ALLOCATE_BUFFERS ---------------------------------------- +! Here Add Areas per SURF_ID: +IF (PROCESS(NM)==MY_RANK) THEN + DO ICF=1,M%N_CUTFACE_MESH + CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE + DO J=1,CF%NFACE + IF(.NOT.CF%BLK_TAG(J)) CYCLE + GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & + GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) + ENDDO + ENDDO +ENDIF +! Deallocate arrays: +IF (GET_CUTCELLS_VERBOSE) THEN + IF(M%N_CUTCELL_MESH > 0) THEN + MIN_FACES_PER_CUTCELL = 1000000 !HUGE(MIN_FACES_PER_CUTCELL) + MAX_FACES_PER_CUTCELL = 0 + MEAN_FACES_PER_CUTCELL= 0 + SUM_FACE = 0 + SUM_CCELL= 0 + DO ICC1=1,M%N_CUTCELL_MESH + IF (M%CUT_CELL(ICC1)%NCELL==0) CYCLE + SUM_CCELL = SUM_CCELL + M%CUT_CELL(ICC1)%NCELL + DO ICC2=1,M%CUT_CELL(ICC1)%NCELL + MAX_FACES_PER_CUTCELL = MAX(MAX_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) + MIN_FACES_PER_CUTCELL = MIN(MIN_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) + SUM_FACE = SUM_FACE + M%CUT_CELL(ICC1)%CCELEM(1,ICC2) + ENDDO + ENDDO + IF(SUM_CCELL > TWENTY_EPSILON_EB) MEAN_FACES_PER_CUTCELL = SUM_FACE / SUM_CCELL + ! Write to file: + WRITE(LU_SETCC,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& + MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL + IF (MEAN_FACES_PER_CUTCELL > 30) THEN + WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN + WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ENDIF + ! Write to ERR file: + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& + MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL + IF (MEAN_FACES_PER_CUTCELL > 30) THEN + WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN + WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ENDIF + ENDIF + ENDIF + WRITE(LU_SETCC,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' + WRITE(LU_SETCC,'(A)') ' ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' + WRITE(LU_ERR ,'(A)') ' ' + ENDIF +ENDIF -SUBROUTINE ALLOCATE_BUFFERS +! Here we have to deallocate if no geometric entities were defined: +! EDGE_CROSS is deallocated: +IF (ALLOCATED(M%EDGE_CROSS)) DEALLOCATE(M%EDGE_CROSS) +IF (M%N_CUTEDGE_MESH == 0 .OR. PROCESS(NM)/=MY_RANK) THEN + IF (ALLOCATED(M%CUT_EDGE)) DEALLOCATE(M%CUT_EDGE) +ENDIF +IF (M%N_CUTFACE_MESH+M%N_BBCUTFACE_MESH+M%N_GCCUTFACE_MESH == 0) THEN + IF (ALLOCATED(M%CUT_FACE)) DEALLOCATE(M%CUT_FACE) +ENDIF +IF(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH == 0) THEN + IF (ALLOCATED(M%CUT_CELL)) DEALLOCATE(M%CUT_CELL) +ENDIF -IF(ALLOCATED(SURF_ID)) DEALLOCATE(SURF_ID) -ALLOCATE(SURF_ID(MAX_SURF_IDS+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','SURF_ID',IZERO) +! Sanity tests on cut-faces, cut-cells: +IF (DEBUG_SET_CUTCELLS) THEN + CUTFACE_TEST_LOOP : DO ICF=1,M%N_CUTFACE_MESH + NFACE = M%CUT_FACE(ICF)%NFACE + I = M%CUT_FACE(ICF)%IJK(IAXIS) + J = M%CUT_FACE(ICF)%IJK(JAXIS) + K = M%CUT_FACE(ICF)%IJK(KAXIS) + X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) + DO I=1,NFACE + IF(M%CUT_FACE(ICF)%AREA(I) MESHES(NM) - ZMIN=ZS_MIN - WRITE(ID,'(A,I0)') 'geom_',N - SURF_ID(:)='null' - SURF_IDS = 'null' - SURF_ID6 = 'null' - MATL_ID = 'null' - MOVE_ID = 'null' - DEVC_ID = 'null' - CTRL_ID = 'null' - FYI = 'null' - HAVE_SURF = .TRUE. - HAVE_MATL = .TRUE. - TEXTURE_ORIGIN = 0.0_EB - TEXTURE_MAPPING = 'RECTANGULAR' - TEXTURE_SCALE = 1.0_EB - TRANSPARENCY = -1._EB - VERTS=1.001_EB*MAX_VAL - ZVALS=1.001_EB*MAX_VAL - XB=1.001_EB*MAX_VAL - FACES=0 - VOLUS=0 - POLY =0 - IJK = 2 ! minimize number of triangles by default - IS_GEOMETRY_DYNAMIC = .FALSE. - EXTEND_TERRAIN = .FALSE. - IS_TERRAIN = .FALSE. - ZVAL_HORIZON = 1.001_EB*MAX_VAL - SPHERE_ORIGIN = 1.001_EB*MAX_VAL - SPHERE_RADIUS = 1.001_EB*MAX_VAL - CYLINDER_LENGTH = 1.001_EB*MAX_VAL - CYLINDER_RADIUS = 1.001_EB*MAX_VAL - CYLINDER_ORIGIN = 1.001_EB*MAX_VAL - CYLINDER_AXIS = 1.001_EB*MAX_VAL - EXTRUDE = 0._EB - CYLINDER_NSEG_THETA = -1 - CYLINDER_NSEG_AXIS = -1 - N_LEVELS=-1 - N_LAT=-1 - N_LONG=-1 - SPHERE_TYPE=-1 - GEOM_TYPE=CAD_GEOM_TYPE - BNDF_GEOM=BNDF_DEFAULT - READ_BINARY = .FALSE. - BINARY_FILE = 'null' - RGB=-1 - CELL_BLOCK_IOR=0 - CELL_BLOCK_ORIENTATION = 0._EB - COLOR='null' +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + CF => M%CUT_FACE(ICF); IF(CF%NFACE==0) CYCLE + ICF1=3 ! BLOCK boundary flag, when == 1,2. + IF (CF%STATUS == CC_GASPHASE) THEN + I = CF%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE + J = CF%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE + K = CF%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE + SELECT CASE(CF%IJK(KAXIS+1)) ! X1AXIS + CASE(IAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DY(J)*DZ(K)); IF(I==0 .OR. I==M%IBAR) ICF1=1 + CASE(JAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DZ(K)*DX(I)); IF(J==0 .OR. J==M%JBAR) ICF1=1 + CASE(KAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DX(I)*DY(J)); IF(K==0 .OR. K==M%KBAR) ICF1=1 + END SELECT + ENDIF + CALL ALLOC_FACE_STATE_VARS(NM,ICF,CF%NFACE,ICF1) +ENDDO -END SUBROUTINE SET_GEOM_DEFAULTS +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC => M%CUT_CELL(ICC); IF(CC%NCELL==0) CYCLE + I = CC%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE + J = CC%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE + K = CC%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE + CC%ALPHA_CC = SUM(CC%VOLUME(1:CC%NCELL))/(DX(I)*DY(J)*DZ(K)) + CALL ALLOC_CELL_STATE_VARS(NM,ICC,CC%NCELL) +ENDDO -! ! ---------------------------- EXTRUDE_SPHERE ---------------------------------------- -! -! SUBROUTINE EXTRUDE_SPHERE(ZCENTER,VERTS,MAXVERTS,NVERTS,FACES,NFACES,VOLS,MAXVOLS, NVOLS) -! -! ! convert a closed surface defined by VERTS and FACES into a solid -! -! INTEGER, INTENT(IN) :: NFACES, MAXVERTS,MAXVOLS -! INTEGER, INTENT(INOUT) :: NVERTS -! REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) -! INTEGER, INTENT(IN) :: FACES(3*NFACES) -! INTEGER, INTENT(OUT) :: NVOLS -! INTEGER, INTENT(OUT) :: VOLS(4*MAXVOLS) -! REAL(EB), INTENT(IN) :: ZCENTER(3) -! -! INTEGER :: I -! -! ! define a new vertex at ZCENTER -! VERTS(3*NVERTS+1:3*NVERTS+3)=ZCENTER(1:3) -! -! ! form a tetrahedron using each face and the vertex ZCENTER -! DO I = 1, NFACES -! VOLS(4*I-3:4*I)=(/FACES(3*I-2:3*I),NVERTS+1/) -! ENDDO -! NVERTS=NVERTS+1 -! NVOLS=NFACES -! -! END SUBROUTINE EXTRUDE_SPHERE +! Allocate array of indexes of chemically active cut-cells +SUM_CC = 0 +DO ICC=1,M%N_CUTCELL_MESH + SUM_CC = SUM_CC + CC%NCELL +ENDDO +ALLOCATE(M%CHEM_ACTIVE_CC(SUM_CC,3)) +M%CHEM_ACTIVE_CC=-1 -! ! ---------------------------- EXTRUDE_SURFACE ---------------------------------------- -! -! SUBROUTINE EXTRUDE_SURFACE(ZMIN,VERTS,MAXVERTS,NVERTS,FACES,NFACES,VOLS,MAXVOLS, NVOLS) -! -! ! extend a 2D surface defined by VERTS and FACES to a plane defined by ZMIN -! -! INTEGER, INTENT(IN) :: NFACES, MAXVERTS,MAXVOLS -! INTEGER, INTENT(INOUT) :: NVERTS -! REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) -! INTEGER, INTENT(IN) :: FACES(3*NFACES) -! INTEGER, INTENT(OUT) :: NVOLS -! INTEGER, INTENT(OUT) :: VOLS(4*MAXVOLS) -! REAL(EB), INTENT(IN) :: ZMIN -! INTEGER :: PRISM(6) -! -! INTEGER :: I -! REAL(EB), POINTER, DIMENSION(:) :: VNEW, VOLD -! -! ! define a new vertex on the plane z=ZMIN for each vertex in original list -! DO I = 1, NVERTS -! VNEW=>VERTS(3*NVERTS+3*I-2:3*NVERTS+3*I) -! VOLD=>VERTS(3*I-2:3*I) -! VNEW(1:3)=(/VOLD(1:2),ZMIN/) +END SUBROUTINE CC_GRID_ALLOCATE_STATE_VARS + +SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST + +! ALL REDUCE areas per surface: +IF(N_GEOMETRY>0) THEN +CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_OLD(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) +CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) +ENDIF +! Define AREA_ADJUST per SURF_ID: +DO J=1,N_GEOMETRY + DO I=0,N_SURF + IF(GEOM_AREA_SURF_NEW(I,J)>TWENTY_EPSILON_EB) THEN + GEOM_AREA_SURF_NEW(I,J) = GEOM_AREA_SURF_OLD(I,J)/GEOM_AREA_SURF_NEW(I,J) + ELSE; GEOM_AREA_SURF_NEW(I,J) = 1._EB + ENDIF + ENDDO +ENDDO +DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE + DO J=1,CF%NFACE + IF(.NOT.CF%BLK_TAG(J)) CYCLE + CF%AREA_ADJUST(J) = CF%AREA_ADJUST(J)*GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + ENDDO + ENDDO + DEALLOCATE(MESHES(NM)%INBCF_AREA) +ENDDO + +! GEOM_AREA_SURF_NEW = 0._EB +! DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX +! DO ICF=1,MESHES(NM)%N_CUTFACE_MESH +! CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE +! DO J=1,CF%NFACE +! IF(.NOT.CF%BLK_TAG(J)) CYCLE +! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & +! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) +! ENDDO +! ENDDO ! ENDDO -! ! construct 3 tetrahedrons for each prism (solid between original face and face on plane z=zplane) -! DO I = 1, NFACES -! PRISM(1:3)=FACES(3*I-2:3*I) -! PRISM(4:6)=FACES(3*I-2:3*I)+NVERTS -! CALL PRISM2TETRA(PRISM,VOLS(12*I-11:12*I)) +! CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW,(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) +! DO J=1,N_GEOMETRY +! DO I=0,N_SURF +! IF(MY_RANK==0) WRITE(LU_ERR,*) 'IG,N_SURF,AOLD,ANEW=',J,I,GEOM_AREA_SURF_OLD(I,J),GEOM_AREA_SURF_NEW(I,J) +! ENDDO ! ENDDO -! NVOLS=3*NFACES -! NVERTS=2*NVERTS -! -! END SUBROUTINE EXTRUDE_SURFACE +IF(ALLOCATED(GEOM_AREA_SURF_OLD)) DEALLOCATE(GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) -! ---------------------------- BOX2TETRA ---------------------------------------- +END SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST -SUBROUTINE BOX2TETRA(BOX,TETRAS) +SUBROUTINE CC_GRID_LOG_PROCESSING_TIME -! split a box defined by a list of 8 vertices (not necessarily cubic) into 6 stackable tetrahedrons +! Add to SET_CUTCELLS_3D loop time: +T_CC_USED(SET_CUTCELLS_TIME_INDEX) = T_CC_USED(SET_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW -! 8-------7 -! / . / | -! 5-------6 | -! | . | | -! | . | | -! | 4-------3 -! | / | / -! 1-------2 +IF(GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_MESH) + WRITE(LU_SETCC,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' + WRITE(LU_SETCC,'(A)') ' ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' + WRITE(LU_ERR,'(A)') ' ' + ENDIF +ENDIF +END SUBROUTINE CC_GRID_LOG_PROCESSING_TIME -INTEGER, INTENT(IN) :: BOX(8) -INTEGER, INTENT(OUT) :: TETRAS(1:24) +SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING(EARLY_RETURN) -TETRAS(1:4) = (/BOX(1),BOX(2),BOX(4),BOX(5)/) -TETRAS(5:8) = (/BOX(4),BOX(5),BOX(2),BOX(6)/) -TETRAS(9:12) = (/BOX(4),BOX(5),BOX(6),BOX(8)/) -TETRAS(13:16) = (/BOX(2),BOX(3),BOX(4),BOX(6)/) -TETRAS(17:20) = (/BOX(4),BOX(6),BOX(3),BOX(8)/) -TETRAS(21:24) = (/BOX(6),BOX(3),BOX(8),BOX(7)/) +LOGICAL, INTENT(OUT) :: EARLY_RETURN -END SUBROUTINE BOX2TETRA +EARLY_RETURN = .FALSE. -! ! ---------------------------- PRISM2TETRA ---------------------------------------- -! -! SUBROUTINE PRISM2TETRA(PRISM,TETRAS) -! -! ! split a prism defined by a list of 6 vertices into 3 tetrahedrons -! -! ! 6 -! ! /.\ . -! ! / . \ . -! ! / . \ . -! ! 4-----------5 -! ! | . | -! ! | . | -! ! | 3 | -! ! | / \ | -! ! | / \ | -! ! |/ \| -! ! 1-----------2 -! INTEGER, INTENT(IN) :: PRISM(6) -! INTEGER, INTENT(OUT) :: TETRAS(1:12) -! -! TETRAS(1:4) = (/PRISM(1),PRISM(6),PRISM(4),PRISM(5)/) -! TETRAS(5:8) = (/PRISM(1),PRISM(3),PRISM(6),PRISM(5)/) -! TETRAS(9:12) = (/PRISM(1),PRISM(2),PRISM(3),PRISM(5)/) -! -! END SUBROUTINE PRISM2TETRA +IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) -! ! ---------------------------- SPLIT_TETRA ---------------------------------------- -! -! SUBROUTINE SPLIT_TETRA(VERTS,MAXVERTS,NVERTS,TETRAS) -! ! split a tetrahedron defined by a list of 4 vertices into 4 tetrahedrons -! -! ! 1 -! ! | -! ! .|. -! ! .|. -! ! . | . -! ! . 7 . -! ! . | . -! ! . 4 . -! ! 5 / \ 6 -! ! . / \ . -! ! . / \ . -! ! . / \ . -! ! ./ \. -! ! / \. -! ! 2-------------3 -! -! INTEGER, INTENT(IN) :: MAXVERTS -! INTEGER, INTENT(INOUT) :: NVERTS -! REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) -! INTEGER, INTENT(INOUT) :: TETRAS(16) -! -! REAL(EB), POINTER, DIMENSION(:) :: VERT1, VERT2, VERT3, VERT4, VERT5, VERT6, VERT7 -! INTEGER :: TETRANEW(16) -! -! VERT1=>VERTS(3*TETRAS(1)-2:3*TETRAS(1)) -! VERT2=>VERTS(3*TETRAS(2)-2:3*TETRAS(2)) -! VERT3=>VERTS(3*TETRAS(3)-2:3*TETRAS(3)) -! VERT4=>VERTS(3*TETRAS(4)-2:3*TETRAS(4)) -! VERT5=>VERTS(3*NVERTS+1:3*NVERTS+3) -! VERT6=>VERTS(3*NVERTS+4:3*NVERTS+6) -! VERT7=>VERTS(3*NVERTS+7:3*NVERTS+9) -! -! ! add 3 vertices -! VERT5(1:3) = ( VERT1(1:3)+VERT2(1:3) )/2.0_EB -! VERT6(1:3) = ( VERT1(1:3)+VERT3(1:3) )/2.0_EB -! VERT7(1:3) = ( VERT1(1:3)+VERT4(1:3) )/2.0_EB -! TETRAS(5)=NVERTS+1 -! TETRAS(6)=NVERTS+2 -! TETRAS(7)=NVERTS+3 -! NVERTS=NVERTS+3 -! -! TETRANEW(1:4)=(/TETRAS(1),TETRAS(5),TETRAS(6),TETRAS(7)/) -! CALL PRISM2TETRA(TETRAS(2:7),TETRANEW(5:16)) -! TETRAS(1:16)=TETRANEW(1:16) -! -! END SUBROUTINE SPLIT_TETRA +IF(GET_CUTCELLS_VERBOSE) THEN + WRITE(LU_SETCC,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' + WRITE(LU_SETCC,'(A)') ' ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' + WRITE(LU_ERR ,'(A)') ' ' + ENDIF +ENDIF + +! Write out: +! Increase SET_CUTCELLS_3D call counter by 1: +CALL_COUNT = CALL_COUNT + 1 +IF(PERIODIC_TEST==105) THEN + CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) + IF(CALL_COUNT > 1) THEN + EARLY_RETURN = .TRUE. + RETURN + ENDIF +ENDIF + +END SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING + +SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY + +! Loop over geometry: +CCVERBOSE_COND : IF(GET_CUTCELLS_VERBOSE) THEN + SLEN_GEOM = 0._EB; AREA_GEOM = 0._EB; VOLUME_GEOM = 0._EB; XYZCEN_GEOM(IAXIS:KAXIS) = 0._EB + DO IG=1,N_GEOMETRY + ! Add length of wet surface edges: + DO IEDGE=1,GEOMETRY(IG)%N_EDGES + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IEDGE) + DV(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - & + GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) + SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) + SLEN_GEOM = SLEN_GEOM + SLEN + ENDDO + ! Add to wet surface Areas: + AREA_GEOM = AREA_GEOM + GEOMETRY(IG)%GEOM_AREA + ! Add to GEOMETRY volume: + VOLUME_GEOM = VOLUME_GEOM + GEOMETRY(IG)%GEOM_VOLUME + ! Add to XYZCEN for geometries: + XYZCEN_GEOM(IAXIS:KAXIS)= XYZCEN_GEOM(IAXIS:KAXIS) + GEOMETRY(IG)%GEOM_VOLUME * GEOMETRY(IG)%GEOM_XYZCEN(IAXIS:KAXIS) + ENDDO + IF(N_GEOMETRY > 0) XYZCEN_GEOM(IAXIS:KAXIS)=XYZCEN_GEOM(IAXIS:KAXIS)/VOLUME_GEOM + + ! Loop over meshes: + NCUTFACE_INB = 0 + CF_AREA_INB=0._EB + CC_VOLUME_INB=0._EB + GP_VOLUME=0._EB + DM_XYZCEN(IAXIS:KAXIS) = 0._EB + CCGP_XYZCEN(IAXIS:KAXIS) = 0._EB + TESTS_MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + DO ICF1 = 1,MESHES(NM)%N_CUTFACE_MESH + IF (CUT_FACE(ICF1)%STATUS == CC_INBOUNDARY) THEN + NFACE = CUT_FACE(ICF1)%NFACE + CF_AREA_INB = CF_AREA_INB + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) + ENDIF + ENDDO + DO ICC1 = 1,MESHES(NM)%N_CUTCELL_MESH + NCELL = CUT_CELL(ICC1)%NCELL + DO ICC2=1,NCELL + CCGP_XYZCEN(IAXIS:KAXIS) = CCGP_XYZCEN(IAXIS:KAXIS) + CUT_CELL(ICC1)%VOLUME(ICC2) * & + CUT_CELL(ICC1)%XYZCEN(IAXIS:KAXIS,ICC2) + IF (CUT_CELL(ICC1)%VOLUME(ICC2)1) THEN - NMID = (LEFT+RIGHT)/2 - CALL ORDER_FACES1(ORDER,WORK,LEFT,NMID,N) - CALL ORDER_FACES1(ORDER,WORK,NMID+1,RIGHT,N) - I1=LEFT - I2=NMID+1 - ICOUNT=LEFT - DO WHILE (I1<=NMID .OR. I2<=RIGHT) - IF (I1<=NMID .AND. I2<=RIGHT) THEN - IF (COMPARE_FACES(ORDER(I1),ORDER(I2))==-1) THEN - WORK(ICOUNT)=ORDER(I1) - I1=I1+1 - ELSE - WORK(ICOUNT)=ORDER(I2) - I2=I2+1 - ENDIF - ELSE IF (I1<=NMID .AND. I2>RIGHT) THEN - WORK(ICOUNT)=ORDER(I1) - I1=I1+1 - ELSE IF (I1>NMID .AND. I2<=RIGHT) THEN - WORK(ICOUNT)=ORDER(I2) - I2=I2+1 - ENDIF - ICOUNT=ICOUNT+1 + IF (MY_RANK == 0) THEN + WRITE(LU_ERR,"(A,E11.4,A,E11.4,A,E11.4)") & + ' GEOM Gas Volume=',DM_VOLUME-VOLUME_GEOM,', Cut/Regl Gas cells Volume=',GP_VOLUME+CC_VOLUME_INB, & + ', Relative Difference=',((DM_VOLUME-VOLUME_GEOM)-(GP_VOLUME+CC_VOLUME_INB))/(DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) + WRITE(LU_SETCC,"(A,E11.4,A,E11.4,A,E11.4)") & + ' GEOM Gas Volume=',DM_VOLUME-VOLUME_GEOM,', Cut/Regl Gas cells Volume=',GP_VOLUME+CC_VOLUME_INB, & + ', Relative Difference=',((DM_VOLUME-VOLUME_GEOM)-(GP_VOLUME+CC_VOLUME_INB))/(DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) + WRITE(LU_ERR,"(A,3E12.4)") & + ' GEOM Centroid =',XYZCEN_GEOM(IAXIS:KAXIS) + WRITE(LU_ERR,"(A,3E12.4)") & + ' DOMAIN-GEOM Centroid =',(DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & + (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) + WRITE(LU_ERR,"(A,3E12.4)") & + ' Cut/Regl Gas cells Centroid =',CCGP_XYZCEN(IAXIS:KAXIS) + WRITE(LU_ERR,"(A,3E12.4)") & + ' Centroid Relative Difference=',CCGP_XYZCEN(IAXIS:KAXIS)-& + (DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & + (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) + WRITE(LU_SETCC,"(A,3E12.4)") & + ' GEOM Centroid =',XYZCEN_GEOM(IAXIS:KAXIS) + WRITE(LU_SETCC,"(A,3E12.4)") & + ' DOMAIN-GEOM Centroid =',(DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & + (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) + WRITE(LU_SETCC,"(A,3E12.4)") & + ' Cut/Regl Gas cells Centroid =',CCGP_XYZCEN(IAXIS:KAXIS) + WRITE(LU_SETCC,"(A,3E12.4)") & + ' Centroid Relative Difference=',CCGP_XYZCEN(IAXIS:KAXIS)-& + (DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & + (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) + ENDIF + + ! Write out the GEOM Area per SURF_ID: + ALLOCATE(GEOM_AREA_SURF(0:N_SURF)); GEOM_AREA_SURF=0._EB + ALLOCATE(GEOM_SURF(0:N_SURF)); GEOM_SURF=0 + SURF_MESH_LOOP : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + DO ICF=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + CFA=>CFACE(ICF) + GEOM_AREA_SURF(CFA%SURF_INDEX) = GEOM_AREA_SURF(CFA%SURF_INDEX) + CFA%AREA + GEOM_SURF(CFA%SURF_INDEX) = 1 + ENDDO + ENDDO SURF_MESH_LOOP + CALL MPI_ALLREDUCE(MPI_IN_PLACE, GEOM_AREA_SURF(0), N_SURF+1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE, GEOM_SURF(0), N_SURF+1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, IERR) + IF (MY_RANK==0) THEN + DO SURF_INDEX=0,N_SURF + IF (GEOM_SURF(SURF_INDEX)>0) & + WRITE(LU_ERR,"(A,1E14.6)") ' SURF_ID = '//TRIM(SURFACE(SURF_INDEX)%ID)//', Area : ',GEOM_AREA_SURF(SURF_INDEX) + WRITE(LU_SETCC,"(A,1E14.6)")' SURF_ID = '//TRIM(SURFACE(SURF_INDEX)%ID)//', Area : ',GEOM_AREA_SURF(SURF_INDEX) + ENDDO + ENDIF + DEALLOCATE(GEOM_AREA_SURF, GEOM_SURF) + + ! Write out special cells info: + N_SPCELLCF_TOT=0; N_SPCELL_TOT=0 + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + N_SPCELLCF_TOT = N_SPCELLCF_TOT + MESHES(NM)%N_SPCELL_CF + N_SPCELL_TOT = N_SPCELL_TOT + MESHES(NM)%N_SPCELL + WRITE(LU_SETCC,"(A,3I8)") 'MESH, Number of Special Cells CF, Total=',NM,MESHES(NM)%N_SPCELL_CF,MESHES(NM)%N_SPCELL + DO ICC1=1,MESHES(NM)%N_SPCELL + WRITE(LU_SETCC,"(A,2I8,A,3I8)") 'NM,CELL IJK=',NM,ICC1,':',MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,ICC1) + ENDDO ENDDO - ORDER(LEFT:RIGHT)=WORK(LEFT:RIGHT) -ELSE IF (RIGHT-LEFT==1) THEN - IF (COMPARE_FACES(ORDER(LEFT),ORDER(RIGHT))==1) RETURN - TEMP=ORDER(LEFT) - ORDER(LEFT) = ORDER(RIGHT) - ORDER(RIGHT) = TEMP -ENDIF -END SUBROUTINE ORDER_FACES1 + CALL MPI_ALLREDUCE(MPI_IN_PLACE, N_SPCELLCF_TOT, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, IERR) + CALL MPI_ALLREDUCE(MPI_IN_PLACE, N_SPCELL_TOT, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, IERR) + IF (MY_RANK==0) WRITE(LU_ERR,"(A,2I8)") 'Total Number of Special Cells CF, Total=',N_SPCELLCF_TOT,N_SPCELL_TOT -! ---------------------------- COMPARE_FACES ---------------------------------------- + ! Write out more detailed stats: + WRITE_CFACE_STATS_COND : IF (WRITE_CFACE_STATS) THEN + ! Loop over meshes: + TESTS_MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + NCUTEDGE_IBCC = 0; SLEN_IBCC = 0._EB + NCUTEDGE_IBCF = 0 + ! Number of CUT_EDGE for this mesh: + IF(ALLOCATED(MESHES(NM)%CUT_EDGE)) THEN + DO ICE1 = 1,MESHES(NM)%N_CUTEDGE_MESH + SELECT CASE(MESHES(NM)%CUT_EDGE(ICE1)%STATUS) + CASE(CC_INBOUNDCC) + NEDGE = MESHES(NM)%CUT_EDGE(ICE1)%NEDGE + NCUTEDGE_IBCC = NCUTEDGE_IBCC + NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(ICE1)%CEELEM(NOD1:NOD2,IEDGE) + DV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(ICE1)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - & + MESHES(NM)%CUT_EDGE(ICE1)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) + SLEN_IBCC = SLEN_IBCC + SLEN + ENDDO + CASE(CC_INBOUNDCF) + SELECT CASE(MESHES(NM)%CUT_EDGE(ICE1)%IJK(4)) + CASE(IAXIS) + IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(IAXIS) == IBAR) CYCLE + CASE(JAXIS) + IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(JAXIS) == JBAR) CYCLE + CASE(KAXIS) + IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(KAXIS) == KBAR) CYCLE + END SELECT + NCUTEDGE_IBCF = NCUTEDGE_IBCF + MESHES(NM)%CUT_EDGE(ICE1)%NEDGE + END SELECT + ENDDO + ENDIF + + WRITE(LU_SETCC,*) ' ' + WRITE(LU_SETCC,*) 'MESH=',NM + WRITE(LU_SETCC,*) 'CUTEDGE=',PROCESS(NM),NM,MESHES(NM)%N_CUTEDGE_MESH,MESHES(NM)%N_EDGE_CROSS + !WRITE(LU_SETCC,*) 'NCUTEDGE_IBCF =',NCUTEDGE_IBCF + !WRITE(LU_SETCC,*) 'NCUTEDGE_IBCC =',NCUTEDGE_IBCC, ', SLEN_IBCC =',SLEN_IBCC,', SLEN_GEOM =',SLEN_GEOM + + NCUTFACE_IAXIS = 0 + NCUTFACE_JAXIS = 0 + NCUTFACE_KAXIS = 0 + CF_AREA_IAXIS=0._EB; CF_AREA_JAXIS=0._EB; CF_AREA_KAXIS=0._EB + CF_INXAREA_IAXIS=0._EB; CF_INXAREA_JAXIS=0._EB; CF_INXAREA_KAXIS=0._EB + CF_INXSQAREA_IAXIS=0._EB; CF_INXSQAREA_JAXIS=0._EB; CF_INXSQAREA_KAXIS=0._EB + CF_JNYSQAREA_IAXIS=0._EB; CF_JNYSQAREA_JAXIS=0._EB; CF_JNYSQAREA_KAXIS=0._EB + CF_KNZSQAREA_IAXIS=0._EB; CF_KNZSQAREA_JAXIS=0._EB; CF_KNZSQAREA_KAXIS=0._EB + NCUTFACE_INB = 0 + CF_AREA_INB=0._EB; CF_INXAREA_INB=0._EB; + CF_INXSQAREA_INB=0._EB; CF_JNYSQAREA_INB=0._EB; CF_KNZSQAREA_INB=0._EB + DO ICF1 = 1,MESHES(NM)%N_CUTFACE_MESH + IF (CUT_FACE(ICF1)%STATUS == CC_GASPHASE) THEN + NFACE = CUT_FACE(ICF1)%NFACE + X1AXIS= CUT_FACE(ICF1)%IJK(MAX_DIM+1) + SELECT CASE(X1AXIS) + CASE(IAXIS) + NCUTFACE_IAXIS = NCUTFACE_IAXIS + NFACE + CF_AREA_IAXIS = CF_AREA_IAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) + CF_INXAREA_IAXIS = CF_INXAREA_IAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) + CF_INXSQAREA_IAXIS=CF_INXSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) + CF_JNYSQAREA_IAXIS=CF_JNYSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) + CF_KNZSQAREA_IAXIS=CF_KNZSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) + CASE(JAXIS) + NCUTFACE_JAXIS = NCUTFACE_JAXIS + NFACE + CF_AREA_JAXIS = CF_AREA_JAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) + CF_INXAREA_JAXIS = CF_INXAREA_JAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) + CF_INXSQAREA_JAXIS=CF_INXSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) + CF_JNYSQAREA_JAXIS=CF_JNYSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) + CF_KNZSQAREA_JAXIS=CF_KNZSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) + CASE(KAXIS) + NCUTFACE_KAXIS = NCUTFACE_KAXIS + NFACE + CF_AREA_KAXIS = CF_AREA_KAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) + CF_INXAREA_KAXIS = CF_INXAREA_KAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) + CF_INXSQAREA_KAXIS=CF_INXSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) + CF_JNYSQAREA_KAXIS=CF_JNYSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) + CF_KNZSQAREA_KAXIS=CF_KNZSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) + END SELECT + ELSE ! CC_INBOUNDARY.. + NFACE = CUT_FACE(ICF1)%NFACE + CF_AREA_INB = CF_AREA_INB + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) + CF_INXAREA_INB = CF_INXAREA_INB + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) + CF_INXSQAREA_INB=CF_INXSQAREA_INB+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) + CF_JNYSQAREA_INB=CF_JNYSQAREA_INB+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) + CF_KNZSQAREA_INB=CF_KNZSQAREA_INB+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) + ENDIF + ENDDO + !WRITE(LU_SETCC,*) ' ' + WRITE(LU_SETCC,*) 'CUTFACE=',PROCESS(NM),NM,MESHES(NM)%N_CUTFACE_MESH + WRITE(LU_SETCC,*) 'CUTFACE X Y Z=',NCUTFACE_IAXIS,NCUTFACE_JAXIS,NCUTFACE_KAXIS + !WRITE(LU_SETCC,*) 'CF_AREA X Y Z=',CF_AREA_IAXIS,CF_AREA_JAXIS,CF_AREA_KAXIS + !WRITE(LU_SETCC,*) 'CF_INXAREA X Y Z=',CF_INXAREA_IAXIS,CF_INXAREA_JAXIS,CF_INXAREA_KAXIS + !WRITE(LU_SETCC,*) 'CF_INXSQAREA X Y Z=',CF_INXSQAREA_IAXIS,CF_INXSQAREA_JAXIS,CF_INXSQAREA_KAXIS + !WRITE(LU_SETCC,*) 'CF_JNYSQAREA X Y Z=',CF_JNYSQAREA_IAXIS,CF_JNYSQAREA_JAXIS,CF_JNYSQAREA_KAXIS + !WRITE(LU_SETCC,*) 'CF_KNZSQAREA X Y Z=',CF_KNZSQAREA_IAXIS,CF_KNZSQAREA_JAXIS,CF_KNZSQAREA_KAXIS + !WRITE(LU_SETCC,*) ' ' + WRITE(LU_SETCC,*) 'CUTFACE INB=',NCUTFACE_INB + !WRITE(LU_SETCC,*) 'CF_AREA, CF_INXAREA INB=',CF_AREA_INB,CF_INXAREA_INB + !WRITE(LU_SETCC,*) 'CF_INXSQAREA INB =',CF_INXSQAREA_INB,CF_JNYSQAREA_INB,CF_KNZSQAREA_INB -INTEGER FUNCTION COMPARE_FACES(INDEX1,INDEX2) -INTEGER, INTENT(IN) :: INDEX1, INDEX2 -INTEGER, POINTER, DIMENSION(:) :: FACE1, FACE2 -INTEGER :: F1(3), F2(3) + ! Cut-cells: + MIN_CC_IJK_ICCJCC(1:5) = 0 + MAX_CC_IJK_ICCJCC(1:5) = 0 + MIN_CC_VOL = 1.E20_EB; MIN_ALPHA_CV = 1.E20_EB + MAX_CC_VOL =-1.E20_EB; MAX_ALPHA_CV =-1.E20_EB + DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH + CC => CUT_CELL(ICC1) + DO ICC2=1,CC%NCELL + IF(CC%VOLUME(ICC2) < MIN_CC_VOL) THEN + MIN_CC_VOL = CC%VOLUME(ICC2) + MIN_ALPHA_CV = MIN_CC_VOL / ( DX(CC%IJK(IAXIS))*DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) ) + MIN_CC_IJK_ICCJCC(1:5) = (/ CC%IJK(1:3), ICC1, ICC2 /) + ENDIF + IF(CC%VOLUME(ICC2) > MAX_CC_VOL) THEN + MAX_CC_VOL = CC%VOLUME(ICC2) + MAX_ALPHA_CV = MAX_CC_VOL / ( DX(CC%IJK(IAXIS))*DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) ) + MAX_CC_IJK_ICCJCC(1:5) = (/ CC%IJK(1:3), ICC1, ICC2 /) + ENDIF + ENDDO + ENDDO + WRITE(LU_SETCC,*) ' ' + WRITE(LU_SETCC,*) 'CUTCELL=',PROCESS(NM),NM,MESHES(NM)%N_CUTCELL_MESH + WRITE(LU_SETCC,*) 'MIN VOL=',MIN_CC_IJK_ICCJCC(1:5),MIN_CC_VOL,MIN_ALPHA_CV + WRITE(LU_SETCC,*) 'MAX VOL=',MAX_CC_IJK_ICCJCC(1:5),MAX_CC_VOL,MAX_ALPHA_CV -FACE1=>FACES(3*INDEX1-2:3*INDEX1) -FACE2=>FACES(3*INDEX2-2:3*INDEX2) -F1(1:3) = (/FACE1(1),MIN(FACE1(2),FACE1(3)),MAX(FACE1(2),FACE1(3))/) -F2(1:3) = (/FACE2(1),MIN(FACE2(2),FACE2(3)),MAX(FACE2(2),FACE2(3))/) + ! Dump info for Max Size Cut-cell: + DO IG=1,2 + IF(IG==1) THEN; ICC1 = MIN_CC_IJK_ICCJCC(4); ICC2 = MIN_CC_IJK_ICCJCC(5); ENDIF + IF(IG==2) THEN; ICC1 = MAX_CC_IJK_ICCJCC(4); ICC2 = MAX_CC_IJK_ICCJCC(5); ENDIF + IF(ICC1==0) CYCLE + CC => CUT_CELL(ICC1) + I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF(IG==1) THEN; WRITE(LU_SETCC,*) 'MIN VOL CC cut-faces:',I,J,K; ENDIF + IF(IG==2) THEN; WRITE(LU_SETCC,*) 'MAX VOL CC cut-faces:',I,J,K; ENDIF + DO JCF=2,CC%CCELEM(1,ICC2)+1 + IFACE = CC%CCELEM(JCF,ICC2) + FTYPE = CC%FACE_LIST(1,IFACE) + ILH = CC%FACE_LIST(2,IFACE) - 2 ! -1 for LOW_IND, 0 for HIGH_IND + X1AXIS= CC%FACE_LIST(3,IFACE) + SELECT CASE(FTYPE) + CASE(CC_FTYPE_RCGAS) + SELECT CASE(X1AXIS) + CASE(IAXIS); I=CC%IJK(IAXIS)+ILH; ACRT = DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) + CASE(JAXIS); J=CC%IJK(JAXIS)+ILH; ACRT = DX(CC%IJK(IAXIS))*DZ(CC%IJK(KAXIS)) + CASE(KAXIS); K=CC%IJK(KAXIS)+ILH; ACRT = DY(CC%IJK(JAXIS))*DX(CC%IJK(IAXIS)) + END SELECT + WRITE(LU_SETCC,*) JCF-1,' RCGAS ',I,J,K,X1AXIS,ACRT,ACRT/ACRT + CASE(CC_FTYPE_CFGAS) + SELECT CASE(X1AXIS) + CASE(IAXIS); ACRT = DY(J)*DZ(K) + CASE(JAXIS); ACRT = DX(I)*DZ(K) + CASE(KAXIS); ACRT = DY(J)*DX(I) + END SELECT + ICF2 = CC%FACE_LIST(4,IFACE) + JCF2 = CC%FACE_LIST(5,IFACE) + WRITE(LU_SETCC,*) JCF-1,' CFGAS ',CUT_FACE(ICF2)%IJK(1:KAXIS+1),CUT_FACE(ICF2)%AREA(JCF2),& + CUT_FACE(ICF2)%AREA(JCF2)/ACRT + CASE(CC_FTYPE_CFINB) + ICF2 = CC%FACE_LIST(4,IFACE) + JCF2 = CC%FACE_LIST(5,IFACE) + ACRT = 1._EB/3._EB*(DY(J)*DZ(K)+DX(I)*DZ(K)+DY(J)*DX(I)) + WRITE(LU_SETCC,*) JCF-1,' CFINB ',CUT_FACE(ICF2)%IJK(1:KAXIS+1),CUT_FACE(ICF2)%AREA(JCF2) + END SELECT + ENDDO + ENDDO -COMPARE_FACES=0 -IF (F1(1)F2(1)) THEN - COMPARE_FACES=-1 -ENDIF -IF (COMPARE_FACES/=0) RETURN + ENDDO TESTS_MESH_LOOP_2 + ENDIF WRITE_CFACE_STATS_COND +ENDIF CCVERBOSE_COND -IF (F1(2)F2(2)) THEN - COMPARE_FACES=-1 -ENDIF -IF (COMPARE_FACES/=0) RETURN +END SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY -IF (F1(3)F2(3)) THEN - COMPARE_FACES=-1 -ENDIF -END FUNCTION COMPARE_FACES +SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS -END SUBROUTINE READ_GEOM +USE TRAN, ONLY: GET_IJK +INTEGER :: NM2,ICELL,I2,J2,K2,BLOCK_TAG +LOGICAL :: IND_FOUND +REAL(EB):: XCO,YCO,ZCO,VOL_NM,VOL_NOM,X1,Y1,Z1 +TYPE(MESH_TYPE), POINTER :: M2 +MESH_LOOP : DO NM=1,NMESHES -! ---------------------------- INIT_SPHERE ---------------------------------------- + IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. + IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 -SUBROUTINE INIT_SPHERE(N_LEVELS,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) -INTEGER, INTENT(IN) :: N_LEVELS -INTEGER, INTENT(OUT) :: N_VERTS, N_FACES -INTEGER, INTENT(IN) :: MAX_VERTS, MAX_FACES -REAL(EB), TARGET, INTENT(OUT) :: SPHERE_VERTS(3*MAX_VERTS) -INTEGER, TARGET, INTENT(OUT) :: SPHERE_FACES(3*MAX_FACES) + ! Compute average cell volume for mesh NM + VOL_NM = (M%XF-M%XS)*(M%YF-M%YS)*(M%ZF-M%ZS) / REAL(M%IBAR*M%JBAR*M%KBAR,EB) -REAL(EB) :: ARG -REAL(EB), DIMENSION(3) :: VERT -INTEGER :: I,IFACE -INTEGER, DIMENSION(60) :: FACE_LIST + ! Process blocked cut-cells from neighboring meshes: + NEIGHBORING_MESHES_DO : DO NM2=1,M%N_NEIGHBORING_MESHES + NOM = M%NEIGHBORING_MESH(NM2); IF (NOM==NM) CYCLE + M2 => MESHES(NOM) -DATA (FACE_LIST(I),I=1,60) / & - 1, 2, 3, 1, 3, 4, 1, 4, 5, 1, 5, 6, 1, 6,2, & - 2, 7, 3, 3, 7, 8, 3, 8, 4, 4, 8, 9, 4, 9,5, & - 5, 9,10, 5,10, 6, 6,10,11, 6,11, 2, 2,11,7, & - 12, 8,7, 12, 9,8, 12,10,9, 12,11,10, 12,7,11 & - / + ICELL_DO : DO ICELL=1,M2%N_CC_BLOCKED + XCO = M2%XYZ_CC_BLOCKED(IAXIS,ICELL) + YCO = M2%XYZ_CC_BLOCKED(JAXIS,ICELL) + ZCO = M2%XYZ_CC_BLOCKED(KAXIS,ICELL) + BLOCK_TAG = M2%JBT_CC_BLOCKED(2,ICELL) -N_VERTS = 12 -N_FACES = 20 + CALL GET_IJK(XCO,YCO,ZCO,NOM,X1,Y1,Z1,I2,J2,K2) + VOL_NOM = M2%DX(I2)*M2%DY(J2)*M2%DZ(K2) -SPHERE_VERTS(1:3) = (/0.0,0.0,1.0/) ! 1 -DO I=2, 6 - ARG = REAL(I-2,EB)*72.0_EB - ARG = 2.0_EB*PI*ARG/360.0_EB - VERT = (/COS(ARG),SIN(ARG),1.0_EB/SQRT(5.0_EB)/) - SPHERE_VERTS(3*I-2:3*I) = VERT/NORM2(VERT) ! 2-6 -ENDDO -DO I=7, 11 - ARG = 36.0_EB+REAL(I-7,EB)*72.0_EB - ARG = 2.0_EB*PI*ARG/360.0_EB - VERT = (/COS(ARG),SIN(ARG),-1.0_EB/SQRT(5.0_EB)/) - SPHERE_VERTS(3*I-2:3*I) = VERT/NORM2(VERT) ! 7-11 -ENDDO -SPHERE_VERTS(34:36) = (/0.0,0.0,-1.0/) ! 12 + IF (VOL_NM > 1.5_EB * VOL_NOM) THEN ! NM is COARSE, NOM is FINE + IF(XCO < M2%XS .OR. XCO > M2%XF .OR. & + YCO < M2%YS .OR. YCO > M2%YF .OR. & + ZCO < M2%ZS .OR. ZCO > M2%ZF) CYCLE ICELL_DO + IF(XCO > M2%X(1) .AND. XCO < M2%X(M2%IBAR-1) .AND. & + YCO > M2%Y(1) .AND. YCO < M2%Y(M2%JBAR-1) .AND. & + ZCO > M2%Z(1) .AND. ZCO < M2%Z(M2%KBAR-1)) CYCLE ICELL_DO -SPHERE_FACES(1:60) = FACE_LIST(1:60) + ! Find I,J,K in NM where (XCO,YCO,ZCO) falls within cell bounds + IND_FOUND = .FALSE. + DO I=ILO_CELL-1,IHI_CELL+1 + IF (XCO < XFACE(I-1)-GEOMEPS .OR. XCO > XFACE(I)+GEOMEPS) CYCLE + DO J=JLO_CELL-1,JHI_CELL+1 + IF (YCO < YFACE(J-1)-GEOMEPS .OR. YCO > YFACE(J)+GEOMEPS) CYCLE + DO K=KLO_CELL-1,KHI_CELL+1 + IF (ZCO < ZFACE(K-1)-GEOMEPS .OR. ZCO > ZFACE(K)+GEOMEPS) CYCLE + IF (I > ILO_CELL-1 .AND. I < IHI_CELL+1 .AND. & + J > JLO_CELL-1 .AND. J < JHI_CELL+1 .AND. & + K > KLO_CELL-1 .AND. K < KHI_CELL+1) CYCLE + IND_FOUND = .TRUE. + EXIT + ENDDO + IF (IND_FOUND) EXIT + ENDDO + IF (IND_FOUND) EXIT + ENDDO + IF (.NOT.IND_FOUND) CYCLE ICELL_DO -! refine each triangle of the icosahedron recursively until the -! refined triangle sides are the same size as the grid mesh + ! Tag the coarse ghost-cell in NM that contains the blocked fine cell. + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF (ICC > 0) THEN + DO JCC = 1, M%CUT_CELL(ICC)%NCELL + IF (M%CUT_CELL(ICC)%NOADVANCE(JCC) == NOT_BLOCKED) & + M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCK_TAG + ENDDO + ENDIF -DO IFACE = 1, 20 ! can't use N_FACES since N_FACES is altered by each call to REFINE_FACE - CALL REFINE_FACE(N_LEVELS,IFACE,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) -ENDDO -END SUBROUTINE INIT_SPHERE -! ---------------------------- COMPUTE_TEXTURES ---------------------------------------- + ELSE + ! ===================================================== + ! Same refinement level (or refinement handled by EXT_WALL_LOOP) - use centroid matching + ! ===================================================== + IND_FOUND = .FALSE. + DO I=ILO_CELL-1,IHI_CELL+1 + IF (ABS(XCO-XCELL(I))0) M%CUT_CELL(ICC)%NOADVANCE(M2%JBT_CC_BLOCKED(1,ICELL)) = BLOCK_TAG -INTEGER :: IFACE -REAL(EB) :: EPS_TEXTURE -REAL(EB), POINTER, DIMENSION(:) :: TFACE, VERTPTR -INTEGER, POINTER, DIMENSION(:) :: FACEPTR + ENDIF + ENDDO ICELL_DO + ENDDO NEIGHBORING_MESHES_DO + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +ENDDO MESH_LOOP -EPS_TEXTURE=0.25_EB -IFACE_LOOP: DO IFACE=0, N_FACES-1 +END SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS - FACEPTR=>SPHERE_FACES(3*IFACE+1:3*IFACE+3) - TFACE=>SPHERE_TFACES(6*IFACE+1:6*IFACE+6) - VERTPTR=>SPHERE_VERTS(3*FACEPTR(1)-2:3*FACEPTR(1)) - CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(1:2)) +SUBROUTINE DEFINE_XYZFACE_CELL(ALLOC_FLG) - VERTPTR=>SPHERE_VERTS(3*FACEPTR(2)-2:3*FACEPTR(2)) - CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(3:4)) +LOGICAL, INTENT(IN) :: ALLOC_FLG - VERTPTR=>SPHERE_VERTS(3*FACEPTR(3)-2:3*FACEPTR(3)) - CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(5:6)) +IF (ALLOC_FLG) THEN - ! adjust texture coordinates when a triangle crosses the "prime meridian" + ! X direction bounds: + ILO_FACE = 0 ! Low mesh boundary face index. + IHI_FACE = M%IBAR ! High mesh boundary face index. + ILO_CELL = ILO_FACE + 1 ! First internal cell index. See notes. + IHI_CELL = IHI_FACE ! Last internal cell index. + ISTR = ILO_FACE - NGUARD ! Allocation start x arrays. + IEND = IHI_FACE + NGUARD ! Allocation end x arrays. - IF (TFACE(1)>1.0_EB-EPS_TEXTURE .AND. TFACE(3)1.0_EB-EPS_TEXTURE .AND. TFACE(5)1.0_EB-EPS_TEXTURE .AND. TFACE(1)1.0_EB-EPS_TEXTURE .AND. TFACE(5)1.0_EB-EPS_TEXTURE .AND. TFACE(1)1.0_EB-EPS_TEXTURE .AND. TFACE(3) MESHES(NM) -IJ = 4 -DO I = 2, NLAT-1 - DO J = 1, NLONG - SPHERE_VERTS(IJ:IJ+2) = (/COSLONG(J)*COSLAT(I),SINLONG(J)*COSLAT(I),SINLAT(I)/) - IJ = IJ + 3 - ENDDO -ENDDO + ! Set all fine side cut-cells in cells next to external boundaries which have SOLID coarse mesh faces + ! to CC%NOADVANCE(J)=BLOCKED_REFI_INTER and block them. + EXT_WALL_LOOP_1 : DO IW=1,M%N_EXTERNAL_WALL_CELLS + WC=>WALL(IW) + EWC=>EXTERNAL_WALL(IW) + BC =>BOUNDARY_COORD(WC%BC_INDEX) + IIG = BC%IIG;JJG = BC%JJG;KKG = BC%KKG; + II = BC%II; JJ = BC%JJ; KK = BC%KK; IOR = BC%IOR; X1AXIS=ABS(IOR) + NOM = EWC%NOM; IF(NOM<1 .OR. NOM==NM) CYCLE EXT_WALL_LOOP_1 + M2 => MESHES(NOM) + IIF=II; JJF=JJ; KKF=KK + SELECT CASE(IOR) + CASE(-IAXIS); IIF=IIF-1; + CASE(-JAXIS); JJF=JJF-1; + CASE(-KAXIS); KKF=KKF-1; + END SELECT + IF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)==1) THEN -! south pole + ! Find if omesh cells under both IIG,JJG,KKG, and II,JJ,KK cells + ! are of type CC_CUTCFE and test if these small size cells have centroids within the SOLID. + IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN + IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN + SELECT CASE(IOR) + CASE( IAXIS); IIOG=IIO+1 + CASE(-IAXIS); IIOG=IIO-1 + CASE( JAXIS); JJOG=JJO+1 + CASE(-JAXIS); JJOG=JJO-1 + CASE( KAXIS); KKOG=KKO+1 + CASE(-KAXIS); KKOG=KKO-1 + END SELECT + + ! Test for cut/reg-cells in II,JJ,KK, respect to IIO,JJO,KKO, AND IIG,JJG,KKG respect to IIOG,JJOG,KKOG: + DO DUM=1,2 + IF(DUM==1) THEN; II1 = II; JJ1 = JJ; KK1 = KK; IIO1= IIO; JJO1= JJO; KKO1= KKO + ELSE; II1 = IIG; JJ1 = JJG; KK1 = KKG; IIO1=IIOG; JJO1=JJOG; KKO1=KKOG + ENDIF + CALL TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL=.TRUE.) + ENDDO -SPHERE_VERTS(IJ:IJ+2) = (/0.0_EB,0.0_EB,-1.0_EB/) + ! Test for cut/reg-cells in corner respect to OMESH undelying cell if needed: + IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN + IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(KKG>1 .AND. KKG1 .AND. IIG1 .AND. JJG1) THEN -! faces connected to north pole -IJ=1 -DO ILONG = 1, NLONG - I11 = ILONG+1 - I12 = ILONG+2 - I22 = 1 - IF (ILONG==NLONG)I12=2 - SPHERE_FACES(IJ:IJ+2) = (/I22, I11,I12/) - IJ = IJ + 3 -ENDDO + ! If needed, block ghost cells of the other mesh which has finer cells. + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + IIOG=IIO; JJOG=JJO; KKOG=KKO; II=BC%II; JJ=BC%JJ; KK=BC%KK; IIG=BC%IIG; JJG=BC%JJG; KKG=BC%KKG + SELECT CASE(IOR) + CASE( IAXIS); IIOG=IIO+1 + CASE(-IAXIS); IIOG=IIO-1 + CASE( JAXIS); JJOG=JJO+1 + CASE(-JAXIS); JJOG=JJO-1 + CASE( KAXIS); KKOG=KKO+1 + CASE(-KAXIS); KKOG=KKO-1 + END SELECT + DO DUM=1,2 + IF(DUM==1) THEN; II1 = II; JJ1 = JJ; KK1 = KK; IIO1= IIO; JJO1= JJO; KKO1= KKO + ELSE; II1 = IIG; JJ1 = JJG; KK1 = KKG; IIO1=IIOG; JJO1=JJOG; KKO1=KKOG + ENDIF + CALL TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL=.FALSE.) + ENDDO -DO ILAT = 2, NLAT - 2 - DO ILONG = 1, NLONG + ! Test for OMESH cut/reg-cells in corner respect to this mesh undelying cell if needed: + IIO2=IIO; JJO2=JJO; KKO2=KKO + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(KKOG>1 .AND. KKOG1 .AND. IIOG1 .AND. JJOG MESHES(NM) -DO ILONG = 1, NLONG - I11 = ILONG+1 + NLONG*(NLAT-3) - I12 = I11 + 1 - I22 = NLONG*(NLAT-2)+2 - IF (ILONG==NLONG) I12=2+NLONG*(NLAT-3) - SPHERE_FACES(IJ:IJ+2) = (/I11,I22,I12/) - IJ = IJ + 3 -ENDDO -END SUBROUTINE INIT_SPHERE2 + ! Set all fine side cut-cells in cells next to external boundaries which have SOLID coarse mesh faces + ! to CC%NOADVANCE(J)=BLOCKED_REFI_INTER and block them. + EXT_WALL_LOOP : DO IW=1,M%N_EXTERNAL_WALL_CELLS + WC=>WALL(IW); IF (WC%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY) CYCLE EXT_WALL_LOOP + EWC=>EXTERNAL_WALL(IW) + BC =>BOUNDARY_COORD(WC%BC_INDEX) + II = BC%II; JJ = BC%JJ; KK = BC%KK; IOR = BC%IOR; X1AXIS=ABS(IOR) + NOM = EWC%NOM + M2 => MESHES(NOM) + IIF=II; JJF=JJ; KKF=KK + SELECT CASE(IOR) + CASE(-IAXIS); IIF=IIF-1; + CASE(-JAXIS); JJF=JJF-1; + CASE(-KAXIS); KKF=KKF-1; + END SELECT + IF (EWC%AREA_RATIO<0.9_EB) THEN -! ---------------------------- REFINE_FACE ---------------------------------------- + ! Check if other mesh boundary face set to SOLID and current mesh face set to .NOT.SOLID: + IIOF=EWC%IIO_MIN; JJOF=EWC%JJO_MIN; KKOF=EWC%KKO_MIN; LOHIF=HIGH_IND + SELECT CASE(IOR) + CASE(-IAXIS); IIOF=IIOF-1; LOHIF=LOW_IND + CASE(-JAXIS); JJOF=JJOF-1; LOHIF=LOW_IND + CASE(-KAXIS); KKOF=KKOF-1; LOHIF=LOW_IND + END SELECT + IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) CYCLE EXT_WALL_LOOP ! No need to do anything. + IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_SOLID) THEN ! Coarse side face is solid. + ! Set II,JJ,KK fine cells next to this EWC for blocking. + IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) THEN + ! Insert cut-cell in this location, set to Block. + CT = 6; + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II)*M%DY(JJ)*M%DZ(KK) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II),M%YC(JJ),M%ZC(KK) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = BLOCKED_REFI_INTER + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO AX=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND + ICFC=M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_IDCF,AX); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF(M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_FGSC,AX) == & + CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO + ! Insert cut_cell: + CALL INSERT_CUT_CELL(NM,II,JJ,KK,ICC); M => MESHES(NM) + CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M%CUT_CELL(ICC)%NCELL = NCELL + M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) + ELSEIF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_CUTCFE) THEN + ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. + ICC=M%CCVAR(II,JJ,KK,CC_IDCC); CC=> M%CUT_CELL(ICC) + JCC_LOOP_1 : DO JCC=1,CC%NCELL + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE = CC%CCELEM(IFC,JCC) + IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & + CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN + IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER + CYCLE JCC_LOOP_1 + ENDIF + ENDDO + ENDDO JCC_LOOP_1 + ENDIF + !ELSEIF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_CUTCFE) THEN + ! Coarse side is a cut-face in the boundary. + ENDIF + ELSEIF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)>1) THEN -RECURSIVE SUBROUTINE REFINE_FACE(N_LEVELS,IFACE,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) + IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) THEN ! Coarse side face is solid. + ! If needed, block ghost cells of the other mesh which has finer cells. + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + IIOF=IIO; JJOF=JJO; KKOF=KKO; IOGC=IIO; JOGC=JJO; KOGC=KKO; LOHIF=LOW_IND + SELECT CASE(IOR) + CASE( IAXIS); IOGC=IOGC+1; + CASE(-IAXIS); IIOF= IIO-1; LOHIF=HIGH_IND + CASE( JAXIS); JOGC=JOGC+1; + CASE(-JAXIS); JJOF= JJO-1; LOHIF=HIGH_IND + CASE( KAXIS); KOGC=KOGC+1; + CASE(-KAXIS); KKOF= KKO-1; LOHIF=HIGH_IND + END SELECT + IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_SOLID) CYCLE ! No need to do anything. -INTEGER, INTENT(IN) :: N_LEVELS -INTEGER, INTENT(IN) :: IFACE -INTEGER, INTENT(INOUT) :: N_VERTS, N_FACES -INTEGER, INTENT(IN) :: MAX_VERTS, MAX_FACES -REAL(EB), INTENT(INOUT), TARGET :: SPHERE_VERTS(3*MAX_VERTS) -INTEGER, INTENT(INOUT), TARGET :: SPHERE_FACES(3*MAX_FACES) + ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking. + IF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_GASPHASE) THEN + ! Insert cut-cell in this location, set to Block. + CT = 6; + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M2%DX(IOGC)*M2%DY(JOGC)*M2%DZ(KOGC) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M2%XC(IOGC),M2%YC(JOGC),M2%ZC(KOGC) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = BLOCKED_REFI_INTER + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO AX=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND; ICFC=& + M2%FCVAR(IOGC+ADDI(SIDE,AX),JOGC+ADDJ(SIDE,AX),KOGC+ADDK(SIDE,AX),CC_IDCF,AX); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF( & + M2%FCVAR(IOGC+ADDI(SIDE,AX),JOGC+ADDJ(SIDE,AX),KOGC+ADDK(SIDE,AX),CC_FGSC,AX)& + == CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO + ! Insert cut_cell: + CALL INSERT_CUT_CELL(NOM,IOGC,JOGC,KOGC,ICC); M2 => MESHES(NOM) + CALL NEW_CELL_ALLOC(NOM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M2%CUT_CELL(ICC)%NCELL = NCELL + M2%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M2%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M2%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M2%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M2%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M2%CUT_CELL(ICC)%NOADVANCE) + ELSEIF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_CUTCFE) THEN + ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. + ICC=M2%CCVAR(IOGC,JOGC,KOGC,CC_IDCC); CC=> M2%CUT_CELL(ICC) + JCC_LOOP_3 : DO JCC=1,CC%NCELL + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE = CC%CCELEM(IFC,JCC) + IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & + CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN + IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER + CYCLE JCC_LOOP_3 + ENDIF + ENDDO + ENDDO JCC_LOOP_3 + ENDIF + ENDDO + ENDDO + ENDDO + !ELSEIF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_CUTCFE) THEN + ! Coarse side is a cut-face in the boundary. + ENDIF + ENDIF + ENDDO EXT_WALL_LOOP + ENDDO MAIN_MESH_LOOP_2 -INTEGER, POINTER, DIMENSION(:) :: FACE1, FACE2, FACE3, FACE4 -REAL(EB), POINTER, DIMENSION(:) :: V1, V2, V3 -REAL(EB), POINTER, DIMENSION(:) :: V12, V13, V23 -INTEGER :: N1, N2, N3, N4 +ENDIF +RETURN +END SUBROUTINE TAG_CC_BLOCKING_REFINEMENT -IF (N_LEVELS==0 .OR. N_FACES+3>MAX_FACES .OR. N_VERTS+3>MAX_VERTS) RETURN ! prevent memory overwrites +SUBROUTINE TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL) -FACE1(1:3)=>SPHERE_FACES(3*IFACE-2:3*IFACE) ! original face and 1st new face -FACE2(1:3)=>SPHERE_FACES(3*N_FACES+1:3*N_FACES+3) ! 2nd new face -FACE3(1:3)=>SPHERE_FACES(3*N_FACES+4:3*N_FACES+6) ! 3rd new face -FACE4(1:3)=>SPHERE_FACES(3*N_FACES+7:3*N_FACES+9) ! 4th new face +INTEGER, INTENT(IN) :: NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1 +LOGICAL, INTENT(IN) :: FINE_CELL +TYPE(MESH_TYPE), POINTER :: M,M2 +M =>MESHES( NM) +M2=>MESHES(NOM) -V1(1:3)=>SPHERE_VERTS(3*FACE1(1)-2:3*FACE1(1)) ! FACE1(1) -V2(1:3)=>SPHERE_VERTS(3*FACE1(2)-2:3*FACE1(2)) ! FACE1(2) -V3(1:3)=>SPHERE_VERTS(3*FACE1(3)-2:3*FACE1(3)) ! FACE1(3) +IF (FINE_CELL) THEN -V12(1:3)=>SPHERE_VERTS(3*N_VERTS+1:3*N_VERTS+3) -V13(1:3)=>SPHERE_VERTS(3*N_VERTS+4:3*N_VERTS+6) -V23(1:3)=>SPHERE_VERTS(3*N_VERTS+7:3*N_VERTS+9) + ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC); ICC = 0 + IF ( ICC2 > 0 .OR. M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN ! There are cut-cells in omesh cartesian cell. + IF(M%CCVAR(II1,JJ1,KK1,CC_CGSC)==CC_GASPHASE) THEN + ! Insert cut-cell is this location: + CT = 6; + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II1)*M%DY(JJ1)*M%DZ(KK1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II1),M%YC(JJ1),M%ZC(KK1) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED + IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) NOADVANCE(1) = BLOCKED_REFI_INTER + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO AX=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND + ICFC=M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_IDCF,AX); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF(M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_FGSC,AX) == & + CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO + ! Insert cut_cell: + CALL INSERT_CUT_CELL(NM,II1,JJ1,KK1,ICC); M => MESHES(NM) + CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M%CUT_CELL(ICC)%NCELL = NCELL + M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) + ELSEIF(M%CCVAR(II1,JJ1,KK1,CC_IDCC)>0) THEN + ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC) + ENDIF + ! Here Test if cut-cells in II,KK,KK are blocked or not in IIO,JJO,KKO: + IF(ICC>0) THEN + IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN + WHERE(M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL)==NOT_BLOCKED) & + M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL) = BLOCKED_REFI_INTER + ELSE; CALL TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) + ENDIF + ENDIF + ENDIF -V12 = (V1+V2)/2.0_EB -V13 = (V1+V3)/2.0_EB -V23 = (V2+V3)/2.0_EB -V12 = V12/NORM2(V12) ! N_VERTS + 1 -V13 = V13/NORM2(V13) ! N_VERTS + 2 -V23 = V23/NORM2(V23) ! N_VERTS + 3 +ELSE -! split triangle 123 into 4 triangles + ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC); ICC2 = 0 + IF(ICC>0) THEN + ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking. + IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_GASPHASE) THEN + ! Insert cut-cell in this location, set to Block. + CT = 6; + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M2%DX(IIO1)*M2%DY(JJO1)*M2%DZ(KKO1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M2%XC(IIO1),M2%YC(JJO1),M2%ZC(KKO1) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO AX=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND; ICFC=& + M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_IDCF,AX); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF( & + M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_FGSC,AX)& + == CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO + ! Insert cut_cell: + CALL INSERT_CUT_CELL(NOM,IIO1,JJO1,KKO1,ICC2); M2 => MESHES(NOM) + CALL NEW_CELL_ALLOC(NOM,ICC2,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M2%CUT_CELL(ICC2)%NCELL = NCELL + M2%CUT_CELL(ICC2)%NFACE_CELL = NFACE_CELL + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M2%CUT_CELL(ICC2)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M2%CUT_CELL(ICC2)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M2%CUT_CELL(ICC2)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M2%CUT_CELL(ICC2)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M2%CUT_CELL(ICC2)%NOADVANCE) + ELSEIF(M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC)>0) THEN + ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC) + ENDIF + ! Here Test if cut-cells in IIO,JJO,KKO are blocked or not in II,JJ,KK: + IF(ICC2>0) CALL TEST_CC_FOR_BLOCKING(NOM,ICC2,NM,II1,JJ1,KK1,ICC) + ENDIF -! 1 -! /F1\ . -! 12----13 -! /F2\F3/F4\ i. -! 2 --- 23----3 +ENDIF -FACE2(1:3) = (/N_VERTS+1,FACE1(2),N_VERTS+3/) -FACE3(1:3) = (/N_VERTS+1,N_VERTS+3,N_VERTS+2/) -FACE4(1:3) = (/N_VERTS+2,N_VERTS+3,FACE1(3)/) -FACE1(1:3) = (/ FACE1(1),N_VERTS+1,N_VERTS+2/) +END SUBROUTINE TAG_BLOCK_CELL -N1 = IFACE -N2 = N_FACES+1 -N3 = N_FACES+2 -N4 = N_FACES+3 +SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) -N_FACES = N_FACES + 3 -N_VERTS = N_VERTS + 3 -IF (N_LEVELS==1) RETURN ! stop recursion +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -CALL REFINE_FACE(N_LEVELS-1,N1,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) -CALL REFINE_FACE(N_LEVELS-1,N2,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) -CALL REFINE_FACE(N_LEVELS-1,N3,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) -CALL REFINE_FACE(N_LEVELS-1,N4,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +INTEGER, INTENT(IN) :: NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2 -END SUBROUTINE REFINE_FACE +INTEGER :: JCC,FC_FOUND,FC_TYPE,INBFC,INBFC_LOC,VERT_CUTFACE,NVERT,X1AXIS,X2AXIS,X3AXIS,NCROSS,DIRRAY,IFC1,JFC1,& + NVERT2,VERT_CUTFACE2,IV,IFCC,IFACE2,IFC2,JFC2 +TYPE(MESH_TYPE), POINTER :: M,M2 +TYPE(CC_CUTCELL_TYPE), POINTER :: CC,CC2 +TYPE(CC_CUTFACE_TYPE), POINTER :: CF2 +INTEGER, PARAMETER :: EAST=1,WEST=2,FRONT=3,BACK=4,SOUTH=5,NORTH=6 +INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM,CFELEM2 +REAL(EB),ALLOCATABLE, DIMENSION(:,:):: XYZVERTIJK,XYZVERTSTN +REAL(EB):: XYZCEN(MAX_DIM),NVEC(MAX_DIM),P0(MAX_DIM),A,B,C,D,XYZ_P(MAX_DIM),PTCEN(IAXIS:JAXIS),X1F,XC2(MAX_DIM),XC3(MAX_DIM),& + XLO,XHI,YLO,YHI,ZLO,ZHI,XLO2,XHI2,YLO2,YHI2,ZLO2,ZHI2,CFCEN(MAX_DIM),XYZC(MAX_DIM,1),N(MAX_DIM,1),S(MAX_DIM,1),& + T(MAX_DIM,1),TBN(MAX_DIM,MAX_DIM),XYZCSTN(MAX_DIM,1),NN(MAX_DIM,1),XN_CEN,XN_INT,XYZC2(IAXIS:KAXIS,1) +REAL(EB), PARAMETER :: SCALE_FCT=1.E-4_EB +LOGICAL :: IN_CFACE,BLOCK_CELL,FGPOINT +! INTEGER :: LU_CCELL +! CHARACTER(50) :: FILENAME -! ---------------------------- COMPUTE_TEXTURE ---------------------------------------- +M =>MESHES( NM) +M2=>MESHES(NOM) -SUBROUTINE COMPUTE_TEXTURE(XYZ,TEXT_COORDS) -REAL(EB), INTENT(IN), DIMENSION(3) :: XYZ -REAL(EB), INTENT(OUT), DIMENSION(2) :: TEXT_COORDS -REAL(EB), DIMENSION(2) :: ANGLES -REAL(EB) :: NORM2_XYZ, Z_ANGLE +INBFC=M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCF); IF(INBFC<1) RETURN ! No CC_INBOUNDARY faces in this cartesian cell. -NORM2_XYZ = NORM2(XYZ) -IF (NORM2_XYZ < TWENTY_EPSILON_EB) THEN - Z_ANGLE = 0.0_EB -ELSE - Z_ANGLE = ASIN(XYZ(3)/NORM2_XYZ) +CC =>M%CUT_CELL( ICC) +CC2=>M2%CUT_CELL(ICC2) +CF2=>M2%CUT_FACE(INBFC) +VERT_CUTFACE = SIZE(CF2%CFELEM, DIM=1); ALLOCATE(CFELEM(1:VERT_CUTFACE)) +NVERT = SIZE(CF2%XYZVERT,DIM=2) +! For each cut-cell in CC, test if its centroid Xc is in the SOLID region of CC2: +! We do this by finding a direction to a Cartesian face type CC_GASPHASE or CC_SOLID and intersection point XE, +FC_FOUND=0; FC_TYPE=CC_UNDEFINED; DIRRAY=CC_UNDEFINED +! Then counting INBOUNDARY cut-face intersections from XE point to Xc. +SELECT CASE(M2%FCVAR(IIO1-1,JJO1,KKO1,CC_FGSC,IAXIS)) +CASE(CC_GASPHASE) +FC_FOUND=WEST; FC_TYPE =CC_GASPHASE; DIRRAY=IAXIS +IF(IIO1==0) THEN; X1F=M2%X(IIO1)-M2%DX(IIO1); ELSE; X1F=M2%X(IIO1-1); ENDIF +CASE(CC_SOLID ) +FC_FOUND=WEST; FC_TYPE =CC_SOLID; DIRRAY=IAXIS +IF(IIO1==0) THEN; X1F=M2%X(IIO1)-M2%DX(IIO1); ELSE; X1F=M2%X(IIO1-1); ENDIF +END SELECT +IF(FC_FOUND<1) THEN + SELECT CASE(M2%FCVAR(IIO1 ,JJO1,KKO1,CC_FGSC,IAXIS)) + CASE(CC_GASPHASE) + FC_FOUND=EAST; FC_TYPE =CC_GASPHASE; DIRRAY=-IAXIS + IF(IIO1==M2%IBP1) THEN; X1F=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; X1F=M2%X(IIO1); ENDIF + CASE(CC_SOLID ) + FC_FOUND=EAST; FC_TYPE =CC_SOLID; DIRRAY=-IAXIS + IF(IIO1==M2%IBP1) THEN; X1F=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; X1F=M2%X(IIO1); ENDIF + END SELECT +ENDIF +IF(FC_FOUND<1) THEN + SELECT CASE(M2%FCVAR(IIO1,JJO1-1,KKO1,CC_FGSC,JAXIS)) + CASE(CC_GASPHASE) + FC_FOUND=FRONT; FC_TYPE =CC_GASPHASE; DIRRAY=JAXIS + IF(JJO1==0) THEN; X1F=M2%Y(JJO1)-M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1-1); ENDIF + CASE(CC_SOLID ) + FC_FOUND=FRONT; FC_TYPE =CC_SOLID; DIRRAY=JAXIS + IF(JJO1==0) THEN; X1F=M2%Y(JJO1)-M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1-1); ENDIF + END SELECT +ENDIF +IF(FC_FOUND<1) THEN + SELECT CASE(M2%FCVAR(IIO1,JJO1 ,KKO1,CC_FGSC,JAXIS)) + CASE(CC_GASPHASE) + FC_FOUND=BACK; FC_TYPE =CC_GASPHASE; DIRRAY=-JAXIS + IF(JJO1==M2%JBP1) THEN; X1F=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1); ENDIF + CASE(CC_SOLID ) + FC_FOUND=BACK; FC_TYPE =CC_SOLID; DIRRAY=-JAXIS + IF(JJO1==M2%JBP1) THEN; X1F=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1); ENDIF + END SELECT +ENDIF +IF(FC_FOUND<1) THEN + SELECT CASE(M2%FCVAR(IIO1,JJO1,KKO1-1,CC_FGSC,KAXIS)) + CASE(CC_GASPHASE) + FC_FOUND=SOUTH; FC_TYPE =CC_GASPHASE; DIRRAY=KAXIS + IF(KKO1==0) THEN; X1F=M2%Z(KKO1)-M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1-1); ENDIF + CASE(CC_SOLID ) + FC_FOUND=SOUTH; FC_TYPE =CC_SOLID; DIRRAY=KAXIS + IF(KKO1==0) THEN; X1F=M2%Z(KKO1)-M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1-1); ENDIF + END SELECT +ENDIF +IF(FC_FOUND<1) THEN + SELECT CASE(M2%FCVAR(IIO1,JJO1,KKO1 ,CC_FGSC,KAXIS)) + CASE(CC_GASPHASE) + FC_FOUND=NORTH; FC_TYPE =CC_GASPHASE; DIRRAY=-KAXIS + IF(KKO1==M2%KBP1) THEN; X1F=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1); ENDIF + CASE(CC_SOLID ) + FC_FOUND=NORTH; FC_TYPE =CC_SOLID; DIRRAY=-KAXIS + IF(KKO1==M2%KBP1) THEN; X1F=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1); ENDIF + END SELECT ENDIF -ANGLES = (/ATAN2(XYZ(2),XYZ(1)),Z_ANGLE/) - -!convert back to texture coordinates -TEXT_COORDS = (/ 0.5_EB + 0.5_EB*ANGLES(1)/PI,0.5_EB + ANGLES(2)/PI /) -END SUBROUTINE COMPUTE_TEXTURE - -! ---------------------------- GET_GEOM_ID ---------------------------------------- - -INTEGER FUNCTION GET_GEOM_ID(ID,N_LAST) - -! return the index of the geometry array with label ID -CHARACTER(30), INTENT(IN) :: ID -INTEGER, INTENT(IN) :: N_LAST +IF(FC_FOUND<1) RETURN ! Here or before we can switch to a point in polygon test whithin JCC_LOOP. -INTEGER :: N -TYPE(GEOMETRY_TYPE), POINTER :: G +SELECT CASE(ABS(DIRRAY)) +CASE(IAXIS); X1AXIS = IAXIS; X2AXIS = JAXIS; X3AXIS = KAXIS +CASE(JAXIS); X1AXIS = JAXIS; X2AXIS = KAXIS; X3AXIS = IAXIS +CASE(KAXIS); X1AXIS = KAXIS; X2AXIS = IAXIS; X3AXIS = JAXIS +END SELECT -GET_GEOM_ID = 0 -DO N=1,N_LAST - G=>GEOMETRY(N) - IF (TRIM(G%ID)==TRIM(ID)) THEN - GET_GEOM_ID = N - RETURN - ENDIF -ENDDO -END FUNCTION GET_GEOM_ID +! IF(NM==1 .AND. ICC<30) THEN +! LU_CCELL = 797 +! WRITE(FILENAME,'(A,I6.6,A)') 'FACESBLK_',ICC,'.txt' +! OPEN(UNIT=LU_CCELL,FILE=FILENAME,STATUS='UNKNOWN') +! WRITE(LU_CCELL,*) NVERT,VERT_CUTFACE,X1AXIS,X2AXIS,X3AXIS,CF2%NFACE +! ENDIF -! ---------------------------- GEOMCLIPS ---------------------------------------- +I=CC%IJK(IAXIS); J=CC%IJK(JAXIS); K=CC%IJK(KAXIS) +IF(I== 0) THEN; XLO=M%X( I)-M%DX( I); ELSE; XLO=M%X(I-1); ENDIF +IF(I==M%IBP1) THEN; XHI=M%X(I-1)+M%DX( I); ELSE; XHI=M%X( I); ENDIF +IF(J== 0) THEN; YLO=M%Y( J)-M%DY( J); ELSE; YLO=M%Y(J-1); ENDIF +IF(J==M%JBP1) THEN; YHI=M%Y(J-1)+M%DY( J); ELSE; YHI=M%Y( J); ENDIF +IF(K== 0) THEN; ZLO=M%Z( K)-M%DZ( K); ELSE; ZLO=M%Z(K-1); ENDIF +IF(K==M%KBP1) THEN; ZHI=M%Z(K-1)+M%DZ( K); ELSE; ZHI=M%Z( K); ENDIF -SUBROUTINE GEOMCLIPS -USE BOXTETRA_ROUTINES, ONLY : GEOMCLIP -REAL(EB) :: XB(6) -INTEGER :: I -TYPE(GEOMETRY_TYPE), POINTER :: G +IF(IIO1== 0) THEN; XLO2=M2%X( IIO1)-M2%DX(IIO1); ELSE; XLO2=M2%X(IIO1-1); ENDIF +IF(IIO1==M2%IBP1) THEN; XHI2=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; XHI2=M2%X( IIO1); ENDIF +IF(JJO1== 0) THEN; YLO2=M2%Y( JJO1)-M2%DY(JJO1); ELSE; YLO2=M2%Y(JJO1-1); ENDIF +IF(JJO1==M2%JBP1) THEN; YHI2=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; YHI2=M2%Y( JJO1); ENDIF +IF(KKO1== 0) THEN; ZLO2=M2%Z( KKO1)-M2%DZ(KKO1); ELSE; ZLO2=M2%Z(KKO1-1); ENDIF +IF(KKO1==M2%KBP1) THEN; ZHI2=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; ZHI2=M2%Z( KKO1); ENDIF - ! clip geometries to mesh +IFC1 = M%CCVAR(I,J,K,CC_IDCF) +IF(IFC1>0) THEN + NVERT2 = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) + ALLOCATE(XYZVERTIJK(MAX_DIM,NVERT2)); XYZVERTIJK = M%CUT_FACE(IFC1)%XYZVERT + ALLOCATE(XYZVERTSTN(MAX_DIM,NVERT2)) + VERT_CUTFACE2 = SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1); ALLOCATE(CFELEM2(VERT_CUTFACE2)) +ENDIF +JCC_LOOP : DO JCC=1,CC%NCELL + ! Get point within gas region of cut-cell: + FGPOINT=.FALSE. + IFC_LOOP : DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + IFC1 = CC%FACE_LIST(4,IFACE) + JFC1 = CC%FACE_LIST(5,IFACE) + IF (CC%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE + CFCEN(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) + CFELEM(1:3) = M%CUT_FACE(IFC1)%CFELEM(1:3,JFC1) + XC2(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,CFELEM(2))-CFCEN(IAXIS:KAXIS) + XC3(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,CFELEM(3))-CFCEN(IAXIS:KAXIS) + CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) + IF (NORM2(NVEC)GEOMETRY(I) - CALL GEOMCLIP(G%VERTS, G%N_VERTS, G%FACES, G%N_FACES, XB) -END DO -END SUBROUTINE GEOMCLIPS + ! Define XYZCEN point, move from CFACE centroid a small distance in the NVEC direction: + XN_CEN = SCALE_FCT*NORM2(CFCEN(IAXIS:KAXIS)-CC%XYZCEN(IAXIS:KAXIS,JCC)) + XYZC(IAXIS:KAXIS,1) = CFCEN(IAXIS:KAXIS) + XN_CEN*NVEC(IAXIS:KAXIS) -! ---------------------------- PROCESS_GEOM ---------------------------------------- + ! Check point is inside the cartesian cell: + IF(XYZC(IAXIS,1) < XLO+GEOMEPS .OR. XYZC(IAXIS,1) > XHI-GEOMEPS) CYCLE + IF(XYZC(JAXIS,1) < YLO+GEOMEPS .OR. XYZC(JAXIS,1) > YHI-GEOMEPS) CYCLE + IF(XYZC(KAXIS,1) < ZLO+GEOMEPS .OR. XYZC(KAXIS,1) > ZHI-GEOMEPS) CYCLE + IF(XYZC(IAXIS,1) < XLO2+GEOMEPS .OR. XYZC(IAXIS,1) > XHI2-GEOMEPS) CYCLE + IF(XYZC(JAXIS,1) < YLO2+GEOMEPS .OR. XYZC(JAXIS,1) > YHI2-GEOMEPS) CYCLE + IF(XYZC(KAXIS,1) < ZLO2+GEOMEPS .OR. XYZC(KAXIS,1) > ZHI2-GEOMEPS) CYCLE -SUBROUTINE PROCESS_GEOM(IS_DYNAMIC,TIME, N_VERTS, N_FACES, N_VOLUS) + ! Build S,T,N transformation matrix: + N(:,1) = -NVEC; S(:,1) = XC2/NORM2(XC2); CALL CROSS_PRODUCT(T(:,1),N(:,1),S(:,1)) + TBN(1,:)= S(:,1); TBN(2,:)= T(:,1); TBN(3,:)= N(:,1) -USE GEOMETRY_FUNCTIONS, ONLY: TRANSFORM_COORDINATES + ! Check that cut-face centroid is within its polygon. + XYZC2(IAXIS:KAXIS,1) = CFCEN(IAXIS:KAXIS); XYZCSTN = MATMUL(TBN,XYZC2) + DO IV = 1,NVERT2; XYZVERTSTN(:,IV) = MATMUL(TBN,XYZVERTIJK(:,IV))-XYZCSTN(:,1); ENDDO + CFELEM2(1:VERT_CUTFACE2) =M%CUT_FACE(IFC1)%CFELEM(1:VERT_CUTFACE2,JFC1) + PTCEN(IAXIS:JAXIS) = 0._EB; CALL POINT_IN_POLYGON(PTCEN,VERT_CUTFACE2,CFELEM2,NVERT2,1,2,XYZVERTSTN,IN_CFACE) + IF(.NOT.IN_CFACE) CYCLE -! transform (scale, rotate and translate) vectors found on each &GEOM line + ! Run again over all CFACES of the JCC cut-cell (except IFC) and check for other intersections within their polygons: + ! 1. First of all compute XYZCENSTN, allocate XYZVERTSTN and populate it. Compute XYZVERTSTN-XYZCENSTN. + XYZCSTN = MATMUL(TBN,XYZC) + DO IV = 1,NVERT2 + XYZVERTSTN(:,IV) = MATMUL(TBN,XYZVERTIJK(:,IV))-XYZCSTN(:,1) + ENDDO - LOGICAL, INTENT(IN) :: IS_DYNAMIC - REAL(EB), INTENT(IN) :: TIME - INTEGER, INTENT(OUT) :: N_VERTS, N_FACES, N_VOLUS + ! 2. Run over CFACEs, copy CFELEM and find if intersection point in CFACE + point location: + DO IFCC=1,CC%CCELEM(1,JCC) + IF(IFCC==IFC) CYCLE + IFACE2 = CC%CCELEM(IFCC+1,JCC) + IFC2 = CC%FACE_LIST(4,IFACE2) + JFC2 = CC%FACE_LIST(5,IFACE2) + IF (CC%FACE_LIST(1,IFACE2) /= CC_FTYPE_CFINB) CYCLE - INTEGER :: I, IVERT, IMOVE, MOVE_INDEX, IFACE - TYPE(GEOMETRY_TYPE), POINTER :: G - REAL(EB) :: DELTA_T, VEC(1:3) ! M(3,3) - TYPE(MOVEMENT_TYPE), POINTER :: MV + CFCEN(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZCEN(IAXIS:KAXIS,JFC2) + CFELEM2(1:VERT_CUTFACE2) = M%CUT_FACE(IFC2)%CFELEM(1:VERT_CUTFACE2,JFC2) + XC2(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZVERT(IAXIS:KAXIS,CFELEM2(2))-CFCEN(IAXIS:KAXIS) + XC3(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZVERT(IAXIS:KAXIS,CFELEM2(3))-CFCEN(IAXIS:KAXIS) + CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) + IF (NORM2(NVEC)XN_CEN+GEOMEPS) CYCLE + ! Found an intersection in a face closer to XYZC than original CF centroid, try another point. + CYCLE IFC_LOOP + ENDIF + ENDDO + ! Did not find intersection, XYZC is inside the cut-cell, use as XYZCEN: + FGPOINT=.TRUE. + XYZCEN(IAXIS:KAXIS) = XYZC(IAXIS:KAXIS,1) + EXIT IFC_LOOP + ENDDO IFC_LOOP + ! If point in inside cut-cell not found - fall back to using cut-cell centroid: + IF(.NOT.FGPOINT) XYZCEN(IAXIS:KAXIS) = CC%XYZCEN(IAXIS:KAXIS,JCC) + PTCEN(IAXIS:JAXIS) = XYZCEN( (/ X2AXIS, X3AXIS /) ) - DO I = 1, N_GEOMETRY - G=>GEOMETRY(I) - IF ((IS_DYNAMIC .AND. G%IS_DYNAMIC) .OR. (.NOT.IS_DYNAMIC .AND. .NOT.G%IS_DYNAMIC)) THEN - G%N_VERTS = G%N_VERTS_BASE - G%N_FACES = G%N_FACES_BASE - G%N_VOLUS = G%N_VOLUS_BASE - ENDIF - ENDDO + NCROSS=0; + IF(FC_TYPE==CC_SOLID ) BLOCK_CELL=.TRUE. + IF(FC_TYPE==CC_GASPHASE) BLOCK_CELL=.FALSE. + ! Here do ray-tracing from FC_FOUND to centroid location for this cut cell, use point in poly to note the + ! intersections with CC_INBOUNDARY cut-faces: + ! IF(NM==1 .AND. ICC<30) THEN + ! WRITE(LU_CCELL,*) PTCEN(IAXIS:JAXIS) + ! DO I=1,NVERT + ! WRITE(LU_CCELL,*) CF2%XYZVERT(:,I) + ! ENDDO + ! ENDIF + INBFC_LOC_LOOP : DO INBFC_LOC=1,CF2%NFACE + ! Normal, max normal component, define plane X2AXIS,X3AXIS to do search: + CFELEM(1:VERT_CUTFACE) = CF2%CFELEM(1:VERT_CUTFACE,INBFC_LOC) + XC2(IAXIS:KAXIS) = CF2%XYZVERT(IAXIS:KAXIS,CFELEM(2))-CF2%XYZCEN(IAXIS:KAXIS,INBFC_LOC) + XC3(IAXIS:KAXIS) = CF2%XYZVERT(IAXIS:KAXIS,CFELEM(3))-CF2%XYZCEN(IAXIS:KAXIS,INBFC_LOC) + CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) - DO I = 1, N_GEOMETRY - G=>GEOMETRY(I) - IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE - IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE - MOVE_INDEX = 0 - IF (TRIM(G%MOVE_ID)/='null') THEN - DO IMOVE=1,N_MOVE - IF (TRIM(G%MOVE_ID)==TRIM(MOVEMENT(IMOVE)%ID)) THEN - MOVE_INDEX = MOVEMENT(IMOVE)%INDEX - EXIT - ENDIF - ENDDO - IF (MOVE_INDEX==0) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR(725): &GEOM ',TRIM(G%ID),' MOVE_ID is not recognized' - CALL SHUTDOWN(MESSAGE) ; RETURN - ENDIF - DO IVERT=1,G%N_VERTS - VEC(1:3) = G%VERTS_BASE(3*IVERT-2:3*IVERT) - CALL TRANSFORM_COORDINATES(VEC(1),VEC(2),VEC(3),MOVE_INDEX,1) ! Eventually, time varying motion dealt with here. - G%VERTS(3*IVERT-2:3*IVERT) = VEC(1:3) - ENDDO - ! Swap face connectivities if we have reflections: - MV => MOVEMENT(MOVE_INDEX) - IF (MV%DET < -TWENTY_EPSILON_EB) THEN ! Swap vertices 2 and 3: - DO IFACE=1,G%N_FACES - IVERT = G%FACES(3*(IFACE-1)+2) - G%FACES(3*(IFACE-1)+2) = G%FACES(3*(IFACE-1)+3) - G%FACES(3*(IFACE-1)+3) = IVERT - ENDDO + IF (NORM2(NVEC)X1F +GEOMEPS) CYCLE INBFC_LOC_LOOP + ELSE + IF(XYZ_P(X1AXIS)XYZCEN(X1AXIS)+GEOMEPS) CYCLE INBFC_LOC_LOOP ENDIF - ELSE - DO IVERT=1,G%N_VERTS - G%VERTS(3*IVERT-2:3*IVERT) = G%VERTS_BASE(3*IVERT-2:3*IVERT) - ENDDO + NCROSS = NCROSS + 1 ! Add crossing between face and cut-cell centroid. + BLOCK_CELL=.NOT.BLOCK_CELL ENDIF + ! IF(NM==1 .AND. ICC<30) THEN + ! IF(MY_RANK==0) WRITE(0,*) 'TESTS INBFC_LOC_LOOP',INBFC_LOC,PTCEN(IAXIS:JAXIS),XYZCEN(X1AXIS),XYZ_P(X1AXIS),& + ! NVEC(2),D,IN_CFACE,BLOCK_CELL + ! ENDIF + ENDDO INBFC_LOC_LOOP + ! Here set no ADVANCE if BLOCK_CELL=T: + IF(BLOCK_CELL .AND. CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC) = BLOCKED_REFI_INTER +ENDDO JCC_LOOP - ENDDO - - ! remove this if statement when GEOMCLIPS is ready for use - IF ( I .EQ. 0 ) THEN - CALL GEOMCLIPS - ENDIF - - CALL GEOM2TEXTURE - - N_VERTS = 0 - N_FACES = 0 - N_VOLUS = 0 - DO I = 1, N_GEOMETRY ! count vertices and faces - G=>GEOMETRY(I) - IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE - IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE - N_VERTS = N_VERTS + G%N_VERTS - N_FACES = N_FACES + G%N_FACES - N_VOLUS = N_VOLUS + G%N_VOLUS - ENDDO +! IF(NM==1 .AND. ICC<30) CLOSE(LU_CCELL) -END SUBROUTINE PROCESS_GEOM +DEALLOCATE(CFELEM) +IF(ALLOCATED(XYZVERTIJK)) DEALLOCATE(XYZVERTIJK,XYZVERTSTN,CFELEM2) +RETURN +END SUBROUTINE TEST_CC_FOR_BLOCKING -! ---------------------------- GEOM2TEXTURE ---------------------------------------- +SUBROUTINE GET_CC_FACE_CELL_LIST_INFO(NM,PHASE) -SUBROUTINE GEOM2TEXTURE - INTEGER :: I,J,K,JJ - TYPE(GEOMETRY_TYPE), POINTER :: G - REAL(EB), POINTER, DIMENSION(:) :: XYZ, TFACES - INTEGER, POINTER, DIMENSION(:) :: FACES - INTEGER :: SURF_INDEX - TYPE(SURFACE_TYPE), POINTER :: SF +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: PHASE - DO I = 1, N_GEOMETRY - G=>GEOMETRY(I) - IF (G%TEXTURE_MAPPING/='RECTANGULAR') CYCLE - DO J = 0, G%N_FACES-1 - SURF_INDEX = G%SURFS(1+J) - SF=>SURFACE(SURF_INDEX) - IF (TRIM(SF%TEXTURE_MAP)=='null') CYCLE - FACES(1:3)=>G%FACES(1+3*J:3+3*J) - TFACES(1:6)=>G%TFACES(1+6*J:6+6*J) - DO K = 0, 2 - JJ = FACES(1+K) +! Local Vars: +INTEGER :: ICC,JCC,IFC,IFACE,ICF1,ICF2,JCF,ICE,JCE,IIE,JJE,KKE,IIF,JJF,KKF,X1AXIS,EAXIS,IEDG_LOC,IEDGE +TYPE(MESH_TYPE), POINTER :: M +M=>MESHES(NM) - XYZ(1:3) => G%VERTS(3*JJ-2:3*JJ) - TFACES(1+2*K:2+2*K) = (XYZ(1:2) - G%TEXTURE_ORIGIN(1:2))/G%TEXTURE_SCALE(1:2) - ENDDO +! FACE-CELL incidence: +CUT_CELL_LOOP : DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC => M%CUT_CELL(ICC) + IF(PHASE==2) THEN + IF(CC%IJK(IAXIS)<-1 .OR. CC%IJK(IAXIS)>M%IBAR+2) CYCLE CUT_CELL_LOOP + IF(CC%IJK(JAXIS)<-1 .OR. CC%IJK(JAXIS)>M%JBAR+2) CYCLE CUT_CELL_LOOP + IF(CC%IJK(KAXIS)<-1 .OR. CC%IJK(KAXIS)>M%KBAR+2) CYCLE CUT_CELL_LOOP + ENDIF + DO JCC=1,CC%NCELL + ! Loop faces and test: + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + SELECT CASE(CC%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_CFGAS) ! GASPHASE cut-face: + ICF1 = CC%FACE_LIST(4,IFACE) + ICF2 = CC%FACE_LIST(5,IFACE); CF => M%CUT_FACE(ICF1) + IF (CC%FACE_LIST(2,IFACE) == LOW_IND) THEN ! Cut-face on low side of cut-cell: + CF%CELL_LIST(IAXIS:KAXIS+1,HIGH_IND,ICF2) = & + (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) + ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. + CF%XCENHIGH(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) + ELSE ! HIGH + CF%CELL_LIST(IAXIS:KAXIS+1,LOW_IND,ICF2) = & + (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) + ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. + CF%XCENLOW(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) + ENDIF + CASE(CC_FTYPE_CFINB) ! INBOUNDARY cut-face: + ICF1 = CC%FACE_LIST(4,IFACE) + ICF2 = CC%FACE_LIST(5,IFACE); CF => M%CUT_FACE(ICF1) + ! We add the cut-cell related info in LOW_IND + CF%CELL_LIST(IAXIS:KAXIS+1,LOW_IND,ICF2) = & + (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) + ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. + CF%XCENLOW(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) + END SELECT ENDDO ENDDO -END SUBROUTINE GEOM2TEXTURE - -! ---------------------------- MERGE_GEOMS ---------------------------------------- - -SUBROUTINE MERGE_GEOMS(VERTS,N_VERTS,FACES,TFACES,GEOM_IDS,SURF_IDS,N_FACES,VOLUS,MATL_IDS,N_VOLUS,IS_DYNAMIC) - -! combine vectors and faces found on all &GEOM lines into one set of VECTOR and FACE arrays - -INTEGER, INTENT(IN) :: N_VERTS, N_FACES, N_VOLUS -LOGICAL, INTENT(IN) :: IS_DYNAMIC -REAL(EB), DIMENSION(:), INTENT(OUT) :: VERTS(3*N_VERTS), TFACES(6*N_FACES) -INTEGER, DIMENSION(:), INTENT(OUT) :: FACES(3*N_FACES), VOLUS(4*N_VOLUS), MATL_IDS(N_VOLUS), GEOM_IDS(N_FACES), SURF_IDS(N_FACES) - -INTEGER :: I -TYPE(GEOMETRY_TYPE), POINTER :: G -INTEGER :: IVERT, ITFACE, IFACE, IVOLUS, IMATL, IGEOM, ISURF, OFFSET +ENDDO CUT_CELL_LOOP -IVERT = 0 -ITFACE = 0 -IFACE = 0 -IVOLUS = 0 -IGEOM = 0 -ISURF = 0 -IMATL = 0 -OFFSET = 0 -DO I = 1, N_GEOMETRY - G=>GEOMETRY(I) - IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE - IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE +! EDGE-FACE incidence: +! First Allocate DXX and FACE_LIST for CUT_EDGEs: +DO ICE=1,M%N_CUTEDGE_MESH + CE => M%CUT_EDGE(ICE) + IF(ALLOCATED(CE%DXX)) DEALLOCATE(CE%DXX) + IF(ALLOCATED(CE%FACE_LIST)) DEALLOCATE(CE%FACE_LIST) + IF(ALLOCATED(CE%DUIDXJ)) DEALLOCATE(CE%DUIDXJ) + IF(ALLOCATED(CE%MU_DUIDXJ)) DEALLOCATE(CE%MU_DUIDXJ) + ! DXX(1), DXX(2) + ALLOCATE(CE%DXX(1:2,SIZE(CE%CEELEM,DIM=2))); CE%DXX = 0._EB + ! ! ICF JCF, dir -2 -1 1 2, JCE. + ALLOCATE(CE%FACE_LIST(1:3,-2:2,SIZE(CE%CEELEM,DIM=2))); CE%FACE_LIST = CC_UNDEFINED +ENDDO - IF (G%N_VERTS>0) THEN - VERTS(1+IVERT:3*G%N_VERTS+IVERT) = G%VERTS(1:3*G%N_VERTS) - IVERT = IVERT + 3*G%N_VERTS +CUTFACE_LOOP : DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + CF => M%CUT_FACE(ICF); IF(CF%STATUS/=CC_GASPHASE) CYCLE + IIF= CF%IJK(IAXIS); JJF= CF%IJK(JAXIS); KKF= CF%IJK(KAXIS); X1AXIS= CF%IJK(KAXIS+1) + IF(PHASE==2) THEN + SELECT CASE (X1AXIS) + CASE(IAXIS) + IF(IIF<-2 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP + IF(JJF<-1 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP + IF(KKF<-1 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP + CASE(JAXIS) + IF(IIF<-1 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP + IF(JJF<-2 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP + IF(KKF<-1 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP + CASE(KAXIS) + IF(IIF<-1 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP + IF(JJF<-1 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP + IF(KKF<-2 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP + END SELECT ENDIF - IF (G%N_FACES>0) THEN - FACES(1+IFACE:3*G%N_FACES + IFACE) = G%FACES(1:3*G%N_FACES)+OFFSET - IFACE = IFACE + 3*G%N_FACES - - TFACES(1+ITFACE:6*G%N_FACES + ITFACE) = G%TFACES(1:6*G%N_FACES) - ITFACE = ITFACE + 6*G%N_FACES + DO JCF=1,CF%NFACE + DO IEDG_LOC=2,CF%CEDGES(1,JCF)+1 + IEDGE = CF%CEDGES(IEDG_LOC,JCF) + SELECT CASE(CF%EDGE_LIST(1,IEDGE)) + CASE(CC_ETYPE_RGGAS) ! RCEDGE to be defined in .. + ! LOHI = CF%EDGE_LIST(2,IEDGE) + ! AXIS = CF%EDGE_LIST(3,IEDGE) + ! CC_RCEDGE.. Filled once RCEDGES are built. + CASE(CC_ETYPE_CFGAS) ! Gas cut-edge + ICE = CF%EDGE_LIST(2,IEDGE) + JCE = CF%EDGE_LIST(3,IEDGE) + CE => M%CUT_EDGE(ICE) + IIE = CE%IJK(IAXIS); JJE = CE%IJK(JAXIS); KKE = CE%IJK(KAXIS) + EAXIS= CE%IJK(KAXIS+1) + SELECT CASE(EAXIS) + CASE(IAXIS) ! Edge in x dir. + IF(X1AXIS==KAXIS) THEN ! Face in z dir, +/- y. + CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(YFACE(JJE)-CF%XYZCEN(JAXIS,JCF)) + IF(JJF==JJE) THEN ! Face -1, resp to IEDGE. + CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(JJF==JJE+1) THEN + CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ELSEIF(X1AXIS==JAXIS) THEN ! Face in y dir, +/- z: + CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(ZFACE(KKE)-CF%XYZCEN(KAXIS,JCF)) + IF(KKF==KKE) THEN ! Face -2, resp to IEDGE. + CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(KKF==KKE+1) THEN + CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ENDIF + CASE(JAXIS) ! Edge in y dir. + IF(X1AXIS==IAXIS) THEN ! Face in x dir, +/- z. + CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(ZFACE(KKE)-CF%XYZCEN(KAXIS,JCF)) + IF(KKF==KKE) THEN ! Face -1, resp to IEDGE. + CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(KKF==KKE+1) THEN + CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ELSEIF(X1AXIS==KAXIS) THEN ! Face in z dir, +/- x + CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(XFACE(IIE)-CF%XYZCEN(IAXIS,JCF)) + IF(IIF==IIE) THEN ! Face -2, resp to IEDGE. + CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(IIF==IIE+1) THEN + CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ENDIF + CASE(KAXIS) ! Edge in z dir. + IF(X1AXIS==JAXIS) THEN ! Face in y dir, +/- x. + CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(XFACE(IIE)-CF%XYZCEN(IAXIS,JCF)) + IF(IIF==IIE) THEN ! Face -1, resp to IEDGE. + CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(IIF==IIE+1) THEN + CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ELSEIF(X1AXIS==IAXIS) THEN ! Face in x dir, +/- y. + CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(YFACE(JJE)-CF%XYZCEN(JAXIS,JCF)) + IF(JJF==JJE) THEN ! Face -2, resp to IEDGE. + CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(JJF==JJE+1) THEN + CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ENDIF + END SELECT - GEOM_IDS(1+IGEOM:G%N_FACES+IGEOM) = I - IGEOM = IGEOM + G%N_FACES + CASE(CC_ETYPE_CFINB) ! Inboundary cut-edge (face) - SURF_IDS(1+ISURF:G%N_FACES+ISURF) = G%SURFS(1:G%N_FACES) - ISURF = ISURF + G%N_FACES - ENDIF - IF (G%N_VOLUS>0) THEN - VOLUS(1+IVOLUS:4*G%N_VOLUS + IVOLUS) = G%VOLUS(1:4*G%N_VOLUS)+OFFSET - IVOLUS = IVOLUS + 4*G%N_VOLUS + END SELECT + ENDDO + ENDDO +ENDDO CUTFACE_LOOP - MATL_IDS(1+IMATL:G%N_VOLUS+IMATL) = G%MATLS(1:G%N_VOLUS) - IMATL = IMATL + G%N_VOLUS +! Allocate for gas CUT_EDGEs DUIDXJ, MU_DUIDXJ +DO ICE=1,M%N_CUTEDGE_MESH + CE => M%CUT_EDGE(ICE); IF(CE%STATUS/=CC_GASPHASE) CYCLE + IF(.NOT.ALLOCATED(CE%DUIDXJ)) THEN + ALLOCATE(CE%DUIDXJ( -2:2,1:SIZE(CE%CEELEM,DIM=2))); CE%DUIDXJ = 0._EB + ALLOCATE(CE%MU_DUIDXJ(-2:2,1:SIZE(CE%CEELEM,DIM=2))); CE%MU_DUIDXJ = 0._EB ENDIF - OFFSET = OFFSET + G%N_VERTS + ! Assign DXX to grid size for cut-edges with unassigned deltas: + I=CE%IJK(IAXIS); J=CE%IJK(JAXIS); K=CE%IJK(KAXIS); X1AXIS=CE%IJK(KAXIS+1) + DO JCE=1,CE%NEDGE + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(CE%DXX(1,JCE)M%CUT_FACE(ICF1) + WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE,CF%STATUS + DO ICF2=1,CF%NFACE + WRITE(33,'(I8,3F16.8,F16.8)') ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) + ICC=CF%CELL_LIST(2,LOW_IND,ICF2); JCC=CF%CELL_LIST(3,LOW_IND,ICF2) + WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& + M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) + CC=>M%CUT_CELL(ICC) + IFACE = CC%CCELEM(CF%CELL_LIST(4,LOW_IND,ICF2)+1,JCC) + IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN + WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& + ICF2,CC%FACE_LIST(5,IFACE) + ENDIF -ALLOCATE(VOLUS(MAX(1,4*N_VOLUS)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','VOLUS',IZERO) + IF(CF%STATUS==CC_GASPHASE) THEN + ICC=CF%CELL_LIST(2,HIGH_IND,ICF2); JCC=CF%CELL_LIST(3,HIGH_IND,ICF2) + WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& + M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) + CC=>M%CUT_CELL(ICC) + IFACE = CC%CCELEM(CF%CELL_LIST(4,HIGH_IND,ICF2)+1,JCC) + IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN + WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& + ICF2,CC%FACE_LIST(5,IFACE) + ENDIF -ALLOCATE(MATL_IDS(MAX(1,N_VOLUS)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','MATL_IDS',IZERO) + ENDIF + ENDDO + ENDIF + ENDDO + X1AXIS=0 + IF(M%CCVAR(I,J,K,CC_IDCF)>0)THEN + ICF1=M%CCVAR(I,J,K,CC_IDCF); CF=>M%CUT_FACE(ICF1) + WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE,CF%STATUS + DO ICF2=1,CF%NFACE + WRITE(33,'(I8,3F16.8,F16.8)') ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) + ICC=CF%CELL_LIST(2,LOW_IND,ICF2); JCC=CF%CELL_LIST(3,LOW_IND,ICF2) + WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& + M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) + CC=>M%CUT_CELL(ICC) + IFACE = CC%CCELEM(CF%CELL_LIST(4,LOW_IND,ICF2)+1,JCC) + IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN + WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& + ICF2,CC%FACE_LIST(5,IFACE) + ENDIF + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + CLOSE(33) -IF (N_VERTS_S>0 .AND. (N_FACES_S>0 .OR. N_VOLUS_S>0)) THEN ! merge static geometry - CALL MERGE_GEOMS(VERTS(1:3*N_VERTS_S),N_VERTS_S,& - FACES(1:3*N_FACES_S),TFACES(1:3*N_FACES_S),GEOM_IDS(1:N_FACES_S),SURF_IDS(1:N_FACES_S),N_FACES_S,& - VOLUS(1:3*N_VOLUS_S),MATL_IDS(1:N_VOLUS_S),N_VOLUS_S,.FALSE.) -ENDIF -IF (N_VERTS_D>0 .AND. (N_FACES_D>0 .OR. N_VOLUS_D>0)) THEN ! merge dynamic geometry - CALL MERGE_GEOMS(VERTS(3*N_VERTS_S+1:3*N_VERTS),N_VERTS_D,& - FACES(3*N_FACES_S+1:3*N_FACES),TFACES(3*N_FACES_S+1:3*N_FACES),GEOM_IDS,SURF_IDS(N_FACES_S+1:N_FACES),N_FACES_D,& - VOLUS(3*N_VOLUS_S+1:3*N_VOLUS),MATL_IDS(N_VOLUS_S+1:N_VOLUS),N_VOLUS_D,.TRUE.) + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFACES.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,A,I8,I8,I8,I8)') I,J,K,':',& + M%ECVAR(I,J,K,CC_EGSC,IAXIS),M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) + DO X1AXIS=IAXIS,KAXIS + IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN + ICE=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(ICE) + WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE + DO JCE=1,CE%NEDGE + WRITE(33,'(I8,F12.8,F12.8)') JCE,CE%DXX(1,JCE),CE%DXX(2,JCE) + DO JCF=-2,2 + IF(JCF==0) CYCLE + ! Face JCF: + ICF1=CE%FACE_LIST(1,JCF,JCE); ICF2=CE%FACE_LIST(2,JCF,JCE) + CF=>M%CUT_FACE(ICF1) + WRITE(33,'(4I8,I8,3F16.8,F16.8)') CF%IJK(1:4),ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) + ENDDO + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CLOSE(33) ENDIF RETURN -END SUBROUTINE CONVERTGEOM +END SUBROUTINE GET_CC_FACE_CELL_LIST_INFO -! ---------------------------- REORDER_FACE ---------------------------------------- -SUBROUTINE REORDER_VERTS(VERTS) -! the VERTS triplet V1, V2, V3 defines a face -! reorder V1,V2,V3 so that V1 has the smallest index -INTEGER, INTENT(INOUT) :: VERTS(3) +! ---------------------- GET_REGULAR_CUTCELLS_BOX ------------------------------ -INTEGER :: VERTS_TEMP(5) +SUBROUTINE GET_REGULAR_CUTCELLS_BOX -IF ( VERTS(1) GEOMETRY(IG)%XB(2)) CYCLE + IF(YCELL(J) < GEOMETRY(IG)%XB(3)) CYCLE + IF(YCELL(J) > GEOMETRY(IG)%XB(4)) CYCLE + IF(ZCELL(K) < GEOMETRY(IG)%XB(5)) CYCLE + IF(ZCELL(K) > GEOMETRY(IG)%XB(6)) CYCLE + GEOMCELL(I,J,K) = IG + MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_SOLID + EXIT + ENDDO + ENDDO + ENDDO +ENDDO -SUBROUTINE OUTGEOM(LUNIT,LUNIT2,IS_DYNAMIC,TIME,APPLY_TRAN,TRAN) - INTEGER, INTENT(IN) :: LUNIT, LUNIT2 - REAL(EB), INTENT(IN) :: TIME - TYPE(TRANSFORM_TYPE), POINTER, INTENT(IN) :: TRAN - LOGICAL, INTENT(IN) :: IS_DYNAMIC, APPLY_TRAN - INTEGER :: N_VERTS, N_FACES, N_VOLUS - INTEGER :: I - INTEGER, ALLOCATABLE, DIMENSION(:) :: FACES, VOLUS, MATL_IDS, GEOM_IDS, SURF_IDS - REAL(EB), ALLOCATABLE, DIMENSION(:) :: VERTS, TFACES - INTEGER :: IZERO +! Now Tag cut-cells: The -2, +2 is to be able to define cut-face types below on boundary of GC cut-cells. +DO K=KLO_CELL-NGUARD+1,KHI_CELL+NGUARD-1 + DO J=JLO_CELL-NGUARD+1,JHI_CELL+NGUARD-1 + DO I=ILO_CELL-NGUARD+1,IHI_CELL+NGUARD-1 + IF(MESHES(NM)%CCVAR(I,J,K,CC_CGSC)==CC_SOLID) THEN + ! Set all vertices to Solid: + MESHES(NM)%VERTVAR(I-1,J ,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I-1,J-1,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I-1,J-1,K-1,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I-1,J ,K-1,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J ,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J-1,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J-1,K-1,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J ,K-1,CC_VGSC) = CC_SOLID + CYCLE + ENDIF + IF(ANY(MESHES(NM)%CCVAR(I-1:I+1,J-1:J+1,K-1:K+1,CC_CGSC) == CC_SOLID)) & + MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE + ENDDO + ENDDO +ENDDO - CALL PROCESS_GEOM(IS_DYNAMIC,TIME,N_VERTS, N_FACES, N_VOLUS) ! scale, rotate, translate GEOM vertices +! Then tag faces: +! X Faces: +DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD + DO J=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD + DO I=ILO_FACE-CCGUARD,IHI_FACE+CCGUARD + ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: + IF(ANY(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_GASPHASE)) CYCLE - ALLOCATE(VERTS(MAX(1,3*N_VERTS)),STAT=IZERO) ! create arrays to contain all vertices and faces - CALL ChkMemErr('OUTGEOM','VERTS',IZERO) + ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: + IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_SOLID)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID + GEOMFACE(I,J,K,IAXIS) = GEOMCELL(I,J,K) + CYCLE + ENDIF - ALLOCATE(TFACES(MAX(1,6*N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','VERTS',IZERO) + ! Now Gasphase cut-faces: All CCVAR == CUTCFE + IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_CUTCFE)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_CUTCFE + ! GEOMFACE(I,J,K,IAXIS) stays CC_GASPHASE + CYCLE + ENDIF - ALLOCATE(FACES(MAX(1,3*N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','FACES',IZERO) + ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: + IF (GEOMCELL(I,J,K)*GEOMCELL(I+1,J,K) < 0) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID + GEOMFACE(I,J,K,IAXIS) = MAXVAL(GEOMCELL(I:I+1,J,K)) ! This is because one is ==CC_GASPHASE==-1 + CYCLE + ENDIF + ENDDO + ENDDO +ENDDO - ALLOCATE(GEOM_IDS(MAX(1,N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','GEOM_IDS',IZERO) +! Y Faces: +DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD + DO J=JLO_FACE-CCGUARD,JHI_FACE+CCGUARD + DO I=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD + ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: + IF(ANY(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_GASPHASE)) CYCLE - ALLOCATE(SURF_IDS(MAX(1,N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','SURF_IDS',IZERO) + ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: + IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_SOLID)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_SOLID + GEOMFACE(I,J,K,JAXIS) = GEOMCELL(I,J,K) + CYCLE + ENDIF - ALLOCATE(VOLUS(MAX(1,4*N_VOLUS)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','VOLUS',IZERO) + ! Now Gasphase cut-faces: All CCVAR == CUTCFE + IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_CUTCFE)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_CUTCFE + ! GEOMFACE(I,J,K,JAXIS) stays CC_GASPHASE + CYCLE + ENDIF - ALLOCATE(MATL_IDS(MAX(1,N_VOLUS)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','MATL_IDS',IZERO) + ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: + IF (GEOMCELL(I,J,K)*GEOMCELL(I,J+1,K) < 0) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_SOLID + GEOMFACE(I,J,K,JAXIS) = MAXVAL(GEOMCELL(I,J:J+1,K)) ! This is because one is ==CC_GASPHASE==-1 + CYCLE + ENDIF + ENDDO + ENDDO +ENDDO - IF (N_VERTS>0 .AND. (N_FACES>0 .OR. N_VOLUS>0)) THEN - CALL MERGE_GEOMS(VERTS,N_VERTS,FACES,TFACES,GEOM_IDS,SURF_IDS,N_FACES,VOLUS,MATL_IDS,N_VOLUS,IS_DYNAMIC) - ENDIF +! Z Faces: +DO K=KLO_FACE-CCGUARD,KHI_FACE+CCGUARD + DO J=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD + DO I=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD + ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: + IF(ANY(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_GASPHASE)) CYCLE - WRITE(LUNIT) REAL(TIME,FB) - WRITE(LUNIT) N_VERTS, N_FACES, N_VOLUS - IF (N_VERTS>0) THEN - IF (APPLY_TRAN) THEN - DO I = 1, N_VERTS - VERTS(3*I) = VERTS(3*I) + TRAN%Z_OFFSET - ENDDO - ENDIF - WRITE(LUNIT) (REAL(VERTS(I),FB), I=1,3*N_VERTS) - ENDIF - IF (N_FACES>0) THEN - WRITE(LUNIT) (FACES(I), I=1,3*N_FACES) - WRITE(LUNIT) (SURF_IDS(I), I=1,N_FACES) - WRITE(LUNIT) (REAL(TFACES(I),FB), I=1,6*N_FACES) + ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: + IF(ALL(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_SOLID)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_SOLID + GEOMFACE(I,J,K,KAXIS) = GEOMCELL(I,J,K) + CYCLE + ENDIF - WRITE(LUNIT2) N_FACES - WRITE(LUNIT2) (GEOM_IDS(I), I=1,N_FACES) - ENDIF - IF (N_VOLUS>0) THEN - WRITE(LUNIT) (VOLUS(I), I=1,4*N_VOLUS) - WRITE(LUNIT) (MATL_IDS(I), I=1,N_VOLUS) - ENDIF + ! Now Gasphase cut-faces: All CCVAR == CUTCFE + IF(ALL(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_CUTCFE)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_CUTCFE + ! GEOMFACE(I,J,K,KAXIS) stays CC_GASPHASE + CYCLE + ENDIF -END SUBROUTINE OUTGEOM + ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: + IF (GEOMCELL(I,J,K)*GEOMCELL(I,J,K+1) < 0) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_SOLID + GEOMFACE(I,J,K,KAXIS) = MAXVAL(GEOMCELL(I,J,K:K+1)) ! This is because one is ==CC_GASPHASE==-1 + CYCLE + ENDIF + ENDDO + ENDDO +ENDDO -! ---------------------------- WRITE_GEOM_ALL ------------------------------------ -SUBROUTINE WRITE_GEOM_ALL -CALL WRITE_GEOM(T_BEGIN) ! write out both static and dynamic data at t=T_BEGIN -END SUBROUTINE WRITE_GEOM_ALL +! Now define Gasphase and boundary cut-faces: 1 Boundary, 2 internal, 3 guard cell faces: +INTGC_FLG_LOOP : DO INTGC_FLG=LOW_IND,HIGH_IND -! ---------------------------- WRITE_GEOM ---------------------------------------- + ! GASPHASE cut-faces: + NVERT = 4; NFACE = 1; NVERTFACE = 5 + IF (INTGC_FLG==LOW_IND) THEN + ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. + BNDINT_LOW = 1; BNDINT_HIGH = 3 + ELSE + BNDINT_LOW = 4; BNDINT_HIGH = 4 + ENDIF -SUBROUTINE WRITE_GEOM(TIME) + IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, + ! 4 guard-cell faces. -! output geometries to a .ge file + ! When switching to internal faces, copy number of external faces already computed. + IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH -REAL(EB), INTENT(IN) :: TIME -INTEGER :: ONE=1, ZERO=0, VERSION=2 -TYPE(TRANSFORM_TYPE), POINTER :: T + X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS + SELECT CASE(X1AXIS) + CASE(IAXIS) + X2AXIS = JAXIS; X3AXIS = KAXIS + ! IAXIS gasphase cut-faces: + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + ILO = ILO_FACE; IHI = ILO_FACE + CASE(2) + ILO = IHI_FACE; IHI = IHI_FACE + CASE(3) + ILO = ILO_FACE+1; IHI = IHI_FACE-1 + CASE(4) + ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS + ! Local indexing in x1, x2, x3: + X1LO = ILO; X1HI = IHI + X2LO = JLO; X2HI = JHI + X3LO = KLO; X3HI = KHI + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE + ALLOCATE(X2FACE(JSTR:JEND)); X2FACE = YFACE + ALLOCATE(X3FACE(KSTR:KEND)); X3FACE = ZFACE -IF (N_GEOMETRY<=0) RETURN + CASE(JAXIS) + X2AXIS = KAXIS; X3AXIS = IAXIS + ! JAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + JLO = JLO_FACE; JHI = JLO_FACE + CASE(2) + JLO = JHI_FACE; JHI = JHI_FACE + CASE(3) + JLO = JLO_FACE+1; JHI = JHI_FACE-1 + CASE(4) + JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS + ! Local indexing in x1, x2, x3: + X1LO = JLO; X1HI = JHI + X2LO = KLO; X2HI = KHI + X3LO = ILO; X3HI = IHI + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE + ALLOCATE(X2FACE(KSTR:KEND)); X2FACE = ZFACE + ALLOCATE(X3FACE(ISTR:IEND)); X3FACE = XFACE -IF (WRITE_GEOM_FIRST) THEN - OPEN(LU_GEOM(1),FILE=TRIM(FN_GEOM(1)),FORM='UNFORMATTED',STATUS='REPLACE') - OPEN(LU_GEOM(2),FILE=TRIM(FN_GEOM(2)),FORM='UNFORMATTED',STATUS='REPLACE') - WRITE(LU_GEOM(1)) ONE - WRITE(LU_GEOM(1)) VERSION - WRITE(LU_GEOM(1)) ZERO, ZERO, ONE ! n floats, n ints, first frame static - CALL OUTGEOM(LU_GEOM(1),LU_GEOM(2),.FALSE.,TIME,.FALSE.,T) ! write out static data -ELSE - OPEN(LU_GEOM(1),FILE=TRIM(FN_GEOM(1)),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND') - OPEN(LU_GEOM(2),FILE=TRIM(FN_GEOM(2)),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND') -ENDIF -CALL OUTGEOM(LU_GEOM(1),LU_GEOM(2),.TRUE.,TIME,.FALSE.,T) ! write out dynamic data -CLOSE(LU_GEOM(1)) -CLOSE(LU_GEOM(2)) + CASE(KAXIS) + X2AXIS = IAXIS; X3AXIS = JAXIS + ! KAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + KLO = KLO_FACE; KHI = KLO_FACE + CASE(2) + KLO = KHI_FACE; KHI = KHI_FACE + CASE(3) + KLO = KLO_FACE+1; KHI = KHI_FACE-1 + CASE(4) + KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + END SELECT + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS + ! Local indexing in x1, x2, x3: + X1LO = KLO; X1HI = KHI + X2LO = ILO; X2HI = IHI + X3LO = JLO; X3HI = JHI + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE + ALLOCATE(X2FACE(ISTR:IEND)); X2FACE = XFACE + ALLOCATE(X3FACE(JSTR:JEND)); X3FACE = YFACE -WRITE_GEOM_FIRST = .FALSE. + END SELECT -END SUBROUTINE WRITE_GEOM + ! Loop on Cartesian faces, local x1, x2, x3 indexes: + DO II=X1LO,X1HI + DO KK=X3LO,X3HI + DO JJ=X2LO,X2HI + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI = INDXI(XIAXIS) + INDJ = INDXI(XJAXIS) + INDK = INDXI(XKAXIS) + ! Drop if not CUTCFE: + IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE; IJK_COUNTED(INDI,INDJ,INDK,X1AXIS)=.TRUE. + IF(MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE -! ---------------------------- TRIANGLE_AREA ---------------------------------------- + ! Vertex at index II,JJ-1,KK-1: + INDXI1(IAXIS:KAXIS) = (/ II, JJ-1, KK-1 /) ! Local x1,x2,x3 + INDI1 = INDXI1(XIAXIS) + INDJ1 = INDXI1(XJAXIS) + INDK1 = INDXI1(XKAXIS) + ! Vertex at index II,JJ,KK-1: + INDXI2(IAXIS:KAXIS) = (/ II, JJ, KK-1 /) ! Local x1,x2,x3 + INDI2 = INDXI2(XIAXIS) + INDJ2 = INDXI2(XJAXIS) + INDK2 = INDXI2(XKAXIS) + ! Vertex at index II,JJ,KK: + INDXI3(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI3 = INDXI3(XIAXIS) + INDJ3 = INDXI3(XJAXIS) + INDK3 = INDXI3(XKAXIS) + ! Vertex at index II,JJ-1,KK: + INDXI4(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 + INDI4 = INDXI4(XIAXIS) + INDJ4 = INDXI4(XJAXIS) + INDK4 = INDXI4(XKAXIS) -REAL(EB) FUNCTION TRIANGLE_AREA(V1,V2,V3) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT + ! First, normal direction in x1 direction. + ! For this face: XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + ! Vert 1: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI1(IAXIS)), X2FACE(INDXI1(JAXIS)), X3FACE(INDXI1(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) + ! Vert 2: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI2(IAXIS)), X2FACE(INDXI2(JAXIS)), X3FACE(INDXI2(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) + ! Vert 3: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI3(IAXIS)), X2FACE(INDXI3(JAXIS)), X3FACE(INDXI3(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) + ! Vert 4: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI4(IAXIS)), X2FACE(INDXI4(JAXIS)), X3FACE(INDXI4(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) -REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3) -REAL(EB) :: N(3),R1(3),R2(3) + CFELEM(1:5,1) = (/ 4, NOD1, NOD2, NOD3, NOD4 /) -R1 = V2-V1 -R2 = V3-V1 -CALL CROSS_PRODUCT(N,R1,R2) + ! Area: + AREA(1) = (X2FACE(INDXI2(JAXIS))-X2FACE(INDXI1(JAXIS)))*(X3FACE(INDXI4(KAXIS))-X3FACE(INDXI1(KAXIS))) -TRIANGLE_AREA = 0.5_EB*NORM2(N) + ! XYZCEN in Local Coords: + XYZCEN(IAXIS:KAXIS,1)= (/ X1FACE(II), 0.5_EB*(X2FACE(INDXI2(JAXIS))+X2FACE(INDXI1(JAXIS))), & + 0.5_EB*(X3FACE(INDXI4(KAXIS))+X3FACE(INDXI1(KAXIS))) /) -END FUNCTION TRIANGLE_AREA + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(IAXIS,1) = 1._EB * X1FACE(II) * AREA(1) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(IAXIS,1) = 1._EB * X1FACE(II)**2._EB * AREA(1) + ! This is a new cut-face, allocate space: + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (INTGC_FLG==LOW_IND) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCF,X1AXIS) = NCUTFACE -! ---------------------------- POINT_IN_BOX_2D ---------------------------------------- + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -LOGICAL FUNCTION POINT_IN_BOX_2D(P,BB,IOR) + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ INDI, INDJ, INDK, X1AXIS /) + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE,IBNDINT) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) -REAL(EB), INTENT(IN) :: P(3),BB(6) -INTEGER, INTENT(IN) :: IOR + ! Connectivity: + CF%CFELEM(1:NVERTFACE,NFACE) = CFELEM(1:NVERTFACE,1) + ! Geom Properties: + CF%AREA(NFACE) = AREA(1) + CF%XYZCEN(IAXIS:KAXIS,NFACE) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,1) -POINT_IN_BOX_2D=.FALSE. + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: + CF%INXAREA(NFACE) = INXAREA(XIAXIS,1) + ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: + CF%INXSQAREA(NFACE) = INXSQAREA(XIAXIS,1) + ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: + CF%JNYSQAREA(NFACE) = INXSQAREA(XJAXIS,1) + ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: + CF%KNZSQAREA(NFACE) = INXSQAREA(XKAXIS,1) -SELECT CASE(ABS(IOR)) - CASE(1) ! YZ plane - IF ( P(2)>=BB(3) .AND. P(2)<=BB(4) .AND. & - P(3)>=BB(5) .AND. P(3)<=BB(6) ) POINT_IN_BOX_2D=.TRUE. - CASE(2) ! XZ plane - IF ( P(1)>=BB(1) .AND. P(1)<=BB(2) .AND. & - P(3)>=BB(5) .AND. P(3)<=BB(6) ) POINT_IN_BOX_2D=.TRUE. - CASE(3) ! XY plane - IF ( P(1)>=BB(1) .AND. P(1)<=BB(2) .AND. & - P(2)>=BB(3) .AND. P(2)<=BB(4) ) POINT_IN_BOX_2D=.TRUE. -END SELECT + ENDDO + ENDDO + ENDDO + DEALLOCATE(X1FACE,X2FACE,X3FACE) + ENDDO X1AXIS_LOOP + ENDDO IBNDINT_LOOP -END FUNCTION POINT_IN_BOX_2D + IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED ) -! ---------------------------- POINT_IN_TETRAHEDRON ---------------------------------------- + ! INBOUNDARY cut-faces: + IF (INTGC_FLG==LOW_IND) THEN + ALLOCATE( IJK_COUNTED2(ISTR:IEND,JSTR:JEND,KSTR:KEND) ); IJK_COUNTED2=.FALSE. + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + ELSE + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD + ENDIF -LOGICAL FUNCTION POINT_IN_TETRAHEDRON(XP,V1,V2,V3,V4,BB) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT + ! Loop on Cartesian cells: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -REAL(EB), INTENT(IN) :: XP(3),V1(3),V2(3),V3(3),V4(3),BB(6) -REAL(EB) :: U_VEC(3),V_VEC(3),N_VEC(3),Q_VEC(3),R_VEC(3) -INTEGER :: I + IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE -! In this routine, we test all four faces of the tet volume defined by the points X(i),Y(i),Z(i); i=1:4. -! If the point is on the negative side of all the faces, it is inside the volume. + IF(IJK_COUNTED2(I,J,K)) CYCLE; IJK_COUNTED2(I,J,K)=.TRUE. -POINT_IN_TETRAHEDRON=.FALSE. + ! Face type of bounding Cartesian faces: + FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) + FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) + FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) + FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) + FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) + FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) -! first test bounding box + IF ( ALL(FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) /= CC_SOLID) ) CYCLE -IF (XP(1)BB(2)) RETURN -IF (XP(2)BB(4)) RETURN -IF (XP(3)BB(6)) RETURN + NVERT = 0; NFACE = 0 + INXAREA = 0._EB + INXSQAREA = 0._EB + ! XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + X1AXIS_LOOP2 : DO X1AXIS=IAXIS,KAXIS + LOHI_DO : DO LOHI=LOW_IND,HIGH_IND + IF (FSID_XYZ(LOHI,X1AXIS) /= CC_SOLID) CYCLE + NFACE = NFACE + 1 + SELECT CASE(X1AXIS) + CASE(IAXIS) -POINT_IN_TETRAHEDRON=.TRUE. + ! Vertices: + XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K ) /) + IF(LOHI==LOW_IND)THEN + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) + ELSE + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) + ENDIF + ! Area: + AREA(NFACE) = (YFACE(J )-YFACE(J-1))*(ZFACE(K )-ZFACE(K-1)) + ! XYZCEN: + XYZCEN(IAXIS:KAXIS,NFACE) = (/ XFACE(I-2+LOHI), 0.5_EB*(YFACE(J )+YFACE(J-1)), & + 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI) * AREA(NFACE) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI)**2._EB * AREA(NFACE) -FACE_LOOP: DO I=1,4 + ! Define IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I-2+LOHI,J,K,X1AXIS) + CASE(JAXIS) - SELECT CASE(I) - CASE(1) - ! vertex ordering = 1,2,3,4 - Q_VEC = XP-(/V1(1),V1(2),V1(3)/) ! form a vector from a point on the triangular surface to the point XP - R_VEC = (/V4(1),V4(2),V4(3)/)-(/V1(1),V1(2),V1(3)/) ! vector from the tri to other point of volume defining inside - U_VEC = (/V2(1)-V1(1),V2(2)-V1(2),V2(3)-V1(3)/) ! vectors forming the sides of the triangle - V_VEC = (/V3(1)-V1(1),V3(2)-V1(2),V3(3)-V1(3)/) - CASE(2) - ! vertex ordering = 1,3,4,2 - Q_VEC = XP-(/V1(1),V1(2),V1(3)/) - R_VEC = (/V2(1),V2(2),V2(3)/)-(/V1(1),V1(2),V1(3)/) - U_VEC = (/V3(1)-V1(1),V3(2)-V1(2),V3(3)-V1(3)/) - V_VEC = (/V4(1)-V1(1),V4(2)-V1(2),V4(3)-V1(3)/) - CASE(3) - ! vertex ordering = 1,4,2,3 - Q_VEC = XP-(/V1(1),V1(2),V1(3)/) - R_VEC = (/V2(1),V2(2),V2(3)/)-(/V1(1),V1(2),V1(3)/) - U_VEC = (/V4(1)-V1(1),V4(2)-V1(2),V4(3)-V1(3)/) - V_VEC = (/V2(1)-V1(1),V2(2)-V1(2),V2(3)-V1(3)/) - CASE(4) - ! vertex ordering = 2,4,3,1 - Q_VEC = XP-(/V2(1),V2(2),V2(3)/) - R_VEC = (/V1(1),V1(2),V1(3)/)-(/V2(1),V2(2),V2(3)/) - U_VEC = (/V4(1)-V2(1),V4(2)-V2(2),V4(3)-V2(3)/) - V_VEC = (/V3(1)-V2(1),V3(2)-V2(2),V3(3)-V2(3)/) - END SELECT + ! Vertices: + XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K-1) /) + IF(LOHI==LOW_IND)THEN + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) + ELSE + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) + ENDIF + ! Area: + AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(ZFACE(K )-ZFACE(K-1)) + ! XYZCEN: + XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), YFACE(J-2+LOHI), & + 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI) * AREA(NFACE) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI)**2._EB * AREA(NFACE) - ! if the sign of the dot products are equal, the point is inside, else it is outside and we return + ! Define IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I,J-2+LOHI,K,X1AXIS) + CASE(KAXIS) - IF ( ABS( SIGN(1._EB,DOT_PRODUCT(Q_VEC,N_VEC))-SIGN(1._EB,DOT_PRODUCT(R_VEC,N_VEC)) )>TWENTY_EPSILON_EB ) THEN - POINT_IN_TETRAHEDRON=.FALSE. - RETURN - ENDIF + ! Vertices: + XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K-2+LOHI) /) + XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K-2+LOHI) /) + XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J ), ZFACE(K-2+LOHI) /) + XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K-2+LOHI) /) + IF(LOHI==LOW_IND)THEN + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) + ELSE + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) + ENDIF + ! Area: + AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(YFACE(J )-YFACE(J-1)) + ! XYZCEN: + XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), 0.5_EB*(YFACE(J )+YFACE(J-1)), & + ZFACE(K-2+LOHI) /) + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI) * AREA(NFACE) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI)**2._EB * AREA(NFACE) -ENDDO FACE_LOOP + ! Define IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I,J,K-2+LOHI,X1AXIS) + END SELECT -END FUNCTION POINT_IN_TETRAHEDRON + ! With IBOD and cut-face XYZCEN defined, find closest triangle: + DIST = 1.E20_EB + ITRI(NFACE) = 1 + DO IWSEL=1,GEOMETRY(IBOD(NFACE))%N_FACES + I1 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-2) + I2 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-1) + I3 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL ) + XCEN(IAXIS:KAXIS) = 1._EB/3._EB * ( GEOMETRY(IBOD(NFACE))%VERTS(3*(I1-1)+IAXIS:3*(I1-1)+KAXIS)+ & + GEOMETRY(IBOD(NFACE))%VERTS(3*(I2-1)+IAXIS:3*(I2-1)+KAXIS)+ & + GEOMETRY(IBOD(NFACE))%VERTS(3*(I3-1)+IAXIS:3*(I3-1)+KAXIS) ) + ! Drop Triangles not on the face: + IF (ABS(XYZCEN(X1AXIS,NFACE)-XCEN(X1AXIS)) > GEOMEPS) CYCLE + DIST2 = NORM2(XYZCEN(IAXIS:KAXIS,NFACE)-XCEN(IAXIS:KAXIS)) + IF (DIST > DIST2) THEN + DIST = DIST2 + ITRI(NFACE) = IWSEL + ENDIF + ENDDO + NVERT = NVERT + 4 -! ---------------------------- VALID_TRIANGLE ---------------------------------------- + ENDDO LOHI_DO + ENDDO X1AXIS_LOOP2 -LOGICAL FUNCTION VALID_TRIANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3,VERT_FLAG) -INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3, VERT_FLAG(0:300) -REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) + ! This is a cut-face, allocate space: + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (INTGC_FLG==LOW_IND) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF + MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE -REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB -REAL(FB), POINTER, DIMENSION(:) :: V, V1, V2, V3 -REAL(FB) :: U1(3), U2(3), U1XU2, D123 + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -INTEGER :: I + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, 0 /) ! No axis = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_INBOUNDARY + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) + CF%CFELEM(1:5,1:NFACE) = CFELEM(1:5,1:NFACE) -VALID_TRIANGLE = .FALSE. + CF%AREA(1:NFACE) = AREA(1:NFACE) + CF%XYZCEN(IAXIS:KAXIS,1:NFACE) = XYZCEN(IAXIS:KAXIS,1:NFACE) -V1(1:3)=>VERTS(3*IV1-2:3*IV1) -V2(1:3)=>VERTS(3*IV2-2:3*IV2) -V3(1:3)=>VERTS(3*IV3-2:3*IV3) + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA: + CF%INXAREA(1:NFACE) = INXAREA(IAXIS,1:NFACE) + ! dot(i,nc)*int(x^2)dA: + CF%INXSQAREA(1:NFACE) = INXSQAREA(IAXIS,NFACE) + ! dot(j,nc)*int(y^2)dA: + CF%JNYSQAREA(1:NFACE) = INXSQAREA(JAXIS,NFACE) + ! dot(k,nc)*int(z^2)dA: + CF%KNZSQAREA(1:NFACE) = INXSQAREA(KAXIS,NFACE) -U1 = V2 - V1; -U2 = V3 - V2; + ! Define Body-triangle reference: + CF%BODTRI(1,1:NFACE)= IBOD(1:NFACE) + CF%BODTRI(2,1:NFACE)= ITRI(1:NFACE) -! triangle is invalid if angle at V2 is > 180 deg + ! Assign surf-index: Depending on GEOMETRY: + DO IFACE=1,NFACE + CF%SURF_INDEX(IFACE) = GEOMETRY(IBOD(IFACE))%SURFS(ITRI(IFACE)) + ENDDO -IF(DIR==1) THEN - U1(1) = U1(2) - U1(2) = U1(3) - U2(1) = U2(2) - U2(2) = U2(3) -ELSE IF(DIR==2) THEN - U1(2) = U1(1) - U1(1) = U1(3) - U2(2) = U2(1) - U2(1) = U2(3) -ELSE - U1(1) = U1(1) - U1(2) = U1(2) - U2(1) = U2(1) - U2(2) = U2(2) -ENDIF -U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize -U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize -U1XU2 = U1(1)*U2(2)-U1(2)*U2(1) ! U1 x U2 -IF (U1XU2 < EPS_FB) RETURN + ENDDO + ENDDO + ENDDO -DO I = 1, NVERTS - IF (VERT_FLAG(I) == 0) CYCLE - IF (I == IV1 .OR. I == IV2 .OR.I == IV3 ) CYCLE - V(1:3)=>VERTS(3*I-2:3*I) - ! These CYCLE tests are done to treat holes properly: - D123=SQRT( (V(1)-V1(1))**2._FB + (V(2)-V1(2))**2._FB + (V(3)-V1(3))**2._FB ) - IF (D123 < EPS_FB) CYCLE - D123=SQRT( (V(1)-V2(1))**2._FB + (V(2)-V2(2))**2._FB + (V(3)-V2(3))**2._FB ) - IF (D123 < EPS_FB) CYCLE - D123=SQRT( (V(1)-V3(1))**2._FB + (V(2)-V3(2))**2._FB + (V(3)-V3(3))**2._FB ) - IF (D123 < EPS_FB) CYCLE - IF (POINT_IN_TRIANGLE_FB(V, V1, V2, V3)) RETURN -ENDDO + IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED2 ) -VALID_TRIANGLE = .TRUE. -END FUNCTION VALID_TRIANGLE +ENDDO INTGC_FLG_LOOP -! ----------------------------- DIFF_ANGLE ----------------------------------------- +! Finally Build cut-cells: +NCFACE_CUTCELL = 7; NFACE_CELL = 6; NCELL = 1 +INTGC_FLG_LOOP2 : DO INTGC_FLG=LOW_IND,HIGH_IND ! 1 refers to blocks internal cells, 2 refers to block guard cells. -LOGICAL FUNCTION DIFF_ANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3, ABS_FLG) + SELECT CASE(INTGC_FLG) + CASE(LOW_IND) + ALLOCATE(IJK_COUNT(ILO_CELL-NGUARD:IHI_CELL+NGUARD,JLO_CELL-NGUARD:JHI_CELL+NGUARD, & + KLO_CELL-NGUARD:KHI_CELL+NGUARD)) + IJK_COUNT = .FALSE. + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + CASE(HIGH_IND) + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD + END SELECT -INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3 -REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) -LOGICAL, INTENT(IN) :: ABS_FLG + ! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB -REAL(FB), PARAMETER :: EPS_MID= 1.E-4_FB -REAL(FB), POINTER, DIMENSION(:) :: V1, V2, V3 -REAL(FB) :: U1(3), U2(3), CRPD(3), NORMU(2) -LOGICAL :: TEST_FLAG=.FALSE. + IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE -DIFF_ANGLE = .FALSE. + IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. -V1(1:3)=>VERTS(3*IV1-2:3*IV1) -V2(1:3)=>VERTS(3*IV2-2:3*IV2) -V3(1:3)=>VERTS(3*IV3-2:3*IV3) + ! Start with Cartesian Faces: + ! Face type of bounding Cartesian faces: + FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) + FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) + FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) + FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) + FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) + FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) -U1 = V2 - V1; -U2 = V3 - V2; + ! Cut-face number of bounding Cartesian faces: + IDCF_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCF,IAXIS) + IDCF_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCF,IAXIS) + IDCF_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCF,JAXIS) + IDCF_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCF,JAXIS) + IDCF_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCF,KAXIS) + IDCF_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCF,KAXIS) -NORMU(1)=SQRT(U1(1)**2._FB+U1(2)**2._FB+U1(3)**2._FB) -NORMU(2)=SQRT(U2(1)**2._FB+U2(2)**2._FB+U2(3)**2._FB) + NFACE_CELL = 0 -IF(ANY(NORMU(1:2) 180 deg -SELECT CASE(DIR) -CASE(IAXIS) - U1(1) = U1(2) - U1(2) = U1(3) - U2(1) = U2(2) - U2(2) = U2(3) -CASE(JAXIS) - U1(2) = U1(1) - U1(1) = U1(3) - U2(2) = U2(1) - U2(1) = U2(3) -CASE(KAXIS) - U1(1) = U1(1) - U1(2) = U1(2) - U2(1) = U2(1) - U2(2) = U2(2) -CASE(0) ! 3D Cross for Inboundary faces: - U1(1:3) = U1(1:3) / NORMU(1) ! Normalize - U2(1:3) = U2(1:3) / NORMU(2) ! Normalize - CRPD(1) = U1(2)*U2(3)-U1(3)*U2(2) - CRPD(2) = U1(3)*U2(1)-U1(1)*U2(3) - CRPD(3) = U1(1)*U2(2)-U1(2)*U2(1) - ! ABS_FLG always .TRUE. in the 3D case: - IF (SQRT(CRPD(1)**2._FB+CRPD(2)**2._FB+CRPD(3)**2._FB) < EPS_FB) DIFF_ANGLE = .TRUE. - RETURN -END SELECT + ! Now add INBOUNDARY faces of the cell: + CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) + IF ( CEI > 0 ) THEN + DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE + NFACE_CELL = NFACE_CELL + 1 + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB, 0, 0, CEI, ICF, CC_UNDEFINED /) + ! CC_FTYPE_CFINB in Cart-cell. + ENDDO + ENDIF -U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize -U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize -IF (ABS_FLG) THEN - TEST_FLAG=ABS(U1(1)*U2(2)-U1(2)*U2(1)) < EPS_MID -ELSE - TEST_FLAG= U1(1)*U2(2)-U1(2)*U2(1) < EPS_FB -ENDIF -IF (TEST_FLAG) DIFF_ANGLE = .TRUE. + VOL(1) = DXCELL(I)*DYCELL(J)*DZCELL(K) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZCELL(K) /) -RETURN + ! Load into CUT_CELL data structure + NCUTCELL = MESHES(NM)%N_CUTCELL_MESH + MESHES(NM)%N_GCCUTCELL_MESH + 1 + IF (INTGC_FLG==LOW_IND) THEN + MESHES(NM)%N_CUTCELL_MESH = NCUTCELL + ELSE + MESHES(NM)%N_GCCUTCELL_MESH = MESHES(NM)%N_GCCUTCELL_MESH + 1 + ENDIF + MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = NCUTCELL -END FUNCTION DIFF_ANGLE + ! Resize array MESHES(NM)%CUT_CELL if necessary: + CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) -! ---------------------------- POINT_IN_TRIANGLE_FB ---------------------------------------- + ! Add cut-cell NCUTCELL entry: + MESHES(NM)%CUT_CELL(NCUTCELL)%IJK(IAXIS:KAXIS) = (/ I, J, K /) + MESHES(NM)%CUT_CELL(NCUTCELL)%NCELL = NCELL + MESHES(NM)%CUT_CELL(NCUTCELL)%NFACE_CELL= NFACE_CELL + CALL NEW_CELL_ALLOC(NM,NCUTCELL,NCELL,NFACE_CELL,NCFACE_CUTCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%CCELEM(1:NCFACE_CUTCELL,1) = (/ 6, 1, 2, 3, 4, 5, 6 /) + MESHES(NM)%CUT_CELL(NCUTCELL)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) = & + FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%VOLUME(1:NCELL) = VOL(1:NCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%XYZCEN(IAXIS:KAXIS,1:NCELL) = XYZCEN(IAXIS:KAXIS,1:NCELL) -LOGICAL FUNCTION POINT_IN_TRIANGLE_FB(P_FB,V1_FB,V2_FB,V3_FB) + ENDDO + ENDDO + ENDDO -REAL(FB), INTENT(IN) :: P_FB(3),V1_FB(3),V2_FB(3),V3_FB(3) -REAL(EB) :: P_EB(3),V1_EB(3),V2_EB(3),V3_EB(3) + IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNT ) - P_EB = REAL( P_FB,EB) -V1_EB = REAL(V1_FB,EB) -V2_EB = REAL(V2_FB,EB) -V3_EB = REAL(V3_FB,EB) -POINT_IN_TRIANGLE_FB = POINT_IN_TRIANGLE(P_EB,V1_EB,V2_EB,V3_EB) +ENDDO INTGC_FLG_LOOP2 -END FUNCTION POINT_IN_TRIANGLE_FB -! ---------------------------- POINT_IN_TRIANGLE ---------------------------------------- +DEALLOCATE(GEOMFACE,GEOMCELL) -LOGICAL FUNCTION POINT_IN_TRIANGLE(P,V1,V2,V3) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +END SUBROUTINE GET_REGULAR_CUTCELLS_BOX -REAL(EB), INTENT(IN) :: P(3),V1(3),V2(3),V3(3) -REAL(EB) :: E(3),E1(3),E2(3),N(3),R(3),Q(3) -INTEGER :: I -REAL(EB), PARAMETER :: EPS=1.E-16_EB -! This routine tests whether the projection of P, in the plane normal -! direction, onto to the plane defined by the triangle (V1,V2,V3) is -! inside the triangle. +! --------------------- DEALLOCATE_CUTCELLS_CONN_MESH -------------------------- -POINT_IN_TRIANGLE=.TRUE. ! start by assuming the point is inside +SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH(NM) -! compute face normal -E1 = V2-V1 -E2 = V3-V1 -CALL CROSS_PRODUCT(N,E1,E2) +INTEGER, INTENT(IN) :: NM -EDGE_LOOP: DO I=1,3 - SELECT CASE(I) - CASE(1) - E = V2-V1 - R = P-V1 - CASE(2) - E = V3-V2 - R = P-V2 - CASE(3) - E = V1-V3 - R = P-V3 - END SELECT - CALL CROSS_PRODUCT(Q,E,R) - IF ( DOT_PRODUCT(Q,N) < -EPS ) THEN - POINT_IN_TRIANGLE=.FALSE. - RETURN - ENDIF -ENDDO EDGE_LOOP +INTEGER :: ICC, ICF, I, J, K, DO_BNCF=1 +INTEGER, PARAMETER :: LOIN=-1 +INTEGER, PARAMETER :: HIIN= 2 -END FUNCTION POINT_IN_TRIANGLE +! Cut-cells and GASPHASE cut-faces: +DO K=-CCGUARD,MESHES(NM)%KBAR+CCGUARD + IF(K>LOIN .AND. KMESHES(NM)%KBAR+LOIN .AND. KLOIN .AND. JMESHES(NM)%JBAR+LOIN .AND. JLOIN .AND. IMESHES(NM)%IBAR+LOIN .AND. I0) CALL CELL_DEALLOC(NM,ICC) ! Deallocate this CUT_CELL array container: + ! IAXIS cut-face: + ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,IAXIS) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) + ! JAXIS cut-face: + ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,JAXIS) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) + ! KAXIS cut-face: + ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,KAXIS) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) + ENDDO + ENDDO +ENDDO +! INBOUNDARY cut-faces: +DO K=-CCGUARD,MESHES(NM)%KBAR+CCGUARD + DO J=-CCGUARD,MESHES(NM)%JBAR+CCGUARD + DO I=-CCGUARD,MESHES(NM)%IBAR+CCGUARD + ICF = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF,DO_BNCF) ! Deallocate this CUT_FACE array fields, except NFACE, XYZCEN. + ENDDO + ENDDO +ENDDO +IF(ALLOCATED(MESHES(NM)%VERTVAR)) DEALLOCATE(MESHES(NM)%VERTVAR) +IF(ALLOCATED(MESHES(NM)%ECVAR)) DEALLOCATE(MESHES(NM)%ECVAR) +RETURN +END SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH -! ---------------------------- TRIANGULATE ---------------------------------------- -SUBROUTINE TRIANGULATE(DIR,VERTS,NVERTS,VERT_OFFSET,FACES,LOCTYPE) +! ----------------------- DEALLOCATE_BODINT_PLANE ------------------------------ -INTEGER, INTENT(IN) :: DIR, NVERTS, VERT_OFFSET -REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) -INTEGER, INTENT(OUT) :: FACES(3*(NVERTS-2)) -INTEGER, INTENT(OUT) :: LOCTYPE(NVERTS-2) +SUBROUTINE DEALLOCATE_BODINT_PLANE(BODINT_PLANE) -INTEGER :: IFACE, NLIST, NLIST_OLD -INTEGER :: VERT_LIST(0:1024), VERT_FLAG(0:1023), EDGE_LIST(2,1:1024) -LOGICAL :: NODE_EXISTS(1024) -INTEGER :: IM1, I, IP1, V0, V1, V2, IVERT, IEDGE -LOGICAL HAVE_TRIANGLE -REAL(FB), POINTER, DIMENSION(:) :: VV1, VV2, VV3 -REAL(FB) :: U1(3), U2(3), U1XU2 -REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB -INTEGER :: NBIG_ANGLES, VERT_START -LOGICAL :: VERT_DROPPED, FLAG +TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE -INTEGER :: HIDEDGE(3), EDGEI(1:2), NVERTS2, NEDGES, COUNT -INTEGER, PARAMETER :: SHFT_NODE(1:4) = (/ 2, 1, 0, 2 /) +IF ( ALLOCATED(BODINT_PLANE%XYZ) ) DEALLOCATE(BODINT_PLANE%XYZ) +IF ( ALLOCATED(BODINT_PLANE%SGLS) ) DEALLOCATE(BODINT_PLANE%SGLS) +IF ( ALLOCATED(BODINT_PLANE%SEGS) ) DEALLOCATE(BODINT_PLANE%SEGS) +IF ( ALLOCATED(BODINT_PLANE%TRIS) ) DEALLOCATE(BODINT_PLANE%TRIS) +IF ( ALLOCATED(BODINT_PLANE%INDSEG) ) DEALLOCATE(BODINT_PLANE%INDSEG) +IF ( ALLOCATED(BODINT_PLANE%INDTRI) ) DEALLOCATE(BODINT_PLANE%INDTRI) +IF ( ALLOCATED(BODINT_PLANE%X2ALIGNED) ) DEALLOCATE(BODINT_PLANE%X2ALIGNED) +IF ( ALLOCATED(BODINT_PLANE%X3ALIGNED) ) DEALLOCATE(BODINT_PLANE%X3ALIGNED) +IF ( ALLOCATED(BODINT_PLANE%SEGTYPE) ) DEALLOCATE(BODINT_PLANE%SEGTYPE) +IF ( ALLOCATED(BODINT_PLANE%NOD_PERM) ) DEALLOCATE(BODINT_PLANE%NOD_PERM) +IF ( ALLOCATED(BODINT_PLANE%NBCROSS) ) DEALLOCATE(BODINT_PLANE%NBCROSS) +IF ( ALLOCATED(BODINT_PLANE%SVAR) ) DEALLOCATE(BODINT_PLANE%SVAR) +IF ( ALLOCATED(BODINT_PLANE%X1NVEC) ) DEALLOCATE(BODINT_PLANE%X1NVEC) +IF ( ALLOCATED(BODINT_PLANE%AINV) ) DEALLOCATE(BODINT_PLANE%AINV) +IF ( ALLOCATED(BODINT_PLANE%TBAXIS(IAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(IAXIS)%TRIBIN) +IF ( ALLOCATED(BODINT_PLANE%TBAXIS(JAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(JAXIS)%TRIBIN) +IF ( ALLOCATED(BODINT_PLANE%TBAXIS(KAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(KAXIS)%TRIBIN) -INTEGER :: COUNT_OUT +RETURN +END SUBROUTINE DEALLOCATE_BODINT_PLANE -FLAG = .TRUE. +! ---------------------- GET_EXT_INB_CUTFACES_TO_CFACE -------------------------------- -! Drop vertices that are repeated, close verts in EB precision that are fused in FB: -VERT_FLAG(1:NVERTS)=1 -I = 1 -VV1(1:3)=>VERTS(3*NVERTS-2:3*NVERTS) -VV2(1:3)=>VERTS(3*I-2:3*I) -IF ( ABS(VV1(1)-VV2(1))+ABS(VV1(2)-VV2(2))+ABS(VV1(3)-VV2(3)) < 10._FB*EPS_FB) VERT_FLAG(I)=0 -DO I = 2, NVERTS - VV1(1:3)=>VERTS(3*(I-1)-2:3*(I-1)) - VV2(1:3)=>VERTS(3*I-2:3*I) - IF ( ABS(VV1(1)-VV2(1))+ABS(VV1(2)-VV2(2))+ABS(VV1(3)-VV2(3)) < 10._FB*EPS_FB) VERT_FLAG(I)=0 -ENDDO -NLIST = SUM(VERT_FLAG(1:NVERTS)) -NVERTS2= NLIST -COUNT = 0 -DO I = 1, NVERTS - IF(VERT_FLAG(I)==0) CYCLE - COUNT= COUNT + 1 - VERT_LIST(COUNT) = I -ENDDO -VERT_LIST(0) = VERT_LIST(NLIST) -VERT_LIST(NLIST+1) = VERT_LIST(1) +SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE -! Now drop vertices contained whithin lines of the polygon: -DO I=1,NLIST - IM1 = VERT_LIST(I-1) - IVERT = VERT_LIST(I) - IP1 = VERT_LIST(I+1) - IF ( DIFF_ANGLE(DIR,VERTS,NVERTS,IM1,IVERT,IP1,.TRUE.) ) VERT_FLAG(IVERT)=0 -ENDDO +! Local Variables: +INTEGER :: ICF, CFACE_INDEX_LOCAL, SURF_INDEX +INTEGER :: IVENT +REAL(EB):: ADDMAT(IAXIS:KAXIS,LOW_IND:HIGH_IND) -! Redo List: -NLIST = SUM(VERT_FLAG(1:NVERTS)) +! GET_CUTCELLS_VERBOSE variables: +INTEGER, ALLOCATABLE, DIMENSION(:) :: NCFACE_BY_MESH -IF (NLIST < 3) THEN - FACES(1:3*(NVERTS-2)) = VERT_OFFSET + 1 - LOCTYPE(1:NVERTS-2) = 4+8+16 - RETURN -ENDIF +TYPE(VENTS_TYPE), POINTER :: VT +TYPE(CFACE_TYPE), POINTER :: CFA -NVERTS2= NLIST -NEDGES = NLIST -COUNT = 0 -DO I = 1, NVERTS - IF(VERT_FLAG(I)==0) CYCLE - COUNT= COUNT + 1 - VERT_LIST(COUNT) = I -ENDDO -VERT_LIST(0) = VERT_LIST(NLIST) -VERT_LIST(NLIST+1) = VERT_LIST(1) -NODE_EXISTS(1:NLIST+1) = .TRUE. -DO I = 1, NLIST-1 - EDGE_LIST((/1,2/),I) = (/ VERT_LIST(I), VERT_LIST(I+1) /) -ENDDO -EDGE_LIST((/1,2/),NLIST) = (/ VERT_LIST(NEDGES), VERT_LIST(1) /) -FACES(1:3*(NVERTS-2)) = VERT_OFFSET+VERT_LIST(NLIST) +IF(GET_CUTCELLS_VERBOSE) CALL CPU_TIME(CPUTIME_START) -IF (DIR == 0) THEN ! INBOUNDARY cut-face, always convex polygon. - VERT_START = VERT_LIST(1) - IFACE = 0 - DO I = 1, NVERTS2 - IP1 = I + 1 - IF (I==NVERTS2) IP1=1 - IF (I==VERT_START .OR. IP1==VERT_START) CYCLE - FACES(3*IFACE+1) = VERT_OFFSET+VERT_LIST(VERT_START) - FACES(3*IFACE+2) = VERT_OFFSET+VERT_LIST(I) - FACES(3*IFACE+3) = VERT_OFFSET+VERT_LIST(IP1) - IFACE = IFACE + 1 +ALLOCATE(NCFACE_BY_MESH(1:NMESHES)); NCFACE_BY_MESH(1:NMESHES) = 0 +MESH_LOOP_0 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + ! First N_EXTERNAL_CFACE_CELLS: + DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE + CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE + CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE + END SELECT + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE + ENDDO + ! Second N_INTWALL_CFACE_CELLS: + DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS)==0) CYCLE + ENDIF + CASE(JAXIS) + IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS)==0) CYCLE + ENDIF + CASE(KAXIS) + IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS)==0) CYCLE + ENDIF + END SELECT + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE ENDDO - ! Here test edges to define LOCTYPE: - LOCTYPE(:) = 4+8+16 - DO IFACE=1,NVERTS2-2 - HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. - DO IEDGE=1,3 - ! Nodes i,i+1: - EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) - DO I=1,NEDGES - IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN - HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. - EXIT - ENDIF - ENDDO - ENDDO - LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) + ! Second N_INTERNAL_CFACE_CELLS: + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE + ! Don't count INB cut-faces inside an OBST: + IF (CELL(CELL_INDEX(CF%IJK(IAXIS),CF%IJK(JAXIS),CF%IJK(KAXIS)))%SOLID) CYCLE + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE ENDDO - RETURN -ENDIF - -IF (FLAG) THEN ! find number of angles > 180 deg - NBIG_ANGLES = 0 - VERT_START = VERT_LIST(1) - DO I = 1, NVERTS2 - IM1 = I - 1 - IF (I==1)IM1 = NVERTS2 - IP1 = I + 1 - IF (I==NVERTS2)IP1 = 1 - IF ( DIFF_ANGLE(DIR,VERTS,NVERTS,VERT_LIST(IM1),VERT_LIST(I),VERT_LIST(IP1),.FALSE.) ) THEN - NBIG_ANGLES = NBIG_ANGLES + 1 - VERT_START = I - ENDIF - END DO +ENDDO MESH_LOOP_0 - ! if 0 angles (convex) or 1 angle (simple concave) then triangulate using a fan - IF ( NBIG_ANGLES <= 1 ) THEN - IFACE = 0 - DO I = 1, NVERTS2 - IP1 = I + 1 - IF (I==NVERTS2) IP1=1 - IF (I==VERT_START .OR. IP1==VERT_START) CYCLE - FACES(3*IFACE+1) = VERT_OFFSET+VERT_LIST(VERT_START) - FACES(3*IFACE+2) = VERT_OFFSET+VERT_LIST(I) - FACES(3*IFACE+3) = VERT_OFFSET+VERT_LIST(IP1) - IFACE = IFACE + 1 - ENDDO - ! Here test edges to define LOCTYPE: - LOCTYPE(:) = 4+8+16 - DO IFACE=1,NVERTS2-2 - HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. - DO IEDGE=1,3 - ! Nodes i,i+1: - EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) - DO I=1,NEDGES - IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN - HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. - EXIT - ENDIF - ENDDO - ENDDO - LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) - ENDDO - RETURN +IF(GET_CUTCELLS_VERBOSE) THEN + CALL MPI_ALLREDUCE(MPI_IN_PLACE,NCFACE_BY_MESH(1),NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + WRITE(LU_SETCC,'(A,I10)',advance='no') ' 4. Generating CFACES from cut-faces, total CFACE_CELLS=', & + SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,I10)') ' Total number of CFACES in all processes=', & + SUM(NCFACE_BY_MESH(1:NMESHES)) + WRITE(LU_ERR ,'(A,I10)',advance='no') & + ' 4. Process 0 Generating CFACES from cut-faces, total CFACE_CELLS=', & + SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) ENDIF ENDIF -! more than 1 angles in polygon > 180 deg -COUNT_OUT = 0 -IFACE = 1 -OUTER: DO WHILE (NLIST>=3) - COUNT_OUT = COUNT_OUT + 1 - IF(COUNT_OUT > NVERTS**4) THEN - ! Revert to Convex poly solution: - DO IVERT = 1, NVERTS - 2 ! for now assume face is convex - ! vertex indices 1, 2, ..., NVF - ! faces (1,2,3), (1,3,4), ..., (1,NVF-1,NVF) - FACES(3*IVERT-2) = VERT_OFFSET+1 - FACES(3*IVERT-1) = VERT_OFFSET+1+IVERT - FACES(3*IVERT) = VERT_OFFSET+2+IVERT - ENDDO - EXIT - ENDIF - IVERT = 1 - HAVE_TRIANGLE = .FALSE. - INNER: DO WHILE (IVERT<=NLIST) - V0 = VERT_LIST(IVERT-1) - V1 = VERT_LIST(IVERT) - V2 = VERT_LIST(IVERT+1) - IF(.NOT.NODE_EXISTS(IVERT+1))EXIT INNER - IF(NLIST==3.OR.VALID_TRIANGLE(DIR,VERTS,NVERTS,V0,V1,V2,VERT_FLAG)) THEN - FACES(IFACE ) = VERT_OFFSET+V0 - FACES(IFACE+1) = VERT_OFFSET+V1 - FACES(IFACE+2) = VERT_OFFSET+V2 - IF (NLIST == 3) EXIT OUTER - IFACE = IFACE + 3 - NODE_EXISTS(IVERT) = .FALSE. - IF(IVERT==1) NODE_EXISTS(NLIST+1) = .FALSE. - HAVE_TRIANGLE = .TRUE. - IVERT = IVERT + 2 - ELSE - IVERT = IVERT + 1 - ENDIF - ENDDO INNER - NLIST_OLD = NLIST - NLIST = 0 - DO I = 1, NLIST_OLD - IF(NODE_EXISTS(I))THEN - NLIST = NLIST + 1 - VERT_LIST(NLIST) = VERT_LIST(I) - ENDIF - ENDDO - VERT_LIST(0) = VERT_LIST(NLIST) - VERT_LIST(NLIST+1) = VERT_LIST(1) - NODE_EXISTS(1:NLIST+1) = .TRUE. +! First mesh Loop, Allocate storage for CFACES, CFACE geometric info: +MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) - ! Test for nodes connecting parallel edges, if found drop them: - VERT_DROPPED=.FALSE. - DO I=1,NLIST - V0=VERT_LIST(I-1); V1=VERT_LIST(I); V2=VERT_LIST(I+1); - VV1(1:3)=>VERTS(3*V0-2:3*V0) - VV2(1:3)=>VERTS(3*V1-2:3*V1) - VV3(1:3)=>VERTS(3*V2-2:3*V2) - U1 = VV2 - VV1; - U2 = VV3 - VV2; - SELECT CASE(DIR) + ! ALLOCATE to zero size + IF(ALLOCATED(MESHES(NM)%CFACE)) DEALLOCATE(MESHES(NM)%CFACE) + MESHES(NM)%N_CFACE_CELLS_DIM = NCFACE_BY_MESH(NM) + ALLOCATE(MESHES(NM)%CFACE(0:MESHES(NM)%N_CFACE_CELLS_DIM)) + + ALLOCATE(MESHES(NM)%FACE_WORK1(MESHES(NM)%N_CFACE_CELLS_DIM)) + ALLOCATE(MESHES(NM)%FACE_WORK2(MESHES(NM)%N_CFACE_CELLS_DIM)) + ALLOCATE(MESHES(NM)%FACE_WORK3(MESHES(NM)%N_CFACE_CELLS_DIM)) + + ! Define pointers among External CC_GASPHASE CUT_FACE and CFACE (N_EXTERNAL_CFACE_CELLS): + CFACE_INDEX_LOCAL = 0 + DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE + CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE + CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE + END SELECT + ! Now get WALL cell SURF_INDEX: + IW = 0 + SELECT CASE(X1AXIS) CASE(IAXIS) - U1(1) = U1(2); U1(2) = U1(3) - U2(1) = U2(2); U2(2) = U2(3) + IF (I==0 ) IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-1) + IF (I==IBAR) IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( 1) CASE(JAXIS) - U1(2) = U1(1); U1(1) = U1(3) - U2(2) = U2(1); U2(1) = U2(3) + IF (J==0 ) IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-2) + IF (J==JBAR) IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( 2) CASE(KAXIS) - U1(1) = U1(1); U1(2) = U1(2) - U2(1) = U2(1); U2(2) = U2(2) + IF (K==0 ) IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-3) + IF (K==KBAR) IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( 3) END SELECT - U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize - U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize - IF (U1(1)*U2(1)+U1(2)*U2(2) > -EPS_FB) CYCLE - U1XU2 = U1(1)*U2(2)-U1(2)*U2(1) ! U1 x U2 - IF (ABS(U1XU2) < EPS_FB) THEN ! Triple product less than EPS - VERT_DROPPED=.TRUE.; NODE_EXISTS(I)=.FALSE. - IF (IFACE < 3*(NVERTS2-2)) THEN - FACES(IFACE ) = VERT_OFFSET+V0 - FACES(IFACE+1) = VERT_OFFSET+V1 - FACES(IFACE+2) = VERT_OFFSET+V2 - IFACE = IFACE + 3 - ENDIF - IF (NLIST == 3) EXIT OUTER - ENDIF + SURF_INDEX = WALL(IW)%SURF_INDEX + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) + ENDDO ENDDO - IF (VERT_DROPPED) THEN - ! Repeat List generation: - NLIST_OLD = NLIST - NLIST = 0 - DO I = 1, NLIST_OLD - IF(NODE_EXISTS(I))THEN - NLIST = NLIST + 1 - VERT_LIST(NLIST) = VERT_LIST(I) + MESHES(NM)%N_EXTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL + ! Define pointers among internal CC_GASPHASE CUT_FACE and CFACE (N_INTWALL_CFACE_CELLS): + DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST, or don't lay on a WALL_CELL: + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE ENDIF - ENDDO - VERT_LIST(0) = VERT_LIST(NLIST) - VERT_LIST(NLIST+1) = VERT_LIST(1) - NODE_EXISTS(1:NLIST+1) = .TRUE. - ENDIF -ENDDO OUTER - -! Here test edges to define LOCTYPE: -LOCTYPE(:) = 4+8+16 -DO IFACE=1,NVERTS2-2 - HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. - DO IEDGE=1,3 - ! Nodes i,i+1: - EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) - DO I=1,NEDGES - IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN - HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. - EXIT + CASE(JAXIS) + IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE ENDIF + CASE(KAXIS) + IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + ENDIF + END SELECT + SURF_INDEX = WALL(IW)%SURF_INDEX + IF(.NOT.ALLOCATED(CF%CFACE_INDEX)) THEN; ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) + ELSEIF (SIZE(CF%CFACE_INDEX,DIM=1)/=CF%NFACE)THEN + DEALLOCATE(CF%CFACE_INDEX); ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) + ENDIF + IF(.NOT.ALLOCATED(CF%SURF_INDEX)) THEN; ALLOCATE(CF%SURF_INDEX(CF%NFACE)) + ELSEIF (SIZE(CF%SURF_INDEX,DIM=1)/=CF%NFACE)THEN + DEALLOCATE(CF%SURF_INDEX); ALLOCATE(CF%SURF_INDEX(CF%NFACE)) + ENDIF + + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) ENDDO ENDDO - LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) -ENDDO - -RETURN -END SUBROUTINE TRIANGULATE - -! ---------------------------- RAY_TRIANGLE_INTERSECT_PT ---------------------------------------- - -SUBROUTINE RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,D,IS_INTERSECT,POS) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - -! V1(3), V2(3), V3(3) triangle vertices coordinates. -! XP(3) -> Ray origin coordinates. -! D(3) -> Ray direction. -! OUTPUT : -! IS_INTERSECT, .TRUE. if these is intersection. -! POS(3), coordinates of intersection point. - -REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3),XP(3),D(3) -LOGICAL, INTENT(OUT):: IS_INTERSECT -REAL(EB), INTENT(OUT):: POS(3) - -REAL(EB) :: E1(3),E2(3),P(3),S(3),Q(3),U,V,TMP,T -REAL(EB), PARAMETER :: EPS=1.E-10_EB + MESHES(NM)%N_INTWALL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%INTERNAL_CFACE_CELLS_LB = MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%N_INTWALL_CFACE_CELLS + ! Define pointers among CC_INBOUNDARY CUT_FACE and CFACE (N_INTERNAL_CFACE_CELLS): + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + CF => MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS) + ! Don't count INB cut-faces inside an OBST: + IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + SURF_INDEX = CF%SURF_INDEX(IFACE) + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.TRUE.) + ENDDO + IF(ALLOCATED(CF%CFACE_ORIGIN)) DEALLOCATE(CF%CFACE_ORIGIN) + ENDDO + MESHES(NM)%N_INTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%INTERNAL_CFACE_CELLS_LB +ENDDO MESH_LOOP_1 -! Schneider and Eberly, Section 11.1 -IS_INTERSECT = .FALSE. -POS(1:3) = 1._EB/TWENTY_EPSILON_EB +! Second loop, apply VENTS to change SURF_ID associated with CFACEs: +MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) -E1 = V2-V1 -E2 = V3-V1 + ! ! Currently : Modify CFACE SURF_INDEX with VENT information: This needs more development. -CALL CROSS_PRODUCT(P,D,E2) + VENT_LOOP : DO IVENT=1,MESHES(NM)%N_VENT + VT => VENTS(IVENT) + IF(.NOT.VT%GEOM) CYCLE VENT_LOOP ! Do not apply vent to Geometries. -TMP = DOT_PRODUCT(P,E1) + ! This test is a simplified test for VENTS changing the CFACE SURF_ID to VENT SURF_ID for all CFACEs whose + ! centroid locations lay within the frame of the IOR grid aligned VENT: + ADDMAT = 0._EB; + SELECT CASE(ABS(VT%IOR)) + CASE(IAXIS) + ADDMAT(IAXIS,LOW_IND) = -(XF_MAX-XS_MIN) ! -DX(VT%I1) Set normal size to 2 times domain size. + ADDMAT(IAXIS,HIGH_IND) = (XF_MAX-XS_MIN) ! DX(VT%I2) XF_MAX, etc. defined in cons.f90. + CASE(JAXIS) + ADDMAT(JAXIS,LOW_IND) = -(YF_MAX-YS_MIN) ! -DY(VT%J1) + ADDMAT(JAXIS,HIGH_IND) = (YF_MAX-YS_MIN) ! DY(VT%J2) + CASE(KAXIS) + ADDMAT(KAXIS,LOW_IND) = -(ZF_MAX-ZS_MIN) ! -DZ(VT%K1) + ADDMAT(KAXIS,HIGH_IND) = (ZF_MAX-ZS_MIN) ! DZ(VT%K2) + END SELECT + ! CFACE Loop to modify SURF_INDEX in INTERNAL_CFACE_CELLS: + CFACE_LOOP_2 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + CFA => CFACE(CFACE_INDEX_LOCAL) + BC => BOUNDARY_COORD(CFA%BC_INDEX) + IF (BC%X < X(VT%I1)+ADDMAT(IAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%X > X(VT%I2)+ADDMAT(IAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + IF (BC%Y < Y(VT%J1)+ADDMAT(JAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%Y > Y(VT%J2)+ADDMAT(JAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + IF (BC%Z < Z(VT%K1)+ADDMAT(KAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%Z > Z(VT%K2)+ADDMAT(KAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + CFA%VENT_INDEX = IVENT + CFA%SURF_INDEX = VT%SURF_INDEX + ENDDO CFACE_LOOP_2 + ENDDO VENT_LOOP +ENDDO MESH_LOOP_2 +! - At this pont all final values of SURF_INDEX have been given to CFACEs. -IF ( ABS(TMP)0) THEN + ALLOCATE(FDS_AREA_GEOM(0:N_SURF,N_GEOMETRY)); FDS_AREA_GEOM = 0._EB +ENDIF +MESH_LOOP_3 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + CFA => CFACE(CFACE_INDEX_LOCAL) + ICF = CFA%CUT_FACE_IND1; IFACE= CFA%CUT_FACE_IND2 + I = CUT_FACE(ICF)%BODTRI(1,IFACE) + IF(I>0) FDS_AREA_GEOM(CFA%SURF_INDEX,I) = FDS_AREA_GEOM(CFA%SURF_INDEX,I) + CFA%AREA + ENDDO +ENDDO MESH_LOOP_3 +! Sum FDS and INPUT areas per SURF_ID and GEOM (all reduce sum): +IF(N_GEOMETRY>0) & +CALL MPI_ALLREDUCE(MPI_IN_PLACE, FDS_AREA_GEOM(0,1), (N_SURF+1)*N_GEOMETRY, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) -U = TMP*DOT_PRODUCT(S,P) -IF (U<-EPS .OR. U>(1._EB+EPS)) RETURN ! No intersection. +! Fourth Loop: Assign AREA_ADJUST for CFACEs, and assign BC info to CFACEs: +MESH_LOOP_4 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) -CALL CROSS_PRODUCT(Q,S,E1) -V = TMP*DOT_PRODUCT(D,Q) -IF (V<-EPS .OR. (U+V)>(1._EB+EPS)) RETURN ! No intersection. + ! BCs related information for INTERNAL CFACE CELLS: + CFACE_LOOP_4 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + ICF = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND1 + IFACE = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND2 + SURF_INDEX = CFACE(CFACE_INDEX_LOCAL)%SURF_INDEX + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_TWO,IS_INB=.TRUE.) + ENDDO CFACE_LOOP_4 -T = TMP*DOT_PRODUCT(E2,Q) -IF (T <= 0._EB) RETURN ! No intersection. +ENDDO MESH_LOOP_4 -IS_INTERSECT = .TRUE. -POS = XP + T*D ! the intersection point +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' + IF (MY_RANK==0) WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' +ENDIF RETURN -END SUBROUTINE RAY_TRIANGLE_INTERSECT_PT +END SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE -! ---------------------------- TRILINEAR ---------------------------------------- -REAL(EB) FUNCTION TRILINEAR(UU,DXI,LL) +! ------------------------- SET_GC_CUTCELLS_3D ----------------------------------- -REAL(EB), INTENT(IN) :: UU(0:1,0:1,0:1),DXI(3),LL(3) -REAL(EB) :: XX,YY,ZZ +SUBROUTINE SET_GC_CUTCELLS_3D -! Comments: -! -! see http://local.wasp.uwa.edu.au/~pbourke/miscellaneous/interpolation/index.html -! with appropriate scaling. LL is length of side. -! -! UU(1,1,1) -! z /----------/ -! ^/ / | -! ------------ | Particle position -! | | | -! LL(3) | o<-----|------- DXI = [DXI(1),DXI(2),DXI(3)] -! | | / -! | |/ Particle property at XX = TRILINEAR -! ------------> x -! ^ -! | -! X0 = [0,0,0] -! -! UU(0,0,0) -! -!=========================================================== +! Local Variables: +INTEGER :: IW,II,JJ,KK,IOR,IIO,JJO,KKO,IIF,JJF,KKF,IIOF,JJOF,KKOF,ICF,ICOF,X1AXIS,ICC,NMICC,NOFC,N_CF,N_CRT +REAL(EB):: XNM, XNOM +TYPE (WALL_TYPE), POINTER :: WC +TYPE (EXTERNAL_WALL_TYPE), POINTER :: EWC +LOGICAL :: WC_PERIODIC, TEST_ICC +REAL(EB):: AREA_NM, AREA_NOM, AREA_CRT -XX = DXI(1)/LL(1) -YY = DXI(2)/LL(2) -ZZ = DXI(3)/LL(3) -TRILINEAR = UU(0,0,0)*(1._EB-XX)*(1._EB-YY)*(1._EB-ZZ) + & - UU(1,0,0)*XX*(1._EB-YY)*(1._EB-ZZ) + & - UU(0,1,0)*(1._EB-XX)*YY*(1._EB-ZZ) + & - UU(0,0,1)*(1._EB-XX)*(1._EB-YY)*ZZ + & - UU(1,0,1)*XX*(1._EB-YY)*ZZ + & - UU(0,1,1)*(1._EB-XX)*YY*ZZ + & - UU(1,1,0)*XX*YY*(1._EB-ZZ) + & - UU(1,1,1)*XX*YY*ZZ +IF (CCGUARD == 0) RETURN -END FUNCTION TRILINEAR +IF(GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_SETCC,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' + ENDIF +ENDIF -! ---------------------------- POINT_IN_BB ---------------------------------------- +! Meshes Loop: +! First Mesh Loop: +! Test if NOM mesh cells are of the same size or smaller than NM mesh that areas match: +MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX -LOGICAL FUNCTION POINT_IN_BB(V1,BB) + IF (MESHES(NM)%N_CUTFACE_MESH==0) CYCLE MESH_LOOP_1 + CALL POINT_TO_MESH(NM) -REAL(EB), INTENT(IN) :: V1(3),BB(6) + EXTERNAL_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS -POINT_IN_BB=.FALSE. -IF ( V1(1)>=BB(1) .AND. V1(1)<=BB(2) .AND. & - V1(2)>=BB(3) .AND. V1(2)<=BB(4) .AND. & - V1(3)>=BB(5) .AND. V1(3)<=BB(6) ) THEN - POINT_IN_BB=.TRUE. - RETURN -ENDIF + WC=>WALL(IW) + EWC=>EXTERNAL_WALL(IW) + BC=>BOUNDARY_COORD(WC%BC_INDEX) + B1=>BOUNDARY_PROP1(WC%B1_INDEX) + IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & + WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_1 -RETURN -END FUNCTION POINT_IN_BB + II = BC%II + JJ = BC%JJ + KK = BC%KK + IOR = BC%IOR -! ---------------------------- POLYGON_AREA ---------------------------------------- + ! Skip if no cut-faces present on this WC: + ! Define underlying Cartesian faces indexes: + SELECT CASE(IOR) + CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-IAXIS) ! Higher X boundary for Mesh NM. + IIF = II - 1; JJF = JJ ; KKF = KK + CASE( JAXIS) ! Lower Y boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-JAXIS) ! Higher Y boundary for Mesh NM. + IIF = II ; JJF = JJ - 1; KKF = KK + CASE( KAXIS) ! Lower Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-KAXIS) ! Higher Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK - 1 + END SELECT + X1AXIS = ABS(IOR) + IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE EXTERNAL_WALL_LOOP_1 + + ! Gas cut-face area in wall-cell IW face: + ICF = FCVAR(IIF,JJF,KKF,CC_IDCF,X1AXIS) + AREA_NM = SUM(CUT_FACE(ICF)%AREA(1:CUT_FACE(ICF)%NFACE)) -REAL(EB) FUNCTION POLYGON_AREA(NP,PC) -! Calculate the area of a polygon + IF(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN + NOM = EWC%NOM ! Use Other Mesh Data. + IF(MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_1 + ! Now Obtain the CUT_FACE for the same face on NM-NOM: -INTEGER, INTENT(IN) :: NP -REAL(EB), INTENT(IN) :: PC(60) -INTEGER :: I,K -REAL(EB) :: V1(3),V2(3),V3(3) + AREA_NOM = 0._EB; N_CF=0; N_CRT=0 + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + SELECT CASE(IOR) + CASE( IAXIS) ! Lower X boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) + CASE(-IAXIS) ! Higher X boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO- 1; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) + CASE( JAXIS) ! Lower Y boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) + CASE(-JAXIS) ! Higher Y boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO ; JJOF= JJO- 1; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) + CASE( KAXIS) ! Lower Z boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) + CASE(-KAXIS) ! Higher Z boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO- 1; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) + END SELECT + IF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_FGSC,X1AXIS) == CC_GASPHASE) THEN + AREA_NOM = AREA_NOM + AREA_CRT + N_CRT = N_CRT + 1 + ELSEIF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) > 0) THEN ! there are gasphase cut-faces + ICOF = MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) + AREA_NOM = AREA_NOM + SUM(MESHES(NOM)%CUT_FACE(ICOF)%AREA(1:MESHES(NOM)%CUT_FACE(ICOF)%NFACE)) + N_CF = N_CF + 1 + ENDIF + ENDDO + ENDDO + ENDDO -POLYGON_AREA = 0._EB -V3 = POLYGON_CENTROID(NP,PC) + ! Check if: + ! 1. other mesh faces are more than one -> areas match. + ! 2. other mesh face and size of cartesian faces the same -> areas match. + ! 3. Left the case of fine mesh face with OMESH face coarse. + NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 + IF ( (NOFC > 1) .OR. (ABS(B1%AREA-AREA_CRT) < GEOMEPS) )THEN + IF(ABS(AREA_NM-AREA_NOM) > ADIFF_INFO_FACTOR*AREA_CRT) THEN + WRITE(LU_ERR,*) 'SET_GC_CUTCELLS_3D Error: MESH=',NM,', CUT_FACE=',ICF,' does not match OMESH=',& + NOM,', with CUT_FACEs,CRT_FACEs=',N_CF,N_CRT,', area difference=',& + ABS(AREA_NM-AREA_NOM),', GEOMEPS=',GEOMEPS + WRITE(LU_ERR,*) 'CUT FACE=',ICF,MESHES(NM)%CUT_FACE(ICF)%IJK(1:4),':',MESHES(NM)%CUT_FACE(ICF)%STATUS + ENDIF + ENDIF -DO I=1,NP - IF (I < NP) THEN - DO K=1,3 - V1(K) = PC((I-1)*3+K) - V2(K) = PC(I*3+K) - ENDDO - ELSE - DO K=1,3 - V1(K) = PC((I-1)*3+K) - V2(K) = PC(K) - ENDDO - ENDIF - POLYGON_AREA = POLYGON_AREA+TRIANGLE_AREA(V1,V2,V3) -ENDDO + ENDIF -RETURN -END FUNCTION POLYGON_AREA + ENDDO EXTERNAL_WALL_LOOP_1 -! ---------------------------- POLYGON_CENTROID ---------------------------------------- +ENDDO MESH_LOOP_1 -REAL(EB) FUNCTION POLYGON_CENTROID(NP,PC) -! Calculate the centroid of polygon vertices -DIMENSION :: POLYGON_CENTROID(3) -INTEGER, INTENT(IN) :: NP -REAL(EB), INTENT(IN) :: PC(60) -INTEGER :: I,K +! Second mesh loop: +! Define cut-cell data on guard-cell region to be communicated: +MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX -POLYGON_CENTROID = 0._EB -DO I=1,NP - DO K=1,3 - POLYGON_CENTROID(K) = POLYGON_CENTROID(K)+PC((I-1)*3+K)/NP - ENDDO -ENDDO + IF ((MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH)==0) CYCLE MESH_LOOP_2 -RETURN -END FUNCTION POLYGON_CENTROID + CALL POINT_TO_MESH(NM) -! ---------------------------- INTERSECT_SPHERE_AABB ---------------------------------------- + EXTERNAL_WALL_LOOP_2 : DO IW=1,N_EXTERNAL_WALL_CELLS -! Algorithm from Schneider and Eberly, p. 644 -! Intersection of Sphere and Axis-Aligned Bounding Box + WC=>WALL(IW) + BC=>BOUNDARY_COORD(WC%BC_INDEX) + EWC=>EXTERNAL_WALL(IW) + IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & + WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_2 -LOGICAL FUNCTION INTERSECT_SPHERE_AABB(X0,RADIUS,XB) + II = BC%II + JJ = BC%JJ + KK = BC%KK + IOR = BC%IOR + NOM = EWC%NOM ! Use Other Mesh Data. -REAL(EB), INTENT(IN) :: X0(3),RADIUS,XB(6) -REAL(EB) :: DIST_SQUARED + IF (NOM>0) THEN + IF (MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_2 + ENDIF -INTERSECT_SPHERE_AABB=.TRUE. + IF (WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN -! Compute distance in each direction, summing as we go -DIST_SQUARED = 0._EB -IF (X0(1)XB(2)) THEN - DIST_SQUARED = DIST_SQUARED + (X0(1)-XB(2))**2 -ENDIF -IF (X0(2)XB(4)) THEN - DIST_SQUARED = DIST_SQUARED + (X0(2)-XB(4))**2 -ENDIF -IF (X0(3)XB(6)) THEN - DIST_SQUARED = DIST_SQUARED + (X0(3)-XB(6))**2 -ENDIF + ! Skip if no cut-faces present on this WC: + ! Define underlying Cartesian faces indexes: + SELECT CASE(IOR) + CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-IAXIS) ! Higher X boundary for Mesh NM. + IIF = II - 1; JJF = JJ ; KKF = KK + CASE( JAXIS) ! Lower Y boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-JAXIS) ! Higher Y boundary for Mesh NM. + IIF = II ; JJF = JJ - 1; KKF = KK + CASE( KAXIS) ! Lower Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-KAXIS) ! Higher Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK - 1 + END SELECT + X1AXIS = ABS(IOR) + IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) CYCLE EXTERNAL_WALL_LOOP_2 -! Compare squared distance to radius squared -IF (DIST_SQUARED > (RADIUS*RADIUS-TWENTY_EPSILON_EB)) INTERSECT_SPHERE_AABB=.FALSE. + IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN + TEST_ICC = .TRUE. + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + TEST_ICC = TEST_ICC .AND. (MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) <= 0) + ENDDO + ENDDO + ENDDO -RETURN -END FUNCTION INTERSECT_SPHERE_AABB + NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) + ! Do test for PERIODIC boundaries. Note: PERIODIC boundaries at this point have been redefined as INTERPOLATED_BOUNDARY, + ! so we test using the Mesh center relative locations. + IF (WC%BOUNDARY_TYPE==INTERPOLATED_BOUNDARY .AND. NMICC > 0 .AND. TEST_ICC) THEN + WC_PERIODIC=.FALSE. + SELECT CASE(IOR) + CASE(-IAXIS) ! High X wall cell. + XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) + IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE( IAXIS) ! Low X wall cell. + XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) + IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE(-JAXIS) ! High Y wall cell. + XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) + IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE( JAXIS) ! Low Y wall cell. + XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) + IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE(-KAXIS) ! High Z wall cell. + XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) + IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE( KAXIS) ! Low Z wall cell. + XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) + IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + END SELECT + IF (WC_PERIODIC) THEN + MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) = 0 ! Set NMICC = 0. + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + IF(MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_CGSC)==CC_SOLID) THEN + MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC)=CC_SOLID ! set to Solid. + CYCLE EXTERNAL_WALL_LOOP_2 + ENDIF + ENDDO + ENDDO + ENDDO + ENDIF + ENDIF -! ---------------------------- INTERSECT_CYLINDER_AABB ---------------------------------------- + NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 + ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 + N_CF = 0 + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) + IF (ICC > 0) THEN + N_CF = N_CF + 1 + MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,N_CF) = (/ NOM, ICC /) + NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL + ! Add NCELL cut-cells to OM%NCC_R: + MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 + MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL + ENDIF + ENDDO + ENDDO + ENDDO + MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = N_CF + ENDIF -! Intersection of Cylinder and Axis-Aligned Bounding Box -! -! Cylinder is represented by: -! X_IN = bottom-center of cylinder (X,Y,Z) in grid reference frame -! H = length of cylinder -! RADIUS = radius of cylinder -! AX_VEC = unit vector pointing along cylinder axis (which leads to ROT_MAT using ROTATION_MATRIX) -! -! The basic algorithm is: -! 1. rotate the cylinder into a frame where the axis points in the vertical direction (+zbar in new frame) -! 2. find the vertex point locations of AABB in this new frame -! 3. test each vertex location against the end caps of cylinder -! 4. test each vertex against radius of cylinder + ! Here add cut or regular faces to every face on this wall cell: + ! This requires defining the sets of cut and regular faces within the area of each cut or + ! regular face. Option : Use POINT_IN_POLYGON with centroids. To do. -LOGICAL FUNCTION INTERSECT_CYLINDER_AABB(X_IN,H,RADIUS,ROTMAT,XB) + ELSEIF(WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) THEN + NOM = NM ! Use gas cell data, same mesh. + IIO = BC%IIG + JJO = BC%JJG + KKO = BC%KKG + ! CYCLE if OBJECT face is in the Mirror Boundary, normal out into ghost-cell: + SELECT CASE(IOR) + CASE( IAXIS) + IF(FCVAR(IIO-1,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE + CASE(-IAXIS) + IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE + CASE( JAXIS) + IF(FCVAR(IIO ,JJO-1,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE + CASE(-JAXIS) + IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE + CASE( KAXIS) + IF(FCVAR(IIO ,JJO ,KKO-1,CC_FGSC,KAXIS) == CC_SOLID) CYCLE + CASE(-KAXIS) + IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,KAXIS) == CC_SOLID) CYCLE + END SELECT + IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN + ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC); IF (ICC<1) CYCLE + NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) + NOFC = 1 + ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 + MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,NOFC) = (/ NOM, ICC /) + MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = NOFC + NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL + ! Add NCELL cut-cells to OM%NCC_R: + MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 + MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL + ENDIF + ENDIF -REAL(EB), INTENT(IN) :: X_IN(3),H,RADIUS,ROTMAT(3,3),XB(6) -REAL(EB) :: X(3),U(3),V(3),DUX(2),Z0,ZH,R2,DIST_SQUARED -INTERSECT_CYLINDER_AABB=.FALSE. + ENDDO EXTERNAL_WALL_LOOP_2 -X = MATMUL(ROTMAT,X_IN) ! transform center -Z0 = X(3) ! lower cap in new reference frame -ZH = X(3) + H ! upper cap in new reference frame +ENDDO MESH_LOOP_2 -! transform vertices and test against end caps, then radius -R2 = RADIUS*RADIUS -V = (/0.5_EB*(XB(1)+XB(2)),0.5_EB*(XB(3)+XB(4)),0.5_EB*(XB(5)+XB(6))/) -U = MATMUL(ROTMAT,V) -IF (U(3)>=Z0 .AND. U(3)<=ZH) THEN - ! centroid is within end-cap range, now test against radius - ! in new frame the distance from centroid to cylinder axis only requires the 1st and 2nd vector components - DUX = U(1:2) - X(1:2) - DIST_SQUARED = DOT_PRODUCT(DUX,DUX) - IF (DIST_SQUARED < R2+TWENTY_EPSILON_EB) THEN - INTERSECT_CYLINDER_AABB = .TRUE. - RETURN +IF(GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' ENDIF ENDIF RETURN -END FUNCTION INTERSECT_CYLINDER_AABB -! ---------------------------- ROTATION_MATRIX ---------------------------------------- +END SUBROUTINE SET_GC_CUTCELLS_3D -SUBROUTINE ROTATION_MATRIX(R_OUT,A_IN,THETA) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -REAL(EB), INTENT(OUT) :: R_OUT(3,3) -REAL(EB), INTENT(IN) :: A_IN(3),THETA -REAL(EB) :: A(3),C,DENOM,V(3),A1(3),A2(3),A3(3),B1(3),B2(3),B3(3),R_THETA(3,3) +! --------------------------- GET_GEOM_TRIBIN -------------------------------------- -! initialize 2D rotation matrix -! this is a counterclockwise rotation -R_THETA = 0._EB -R_THETA(1,1) = COS(THETA*DEG2RAD); R_THETA(1,2) = SIN(THETA*DEG2RAD) -R_THETA(2,1) = -SIN(THETA*DEG2RAD); R_THETA(2,2) = COS(THETA*DEG2RAD) -R_THETA(3,3) = 1._EB +SUBROUTINE GET_GEOM_TRIBIN -! initialize R_OUT as 2D rotation matrix -R_OUT = R_THETA +! This routine separates lists of triangles for each GEOMETRY in interval +! bins in each direction. They are used in SET_CUTCELLS_3D/GET_BODINT_PLANE to optimize +! cut-cell generation. -! normalize input vector -DENOM = SQRT(DOT_PRODUCT(A_IN,A_IN)) -IF (DENOM 0) THEN + CC_COMPUTE_MESH(NOM)=.TRUE. ! There are cells from mesh NOM that are guardcells of mesh NM. + ! Min-max locations of MESH + halo region. + IG = MESHES(NOM)%IBAR + MINMAX_MESHES( LOW_IND,IAXIS) = MIN(MINMAX_MESHES( LOW_IND,IAXIS),MESHES(NOM)%XS-REAL(NGUARD,EB)*MESHES(NOM)%DX( 1)) + MINMAX_MESHES(HIGH_IND,IAXIS) = MAX(MINMAX_MESHES(HIGH_IND,IAXIS),MESHES(NOM)%XF+REAL(NGUARD,EB)*MESHES(NOM)%DX(IG)) + IG = MESHES(NOM)%JBAR + MINMAX_MESHES( LOW_IND,JAXIS) = MIN(MINMAX_MESHES( LOW_IND,JAXIS),MESHES(NOM)%YS-REAL(NGUARD,EB)*MESHES(NOM)%DY( 1)) + MINMAX_MESHES(HIGH_IND,JAXIS) = MAX(MINMAX_MESHES(HIGH_IND,JAXIS),MESHES(NOM)%YF+REAL(NGUARD,EB)*MESHES(NOM)%DY(IG)) + IG = MESHES(NOM)%KBAR + MINMAX_MESHES( LOW_IND,KAXIS) = MIN(MINMAX_MESHES( LOW_IND,KAXIS),MESHES(NOM)%ZS-REAL(NGUARD,EB)*MESHES(NOM)%DZ( 1)) + MINMAX_MESHES(HIGH_IND,KAXIS) = MAX(MINMAX_MESHES(HIGH_IND,KAXIS),MESHES(NOM)%ZF+REAL(NGUARD,EB)*MESHES(NOM)%DZ(IG)) + ENDIF + ENDDO +ENDDO -IF (DOT_PRODUCT(V,V)0._EB) THEN - RETURN - ELSE - R_OUT = -R_OUT - RETURN - ENDIF -ENDIF -! find orthnormal basis for A=A3 in old system +! Loop geometries: +LOOP_GEOM : DO IG = 1, N_GEOMETRY -A3 = A -CALL CROSS_PRODUCT(A2,B3,A3) -CALL CROSS_PRODUCT(A1,A2,A3) + G=>GEOMETRY(IG) -! rotation matrix (direction cosines), Pope (2000), Eq. (A.11) + ! Define EDGE sizes and FACE cointaining boxes: + G%MAX_LEDGE = GEOMEPS ! Initialize to a small number. + G%MIN_LEDGE = 1._EB/GEOMEPS ! Initialize to a large number. + G%MEAN_LEDGE= 0._EB ! Initialize to 0. -R_OUT(1,1) = DOT_PRODUCT(A1,B1); R_OUT(1,2) = DOT_PRODUCT(A1,B2); R_OUT(1,3) = DOT_PRODUCT(A1,B3) -R_OUT(2,1) = DOT_PRODUCT(A2,B1); R_OUT(2,2) = DOT_PRODUCT(A2,B2); R_OUT(2,3) = DOT_PRODUCT(A2,B3) -R_OUT(3,1) = DOT_PRODUCT(A3,B1); R_OUT(3,2) = DOT_PRODUCT(A3,B2); R_OUT(3,3) = DOT_PRODUCT(A3,B3) + ! Loop Faces: + DO IWSEL = 0,G%N_FACES-1 + WSELEM(NOD1:NOD3) = G%FACES(3*IWSEL+1:3*IWSEL+3) -R_OUT = MATMUL(R_OUT,R_THETA) + ! Obtain edges length, test against MAX_LEDGE: + DO IEDGE=1,3 + ! DX = XYZ2 - XYZ1: + DXYZE(IAXIS:KAXIS) = G%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) - & + G%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) + LEDGE = sqrt( DXYZE(IAXIS)**2._EB + DXYZE(JAXIS)**2._EB + DXYZE(KAXIS)**2._EB ) -! ! test -! print *,R_OUT(1,:) -! print *,R_OUT(2,:) -! print *,R_OUT(3,:) -! print *,MATMUL(R_OUT,A) ! result should be B3 -! stop + G%MAX_LEDGE = MAX(G%MAX_LEDGE,LEDGE) + G%MIN_LEDGE = MIN(G%MIN_LEDGE,LEDGE) + G%MEAN_LEDGE= G%MEAN_LEDGE + LEDGE -END SUBROUTINE ROTATION_MATRIX + WSELEM=CSHIFT(WSELEM,1) ! Shift cyclically array by 1 entry. This rotates nodes connectivities. + ! i.e: initially WSELEM=(/1,2,3/), 1st call gives WSELEM=(/2,3,1/), 2nd + ! call gives WSELEM=(/3,1,2/). + ENDDO -! ---------------------------- INTERSECT_CONE_AABB ---------------------------------------- + ENDDO + ! Mean length of Edge: + G%MEAN_LEDGE = G%MEAN_LEDGE / REAL(G%N_FACES*EDGS_WSEL,EB) !Num EDGES summed in NUM_FACES * NUM edges on a face. -! This routine basically follows the INTERSECT_CYLINDER_AABB algorithm, with radius = R(Z) + ! Now define Bin sizes to distribute Faces subsets: + DO X1AXIS=IAXIS,KAXIS -LOGICAL FUNCTION INTERSECT_CONE_AABB(X_IN,H,RADIUS,ROTMAT,XB) + ! Here reduce the X1_LOW to X1_HIGH distance to the smallest of FDS Mesh and connected meshes BBOX or Geometry: + MIN_MESHGEOM = MAX(MINMAX_MESHES( LOW_IND,X1AXIS),G%GEOM_BOX( LOW_IND,X1AXIS)-G%MEAN_LEDGE) + MAX_MESHGEOM = MIN(MINMAX_MESHES(HIGH_IND,X1AXIS),G%GEOM_BOX(HIGH_IND,X1AXIS)+G%MEAN_LEDGE) + LX1 = MAX_MESHGEOM - MIN_MESHGEOM -REAL(EB), INTENT(IN) :: X_IN(3),H,RADIUS,ROTMAT(3,3),XB(6) -REAL(EB) :: X(3),U(3),V(3),DUX(2),Z0,ZH,DIST_SQUARED,R_Z -INTEGER :: II,JJ,KK + ! Define number of bins in direction X1AXIS: + G%TBAXIS(X1AXIS)%N_BINS = CEILING(LX1/(GAMMA_MULT*G%MEAN_LEDGE)) -INTERSECT_CONE_AABB=.FALSE. + ! No overlap between procs meshes and Geometry, cycle: + IF (G%TBAXIS(X1AXIS)%N_BINS < 1) THEN; G%TBAXIS(X1AXIS)%N_BINS = 0; CYCLE; ENDIF -X = MATMUL(ROTMAT,X_IN) ! transform center -Z0 = X(3) ! lower cap in new reference frame -ZH = X(3) + H ! upper cap in new reference frame + DELTA_TBIN2 = MAX(DELTA_TBIN,CEILING(0.05_EB*LX1/(G%GEOM_BOX(HIGH_IND,X1AXIS)-G%GEOM_BOX(LOW_IND,X1AXIS))*& + REAL(G%N_FACES,EB)/REAL(G%TBAXIS(X1AXIS)%N_BINS+1,EB))) -! transform vertices and test against end caps, then radius -DO KK=5,6 - DO JJ=3,4 - DO II=1,2 - V = (/XB(II),XB(JJ),XB(KK)/) - U = MATMUL(ROTMAT,V) - IF (U(3)>=Z0 .AND. U(3)<=ZH) THEN - ! vertex is within end-cap range, now test against radius - ! in new frame the distance from vertex to CONE axis only requires the 1st and 2nd vector components - DUX = U(1:2) - X(1:2) - DIST_SQUARED = DOT_PRODUCT(DUX,DUX) - R_Z = RADIUS*(1._EB-(U(3)-Z0)/H) - IF (DIST_SQUARED < R_Z*R_Z+TWENTY_EPSILON_EB) THEN - INTERSECT_CONE_AABB = .TRUE. - RETURN + ! Allocate TRIBIN field: + IF(ALLOCATED(G%TBAXIS(X1AXIS)%TRIBIN)) DEALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN) + ALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN(1:G%TBAXIS(X1AXIS)%N_BINS)) + + ! Set BIN boundaries and make initial allocation of TRI_LIST for each bin: + DELBIN = LX1 / REAL(G%TBAXIS(X1AXIS)%N_BINS,EB) + G%TBAXIS(X1AXIS)%DELBIN = DELBIN + DO IBIN=1,G%TBAXIS(X1AXIS)%N_BINS + G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW = MIN_MESHGEOM + REAL(IBIN-1,EB)*DELBIN + G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH = MIN_MESHGEOM + REAL(IBIN ,EB)*DELBIN + G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL = 0 + ALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(DELTA_TBIN2)) + ENDDO + + ! Finally, populate TRI_LIST for X1AXIS bins: + DO IWSEL = 0,G%N_FACES-1 + WSELEM(NOD1:NOD3) = G%FACES(3*IWSEL+1:3*IWSEL+3) + X1V(NOD1:NOD3) = G%VERTS(MAX_DIM*(WSELEM(NOD1:NOD3)-1)+X1AXIS) + X1V_LO = MINVAL(X1V(NOD1:NOD3)); + X1V_HI = MAXVAL(X1V(NOD1:NOD3)); + ILO_BIN = MAX(1,CEILING((X1V_LO-GEOMEPS-MIN_MESHGEOM)/DELBIN)) + IHI_BIN = MIN(G%TBAXIS(X1AXIS)%N_BINS,CEILING((X1V_HI+GEOMEPS-MIN_MESHGEOM)/DELBIN)) + DO IBIN=ILO_BIN,IHI_BIN + NTL = G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL + 1 + SZE = SIZE(G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST,DIM=1) + IF (NTL > SZE) THEN + ! Reallocate: + ALLOCATE(TRI_LIST(1:SZE+DELTA_TBIN2)); + TRI_LIST(1:SZE)=G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) + CALL MOVE_ALLOC(FROM=TRI_LIST,TO=G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST) ENDIF - ENDIF + ! Add Triangle index to BINs TRI_LIST + G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL = NTL + G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(NTL) = IWSEL+1 + + ENDDO ENDDO - ENDDO -ENDDO + END DO + + ! WRITE(LU_ERR,*) 'GEOMETRY=',IG,'NBINS=',G%TBAXIS(IAXIS)%N_BINS,G%TBAXIS(JAXIS)%N_BINS,G%TBAXIS(KAXIS)%N_BINS + ! DO X1AXIS=IAXIS,KAXIS + ! DO IBIN=1,G%TBAXIS(X1AXIS)%N_BINS + ! WRITE(LU_ERR,*) X1AXIS,'IBIN, NTL=',IBIN,G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL, & + ! G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW,G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH + ! END DO + ! END DO + +ENDDO LOOP_GEOM RETURN -END FUNCTION INTERSECT_CONE_AABB +END SUBROUTINE GET_GEOM_TRIBIN -! ---------------------------- INTERSECT_OBB_AABB ---------------------------------------- -! Intersect an Oriented Bounding Box (OBB) with an Axis-Aligned Bounding Box (AABB) -! First, rotate AABB into OBB frame. -! Then test each vertex. +! --------------------------- SNAP_GEOM_NODES -------------------------------------- -LOGICAL FUNCTION INTERSECT_OBB_AABB(X_IN,L,W,H,ROTMAT,XB) +SUBROUTINE SNAP_GEOM_NODES -REAL(EB), INTENT(IN) :: X_IN(3),L,W,H,ROTMAT(3,3),XB(6) -REAL(EB) :: X(3),U(3),V(3),X0,XL,Y0,YW,Z0,ZH -INTEGER :: II,JJ,KK +INTEGER :: IBIN,IWSELDUM,IWSEL,WSELEM(NOD1:NOD3),X1LO,X1HI,X1IND,ILO_BIN,IHI_BIN +REAL(EB):: MIN_MESHGEOM,DELBIN +REAL(EB) :: CPUTIME_START, CPUTIME -INTERSECT_OBB_AABB=.FALSE. +IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_ERR,'(A)',advance="no") ' 1a. Snap node position to grid planes : SNAP_GEOM_NODES' +ENDIF -X = MATMUL(ROTMAT,X_IN) ! transform center -X0 = X(1) - 0.5_EB*L - TWENTY_EPSILON_EB -XL = X(1) + 0.5_EB*L + TWENTY_EPSILON_EB -Y0 = X(2) - 0.5_EB*W - TWENTY_EPSILON_EB -YW = X(2) + 0.5_EB*W + TWENTY_EPSILON_EB -Z0 = X(3) - 0.5_EB*H - TWENTY_EPSILON_EB -ZH = X(3) + 0.5_EB*H + TWENTY_EPSILON_EB +! Main Loop over Geometries, set nodes to SNAP_NODE=T: +MAIN_GEOM_LOOP_1 : DO IG=1,N_GEOMETRY + ALLOCATE(GEOMETRY(IG)%SNAP_NODE(IAXIS:KAXIS,1:GEOMETRY(IG)%N_VERTS)); GEOMETRY(IG)%SNAP_NODE = .FALSE. + AXIS_LOOP_1 : DO X1AXIS=IAXIS,KAXIS + IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE + ! Run all bin on this geometry and set nodes involved to SNAP_NODE=T: + IBIN_DO_1 : DO IBIN=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS + ! Loop surface triangles: + DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL + IWSEL=GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(IWSELDUM) + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(MAX_DIM*(IWSEL-1)+1:MAX_DIM*IWSEL) + GEOMETRY(IG)%SNAP_NODE(X1AXIS, (/WSELEM(NOD1:NOD3)/) ) = .TRUE. ! Set nodes to test for snapping to grid planes. + ENDDO + ENDDO IBIN_DO_1 + ENDDO AXIS_LOOP_1 +ENDDO MAIN_GEOM_LOOP_1 -! transform and test vertices (probably a more efficient way, but just to get going...) -DO KK=5,6 - DO JJ=3,4 - DO II=1,2 - V = (/XB(II),XB(JJ),XB(KK)/) - U = MATMUL(ROTMAT,V) - IF (U(1)>X0 .AND. U(1)Y0 .AND. U(2)Z0 .AND. U(3) MESHES(NM) + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + ! Run by coordinate direction, define planes X1PLN on this mesh, look for involved GEOMETRY vertices using TBAXIS and + ! after positive test of SNAP_NODE check if node is to be snapped to plane. + AXIS_LOOP_2 : DO X1AXIS=IAXIS,KAXIS -! ---------------------------- AVERAGE_FACE_VALUES ---------------------------------------- + SELECT CASE(X1AXIS) + CASE(IAXIS) + X1LO = ILO_FACE-CCGUARD; X1HI = IHI_FACE+CCGUARD + ALLOCATE(X1FACE(ISTR:IEND),DX1FACE(ISTR:IEND)); X1FACE = XFACE; DX1FACE = DXFACE + CASE(JAXIS) + X1LO = JLO_FACE-CCGUARD; X1HI = JHI_FACE+CCGUARD + ALLOCATE(X1FACE(JSTR:JEND),DX1FACE(JSTR:JEND)); X1FACE = YFACE; DX1FACE = DYFACE + CASE(KAXIS) + X1LO = KLO_FACE-CCGUARD; X1HI = KHI_FACE+CCGUARD + ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)); X1FACE = ZFACE; DX1FACE = DZFACE + END SELECT -! for each node, compute the average values of faces connected to that node + ! Loop planes in X1AXIS direction: + X1PLN_LOOP : DO X1IND=X1LO,X1HI + X1PLN = X1FACE(X1IND) ! Plane position. + MAIN_GEOM_LOOP_2 : DO IG=1,N_GEOMETRY + IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE + DELBIN = GEOMETRY(IG)%TBAXIS(X1AXIS)%DELBIN + MIN_MESHGEOM = GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(1)%X1_LOW + ILO_BIN = MAX(1,CEILING((X1PLN-GEOMEPS-MIN_MESHGEOM)/DELBIN)) + IHI_BIN = MIN(GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS,CEILING((X1PLN+GEOMEPS-MIN_MESHGEOM)/DELBIN)) + IBIN_DO_2 : DO IBIN=ILO_BIN,IHI_BIN + IF ( X1PLN < GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE + IF ( X1PLN > GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE + ! Loop surface triangles: + DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL + IWSEL=GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(IWSELDUM) + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(MAX_DIM*(IWSEL-1)+1:MAX_DIM*IWSEL) + ! Triangles NODES coordinates: + DO INOD=NOD1,NOD3 + IF(.NOT.GEOMETRY(IG)%SNAP_NODE(X1AXIS,WSELEM(INOD))) CYCLE + ! Do test to snap to: + IF(ABS(GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+X1AXIS)-X1PLN) < SNAP_DIST_FACTOR*DX1FACE(X1IND) ) THEN + GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+X1AXIS) = X1PLN ! Set node position to plane value. + GEOMETRY(IG)%SNAP_NODE(X1AXIS,WSELEM(INOD)) = .FALSE. ! No need to snap again. + ENDIF + ENDDO + ENDDO + ENDDO IBIN_DO_2 + ENDDO MAIN_GEOM_LOOP_2 + ENDDO X1PLN_LOOP -SUBROUTINE AVERAGE_FACE_VALUES(VERT_UNIQUE, VERT_VALS, NVERTS, FACES, FACE_VALS, NFACES) -INTEGER, INTENT(IN) :: NVERTS, NFACES -INTEGER, INTENT(IN), TARGET :: FACES(3*NFACES), VERT_UNIQUE(NVERTS) -REAL(FB), INTENT(IN) :: FACE_VALS(NFACES) -REAL(FB), INTENT(OUT) :: VERT_VALS(NVERTS) + DEALLOCATE(X1FACE,DX1FACE) -INTEGER, DIMENSION(:), POINTER :: V -INTEGER :: I -INTEGER :: COUNT(NVERTS) + ENDDO AXIS_LOOP_2 + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +ENDDO MAIN_MESH_LOOP -VERT_VALS(1:NVERTS) = 0.0_FB -COUNT(1:NVERTS) = 0 -DO I = 1, NFACES - V(1:3) => FACES(3*I-2:3*I) - V(1:3) = VERT_UNIQUE(V(1:3)) - VERT_VALS(V(1)) = VERT_VALS(V(1)) + FACE_VALS(I) - COUNT(V(1)) = COUNT(V(1)) + 1 - VERT_VALS(V(2)) = VERT_VALS(V(2)) + FACE_VALS(I) - COUNT(V(2)) = COUNT(V(2)) + 1 - VERT_VALS(V(3)) = VERT_VALS(V(3)) + FACE_VALS(I) - COUNT(V(3)) = COUNT(V(3)) + 1 -ENDDO -DO I = 1, NVERTS - IF (COUNT(I) .GT. 1) VERT_VALS(I) = VERT_VALS(I)/REAL(COUNT(I), FB) -ENDDO -DO I = 1, NVERTS - IF (VERT_UNIQUE(I) .NE. I) VERT_VALS(I) = VERT_VALS(VERT_UNIQUE(I)) +! Deallocate SNAP_NODE in geometries: +DO IG=1,N_GEOMETRY + DEALLOCATE(GEOMETRY(IG)%SNAP_NODE) ENDDO -END SUBROUTINE AVERAGE_FACE_VALUES +IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN + WRITE(LU_ERR,'(A)',advance="no") '.. done.' + CALL CPU_TIME(CPUTIME) + WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken : ',CPUTIME-CPUTIME_START,' sec.' +ENDIF +END SUBROUTINE SNAP_GEOM_NODES -! ---------------------------- MAKE_UNIQUE_VERT_ARRAY ---------------------------------------- +SUBROUTINE CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) -! construct an array that points to first vertex in a vertex array when one or more vertices are identical +INTEGER, INTENT(IN) :: NM,ISTR,IEND,JSTR,JEND,KSTR,KEND +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX -SUBROUTINE MAKE_UNIQUE_VERT_ARRAY(VERTS, VERT_UNIQUE, NVERTS) -INTEGER, INTENT(IN) :: NVERTS -REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) -INTEGER, INTENT(OUT) :: VERT_UNIQUE(NVERTS) +! Initialize CC_IBM arrays for mesh NM: +! Vertices: +IF (.NOT. ALLOCATED(MESHES(NM)%VERTVAR)) & + ALLOCATE(MESHES(NM)%VERTVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NVVARS)) +MESHES(NM)%VERTVAR = 0 +MESHES(NM)%VERTVAR(:,:,:,CC_VGSC) = CC_GASPHASE -INTEGER :: PERM(NVERTS) -INTEGER :: I, RESULT +! Cartesian Edges: +IF (.NOT. ALLOCATED(MESHES(NM)%ECVAR)) & + ALLOCATE(MESHES(NM)%ECVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NEVARS,MAX_DIM)) +MESHES(NM)%ECVAR = 0 +MESHES(NM)%ECVAR(:,:,:,CC_EGSC,:) = CC_GASPHASE -DO I = 1, NVERTS - PERM(I) = I - VERT_UNIQUE(I) = I -ENDDO -CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, 1, NVERTS) +! Cartesian Faces: +IF (.NOT. ALLOCATED(MESHES(NM)%FCVAR)) & + ALLOCATE(MESHES(NM)%FCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NFVARS,MAX_DIM)) +MESHES(NM)%FCVAR = 0 +MESHES(NM)%FCVAR(:,:,:,CC_FGSC,:) = CC_GASPHASE -DO I = 1, NVERTS - 1 - CALL COMPARE_VERTS(VERTS, NVERTS, PERM(I), PERM(I+1), RESULT) - IF (RESULT == 0) VERT_UNIQUE(PERM(I+1)) = VERT_UNIQUE(PERM(I)) -END DO +! Cartesian Cells: +IF (.NOT. ALLOCATED(MESHES(NM)%CCVAR)) & + ALLOCATE(MESHES(NM)%CCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NCVARS)) +MESHES(NM)%CCVAR = 0 +MESHES(NM)%CCVAR(:,:,:,CC_CGSC) = CC_GASPHASE -END SUBROUTINE MAKE_UNIQUE_VERT_ARRAY +! When TERRAIN_CASE = TRUE, allocate GEOM_ZMAX for the mesh: +IF (TERRAIN_CASE) THEN + ALLOCATE(GEOM_ZMAX_AUX(ISTR:IEND,JSTR:JEND)) + GEOM_ZMAX_AUX = -1._EB/GEOMEPS +ENDIF -! ---------------------------- COMPARE_VERTS ---------------------------------------- +! Write mesh number allocation if GET_CUTCELLS_VERBOSE: +IF (GET_CUTCELLS_VERBOSE) THEN + WRITE(LU_SETCC,'(A)') ' ' + WRITE(LU_SETCC,'(A,I5,A,I10)') ' Processing Mesh : ',NM + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A)') ' ' + WRITE(LU_ERR,'(A,I5,A,I10)') ' Processing Mesh : ',NM + ENDIF +ENDIF -! returns -1, 0, 1 when a vertex I is less than, the same or greater than vertex J +! Here we have to allocate the size of MESHES(NM)%EDGE_CROSS: +MESHES(NM)%N_EDGE_CROSS = 0 ! Reset EDCROSS counter for mesh NM. +IF (ALLOCATED(MESHES(NM)%EDGE_CROSS)) DEALLOCATE(MESHES(NM)%EDGE_CROSS) +ALLOCATE(MESHES(NM)%EDGE_CROSS(GLOBAL_DELTA_EDGE)) -SUBROUTINE COMPARE_VERTS(VERTS, NVERTS, I, J, RESULT) -INTEGER, INTENT(IN) :: NVERTS -REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) -INTEGER, INTENT(IN) :: I, J -INTEGER, INTENT(OUT) :: RESULT -REAL(FB) :: TOLERANCE=0.00001_FB +! Here we have to allocate the size of MESHES(NM)%CUT_EDGE: +MESHES(NM)%N_CUTEDGE_MESH = 0 ! Reset CUTEDGE counter for mesh NM. +IF (ALLOCATED(MESHES(NM)%CUT_EDGE)) DEALLOCATE(MESHES(NM)%CUT_EDGE) +ALLOCATE(MESHES(NM)%CUT_EDGE(GLOBAL_DELTA_EDGE)) -IF (VERTS(3*I-2) < VERTS(3*J-2) - TOLERANCE) THEN - RESULT = -1 - RETURN -ENDIF -IF (VERTS(3*I-2) > VERTS(3*J-2) + TOLERANCE) THEN - RESULT = 1 - RETURN -ENDIF -IF (VERTS(3*I-1) < VERTS(3*J-1) - TOLERANCE) THEN - RESULT = -1 - RETURN -ENDIF -IF (VERTS(3*I-1) > VERTS(3*J-1) + TOLERANCE) THEN - RESULT = 1 - RETURN -ENDIF -IF (VERTS(3*I ) < VERTS(3*J ) - TOLERANCE) THEN - RESULT = -1 - RETURN -ENDIF -IF (VERTS(3*I ) > VERTS(3*J ) + TOLERANCE) THEN - RESULT = 1 - RETURN -ENDIF -RESULT = 0 -RETURN -END SUBROUTINE COMPARE_VERTS +! Here we have to allocate the size of MESHES(NM)%CUT_FACE: +MESHES(NM)%N_CUTFACE_MESH = 0 ! Reset CUTFACE counter for mesh NM. +MESHES(NM)%N_BBCUTFACE_MESH = 0 +MESHES(NM)%N_GCCUTFACE_MESH = 0 +IF (ALLOCATED(MESHES(NM)%CUT_FACE)) DEALLOCATE(MESHES(NM)%CUT_FACE) +ALLOCATE(MESHES(NM)%CUT_FACE(GLOBAL_DELTA_FACE)) + +! Here we have to allocate the size of MESHES(NM)%CUT_CELL: +MESHES(NM)%N_CUTCELL_MESH = 0 ! Reset CUTCELL counter for mesh NM. +MESHES(NM)%N_GCCUTCELL_MESH = 0 +IF (ALLOCATED(MESHES(NM)%CUT_CELL)) DEALLOCATE(MESHES(NM)%CUT_CELL) +ALLOCATE(MESHES(NM)%CUT_CELL(GLOBAL_DELTA_CELL)) -! ---------------------------- MAKE_PERMUTATION_ARRAY ---------------------------------------- +! Allocate array for special cells containing geometry intersections: +ALLOCATE(CELLRT(ISTR:IEND,JSTR:JEND,KSTR:KEND)) +CELLRT(:,:,:) = .FALSE. -! sort a vertex array in increasing order and store the order in a permutation array -! PERM(1) is the 1st vertex, PERM(2) is the 2nd and so on +! List of special cells to block (either from GET_CARTCELL_CUTCELLS or +! cells flagged as polyline could not be built in GET_CARTCELL_CUTFACES): +ALLOCATE(SPCELLS_TO_BLOCK(1:GLOBAL_DELTA_CELL)) +N_SPCELLS_TO_BLOCK = 0 +MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) -RECURSIVE SUBROUTINE MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, FIRST, LAST) -INTEGER, INTENT(IN) :: NVERTS -REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) -INTEGER, INTENT(INOUT) :: PERM(NVERTS) -INTEGER, INTENT(IN) :: FIRST, LAST -INTEGER :: PERM_COPY(NVERTS) -INTEGER RESULT +END SUBROUTINE CC_GRID_INIT_MESH_STORAGE -INTEGER :: MID, I, I1, I2, IP1, IP2, N, N1, N2 -IF (FIRST .EQ. LAST)RETURN ! only one element in list so don't need to sort +SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) -! FIRST .... LAST original list -! FIRST ... MID first half of list -! MID+1 ... LAST 2nd half of list +INTEGER, INTENT(IN) :: NM +INTEGER, ALLOCATABLE, DIMENSION(:) :: SPCELLS_TO_BLOCK_TMP -MID = (FIRST + LAST)/2 +MESHES(NM)%N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) -CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, FIRST, MID) ! sort first half of list -CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, MID+1, LAST) ! sort 2nd half of list +IF (N_SPCELLS_TO_BLOCK < 1) THEN + IF (ALLOCATED(SPCELLS_TO_BLOCK)) DEALLOCATE(SPCELLS_TO_BLOCK) + RETURN +ENDIF -! combine two lists into one -I1 = 1 -I2 = 1 -N1 = MID + 1 - FIRST -N2 = LAST - MID -N = LAST + 1 - FIRST -DO I = 1, N - IF (I1 .GT. N1 ) THEN ! no more in 1st half so copy item from 2nd half - IP2 = PERM(MID + I2) - PERM_COPY(I) = IP2 - I2 = I2 + 1 - CYCLE - ENDIF +IF (SIZE(SPCELLS_TO_BLOCK,DIM=1) > N_SPCELLS_TO_BLOCK) THEN + ALLOCATE(SPCELLS_TO_BLOCK_TMP(1:N_SPCELLS_TO_BLOCK)) + SPCELLS_TO_BLOCK_TMP(1:N_SPCELLS_TO_BLOCK) = SPCELLS_TO_BLOCK(1:N_SPCELLS_TO_BLOCK) + DEALLOCATE(SPCELLS_TO_BLOCK) + CALL MOVE_ALLOC(FROM=SPCELLS_TO_BLOCK_TMP,TO=MESHES(NM)%SPCELLS_TO_BLOCK) +ELSE + CALL MOVE_ALLOC(FROM=SPCELLS_TO_BLOCK,TO=MESHES(NM)%SPCELLS_TO_BLOCK) +ENDIF - IF (I2 .GT. N2 ) THEN ! no more in 2nd half so copy item from first half - IP1 = PERM(FIRST + I1 - 1) - PERM_COPY(I) = IP1 - I1 = I1 + 1 - CYCLE - ENDIF +END SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK - IP1 = PERM(FIRST + I1 - 1) - IP2 = PERM(MID + I2) - CALL COMPARE_VERTS(VERTS, NVERTS, IP1, IP2, RESULT) - IF (RESULT .EQ. -1) THEN ! sort in increasing order - PERM_COPY(I) = IP1 - I1 = I1 + 1 - ELSE - PERM_COPY(I) = IP2 - I2 = I2 + 1 - ENDIF -END DO -DO I = 1, N - PERM(FIRST + I - 1) = PERM_COPY(I) -END DO -END SUBROUTINE MAKE_PERMUTATION_ARRAY +SUBROUTINE CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) -END MODULE COMPLEX_GEOMETRY +INTEGER, INTENT(IN) :: NM +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX +INTEGER :: I,J +! Case of terrain, populate GEOM_ZMAX: +IF (.NOT.TERRAIN_CASE) RETURN -!> \brief Grid related complex-geometry routines. +IF (ALLOCATED(MESHES(NM)%GEOM_ZMAX)) DEALLOCATE(MESHES(NM)%GEOM_ZMAX) +ALLOCATE(MESHES(NM)%GEOM_ZMAX(0:IBAR,0:JBAR)) +DO J=0,JBAR + DO I=0,IBAR + ! Clip at ZS-DZ(1): + MESHES(NM)%GEOM_ZMAX(I,J) = MAX(ZFACE(-1),GEOM_ZMAX_AUX(I,J)) + ENDDO +ENDDO +DEALLOCATE(GEOM_ZMAX_AUX) -MODULE COMPLEX_GEOMETRY_GRID +END SUBROUTINE CC_GRID_FINALIZE_TERRAIN -USE PRECISION_PARAMETERS, ONLY: EB -USE TYPES, ONLY: CFACE_TYPE -USE COMPLEX_GEOMETRY, ONLY: SET_CUTCELLS_3D_FROM_GEOM => SET_CUTCELLS_3D, & - GET_CFACE_INDEX_FROM_GEOM => GET_CFACE_INDEX, & - RANDOM_CFACE_XYZ_FROM_GEOM => RANDOM_CFACE_XYZ, & - POINT_IN_CFACE_FROM_GEOM => POINT_IN_CFACE -IMPLICIT NONE (TYPE,EXTERNAL) -PRIVATE +SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS(NM) -PUBLIC :: GET_CFACE_INDEX, POINT_IN_CFACE, RANDOM_CFACE_XYZ, SET_CUTCELLS_3D +INTEGER, INTENT(IN) :: NM +INTEGER :: ICC,ICC1,I,J,K -CONTAINS +! Block SPCELLS, cells in cut-cell region where cut-cells could not be built: +IF (MESHES(NM)%N_SPCELLS_TO_BLOCK < 1 .OR. .NOT.ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) RETURN -SUBROUTINE SET_CUTCELLS_3D +DO ICC=1,MESHES(NM)%N_SPCELLS_TO_BLOCK + I = MESHES(NM)%SPCELL_LIST(IAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + J = MESHES(NM)%SPCELL_LIST(JAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + K = MESHES(NM)%SPCELL_LIST(KAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + ICC1 = MESHES(NM)%CCVAR(I,J,K,CC_IDCC) + IF (ICC1 > 0) THEN + CC => MESHES(NM)%CUT_CELL(ICC1) + CC%NOADVANCE(1:CC%NCELL) = BLOCKED_SPECIAL_CELL + ENDIF +ENDDO + +END SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS + + +SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) + +INTEGER, INTENT(IN) :: NM + +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) +MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 -CALL SET_CUTCELLS_3D_FROM_GEOM +END SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK END SUBROUTINE SET_CUTCELLS_3D + SUBROUTINE GET_CFACE_INDEX(NM,I,J,K,XPT,YPT,ZPT,ICF) INTEGER, INTENT(IN) :: NM,I,J,K REAL(EB),INTENT(IN) :: XPT,YPT,ZPT INTEGER, INTENT(OUT):: ICF -CALL GET_CFACE_INDEX_FROM_GEOM(NM,I,J,K,XPT,YPT,ZPT,ICF) +! Local Variables: +INTEGER, PARAMETER :: DELTA_IJK = 1 +INTEGER :: ILO, IHI, JLO, JHI, KLO, KHI, II, JJ, KK, ICF2, JCF +REAL(EB):: DIST, DIST_CLOSE +LOGICAL :: CFACE_FOUND + +ICF = 0 +IF(.NOT.ALLOCATED(MESHES(NM)%CCVAR)) RETURN ! Case of NO GEOMs, return and give an error. + +ILO = MAX(I-DELTA_IJK,1) +IHI = MIN(I+DELTA_IJK,MESHES(NM)%IBAR) + +JLO = MAX(J-DELTA_IJK,1) +JHI = MIN(J+DELTA_IJK,MESHES(NM)%JBAR) + +KLO = MAX(K-DELTA_IJK,1) +KHI = MIN(K+DELTA_IJK,MESHES(NM)%KBAR) + +CFACE_FOUND = .FALSE. +DO KK=KLO,KHI + DO JJ=JLO,JHI + DO II=ILO,IHI + ICF2 = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCF) + IF (ICF2 <= 0) CYCLE + DO JCF=1,MESHES(NM)%CUT_FACE(ICF2)%NFACE + DIST = SQRT( (XPT-MESHES(NM)%CUT_FACE(ICF2)%XYZCEN(IAXIS,JCF))**2._EB + & + (YPT-MESHES(NM)%CUT_FACE(ICF2)%XYZCEN(JAXIS,JCF))**2._EB + & + (ZPT-MESHES(NM)%CUT_FACE(ICF2)%XYZCEN(KAXIS,JCF))**2._EB ) + IF (.NOT.CFACE_FOUND) THEN + ICF = MESHES(NM)%CUT_FACE(ICF2)%CFACE_INDEX(JCF) + DIST_CLOSE = DIST + CFACE_FOUND = .TRUE. + ELSE + IF (DIST > DIST_CLOSE) CYCLE + ICF = MESHES(NM)%CUT_FACE(ICF2)%CFACE_INDEX(JCF) + DIST_CLOSE = DIST + ENDIF + ENDDO + ENDDO + ENDDO +ENDDO END SUBROUTINE GET_CFACE_INDEX @@ -26730,7 +26637,56 @@ SUBROUTINE RANDOM_CFACE_XYZ(NM,CFA,CFA_X,CFA_Y,CFA_Z) TYPE(CFACE_TYPE), INTENT(IN) :: CFA REAL(EB), INTENT(OUT) :: CFA_X,CFA_Y,CFA_Z -CALL RANDOM_CFACE_XYZ_FROM_GEOM(NM,CFA,CFA_X,CFA_Y,CFA_Z) +! Local Variables: +INTEGER :: IND1, IND2, ITRI, N_TRI, INOD_2, INOD_3 +REAL(EB):: RN, RN_I, E1, E2, E3, V12(IAXIS:KAXIS), V13(IAXIS:KAXIS) +TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC + +IND1 = CFA%CUT_FACE_IND1 +IND2 = CFA%CUT_FACE_IND2 +BC => MESHES(NM)%BOUNDARY_COORD(CFA%BC_INDEX) + +! Number of triangles that will cover the boundary cut-face convex polygon is same as NVERT for the cut-face: +N_TRI= MESHES(NM)%CUT_FACE(IND1)%CFELEM(1,IND2) + +! First pick randomly one triangle weighting by area: +CALL RANDOM_NUMBER(RN) +RN_I = 0._EB +CFTRI_LOOP : DO ITRI=1,N_TRI + ! Compute triangle Area: + ! INOD_1 is polygon centroid, CFA%X, CFA%Y, CFA%Z + ! VERTEX locations: + ! Vertex 2 and 3 of triangle in local CFELEM indexing + INOD_2 = ITRI + INOD_3 = 1; IF (ITRI /= N_TRI) INOD_3 = ITRI+1 + ! Vertex 2 and 3 of traingle in XYZVERT indexing + INOD_2 = MESHES(NM)%CUT_FACE(IND1)%CFELEM(1+INOD_2,IND2) + INOD_3 = MESHES(NM)%CUT_FACE(IND1)%CFELEM(1+INOD_3,IND2) + + ! Compute triangles Area / AreaTOT for CFACE polygon: + V12(IAXIS:KAXIS) = (/ MESHES(NM)%CUT_FACE(IND1)%XYZVERT(IAXIS,INOD_2)-BC%X, & + MESHES(NM)%CUT_FACE(IND1)%XYZVERT(JAXIS,INOD_2)-BC%Y, & + MESHES(NM)%CUT_FACE(IND1)%XYZVERT(KAXIS,INOD_2)-BC%Z /) + V13(IAXIS:KAXIS) = (/ MESHES(NM)%CUT_FACE(IND1)%XYZVERT(IAXIS,INOD_3)-BC%X, & + MESHES(NM)%CUT_FACE(IND1)%XYZVERT(JAXIS,INOD_3)-BC%Y, & + MESHES(NM)%CUT_FACE(IND1)%XYZVERT(KAXIS,INOD_3)-BC%Z /) + + RN_I = RN_I + 0.5_EB/CFA%AREA * SQRT( (V12(JAXIS)*V13(KAXIS)-V12(KAXIS)*V13(JAXIS))**2 + & + (V12(KAXIS)*V13(IAXIS)-V12(IAXIS)*V13(KAXIS))**2 + & + (V12(IAXIS)*V13(JAXIS)-V12(JAXIS)*V13(IAXIS))**2 ) + IF (RN_I > RN) EXIT CFTRI_LOOP +ENDDO CFTRI_LOOP + +! Randomly define natural coordinates for the triangle: +CALL RANDOM_NUMBER(E2) +CALL RANDOM_NUMBER(E3) +E3 = (1._EB-E2)*E3 +E1 = 1._EB-E2-E3 + +! Compute physical coordinates of point: +CFA_X = E1*BC%X+E2*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(IAXIS,INOD_2)+E3*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(IAXIS,INOD_3) +CFA_Y = E1*BC%Y+E2*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(JAXIS,INOD_2)+E3*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(JAXIS,INOD_3) +CFA_Z = E1*BC%Z+E2*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(KAXIS,INOD_2)+E3*MESHES(NM)%CUT_FACE(IND1)%XYZVERT(KAXIS,INOD_3) END SUBROUTINE RANDOM_CFACE_XYZ @@ -26741,7 +26697,48 @@ SUBROUTINE POINT_IN_CFACE(NM,XP,YP,ZP,CFACE_INDEX,IN_CFACE) INTEGER, INTENT(IN) :: NM,CFACE_INDEX LOGICAL, INTENT(OUT) :: IN_CFACE -CALL POINT_IN_CFACE_FROM_GEOM(NM,XP,YP,ZP,CFACE_INDEX,IN_CFACE) +! Local Variables +INTEGER :: INBFC,INBFC_LOC,VERT_CUTFACE,NVERT,X1AXIS,X2AXIS,X3AXIS +REAL(EB), POINTER, DIMENSION(:) :: NVEC +INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM +REAL(EB):: ANVEC(MAX_DIM),P0(MAX_DIM),A,B,C,D,PROJ_COEFF,XYZ_P(MAX_DIM),PTCEN(IAXIS:JAXIS) +TYPE(CFACE_TYPE), POINTER :: CFA + +CFA => MESHES(NM)%CFACE(CFACE_INDEX) +INBFC = CFA%CUT_FACE_IND1 +INBFC_LOC = CFA%CUT_FACE_IND2 + +! Normal, max normal component, define plane X2AXIS,X3AXIS to do search: +VERT_CUTFACE = SIZE(MESHES(NM)%CUT_FACE(INBFC)%CFELEM, DIM=1); ALLOCATE(CFELEM(1:VERT_CUTFACE)) +CFELEM(1:VERT_CUTFACE) = MESHES(NM)%CUT_FACE(INBFC)%CFELEM(1:VERT_CUTFACE,INBFC_LOC) +NVEC(IAXIS:KAXIS) => MESHES(NM)%BOUNDARY_COORD(CFA%BC_INDEX)%NVEC(IAXIS:KAXIS) + +! Plane equation for INBOUNDARY cut-face plane: +! Location of first point in cf polygon is P0: +P0(IAXIS:KAXIS) = MESHES(NM)%CUT_FACE(INBFC)%XYZVERT(IAXIS:KAXIS,CFELEM(2)) +A = NVEC(IAXIS) +B = NVEC(JAXIS) +C = NVEC(KAXIS) +D = -(A*P0(IAXIS) + B*P0(JAXIS) + C*P0(KAXIS)) +! Project XP,YP,ZP point into plane of cf polygon: +PROJ_COEFF = (A*XP+B*YP+C*ZP) + D ! /dot(n,n) = 1 +XYZ_P(IAXIS:KAXIS) = (/XP,YP,ZP/) - PROJ_COEFF*NVEC(IAXIS:KAXIS) + +! Which Cartesian plane we project to? +ANVEC(IAXIS) = ABS(NVEC(IAXIS)); ANVEC(JAXIS) = ABS(NVEC(JAXIS)); ANVEC(KAXIS) = ABS(NVEC(KAXIS)) +IF ( MAX(ANVEC(IAXIS),MAX(ANVEC(JAXIS),ANVEC(KAXIS))) == ANVEC(IAXIS) ) THEN + X1AXIS = IAXIS; X2AXIS = JAXIS; X3AXIS = KAXIS +ELSEIF ( MAX(ANVEC(IAXIS),MAX(ANVEC(JAXIS),ANVEC(KAXIS))) == ANVEC(JAXIS) ) THEN + X1AXIS = JAXIS; X2AXIS = KAXIS; X3AXIS = IAXIS +ELSE + X1AXIS = KAXIS; X2AXIS = IAXIS; X3AXIS = JAXIS +ENDIF +PTCEN(IAXIS:JAXIS) = XYZ_P( (/ X2AXIS, X3AXIS /) ) + +NVERT = SIZE(MESHES(NM)%CUT_FACE(INBFC)%XYZVERT,DIM=2) +CALL POINT_IN_POLYGON(PTCEN,VERT_CUTFACE,CFELEM,NVERT,X2AXIS,X3AXIS,MESHES(NM)%CUT_FACE(INBFC)%XYZVERT,IN_CFACE) + +DEALLOCATE(CFELEM) END SUBROUTINE POINT_IN_CFACE From 10367ad49e896512b5d9fea60e8ac5e62770f329 Mon Sep 17 00:00:00 2001 From: Marcos Vanella Date: Fri, 27 Mar 2026 14:03:22 -0400 Subject: [PATCH 03/18] FDS Source: Move all grid routines and related data to COMPLEX_GEOMETRY_GRID. --- Source/ccib.f90 | 37 +- Source/geom.f90 | 46335 +++++++++++++++++++++++----------------------- Source/pres.f90 | 6 +- 3 files changed, 23433 insertions(+), 22945 deletions(-) diff --git a/Source/ccib.f90 b/Source/ccib.f90 index 3b98313d5ea..475822debac 100644 --- a/Source/ccib.f90 +++ b/Source/ccib.f90 @@ -6,24 +6,25 @@ ! MODULE CC_SCALARS -USE COMPLEX_GEOMETRY, ONLY: BLOCK_CC_SOLID_EXTWALLCELLS,GEOFCT,CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,CCGUARD, & - CC_MATVEC_DEFINED,GEOMEPS,DELTA_INT,DELTA_VERT,DIST_THRES,GET_CARTCELL_CUTCELLS_TIME_INDEX, & - CC_SOLID,CC_VGSC,CC_CGSC,CC_FGSC,CC_IDCF,CC_UNKZ,CC_GASPHASE,CC_CUTCFE,CC_IDRC,CC_FTYPE_CFGAS, & - CC_FTYPE_CFINB,CC_FTYPE_RGGAS,CC_IDCC,CC_EGSC,CC_IDCE,CC_INBOUNDARY,CC_UNDEFINED,CC_UNKH,CC_UNKF, & - FDS_AREA_GEOM,INDEX_UNDEFINED,INIT_CFACE_CELL,INT_N_EXT_PTS,INT_P_IND,INT_TMP_IND,INT_VEL_IND, & - INT_RHO_IND,INT_H_IND,INT_RSUM_IND,INT_MU_IND,INT_MUDNS_IND,INT_RHO0_IND,INT_WCEN_IND,INT_VELS_IND, & - CC_ETYPE_EP,CC_ETYPE_SCINB,CC_FTYPE_SVERT,CC_ETYPE_RCGAS,CC_ETYPE_RGGAS,CC_ETYPE_CFGAS,CC_FTYPE_RCGAS, & - CC_FTYPE_CCGAS,GET_REGULAR_CUT_EDGES_BC,GET_SOLID_CUTCELL_EDGES_BC,LOOSEPS,LU_SETCC,MAX_INTERP_POINTS, & - MESH_CC_EXCHANGE_TIME_INDEX,CCCOMPUTE_RADIATION_TIME_INDEX,CC_DENSITY_TIME_INDEX, & - CC_SET_DATA_TIME_INDEX,INIT_CUTCELL_DATA_TIME_INDEX,CC_VELOCITY_FLUX_TIME_INDEX, & - CC_COMPUTE_VISCOSITY_TIME_INDEX,CC_DIVERGENCE_PART_1_TIME_INDEX,CC_END_STEP_TIME_INDEX, & - CC_NO_FLUX_TIME_INDEX,CC_COMPUTE_VELOCITY_ERROR_TIME_INDEX,NQT2C,N_CUTCELLS_PROC,NGUARD, & - N_INB_CUTFACES_PROC,N_INT_CVARS,N_INT_CCVARS,N_REG_CUTFACES_PROC,N_LINK_ATTMP_F, & - N_SET_CUTCELLS_3D_CALLS,NM_START,N_REQ11,N_REQ12,N_REQ112,N_REQ13,REQ11,REQ112,REQ12,REQ13, & - POINT_IN_POLYGON,SEARCH_OTHER_MESHES_FACE,SET_CUTCELLS_TIME_INDEX,VAL_TESTX_LOW, & - VAL_TESTX_HIGH,VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH,T_CC_USED, & - WRITE_SET_CUTCELLS_TIMINGS -USE COMPLEX_GEOMETRY_GRID, ONLY: SET_CUTCELLS_3D +USE COMPLEX_GEOMETRY, ONLY: GEOMEPS,LOOSEPS,GEOFCT,NGUARD,CCGUARD,CC_GASPHASE,CC_CUTCFE,CC_SOLID, & + CC_INBOUNDARY,CC_UNDEFINED,CC_VGSC,CC_EGSC,CC_IDCE, & + CC_FGSC,CC_IDCF,CC_IDRC,CC_UNKF,CC_CGSC,CC_IDCC,CC_UNKZ,CC_UNKH,CC_ETYPE_RGGAS, & + CC_ETYPE_CFGAS,CC_FTYPE_RGGAS,CC_FTYPE_CFGAS,CC_FTYPE_CFINB,CC_FTYPE_SVERT,CC_FTYPE_RCGAS, & + CC_FTYPE_CCGAS,CC_ETYPE_SCINB,CC_ETYPE_RCGAS,CC_ETYPE_EP,CC_MATVEC_DEFINED,NM_START, & + CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,N_REQ11,N_REQ12,N_REQ112,N_REQ13,REQ11,REQ112,REQ12,REQ13, & + WRITE_SET_CUTCELLS_TIMINGS,N_SET_CUTCELLS_3D_CALLS,SET_CUTCELLS_TIME_INDEX,GET_CARTCELL_CUTCELLS_TIME_INDEX, & + CC_SET_DATA_TIME_INDEX,INIT_CUTCELL_DATA_TIME_INDEX,CCCOMPUTE_RADIATION_TIME_INDEX, & + CC_DENSITY_TIME_INDEX,CC_VELOCITY_FLUX_TIME_INDEX,CC_COMPUTE_VISCOSITY_TIME_INDEX, & + CC_DIVERGENCE_PART_1_TIME_INDEX,CC_END_STEP_TIME_INDEX,CC_NO_FLUX_TIME_INDEX, & + CC_COMPUTE_VELOCITY_ERROR_TIME_INDEX,MESH_CC_EXCHANGE_TIME_INDEX,T_CC_USED, & + VAL_TESTX_LOW,VAL_TESTX_HIGH,VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH, & + LU_SETCC,SEARCH_OTHER_MESHES_FACE,POINT_IN_POLYGON +USE COMPLEX_GEOMETRY_GRID, ONLY: DELTA_INT,DELTA_VERT,DIST_THRES,FDS_AREA_GEOM,INDEX_UNDEFINED,INT_N_EXT_PTS, & + INT_P_IND,INT_TMP_IND,INT_VEL_IND,INT_RHO_IND,INT_H_IND,INT_RSUM_IND,INT_MU_IND,INT_MUDNS_IND, & + INT_RHO0_IND,INT_WCEN_IND,INT_VELS_IND,MAX_INTERP_POINTS,NQT2C,N_CUTCELLS_PROC,N_INB_CUTFACES_PROC, & + N_INT_CVARS,N_INT_CCVARS,N_REG_CUTFACES_PROC,N_LINK_ATTMP_F,GLOBAL_DELTA_CELL,GLOBAL_DELTA_EDGE, & + GLOBAL_DELTA_FACE,SET_CUTCELLS_3D,BLOCK_CC_SOLID_EXTWALLCELLS,INIT_CFACE_CELL,GET_REGULAR_CUT_EDGES_BC, & + GET_SOLID_CUTCELL_EDGES_BC USE PRECISION_PARAMETERS USE GLOBAL_CONSTANTS USE MESH_POINTERS diff --git a/Source/geom.f90 b/Source/geom.f90 index 909825037b9..fc447961cec 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -21,10 +21,6 @@ MODULE COMPLEX_GEOMETRY !! --------------------------------------------------------------------------------- ! Debug Parameter: LOGICAL, PARAMETER :: DEBUG_SET_CUTCELLS = .FALSE. -INTEGER :: LU_DB_SETCC - -! Engage NOADVANCE for small cut-cells to be dropped: -LOGICAL, PARAMETER :: DO_NOADVANCE = .TRUE. !! --------------------------------------------------------------------------------- ! Start Variable declaration for cut-cell definition: @@ -116,97 +112,10 @@ MODULE COMPLEX_GEOMETRY INTEGER, PARAMETER :: CC_ETYPE_RCGAS =14 ! A regular edge next to a cut-face and a regular gasphase face. INTEGER, PARAMETER :: CC_ETYPE_EP =15 ! External edge for Stress extrapolation in one Cartesian plane. -! Local integers: -INTEGER, SAVE :: CC_NEDGECROSS, CC_NCUTEDGE, CC_NCUTFACE, CC_NCUTCELL -INTEGER, SAVE :: ILO_CELL,IHI_CELL,JLO_CELL,JHI_CELL,KLO_CELL,KHI_CELL -INTEGER, SAVE :: ILO_FACE,IHI_FACE,JLO_FACE,JHI_FACE,KLO_FACE,KHI_FACE -INTEGER, SAVE :: NXB, NYB, NZB - INTEGER, PARAMETER :: NODS_WSEL = 3 ! Three nodes per wet surface element (i.e. surface triangle). - INTEGER, PARAMETER :: EDGS_WSEL = 3 ! Three edges per wet surface element. - INTEGER, PARAMETER :: NODS_VLEL = 4 ! Nodes of volume element (tetrahedra). -INTEGER, PARAMETER :: LINSEARCH_LIMIT = 13 ! LINSEARCH_LIMIT-1 is the maximum size of array for linear search O(n). If - ! Array larger -> binary search O(log(n)). - -TYPE(CC_CUTCELL_TYPE), POINTER :: CC -TYPE(CC_CUTFACE_TYPE), POINTER :: CF -TYPE(CC_CUTEDGE_TYPE), POINTER :: CE - -! Auxiliary variables: -TYPE(CC_EDGECROSS_TYPE), ALLOCATABLE, DIMENSION(:) :: EDGE_CROSS_AUX -TYPE(CC_CUTEDGE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_EDGE_AUX -TYPE(CC_CUTFACE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_FACE_AUX -TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX - -! Intersection Body-plane data structure: -TYPE BODINT_PLANE_TYPE - INTEGER :: NNODS ! Number of intersection vertices. - INTEGER :: NSGLS ! Number of single point intersection elements. - INTEGER :: NSEGS ! Number of intersection segments. - INTEGER :: NTRIS ! Number of in-plane intersections triangles. - REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZ ! (1:NNODS,IAXIS:KAXIS) vertex coordinates. - INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SGLS ! (1:NSGLS,NOD1) connectivity list for single node elements. - INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEGS ! (1:NSEGS,NOD1:NOD2) connectivity list for segments. - INTEGER, ALLOCATABLE, DIMENSION(:,:) :: TRIS ! (1:NTRIS,NOD1:NOD3) connectivity list for triangle elements. - INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INDSEG ! Wet surface triangles associated with intersection segments. - INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INDTRI ! Wet surface triangles associated with intersection triangles. - LOGICAL, ALLOCATABLE, DIMENSION(:) :: X2ALIGNED ! For segments. - LOGICAL, ALLOCATABLE, DIMENSION(:) :: X3ALIGNED ! For segments. - INTEGER, ALLOCATABLE, DIMENSION(:) :: NBCROSS ! Number of crossings per segment with x2,x3 grid lines. - REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR ! Intersections with gridlines for SEGS. - INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEGTYPE ! Type of SEG based on the media it separates. - REAL(EB), ALLOCATABLE, DIMENSION(:) :: X1NVEC ! Sign of in-plane triangles normal vectors resp to x1 dir. - REAL(EB), ALLOCATABLE, DIMENSION(:,:,:):: AINV ! Inverse transformation matrix for in-plane triangles. - INTEGER, ALLOCATABLE, DIMENSION(:) :: NOD_PERM ! Permutation array for nodes in ascending order, s.t. - ! XYZ(X2AXIS,NOD_PERM(I-1)) <= XYZ(X2AXIS,NOD_PERM(I)), etc. - TYPE(TBAXIS_TYPE) :: TBAXIS(IAXIS:KAXIS) - REAL(EB) :: BOX(LOW_IND:HIGH_IND,IAXIS:KAXIS) -END TYPE BODINT_PLANE_TYPE - -INTEGER, SAVE :: CC_MAX_NNODS, CC_MAX_NSGLS, CC_MAX_NSEGS, CC_MAX_NTRIS, CC_DELTA_NBCROSS=20 - -TYPE(BODINT_PLANE_TYPE) :: BODINT_PLANE, BODINT_PLANE2 -TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC,WC_BC -TYPE(BOUNDARY_PROP1_TYPE), POINTER :: B1,WC_B1 - -REAL(EB), PARAMETER :: GAMMA_MULT = 1._EB -INTEGER, PARAMETER :: DELTA_TBIN = 200, DELTA_SEGBIN = 50 - -LOGICAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: CELLRT -LOGICAL, SAVE, ALLOCATABLE, DIMENSION(:,:) :: FACERT -REAL(EB) :: MAX_LEDGE, X3LO_RT, X3HI_RT -INTEGER, ALLOCATABLE, DIMENSION(:) :: SPCELLS_TO_BLOCK, SPCELLS_TO_BLOCK_AUX -INTEGER :: N_SPCELLS_TO_BLOCK - - -! Wet surface edges intersection with Cartesian cells data structure: -TYPE BODINT_CELL_EDGE_TYPE - INTEGER :: NWCROSS=0 ! Number of intersections with Cartesian grid planes. - REAL(EB), ALLOCATABLE, DIMENSION(:) :: SVAR ! Intersection with grid planes defined by local coord s. -END TYPE BODINT_CELL_EDGE_TYPE - -! Allocatable real arrays -! Grid position containers: -REAL(EB), SAVE, TARGET, ALLOCATABLE, DIMENSION(:) :: XFACE,YFACE,ZFACE,XCELL,YCELL,ZCELL, & - DXFACE,DYFACE,DZFACE,DXCELL,DYCELL,DZCELL,X1FACE,X2FACE,X3FACE, & - X2CELL,X3CELL,DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL ! X1CELL,DX1CELL not used. - -! x2 Intersection data containers: -INTEGER, SAVE :: CC_N_CRS -INTEGER, PARAMETER :: DELTA_CROSS_X2 = 512 -INTEGER, SAVE :: CC_MAXCROSS_X2= 512 -REAL(EB), ALLOCATABLE, DIMENSION(:) :: CC_SVAR_CRS -INTEGER, ALLOCATABLE, DIMENSION(:) :: CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX -INTEGER, ALLOCATABLE, DIMENSION(:,:):: CC_IS_CRS2 -REAL(EB), ALLOCATABLE, DIMENSION(:,:):: CC_SEG_TAN -INTEGER :: X1NOC, X2NOC, X3NOC -INTEGER, PARAMETER :: MAX_CELL_POLYLINES = 200 - -REAL(EB):: VAL_TESTX_LOW,VAL_TESTX_HIGH,VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH - ! Matrix vector building variables: LOGICAL, SAVE :: CC_MATVEC_DEFINED=.FALSE. @@ -215,14 +124,9 @@ MODULE COMPLEX_GEOMETRY ! complete. INTEGER :: NM_START -INTEGER, PARAMETER :: NNZ_ROW_H = 10 ! 7 point stencil + 3 - ! (buffer in case of unstructured grid). - LOGICAL :: CALL_FOR_GLMAT = .FALSE. ! Flag to avoid MESH_CC_EXCHANGE(5) whithin GLMAT calls in PRESSURE_ITERATION_SCHEME. LOGICAL :: CALL_FROM_GLMAT_SETUP = .FALSE. ! Flag to avoid MESH_CC_EXCHANGE(3) when exchaging UNK numbers in GLMAT setup. -INTEGER, ALLOCATABLE, DIMENSION(:) :: IPARM ! SOLVER Control Parameters array, defined in GET_HLU_3D - ! Communication variables: INTEGER :: N_REQ11=0, N_REQ12=0, N_REQ112=0, N_REQ13=0 @@ -259,125 +163,42 @@ MODULE COMPLEX_GEOMETRY REAL(EB), SAVE :: T_CC_USED(SET_CUTCELLS_TIME_INDEX:MESH_CC_EXCHANGE_TIME_INDEX) = 0._EB -INTEGER, SAVE :: N_CUTCELLS_PROC=0, N_INB_CUTFACES_PROC=0, N_REG_CUTFACES_PROC=0 - -! Local arrays allocation variables: -INTEGER, PARAMETER :: DELTA_VERT = 24 -INTEGER, PARAMETER :: DELTA_EDGE = 24 -INTEGER, PARAMETER :: DELTA_FACE = 24 -INTEGER, PARAMETER :: DELTA_CELL = 5 - -! Global cut-edge, face, cell allocation variables: -INTEGER, PARAMETER :: GLOBAL_DELTA_CELL = 100 -INTEGER, PARAMETER :: GLOBAL_DELTA_EDGE = 3*GLOBAL_DELTA_CELL -INTEGER, PARAMETER :: GLOBAL_DELTA_FACE = 3*GLOBAL_DELTA_CELL - -! Wall model volume interpolation variables: - -! Velocity interpolation stencil threshold. Interpolation stencils will be defined if distance -! from body to face centroid is greater than DIST_THRES of the minimum local cell size. -REAL(EB), PARAMETER :: DIST_THRES = 0.0001_EB - -INTEGER, PARAMETER :: INDEX_UNDEFINED = -1000 -INTEGER, SAVE :: INT_N_EXT_PTS = 1 ! Default is one external point in normal probe. -INTEGER, PARAMETER :: MAX_INTERP_POINTS_VOL_LIN = 8 ! 8 stencil points for trilinear interpolation. -INTEGER, PARAMETER :: MAX_INTERP_POINTS_VOL_QUAD=27 !27 stencil points for quadratic interpolation. -INTEGER, SAVE :: MAX_INTERP_POINTS = MAX_INTERP_POINTS_VOL_LIN ! Default linear interpolation. -INTEGER, SAVE :: DELTA_INT = 1*MAX_DIM*MAX_INTERP_POINTS_VOL_LIN ! The 1 is for INT_N_EXT_PTS -INTEGER, SAVE :: N_INT_CVARS, N_INT_CCVARS -INTEGER, PARAMETER :: INT_VEL_IND=1, INT_VELS_IND=2, INT_FV_IND=3, INT_DHDX_IND=4, INT_DPDX_IND=6, N_INT_FVARS=4 -INTEGER, PARAMETER :: INT_MU_IND=1, INT_H_IND=2, INT_RHO_IND=3, INT_TMP_IND=4, INT_RSUM_IND=5, INT_MUDNS_IND=6, INT_P_IND=7 -INTEGER, PARAMETER :: INT_RHO0_IND=1, INT_WCEN_IND=3 -INTEGER, SAVE :: NQT2C = INT_P_IND+2 ! The +2 is because we pass RHO0, WCEN. - -! Max numbers of link attempts for small faces and cut-cells: -INTEGER, PARAMETER :: N_LINK_ATTMP = 1, N_LINK_ATTMP_F=50 -! Number of digits in loose precision used in normals definition for linking. -INTEGER, PARAMETER :: LINK_DIGITS = 8 -REAL(EB),PARAMETER :: LINK_FCT = REAL(10**LINK_DIGITS,EB) - -! Areas per SURF and GEOM: -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: FDS_AREA_GEOM - -! Cut-cell state and CFACE origin parameter: -INTEGER, PARAMETER :: NOT_BLOCKED = 0 -INTEGER, PARAMETER :: BLOCKED_SMALL_CELL = 1 -INTEGER, PARAMETER :: BLOCKED_SPLIT_CELL = 2 -INTEGER, PARAMETER :: BLOCKED_REFI_INTER = 3 -INTEGER, PARAMETER :: BLOCKED_CAVITY_CELL= 4 -INTEGER, PARAMETER :: BLOCKED_UNLINK_CELL= 5 -INTEGER, PARAMETER :: BLOCKED_SPECIAL_CELL=6 +REAL(EB) :: VAL_TESTX_LOW,VAL_TESTX_HIGH,VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH ! End Variable declaration for CC_IBM. ! --------------------------------------------------------------------------------- -PUBLIC :: BLOCK_CC_SOLID_EXTWALLCELLS,GEOFCT,CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,CCGUARD,CC_MATVEC_DEFINED, & - GEOMEPS,DELTA_INT,DELTA_VERT,DEBUG_SET_CUTCELLS,DEBUG_WAIT,DIST_THRES, & - GET_CARTCELL_CUTCELLS_TIME_INDEX,BODINT_PLANE_TYPE,INTERSECT_CONE_AABB,INTERSECT_CYLINDER_AABB, & +PUBLIC :: GEOFCT,CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,CCGUARD,CC_MATVEC_DEFINED, & + GEOMEPS,DEBUG_SET_CUTCELLS,DEBUG_WAIT, & + SET_CUTCELLS_TIME_INDEX,GET_BODINT_PLANE_TIME_INDEX,GET_X2_INTERSECTIONS_TIME_INDEX, & + GET_X2_VERTVAR_TIME_INDEX,GET_CARTEDGE_CUTEDGES_TIME_INDEX,GET_BODX2X3_INTERSECTIONS_TIME_INDEX, & + GET_CARTFACE_CUTEDGES_TIME_INDEX,GET_CARTCELL_CUTEDGES_TIME_INDEX,GET_CARTFACE_CUTFACES_TIME_INDEX, & + GET_CARTCELL_CUTFACES_TIME_INDEX,GET_CARTCELL_CUTCELLS_TIME_INDEX,INTERSECT_CONE_AABB,INTERSECT_CYLINDER_AABB, & INTERSECT_OBB_AABB,INTERSECT_SPHERE_AABB,READ_GEOM,ROTATION_MATRIX,WRITE_GEOM,WRITE_GEOM_ALL, & CC_SOLID,CC_VGSC,CC_CGSC,CC_FGSC,CC_IDCF,CC_UNKZ,CC_GASPHASE,CC_CUTCFE,CC_IDRC,CC_FTYPE_CFGAS, & - CC_FTYPE_CFINB,CC_FTYPE_RGGAS,CC_IDCC,CC_EGSC,CC_IDCE,CC_INBOUNDARY,CC_UNDEFINED,CC_NCVARS, & - CC_UNKH,CC_UNKF,FDS_AREA_GEOM,INDEX_UNDEFINED,INIT_CFACE_CELL,INT_N_EXT_PTS,INT_P_IND,INT_TMP_IND, & - INT_VEL_IND,INT_RHO_IND,INT_H_IND,INT_RSUM_IND,INT_MU_IND,INT_MUDNS_IND,INT_RHO0_IND,INT_FV_IND, & - INT_DHDX_IND,INT_WCEN_IND,INT_VELS_IND,CC_ETYPE_EP,CC_ETYPE_SCINB,CC_FTYPE_SVERT,CC_ETYPE_RCGAS, & - CC_ETYPE_RGGAS,CC_ETYPE_CFGAS,CC_FTYPE_RCGAS,CC_FTYPE_CCGAS,GET_REGULAR_CUT_EDGES_BC, & - GET_SOLID_CUTCELL_EDGES_BC,LOOSEPS,LU_SETCC,MAX_INTERP_POINTS,MESH_CC_EXCHANGE_TIME_INDEX, & + CC_FTYPE_CFINB,CC_FTYPE_RGGAS,CC_IDCC,CC_EGSC,CC_IDCE,CC_ECRS,CC_INBOUNDARY,CC_UNDEFINED, & + CC_GG,CC_SS,CC_GS,CC_SG,CC_NCVARS, & + CC_UNKH,CC_UNKF,CC_ETYPE_EP,CC_ETYPE_SCINB,CC_FTYPE_SVERT,CC_ETYPE_RCGAS, & + CC_ETYPE_RGGAS,CC_ETYPE_CFGAS,CC_FTYPE_RCGAS,CC_FTYPE_CCGAS,LOOSEPS,LU_SETCC, & + MESH_CC_EXCHANGE_TIME_INDEX, & CCCOMPUTE_RADIATION_TIME_INDEX,CC_DENSITY_TIME_INDEX,CC_SET_DATA_TIME_INDEX, & INIT_CUTCELL_DATA_TIME_INDEX,CC_VELOCITY_FLUX_TIME_INDEX,CC_COMPUTE_VISCOSITY_TIME_INDEX, & CC_INTERP_FACE_VEL_TIME_INDEX,CC_DIVERGENCE_PART_1_TIME_INDEX,CC_END_STEP_TIME_INDEX, & CC_TARGET_VELOCITY_TIME_INDEX,CC_NO_FLUX_TIME_INDEX,CC_COMPUTE_VELOCITY_ERROR_TIME_INDEX, & - MIN_VOL_FACTOR,NQT2C,N_CUTCELLS_PROC,NGUARD,N_INB_CUTFACES_PROC,N_INT_CVARS,N_INT_CCVARS, & - N_REG_CUTFACES_PROC,NNZ_ROW_H,N_INT_FVARS,N_LINK_ATTMP_F,N_SET_CUTCELLS_3D_CALLS,NM_START,N_REQ11, & - N_REQ12,N_REQ112,N_REQ13,REQ11,REQ112,REQ12,REQ13,BODINT_PLANE,BODINT_PLANE2,CELLRT,FACERT,XFACE, & - YFACE,ZFACE,XCELL,YCELL,ZCELL,DXFACE,DYFACE,DZFACE,DXCELL,DYCELL,DZCELL,X1FACE,X2FACE,X3FACE, & - X2CELL,X3CELL,DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL,CC_N_CRS,CC_MAXCROSS_X2,CC_SVAR_CRS, & - CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX,CC_IS_CRS2,CC_SEG_TAN,X1NOC,X2NOC,X3NOC, & - SPCELLS_TO_BLOCK,SPCELLS_TO_BLOCK_AUX,N_SPCELLS_TO_BLOCK,IPARM,POINT_IN_POLYGON, & - SEARCH_OTHER_MESHES_FACE,CHECK_WALL_CELL_PLANE_MATCH,CC_INIT_GEOM,ALLOCATE_BODINT_PLANE, & - GET_BODINT_PLANE,GET_X2_INTERSECTIONS,GET_X2_VERTVAR,GET_CARTEDGE_CUTEDGES, & - GET_BODX2_INTERSECTIONS,GET_BODX3_INTERSECTIONS,GET_CARTFACE_CUTEDGES,GET_CARTCELL_CUTEDGES, & - GET_CARTFACE_CUTFACES,GET_CARTCELL_CUTFACES,GET_CARTCELL_CUTCELLS,GET_CELL_LINK_INFO, & - EXCHANGE_CC_NOADVANCE_INFO,BLOCK_SMALL_UNLINKED_CUTCELLS,ALLOC_FACE_STATE_VARS, & - ALLOC_CELL_STATE_VARS,SET_CUTCELLS_TIME_INDEX,TRIANGULATE,TRILINEAR,VALID_TRIANGLE,VAL_TESTX_LOW, & - VAL_TESTX_HIGH,VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH,T_CC_USED, & + MIN_VOL_FACTOR,MIN_LENGTH_FACTOR,NGUARD, & + N_SET_CUTCELLS_3D_CALLS,NM_START,N_REQ11, & + N_REQ12,N_REQ112,N_REQ13,REQ11,REQ112,REQ12,REQ13, & + POINT_IN_POLYGON,TEST_PT_INPOLY,RAY_TRIANGLE_INTERSECT_PT,SEARCH_OTHER_MESHES_FACE,CC_INIT_GEOM, & + GET_SEGSEG_INTERSECTION,LINE_INTERSECT_COORDPLANE, & + TRIANGULATE,TRILINEAR,VALID_TRIANGLE,VAL_TESTX_LOW,VAL_TESTX_HIGH, & + VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH,T_CC_USED, & WRITE_SET_CUTCELLS_TIMINGS,MAKE_UNIQUE_VERT_ARRAY,AVERAGE_FACE_VALUES,ADIFF_INFO_FACTOR, & - SNAP_DIST_FACTOR,CC_INBOUNDCC,CC_INBOUNDCF,CC_NVVARS,CC_NEVARS,CC_NFVARS,CC_ETYPE_CFINB,NODS_WSEL, & - EDGS_WSEL,NODS_VLEL,GAMMA_MULT,DELTA_TBIN,GLOBAL_DELTA_CELL,GLOBAL_DELTA_EDGE,GLOBAL_DELTA_FACE, & - BLOCKED_SPECIAL_CELL,CC_NEDGECROSS,CC_NCUTEDGE,CC_NCUTFACE,CC_NCUTCELL,ILO_CELL,IHI_CELL,JLO_CELL, & - JHI_CELL,KLO_CELL,KHI_CELL,ILO_FACE,IHI_FACE,JLO_FACE,JHI_FACE,KLO_FACE,KHI_FACE,NXB,NYB,NZB, & - INSERT_CUT_CELL,INSERT_CUT_FACE,CUT_EDGE_ARRAY_REALLOC,NEW_EDGE_ALLOC,CUT_FACE_ARRAY_REALLOC, & - FACE_DEALLOC,NEW_FACE_ALLOC,CUT_CELL_ARRAY_REALLOC,CELL_DEALLOC,NEW_CELL_ALLOC,NOT_BLOCKED, & - BLOCKED_SPLIT_CELL,BLOCKED_REFI_INTER,BLOCKED_CAVITY_CELL + SNAP_DIST_FACTOR,CC_INBOUNDCC,CC_INBOUNDCF,CC_NVVARS,CC_NEVARS,CC_NFVARS,CC_ETYPE_CFINB, & + CC_VTYPE_VGAS,CC_VTYPE_VINB,CC_VTYPE_NINB,NODS_WSEL,EDGS_WSEL,NODS_VLEL CONTAINS -! ----------------------------- GET_CARTCELL_CFACE_LIST ---------------------------- - -! SUBROUTINE GET_CARTCELL_CFACE_LIST(I,J,K,ICF_START,NCFACE) -! -! ! Provides CFACE indexes for Cartesian cell I,J,K. -! ! IF NCFACE > 0, indexes range from ICF_START+1 to ICF_START+NCFACE. -! -! INTEGER, INTENT(IN) :: I,J,K -! INTEGER, INTENT(OUT):: ICF_START,NCFACE -! -! ! Local variables: -! INTEGER :: ICF -! -! ICF_START = CC_UNDEFINED -! NCFACE = 0 -! IF( CCVAR(I,J,K,CC_CGSC) == CC_CUTCFE )THEN -! ICF=CCVAR(I,J,K,CC_IDCF) -! IF (ICF==0) RETURN -! IF (CUT_FACE(ICF)%NFACE==0) RETURN -! NCFACE = CUT_FACE(ICF)%NFACE -! ICF_START= CUT_FACE(ICF)%CFACE_INDEX(1) - 1 -! ENDIF -! -! RETURN -! END SUBROUTINE GET_CARTCELL_CFACE_LIST - ! ------------------------- SEARCH_OTHER_MESHES_FACE --------------------------------------------- @@ -542,21981 +363,22318 @@ SUBROUTINE POINT_IN_POLYGON(PT,CFELEM_SIZE,CFELEM,NVERT,IAXLOC,JAXLOC,XYZVERT,IN END SUBROUTINE POINT_IN_POLYGON -! ---------------------------- SET_CUTCELLS_3D ------------------------------------- +! -------------------------- TEST_PT_INPOLY ------------------------------------- +SUBROUTINE TEST_PT_INPOLY(NP,XY,XY1,PTSFLAG) -! ----------------------- CHECK_WALL_CELL_PLANE_MATCH ---------------------------- +INTEGER, INTENT(IN) :: NP +REAL(EB), INTENT(INOUT) :: XY(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) +REAL(EB), INTENT(IN) :: XY1(IAXIS:JAXIS) +LOGICAL, INTENT(OUT) :: PTSFLAG -SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH +! Local Variables: +INTEGER :: RCROSS, LCROSS, IP +REAL(EB):: XPT +LOGICAL :: RS, LS -! Routine checks that external boundaries match among neighboring meshes. This is not strictly enforced -! by FDS but is required to compute same cut-cells on mesh ghost-cells and other mesh internal cells. +PTSFLAG = .FALSE. +RCROSS = 0 +LCROSS = 0 -USE MPI_F08 +! ADD first point location at the end of XY (assumes CC_MAXVERTS_FACE > NP): +XY(IAXIS:JAXIS,NP+1) = XY(IAXIS:JAXIS,1) -! Local variables: -INTEGER :: NM,NOM,IW,IOR,IERR -REAL(EB):: XM,XOM,MSIZE -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BUFF -TYPE(WALL_TYPE), POINTER :: WC -TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC -TYPE(MESH_TYPE), POINTER :: M2 +! Shift origin to XY1: +DO IP=1,NP+1 + XY(IAXIS:JAXIS,IP) = XY(IAXIS:JAXIS,IP) - XY1(IAXIS:JAXIS) +ENDDO -ALLOCATE(BUFF(2,NMESHES)); BUFF=0 -MESH_LP : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - EXT_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS - WC=>WALL(IW); IF (WC%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY) CYCLE EXT_WALL_LOOP_1 - EWC=>EXTERNAL_WALL(IW) - BC =>BOUNDARY_COORD(WC%BC_INDEX) - IOR = BC%IOR; NOM = EWC%NOM; IF(NOM<1 .OR. NOM==NM) CYCLE EXT_WALL_LOOP_1 - M2 => MESHES(NOM) - SELECT CASE(IOR) - CASE( IAXIS); XM=X(0); XOM=M2%X(M2%IBAR); MSIZE=X(IBAR)-X(0) ! Low X for mesh NM, high X for mesh NOM - CASE(-IAXIS); XM=X(IBAR); XOM=M2%X(0) ; MSIZE=X(IBAR)-X(0) ! High X for mesh NM, low X for mesh NOM - CASE( JAXIS); XM=Y(0); XOM=M2%Y(M2%JBAR); MSIZE=Y(JBAR)-Y(0) ! Low Y for mesh NM, high Y for mesh NOM - CASE(-JAXIS); XM=Y(JBAR); XOM=M2%Y(0) ; MSIZE=Y(JBAR)-Y(0) ! High Y for mesh NM, low Y for mesh NOM - CASE( KAXIS); XM=Z(0); XOM=M2%Z(M2%KBAR); MSIZE=Z(KBAR)-Z(0) ! Low Z for mesh NM, high Z for mesh NOM - CASE(-KAXIS); XM=Z(KBAR); XOM=M2%Z(0) ; MSIZE=Z(KBAR)-Z(0) ! High Z for mesh NM, low Z for mesh NOM - END SELECT - IF(ABS(XM-XOM)>10._EB*GEOMEPS .AND. ABS(XM-XOM)<0.5_EB*MSIZE) THEN - BUFF(1:2,NM) = (/NM,NOM/) - CYCLE MESH_LP - ENDIF - ENDDO EXT_WALL_LOOP_1 -ENDDO MESH_LP +! For each edge test against rays x=0, y=0: +DO IP=1,NP + ! Check if edges first point is vertex: + IF ( (ABS(XY(IAXIS,IP)) < GEOMEPS) .AND. & + (ABS(XY(JAXIS,IP)) < GEOMEPS) ) THEN + PTSFLAG = .TRUE. + RETURN + ENDIF + ! Check if edge crosses x axis: + RS = (XY(JAXIS,IP) > 0._EB) .NEQV. (XY(JAXIS,IP+1) > 0._EB) + LS = (XY(JAXIS,IP) < 0._EB) .NEQV. (XY(JAXIS,IP+1) < 0._EB) -! Now All-Reduce mismatch -CALL MPI_ALLREDUCE(MPI_IN_PLACE,BUFF(1,1),2*NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + IF ( RS .OR. LS ) THEN + ! Intersection: + XPT = (XY(IAXIS,IP )*XY(JAXIS,IP+1) - XY(JAXIS,IP )*XY(IAXIS,IP+1)) / (XY(JAXIS,IP+1)-XY(JAXIS,IP)) -DO NM=1,NMESHES - IF(BUFF(1,NM)>0) THEN ! First Mismatched meshes found. - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A,I5,A,I5,A)') "ERROR(734): Mismatched mesh boundary location between meshes ",BUFF(1,NM),& - " and ",BUFF(2,NM),". Check your mesh MULT line. Mesh boundary locations must strictly match with &GEOM." - ENDIF - DEALLOCATE(BUFF) - CALL SHUTDOWN("") ; RETURN + IF (RS .AND. (XPT > 0._EB)) RCROSS = RCROSS + 1 + IF (LS .AND. (XPT < 0._EB)) LCROSS = LCROSS + 1 ENDIF ENDDO -DEALLOCATE(BUFF) -END SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH -! ----------------------- EXCHANGE_CC_NOADVANCE_INFO ---------------------------- +IF ( MOD(RCROSS,2) /= MOD(LCROSS,2) ) THEN ! Point on edge + PTSFLAG = .TRUE. + RETURN +ENDIF -SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO +IF ( MOD(RCROSS,2) == 1) THEN ! Point inside + PTSFLAG = .TRUE. + RETURN +ENDIF - USE MPI_F08 +RETURN +END SUBROUTINE TEST_PT_INPOLY - ! Local Variables: - INTEGER :: NM,NOM,N,IERR,I,J,K,ICC,JCC - TYPE(MESH_TYPE), POINTER :: M - TYPE (MPI_REQUEST), ALLOCATABLE, DIMENSION(:) :: REQ0,REQ0DUM - INTEGER :: N_REQ0 - LOGICAL :: PROCESS_SENDREC - ! Define cut-cells to be blocked for exchange: - DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - ! Count cut-cells for blocking in mesh: - M%N_CC_BLOCKED = 0 - DO ICC=1,MESHES(NM)%N_CUTCELL_MESH - CC => CUT_CELL(ICC) - DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)>0) M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 - ENDDO - ENDDO - IF (M%N_CC_BLOCKED>0) THEN - IF(ALLOCATED(M%XYZ_CC_BLOCKED)) DEALLOCATE(M%XYZ_CC_BLOCKED) - IF(ALLOCATED(M%JBT_CC_BLOCKED)) DEALLOCATE(M%JBT_CC_BLOCKED) - ALLOCATE(M%XYZ_CC_BLOCKED(3,M%N_CC_BLOCKED)) - ALLOCATE(M%JBT_CC_BLOCKED(2,M%N_CC_BLOCKED)) - ! Fill in blocked cut-cell info: - M%N_CC_BLOCKED = 0 - DO ICC=1,MESHES(NM)%N_CUTCELL_MESH - CC => CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)>0) THEN - M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 - M%XYZ_CC_BLOCKED(1:3,M%N_CC_BLOCKED) = (/XC(I),YC(J),ZC(K)/) - M%JBT_CC_BLOCKED(1:2,M%N_CC_BLOCKED) = (/JCC,CC%NOADVANCE(JCC)/) - ENDIF - ENDDO - ENDDO - ENDIF - ENDDO - ! MPI Exchange: - IF (N_MPI_PROCESSES>1) THEN - ALLOCATE(REQ0(NMESHES)); N_REQ0 = 0 - ! Exchange number of cut-cells information to be exchanged between MESH and OMESHES: - ! Receive from neighbors: - DO NM=1,NMESHES - DO NOM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - PROCESS_SENDREC = .FALSE. - DO N=1,MESHES(NM)%N_NEIGHBORING_MESHES - IF (NOM==MESHES(NM)%NEIGHBORING_MESH(N)) PROCESS_SENDREC = .TRUE. - ENDDO - IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NM)/=MY_RANK .AND. PROCESS_SENDREC) THEN - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_IRECV(MESHES(NM)%N_CC_BLOCKED,1,MPI_INTEGER,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) - ENDIF - ENDDO - ENDDO - ! Send to neighbors: - DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - DO NOM=1,NMESHES - PROCESS_SENDREC = .FALSE. - DO N=1,MESHES(NOM)%N_NEIGHBORING_MESHES - IF (NM==MESHES(NOM)%NEIGHBORING_MESH(N)) PROCESS_SENDREC = .TRUE. - ENDDO - IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NOM)/=MY_RANK .AND. PROCESS_SENDREC) THEN - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_ISEND(MESHES(NM)%N_CC_BLOCKED,1,MPI_INTEGER,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) - ENDIF - ENDDO - ENDDO - IF (N_REQ0>0) CALL MPI_WAITALL(N_REQ0,REQ0(1:N_REQ0),MPI_STATUSES_IGNORE,IERR) +! ------------------------ GET_SEGSEG_INTERSECTION ------------------------------ - ! At this point values of MESHES(NM)%N_CC_BLOCKED are populated for PROCESSSED and NEIGNBORING meshes. - DO NM=1,NMESHES - IF (PROCESS(NM)==MY_RANK) CYCLE ! already done for this mesh at the beginning of the routine. - IF(MESHES(NM)%N_CC_BLOCKED>0) THEN - IF(ALLOCATED(MESHES(NM)%XYZ_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED) - IF(ALLOCATED(MESHES(NM)%JBT_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%JBT_CC_BLOCKED) - ALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED(3,MESHES(NM)%N_CC_BLOCKED)) - ALLOCATE(MESHES(NM)%JBT_CC_BLOCKED(2,MESHES(NM)%N_CC_BLOCKED)) - ENDIF - ENDDO +SUBROUTINE GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) - ! Exchange blocked cutcells lists: - ! Receive from neighbors: - N_REQ0 = 0 - DO NM=1,NMESHES - DO NOM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - PROCESS_SENDREC = .FALSE. - DO N=1,MESHES(NM)%N_NEIGHBORING_MESHES - IF (NOM==MESHES(NM)%NEIGHBORING_MESH(N) .AND. MESHES(NM)%N_CC_BLOCKED>0) PROCESS_SENDREC=.TRUE. - ENDDO - IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NM)/=MY_RANK .AND. PROCESS_SENDREC) THEN - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_IRECV(MESHES(NM)%XYZ_CC_BLOCKED(1,1),3*MESHES(NM)%N_CC_BLOCKED,& - MPI_DOUBLE_PRECISION,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_IRECV(MESHES(NM)%JBT_CC_BLOCKED(1,1),2*MESHES(NM)%N_CC_BLOCKED,& - MPI_INTEGER,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) - ENDIF - ENDDO - ENDDO - ! Send to neighbors: - DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - DO NOM=1,NMESHES - PROCESS_SENDREC = .FALSE. - DO N=1,MESHES(NOM)%N_NEIGHBORING_MESHES - IF (NM==MESHES(NOM)%NEIGHBORING_MESH(N) .AND. MESHES(NM)%N_CC_BLOCKED>0) PROCESS_SENDREC=.TRUE. - ENDDO - IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NOM)/=MY_RANK .AND. PROCESS_SENDREC) THEN - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_ISEND(MESHES(NM)%XYZ_CC_BLOCKED(1,1),3*MESHES(NM)%N_CC_BLOCKED,& - MPI_DOUBLE_PRECISION,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) - N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_ISEND(MESHES(NM)%JBT_CC_BLOCKED(1,1),2*MESHES(NM)%N_CC_BLOCKED,& - MPI_INTEGER,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) - ENDIF - ENDDO - ENDDO - IF (N_REQ0>0) CALL MPI_WAITALL(N_REQ0,REQ0(1:N_REQ0),MPI_STATUSES_IGNORE,IERR) +REAL(EB), INTENT(IN) :: P1(IAXIS:JAXIS),D1(IAXIS:JAXIS),P2(IAXIS:JAXIS),D2(IAXIS:JAXIS) +REAL(EB), INTENT(OUT):: SVARV(NOD1:NOD2,EDG1:EDG2), SLENV(EDG1:EDG2) +INTEGER, INTENT(OUT):: INT_FLG - ! Deallocate REQ0: - IF(ALLOCATED(REQ0)) DEALLOCATE(REQ0) - ENDIF +! Local Variables: +REAL(EB) :: SVR, TVR, KRS, KRS2, E2, L12, L22, E(IAXIS:JAXIS), S1, S2, SMIN, SMAX - CONTAINS - SUBROUTINE CHECK_REQ0_SIZE - IF(N_REQ0>SIZE(REQ0,DIM=1)) THEN - ALLOCATE(REQ0DUM(SIZE(REQ0,DIM=1)+NMESHES)) - REQ0DUM(1:N_REQ0-1) = REQ0(1:N_REQ0-1) - CALL MOVE_ALLOC(REQ0DUM,REQ0) - ENDIF - END SUBROUTINE CHECK_REQ0_SIZE +! Test for segment-segment intersection: +E(IAXIS:JAXIS) = P2(IAXIS:JAXIS) - P1(IAXIS:JAXIS) +KRS = D1(IAXIS)*D2(JAXIS) - D1(JAXIS)*D2(IAXIS); KRS2=KRS**2._EB +L12 = D1(IAXIS)**2._EB + D1(JAXIS)**2._EB +L22 = D2(IAXIS)**2._EB + D2(JAXIS)**2._EB +! Case of segments not parallel. +IF ( KRS2 > GEOMEPS**2._EB*L12*L22) THEN + SVR = (E(IAXIS)*D2(JAXIS)-E(JAXIS)*D2(IAXIS))/ KRS + IF ( (SVR<-GEOMEPS) .OR. ((SVR-1._EB)>GEOMEPS) ) THEN + ! intersection not a point of segment SEG. + INT_FLG = 0 + RETURN + ENDIF + TVR = (E(IAXIS)*D1(JAXIS)-E(JAXIS)*D1(IAXIS))/ KRS + IF ( (TVR<-GEOMEPS) .OR. ((TVR-1._EB)>GEOMEPS) ) THEN + ! intersection not a point of segment SEG2. + INT_FLG = 0 + RETURN + ENDIF + ! Intersection a point on SEG and SEG2. + SLENV(EDG1) = SQRT(L12) + SLENV(EDG2) = SQRT(L22) + SVARV(NOD1,EDG1) = SVR*SLENV(EDG1) + SVARV(NOD1,EDG2) = TVR*SLENV(EDG2) + INT_FLG=1 + RETURN +ENDIF - END SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO +! Parallel Segments: +E2 = E(IAXIS)**2._EB + E(JAXIS)**2._EB +KRS= E(IAXIS)*D1(JAXIS) - E(JAXIS)*D1(IAXIS); KRS2=KRS**2._EB +IF ( KRS2 > GEOMEPS**2._EB*L12*E2 ) THEN + ! Segments are different. + INT_FLG = 0 + RETURN +ENDIF +! Segment lines are the same. +S1 = DOT_PRODUCT(D1,E)/L12; S2 = S1+DOT_PRODUCT(D1,D2)/L12 +SMIN=MIN(S1,S2); SMAX=MAX(S1,S2) +IF ( (1._EB+GEOMEPS) < SMIN .OR. (0._EB-GEOMEPS) > SMAX) THEN + INT_FLG = 0 + RETURN +ENDIF +! Overlap tests: +SLENV(EDG1) = SQRT(L12) +SLENV(EDG2) = SQRT(L22) +IF ( (1._EB+GEOMEPS) > SMIN ) THEN ! SMIN between P1 and P1+D1 + IF ( (0._EB-GEOMEPS) < SMAX) THEN ! SMAX greater that P1 + IF (0._EB < SMIN) THEN ! SMIN higher that P1 + SVARV(NOD1,EDG1) = SMIN*SLENV(EDG1) ! First crossing on P1-P1+D1 + IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN ! SMIN is P2 + SVARV(NOD1,EDG2)=0._EB ! First crossing in P2-P2+D2 + ELSE ! SMIN is P2+D2 + SVARV(NOD2,EDG2)=1._EB*SLENV(EDG2) ! Second crossing in P2-P2+D2 + ENDIF + ELSE ! SMIN lower than P1 + SVARV(NOD1,EDG1) = 0._EB ! First crossing in P1-P1+D1 + IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN ! SMIN os P2 + SVARV(NOD1,EDG2)=-SMIN*SLENV(EDG1) ! First crossing in P2-P2-D2 + ELSE + SVARV(NOD2,EDG2)=SMAX*SLENV(EDG1) + ENDIF + ENDIF + IF (1._EB > SMAX) THEN + SVARV(NOD2,EDG1) = SMAX*SLENV(EDG1) + IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN ! SMAX is P2 + SVARV(NOD1,EDG2)=0._EB*SLENV(EDG2) + ELSE + SVARV(NOD2,EDG2)=1._EB*SLENV(EDG2) + ENDIF + ELSE + SVARV(NOD2,EDG1) = 1._EB*SLENV(EDG1) + IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN ! SMAX is P2 + SVARV(NOD1,EDG2)=(SMAX-1._EB)*SLENV(EDG1) + ELSE + SVARV(NOD2,EDG2)=(1._EB-SMIN)*SLENV(EDG1) + ENDIF + ENDIF + INT_FLG = 2 + ELSE + ! SMAX = 0._EB + SVARV(NOD1,EDG1) = 0._EB + IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN + SVARV(NOD1,EDG2) = 0._EB + ELSE + SVARV(NOD1,EDG2) = 1._EB*SLENV(EDG2) + ENDIF + INT_FLG = 1 + ENDIF +ELSE + ! SMIN = 1._EB + SVARV(NOD1,EDG1) = 1._EB*SLENV(EDG1) + IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN + SVARV(NOD1,EDG2) = 0._EB + ELSE + SVARV(NOD1,EDG2) = 1._EB*SLENV(EDG2) + ENDIF + INT_FLG = 1 +ENDIF -! ----------------------- BLOCK_SMALL_UNLINKED_CUTCELLS ---------------------------- +RETURN +END SUBROUTINE GET_SEGSEG_INTERSECTION -SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS(NM,NBLKCELLS) -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(OUT):: NBLKCELLS +! -------------------- LINE_INTERSECT_COORDPLANE -------------------------------- -INTEGER :: ICC,JCC,I,J,K,IFC,IEC,JEC,IVR,DUM,NSEG,ISEG,JFC,INOD1,INOD2,X1AXIS,COUNT,NCELL -TYPE(MESH_TYPE), POINTER :: M -CHARACTER(100) :: FILENAME +SUBROUTINE LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LNC,XYZ_INT,INTFLG) -M => MESHES(NM) -NBLKCELLS = 0 +INTEGER, INTENT(IN) :: X1AXIS +REAL(EB), INTENT(IN) :: X1PLN,PLNORMAL(MAX_DIM),LNC(MAX_DIM,NOD1:NOD2) +REAL(EB), INTENT(OUT):: XYZ_INT(MAX_DIM) +LOGICAL, INTENT(OUT) :: INTFLG -IF(DEBUG_SET_CUTCELLS) THEN +! Local variables: +REAL(EB) :: DVEC(MAX_DIM), DIRV(MAX_DIM), NMDV, DENOM, PLNEQ, TLINE +! REAL(QB) :: DVECQ(MAX_DIM), DIRVQ(MAX_DIM), NMDVQ, DENOMQ, PLNEQQ, TLINEQ - ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges1.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH - DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH - CE=>MESHES(NM)%CUT_EDGE(IEC) - WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) - DO IVR=1,CE%NVERT - WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO IVR=1,CE%NVERT - WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& - CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) - ENDDO - ENDDO - CLOSE(33) - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces1.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH - DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 - IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 - WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) - DO IVR=1,CF%NVERT - WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(I6,I6)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) - DO DUM=1,CF%CFELEM(1,JFC) - WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) - ENDDO - DO DUM=1,CF%CEDGES(1,JFC) - WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) - ENDDO - ENDDO - DO ISEG=1,NSEG - WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) - ENDDO - ENDDO - CLOSE(33) +! Initialize: +INTFLG = .FALSE. +XYZ_INT(IAXIS:KAXIS) = 0._EB + +! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN +! Preliminary calculations: +DVEC(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD2) - LNC(IAXIS:KAXIS,NOD1) +NMDV = SQRT( DVEC(IAXIS)**2._EB + DVEC(JAXIS)**2._EB + DVEC(KAXIS)**2._EB ) +DIRV = DVEC(IAXIS:KAXIS) * NMDV**(-1._EB) +DENOM = DIRV(IAXIS)*PLNORMAL(IAXIS) +DIRV(JAXIS)*PLNORMAL(JAXIS) +DIRV(KAXIS)*PLNORMAL(KAXIS) +PLNEQ = LNC(IAXIS,NOD1)*PLNORMAL(IAXIS) + & + LNC(JAXIS,NOD1)*PLNORMAL(JAXIS) + & + LNC(KAXIS,NOD1)*PLNORMAL(KAXIS) - X1PLN + +! Line parallel to plane: +IF ( ABS(DENOM) < GEOMEPS ) THEN + ! Check if seg lies on plane or not. + ! Do this by checking if node one of segment is on plane. + IF ( ABS(PLNEQ) < GEOMEPS ) THEN + XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1); XYZ_INT(X1AXIS) = X1PLN + INTFLG = .TRUE. + ENDIF + RETURN ENDIF -! Create new cut-edges and faces: -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - JCC_LOOP : DO JCC=1,M%CUT_CELL(ICC)%NCELL - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP - NBLKCELLS = NBLKCELLS + 1 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,1) - ENDDO JCC_LOOP - ENDDO - ENDDO -ENDDO +! Non parallel case: +TLINE = -PLNEQ/DENOM ! Coordinate along the line LNC. +XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1) + TLINE*DIRV(IAXIS:KAXIS) ! Intersection point. +XYZ_INT(X1AXIS) = X1PLN ! Force X1AXIS coordinate to be the planes value. +! ELSE +! ! Preliminary calculations: +! DVECQ(IAXIS:KAXIS) = REAL(LNC(IAXIS:KAXIS,NOD2),QB) - REAL(LNC(IAXIS:KAXIS,NOD1),QB) +! NMDVQ = SQRT( DVECQ(IAXIS)**2._QB + DVECQ(JAXIS)**2._QB + DVECQ(KAXIS)**2._QB ) +! DIRVQ = DVECQ(IAXIS:KAXIS) * NMDVQ**(-1._QB) +! DENOMQ = DIRVQ(IAXIS)*REAL(PLNORMAL(IAXIS),QB) + & +! DIRVQ(JAXIS)*REAL(PLNORMAL(JAXIS),QB) + & +! DIRVQ(KAXIS)*REAL(PLNORMAL(KAXIS),QB) +! PLNEQQ = REAL(LNC(IAXIS,NOD1),QB)*REAL(PLNORMAL(IAXIS),QB) + & +! REAL(LNC(JAXIS,NOD1),QB)*REAL(PLNORMAL(JAXIS),QB) + & +! REAL(LNC(KAXIS,NOD1),QB)*REAL(PLNORMAL(KAXIS),QB) - REAL(X1PLN,QB) +! +! ! Line parallel to plane: +! IF ( ABS(REAL(DENOMQ,EB)) < GEOMEPS ) THEN +! ! Check if seg lies on plane or not. +! ! Do this by checking if node one of segment is on plane. +! IF ( ABS(REAL(PLNEQ,EB)) < GEOMEPS ) THEN +! XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1); XYZ_INT(X1AXIS) = X1PLN +! INTFLG = .TRUE. +! ENDIF +! RETURN +! ENDIF +! +! ! Non parallel case: +! TLINEQ = -PLNEQQ/DENOMQ ! Coordinate along the line LNC. +! XYZ_INT(IAXIS:KAXIS) = REAL(REAL(LNC(IAXIS:KAXIS,NOD1),QB)+TLINEQ*DIRVQ(IAXIS:KAXIS),EB) ! Intersection pt. +! XYZ_INT(X1AXIS) = X1PLN ! Force X1AXIS coordinate to be the planes value. +! ENDIF -! Drop cut-edges and faces that were gas or boundary of blocked cells. -COUNT=0 -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - NCELL = M%CUT_CELL(ICC)%NCELL - JCC_LOOP_2 : DO JCC=1,NCELL - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_2 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,2) - ENDDO JCC_LOOP_2 - ENDDO - ENDDO -ENDDO +INTFLG = .TRUE. -! Drop blocked cells: -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - NCELL = M%CUT_CELL(ICC)%NCELL - JCC_LOOP_3 : DO JCC=NCELL,1,-1 - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_3 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,3) - ENDDO JCC_LOOP_3 - ENDDO - ENDDO -ENDDO -! Build remaining Regular shaped GASPHASE cut-faces: -CALL GET_REMAINING_CUTFACES(NM) -! Build remaining Regular shaped GASPHASE cut-cells: -CALL GET_REMAINING_CUTCELLS(NM) -! Clean up CUT_CELL, CUT_FACE arrays: -CALL CUT_CELL_FACE_ARRAYS_CLEANUP(NM) +RETURN +END SUBROUTINE LINE_INTERSECT_COORDPLANE -IF(DEBUG_SET_CUTCELLS) THEN - ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges2.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH - DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH - CE=>MESHES(NM)%CUT_EDGE(IEC) - WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) - DO IVR=1,CE%NVERT - WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO IVR=1,CE%NVERT - WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& - CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) - ENDDO - ENDDO - CLOSE(33) - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces2.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH - DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 - IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 - WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) - DO IVR=1,CF%NVERT - WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(I8,I8)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) - DO DUM=1,CF%CFELEM(1,JFC) - WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) - ENDDO - DO DUM=1,CF%CEDGES(1,JFC) - WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) - ENDDO - ENDDO - DO ISEG=1,NSEG - WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) - ENDDO - ENDDO - CLOSE(33) +! ------------------------- CC_INIT_GEOM --------------------------------------- - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeECVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%ECVAR(I,J,K,CC_EGSC,IAXIS),& - M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) - DO X1AXIS=IAXIS,KAXIS - IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN - IEC=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) - IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT EDGE does not match ECVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE - DO JEC=1,CE%NEDGE - INOD1=CE%CEELEM(NOD1,JEC) - INOD2=CE%CEELEM(NOD2,JEC) - WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) - WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) - IF(CE%VERT_LIST(1,INOD1)==CE%VERT_LIST(1,INOD2) .AND. & - CE%VERT_LIST(2,INOD1)==CE%VERT_LIST(2,INOD2) .AND. & - CE%VERT_LIST(3,INOD1)==CE%VERT_LIST(3,INOD2) .AND. & - CE%VERT_LIST(4,INOD1)==CE%VERT_LIST(4,INOD2)) THEN - IF(CE%VERT_LIST(1,INOD1)/=CC_VTYPE_NINB) & - WRITE(LU_ERR,*) 'Edge with same node types=',IEC,JEC,CE%NEDGE,CE%XYZVERT(:,INOD1),& - CE%XYZVERT(:,INOD2),CE%VERT_LIST(1:4,INOD1) - ENDIF - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) +SUBROUTINE CC_INIT_GEOM - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - DO X1AXIS=IAXIS,KAXIS - IF(M%FCVAR(I,J,K,CC_IDCE,X1AXIS)>0)THEN - IEC=M%FCVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) - IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT EDGE does not match FCVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE - DO JEC=1,CE%NEDGE - INOD1=CE%CEELEM(NOD1,JEC) - INOD2=CE%CEELEM(NOD2,JEC) - WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) - WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) +! Local Variables: +INTEGER :: IG, IWSEL, INOD, IEDGE, NVERT, NWSEL, NWSEDG, IEDLIST, IX, N_TENT_EDGES +INTEGER :: WSELEM(NOD1:NOD3),SEG(NOD1:NOD2) +REAL(EB):: XYZV(MAX_DIM,NODS_WSEL), V12(MAX_DIM), V23(MAX_DIM), V31(MAX_DIM), WSNORM(MAX_DIM) +REAL(EB):: X12(MAX_DIM), X23(MAX_DIM), X31(MAX_DIM), SQAREA(MAX_DIM), INT2 +REAL(EB):: MGNRM, XCEN +REAL(EB):: GEOMEPSSQ ! Local epsilon for GEOM quality check +INTEGER, ALLOCATABLE, DIMENSION(:,:):: EDGES2 +LOGICAL, ALLOCATABLE, DIMENSION(:) :: COUNTED_VERT +! REAL(QB) :: V12Q(IAXIS:KAXIS),V23Q(IAXIS:KAXIS),V31Q(IAXIS:KAXIS),WSNORMQ(IAXIS:KAXIS),MGNRMQ +REAL(EB) :: CPUTIME_START, CPUTIME - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaceFCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%FCVAR(I,J,K,CC_FGSC,IAXIS),& - M%FCVAR(I,J,K,CC_FGSC,JAXIS),M%FCVAR(I,J,K,CC_FGSC,KAXIS) - DO X1AXIS=IAXIS,KAXIS - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)==CC_CUTCFE)THEN - IEC=M%FCVAR(I,J,K,CC_IDCF,X1AXIS); CF=>M%CUT_FACE(IEC) - IF(CF%IJK(IAXIS)/=I .OR. CF%IJK(JAXIS)/=J .OR. CF%IJK(KAXIS)/=K .OR. CF%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT FACE does not match FCVAR',I,J,K,X1AXIS,':',CF%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE - DO JEC=1,CF%NFACE - WRITE(33,'(I8,3F16.8,F16.8)') CF%IJK(4),CF%XYZCEN(:,JEC),CF%AREA(JEC) - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) +IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_ERR,'(A,I5,A)',advance="no") ' 1b. Number of Geometries : ',N_GEOMETRY,& + ', CC_INIT_GEOM, processed GEOMETRY : ' +ENDIF - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutcellCCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8)') I,J,K,M%CCVAR(I,J,K,CC_CGSC) - IF(M%CCVAR(I,J,K,CC_CGSC)==CC_CUTCFE)THEN - IEC=M%CCVAR(I,J,K,CC_IDCC); CC=>M%CUT_CELL(IEC) - IF(CC%IJK(IAXIS)/=I .OR. CC%IJK(JAXIS)/=J .OR. CC%IJK(KAXIS)/=K) & - WRITE(LU_ERR,*) 'CUT CELL does not match CCVAR',I,J,K,':',CC%IJK(IAXIS:KAXIS) - WRITE(33,'(I8,I8,I8,I8,I8)') CC%IJK(1:3),CC%NCELL - DO JEC=1,CC%NCELL - WRITE(33,'(I8,3F16.8,F16.8)') JEC,CC%XYZCEN(:,JEC),CC%VOLUME(JEC) - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - CLOSE(33) -ENDIF +! In this subroutine the quality of the GEOM lines is checked +! Calc local squared epsilon for GEOM quality check +GEOMEPSSQ = (GEOMEPS * GEOMQUALITYFCT)**2._EB -RETURN -END SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS +! Geometry loop: +GEOMETRY_LOOP : DO IG=1,N_GEOMETRY -! ------------------------- GET_REMAINING_CUTCELLS -------------------------------- + NWSEL = GEOMETRY(IG)%N_FACES + NVERT = GEOMETRY(IG)%N_VERTS -SUBROUTINE GET_REMAINING_CUTCELLS(NM) + IF (GEOMETRY(IG)%IS_TERRAIN) THEN ! Terrain is always manifold with volume. + N_TENT_EDGES = INT(1.55_EB*REAL(NWSEL,EB)) ! Number of edges is 1.5 number of triangles. + ELSE + N_TENT_EDGES = 3*NWSEL + ENDIF -! Define regular cut-cells for regular cartesian cells surrounded by a gas cut-face. -INTEGER, INTENT(IN) :: NM + ! Allocate fields of Geometry used by IBM: + ! WS Faces normal unit vectors: + IF (ALLOCATED(GEOMETRY(IG)%FACES_NORMAL)) DEALLOCATE(GEOMETRY(IG)%FACES_NORMAL) + ALLOCATE(GEOMETRY(IG)%FACES_NORMAL(MAX_DIM,NWSEL)) + ! WS Faces areas: + IF (ALLOCATED(GEOMETRY(IG)%FACES_AREA)) DEALLOCATE(GEOMETRY(IG)%FACES_AREA) + ALLOCATE(GEOMETRY(IG)%FACES_AREA(NWSEL)) + ! WS Faces edges: + IF (ALLOCATED(GEOMETRY(IG)%EDGES)) DEALLOCATE(GEOMETRY(IG)%EDGES) + ALLOCATE(GEOMETRY(IG)%EDGES(NOD1:NOD2,N_TENT_EDGES)) ! Size large enough to take care of surfaces + ! (zero thickness immersed solids) and 3D domains + ! boundaries (what we call wet surfaces). + ! WS Faces edges: + IF (ALLOCATED(GEOMETRY(IG)%FACE_EDGES)) DEALLOCATE(GEOMETRY(IG)%FACE_EDGES) + ALLOCATE(GEOMETRY(IG)%FACE_EDGES(EDG1:EDG3,NWSEL)) ! Edges in GEOMETRY(IG)%EDGES for this triangle. + ! WS Edges faces: + IF (ALLOCATED(GEOMETRY(IG)%EDGE_FACES)) DEALLOCATE(GEOMETRY(IG)%EDGE_FACES) + ALLOCATE(GEOMETRY(IG)%EDGE_FACES(5,N_TENT_EDGES)) ! Triangles sharing this edge [niel iwel1 LocEdge1 iwel2 LocEdge2] -! Local Variables: -INTEGER :: I,J,K,CT,X1AXIS,SIDE,ICC,JCC,IFACE,ICF,JCF,ICFC,ICFINB,NCFACE_CUTCELL,NCELL,NFACE_CELL -INTEGER :: NCC_MESH,NGC_MESH,NCELL_IN,NCELL_GC,COUNT_CC,COUNT_GC -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME -INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX -LOGICAL, PARAMETER :: OPT=.TRUE. + ! COUNTED_VERT used for test of loose vertices: + ALLOCATE(COUNTED_VERT(1:NVERT)); COUNTED_VERT = .FALSE. -M => MESHES(NM) + GEOMETRY(IG)%GEOM_VOLUME = 0._EB + GEOMETRY(IG)%GEOM_AREA = 0._EB + GEOMETRY(IG)%GEOM_XYZCEN(:) = 0._EB -! First thing is, for known cut-cells with reg faces that have changed to cut-faces to change the -! FACE_LIST incidence: -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_CUTCFE) CYCLE - ICC=M%CCVAR(I,J,K,CC_IDCC) - CC=>M%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - DO ICF=2,CC%CCELEM(1,JCC)+1 - IFACE = CC%CCELEM(ICF,JCC) - SIDE = CC%FACE_LIST(2,IFACE) - X1AXIS= CC%FACE_LIST(3,IFACE) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE - ICFC = M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS) - IF(ICFC>0) CC%FACE_LIST(:,IFACE) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) ! New cut-face. - ENDDO - ENDDO - ENDDO - ENDDO -ENDDO + ! Compute normal, area and volume: + SQAREA(IAXIS:KAXIS) = 0._EB + DO IWSEL=1,NWSEL -IF (OPT) THEN + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) -NCC_MESH = M%N_CUTCELL_MESH -NGC_MESH = M%N_GCCUTCELL_MESH + COUNTED_VERT(WSELEM(NOD1:NOD3)) = .TRUE. -! First count how many new cells are goint to be created inside, and in ghost cell region: -NCELL_IN=0 -NCELL_GC=0 -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE - ! Test for gas cut-faces: - CT=0 - IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - IF(K<1 .OR. K>M%KBAR .OR. J<1 .OR. J>M%JBAR .OR. I<1 .OR. I>M%IBAR) THEN - NCELL_GC = NCELL_GC + 1 - ELSE - NCELL_IN = NCELL_IN + 1 - ENDIF + ! Triangles NODES coordinates: + DO INOD=NOD1,NOD3 + XYZV(IAXIS:KAXIS,INOD) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+1:MAX_DIM*WSELEM(INOD)) ENDDO - ENDDO -ENDDO -! Reset CCVAR, CELL_LIST indexes: -DO K=-CCGUARD,M%KBAR+CCGUARD - DO J=-CCGUARD,M%JBAR+CCGUARD - DO I=-CCGUARD,M%IBAR+CCGUARD - ! All GC cut-cells get their index + NCELL_IN - IF(M%CCVAR(I,J,K,CC_IDCC)<=NCC_MESH) CYCLE - M%CCVAR(I,J,K,CC_IDCC)=M%CCVAR(I,J,K,CC_IDCC) + NCELL_IN - ENDDO - ENDDO -ENDDO -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - DO JCF=1,M%CUT_FACE(ICF)%NFACE - IF(M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>NCC_MESH) & - M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + NCELL_IN - IF(M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>NCC_MESH) & - M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + NCELL_IN - ENDDO -ENDDO + V12(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD2) - XYZV(IAXIS:KAXIS,NOD1) + V23(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD3) - XYZV(IAXIS:KAXIS,NOD2) + V31(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD1) - XYZV(IAXIS:KAXIS,NOD3) -! Make space for NCELL_IN, NCELL_GC cut-cell entries. -ALLOCATE(CUT_CELL_AUX( MAX(SIZE(M%CUT_CELL,DIM=1),NCC_MESH + NCELL_IN +NGC_MESH + NCELL_GC) )) -CUT_CELL_AUX(1:NCC_MESH) = M%CUT_CELL(1:NCC_MESH) -CUT_CELL_AUX(NCC_MESH+NCELL_IN+1:NCC_MESH+NCELL_IN+NGC_MESH) = M%CUT_CELL(NCC_MESH+1:NCC_MESH+NGC_MESH) -CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL); M=> MESHES(NM) + ! Check that face edges are not too small + IF ((V12(IAXIS)**2._EB + V12(JAXIS)**2._EB + V12(KAXIS)**2._EB ) < GEOMEPSSQ) THEN + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD2) + WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD1),', ',WSELEM(NOD2),' are not equal.' + ENDIF + CALL SHUTDOWN("") ; RETURN + ENDIF + IF ((V23(IAXIS)**2._EB + V23(JAXIS)**2._EB + V23(KAXIS)**2._EB ) < GEOMEPSSQ) THEN + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD3) + WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD2),', ',WSELEM(NOD3),' are not equal.' + END IF + CALL SHUTDOWN("") ; RETURN + ENDIF + IF ((V31(IAXIS)**2._EB + V31(JAXIS)**2._EB + V31(KAXIS)**2._EB ) < GEOMEPSSQ) THEN + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(MESSAGE,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD1) + WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD1),', ',WSELEM(NOD3),' are not equal.' + ENDIF + CALL SHUTDOWN("") ; RETURN + END IF -! Then build new regular cut-cells: -COUNT_CC = 0 -COUNT_GC = 0 -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE - ! Test for gas cut-faces: - CT=0 - IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE + ! Cross V12 x V23: + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + WSNORM(IAXIS) = V12(JAXIS)*V23(KAXIS) - V12(KAXIS)*V23(JAXIS) + WSNORM(JAXIS) = V12(KAXIS)*V23(IAXIS) - V12(IAXIS)*V23(KAXIS) + WSNORM(KAXIS) = V12(IAXIS)*V23(JAXIS) - V12(JAXIS)*V23(IAXIS) + MGNRM = SQRT( WSNORM(IAXIS)**2._EB + WSNORM(JAXIS)**2._EB + WSNORM(KAXIS)**2._EB ) + ! ELSE + ! V12Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD2),QB) - REAL(XYZV(IAXIS:KAXIS,NOD1),QB) + ! V23Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD3),QB) - REAL(XYZV(IAXIS:KAXIS,NOD2),QB) + ! V31Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD1),QB) - REAL(XYZV(IAXIS:KAXIS,NOD3),QB) + ! WSNORMQ(IAXIS) = V12Q(JAXIS)*V23Q(KAXIS) - V12Q(KAXIS)*V23Q(JAXIS) + ! WSNORMQ(JAXIS) = V12Q(KAXIS)*V23Q(IAXIS) - V12Q(IAXIS)*V23Q(KAXIS) + ! WSNORMQ(KAXIS) = V12Q(IAXIS)*V23Q(JAXIS) - V12Q(JAXIS)*V23Q(IAXIS) + ! MGNRMQ = SQRT( WSNORMQ(IAXIS)**2._QB + WSNORMQ(JAXIS)**2._QB + WSNORMQ(KAXIS)**2._QB ) + ! MGNRM = REAL(MGNRMQ,EB) + ! ENDIF - ! Count allocation number for faces boundary of this cut-cell: - CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT + XCEN = (XYZV(IAXIS,NOD1) + XYZV(IAXIS,NOD2) + XYZV(IAXIS,NOD3)) / 3._EB - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED + ! Check that face area is not too small + IF(MGNRM < GEOMEPSSQ) THEN + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(728): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,3F12.3)') " Face area too small at:", XYZV(IAXIS:KAXIS,NOD1) + WRITE(LU_ERR,*) ' Face IWSEL=', IWSEL, ', Connectivity=', WSELEM(NOD1:NOD3),', Norm Cross=', MGNRM + ENDIF + CALL SHUTDOWN("") ; RETURN + ENDIF - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO X1AXIS=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO + ! Assign to GEOMETRY: + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) = WSNORM(IAXIS:KAXIS) * MGNRM**(-1._EB) + GEOMETRY(IG)%FACES_AREA(IWSEL) = MGNRM/2._EB + ! ELSE + ! GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) = REAL(WSNORMQ(IAXIS:KAXIS)*MGNRMQ**(-1._QB),EB) + ! GEOMETRY(IG)%FACES_AREA(IWSEL) = REAL(MGNRMQ/2._QB,EB) + ! ENDIF - ! Add INB cut-face if any present: - IF(ICFINB>0) THEN - DO JCF=1,M%CUT_FACE(ICFINB)%NFACE - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDDO - ENDIF + ! Total Area and Volume for GEOMETRY(IG). + GEOMETRY(IG)%GEOM_AREA = GEOMETRY(IG)%GEOM_AREA + GEOMETRY(IG)%FACES_AREA(IWSEL) + GEOMETRY(IG)%GEOM_VOLUME= GEOMETRY(IG)%GEOM_VOLUME+ & ! Divergence theorem with F = x i, assumes we have a volume. + GEOMETRY(IG)%FACES_NORMAL(IAXIS,IWSEL)*XCEN*GEOMETRY(IG)%FACES_AREA(IWSEL) - ! Insert cut_cell: - IF(K<1 .OR. K>MESHES(NM)%KBAR .OR. J<1 .OR. J>MESHES(NM)%JBAR .OR. I<1 .OR. I>MESHES(NM)%IBAR) THEN - COUNT_GC = COUNT_GC + 1 - ICC = NCC_MESH + NCELL_IN + NGC_MESH + COUNT_GC - ELSE - COUNT_CC = COUNT_CC + 1 - ICC = NCC_MESH + COUNT_CC - ENDIF - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - M%CUT_CELL(ICC)%NFACE_DROPPED = 0 - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) - M%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) - M%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE - M%CCVAR(I,J,K,CC_IDCC) = ICC + ! Define Centroid: + X12(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD1) + XYZV(IAXIS:KAXIS,NOD2)) + X23(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD2) + XYZV(IAXIS:KAXIS,NOD3)) + X31(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD3) + XYZV(IAXIS:KAXIS,NOD1)) + ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA + DO IX=IAXIS,KAXIS + INT2 = (X12(IX)**2._EB + X23(IX)**2._EB + X31(IX)**2._EB) / 3._EB + SQAREA(IX) = SQAREA(IX) + GEOMETRY(IG)%FACES_NORMAL(IX,IWSEL)*INT2*GEOMETRY(IG)%FACES_AREA(IWSEL) ! Midpt rule. ENDDO ENDDO -ENDDO -M%N_CUTCELL_MESH = NCC_MESH + NCELL_IN -M%N_GCCUTCELL_MESH = NGC_MESH + NCELL_GC + ! In the broken case where GEOM normals are wrong, GEOM_VOLUME can become too small + IF(GEOMETRY(IG)%GEOM_VOLUME < GEOMEPSSQ) THEN + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(729): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A)') " Geometry volume too small." + WRITE(LU_ERR,'(A)') " Face normals are probably pointing in the wrong direction. " + WRITE(LU_ERR,'(A)') " Check they point towards the gas phase." + ENDIF + CALL SHUTDOWN("") ; RETURN + ENDIF -ELSE + ! Geometry Centroid: + DO IX=IAXIS,KAXIS + GEOMETRY(IG)%GEOM_XYZCEN(IX) = SQAREA(IX) / (2._EB * GEOMETRY(IG)%GEOM_VOLUME) + ENDDO -! Then build new regular cut-cells: -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE - ! Test for gas cut-faces: - CT=0 - IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE + ! Build geometry connectivity + ! While building, check that the triangulated surface is manifold and oriented + NWSEDG = 0 + IX = SIZE(GEOMETRY(IG)%FACES,DIM=1) + CALL GET_GEOM_EDGES(NVERT,NWSEL,IX,GEOMETRY(IG)%FACES,NWSEDG,GEOMETRY(IG)%EDGES,& + GEOMETRY(IG)%FACE_EDGES,GEOMETRY(IG)%EDGE_FACES) - ! Count allocation number for faces boundary of this cut-cell: - CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT + ! Perform manifoldness tests: + ALLOCATE(EDGES2(2,NWSEDG)); EDGES2=0 + DO IWSEL=1,NWSEL + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + DO IEDGE=EDG1,EDG3 + IEDLIST = GEOMETRY(IG)%FACE_EDGES(IEDGE,IWSEL) + IF(WSELEM(IEDGE) == GEOMETRY(IG)%EDGES(NOD1,IEDLIST)) THEN ! First node of face edge equals first node of seg. + EDGES2(1,IEDLIST)=EDGES2(1,IEDLIST)+1 + ELSEIF(WSELEM(IEDGE) == GEOMETRY(IG)%EDGES(NOD2,IEDLIST)) THEN ! Inverted. + EDGES2(2,IEDLIST)=EDGES2(2,IEDLIST)+1 + ENDIF + ENDDO + ENDDO + DO IWSEL=1,NWSEDG + IF(SUM(EDGES2(1:2,IWSEL)) < 2) THEN ! Less that two faces have this edge as boundary: + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEL) + XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) + XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(730): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') " Open geometry at edge with nodes: NOD1",SEG(NOD1),& + " (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",SEG(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" + ENDIF + CALL SHUTDOWN("") ; RETURN - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED + ELSEIF(SUM(EDGES2(1:2,IWSEL)) > 2) THEN ! More than two faces share this edge: + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEL) + XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) + XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(731): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') " Non manifold geometry in adjacent faces at edge with nodes: NOD1",& + SEG(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",SEG(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" + ENDIF + CALL SHUTDOWN("") ; RETURN - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO X1AXIS=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO + ELSEIF(ANY(EDGES2(1:2,IWSEL) > 1)) THEN ! half edge counted more than once, opposite normals on triangles + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEL) + XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) + XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(732): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') & + " Opposite normals on triangles sharing edge with nodes: NOD1",& + SEG(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",SEG(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" + ENDIF + CALL SHUTDOWN("") ; RETURN - ! Add INB cut-face if any present: - IF(ICFINB>0) THEN - DO JCF=1,M%CUT_FACE(ICFINB)%NFACE - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDDO + ENDIF + ENDDO + DEALLOCATE(EDGES2) + + ! Check if the surface is closed + ! Each halfedge should be coupled with an opposite halfedge + DO IEDLIST=1,NWSEDG + IF (GEOMETRY(IG)%EDGE_FACES(1,IEDLIST) == 1) THEN + XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) + XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) + IF (MY_RANK==0) THEN + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ELSE + WRITE(LU_ERR,'(A,A,A)') "ERROR(733): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" + ENDIF + WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') " Open geometry at edge with nodes: NOD1",& + WSELEM(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",WSELEM(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" ENDIF + CALL SHUTDOWN("") ; RETURN + ENDIF + ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NM,I,J,K,ICC); M => MESHES(NM) - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) - ENDDO + ! Check that all vertices are counted: + DO INOD=1,NVERT + IF (.NOT.COUNTED_VERT(INOD) .AND. MY_RANK==0) & + WRITE(LU_ERR,'(A,A,A,I8,A)') " WARNING: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "': Vertex ",INOD," not connected." ENDDO -ENDDO + DEALLOCATE(COUNTED_VERT) -ENDIF + GEOMETRY(IG)%N_EDGES = NWSEDG -END SUBROUTINE GET_REMAINING_CUTCELLS + ! At this point the surface is manifold, well oriented, and closed. + IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN + IF (IG==N_GEOMETRY) THEN + WRITE(LU_ERR,'(I4.4,A,I9.9,A,I9.9,A)',advance="no") IG,', VERTS=',GEOMETRY(IG)%N_VERTS,& + ', FACES=',GEOMETRY(IG)%N_FACES,'.. done.' + CALL CPU_TIME(CPUTIME) + WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken : ',CPUTIME-CPUTIME_START,' sec.' + ELSE + WRITE(LU_ERR,'(I4.4,A)',advance="no") IG,', ' + ENDIF + ENDIF -! ------------------------- GET_REMAINING_CUTFACES -------------------------------- +ENDDO GEOMETRY_LOOP -SUBROUTINE GET_REMAINING_CUTFACES(NM) +! Print out of computed result: +! DO IG=1,N_GEOMETRY +! NWSEL = GEOMETRY(IG)%N_FACES +! DO IWSEL=1,NWSEL +! print*, IWSEL,GEOMETRY(IG)%FACES_AREA(IWSEL) +! ENDDO +! DO IWSEL=1,NWSEL +! print*, IWSEL,GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) +! ENDDO +! print*, "EDGES=" +! DO NWSEDG=1,GEOMETRY(IG)%N_EDGES +! print*, NWSEDG,GEOMETRY(IG)%EDGES(NOD1:NOD2,NWSEDG) +! ENDDO +! DO NWSEDG=1,GEOMETRY(IG)%N_EDGES +! print*, GEOMETRY(IG)%EDGE_FACES(1:5,NWSEDG) +! ENDDO +! print*, "FACES=" +! DO IWSEL=1,NWSEL +! print*, IWSEL,GEOMETRY(IG)%FACE_EDGES(EDG1:EDG3,IWSEL) +! ENDDO +! ENDDO -! Running by axes define regular cut-faces, add to CUT_FACE array. +RETURN +END SUBROUTINE CC_INIT_GEOM -INTEGER, INTENT(IN) :: NM +! ------------------------ GET_GEOM_EDGES --------------------------------------- -! Local Variables: -INTEGER :: I,J,K,CT,X1AXIS,X2AXIS,X3AXIS,IFC,CEI,CEIF,ICC,JCC,ICE,IEDGE,ILOC,IFACE -INTEGER :: NBD_MESH,NCF_MESH,NGF_MESH,NFC_BND,NFC_MSH,NFC_GCR,CT_BND,CT_MSH,CT_GCR,FCINDEX -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES,EDGE_LIST -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZVERT,XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA -TYPE(MESH_TYPE), POINTER :: M -LOGICAL, PARAMETER :: OPT=.TRUE. +SUBROUTINE GET_GEOM_EDGES(NVERT,NWSEL,SIZEFC,FACES,NWSEDG,EDGES,FACE_EDGES,EDGE_FACES) -M => MESHES(NM) +INTEGER, INTENT(IN) :: NVERT,NWSEL,SIZEFC +INTEGER, INTENT(IN) :: FACES(1:SIZEFC) +INTEGER, INTENT(OUT):: NWSEDG,EDGES(NOD1:NOD2,3*NWSEL),FACE_EDGES(EDG1:EDG3,NWSEL),EDGE_FACES(5,3*NWSEL) -IF (OPT) THEN +! Local Variables: +INTEGER :: IWSEL,IVERT,IEDGE,TOT_ELVERT,IEDLIST,WSELEM(NOD1:NOD3),SEG(NOD1:NOD2) +LOGICAL :: INLIST +LOGICAL :: FLG_LOHI +INTEGER, ALLOCATABLE, DIMENSION(:) :: NELVERT,ISTVERT,EDGE_RNK +INTEGER, ALLOCATABLE, DIMENSION(:,:):: EDGES2,EDGE_FACES2 -NBD_MESH = M%N_BBCUTFACE_MESH -NCF_MESH = M%N_CUTFACE_MESH -NGF_MESH = M%N_GCCUTFACE_MESH +NWSEDG = 0 -! First count EXT Boundary, In meshm and ghost cell region cut-faces: -NFC_BND = 0 -NFC_MSH = 0 -NFC_GCR = 0 -! IAXIS cut-faces: -X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-2,M%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%IBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External - ELSEIF(I==0 .OR. I==M%IBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary - ENDIF - ELSE; NFC_GCR = NFC_GCR + 1 ! External - ENDIF - ENDDO - ENDDO +! Populate NELVERT with the number of elements associated per node: +ALLOCATE(NELVERT(NVERT)); NELVERT(:) = 0 +ALLOCATE(ISTVERT(NVERT)); ISTVERT(:) = 0 +DO IWSEL=1,NWSEL + NELVERT(FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL)) = NELVERT(FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL)) + 1 ENDDO -! JAXIS cut-faces: -X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS -DO K=-1,M%KBAR+2 - DO J=-2,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%JBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External - ELSEIF(J==0 .OR. J==M%JBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary - ENDIF - ELSE; NFC_GCR = NFC_GCR + 1 ! External - ENDIF - ENDDO - ENDDO +NELVERT = NELVERT + 1 ! Add buffer. +DO IVERT=2,NVERT + ISTVERT(IVERT) = ISTVERT(IVERT-1) + NELVERT(IVERT-1) ENDDO -! KAXIS cut-faces: -X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS -DO K=-2,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%KBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External - ELSEIF(K==0 .OR. K==M%KBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary - ENDIF - ELSE; NFC_GCR = NFC_GCR + 1 ! External + +! First pass build unique list of segments per VERTEX where: +! SEG_IJ = [ni nj] with ni < nj +TOT_ELVERT = SUM(NELVERT(1:NVERT)) +ALLOCATE(EDGES2(NOD1:NOD2,TOT_ELVERT)); EDGES2(:,:) = 0 +ALLOCATE(EDGE_FACES2( 5,TOT_ELVERT)); EDGE_FACES2(:,:) = 0 +ALLOCATE(EDGE_RNK( TOT_ELVERT)); EDGE_RNK(:) = 0 +NELVERT(:) = 0 ! Reset NELVERT. + +DO IWSEL=1,NWSEL + WSELEM(NOD1:NOD3) = FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + + DO IEDGE=EDG1,EDG3 + SEG(NOD1:NOD2) = (/ MINVAL(WSELEM(NOD1:NOD2)), MAXVAL(WSELEM(NOD1:NOD2)) /) + FLG_LOHI = .TRUE.; IF(SEG(NOD2) /= WSELEM(NOD2)) FLG_LOHI = .FALSE. + + IF(NELVERT(SEG(NOD2)) == 0) THEN + NELVERT(SEG(NOD2)) = NELVERT(SEG(NOD2)) + 1 + FACE_EDGES(IEDGE,IWSEL) = ISTVERT(SEG(NOD2)) + NELVERT(SEG(NOD2)) + EDGES2(NOD1:NOD2,FACE_EDGES(IEDGE,IWSEL)) = SEG(NOD1:NOD2) + EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) = & + EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) + 1 + IF(FLG_LOHI) THEN + EDGE_FACES2(2,FACE_EDGES(IEDGE,IWSEL)) = IWSEL + EDGE_FACES2(3,FACE_EDGES(IEDGE,IWSEL)) = IEDGE + ELSE + EDGE_FACES2(4,FACE_EDGES(IEDGE,IWSEL)) = IWSEL + EDGE_FACES2(5,FACE_EDGES(IEDGE,IWSEL)) = IEDGE + ENDIF + WSELEM=CSHIFT(WSELEM,1) + CYCLE ! IEDGE + ENDIF + + INLIST = .FALSE. + DO IEDLIST=ISTVERT(SEG(NOD2))+1,ISTVERT(SEG(NOD2))+NELVERT(SEG(NOD2)) + ! Here SEG(NOD2) is by construction the same as + ! EDGES2(NOD2,IEDLIST), search only NOD1 component. + IF(SEG(NOD1) == EDGES2(NOD1,IEDLIST)) THEN + INLIST = .TRUE. + EXIT ! IEDLIST ENDIF ENDDO + IF(INLIST) THEN + FACE_EDGES(IEDGE,IWSEL) = IEDLIST + ELSE + NELVERT(SEG(NOD2)) = NELVERT(SEG(NOD2)) + 1 + FACE_EDGES(IEDGE,IWSEL) = ISTVERT(SEG(NOD2)) + NELVERT(SEG(NOD2)) + EDGES2(NOD1:NOD2,FACE_EDGES(IEDGE,IWSEL)) = SEG(NOD1:NOD2) + ENDIF + + EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) = & + EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) + 1 + IF(FLG_LOHI) THEN + EDGE_FACES2(2,FACE_EDGES(IEDGE,IWSEL)) = IWSEL + EDGE_FACES2(3,FACE_EDGES(IEDGE,IWSEL)) = IEDGE + ELSE + EDGE_FACES2(4,FACE_EDGES(IEDGE,IWSEL)) = IWSEL + EDGE_FACES2(5,FACE_EDGES(IEDGE,IWSEL)) = IEDGE + ENDIF + + WSELEM=CSHIFT(WSELEM,1) ENDDO ENDDO -! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): -DO K=-CCGUARD,M%KBAR+CCGUARD - DO J=-CCGUARD,M%JBAR+CCGUARD - DO I=-CCGUARD,M%IBAR+CCGUARD - FCINDEX = M%CCVAR(I,J,K,CC_IDCF) - IF(M%CCVAR(I,J,K,CC_IDCF)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(M%CCVAR(I,J,K,CC_IDCF)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - M%CCVAR(I,J,K,CC_IDCF) = FCINDEX - DO X1AXIS=IAXIS,KAXIS - FCINDEX = M%FCVAR(I,J,K,CC_IDCF,X1AXIS) - IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = FCINDEX - ENDDO - ENDDO +! Second pass get segments ranking: +DO IVERT=1,NVERT + DO IEDLIST=ISTVERT(IVERT)+1,ISTVERT(IVERT)+NELVERT(IVERT) + NWSEDG = NWSEDG + 1 + EDGE_RNK(IEDLIST) = NWSEDG + EDGES(NOD1:NOD2,NWSEDG) = EDGES2(NOD1:NOD2,IEDLIST) + EDGE_FACES(1:5,NWSEDG) = EDGE_FACES2(1:5,IEDLIST) ENDDO ENDDO -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - SELECT CASE(CC%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_RCGAS); CYCLE - CASE DEFAULT - FCINDEX = CC%FACE_LIST(4,IFACE) - IF(CC%FACE_LIST(4,IFACE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(CC%FACE_LIST(4,IFACE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - CC%FACE_LIST(4,IFACE) = FCINDEX - END SELECT - ENDDO + +! Third pass populate FACE_EDGES data: +DO IWSEL=1,NWSEL + DO IEDGE=EDG1,EDG3 + IEDLIST = EDGE_RNK(FACE_EDGES(IEDGE,IWSEL)) + FACE_EDGES(IEDGE,IWSEL) = IEDLIST ENDDO ENDDO -DO ICE=1,M%N_CUTEDGE_MESH - CE=>M%CUT_EDGE(ICE) - DO IEDGE=1,CE%NEDGE - DO ILOC=-2,2 - FCINDEX = CE%FACE_LIST(1,ILOC,IEDGE) - IF(CE%FACE_LIST(1,ILOC,IEDGE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(CE%FACE_LIST(1,ILOC,IEDGE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - CE%FACE_LIST(1,ILOC,IEDGE) = FCINDEX - ENDDO - ENDDO + +DEALLOCATE(NELVERT,ISTVERT,EDGES2,EDGE_FACES2,EDGE_RNK) + +RETURN +END SUBROUTINE GET_GEOM_EDGES + +! ---------------------------- DEBUG_WAIT --------------------------------------- + +SUBROUTINE DEBUG_WAIT +USE COMP_FUNCTIONS, ONLY: FDS_SLEEP +INTEGER I +INTEGER, PARAMETER :: N_SEG=20 +WRITE(LU_ERR,'(A,I6,A,I2,A)') 'Process ID=',MY_RANK,'; execution halted for ',N_SEG,' seconds : ' +DO I=1,N_SEG + CALL FDS_SLEEP(1._EB) + IF (I MESHES(NM) -! Finally, add new cut-faces: -CT_BND = 0 -CT_MSH = 0 -CT_GCR = 0 -! IAXIS cut-faces: -X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-2,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%IBAR) THEN ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ELSEIF(I==0 .OR. I==M%IBAR) THEN ! Block boundary - CT_BND = CT_BND + 1 - IFC = NBD_MESH + CT_BND - ENDIF - ELSE ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ENDIF - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XFACE(I), YCELL(J), ZCELL(K) /); AREA(1) = DYCELL(J)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC - M%CUT_FACE(IFC)%STATUS = CC_GASPHASE - M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) - ENDDO - ENDDO -ENDDO +! ---------------------------- READ_GEOM ---------------------------------------- -! JAXIS cut-faces: -X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-2,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%JBAR) THEN ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ELSEIF(J==0 .OR. J==M%JBAR) THEN ! Block boundary - CT_BND = CT_BND + 1 - IFC = NBD_MESH + CT_BND - ENDIF - ELSE ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ENDIF - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC - M%CUT_FACE(IFC)%STATUS = CC_GASPHASE - M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) - ENDDO - ENDDO -ENDDO +SUBROUTINE READ_GEOM +USE BOXTETRA_ROUTINES, ONLY: TETRAHEDRON_VOLUME, REMOVE_DUPLICATE_VERTS +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +USE MISC_FUNCTIONS, ONLY: GET_MATL_INDEX +USE MPI_F08 +USE OUTPUT_DATA, ONLY: COLOR2RGB -! KAXIS cut-faces: -X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS -DO K=-2,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%KBAR) THEN ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ELSEIF(K==0 .OR. K==M%KBAR) THEN ! Block boundary - CT_BND = CT_BND + 1 - IFC = NBD_MESH + CT_BND - ENDIF - ELSE ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ENDIF - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC - M%CUT_FACE(IFC)%STATUS = CC_GASPHASE - M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) - ENDDO - ENDDO -ENDDO +CHARACTER(LABEL_LENGTH) :: ID,MATL_ID,TEXTURE_MAPPING, & + DEVC_ID,CTRL_ID,SURF_IDS(3),SURF_ID6(6),MOVE_ID +CHARACTER(FN_LENGTH) :: BUFFER,FN_BINGEOM,BINARY_FILE +CHARACTER(LABEL_LENGTH), ALLOCATABLE, DIMENSION(:) :: SURF_ID +CHARACTER(MESSAGE_LENGTH) :: FYI +REAL(EB), ALLOCATABLE, DIMENSION(:) :: ZVALS,TFACES +REAL(EB), ALLOCATABLE, TARGET, DIMENSION(:) :: VERTS,VERTS_AUX +INTEGER, ALLOCATABLE, DIMENSION(:) :: SURF_ID_IND,POLY +INTEGER, ALLOCATABLE, TARGET, DIMENSION(:) :: FACES,FACES_AUX,VOLUS,OFACES,SURFS,SURFS2 +LOGICAL, ALLOCATABLE, DIMENSION(:) :: IS_EXTERNAL -M%N_BBCUTFACE_MESH = NBD_MESH + NFC_BND -M%N_CUTFACE_MESH = NCF_MESH + NFC_BND + NFC_MSH -M%N_GCCUTFACE_MESH = NGF_MESH + NFC_GCR +REAL(EB) :: SPHERE_ORIGIN(3),SPHERE_RADIUS,TEXTURE_ORIGIN(3),TEXTURE_SCALE(2),XB(6),DX,BOX_XYZ(3),& + ZMIN,VOLUME,TXMIN,TXMAX,TYMIN,TYMAX,TX,TY,DV1(MAX_DIM),DV2(MAX_DIM),& + NVECI(MAX_DIM),DXCEN(MAX_DIM),DOTI,TRANSPARENCY,CYLINDER_ORIGIN(3),CYLINDER_AXIS(3),& + CYLINDER_RADIUS,CYLINDER_LENGTH,EXTRUDE,CELL_BLOCK_ORIENTATION(3) -ELSE +INTEGER :: MAX_IDS=0,MAX_SURF_IDS=0,MAX_ZVALS=0,MAX_VERTS=0,MAX_FACES=0,MAX_VOLUS=0,MAX_POLY_VERTS=0,& + N_VERTS,N_FACES,N_FACES_TEMP,N_VOLUS,N_ZVALS,N_SURF_ID,N_SURF_ID2,N_POLY_VERTS,& + MATL_INDEX,IOS,IZERO,N,I,J,K,IJ,FIRST_FACE_INDEX,I1,I2,I3,I4,& + GEOM_TYPE,NXB,IJK(3),N_LEVELS,N_LAT,N_LONG,SPHERE_TYPE,BOXVERTLIST(8),NI,NIJ,IVOL,SORT_FACES,II,II1,II2,II3,& + X1AXIS,NNN,CYLINDER_NSEG_THETA,CYLINDER_NSEG_AXIS,CYL_FIND(LOW_IND:HIGH_IND,1:3),CELL_BLOCK_IOR -! IAXIS cut-faces: -X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-2,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - ! Insert cut-face in CUT_FACE array: - CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XFACE(I), YCELL(J), ZCELL(K) /); AREA(1) = DYCELL(J)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - ENDDO - ENDDO -ENDDO - -! JAXIS cut-faces: -X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-2,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - ! Insert cut-face in CUT_FACE array: - CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - ENDDO - ENDDO -ENDDO +LOGICAL :: HAVE_SURF,HAVE_MATL,IN_LIST,SURF_INDEX_PER_FACE,BNDF_GEOM,LOGTEST +REAL(EB), POINTER, DIMENSION(:) :: V1,V2,V3,V4 +INTEGER, POINTER, DIMENSION(:) :: FACEI,FACEJ,FACE_FROM,FACE_TO,VOL +TYPE(MESH_TYPE), POINTER :: M +TYPE(GEOMETRY_TYPE), POINTER :: G -! KAXIS cut-faces: -X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS -DO K=-2,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - ! Insert cut-face in CUT_FACE array: - CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - ENDDO - ENDDO -ENDDO +INTEGER, PARAMETER :: CAD_GEOM_TYPE=1,TERRAIN_GEOM_TYPE=2,& + BOX_GEOM_TYPE=3,SPHERE_GEOM_TYPE=4,CYLINDER_GEOM_TYPE=5 ! These 4 are for internal use. -ENDIF +REAL(EB), PARAMETER :: MAX_VAL=1.0E20_EB -END SUBROUTINE GET_REMAINING_CUTFACES +LOGICAL :: READ_BINARY +INTEGER :: IJF, IJB, IJE, NM +INTEGER, ALLOCATABLE, DIMENSION(:) :: B_IND,E_IND,F_IND +REAL(EB) :: XLOW,XHI,YLOW,YHI,ZLOW,ZHI,DELX,DELY,DELTZ -! ---------------------- CUT_CELL_FACE_ARRAYS_CLEANUP ----------------------------- +LOGICAL :: IS_TERRAIN,EXTEND_TERRAIN,WRITE_WARNING +REAL(EB):: ZVAL_HORIZON, ZVAL_FACTOR -SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP(NM) +INTEGER :: START_FACE_LO, START_FACE_MID, START_FACE_HI -INTEGER, INTENT(IN) :: NM +INTEGER :: N_EDGES,N_BEDGES,N_FACES_ORIG,N_VERTS_ORIG,N_VOLUS_ORIG,ICPT,CLOSE_PT(NOD1:NOD4+1), RGB(3)=-1 +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: EDGES,FACE_EDGES,EDGE_FACES,BOUND_EDGES,BOUND_EDGES2 +INTEGER, ALLOCATABLE, DIMENSION(:) :: NBND_EDGE,COUNTED_EDGES +REAL(EB) :: X_CEN,Y_CEN,ZMIN2,CORNER_PT(IAXIS:JAXIS,NOD1:NOD4+1),DIST,DISTI +REAL(EB), PARAMETER :: VERXY(IAXIS:JAXIS,NOD1:NOD4) = & + RESHAPE((/0._EB,1._EB,-1._EB,0._EB,0._EB,-1._EB,1._EB,0._EB/),(/ 2, 4 /)) +CHARACTER(25) :: COLOR='null' -INTEGER, ALLOCATABLE, DIMENSION(:) :: CCIND,CFIND,AUXV -INTEGER :: I,J,K,X1AXIS,ICC,JCC,IFC,IFACE,ICF,JCF,IFC1,CT,CTC,CTF,ILH,& - N_CUTCELL_MESH_NEW,N_GCCUTCELL_MESH_NEW,N_CUTFACE_MESH_NEW,N_GCCUTFACE_MESH_NEW,N_BBCUTFACE_MESH_NEW,& - NEDG,IEDG,LOHI,DIR,ICE -TYPE(MESH_TYPE), POINTER :: M -M => MESHES(NM) -ALLOCATE(CCIND(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH),CFIND(M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH)); CCIND=0; CFIND=0 +LOGICAL :: DONE -! Count cut-cells and face entries with NCELL, NFACE > 0: -CTC=0; N_CUTCELL_MESH_NEW=0; N_GCCUTCELL_MESH_NEW=0 -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - IF(M%CUT_CELL(ICC)%NCELL<1) CYCLE - CTC=CTC+1 - CCIND(ICC) = CTC - IF (ICC<=M%N_CUTCELL_MESH) THEN; N_CUTCELL_MESH_NEW = N_CUTCELL_MESH_NEW + 1 - ELSE; N_GCCUTCELL_MESH_NEW = N_GCCUTCELL_MESH_NEW + 1; ENDIF -ENDDO -CTF=0; N_CUTFACE_MESH_NEW=0; N_GCCUTFACE_MESH_NEW=0; N_BBCUTFACE_MESH_NEW=0 -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - IF(M%CUT_FACE(ICF)%NFACE<1) CYCLE - CTF=CTF+1 - CFIND(ICF) = CTF - IF (ICF<=M%N_BBCUTFACE_MESH) N_BBCUTFACE_MESH_NEW = N_BBCUTFACE_MESH_NEW + 1 - IF (ICF<=M%N_CUTFACE_MESH) THEN; N_CUTFACE_MESH_NEW = N_CUTFACE_MESH_NEW + 1 - ELSE; N_GCCUTFACE_MESH_NEW = N_GCCUTFACE_MESH_NEW + 1; ENDIF -ENDDO +INTEGER :: ILINE, IERR +INTEGER :: IG, IVERT -! Move Cut-cells to new location, NCELL=0 entries are dropped: -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - IF(M%CUT_CELL(ICC)%NCELL<1 .OR. ICC==CCIND(ICC)) CYCLE - CALL CUT_CELL_MOVE(M%CUT_CELL(ICC),M%CUT_CELL(CCIND(ICC))) -ENDDO -M%N_CUTCELL_MESH = N_CUTCELL_MESH_NEW -M%N_GCCUTCELL_MESH = N_GCCUTCELL_MESH_NEW +INTEGER, ALLOCATABLE, DIMENSION(:) :: GEOM_LINE,GEOM_LINE2 +INTEGER, PARAMETER :: DELTA_GEOM_LINE=1000 +INTEGER :: GEOM_LINE_SIZE -! Now Cut-faces: -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - IF(M%CUT_FACE(ICF)%NFACE<1 .OR. ICF==CFIND(ICF)) CYCLE - CALL CUT_FACE_MOVE(M%CUT_FACE(ICF),M%CUT_FACE(CFIND(ICF))) -ENDDO -M%N_CUTFACE_MESH = N_CUTFACE_MESH_NEW -M%N_GCCUTFACE_MESH = N_GCCUTFACE_MESH_NEW -M%N_BBCUTFACE_MESH = N_BBCUTFACE_MESH_NEW +NAMELIST /GEOM/ BNDF_GEOM,BINARY_FILE,CELL_BLOCK_IOR,CELL_BLOCK_ORIENTATION,COLOR,CYLINDER_ORIGIN,CYLINDER_AXIS,& + CYLINDER_RADIUS,CYLINDER_LENGTH,CYLINDER_NSEG_THETA,CYLINDER_NSEG_AXIS,& + EXTRUDE,EXTEND_TERRAIN,FACES,FYI,ID,IJK,IS_TERRAIN,MOVE_ID,N_LAT,N_LEVELS,N_LONG,POLY,& + RGB,SPHERE_ORIGIN,SPHERE_RADIUS,SPHERE_TYPE,SURF_ID,SURF_IDS,SURF_ID6,& + TEXTURE_MAPPING,TEXTURE_ORIGIN,TEXTURE_SCALE,TRANSPARENCY,& + VERTS,XB,ZMIN,ZVALS,ZVAL_HORIZON -! Finally fix ICC and ICF in CCVAR, FCVAR, CELL_LIST and FACE_LIST arrays -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC=>M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS); - M%CCVAR(I,J,K,CC_IDCC) = ICC; - DO JCC=1,CC%NCELL - ALLOCATE(AUXV(CC%CCELEM(1,JCC))); AUXV = 0 - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - AUXV(IFC) = 1 - IF ( .NOT.(CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB .OR. & - CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) ) CYCLE - IFC1 = CC%FACE_LIST(4,IFACE) - CC%FACE_LIST(4,IFACE) = 0; IF(IFC1>0) CC%FACE_LIST(4,IFACE) = CFIND(IFC1) - IF(CC%FACE_LIST(4,IFACE)<1) AUXV(IFC) = 0 - ENDDO - IFC1=0 - DO IFC=1,CC%CCELEM(1,JCC) - IF(AUXV(IFC)<1) CYCLE - IFC1 = IFC1+1 - CC%CCELEM(IFC1+1,JCC) = CC%CCELEM(IFC+1,JCC) - ENDDO - CC%CCELEM(1,JCC) = SUM(AUXV(:)) - DEALLOCATE(AUXV) - ENDDO - ! Deallocate FACE_LIST_DROPPED - CC%NFACE_DROPPED = 0 - IF(ALLOCATED(CC%FACE_LIST_DROPPED)) DEALLOCATE(CC%FACE_LIST_DROPPED) -ENDDO +! first pass - count number of &GEOM lines. -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CT = HIGH_IND - I = M%CUT_FACE(ICF)%IJK(IAXIS); J = M%CUT_FACE(ICF)%IJK(JAXIS); K = M%CUT_FACE(ICF)%IJK(KAXIS) - X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) - SELECT CASE(M%CUT_FACE(ICF)%STATUS) - CASE(CC_INBOUNDARY) - CT = LOW_IND - M%CCVAR(I,J,K,CC_IDCF) = ICF - CASE(CC_GASPHASE) - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = ICF - END SELECT - DO JCF=1,M%CUT_FACE(ICF)%NFACE - DO ILH=LOW_IND,CT - IF (M%CUT_FACE(ICF)%CELL_LIST(1,ILH,JCF)==CC_FTYPE_CFGAS) THEN - ICC = M%CUT_FACE(ICF)%CELL_LIST(2,ILH,JCF) - M%CUT_FACE(ICF)%CELL_LIST(2,ILH,JCF) = CCIND(ICC) - ENDIF - ENDDO - ENDDO -ENDDO +N_GEOMETRY=0 +ALLOCATE(GEOM_LINE(DELTA_GEOM_LINE)); GEOM_LINE = 0 +GEOM_LINE_SIZE = SIZE(GEOM_LINE,DIM=1) +REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 +COUNT_GEOM_LOOP: DO + CALL CHECKREAD('GEOM',LU_INPUT,IOS) ; IF (STOP_STATUS==SETUP_STOP) RETURN + IF (IOS==1) EXIT COUNT_GEOM_LOOP + IF(N_GEOMETRY+1 > GEOM_LINE_SIZE) THEN + ALLOCATE(GEOM_LINE2(GEOM_LINE_SIZE)) + GEOM_LINE2(1:GEOM_LINE_SIZE) = GEOM_LINE(1:GEOM_LINE_SIZE) + DEALLOCATE(GEOM_LINE) + ALLOCATE(GEOM_LINE(GEOM_LINE_SIZE+DELTA_GEOM_LINE)); GEOM_LINE = 0 + GEOM_LINE(1:GEOM_LINE_SIZE) = GEOM_LINE2(1:GEOM_LINE_SIZE) + GEOM_LINE_SIZE = SIZE(GEOM_LINE,DIM=1) + DEALLOCATE(GEOM_LINE2) + ENDIF + READ(LU_INPUT,'(A)')BUFFER + N_GEOMETRY=N_GEOMETRY+1 + GEOM_LINE(N_GEOMETRY) = INPUT_FILE_LINE_NUMBER +ENDDO COUNT_GEOM_LOOP +REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 +IF (N_GEOMETRY==0) RETURN -! Finally, some cut-faces might have regular Edges which are in CUT_EDGE, renumber in EDGE_LIST: -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_GASPHASE) CYCLE - NEDG=SIZE(CF%EDGE_LIST,DIM=2); I=CF%IJK(IAXIS); J=CF%IJK(JAXIS); K=CF%IJK(KAXIS); X1AXIS=CF%IJK(KAXIS+1) - DO IEDG=1,NEDG-1 - IF(CF%EDGE_LIST(1,IEDG)/=CC_ETYPE_RGGAS) CYCLE - LOHI=CF%EDGE_LIST(2,IEDG)-2 ! -1 for LOW_IND, 0 for HIGH_IND - DIR =CF%EDGE_LIST(3,IEDG) - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(DIR==JAXIS) THEN - ICE=M%ECVAR(I,J+LOHI,K,CC_IDCE,KAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ELSEIF(DIR==KAXIS) THEN - ICE=M%ECVAR(I,J,K+LOHI,CC_IDCE,JAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ENDIF - CASE(JAXIS) - IF(DIR==IAXIS) THEN - ICE=M%ECVAR(I+LOHI,J,K,CC_IDCE,KAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ELSEIF(DIR==KAXIS) THEN - ICE=M%ECVAR(I,J,K+LOHI,CC_IDCE,IAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ENDIF - CASE(KAXIS) - IF(DIR==IAXIS) THEN - ICE=M%ECVAR(I+LOHI,J,K,CC_IDCE,JAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ELSEIF(DIR==JAXIS) THEN - ICE=M%ECVAR(I,J+LOHI,K,CC_IDCE,IAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ENDIF - END SELECT - ENDDO -ENDDO +! Allocate GEOMETRY array -DEALLOCATE(CCIND,CFIND) +ALLOCATE(GEOMETRY(0:N_GEOMETRY),STAT=IZERO) +CALL ChkMemErr('READ_GEOM','GEOMETRY',IZERO) -RETURN -END SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP +! third pass - read GEOM data -! ---------------------------- BLOCK_CUT_CELL ------------------------------------- +READ_GEOM_LOOP: DO N=1,N_GEOMETRY + G=>GEOMETRY(N) -SUBROUTINE BLOCK_CUT_CELL(NM,ICC,JCC,BLOCK_PHASE) + CALL CHECKREAD('GEOM',LU_INPUT,IOS) ; IF (STOP_STATUS==SETUP_STOP) RETURN + IF (IOS==1) EXIT READ_GEOM_LOOP -! 1. Find Body and triangle with largest boundary cut-face area in cut-cell ICC,JCC. -! 2. Loop on faces of ICC,JCC (IFC_LOOP): -! a. If face is regular face, define it as Boundary cut-face of cell sharing it with ICC,JCC. -! a1. Make space for all surrounding Cartesian cells that will turn into cut-cells. -! a2. Make space for CFINB cut-edges and cut-faces in cell sharing with ICC,JCC, define cut-cell in said -! Cartesian cell. -! a3. Drop regular face, set FCVAR, ECVAR for edges involved => SOLID. Make VERTVAR for vertices involved SOLID. -! b. If face is type CFGAS. -! b1. Make space for all surrounding Cartesain cells that will turn into cut-cells. -! b2. Make space for CFINB cut-edges and cut-faces in CUT_CELL sharing with ICC,JCC. -! b3. Add INB cut-face to surrounding cut-cell, drop regular face, set FCVAR, ECVAR for edges involved => SOLID. -! Make VERTVAR for vertices involved SOLID. + IF(MAX_ZVALS/=MAXIMUM_GEOMETRY_ZVALS) THEN ! Reset to default GEOMETRY values and allocate ARRAYS. + MAX_ZVALS=0; MAX_VERTS=0; MAX_FACES=0; MAX_VOLUS=0; MAX_IDS=0; MAX_SURF_IDS=0; MAX_POLY_VERTS=0 + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + CALL ALLOCATE_BUFFERS + ENDIF -INTEGER, INTENT(IN) :: NM,ICC,JCC,BLOCK_PHASE + GEOM_RESIZE_DO : DO + DONE=.TRUE. + CALL SET_GEOM_DEFAULTS + READ(LU_INPUT,GEOM,END=35,ERR=22,IOSTAT=IOS) + 22 IF (IOS>0) THEN + IF ( (ZVALS(MAX_ZVALS+1) < MAX_VAL) .OR. (VERTS(3*MAX_VERTS+1) < MAX_VAL) .OR.& + (FACES(4*MAX_FACES+1) > 0) .OR. (VOLUS(4*MAX_VOLUS+1) > 0)) THEN + ! Resize MAX_ZVALS, MAX_VERTS, MAX_FACES, MAX_VOLUS: + MAX_ZVALS = MAX_ZVALS + 25000 + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + CALL ALLOCATE_BUFFERS + DONE=.FALSE. + ELSE + WRITE(BUFFER,'(A,A,A)') 'ERROR(101): GEOM ID=',TRIM(ID),'. Check &GEOM input line.' + CALL SHUTDOWN(TRIM(BUFFER)) + RETURN + ENDIF + REWIND(LU_INPUT); DO ILINE=1,GEOM_LINE(N)-1; READ(LU_INPUT,'(A)') BUFFER; ENDDO + ENDIF + IF (DONE) EXIT GEOM_RESIZE_DO + ENDDO GEOM_RESIZE_DO -INTEGER :: I,J,K,II,JJ,KK,IFC,IFC1,JFC1,IFACE,LOHI,ILH,X1AXIS,NSVERT,NSFACE,NVERTFACE_NEW,COUNT,DUM,IBOD,ITRI,& - HILO,ILHF,ICC2,JCC2,IFC2,IFACE2,IFCX,JFCX,IV,IVERT,MAXVERTS,INOD,INDFC(1:4),ICCNXT,& - IADD,JADD,KADD,EDGE_LIST_REG(1:3,1:4),DIMCE(2),IEDGE,CEI,LOHIE,AXISF,AXISE,LOWI,HIGI,LOWJ,HIGJ,LOWK,HIGK,& - IEG,JEG,KEG,ICE,JCE,ICF2,JCF2,JCE2,IEC2,JEC2,VL1(4),VL2(4),NFCD,IFCIN,JFCIN,KFCIN,X1AXIN,SZDUM -REAL(EB):: XYZV(IAXIS:KAXIS),XYZVERT(MAX_DIM,4) -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BODTRI,EDGE_LIST_AUX,CEDGES_AUX,CEDGES_AUX2,FACE_LIST_DROPPED -INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM -REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA -LOGICAL :: REALLOC_FLG, NEW_FACE_FLG, DROP_FACE, INZONE -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_INBCF_AREA_TYPE), POINTER :: INBCF_AREA -M => MESHES(NM) + IF (COLOR/='null') THEN + CALL COLOR2RGB(RGB,COLOR) + ENDIF + G%CELL_BLOCK_IOR = CELL_BLOCK_IOR + G%CELL_BLOCK_ORIENTATION = CELL_BLOCK_ORIENTATION + G%RGB = RGB + G%TRANSPARENCY = TRANSPARENCY + N_VERTS=0 + N_FACES=0 + TFACES(1:6*MAX_FACES) = -1.0_EB + N_VOLUS=0 + N_ZVALS=0 + N_POLY_VERTS=0 + IF(TRIM(BINARY_FILE)/='null') READ_BINARY = .TRUE. ! In case a binary name is provided, read the binary. + G%READ_BINARY = READ_BINARY -I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS); -! Find Body and triangle to associate to the cell to be blocked: -IBOD = 0; ITRI = 0 -COUNT= 0; DUM = 0 -DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 -ENDDO -IF (COUNT>0) THEN - ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 - DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE - DO DUM=1,COUNT - IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & - BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT - ENDDO - IF(DUM > COUNT) THEN ! No match in previous loop DUM=COUNT+1 - BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) - COUNT = DUM - ENDIF - AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) + ! Get number of SURF_IDs defined for the GEOM: + N_SURF_ID = 0 + DO I = 1, MAX_SURF_IDS + IF( SURF_ID(I)=='null' ) EXIT ! First 'null' + N_SURF_ID = N_SURF_ID + 1 ENDDO - IF (COUNT>0) THEN - ! Now set IBOD, ITRI - DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. - IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) - ENDIF - DEALLOCATE(BODTRI,AREA) -ELSE - ! Look in surrounding cells: - DO KK=K-1,K+1 - DO JJ=J-1,J+1 - DO II=I-1,I+1 - ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) - IF (ICC2>0) THEN - DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) - IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 - ENDDO - ENDDO - ENDIF - ENDDO + + READ_BIN_COND : IF (.NOT.READ_BINARY) THEN + ! count VERTS + DO I = 1, MAX_VERTS + IF (ANY(VERTS(3*I-2:3*I)>=MAX_VAL)) EXIT + N_VERTS = N_VERTS+1 ENDDO - ENDDO - IF (COUNT>0) THEN - ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 - DO KK=K-1,K+1 - DO JJ=J-1,J+1 - DO II=I-1,I+1 - ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) - IF (ICC2>0) THEN - DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) - IFC1 = M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE) - JFC1 = M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE) - IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE - DO DUM=1,COUNT - IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & - BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT - ENDDO - IF(DUM > COUNT) THEN - BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) - COUNT = DUM - ENDIF - AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) - ENDDO - ENDDO - ENDIF - ENDDO - ENDDO + + ! count POLY Verts: + DO I = 1,MAX_POLY_VERTS + IF (POLY(I)==0) EXIT + N_POLY_VERTS = N_POLY_VERTS+1 ENDDO - IF (COUNT>0) THEN - ! Now set IBOD, ITRI - DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. - IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) - ENDIF - DEALLOCATE(BODTRI,AREA) - ENDIF -ENDIF -! For cut-cell ICC, JCC run through its boundary faces and generate new boundary EDGES, CUT-FACES and cells: -BLOCK_PHASE_IF : IF(BLOCK_PHASE==1) THEN + ! count FACES + DO I = 1, MAX_FACES + IF (ALL(FACES(4*(I-1)+1:4*(I-1)+3)==0)) EXIT + N_FACES = N_FACES+1 + ENDDO -! Add areas of corresponding INB faces: -INZONE = (I>=0 .AND. I<=M%IBP1 .AND. J>=0 .AND. J<=M%JBP1 .AND. K>=0 .AND. K<=M%KBP1) .AND. MY_RANK==PROCESS(NM) -IF(INZONE) THEN - INBCF_AREA => M%INBCF_AREA(I,J,K) - IF(INBCF_AREA%NCELL == 0) THEN - INBCF_AREA%NCELL = M%CUT_CELL(ICC)%NCELL - ALLOCATE(INBCF_AREA%AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%AINB = 0._EB - ALLOCATE(INBCF_AREA%NEW_AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%NEW_AINB = 0._EB - ALLOCATE(INBCF_AREA%SURF_INDEX(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%SURF_INDEX = 0 - ALLOCATE(INBCF_AREA%IJCF(M%CUT_CELL(ICC)%NCELL)) - ENDIF - IF(IBOD>0) M%INBCF_AREA(I,J,K)%SURF_INDEX(JCC) = GEOMETRY(IBOD)%SURFS(ITRI) - DUM = 0; M%INBCF_AREA(I,J,K)%AINB(JCC) = 0._EB - DO IFC=2,M%CUT_CELL(ICC)%CCELEM(1,JCC)+1 - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC,JCC) - IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) - SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_CFINB) - M%INBCF_AREA(I,J,K)%AINB(JCC) = M%INBCF_AREA(I,J,K)%AINB(JCC) + & - M%CUT_FACE(IFC1)%AREA(JFC1)*M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1) - CASE(CC_FTYPE_CFGAS,CC_FTYPE_RCGAS) - DUM=DUM+1 - END SELECT - ENDDO - IF(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE>0) THEN - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = 0; - DEALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB) - ENDIF - IF(.NOT.ALLOCATED(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB)) THEN - ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB = 0 - ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB = 0 - ENDIF -ENDIF + ! Now split FACES array into FACES (connectivity), and SURFS, i.e. local surf ID: + IF(N_FACES > 0) THEN + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)) + DO I = 1, N_FACES + FACES(3*(I-1)+1:3*(I-1)+3) = FACES(4*(I-1)+1:4*(I-1)+3) + SURFS(I) = FACES(4*(I-1)+4) + IF(SURFS(I) > N_SURF_ID) THEN + WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(701): problem with GEOM ',TRIM(ID),& + ', local SURF_ID index for FACE ',I,'out of bounds.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ENDIF -IFC_LOOP : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) - HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND - ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND - ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND - X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) - IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + ! count VOLUS + DO I = 1, MAX_VOLUS + IF (ANY(VOLUS(4*I-3:4*I)==0)) EXIT + N_VOLUS = N_VOLUS+1 + ENDDO - FACE_TYPE_IF : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & - M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN + ! count ZVALS + DO I = 1, MAX_ZVALS + IF (ZVALS(I)>MAX_VAL) EXIT + N_ZVALS=N_ZVALS+1 + ENDDO - ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN - LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) - HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) - LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) - HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) - IF(LOWI>0 .AND. LOWJ>0) THEN - IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) CYCLE IFC_LOOP + ELSE READ_BIN_COND + ! Read Binary file, reset values of other geometry types to default: + ! Defaults for terrain, sphere, cylinder, box, etc. + XB=1.001_EB*MAX_VAL + SPHERE_ORIGIN = 1.001_EB*MAX_VAL + SPHERE_RADIUS = 1.001_EB*MAX_VAL + CYLINDER_LENGTH = 1.001_EB*MAX_VAL + CYLINDER_RADIUS = 1.001_EB*MAX_VAL + CYLINDER_ORIGIN = 1.001_EB*MAX_VAL + CYLINDER_AXIS = 1.001_EB*MAX_VAL + CYLINDER_NSEG_THETA = -1 + CYLINDER_NSEG_AXIS = -1 + N_LEVELS=-1 + N_LAT=-1 + N_LONG=-1 + SPHERE_TYPE=-1 + + ! This is to add the SURF_IDS to SURF_ID for analytical geometries being read from bingeom: + IF (TRIM(SURF_ID(1))=='null' .AND. TRIM(SURF_IDS(1))/='null') THEN ! Case of cylinders. + SURF_ID(1:3) = SURF_IDS(1:3) + N_SURF_ID = 3 + DO I=2,3 + IF (TRIM(SURF_ID(I))=='null') THEN + WRITE(MESSAGE,'(A,A,A)') 'ERROR(702): problem with GEOM ',TRIM(ID),', SURF_IDS not defined properly.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ENDIF + + ! Read Binary + OPEN(UNIT=731,FILE=TRIM(BINARY_FILE),STATUS='OLD',FORM='UNFORMATTED',ACTION='READ',ERR=221,IOSTAT=IOS) + IF (IOS==0) THEN + READ(731) GEOM_TYPE + READ(731) N_VERTS,N_FACES,N_SURF_ID2,N_VOLUS + IF(GEOM_TYPE==TERRAIN_GEOM_TYPE) THEN + IS_TERRAIN=.TRUE. + ELSE ! If GEOM is of any type other than terrains, set it to CAD type. + GEOM_TYPE=CAD_GEOM_TYPE + ENDIF + ! Now reallocate if necessary, twice size is to make sure terrains have sufficient array size allocated: + IF (2*N_VERTS > MAX_VERTS) THEN; MAX_VERTS=2*N_VERTS; DEALLOCATE(VERTS); ALLOCATE(VERTS(1:3*MAX_VERTS)); ENDIF + IF (2*N_FACES > MAX_FACES) THEN + MAX_FACES=2*N_FACES + DEALLOCATE(FACES); ALLOCATE(FACES(1:3*MAX_FACES)) + DEALLOCATE(TFACES); ALLOCATE(TFACES(1:6*MAX_FACES)) + ENDIF + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(MAX_FACES)) + IF (2*N_VOLUS > MAX_VOLUS) THEN; MAX_VOLUS=2*N_VOLUS; DEALLOCATE(VOLUS); ALLOCATE(VOLUS(1:4*N_VOLUS)); ENDIF + ! Read Vertices, Faces, Surfs and Volus: + IF (N_VERTS > 0 ) READ(731) VERTS(1:3*N_VERTS) + IF (N_FACES > 0 ) THEN + READ(731) FACES(1:3*N_FACES) + READ(731) SURFS(1:N_FACES) ENDIF + IF (N_VOLUS > 0 ) READ(731) VOLUS(1:4*N_VOLUS) + CLOSE(731) + IF (ANY(SURFS(1:N_FACES)>0) .AND. TRIM(SURF_ID(1))=='null') THEN + WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR(703): missing SURF_ID in &GEOM line ',TRIM(ID),& + ' for binary file ',TRIM(BINARY_FILE),& + '. Add SURF_ID in said &GEOM line.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + IF(N_SURF_ID2 /= N_SURF_ID) THEN + WRITE(MESSAGE,'(A,A,A,I8,A,I8,A,A,A)') 'ERROR(704): problem with GEOM ',TRIM(ID),& + ', number of surfaces in SURF_ID field (',N_SURF_ID, & + ') not equal to number of surfaces (',N_SURF_ID2,& + ') defined in bingeom ',TRIM(BINARY_FILE),'.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + DO I = 1, N_FACES + IF(SURFS(I) > N_SURF_ID) THEN + WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(701): problem with GEOM ',TRIM(ID),& + ', local SURF_ID index for FACE ',I,'out of bounds.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ENDIF +221 IF(IOS > 0) THEN + WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR(705): could not read binary connectivity for GEOM ',TRIM(ID),& + ' in binary file ',TRIM(BINARY_FILE),& + '. Check file exists.' + CALL SHUTDOWN(MESSAGE); RETURN ENDIF + ENDIF READ_BIN_COND - ! If needed reallocate CUT_FACE to accomodate INBOUNDARY face in neighbor cell. - SELECT CASE(X1AXIS) - CASE(IAXIS); II=I+ILH; JJ=J; KK=K - CASE(JAXIS); II=I; JJ=J+ILH; KK=K - CASE(KAXIS); II=I; JJ=J; KK=K+ILH - END SELECT - IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP - ICCNXT=0; IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) ICCNXT=1 + N_VERTS_ORIG = N_VERTS + N_FACES_ORIG = N_FACES + N_VOLUS_ORIG = N_VOLUS - IFC1 = M%CCVAR(II,JJ,KK,CC_IDCF) ! INBOUNDARY cut-faces in neighbor cartesian cell. - NEW_FACE_FLG = .FALSE. - IF (IFC1 < 1) THEN - ! Insert IFC1: - CALL INSERT_CUT_FACE(NM,II,JJ,KK,0,IFC1,INZONE=INZONE); M => MESHES(NM) ! Make space for INBOUNDARY cut-face - NEW_FACE_FLG = .TRUE. + !--- setup a 2D surface (terrain) object (ZVALS keyword ) + ZVALS_IF: IF (N_ZVALS>0) THEN + GEOM_TYPE = TERRAIN_GEOM_TYPE + TERRAIN_CASE= .TRUE. + CALL CHECK_XB(XB) + IF (N_ZVALS/=IJK(1)*IJK(2) ) THEN + WRITE(MESSAGE,'(A,I4,A,I4)') 'ERROR(706): Expected ',IJK(1)*IJK(2),' Z values, found ',N_ZVALS + CALL SHUTDOWN(MESSAGE) ENDIF - - REALLOC_FLG = .FALSE. - NSVERT = 0; NSFACE = 0; - IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) NVERTFACE_NEW = 5 - IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) NVERTFACE_NEW = M%CUT_FACE(IFCX)%CFELEM(1,JFCX)+1 - SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CFELEM)) SZDUM = SIZE(M%CUT_FACE(IFC1)%CFELEM, DIM=1) - IF(SZDUM < NVERTFACE_NEW) REALLOC_FLG = .TRUE. - SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%XYZVERT)) SZDUM = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) - IF(SZDUM < M%CUT_FACE(IFC1)%NVERT+NVERTFACE_NEW-1) THEN - REALLOC_FLG = .TRUE. - NSVERT = NVERTFACE_NEW-1 + IF (IJK(1)<2 .OR. IJK(2)<2) THEN + CALL SHUTDOWN('ERROR(707): IJK(1) and IJK(2) on &GEOM line needs to be at least 2.') ENDIF - SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%AREA)) SZDUM = SIZE(M%CUT_FACE(IFC1)%AREA,DIM=1) - IF(SZDUM < M%CUT_FACE(IFC1)%NFACE+1) THEN - REALLOC_FLG = .TRUE. - NSFACE = 1 + NXB=0 + DO I = 1, 4 ! first 4 XB values must be set, don't care about 5th and 6th + IF (XB(I)=XHI)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF((XB(3)<=YLOW) .OR. (XB(4)>=YHI)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF(MY_RANK==0 .AND. WRITE_WARNING) WRITE(LU_ERR,'(A,A,A)') 'Warning : Terrain &GEOM ',TRIM(ID),& + ' cannot be extended. When setting EXTEND_TERRAIN=T, make sure it lays entirely within the computational domain.' ENDIF - M=>MESHES(NM) - ! Provide GEOM surface information to newly created INBOUNDARY face: - M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) = (/ IBOD, ITRI /) - M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = 0 ! Default surf. - M%CUT_FACE(IFC1)%CFACE_ORIGIN(JFC1) = M%CUT_CELL(ICC)%NOADVANCE(JCC) - IF(IBOD>0) M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = GEOMETRY(IBOD)%SURFS(ITRI) - M%CUT_FACE(IFC1)%NFACE = JFC1 - ENDIF FACE_TYPE_IF + ! Move Low Z position of terrain to less that number od cutcells, s.t. they don't get computed on the bottom. + ZMIN2= 1.E10_EB + DO NM=1,NMESHES + ZMIN2 = MIN( ZMIN2 , MESHES(NM)%ZS-REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) + ENDDO + ZHI = MAXVAL(ZVALS(1:N_ZVALS)) + ZLOW = MINVAL(ZVALS(1:N_ZVALS)) + ZLOW = MIN(REAL(FLOOR(ZLOW-0.1_EB*(ZHI-ZLOW)),EB),ZMIN,ZMIN2) - SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_RCGAS) ! This regular face has to be connecting two small cut-cells. - ! Scheme: - ! 0. Add REG edges as INB cut-edges in corresponding cartesian cut faces. Define normal edges to new INB cut-edge - ! as CFGAS cut-edges. Set VERTVAR to SOLID in EDGE corners: - EDGE_LIST_REG(1:3,1:4) = CC_UNDEFINED; EDGE_LIST_REG(1,1:4) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. - SELECT CASE(X1AXIS) - CASE(IAXIS) - ! First INB cut edges in surrounding faces: - ! I+ILHF location. - ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 - XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) - XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) - ! Edge 1: V1-V2 add to face (I+2*ILHF+1,J ,K-1,KAXIS) - ! side on blocked cell,[I,J,K,X1EDGE], [I,J,K,X1FACE] - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K-1,JAXIS,I+2*ILHF+1,J ,K-1,KAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) - ! Edge 2: V2-V3 add to face (I+2*ILHF+1,J ,K ,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,KAXIS,I+2*ILHF+1,J ,K ,JAXIS,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) - ! Edge 3: V4-V3 add to face (I+2*ILHF+1,J ,K ,KAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,JAXIS,I+2*ILHF+1,J ,K ,KAXIS,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) - ! Edge 4: V1-V4 add to face (I+2*ILHF+1,J-1,K ,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J-1,K ,KAXIS,I+2*ILHF+1,J-1,K ,JAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) + ZVAL_FACTOR = 1._EB + IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. - ! Second CFGAS cut-edges in edges normal to face: - DO KADD=-1,0 - DO JADD=-1,0 - ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO + N_VOLUS = 0; N_VOLUS_ORIG = N_VOLUS - CASE(JAXIS) - ! J+ILHF location. - ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) - ! Edge 1: V1-V2 add to face (I-1,J+2*ILHF+1,K ,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J+ILHF,K ,KAXIS,I-1,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) - ! Edge 2: V2-V3 add to face (I ,J+2*ILHF+1,K ,KAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,IAXIS,I ,J+2*ILHF+1,K ,KAXIS,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) - ! Edge 3: V4-V3 add to face (I ,J+2*ILHF+1,K ,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,KAXIS,I ,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) - ! Edge 4: V1-V4 add to face (I ,J+2*ILHF+1,K-1,KAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K-1,IAXIS,I ,J+2*ILHF+1,K-1,KAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) + ALLOCATE(B_IND(2*(IJK(1)+IJK(2))-3)); B_IND=-1 + ALLOCATE(E_IND(2*(IJK(1)+IJK(2))-3)); E_IND=-1 + ALLOCATE(F_IND(2*(IJK(1)+IJK(2))-3)); F_IND=-1 - ! Second CFGAS cut-edges in edges normal to face: - DO KADD=-1,0 - DO IADD=-1,0 - ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO + ! First add terrain IJK(1)*IJK(2) vertices: + IJ = 1 + DO J = 1, IJK(2) + DO I = 1, IJK(1) + VERTS(3*IJ-2) = (XB(1)*REAL(IJK(1)-I,EB) + XB(2)*REAL(I-1,EB))/REAL(IJK(1)-1,EB) + VERTS(3*IJ-1) = (XB(3)*REAL(IJK(2)-J,EB) + XB(4)*REAL(J-1,EB))/REAL(IJK(2)-1,EB) + VERTS(3*IJ) = ZVALS(IJ) + IJ = IJ + 1 ENDDO + ENDDO + N_VERTS_ORIG = IJ-1 - CASE(KAXIS) - ! K+ILHF location. - ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /) - XYZVERT(:,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) - ! Edge 1: V1-V2 add to face (I,J-1,K+2*ILHF+1,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J-1,K+ILHF,IAXIS,I ,J-1,K+2*ILHF+1,JAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) - ! Edge 2: V2-V3 add to face (I,J ,K+2*ILHF+1,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,JAXIS,I ,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) - ! Edge 3: V4-V3 add to face (I,J ,K+2*ILHF+1,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,IAXIS,I ,J ,K+2*ILHF+1,JAXIS,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) - ! Edge 4: V1-V4 add to face (I-1,J,K+2*ILHF+1,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J ,K+ILHF,JAXIS,I-1,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) + ! Boundary indexes: + IJB = 1 + DO J=1,1 + DO I=1,IJK(1) + B_IND(IJB)=(J-1)*IJK(1)+I + IJB = IJB + 1 + ENDDO + ENDDO + DO J=2,IJK(2) + DO I=IJK(1),IJK(1) + B_IND(IJB)=(J-1)*IJK(1)+I + IJB = IJB + 1 + ENDDO + ENDDO + DO J=IJK(2),IJK(2) + DO I=IJK(1)-1,1,-1 + B_IND(IJB)=(J-1)*IJK(1)+I + IJB = IJB + 1 + ENDDO + ENDDO + DO J=IJK(2)-1,2,-1 + DO I=1,1 + B_IND(IJB)=(J-1)*IJK(1)+I + IJB = IJB + 1 + ENDDO + ENDDO + B_IND(IJB)= B_IND(1) ! Last point equal to first. - ! Second CFGAS cut-edges in edges normal to face: - DO JADD=-1,0 - DO IADD=-1,0 - ! Edge (I+IADD,J+JADD,K+2*ILHF+1,KAXIS): From V(I+IADD,J+JADD,K+2*ILHF) to V(I+IADD,J+JADD,K+2*ILHF+1) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+JADD,K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO + ! Now add terrain 2*(IJK(1)-1)*(IJK(2)-1) faces: + IJF = 1 + DO J = 1, IJK(2) - 1 + DO I = 1, IJK(1) - 1 + I1 = (J-1)*IJK(1) + I + I2 = I1 + 1 + I3 = I2 + IJK(1) + I4 = I3 - 1 + + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 + + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 ENDDO + ENDDO + N_FACES_ORIG = IJF-1 - END SELECT + IF (EXTEND_TERRAIN) THEN + ! Then add 2*(IJK(1)+IJK(2))-4 extended points: + DELX = (XHI - XLOW)/REAL(IJK(1)-1,EB) + DELY = (YHI - YLOW)/REAL(IJK(2)-1,EB) + IJE = 1 + ! Low Y along X: from IJK(1)*IJK(2)+1 : IJK(1)*IJK(2) + IJK(1) + DO J=1,1 + DO I=1,IJK(1) + VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) + VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) + VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON + E_IND(IJE) = IJ + IJE= IJE + 1 + IJ = IJ + 1 + ENDDO + ENDDO - ! 1. Add INBOUNDARY cut-face with size of RGGAS in CUT_FACE for this face (IFC1,JFC1). - DUM = M%CUT_FACE(IFC1)%NVERT + 1 - SELECT CASE(X1AXIS) - CASE(IAXIS) - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) - M%CUT_FACE(IFC1)%AREA(JFC1) = DYCELL(J)*DZCELL(K) - M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XFACE(I+ILHF), YCELL(J), ZCELL(K) /) - CASE(JAXIS) - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) - M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DZCELL(K) - M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YFACE(J+ILHF), ZCELL(K) /) - CASE(KAXIS) - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) - M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DYCELL(J) - M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YCELL(J), ZFACE(K+ILHF) /) - END SELECT - INDFC(1:4) = (/ 1, 2, 3, 4 /); INDFC = INDFC + M%CUT_FACE(IFC1)%NVERT - M%CUT_FACE(IFC1)%NVERT = DUM + ! Hi X along Y: from IJK(1)*IJK(2) + IJK(1) + 1 : IJK(1)*IJK(2) + IJK(1) + IJK(2) - 2 + DO J=2,IJK(2) + DO I=IJK(1),IJK(1) + VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) + VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) + VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON + E_IND(IJE) = IJ + IJE= IJE + 1 + IJ = IJ + 1 + ENDDO + ENDDO - ! All faces connectivities: (/ NNODS, NOD1, NOD2, NOD3, NOD4 /) ! Conn. into gas region of new cell. - IF (LOHI==HIGH_IND) THEN; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(2), INDFC(3), INDFC(4) /) - ELSE; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(4), INDFC(3), INDFC(2) /); ENDIF + ! Hi Y along X: from IJK(1)*IJK(2) + IJK(1) + IJK(2) - 1 : IJK(1)*IJK(2) + 2*IJK(1) + IJK(2) - 2 + DO J=IJK(2),IJK(2) + DO I=IJK(1)-1,1,-1 + VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) + VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) + VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON + E_IND(IJE) = IJ + IJE= IJE + 1 + IJ = IJ + 1 + ENDDO + ENDDO - ! Add new edges to EDGE_LIST: - DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) - ALLOCATE(EDGE_LIST_AUX(3,DUM+4)); - IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) - EDGE_LIST_AUX(1:3,DUM+1:DUM+4) = EDGE_LIST_REG(1:3,1:4); - CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) - ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) - DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN - DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) - ENDIF - IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) - IF (LOHI==HIGH_IND) THEN; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+2, DUM+3, DUM+4 /) - ELSE; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+4, DUM+3, DUM+2 /); ENDIF - CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) + ! Low X Along Y: from IJK(1)*IJK(2) + 2*IJK(1) + IJK(2) - 1 : IJK(1)*IJK(2) + 2*(IJK(1)+IJK(2)) - 4 + DO J=IJK(2)-1,2,-1 + DO I=1,1 + VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) + VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) + VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON + E_IND(IJE) = IJ + IJE= IJE + 1 + IJ = IJ + 1 + ENDDO + ENDDO + E_IND(IJE) = E_IND(1) ! Last point equal to first. - IF(INZONE) THEN - M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 - ENDIF + DO I=1,IJE-1 + VERTS(3*IJ-2) = VERTS(3*E_IND(I)-2) + VERTS(3*IJ-1) = VERTS(3*E_IND(I)-1) + VERTS(3*IJ) = ZLOW + F_IND(I) = IJ + IJ = IJ + 1 + ENDDO + F_IND(IJE) = F_IND(1) ! Last lower point equal to the first. - ! 2. Find cut-cell sharing this RGGAS face, and where in FACE_LIST this face is. - IF( ICCNXT==0 ) THEN - ! 3. Change in FACE_LIST -> (/CC_FTYPE_RCGAS,SIDE,MYAXIS,0,0/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/). - ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) - JCC2_LOOP_1 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) - IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_RCGAS .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(2,IFACE2)==HILO .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(3,IFACE2)==X1AXIS) THEN - M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) - M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1)= (/ CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) - EXIT JCC2_LOOP_1 - ENDIF - ENDDO - ENDDO JCC2_LOOP_1 - ENDIF - - CASE(CC_FTYPE_CFGAS) - - ! Scheme: - ! 0. Add REG and CFGAS cut edges as INB cut edges for the normal faces where it corresponds: - DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) - ALLOCATE(EDGE_LIST_AUX(3,DUM+M%CUT_FACE(IFCX)%CEDGES(1,JFCX))); - EDGE_LIST_AUX = CC_UNDEFINED; EDGE_LIST_REG(1,:) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. - IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) - ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) - DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN - DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) - ENDIF - IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) - CEDGES_AUX(1,JFC1) = M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - SELECT CASE(X1AXIS) - CASE(IAXIS) - XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) - XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) - ! Loop face edges/cut-edges: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) - ENDIF - CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! First INB cut edges in surrounding faces: - ! I+ILHF location. - ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 - LOWJ=-1; HIGJ=0; LOWK=-1; HIGK=0; - IF(AXISF==JAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J-1; KEG=K ; HIGJ=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J-1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; LOWJ= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ENDIF - ELSEIF(AXISF==KAXIS) THEN - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J ; KEG=K-1; HIGK=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K-1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; LOWK= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ENDIF - ENDIF - DO KADD=LOWK,HIGK - DO JADD=LOWJ,HIGJ - ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO - CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge - ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; - ! Find Edge: - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. - SELECT CASE(AXISE) - CASE(KAXIS) ! Edge in z dir. For surrounding faces in X dir -> 2*ILHF+1 = -1 or 1. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=JAXIS - CASE(JAXIS) ! Edge in y dir. For surrounding faces in X dir -> 4*ILHF+2 = -2 or 2. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=KAXIS - END SELECT - ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: - ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: - CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) + ! Remaining Faces: + ! Extension faces: + DO I=1,2*(IJK(1)+IJK(2))-4 + I1 = E_IND(I) + I2 = E_IND(I+1) + I3 = B_IND(I+1) + I4 = B_IND(I) - ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: - EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 - ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: - VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - IF(VL1(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL1(3)), ZFACE(VL1(4)) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL1(3)), ZFACE(VL1(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL1(3),VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - IF(VL2(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL2(3)), ZFACE(VL2(4)) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL2(3)), ZFACE(VL2(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL2(3),VL2(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge - ! New edge list for the heighboring cell Boundary cut-faces is inherited. - EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) - END SELECT + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 ENDDO - CASE(JAXIS) - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) - ! Loop face edges/cut-edges: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) - ENDIF - CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! First INB cut edges in surrounding faces: - ! J+ILHF location. - ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - LOWI=-1; HIGI=0; LOWK=-1; HIGK=0; - IF(AXISF==KAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J+ILHF; KEG=K-1; HIGK=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K-1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ELSE - IEG=I; JEG=J+ILHF; KEG=K ; LOWK= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ENDIF - ELSEIF(AXISF==IAXIS) THEN - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J+ILHF; KEG=K ; HIGI=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ELSE - IEG=I ; JEG=J+ILHF; KEG=K ; LOWI= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ENDIF - ENDIF - DO KADD=LOWK,HIGK - DO IADD=LOWI,HIGI - ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO - CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge - ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; - ! Find Edge: - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. - SELECT CASE(AXISE) - CASE(IAXIS) ! Edge in x dir. For surrounding faces in Y dir -> 2*ILHF+1 = -1 or 1. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=KAXIS - CASE(KAXIS) ! Edge in z dir. For surrounding faces in Y dir -> 4*ILHF+2 = -2 or 2. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=IAXIS - END SELECT - - ! IF(ICF2<1) THEN - ! WRITE(LU_ERR,*) 'ADD CUT_EDGE TO FACE IFCX,JFCX,I,J,K,X1AXIS=',& - ! IFCX,JFCX,M%CUT_FACE(IFCX)%IJK(1:4),':',M%FCVAR(7,7,7,CC_IDCF,2),M%FCVAR(7,7,7,CC_FGSC,2) - ! WRITE(LU_ERR,*) 'IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4)=',& - ! IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4),4*ILHF+2 - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-2,JCE) - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-1,JCE) - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 1,JCE) - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 2,JCE) - ! ENDIF + ! Side faces: + DO I=1,2*(IJK(1)+IJK(2))-4 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = E_IND(I+1) + I4 = E_IND(I) - ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: - ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: - CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 - ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: - EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO - ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: - VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - IF(VL1(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF ), ZFACE(VL1(4)) /) - XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF+1), ZFACE(VL1(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),J+2*ILHF+1,VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - IF(VL2(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - XYZVERT(:,1) = (/ XFACE(VL2(2)), YFACE(J+2*ILHF ), ZFACE(VL2(4)) /) - XYZVERT(:,2) = (/ XFACE(VL2(2)), YFACE(J+2*ILHF+1), ZFACE(VL2(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL2(2),J+2*ILHF+1,VL2(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge - ! New edge list for the heighboring cell Boundary cut-faces is inherited. - EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) - END SELECT + ELSE + ! Do not Extend to domain boundary: + DO I=1,IJB-1 + VERTS(3*IJ-2) = VERTS(3*B_IND(I)-2) + VERTS(3*IJ-1) = VERTS(3*B_IND(I)-1) + VERTS(3*IJ) = ZLOW + F_IND(I) = IJ + IJ = IJ + 1 ENDDO - CASE(KAXIS) - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /) - XYZVERT(:,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) - ! Loop face edges/cut-edges: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) - ENDIF - CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! First INB cut edges in surrounding faces: - ! K+ILHF location. - ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - LOWI=-1; HIGI=0; LOWJ=-1; HIGJ=0; - IF(AXISF==IAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J; KEG=K+ILHF; HIGI=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ELSE - IEG=I ; JEG=J; KEG=K+ILHF; LOWI= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ENDIF - ELSEIF(AXISF==JAXIS) THEN - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J-1; KEG=K+ILHF; HIGJ=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J-1,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ELSE - IEG=I; JEG=J ; KEG=K+ILHF; LOWJ= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ENDIF - ENDIF - DO JADD=LOWJ,HIGJ - DO IADD=LOWI,HIGI - ! Edge (I+IADD,J+JADD,K+2*ILHF+1,KAXIS): From V(I+IADD,J+JADD,K+2*ILHF) to V(I+IADD,J+JADD,K+2*ILHF+1) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+JADD,K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO - CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge - ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; - ! Find Edge: - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. - SELECT CASE(AXISE) - CASE(JAXIS) ! Edge in y dir. For surrounding faces in Z dir -> 2*ILHF+1 = -1 or 1. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; - X1AXIN=IAXIS - CASE(IAXIS) ! Edge in x dir. For surrounding faces in Z dir -> 4*ILHF+2 = -2 or 2. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; - X1AXIN=JAXIS - END SELECT + F_IND(IJB) = F_IND(1) ! Last lower point equal to the first. - ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: - ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: - CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) + ! Side faces: + DO I=1,2*(IJK(1)+IJK(2))-4 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = B_IND(I+1) + I4 = B_IND(I) - ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: - EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 - ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: - VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - IF(VL1(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),VL1(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - IF(VL2(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - XYZVERT(:,1) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL2(2),VL2(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge - ! New edge list for the heighboring cell Boundary cut-faces is inherited. - EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) - END SELECT + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 ENDDO - END SELECT - CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) - ! 1. Add INBOUNDARY cut-face in CUT_FACE for this face (IFC1,JFC1). - ! Add XYZVERT, AREA, XYZCEN and CFELEM entry in CUT_FACE(IFC1) for this (IFCX,JFCX) CFGAS face. - M%CUT_FACE(IFC1)%CFELEM(1,JFC1) = M%CUT_FACE(IFCX)%CFELEM(1,JFCX) - MAXVERTS = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) - COUNT=1 - DO IVERT=1,M%CUT_FACE(IFCX)%CFELEM(1,JFCX) - IV=M%CUT_FACE(IFCX)%CFELEM(IVERT+1,JFCX) - XYZV(IAXIS:KAXIS) =M%CUT_FACE(IFCX)%XYZVERT(IAXIS:KAXIS,IV) - CALL INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,M%CUT_FACE(IFC1)%NVERT,INOD,M%CUT_FACE(IFC1)%XYZVERT) - COUNT=COUNT+1 - IF(COUNT>SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(COUNT+1,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:COUNT-1,:)=M%CUT_FACE(IFC1)%CFELEM(1:COUNT-1,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=M%CUT_FACE(IFC1)%CFELEM) - ENDIF - M%CUT_FACE(IFC1)%CFELEM(COUNT,JFC1)=INOD - ENDDO - IF (HILO==HIGH_IND) THEN ! Mirror the connectivity, s.t. normal pointing inside: - COUNT=M%CUT_FACE(IFC1)%CFELEM(1,JFC1) - ALLOCATE(CFELEM(COUNT)); CFELEM(1:COUNT) = M%CUT_FACE(IFC1)%CFELEM(COUNT+1:2:-1,JFC1) - M%CUT_FACE(IFC1)%CFELEM(2:COUNT+1,JFC1) = CFELEM(1:COUNT) - DEALLOCATE(CFELEM) ENDIF - M%CUT_FACE(IFC1)%AREA(JFC1) = M%CUT_FACE(IFCX)%AREA(JFCX) - M%CUT_FACE(IFC1)%XYZCEN(:,JFC1) = M%CUT_FACE(IFCX)%XYZCEN(:,JFCX) - ! 2. Find cut-cell sharing this CFGAS face (IFCX,JFCX), find where in saids cell FACE_LIST this face is. - ! 3. Change in FACE_LIST -> (/CC_FTYPE_CFGAS,SIDE,MYAXIS,IFCX,JFCX/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/) - ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) - JCC2_LOOP_2 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) - IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_CFGAS .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE2)==IFCX .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE2)==JFCX) THEN - ! Add to FACE_LIST_DROPPED: - M%CUT_CELL(ICC2)%NFACE_DROPPED = M%CUT_CELL(ICC2)%NFACE_DROPPED + 1 - NFCD=0; IF(ALLOCATED(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED)) NFCD=SIZE(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED,DIM=2) - IF(M%CUT_CELL(ICC2)%NFACE_DROPPED>NFCD) THEN - ALLOCATE(FACE_LIST_DROPPED(6,M%CUT_CELL(ICC2)%NFACE_DROPPED)) - IF(NFCD>0) FACE_LIST_DROPPED(1:6,1:NFCD) = M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1:6,1:NFCD) - FACE_LIST_DROPPED(1:6,NFCD+1) = M%CUT_CELL(ICC2)%FACE_LIST(1:6,IFACE2) - CALL MOVE_ALLOC(FROM=FACE_LIST_DROPPED,TO=M%CUT_CELL(ICC2)%FACE_LIST_DROPPED) - ENDIF - ! Now write CC_FTYPE_CFINB entry: - M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) - M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1) =(/CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) - IF(INZONE) THEN - M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 - ENDIF - EXIT JCC2_LOOP_2 - ENDIF - ENDDO - ENDDO JCC2_LOOP_2 - END SELECT + ! Bottom Faces: + ! First Face: + I = 1 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = F_IND(2*(IJK(1)+IJK(2))-3-I) + FACES(3*IJF-2) = I2 + FACES(3*IJF-1) = I1 + FACES(3*IJF) = I3 + IJF = IJF + 1 -ENDDO IFC_LOOP + DO I=2,(2*(IJK(1)+IJK(2))-6)/2 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = F_IND(2*(IJK(1)+IJK(2))-3-I) + I4 = F_IND(2*(IJK(1)+IJK(2))-2-I) -IF(INZONE) THEN - DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE - IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) - JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) - M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) = M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) + M%CUT_FACE(IFC1)%AREA(JFC1) - ENDDO - DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE - IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) - JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) - M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)= & - M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)*M%INBCF_AREA(I,J,K)%AINB(JCC)/M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) - ENDDO -ENDIF + FACES(3*IJF-2) = I2 + FACES(3*IJF-1) = I1 + FACES(3*IJF) = I4 + IJF = IJF + 1 -ELSEIF(BLOCK_PHASE==2) THEN BLOCK_PHASE_IF + FACES(3*IJF-2) = I2 + FACES(3*IJF-1) = I4 + FACES(3*IJF) = I3 + IJF = IJF + 1 + ENDDO -! Drop Edges and Faces: -IFC_LOOP_2 : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) - HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND - ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND - ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND - X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) - IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + ! Last Face: + I = (2*(IJK(1)+IJK(2))-4)/2 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = F_IND(I+2) + FACES(3*IJF-2) = I2 + FACES(3*IJF-1) = I1 + FACES(3*IJF) = I3 + IJF = IJF + 1 - FACE_TYPE_IF_2 : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & - M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN + N_VERTS = IJ - 1 + N_FACES = IJF - 1 - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN - LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) - HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) - LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) - HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) - IF(LOWI>0 .AND. LOWJ>0) THEN - IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. & ! This is to drop this cut-face on the second hit. - M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0 .AND. M%CUT_FACE(IFCX)%SHARED(JFCX)) THEN - M%CUT_FACE(IFCX)%SHARED(JFCX) =.FALSE. - CYCLE IFC_LOOP_2 - ENDIF + DEALLOCATE(B_IND,E_IND,F_IND) + + ELSEIF(IS_TERRAIN) THEN ZVALS_IF + + GEOM_TYPE = TERRAIN_GEOM_TYPE + TERRAIN_CASE= .TRUE. + + ! Here estimate final number of Faces and if necessary reallocate FACE, VERTS, SURFS arrays: + IF ( (2*N_FACES>MAX_FACES) .AND. .NOT.READ_BINARY) THEN + ALLOCATE(VERTS_AUX(3*N_VERTS)); VERTS_AUX(1:3*N_VERTS)= VERTS(1:3*N_VERTS) + ALLOCATE(FACES_AUX(4*N_FACES)); FACES_AUX(1:4*N_FACES)= FACES(1:4*N_FACES) + ALLOCATE(SURFS2(N_FACES)); SURFS2(1:N_FACES) = SURFS(1:N_FACES) + MAX_FACES = 2*N_FACES ! Enough for square structured triangulations of more that 200 triangs with domain extension. + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + DEALLOCATE(VERTS,FACES,TFACES); + ALLOCATE(VERTS(3*MAX_VERTS+1)); ALLOCATE(TFACES(6*MAX_FACES+1)); ALLOCATE(FACES(4*MAX_FACES+1)) + VERTS=1.001_EB*MAX_VAL; FACES=0 + VERTS(1:3*N_VERTS) = VERTS_AUX(1:3*N_VERTS) + FACES(1:4*N_FACES) = FACES_AUX(1:4*N_FACES) + DEALLOCATE(SURFS); ALLOCATE(SURFS(MAX_FACES)); + IF(SURF_INDEX_PER_FACE) THEN + SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). + ELSE + SURFS(:) = 0 ! All external faces point to default surf ID. ENDIF + SURFS(1:N_FACES) = SURFS2(1:N_FACES) + DEALLOCATE(VERTS_AUX,FACES_AUX,SURFS2) ENDIF - SELECT CASE(X1AXIS) - CASE(IAXIS); II=I+ILH; JJ=J; KK=K - CASE(JAXIS); II=I; JJ=J+ILH; KK=K - CASE(KAXIS); II=I; JJ=J; KK=K+ILH - END SELECT - IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP_2 - ENDIF FACE_TYPE_IF_2 + ! First get EDGES arrays to find edges attached to only one face: + I = SIZE(FACES,DIM=1) + ALLOCATE(EDGES(NOD1:NOD2,3*N_FACES),FACE_EDGES(EDG1:EDG3,N_FACES),EDGE_FACES(5,3*N_FACES)) + CALL GET_GEOM_EDGES(N_VERTS,N_FACES,I,FACES,N_EDGES,EDGES,FACE_EDGES,EDGE_FACES) - SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_RCGAS) - ! 4. Make FCVAR(I,J,K,CC_CGSC,X1AXIS)=CC_SOLID, ECVAR and VERTVAR CC_SOLID where corresponds: - CALL DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) - CASE(CC_FTYPE_CFGAS) - ! Drop Face and Edges test: - DROP_FACE=.FALSE. - ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: - LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) - HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) - LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) - HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) - IF(LOWI>0 .AND. LOWJ>0) THEN - IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) THEN - DROP_FACE=.TRUE. - M%CUT_FACE(IFCX)%SHARED(JFCX) =.TRUE. - ENDIF + ! FIND SET OF EDGES: + ALLOCATE(NBND_EDGE(1:N_EDGES)); NBND_EDGE(1:N_EDGES) = 2 - EDGE_FACES(1,1:N_EDGES) ! 0 if interior edge, 1 bnd. + N_BEDGES = SUM(NBND_EDGE(1:N_EDGES)) + ALLOCATE(BOUND_EDGES(2,N_BEDGES),BOUND_EDGES2(2,N_BEDGES)); BOUND_EDGES = 0; BOUND_EDGES2 = 0 + ALLOCATE(COUNTED_EDGES(1:N_BEDGES)); COUNTED_EDGES = 0 + ! Reorder Edges in counter-clockwise (x-y plane) direction: + ! First copy edges in correct counter-clockwise outside node order: + J=0 + DO I=1,N_EDGES + IF(NBND_EDGE(I)/=1) CYCLE + J=J+1 + IF(EDGE_FACES(2,I)>0) THEN + BOUND_EDGES(NOD1:NOD2,J) = EDGES( (/ NOD1,NOD2 /) , I ) + ELSEIF(EDGE_FACES(4,I)>0) THEN + BOUND_EDGES(NOD1:NOD2,J) = EDGES( (/ NOD2,NOD1 /) , I ) ENDIF + ENDDO - ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) - JCC2_LOOP_3 : DO IFACE2=1,M%CUT_CELL(ICC2)%NFACE_DROPPED - IF(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & - M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(4,IFACE2)==IFCX .AND. & - M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(5,IFACE2)==JFCX) THEN - DROP_FACE=.TRUE. - EXIT JCC2_LOOP_3 + ! Then reorder-copy edges: + J = 1; I = 1 + BOUND_EDGES2(NOD1:NOD2,J) = BOUND_EDGES(NOD1:NOD2,I); COUNTED_EDGES(I) = 1 + DO J=2,N_BEDGES + DO I=1,N_BEDGES + IF(COUNTED_EDGES(I)==1) CYCLE + IF(BOUND_EDGES2(NOD2,J-1)==BOUND_EDGES(NOD1,I)) THEN ! Found new edge: + BOUND_EDGES2(NOD1:NOD2,J) = BOUND_EDGES(NOD1:NOD2,I); COUNTED_EDGES(I) = 1 + EXIT ENDIF - ENDDO JCC2_LOOP_3 - - DROP_FACE_IF : IF (DROP_FACE) THEN - SELECT CASE(X1AXIS) - CASE(IAXIS) - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - IF(AXISF==KAXIS) THEN - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J ; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ELSEIF(AXISF==JAXIS) THEN - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J-1; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ENDIF - CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! Drop edge JCE: - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - END SELECT - ENDDO + ENDDO + IF(I>N_BEDGES) THEN ! Error + WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(709): For terrain GEOM ',TRIM(ID),& + ' unconnected boundary edge at node number,',BOUND_EDGES2(NOD2,J-1),'.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + DO I=1,N_BEDGES + IF (COUNTED_EDGES(I) /= 1) THEN + WRITE(MESSAGE,'(A,A,A,2I8,A)') 'ERROR(710): For terrain GEOM ',TRIM(ID),& + ' unconnected boundary edge at nodes,',BOUND_EDGES(NOD1:NOD2,I),'.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ! Here all edges are counted and SUM(COUNTED_EDGES(1:N_BEDGES)==N_BEDGES): + BOUND_EDGES(NOD1:NOD2,1:N_BEDGES) = BOUND_EDGES2(NOD1:NOD2,1:N_BEDGES); + DEALLOCATE(NBND_EDGE,COUNTED_EDGES,BOUND_EDGES2) - CASE(JAXIS) - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - IF(AXISF==KAXIS) THEN - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J+ILHF; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I; JEG=J+ILHF; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ELSEIF(AXISF==IAXIS) THEN - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I ; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ENDIF - CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! Drop edge JCE: - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - END SELECT - ENDDO - CASE(KAXIS) - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - IF(AXISF==IAXIS) THEN - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I ; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ELSEIF(AXISF==JAXIS) THEN - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J-1; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I; JEG=J ; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ENDIF - CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! Drop edge JCE: - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - END SELECT - ENDDO - END SELECT + IF (EXTEND_TERRAIN) THEN + ! Find XLOW,XHI,YLOW,YHI for the set of NM meshes defined: + XLOW = 1.E10_EB + XHI =-1.E10_EB + YLOW = 1.E10_EB + YHI =-1.E10_EB + DO NM=1,NMESHES + XLOW = MIN(XLOW,MESHES(NM)%XS) + XHI = MAX(XHI ,MESHES(NM)%XF) + YLOW = MIN(YLOW,MESHES(NM)%YS) + YHI = MAX(YHI ,MESHES(NM)%YF) + ENDDO + WRITE_WARNING=.FALSE. + IF(ANY(VERTS(1:3:3*N_VERTS-2) <= XLOW)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF(ANY(VERTS(1:3:3*N_VERTS-2) >= XHI )) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF(ANY(VERTS(2:3:3*N_VERTS-1) <= YLOW)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF(ANY(VERTS(2:3:3*N_VERTS-1) >= YHI )) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF + IF(MY_RANK==0 .AND. WRITE_WARNING) WRITE(LU_ERR,'(A,A,A)') 'Warning : Terrain &GEOM ',TRIM(ID),& + ' cannot be extended. When setting EXTEND_TERRAIN=T, make sure it lays entirely within the computational domain.' + ENDIF + ! Move Low Z position of terrain to less that number od cutcells, s.t. they don't get computed on the bottom. + ZMIN2= 1.E10_EB + DELTZ= 0._EB + DO NM=1,NMESHES + DELTZ = MAX( DELTZ , REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) + ZMIN2 = MIN( ZMIN2 , MESHES(NM)%ZS-REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) + ENDDO + ZHI =-1.E10_EB + ZLOW = 1.E10_EB + DO I=1,N_VERTS + ZLOW = MIN(ZLOW,VERTS(3*I)) + ZHI = MAX(ZHI ,VERTS(3*I)) + ENDDO + ! Take the min of LOWZ_VERTS-NGUARD*DZ, ZMIN from input, ZMIN_MESH-NGUARD*DZ: + ZLOW = MIN(ZLOW-DELTZ,ZMIN,ZMIN2) - ! Drop (IFCX,JFCX) from CUT_FACE(IFCX): - CALL DROP_CUTFACE(NM,CC_FTYPE_CFGAS,I,J,K,ILHF,X1AXIS,IFCX,JFCX) - ENDIF DROP_FACE_IF - CASE(CC_FTYPE_CFINB) + ZVAL_FACTOR = 1._EB + IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. - ! Drop cut-edges whithin the Cartesian cell I,J,K that belong to this INBOUNDARY cut-face: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)/=CC_ETYPE_CFINB) CYCLE - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) - IF(AXISE>0) CYCLE - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - ENDDO + N_VOLUS = 0 - ! Scheme: - ! 1. Drop (IFC2,JFC2) from CUT_FACE(IFC2). Note this changes the face arrays, so FACE_LIST face indexes - ! for cut-cells on this CUT_CELL(ICC) entry need to be updated. - CALL DROP_CUTFACE(NM,CC_FTYPE_CFINB,I,J,K,ILHF,X1AXIS,IFCX,JFCX) - - END SELECT - -ENDDO IFC_LOOP_2 + ALLOCATE(B_IND(2*N_BEDGES+1)); B_IND=-1 + ALLOCATE(E_IND(2*N_BEDGES+1)); E_IND=-1 + ALLOCATE(F_IND(2*N_BEDGES+1)); F_IND=-1 -ELSEIF(BLOCK_PHASE==3) THEN BLOCK_PHASE_IF + B_IND(1:N_BEDGES) = BOUND_EDGES(NOD1,1:N_BEDGES); B_IND(N_BEDGES+1) = B_IND(1) ! Last equal to first -! At this point all faces defining the ICC,JCC cut-cell have been dropped in the CUT_FACE, CUT_CELL trees. -! We can drop JCC from CUT_CELL(ICC)%CCELEM, etc. -CALL DROP_CUTCELL(NM,ICC,JCC) + ! All vertices in counter-clockwise dir are in BOUND_EDGES(NOD1,1:N_BEDGES) + ! IF EXTEND_TERRAIN, of this vertex list find the 4 points SW, SE, NW, NE closest to the boundary of the domain. + IF (EXTEND_TERRAIN) THEN -ENDIF BLOCK_PHASE_IF + B_IND(N_BEDGES+1:2*N_BEDGES) = B_IND(1:N_BEDGES) + B_IND(2*N_BEDGES+1) = B_IND(1) -RETURN -END SUBROUTINE BLOCK_CUT_CELL + ! Find the 4 points closest to SE, NE, NW, SW corners. + CORNER_PT(IAXIS:JAXIS,NOD1) = (/ XHI , YLOW /) ! SE + CORNER_PT(IAXIS:JAXIS,NOD2) = (/ XHI , YHI /) ! NE + CORNER_PT(IAXIS:JAXIS,NOD3) = (/ XLOW, YHI /) ! NW + CORNER_PT(IAXIS:JAXIS,NOD4) = (/ XLOW, YLOW /) ! SW + CORNER_PT(IAXIS:JAXIS,NOD4+1)= CORNER_PT(IAXIS:JAXIS,NOD1) ! SE + CLOSE_PT(:) = 0 + DO ICPT=NOD1,NOD4 + ! Search in B_IND vertices which is closest: + DIST=1.E10_EB + DO I=1,N_BEDGES + DISTI = SQRT( ( CORNER_PT(IAXIS,ICPT)-VERTS(3*B_IND(I)-2) )**2._EB + & + ( CORNER_PT(JAXIS,ICPT)-VERTS(3*B_IND(I)-1) )**2._EB ) + IF(DISTI >= DIST) CYCLE + CLOSE_PT(ICPT) = I + DIST = DISTI + ENDDO + ENDDO + DO ICPT=NOD2,NOD4 + IF(CLOSE_PT(ICPT) < CLOSE_PT(ICPT-1)) CLOSE_PT(ICPT) = CLOSE_PT(ICPT) + N_BEDGES ! Pad corner nodes. + ENDDO + CLOSE_PT(NOD4+1) = CLOSE_PT(NOD1) + N_BEDGES + ! These points are mapped to domain external corners, rest of the points are mapped to corresponding domain + ! External boundaries. + IJ = N_VERTS + 1 + DO ICPT=NOD1,NOD4 + IJE = CLOSE_PT(ICPT+1) - CLOSE_PT(ICPT); + IF (IJE <= 0) THEN + WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(711): For terrain GEOM ',TRIM(ID),& + ' same boundary vertex ',B_IND(CLOSE_PT(ICPT)),' closest to 2 domain corners.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + DISTI = SQRT( ( CORNER_PT(IAXIS,ICPT+1)-CORNER_PT(IAXIS,ICPT) )**2._EB + & + ( CORNER_PT(JAXIS,ICPT+1)-CORNER_PT(JAXIS,ICPT) )**2._EB ) / REAL(IJE,EB) + ! Place points in extended domain: + J = 0 + DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 + VERTS(3*IJ-2) = CORNER_PT(IAXIS,ICPT) + DISTI*VERXY(IAXIS,ICPT)*REAL(J,EB) + VERTS(3*IJ-1) = CORNER_PT(JAXIS,ICPT) + DISTI*VERXY(JAXIS,ICPT)*REAL(J,EB) + VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*VERTS(3*B_IND(I)) + ZVAL_FACTOR*ZVAL_HORIZON + E_IND(I) = IJ + IJ = IJ + 1 + J = J + 1 + ENDDO + ENDDO + E_IND(CLOSE_PT(NOD4+1)) = E_IND(CLOSE_PT(NOD1)) -! ------------------------------ ADD_CUTEDGE_TO_FACE -------------------------------- + ! Add the floor F_IND Vertices: + X_CEN = 0 + Y_CEN = 0 + DO ICPT=NOD1,NOD4 + DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 + VERTS(3*IJ-2) = VERTS(3*E_IND(I)-2) + VERTS(3*IJ-1) = VERTS(3*E_IND(I)-1) + VERTS(3*IJ) = ZLOW + F_IND(I) = IJ + X_CEN = X_CEN + VERTS(3*E_IND(I)-2) + Y_CEN = Y_CEN + VERTS(3*E_IND(I)-1) + IJ = IJ + 1 + ENDDO + ENDDO + F_IND(CLOSE_PT(NOD4+1)) = F_IND(CLOSE_PT(NOD1)) -SUBROUTINE ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IEC2,JEC2,IFC,JFC,KFC,X1AXFC) + ! Add center point: + VERTS(3*IJ-2) = X_CEN / REAL(N_BEDGES,EB) + VERTS(3*IJ-1) = Y_CEN / REAL(N_BEDGES,EB) + VERTS(3*IJ) = ZLOW + IJ = IJ + 1 -INTEGER, INTENT(IN) :: NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IFC,JFC,KFC,X1AXFC -INTEGER, INTENT(OUT):: IEC2,JEC2 + ! Add extend faces: + IJF = N_FACES + 1 + DO ICPT=NOD1,NOD4 + DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 + I1 = E_IND(I) + I2 = E_IND(I+1) + I3 = B_IND(I+1) + I4 = B_IND(I) -! Local variables: -INTEGER :: INOD1,INOD2,VL1(1:4),VL2(1:4),NVERT,NEDGE,IEDGE -INTEGER, ALLOCATABLE :: EDGE_LIST_AUX(:,:) -REAL(EB):: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) -TYPE(MESH_TYPE), POINTER :: M + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 -IEDGE=JCF2 ! Dummy for now FACE_LIST not filled for ETYPE_CFINB edges. + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO + ENDDO -M =>MESHES(NM) -IEC2=M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) -IF(IEC2<1) THEN ! Allocate space for CFINB cut-edge on this cut-face. + ! Add side faces: + DO ICPT=NOD1,NOD4 + DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = E_IND(I+1) + I4 = E_IND(I) - ! Allocate space for cut-edge in CUT_EDGE: - IEC2 = M%N_CUTEDGE_MESH + 1 - M%N_CUTEDGE_MESH = IEC2 - M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = IEC2 - CALL CUT_EDGE_ARRAY_REALLOC(NM,IEC2) - M%CUT_EDGE(IEC2)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,IEC2,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - M%CUT_EDGE(IEC2)%NEDGE = 0 - M%CUT_EDGE(IEC2)%NEDGE1 = 0 - M%CUT_EDGE(IEC2)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. - M%CUT_EDGE(IEC2)%STATUS = CC_INBOUNDCF - ALLOCATE(M%CUT_EDGE(IEC2)%DXX(1:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%DXX = 0._EB - ALLOCATE(M%CUT_EDGE(IEC2)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%FACE_LIST = CC_UNDEFINED + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 -ENDIF + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO + ENDDO -! Edge nodes location and type: -INOD1 = M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE) -INOD2 = M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE) -XV1(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD1) -XV2(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD2) -VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD1) ! [CC_VTYPE I J K] -VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD2) + ! Add bottom faces: + DO ICPT=NOD1,NOD4 + DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 + I1 = F_IND(I) + I2 = IJ - 1 ! ZLOW center vert. + I3 = F_IND(I+1) -! Add cut-edge: -NVERT = M%CUT_EDGE(IEC2)%NVERT -CALL REALLOCATE_EDGE_VERT(NM,IEC2,NVERT+2) -CALL INSERT_FACE_VERT(XV1,NM,IEC2,NVERT,INOD1) -CALL INSERT_FACE_VERT(XV2,NM,IEC2,NVERT,INOD2) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 + ENDDO + ENDDO -DO NEDGE=1,M%CUT_EDGE(IEC2)%NEDGE - IF( (INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) .OR. & - (INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) ) THEN - JEC2=NEDGE; RETURN ! Edge already in Face cut-edges list. - ENDIF -ENDDO -JEC2=NEDGE -CALL REALLOCATE_EDGE_ELEM(NM,IEC2,NEDGE) + ELSE -! Check first node type, if gas vertex make it boundary vertex and change VERTVAR to CC_SOLID: -M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = VL1(1:4) -IF(VL1(1)==CC_VTYPE_VGAS) THEN - M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,VL1(2),VL1(3),VL1(4)/) - M%VERTVAR(VL1(2),VL1(3),VL1(4),CC_VGSC) = CC_SOLID -ENDIF -M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = VL2(1:4) -IF(VL2(1)==CC_VTYPE_VGAS) THEN - M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,VL2(2),VL2(3),VL2(4)/) - M%VERTVAR(VL2(2),VL2(3),VL2(4),CC_VGSC) = CC_SOLID -ENDIF + ! Add the floor F_IND Vertices: + IJ = N_VERTS + 1 + X_CEN = 0 + Y_CEN = 0 + DO I=1,N_BEDGES + VERTS(3*IJ-2) = VERTS(3*B_IND(I)-2) + VERTS(3*IJ-1) = VERTS(3*B_IND(I)-1) + VERTS(3*IJ) = ZLOW + F_IND(I) = IJ + X_CEN = X_CEN + VERTS(3*B_IND(I)-2) + Y_CEN = Y_CEN + VERTS(3*B_IND(I)-1) + IJ = IJ + 1 + ENDDO + F_IND(N_BEDGES+1) = F_IND(1) ! Last lower point equal to the first. -! Add edge: Assumes XV1 < XV2 in X1AXEG direction: -M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) -IF(ILHF==-1) M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) + ! Add center point: + VERTS(3*IJ-2) = X_CEN / REAL(N_BEDGES,EB) + VERTS(3*IJ-1) = Y_CEN / REAL(N_BEDGES,EB) + VERTS(3*IJ) = ZLOW + IJ = IJ + 1 -M%CUT_EDGE(IEC2)%NVERT = NVERT -M%CUT_EDGE(IEC2)%NEDGE = NEDGE + ! Add side faces: + IJF = N_FACES + 1 + DO I=1,N_BEDGES + I1 = F_IND(I) + I2 = F_IND(I+1) + I3 = B_IND(I+1) + I4 = B_IND(I) -M%CUT_EDGE(IEC2)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 -! Define Edge as INB CUT_EDGE, find corresponding CFGAS EDGE associated cut-face and replace it -IF(ICF2>0) THEN - ! Reallocate EDGE_LIST if JCE2 exceeds current size - NVERT = 0 - IF(ALLOCATED(M%CUT_FACE(ICF2)%EDGE_LIST)) NVERT = SIZE(M%CUT_FACE(ICF2)%EDGE_LIST,DIM=2)-1 - IF(JCE2 > NVERT) THEN - ALLOCATE(EDGE_LIST_AUX(3,0:JCE2)) - EDGE_LIST_AUX = CC_UNDEFINED - IF(NVERT > 0) EDGE_LIST_AUX(1:3,0:NVERT) = M%CUT_FACE(ICF2)%EDGE_LIST(1:3,0:NVERT) - CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX, TO=M%CUT_FACE(ICF2)%EDGE_LIST) - ENDIF - M%CUT_FACE(ICF2)%EDGE_LIST(1:3,JCE2) = (/CC_ETYPE_CFINB, IEC2, JEC2/) -ENDIF + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO -END SUBROUTINE ADD_CUTEDGE_TO_FACE + ! Add bottom faces: + DO I=1,N_BEDGES + I1 = F_IND(I) + I2 = IJ - 1 ! ZLOW center vert. + I3 = F_IND(I+1) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 + ENDDO -! ------------------------------ ADD_CUTEDGE_TO_EDGE ------------------------------- + ENDIF -SUBROUTINE ADD_CUTEDGE_TO_EDGE(NM,ILHF,IEG,JEG,KEG,X1AXEG,XV1,XV2) + N_VERTS = IJ - 1 + N_FACES = IJF - 1 -INTEGER, INTENT(IN) :: NM,ILHF,IEG,JEG,KEG,X1AXEG -REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) + DEALLOCATE(B_IND,E_IND,F_IND,BOUND_EDGES) -! Local Variables: -INTEGER :: NVERT,INOD1,INOD2,ICF,CEI,NEDGE,NOD1_TYPE,NOD2_TYPE,LOHI,AXIS -TYPE(MESH_TYPE), POINTER :: M + ENDIF ZVALS_IF -M=>MESHES(NM) -IF(M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG)==CC_SOLID) RETURN + !--- setup a block object (XB keyword ) -! Define Gas Cut-edge: -CEI = M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) -IF(CEI<1) THEN - ! Allocate space for cut-edge in CUT_EDGE: - CEI = M%N_CUTEDGE_MESH + 1 - M%N_CUTEDGE_MESH = CEI - M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG) = CC_CUTCFE - M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - M%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - M%CUT_EDGE(CEI)%NEDGE = 0 - M%CUT_EDGE(CEI)%NEDGE1 = 0 - M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+1) = (/ IEG,JEG,KEG,X1AXEG /) ! Gas right to solid left. - M%CUT_EDGE(CEI)%STATUS = CC_GASPHASE - ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB - ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED + NXB=0 + DO I = 1, 6 + IF (XB(I) MAX_VOLUS) THEN + MAX_VOLUS = N_VOLUS + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + DEALLOCATE(VERTS,FACES,TFACES,VOLUS); + ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1),VOLUS(4*MAX_VOLUS+1)) + VERTS=1.001_EB*MAX_VAL; FACES=0; VOLUS = 0; + ENDIF -! Add new cut-edge created from regular edge: -NVERT = M%CUT_EDGE(CEI)%NVERT -CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) -CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) -CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) + ! define verts in box -NEDGE = M%CUT_EDGE(CEI)%NEDGE+1 -CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) + N_VERTS = 0 + DO K = 0, IJK(3)-1 + BOX_XYZ(3) = (REAL(IJK(3)-1-K,EB)*XB(5) + REAL(K,EB)*XB(6))/REAL(IJK(3)-1,EB) + DO J = 0, IJK(2)-1 + BOX_XYZ(2) = (REAL(IJK(2)-1-J,EB)*XB(3) + REAL(J,EB)*XB(4))/REAL(IJK(2)-1,EB) + DO I = 0, IJK(1)-1 + BOX_XYZ(1) = (REAL(IJK(1)-1-I,EB)*XB(1) + REAL(I,EB)*XB(2))/REAL(IJK(1)-1,EB) + VERTS(3*N_VERTS+1:3*N_VERTS+3) = BOX_XYZ(1:3) + N_VERTS = N_VERTS + 1 + ENDDO + ENDDO + ENDDO -! Define Vert List for newly defined cut-edge: -IF (ILHF==-1) THEN - NOD1_TYPE = CC_VTYPE_VGAS - NOD2_TYPE = CC_VTYPE_VINB -ELSE - NOD1_TYPE = CC_VTYPE_VINB - NOD2_TYPE = CC_VTYPE_VGAS -ENDIF -SELECT CASE(X1AXEG) -CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG-1,JEG ,KEG /) -CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG-1,KEG /) -CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG ,KEG-1/) -END SELECT -M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/NOD2_TYPE,IEG ,JEG ,KEG /) + ! define tetrahedrons in box -! Add edge: Assumes XV1 < XV2 in X1AXEG direction: -M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) + N_VOLUS = 0 + NI = IJK(1) + NIJ = IJK(1)*IJK(2) + DO K = 0, IJK(3)-2 + DO J = 0, IJK(2)-2 + DO I = 0, IJK(1)-2 -M%CUT_EDGE(CEI)%NVERT = NVERT -M%CUT_EDGE(CEI)%NEDGE = NEDGE + ! 8-------7 + ! / . / | + ! 5-------6 | + ! | . | | + ! | . | | + ! | 4-------3 + ! | / | / + ! 1-------2 + BOXVERTLIST(1) = K*NIJ + J*NI + I + 1 + BOXVERTLIST(2) = BOXVERTLIST(1) + 1 + BOXVERTLIST(3) = BOXVERTLIST(2) + NI + BOXVERTLIST(4) = BOXVERTLIST(3) - 1 + BOXVERTLIST(5) = BOXVERTLIST(1) + NIJ + BOXVERTLIST(6) = BOXVERTLIST(2) + NIJ + BOXVERTLIST(7) = BOXVERTLIST(3) + NIJ + BOXVERTLIST(8) = BOXVERTLIST(4) + NIJ + CALL BOX2TETRA(BOXVERTLIST,VOLUS(4*N_VOLUS+1:4*N_VOLUS+24)) + N_VOLUS = N_VOLUS + 6 + ENDDO + ENDDO + ENDDO + N_FACES=0 + ENDIF NXB_IF -! There might be cut-faces that note this EDGE as a regular Gas edge, change incidence in their EDGE_LIST: -SELECT CASE(X1AXEG) -CASE(IAXIS) - ! Face at LOC=-2, located at low Z normal to Y axis: - ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC=-1, located at low Y normal to Z axis: - ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 1, located at high Y normal to Z axis: - ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 2, located at high Z normal to Y axis: - ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) -CASE(JAXIS) - ! Face at LOC=-2, located at low X normal to Z axis: - ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC=-1, located at low Z normal to X axis: - ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 1, located at high Z normal to X axis: - ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 2, located at high X normal to Z axis: - ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) -CASE(KAXIS) - ! Face at LOC=-2, located at low Y normal to X axis: - ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC=-1, located at low X normal to Y axis: - ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! IF(IEG==7 .AND. JEG==4 .AND. KEG==4) THEN - ! WRITE(LU_ERR,*) 'Found EDGE IN CUTEDGE To EDGE IF,JF,KF,AXIS,ICF=',IEG,JEG,KEG,JAXIS,ICF,CEI - ! DO INOD1=1,SIZE(M%CUT_FACE(ICF)%EDGE_LIST,DIM=2)-1 - ! WRITE(LU_ERR,*) M%CUT_FACE(ICF)%EDGE_LIST(:,INOD1) - ! ENDDO - ! ENDIF - ! Face at LOC= 1, located at high X normal to Y axis: - ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 2, located at high Y normal to X axis: - ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) -END SELECT + ! setup a sphere object (SPHERE_RADIUS and SPHERE_ORIGIN keywords) -END SUBROUTINE ADD_CUTEDGE_TO_EDGE + IF (SPHERE_RADIUS MESHES(1) + DX = M%DXMIN -SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,IEC,JEC,LOHI,AXIS) + ! 2*PI*R/(5*2^N_LEVELS) ~= DX, solve for N_LEVELS -INTEGER, INTENT(IN) :: NM,ICF,IEC,JEC,LOHI,AXIS -INTEGER :: IEDGE,DUM + IF (SPHERE_RADIUS<100.0_EB*TWENTY_EPSILON_EB) SPHERE_RADIUS = 100.0_EB*TWENTY_EPSILON_EB -IF(ICF>0) THEN - DUM=0; IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST)) DUM=SIZE(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST,DIM=2) - DO IEDGE=1,DUM-1 - IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE - IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE - IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(3,IEDGE)/=AXIS) CYCLE - MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFGAS,IEC,JEC/) - RETURN - ENDDO -ENDIF -END SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES + IF (SPHERE_TYPE/=2) SPHERE_TYPE = 1 + IF (N_LEVELS<0 .AND. N_LAT>0 .AND. N_LONG>0) SPHERE_TYPE = 2 + IF (SPHERE_TYPE==1) THEN + IF (N_LEVELS==-1) N_LEVELS = INT(LOG(2.0_EB*PI*SPHERE_RADIUS/(5.0_EB*DX))/LOG(2.0_EB)) + N_LEVELS = MIN(7,MAX(0,N_LEVELS)) + N_FACES = 20*(4**N_LEVELS+1) ! NOTE : Number larger than actual value. + ELSE + IF (N_LONG<6) N_LONG = MAX(6,INT(2.0_EB*PI*SPHERE_RADIUS/DX)+1) + IF (N_LAT<3) N_LAT = MAX(3,INT(PI*SPHERE_RADIUS/DX)+1) + N_FACES = 2*N_LAT*N_LONG ! NOTE : Number larger than actual value. + ENDIF + IF (N_FACES > MAX_FACES) THEN + MAX_FACES = N_FACES + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + DEALLOCATE(VERTS,FACES,TFACES); + ALLOCATE(VERTS(3*MAX_VERTS+1)); ALLOCATE(TFACES(6*MAX_FACES+1)); ALLOCATE(FACES(4*MAX_FACES+1)) + VERTS=1.001_EB*MAX_VAL; FACES=0 + ENDIF + IF (SPHERE_TYPE==1) THEN + CALL INIT_SPHERE(N_LEVELS,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,VERTS,FACES) + ELSE + CALL INIT_SPHERE2(N_VERTS,N_FACES,N_LAT,N_LONG,VERTS,FACES) + ENDIF + DO I = 0, N_VERTS-1 + VERTS(3*I+1:3*I+3) = SPHERE_ORIGIN(1:3) + SPHERE_RADIUS*VERTS(3*I+1:3*I+3) + ENDDO + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 + IF (TRIM(SURF_ID(1))/='null') SURFS = 1 ! First single SURF_ID entry takes precedence. + ENDIF -! ------------------------------ ADD_REGEDGE_TO_FACE ------------------------------- + ! Setup a cylinder object (CYLINDER_RADIUS, CYLINDER_LENGTH, CYLINDER_ORIGIN, CYLINDER_AXIS keywords): + DEFINE_CYLINDER_IF: IF ( CYLINDER_LENGTH MAX_FACES) THEN + MAX_FACES = N_FACES + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + DEALLOCATE(VERTS,FACES,TFACES); ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1)) + VERTS=1.001_EB*MAX_VAL; FACES=0 + ENDIF -INTEGER, INTENT(IN) :: NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD -REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) -INTEGER, INTENT(OUT):: CEI,NEDGE -LOGICAL, INTENT(IN) :: IV_LIST + ! Call routine to create cylinder: + CALL DEFINE_CYLINDER(VERTS,MAX_VERTS,N_VERTS,FACES,MAX_FACES,N_FACES,VOLUS,MAX_VOLUS,N_VOLUS,CYL_FIND) -! Local Variables: -INTEGER :: NVERT,INOD1,INOD2,ICF,IEDGE,LOHI -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTFACE_TYPE), POINTER :: CF - -M=>MESHES(NM) -IF(M%FCVAR(IFC,JFC,KFC,CC_FGSC,X1AXFC)==CC_SOLID) RETURN - -! Define Edge as INB cut-edge, add to CUT_EDGE: -CEI = M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) -IF (CEI < 1) THEN - ! Allocate space for cut-edge in CUT_EDGE: - CEI = M%N_CUTEDGE_MESH + 1 - M%N_CUTEDGE_MESH = CEI - M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - M%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - M%CUT_EDGE(CEI)%NEDGE = 0 - M%CUT_EDGE(CEI)%NEDGE1 = 0 - M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. - M%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF - ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB - ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED -ENDIF - -! Add cut-edge: -NVERT = M%CUT_EDGE(CEI)%NVERT -CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) -CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) -CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) - -DO NEDGE=1,M%CUT_EDGE(CEI)%NEDGE - IF( (INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) .OR. & - (INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) ) THEN - RETURN ! Edge already in Face cut-edges list. - ENDIF -ENDDO -CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 -SELECT CASE(X1AXEG) -CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG-1,JEG ,KEG /) -CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG-1,KEG /) -CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG ,KEG-1/) -END SELECT -M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,IEG ,JEG ,KEG /) -IF(IV_LIST) THEN - ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: - M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) - IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) -ELSE - ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: - M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) - IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) -ENDIF + IF (TRIM(SURF_ID(1))/='null') THEN ! First single SURF_ID entry takes precedence. + SURFS = 1 + ELSEIF (TRIM(SURF_IDS(1))/='null' .AND. TRIM(SURF_IDS(2))/='null' .AND. TRIM(SURF_IDS(3))/='null') THEN + SURF_ID(1:3) = SURF_IDS(1:3) + ! Then SURF_IDS(1:3), where (1) is top, (2) sides (3) bottom. + SURFS(CYL_FIND(LOW_IND,1):CYL_FIND(HIGH_IND,1)) = 1 + SURFS(CYL_FIND(LOW_IND,2):CYL_FIND(HIGH_IND,2)) = 2 + SURFS(CYL_FIND(LOW_IND,3):CYL_FIND(HIGH_IND,3)) = 3 + ENDIF -M%CUT_EDGE(CEI)%NVERT = NVERT -M%CUT_EDGE(CEI)%NEDGE = NEDGE + ENDIF DEFINE_CYLINDER_IF -M%CUT_EDGE(CEI)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) + ! Setup an extruded POLYGON object: + POLY_COND : IF (N_POLY_VERTS > 0) THEN + IF ( ABS(EXTRUDE) < GEOMEPS ) THEN + WRITE(MESSAGE,'(A,A,A)') 'ERROR(712): For extruded Polygon GEOM ',TRIM(ID),& + ' : extrusion distance in EXTRUDE field not defined or zero. Define EXTRUDE value in &GEOM.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF -ICF = M%FCVAR(IFC,JFC,KFC,CC_IDCF,X1AXFC) -IF (ICF>0) THEN ! There are cut-faces in this face - LOHI= LOW_IND; IF(ILHF==-1) LOHI=HIGH_IND - ! Define Edge as INB CUT_EDGE, find corresponding RGGAS EDGE associated cut-face and replace it - CF=>M%CUT_FACE(ICF); - INOD1=0; IF(ALLOCATED(CF%EDGE_LIST)) INOD1=SIZE(CF%EDGE_LIST,DIM=2) - DO IEDGE=1,INOD1-1 - IF(CF%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE - IF(CF%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE - IF(CF%EDGE_LIST(3,IEDGE)/=X1AXIS) CYCLE - CF%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFINB, CEI, NEDGE/) - RETURN - ENDDO -ENDIF + ! Do some tests in POLY, Repeated vertex, etc.: + IF (N_POLY_VERTS > N_VERTS) THEN + WRITE(MESSAGE,'(A,A,A,I6,A,I6,A)') 'ERROR(713): For extruded Polygon GEOM ',TRIM(ID),& + ' : Number of POLY indexes ',N_POLY_VERTS,' greater than Number of VERTS ',N_VERTS,'.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + DO J=1,N_POLY_VERTS + DO I=J+1,N_POLY_VERTS + IF (POLY(I)==POLY(J)) THEN + WRITE(MESSAGE,'(A,A,A,I6,A)') 'ERROR(714): For extruded Polygon GEOM ',TRIM(ID),& + ' : Repeated vertex ',POLY(I),' in Polyline.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + IF (NORM2(VERTS(3*POLY(I)-2:3*POLY(I))-VERTS(3*POLY(J)-2:3*POLY(J))) < GEOMEPS) THEN + WRITE(MESSAGE,'(A,A,A,I6,A,I6,A)') 'ERROR(715): For extruded Polygon GEOM ',TRIM(ID),& + ' : Vertices ',POLY(I),' and ',POLY(J),' have same position.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ENDDO -END SUBROUTINE ADD_REGEDGE_TO_FACE + N_FACES = 5*N_POLY_VERTS ! NOTE : Number larger than actual value. + IF (N_FACES > MAX_FACES) THEN + MAX_FACES = N_FACES + CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) + DEALLOCATE(VERTS,FACES,TFACES); ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1)) + VERTS=1.001_EB*MAX_VAL; FACES=0 + ENDIF + CALL DEFINE_EXTRUDED_POLY(MAX_VERTS,N_VERTS,VERTS,MAX_POLY_VERTS,N_POLY_VERTS,POLY,& + EXTRUDE,MAX_FACES,N_FACES,START_FACE_LO,START_FACE_HI,START_FACE_MID,FACES,IERR) -! --------------------------------- DROP_REG_FACE ------------------------------------------- + IF(IERR /= 0) RETURN -SUBROUTINE DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 -INTEGER, INTENT(IN) :: NM,I,J,K,ILHF,X1AXIS + IF (TRIM(SURF_ID(1))/='null') THEN ! First single SURF_ID entry takes precedence. + SURFS = 1 + ELSEIF (TRIM(SURF_IDS(1))/='null' .AND. TRIM(SURF_IDS(2))/='null' .AND. TRIM(SURF_IDS(3))/='null') THEN + SURF_ID(1:3) = SURF_IDS(1:3) + ! Then SURF_IDS(1:3), where (1) is top, (2) sides (3) bottom. + SURFS(START_FACE_HI +1:START_FACE_HI+START_FACE_MID) = 1 + SURFS(START_FACE_MID+1:N_FACES) = 2 + SURFS(START_FACE_LO +1:START_FACE_LO+START_FACE_HI) = 3 + ENDIF -SELECT CASE(X1AXIS) -CASE(IAXIS) - ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: - MESHES(NM)%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID - MESHES(NM)%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: - MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_EGSC,JAXIS)= CC_SOLID ! X2 - MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_IDCE,JAXIS)= CC_UNDEFINED - MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_EGSC,KAXIS)= CC_SOLID ! X3 - MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_IDCE,KAXIS)= CC_UNDEFINED - ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: - MESHES(NM)%VERTVAR(I+ILHF, J-1:J, K-1:K,CC_VGSC) = CC_SOLID -CASE(JAXIS) - ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: - MESHES(NM)%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID - MESHES(NM)%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: - MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_EGSC,KAXIS)= CC_SOLID ! X2 - MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_IDCE,KAXIS)= CC_UNDEFINED - MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_EGSC,IAXIS)= CC_SOLID ! X3 - MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_IDCE,IAXIS)= CC_UNDEFINED - ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: - MESHES(NM)%VERTVAR( I-1:I,J+ILHF, K-1:K,CC_VGSC) = CC_SOLID -CASE(KAXIS) - ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: - MESHES(NM)%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID - MESHES(NM)%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED - ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: - MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_EGSC,IAXIS)= CC_SOLID ! X2 - MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_IDCE,IAXIS)= CC_UNDEFINED - MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_EGSC,JAXIS)= CC_SOLID ! X3 - MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_IDCE,JAXIS)= CC_UNDEFINED - ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: - MESHES(NM)%VERTVAR( I-1:I, J-1:J,K+ILHF,CC_VGSC) = CC_SOLID -END SELECT + ENDIF POLY_COND -END SUBROUTINE DROP_REG_FACE + G%N_LEVELS = N_LEVELS + G%SPHERE_ORIGIN = SPHERE_ORIGIN + G%SPHERE_RADIUS = SPHERE_RADIUS + G%CYLINDER_LENGTH = CYLINDER_LENGTH + G%CYLINDER_RADIUS = CYLINDER_RADIUS + G%CYLINDER_ORIGIN = CYLINDER_ORIGIN + G%CYLINDER_AXIS = CYLINDER_AXIS + G%IJK = IJK + G%GEOM_TYPE = GEOM_TYPE + ! If terrain GEOM and CELL_BLOCK_IOR not set in input line, block in the -3 direction: + IF(GEOM_TYPE==TERRAIN_GEOM_TYPE .AND. CELL_BLOCK_IOR==0) G%CELL_BLOCK_IOR = -KAXIS + LOGTEST = GEOM_TYPE==CAD_GEOM_TYPE .OR. GEOM_TYPE==TERRAIN_GEOM_TYPE + IF (.NOT.LOGTEST) THEN + ! The geometry has been constructed from predefined object : Terrain, cube, sphere, etc. + ! This requires removing duplicate verts. + ! For geometries where VERTS, FACES are being read, GEOM_TYPE=CAD_GEOM_TYPE, it is assumed duplicate vertices + ! have already been removed. + FIRST_FACE_INDEX=1 + CALL REMOVE_DUPLICATE_VERTS(N_VERTS,N_FACES,N_VOLUS,MAX_VERTS,MAX_FACES,MAX_VOLUS,FIRST_FACE_INDEX,& + VERTS,FACES,VOLUS,GEOMEPS) + ENDIF -! --------------------------- INSERT_CUT_CELL ----------------------------------------------- + ! wrap up -SUBROUTINE INSERT_CUT_CELL(NM,I,J,K,ICC) + G%ID = ID + G%N_VOLUS_BASE = N_VOLUS + G%N_FACES_BASE = N_FACES + G%N_VERTS_BASE = N_VERTS -! Adds a cut-cell entry ICF in the CUT_CELL array, assumes no cut-cell defined in cell I,J,K. -INTEGER, INTENT(IN) :: NM,I,J,K -INTEGER, INTENT(OUT):: ICC + ! Check if SURF_ID(1) has been defined: + N_SURF_ID = 0 + IF (TRIM(SURF_ID(1))=='null') THEN + SURF_INDEX_PER_FACE = .FALSE. + HAVE_SURF = .FALSE. + ALLOCATE(G%SURF_ID(1)) + G%SURF_ID(1) = 'null' + ELSE + SURF_INDEX_PER_FACE = .TRUE. + ! Check that elements of the list of SURF_IDs are in list of SURFS: + ! How many SURF_ID entries are different than Null, where in SURFACE they belong: + DO I = 1, MAX_SURF_IDS + IF( SURF_ID(I)=='null' ) EXIT ! First 'null' + N_SURF_ID = N_SURF_ID + 1 + ENDDO + ALLOCATE(G%SURF_ID(1:N_SURF_ID)) + G%SURF_ID(1:N_SURF_ID) = SURF_ID(1:N_SURF_ID) -INTEGER :: DUM,KDUM,JDUM,IDUM,ICF,JCF + ! Now find correspondence with SURFACE(N)%ID: + IF (ALLOCATED(SURF_ID_IND)) DEALLOCATE(SURF_ID_IND) + ALLOCATE(SURF_ID_IND(N_SURF_ID)) + DO I = 1, N_SURF_ID + ! Get Surf Index: + IN_LIST = .FALSE. + DO J = 0, N_SURF + IF (TRIM(SURF_ID(I))/=TRIM(SURFACE(J)%ID)) CYCLE + SURF_ID_IND(I)=J + IN_LIST = .TRUE. + EXIT + ENDDO + IF(.NOT.IN_LIST) THEN + WRITE(MESSAGE,'(A,I4,3A)') 'ERROR(716): problem with GEOM, the surface ID(',I,') =',& + TRIM(SURF_ID(I)),' is not defined.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO + ENDIF + G%HAVE_SURF = HAVE_SURF -TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX + IF (MATL_ID=='null') THEN + HAVE_MATL = .FALSE. + ENDIF + G%MATL_ID = MATL_ID + G%HAVE_MATL = HAVE_MATL -IF( 00) THEN -! Reallocate CUT_CELL: -ALLOCATE(CUT_CELL_AUX( MAX(SIZE(MESHES(NM)%CUT_CELL,DIM=1),MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH) )) -DO DUM=1,ICC-1 - CALL CUT_CELL_MOVE(MESHES(NM)%CUT_CELL(DUM),CUT_CELL_AUX(DUM)) -ENDDO -DO DUM=ICC,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH-1 - CALL CUT_CELL_MOVE(MESHES(NM)%CUT_CELL(DUM),CUT_CELL_AUX(DUM+1)) -ENDDO -CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL) - -! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): -DO KDUM=-CCGUARD,MESHES(NM)%KBAR+CCGUARD - DO JDUM=-CCGUARD,MESHES(NM)%JBAR+CCGUARD - DO IDUM=-CCGUARD,MESHES(NM)%IBAR+CCGUARD - IF(MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC)>=ICC) & - MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC) + 1 + TXMIN = VERTS(1) + TXMAX = TXMIN + TYMIN = VERTS(2) + TYMAX = TYMIN + DO I = 1, N_VERTS + TX = VERTS(3*I-2) + TY = VERTS(3*I-1) + IF (TXTXMAX)TXMAX=TX + IF (TYTYMAX)TYMAX=TY ENDDO - ENDDO -ENDDO -DO ICF=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - DO JCF=1,MESHES(NM)%CUT_FACE(ICF)%NFACE - IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>ICC) & - MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + 1 - IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>ICC) & - MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + 1 - ENDDO -ENDDO - -MESHES(NM)%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) -MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE -MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = ICC - -RETURN -END SUBROUTINE INSERT_CUT_CELL - -! --------------------------- INSERT_CUT_FACE ----------------------------------------------- - -SUBROUTINE INSERT_CUT_FACE(NM,I,J,K,AXIS,ICF,INZONE) - -! This routine add a cut-face entry ICF in the CUT_FACE array: -! 1. IF AXIS = 0 INBOUNDARY face: -! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK is an interior cell. -! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK is a guard cell. -! 2. IF AXIS = 1,2,3 GASPHASE face: -! ICF = MESHES(NM)%N_BBCUTFACE_MESH+1 if II,JJ,KK,AXIS is a boundary face. -! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK,AXIS is an interior face. -! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK,AXIS is a guard face. -INTEGER, INTENT(IN) :: NM,I,J,K,AXIS -INTEGER, INTENT(OUT):: ICF -LOGICAL, OPTIONAL, INTENT(IN) :: INZONE + TEXTURE_ORIGIN(1)=TXMIN + TEXTURE_ORIGIN(2)=TYMIN + TEXTURE_SCALE(1)=TXMAX-TXMIN + TEXTURE_SCALE(2)=TYMAX-TYMIN + ENDIF + G%TEXTURE_ORIGIN = TEXTURE_ORIGIN + G%TEXTURE_SCALE = TEXTURE_SCALE + IF ( TRIM(TEXTURE_MAPPING)/='SPHERICAL' .AND. TRIM(TEXTURE_MAPPING)/='RECTANGULAR') TEXTURE_MAPPING = 'RECTANGULAR' + G%TEXTURE_MAPPING = TEXTURE_MAPPING + G%IS_TERRAIN = IS_TERRAIN -INTEGER :: ICC,JCC,IFC,IFACE,IFCX,DUM,IDUM,JDUM,KDUM,X1AXIS,ICE,ILOC,IEDGE -TYPE(CC_CUTFACE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_FACE_AUX + ! setup volumes -IF(AXIS==0) THEN - IF( 0MESHES(NM)%IBAR) THEN ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ELSEIF(I==0 .OR. I==MESHES(NM)%IBAR) THEN ! Block boundary - MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 - MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 - ICF = MESHES(NM)%N_BBCUTFACE_MESH - ENDIF - ELSE ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ENDIF - CASE(JAXIS) - IF(0MESHES(NM)%JBAR) THEN ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ELSEIF(J==0 .OR. J==MESHES(NM)%JBAR) THEN ! Block boundary - MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 - MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 - ICF = MESHES(NM)%N_BBCUTFACE_MESH - ENDIF - ELSE ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ENDIF - CASE(KAXIS) - IF(0MESHES(NM)%KBAR) THEN ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ELSEIF(K==0 .OR. K==MESHES(NM)%KBAR) THEN ! Block boundary - MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 - MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 - ICF = MESHES(NM)%N_BBCUTFACE_MESH + N_VOLUS_IF: IF (N_VOLUS>0) THEN + ALLOCATE(G%VOLUS(4*N_VOLUS),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%VOLUS',IZERO) + DO I = 0, N_VOLUS-1 + VOL(1:4)=> VOLUS(4*I+1:4*I+4) + V1(1:3) => VERTS(3*VOL(1)-2:3*VOL(1)) + V2(1:3) => VERTS(3*VOL(2)-2:3*VOL(2)) + V3(1:3) => VERTS(3*VOL(3)-2:3*VOL(3)) + V4(1:3) => VERTS(3*VOL(4)-2:3*VOL(4)) + VOLUME = TETRAHEDRON_VOLUME(V3,V4,V2,V1) + IF ( VOLUME<0.0_EB ) THEN ! reorder vertices if tetrahedron volume is negative + IVOL=VOL(3) + VOL(3)=VOL(4) + VOL(4)=IVOL ENDIF - ELSE ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ENDIF - END SELECT -ENDIF - -! Reallocate CUT_FACE: -ALLOCATE(CUT_FACE_AUX( MAX(SIZE(MESHES(NM)%CUT_FACE,DIM=1),MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH) )) -DO DUM=1,ICF-1 - CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM)) -ENDDO -DO DUM=ICF,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH-1 - CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM+1)) -ENDDO -CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE) - -! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): -DO KDUM=-CCGUARD,MESHES(NM)%KBAR+CCGUARD - DO JDUM=-CCGUARD,MESHES(NM)%JBAR+CCGUARD - DO IDUM=-CCGUARD,MESHES(NM)%IBAR+CCGUARD - IF(MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)>=ICF) & - MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF) + 1 - DO X1AXIS=IAXIS,KAXIS - IF(MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS)>=ICF) & - MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) = MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) + 1 - ENDDO - ENDDO - ENDDO -ENDDO -DO ICC=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - DO JCC=1,MESHES(NM)%CUT_CELL(ICC)%NCELL - DO IFC=1,MESHES(NM)%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = MESHES(NM)%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - IF(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) CYCLE - IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) = IFCX+1 - ENDDO - ENDDO - DO IFACE=1,MESHES(NM)%CUT_CELL(ICC)%NFACE_DROPPED - IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) - IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) = IFCX+1 - ENDDO -ENDDO -DO ICE=1,MESHES(NM)%N_CUTEDGE_MESH - CE=>MESHES(NM)%CUT_EDGE(ICE) - DO IEDGE=1,CE%NEDGE - DO ILOC=-2,2 - IF(CE%FACE_LIST(1,ILOC,IEDGE)>=ICF) CE%FACE_LIST(1,ILOC,IEDGE)=CE%FACE_LIST(1,ILOC,IEDGE)+1 - ENDDO - ENDDO -ENDDO -IF(PRESENT(INZONE)) THEN - IF (INZONE) THEN - DO KDUM=0,MESHES(NM)%KBP1 - DO JDUM=0,MESHES(NM)%JBP1 - DO IDUM=0,MESHES(NM)%IBP1 - DO JCC=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%NCELL - DO IFACE=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NWFACE - IF(MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE)>=ICF) & - MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) = & - MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) + 1 - ENDDO - ENDDO - ENDDO - ENDDO ENDDO - ENDIF -ENDIF + G%VOLUS(1: 4*N_VOLUS) = VOLUS(1:4*N_VOLUS) + IF (ANY(VOLUS(1:4*N_VOLUS)<1 .OR. VOLUS(1:4*N_VOLUS)>N_VERTS)) THEN + CALL SHUTDOWN('ERROR(717): problem with GEOM, vertex index out of bounds.') + ENDIF -IF(AXIS==0) THEN - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = ICF - MESHES(NM)%CUT_FACE(ICF)%STATUS = CC_INBOUNDARY -ELSE - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,AXIS) = CC_CUTCFE - MESHES(NM)%FCVAR(I,J,K,CC_IDCF,AXIS) = ICF - MESHES(NM)%CUT_FACE(ICF)%STATUS = CC_GASPHASE -ENDIF -MESHES(NM)%CUT_FACE(ICF)%IJK(1:4) = (/I, J, K, AXIS/) + ALLOCATE(G%MATLS(N_VOLUS),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%MATLS',IZERO) + MATL_INDEX = GET_MATL_INDEX(MATL_ID) + ! The following constraint is removed for the time being. When Tetrahedrons are actually used for heat transfer + ! and pyrolysis this will be needed. + !IF (MATL_INDEX==0) THEN + ! IF (TRIM(MATL_ID)=='null') THEN + ! WRITE(MESSAGE,'(A)') 'ERROR: problem with GEOM, the material keyword, MATL_ID, is not defined.' + ! ELSE + ! WRITE(MESSAGE,'(3A)') 'ERROR: problem with GEOM, the material ',TRIM(MATL_ID),' is not defined.' + ! ENDIF + ! CALL SHUTDOWN(MESSAGE) + !ENDIF + G%MATLS(1:N_VOLUS) = MATL_INDEX -RETURN -END SUBROUTINE INSERT_CUT_FACE + ! construct an array of external faces -! --------------------------------- DROP_CUT_EDGE ------------------------------------------- + ! determine which tetrahedron faces are external -SUBROUTINE DROP_CUT_EDGE(NM,ICE,JCE,ETYPE) + IF (N_FACES==0) THEN + N_FACES = 4*N_VOLUS + IF(ALLOCATED(IS_EXTERNAL)) DEALLOCATE(IS_EXTERNAL) + ALLOCATE(IS_EXTERNAL(0:N_FACES-1),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','IS_EXTERNAL',IZERO) -INTEGER, INTENT(IN) :: NM,ICE,JCE,ETYPE + IS_EXTERNAL(0:N_FACES-1)=.TRUE. ! start off by assuming all faces are external -INTEGER :: CT,DUM,ILH,ICF1,IEDGE -INTEGER, ALLOCATABLE, DIMENSION(:) :: IND -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTEDGE_TYPE), POINTER :: CE + ! reorder face indices so the the first index is always the smallest -IF(ICE<1) RETURN -M =>MESHES(NM) -CE=>M%CUT_EDGE(ICE) + ! 1 + ! /|\ . + ! / | \ . + ! / | \ . + ! / | \ . + ! / | \ . + ! / 4 \ . + ! / . . \ . + ! / . . \ . + ! / . . \ . + ! / . . \ . + ! / . . \ . + ! / . .\ . + ! 2-------------------------3 -NEDGE_IF_1 : IF(CE%NEDGE>1) THEN - ALLOCATE(IND(CE%NEDGE)); IND = 0 - CT=0; - DO DUM=1,CE%NEDGE - IF(DUM==JCE) CYCLE - CT = CT + 1 - IND(DUM) = CT - ENDDO - ! Collapse NEDGE variables: - DO DUM=1,CE%NEDGE - IF(DUM==JCE) CYCLE - CE%CEELEM( :,IND(DUM)) = CE%CEELEM( :,DUM) - CE%INDSEG( :,IND(DUM)) = CE%INDSEG( :,DUM) - CE%FACE_LIST(:,:,IND(DUM)) = CE%FACE_LIST(:,:,DUM) - CE%DXX( :,IND(DUM)) = CE%DXX( :,DUM) + DO I = 0, N_VOLUS-1 + FACES(12*I+1) = VOLUS(4*I+1) + FACES(12*I+2) = VOLUS(4*I+2) + FACES(12*I+3) = VOLUS(4*I+3) + CALL REORDER_VERTS(FACES(12*I+1:12*I+3)) - ! Finally change EDGE_LIST of involved faces: - DO ILH=-2,2 - ICF1 = CE%FACE_LIST(1,ILH,IND(DUM)); IF(ICF1<1) CYCLE - IEDGE = CE%FACE_LIST(3,ILH,IND(DUM)) - M%CUT_FACE(ICF1)%EDGE_LIST(3,IEDGE) = IND(DUM) - ENDDO - ENDDO -ENDIF NEDGE_IF_1 + FACES(12*I+4) = VOLUS(4*I+1) + FACES(12*I+5) = VOLUS(4*I+3) + FACES(12*I+6) = VOLUS(4*I+4) + CALL REORDER_VERTS(FACES(12*I+4:12*I+6)) -CE%NEDGE = CE%NEDGE - 1 -IF(CE%NEDGE < 1) THEN - IF(ETYPE==CC_ETYPE_CFGAS) THEN - M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_EGSC,CE%IJK(KAXIS+1)) = CC_SOLID - M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED - ELSEIF(ETYPE==CC_ETYPE_CFINB) THEN - IF(CE%IJK(KAXIS+1)>0) THEN - M%FCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED - ELSE - M%CCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE) = CC_UNDEFINED - ENDIF - ENDIF - CE%STATUS = CC_SOLID -ENDIF + FACES(12*I+7) = VOLUS(4*I+1) + FACES(12*I+8) = VOLUS(4*I+4) + FACES(12*I+9) = VOLUS(4*I+2) + CALL REORDER_VERTS(FACES(12*I+7:12*I+9)) -END SUBROUTINE DROP_CUT_EDGE + FACES(12*I+10) = VOLUS(4*I+2) + FACES(12*I+11) = VOLUS(4*I+4) + FACES(12*I+12) = VOLUS(4*I+3) + CALL REORDER_VERTS(FACES(12*I+10:12*I+12)) + ENDDO + ! find faces that match -! ----------------------------- DROP_CUTFACE -------------------------------------- + SORT_FACES=2 + IF (GEOM_TYPE == SPHERE_GEOM_TYPE) SORT_FACES = 3 ! Case of sphere. -SUBROUTINE DROP_CUTFACE(NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC) + SORT_FACES_IF: IF (SORT_FACES==1 ) THEN ! O(n*log(n)) algorithm for determining external faces + ALLOCATE(OFACES(N_FACES),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','OFACES',IZERO) + CALL ORDER_FACES(OFACES,N_FACES) + DO I = 1, N_FACES-1 + FACEI=>FACES(3*OFACES(I)-2:3*OFACES(I)) + FACEJ=>FACES(3*OFACES(I)+1:3*OFACES(I)+3) + IF (FACEI(1)==FACEJ(1) .AND. & + MIN(FACEI(2),FACEI(3))==MIN(FACEJ(2),FACEJ(3)) .AND. & + MAX(FACEI(2),FACEI(3))==MAX(FACEJ(2),FACEJ(3))) THEN + IS_EXTERNAL(OFACES(I))=.FALSE. + IS_EXTERNAL(OFACES(I-1))=.FALSE. + IF (FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(3)) THEN + WRITE(LU_ERR,*) 'WARNING: duplicate faces found:', FACEI(1),FACEI(2),FACEI(3) + ENDIF + ENDIF + ENDDO + DEALLOCATE(OFACES) + ELSEIF(SORT_FACES==2 ) THEN + DO I = 0, N_FACES-1 ! O(n^2) algorithm for determining external faces + FACEI=>FACES(3*I+1:3*I+3) + ! Sort FACEI: + DO J = 0, N_FACES-1 + IF (I==J) CYCLE + FACEJ=>FACES(3*J+1:3*J+3) + IF (FACEI(1)==FACEJ(1)) THEN + IF ((FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(3)) .OR. & + (FACEI(2)==FACEJ(3) .AND. FACEI(3)==FACEJ(2))) THEN + IS_EXTERNAL(I) = .FALSE. + IS_EXTERNAL(J) = .FALSE. + ENDIF + ELSEIF (FACEI(1)==FACEJ(2)) THEN + IF ((FACEI(2)==FACEJ(1) .AND. FACEI(3)==FACEJ(3)) .OR. & + (FACEI(2)==FACEJ(3) .AND. FACEI(3)==FACEJ(1))) THEN + IS_EXTERNAL(I) = .FALSE. + IS_EXTERNAL(J) = .FALSE. + ENDIF + ELSEIF (FACEI(1)==FACEJ(3)) THEN + IF ((FACEI(2)==FACEJ(1) .AND. FACEI(3)==FACEJ(2)) .OR. & + (FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(1))) THEN + IS_EXTERNAL(I) = .FALSE. + IS_EXTERNAL(J) = .FALSE. + ENDIF + ENDIF + ENDDO + ENDDO + ELSEIF(SORT_FACES==3 ) THEN + DO I = 0,N_FACES-1 + ! Check that no verts are at the spheres center: + DO II=1,3 + II1=FACES(3*I+II) + IF ( SQRT((VERTS(3*II1-2)-SPHERE_ORIGIN(IAXIS))**2 + & + (VERTS(3*II1-1)-SPHERE_ORIGIN(JAXIS))**2 + & + (VERTS(3*II1 )-SPHERE_ORIGIN(KAXIS))**2) < GEOMEPS) & + IS_EXTERNAL(I) = .FALSE. + ENDDO + ENDDO + ENDIF SORT_FACES_IF -! Drop cut-face CUT_FACE(ICF)%CFELEM(:,JCF): -! 0. For garphase cut-faces, move gas edges (reg and cut) to INB face CUT_EDGEs where it corresponds. -! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). -! 2. Change second index for cut-faces of cells attached to ICF,JCF -! 3. If zero remaining cut-faces in CUT_FACE(ICF) => make FCVAR,CCVAR GSC and IDCF indexes SOLID and INDEFINED. + ! create new FACES index array keeping only external faces -INTEGER, INTENT(IN) :: NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC + N_FACES_TEMP = N_FACES + N_FACES=0 + DO I = 0, N_FACES_TEMP-1 + FACE_FROM=>FACES(3*I+1:3*I+3) + ! Drop triangles with zero area: + IF ( (FACE_FROM(1)==FACE_FROM(2)).OR.(FACE_FROM(1)==FACE_FROM(3)).OR.(FACE_FROM(2)==FACE_FROM(3)) ) CYCLE + IF (IS_EXTERNAL(I)) THEN + FACE_TO=>FACES(3*N_FACES+1:3*N_FACES+3) + FACE_TO(1:3) = FACE_FROM(1:3) + N_FACES=N_FACES+1 + ENDIF + ENDDO + G%N_FACES_BASE = N_FACES -INTEGER :: CT,DUM,ILH,ICC1,JCC1,IFACE,IFC1,IFACE2 -INTEGER, ALLOCATABLE, DIMENSION(:) :: IND -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTFACE_TYPE), POINTER :: CF + IF (GEOM_TYPE == SPHERE_GEOM_TYPE) THEN + DO I = 0,N_FACES-1 + ! Check that no verts are at the spheres center: + DO II=1,3 + II1=FACES(3*I+II) + IF ( SQRT((VERTS(3*II1-2)-SPHERE_ORIGIN(IAXIS))**2 + & + (VERTS(3*II1-1)-SPHERE_ORIGIN(JAXIS))**2 + & + (VERTS(3*II1 )-SPHERE_ORIGIN(KAXIS))**2) < GEOMEPS) & + WRITE(LU_ERR,*) 'On External Faces, face/vertex ',I,II,II1,' located at center.' + ENDDO + II1=FACES(3*I+1) + II2=FACES(3*I+2) + II3=FACES(3*I+3) + DV1(IAXIS:KAXIS)= VERTS(3*II2-2:3*II2) - VERTS(3*II1-2:3*II1) + DV2(IAXIS:KAXIS)= VERTS(3*II3-2:3*II3) - VERTS(3*II1-2:3*II1) + CALL CROSS_PRODUCT(NVECI,DV1,DV2) + DXCEN= 1._EB/3._EB*(VERTS(3*II1-2:3*II1)+VERTS(3*II2-2:3*II2)+VERTS(3*II3-2:3*II3)) - & + SPHERE_ORIGIN(IAXIS:KAXIS) + DOTI = NVECI(IAXIS)*DXCEN(IAXIS) + NVECI(JAXIS)*DXCEN(JAXIS) + NVECI(KAXIS)*DXCEN(KAXIS) -M => MESHES(NM) -CF=> M%CUT_FACE(IFC) + IF (SIGN(1._EB,DOTI) < 0._EB) THEN + WRITE(LU_ERR,*) I,' has (-) sign normal.' + FACES(3*I+2) = II3 + FACES(3*I+3) = II2 + ENDIF + ENDDO + ENDIF + CALL COMPUTE_TEXTURES(VERTS,FACES,TFACES,MAX_VERTS,MAX_FACES,N_FACES) -! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). -NFACE_IF_1 : IF(CF%NFACE>1) THEN - ALLOCATE(IND(CF%NFACE)); IND = 0 - CT=0; - DO DUM=1,CF%NFACE - IF(DUM==JFC) CYCLE - CT = CT + 1 - IND(DUM) = CT - ENDDO - ! Collapse NFACE variables: - DO DUM=1,CF%NFACE - IF(DUM==JFC) CYCLE - CF%CFELEM( :,IND(DUM)) = CF%CFELEM( :,DUM) - CF%CEDGES( :,IND(DUM)) = CF%CEDGES( :,DUM) - CF%AREA( IND(DUM)) = CF%AREA( DUM) - CF%XYZCEN( :,IND(DUM)) = CF%XYZCEN( :,DUM) - CF%SHARED( IND(DUM)) = CF%SHARED( DUM) - CF%CELL_LIST(:,:,IND(DUM)) = CF%CELL_LIST(:,:,DUM) - ! Finally change FACE_LIST of involved cells: - CT = HIGH_IND - IF(FTYPE==CC_FTYPE_CFINB) THEN - CT = LOW_IND - CF%BODTRI( :,IND(DUM)) = CF%BODTRI( :,DUM) - CF%SURF_INDEX( IND(DUM)) = CF%SURF_INDEX( DUM) - CF%BLK_TAG( IND(DUM)) = CF%BLK_TAG( DUM) - CF%CFACE_ORIGIN( IND(DUM)) = CF%CFACE_ORIGIN( DUM) - CF%AREA_ADJUST( IND(DUM)) = CF%AREA_ADJUST( DUM) + ! Surf IDs for generated GEOM: + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) + ALLOCATE(SURFS(N_FACES)) + IF(SURF_INDEX_PER_FACE) THEN + SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). + ELSE + SURFS(:) = 0 ! All external faces point to default surf ID. + ENDIF ENDIF - DO ILH=LOW_IND,CT - ICC1 = CF%CELL_LIST(2,ILH,IND(DUM)) - JCC1 = CF%CELL_LIST(3,ILH,IND(DUM)) - IFC1 = CF%CELL_LIST(4,ILH,IND(DUM)) - IFACE= M%CUT_CELL(ICC1)%CCELEM(IFC1+1,JCC1) - ! Dropping gas-cut cells, do not reindex local JCF for INBOUNDARY faces. These have been changed already. - IF(FTYPE==CC_FTYPE_CFINB .OR. (FTYPE==CC_FTYPE_CFGAS .AND. M%CUT_CELL(ICC1)%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB)) & - M%CUT_CELL(ICC1)%FACE_LIST(5,IFACE) = IND(DUM) - DO IFACE2=1,M%CUT_CELL(ICC1)%NFACE_DROPPED - IF(M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & - M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(4,IFACE2)==IFC .AND. & - M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)==DUM) & - M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)=IND(DUM) - ENDDO - ENDDO - ENDDO - CF%CFELEM( :,CF%NFACE) = CC_UNDEFINED - CF%CEDGES( :,CF%NFACE) = CC_UNDEFINED - CF%AREA( CF%NFACE) = 0._EB - CF%XYZCEN( :,CF%NFACE) = 0._EB - CF%SHARED( CF%NFACE) = .FALSE. - CF%BLK_TAG( CF%NFACE) = .FALSE. - CF%CELL_LIST(:,:,CF%NFACE) = CC_UNDEFINED - IF(FTYPE==CC_FTYPE_CFINB) THEN - CF%BODTRI( :,CF%NFACE) = CC_UNDEFINED - CF%SURF_INDEX( CF%NFACE) = CC_UNDEFINED - CF%CFACE_ORIGIN( CF%NFACE) = CC_UNDEFINED - ENDIF - DEALLOCATE(IND) -ENDIF NFACE_IF_1 - -CF%NFACE = MAX(0,CF%NFACE - 1) + ENDIF N_VOLUS_IF -IF(FTYPE==CC_FTYPE_CFGAS .AND. CF%NSFACE>0) THEN ! Bring down SOLID faces used for SLCF plotting. - CT=CF%NFACE - DO DUM=1,CF%NSFACE - CT=CT+1 - CF%CFELEM( :,CT) = CF%CFELEM( :,CT+1) - CF%CEDGES( :,CT) = CF%CEDGES( :,CT+1) - CF%AREA( CT) = CF%AREA( CT+1) - CF%XYZCEN( :,CT) = CF%XYZCEN( :,CT+1) - ENDDO -ENDIF - -IF(CF%NFACE < 1) THEN - CF%STATUS = CC_SOLID - CF%NSFACE = 0 - IF (FTYPE == CC_FTYPE_CFGAS) THEN - SELECT CASE(X1AXIS) - CASE(IAXIS) - M%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - M%ECVAR(I+ILHF,J-1:J,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J-1:J,K,CC_IDCE,KAXIS) = CC_UNDEFINED - M%ECVAR(I+ILHF,J,K-1:K,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J,K-1:K,CC_IDCE,JAXIS) = CC_UNDEFINED - CASE(JAXIS) - M%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - M%ECVAR(I-1:I,J+ILHF,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I-1:I,J+ILHF,K,CC_IDCE,KAXIS) = CC_UNDEFINED - M%ECVAR(I,J+ILHF,K-1:K,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J+ILHF,K-1:K,CC_IDCE,IAXIS) = CC_UNDEFINED - CASE(KAXIS) - M%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED - M%ECVAR(I-1:I,J,K+ILHF,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I-1:I,J,K+ILHF,CC_IDCE,JAXIS) = CC_UNDEFINED - M%ECVAR(I,J-1:J,K+ILHF,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J-1:J,K+ILHF,CC_IDCE,IAXIS) = CC_UNDEFINED - END SELECT - ELSEIF (FTYPE == CC_FTYPE_CFINB) THEN - M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED + ! Terrain case built with ZVALS, optimized way, define SURFS(:): + IF (N_ZVALS > 0) THEN + ! Surf IDs for generated GEOM: + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) + ALLOCATE(SURFS(N_FACES)) + IF(SURF_INDEX_PER_FACE) THEN + SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). + ELSE + SURFS(:) = 0 ! All external faces point to default surf ID. + ENDIF + ELSEIF(IS_TERRAIN) THEN + ! Finally Enhance SURFS to accomodate new faces. + ALLOCATE(SURFS2(N_FACES)); + ! Here define what SURF to assign to added faces. + IF(SURF_INDEX_PER_FACE) THEN + SURFS2(:) = 1 ! All external faces point to only entry SURF_ID(1). + ELSE + SURFS2(:) = 0 ! All external faces point to default surf ID. + ENDIF + SURFS2(1:N_FACES_ORIG) = SURFS(1:N_FACES_ORIG) + CALL MOVE_ALLOC(FROM=SURFS2,TO=SURFS) ENDIF -ENDIF -RETURN -END SUBROUTINE DROP_CUTFACE + N_FACES_IF: IF (N_FACES>0) THEN + ALLOCATE(G%FACES(3*N_FACES),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%FACES',IZERO) + G%FACES(1:3*N_FACES) = FACES(1:3*N_FACES) + ! Check FACES for out of bounds indexes: + I = MINVAL(FACES(1:3*N_FACES)); II= MINLOC(FACES(1:3*N_FACES),DIM=1) + IF (I < 1) THEN + WRITE(MESSAGE,'(3A,I8,A,I8,A)') 'ERROR(718): Out of Bounds. GEOM: ',TRIM(ID), ', FACE=',& + II/3+1,', has vertex index ',I,' less than 1.' + CALL SHUTDOWN(MESSAGE) + RETURN + ENDIF + I = MAXVAL(FACES(1:3*N_FACES)); II= MAXLOC(FACES(1:3*N_FACES),DIM=1) + IF (I > N_VERTS) THEN + WRITE(MESSAGE,'(3A,I8,A,I8,A,I8,A)') 'ERROR(719): Out of Bounds. GEOM: ',TRIM(ID), ', FACE=',& + II/3+1,', has vertex index ',I,', higher than number of vertices defined ',N_VERTS,'.' + CALL SHUTDOWN(MESSAGE) + RETURN + ENDIF -! ----------------------------- DROP_CUTCELL -------------------------------------- + ALLOCATE(G%TFACES(6*N_FACES),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%TFACES',IZERO) + G%TFACES(1:6*N_FACES) = TFACES(1:6*N_FACES) -SUBROUTINE DROP_CUTCELL(NM,ICC,JCC) + ALLOCATE(G%SURFS(N_FACES),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%SURFS',IZERO) -! Remove cut-cell CUT_CELL(ICC)%CCELEM(:,JCC): -! 1. If CUT_CELL(ICC)%NCELL==1 drop INBOUNDARY faces of ICC,JCC, make CCVAR CGSC SOLID and IDCC,IDCF undefined. -! 2. If more than 1 NCELL, drop JCc from CCELEM, IJK_LINK, LINK_LEV, VOLUME, XYZCEN lists and NCELL=NCELL-1 + PER_FACE_IF: IF (SURF_INDEX_PER_FACE) THEN + DO I=1,N_FACES + IF ( SURFS(I) <= 0 ) THEN + G%SURFS(I) = DEFAULT_SURF_INDEX ! If local SURF ID index <= 0, use default surf ID. + ELSE + G%SURFS(I) = SURF_ID_IND(SURFS(I)) + ENDIF + ENDDO + DEALLOCATE(SURF_ID_IND) + ELSE + G%SURFS(1:N_FACES) = DEFAULT_SURF_INDEX + BOX_TYPE_IF: IF ( GEOM_TYPE==BOX_GEOM_TYPE .AND. & + (SURF_ID(1)/='null' .OR. ALL(SURF_IDS/='null') .OR. ALL(SURF_ID6/='null')) )THEN + ! This loop allows GEOM to behave similarly to OBST + FACE_LOOP: DO I=1,N_FACES + II1=G%FACES(3*(I-1)+1) + II2=G%FACES(3*(I-1)+2) + II3=G%FACES(3*(I-1)+3) + DV1(IAXIS:KAXIS)= VERTS(3*II2-2:3*II2) - VERTS(3*II1-2:3*II1) + DV2(IAXIS:KAXIS)= VERTS(3*II3-2:3*II3) - VERTS(3*II1-2:3*II1) + CALL CROSS_PRODUCT(NVECI,DV1,DV2) + SURF_LOOP: DO NNN=0,N_SURF + IF (SURF_ID(1)==SURFACE(NNN)%ID .AND. ANY(ABS(NVECI(:))>TWENTY_EPSILON_EB)) G%SURFS(I) = NNN ! all sides + IF (SURF_IDS(2)==SURFACE(NNN)%ID .AND. (ABS(NVECI(1))>TWENTY_EPSILON_EB .OR. ABS(NVECI(2))>TWENTY_EPSILON_EB) ) & + G%SURFS(I) = NNN ! sides + IF (SURF_IDS(1)==SURFACE(NNN)%ID .AND. NVECI(3)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! top + IF (SURF_IDS(3)==SURFACE(NNN)%ID .AND. NVECI(3)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! bottom + IF (SURF_ID6(1)==SURFACE(NNN)%ID .AND. NVECI(1)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! X1 + IF (SURF_ID6(2)==SURFACE(NNN)%ID .AND. NVECI(1)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! X2 + IF (SURF_ID6(3)==SURFACE(NNN)%ID .AND. NVECI(2)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Y1 + IF (SURF_ID6(4)==SURFACE(NNN)%ID .AND. NVECI(2)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Y2 + IF (SURF_ID6(5)==SURFACE(NNN)%ID .AND. NVECI(3)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Z1 + IF (SURF_ID6(6)==SURFACE(NNN)%ID .AND. NVECI(3)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Z2 + ENDDO SURF_LOOP + ENDDO FACE_LOOP + ENDIF BOX_TYPE_IF + ENDIF PER_FACE_IF -INTEGER, INTENT(IN) :: NM,ICC,JCC + ! Test for Unsupported surfaces: + DO I=1,N_FACES + ! HERE do tests on surfaces, is not supported by GEOMs throw error: + UNSUPPORTED_SURF_FIELD : IF(SURFACE(G%SURFS(I))%BURN_AWAY) THEN + WRITE(MESSAGE,'(5A)') 'ERROR(720): GEOM: ',TRIM(ID),& + ', has currently unsupported BURN_AWAY feature in surface : ',TRIM(SURFACE(G%SURFS(I))%ID),'.' + CALL SHUTDOWN(MESSAGE) + RETURN + ENDIF UNSUPPORTED_SURF_FIELD + ! Others.. + ENDDO -! Local Variables -INTEGER :: I,J,K,JCC2,IFC,CT -INTEGER, ALLOCATABLE, DIMENSION(:) :: IND -TYPE(MESH_TYPE), POINTER :: M -M => MESHES(NM) + ENDIF N_FACES_IF -I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS) + IF (N_VERTS>0) THEN + ALLOCATE(G%VERTS_BASE(3*N_VERTS),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%VERTS_BASE',IZERO) + G%VERTS_BASE(1:3*N_VERTS) = VERTS(1:3*N_VERTS) -! Check if JCC is the only cut-cell in CUT_CELL(ICC): -IF (M%CUT_CELL(ICC)%NCELL==1) THEN - ! Set cut-cell to solid - M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID - M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED - M%CUT_CELL(ICC)%NCELL = 0 - ! Then drop INBOUNDARY cut-faces in I,J,K if there are any left: - IFC=M%CCVAR(I,J,K,CC_IDCF) - IF (IFC>0) THEN - M%CUT_FACE(IFC)%STATUS = CC_SOLID - M%CUT_FACE(IFC)%NFACE = 0 + ALLOCATE(G%VERTS(3*N_VERTS),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%VERTS',IZERO) ENDIF - M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED - RETURN -ENDIF -! First count: -ALLOCATE(IND(1:M%CUT_CELL(ICC)%NCELL)); IND=0 -CT=0 -DO JCC2=1,M%CUT_CELL(ICC)%NCELL - IF (JCC2==JCC) CYCLE - CT = CT + 1 - IND(JCC2) = CT -ENDDO + G%MOVE_ID = MOVE_ID + G%IS_DYNAMIC = .FALSE. -! Then drop JCC: -DO JCC2=1,M%CUT_CELL(ICC)%NCELL - IF (JCC2==JCC) CYCLE - M%CUT_CELL(ICC)%CCELEM(:,IND(JCC2)) = M%CUT_CELL(ICC)%CCELEM(:,JCC2) - M%CUT_CELL(ICC)%IJK_LINK(:,IND(JCC2)) = M%CUT_CELL(ICC)%IJK_LINK(:,JCC2) - M%CUT_CELL(ICC)%LINK_LEV(IND(JCC2)) = M%CUT_CELL(ICC)%LINK_LEV(JCC2) - M%CUT_CELL(ICC)%VOLUME(IND(JCC2)) = M%CUT_CELL(ICC)%VOLUME(JCC2) - M%CUT_CELL(ICC)%XYZCEN(:,IND(JCC2)) = M%CUT_CELL(ICC)%XYZCEN(:,JCC2) - M%CUT_CELL(ICC)%NOADVANCE(IND(JCC2)) = M%CUT_CELL(ICC)%NOADVANCE(JCC2) -ENDDO + ! Prevent drawing of boundary info if desired -M%CUT_CELL(ICC)%NCELL = M%CUT_CELL(ICC)%NCELL - 1 + G%SHOW_BNDF = BNDF_GEOM -DEALLOCATE(IND) + ! Case of false READ_BINARY, Process 0 writes a binary file with the geom: + IF(MY_RANK == 0 .AND. .NOT.READ_BINARY) THEN + WRITE(FN_BINGEOM,'(A,A,A,A,A)') './',TRIM(BINGEOM_DIR)//TRIM(CHID),'_',TRIM(ID),'.bingeom' + OPEN(UNIT=LU_BINGEOM,FILE=TRIM(FN_BINGEOM),STATUS='UNKNOWN',ACTION='WRITE',FORM='UNFORMATTED') + WRITE(LU_BINGEOM) GEOM_TYPE + IF (GEOM_TYPE==TERRAIN_GEOM_TYPE) THEN + WRITE(LU_BINGEOM) N_VERTS_ORIG,N_FACES_ORIG,N_SURF_ID,N_VOLUS_ORIG + WRITE(LU_BINGEOM) VERTS(1:3*N_VERTS_ORIG) + WRITE(LU_BINGEOM) FACES(1:3*N_FACES_ORIG) + WRITE(LU_BINGEOM) SURFS(1:N_FACES_ORIG) + WRITE(LU_BINGEOM) VOLUS(1:4*N_VOLUS_ORIG) + ELSE + WRITE(LU_BINGEOM) N_VERTS,N_FACES,N_SURF_ID,N_VOLUS + WRITE(LU_BINGEOM) VERTS(1:3*N_VERTS) + WRITE(LU_BINGEOM) FACES(1:3*N_FACES) + WRITE(LU_BINGEOM) SURFS(1:N_FACES) + WRITE(LU_BINGEOM) VOLUS(1:4*N_VOLUS) + ENDIF + CLOSE(LU_BINGEOM) + ENDIF -RETURN -END SUBROUTINE DROP_CUTCELL +ENDDO READ_GEOM_LOOP +35 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 -! -------------------------- GET_CELL_LINK_INFO ----------------------------------- +CALL CONVERTGEOM(T_BEGIN) -SUBROUTINE GET_CELL_LINK_INFO(NM) +DO IG = 1, N_GEOMETRY -! Small cell linking subroutine in the mesh. Builds linking information for cutcell ICC,JCC: -! CUT_CELL(ICC)%IJK_LINK(1:KAXIS+2,JCC) of cell linked to, and CUT_CELL(ICC)%LINK_LEV(JCC) level within link tree. + G=>GEOMETRY(IG) -INTEGER, INTENT(IN) :: NM + ! Define box containing Geometry: + DO X1AXIS=IAXIS,KAXIS + G%GEOM_BOX( LOW_IND,X1AXIS) = 1._EB/GEOMEPS ! Initialize min location in X1AXIS dir to large (+) number. + G%GEOM_BOX(HIGH_IND,X1AXIS) =-1._EB/GEOMEPS ! Initialize max location in X1AXIS dir to large (-) number. + DO IVERT=1,G%N_VERTS + G%GEOM_BOX( LOW_IND,X1AXIS) = MIN(G%GEOM_BOX( LOW_IND,X1AXIS),G%VERTS(MAX_DIM*(IVERT-1)+X1AXIS)) + G%GEOM_BOX(HIGH_IND,X1AXIS) = MAX(G%GEOM_BOX(HIGH_IND,X1AXIS),G%VERTS(MAX_DIM*(IVERT-1)+X1AXIS)) + ENDDO + ENDDO -! Local Variables: -INTEGER :: ICC,JCC,ICC2,JCC2,JCC_LNK,I,J,K,I_LNK,J_LNK,K_LNK,IFC,IFC2,IFACE,IFACE2,IFACE3,IBOD,IWSEL,VAL_UNKZ,& - LINK_ITER,INGH,JNGH,KNGH,X1AXIS,ILH,INRM(1:3),DUM,LNK_LEV,ULINK_COUNT,LINK_LEV_UP,AX_MIN,AX_OTHERS(2) -REAL(EB):: AREA,AF,NRML(IAXIS:KAXIS),VAL_CVOL,CCVOL_THRES, XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND),& - MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND:HIGH_IND),CELL_DELTA(IAXIS:KAXIS) -LOGICAL :: QUITLINK_FLG,CRTCELL_FLG,MASK(IAXIS:KAXIS),BLOCK_SLIM_IF,SOLID_FACES -CHARACTER(MESSAGE_LENGTH) :: UNLINKED_FILE -INTEGER, SAVE :: LU_UNLNK -LOGICAL, SAVE :: UNLINKED_1ST_CALL=.TRUE. -TYPE (MESH_TYPE), POINTER :: M -TYPE (CC_CUTCELL_TYPE), POINTER :: CC + ! Check for duct nodes -M => MESHES(NM) + DO J = 1,G%N_FACES + IF (SURFACE(G%SURFS(J))%NODE_ID/='null') THEN + G%HAVE_NODE = .TRUE. + EXIT + ENDIF + ENDDO -! Initialize UNKZ, used here to define if cell has been noted in linking hierarchy. Assume CCVAR has been allocated: -M%CCVAR(:,:,:,CC_UNKZ) = CC_UNDEFINED -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC); I=CC%IJK(IAXIS); J=CC%IJK(JAXIS); K=CC%IJK(KAXIS) - ! Test for sliver trapped cells blocking: - XYZCELL(IAXIS,LOW_IND) = XFACE(I-1); XYZCELL(IAXIS,HIGH_IND) = XFACE(I); - XYZCELL(JAXIS,LOW_IND) = YFACE(J-1); XYZCELL(JAXIS,HIGH_IND) = YFACE(J); - XYZCELL(KAXIS,LOW_IND) = ZFACE(K-1); XYZCELL(KAXIS,HIGH_IND) = ZFACE(K); - MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) - MINMAX_XYZ_CC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) - DO JCC=1,CC%NCELL - ! Get cut-cell bounding box: - CALL CUT_CELL_BOUNDING_BOX(NM,ICC,JCC,XYZCELL,MINMAX_XYZ_CC) - ! Perform Tests: - DO DUM=IAXIS,KAXIS - CELL_DELTA(DUM) = ABS(MINMAX_XYZ_CC(DUM,HIGH_IND)-MINMAX_XYZ_CC(DUM,LOW_IND)) - ENDDO - ! Axis with minimum width: - AX_MIN = MINLOC(CELL_DELTA(IAXIS:KAXIS),DIM=1) - SELECT CASE(AX_MIN) - CASE(IAXIS); AX_OTHERS(1:2) = (/ JAXIS, KAXIS /); SOLID_FACES = ALL(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_SOLID) - CASE(JAXIS); AX_OTHERS(1:2) = (/ IAXIS, KAXIS /); SOLID_FACES = ALL(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_SOLID) - CASE(KAXIS); AX_OTHERS(1:2) = (/ IAXIS, JAXIS /); SOLID_FACES = ALL(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_SOLID) - END SELECT - ! Perform Test: - BLOCK_SLIM_IF = (CELL_DELTA(AX_MIN)<10._EB*MIN_LENGTH_FACTOR*CELL_DELTA(AX_OTHERS(1))) .AND. & - (CELL_DELTA(AX_MIN)<10._EB*MIN_LENGTH_FACTOR*CELL_DELTA(AX_OTHERS(2))) - IF(BLOCK_SLIM_IF .AND. SOLID_FACES) CC%NOADVANCE(JCC) = BLOCKED_SMALL_CELL - ENDDO - CC%UNKZ(:) = CC_UNDEFINED - DO JCC=1,CC%NCELL - IF (CC%NOADVANCE(JCC)>0) CC%IJK_LINK(1,JCC) = CC_SOLID - ENDDO ENDDO -! Loop on Cartesian cells, number unknowns for cells type CC_CUTCFE and surrounding CC_GASPHASE: -DO K=0,M%KBP1 - DO J=0,M%JBP1 - DO I=0,M%IBP1 - IF ( M%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE - ! First Add the Cut-Cell - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF (ICC <= M%N_CUTCELL_MESH .AND. .NOT. M%CELL(M%CELL_INDEX(I,J,K))%SOLID ) THEN ! Don't number GC cut-cells, - ! or cutcells inside an OBST. - CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) - DO JCC=1,M%CUT_CELL(ICC)%NCELL - IF ( M%CUT_CELL(ICC)%NOADVANCE(JCC)>0 ) CYCLE - IF ( M%CUT_CELL(ICC)%VOLUME(JCC) > CCVOL_THRES) M%CUT_CELL(ICC)%UNKZ(JCC) = 1 - ENDDO - ENDIF - ! Run over Neighbors: Case 27 cells. Only Internal cells for the mesh in the stencil (I-1:I+1,J-1:J+1,K-1:K+1) - ! around Cartesian cell I,J,K of type CC_CUTCFE: - DO KNGH=K-1,K+1 - IF ( (KNGH < 1) .OR. (KNGH > M%KBAR) ) CYCLE - DO JNGH=J-1,J+1 - IF ( (JNGH < 1) .OR. (JNGH > M%JBAR) ) CYCLE - DO INGH=I-1,I+1 - ! Either not GASPHASE or already counted: - IF ((M%CCVAR(INGH,JNGH,KNGH,CC_CGSC)/=CC_GASPHASE) .OR. (M%CCVAR(INGH,JNGH,KNGH,CC_UNKZ)>0)) CYCLE - IF ( (INGH < 1) .OR. (INGH > M%IBAR) ) CYCLE - IF (M%CELL(CELL_INDEX(INGH,JNGH,KNGH))%SOLID) CYCLE - M%CCVAR(INGH,JNGH,KNGH,CC_UNKZ) = 1 - ENDDO - ENDDO - ENDDO +IF(ALLOCATED(VOLUS)) DEALLOCATE(VOLUS) +IF(ALLOCATED(FACES)) DEALLOCATE(FACES) +IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) +IF(ALLOCATED(VERTS)) DEALLOCATE(VERTS) +IF(ALLOCATED(ZVALS)) DEALLOCATE(ZVALS) +IF(ALLOCATED(TFACES))DEALLOCATE(TFACES) - ENDDO - ENDDO -ENDDO +DEALLOCATE(GEOM_LINE) -! Now link small cells to surrounding cells in the mesh: -! NOTE: This scheme links two unknowns local to the mesh, therefore parallel consistency is not maintained. -! 1. Try linking them to adjacent regular cell with UNKZ > 0. Attempt going in surface normal direction first. -! 2. Try linking to adjacent cut-cell with UNKZ > 0. Attempt going in surface normal direction first. -! 3. If cut-cell could not be linked after N_LINK_ATTMP, block it. -LINK_ITER = 0; LINK_LEV_UP = 0 -LINK_LOOP : DO ! Cut-cell linking loop for small cells. -> Algo defined by CCVOL_LINK. - QUITLINK_FLG = .TRUE. +IF( (T_END-T_BEGIN) < TWENTY_EPSILON_EB) RETURN - IF (LINK_ITER==0) THEN - ICC_LOOP_1 : DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) +CC_IBM = .TRUE. - JCC_LOOP_1 : DO JCC=1,CC%NCELL - IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE - CRTCELL_FLG = .FALSE. - VAL_UNKZ = CC_UNDEFINED - VAL_CVOL = CCVOL_THRES - ! Find area averaged body surface normal: - NRML(IAXIS:KAXIS) = 0._EB; AREA = 0._EB - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE - IFC2 = CC%FACE_LIST(4,IFACE) - IFACE2 = CC%FACE_LIST(5,IFACE) - IBOD = M%CUT_FACE(IFC2)%BODTRI(1,IFACE2) - IWSEL = M%CUT_FACE(IFC2)%BODTRI(2,IFACE2) - AF = M%CUT_FACE(IFC2)%AREA( IFACE2) - NRML(IAXIS:KAXIS) = NRML(IAXIS:KAXIS) + GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL)*AF - AREA = AREA + AF - ENDDO +! If unstructured projection defined set Pressure solver on unstructured grid. +IF (PRES_FLAG/=UGLMAT_FLAG) THEN + PRES_METHOD = 'ULMAT' + PRES_FLAG = ULMAT_FLAG +ENDIF +PRES_ON_WHOLE_DOMAIN = .FALSE. +IF (ABS(CCVOL_LINK-0.95_EB) TWENTY_EPSILON_EB) THEN - NRML = NRML / AREA ! Normalize unit vector: - ! Normalize NRML vector to LINK_DIGITS: - DO DUM=IAXIS,KAXIS - NRML(DUM) = REAL(INT(LINK_FCT*NRML(DUM)),EB)/LINK_FCT - ENDDO - MASK(IAXIS:KAXIS) = .TRUE. - INRM(1) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(1))=.FALSE. - INRM(2) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(2))=.FALSE. - INRM(3) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1) - AXIS_LOOP_1 : DO DUM=IAXIS,KAXIS - X1AXIS=INRM(DUM) - IFC_LOOP_1 : DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND - IF( (X1AXIS /= CC%FACE_LIST(3,IFACE)) .OR. & - (CC%FACE_LIST(1,IFACE) /= CC_FTYPE_RCGAS) .OR. & - (ILH /= INT(SIGN(1._EB,NRML(X1AXIS)))) ) CYCLE IFC_LOOP_1 - SELECT CASE(X1AXIS) - CASE(IAXIS) - I_LNK = I+ILH; J_LNK = J; K_LNK = K - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - CASE(JAXIS) - I_LNK = I; J_LNK = J+ILH; K_LNK = K - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - CASE(KAXIS) - I_LNK = I; J_LNK = J; K_LNK = K+ILH - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - END SELECT - IF ( CRTCELL_FLG ) EXIT AXIS_LOOP_1 - ENDDO IFC_LOOP_1 - ENDDO AXIS_LOOP_1 - ENDIF AREA_IF_1 +CONTAINS - ! If not successful try any Regular Gasphase face. - ! Small cells, get CC_UNKZ from a large cell neighbor: - IF (.NOT. CRTCELL_FLG) THEN - IFC_LOOP_2 : DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - ILH = 2*CC%FACE_LIST(2,IFACE) - 3 - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE IFC_LOOP_2 - X1AXIS = CC%FACE_LIST(3,IFACE) - SELECT CASE(X1AXIS) - CASE(IAXIS) - I_LNK = I+ILH; J_LNK = J; K_LNK = K - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - CASE(JAXIS) - I_LNK = I; J_LNK = J+ILH; K_LNK = K - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - CASE(KAXIS) - I_LNK = I; J_LNK = J; K_LNK = K+ILH - IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell - VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) - CRTCELL_FLG = .TRUE. - ENDIF - END SELECT - IF ( CRTCELL_FLG ) EXIT IFC_LOOP_2 - ENDDO IFC_LOOP_2 - ENDIF - IF (VAL_UNKZ>0) THEN - CC%FACE_LIST(6,IFACE) = INTEGER_ONE ! This face is shared with master. - CC%UNKZ(JCC) = VAL_UNKZ !(/ Cell Type, I, J, K, JCC_LNK /) - CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_GASPHASE, I_LNK, J_LNK, K_LNK, 0 /) - CC%LINK_LEV(JCC) = -1 ! One link hierarchy level below regular cells (at LNK_LEV=0). - ENDIF - ENDDO JCC_LOOP_1 - ENDDO ICC_LOOP_1 - ENDIF +SUBROUTINE DEFINE_EXTRUDED_POLY(MAX_VERTS,N_VERTS,VERTS,MAX_POLY_VERTS,N_POLY_VERTS,POLY,& + EXTRUDE,MAX_FACES,N_FACES,START_FACE_LO,START_FACE_HI,START_FACE_MID,FACES,IERR) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +INTEGER, INTENT(IN) :: MAX_VERTS, MAX_POLY_VERTS, N_POLY_VERTS, POLY(MAX_POLY_VERTS), MAX_FACES +REAL(EB),INTENT(IN) :: EXTRUDE +INTEGER, INTENT(INOUT) :: N_VERTS +REAL(EB),INTENT(INOUT) :: VERTS(3*MAX_VERTS) +INTEGER, INTENT(OUT) :: N_FACES,START_FACE_LO,START_FACE_HI,START_FACE_MID,FACES(4*MAX_FACES),IERR - ! Then attempt to connect to large cut-cells, or already connected small cells (CUT_CELL(ICC)%UNKZ(JCC) > 0): - ICC_LOOP_2 : DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) +! Local Variables: +REAL(EB), ALLOCATABLE, DIMENSION(:) :: PVERTS,PVERTS2 +REAL(EB):: XYZCEN(IAXIS:KAXIS), NVEC(IAXIS:KAXIS), DV1(IAXIS:KAXIS), DV2(IAXIS:KAXIS), N(IAXIS:KAXIS), SINANG +LOGICAL :: IS_CONVEX, VERT_DROPPED, NOPT_INTRI +INTEGER :: IM1, IP1, NVERTS2, V0, V1, V2, COUNT, COUNT_OUT, NLIST, NLIST_OLD, VERT_START, IVERT, IVM1, IV, IVP1, & + I1, I2, I3, I4, IDUM, IFACE, JP1, JEND, INT_FLG +INTEGER, ALLOCATABLE, DIMENSION(:) :: NODE_FLG, VERT_LIST +LOGICAL, ALLOCATABLE, DIMENSION(:) :: NODE_EXISTS +REAL(EB):: BBLEN, THLEN, MINMAX_POS(LOW_IND:HIGH_IND,IAXIS:KAXIS), P1(IAXIS:JAXIS), D1(IAXIS:JAXIS), & + P2(IAXIS:JAXIS), D2(IAXIS:JAXIS), SVEC(IAXIS:KAXIS), PVEC(IAXIS:KAXIS), SVARV(NOD1:NOD2,EDG1:EDG2), SLENV(EDG1:EDG2) - JCC_LOOP_2 : DO JCC=1,CC%NCELL - IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE - VAL_UNKZ = CC_UNDEFINED - VAL_CVOL = -GEOMEPS +IERR = 1 - ! Find area averaged body surface normal: - NRML(IAXIS:KAXIS) = 0._EB; AREA = 0._EB - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE - IFC2 = CC%FACE_LIST(4,IFACE) - IFACE2 = CC%FACE_LIST(5,IFACE) - IBOD = M%CUT_FACE(IFC2)%BODTRI(1,IFACE2) - IWSEL = M%CUT_FACE(IFC2)%BODTRI(2,IFACE2) - AF = M%CUT_FACE(IFC2)%AREA( IFACE2) - NRML(IAXIS:KAXIS) = NRML(IAXIS:KAXIS) + GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL)*AF - AREA = AREA + AF - ENDDO +! Define PVERTS: +ALLOCATE(PVERTS(1:2*MAX_DIM*N_POLY_VERTS)); PVERTS=0._EB +MINMAX_POS( LOW_IND,IAXIS:KAXIS) = 1._EB/GEOMEPS +MINMAX_POS(HIGH_IND,IAXIS:KAXIS) =-1._EB/GEOMEPS +DO I=1,N_POLY_VERTS + PVERTS(3*I-2:3*I) = VERTS(3*POLY(I)-2:3*POLY(I)) + MINMAX_POS( LOW_IND,IAXIS) = MIN(MINMAX_POS( LOW_IND,IAXIS),PVERTS(3*I-2)) + MINMAX_POS( LOW_IND,JAXIS) = MIN(MINMAX_POS( LOW_IND,JAXIS),PVERTS(3*I-1)) + MINMAX_POS( LOW_IND,KAXIS) = MIN(MINMAX_POS( LOW_IND,KAXIS),PVERTS(3*I )) + MINMAX_POS(HIGH_IND,IAXIS) = MAX(MINMAX_POS(HIGH_IND,IAXIS),PVERTS(3*I-2)) + MINMAX_POS(HIGH_IND,JAXIS) = MAX(MINMAX_POS(HIGH_IND,JAXIS),PVERTS(3*I-1)) + MINMAX_POS(HIGH_IND,KAXIS) = MAX(MINMAX_POS(HIGH_IND,KAXIS),PVERTS(3*I )) +ENDDO +PVERTS(3*(N_POLY_VERTS+1)-2:3*(N_POLY_VERTS+1)) = PVERTS(1:3) +! Define average normal: +XYZCEN(IAXIS:KAXIS)=0._EB +DO I=1,N_POLY_VERTS + XYZCEN(IAXIS:KAXIS) = XYZCEN(IAXIS:KAXIS) + PVERTS(3*I-2:3*I) +ENDDO +XYZCEN = XYZCEN / REAL(N_POLY_VERTS,EB) +! Define an area averaged normal vector (note: this might need to change to average normal to the set of points in a +! least squares sense, i.e. eigenvector associated with smallest eigenvalue of the covariance matrix of vertices positions +! respect to XYZCEN): +NVEC(IAXIS:KAXIS)=0._EB +DO I=1,N_POLY_VERTS + DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - XYZCEN(IAXIS:KAXIS) + DV2(IAXIS:KAXIS) = PVERTS(3*I+1:3*(I+1)) - XYZCEN(IAXIS:KAXIS) + CALL CROSS_PRODUCT(N,DV1,DV2) + NVEC(IAXIS:KAXIS) = NVEC(IAXIS:KAXIS) + N(IAXIS:KAXIS) +ENDDO +IF(NORM2(NVEC) > TWENTY_EPSILON_EB) NVEC=NVEC/NORM2(NVEC) - AREA_IF_2 : IF (AREA > TWENTY_EPSILON_EB) THEN - NRML = NRML / AREA ! Normalize unit vector: - ! Normalize NRML vector to LINK_DIGITS: - DO DUM=IAXIS,KAXIS - NRML(DUM) = REAL(INT(LINK_FCT*NRML(DUM)),EB)/LINK_FCT - ENDDO - MASK(IAXIS:KAXIS) = .TRUE. - INRM(1) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(1))=.FALSE. - INRM(2) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(2))=.FALSE. - INRM(3) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1) - AXIS_LOOP_2 : DO DUM=IAXIS,KAXIS - X1AXIS=INRM(DUM) - IFC_LOOP_3 : DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - IF((CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB) .OR. & - (CC%FACE_LIST(1,IFACE)==CC_FTYPE_SVERT)) CYCLE IFC_LOOP_3 - ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND - IF( (X1AXIS /= CC%FACE_LIST(3,IFACE)) .OR. & - (ILH /= INT(SIGN(1._EB,NRML(X1AXIS)))) ) CYCLE IFC_LOOP_3 - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF( (I+ILH < 1) .OR. (I+ILH > M%IBAR) ) CYCLE IFC_LOOP_3 ! Drop if outside the mesh. - CASE(JAXIS) - IF( (J+ILH < 1) .OR. (J+ILH > M%JBAR) ) CYCLE IFC_LOOP_3 - CASE(KAXIS) - IF( (K+ILH < 1) .OR. (K+ILH > M%KBAR) ) CYCLE IFC_LOOP_3 - END SELECT - SELECT CASE(CC%FACE_LIST(1,IFACE)) ! 1. Check if a surrounding cell is a regular cell: - CASE(CC_FTYPE_RCGAS) ! REGULAR GASPHASE - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(M%CCVAR(I+ILH,J,K,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I+ILH,J,K,ICC2,JCC2) - IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 - IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 - I_LNK = I+ILH; J_LNK = J; K_LNK = K; JCC_LNK = JCC2 - VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); - EXIT AXIS_LOOP_2 - ENDIF - CASE(JAXIS) - IF(M%CCVAR(I,J+ILH,K,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I,J+ILH,K,ICC2,JCC2) - IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 - IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 - I_LNK = I; J_LNK = J+ILH; K_LNK = K; JCC_LNK = JCC2 - VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); - EXIT AXIS_LOOP_2 - ENDIF - CASE(KAXIS) - IF(M%CCVAR(I,J,K+ILH,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I,J,K+ILH,ICC2,JCC2) - IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 - IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 - I_LNK = I; J_LNK = J; K_LNK = K+ILH; JCC_LNK = JCC2 - VAL_UNKZ=M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); - EXIT AXIS_LOOP_2 - ENDIF - END SELECT - CASE(CC_FTYPE_CFGAS) ! 2. Check for large surrounding cut-cells: - IFC2 = CC%FACE_LIST(4,IFACE) - IFACE2 = CC%FACE_LIST(5,IFACE) - ICC2 = M%CUT_FACE(IFC2)%CELL_LIST(2,CC%FACE_LIST(2,IFACE),IFACE2) - JCC2 = M%CUT_FACE(IFC2)%CELL_LIST(3,CC%FACE_LIST(2,IFACE),IFACE2) - IF (M%CUT_CELL(ICC2)%UNKZ(JCC2)<1) CYCLE IFC_LOOP_3 - IF (M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 - I_LNK = M%CUT_CELL(ICC2)%IJK(IAXIS); J_LNK = M%CUT_CELL(ICC2)%IJK(JAXIS); - K_LNK = M%CUT_CELL(ICC2)%IJK(KAXIS); JCC_LNK = JCC2 - VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); EXIT AXIS_LOOP_2 - END SELECT - ENDDO IFC_LOOP_3 - ENDDO AXIS_LOOP_2 - IF (VAL_UNKZ > 0) THEN - CC%FACE_LIST(6,IFACE) = INTEGER_ONE ! This face is shared with master. - CC%UNKZ(JCC) = VAL_UNKZ - CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I_LNK, J_LNK, K_LNK, JCC_LNK /) - CC%LINK_LEV(JCC) = LNK_LEV-1 ! One link hierarchy level below master cell. - CYCLE JCC_LOOP_2 - ENDIF - ENDIF AREA_IF_2 - - ! Small cells, get CC_UNKZ from a large cell neighbor: - IFACE3 = CC_UNDEFINED - IFC_LOOP_4 : DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - IF((CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB) .OR. & - (CC%FACE_LIST(1,IFACE)==CC_FTYPE_SVERT)) CYCLE IFC_LOOP_4 - ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND +! Test all segments are in plane normal to NVEC, tolerance for distance to plane given by XYZCEN, NVEC is +! 5% of the bounding box diagonal for the polygon: +BBLEN = SQRT( (MINMAX_POS(HIGH_IND,IAXIS)-MINMAX_POS( LOW_IND,IAXIS))**2._EB + & + (MINMAX_POS(HIGH_IND,JAXIS)-MINMAX_POS( LOW_IND,JAXIS))**2._EB + & + (MINMAX_POS(HIGH_IND,KAXIS)-MINMAX_POS( LOW_IND,KAXIS))**2._EB ) +THLEN = 0.05_EB * BBLEN ! Threshold distance to polygon average plane. +DO I=1,N_POLY_VERTS + DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - XYZCEN(IAXIS:KAXIS) + IF (ABS(DOT_PRODUCT(DV1,NVEC)) > THLEN) THEN + WRITE(MESSAGE,'(A,A,A,I3,A)') 'ERROR(721): For extruded Polygon GEOM ',TRIM(ID),& + ' : Node (',POLY(I),') not in the plane of the polygon. Check VERTS.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF +ENDDO - ! Cycle if surrounding cell is located in the guard-cell region, if so drop, as we don't have - ! at this point unknown numbers on guard-cells/guard-cell ccs: - X1AXIS = CC%FACE_LIST(3,IFACE) - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF( (I+ILH < 1) .OR. (I+ILH > M%IBAR) ) CYCLE IFC_LOOP_4 - CASE(JAXIS) - IF( (J+ILH < 1) .OR. (J+ILH > M%JBAR) ) CYCLE IFC_LOOP_4 - CASE(KAXIS) - IF( (K+ILH < 1) .OR. (K+ILH > M%KBAR) ) CYCLE IFC_LOOP_4 - END SELECT +! Here project all points to average plane. Do seg-seg intersection tests: +DO I=1,N_POLY_VERTS + DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I)-XYZCEN(IAXIS:KAXIS) + DV2(IAXIS:KAXIS) = DV1(IAXIS:KAXIS) - DOT_PRODUCT(DV1,NVEC) * NVEC(IAXIS:KAXIS) + PVERTS(3*(I+N_POLY_VERTS)-2:3*(I+N_POLY_VERTS)) = XYZCEN(IAXIS:KAXIS) + DV2(IAXIS:KAXIS) +ENDDO +! Define local coordinate system SVEC,PVEC,NVEC: +IF(ABS(NVEC(IAXIS))>TWENTY_EPSILON_EB .OR. ABS(NVEC(JAXIS))>TWENTY_EPSILON_EB) PVEC(IAXIS:KAXIS)=(/NVEC(JAXIS),-NVEC(IAXIS),0._EB/) +IF(ABS(NVEC(IAXIS))0) THEN + WRITE(MESSAGE,'(A,I3,A,I3,A,I3,A,I3,A)') 'ERROR(722): Segments (',POLY(I-N_POLY_VERTS),'-',POLY(IP1-N_POLY_VERTS),& + ') and (',POLY(J-N_POLY_VERTS),'-',POLY(JP1-N_POLY_VERTS),') intersect in average POLY plane.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + ENDDO +ENDDO - SELECT CASE(CC%FACE_LIST(1,IFACE)) ! 1. Check if a surrounding cell is a regular cell: - CASE(CC_FTYPE_RCGAS) ! REGULAR GASPHASE - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(M%CCVAR(I+ILH,J,K,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I+ILH,J,K,ICC2,JCC2) - IF(ANY((/ ICC2, JCC2 /) == 0)) CYCLE IFC_LOOP_4 - IF(M%CUT_CELL(ICC2)%VOLUME(JCC2) 0) THEN - CC%FACE_LIST(6,IFACE3) = INTEGER_ONE ! This face is shared with master. - CC%UNKZ(JCC) = VAL_UNKZ - CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I_LNK, J_LNK, K_LNK, JCC_LNK /) - CC%LINK_LEV(JCC) = LNK_LEV-1 ! One link hierarchy level below master cell. - ELSE - QUITLINK_FLG = .FALSE. - ENDIF - ENDDO JCC_LOOP_2 - ENDDO ICC_LOOP_2 +IS_CONVEX=.TRUE. +ALLOCATE(NODE_FLG(1:N_POLY_VERTS+1)); NODE_FLG=1 +DO I=1,N_POLY_VERTS + IM1 = I - 1 + IF (I==1) IM1=N_POLY_VERTS + IP1 = I + 1 + IF (I==N_POLY_VERTS) IP1=1 + DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - PVERTS(3*IM1-2:3*IM1 ); DV1=DV1/NORM2(DV1) + DV2(IAXIS:KAXIS) = PVERTS(3*IP1-2:3*IP1) - PVERTS(3*I-2:3*I ); DV2=DV2/NORM2(DV2) + CALL CROSS_PRODUCT(N,DV1,DV2) + SINANG = NORM2(N) + IF ( DOT_PRODUCT(NVEC,N) < -GEOMEPS ) IS_CONVEX=.FALSE. + IF ( SINANG < GEOMEPS ) NODE_FLG(I)= 0 ! Vertex located in line joining neighbors. +ENDDO - ! Then fuse cut-cell unknowns if several ccs in one Cartesian cell and one of them has CUT_CELL(ICC)%UNKZ(JCC)>0: - ! IF(.NOT. ONE_UNKH_PER_CUTCELL) THEN - ! DO ICC=1,M%N_CUTCELL_MESH - ! CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - ! ! Don't attempt to link cut-cells inside an OBST: - ! IF ( M%CELL(M%CELL_INDEX(I,J,K))%SOLID ) CYCLE - ! ! Cases with more than one cut-cell: define UNKZ of all cells to be the one of first cut-cell with UNKZ > 0: - ! DO JCC=1,CC%NCELL; IF(CC%UNKZ(JCC)>0) EXIT; ENDDO - ! JCC_LNK = JCC - ! IF (JCC_LNK <= CC%NCELL) THEN - ! DO JCC=1,CC%NCELL - ! IF ( CC%NOADVANCE(JCC)>0 .OR. JCC==JCC_LNK ) CYCLE - ! CC%UNKZ(JCC) = CC%UNKZ(JCC_LNK) - ! CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I, J, K, JCC_LNK /) - ! CC%LINK_LEV(JCC) = CC%LINK_LEV(JCC_LNK) - 1 - ! ENDDO - ! ENDIF - ! ENDDO - ! ENDIF +NVERTS2 = SUM(NODE_FLG(1:N_POLY_VERTS)); +IF (NVERTS2 < 3) THEN + WRITE(MESSAGE,'(A,A,A)') 'ERROR(723): For extruded Polygon GEOM ',TRIM(ID),' : Not enough valid vertices on the polygon.' + CALL SHUTDOWN(MESSAGE); RETURN +ENDIF +ALLOCATE(PVERTS2(1:2*MAX_DIM*N_POLY_VERTS)); PVERTS2=0._EB +ALLOCATE(VERT_LIST(NVERTS2+1)); VERT_LIST=0 +ALLOCATE(NODE_EXISTS(NVERTS2+1)); NODE_EXISTS=.TRUE. +COUNT = 0 +DO I=1,N_POLY_VERTS + IF (NODE_FLG(I)==0) CYCLE + COUNT= COUNT + 1 + PVERTS2(3*COUNT-2:3*COUNT) = PVERTS(3*I-2:3*I) + VERT_LIST(COUNT) = COUNT +ENDDO +PVERTS(1:3*NVERTS2) = PVERTS2(1:3*NVERTS2) +VERT_LIST(NVERTS2+1) = VERT_LIST(1) +DEALLOCATE(PVERTS2) - IF (QUITLINK_FLG) EXIT LINK_LOOP - LINK_LEV_UP = LINK_LEV_UP - 1 - - LINK_ITER = LINK_ITER + 1 - BLOCK_CELL_IF : IF (LINK_ITER > N_LINK_ATTMP) THEN - ! Count how many unlinked cells we have in this mesh: - ULINK_COUNT = 0 - DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - DO JCC=1,CC%NCELL - IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE - ULINK_COUNT = ULINK_COUNT + 1 - ENDDO - ENDDO - - IF (GET_CUTCELLS_VERBOSE) THEN - ! Write out unlinked cells properties: - ! Open file to write unlinked cells: - WRITE(UNLINKED_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_unlinked_',MY_RANK,'.log' - ! Create file: - IF (UNLINKED_1ST_CALL) THEN - LU_UNLNK = GET_FILE_NUMBER() - OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='UNKNOWN') - WRITE(LU_UNLNK,*) 'Unlinked cut-cell Information for Process=',MY_RANK - CLOSE(LU_UNLNK) - UNLINKED_1ST_CALL = .FALSE. - ENDIF - ! Open file to write unlinked cell information: - OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='OLD',POSITION='APPEND') - WRITE(LU_UNLNK,*) ' ' - WRITE(LU_UNLNK,'(A,I4,A,I4)') ' Mesh NM=',NM,', number of unlinked cells=',ULINK_COUNT +! Now do the Ear clip: +N_FACES = 0 +START_FACE_LO = N_FACES +IS_CONVEX_IF : IF (IS_CONVEX) THEN ! Convex POLY. + VERT_START = VERT_LIST(1) + DO I = 1,NVERTS2 + IP1 = I+1; IF (I==NVERTS2) IP1=1 + IF (I==VERT_START .OR. IP1==VERT_START) CYCLE + N_FACES = N_FACES + 1 + FACES(3*N_FACES-2) = VERT_LIST(VERT_START) + FACES(3*N_FACES-1) = VERT_LIST(I) + FACES(3*N_FACES ) = VERT_LIST(IP1) + ENDDO +ELSE IS_CONVEX_IF ! Simple polygon, ear clipping. + NLIST = NVERTS2 + COUNT_OUT = 0 + OUTER_LOOP : DO WHILE(NLIST>=3) ! OUTER LOOP + COUNT_OUT = COUNT_OUT + 1 + IF (COUNT_OUT > NVERTS2**4) THEN + WRITE(MESSAGE,'(A,A,A)') 'ERROR(724): For extruded Polygon GEOM ',TRIM(ID),' : Could not triangulate polygon.' + CALL SHUTDOWN(MESSAGE); RETURN + ENDIF + IVERT = 1 + INNER_LOOP : DO WHILE(IVERT<=NLIST) ! INNER LOOP + IVM1 = IVERT-1; IV=IVERT; IVP1=IVERT+1 + IF (IVERT==1) IVM1=NLIST + V0 = VERT_LIST(IVM1); V1 = VERT_LIST(IV ); V2 = VERT_LIST(IVP1); + IF (.NOT.NODE_EXISTS(IVP1)) EXIT INNER_LOOP + DV1(IAXIS:KAXIS) = PVERTS(3*V1-2:3*V1)-PVERTS(3*V0-2:3*V0) + IF (NORM2(DV1)GEOMEPS + IF (NOPT_INTRI) THEN + DO I=1,NVERTS2 + IF(ANY( (/V0,V1,V2/) == I)) CYCLE + IF (POINT_IN_TRIANGLE(PVERTS(3*I-2:3*I), PVERTS(3*V0-2:3*V0), PVERTS(3*V1-2:3*V1), PVERTS(3*V2-2:3*V2))) THEN + NOPT_INTRI=.FALSE. + EXIT + ENDIF + ENDDO + ENDIF + IF ( NLIST==3 .OR. NOPT_INTRI ) THEN + N_FACES = N_FACES + 1 + FACES(3*N_FACES-2) = V0 + FACES(3*N_FACES-1) = V1 + FACES(3*N_FACES ) = V2 + IF (NLIST == 3) EXIT OUTER_LOOP + NODE_EXISTS(IVERT) =.FALSE. + IF (IVERT==1) NODE_EXISTS(NLIST+1)=.FALSE. + IVERT = IVERT + 2 + ELSE + IVERT = IVERT + 1 + ENDIF + ENDDO INNER_LOOP + NLIST_OLD = NLIST + NLIST = 0 + DO I = 1,NLIST_OLD + IF (NODE_EXISTS(I)) THEN + NLIST = NLIST + 1 + VERT_LIST(NLIST) = VERT_LIST(I) + ENDIF + ENDDO + VERT_LIST(NLIST+1) = VERT_LIST(1) + NODE_EXISTS(1:NLIST+1) =.TRUE. - ! Dump info: - ULINK_COUNT = 0 - DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - DO JCC=1,CC%NCELL - IF (CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0) CYCLE - ULINK_COUNT = ULINK_COUNT + 1 - WRITE(LU_UNLNK,'(I8,A,5I8,A,5F22.8)') & - ULINK_COUNT,', I,J,K,ICC,JCC=',I,J,K,ICC,JCC,', X,Y,Z,CCVOL,CCVOL_CRT=',M%X(I),M%Y(J),M%Z(K), & - CC%VOLUME(JCC),M%DX(I)*M%DY(J)*M%DZ(K) + ! Test for nodes connecting parallel edges, if found drop them: + VERT_DROPPED=.FALSE. + DO I=1,NLIST + IVM1 = I-1; IV=I; IVP1=I+1; IF (I==1) IVM1=NLIST + V0 = VERT_LIST(IVM1); V1 = VERT_LIST(IV ); V2 = VERT_LIST(IVP1) + DV1(IAXIS:KAXIS) = PVERTS(3*V1-2:3*V1)-PVERTS(3*V0-2:3*V0) + IF (NORM2(DV1) CCVAR(I,J,K,CC_CGSC) is set to CC_SOLID. - DO ICC=1,M%N_CUTCELL_MESH - DO JCC=1,M%CUT_CELL(ICC)%NCELL - IF ( M%CUT_CELL(ICC)%UNKZ(JCC) > 0 ) CYCLE - M%CUT_CELL(ICC)%IJK_LINK(1,JCC) = CC_SOLID ! Flag for Blocking after main mesh loop in SET_CUTCELLS_3D - ENDDO - ENDDO + VERT_LIST(NLIST+1) = VERT_LIST(1) + NODE_EXISTS(1:NLIST+1)=.TRUE. + ENDIF + ENDDO OUTER_LOOP +ENDIF IS_CONVEX_IF - ! Recount unlinked cells (i.e. no other viable cells in the mesh). - ULINK_COUNT = 0 - DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - DO JCC=1,CC%NCELL - IF ( CC%UNKZ(JCC) > 0 .OR. CC%IJK_LINK(1,JCC)==CC_SOLID) CYCLE - ULINK_COUNT = ULINK_COUNT + 1 - ENDDO - ENDDO +! Add top faces and Revert lo faces normal: +START_FACE_HI = N_FACES +DO IFACE=1,N_FACES + FACES(3*(START_FACE_HI+IFACE)-2:3*(START_FACE_HI+IFACE)) = FACES(3*IFACE-2:3*IFACE) + NVERTS2 + IDUM=FACES(3*IFACE-1); FACES(3*IFACE-1)=FACES(3*IFACE); FACES(3*IFACE)=IDUM +ENDDO +N_FACES = 2*N_FACES - IF (GET_CUTCELLS_VERBOSE) THEN - ! Write out remaining unlinked cells properties. - ! Open file to write unlinked cell information: - OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='OLD',POSITION='APPEND') - WRITE(LU_UNLNK,*) ' ' - WRITE(LU_UNLNK,*) 'STATUS AFTER BLOCKING SMALL UNLINKED CUT-CELLS:' - WRITE(LU_UNLNK,'(A,I4,A,I4)') ' Mesh NM=',NM,', number of unlinked cells after blocking=',ULINK_COUNT - IF(ULINK_COUNT > 0) THEN - ! Dump info: - ULINK_COUNT = 0 - DO ICC=1,M%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE - DO JCC=1,CC%NCELL - IF (CC%UNKZ(JCC)>0) CYCLE - ULINK_COUNT = ULINK_COUNT + 1 - WRITE(LU_UNLNK,'(I8,A,5I8,A,5F22.8)') & - ULINK_COUNT,', I,J,K,ICC,JCC=',I,J,K,ICC,JCC,', X,Y,Z,CCVOL,CCVOL_CRT=',M%X(I),M%Y(J),M%Z(K), & - CC%VOLUME(JCC),M%DX(I)*M%DY(J)*M%DZ(K) - ENDDO - ENDDO - ENDIF - CLOSE(LU_UNLNK) - ENDIF - EXIT LINK_LOOP - ENDIF BLOCK_CELL_IF -ENDDO LINK_LOOP +! Now replicate Vertices at a distance EXTRUDE in the normal direction. +N_VERTS = 2*NVERTS2 +VERTS(1:3*NVERTS2) = PVERTS(1:3*NVERTS2) +DO I=1,NVERTS2 + VERTS(3*(I+NVERTS2)-2:3*(I+NVERTS2)) = PVERTS(3*I-2:3*I) + EXTRUDE*NVEC(IAXIS:KAXIS) +ENDDO -! Finally compute M%FINEST_LINK_LEV: -DO ICC=1,M%N_CUTCELL_MESH - DO JCC=1,M%CUT_CELL(ICC)%NCELL - IF(M%CUT_CELL(ICC)%IJK_LINK(1,JCC)==CC_SOLID) THEN - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)==NOT_BLOCKED) M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCKED_UNLINK_CELL - M%CUT_CELL(ICC)%LINK_LEV(JCC) = CC_UNDEFINED - M%CUT_CELL(ICC)%IJK_LINK(2:5,JCC)= CC_UNDEFINED - ELSEIF(M%CUT_CELL(ICC)%LINK_LEV(JCC) < M%FINEST_LINK_LEV) THEN - M%FINEST_LINK_LEV = M%CUT_CELL(ICC)%LINK_LEV(JCC) - ENDIF - ENDDO +! Add side faces: +START_FACE_MID=N_FACES +DO IVERT=1,NVERTS2 + I1 = IVERT; I2 = IVERT+1; I3 = IVERT+NVERTS2; I4 = IVERT+NVERTS2+1 + IF (IVERT==NVERTS2) THEN + I2 = 1; I4 = 1+NVERTS2 + ENDIF + N_FACES = N_FACES + 1 + FACES(3*N_FACES-2:3*N_FACES) = (/ I1, I2, I4 /) + N_FACES = N_FACES + 1 + FACES(3*N_FACES-2:3*N_FACES) = (/ I1, I4, I3 /) ENDDO -RETURN +! Revert Faces order if EXTRUDE -ve: +IF (EXTRUDE < 0) THEN + DO IFACE=1,N_FACES + IDUM=FACES(3*IFACE-1); FACES(3*IFACE-1)=FACES(3*IFACE); FACES(3*IFACE)=IDUM + ENDDO +ENDIF -CONTAINS +DEALLOCATE(PVERTS,NODE_FLG,VERT_LIST,NODE_EXISTS) -SUBROUTINE GET_ICC2_JCC2(ICC,IFACE,INXT,JNXT,KNXT,ICC2,JCC2) -INTEGER, INTENT(IN) :: ICC,IFACE,INXT,JNXT,KNXT -INTEGER, INTENT(OUT):: ICC2, JCC2 +IERR = 0 -INTEGER :: IFC, IFACE2 -TYPE(CC_CUTCELL_TYPE), POINTER :: CC2 -ICC2=M%CCVAR(INXT,JNXT,KNXT,CC_IDCC); IF (ICC2<=0) RETURN -CC2 => M%CUT_CELL(ICC2) -DO JCC2=1,CC2%NCELL - ! Loop faces and test: - DO IFC=1,CC2%CCELEM(1,JCC2) - IFACE2 = CC2%CCELEM(IFC+1,JCC2) - ! If face type in face_list is not CC_FTYPE_RCGAS, drop: - IF(CC2%FACE_LIST(1,IFACE2) /= CC_FTYPE_RCGAS) CYCLE - ! Does X1AXIS match and LOWHIGH are different? - IF( CC2%FACE_LIST(3,IFACE2) /= M%CUT_CELL(ICC)%FACE_LIST(3,IFACE)) CYCLE ! X1AXIS is different. - IF(ABS(CC2%FACE_LIST(2,IFACE2) - M%CUT_CELL(ICC)%FACE_LIST(2,IFACE)) < 1) CYCLE ! Same LOWHIGH. - ! Found the cut-cell ICC2,JCC2 on the other side of IFACE for cut-cell ICC,JCC. - RETURN - ENDDO -ENDDO -JCC2=0 RETURN -END SUBROUTINE GET_ICC2_JCC2 - -END SUBROUTINE GET_CELL_LINK_INFO +END SUBROUTINE DEFINE_EXTRUDED_POLY -! --------------------- BLOCK_CC_SOLID_EXTWALLCELLS ----------------------------- +SUBROUTINE DEFINE_CYLINDER(VERTS,MAXVERTS,NVERTS,FACES,MAXFACES,NFACES,VOLS,MAXVOLS,NVOLS,CYL_FIND) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -SUBROUTINE BLOCK_CC_SOLID_EXTWALLCELLS(FIRST_CALL) - -LOGICAL, INTENT(IN) :: FIRST_CALL - -! Local variables: -INTEGER :: NM,IW,IIF,JJF,KKF,II,JJ,KK,IOR,X1AXIS -TYPE (WALL_TYPE), POINTER :: WC - -MESH_LOOP : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - EXTERNAL_WALL_LOOP : DO IW=1,N_EXTERNAL_WALL_CELLS - WC=>WALL(IW) - BC=>BOUNDARY_COORD(WC%BC_INDEX) - IF (FIRST_CALL) THEN - IF (.NOT.(WC%BOUNDARY_TYPE==INTERPOLATED_BOUNDARY)) CYCLE EXTERNAL_WALL_LOOP - ELSE - ! Here we might need to add other EXT wall cell types. - IF (.NOT.(WC%BOUNDARY_TYPE==OPEN_BOUNDARY .OR. WC%BOUNDARY_TYPE==SOLID_BOUNDARY)) CYCLE EXTERNAL_WALL_LOOP - ENDIF - II = BC%II - JJ = BC%JJ - KK = BC%KK - IOR = BC%IOR - X1AXIS = ABS(IOR) - ! Define underlying Cartesian faces indexes: - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-IAXIS) ! Higher X boundary for Mesh NM. - IIF = II - 1; JJF = JJ ; KKF = KK - CASE( JAXIS) ! Lower Y boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-JAXIS) ! Higher Y boundary for Mesh NM. - IIF = II ; JJF = JJ - 1; KKF = KK - CASE( KAXIS) ! Lower Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-KAXIS) ! Higher Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - 1 - END SELECT - ! Change BOUNDARY_TYPE to null: - IF (FIRST_CALL) THEN - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) WC%BOUNDARY_TYPE = SOLID_BOUNDARY - ELSE - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) WC%BOUNDARY_TYPE = NULL_BOUNDARY - ENDIF - ENDDO EXTERNAL_WALL_LOOP -ENDDO MESH_LOOP - -RETURN -END SUBROUTINE BLOCK_CC_SOLID_EXTWALLCELLS +INTEGER, INTENT(IN) :: MAXVERTS,MAXFACES,MAXVOLS +INTEGER, INTENT(OUT) :: NFACES, NVERTS +REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) +INTEGER, INTENT(OUT) :: FACES(4*MAXFACES) +INTEGER, INTENT(OUT) :: NVOLS +INTEGER, INTENT(OUT) :: VOLS(4*MAXVOLS) +INTEGER, INTENT(OUT) :: CYL_FIND(LOW_IND:HIGH_IND,1:3) +! Local Variables: +REAL(EB), PARAMETER :: EX(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) +REAL(EB) :: E1(IAXIS:KAXIS), E2(IAXIS:KAXIS), E3(IAXIS:KAXIS), TGL(3,3), V(IAXIS:KAXIS,1), R(IAXIS:KAXIS,1) +INTEGER :: NP_L,NP_T,IVERT,IFACE,ILE,ITH,IFC +REAL(EB):: DELTA_L,DELTA_T,THETA,POS_1,POS_2,POS_3, LEN -! ----------------------- INIT_CFACE_CELL ----------------------------- -SUBROUTINE INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX,SURF_INDEX,STAGE_FLG,IS_INB,IW) -USE GEOMETRY_FUNCTIONS, ONLY : SEARCH_OTHER_MESHES -USE MEMORY_FUNCTIONS, ONLY: ALLOCATE_STORAGE -USE MATH_FUNCTIONS, ONLY : CROSS_PRODUCT +! Check if CYLINDER axis is any of IAXIS, JAXIS, KAXIS: +IF (ABS(CYLINDER_AXIS(JAXIS)) MESHES(NM) -SF=> SURFACE(SURF_INDEX) -CF=> CUT_FACE(ICF) +! Low plane center vertex: +POS_1 = -CYLINDER_LENGTH/2._EB +POS_2 = 0._EB; POS_3 = 0._EB; +IVERT = IVERT + 1 +VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) -STAGE_FLG_BRANCH : SELECT CASE(STAGE_FLG) +VERTEX_LOOP : DO ILE=1,NP_L + POS_1 = -CYLINDER_LENGTH/2._EB + REAL(ILE-1,EB)*DELTA_L + DO ITH=1,NP_T -CASE(INTEGER_ONE) ! Geometry information for CFACE. + THETA = REAL(ITH-1,EB)*DELTA_T + POS_2 = CYLINDER_RADIUS*COS(THETA) + POS_3 = CYLINDER_RADIUS*SIN(THETA) - CALL ALLOCATE_STORAGE(NM,SURF_INDEX=SURF_INDEX,CFACE_INDEX=CFACE_INDEX) + IVERT = IVERT + 1 + VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) - CFA => M%CFACE(CFACE_INDEX) - BC => M%BOUNDARY_COORD(CFA%BC_INDEX) - B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) + ENDDO +ENDDO VERTEX_LOOP - CFA%SURF_INDEX = SURF_INDEX - CFA%NODE_INDEX = SURFACE(SURF_INDEX)%NODE_INDEX - B1%NODE_INDEX = CFA%NODE_INDEX +! High plane center vertex: +POS_1 = CYLINDER_LENGTH/2._EB +POS_2 = 0._EB; POS_3 = 0._EB; +IVERT = IVERT + 1 +VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) - BC%X = CF%XYZCEN(IAXIS,IFACE) - BC%Y = CF%XYZCEN(JAXIS,IFACE) - BC%Z = CF%XYZCEN(KAXIS,IFACE) - CFA%AREA = CF%AREA(IFACE) +NVERTS = IVERT - ! Now populate cut-face information: - CFA%CUT_FACE_IND1 = ICF - CFA%CUT_FACE_IND2 = IFACE +! Define faces: +! Low axis plane: +IFACE=0 +IVERT=1 +CYL_FIND(LOW_IND,3) = IFACE + 1 +DO IFC=1,NP_T + IF (IFC < NP_T) THEN + I1 = 1 + IFC + 1 + I2 = 1 + IFC + I3 = IVERT + ELSE + I1 = IVERT + 1 + I2 = IFC + 1 + I3 = IVERT + ENDIF + IFACE=IFACE+1 + FACES(3*IFACE-2:3*IFACE) = (/I1, I2, I3 /) +ENDDO +CYL_FIND(HIGH_IND,3) = IFACE - INS_INB_COND_1 : IF (IS_INB) THEN - B1%VEL_ERR_NEW=CF%VEL(IFACE) - 0._EB ! Assumes zero velocity of solid. +! Cylinder side faces: +CYL_FIND(LOW_IND,2) = IFACE + 1 +FACE_LOOP : DO ILE=2,NP_L + DO IFC=1,NP_T - ! Normal to cut-face: - V2(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(2,IFACE))-CF%XYZCEN(IAXIS:KAXIS,IFACE) - V3(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(3,IFACE))-CF%XYZCEN(IAXIS:KAXIS,IFACE) - CALL CROSS_PRODUCT(BC%NVEC(IAXIS:KAXIS),V2,V3) - IF(NORM2(BC%NVEC)>TWENTY_EPSILON_EB .AND. CF%CFACE_ORIGIN(IFACE)==BLOCKED_SPLIT_CELL) THEN - BC%NVEC(IAXIS:KAXIS) = BC%NVEC(IAXIS:KAXIS)/NORM2(BC%NVEC) + ! Locate first vertex index: + IF (IFC < NP_T) THEN + I1 = (ILE-1)*NP_T + 1 + IFC + I2 = (ILE-1)*NP_T + 1 + IFC + 1 + I3 = (ILE-2)*NP_T + 1 + IFC + I4 = (ILE-2)*NP_T + 1 + IFC + 1 ELSE - IBOD =CF%BODTRI(1,IFACE) - IWSEL=CF%BODTRI(2,IFACE) - BC%NVEC(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) + I1 = (ILE-1)*NP_T + 1 + IFC + I2 = (ILE-1)*NP_T + 1 + 1 + I3 = (ILE-2)*NP_T + 1 + IFC + I4 = (ILE-2)*NP_T + 1 + 1 ENDIF - X1AXIS = MAXLOC(ABS(BC%NVEC(IAXIS:KAXIS)),DIM=1) - BC%IOR = INT(SIGN(1._EB,BC%NVEC(X1AXIS)))*X1AXIS - ! Boundary CFACES processed are defined of type SOLID_BOUNDARY - CFA%BOUNDARY_TYPE = SOLID_BOUNDARY + IFACE=IFACE+1 + FACES(3*IFACE-2:3*IFACE) = (/I1, I3, I2/) + IFACE=IFACE+1 + FACES(3*IFACE-2:3*IFACE) = (/I3, I4, I2/) - ! Might need to rethink this, but for the time being... - BC%II = CF%IJK(IAXIS) - BC%JJ = CF%IJK(JAXIS) - BC%KK = CF%IJK(KAXIS) + ENDDO +ENDDO FACE_LOOP +CYL_FIND(HIGH_IND,2) = IFACE - BC%IIG = CF%IJK(IAXIS) - BC%JJG = CF%IJK(JAXIS) - BC%KKG = CF%IJK(KAXIS) +! High axis plane: +IVERT=NVERTS +CYL_FIND(LOW_IND,1) = IFACE + 1 +DO IFC=1,NP_T + IF (IFC < NP_T) THEN + I1 = (NP_L-1)*NP_T + 1 + IFC + I2 = (NP_L-1)*NP_T + 1 + IFC + 1 + I3 = IVERT + ELSE + I1 = (NP_L-1)*NP_T + 1 + IFC + I2 = (NP_L-1)*NP_T + 1 + 1 + I3 = IVERT + ENDIF + IFACE=IFACE+1 + FACES(3*IFACE-2:3*IFACE) = (/I1, I2, I3 /) +ENDDO +CYL_FIND(HIGH_IND,1) = IFACE +NFACES = IFACE - ELSE INS_INB_COND_1 ! External mesh boundary CFACE +! Transform vertices to global axes: +DO IVERT=1,NVERTS + V(IAXIS:KAXIS,1) = VERTS(3*IVERT-2:3*IVERT) + R = MATMUL(TGL,V) + VERTS(3*IVERT-2:3*IVERT) = R(IAXIS:KAXIS,1) + CYLINDER_ORIGIN(IAXIS:KAXIS) +ENDDO - IF (PRESENT(IW)) THEN - WC => M%WALL(IW) - WC_BC => M%BOUNDARY_COORD(WC%BC_INDEX) - IOR = WC_BC%IOR - SELECT CASE(ABS(IOR)) - CASE(IAXIS); BC%NVEC(IAXIS:KAXIS) = (/ REAL(SIGN(1,IOR),EB), 0._EB, 0._EB /) - CASE(JAXIS); BC%NVEC(IAXIS:KAXIS) = (/ 0._EB, REAL(SIGN(1,IOR),EB), 0._EB /) - CASE(KAXIS); BC%NVEC(IAXIS:KAXIS) = (/ 0._EB, 0._EB, REAL(SIGN(1,IOR),EB) /) - END SELECT - BC%IOR = IOR +! No volumes being defined. +NVOLS = 0 +VOLS = 0 - ! External mesh boundary CFACES inherit the underlaying WALL type. - CFA%BOUNDARY_TYPE = WC%BOUNDARY_TYPE - CFA%NODE_INDEX = SURFACE(WC%SURF_INDEX)%NODE_INDEX - CFA%VENT_INDEX = WC%VENT_INDEX +! WRITE(LU_ERR,*) 'Vertices:' +! DO IVERT=1,NVERTS +! WRITE(LU_ERR,*) VERTS(3*IVERT-2:3*IVERT) +! ENDDO +! WRITE(LU_ERR,*) ' ' +! WRITE(LU_ERR,*) 'Faces:' +! DO IFACE=1,NFACES +! WRITE(LU_ERR,*) FACES(3*IFACE-2:3*IFACE) +! ENDDO - BC%II = WC_BC%II - BC%JJ = WC_BC%JJ - BC%KK = WC_BC%KK +RETURN +END SUBROUTINE DEFINE_CYLINDER - BC%IIG = WC_BC%IIG - BC%JJG = WC_BC%JJG - BC%KKG = WC_BC%KKG +! ---------------------------- GET_GEOM_INFO ---------------------------------------- - ENDIF - ENDIF INS_INB_COND_1 +SUBROUTINE GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) ! LU_INPUT not used for now. - B1%AREA = CF%AREA(IFACE) ! Init to CFACE AREA. +! Count number of various geometry types on the current &GEOM line +! Assume a maximum number of faces and ZVALS, which can be modified in the &MISC line. -CASE(INTEGER_TWO) ! Assign AREA_ADJUST for CFACE, BCs information for CFACE. +INTEGER, INTENT(INOUT) :: MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS - CFA => M%CFACE(CFACE_INDEX) - BC => M%BOUNDARY_COORD(CFA%BC_INDEX) - B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) - ! First: Assign AREA_ADJUST for CFACEs. - B1%AREA_ADJUST = CF%AREA_ADJUST(IFACE) +MAX_ZVALS = MAX(MAX_ZVALS, MAXIMUM_GEOMETRY_ZVALS) +MAX_VOLUS = MAX(MAX_VOLUS,6*MAX_ZVALS, MAXIMUM_GEOMETRY_VOLUS) +MAX_FACES = MAX(MAX_FACES,4*MAX_VOLUS, MAXIMUM_GEOMETRY_FACES) +MAX_VERTS = MAX(MAX_VERTS,4*MAX_VOLUS,3*MAX_FACES, MAXIMUM_GEOMETRY_VERTS) +MAX_IDS = MAX(MAX_IDS, MAXIMUM_GEOMETRY_IDS) +MAX_SURF_IDS = MAX(MAX_SURF_IDS, MAXIMUM_GEOMETRY_SURFIDS) +MAX_POLY_VERTS= MAX(MAX_POLY_VERTS, MAXIMUM_POLY_VERTS) - ! Case of exposed Backing we need to find CFACE_INDEX of BACK CFACE. - IF (SF%BACKING==EXPOSED .AND. SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN - IG = CF%BODTRI(1,IFACE) - TRI = CF%BODTRI(2,IFACE) - XP(IAXIS:KAXIS) = (/ BC%X, BC%Y, BC%Z /) ! CFACE centroid location. - RDIR(IAXIS:KAXIS)= - GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,TRI) ! Normal into the body. - TRI_LOOP : DO IWSEL=1,GEOMETRY(IG)%N_FACES - IF (IWSEL==TRI) CYCLE - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) - ! Triangles NODES coordinates: - V1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) - V2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) - V3(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD3)-1)+1:MAX_DIM*WSELEM(NOD3)) +END SUBROUTINE GET_GEOM_INFO - ! Fast triangle discard method: To do. +! ---------------------------- ALLOCATE_BUFFERS ---------------------------------------- - ! Search for intersection point in POS(IAXIS:KAXIS): - CALL RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,RDIR,IS_INTERSECT,POS) +SUBROUTINE ALLOCATE_BUFFERS - IF (IS_INTERSECT) EXIT TRI_LOOP +IF(ALLOCATED(SURF_ID)) DEALLOCATE(SURF_ID) +ALLOCATE(SURF_ID(MAX_SURF_IDS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','SURF_ID',IZERO) - ENDDO TRI_LOOP +IF(ALLOCATED(ZVALS)) DEALLOCATE(ZVALS) +ALLOCATE(ZVALS(MAX_ZVALS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','ZVALS',IZERO) - IF (IS_INTERSECT) THEN +IF(ALLOCATED(VERTS)) DEALLOCATE(VERTS) +ALLOCATE(VERTS(3*MAX_VERTS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','VERTS',IZERO) - ! Check that distance is less than cell diagonal size: - ! For longer distances from CFACE to BACK CFACE BC is 'VOID'. - IF(NORM2(XP-POS) > SQRT(DX(BC%IIG)**2 + DY(BC%JJG)**2 + DZ(BC%KKG)**2)) RETURN +IF(ALLOCATED(TFACES)) DEALLOCATE(TFACES) +ALLOCATE(TFACES(6*MAX_FACES+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','TFACES',IZERO) - ! We Found an intersection with IWSEL in position POS(IAXIS:KAXIS): - ! Find indexes and mesh of cell containing intersection point: - CALL SEARCH_OTHER_MESHES(POS(IAXIS),POS(JAXIS),POS(KAXIS),NOM,IIO,JJO,KKO) +IF(ALLOCATED(FACES)) DEALLOCATE(FACES) +ALLOCATE(FACES(4*MAX_FACES+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','FACES',IZERO) - ! This test and restriction of NOM==NM is temporary. Discard when parallel CFACE info is in place. - IF (NOM/=NM) THEN - IF(NOM==0) RETURN - WRITE(LU_ERR,*) 'WARNING: BACK CFACE search, other mesh NOM not equal to working mesh NM. NM=',NM,& - ', NOM and other cell IIO,JJO,KKO=',NOM,IIO,JJO,KKO,', intersection pt=',POS(IAXIS:KAXIS) - RETURN - ENDIF +IF(ALLOCATED(VOLUS)) DEALLOCATE(VOLUS) +ALLOCATE(VOLUS(4*MAX_VOLUS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','VOLUS',IZERO) - IF (NOM>0) THEN - IF (ALLOCATED(MESHES(NOM)%CCVAR)) THEN - IIV(1:3) = (/ IIO, MAX(IIO-1,1), MIN(IIO+1,MESHES(NOM)%IBAR) /) - JJV(1:3) = (/ JJO, MAX(JJO-1,1), MIN(JJO+1,MESHES(NOM)%JBAR) /) - KKV(1:3) = (/ KKO, MAX(KKO-1,1), MIN(KKO+1,MESHES(NOM)%KBAR) /) +IF(ALLOCATED(POLY)) DEALLOCATE(POLY) +ALLOCATE(POLY(MAX_POLY_VERTS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','POLY',IZERO) +END SUBROUTINE ALLOCATE_BUFFERS - DIST= 1._EB/TWENTY_EPSILON_EB; ICFF=0; JCF2=0 - K_LOOP : DO KKK=1,3 - KK=KKV(KKK) - DO JJJ=1,3 - JJ=JJV(JJJ) - DO III=1,3 - II=IIV(III) - ICF2 = MESHES(NOM)%CCVAR(II,JJ,KK,CC_IDCF) - ICF2_COND : IF (ICF2>0) THEN +! ---------------------------- SET_GEOM_DEFAULTS ---------------------------------------- - ! Use cut-face with closest centroid to POS: - DO JCF22=1,MESHES(NOM)%CUT_FACE(ICF2)%NFACE - IF(ICF==ICF2 .AND. IFACE==JCF22) CYCLE - DIST2 = (POS(IAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(IAXIS,JCF22))**2._EB + & - (POS(JAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(JAXIS,JCF22))**2._EB + & - (POS(KAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(KAXIS,JCF22))**2._EB - IF (DIST20 .AND. CFA%OD_INDEX>0) THEN - M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_MESH = NOM - M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_INDEX = ICFACE - ENDIF +END SUBROUTINE SET_GEOM_DEFAULTS - ! Write error for testing: - ELSE - WRITE(LU_ERR,*) 'WARNING: BACK CFACE search, MESH, CFACE_INDEX=',NM,CFACE_INDEX,& - ', back CFACE not found in mesh NOM,IIO,JJO,KKO=',NOM,IIO,JJO,KKO - RETURN - ENDIF - ELSE ! Intersection in mesh furher away than neighboring meshes. - ! To Do stop. - ENDIF +! ---------------------------- BOX2TETRA ---------------------------------------- - ELSE ! Intersection outside of domain. - ! To Do stop. +SUBROUTINE BOX2TETRA(BOX,TETRAS) - ENDIF +! split a box defined by a list of 8 vertices (not necessarily cubic) into 6 stackable tetrahedrons - ELSE ! Did not find intersection with other triangles. - ! To Do : Here we can add a test to check if CFACE is indeed within geometry IG. Geometry intersection and - ! linearization lead need to CFACES lay outside of the geometry. - WRITE(LU_ERR,*) 'WARNING: BACK CFACE search did NOT Find Intersection. MESH=',NM,', GEOM=',IG,& - ', CFACE_INDEX, Centroid location=',CFACE_INDEX,XP(:) - RETURN - ENDIF +! 8-------7 +! / . / | +! 5-------6 | +! | . | | +! | . | | +! | 4-------3 +! | / | / +! 1-------2 - ENDIF -CASE(INTEGER_THREE) +INTEGER, INTENT(IN) :: BOX(8) +INTEGER, INTENT(OUT) :: TETRAS(1:24) - CFA => M%CFACE(CFACE_INDEX) - BC => M%BOUNDARY_COORD(CFA%BC_INDEX) - B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) +TETRAS(1:4) = (/BOX(1),BOX(2),BOX(4),BOX(5)/) +TETRAS(5:8) = (/BOX(4),BOX(5),BOX(2),BOX(6)/) +TETRAS(9:12) = (/BOX(4),BOX(5),BOX(6),BOX(8)/) +TETRAS(13:16) = (/BOX(2),BOX(3),BOX(4),BOX(6)/) +TETRAS(17:20) = (/BOX(4),BOX(6),BOX(3),BOX(8)/) +TETRAS(21:24) = (/BOX(6),BOX(3),BOX(8),BOX(7)/) - INS_INB_COND_3 : IF (IS_INB) THEN +END SUBROUTINE BOX2TETRA - ! Associated cut-cell location in CUT_CELL array. - ! This CFACE initialization assumes TMP,RHO,ZZ have been initialized in cut-cell ICC,JCC. - ICC = CF%CELL_LIST(2,LOW_IND,IFACE) - JCC = CF%CELL_LIST(3,LOW_IND,IFACE) - ! Set TMP_F to Surface value and rest to ambient in underlying cartesian cell. - B1%TMP_G = TMP_0(CF%IJK(KAXIS)) - IF (SF%TMP_FRONT > 0._EB) THEN - B1%TMP_F = SF%TMP_FRONT - ELSE - B1%TMP_F = B1%TMP_G - ENDIF +! ---------------------------- ORDER_FACES ---------------------------------------- - B1%RHO_F = CUT_CELL(ICC)%RHO(JCC) - B1%RHO_G = CUT_CELL(ICC)%RHO(JCC) - B1%ZZ_F(1:N_TOTAL_SCALARS) = CUT_CELL(ICC)%ZZ(1:N_TOTAL_SCALARS,JCC) - ! Reinitialize CFACE cell outgoing radiation for change in TMP_F - IF (RADIATION) THEN - B1%Q_RAD_OUT = B1%EMISSIVITY*SIGMA*B1%TMP_F**4 - ELSE - B1%Q_RAD_OUT = 0._EB - ENDIF - ! Assign normal velocity to CFACE from SURF input: - B1%U_NORMAL_0 = SF%VEL - ! Assign normal velocity from VOLUME_FLOW : - IBOD =CF%BODTRI(1,IFACE) - IF(IBOD>0 .AND. ABS(SF%VOLUME_FLOW)>=TWENTY_EPSILON_EB) B1%U_NORMAL_0 = SF%VOLUME_FLOW / FDS_AREA_GEOM(SURF_INDEX,IBOD) - ! Assign normal velocity from MASS_FLUX_TOTAL : - IF(ABS(SF%MASS_FLUX_TOTAL)>=TWENTY_EPSILON_EB) B1%U_NORMAL_0 = SF%MASS_FLUX_TOTAL / RHOA * B1%AREA_ADJUST - ! Vegetation T_IGN setup: Check if fire spreads radially over this surface type - IF (SF%FIRE_SPREAD_RATE>0._EB) THEN - B1%T_IGN = T_BEGIN + SQRT((BC%X-SF%XYZ(1))**2 + & - (BC%Y-SF%XYZ(2))**2 + & - (BC%Z-SF%XYZ(3))**2)/SF%FIRE_SPREAD_RATE - ELSE - B1%T_IGN = SF%T_IGN - ENDIF +SUBROUTINE ORDER_FACES(ORDER,N) ! +INTEGER, INTENT(IN) :: N +INTEGER, INTENT(OUT) :: ORDER(1:N) - ELSE INS_INB_COND_3 ! External mesh boundary CFACE +INTEGER, ALLOCATABLE, DIMENSION(:) :: WORK +INTEGER :: I, IZERO - IF (PRESENT(IW)) THEN - WC => M%WALL(IW) - IOR = M%BOUNDARY_COORD(WC%BC_INDEX)%IOR - WC_B1 => M%BOUNDARY_PROP1(WC%B1_INDEX) - WC_BC => M%BOUNDARY_COORD(WC%BC_INDEX) - ! Set TMP_F to Surface value and rest to ambient in underlying cartesian cell. - B1%TMP_G = TMP(WC_BC%IIG,WC_BC%JJG,WC_BC%KKG) - B1%TMP_F = WC_B1%TMP_F - B1%RHO_F = WC_B1%RHO_F - B1%RHO_G = RHO(WC_BC%IIG,WC_BC%JJG,WC_BC%KKG) - B1%ZZ_F(1:N_TOTAL_SCALARS) = WC_B1%ZZ_F(1:N_TOTAL_SCALARS) +DO I = 1, N + ORDER(I) = I +ENDDO +ALLOCATE(WORK(N),STAT=IZERO) +CALL ChkMemErr('ORDER_FACES','WORK',IZERO) +CALL ORDER_FACES1(ORDER,WORK,1,N,N) +END SUBROUTINE ORDER_FACES - ! Assign normal velocity to CFACE from wall cell: - B1%U_NORMAL_0 = WC_B1%U_NORMAL_0 +! ---------------------------- ORDER_FACES1 ---------------------------------------- - ! Here downscale velocity: - IF (IFACE==CF%NFACE) WC_B1%U_NORMAL_0 = & - WC_B1%U_NORMAL_0 * SUM(CF%AREA(1:CF%NFACE))/WC_B1%AREA +RECURSIVE SUBROUTINE ORDER_FACES1(ORDER,WORK,LEFT,RIGHT,N) +INTEGER, INTENT(IN) :: N, LEFT, RIGHT +INTEGER, INTENT(INOUT) :: ORDER(1:N) +INTEGER :: TEMP +INTEGER :: I1, I2 +INTEGER, INTENT(OUT) :: WORK(N) +INTEGER :: ICOUNT - ! Vegetation T_IGN setup: - B1%T_IGN = WC_B1%T_IGN - ! Back wall cells: - IF (WC%OD_INDEX>0 .AND. CFA%OD_INDEX>0) THEN - M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_MESH = M%BOUNDARY_ONE_D(WC%OD_INDEX)%BACK_MESH - M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_INDEX = M%BOUNDARY_ONE_D(WC%OD_INDEX)%BACK_INDEX - ENDIF +INTEGER :: NMID + +IF (RIGHT-LEFT>1) THEN + NMID = (LEFT+RIGHT)/2 + CALL ORDER_FACES1(ORDER,WORK,LEFT,NMID,N) + CALL ORDER_FACES1(ORDER,WORK,NMID+1,RIGHT,N) + I1=LEFT + I2=NMID+1 + ICOUNT=LEFT + DO WHILE (I1<=NMID .OR. I2<=RIGHT) + IF (I1<=NMID .AND. I2<=RIGHT) THEN + IF (COMPARE_FACES(ORDER(I1),ORDER(I2))==-1) THEN + WORK(ICOUNT)=ORDER(I1) + I1=I1+1 + ELSE + WORK(ICOUNT)=ORDER(I2) + I2=I2+1 + ENDIF + ELSE IF (I1<=NMID .AND. I2>RIGHT) THEN + WORK(ICOUNT)=ORDER(I1) + I1=I1+1 + ELSE IF (I1>NMID .AND. I2<=RIGHT) THEN + WORK(ICOUNT)=ORDER(I2) + I2=I2+1 ENDIF + ICOUNT=ICOUNT+1 + ENDDO + ORDER(LEFT:RIGHT)=WORK(LEFT:RIGHT) +ELSE IF (RIGHT-LEFT==1) THEN + IF (COMPARE_FACES(ORDER(LEFT),ORDER(RIGHT))==1) RETURN + TEMP=ORDER(LEFT) + ORDER(LEFT) = ORDER(RIGHT) + ORDER(RIGHT) = TEMP +ENDIF +END SUBROUTINE ORDER_FACES1 - ENDIF INS_INB_COND_3 +! ---------------------------- COMPARE_FACES ---------------------------------------- -END SELECT STAGE_FLG_BRANCH +INTEGER FUNCTION COMPARE_FACES(INDEX1,INDEX2) +INTEGER, INTENT(IN) :: INDEX1, INDEX2 +INTEGER, POINTER, DIMENSION(:) :: FACE1, FACE2 +INTEGER :: F1(3), F2(3) -END SUBROUTINE INIT_CFACE_CELL +FACE1=>FACES(3*INDEX1-2:3*INDEX1) +FACE2=>FACES(3*INDEX2-2:3*INDEX2) +F1(1:3) = (/FACE1(1),MIN(FACE1(2),FACE1(3)),MAX(FACE1(2),FACE1(3))/) +F2(1:3) = (/FACE2(1),MIN(FACE2(2),FACE2(3)),MAX(FACE2(2),FACE2(3))/) +COMPARE_FACES=0 +IF (F1(1)F2(1)) THEN + COMPARE_FACES=-1 +ENDIF +IF (COMPARE_FACES/=0) RETURN -! --------------------- GET_REGULAR_CUT_EDGES_BC -------------------------------- +IF (F1(2)F2(2)) THEN + COMPARE_FACES=-1 +ENDIF +IF (COMPARE_FACES/=0) RETURN -SUBROUTINE GET_REGULAR_CUT_EDGES_BC(NM) +IF (F1(3)F2(3)) THEN + COMPARE_FACES=-1 +ENDIF +END FUNCTION COMPARE_FACES -! This routine adds to FDS EDGE array -! the sum of regular edges that are boundary at least a neighboring CC_CUTCFE face and -! one CC_GASPHASE face. +END SUBROUTINE READ_GEOM -USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_CELL,REALLOCATE_EDGE -INTEGER, INTENT(IN) :: NM -! Local variables: -INTEGER :: ECOUNT, CC_ECOUNT_RC, CC_ECOUNT_CE, CCOUNT, I, J, K, N_CC, N_RG, IE, IADD, JADD, KADD, IEC, N1, N2 -LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: CELL_ADDED -INTEGER :: ICMM,ICPM,ICPP,ICMP -INTEGER :: IDUM,IOR,IW1,IW2,CELL_COUNT_OLD -INTEGER, PARAMETER :: IAXIS_WALL_INDS(1:4) = (/ -3, -2, 2, 3 /) -INTEGER, PARAMETER :: JAXIS_WALL_INDS(1:4) = (/ -3, -1, 1, 3 /) -INTEGER, PARAMETER :: KAXIS_WALL_INDS(1:4) = (/ -2, -1, 1, 2 /) -LOGICAL :: DO_EDGE_FLG -TYPE(MESH_TYPE), POINTER :: M +! ---------------------------- INIT_SPHERE ---------------------------------------- -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -CHARACTER(100) :: MSEGS_FILE +SUBROUTINE INIT_SPHERE(N_LEVELS,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) -M => MESHES(NM) +INTEGER, INTENT(IN) :: N_LEVELS +INTEGER, INTENT(OUT) :: N_VERTS, N_FACES +INTEGER, INTENT(IN) :: MAX_VERTS, MAX_FACES +REAL(EB), TARGET, INTENT(OUT) :: SPHERE_VERTS(3*MAX_VERTS) +INTEGER, TARGET, INTENT(OUT) :: SPHERE_FACES(3*MAX_FACES) -IF (DEBUG_SET_CUTCELLS) THEN - ! Write out: - WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_rcsegs_mesh_',NM,'.dat' - OPEN(333,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') - CLOSE(333) -ENDIF +REAL(EB) :: ARG +REAL(EB), DIMENSION(3) :: VERT +INTEGER :: I,IFACE +INTEGER, DIMENSION(60) :: FACE_LIST -CALL POINT_TO_MESH(NM) +DATA (FACE_LIST(I),I=1,60) / & + 1, 2, 3, 1, 3, 4, 1, 4, 5, 1, 5, 6, 1, 6,2, & + 2, 7, 3, 3, 7, 8, 3, 8, 4, 4, 8, 9, 4, 9,5, & + 5, 9,10, 5,10, 6, 6,10,11, 6,11, 2, 2,11,7, & + 12, 8,7, 12, 9,8, 12,10,9, 12,11,10, 12,7,11 & + / -! Return if nothing to do for the mesh: -IF(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH == 0) RETURN +N_VERTS = 12 +N_FACES = 20 -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating REGULAR_CUTCELL_EDGES_BC for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating REGULAR_CUTCELL_EDGES_BC for mesh :',NM,' ..' -ENDIF +SPHERE_VERTS(1:3) = (/0.0,0.0,1.0/) ! 1 +DO I=2, 6 + ARG = REAL(I-2,EB)*72.0_EB + ARG = 2.0_EB*PI*ARG/360.0_EB + VERT = (/COS(ARG),SIN(ARG),1.0_EB/SQRT(5.0_EB)/) + SPHERE_VERTS(3*I-2:3*I) = VERT/NORM2(VERT) ! 2-6 +ENDDO +DO I=7, 11 + ARG = 36.0_EB+REAL(I-7,EB)*72.0_EB + ARG = 2.0_EB*PI*ARG/360.0_EB + VERT = (/COS(ARG),SIN(ARG),-1.0_EB/SQRT(5.0_EB)/) + SPHERE_VERTS(3*I-2:3*I) = VERT/NORM2(VERT) ! 7-11 +ENDDO +SPHERE_VERTS(34:36) = (/0.0,0.0,-1.0/) ! 12 -ALLOCATE(CELL_ADDED(0:IBP1,0:JBP1,0:KBP1)); CELL_ADDED = .FALSE. +SPHERE_FACES(1:60) = FACE_LIST(1:60) -! Now count added edge number for mesh N_EDGES_DIM_CC(2,NM), and added non zero cell indexes for mesh +! refine each triangle of the icosahedron recursively until the +! refined triangle sides are the same size as the grid mesh -ECOUNT = 0; CC_ECOUNT_RC=0; CC_ECOUNT_CE = 0; CCOUNT = 0; +DO IFACE = 1, 20 ! can't use N_FACES since N_FACES is altered by each call to REFINE_FACE + CALL REFINE_FACE(N_LEVELS,IFACE,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +ENDDO +END SUBROUTINE INIT_SPHERE -! X axis edges: -DO K=0,KBAR - DO J=0,JBAR - IX_LOOP_1 : DO I=1,IBAR - DO_EDGE_FLG = .FALSE. - IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in Y. - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO JADD=0,1 ! Faces aligned in Z. - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,IAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IX_LOOP_1 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IX_LOOP_1 - ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO KADD=0,1 - DO JADD=0,1 - IF(CELL_INDEX(I ,J+JADD,K+KADD)==0 .AND. .NOT.CELL_ADDED(I ,J+JADD,K+KADD)) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I ,J+JADD,K+KADD) = .TRUE. - ENDIF - ENDDO - ENDDO - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=IAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-2) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) - CASE( 2) - IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) - CASE(-3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 - ENDIF - ENDDO - ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE - ELSE - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE - ENDIF - ENDIF - ENDDO IX_LOOP_1 - ENDDO -ENDDO +! ---------------------------- COMPUTE_TEXTURES ---------------------------------------- -! Y axis edges: -DO K=0,KBAR - DO J=1,JBAR - IY_LOOP_1 : DO I=0,IBAR - DO_EDGE_FLG = .FALSE. - IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in X. - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Z. - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,JAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IY_LOOP_1 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IY_LOOP_1 - ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO KADD=0,1 - DO IADD=0,1 - IF(CELL_INDEX(I+IADD,J ,K+KADD)==0 .AND. .NOT.CELL_ADDED(I+IADD,J ,K+KADD)) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I+IADD,J ,K+KADD) = .TRUE. - ENDIF - ENDDO - ENDDO - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=JAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) - CASE( 1) - IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) - CASE(-3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 - ENDIF - ENDDO - ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE - ELSE - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE - ENDIF - ENDIF - ENDDO IY_LOOP_1 - ENDDO -ENDDO +SUBROUTINE COMPUTE_TEXTURES(SPHERE_VERTS,SPHERE_FACES,SPHERE_TFACES,MAX_VERTS,MAX_FACES,N_FACES) +INTEGER, INTENT(IN) :: N_FACES,MAX_VERTS,MAX_FACES +REAL(EB), TARGET, INTENT(IN) :: SPHERE_VERTS(3*MAX_VERTS) +REAL(EB), INTENT(OUT), TARGET :: SPHERE_TFACES(6*MAX_FACES) +INTEGER, TARGET, INTENT(IN) :: SPHERE_FACES(3*MAX_FACES) -! Z axis edges: -DO K=1,KBAR - DO J=0,JBAR - IZ_LOOP_1 : DO I=0,IBAR - DO_EDGE_FLG = .FALSE. - IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN - N_CC = 0; N_RG = 0 - DO JADD=0,1 ! Faces aligned in X. - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Y. - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,KAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IZ_LOOP_1 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IZ_LOOP_1 - ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO JADD=0,1 - DO IADD=0,1 - IF(CELL_INDEX(I+IADD,J+JADD,K )==0 .AND. .NOT.CELL_ADDED(I+IADD,J+JADD,K )) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I+IADD,J+JADD,K ) = .TRUE. - ENDIF - ENDDO - ENDDO - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=KAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) - CASE( 1) - IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) - CASE(-2) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) - CASE( 2) - IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 - ENDIF - ENDDO - ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE - ELSE - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE - ENDIF - ENDIF - ENDDO IZ_LOOP_1 - ENDDO -ENDDO +INTEGER :: IFACE +REAL(EB) :: EPS_TEXTURE +REAL(EB), POINTER, DIMENSION(:) :: TFACE, VERTPTR +INTEGER, POINTER, DIMENSION(:) :: FACEPTR -IF (CC_ECOUNT_RC+CC_ECOUNT_CE==0) THEN - DEALLOCATE(CELL_ADDED) - RETURN -ENDIF +EPS_TEXTURE=0.25_EB +IFACE_LOOP: DO IFACE=0, N_FACES-1 -! Allocate CC_RCEDGE: -M%CC_NRCEDGE = CC_ECOUNT_RC -ALLOCATE(M%CC_RCEDGE(1:CC_ECOUNT_RC)) + FACEPTR=>SPHERE_FACES(3*IFACE+1:3*IFACE+3) + TFACE=>SPHERE_TFACES(6*IFACE+1:6*IFACE+6) -! Reallocate EDGE variables + VERTPTR=>SPHERE_VERTS(3*FACEPTR(1)-2:3*FACEPTR(1)) + CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(1:2)) -N1 = UBOUND(MESHES(NM)%EDGE,DIM=1) -N2 = EDGE_COUNT(NM) + ECOUNT -IF (ECOUNT>0 .AND. N2>N1) CALL REALLOCATE_EDGE(NM,N1,N2) + VERTPTR=>SPHERE_VERTS(3*FACEPTR(2)-2:3*FACEPTR(2)) + CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(3:4)) -! Reallocate CELL variables + VERTPTR=>SPHERE_VERTS(3*FACEPTR(3)-2:3*FACEPTR(3)) + CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(5:6)) -CELL_COUNT_OLD = CELL_COUNT(NM) -IF (CCOUNT > 0) CALL REALLOCATE_CELL(NM,CELL_COUNT(NM),CELL_COUNT(NM)+CCOUNT) -CCOUNT = CELL_COUNT_OLD + ! adjust texture coordinates when a triangle crosses the "prime meridian" -! Finally repeat search process and assign edge and cell values to cut-cell region entities: + IF (TFACE(1)>1.0_EB-EPS_TEXTURE .AND. TFACE(3)1.0_EB-EPS_TEXTURE .AND. TFACE(5)1.0_EB-EPS_TEXTURE .AND. TFACE(1)1.0_EB-EPS_TEXTURE .AND. TFACE(5)0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,IAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IX_LOOP_2 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IX_LOOP_2 - ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO KADD=0,1 - DO JADD=0,1 - IF(M%CELL_INDEX(I ,J+JADD,K+KADD)==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - M%CELL_INDEX(I ,J+JADD,K+KADD) = CCOUNT - M%CELL(CCOUNT)%I = I - M%CELL(CCOUNT)%J = J+JADD - M%CELL(CCOUNT)%K = K+KADD - ENDIF - ENDDO - ENDDO - ICMM = M%CELL_INDEX(I ,J ,K ) - ICPM = M%CELL_INDEX(I ,J+1,K ) - ICPP = M%CELL_INDEX(I ,J+1,K+1) - ICMP = M%CELL_INDEX(I ,J ,K+1) - M%EDGE(IE)%I = I - M%EDGE(IE)%J = J - M%EDGE(IE)%K = K - M%EDGE(IE)%AXIS = IAXIS - M%EDGE(IE)%CELL_INDEX_MM = ICMM - M%EDGE(IE)%CELL_INDEX_PM = ICPM - M%EDGE(IE)%CELL_INDEX_MP = ICMP - M%EDGE(IE)%CELL_INDEX_PP = ICPP - M%CELL(ICPP)%EDGE_INDEX(1) = IE - M%CELL(ICMP)%EDGE_INDEX(2) = IE - M%CELL(ICPM)%EDGE_INDEX(3) = IE - M%CELL(ICMM)%EDGE_INDEX(4) = IE - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=IAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-2) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) - CASE( 2) - IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) - CASE(-3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 - ENDIF - ENDDO - ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 - ! Add info to CC_RCEDGE: - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS - M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE - ! Note RCEDGE number in ECVAR: - M%ECVAR(I,J,K,CC_IDCE,IAXIS) = CC_ECOUNT_RC - ELSE ! CUT_EDGE: - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 - IEC = M%ECVAR(I,J,K,CC_IDCE,IAXIS) - M%CUT_EDGE(IEC)%IE = IE - ENDIF - ENDIF - ENDDO IX_LOOP_2 - ENDDO -ENDDO - -! Y axis edges: -DO K=0,KBAR - DO J=1,JBAR - IY_LOOP_2 : DO I=0,IBAR - DO_EDGE_FLG = .FALSE. - IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in X. - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Z. - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,JAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IY_LOOP_2 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IY_LOOP_2 - ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO KADD=0,1 - DO IADD=0,1 - IF(M%CELL_INDEX(I+IADD,J ,K+KADD)==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - M%CELL_INDEX(I+IADD,J ,K+KADD) = CCOUNT - M%CELL(CCOUNT)%I = I+IADD - M%CELL(CCOUNT)%J = J - M%CELL(CCOUNT)%K = K+KADD - ENDIF - ENDDO - ENDDO - ICMM = M%CELL_INDEX(I ,J ,K ) - ICMP = M%CELL_INDEX(I+1,J ,K ) - ICPP = M%CELL_INDEX(I+1,J ,K+1) - ICPM = M%CELL_INDEX(I ,J ,K+1) - M%EDGE(IE)%I = I - M%EDGE(IE)%J = J - M%EDGE(IE)%K = K - M%EDGE(IE)%AXIS = JAXIS - M%EDGE(IE)%CELL_INDEX_MM = ICMM - M%EDGE(IE)%CELL_INDEX_PM = ICPM - M%EDGE(IE)%CELL_INDEX_MP = ICMP - M%EDGE(IE)%CELL_INDEX_PP = ICPP - M%CELL(ICPP)%EDGE_INDEX(5) = IE - M%CELL(ICPM)%EDGE_INDEX(6) = IE - M%CELL(ICMP)%EDGE_INDEX(7) = IE - M%CELL(ICMM)%EDGE_INDEX(8) = IE - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=JAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) - CASE( 1) - IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) - CASE(-3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 - ENDIF - ENDDO - ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 - ! Add info to CC_RCEDGE: - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS - M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE - ! Note RCEDGE number in ECVAR: - M%ECVAR(I,J,K,CC_IDCE,JAXIS) = CC_ECOUNT_RC - ELSE ! CUT_EDGE: - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 - IEC = M%ECVAR(I,J,K,CC_IDCE,JAXIS) - M%CUT_EDGE(IEC)%IE = IE - ENDIF - ENDIF - ENDDO IY_LOOP_2 - ENDDO -ENDDO - -! Z axis edges: -DO K=1,KBAR - DO J=0,JBAR - IZ_LOOP_2 : DO I=0,IBAR - DO_EDGE_FLG = .FALSE. - IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN - N_CC = 0; N_RG = 0 - DO JADD=0,1 ! Faces aligned in X. - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Y. - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 - ENDDO - DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 - ELSEIF(M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_CUTCFE) THEN ! CUT_EDGE - IEC=M%ECVAR(I,J,K,CC_IDCE,KAXIS) - ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. - IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IZ_LOOP_2 - DO_EDGE_FLG = .TRUE. - ELSE - CYCLE IZ_LOOP_2 - ENDIF - IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. - IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO JADD=0,1 - DO IADD=0,1 - IF(M%CELL_INDEX(I+IADD,J+JADD,K )==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - M%CELL_INDEX(I+IADD,J+JADD,K ) = CCOUNT - M%CELL(CCOUNT)%I = I+IADD - M%CELL(CCOUNT)%J = J+JADD - M%CELL(CCOUNT)%K = K - ENDIF - ENDDO - ENDDO - ICMM = M%CELL_INDEX(I ,J ,K ) - ICPM = M%CELL_INDEX(I+1,J ,K ) - ICPP = M%CELL_INDEX(I+1,J+1,K ) - ICMP = M%CELL_INDEX(I ,J+1,K ) - M%EDGE(IE)%I = I - M%EDGE(IE)%J = J - M%EDGE(IE)%K = K - M%EDGE(IE)%AXIS = KAXIS - M%EDGE(IE)%CELL_INDEX_MM = ICMM - M%EDGE(IE)%CELL_INDEX_PM = ICPM - M%EDGE(IE)%CELL_INDEX_MP = ICMP - M%EDGE(IE)%CELL_INDEX_PP = ICPP - M%CELL(ICPP)%EDGE_INDEX( 9) = IE - M%CELL(ICMP)%EDGE_INDEX(10) = IE - M%CELL(ICPM)%EDGE_INDEX(11) = IE - M%CELL(ICMM)%EDGE_INDEX(12) = IE - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=KAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) - CASE( 1) - IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) - CASE(-2) - IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) - CASE( 2) - IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) - END SELECT - IF (IW1>0) THEN - IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 - ENDIF - ENDDO - ENDIF - IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN - CC_ECOUNT_RC = CC_ECOUNT_RC + 1 - ! Add info to CC_RCEDGE: - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K - M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS - M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE - ! Note RCEDGE number in ECVAR: - M%ECVAR(I,J,K,CC_IDCE,KAXIS) = CC_ECOUNT_RC - ELSE ! CUT_EDGE: - CC_ECOUNT_CE = CC_ECOUNT_CE + 1 - IEC = M%ECVAR(I,J,K,CC_IDCE,KAXIS) - M%CUT_EDGE(IEC)%IE = IE - ENDIF - ENDIF - ENDDO IZ_LOOP_2 - ENDDO -ENDDO - -DEALLOCATE(CELL_ADDED) - -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - WRITE(LU_SETCC,'(A,F8.3,A,7I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Reg-CC edges for BC : ',CC_ECOUNT_RC,M%CC_NRCEDGE,CC_ECOUNT_CE, & - EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,7I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Reg-CC edges for BC : ',CC_ECOUNT_RC,M%CC_NRCEDGE,CC_ECOUNT_CE, & - EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' - ENDIF - ! DO I=1,M%CC_NRCEDGE - ! WRITE(LU_ERR,*) 'IE,I,J,K,IAXIS=',M%CC_RCEDGE(I)%IE,M%CC_RCEDGE(I)%IJK(IAXIS:KAXIS+1) - ! ENDDO -ENDIF - -IF (DEBUG_SET_CUTCELLS) THEN - ! Write segment information for the mesh if it belongs to the process: - ! Write out: - WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_rcsegs_mesh_',NM,'.dat' - LU_DB_SETCC = GET_FILE_NUMBER() - OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') - !WRITE(LU_ERR,*) TRIM(MSEGS_FILE),M%CC_NRCEDGE,CC_ECOUNT_RC - DO ECOUNT=1,M%CC_NRCEDGE - I=M%CC_RCEDGE(ECOUNT)%IJK(IAXIS) - J=M%CC_RCEDGE(ECOUNT)%IJK(JAXIS) - K=M%CC_RCEDGE(ECOUNT)%IJK(KAXIS) - IE=M%CC_RCEDGE(ECOUNT)%IJK(KAXIS+1) - SELECT CASE(IE) - CASE(IAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DX(I),XC(I),Y(J),Z(K) - CASE(JAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DY(J),X(I),YC(J),Z(K) - CASE(KAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DZ(K),X(I),Y(J),ZC(K) - END SELECT - ENDDO - CLOSE(LU_DB_SETCC) -ENDIF - -RETURN -END SUBROUTINE GET_REGULAR_CUT_EDGES_BC - - -! --------------------- GET_SOLID_CUTCELL_EDGES_BC -------------------------------- - -SUBROUTINE GET_SOLID_CUTCELL_EDGES_BC(NM) - -! This routine adds to FDS EDGE array -! the sum of regular edges that are boundary at least a neighboring CC_CUTCFE face and -! one CC_SOLID face. - -USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_CELL,REALLOCATE_EDGE -INTEGER, INTENT(IN) :: NM - -! Local variables: -INTEGER :: ECOUNT, CC_ECOUNT, CCOUNT, I, J, K, N_CC, N_RG, IE, IADD, JADD, KADD, CELL_COUNT_OLD, N1, N2 -LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: CELL_ADDED -INTEGER :: ICMM,ICPM,ICPP,ICMP -INTEGER :: IDUM,IOR,IW1,IW2 -INTEGER, PARAMETER :: IAXIS_WALL_INDS(1:4) = (/ -3, -2, 2, 3 /) -INTEGER, PARAMETER :: JAXIS_WALL_INDS(1:4) = (/ -3, -1, 1, 3 /) -INTEGER, PARAMETER :: KAXIS_WALL_INDS(1:4) = (/ -2, -1, 1, 2 /) -INTEGER :: IN1,IN2,JN1,JN2,KN1,KN2 -LOGICAL :: INI,INJ,INK,INMESH - -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -CHARACTER(100) :: MSEGS_FILE - -IF (DEBUG_SET_CUTCELLS) THEN - ! Write out: - WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_ibsegs_mesh_',NM,'.dat' - LU_DB_SETCC = GET_FILE_NUMBER() - OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') - CLOSE(LU_DB_SETCC) -ENDIF - -CALL POINT_TO_MESH(NM) - -! Return if nothing to do for the mesh: -IF(MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH == 0) RETURN - -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating SOLID_CUTCELL_EDGES_BC for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating SOLID_CUTCELL_EDGES_BC for mesh :',NM,' ..' -ENDIF - -ALLOCATE(CELL_ADDED(0:IBP1,0:JBP1,0:KBP1)); CELL_ADDED = .FALSE. - -! Now count added edge number for EDGE and CELL - -ECOUNT = 0; CC_ECOUNT=0 -CCOUNT = 0; - -! X axis edges: -DO K=0,KBAR - INK = .FALSE. - KN1 = K; KN2 = K+1 - IF (K==0) THEN; KN1=K+1 - ELSEIF(K==KBAR) THEN; KN2=K - ELSE - INK = .TRUE. - ENDIF - DO J=0,JBAR - INJ = .FALSE. - JN1 = J; JN2 = J+1 - IF (J==0) THEN; JN1=J+1 - ELSEIF(J==JBAR) THEN; JN2=J - ELSE - INJ = .TRUE. - ENDIF - INMESH = INK .AND. INJ - IX_LOOP_1 : DO I=1,IBAR - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,IAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in Y. - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - DO JADD=0,1 ! Faces aligned in Z. - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(I,JN1:JN2,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. - ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-face, and a solid face. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO KADD=0,1 - DO JADD=0,1 - IF(CELL_INDEX(I ,J+JADD,K+KADD)==0 .AND. .NOT.CELL_ADDED(I ,J+JADD,K+KADD)) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I ,J+JADD,K+KADD) = .TRUE. - ENDIF - ENDDO - ENDDO - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=IAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K ))%WALL_INDEX( 2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K+1))%WALL_INDEX( 2) - CASE( 2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K ))%WALL_INDEX(-2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K+1))%WALL_INDEX(-2) - CASE(-3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K ))%WALL_INDEX( 3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K+1))%WALL_INDEX(-3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 - ENDIF - ENDDO - ENDIF - CC_ECOUNT = CC_ECOUNT + 1 - ENDIF - ENDDO IX_LOOP_1 - ENDDO -ENDDO - -! Y axis edges: -DO K=0,KBAR - INK = .FALSE. - KN1 = K; KN2 = K+1 - IF (K==0) THEN; KN1=K+1 - ELSEIF(K==KBAR) THEN; KN2=K - ELSE - INK = .TRUE. - ENDIF - DO J=1,JBAR - IY_LOOP_1 : DO I=0,IBAR - INI = .FALSE. - IN1 = I; IN2 = I+1 - IF (I==0) THEN; IN1=I+1 - ELSEIF(I==IBAR) THEN; IN2=I - ELSE - INI = .TRUE. - ENDIF - INMESH = INK .AND. INI - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,JAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in X. - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Z. - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,J,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. - ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO KADD=0,1 - DO IADD=0,1 - IF(CELL_INDEX(I+IADD,J ,K+KADD)==0 .AND. .NOT.CELL_ADDED(I+IADD,J ,K+KADD)) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I+IADD,J ,K+KADD) = .TRUE. - ENDIF - ENDDO - ENDDO - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=JAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) - CASE( 1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) - CASE(-3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 - ENDIF - ENDDO - ENDIF - CC_ECOUNT = CC_ECOUNT + 1 - ENDIF - ENDDO IY_LOOP_1 - ENDDO -ENDDO - -! Z axis edges: -DO K=1,KBAR - DO J=0,JBAR - INJ = .FALSE. - JN1 = J; JN2 = J+1 - IF (J==0) THEN; JN1=J+1 - ELSEIF(J==JBAR) THEN; JN2=J - ELSE - INJ = .TRUE. - ENDIF - IZ_LOOP_1 : DO I=0,IBAR - INI = .FALSE. - IN1 = I; IN2 = I+1 - IF (I==0) THEN; IN1=I+1 - ELSEIF(I==IBAR) THEN; IN2=I - ELSE - INI = .TRUE. - ENDIF - INMESH = INJ .AND. INI - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,KAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO JADD=0,1 ! Faces aligned in X. - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Y. - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,JN1:JN2,K,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. - ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. - ! If IE not counted yet increase ECOUNT: - IF (IE==0) THEN - ECOUNT = ECOUNT + 1 - ! See if we need to add to CCOUNT any neighboring cells: - DO JADD=0,1 - DO IADD=0,1 - IF(CELL_INDEX(I+IADD,J+JADD,K )==0 .AND. .NOT.CELL_ADDED(I+IADD,J+JADD,K )) THEN - CCOUNT = CCOUNT + 1 - CELL_ADDED(I+IADD,J+JADD,K ) = .TRUE. - ENDIF - ENDDO - ENDDO - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=KAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) - CASE( 1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) - CASE(-2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) - CASE( 2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 - ENDIF - ENDDO - ENDIF - CC_ECOUNT = CC_ECOUNT + 1 - ENDIF - ENDDO IZ_LOOP_1 - ENDDO -ENDDO - -IF (CC_ECOUNT==0) THEN - DEALLOCATE(CELL_ADDED) - RETURN -ENDIF - -! Allocate CC_IBEDGE: -MESHES(NM)%CC_NIBEDGE = CC_ECOUNT -ALLOCATE(MESHES(NM)%CC_IBEDGE(1:CC_ECOUNT)) - -! Reallocate EDGE variables - -N1 = UBOUND(MESHES(NM)%EDGE,DIM=1) -N2 = EDGE_COUNT(NM) + ECOUNT -IF (ECOUNT>0 .AND. N2>N1) CALL REALLOCATE_EDGE(NM,N1,N2) - -! Reallocate derived type array CELL which contains SOLID, OBST_INDEX, WALL_INDEX, EDGE_INDEX, EXTERIOR, I, J, K: - -CELL_COUNT_OLD = CELL_COUNT(NM) -IF (CCOUNT > 0) CALL REALLOCATE_CELL(NM,CELL_COUNT(NM),CELL_COUNT(NM)+CCOUNT) -CCOUNT = CELL_COUNT_OLD - -! Finally repeat search process and assign edge and cell values to cut-cell region entities: - -CC_ECOUNT=0 - -! X axis edges: -DO K=0,KBAR - INK = .FALSE. - KN1 = K; KN2 = K+1 - IF (K==0) THEN; KN1=K+1 - ELSEIF(K==KBAR) THEN; KN2=K - ELSE - INK = .TRUE. - ENDIF - DO J=0,JBAR - INJ = .FALSE. - JN1 = J; JN2 = J+1 - IF (J==0) THEN; JN1=J+1 - ELSEIF(J==JBAR) THEN; JN2=J - ELSE - INJ = .TRUE. - ENDIF - INMESH = INK .AND. INJ - IX_LOOP_2 : DO I=1,IBAR - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,IAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in Y. - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - DO JADD=0,1 ! Faces aligned in Z. - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(I,JN1:JN2,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. - ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells, NEW edge to force. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO KADD=0,1 - DO JADD=0,1 - IF(MESHES(NM)%CELL_INDEX(I ,J+JADD,K+KADD)==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - MESHES(NM)%CELL_INDEX(I ,J+JADD,K+KADD) = CCOUNT - MESHES(NM)%CELL(CCOUNT)%I = I - MESHES(NM)%CELL(CCOUNT)%J = J+JADD - MESHES(NM)%CELL(CCOUNT)%K = K+KADD - ENDIF - ENDDO - ENDDO - ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) - ICPM = MESHES(NM)%CELL_INDEX(I ,J+1,K ) - ICPP = MESHES(NM)%CELL_INDEX(I ,J+1,K+1) - ICMP = MESHES(NM)%CELL_INDEX(I ,J ,K+1) - MESHES(NM)%EDGE(IE)%I = I - MESHES(NM)%EDGE(IE)%J = J - MESHES(NM)%EDGE(IE)%K = K - MESHES(NM)%EDGE(IE)%AXIS = IAXIS - MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM - MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM - MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP - MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP - MESHES(NM)%CELL(ICPP)%EDGE_INDEX(1) = IE - MESHES(NM)%CELL(ICMP)%EDGE_INDEX(2) = IE - MESHES(NM)%CELL(ICPM)%EDGE_INDEX(3) = IE - MESHES(NM)%CELL(ICMM)%EDGE_INDEX(4) = IE - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=IAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) - CASE( 2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) - CASE(-3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 - ENDIF - ENDDO - ENDIF - - CC_ECOUNT = CC_ECOUNT + 1 - - ! Add info to CC_IBEDGE: - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE - - ENDIF - ENDDO IX_LOOP_2 - ENDDO -ENDDO - -! Y axis edges: -DO K=0,KBAR - INK = .FALSE. - KN1 = K; KN2 = K+1 - IF (K==0) THEN; KN1=K+1 - ELSEIF(K==KBAR) THEN; KN2=K - ELSE - INK = .TRUE. - ENDIF - DO J=1,JBAR - IY_LOOP_2 : DO I=0,IBAR - INI = .FALSE. - IN1 = I; IN2 = I+1 - IF (I==0) THEN; IN1=I+1 - ELSEIF(I==IBAR) THEN; IN2=I - ELSE - INI = .TRUE. - ENDIF - INMESH = INK .AND. INI - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,JAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO KADD=0,1 ! Faces aligned in X. - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Z. - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,J,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. - ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO KADD=0,1 - DO IADD=0,1 - IF(MESHES(NM)%CELL_INDEX(I+IADD,J ,K+KADD)==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - MESHES(NM)%CELL_INDEX(I+IADD,J ,K+KADD) = CCOUNT - MESHES(NM)%CELL(CCOUNT)%I = I+IADD - MESHES(NM)%CELL(CCOUNT)%J = J - MESHES(NM)%CELL(CCOUNT)%K = K+KADD - ENDIF - ENDDO - ENDDO - ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) - ICMP = MESHES(NM)%CELL_INDEX(I+1,J ,K ) - ICPP = MESHES(NM)%CELL_INDEX(I+1,J ,K+1) - ICPM = MESHES(NM)%CELL_INDEX(I ,J ,K+1) - MESHES(NM)%EDGE(IE)%I = I - MESHES(NM)%EDGE(IE)%J = J - MESHES(NM)%EDGE(IE)%K = K - MESHES(NM)%EDGE(IE)%AXIS = JAXIS - MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM - MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM - MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP - MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP - MESHES(NM)%CELL(ICPP)%EDGE_INDEX(5) = IE - MESHES(NM)%CELL(ICPM)%EDGE_INDEX(6) = IE - MESHES(NM)%CELL(ICMP)%EDGE_INDEX(7) = IE - MESHES(NM)%CELL(ICMM)%EDGE_INDEX(8) = IE - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=JAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) - CASE( 1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) - CASE(-3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) - CASE( 3) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 - ENDIF - ENDDO - ENDIF - - CC_ECOUNT = CC_ECOUNT + 1 - - ! Add info to CC_IBEDGE: - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE - - ENDIF - ENDDO IY_LOOP_2 - ENDDO -ENDDO - -! Z axis edges: -DO K=1,KBAR - DO J=0,JBAR - INJ = .FALSE. - JN1 = J; JN2 = J+1 - IF (J==0) THEN; JN1=J+1 - ELSEIF(J==JBAR) THEN; JN2=J - ELSE - INJ = .TRUE. - ENDIF - IZ_LOOP_2 : DO I=0,IBAR - INI = .FALSE. - IN1 = I; IN2 = I+1 - IF (I==0) THEN; IN1=I+1 - ELSEIF(I==IBAR) THEN; IN2=I - ELSE - INI = .TRUE. - ENDIF - INMESH = INJ .AND. INI - IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,KAXIS) /= CC_SOLID) CYCLE - N_CC = 0; N_RG = 0 - DO JADD=0,1 ! Faces aligned in X. - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - DO IADD=0,1 ! Faces aligned in Y. - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 - IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 - ENDDO - IF (.NOT.INMESH) THEN - IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,JN1:JN2,K,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. - ENDIF - IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. - IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. - IF (IE==0) THEN - EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) - DO JADD=0,1 - DO IADD=0,1 - IF(MESHES(NM)%CELL_INDEX(I+IADD,J+JADD,K )==0) THEN ! Add cell to CELL_INDEX - CCOUNT = CCOUNT + 1 - MESHES(NM)%CELL_INDEX(I+IADD,J+JADD,K ) = CCOUNT - MESHES(NM)%CELL(CCOUNT)%I = I+IADD - MESHES(NM)%CELL(CCOUNT)%J = J+JADD - MESHES(NM)%CELL(CCOUNT)%K = K - ENDIF - ENDDO - ENDDO - ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) - ICPM = MESHES(NM)%CELL_INDEX(I+1,J ,K ) - ICPP = MESHES(NM)%CELL_INDEX(I+1,J+1,K ) - ICMP = MESHES(NM)%CELL_INDEX(I ,J+1,K ) - MESHES(NM)%EDGE(IE)%I = I - MESHES(NM)%EDGE(IE)%J = J - MESHES(NM)%EDGE(IE)%K = K - MESHES(NM)%EDGE(IE)%AXIS = KAXIS - MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM - MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM - MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP - MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP - MESHES(NM)%CELL(ICPP)%EDGE_INDEX( 9) = IE - MESHES(NM)%CELL(ICMP)%EDGE_INDEX(10) = IE - MESHES(NM)%CELL(ICPM)%EDGE_INDEX(11) = IE - MESHES(NM)%CELL(ICMM)%EDGE_INDEX(12) = IE - ELSE - ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. - ! If so discard edge for CCIBM stress recalculation, no need to do it. - DO IDUM=1,4 - IOR=KAXIS_WALL_INDS(IDUM) - SELECT CASE(IOR) - CASE(-1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) - CASE( 1) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) - CASE(-2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) - CASE( 2) - IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) - IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) - END SELECT - IF (IW1>0) THEN - IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 - ENDIF - IF (IW2>0) THEN - IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & - MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 - ENDIF - ENDDO - ENDIF - - CC_ECOUNT = CC_ECOUNT + 1 - - ! Add info to CC_IBEDGE: - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS - MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE - - ENDIF - ENDDO IZ_LOOP_2 - ENDDO -ENDDO - -DEALLOCATE(CELL_ADDED) - -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - WRITE(LU_SETCC,'(A,F8.3,A,6I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Sol-CC edges for BC : ', & - CC_ECOUNT,MESHES(NM)%CC_NIBEDGE,EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,6I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Sol-CC edges for BC : ', & - CC_ECOUNT,MESHES(NM)%CC_NIBEDGE,EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' - ENDIF - ! DO I=1,MESHES(NM)%CC_NRCEDGE - ! WRITE(LU_ERR,*) 'IE,I,J,K,IAXIS=',MESHES(NM)%CC_RCEDGE(I)%IE,MESHES(NM)%CC_RCEDGE(I)%IJK(IAXIS:KAXIS+1) - ! ENDDO -ENDIF - -IF (DEBUG_SET_CUTCELLS) THEN - ! Write segment information for the mesh if it belongs to the process: - ! Write out: - WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_ibsegs_mesh_',NM,'.dat' - LU_DB_SETCC = GET_FILE_NUMBER() - OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') - !WRITE(LU_ERR,*) TRIM(MSEGS_FILE),MESHES(NM)%CC_NRCEDGE,CC_ECOUNT - DO ECOUNT=1,MESHES(NM)%CC_NIBEDGE - I=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(IAXIS) - J=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(JAXIS) - K=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(KAXIS) - IE=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(KAXIS+1) - SELECT CASE(IE) - CASE(IAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DX(I),XC(I),Y(J),Z(K) - CASE(JAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DY(J),X(I),YC(J),Z(K) - CASE(KAXIS) - WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DZ(K),X(I),Y(J),ZC(K) - END SELECT - ENDDO - CLOSE(LU_DB_SETCC) -ENDIF - -RETURN -END SUBROUTINE GET_SOLID_CUTCELL_EDGES_BC - -! ----------------------- ALLOCATE_BODINT_PLANE -------------------------------- - -SUBROUTINE ALLOCATE_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) - -TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE -LOGICAL, INTENT (INOUT) :: FIRST_CALL_ARG - -! Local Variables: -INTEGER, SAVE :: N_VERTS_TOT, N_FACES_TOT -LOGICAL, SAVE :: FIRST_CALL=.TRUE. -REAL(EB) :: LEDGE -INTEGER :: IG - -IF (FIRST_CALL) THEN - ! Define BODINT_PLANE allocation sizes, hard wired for now: - ! Maximum number of vertices and elements in BODINT_PLANE: - N_VERTS_TOT=0; N_FACES_TOT=0 - DO IG=1,N_GEOMETRY - N_VERTS_TOT = N_VERTS_TOT + GEOMETRY(IG)%N_VERTS - N_FACES_TOT = N_FACES_TOT + GEOMETRY(IG)%N_FACES - ENDDO - - ! Conservative estimate: - CC_MAX_NNODS = 2 * N_VERTS_TOT - CC_MAX_NSGLS = N_VERTS_TOT - CC_MAX_NSEGS = N_FACES_TOT - CC_MAX_NTRIS = N_FACES_TOT - - ! Maximum number of grid crossings on BODINT_PLANE segments, MAX_LEDGE is a module variable: - MAX_LEDGE = GEOMEPS ! Initialize to a small number. - DO IG=1,N_GEOMETRY - LEDGE = GEOMETRY(IG)%MAX_LEDGE ! This has been computed at setup in GET_GEOM_TRIBIN - MAX_LEDGE = MAX(MAX_LEDGE,LEDGE) - ENDDO - - FIRST_CALL =.FALSE. -ENDIF - -IF (.NOT.FIRST_CALL_ARG) RETURN - -IF ( ALLOCATED(BODINT_PLANE%XYZ) ) DEALLOCATE(BODINT_PLANE%XYZ) -IF ( ALLOCATED(BODINT_PLANE%SGLS) ) DEALLOCATE(BODINT_PLANE%SGLS) -IF ( ALLOCATED(BODINT_PLANE%SEGS) ) DEALLOCATE(BODINT_PLANE%SEGS) -IF ( ALLOCATED(BODINT_PLANE%TRIS) ) DEALLOCATE(BODINT_PLANE%TRIS) -IF ( ALLOCATED(BODINT_PLANE%INDSEG) ) DEALLOCATE(BODINT_PLANE%INDSEG) -IF ( ALLOCATED(BODINT_PLANE%INDTRI) ) DEALLOCATE(BODINT_PLANE%INDTRI) -IF ( ALLOCATED(BODINT_PLANE%X2ALIGNED) ) DEALLOCATE(BODINT_PLANE%X2ALIGNED) -IF ( ALLOCATED(BODINT_PLANE%X3ALIGNED) ) DEALLOCATE(BODINT_PLANE%X3ALIGNED) -IF ( ALLOCATED(BODINT_PLANE%SEGTYPE) ) DEALLOCATE(BODINT_PLANE%SEGTYPE) -IF ( ALLOCATED(BODINT_PLANE%NOD_PERM) ) DEALLOCATE(BODINT_PLANE%NOD_PERM) - -ALLOCATE(BODINT_PLANE% XYZ(IAXIS:KAXIS, CC_MAX_NNODS)) -ALLOCATE(BODINT_PLANE% NOD_PERM(CC_MAX_NNODS)) -ALLOCATE(BODINT_PLANE% SGLS(NOD1, CC_MAX_NSGLS)) -ALLOCATE(BODINT_PLANE% SEGS(NOD1:NOD2, CC_MAX_NSEGS)) -ALLOCATE(BODINT_PLANE% TRIS(NOD1:NOD3, CC_MAX_NTRIS)) -ALLOCATE(BODINT_PLANE% INDSEG(CC_MAX_WSTRIANG_SEG+2, CC_MAX_NSEGS)) -ALLOCATE(BODINT_PLANE% INDTRI(CC_MAX_WSTRIANG_TRI+1, CC_MAX_NTRIS)) -ALLOCATE(BODINT_PLANE%X2ALIGNED(CC_MAX_NSEGS)) -ALLOCATE(BODINT_PLANE%X3ALIGNED(CC_MAX_NSEGS)) -ALLOCATE(BODINT_PLANE% SEGTYPE(LOW_IND:HIGH_IND, CC_MAX_NSEGS)) - -FIRST_CALL_ARG=.FALSE. - -END SUBROUTINE ALLOCATE_BODINT_PLANE - -! -------------------------- GET_BODINT_PLANE ----------------------------------- - -SUBROUTINE GET_BODINT_PLANE(X1AXIS,X1PLN,INDX1,PLNORMAL,X2AXIS,X3AXIS,& - X2LO,X2HI,X3LO,X3HI,X2FACE,X3FACE,X2LO_CELL,& - X2HI_CELL,X3LO_CELL,X3HI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE) - -INTEGER, INTENT(IN) :: X1AXIS, X2AXIS, X3AXIS, INDX1, X2LO, X2HI, X3LO, X3HI, X2LO_CELL,& - X2HI_CELL,X3LO_CELL,X3HI_CELL -REAL(EB),INTENT(IN) :: X1PLN, PLNORMAL(MAX_DIM) -REAL(EB), ALLOCATABLE, DIMENSION(:), INTENT(IN) :: X2FACE,X3FACE -LOGICAL, INTENT(IN) :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY -TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE - -! Local variables: -INTEGER :: IG, IBIN, IWSEL, IWSELDUM, IEDGE, ISGL, ISEG, ITRI, EDGE_TRI -REAL(EB):: XYZV(MAX_DIM,NODS_WSEL) -INTEGER :: ELEM(NODS_WSEL), IND_P(NODS_WSEL), NTRIS, NSEGS -REAL(EB):: DOT1, DOT2, DOT3 -LOGICAL :: INTFLG, INLIST -REAL(EB):: LN1(MAX_DIM,NOD1:NOD2), LN2(MAX_DIM,NOD1:NOD2) -REAL(EB):: XYZ_INT1(MAX_DIM), XYZ_INT2(MAX_DIM) -INTEGER :: SEG(NOD1:NOD2), EDGES(NOD1:NOD2,3), VEC3(3) -REAL(EB):: X2X3(IAXIS:JAXIS,NODS_WSEL), AREALOC -REAL(EB):: XP1(IAXIS:JAXIS), XP2(IAXIS:JAXIS), TX2P(IAXIS:JAXIS), TX3P(IAXIS:JAXIS) -REAL(EB):: NMTX2P -INTEGER :: IWSEL1, IWSEL2, ELEM1(NODS_WSEL), ELEM2(NODS_WSEL) -REAL(EB):: XYZ1(MAX_DIM), NXYZ1(MAX_DIM), NX3P1, N1(IAXIS:JAXIS), NMNL -REAL(EB):: XYZ2(MAX_DIM), NXYZ2(MAX_DIM), NX3P2, N2(IAXIS:JAXIS) -REAL(EB):: X3PVERT, PVERT(IAXIS:JAXIS), X3P1, P1CEN(IAXIS:JAXIS), X3P2, P2CEN(IAXIS:JAXIS) -INTEGER :: VCT(2) -REAL(EB):: PCT(IAXIS:JAXIS,1:2), V1(IAXIS:JAXIS), V2(IAXIS:JAXIS), CRSSNV, CTST -REAL(EB):: VEC(IAXIS:JAXIS,1:2) -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEGAUX, INDSEGAUX, SEGTYPEAUX, ISEG_NODE -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: ANGS_NODE -REAL(EB):: X3_1, X2_1, X3_2, X2_2, SLEN, SBOD -INTEGER :: INOD, ISEG_NEW, NBCROSS, NBCROSS_SVAR -REAL(EB):: DELBIN -INTEGER :: ILO_BIN, IHI_BIN - -INTEGER :: AXIS, NTL, SZE, IBCR, ICROSS, IDUM, ISVAR, ISX, JJ2, KK2, BISEG, BIISEG, JJ2_LO, JJ2_HI, KK2_LO, KK2_HI -INTEGER :: VAXIS(IAXIS:JAXIS), I -REAL(EB):: LXI, MEAN_SLEN, XIV(NOD1:NOD2), XIV_LO, XIV_HI, MIN_MESHGEOM -INTEGER, ALLOCATABLE, DIMENSION(:) :: TRI_LIST, SEGS_NODE, CIRC_MED -INTEGER :: SEGV(NOD1:NOD2,EDG1:EDG2), ISEGV(EDG1:EDG2), INT_FLG, MAX_SEG_NODE, ISEG2, ISEG3, NSN, COUNT -REAL(EB):: XPOS, XY(IAXIS:JAXIS), S1_X2_MIN, S1_X3_MIN, S1_X2_MAX, S1_X3_MAX, AVAL, ANG, DX2, DX3 -REAL(EB):: D1(IAXIS:JAXIS),P1(IAXIS:JAXIS),D2(IAXIS:JAXIS),P2(IAXIS:JAXIS),SLENV(EDG1:EDG2),SVARV(NOD1:NOD2,EDG1:EDG2) -REAL(EB) :: TNOW -LOGICAL :: LO_X2_TEST, HI_X2_TEST, LO_X3_TEST, HI_X3_TEST, FOUND_SEG, CRS_FLG -CHARACTER(100) :: BIPL_FILE -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX - -INTEGER :: WSELEM(NOD1:NOD3), MYAXIS -REAL(EB):: FACECUBE(LOW_IND:HIGH_IND,IAXIS:KAXIS) - -IG = INDX1 -TNOW = CURRENT_TIME() - -! Now allocate BODINT_PLANE: -BODINT_PLANE%NNODS = 0 -BODINT_PLANE%NSGLS = 0 -BODINT_PLANE%NSEGS = 0 -BODINT_PLANE%NTRIS = 0 - -! Main Loop over Geometries: -MAIN_GEOM_LOOP : DO IG=1,N_GEOMETRY - - IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE - DELBIN = GEOMETRY(IG)%TBAXIS(X1AXIS)%DELBIN - MIN_MESHGEOM = GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(1)%X1_LOW - ILO_BIN = MAX(1,CEILING((X1PLN-GEOMEPS-MIN_MESHGEOM)/DELBIN)) - IHI_BIN = MIN(GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS,CEILING((X1PLN+GEOMEPS-MIN_MESHGEOM)/DELBIN)) - - ! Find for this geometry where does the plane lay on triangle bins: - IBIN_DO : DO IBIN=ILO_BIN,IHI_BIN !1,GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS - - IF ( X1PLN < GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE - IF ( X1PLN > GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE - - ! Loop surface triangles: -! DO IWSEL =1,GEOMETRY(IG)%N_FACES - DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL - - IWSEL=GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(IWSELDUM) - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(MAX_DIM*(IWSEL-1)+1:MAX_DIM*IWSEL) - ! Triangles NODES coordinates: - DO INOD=NOD1,NOD3 - XYZV(IAXIS:KAXIS,INOD) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+1:MAX_DIM*WSELEM(INOD)) - ENDDO - ! FACECUBE: - DO MYAXIS=IAXIS,KAXIS - FACECUBE( LOW_IND,MYAXIS) = MINVAL(XYZV(MYAXIS,NOD1:NOD3)) - FACECUBE(HIGH_IND,MYAXIS) = MAXVAL(XYZV(MYAXIS,NOD1:NOD3)) - ENDDO - - ! Test low-high vertices of triangle along x1axis vs plane (O(NT) operation): - IF( (FACECUBE( LOW_IND,X1AXIS)-X1PLN) > GEOMEPS) CYCLE - IF( (X1PLN-FACECUBE(HIGH_IND,X1AXIS)) > GEOMEPS) CYCLE - - IF(RAYTRACE_X2_ONLY) THEN - IF( (X3LO_RT-FACECUBE(HIGH_IND,X3AXIS)) > GEOMEPS) CYCLE - IF( (FACECUBE( LOW_IND,X3AXIS)-X3HI_RT) > GEOMEPS) CYCLE - ELSE - LO_X2_TEST=(X2FACE(X2LO)-FACECUBE(HIGH_IND,X2AXIS)) > GEOMEPS - LO_X3_TEST=(X3FACE(X3LO)-FACECUBE(HIGH_IND,X3AXIS)) > GEOMEPS - IF( LO_X2_TEST .AND. LO_X3_TEST ) CYCLE - HI_X2_TEST=(FACECUBE( LOW_IND,X2AXIS)-X2FACE(X2HI)) > GEOMEPS - IF( HI_X2_TEST .AND. LO_X3_TEST ) CYCLE - HI_X3_TEST=(FACECUBE( LOW_IND,X3AXIS)-X3FACE(X3HI)) > GEOMEPS - IF( LO_X2_TEST .AND. HI_X3_TEST ) CYCLE - IF( HI_X2_TEST .AND. HI_X3_TEST ) CYCLE - ENDIF - - ! Compute simplified dot(PLNORMAL,XYZV-XYZPLANE): - DOT1 = XYZV(X1AXIS,NOD1) - X1PLN - DOT2 = XYZV(X1AXIS,NOD2) - X1PLN - DOT3 = XYZV(X1AXIS,NOD3) - X1PLN - IF ( ABS(DOT1) <= GEOMEPS ) DOT1 = 0._EB - IF ( ABS(DOT2) <= GEOMEPS ) DOT2 = 0._EB - IF ( ABS(DOT3) <= GEOMEPS ) DOT3 = 0._EB - - ! Test if IWSEL lays in X1PLN: - IF ( (ABS(DOT1)+ABS(DOT2)+ABS(DOT3)) == 0._EB ) THEN - - ! Force nodes location in X1PLN plane: - XYZV(X1AXIS,NOD1:NOD3) = X1PLN - - ! Index to point 1 of triangle in BODINT_PLANE%XYZ list: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD1),IND_P(NOD1)) - - ! Index to point 2 of triangle in BODINT_PLANE%XYZ list: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD2),IND_P(NOD2)) - - ! Index to point 3 of triangle in BODINT_PLANE%XYZ list: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD3),IND_P(NOD3)) - - ! Do we need to test if we already have this triangle on - ! the list? Shouldn't unless repeated -> Possibility for - ! zero thickness. - NTRIS = BODINT_PLANE % NTRIS + 1 - BODINT_PLANE % NTRIS = NTRIS - BODINT_PLANE % TRIS(NOD1:NOD3,NTRIS) = IND_P - BODINT_PLANE % INDTRI(1:2,NTRIS) = (/ IWSEL, IG /) - - CYCLE ! Next WSELEM - - ENDIF - - ! Test if we are looking for intersection triangles only: - ONLY_TRIANG_EDGES_COND : IF (.NOT.TRI_ONPLANE_ONLY) THEN - ! Case a: Typical intersections: - ! Points 1,2 on on side of plane, point 3 on the other: - IF ( ((DOT1 > 0._EB) .AND. (DOT2 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT2 < 0._EB) .AND. (DOT3 > 0._EB)) ) THEN - - ! Line 1, from node 2 to 3: - LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) - LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) - - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - - ! Line 2, from node 1 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) - - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) - - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT1 > 0._EB ) THEN ! First case, counterclockwise p1 to p2 - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) - - CYCLE ! Next WSELEM - - ENDIF - ! Points 2,3 on one side of plane, point 1 on the other: - IF ( ((DOT2 > 0._EB) .AND. (DOT3 > 0._EB) .AND. (DOT1 < 0._EB)) .OR. & - ((DOT2 < 0._EB) .AND. (DOT3 < 0._EB) .AND. (DOT1 > 0._EB)) ) THEN - - ! Line 1, from node 1 to 2: - LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) - - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) - - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - - ! Line 2, from node 1 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) - - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) - - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT2 > 0._EB ) THEN ! Second case, counterclockwise p2 to p1 - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) - ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) - - CYCLE ! Next WSELEM - - ENDIF - ! Points 1,3 on one side of plane, point 2 on the other: - IF ( ((DOT1 > 0._EB) .AND. (DOT3 > 0._EB) .AND. (DOT2 < 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT3 < 0._EB) .AND. (DOT2 > 0._EB)) ) THEN - - ! Line 1, from node 1 to 2: - LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) - - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) - - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - - ! Line 2, from node 2 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) - - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) - - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT1 > 0._EB ) THEN ! Third case, counterclockwise p1 to p2 - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) - - CYCLE ! Next WSELEM + IF (TFACE(5)>1.0_EB-EPS_TEXTURE .AND. TFACE(1)1.0_EB-EPS_TEXTURE .AND. TFACE(3) 0._EB) .AND. (DOT3 > 0._EB)) .OR. & - ((DOT2 < 0._EB) .AND. (DOT3 < 0._EB)) ) ) THEN + IF (ABS(TFACE(2)-1.0_EB)<0.001_EB) THEN + TFACE(1) = (TFACE(3)+TFACE(5))/2.0_EB + ENDIF + IF (ABS(TFACE(4)-1.0_EB)<0.001_EB) THEN + TFACE(3) = (TFACE(1)+TFACE(5))/2.0_EB + ENDIF + IF (ABS(TFACE(6)-1.0_EB)<0.001_EB) THEN + TFACE(5) = (TFACE(1)+TFACE(3))/2.0_EB + ENDIF - ! First node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN + IF (ABS(TFACE(2))<0.001_EB) THEN + TFACE(1) = (TFACE(3)+TFACE(5))/2.0_EB + ENDIF + IF (ABS(TFACE(4))<0.001_EB) THEN + TFACE(3) = (TFACE(1)+TFACE(5))/2.0_EB + ENDIF + IF (ABS(TFACE(6))<0.001_EB) THEN + TFACE(5) = (TFACE(1)+TFACE(3))/2.0_EB + ENDIF - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +ENDDO IFACE_LOOP +END SUBROUTINE COMPUTE_TEXTURES - ! Add index to singles: - ! Find if oriented segment is in list: - INLIST = .FALSE. - DO ISGL=1,BODINT_PLANE%NSGLS - IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ISGL = BODINT_PLANE%NSGLS + 1 - BODINT_PLANE % NSGLS = ISGL - BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) - ENDIF +! ---------------------------- INIT_SPHERE2 ---------------------------------------- - CYCLE ! Next WSELEM +SUBROUTINE INIT_SPHERE2(N_VERTS, N_FACES, NLAT,NLONG,SPHERE_VERTS,SPHERE_FACES) +INTEGER, INTENT(IN) :: NLAT, NLONG +REAL(EB), INTENT(OUT), TARGET, DIMENSION(3*(NLONG*(NLAT-2) + 2)) :: SPHERE_VERTS +INTEGER, INTENT(OUT), TARGET, DIMENSION(3*(NLAT-1)*NLONG*2*2) :: SPHERE_FACES +INTEGER, INTENT(OUT) :: N_VERTS, N_FACES +REAL(EB) :: LAT, LONG +INTEGER :: ILONG, ILAT +REAL(EB) :: COSLAT(NLAT), SINLAT(NLAT) +REAL(EB) :: COSLONG(NLONG), SINLONG(NLONG) - ENDIF - ! Point 2 is on the plane: - IF ( (DOT2 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT3 > 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT3 < 0._EB)) ) ) THEN +INTEGER :: I , J, IJ, I11, I12, I21, I22 - ! Second node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN +N_VERTS = NLONG*(NLAT-2) + 2 +N_FACES = (NLAT-2)*NLONG*2 - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +IJ = 0 +DO I = 1, NLAT + LAT = PI/2.0_EB - PI*REAL(I-1,EB)/REAL(NLAT-1,EB) + COSLAT(I) = COS(LAT) + SINLAT(I) = SIN(LAT) +ENDDO +DO I = 1, NLONG + LONG = -PI + 2.0_EB*PI*REAL(I-1,EB)/REAL(NLONG,EB) + COSLONG(I) = COS(LONG) + SINLONG(I) = SIN(LONG) +ENDDO - ! Add index to singles: - ! Find if oriented segment is in list: - INLIST = .FALSE. - DO ISGL=1,BODINT_PLANE%NSGLS - IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ISGL = BODINT_PLANE%NSGLS + 1 - BODINT_PLANE % NSGLS = ISGL - BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) - ENDIF +! define vertices - CYCLE ! Next WSELEM +! north pole - ENDIF - ! Point 3 is on the plane: - IF ( (DOT3 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT2 > 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT2 < 0._EB)) ) ) THEN +SPHERE_VERTS(1:3) = (/0.0_EB,0.0_EB,1.0_EB/) - ! Third node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN +! middle latitudes - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +IJ = 4 +DO I = 2, NLAT-1 + DO J = 1, NLONG + SPHERE_VERTS(IJ:IJ+2) = (/COSLONG(J)*COSLAT(I),SINLONG(J)*COSLAT(I),SINLAT(I)/) + IJ = IJ + 3 + ENDDO +ENDDO - ! Add index to singles: - ! Find if single element is in list: - INLIST = .FALSE. - DO ISGL=1,BODINT_PLANE%NSGLS - IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ISGL = BODINT_PLANE%NSGLS + 1 - BODINT_PLANE % NSGLS = ISGL - BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) - ENDIF +! south pole - CYCLE ! Next WSELEM +SPHERE_VERTS(IJ:IJ+2) = (/0.0_EB,0.0_EB,-1.0_EB/) - ENDIF +! define faces - ! Case c: one node is part of the intersection: - ! Node 1 is in the plane: - IF ( (DOT1 == 0._EB) .AND. ( ((DOT2 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & - ((DOT2 < 0._EB) .AND. (DOT3 > 0._EB)) ) ) THEN +! faces connected to north pole +IJ=1 +DO ILONG = 1, NLONG + I11 = ILONG+1 + I12 = ILONG+2 + I22 = 1 + IF (ILONG==NLONG)I12=2 + SPHERE_FACES(IJ:IJ+2) = (/I22, I11,I12/) + IJ = IJ + 3 +ENDDO - ! First node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN +DO ILAT = 2, NLAT - 2 + DO ILONG = 1, NLONG - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + I11 = 1+ILONG+NLONG*(ILAT+1-2) + I21 = I11 + 1 + I12 = 1+ILONG+NLONG*(ILAT-2) + I22 = I12 + 1 + IF ( ILONG==NLONG) THEN + I21 = 1+1+NLONG*(ILAT+1-2) + I22 = 1+1+NLONG*(ILAT-2) + ENDIF - ! Line 2, from node 2 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) + SPHERE_FACES(IJ:IJ+2) = (/I12,I11,I22/) + SPHERE_FACES(IJ+3:IJ+5) = (/I22,I11,I21/) + IJ = IJ + 6 + ENDDO +ENDDO - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) +! faces connected to south pole - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +DO ILONG = 1, NLONG + I11 = ILONG+1 + NLONG*(NLAT-3) + I12 = I11 + 1 + I22 = NLONG*(NLAT-2)+2 + IF (ILONG==NLONG) I12=2+NLONG*(NLAT-3) + SPHERE_FACES(IJ:IJ+2) = (/I11,I22,I12/) + IJ = IJ + 3 +ENDDO +END SUBROUTINE INIT_SPHERE2 - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT2 > 0._EB ) THEN ! Second case, counterclockwise p2 to p1 - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) - ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) +! ---------------------------- REFINE_FACE ---------------------------------------- - CYCLE ! Next WSELEM +RECURSIVE SUBROUTINE REFINE_FACE(N_LEVELS,IFACE,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) - ENDIF - ! Node 2 is in the plane: - IF ( (DOT2 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT3 > 0._EB)) ) ) THEN +INTEGER, INTENT(IN) :: N_LEVELS +INTEGER, INTENT(IN) :: IFACE +INTEGER, INTENT(INOUT) :: N_VERTS, N_FACES +INTEGER, INTENT(IN) :: MAX_VERTS, MAX_FACES +REAL(EB), INTENT(INOUT), TARGET :: SPHERE_VERTS(3*MAX_VERTS) +INTEGER, INTENT(INOUT), TARGET :: SPHERE_FACES(3*MAX_FACES) - ! Second node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN +INTEGER, POINTER, DIMENSION(:) :: FACE1, FACE2, FACE3, FACE4 +REAL(EB), POINTER, DIMENSION(:) :: V1, V2, V3 +REAL(EB), POINTER, DIMENSION(:) :: V12, V13, V23 +INTEGER :: N1, N2, N3, N4 - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +IF (N_LEVELS==0 .OR. N_FACES+3>MAX_FACES .OR. N_VERTS+3>MAX_VERTS) RETURN ! prevent memory overwrites - ! Line 2, from node 1 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) +FACE1(1:3)=>SPHERE_FACES(3*IFACE-2:3*IFACE) ! original face and 1st new face +FACE2(1:3)=>SPHERE_FACES(3*N_FACES+1:3*N_FACES+3) ! 2nd new face +FACE3(1:3)=>SPHERE_FACES(3*N_FACES+4:3*N_FACES+6) ! 3rd new face +FACE4(1:3)=>SPHERE_FACES(3*N_FACES+7:3*N_FACES+9) ! 4th new face - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) +V1(1:3)=>SPHERE_VERTS(3*FACE1(1)-2:3*FACE1(1)) ! FACE1(1) +V2(1:3)=>SPHERE_VERTS(3*FACE1(2)-2:3*FACE1(2)) ! FACE1(2) +V3(1:3)=>SPHERE_VERTS(3*FACE1(3)-2:3*FACE1(3)) ! FACE1(3) - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +V12(1:3)=>SPHERE_VERTS(3*N_VERTS+1:3*N_VERTS+3) +V13(1:3)=>SPHERE_VERTS(3*N_VERTS+4:3*N_VERTS+6) +V23(1:3)=>SPHERE_VERTS(3*N_VERTS+7:3*N_VERTS+9) - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT1 > 0._EB ) THEN - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) +V12 = (V1+V2)/2.0_EB +V13 = (V1+V3)/2.0_EB +V23 = (V2+V3)/2.0_EB +V12 = V12/NORM2(V12) ! N_VERTS + 1 +V13 = V13/NORM2(V13) ! N_VERTS + 2 +V23 = V23/NORM2(V23) ! N_VERTS + 3 - CYCLE ! Next WSELEM +! split triangle 123 into 4 triangles - ENDIF - ! Node 3 is in the plane: - IF ( (DOT3 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT2 < 0._EB)) .OR. & - ((DOT1 < 0._EB) .AND. (DOT2 > 0._EB)) ) ) THEN +! 1 +! /F1\ . +! 12----13 +! /F2\F3/F4\ i. +! 2 --- 23----3 - ! Third node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN +FACE2(1:3) = (/N_VERTS+1,FACE1(2),N_VERTS+3/) +FACE3(1:3) = (/N_VERTS+1,N_VERTS+3,N_VERTS+2/) +FACE4(1:3) = (/N_VERTS+2,N_VERTS+3,FACE1(3)/) +FACE1(1:3) = (/ FACE1(1),N_VERTS+1,N_VERTS+2/) - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +N1 = IFACE +N2 = N_FACES+1 +N3 = N_FACES+2 +N4 = N_FACES+3 - ! Line 2, from node 1 to 2: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) +N_FACES = N_FACES + 3 +N_VERTS = N_VERTS + 3 +IF (N_LEVELS==1) RETURN ! stop recursion - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) +CALL REFINE_FACE(N_LEVELS-1,N1,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +CALL REFINE_FACE(N_LEVELS-1,N2,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +CALL REFINE_FACE(N_LEVELS-1,N3,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +CALL REFINE_FACE(N_LEVELS-1,N4,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +END SUBROUTINE REFINE_FACE - ! Now add segment: - NSEGS = BODINT_PLANE % NSEGS + 1 - BODINT_PLANE % NSEGS = NSEGS - IF ( DOT1 > 0._EB ) THEN - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) - ELSE - BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) - ENDIF - BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) - BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) +! ---------------------------- COMPUTE_TEXTURE ---------------------------------------- - CYCLE ! Next WSELEM +SUBROUTINE COMPUTE_TEXTURE(XYZ,TEXT_COORDS) +REAL(EB), INTENT(IN), DIMENSION(3) :: XYZ +REAL(EB), INTENT(OUT), DIMENSION(2) :: TEXT_COORDS +REAL(EB), DIMENSION(2) :: ANGLES +REAL(EB) :: NORM2_XYZ, Z_ANGLE - ENDIF - ENDIF ONLY_TRIANG_EDGES_COND +NORM2_XYZ = NORM2(XYZ) +IF (NORM2_XYZ < TWENTY_EPSILON_EB) THEN + Z_ANGLE = 0.0_EB +ELSE + Z_ANGLE = ASIN(XYZ(3)/NORM2_XYZ) +ENDIF +ANGLES = (/ATAN2(XYZ(2),XYZ(1)),Z_ANGLE/) - ! Case D: A triangle segment is in the plane. - ! Intersection is line 1-2: - IF ( (DOT1 == 0._EB) .AND. (DOT2 == 0._EB) ) THEN +!convert back to texture coordinates +TEXT_COORDS = (/ 0.5_EB + 0.5_EB*ANGLES(1)/PI,0.5_EB + ANGLES(2)/PI /) +END SUBROUTINE COMPUTE_TEXTURE - ! First node: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN +! ---------------------------- GET_GEOM_ID ---------------------------------------- - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +INTEGER FUNCTION GET_GEOM_ID(ID,N_LAST) - ! Second node: - XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT2(X1AXIS) = X1PLN +! return the index of the geometry array with label ID - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +CHARACTER(30), INTENT(IN) :: ID +INTEGER, INTENT(IN) :: N_LAST - ! Set oriented segment regarding plane: - IF ( DOT3 > 0._EB ) THEN - SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - ! Find if oriented segment is in list: - EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG1,IWSEL) ! 1st edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. - VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) - VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) - VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) - INLIST = .FALSE. - DO ISEG=1,BODINT_PLANE%NSEGS - FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & - ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) - IF ( FOUND_SEG .AND. & - (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & - (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & - (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ISEG = BODINT_PLANE%NSEGS + 1 - BODINT_PLANE%NSEGS = ISEG - BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG - BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) - ENDIF +INTEGER :: N +TYPE(GEOMETRY_TYPE), POINTER :: G - CYCLE ! Next WSELEM +GET_GEOM_ID = 0 +DO N=1,N_LAST + G=>GEOMETRY(N) + IF (TRIM(G%ID)==TRIM(ID)) THEN + GET_GEOM_ID = N + RETURN + ENDIF +ENDDO +END FUNCTION GET_GEOM_ID - ENDIF - ! Intersection is line 2-3: - IF ( (DOT2 == 0._EB) .AND. (DOT3 == 0._EB) ) THEN +! ---------------------------- GEOMCLIPS ---------------------------------------- - ! Second node: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN +SUBROUTINE GEOMCLIPS +USE BOXTETRA_ROUTINES, ONLY : GEOMCLIP +REAL(EB) :: XB(6) +INTEGER :: I +TYPE(GEOMETRY_TYPE), POINTER :: G - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + ! clip geometries to mesh - ! Third node: - XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT2(X1AXIS) = X1PLN +XB(1)=-1.0 +XB(2)=0.0 +XB(3)=-1.0 +XB(4)=0.0 +XB(5)=0.0 +XB(6)=1.0 +DO I = 1, N_GEOMETRY + G=>GEOMETRY(I) + CALL GEOMCLIP(G%VERTS, G%N_VERTS, G%FACES, G%N_FACES, XB) +END DO +END SUBROUTINE GEOMCLIPS - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +! ---------------------------- PROCESS_GEOM ---------------------------------------- - ! Set oriented segment regarding plane: - IF ( DOT1 > 0._EB ) THEN - SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - ! Find if oriented segment is in list: - EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG2,IWSEL) ! 2nd edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. - VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) - VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) - VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) - INLIST = .FALSE. - DO ISEG=1,BODINT_PLANE%NSEGS - FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & - ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) - IF ( FOUND_SEG .AND. & - (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & - (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & - (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ISEG = BODINT_PLANE%NSEGS + 1 - BODINT_PLANE%NSEGS = ISEG - BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG - BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) - ENDIF +SUBROUTINE PROCESS_GEOM(IS_DYNAMIC,TIME, N_VERTS, N_FACES, N_VOLUS) - CYCLE ! Next WSELEM +USE GEOMETRY_FUNCTIONS, ONLY: TRANSFORM_COORDINATES - ENDIF - ! Intersection is line 3-1: - IF ( (DOT3 == 0._EB) .AND. (DOT1 == 0._EB) ) THEN +! transform (scale, rotate and translate) vectors found on each &GEOM line - ! Third node: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN + LOGICAL, INTENT(IN) :: IS_DYNAMIC + REAL(EB), INTENT(IN) :: TIME + INTEGER, INTENT(OUT) :: N_VERTS, N_FACES, N_VOLUS - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + INTEGER :: I, IVERT, IMOVE, MOVE_INDEX, IFACE + TYPE(GEOMETRY_TYPE), POINTER :: G + REAL(EB) :: DELTA_T, VEC(1:3) ! M(3,3) + TYPE(MOVEMENT_TYPE), POINTER :: MV - ! First node: - XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT2(X1AXIS) = X1PLN + IF (IS_DYNAMIC) THEN + DELTA_T = TIME - T_BEGIN + ELSE + DELTA_T = 0.0_EB + ENDIF - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + DO I = 1, N_GEOMETRY + G=>GEOMETRY(I) + IF ((IS_DYNAMIC .AND. G%IS_DYNAMIC) .OR. (.NOT.IS_DYNAMIC .AND. .NOT.G%IS_DYNAMIC)) THEN + G%N_VERTS = G%N_VERTS_BASE + G%N_FACES = G%N_FACES_BASE + G%N_VOLUS = G%N_VOLUS_BASE + ENDIF + ENDDO - ! Set oriented segment regarding plane: - IF ( DOT2 > 0._EB ) THEN - SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) - ELSE - SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) - ENDIF - ! Find if oriented segment is in list: - EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG3,IWSEL) ! 3rd edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. - VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) - VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) - VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) - INLIST = .FALSE. - DO ISEG=1,BODINT_PLANE%NSEGS - FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & - ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) - IF ( FOUND_SEG .AND. & - (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & - (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & - (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN - INLIST = .TRUE. + DO I = 1, N_GEOMETRY + G=>GEOMETRY(I) + IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE + IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE + MOVE_INDEX = 0 + IF (TRIM(G%MOVE_ID)/='null') THEN + DO IMOVE=1,N_MOVE + IF (TRIM(G%MOVE_ID)==TRIM(MOVEMENT(IMOVE)%ID)) THEN + MOVE_INDEX = MOVEMENT(IMOVE)%INDEX EXIT ENDIF ENDDO - IF (.NOT.INLIST) THEN - ISEG = BODINT_PLANE%NSEGS + 1 - BODINT_PLANE%NSEGS = ISEG - BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG - BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) + IF (MOVE_INDEX==0) THEN + WRITE(MESSAGE,'(A,A,A)') 'ERROR(725): &GEOM ',TRIM(G%ID),' MOVE_ID is not recognized' + CALL SHUTDOWN(MESSAGE) ; RETURN + ENDIF + DO IVERT=1,G%N_VERTS + VEC(1:3) = G%VERTS_BASE(3*IVERT-2:3*IVERT) + CALL TRANSFORM_COORDINATES(VEC(1),VEC(2),VEC(3),MOVE_INDEX,1) ! Eventually, time varying motion dealt with here. + G%VERTS(3*IVERT-2:3*IVERT) = VEC(1:3) + ENDDO + ! Swap face connectivities if we have reflections: + MV => MOVEMENT(MOVE_INDEX) + IF (MV%DET < -TWENTY_EPSILON_EB) THEN ! Swap vertices 2 and 3: + DO IFACE=1,G%N_FACES + IVERT = G%FACES(3*(IFACE-1)+2) + G%FACES(3*(IFACE-1)+2) = G%FACES(3*(IFACE-1)+3) + G%FACES(3*(IFACE-1)+3) = IVERT + ENDDO ENDIF + ELSE + DO IVERT=1,G%N_VERTS + G%VERTS(3*IVERT-2:3*IVERT) = G%VERTS_BASE(3*IVERT-2:3*IVERT) + ENDDO + ENDIF - CYCLE ! Next WSELEM + ENDDO - ENDIF + ! remove this if statement when GEOMCLIPS is ready for use + IF ( I .EQ. 0 ) THEN + CALL GEOMCLIPS + ENDIF - ! If you get to this point -> you have a problem: - IF (.NOT.TRI_ONPLANE_ONLY) print*, "Error GET_BODINT_PLANE: Missed wet surface Triangle =",IWSEL + CALL GEOM2TEXTURE - ENDDO ! IWSEL + N_VERTS = 0 + N_FACES = 0 + N_VOLUS = 0 + DO I = 1, N_GEOMETRY ! count vertices and faces + G=>GEOMETRY(I) + IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE + IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE + N_VERTS = N_VERTS + G%N_VERTS + N_FACES = N_FACES + G%N_FACES + N_VOLUS = N_VOLUS + G%N_VOLUS + ENDDO - EXIT IBIN_DO ! No need to test more bins. +END SUBROUTINE PROCESS_GEOM - ENDDO IBIN_DO +! ---------------------------- GEOM2TEXTURE ---------------------------------------- -ENDDO MAIN_GEOM_LOOP +SUBROUTINE GEOM2TEXTURE + INTEGER :: I,J,K,JJ + TYPE(GEOMETRY_TYPE), POINTER :: G + REAL(EB), POINTER, DIMENSION(:) :: XYZ, TFACES + INTEGER, POINTER, DIMENSION(:) :: FACES + INTEGER :: SURF_INDEX + TYPE(SURFACE_TYPE), POINTER :: SF + DO I = 1, N_GEOMETRY + G=>GEOMETRY(I) + IF (G%TEXTURE_MAPPING/='RECTANGULAR') CYCLE + DO J = 0, G%N_FACES-1 + SURF_INDEX = G%SURFS(1+J) + SF=>SURFACE(SURF_INDEX) + IF (TRIM(SF%TEXTURE_MAP)=='null') CYCLE + FACES(1:3)=>G%FACES(1+3*J:3+3*J) + TFACES(1:6)=>G%TFACES(1+6*J:6+6*J) + DO K = 0, 2 + JJ = FACES(1+K) -! Next step is to Test triangles sides normals on plane against the obtained -! segments normals. If two identical segments found contain oposite -! normals, drop the segment in BODINT_PLANE%SEGS: -IF ( BODINT_PLANE%NTRIS > 0 ) THEN + XYZ(1:3) => G%VERTS(3*JJ-2:3*JJ) + TFACES(1+2*K:2+2*K) = (XYZ(1:2) - G%TEXTURE_ORIGIN(1:2))/G%TEXTURE_SCALE(1:2) + ENDDO + ENDDO + ENDDO +END SUBROUTINE GEOM2TEXTURE - DO ITRI=1,BODINT_PLANE%NTRIS +! ---------------------------- MERGE_GEOMS ---------------------------------------- - ! Triang conectivities: - ELEM(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) +SUBROUTINE MERGE_GEOMS(VERTS,N_VERTS,FACES,TFACES,GEOM_IDS,SURF_IDS,N_FACES,VOLUS,MATL_IDS,N_VOLUS,IS_DYNAMIC) - ! Coordinates in x2, x3 directions: - X2X3(IAXIS,NOD1:NOD3) = (/ BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD1)), & - BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD2)), & - BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD3)) /) - X2X3(JAXIS,NOD1:NOD3) = (/ BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD1)), & - BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD2)), & - BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD3)) /) +! combine vectors and faces found on all &GEOM lines into one set of VECTOR and FACE arrays - ! Test Area sign, if -ve switch node order: - AREALOC = 0.5_EB*(X2X3(IAXIS,NOD1)*X2X3(JAXIS,NOD2) - X2X3(IAXIS,NOD2)*X2X3(JAXIS,NOD1) + & - X2X3(IAXIS,NOD2)*X2X3(JAXIS,NOD3) - X2X3(IAXIS,NOD3)*X2X3(JAXIS,NOD2) + & - X2X3(IAXIS,NOD3)*X2X3(JAXIS,NOD1) - X2X3(IAXIS,NOD1)*X2X3(JAXIS,NOD3)) - IF (AREALOC < 0._EB) THEN - ISEG = ELEM(3) - ELEM(3) = ELEM(2) - ELEM(2) = ISEG - ENDIF +INTEGER, INTENT(IN) :: N_VERTS, N_FACES, N_VOLUS +LOGICAL, INTENT(IN) :: IS_DYNAMIC +REAL(EB), DIMENSION(:), INTENT(OUT) :: VERTS(3*N_VERTS), TFACES(6*N_FACES) +INTEGER, DIMENSION(:), INTENT(OUT) :: FACES(3*N_FACES), VOLUS(4*N_VOLUS), MATL_IDS(N_VOLUS), GEOM_IDS(N_FACES), SURF_IDS(N_FACES) - ! Now corresponding segments, ordered normal outside of plane x2-x3. - EDGES(NOD1:NOD2,1) = (/ ELEM(1), ELEM(2) /) ! edge 1. - EDGES(NOD1:NOD2,2) = (/ ELEM(2), ELEM(3) /) ! edge 2. - EDGES(NOD1:NOD2,3) = (/ ELEM(3), ELEM(1) /) +INTEGER :: I +TYPE(GEOMETRY_TYPE), POINTER :: G +INTEGER :: IVERT, ITFACE, IFACE, IVOLUS, IMATL, IGEOM, ISURF, OFFSET - ! Now Test against segments, Beast approach: - DO IEDGE=1,3 - DO ISEG=1,BODINT_PLANE%NSEGS - IF ( (BODINT_PLANE%SEGS(NOD1,ISEG) == EDGES(NOD2,IEDGE)) .AND. & - (BODINT_PLANE%SEGS(NOD2,ISEG) == EDGES(NOD1,IEDGE)) ) THEN ! Edge normals - ! oriented in opposite dirs. - ! Set to SOLID SOLID segtype from BODINT_PLANE.SEGS - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG)=(/ CC_SOLID, CC_SOLID /) +IVERT = 0 +ITFACE = 0 +IFACE = 0 +IVOLUS = 0 +IGEOM = 0 +ISURF = 0 +IMATL = 0 +OFFSET = 0 +DO I = 1, N_GEOMETRY + G=>GEOMETRY(I) + IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE + IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE - ENDIF - ENDDO - ENDDO + IF (G%N_VERTS>0) THEN + VERTS(1+IVERT:3*G%N_VERTS+IVERT) = G%VERTS(1:3*G%N_VERTS) + IVERT = IVERT + 3*G%N_VERTS + ENDIF + IF (G%N_FACES>0) THEN + FACES(1+IFACE:3*G%N_FACES + IFACE) = G%FACES(1:3*G%N_FACES)+OFFSET + IFACE = IFACE + 3*G%N_FACES - ENDDO -ENDIF + TFACES(1+ITFACE:6*G%N_FACES + ITFACE) = G%TFACES(1:6*G%N_FACES) + ITFACE = ITFACE + 6*G%N_FACES -! For segments that are related to 2 Wet Surface triangles, test if they are of type GG or SS: -DO ISEG=1,BODINT_PLANE%NSEGS - IF (BODINT_PLANE%INDSEG(1,ISEG) > 1) THEN ! Related to 2 WS triangles: + GEOM_IDS(1+IGEOM:G%N_FACES+IGEOM) = I + IGEOM = IGEOM + G%N_FACES - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + SURF_IDS(1+ISURF:G%N_FACES+ISURF) = G%SURFS(1:G%N_FACES) + ISURF = ISURF + G%N_FACES + ENDIF + IF (G%N_VOLUS>0) THEN + VOLUS(1+IVOLUS:4*G%N_VOLUS + IVOLUS) = G%VOLUS(1:4*G%N_VOLUS)+OFFSET + IVOLUS = IVOLUS + 4*G%N_VOLUS - ! Segment nodes positions: - XP1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/X2AXIS,X3AXIS/) ,SEG(NOD1)) - XP2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/X2AXIS,X3AXIS/) ,SEG(NOD2)) + MATL_IDS(1+IMATL:G%N_VOLUS+IMATL) = G%MATLS(1:G%N_VOLUS) + IMATL = IMATL + G%N_VOLUS + ENDIF + OFFSET = OFFSET + G%N_VERTS +ENDDO - ! Unit normal versor along x2p (axis directed from NOD2 to NOD1): - NMTX2P = SQRT( (XP1(IAXIS)-XP2(IAXIS))**2._EB + (XP1(JAXIS)-XP2(JAXIS))**2._EB ) - TX2P(IAXIS:JAXIS) = (XP1(IAXIS:JAXIS)-XP2(IAXIS:JAXIS)) * NMTX2P**(-1._EB) - ! Versor along x3p. - TX3P(IAXIS:JAXIS) = (/ -TX2P(JAXIS), TX2P(IAXIS) /) +END SUBROUTINE MERGE_GEOMS - ! Now related WS triangles centroids: - IWSEL1 = BODINT_PLANE%INDSEG(2,ISEG) - IWSEL2 = BODINT_PLANE%INDSEG(3,ISEG) - IG = BODINT_PLANE%INDSEG(4,ISEG) +! ---------------------------- CONVERTGEOM ---------------------------------------- - ! Centroid of WS elem 1: - ELEM1(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL1-1)+1:NODS_WSEL*IWSEL1) - XYZ1(IAXIS:KAXIS) = ( GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD1)-1)+1:MAX_DIM*ELEM1(NOD1)) + & - GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD2)-1)+1:MAX_DIM*ELEM1(NOD2)) + & - GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD3)-1)+1:MAX_DIM*ELEM1(NOD3)) ) / 3._EB - NXYZ1(IAXIS:KAXIS)= GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL1) - ! Normal versor in x3p-x1 direction: - NX3P1 = TX3P(IAXIS)*NXYZ1(X2AXIS) + TX3P(JAXIS)*NXYZ1(X3AXIS) - N1(IAXIS:JAXIS) = (/ NX3P1, NXYZ1(X1AXIS) /) - NMNL = SQRT( N1(IAXIS)**2._EB + N1(JAXIS)**2._EB ) - N1 = N1 * NMNL**(-1._EB) +SUBROUTINE CONVERTGEOM(TIME) - ! Centroid of WS elem 2: - ELEM2(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL2-1)+1:NODS_WSEL*IWSEL2) - XYZ2(IAXIS:KAXIS) = ( GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD1)-1)+1:MAX_DIM*ELEM2(NOD1)) + & - GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD2)-1)+1:MAX_DIM*ELEM2(NOD2)) + & - GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD3)-1)+1:MAX_DIM*ELEM2(NOD3)) ) / 3._EB - NXYZ2(IAXIS:KAXIS)= GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL2) - ! Normal versor in x3p-x1 direction: - NX3P2 = TX3P(IAXIS)*NXYZ2(X2AXIS) + TX3P(JAXIS)*NXYZ2(X3AXIS) - N2(IAXIS:JAXIS) = (/ NX3P2, NXYZ2(X1AXIS) /) - NMNL = SQRT( N2(IAXIS)**2._EB + N2(JAXIS)**2._EB ) - N2 = N2 * NMNL**(-1._EB) +REAL(EB), INTENT(IN) :: TIME - ! Define points in plane x3p-x1: - ! vertex point: - X3PVERT = TX3P(IAXIS)*XP1(IAXIS) + TX3P(JAXIS)*XP1(JAXIS) - PVERT(IAXIS:JAXIS) = (/ X3PVERT, X1PLN /) - ! First triangle centroid: - X3P1 = TX3P(IAXIS)*XYZ1(X2AXIS) + TX3P(JAXIS)*XYZ1(X3AXIS) - P1CEN(IAXIS:JAXIS) = (/ X3P1, XYZ1(X1AXIS) /) - ! Second triangle centroid: - X3P2 = TX3P(IAXIS)*XYZ2(X2AXIS) + TX3P(JAXIS)*XYZ2(X3AXIS) - P2CEN(IAXIS:JAXIS) = (/ X3P2, XYZ2(X1AXIS) /) +INTEGER :: N_VERTS, N_FACES, N_VOLUS +INTEGER :: N_VERTS_S, N_FACES_S, N_VOLUS_S +INTEGER :: N_VERTS_D, N_FACES_D, N_VOLUS_D +INTEGER, ALLOCATABLE, DIMENSION(:) :: VOLUS, FACES, MATL_IDS, SURF_IDS, GEOM_IDS +REAL(EB), ALLOCATABLE, DIMENSION(:) :: VERTS, TFACES +INTEGER :: IZERO - VCT(1:2) = 0 - PCT(IAXIS:JAXIS,1:2) = 0._EB +CALL PROCESS_GEOM(.FALSE.,TIME, N_VERTS_S, N_FACES_S, N_VOLUS_S) ! scale, rotate, translate static GEOM vertices +CALL PROCESS_GEOM( .TRUE.,TIME, N_VERTS_D, N_FACES_D, N_VOLUS_D) ! scale, rotate, translate dynamic GEOM vertices - ! Segment on triangle 1: - V1(IAXIS:JAXIS) = P1CEN(IAXIS:JAXIS) - PVERT(IAXIS:JAXIS) - CRSSNV = N1(IAXIS)*V1(JAXIS) - N1(JAXIS)*V1(IAXIS) - IF (CRSSNV > 0._EB) THEN - ! v1 stays as is, and is second segment: - VEC(IAXIS:JAXIS,2) = V1(IAXIS:JAXIS) - PCT(IAXIS:JAXIS,2) = P1CEN(IAXIS:JAXIS) - VCT(2) = 1 - ELSE - ! -v1 is the first segment: - VEC(IAXIS:JAXIS,1) = -V1(IAXIS:JAXIS) - PCT(IAXIS:JAXIS,1) = P1CEN(IAXIS:JAXIS) - VCT(1) = 1 - ENDIF +N_VERTS = N_VERTS_S + N_VERTS_D +N_FACES = N_FACES_S + N_FACES_D +N_VOLUS = N_VOLUS_S + N_VOLUS_D - ! Segment on triangle 2: - V2(IAXIS:JAXIS) = P2CEN(IAXIS:JAXIS) - PVERT(IAXIS:JAXIS) - CRSSNV = N2(IAXIS)*V2(JAXIS) - N2(JAXIS)*V2(IAXIS) - IF (CRSSNV > 0._EB) THEN - ! v2 stays as is, and is second segment: - VEC(IAXIS:JAXIS,2) = V2(IAXIS:JAXIS) - PCT(IAXIS:JAXIS,2) = P2CEN(IAXIS:JAXIS) - VCT(2) = 1 - ELSE - ! -v2 is the first segment: - VEC(IAXIS:JAXIS,1) = -V2(IAXIS:JAXIS) - PCT(IAXIS:JAXIS,1) = P2CEN(IAXIS:JAXIS) - VCT(1) = 1 - ENDIF +ALLOCATE(VERTS(MAX(1,3*N_VERTS)),STAT=IZERO) ! create arrays to contain all vertices and faces +CALL ChkMemErr('CONVERTGEOM','VERTS',IZERO) + +ALLOCATE(TFACES(MAX(1,6*N_FACES)),STAT=IZERO) ! create arrays to contain all vertices and faces +CALL ChkMemErr('CONVERTGEOM','TVERTS',IZERO) - IF ( (VCT(1) == 0) .OR. (VCT(2) == 0) ) THEN - print*, "Error GET_BODINT_PLANE: One component of vct == 0." - ENDIF +ALLOCATE(FACES(MAX(1,3*N_FACES)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','FACES',IZERO) - ! Cross product of v1 and v2 gives magnitude along x2p axis: - CTST = VEC(IAXIS,1)*VEC(JAXIS,2) - VEC(JAXIS,1)*VEC(IAXIS,2) +ALLOCATE(SURF_IDS(MAX(1,N_FACES)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','SURF_IDS',IZERO) - ! Now tests: - ! Start with SOLID GASPHASE definition for segtype: - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_GASPHASE /) +ALLOCATE(GEOM_IDS(MAX(1,N_FACES)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','SURF_IDS',IZERO) - ! Test for SOLID SOLID condition: - IF ( ((PCT(JAXIS,1)-X1PLN) > -GEOMEPS) .AND. & - ((PCT(JAXIS,2)-X1PLN) > -GEOMEPS) .AND. (CTST < GEOMEPS) ) THEN - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_SOLID /) - CYCLE - ELSEIF (((PCT(JAXIS,1)-X1PLN) < GEOMEPS) .AND. & - ((PCT(JAXIS,2)-X1PLN) < GEOMEPS) .AND. (CTST < GEOMEPS) ) THEN - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_SOLID /) - CYCLE - ENDIF +ALLOCATE(VOLUS(MAX(1,4*N_VOLUS)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','VOLUS',IZERO) - ! Test for GASPHASE GASPHASE condition: - IF ( ((PCT(JAXIS,1)-X1PLN) > GEOMEPS) .AND. & - ((PCT(JAXIS,2)-X1PLN) > GEOMEPS) .AND. (CTST > GEOMEPS) ) THEN - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_GASPHASE, CC_GASPHASE /) - CYCLE - ELSEIF (((PCT(JAXIS,1)-X1PLN) < -GEOMEPS) .AND. & - ((PCT(JAXIS,2)-X1PLN) < -GEOMEPS) .AND. (CTST > GEOMEPS) ) THEN - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_GASPHASE, CC_GASPHASE /) - CYCLE - ENDIF +ALLOCATE(MATL_IDS(MAX(1,N_VOLUS)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','MATL_IDS',IZERO) - ENDIF -ENDDO +IF (N_VERTS_S>0 .AND. (N_FACES_S>0 .OR. N_VOLUS_S>0)) THEN ! merge static geometry + CALL MERGE_GEOMS(VERTS(1:3*N_VERTS_S),N_VERTS_S,& + FACES(1:3*N_FACES_S),TFACES(1:3*N_FACES_S),GEOM_IDS(1:N_FACES_S),SURF_IDS(1:N_FACES_S),N_FACES_S,& + VOLUS(1:3*N_VOLUS_S),MATL_IDS(1:N_VOLUS_S),N_VOLUS_S,.FALSE.) +ENDIF +IF (N_VERTS_D>0 .AND. (N_FACES_D>0 .OR. N_VOLUS_D>0)) THEN ! merge dynamic geometry + CALL MERGE_GEOMS(VERTS(3*N_VERTS_S+1:3*N_VERTS),N_VERTS_D,& + FACES(3*N_FACES_S+1:3*N_FACES),TFACES(3*N_FACES_S+1:3*N_FACES),GEOM_IDS,SURF_IDS(N_FACES_S+1:N_FACES),N_FACES_D,& + VOLUS(3*N_VOLUS_S+1:3*N_VOLUS),MATL_IDS(N_VOLUS_S+1:N_VOLUS),N_VOLUS_D,.TRUE.) +ENDIF +RETURN +END SUBROUTINE CONVERTGEOM -! For the time being, as BODINT_PLANE is used to create Cartesian face cut-faces -! We eliminate from the list the SEGTYPE=[SOLID SOLID] segments: -ALLOCATE(SEGAUX(NOD1:NOD2,BODINT_PLANE%NSEGS)) -ALLOCATE(INDSEGAUX(CC_MAX_WSTRIANG_SEG+2,BODINT_PLANE%NSEGS)) -ALLOCATE(SEGTYPEAUX(NOD1:NOD2,BODINT_PLANE%NSEGS)) +! ---------------------------- REORDER_FACE ---------------------------------------- -ISEG_NEW = 0 -IF(.NOT.TRI_ONPLANE_ONLY) THEN - DO ISEG=1,BODINT_PLANE%NSEGS - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) - IF( NORM2(XYZ2((/X2AXIS,X3AXIS/))-XYZ1((/X2AXIS,X3AXIS/))) < 0.1_EB*GEOMEPS) CYCLE - IF ( (BODINT_PLANE%SEGTYPE(NOD1,ISEG) == CC_SOLID) .AND. & - (BODINT_PLANE%SEGTYPE(NOD2,ISEG) == CC_SOLID) ) CYCLE +SUBROUTINE REORDER_VERTS(VERTS) +! the VERTS triplet V1, V2, V3 defines a face +! reorder V1,V2,V3 so that V1 has the smallest index +INTEGER, INTENT(INOUT) :: VERTS(3) - ISEG_NEW = ISEG_NEW + 1 - SEGAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+2,ISEG_NEW) = & - BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) - SEGTYPEAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) - ENDDO -ELSE - DO ISEG=1,BODINT_PLANE%NSEGS - IF ( (BODINT_PLANE%SEGTYPE(NOD1,ISEG) == CC_SOLID) .AND. & - (BODINT_PLANE%SEGTYPE(NOD2,ISEG) == CC_SOLID) ) THEN +INTEGER :: VERTS_TEMP(5) - ISEG_NEW = ISEG_NEW + 1 - SEGAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+2,ISEG_NEW) = & - BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) - SEGTYPEAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) - ENDIF - ENDDO +IF ( VERTS(1)0 .AND. (N_FACES>0 .OR. N_VOLUS>0)) THEN + CALL MERGE_GEOMS(VERTS,N_VERTS,FACES,TFACES,GEOM_IDS,SURF_IDS,N_FACES,VOLUS,MATL_IDS,N_VOLUS,IS_DYNAMIC) ENDIF - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) + WRITE(LUNIT) REAL(TIME,FB) + WRITE(LUNIT) N_VERTS, N_FACES, N_VOLUS + IF (N_VERTS>0) THEN + IF (APPLY_TRAN) THEN + DO I = 1, N_VERTS + VERTS(3*I) = VERTS(3*I) + TRAN%Z_OFFSET + ENDDO + ENDIF + WRITE(LUNIT) (REAL(VERTS(I),FB), I=1,3*N_VERTS) + ENDIF + IF (N_FACES>0) THEN + WRITE(LUNIT) (FACES(I), I=1,3*N_FACES) + WRITE(LUNIT) (SURF_IDS(I), I=1,N_FACES) + WRITE(LUNIT) (REAL(TFACES(I),FB), I=1,6*N_FACES) - ! Is segment aligned with x3 direction? - BODINT_PLANE%X3ALIGNED(ISEG) = (ABS(XYZ2(X2AXIS)-XYZ1(X2AXIS)) < GEOMEPS) - ! Is segment aligned with x2 rays?: - BODINT_PLANE%X2ALIGNED(ISEG) = (ABS(XYZ2(X3AXIS)-XYZ1(X3AXIS)) < GEOMEPS) + WRITE(LUNIT2) N_FACES + WRITE(LUNIT2) (GEOM_IDS(I), I=1,N_FACES) + ENDIF + IF (N_VOLUS>0) THEN + WRITE(LUNIT) (VOLUS(I), I=1,4*N_VOLUS) + WRITE(LUNIT) (MATL_IDS(I), I=1,N_VOLUS) + ENDIF - ! x2_x3 of segment point 1: - X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) - ! x2_x3 of segment point 2: - X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) +END SUBROUTINE OUTGEOM - ! Segment length: - SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) - MEAN_SLEN = MEAN_SLEN + SLEN +! ---------------------------- WRITE_GEOM_ALL ------------------------------------ - ! First node: - SBOD = 0._EB - ! Add crossing to BODINT_PLANE: - NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + 1 - BODINT_PLANE%NBCROSS(ISEG) = NBCROSS - BODINT_PLANE%SVAR(NBCROSS,ISEG) = SBOD +SUBROUTINE WRITE_GEOM_ALL +CALL WRITE_GEOM(T_BEGIN) ! write out both static and dynamic data at t=T_BEGIN +END SUBROUTINE WRITE_GEOM_ALL - ! Second node: - SBOD = SLEN - ! Add crossing to BODINT_PLANE: - NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + 1 - BODINT_PLANE%NBCROSS(ISEG) = NBCROSS - BODINT_PLANE%SVAR(NBCROSS,ISEG) = SBOD +! ---------------------------- WRITE_GEOM ---------------------------------------- -ENDDO +SUBROUTINE WRITE_GEOM(TIME) -! Spread Segments in BINs in the x2-x3 directions: -MEAN_SLEN = MEAN_SLEN / REAL(BODINT_PLANE%NSEGS,EB) -VAXIS(IAXIS:JAXIS) = (/ X2AXIS, X3AXIS /) -DO I = 1,2 - AXIS = VAXIS(I) - LXI = BODINT_PLANE%BOX(HIGH_IND,AXIS)-BODINT_PLANE%BOX(LOW_IND,AXIS) - IF (BODINT_PLANE%NSEGS < 100) THEN - BODINT_PLANE%TBAXIS(AXIS)%N_BINS = MAX(1 ,CEILING(LXI/(MEAN_SLEN))) - ELSE - BODINT_PLANE%TBAXIS(AXIS)%N_BINS = MAX(10,CEILING(LXI/(MEAN_SLEN))) - ENDIF +! output geometries to a .ge file + +REAL(EB), INTENT(IN) :: TIME +INTEGER :: ONE=1, ZERO=0, VERSION=2 +TYPE(TRANSFORM_TYPE), POINTER :: T + +IF (N_GEOMETRY<=0) RETURN + +IF (WRITE_GEOM_FIRST) THEN + OPEN(LU_GEOM(1),FILE=TRIM(FN_GEOM(1)),FORM='UNFORMATTED',STATUS='REPLACE') + OPEN(LU_GEOM(2),FILE=TRIM(FN_GEOM(2)),FORM='UNFORMATTED',STATUS='REPLACE') + WRITE(LU_GEOM(1)) ONE + WRITE(LU_GEOM(1)) VERSION + WRITE(LU_GEOM(1)) ZERO, ZERO, ONE ! n floats, n ints, first frame static + CALL OUTGEOM(LU_GEOM(1),LU_GEOM(2),.FALSE.,TIME,.FALSE.,T) ! write out static data +ELSE + OPEN(LU_GEOM(1),FILE=TRIM(FN_GEOM(1)),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND') + OPEN(LU_GEOM(2),FILE=TRIM(FN_GEOM(2)),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND') +ENDIF +CALL OUTGEOM(LU_GEOM(1),LU_GEOM(2),.TRUE.,TIME,.FALSE.,T) ! write out dynamic data +CLOSE(LU_GEOM(1)) +CLOSE(LU_GEOM(2)) - ! Allocate TRIBIN field: - IF(ALLOCATED(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN)) DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN) - ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(1:BODINT_PLANE%TBAXIS(AXIS)%N_BINS)) +WRITE_GEOM_FIRST = .FALSE. - ! Set BIN boundaries and make initial allocation of TRI_LIST (here for SEGS) for each bin: - DELBIN = LXI / REAL(BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB) - BODINT_PLANE%TBAXIS(AXIS)%DELBIN = DELBIN - DO IBIN=1,BODINT_PLANE%TBAXIS(AXIS)%N_BINS - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_LOW = BODINT_PLANE%BOX( LOW_IND,AXIS) + REAL(IBIN-1,EB)*DELBIN - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_HIGH = BODINT_PLANE%BOX( LOW_IND,AXIS) + REAL(IBIN ,EB)*DELBIN - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL = 0 - IF(ALLOCATED(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST)) & - DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST) - ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(DELTA_SEGBIN)) - ENDDO - ! Finally, populate TRI_LIST (here for SEGS) for AXIS bins: - DO ISEG=1,BODINT_PLANE%NSEGS - XIV(NOD1:NOD2) = BODINT_PLANE%XYZ(AXIS,BODINT_PLANE%SEGS(NOD1:NOD2,ISEG)) - XIV_LO = MINVAL(XIV(NOD1:NOD2)); XIV_HI = MAXVAL(XIV(NOD1:NOD2)) - AVAL = (XIV_LO-GEOMEPS-BODINT_PLANE%BOX(LOW_IND,AXIS))/DELBIN - ILO_BIN= MAX(1, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB),ABS(AVAL)) )) - AVAL = (XIV_HI+GEOMEPS-BODINT_PLANE%BOX(LOW_IND,AXIS))/DELBIN - IHI_BIN= MIN(BODINT_PLANE%TBAXIS(AXIS)%N_BINS, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB),ABS(AVAL)) )) - DO IBIN=ILO_BIN,IHI_BIN - NTL = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL + 1 - SZE = SIZE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST,DIM=1) - IF (NTL > SZE) THEN - ! Reallocate: - ALLOCATE(TRI_LIST(1:SZE)); TRI_LIST(1:SZE)=BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) - DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST) - ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE+DELTA_SEGBIN)) - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) = TRI_LIST(1:SZE) - DEALLOCATE(TRI_LIST) - ENDIF - ! Add Triangle index to BINs TRI_LIST - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL = NTL - BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(NTL) = ISEG - ENDDO - ENDDO -ENDDO +END SUBROUTINE WRITE_GEOM -! Add Segments intersections: -DO IBIN=1,BODINT_PLANE%TBAXIS(AXIS)%N_BINS - NTL = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL - ! Now double loop, cost O(1/2*NTL^2): - DO BISEG=1,NTL - ISEGV(EDG1) = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(BISEG) - SEGV(NOD1:NOD2,EDG1) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEGV(EDG1)) - P1(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1,EDG1)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1,EDG1))/) - D1(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD2,EDG1)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD2,EDG1))/) - D1 = D1 - P1 - S1_X2_MIN=MINVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG1))) - S1_X2_MAX=MAXVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG1))) - S1_X3_MIN=MINVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG1))) - S1_X3_MAX=MAXVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG1))) - DO BIISEG=BISEG+1,NTL - ! Test for segment-segment intersection: - ISEGV(EDG2) = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(BIISEG) - SEGV(NOD1:NOD2,EDG2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEGV(EDG2)) - P2(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1,EDG2)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1,EDG2))/) - D2(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD2,EDG2)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD2,EDG2))/) - D2 = D2 - P2 - ! Tests for quick discard: - IF( MAXVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG2)))+GEOMEPS < S1_X2_MIN) CYCLE - IF( MINVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG2)))-GEOMEPS > S1_X2_MAX) CYCLE - IF( MAXVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG2)))+GEOMEPS < S1_X3_MIN) CYCLE - IF( MINVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG2)))-GEOMEPS > S1_X3_MAX) CYCLE +! ---------------------------- TRIANGLE_AREA ---------------------------------------- - ! Test for segment-segment intersection: - CALL GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) +REAL(EB) FUNCTION TRIANGLE_AREA(V1,V2,V3) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - ! Now discard repeated intersections: - ! If crossing is already defined in SEG don't add: - DO ICROSS=1,INT_FLG - DO ISX = EDG1,EDG2 - SBOD = SVARV(ICROSS,ISX) - ! Discard intersections already present in segment, including ends: - INLIST = .FALSE. - DO ISVAR=1,BODINT_PLANE%NBCROSS(ISEGV(ISX)) - IF ( ABS(SBOD-BODINT_PLANE%SVAR(ISVAR,ISEGV(ISX))) < GEOMEPS ) THEN - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (INLIST) CYCLE +REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3) +REAL(EB) :: N(3),R1(3),R2(3) - ! Add crossing to BODINT_PLANE, insertion sort: - NBCROSS = BODINT_PLANE%NBCROSS(ISEGV(ISX)) + 1 - ! Test-reallocate BODINT_PLANE%SVAR - NBCROSS_SVAR = SIZE(BODINT_PLANE%SVAR,DIM=1) - IF (NBCROSS > NBCROSS_SVAR) THEN - ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB - SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) - CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) - ENDIF - BODINT_PLANE%SVAR(NBCROSS,ISEGV(ISX)) = 1._EB/GEOMEPS - DO IBCR=1,NBCROSS - IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEGV(ISX)) ) EXIT - ENDDO - IBCR = MIN(IBCR,NBCROSS) +R1 = V2-V1 +R2 = V3-V1 +CALL CROSS_PRODUCT(N,R1,R2) - ! Here copy from the back (updated nbcross) to the ibcr location: - DO IDUM = NBCROSS,IBCR+1,-1 - BODINT_PLANE%SVAR(IDUM,ISEGV(ISX)) = BODINT_PLANE%SVAR(IDUM-1,ISEGV(ISX)) - ENDDO - BODINT_PLANE%SVAR(IBCR,ISEGV(ISX)) = SBOD - BODINT_PLANE%NBCROSS(ISEGV(ISX)) = NBCROSS +TRIANGLE_AREA = 0.5_EB*NORM2(N) - ! Here we have an intersection inside a segment, note it in FACERT: - IF ( ISX==EDG1 ) THEN - ! X2AXIS, X3AXIS location of intersection: - XY(IAXIS:JAXIS) = P1(IAXIS:JAXIS) + SBOD*D1(IAXIS:JAXIS)/NORM2(D1(IAXIS:JAXIS)) - ELSE - ! X2AXIS, X3AXIS location of intersection: - XY(IAXIS:JAXIS) = P2(IAXIS:JAXIS) + SBOD*D2(IAXIS:JAXIS)/NORM2(D2(IAXIS:JAXIS)) - ENDIF - XPOS = XY(IAXIS) - IF ( X2NOC==0 ) THEN - JJ2_LO = FLOOR((XPOS-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - JJ2_HI = FLOOR((XPOS+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - IF (ALL((/JJ2_LO,JJ2_HI/) < X2LO_CELL) .OR. ALL((/JJ2_LO,JJ2_HI/) > X2HI_CELL)) CYCLE - JJ2_LO = MAX(JJ2_LO,X2LO_CELL); JJ2_HI = MIN(JJ2_HI,X2HI_CELL) - ELSE - FOUND_SEG = .FALSE.; JJ2_LO = -100; JJ2_HI = -100 - DO JJ2=X2LO_CELL,X2HI_CELL - ! Check if XPOS is within this segment JJ2: - IF ( ((XPOS-X2FACE(JJ2-1))>-GEOMEPS) .AND. ((X2FACE(JJ2)-XPOS)>-GEOMEPS) ) THEN - IF (JJ2_LO > -100) THEN - JJ2_HI = JJ2 - EXIT - ELSE - JJ2_LO = JJ2 - JJ2_HI = JJ2 - ENDIF - FOUND_SEG = .TRUE. - ENDIF - ENDDO - IF (.NOT.FOUND_SEG) CYCLE - ENDIF - XPOS = XY(JAXIS) - IF ( X3NOC==0 ) THEN - KK2_LO = FLOOR((XPOS-GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - KK2_HI = FLOOR((XPOS+GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - IF (ALL((/KK2_LO,KK2_HI/) < X3LO_CELL) .OR. ALL((/KK2_LO,KK2_HI/) > X3HI_CELL)) CYCLE - KK2_LO = MAX(KK2_LO,X3LO_CELL); KK2_HI = MIN(KK2_HI,X3HI_CELL) - ELSE - FOUND_SEG = .FALSE.; KK2_LO = -100; KK2_HI = -100 - DO KK2=X3LO_CELL,X3HI_CELL - ! Check if XPOS is within this segment KK2: - IF ( ((XPOS-X3FACE(KK2-1))>-GEOMEPS) .AND. ((X3FACE(KK2)-XPOS)>-GEOMEPS) ) THEN - IF (KK2_LO > -100) THEN - KK2_HI = KK2 - EXIT - ELSE - KK2_LO = KK2 - KK2_HI = KK2 - ENDIF - FOUND_SEG = .TRUE. - ENDIF - ENDDO - IF (.NOT.FOUND_SEG) CYCLE - ENDIF +END FUNCTION TRIANGLE_AREA - ! Here JJ2 and KK2 have the face containing the intersection: - DO KK2=KK2_LO,KK2_HI - DO JJ2=JJ2_LO,JJ2_HI - FACERT(JJ2,KK2) = .TRUE. - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO -ENDDO +! ---------------------------- POINT_IN_BOX_2D ---------------------------------------- +LOGICAL FUNCTION POINT_IN_BOX_2D(P,BB,IOR) -! Loop nodes and test in SEG_NODES: if more than 2 segments end in the -! node, note it in FACERT. -MAX_SEG_NODE = MAXVAL(SEGS_NODE(1:BODINT_PLANE%NNODS)) -ALLOCATE(ISEG_NODE(MAX_SEG_NODE+1,BODINT_PLANE%NNODS)); ISEG_NODE = 0 -ALLOCATE(ANGS_NODE(MAX_SEG_NODE ,BODINT_PLANE%NNODS)); ANGS_NODE = 0._EB -ANGNODE_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS - ! End nodes to cross: - IF( ANY(BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG)/=CC_GASPHASE) ) THEN - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - DX2 = BODINT_PLANE%XYZ(X2AXIS,SEG(NOD2))-BODINT_PLANE%XYZ(X2AXIS,SEG(NOD1)) - DX3 = BODINT_PLANE%XYZ(X3AXIS,SEG(NOD2))-BODINT_PLANE%XYZ(X3AXIS,SEG(NOD1)) - NOD_LOOP : DO INOD=NOD1,NOD2 - ! Compute angle, for NOD2 the seg andgle is -ANG. - ANG=REAL(NOD2-INOD,EB)*ATAN2(DX3,DX2) + REAL(INOD-NOD1,EB)*ATAN2(-DX3,-DX2) - IF(ANG < 0._EB) ANG = ANG + TWOPI ! Make angle from 0 to 2*pi. - ! Insert-add segment into ISEG_NODE depending on angle value: - NSN = ISEG_NODE(1,SEG(INOD)) - ISEG_NODE(1 ,SEG(INOD)) = NSN+1 - FOUND_SEG=.FALSE.; ISEG2=1 - IF (NSN>0) THEN - DO ISEG2=1,NSN - IF (ANGS_NODE(ISEG2,SEG(INOD)) > ANG) THEN - FOUND_SEG=.TRUE.; EXIT - ENDIF - ENDDO - ENDIF - IF (FOUND_SEG) THEN - DO ISEG3=NSN+1,ISEG2+1,-1 - ISEG_NODE(ISEG3+1,SEG(INOD)) = ISEG_NODE(ISEG3 ,SEG(INOD)) - ANGS_NODE(ISEG3 ,SEG(INOD)) = ANGS_NODE(ISEG3-1,SEG(INOD)) - ENDDO - ENDIF - ISEG_NODE(ISEG2+1,SEG(INOD)) = ISEG - ANGS_NODE(ISEG2 ,SEG(INOD)) = ANG - ENDDO NOD_LOOP - ENDIF -ENDDO ANGNODE_LOOP +REAL(EB), INTENT(IN) :: P(3),BB(6) +INTEGER, INTENT(IN) :: IOR -ALLOCATE(CIRC_MED(MAX_SEG_NODE+1)) -INOD_LOOP : DO INOD = 1,BODINT_PLANE%NNODS - IF (SEGS_NODE(INOD) < 3) CYCLE INOD_LOOP +POINT_IN_BOX_2D=.FALSE. - ! Test case of even number of segments: - IF (MOD(SEGS_NODE(INOD),2)==0) THEN ! Case of even number of segments. - ! Test if circling around the node we have media discontinuity. - NSN=ISEG_NODE(1,INOD); COUNT=0 - DO ISEG2=2,NSN+1 - ISEG =ISEG_NODE(ISEG2,INOD) - COUNT=COUNT+1 - SEG = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - IF (INOD==SEG(NOD2)) THEN - CIRC_MED(COUNT) = BODINT_PLANE%SEGTYPE(NOD2,ISEG) - ELSE - CIRC_MED(COUNT) = BODINT_PLANE%SEGTYPE(NOD1,ISEG) - ENDIF - ENDDO - CIRC_MED(COUNT+1)=CIRC_MED(1) - CRS_FLG=.FALSE. - DO COUNT=1,NSN - IF(CIRC_MED(COUNT)==CIRC_MED(COUNT+1)) THEN - CRS_FLG=.TRUE.; EXIT - ENDIF - ENDDO - IF (.NOT.CRS_FLG) CYCLE INOD_LOOP - ENDIF +SELECT CASE(ABS(IOR)) + CASE(1) ! YZ plane + IF ( P(2)>=BB(3) .AND. P(2)<=BB(4) .AND. & + P(3)>=BB(5) .AND. P(3)<=BB(6) ) POINT_IN_BOX_2D=.TRUE. + CASE(2) ! XZ plane + IF ( P(1)>=BB(1) .AND. P(1)<=BB(2) .AND. & + P(3)>=BB(5) .AND. P(3)<=BB(6) ) POINT_IN_BOX_2D=.TRUE. + CASE(3) ! XY plane + IF ( P(1)>=BB(1) .AND. P(1)<=BB(2) .AND. & + P(2)>=BB(3) .AND. P(2)<=BB(4) ) POINT_IN_BOX_2D=.TRUE. +END SELECT - ! X2AXIS, X3AXIS location of intersection: - XY(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,INOD), BODINT_PLANE%XYZ(X3AXIS,INOD)/) - XPOS = XY(IAXIS) - IF ( X2NOC==0 ) THEN - JJ2_LO = FLOOR((XPOS-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - JJ2_HI = FLOOR((XPOS+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - IF (ALL((/JJ2_LO,JJ2_HI/) < X2LO_CELL) .OR. ALL((/JJ2_LO,JJ2_HI/) > X2HI_CELL)) CYCLE INOD_LOOP - JJ2_LO = MAX(JJ2_LO,X2LO_CELL); JJ2_HI = MIN(JJ2_HI,X2HI_CELL) - ELSE - FOUND_SEG = .FALSE.; JJ2_LO = -100; JJ2_HI = -100 - DO JJ2=X2LO_CELL,X2HI_CELL - ! Check if XPOS is within this segment JJ2: - IF ( ((XPOS-X2FACE(JJ2-1))>-GEOMEPS) .AND. ((X2FACE(JJ2)-XPOS)>-GEOMEPS) ) THEN - IF (JJ2_LO > -100) THEN - JJ2_HI = JJ2 - EXIT - ELSE - JJ2_LO = JJ2 - JJ2_HI = JJ2 - ENDIF - FOUND_SEG = .TRUE. - ENDIF - ENDDO - IF (.NOT.FOUND_SEG) CYCLE INOD_LOOP - ENDIF - XPOS = XY(JAXIS) - IF ( X3NOC==0 ) THEN - KK2_LO = FLOOR((XPOS-GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - KK2_HI = FLOOR((XPOS+GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - IF (ALL((/KK2_LO,KK2_HI/) < X3LO_CELL) .OR. ALL((/KK2_LO,KK2_HI/) > X3HI_CELL)) CYCLE INOD_LOOP - KK2_LO = MAX(KK2_LO,X3LO_CELL); KK2_HI = MIN(KK2_HI,X3HI_CELL) - ELSE - FOUND_SEG = .FALSE.; KK2_LO = -100; KK2_HI = -100 - DO KK2=X3LO_CELL,X3HI_CELL - ! Check if XPOS is within this segment KK2: - IF ( ((XPOS-X3FACE(KK2-1))>-GEOMEPS) .AND. ((X3FACE(KK2)-XPOS)>-GEOMEPS) ) THEN - IF (KK2_LO > -100) THEN - KK2_HI = KK2 - EXIT - ELSE - KK2_LO = KK2 - KK2_HI = KK2 - ENDIF - FOUND_SEG = .TRUE. - ENDIF - ENDDO - IF (.NOT.FOUND_SEG) CYCLE INOD_LOOP - ENDIF +END FUNCTION POINT_IN_BOX_2D - ! Here JJ2 and KK2 have the face containing the intersection: - DO KK2=KK2_LO,KK2_HI - DO JJ2=JJ2_LO,JJ2_HI - FACERT(JJ2,KK2) = .TRUE. - ENDDO - ENDDO -ENDDO INOD_LOOP -DEALLOCATE(SEGS_NODE,ISEG_NODE,ANGS_NODE,CIRC_MED) +! ---------------------------- POINT_IN_TETRAHEDRON ---------------------------------------- -T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) = T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) + CURRENT_TIME() - TNOW +LOGICAL FUNCTION POINT_IN_TETRAHEDRON(XP,V1,V2,V3,V4,BB) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -IF (DEBUG_SET_CUTCELLS) THEN - ! Write out: - IF(INDX1 < 0) THEN - WRITE(BIPL_FILE,'(A,A,I3.3,A,I1.1,A,I2.1,A)') TRIM(CHID),'_BODINT_PLANE_',MY_RANK,'_',X1AXIS,'_',INDX1,'.csv' - ELSE - WRITE(BIPL_FILE,'(A,A,I3.3,A,I1.1,A,I2.2,A)') TRIM(CHID),'_BODINT_PLANE_',MY_RANK,'_',X1AXIS,'_',INDX1,'.csv' - ENDIF - LU_DB_SETCC = GET_FILE_NUMBER() - OPEN(LU_DB_SETCC,FILE=TRIM(BIPL_FILE),STATUS='UNKNOWN') - WRITE(LU_DB_SETCC,*) 'X1AXIS,X2AXIS,X3AXIS,X1PLN,GEOMEPS' - WRITE(LU_DB_SETCC,*) X1AXIS,X2AXIS,X3AXIS,X1PLN,GEOMEPS - WRITE(LU_DB_SETCC,*) 'NNODS, NSEGS, NSGLS, NTRIS' - WRITE(LU_DB_SETCC,*) BODINT_PLANE%NNODS,BODINT_PLANE%NSEGS,BODINT_PLANE%NSGLS,BODINT_PLANE%NTRIS - DO INOD=1,BODINT_PLANE%NNODS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%XYZ(IAXIS:KAXIS,INOD) - END DO - DO INOD=1,BODINT_PLANE%NNODS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%NOD_PERM(INOD) - ENDDO - DO ISEG=1,BODINT_PLANE%NSEGS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - END DO - DO ISEG=1,BODINT_PLANE%NSEGS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) - END DO - DO ISGL=1,BODINT_PLANE%NSGLS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%SGLS(NOD1,ISGL) - END DO - DO ITRI=1,BODINT_PLANE%NTRIS - WRITE(LU_DB_SETCC,*) BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) - ENDDO - CLOSE(333) -ENDIF +REAL(EB), INTENT(IN) :: XP(3),V1(3),V2(3),V3(3),V4(3),BB(6) +REAL(EB) :: U_VEC(3),V_VEC(3),N_VEC(3),Q_VEC(3),R_VEC(3) +INTEGER :: I -RETURN -END SUBROUTINE GET_BODINT_PLANE +! In this routine, we test all four faces of the tet volume defined by the points X(i),Y(i),Z(i); i=1:4. +! If the point is on the negative side of all the faces, it is inside the volume. +POINT_IN_TETRAHEDRON=.FALSE. -! ------------------------ GET_SEGSEG_INTERSECTION ------------------------------ +! first test bounding box -SUBROUTINE GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) +IF (XP(1)BB(2)) RETURN +IF (XP(2)BB(4)) RETURN +IF (XP(3)BB(6)) RETURN -REAL(EB), INTENT(IN) :: P1(IAXIS:JAXIS),D1(IAXIS:JAXIS),P2(IAXIS:JAXIS),D2(IAXIS:JAXIS) -REAL(EB), INTENT(OUT):: SVARV(NOD1:NOD2,EDG1:EDG2), SLENV(EDG1:EDG2) -INTEGER, INTENT(OUT):: INT_FLG +POINT_IN_TETRAHEDRON=.TRUE. -! Local Variables: -REAL(EB) :: SVR, TVR, KRS, KRS2, E2, L12, L22, E(IAXIS:JAXIS), S1, S2, SMIN, SMAX +FACE_LOOP: DO I=1,4 -! Test for segment-segment intersection: -E(IAXIS:JAXIS) = P2(IAXIS:JAXIS) - P1(IAXIS:JAXIS) -KRS = D1(IAXIS)*D2(JAXIS) - D1(JAXIS)*D2(IAXIS); KRS2=KRS**2._EB -L12 = D1(IAXIS)**2._EB + D1(JAXIS)**2._EB -L22 = D2(IAXIS)**2._EB + D2(JAXIS)**2._EB -! Case of segments not parallel. -IF ( KRS2 > GEOMEPS**2._EB*L12*L22) THEN - SVR = (E(IAXIS)*D2(JAXIS)-E(JAXIS)*D2(IAXIS))/ KRS - IF ( (SVR<-GEOMEPS) .OR. ((SVR-1._EB)>GEOMEPS) ) THEN - ! intersection not a point of segment SEG. - INT_FLG = 0 - RETURN - ENDIF - TVR = (E(IAXIS)*D1(JAXIS)-E(JAXIS)*D1(IAXIS))/ KRS - IF ( (TVR<-GEOMEPS) .OR. ((TVR-1._EB)>GEOMEPS) ) THEN - ! intersection not a point of segment SEG2. - INT_FLG = 0 - RETURN - ENDIF - ! Intersection a point on SEG and SEG2. - SLENV(EDG1) = SQRT(L12) - SLENV(EDG2) = SQRT(L22) - SVARV(NOD1,EDG1) = SVR*SLENV(EDG1) - SVARV(NOD1,EDG2) = TVR*SLENV(EDG2) - INT_FLG=1 - RETURN -ENDIF + SELECT CASE(I) + CASE(1) + ! vertex ordering = 1,2,3,4 + Q_VEC = XP-(/V1(1),V1(2),V1(3)/) ! form a vector from a point on the triangular surface to the point XP + R_VEC = (/V4(1),V4(2),V4(3)/)-(/V1(1),V1(2),V1(3)/) ! vector from the tri to other point of volume defining inside + U_VEC = (/V2(1)-V1(1),V2(2)-V1(2),V2(3)-V1(3)/) ! vectors forming the sides of the triangle + V_VEC = (/V3(1)-V1(1),V3(2)-V1(2),V3(3)-V1(3)/) + CASE(2) + ! vertex ordering = 1,3,4,2 + Q_VEC = XP-(/V1(1),V1(2),V1(3)/) + R_VEC = (/V2(1),V2(2),V2(3)/)-(/V1(1),V1(2),V1(3)/) + U_VEC = (/V3(1)-V1(1),V3(2)-V1(2),V3(3)-V1(3)/) + V_VEC = (/V4(1)-V1(1),V4(2)-V1(2),V4(3)-V1(3)/) + CASE(3) + ! vertex ordering = 1,4,2,3 + Q_VEC = XP-(/V1(1),V1(2),V1(3)/) + R_VEC = (/V2(1),V2(2),V2(3)/)-(/V1(1),V1(2),V1(3)/) + U_VEC = (/V4(1)-V1(1),V4(2)-V1(2),V4(3)-V1(3)/) + V_VEC = (/V2(1)-V1(1),V2(2)-V1(2),V2(3)-V1(3)/) + CASE(4) + ! vertex ordering = 2,4,3,1 + Q_VEC = XP-(/V2(1),V2(2),V2(3)/) + R_VEC = (/V1(1),V1(2),V1(3)/)-(/V2(1),V2(2),V2(3)/) + U_VEC = (/V4(1)-V2(1),V4(2)-V2(2),V4(3)-V2(3)/) + V_VEC = (/V3(1)-V2(1),V3(2)-V2(2),V3(3)-V2(3)/) + END SELECT -! Parallel Segments: -E2 = E(IAXIS)**2._EB + E(JAXIS)**2._EB -KRS= E(IAXIS)*D1(JAXIS) - E(JAXIS)*D1(IAXIS); KRS2=KRS**2._EB -IF ( KRS2 > GEOMEPS**2._EB*L12*E2 ) THEN - ! Segments are different. - INT_FLG = 0 - RETURN -ENDIF -! Segment lines are the same. -S1 = DOT_PRODUCT(D1,E)/L12; S2 = S1+DOT_PRODUCT(D1,D2)/L12 -SMIN=MIN(S1,S2); SMAX=MAX(S1,S2) -IF ( (1._EB+GEOMEPS) < SMIN .OR. (0._EB-GEOMEPS) > SMAX) THEN - INT_FLG = 0 - RETURN -ENDIF -! Overlap tests: -SLENV(EDG1) = SQRT(L12) -SLENV(EDG2) = SQRT(L22) -IF ( (1._EB+GEOMEPS) > SMIN ) THEN ! SMIN between P1 and P1+D1 - IF ( (0._EB-GEOMEPS) < SMAX) THEN ! SMAX greater that P1 - IF (0._EB < SMIN) THEN ! SMIN higher that P1 - SVARV(NOD1,EDG1) = SMIN*SLENV(EDG1) ! First crossing on P1-P1+D1 - IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN ! SMIN is P2 - SVARV(NOD1,EDG2)=0._EB ! First crossing in P2-P2+D2 - ELSE ! SMIN is P2+D2 - SVARV(NOD2,EDG2)=1._EB*SLENV(EDG2) ! Second crossing in P2-P2+D2 - ENDIF - ELSE ! SMIN lower than P1 - SVARV(NOD1,EDG1) = 0._EB ! First crossing in P1-P1+D1 - IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN ! SMIN os P2 - SVARV(NOD1,EDG2)=-SMIN*SLENV(EDG1) ! First crossing in P2-P2-D2 - ELSE - SVARV(NOD2,EDG2)=SMAX*SLENV(EDG1) - ENDIF - ENDIF - IF (1._EB > SMAX) THEN - SVARV(NOD2,EDG1) = SMAX*SLENV(EDG1) - IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN ! SMAX is P2 - SVARV(NOD1,EDG2)=0._EB*SLENV(EDG2) - ELSE - SVARV(NOD2,EDG2)=1._EB*SLENV(EDG2) - ENDIF - ELSE - SVARV(NOD2,EDG1) = 1._EB*SLENV(EDG1) - IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN ! SMAX is P2 - SVARV(NOD1,EDG2)=(SMAX-1._EB)*SLENV(EDG1) - ELSE - SVARV(NOD2,EDG2)=(1._EB-SMIN)*SLENV(EDG1) - ENDIF - ENDIF - INT_FLG = 2 - ELSE - ! SMAX = 0._EB - SVARV(NOD1,EDG1) = 0._EB - IF (ABS(SMAX-S1) < GEOMEPS/2._EB) THEN - SVARV(NOD1,EDG2) = 0._EB - ELSE - SVARV(NOD1,EDG2) = 1._EB*SLENV(EDG2) - ENDIF - INT_FLG = 1 - ENDIF -ELSE - ! SMIN = 1._EB - SVARV(NOD1,EDG1) = 1._EB*SLENV(EDG1) - IF (ABS(SMIN-S1) < GEOMEPS/2._EB) THEN - SVARV(NOD1,EDG2) = 0._EB - ELSE - SVARV(NOD1,EDG2) = 1._EB*SLENV(EDG2) - ENDIF - INT_FLG = 1 -ENDIF + ! if the sign of the dot products are equal, the point is inside, else it is outside and we return + + IF ( ABS( SIGN(1._EB,DOT_PRODUCT(Q_VEC,N_VEC))-SIGN(1._EB,DOT_PRODUCT(R_VEC,N_VEC)) )>TWENTY_EPSILON_EB ) THEN + POINT_IN_TETRAHEDRON=.FALSE. + RETURN + ENDIF -RETURN -END SUBROUTINE GET_SEGSEG_INTERSECTION +ENDDO FACE_LOOP -! -------------------------- GET_X2INTERSECTIONS -------------------------------- +END FUNCTION POINT_IN_TETRAHEDRON -SUBROUTINE GET_X2_INTERSECTIONS(X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN) -INTEGER, INTENT(IN) :: X1AXIS, X2AXIS, X3AXIS -REAL(EB),INTENT(IN) :: X3RAY,X1PLN +! ---------------------------- VALID_TRIANGLE ---------------------------------------- -! Local Variables: -INTEGER :: ISGL, SGL, ISEG, SEG(NOD1:NOD2) -REAL(EB):: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, DOT1, DOT2 -REAL(EB):: SVARI, STANI(IAXIS:JAXIS) -INTEGER :: ICRSI(LOW_IND:HIGH_IND+1), SCRSI, ISSEG(LOW_IND:HIGH_IND), GAM(LOW_IND:HIGH_IND) -REAL(EB):: X3MIN, X3MAX, DV12(MAX_DIM), MODTI, NOMLI(IAXIS:JAXIS) -LOGICAL :: OUTRAY -REAL(EB):: DELBIN, AVAL -INTEGER :: ILO_BIN,IHI_BIN,IBIN,IISEG,ICR +LOGICAL FUNCTION VALID_TRIANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3,VERT_FLAG) -REAL(EB) :: TNOW -! INTEGER :: IAUX +INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3, VERT_FLAG(0:300) +REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) -TNOW = CURRENT_TIME() +REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB +REAL(FB), POINTER, DIMENSION(:) :: V, V1, V2, V3 +REAL(FB) :: U1(3), U2(3), U1XU2, D123 -! Initialize crossings arrays: -CC_N_CRS = 0 -CC_SVAR_CRS = 1._EB / GEOMEPS -CC_IS_CRS = CC_UNDEFINED -CC_IS_CRS2 = CC_UNDEFINED -CC_SEG_TAN = 0._EB -CC_SEG_CRS = 0 -CC_BDNUM_CRS = 0 ! Size (0:CC_MAXCROSS_X2) -CC_BDNUM_CRS_AUX= 0 ! Size (0:CC_MAXCROSS_X2) +INTEGER :: I -! First Single points: -! Treat them as [GASPHASE GASPHASE] crossings: -DO ISGL=1,BODINT_PLANE%NSGLS - SGL = BODINT_PLANE%SGLS(NOD1,ISGL) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SGL) - ! x2-x3 coordinates of point: - X2_1 = XYZ1(X2AXIS) - X3_1 = XYZ1(X3AXIS) +VALID_TRIANGLE = .FALSE. - ! Dot product dot(X_1-XRAY,e3) - DOT1 = X3_1-X3RAY - IF (ABS(DOT1) <= GEOMEPS) DOT1=0._EB - IF ( ABS(DOT1) == 0._EB ) THEN - ! Point 1: - SVARI = X2_1 - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_GASPHASE, CC_UNDEFINED /) - SCRSI = -ISGL - STANI(IAXIS:JAXIS) = 0._EB +V1(1:3)=>VERTS(3*IV1-2:3*IV1) +V2(1:3)=>VERTS(3*IV2-2:3*IV2) +V3(1:3)=>VERTS(3*IV3-2:3*IV3) - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) ! Modifies crossings arrays. - ENDIF +U1 = V2 - V1; +U2 = V3 - V2; + +! triangle is invalid if angle at V2 is > 180 deg + +IF(DIR==1) THEN + U1(1) = U1(2) + U1(2) = U1(3) + U2(1) = U2(2) + U2(2) = U2(3) +ELSE IF(DIR==2) THEN + U1(2) = U1(1) + U1(1) = U1(3) + U2(2) = U2(1) + U2(1) = U2(3) +ELSE + U1(1) = U1(1) + U1(2) = U1(2) + U2(1) = U2(1) + U2(2) = U2(2) +ENDIF +U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize +U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize +U1XU2 = U1(1)*U2(2)-U1(2)*U2(1) ! U1 x U2 +IF (U1XU2 < EPS_FB) RETURN + +DO I = 1, NVERTS + IF (VERT_FLAG(I) == 0) CYCLE + IF (I == IV1 .OR. I == IV2 .OR.I == IV3 ) CYCLE + V(1:3)=>VERTS(3*I-2:3*I) + ! These CYCLE tests are done to treat holes properly: + D123=SQRT( (V(1)-V1(1))**2._FB + (V(2)-V1(2))**2._FB + (V(3)-V1(3))**2._FB ) + IF (D123 < EPS_FB) CYCLE + D123=SQRT( (V(1)-V2(1))**2._FB + (V(2)-V2(2))**2._FB + (V(3)-V2(3))**2._FB ) + IF (D123 < EPS_FB) CYCLE + D123=SQRT( (V(1)-V3(1))**2._FB + (V(2)-V3(2))**2._FB + (V(3)-V3(3))**2._FB ) + IF (D123 < EPS_FB) CYCLE + IF (POINT_IN_TRIANGLE_FB(V, V1, V2, V3)) RETURN ENDDO -! Now Segments: -NSEGS_COND : IF (BODINT_PLANE%NSEGS > 0) THEN +VALID_TRIANGLE = .TRUE. +END FUNCTION VALID_TRIANGLE -DELBIN = BODINT_PLANE%TBAXIS(X3AXIS)%DELBIN -AVAL = (X3RAY-GEOMEPS-BODINT_PLANE%BOX(LOW_IND,X3AXIS))/DELBIN -ILO_BIN= MAX(1, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS,EB),ABS(AVAL)) )) -AVAL = (X3RAY+GEOMEPS-BODINT_PLANE%BOX(LOW_IND,X3AXIS))/DELBIN -IHI_BIN= MIN(BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS,EB),ABS(AVAL)) )) -IBIN_DO : DO IBIN=ILO_BIN,IHI_BIN - IF (X3RAY < BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%X1_LOW -GEOMEPS) CYCLE - IF (X3RAY > BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE +! ----------------------------- DIFF_ANGLE ----------------------------------------- - TRIBIN_DO : DO IISEG=1,BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%NTL +LOGICAL FUNCTION DIFF_ANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3, ABS_FLG) - ISEG = BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) -!SEGMENTS_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS +INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3 +REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) +LOGICAL, INTENT(IN) :: ABS_FLG - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) +REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB +REAL(FB), PARAMETER :: EPS_MID= 1.E-4_FB +REAL(FB), POINTER, DIMENSION(:) :: V1, V2, V3 +REAL(FB) :: U1(3), U2(3), CRPD(3), NORMU(2) +LOGICAL :: TEST_FLAG=.FALSE. - ! x2,x3 coordinates of segment: - X2_1 = XYZ1(X2AXIS) - X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. - X2_2 = XYZ2(X2AXIS) - X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. +DIFF_ANGLE = .FALSE. - ! First Test if the whole segment is on one side of the Ray: - ! Test segment crosses the ray, or is in geomepsilon proximity - ! of it: - X3MIN = MIN(X3_1,X3_2) - X3MAX = MAX(X3_1,X3_2) - OUTRAY=(((X3RAY-X3MAX) > GEOMEPS) .OR. ((X3MIN-X3RAY) > GEOMEPS)) +V1(1:3)=>VERTS(3*IV1-2:3*IV1) +V2(1:3)=>VERTS(3*IV2-2:3*IV2) +V3(1:3)=>VERTS(3*IV3-2:3*IV3) - IF (OUTRAY) CYCLE +U1 = V2 - V1; +U2 = V3 - V2; - DOT1 = X3_1-X3RAY - DOT2 = X3_2-X3RAY +NORMU(1)=SQRT(U1(1)**2._FB+U1(2)**2._FB+U1(3)**2._FB) +NORMU(2)=SQRT(U2(1)**2._FB+U2(2)**2._FB+U2(3)**2._FB) - IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB - IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB +IF(ANY(NORMU(1:2) 180 deg +SELECT CASE(DIR) +CASE(IAXIS) + U1(1) = U1(2) + U1(2) = U1(3) + U2(1) = U2(2) + U2(2) = U2(3) +CASE(JAXIS) + U1(2) = U1(1) + U1(1) = U1(3) + U2(2) = U2(1) + U2(1) = U2(3) +CASE(KAXIS) + U1(1) = U1(1) + U1(2) = U1(2) + U2(1) = U2(1) + U2(2) = U2(2) +CASE(0) ! 3D Cross for Inboundary faces: + U1(1:3) = U1(1:3) / NORMU(1) ! Normalize + U2(1:3) = U2(1:3) / NORMU(2) ! Normalize + CRPD(1) = U1(2)*U2(3)-U1(3)*U2(2) + CRPD(2) = U1(3)*U2(1)-U1(1)*U2(3) + CRPD(3) = U1(1)*U2(2)-U1(2)*U2(1) + ! ABS_FLG always .TRUE. in the 3D case: + IF (SQRT(CRPD(1)**2._FB+CRPD(2)**2._FB+CRPD(3)**2._FB) < EPS_FB) DIFF_ANGLE = .TRUE. + RETURN +END SELECT - ! For x2, in local x2-x3 coords e2=(1,0): - GAM(LOW_IND) = (1 + NINT(SIGN( 1._EB, NOMLI(IAXIS))) ) / 2 !(1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; - GAM(HIGH_IND)= (1 - NINT(SIGN( 1._EB, NOMLI(IAXIS))) ) / 2 !(1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; +U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize +U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize +IF (ABS_FLG) THEN + TEST_FLAG=ABS(U1(1)*U2(2)-U1(2)*U2(1)) < EPS_MID +ELSE + TEST_FLAG= U1(1)*U2(2)-U1(2)*U2(1) < EPS_FB +ENDIF +IF (TEST_FLAG) DIFF_ANGLE = .TRUE. - ! Test if whole segment is in ray, if so add segment nodes as crossings: - IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN +RETURN - ! Count both points as crossings: - ! Point 1: - SVARI = MIN(X2_1,X2_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) - SCRSI = ISEG +END FUNCTION DIFF_ANGLE - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) +! ---------------------------- POINT_IN_TRIANGLE_FB ---------------------------------------- - DO ICR=2,BODINT_PLANE%NBCROSS(ISEG)-1 - SVARI = X2_1 + BODINT_PLANE%SVAR(ICR,ISEG)*STANI(IAXIS) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - ENDDO +LOGICAL FUNCTION POINT_IN_TRIANGLE_FB(P_FB,V1_FB,V2_FB,V3_FB) - ! Point 2: - SVARI = MAX(X2_1,X2_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) - SCRSI = ISEG +REAL(FB), INTENT(IN) :: P_FB(3),V1_FB(3),V2_FB(3),V3_FB(3) +REAL(EB) :: P_EB(3),V1_EB(3),V2_EB(3),V3_EB(3) - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + P_EB = REAL( P_FB,EB) +V1_EB = REAL(V1_FB,EB) +V2_EB = REAL(V2_FB,EB) +V3_EB = REAL(V3_FB,EB) +POINT_IN_TRIANGLE_FB = POINT_IN_TRIANGLE(P_EB,V1_EB,V2_EB,V3_EB) - CYCLE +END FUNCTION POINT_IN_TRIANGLE_FB - ENDIF +! ---------------------------- POINT_IN_TRIANGLE ---------------------------------------- - ! Now nodes individually: - IF ( ABS(DOT1) == 0._EB ) THEN +LOGICAL FUNCTION POINT_IN_TRIANGLE(P,V1,V2,V3) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - ! Point 1: - SVARI = X2_1 +REAL(EB), INTENT(IN) :: P(3),V1(3),V2(3),V3(3) +REAL(EB) :: E(3),E1(3),E2(3),N(3),R(3),Q(3) +INTEGER :: I +REAL(EB), PARAMETER :: EPS=1.E-16_EB - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND) = GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)= CC_UNDEFINED - SCRSI = ISEG +! This routine tests whether the projection of P, in the plane normal +! direction, onto to the plane defined by the triangle (V1,V2,V3) is +! inside the triangle. - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) +POINT_IN_TRIANGLE=.TRUE. ! start by assuming the point is inside - CYCLE +! compute face normal +E1 = V2-V1 +E2 = V3-V1 +CALL CROSS_PRODUCT(N,E1,E2) +EDGE_LOOP: DO I=1,3 + SELECT CASE(I) + CASE(1) + E = V2-V1 + R = P-V1 + CASE(2) + E = V3-V2 + R = P-V2 + CASE(3) + E = V1-V3 + R = P-V3 + END SELECT + CALL CROSS_PRODUCT(Q,E,R) + IF ( DOT_PRODUCT(Q,N) < -EPS ) THEN + POINT_IN_TRIANGLE=.FALSE. + RETURN ENDIF - IF ( ABS(DOT2) == 0._EB ) THEN +ENDDO EDGE_LOOP - ! Point 2: - SVARI = X2_2 +END FUNCTION POINT_IN_TRIANGLE - ! LOW and HIGH_IND media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND) = GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1) = CC_UNDEFINED - SCRSI = ISEG +! ---------------------------- TRIANGULATE ---------------------------------------- - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) +SUBROUTINE TRIANGULATE(DIR,VERTS,NVERTS,VERT_OFFSET,FACES,LOCTYPE) - CYCLE +INTEGER, INTENT(IN) :: DIR, NVERTS, VERT_OFFSET +REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) +INTEGER, INTENT(OUT) :: FACES(3*(NVERTS-2)) +INTEGER, INTENT(OUT) :: LOCTYPE(NVERTS-2) - ENDIF +INTEGER :: IFACE, NLIST, NLIST_OLD +INTEGER :: VERT_LIST(0:1024), VERT_FLAG(0:1023), EDGE_LIST(2,1:1024) +LOGICAL :: NODE_EXISTS(1024) +INTEGER :: IM1, I, IP1, V0, V1, V2, IVERT, IEDGE +LOGICAL HAVE_TRIANGLE +REAL(FB), POINTER, DIMENSION(:) :: VV1, VV2, VV3 +REAL(FB) :: U1(3), U2(3), U1XU2 +REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB +INTEGER :: NBIG_ANGLES, VERT_START +LOGICAL :: VERT_DROPPED, FLAG - ! Finally regular case: - ! Points 1 on one side of ray, point 2 on the other: - ! IF ((DOT1 > 0. .AND. DOT2 < 0.) .OR. (DOT1 < 0. .AND. DOT2 > 0.)) - IF ( DOT1*DOT2 < 0._EB ) THEN +INTEGER :: HIDEDGE(3), EDGEI(1:2), NVERTS2, NEDGES, COUNT +INTEGER, PARAMETER :: SHFT_NODE(1:4) = (/ 2, 1, 0, 2 /) - ! Intersection Point along segment: - !DS = (X3RAY-X3_1) / (X3_2-X3_1) - !SVARI = X2_1 + DS*(X2_2-X2_1) - SVARI = X2_1 + (X3RAY-X3_1) * (X2_2-X2_1) / (X3_2-X3_1) +INTEGER :: COUNT_OUT - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND) = GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1) = CC_UNDEFINED - SCRSI = ISEG +FLAG = .TRUE. - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) +! Drop vertices that are repeated, close verts in EB precision that are fused in FB: +VERT_FLAG(1:NVERTS)=1 +I = 1 +VV1(1:3)=>VERTS(3*NVERTS-2:3*NVERTS) +VV2(1:3)=>VERTS(3*I-2:3*I) +IF ( ABS(VV1(1)-VV2(1))+ABS(VV1(2)-VV2(2))+ABS(VV1(3)-VV2(3)) < 10._FB*EPS_FB) VERT_FLAG(I)=0 +DO I = 2, NVERTS + VV1(1:3)=>VERTS(3*(I-1)-2:3*(I-1)) + VV2(1:3)=>VERTS(3*I-2:3*I) + IF ( ABS(VV1(1)-VV2(1))+ABS(VV1(2)-VV2(2))+ABS(VV1(3)-VV2(3)) < 10._FB*EPS_FB) VERT_FLAG(I)=0 +ENDDO +NLIST = SUM(VERT_FLAG(1:NVERTS)) +NVERTS2= NLIST +COUNT = 0 +DO I = 1, NVERTS + IF(VERT_FLAG(I)==0) CYCLE + COUNT= COUNT + 1 + VERT_LIST(COUNT) = I +ENDDO +VERT_LIST(0) = VERT_LIST(NLIST) +VERT_LIST(NLIST+1) = VERT_LIST(1) - CYCLE +! Now drop vertices contained whithin lines of the polygon: +DO I=1,NLIST + IM1 = VERT_LIST(I-1) + IVERT = VERT_LIST(I) + IP1 = VERT_LIST(I+1) + IF ( DIFF_ANGLE(DIR,VERTS,NVERTS,IM1,IVERT,IP1,.TRUE.) ) VERT_FLAG(IVERT)=0 +ENDDO - ENDIF +! Redo List: +NLIST = SUM(VERT_FLAG(1:NVERTS)) - print*, "Error GET_X2INTERSECTIONS: Missed segment=",ISEG +IF (NLIST < 3) THEN + FACES(1:3*(NVERTS-2)) = VERT_OFFSET + 1 + LOCTYPE(1:NVERTS-2) = 4+8+16 + RETURN +ENDIF - ENDDO TRIBIN_DO -ENDDO IBIN_DO -!ENDDO SEGMENTS_LOOP +NVERTS2= NLIST +NEDGES = NLIST +COUNT = 0 +DO I = 1, NVERTS + IF(VERT_FLAG(I)==0) CYCLE + COUNT= COUNT + 1 + VERT_LIST(COUNT) = I +ENDDO +VERT_LIST(0) = VERT_LIST(NLIST) +VERT_LIST(NLIST+1) = VERT_LIST(1) +NODE_EXISTS(1:NLIST+1) = .TRUE. +DO I = 1, NLIST-1 + EDGE_LIST((/1,2/),I) = (/ VERT_LIST(I), VERT_LIST(I+1) /) +ENDDO +EDGE_LIST((/1,2/),NLIST) = (/ VERT_LIST(NEDGES), VERT_LIST(1) /) +FACES(1:3*(NVERTS-2)) = VERT_OFFSET+VERT_LIST(NLIST) -ENDIF NSEGS_COND +IF (DIR == 0) THEN ! INBOUNDARY cut-face, always convex polygon. + VERT_START = VERT_LIST(1) + IFACE = 0 + DO I = 1, NVERTS2 + IP1 = I + 1 + IF (I==NVERTS2) IP1=1 + IF (I==VERT_START .OR. IP1==VERT_START) CYCLE + FACES(3*IFACE+1) = VERT_OFFSET+VERT_LIST(VERT_START) + FACES(3*IFACE+2) = VERT_OFFSET+VERT_LIST(I) + FACES(3*IFACE+3) = VERT_OFFSET+VERT_LIST(IP1) + IFACE = IFACE + 1 + ENDDO + ! Here test edges to define LOCTYPE: + LOCTYPE(:) = 4+8+16 + DO IFACE=1,NVERTS2-2 + HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. + DO IEDGE=1,3 + ! Nodes i,i+1: + EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) + DO I=1,NEDGES + IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN + HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. + EXIT + ENDIF + ENDDO + ENDDO + LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) + ENDDO + RETURN +ENDIF -! Do we have any intersections? -IF ( CC_N_CRS == 0 ) RETURN +IF (FLAG) THEN ! find number of angles > 180 deg + NBIG_ANGLES = 0 + VERT_START = VERT_LIST(1) + DO I = 1, NVERTS2 + IM1 = I - 1 + IF (I==1)IM1 = NVERTS2 + IP1 = I + 1 + IF (I==NVERTS2)IP1 = 1 + IF ( DIFF_ANGLE(DIR,VERTS,NVERTS,VERT_LIST(IM1),VERT_LIST(I),VERT_LIST(IP1),.FALSE.) ) THEN + NBIG_ANGLES = NBIG_ANGLES + 1 + VERT_START = I + ENDIF + END DO -! Collapse crossings to single SVARs: -CALL COLLAPSE_CROSSINGS(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,1) + ! if 0 angles (convex) or 1 angle (simple concave) then triangulate using a fan + IF ( NBIG_ANGLES <= 1 ) THEN + IFACE = 0 + DO I = 1, NVERTS2 + IP1 = I + 1 + IF (I==NVERTS2) IP1=1 + IF (I==VERT_START .OR. IP1==VERT_START) CYCLE + FACES(3*IFACE+1) = VERT_OFFSET+VERT_LIST(VERT_START) + FACES(3*IFACE+2) = VERT_OFFSET+VERT_LIST(I) + FACES(3*IFACE+3) = VERT_OFFSET+VERT_LIST(IP1) + IFACE = IFACE + 1 + ENDDO + ! Here test edges to define LOCTYPE: + LOCTYPE(:) = 4+8+16 + DO IFACE=1,NVERTS2-2 + HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. + DO IEDGE=1,3 + ! Nodes i,i+1: + EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) + DO I=1,NEDGES + IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN + HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. + EXIT + ENDIF + ENDDO + ENDDO + LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) + ENDDO + RETURN + ENDIF +ENDIF +! more than 1 angles in polygon > 180 deg +COUNT_OUT = 0 +IFACE = 1 +OUTER: DO WHILE (NLIST>=3) + COUNT_OUT = COUNT_OUT + 1 + IF(COUNT_OUT > NVERTS**4) THEN + ! Revert to Convex poly solution: + DO IVERT = 1, NVERTS - 2 ! for now assume face is convex + ! vertex indices 1, 2, ..., NVF + ! faces (1,2,3), (1,3,4), ..., (1,NVF-1,NVF) + FACES(3*IVERT-2) = VERT_OFFSET+1 + FACES(3*IVERT-1) = VERT_OFFSET+1+IVERT + FACES(3*IVERT) = VERT_OFFSET+2+IVERT + ENDDO + EXIT + ENDIF + IVERT = 1 + HAVE_TRIANGLE = .FALSE. + INNER: DO WHILE (IVERT<=NLIST) + V0 = VERT_LIST(IVERT-1) + V1 = VERT_LIST(IVERT) + V2 = VERT_LIST(IVERT+1) + IF(.NOT.NODE_EXISTS(IVERT+1))EXIT INNER + IF(NLIST==3.OR.VALID_TRIANGLE(DIR,VERTS,NVERTS,V0,V1,V2,VERT_FLAG)) THEN + FACES(IFACE ) = VERT_OFFSET+V0 + FACES(IFACE+1) = VERT_OFFSET+V1 + FACES(IFACE+2) = VERT_OFFSET+V2 + IF (NLIST == 3) EXIT OUTER + IFACE = IFACE + 3 + NODE_EXISTS(IVERT) = .FALSE. + IF(IVERT==1) NODE_EXISTS(NLIST+1) = .FALSE. + HAVE_TRIANGLE = .TRUE. + IVERT = IVERT + 2 + ELSE + IVERT = IVERT + 1 + ENDIF + ENDDO INNER + NLIST_OLD = NLIST + NLIST = 0 + DO I = 1, NLIST_OLD + IF(NODE_EXISTS(I))THEN + NLIST = NLIST + 1 + VERT_LIST(NLIST) = VERT_LIST(I) + ENDIF + ENDDO + VERT_LIST(0) = VERT_LIST(NLIST) + VERT_LIST(NLIST+1) = VERT_LIST(1) + NODE_EXISTS(1:NLIST+1) = .TRUE. -! Write out: -! print*, "X3RAY=",X3RAY,", Intersect X2=",CC_N_CRS -! DO ICRS=1,CC_N_CRS -! print*, ICRS,", ",CC_SVAR_CRS(ICRS),", ",CC_IS_CRS(ICRS) -! ENDDO + ! Test for nodes connecting parallel edges, if found drop them: + VERT_DROPPED=.FALSE. + DO I=1,NLIST + V0=VERT_LIST(I-1); V1=VERT_LIST(I); V2=VERT_LIST(I+1); + VV1(1:3)=>VERTS(3*V0-2:3*V0) + VV2(1:3)=>VERTS(3*V1-2:3*V1) + VV3(1:3)=>VERTS(3*V2-2:3*V2) + U1 = VV2 - VV1; + U2 = VV3 - VV2; + SELECT CASE(DIR) + CASE(IAXIS) + U1(1) = U1(2); U1(2) = U1(3) + U2(1) = U2(2); U2(2) = U2(3) + CASE(JAXIS) + U1(2) = U1(1); U1(1) = U1(3) + U2(2) = U2(1); U2(1) = U2(3) + CASE(KAXIS) + U1(1) = U1(1); U1(2) = U1(2) + U2(1) = U2(1); U2(2) = U2(2) + END SELECT + U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize + U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize + IF (U1(1)*U2(1)+U1(2)*U2(2) > -EPS_FB) CYCLE + U1XU2 = U1(1)*U2(2)-U1(2)*U2(1) ! U1 x U2 + IF (ABS(U1XU2) < EPS_FB) THEN ! Triple product less than EPS + VERT_DROPPED=.TRUE.; NODE_EXISTS(I)=.FALSE. + IF (IFACE < 3*(NVERTS2-2)) THEN + FACES(IFACE ) = VERT_OFFSET+V0 + FACES(IFACE+1) = VERT_OFFSET+V1 + FACES(IFACE+2) = VERT_OFFSET+V2 + IFACE = IFACE + 3 + ENDIF + IF (NLIST == 3) EXIT OUTER + ENDIF + ENDDO + IF (VERT_DROPPED) THEN + ! Repeat List generation: + NLIST_OLD = NLIST + NLIST = 0 + DO I = 1, NLIST_OLD + IF(NODE_EXISTS(I))THEN + NLIST = NLIST + 1 + VERT_LIST(NLIST) = VERT_LIST(I) + ENDIF + ENDDO + VERT_LIST(0) = VERT_LIST(NLIST) + VERT_LIST(NLIST+1) = VERT_LIST(1) + NODE_EXISTS(1:NLIST+1) = .TRUE. + ENDIF +ENDDO OUTER -T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW +! Here test edges to define LOCTYPE: +LOCTYPE(:) = 4+8+16 +DO IFACE=1,NVERTS2-2 + HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. + DO IEDGE=1,3 + ! Nodes i,i+1: + EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) + DO I=1,NEDGES + IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN + HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. + EXIT + ENDIF + ENDDO + ENDDO + LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) +ENDDO RETURN -END SUBROUTINE GET_X2_INTERSECTIONS - - -! ------------------------ COLLAPSE_CROSSINGS ----------------------------------- - -SUBROUTINE COLLAPSE_CROSSINGS(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,ITITLE) - -TYPE(BODINT_PLANE_TYPE), INTENT(IN) :: BODINT_PLANE2 -INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,ITITLE -REAL(EB), INTENT(IN) :: X3RAY,X1PLN - -! Local Variables: -INTEGER :: CC_N_CRS_AUX -REAL(EB):: CC_SVAR_CRS_AUX(CC_MAXCROSS_X2) -INTEGER :: CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_MAXCROSS_X2),BODNUM(CC_MAXCROSS_X2) -REAL(EB):: CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_MAXCROSS_X2) -INTEGER :: CC_SEG_CRS_AUX(CC_MAXCROSS_X2) -INTEGER :: CRS_NUM(CC_MAXCROSS_X2),IND_CRS(LOW_IND:HIGH_IND,CC_MAXCROSS_X2) -INTEGER :: LEFT_MEDIA, NCRS_REMAIN -INTEGER :: ICRS, ICRS1, ICRS2, IDCR, IDCR2, IND_LEFT, IND_RIGHT, NUBD, IBDNUM, ISEG, IUBD, SBOD -LOGICAL :: DROP_SS_GG, FOUND_LEFT, NOT_COUNTED(CC_MAXCROSS_X2), USE_INT_POINT(CC_MAXCROSS_X2), ALGN_CROSS -INTEGER, ALLOCATABLE, DIMENSION(:) :: UBOD - -CC_N_CRS_AUX = 0 -CC_SVAR_CRS_AUX = 1._EB/GEOMEPS ! svar = x2_intersection -CC_IS_CRS2_AUX = CC_UNDEFINED ! Is the intersection an actual GS. -CC_SEG_CRS_AUX = 0 ! Segment containing the crossing. -CC_SEG_TAN_AUX = 0._EB ! Segment orientation for each intersection. +END SUBROUTINE TRIANGULATE -! Count how many crossings with different SVAR: -CRS_NUM(:) = 0 -ICRS = 1 -CRS_NUM(ICRS) = 1 -IND_CRS(:,:) = 0 -IND_CRS(LOW_IND, CRS_NUM(ICRS)) = ICRS-1 -IND_CRS(HIGH_IND,CRS_NUM(ICRS)) = IND_CRS(HIGH_IND,ICRS)+1 +! ---------------------------- TRILINEAR ---------------------------------------- -DO ICRS=2,CC_N_CRS - IF ( ABS(CC_SVAR_CRS(ICRS)-CC_SVAR_CRS(ICRS-1)) < GEOMEPS ) THEN - CRS_NUM(ICRS) = CRS_NUM(ICRS-1) - ELSE - CRS_NUM(ICRS) = CRS_NUM(ICRS-1)+1 - IND_CRS(LOW_IND,CRS_NUM(ICRS)) = ICRS-1 - ENDIF - IND_CRS(HIGH_IND,CRS_NUM(ICRS)) = IND_CRS(HIGH_IND,CRS_NUM(ICRS))+1 -ENDDO +REAL(EB) FUNCTION TRILINEAR(UU,DXI,LL) -! Computation of CC_BDNUM_CRS_AUX requires knowledge of how many different -! bodies reach an intersection: -BODNUM(:) = 0 -ALLOCATE(UBOD(N_GEOMETRY)); UBOD=0 -IDCR_DO_1 : DO IDCR=1,CRS_NUM(CC_N_CRS) - ! Load body numbers: - DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - ISEG=CC_SEG_CRS(IDCR2) - IF (ISEG > 0) BODNUM(IDCR2)=BODINT_PLANE2%INDSEG(4,ISEG) - ENDDO - ! Unique bodies: - NUBD = 0 - DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF ( BODNUM(IDCR2)<1 ) CYCLE - IF ((NUBD > 0) .AND. ANY(UBOD(1:NUBD)==BODNUM(IDCR2))) CYCLE - NUBD = NUBD + 1 - UBOD(NUBD) = BODNUM(IDCR2) - ENDDO - ! Now assign CC_BDNUM_CRS_AUX(IDCR): - SBOD = 0 - DO IUBD=1,NUBD - ! Drop extra intersections (same intersection type, same body): - USE_INT_POINT(IND_CRS(LOW_IND,IDCR)+1:IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR)) = .TRUE. - DO ICRS1=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF (.NOT.USE_INT_POINT(ICRS1)) CYCLE ! Don't use collapsed point as pivot. - ! Collapse GS or SG points: - DO ICRS2 = IND_CRS(LOW_IND,IDCR)+1 , IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF ( (ICRS2==ICRS1) .OR. .NOT.USE_INT_POINT(ICRS2) ) CYCLE ! Don't use pivot, or collapsed point. - IF ((CC_IS_CRS2(LOW_IND ,ICRS1) == CC_IS_CRS2(LOW_IND ,ICRS2)) .AND. & - (CC_IS_CRS2(HIGH_IND,ICRS1) == CC_IS_CRS2(HIGH_IND,ICRS2)) .AND. & - (BODNUM(ICRS1) == BODNUM(ICRS2))) THEN - USE_INT_POINT(ICRS2) = .FALSE. - ENDIF - ENDDO - ENDDO - IBDNUM=0 - DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF (BODNUM(IDCR2) /= UBOD(IUBD)) CYCLE - IF ( .NOT.USE_INT_POINT(IDCR2) ) CYCLE - IBDNUM = IBDNUM + CC_BDNUM_CRS(IDCR2) - ENDDO - IF (IBDNUM /= 0) SBOD = SBOD + SIGN(1,IBDNUM) - ENDDO - IF (IDCR == 1) THEN - CC_BDNUM_CRS_AUX(IDCR) = SBOD - ELSE - CC_BDNUM_CRS_AUX(IDCR) = CC_BDNUM_CRS_AUX(IDCR-1) + SBOD - ENDIF -ENDDO IDCR_DO_1 -DEALLOCATE(UBOD) +REAL(EB), INTENT(IN) :: UU(0:1,0:1,0:1),DXI(3),LL(3) +REAL(EB) :: XX,YY,ZZ +! Comments: +! +! see http://local.wasp.uwa.edu.au/~pbourke/miscellaneous/interpolation/index.html +! with appropriate scaling. LL is length of side. +! +! UU(1,1,1) +! z /----------/ +! ^/ / | +! ------------ | Particle position +! | | | +! LL(3) | o<-----|------- DXI = [DXI(1),DXI(2),DXI(3)] +! | | / +! | |/ Particle property at XX = TRILINEAR +! ------------> x +! ^ +! | +! X0 = [0,0,0] +! +! UU(0,0,0) +! +!=========================================================== -! This is where we merge intersections at same svar location (i.e. same CRS_NUM value): -! Loop over different crossings: -LEFT_MEDIA = CC_GASPHASE ! Here we could change the initial LEFT_MEDIA to CC_SOLID if needed. Would require adding - ! CC_BDNUM_CRS(LOW_IND,0) = 1, i.e crossed into SOLID at x2 -> -Inf. -IDCR_DO_2 : DO IDCR=1,CRS_NUM(CC_N_CRS) +XX = DXI(1)/LL(1) +YY = DXI(2)/LL(2) +ZZ = DXI(3)/LL(3) - CC_N_CRS_AUX = CC_N_CRS_AUX + 1 - ! Case of single crossing with new svar: - SNGL_CRS_IF : IF ( IND_CRS(HIGH_IND,IDCR) == 1 ) THEN +TRILINEAR = UU(0,0,0)*(1._EB-XX)*(1._EB-YY)*(1._EB-ZZ) + & + UU(1,0,0)*XX*(1._EB-YY)*(1._EB-ZZ) + & + UU(0,1,0)*(1._EB-XX)*YY*(1._EB-ZZ) + & + UU(0,0,1)*(1._EB-XX)*(1._EB-YY)*ZZ + & + UU(1,0,1)*XX*(1._EB-YY)*ZZ + & + UU(0,1,1)*(1._EB-XX)*YY*ZZ + & + UU(1,1,0)*XX*YY*(1._EB-ZZ) + & + UU(1,1,1)*XX*YY*ZZ - ICRS =IND_CRS(LOW_IND,IDCR) + 1 +END FUNCTION TRILINEAR - IF ( (ICRS>1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN - ! Test if already inside an Object. - CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) = CC_SOLID - ELSEIF ( CC_IS_CRS2(LOW_IND,ICRS) /= LEFT_MEDIA ) THEN +! ---------------------------- RAY_TRIANGLE_INTERSECT_PT ---------------------------------------- - ! Check if this is a single point SGLS which was initially tagged as CC_GASPHASE, - ! if so switch media type to LEFT_MEDIA - IF (CC_SEG_CRS(ICRS) < 0) THEN - CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) = LEFT_MEDIA - ELSE - IF (ITITLE==1) THEN - WRITE(LU_ERR,*) "Error GET_X2INTERSECTIONS: IS_CRS(LOW_IND,ICRS) ~= LEFT_MEDIA, media continuity problem" - WRITE(LU_ERR,*) "X1AXIS,X1PLN=",X1AXIS,X1PLN,", X2AXIS,X3AXIS=",X2AXIS,X3AXIS,", RAY X3 POSITION=",X3RAY - ELSEIF (ITITLE==2) THEN - WRITE(LU_ERR,*) "Error GET_IS_SOLID_PT: IS_CRS(LOW_IND,ICRS) ~= LEFT_MEDIA, media continuity problem" - WRITE(LU_ERR,*) "X1AXIS,X1PLN=",X1AXIS,X1PLN,", X2AXIS,X3AXIS=",X2AXIS,X3AXIS,", RAY X3 POSITION=",X3RAY - ENDIF - IF (IDCR==1) THEN - ! FIXME: this should be the error message, IG should be made available here - ! WRITE(MESSAGE,'(A,A,A)') "ERROR: GEOM ID='", TRIM(GEOMETRY(IG)%ID), & - ! "': Face normals are probably pointing in the wrong direction. Check they point towards the gas phase." - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A)') " SUCCESS: GEOM ID Unknown:" - ELSE - WRITE(LU_ERR,'(A)') " ERROR(726): GEOM ID Unknown:" - ENDIF - WRITE(LU_ERR,'(A)') " Face normals are probably pointing in the wrong direction. " - WRITE(LU_ERR,'(A)') " Check they point towards the gas phase." - ENDIF - CALL SHUTDOWN("") ; RETURN - ENDIF - ENDIF +SUBROUTINE RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,D,IS_INTERSECT,POS) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - CC_SVAR_CRS_AUX(CC_N_CRS_AUX) = CC_SVAR_CRS(ICRS) - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) - CC_SEG_CRS_AUX(CC_N_CRS_AUX) = CC_SEG_CRS(ICRS) - CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_N_CRS_AUX) = CC_SEG_TAN(IAXIS:JAXIS,ICRS) - LEFT_MEDIA = CC_IS_CRS2(HIGH_IND,ICRS) +! V1(3), V2(3), V3(3) triangle vertices coordinates. +! XP(3) -> Ray origin coordinates. +! D(3) -> Ray direction. +! OUTPUT : +! IS_INTERSECT, .TRUE. if these is intersection. +! POS(3), coordinates of intersection point. - CYCLE +REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3),XP(3),D(3) +LOGICAL, INTENT(OUT):: IS_INTERSECT +REAL(EB), INTENT(OUT):: POS(3) - ENDIF SNGL_CRS_IF +REAL(EB) :: E1(3),E2(3),P(3),S(3),Q(3),U,V,TMP,T +REAL(EB), PARAMETER :: EPS=1.E-10_EB - ! Case of several crossings with new svar: - DROP_SS_GG = .FALSE. - DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF ( CC_IS_CRS2(LOW_IND,ICRS) /= CC_IS_CRS2(HIGH_IND,ICRS) ) THEN - DROP_SS_GG = .TRUE. - EXIT - ENDIF - ENDDO +! Schneider and Eberly, Section 11.1 +IS_INTERSECT = .FALSE. +POS(1:3) = 1._EB/TWENTY_EPSILON_EB - ! Variables related to new svar crossing: - ICRS = IND_CRS(LOW_IND,IDCR) + 1 - CC_SVAR_CRS_AUX(CC_N_CRS_AUX) = CC_SVAR_CRS(ICRS) - CC_SEG_CRS_AUX(CC_N_CRS_AUX) = CC_SEG_CRS(ICRS) - CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_N_CRS_AUX) = CC_SEG_TAN(IAXIS:JAXIS,ICRS) +E1 = V2-V1 +E2 = V3-V1 - ! Case of intersection inside segment aligned with SVAR location, i.e. - ! intersection among two bodies or self intersection: - ALGN_CROSS=.FALSE. - DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF ( CC_IS_CRS2(HIGH_IND+1,ICRS) /= CC_SOLID ) CYCLE - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID - ALGN_CROSS=.TRUE. - EXIT - ENDDO - IF ( ALGN_CROSS ) CYCLE +CALL CROSS_PRODUCT(P,D,E2) - ! Now figure out the type of crossing: - NOT_COUNTED = .TRUE. - NCRS_REMAIN = IND_CRS(HIGH_IND,IDCR) - DROP_SS_GG_IF : IF (DROP_SS_GG) THEN +TMP = DOT_PRODUCT(P,E1) - ! Points of the same type are collapsed: - USE_INT_POINT(IND_CRS(LOW_IND,IDCR)+1:IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR)) = .TRUE. - DO ICRS1 = IND_CRS(LOW_IND,IDCR)+1, IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) ! Pivot Loop - IF(.NOT.USE_INT_POINT(ICRS1)) CYCLE ! Don't use collapsed point as pivot. - DO ICRS2 = IND_CRS(LOW_IND,IDCR)+1, IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - IF( (ICRS2==ICRS1) .OR. .NOT.USE_INT_POINT(ICRS2) ) CYCLE ! Don't use pivot, or collapsed point. - IF( (CC_IS_CRS2(LOW_IND ,ICRS1) == CC_IS_CRS2(LOW_IND ,ICRS2)) .AND. & - (CC_IS_CRS2(HIGH_IND,ICRS1) == CC_IS_CRS2(HIGH_IND,ICRS2)) .AND. & - (BODNUM(ICRS1) == BODNUM(ICRS2)) ) USE_INT_POINT(ICRS2) = .FALSE. - ENDDO - ENDDO +IF ( ABS(TMP)(1._EB+EPS)) RETURN ! No intersection. - IND_LEFT = IND_LEFT + CC_IS_CRS2(LOW_IND,ICRS) - IND_RIGHT = IND_RIGHT + CC_IS_CRS2(HIGH_IND,ICRS) - ENDDO +CALL CROSS_PRODUCT(Q,S,E1) +V = TMP*DOT_PRODUCT(D,Q) +IF (V<-EPS .OR. (U+V)>(1._EB+EPS)) RETURN ! No intersection. - IF (IND_LEFT /= 0) IND_LEFT = SIGN(1,IND_LEFT) - IF (IND_RIGHT /= 0) IND_RIGHT = SIGN(1,IND_RIGHT) +T = TMP*DOT_PRODUCT(E2,Q) +IF (T <= 0._EB) RETURN ! No intersection. - IF ( (IDCR>1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN - ! Test if we are inside an Object. - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID; ! GS or SG. +IS_INTERSECT = .TRUE. +POS = XP + T*D ! the intersection point - ELSEIF (ABS(IND_LEFT)+ABS(IND_RIGHT) == 0) THEN ! Same number of SG and GS crossings, - ! both sides of the crossing - ! defined as left_media: - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = LEFT_MEDIA - ELSEIF (IND_LEFT == LEFT_MEDIA) THEN - CC_IS_CRS2_AUX((/ LOW_IND, HIGH_IND/),CC_N_CRS_AUX) = (/ IND_LEFT, IND_RIGHT /) ! GS or SG. - ELSE - IF (ITITLE==1) THEN - WRITE(LU_ERR,*) "Error GET_X2INTERSECTIONS: DROP_SS_GG = .TRUE., Didn't find left side continuity." - ELSEIF (ITITLE==2) THEN - WRITE(LU_ERR,*) "Error GET_IS_SOLID_PT: DROP_SS_GG = .TRUE., Didn't find left side continuity." - ENDIF - ! WRITE(LU_ERR,*) "BODINT_PLANE, NSGLS, NSEGS=",BODINT_PLANE%NSGLS,BODINT_PLANE%NSEGS - ! WRITE(LU_ERR,*) "X1PLN, X2AXIS, X3AXIS, X3RAY=",X1PLN,X2AXIS,X3AXIS,X3RAY - ! WRITE(LU_ERR,*) "CC_N_CRS=",CC_N_CRS,", IDCR=",IDCR - ! WRITE(LU_ERR,*) ICRS,"IND_LEFT=",IND_LEFT,", IND_RIGHT=",IND_RIGHT - ! WRITE(LU_ERR,*) "CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS)",CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) - ! DO IAUX=1,CC_N_CRS - ! WRITE(LU_ERR,*) IAUX,CRS_NUM(CC_N_CRS),IND_LEFT,IND_RIGHT,CC_SVAR_CRS(IND_CRS(LOW_IND,IAUX)+1) - ! ENDDO - ! WRITE(LU_ERR,*) ' ' - ! CALL DEBUG_WAIT - ENDIF - LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) +RETURN +END SUBROUTINE RAY_TRIANGLE_INTERSECT_PT - ELSE ! Intersections are either GG or SS +! ---------------------------- POINT_IN_BB ---------------------------------------- - ! Left side: - FOUND_LEFT = .FALSE. - DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) +LOGICAL FUNCTION POINT_IN_BB(V1,BB) - ! Case GG or SS with CC_IS_CRS2(LOW_IND,ICRS) == LEFT_MEDIA: - ! This collapses all types SS or GG that have the left side - ! type. Note they should all be one type (either GG or SS): - IF (CC_IS_CRS2(LOW_IND,ICRS) == LEFT_MEDIA) THEN - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) - NOT_COUNTED(ICRS) = .FALSE. - NCRS_REMAIN = NCRS_REMAIN-1 - FOUND_LEFT = .TRUE. - ENDIF - ENDDO +REAL(EB), INTENT(IN) :: V1(3),BB(6) - IF ( (IDCR>1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN - ! Test if we are inside an Object. - CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID - LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) - CYCLE - ENDIF +POINT_IN_BB=.FALSE. +IF ( V1(1)>=BB(1) .AND. V1(1)<=BB(2) .AND. & + V1(2)>=BB(3) .AND. V1(2)<=BB(4) .AND. & + V1(3)>=BB(5) .AND. V1(3)<=BB(6) ) THEN + POINT_IN_BB=.TRUE. + RETURN +ENDIF - IF (.NOT.FOUND_LEFT) print*, "Error GET_X2INTERSECTIONS: DROP_SS_GG = .FALSE., Didn't find left side continuity." - IF ( NCRS_REMAIN /= 0) print*, "Error GET_X2INTERSECTIONS: DROP_SS_GG = .FALSE., NCRS_REMAIN /= 0." +RETURN +END FUNCTION POINT_IN_BB - LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) +! ---------------------------- POLYGON_AREA ---------------------------------------- - ENDIF DROP_SS_GG_IF +REAL(EB) FUNCTION POLYGON_AREA(NP,PC) +! Calculate the area of a polygon -ENDDO IDCR_DO_2 +INTEGER, INTENT(IN) :: NP +REAL(EB), INTENT(IN) :: PC(60) +INTEGER :: I,K +REAL(EB) :: V1(3),V2(3),V3(3) -! Copy final results: -CC_N_CRS = CC_N_CRS_AUX -CC_SVAR_CRS(1:CC_MAXCROSS_X2) = CC_SVAR_CRS_AUX(1:CC_MAXCROSS_X2) -CC_SEG_CRS(1:CC_MAXCROSS_X2) = CC_SEG_CRS_AUX(1:CC_MAXCROSS_X2) -CC_SEG_TAN(IAXIS:JAXIS,1:CC_MAXCROSS_X2) = CC_SEG_TAN_AUX(IAXIS:JAXIS,1:CC_MAXCROSS_X2) -! CC_IS_CRS2(LOW_IND:HIGH_IND,1:CC_MAXCROSS_X2) = CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,1:CC_MAXCROSS_X2) +POLYGON_AREA = 0._EB +V3 = POLYGON_CENTROID(NP,PC) -DO ICRS=1,CC_N_CRS - CC_IS_CRS(ICRS) = 2*( CC_IS_CRS2_AUX(LOW_IND,ICRS) + 1 ) - CC_IS_CRS2_AUX(HIGH_IND,ICRS) +DO I=1,NP + IF (I < NP) THEN + DO K=1,3 + V1(K) = PC((I-1)*3+K) + V2(K) = PC(I*3+K) + ENDDO + ELSE + DO K=1,3 + V1(K) = PC((I-1)*3+K) + V2(K) = PC(K) + ENDDO + ENDIF + POLYGON_AREA = POLYGON_AREA+TRIANGLE_AREA(V1,V2,V3) ENDDO RETURN -END SUBROUTINE COLLAPSE_CROSSINGS +END FUNCTION POLYGON_AREA +! ---------------------------- POLYGON_CENTROID ---------------------------------------- -! ------------------------- INSERT_RAY_CROSS ------------------------------------ +REAL(EB) FUNCTION POLYGON_CENTROID(NP,PC) +! Calculate the centroid of polygon vertices -SUBROUTINE INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) +DIMENSION :: POLYGON_CENTROID(3) +INTEGER, INTENT(IN) :: NP +REAL(EB), INTENT(IN) :: PC(60) +INTEGER :: I,K -REAL(EB), INTENT(IN) :: SVARI, STANI(IAXIS:JAXIS) -INTEGER, INTENT(IN) :: ICRSI(LOW_IND:HIGH_IND+1), SCRSI +POLYGON_CENTROID = 0._EB +DO I=1,NP + DO K=1,3 + POLYGON_CENTROID(K) = POLYGON_CENTROID(K)+PC((I-1)*3+K)/NP + ENDDO +ENDDO -! Local Variables: -INTEGER :: ICRS, IDUM -REAL(EB), ALLOCATABLE, DIMENSION(:) :: CC_SVAR_CRS_DUM -INTEGER, ALLOCATABLE, DIMENSION(:) :: CC_IS_CRS_DUM,CC_SEG_CRS_DUM,CC_BDNUM_CRS_DUM,CC_BDNUM_CRS_AUX_DUM -INTEGER, ALLOCATABLE, DIMENSION(:,:):: CC_IS_CRS2_DUM -REAL(EB), ALLOCATABLE, DIMENSION(:,:):: CC_SEG_TAN_DUM +RETURN +END FUNCTION POLYGON_CENTROID +! ---------------------------- INTERSECT_SPHERE_AABB ---------------------------------------- -CC_N_CRS = CC_N_CRS + 1 +! Algorithm from Schneider and Eberly, p. 644 +! Intersection of Sphere and Axis-Aligned Bounding Box -! Test maximum crossings defined: -IF ( CC_N_CRS > CC_MAXCROSS_X2) THEN - IDUM = CC_MAXCROSS_X2 - CC_MAXCROSS_X2 = IDUM + DELTA_CROSS_X2 - ! Allocate Intersection variables: - ALLOCATE(CC_SVAR_CRS_DUM(CC_MAXCROSS_X2),CC_IS_CRS_DUM(CC_MAXCROSS_X2),CC_SEG_CRS_DUM(CC_MAXCROSS_X2)) - CC_SVAR_CRS_DUM = 1._EB/GEOMEPS; CC_SVAR_CRS_DUM(1:IDUM) = CC_SVAR_CRS(1:IDUM) - CC_IS_CRS_DUM = CC_UNDEFINED; - CC_SEG_CRS_DUM = 0; CC_SEG_CRS_DUM(1:IDUM) = CC_SEG_CRS(1:IDUM) - ALLOCATE(CC_BDNUM_CRS_DUM(0:CC_MAXCROSS_X2),CC_BDNUM_CRS_AUX_DUM(0:CC_MAXCROSS_X2)) - CC_BDNUM_CRS_DUM = 0; CC_BDNUM_CRS_DUM(0:IDUM) = CC_BDNUM_CRS(0:IDUM) - CC_BDNUM_CRS_AUX_DUM= 0; CC_BDNUM_CRS_AUX_DUM(0:IDUM) = CC_BDNUM_CRS_AUX(0:IDUM) - ALLOCATE(CC_IS_CRS2_DUM(LOW_IND:HIGH_IND+1,CC_MAXCROSS_X2),CC_SEG_TAN_DUM(IAXIS:JAXIS,CC_MAXCROSS_X2)) - CC_IS_CRS2_DUM = CC_UNDEFINED; CC_IS_CRS2_DUM(LOW_IND:HIGH_IND+1,1:IDUM) = CC_IS_CRS2(LOW_IND:HIGH_IND+1,1:IDUM) - CC_SEG_TAN_DUM = 0._EB; CC_SEG_TAN_DUM(IAXIS:JAXIS,1:IDUM) = CC_SEG_TAN(IAXIS:JAXIS,1:IDUM) - CALL MOVE_ALLOC(FROM=CC_SVAR_CRS_DUM,TO=CC_SVAR_CRS) - CALL MOVE_ALLOC(FROM=CC_IS_CRS_DUM,TO=CC_IS_CRS) - CALL MOVE_ALLOC(FROM=CC_SEG_CRS_DUM,TO=CC_SEG_CRS) - CALL MOVE_ALLOC(FROM=CC_BDNUM_CRS_DUM,TO=CC_BDNUM_CRS) - CALL MOVE_ALLOC(FROM=CC_BDNUM_CRS_AUX_DUM,TO=CC_BDNUM_CRS_AUX) - CALL MOVE_ALLOC(FROM=CC_IS_CRS2_DUM,TO=CC_IS_CRS2) - CALL MOVE_ALLOC(FROM=CC_SEG_TAN_DUM,TO=CC_SEG_TAN) +LOGICAL FUNCTION INTERSECT_SPHERE_AABB(X0,RADIUS,XB) + +REAL(EB), INTENT(IN) :: X0(3),RADIUS,XB(6) +REAL(EB) :: DIST_SQUARED + +INTERSECT_SPHERE_AABB=.TRUE. + +! Compute distance in each direction, summing as we go +DIST_SQUARED = 0._EB +IF (X0(1)XB(2)) THEN + DIST_SQUARED = DIST_SQUARED + (X0(1)-XB(2))**2 +ENDIF +IF (X0(2)XB(4)) THEN + DIST_SQUARED = DIST_SQUARED + (X0(2)-XB(4))**2 ENDIF +IF (X0(3)XB(6)) THEN + DIST_SQUARED = DIST_SQUARED + (X0(3)-XB(6))**2 +ENDIF + +! Compare squared distance to radius squared +IF (DIST_SQUARED > (RADIUS*RADIUS-TWENTY_EPSILON_EB)) INTERSECT_SPHERE_AABB=.FALSE. -! Add in place, ascending value order: -DO ICRS=1,CC_N_CRS ! The updated CC_N_CRS is for ICRS to reach the - ! initialization value CC_SVAR_CRS(ICRS)=1/GEOMEPS. - IF ( SVARI < CC_SVAR_CRS(ICRS) ) EXIT -ENDDO +RETURN +END FUNCTION INTERSECT_SPHERE_AABB -! Here copy from the back (updated CC_N_CRS) to the ICRS location: -! if ICRS=CC_N_CRS -> nothing gets copied: -DO IDUM = CC_N_CRS,ICRS+1,-1 - CC_SVAR_CRS(IDUM) = CC_SVAR_CRS(IDUM-1) - CC_IS_CRS2(LOW_IND:HIGH_IND+1,IDUM) = CC_IS_CRS2(LOW_IND:HIGH_IND+1,IDUM-1) - CC_SEG_CRS(IDUM) = CC_SEG_CRS(IDUM-1); - CC_SEG_TAN(IAXIS:JAXIS,IDUM)= CC_SEG_TAN(IAXIS:JAXIS,IDUM-1); - CC_BDNUM_CRS(IDUM) = CC_BDNUM_CRS(IDUM-1) -ENDDO +! ---------------------------- INTERSECT_CYLINDER_AABB ---------------------------------------- -CC_SVAR_CRS(ICRS) = SVARI ! x2 location. -CC_IS_CRS2(LOW_IND:HIGH_IND+1,ICRS) = ICRSI(LOW_IND:HIGH_IND+1) ! Does point separate GASPHASE from SOLID? -CC_SEG_CRS(ICRS) = SCRSI ! Segment on BOINT_PLANE the crossing belongs to. -CC_SEG_TAN(IAXIS:JAXIS,ICRS) = STANI(IAXIS:JAXIS) ! CC_SEG_TAN might not be needed in new implementation. -CC_BDNUM_CRS(ICRS) = 0 -IF (SCRSI > 0) THEN - IF(ICRSI(LOW_IND) == CC_GASPHASE .AND. ICRSI(HIGH_IND) == CC_SOLID) THEN - CC_BDNUM_CRS(ICRS) = 1 - ELSEIF(ICRSI(LOW_IND) == CC_SOLID .AND. ICRSI(HIGH_IND) == CC_GASPHASE) THEN - CC_BDNUM_CRS(ICRS) =-1 +! Intersection of Cylinder and Axis-Aligned Bounding Box +! +! Cylinder is represented by: +! X_IN = bottom-center of cylinder (X,Y,Z) in grid reference frame +! H = length of cylinder +! RADIUS = radius of cylinder +! AX_VEC = unit vector pointing along cylinder axis (which leads to ROT_MAT using ROTATION_MATRIX) +! +! The basic algorithm is: +! 1. rotate the cylinder into a frame where the axis points in the vertical direction (+zbar in new frame) +! 2. find the vertex point locations of AABB in this new frame +! 3. test each vertex location against the end caps of cylinder +! 4. test each vertex against radius of cylinder + +LOGICAL FUNCTION INTERSECT_CYLINDER_AABB(X_IN,H,RADIUS,ROTMAT,XB) + +REAL(EB), INTENT(IN) :: X_IN(3),H,RADIUS,ROTMAT(3,3),XB(6) +REAL(EB) :: X(3),U(3),V(3),DUX(2),Z0,ZH,R2,DIST_SQUARED + +INTERSECT_CYLINDER_AABB=.FALSE. + +X = MATMUL(ROTMAT,X_IN) ! transform center +Z0 = X(3) ! lower cap in new reference frame +ZH = X(3) + H ! upper cap in new reference frame + +! transform vertices and test against end caps, then radius +R2 = RADIUS*RADIUS +V = (/0.5_EB*(XB(1)+XB(2)),0.5_EB*(XB(3)+XB(4)),0.5_EB*(XB(5)+XB(6))/) +U = MATMUL(ROTMAT,V) +IF (U(3)>=Z0 .AND. U(3)<=ZH) THEN + ! centroid is within end-cap range, now test against radius + ! in new frame the distance from centroid to cylinder axis only requires the 1st and 2nd vector components + DUX = U(1:2) - X(1:2) + DIST_SQUARED = DOT_PRODUCT(DUX,DUX) + IF (DIST_SQUARED < R2+TWENTY_EPSILON_EB) THEN + INTERSECT_CYLINDER_AABB = .TRUE. + RETURN ENDIF ENDIF + RETURN -END SUBROUTINE INSERT_RAY_CROSS +END FUNCTION INTERSECT_CYLINDER_AABB -! ----------------------- GET_BODINT_NODE_INDEX ---------------------------------- +! ---------------------------- ROTATION_MATRIX ---------------------------------------- -SUBROUTINE GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ,IND_PI) +SUBROUTINE ROTATION_MATRIX(R_OUT,A_IN,THETA) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE -INTEGER, INTENT(IN) :: X2AXIS,X3AXIS -REAL(EB), INTENT(IN) :: XYZ(MAX_DIM) -INTEGER, INTENT(OUT) :: IND_PI +REAL(EB), INTENT(OUT) :: R_OUT(3,3) +REAL(EB), INTENT(IN) :: A_IN(3),THETA +REAL(EB) :: A(3),C,DENOM,V(3),A1(3),A2(3),A3(3),B1(3),B2(3),B3(3),R_THETA(3,3) -! Local variables: -INTEGER :: INOD=1, PIVOT(LOW_IND:HIGH_IND), INOD2 -REAL(EB):: DIFFX2, DIFFX3 +! initialize 2D rotation matrix +! this is a counterclockwise rotation +R_THETA = 0._EB +R_THETA(1,1) = COS(THETA*DEG2RAD); R_THETA(1,2) = SIN(THETA*DEG2RAD) +R_THETA(2,1) = -SIN(THETA*DEG2RAD); R_THETA(2,2) = COS(THETA*DEG2RAD) +R_THETA(3,3) = 1._EB -! Test if XYZ is already on BODINT_PLANE%XYZ: -IND_PI = -1 ! Initialize to negative index. -IF (BODINT_PLANE%NNODS < LINSEARCH_LIMIT) THEN - ! Linear Search: - DO INOD=1,BODINT_PLANE%NNODS - DIFFX2 = BODINT_PLANE%XYZ(X2AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X2AXIS) - IF( DIFFX2 > GEOMEPS ) THEN - EXIT - ELSEIF( ABS(DIFFX2) <= GEOMEPS) THEN - DIFFX3 = BODINT_PLANE%XYZ(X3AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X3AXIS) - IF ( DIFFX3 > GEOMEPS ) THEN - EXIT - ELSEIF ( ABS(DIFFX3) <= GEOMEPS ) THEN - IND_PI = BODINT_PLANE%NOD_PERM(INOD) - RETURN - ENDIF - ENDIF - ENDDO -ELSE - ! Binary Search: - PIVOT(LOW_IND) = 0 - PIVOT(HIGH_IND)= BODINT_PLANE%NNODS + 1 - DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) - INOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 - DIFFX2 = BODINT_PLANE%XYZ(X2AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X2AXIS) - IF( DIFFX2 < -GEOMEPS ) THEN - PIVOT(LOW_IND) = INOD - ELSEIF( DIFFX2 > GEOMEPS ) THEN - PIVOT(HIGH_IND)= INOD - ELSE ! ABS(DIFFX2) < GEOMEPS - DIFFX3 = BODINT_PLANE%XYZ(X3AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X3AXIS) - IF ( DIFFX3 < -GEOMEPS ) THEN - PIVOT(LOW_IND) = INOD - ELSEIF( DIFFX3 > GEOMEPS ) THEN - PIVOT(HIGH_IND)= INOD - ELSE ! ABS(DIFFX3) < GEOMEPS - IND_PI = BODINT_PLANE%NOD_PERM(INOD) - RETURN - ENDIF - ENDIF - ENDDO - INOD=PIVOT(HIGH_IND) -ENDIF +! initialize R_OUT as 2D rotation matrix +R_OUT = R_THETA -! Insert add NOD_PERM permutation array, O(NP) operation: -DO INOD2=BODINT_PLANE%NNODS+1,INOD+1,-1 - BODINT_PLANE%NOD_PERM(INOD2) = BODINT_PLANE%NOD_PERM(INOD2-1) -ENDDO -IND_PI = BODINT_PLANE%NNODS + 1 -BODINT_PLANE%NNODS = IND_PI -BODINT_PLANE%NOD_PERM(INOD) = IND_PI -BODINT_PLANE%XYZ(IAXIS:KAXIS,IND_PI) = XYZ(IAXIS:KAXIS) +! normalize input vector +DENOM = SQRT(DOT_PRODUCT(A_IN,A_IN)) +IF (DENOM0._EB) THEN + RETURN + ELSE + R_OUT = -R_OUT + RETURN + ENDIF +ENDIF -! SUBROUTINE GET_BODINT_NODE_INDEX(X2AXIS,X3AXIS,XYZ,IND_PI) -! -! INTEGER, INTENT(IN) :: X2AXIS,X3AXIS -! REAL(EB), INTENT(IN) :: XYZ(MAX_DIM) -! INTEGER, INTENT(OUT) :: IND_PI -! -! ! Local variables: -! !LOGICAL :: INLIST -! INTEGER :: INOD -! -! ! Test if XYZ is already on BODINT_PLANE%XYZ: -! ! INLIST = .FALSE. -! IND_PI = -1 ! Initialize to negative index. -! DO INOD=1,BODINT_PLANE%NNODS -! IF(ABS(BODINT_PLANE%XYZ(X2AXIS,INOD)-XYZ(X2AXIS)) > GEOMEPS) CYCLE -! IF(ABS(BODINT_PLANE%XYZ(X3AXIS,INOD)-XYZ(X3AXIS)) > GEOMEPS) CYCLE -! IND_PI = INOD -! RETURN -! ENDDO -! -! WRITE(LU_ERR,*) 'X2AXIS,X3AXIS',X2AXIS,X3AXIS,BODINT_PLANE%NNODS,INOD -! IND_PI = BODINT_PLANE%NNODS + 1 -! BODINT_PLANE%NNODS = IND_PI -! BODINT_PLANE%XYZ(IAXIS:KAXIS,IND_PI) = XYZ -! DO INOD=1,BODINT_PLANE%NNODS -! WRITE(LU_ERR,*) INOD,BODINT_PLANE%XYZ(IAXIS:KAXIS,INOD) -! ENDDO -! RETURN -! END SUBROUTINE GET_BODINT_NODE_INDEX +! find orthnormal basis for A=A3 in old system +A3 = A +CALL CROSS_PRODUCT(A2,B3,A3) +CALL CROSS_PRODUCT(A1,A2,A3) -! -------------------- LINE_INTERSECT_COORDPLANE -------------------------------- +! rotation matrix (direction cosines), Pope (2000), Eq. (A.11) -SUBROUTINE LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LNC,XYZ_INT,INTFLG) +R_OUT(1,1) = DOT_PRODUCT(A1,B1); R_OUT(1,2) = DOT_PRODUCT(A1,B2); R_OUT(1,3) = DOT_PRODUCT(A1,B3) +R_OUT(2,1) = DOT_PRODUCT(A2,B1); R_OUT(2,2) = DOT_PRODUCT(A2,B2); R_OUT(2,3) = DOT_PRODUCT(A2,B3) +R_OUT(3,1) = DOT_PRODUCT(A3,B1); R_OUT(3,2) = DOT_PRODUCT(A3,B2); R_OUT(3,3) = DOT_PRODUCT(A3,B3) -INTEGER, INTENT(IN) :: X1AXIS -REAL(EB), INTENT(IN) :: X1PLN,PLNORMAL(MAX_DIM),LNC(MAX_DIM,NOD1:NOD2) -REAL(EB), INTENT(OUT):: XYZ_INT(MAX_DIM) -LOGICAL, INTENT(OUT) :: INTFLG +R_OUT = MATMUL(R_OUT,R_THETA) -! Local variables: -REAL(EB) :: DVEC(MAX_DIM), DIRV(MAX_DIM), NMDV, DENOM, PLNEQ, TLINE -! REAL(QB) :: DVECQ(MAX_DIM), DIRVQ(MAX_DIM), NMDVQ, DENOMQ, PLNEQQ, TLINEQ +! ! test +! print *,R_OUT(1,:) +! print *,R_OUT(2,:) +! print *,R_OUT(3,:) +! print *,MATMUL(R_OUT,A) ! result should be B3 +! stop +END SUBROUTINE ROTATION_MATRIX -! Initialize: -INTFLG = .FALSE. -XYZ_INT(IAXIS:KAXIS) = 0._EB +! ---------------------------- INTERSECT_CONE_AABB ---------------------------------------- -! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN -! Preliminary calculations: -DVEC(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD2) - LNC(IAXIS:KAXIS,NOD1) -NMDV = SQRT( DVEC(IAXIS)**2._EB + DVEC(JAXIS)**2._EB + DVEC(KAXIS)**2._EB ) -DIRV = DVEC(IAXIS:KAXIS) * NMDV**(-1._EB) -DENOM = DIRV(IAXIS)*PLNORMAL(IAXIS) +DIRV(JAXIS)*PLNORMAL(JAXIS) +DIRV(KAXIS)*PLNORMAL(KAXIS) -PLNEQ = LNC(IAXIS,NOD1)*PLNORMAL(IAXIS) + & - LNC(JAXIS,NOD1)*PLNORMAL(JAXIS) + & - LNC(KAXIS,NOD1)*PLNORMAL(KAXIS) - X1PLN +! This routine basically follows the INTERSECT_CYLINDER_AABB algorithm, with radius = R(Z) -! Line parallel to plane: -IF ( ABS(DENOM) < GEOMEPS ) THEN - ! Check if seg lies on plane or not. - ! Do this by checking if node one of segment is on plane. - IF ( ABS(PLNEQ) < GEOMEPS ) THEN - XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1); XYZ_INT(X1AXIS) = X1PLN - INTFLG = .TRUE. - ENDIF - RETURN -ENDIF +LOGICAL FUNCTION INTERSECT_CONE_AABB(X_IN,H,RADIUS,ROTMAT,XB) -! Non parallel case: -TLINE = -PLNEQ/DENOM ! Coordinate along the line LNC. -XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1) + TLINE*DIRV(IAXIS:KAXIS) ! Intersection point. -XYZ_INT(X1AXIS) = X1PLN ! Force X1AXIS coordinate to be the planes value. -! ELSE -! ! Preliminary calculations: -! DVECQ(IAXIS:KAXIS) = REAL(LNC(IAXIS:KAXIS,NOD2),QB) - REAL(LNC(IAXIS:KAXIS,NOD1),QB) -! NMDVQ = SQRT( DVECQ(IAXIS)**2._QB + DVECQ(JAXIS)**2._QB + DVECQ(KAXIS)**2._QB ) -! DIRVQ = DVECQ(IAXIS:KAXIS) * NMDVQ**(-1._QB) -! DENOMQ = DIRVQ(IAXIS)*REAL(PLNORMAL(IAXIS),QB) + & -! DIRVQ(JAXIS)*REAL(PLNORMAL(JAXIS),QB) + & -! DIRVQ(KAXIS)*REAL(PLNORMAL(KAXIS),QB) -! PLNEQQ = REAL(LNC(IAXIS,NOD1),QB)*REAL(PLNORMAL(IAXIS),QB) + & -! REAL(LNC(JAXIS,NOD1),QB)*REAL(PLNORMAL(JAXIS),QB) + & -! REAL(LNC(KAXIS,NOD1),QB)*REAL(PLNORMAL(KAXIS),QB) - REAL(X1PLN,QB) -! -! ! Line parallel to plane: -! IF ( ABS(REAL(DENOMQ,EB)) < GEOMEPS ) THEN -! ! Check if seg lies on plane or not. -! ! Do this by checking if node one of segment is on plane. -! IF ( ABS(REAL(PLNEQ,EB)) < GEOMEPS ) THEN -! XYZ_INT(IAXIS:KAXIS) = LNC(IAXIS:KAXIS,NOD1); XYZ_INT(X1AXIS) = X1PLN -! INTFLG = .TRUE. -! ENDIF -! RETURN -! ENDIF -! -! ! Non parallel case: -! TLINEQ = -PLNEQQ/DENOMQ ! Coordinate along the line LNC. -! XYZ_INT(IAXIS:KAXIS) = REAL(REAL(LNC(IAXIS:KAXIS,NOD1),QB)+TLINEQ*DIRVQ(IAXIS:KAXIS),EB) ! Intersection pt. -! XYZ_INT(X1AXIS) = X1PLN ! Force X1AXIS coordinate to be the planes value. -! ENDIF +REAL(EB), INTENT(IN) :: X_IN(3),H,RADIUS,ROTMAT(3,3),XB(6) +REAL(EB) :: X(3),U(3),V(3),DUX(2),Z0,ZH,DIST_SQUARED,R_Z +INTEGER :: II,JJ,KK + +INTERSECT_CONE_AABB=.FALSE. -INTFLG = .TRUE. +X = MATMUL(ROTMAT,X_IN) ! transform center +Z0 = X(3) ! lower cap in new reference frame +ZH = X(3) + H ! upper cap in new reference frame + +! transform vertices and test against end caps, then radius +DO KK=5,6 + DO JJ=3,4 + DO II=1,2 + V = (/XB(II),XB(JJ),XB(KK)/) + U = MATMUL(ROTMAT,V) + IF (U(3)>=Z0 .AND. U(3)<=ZH) THEN + ! vertex is within end-cap range, now test against radius + ! in new frame the distance from vertex to CONE axis only requires the 1st and 2nd vector components + DUX = U(1:2) - X(1:2) + DIST_SQUARED = DOT_PRODUCT(DUX,DUX) + R_Z = RADIUS*(1._EB-(U(3)-Z0)/H) + IF (DIST_SQUARED < R_Z*R_Z+TWENTY_EPSILON_EB) THEN + INTERSECT_CONE_AABB = .TRUE. + RETURN + ENDIF + ENDIF + ENDDO + ENDDO +ENDDO RETURN -END SUBROUTINE LINE_INTERSECT_COORDPLANE +END FUNCTION INTERSECT_CONE_AABB +! ---------------------------- INTERSECT_OBB_AABB ---------------------------------------- -! ------------------------- CC_INIT_GEOM --------------------------------------- +! Intersect an Oriented Bounding Box (OBB) with an Axis-Aligned Bounding Box (AABB) +! First, rotate AABB into OBB frame. +! Then test each vertex. -SUBROUTINE CC_INIT_GEOM +LOGICAL FUNCTION INTERSECT_OBB_AABB(X_IN,L,W,H,ROTMAT,XB) -! Local Variables: -INTEGER :: IG, IWSEL, INOD, IEDGE, NVERT, NWSEL, NWSEDG, IEDLIST, IX, N_TENT_EDGES -INTEGER :: WSELEM(NOD1:NOD3),SEG(NOD1:NOD2) -REAL(EB):: XYZV(MAX_DIM,NODS_WSEL), V12(MAX_DIM), V23(MAX_DIM), V31(MAX_DIM), WSNORM(MAX_DIM) -REAL(EB):: X12(MAX_DIM), X23(MAX_DIM), X31(MAX_DIM), SQAREA(MAX_DIM), INT2 -REAL(EB):: MGNRM, XCEN -REAL(EB):: GEOMEPSSQ ! Local epsilon for GEOM quality check -INTEGER, ALLOCATABLE, DIMENSION(:,:):: EDGES2 -LOGICAL, ALLOCATABLE, DIMENSION(:) :: COUNTED_VERT -! REAL(QB) :: V12Q(IAXIS:KAXIS),V23Q(IAXIS:KAXIS),V31Q(IAXIS:KAXIS),WSNORMQ(IAXIS:KAXIS),MGNRMQ +REAL(EB), INTENT(IN) :: X_IN(3),L,W,H,ROTMAT(3,3),XB(6) +REAL(EB) :: X(3),U(3),V(3),X0,XL,Y0,YW,Z0,ZH +INTEGER :: II,JJ,KK -REAL(EB) :: CPUTIME_START, CPUTIME +INTERSECT_OBB_AABB=.FALSE. -IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_ERR,'(A,I5,A)',advance="no") ' 1b. Number of Geometries : ',N_GEOMETRY,& - ', CC_INIT_GEOM, processed GEOMETRY : ' -ENDIF +X = MATMUL(ROTMAT,X_IN) ! transform center +X0 = X(1) - 0.5_EB*L - TWENTY_EPSILON_EB +XL = X(1) + 0.5_EB*L + TWENTY_EPSILON_EB +Y0 = X(2) - 0.5_EB*W - TWENTY_EPSILON_EB +YW = X(2) + 0.5_EB*W + TWENTY_EPSILON_EB +Z0 = X(3) - 0.5_EB*H - TWENTY_EPSILON_EB +ZH = X(3) + 0.5_EB*H + TWENTY_EPSILON_EB -! In this subroutine the quality of the GEOM lines is checked -! Calc local squared epsilon for GEOM quality check -GEOMEPSSQ = (GEOMEPS * GEOMQUALITYFCT)**2._EB +! transform and test vertices (probably a more efficient way, but just to get going...) +DO KK=5,6 + DO JJ=3,4 + DO II=1,2 + V = (/XB(II),XB(JJ),XB(KK)/) + U = MATMUL(ROTMAT,V) + IF (U(1)>X0 .AND. U(1)Y0 .AND. U(2)Z0 .AND. U(3) FACES(3*I-2:3*I) + V(1:3) = VERT_UNIQUE(V(1:3)) + VERT_VALS(V(1)) = VERT_VALS(V(1)) + FACE_VALS(I) + COUNT(V(1)) = COUNT(V(1)) + 1 + VERT_VALS(V(2)) = VERT_VALS(V(2)) + FACE_VALS(I) + COUNT(V(2)) = COUNT(V(2)) + 1 + VERT_VALS(V(3)) = VERT_VALS(V(3)) + FACE_VALS(I) + COUNT(V(3)) = COUNT(V(3)) + 1 +ENDDO +DO I = 1, NVERTS + IF (COUNT(I) .GT. 1) VERT_VALS(I) = VERT_VALS(I)/REAL(COUNT(I), FB) +ENDDO +DO I = 1, NVERTS + IF (VERT_UNIQUE(I) .NE. I) VERT_VALS(I) = VERT_VALS(VERT_UNIQUE(I)) +ENDDO - ! Compute normal, area and volume: - SQAREA(IAXIS:KAXIS) = 0._EB - DO IWSEL=1,NWSEL +END SUBROUTINE AVERAGE_FACE_VALUES - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) - COUNTED_VERT(WSELEM(NOD1:NOD3)) = .TRUE. +! ---------------------------- MAKE_UNIQUE_VERT_ARRAY ---------------------------------------- - ! Triangles NODES coordinates: - DO INOD=NOD1,NOD3 - XYZV(IAXIS:KAXIS,INOD) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+1:MAX_DIM*WSELEM(INOD)) - ENDDO +! construct an array that points to first vertex in a vertex array when one or more vertices are identical - V12(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD2) - XYZV(IAXIS:KAXIS,NOD1) - V23(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD3) - XYZV(IAXIS:KAXIS,NOD2) - V31(IAXIS:KAXIS) = XYZV(IAXIS:KAXIS,NOD1) - XYZV(IAXIS:KAXIS,NOD3) +SUBROUTINE MAKE_UNIQUE_VERT_ARRAY(VERTS, VERT_UNIQUE, NVERTS) +INTEGER, INTENT(IN) :: NVERTS +REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) +INTEGER, INTENT(OUT) :: VERT_UNIQUE(NVERTS) - ! Check that face edges are not too small - IF ((V12(IAXIS)**2._EB + V12(JAXIS)**2._EB + V12(KAXIS)**2._EB ) < GEOMEPSSQ) THEN - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD2) - WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD1),', ',WSELEM(NOD2),' are not equal.' - ENDIF - CALL SHUTDOWN("") ; RETURN - ENDIF - IF ((V23(IAXIS)**2._EB + V23(JAXIS)**2._EB + V23(KAXIS)**2._EB ) < GEOMEPSSQ) THEN - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD3) - WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD2),', ',WSELEM(NOD3),' are not equal.' - END IF - CALL SHUTDOWN("") ; RETURN - ENDIF - IF ((V31(IAXIS)**2._EB + V31(JAXIS)**2._EB + V31(KAXIS)**2._EB ) < GEOMEPSSQ) THEN - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(727): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(MESSAGE,'(A,3F12.3)') " Edge length too small at:", XYZV(IAXIS:KAXIS,NOD1) - WRITE(LU_ERR,'(A,I8,A,I8,A)') " Check that Vertices:",WSELEM(NOD1),', ',WSELEM(NOD3),' are not equal.' - ENDIF - CALL SHUTDOWN("") ; RETURN - END IF +INTEGER :: PERM(NVERTS) +INTEGER :: I, RESULT - ! Cross V12 x V23: - ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - WSNORM(IAXIS) = V12(JAXIS)*V23(KAXIS) - V12(KAXIS)*V23(JAXIS) - WSNORM(JAXIS) = V12(KAXIS)*V23(IAXIS) - V12(IAXIS)*V23(KAXIS) - WSNORM(KAXIS) = V12(IAXIS)*V23(JAXIS) - V12(JAXIS)*V23(IAXIS) - MGNRM = SQRT( WSNORM(IAXIS)**2._EB + WSNORM(JAXIS)**2._EB + WSNORM(KAXIS)**2._EB ) - ! ELSE - ! V12Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD2),QB) - REAL(XYZV(IAXIS:KAXIS,NOD1),QB) - ! V23Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD3),QB) - REAL(XYZV(IAXIS:KAXIS,NOD2),QB) - ! V31Q(IAXIS:KAXIS) = REAL(XYZV(IAXIS:KAXIS,NOD1),QB) - REAL(XYZV(IAXIS:KAXIS,NOD3),QB) - ! WSNORMQ(IAXIS) = V12Q(JAXIS)*V23Q(KAXIS) - V12Q(KAXIS)*V23Q(JAXIS) - ! WSNORMQ(JAXIS) = V12Q(KAXIS)*V23Q(IAXIS) - V12Q(IAXIS)*V23Q(KAXIS) - ! WSNORMQ(KAXIS) = V12Q(IAXIS)*V23Q(JAXIS) - V12Q(JAXIS)*V23Q(IAXIS) - ! MGNRMQ = SQRT( WSNORMQ(IAXIS)**2._QB + WSNORMQ(JAXIS)**2._QB + WSNORMQ(KAXIS)**2._QB ) - ! MGNRM = REAL(MGNRMQ,EB) - ! ENDIF +DO I = 1, NVERTS + PERM(I) = I + VERT_UNIQUE(I) = I +ENDDO +CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, 1, NVERTS) + +DO I = 1, NVERTS - 1 + CALL COMPARE_VERTS(VERTS, NVERTS, PERM(I), PERM(I+1), RESULT) + IF (RESULT == 0) VERT_UNIQUE(PERM(I+1)) = VERT_UNIQUE(PERM(I)) +END DO + +END SUBROUTINE MAKE_UNIQUE_VERT_ARRAY + +! ---------------------------- COMPARE_VERTS ---------------------------------------- + +! returns -1, 0, 1 when a vertex I is less than, the same or greater than vertex J + +SUBROUTINE COMPARE_VERTS(VERTS, NVERTS, I, J, RESULT) +INTEGER, INTENT(IN) :: NVERTS +REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) +INTEGER, INTENT(IN) :: I, J +INTEGER, INTENT(OUT) :: RESULT +REAL(FB) :: TOLERANCE=0.00001_FB + +IF (VERTS(3*I-2) < VERTS(3*J-2) - TOLERANCE) THEN + RESULT = -1 + RETURN +ENDIF +IF (VERTS(3*I-2) > VERTS(3*J-2) + TOLERANCE) THEN + RESULT = 1 + RETURN +ENDIF +IF (VERTS(3*I-1) < VERTS(3*J-1) - TOLERANCE) THEN + RESULT = -1 + RETURN +ENDIF +IF (VERTS(3*I-1) > VERTS(3*J-1) + TOLERANCE) THEN + RESULT = 1 + RETURN +ENDIF +IF (VERTS(3*I ) < VERTS(3*J ) - TOLERANCE) THEN + RESULT = -1 + RETURN +ENDIF +IF (VERTS(3*I ) > VERTS(3*J ) + TOLERANCE) THEN + RESULT = 1 + RETURN +ENDIF +RESULT = 0 +RETURN +END SUBROUTINE COMPARE_VERTS - XCEN = (XYZV(IAXIS,NOD1) + XYZV(IAXIS,NOD2) + XYZV(IAXIS,NOD3)) / 3._EB +! ---------------------------- MAKE_PERMUTATION_ARRAY ---------------------------------------- - ! Check that face area is not too small - IF(MGNRM < GEOMEPSSQ) THEN - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(728): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,3F12.3)') " Face area too small at:", XYZV(IAXIS:KAXIS,NOD1) - WRITE(LU_ERR,*) ' Face IWSEL=', IWSEL, ', Connectivity=', WSELEM(NOD1:NOD3),', Norm Cross=', MGNRM - ENDIF - CALL SHUTDOWN("") ; RETURN - ENDIF +! sort a vertex array in increasing order and store the order in a permutation array +! PERM(1) is the 1st vertex, PERM(2) is the 2nd and so on - ! Assign to GEOMETRY: - ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) = WSNORM(IAXIS:KAXIS) * MGNRM**(-1._EB) - GEOMETRY(IG)%FACES_AREA(IWSEL) = MGNRM/2._EB - ! ELSE - ! GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) = REAL(WSNORMQ(IAXIS:KAXIS)*MGNRMQ**(-1._QB),EB) - ! GEOMETRY(IG)%FACES_AREA(IWSEL) = REAL(MGNRMQ/2._QB,EB) - ! ENDIF +RECURSIVE SUBROUTINE MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, FIRST, LAST) +INTEGER, INTENT(IN) :: NVERTS +REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) +INTEGER, INTENT(INOUT) :: PERM(NVERTS) +INTEGER, INTENT(IN) :: FIRST, LAST +INTEGER :: PERM_COPY(NVERTS) +INTEGER RESULT - ! Total Area and Volume for GEOMETRY(IG). - GEOMETRY(IG)%GEOM_AREA = GEOMETRY(IG)%GEOM_AREA + GEOMETRY(IG)%FACES_AREA(IWSEL) - GEOMETRY(IG)%GEOM_VOLUME= GEOMETRY(IG)%GEOM_VOLUME+ & ! Divergence theorem with F = x i, assumes we have a volume. - GEOMETRY(IG)%FACES_NORMAL(IAXIS,IWSEL)*XCEN*GEOMETRY(IG)%FACES_AREA(IWSEL) +INTEGER :: MID, I, I1, I2, IP1, IP2, N, N1, N2 - ! Define Centroid: - X12(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD1) + XYZV(IAXIS:KAXIS,NOD2)) - X23(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD2) + XYZV(IAXIS:KAXIS,NOD3)) - X31(IAXIS:KAXIS) = 0.5_EB*(XYZV(IAXIS:KAXIS,NOD3) + XYZV(IAXIS:KAXIS,NOD1)) - ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA - DO IX=IAXIS,KAXIS - INT2 = (X12(IX)**2._EB + X23(IX)**2._EB + X31(IX)**2._EB) / 3._EB - SQAREA(IX) = SQAREA(IX) + GEOMETRY(IG)%FACES_NORMAL(IX,IWSEL)*INT2*GEOMETRY(IG)%FACES_AREA(IWSEL) ! Midpt rule. - ENDDO - ENDDO +IF (FIRST .EQ. LAST)RETURN ! only one element in list so don't need to sort - ! In the broken case where GEOM normals are wrong, GEOM_VOLUME can become too small - IF(GEOMETRY(IG)%GEOM_VOLUME < GEOMEPSSQ) THEN - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(729): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A)') " Geometry volume too small." - WRITE(LU_ERR,'(A)') " Face normals are probably pointing in the wrong direction. " - WRITE(LU_ERR,'(A)') " Check they point towards the gas phase." - ENDIF - CALL SHUTDOWN("") ; RETURN - ENDIF +! FIRST .... LAST original list +! FIRST ... MID first half of list +! MID+1 ... LAST 2nd half of list - ! Geometry Centroid: - DO IX=IAXIS,KAXIS - GEOMETRY(IG)%GEOM_XYZCEN(IX) = SQAREA(IX) / (2._EB * GEOMETRY(IG)%GEOM_VOLUME) - ENDDO +MID = (FIRST + LAST)/2 - ! Build geometry connectivity - ! While building, check that the triangulated surface is manifold and oriented - NWSEDG = 0 - IX = SIZE(GEOMETRY(IG)%FACES,DIM=1) - CALL GET_GEOM_EDGES(NVERT,NWSEL,IX,GEOMETRY(IG)%FACES,NWSEDG,GEOMETRY(IG)%EDGES,& - GEOMETRY(IG)%FACE_EDGES,GEOMETRY(IG)%EDGE_FACES) +CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, FIRST, MID) ! sort first half of list +CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, MID+1, LAST) ! sort 2nd half of list - ! Perform manifoldness tests: - ALLOCATE(EDGES2(2,NWSEDG)); EDGES2=0 - DO IWSEL=1,NWSEL - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) - DO IEDGE=EDG1,EDG3 - IEDLIST = GEOMETRY(IG)%FACE_EDGES(IEDGE,IWSEL) - IF(WSELEM(IEDGE) == GEOMETRY(IG)%EDGES(NOD1,IEDLIST)) THEN ! First node of face edge equals first node of seg. - EDGES2(1,IEDLIST)=EDGES2(1,IEDLIST)+1 - ELSEIF(WSELEM(IEDGE) == GEOMETRY(IG)%EDGES(NOD2,IEDLIST)) THEN ! Inverted. - EDGES2(2,IEDLIST)=EDGES2(2,IEDLIST)+1 - ENDIF - ENDDO - ENDDO - DO IWSEL=1,NWSEDG - IF(SUM(EDGES2(1:2,IWSEL)) < 2) THEN ! Less that two faces have this edge as boundary: - SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEL) - XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) - XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(730): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') " Open geometry at edge with nodes: NOD1",SEG(NOD1),& - " (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",SEG(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" - ENDIF - CALL SHUTDOWN("") ; RETURN +! combine two lists into one +I1 = 1 +I2 = 1 +N1 = MID + 1 - FIRST +N2 = LAST - MID +N = LAST + 1 - FIRST +DO I = 1, N + IF (I1 .GT. N1 ) THEN ! no more in 1st half so copy item from 2nd half + IP2 = PERM(MID + I2) + PERM_COPY(I) = IP2 + I2 = I2 + 1 + CYCLE + ENDIF - ELSEIF(SUM(EDGES2(1:2,IWSEL)) > 2) THEN ! More than two faces share this edge: - SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEL) - XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) - XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(731): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') " Non manifold geometry in adjacent faces at edge with nodes: NOD1",& - SEG(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",SEG(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" - ENDIF - CALL SHUTDOWN("") ; RETURN + IF (I2 .GT. N2 ) THEN ! no more in 2nd half so copy item from first half + IP1 = PERM(FIRST + I1 - 1) + PERM_COPY(I) = IP1 + I1 = I1 + 1 + CYCLE + ENDIF - ELSEIF(ANY(EDGES2(1:2,IWSEL) > 1)) THEN ! half edge counted more than once, opposite normals on triangles - SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEL) - XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) - XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(732): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') & - " Opposite normals on triangles sharing edge with nodes: NOD1",& - SEG(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",SEG(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" - ENDIF - CALL SHUTDOWN("") ; RETURN + IP1 = PERM(FIRST + I1 - 1) + IP2 = PERM(MID + I2) + CALL COMPARE_VERTS(VERTS, NVERTS, IP1, IP2, RESULT) + IF (RESULT .EQ. -1) THEN ! sort in increasing order + PERM_COPY(I) = IP1 + I1 = I1 + 1 + ELSE + PERM_COPY(I) = IP2 + I2 = I2 + 1 + ENDIF +END DO +DO I = 1, N + PERM(FIRST + I - 1) = PERM_COPY(I) +END DO - ENDIF - ENDDO - DEALLOCATE(EDGES2) +END SUBROUTINE MAKE_PERMUTATION_ARRAY - ! Check if the surface is closed - ! Each halfedge should be coupled with an opposite halfedge - DO IEDLIST=1,NWSEDG - IF (GEOMETRY(IG)%EDGE_FACES(1,IEDLIST) == 1) THEN - XYZV(IAXIS:KAXIS,NOD1) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) - XYZV(IAXIS:KAXIS,NOD2) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) - IF (MY_RANK==0) THEN - IF (POSITIVE_ERROR_TEST) THEN - WRITE(LU_ERR,'(A,A,A)') "SUCCESS: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ELSE - WRITE(LU_ERR,'(A,A,A)') "ERROR(733): GEOM ID='", TRIM(GEOMETRY(IG)%ID), "':" - ENDIF - WRITE(LU_ERR,'(A,I8,A,3F12.3,A,I8,A,3F12.3,A)') " Open geometry at edge with nodes: NOD1",& - WSELEM(NOD1)," (", XYZV(IAXIS:KAXIS,NOD1), "), NOD2",WSELEM(NOD2)," (", XYZV(IAXIS:KAXIS,NOD2), ")" - ENDIF - CALL SHUTDOWN("") ; RETURN - ENDIF - ENDDO +END MODULE COMPLEX_GEOMETRY - ! Check that all vertices are counted: - DO INOD=1,NVERT - IF (.NOT.COUNTED_VERT(INOD) .AND. MY_RANK==0) & - WRITE(LU_ERR,'(A,A,A,I8,A)') " WARNING: GEOM ID='", TRIM(GEOMETRY(IG)%ID), "': Vertex ",INOD," not connected." - ENDDO - DEALLOCATE(COUNTED_VERT) - GEOMETRY(IG)%N_EDGES = NWSEDG +!> \brief Grid related complex-geometry routines. - ! At this point the surface is manifold, well oriented, and closed. +MODULE COMPLEX_GEOMETRY_GRID - IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN - IF (IG==N_GEOMETRY) THEN - WRITE(LU_ERR,'(I4.4,A,I9.9,A,I9.9,A)',advance="no") IG,', VERTS=',GEOMETRY(IG)%N_VERTS,& - ', FACES=',GEOMETRY(IG)%N_FACES,'.. done.' - CALL CPU_TIME(CPUTIME) - WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken : ',CPUTIME-CPUTIME_START,' sec.' - ELSE - WRITE(LU_ERR,'(I4.4,A)',advance="no") IG,', ' - ENDIF - ENDIF +USE PRECISION_PARAMETERS, ONLY: EB +USE GLOBAL_CONSTANTS +USE MESH_POINTERS +USE COMP_FUNCTIONS, ONLY: CURRENT_TIME, GET_FILE_NUMBER, SHUTDOWN +USE TYPES, ONLY: BOUNDARY_COORD_TYPE, BOUNDARY_PROP1_TYPE, CFACE_TYPE, CC_CUTCELL_TYPE, CC_CUTFACE_TYPE, & + CC_CUTEDGE_TYPE, CC_EDGECROSS_TYPE, CC_INBCF_AREA_TYPE, WALL_TYPE, EXTERNAL_WALL_TYPE, TBAXIS_TYPE + +USE COMPLEX_GEOMETRY, ONLY: DEBUG_SET_CUTCELLS,GEOMEPS,LOOSEPS,MIN_VOL_FACTOR,ADIFF_INFO_FACTOR, & + SNAP_DIST_FACTOR,MIN_LENGTH_FACTOR,NGUARD,CCGUARD,CC_INBOUNDCC,CC_INBOUNDCF,CC_GASPHASE, & + CC_CUTCFE,CC_SOLID,CC_INBOUNDARY,CC_UNDEFINED,CC_GG,CC_SS,CC_GS,CC_SG,CC_VGSC,CC_NVVARS, & + CC_EGSC,CC_IDCE,CC_ECRS,CC_NEVARS,CC_FGSC,CC_IDCF,CC_IDRC,CC_UNKF,CC_NFVARS,CC_CGSC, & + CC_IDCC,CC_UNKZ,CC_UNKH,CC_NCVARS,CC_VTYPE_VGAS,CC_VTYPE_VINB,CC_VTYPE_NINB,CC_ETYPE_RGGAS, & + CC_ETYPE_CFGAS,CC_ETYPE_CFINB,CC_FTYPE_RGGAS,CC_FTYPE_CFGAS,CC_FTYPE_CFINB,CC_FTYPE_SVERT, & + CC_FTYPE_RCGAS,CC_FTYPE_CCGAS,CC_ETYPE_SCINB,CC_ETYPE_RCGAS,CC_ETYPE_EP,NODS_WSEL,EDGS_WSEL, & + NODS_VLEL,WRITE_SET_CUTCELLS_TIMINGS,SET_CUTCELLS_TIME_INDEX,GET_BODINT_PLANE_TIME_INDEX, & + GET_X2_INTERSECTIONS_TIME_INDEX,GET_X2_VERTVAR_TIME_INDEX,GET_CARTEDGE_CUTEDGES_TIME_INDEX, & + GET_BODX2X3_INTERSECTIONS_TIME_INDEX,GET_CARTFACE_CUTEDGES_TIME_INDEX,GET_CARTCELL_CUTEDGES_TIME_INDEX, & + GET_CARTFACE_CUTFACES_TIME_INDEX,GET_CARTCELL_CUTFACES_TIME_INDEX,GET_CARTCELL_CUTCELLS_TIME_INDEX, & + T_CC_USED,VAL_TESTX_LOW,VAL_TESTX_HIGH,VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH, & + SEARCH_OTHER_MESHES_FACE,POINT_IN_POLYGON,TEST_PT_INPOLY,GET_SEGSEG_INTERSECTION, & + LINE_INTERSECT_COORDPLANE,CC_INIT_GEOM,DEBUG_WAIT,VALID_TRIANGLE,TRIANGULATE,TRILINEAR, & + RAY_TRIANGLE_INTERSECT_PT,LU_SETCC -ENDDO GEOMETRY_LOOP +IMPLICIT NONE (TYPE,EXTERNAL) +PRIVATE -! Print out of computed result: -! DO IG=1,N_GEOMETRY -! NWSEL = GEOMETRY(IG)%N_FACES -! DO IWSEL=1,NWSEL -! print*, IWSEL,GEOMETRY(IG)%FACES_AREA(IWSEL) -! ENDDO -! DO IWSEL=1,NWSEL -! print*, IWSEL,GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) -! ENDDO -! print*, "EDGES=" -! DO NWSEDG=1,GEOMETRY(IG)%N_EDGES -! print*, NWSEDG,GEOMETRY(IG)%EDGES(NOD1:NOD2,NWSEDG) -! ENDDO -! DO NWSEDG=1,GEOMETRY(IG)%N_EDGES -! print*, GEOMETRY(IG)%EDGE_FACES(1:5,NWSEDG) -! ENDDO -! print*, "FACES=" -! DO IWSEL=1,NWSEL -! print*, IWSEL,GEOMETRY(IG)%FACE_EDGES(EDG1:EDG3,IWSEL) -! ENDDO -! ENDDO +INTEGER :: LU_DB_SETCC + +! Engage NOADVANCE for small cut-cells to be dropped: +LOGICAL, PARAMETER :: DO_NOADVANCE = .TRUE. + +! Local integers: +INTEGER, SAVE :: CC_NEDGECROSS, CC_NCUTEDGE, CC_NCUTFACE, CC_NCUTCELL +INTEGER, SAVE :: ILO_CELL,IHI_CELL,JLO_CELL,JHI_CELL,KLO_CELL,KHI_CELL +INTEGER, SAVE :: ILO_FACE,IHI_FACE,JLO_FACE,JHI_FACE,KLO_FACE,KHI_FACE +INTEGER, SAVE :: NXB, NYB, NZB -RETURN -END SUBROUTINE CC_INIT_GEOM +! Auxiliary variables: +REAL(EB), PARAMETER :: GAMMA_MULT = 1._EB +INTEGER, PARAMETER :: DELTA_TBIN = 200, DELTA_SEGBIN = 50 -! ------------------------ GET_GEOM_EDGES --------------------------------------- +INTEGER, ALLOCATABLE, DIMENSION(:) :: SPCELLS_TO_BLOCK, SPCELLS_TO_BLOCK_AUX +INTEGER :: N_SPCELLS_TO_BLOCK -SUBROUTINE GET_GEOM_EDGES(NVERT,NWSEL,SIZEFC,FACES,NWSEDG,EDGES,FACE_EDGES,EDGE_FACES) +! Wet surface edges intersection with Cartesian cells data structure: +TYPE BODINT_CELL_EDGE_TYPE + INTEGER :: NWCROSS=0 ! Number of intersections with Cartesian grid planes. + REAL(EB), ALLOCATABLE, DIMENSION(:) :: SVAR ! Intersection with grid planes defined by local coord s. +END TYPE BODINT_CELL_EDGE_TYPE -INTEGER, INTENT(IN) :: NVERT,NWSEL,SIZEFC -INTEGER, INTENT(IN) :: FACES(1:SIZEFC) -INTEGER, INTENT(OUT):: NWSEDG,EDGES(NOD1:NOD2,3*NWSEL),FACE_EDGES(EDG1:EDG3,NWSEL),EDGE_FACES(5,3*NWSEL) +! Allocatable real arrays +! Grid position containers (shared mesh coordinates for cut-cell/GEOM routines): +REAL(EB), SAVE, TARGET, ALLOCATABLE, DIMENSION(:) :: XFACE,YFACE,ZFACE,XCELL,YCELL,ZCELL, & + DXFACE,DYFACE,DZFACE,DXCELL,DYCELL,DZCELL -! Local Variables: -INTEGER :: IWSEL,IVERT,IEDGE,TOT_ELVERT,IEDLIST,WSELEM(NOD1:NOD3),SEG(NOD1:NOD2) -LOGICAL :: INLIST -LOGICAL :: FLG_LOHI -INTEGER, ALLOCATABLE, DIMENSION(:) :: NELVERT,ISTVERT,EDGE_RNK -INTEGER, ALLOCATABLE, DIMENSION(:,:):: EDGES2,EDGE_FACES2 +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTFACE_TYPE), POINTER :: CF +TYPE(CC_CUTEDGE_TYPE), POINTER :: CE -NWSEDG = 0 +TYPE(CC_EDGECROSS_TYPE), ALLOCATABLE, DIMENSION(:) :: EDGE_CROSS_AUX +TYPE(CC_CUTEDGE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_EDGE_AUX +TYPE(CC_CUTFACE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_FACE_AUX -! Populate NELVERT with the number of elements associated per node: -ALLOCATE(NELVERT(NVERT)); NELVERT(:) = 0 -ALLOCATE(ISTVERT(NVERT)); ISTVERT(:) = 0 -DO IWSEL=1,NWSEL - NELVERT(FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL)) = NELVERT(FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL)) + 1 -ENDDO -NELVERT = NELVERT + 1 ! Add buffer. -DO IVERT=2,NVERT - ISTVERT(IVERT) = ISTVERT(IVERT-1) + NELVERT(IVERT-1) -ENDDO +!> Body-plane intersection workspace owned by the grid cut-cell build path. +TYPE BODINT_PLANE_TYPE + INTEGER :: NNODS + INTEGER :: NSGLS + INTEGER :: NSEGS + INTEGER :: NTRIS + REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZ + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SGLS + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEGS + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: TRIS + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INDSEG + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INDTRI + LOGICAL, ALLOCATABLE, DIMENSION(:) :: X2ALIGNED + LOGICAL, ALLOCATABLE, DIMENSION(:) :: X3ALIGNED + INTEGER, ALLOCATABLE, DIMENSION(:) :: NBCROSS + REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEGTYPE + REAL(EB), ALLOCATABLE, DIMENSION(:) :: X1NVEC + REAL(EB), ALLOCATABLE, DIMENSION(:,:,:):: AINV + INTEGER, ALLOCATABLE, DIMENSION(:) :: NOD_PERM + TYPE(TBAXIS_TYPE) :: TBAXIS(IAXIS:KAXIS) + REAL(EB) :: BOX(LOW_IND:HIGH_IND,IAXIS:KAXIS) +END TYPE BODINT_PLANE_TYPE -! First pass build unique list of segments per VERTEX where: -! SEG_IJ = [ni nj] with ni < nj -TOT_ELVERT = SUM(NELVERT(1:NVERT)) -ALLOCATE(EDGES2(NOD1:NOD2,TOT_ELVERT)); EDGES2(:,:) = 0 -ALLOCATE(EDGE_FACES2( 5,TOT_ELVERT)); EDGE_FACES2(:,:) = 0 -ALLOCATE(EDGE_RNK( TOT_ELVERT)); EDGE_RNK(:) = 0 -NELVERT(:) = 0 ! Reset NELVERT. +INTEGER, SAVE :: CC_MAX_NNODS, CC_MAX_NSGLS, CC_MAX_NSEGS, CC_MAX_NTRIS, CC_DELTA_NBCROSS=20 +TYPE(BODINT_PLANE_TYPE) :: BODINT_PLANE, BODINT_PLANE2 +LOGICAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: CELLRT +LOGICAL, SAVE, ALLOCATABLE, DIMENSION(:,:) :: FACERT +REAL(EB) :: MAX_LEDGE, X3LO_RT, X3HI_RT +REAL(EB), SAVE, TARGET, ALLOCATABLE, DIMENSION(:) :: X1FACE,X2FACE,X3FACE,X2CELL,X3CELL, & + DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL +INTEGER, SAVE :: CC_N_CRS +INTEGER, PARAMETER :: DELTA_CROSS_X2 = 512 +INTEGER, SAVE :: CC_MAXCROSS_X2= 512 +REAL(EB), ALLOCATABLE, DIMENSION(:) :: CC_SVAR_CRS +INTEGER, ALLOCATABLE, DIMENSION(:) :: CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX +INTEGER, ALLOCATABLE, DIMENSION(:,:):: CC_IS_CRS2 +REAL(EB), ALLOCATABLE, DIMENSION(:,:):: CC_SEG_TAN +INTEGER :: X1NOC, X2NOC, X3NOC -DO IWSEL=1,NWSEL - WSELEM(NOD1:NOD3) = FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) +INTEGER, SAVE :: N_CUTCELLS_PROC=0, N_INB_CUTFACES_PROC=0, N_REG_CUTFACES_PROC=0 - DO IEDGE=EDG1,EDG3 - SEG(NOD1:NOD2) = (/ MINVAL(WSELEM(NOD1:NOD2)), MAXVAL(WSELEM(NOD1:NOD2)) /) - FLG_LOHI = .TRUE.; IF(SEG(NOD2) /= WSELEM(NOD2)) FLG_LOHI = .FALSE. +! Local arrays allocation variables: +INTEGER, PARAMETER :: DELTA_CELL = 5 +INTEGER, PARAMETER :: DELTA_EDGE = 24 +INTEGER, PARAMETER :: DELTA_FACE = 24 +INTEGER, PARAMETER :: DELTA_VERT = 24 +INTEGER, PARAMETER :: MAX_CELL_POLYLINES = 200 - IF(NELVERT(SEG(NOD2)) == 0) THEN - NELVERT(SEG(NOD2)) = NELVERT(SEG(NOD2)) + 1 - FACE_EDGES(IEDGE,IWSEL) = ISTVERT(SEG(NOD2)) + NELVERT(SEG(NOD2)) - EDGES2(NOD1:NOD2,FACE_EDGES(IEDGE,IWSEL)) = SEG(NOD1:NOD2) - EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) = & - EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) + 1 - IF(FLG_LOHI) THEN - EDGE_FACES2(2,FACE_EDGES(IEDGE,IWSEL)) = IWSEL - EDGE_FACES2(3,FACE_EDGES(IEDGE,IWSEL)) = IEDGE - ELSE - EDGE_FACES2(4,FACE_EDGES(IEDGE,IWSEL)) = IWSEL - EDGE_FACES2(5,FACE_EDGES(IEDGE,IWSEL)) = IEDGE - ENDIF - WSELEM=CSHIFT(WSELEM,1) - CYCLE ! IEDGE - ENDIF +! Global cut-edge, face, cell allocation variables: +INTEGER, PARAMETER :: GLOBAL_DELTA_CELL = 100 +INTEGER, PARAMETER :: GLOBAL_DELTA_EDGE = 3*GLOBAL_DELTA_CELL +INTEGER, PARAMETER :: GLOBAL_DELTA_FACE = 3*GLOBAL_DELTA_CELL - INLIST = .FALSE. - DO IEDLIST=ISTVERT(SEG(NOD2))+1,ISTVERT(SEG(NOD2))+NELVERT(SEG(NOD2)) - ! Here SEG(NOD2) is by construction the same as - ! EDGES2(NOD2,IEDLIST), search only NOD1 component. - IF(SEG(NOD1) == EDGES2(NOD1,IEDLIST)) THEN - INLIST = .TRUE. - EXIT ! IEDLIST - ENDIF - ENDDO - IF(INLIST) THEN - FACE_EDGES(IEDGE,IWSEL) = IEDLIST - ELSE - NELVERT(SEG(NOD2)) = NELVERT(SEG(NOD2)) + 1 - FACE_EDGES(IEDGE,IWSEL) = ISTVERT(SEG(NOD2)) + NELVERT(SEG(NOD2)) - EDGES2(NOD1:NOD2,FACE_EDGES(IEDGE,IWSEL)) = SEG(NOD1:NOD2) - ENDIF +INTEGER, PARAMETER :: LINSEARCH_LIMIT = 13 ! LINSEARCH_LIMIT-1 is the maximum size of array for linear search O(n). + ! If Array larger -> binary search O(log(n)). - EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) = & - EDGE_FACES2(1,FACE_EDGES(IEDGE,IWSEL)) + 1 - IF(FLG_LOHI) THEN - EDGE_FACES2(2,FACE_EDGES(IEDGE,IWSEL)) = IWSEL - EDGE_FACES2(3,FACE_EDGES(IEDGE,IWSEL)) = IEDGE - ELSE - EDGE_FACES2(4,FACE_EDGES(IEDGE,IWSEL)) = IWSEL - EDGE_FACES2(5,FACE_EDGES(IEDGE,IWSEL)) = IEDGE - ENDIF +! Interpolation stencil threshold. Interpolation stencils will be defined if distance +! from body to centroid is greater than DIST_THRES of the minimum local cell size. +REAL(EB), PARAMETER :: DIST_THRES = 0.0001_EB - WSELEM=CSHIFT(WSELEM,1) - ENDDO -ENDDO +INTEGER, PARAMETER :: INDEX_UNDEFINED = -1000 +INTEGER, SAVE :: INT_N_EXT_PTS = 1 ! Default is one external point in normal probe. +INTEGER, PARAMETER :: MAX_INTERP_POINTS_VOL_LIN = 8 ! 8 stencil points for trilinear interpolation. +INTEGER, PARAMETER :: MAX_INTERP_POINTS_VOL_QUAD=27 !27 stencil points for quadratic interpolation. +INTEGER, SAVE :: MAX_INTERP_POINTS = MAX_INTERP_POINTS_VOL_LIN ! Default linear interpolation. +INTEGER, SAVE :: DELTA_INT = 1*MAX_DIM*MAX_INTERP_POINTS_VOL_LIN ! The 1 is for INT_N_EXT_PTS +INTEGER, SAVE :: N_INT_CVARS, N_INT_CCVARS +INTEGER, PARAMETER :: INT_VEL_IND=1, INT_VELS_IND=2, INT_FV_IND=3, INT_DHDX_IND=4, INT_DPDX_IND=6, N_INT_FVARS=4 +INTEGER, PARAMETER :: INT_MU_IND=1, INT_H_IND=2, INT_RHO_IND=3, INT_TMP_IND=4, INT_RSUM_IND=5, INT_MUDNS_IND=6, INT_P_IND=7 +INTEGER, PARAMETER :: INT_RHO0_IND=1, INT_WCEN_IND=3 +INTEGER, SAVE :: NQT2C = INT_P_IND+2 ! The +2 is because we pass RHO0, WCEN. -! Second pass get segments ranking: -DO IVERT=1,NVERT - DO IEDLIST=ISTVERT(IVERT)+1,ISTVERT(IVERT)+NELVERT(IVERT) - NWSEDG = NWSEDG + 1 - EDGE_RNK(IEDLIST) = NWSEDG - EDGES(NOD1:NOD2,NWSEDG) = EDGES2(NOD1:NOD2,IEDLIST) - EDGE_FACES(1:5,NWSEDG) = EDGE_FACES2(1:5,IEDLIST) - ENDDO -ENDDO +! Max numbers of link attempts for small faces and cut-cells: +INTEGER, PARAMETER :: N_LINK_ATTMP = 1, N_LINK_ATTMP_F=50 +! Number of digits in loose precision used in normals definition for linking. +INTEGER, PARAMETER :: LINK_DIGITS = 8 +REAL(EB),PARAMETER :: LINK_FCT = REAL(10**LINK_DIGITS,EB) -! Third pass populate FACE_EDGES data: -DO IWSEL=1,NWSEL - DO IEDGE=EDG1,EDG3 - IEDLIST = EDGE_RNK(FACE_EDGES(IEDGE,IWSEL)) - FACE_EDGES(IEDGE,IWSEL) = IEDLIST - ENDDO -ENDDO +! Areas per SURF and GEOM: +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: FDS_AREA_GEOM -DEALLOCATE(NELVERT,ISTVERT,EDGES2,EDGE_FACES2,EDGE_RNK) +! Cut-cell state and CFACE origin parameter: +INTEGER, PARAMETER :: NOT_BLOCKED = 0 +INTEGER, PARAMETER :: BLOCKED_SMALL_CELL = 1 +INTEGER, PARAMETER :: BLOCKED_SPLIT_CELL = 2 +INTEGER, PARAMETER :: BLOCKED_REFI_INTER = 3 +INTEGER, PARAMETER :: BLOCKED_CAVITY_CELL= 4 +INTEGER, PARAMETER :: BLOCKED_UNLINK_CELL= 5 +INTEGER, PARAMETER :: BLOCKED_SPECIAL_CELL=6 -RETURN -END SUBROUTINE GET_GEOM_EDGES +PUBLIC :: GET_CFACE_INDEX, POINT_IN_CFACE, RANDOM_CFACE_XYZ, SET_CUTCELLS_3D, BLOCK_CC_SOLID_EXTWALLCELLS, & + INIT_CFACE_CELL, GET_REGULAR_CUT_EDGES_BC, GET_SOLID_CUTCELL_EDGES_BC +PUBLIC :: DELTA_INT, DELTA_VERT, DIST_THRES, FDS_AREA_GEOM, INDEX_UNDEFINED, INT_N_EXT_PTS, INT_P_IND, & + INT_TMP_IND, INT_VEL_IND, INT_RHO_IND, INT_H_IND, INT_RSUM_IND, INT_MU_IND, INT_MUDNS_IND, & + INT_RHO0_IND, INT_WCEN_IND, INT_VELS_IND, MAX_INTERP_POINTS, NQT2C, N_CUTCELLS_PROC, & + N_INB_CUTFACES_PROC, N_INT_CVARS, N_INT_CCVARS, N_REG_CUTFACES_PROC, N_LINK_ATTMP_F, & + GLOBAL_DELTA_CELL, GLOBAL_DELTA_EDGE, GLOBAL_DELTA_FACE -! ------------------------- GET_X2_VERTVAR -------------------------------------- +CONTAINS -SUBROUTINE GET_X2_VERTVAR(X1AXIS,X2LO,X2HI,NM,I,KK) +! ----------------------- CHECK_WALL_CELL_PLANE_MATCH ---------------------------- -INTEGER, INTENT(IN) :: X1AXIS,X2LO,X2HI,NM,I,KK +SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH -! Local Variables: -INTEGER :: ICRS,ICRS1,JSTR,JEND,JJ,X2LO_LOC,X2HI_LOC -REAL(EB):: TNOW +! Routine checks that external boundaries match among neighboring meshes. This is not strictly enforced +! by FDS but is required to compute same cut-cells on mesh ghost-cells and other mesh internal cells. -TNOW=CURRENT_TIME() +USE MPI_F08 -! Work By Edge, Only one X1AXIS=IAXIS needs to be used: -SELECT CASE(X1AXIS) -CASE(IAXIS) - X2LO_LOC = X2LO - X2HI_LOC = X2HI - ! Case of GG, SS points: - DO ICRS=1,CC_N_CRS - ! If is_crs(icrs) == GG, SS, SGG see if crossing is - ! exactly on a Cartesian cell vertex: - SELECT CASE(CC_IS_CRS(ICRS)) - CASE(CC_GG,CC_SS) - JSTR = X2LO_LOC; JEND = X2HI_LOC - IF(X2NOC==0) THEN - ! Optimized and will ONLY work for Uniform Grids: - JSTR = MAX(X2LO_LOC, FLOOR((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) - JEND = MIN(X2HI_LOC, CEILING((CC_SVAR_CRS(ICRS)+GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) - ENDIF +! Local variables: +TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC +INTEGER :: NM,NOM,IW,IOR,IERR +REAL(EB):: XM,XOM,MSIZE +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BUFF +TYPE(WALL_TYPE), POINTER :: WC +TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC +TYPE(MESH_TYPE), POINTER :: M2 - DO JJ=JSTR,JEND - ! Crossing on Vertex? - IF ( ABS(X2FACE(JJ)-CC_SVAR_CRS(ICRS)) < GEOMEPS ) THEN - MESHES(NM)%VERTVAR(I,JJ,KK,CC_VGSC) = CC_SOLID - EXIT - ENDIF - ENDDO +ALLOCATE(BUFF(2,NMESHES)); BUFF=0 +MESH_LP : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + EXT_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS + WC=>WALL(IW); IF (WC%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY) CYCLE EXT_WALL_LOOP_1 + EWC=>EXTERNAL_WALL(IW) + BC =>BOUNDARY_COORD(WC%BC_INDEX) + IOR = BC%IOR; NOM = EWC%NOM; IF(NOM<1 .OR. NOM==NM) CYCLE EXT_WALL_LOOP_1 + M2 => MESHES(NOM) + SELECT CASE(IOR) + CASE( IAXIS); XM=X(0); XOM=M2%X(M2%IBAR); MSIZE=X(IBAR)-X(0) ! Low X for mesh NM, high X for mesh NOM + CASE(-IAXIS); XM=X(IBAR); XOM=M2%X(0) ; MSIZE=X(IBAR)-X(0) ! High X for mesh NM, low X for mesh NOM + CASE( JAXIS); XM=Y(0); XOM=M2%Y(M2%JBAR); MSIZE=Y(JBAR)-Y(0) ! Low Y for mesh NM, high Y for mesh NOM + CASE(-JAXIS); XM=Y(JBAR); XOM=M2%Y(0) ; MSIZE=Y(JBAR)-Y(0) ! High Y for mesh NM, low Y for mesh NOM + CASE( KAXIS); XM=Z(0); XOM=M2%Z(M2%KBAR); MSIZE=Z(KBAR)-Z(0) ! Low Z for mesh NM, high Z for mesh NOM + CASE(-KAXIS); XM=Z(KBAR); XOM=M2%Z(0) ; MSIZE=Z(KBAR)-Z(0) ! High Z for mesh NM, low Z for mesh NOM + END SELECT + IF(ABS(XM-XOM)>10._EB*GEOMEPS .AND. ABS(XM-XOM)<0.5_EB*MSIZE) THEN + BUFF(1:2,NM) = (/NM,NOM/) + CYCLE MESH_LP + ENDIF + ENDDO EXT_WALL_LOOP_1 +ENDDO MESH_LP + +! Now All-Reduce mismatch +CALL MPI_ALLREDUCE(MPI_IN_PLACE,BUFF(1,1),2*NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + +DO NM=1,NMESHES + IF(BUFF(1,NM)>0) THEN ! First Mismatched meshes found. + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A,I5,A,I5,A)') "ERROR(734): Mismatched mesh boundary location between meshes ",BUFF(1,NM),& + " and ",BUFF(2,NM),". Check your mesh MULT line. Mesh boundary locations must strictly match with &GEOM." + ENDIF + DEALLOCATE(BUFF) + CALL SHUTDOWN("") ; RETURN + ENDIF +ENDDO +DEALLOCATE(BUFF) +END SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH - END SELECT - ENDDO +! ----------------------- EXCHANGE_CC_NOADVANCE_INFO ---------------------------- - ! Other cases: - DO ICRS=1,CC_N_CRS-1 - ! Case GS-SG: All Cartesian vertices are set to CC_SOLID. - IF (CC_IS_CRS(ICRS) == CC_GS) THEN - ! Find corresponding SG intersection: - DO ICRS1=ICRS+1,CC_N_CRS - IF (CC_IS_CRS(ICRS1) == CC_SG) EXIT - ENDDO - JSTR = X2LO_LOC; JEND = X2HI_LOC - IF(X2NOC==0) THEN - ! Optimized for UG: - JSTR = MAX(X2LO_LOC, CEILING(( CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) - JEND = MIN(X2HI_LOC, FLOOR((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) - ELSE - IF ((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC)) < 0._EB) THEN - JSTR=X2LO_LOC - ELSEIF((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2HI_LOC)) >= 0._EB) THEN - JSTR=X2HI_LOC+1 - ELSE - DO JJ=X2LO_LOC,X2HI_LOC - IF((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. & - (CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN - JSTR = JJ+1 - EXIT - ENDIF - ENDDO - ENDIF - IF ((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2LO_LOC)) < 0._EB) THEN - JEND=X2LO_LOC-1 - ELSEIF((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2HI)) >= 0._EB) THEN - JEND=X2HI_LOC - ELSE - DO JJ=X2LO_LOC,X2HI_LOC - IF((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. & - (CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN - JEND = JJ - EXIT - ENDIF - ENDDO - ENDIF - ENDIF +SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO - DO JJ=JSTR,JEND - MESHES(NM)%VERTVAR(I,JJ,KK,CC_VGSC) = CC_SOLID + USE MPI_F08 + + ! Local Variables: + TYPE(CC_CUTCELL_TYPE), POINTER :: CC + INTEGER :: NM,NOM,N,IERR,I,J,K,ICC,JCC + TYPE(MESH_TYPE), POINTER :: M + TYPE (MPI_REQUEST), ALLOCATABLE, DIMENSION(:) :: REQ0,REQ0DUM + INTEGER :: N_REQ0 + LOGICAL :: PROCESS_SENDREC + + ! Define cut-cells to be blocked for exchange: + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + ! Count cut-cells for blocking in mesh: + M%N_CC_BLOCKED = 0 + DO ICC=1,MESHES(NM)%N_CUTCELL_MESH + CC => CUT_CELL(ICC) + DO JCC=1,CC%NCELL + IF(CC%NOADVANCE(JCC)>0) M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 + ENDDO + ENDDO + IF (M%N_CC_BLOCKED>0) THEN + IF(ALLOCATED(M%XYZ_CC_BLOCKED)) DEALLOCATE(M%XYZ_CC_BLOCKED) + IF(ALLOCATED(M%JBT_CC_BLOCKED)) DEALLOCATE(M%JBT_CC_BLOCKED) + ALLOCATE(M%XYZ_CC_BLOCKED(3,M%N_CC_BLOCKED)) + ALLOCATE(M%JBT_CC_BLOCKED(2,M%N_CC_BLOCKED)) + ! Fill in blocked cut-cell info: + M%N_CC_BLOCKED = 0 + DO ICC=1,MESHES(NM)%N_CUTCELL_MESH + CC => CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + DO JCC=1,CC%NCELL + IF(CC%NOADVANCE(JCC)>0) THEN + M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 + M%XYZ_CC_BLOCKED(1:3,M%N_CC_BLOCKED) = (/XC(I),YC(J),ZC(K)/) + M%JBT_CC_BLOCKED(1:2,M%N_CC_BLOCKED) = (/JCC,CC%NOADVANCE(JCC)/) + ENDIF + ENDDO ENDDO ENDIF ENDDO -END SELECT - -T_CC_USED(GET_X2_VERTVAR_TIME_INDEX) = T_CC_USED(GET_X2_VERTVAR_TIME_INDEX) + CURRENT_TIME() - TNOW -RETURN -END SUBROUTINE GET_X2_VERTVAR - -! -------------------------- GET_CARTEDGE_CUTEDGES ------------------------------ + ! MPI Exchange: + IF (N_MPI_PROCESSES>1) THEN + ALLOCATE(REQ0(NMESHES)); N_REQ0 = 0 + ! Exchange number of cut-cells information to be exchanged between MESH and OMESHES: + ! Receive from neighbors: + DO NM=1,NMESHES + DO NOM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + PROCESS_SENDREC = .FALSE. + DO N=1,MESHES(NM)%N_NEIGHBORING_MESHES + IF (NOM==MESHES(NM)%NEIGHBORING_MESH(N)) PROCESS_SENDREC = .TRUE. + ENDDO + IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NM)/=MY_RANK .AND. PROCESS_SENDREC) THEN + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_IRECV(MESHES(NM)%N_CC_BLOCKED,1,MPI_INTEGER,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + ENDIF + ENDDO + ENDDO + ! Send to neighbors: + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + DO NOM=1,NMESHES + PROCESS_SENDREC = .FALSE. + DO N=1,MESHES(NOM)%N_NEIGHBORING_MESHES + IF (NM==MESHES(NOM)%NEIGHBORING_MESH(N)) PROCESS_SENDREC = .TRUE. + ENDDO + IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NOM)/=MY_RANK .AND. PROCESS_SENDREC) THEN + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_ISEND(MESHES(NM)%N_CC_BLOCKED,1,MPI_INTEGER,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + ENDIF + ENDDO + ENDDO + IF (N_REQ0>0) CALL MPI_WAITALL(N_REQ0,REQ0(1:N_REQ0),MPI_STATUSES_IGNORE,IERR) -SUBROUTINE GET_CARTEDGE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & - NM,X2LO_CELL,X2HI_CELL,INDX1,KK) + ! At this point values of MESHES(NM)%N_CC_BLOCKED are populated for PROCESSSED and NEIGNBORING meshes. + DO NM=1,NMESHES + IF (PROCESS(NM)==MY_RANK) CYCLE ! already done for this mesh at the beginning of the routine. + IF(MESHES(NM)%N_CC_BLOCKED>0) THEN + IF(ALLOCATED(MESHES(NM)%XYZ_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED) + IF(ALLOCATED(MESHES(NM)%JBT_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%JBT_CC_BLOCKED) + ALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED(3,MESHES(NM)%N_CC_BLOCKED)) + ALLOCATE(MESHES(NM)%JBT_CC_BLOCKED(2,MESHES(NM)%N_CC_BLOCKED)) + ENDIF + ENDDO -INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & - NM,X2LO_CELL,X2HI_CELL,INDX1(MAX_DIM),KK + ! Exchange blocked cutcells lists: + ! Receive from neighbors: + N_REQ0 = 0 + DO NM=1,NMESHES + DO NOM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + PROCESS_SENDREC = .FALSE. + DO N=1,MESHES(NM)%N_NEIGHBORING_MESHES + IF (NOM==MESHES(NM)%NEIGHBORING_MESH(N) .AND. MESHES(NM)%N_CC_BLOCKED>0) PROCESS_SENDREC=.TRUE. + ENDDO + IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NM)/=MY_RANK .AND. PROCESS_SENDREC) THEN + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_IRECV(MESHES(NM)%XYZ_CC_BLOCKED(1,1),3*MESHES(NM)%N_CC_BLOCKED,& + MPI_DOUBLE_PRECISION,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_IRECV(MESHES(NM)%JBT_CC_BLOCKED(1,1),2*MESHES(NM)%N_CC_BLOCKED,& + MPI_INTEGER,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + ENDIF + ENDDO + ENDDO + ! Send to neighbors: + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + DO NOM=1,NMESHES + PROCESS_SENDREC = .FALSE. + DO N=1,MESHES(NOM)%N_NEIGHBORING_MESHES + IF (NM==MESHES(NOM)%NEIGHBORING_MESH(N) .AND. MESHES(NM)%N_CC_BLOCKED>0) PROCESS_SENDREC=.TRUE. + ENDDO + IF (N_MPI_PROCESSES>1 .AND. NM/=NOM .AND. PROCESS(NOM)/=MY_RANK .AND. PROCESS_SENDREC) THEN + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_ISEND(MESHES(NM)%XYZ_CC_BLOCKED(1,1),3*MESHES(NM)%N_CC_BLOCKED,& + MPI_DOUBLE_PRECISION,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE + CALL MPI_ISEND(MESHES(NM)%JBT_CC_BLOCKED(1,1),2*MESHES(NM)%N_CC_BLOCKED,& + MPI_INTEGER,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) + ENDIF + ENDDO + ENDDO + IF (N_REQ0>0) CALL MPI_WAITALL(N_REQ0,REQ0(1:N_REQ0),MPI_STATUSES_IGNORE,IERR) -! Local Variables: -INTEGER :: NEDGECROSS, NEDGECROSS_OLD, NCUTEDGE, JJ, INDXI(MAX_DIM), INDI, INDJ, INDK -INTEGER :: INDI1, INDJ1, INDK1, INDIE, INDJE, INDKE, NCROSS, ICROSS, ICRS, JSTR -INTEGER :: JJLOW, JJHIGH, JJADD -REAL(EB):: DELJJ -LOGICAL :: VSOLID, DIF, VFLUID -REAL(EB):: X123VERT(MAX_DIM,CC_MAXCROSS_EDGE), XCEN, YCEN, ZCEN, SCEN, XYZCEN(IAXIS:KAXIS) -INTEGER :: VERT_LIST(4,CC_MAXCROSS_EDGE),NEDGE, NVERT, IVERT -LOGICAL :: IS_GASPHASE -REAL(EB):: TNOW + ! Deallocate REQ0: + IF(ALLOCATED(REQ0)) DEALLOCATE(REQ0) + ENDIF -LOGICAL :: FOUND_EDGE -REAL(EB):: XVJJ, DELJJ1 + CONTAINS + SUBROUTINE CHECK_REQ0_SIZE + IF(N_REQ0>SIZE(REQ0,DIM=1)) THEN + ALLOCATE(REQ0DUM(SIZE(REQ0,DIM=1)+NMESHES)) + REQ0DUM(1:N_REQ0-1) = REQ0(1:N_REQ0-1) + CALL MOVE_ALLOC(REQ0DUM,REQ0) + ENDIF + END SUBROUTINE CHECK_REQ0_SIZE -TNOW=CURRENT_TIME() + END SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO -! INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CEELEMAUX, INDSEGAUX -! INTEGER :: NEDGE_SIZE -! Now define Crossings on Cartesian Edges and Body segments: -! - Edges: MESHES(NM) % ECVAR(:,:,:,CC_EGSC,IAXIS) = -! ECVAR(:,:,:,CC_EGSC,JAXIS) = CC_GASPHASE, CC_SOLID or CC_CUTCFE -! ECVAR(:,:,:,CC_EGSC,KAXIS) = -! ECVAR(:,:,:,CC_ECRS,IAXIS) = -! ECVAR(:,:,:,CC_ECRS,JAXIS) = Index to Corresponding EDGE_CROSS array. -! ECVAR(:,:,:,CC_ECRS,KAXIS) = -! MESHES(NM) % EDGE_CROSS: Data structure with -! crossings per cartesian edge information. -! .NCROSS = Number of crossings. -! .SVAR(1:NCROSS) = distances along edge from lower -! Cartesian vertex. -! Note: Crossings right on vertices do not need to be added, -! they are taken care of by setting VERTVAR(iv,jv,kv,CC_VGSC,lb)=CC_SOLID. -! MESHES(NM) % CUT_EDGE: Data structure with info on CC_GASPHASE cut-edges, -! per Cartesian Edge and CC_INBOUNDARY cut-edges, per -! Cartesian Face: -! .NVERT = number of vertices on cut-edges. -! .NEDGE = number of cut-edges. -! .XYZVERT(IAXIS:KAXIS,1:NVERT) = Segments Vertices -! .CEELEM(NOD1:NOD2,1:NEDGE) = Segments connectivity list. -! .STATUS = CC_GASPHASE or CC_INBOUNDARY; if latter -! .IJK = [I J K AXIS] for Cartesian Edge if status = CC_GASPHASE -! = [I J K AXIS] for Cartesian Face if status = CC_INBOUNDARY -! .INDSEG(1:4,1:NEDGE) = [nwel iwel1 iwel2 ibod] if status = CC_INBOUNDARY -! Also: -! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = -! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = index on CUT_EDGE location. -! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = -! -! Now figure out which segment the intersections belong to, also -! add intersections to body segments. -! As defined, a Cartesian CUT_EDGE is defined by: -! 1. A crossing. -! 2. A VERTVAR(iv,jv,kv,CC_VGSC,lb) = CC_SOLID and another -! VERTVAR(iv,jv,kv,CC_VGSC,lb) = CC_GASPHASE +! -------------------------- GET_CELL_LINK_INFO ----------------------------------- -! Set initially edges with MESHES(NM)%VERTVAR vertices == CC_SOLID to CC_SOLID status: -DO JJ=X2LO_CELL,X2HI_CELL +SUBROUTINE GET_CELL_LINK_INFO(NM) - ! Vert at index JJ-1: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ-1, KK /) ! Local x1,x2,x3 - INDI=INDXI(XIAXIS) - INDJ=INDXI(XJAXIS) - INDK=INDXI(XKAXIS) - ! Vert at index JJ: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ, KK /) ! Local x1,x2,x3 - INDI1=INDXI(XIAXIS) - INDJ1=INDXI(XJAXIS) - INDK1=INDXI(XKAXIS) - ! Edge at index JJ: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ, KK /) ! Local x1,x2,x3 - INDIE=INDXI(XIAXIS) - INDJE=INDXI(XJAXIS) - INDKE=INDXI(XKAXIS) +! Small cell linking subroutine in the mesh. Builds linking information for cutcell ICC,JCC: +! CUT_CELL(ICC)%IJK_LINK(1:KAXIS+2,JCC) of cell linked to, and CUT_CELL(ICC)%LINK_LEV(JCC) level within link tree. - IF ((MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & - (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) ) & - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID +INTEGER, INTENT(IN) :: NM + +! Local Variables: +INTEGER :: ICC,JCC,ICC2,JCC2,JCC_LNK,I,J,K,I_LNK,J_LNK,K_LNK,IFC,IFC2,IFACE,IFACE2,IFACE3,IBOD,IWSEL,VAL_UNKZ,& + LINK_ITER,INGH,JNGH,KNGH,X1AXIS,ILH,INRM(1:3),DUM,LNK_LEV,ULINK_COUNT,LINK_LEV_UP,AX_MIN,AX_OTHERS(2) +REAL(EB):: AREA,AF,NRML(IAXIS:KAXIS),VAL_CVOL,CCVOL_THRES, XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND),& + MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND:HIGH_IND),CELL_DELTA(IAXIS:KAXIS) +LOGICAL :: QUITLINK_FLG,CRTCELL_FLG,MASK(IAXIS:KAXIS),BLOCK_SLIM_IF,SOLID_FACES +CHARACTER(MESSAGE_LENGTH) :: UNLINKED_FILE +INTEGER, SAVE :: LU_UNLNK +LOGICAL, SAVE :: UNLINKED_1ST_CALL=.TRUE. +TYPE (MESH_TYPE), POINTER :: M +TYPE (CC_CUTCELL_TYPE), POINTER :: CC + +M => MESHES(NM) +! Initialize UNKZ, used here to define if cell has been noted in linking hierarchy. Assume CCVAR has been allocated: +M%CCVAR(:,:,:,CC_UNKZ) = CC_UNDEFINED +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC => M%CUT_CELL(ICC); I=CC%IJK(IAXIS); J=CC%IJK(JAXIS); K=CC%IJK(KAXIS) + ! Test for sliver trapped cells blocking: + XYZCELL(IAXIS,LOW_IND) = XFACE(I-1); XYZCELL(IAXIS,HIGH_IND) = XFACE(I); + XYZCELL(JAXIS,LOW_IND) = YFACE(J-1); XYZCELL(JAXIS,HIGH_IND) = YFACE(J); + XYZCELL(KAXIS,LOW_IND) = ZFACE(K-1); XYZCELL(KAXIS,HIGH_IND) = ZFACE(K); + MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) + MINMAX_XYZ_CC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) + DO JCC=1,CC%NCELL + ! Get cut-cell bounding box: + CALL CUT_CELL_BOUNDING_BOX(NM,ICC,JCC,XYZCELL,MINMAX_XYZ_CC) + ! Perform Tests: + DO DUM=IAXIS,KAXIS + CELL_DELTA(DUM) = ABS(MINMAX_XYZ_CC(DUM,HIGH_IND)-MINMAX_XYZ_CC(DUM,LOW_IND)) + ENDDO + ! Axis with minimum width: + AX_MIN = MINLOC(CELL_DELTA(IAXIS:KAXIS),DIM=1) + SELECT CASE(AX_MIN) + CASE(IAXIS); AX_OTHERS(1:2) = (/ JAXIS, KAXIS /); SOLID_FACES = ALL(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_SOLID) + CASE(JAXIS); AX_OTHERS(1:2) = (/ IAXIS, KAXIS /); SOLID_FACES = ALL(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_SOLID) + CASE(KAXIS); AX_OTHERS(1:2) = (/ IAXIS, JAXIS /); SOLID_FACES = ALL(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_SOLID) + END SELECT + ! Perform Test: + BLOCK_SLIM_IF = (CELL_DELTA(AX_MIN)<10._EB*MIN_LENGTH_FACTOR*CELL_DELTA(AX_OTHERS(1))) .AND. & + (CELL_DELTA(AX_MIN)<10._EB*MIN_LENGTH_FACTOR*CELL_DELTA(AX_OTHERS(2))) + IF(BLOCK_SLIM_IF .AND. SOLID_FACES) CC%NOADVANCE(JCC) = BLOCKED_SMALL_CELL + ENDDO + CC%UNKZ(:) = CC_UNDEFINED + DO JCC=1,CC%NCELL + IF (CC%NOADVANCE(JCC)>0) CC%IJK_LINK(1,JCC) = CC_SOLID + ENDDO ENDDO +! Loop on Cartesian cells, number unknowns for cells type CC_CUTCFE and surrounding CC_GASPHASE: +DO K=0,M%KBP1 + DO J=0,M%JBP1 + DO I=0,M%IBP1 + IF ( M%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE + ! First Add the Cut-Cell + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF (ICC <= M%N_CUTCELL_MESH .AND. .NOT. M%CELL(M%CELL_INDEX(I,J,K))%SOLID ) THEN ! Don't number GC cut-cells, + ! or cutcells inside an OBST. + CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) + DO JCC=1,M%CUT_CELL(ICC)%NCELL + IF ( M%CUT_CELL(ICC)%NOADVANCE(JCC)>0 ) CYCLE + IF ( M%CUT_CELL(ICC)%VOLUME(JCC) > CCVOL_THRES) M%CUT_CELL(ICC)%UNKZ(JCC) = 1 + ENDDO + ENDIF + ! Run over Neighbors: Case 27 cells. Only Internal cells for the mesh in the stencil (I-1:I+1,J-1:J+1,K-1:K+1) + ! around Cartesian cell I,J,K of type CC_CUTCFE: + DO KNGH=K-1,K+1 + IF ( (KNGH < 1) .OR. (KNGH > M%KBAR) ) CYCLE + DO JNGH=J-1,J+1 + IF ( (JNGH < 1) .OR. (JNGH > M%JBAR) ) CYCLE + DO INGH=I-1,I+1 + ! Either not GASPHASE or already counted: + IF ((M%CCVAR(INGH,JNGH,KNGH,CC_CGSC)/=CC_GASPHASE) .OR. (M%CCVAR(INGH,JNGH,KNGH,CC_UNKZ)>0)) CYCLE + IF ( (INGH < 1) .OR. (INGH > M%IBAR) ) CYCLE + IF (M%CELL(CELL_INDEX(INGH,JNGH,KNGH))%SOLID) CYCLE + M%CCVAR(INGH,JNGH,KNGH,CC_UNKZ) = 1 + ENDDO + ENDDO + ENDDO -NEDGECROSS_OLD = MESHES(NM) % N_EDGE_CROSS -! Edges with Crossings not on VERTICES: -ICRS_DO : DO ICRS=1,CC_N_CRS + ENDDO + ENDDO +ENDDO - ! Skip SOLID-SOLID intersections, as there is no media crossing: - IF (CC_IS_CRS(ICRS) == CC_SS) CYCLE +! Now link small cells to surrounding cells in the mesh: +! NOTE: This scheme links two unknowns local to the mesh, therefore parallel consistency is not maintained. +! 1. Try linking them to adjacent regular cell with UNKZ > 0. Attempt going in surface normal direction first. +! 2. Try linking to adjacent cut-cell with UNKZ > 0. Attempt going in surface normal direction first. +! 3. If cut-cell could not be linked after N_LINK_ATTMP, block it. +LINK_ITER = 0; LINK_LEV_UP = 0 +LINK_LOOP : DO ! Cut-cell linking loop for small cells. -> Algo defined by CCVOL_LINK. + QUITLINK_FLG = .TRUE. - ! Check location on grid of crossing: - ! See if crossing is exactly on a Cartesian cell vertex: - IF (X2NOC==0) THEN - ! Optimized for UG: - JSTR = FLOOR( (CC_SVAR_CRS(ICRS)-GEOMEPS-X2CELL(X2LO_CELL))/DX2CELL(X2LO_CELL) ) + X2LO_CELL - ! Discard cut-edges on Cartesian edges laying > X2HI_CELL. - IF (JSTR < X2LO_CELL-1) CYCLE - IF (JSTR > X2HI_CELL+1) CYCLE + IF (LINK_ITER==0) THEN + ICC_LOOP_1 : DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) - JJ = JSTR - DELJJ = ABS(X2CELL(JJ)-CC_SVAR_CRS(ICRS)) - DX2CELL(X2LO_CELL)/2._EB - ! Crossing on Vertex? - IF ( ABS(DELJJ) < GEOMEPS ) THEN ! Add crossing to two edges: - JJLOW=0; JJHIGH=1 - ELSEIF ( DELJJ < -GEOMEPS ) THEN ! Crossing in jj Edge. - JJLOW=0; JJHIGH=0 - ELSEIF ( DELJJ > GEOMEPS ) THEN ! Crossing in jj+1 Edge. - JJLOW=1; JJHIGH=1 - ENDIF - ELSE - FOUND_EDGE=.FALSE. - JJLOW = -1000000 - JJHIGH= 1000000 - DO JJ=X2LO_CELL-1,X2HI_CELL - DELJJ = CC_SVAR_CRS(ICRS)-X2CELL(JJ) - XVJJ = X2CELL(JJ) + DX2CELL(JJ)/2._EB - DELJJ1= CC_SVAR_CRS(ICRS)-X2CELL(JJ+1) - ! First two edges: - IF(ABS(CC_SVAR_CRS(ICRS)-XVJJ) < GEOMEPS) THEN ! Both JJ and JJ+1 - FOUND_EDGE=.TRUE. - JJLOW=0; JJHIGH=1 - EXIT - ELSEIF (ABS(DELJJ) < DX2CELL(JJ)/2._EB) THEN ! JJ - FOUND_EDGE=.TRUE. - JJLOW=0; JJHIGH=0 - EXIT - ELSEIF (ABS(DELJJ1)< DX2CELL(JJ+1)/2._EB) THEN ! JJ+1 - FOUND_EDGE=.TRUE. - JJLOW=1; JJHIGH=1 - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_EDGE) CYCLE - ENDIF + JCC_LOOP_1 : DO JCC=1,CC%NCELL + IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE + CRTCELL_FLG = .FALSE. + VAL_UNKZ = CC_UNDEFINED + VAL_CVOL = CCVOL_THRES + ! Find area averaged body surface normal: + NRML(IAXIS:KAXIS) = 0._EB; AREA = 0._EB + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + IFC2 = CC%FACE_LIST(4,IFACE) + IFACE2 = CC%FACE_LIST(5,IFACE) + IBOD = M%CUT_FACE(IFC2)%BODTRI(1,IFACE2) + IWSEL = M%CUT_FACE(IFC2)%BODTRI(2,IFACE2) + AF = M%CUT_FACE(IFC2)%AREA( IFACE2) + NRML(IAXIS:KAXIS) = NRML(IAXIS:KAXIS) + GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL)*AF + AREA = AREA + AF + ENDDO - DO JJADD=JJLOW,JJHIGH - ! Edge in the left: - ! Edge at index JJ or JJ+1: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ+JJADD, KK /) ! Local x1,x2,x3 - INDIE=INDXI(XIAXIS) - INDJE=INDXI(XJAXIS) - INDKE=INDXI(XKAXIS) + ! With the surface normal search for a Regular Gasphase face in that direction. + AREA_IF_1 : IF (AREA > TWENTY_EPSILON_EB) THEN + NRML = NRML / AREA ! Normalize unit vector: + ! Normalize NRML vector to LINK_DIGITS: + DO DUM=IAXIS,KAXIS + NRML(DUM) = REAL(INT(LINK_FCT*NRML(DUM)),EB)/LINK_FCT + ENDDO + MASK(IAXIS:KAXIS) = .TRUE. + INRM(1) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(1))=.FALSE. + INRM(2) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(2))=.FALSE. + INRM(3) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1) + AXIS_LOOP_1 : DO DUM=IAXIS,KAXIS + X1AXIS=INRM(DUM) + IFC_LOOP_1 : DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND + IF( (X1AXIS /= CC%FACE_LIST(3,IFACE)) .OR. & + (CC%FACE_LIST(1,IFACE) /= CC_FTYPE_RCGAS) .OR. & + (ILH /= INT(SIGN(1._EB,NRML(X1AXIS)))) ) CYCLE IFC_LOOP_1 + SELECT CASE(X1AXIS) + CASE(IAXIS) + I_LNK = I+ILH; J_LNK = J; K_LNK = K + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + CASE(JAXIS) + I_LNK = I; J_LNK = J+ILH; K_LNK = K + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + CASE(KAXIS) + I_LNK = I; J_LNK = J; K_LNK = K+ILH + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + END SELECT + IF ( CRTCELL_FLG ) EXIT AXIS_LOOP_1 + ENDDO IFC_LOOP_1 + ENDDO AXIS_LOOP_1 + ENDIF AREA_IF_1 + + ! If not successful try any Regular Gasphase face. + ! Small cells, get CC_UNKZ from a large cell neighbor: + IF (.NOT. CRTCELL_FLG) THEN + IFC_LOOP_2 : DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + ILH = 2*CC%FACE_LIST(2,IFACE) - 3 + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE IFC_LOOP_2 + X1AXIS = CC%FACE_LIST(3,IFACE) + SELECT CASE(X1AXIS) + CASE(IAXIS) + I_LNK = I+ILH; J_LNK = J; K_LNK = K + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + CASE(JAXIS) + I_LNK = I; J_LNK = J+ILH; K_LNK = K + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + CASE(KAXIS) + I_LNK = I; J_LNK = J; K_LNK = K+ILH + IF(M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) > 0) THEN ! Regular Cartesian Cell + VAL_UNKZ = M%CCVAR(I_LNK,J_LNK,K_LNK,CC_UNKZ) + CRTCELL_FLG = .TRUE. + ENDIF + END SELECT + IF ( CRTCELL_FLG ) EXIT IFC_LOOP_2 + ENDDO IFC_LOOP_2 + ENDIF + IF (VAL_UNKZ>0) THEN + CC%FACE_LIST(6,IFACE) = INTEGER_ONE ! This face is shared with master. + CC%UNKZ(JCC) = VAL_UNKZ !(/ Cell Type, I, J, K, JCC_LNK /) + CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_GASPHASE, I_LNK, J_LNK, K_LNK, 0 /) + CC%LINK_LEV(JCC) = -1 ! One link hierarchy level below regular cells (at LNK_LEV=0). + ENDIF + ENDDO JCC_LOOP_1 + ENDDO ICC_LOOP_1 + ENDIF - ! Set MESHES(NM)%ECVAR(IE,JE,KE,CC_EGSC,X2AXIS) = CC_CUTCFE: - ICROSS = MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_ECRS,X2AXIS) - IF ( ICROSS > 0 ) THEN ! Edge has crossings already. + ! Then attempt to connect to large cut-cells, or already connected small cells (CUT_CELL(ICC)%UNKZ(JCC) > 0): + ICC_LOOP_2 : DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) - ! Populate EDGECROSS struct: - NCROSS = MESHES(NM)%EDGE_CROSS(ICROSS)%NCROSS + 1 - MESHES(NM)%EDGE_CROSS(ICROSS) % NCROSS = NCROSS - MESHES(NM)%EDGE_CROSS(ICROSS) % SVAR(NCROSS) = CC_SVAR_CRS(ICRS) - MESHES(NM)%EDGE_CROSS(ICROSS) % ISVAR(NCROSS)= CC_IS_CRS(ICRS) + JCC_LOOP_2 : DO JCC=1,CC%NCELL + IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE + VAL_UNKZ = CC_UNDEFINED + VAL_CVOL = -GEOMEPS - ELSE ! No crossings yet. + ! Find area averaged body surface normal: + NRML(IAXIS:KAXIS) = 0._EB; AREA = 0._EB + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + IFC2 = CC%FACE_LIST(4,IFACE) + IFACE2 = CC%FACE_LIST(5,IFACE) + IBOD = M%CUT_FACE(IFC2)%BODTRI(1,IFACE2) + IWSEL = M%CUT_FACE(IFC2)%BODTRI(2,IFACE2) + AF = M%CUT_FACE(IFC2)%AREA( IFACE2) + NRML(IAXIS:KAXIS) = NRML(IAXIS:KAXIS) + GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL)*AF + AREA = AREA + AF + ENDDO - NEDGECROSS = MESHES(NM)%N_EDGE_CROSS + 1 - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_CUTCFE - MESHES(NM)%N_EDGE_CROSS = NEDGECROSS - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_ECRS,X2AXIS) = NEDGECROSS + AREA_IF_2 : IF (AREA > TWENTY_EPSILON_EB) THEN + NRML = NRML / AREA ! Normalize unit vector: + ! Normalize NRML vector to LINK_DIGITS: + DO DUM=IAXIS,KAXIS + NRML(DUM) = REAL(INT(LINK_FCT*NRML(DUM)),EB)/LINK_FCT + ENDDO + MASK(IAXIS:KAXIS) = .TRUE. + INRM(1) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(1))=.FALSE. + INRM(2) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1); MASK(INRM(2))=.FALSE. + INRM(3) = MAXLOC(ABS(NRML(IAXIS:KAXIS)),MASK=MASK,DIM=1) + AXIS_LOOP_2 : DO DUM=IAXIS,KAXIS + X1AXIS=INRM(DUM) + IFC_LOOP_3 : DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + IF((CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB) .OR. & + (CC%FACE_LIST(1,IFACE)==CC_FTYPE_SVERT)) CYCLE IFC_LOOP_3 + ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND + IF( (X1AXIS /= CC%FACE_LIST(3,IFACE)) .OR. & + (ILH /= INT(SIGN(1._EB,NRML(X1AXIS)))) ) CYCLE IFC_LOOP_3 + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF( (I+ILH < 1) .OR. (I+ILH > M%IBAR) ) CYCLE IFC_LOOP_3 ! Drop if outside the mesh. + CASE(JAXIS) + IF( (J+ILH < 1) .OR. (J+ILH > M%JBAR) ) CYCLE IFC_LOOP_3 + CASE(KAXIS) + IF( (K+ILH < 1) .OR. (K+ILH > M%KBAR) ) CYCLE IFC_LOOP_3 + END SELECT + SELECT CASE(CC%FACE_LIST(1,IFACE)) ! 1. Check if a surrounding cell is a regular cell: + CASE(CC_FTYPE_RCGAS) ! REGULAR GASPHASE + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(M%CCVAR(I+ILH,J,K,CC_UNKZ) <= 0) THEN ! Cut - cell. + CALL GET_ICC2_JCC2(ICC,IFACE,I+ILH,J,K,ICC2,JCC2) + IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 + IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 + I_LNK = I+ILH; J_LNK = J; K_LNK = K; JCC_LNK = JCC2 + VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); + EXIT AXIS_LOOP_2 + ENDIF + CASE(JAXIS) + IF(M%CCVAR(I,J+ILH,K,CC_UNKZ) <= 0) THEN ! Cut - cell. + CALL GET_ICC2_JCC2(ICC,IFACE,I,J+ILH,K,ICC2,JCC2) + IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 + IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 + I_LNK = I; J_LNK = J+ILH; K_LNK = K; JCC_LNK = JCC2 + VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); + EXIT AXIS_LOOP_2 + ENDIF + CASE(KAXIS) + IF(M%CCVAR(I,J,K+ILH,CC_UNKZ) <= 0) THEN ! Cut - cell. + CALL GET_ICC2_JCC2(ICC,IFACE,I,J,K+ILH,ICC2,JCC2) + IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 + IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 + I_LNK = I; J_LNK = J; K_LNK = K+ILH; JCC_LNK = JCC2 + VAL_UNKZ=M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); + EXIT AXIS_LOOP_2 + ENDIF + END SELECT + CASE(CC_FTYPE_CFGAS) ! 2. Check for large surrounding cut-cells: + IFC2 = CC%FACE_LIST(4,IFACE) + IFACE2 = CC%FACE_LIST(5,IFACE) + ICC2 = M%CUT_FACE(IFC2)%CELL_LIST(2,CC%FACE_LIST(2,IFACE),IFACE2) + JCC2 = M%CUT_FACE(IFC2)%CELL_LIST(3,CC%FACE_LIST(2,IFACE),IFACE2) + IF (M%CUT_CELL(ICC2)%UNKZ(JCC2)<1) CYCLE IFC_LOOP_3 + IF (M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 + I_LNK = M%CUT_CELL(ICC2)%IJK(IAXIS); J_LNK = M%CUT_CELL(ICC2)%IJK(JAXIS); + K_LNK = M%CUT_CELL(ICC2)%IJK(KAXIS); JCC_LNK = JCC2 + VAL_UNKZ = M%CUT_CELL(ICC2)%UNKZ(JCC2); LNK_LEV=M%CUT_CELL(ICC2)%LINK_LEV(JCC2); EXIT AXIS_LOOP_2 + END SELECT + ENDDO IFC_LOOP_3 + ENDDO AXIS_LOOP_2 + IF (VAL_UNKZ > 0) THEN + CC%FACE_LIST(6,IFACE) = INTEGER_ONE ! This face is shared with master. + CC%UNKZ(JCC) = VAL_UNKZ + CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I_LNK, J_LNK, K_LNK, JCC_LNK /) + CC%LINK_LEV(JCC) = LNK_LEV-1 ! One link hierarchy level below master cell. + CYCLE JCC_LOOP_2 + ENDIF + ENDIF AREA_IF_2 - CALL EDGE_CROSS_ARRAY_REALLOCATE(NM,NEDGECROSS) + ! Small cells, get CC_UNKZ from a large cell neighbor: + IFACE3 = CC_UNDEFINED + IFC_LOOP_4 : DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + IF((CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB) .OR. & + (CC%FACE_LIST(1,IFACE)==CC_FTYPE_SVERT)) CYCLE IFC_LOOP_4 + ILH = 2*CC%FACE_LIST(2,IFACE) - 3 ! -1 for LOW_IND, 1 for HIGH_IND - ! Populate EDGECROSS struct: - NCROSS = 1 - MESHES(NM)%EDGE_CROSS(NEDGECROSS) % NCROSS = NCROSS - MESHES(NM)%EDGE_CROSS(NEDGECROSS) % SVAR(NCROSS) = CC_SVAR_CRS(ICRS) - MESHES(NM)%EDGE_CROSS(NEDGECROSS) % ISVAR(NCROSS)= CC_IS_CRS(ICRS) - MESHES(NM)%EDGE_CROSS(NEDGECROSS) % IJK(1:4) = (/ INDIE, INDJE, INDKE, X2AXIS /) + ! Cycle if surrounding cell is located in the guard-cell region, if so drop, as we don't have + ! at this point unknown numbers on guard-cells/guard-cell ccs: + X1AXIS = CC%FACE_LIST(3,IFACE) + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF( (I+ILH < 1) .OR. (I+ILH > M%IBAR) ) CYCLE IFC_LOOP_4 + CASE(JAXIS) + IF( (J+ILH < 1) .OR. (J+ILH > M%JBAR) ) CYCLE IFC_LOOP_4 + CASE(KAXIS) + IF( (K+ILH < 1) .OR. (K+ILH > M%KBAR) ) CYCLE IFC_LOOP_4 + END SELECT - ENDIF + SELECT CASE(CC%FACE_LIST(1,IFACE)) ! 1. Check if a surrounding cell is a regular cell: + CASE(CC_FTYPE_RCGAS) ! REGULAR GASPHASE + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(M%CCVAR(I+ILH,J,K,CC_UNKZ) <= 0) THEN ! Cut - cell. + CALL GET_ICC2_JCC2(ICC,IFACE,I+ILH,J,K,ICC2,JCC2) + IF(ANY((/ ICC2, JCC2 /) == 0)) CYCLE IFC_LOOP_4 + IF(M%CUT_CELL(ICC2)%VOLUME(JCC2) 0) THEN + CC%FACE_LIST(6,IFACE3) = INTEGER_ONE ! This face is shared with master. + CC%UNKZ(JCC) = VAL_UNKZ + CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I_LNK, J_LNK, K_LNK, JCC_LNK /) + CC%LINK_LEV(JCC) = LNK_LEV-1 ! One link hierarchy level below master cell. + ELSE + QUITLINK_FLG = .FALSE. + ENDIF + ENDDO JCC_LOOP_2 + ENDDO ICC_LOOP_2 -ENDDO ICRS_DO + ! Then fuse cut-cell unknowns if several ccs in one Cartesian cell and one of them has CUT_CELL(ICC)%UNKZ(JCC)>0: + ! IF(.NOT. ONE_UNKH_PER_CUTCELL) THEN + ! DO ICC=1,M%N_CUTCELL_MESH + ! CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + ! ! Don't attempt to link cut-cells inside an OBST: + ! IF ( M%CELL(M%CELL_INDEX(I,J,K))%SOLID ) CYCLE + ! ! Cases with more than one cut-cell: define UNKZ of all cells to be the one of first cut-cell with UNKZ > 0: + ! DO JCC=1,CC%NCELL; IF(CC%UNKZ(JCC)>0) EXIT; ENDDO + ! JCC_LNK = JCC + ! IF (JCC_LNK <= CC%NCELL) THEN + ! DO JCC=1,CC%NCELL + ! IF ( CC%NOADVANCE(JCC)>0 .OR. JCC==JCC_LNK ) CYCLE + ! CC%UNKZ(JCC) = CC%UNKZ(JCC_LNK) + ! CC%IJK_LINK(1:KAXIS+2,JCC) = (/ CC_CUTCFE, I, J, K, JCC_LNK /) + ! CC%LINK_LEV(JCC) = CC%LINK_LEV(JCC_LNK) - 1 + ! ENDDO + ! ENDIF + ! ENDDO + ! ENDIF -! Now Define MESHES(NM)%CUT_EDGE for CC_GASPHASE cut-edges: -DO ICROSS=NEDGECROSS_OLD+1,MESHES(NM)%N_EDGE_CROSS + IF (QUITLINK_FLG) EXIT LINK_LOOP - ! Discard edge outside of blocks ranges for ray on x2axis: - IF ( (MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS) < X2LO_CELL) .OR. & - (MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS) > X2HI_CELL) ) CYCLE + LINK_LEV_UP = LINK_LEV_UP - 1 + + LINK_ITER = LINK_ITER + 1 + BLOCK_CELL_IF : IF (LINK_ITER > N_LINK_ATTMP) THEN + ! Count how many unlinked cells we have in this mesh: + ULINK_COUNT = 0 + DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + DO JCC=1,CC%NCELL + IF ( CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0 ) CYCLE + ULINK_COUNT = ULINK_COUNT + 1 + ENDDO + ENDDO + + IF (GET_CUTCELLS_VERBOSE) THEN + ! Write out unlinked cells properties: + ! Open file to write unlinked cells: + WRITE(UNLINKED_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_unlinked_',MY_RANK,'.log' + ! Create file: + IF (UNLINKED_1ST_CALL) THEN + LU_UNLNK = GET_FILE_NUMBER() + OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='UNKNOWN') + WRITE(LU_UNLNK,*) 'Unlinked cut-cell Information for Process=',MY_RANK + CLOSE(LU_UNLNK) + UNLINKED_1ST_CALL = .FALSE. + ENDIF + ! Open file to write unlinked cell information: + OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='OLD',POSITION='APPEND') + WRITE(LU_UNLNK,*) ' ' + WRITE(LU_UNLNK,'(A,I4,A,I4)') ' Mesh NM=',NM,', number of unlinked cells=',ULINK_COUNT - NCROSS = MESHES(NM)%EDGE_CROSS(ICROSS)%NCROSS + ! Dump info: + ULINK_COUNT = 0 + DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + DO JCC=1,CC%NCELL + IF (CC%NOADVANCE(JCC)>0 .OR. CC%UNKZ(JCC)>0) CYCLE + ULINK_COUNT = ULINK_COUNT + 1 + WRITE(LU_UNLNK,'(I8,A,5I8,A,5F22.8)') & + ULINK_COUNT,', I,J,K,ICC,JCC=',I,J,K,ICC,JCC,', X,Y,Z,CCVOL,CCVOL_CRT=',M%X(I),M%Y(J),M%Z(K), & + CC%VOLUME(JCC),M%DX(I)*M%DY(J)*M%DZ(K) + ENDDO + ENDDO + CLOSE(LU_UNLNK) + ENDIF - ! Edge Location in x1,x2,x3 axes: - ! Vert at index JJ-1: - INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)-1, & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 - INDI=INDXI(XIAXIS) - INDJ=INDXI(XJAXIS) - INDK=INDXI(XKAXIS) - ! Vert at index JJ: - INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS), & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 - INDI1=INDXI(XIAXIS) - INDJ1=INDXI(XJAXIS) - INDK1=INDXI(XKAXIS) - ! Edge at index jj: - INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS), & - MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 - INDIE=INDXI(XIAXIS) ! i.e. MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(IAXIS), etc. - INDJE=INDXI(XJAXIS) - INDKE=INDXI(XKAXIS) + ! Unlinked cells get blocked, inboundary cut-faces are dropped, shared gas cut-faces are made inboundary faces + ! for neighbors. If no cut-cells left in location I,J,K => CCVAR(I,J,K,CC_CGSC) is set to CC_SOLID. + DO ICC=1,M%N_CUTCELL_MESH + DO JCC=1,M%CUT_CELL(ICC)%NCELL + IF ( M%CUT_CELL(ICC)%UNKZ(JCC) > 0 ) CYCLE + M%CUT_CELL(ICC)%IJK_LINK(1,JCC) = CC_SOLID ! Flag for Blocking after main mesh loop in SET_CUTCELLS_3D + ENDDO + ENDDO - ! Discard Edge with one EDGECROSS and both vertices having VERTVAR = CC_SOLID: - ! The crossing is on one of the edge vertices. - IF ( (NCROSS == 1) .AND. & - (MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & - (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) ) THEN + ! Recount unlinked cells (i.e. no other viable cells in the mesh). + ULINK_COUNT = 0 + DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + DO JCC=1,CC%NCELL + IF ( CC%UNKZ(JCC) > 0 .OR. CC%IJK_LINK(1,JCC)==CC_SOLID) CYCLE + ULINK_COUNT = ULINK_COUNT + 1 + ENDDO + ENDDO - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID - CYCLE + IF (GET_CUTCELLS_VERBOSE) THEN + ! Write out remaining unlinked cells properties. + ! Open file to write unlinked cell information: + OPEN(UNIT=LU_UNLNK,FILE=TRIM(UNLINKED_FILE),STATUS='OLD',POSITION='APPEND') + WRITE(LU_UNLNK,*) ' ' + WRITE(LU_UNLNK,*) 'STATUS AFTER BLOCKING SMALL UNLINKED CUT-CELLS:' + WRITE(LU_UNLNK,'(A,I4,A,I4)') ' Mesh NM=',NM,', number of unlinked cells after blocking=',ULINK_COUNT + IF(ULINK_COUNT > 0) THEN + ! Dump info: + ULINK_COUNT = 0 + DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID) CYCLE + DO JCC=1,CC%NCELL + IF (CC%UNKZ(JCC)>0) CYCLE + ULINK_COUNT = ULINK_COUNT + 1 + WRITE(LU_UNLNK,'(I8,A,5I8,A,5F22.8)') & + ULINK_COUNT,', I,J,K,ICC,JCC=',I,J,K,ICC,JCC,', X,Y,Z,CCVOL,CCVOL_CRT=',M%X(I),M%Y(J),M%Z(K), & + CC%VOLUME(JCC),M%DX(I)*M%DY(J)*M%DZ(K) + ENDDO + ENDDO + ENDIF + CLOSE(LU_UNLNK) + ENDIF + EXIT LINK_LOOP + ENDIF BLOCK_CELL_IF +ENDDO LINK_LOOP - ENDIF +! Finally compute M%FINEST_LINK_LEV: +DO ICC=1,M%N_CUTCELL_MESH + DO JCC=1,M%CUT_CELL(ICC)%NCELL + IF(M%CUT_CELL(ICC)%IJK_LINK(1,JCC)==CC_SOLID) THEN + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)==NOT_BLOCKED) M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCKED_UNLINK_CELL + M%CUT_CELL(ICC)%LINK_LEV(JCC) = CC_UNDEFINED + M%CUT_CELL(ICC)%IJK_LINK(2:5,JCC)= CC_UNDEFINED + ELSEIF(M%CUT_CELL(ICC)%LINK_LEV(JCC) < M%FINEST_LINK_LEV) THEN + M%FINEST_LINK_LEV = M%CUT_CELL(ICC)%LINK_LEV(JCC) + ENDIF + ENDDO +ENDDO - ! Discard cases for edge with two crossings: - IF ( NCROSS == 2 ) THEN +RETURN - VSOLID = (MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & - (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) +CONTAINS - ! Test if crossings lay on same location + solid vertices: - DIF = ( MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(2) - & - MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(1) ) < GEOMEPS - IF (DIF .AND. VSOLID) THEN - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID - CYCLE - ENDIF +SUBROUTINE GET_ICC2_JCC2(ICC,IFACE,INXT,JNXT,KNXT,ICC2,JCC2) +INTEGER, INTENT(IN) :: ICC,IFACE,INXT,JNXT,KNXT +INTEGER, INTENT(OUT):: ICC2, JCC2 - DIF = (ABS(X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)-1 ) - & - MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(1)) < GEOMEPS) .AND. & - (ABS(X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)) - & - MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(2)) < GEOMEPS) +INTEGER :: IFC, IFACE2 +TYPE(CC_CUTCELL_TYPE), POINTER :: CC2 +ICC2=M%CCVAR(INXT,JNXT,KNXT,CC_IDCC); IF (ICC2<=0) RETURN +CC2 => M%CUT_CELL(ICC2) +DO JCC2=1,CC2%NCELL + ! Loop faces and test: + DO IFC=1,CC2%CCELEM(1,JCC2) + IFACE2 = CC2%CCELEM(IFC+1,JCC2) + ! If face type in face_list is not CC_FTYPE_RCGAS, drop: + IF(CC2%FACE_LIST(1,IFACE2) /= CC_FTYPE_RCGAS) CYCLE + ! Does X1AXIS match and LOWHIGH are different? + IF( CC2%FACE_LIST(3,IFACE2) /= M%CUT_CELL(ICC)%FACE_LIST(3,IFACE)) CYCLE ! X1AXIS is different. + IF(ABS(CC2%FACE_LIST(2,IFACE2) - M%CUT_CELL(ICC)%FACE_LIST(2,IFACE)) < 1) CYCLE ! Same LOWHIGH. + ! Found the cut-cell ICC2,JCC2 on the other side of IFACE for cut-cell ICC,JCC. + RETURN + ENDDO +ENDDO +JCC2=0 +RETURN +END SUBROUTINE GET_ICC2_JCC2 - VFLUID = (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(1) == CC_GS) .AND. & - (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(2) == CC_SG) - IF (DIF .AND. VSOLID .AND. VFLUID) THEN - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID - CYCLE - ENDIF +END SUBROUTINE GET_CELL_LINK_INFO - ENDIF - ! New CUT_EDGE struct for this edge: - NCUTEDGE = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = NCUTEDGE - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_IDCE,X2AXIS)= NCUTEDGE - CALL CUT_EDGE_ARRAY_REALLOC(NM,NCUTEDGE) +! --------------------- BLOCK_CC_SOLID_EXTWALLCELLS ----------------------------- - MESHES(NM)%CUT_EDGE(NCUTEDGE)%STATUS = CC_GASPHASE - MESHES(NM)%CUT_EDGE(NCUTEDGE)%IJK(1:MAX_DIM+1) = MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(1:MAX_DIM+1) - MESHES(NM)%CUT_EDGE(NCUTEDGE)%IJK(MAX_DIM+2) = CC_UNDEFINED ! No need to define CUT_EDGE type (is CC_GASPHASE). - ! First Vertices: - NVERT = NCROSS + 2 - MESHES(NM)%CUT_EDGE(NCUTEDGE)%NVERT = NVERT - X123VERT(IAXIS:KAXIS,1:NVERT) = 0._EB - X123VERT(IAXIS,1:NVERT) = X1FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS)) - X123VERT(JAXIS,1) = X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)-1) - X123VERT(JAXIS,2:NCROSS+1)= MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(1:NCROSS) - X123VERT(JAXIS,NVERT) = X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)) - X123VERT(KAXIS,1:NVERT) = X3FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS)) +SUBROUTINE BLOCK_CC_SOLID_EXTWALLCELLS(FIRST_CALL) - ! Allocate new edge XYZVERT, CEELEM, INDSEG - CALL NEW_EDGE_ALLOC(NM,NCUTEDGE,NVERT,CC_ALLOC_DELEM) - DO IVERT=1,MESHES(NM)%CUT_EDGE(NCUTEDGE)%NVERT - MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT(IAXIS:KAXIS,IVERT) = & - X123VERT( (/ XIAXIS, XJAXIS, XKAXIS /) ,IVERT) - ENDDO +LOGICAL, INTENT(IN) :: FIRST_CALL - ! Now Cut Edges: - ! Node List: - VERT_LIST(:,:) = CC_UNDEFINED - VERT_LIST(1,:) = CC_VTYPE_NINB ! Nodes by default are in boundary. - CE=>MESHES(NM)%CUT_EDGE(NCUTEDGE) - DO IVERT=1,CE%NVERT - ! NOD1: - IF(ABS(CE%XYZVERT(IAXIS,IVERT)-XFACE(INDI ))WALL(IW) + BC=>BOUNDARY_COORD(WC%BC_INDEX) + IF (FIRST_CALL) THEN + IF (.NOT.(WC%BOUNDARY_TYPE==INTERPOLATED_BOUNDARY)) CYCLE EXTERNAL_WALL_LOOP + ELSE + ! Here we might need to add other EXT wall cell types. + IF (.NOT.(WC%BOUNDARY_TYPE==OPEN_BOUNDARY .OR. WC%BOUNDARY_TYPE==SOLID_BOUNDARY)) CYCLE EXTERNAL_WALL_LOOP ENDIF - ! NOD 2: - IF(ABS(CE%XYZVERT(IAXIS,IVERT)-XFACE(INDI1)) MESHES(NM) +SF=> SURFACE(SURF_INDEX) +CF=> CUT_FACE(ICF) -! ------------------------EDGE_CROSS_ARRAY_REALLOCATE---------------------------- +STAGE_FLG_BRANCH : SELECT CASE(STAGE_FLG) -SUBROUTINE EDGE_CROSS_ARRAY_REALLOCATE(NM,CEI) +CASE(INTEGER_ONE) ! Geometry information for CFACE. -INTEGER, INTENT(IN) :: NM, CEI + CALL ALLOCATE_STORAGE(NM,SURF_INDEX=SURF_INDEX,CFACE_INDEX=CFACE_INDEX) -! Local Variables: -INTEGER :: CEI1, SIZE_EDGE_CROSS + CFA => M%CFACE(CFACE_INDEX) + BC => M%BOUNDARY_COORD(CFA%BC_INDEX) + B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) -SIZE_EDGE_CROSS = SIZE(MESHES(NM)%EDGE_CROSS,DIM=1) -IF(CEI > SIZE_EDGE_CROSS) THEN - ALLOCATE(EDGE_CROSS_AUX(SIZE_EDGE_CROSS+GLOBAL_DELTA_EDGE)) - DO CEI1=1,CEI-1 - EDGE_CROSS_AUX(CEI1)%NCROSS = MESHES(NM)%EDGE_CROSS(CEI1)%NCROSS - EDGE_CROSS_AUX(CEI1)%SVAR = MESHES(NM)%EDGE_CROSS(CEI1)%SVAR - EDGE_CROSS_AUX(CEI1)%ISVAR = MESHES(NM)%EDGE_CROSS(CEI1)%ISVAR - EDGE_CROSS_AUX(CEI1)%IJK = MESHES(NM)%EDGE_CROSS(CEI1)%IJK - ENDDO - CALL MOVE_ALLOC(FROM=EDGE_CROSS_AUX, TO=MESHES(NM)%EDGE_CROSS) -ENDIF + CFA%SURF_INDEX = SURF_INDEX + CFA%NODE_INDEX = SURFACE(SURF_INDEX)%NODE_INDEX + B1%NODE_INDEX = CFA%NODE_INDEX -RETURN -END SUBROUTINE EDGE_CROSS_ARRAY_REALLOCATE + BC%X = CF%XYZCEN(IAXIS,IFACE) + BC%Y = CF%XYZCEN(JAXIS,IFACE) + BC%Z = CF%XYZCEN(KAXIS,IFACE) + CFA%AREA = CF%AREA(IFACE) + ! Now populate cut-face information: + CFA%CUT_FACE_IND1 = ICF + CFA%CUT_FACE_IND2 = IFACE -! --------------------------CUT_EDGE_ARRAY_REALLOC------------------------------- + INS_INB_COND_1 : IF (IS_INB) THEN + B1%VEL_ERR_NEW=CF%VEL(IFACE) - 0._EB ! Assumes zero velocity of solid. -SUBROUTINE CUT_EDGE_ARRAY_REALLOC(NM,CEI) + ! Normal to cut-face: + V2(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(2,IFACE))-CF%XYZCEN(IAXIS:KAXIS,IFACE) + V3(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(3,IFACE))-CF%XYZCEN(IAXIS:KAXIS,IFACE) + CALL CROSS_PRODUCT(BC%NVEC(IAXIS:KAXIS),V2,V3) + IF(NORM2(BC%NVEC)>TWENTY_EPSILON_EB .AND. CF%CFACE_ORIGIN(IFACE)==BLOCKED_SPLIT_CELL) THEN + BC%NVEC(IAXIS:KAXIS) = BC%NVEC(IAXIS:KAXIS)/NORM2(BC%NVEC) + ELSE + IBOD =CF%BODTRI(1,IFACE) + IWSEL=CF%BODTRI(2,IFACE) + BC%NVEC(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) + ENDIF + X1AXIS = MAXLOC(ABS(BC%NVEC(IAXIS:KAXIS)),DIM=1) + BC%IOR = INT(SIGN(1._EB,BC%NVEC(X1AXIS)))*X1AXIS -INTEGER, INTENT(IN) :: NM, CEI + ! Boundary CFACES processed are defined of type SOLID_BOUNDARY + CFA%BOUNDARY_TYPE = SOLID_BOUNDARY -! Local Variables: -INTEGER :: CEI1, SIZE_CUT_EDGE + ! Might need to rethink this, but for the time being... + BC%II = CF%IJK(IAXIS) + BC%JJ = CF%IJK(JAXIS) + BC%KK = CF%IJK(KAXIS) -SIZE_CUT_EDGE = SIZE(MESHES(NM)%CUT_EDGE,DIM=1) -IF (CEI > SIZE_CUT_EDGE) THEN - ALLOCATE(CUT_EDGE_AUX(SIZE_CUT_EDGE+GLOBAL_DELTA_EDGE)) - DO CEI1=1,CEI-1 - CUT_EDGE_AUX(CEI1)%NVERT = MESHES(NM)%CUT_EDGE(CEI1)%NVERT - CUT_EDGE_AUX(CEI1)%NEDGE = MESHES(NM)%CUT_EDGE(CEI1)%NEDGE - CUT_EDGE_AUX(CEI1)%NEDGE1 = MESHES(NM)%CUT_EDGE(CEI1)%NEDGE1 - CUT_EDGE_AUX(CEI1)%STATUS = MESHES(NM)%CUT_EDGE(CEI1)%STATUS - CUT_EDGE_AUX(CEI1)%IJK = MESHES(NM)%CUT_EDGE(CEI1)%IJK - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%XYZVERT, TO=CUT_EDGE_AUX(CEI1)%XYZVERT) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%CEELEM, TO=CUT_EDGE_AUX(CEI1)%CEELEM) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%INDSEG, TO=CUT_EDGE_AUX(CEI1)%INDSEG) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%VERT_LIST, TO=CUT_EDGE_AUX(CEI1)%VERT_LIST) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%NOD_PERM, TO=CUT_EDGE_AUX(CEI1)%NOD_PERM) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%DXX, TO=CUT_EDGE_AUX(CEI1)%DXX) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%FACE_LIST, TO=CUT_EDGE_AUX(CEI1)%FACE_LIST) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%DUIDXJ, TO=CUT_EDGE_AUX(CEI1)%DUIDXJ) - CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%MU_DUIDXJ, TO=CUT_EDGE_AUX(CEI1)%MU_DUIDXJ) - ENDDO - CALL MOVE_ALLOC(FROM=CUT_EDGE_AUX, TO=MESHES(NM)%CUT_EDGE) -ENDIF + BC%IIG = CF%IJK(IAXIS) + BC%JJG = CF%IJK(JAXIS) + BC%KKG = CF%IJK(KAXIS) -RETURN -END SUBROUTINE CUT_EDGE_ARRAY_REALLOC + ELSE INS_INB_COND_1 ! External mesh boundary CFACE + IF (PRESENT(IW)) THEN + WC => M%WALL(IW) + WC_BC => M%BOUNDARY_COORD(WC%BC_INDEX) + IOR = WC_BC%IOR + SELECT CASE(ABS(IOR)) + CASE(IAXIS); BC%NVEC(IAXIS:KAXIS) = (/ REAL(SIGN(1,IOR),EB), 0._EB, 0._EB /) + CASE(JAXIS); BC%NVEC(IAXIS:KAXIS) = (/ 0._EB, REAL(SIGN(1,IOR),EB), 0._EB /) + CASE(KAXIS); BC%NVEC(IAXIS:KAXIS) = (/ 0._EB, 0._EB, REAL(SIGN(1,IOR),EB) /) + END SELECT + BC%IOR = IOR -! ----------------------------- NEW_EDGE_ALLOC ---------------------------------- + ! External mesh boundary CFACES inherit the underlaying WALL type. + CFA%BOUNDARY_TYPE = WC%BOUNDARY_TYPE + CFA%NODE_INDEX = SURFACE(WC%SURF_INDEX)%NODE_INDEX + CFA%VENT_INDEX = WC%VENT_INDEX -SUBROUTINE NEW_EDGE_ALLOC(NM,CEI,NVERTALLOC,NEDGEALLOC) + BC%II = WC_BC%II + BC%JJ = WC_BC%JJ + BC%KK = WC_BC%KK -INTEGER, INTENT(IN) :: NM, CEI, NVERTALLOC, NEDGEALLOC + BC%IIG = WC_BC%IIG + BC%JJG = WC_BC%JJG + BC%KKG = WC_BC%KKG -IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT) -IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM) -IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%CEELEM)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM) -IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%INDSEG)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%INDSEG) -IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST) + ENDIF + ENDIF INS_INB_COND_1 -ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:NVERTALLOC)) -ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(1:NVERTALLOC)) -ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGEALLOC)) -ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%INDSEG(CC_MAX_WSTRIANG_SEG+3,1:NEDGEALLOC)) -ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(CC_MAX_WSTRIANG_SEG+2,1:NVERTALLOC)) + B1%AREA = CF%AREA(IFACE) ! Init to CFACE AREA. -MESHES(NM)%CUT_EDGE(CEI)%XYZVERT = 0._EB -MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM = CC_UNDEFINED -MESHES(NM)%CUT_EDGE(CEI)%CEELEM = CC_UNDEFINED -MESHES(NM)%CUT_EDGE(CEI)%INDSEG = CC_UNDEFINED -MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST= CC_UNDEFINED +CASE(INTEGER_TWO) ! Assign AREA_ADJUST for CFACE, BCs information for CFACE. -RETURN + CFA => M%CFACE(CFACE_INDEX) + BC => M%BOUNDARY_COORD(CFA%BC_INDEX) + B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) + ! First: Assign AREA_ADJUST for CFACEs. + B1%AREA_ADJUST = CF%AREA_ADJUST(IFACE) -END SUBROUTINE NEW_EDGE_ALLOC + ! Case of exposed Backing we need to find CFACE_INDEX of BACK CFACE. + IF (SF%BACKING==EXPOSED .AND. SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN + IG = CF%BODTRI(1,IFACE) + TRI = CF%BODTRI(2,IFACE) + XP(IAXIS:KAXIS) = (/ BC%X, BC%Y, BC%Z /) ! CFACE centroid location. + RDIR(IAXIS:KAXIS)= - GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,TRI) ! Normal into the body. + TRI_LOOP : DO IWSEL=1,GEOMETRY(IG)%N_FACES + IF (IWSEL==TRI) CYCLE + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + ! Triangles NODES coordinates: + V1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) + V2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) + V3(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD3)-1)+1:MAX_DIM*WSELEM(NOD3)) -! ------------------ REALLOCATE_EDGE_VERT(NM,CEI,NVERT) ------------------------- + ! Fast triangle discard method: To do. -SUBROUTINE REALLOCATE_EDGE_VERT(NM,CEI,NVERT) + ! Search for intersection point in POS(IAXIS:KAXIS): + CALL RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,RDIR,IS_INTERSECT,POS) -INTEGER, INTENT(IN) :: NM, CEI, NVERT + IF (IS_INTERSECT) EXIT TRI_LOOP -! Local Variables: -INTEGER :: NVERT_SIZE -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZVERTAUX -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: VERT_LISTAUX -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOD_PERMAUX + ENDDO TRI_LOOP -NVERT_SIZE = SIZE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT, DIM=2) + IF (IS_INTERSECT) THEN -IF (NVERT > NVERT_SIZE) THEN ! Reallocate XYZVERT - ALLOCATE(XYZVERTAUX(IAXIS:KAXIS,1:NVERT_SIZE+CC_ALLOC_DVERT)); XYZVERTAUX = 0._EB - XYZVERTAUX(IAXIS:KAXIS,1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:NVERT_SIZE) - CALL MOVE_ALLOC(FROM=XYZVERTAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%XYZVERT) + ! Check that distance is less than cell diagonal size: + ! For longer distances from CFACE to BACK CFACE BC is 'VOID'. + IF(NORM2(XP-POS) > SQRT(DX(BC%IIG)**2 + DY(BC%JJG)**2 + DZ(BC%KKG)**2)) RETURN - ALLOCATE(NOD_PERMAUX(1:NVERT_SIZE+CC_ALLOC_DVERT)); NOD_PERMAUX = CC_UNDEFINED - NOD_PERMAUX(1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(1:NVERT_SIZE) - CALL MOVE_ALLOC(FROM=NOD_PERMAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM) + ! We Found an intersection with IWSEL in position POS(IAXIS:KAXIS): + ! Find indexes and mesh of cell containing intersection point: + CALL SEARCH_OTHER_MESHES(POS(IAXIS),POS(JAXIS),POS(KAXIS),NOM,IIO,JJO,KKO) - ALLOCATE(VERT_LISTAUX(1:4,1:NVERT_SIZE+CC_ALLOC_DVERT)); VERT_LISTAUX = CC_UNDEFINED - VERT_LISTAUX(1:4,1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,1:NVERT_SIZE) - CALL MOVE_ALLOC(FROM=VERT_LISTAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST) -ENDIF + ! This test and restriction of NOM==NM is temporary. Discard when parallel CFACE info is in place. + IF (NOM/=NM) THEN + IF(NOM==0) RETURN + WRITE(LU_ERR,*) 'WARNING: BACK CFACE search, other mesh NOM not equal to working mesh NM. NM=',NM,& + ', NOM and other cell IIO,JJO,KKO=',NOM,IIO,JJO,KKO,', intersection pt=',POS(IAXIS:KAXIS) + RETURN + ENDIF -RETURN + IF (NOM>0) THEN + IF (ALLOCATED(MESHES(NOM)%CCVAR)) THEN + IIV(1:3) = (/ IIO, MAX(IIO-1,1), MIN(IIO+1,MESHES(NOM)%IBAR) /) + JJV(1:3) = (/ JJO, MAX(JJO-1,1), MIN(JJO+1,MESHES(NOM)%JBAR) /) + KKV(1:3) = (/ KKO, MAX(KKO-1,1), MIN(KKO+1,MESHES(NOM)%KBAR) /) -END SUBROUTINE REALLOCATE_EDGE_VERT + DIST= 1._EB/TWENTY_EPSILON_EB; ICFF=0; JCF2=0 + K_LOOP : DO KKK=1,3 + KK=KKV(KKK) + DO JJJ=1,3 + JJ=JJV(JJJ) + DO III=1,3 + II=IIV(III) + ICF2 = MESHES(NOM)%CCVAR(II,JJ,KK,CC_IDCF) + ICF2_COND : IF (ICF2>0) THEN -! ------------------ REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) ------------------------- + ! Use cut-face with closest centroid to POS: + DO JCF22=1,MESHES(NOM)%CUT_FACE(ICF2)%NFACE + IF(ICF==ICF2 .AND. IFACE==JCF22) CYCLE + DIST2 = (POS(IAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(IAXIS,JCF22))**2._EB + & + (POS(JAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(JAXIS,JCF22))**2._EB + & + (POS(KAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(KAXIS,JCF22))**2._EB + IF (DIST20 .AND. CFA%OD_INDEX>0) THEN + M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_MESH = NOM + M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_INDEX = ICFACE + ENDIF -NEDGE_SIZE = SIZE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM, DIM=2) + ! Write error for testing: + ELSE + WRITE(LU_ERR,*) 'WARNING: BACK CFACE search, MESH, CFACE_INDEX=',NM,CFACE_INDEX,& + ', back CFACE not found in mesh NOM,IIO,JJO,KKO=',NOM,IIO,JJO,KKO + RETURN + ENDIF + ELSE ! Intersection in mesh furher away than neighboring meshes. + ! To Do stop. -IF (NEDGE > NEDGE_SIZE) THEN ! Reallocate CEELEM, + ENDIF - CC_ALLOC_ELEM = MAX(NEDGE-NEDGE_SIZE,CC_ALLOC_DELEM) + ELSE ! Intersection outside of domain. + ! To Do stop. - ALLOCATE(CEELEMAUX(NOD1:NOD2,1:NEDGE_SIZE+CC_ALLOC_ELEM), INDSEGAUX(CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE+CC_ALLOC_ELEM)) - CEELEMAUX = CC_UNDEFINED; INDSEGAUX = CC_UNDEFINED + ENDIF - CEELEMAUX(NOD1:NOD2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGE_SIZE) - INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE) + ELSE ! Did not find intersection with other triangles. + ! To Do : Here we can add a test to check if CFACE is indeed within geometry IG. Geometry intersection and + ! linearization lead need to CFACES lay outside of the geometry. + WRITE(LU_ERR,*) 'WARNING: BACK CFACE search did NOT Find Intersection. MESH=',NM,', GEOM=',IG,& + ', CFACE_INDEX, Centroid location=',CFACE_INDEX,XP(:) + RETURN + ENDIF - CALL MOVE_ALLOC(FROM=CEELEMAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%CEELEM) - CALL MOVE_ALLOC(FROM=INDSEGAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%INDSEG) + ENDIF - IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST)) THEN - ! FACE_LIST, DXX, DUIDXJ, MU_DUIDXJ: - ALLOCATE(FACE_LIST_AUX(1:3,-2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); FACE_LIST_AUX=CC_UNDEFINED - FACE_LIST_AUX(1:3,-2:2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,1:NEDGE_SIZE) - CALL MOVE_ALLOC(FROM=FACE_LIST_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST) +CASE(INTEGER_THREE) - ALLOCATE(DXX_AUX(1:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); DXX_AUX=0._EB - DXX_AUX(1:2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%DXX(1:2,1:NEDGE_SIZE) - CALL MOVE_ALLOC(FROM=DXX_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%DXX) + CFA => M%CFACE(CFACE_INDEX) + BC => M%BOUNDARY_COORD(CFA%BC_INDEX) + B1 => M%BOUNDARY_PROP1(CFA%B1_INDEX) - ALLOCATE(DUIDXJ_AUX( -2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); DUIDXJ_AUX = 0._EB - ALLOCATE(MU_DUIDXJ_AUX(-2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); MU_DUIDXJ_AUX= 0._EB + INS_INB_COND_3 : IF (IS_INB) THEN - CALL MOVE_ALLOC(FROM=DUIDXJ_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%DUIDXJ) - CALL MOVE_ALLOC(FROM=MU_DUIDXJ_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%MU_DUIDXJ) - ENDIF + ! Associated cut-cell location in CUT_CELL array. + ! This CFACE initialization assumes TMP,RHO,ZZ have been initialized in cut-cell ICC,JCC. + ICC = CF%CELL_LIST(2,LOW_IND,IFACE) + JCC = CF%CELL_LIST(3,LOW_IND,IFACE) -ENDIF + ! Set TMP_F to Surface value and rest to ambient in underlying cartesian cell. + B1%TMP_G = TMP_0(CF%IJK(KAXIS)) + IF (SF%TMP_FRONT > 0._EB) THEN + B1%TMP_F = SF%TMP_FRONT + ELSE + B1%TMP_F = B1%TMP_G + ENDIF -RETURN + B1%RHO_F = CUT_CELL(ICC)%RHO(JCC) + B1%RHO_G = CUT_CELL(ICC)%RHO(JCC) + B1%ZZ_F(1:N_TOTAL_SCALARS) = CUT_CELL(ICC)%ZZ(1:N_TOTAL_SCALARS,JCC) + ! Reinitialize CFACE cell outgoing radiation for change in TMP_F + IF (RADIATION) THEN + B1%Q_RAD_OUT = B1%EMISSIVITY*SIGMA*B1%TMP_F**4 + ELSE + B1%Q_RAD_OUT = 0._EB + ENDIF + ! Assign normal velocity to CFACE from SURF input: + B1%U_NORMAL_0 = SF%VEL + ! Assign normal velocity from VOLUME_FLOW : + IBOD =CF%BODTRI(1,IFACE) + IF(IBOD>0 .AND. ABS(SF%VOLUME_FLOW)>=TWENTY_EPSILON_EB) B1%U_NORMAL_0 = SF%VOLUME_FLOW / FDS_AREA_GEOM(SURF_INDEX,IBOD) + ! Assign normal velocity from MASS_FLUX_TOTAL : + IF(ABS(SF%MASS_FLUX_TOTAL)>=TWENTY_EPSILON_EB) B1%U_NORMAL_0 = SF%MASS_FLUX_TOTAL / RHOA * B1%AREA_ADJUST + ! Vegetation T_IGN setup: Check if fire spreads radially over this surface type + IF (SF%FIRE_SPREAD_RATE>0._EB) THEN + B1%T_IGN = T_BEGIN + SQRT((BC%X-SF%XYZ(1))**2 + & + (BC%Y-SF%XYZ(2))**2 + & + (BC%Z-SF%XYZ(3))**2)/SF%FIRE_SPREAD_RATE + ELSE + B1%T_IGN = SF%T_IGN + ENDIF -END SUBROUTINE REALLOCATE_EDGE_ELEM + ELSE INS_INB_COND_3 ! External mesh boundary CFACE -! -------------------------- GET_ISGASPHASE ------------------------------------- + IF (PRESENT(IW)) THEN + WC => M%WALL(IW) + IOR = M%BOUNDARY_COORD(WC%BC_INDEX)%IOR + WC_B1 => M%BOUNDARY_PROP1(WC%B1_INDEX) + WC_BC => M%BOUNDARY_COORD(WC%BC_INDEX) + ! Set TMP_F to Surface value and rest to ambient in underlying cartesian cell. + B1%TMP_G = TMP(WC_BC%IIG,WC_BC%JJG,WC_BC%KKG) + B1%TMP_F = WC_B1%TMP_F + B1%RHO_F = WC_B1%RHO_F + B1%RHO_G = RHO(WC_BC%IIG,WC_BC%JJG,WC_BC%KKG) + B1%ZZ_F(1:N_TOTAL_SCALARS) = WC_B1%ZZ_F(1:N_TOTAL_SCALARS) -SUBROUTINE GET_IS_GASPHASE(SCEN,IS_GASPHASE) + ! Assign normal velocity to CFACE from wall cell: + B1%U_NORMAL_0 = WC_B1%U_NORMAL_0 -REAL(EB), INTENT(IN) :: SCEN -LOGICAL, INTENT(OUT) :: IS_GASPHASE + ! Here downscale velocity: + IF (IFACE==CF%NFACE) WC_B1%U_NORMAL_0 = & + WC_B1%U_NORMAL_0 * SUM(CF%AREA(1:CF%NFACE))/WC_B1%AREA -! Local Variables: -LOGICAL :: IS_GASPHASE_LEFT, IS_GASPHASE_RIGHT -INTEGER :: ICRS + ! Vegetation T_IGN setup: + B1%T_IGN = WC_B1%T_IGN + ! Back wall cells: + IF (WC%OD_INDEX>0 .AND. CFA%OD_INDEX>0) THEN + M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_MESH = M%BOUNDARY_ONE_D(WC%OD_INDEX)%BACK_MESH + M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_INDEX = M%BOUNDARY_ONE_D(WC%OD_INDEX)%BACK_INDEX + ENDIF + ENDIF -! Count GS,SG intersections from both sides: -IS_GASPHASE_LEFT = .TRUE. -DO ICRS=1,CC_N_CRS - IF (SCEN < CC_SVAR_CRS(ICRS)-GEOMEPS/2._EB) CYCLE - ! If solid change state: - IF ( (CC_IS_CRS(ICRS) == CC_GS) .OR. (CC_IS_CRS(ICRS) == CC_SG) ) THEN - IS_GASPHASE_LEFT = .NOT.IS_GASPHASE_LEFT - ENDIF -ENDDO + ENDIF INS_INB_COND_3 -IS_GASPHASE_RIGHT = .TRUE. -DO ICRS=CC_N_CRS,1,-1 - IF (SCEN > CC_SVAR_CRS(ICRS)+GEOMEPS/2._EB) CYCLE - ! If solid change state: - IF ( (CC_IS_CRS(ICRS) == CC_GS) .OR. (CC_IS_CRS(ICRS) == CC_SG) ) THEN - IS_GASPHASE_RIGHT = .NOT.IS_GASPHASE_RIGHT - ENDIF -ENDDO +END SELECT STAGE_FLG_BRANCH -! If at least one of left and right are true -> add -! CC_GASPHASE cut-edge: -IS_GASPHASE = IS_GASPHASE_LEFT .OR. IS_GASPHASE_RIGHT +END SUBROUTINE INIT_CFACE_CELL -RETURN -END SUBROUTINE GET_IS_GASPHASE -! --------------------- GET_BODX2_INTERSECTIONS --------------------------------- +! --------------------- GET_REGULAR_CUT_EDGES_BC -------------------------------- -SUBROUTINE GET_BODX2_INTERSECTIONS(X2AXIS,X3AXIS,X3RAY) +SUBROUTINE GET_REGULAR_CUT_EDGES_BC(NM) -INTEGER, INTENT(IN) :: X2AXIS,X3AXIS -REAL(EB),INTENT(IN) :: X3RAY +! This routine adds to FDS EDGE array +! the sum of regular edges that are boundary at least a neighboring CC_CUTCFE face and +! one CC_GASPHASE face. -! Local Variables: -REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN, SBOD -REAL(EB) :: STANI(IAXIS:JAXIS), DV(IAXIS:JAXIS) -INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IBCR, IDUM, NBCROSS_SVAR -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX -REAL(EB) :: DX3_1, DX3_2, XI1, XI2 -REAL(EB) :: TNOW +USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_CELL,REALLOCATE_EDGE +INTEGER, INTENT(IN) :: NM -! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX3_1Q,DX3_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) +! Local variables: +INTEGER :: ECOUNT, CC_ECOUNT_RC, CC_ECOUNT_CE, CCOUNT, I, J, K, N_CC, N_RG, IE, IADD, JADD, KADD, IEC, N1, N2 +LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: CELL_ADDED +INTEGER :: ICMM,ICPM,ICPP,ICMP +INTEGER :: IDUM,IOR,IW1,IW2,CELL_COUNT_OLD +INTEGER, PARAMETER :: IAXIS_WALL_INDS(1:4) = (/ -3, -2, 2, 3 /) +INTEGER, PARAMETER :: JAXIS_WALL_INDS(1:4) = (/ -3, -1, 1, 3 /) +INTEGER, PARAMETER :: KAXIS_WALL_INDS(1:4) = (/ -2, -1, 1, 2 /) +LOGICAL :: DO_EDGE_FLG +TYPE(MESH_TYPE), POINTER :: M -TNOW=CURRENT_TIME() +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +CHARACTER(100) :: MSEGS_FILE +M => MESHES(NM) -IF ( BODINT_PLANE%NSEGS == 0) RETURN +IF (DEBUG_SET_CUTCELLS) THEN + ! Write out: + WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_rcsegs_mesh_',NM,'.dat' + OPEN(333,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') + CLOSE(333) +ENDIF -DO ISEG=1,BODINT_PLANE%NSEGS +CALL POINT_TO_MESH(NM) - IF (BODINT_PLANE%X2ALIGNED(ISEG)) CYCLE - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - IF( (X3RAY-MAX(BODINT_PLANE%XYZ(X3AXIS,SEG(NOD1)),BODINT_PLANE%XYZ(X3AXIS,SEG(NOD2)))) > GEOMEPS) CYCLE - IF( (MIN(BODINT_PLANE%XYZ(X3AXIS,SEG(NOD1)),BODINT_PLANE%XYZ(X3AXIS,SEG(NOD2)))-X3RAY) > GEOMEPS) CYCLE - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) +! Return if nothing to do for the mesh: +IF(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH == 0) RETURN - ! x2_x3 of segment point 1: - X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) - ! x2_x3 of segment point 2: - X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating REGULAR_CUTCELL_EDGES_BC for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating REGULAR_CUTCELL_EDGES_BC for mesh :',NM,' ..' +ENDIF - ! IF (.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - ! Segment length: - SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) +ALLOCATE(CELL_ADDED(0:IBP1,0:JBP1,0:KBP1)); CELL_ADDED = .FALSE. - ! Unit vector along segment: - STANI(IAXIS:JAXIS) = 1._EB/SLEN * (/ (X2_2-X2_1), (X3_2-X3_1) /) +! Now count added edge number for mesh N_EDGES_DIM_CC(2,NM), and added non zero cell indexes for mesh - ! S coordinate along segment: - DX3_1 = X3_2 - X3RAY - DX3_2 = X3RAY- X3_1 - XI1 = DX3_1 / (X3_2-X3_1) - XI2 = DX3_2 / (X3_2-X3_1) - DV(IAXIS:JAXIS) = (/ (XI1-1._EB)*X2_1+XI2*X2_2 , DX3_2 /) - SBOD = DV(IAXIS)*STANI(IAXIS)+DV(JAXIS)*STANI(JAXIS) - ! ELSE - ! ! Segment length: - ! X2_21Q = (REAL(X2_2,QB)-REAL(X2_1,QB)) - ! X3_21Q = (REAL(X3_2,QB)-REAL(X3_1,QB)) - ! SLENQ = SQRT( X2_21Q**2._QB + X3_21Q**2._QB ) - ! - ! ! Unit vector along segment: - ! STANIQ(IAXIS:JAXIS) = 1._QB/SLENQ * (/ X2_21Q, X3_21Q /) - ! - ! ! S coordinate along segment: - ! DX3_1Q = REAL(X3_2,QB) - REAL(X3RAY,QB) - ! DX3_2Q = REAL(X3RAY,QB)- REAL(X3_1,QB) - ! XI1Q = DX3_1Q / X3_21Q - ! XI2Q = DX3_2Q / X3_21Q - ! DVQ(IAXIS:JAXIS) = (/ (XI1Q-1._QB)*REAL(X2_1,QB)+XI2Q*REAL(X2_2,QB) , DX3_2Q /) - ! SBOD = REAL(DVQ(IAXIS)*STANIQ(IAXIS)+DVQ(JAXIS)*STANIQ(JAXIS),EB) - ! ENDIF +ECOUNT = 0; CC_ECOUNT_RC=0; CC_ECOUNT_CE = 0; CCOUNT = 0; - ! If crossing is already defined, cycle: - DO IBCR=1,BODINT_PLANE%NBCROSS(ISEG) - IF ( ABS(SBOD-BODINT_PLANE%SVAR(IBCR,ISEG)) < GEOMEPS ) EXIT +! X axis edges: +DO K=0,KBAR + DO J=0,JBAR + IX_LOOP_1 : DO I=1,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in Y. + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO JADD=0,1 ! Faces aligned in Z. + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,IAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IX_LOOP_1 + DO_EDGE_FLG = .TRUE. + ELSE + CYCLE IX_LOOP_1 + ENDIF + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO KADD=0,1 + DO JADD=0,1 + IF(CELL_INDEX(I ,J+JADD,K+KADD)==0 .AND. .NOT.CELL_ADDED(I ,J+JADD,K+KADD)) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I ,J+JADD,K+KADD) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=IAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-2) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) + CASE( 2) + IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) + CASE(-3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 + ENDIF + ENDDO + ENDIF + IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE + ELSE + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE + ENDIF + ENDIF + ENDDO IX_LOOP_1 ENDDO - IF (IBCR NBCROSS_SVAR) THEN - ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB - SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) - CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) - ENDIF - BODINT_PLANE%SVAR(NBCROSS,ISEG) = 1._EB/GEOMEPS - DO IBCR=1,NBCROSS - IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEG) ) EXIT +! Y axis edges: +DO K=0,KBAR + DO J=1,JBAR + IY_LOOP_1 : DO I=0,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in X. + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Z. + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,JAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IY_LOOP_1 + DO_EDGE_FLG = .TRUE. + ELSE + CYCLE IY_LOOP_1 + ENDIF + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO KADD=0,1 + DO IADD=0,1 + IF(CELL_INDEX(I+IADD,J ,K+KADD)==0 .AND. .NOT.CELL_ADDED(I+IADD,J ,K+KADD)) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I+IADD,J ,K+KADD) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=JAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) + CASE( 1) + IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) + CASE(-3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 + ENDIF + ENDDO + ENDIF + IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE + ELSE + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE + ENDIF + ENDIF + ENDDO IY_LOOP_1 ENDDO +ENDDO - ! Here copy from the back (updated nbcross) to the ibcr location: - DO IDUM = NBCROSS,IBCR+1,-1 - BODINT_PLANE%SVAR(IDUM,ISEG) = BODINT_PLANE%SVAR(IDUM-1,ISEG) +! Z axis edges: +DO K=1,KBAR + DO J=0,JBAR + IZ_LOOP_1 : DO I=0,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO JADD=0,1 ! Faces aligned in X. + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Y. + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,KAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IZ_LOOP_1 + DO_EDGE_FLG = .TRUE. + ELSE + CYCLE IZ_LOOP_1 + ENDIF + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO JADD=0,1 + DO IADD=0,1 + IF(CELL_INDEX(I+IADD,J+JADD,K )==0 .AND. .NOT.CELL_ADDED(I+IADD,J+JADD,K )) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I+IADD,J+JADD,K ) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=KAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) + CASE( 1) + IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) + CASE(-2) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) + CASE( 2) + IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 + ENDIF + ENDDO + ENDIF + IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 ! RCEDGE + ELSE + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 ! CUT_EDGE + ENDIF + ENDIF + ENDDO IZ_LOOP_1 ENDDO - BODINT_PLANE%SVAR(IBCR,ISEG) = SBOD - BODINT_PLANE%NBCROSS(ISEG) = NBCROSS - ENDDO -T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW -RETURN -END SUBROUTINE GET_BODX2_INTERSECTIONS - -! ----------------------- GET_BODX3_INTERSECTIONS ------------------------------- - -SUBROUTINE GET_BODX3_INTERSECTIONS(X2AXIS,X3AXIS,X2LO,X2HI) - -INTEGER, INTENT(IN) :: X2AXIS,X3AXIS,X2LO,X2HI - -! Local Variables: -REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN, SBOD -REAL(EB) :: STANI(IAXIS:JAXIS), DV(IAXIS:JAXIS), MINX, MAXX, XI1, XI2, DX2_1, DX2_2 -INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IBCR, IDUM, JSTR, JEND, JJ, NBCROSS_SVAR -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX -LOGICAL :: ISCONT -REAL(EB) :: TNOW - -! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX2_1Q,DX2_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) - -TNOW=CURRENT_TIME() - -DO ISEG=1,BODINT_PLANE%NSEGS - - IF (BODINT_PLANE%X3ALIGNED(ISEG)) CYCLE ! This segment is not aligned with x3. +IF (CC_ECOUNT_RC+CC_ECOUNT_CE==0) THEN + DEALLOCATE(CELL_ADDED) + RETURN +ENDIF - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) +! Allocate CC_RCEDGE: +M%CC_NRCEDGE = CC_ECOUNT_RC +ALLOCATE(M%CC_RCEDGE(1:CC_ECOUNT_RC)) - ! x2_x3 of segment point 1: - X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) - ! x2_x3 of segment point 2: - X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) +! Reallocate EDGE variables - ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - ! Segment length: - SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) - ! Unit vector along segment: - STANI(IAXIS:JAXIS) = (/ (X2_2-X2_1), (X3_2-X3_1) /)*SLEN**(-1._EB) - ! ELSE - ! ! Segment length: - ! X2_21Q = (REAL(X2_2,QB)-REAL(X2_1,QB)) - ! X3_21Q = (REAL(X3_2,QB)-REAL(X3_1,QB)) - ! SLENQ = SQRT( X2_21Q**2._QB + X3_21Q**2._QB ) - ! ! Unit vector along segment: - ! STANIQ(IAXIS:JAXIS) = 1._QB/SLENQ * (/ X2_21Q, X3_21Q /) - ! ENDIF +N1 = UBOUND(MESHES(NM)%EDGE,DIM=1) +N2 = EDGE_COUNT(NM) + ECOUNT +IF (ECOUNT>0 .AND. N2>N1) CALL REALLOCATE_EDGE(NM,N1,N2) - MINX = MIN(X2_1,X2_2) - MAXX = MAX(X2_1,X2_2) - IF(X2NOC==0) THEN - ! Optimized for UG: - JSTR = MAX(X2LO, CEILING(( MINX-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO))+X2LO) - JEND = MIN(X2HI, FLOOR(( MAXX+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO))+X2LO) - ELSE - IF ((MINX-GEOMEPS-X2FACE(X2LO)) < 0._EB) THEN - JSTR=X2LO - ELSEIF((MINX-GEOMEPS-X2FACE(X2HI)) >= 0._EB) THEN - JSTR=X2HI+1 - ELSE - DO JJ=X2LO,X2HI - IF((MINX-GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. (MINX-GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN - JSTR = JJ+1 - EXIT - ENDIF - ENDDO - ENDIF - IF ((MAXX+GEOMEPS-X2FACE(X2LO)) < 0._EB) THEN - JEND=X2LO-1 - ELSEIF((MAXX+GEOMEPS-X2FACE(X2HI)) >= 0._EB) THEN - JEND=X2HI - ELSE - DO JJ=X2LO,X2HI - IF((MAXX+GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. (MAXX+GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN - JEND = JJ - EXIT - ENDIF - ENDDO - ENDIF - ENDIF +! Reallocate CELL variables - DO JJ=JSTR,JEND +CELL_COUNT_OLD = CELL_COUNT(NM) +IF (CCOUNT > 0) CALL REALLOCATE_CELL(NM,CELL_COUNT(NM),CELL_COUNT(NM)+CCOUNT) +CCOUNT = CELL_COUNT_OLD - ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - ! S coordinate along segment: - DX2_1 = X2_2 - X2FACE(JJ) - DX2_2 = X2FACE(JJ) - X2_1 - XI1 = DX2_1 / (X2_2-X2_1) - XI2 = DX2_2 / (X2_2-X2_1) - DV(IAXIS:JAXIS) = (/ DX2_2, (XI1-1._EB)*X3_1+XI2*X3_2 /) - SBOD = DV(IAXIS)*STANI(IAXIS)+DV(JAXIS)*STANI(JAXIS) - ! ELSE - ! ! S coordinate along segment: - ! DX2_1Q = REAL(X2_2,QB) - REAL(X2FACE(JJ),QB) - ! DX2_2Q = REAL(X2FACE(JJ),QB)- REAL(X2_1,QB) - ! XI1Q = DX2_1Q / X2_21Q - ! XI2Q = DX2_2Q / X2_21Q - ! DVQ(IAXIS:JAXIS) = (/ DX2_2Q, (XI1Q-1._QB)*REAL(X3_1,QB)+XI2Q*REAL(X3_2,QB) /) - ! SBOD = REAL(DVQ(IAXIS)*STANIQ(IAXIS)+DVQ(JAXIS)*STANIQ(JAXIS),EB) - ! ENDIF +! Finally repeat search process and assign edge and cell values to cut-cell region entities: +CC_ECOUNT_RC=0; CC_ECOUNT_CE = 0 - ! If crossing is already defined, cycle: - NBCROSS = BODINT_PLANE%NBCROSS(ISEG) - ISCONT = .FALSE. - DO IBCR=1,NBCROSS - IF ( ABS(SBOD-BODINT_PLANE%SVAR(IBCR,ISEG)) < GEOMEPS ) THEN - ISCONT = .TRUE. - EXIT +! X axis edges: +DO K=0,KBAR + DO J=0,JBAR + IX_LOOP_2 : DO I=1,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in Y. + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO JADD=0,1 ! Faces aligned in Z. + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,IAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IX_LOOP_2 + DO_EDGE_FLG = .TRUE. + ELSE + CYCLE IX_LOOP_2 ENDIF - ENDDO - IF (ISCONT) CYCLE - - ! Add crossing to BODINT_PLANE, insertion sort: - NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + 1 - ! Test-reallocate BODINT_PLANE%SVAR - NBCROSS_SVAR = SIZE(BODINT_PLANE%SVAR,DIM=1) - IF (NBCROSS > NBCROSS_SVAR) THEN - ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB - SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) - CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) - ENDIF - BODINT_PLANE%SVAR(NBCROSS,ISEG) = 1._EB/GEOMEPS - DO IBCR=1,NBCROSS - IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEG) ) EXIT - ENDDO - - ! Here copy from the back (updated nbcross) to the ibcr location: - DO IDUM = NBCROSS,IBCR+1,-1 - BODINT_PLANE%SVAR(IDUM,ISEG) = BODINT_PLANE%SVAR(IDUM-1,ISEG) - ENDDO - BODINT_PLANE%SVAR(IBCR,ISEG) = SBOD - BODINT_PLANE%NBCROSS(ISEG) = NBCROSS - + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO KADD=0,1 + DO JADD=0,1 + IF(M%CELL_INDEX(I ,J+JADD,K+KADD)==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + M%CELL_INDEX(I ,J+JADD,K+KADD) = CCOUNT + M%CELL(CCOUNT)%I = I + M%CELL(CCOUNT)%J = J+JADD + M%CELL(CCOUNT)%K = K+KADD + ENDIF + ENDDO + ENDDO + ICMM = M%CELL_INDEX(I ,J ,K ) + ICPM = M%CELL_INDEX(I ,J+1,K ) + ICPP = M%CELL_INDEX(I ,J+1,K+1) + ICMP = M%CELL_INDEX(I ,J ,K+1) + M%EDGE(IE)%I = I + M%EDGE(IE)%J = J + M%EDGE(IE)%K = K + M%EDGE(IE)%AXIS = IAXIS + M%EDGE(IE)%CELL_INDEX_MM = ICMM + M%EDGE(IE)%CELL_INDEX_PM = ICPM + M%EDGE(IE)%CELL_INDEX_MP = ICMP + M%EDGE(IE)%CELL_INDEX_PP = ICPP + M%CELL(ICPP)%EDGE_INDEX(1) = IE + M%CELL(ICMP)%EDGE_INDEX(2) = IE + M%CELL(ICPM)%EDGE_INDEX(3) = IE + M%CELL(ICMM)%EDGE_INDEX(4) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=IAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-2) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) + CASE( 2) + IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) + CASE(-3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 + ENDIF + ENDDO + ENDIF + IF (M%ECVAR(I,J,K,CC_EGSC,IAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 + ! Add info to CC_RCEDGE: + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS + M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE + ! Note RCEDGE number in ECVAR: + M%ECVAR(I,J,K,CC_IDCE,IAXIS) = CC_ECOUNT_RC + ELSE ! CUT_EDGE: + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 + IEC = M%ECVAR(I,J,K,CC_IDCE,IAXIS) + M%CUT_EDGE(IEC)%IE = IE + ENDIF + ENDIF + ENDDO IX_LOOP_2 ENDDO - ENDDO -T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW - -RETURN -END SUBROUTINE GET_BODX3_INTERSECTIONS - -! ----------------------- GET_CARTFACE_CUTEDGES --------------------------------- - -SUBROUTINE GET_CARTFACE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS, & - XIAXIS,XJAXIS,XKAXIS,NM , & - X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL, & - X3LO_CELL,X3HI_CELL,INDX1,X1PLN) - -INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS,NM, & - X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL, & - X3LO_CELL,X3HI_CELL,INDX1(MAX_DIM) -REAL(EB), INTENT(IN) :: X1PLN - -! Local Variables: -REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN -REAL(EB) :: STANI(IAXIS:JAXIS), SNORI(IAXIS:JAXIS), X2RAY, X3RAY -INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IEDGE, JJ, KK, JJ2, KK2, IPFACE, NPFACE, INOD1, INOD2 -LOGICAL :: ADD2FACES, INRAY, CONDAX -INTEGER :: INDSEG(1:CC_MAX_WSTRIANG_SEG+2), NTRISEG, CETYPE, JJ2VEC(LOW_IND:HIGH_IND), KK2VEC(LOW_IND:HIGH_IND) -REAL(EB) :: SVAR1, SVAR2, SVAR12, XPOS, XY(IAXIS:JAXIS) -INTEGER :: INDXI(IAXIS:KAXIS), INDIF, INDJF, INDKF, CEI, NVERT, NEDGE, DIRAXIS, IDG -REAL(EB) :: XYZV1(IAXIS:KAXIS), XYZV1LC(IAXIS:KAXIS) -REAL(EB) :: XYZV2(IAXIS:KAXIS), XYZV2LC(IAXIS:KAXIS) -REAL(EB) :: TNOW -INTEGER :: INIT_CUT_EDGES,IVERT,IADD,JADD,KADD -LOGICAL :: FOUND_SEG, IS_SOLID - -TNOW=CURRENT_TIME() - -INIT_CUT_EDGES = MESHES(NM)%N_CUTEDGE_MESH+1 - -! Segment by segment define the INBOUNDARY MESHES(NM)%CUT_EDGEs between crossings -! and individualize the Cartesian face they belong to. -! NCUTEDGEOLD = MESHES(NM)%N_CUTEDGE_MESH + 1 -SEGS_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS - - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) - - IF (MAX(XYZ1(X2AXIS),XYZ2(X2AXIS)) < X2FACE(X2LO)-GEOMEPS) CYCLE - IF (MIN(XYZ1(X2AXIS),XYZ2(X2AXIS)) > X2FACE(X2HI)+GEOMEPS) CYCLE - IF (MAX(XYZ1(X3AXIS),XYZ2(X3AXIS)) < X3FACE(X3LO)-GEOMEPS) CYCLE - IF (MIN(XYZ1(X3AXIS),XYZ2(X3AXIS)) > X3FACE(X3HI)+GEOMEPS) CYCLE - - NBCROSS = BODINT_PLANE%NBCROSS(ISEG) ! Cross points include Node1, Node2 - - ! x2_x3 of segment point 1: - X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) - ! x2_x3 of segment point 2: - X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) - - ! Normal out: - SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) - STANI(IAXIS:JAXIS) = (/ (X2_2-X2_1), (X3_2-X3_1) /)*SLEN**(-1._EB) - SNORI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) - - INDSEG(1:CC_MAX_WSTRIANG_SEG+2) = BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2, ISEG) - NTRISEG = INDSEG(1) - - ADD2FACES = .FALSE. - ! Type to be assigned to cut edges: - CETYPE = 2*(BODINT_PLANE%SEGTYPE(LOW_IND,ISEG)+1) - BODINT_PLANE%SEGTYPE(HIGH_IND,ISEG) - IF ( CETYPE == CC_GG ) ADD2FACES = .TRUE. - - INRAY = .FALSE. - - ! Different cases: - ! First check if segment geomepsilon aligned with x2: - IF (BODINT_PLANE%X2ALIGNED(ISEG)) THEN - - ! Test if node1 of segment is in geomepsilon vicinity of an x2 ray - DO KK=X3LO,X3HI - ! x3 location of ray along x2, on the x2-x3 plane: - X3RAY = X3FACE(KK) - IF ( ABS(X3RAY-X3_1) < GEOMEPS ) THEN - INRAY = .TRUE. - EXIT - ENDIF - ENDDO - - IF (INRAY) THEN ! Segment in x2 ray defined by x3 face index kk. - - ! 1. INB cut-edges on top of an x2 gridline, assign to cut-face - ! defined by normal out. - KK2VEC(LOW_IND:HIGH_IND) = 0 - IF (ADD2FACES) THEN - NPFACE = 2 - KK2VEC(LOW_IND) = KK + 1 - KK2VEC(HIGH_IND)= KK +! Y axis edges: +DO K=0,KBAR + DO J=1,JBAR + IY_LOOP_2 : DO I=0,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in X. + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Z. + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,JAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IY_LOOP_2 + DO_EDGE_FLG = .TRUE. ELSE - NPFACE = 1 - if ( SNORI(JAXIS) > 0._EB ) THEN ! add 1 to index kk (i.e. lower face index) - KK2VEC(LOW_IND) = KK + 1 - ELSE - KK2VEC(LOW_IND)= KK - ENDIF + CYCLE IY_LOOP_2 ENDIF + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO KADD=0,1 + DO IADD=0,1 + IF(M%CELL_INDEX(I+IADD,J ,K+KADD)==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + M%CELL_INDEX(I+IADD,J ,K+KADD) = CCOUNT + M%CELL(CCOUNT)%I = I+IADD + M%CELL(CCOUNT)%J = J + M%CELL(CCOUNT)%K = K+KADD + ENDIF + ENDDO + ENDDO + ICMM = M%CELL_INDEX(I ,J ,K ) + ICMP = M%CELL_INDEX(I+1,J ,K ) + ICPP = M%CELL_INDEX(I+1,J ,K+1) + ICPM = M%CELL_INDEX(I ,J ,K+1) + M%EDGE(IE)%I = I + M%EDGE(IE)%J = J + M%EDGE(IE)%K = K + M%EDGE(IE)%AXIS = JAXIS + M%EDGE(IE)%CELL_INDEX_MM = ICMM + M%EDGE(IE)%CELL_INDEX_PM = ICPM + M%EDGE(IE)%CELL_INDEX_MP = ICMP + M%EDGE(IE)%CELL_INDEX_PP = ICPP + M%CELL(ICPP)%EDGE_INDEX(5) = IE + M%CELL(ICPM)%EDGE_INDEX(6) = IE + M%CELL(ICMP)%EDGE_INDEX(7) = IE + M%CELL(ICMM)%EDGE_INDEX(8) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=JAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) + CASE( 1) + IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) + CASE(-3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = M%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 + ENDIF + ENDDO + ENDIF + IF (M%ECVAR(I,J,K,CC_EGSC,JAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 + ! Add info to CC_RCEDGE: + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS + M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE + ! Note RCEDGE number in ECVAR: + M%ECVAR(I,J,K,CC_IDCE,JAXIS) = CC_ECOUNT_RC + ELSE ! CUT_EDGE: + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 + IEC = M%ECVAR(I,J,K,CC_IDCE,JAXIS) + M%CUT_EDGE(IEC)%IE = IE + ENDIF + ENDIF + ENDDO IY_LOOP_2 + ENDDO +ENDDO - DO IPFACE=1,NPFACE - - KK2 = KK2VEC(IPFACE) - - ! Figure out which cut faces the inboundary cut-edges of - ! this segment belong to: - ! We have nbcross-1 INBOUNDARY CUT_EDGEs to generate. - DO IEDGE=1,NBCROSS-1 - - ! Location along Segment: - SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) - SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) - ! Location of midpoint of cut-edge: - SVAR12 = 0.5_EB * (SVAR1+SVAR2) - ! Define Cartesian segment this cut-edge belongs: - XPOS = X2_1 + SVAR12*STANI(IAXIS) - IF (X2NOC==0) THEN - JJ2 = FLOOR((XPOS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - ! Discard cut-edges on faces laying on x2hi. - IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO JJ2=X2LO_CELL,X2HI_CELL - ! Check if XPOS is within this segment JJ2: - IF((XPOS-X2FACE(JJ2-1)) >= 0._EB .AND. (X2FACE(JJ2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT +! Z axis edges: +DO K=1,KBAR + DO J=0,JBAR + IZ_LOOP_2 : DO I=0,IBAR + DO_EDGE_FLG = .FALSE. + IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN + N_CC = 0; N_RG = 0 + DO JADD=0,1 ! Faces aligned in X. + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Y. + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (M%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)==CC_GASPHASE) N_RG=N_RG+1 + ENDDO + DO_EDGE_FLG = N_CC>0 .AND. N_RG>0 + ELSEIF(M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_CUTCFE) THEN ! CUT_EDGE + IEC=M%ECVAR(I,J,K,CC_IDCE,KAXIS) + ! Assumes ECVAR IDCE indexed cut-edge is of type gas with NEDGE>0. + IF(M%CUT_EDGE(IEC)%STATUS/=CC_GASPHASE .OR. M%CUT_EDGE(IEC)%NEDGE<1) CYCLE IZ_LOOP_2 + DO_EDGE_FLG = .TRUE. + ELSE + CYCLE IZ_LOOP_2 + ENDIF + IF (DO_EDGE_FLG) THEN ! At least one neighboring cut-face, and one regular face. + IE = M%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO JADD=0,1 + DO IADD=0,1 + IF(M%CELL_INDEX(I+IADD,J+JADD,K )==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + M%CELL_INDEX(I+IADD,J+JADD,K ) = CCOUNT + M%CELL(CCOUNT)%I = I+IADD + M%CELL(CCOUNT)%J = J+JADD + M%CELL(CCOUNT)%K = K ENDIF ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF - - IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE - - ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. - ! If segment is inside the solid region mark cells surrounding face - ! to be treated in special manner (only if they happen to be type CUTCFE), - ! then drop segment. - XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) - CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) - IF (IS_SOLID) CYCLE - - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS) - INDJF=INDXI(XJAXIS) - INDKF=INDXI(XKAXIS) + ENDDO + ICMM = M%CELL_INDEX(I ,J ,K ) + ICPM = M%CELL_INDEX(I+1,J ,K ) + ICPP = M%CELL_INDEX(I+1,J+1,K ) + ICMP = M%CELL_INDEX(I ,J+1,K ) + M%EDGE(IE)%I = I + M%EDGE(IE)%J = J + M%EDGE(IE)%K = K + M%EDGE(IE)%AXIS = KAXIS + M%EDGE(IE)%CELL_INDEX_MM = ICMM + M%EDGE(IE)%CELL_INDEX_PM = ICPM + M%EDGE(IE)%CELL_INDEX_MP = ICMP + M%EDGE(IE)%CELL_INDEX_PP = ICPP + M%CELL(ICPP)%EDGE_INDEX( 9) = IE + M%CELL(ICMP)%EDGE_INDEX(10) = IE + M%CELL(ICPM)%EDGE_INDEX(11) = IE + M%CELL(ICMM)%EDGE_INDEX(12) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=KAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) + CASE( 1) + IW1 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) + CASE(-2) + IW1 = M%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = M%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) + CASE( 2) + IW1 = M%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = M%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) + END SELECT + IF (IW1>0) THEN + IF(M%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(M%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + M%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 + ENDIF + ENDDO + ENDIF + IF (M%ECVAR(I,J,K,CC_EGSC,KAXIS) == CC_GASPHASE) THEN + CC_ECOUNT_RC = CC_ECOUNT_RC + 1 + ! Add info to CC_RCEDGE: + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(IAXIS) = M%EDGE(IE)%I + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(JAXIS) = M%EDGE(IE)%J + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS) = M%EDGE(IE)%K + M%CC_RCEDGE(CC_ECOUNT_RC)%IJK(KAXIS+1) = M%EDGE(IE)%AXIS + M%CC_RCEDGE(CC_ECOUNT_RC)%IE = IE + ! Note RCEDGE number in ECVAR: + M%ECVAR(I,J,K,CC_IDCE,KAXIS) = CC_ECOUNT_RC + ELSE ! CUT_EDGE: + CC_ECOUNT_CE = CC_ECOUNT_CE + 1 + IEC = M%ECVAR(I,J,K,CC_IDCE,KAXIS) + M%CUT_EDGE(IEC)%IE = IE + ENDIF + ENDIF + ENDDO IZ_LOOP_2 + ENDDO +ENDDO - ! Now the face is, FCVAR (x1axis): - IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already - ! an entry in CUT_EDGE. - CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) - ELSE ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF - ENDIF +DEALLOCATE(CELL_ADDED) - ! Add vertices, non repeated vertex entries at this point. - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - ! Define vertices for this segment: - ! xv1 yv1 zv1 - XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) - XYZV1(IAXIS) = XYZV1LC(XIAXIS) - XYZV1(JAXIS) = XYZV1LC(XJAXIS) - XYZV1(KAXIS) = XYZV1LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) - ! xv2 yv2 zv2 - XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) - XYZV2(IAXIS) = XYZV2LC(XIAXIS) - XYZV2(JAXIS) = XYZV2LC(XJAXIS) - XYZV2(KAXIS) = XYZV2LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + WRITE(LU_SETCC,'(A,F8.3,A,7I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Reg-CC edges for BC : ',CC_ECOUNT_RC,M%CC_NRCEDGE,CC_ECOUNT_CE, & + EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A,7I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Reg-CC edges for BC : ',CC_ECOUNT_RC,M%CC_NRCEDGE,CC_ECOUNT_CE, & + EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' + ENDIF + ! DO I=1,M%CC_NRCEDGE + ! WRITE(LU_ERR,*) 'IE,I,J,K,IAXIS=',M%CC_RCEDGE(I)%IE,M%CC_RCEDGE(I)%IJK(IAXIS:KAXIS+1) + ! ENDDO +ENDIF - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) - IF ( NPFACE == 1 ) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ELSE - DIRAXIS = X2AXIS - CONDAX = (XYZV2(DIRAXIS)-XYZV1(DIRAXIS)) > 0 - IF ( KK2 == KK ) THEN - IF (CONDAX) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ELSE - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) - ENDIF - ELSE - IF (CONDAX) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) - ELSE - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ENDIF - ENDIF - ENDIF - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & - BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = 0 !Edges in face boundary counted once. - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE +IF (DEBUG_SET_CUTCELLS) THEN + ! Write segment information for the mesh if it belongs to the process: + ! Write out: + WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_rcsegs_mesh_',NM,'.dat' + LU_DB_SETCC = GET_FILE_NUMBER() + OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') + !WRITE(LU_ERR,*) TRIM(MSEGS_FILE),M%CC_NRCEDGE,CC_ECOUNT_RC + DO ECOUNT=1,M%CC_NRCEDGE + I=M%CC_RCEDGE(ECOUNT)%IJK(IAXIS) + J=M%CC_RCEDGE(ECOUNT)%IJK(JAXIS) + K=M%CC_RCEDGE(ECOUNT)%IJK(KAXIS) + IE=M%CC_RCEDGE(ECOUNT)%IJK(KAXIS+1) + SELECT CASE(IE) + CASE(IAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DX(I),XC(I),Y(J),Z(K) + CASE(JAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DY(J),X(I),YC(J),Z(K) + CASE(KAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DZ(K),X(I),Y(J),ZC(K) + END SELECT + ENDDO + CLOSE(LU_DB_SETCC) +ENDIF - ! Test for Repeated edge -> If so note FACERT: - DO IDG=1,NEDGE - IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & - ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN - FACERT(JJ2,KK2) =.TRUE. - EXIT - ENDIF - ENDDO +RETURN +END SUBROUTINE GET_REGULAR_CUT_EDGES_BC - ENDDO - ENDDO - CYCLE ! Skips rest of iseg loop, for this ISEG. - ENDIF - ! Second check if segment geomepsilon aligned with x3: - ELSEIF (BODINT_PLANE%X3ALIGNED(ISEG)) THEN +! --------------------- GET_SOLID_CUTCELL_EDGES_BC -------------------------------- - ! Test if node1 of segment is in geomepsilon vicinity of an x3 ray - DO JJ=X2LO,X2HI - ! x2 location of ray along x3, on the x2-x3 plane: - X2RAY = X2FACE(JJ) - IF ( ABS(X2RAY-X2_1) < GEOMEPS ) THEN - INRAY = .TRUE. - EXIT - ENDIF - ENDDO +SUBROUTINE GET_SOLID_CUTCELL_EDGES_BC(NM) - IF (INRAY) THEN ! Segment in x3 ray defined by x2 face index JJ +! This routine adds to FDS EDGE array +! the sum of regular edges that are boundary at least a neighboring CC_CUTCFE face and +! one CC_SOLID face. - ! 1. INB cut-edges on top of an x3 gridline, assign to cut-face - ! defined by normal out. - JJ2VEC(LOW_IND:HIGH_IND) = 0 - IF (ADD2FACES) THEN - NPFACE = 2 - JJ2VEC(LOW_IND) = JJ + 1 - JJ2VEC(HIGH_IND) = JJ - ELSE - NPFACE = 1 - IF ( SNORI(IAXIS) > 0._EB ) THEN ! add 1 to index jj (i.e. lower face index) - JJ2VEC(LOW_IND) = JJ + 1 - ELSE - JJ2VEC(LOW_IND) = JJ - ENDIF - ENDIF +USE MEMORY_FUNCTIONS, ONLY: REALLOCATE_CELL,REALLOCATE_EDGE +INTEGER, INTENT(IN) :: NM - DO IPFACE=1,NPFACE +! Local variables: +INTEGER :: ECOUNT, CC_ECOUNT, CCOUNT, I, J, K, N_CC, N_RG, IE, IADD, JADD, KADD, CELL_COUNT_OLD, N1, N2 +LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: CELL_ADDED +INTEGER :: ICMM,ICPM,ICPP,ICMP +INTEGER :: IDUM,IOR,IW1,IW2 +INTEGER, PARAMETER :: IAXIS_WALL_INDS(1:4) = (/ -3, -2, 2, 3 /) +INTEGER, PARAMETER :: JAXIS_WALL_INDS(1:4) = (/ -3, -1, 1, 3 /) +INTEGER, PARAMETER :: KAXIS_WALL_INDS(1:4) = (/ -2, -1, 1, 2 /) +INTEGER :: IN1,IN2,JN1,JN2,KN1,KN2 +LOGICAL :: INI,INJ,INK,INMESH - JJ2 = JJ2VEC(IPFACE) +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +CHARACTER(100) :: MSEGS_FILE - ! Figure out which cut faces the inboundary cut-edges of - ! this segment belong to: - ! We have NBCROSS-1 INBOUNDARY CUT_EDGEs to generate. - DO IEDGE=1,NBCROSS-1 +IF (DEBUG_SET_CUTCELLS) THEN + ! Write out: + WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_ibsegs_mesh_',NM,'.dat' + LU_DB_SETCC = GET_FILE_NUMBER() + OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') + CLOSE(LU_DB_SETCC) +ENDIF - ! Location along Segment: - SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) - SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) - ! Location of midpoint of cut-edge: - SVAR12 = 0.5_EB * (SVAR1+SVAR2) +CALL POINT_TO_MESH(NM) - ! Define Cartesian segment this cut-edge belongs: - XPOS = X3_1 + SVAR12*STANI(JAXIS) - IF (X3NOC==0) THEN - KK2 = FLOOR((XPOS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - ! Discard cut-edges on faces laying on x3hi. - IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO KK2=X3LO_CELL,X3HI_CELL - ! Check if XPOS is within this segment KK2: - IF((XPOS-X3FACE(KK2-1)) >= 0._EB .AND. (X3FACE(KK2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF +! Return if nothing to do for the mesh: +IF(MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH == 0) RETURN - IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating SOLID_CUTCELL_EDGES_BC for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating SOLID_CUTCELL_EDGES_BC for mesh :',NM,' ..' +ENDIF - ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. - ! If segment is inside the solid region mark cells surrounding face - ! to be treated in special manner (only if they happen to be type CUTCFE), - ! then drop segment. - XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) - CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) - IF (IS_SOLID) CYCLE +ALLOCATE(CELL_ADDED(0:IBP1,0:JBP1,0:KBP1)); CELL_ADDED = .FALSE. - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS) - INDJF=INDXI(XJAXIS) - INDKF=INDXI(XKAXIS) +! Now count added edge number for EDGE and CELL - ! Now the face is, FCVAR (x1axis): - IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already - ! an entry in CUT_EDGE. - CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) - ELSE ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF - ENDIF +ECOUNT = 0; CC_ECOUNT=0 +CCOUNT = 0; - ! Add vertices, non repeated vertex entries at this point. - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - ! Define vertices for this segment: - ! xv1 yv1 zv1 - XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) - XYZV1(IAXIS) = XYZV1LC(XIAXIS) - XYZV1(JAXIS) = XYZV1LC(XJAXIS) - XYZV1(KAXIS) = XYZV1LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) - ! xv2 yv2 zv2 - XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) - XYZV2(IAXIS) = XYZV2LC(XIAXIS) - XYZV2(JAXIS) = XYZV2LC(XJAXIS) - XYZV2(KAXIS) = XYZV2LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) +! X axis edges: +DO K=0,KBAR + INK = .FALSE. + KN1 = K; KN2 = K+1 + IF (K==0) THEN; KN1=K+1 + ELSEIF(K==KBAR) THEN; KN2=K + ELSE + INK = .TRUE. + ENDIF + DO J=0,JBAR + INJ = .FALSE. + JN1 = J; JN2 = J+1 + IF (J==0) THEN; JN1=J+1 + ELSEIF(J==JBAR) THEN; JN2=J + ELSE + INJ = .TRUE. + ENDIF + INMESH = INK .AND. INJ + IX_LOOP_1 : DO I=1,IBAR + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,IAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in Y. + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + DO JADD=0,1 ! Faces aligned in Z. + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(I,JN1:JN2,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. + ENDIF + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-face, and a solid face. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO KADD=0,1 + DO JADD=0,1 + IF(CELL_INDEX(I ,J+JADD,K+KADD)==0 .AND. .NOT.CELL_ADDED(I ,J+JADD,K+KADD)) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I ,J+JADD,K+KADD) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=IAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K ))%WALL_INDEX( 2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K+1))%WALL_INDEX( 2) + CASE( 2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K ))%WALL_INDEX(-2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K+1))%WALL_INDEX(-2) + CASE(-3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K ))%WALL_INDEX( 3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I,J ,K+1))%WALL_INDEX(-3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I,J+1,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_1 + ENDIF + ENDDO + ENDIF + CC_ECOUNT = CC_ECOUNT + 1 + ENDIF + ENDDO IX_LOOP_1 + ENDDO +ENDDO - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) - IF ( NPFACE == 1 ) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ELSE - DIRAXIS = X3AXIS - CONDAX = (XYZV2(DIRAXIS)-XYZV1(DIRAXIS)) > 0 - IF ( JJ2 == JJ ) THEN - IF (CONDAX) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) - ELSE - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ENDIF - ELSE - IF (CONDAX) THEN - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - ELSE - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) - ENDIF +! Y axis edges: +DO K=0,KBAR + INK = .FALSE. + KN1 = K; KN2 = K+1 + IF (K==0) THEN; KN1=K+1 + ELSEIF(K==KBAR) THEN; KN2=K + ELSE + INK = .TRUE. + ENDIF + DO J=1,JBAR + IY_LOOP_1 : DO I=0,IBAR + INI = .FALSE. + IN1 = I; IN2 = I+1 + IF (I==0) THEN; IN1=I+1 + ELSEIF(I==IBAR) THEN; IN2=I + ELSE + INI = .TRUE. + ENDIF + INMESH = INK .AND. INI + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,JAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in X. + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Z. + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,J,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. + ENDIF + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO KADD=0,1 + DO IADD=0,1 + IF(CELL_INDEX(I+IADD,J ,K+KADD)==0 .AND. .NOT.CELL_ADDED(I+IADD,J ,K+KADD)) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I+IADD,J ,K+KADD) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=JAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) + CASE( 1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) + CASE(-3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_1 ENDIF - ENDIF - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & - BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = 0 !Edges in face boundary counted once. - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE - - ! Test for Repeated edge -> If so note FACERT - DO IDG=1,NEDGE - IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & - ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN - FACERT(JJ2,KK2) =.TRUE. - EXIT - ENDIF ENDDO - - ENDDO - ENDDO - CYCLE ! Skips rest of iseg loop, for this ISEG. - ENDIF - - ENDIF - - ! 3. Regular case: INB cut-edge with centroid inside a - ! Cartesian face, assign to corresponding FCVAR CC_IDCE variable. - ! This is the most common case, INBOUNDARY edges defined inside x1 faces. - ! We have NBCROSS-1 INBOUNDARY CUT_EDGEs to generate. - DO IEDGE=1,NBCROSS-1 - - ! Location along Segment: - SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) - SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) - ! Location of midpoint of cut-edge: - SVAR12 = 0.5_EB * (SVAR1+SVAR2) - - ! Define Cartesian face this cut-edge belongs: - XPOS = X2_1 + SVAR12*STANI(IAXIS) - IF (X2NOC==0) THEN - JJ2 = FLOOR((XPOS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL - IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO JJ2=X2LO_CELL,X2HI_CELL - ! Check if XPOS is within this segment JJ2: - IF((XPOS-X2FACE(JJ2-1)) >= 0._EB .AND. (X2FACE(JJ2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF - XPOS = X3_1 + SVAR12*STANI(JAXIS) - IF(X3NOC==0) THEN - KK2 = FLOOR((XPOS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL - IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO KK2=X3LO_CELL,X3HI_CELL - ! Check if XPOS is within this segment KK2: - IF((XPOS-X3FACE(KK2-1)) >= 0._EB .AND. (X3FACE(KK2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF - - ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. - ! If segment is inside the solid region mark cells surrounding face - ! to be treated in special manner (only if they happen to be type CUTCFE), - ! then drop segment. - XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) - CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) - IF (IS_SOLID) CYCLE - - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS) - INDJF=INDXI(XJAXIS) - INDKF=INDXI(XKAXIS) - - ! Now the face is, FCVAR (x1axis): - IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already - ! an entry in CUT_EDGE. - CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) - ELSE ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF - ENDIF - - ! Add vertices, non repeated vertex entries at this point. - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - - ! Define vertices for this segment: - ! xv1 yv1 zv1 - XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) - XYZV1(IAXIS) = XYZV1LC(XIAXIS) - XYZV1(JAXIS) = XYZV1LC(XJAXIS) - XYZV1(KAXIS) = XYZV1LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) - ! xv2 yv2 zv2 - XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) - XYZV2(IAXIS) = XYZV2LC(XIAXIS) - XYZV2(JAXIS) = XYZV2LC(XJAXIS) - XYZV2(KAXIS) = XYZV2LC(XKAXIS) - CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) - - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & - BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = & - -SUM(BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG))/2 - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE - - ! Test for Repeated edge -> If so note FACERT - DO IDG=1,NEDGE - IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & - ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN - FACERT(JJ2,KK2) =.TRUE. - EXIT - ENDIF - ENDDO - + CC_ECOUNT = CC_ECOUNT + 1 + ENDIF + ENDDO IY_LOOP_1 ENDDO +ENDDO -ENDDO SEGS_LOOP - -! Here TAG any CUT_EDGE vertices in VERT_LIST that lay in cartesian cell vertices: -DO CEI=INIT_CUT_EDGES,MESHES(NM)%N_CUTEDGE_MESH - INDIF = MESHES(NM)%CUT_EDGE(CEI)%IJK(IAXIS) - INDJF = MESHES(NM)%CUT_EDGE(CEI)%IJK(JAXIS) - INDKF = MESHES(NM)%CUT_EDGE(CEI)%IJK(KAXIS) - SELECT CASE(X1AXIS) ! INBOUNDCF edge, X1AXIS axis normal to face that edge is assigned to. - CASE(IAXIS) - IVERT_DOI : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB - ! INDJF-1:INDJF,INDKF-1:INDKF - DO KADD=-1,0 - DO JADD=-1,0 - IF(ABS(YFACE(INDJF+JADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,IVERT))>GEOMEPS) CYCLE - IF(ABS(ZFACE(INDKF+KADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,IVERT))>GEOMEPS) CYCLE - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF, INDJF+JADD, INDKF+KADD /) - CYCLE IVERT_DOI - ENDDO - ENDDO - ENDDO IVERT_DOI - CASE(JAXIS) - IVERT_DOJ : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB - ! INDIF-1:INDIF,INDKF-1:INDKF - DO KADD=-1,0 - DO IADD=-1,0 - IF(ABS(XFACE(INDIF+IADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,IVERT))>GEOMEPS) CYCLE - IF(ABS(ZFACE(INDKF+KADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,IVERT))>GEOMEPS) CYCLE - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF+IADD, INDJF, INDKF+KADD /) - CYCLE IVERT_DOJ - ENDDO +! Z axis edges: +DO K=1,KBAR + DO J=0,JBAR + INJ = .FALSE. + JN1 = J; JN2 = J+1 + IF (J==0) THEN; JN1=J+1 + ELSEIF(J==JBAR) THEN; JN2=J + ELSE + INJ = .TRUE. + ENDIF + IZ_LOOP_1 : DO I=0,IBAR + INI = .FALSE. + IN1 = I; IN2 = I+1 + IF (I==0) THEN; IN1=I+1 + ELSEIF(I==IBAR) THEN; IN2=I + ELSE + INI = .TRUE. + ENDIF + INMESH = INJ .AND. INI + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,KAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO JADD=0,1 ! Faces aligned in X. + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 ENDDO - ENDDO IVERT_DOJ - CASE(KAXIS) - IVERT_DOK : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB - ! INDJF-1:INDJF,INDKF-1:INDKF - DO IADD=-1,0 - DO JADD=-1,0 - IF(ABS(YFACE(INDJF+JADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,IVERT))>GEOMEPS) CYCLE - IF(ABS(XFACE(INDIF+IADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,IVERT))>GEOMEPS) CYCLE - MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF+IADD, INDJF+JADD, INDKF /) - CYCLE IVERT_DOK - ENDDO + DO IADD=0,1 ! Faces aligned in Y. + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 ENDDO - ENDDO IVERT_DOK - END SELECT -ENDDO - -! Note cells in CELLRT due to FCERT intersections in GET_BODINT_PLANE: -DO KK2=X3LO_CELL,X3HI_CELL - DO JJ2=X2LO_CELL,X2HI_CELL - IF(.NOT.FACERT(JJ2,KK2)) CYCLE - ! Low cell indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS); INDJF=INDXI(XJAXIS); INDKF=INDXI(XKAXIS) - CELLRT(INDIF,INDJF,INDKF) =.TRUE. - - ! High cell indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS)+1, JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS); INDJF=INDXI(XJAXIS); INDKF=INDXI(XKAXIS) - CELLRT(INDIF,INDJF,INDKF) =.TRUE. - ENDDO + ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,JN1:JN2,K,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. + ENDIF + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. + ! If IE not counted yet increase ECOUNT: + IF (IE==0) THEN + ECOUNT = ECOUNT + 1 + ! See if we need to add to CCOUNT any neighboring cells: + DO JADD=0,1 + DO IADD=0,1 + IF(CELL_INDEX(I+IADD,J+JADD,K )==0 .AND. .NOT.CELL_ADDED(I+IADD,J+JADD,K )) THEN + CCOUNT = CCOUNT + 1 + CELL_ADDED(I+IADD,J+JADD,K ) = .TRUE. + ENDIF + ENDDO + ENDDO + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=KAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) + CASE( 1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) + CASE(-2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) + CASE( 2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_1 + ENDIF + ENDDO + ENDIF + CC_ECOUNT = CC_ECOUNT + 1 + ENDIF + ENDDO IZ_LOOP_1 + ENDDO ENDDO -T_CC_USED(GET_CARTFACE_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTEDGES_TIME_INDEX) + CURRENT_TIME() - TNOW - -RETURN -END SUBROUTINE GET_CARTFACE_CUTEDGES - -! -------------------------- GET_IS_SOLID_PT ------------------------------------ - -SUBROUTINE GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) - -TYPE(BODINT_PLANE_TYPE), INTENT(IN) :: BODINT_PLANE2 -INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS -REAL(EB), INTENT(IN) :: XY(IAXIS:JAXIS),NVEC(IAXIS:JAXIS),X1PLN -LOGICAL, INTENT(OUT):: IS_SOLID +IF (CC_ECOUNT==0) THEN + DEALLOCATE(CELL_ADDED) + RETURN +ENDIF -! Local Variables -REAL(EB):: XYZ1(IAXIS:KAXIS), XYZ2(IAXIS:KAXIS), SCEN, XRAY -REAL(EB):: X2_1, X2_2, X3_1, X3_2, X2MIN, X2MAX, X3MIN, X3MAX, DOT1, DOT2, DELBIN, MODTI, SVARI, AVAL -REAL(EB):: STANI(IAXIS:JAXIS), NOMLI(IAXIS:JAXIS), DV12(IAXIS:JAXIS) -INTEGER :: SEG(NOD1:NOD2), ISSEG(LOW_IND:HIGH_IND), ISEG, IISEG, XAXIS, IBIN, ICR, SCRSI, ILO_BIN, IHI_BIN,& - ICRSI(LOW_IND:HIGH_IND+1), GAM(LOW_IND:HIGH_IND) -LOGICAL :: OUTRAY, IS_GASPHASE +! Allocate CC_IBEDGE: +MESHES(NM)%CC_NIBEDGE = CC_ECOUNT +ALLOCATE(MESHES(NM)%CC_IBEDGE(1:CC_ECOUNT)) -! Initialize crossings arrays: -CC_N_CRS = 0 -CC_SVAR_CRS(:) = 1._EB/GEOMEPS -CC_IS_CRS(:) = CC_UNDEFINED -CC_IS_CRS2(:,:)= CC_UNDEFINED -CC_SEG_TAN(:,:)= 0._EB -CC_SEG_CRS(:) = 0 -CC_BDNUM_CRS(:)= 0 -CC_BDNUM_CRS_AUX(:)= 0 +! Reallocate EDGE variables -! Define crossings: -IF(ABS(NVEC(IAXIS)) > ABS(NVEC(JAXIS))) THEN ! Do X2 ray - SCEN = XY(IAXIS); XRAY=XY(JAXIS); XAXIS=X3AXIS +N1 = UBOUND(MESHES(NM)%EDGE,DIM=1) +N2 = EDGE_COUNT(NM) + ECOUNT +IF (ECOUNT>0 .AND. N2>N1) CALL REALLOCATE_EDGE(NM,N1,N2) - DELBIN = BODINT_PLANE2%TBAXIS(XAXIS)%DELBIN - AVAL = (XRAY-GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN - ILO_BIN= MAX(1, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) - AVAL = (XRAY+GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN - IHI_BIN= MIN(BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) - DO IBIN=ILO_BIN,IHI_BIN - IF (XRAY < BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE - IF (XRAY > BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE - DO IISEG=1,BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%NTL - ISEG = BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) - SEG(NOD1:NOD2) = BODINT_PLANE2%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD2)) +! Reallocate derived type array CELL which contains SOLID, OBST_INDEX, WALL_INDEX, EDGE_INDEX, EXTERIOR, I, J, K: - ! x2,x3 coordinates of segment: - X2_1 = XYZ1(X2AXIS) - X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. - X2_2 = XYZ2(X2AXIS) - X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. +CELL_COUNT_OLD = CELL_COUNT(NM) +IF (CCOUNT > 0) CALL REALLOCATE_CELL(NM,CELL_COUNT(NM),CELL_COUNT(NM)+CCOUNT) +CCOUNT = CELL_COUNT_OLD - ! First Test if the whole segment is on one side of the Ray: - ! Test segment crosses the ray, or is in geomepsilon proximity - ! of it: - X3MIN = MIN(X3_1,X3_2); X3MAX = MAX(X3_1,X3_2); - OUTRAY=(((XRAY-X3MAX) > GEOMEPS) .OR. ((X3MIN-XRAY) > GEOMEPS)) +! Finally repeat search process and assign edge and cell values to cut-cell region entities: - IF (OUTRAY) CYCLE - DOT1 = X3_1-XRAY; DOT2 = X3_2-XRAY - IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB - IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB +CC_ECOUNT=0 - ! Segment tangent unit vector. - DV12(IAXIS:JAXIS) = XYZ2( (/ X2AXIS, X3AXIS /) ) - XYZ1( (/ X2AXIS, X3AXIS /) ) - MODTI = SQRT( DV12(IAXIS)**2._EB + DV12(JAXIS)**2._EB ) - STANI(IAXIS:JAXIS) = DV12(IAXIS:JAXIS) * MODTI**(-1._EB) - NOMLI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) - ISSEG(LOW_IND:HIGH_IND) = BODINT_PLANE2%SEGTYPE(LOW_IND:HIGH_IND,ISEG) +! X axis edges: +DO K=0,KBAR + INK = .FALSE. + KN1 = K; KN2 = K+1 + IF (K==0) THEN; KN1=K+1 + ELSEIF(K==KBAR) THEN; KN2=K + ELSE + INK = .TRUE. + ENDIF + DO J=0,JBAR + INJ = .FALSE. + JN1 = J; JN2 = J+1 + IF (J==0) THEN; JN1=J+1 + ELSEIF(J==JBAR) THEN; JN2=J + ELSE + INJ = .TRUE. + ENDIF + INMESH = INK .AND. INJ + IX_LOOP_2 : DO I=1,IBAR + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,IAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in Y. + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + DO JADD=0,1 ! Faces aligned in Z. + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(I,JN1:JN2,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. + ENDIF + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells, NEW edge to force. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(4) ! EDGE in Xaxis in upper Y,Z boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO KADD=0,1 + DO JADD=0,1 + IF(MESHES(NM)%CELL_INDEX(I ,J+JADD,K+KADD)==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + MESHES(NM)%CELL_INDEX(I ,J+JADD,K+KADD) = CCOUNT + MESHES(NM)%CELL(CCOUNT)%I = I + MESHES(NM)%CELL(CCOUNT)%J = J+JADD + MESHES(NM)%CELL(CCOUNT)%K = K+KADD + ENDIF + ENDDO + ENDDO + ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) + ICPM = MESHES(NM)%CELL_INDEX(I ,J+1,K ) + ICPP = MESHES(NM)%CELL_INDEX(I ,J+1,K+1) + ICMP = MESHES(NM)%CELL_INDEX(I ,J ,K+1) + MESHES(NM)%EDGE(IE)%I = I + MESHES(NM)%EDGE(IE)%J = J + MESHES(NM)%EDGE(IE)%K = K + MESHES(NM)%EDGE(IE)%AXIS = IAXIS + MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM + MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM + MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP + MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP + MESHES(NM)%CELL(ICPP)%EDGE_INDEX(1) = IE + MESHES(NM)%CELL(ICMP)%EDGE_INDEX(2) = IE + MESHES(NM)%CELL(ICPM)%EDGE_INDEX(3) = IE + MESHES(NM)%CELL(ICMM)%EDGE_INDEX(4) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=IAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 2) + CASE( 2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-2) + CASE(-3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IX_LOOP_2 + ENDIF + ENDDO + ENDIF - ! For x2, in local x2-x3 coords e2=(1,0): - GAM(LOW_IND) = (1 + NINT(SIGN(1._EB,NOMLI(IAXIS)))) / 2 ! (1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; - GAM(HIGH_IND)= (1 - NINT(SIGN(1._EB,NOMLI(IAXIS)))) / 2 ! (1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; + CC_ECOUNT = CC_ECOUNT + 1 + + ! Add info to CC_IBEDGE: + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE - ! Test if whole segment is in ray, if so add segment nodes as crossings: - IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN - ! Count both points as crossings: - ! Point 1: - SVARI = MIN(X2_1,X2_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - DO ICR=2,BODINT_PLANE2%NBCROSS(ISEG)-1 - SVARI = X2_1 + BODINT_PLANE2%SVAR(ICR,ISEG)*STANI(IAXIS) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - ENDDO - ! Point 2: - SVARI = max(X2_1,X2_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - ! Now nodes individually: - IF ( ABS(DOT1) == 0._EB ) THEN - ! Point 1: - SVARI = X2_1 - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE ENDIF - IF ( ABS(DOT2) == 0._EB ) THEN - ! Point 2: - SVARI = X2_2 - ! LOW and HIGH_IND media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE + ENDDO IX_LOOP_2 + ENDDO +ENDDO + +! Y axis edges: +DO K=0,KBAR + INK = .FALSE. + KN1 = K; KN2 = K+1 + IF (K==0) THEN; KN1=K+1 + ELSEIF(K==KBAR) THEN; KN2=K + ELSE + INK = .TRUE. + ENDIF + DO J=1,JBAR + IY_LOOP_2 : DO I=0,IBAR + INI = .FALSE. + IN1 = I; IN2 = I+1 + IF (I==0) THEN; IN1=I+1 + ELSEIF(I==IBAR) THEN; IN2=I + ELSE + INI = .TRUE. ENDIF - ! Finally regular case: - ! Points 1 on one side of ray, point 2 on the other: - IF ( DOT1*DOT2 < 0._EB ) THEN - ! Intersection Point along segment: - ! DS = (XRAY-X3_1) / (X3_2-X3_1) - ! SVARI = X2_1 + DS*(X2_2-X2_1) - SVARI = X2_1 + (XRAY-X3_1) * (X2_2-X2_1) / (X3_2-X3_1) - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE + INMESH = INK .AND. INI + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,JAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO KADD=0,1 ! Faces aligned in X. + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J ,K+KADD,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Z. + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,KAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + ! This Test is to drop IBEDGES related to only CC_SOLID cells in the mesh, no need to have them on this mesh: + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,J,KN1:KN2,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. ENDIF - WRITE(LU_ERR,*) 'Error GET_IS_SOLID_PT NVEC(IAXIS): Missed segment=',ISEG - ENDDO - ENDDO - -ELSE ! Do X3 ray - SCEN=XY(JAXIS); XRAY=XY(IAXIS); XAXIS=X2AXIS; + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(8) ! EDGE in Yaxis in upper X,Z boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO KADD=0,1 + DO IADD=0,1 + IF(MESHES(NM)%CELL_INDEX(I+IADD,J ,K+KADD)==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + MESHES(NM)%CELL_INDEX(I+IADD,J ,K+KADD) = CCOUNT + MESHES(NM)%CELL(CCOUNT)%I = I+IADD + MESHES(NM)%CELL(CCOUNT)%J = J + MESHES(NM)%CELL(CCOUNT)%K = K+KADD + ENDIF + ENDDO + ENDDO + ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) + ICMP = MESHES(NM)%CELL_INDEX(I+1,J ,K ) + ICPP = MESHES(NM)%CELL_INDEX(I+1,J ,K+1) + ICPM = MESHES(NM)%CELL_INDEX(I ,J ,K+1) + MESHES(NM)%EDGE(IE)%I = I + MESHES(NM)%EDGE(IE)%J = J + MESHES(NM)%EDGE(IE)%K = K + MESHES(NM)%EDGE(IE)%AXIS = JAXIS + MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM + MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM + MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP + MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP + MESHES(NM)%CELL(ICPP)%EDGE_INDEX(5) = IE + MESHES(NM)%CELL(ICPM)%EDGE_INDEX(6) = IE + MESHES(NM)%CELL(ICMP)%EDGE_INDEX(7) = IE + MESHES(NM)%CELL(ICMM)%EDGE_INDEX(8) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=JAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX( 1) + CASE( 1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-1) + CASE(-3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 3) + CASE( 3) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K+1))%WALL_INDEX(-3) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K+1))%WALL_INDEX(-3) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IY_LOOP_2 + ENDIF + ENDDO + ENDIF - DELBIN = BODINT_PLANE2%TBAXIS(XAXIS)%DELBIN - AVAL = (XRAY-GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN - ILO_BIN= MAX(1, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) - AVAL = (XRAY+GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN - IHI_BIN= MIN(BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS, & - CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) - DO IBIN=ILO_BIN,IHI_BIN - IF (XRAY < BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE - IF (XRAY > BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE - DO IISEG=1,BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%NTL - ISEG = BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) - SEG(NOD1:NOD2) = BODINT_PLANE2%SEGS(NOD1:NOD2,ISEG) - XYZ1(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD2)) + CC_ECOUNT = CC_ECOUNT + 1 - ! x2,x3 coordinates of segment: - X2_1 = XYZ1(X2AXIS) - X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. - X2_2 = XYZ2(X2AXIS) - X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. + ! Add info to CC_IBEDGE: + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE - ! First Test if the whole segment is on one side of the Ray: - ! Test segment crosses the ray, or is in geomepsilon proximity - ! of it: - X2MIN = MIN(X2_1,X2_2) - X2MAX = MAX(X2_1,X2_2) - OUTRAY=(((XRAY-X2MAX) > GEOMEPS) .OR. ((X2MIN-XRAY) > GEOMEPS)) + ENDIF + ENDDO IY_LOOP_2 + ENDDO +ENDDO - IF (OUTRAY) CYCLE - DOT1 = X2_1-XRAY; DOT2 = X2_2-XRAY - IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB - IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB +! Z axis edges: +DO K=1,KBAR + DO J=0,JBAR + INJ = .FALSE. + JN1 = J; JN2 = J+1 + IF (J==0) THEN; JN1=J+1 + ELSEIF(J==JBAR) THEN; JN2=J + ELSE + INJ = .TRUE. + ENDIF + IZ_LOOP_2 : DO I=0,IBAR + INI = .FALSE. + IN1 = I; IN2 = I+1 + IF (I==0) THEN; IN1=I+1 + ELSEIF(I==IBAR) THEN; IN2=I + ELSE + INI = .TRUE. + ENDIF + INMESH = INJ .AND. INI + IF (MESHES(NM)%ECVAR(I,J,K,CC_EGSC,KAXIS) /= CC_SOLID) CYCLE + N_CC = 0; N_RG = 0 + DO JADD=0,1 ! Faces aligned in X. + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I ,J+JADD,K ,CC_FGSC,IAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + DO IADD=0,1 ! Faces aligned in Y. + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_CUTCFE) N_CC=N_CC+1 + IF (MESHES(NM)%FCVAR(I+IADD,J ,K ,CC_FGSC,JAXIS)== CC_SOLID) N_RG=N_RG+1 + ENDDO + IF (.NOT.INMESH) THEN + IF(ALL(MESHES(NM)%CCVAR(IN1:IN2,JN1:JN2,K,CC_CGSC)==CC_SOLID)) N_CC=0 ! Drop IBEDGE. + ENDIF + IF (N_CC>0 .AND. N_RG>0) THEN ! At least one neighboring cut-cell, and two regular cells. + IE = MESHES(NM)%CELL(CELL_INDEX(I,J,K))%EDGE_INDEX(12) ! EDGE in Zaxis in upper X,Y boundaries of cell I,J,K. + IF (IE==0) THEN + EDGE_COUNT(NM) = EDGE_COUNT(NM) + 1 ; IE = EDGE_COUNT(NM) + DO JADD=0,1 + DO IADD=0,1 + IF(MESHES(NM)%CELL_INDEX(I+IADD,J+JADD,K )==0) THEN ! Add cell to CELL_INDEX + CCOUNT = CCOUNT + 1 + MESHES(NM)%CELL_INDEX(I+IADD,J+JADD,K ) = CCOUNT + MESHES(NM)%CELL(CCOUNT)%I = I+IADD + MESHES(NM)%CELL(CCOUNT)%J = J+JADD + MESHES(NM)%CELL(CCOUNT)%K = K + ENDIF + ENDDO + ENDDO + ICMM = MESHES(NM)%CELL_INDEX(I ,J ,K ) + ICPM = MESHES(NM)%CELL_INDEX(I+1,J ,K ) + ICPP = MESHES(NM)%CELL_INDEX(I+1,J+1,K ) + ICMP = MESHES(NM)%CELL_INDEX(I ,J+1,K ) + MESHES(NM)%EDGE(IE)%I = I + MESHES(NM)%EDGE(IE)%J = J + MESHES(NM)%EDGE(IE)%K = K + MESHES(NM)%EDGE(IE)%AXIS = KAXIS + MESHES(NM)%EDGE(IE)%CELL_INDEX_MM = ICMM + MESHES(NM)%EDGE(IE)%CELL_INDEX_PM = ICPM + MESHES(NM)%EDGE(IE)%CELL_INDEX_MP = ICMP + MESHES(NM)%EDGE(IE)%CELL_INDEX_PP = ICPP + MESHES(NM)%CELL(ICPP)%EDGE_INDEX( 9) = IE + MESHES(NM)%CELL(ICMP)%EDGE_INDEX(10) = IE + MESHES(NM)%CELL(ICPM)%EDGE_INDEX(11) = IE + MESHES(NM)%CELL(ICMM)%EDGE_INDEX(12) = IE + ELSE + ! Search if WALL cells related to the edge are of type SOLID_BOUNDARY or MIRROR_BOUNDARY. + ! If so discard edge for CCIBM stress recalculation, no need to do it. + DO IDUM=1,4 + IOR=KAXIS_WALL_INDS(IDUM) + SELECT CASE(IOR) + CASE(-1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX( 1) + CASE( 1) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX(-1) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-1) + CASE(-2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J ,K ))%WALL_INDEX( 2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J ,K ))%WALL_INDEX( 2) + CASE( 2) + IW1 = MESHES(NM)%CELL(CELL_INDEX(I ,J+1,K ))%WALL_INDEX(-2) + IW2 = MESHES(NM)%CELL(CELL_INDEX(I+1,J+1,K ))%WALL_INDEX(-2) + END SELECT + IF (IW1>0) THEN + IF(MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW1)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 + ENDIF + IF (IW2>0) THEN + IF(MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. & + MESHES(NM)%WALL(IW2)%BOUNDARY_TYPE==MIRROR_BOUNDARY) CYCLE IZ_LOOP_2 + ENDIF + ENDDO + ENDIF - ! Segment tangent unit vector. - DV12(IAXIS:JAXIS) = XYZ2( (/ X2AXIS, X3AXIS /) ) - XYZ1( (/ X2AXIS, X3AXIS /) ) - MODTI = SQRT( DV12(IAXIS)**2._EB + DV12(JAXIS)**2._EB ) - STANI(IAXIS:JAXIS) = DV12(IAXIS:JAXIS) * MODTI**(-1._EB) - NOMLI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) - ISSEG(LOW_IND:HIGH_IND) = BODINT_PLANE2%SEGTYPE(LOW_IND:HIGH_IND,ISEG) + CC_ECOUNT = CC_ECOUNT + 1 - ! For x3, in local x2-x3 coords e2=(0,1): - GAM(LOW_IND) = (1 + NINT(SIGN(1._EB,NOMLI(JAXIS)))) / 2 ! (1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; - GAM(HIGH_IND)= (1 - NINT(SIGN(1._EB,NOMLI(JAXIS)))) / 2 ! (1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; + ! Add info to CC_IBEDGE: + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(IAXIS) = MESHES(NM)%EDGE(IE)%I + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(JAXIS) = MESHES(NM)%EDGE(IE)%J + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS) = MESHES(NM)%EDGE(IE)%K + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IJK(KAXIS+1) = MESHES(NM)%EDGE(IE)%AXIS + MESHES(NM)%CC_IBEDGE(CC_ECOUNT)%IE = IE - ! Test if whole segment is in ray, if so add segment nodes as crossings: - IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN - ! Count both points as crossings: - ! Point 1: - SVARI = MIN(X3_1,X3_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - DO ICR=2,BODINT_PLANE2%NBCROSS(ISEG)-1 - SVARI = X3_1 + BODINT_PLANE2%SVAR(ICR,ISEG)*STANI(JAXIS) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - ENDDO - ! Point 2: - SVARI = MAX(X3_1,X3_2) - ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - ! Now nodes individually: - IF ( ABS(DOT1) == 0._EB ) THEN - ! Point 1: - SVARI = X3_1 - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - IF ( ABS(DOT2) == 0._EB ) THEN - ! Point 2: - SVARI = X3_2 - ! LOW and HIGH_IND media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE - ENDIF - ! Finally regular case: - ! Points 1 on one side of ray, point 2 on the other: - IF ( DOT1*DOT2 < 0._EB ) THEN - ! Intersection Point along segment: - ! DS = (XRAY-X2_1) / (X2_2-X2_1) - ! SVARI = X3_1 + DS*(X3_2-X3_1) - SVARI = X3_1 + (XRAY-X2_1) * (X3_2-X3_1) / (X2_2-X2_1) - ! LOW and HIGH media type, using the segment definition: - ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) - ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) - ICRSI(HIGH_IND+1)=CC_UNDEFINED - SCRSI = ISEG - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - CYCLE ENDIF - WRITE(LU_ERR,*) 'Error GET_IS_SOLID_PT NVEC(JAXIS): Missed segment=',ISEG - ENDDO - ENDDO + ENDDO IZ_LOOP_2 + ENDDO +ENDDO -ENDIF +DEALLOCATE(CELL_ADDED) -! Do we have any intersections? -IF ( CC_N_CRS == 0 ) THEN - IS_SOLID =.FALSE. - RETURN +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + WRITE(LU_SETCC,'(A,F8.3,A,6I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Sol-CC edges for BC : ', & + CC_ECOUNT,MESHES(NM)%CC_NIBEDGE,EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A,6I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Sol-CC edges for BC : ', & + CC_ECOUNT,MESHES(NM)%CC_NIBEDGE,EDGE_COUNT(NM),CELL_COUNT_OLD,CELL_COUNT(NM),CCOUNT,'. ' + ENDIF + ! DO I=1,MESHES(NM)%CC_NRCEDGE + ! WRITE(LU_ERR,*) 'IE,I,J,K,IAXIS=',MESHES(NM)%CC_RCEDGE(I)%IE,MESHES(NM)%CC_RCEDGE(I)%IJK(IAXIS:KAXIS+1) + ! ENDDO ENDIF -CALL COLLAPSE_CROSSINGS(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XRAY,X1PLN,2) -CALL GET_IS_GASPHASE(SCEN,IS_GASPHASE) -IS_SOLID = .NOT.IS_GASPHASE +IF (DEBUG_SET_CUTCELLS) THEN + ! Write segment information for the mesh if it belongs to the process: + ! Write out: + WRITE(MSEGS_FILE,'(A,A,I4.4,A)') TRIM(CHID),'_ibsegs_mesh_',NM,'.dat' + LU_DB_SETCC = GET_FILE_NUMBER() + OPEN(LU_DB_SETCC,FILE=TRIM(MSEGS_FILE),STATUS='UNKNOWN') + !WRITE(LU_ERR,*) TRIM(MSEGS_FILE),MESHES(NM)%CC_NRCEDGE,CC_ECOUNT + DO ECOUNT=1,MESHES(NM)%CC_NIBEDGE + I=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(IAXIS) + J=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(JAXIS) + K=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(KAXIS) + IE=MESHES(NM)%CC_IBEDGE(ECOUNT)%IJK(KAXIS+1) + SELECT CASE(IE) + CASE(IAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DX(I),XC(I),Y(J),Z(K) + CASE(JAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DY(J),X(I),YC(J),Z(K) + CASE(KAXIS) + WRITE(LU_DB_SETCC,'(4I8,4F16.8)') I,J,K,IE,DZ(K),X(I),Y(J),ZC(K) + END SELECT + ENDDO + CLOSE(LU_DB_SETCC) +ENDIF RETURN -END SUBROUTINE GET_IS_SOLID_PT +END SUBROUTINE GET_SOLID_CUTCELL_EDGES_BC +! ------------------------ CUT_CELL_MOVE ----------------------------------- -! ------------------------- INSERT_FACE_VERT ------------------------------------ +SUBROUTINE CUT_CELL_MOVE(CUT_CELL_FROM,CUT_CELL_TO) -SUBROUTINE INSERT_FACE_VERT(XYZV,NM,CEI,NVERT,INOD) +TYPE(CC_CUTCELL_TYPE), INTENT(INOUT) :: CUT_CELL_FROM,CUT_CELL_TO -REAL(EB), INTENT(IN) :: XYZV(MAX_DIM) -INTEGER, INTENT(IN) :: NM,CEI -INTEGER, INTENT(INOUT):: NVERT -INTEGER, INTENT(OUT) :: INOD +CUT_CELL_TO%NCELL = CUT_CELL_FROM%NCELL +CUT_CELL_TO%NFACE_CELL = CUT_CELL_FROM%NFACE_CELL +CUT_CELL_TO%NFACE_DROPPED = CUT_CELL_FROM%NFACE_DROPPED +CUT_CELL_TO%IJK = CUT_CELL_FROM%IJK -! Local Variables: -! INTEGER :: JNOD, JNOD2, PIVOT(LOW_IND:HIGH_IND) -! REAL(EB) :: DV(MAX_DIM) -! IF (NVERT < LINSEARCH_LIMIT) THEN -! ! Linear Search: -! DO JNOD=1,NVERT -! DV(IAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(IAXIS) -! IF( DV(IAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF( ABS(DV(IAXIS)) <= GEOMEPS) THEN -! DV(JAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(JAXIS) -! IF ( DV(JAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF ( ABS(DV(JAXIS)) <= GEOMEPS ) THEN -! DV(KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(KAXIS) -! IF ( DV(KAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF ( ABS(DV(KAXIS)) <= GEOMEPS ) THEN -! INOD = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) -! RETURN ! XYZV is in XYZVERT(IAXIS:KAXIS,NOD_PERM(JNOD)) -! ENDIF -! ENDIF -! ENDIF -! ENDDO -! ELSE -! ! Binary Search: -! PIVOT(LOW_IND) = 0 -! PIVOT(HIGH_IND)= NVERT + 1 -! DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) -! JNOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 -! DV(IAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(IAXIS) -! IF( DV(IAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(IAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(IAXIS)) < GEOMEPS -! DV(JAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(JAXIS) -! IF ( DV(JAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(JAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(JAXIS)) < GEOMEPS -! DV(KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(KAXIS) -! IF ( DV(KAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(KAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(KAXIS)) < GEOMEPS -! INOD = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) -! RETURN -! ENDIF -! ENDIF -! ENDIF -! ENDDO -! JNOD=PIVOT(HIGH_IND) -! ENDIF -! ! Insert add NOD_PERM permutation array, O(NP) operation: -! INOD = NVERT + 1 -! NVERT = INOD -! CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT) -! DO JNOD2=NVERT,JNOD+1,-1 -! MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD2) = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD2-1) -! ENDDO -! MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) = INOD -! MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%CCELEM ,TO=CUT_CELL_TO%CCELEM) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%FACE_LIST ,TO=CUT_CELL_TO%FACE_LIST) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%FACE_LIST_DROPPED,TO=CUT_CELL_TO%FACE_LIST_DROPPED) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%IJK_LINK ,TO=CUT_CELL_TO%IJK_LINK) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%LINK_LEV ,TO=CUT_CELL_TO%LINK_LEV) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%VOLUME ,TO=CUT_CELL_TO%VOLUME) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%XYZCEN ,TO=CUT_CELL_TO%XYZCEN) + +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHO ,TO=CUT_CELL_TO%RHO) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHOS ,TO=CUT_CELL_TO%RHOS) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RSUM ,TO=CUT_CELL_TO%RSUM) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%TMP ,TO=CUT_CELL_TO%TMP) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%D ,TO=CUT_CELL_TO%D) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DS ,TO=CUT_CELL_TO%DS) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DVOL ,TO=CUT_CELL_TO%DVOL) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DVOL_PR ,TO=CUT_CELL_TO%DVOL_PR) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%Q ,TO=CUT_CELL_TO%Q) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%QR ,TO=CUT_CELL_TO%QR) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%D_SOURCE ,TO=CUT_CELL_TO%D_SOURCE) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%CHI_R ,TO=CUT_CELL_TO%CHI_R) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%MIX_TIME ,TO=CUT_CELL_TO%MIX_TIME) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%Q_REAC ,TO=CUT_CELL_TO%Q_REAC) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%REAC_SOURCE_TERM ,TO=CUT_CELL_TO%REAC_SOURCE_TERM) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%ZZ ,TO=CUT_CELL_TO%ZZ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%ZZS ,TO=CUT_CELL_TO%ZZS) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%M_DOT_PPP ,TO=CUT_CELL_TO%M_DOT_PPP) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%UNKH ,TO=CUT_CELL_TO%UNKH) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%UNKZ ,TO=CUT_CELL_TO%UNKZ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%KRES ,TO=CUT_CELL_TO%KRES) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%H ,TO=CUT_CELL_TO%H) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%HS ,TO=CUT_CELL_TO%HS) + +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RTRM ,TO=CUT_CELL_TO%RTRM) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%R_H_G ,TO=CUT_CELL_TO%R_H_G) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHO_0 ,TO=CUT_CELL_TO%RHO_0) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%WVEL ,TO=CUT_CELL_TO%WVEL) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DDDTVOL ,TO=CUT_CELL_TO%DDDTVOL) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DELTA_RHO ,TO=CUT_CELL_TO%DELTA_RHO) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DELTA_RHO_ZZ ,TO=CUT_CELL_TO%DELTA_RHO_ZZ) -DO INOD=1,NVERT - IF( ABS(XYZV(IAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,INOD)) > GEOMEPS ) CYCLE - IF( ABS(XYZV(JAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,INOD)) > GEOMEPS ) CYCLE - IF( ABS(XYZV(KAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,INOD)) > GEOMEPS ) CYCLE - RETURN -ENDDO -NVERT = NVERT + 1 -INOD = NVERT -CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT) -MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_IJK ,TO=CUT_CELL_TO%INT_IJK ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_COEF ,TO=CUT_CELL_TO%INT_COEF ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_XYZBF ,TO=CUT_CELL_TO%INT_XYZBF ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NOUT ,TO=CUT_CELL_TO%INT_NOUT ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_INBFC ,TO=CUT_CELL_TO%INT_INBFC ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NPE ,TO=CUT_CELL_TO%INT_NPE ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_XN ,TO=CUT_CELL_TO%INT_XN ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_CN ,TO=CUT_CELL_TO%INT_CN ) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_CCVARS ,TO=CUT_CELL_TO%INT_CCVARS) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NOMIND ,TO=CUT_CELL_TO%INT_NOMIND) + +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DEL_RHO_D_DEL_Z_VOL ,TO=CUT_CELL_TO%DEL_RHO_D_DEL_Z_VOL) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%U_DOT_DEL_RHO_Z_VOL ,TO=CUT_CELL_TO%U_DOT_DEL_RHO_Z_VOL) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%NOADVANCE ,TO=CUT_CELL_TO%NOADVANCE) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%NOMICC ,TO=CUT_CELL_TO%NOMICC) RETURN -END SUBROUTINE INSERT_FACE_VERT +END SUBROUTINE CUT_CELL_MOVE -! ------------------------- INSERT_FACE_VERT_LOC(XYZ,NVERT,INOD1,XYZVERT) +! ------------------------ CUT_CELL_BOUNDING_BOX ------------------------------------ -SUBROUTINE INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,NVERT,INOD,XYZVERT) +SUBROUTINE CUT_CELL_BOUNDING_BOX(NM,ICC,JCC,XYZCELL,MINMAX_XYZ_JCC) -INTEGER, INTENT(IN) :: MAXVERTS -REAL(EB), INTENT(IN) :: XYZV(MAX_DIM) -REAL(EB), INTENT(INOUT), DIMENSION(IAXIS:KAXIS,1:MAXVERTS) :: XYZVERT ! Locations of vertices. -INTEGER, INTENT(INOUT):: NVERT -INTEGER, INTENT(OUT) :: INOD +! Computes bounding box for cut-cell (ICC,JCC) in mesh NM. +! Underlaying cartesian cell bounds XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND) has to be provided. -REAL(EB), PARAMETER :: VERT_PROX_FCT = 1000._EB +INTEGER, INTENT(IN) :: NM,ICC,JCC +REAL(EB),INTENT(IN) :: XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND) +REAL(EB),INTENT(OUT):: MINMAX_XYZ_JCC(IAXIS:KAXIS,LOW_IND:HIGH_IND) ! Local Variables: -! INTEGER :: JNOD, JNOD2, PIVOT(LOW_IND:HIGH_IND) -! REAL(EB) :: DV(MAX_DIM) -! INTEGER, SAVE :: NOD_PERM(CC_MAXVERTS_CELL) -! IF (NVERT < LINSEARCH_LIMIT) THEN -! ! Linear Search: -! DO JNOD=1,NVERT -! DV(IAXIS) = XYZVERT(IAXIS,NOD_PERM(JNOD)) - XYZV(IAXIS) -! IF( DV(IAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF( ABS(DV(IAXIS)) <= GEOMEPS) THEN -! DV(JAXIS) = XYZVERT(JAXIS,NOD_PERM(JNOD)) - XYZV(JAXIS) -! IF ( DV(JAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF ( ABS(DV(JAXIS)) <= GEOMEPS ) THEN -! DV(KAXIS) = XYZVERT(KAXIS,NOD_PERM(JNOD)) - XYZV(KAXIS) -! IF ( DV(KAXIS) > GEOMEPS ) THEN -! EXIT -! ELSEIF ( ABS(DV(KAXIS)) <= GEOMEPS ) THEN -! INOD = NOD_PERM(JNOD) -! RETURN ! XYZV is in XYZVERT(IAXIS:KAXIS,NOD_PERM(JNOD)) -! ENDIF -! ENDIF -! ENDIF -! ENDDO -! ELSE -! ! Binary Search: -! PIVOT(LOW_IND) = 0 -! PIVOT(HIGH_IND)= NVERT + 1 -! DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) -! JNOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 -! DV(IAXIS) = XYZVERT(IAXIS,NOD_PERM(JNOD)) - XYZV(IAXIS) -! IF( DV(IAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(IAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(IAXIS)) < GEOMEPS -! DV(JAXIS) = XYZVERT(JAXIS,NOD_PERM(JNOD)) - XYZV(JAXIS) -! IF ( DV(JAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(JAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(JAXIS)) < GEOMEPS -! DV(KAXIS) = XYZVERT(KAXIS,NOD_PERM(JNOD)) - XYZV(KAXIS) -! IF ( DV(KAXIS) < -GEOMEPS ) THEN -! PIVOT(LOW_IND) = JNOD -! ELSEIF( DV(KAXIS) > GEOMEPS ) THEN -! PIVOT(HIGH_IND)= JNOD -! ELSE ! ABS(DV(KAXIS)) < GEOMEPS -! INOD = NOD_PERM(JNOD) -! RETURN -! ENDIF -! ENDIF -! ENDIF -! ENDDO -! JNOD=PIVOT(HIGH_IND) -! ENDIF -! ! Insert add NOD_PERM permutation array, O(NP) operation: -! INOD = NVERT + 1 -! NVERT = INOD -! IF (NVERT>MAXVERTS) WRITE(LU_ERR,*) 'geom.f90: INSERT_FACE_VERT_LOC, NVERT',NVERT,', higher than CC_MAXVERTS',MAXVERTS -! DO JNOD2=NVERT,JNOD+1,-1 -! NOD_PERM(JNOD2) = NOD_PERM(JNOD2-1) -! ENDDO -! NOD_PERM(JNOD) = INOD -! XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) +INTEGER :: IFC,IFACE,LOHI,HILO,X1AXIS,IFCX,JFCX,IVERT,AXIS +REAL(EB):: XYZFACE(IAXIS:KAXIS,LOW_IND:HIGH_IND),XYZ(IAXIS:KAXIS) +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTFACE_TYPE), POINTER :: CF -DO INOD=1,NVERT - IF( ABS(XYZV(IAXIS)-XYZVERT(IAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE - IF( ABS(XYZV(JAXIS)-XYZVERT(JAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE - IF( ABS(XYZV(KAXIS)-XYZVERT(KAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE - RETURN -ENDDO -NVERT = NVERT + 1 -INOD = NVERT -IF (NVERT>MAXVERTS) WRITE(LU_ERR,*) 'geom.f90: INSERT_FACE_VERT_LOC, NVERT',NVERT,', higher than CC_MAXVERTS',MAXVERTS -XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) +CC => MESHES(NM)%CUT_CELL(ICC) -RETURN -END SUBROUTINE INSERT_FACE_VERT_LOC +! Get cut-cell bounding box: +MINMAX_XYZ_JCC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) +MINMAX_XYZ_JCC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) +DO IFC=1,CC%CCELEM(1,JCC) ! Loop over cut-faces boundary of this cell. + IFACE=CC%CCELEM(IFC+1,JCC) + LOHI = CC%FACE_LIST(2,IFACE) + HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND + X1AXIS = CC%FACE_LIST(3,IFACE) + IFCX = CC%FACE_LIST(4,IFACE) + JFCX = CC%FACE_LIST(5,IFACE) -! ----------------------- GET_CARTFACE_CUTFACES --------------------------------- + SELECT CASE(CC%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_RCGAS) ! Regular Gas face with a regular cell on one side and a cut-cell on the other. + XYZFACE = XYZCELL; XYZFACE(X1AXIS,HILO) = XYZFACE(X1AXIS,LOHI) ! Same location in X1AXIS for both sides of face. + DO AXIS=IAXIS,KAXIS + MINMAX_XYZ_JCC(AXIS,LOW_IND) = MIN(MINMAX_XYZ_JCC(AXIS,LOW_IND) ,XYZFACE(AXIS,LOW_IND)) + MINMAX_XYZ_JCC(AXIS,HIGH_IND)= MAX(MINMAX_XYZ_JCC(AXIS,HIGH_IND),XYZFACE(AXIS,HIGH_IND)) + ENDDO -SUBROUTINE GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) + CASE(CC_FTYPE_CFGAS,CC_FTYPE_CFINB) ! GAS or Boundary cut-face: + CF => MESHES(NM)%CUT_FACE(IFCX) + DO IVERT=1,CF%CFELEM(1,JFCX) + XYZ(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(IVERT+1,JFCX)) + DO AXIS=IAXIS,KAXIS + MINMAX_XYZ_JCC(AXIS,LOW_IND) = MIN(MINMAX_XYZ_JCC(AXIS,LOW_IND) ,XYZ(AXIS)) + MINMAX_XYZ_JCC(AXIS,HIGH_IND)= MAX(MINMAX_XYZ_JCC(AXIS,HIGH_IND),XYZ(AXIS)) + ENDDO + ENDDO -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -LOGICAL, INTENT(IN) :: BNDINT_FLAG + END SELECT +ENDDO -! Local Variables: -INTEGER :: X1AXIS, X2AXIS, X3AXIS -INTEGER :: XIAXIS, XJAXIS, XKAXIS -INTEGER :: X1LO, X1HI, X2LO, X2HI, X3LO, X3HI -INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI -INTEGER :: II,II2,JJ,KK, CEI -INTEGER :: INDXI(MAX_DIM), INDI, INDJ, INDK -INTEGER :: INDXI1(MAX_DIM), INDI1, INDJ1, INDK1 -INTEGER :: INDXI2(MAX_DIM), INDI2, INDJ2, INDK2 -INTEGER :: INDXI3(MAX_DIM), INDI3, INDJ3, INDK3 -INTEGER :: INDXI4(MAX_DIM), INDI4, INDJ4, INDK4 -INTEGER :: INDLC(MAX_DIM), IEDG, JEDG, KEDG -INTEGER :: NSEG, ISEG, ISEG2, NVERT, NFACE, NEDGE, IEDGE, NVERT_CART, NSEG_CART -LOGICAL :: OUTFACE1, OUTFACE2, NOTDONE +END SUBROUTINE CUT_CELL_BOUNDING_BOX -INTEGER, DIMENSION(NOD1:NOD2+3,1:CC_MAXCEELEM_FACE) :: SEG_FACE, SEG_FACE_CART, SEG_FACEAUX -INTEGER, DIMENSION(NOD1:NOD3+1,1:CC_MAXCEELEM_FACE) :: SEG_FACE2 -REAL(EB), DIMENSION(CC_MAXCEELEM_FACE) :: ANGSEG, ANGSEGAUX -REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) :: XYZVERT, XYZVERT_CART ! Locations of vertices. +! -------------------------CUT_CELL_ARRAY_REALLOC------------------------------------ -INTEGER, SAVE :: SIZE_CFACES_CFELEM, SIZE_VERTS_CFELEM -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CFELEM2,CEDGES,CEDGES2 -INTEGER, ALLOCATABLE, DIMENSION(:) :: CFE, CFEL +SUBROUTINE CUT_CELL_ARRAY_REALLOC(NM,ICC) -INTEGER, SAVE :: SIZE_EDGES_NODEDG, SIZE_VERTS_NODEDG -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NODEDG_FACE +INTEGER, INTENT(IN) :: NM,ICC -LOGICAL :: SEG_FLAG(CC_MAXCEELEM_FACE) -INTEGER :: NUMEDG_NODE(CC_MAXVERTS_FACE) +! Local Variables: +INTEGER :: ICC1,SIZE_CUT_CELL +TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX -INTEGER :: INOD, INOD1, INOD2, SEG(NOD1:NOD2) -REAL(EB):: X1, X2, X3, DX2, DX3, XYZV(MAX_DIM), XYZLC(MAX_DIM) -INTEGER :: NUMNOD1, NUMNOD2, NEDI, ICF, ISS, NEWSEG, COUNT, N2COUNT, CTSTART, NSEG_LEFT -REAL(EB):: ANGCOUNT, DANG, DANGI -LOGICAL :: FOUNDSEG, PTSFLAG -INTEGER :: ICF1, ICF2, ICF_PT, IPT, NP, NP1, NP2, NFACE2, NCUTFACE, NVERTFACE -REAL(EB), DIMENSION(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) :: XY -REAL(EB):: AREA, AREA1, AREA2, AREAH, CX2, CX3, DIST12, D12 -REAL(EB), DIMENSION(IAXIS:JAXIS) :: XYC1, XYC2, XYH +! Here test if we need to reallocate cut-cell: +SIZE_CUT_CELL = SIZE(MESHES(NM)%CUT_CELL,DIM=1) +IF (ICC > SIZE_CUT_CELL) THEN + ALLOCATE(CUT_CELL_AUX(SIZE_CUT_CELL+GLOBAL_DELTA_CELL)) + DO ICC1=1,ICC-1 + CALL CUT_CELL_MOVE(MESHES(NM)%CUT_CELL(ICC1),CUT_CELL_AUX(ICC1)) + ENDDO + CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL) +ENDIF -REAL(EB), DIMENSION(CC_MAXCFELEM_FACE) :: AREAV ! Cut-faces areas. -REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXCFELEM_FACE) :: XYZCEN ! Cut-faces centroid locations. -REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXCFELEM_FACE) :: INXAREA, INXSQAREA -INTEGER, DIMENSION(CC_MAXCFELEM_FACE) :: FINFACE -INTEGER :: IBNDINT,BNDINT_LOW,BNDINT_HIGH,ILOC,BODNUM(1:CC_MAXCEELEM_FACE),& -SEGTYPE(CC_MAXCEELEM_FACE),SEGTYPEAUX(CC_MAXCEELEM_FACE),VEC(2),IDUM,IBOD,STYPE -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED +RETURN +END SUBROUTINE CUT_CELL_ARRAY_REALLOC -INTEGER :: NSSEG, NSVERT, NSFACE, NSFACE2 -LOGICAL :: ASCDESC, INLIST -INTEGER :: NV,IV,V(1:CC_MAXVERTS_FACE) -REAL(EB):: XVERT1(1:CC_MAXVERTS_FACE),XVERT2(1:CC_MAXVERTS_FACE) +! ------------------------- CELL_DEALLOC ----------------------------------- -INTEGER, PARAMETER :: NODC1(1:4) = (/ 1, 2, 1, 2 /) -INTEGER, PARAMETER :: NODC2(1:4) = (/ 1, 2, 2, 1 /) -INTEGER :: SNOD1(NOD1:NOD2), SNOD2(NOD1:NOD2) -REAL(EB) :: XYZ_SEG1(IAXIS:KAXIS,NOD1:NOD2), XYZ_SEG2(IAXIS:KAXIS,NOD1:NOD2) -LOGICAL :: DIFF(1:4) -LOGICAL :: GET_SOLID_CUTFACES = .TRUE. -LOGICAL, ALLOCATABLE, DIMENSION(:) :: DROPFACE -REAL(EB) :: TNOW +SUBROUTINE CELL_DEALLOC(NM,ICC) -! INTEGER :: ETYPE, AXIS, SIDE, IEC, JEC, CEIJK(4), IIF, JJF ,KKF -! REAL(EB):: X1E(IAXIS:KAXIS), X1V(IAXIS:KAXIS), X2E(IAXIS:KAXIS), X2V(IAXIS:KAXIS) +INTEGER, INTENT(IN) :: NM,ICC -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -INTEGER :: NCUTFCE +MESHES(NM)%CUT_CELL(ICC)%NCELL = 0 +IF (.NOT.ALLOCATED(MESHES(NM)%CUT_CELL(ICC)%CCELEM)) RETURN -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - IF (BNDINT_FLAG) THEN ! Boundary and internal cartface cut-faces: - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating internal CARTFACE_CUTFACES for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating internal CARTFACE_CUTFACES for mesh :',NM,' ..' - ELSE - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTFACE_CUTFACES for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTFACE_CUTFACES for mesh :',NM,' ..' - ENDIF -ENDIF +! Deallocate ICC entries: +DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%CCELEM) +DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST) +DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%IJK_LINK,MESHES(NM)%CUT_CELL(ICC)%LINK_LEV) +DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%VOLUME, MESHES(NM)%CUT_CELL(ICC)%XYZCEN) +DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%NOADVANCE,MESHES(NM)%CUT_CELL(ICC)%UNKZ) -TNOW=CURRENT_TIME() +RETURN -! Allocate local Arrays: -SIZE_EDGES_NODEDG = DELTA_EDGE -SIZE_VERTS_NODEDG = DELTA_VERT -ALLOCATE(NODEDG_FACE(1:SIZE_EDGES_NODEDG,1:SIZE_VERTS_NODEDG)) -SIZE_CFACES_CFELEM = DELTA_FACE -SIZE_VERTS_CFELEM = DELTA_VERT -ALLOCATE(CFELEM(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) -ALLOCATE(CEDGES(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) -ALLOCATE(CFE(1:SIZE_VERTS_CFELEM),CFEL(1:SIZE_VERTS_CFELEM)) +END SUBROUTINE CELL_DEALLOC -! Build a set of regular cut-cells in the middle of the domain to do testing. -IF (PERIODIC_TEST == 103 .OR. PERIODIC_TEST == 11 .OR. PERIODIC_TEST == 7) THEN - CALL DEFINE_REGULAR_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) - T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW - RETURN -ENDIF +! -------------------------- NEW_CELL_ALLOC ------------------------------------- -! Test to check cut-cell definition scaling: -IF (PERIODIC_TEST == 105) GET_SOLID_CUTFACES = .FALSE. +SUBROUTINE NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) -! Main Loop on block NM: -IF (BNDINT_FLAG) THEN - ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. - BNDINT_LOW = 1 - BNDINT_HIGH = 3 -ELSE - IF (CCGUARD==0) THEN - DEALLOCATE( IJK_COUNTED ) - RETURN - ENDIF - BNDINT_LOW = 4 - BNDINT_HIGH = 4 -ENDIF +INTEGER, INTENT(IN) :: NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL -IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, - ! 4 guard-cell faces. +! Allocate ICC entries: +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%CCELEM(1:NCFACE_CUTCELL,1:NCELL)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%IJK_LINK(IAXIS:KAXIS+2,1:NCELL),MESHES(NM)%CUT_CELL(ICC)%LINK_LEV(1:NCELL)) +MESHES(NM)%CUT_CELL(ICC)%CCELEM = CC_UNDEFINED +MESHES(NM)%CUT_CELL(ICC)%FACE_LIST = CC_UNDEFINED +MESHES(NM)%CUT_CELL(ICC)%IJK_LINK = CC_UNDEFINED +MESHES(NM)%CUT_CELL(ICC)%LINK_LEV = 0 ! Root of link Hierarchy is zero. - ! When switching to internal faces, copy number of external faces already computed. - IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%VOLUME(1:NCELL),MESHES(NM)%CUT_CELL(ICC)%NOADVANCE(1:NCELL)) +MESHES(NM)%CUT_CELL(ICC)%VOLUME = 0._EB +MESHES(NM)%CUT_CELL(ICC)%NOADVANCE= NOT_BLOCKED - XIAXIS_LOOP : DO X1AXIS=IAXIS,KAXIS +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,1:NCELL)) +MESHES(NM)%CUT_CELL(ICC)%XYZCEN = 0._EB +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%UNKZ(1:NCELL)); MESHES(NM)%CUT_CELL(ICC)%UNKZ = CC_UNDEFINED +RETURN +END SUBROUTINE NEW_CELL_ALLOC - SELECT CASE(X1AXIS) - case(IAXIS) +! -------------------------- ALLOC_CELL_STATE_VARS ------------------------------------- - X2AXIS = JAXIS - X3AXIS = KAXIS +SUBROUTINE ALLOC_CELL_STATE_VARS(NM,ICC,NCELL) - ! IAXIS gasphase cut-faces: - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - ILO = ILO_FACE; IHI = ILO_FACE - CASE(2) - ILO = IHI_FACE; IHI = IHI_FACE - CASE(3) - ILO = ILO_FACE+1; IHI = IHI_FACE-1 - CASE(4) - ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT +INTEGER, INTENT(IN) :: NM,ICC,NCELL - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS +! Allocate ICC entries: +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%RHO(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%RHOS(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%RSUM(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%TMP(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%D(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%DVOL(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%DVOL_PR(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%Q(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%QR(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%D_SOURCE(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%CHI_R(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%DS(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%MIX_TIME(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%H(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%HS(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%RTRM(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%R_H_G(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%RHO_0(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%WVEL(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%KRES(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%DDDTVOL(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%DELTA_RHO(1:NCELL),MESHES(NM)%CUT_CELL(ICC)%DELTA_RHO_ZZ(1:NCELL)) - ! Local indexing in x1, x2, x3: - X1LO = ILO; X1HI = IHI - X2LO = JLO; X2HI = JHI - X3LO = KLO; X3HI = KHI +MESHES(NM)%CUT_CELL(ICC)%RHO = 0._EB +MESHES(NM)%CUT_CELL(ICC)%RHOS = 0._EB +MESHES(NM)%CUT_CELL(ICC)%RSUM = 0._EB +MESHES(NM)%CUT_CELL(ICC)%TMP = 0._EB +MESHES(NM)%CUT_CELL(ICC)%D = 0._EB +MESHES(NM)%CUT_CELL(ICC)%DS = 0._EB +MESHES(NM)%CUT_CELL(ICC)%DVOL = 0._EB +MESHES(NM)%CUT_CELL(ICC)%DVOL_PR = 0._EB +MESHES(NM)%CUT_CELL(ICC)%Q = 0._EB +MESHES(NM)%CUT_CELL(ICC)%QR = 0._EB +MESHES(NM)%CUT_CELL(ICC)%D_SOURCE = 0._EB +MESHES(NM)%CUT_CELL(ICC)%CHI_R = 0._EB +MESHES(NM)%CUT_CELL(ICC)%MIX_TIME = 0._EB +MESHES(NM)%CUT_CELL(ICC)%KRES = 0._EB +MESHES(NM)%CUT_CELL(ICC)%H = 0._EB +MESHES(NM)%CUT_CELL(ICC)%HS = 0._EB +MESHES(NM)%CUT_CELL(ICC)%RTRM = 0._EB +MESHES(NM)%CUT_CELL(ICC)%R_H_G = 0._EB +MESHES(NM)%CUT_CELL(ICC)%RHO_0 = 0._EB +MESHES(NM)%CUT_CELL(ICC)%WVEL = 0._EB +MESHES(NM)%CUT_CELL(ICC)%DDDTVOL = 0._EB +MESHES(NM)%CUT_CELL(ICC)%DELTA_RHO= 0._EB +MESHES(NM)%CUT_CELL(ICC)%DELTA_RHO_ZZ= 0._EB - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE - ALLOCATE(X2FACE(JSTR:JEND)); X2FACE = YFACE - ALLOCATE(X3FACE(KSTR:KEND)); X3FACE = ZFACE +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%Q_REAC(1:N_REACTIONS,1:NCELL)) +MESHES(NM)%CUT_CELL(ICC)%Q_REAC = 0._EB - CASE(JAXIS) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%REAC_SOURCE_TERM(1:N_TOTAL_SCALARS,1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%ZZ(1:N_TOTAL_SCALARS,1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%ZZS(1:N_TOTAL_SCALARS,1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%M_DOT_PPP(1:N_TOTAL_SCALARS,1:NCELL)) +MESHES(NM)%CUT_CELL(ICC)%REAC_SOURCE_TERM = 0._EB +MESHES(NM)%CUT_CELL(ICC)%ZZ = 0._EB +MESHES(NM)%CUT_CELL(ICC)%ZZS = 0._EB +MESHES(NM)%CUT_CELL(ICC)%M_DOT_PPP = 0._EB - X2AXIS = KAXIS - X3AXIS = IAXIS +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%UNKH(1:NCELL)); MESHES(NM)%CUT_CELL(ICC)%UNKH = CC_UNDEFINED +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_IJK(IAXIS:KAXIS,(NCELL+1)*DELTA_INT)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_COEF((NCELL+1)*DELTA_INT)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_XYZBF(IAXIS:KAXIS,0:NCELL)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_NOUT(IAXIS:KAXIS,0:NCELL)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_INBFC(1:3,0:NCELL)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_NPE(LOW_IND:HIGH_IND,0:KAXIS,1:INT_N_EXT_PTS,0:NCELL)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_XN(0:INT_N_EXT_PTS,0:NCELL)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_CN(0:INT_N_EXT_PTS,0:NCELL)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_CCVARS(1:N_INT_FVARS,(NCELL+1)*DELTA_INT)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_NOMIND(LOW_IND:HIGH_IND,(NCELL+1)*DELTA_INT)) - ! JAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - JLO = JLO_FACE; JHI = JLO_FACE - CASE(2) - JLO = JHI_FACE; JHI = JHI_FACE - CASE(3) - JLO = JLO_FACE+1; JHI = JHI_FACE-1 - CASE(4) - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT +MESHES(NM)%CUT_CELL(ICC)%INT_IJK = CC_UNDEFINED +MESHES(NM)%CUT_CELL(ICC)%INT_COEF = 0._EB +MESHES(NM)%CUT_CELL(ICC)%INT_XYZBF = 0._EB +MESHES(NM)%CUT_CELL(ICC)%INT_NOUT = 0._EB +MESHES(NM)%CUT_CELL(ICC)%INT_INBFC = CC_UNDEFINED +MESHES(NM)%CUT_CELL(ICC)%INT_NPE = 0 +MESHES(NM)%CUT_CELL(ICC)%INT_XN = 0._EB +MESHES(NM)%CUT_CELL(ICC)%INT_CN = 0._EB +MESHES(NM)%CUT_CELL(ICC)%INT_CCVARS= 0._EB +MESHES(NM)%CUT_CELL(ICC)%INT_NOMIND= CC_UNDEFINED - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%DEL_RHO_D_DEL_Z_VOL(1:N_TOTAL_SCALARS,1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%U_DOT_DEL_RHO_Z_VOL(1:N_TOTAL_SCALARS,1:NCELL)) +MESHES(NM)%CUT_CELL(ICC)%DEL_RHO_D_DEL_Z_VOL = 0._EB; MESHES(NM)%CUT_CELL(ICC)%U_DOT_DEL_RHO_Z_VOL = 0._EB - ! Local indexing in x1, x2, x3: - X1LO = JLO; X1HI = JHI - X2LO = KLO; X2HI = KHI - X3LO = ILO; X3HI = IHI +RETURN - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE - ALLOCATE(X2FACE(KSTR:KEND)); X2FACE = ZFACE - ALLOCATE(X3FACE(ISTR:IEND)); X3FACE = XFACE +END SUBROUTINE ALLOC_CELL_STATE_VARS - CASE(KAXIS) +SUBROUTINE SET_CUTCELLS_3D +USE MPI_F08 - X2AXIS = IAXIS - X3AXIS = JAXIS +INTEGER :: I,J,K,KK +INTEGER :: X1AXIS +INTEGER :: ISTR, IEND, JSTR, JEND, KSTR, KEND +INTEGER :: NM, NOM - ! KAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - KLO = KLO_FACE; KHI = KLO_FACE - CASE(2) - KLO = KHI_FACE; KHI = KHI_FACE - CASE(3) - KLO = KLO_FACE+1; KHI = KHI_FACE-1 - CASE(4) - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - END SELECT +! Miscellaneous: +REAL(EB) :: X1PLN +INTEGER :: NCUTFACE_IAXIS, NCUTFACE_JAXIS, NCUTFACE_KAXIS, ICE1, ICF1, NFACE, IERR, & + NCUTEDGE_IBCC, NCUTEDGE_IBCF +REAL(EB):: CF_AREA_IAXIS=0._EB, CF_AREA_JAXIS=0._EB, CF_AREA_KAXIS=0._EB, & + CF_INXAREA_IAXIS=0._EB,CF_INXAREA_JAXIS=0._EB,CF_INXAREA_KAXIS=0._EB, & + CF_INXSQAREA_IAXIS=0._EB,CF_INXSQAREA_JAXIS=0._EB,CF_INXSQAREA_KAXIS=0._EB, & + CF_JNYSQAREA_IAXIS=0._EB,CF_JNYSQAREA_JAXIS=0._EB,CF_JNYSQAREA_KAXIS=0._EB, & + CF_KNZSQAREA_IAXIS=0._EB,CF_KNZSQAREA_JAXIS=0._EB,CF_KNZSQAREA_KAXIS=0._EB +REAL(EB):: SLEN_GEOM, AREA_GEOM, VOLUME_GEOM, SLEN_IBCC, SLEN, DV(MAX_DIM), XYZCEN_GEOM(MAX_DIM), & + DM_XYZCEN(MAX_DIM), CCGP_XYZCEN(MAX_DIM), DM_XYZCEN_AUX(MAX_DIM), CCGP_XYZCEN_AUX(MAX_DIM) +INTEGER :: SEG(NOD1:NOD2), NEDGE, IEDGE, IFACE, IG - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS +INTEGER :: NCUTFACE_INB, ICC1, ICC2, NCELL, IGC, ICF2, JCF2, JCF, FTYPE, ILH, CELL_BLOCK_IOR +REAL(EB):: CF_AREA_INB=0._EB, CF_INXAREA_INB=0._EB, CF_INXSQAREA_INB=0._EB, & + CF_JNYSQAREA_INB=0._EB, CF_KNZSQAREA_INB=0._EB, CF_AREA_INB_AUX=0._EB, ACRT +REAL(EB):: CC_VOLUME_INB=0._EB, DM_VOLUME=0._EB, GP_VOLUME=0._EB, & + CC_VOLUME_INB_AUX=0._EB, DM_VOLUME_AUX=0._EB, GP_VOLUME_AUX=0._EB +INTEGER, DIMENSION(5) :: MIN_CC_IJK_ICCJCC, MAX_CC_IJK_ICCJCC +REAL(EB):: MIN_CC_VOL, MAX_CC_VOL, MIN_ALPHA_CV, MAX_ALPHA_CV +LOGICAL, ALLOCATABLE, DIMENSION(:) :: CC_COMPUTE_MESH, CC_COMPUTE_MESH_AUX +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_ZMAX_AUX + +INTEGER :: IW,II,JJ,IIF,JJF,KKF,IIOF,JJOF,KKOF,LOHIF,IOR,CT,NCFACE_CUTCELL,NFACE_CELL,AX,SIDE,ICC,JCC,ICFC,IFC +TYPE(MESH_TYPE), POINTER :: M, M2 +TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC +TYPE(WALL_TYPE), POINTER :: WC +TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC +TYPE(BOUNDARY_PROP1_TYPE), POINTER :: B1 +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTFACE_TYPE), POINTER :: CF +TYPE(CC_CUTEDGE_TYPE), POINTER :: CE +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME +INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) +INTEGER :: IIO,JJO,KKO,IOGC,JOGC,KOGC - ! Local indexing in x1, x2, x3: - X1LO = KLO; X1HI = KHI - X2LO = ILO; X2HI = IHI - X3LO = JLO; X3HI = JHI +REAL(EB) :: TNOW - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE - ALLOCATE(X2FACE(ISTR:IEND)); X2FACE = XFACE - ALLOCATE(X3FACE(JSTR:JEND)); X3FACE = YFACE +LOGICAL :: WRITE_CFACE_STATS = .FALSE. +LOGICAL :: EARLY_RETURN_FROM_SET_CUTCELLS - END SELECT +INTEGER, SAVE :: CALL_COUNT = 0 - ! Loop on Cartesian faces, local x1, x2, x3 indexes: - DO II=X1LO,X1HI - DO KK=X3LO,X3HI - DO JJ=X2LO,X2HI +! GET_CUTCELL_VERBOSE variables: +INTEGER :: IPROC, NMESH_CC, NMESH_CC_AUX, TAG +TYPE (MPI_STATUS) :: MPISTATUS +CHARACTER(MESSAGE_LENGTH) :: VERBOSE_FILE, VERBOSE_FILE_AUX +CHARACTER(1), DIMENSION(3), PARAMETER :: AXSTR(1:3) = (/ 'X', 'Y', 'Z' /) +REAL(EB) :: CPUTIME, CPUTIME_START, CPUTIME_MESH, CPUTIME_START_MESH +INTEGER :: MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL, SUM_FACE, SUM_CCELL=0 +TYPE(CFACE_TYPE), POINTER :: CFA +REAL(EB), ALLOCATABLE, DIMENSION(:) :: GEOM_AREA_SURF +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW +INTEGER, ALLOCATABLE, DIMENSION(:) :: GEOM_SURF +INTEGER :: ICF, SURF_INDEX, SUM_CC, IDIM - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI = INDXI(XIAXIS) - INDJ = INDXI(XJAXIS) - INDK = INDXI(XKAXIS) +LOGICAL, SAVE :: FIRST_CALL_ARG=.TRUE., FIRST_CALL_ARG2=.TRUE. - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE; IJK_COUNTED(INDI,INDJ,INDK,X1AXIS)=.TRUE. - IF(MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) == CC_SOLID) CYCLE +REAL(EB):: VERT_AUX(IAXIS:KAXIS),CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) +INTEGER :: ING,INOD,IWSEL,IEL,FACE_AUX(NOD1:NOD3),VOL_AUX(NOD1:NOD4),N_SPCELLCF_TOT,N_SPCELL_TOT +CHARACTER(100) :: FILENAME - ! Drop if face not cut-face: - ! Test for FACE Cartesian edges being cut: - ! If outface1 is true -> All regular edges for this face: - ! Edge at index KK-1: - INDXI1(IAXIS:KAXIS) = (/ II, JJ, KK-1 /) ! Local x1,x2,x3 - INDI1 = INDXI1(XIAXIS) - INDJ1 = INDXI1(XJAXIS) - INDK1 = INDXI1(XKAXIS) - ! Edge at index KK: - INDXI2(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI2 = INDXI2(XIAXIS) - INDJ2 = INDXI2(XJAXIS) - INDK2 = INDXI2(XKAXIS) - ! Edge at index JJ-1: - INDXI3(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 - INDI3 = INDXI3(XIAXIS) - INDJ3 = INDXI3(XJAXIS) - INDK3 = INDXI3(XKAXIS) - ! Edge at index jj: - INDXI4(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI4 = INDXI4(XIAXIS) - INDJ4 = INDXI4(XJAXIS) - INDK4 = INDXI4(XKAXIS) +CALL CC_GRID_GLOBAL_INIT +IF (STOP_STATUS==SETUP_STOP) RETURN - OUTFACE1 = (MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) /= CC_CUTCFE) +CALL CC_GRID_ALLOCATE_BUILD_SCRATCH - ! Test for face with INB edges: - ! If outface2 is true -> no INB Edges associated with this face: - OUTFACE2 = (MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) <= 0) +! Main Loop over Meshes: +MAIN_MESH_LOOP : DO NM=1,NMESHES + CALL CC_GRID_BUILD_CUTCELL_MESH(NM) + IF (STOP_STATUS==SETUP_STOP) RETURN +ENDDO MAIN_MESH_LOOP - ! Drop if outface1 & outface2 - IF (OUTFACE1 .AND. OUTFACE2) THEN - ! Test if face is SOLID: - IF ((MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) == CC_SOLID) ) THEN - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID - ENDIF - CYCLE - ENDIF +CALL CC_GRID_RELEASE_BUILD_SCRATCH - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_CUTCFE +POSTBUILD_MESH_LOOP : DO NM=1,NMESHES + CALL CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) + IF (STOP_STATUS==SETUP_STOP) RETURN +ENDDO POSTBUILD_MESH_LOOP - ! Build segment list: - NSEG = 0 - NVERT = 0 - NFACE = 0 +CALL CC_GRID_EXCHANGE_AND_REBLOCK - SEG_FACE (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED - XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) = 0._EB - ANGSEG(1:CC_MAXCEELEM_FACE) = 0._EB - BODNUM(1:CC_MAXCEELEM_FACE) = 1000000000 - SEGTYPE(1:CC_MAXCEELEM_FACE) = 0 +MAIN_MESH_LOOP_3 : DO NM=1,NMESHES + CALL CC_GRID_POSTPROCESS_AND_CLEANUP(NM) +ENDDO MAIN_MESH_LOOP_3 +! Finally allocate Face and cell variables, compute area and volume factors: +MAIN_MESH_LOOP_4 : DO NM=1,NMESHES + CALL CC_GRID_ALLOCATE_STATE_VARS(NM) +ENDDO MAIN_MESH_LOOP_4 - ! 1. Cartesian CC_GASPHASE edges, cut-edges: - ! a. Make a list of segments: - ! Low x2 cut-edges: - INDLC(IAXIS:KAXIS) = INDXI3(IAXIS:KAXIS) - IEDG=INDI3; JEDG=INDJ3; KEDG=INDK3 - CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X3AXIS) - IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: - IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X3AXIS) /= CC_SOLID) THEN - ! x,y,z of node 1: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) +CALL CC_GRID_LOG_PROCESSING_TIME - ! x,y,z of node 2: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)-1) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) +CALL CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, LOW_IND, X2AXIS /) - ANGSEG(NSEG) = - PI / 2._EB - ENDIF - ELSE ! Cut-edge, load CUT_EDGE(CEI) segments - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) +! Fill Guardcells for CCVAR CC_CGSC and CUT_CELL for meshes assigned to MPI process: +CALL SET_GC_CUTCELLS_3D - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) +! Allocate and define entries for solid side CFACES: +IF(PERIODIC_TEST/=105) CALL GET_EXT_INB_CUTFACES_TO_CFACE - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) +CALL CC_GRID_FINALIZE_BOOKKEEPING(EARLY_RETURN_FROM_SET_CUTCELLS) +IF (EARLY_RETURN_FROM_SET_CUTCELLS) RETURN - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) - ANGSEG(NSEG) = - PI / 2._EB - ENDDO - ENDIF +CALL CC_GRID_WRITE_VERBOSE_SUMMARY - ! High x2 cut-edges: - INDLC(IAXIS:KAXIS) = INDXI4(IAXIS:KAXIS) - IEDG=INDI4; JEDG=INDJ4; KEDG=INDK4 - CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X3AXIS) - IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: - IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X3AXIS) /= CC_SOLID) THEN - ! x,y,z of node 1: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)-1) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) +RETURN - ! x,y,z of node 2: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) +CONTAINS - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, HIGH_IND, X2AXIS /) - ANGSEG(NSEG) = PI / 2._EB - ENDIF - ELSE ! Cut-edge, load CUT_EDGE(CEI) segments - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) +SUBROUTINE CC_GRID_GLOBAL_INIT - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) +IF (MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN + WRITE(LU_ERR,*) ' ' + WRITE(LU_ERR,*) 'SET_CUTCELLS_3D : Cut-Cell computation in VERBOSE mode, 4 tasks to perform:' +ENDIF - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) +! Reset variables: +CC_NEDGECROSS = 0 +CC_NCUTEDGE = 0 +CC_NCUTFACE = 0 +CC_NCUTCELL = 0 - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) - ANGSEG(NSEG) = PI / 2._EB - ENDDO - ENDIF +! Check Meshes Boundaries match, requirement to get consistent ghost and internal cut-cells. +CALL CHECK_WALL_CELL_PLANE_MATCH; IF (STOP_STATUS==SETUP_STOP) RETURN - ! Low x3 cut-edges: - INDLC(IAXIS:KAXIS) = INDXI1(IAXIS:KAXIS) - IEDG=INDI1; JEDG=INDJ1; KEDG=INDK1 - CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X2AXIS) - IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: - IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X2AXIS) /= CC_SOLID) THEN - ! x,y,z of node 1: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)-1), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) +! Get geometry triangle bins in Cartesian directions: +CALL GET_GEOM_TRIBIN - ! x,y,z of node 2: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) +! Snap to grid planes node positions in the work volume of this process: +CALL SNAP_GEOM_NODES - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, LOW_IND, X3AXIS /) - ANGSEG(NSEG) = 0._EB - ENDIF - ELSE ! Cut-edge, load CUT_EDGE(CEI) segments - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) +! Initialize GEOMETRY fields used by CC_IBM: +CALL CC_INIT_GEOM; IF (STOP_STATUS==SETUP_STOP) RETURN - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) +TNOW=CURRENT_TIME() - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) +DEBUG_SET_CUTCELLS_COND : IF (DEBUG_SET_CUTCELLS) THEN + ! Write meshes file: + WRITE(FILENAME,'(A,A)') TRIM(CHID),'_meshes.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8)') NMESHES + MESH_LOOP : DO NM=1,NMESHES - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) - ANGSEG(NSEG) = 0._EB - ENDDO - ENDIF + IF (PROCESS(NM)/=MY_RANK) CYCLE - ! High x3 cut-edges: - INDLC(IAXIS:KAXIS) = INDXI2(IAXIS:KAXIS) - IEDG=INDI2; JEDG=INDJ2; KEDG=INDK2 - CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X2AXIS) - IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: - IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X2AXIS) /= CC_SOLID) THEN - ! x,y,z of node 1: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + ! Mesh sizes: + NXB=MESHES(NM)%IBAR + NYB=MESHES(NM)%JBAR + NZB=MESHES(NM)%KBAR - ! x,y,z of node 2: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & - X2FACE(INDLC(JAXIS)-1), & - X3FACE(INDLC(KAXIS)) /) - X1 = XYZLC(XIAXIS) - X2 = XYZLC(XJAXIS) - X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + WRITE(33,'(4I8,6F24.16)') NM,NXB,NYB,NZB,MESHES(NM)%X(0),MESHES(NM)%X(NXB),& + MESHES(NM)%Y(0),MESHES(NM)%Y(NYB),& + MESHES(NM)%Z(0),MESHES(NM)%Z(NZB) + DO I=0,NXB + WRITE(33,'(4F24.16)') MESHES(NM)%X(I),MESHES(NM)%XC(I),MESHES(NM)%DXN(I),MESHES(NM)%DX(I) + ENDDO + DO J=0,NYB + WRITE(33,'(4F24.16)') MESHES(NM)%Y(J),MESHES(NM)%YC(J),MESHES(NM)%DYN(J),MESHES(NM)%DY(J) + ENDDO + DO K=0,NZB + WRITE(33,'(4F24.16)') MESHES(NM)%Z(K),MESHES(NM)%ZC(K),MESHES(NM)%DZN(K),MESHES(NM)%DZ(K) + ENDDO - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, HIGH_IND, X3AXIS /) - ANGSEG(NSEG) = PI - ENDIF - ELSE ! Cut-edge, load CUT_EDGE(CEI) segments - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + ENDDO MESH_LOOP + CLOSE(33) - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + ! Write geometry files: + WRITE(FILENAME,'(A,A)') TRIM(CHID),'_num_geometries.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I6,4F24.16)') N_GEOMETRY, GEOMEPS + CLOSE(33) + GEOM_LOOP : DO ING=1,N_GEOMETRY - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + ! Write Vertices: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_verts.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO INOD=1,GEOMETRY(ING)%N_VERTS + VERT_AUX(IAXIS:KAXIS) = GEOMETRY(ING)%VERTS(MAX_DIM*(INOD-1)+1:MAX_DIM*INOD) + WRITE(33,'(3F24.16)') VERT_AUX(IAXIS:KAXIS) + ENDDO + CLOSE(33) - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) - ANGSEG(NSEG) = PI - ENDDO - ENDIF + ! Write faces: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_faces.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IWSEL=1,GEOMETRY(ING)%N_FACES + FACE_AUX(NOD1:NOD3)=GEOMETRY(ING)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + WRITE(33,'(4I10)') FACE_AUX(NOD1:NOD3),GEOMETRY(ING)%SURFS(IWSEL) + ENDDO + CLOSE(33) - ! Store Segment and Vertex list from Cartesian face boundary: - XYZVERT_CART(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - SEG_FACE_CART(NOD1:NOD2+3,1:NSEG) = SEG_FACE(NOD1:NOD2+3,1:NSEG) - NVERT_CART=NVERT; NSEG_CART = NSEG + ! Write Volumes: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_volus.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_VOLUS + VOL_AUX(NOD1:NOD4)=GEOMETRY(ING)%VOLUS(NODS_VLEL*(IEL-1)+1:NODS_VLEL*IEL) + WRITE(33,'(4I10)') VOL_AUX(NOD1:NOD4) + ENDDO + CLOSE(33) - ! 2. CC_INBOUNDARY cut-edges assigned to this face: - CEI = MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) - IF ( CEI > 0 ) THEN ! There are inboundary cut-edges - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + ! Write Edges: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edges.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_EDGES + WRITE(33,'(2I10)') GEOMETRY(ING)%EDGES(NOD1:NOD2,IEL) + ENDDO + CLOSE(33) - IBOD = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) - STYPE = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(5,IEDGE) + ! Write FACE_EDGES: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_fcedg.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_FACES + WRITE(33,'(3I10)') GEOMETRY(ING)%FACE_EDGES(NOD1:NOD3,IEL) + ENDDO + CLOSE(33) - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) + ! Write EDGE_FACES: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edfac.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_EDGES + WRITE(33,'(5I10)') GEOMETRY(ING)%EDGE_FACES(NOD1:NOD4+1,IEL) + ENDDO + CLOSE(33) - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) + ENDDO GEOM_LOOP +ENDIF DEBUG_SET_CUTCELLS_COND - ! ADD segment: - VEC(NOD1:NOD2) = (/ INOD1, INOD2 /) - ! Insertion ADD segment: - INLIST =.FALSE. - DO IDUM = 1,NSEG - IF ( (SEG_FACE(NOD1,IDUM)==VEC(NOD1)) .AND. (SEG_FACE(NOD2,IDUM)==VEC(NOD2)) ) THEN - IF ( (STYPE >= SEGTYPE(IDUM)) .AND. (BODNUM(IDUM) > IBOD) ) THEN - BODNUM(IDUM) = IBOD - SEGTYPE(IDUM)=STYPE - ENDIF - INLIST =.TRUE. - EXIT - ENDIF - IF ( (SEG_FACE(NOD2,IDUM)==VEC(NOD1)) .AND. (SEG_FACE(NOD1,IDUM)==VEC(NOD2)) ) THEN - IF ( (STYPE >= SEGTYPE(IDUM)) .AND. (BODNUM(IDUM) > IBOD) ) THEN - SEG_FACE(NOD1:NOD2,IDUM) = VEC(NOD1:NOD2) - BODNUM(IDUM) = IBOD - SEGTYPE(IDUM) =STYPE - ENDIF - INLIST =.TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ VEC(NOD1:NOD2), CC_ETYPE_CFINB, CEI, IEDGE /) - BODNUM(NSEG) = IBOD - SEGTYPE(NSEG) = STYPE - DX3 = XYZVERT(X3AXIS,INOD2)-XYZVERT(X3AXIS,INOD1) - DX2 = XYZVERT(X2AXIS,INOD2)-XYZVERT(X2AXIS,INOD1) - ANGSEG(NSEG) = ATAN2(DX3,DX2) - ENDIF - ENDDO - ENDIF +! Select MESHES assigned to MY_RANK and OMESHES of these. Cut-cells computed for all of them. Done in GET_GEOM_TRIBIN +IF (GET_CUTCELLS_VERBOSE) THEN + NMESH_CC=0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH(NOM)) NMESH_CC = NMESH_CC + 1 + ENDDO + ! MY_RANK = 0 writes first: + IF (MY_RANK==0) THEN + ! Open file to write SET_CUTCELLS_3D progress: + WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' + OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') + WRITE(LU_ERR,*) ' ' + WRITE(LU_ERR,*) '2. Generate Cut-cells in Meshes :' + WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC, & + ' meshes in file ',TRIM(VERBOSE_FILE),'.' + WRITE(LU_SETCC,*) ' ' + WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' + WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC,' meshes.' + WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' + WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process : ' + NMESH_CC_AUX = 0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH(NOM)) THEN + NMESH_CC_AUX = NMESH_CC_AUX + 1 + IF(NMESH_CC_AUX < NMESH_CC) THEN + WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' + WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' + ELSE + WRITE(LU_ERR,'(I4.4,A)') NOM,'.' + WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' + ENDIF + ENDIF + ENDDO + ENDIF + IF (N_MPI_PROCESSES > 1) THEN + IF (MY_RANK==0) ALLOCATE(CC_COMPUTE_MESH_AUX(1:NMESHES)) + ! Now rest of processes pass their mesh info to process 0: + DO IPROC=1,N_MPI_PROCESSES-1 + TAG = 0 + IF (MY_RANK==IPROC) THEN ! Send CC_COMPUTE_MESH array. + TAG=IPROC + CALL MPI_SEND(CC_COMPUTE_MESH(1),NMESHES,MPI_LOGICAL,0,TAG,MPI_COMM_WORLD,IERR) + ! Open file to write SET_CUTCELLS_3D progress: + WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' + OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') + WRITE(LU_SETCC,*) ' ' + WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' + WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC,' meshes.' + WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process :' + NMESH_CC_AUX = 0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH(NOM)) THEN + NMESH_CC_AUX = NMESH_CC_AUX + 1 + IF ( NMESH_CC_AUX < NMESH_CC ) THEN + WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' + ELSE + WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' + ENDIF + ENDIF + ENDDO + ELSEIF (MY_RANK==0) THEN ! Receive CC_COMPUTE_MESH array and write. + TAG=IPROC + CALL MPI_RECV(CC_COMPUTE_MESH_AUX(1),NMESHES,MPI_LOGICAL,IPROC,TAG,MPI_COMM_WORLD,MPISTATUS,IERR) + ! Write to LU_ERR: + NMESH_CC=0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH_AUX(NOM)) NMESH_CC = NMESH_CC + 1 + ENDDO + WRITE(VERBOSE_FILE_AUX,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',IPROC,'.log' + WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC, & + ' meshes in file ',TRIM(VERBOSE_FILE_AUX),'.' + WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' + NMESH_CC_AUX = 0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH_AUX(NOM)) THEN + NMESH_CC_AUX = NMESH_CC_AUX + 1 + IF ( NMESH_CC_AUX < NMESH_CC ) THEN + WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' + ELSE + WRITE(LU_ERR,'(I4.4,A)') NOM,'.' + ENDIF + ENDIF + ENDDO + ENDIF + CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) + ENDDO + IF (MY_RANK==0) DEALLOCATE(CC_COMPUTE_MESH_AUX) + ENDIF + CALL CPU_TIME(CPUTIME_START_MESH) +ENDIF - ! IF(INDI==14 .AND. INDJ==2 .AND. INDK==5 .AND. X1AXIS==KAXIS) THEN - ! OPEN(666,FILE='VERTS_FC0.txt',STATUS='REPLACE') - ! DO IDUM=1,NVERT - ! WRITE(666,*) XYZVERT(1:3,IDUM) - ! ENDDO - ! CLOSE(666) - ! OPEN(666,FILE='SEGS_FC0.txt',STATUS='REPLACE') - ! DO ISEG=1,NSEG - ! WRITE(666,*) SEG_FACE(NOD1:NOD2,ISEG),ANGSEG(ISEG),SEGTYPE(ISEG) - ! ENDDO - ! CLOSE(666) - ! ENDIF +IF(N_GEOMETRY>0) THEN + ALLOCATE(GEOM_AREA_SURF_OLD(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_OLD=0._EB + ALLOCATE(GEOM_AREA_SURF_NEW(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_NEW=0._EB +ENDIF - NOTDONE = .TRUE. - DO WHILE(NOTDONE) - NOTDONE = .FALSE. - ! Counts edges that reach nodes: - NUMEDG_NODE(1:CC_MAXVERTS_FACE) = 0 - DO ISEG=1,NSEG - DO II2=NOD1,NOD2 - INOD = SEG_FACE(II2,ISEG) - NUMEDG_NODE(INOD) = NUMEDG_NODE(INOD) + 1 - ENDDO - ENDDO +END SUBROUTINE CC_GRID_GLOBAL_INIT - ! Drop segments with NUMEDG_NODE(INOD)=1: - ! The assumption here is that they are CC_GG CC_INBOUNDCF - ! segments with one node inside the Cartface i.e. case Fig - ! 9(a) in the CompGeom3D notes): - COUNT = 0 - SEG_FACEAUX (NOD1:NOD2+3,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED - ANGSEGAUX(1:CC_MAXCEELEM_FACE) = 0._EB - SEGTYPEAUX(1:CC_MAXCEELEM_FACE) = CC_UNDEFINED - DO ISEG=1,NSEG - NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) - NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) - IF ((NUMNOD1 > 1) .AND. (NUMNOD2 > 1)) THEN - COUNT = COUNT + 1 - SEG_FACEAUX(NOD1:NOD2+3,COUNT) = SEG_FACE(NOD1:NOD2+3,ISEG) - ANGSEGAUX(COUNT) = ANGSEG(ISEG) - SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) - ELSE - NOTDONE = .TRUE. - ENDIF - ENDDO - NSEG = COUNT - SEG_FACE = SEG_FACEAUX - ANGSEG = ANGSEGAUX - SEGTYPE = SEGTYPEAUX - ENDDO +SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH - ! Discard face with no conected edges: - IF ( (NSEG==0) .OR. (NSEG==2 .AND. ( ANY(SEG_FACE(NOD1:NOD2,1)==SEG_FACE(NOD2,2)) .AND. & - ANY(SEG_FACE(NOD1:NOD2,1)==SEG_FACE(NOD1,2)) )) ) THEN - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID - CYCLE - ENDIF +CALL CC_GRID_ALLOCATE_BUILD_SCRATCH_WORK(FIRST_CALL_ARG,FIRST_CALL_ARG2) - ! Add segments which have both ends attached to more than two segs: - count = 0 - DO ISEG=1,NSEG - COUNT = COUNT + 1 - SEG_FACEAUX (NOD1:NOD2+3,COUNT) = SEG_FACE(NOD1:NOD2+3,ISEG) - ANGSEGAUX(COUNT) = ANGSEG(ISEG) - !SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) - IF (SEGTYPE(ISEG)==1) THEN - COUNT = COUNT + 1 - SEG_FACEAUX (NOD1:NOD2+3,COUNT) = SEG_FACE( (/ NOD2, NOD1, 3, 4, 5 /),ISEG) - !SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) - IF (ANGSEG(ISEG) > 0._EB) THEN - ANGSEGAUX(COUNT) = ANGSEG(ISEG) - PI - ELSE - ANGSEGAUX(COUNT) = ANGSEG(ISEG) + PI - ENDIF - ENDIF - ENDDO - NSEG = COUNT - SEG_FACE = SEG_FACEAUX - ANGSEG = ANGSEGAUX - !SEGTYPE = SEGTYPEAUX +END SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH - ! Fill NODEDG_FACE(IEDGE,INOD), where iedge are edges - ! that contain inod as first node. This assumes edges are - ! ordered using the right hand rule on x2-x3 plane. - ! Also compute the edges angles in x2-x3 plane: - ! Reallocate NODEDG_FACE if NSEG+1 > SIZE_EDGES_NODEDG, or NVERT > SIZE_VERTS_NODEDG: - CALL REALLOCATE_NODEDG_FACE(NSEG,NVERT) - NODEDG_FACE(:,:) = 0 - DO ISEG=1,NSEG - INOD1 = SEG_FACE(NOD1,ISEG) - NEDI = NODEDG_FACE(1,INOD1) + 1 ! Increase number of edges connected to node by 1. - NODEDG_FACE( 1,INOD1) = NEDI - NODEDG_FACE(NEDI+1,INOD1) = ISEG - ENDDO +SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH - ! Now Reorder Segments, do tests: - SEG_FACE2(NOD1:NOD3+1,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED ! [INOD1 INOD2 ICF] - SEG_FLAG(1:CC_MAXCEELEM_FACE) = .TRUE. +CALL CC_GRID_RELEASE_BUILD_SCRATCH_WORK - ICF = 1 - ISEG = 1 - NEWSEG = ISEG - COUNT= 1 - CTSTART=COUNT - SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG), SEG_FACE(NOD2,NEWSEG), ICF, NEWSEG /) - SEG_FLAG(ISEG) = .FALSE. - NSEG_LEFT = NSEG - 1 +END SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH - ! Infamous infinite loop: - INF_LOOP : DO +SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH(NM) - FOUNDSEG = .FALSE. - N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. - ANGCOUNT = ANGSEG(NEWSEG) +INTEGER, INTENT(IN) :: NM - ! Find Segment starting on Node 2 with smaller ANGSEG respect to COUNT. - DANG = -1._EB / GEOMEPS - DO ISS=2,NODEDG_FACE(1,N2COUNT)+1 - ISEG = NODEDG_FACE(ISS,N2COUNT) - IF ( SEG_FLAG(ISEG) ) THEN ! This seg hasn't been added to SEG_FACE2 - ! Drop if seg is the opposite of count seg, only when 2nd node is connected to more than 2 segments: - IF ( (SEG_FACE2(NOD1,COUNT)==SEG_FACE(NOD2,ISEG)) .AND. (NUMEDG_NODE(N2COUNT)>2) ) CYCLE - DANGI = ANGSEG(ISEG) - ANGCOUNT - IF ( DANGI < 0._EB ) DANGI = DANGI + 2._EB * PI - IF ( DANGI > DANG ) THEN - NEWSEG = ISEG - DANG = DANGI - FOUNDSEG = .TRUE. - ENDIF - ENDIF - ENDDO +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 - ! Found a seg add to SEG_FACE2: - IF ( FOUNDSEG ) THEN - COUNT = COUNT + 1 - SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG),SEG_FACE(NOD2,NEWSEG),ICF,NEWSEG /) - SEG_FLAG(NEWSEG) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - ENDIF +CALL POINT_TO_MESH(NM) +M => MESHES(NM) +! Mesh sizes: +NXB=IBAR +NYB=JBAR +NZB=KBAR - ! Test if line has closed on point shared any other cutface: - IF ( SEG_FACE2(NOD2,COUNT) == SEG_FACE2(NOD1,CTSTART) ) THEN - ! Go for new cut-face on this Cartesian face. - ELSEIF ( FOUNDSEG ) THEN - CYCLE - ENDIF +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) +CALL CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) - ! Break loop: - IF ( NSEG_LEFT == 0 ) EXIT +REGCC_REGION_IF : IF(PERIODIC_TEST==7 .OR. PERIODIC_TEST==11) THEN - ! Start a new cut-face on this Cartesian face: - ICF = ICF + 1 - DO ISEG=1,NSEG - IF ( SEG_FLAG(ISEG) ) THEN - COUNT = COUNT + 1 - CTSTART= COUNT - SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,ISEG), SEG_FACE(NOD2,ISEG), ICF, ISEG /) - SEG_FLAG(ISEG) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - EXIT - ENDIF - ENDDO + CALL GET_REGULAR_CUTCELLS_BOX - ENDDO INF_LOOP +ELSE - ! Load ordered nodes to CFELEM: - NFACE = ICF - ! Reallocate CFELEM ARRAY if necessary: - CALL REALLOCATE_LOCAL_CFELEM(NSEG,NFACE) - CFELEM(:,:) = CC_UNDEFINED; CEDGES(:,:) = CC_UNDEFINED - DO ICF=1,NFACE - NP = 0 - DO ISEG=1,NSEG - IF ( SEG_FACE2(NOD3,ISEG) == ICF ) THEN - NP = NP + 1 - CFELEM(1,ICF) = NP - CFELEM(NP+1,ICF) = SEG_FACE2(NOD1,ISEG) - CEDGES(1,ICF) = CFELEM(1,ICF); CEDGES(NP+1,ICF) = SEG_FACE2(NOD3+1,ISEG) ! Index in SEG_FACE. - ENDIF - ENDDO - ENDDO + CALL CC_GRID_BUILD_CUTCELL_MESH_WORK(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) - ALLOCATE(CFELEM2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CFELEM2 = CC_UNDEFINED - ALLOCATE(CEDGES2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CEDGES2 = CC_UNDEFINED - NP=0 - DO ICF=1,NFACE - IF(CFELEM(1,ICF)>2) THEN - NP=NP+1 - CFELEM2(:,NP) = CFELEM(:,ICF) - CEDGES2(:,NP) = CEDGES(:,ICF) - ENDIF - ENDDO - CALL MOVE_ALLOC(FROM=CFELEM2,TO=CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES2,TO=CEDGES) - NFACE = NP +ENDIF REGCC_REGION_IF - ! Compute area and Centroid, in local x1, x2, x3 coords: - ALLOCATE(DROPFACE(1:NFACE)); DROPFACE=.FALSE. - AREAV(1:NFACE) = 0._EB - XYZCEN(IAXIS:KAXIS,1:NFACE) = 0._EB - INXAREA(IAXIS:KAXIS,1:NFACE) = 0._EB - INXSQAREA(IAXIS:KAXIS,1:NFACE) = 0._EB - DO ICF=1,NFACE - NP = CFELEM(1,ICF) - DO IPT=2,NP+1 - ICF_PT = CFELEM(IPT,ICF) - ! Define closed Polygon centered in First Point: - XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & - XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) - ENDDO - ICF_PT = CFELEM(2,ICF) - XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & - XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) +CALL CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) +CALL CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +CALL CC_GRID_RELEASE_CELLRT - ! Get Area and Centroid properties of Cut-face: - AREA = 0._EB - DO II2=1,NP - AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & - XY(JAXIS,II2) * XY(IAXIS,II2+1) ) - ENDDO - AREA = AREA / 2._EB - IF ( (AREA dot(e2,nc)=0: - INXSQAREA(JAXIS,ICF) = 0._EB - ! dot(e3,nc)*int(x3^2)dA, where nc=e1 => dot(e3,nc)=0: - INXSQAREA(KAXIS,ICF) = 0._EB +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 - ENDDO +CALL POINT_TO_MESH(NM) +M => MESHES(NM) +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) - ALLOCATE(CFELEM2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CFELEM2 = CC_UNDEFINED - ALLOCATE(CEDGES2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CEDGES2 = CC_UNDEFINED - NP=0 - DO ICF=1,NFACE - IF(.NOT.DROPFACE(ICF)) THEN - NP=NP+1 - CFELEM2(:,NP) = CFELEM(:,ICF) - CEDGES2(:,NP) = CEDGES(:,ICF) - ENDIF - ENDDO - CALL MOVE_ALLOC(FROM=CFELEM2,TO=CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES2,TO=CEDGES) - DEALLOCATE(DROPFACE) - IF (NP==0) THEN - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID - CYCLE - ENDIF - NFACE = NP +CALL CC_GRID_BLOCK_SPECIAL_CELLS(NM) +CALL CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) - ! Figure out if a cut-face is completely inside any of the - ! others (that is, it is a hole on the GASPHASE): - FINFACE = 0 - NFACE2 = NFACE - DO ICF1=1,NFACE2 - ! Test that ICF1 has a negative area (case of holes) - AREA1 = AREAV(ICF1) - IF ( AREA1 < -GEOMEPS ) THEN - DO ICF2=1,NFACE2 - ! Drop if same face: - IF ( ICF1 == ICF2 ) CYCLE +IF (ONE_CC_PER_CARTESIAN_CELL) THEN + ! Here Block all cells that have volume less (or equal) than the first largest cell found. + DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + CC=>MESHES(NM)%CUT_CELL(ICC1) + NCELL=0 + DO J=1,CC%NCELL + IF(CC%NOADVANCE(J)==NOT_BLOCKED) NCELL=NCELL+1 + ENDDO + IF(NCELL<2) CYCLE + ! Find if any GEOMETRY related to CC_INBOUNDARY faces has CELL_BLOCK_IOR>0: + CELL_BLOCK_IOR=0; CELL_BLOCK_ORIENTATION = 0._EB + NCELL_LOOP_1 : DO J=1,CC%NCELL + DO I=2,CC%CCELEM(1,J)+1 + IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN + ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) + IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) + IF(IG>0) THEN + IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN + CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION + ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN + CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR + EXIT NCELL_LOOP_1 + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO NCELL_LOOP_1 + ALLOCATE(VOLUME(1:CC%NCELL)); VOLUME(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN + ! Cell Block Orientation: + DO J=1,CC%NCELL; VOLUME(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)); ENDDO + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN + ! Make search for double precision min/max unambiguous. + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS,IAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) + CASE(-JAXIS,JAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) + CASE(-KAXIS,KAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) + END SELECT + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( IAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE(-JAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( JAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE(-KAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( KAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + END SELECT + ENDIF + DEALLOCATE(VOLUME) + NCELL_LOOP_2 : DO J=1,CC%NCELL + IF(J==I) CYCLE NCELL_LOOP_2 + IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL + ENDDO NCELL_LOOP_2 + ENDDO +ENDIF - ! Centroid node for ICF1: - XYC1(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF1 ) ! [x2axis x3axis] +CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) - ! Polygon nodes for ICF2: - NP2 = CFELEM(1,ICF2) - DO IPT=2,NP2+1 - ICF_PT = CFELEM(IPT,ICF2) - ! Define closed Polygon: - XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) - ENDDO +! Here: 1,2. Define Linking information for cut-cells. +CALL GET_CELL_LINK_INFO(NM) - CALL TEST_PT_INPOLY(NP2,XY,XYC1,PTSFLAG) +IF(PROCESS(NM)==MY_RANK) THEN ! Here Add Blocked Areas per SURF_ID: + ALLOCATE(MESHES(NM)%INBCF_AREA(0:MESHES(NM)%IBP1,0:MESHES(NM)%JBP1,0:MESHES(NM)%KBP1)) + DO K=1,M%KBAR + DO J=1,M%JBAR + DO I=1,M%IBAR + ICC = MESHES(NM)%CCVAR(I,J,K,CC_IDCC); IF(ICC<1) CYCLE + CC =>MESHES(NM)%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + IF(CC%NOADVANCE(JCC)<1) CYCLE + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE=CC%CCELEM(IFC,JCC) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO +ENDIF +CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) - IF ( PTSFLAG ) THEN ! Centroid of face 1 inside Face 2. +END SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH - FINFACE(ICF1) = ICF2 - NFACE = NFACE - 1 +! ----------------------- BLOCK_SMALL_UNLINKED_CUTCELLS ---------------------------- - ! Redefine areas in case of faces with holes: - AREA2 = AREAV(ICF2) +SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS(NM,NBLKCELLS) - ! Area with hole, AREA1 has negative sign: - AREAH = AREA2 + AREA1 +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(OUT):: NBLKCELLS - IF (ABS(AREAH) < GEOMEPS) THEN ! Hole of same size as cut-face, drop both. - FINFACE(ICF2) = ICF1 - CYCLE - ENDIF +INTEGER :: ICC,JCC,I,J,K,IFC,IEC,JEC,IVR,DUM,NSEG,ISEG,JFC,INOD1,INOD2,X1AXIS,COUNT,NCELL +TYPE(MESH_TYPE), POINTER :: M +CHARACTER(100) :: FILENAME + +M => MESHES(NM) +NBLKCELLS = 0 + +IF(DEBUG_SET_CUTCELLS) THEN + + ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges1.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH + DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH + CE=>MESHES(NM)%CUT_EDGE(IEC) + WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) + DO IVR=1,CE%NVERT + WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) + ENDDO + DO IVR=1,CE%NVERT + WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& + CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) + ENDDO + ENDDO + CLOSE(33) + + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces1.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH + DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 + IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 + WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) + DO IVR=1,CF%NVERT + WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(I6,I6)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) + DO DUM=1,CF%CFELEM(1,JFC) + WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) + ENDDO + DO DUM=1,CF%CEDGES(1,JFC) + WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) + ENDDO + ENDDO + DO ISEG=1,NSEG + WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) + ENDDO + ENDDO + CLOSE(33) +ENDIF - ! Centroid with hole: - XYC2(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF2 ) ! [x2axis x3axis] - XYH(1:2) = (AREA1 * XYC1(1:2) + AREA2 * XYC2(1:2)) / AREAH +! Create new cut-edges and faces: +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + JCC_LOOP : DO JCC=1,M%CUT_CELL(ICC)%NCELL + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP + NBLKCELLS = NBLKCELLS + 1 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,1) + ENDDO JCC_LOOP + ENDDO + ENDDO +ENDDO - ! So ICF2 has the area with hole properties: - AREAV(ICF2) = AREAH - XYZCEN(JAXIS,ICF2) = XYH(IAXIS) - XYZCEN(KAXIS,ICF2) = XYH(JAXIS) +! Drop cut-edges and faces that were gas or boundary of blocked cells. +COUNT=0 +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + NCELL = M%CUT_CELL(ICC)%NCELL + JCC_LOOP_2 : DO JCC=1,NCELL + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_2 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,2) + ENDDO JCC_LOOP_2 + ENDDO + ENDDO +ENDDO - ! Other geom variables: - INXAREA(IAXIS:KAXIS,ICF2) = INXAREA(IAXIS:KAXIS,ICF2)+ INXAREA(IAXIS:KAXIS,ICF1) - INXSQAREA(IAXIS:KAXIS,ICF2)=INXSQAREA(IAXIS:KAXIS,ICF2)+INXSQAREA(IAXIS:KAXIS,ICF1) +! Drop blocked cells: +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + NCELL = M%CUT_CELL(ICC)%NCELL + JCC_LOOP_3 : DO JCC=NCELL,1,-1 + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_3 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,3) + ENDDO JCC_LOOP_3 + ENDDO + ENDDO +ENDDO +! Build remaining Regular shaped GASPHASE cut-faces: +CALL GET_REMAINING_CUTFACES(NM) +! Build remaining Regular shaped GASPHASE cut-cells: +CALL GET_REMAINING_CUTCELLS(NM) +! Clean up CUT_CELL, CUT_FACE arrays: +CALL CUT_CELL_FACE_ARRAYS_CLEANUP(NM) - EXIT - ENDIF - ENDDO - ENDIF - ENDDO +IF(DEBUG_SET_CUTCELLS) THEN + ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges2.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH + DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH + CE=>MESHES(NM)%CUT_EDGE(IEC) + WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) + DO IVR=1,CE%NVERT + WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) + ENDDO + DO IVR=1,CE%NVERT + WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& + CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) + ENDDO + ENDDO + CLOSE(33) - ! Now enhance CFELEM for faces with holes nodes: - DO ICF1=1,NFACE2 - ICF2 = FINFACE(ICF1) - IF ( ICF2 > 0 ) THEN ! Allows for up to one hole per CC_GASPHASE cut-face. - ! Load points - NP1 = CFELEM(1,ICF1) - NP2 = CFELEM(1,ICF2) - NP = (NP1+1) + (NP2+1) + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces2.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH + DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 + IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 + WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) + DO IVR=1,CF%NVERT + WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(I8,I8)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) + DO DUM=1,CF%CFELEM(1,JFC) + WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) + ENDDO + DO DUM=1,CF%CEDGES(1,JFC) + WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) + ENDDO + ENDDO + DO ISEG=1,NSEG + WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) + ENDDO + ENDDO + CLOSE(33) - ! Here reallocate CFELEM, CEDGES CFE, CFEL if NP > SIZE_VERTS_CFELEM: - CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) - CFE(1) = NP + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeECVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%ECVAR(I,J,K,CC_EGSC,IAXIS),& + M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) + DO X1AXIS=IAXIS,KAXIS + IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN + IEC=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) + IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT EDGE does not match ECVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE + DO JEC=1,CE%NEDGE + INOD1=CE%CEELEM(NOD1,JEC) + INOD2=CE%CEELEM(NOD2,JEC) + WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) + WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) + IF(CE%VERT_LIST(1,INOD1)==CE%VERT_LIST(1,INOD2) .AND. & + CE%VERT_LIST(2,INOD1)==CE%VERT_LIST(2,INOD2) .AND. & + CE%VERT_LIST(3,INOD1)==CE%VERT_LIST(3,INOD2) .AND. & + CE%VERT_LIST(4,INOD1)==CE%VERT_LIST(4,INOD2)) THEN + IF(CE%VERT_LIST(1,INOD1)/=CC_VTYPE_NINB) & + WRITE(LU_ERR,*) 'Edge with same node types=',IEC,JEC,CE%NEDGE,CE%XYZVERT(:,INOD1),& + CE%XYZVERT(:,INOD2),CE%VERT_LIST(1:4,INOD1) + ENDIF + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CLOSE(33) - DO II2=2,NP1+1 - CFE(II2) = CFELEM(II2,ICF1) - ENDDO - II2 = (NP1+1) + 1 - CFE(II2) = CFELEM(2,ICF1) + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + DO X1AXIS=IAXIS,KAXIS + IF(M%FCVAR(I,J,K,CC_IDCE,X1AXIS)>0)THEN + IEC=M%FCVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) + IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT EDGE does not match FCVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE + DO JEC=1,CE%NEDGE + INOD1=CE%CEELEM(NOD1,JEC) + INOD2=CE%CEELEM(NOD2,JEC) + WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) + WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CLOSE(33) - ! Load last point location: - ILOC = 2 - DIST12 = 1._EB / GEOMEPS - XYC1(1:2) = (/ XYZVERT(X2AXIS,CFE(II2)), XYZVERT(X3AXIS,CFE(II2)) /) - DO COUNT=2,NP2+1 - XYC2(1:2) = (/ XYZVERT(X2AXIS,CFELEM(COUNT,ICF2)), XYZVERT(X3AXIS,CFELEM(COUNT,ICF2)) /) - D12 = SQRT( (XYC1(1)-XYC2(1))**2._EB + (XYC1(2)-XYC2(2))**2._EB ) - IF( D12 < DIST12 ) THEN - DIST12 = D12 - ILOC = COUNT - ENDIF - ENDDO - IF (ILOC > 2) THEN - ! Rebuild CFELEM(:,ICF2) such that the first point is ILOC: - CFEL(2:2+(NP2+1)-ILOC) = CFELEM(ILOC:NP2+1,ICF2) - CFEL(3+(NP2+1)-ILOC:NP2+1)= CFELEM(2:ILOC-1 ,ICF2) - CFELEM(2:NP2+1 ,ICF2) = CFEL(2:NP2+1) - CFEL(2:2+(NP2+1)-ILOC) = CEDGES(ILOC:NP2+1,ICF2) - CFEL(3+(NP2+1)-ILOC:NP2+1)= CEDGES(2:ILOC-1 ,ICF2) - CEDGES(2:NP2+1 ,ICF2) = CFEL(2:NP2+1) - ENDIF - COUNT = 1 - DO II2=(NP1+1)+2,(NP1+1)+1+NP2 - COUNT = COUNT + 1 - CFE(II2) = CFELEM(COUNT,ICF2) - ENDDO - II2 = NP + 1 - CFE(II2) = CFELEM(2,ICF2) + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaceFCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%FCVAR(I,J,K,CC_FGSC,IAXIS),& + M%FCVAR(I,J,K,CC_FGSC,JAXIS),M%FCVAR(I,J,K,CC_FGSC,KAXIS) + DO X1AXIS=IAXIS,KAXIS + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)==CC_CUTCFE)THEN + IEC=M%FCVAR(I,J,K,CC_IDCF,X1AXIS); CF=>M%CUT_FACE(IEC) + IF(CF%IJK(IAXIS)/=I .OR. CF%IJK(JAXIS)/=J .OR. CF%IJK(KAXIS)/=K .OR. CF%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT FACE does not match FCVAR',I,J,K,X1AXIS,':',CF%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE + DO JEC=1,CF%NFACE + WRITE(33,'(I8,3F16.8,F16.8)') CF%IJK(4),CF%XYZCEN(:,JEC),CF%AREA(JEC) + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CLOSE(33) - ! Copy CFE into CFELEM(1:np+1,icf2): - CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutcellCCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8)') I,J,K,M%CCVAR(I,J,K,CC_CGSC) + IF(M%CCVAR(I,J,K,CC_CGSC)==CC_CUTCFE)THEN + IEC=M%CCVAR(I,J,K,CC_IDCC); CC=>M%CUT_CELL(IEC) + IF(CC%IJK(IAXIS)/=I .OR. CC%IJK(JAXIS)/=J .OR. CC%IJK(KAXIS)/=K) & + WRITE(LU_ERR,*) 'CUT CELL does not match CCVAR',I,J,K,':',CC%IJK(IAXIS:KAXIS) + WRITE(33,'(I8,I8,I8,I8,I8)') CC%IJK(1:3),CC%NCELL + DO JEC=1,CC%NCELL + WRITE(33,'(I8,3F16.8,F16.8)') JEC,CC%XYZCEN(:,JEC),CC%VOLUME(JEC) + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + CLOSE(33) +ENDIF - ! Rearrange CEDGES - CFEL(1) = NP - CFEL(2:NP1+1) = CEDGES(2:NP1+1,ICF1) - CFEL(NP1+2) = 0 ! ENTRY 0 in EDGE_LIST, EDGE inside the SOLID. - CFEL(NP1+3:NP1+2+NP2)= CEDGES(2:NP2+1,ICF2) - CFEL(NP+1) = 0 ! ENTRY 0 in EDGE_LIST, EDGE inside the SOLID. - CEDGES(1:NP+1,ICF2) = CFEL(1:NP+1) +RETURN +END SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS - ENDIF - ENDDO +! ------------------------- GET_REMAINING_CUTCELLS -------------------------------- - NVERTFACE = MAXVAL(CFELEM(1,1:NFACE)) + 1 +SUBROUTINE GET_REMAINING_CUTCELLS(NM) - ! This is a cut-face, allocate space: - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCF,X1AXIS) = NCUTFACE +! Define regular cut-cells for regular cartesian cells surrounded by a gas cut-face. +INTEGER, INTENT(IN) :: NM - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +! Local Variables: +INTEGER :: I,J,K,CT,X1AXIS,SIDE,ICC,JCC,IFACE,ICF,JCF,ICFC,ICFINB,NCFACE_CUTCELL,NCELL,NFACE_CELL +INTEGER :: NCC_MESH,NGC_MESH,NCELL_IN,NCELL_GC,COUNT_CC,COUNT_GC +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME +INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX +LOGICAL, PARAMETER :: OPT=.TRUE. - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ INDI, INDJ, INDK, X1AXIS /) - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE,IBNDINT) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - ALLOCATE(CF%EDGE_LIST(3,0:NSEG)); - CF%EDGE_LIST( : , 0) = CC_UNDEFINED ! Segment inside the solid volume. - CF%EDGE_LIST(1:3,1:NSEG) = SEG_FACE(3:5,1:NSEG) - ALLOCATE(CF%CEDGES(SIZE(CEDGES,DIM=1),SIZE(CEDGES,DIM=2))) - CF%CEDGES = CC_UNDEFINED - ! Load Ordered nodes to CFELEM and geom properties: - COUNT = 0 - DO ICF=1,NFACE2 - IF ( FINFACE(ICF) > 0 ) CYCLE ! icf is a hole on another cut-face. - COUNT = COUNT + 1 - ! Connectivity: - CF%CFELEM(1:NVERTFACE,COUNT) = CFELEM(1:NVERTFACE, ICF) - CF%CEDGES(1:NVERTFACE,COUNT) = CEDGES(1:NVERTFACE, ICF) - ! Geom Properties: - CF%AREA(COUNT) = AREAV(ICF) - CF%XYZCEN(IAXIS:KAXIS,COUNT) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,ICF) - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: - CF%INXAREA(COUNT) = INXAREA(XIAXIS,ICF) - ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: - CF%INXSQAREA(COUNT) = INXSQAREA(XIAXIS,ICF) - ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: - CF%JNYSQAREA(COUNT) = INXSQAREA(XJAXIS,ICF) - ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: - CF%KNZSQAREA(COUNT) = INXSQAREA(XKAXIS,ICF) - ENDDO - ! Final number of cut-faces in the gas region of the face: - NFACE = COUNT - CF%NFACE = NFACE +M => MESHES(NM) - ! ! Test that cut-edge nodes in EDGE list match nodes defined in CF XYZVERT: - ! IIF= CF%IJK(IAXIS) - ! JJF= CF%IJK(JAXIS) - ! KKF= CF%IJK(KAXIS) - ! DO ICF = 1, CF%NFACE - ! DO ISEG=1,CF%CEDGES(1,ICF) - ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) - ! IF (ISEGGEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN - ! WRITE(LU_ERR,*) 'Found difference in RGGAS SEGMENT=',NCUTFACE,ICF,ISEG,':',X1AXIS,AXIS,SIDE - ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) - ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) - ! ENDIF - ! CASE(CC_ETYPE_CFGAS) - ! IEC=CF%EDGE_LIST(2,IEDGE); JEC=CF%EDGE_LIST(3,IEDGE) - ! INOD1 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(1,JEC) - ! INOD2 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(2,JEC) - ! CEIJK(1:4) = MESHES(NM)%CUT_EDGE(IEC)%IJK(1:4) - ! SELECT CASE(X1AXIS) - ! CASE(IAXIS) - ! IF (CEIJK(4)==JAXIS) THEN - ! IF(CEIJK(KAXIS)==KKF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ELSEIF(CEIJK(KAXIS)==KKF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ENDIF - ! ELSEIF(CEIJK(4)==KAXIS) THEN - ! IF(CEIJK(JAXIS)==JJF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ELSEIF(CEIJK(JAXIS)==JJF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ENDIF - ! ENDIF - ! CASE(JAXIS) - ! IF (CEIJK(4)==IAXIS) THEN - ! IF(CEIJK(KAXIS)==KKF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ELSEIF(CEIJK(KAXIS)==KKF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ENDIF - ! ELSEIF(CEIJK(4)==KAXIS) THEN - ! IF(CEIJK(IAXIS)==IIF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ELSEIF(CEIJK(IAXIS)==IIF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ENDIF - ! ENDIF - ! CASE(KAXIS) - ! IF (CEIJK(4)==IAXIS) THEN - ! IF(CEIJK(JAXIS)==JJF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ELSEIF(CEIJK(JAXIS)==JJF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ENDIF - ! ELSEIF(CEIJK(4)==JAXIS) THEN - ! IF(CEIJK(IAXIS)==IIF-1) THEN ! LOW_IND - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! ELSEIF(CEIJK(IAXIS)==IIF) THEN ! HIGH_SIDE - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! ENDIF - ! ENDIF - ! END SELECT - ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN - ! WRITE(LU_ERR,*) 'Found difference in CFGAS SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC - ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) - ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) - ! ENDIF - ! CASE(CC_ETYPE_CFINB) - ! IEC=CF%EDGE_LIST(2,IEDGE); JEC=CF%EDGE_LIST(3,IEDGE) - ! INOD1 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(1,JEC) - ! INOD2 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(2,JEC) - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! IF(NORM2(X1E-X1V)>GEOMEPS) THEN - ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT - ! ENDIF - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN - ! WRITE(LU_ERR,*) 'CARTF Found difference in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC - ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) - ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) - ! ENDIF - ! END SELECT - ! ENDDO - ! ENDDO +! First thing is, for known cut-cells with reg faces that have changed to cut-faces to change the +! FACE_LIST incidence: +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_CUTCFE) CYCLE + ICC=M%CCVAR(I,J,K,CC_IDCC) + CC=>M%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + DO ICF=2,CC%CCELEM(1,JCC)+1 + IFACE = CC%CCELEM(ICF,JCC) + SIDE = CC%FACE_LIST(2,IFACE) + X1AXIS= CC%FACE_LIST(3,IFACE) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE + ICFC = M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS) + IF(ICFC>0) CC%FACE_LIST(:,IFACE) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) ! New cut-face. + ENDDO + ENDDO + ENDDO + ENDDO +ENDDO - ! HERE WE LOAD CARTESIAN CUT FACES THAT BELONG TO THE SOLID REGION, FOR SLICE PLOTTING - ! PURPOSES: - ! ------------------------------------------------------------------------------------ - SOLID_FACE_IF : IF (GET_SOLID_CUTFACES) THEN - ! Build segment list: - NSSEG = 0 - NSVERT = 0 - NSFACE = 0 +IF (OPT) THEN - SEG_FACE (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED - XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) = 0._EB - ANGSEG(1:CC_MAXCEELEM_FACE) = 0._EB +NCC_MESH = M%N_CUTCELL_MESH +NGC_MESH = M%N_GCCUTCELL_MESH - ! First Add to vertex list INBOUNDARY vertices and SOLID Cartesian vertices: - CEI = MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) - IF ( CEI > 0 ) THEN ! There are inboundary cut-edges - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) +! First count how many new cells are goint to be created inside, and in ghost cell region: +NCELL_IN=0 +NCELL_GC=0 +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE + ! Test for gas cut-faces: + CT=0 + IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + IF(K<1 .OR. K>M%KBAR .OR. J<1 .OR. J>M%JBAR .OR. I<1 .OR. I>M%IBAR) THEN + NCELL_GC = NCELL_GC + 1 + ELSE + NCELL_IN = NCELL_IN + 1 + ENDIF + ENDDO + ENDDO +ENDDO - ! Here we use the SOLID orientation NOD1:NOD2 for right hand rule (inverse of GASPHASE cut-faces) - ! x,y,z of node 1: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) +! Reset CCVAR, CELL_LIST indexes: +DO K=-CCGUARD,M%KBAR+CCGUARD + DO J=-CCGUARD,M%JBAR+CCGUARD + DO I=-CCGUARD,M%IBAR+CCGUARD + ! All GC cut-cells get their index + NCELL_IN + IF(M%CCVAR(I,J,K,CC_IDCC)<=NCC_MESH) CYCLE + M%CCVAR(I,J,K,CC_IDCC)=M%CCVAR(I,J,K,CC_IDCC) + NCELL_IN + ENDDO + ENDDO +ENDDO +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + DO JCF=1,M%CUT_FACE(ICF)%NFACE + IF(M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>NCC_MESH) & + M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + NCELL_IN + IF(M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>NCC_MESH) & + M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + NCELL_IN + ENDDO +ENDDO - ! x,y,z of node 2: - XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD2,XYZVERT) +! Make space for NCELL_IN, NCELL_GC cut-cell entries. +ALLOCATE(CUT_CELL_AUX( MAX(SIZE(M%CUT_CELL,DIM=1),NCC_MESH + NCELL_IN +NGC_MESH + NCELL_GC) )) +CUT_CELL_AUX(1:NCC_MESH) = M%CUT_CELL(1:NCC_MESH) +CUT_CELL_AUX(NCC_MESH+NCELL_IN+1:NCC_MESH+NCELL_IN+NGC_MESH) = M%CUT_CELL(NCC_MESH+1:NCC_MESH+NGC_MESH) +CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL); M=> MESHES(NM) - ! ADD segment: - NSSEG = NSSEG + 1 - SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ INOD1, INOD2 /) - DX3 = XYZVERT(X3AXIS,INOD2)-XYZVERT(X3AXIS,INOD1) - DX2 = XYZVERT(X2AXIS,INOD2)-XYZVERT(X2AXIS,INOD1) - ANGSEG(NSSEG) = ATAN2(DX3,DX2) +! Then build new regular cut-cells: +COUNT_CC = 0 +COUNT_GC = 0 +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE + ! Test for gas cut-faces: + CT=0 + IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE - ENDDO - ENDIF + ! Count allocation number for faces boundary of this cut-cell: + CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT - ! Now add CC_SOLID Type vertices: - ! Vertex at index JJ-1,KK-1: - INDXI1(IAXIS:KAXIS) = (/ II, JJ-1, KK-1 /) ! Local x1,x2,x3 - INDI1 = INDXI1(XIAXIS) - INDJ1 = INDXI1(XJAXIS) - INDK1 = INDXI1(XKAXIS) - ! Vertex at index JJ,KK-1: - INDXI2(IAXIS:KAXIS) = (/ II, JJ , KK-1 /) ! Local x1,x2,x3 - INDI2 = INDXI2(XIAXIS) - INDJ2 = INDXI2(XJAXIS) - INDK2 = INDXI2(XKAXIS) - ! Vertex at index JJ,KK: - INDXI3(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 - INDI3 = INDXI3(XIAXIS) - INDJ3 = INDXI3(XJAXIS) - INDK3 = INDXI3(XKAXIS) - ! Vertex at index JJ-1,KK: - INDXI4(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 - INDI4 = INDXI4(XIAXIS) - INDJ4 = INDXI4(XJAXIS) - INDK4 = INDXI4(XKAXIS) + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED + + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO X1AXIS=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND + ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO + + ! Add INB cut-face if any present: + IF(ICFINB>0) THEN + DO JCF=1,M%CUT_FACE(ICFINB)%NFACE + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDDO + ENDIF + + ! Insert cut_cell: + IF(K<1 .OR. K>MESHES(NM)%KBAR .OR. J<1 .OR. J>MESHES(NM)%JBAR .OR. I<1 .OR. I>MESHES(NM)%IBAR) THEN + COUNT_GC = COUNT_GC + 1 + ICC = NCC_MESH + NCELL_IN + NGC_MESH + COUNT_GC + ELSE + COUNT_CC = COUNT_CC + 1 + ICC = NCC_MESH + COUNT_CC + ENDIF + CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M%CUT_CELL(ICC)%NCELL = NCELL + M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + M%CUT_CELL(ICC)%NFACE_DROPPED = 0 + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) + M%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) + M%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE + M%CCVAR(I,J,K,CC_IDCC) = ICC + ENDDO + ENDDO +ENDDO + +M%N_CUTCELL_MESH = NCC_MESH + NCELL_IN +M%N_GCCUTCELL_MESH = NGC_MESH + NCELL_GC + +ELSE + +! Then build new regular cut-cells: +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE + ! Test for gas cut-faces: + CT=0 + IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + + ! Count allocation number for faces boundary of this cut-cell: + CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT + + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED + + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO X1AXIS=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND + ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO + + ! Add INB cut-face if any present: + IF(ICFINB>0) THEN + DO JCF=1,M%CUT_FACE(ICFINB)%NFACE + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDDO + ENDIF + + ! Insert cut_cell: + CALL INSERT_CUT_CELL(NM,I,J,K,ICC); M => MESHES(NM) + CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M%CUT_CELL(ICC)%NCELL = NCELL + M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) + ENDDO + ENDDO +ENDDO + +ENDIF + +END SUBROUTINE GET_REMAINING_CUTCELLS + + +! ------------------------- GET_REMAINING_CUTFACES -------------------------------- - IF(MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID ) THEN - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI1(IAXIS)), X2FACE(INDXI1(JAXIS)), X3FACE(INDXI1(KAXIS)) /) - X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) - ENDIF +SUBROUTINE GET_REMAINING_CUTFACES(NM) - IF(MESHES(NM)%VERTVAR(INDI2,INDJ2,INDK2,CC_VGSC) == CC_SOLID ) THEN - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI2(IAXIS)), X2FACE(INDXI2(JAXIS)), X3FACE(INDXI2(KAXIS)) /) - X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) - ENDIF +! Running by axes define regular cut-faces, add to CUT_FACE array. - IF(MESHES(NM)%VERTVAR(INDI3,INDJ3,INDK3,CC_VGSC) == CC_SOLID ) THEN - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI3(IAXIS)), X2FACE(INDXI3(JAXIS)), X3FACE(INDXI3(KAXIS)) /) - X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) - ENDIF +INTEGER, INTENT(IN) :: NM - IF(MESHES(NM)%VERTVAR(INDI4,INDJ4,INDK4,CC_VGSC) == CC_SOLID ) THEN - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI4(IAXIS)), X2FACE(INDXI4(JAXIS)), X3FACE(INDXI4(KAXIS)) /) - X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) - XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) - ENDIF +! Local Variables: +INTEGER :: I,J,K,CT,X1AXIS,X2AXIS,X3AXIS,IFC,CEI,CEIF,ICC,JCC,ICE,IEDGE,ILOC,IFACE +INTEGER :: NBD_MESH,NCF_MESH,NGF_MESH,NFC_BND,NFC_MSH,NFC_GCR,CT_BND,CT_MSH,CT_GCR,FCINDEX +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES,EDGE_LIST +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZVERT,XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA +TYPE(MESH_TYPE), POINTER :: M +LOGICAL, PARAMETER :: OPT=.TRUE. - ! Make List of HIGH X2 vertices, in ascending X3 order. Add segments: - ASCDESC=.TRUE. - XVERT1(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) - XVERT2(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) - CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X2FACE(JJ),ASCDESC,NV,V) - DO IV=1,NV-1 - NSSEG=NSSEG + 1 - SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) - ANGSEG(NSSEG) = PI / 2._EB - ENDDO +M => MESHES(NM) - ! Make list of HIGH X3 vertices, in descending X2 order. Add segments: - ASCDESC=.FALSE. - XVERT1(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) - XVERT2(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) - CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X3FACE(KK),ASCDESC,NV,V) - DO IV=1,NV-1 - NSSEG=NSSEG + 1 - SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) - ANGSEG(NSSEG) = PI - ENDDO +IF (OPT) THEN + +NBD_MESH = M%N_BBCUTFACE_MESH +NCF_MESH = M%N_CUTFACE_MESH +NGF_MESH = M%N_GCCUTFACE_MESH + +! First count EXT Boundary, In meshm and ghost cell region cut-faces: +NFC_BND = 0 +NFC_MSH = 0 +NFC_GCR = 0 +! IAXIS cut-faces: +X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-2,M%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%IBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External + ELSEIF(I==0 .OR. I==M%IBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary + ENDIF + ELSE; NFC_GCR = NFC_GCR + 1 ! External + ENDIF + ENDDO + ENDDO +ENDDO +! JAXIS cut-faces: +X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS +DO K=-1,M%KBAR+2 + DO J=-2,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%JBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External + ELSEIF(J==0 .OR. J==M%JBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary + ENDIF + ELSE; NFC_GCR = NFC_GCR + 1 ! External + ENDIF + ENDDO + ENDDO +ENDDO +! KAXIS cut-faces: +X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS +DO K=-2,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%KBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External + ELSEIF(K==0 .OR. K==M%KBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary + ENDIF + ELSE; NFC_GCR = NFC_GCR + 1 ! External + ENDIF + ENDDO + ENDDO +ENDDO + +! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): +DO K=-CCGUARD,M%KBAR+CCGUARD + DO J=-CCGUARD,M%JBAR+CCGUARD + DO I=-CCGUARD,M%IBAR+CCGUARD + FCINDEX = M%CCVAR(I,J,K,CC_IDCF) + IF(M%CCVAR(I,J,K,CC_IDCF)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(M%CCVAR(I,J,K,CC_IDCF)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + M%CCVAR(I,J,K,CC_IDCF) = FCINDEX + DO X1AXIS=IAXIS,KAXIS + FCINDEX = M%FCVAR(I,J,K,CC_IDCF,X1AXIS) + IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = FCINDEX + ENDDO + ENDDO + ENDDO +ENDDO +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC => M%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + SELECT CASE(CC%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_RCGAS); CYCLE + CASE DEFAULT + FCINDEX = CC%FACE_LIST(4,IFACE) + IF(CC%FACE_LIST(4,IFACE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(CC%FACE_LIST(4,IFACE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + CC%FACE_LIST(4,IFACE) = FCINDEX + END SELECT + ENDDO + ENDDO +ENDDO +DO ICE=1,M%N_CUTEDGE_MESH + CE=>M%CUT_EDGE(ICE) + DO IEDGE=1,CE%NEDGE + DO ILOC=-2,2 + FCINDEX = CE%FACE_LIST(1,ILOC,IEDGE) + IF(CE%FACE_LIST(1,ILOC,IEDGE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(CE%FACE_LIST(1,ILOC,IEDGE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + CE%FACE_LIST(1,ILOC,IEDGE) = FCINDEX + ENDDO + ENDDO +ENDDO + +! Reallocate CUT_FACE: +ALLOCATE(CUT_FACE_AUX( MAX(SIZE(MESHES(NM)%CUT_FACE,DIM=1), NCF_MESH+NFC_BND+NFC_MSH + NGF_MESH+NFC_GCR ) )) +CUT_FACE_AUX(1:NBD_MESH) = M%CUT_FACE(1:NBD_MESH) +CUT_FACE_AUX(NBD_MESH+NFC_BND+1:NCF_MESH+NFC_BND) = M%CUT_FACE(NBD_MESH+1:NCF_MESH) +CUT_FACE_AUX(NCF_MESH+NFC_BND+NFC_MSH+1:NCF_MESH+NFC_BND+NFC_MSH+NGF_MESH) = M%CUT_FACE(NCF_MESH+1:NCF_MESH+NGF_MESH) +CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE); M => MESHES(NM) + +! Finally, add new cut-faces: +CT_BND = 0 +CT_MSH = 0 +CT_GCR = 0 +! IAXIS cut-faces: +X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-2,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%IBAR) THEN ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ELSEIF(I==0 .OR. I==M%IBAR) THEN ! Block boundary + CT_BND = CT_BND + 1 + IFC = NBD_MESH + CT_BND + ENDIF + ELSE ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ENDIF + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XFACE(I), YCELL(J), ZCELL(K) /); AREA(1) = DYCELL(J)*DZCELL(K) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I,J,K-1,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I,J ,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I,J,K ,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I,J-1,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC + M%CUT_FACE(IFC)%STATUS = CC_GASPHASE + M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) + ENDDO + ENDDO +ENDDO - ! Make list of LOW X2 vertices, in descending X3 order. Add segments: - ASCDESC=.FALSE. - XVERT1(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) - XVERT2(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) - CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X2FACE(JJ-1),ASCDESC,NV,V) - DO IV=1,NV-1 - NSSEG=NSSEG + 1 - SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) - ANGSEG(NSSEG) = - PI / 2._EB - ENDDO +! JAXIS cut-faces: +X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-2,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%JBAR) THEN ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ELSEIF(J==0 .OR. J==M%JBAR) THEN ! Block boundary + CT_BND = CT_BND + 1 + IFC = NBD_MESH + CT_BND + ENDIF + ELSE ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ENDIF + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC + M%CUT_FACE(IFC)%STATUS = CC_GASPHASE + M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) + ENDDO + ENDDO +ENDDO - ! Make list of LOW X3 vertices, in ascending X2 order. Add segments: - ASCDESC=.TRUE. - XVERT1(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) - XVERT2(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) - CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X3FACE(KK-1),ASCDESC,NV,V) - DO IV=1,NV-1 - NSSEG=NSSEG + 1 - SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) - ANGSEG(NSSEG) = 0._EB - ENDDO +! KAXIS cut-faces: +X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS +DO K=-2,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%KBAR) THEN ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ELSEIF(K==0 .OR. K==M%KBAR) THEN ! Block boundary + CT_BND = CT_BND + 1 + IFC = NBD_MESH + CT_BND + ENDIF + ELSE ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ENDIF + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC + M%CUT_FACE(IFC)%STATUS = CC_GASPHASE + M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) + ENDDO + ENDDO +ENDDO - ! Use list of segments on gasphase region from CUT_EDGE: - ! These are to discard from SEGS computed before: - COUNT=0 - SEG_FACEAUX(NOD1:NOD2,1:NSSEG) = SEG_FACE(NOD1:NOD2,1:NSSEG) - ANGSEGAUX(1:NSSEG)=ANGSEG(1:NSSEG) - SEG_FLAG(1:NSSEG) = .FALSE. - OUTER : DO ISEG=1,NSSEG - ! Test against GASPHASE segments: - INNER1 : DO ISEG2=1,NSEG_CART - SNOD1(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG) - SNOD2(NOD1:NOD2)= SEG_FACE_CART(NOD1:NOD2,ISEG2) - XYZ_SEG1(IAXIS:KAXIS,NOD1:NOD2) = XYZVERT(IAXIS:KAXIS,SNOD1(NOD1:NOD2)) - XYZ_SEG2(IAXIS:KAXIS,NOD1:NOD2) = XYZVERT_CART(IAXIS:KAXIS,SNOD2(NOD1:NOD2)) - ! Test for possible node combination: - DO INOD=1,4 - INOD1=NODC1(INOD) ! [ 1 2 1 2 ] - INOD2=NODC2(INOD) ! [ 1 2 2 1] - DIFF(INOD) = SQRT((XYZ_SEG1(IAXIS,INOD1)-XYZ_SEG2(IAXIS,INOD2))**2._EB + & - (XYZ_SEG1(JAXIS,INOD1)-XYZ_SEG2(JAXIS,INOD2))**2._EB + & - (XYZ_SEG1(KAXIS,INOD1)-XYZ_SEG2(KAXIS,INOD2))**2._EB ) < GEOMEPS - ENDDO - IF(DIFF(1) .AND. DIFF(2)) SEG_FLAG(ISEG)=.TRUE. ! Nodes of two segs coincide, its a GASPHASE segment. - IF(DIFF(3) .AND. DIFF(4)) SEG_FLAG(ISEG)=.TRUE. ! Nodes of two segs coincide, its a GASPHASE segment. - ENDDO INNER1 - ! Test against itself: - INNER2 : DO ISEG2=1,NSSEG - IF (ISEG==ISEG2) CYCLE - SNOD1(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG) - SNOD2(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG2) - IF(SNOD1(NOD1)==SNOD2(NOD2) .AND. SNOD1(NOD2)==SNOD2(NOD1)) SEG_FLAG(ISEG)=.TRUE. - ENDDO INNER2 - ENDDO OUTER - DO ISEG=1,NSSEG - IF(SEG_FLAG(ISEG)) CYCLE - COUNT=COUNT+1 - SEG_FACE(NOD1:NOD2,COUNT)=SEG_FACEAUX(NOD1:NOD2,ISEG) - ANGSEG(COUNT) = ANGSEGAUX(ISEG) - ENDDO +M%N_BBCUTFACE_MESH = NBD_MESH + NFC_BND +M%N_CUTFACE_MESH = NCF_MESH + NFC_BND + NFC_MSH +M%N_GCCUTFACE_MESH = NGF_MESH + NFC_GCR - NSSEG=COUNT +ELSE + +! IAXIS cut-faces: +X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-2,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + ! Insert cut-face in CUT_FACE array: + CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XFACE(I), YCELL(J), ZCELL(K) /); AREA(1) = DYCELL(J)*DZCELL(K) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I,J,K-1,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I,J ,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I,J,K ,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I,J-1,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + ENDDO + ENDDO +ENDDO - ! Build Solid side faces: - NOTDONE = .TRUE. - DO WHILE(NOTDONE) - NOTDONE = .FALSE. - ! Counts edges that reach nodes: - NUMEDG_NODE(1:CC_MAXVERTS_FACE) = 0 - DO ISEG=1,NSSEG - DO II2=NOD1,NOD2 - INOD = SEG_FACE(II2,ISEG) - NUMEDG_NODE(INOD) = NUMEDG_NODE(INOD) + 1 - ENDDO - ENDDO +! JAXIS cut-faces: +X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-2,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + ! Insert cut-face in CUT_FACE array: + CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + ENDDO + ENDDO +ENDDO - ! Drop segments with NUMEDG_NODE(INOD)=1: - ! The assumption here is that they are CC_SS CC_INBOUNDCF - ! segments with one node inside the Cartface i.e. case Fig - ! 9(a) in the CompGeom3D notes): - COUNT = 0 - SEG_FACEAUX (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED - ANGSEGAUX(1:CC_MAXCEELEM_FACE) = 0._EB - DO ISEG=1,NSSEG - NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) - NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) - IF ((NUMNOD1 > 1) .AND. (NUMNOD2 > 1)) THEN - COUNT = COUNT + 1 - SEG_FACEAUX(NOD1:NOD2,COUNT) = SEG_FACE(NOD1:NOD2,ISEG) - ANGSEGAUX(COUNT) = ANGSEG(ISEG) - ELSE - NOTDONE = .TRUE. - ENDIF - ENDDO - NSSEG = COUNT - SEG_FACE = SEG_FACEAUX - ANGSEG = ANGSEGAUX - ENDDO +! KAXIS cut-faces: +X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS +DO K=-2,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + ! Insert cut-face in CUT_FACE array: + CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + ENDDO + ENDDO +ENDDO - ! Discard face with less than 3 edges (triangle): - IF ( NSSEG < 3 ) CYCLE +ENDIF - ! Add segments which have both ends attached to more than two segs: - count = 0 - DO ISEG=1,NSSEG - NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) - NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) - IF ((NUMNOD1 > 2) .AND. (NUMNOD2 > 2)) THEN - COUNT = COUNT + 1 - SEG_FACE(NOD1:NOD2,NSSEG+COUNT) = SEG_FACE( (/ NOD2, NOD1 /) ,ISEG) - IF (ANGSEG(ISEG) >= 0._EB) THEN - ANGSEG(NSSEG+COUNT) = ANGSEG(ISEG) - PI - ELSE - ANGSEG(NSSEG+COUNT) = ANGSEG(ISEG) + PI - ENDIF - ENDIF - ENDDO - NSSEG = NSSEG + COUNT +END SUBROUTINE GET_REMAINING_CUTFACES - ! Fill NODEDG_FACE(IEDGE,INOD), where iedge are edges - ! that contain inod as first node. This assumes edges are - ! ordered using the right hand rule on x2-x3 plane. - ! Also compute the edges angles in x2-x3 plane - CALL REALLOCATE_NODEDG_FACE(NSSEG,NSVERT) - NODEDG_FACE(:,:) = 0 - DO ISEG=1,NSSEG - INOD1 = SEG_FACE(NOD1,ISEG) - NEDI = NODEDG_FACE(1,INOD1) + 1 ! Increase number of edges connected to node by 1. - NODEDG_FACE( 1,INOD1) = NEDI - NODEDG_FACE(NEDI+1,INOD1) = ISEG - ENDDO - ! Now Reorder Segments, do tests: - SEG_FACE2(NOD1:NOD3,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED ! [INOD1 INOD2 ICF] - SEG_FLAG(1:CC_MAXCEELEM_FACE) = .TRUE. +! ---------------------- CUT_CELL_FACE_ARRAYS_CLEANUP ----------------------------- - ICF = 1 - ISEG = 1 - NEWSEG = ISEG - COUNT= 1 - CTSTART=COUNT - SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG),SEG_FACE(NOD2,NEWSEG),ICF /) - SEG_FLAG(ISEG) = .FALSE. - NSEG_LEFT = NSSEG - 1 +SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP(NM) - ! Infamous infinite loop: - INF_LOOP2 : DO +INTEGER, INTENT(IN) :: NM - FOUNDSEG = .FALSE. - N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. - ANGCOUNT = ANGSEG(NEWSEG) +INTEGER, ALLOCATABLE, DIMENSION(:) :: CCIND,CFIND,AUXV +INTEGER :: I,J,K,X1AXIS,ICC,JCC,IFC,IFACE,ICF,JCF,IFC1,CT,CTC,CTF,ILH,& + N_CUTCELL_MESH_NEW,N_GCCUTCELL_MESH_NEW,N_CUTFACE_MESH_NEW,N_GCCUTFACE_MESH_NEW,N_BBCUTFACE_MESH_NEW,& + NEDG,IEDG,LOHI,DIR,ICE +TYPE(MESH_TYPE), POINTER :: M +M => MESHES(NM) +ALLOCATE(CCIND(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH),CFIND(M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH)); CCIND=0; CFIND=0 - ! Find Segment starting on Node 2 with smaller ANGSEG respect to COUNT. - DANG = -1._EB / GEOMEPS - DO ISS=2,NODEDG_FACE(1,N2COUNT)+1 - ISEG = NODEDG_FACE(ISS,N2COUNT) - IF ( SEG_FLAG(ISEG) ) THEN ! This seg hasn't been added to SEG_FACE2 - ! Drop if seg is the opposite of count seg: - IF ( SEG_FACE2(NOD1,COUNT) == SEG_FACE(NOD2,ISEG) ) CYCLE - DANGI = ANGSEG(ISEG) - ANGCOUNT - IF ( DANGI < 0._EB ) DANGI = DANGI + 2._EB * PI +! Count cut-cells and face entries with NCELL, NFACE > 0: +CTC=0; N_CUTCELL_MESH_NEW=0; N_GCCUTCELL_MESH_NEW=0 +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + IF(M%CUT_CELL(ICC)%NCELL<1) CYCLE + CTC=CTC+1 + CCIND(ICC) = CTC + IF (ICC<=M%N_CUTCELL_MESH) THEN; N_CUTCELL_MESH_NEW = N_CUTCELL_MESH_NEW + 1 + ELSE; N_GCCUTCELL_MESH_NEW = N_GCCUTCELL_MESH_NEW + 1; ENDIF +ENDDO +CTF=0; N_CUTFACE_MESH_NEW=0; N_GCCUTFACE_MESH_NEW=0; N_BBCUTFACE_MESH_NEW=0 +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + IF(M%CUT_FACE(ICF)%NFACE<1) CYCLE + CTF=CTF+1 + CFIND(ICF) = CTF + IF (ICF<=M%N_BBCUTFACE_MESH) N_BBCUTFACE_MESH_NEW = N_BBCUTFACE_MESH_NEW + 1 + IF (ICF<=M%N_CUTFACE_MESH) THEN; N_CUTFACE_MESH_NEW = N_CUTFACE_MESH_NEW + 1 + ELSE; N_GCCUTFACE_MESH_NEW = N_GCCUTFACE_MESH_NEW + 1; ENDIF +ENDDO - IF ( DANGI > DANG ) THEN - NEWSEG = ISEG - DANG = DANGI - FOUNDSEG = .TRUE. - ENDIF - ENDIF - ENDDO +! Move Cut-cells to new location, NCELL=0 entries are dropped: +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + IF(M%CUT_CELL(ICC)%NCELL<1 .OR. ICC==CCIND(ICC)) CYCLE + CALL CUT_CELL_MOVE(M%CUT_CELL(ICC),M%CUT_CELL(CCIND(ICC))) +ENDDO +M%N_CUTCELL_MESH = N_CUTCELL_MESH_NEW +M%N_GCCUTCELL_MESH = N_GCCUTCELL_MESH_NEW - ! Found a seg add to SEG_FACE2: - IF ( FOUNDSEG ) THEN - COUNT = COUNT + 1 - SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG), SEG_FACE(NOD2,NEWSEG), ICF /) - SEG_FLAG(NEWSEG) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - ENDIF +! Now Cut-faces: +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + IF(M%CUT_FACE(ICF)%NFACE<1 .OR. ICF==CFIND(ICF)) CYCLE + CALL CUT_FACE_MOVE(M%CUT_FACE(ICF),M%CUT_FACE(CFIND(ICF))) +ENDDO +M%N_CUTFACE_MESH = N_CUTFACE_MESH_NEW +M%N_GCCUTFACE_MESH = N_GCCUTFACE_MESH_NEW +M%N_BBCUTFACE_MESH = N_BBCUTFACE_MESH_NEW - ! Test if line has closed on point shared any other cutface: - IF ( SEG_FACE2(NOD2,COUNT) == SEG_FACE2(NOD1,CTSTART) ) THEN - ! Go for new cut-face on this Cartesian face. - ELSEIF ( FOUNDSEG ) THEN - CYCLE - ENDIF +! Finally fix ICC and ICF in CCVAR, FCVAR, CELL_LIST and FACE_LIST arrays +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC=>M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS); + M%CCVAR(I,J,K,CC_IDCC) = ICC; + DO JCC=1,CC%NCELL + ALLOCATE(AUXV(CC%CCELEM(1,JCC))); AUXV = 0 + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + AUXV(IFC) = 1 + IF ( .NOT.(CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB .OR. & + CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) ) CYCLE + IFC1 = CC%FACE_LIST(4,IFACE) + CC%FACE_LIST(4,IFACE) = 0; IF(IFC1>0) CC%FACE_LIST(4,IFACE) = CFIND(IFC1) + IF(CC%FACE_LIST(4,IFACE)<1) AUXV(IFC) = 0 + ENDDO + IFC1=0 + DO IFC=1,CC%CCELEM(1,JCC) + IF(AUXV(IFC)<1) CYCLE + IFC1 = IFC1+1 + CC%CCELEM(IFC1+1,JCC) = CC%CCELEM(IFC+1,JCC) + ENDDO + CC%CCELEM(1,JCC) = SUM(AUXV(:)) + DEALLOCATE(AUXV) + ENDDO + ! Deallocate FACE_LIST_DROPPED + CC%NFACE_DROPPED = 0 + IF(ALLOCATED(CC%FACE_LIST_DROPPED)) DEALLOCATE(CC%FACE_LIST_DROPPED) +ENDDO - ! Break loop: - IF ( NSEG_LEFT == 0 ) EXIT +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + CT = HIGH_IND + I = M%CUT_FACE(ICF)%IJK(IAXIS); J = M%CUT_FACE(ICF)%IJK(JAXIS); K = M%CUT_FACE(ICF)%IJK(KAXIS) + X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) + SELECT CASE(M%CUT_FACE(ICF)%STATUS) + CASE(CC_INBOUNDARY) + CT = LOW_IND + M%CCVAR(I,J,K,CC_IDCF) = ICF + CASE(CC_GASPHASE) + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = ICF + END SELECT + DO JCF=1,M%CUT_FACE(ICF)%NFACE + DO ILH=LOW_IND,CT + IF (M%CUT_FACE(ICF)%CELL_LIST(1,ILH,JCF)==CC_FTYPE_CFGAS) THEN + ICC = M%CUT_FACE(ICF)%CELL_LIST(2,ILH,JCF) + M%CUT_FACE(ICF)%CELL_LIST(2,ILH,JCF) = CCIND(ICC) + ENDIF + ENDDO + ENDDO +ENDDO - ! Start a new cut-face on this Cartesian face: - ICF = ICF + 1 - DO ISEG=1,NSSEG - IF ( SEG_FLAG(ISEG) ) THEN - COUNT = COUNT + 1 - CTSTART= COUNT - SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,ISEG), SEG_FACE(NOD2,ISEG), ICF /) - SEG_FLAG(ISEG) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - EXIT - ENDIF - ENDDO +! Finally, some cut-faces might have regular Edges which are in CUT_EDGE, renumber in EDGE_LIST: +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_GASPHASE) CYCLE + NEDG=SIZE(CF%EDGE_LIST,DIM=2); I=CF%IJK(IAXIS); J=CF%IJK(JAXIS); K=CF%IJK(KAXIS); X1AXIS=CF%IJK(KAXIS+1) + DO IEDG=1,NEDG-1 + IF(CF%EDGE_LIST(1,IEDG)/=CC_ETYPE_RGGAS) CYCLE + LOHI=CF%EDGE_LIST(2,IEDG)-2 ! -1 for LOW_IND, 0 for HIGH_IND + DIR =CF%EDGE_LIST(3,IEDG) + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(DIR==JAXIS) THEN + ICE=M%ECVAR(I,J+LOHI,K,CC_IDCE,KAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ELSEIF(DIR==KAXIS) THEN + ICE=M%ECVAR(I,J,K+LOHI,CC_IDCE,JAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ENDIF + CASE(JAXIS) + IF(DIR==IAXIS) THEN + ICE=M%ECVAR(I+LOHI,J,K,CC_IDCE,KAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ELSEIF(DIR==KAXIS) THEN + ICE=M%ECVAR(I,J,K+LOHI,CC_IDCE,IAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ENDIF + CASE(KAXIS) + IF(DIR==IAXIS) THEN + ICE=M%ECVAR(I+LOHI,J,K,CC_IDCE,JAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ELSEIF(DIR==JAXIS) THEN + ICE=M%ECVAR(I,J+LOHI,K,CC_IDCE,IAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ENDIF + END SELECT + ENDDO +ENDDO - ENDDO INF_LOOP2 +DEALLOCATE(CCIND,CFIND) - ! Load ordered nodes to CFELEM: - NSFACE = ICF - ! Reallocate CFELEM ARRAY if necessary: - CALL REALLOCATE_LOCAL_CFELEM(NSSEG,NSFACE) - CFELEM(:,:) = CC_UNDEFINED - COUNT = 0 - DO ICF=1,NSFACE - NP = 0 - DO ISEG=1,NSSEG - IF ( SEG_FACE2(NOD3,ISEG) == ICF ) NP = NP + 1 - ENDDO - IF (NP < 3) CYCLE ! Drop face if it has less than 2 3 vertices - COUNT=COUNT+1 - NP = 0 - DO ISEG=1,NSSEG - IF ( SEG_FACE2(NOD3,ISEG) == ICF ) THEN - NP = NP + 1 - CFELEM(1,COUNT) = NP - CFELEM(NP+1,COUNT) = SEG_FACE2(NOD1,ISEG) - ENDIF - ENDDO - ! Does Face Have zero Area? If so drop, rewind: - DO IPT=2,NP+1 - ICF_PT = CFELEM(IPT,COUNT) - ! Define closed Polygon: - XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) - ENDDO - ICF_PT = CFELEM(2,COUNT) - XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) ! Close Polygon. - AREA = 0._EB - DO II2=1,NP - AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & - XY(JAXIS,II2) * XY(IAXIS,II2+1) ) - ENDDO - IF (ABS(AREA) < GEOMEPS**2._EB) THEN - CFELEM(:,COUNT) = CC_UNDEFINED - COUNT = COUNT - 1 - ENDIF - ENDDO - NSFACE = COUNT; IF(NSFACE==0) CYCLE +RETURN +END SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP - ! Compute area and Centroid, in local x1, x2, x3 coords: - ALLOCATE(DROPFACE(1:NSFACE)); DROPFACE=.FALSE. - AREAV(1:NSFACE) = 0._EB - XYZCEN(IAXIS:KAXIS,1:NSFACE) = 0._EB - DO ICF=1,NSFACE - NP = CFELEM(1,ICF) - DO IPT=2,NP+1 - ICF_PT = CFELEM(IPT,ICF) - ! Define closed Polygon centered in First Point: - XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & - XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) - ENDDO - ICF_PT = CFELEM(2,ICF) - XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & - XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) +! ---------------------------- BLOCK_CUT_CELL ------------------------------------- - ! Get Area and Centroid properties of Cut-face: - AREA = 0._EB - DO II2=1,NP - AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & - XY(JAXIS,II2) * XY(IAXIS,II2+1) ) - ENDDO - AREA = AREA / 2._EB - IF ( (AREA SOLID. Make VERTVAR for vertices involved SOLID. +! b. If face is type CFGAS. +! b1. Make space for all surrounding Cartesain cells that will turn into cut-cells. +! b2. Make space for CFINB cut-edges and cut-faces in CUT_CELL sharing with ICC,JCC. +! b3. Add INB cut-face to surrounding cut-cell, drop regular face, set FCVAR, ECVAR for edges involved => SOLID. +! Make VERTVAR for vertices involved SOLID. - ! Add to cut-face: - AREAV(ICF) = AREA - XYZCEN((/IAXIS,JAXIS,KAXIS/),ICF) = (/ X1FACE(II), CX2, CX3 /) +INTEGER, INTENT(IN) :: NM,ICC,JCC,BLOCK_PHASE - ENDDO +INTEGER :: I,J,K,II,JJ,KK,IFC,IFC1,JFC1,IFACE,LOHI,ILH,X1AXIS,NSVERT,NSFACE,NVERTFACE_NEW,COUNT,DUM,IBOD,ITRI,& + HILO,ILHF,ICC2,JCC2,IFC2,IFACE2,IFCX,JFCX,IV,IVERT,MAXVERTS,INOD,INDFC(1:4),ICCNXT,& + IADD,JADD,KADD,EDGE_LIST_REG(1:3,1:4),DIMCE(2),IEDGE,CEI,LOHIE,AXISF,AXISE,LOWI,HIGI,LOWJ,HIGJ,LOWK,HIGK,& + IEG,JEG,KEG,ICE,JCE,ICF2,JCF2,JCE2,IEC2,JEC2,VL1(4),VL2(4),NFCD,IFCIN,JFCIN,KFCIN,X1AXIN,SZDUM +REAL(EB):: XYZV(IAXIS:KAXIS),XYZVERT(MAX_DIM,4) +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BODTRI,EDGE_LIST_AUX,CEDGES_AUX,CEDGES_AUX2,FACE_LIST_DROPPED +INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM +REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA +LOGICAL :: REALLOC_FLG, NEW_FACE_FLG, DROP_FACE, INZONE +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_INBCF_AREA_TYPE), POINTER :: INBCF_AREA +M => MESHES(NM) - ALLOCATE(CFELEM2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CFELEM2 = CC_UNDEFINED - NP=0 - DO ICF=1,NSFACE - IF(.NOT.DROPFACE(ICF)) THEN - NP=NP+1 - CFELEM2(:,NP) = CFELEM(:,ICF) - ENDIF - ENDDO - CFELEM = CFELEM2 - DEALLOCATE(CFELEM2,DROPFACE) - IF (NP==0) CYCLE - NSFACE = NP +I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS); +! Find Body and triangle to associate to the cell to be blocked: +IBOD = 0; ITRI = 0 +COUNT= 0; DUM = 0 +DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 +ENDDO +IF (COUNT>0) THEN + ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 + DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE + DO DUM=1,COUNT + IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & + BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT + ENDDO + IF(DUM > COUNT) THEN ! No match in previous loop DUM=COUNT+1 + BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) + COUNT = DUM + ENDIF + AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) + ENDDO + IF (COUNT>0) THEN + ! Now set IBOD, ITRI + DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. + IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) + ENDIF + DEALLOCATE(BODTRI,AREA) +ELSE + ! Look in surrounding cells: + DO KK=K-1,K+1 + DO JJ=J-1,J+1 + DO II=I-1,I+1 + ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) + IF (ICC2>0) THEN + DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) + IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 + ENDDO + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + IF (COUNT>0) THEN + ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 + DO KK=K-1,K+1 + DO JJ=J-1,J+1 + DO II=I-1,I+1 + ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) + IF (ICC2>0) THEN + DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) + IFC1 = M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE) + JFC1 = M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE) + IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE + DO DUM=1,COUNT + IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & + BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT + ENDDO + IF(DUM > COUNT) THEN + BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) + COUNT = DUM + ENDIF + AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) + ENDDO + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + IF (COUNT>0) THEN + ! Now set IBOD, ITRI + DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. + IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) + ENDIF + DEALLOCATE(BODTRI,AREA) + ENDIF +ENDIF - ! Figure out if a cut-face is completely inside any of the - ! others (that is, it is a hole on the GASPHASE): - FINFACE = 0 - NSFACE2 = NSFACE - DO ICF1=1,NSFACE2 - ! Test that ICF1 has a negative area (case of holes) - AREA1 = AREAV(ICF1) - IF ( AREA1 < -GEOMEPS ) THEN - DO ICF2=1,NSFACE2 - ! Drop if same face: - IF ( ICF1 == ICF2 ) CYCLE +! For cut-cell ICC, JCC run through its boundary faces and generate new boundary EDGES, CUT-FACES and cells: +BLOCK_PHASE_IF : IF(BLOCK_PHASE==1) THEN - ! Centroid node for ICF1: - XYC1(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF1 ) ! [x2axis x3axis] +! Add areas of corresponding INB faces: +INZONE = (I>=0 .AND. I<=M%IBP1 .AND. J>=0 .AND. J<=M%JBP1 .AND. K>=0 .AND. K<=M%KBP1) .AND. MY_RANK==PROCESS(NM) +IF(INZONE) THEN + INBCF_AREA => M%INBCF_AREA(I,J,K) + IF(INBCF_AREA%NCELL == 0) THEN + INBCF_AREA%NCELL = M%CUT_CELL(ICC)%NCELL + ALLOCATE(INBCF_AREA%AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%AINB = 0._EB + ALLOCATE(INBCF_AREA%NEW_AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%NEW_AINB = 0._EB + ALLOCATE(INBCF_AREA%SURF_INDEX(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%SURF_INDEX = 0 + ALLOCATE(INBCF_AREA%IJCF(M%CUT_CELL(ICC)%NCELL)) + ENDIF + IF(IBOD>0) M%INBCF_AREA(I,J,K)%SURF_INDEX(JCC) = GEOMETRY(IBOD)%SURFS(ITRI) + DUM = 0; M%INBCF_AREA(I,J,K)%AINB(JCC) = 0._EB + DO IFC=2,M%CUT_CELL(ICC)%CCELEM(1,JCC)+1 + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC,JCC) + IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_CFINB) + M%INBCF_AREA(I,J,K)%AINB(JCC) = M%INBCF_AREA(I,J,K)%AINB(JCC) + & + M%CUT_FACE(IFC1)%AREA(JFC1)*M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1) + CASE(CC_FTYPE_CFGAS,CC_FTYPE_RCGAS) + DUM=DUM+1 + END SELECT + ENDDO + IF(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE>0) THEN + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = 0; + DEALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB) + ENDIF + IF(.NOT.ALLOCATED(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB)) THEN + ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB = 0 + ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB = 0 + ENDIF +ENDIF - ! Polygon nodes for ICF2: - NP2 = CFELEM(1,ICF2) - DO IPT=2,NP2+1 - ICF_PT = CFELEM(IPT,ICF2) - ! Define closed Polygon: - XY(IAXIS:JAXIS,IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) - ENDDO +IFC_LOOP : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) + HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND + ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND + ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND + X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) + IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) - CALL TEST_PT_INPOLY(NP2,XY,XYC1,PTSFLAG) + FACE_TYPE_IF : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & + M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN - IF ( PTSFLAG ) THEN ! Centroid of face 1 inside Face 2. + ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: + IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN + LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) + HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) + LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) + HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) + IF(LOWI>0 .AND. LOWJ>0) THEN + IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) CYCLE IFC_LOOP + ENDIF + ENDIF - FINFACE(ICF1) = ICF2 - NSFACE = NSFACE - 1 + ! If needed reallocate CUT_FACE to accomodate INBOUNDARY face in neighbor cell. + SELECT CASE(X1AXIS) + CASE(IAXIS); II=I+ILH; JJ=J; KK=K + CASE(JAXIS); II=I; JJ=J+ILH; KK=K + CASE(KAXIS); II=I; JJ=J; KK=K+ILH + END SELECT + IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP + ICCNXT=0; IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) ICCNXT=1 - ! Redefine areas in case of faces with holes: - AREA2 = AREAV(ICF2) + IFC1 = M%CCVAR(II,JJ,KK,CC_IDCF) ! INBOUNDARY cut-faces in neighbor cartesian cell. + NEW_FACE_FLG = .FALSE. + IF (IFC1 < 1) THEN + ! Insert IFC1: + CALL INSERT_CUT_FACE(NM,II,JJ,KK,0,IFC1,INZONE=INZONE); M => MESHES(NM) ! Make space for INBOUNDARY cut-face + NEW_FACE_FLG = .TRUE. + ENDIF - ! Area with hole, AREA1 has negative sign: - AREAH = AREA2 + AREA1 + REALLOC_FLG = .FALSE. + NSVERT = 0; NSFACE = 0; + IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) NVERTFACE_NEW = 5 + IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) NVERTFACE_NEW = M%CUT_FACE(IFCX)%CFELEM(1,JFCX)+1 + SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CFELEM)) SZDUM = SIZE(M%CUT_FACE(IFC1)%CFELEM, DIM=1) + IF(SZDUM < NVERTFACE_NEW) REALLOC_FLG = .TRUE. + SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%XYZVERT)) SZDUM = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) + IF(SZDUM < M%CUT_FACE(IFC1)%NVERT+NVERTFACE_NEW-1) THEN + REALLOC_FLG = .TRUE. + NSVERT = NVERTFACE_NEW-1 + ENDIF + SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%AREA)) SZDUM = SIZE(M%CUT_FACE(IFC1)%AREA,DIM=1) + IF(SZDUM < M%CUT_FACE(IFC1)%NFACE+1) THEN + REALLOC_FLG = .TRUE. + NSFACE = 1 + ENDIF + JFC1 = M%CUT_FACE(IFC1)%NFACE+1 - IF (ABS(AREAH) < GEOMEPS) THEN ! Hole of same size as cut-face, drop both. - FINFACE(ICF2) = ICF1 - CYCLE - ENDIF + ! Reallocate CUT_FACE(IFC1) entry: + IF(NEW_FACE_FLG) THEN + CALL FACE_DEALLOC(NM,IFC1); CALL NEW_FACE_ALLOC(NM,IFC1,NSVERT,NSFACE,NVERTFACE_NEW) + ELSEIF(REALLOC_FLG) THEN + CALL FACE_REALLOC(NM,IFC1,M%CUT_FACE(IFC1)%NVERT,M%CUT_FACE(IFC1)%NFACE,NSVERT,NSFACE,NVERTFACE_NEW) + ENDIF - ! Centroid with hole: - XYC2(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF2 ) ! [x2axis x3axis] - XYH(1:2) = (AREA1 * XYC1(1:2) + AREA2 * XYC2(1:2)) / AREAH + M=>MESHES(NM) + ! Provide GEOM surface information to newly created INBOUNDARY face: + M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) = (/ IBOD, ITRI /) + M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = 0 ! Default surf. + M%CUT_FACE(IFC1)%CFACE_ORIGIN(JFC1) = M%CUT_CELL(ICC)%NOADVANCE(JCC) + IF(IBOD>0) M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = GEOMETRY(IBOD)%SURFS(ITRI) + M%CUT_FACE(IFC1)%NFACE = JFC1 + ENDIF FACE_TYPE_IF - ! So ICF2 has the area with hole properties: - AREAV(ICF2) = AREAH - XYZCEN(JAXIS,ICF2) = XYH(IAXIS) - XYZCEN(KAXIS,ICF2) = XYH(JAXIS) - EXIT - ENDIF - ENDDO - ENDIF - ENDDO + SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_RCGAS) ! This regular face has to be connecting two small cut-cells. + ! Scheme: + ! 0. Add REG edges as INB cut-edges in corresponding cartesian cut faces. Define normal edges to new INB cut-edge + ! as CFGAS cut-edges. Set VERTVAR to SOLID in EDGE corners: + EDGE_LIST_REG(1:3,1:4) = CC_UNDEFINED; EDGE_LIST_REG(1,1:4) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. + SELECT CASE(X1AXIS) + CASE(IAXIS) + ! First INB cut edges in surrounding faces: + ! I+ILHF location. + ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 + XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) + XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) + ! Edge 1: V1-V2 add to face (I+2*ILHF+1,J ,K-1,KAXIS) + ! side on blocked cell,[I,J,K,X1EDGE], [I,J,K,X1FACE] + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K-1,JAXIS,I+2*ILHF+1,J ,K-1,KAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) + ! Edge 2: V2-V3 add to face (I+2*ILHF+1,J ,K ,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,KAXIS,I+2*ILHF+1,J ,K ,JAXIS,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) + ! Edge 3: V4-V3 add to face (I+2*ILHF+1,J ,K ,KAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,JAXIS,I+2*ILHF+1,J ,K ,KAXIS,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) + ! Edge 4: V1-V4 add to face (I+2*ILHF+1,J-1,K ,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J-1,K ,KAXIS,I+2*ILHF+1,J-1,K ,JAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) - ! Now enhance CFELEM for faces with holes nodes: - DO ICF1=1,NSFACE2 - ICF2 = FINFACE(ICF1) - IF ( ICF2 > 0 ) THEN ! Allows for up to one hole per CC_GASPHASE cut-face. - ! Load points - NP1 = CFELEM(1,ICF1) - NP2 = CFELEM(1,ICF2) - NP = (NP1+1) + (NP2+1) + ! Second CFGAS cut-edges in edges normal to face: + DO KADD=-1,0 + DO JADD=-1,0 + ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO - ! Here reallocate CFELEM, CFE, CFEL if NP > SIZE_VERTS_CFELEM: - CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) + CASE(JAXIS) + ! J+ILHF location. + ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) + ! Edge 1: V1-V2 add to face (I-1,J+2*ILHF+1,K ,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J+ILHF,K ,KAXIS,I-1,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) + ! Edge 2: V2-V3 add to face (I ,J+2*ILHF+1,K ,KAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,IAXIS,I ,J+2*ILHF+1,K ,KAXIS,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) + ! Edge 3: V4-V3 add to face (I ,J+2*ILHF+1,K ,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,KAXIS,I ,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) + ! Edge 4: V1-V4 add to face (I ,J+2*ILHF+1,K-1,KAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K-1,IAXIS,I ,J+2*ILHF+1,K-1,KAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) - CFE(1) = NP + ! Second CFGAS cut-edges in edges normal to face: + DO KADD=-1,0 + DO IADD=-1,0 + ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO - DO II2=2,np1+1 - CFE(II2) = CFELEM(II2,icf1) - ENDDO - II2 = (np1+1) + 1 - CFE(II2) = CFELEM(2,icf1) + CASE(KAXIS) + ! K+ILHF location. + ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /) + XYZVERT(:,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /) + XYZVERT(:,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /) + XYZVERT(:,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) + ! Edge 1: V1-V2 add to face (I,J-1,K+2*ILHF+1,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J-1,K+ILHF,IAXIS,I ,J-1,K+2*ILHF+1,JAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) + ! Edge 2: V2-V3 add to face (I,J ,K+2*ILHF+1,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,JAXIS,I ,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) + ! Edge 3: V4-V3 add to face (I,J ,K+2*ILHF+1,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,IAXIS,I ,J ,K+2*ILHF+1,JAXIS,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) + ! Edge 4: V1-V4 add to face (I-1,J,K+2*ILHF+1,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J ,K+ILHF,JAXIS,I-1,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) - COUNT = 1 - DO II2=(NP1+1)+2,(NP1+1)+1+NP2 - COUNT = COUNT + 1 - CFE(II2) = CFELEM(COUNT,ICF2) - ENDDO - II2 = NP + 1 - CFE(II2) = CFELEM(2,ICF2) + ! Second CFGAS cut-edges in edges normal to face: + DO JADD=-1,0 + DO IADD=-1,0 + ! Edge (I+IADD,J+JADD,K+2*ILHF+1,KAXIS): From V(I+IADD,J+JADD,K+2*ILHF) to V(I+IADD,J+JADD,K+2*ILHF+1) + XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF ) /) + XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF+1) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+JADD,K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO - ! Copy CFE into CFELEM(1:np+1,icf2): - CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) + END SELECT - ENDIF - ENDDO - NVERTFACE = MAXVAL(CFELEM(1,1:NSFACE2)) + 1 + ! 1. Add INBOUNDARY cut-face with size of RGGAS in CUT_FACE for this face (IFC1,JFC1). + DUM = M%CUT_FACE(IFC1)%NVERT + 1 + SELECT CASE(X1AXIS) + CASE(IAXIS) + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) + M%CUT_FACE(IFC1)%AREA(JFC1) = DYCELL(J)*DZCELL(K) + M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XFACE(I+ILHF), YCELL(J), ZCELL(K) /) + CASE(JAXIS) + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) + M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DZCELL(K) + M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YFACE(J+ILHF), ZCELL(K) /) + CASE(KAXIS) + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) + M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DYCELL(J) + M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YCELL(J), ZFACE(K+ILHF) /) + END SELECT + INDFC(1:4) = (/ 1, 2, 3, 4 /); INDFC = INDFC + M%CUT_FACE(IFC1)%NVERT + M%CUT_FACE(IFC1)%NVERT = DUM - ! Up to this point we have all SOLID side cut-faces in CFELEM, SOLID_SIDE nodes in XYZVERT and - ! Area properties: Add these to Existing CUT_FACE info: - MESHES(NM)%CUT_FACE(NCUTFACE)%NSVERT = NSVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NSFACE = NSFACE - CALL FACE_REALLOC(NM,NCUTFACE,NVERT,NFACE,NSVERT,NSFACE,NVERTFACE) - MESHES(NM)%CUT_FACE(NCUTFACE)%XYZVERT(IAXIS:KAXIS,NVERT+1:NVERT+NSVERT)=XYZVERT(IAXIS:KAXIS,1:NSVERT) + ! All faces connectivities: (/ NNODS, NOD1, NOD2, NOD3, NOD4 /) ! Conn. into gas region of new cell. + IF (LOHI==HIGH_IND) THEN; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(2), INDFC(3), INDFC(4) /) + ELSE; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(4), INDFC(3), INDFC(2) /); ENDIF - ! Load Ordered nodes to CFELEM and geom properties: - COUNT = NFACE - DO ICF=1,NSFACE2 - IF ( FINFACE(ICF) > 0 ) CYCLE ! icf is a hole on another cut-face. - COUNT = COUNT + 1 - ! Connectivity: - NV=CFELEM(1, ICF) - CFELEM(2:NV+1,ICF)=CFELEM(2:NV+1,ICF) + NVERT ! Re-index to total number of vertices. - MESHES(NM)%CUT_FACE(NCUTFACE)%CFELEM(1:NVERTFACE,COUNT) = CFELEM(1:NVERTFACE, ICF) - ! Geom Properties SOLID: - MESHES(NM)%CUT_FACE(NCUTFACE)%AREA(COUNT) = AREAV(ICF) - MESHES(NM)%CUT_FACE(NCUTFACE)%XYZCEN(IAXIS:KAXIS,COUNT) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,ICF) - ENDDO - ! Final number of cut-faces in the solid region of the face: - MESHES(NM)%CUT_FACE(NCUTFACE)%NSFACE = COUNT-NFACE + ! Add new edges to EDGE_LIST: + DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) + ALLOCATE(EDGE_LIST_AUX(3,DUM+4)); + IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) + EDGE_LIST_AUX(1:3,DUM+1:DUM+4) = EDGE_LIST_REG(1:3,1:4); + CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) + ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) + DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN + DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) + ENDIF + IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) + IF (LOHI==HIGH_IND) THEN; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+2, DUM+3, DUM+4 /) + ELSE; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+4, DUM+3, DUM+2 /); ENDIF + CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) - ENDIF SOLID_FACE_IF + IF(INZONE) THEN + M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 + ENDIF - ENDDO ! JJ - ENDDO ! KK - ENDDO ! II + ! 2. Find cut-cell sharing this RGGAS face, and where in FACE_LIST this face is. + IF( ICCNXT==0 ) THEN + ! 3. Change in FACE_LIST -> (/CC_FTYPE_RCGAS,SIDE,MYAXIS,0,0/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/). + ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) + JCC2_LOOP_1 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) + IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_RCGAS .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(2,IFACE2)==HILO .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(3,IFACE2)==X1AXIS) THEN + M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) + M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1)= (/ CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) + EXIT JCC2_LOOP_1 + ENDIF + ENDDO + ENDDO JCC2_LOOP_1 + ENDIF - DEALLOCATE(X1FACE,X2FACE,X3FACE) + CASE(CC_FTYPE_CFGAS) + + ! Scheme: + ! 0. Add REG and CFGAS cut edges as INB cut edges for the normal faces where it corresponds: + DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) + ALLOCATE(EDGE_LIST_AUX(3,DUM+M%CUT_FACE(IFCX)%CEDGES(1,JFCX))); + EDGE_LIST_AUX = CC_UNDEFINED; EDGE_LIST_REG(1,:) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. + IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) + ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) + DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN + DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) + ENDIF + IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) + CEDGES_AUX(1,JFC1) = M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + SELECT CASE(X1AXIS) + CASE(IAXIS) + XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) + XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) + ! Loop face edges/cut-edges: + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) + ENDIF + CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! First INB cut edges in surrounding faces: + ! I+ILHF location. + ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 + LOWJ=-1; HIGJ=0; LOWK=-1; HIGK=0; + IF(AXISF==JAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J-1; KEG=K ; HIGJ=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J-1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; LOWJ= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ENDIF + ELSEIF(AXISF==KAXIS) THEN + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J ; KEG=K-1; HIGK=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K-1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; LOWK= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ENDIF + ENDIF + DO KADD=LOWK,HIGK + DO JADD=LOWJ,HIGJ + ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO + CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge + ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; + ! Find Edge: + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. + SELECT CASE(AXISE) + CASE(KAXIS) ! Edge in z dir. For surrounding faces in X dir -> 2*ILHF+1 = -1 or 1. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=JAXIS + CASE(JAXIS) ! Edge in y dir. For surrounding faces in X dir -> 4*ILHF+2 = -2 or 2. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=KAXIS + END SELECT + ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: + ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: + CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) - ENDDO XIAXIS_LOOP + ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: + EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) -ENDDO IBNDINT_LOOP + ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: + VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + IF(VL1(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL1(3)), ZFACE(VL1(4)) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL1(3)), ZFACE(VL1(4)) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL1(3),VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + IF(VL2(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL2(3)), ZFACE(VL2(4)) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL2(3)), ZFACE(VL2(4)) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL2(3),VL2(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge + ! New edge list for the heighboring cell Boundary cut-faces is inherited. + EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) + END SELECT + ENDDO -IF (BNDINT_FLAG) THEN - ! Here we mark faces on the guard-cell region for the computaiton of grid aligned INBOUNDARY faces - ! on CARTCELL_CUTFACES to work correctly: - XIAXIS_LOOP_2 : DO X1AXIS=IAXIS,KAXIS + CASE(JAXIS) + XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) + ! Loop face edges/cut-edges: + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) + ENDIF + CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! First INB cut edges in surrounding faces: + ! J+ILHF location. + ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + LOWI=-1; HIGI=0; LOWK=-1; HIGK=0; + IF(AXISF==KAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J+ILHF; KEG=K-1; HIGK=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K-1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ELSE + IEG=I; JEG=J+ILHF; KEG=K ; LOWK= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ENDIF + ELSEIF(AXISF==IAXIS) THEN + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J+ILHF; KEG=K ; HIGI=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ELSE + IEG=I ; JEG=J+ILHF; KEG=K ; LOWI= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ENDIF + ENDIF + DO KADD=LOWK,HIGK + DO IADD=LOWI,HIGI + ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO + CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge + ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; + ! Find Edge: + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. + SELECT CASE(AXISE) + CASE(IAXIS) ! Edge in x dir. For surrounding faces in Y dir -> 2*ILHF+1 = -1 or 1. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=KAXIS + CASE(KAXIS) ! Edge in z dir. For surrounding faces in Y dir -> 4*ILHF+2 = -2 or 2. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=IAXIS + END SELECT - SELECT CASE(X1AXIS) - case(IAXIS) + ! IF(ICF2<1) THEN + ! WRITE(LU_ERR,*) 'ADD CUT_EDGE TO FACE IFCX,JFCX,I,J,K,X1AXIS=',& + ! IFCX,JFCX,M%CUT_FACE(IFCX)%IJK(1:4),':',M%FCVAR(7,7,7,CC_IDCF,2),M%FCVAR(7,7,7,CC_FGSC,2) + ! WRITE(LU_ERR,*) 'IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4)=',& + ! IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4),4*ILHF+2 + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-2,JCE) + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-1,JCE) + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 1,JCE) + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 2,JCE) + ! ENDIF - X2AXIS = JAXIS - X3AXIS = KAXIS + ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: + ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: + CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) - ! IAXIS gasphase cut-faces: - ILO = ILO_FACE-CCGUARD; IHI = IHI_FACE+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD + ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: + EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS + ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: + VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + IF(VL1(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF ), ZFACE(VL1(4)) /) + XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF+1), ZFACE(VL1(4)) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),J+2*ILHF+1,VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + IF(VL2(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + XYZVERT(:,1) = (/ XFACE(VL2(2)), YFACE(J+2*ILHF ), ZFACE(VL2(4)) /) + XYZVERT(:,2) = (/ XFACE(VL2(2)), YFACE(J+2*ILHF+1), ZFACE(VL2(4)) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL2(2),J+2*ILHF+1,VL2(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge + ! New edge list for the heighboring cell Boundary cut-faces is inherited. + EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) + END SELECT + ENDDO + CASE(KAXIS) + XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /) + XYZVERT(:,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /) + XYZVERT(:,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /) + XYZVERT(:,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) + ! Loop face edges/cut-edges: + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) + ENDIF + CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! First INB cut edges in surrounding faces: + ! K+ILHF location. + ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + LOWI=-1; HIGI=0; LOWJ=-1; HIGJ=0; + IF(AXISF==IAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J; KEG=K+ILHF; HIGI=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ELSE + IEG=I ; JEG=J; KEG=K+ILHF; LOWI= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ENDIF + ELSEIF(AXISF==JAXIS) THEN + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J-1; KEG=K+ILHF; HIGJ=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J-1,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ELSE + IEG=I; JEG=J ; KEG=K+ILHF; LOWJ= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ENDIF + ENDIF + DO JADD=LOWJ,HIGJ + DO IADD=LOWI,HIGI + ! Edge (I+IADD,J+JADD,K+2*ILHF+1,KAXIS): From V(I+IADD,J+JADD,K+2*ILHF) to V(I+IADD,J+JADD,K+2*ILHF+1) + XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF ) /) + XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF+1) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+JADD,K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO + CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge + ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; + ! Find Edge: + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. + SELECT CASE(AXISE) + CASE(JAXIS) ! Edge in y dir. For surrounding faces in Z dir -> 2*ILHF+1 = -1 or 1. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; + X1AXIN=IAXIS + CASE(IAXIS) ! Edge in x dir. For surrounding faces in Z dir -> 4*ILHF+2 = -2 or 2. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; + X1AXIN=JAXIS + END SELECT - ! Local indexing in x1, x2, x3: - X1LO = ILO; X1HI = IHI - X2LO = JLO; X2HI = JHI - X3LO = KLO; X3HI = KHI + ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: + ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: + CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) - CASE(JAXIS) + ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: + EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) - X2AXIS = KAXIS - X3AXIS = IAXIS + ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: + VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + IF(VL1(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF ) /) + XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF+1) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),VL1(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + IF(VL2(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + XYZVERT(:,1) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF ) /) + XYZVERT(:,2) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF+1) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL2(2),VL2(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge + ! New edge list for the heighboring cell Boundary cut-faces is inherited. + EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) + END SELECT + ENDDO + END SELECT + CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) - ! JAXIS gasphase cut-faces: - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD + ! 1. Add INBOUNDARY cut-face in CUT_FACE for this face (IFC1,JFC1). + ! Add XYZVERT, AREA, XYZCEN and CFELEM entry in CUT_FACE(IFC1) for this (IFCX,JFCX) CFGAS face. + M%CUT_FACE(IFC1)%CFELEM(1,JFC1) = M%CUT_FACE(IFCX)%CFELEM(1,JFCX) + MAXVERTS = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) + COUNT=1 + DO IVERT=1,M%CUT_FACE(IFCX)%CFELEM(1,JFCX) + IV=M%CUT_FACE(IFCX)%CFELEM(IVERT+1,JFCX) + XYZV(IAXIS:KAXIS) =M%CUT_FACE(IFCX)%XYZVERT(IAXIS:KAXIS,IV) + CALL INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,M%CUT_FACE(IFC1)%NVERT,INOD,M%CUT_FACE(IFC1)%XYZVERT) + COUNT=COUNT+1 + IF(COUNT>SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(COUNT+1,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:COUNT-1,:)=M%CUT_FACE(IFC1)%CFELEM(1:COUNT-1,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=M%CUT_FACE(IFC1)%CFELEM) + ENDIF + M%CUT_FACE(IFC1)%CFELEM(COUNT,JFC1)=INOD + ENDDO + IF (HILO==HIGH_IND) THEN ! Mirror the connectivity, s.t. normal pointing inside: + COUNT=M%CUT_FACE(IFC1)%CFELEM(1,JFC1) + ALLOCATE(CFELEM(COUNT)); CFELEM(1:COUNT) = M%CUT_FACE(IFC1)%CFELEM(COUNT+1:2:-1,JFC1) + M%CUT_FACE(IFC1)%CFELEM(2:COUNT+1,JFC1) = CFELEM(1:COUNT) + DEALLOCATE(CFELEM) + ENDIF + M%CUT_FACE(IFC1)%AREA(JFC1) = M%CUT_FACE(IFCX)%AREA(JFCX) + M%CUT_FACE(IFC1)%XYZCEN(:,JFC1) = M%CUT_FACE(IFCX)%XYZCEN(:,JFCX) - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS + ! 2. Find cut-cell sharing this CFGAS face (IFCX,JFCX), find where in saids cell FACE_LIST this face is. + ! 3. Change in FACE_LIST -> (/CC_FTYPE_CFGAS,SIDE,MYAXIS,IFCX,JFCX/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/) + ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) + JCC2_LOOP_2 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) + IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_CFGAS .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE2)==IFCX .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE2)==JFCX) THEN + ! Add to FACE_LIST_DROPPED: + M%CUT_CELL(ICC2)%NFACE_DROPPED = M%CUT_CELL(ICC2)%NFACE_DROPPED + 1 + NFCD=0; IF(ALLOCATED(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED)) NFCD=SIZE(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED,DIM=2) + IF(M%CUT_CELL(ICC2)%NFACE_DROPPED>NFCD) THEN + ALLOCATE(FACE_LIST_DROPPED(6,M%CUT_CELL(ICC2)%NFACE_DROPPED)) + IF(NFCD>0) FACE_LIST_DROPPED(1:6,1:NFCD) = M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1:6,1:NFCD) + FACE_LIST_DROPPED(1:6,NFCD+1) = M%CUT_CELL(ICC2)%FACE_LIST(1:6,IFACE2) + CALL MOVE_ALLOC(FROM=FACE_LIST_DROPPED,TO=M%CUT_CELL(ICC2)%FACE_LIST_DROPPED) + ENDIF + ! Now write CC_FTYPE_CFINB entry: + M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) + M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1) =(/CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) + IF(INZONE) THEN + M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 + ENDIF + EXIT JCC2_LOOP_2 + ENDIF + ENDDO + ENDDO JCC2_LOOP_2 + END SELECT - ! Local indexing in x1, x2, x3: - X1LO = JLO; X1HI = JHI - X2LO = KLO; X2HI = KHI - X3LO = ILO; X3HI = IHI +ENDDO IFC_LOOP - CASE(KAXIS) +IF(INZONE) THEN + DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) + JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) + M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) = M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) + M%CUT_FACE(IFC1)%AREA(JFC1) + ENDDO + DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) + JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) + M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)= & + M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)*M%INBCF_AREA(I,J,K)%AINB(JCC)/M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) + ENDDO +ENDIF - X2AXIS = IAXIS - X3AXIS = JAXIS +ELSEIF(BLOCK_PHASE==2) THEN BLOCK_PHASE_IF - ! KAXIS gasphase cut-faces: - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD +! Drop Edges and Faces: +IFC_LOOP_2 : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) + HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND + ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND + ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND + X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) + IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS + FACE_TYPE_IF_2 : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & + M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN - ! Local indexing in x1, x2, x3: - X1LO = KLO; X1HI = KHI - X2LO = ILO; X2HI = IHI - X3LO = JLO; X3HI = JHI + IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN + LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) + HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) + LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) + HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) + IF(LOWI>0 .AND. LOWJ>0) THEN + IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. & ! This is to drop this cut-face on the second hit. + M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0 .AND. M%CUT_FACE(IFCX)%SHARED(JFCX)) THEN + M%CUT_FACE(IFCX)%SHARED(JFCX) =.FALSE. + CYCLE IFC_LOOP_2 + ENDIF + ENDIF + ENDIF + SELECT CASE(X1AXIS) + CASE(IAXIS); II=I+ILH; JJ=J; KK=K + CASE(JAXIS); II=I; JJ=J+ILH; KK=K + CASE(KAXIS); II=I; JJ=J; KK=K+ILH END SELECT + IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP_2 - ! Loop on Cartesian faces, local x1, x2, x3 indexes: - DO II=X1LO,X1HI - DO KK=X3LO,X3HI - DO JJ=X2LO,X2HI + ENDIF FACE_TYPE_IF_2 - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI = INDXI(XIAXIS) - INDJ = INDXI(XJAXIS) - INDK = INDXI(XKAXIS) + SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_RCGAS) + ! 4. Make FCVAR(I,J,K,CC_CGSC,X1AXIS)=CC_SOLID, ECVAR and VERTVAR CC_SOLID where corresponds: + CALL DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) + CASE(CC_FTYPE_CFGAS) + ! Drop Face and Edges test: + DROP_FACE=.FALSE. + ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: + LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) + HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) + LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) + HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) + IF(LOWI>0 .AND. LOWJ>0) THEN + IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) THEN + DROP_FACE=.TRUE. + M%CUT_FACE(IFCX)%SHARED(JFCX) =.TRUE. + ENDIF + ENDIF - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE + ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) + JCC2_LOOP_3 : DO IFACE2=1,M%CUT_CELL(ICC2)%NFACE_DROPPED + IF(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & + M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(4,IFACE2)==IFCX .AND. & + M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(5,IFACE2)==JFCX) THEN + DROP_FACE=.TRUE. + EXIT JCC2_LOOP_3 + ENDIF + ENDDO JCC2_LOOP_3 + + DROP_FACE_IF : IF (DROP_FACE) THEN + SELECT CASE(X1AXIS) + CASE(IAXIS) + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + IF(AXISF==KAXIS) THEN + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J ; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ELSEIF(AXISF==JAXIS) THEN + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J-1; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ENDIF + CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! Drop edge JCE: + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + END SELECT + ENDDO + + CASE(JAXIS) + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + IF(AXISF==KAXIS) THEN + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J+ILHF; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I; JEG=J+ILHF; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ELSEIF(AXISF==IAXIS) THEN + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I ; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ENDIF + CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! Drop edge JCE: + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + END SELECT + ENDDO + CASE(KAXIS) + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + IF(AXISF==IAXIS) THEN + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I ; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ELSEIF(AXISF==JAXIS) THEN + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J-1; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I; JEG=J ; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ENDIF + CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! Drop edge JCE: + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + END SELECT + ENDDO + END SELECT - ! Drop if face not cut-face: - ! Test for FACE Cartesian edges being cut: - ! If outface1 is true -> All regular edges for this face: - ! Edge at index KK-1: - INDXI1(IAXIS:KAXIS) = (/ II, JJ , KK-1 /) ! Local x1,x2,x3 - INDI1 = INDXI1(XIAXIS) - INDJ1 = INDXI1(XJAXIS) - INDK1 = INDXI1(XKAXIS) - ! Edge at index KK: - INDXI2(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 - INDI2 = INDXI2(XIAXIS) - INDJ2 = INDXI2(XJAXIS) - INDK2 = INDXI2(XKAXIS) - ! Edge at index JJ-1: - INDXI3(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 - INDI3 = INDXI3(XIAXIS) - INDJ3 = INDXI3(XJAXIS) - INDK3 = INDXI3(XKAXIS) - ! Edge at index jj: - INDXI4(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 - INDI4 = INDXI4(XIAXIS) - INDJ4 = INDXI4(XJAXIS) - INDK4 = INDXI4(XKAXIS) + ! Drop (IFCX,JFCX) from CUT_FACE(IFCX): + CALL DROP_CUTFACE(NM,CC_FTYPE_CFGAS,I,J,K,ILHF,X1AXIS,IFCX,JFCX) + ENDIF DROP_FACE_IF + CASE(CC_FTYPE_CFINB) - OUTFACE1 = (MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) /= CC_CUTCFE) .AND. & - (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) /= CC_CUTCFE) + ! Drop cut-edges whithin the Cartesian cell I,J,K that belong to this INBOUNDARY cut-face: + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + IF(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)/=CC_ETYPE_CFINB) CYCLE + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + AXISE=M%CUT_EDGE(ICE)%IJK(4) + IF(AXISE>0) CYCLE + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + ENDDO - ! Test for face with INB edges: - ! If outface2 is true -> no INB Edges associated with this face: - OUTFACE2 = (MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) <= 0) + ! Scheme: + ! 1. Drop (IFC2,JFC2) from CUT_FACE(IFC2). Note this changes the face arrays, so FACE_LIST face indexes + ! for cut-cells on this CUT_CELL(ICC) entry need to be updated. + CALL DROP_CUTFACE(NM,CC_FTYPE_CFINB,I,J,K,ILHF,X1AXIS,IFCX,JFCX) - ! Drop if outface1 & outface2 - IF (OUTFACE1 .AND. OUTFACE2) THEN - ! Test if face is SOLID: - IF ((MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) == CC_SOLID) .AND. & - (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) == CC_SOLID) ) THEN - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID - ENDIF - CYCLE - ENDIF + END SELECT - ENDDO ! JJ - ENDDO ! KK - ENDDO ! II +ENDDO IFC_LOOP_2 - ENDDO XIAXIS_LOOP_2 +ELSEIF(BLOCK_PHASE==3) THEN BLOCK_PHASE_IF -ELSE - DEALLOCATE(IJK_COUNTED) -ENDIF +! At this point all faces defining the ICC,JCC cut-cell have been dropped in the CUT_FACE, CUT_CELL trees. +! We can drop JCC from CUT_CELL(ICC)%CCELEM, etc. +CALL DROP_CUTCELL(NM,ICC,JCC) -DEALLOCATE(NODEDG_FACE) -DEALLOCATE(CFELEM,CEDGES,CFE,CFEL) +ENDIF BLOCK_PHASE_IF -T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW +RETURN +END SUBROUTINE BLOCK_CUT_CELL -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - NCUTFCE = 0 - IF (BNDINT_FLAG) THEN - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_GASPHASE) CYCLE - NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE - ENDDO - ELSE - DO ICF=MESHES(NM)%N_CUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_GASPHASE) CYCLE - NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE - ENDDO - ENDIF - WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-faces : ',NCUTFCE,'. ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-faces : ',NCUTFCE,'. ' - ENDIF -ENDIF -RETURN +! ------------------------------ ADD_CUTEDGE_TO_FACE -------------------------------- -CONTAINS +SUBROUTINE ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IEC2,JEC2,IFC,JFC,KFC,X1AXFC) -SUBROUTINE REALLOCATE_NODEDG_FACE(N_SEG_CFACE,N_VERT_CFACE) +INTEGER, INTENT(IN) :: NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IFC,JFC,KFC,X1AXFC +INTEGER, INTENT(OUT):: IEC2,JEC2 -INTEGER, INTENT(IN) :: N_SEG_CFACE,N_VERT_CFACE -INTEGER :: DFCTE,DFCTV +! Local variables: +INTEGER :: INOD1,INOD2,VL1(1:4),VL2(1:4),NVERT,NEDGE,IEDGE +INTEGER, ALLOCATABLE :: EDGE_LIST_AUX(:,:) +REAL(EB):: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) +TYPE(MESH_TYPE), POINTER :: M -IF ( (N_SEG_CFACE+1 > SIZE_EDGES_NODEDG) .OR. (N_VERT_CFACE > SIZE_VERTS_NODEDG)) THEN - ! Allocation factors: - DFCTE = MAX(0,CEILING(REAL(N_SEG_CFACE+1-SIZE_EDGES_NODEDG,EB)/REAL(DELTA_EDGE,EB))) - DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE -SIZE_VERTS_NODEDG,EB)/REAL(DELTA_VERT,EB))) - DEALLOCATE(NODEDG_FACE) - SIZE_VERTS_NODEDG = SIZE_VERTS_NODEDG + DFCTV*DELTA_VERT - SIZE_EDGES_NODEDG = SIZE_EDGES_NODEDG + DFCTE*DELTA_EDGE - ALLOCATE(NODEDG_FACE(1:SIZE_EDGES_NODEDG,1:SIZE_VERTS_NODEDG)) -ENDIF -RETURN -END SUBROUTINE REALLOCATE_NODEDG_FACE +IEDGE=JCF2 ! Dummy for now FACE_LIST not filled for ETYPE_CFINB edges. -SUBROUTINE REALLOCATE_LOCAL_CFELEM(N_VERT_CFACE,N_FACE_CFACE) +M =>MESHES(NM) +IEC2=M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) +IF(IEC2<1) THEN ! Allocate space for CFINB cut-edge on this cut-face. -INTEGER, INTENT(IN) :: N_VERT_CFACE, N_FACE_CFACE -INTEGER :: DFCTF,DFCTV + ! Allocate space for cut-edge in CUT_EDGE: + IEC2 = M%N_CUTEDGE_MESH + 1 + M%N_CUTEDGE_MESH = IEC2 + M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = IEC2 + CALL CUT_EDGE_ARRAY_REALLOC(NM,IEC2) + M%CUT_EDGE(IEC2)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,IEC2,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + M%CUT_EDGE(IEC2)%NEDGE = 0 + M%CUT_EDGE(IEC2)%NEDGE1 = 0 + M%CUT_EDGE(IEC2)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. + M%CUT_EDGE(IEC2)%STATUS = CC_INBOUNDCF + ALLOCATE(M%CUT_EDGE(IEC2)%DXX(1:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%DXX = 0._EB + ALLOCATE(M%CUT_EDGE(IEC2)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%FACE_LIST = CC_UNDEFINED -IF ( (N_FACE_CFACE > SIZE_CFACES_CFELEM) .OR. (N_VERT_CFACE+1 > SIZE_VERTS_CFELEM)) THEN - DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE+1-SIZE_VERTS_CFELEM,EB)/REAL(DELTA_VERT,EB))) - DFCTF = MAX(0,CEILING(REAL(N_FACE_CFACE-SIZE_CFACES_CFELEM,EB)/REAL(DELTA_FACE,EB))) - DEALLOCATE(CFELEM) - SIZE_CFACES_CFELEM = SIZE_CFACES_CFELEM + DFCTF*DELTA_FACE - SIZE_VERTS_CFELEM = SIZE_VERTS_CFELEM + DFCTV*DELTA_VERT - ALLOCATE(CFELEM(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) - DEALLOCATE(CFE,CFEL); ALLOCATE(CFE(1:SIZE_VERTS_CFELEM),CFEL(1:SIZE_VERTS_CFELEM)) - IF(ALLOCATED(CEDGES)) DEALLOCATE(CEDGES); ALLOCATE(CEDGES(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) ENDIF -RETURN -END SUBROUTINE REALLOCATE_LOCAL_CFELEM +! Edge nodes location and type: +INOD1 = M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE) +INOD2 = M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE) +XV1(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD1) +XV2(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD2) +VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD1) ! [CC_VTYPE I J K] +VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD2) -SUBROUTINE REALLOCATE_LOCAL_VERT_CFELEM(N_VERT_CFACE) +! Add cut-edge: +NVERT = M%CUT_EDGE(IEC2)%NVERT +CALL REALLOCATE_EDGE_VERT(NM,IEC2,NVERT+2) +CALL INSERT_FACE_VERT(XV1,NM,IEC2,NVERT,INOD1) +CALL INSERT_FACE_VERT(XV2,NM,IEC2,NVERT,INOD2) -INTEGER, INTENT(IN) :: N_VERT_CFACE -INTEGER :: DFCTV -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM_AUX,CEDGES_AUX +DO NEDGE=1,M%CUT_EDGE(IEC2)%NEDGE + IF( (INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) .OR. & + (INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) ) THEN + JEC2=NEDGE; RETURN ! Edge already in Face cut-edges list. + ENDIF +ENDDO +JEC2=NEDGE +CALL REALLOCATE_EDGE_ELEM(NM,IEC2,NEDGE) -IF( N_VERT_CFACE > SIZE_VERTS_CFELEM ) THEN - DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE-SIZE_VERTS_CFELEM,EB)/REAL(DELTA_VERT,EB))) - ALLOCATE(CFELEM_AUX(1:SIZE_VERTS_CFELEM+DFCTV*DELTA_VERT,1:SIZE_CFACES_CFELEM)) - CFELEM_AUX(:,:) = CC_UNDEFINED - CFELEM_AUX(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) = CFELEM(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) - ALLOCATE(CEDGES_AUX(1:SIZE_VERTS_CFELEM+DFCTV*DELTA_VERT,1:SIZE_CFACES_CFELEM)) - CEDGES_AUX(:,:) = CC_UNDEFINED - CEDGES_AUX(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) = CEDGES(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) - SIZE_VERTS_CFELEM = SIZE_VERTS_CFELEM + DFCTV*DELTA_VERT - CALL MOVE_ALLOC(FROM=CFELEM_AUX,TO=CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=CEDGES) - ! Now Reallocate CFE, CFEL: - DEALLOCATE(CFE,CFEL); ALLOCATE(CFE(1:SIZE_VERTS_CFELEM),CFEL(1:SIZE_VERTS_CFELEM)) +! Check first node type, if gas vertex make it boundary vertex and change VERTVAR to CC_SOLID: +M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = VL1(1:4) +IF(VL1(1)==CC_VTYPE_VGAS) THEN + M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,VL1(2),VL1(3),VL1(4)/) + M%VERTVAR(VL1(2),VL1(3),VL1(4),CC_VGSC) = CC_SOLID +ENDIF +M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = VL2(1:4) +IF(VL2(1)==CC_VTYPE_VGAS) THEN + M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,VL2(2),VL2(3),VL2(4)/) + M%VERTVAR(VL2(2),VL2(3),VL2(4),CC_VGSC) = CC_SOLID ENDIF -RETURN -END SUBROUTINE REALLOCATE_LOCAL_VERT_CFELEM - -END SUBROUTINE GET_CARTFACE_CUTFACES - - -! ---------------- DEFINE_REGULAR_CUTFACES -------------------------- -SUBROUTINE DEFINE_REGULAR_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) +! Add edge: Assumes XV1 < XV2 in X1AXEG direction: +M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) +IF(ILHF==-1) M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -LOGICAL, INTENT(IN) :: BNDINT_FLAG +M%CUT_EDGE(IEC2)%NVERT = NVERT +M%CUT_EDGE(IEC2)%NEDGE = NEDGE -! Local Variables: -INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI,X1AXIS,NVERT,NFACE,I,J,K,NCUTFACE -INTEGER :: IBNDINT,BNDINT_LOW,BNDINT_HIGH +M%CUT_EDGE(IEC2)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED +! Define Edge as INB CUT_EDGE, find corresponding CFGAS EDGE associated cut-face and replace it +IF(ICF2>0) THEN + ! Reallocate EDGE_LIST if JCE2 exceeds current size + NVERT = 0 + IF(ALLOCATED(M%CUT_FACE(ICF2)%EDGE_LIST)) NVERT = SIZE(M%CUT_FACE(ICF2)%EDGE_LIST,DIM=2)-1 + IF(JCE2 > NVERT) THEN + ALLOCATE(EDGE_LIST_AUX(3,0:JCE2)) + EDGE_LIST_AUX = CC_UNDEFINED + IF(NVERT > 0) EDGE_LIST_AUX(1:3,0:NVERT) = M%CUT_FACE(ICF2)%EDGE_LIST(1:3,0:NVERT) + CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX, TO=M%CUT_FACE(ICF2)%EDGE_LIST) + ENDIF + M%CUT_FACE(ICF2)%EDGE_LIST(1:3,JCE2) = (/CC_ETYPE_CFINB, IEC2, JEC2/) +ENDIF -CALL POINT_TO_MESH(NM) +END SUBROUTINE ADD_CUTEDGE_TO_FACE -! Mesh sizes: -NXB=IBAR -NYB=JBAR -NZB=KBAR -! Test Sizes: -IF (PERIODIC_TEST == 7 ) THEN - VAL_TESTX_LOW =-.5_EB - VAL_TESTX_HIGH= .5_EB - VAL_TESTY_LOW = YS - VAL_TESTY_HIGH= YF - VAL_TESTZ_LOW =-.5_EB - VAL_TESTZ_HIGH= .5_EB -ELSEIF (PERIODIC_TEST == 11) THEN - VAL_TESTX_LOW =-.5_EB - VAL_TESTX_HIGH= .5_EB - VAL_TESTY_LOW = YS - VAL_TESTY_HIGH= YF - VAL_TESTZ_LOW = ZS - VAL_TESTZ_HIGH= ZF -ELSEIF (PERIODIC_TEST == 103) THEN - VAL_TESTX_LOW =-1.0_EB - VAL_TESTX_HIGH= 1.0_EB - VAL_TESTY_LOW =-1.0_EB - VAL_TESTY_HIGH= 1.0_EB - VAL_TESTZ_LOW = 1.0_EB - VAL_TESTZ_HIGH= 3.0_EB -ENDIF +! ------------------------------ ADD_CUTEDGE_TO_EDGE ------------------------------- +SUBROUTINE ADD_CUTEDGE_TO_EDGE(NM,ILHF,IEG,JEG,KEG,X1AXEG,XV1,XV2) -! Main Loop on block NM: -IF (BNDINT_FLAG) THEN - ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. - BNDINT_LOW = 1 - BNDINT_HIGH = 3 -ELSE - BNDINT_LOW = 4 - BNDINT_HIGH = 4 -ENDIF +INTEGER, INTENT(IN) :: NM,ILHF,IEG,JEG,KEG,X1AXEG +REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) -IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, - ! 4 guard-cell faces. +! Local Variables: +INTEGER :: NVERT,INOD1,INOD2,ICF,CEI,NEDGE,NOD1_TYPE,NOD2_TYPE,LOHI,AXIS +TYPE(MESH_TYPE), POINTER :: M - ! When switching to internal faces, copy number of external faces already computed. - IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH +M=>MESHES(NM) +IF(M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG)==CC_SOLID) RETURN - ! First tag and define Gasphase cut-faces in X,Y,Z directions. - ! X direction: - ! IAXIS gasphase cut-faces: - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - ILO = ILO_FACE; IHI = ILO_FACE - CASE(2) - ILO = IHI_FACE; IHI = IHI_FACE - CASE(3) - ILO = ILO_FACE+1; IHI = IHI_FACE-1 - CASE(4) - ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT - X1AXIS=IAXIS - NVERT = 4 - NFACE = 1 - DO I=ILO,IHI - DO J=JLO,JHI - DO K=KLO,KHI +! Define Gas Cut-edge: +CEI = M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) +IF(CEI<1) THEN + ! Allocate space for cut-edge in CUT_EDGE: + CEI = M%N_CUTEDGE_MESH + 1 + M%N_CUTEDGE_MESH = CEI + M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG) = CC_CUTCFE + M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + M%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + M%CUT_EDGE(CEI)%NEDGE = 0 + M%CUT_EDGE(CEI)%NEDGE1 = 0 + M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+1) = (/ IEG,JEG,KEG,X1AXEG /) ! Gas right to solid left. + M%CUT_EDGE(CEI)%STATUS = CC_GASPHASE + ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB + ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED - ! If cut-cell centroid is outside the test box -> drop: - IF(XFACE(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XFACE(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE - IF(YCELL(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YCELL(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE - IF(ZCELL(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZCELL(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE +ELSE ! CUT_EDGE + IF(ILHF==-1) THEN + INOD2 = M%CUT_EDGE(CEI)%CEELEM(NOD2,M%CUT_EDGE(CEI)%NEDGE) ! High node of last gas segment. + M%CUT_EDGE(CEI)%VERT_LIST(1,INOD2) = CC_VTYPE_VINB + ELSE + INOD1 = M%CUT_EDGE(CEI)%CEELEM(NOD1,1) ! Low node of first gas segment. + M%CUT_EDGE(CEI)%VERT_LIST(1,INOD1) = CC_VTYPE_VINB + ENDIF + RETURN +ENDIF - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. +! Add new cut-edge created from regular edge: +NVERT = M%CUT_EDGE(CEI)%NVERT +CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) +CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) +CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) - FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE +NEDGE = M%CUT_EDGE(CEI)%NEDGE+1 +CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF +! Define Vert List for newly defined cut-edge: +IF (ILHF==-1) THEN + NOD1_TYPE = CC_VTYPE_VGAS + NOD2_TYPE = CC_VTYPE_VINB +ELSE + NOD1_TYPE = CC_VTYPE_VINB + NOD2_TYPE = CC_VTYPE_VGAS +ENDIF +SELECT CASE(X1AXEG) +CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG-1,JEG ,KEG /) +CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG-1,KEG /) +CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG ,KEG-1/) +END SELECT +M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/NOD2_TYPE,IEG ,JEG ,KEG /) - FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE +! Add edge: Assumes XV1 < XV2 in X1AXEG direction: +M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +M%CUT_EDGE(CEI)%NVERT = NVERT +M%CUT_EDGE(CEI)%NEDGE = NEDGE - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, X1AXIS /) - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERT+1,IBNDINT) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) +! There might be cut-faces that note this EDGE as a regular Gas edge, change incidence in their EDGE_LIST: +SELECT CASE(X1AXEG) +CASE(IAXIS) + ! Face at LOC=-2, located at low Z normal to Y axis: + ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC=-1, located at low Y normal to Z axis: + ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 1, located at high Y normal to Z axis: + ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 2, located at high Z normal to Y axis: + ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) +CASE(JAXIS) + ! Face at LOC=-2, located at low X normal to Z axis: + ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC=-1, located at low Z normal to X axis: + ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 1, located at high Z normal to X axis: + ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 2, located at high X normal to Z axis: + ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) +CASE(KAXIS) + ! Face at LOC=-2, located at low Y normal to X axis: + ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC=-1, located at low X normal to Y axis: + ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! IF(IEG==7 .AND. JEG==4 .AND. KEG==4) THEN + ! WRITE(LU_ERR,*) 'Found EDGE IN CUTEDGE To EDGE IF,JF,KF,AXIS,ICF=',IEG,JEG,KEG,JAXIS,ICF,CEI + ! DO INOD1=1,SIZE(M%CUT_FACE(ICF)%EDGE_LIST,DIM=2)-1 + ! WRITE(LU_ERR,*) M%CUT_FACE(ICF)%EDGE_LIST(:,INOD1) + ! ENDDO + ! ENDIF + ! Face at LOC= 1, located at high X normal to Y axis: + ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 2, located at high Y normal to X axis: + ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) +END SELECT - ! Vertices: - CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) - CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) - CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) - CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) +END SUBROUTINE ADD_CUTEDGE_TO_EDGE - ! Centroid: - CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & - (/ XFACE(I )+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) +! --------------------------- REPL_CUTEDGE_IN_LIST_EDGES --------------------------- - ! Load Ordered nodes to CFELEM and geom properties: - CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) - CF%AREA(NFACE) = DYCELL(J)*DZCELL(K) +SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,IEC,JEC,LOHI,AXIS) - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: - CF%INXAREA(NFACE) = XFACE(I)*CF%AREA(NFACE) - ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: - CF%INXSQAREA(NFACE) = XFACE(I)**2._EB*CF%AREA(NFACE) - ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: - CF%JNYSQAREA(NFACE) = 0._EB - ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: - CF%KNZSQAREA(NFACE) = 0._EB - ENDDO - ENDDO - ENDDO +INTEGER, INTENT(IN) :: NM,ICF,IEC,JEC,LOHI,AXIS +INTEGER :: IEDGE,DUM - ! Y direction: - ! JAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - JLO = JLO_FACE; JHI = JLO_FACE - CASE(2) - JLO = JHI_FACE; JHI = JHI_FACE - CASE(3) - JLO = JLO_FACE+1; JHI = JHI_FACE-1 - CASE(4) - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT - X1AXIS=JAXIS - NVERT = 4 - NFACE = 1 - DO I=ILO,IHI - DO J=JLO,JHI - DO K=KLO,KHI +IF(ICF>0) THEN + DUM=0; IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST)) DUM=SIZE(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST,DIM=2) + DO IEDGE=1,DUM-1 + IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE + IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE + IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(3,IEDGE)/=AXIS) CYCLE + MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFGAS,IEC,JEC/) + RETURN + ENDDO +ENDIF +END SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES - ! If cut-cell centroid is outside the test box -> drop: - IF(XCELL(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XCELL(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE - IF(YFACE(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YFACE(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE - IF(ZCELL(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZCELL(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE +! ------------------------------ ADD_REGEDGE_TO_FACE ------------------------------- - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. +SUBROUTINE ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD,XV1,XV2,CEI,NEDGE,IV_LIST) - FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF +! ILHF -1 face in low side of edge, 0 face on high side of edge. - FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE +INTEGER, INTENT(IN) :: NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD +REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) +INTEGER, INTENT(OUT):: CEI,NEDGE +LOGICAL, INTENT(IN) :: IV_LIST - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +! Local Variables: +INTEGER :: NVERT,INOD1,INOD2,ICF,IEDGE,LOHI +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTFACE_TYPE), POINTER :: CF - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, X1AXIS /) - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERT+1,IBNDINT) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) +M=>MESHES(NM) +IF(M%FCVAR(IFC,JFC,KFC,CC_FGSC,X1AXFC)==CC_SOLID) RETURN - ! Vertices: - CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) - CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) - CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) - CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) +! Define Edge as INB cut-edge, add to CUT_EDGE: +CEI = M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) +IF (CEI < 1) THEN + ! Allocate space for cut-edge in CUT_EDGE: + CEI = M%N_CUTEDGE_MESH + 1 + M%N_CUTEDGE_MESH = CEI + M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + M%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + M%CUT_EDGE(CEI)%NEDGE = 0 + M%CUT_EDGE(CEI)%NEDGE1 = 0 + M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. + M%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF + ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB + ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED +ENDIF - ! Centroid: - CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & - (/ XFACE(I-1)+XFACE(I ), YFACE(J )+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) +! Add cut-edge: +NVERT = M%CUT_EDGE(CEI)%NVERT +CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) +CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) +CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) - ! Load Ordered nodes to CFELEM and geom properties: - CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) - CF%AREA(NFACE) = DXCELL(I)*DZCELL(K) +DO NEDGE=1,M%CUT_EDGE(CEI)%NEDGE + IF( (INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) .OR. & + (INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) ) THEN + RETURN ! Edge already in Face cut-edges list. + ENDIF +ENDDO +CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: - CF%INXAREA(NFACE) = 0._EB - ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: - CF%INXSQAREA(NFACE) = 0._EB - ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: - CF%JNYSQAREA(NFACE) = YFACE(J)**2._EB*CF%AREA(NFACE) - ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: - CF%KNZSQAREA(NFACE) = 0._EB - ENDDO - ENDDO +SELECT CASE(X1AXEG) +CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG-1,JEG ,KEG /) +CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG-1,KEG /) +CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG ,KEG-1/) +END SELECT +M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,IEG ,JEG ,KEG /) +IF(IV_LIST) THEN + ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: + M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) + IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) +ELSE + ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: + M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) + IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) +ENDIF + +M%CUT_EDGE(CEI)%NVERT = NVERT +M%CUT_EDGE(CEI)%NEDGE = NEDGE + +M%CUT_EDGE(CEI)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) + +ICF = M%FCVAR(IFC,JFC,KFC,CC_IDCF,X1AXFC) +IF (ICF>0) THEN ! There are cut-faces in this face + LOHI= LOW_IND; IF(ILHF==-1) LOHI=HIGH_IND + ! Define Edge as INB CUT_EDGE, find corresponding RGGAS EDGE associated cut-face and replace it + CF=>M%CUT_FACE(ICF); + INOD1=0; IF(ALLOCATED(CF%EDGE_LIST)) INOD1=SIZE(CF%EDGE_LIST,DIM=2) + DO IEDGE=1,INOD1-1 + IF(CF%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE + IF(CF%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE + IF(CF%EDGE_LIST(3,IEDGE)/=X1AXIS) CYCLE + CF%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFINB, CEI, NEDGE/) + RETURN ENDDO +ENDIF - ! Z direction: - ! KAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - KLO = KLO_FACE; KHI = KLO_FACE - CASE(2) - KLO = KHI_FACE; KHI = KHI_FACE - CASE(3) - KLO = KLO_FACE+1; KHI = KHI_FACE-1 - CASE(4) - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - END SELECT - X1AXIS=KAXIS - NVERT = 4 - NFACE = 1 - DO I=ILO,IHI - DO J=JLO,JHI - DO K=KLO,KHI +END SUBROUTINE ADD_REGEDGE_TO_FACE - ! If cut-cell centroid is outside the test box -> drop: - IF(XCELL(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XCELL(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE - IF(YCELL(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YCELL(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE - IF(ZFACE(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZFACE(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. +! --------------------------------- DROP_REG_FACE ------------------------------------------- - FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE +SUBROUTINE DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF +INTEGER, INTENT(IN) :: NM,I,J,K,ILHF,X1AXIS - FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE +SELECT CASE(X1AXIS) +CASE(IAXIS) + ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: + MESHES(NM)%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID + MESHES(NM)%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: + MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_EGSC,JAXIS)= CC_SOLID ! X2 + MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_IDCE,JAXIS)= CC_UNDEFINED + MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_EGSC,KAXIS)= CC_SOLID ! X3 + MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_IDCE,KAXIS)= CC_UNDEFINED + ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: + MESHES(NM)%VERTVAR(I+ILHF, J-1:J, K-1:K,CC_VGSC) = CC_SOLID +CASE(JAXIS) + ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: + MESHES(NM)%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID + MESHES(NM)%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: + MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_EGSC,KAXIS)= CC_SOLID ! X2 + MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_IDCE,KAXIS)= CC_UNDEFINED + MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_EGSC,IAXIS)= CC_SOLID ! X3 + MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_IDCE,IAXIS)= CC_UNDEFINED + ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: + MESHES(NM)%VERTVAR( I-1:I,J+ILHF, K-1:K,CC_VGSC) = CC_SOLID +CASE(KAXIS) + ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: + MESHES(NM)%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID + MESHES(NM)%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED + ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: + MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_EGSC,IAXIS)= CC_SOLID ! X2 + MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_IDCE,IAXIS)= CC_UNDEFINED + MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_EGSC,JAXIS)= CC_SOLID ! X3 + MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_IDCE,JAXIS)= CC_UNDEFINED + ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: + MESHES(NM)%VERTVAR( I-1:I, J-1:J,K+ILHF,CC_VGSC) = CC_SOLID +END SELECT - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +END SUBROUTINE DROP_REG_FACE - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, X1AXIS /) - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERT+1,IBNDINT) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - ! Vertices: - CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) - CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) - CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) - CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) +! --------------------------- INSERT_CUT_CELL ----------------------------------------------- - ! Centroid: - CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & - (/ XFACE(I-1)+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K )+ZFACE(K ) /) +SUBROUTINE INSERT_CUT_CELL(NM,I,J,K,ICC) - ! Load Ordered nodes to CFELEM and geom properties: - CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) - CF%AREA(NFACE) = DXCELL(I)*DYCELL(J) +! Adds a cut-cell entry ICF in the CUT_CELL array, assumes no cut-cell defined in cell I,J,K. +INTEGER, INTENT(IN) :: NM,I,J,K +INTEGER, INTENT(OUT):: ICC - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: - CF%INXAREA(NFACE) = 0._EB - ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: - CF%INXSQAREA(NFACE) = 0._EB - ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: - CF%JNYSQAREA(NFACE) = 0._EB - ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: - CF%KNZSQAREA(NFACE) = ZFACE(K)**2._EB*CF%AREA(NFACE) - ENDDO +INTEGER :: DUM,KDUM,JDUM,IDUM,ICF,JCF + +TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX + +IF( 0=ICC) & + MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC) + 1 ENDDO ENDDO +ENDDO +DO ICF=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + DO JCF=1,MESHES(NM)%CUT_FACE(ICF)%NFACE + IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>ICC) & + MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + 1 + IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>ICC) & + MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + 1 + ENDDO +ENDDO -ENDDO IBNDINT_LOOP - -IF (.NOT.BNDINT_FLAG) DEALLOCATE( IJK_COUNTED ) +MESHES(NM)%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) +MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE +MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = ICC RETURN -END SUBROUTINE DEFINE_REGULAR_CUTFACES +END SUBROUTINE INSERT_CUT_CELL +! --------------------------- INSERT_CUT_FACE ----------------------------------------------- -! ---------------------------- SORT_VERTS --------------------------------------- +SUBROUTINE INSERT_CUT_FACE(NM,I,J,K,AXIS,ICF,INZONE) -SUBROUTINE SORT_VERTS(MAXVERTS,NVERTS,VERTS1,VERTS2,XV,ASCDESC,NV,V) +! This routine add a cut-face entry ICF in the CUT_FACE array: +! 1. IF AXIS = 0 INBOUNDARY face: +! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK is an interior cell. +! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK is a guard cell. +! 2. IF AXIS = 1,2,3 GASPHASE face: +! ICF = MESHES(NM)%N_BBCUTFACE_MESH+1 if II,JJ,KK,AXIS is a boundary face. +! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK,AXIS is an interior face. +! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK,AXIS is a guard face. +INTEGER, INTENT(IN) :: NM,I,J,K,AXIS +INTEGER, INTENT(OUT):: ICF +LOGICAL, OPTIONAL, INTENT(IN) :: INZONE -INTEGER, INTENT(IN) :: MAXVERTS, NVERTS -REAL(EB),INTENT(IN) :: VERTS1(MAXVERTS),VERTS2(MAXVERTS),XV -LOGICAL, INTENT(IN) :: ASCDESC -INTEGER, INTENT(OUT):: NV,V(MAXVERTS) -! Local Variables: -INTEGER :: IV, IIV, JJV -INTEGER :: V2(MAXVERTS) -LOGICAL :: FOUND +INTEGER :: ICC,JCC,IFC,IFACE,IFCX,DUM,IDUM,JDUM,KDUM,X1AXIS,ICE,ILOC,IEDGE +TYPE(CC_CUTFACE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_FACE_AUX -V(:) = 0 -NV = 0 -DO IV=1,NVERTS - IF (ABS(VERTS1(IV)-XV) < GEOMEPS) THEN - IF (NV==0) THEN - NV=1; V(NV)=IV - ELSE - ! Insert add IV, using ascending X3: - FOUND=.FALSE. - DO IIV=1,NV - IF ( (VERTS2(IV)-VERTS2(V(IIV))) < 0._EB ) THEN - FOUND=.TRUE. - EXIT - ENDIF - ENDDO - IF (FOUND) THEN - DO JJV=NV+1,IIV+1,-1 - V(JJV) = V(JJV-1) - ENDDO - V(IIV) = IV - ELSE - V(IIV) = IV ! Here IIV = NV+1, as loop leaves it to that value. +IF(AXIS==0) THEN + IF( 0MESHES(NM)%IBAR) THEN ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ELSEIF(I==0 .OR. I==MESHES(NM)%IBAR) THEN ! Block boundary + MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 + MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 + ICF = MESHES(NM)%N_BBCUTFACE_MESH ENDIF - NV=NV+1 + ELSE ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH ENDIF - ENDIF -ENDDO -IF (.NOT.ASCDESC) THEN - V2(1:NV) = V(1:NV) - DO IV=1,NV; V(NV+1-IV)=V2(IV); ENDDO + CASE(JAXIS) + IF(0MESHES(NM)%JBAR) THEN ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ELSEIF(J==0 .OR. J==MESHES(NM)%JBAR) THEN ! Block boundary + MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 + MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 + ICF = MESHES(NM)%N_BBCUTFACE_MESH + ENDIF + ELSE ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ENDIF + CASE(KAXIS) + IF(0MESHES(NM)%KBAR) THEN ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ELSEIF(K==0 .OR. K==MESHES(NM)%KBAR) THEN ! Block boundary + MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 + MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 + ICF = MESHES(NM)%N_BBCUTFACE_MESH + ENDIF + ELSE ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ENDIF + END SELECT ENDIF -RETURN -END SUBROUTINE SORT_VERTS - -! ----------------------------- FACE_REALLOC ------------------------------------- - -SUBROUTINE FACE_REALLOC(NM,ICF,NVERT,NFACE,NSVERT,NSFACE,NVERTFACE_NEW) - -INTEGER, INTENT(IN) :: NM,ICF,NVERT,NFACE,NSVERT,NSFACE -INTEGER, INTENT(INOUT) :: NVERTFACE_NEW - -! Local Variables: -INTEGER :: NVERTFACE -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZVERT, XYZCEN, REAL2D -REAL(EB), ALLOCATABLE, DIMENSION(:) :: AREA, REAL1D -INTEGER, ALLOCATABLE, DIMENSION(:) :: INT1D -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM, INT2D ! Cut-faces connectivities. -INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: INT3D -LOGICAL, ALLOCATABLE, DIMENSION(:) :: SHARED - -NVERTFACE=SIZE(MESHES(NM)%CUT_FACE(ICF)%CFELEM,DIM=1) -NVERTFACE_NEW = MAX(NVERTFACE_NEW,NVERTFACE) +! Reallocate CUT_FACE: +ALLOCATE(CUT_FACE_AUX( MAX(SIZE(MESHES(NM)%CUT_FACE,DIM=1),MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH) )) +DO DUM=1,ICF-1 + CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM)) +ENDDO +DO DUM=ICF,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH-1 + CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM+1)) +ENDDO +CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE) -IF(SIZE(MESHES(NM)%CUT_FACE(ICF)%XYZVERT,DIM=2) < NVERT+NSVERT) THEN - ! Allocate and initialize NVERT related fields: - ALLOCATE(XYZVERT(IAXIS:KAXIS,1:NVERT+NSVERT)); XYZVERT = 0._EB - XYZVERT(IAXIS:KAXIS,1:NVERT)=MESHES(NM)%CUT_FACE(ICF)%XYZVERT(IAXIS:KAXIS,1:NVERT) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=MESHES(NM)%CUT_FACE(ICF)%XYZVERT) +! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): +DO KDUM=-CCGUARD,MESHES(NM)%KBAR+CCGUARD + DO JDUM=-CCGUARD,MESHES(NM)%JBAR+CCGUARD + DO IDUM=-CCGUARD,MESHES(NM)%IBAR+CCGUARD + IF(MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)>=ICF) & + MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF) + 1 + DO X1AXIS=IAXIS,KAXIS + IF(MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS)>=ICF) & + MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) = MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) + 1 + ENDDO + ENDDO + ENDDO +ENDDO +DO ICC=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + DO JCC=1,MESHES(NM)%CUT_CELL(ICC)%NCELL + DO IFC=1,MESHES(NM)%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = MESHES(NM)%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + IF(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) CYCLE + IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) = IFCX+1 + ENDDO + ENDDO + DO IFACE=1,MESHES(NM)%CUT_CELL(ICC)%NFACE_DROPPED + IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) + IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) = IFCX+1 + ENDDO +ENDDO +DO ICE=1,MESHES(NM)%N_CUTEDGE_MESH + CE=>MESHES(NM)%CUT_EDGE(ICE) + DO IEDGE=1,CE%NEDGE + DO ILOC=-2,2 + IF(CE%FACE_LIST(1,ILOC,IEDGE)>=ICF) CE%FACE_LIST(1,ILOC,IEDGE)=CE%FACE_LIST(1,ILOC,IEDGE)+1 + ENDDO + ENDDO +ENDDO +IF(PRESENT(INZONE)) THEN + IF (INZONE) THEN + DO KDUM=0,MESHES(NM)%KBP1 + DO JDUM=0,MESHES(NM)%JBP1 + DO IDUM=0,MESHES(NM)%IBP1 + DO JCC=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%NCELL + DO IFACE=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NWFACE + IF(MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE)>=ICF) & + MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) = & + MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) + 1 + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDIF ENDIF -IF(SIZE(MESHES(NM)%CUT_FACE(ICF)%AREA,DIM=1)MESHES(NM) +CE=>M%CUT_EDGE(ICE) - ALLOCATE(REAL1D(1:NFACE+NSFACE)); REAL1D = 1._EB - CALL MOVE_ALLOC(FROM=REAL1D,TO=MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST) +NEDGE_IF_1 : IF(CE%NEDGE>1) THEN + ALLOCATE(IND(CE%NEDGE)); IND = 0 + CT=0; + DO DUM=1,CE%NEDGE + IF(DUM==JCE) CYCLE + CT = CT + 1 + IND(DUM) = CT + ENDDO + ! Collapse NEDGE variables: + DO DUM=1,CE%NEDGE + IF(DUM==JCE) CYCLE + CE%CEELEM( :,IND(DUM)) = CE%CEELEM( :,DUM) + CE%INDSEG( :,IND(DUM)) = CE%INDSEG( :,DUM) + CE%FACE_LIST(:,:,IND(DUM)) = CE%FACE_LIST(:,:,DUM) + CE%DXX( :,IND(DUM)) = CE%DXX( :,DUM) - ALLOCATE(INT1D(1:NFACE+NSFACE)); INT1D=NOT_BLOCKED - INT1D(1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN(1:NFACE) - CALL MOVE_ALLOC(FROM=INT1D,TO=MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN) + ! Finally change EDGE_LIST of involved faces: + DO ILH=-2,2 + ICF1 = CE%FACE_LIST(1,ILH,IND(DUM)); IF(ICF1<1) CYCLE + IEDGE = CE%FACE_LIST(3,ILH,IND(DUM)) + M%CUT_FACE(ICF1)%EDGE_LIST(3,IEDGE) = IND(DUM) + ENDDO + ENDDO +ENDIF NEDGE_IF_1 +CE%NEDGE = CE%NEDGE - 1 +IF(CE%NEDGE < 1) THEN + IF(ETYPE==CC_ETYPE_CFGAS) THEN + M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_EGSC,CE%IJK(KAXIS+1)) = CC_SOLID + M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED + ELSEIF(ETYPE==CC_ETYPE_CFINB) THEN + IF(CE%IJK(KAXIS+1)>0) THEN + M%FCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED + ELSE + M%CCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE) = CC_UNDEFINED + ENDIF ENDIF + CE%STATUS = CC_SOLID ENDIF -RETURN +END SUBROUTINE DROP_CUT_EDGE -END SUBROUTINE FACE_REALLOC +! ----------------------------- DROP_CUTFACE -------------------------------------- -! ---------------------- CUT_FACE_ARRAY_REALLOC ------------------------------- +SUBROUTINE DROP_CUTFACE(NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC) -SUBROUTINE CUT_FACE_ARRAY_REALLOC(NM,ICF) +! Drop cut-face CUT_FACE(ICF)%CFELEM(:,JCF): +! 0. For garphase cut-faces, move gas edges (reg and cut) to INB face CUT_EDGEs where it corresponds. +! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). +! 2. Change second index for cut-faces of cells attached to ICF,JCF +! 3. If zero remaining cut-faces in CUT_FACE(ICF) => make FCVAR,CCVAR GSC and IDCF indexes SOLID and INDEFINED. -INTEGER, INTENT(IN) :: NM,ICF +INTEGER, INTENT(IN) :: NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC -! Local Variables: -INTEGER :: ICF1, SIZE_CUT_FACE +INTEGER :: CT,DUM,ILH,ICC1,JCC1,IFACE,IFC1,IFACE2 +INTEGER, ALLOCATABLE, DIMENSION(:) :: IND +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTFACE_TYPE), POINTER :: CF -SIZE_CUT_FACE = SIZE(MESHES(NM)%CUT_FACE,DIM=1) +M => MESHES(NM) +CF=> M%CUT_FACE(IFC) -IF(ICF > SIZE_CUT_FACE) THEN +! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). +NFACE_IF_1 : IF(CF%NFACE>1) THEN + ALLOCATE(IND(CF%NFACE)); IND = 0 + CT=0; + DO DUM=1,CF%NFACE + IF(DUM==JFC) CYCLE + CT = CT + 1 + IND(DUM) = CT + ENDDO + ! Collapse NFACE variables: + DO DUM=1,CF%NFACE + IF(DUM==JFC) CYCLE + CF%CFELEM( :,IND(DUM)) = CF%CFELEM( :,DUM) + CF%CEDGES( :,IND(DUM)) = CF%CEDGES( :,DUM) + CF%AREA( IND(DUM)) = CF%AREA( DUM) + CF%XYZCEN( :,IND(DUM)) = CF%XYZCEN( :,DUM) + CF%SHARED( IND(DUM)) = CF%SHARED( DUM) + CF%CELL_LIST(:,:,IND(DUM)) = CF%CELL_LIST(:,:,DUM) + ! Finally change FACE_LIST of involved cells: + CT = HIGH_IND + IF(FTYPE==CC_FTYPE_CFINB) THEN + CT = LOW_IND + CF%BODTRI( :,IND(DUM)) = CF%BODTRI( :,DUM) + CF%SURF_INDEX( IND(DUM)) = CF%SURF_INDEX( DUM) + CF%BLK_TAG( IND(DUM)) = CF%BLK_TAG( DUM) + CF%CFACE_ORIGIN( IND(DUM)) = CF%CFACE_ORIGIN( DUM) + CF%AREA_ADJUST( IND(DUM)) = CF%AREA_ADJUST( DUM) + ENDIF + DO ILH=LOW_IND,CT + ICC1 = CF%CELL_LIST(2,ILH,IND(DUM)) + JCC1 = CF%CELL_LIST(3,ILH,IND(DUM)) + IFC1 = CF%CELL_LIST(4,ILH,IND(DUM)) + IFACE= M%CUT_CELL(ICC1)%CCELEM(IFC1+1,JCC1) + ! Dropping gas-cut cells, do not reindex local JCF for INBOUNDARY faces. These have been changed already. + IF(FTYPE==CC_FTYPE_CFINB .OR. (FTYPE==CC_FTYPE_CFGAS .AND. M%CUT_CELL(ICC1)%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB)) & + M%CUT_CELL(ICC1)%FACE_LIST(5,IFACE) = IND(DUM) + DO IFACE2=1,M%CUT_CELL(ICC1)%NFACE_DROPPED + IF(M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & + M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(4,IFACE2)==IFC .AND. & + M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)==DUM) & + M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)=IND(DUM) + ENDDO + ENDDO + ENDDO + CF%CFELEM( :,CF%NFACE) = CC_UNDEFINED + CF%CEDGES( :,CF%NFACE) = CC_UNDEFINED + CF%AREA( CF%NFACE) = 0._EB + CF%XYZCEN( :,CF%NFACE) = 0._EB + CF%SHARED( CF%NFACE) = .FALSE. + CF%BLK_TAG( CF%NFACE) = .FALSE. + CF%CELL_LIST(:,:,CF%NFACE) = CC_UNDEFINED + IF(FTYPE==CC_FTYPE_CFINB) THEN + CF%BODTRI( :,CF%NFACE) = CC_UNDEFINED + CF%SURF_INDEX( CF%NFACE) = CC_UNDEFINED + CF%CFACE_ORIGIN( CF%NFACE) = CC_UNDEFINED + ENDIF + DEALLOCATE(IND) +ENDIF NFACE_IF_1 - ALLOCATE(CUT_FACE_AUX(SIZE_CUT_FACE+GLOBAL_DELTA_FACE)) +CF%NFACE = MAX(0,CF%NFACE - 1) - DO ICF1=1,ICF-1 - CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(ICF1),CUT_FACE_AUX(ICF1)) +IF(FTYPE==CC_FTYPE_CFGAS .AND. CF%NSFACE>0) THEN ! Bring down SOLID faces used for SLCF plotting. + CT=CF%NFACE + DO DUM=1,CF%NSFACE + CT=CT+1 + CF%CFELEM( :,CT) = CF%CFELEM( :,CT+1) + CF%CEDGES( :,CT) = CF%CEDGES( :,CT+1) + CF%AREA( CT) = CF%AREA( CT+1) + CF%XYZCEN( :,CT) = CF%XYZCEN( :,CT+1) ENDDO - CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE) ENDIF -RETURN -END SUBROUTINE CUT_FACE_ARRAY_REALLOC - - -! --------------------------- CUT_FACE_MOVE ------------------------------------- - -SUBROUTINE CUT_FACE_MOVE(CUT_FACE_FROM,CUT_FACE_TO) - -TYPE(CC_CUTFACE_TYPE), INTENT(INOUT) :: CUT_FACE_FROM, CUT_FACE_TO - -CUT_FACE_TO%IWC = CUT_FACE_FROM%IWC -CUT_FACE_TO%PRES_ZONE = CUT_FACE_FROM%PRES_ZONE -CUT_FACE_TO%NVERT = CUT_FACE_FROM%NVERT -CUT_FACE_TO%NSVERT = CUT_FACE_FROM%NSVERT -CUT_FACE_TO%NFACE = CUT_FACE_FROM%NFACE -CUT_FACE_TO%NSFACE = CUT_FACE_FROM%NSFACE -CUT_FACE_TO%STATUS = CUT_FACE_FROM%STATUS -CUT_FACE_TO%IJK = CUT_FACE_FROM%IJK - -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XYZVERT, TO=CUT_FACE_TO%XYZVERT) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CFELEM, TO=CUT_FACE_TO%CFELEM) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CEDGES, TO=CUT_FACE_TO%CEDGES) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%AREA, TO=CUT_FACE_TO%AREA) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%AREA_ADJUST, TO=CUT_FACE_TO%AREA_ADJUST) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XYZCEN, TO=CUT_FACE_TO%XYZCEN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%SHARED, TO=CUT_FACE_TO%SHARED) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%BLK_TAG, TO=CUT_FACE_TO%BLK_TAG) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CFACE_ORIGIN, TO=CUT_FACE_TO%CFACE_ORIGIN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%LINK_LEV, TO=CUT_FACE_TO%LINK_LEV) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INXAREA, TO=CUT_FACE_TO%INXAREA) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INXSQAREA, TO=CUT_FACE_TO%INXSQAREA) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%JNYSQAREA, TO=CUT_FACE_TO%JNYSQAREA) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%KNZSQAREA, TO=CUT_FACE_TO%KNZSQAREA) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%BODTRI, TO=CUT_FACE_TO%BODTRI) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%UNKH, TO=CUT_FACE_TO%UNKH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%UNKZ, TO=CUT_FACE_TO%UNKZ) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XCENLOW, TO=CUT_FACE_TO%XCENLOW) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%XCENHIGH, TO=CUT_FACE_TO%XCENHIGH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%ZZ_FACE, TO=CUT_FACE_TO%ZZ_FACE) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%TMP_FACE, TO=CUT_FACE_TO%TMP_FACE) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%RHO_D_DZDN, TO=CUT_FACE_TO%RHO_D_DZDN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%H_RHO_D_DZDN, TO=CUT_FACE_TO%H_RHO_D_DZDN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL, TO=CUT_FACE_TO%VEL) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VELS, TO=CUT_FACE_TO%VELS) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%FN, TO=CUT_FACE_TO%FN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%FN_B, TO=CUT_FACE_TO%FN_B) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_SAVE, TO=CUT_FACE_TO%VEL_SAVE) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_LNK, TO=CUT_FACE_TO%VEL_LNK) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_OMESH, TO=CUT_FACE_TO%VEL_OMESH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VELS_OMESH, TO=CUT_FACE_TO%VELS_OMESH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%VEL_LNK_OMESH, TO=CUT_FACE_TO%VEL_LNK_OMESH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%FN_OMESH, TO=CUT_FACE_TO%FN_OMESH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%JDH, TO=CUT_FACE_TO%JDH) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%EDGE_LIST, TO=CUT_FACE_TO%EDGE_LIST) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CELL_LIST, TO=CUT_FACE_TO%CELL_LIST) +IF(CF%NFACE < 1) THEN + CF%STATUS = CC_SOLID + CF%NSFACE = 0 + IF (FTYPE == CC_FTYPE_CFGAS) THEN + SELECT CASE(X1AXIS) + CASE(IAXIS) + M%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + M%ECVAR(I+ILHF,J-1:J,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J-1:J,K,CC_IDCE,KAXIS) = CC_UNDEFINED + M%ECVAR(I+ILHF,J,K-1:K,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J,K-1:K,CC_IDCE,JAXIS) = CC_UNDEFINED + CASE(JAXIS) + M%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + M%ECVAR(I-1:I,J+ILHF,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I-1:I,J+ILHF,K,CC_IDCE,KAXIS) = CC_UNDEFINED + M%ECVAR(I,J+ILHF,K-1:K,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J+ILHF,K-1:K,CC_IDCE,IAXIS) = CC_UNDEFINED + CASE(KAXIS) + M%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED + M%ECVAR(I-1:I,J,K+ILHF,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I-1:I,J,K+ILHF,CC_IDCE,JAXIS) = CC_UNDEFINED + M%ECVAR(I,J-1:J,K+ILHF,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J-1:J,K+ILHF,CC_IDCE,IAXIS) = CC_UNDEFINED + END SELECT + ELSEIF (FTYPE == CC_FTYPE_CFINB) THEN + M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED + ENDIF +ENDIF -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_IJK, TO=CUT_FACE_TO%INT_IJK) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_COEF, TO=CUT_FACE_TO%INT_COEF) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_DCOEF, TO=CUT_FACE_TO%INT_DCOEF) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_XYZBF, TO=CUT_FACE_TO%INT_XYZBF) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NOUT, TO=CUT_FACE_TO%INT_NOUT) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_INBFC, TO=CUT_FACE_TO%INT_INBFC) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NPE, TO=CUT_FACE_TO%INT_NPE) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_XN, TO=CUT_FACE_TO%INT_XN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_CN, TO=CUT_FACE_TO%INT_CN) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_FVARS, TO=CUT_FACE_TO%INT_FVARS) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NOMIND, TO=CUT_FACE_TO%INT_NOMIND) +RETURN +END SUBROUTINE DROP_CUTFACE -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_CVARS, TO=CUT_FACE_TO%INT_CVARS) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%UNKF, TO=CUT_FACE_TO%UNKF) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CFACE_INDEX, TO=CUT_FACE_TO%CFACE_INDEX) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%SURF_INDEX, TO=CUT_FACE_TO%SURF_INDEX) -CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%NOMICF, TO=CUT_FACE_TO%NOMICF) -RETURN -END SUBROUTINE CUT_FACE_MOVE +! ----------------------------- DROP_CUTCELL -------------------------------------- +SUBROUTINE DROP_CUTCELL(NM,ICC,JCC) -! ---------------------------- FACE_DEALLOC ------------------------------------- +! Remove cut-cell CUT_CELL(ICC)%CCELEM(:,JCC): +! 1. If CUT_CELL(ICC)%NCELL==1 drop INBOUNDARY faces of ICC,JCC, make CCVAR CGSC SOLID and IDCC,IDCF undefined. +! 2. If more than 1 NCELL, drop JCc from CCELEM, IJK_LINK, LINK_LEV, VOLUME, XYZCEN lists and NCELL=NCELL-1 -SUBROUTINE FACE_DEALLOC(NM,ICF,DO_BNCF) +INTEGER, INTENT(IN) :: NM,ICC,JCC -INTEGER, INTENT(IN) :: NM,ICF -INTEGER, OPTIONAL, INTENT(IN) :: DO_BNCF +! Local Variables +INTEGER :: I,J,K,JCC2,IFC,CT +INTEGER, ALLOCATABLE, DIMENSION(:) :: IND +TYPE(MESH_TYPE), POINTER :: M +M => MESHES(NM) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XYZVERT)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZVERT) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CFELEM)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFELEM) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CEDGES)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CEDGES) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%AREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST) -IF(.NOT.PRESENT(DO_BNCF)) THEN - MESHES(NM)%CUT_FACE(ICF)%NFACE = 0 - IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XYZCEN)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZCEN) -ENDIF -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%SHARED)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SHARED) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA) +I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%BODTRI)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI) +! Check if JCC is the only cut-cell in CUT_CELL(ICC): +IF (M%CUT_CELL(ICC)%NCELL==1) THEN + ! Set cut-cell to solid + M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID + M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED + M%CUT_CELL(ICC)%NCELL = 0 + ! Then drop INBOUNDARY cut-faces in I,J,K if there are any left: + IFC=M%CCVAR(I,J,K,CC_IDCF) + IF (IFC>0) THEN + M%CUT_FACE(IFC)%STATUS = CC_SOLID + M%CUT_FACE(IFC)%NFACE = 0 + ENDIF + M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED + RETURN +ENDIF -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%UNKH)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKH) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%UNKZ)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKZ) +! First count: +ALLOCATE(IND(1:M%CUT_CELL(ICC)%NCELL)); IND=0 +CT=0 +DO JCC2=1,M%CUT_CELL(ICC)%NCELL + IF (JCC2==JCC) CYCLE + CT = CT + 1 + IND(JCC2) = CT +ENDDO -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XCENLOW)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENLOW) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH) +! Then drop JCC: +DO JCC2=1,M%CUT_CELL(ICC)%NCELL + IF (JCC2==JCC) CYCLE + M%CUT_CELL(ICC)%CCELEM(:,IND(JCC2)) = M%CUT_CELL(ICC)%CCELEM(:,JCC2) + M%CUT_CELL(ICC)%IJK_LINK(:,IND(JCC2)) = M%CUT_CELL(ICC)%IJK_LINK(:,JCC2) + M%CUT_CELL(ICC)%LINK_LEV(IND(JCC2)) = M%CUT_CELL(ICC)%LINK_LEV(JCC2) + M%CUT_CELL(ICC)%VOLUME(IND(JCC2)) = M%CUT_CELL(ICC)%VOLUME(JCC2) + M%CUT_CELL(ICC)%XYZCEN(:,IND(JCC2)) = M%CUT_CELL(ICC)%XYZCEN(:,JCC2) + M%CUT_CELL(ICC)%NOADVANCE(IND(JCC2)) = M%CUT_CELL(ICC)%NOADVANCE(JCC2) +ENDDO -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX) +M%CUT_CELL(ICC)%NCELL = M%CUT_CELL(ICC)%NCELL - 1 +DEALLOCATE(IND) RETURN -END SUBROUTINE FACE_DEALLOC - -! -------------------------- NEW_FACE_ALLOC ------------------------------------- +END SUBROUTINE DROP_CUTCELL -SUBROUTINE NEW_FACE_ALLOC(NM,ICF,NVERT,NFACE,NVERTFACE,IBNDINT) +SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK -INTEGER, INTENT(IN) :: NM,ICF,NVERT,NFACE,NVERTFACE -INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT +DO IDIM=1,MAX_DIM -! Allocate and initialize NVERT related fields: -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZVERT(IAXIS:KAXIS,1:NVERT)); MESHES(NM)%CUT_FACE(ICF)%XYZVERT = 0._EB +! Exchange CC%NOADVANCE(JCC)>0 information among NEIGHBOURING meshes: +CALL EXCHANGE_CC_NOADVANCE_INFO +! Add CC%NOADVANCE(JCC) where needed: +CALL ADD_NEIGHBOR_BLOCKED_CELLS -! Allocate and initialize NFACE, NVERTFACE related fields: -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFELEM(1:NVERTFACE,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFELEM = CC_UNDEFINED -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%AREA = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZCEN(IAXIS:KAXIS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%XYZCEN = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SHARED(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%SHARED = .FALSE. -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG(1:NFACE));MESHES(NM)%CUT_FACE(ICF)%BLK_TAG= .FALSE. -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%LINK_LEV = CC_UNDEFINED +MAIN_MESH_LOOP_1 : DO NM=1,NMESHES -!Integrals to be used in cut-cell volume and centroid computations. -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%INXAREA = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%INXSQAREA = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA = 0._EB + IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. + IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI(1:2,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%BODTRI = CC_UNDEFINED + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKZ(LOW_IND:HIGH_IND,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%UNKZ = CC_UNDEFINED + ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: + CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENLOW(IAXIS:KAXIS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%XCENLOW = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH(IAXIS:KAXIS,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%XCENHIGH = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(MAX_DIM+1,LOW_IND:HIGH_IND,1:NFACE)) -MESHES(NM)%CUT_FACE(ICF)%CELL_LIST = CC_UNDEFINED + IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + CALL GET_CELL_LINK_INFO(NM) + ENDIF -IF(MESHES(NM)%CUT_FACE(ICF)%STATUS==CC_INBOUNDARY) THEN - ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST = 1._EB - ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN = NOT_BLOCKED -ELSE - IF(PRESENT(IBNDINT)) THEN - IF(IBNDINT>2) RETURN ! Gas cut-face not in block boundary. + ! Block any cells that contain only one gas cut-face (cavity type cut-cells): + K = 0 + DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + CC=>MESHES(NM)%CUT_CELL(ICC1) + DO J=1,CC%NCELL + SUM_FACE=0; SUM_CCELL=0 + DO I=2,CC%CCELEM(1,J) + SELECT CASE(CC%FACE_LIST(1,CC%CCELEM(I,J))) + CASE(CC_FTYPE_CFGAS); SUM_FACE = SUM_FACE+1 + CASE(CC_FTYPE_RCGAS); SUM_CCELL=SUM_CCELL+1 + END SELECT + ENDDO + IF(SUM_FACE>1 .OR. SUM_CCELL>0) CYCLE + IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J)=BLOCKED_CAVITY_CELL + K=K+1 + ENDDO + ENDDO + IF (K>0) THEN + CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) + IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + CALL GET_CELL_LINK_INFO(NM) + ENDIF ENDIF -ENDIF -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX = CC_UNDEFINED + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +ENDDO MAIN_MESH_LOOP_1 -RETURN -END SUBROUTINE NEW_FACE_ALLOC +! Call tag boundary cut-cells for blocking in refinement interfaces: +CALL TAG_CC_BLOCKING_REFINEMENT +ENDDO -! -------------------------- ALLOC_FACE_STATE_VARS ------------------------------------- +FINAL_BLOCK_MESH_LOOP : DO NM=1,NMESHES -SUBROUTINE ALLOC_FACE_STATE_VARS(NM,ICF,NFACE,IBNDINT) + IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. + IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 -INTEGER, INTENT(IN) :: NM,ICF,NFACE -INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) -! !Integrals to be used in cut-cell volume and centroid computations. -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA) -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA) + ! Here: 1,2. Define Linking information for cut-cells. + CALL GET_CELL_LINK_INFO(NM) -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKH(LOW_IND:HIGH_IND,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%UNKH = CC_UNDEFINED -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%RHO_D_DZDN(1:N_TOTAL_SCALARS,1:NFACE)) -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%H_RHO_D_DZDN(1:N_TOTAL_SCALARS,1:NFACE)) -MESHES(NM)%CUT_FACE(ICF)%RHO_D_DZDN = 0._EB -MESHES(NM)%CUT_FACE(ICF)%H_RHO_D_DZDN = 0._EB + ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: + CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) + IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + CALL GET_CELL_LINK_INFO(NM) + ENDIF -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%ZZ_FACE(1:N_TOTAL_SCALARS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%ZZ_FACE = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%TMP_FACE(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%TMP_FACE = 0._EB + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +ENDDO FINAL_BLOCK_MESH_LOOP -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%VEL(1:NFACE), MESHES(NM)%CUT_FACE(ICF)%VELS(1:NFACE), & - MESHES(NM)%CUT_FACE(ICF)%FN(1:NFACE), MESHES(NM)%CUT_FACE(ICF)%FN_B(1:NFACE), & - MESHES(NM)%CUT_FACE(ICF)%VEL_SAVE(1:NFACE)) -MESHES(NM)%CUT_FACE(ICF)%VEL = 0._EB; MESHES(NM)%CUT_FACE(ICF)%VELS = 0._EB -MESHES(NM)%CUT_FACE(ICF)%FN = 0._EB; MESHES(NM)%CUT_FACE(ICF)%VEL_SAVE = 0._EB -MESHES(NM)%CUT_FACE(ICF)%FN_B = 0._EB; +END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JDH(1:2,1:2,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%JDH = CC_UNDEFINED -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKF(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%UNKF = CC_UNDEFINED +SUBROUTINE CC_GRID_POSTPROCESS_AND_CLEANUP(NM) -IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) THEN - IF(PRESENT(IBNDINT)) THEN - IF(IBNDINT>2) RETURN ! Gas cut-face not in block boundary. +INTEGER, INTENT(IN) :: NM + +CALL CC_GRID_RELEASE_BLOCKED_CELL_LISTS(NM) + +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 + +CALL POINT_TO_MESH(NM) +M => MESHES(NM) + +! Here Add Areas per SURF_ID: +IF (PROCESS(NM)==MY_RANK) THEN + DO ICF=1,M%N_CUTFACE_MESH + CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE + DO J=1,CF%NFACE + IF(.NOT.CF%BLK_TAG(J)) CYCLE + GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & + GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) + ENDDO + ENDDO +ENDIF +! Deallocate arrays: +IF (GET_CUTCELLS_VERBOSE) THEN + IF(M%N_CUTCELL_MESH > 0) THEN + MIN_FACES_PER_CUTCELL = 1000000 !HUGE(MIN_FACES_PER_CUTCELL) + MAX_FACES_PER_CUTCELL = 0 + MEAN_FACES_PER_CUTCELL= 0 + SUM_FACE = 0 + SUM_CCELL= 0 + DO ICC1=1,M%N_CUTCELL_MESH + IF (M%CUT_CELL(ICC1)%NCELL==0) CYCLE + SUM_CCELL = SUM_CCELL + M%CUT_CELL(ICC1)%NCELL + DO ICC2=1,M%CUT_CELL(ICC1)%NCELL + MAX_FACES_PER_CUTCELL = MAX(MAX_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) + MIN_FACES_PER_CUTCELL = MIN(MIN_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) + SUM_FACE = SUM_FACE + M%CUT_CELL(ICC1)%CCELEM(1,ICC2) + ENDDO + ENDDO + IF(SUM_CCELL > TWENTY_EPSILON_EB) MEAN_FACES_PER_CUTCELL = SUM_FACE / SUM_CCELL + ! Write to file: + WRITE(LU_SETCC,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& + MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL + IF (MEAN_FACES_PER_CUTCELL > 30) THEN + WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN + WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ENDIF + ! Write to ERR file: + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& + MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL + IF (MEAN_FACES_PER_CUTCELL > 30) THEN + WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN + WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ENDIF + ENDIF + ENDIF + WRITE(LU_SETCC,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' + WRITE(LU_SETCC,'(A)') ' ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' + WRITE(LU_ERR ,'(A)') ' ' ENDIF ENDIF -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_INDEX(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFACE_INDEX = CC_UNDEFINED -RETURN -END SUBROUTINE ALLOC_FACE_STATE_VARS +! Here we have to deallocate if no geometric entities were defined: +! EDGE_CROSS is deallocated: +IF (ALLOCATED(M%EDGE_CROSS)) DEALLOCATE(M%EDGE_CROSS) +IF (M%N_CUTEDGE_MESH == 0 .OR. PROCESS(NM)/=MY_RANK) THEN + IF (ALLOCATED(M%CUT_EDGE)) DEALLOCATE(M%CUT_EDGE) +ENDIF +IF (M%N_CUTFACE_MESH+M%N_BBCUTFACE_MESH+M%N_GCCUTFACE_MESH == 0) THEN + IF (ALLOCATED(M%CUT_FACE)) DEALLOCATE(M%CUT_FACE) +ENDIF +IF(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH == 0) THEN + IF (ALLOCATED(M%CUT_CELL)) DEALLOCATE(M%CUT_CELL) +ENDIF -! -------------------------- TEST_PT_INPOLY ------------------------------------- +! Sanity tests on cut-faces, cut-cells: +IF (DEBUG_SET_CUTCELLS) THEN + CUTFACE_TEST_LOOP : DO ICF=1,M%N_CUTFACE_MESH + NFACE = M%CUT_FACE(ICF)%NFACE + I = M%CUT_FACE(ICF)%IJK(IAXIS) + J = M%CUT_FACE(ICF)%IJK(JAXIS) + K = M%CUT_FACE(ICF)%IJK(KAXIS) + X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) + DO I=1,NFACE + IF(M%CUT_FACE(ICF)%AREA(I) MESHES(NM) + +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + CF => M%CUT_FACE(ICF); IF(CF%NFACE==0) CYCLE + ICF1=3 ! BLOCK boundary flag, when == 1,2. + IF (CF%STATUS == CC_GASPHASE) THEN + I = CF%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE + J = CF%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE + K = CF%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE + SELECT CASE(CF%IJK(KAXIS+1)) ! X1AXIS + CASE(IAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DY(J)*DZ(K)); IF(I==0 .OR. I==M%IBAR) ICF1=1 + CASE(JAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DZ(K)*DX(I)); IF(J==0 .OR. J==M%JBAR) ICF1=1 + CASE(KAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DX(I)*DY(J)); IF(K==0 .OR. K==M%KBAR) ICF1=1 + END SELECT ENDIF + CALL ALLOC_FACE_STATE_VARS(NM,ICF,CF%NFACE,ICF1) ENDDO -IF ( MOD(RCROSS,2) /= MOD(LCROSS,2) ) THEN ! Point on edge - PTSFLAG = .TRUE. - RETURN -ENDIF +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC => M%CUT_CELL(ICC); IF(CC%NCELL==0) CYCLE + I = CC%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE + J = CC%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE + K = CC%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE + CC%ALPHA_CC = SUM(CC%VOLUME(1:CC%NCELL))/(DX(I)*DY(J)*DZ(K)) + CALL ALLOC_CELL_STATE_VARS(NM,ICC,CC%NCELL) +ENDDO -IF ( MOD(RCROSS,2) == 1) THEN ! Point inside - PTSFLAG = .TRUE. - RETURN -ENDIF +! Allocate array of indexes of chemically active cut-cells +SUM_CC = 0 +DO ICC=1,M%N_CUTCELL_MESH + SUM_CC = SUM_CC + CC%NCELL +ENDDO +ALLOCATE(M%CHEM_ACTIVE_CC(SUM_CC,3)) +M%CHEM_ACTIVE_CC=-1 -RETURN -END SUBROUTINE TEST_PT_INPOLY +END SUBROUTINE CC_GRID_ALLOCATE_STATE_VARS +SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST -! ---------------------- GET_CARTCELL_CUTEDGES ---------------------------------- +! ALL REDUCE areas per surface: +IF(N_GEOMETRY>0) THEN +CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_OLD(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) +CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) +ENDIF +! Define AREA_ADJUST per SURF_ID: +DO J=1,N_GEOMETRY + DO I=0,N_SURF + IF(GEOM_AREA_SURF_NEW(I,J)>TWENTY_EPSILON_EB) THEN + GEOM_AREA_SURF_NEW(I,J) = GEOM_AREA_SURF_OLD(I,J)/GEOM_AREA_SURF_NEW(I,J) + ELSE; GEOM_AREA_SURF_NEW(I,J) = 1._EB + ENDIF + ENDDO +ENDDO +DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE + DO J=1,CF%NFACE + IF(.NOT.CF%BLK_TAG(J)) CYCLE + CF%AREA_ADJUST(J) = CF%AREA_ADJUST(J)*GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + ENDDO + ENDDO + DEALLOCATE(MESHES(NM)%INBCF_AREA) +ENDDO -SUBROUTINE GET_CARTCELL_CUTEDGES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) +! GEOM_AREA_SURF_NEW = 0._EB +! DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX +! DO ICF=1,MESHES(NM)%N_CUTFACE_MESH +! CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE +! DO J=1,CF%NFACE +! IF(.NOT.CF%BLK_TAG(J)) CYCLE +! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & +! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) +! ENDDO +! ENDDO +! ENDDO +! CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW,(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) +! DO J=1,N_GEOMETRY +! DO I=0,N_SURF +! IF(MY_RANK==0) WRITE(LU_ERR,*) 'IG,N_SURF,AOLD,ANEW=',J,I,GEOM_AREA_SURF_OLD(I,J),GEOM_AREA_SURF_NEW(I,J) +! ENDDO +! ENDDO +IF(ALLOCATED(GEOM_AREA_SURF_OLD)) DEALLOCATE(GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) -USE TRAN, ONLY : TRANS +END SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +SUBROUTINE CC_GRID_LOG_PROCESSING_TIME -! Local Variables: -INTEGER :: II2, JJ2, KK2, IG, IWSEDG, SEG(NOD1:NOD2),X1AXIS, X1LO, X1HI, IPLN, LSTR, LEND -REAL(EB):: XYZ1(IAXIS:KAXIS), XYZ2(IAXIS:KAXIS), PLNORMAL(IAXIS:KAXIS), X1PLN, MINX, MAXX -LOGICAL :: DROPSEG, OUTPLANE, SAMEINT -REAL(EB):: DOT1, DOT2, DENOM, PLANEEQ, SVARI, XYZV1(IAXIS:KAXIS), XYZV2(IAXIS:KAXIS), SLEN, STANI(IAXIS:KAXIS) -INTEGER :: NWCROSS, IBCR, IDUM, INOD1, INOD2, NVERT, NEDGE, IEDGE, CEI, NWCROSS_SVAR, X1NOC -REAL(EB):: SVAR1, SVAR2, SVAR12, XPOS, DV(IAXIS:KAXIS) -REAL(EB), ALLOCATABLE, DIMENSION(:) :: SVAR_AUX -INTEGER :: X2AXIS, EDGE_START, COUNT, CEI2, I, J, K, I_NP, IFCELL, ITRI, IG1 -REAL(EB):: XP(IAXIS:KAXIS), NP(IAXIS:KAXIS), ADD_XSEG(IAXIS:KAXIS), X1X2(IAXIS:KAXIS), X1O1(IAXIS:KAXIS), X1O2(IAXIS:KAXIS), & - X1T1_OPNOD, X1T2_OPNOD -LOGICAL :: TWOBOD_EDG, INPL_TEST, ANG_FLG1, ANG_FLG2, ANG_FLG3 -INTEGER, PARAMETER :: AXIS(1:6)=(/ IAXIS, IAXIS, JAXIS, JAXIS, KAXIS, KAXIS /) -INTEGER, PARAMETER :: IADD(1:6)=(/ -1, 0, 0, 0, 0, 0 /) -INTEGER, PARAMETER :: JADD(1:6)=(/ 0, 0, -1, 0, 0, 0 /) -INTEGER, PARAMETER :: KADD(1:6)=(/ 0, 0, 0, 0, -1, 0 /) -LOGICAL, ALLOCATABLE, DIMENSION(:) :: SOLID_EDGE -INTEGER, PARAMETER :: ON(1:3) =(/ 3, 1, 2 /) -INTEGER :: T1, E1, ON1, T2, E2, ON2 -REAL(EB) :: TNOW, EDGECUBE(LOW_IND:HIGH_IND,IAXIS:KAXIS) -TYPE(BODINT_CELL_EDGE_TYPE) :: BODINT_CELL_EDGE -LOGICAL :: FOUND_SEG +! Add to SET_CUTCELLS_3D loop time: +T_CC_USED(SET_CUTCELLS_TIME_INDEX) = T_CC_USED(SET_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW -! REAL(QB) :: DVQ(IAXIS:KAXIS), SLENQ, STANIQ(IAXIS:KAXIS), DENOMQ, PLANEEQQ +IF(GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_MESH) + WRITE(LU_SETCC,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' + WRITE(LU_SETCC,'(A)') ' ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' + WRITE(LU_ERR,'(A)') ' ' + ENDIF +ENDIF -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -INTEGER :: NCUTEDG +END SUBROUTINE CC_GRID_LOG_PROCESSING_TIME -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTEDGES for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTEDGES for mesh :',NM,' ..' -ENDIF +SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING(EARLY_RETURN) -TNOW=CURRENT_TIME() +LOGICAL, INTENT(OUT) :: EARLY_RETURN -EDGE_START= MESHES(NM)%N_CUTEDGE_MESH + 1 +EARLY_RETURN = .FALSE. -! BODINT_CELL: -GEOM_LOOP : DO IG=1,N_GEOMETRY +IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) - ! The IG wet surface edges will be used to obtain intersections with grid planes on - ! increasing svar order. - ALLOCATE(BODINT_CELL_EDGE%SVAR(CC_DELTA_NBCROSS)) +IF(GET_CUTCELLS_VERBOSE) THEN + WRITE(LU_SETCC,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' + WRITE(LU_SETCC,'(A)') ' ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' + WRITE(LU_ERR ,'(A)') ' ' + ENDIF +ENDIF - IWSEDG_LOOP : DO IWSEDG=1,GEOMETRY(IG)%N_EDGES +! Write out: +! Increase SET_CUTCELLS_3D call counter by 1: +CALL_COUNT = CALL_COUNT + 1 +IF(PERIODIC_TEST==105) THEN + CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) + IF(CALL_COUNT > 1) THEN + EARLY_RETURN = .TRUE. + RETURN + ENDIF +ENDIF - ! Seg Nodes location: - SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEDG) +END SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING - XYZ1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) +SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY - DO X1AXIS=IAXIS,KAXIS - EDGECUBE( LOW_IND,X1AXIS) = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) - EDGECUBE(HIGH_IND,X1AXIS) = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) +! Loop over geometry: +CCVERBOSE_COND : IF(GET_CUTCELLS_VERBOSE) THEN + SLEN_GEOM = 0._EB; AREA_GEOM = 0._EB; VOLUME_GEOM = 0._EB; XYZCEN_GEOM(IAXIS:KAXIS) = 0._EB + DO IG=1,N_GEOMETRY + ! Add length of wet surface edges: + DO IEDGE=1,GEOMETRY(IG)%N_EDGES + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IEDGE) + DV(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - & + GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) + SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) + SLEN_GEOM = SLEN_GEOM + SLEN ENDDO + ! Add to wet surface Areas: + AREA_GEOM = AREA_GEOM + GEOMETRY(IG)%GEOM_AREA + ! Add to GEOMETRY volume: + VOLUME_GEOM = VOLUME_GEOM + GEOMETRY(IG)%GEOM_VOLUME + ! Add to XYZCEN for geometries: + XYZCEN_GEOM(IAXIS:KAXIS)= XYZCEN_GEOM(IAXIS:KAXIS) + GEOMETRY(IG)%GEOM_VOLUME * GEOMETRY(IG)%GEOM_XYZCEN(IAXIS:KAXIS) + ENDDO + IF(N_GEOMETRY > 0) XYZCEN_GEOM(IAXIS:KAXIS)=XYZCEN_GEOM(IAXIS:KAXIS)/VOLUME_GEOM - ! Discard if segment is outside of volume of interest: - IF (EDGECUBE( LOW_IND,IAXIS) > X(IBAR)+REAL(NGUARD,EB)*DX(IBAR)) CYCLE - IF (EDGECUBE(HIGH_IND,IAXIS) < X( 0)-REAL(NGUARD,EB)*DX( 1)) CYCLE - IF (EDGECUBE( LOW_IND,JAXIS) > Y(JBAR)+REAL(NGUARD,EB)*DY(JBAR)) CYCLE - IF (EDGECUBE(HIGH_IND,JAXIS) < Y( 0)-REAL(NGUARD,EB)*DY( 1)) CYCLE - IF (EDGECUBE( LOW_IND,KAXIS) > Z(KBAR)+REAL(NGUARD,EB)*DZ(KBAR)) CYCLE - IF (EDGECUBE(HIGH_IND,KAXIS) < Z( 0)-REAL(NGUARD,EB)*DZ( 1)) CYCLE - - ! Test if Segment lays on plane, If so drop, unless SOLID-SOLID with triangles off plane, it was taken care of - ! previously: This is expensive think of switching to pointer X1FACEP. - DROPSEG = .FALSE. - ADD_XSEG= 0._EB - X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS - SELECT CASE(X1AXIS) - CASE(IAXIS) - PLNORMAL(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) - ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE - ALLOCATE(DX1FACE(ISTR:IEND)); DX1FACE = DXFACE - X1LO = ILO_FACE-CCGUARD; X1HI = IHI_FACE+CCGUARD - CASE(JAXIS) - PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 1._EB, 0._EB /) - ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE - ALLOCATE(DX1FACE(JSTR:JEND)); DX1FACE = DYFACE - X1LO = JLO_FACE-CCGUARD; X1HI = JHI_FACE+CCGUARD - CASE(KAXIS) - PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 0._EB, 1._EB /) - ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE - ALLOCATE(DX1FACE(KSTR:KEND)); DX1FACE = DZFACE - X1LO = KLO_FACE-CCGUARD; X1HI = KHI_FACE+CCGUARD - END SELECT + ! Loop over meshes: + NCUTFACE_INB = 0 + CF_AREA_INB=0._EB + CC_VOLUME_INB=0._EB + GP_VOLUME=0._EB + DM_XYZCEN(IAXIS:KAXIS) = 0._EB + CCGP_XYZCEN(IAXIS:KAXIS) = 0._EB + TESTS_MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + DO ICF1 = 1,MESHES(NM)%N_CUTFACE_MESH + IF (CUT_FACE(ICF1)%STATUS == CC_INBOUNDARY) THEN + NFACE = CUT_FACE(ICF1)%NFACE + CF_AREA_INB = CF_AREA_INB + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) + ENDIF + ENDDO + DO ICC1 = 1,MESHES(NM)%N_CUTCELL_MESH + NCELL = CUT_CELL(ICC1)%NCELL + DO ICC2=1,NCELL + CCGP_XYZCEN(IAXIS:KAXIS) = CCGP_XYZCEN(IAXIS:KAXIS) + CUT_CELL(ICC1)%VOLUME(ICC2) * & + CUT_CELL(ICC1)%XYZCEN(IAXIS:KAXIS,ICC2) + IF (CUT_CELL(ICC1)%VOLUME(ICC2) IHI_CELL+CCGUARD) ) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO II2=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD - IF((XPOS-XFACE(II2-1)) >= 0._EB .AND. (XFACE(II2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF +USE TRAN, ONLY: GET_IJK +INTEGER :: NM2,ICELL,I2,J2,K2,BLOCK_TAG +LOGICAL :: IND_FOUND +REAL(EB):: XCO,YCO,ZCO,VOL_NM,VOL_NOM,X1,Y1,Z1 +TYPE(MESH_TYPE), POINTER :: M2 - XPOS = XYZ1(JAXIS) + SVAR12*STANI(JAXIS) + ADD_XSEG(JAXIS) - IF(TRANS(NM)%NOC(JAXIS)==0)THEN - JJ2 = FLOOR( (XPOS-YFACE(JLO_FACE))/DYFACE(JLO_FACE) ) + JLO_CELL - IF ( (JJ2 < JLO_CELL-CCGUARD) .OR. (JJ2 > JHI_CELL+CCGUARD) ) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO JJ2=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD - IF((XPOS-YFACE(JJ2-1)) >= 0._EB .AND. (YFACE(JJ2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF +MESH_LOOP : DO NM=1,NMESHES - XPOS = XYZ1(KAXIS) + SVAR12*STANI(KAXIS) + ADD_XSEG(KAXIS) - IF(TRANS(NM)%NOC(KAXIS)==0)THEN - KK2 = FLOOR( (XPOS-ZFACE(KLO_FACE))/DZFACE(KLO_FACE) ) + KLO_CELL - IF ( (KK2 < KLO_CELL-CCGUARD) .OR. (KK2 > KHI_CELL+CCGUARD) ) CYCLE - ELSE - FOUND_SEG=.FALSE. - DO KK2=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD - IF((XPOS-ZFACE(KK2-1)) >= 0._EB .AND. (ZFACE(KK2)-XPOS) > 0._EB) THEN - FOUND_SEG=.TRUE. - EXIT - ENDIF - ENDDO - IF(.NOT.FOUND_SEG) CYCLE - ENDIF + IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. + IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 - ! CCVAR edge number: - IF ( MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) > 0 ) THEN ! There is already - ! an entry in CUT_EDGE. - CEI = MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) - ELSE ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ II2, JJ2, KK2, 0, CC_GS /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCC - ENDIF + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) - ! Add vertices, non repeated vertex entries at this point. - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - ! Define vertices for this segment: - ! xv1 yv1 zv1 - ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - XYZV1(IAXIS:KAXIS) = (/ XYZ1(IAXIS)+SVAR1*STANI(IAXIS), & - XYZ1(JAXIS)+SVAR1*STANI(JAXIS), & - XYZ1(KAXIS)+SVAR1*STANI(KAXIS) /) - CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) - ! xv2 yv2 zv2 - XYZV2(IAXIS:KAXIS) = (/ XYZ1(IAXIS)+SVAR2*STANI(IAXIS), & - XYZ1(JAXIS)+SVAR2*STANI(JAXIS), & - XYZ1(KAXIS)+SVAR2*STANI(KAXIS) /) - CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) - ! ELSE - ! XYZV1(IAXIS:KAXIS) = REAL((/ REAL(XYZ1(IAXIS),QB)+REAL(SVAR1,QB)*STANIQ(IAXIS), & - ! REAL(XYZ1(JAXIS),QB)+REAL(SVAR1,QB)*STANIQ(JAXIS), & - ! REAL(XYZ1(KAXIS),QB)+REAL(SVAR1,QB)*STANIQ(KAXIS) /),EB) - ! CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) - ! ! xv2 yv2 zv2 - ! XYZV2(IAXIS:KAXIS) = REAL((/ REAL(XYZ1(IAXIS),QB)+REAL(SVAR2,QB)*STANIQ(IAXIS), & - ! REAL(XYZ1(JAXIS),QB)+REAL(SVAR2,QB)*STANIQ(JAXIS), & - ! REAL(XYZ1(KAXIS),QB)+REAL(SVAR2,QB)*STANIQ(KAXIS) /),EB) - ! CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) - ! ENDIF + ! Compute average cell volume for mesh NM + VOL_NM = (M%XF-M%XS)*(M%YF-M%YS)*(M%ZF-M%ZS) / REAL(M%IBAR*M%JBAR*M%KBAR,EB) - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + 1 - CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE) = (/ INOD1, INOD2 /) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE) = & - (/ GEOMETRY(IG)%EDGE_FACES(1,IWSEDG), & - GEOMETRY(IG)%EDGE_FACES(2,IWSEDG), & - GEOMETRY(IG)%EDGE_FACES(4,IWSEDG), IG /) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE - ENDDO + ! Process blocked cut-cells from neighboring meshes: + NEIGHBORING_MESHES_DO : DO NM2=1,M%N_NEIGHBORING_MESHES + NOM = M%NEIGHBORING_MESH(NM2); IF (NOM==NM) CYCLE + M2 => MESHES(NOM) - ENDDO IWSEDG_LOOP + ICELL_DO : DO ICELL=1,M2%N_CC_BLOCKED + XCO = M2%XYZ_CC_BLOCKED(IAXIS,ICELL) + YCO = M2%XYZ_CC_BLOCKED(JAXIS,ICELL) + ZCO = M2%XYZ_CC_BLOCKED(KAXIS,ICELL) + BLOCK_TAG = M2%JBT_CC_BLOCKED(2,ICELL) - ! Deallocate BODINT_CELL_EDGE: - DEALLOCATE(BODINT_CELL_EDGE%SVAR) + CALL GET_IJK(XCO,YCO,ZCO,NOM,X1,Y1,Z1,I2,J2,K2) + VOL_NOM = M2%DX(I2)*M2%DY(J2)*M2%DZ(K2) -ENDDO GEOM_LOOP + IF (VOL_NM > 1.5_EB * VOL_NOM) THEN ! NM is COARSE, NOM is FINE + IF(XCO < M2%XS .OR. XCO > M2%XF .OR. & + YCO < M2%YS .OR. YCO > M2%YF .OR. & + ZCO < M2%ZS .OR. ZCO > M2%ZF) CYCLE ICELL_DO + IF(XCO > M2%X(1) .AND. XCO < M2%X(M2%IBAR-1) .AND. & + YCO > M2%Y(1) .AND. YCO < M2%Y(M2%JBAR-1) .AND. & + ZCO > M2%Z(1) .AND. ZCO < M2%Z(M2%KBAR-1)) CYCLE ICELL_DO -! Now filter out CC_INBOUNDCC cut-edges that lay within the SOLID: -DO CEI=EDGE_START,MESHES(NM)%N_CUTEDGE_MESH - ! Here we have cut-edges on the cell belonging to two or more bodies: - I = MESHES(NM)%CUT_EDGE(CEI)%IJK(IAXIS) - J = MESHES(NM)%CUT_EDGE(CEI)%IJK(JAXIS) - K = MESHES(NM)%CUT_EDGE(CEI)%IJK(KAXIS) + ! Find I,J,K in NM where (XCO,YCO,ZCO) falls within cell bounds + IND_FOUND = .FALSE. + DO I=ILO_CELL-1,IHI_CELL+1 + IF (XCO < XFACE(I-1)-GEOMEPS .OR. XCO > XFACE(I)+GEOMEPS) CYCLE + DO J=JLO_CELL-1,JHI_CELL+1 + IF (YCO < YFACE(J-1)-GEOMEPS .OR. YCO > YFACE(J)+GEOMEPS) CYCLE + DO K=KLO_CELL-1,KHI_CELL+1 + IF (ZCO < ZFACE(K-1)-GEOMEPS .OR. ZCO > ZFACE(K)+GEOMEPS) CYCLE + IF (I > ILO_CELL-1 .AND. I < IHI_CELL+1 .AND. & + J > JLO_CELL-1 .AND. J < JHI_CELL+1 .AND. & + K > KLO_CELL-1 .AND. K < KHI_CELL+1) CYCLE + IND_FOUND = .TRUE. + EXIT + ENDDO + IF (IND_FOUND) EXIT + ENDDO + IF (IND_FOUND) EXIT + ENDDO + IF (.NOT.IND_FOUND) CYCLE ICELL_DO - ! First cut-edges in the cell: - NEDGE =MESHES(NM)%CUT_EDGE(CEI)%NEDGE - TWOBOD_EDG=.FALSE. - IF (NEDGE > 0) IG1 = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,1) - DO IEDGE=2,NEDGE - IF (MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) /= IG1) THEN - TWOBOD_EDG =.TRUE. - EXIT - ENDIF - ENDDO - ! Low-High x,y,z face Edges: - IF(.NOT.TWOBOD_EDG) THEN - IFCELL_DO : DO IFCELL=1,6 - CEI2 = MESHES(NM)%FCVAR(I+IADD(IFCELL),J+JADD(IFCELL),K+KADD(IFCELL),CC_IDCE,AXIS(IFCELL)) - IF (CEI2 < 1) CYCLE - DO IEDGE=1,MESHES(NM)%CUT_EDGE(CEI2)%NEDGE - IF (MESHES(NM)%CUT_EDGE(CEI2)%INDSEG(4,IEDGE) /= IG1) THEN - TWOBOD_EDG =.TRUE. - EXIT IFCELL_DO + ! Tag the coarse ghost-cell in NM that contains the blocked fine cell. + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF (ICC > 0) THEN + DO JCC = 1, M%CUT_CELL(ICC)%NCELL + IF (M%CUT_CELL(ICC)%NOADVANCE(JCC) == NOT_BLOCKED) & + M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCK_TAG + ENDDO ENDIF - ENDDO - ENDDO IFCELL_DO - ENDIF - IF(.NOT.TWOBOD_EDG) CYCLE - - ! Here we have cut-edges on the cell belonging to two or more bodies: - ! First discard if CELLRT=true, we won't be using cut-edges: - IF (CELLRT(I,J,K)) CYCLE - ! Now figure out which edges are inside other SOLIDS: - ! Ray tracing in either X, Y or Z directions: - ! 1. For the segment center point P provide: - ! a. Its coordinates P={xp,yp,zp}. - ! b. Direction X1 for Ray shooting (IAXIS,JAXIS,KAXIS). - ALLOCATE(SOLID_EDGE(1:NEDGE)); SOLID_EDGE(1:NEDGE)=.FALSE. - DO IEDGE=1,NEDGE - ! No body associated with segment. Might not be needed. - IG = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) - IF ( IG < 1 ) CYCLE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - XP(IAXIS:KAXIS) = 0.5_EB*(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + & - MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2))) - ! Direction NP: - NP(IAXIS:KAXIS) = 0._EB - DO I_NP=1,MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,IEDGE) - ITRI = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1+I_NP,IEDGE) - NP(IAXIS:KAXIS) = NP(IAXIS:KAXIS) + GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,ITRI) - ENDDO - X2AXIS = MAXLOC(ABS(NP(IAXIS:KAXIS)),DIM=1) - CALL GET_IS_SOLID_3D(X2AXIS,XP,I,J,K,SOLID_EDGE(IEDGE)) - ENDDO - ! Now drop SEGS with SOLID_EDGE(IEDGE)=true: - COUNT = 0 - DO IEDGE=1,NEDGE - IF (SOLID_EDGE(IEDGE)) CYCLE - COUNT=COUNT+1 - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,COUNT) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,COUNT) = & - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,IEDGE) - ENDDO + ELSE + ! ===================================================== + ! Same refinement level (or refinement handled by EXT_WALL_LOOP) - use centroid matching + ! ===================================================== + IND_FOUND = .FALSE. + DO I=ILO_CELL-1,IHI_CELL+1 + IF (ABS(XCO-XCELL(I))0) M%CUT_CELL(ICC)%NOADVANCE(M2%JBT_CC_BLOCKED(1,ICELL)) = BLOCK_TAG -T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX ) + CURRENT_TIME() - TNOW + ENDIF + ENDDO ICELL_DO + ENDDO NEIGHBORING_MESHES_DO + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +ENDDO MESH_LOOP -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - NCUTEDG = 0 - DO CEI=1,MESHES(NM)%N_CUTEDGE_MESH - NCUTEDG = NCUTEDG + MESHES(NM)%CUT_EDGE(CEI)%NEDGE - ENDDO - WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-edges in mesh : ',NCUTEDG,'. ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-edges in mesh : ',NCUTEDG,'. ' - ENDIF -ENDIF +END SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS -RETURN -END SUBROUTINE GET_CARTCELL_CUTEDGES -! ------------------------- GET_IS_SOLID_3D ------------------------------------- +SUBROUTINE DEFINE_XYZFACE_CELL(ALLOC_FLG) -SUBROUTINE GET_IS_SOLID_3D(X2AXIS,XP,I,J,K,IS_SOLID) +LOGICAL, INTENT(IN) :: ALLOC_FLG -INTEGER, INTENT(IN) :: X2AXIS,I,J,K -REAL(EB), INTENT(IN) :: XP(IAXIS:KAXIS) -LOGICAL, INTENT(OUT):: IS_SOLID +IF (ALLOC_FLG) THEN -! Logical Variables: -INTEGER :: IJK(IAXIS:KAXIS) -REAL(EB):: NVEC(IAXIS:JAXIS)=(/ 1._EB, 0._EB /), XY(IAXIS:JAXIS), PLNORMAL(IAXIS:KAXIS), X1PLN, X3RAY -INTEGER :: X1AXIS, X3AXIS, X2LO, X2HI, X3LO, X3HI -LOGICAL :: TRI_ONPLANE_ONLY =.FALSE., RAYTRACE_X2_ONLY =.TRUE. + ! X direction bounds: + ILO_FACE = 0 ! Low mesh boundary face index. + IHI_FACE = M%IBAR ! High mesh boundary face index. + ILO_CELL = ILO_FACE + 1 ! First internal cell index. See notes. + IHI_CELL = IHI_FACE ! Last internal cell index. + ISTR = ILO_FACE - NGUARD ! Allocation start x arrays. + IEND = IHI_FACE + NGUARD ! Allocation end x arrays. -IJK(IAXIS:KAXIS) = (/ I, J, K /) + ! Y direction bounds: + JLO_FACE = 0 ! Low mesh boundary face index. + JHI_FACE = M%JBAR ! High mesh boundary face index. + JLO_CELL = JLO_FACE + 1 ! First internal cell index. See notes. + JHI_CELL = JHI_FACE ! Last internal cell index. + JSTR = JLO_FACE - NGUARD ! Allocation start y arrays. + JEND = JHI_FACE + NGUARD ! Allocation end y arrays. -SELECT CASE(X2AXIS) - CASE(JAXIS) - X1AXIS = IAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) - ! x2, x3 axes parameters: - X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD - X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD - X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) - ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: - X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS - CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & - X2LO,X2HI,X3LO,X3HI,YFACE,ZFACE,JLO_CELL,JHI_CELL,& - KLO_CELL,KHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) - CASE(KAXIS) - X1AXIS = JAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 1._EB, 0._EB /) - ! x2, x3 axes parameters: - X2LO = KLO_FACE-CCGUARD; X2HI = KHI_FACE+CCGUARD - X3AXIS = IAXIS; X3LO = ILO_FACE-CCGUARD; X3HI = IHI_FACE+CCGUARD - X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) - ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: - X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS - CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & - X2LO,X2HI,X3LO,X3HI,ZFACE,XFACE,KLO_CELL,KHI_CELL,& - ILO_CELL,IHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) - CASE(IAXIS) - X1AXIS = KAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 0._EB, 1._EB /) - ! x2, x3 axes parameters: - X2LO = ILO_FACE-CCGUARD; X2HI = IHI_FACE+CCGUARD - X3AXIS = JAXIS; X3LO = JLO_FACE-CCGUARD; X3HI = JHI_FACE+CCGUARD - X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) - ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: - X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS - CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & - X2LO,X2HI,X3LO,X3HI,XFACE,YFACE,ILO_CELL,IHI_CELL,& - JLO_CELL,JHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) -END SELECT + ! Z direction bounds: + KLO_FACE = 0 ! Low mesh boundary face index. + KHI_FACE = M%KBAR ! High mesh boundary face index. + KLO_CELL = KLO_FACE + 1 ! First internal cell index. See notes. + KHI_CELL = KHI_FACE ! Last internal cell index. + KSTR = KLO_FACE - NGUARD ! Allocation start z arrays. + KEND = KHI_FACE + NGUARD ! Allocation end z arrays. -IF (BODINT_PLANE2%NSEGS == 0) THEN - IS_SOLID =.FALSE. - RETURN -ENDIF + ! Define grid arrays for this mesh: + ! Populate position and cell size arrays: Uniform grid implementation. + ! X direction: + ALLOCATE(DXCELL(ISTR:IEND)); DXCELL(ILO_CELL-1:IHI_CELL+1) = M%DX(ILO_CELL-1:IHI_CELL+1) + DO IGC=2,NGUARD + DXCELL(ILO_CELL-IGC)=DXCELL(ILO_CELL-IGC+1) + DXCELL(IHI_CELL+IGC)=DXCELL(IHI_CELL+IGC-1) + ENDDO + ALLOCATE(DXFACE(ISTR:IEND)); DXFACE(ILO_FACE:IHI_FACE)= M%DXN(ILO_FACE:IHI_FACE) + DO IGC=1,NGUARD + DXFACE(ILO_FACE-IGC)=DXFACE(ILO_FACE-IGC+1) + DXFACE(IHI_FACE+IGC)=DXFACE(ILO_FACE+IGC-1) + ENDDO + ALLOCATE(XCELL(ISTR:IEND)); XCELL = 1._EB/GEOMEPS ! Initialize huge. + XCELL(ILO_CELL-1:IHI_CELL+1) = M%XC(ILO_CELL-1:IHI_CELL+1) + DO IGC=2,NGUARD + XCELL(ILO_CELL-IGC)=XCELL(ILO_CELL-IGC+1)-DXFACE(ILO_FACE-IGC+1) + XCELL(IHI_CELL+IGC)=XCELL(IHI_CELL+IGC-1)+DXFACE(IHI_FACE+IGC-1) + ENDDO + ALLOCATE(XFACE(ISTR:IEND)); XFACE = 1._EB/GEOMEPS ! Initialize huge. + XFACE(ILO_FACE:IHI_FACE) = M%X(ILO_FACE:IHI_FACE) + DO IGC=1,NGUARD + XFACE(ILO_FACE-IGC)=XFACE(ILO_FACE-IGC+1)-DXCELL(ILO_CELL-IGC) + XFACE(IHI_FACE+IGC)=XFACE(IHI_FACE+IGC-1)+DXCELL(IHI_CELL+IGC) + ENDDO -XY(IAXIS:JAXIS) = (/ XP(X2AXIS), X3RAY /) -CALL GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) + ! Y direction: + ALLOCATE(DYCELL(JSTR:JEND)); DYCELL(JLO_CELL-1:JHI_CELL+1)= M%DY(JLO_CELL-1:JHI_CELL+1) + DO IGC=2,NGUARD + DYCELL(JLO_CELL-IGC)=DYCELL(JLO_CELL-IGC+1) + DYCELL(JHI_CELL+IGC)=DYCELL(JHI_CELL+IGC-1) + ENDDO + ALLOCATE(DYFACE(JSTR:JEND)); DYFACE(JLO_FACE:JHI_FACE)= M%DYN(JLO_FACE:JHI_FACE) + DO IGC=1,NGUARD + DYFACE(JLO_FACE-IGC)=DYFACE(JLO_FACE-IGC+1) + DYFACE(JHI_FACE+IGC)=DYFACE(JHI_FACE+IGC-1) + ENDDO + ALLOCATE(YCELL(JSTR:JEND)); YCELL = 1._EB/GEOMEPS ! Initialize huge. + YCELL(JLO_CELL-1:JHI_CELL+1) = M%YC(JLO_CELL-1:JHI_CELL+1) + DO IGC=2,NGUARD + YCELL(JLO_CELL-IGC)=YCELL(JLO_CELL-IGC+1)-DYFACE(JLO_FACE-IGC+1) + YCELL(JHI_CELL+IGC)=YCELL(JHI_CELL+IGC-1)+DYFACE(JHI_FACE+IGC-1) + ENDDO + ALLOCATE(YFACE(JSTR:JEND)); YFACE = 1._EB/GEOMEPS ! Initialize huge. + YFACE(JLO_FACE:JHI_FACE) = M%Y(JLO_FACE:JHI_FACE) + DO IGC=1,NGUARD + YFACE(JLO_FACE-IGC)=YFACE(JLO_FACE-IGC+1)-DYCELL(JLO_CELL-IGC) + YFACE(JHI_FACE+IGC)=YFACE(JHI_FACE+IGC-1)+DYCELL(JHI_CELL+IGC) + ENDDO -RETURN -END SUBROUTINE GET_IS_SOLID_3D + ! Z direction: + ALLOCATE(DZCELL(KSTR:KEND)); DZCELL(KLO_CELL-1:KHI_CELL+1)= M%DZ(KLO_CELL-1:KHI_CELL+1) + DO IGC=2,NGUARD + DZCELL(KLO_CELL-IGC)=DZCELL(KLO_CELL-IGC+1) + DZCELL(KHI_CELL+IGC)=DZCELL(KHI_CELL+IGC-1) + ENDDO + ALLOCATE(DZFACE(KSTR:KEND)); DZFACE(KLO_FACE:KHI_FACE)= M%DZN(KLO_FACE:KHI_FACE) + DO IGC=1,NGUARD + DZFACE(KLO_FACE-IGC)=DZFACE(KLO_FACE-IGC+1) + DZFACE(KHI_FACE+IGC)=DZFACE(KHI_FACE+IGC-1) + ENDDO + ALLOCATE(ZCELL(KSTR:KEND)); ZCELL = 1._EB/GEOMEPS ! Initialize huge. + ZCELL(KLO_CELL-1:KHI_CELL+1) = M%ZC(KLO_CELL-1:KHI_CELL+1) + DO IGC=2,NGUARD + ZCELL(KLO_CELL-IGC)=ZCELL(KLO_CELL-IGC+1)-DZFACE(KLO_FACE-IGC+1) + ZCELL(KHI_CELL+IGC)=ZCELL(KHI_CELL+IGC-1)+DZFACE(KHI_FACE+IGC-1) + ENDDO + ALLOCATE(ZFACE(KSTR:KEND)); ZFACE = 1._EB/GEOMEPS ! Initialize huge. + ZFACE(KLO_FACE:KHI_FACE) = M%Z(KLO_FACE:KHI_FACE) + DO IGC=1,NGUARD + ZFACE(KLO_FACE-IGC)=ZFACE(KLO_FACE-IGC+1)-DZCELL(KLO_CELL-IGC) + ZFACE(KHI_FACE+IGC)=ZFACE(KHI_FACE+IGC-1)+DZCELL(KHI_CELL+IGC) + ENDDO +ELSE -! ---------------------- GET_CARTCELL_CUTFACES ---------------------------------- + ! Face centered positions and cell sizes: + IF (ALLOCATED(XFACE)) DEALLOCATE(XFACE) + IF (ALLOCATED(YFACE)) DEALLOCATE(YFACE) + IF (ALLOCATED(ZFACE)) DEALLOCATE(ZFACE) + IF (ALLOCATED(DXFACE)) DEALLOCATE(DXFACE) + IF (ALLOCATED(DYFACE)) DEALLOCATE(DYFACE) + IF (ALLOCATED(DZFACE)) DEALLOCATE(DZFACE) -SUBROUTINE GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) + ! Cell centered positions and cell sizes: + IF (ALLOCATED(XCELL)) DEALLOCATE(XCELL) + IF (ALLOCATED(YCELL)) DEALLOCATE(YCELL) + IF (ALLOCATED(ZCELL)) DEALLOCATE(ZCELL) + IF (ALLOCATED(DXCELL)) DEALLOCATE(DXCELL) + IF (ALLOCATED(DYCELL)) DEALLOCATE(DYCELL) + IF (ALLOCATED(DZCELL)) DEALLOCATE(DZCELL) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +ENDIF -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -LOGICAL, INTENT(IN) :: BNDINT_FLAG +RETURN +END SUBROUTINE DEFINE_XYZFACE_CELL - ! Local Variables: -INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI -INTEGER :: I,J,K, JJ, KK -INTEGER, DIMENSION(LOW_IND:HIGH_IND,IAXIS:KAXIS) :: FSID_XYZ, CEIB_XYZ -LOGICAL :: OUTCELL1 -INTEGER :: X1AXIS, X2AXIS, X3AXIS -INTEGER :: XIAXIS, XJAXIS, XKAXIS -INTEGER :: X2LO, X2HI, X3LO, X3HI -INTEGER :: X2LO_CELL, X2HI_CELL, X3LO_CELL, X3HI_CELL -REAL(EB), DIMENSION(MAX_DIM) :: PLNORMAL -INTEGER, DIMENSION(MAX_DIM) :: IJK -REAL(EB) :: X1PLN -LOGICAL :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY -INTEGER :: NVERT, NEDGE, NFACE, NSEG, NCF, FNVERT, FNEDGE, CEI, NSEG_FACE -REAL(EB) :: FVERT(IAXIS:JAXIS,NOD1:NOD4) -LOGICAL :: INB_FLG -INTEGER :: CEELEM(NOD1:NOD2,1:CC_MAXCEELEM_FACE) -INTEGER :: INDSEG(CC_MAX_WSTRIANG_SEG+3,CC_MAXCEELEM_FACE) -REAL(EB) :: XYVERT(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) -INTEGER :: TRIS(NOD1:NOD3), ITRI -REAL(EB) :: XYEL(IAXIS:JAXIS,NOD1:NOD3), VAL, DUMMY(IAXIS:JAXIS) -REAL(EB) :: A_COEF, B_COEF, C_COEF, D_COEF, DENOM -INTEGER :: INDXI(IAXIS:KAXIS), INDIF, INDJF, INDKF -REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) :: XYZVERT, XYZVERTF -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL,SEG_CELL_AUX -INTEGER, SAVE :: SIZE_CEELEM_SEG_CELL +SUBROUTINE TAG_CC_BLOCKING_REFINEMENT -INTEGER, DIMENSION(NOD1:NOD2+1,1:CC_MAXCEELEM_FACE) :: SEG_FACE, SEG_FACE2 -INTEGER, DIMENSION(1:2,1:CC_MAXCFELEM_FACE) :: BOD_TRI -LOGICAL :: SEG_FLAG(1:CC_MAXCEELEM_FACE), INLIST, EQUAL1, EQUAL2, RH_ORIENTED -INTEGER :: COUNTR, CTR, CTSTART, FAXIS, ILH, IEDGE, SEG(NOD1:NOD2), STRI(1:CC_MAX_WSTRIANG_SEG+2), ISEG -INTEGER :: INOD1, INOD2, VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5), IDUM, IEQ1, IEQ2, NBODTRI -REAL(EB), DIMENSION(IAXIS:KAXIS) :: XYZ, NORMTRI, XCENI, XCEN, X1, X2, XC1, XC2, X12, VC1, V12, CROSSV -INTEGER, PARAMETER :: INDVERTBOD(1:3) = (/ 1, 2, 6 /) -INTEGER, PARAMETER :: INDVERTBOD2(1:3) = (/ 2, 1, 6 /) -INTEGER :: NCUTFACE, ICF, NSEG_LEFT, ISEG_FACE, IBOD, NP, IX, IBODTRI, NVSIZE -REAL(EB) :: AREAI, AREA, INXAREA, INT2 -REAL(EB), DIMENSION(IAXIS:KAXIS) :: ACEN, SQAREA +LOGICAL, PARAMETER :: DO_RAY_TRACING=.TRUE. +INTEGER :: DUM,II1,JJ1,KK1,IIO1,JJO1,KKO1,IIO2,JJO2,KKO2,IIG,JJG,KKG,IIOG,JJOG,KKOG -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNTED -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:):: IJK_COUNTF +IF ( DO_RAY_TRACING) THEN -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES + ! This loop is to block cut-cells on fine side grids for which coarse grid cut-cells have been blocked. + MAIN_MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX -INTEGER :: NVERT_AUX, NEDGE_OLD, IVERT, COUNT, IEOLD, INOD, NPOLY, CT_EDGES -INTEGER :: NSG_POLY(1:MAX_CELL_POLYLINES), ILO_POLY(1:MAX_CELL_POLYLINES) -LOGICAL :: FOUND -REAL(EB):: XYZV(IAXIS:KAXIS), NXP(IAXIS:KAXIS), XP(IAXIS:KAXIS), D12(IAXIS:KAXIS), D23(IAXIS:KAXIS), NNORM + CALL POINT_TO_MESH(NM) + M => MESHES(NM) -INTEGER :: I_NP, IG, XAXIS, NSPCELL_LIST -LOGICAL, ALLOCATABLE, DIMENSION(:) :: SOLID_EDGE -INTEGER, ALLOCATABLE, DIMENSION(:) :: VERT_SEGS, SEG_POS -INTEGER, ALLOCATABLE, DIMENSION(:,:):: SPCELL_LIST -LOGICAL :: CYCLE_CELL, IFLG -REAL(EB) :: XMIN(IAXIS:KAXIS),XMAX(IAXIS:KAXIS) + ! Set all fine side cut-cells in cells next to external boundaries which have SOLID coarse mesh faces + ! to CC%NOADVANCE(J)=BLOCKED_REFI_INTER and block them. + EXT_WALL_LOOP_1 : DO IW=1,M%N_EXTERNAL_WALL_CELLS + WC=>WALL(IW) + EWC=>EXTERNAL_WALL(IW) + BC =>BOUNDARY_COORD(WC%BC_INDEX) + IIG = BC%IIG;JJG = BC%JJG;KKG = BC%KKG; + II = BC%II; JJ = BC%JJ; KK = BC%KK; IOR = BC%IOR; X1AXIS=ABS(IOR) + NOM = EWC%NOM; IF(NOM<1 .OR. NOM==NM) CYCLE EXT_WALL_LOOP_1 + M2 => MESHES(NOM) + IIF=II; JJF=JJ; KKF=KK + SELECT CASE(IOR) + CASE(-IAXIS); IIF=IIF-1; + CASE(-JAXIS); JJF=JJF-1; + CASE(-KAXIS); KKF=KKF-1; + END SELECT + IF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)==1) THEN -REAL(EB) :: TNOW + ! Find if omesh cells under both IIG,JJG,KKG, and II,JJ,KK cells + ! are of type CC_CUTCFE and test if these small size cells have centroids within the SOLID. + IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN + IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN + SELECT CASE(IOR) + CASE( IAXIS); IIOG=IIO+1 + CASE(-IAXIS); IIOG=IIO-1 + CASE( JAXIS); JJOG=JJO+1 + CASE(-JAXIS); JJOG=JJO-1 + CASE( KAXIS); KKOG=KKO+1 + CASE(-KAXIS); KKOG=KKO-1 + END SELECT -INTEGER :: ETYPE,JEC -REAL(EB) :: X1V(IAXIS:KAXIS), X2V(IAXIS:KAXIS) -! INTEGER :: IEC -! REAL(EB) :: X1E(IAXIS:KAXIS), X2E(IAXIS:KAXIS) + ! Test for cut/reg-cells in II,JJ,KK, respect to IIO,JJO,KKO, AND IIG,JJG,KKG respect to IIOG,JJOG,KKOG: + DO DUM=1,2 + IF(DUM==1) THEN; II1 = II; JJ1 = JJ; KK1 = KK; IIO1= IIO; JJO1= JJO; KKO1= KKO + ELSE; II1 = IIG; JJ1 = JJG; KK1 = KKG; IIO1=IIOG; JJO1=JJOG; KKO1=KKOG + ENDIF + CALL TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL=.TRUE.) + ENDDO -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -INTEGER :: NCUTFCE + ! Test for cut/reg-cells in corner respect to OMESH undelying cell if needed: + IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN + IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(KKG>1 .AND. KKG1 .AND. IIG1 .AND. JJG1) THEN -TNOW=CURRENT_TIME() + ! If needed, block ghost cells of the other mesh which has finer cells. + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + IIOG=IIO; JJOG=JJO; KKOG=KKO; II=BC%II; JJ=BC%JJ; KK=BC%KK; IIG=BC%IIG; JJG=BC%JJG; KKG=BC%KKG + SELECT CASE(IOR) + CASE( IAXIS); IIOG=IIO+1 + CASE(-IAXIS); IIOG=IIO-1 + CASE( JAXIS); JJOG=JJO+1 + CASE(-JAXIS); JJOG=JJO-1 + CASE( KAXIS); KKOG=KKO+1 + CASE(-KAXIS); KKOG=KKO-1 + END SELECT + DO DUM=1,2 + IF(DUM==1) THEN; II1 = II; JJ1 = JJ; KK1 = KK; IIO1= IIO; JJO1= JJO; KKO1= KKO + ELSE; II1 = IIG; JJ1 = JJG; KK1 = KKG; IIO1=IIOG; JJO1=JJOG; KKO1=KKOG + ENDIF + CALL TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL=.FALSE.) + ENDDO -SIZE_CEELEM_SEG_CELL = DELTA_EDGE -ALLOCATE(SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL),SEG_POS(1:SIZE_CEELEM_SEG_CELL)) + ! Test for OMESH cut/reg-cells in corner respect to this mesh undelying cell if needed: + IIO2=IIO; JJO2=JJO; KKO2=KKO + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(KKOG>1 .AND. KKOG1 .AND. IIOG1 .AND. JJOG MESHES(NM) - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) + ! Set all fine side cut-cells in cells next to external boundaries which have SOLID coarse mesh faces + ! to CC%NOADVANCE(J)=BLOCKED_REFI_INTER and block them. + EXT_WALL_LOOP : DO IW=1,M%N_EXTERNAL_WALL_CELLS + WC=>WALL(IW); IF (WC%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY) CYCLE EXT_WALL_LOOP + EWC=>EXTERNAL_WALL(IW) + BC =>BOUNDARY_COORD(WC%BC_INDEX) + II = BC%II; JJ = BC%JJ; KK = BC%KK; IOR = BC%IOR; X1AXIS=ABS(IOR) + NOM = EWC%NOM + M2 => MESHES(NOM) + IIF=II; JJF=JJ; KKF=KK + SELECT CASE(IOR) + CASE(-IAXIS); IIF=IIF-1; + CASE(-JAXIS); JJF=JJF-1; + CASE(-KAXIS); KKF=KKF-1; + END SELECT + IF (EWC%AREA_RATIO<0.9_EB) THEN + + ! Check if other mesh boundary face set to SOLID and current mesh face set to .NOT.SOLID: + IIOF=EWC%IIO_MIN; JJOF=EWC%JJO_MIN; KKOF=EWC%KKO_MIN; LOHIF=HIGH_IND + SELECT CASE(IOR) + CASE(-IAXIS); IIOF=IIOF-1; LOHIF=LOW_IND + CASE(-JAXIS); JJOF=JJOF-1; LOHIF=LOW_IND + CASE(-KAXIS); KKOF=KKOF-1; LOHIF=LOW_IND + END SELECT + IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) CYCLE EXT_WALL_LOOP ! No need to do anything. + IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_SOLID) THEN ! Coarse side face is solid. + ! Set II,JJ,KK fine cells next to this EWC for blocking. + IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) THEN + ! Insert cut-cell in this location, set to Block. + CT = 6; + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II)*M%DY(JJ)*M%DZ(KK) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II),M%YC(JJ),M%ZC(KK) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = BLOCKED_REFI_INTER + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO AX=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND + ICFC=M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_IDCF,AX); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF(M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_FGSC,AX) == & + CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO + ! Insert cut_cell: + CALL INSERT_CUT_CELL(NM,II,JJ,KK,ICC); M => MESHES(NM) + CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M%CUT_CELL(ICC)%NCELL = NCELL + M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) + ELSEIF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_CUTCFE) THEN + ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. + ICC=M%CCVAR(II,JJ,KK,CC_IDCC); CC=> M%CUT_CELL(ICC) + JCC_LOOP_1 : DO JCC=1,CC%NCELL + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE = CC%CCELEM(IFC,JCC) + IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & + CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN + IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER + CYCLE JCC_LOOP_1 + ENDIF + ENDDO + ENDDO JCC_LOOP_1 + ENDIF + !ELSEIF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_CUTCFE) THEN + ! Coarse side is a cut-face in the boundary. + ENDIF + ELSEIF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)>1) THEN - ! For this cell check if no Cartesian boundary faces are CC_CUTCFE: - ! If outcell1 is true -> All regular faces for this face: - OUTCELL1 = (FSID_XYZ(LOW_IND ,IAXIS) /= CC_CUTCFE) .AND. & - (FSID_XYZ(HIGH_IND,IAXIS) /= CC_CUTCFE) .AND. & - (FSID_XYZ(LOW_IND ,JAXIS) /= CC_CUTCFE) .AND. & - (FSID_XYZ(HIGH_IND,JAXIS) /= CC_CUTCFE) .AND. & - (FSID_XYZ(LOW_IND ,KAXIS) /= CC_CUTCFE) .AND. & - (FSID_XYZ(HIGH_IND,KAXIS) /= CC_CUTCFE) + IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) THEN ! Coarse side face is solid. + ! If needed, block ghost cells of the other mesh which has finer cells. + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + IIOF=IIO; JJOF=JJO; KKOF=KKO; IOGC=IIO; JOGC=JJO; KOGC=KKO; LOHIF=LOW_IND + SELECT CASE(IOR) + CASE( IAXIS); IOGC=IOGC+1; + CASE(-IAXIS); IIOF= IIO-1; LOHIF=HIGH_IND + CASE( JAXIS); JOGC=JOGC+1; + CASE(-JAXIS); JJOF= JJO-1; LOHIF=HIGH_IND + CASE( KAXIS); KOGC=KOGC+1; + CASE(-KAXIS); KKOF= KKO-1; LOHIF=HIGH_IND + END SELECT + IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_SOLID) CYCLE ! No need to do anything. - ! Drop if outcell1 & outcell2 - IF (OUTCELL1) THEN - IF ( (FSID_XYZ(LOW_IND ,IAXIS) == CC_SOLID) .AND. & - (FSID_XYZ(HIGH_IND,IAXIS) == CC_SOLID) .AND. & - (FSID_XYZ(LOW_IND ,JAXIS) == CC_SOLID) .AND. & - (FSID_XYZ(HIGH_IND,JAXIS) == CC_SOLID) .AND. & - (FSID_XYZ(LOW_IND ,KAXIS) == CC_SOLID) .AND. & - (FSID_XYZ(HIGH_IND,KAXIS) == CC_SOLID) ) THEN - MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_SOLID + ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking. + IF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_GASPHASE) THEN + ! Insert cut-cell in this location, set to Block. + CT = 6; + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M2%DX(IOGC)*M2%DY(JOGC)*M2%DZ(KOGC) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M2%XC(IOGC),M2%YC(JOGC),M2%ZC(KOGC) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = BLOCKED_REFI_INTER + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO AX=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND; ICFC=& + M2%FCVAR(IOGC+ADDI(SIDE,AX),JOGC+ADDJ(SIDE,AX),KOGC+ADDK(SIDE,AX),CC_IDCF,AX); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF( & + M2%FCVAR(IOGC+ADDI(SIDE,AX),JOGC+ADDJ(SIDE,AX),KOGC+ADDK(SIDE,AX),CC_FGSC,AX)& + == CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO + ! Insert cut_cell: + CALL INSERT_CUT_CELL(NOM,IOGC,JOGC,KOGC,ICC); M2 => MESHES(NOM) + CALL NEW_CELL_ALLOC(NOM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M2%CUT_CELL(ICC)%NCELL = NCELL + M2%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M2%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M2%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M2%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M2%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M2%CUT_CELL(ICC)%NOADVANCE) + ELSEIF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_CUTCFE) THEN + ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. + ICC=M2%CCVAR(IOGC,JOGC,KOGC,CC_IDCC); CC=> M2%CUT_CELL(ICC) + JCC_LOOP_3 : DO JCC=1,CC%NCELL + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE = CC%CCELEM(IFC,JCC) + IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & + CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN + IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER + CYCLE JCC_LOOP_3 + ENDIF + ENDDO + ENDDO JCC_LOOP_3 + ENDIF + ENDDO + ENDDO + ENDDO + !ELSEIF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_CUTCFE) THEN + ! Coarse side is a cut-face in the boundary. ENDIF - CYCLE ENDIF + ENDDO EXT_WALL_LOOP + ENDDO MAIN_MESH_LOOP_2 - MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE - - ENDDO - ENDDO -ENDDO - - -! First add edges stemming from triangles laying on gridline planes: -! Dump triangle aligned segments as cut-cell cut-edges, on face cases: -! BNDINT_COND : IF (BNDINT_FLAG) THEN - ! Do Loop for different x1 planes: - X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS - - SELECT CASE(X1AXIS) - CASE(IAXIS) - - PLNORMAL = (/ 1._EB, 0._EB, 0._EB/) - ILO = ILO_FACE-CCGUARD; IHI = IHI_FACE+CCGUARD - JLO = JLO_FACE; JHI = JLO_FACE - KLO = KLO_FACE; KHI = KLO_FACE - - ! x2, x3 axes parameters: - X2AXIS = JAXIS; X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD - X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD - - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS +ENDIF +RETURN +END SUBROUTINE TAG_CC_BLOCKING_REFINEMENT - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(ISTR:IEND),DX1FACE(ISTR:IEND)) - X1FACE = XFACE; DX1FACE = DXFACE - ALLOCATE(X2FACE(JSTR:JEND),DX2FACE(JSTR:JEND)) - X2FACE = YFACE; DX2FACE = DYFACE - ALLOCATE(X3FACE(KSTR:KEND),DX3FACE(KSTR:KEND)) - X3FACE = ZFACE; DX3FACE = DZFACE +SUBROUTINE TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL) - ! x2 cell center parameters: - X2LO_CELL = JLO_CELL-CCGUARD; X2HI_CELL = JHI_CELL+CCGUARD - ALLOCATE(X2CELL(JSTR:JEND),DX2CELL(JSTR:JEND)) - X2CELL = YCELL; DX2CELL = DYCELL +INTEGER, INTENT(IN) :: NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1 +LOGICAL, INTENT(IN) :: FINE_CELL +TYPE(MESH_TYPE), POINTER :: M,M2 +M =>MESHES( NM) +M2=>MESHES(NOM) - ! x3 cell center parameters: - X3LO_CELL = KLO_CELL-CCGUARD; X3HI_CELL = KHI_CELL+CCGUARD - ALLOCATE(X3CELL(KSTR:KEND),DX3CELL(KSTR:KEND)) - X3CELL = ZCELL; DX3CELL = DZCELL +IF (FINE_CELL) THEN - CASE(JAXIS) + ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC); ICC = 0 + IF ( ICC2 > 0 .OR. M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN ! There are cut-cells in omesh cartesian cell. + IF(M%CCVAR(II1,JJ1,KK1,CC_CGSC)==CC_GASPHASE) THEN + ! Insert cut-cell is this location: + CT = 6; + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II1)*M%DY(JJ1)*M%DZ(KK1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II1),M%YC(JJ1),M%ZC(KK1) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED + IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) NOADVANCE(1) = BLOCKED_REFI_INTER + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO AX=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND + ICFC=M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_IDCF,AX); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF(M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_FGSC,AX) == & + CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO + ! Insert cut_cell: + CALL INSERT_CUT_CELL(NM,II1,JJ1,KK1,ICC); M => MESHES(NM) + CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M%CUT_CELL(ICC)%NCELL = NCELL + M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) + ELSEIF(M%CCVAR(II1,JJ1,KK1,CC_IDCC)>0) THEN + ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC) + ENDIF + ! Here Test if cut-cells in II,KK,KK are blocked or not in IIO,JJO,KKO: + IF(ICC>0) THEN + IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN + WHERE(M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL)==NOT_BLOCKED) & + M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL) = BLOCKED_REFI_INTER + ELSE; CALL TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) + ENDIF + ENDIF + ENDIF - PLNORMAL = (/ 0._EB, 1._EB, 0._EB/) - ILO = ILO_FACE; IHI = ILO_FACE - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - KLO = KLO_FACE; KHI = KLO_FACE +ELSE - ! x2, x3 axes parameters: - X2AXIS = KAXIS; X2LO = KLO_FACE-CCGUARD; X2HI = KHI_FACE+CCGUARD - X3AXIS = IAXIS; X3LO = ILO_FACE-CCGUARD; X3HI = IHI_FACE+CCGUARD + ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC); ICC2 = 0 + IF(ICC>0) THEN + ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking. + IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_GASPHASE) THEN + ! Insert cut-cell in this location, set to Block. + CT = 6; + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M2%DX(IIO1)*M2%DY(JJO1)*M2%DZ(KKO1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M2%XC(IIO1),M2%YC(JJO1),M2%ZC(KKO1) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO AX=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND; ICFC=& + M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_IDCF,AX); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF( & + M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_FGSC,AX)& + == CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO + ! Insert cut_cell: + CALL INSERT_CUT_CELL(NOM,IIO1,JJO1,KKO1,ICC2); M2 => MESHES(NOM) + CALL NEW_CELL_ALLOC(NOM,ICC2,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M2%CUT_CELL(ICC2)%NCELL = NCELL + M2%CUT_CELL(ICC2)%NFACE_CELL = NFACE_CELL + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M2%CUT_CELL(ICC2)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M2%CUT_CELL(ICC2)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M2%CUT_CELL(ICC2)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M2%CUT_CELL(ICC2)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M2%CUT_CELL(ICC2)%NOADVANCE) + ELSEIF(M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC)>0) THEN + ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC) + ENDIF + ! Here Test if cut-cells in IIO,JJO,KKO are blocked or not in II,JJ,KK: + IF(ICC2>0) CALL TEST_CC_FOR_BLOCKING(NOM,ICC2,NM,II1,JJ1,KK1,ICC) + ENDIF - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS +ENDIF - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(JSTR:JEND),DX1FACE(JSTR:JEND)) - X1FACE = YFACE; DX1FACE = DYFACE - ALLOCATE(X2FACE(KSTR:KEND),DX2FACE(KSTR:KEND)) - X2FACE = ZFACE; DX2FACE = DZFACE - ALLOCATE(X3FACE(ISTR:IEND),DX3FACE(ISTR:IEND)) - X3FACE = XFACE; DX3FACE = DXFACE +END SUBROUTINE TAG_BLOCK_CELL - ! x2 cell center parameters: - X2LO_CELL = KLO_CELL-CCGUARD; X2HI_CELL = KHI_CELL+CCGUARD - ALLOCATE(X2CELL(KSTR:KEND),DX2CELL(KSTR:KEND)) - X2CELL = ZCELL; DX2CELL = DZCELL +SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) - ! x3 cell center parameters: - X3LO_CELL = ILO_CELL-CCGUARD; X3HI_CELL = IHI_CELL+CCGUARD - ALLOCATE(X3CELL(ISTR:IEND),DX3CELL(ISTR:IEND)) - X3CELL = XCELL; DX3CELL = DXCELL +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - CASE(KAXIS) +INTEGER, INTENT(IN) :: NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2 - PLNORMAL = (/ 0._EB, 0._EB, 1._EB/) - ILO = ILO_FACE; IHI = ILO_FACE - JLO = JLO_FACE; JHI = JLO_FACE - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD +INTEGER :: JCC,FC_FOUND,FC_TYPE,INBFC,INBFC_LOC,VERT_CUTFACE,NVERT,X1AXIS,X2AXIS,X3AXIS,NCROSS,DIRRAY,IFC1,JFC1,& + NVERT2,VERT_CUTFACE2,IV,IFCC,IFACE2,IFC2,JFC2 +TYPE(MESH_TYPE), POINTER :: M,M2 +TYPE(CC_CUTCELL_TYPE), POINTER :: CC,CC2 +TYPE(CC_CUTFACE_TYPE), POINTER :: CF2 +INTEGER, PARAMETER :: EAST=1,WEST=2,FRONT=3,BACK=4,SOUTH=5,NORTH=6 +INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM,CFELEM2 +REAL(EB),ALLOCATABLE, DIMENSION(:,:):: XYZVERTIJK,XYZVERTSTN +REAL(EB):: XYZCEN(MAX_DIM),NVEC(MAX_DIM),P0(MAX_DIM),A,B,C,D,XYZ_P(MAX_DIM),PTCEN(IAXIS:JAXIS),X1F,XC2(MAX_DIM),XC3(MAX_DIM),& + XLO,XHI,YLO,YHI,ZLO,ZHI,XLO2,XHI2,YLO2,YHI2,ZLO2,ZHI2,CFCEN(MAX_DIM),XYZC(MAX_DIM,1),N(MAX_DIM,1),S(MAX_DIM,1),& + T(MAX_DIM,1),TBN(MAX_DIM,MAX_DIM),XYZCSTN(MAX_DIM,1),NN(MAX_DIM,1),XN_CEN,XN_INT,XYZC2(IAXIS:KAXIS,1) +REAL(EB), PARAMETER :: SCALE_FCT=1.E-4_EB +LOGICAL :: IN_CFACE,BLOCK_CELL,FGPOINT +! INTEGER :: LU_CCELL +! CHARACTER(50) :: FILENAME - ! x2, x3 axes parameters: - X2AXIS = IAXIS; X2LO = ILO_FACE-CCGUARD; X2HI = IHI_FACE+CCGUARD - X3AXIS = JAXIS; X3LO = JLO_FACE-CCGUARD; X3HI = JHI_FACE+CCGUARD +M =>MESHES( NM) +M2=>MESHES(NOM) - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS +INBFC=M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCF); IF(INBFC<1) RETURN ! No CC_INBOUNDARY faces in this cartesian cell. - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)) - X1FACE = ZFACE; DX1FACE = DZFACE - ALLOCATE(X2FACE(ISTR:IEND),DX2FACE(ISTR:IEND)) - X2FACE = XFACE; DX2FACE = DXFACE - ALLOCATE(X3FACE(JSTR:JEND),DX3FACE(JSTR:JEND)) - X3FACE = YFACE; DX3FACE = DYFACE +CC =>M%CUT_CELL( ICC) +CC2=>M2%CUT_CELL(ICC2) +CF2=>M2%CUT_FACE(INBFC) +VERT_CUTFACE = SIZE(CF2%CFELEM, DIM=1); ALLOCATE(CFELEM(1:VERT_CUTFACE)) +NVERT = SIZE(CF2%XYZVERT,DIM=2) +! For each cut-cell in CC, test if its centroid Xc is in the SOLID region of CC2: +! We do this by finding a direction to a Cartesian face type CC_GASPHASE or CC_SOLID and intersection point XE, +FC_FOUND=0; FC_TYPE=CC_UNDEFINED; DIRRAY=CC_UNDEFINED +! Then counting INBOUNDARY cut-face intersections from XE point to Xc. +SELECT CASE(M2%FCVAR(IIO1-1,JJO1,KKO1,CC_FGSC,IAXIS)) +CASE(CC_GASPHASE) +FC_FOUND=WEST; FC_TYPE =CC_GASPHASE; DIRRAY=IAXIS +IF(IIO1==0) THEN; X1F=M2%X(IIO1)-M2%DX(IIO1); ELSE; X1F=M2%X(IIO1-1); ENDIF +CASE(CC_SOLID ) +FC_FOUND=WEST; FC_TYPE =CC_SOLID; DIRRAY=IAXIS +IF(IIO1==0) THEN; X1F=M2%X(IIO1)-M2%DX(IIO1); ELSE; X1F=M2%X(IIO1-1); ENDIF +END SELECT +IF(FC_FOUND<1) THEN + SELECT CASE(M2%FCVAR(IIO1 ,JJO1,KKO1,CC_FGSC,IAXIS)) + CASE(CC_GASPHASE) + FC_FOUND=EAST; FC_TYPE =CC_GASPHASE; DIRRAY=-IAXIS + IF(IIO1==M2%IBP1) THEN; X1F=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; X1F=M2%X(IIO1); ENDIF + CASE(CC_SOLID ) + FC_FOUND=EAST; FC_TYPE =CC_SOLID; DIRRAY=-IAXIS + IF(IIO1==M2%IBP1) THEN; X1F=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; X1F=M2%X(IIO1); ENDIF + END SELECT +ENDIF +IF(FC_FOUND<1) THEN + SELECT CASE(M2%FCVAR(IIO1,JJO1-1,KKO1,CC_FGSC,JAXIS)) + CASE(CC_GASPHASE) + FC_FOUND=FRONT; FC_TYPE =CC_GASPHASE; DIRRAY=JAXIS + IF(JJO1==0) THEN; X1F=M2%Y(JJO1)-M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1-1); ENDIF + CASE(CC_SOLID ) + FC_FOUND=FRONT; FC_TYPE =CC_SOLID; DIRRAY=JAXIS + IF(JJO1==0) THEN; X1F=M2%Y(JJO1)-M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1-1); ENDIF + END SELECT +ENDIF +IF(FC_FOUND<1) THEN + SELECT CASE(M2%FCVAR(IIO1,JJO1 ,KKO1,CC_FGSC,JAXIS)) + CASE(CC_GASPHASE) + FC_FOUND=BACK; FC_TYPE =CC_GASPHASE; DIRRAY=-JAXIS + IF(JJO1==M2%JBP1) THEN; X1F=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1); ENDIF + CASE(CC_SOLID ) + FC_FOUND=BACK; FC_TYPE =CC_SOLID; DIRRAY=-JAXIS + IF(JJO1==M2%JBP1) THEN; X1F=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1); ENDIF + END SELECT +ENDIF +IF(FC_FOUND<1) THEN + SELECT CASE(M2%FCVAR(IIO1,JJO1,KKO1-1,CC_FGSC,KAXIS)) + CASE(CC_GASPHASE) + FC_FOUND=SOUTH; FC_TYPE =CC_GASPHASE; DIRRAY=KAXIS + IF(KKO1==0) THEN; X1F=M2%Z(KKO1)-M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1-1); ENDIF + CASE(CC_SOLID ) + FC_FOUND=SOUTH; FC_TYPE =CC_SOLID; DIRRAY=KAXIS + IF(KKO1==0) THEN; X1F=M2%Z(KKO1)-M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1-1); ENDIF + END SELECT +ENDIF +IF(FC_FOUND<1) THEN + SELECT CASE(M2%FCVAR(IIO1,JJO1,KKO1 ,CC_FGSC,KAXIS)) + CASE(CC_GASPHASE) + FC_FOUND=NORTH; FC_TYPE =CC_GASPHASE; DIRRAY=-KAXIS + IF(KKO1==M2%KBP1) THEN; X1F=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1); ENDIF + CASE(CC_SOLID ) + FC_FOUND=NORTH; FC_TYPE =CC_SOLID; DIRRAY=-KAXIS + IF(KKO1==M2%KBP1) THEN; X1F=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1); ENDIF + END SELECT +ENDIF - ! x2 cell center parameters: - X2LO_CELL = ILO_CELL-CCGUARD; X2HI_CELL = IHI_CELL+CCGUARD - ALLOCATE(X2CELL(ISTR:IEND),DX2CELL(ISTR:IEND)) - X2CELL = XCELL; DX2CELL = DXCELL +IF(FC_FOUND<1) RETURN ! Here or before we can switch to a point in polygon test whithin JCC_LOOP. - ! x3 cell center parameters: - X3LO_CELL = JLO_CELL-CCGUARD; X3HI_CELL = JHI_CELL+CCGUARD - ALLOCATE(X3CELL(JSTR:JEND),DX3CELL(JSTR:JEND)) - X3CELL = YCELL; DX3CELL = DYCELL +SELECT CASE(ABS(DIRRAY)) +CASE(IAXIS); X1AXIS = IAXIS; X2AXIS = JAXIS; X3AXIS = KAXIS +CASE(JAXIS); X1AXIS = JAXIS; X2AXIS = KAXIS; X3AXIS = IAXIS +CASE(KAXIS); X1AXIS = KAXIS; X2AXIS = IAXIS; X3AXIS = JAXIS +END SELECT - END SELECT +! IF(NM==1 .AND. ICC<30) THEN +! LU_CCELL = 797 +! WRITE(FILENAME,'(A,I6.6,A)') 'FACESBLK_',ICC,'.txt' +! OPEN(UNIT=LU_CCELL,FILE=FILENAME,STATUS='UNKNOWN') +! WRITE(LU_CCELL,*) NVERT,VERT_CUTFACE,X1AXIS,X2AXIS,X3AXIS,CF2%NFACE +! ENDIF - ! Loop Slices: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI +I=CC%IJK(IAXIS); J=CC%IJK(JAXIS); K=CC%IJK(KAXIS) +IF(I== 0) THEN; XLO=M%X( I)-M%DX( I); ELSE; XLO=M%X(I-1); ENDIF +IF(I==M%IBP1) THEN; XHI=M%X(I-1)+M%DX( I); ELSE; XHI=M%X( I); ENDIF +IF(J== 0) THEN; YLO=M%Y( J)-M%DY( J); ELSE; YLO=M%Y(J-1); ENDIF +IF(J==M%JBP1) THEN; YHI=M%Y(J-1)+M%DY( J); ELSE; YHI=M%Y( J); ENDIF +IF(K== 0) THEN; ZLO=M%Z( K)-M%DZ( K); ELSE; ZLO=M%Z(K-1); ENDIF +IF(K==M%KBP1) THEN; ZHI=M%Z(K-1)+M%DZ( K); ELSE; ZHI=M%Z( K); ENDIF - IJK(IAXIS:KAXIS) = (/ I, J, K /) +IF(IIO1== 0) THEN; XLO2=M2%X( IIO1)-M2%DX(IIO1); ELSE; XLO2=M2%X(IIO1-1); ENDIF +IF(IIO1==M2%IBP1) THEN; XHI2=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; XHI2=M2%X( IIO1); ENDIF +IF(JJO1== 0) THEN; YLO2=M2%Y( JJO1)-M2%DY(JJO1); ELSE; YLO2=M2%Y(JJO1-1); ENDIF +IF(JJO1==M2%JBP1) THEN; YHI2=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; YHI2=M2%Y( JJO1); ENDIF +IF(KKO1== 0) THEN; ZLO2=M2%Z( KKO1)-M2%DZ(KKO1); ELSE; ZLO2=M2%Z(KKO1-1); ENDIF +IF(KKO1==M2%KBP1) THEN; ZHI2=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; ZHI2=M2%Z( KKO1); ENDIF - ! Plane: - X1PLN = X1FACE(IJK(X1AXIS)) +IFC1 = M%CCVAR(I,J,K,CC_IDCF) +IF(IFC1>0) THEN + NVERT2 = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) + ALLOCATE(XYZVERTIJK(MAX_DIM,NVERT2)); XYZVERTIJK = M%CUT_FACE(IFC1)%XYZVERT + ALLOCATE(XYZVERTSTN(MAX_DIM,NVERT2)) + VERT_CUTFACE2 = SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1); ALLOCATE(CFELEM2(VERT_CUTFACE2)) +ENDIF +JCC_LOOP : DO JCC=1,CC%NCELL + ! Get point within gas region of cut-cell: + FGPOINT=.FALSE. + IFC_LOOP : DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + IFC1 = CC%FACE_LIST(4,IFACE) + JFC1 = CC%FACE_LIST(5,IFACE) + IF (CC%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE + CFCEN(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) + CFELEM(1:3) = M%CUT_FACE(IFC1)%CFELEM(1:3,JFC1) + XC2(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,CFELEM(2))-CFCEN(IAXIS:KAXIS) + XC3(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,CFELEM(3))-CFCEN(IAXIS:KAXIS) + CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) + IF (NORM2(NVEC) XHI-GEOMEPS) CYCLE + IF(XYZC(JAXIS,1) < YLO+GEOMEPS .OR. XYZC(JAXIS,1) > YHI-GEOMEPS) CYCLE + IF(XYZC(KAXIS,1) < ZLO+GEOMEPS .OR. XYZC(KAXIS,1) > ZHI-GEOMEPS) CYCLE + IF(XYZC(IAXIS,1) < XLO2+GEOMEPS .OR. XYZC(IAXIS,1) > XHI2-GEOMEPS) CYCLE + IF(XYZC(JAXIS,1) < YLO2+GEOMEPS .OR. XYZC(JAXIS,1) > YHI2-GEOMEPS) CYCLE + IF(XYZC(KAXIS,1) < ZLO2+GEOMEPS .OR. XYZC(KAXIS,1) > ZHI2-GEOMEPS) CYCLE - ! Drop if node locations outside block plane area: - IF ((X2FACE(X2LO)-MAXVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE - IF ((MINVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))-X2FACE(X2HI)) > GEOMEPS) CYCLE - IF ((X3FACE(X3LO)-MAXVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE - IF ((MINVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))-X3FACE(X3HI)) > GEOMEPS) CYCLE + ! Build S,T,N transformation matrix: + N(:,1) = -NVEC; S(:,1) = XC2/NORM2(XC2); CALL CROSS_PRODUCT(T(:,1),N(:,1),S(:,1)) + TBN(1,:)= S(:,1); TBN(2,:)= T(:,1); TBN(3,:)= N(:,1) - ! Allocate triangles variables: - ALLOCATE(BODINT_PLANE%X1NVEC(1:BODINT_PLANE%NTRIS), & - BODINT_PLANE%AINV(1:2,1:2,1:BODINT_PLANE%NTRIS)) + ! Check that cut-face centroid is within its polygon. + XYZC2(IAXIS:KAXIS,1) = CFCEN(IAXIS:KAXIS); XYZCSTN = MATMUL(TBN,XYZC2) + DO IV = 1,NVERT2; XYZVERTSTN(:,IV) = MATMUL(TBN,XYZVERTIJK(:,IV))-XYZCSTN(:,1); ENDDO + CFELEM2(1:VERT_CUTFACE2) =M%CUT_FACE(IFC1)%CFELEM(1:VERT_CUTFACE2,JFC1) + PTCEN(IAXIS:JAXIS) = 0._EB; CALL POINT_IN_POLYGON(PTCEN,VERT_CUTFACE2,CFELEM2,NVERT2,1,2,XYZVERTSTN,IN_CFACE) + IF(.NOT.IN_CFACE) CYCLE - ! Triangles inverses: - DO ITRI=1,BODINT_PLANE%NTRIS + ! Run again over all CFACES of the JCC cut-cell (except IFC) and check for other intersections within their polygons: + ! 1. First of all compute XYZCENSTN, allocate XYZVERTSTN and populate it. Compute XYZVERTSTN-XYZCENSTN. + XYZCSTN = MATMUL(TBN,XYZC) + DO IV = 1,NVERT2 + XYZVERTSTN(:,IV) = MATMUL(TBN,XYZVERTIJK(:,IV))-XYZCSTN(:,1) + ENDDO - TRIS(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) + ! 2. Run over CFACEs, copy CFELEM and find if intersection point in CFACE + point location: + DO IFCC=1,CC%CCELEM(1,JCC) + IF(IFCC==IFC) CYCLE + IFACE2 = CC%CCELEM(IFCC+1,JCC) + IFC2 = CC%FACE_LIST(4,IFACE2) + JFC2 = CC%FACE_LIST(5,IFACE2) + IF (CC%FACE_LIST(1,IFACE2) /= CC_FTYPE_CFINB) CYCLE - ! This is local IAXIS:JAXIS - XYEL(IAXIS:JAXIS,NOD1) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD1)), & - BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD1)) /) - XYEL(IAXIS:JAXIS,NOD2) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD2)), & - BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD2)) /) - XYEL(IAXIS:JAXIS,NOD3) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD3)), & - BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD3)) /) + CFCEN(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZCEN(IAXIS:KAXIS,JFC2) + CFELEM2(1:VERT_CUTFACE2) = M%CUT_FACE(IFC2)%CFELEM(1:VERT_CUTFACE2,JFC2) + XC2(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZVERT(IAXIS:KAXIS,CFELEM2(2))-CFCEN(IAXIS:KAXIS) + XC3(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZVERT(IAXIS:KAXIS,CFELEM2(3))-CFCEN(IAXIS:KAXIS) + CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) + IF (NORM2(NVEC)XN_CEN+GEOMEPS) CYCLE + ! Found an intersection in a face closer to XYZC than original CF centroid, try another point. + CYCLE IFC_LOOP + ENDIF + ENDDO + ! Did not find intersection, XYZC is inside the cut-cell, use as XYZCEN: + FGPOINT=.TRUE. + XYZCEN(IAXIS:KAXIS) = XYZC(IAXIS:KAXIS,1) + EXIT IFC_LOOP + ENDDO IFC_LOOP + ! If point in inside cut-cell not found - fall back to using cut-cell centroid: + IF(.NOT.FGPOINT) XYZCEN(IAXIS:KAXIS) = CC%XYZCEN(IAXIS:KAXIS,JCC) + PTCEN(IAXIS:JAXIS) = XYZCEN( (/ X2AXIS, X3AXIS /) ) - ! Transformation Matrix for this triangle in x2x3 plane: - IF (BODINT_PLANE%X1NVEC(ITRI) < 0._EB) THEN ! Rotate node 2 and 3 locations - DUMMY(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,NOD2) - XYEL(IAXIS:JAXIS,NOD2) = XYEL(IAXIS:JAXIS,NOD3) - XYEL(IAXIS:JAXIS,NOD3) = DUMMY(IAXIS:JAXIS) - ENDIF + NCROSS=0; + IF(FC_TYPE==CC_SOLID ) BLOCK_CELL=.TRUE. + IF(FC_TYPE==CC_GASPHASE) BLOCK_CELL=.FALSE. + ! Here do ray-tracing from FC_FOUND to centroid location for this cut cell, use point in poly to note the + ! intersections with CC_INBOUNDARY cut-faces: + ! IF(NM==1 .AND. ICC<30) THEN + ! WRITE(LU_CCELL,*) PTCEN(IAXIS:JAXIS) + ! DO I=1,NVERT + ! WRITE(LU_CCELL,*) CF2%XYZVERT(:,I) + ! ENDDO + ! ENDIF + INBFC_LOC_LOOP : DO INBFC_LOC=1,CF2%NFACE + ! Normal, max normal component, define plane X2AXIS,X3AXIS to do search: + CFELEM(1:VERT_CUTFACE) = CF2%CFELEM(1:VERT_CUTFACE,INBFC_LOC) + XC2(IAXIS:KAXIS) = CF2%XYZVERT(IAXIS:KAXIS,CFELEM(2))-CF2%XYZCEN(IAXIS:KAXIS,INBFC_LOC) + XC3(IAXIS:KAXIS) = CF2%XYZVERT(IAXIS:KAXIS,CFELEM(3))-CF2%XYZCEN(IAXIS:KAXIS,INBFC_LOC) + CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) - ! Inverse of Master to physical triangle transform matrix: - A_COEF = XYEL(IAXIS,NOD1) - XYEL(IAXIS,NOD3) - B_COEF = XYEL(IAXIS,NOD2) - XYEL(IAXIS,NOD3) - C_COEF = XYEL(JAXIS,NOD1) - XYEL(JAXIS,NOD3) - D_COEF = XYEL(JAXIS,NOD2) - XYEL(JAXIS,NOD3) - DENOM = A_COEF * D_COEF - B_COEF * C_COEF - BODINT_PLANE%AINV(1,1,ITRI) = D_COEF / DENOM - BODINT_PLANE%AINV(2,1,ITRI) = -C_COEF / DENOM - BODINT_PLANE%AINV(1,2,ITRI) = -B_COEF / DENOM - BODINT_PLANE%AINV(2,2,ITRI) = A_COEF / DENOM + IF (NORM2(NVEC)X1F +GEOMEPS) CYCLE INBFC_LOC_LOOP + ELSE + IF(XYZ_P(X1AXIS)XYZCEN(X1AXIS)+GEOMEPS) CYCLE INBFC_LOC_LOOP + ENDIF + NCROSS = NCROSS + 1 ! Add crossing between face and cut-cell centroid. + BLOCK_CELL=.NOT.BLOCK_CELL + ENDIF + ! IF(NM==1 .AND. ICC<30) THEN + ! IF(MY_RANK==0) WRITE(0,*) 'TESTS INBFC_LOC_LOOP',INBFC_LOC,PTCEN(IAXIS:JAXIS),XYZCEN(X1AXIS),XYZ_P(X1AXIS),& + ! NVEC(2),D,IN_CFACE,BLOCK_CELL + ! ENDIF + ENDDO INBFC_LOC_LOOP + ! Here set no ADVANCE if BLOCK_CELL=T: + IF(BLOCK_CELL .AND. CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC) = BLOCKED_REFI_INTER +ENDDO JCC_LOOP - ENDDO +! IF(NM==1 .AND. ICC<30) CLOSE(LU_CCELL) - ! There are triangles aligned with this x1pln: - ! Run by Face: - ! First solid Faces: x1 Faces, Check where they lay: - DO KK=X3LO_CELL,X3HI_CELL - DO JJ=X2LO_CELL,X2HI_CELL +DEALLOCATE(CFELEM) +IF(ALLOCATED(XYZVERTIJK)) DEALLOCATE(XYZVERTIJK,XYZVERTSTN,CFELEM2) +RETURN +END SUBROUTINE TEST_CC_FOR_BLOCKING - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ IJK(X1AXIS), JJ, KK /) ! Local x1,x2,x3 - INDIF = INDXI(XIAXIS) - INDJF = INDXI(XJAXIS) - INDKF = INDXI(XKAXIS) +SUBROUTINE GET_CC_FACE_CELL_LIST_INFO(NM,PHASE) - IF (IJK_COUNTF(INDIF,INDJF,INDKF,X1AXIS)) CYCLE +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: PHASE - IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_FGSC,X1AXIS) /= CC_GASPHASE ) THEN +! Local Vars: +INTEGER :: ICC,JCC,IFC,IFACE,ICF1,ICF2,JCF,ICE,JCE,IIE,JJE,KKE,IIF,JJF,KKF,X1AXIS,EAXIS,IEDG_LOC,IEDGE +TYPE(MESH_TYPE), POINTER :: M +M=>MESHES(NM) - FVERT(IAXIS:JAXIS,NOD1) = (/ X2FACE(JJ-1), X3FACE(KK-1) /) - FVERT(IAXIS:JAXIS,NOD2) = (/ X2FACE(JJ ), X3FACE(KK-1) /) - FVERT(IAXIS:JAXIS,NOD3) = (/ X2FACE(JJ ), X3FACE(KK ) /) - FVERT(IAXIS:JAXIS,NOD4) = (/ X2FACE(JJ-1), X3FACE(KK ) /) +! FACE-CELL incidence: +CUT_CELL_LOOP : DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC => M%CUT_CELL(ICC) + IF(PHASE==2) THEN + IF(CC%IJK(IAXIS)<-1 .OR. CC%IJK(IAXIS)>M%IBAR+2) CYCLE CUT_CELL_LOOP + IF(CC%IJK(JAXIS)<-1 .OR. CC%IJK(JAXIS)>M%JBAR+2) CYCLE CUT_CELL_LOOP + IF(CC%IJK(KAXIS)<-1 .OR. CC%IJK(KAXIS)>M%KBAR+2) CYCLE CUT_CELL_LOOP + ENDIF + DO JCC=1,CC%NCELL + ! Loop faces and test: + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + SELECT CASE(CC%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_CFGAS) ! GASPHASE cut-face: + ICF1 = CC%FACE_LIST(4,IFACE) + ICF2 = CC%FACE_LIST(5,IFACE); CF => M%CUT_FACE(ICF1) + IF (CC%FACE_LIST(2,IFACE) == LOW_IND) THEN ! Cut-face on low side of cut-cell: + CF%CELL_LIST(IAXIS:KAXIS+1,HIGH_IND,ICF2) = & + (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) + ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. + CF%XCENHIGH(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) + ELSE ! HIGH + CF%CELL_LIST(IAXIS:KAXIS+1,LOW_IND,ICF2) = & + (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) + ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. + CF%XCENLOW(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) + ENDIF + CASE(CC_FTYPE_CFINB) ! INBOUNDARY cut-face: + ICF1 = CC%FACE_LIST(4,IFACE) + ICF2 = CC%FACE_LIST(5,IFACE); CF => M%CUT_FACE(ICF1) + ! We add the cut-cell related info in LOW_IND + CF%CELL_LIST(IAXIS:KAXIS+1,LOW_IND,ICF2) = & + (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) + ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. + CF%XCENLOW(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) + END SELECT + ENDDO + ENDDO +ENDDO CUT_CELL_LOOP - ! Get triangle face intersection: - CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) +! EDGE-FACE incidence: +! First Allocate DXX and FACE_LIST for CUT_EDGEs: +DO ICE=1,M%N_CUTEDGE_MESH + CE => M%CUT_EDGE(ICE) + IF(ALLOCATED(CE%DXX)) DEALLOCATE(CE%DXX) + IF(ALLOCATED(CE%FACE_LIST)) DEALLOCATE(CE%FACE_LIST) + IF(ALLOCATED(CE%DUIDXJ)) DEALLOCATE(CE%DUIDXJ) + IF(ALLOCATED(CE%MU_DUIDXJ)) DEALLOCATE(CE%MU_DUIDXJ) + ! DXX(1), DXX(2) + ALLOCATE(CE%DXX(1:2,SIZE(CE%CEELEM,DIM=2))); CE%DXX = 0._EB + ! ! ICF JCF, dir -2 -1 1 2, JCE. + ALLOCATE(CE%FACE_LIST(1:3,-2:2,SIZE(CE%CEELEM,DIM=2))); CE%FACE_LIST = CC_UNDEFINED +ENDDO - ! Triangle - face intersection vertices and edges: - CALL GET_TRIANG_FACE_INT(X2AXIS,X3AXIS,FVERT,CEI,NM, & - INB_FLG,FNVERT,XYVERT,FNEDGE,CEELEM,INDSEG) +CUTFACE_LOOP : DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + CF => M%CUT_FACE(ICF); IF(CF%STATUS/=CC_GASPHASE) CYCLE + IIF= CF%IJK(IAXIS); JJF= CF%IJK(JAXIS); KKF= CF%IJK(KAXIS); X1AXIS= CF%IJK(KAXIS+1) + IF(PHASE==2) THEN + SELECT CASE (X1AXIS) + CASE(IAXIS) + IF(IIF<-2 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP + IF(JJF<-1 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP + IF(KKF<-1 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP + CASE(JAXIS) + IF(IIF<-1 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP + IF(JJF<-2 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP + IF(KKF<-1 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP + CASE(KAXIS) + IF(IIF<-1 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP + IF(JJF<-1 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP + IF(KKF<-2 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP + END SELECT + ENDIF + DO JCF=1,CF%NFACE + DO IEDG_LOC=2,CF%CEDGES(1,JCF)+1 + IEDGE = CF%CEDGES(IEDG_LOC,JCF) + SELECT CASE(CF%EDGE_LIST(1,IEDGE)) + CASE(CC_ETYPE_RGGAS) ! RCEDGE to be defined in .. + ! LOHI = CF%EDGE_LIST(2,IEDGE) + ! AXIS = CF%EDGE_LIST(3,IEDGE) + ! CC_RCEDGE.. Filled once RCEDGES are built. + CASE(CC_ETYPE_CFGAS) ! Gas cut-edge + ICE = CF%EDGE_LIST(2,IEDGE) + JCE = CF%EDGE_LIST(3,IEDGE) + CE => M%CUT_EDGE(ICE) + IIE = CE%IJK(IAXIS); JJE = CE%IJK(JAXIS); KKE = CE%IJK(KAXIS) + EAXIS= CE%IJK(KAXIS+1) + SELECT CASE(EAXIS) + CASE(IAXIS) ! Edge in x dir. + IF(X1AXIS==KAXIS) THEN ! Face in z dir, +/- y. + CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(YFACE(JJE)-CF%XYZCEN(JAXIS,JCF)) + IF(JJF==JJE) THEN ! Face -1, resp to IEDGE. + CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(JJF==JJE+1) THEN + CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ELSEIF(X1AXIS==JAXIS) THEN ! Face in y dir, +/- z: + CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(ZFACE(KKE)-CF%XYZCEN(KAXIS,JCF)) + IF(KKF==KKE) THEN ! Face -2, resp to IEDGE. + CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(KKF==KKE+1) THEN + CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ENDIF + CASE(JAXIS) ! Edge in y dir. + IF(X1AXIS==IAXIS) THEN ! Face in x dir, +/- z. + CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(ZFACE(KKE)-CF%XYZCEN(KAXIS,JCF)) + IF(KKF==KKE) THEN ! Face -1, resp to IEDGE. + CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(KKF==KKE+1) THEN + CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ELSEIF(X1AXIS==KAXIS) THEN ! Face in z dir, +/- x + CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(XFACE(IIE)-CF%XYZCEN(IAXIS,JCF)) + IF(IIF==IIE) THEN ! Face -2, resp to IEDGE. + CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(IIF==IIE+1) THEN + CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ENDIF + CASE(KAXIS) ! Edge in z dir. + IF(X1AXIS==JAXIS) THEN ! Face in y dir, +/- x. + CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(XFACE(IIE)-CF%XYZCEN(IAXIS,JCF)) + IF(IIF==IIE) THEN ! Face -1, resp to IEDGE. + CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(IIF==IIE+1) THEN + CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ELSEIF(X1AXIS==IAXIS) THEN ! Face in x dir, +/- y. + CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(YFACE(JJE)-CF%XYZCEN(JAXIS,JCF)) + IF(JJF==JJE) THEN ! Face -2, resp to IEDGE. + CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) + ELSEIF(JJF==JJE+1) THEN + CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) + ENDIF + ENDIF + END SELECT - ! XYvert to XYZvert: - IF ( INB_FLG ) THEN - XYZVERTF = 0._EB - XYZVERTF(X1AXIS,1:FNVERT) = X1PLN - XYZVERTF(X2AXIS,1:FNVERT) = XYVERT(IAXIS,1:FNVERT) - XYZVERTF(X3AXIS,1:FNVERT) = XYVERT(JAXIS,1:FNVERT) + CASE(CC_ETYPE_CFINB) ! Inboundary cut-edge (face) - ! Test for edges inside SOLID Region: - ALLOCATE(SOLID_EDGE(1:FNEDGE)); SOLID_EDGE(1:FNEDGE)=.FALSE. - DO IEDGE=1,FNEDGE - ! No body associated with segment. Might not be needed. - IG = INDSEG(4,IEDGE) - IF ( IG < 1) CYCLE - SEG(NOD1:NOD2) = CEELEM(NOD1:NOD2,IEDGE) - XP(IAXIS:KAXIS)= 0.5_EB*(XYZVERTF(IAXIS:KAXIS,SEG(NOD1))+XYZVERTF(IAXIS:KAXIS,SEG(NOD2))) - ! Direction NP: - NXP(IAXIS:KAXIS) = 0._EB - DO I_NP=1,INDSEG(1,IEDGE) - ITRI = INDSEG(1+I_NP,IEDGE) - NXP(IAXIS:KAXIS) = NXP(IAXIS:KAXIS) + GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,ITRI) - ENDDO - NXP = NXP/NORM2(NXP); XAXIS=MAXLOC(ABS(NXP(IAXIS:KAXIS)),DIM=1) - ! Perturb XP in the average normal NP direction: - IF (INDSEG(1,IEDGE) > 1) XP = XP + 10._EB*GEOMEPS*NXP - CALL GET_IS_SOLID_3D(XAXIS,XP,INDIF,INDJF,INDKF,SOLID_EDGE(IEDGE)) - ENDDO - ! Now drop SEGS with SOLID_EDGE(IEDGE)=true: - COUNT = 0 - DO IEDGE=1,FNEDGE - IF (SOLID_EDGE(IEDGE)) CYCLE - COUNT=COUNT+1 - CEELEM(NOD1:NOD2,COUNT) = CEELEM(NOD1:NOD2,IEDGE) - INDSEG(1:CC_MAX_WSTRIANG_SEG+2,COUNT) = INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) - ENDDO - CEELEM(NOD1:NOD2,COUNT+1:FNEDGE) = CC_UNDEFINED - INDSEG(1:CC_MAX_WSTRIANG_SEG+2,COUNT+1:FNEDGE) = CC_UNDEFINED - FNEDGE = COUNT - DEALLOCATE(SOLID_EDGE) + END SELECT + ENDDO + ENDDO +ENDDO CUTFACE_LOOP - ! Here ADD nodes and vertices to what is already - ! there: - IF (CEI == 0) THEN ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = FNVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = FNEDGE - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,FNVERT,FNEDGE) - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = & - (/ INDIF, INDJF, INDKF, X1AXIS, CC_GS /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF - MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:FNVERT) = & - XYZVERTF(IAXIS:KAXIS,1:FNVERT) - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:FNEDGE) = & - CEELEM(NOD1:NOD2,1:FNEDGE) - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:FNEDGE) = & - INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:FNEDGE) - ELSE +! Allocate for gas CUT_EDGEs DUIDXJ, MU_DUIDXJ +DO ICE=1,M%N_CUTEDGE_MESH + CE => M%CUT_EDGE(ICE); IF(CE%STATUS/=CC_GASPHASE) CYCLE + IF(.NOT.ALLOCATED(CE%DUIDXJ)) THEN + ALLOCATE(CE%DUIDXJ( -2:2,1:SIZE(CE%CEELEM,DIM=2))); CE%DUIDXJ = 0._EB + ALLOCATE(CE%MU_DUIDXJ(-2:2,1:SIZE(CE%CEELEM,DIM=2))); CE%MU_DUIDXJ = 0._EB + ENDIF + ! Assign DXX to grid size for cut-edges with unassigned deltas: + I=CE%IJK(IAXIS); J=CE%IJK(JAXIS); K=CE%IJK(KAXIS); X1AXIS=CE%IJK(KAXIS+1) + DO JCE=1,CE%NEDGE + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(CE%DXX(1,JCE)M%CUT_FACE(ICF1) + WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE,CF%STATUS + DO ICF2=1,CF%NFACE + WRITE(33,'(I8,3F16.8,F16.8)') ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) + ICC=CF%CELL_LIST(2,LOW_IND,ICF2); JCC=CF%CELL_LIST(3,LOW_IND,ICF2) + WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& + M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) + CC=>M%CUT_CELL(ICC) + IFACE = CC%CCELEM(CF%CELL_LIST(4,LOW_IND,ICF2)+1,JCC) + IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN + WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& + ICF2,CC%FACE_LIST(5,IFACE) + ENDIF + IF(CF%STATUS==CC_GASPHASE) THEN + ICC=CF%CELL_LIST(2,HIGH_IND,ICF2); JCC=CF%CELL_LIST(3,HIGH_IND,ICF2) + WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& + M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) + CC=>M%CUT_CELL(ICC) + IFACE = CC%CCELEM(CF%CELL_LIST(4,HIGH_IND,ICF2)+1,JCC) + IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN + WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& + ICF2,CC%FACE_LIST(5,IFACE) ENDIF - IJK_COUNTF(INDIF,INDJF,INDKF,X1AXIS)=.TRUE. ENDIF ENDDO + ENDIF + ENDDO + X1AXIS=0 + IF(M%CCVAR(I,J,K,CC_IDCF)>0)THEN + ICF1=M%CCVAR(I,J,K,CC_IDCF); CF=>M%CUT_FACE(ICF1) + WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE,CF%STATUS + DO ICF2=1,CF%NFACE + WRITE(33,'(I8,3F16.8,F16.8)') ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) + ICC=CF%CELL_LIST(2,LOW_IND,ICF2); JCC=CF%CELL_LIST(3,LOW_IND,ICF2) + WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& + M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) + CC=>M%CUT_CELL(ICC) + IFACE = CC%CCELEM(CF%CELL_LIST(4,LOW_IND,ICF2)+1,JCC) + IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN + WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& + ICF2,CC%FACE_LIST(5,IFACE) + ENDIF ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + CLOSE(33) - DEALLOCATE(BODINT_PLANE%X1NVEC,BODINT_PLANE%AINV) - ENDDO ! I - ENDDO ! J - ENDDO ! K + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFACES.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,A,I8,I8,I8,I8)') I,J,K,':',& + M%ECVAR(I,J,K,CC_EGSC,IAXIS),M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) + DO X1AXIS=IAXIS,KAXIS + IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN + ICE=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(ICE) + WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE + DO JCE=1,CE%NEDGE + WRITE(33,'(I8,F12.8,F12.8)') JCE,CE%DXX(1,JCE),CE%DXX(2,JCE) + DO JCF=-2,2 + IF(JCF==0) CYCLE + ! Face JCF: + ICF1=CE%FACE_LIST(1,JCF,JCE); ICF2=CE%FACE_LIST(2,JCF,JCE) + CF=>M%CUT_FACE(ICF1) + WRITE(33,'(4I8,I8,3F16.8,F16.8)') CF%IJK(1:4),ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) + ENDDO + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CLOSE(33) +ENDIF - ! Deallocate local plane arrays: - DEALLOCATE(X1FACE,X2FACE,X3FACE,X2CELL,X3CELL) - DEALLOCATE(DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL) +RETURN +END SUBROUTINE GET_CC_FACE_CELL_LIST_INFO - ENDDO X1AXIS_LOOP -! ENDIF BNDINT_COND -! Second: Loop over cut-cells: For cut-cell i,j,k,lb -! - From cut-cell Cartesian faces, figure out INBOUNDCF segments (CUT_EDGE) -! and the wet surface triangles related to them. -! - From CCVAR(I,J,K,CC_IDCE), figure out INBOUNDCC segments in CUT_EDGE -! and triangles they belong to. -! - Working by triangle -> reorient segments using triangle normal outside -! of body (no disjoint areas are expected) -! - Load into CUT_FACE <=> CCVAR(I,J,K,CC_IDCF). -IF (BNDINT_FLAG) THEN - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL -ELSE - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD -ENDIF -! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: -DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI +! ---------------------- GET_REGULAR_CUTCELLS_BOX ------------------------------ - IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE +SUBROUTINE GET_REGULAR_CUTCELLS_BOX - IF (CELLRT(I,J,K)) CYCLE ! Special cell with bod-bod or self intersection. +CALL CC_GRID_GET_REGULAR_CUTCELLS_BOX(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) - IF(IJK_COUNTED(I,J,K)) CYCLE; IJK_COUNTED(I,J,K)=.TRUE. +#if 0 +! Local Variables: +INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: GEOMCELL +INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: GEOMFACE +INTEGER :: IBNDINT,INTGC_FLG,BNDINT_LOW,BNDINT_HIGH,II,JJ,KK,IG,ILO,IHI,JLO,JHI,KLO,KHI,X1LO,X1HI,X2LO,X2HI,X3LO,X3HI, & + INDXI(IAXIS:KAXIS) +INTEGER :: INDI,INDJ,INDK,INDI1,INDJ1,INDK1,INDI2,INDJ2,INDK2,INDI3,INDJ3,INDK3,INDI4,INDJ4,INDK4 +INTEGER :: INDXI1(IAXIS:KAXIS),INDXI2(IAXIS:KAXIS),INDXI3(IAXIS:KAXIS),INDXI4(IAXIS:KAXIS) +INTEGER :: NVERT,NFACE,NVERTFACE,NCUTFACE,NCUTCELL,FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS),CFELEM(1:NOD4+1,6),& + IDCF_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) +INTEGER :: LOHI,IWSEL,I1,I2,I3,IBOD(6),ITRI(6),FACE_LIST(1:CC_NPARAM_CCFACE,1:6),CEI_AXIS(LOW_IND:HIGH_IND),& + CEI,SIDE,NCFACE_CUTCELL,NFACE_CELL +REAL(EB):: DIST, DIST2, VOL(1) +REAL(EB):: XYZLC(IAXIS:KAXIS),XYZVERT(IAXIS:KAXIS,NOD1:NOD4+20),AREA(6),XYZCEN(IAXIS:KAXIS,6),XCEN(IAXIS:KAXIS) +REAL(EB):: INXAREA(IAXIS:KAXIS,1:6)=0._EB,INXSQAREA(IAXIS:KAXIS,1:6)=0._EB +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNTED2,IJK_COUNT - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) - ! Start cut-cell INB cut-faces computation: - ! Loop local arrays to cell: - NSEG = 0 - SEG_CELL = CC_UNDEFINED +! Allocate Face - Geom numbering and Cell - Geom numbering arrays +ALLOCATE(GEOMFACE(ISTR:IEND,JSTR:JEND,KSTR:KEND,MAX_DIM)); GEOMFACE = CC_GASPHASE +ALLOCATE(GEOMCELL(ISTR:IEND,JSTR:JEND,KSTR:KEND)); GEOMCELL = CC_GASPHASE - NVERT = 0 - NFACE = 0 - XYZVERT = 0._EB +! First tag cells: NM is set and we have all the mesh info in MESHES(NM) +DO K=KLO_CELL-NGUARD,KHI_CELL+NGUARD + DO J=JLO_CELL-NGUARD,JHI_CELL+NGUARD + DO I=ILO_CELL-NGUARD,IHI_CELL+NGUARD + DO IG=1,N_GEOMETRY + IF(XCELL(I) < GEOMETRY(IG)%XB(1)) CYCLE + IF(XCELL(I) > GEOMETRY(IG)%XB(2)) CYCLE + IF(YCELL(J) < GEOMETRY(IG)%XB(3)) CYCLE + IF(YCELL(J) > GEOMETRY(IG)%XB(4)) CYCLE + IF(ZCELL(K) < GEOMETRY(IG)%XB(5)) CYCLE + IF(ZCELL(K) > GEOMETRY(IG)%XB(6)) CYCLE + GEOMCELL(I,J,K) = IG + MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_SOLID + EXIT + ENDDO + ENDDO + ENDDO +ENDDO - ! CUT_EDGE index of bounding Cartesian faces: - CEIB_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCE,IAXIS) - CEIB_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCE,IAXIS) - CEIB_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCE,JAXIS) - CEIB_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCE,JAXIS) - CEIB_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCE,KAXIS) - CEIB_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCE,KAXIS) +! Now Tag cut-cells: The -2, +2 is to be able to define cut-face types below on boundary of GC cut-cells. +DO K=KLO_CELL-NGUARD+1,KHI_CELL+NGUARD-1 + DO J=JLO_CELL-NGUARD+1,JHI_CELL+NGUARD-1 + DO I=ILO_CELL-NGUARD+1,IHI_CELL+NGUARD-1 + IF(MESHES(NM)%CCVAR(I,J,K,CC_CGSC)==CC_SOLID) THEN + ! Set all vertices to Solid: + MESHES(NM)%VERTVAR(I-1,J ,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I-1,J-1,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I-1,J-1,K-1,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I-1,J ,K-1,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J ,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J-1,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J-1,K-1,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J ,K-1,CC_VGSC) = CC_SOLID + CYCLE + ENDIF + IF(ANY(MESHES(NM)%CCVAR(I-1:I+1,J-1:J+1,K-1:K+1,CC_CGSC) == CC_SOLID)) & + MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE + ENDDO + ENDDO +ENDDO - ! Cartesian Faces INBOUNDARY segments: - DO FAXIS=IAXIS,KAXIS - DO ILH=LOW_IND,HIGH_IND - ! By segment: Add Vertices/Segments to local arrays: - CEI = CEIB_XYZ(ILH,FAXIS) - IF ( CEI > 0 ) THEN ! There are inboundary cut-edges - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE +! Then tag faces: +! X Faces: +DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD + DO J=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD + DO I=ILO_FACE-CCGUARD,IHI_FACE+CCGUARD + ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: + IF(ANY(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_GASPHASE)) CYCLE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - STRI(1:CC_MAX_WSTRIANG_SEG+2) = & - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) + ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: + IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_SOLID)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID + GEOMFACE(I,J,K,IAXIS) = GEOMCELL(I,J,K) + CYCLE + ENDIF - ! x,y,z of node 1: - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD1,XYZVERT) - ! x,y,z of node 2: - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD2,XYZVERT) + ! Now Gasphase cut-faces: All CCVAR == CUTCFE + IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_CUTCFE)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_CUTCFE + ! GEOMFACE(I,J,K,IAXIS) stays CC_GASPHASE + CYCLE + ENDIF - VEC(NOD1:NOD2) = (/ INOD1, INOD2 /) - VEC(NOD2+1:NOD2+CC_MAX_WSTRIANG_SEG+2) = STRI(1:CC_MAX_WSTRIANG_SEG+2) - VEC(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7) = (/ CC_ETYPE_CFINB, CEI, IEDGE /) - ! Insertion ADD segment: - INLIST = .FALSE. - DO IDUM = 1,NSEG - DO IEQ1=1,3 - EQUAL1 = SEG_CELL(INDVERTBOD(IEQ1),IDUM) == VEC(INDVERTBOD(IEQ1)) - IF (.NOT.EQUAL1) EXIT - ENDDO - DO IEQ2=1,3 - EQUAL2 = SEG_CELL(INDVERTBOD(IEQ2),IDUM) == VEC(INDVERTBOD2(IEQ2)) - IF (.NOT.EQUAL2) EXIT - ENDDO - IF ( EQUAL1 .OR. EQUAL2 ) THEN - IF ( SEG_CELL(3,IDUM) > VEC(3) ) THEN - ! DO NOTHING: - ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN - SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 - SEG_CELL(5,IDUM) = VEC(4) - ENDIF - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - NSEG = NSEG + 1 - CALL REALLOCATE_SEG_CELL - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - ENDIF - ENDDO - ENDIF - ENDDO - ENDDO + ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: + IF (GEOMCELL(I,J,K)*GEOMCELL(I+1,J,K) < 0) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID + GEOMFACE(I,J,K,IAXIS) = MAXVAL(GEOMCELL(I:I+1,J,K)) ! This is because one is ==CC_GASPHASE==-1 + CYCLE + ENDIF + ENDDO + ENDDO +ENDDO - ! Cells INBOUNDARY segments: - CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCE) - IF ( CEI > 0 ) THEN ! There are inboundary cut-edges - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - DO IEDGE=1,NEDGE +! Y Faces: +DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD + DO J=JLO_FACE-CCGUARD,JHI_FACE+CCGUARD + DO I=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD + ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: + IF(ANY(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_GASPHASE)) CYCLE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - STRI(1:CC_MAX_WSTRIANG_SEG+2) = & - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) + ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: + IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_SOLID)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_SOLID + GEOMFACE(I,J,K,JAXIS) = GEOMCELL(I,J,K) + CYCLE + ENDIF - ! x,y,z of node 1: - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD1,XYZVERT) - ! x,y,z of node 2: - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD2,XYZVERT) + ! Now Gasphase cut-faces: All CCVAR == CUTCFE + IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_CUTCFE)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_CUTCFE + ! GEOMFACE(I,J,K,JAXIS) stays CC_GASPHASE + CYCLE + ENDIF - IF (INOD1 == INOD2) CYCLE + ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: + IF (GEOMCELL(I,J,K)*GEOMCELL(I,J+1,K) < 0) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_SOLID + GEOMFACE(I,J,K,JAXIS) = MAXVAL(GEOMCELL(I,J:J+1,K)) ! This is because one is ==CC_GASPHASE==-1 + CYCLE + ENDIF + ENDDO + ENDDO +ENDDO - VEC(NOD1:NOD2) = (/ INOD1, INOD2 /) - VEC(NOD2+1:NOD2+CC_MAX_WSTRIANG_SEG+2) = STRI(1:CC_MAX_WSTRIANG_SEG+2) - VEC(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7) = (/ CC_ETYPE_CFINB, CEI, IEDGE /) - ! Insertion ADD segment: - INLIST = .FALSE. - DO IDUM = 1,NSEG - DO IEQ1=1,3 - EQUAL1 = SEG_CELL(INDVERTBOD(IEQ1),IDUM) == VEC(INDVERTBOD(IEQ1)) - IF (.NOT.EQUAL1) EXIT - ENDDO - DO IEQ2=1,3 - EQUAL2 = SEG_CELL(INDVERTBOD(IEQ2),IDUM) == VEC(INDVERTBOD2(IEQ2)) - IF (.NOT.EQUAL2) EXIT - ENDDO - IF ( EQUAL1 .OR. EQUAL2 ) THEN - IF ( SEG_CELL(3,IDUM) > VEC(3) ) THEN - ! DO NOTHING: - ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN - SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 - SEG_CELL(5,IDUM) = VEC(4) - ENDIF - INLIST = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - NSEG = NSEG + 1 - CALL REALLOCATE_SEG_CELL - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - ENDIF - ENDDO +! Z Faces: +DO K=KLO_FACE-CCGUARD,KHI_FACE+CCGUARD + DO J=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD + DO I=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD + ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: + IF(ANY(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_GASPHASE)) CYCLE + + ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: + IF(ALL(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_SOLID)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_SOLID + GEOMFACE(I,J,K,KAXIS) = GEOMCELL(I,J,K) + CYCLE + ENDIF + + ! Now Gasphase cut-faces: All CCVAR == CUTCFE + IF(ALL(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_CUTCFE)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_CUTCFE + ! GEOMFACE(I,J,K,KAXIS) stays CC_GASPHASE + CYCLE ENDIF - ! Drop segments that are unconnected: - ALLOCATE(VERT_SEGS(1:NVERT)); VERT_SEGS(1:NVERT)=0 - DO IDUM = 1,NSEG - IF (SEG_CELL(NOD1,IDUM) == SEG_CELL(NOD2,IDUM)) CYCLE - VERT_SEGS(SEG_CELL(NOD1,IDUM)) = VERT_SEGS(SEG_CELL(NOD1,IDUM)) + 1 - VERT_SEGS(SEG_CELL(NOD2,IDUM)) = VERT_SEGS(SEG_CELL(NOD2,IDUM)) + 1 - ENDDO - ALLOCATE(SEG_CELL_AUX(SIZE(SEG_CELL,DIM=1),SIZE(SEG_CELL,DIM=2))) - SEG_CELL_AUX = SEG_CELL - COUNT = 0 - DO IDUM = 1,NSEG - IF ( (SEG_CELL_AUX(NOD1,IDUM) /= SEG_CELL_AUX(NOD2,IDUM)) .AND. & - (VERT_SEGS(SEG_CELL_AUX(NOD1,IDUM))>1) .AND. (VERT_SEGS(SEG_CELL_AUX(NOD2,IDUM))>1) ) THEN - COUNT = COUNT + 1 - SEG_CELL(:,COUNT) = SEG_CELL_AUX(:,IDUM) + ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: + IF (GEOMCELL(I,J,K)*GEOMCELL(I,J,K+1) < 0) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_SOLID + GEOMFACE(I,J,K,KAXIS) = MAXVAL(GEOMCELL(I,J,K:K+1)) ! This is because one is ==CC_GASPHASE==-1 CYCLE ENDIF - ENDDO - NSEG = COUNT - DEALLOCATE(SEG_CELL_AUX,VERT_SEGS) + ENDDO + ENDDO +ENDDO - ! Now obtain body-triangle combinations present: - BOD_TRI = CC_UNDEFINED - NBODTRI = 0 - DO ISEG=1,NSEG - ! First triangle location (Assume one body and at - ! most two triangs per seg). - INLIST = .FALSE. - DO IBODTRI=1,NBODTRI - IF ( (BOD_TRI(1,IBODTRI) == SEG_CELL(6,ISEG)) .AND. & - (BOD_TRI(2,IBODTRI) == SEG_CELL(4,ISEG)) ) THEN - ! Body/triang already on list. - INLIST = .TRUE. - CYCLE - ENDIF - enddo - IF (.NOT.INLIST) THEN - ! Add first triang to list: - NBODTRI = NBODTRI + 1 - BOD_TRI(1:2,NBODTRI) = SEG_CELL( (/ 6, 4 /) , ISEG) - ENDIF +! Now define Gasphase and boundary cut-faces: 1 Boundary, 2 internal, 3 guard cell faces: +INTGC_FLG_LOOP : DO INTGC_FLG=LOW_IND,HIGH_IND - ! No second triangle associated: - IF ( SEG_CELL(3,ISEG) < 2 ) CYCLE + ! GASPHASE cut-faces: + NVERT = 4; NFACE = 1; NVERTFACE = 5 + IF (INTGC_FLG==LOW_IND) THEN + ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. + BNDINT_LOW = 1; BNDINT_HIGH = 3 + ELSE + BNDINT_LOW = 4; BNDINT_HIGH = 4 + ENDIF - ! Second triangle location - INLIST = .FALSE. - DO IBODTRI=1,NBODTRI - IF ( (BOD_TRI(1,IBODTRI) == SEG_CELL(6,ISEG)) .AND. & - (BOD_TRI(2,IBODTRI) == SEG_CELL(5,ISEG)) ) THEN - ! Body/triang already on list. - INLIST = .TRUE. - CYCLE - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - ! Add first triang to list: - NBODTRI = NBODTRI + 1 - BOD_TRI(1:2,NBODTRI) = SEG_CELL( (/ 6, 5 /) , ISEG) - ENDIF - ENDDO ! ISEG. + IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, + ! 4 guard-cell faces. - ! Do Test for cycling when all body-triangle combinations produce two or less segments: - SEG_FLAG(1)=.TRUE. - DO ICF=1,NBODTRI - IBOD = BOD_TRI(1,ICF) - ITRI = BOD_TRI(2,ICF) - NSEG_FACE = 0 - DO ISEG=1,NSEG - IF ((SEG_CELL(6,ISEG) == IBOD) .AND. & - ((SEG_CELL(4,ISEG) == ITRI) .OR. (SEG_CELL(5,ISEG) == ITRI)) ) THEN - NSEG_FACE = NSEG_FACE + 1 - ENDIF - ENDDO - ! If only one or two seg => continue: - IF ( NSEG_FACE <= 2 ) CYCLE - SEG_FLAG(1)=.FALSE. - EXIT - ENDDO - IF (SEG_FLAG(1)) CYCLE ! CYCLES I,J,K loop. + ! When switching to internal faces, copy number of external faces already computed. + IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH - ! This is a cut-face, allocate space: - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE + X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS + SELECT CASE(X1AXIS) + CASE(IAXIS) + X2AXIS = JAXIS; X3AXIS = KAXIS + ! IAXIS gasphase cut-faces: + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + ILO = ILO_FACE; IHI = ILO_FACE + CASE(2) + ILO = IHI_FACE; IHI = IHI_FACE + CASE(3) + ILO = ILO_FACE+1; IHI = IHI_FACE-1 + CASE(4) + ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS + ! Local indexing in x1, x2, x3: + X1LO = ILO; X1HI = IHI + X2LO = JLO; X2HI = JHI + X3LO = KLO; X3HI = KHI + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE + ALLOCATE(X2FACE(JSTR:JEND)); X2FACE = YFACE + ALLOCATE(X3FACE(KSTR:KEND)); X3FACE = ZFACE - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + CASE(JAXIS) + X2AXIS = KAXIS; X3AXIS = IAXIS + ! JAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + JLO = JLO_FACE; JHI = JLO_FACE + CASE(2) + JLO = JHI_FACE; JHI = JHI_FACE + CASE(3) + JLO = JLO_FACE+1; JHI = JHI_FACE-1 + CASE(4) + JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS + ! Local indexing in x1, x2, x3: + X1LO = JLO; X1HI = JHI + X2LO = KLO; X2HI = KHI + X3LO = ILO; X3HI = IHI + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE + ALLOCATE(X2FACE(KSTR:KEND)); X2FACE = ZFACE + ALLOCATE(X3FACE(ISTR:IEND)); X3FACE = XFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, 0 /) ! No axis = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_INBOUNDARY - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NBODTRI,CC_MAXVERT_CUTFACE) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - ALLOCATE(CF%EDGE_LIST(3,NSEG)) - CF%EDGE_LIST(1:3,1:NSEG) = SEG_CELL(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7,1:NSEG) - ALLOCATE(CF%CEDGES(SIZE(CF%CFELEM,DIM=1),SIZE(CF%CFELEM,DIM=2))); CF%CEDGES = CC_UNDEFINED + CASE(KAXIS) + X2AXIS = IAXIS; X3AXIS = JAXIS + ! KAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + KLO = KLO_FACE; KHI = KLO_FACE + CASE(2) + KLO = KHI_FACE; KHI = KHI_FACE + CASE(3) + KLO = KLO_FACE+1; KHI = KHI_FACE-1 + CASE(4) + KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + END SELECT + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS + ! Local indexing in x1, x2, x3: + X1LO = KLO; X1HI = KHI + X2LO = ILO; X2HI = IHI + X3LO = JLO; X3HI = JHI + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE + ALLOCATE(X2FACE(ISTR:IEND)); X2FACE = XFACE + ALLOCATE(X3FACE(JSTR:JEND)); X3FACE = YFACE + + END SELECT + + ! Loop on Cartesian faces, local x1, x2, x3 indexes: + DO II=X1LO,X1HI + DO KK=X3LO,X3HI + DO JJ=X2LO,X2HI + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI = INDXI(XIAXIS) + INDJ = INDXI(XJAXIS) + INDK = INDXI(XKAXIS) + ! Drop if not CUTCFE: + IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE; IJK_COUNTED(INDI,INDJ,INDK,X1AXIS)=.TRUE. + IF(MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE + + + ! Vertex at index II,JJ-1,KK-1: + INDXI1(IAXIS:KAXIS) = (/ II, JJ-1, KK-1 /) ! Local x1,x2,x3 + INDI1 = INDXI1(XIAXIS) + INDJ1 = INDXI1(XJAXIS) + INDK1 = INDXI1(XKAXIS) + ! Vertex at index II,JJ,KK-1: + INDXI2(IAXIS:KAXIS) = (/ II, JJ, KK-1 /) ! Local x1,x2,x3 + INDI2 = INDXI2(XIAXIS) + INDJ2 = INDXI2(XJAXIS) + INDK2 = INDXI2(XKAXIS) + ! Vertex at index II,JJ,KK: + INDXI3(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI3 = INDXI3(XIAXIS) + INDJ3 = INDXI3(XJAXIS) + INDK3 = INDXI3(XKAXIS) + ! Vertex at index II,JJ-1,KK: + INDXI4(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 + INDI4 = INDXI4(XIAXIS) + INDJ4 = INDXI4(XJAXIS) + INDK4 = INDXI4(XKAXIS) + + ! First, normal direction in x1 direction. + ! For this face: XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + ! Vert 1: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI1(IAXIS)), X2FACE(INDXI1(JAXIS)), X3FACE(INDXI1(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) + ! Vert 2: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI2(IAXIS)), X2FACE(INDXI2(JAXIS)), X3FACE(INDXI2(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) + ! Vert 3: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI3(IAXIS)), X2FACE(INDXI3(JAXIS)), X3FACE(INDXI3(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) + ! Vert 4: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI4(IAXIS)), X2FACE(INDXI4(JAXIS)), X3FACE(INDXI4(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) + + CFELEM(1:5,1) = (/ 4, NOD1, NOD2, NOD3, NOD4 /) + + ! Area: + AREA(1) = (X2FACE(INDXI2(JAXIS))-X2FACE(INDXI1(JAXIS)))*(X3FACE(INDXI4(KAXIS))-X3FACE(INDXI1(KAXIS))) + + ! XYZCEN in Local Coords: + XYZCEN(IAXIS:KAXIS,1)= (/ X1FACE(II), 0.5_EB*(X2FACE(INDXI2(JAXIS))+X2FACE(INDXI1(JAXIS))), & + 0.5_EB*(X3FACE(INDXI4(KAXIS))+X3FACE(INDXI1(KAXIS))) /) - ! Running by body-triangle combination, define list of - ! segments that belong to each pair. - ICF_LOOP : DO ICF=1,NBODTRI + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(IAXIS,1) = 1._EB * X1FACE(II) * AREA(1) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(IAXIS,1) = 1._EB * X1FACE(II)**2._EB * AREA(1) - IBOD = BOD_TRI(1,ICF) - ITRI = BOD_TRI(2,ICF) + ! This is a new cut-face, allocate space: + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (INTGC_FLG==LOW_IND) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCF,X1AXIS) = NCUTFACE - SEG_FACE = CC_UNDEFINED - NSEG_FACE = 0 - DO ISEG=1,NSEG - IF ((SEG_CELL(6,ISEG) == IBOD) .AND. & - ((SEG_CELL(4,ISEG) == ITRI) .OR. (SEG_CELL(5,ISEG) == ITRI)) ) THEN - NSEG_FACE = NSEG_FACE + 1 - SEG_FACE(NOD1:NOD2+1,NSEG_FACE) = (/ SEG_CELL(NOD1:NOD2,ISEG), ISEG /) - ENDIF - ENDDO + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) - ! If only one or two seg => continue: - IF ( NSEG_FACE <= 2 ) CYCLE + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ INDI, INDJ, INDK, X1AXIS /) + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE,IBNDINT) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - ! Now build sequential list of segments: - SEG_FACE2 = CC_UNDEFINED !zeros(nseg_face,2); %[nod1 nod2] - SEG_FLAG = .TRUE. !ones(1,nseg_face); - ISEG_FACE = 1 - COUNTR = 1 - CTSTART = COUNTR - SEG_FACE2(NOD1:NOD2+1,COUNTR) = SEG_FACE(NOD1:NOD2+1,ISEG_FACE) - SEG_FLAG(ISEG_FACE) = .FALSE. - NSEG_LEFT = NSEG_FACE - 1 - CTR = 0 - CYCLE_CELL= .FALSE. - ! Infinite Loop: - INF_LOOP : DO - DO ISEG_FACE=1,NSEG_FACE + ! Connectivity: + CF%CFELEM(1:NVERTFACE,NFACE) = CFELEM(1:NVERTFACE,1) + ! Geom Properties: + CF%AREA(NFACE) = AREA(1) + CF%XYZCEN(IAXIS:KAXIS,NFACE) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,1) - IF (SEG_FLAG(ISEG_FACE)) THEN ! This seg hasn't been added to seg_face2 - ! Test for common node: - IF ( SEG_FACE2(NOD2,COUNTR) == SEG_FACE(NOD1,ISEG_FACE) ) THEN - COUNTR = COUNTR + 1 - SEG_FACE2(NOD1:NOD2+1,COUNTR) = SEG_FACE(NOD1:NOD2+1,ISEG_FACE) - SEG_FLAG(ISEG_FACE) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - EXIT - ELSEIF ( SEG_FACE2(NOD2,COUNTR) == SEG_FACE(NOD2,ISEG_FACE) ) THEN + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: + CF%INXAREA(NFACE) = INXAREA(XIAXIS,1) + ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: + CF%INXSQAREA(NFACE) = INXSQAREA(XIAXIS,1) + ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: + CF%JNYSQAREA(NFACE) = INXSQAREA(XJAXIS,1) + ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: + CF%KNZSQAREA(NFACE) = INXSQAREA(XKAXIS,1) - IF ( SEG_FACE2(NOD1,COUNTR) == SEG_FACE(NOD1,ISEG_FACE) ) & - PRINT*, "Building INBOUND faces, repeated index." - COUNTR = COUNTR + 1 - SEG_FACE2(NOD1:NOD2+1,COUNTR) = SEG_FACE( (/ NOD2, NOD1, NOD2+1 /) ,ISEG_FACE) - SEG_FLAG(ISEG_FACE) = .FALSE. - NSEG_LEFT = NSEG_LEFT - 1 - EXIT - ENDIF - ENDIF ENDDO - ! Break loop: - IF ( NSEG_LEFT == 0 ) EXIT - CTR = CTR + 1 - - ! Plot cell and cut-faces if there is no convergence: - IF ( CTR > NSEG_FACE**3 ) THEN - CYCLE_CELL = .TRUE. - MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 - NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) - IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN - ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) - DEALLOCATE(MESHES(NM)%SPCELL_LIST) - ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED - DEALLOCATE(SPCELL_LIST) - ENDIF - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) - EXIT INF_LOOP + ENDDO + ENDDO + DEALLOCATE(X1FACE,X2FACE,X3FACE) + ENDDO X1AXIS_LOOP + ENDDO IBNDINT_LOOP - IF (DEBUG_SET_CUTCELLS) THEN - WRITE(LU_ERR,*) "Error GET_CARTCELL_CUTFACES: ctr > nseg_face^3 ,",BNDINT_FLAG,I,J,K,NCUTFACE,& - CF%NFACE - WRITE(LU_ERR,*) "Cannot build boundary cut faces in cell (NM,I,J,K):",NM,I,J,K - WRITE(LU_ERR,*) "Located in position:",XCELL(I),YCELL(J),ZCELL(K) - WRITE(LU_ERR,*) "Check for Geometry surface inconsistencies at said location." - WRITE(LU_ERR,*) 'Cartesian CELL:',BNDINT_FLAG,MESHES(NM)%CCVAR(I,J,K,CC_CGSC),CC_CUTCFE,I,J,K - LU_DB_SETCC = GET_FILE_NUMBER() - OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_cutfaces.dat", STATUS='REPLACE') - ! Info pertaining to the Cartesian Cell: - WRITE(LU_DB_SETCC,*) 'I,J,K:' - WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS - WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' - WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) ! MESHES(NM)%XC(I),MESHES(NM)%DX(I) - WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) ! MESHES(NM)%YC(J),MESHES(NM)%DY(J) - WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) ! MESHES(NM)%ZC(K),MESHES(NM)%DZ(K) - WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT:' - WRITE(LU_DB_SETCC,*) NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT - WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' - DO IDUM=1,NVERT - WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) - ENDDO - WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' - DO IDUM=1,NSEG - WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(NOD1:NOD2,IDUM),SEG_CELL(3:6,IDUM) - ENDDO - WRITE(LU_DB_SETCC,*) 'SEG_FACE(NOD1:NOD2,1:NSEG_FACE):' - DO IDUM=1,NSEG_FACE - WRITE(LU_DB_SETCC,*) IDUM,SEG_FACE(NOD1:NOD2,IDUM) - ENDDO - WRITE(LU_DB_SETCC,*) 'SEG_FACE2(NOD1:NOD21:COUNTR):' - DO IDUM=1,COUNTR - WRITE(33,*) IDUM,SEG_FACE2(NOD1:NOD2,IDUM) - ENDDO - WRITE(LU_DB_SETCC,*) 'ICF,BOD_TRI:' - WRITE(LU_DB_SETCC,*) ICF,NBODTRI - DO IDUM=1,NBODTRI - WRITE(LU_DB_SETCC,*) BOD_TRI(1:2,IDUM) - ENDDO - CLOSE(LU_DB_SETCC) - CALL DEBUG_WAIT - ENDIF + IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED ) - ENDIF + ! INBOUNDARY cut-faces: + IF (INTGC_FLG==LOW_IND) THEN + ALLOCATE( IJK_COUNTED2(ISTR:IEND,JSTR:JEND,KSTR:KEND) ); IJK_COUNTED2=.FALSE. + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + ELSE + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD + ENDIF - ENDDO INF_LOOP - IF (CYCLE_CELL) EXIT ICF_LOOP + ! Loop on Cartesian cells: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI - IF ( COUNTR /= NSEG_FACE) & - PRINT*, "Building INBOUND faces: ~isequal(countr,nseg)" + IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE - ! Using triangles normal, reorder nodes as in right hand rule. - NORMTRI(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,ITRI) + IF(IJK_COUNTED2(I,J,K)) CYCLE; IJK_COUNTED2(I,J,K)=.TRUE. - ! First test if INB face is on Cartesian face and pointing - ! outside of Cartesian cell. If so drop: - ! Get min max in face for VERTS x,y,z: - XMIN(IAXIS:KAXIS)= 1._EB/TWENTY_EPSILON_EB - XMAX(IAXIS:KAXIS)=-1._EB/TWENTY_EPSILON_EB - DO ISEG_FACE=1,NSEG_FACE - XMIN(IAXIS) = MIN(XMIN(IAXIS), XYZVERT(IAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - XMIN(JAXIS) = MIN(XMIN(JAXIS), XYZVERT(JAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - XMIN(KAXIS) = MIN(XMIN(KAXIS), XYZVERT(KAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - XMAX(IAXIS) = MAX(XMAX(IAXIS), XYZVERT(IAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - XMAX(JAXIS) = MAX(XMAX(JAXIS), XYZVERT(JAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - XMAX(KAXIS) = MAX(XMAX(KAXIS), XYZVERT(KAXIS,SEG_FACE2(NOD1,ISEG_FACE))) - ENDDO - ! IAXIS: - IF ( (ABS(NORMTRI(IAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(XFACE(I-1)-XMIN(IAXIS)) < GEOMEPS) .AND. & - (ABS(XFACE(I-1)-XMAX(IAXIS)) < GEOMEPS)) CYCLE ! Low Face - IF ( (ABS(NORMTRI(IAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(XFACE(I )-XMIN(IAXIS)) < GEOMEPS) .AND. & - (ABS(XFACE(I )-XMAX(IAXIS)) < GEOMEPS)) CYCLE ! High Face - ! JAXIS: - IF ( (ABS(NORMTRI(JAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(YFACE(J-1)-XMIN(JAXIS)) < GEOMEPS) .AND. & - (ABS(YFACE(J-1)-XMAX(JAXIS)) < GEOMEPS)) CYCLE ! Low Face - IF ( (ABS(NORMTRI(JAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(YFACE(J )-XMIN(JAXIS)) < GEOMEPS) .AND. & - (ABS(YFACE(J )-XMAX(JAXIS)) < GEOMEPS)) CYCLE ! High Face - ! KAXIS: - IF ( (ABS(NORMTRI(KAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(ZFACE(K-1)-XMIN(KAXIS)) < GEOMEPS) .AND. & - (ABS(ZFACE(K-1)-XMAX(KAXIS)) < GEOMEPS)) CYCLE ! Low Face - IF ( (ABS(NORMTRI(KAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(ZFACE(K )-XMIN(KAXIS)) < GEOMEPS) .AND. & - (ABS(ZFACE(K )-XMAX(KAXIS)) < GEOMEPS)) CYCLE ! High Face + ! Face type of bounding Cartesian faces: + FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) + FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) + FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) + FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) + FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) + FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) - ! Face Vertices average location: - XCEN(IAXIS:KAXIS) = 0._EB - DO ISEG_FACE=1,NSEG_FACE - XCEN(IAXIS:KAXIS) = XCEN(IAXIS:KAXIS) + XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE)) - ENDDO - XCEN(IAXIS:KAXIS) = XCEN(IAXIS:KAXIS) / REAL(NSEG_FACE,EB) + IF ( ALL(FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) /= CC_SOLID) ) CYCLE - ISEG_FACE = 1 - VC1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE )) - XCEN(IAXIS:KAXIS) - V12(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE+1)) - & - XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE )) + NVERT = 0; NFACE = 0 + INXAREA = 0._EB + INXSQAREA = 0._EB + ! XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + X1AXIS_LOOP2 : DO X1AXIS=IAXIS,KAXIS + LOHI_DO : DO LOHI=LOW_IND,HIGH_IND + IF (FSID_XYZ(LOHI,X1AXIS) /= CC_SOLID) CYCLE + NFACE = NFACE + 1 + SELECT CASE(X1AXIS) + CASE(IAXIS) - CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) - CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) - CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) + ! Vertices: + XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K ) /) + IF(LOHI==LOW_IND)THEN + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) + ELSE + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) + ENDIF + ! Area: + AREA(NFACE) = (YFACE(J )-YFACE(J-1))*(ZFACE(K )-ZFACE(K-1)) + ! XYZCEN: + XYZCEN(IAXIS:KAXIS,NFACE) = (/ XFACE(I-2+LOHI), 0.5_EB*(YFACE(J )+YFACE(J-1)), & + 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI) * AREA(NFACE) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI)**2._EB * AREA(NFACE) - RH_ORIENTED = ( NORMTRI(IAXIS)*CROSSV(IAXIS) + & - NORMTRI(JAXIS)*CROSSV(JAXIS) + & - NORMTRI(KAXIS)*CROSSV(KAXIS) ) > 0._EB + ! Define IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I-2+LOHI,J,K,X1AXIS) + CASE(JAXIS) - NP = NSEG_FACE - NCF = CF%NFACE + 1 - NVSIZE=SIZE(CF%CFELEM,DIM=1) - IF(NP+1 > NVSIZE) THEN - ALLOCATE(CFELEM(1:NP+1+DELTA_VERT,1:NBODTRI)); CFELEM = CC_UNDEFINED - CFELEM(1:NVSIZE,1:NBODTRI) = CF%CFELEM(1:NVSIZE,1:NBODTRI) - CALL MOVE_ALLOC(FROM=CFELEM,TO=CF%CFELEM) - ALLOCATE(CFELEM(1:NP+1+DELTA_VERT,1:NBODTRI)); CFELEM = CC_UNDEFINED - CFELEM(1:NVSIZE,1:NBODTRI) = CF%CEDGES(1:NVSIZE,1:NBODTRI) - CALL MOVE_ALLOC(FROM=CFELEM,TO=CF%CEDGES) - ENDIF - CF%CFELEM(1,NCF) = NP; CF%CEDGES(1,NCF) = NP - IF (RH_ORIENTED) THEN - DO IDUM=1,NP - CF%CFELEM(IDUM+1,NCF) = SEG_FACE2(NOD1 ,IDUM) - CF%CEDGES(IDUM+1,NCF) = SEG_FACE2(NOD2+1,IDUM) ! Segment index in SEG_CELL/EDGE_LIST - ENDDO - ELSE - DO IDUM=1,NP - CF%CFELEM(IDUM+1,NCF) = SEG_FACE2(NOD1 ,NP+1-IDUM) - CF%CEDGES(IDUM+1,NCF) = SEG_FACE2(NOD2+1,NP+1-IDUM) ! Segment index in SEG_CELL/EDGE_LIST - ENDDO - IDUM = CF%CEDGES(2,NCF) - CF%CEDGES(2:NP,NCF) = CF%CEDGES(3:NP+1,NCF); CF%CEDGES(NP+1,NCF) = IDUM - ENDIF - CF%NFACE = NCF + ! Vertices: + XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K-1) /) + IF(LOHI==LOW_IND)THEN + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) + ELSE + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) + ENDIF + ! Area: + AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(ZFACE(K )-ZFACE(K-1)) + ! XYZCEN: + XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), YFACE(J-2+LOHI), & + 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI) * AREA(NFACE) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI)**2._EB * AREA(NFACE) - ! Compute Sections area and centroid: - AREA = 0._EB - ACEN(IAXIS:KAXIS) = 0._EB - INXAREA = 0._EB - SQAREA(IAXIS:KAXIS) = 0._EB - DO ISEG_FACE=1,NSEG_FACE-1 + ! Define IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I,J-2+LOHI,K,X1AXIS) + CASE(KAXIS) - IDUM = CF%CFELEM(1+ISEG_FACE,NCF) - X1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) - IDUM = CF%CFELEM(2+ISEG_FACE,NCF) - X2(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) - VC1(IAXIS:KAXIS) = X1(IAXIS:KAXIS) - XCEN(IAXIS:KAXIS) - V12(IAXIS:KAXIS) = X2(IAXIS:KAXIS) - X1(IAXIS:KAXIS) - XCENI(IAXIS:KAXIS) = (XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) / 3._EB + ! Vertices: + XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K-2+LOHI) /) + XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K-2+LOHI) /) + XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J ), ZFACE(K-2+LOHI) /) + XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K-2+LOHI) /) + IF(LOHI==LOW_IND)THEN + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) + ELSE + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) + ENDIF + ! Area: + AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(YFACE(J )-YFACE(J-1)) + ! XYZCEN: + XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), 0.5_EB*(YFACE(J )+YFACE(J-1)), & + ZFACE(K-2+LOHI) /) + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI) * AREA(NFACE) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI)**2._EB * AREA(NFACE) - CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) - CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) - CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) + ! Define IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I,J,K-2+LOHI,X1AXIS) + END SELECT - AREAI = 0.5_EB * SQRT( CROSSV(IAXIS)**2._EB + CROSSV(JAXIS)**2._EB + CROSSV(KAXIS)**2._EB ) - AREA = AREA + AREAI - ACEN(IAXIS:KAXIS) = ACEN(IAXIS:KAXIS) + AREAI * XCENI(IAXIS:KAXIS) - ! volume computation variables: - XC1(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS)) - XC2(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) - X12(IAXIS:KAXIS) = 0.5_EB*( X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) - ! dot(i,nc) int(x)dA - INXAREA = INXAREA + NORMTRI(IAXIS)*XCENI(IAXIS)*AREAI ! Single Gauss pt integration. - ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA - DO IX=IAXIS,KAXIS - INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB - SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREAI ! Midpoint rule. - ENDDO - ENDDO - ! Final seg: - IDUM = CF%CFELEM(1+NSEG_FACE,NCF) - X1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) - IDUM = CF%CFELEM(1+1 ,NCF) - X2(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) + ! With IBOD and cut-face XYZCEN defined, find closest triangle: + DIST = 1.E20_EB + ITRI(NFACE) = 1 + DO IWSEL=1,GEOMETRY(IBOD(NFACE))%N_FACES + I1 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-2) + I2 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-1) + I3 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL ) + XCEN(IAXIS:KAXIS) = 1._EB/3._EB * ( GEOMETRY(IBOD(NFACE))%VERTS(3*(I1-1)+IAXIS:3*(I1-1)+KAXIS)+ & + GEOMETRY(IBOD(NFACE))%VERTS(3*(I2-1)+IAXIS:3*(I2-1)+KAXIS)+ & + GEOMETRY(IBOD(NFACE))%VERTS(3*(I3-1)+IAXIS:3*(I3-1)+KAXIS) ) + ! Drop Triangles not on the face: + IF (ABS(XYZCEN(X1AXIS,NFACE)-XCEN(X1AXIS)) > GEOMEPS) CYCLE + DIST2 = NORM2(XYZCEN(IAXIS:KAXIS,NFACE)-XCEN(IAXIS:KAXIS)) + IF (DIST > DIST2) THEN + DIST = DIST2 + ITRI(NFACE) = IWSEL + ENDIF + ENDDO - VC1(IAXIS:KAXIS) = X1(IAXIS:KAXIS) - XCEN(IAXIS:KAXIS) - V12(IAXIS:KAXIS) = X2(IAXIS:KAXIS) - X1(IAXIS:KAXIS) - XCENI(IAXIS:KAXIS) = (XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) / 3._EB + NVERT = NVERT + 4 - CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) - CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) - CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) + ENDDO LOHI_DO + ENDDO X1AXIS_LOOP2 - AREAI = 0.5_EB * SQRT( CROSSV(IAXIS)**2._EB + CROSSV(JAXIS)**2._EB + CROSSV(KAXIS)**2._EB ) - AREA = AREA + AREAI - ACEN(IAXIS:KAXIS) = (ACEN(IAXIS:KAXIS) + AREAI * XCENI(IAXIS:KAXIS))/AREA - ! volume computation variables: - XC1(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS)) - XC2(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) - X12(IAXIS:KAXIS) = 0.5_EB*( X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) - ! dot(i,nc) int(x)dA - INXAREA = INXAREA + NORMTRI(IAXIS)*XCENI(IAXIS)*AREAI ! Single Gauss pt integration. - ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA - DO IX=IAXIS,KAXIS - INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB - SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREAI ! Midpoint rule. - ENDDO - CF%AREA(NCF) = AREA - CF%XYZCEN(IAXIS:KAXIS,NCF) = ACEN(IAXIS:KAXIS) - ! Fields for cut-cell volume/centroid computation: - CF%INXAREA(NCF) = INXAREA ! dot(i,nc)*int(x)dA - CF%INXSQAREA(NCF) = SQAREA(IAXIS) ! dot(i,nc)*int(x^2)dA - CF%JNYSQAREA(NCF) = SQAREA(JAXIS) ! dot(j,nc)*int(y^2)dA - CF%KNZSQAREA(NCF) = SQAREA(KAXIS) ! dot(k,nc)*int(z^2)dA - ! Define Body-triangle reference: - CF%BODTRI(1:2,NCF)= (/ IBOD, ITRI /) - ! Assign surf-index: Depending on GEOMETRY: - CF%SURF_INDEX(NCF) = GEOMETRY(IBOD)%SURFS(ITRI) - ENDDO ICF_LOOP + ! This is a cut-face, allocate space: + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (INTGC_FLG==LOW_IND) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF + MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE - ! IF((NM==3 .AND. I==4 .AND. J==6 .AND. K==36)) THEN - ! LU_DB_SETCC = GET_FILE_NUMBER() - ! WRITE(LU_ERR,*) 'Writing Cartcell_cutfaces.dat... 11111' - ! OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_cutfaces.dat", STATUS='REPLACE') - ! ! Info pertaining to the Cartesian Cell: - ! WRITE(LU_DB_SETCC,*) 'I,J,K:',CF%NFACE - ! WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS - ! WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' - ! WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) ! MESHES(NM)%XC(I),MESHES(NM)%DX(I) - ! WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) ! MESHES(NM)%YC(J),MESHES(NM)%DY(J) - ! WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) ! MESHES(NM)%ZC(K),MESHES(NM)%DZ(K) - ! WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT:' - ! WRITE(LU_DB_SETCC,*) NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT,CF%NFACE - ! WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' - ! DO IDUM=1,NVERT - ! WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) - ! ENDDO - ! WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' - ! DO IDUM=1,NSEG - ! WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(NOD1:NOD2,IDUM),SEG_CELL(3:6,IDUM) - ! ENDDO - ! WRITE(LU_DB_SETCC,*) 'ICF,BOD_TRI:' - ! WRITE(LU_DB_SETCC,*) ICF,NBODTRI - ! DO IDUM=1,NBODTRI - ! WRITE(LU_DB_SETCC,*) BOD_TRI(1:2,IDUM) - ! ENDDO - ! WRITE(LU_DB_SETCC,*) 'CFELEM:' - ! DO IDUM=1,CF%NFACE - ! WRITE(LU_DB_SETCC,*) IDUM,CF%CFELEM(1:CF%CFELEM(1,IDUM)+1,IDUM) - ! ENDDO - ! CLOSE(LU_DB_SETCC) - ! ENDIF + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) - ! IF(.NOT.CYCLE_CELL) THEN - ! DO ICF = 1, CF%NFACE - ! DO ISEG=1,CF%CEDGES(1,ICF) - ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) - ! IF (ISEGGEOMEPS) THEN - ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT - ! ENDIF - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN - ! WRITE(LU_ERR,*) 'CARTC Found difference in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC,CYCLE_CELL - ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) - ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) - ! ENDIF - ! END SELECT - ! ENDDO - ! ENDDO - ! ENDIF - ! WRITE(LU_ERR,*) 'CORRECT CELL I,J,K CUT_FACES',I,J,K,CF%NFACE,NSEG,RH_ORIENTED - ! DO ICF = 1, CF%NFACE - ! WRITE(LU_ERR,*) CF%CEDGES(1:CF%CEDGES(1,ICF)+1,ICF),':',CF%CFELEM(2:CF%CFELEM(1,ICF)+1,ICF) - ! ITRI = CF%EDGE_LIST(2,CF%CEDGES(2,ICF)); IBOD = CF%EDGE_LIST(3,CF%CEDGES(2,ICF)) - ! WRITE(LU_ERR,*) 'E1 N1=',MESHES(NM)%CUT_EDGE(ITRI)%XYZVERT(:,MESHES(NM)%CUT_EDGE(ITRI)%CEELEM(1,IBOD)),& - ! CF%XYZVERT(:,CF%CFELEM(2,ICF)) - ! ITRI = CF%EDGE_LIST(2,CF%CEDGES(2,ICF)); IBOD = CF%EDGE_LIST(3,CF%CEDGES(2,ICF)) - ! WRITE(LU_ERR,*) 'E1 N2=',MESHES(NM)%CUT_EDGE(ITRI)%XYZVERT(:,MESHES(NM)%CUT_EDGE(ITRI)%CEELEM(2,IBOD)),& - ! CF%XYZVERT(:,CF%CFELEM(3,ICF)) - ! ENDDO - ! DO ICF = 1, NSEG - ! WRITE(LU_ERR,*) ICF,CF%EDGE_LIST(1:3,ICF) - ! ENDDO + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, 0 /) ! No axis = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_INBOUNDARY + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) + CF%CFELEM(1:5,1:NFACE) = CFELEM(1:5,1:NFACE) - ! Here if CFACES could not be built, flag the cell as SPECIAL & reduce NCUTFACE by one: - IF (CYCLE_CELL) THEN - CELLRT(I,J,K) =.TRUE. - IJK_COUNTED(I,J,K)=.FALSE. - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED; - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = 0 ! No axis = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_UNDEFINED - CALL FACE_DEALLOC(NM,NCUTFACE) - ! This is a cut-face, allocate space: - NCUTFACE = NCUTFACE-1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH - 1 - ENDIF - ! Now cleanup CUT_EDGES that live on this cell: This space will be used later when trying to linearize the - ! surface. - CEI=MESHES(NM)%CCVAR(I,J,K,CC_IDCE); - IF ( CEI > 0 ) THEN - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - MESHES(NM)%CUT_EDGE(CEI)%INDSEG = 0 - ENDIF - ENDIF + CF%AREA(1:NFACE) = AREA(1:NFACE) + CF%XYZCEN(IAXIS:KAXIS,1:NFACE) = XYZCEN(IAXIS:KAXIS,1:NFACE) - ENDDO ! I - ENDDO ! J -ENDDO ! K + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA: + CF%INXAREA(1:NFACE) = INXAREA(IAXIS,1:NFACE) + ! dot(i,nc)*int(x^2)dA: + CF%INXSQAREA(1:NFACE) = INXSQAREA(IAXIS,NFACE) + ! dot(j,nc)*int(y^2)dA: + CF%JNYSQAREA(1:NFACE) = INXSQAREA(JAXIS,NFACE) + ! dot(k,nc)*int(z^2)dA: + CF%KNZSQAREA(1:NFACE) = INXSQAREA(KAXIS,NFACE) -! Now process special cells of type CELLRT=T: -! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: -DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI + ! Define Body-triangle reference: + CF%BODTRI(1,1:NFACE)= IBOD(1:NFACE) + CF%BODTRI(2,1:NFACE)= ITRI(1:NFACE) - IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE + ! Assign surf-index: Depending on GEOMETRY: + DO IFACE=1,NFACE + CF%SURF_INDEX(IFACE) = GEOMETRY(IBOD(IFACE))%SURFS(ITRI(IFACE)) + ENDDO - IF (.NOT.CELLRT(I,J,K)) CYCLE ! Special cell with bod-bod or self intersection. + ENDDO + ENDDO + ENDDO - IF (IJK_COUNTED(I,J,K)) CYCLE; IJK_COUNTED(I,J,K)=.TRUE. + IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED2 ) - ! Start cut-cell INB cut-faces computation: - ! Loop local arrays to cell: - NSEG = 0 - SEG_CELL = CC_UNDEFINED +ENDDO INTGC_FLG_LOOP - NVERT = 0 - NFACE = 0 - XYZVERT = 0._EB - ! CUT_EDGE index of bounding Cartesian faces: - CEIB_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCE,IAXIS) - CEIB_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCE,IAXIS) - CEIB_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCE,JAXIS) - CEIB_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCE,JAXIS) - CEIB_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCE,KAXIS) - CEIB_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCE,KAXIS) +! Finally Build cut-cells: +NCFACE_CUTCELL = 7; NFACE_CELL = 6; NCELL = 1 +INTGC_FLG_LOOP2 : DO INTGC_FLG=LOW_IND,HIGH_IND ! 1 refers to blocks internal cells, 2 refers to block guard cells. - ! Cartesian Faces INBOUNDARY segments: - DO FAXIS=IAXIS,KAXIS - DO ILH=LOW_IND,HIGH_IND - ! By segment: Add Vertices/Segments to local arrays: - CEI = CEIB_XYZ(ILH,FAXIS) - IF ( CEI > 0 ) THEN ! There are inboundary cut-edges - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 - DO IEDGE=1,NEDGE + SELECT CASE(INTGC_FLG) + CASE(LOW_IND) + ALLOCATE(IJK_COUNT(ILO_CELL-NGUARD:IHI_CELL+NGUARD,JLO_CELL-NGUARD:JHI_CELL+NGUARD, & + KLO_CELL-NGUARD:KHI_CELL+NGUARD)) + IJK_COUNT = .FALSE. + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + CASE(HIGH_IND) + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD + END SELECT - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - STRI(1:CC_MAX_WSTRIANG_SEG+2) = & - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) + ! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI - ! x,y,z of node 1: - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD1,XYZVERT) - ! x,y,z of node 2: - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD2,XYZVERT) + IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE - VEC(NOD1:NOD2) = (HIGH_IND-ILH)*(/ INOD1, INOD2 /) + (ILH-LOW_IND)*(/ INOD2, INOD1 /) - VEC(NOD2+1:NOD2+CC_MAX_WSTRIANG_SEG+2) = STRI(1:CC_MAX_WSTRIANG_SEG+2) - VEC(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7) = (/ CC_ETYPE_CFINB, CEI, IEDGE /) - ! Insertion ADD segment: - INLIST = .FALSE. - DO IDUM = 1,NSEG - DO IEQ1=1,3 - EQUAL1 = SEG_CELL(INDVERTBOD(IEQ1),IDUM) == VEC(INDVERTBOD(IEQ1)) - IF (.NOT.EQUAL1) EXIT - ENDDO - DO IEQ2=1,3 - EQUAL2 = SEG_CELL(INDVERTBOD(IEQ2),IDUM) == VEC(INDVERTBOD2(IEQ2)) - IF (.NOT.EQUAL2) EXIT - ENDDO - IF ( EQUAL1 .OR. EQUAL2 ) THEN - IF ( SEG_CELL(3,IDUM) > VEC(3) ) THEN - ! DO NOTHING: - ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN - SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 - SEG_CELL(5,IDUM) = VEC(4) - ENDIF - INLIST = .TRUE. - EXIT - ENDIF + IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. + + ! Start with Cartesian Faces: + ! Face type of bounding Cartesian faces: + FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) + FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) + FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) + FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) + FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) + FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) + + ! Cut-face number of bounding Cartesian faces: + IDCF_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCF,IAXIS) + IDCF_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCF,IAXIS) + IDCF_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCF,JAXIS) + IDCF_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCF,JAXIS) + IDCF_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCF,KAXIS) + IDCF_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCF,KAXIS) + + NFACE_CELL = 0 + + X1AXIS_LOOP3 : DO X1AXIS=IAXIS,KAXIS + CEI_AXIS(LOW_IND:HIGH_IND) = IDCF_XYZ(LOW_IND:HIGH_IND,X1AXIS) + DO SIDE=LOW_IND,HIGH_IND + ! Low High face: + IF ( FSID_XYZ(SIDE,X1AXIS) == CC_GASPHASE ) THEN + ! Regular Face, build 4 vertices + face: + NFACE_CELL = NFACE_CELL + 1 + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED/) + ! CC_FTYPE_RCGAS=0, regular face. + ELSEIF (FSID_XYZ(SIDE,X1AXIS) == CC_CUTCFE ) THEN + ! GasPhase CUT_FACE, add all cut-faces on these Cartesian cell + nodes + CEI = CEI_AXIS(SIDE) + DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE + NFACE_CELL = NFACE_CELL + 1 + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL)=(/ CC_FTYPE_CFGAS,SIDE,X1AXIS,CEI,ICF,CC_UNDEFINED/) + ! CC_FTYPE_CFGAS=1 ENDDO - IF (.NOT.INLIST) THEN - NSEG = NSEG + 1 - CALL REALLOCATE_SEG_CELL - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) - SEG_POS(NSEG) = (2*ILH-3)*FAXIS - ENDIF - ENDDO - ENDIF - ENDDO - ENDDO + ENDIF + ENDDO + ENDDO X1AXIS_LOOP3 + + ! Now add INBOUNDARY faces of the cell: + CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) + IF ( CEI > 0 ) THEN + DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE + NFACE_CELL = NFACE_CELL + 1 + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB, 0, 0, CEI, ICF, CC_UNDEFINED /) + ! CC_FTYPE_CFINB in Cart-cell. + ENDDO + ENDIF + + VOL(1) = DXCELL(I)*DYCELL(J)*DZCELL(K) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZCELL(K) /) + + ! Load into CUT_CELL data structure + NCUTCELL = MESHES(NM)%N_CUTCELL_MESH + MESHES(NM)%N_GCCUTCELL_MESH + 1 + IF (INTGC_FLG==LOW_IND) THEN + MESHES(NM)%N_CUTCELL_MESH = NCUTCELL + ELSE + MESHES(NM)%N_GCCUTCELL_MESH = MESHES(NM)%N_GCCUTCELL_MESH + 1 + ENDIF + MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = NCUTCELL + + ! Resize array MESHES(NM)%CUT_CELL if necessary: + CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) + + ! Add cut-cell NCUTCELL entry: + MESHES(NM)%CUT_CELL(NCUTCELL)%IJK(IAXIS:KAXIS) = (/ I, J, K /) + MESHES(NM)%CUT_CELL(NCUTCELL)%NCELL = NCELL + MESHES(NM)%CUT_CELL(NCUTCELL)%NFACE_CELL= NFACE_CELL + CALL NEW_CELL_ALLOC(NM,NCUTCELL,NCELL,NFACE_CELL,NCFACE_CUTCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%CCELEM(1:NCFACE_CUTCELL,1) = (/ 6, 1, 2, 3, 4, 5, 6 /) + MESHES(NM)%CUT_CELL(NCUTCELL)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) = & + FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%VOLUME(1:NCELL) = VOL(1:NCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%XYZCEN(IAXIS:KAXIS,1:NCELL) = XYZCEN(IAXIS:KAXIS,1:NCELL) - ! Drop segments that are unconnected: - ALLOCATE(VERT_SEGS(1:NVERT)); VERT_SEGS(1:NVERT)=0 - DO IDUM = 1,NSEG - VERT_SEGS(SEG_CELL(NOD1,IDUM)) = VERT_SEGS(SEG_CELL(NOD1,IDUM)) + 1 - VERT_SEGS(SEG_CELL(NOD2,IDUM)) = VERT_SEGS(SEG_CELL(NOD2,IDUM)) + 1 - ENDDO - ALLOCATE(SEG_CELL_AUX(SIZE(SEG_CELL,DIM=1),SIZE(SEG_CELL,DIM=2))) - SEG_CELL_AUX = SEG_CELL - COUNT = 0 - DO IDUM = 1,NSEG - IF ( SEG_CELL_AUX(NOD1,IDUM)==SEG_CELL_AUX(NOD2,IDUM) ) CYCLE - IF ( (VERT_SEGS(SEG_CELL_AUX(NOD1,IDUM))>1) .AND. (VERT_SEGS(SEG_CELL_AUX(NOD2,IDUM))>1) ) THEN - COUNT = COUNT + 1 - SEG_CELL(:,COUNT) = SEG_CELL_AUX(:,IDUM) - CYCLE - ENDIF ENDDO - NSEG = COUNT - DEALLOCATE(SEG_CELL_AUX,VERT_SEGS) + ENDDO + ENDDO + + IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNT ) + +ENDDO INTGC_FLG_LOOP2 + + +DEALLOCATE(GEOMFACE,GEOMCELL) + +#endif +END SUBROUTINE GET_REGULAR_CUTCELLS_BOX - IF (NSEG < 3 ) CYCLE - ! IF(NM==1 .AND. I==37 .AND. J==6 .AND. K==32) THEN - ! LU_DB_SETCC = GET_FILE_NUMBER() - ! WRITE(LU_ERR,*) 'Writing Cartcell_SEGCELL.dat...' - ! OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_SEGCELL.dat", STATUS='REPLACE') - ! ! Info pertaining to the Cartesian Cell: - ! WRITE(LU_DB_SETCC,*) 'I,J,K:',CF%NFACE - ! WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS - ! WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' - ! WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) - ! WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) - ! WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) - ! WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,SIZE_CEELEM_SEG_CELL,CC_MAX_WSTRIANG_SEG:' - ! WRITE(LU_DB_SETCC,*) NVERT,NSEG,SIZE_CEELEM_SEG_CELL,CC_MAX_WSTRIANG_SEG - ! WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' - ! DO IDUM=1,NVERT - ! WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) - ! ENDDO - ! WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' - ! DO IDUM=1,NSEG - ! WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM),SEG_POS(IDUM) - ! ENDDO - ! CLOSE(LU_DB_SETCC) - ! ENDIF +! --------------------- DEALLOCATE_CUTCELLS_CONN_MESH -------------------------- +SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH(NM) - ! Ear clipping algorithm by TRIANGLE and BODY: - ! 1. Define closed 3D polyline: - CALL GET_CLOSED_POLYLINES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,SEG_POS,IFLG,NPOLY,ILO_POLY,NSG_POLY) +INTEGER, INTENT(IN) :: NM - IF (IFLG) THEN - IF(DEBUG_SET_CUTCELLS .AND. MY_RANK==PROCESS(NM)) WRITE(LU_ERR,*) 'IFLG ~=0, could not close polyline, ',& - BNDINT_FLAG,': ',NM,I,J,K,' NPOLY=',NPOLY,IFLG,'NSEG=',NSEG - MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 - NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) - IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN - ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) - DEALLOCATE(MESHES(NM)%SPCELL_LIST) - ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED - DEALLOCATE(SPCELL_LIST) - ENDIF - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) - ! Add to cells to block list: - N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK + 1 - COUNT = SIZE(SPCELLS_TO_BLOCK,DIM=1) - IF( COUNTLOIN .AND. KMESHES(NM)%KBAR+LOIN .AND. KLOIN .AND. JMESHES(NM)%JBAR+LOIN .AND. JLOIN .AND. IMESHES(NM)%IBAR+LOIN .AND. I0) CALL CELL_DEALLOC(NM,ICC) ! Deallocate this CUT_CELL array container: + ! IAXIS cut-face: + ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,IAXIS) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) + ! JAXIS cut-face: + ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,JAXIS) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) + ! KAXIS cut-face: + ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,KAXIS) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) + ENDDO + ENDDO +ENDDO +! INBOUNDARY cut-faces: +DO K=-CCGUARD,MESHES(NM)%KBAR+CCGUARD + DO J=-CCGUARD,MESHES(NM)%JBAR+CCGUARD + DO I=-CCGUARD,MESHES(NM)%IBAR+CCGUARD + ICF = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF,DO_BNCF) ! Deallocate this CUT_FACE array fields, except NFACE, XYZCEN. + ENDDO + ENDDO +ENDDO +IF(ALLOCATED(MESHES(NM)%VERTVAR)) DEALLOCATE(MESHES(NM)%VERTVAR) +IF(ALLOCATED(MESHES(NM)%ECVAR)) DEALLOCATE(MESHES(NM)%ECVAR) +RETURN +END SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH - ! This is a cut-face, allocate space: - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (BNDINT_FLAG) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, 0 /) ! No axis = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_INBOUNDARY - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NOD3+1) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - ALLOCATE(CF%EDGE_LIST(3,CT_EDGES),CF%CEDGES(NOD3+1,NFACE)); CF%CEDGES = CC_UNDEFINED - CF%EDGE_LIST(1:3,1:CT_EDGES) = SEG_CELL_AUX(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7,1:CT_EDGES) +! ---------------------- GET_EXT_INB_CUTFACES_TO_CFACE -------------------------------- - ! Assign surf-index: Depending on GEOMETRY: - NCF = 0 - DO ICF=1,NFACE - IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) +SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE - ! Area properties for special cfaces: - ! Computed from the cross product: - D23 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - D12 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) - CALL CROSS_PRODUCT(NORMTRI,D12,D23) - ! Test RH rule for CFACE normal outside of body (into gas phase): - RH_ORIENTED = ( GEOMETRY(IBOD)%FACES_NORMAL(IAXIS,ITRI)*NORMTRI(IAXIS) + & - GEOMETRY(IBOD)%FACES_NORMAL(JAXIS,ITRI)*NORMTRI(JAXIS) + & - GEOMETRY(IBOD)%FACES_NORMAL(KAXIS,ITRI)*NORMTRI(KAXIS) ) > -TWENTY_EPSILON_EB - IF(.NOT.RH_ORIENTED) THEN ! Swap normal for triangle: - IDUM = CFELEM(1+NOD2,ICF); CFELEM(1+NOD2,ICF) = CFELEM(1+NOD1,ICF); CFELEM(1+NOD1,ICF) = IDUM - D23 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - D12 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) - CALL CROSS_PRODUCT(NORMTRI,D12,D23) - ENDIF - NNORM = NORM2(NORMTRI) - IF (NNORM < 2._EB*GEOMEPS**2._EB) CYCLE - NORMTRI(IAXIS:KAXIS) = NORMTRI(IAXIS:KAXIS) / NNORM +! Local Variables: +INTEGER :: ICF, CFACE_INDEX_LOCAL, SURF_INDEX +INTEGER :: IVENT +REAL(EB):: ADDMAT(IAXIS:KAXIS,LOW_IND:HIGH_IND) - ! First test if INB face is on Cartesian face and pointing - ! outside of Cartesian cell. If so drop: - ! Face Vertices average location: - ACEN(IAXIS:KAXIS) = 1._EB/3._EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + & - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) - ! IAXIS: - IF ( (ABS(NORMTRI(IAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(XFACE(I-1)-ACEN(IAXIS)) < GEOMEPS) ) CYCLE ! Low Face - IF ( (ABS(NORMTRI(IAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(XFACE(I )-ACEN(IAXIS)) < GEOMEPS) ) CYCLE ! High Face - ! JAXIS: - IF ( (ABS(NORMTRI(JAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(YFACE(J-1)-ACEN(JAXIS)) < GEOMEPS) ) CYCLE ! Low Face - IF ( (ABS(NORMTRI(JAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(YFACE(J )-ACEN(JAXIS)) < GEOMEPS) ) CYCLE ! High Face - ! KAXIS: - IF ( (ABS(NORMTRI(KAXIS)+1._EB) < GEOMEPS) .AND. & - (ABS(ZFACE(K-1)-ACEN(KAXIS)) < GEOMEPS) ) CYCLE ! Low Face - IF ( (ABS(NORMTRI(KAXIS)-1._EB) < GEOMEPS) .AND. & - (ABS(ZFACE(K )-ACEN(KAXIS)) < GEOMEPS) ) CYCLE ! High Face +! GET_CUTCELLS_VERBOSE variables: +INTEGER, ALLOCATABLE, DIMENSION(:) :: NCFACE_BY_MESH - ! Area: - AREA = 0.5_EB*NNORM +TYPE(VENTS_TYPE), POINTER :: VT +TYPE(CFACE_TYPE), POINTER :: CFA + +IF(GET_CUTCELLS_VERBOSE) CALL CPU_TIME(CPUTIME_START) + +ALLOCATE(NCFACE_BY_MESH(1:NMESHES)); NCFACE_BY_MESH(1:NMESHES) = 0 +MESH_LOOP_0 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + ! First N_EXTERNAL_CFACE_CELLS: + DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE + CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE + CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE + END SELECT + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE + ENDDO + ! Second N_INTWALL_CFACE_CELLS: + DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS)==0) CYCLE + ENDIF + CASE(JAXIS) + IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS)==0) CYCLE + ENDIF + CASE(KAXIS) + IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS)==0) CYCLE + ENDIF + END SELECT + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE + ENDDO + ! Second N_INTERNAL_CFACE_CELLS: + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE + ! Don't count INB cut-faces inside an OBST: + IF (CELL(CELL_INDEX(CF%IJK(IAXIS),CF%IJK(JAXIS),CF%IJK(KAXIS)))%SOLID) CYCLE + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE + ENDDO +ENDDO MESH_LOOP_0 + +IF(GET_CUTCELLS_VERBOSE) THEN + CALL MPI_ALLREDUCE(MPI_IN_PLACE,NCFACE_BY_MESH(1),NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + WRITE(LU_SETCC,'(A,I10)',advance='no') ' 4. Generating CFACES from cut-faces, total CFACE_CELLS=', & + SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,I10)') ' Total number of CFACES in all processes=', & + SUM(NCFACE_BY_MESH(1:NMESHES)) + WRITE(LU_ERR ,'(A,I10)',advance='no') & + ' 4. Process 0 Generating CFACES from cut-faces, total CFACE_CELLS=', & + SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) + ENDIF +ENDIF + +! First mesh Loop, Allocate storage for CFACES, CFACE geometric info: +MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + + ! ALLOCATE to zero size + IF(ALLOCATED(MESHES(NM)%CFACE)) DEALLOCATE(MESHES(NM)%CFACE) + MESHES(NM)%N_CFACE_CELLS_DIM = NCFACE_BY_MESH(NM) + ALLOCATE(MESHES(NM)%CFACE(0:MESHES(NM)%N_CFACE_CELLS_DIM)) + + ALLOCATE(MESHES(NM)%FACE_WORK1(MESHES(NM)%N_CFACE_CELLS_DIM)) + ALLOCATE(MESHES(NM)%FACE_WORK2(MESHES(NM)%N_CFACE_CELLS_DIM)) + ALLOCATE(MESHES(NM)%FACE_WORK3(MESHES(NM)%N_CFACE_CELLS_DIM)) - ! dot(i,nc) int(x)dA - INXAREA = NORMTRI(IAXIS)*ACEN(IAXIS)*AREA ! Single Gauss pt integration. + ! Define pointers among External CC_GASPHASE CUT_FACE and CFACE (N_EXTERNAL_CFACE_CELLS): + CFACE_INDEX_LOCAL = 0 + DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE + CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE + CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE + END SELECT + ! Now get WALL cell SURF_INDEX: + IW = 0 + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF (I==0 ) IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-1) + IF (I==IBAR) IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( 1) + CASE(JAXIS) + IF (J==0 ) IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-2) + IF (J==JBAR) IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( 2) + CASE(KAXIS) + IF (K==0 ) IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-3) + IF (K==KBAR) IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( 3) + END SELECT + SURF_INDEX = WALL(IW)%SURF_INDEX + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) + ENDDO + ENDDO + MESHES(NM)%N_EXTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL + ! Define pointers among internal CC_GASPHASE CUT_FACE and CFACE (N_INTWALL_CFACE_CELLS): + DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST, or don't lay on a WALL_CELL: + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + ENDIF + CASE(JAXIS) + IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + ENDIF + CASE(KAXIS) + IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + ENDIF + END SELECT + SURF_INDEX = WALL(IW)%SURF_INDEX + IF(.NOT.ALLOCATED(CF%CFACE_INDEX)) THEN; ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) + ELSEIF (SIZE(CF%CFACE_INDEX,DIM=1)/=CF%NFACE)THEN + DEALLOCATE(CF%CFACE_INDEX); ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) + ENDIF + IF(.NOT.ALLOCATED(CF%SURF_INDEX)) THEN; ALLOCATE(CF%SURF_INDEX(CF%NFACE)) + ELSEIF (SIZE(CF%SURF_INDEX,DIM=1)/=CF%NFACE)THEN + DEALLOCATE(CF%SURF_INDEX); ALLOCATE(CF%SURF_INDEX(CF%NFACE)) + ENDIF - XC1(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + & - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) ! X23 - XC2(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) - X12(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF))) - ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA - SQAREA(IAXIS:KAXIS) = 0._EB - DO IX=IAXIS,KAXIS - INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB - SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREA ! Midpoint rule. - ENDDO + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) + ENDDO + ENDDO + MESHES(NM)%N_INTWALL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%INTERNAL_CFACE_CELLS_LB = MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%N_INTWALL_CFACE_CELLS + ! Define pointers among CC_INBOUNDARY CUT_FACE and CFACE (N_INTERNAL_CFACE_CELLS): + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + CF => MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS) + ! Don't count INB cut-faces inside an OBST: + IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + SURF_INDEX = CF%SURF_INDEX(IFACE) + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.TRUE.) + ENDDO + IF(ALLOCATED(CF%CFACE_ORIGIN)) DEALLOCATE(CF%CFACE_ORIGIN) + ENDDO + MESHES(NM)%N_INTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%INTERNAL_CFACE_CELLS_LB +ENDDO MESH_LOOP_1 - NCF = NCF + 1 - CF%AREA(NCF) = AREA - CF%XYZCEN(IAXIS:KAXIS,NCF) = ACEN(IAXIS:KAXIS) +! Second loop, apply VENTS to change SURF_ID associated with CFACEs: +MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA: - CF%INXAREA(NCF) = INXAREA - ! dot(i,nc)*int(x^2)dA: - CF%INXSQAREA(NCF) = SQAREA(IAXIS) - ! dot(j,nc)*int(y^2)dA: - CF%JNYSQAREA(NCF) = SQAREA(JAXIS) - ! dot(k,nc)*int(z^2)dA: - CF%KNZSQAREA(NCF) = SQAREA(KAXIS) + ! ! Currently : Modify CFACE SURF_INDEX with VENT information: This needs more development. - ! Define Body-triangle reference: - CF%BODTRI(1:2,NCF)= (/ IBOD, ITRI /) + VENT_LOOP : DO IVENT=1,MESHES(NM)%N_VENT + VT => VENTS(IVENT) + IF(.NOT.VT%GEOM) CYCLE VENT_LOOP ! Do not apply vent to Geometries. - CF%SURF_INDEX(NCF) = GEOMETRY(IBOD)%SURFS(ITRI) + ! This test is a simplified test for VENTS changing the CFACE SURF_ID to VENT SURF_ID for all CFACEs whose + ! centroid locations lay within the frame of the IOR grid aligned VENT: + ADDMAT = 0._EB; + SELECT CASE(ABS(VT%IOR)) + CASE(IAXIS) + ADDMAT(IAXIS,LOW_IND) = -(XF_MAX-XS_MIN) ! -DX(VT%I1) Set normal size to 2 times domain size. + ADDMAT(IAXIS,HIGH_IND) = (XF_MAX-XS_MIN) ! DX(VT%I2) XF_MAX, etc. defined in cons.f90. + CASE(JAXIS) + ADDMAT(JAXIS,LOW_IND) = -(YF_MAX-YS_MIN) ! -DY(VT%J1) + ADDMAT(JAXIS,HIGH_IND) = (YF_MAX-YS_MIN) ! DY(VT%J2) + CASE(KAXIS) + ADDMAT(KAXIS,LOW_IND) = -(ZF_MAX-ZS_MIN) ! -DZ(VT%K1) + ADDMAT(KAXIS,HIGH_IND) = (ZF_MAX-ZS_MIN) ! DZ(VT%K2) + END SELECT + ! CFACE Loop to modify SURF_INDEX in INTERNAL_CFACE_CELLS: + CFACE_LOOP_2 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + CFA => CFACE(CFACE_INDEX_LOCAL) + BC => BOUNDARY_COORD(CFA%BC_INDEX) + IF (BC%X < X(VT%I1)+ADDMAT(IAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%X > X(VT%I2)+ADDMAT(IAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + IF (BC%Y < Y(VT%J1)+ADDMAT(JAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%Y > Y(VT%J2)+ADDMAT(JAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + IF (BC%Z < Z(VT%K1)+ADDMAT(KAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%Z > Z(VT%K2)+ADDMAT(KAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + CFA%VENT_INDEX = IVENT + CFA%SURF_INDEX = VT%SURF_INDEX + ENDDO CFACE_LOOP_2 + ENDDO VENT_LOOP +ENDDO MESH_LOOP_2 +! - At this pont all final values of SURF_INDEX have been given to CFACEs. - ! All faces connectivities: - CF%CFELEM(1:1+NOD3,NCF) = CFELEM(1:1+NOD3,ICF) - CF%CEDGES(1:1+NOD3,NCF) = CEDGES(1:1+NOD3,ICF) +! Third loop, 1. Compute final FDS area integrals by SURF_ID and GEOM. +! 2. Compute input areas by SURF_ID and GEOM. First sum over GEOM FACES SURF_IDs, +! then VENTS input surfaces are assigned to corresponding GEOMs and SURF_IDs if present (VENTs take precedence). +IF(N_GEOMETRY>0) THEN + ALLOCATE(FDS_AREA_GEOM(0:N_SURF,N_GEOMETRY)); FDS_AREA_GEOM = 0._EB +ENDIF +MESH_LOOP_3 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + CFA => CFACE(CFACE_INDEX_LOCAL) + ICF = CFA%CUT_FACE_IND1; IFACE= CFA%CUT_FACE_IND2 + I = CUT_FACE(ICF)%BODTRI(1,IFACE) + IF(I>0) FDS_AREA_GEOM(CFA%SURF_INDEX,I) = FDS_AREA_GEOM(CFA%SURF_INDEX,I) + CFA%AREA + ENDDO +ENDDO MESH_LOOP_3 +! Sum FDS and INPUT areas per SURF_ID and GEOM (all reduce sum): +IF(N_GEOMETRY>0) & +CALL MPI_ALLREDUCE(MPI_IN_PLACE, FDS_AREA_GEOM(0,1), (N_SURF+1)*N_GEOMETRY, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) - ENDDO - DEALLOCATE(CFELEM,SEG_CELL_AUX,CEDGES) - CF%NFACE = NCF +! Fourth Loop: Assign AREA_ADJUST for CFACEs, and assign BC info to CFACEs: +MESH_LOOP_4 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) - ! IF((NM==1 .AND. I==37 .AND. J==6 .AND. K==32)) THEN - ! LU_DB_SETCC = GET_FILE_NUMBER() - ! WRITE(LU_ERR,*) 'Writing Cartcell_cutfaces.dat...' - ! OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_cutfaces.dat", STATUS='REPLACE') - ! ! Info pertaining to the Cartesian Cell: - ! WRITE(LU_DB_SETCC,*) 'I,J,K:',CF%NFACE - ! WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS - ! WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' - ! WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) ! MESHES(NM)%XC(I),MESHES(NM)%DX(I) - ! WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) ! MESHES(NM)%YC(J),MESHES(NM)%DY(J) - ! WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) ! MESHES(NM)%ZC(K),MESHES(NM)%DZ(K) - ! WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT:' - ! WRITE(LU_DB_SETCC,*) NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT,CF%NFACE - ! WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' - ! DO IDUM=1,NVERT - ! WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) - ! ENDDO - ! WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG),SEG_POS(NSEG):' - ! DO IDUM=1,NSEG - ! WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(NOD1:NOD2,IDUM),SEG_CELL(3:6,IDUM),SEG_POS(IDUM) - ! ENDDO - ! WRITE(LU_DB_SETCC,*) 'ICF,BOD_TRI:' - ! WRITE(LU_DB_SETCC,*) ICF,NBODTRI - ! DO IDUM=1,NBODTRI - ! WRITE(LU_DB_SETCC,*) BOD_TRI(1:2,IDUM) - ! ENDDO - ! WRITE(LU_DB_SETCC,*) 'CFELEM:' - ! DO IDUM=1,CF%NFACE - ! WRITE(LU_DB_SETCC,*) IDUM,CF%CFELEM(1:CF%CFELEM(1,IDUM)+1,IDUM) - ! ENDDO - ! CLOSE(LU_DB_SETCC) - ! ENDIF + ! BCs related information for INTERNAL CFACE CELLS: + CFACE_LOOP_4 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + ICF = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND1 + IFACE = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND2 + SURF_INDEX = CFACE(CFACE_INDEX_LOCAL)%SURF_INDEX + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_TWO,IS_INB=.TRUE.) + ENDDO CFACE_LOOP_4 - ! Now add cut-edges product of linearization to CUT_EDGE: - DO ICF = 1, CF%NFACE - IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) - DO ISEG=1,CF%CEDGES(1,ICF) - X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) - IF (ISEG 0 ) THEN - CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCE) - ELSE ! We need a new entry in CUT_EDGE - CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 - MESHES(NM)%N_CUTEDGE_MESH = CEI - MESHES(NM)%CCVAR(I,J,K,CC_IDCE) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ I, J, K, 0, CC_GS /) - MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCC - ENDIF +ENDDO MESH_LOOP_4 - ! Add vertices, non repeated vertex entries at this point. - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - ! Define vertices for this segment: - CALL INSERT_FACE_VERT(X1V,NM,CEI,NVERT,INOD1) - CALL INSERT_FACE_VERT(X2V,NM,CEI,NVERT,INOD2) - DO JEC=1,MESHES(NM)%CUT_EDGE(CEI)%NEDGE - IEQ1 = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,JEC) - IEQ2 = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,JEC) - IF((IEQ1==INOD1 .AND. IEQ2==INOD2) .OR. (IEQ1==INOD2 .AND. IEQ2==INOD1)) THEN ! SEG NODES found - EXIT - ENDIF - ENDDO - IF(JEC > MESHES(NM)%CUT_EDGE(CEI)%NEDGE) THEN ! JEC can be NEDGE+1, new cut-edge. - NEDGE = JEC; CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) - MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE) = (/ INOD1, INOD2 /) - ENDIF - CF%EDGE_LIST(1:3,IEDGE) = (/CC_ETYPE_CFINB, CEI, JEC /) +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' + IF (MY_RANK==0) WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' +ENDIF - NCF = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) - IF (NCF==0) THEN - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) = NCF+1 - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(2,JEC) = ITRI - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,JEC) = IBOD - ELSEIF(NCF==1) THEN - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) = NCF+1 - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(3,JEC) = ITRI - ENDIF - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE +RETURN +END SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE - ENDIF - ENDDO - ENDDO - ! DO ICF = 1, CF%NFACE - ! IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) - ! DO ISEG=1,CF%CEDGES(1,ICF) - ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) - ! IF (ISEGGEOMEPS) THEN - ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT - ! ENDIF - ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) - ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) - ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN - ! WRITE(LU_ERR,*) 'CARTC CYC CELL Found diff in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC,CYCLE_CELL - ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) - ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) - ! ENDIF - ! ENDDO - ! ENDDO - ! WRITE(LU_ERR,*) 'ERR CELL I,J,K CUT_FACES',I,J,K,CF%NFACE,CT_EDGES - ! DO ICF = 1, CF%NFACE - ! WRITE(LU_ERR,*) CF%CEDGES(1:4,ICF),':',CF%CFELEM(2:4,ICF) - ! ENDDO - ! DO ICF = 1, CT_EDGES - ! WRITE(LU_ERR,*) ICF,CF%EDGE_LIST(1:3,ICF) - ! ENDDO +! ------------------------- SET_GC_CUTCELLS_3D ----------------------------------- - ENDDO ! I - ENDDO ! J -ENDDO ! K +SUBROUTINE SET_GC_CUTCELLS_3D -IF (.NOT.BNDINT_FLAG) DEALLOCATE(IJK_COUNTED,IJK_COUNTF) -DEALLOCATE(SEG_CELL,SEG_POS) +! Local Variables: +INTEGER :: IW,II,JJ,KK,IOR,IIO,JJO,KKO,IIF,JJF,KKF,IIOF,JJOF,KKOF,ICF,ICOF,X1AXIS,ICC,NMICC,NOFC,N_CF,N_CRT +REAL(EB):: XNM, XNOM +TYPE (WALL_TYPE), POINTER :: WC +TYPE (EXTERNAL_WALL_TYPE), POINTER :: EWC +LOGICAL :: WC_PERIODIC, TEST_ICC +REAL(EB):: AREA_NM, AREA_NOM, AREA_CRT -T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - NCUTFCE = 0 - IF (BNDINT_FLAG) THEN - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) CYCLE - NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE - ENDDO - ELSE - DO ICF=MESHES(NM)%N_CUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) CYCLE - NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE - ENDDO - ENDIF - WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-faces : ',NCUTFCE,'. ' +IF (CCGUARD == 0) RETURN + +IF(GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_SETCC,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-faces : ',NCUTFCE,'. ' + WRITE(LU_ERR ,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' ENDIF ENDIF -RETURN +! Meshes Loop: +! First Mesh Loop: +! Test if NOM mesh cells are of the same size or smaller than NM mesh that areas match: +MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX -CONTAINS + IF (MESHES(NM)%N_CUTFACE_MESH==0) CYCLE MESH_LOOP_1 + CALL POINT_TO_MESH(NM) -SUBROUTINE REALLOCATE_SEG_CELL + EXTERNAL_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS -IF(NSEG > SIZE_CEELEM_SEG_CELL) THEN - ! First SEG_CELL - ALLOCATE(SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)); SEG_CELL_AUX = CC_UNDEFINED - SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) = & - SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) - DEALLOCATE(SEG_CELL); ALLOCATE(SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)) - SEG_CELL(:,:) = SEG_CELL_AUX(:,:) - ! Then SEG_POS: - SEG_CELL_AUX(1,1:SIZE_CEELEM_SEG_CELL) = SEG_POS(1:SIZE_CEELEM_SEG_CELL) - DEALLOCATE(SEG_POS); ALLOCATE(SEG_POS(1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)) - SEG_POS(:) = SEG_CELL_AUX(1,:) - SIZE_CEELEM_SEG_CELL = SIZE_CEELEM_SEG_CELL + DELTA_EDGE - DEALLOCATE(SEG_CELL_AUX) -ENDIF + WC=>WALL(IW) + EWC=>EXTERNAL_WALL(IW) + BC=>BOUNDARY_COORD(WC%BC_INDEX) + B1=>BOUNDARY_PROP1(WC%B1_INDEX) + IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & + WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_1 -RETURN -END SUBROUTINE REALLOCATE_SEG_CELL + II = BC%II + JJ = BC%JJ + KK = BC%KK + IOR = BC%IOR -END SUBROUTINE GET_CARTCELL_CUTFACES + ! Skip if no cut-faces present on this WC: + ! Define underlying Cartesian faces indexes: + SELECT CASE(IOR) + CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-IAXIS) ! Higher X boundary for Mesh NM. + IIF = II - 1; JJF = JJ ; KKF = KK + CASE( JAXIS) ! Lower Y boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-JAXIS) ! Higher Y boundary for Mesh NM. + IIF = II ; JJF = JJ - 1; KKF = KK + CASE( KAXIS) ! Lower Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-KAXIS) ! Higher Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK - 1 + END SELECT + X1AXIS = ABS(IOR) + IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE EXTERNAL_WALL_LOOP_1 + ! Gas cut-face area in wall-cell IW face: + ICF = FCVAR(IIF,JJF,KKF,CC_IDCF,X1AXIS) + AREA_NM = SUM(CUT_FACE(ICF)%AREA(1:CUT_FACE(ICF)%NFACE)) -! ------------------------ GET_CLOSED_POLYLINES --------------------------------- + IF(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN + NOM = EWC%NOM ! Use Other Mesh Data. + IF(MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_1 + ! Now Obtain the CUT_FACE for the same face on NM-NOM: -SUBROUTINE GET_CLOSED_POLYLINES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,SEG_POS,IFLG,NPOLY,ILO_POLY,NSG_POLY) + AREA_NOM = 0._EB; N_CF=0; N_CRT=0 + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + SELECT CASE(IOR) + CASE( IAXIS) ! Lower X boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) + CASE(-IAXIS) ! Higher X boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO- 1; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) + CASE( JAXIS) ! Lower Y boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) + CASE(-JAXIS) ! Higher Y boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO ; JJOF= JJO- 1; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) + CASE( KAXIS) ! Lower Z boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) + CASE(-KAXIS) ! Higher Z boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO- 1; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) + END SELECT + IF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_FGSC,X1AXIS) == CC_GASPHASE) THEN + AREA_NOM = AREA_NOM + AREA_CRT + N_CRT = N_CRT + 1 + ELSEIF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) > 0) THEN ! there are gasphase cut-faces + ICOF = MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) + AREA_NOM = AREA_NOM + SUM(MESHES(NOM)%CUT_FACE(ICOF)%AREA(1:MESHES(NOM)%CUT_FACE(ICOF)%NFACE)) + N_CF = N_CF + 1 + ENDIF + ENDDO + ENDDO + ENDDO + + ! Check if: + ! 1. other mesh faces are more than one -> areas match. + ! 2. other mesh face and size of cartesian faces the same -> areas match. + ! 3. Left the case of fine mesh face with OMESH face coarse. + NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 + IF ( (NOFC > 1) .OR. (ABS(B1%AREA-AREA_CRT) < GEOMEPS) )THEN + IF(ABS(AREA_NM-AREA_NOM) > ADIFF_INFO_FACTOR*AREA_CRT) THEN + WRITE(LU_ERR,*) 'SET_GC_CUTCELLS_3D Error: MESH=',NM,', CUT_FACE=',ICF,' does not match OMESH=',& + NOM,', with CUT_FACEs,CRT_FACEs=',N_CF,N_CRT,', area difference=',& + ABS(AREA_NM-AREA_NOM),', GEOMEPS=',GEOMEPS + WRITE(LU_ERR,*) 'CUT FACE=',ICF,MESHES(NM)%CUT_FACE(ICF)%IJK(1:4),':',MESHES(NM)%CUT_FACE(ICF)%STATUS + ENDIF + ENDIF + + ENDIF + + ENDDO EXTERNAL_WALL_LOOP_1 + +ENDDO MESH_LOOP_1 + + +! Second mesh loop: +! Define cut-cell data on guard-cell region to be communicated: +MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + + IF ((MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH)==0) CYCLE MESH_LOOP_2 + + CALL POINT_TO_MESH(NM) + + EXTERNAL_WALL_LOOP_2 : DO IW=1,N_EXTERNAL_WALL_CELLS + + WC=>WALL(IW) + BC=>BOUNDARY_COORD(WC%BC_INDEX) + EWC=>EXTERNAL_WALL(IW) + IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & + WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_2 + + II = BC%II + JJ = BC%JJ + KK = BC%KK + IOR = BC%IOR + NOM = EWC%NOM ! Use Other Mesh Data. + + IF (NOM>0) THEN + IF (MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_2 + ENDIF + + IF (WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN + + ! Skip if no cut-faces present on this WC: + ! Define underlying Cartesian faces indexes: + SELECT CASE(IOR) + CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-IAXIS) ! Higher X boundary for Mesh NM. + IIF = II - 1; JJF = JJ ; KKF = KK + CASE( JAXIS) ! Lower Y boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-JAXIS) ! Higher Y boundary for Mesh NM. + IIF = II ; JJF = JJ - 1; KKF = KK + CASE( KAXIS) ! Lower Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-KAXIS) ! Higher Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK - 1 + END SELECT + X1AXIS = ABS(IOR) + IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) CYCLE EXTERNAL_WALL_LOOP_2 -INTEGER, INTENT(IN) :: SIZE_CEELEM_SEG_CELL -INTEGER, INTENT(INOUT) :: NSEG -INTEGER, INTENT(INOUT) :: SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) -INTEGER, INTENT(INOUT) :: SEG_POS(1:SIZE_CEELEM_SEG_CELL) -LOGICAL, INTENT(OUT):: IFLG -INTEGER, INTENT(OUT):: NPOLY,ILO_POLY(1:MAX_CELL_POLYLINES),NSG_POLY(1:MAX_CELL_POLYLINES) + IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN + TEST_ICC = .TRUE. + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + TEST_ICC = TEST_ICC .AND. (MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) <= 0) + ENDDO + ENDDO + ENDDO -! Local Variables: -INTEGER :: ISEG, ISEG2, CISEG, MIBOD, NBOD, NEWSEG, SEG_LEFT, ILO, IHI, CT, IBOD, IPOLY, PIVNOD, STNOD, COUNT -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL2 -INTEGER, ALLOCATABLE, DIMENSION(:) :: SEG_POS2, COUNTED, BOD, SEG_POLY, CTBOD -LOGICAL :: FOUNDSEG, FOUND_CHG, INLIST + NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) + ! Do test for PERIODIC boundaries. Note: PERIODIC boundaries at this point have been redefined as INTERPOLATED_BOUNDARY, + ! so we test using the Mesh center relative locations. + IF (WC%BOUNDARY_TYPE==INTERPOLATED_BOUNDARY .AND. NMICC > 0 .AND. TEST_ICC) THEN + WC_PERIODIC=.FALSE. + SELECT CASE(IOR) + CASE(-IAXIS) ! High X wall cell. + XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) + IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE( IAXIS) ! Low X wall cell. + XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) + IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE(-JAXIS) ! High Y wall cell. + XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) + IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE( JAXIS) ! Low Y wall cell. + XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) + IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE(-KAXIS) ! High Z wall cell. + XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) + IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE( KAXIS) ! Low Z wall cell. + XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) + IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + END SELECT + IF (WC_PERIODIC) THEN + MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) = 0 ! Set NMICC = 0. + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + IF(MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_CGSC)==CC_SOLID) THEN + MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC)=CC_SOLID ! set to Solid. + CYCLE EXTERNAL_WALL_LOOP_2 + ENDIF + ENDDO + ENDDO + ENDDO + ENDIF + ENDIF -IFLG=.TRUE. -ALLOCATE(SEG_CELL2(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:NSEG),SEG_POS2(1:NSEG),COUNTED(1:NSEG),& - BOD(1:N_GEOMETRY),SEG_POLY(1:NSEG)) -SEG_CELL2 = 0; SEG_POS2 =0; COUNTED = 0; BOD=0 + NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 + ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 + N_CF = 0 + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) + IF (ICC > 0) THEN + N_CF = N_CF + 1 + MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,N_CF) = (/ NOM, ICC /) + NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL + ! Add NCELL cut-cells to OM%NCC_R: + MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 + MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL + ENDIF + ENDDO + ENDDO + ENDDO + MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = N_CF + ENDIF -! First collapse segments to most frequent body: -NBOD = 1 -BOD(NBOD) = SEG_CELL(6,1) -DO ISEG=2,NSEG - INLIST =.FALSE. - DO IBOD=1,NBOD - IF (SEG_CELL(6,ISEG) == BOD(IBOD)) THEN - INLIST=.TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.INLIST) THEN - NBOD=NBOD+1 - BOD(NBOD)=SEG_CELL(6,ISEG) - ENDIF -ENDDO -ALLOCATE(CTBOD(1:NBOD)); CTBOD = 0 -DO IBOD=1,NBOD - DO ISEG=1,NSEG - IF (SEG_CELL(6,ISEG) == BOD(IBOD)) CTBOD(IBOD) = CTBOD(IBOD) + 1 - ENDDO -ENDDO -MIBOD=MAXLOC(CTBOD(1:NBOD),DIM=1); DEALLOCATE(CTBOD) + ! Here add cut or regular faces to every face on this wall cell: + ! This requires defining the sets of cut and regular faces within the area of each cut or + ! regular face. Option : Use POINT_IN_POLYGON with centroids. To do. -DO ISEG=1,NSEG - IF (COUNTED(ISEG)/=0) CYCLE - CISEG = 0 - DO ISEG2=1,NSEG - IF (COUNTED(ISEG2)/=0) CYCLE - IF ( ISEG2==ISEG ) CYCLE - IF ( (SEG_CELL(NOD1,ISEG)==SEG_CELL(NOD1,ISEG2)) .AND. (SEG_CELL(NOD2,ISEG)==SEG_CELL(NOD2,ISEG2)) ) THEN - IF (SEG_CELL(6,ISEG)==BOD(MIBOD)) THEN - ! ISEG should be COUNTED +1; ISEG2 -1. - COUNTED(ISEG) = 1 - COUNTED(ISEG2)=-1 - CISEG = 1 - ELSE - ! ISEG should be COUNTED -1; ISEG2 +1. - COUNTED(ISEG) =-1 - COUNTED(ISEG2)= 1 - CISEG = 1 + ELSEIF(WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) THEN + NOM = NM ! Use gas cell data, same mesh. + IIO = BC%IIG + JJO = BC%JJG + KKO = BC%KKG + ! CYCLE if OBJECT face is in the Mirror Boundary, normal out into ghost-cell: + SELECT CASE(IOR) + CASE( IAXIS) + IF(FCVAR(IIO-1,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE + CASE(-IAXIS) + IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE + CASE( JAXIS) + IF(FCVAR(IIO ,JJO-1,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE + CASE(-JAXIS) + IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE + CASE( KAXIS) + IF(FCVAR(IIO ,JJO ,KKO-1,CC_FGSC,KAXIS) == CC_SOLID) CYCLE + CASE(-KAXIS) + IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,KAXIS) == CC_SOLID) CYCLE + END SELECT + IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN + ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC); IF (ICC<1) CYCLE + NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) + NOFC = 1 + ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 + MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,NOFC) = (/ NOM, ICC /) + MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = NOFC + NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL + ! Add NCELL cut-cells to OM%NCC_R: + MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 + MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL ENDIF ENDIF - ENDDO - IF (CISEG==0) COUNTED(ISEG) = 1 -ENDDO -NEWSEG = 0 -DO ISEG=1,NSEG - IF (COUNTED(ISEG)/=1) CYCLE - NEWSEG = NEWSEG + 1 - SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) - SEG_POS2(NEWSEG) = SEG_POS(ISEG) -ENDDO -NSEG = NEWSEG -SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:NSEG) = SEG_CELL2(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:NSEG) -SEG_POS(1:NSEG) = SEG_POS2(1:NSEG) -! Now make closed polylines: -SEG_CELL2 = 0; SEG_POS2 =0; COUNTED = 0; -NPOLY = 0; ILO_POLY = 0; NSG_POLY = 0; SEG_POLY = 0; ! Polyline number for the segment. -SEG_LEFT = NSEG -DO ! This exterior while loop defined closed polylines in the cell. - ! Count one more polyline: - NPOLY = NPOLY + 1 - IF (NPOLY==1) THEN - ILO_POLY(NPOLY) = 0 - ELSE - ILO_POLY(NPOLY) = ILO_POLY(NPOLY-1) + NSG_POLY(NPOLY-1) + ENDDO EXTERNAL_WALL_LOOP_2 + +ENDDO MESH_LOOP_2 + +IF(GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' ENDIF +ENDIF - ! Find first segment of next polyline: - FOUNDSEG = .FALSE. - DO ISEG=1,NSEG - IF (COUNTED(ISEG) == 0) THEN - FOUNDSEG = .TRUE. - EXIT - ENDIF - ENDDO - IF (.NOT.FOUNDSEG) EXIT ! Escape if there are no new segments. +RETURN - ! Create new closed polyline: - NEWSEG = ILO_POLY(NPOLY) + 1 - SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) - SEG_POS2(NEWSEG) = SEG_POS(ISEG) - COUNTED(ISEG) = 1 - STNOD = SEG_CELL2(NOD1,NEWSEG) - PIVNOD = SEG_CELL2(NOD2,NEWSEG) ! Pivot Vertex, used to find next segment. - NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 - SEG_POLY(NEWSEG) = NPOLY - SEG_LEFT = SEG_LEFT - 1 - DO NEWSEG = ILO_POLY(NPOLY)+2,NSEG - FOUNDSEG = .FALSE. - DO ISEG=1,NSEG - IF (COUNTED(ISEG) > 0) CYCLE - IF (SEG_CELL(NOD1,ISEG)==PIVNOD) THEN ! Found the next segment - FOUNDSEG = .TRUE. - SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) - SEG_POS2(NEWSEG) = SEG_POS(ISEG) - COUNTED(ISEG) = 1 - PIVNOD = SEG_CELL2(NOD2,NEWSEG); ! Pivot Vertex, used to find next segment. - NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 - SEG_POLY(NEWSEG) = NPOLY; - SEG_LEFT = SEG_LEFT - 1 - EXIT - ELSEIF (SEG_CELL(NOD2,ISEG)==PIVNOD) THEN ! Found the next segment - FOUNDSEG = .TRUE. - SEG_CELL2(:,NEWSEG) = (/ SEG_CELL(NOD2,ISEG), SEG_CELL(NOD1,ISEG), SEG_CELL(3:9,ISEG) /) - SEG_POS2(NEWSEG) = SEG_POS(ISEG) - COUNTED(ISEG) = 1 - PIVNOD = SEG_CELL2(NOD2,NEWSEG) ! Pivot Vertex, used to find next segment. - NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 - SEG_POLY(NEWSEG) = NPOLY - SEG_LEFT = SEG_LEFT - 1 - EXIT - ENDIF - ENDDO - ! Check if for this NEWSEG we didn't find an ISEG: - IF (.NOT.FOUNDSEG) EXIT - ENDDO - ! Finally, test if polyline is closed: - IF ( SEG_CELL2(NOD2,ILO_POLY(NPOLY)+NSG_POLY(NPOLY)) /= STNOD ) RETURN +END SUBROUTINE SET_GC_CUTCELLS_3D - ! End of new polyline creation. - ! Here if we have less that 3 segments not counted exit while loop. - IF (SEG_LEFT < 3) EXIT -ENDDO -! Per polyline, move last SEG if SEG-1 is different body number: -DO IPOLY=1,NPOLY - FOUND_CHG=.FALSE. - ILO =ILO_POLY(IPOLY)+1 - IHI =ILO_POLY(IPOLY)+NSG_POLY(IPOLY) - CT =0 - DO ISEG=ILO,IHI-1 - CT=CT+1 - IF (SEG_CELL2(6,ISEG) /= SEG_CELL2(6,ISEG+1)) THEN - FOUND_CHG=.TRUE. - EXIT +! --------------------------- GET_GEOM_TRIBIN -------------------------------------- + +SUBROUTINE GET_GEOM_TRIBIN + +! This routine separates lists of triangles for each GEOMETRY in interval +! bins in each direction. They are used in SET_CUTCELLS_3D/GET_BODINT_PLANE to optimize +! cut-cell generation. + +! Local Variables: +INTEGER :: IG, IWSEL, IEDGE, NTL, SZE, IBIN, ILO_BIN, IHI_BIN, WSELEM(NOD1:NOD3) +REAL(EB):: LEDGE, DXYZE(MAX_DIM), LX1, DELBIN, X1V_LO, X1V_HI, X1V(NOD1:NOD3) +INTEGER, ALLOCATABLE, DIMENSION(:) :: TRI_LIST +REAL(EB):: MINMAX_MESHES(LOW_IND:HIGH_IND,IAXIS:KAXIS),MIN_MESHGEOM,MAX_MESHGEOM +TYPE(GEOMETRY_TYPE), POINTER :: G +INTEGER :: DELTA_TBIN2 + + +! Define boundary region of Meshes handled by MPI process and their connected meshes: +! Select MESHES assigned to processor and OMESHES of these. Cut-cells will be computed for all of them. +IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) +ALLOCATE(CC_COMPUTE_MESH(1:NMESHES)); CC_COMPUTE_MESH = .FALSE. +MINMAX_MESHES( LOW_IND,:)= 1._EB/TWENTY_EPSILON_EB +MINMAX_MESHES(HIGH_IND,:)= -1._EB/TWENTY_EPSILON_EB +DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CC_COMPUTE_MESH(NM)=.TRUE. ! Compute cut-cells for my meshes. + ! Min-max locations of MESH + halo region. + IG = MESHES(NM)%IBAR + MINMAX_MESHES( LOW_IND,IAXIS) = MIN(MINMAX_MESHES( LOW_IND,IAXIS),MESHES(NM)%XS-REAL(NGUARD,EB)*MESHES(NM)%DX( 1)) + MINMAX_MESHES(HIGH_IND,IAXIS) = MAX(MINMAX_MESHES(HIGH_IND,IAXIS),MESHES(NM)%XF+REAL(NGUARD,EB)*MESHES(NM)%DX(IG)) + IG = MESHES(NM)%JBAR + MINMAX_MESHES( LOW_IND,JAXIS) = MIN(MINMAX_MESHES( LOW_IND,JAXIS),MESHES(NM)%YS-REAL(NGUARD,EB)*MESHES(NM)%DY( 1)) + MINMAX_MESHES(HIGH_IND,JAXIS) = MAX(MINMAX_MESHES(HIGH_IND,JAXIS),MESHES(NM)%YF+REAL(NGUARD,EB)*MESHES(NM)%DY(IG)) + IG = MESHES(NM)%KBAR + MINMAX_MESHES( LOW_IND,KAXIS) = MIN(MINMAX_MESHES( LOW_IND,KAXIS),MESHES(NM)%ZS-REAL(NGUARD,EB)*MESHES(NM)%DZ( 1)) + MINMAX_MESHES(HIGH_IND,KAXIS) = MAX(MINMAX_MESHES(HIGH_IND,KAXIS),MESHES(NM)%ZF+REAL(NGUARD,EB)*MESHES(NM)%DZ(IG)) + DO NOM=1,NMESHES + IF (MESHES(NM)%OMESH(NOM)%NIC_R > 0) THEN + CC_COMPUTE_MESH(NOM)=.TRUE. ! There are cells from mesh NOM that are guardcells of mesh NM. + ! Min-max locations of MESH + halo region. + IG = MESHES(NOM)%IBAR + MINMAX_MESHES( LOW_IND,IAXIS) = MIN(MINMAX_MESHES( LOW_IND,IAXIS),MESHES(NOM)%XS-REAL(NGUARD,EB)*MESHES(NOM)%DX( 1)) + MINMAX_MESHES(HIGH_IND,IAXIS) = MAX(MINMAX_MESHES(HIGH_IND,IAXIS),MESHES(NOM)%XF+REAL(NGUARD,EB)*MESHES(NOM)%DX(IG)) + IG = MESHES(NOM)%JBAR + MINMAX_MESHES( LOW_IND,JAXIS) = MIN(MINMAX_MESHES( LOW_IND,JAXIS),MESHES(NOM)%YS-REAL(NGUARD,EB)*MESHES(NOM)%DY( 1)) + MINMAX_MESHES(HIGH_IND,JAXIS) = MAX(MINMAX_MESHES(HIGH_IND,JAXIS),MESHES(NOM)%YF+REAL(NGUARD,EB)*MESHES(NOM)%DY(IG)) + IG = MESHES(NOM)%KBAR + MINMAX_MESHES( LOW_IND,KAXIS) = MIN(MINMAX_MESHES( LOW_IND,KAXIS),MESHES(NOM)%ZS-REAL(NGUARD,EB)*MESHES(NOM)%DZ( 1)) + MINMAX_MESHES(HIGH_IND,KAXIS) = MAX(MINMAX_MESHES(HIGH_IND,KAXIS),MESHES(NOM)%ZF+REAL(NGUARD,EB)*MESHES(NOM)%DZ(IG)) ENDIF ENDDO - IF (FOUND_CHG) THEN - SEG_CELL(:,ILO:IHI-CT) = SEG_CELL2(:,ISEG+1:IHI) - SEG_POS(ILO:IHI-CT) = SEG_POS2(ISEG+1:IHI) - SEG_CELL(:,IHI-CT+1:IHI) = SEG_CELL2(:,ILO:ISEG) - SEG_POS(IHI-CT+1:IHI) = SEG_POS2(ILO:ISEG) - ELSE - SEG_CELL(:,ILO:IHI) = SEG_CELL2(:,ILO:IHI) - SEG_POS(ILO:IHI) = SEG_POS2(ILO:IHI) - ENDIF ENDDO -! Finally cycle segments to redefine polylines (case of two or more polys -! sharing one point. -STNOD=SEG_CELL(NOD1,1) -NPOLY=1; COUNT=1 -DO ISEG=2,NSEG - COUNT=COUNT+1 - SEG_POLY(ISEG)=NPOLY - IF (SEG_CELL(NOD2,ISEG)==STNOD) THEN - NSG_POLY(NPOLY) = COUNT - IF (ISEG==NSEG) EXIT - NPOLY=NPOLY+1 - ILO_POLY(NPOLY) = ILO_POLY(NPOLY-1) + NSG_POLY(NPOLY-1) - COUNT=0; STNOD=SEG_CELL(NOD1,ISEG+1) - ENDIF -ENDDO -DEALLOCATE(SEG_CELL2,SEG_POS2,COUNTED,BOD,SEG_POLY) +! Loop geometries: +LOOP_GEOM : DO IG = 1, N_GEOMETRY -IFLG=.FALSE. + G=>GEOMETRY(IG) -RETURN -END SUBROUTINE GET_CLOSED_POLYLINES + ! Define EDGE sizes and FACE cointaining boxes: + G%MAX_LEDGE = GEOMEPS ! Initialize to a small number. + G%MIN_LEDGE = 1._EB/GEOMEPS ! Initialize to a large number. + G%MEAN_LEDGE= 0._EB ! Initialize to 0. + ! Loop Faces: + DO IWSEL = 0,G%N_FACES-1 + WSELEM(NOD1:NOD3) = G%FACES(3*IWSEL+1:3*IWSEL+3) -! --------------------------- EAR_CLIP_CFACES ----------------------------------- + ! Obtain edges length, test against MAX_LEDGE: + DO IEDGE=1,3 + ! DX = XYZ2 - XYZ1: + DXYZE(IAXIS:KAXIS) = G%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) - & + G%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) + LEDGE = sqrt( DXYZE(IAXIS)**2._EB + DXYZE(JAXIS)**2._EB + DXYZE(KAXIS)**2._EB ) -SUBROUTINE EAR_CLIP_CFACES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,XYZVERT,& - INDIF,INDJF,INDKF,NPOLY,ILO_POLY,NSG_POLY,NFACE,& - CFELEM,BOD_TRI,CEDGES,SEG_CELL_AUX,COUNT_CEDGE) + G%MAX_LEDGE = MAX(G%MAX_LEDGE,LEDGE) + G%MIN_LEDGE = MIN(G%MIN_LEDGE,LEDGE) + G%MEAN_LEDGE= G%MEAN_LEDGE + LEDGE -INTEGER, INTENT(IN) :: SIZE_CEELEM_SEG_CELL -INTEGER, INTENT(IN) :: NSEG, INDIF, INDJF, INDKF, NPOLY -INTEGER, INTENT(IN) :: ILO_POLY(1:MAX_CELL_POLYLINES),NSG_POLY(1:MAX_CELL_POLYLINES) -INTEGER, INTENT(IN) :: SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) -REAL(EB),INTENT(IN) :: XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) -INTEGER, INTENT(OUT):: NFACE,CFELEM(4,3*NSEG),BOD_TRI(1:2,1:CC_MAXCFELEM_FACE),CEDGES(4,3*NSEG) -INTEGER, INTENT(INOUT) :: SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:3*NSEG) -INTEGER, INTENT(OUT):: COUNT_CEDGE + WSELEM=CSHIFT(WSELEM,1) ! Shift cyclically array by 1 entry. This rotates nodes connectivities. + ! i.e: initially WSELEM=(/1,2,3/), 1st call gives WSELEM=(/2,3,1/), 2nd + ! call gives WSELEM=(/3,1,2/). + ENDDO -! Local Variables: -REAL(EB) :: DV(IAXIS:KAXIS), NP(IAXIS:KAXIS), XP(IAXIS:KAXIS) -REAL(EB), ALLOCATABLE, DIMENSION(:) :: LEN_SEG -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: N -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL2 -LOGICAL :: SEG_FLAG(1:MAX_CELL_POLYLINES), FOUND_ISEG1, IS_SOLID, TWOTRI -INTEGER :: ILO, IHI, NSGP, LEFT_SEGS, COUNTEXT, COUNT, BOD, TRI, ISEG, ISEG1, IPOLY, XAXIS, IFACE -INTEGER :: CONN(1:3),CONN2(1:6) + ENDDO + ! Mean length of Edge: + G%MEAN_LEDGE = G%MEAN_LEDGE / REAL(G%N_FACES*EDGS_WSEL,EB) !Num EDGES summed in NUM_FACES * NUM edges on a face. -ALLOCATE(LEN_SEG(1:3*NSEG)); LEN_SEG = 0._EB -ALLOCATE(N(IAXIS:KAXIS,1:3*NSEG)); N = 0._EB -ALLOCATE(SEG_CELL2(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:3*NSEG)); SEG_CELL2 = 0 -COUNT_CEDGE = 0 + ! Now define Bin sizes to distribute Faces subsets: + DO X1AXIS=IAXIS,KAXIS -! Compute segments director unit vectors and normals: -!DO ISEG=1,NSEG -! DV = XYZVERT(IAXIS:KAXIS,SEG_CELL(NOD2,ISEG)) - XYZVERT(IAXIS:KAXIS,SEG_CELL(NOD1,ISEG)) -! LEN_SEG(ISEG) = NORM2(DV) -! N(IAXIS:KAXIS,ISEG) = 1._EB/LEN_SEG(ISEG) * DV -!ENDDO + ! Here reduce the X1_LOW to X1_HIGH distance to the smallest of FDS Mesh and connected meshes BBOX or Geometry: + MIN_MESHGEOM = MAX(MINMAX_MESHES( LOW_IND,X1AXIS),G%GEOM_BOX( LOW_IND,X1AXIS)-G%MEAN_LEDGE) + MAX_MESHGEOM = MIN(MINMAX_MESHES(HIGH_IND,X1AXIS),G%GEOM_BOX(HIGH_IND,X1AXIS)+G%MEAN_LEDGE) + LX1 = MAX_MESHGEOM - MIN_MESHGEOM -! First sweep across segments defining triangles for all consecutive segments with same triangle and body: -NFACE = 0 -! Ear clipping algorithm by polyline: -DO IPOLY=1,NPOLY - ILO = ILO_POLY(IPOLY)+1 - NSGP = NSG_POLY(IPOLY) - IHI = ILO_POLY(IPOLY)+NSGP - SEG_CELL2(:,1:NSGP) = SEG_CELL(:,ILO:IHI) - DO ISEG=1,NSGP ! Compute segments director unit vectors and normals - DV = XYZVERT(IAXIS:KAXIS,SEG_CELL2(NOD2,ISEG)) - XYZVERT(IAXIS:KAXIS,SEG_CELL2(NOD1,ISEG)) - LEN_SEG(ISEG) = NORM2(DV) - N(IAXIS:KAXIS,ISEG) = 1._EB/LEN_SEG(ISEG) * DV - ENDDO - SEG_CELL_AUX(:,COUNT_CEDGE+1:COUNT_CEDGE+NSGP) = SEG_CELL(:,ILO:IHI) - COUNT_CEDGE = COUNT_CEDGE + NSGP - SEG_FLAG(1:NSGP) = .FALSE. - LEFT_SEGS = NSGP - DO COUNTEXT=1,3 ! Search segmets first that belong to same triangle (1), - ! second that belong to same body (2), third all the rest. - DO COUNT=1,2 ! Search first last uncounted segment (1), second the rest. - IF (LEFT_SEGS < 3) EXIT ! should break out of COUNTEXT loop. - IF (COUNT==1) THEN - ISEG = NSGP-1 - DO ISEG1=1,NSGP - IF (.NOT.SEG_FLAG(ISEG1)) EXIT - ENDDO - ELSE - ISEG = 0 - ENDIF - DO WHILE (ISEG < NSGP) - ISEG = ISEG + 1 - IF (SEG_FLAG(ISEG)) CYCLE - FOUND_ISEG1 =.FALSE. - IF (COUNT==1) THEN - IF (.NOT.SEG_FLAG(ISEG1)) FOUND_ISEG1 =.TRUE. - ELSE - DO ISEG1=ISEG+1,NSGP - IF (.NOT.SEG_FLAG(ISEG1)) THEN - FOUND_ISEG1 =.TRUE. - EXIT - ENDIF - ENDDO - ENDIF - IF(.NOT.FOUND_ISEG1) CYCLE + ! Define number of bins in direction X1AXIS: + G%TBAXIS(X1AXIS)%N_BINS = CEILING(LX1/(GAMMA_MULT*G%MEAN_LEDGE)) - TRI = 0 - ! Test if triangle given by ISEG ISEG+1 DIAG is valid. - ! First, drop if Body not the same: - IF ( (COUNTEXT<3) .AND. (SEG_CELL2(6,ISEG)/=SEG_CELL2(6,ISEG1)) ) CYCLE + ! No overlap between procs meshes and Geometry, cycle: + IF (G%TBAXIS(X1AXIS)%N_BINS < 1) THEN; G%TBAXIS(X1AXIS)%N_BINS = 0; CYCLE; ENDIF + + DELTA_TBIN2 = MAX(DELTA_TBIN,CEILING(0.05_EB*LX1/(G%GEOM_BOX(HIGH_IND,X1AXIS)-G%GEOM_BOX(LOW_IND,X1AXIS))*& + REAL(G%N_FACES,EB)/REAL(G%TBAXIS(X1AXIS)%N_BINS+1,EB))) + + ! Allocate TRIBIN field: + IF(ALLOCATED(G%TBAXIS(X1AXIS)%TRIBIN)) DEALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN) + ALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN(1:G%TBAXIS(X1AXIS)%N_BINS)) + + ! Set BIN boundaries and make initial allocation of TRI_LIST for each bin: + DELBIN = LX1 / REAL(G%TBAXIS(X1AXIS)%N_BINS,EB) + G%TBAXIS(X1AXIS)%DELBIN = DELBIN + DO IBIN=1,G%TBAXIS(X1AXIS)%N_BINS + G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW = MIN_MESHGEOM + REAL(IBIN-1,EB)*DELBIN + G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH = MIN_MESHGEOM + REAL(IBIN ,EB)*DELBIN + G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL = 0 + ALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(DELTA_TBIN2)) + ENDDO + + ! Finally, populate TRI_LIST for X1AXIS bins: + DO IWSEL = 0,G%N_FACES-1 + WSELEM(NOD1:NOD3) = G%FACES(3*IWSEL+1:3*IWSEL+3) + X1V(NOD1:NOD3) = G%VERTS(MAX_DIM*(WSELEM(NOD1:NOD3)-1)+X1AXIS) + X1V_LO = MINVAL(X1V(NOD1:NOD3)); + X1V_HI = MAXVAL(X1V(NOD1:NOD3)); + ILO_BIN = MAX(1,CEILING((X1V_LO-GEOMEPS-MIN_MESHGEOM)/DELBIN)) + IHI_BIN = MIN(G%TBAXIS(X1AXIS)%N_BINS,CEILING((X1V_HI+GEOMEPS-MIN_MESHGEOM)/DELBIN)) + DO IBIN=ILO_BIN,IHI_BIN + NTL = G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL + 1 + SZE = SIZE(G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST,DIM=1) + IF (NTL > SZE) THEN + ! Reallocate: + ALLOCATE(TRI_LIST(1:SZE+DELTA_TBIN2)); + TRI_LIST(1:SZE)=G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) + CALL MOVE_ALLOC(FROM=TRI_LIST,TO=G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST) + ENDIF + ! Add Triangle index to BINs TRI_LIST + G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL = NTL + G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(NTL) = IWSEL+1 + + ENDDO + ENDDO + END DO + + ! WRITE(LU_ERR,*) 'GEOMETRY=',IG,'NBINS=',G%TBAXIS(IAXIS)%N_BINS,G%TBAXIS(JAXIS)%N_BINS,G%TBAXIS(KAXIS)%N_BINS + ! DO X1AXIS=IAXIS,KAXIS + ! DO IBIN=1,G%TBAXIS(X1AXIS)%N_BINS + ! WRITE(LU_ERR,*) X1AXIS,'IBIN, NTL=',IBIN,G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL, & + ! G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW,G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH + ! END DO + ! END DO - ! Second, drop if segments are on the same line: - IF (ABS(ABS(DOT_PRODUCT(N(IAXIS:KAXIS,ISEG),N(IAXIS:KAXIS,ISEG1)))-1._EB) < 1.e-12_EB) CYCLE +ENDDO LOOP_GEOM - ! Now drop if triangles don't match: - TWOTRI = .FALSE. - IF (COUNTEXT<3) THEN - IF( (SEG_CELL2(4,ISEG)/=0) .AND. (SEG_CELL2(4,ISEG)==SEG_CELL2(4,ISEG1) .OR. & - SEG_CELL2(4,ISEG)==SEG_CELL2(5,ISEG1)) ) THEN - TWOTRI = .TRUE. - TRI = SEG_CELL2(4,ISEG) - BOD = SEG_CELL2(6,ISEG) - ELSEIF ( (SEG_CELL2(5,ISEG)/=0) .AND. (SEG_CELL2(5,ISEG)==SEG_CELL2(4,ISEG1) .OR. & - SEG_CELL2(5,ISEG)==SEG_CELL2(5,ISEG1)) ) THEN - TWOTRI = .TRUE. - TRI = SEG_CELL2(5,ISEG) - BOD = SEG_CELL2(6,ISEG) - ENDIF - ENDIF - IF ( (COUNTEXT/=1) .AND. (TRI==0) ) THEN - ! Define TRI as the longest seg one: - IF ( LEN_SEG(ISEG) >= LEN_SEG(ISEG1) ) THEN - TRI = SEG_CELL2(4,ISEG) - BOD = SEG_CELL2(6,ISEG) - ELSE - TRI = SEG_CELL2(4,ISEG1) - BOD = SEG_CELL2(6,ISEG1) - ENDIF - ENDIF +RETURN +END SUBROUTINE GET_GEOM_TRIBIN - IF ( TRI == 0 ) THEN - CYCLE - ELSE ! Found two segments with matching triangle. - ! Test that triangle found is not internal to GEOMs: - CONN(1:3) = (/ SEG_CELL2(1:2,ISEG), SEG_CELL2(2,ISEG1) /) - IF (TWOTRI) THEN - NP(IAXIS:KAXIS)=GEOMETRY(BOD)%FACES_NORMAL(IAXIS:KAXIS,TRI) - XP(IAXIS:KAXIS)=1._EB/3._EB*(XYZVERT(IAXIS:KAXIS,CONN(NOD1)) + & - XYZVERT(IAXIS:KAXIS,CONN(NOD2)) + & - XYZVERT(IAXIS:KAXIS,CONN(NOD3))) + 10._EB*GEOMEPS*NP(IAXIS:KAXIS) - XAXIS = MAXLOC(ABS(NP(IAXIS:KAXIS)),DIM=1) - CALL GET_IS_SOLID_3D(XAXIS,XP,INDIF,INDJF,INDKF,IS_SOLID) - IF (IS_SOLID) CYCLE - ENDIF +! --------------------------- SNAP_GEOM_NODES -------------------------------------- - NFACE = NFACE + 1 - CFELEM(1:4,NFACE) = (/ 3, CONN(1:3) /) - BOD_TRI(1:2,NFACE) = (/ BOD, TRI /) - SEG_CELL2(1:6,ISEG) = (/ SEG_CELL2(1,ISEG), SEG_CELL2(2,ISEG1), 1, TRI, 0, BOD /) - SEG_CELL_AUX(1:6,COUNT_CEDGE+1) = SEG_CELL2(1:6,ISEG) - COUNT_CEDGE = COUNT_CEDGE + 1 - DV = XYZVERT(IAXIS:KAXIS,SEG_CELL2(2,ISEG))-XYZVERT(IAXIS:KAXIS,SEG_CELL2(1,ISEG)) - LEN_SEG(ISEG) = NORM2(DV) - IF(LEN_SEG(ISEG) < GEOMEPS) CYCLE - N(IAXIS:KAXIS,ISEG) = 1._EB/LEN_SEG(ISEG) * DV +SUBROUTINE SNAP_GEOM_NODES - ! Erase Segment ISEG1: - SEG_CELL2(:,ISEG1) = 0 - SEG_FLAG(ISEG1) = .TRUE. - N(IAXIS:KAXIS,ISEG1)= 0._EB - LEFT_SEGS = LEFT_SEGS - 1 - IF (COUNT/=1) ISEG = ISEG - 1 - ENDIF +INTEGER :: IBIN,IWSELDUM,IWSEL,WSELEM(NOD1:NOD3),X1LO,X1HI,X1IND,ILO_BIN,IHI_BIN +REAL(EB):: MIN_MESHGEOM,DELBIN +REAL(EB) :: CPUTIME_START, CPUTIME + +IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_ERR,'(A)',advance="no") ' 1a. Snap node position to grid planes : SNAP_GEOM_NODES' +ENDIF + +! Main Loop over Geometries, set nodes to SNAP_NODE=T: +MAIN_GEOM_LOOP_1 : DO IG=1,N_GEOMETRY + ALLOCATE(GEOMETRY(IG)%SNAP_NODE(IAXIS:KAXIS,1:GEOMETRY(IG)%N_VERTS)); GEOMETRY(IG)%SNAP_NODE = .FALSE. + AXIS_LOOP_1 : DO X1AXIS=IAXIS,KAXIS + IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE + ! Run all bin on this geometry and set nodes involved to SNAP_NODE=T: + IBIN_DO_1 : DO IBIN=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS + ! Loop surface triangles: + DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL + IWSEL=GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(IWSELDUM) + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(MAX_DIM*(IWSEL-1)+1:MAX_DIM*IWSEL) + GEOMETRY(IG)%SNAP_NODE(X1AXIS, (/WSELEM(NOD1:NOD3)/) ) = .TRUE. ! Set nodes to test for snapping to grid planes. ENDDO - ENDDO - ENDDO -ENDDO -DEALLOCATE(LEN_SEG,N,SEG_CELL2) + ENDDO IBIN_DO_1 + ENDDO AXIS_LOOP_1 +ENDDO MAIN_GEOM_LOOP_1 -! Finally define CEDGES: -CEDGES(1,1:NFACE) = 3 -DO IFACE=1,NFACE - CONN2(1:6) = (/ CFELEM(2:3,IFACE), CFELEM(3:4,IFACE), CFELEM(2,IFACE), CFELEM(4,IFACE) /) - DO ISEG=1,3 - CONN(1:2) = CONN2(2*ISEG-1:2*ISEG) - DO ISEG1=1,COUNT_CEDGE - IF(SEG_CELL_AUX(1,ISEG1)==CONN(1) .AND. SEG_CELL_AUX(2,ISEG1)==CONN(2)) THEN - CEDGES(ISEG+1,IFACE) = ISEG1 - EXIT - ENDIF - ENDDO - ENDDO -ENDDO +! Now Mesh loop on mesh + guard planes to test against +! Main Loop over Meshes: +MAIN_MESH_LOOP : DO NM=1,NMESHES -RETURN -END SUBROUTINE EAR_CLIP_CFACES + IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. + IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + ! Run by coordinate direction, define planes X1PLN on this mesh, look for involved GEOMETRY vertices using TBAXIS and + ! after positive test of SNAP_NODE check if node is to be snapped to plane. + AXIS_LOOP_2 : DO X1AXIS=IAXIS,KAXIS -! ----------------------- GET_CARTCELL_CUTCELLS --------------------------------- + SELECT CASE(X1AXIS) + CASE(IAXIS) + X1LO = ILO_FACE-CCGUARD; X1HI = IHI_FACE+CCGUARD + ALLOCATE(X1FACE(ISTR:IEND),DX1FACE(ISTR:IEND)); X1FACE = XFACE; DX1FACE = DXFACE + CASE(JAXIS) + X1LO = JLO_FACE-CCGUARD; X1HI = JHI_FACE+CCGUARD + ALLOCATE(X1FACE(JSTR:JEND),DX1FACE(JSTR:JEND)); X1FACE = YFACE; DX1FACE = DYFACE + CASE(KAXIS) + X1LO = KLO_FACE-CCGUARD; X1HI = KHI_FACE+CCGUARD + ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)); X1FACE = ZFACE; DX1FACE = DZFACE + END SELECT -SUBROUTINE GET_CARTCELL_CUTCELLS(NM) + ! Loop planes in X1AXIS direction: + X1PLN_LOOP : DO X1IND=X1LO,X1HI + X1PLN = X1FACE(X1IND) ! Plane position. + MAIN_GEOM_LOOP_2 : DO IG=1,N_GEOMETRY + IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE + DELBIN = GEOMETRY(IG)%TBAXIS(X1AXIS)%DELBIN + MIN_MESHGEOM = GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(1)%X1_LOW + ILO_BIN = MAX(1,CEILING((X1PLN-GEOMEPS-MIN_MESHGEOM)/DELBIN)) + IHI_BIN = MIN(GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS,CEILING((X1PLN+GEOMEPS-MIN_MESHGEOM)/DELBIN)) + IBIN_DO_2 : DO IBIN=ILO_BIN,IHI_BIN + IF ( X1PLN < GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE + IF ( X1PLN > GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE + ! Loop surface triangles: + DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL + IWSEL=GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(IWSELDUM) + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(MAX_DIM*(IWSEL-1)+1:MAX_DIM*IWSEL) + ! Triangles NODES coordinates: + DO INOD=NOD1,NOD3 + IF(.NOT.GEOMETRY(IG)%SNAP_NODE(X1AXIS,WSELEM(INOD))) CYCLE + ! Do test to snap to: + IF(ABS(GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+X1AXIS)-X1PLN) < SNAP_DIST_FACTOR*DX1FACE(X1IND) ) THEN + GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+X1AXIS) = X1PLN ! Set node position to plane value. + GEOMETRY(IG)%SNAP_NODE(X1AXIS,WSELEM(INOD)) = .FALSE. ! No need to snap again. + ENDIF + ENDDO + ENDDO + ENDDO IBIN_DO_2 + ENDDO MAIN_GEOM_LOOP_2 + ENDDO X1PLN_LOOP -INTEGER, INTENT(IN) :: NM + DEALLOCATE(X1FACE,DX1FACE) -! Local Variables: -INTEGER :: I, II, J, JJ, K, ILO, IHI, JLO, JHI, KLO, KHI -INTEGER, DIMENSION(LOW_IND:HIGH_IND,IAXIS:KAXIS) :: FSID_XYZ, IDCF_XYZ -INTEGER :: NVERT_CELL, NSEG_CELL, NFACE_CELL, NCELL -INTEGER :: IED, JED, KED, MYAXIS, SIDE -REAL(EB), DIMENSION(IAXIS:KAXIS,NOD1:NOD4,LOW_IND:HIGH_IND) :: XYZLH -REAL(EB) :: AREAI, AREAVARSI(1:MAX_DIM+1,LOW_IND:HIGH_IND), FCT, XYZ(IAXIS:KAXIS), XYZC(IAXIS:KAXIS) -INTEGER :: CEI_AXIS(LOW_IND:HIGH_IND) -INTEGER :: IP, NP, ICF, CEI, INOD, FNOD -REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXVERTS_CELL) :: XYZVERT + ENDDO AXIS_LOOP_2 + CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) +ENDDO MAIN_MESH_LOOP -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL,SEG_CELL_AUX,EDGFAC_CELL,EDGFAC_CELL_AUX -INTEGER, SAVE :: SIZE_CEELEM_EDGFAC, SIZE_CFELEM_EDGFAC -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FACEDG_CELL,FACEDG_CELL_AUX -INTEGER, SAVE :: SIZE_CEELEM_FACEDG, SIZE_CFELEM_FACEDG +! Deallocate SNAP_NODE in geometries: +DO IG=1,N_GEOMETRY + DEALLOCATE(GEOMETRY(IG)%SNAP_NODE) +ENDDO -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FACE_CELL,FACE_CELL_AUX -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FACE_LIST,FACE_LIST_AUX,SPCELL_LIST -REAL(EB), ALLOCATABLE, DIMENSION(:,:):: AREAVARS,AREAVARS_AUX -INTEGER, ALLOCATABLE, DIMENSION(:) :: FACECELL_NUM -INTEGER, ALLOCATABLE, DIMENSION(:) :: FACE_CELL_DUM -INTEGER, SAVE :: SIZE_VERTS_FC, SIZE_CFELEM_FC +IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN + WRITE(LU_ERR,'(A)',advance="no") '.. done.' + CALL CPU_TIME(CPUTIME) + WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken : ',CPUTIME-CPUTIME_START,' sec.' +ENDIF -INTEGER, ALLOCATABLE, DIMENSION(:) :: IPTS +END SUBROUTINE SNAP_GEOM_NODES -INTEGER, SAVE :: SIZE_FACE_CCELEM, SIZE_CELL_CCELEM -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOL ! Cut-cell volumes. -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE +SUBROUTINE CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) -REAL(EB) :: XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND),MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND:HIGH_IND),CELL_DELTA(IAXIS:KAXIS) +INTEGER, INTENT(IN) :: NM,ISTR,IEND,JSTR,JEND,KSTR,KEND +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX -INTEGER :: IFACE, IEDGE, ISEG, SEG(NOD1:NOD2), ICELL, NFACEI, JCC, AX_MIN, AX_OTHERS(2) -LOGICAL :: INLIST, TEST1, TEST2, NEWFACE -INTEGER :: NIEDGE, NEF, LOCSEG, JFACE, KFACE, NFACEK, NUM_FACE, NCUTCELL, NCFACE_CUTCELL -INTEGER :: DFCT, CFELEM(5), CTVAL, CTVAL2, IBOD, ITRI, IDCF, MAXSEG, N_GAS_CFACES, NIBFACE, THRES, NSPCELL_LIST -LOGICAL :: CYCLE_CELL, BLOCK_SLIM_IF +! Initialize CC_IBM arrays for mesh NM: +! Vertices: +IF (.NOT. ALLOCATED(MESHES(NM)%VERTVAR)) & + ALLOCATE(MESHES(NM)%VERTVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NVVARS)) +MESHES(NM)%VERTVAR = 0 +MESHES(NM)%VERTVAR(:,:,:,CC_VGSC) = CC_GASPHASE -INTEGER :: IBNDINT -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNT -REAL(EB) :: TNOW +! Cartesian Edges: +IF (.NOT. ALLOCATED(MESHES(NM)%ECVAR)) & + ALLOCATE(MESHES(NM)%ECVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NEVARS,MAX_DIM)) +MESHES(NM)%ECVAR = 0 +MESHES(NM)%ECVAR(:,:,:,CC_EGSC,:) = CC_GASPHASE -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -INTEGER :: NCUTCEL +! Cartesian Faces: +IF (.NOT. ALLOCATED(MESHES(NM)%FCVAR)) & + ALLOCATE(MESHES(NM)%FCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NFVARS,MAX_DIM)) +MESHES(NM)%FCVAR = 0 +MESHES(NM)%FCVAR(:,:,:,CC_FGSC,:) = CC_GASPHASE + +! Cartesian Cells: +IF (.NOT. ALLOCATED(MESHES(NM)%CCVAR)) & + ALLOCATE(MESHES(NM)%CCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NCVARS)) +MESHES(NM)%CCVAR = 0 +MESHES(NM)%CCVAR(:,:,:,CC_CGSC) = CC_GASPHASE + +! When TERRAIN_CASE = TRUE, allocate GEOM_ZMAX for the mesh: +IF (TERRAIN_CASE) THEN + ALLOCATE(GEOM_ZMAX_AUX(ISTR:IEND,JSTR:JEND)) + GEOM_ZMAX_AUX = -1._EB/GEOMEPS +ENDIF +! Write mesh number allocation if GET_CUTCELLS_VERBOSE: IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTCELLS for mesh :',NM,' ..' - IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTCELLS for mesh :',NM,' ..' + WRITE(LU_SETCC,'(A)') ' ' + WRITE(LU_SETCC,'(A,I5,A,I10)') ' Processing Mesh : ',NM + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A)') ' ' + WRITE(LU_ERR,'(A,I5,A,I10)') ' Processing Mesh : ',NM + ENDIF ENDIF -TNOW=CURRENT_TIME() +! Here we have to allocate the size of MESHES(NM)%EDGE_CROSS: +MESHES(NM)%N_EDGE_CROSS = 0 ! Reset EDCROSS counter for mesh NM. +IF (ALLOCATED(MESHES(NM)%EDGE_CROSS)) DEALLOCATE(MESHES(NM)%EDGE_CROSS) +ALLOCATE(MESHES(NM)%EDGE_CROSS(GLOBAL_DELTA_EDGE)) + +! Here we have to allocate the size of MESHES(NM)%CUT_EDGE: +MESHES(NM)%N_CUTEDGE_MESH = 0 ! Reset CUTEDGE counter for mesh NM. +IF (ALLOCATED(MESHES(NM)%CUT_EDGE)) DEALLOCATE(MESHES(NM)%CUT_EDGE) +ALLOCATE(MESHES(NM)%CUT_EDGE(GLOBAL_DELTA_EDGE)) -! Allocate work arrays for this mesh: -SIZE_CEELEM_EDGFAC = DELTA_EDGE -SIZE_CFELEM_EDGFAC = DELTA_FACE -ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) -ALLOCATE(SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC)) +! Here we have to allocate the size of MESHES(NM)%CUT_FACE: +MESHES(NM)%N_CUTFACE_MESH = 0 ! Reset CUTFACE counter for mesh NM. +MESHES(NM)%N_BBCUTFACE_MESH = 0 +MESHES(NM)%N_GCCUTFACE_MESH = 0 +IF (ALLOCATED(MESHES(NM)%CUT_FACE)) DEALLOCATE(MESHES(NM)%CUT_FACE) +ALLOCATE(MESHES(NM)%CUT_FACE(GLOBAL_DELTA_FACE)) -SIZE_CEELEM_FACEDG = DELTA_EDGE -SIZE_CFELEM_FACEDG = DELTA_FACE -ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) -ALLOCATE(IPTS(1:SIZE_CEELEM_FACEDG+1)) ! Note that SIZE_CEELEM_FACEDG should be ~= SIZE_VERTS_FC. - ! (we have equal number of vertices and edges for a closed polygon.) +! Here we have to allocate the size of MESHES(NM)%CUT_CELL: +MESHES(NM)%N_CUTCELL_MESH = 0 ! Reset CUTCELL counter for mesh NM. +MESHES(NM)%N_GCCUTCELL_MESH = 0 +IF (ALLOCATED(MESHES(NM)%CUT_CELL)) DEALLOCATE(MESHES(NM)%CUT_CELL) +ALLOCATE(MESHES(NM)%CUT_CELL(GLOBAL_DELTA_CELL)) -SIZE_VERTS_FC = DELTA_VERT -SIZE_CFELEM_FC = DELTA_FACE -ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) -ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)) -ALLOCATE(AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC)) -ALLOCATE(FACECELL_NUM(1:SIZE_CFELEM_FC)) -ALLOCATE(FACE_CELL_DUM(1:SIZE_VERTS_FC)) +! Allocate array for special cells containing geometry intersections: +CALL CC_GRID_ALLOCATE_CELLRT(ISTR,IEND,JSTR,JEND,KSTR,KEND) -SIZE_FACE_CCELEM = DELTA_FACE -SIZE_CELL_CCELEM = DELTA_CELL -ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) -ALLOCATE(NOADVANCE(1:SIZE_CELL_CCELEM),VOL(1:SIZE_CELL_CCELEM),XYZCEN(IAXIS:KAXIS,1:SIZE_CELL_CCELEM)) +! List of special cells to block (either from GET_CARTCELL_CUTCELLS or +! cells flagged as polyline could not be built in GET_CARTCELL_CUTFACES): +ALLOCATE(SPCELLS_TO_BLOCK(1:GLOBAL_DELTA_CELL)) +N_SPCELLS_TO_BLOCK = 0 +MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) -! Definition of cut-cells: -! For each cartesian cell being cut into one or several cut-cells (NCELL), fill -! entries on a MESHES(NM)%CUT_CELL struct. On each local entry ICC: -! - Add number of faces that are boundary of cut-cell. -! MESHES(NM)%CUT_CELL(ICELL)%CCELEM(1:NFACE_CELL+1,ICC), ICC=1,...,MESHES(NM)%CUT_CELL(ICELL)%NCELL -! - Add list of corresponding regular faces, or cut-faces in CUT_FACE: -! + 5 Indexes: -! MESHES(NM)%CUT_CELL(ICELL)%FACES_LIST = [ FACE_TYPE LOW/HIGH AXIS cei icf ] -! where in MESHES(NM)%CUT_FACE(CEI), which icf. -! - Compute Volume properties for each disjoint volume, add an unknown -! number for scalars, pressure, etc. +END SUBROUTINE CC_GRID_INIT_MESH_STORAGE -IBNDINT_LOOP : DO IBNDINT=LOW_IND,HIGH_IND ! 1 refers to blocks internal cells, 2 refers to block guard cells. -SELECT CASE(IBNDINT) -CASE(LOW_IND) - ALLOCATE(IJK_COUNT(ILO_CELL-NGUARD:IHI_CELL+NGUARD,JLO_CELL-NGUARD:JHI_CELL+NGUARD,KLO_CELL-NGUARD:KHI_CELL+NGUARD)) - IJK_COUNT = .FALSE. - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL -CASE(HIGH_IND) - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD -END SELECT +SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) -! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: -DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI +INTEGER, INTENT(IN) :: NM +INTEGER, ALLOCATABLE, DIMENSION(:) :: SPCELLS_TO_BLOCK_TMP - IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE +MESHES(NM)%N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) - IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. +IF (N_SPCELLS_TO_BLOCK < 1) THEN + IF (ALLOCATED(SPCELLS_TO_BLOCK)) DEALLOCATE(SPCELLS_TO_BLOCK) + RETURN +ENDIF - ! Start with Cartesian Faces: - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) +IF (SIZE(SPCELLS_TO_BLOCK,DIM=1) > N_SPCELLS_TO_BLOCK) THEN + ALLOCATE(SPCELLS_TO_BLOCK_TMP(1:N_SPCELLS_TO_BLOCK)) + SPCELLS_TO_BLOCK_TMP(1:N_SPCELLS_TO_BLOCK) = SPCELLS_TO_BLOCK(1:N_SPCELLS_TO_BLOCK) + DEALLOCATE(SPCELLS_TO_BLOCK) + CALL MOVE_ALLOC(FROM=SPCELLS_TO_BLOCK_TMP,TO=MESHES(NM)%SPCELLS_TO_BLOCK) +ELSE + CALL MOVE_ALLOC(FROM=SPCELLS_TO_BLOCK,TO=MESHES(NM)%SPCELLS_TO_BLOCK) +ENDIF - ! Cut-face number of bounding Cartesian faces: - IDCF_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCF,IAXIS) - IDCF_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCF,IAXIS) - IDCF_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCF,JAXIS) - IDCF_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCF,JAXIS) - IDCF_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCF,KAXIS) - IDCF_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCF,KAXIS) +END SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK - ! Local variables: - ! Geometric entities related to the Cartesian cell: - NVERT_CELL = 0 - NSEG_CELL = 0 - NFACE_CELL = 0 - SEG_CELL = CC_UNDEFINED - FACE_CELL = CC_UNDEFINED - FACE_LIST = CC_UNDEFINED - XYZVERT = 0._EB - AREAVARS = 0._EB - ! Add Cartesian Regular faces + GASPHASE cut-faces + vertices: - IED = I-1; JED = J-1; KED = K-1 - MYAXIS_LOOP : DO MYAXIS=IAXIS,KAXIS - SELECT CASE(MYAXIS) - CASE(IAXIS) +SUBROUTINE CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) +INTEGER, INTENT(IN) :: NM +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX +INTEGER :: I,J - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) +! Case of terrain, populate GEOM_ZMAX: +IF (.NOT.TERRAIN_CASE) RETURN - AREAI = DYCELL(J) * DZCELL(K) - AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/-XFACE(IED )*AREAI, -XFACE(IED )**2._EB*AREAI, 0._EB, 0._EB /) - AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ XFACE(IED+1)*AREAI, XFACE(IED+1)**2._EB*AREAI, 0._EB, 0._EB /) - CASE(JAXIS) +IF (ALLOCATED(MESHES(NM)%GEOM_ZMAX)) DEALLOCATE(MESHES(NM)%GEOM_ZMAX) +ALLOCATE(MESHES(NM)%GEOM_ZMAX(0:IBAR,0:JBAR)) +DO J=0,JBAR + DO I=0,IBAR + ! Clip at ZS-DZ(1): + MESHES(NM)%GEOM_ZMAX(I,J) = MAX(ZFACE(-1),GEOM_ZMAX_AUX(I,J)) + ENDDO +ENDDO +DEALLOCATE(GEOM_ZMAX_AUX) - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) +END SUBROUTINE CC_GRID_FINALIZE_TERRAIN - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - AREAI = DXCELL(I) * DZCELL(K) - AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/ 0._EB, 0._EB, -YFACE(JED )**2._EB*AREAI, 0._EB /) - AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ 0._EB, 0._EB, YFACE(JED+1)**2._EB*AREAI, 0._EB /) - CASE(KAXIS) +SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS(NM) - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) +INTEGER, INTENT(IN) :: NM +INTEGER :: ICC,ICC1,I,J,K - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) +! Block SPCELLS, cells in cut-cell region where cut-cells could not be built: +IF (MESHES(NM)%N_SPCELLS_TO_BLOCK < 1 .OR. .NOT.ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) RETURN - AREAI = DXCELL(I) * DYCELL(J) - AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/ 0._EB, 0._EB, 0._EB, -ZFACE(KED )**2._EB*AREAI /) - AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ 0._EB, 0._EB, 0._EB, ZFACE(KED+1)**2._EB*AREAI /) - END SELECT +DO ICC=1,MESHES(NM)%N_SPCELLS_TO_BLOCK + I = MESHES(NM)%SPCELL_LIST(IAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + J = MESHES(NM)%SPCELL_LIST(JAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + K = MESHES(NM)%SPCELL_LIST(KAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + ICC1 = MESHES(NM)%CCVAR(I,J,K,CC_IDCC) + IF (ICC1 > 0) THEN + CC => MESHES(NM)%CUT_CELL(ICC1) + CC%NOADVANCE(1:CC%NCELL) = BLOCKED_SPECIAL_CELL + ENDIF +ENDDO - CEI_AXIS(LOW_IND:HIGH_IND) = IDCF_XYZ(LOW_IND:HIGH_IND,MYAXIS) +END SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS - DO SIDE=LOW_IND,HIGH_IND - ! Low High face: - IF ( FSID_XYZ(SIDE,MYAXIS) == CC_GASPHASE ) THEN - ! Regular Face, build 4 vertices + face: - NP = 0 - NFACE_CELL = NFACE_CELL + 1 +SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) - ! Here, reallocate FACE_LIST, AREAVARS, FACE_CELL if NFACE_CELL > SIZE_CFELEM_FC: - ! Also no need to reallocate FACE_CELL vert dimension, as for regular cells vert size = 5. - CALL REALLOCATE_LOCAL_FC_VARS - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_RCGAS, SIDE, MYAXIS, 0, 0, CC_UNDEFINED /) - ! CC_FTYPE_RCGAS=0, regular face. - AREAVARS(1:MAX_DIM+1,NFACE_CELL) = AREAVARSI(1:MAX_DIM+1,SIDE) +INTEGER, INTENT(IN) :: NM - ! Vertices arranged normal out of cartesian cell: - DO IP=NOD1,NOD4 - ! xl,yl,zl - XYZ(IAXIS:KAXIS) = XYZLH(IAXIS:KAXIS,IP,SIDE) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) +MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 - NP = NP + 1 - FACE_CELL(1,NFACE_CELL) = NP - FACE_CELL(NP+1,NFACE_CELL) = INOD - ENDDO +END SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK - ELSEIF (FSID_XYZ(SIDE,MYAXIS) == CC_CUTCFE ) THEN +END SUBROUTINE SET_CUTCELLS_3D - FCT = REAL(2*SIDE-3,EB) !2*(side-3/2); - ! GasPhase CUT_FACE, add all cut-faces on these Cartesian cell + nodes: - CEI = CEI_AXIS(SIDE) - DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE - NFACE_CELL = NFACE_CELL + 1 - ! Here, reallocate FACE_LIST, AREAVARS, FACE_CELL if NFACE_CELL > SIZE_CFELEM_FC: - CALL REALLOCATE_LOCAL_FC_VARS - ! Also reallocate FACE_CELL vert dimension, if needed. - NP = MESHES(NM)%CUT_FACE(CEI)%CFELEM(1,ICF) - CALL REALLOCATE_FACE_CELL_VERTS +SUBROUTINE ALLOCATE_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFGAS,SIDE,MYAXIS,CEI,ICF,CC_UNDEFINED /) - ! CC_FTYPE_CFGAS=1 - AREAVARS(1:MAX_DIM+1,NFACE_CELL) =(/ MESHES(NM)%CUT_FACE(CEI)%INXAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%INXSQAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%JNYSQAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%KNZSQAREA(ICF) /)*FCT - ! FCT considers Normal out. - FACE_CELL(1,NFACE_CELL) = NP - DO IP=2,NP+1 - FNOD = MESHES(NM)%CUT_FACE(CEI)%CFELEM(IP,ICF) - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_FACE(CEI)%XYZVERT(IAXIS:KAXIS,FNOD) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) - FACE_CELL(IP,NFACE_CELL) = INOD - ENDDO - ENDDO - ENDIF - ENDDO - ENDDO MYAXIS_LOOP +TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE +LOGICAL, INTENT (INOUT) :: FIRST_CALL_ARG + +! Local Variables: +INTEGER, SAVE :: N_VERTS_TOT, N_FACES_TOT +LOGICAL, SAVE :: FIRST_CALL=.TRUE. +REAL(EB) :: LEDGE +INTEGER :: IG - N_GAS_CFACES = NFACE_CELL +IF (FIRST_CALL) THEN + ! Define BODINT_PLANE allocation sizes, hard wired for now: + ! Maximum number of vertices and elements in BODINT_PLANE: + N_VERTS_TOT=0; N_FACES_TOT=0 + DO IG=1,N_GEOMETRY + N_VERTS_TOT = N_VERTS_TOT + GEOMETRY(IG)%N_VERTS + N_FACES_TOT = N_FACES_TOT + GEOMETRY(IG)%N_FACES + ENDDO - ! Now add INBOUNDARY faces of the cell: - CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) - IF ( CEI > 0 ) THEN - FCT = -1._EB - DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE - NFACE_CELL = NFACE_CELL + 1 - ! Here, reallocate FACE_LIST, AREAVARS, FACE_CELL if NFACE_CELL > SIZE_CFELEM_FC: - CALL REALLOCATE_LOCAL_FC_VARS - ! Also reallocate FACE_CELL, FACE_CELL_DUM vert dimension, if needed. - NP = MESHES(NM)%CUT_FACE(CEI)%CFELEM(1,ICF) - CALL REALLOCATE_FACE_CELL_VERTS - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB, 0, 0, CEI, ICF, CC_UNDEFINED /) - ! CC_FTYPE_CFINB in Cart-cell. - AREAVARS(1:MAX_DIM+1,NFACE_CELL) = (/ MESHES(NM)%CUT_FACE(CEI)%INXAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%INXSQAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%JNYSQAREA(ICF), & - MESHES(NM)%CUT_FACE(CEI)%KNZSQAREA(ICF) /)*FCT - ! Normal out of cut-cell. - FACE_CELL(1,NFACE_CELL) = NP - DO IP=2,NP+1 - FNOD = MESHES(NM)%CUT_FACE(CEI)%CFELEM(IP,ICF) - XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_FACE(CEI)%XYZVERT(IAXIS:KAXIS,FNOD) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) - FACE_CELL(IP,NFACE_CELL) = INOD - ENDDO - ! At this point the face in face cell is ordered - ! throught the normal outside the body. Reorganize - ! to normal outside cut-cell (inside body). - FACE_CELL_DUM(1:NP+1) = FACE_CELL(1:NP+1,NFACE_CELL) - DO IP=2,NP+1 - FACE_CELL(IP,NFACE_CELL) = FACE_CELL_DUM( (NP+1)+2-IP ) - ENDDO - ENDDO - ENDIF + ! Conservative estimate: + CC_MAX_NNODS = 2 * N_VERTS_TOT + CC_MAX_NSGLS = N_VERTS_TOT + CC_MAX_NSEGS = N_FACES_TOT + CC_MAX_NTRIS = N_FACES_TOT - ! IF(I==14 .AND. J==2 .AND. K==6) THEN - ! WRITE(LU_ERR,*) 'CC 1 I,J,K,INB NFACE,NFACE_CELL=',I,J,K,& - ! MESHES(NM)%CUT_FACE(CEI)%NFACE,NFACE_CELL - ! OPEN(666,FILE='VERTS.txt',STATUS='REPLACE') - ! DO IP=1,NVERT_CELL - ! WRITE(666,*) XYZVERT(1:3,IP) - ! ENDDO - ! CLOSE(666) - ! IFACE=MAXVAL(FACE_CELL(1,1:NFACE_CELL)) - ! OPEN(666,FILE='FACES.txt',STATUS='REPLACE') - ! DO IP=1,NFACE_CELL - ! WRITE(666,*) FACE_CELL(1:IFACE+1,IP),FACE_LIST(1,IP) - ! ENDDO - ! CLOSE(666) - ! ENDIF + ! Maximum number of grid crossings on BODINT_PLANE segments, MAX_LEDGE is a module variable: + MAX_LEDGE = GEOMEPS ! Initialize to a small number. + DO IG=1,N_GEOMETRY + LEDGE = GEOMETRY(IG)%MAX_LEDGE ! This has been computed at setup in GET_GEOM_TRIBIN + MAX_LEDGE = MAX(MAX_LEDGE,LEDGE) + ENDDO - ! Here we have in XYZvert all the vertices that define the - ! cut-cells within Cartesian cell I,J,K. We have the faces, - ! boundary of said cut-cells in face_cell. - ! We have in face_list the list of cut-cell boundary faces - ! and if they are regular or cut-face. - ! We want to reorder face list, such that we have the - ! subgroups of faces that make cut-cells. + FIRST_CALL =.FALSE. +ENDIF - ! Make list of edges: - EDGFAC_CELL(:,:) = CC_UNDEFINED - FACEDG_CELL(:,:) = CC_UNDEFINED +IF (.NOT.FIRST_CALL_ARG) RETURN - ! Here reallocate FACEDG_CELL if NFACE_CELL > SIZE_CFELEM_FACEDG: - IF (NFACE_CELL > SIZE_CFELEM_FACEDG) THEN - DFCT = CEILING(REAL(NFACE_CELL-SIZE_CFELEM_FACEDG,EB)/REAL(DELTA_FACE,EB)) - ALLOCATE(FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG+DFCT*DELTA_FACE)); - FACEDG_CELL_AUX = CC_UNDEFINED - ! Copy data into FACEDG_CELL_AUX: - FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & - FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) - ! New SIZE_CFELEM_FACEDG: - SIZE_CFELEM_FACEDG = SIZE_CFELEM_FACEDG + DFCT*DELTA_FACE - DEALLOCATE(FACEDG_CELL); ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) - ! Dump data back into FACEDG_CELL: - FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & - FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) - DEALLOCATE(FACEDG_CELL_AUX) - ENDIF +IF ( ALLOCATED(BODINT_PLANE%XYZ) ) DEALLOCATE(BODINT_PLANE%XYZ) +IF ( ALLOCATED(BODINT_PLANE%SGLS) ) DEALLOCATE(BODINT_PLANE%SGLS) +IF ( ALLOCATED(BODINT_PLANE%SEGS) ) DEALLOCATE(BODINT_PLANE%SEGS) +IF ( ALLOCATED(BODINT_PLANE%TRIS) ) DEALLOCATE(BODINT_PLANE%TRIS) +IF ( ALLOCATED(BODINT_PLANE%INDSEG) ) DEALLOCATE(BODINT_PLANE%INDSEG) +IF ( ALLOCATED(BODINT_PLANE%INDTRI) ) DEALLOCATE(BODINT_PLANE%INDTRI) +IF ( ALLOCATED(BODINT_PLANE%X2ALIGNED) ) DEALLOCATE(BODINT_PLANE%X2ALIGNED) +IF ( ALLOCATED(BODINT_PLANE%X3ALIGNED) ) DEALLOCATE(BODINT_PLANE%X3ALIGNED) +IF ( ALLOCATED(BODINT_PLANE%SEGTYPE) ) DEALLOCATE(BODINT_PLANE%SEGTYPE) +IF ( ALLOCATED(BODINT_PLANE%NOD_PERM) ) DEALLOCATE(BODINT_PLANE%NOD_PERM) - DO IFACE=1,NFACE_CELL - NIEDGE = FACE_CELL(1,IFACE) +ALLOCATE(BODINT_PLANE% XYZ(IAXIS:KAXIS, CC_MAX_NNODS)) +ALLOCATE(BODINT_PLANE% NOD_PERM(CC_MAX_NNODS)) +ALLOCATE(BODINT_PLANE% SGLS(NOD1, CC_MAX_NSGLS)) +ALLOCATE(BODINT_PLANE% SEGS(NOD1:NOD2, CC_MAX_NSEGS)) +ALLOCATE(BODINT_PLANE% TRIS(NOD1:NOD3, CC_MAX_NTRIS)) +ALLOCATE(BODINT_PLANE% INDSEG(CC_MAX_WSTRIANG_SEG+2, CC_MAX_NSEGS)) +ALLOCATE(BODINT_PLANE% INDTRI(CC_MAX_WSTRIANG_TRI+1, CC_MAX_NTRIS)) +ALLOCATE(BODINT_PLANE%X2ALIGNED(CC_MAX_NSEGS)) +ALLOCATE(BODINT_PLANE%X3ALIGNED(CC_MAX_NSEGS)) +ALLOCATE(BODINT_PLANE% SEGTYPE(LOW_IND:HIGH_IND, CC_MAX_NSEGS)) - ! Here reallocate if NIEDGE > SIZE_CEELEM_FACEDG: - IF (NIEDGE > SIZE_CEELEM_FACEDG) THEN - DFCT = CEILING(REAL(NIEDGE-SIZE_CEELEM_FACEDG,EB)/REAL(DELTA_EDGE,EB)) - ALLOCATE(FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG+DFCT*DELTA_EDGE,1:SIZE_CFELEM_FACEDG)); - FACEDG_CELL_AUX = CC_UNDEFINED - ! Copy data into FACEDG_CELL_AUX: - FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & - FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) - ! New SIZE_CEELEM_FACEDG: - SIZE_CEELEM_FACEDG = SIZE_CEELEM_FACEDG + DFCT*DELTA_EDGE - DEALLOCATE(FACEDG_CELL); ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) - ! Dump data back into FACEDG_CELL: - FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & - FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) - DEALLOCATE(FACEDG_CELL_AUX) - DEALLOCATE(IPTS); ALLOCATE(IPTS(1:SIZE_CEELEM_FACEDG+1)) - ENDIF +FIRST_CALL_ARG=.FALSE. - IPTS(1:NIEDGE) = FACE_CELL(2:NIEDGE+1,IFACE); IPTS(NIEDGE+1) = FACE_CELL(2,IFACE) - DO IEDGE=1,NIEDGE - SEG(NOD1:NOD2)= (/ IPTS(IEDGE), IPTS(IEDGE+1) /) - INLIST = .FALSE. - DO ISEG=1,NSEG_CELL - TEST1 = (SEG_CELL(NOD1,ISEG) == SEG(NOD1)) .AND. (SEG_CELL(NOD2,ISEG) == SEG(NOD2)) - TEST2 = (SEG_CELL(NOD2,ISEG) == SEG(NOD1)) .AND. (SEG_CELL(NOD1,ISEG) == SEG(NOD2)) +END SUBROUTINE ALLOCATE_BODINT_PLANE - IF ( TEST1 .OR. TEST2 ) THEN - INLIST = .TRUE. - EXIT - ENDIF - enddo - IF (.NOT.INLIST) THEN - NSEG_CELL = NSEG_CELL + 1 +SUBROUTINE GET_BODINT_PLANE(X1AXIS,X1PLN,INDX1,PLNORMAL,X2AXIS,X3AXIS,& + X2LO,X2HI,X3LO,X3HI,X2FACE,X3FACE,X2LO_CELL,& + X2HI_CELL,X3LO_CELL,X3HI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE) - ! Test the NSEG_CELL doesn't overrun SIZE_CEELEM_EDGFAC, if so reallocate EDGFAC_CELL: - IF(NSEG_CELL > SIZE_CEELEM_EDGFAC) THEN - ! 1. EDGFAC_CELL: - ALLOCATE(EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC+DELTA_EDGE)); - EDGFAC_CELL_AUX = CC_UNDEFINED - ! Copy data into EDGFAC_CELL_AUX: - EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & - EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) - ! 1. SEG_CELL: - ALLOCATE(SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC+DELTA_EDGE)); SEG_CELL_AUX = CC_UNDEFINED - ! Copy data to SEG_CELL_AUX: - SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) = SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) +INTEGER, INTENT(IN) :: X1AXIS, X2AXIS, X3AXIS, INDX1, X2LO, X2HI, X3LO, X3HI, X2LO_CELL,& + X2HI_CELL,X3LO_CELL,X3HI_CELL +REAL(EB),INTENT(IN) :: X1PLN, PLNORMAL(MAX_DIM) +REAL(EB), ALLOCATABLE, DIMENSION(:), INTENT(IN) :: X2FACE,X3FACE +LOGICAL, INTENT(IN) :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY +TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE - ! New SIZE_CEELEM_EDGFAC: - SIZE_CEELEM_EDGFAC = SIZE_CEELEM_EDGFAC + DELTA_EDGE +! Local variables: +INTEGER :: IG, IBIN, IWSEL, IWSELDUM, IEDGE, ISGL, ISEG, ITRI, EDGE_TRI +REAL(EB):: XYZV(MAX_DIM,NODS_WSEL) +INTEGER :: ELEM(NODS_WSEL), IND_P(NODS_WSEL), NTRIS, NSEGS +REAL(EB):: DOT1, DOT2, DOT3 +LOGICAL :: INTFLG, INLIST +REAL(EB):: LN1(MAX_DIM,NOD1:NOD2), LN2(MAX_DIM,NOD1:NOD2) +REAL(EB):: XYZ_INT1(MAX_DIM), XYZ_INT2(MAX_DIM) +INTEGER :: SEG(NOD1:NOD2), EDGES(NOD1:NOD2,3), VEC3(3) +REAL(EB):: X2X3(IAXIS:JAXIS,NODS_WSEL), AREALOC +REAL(EB):: XP1(IAXIS:JAXIS), XP2(IAXIS:JAXIS), TX2P(IAXIS:JAXIS), TX3P(IAXIS:JAXIS) +REAL(EB):: NMTX2P +INTEGER :: IWSEL1, IWSEL2, ELEM1(NODS_WSEL), ELEM2(NODS_WSEL) +REAL(EB):: XYZ1(MAX_DIM), NXYZ1(MAX_DIM), NX3P1, N1(IAXIS:JAXIS), NMNL +REAL(EB):: XYZ2(MAX_DIM), NXYZ2(MAX_DIM), NX3P2, N2(IAXIS:JAXIS) +REAL(EB):: X3PVERT, PVERT(IAXIS:JAXIS), X3P1, P1CEN(IAXIS:JAXIS), X3P2, P2CEN(IAXIS:JAXIS) +INTEGER :: VCT(2) +REAL(EB):: PCT(IAXIS:JAXIS,1:2), V1(IAXIS:JAXIS), V2(IAXIS:JAXIS), CRSSNV, CTST +REAL(EB):: VEC(IAXIS:JAXIS,1:2) +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEGAUX, INDSEGAUX, SEGTYPEAUX, ISEG_NODE +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: ANGS_NODE +REAL(EB):: X3_1, X2_1, X3_2, X2_2, SLEN, SBOD +INTEGER :: INOD, ISEG_NEW, NBCROSS, NBCROSS_SVAR +REAL(EB):: DELBIN +INTEGER :: ILO_BIN, IHI_BIN - ! 2. EDGFAC_CELL: - DEALLOCATE(EDGFAC_CELL); ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) - ! Dump data back into EDGFAC_CELL: - EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & - EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) - DEALLOCATE(EDGFAC_CELL_AUX) - ! 2. SEG_CELL: - DEALLOCATE(SEG_CELL); ALLOCATE(SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC)) - ! Dump data back into SEG_CELL: - SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) = SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) - DEALLOCATE(SEG_CELL_AUX) - ENDIF - SEG_CELL(NOD1:NOD2,NSEG_CELL) = SEG(NOD1:NOD2) - NEF = 1 - EDGFAC_CELL(1,NSEG_CELL) = NEF - EDGFAC_CELL(NEF+1,NSEG_CELL)= IFACE - FACEDG_CELL(IEDGE,IFACE) = NSEG_CELL - ELSE - NEF = EDGFAC_CELL(1,ISEG) + 1 - ! Test NEF+1 doesn't overrun SIZE_CFELEM_EDGFAC, if so reallocate EDGFAC_CELL: - IF(NEF+1 > SIZE_CFELEM_EDGFAC) THEN - ALLOCATE(EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC+DELTA_FACE,1:SIZE_CEELEM_EDGFAC)); - EDGFAC_CELL_AUX = CC_UNDEFINED - ! Copy data into EDGFAC_CELL_AUX: - EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & - EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) - ! New SIZE_CFELEM_EDGFAC: - SIZE_CFELEM_EDGFAC = SIZE_CFELEM_EDGFAC + DELTA_FACE - DEALLOCATE(EDGFAC_CELL); ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) - ! Dump data back into EDGFAC_CELL: - EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & - EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) - DEALLOCATE(EDGFAC_CELL_AUX) - ENDIF - EDGFAC_CELL(1,ISEG) = NEF - EDGFAC_CELL(NEF+1,ISEG) = IFACE - FACEDG_CELL(IEDGE,IFACE) = ISEG - ENDIF - ENDDO - ENDDO +INTEGER :: AXIS, NTL, SZE, IBCR, ICROSS, IDUM, ISVAR, ISX, JJ2, KK2, BISEG, BIISEG, JJ2_LO, JJ2_HI, KK2_LO, KK2_HI +INTEGER :: VAXIS(IAXIS:JAXIS), I +REAL(EB):: LXI, MEAN_SLEN, XIV(NOD1:NOD2), XIV_LO, XIV_HI, MIN_MESHGEOM +INTEGER, ALLOCATABLE, DIMENSION(:) :: TRI_LIST, SEGS_NODE, CIRC_MED +INTEGER :: SEGV(NOD1:NOD2,EDG1:EDG2), ISEGV(EDG1:EDG2), INT_FLG, MAX_SEG_NODE, ISEG2, ISEG3, NSN, COUNT +REAL(EB):: XPOS, XY(IAXIS:JAXIS), S1_X2_MIN, S1_X3_MIN, S1_X2_MAX, S1_X3_MAX, AVAL, ANG, DX2, DX3 +REAL(EB):: D1(IAXIS:JAXIS),P1(IAXIS:JAXIS),D2(IAXIS:JAXIS),P2(IAXIS:JAXIS),SLENV(EDG1:EDG2),SVARV(NOD1:NOD2,EDG1:EDG2) +REAL(EB) :: TNOW +LOGICAL :: LO_X2_TEST, HI_X2_TEST, LO_X3_TEST, HI_X3_TEST, FOUND_SEG, CRS_FLG +CHARACTER(100) :: BIPL_FILE +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX - ! Then loop is on faces that have all regular edges, - ! that is, edges shared with only one another face: - ! Reallocate FACECELL_NUM if NFACE_CELL > SIZE(FACECELL_NUM,DIM=1): - NUM_FACE = SIZE(FACECELL_NUM,DIM=1) - IF (NFACE_CELL > NUM_FACE) THEN - DFCT = CEILING(REAL(NFACE_CELL-NUM_FACE,EB)/REAL(DELTA_FACE,EB)) - DEALLOCATE(FACECELL_NUM); ALLOCATE(FACECELL_NUM(1:NFACE_CELL+DFCT*DELTA_FACE)) - ENDIF +INTEGER :: WSELEM(NOD1:NOD3), MYAXIS +REAL(EB):: FACECUBE(LOW_IND:HIGH_IND,IAXIS:KAXIS) - FACECELL_NUM = 0 - ICELL = 1 - IFACE = 1 - NUM_FACE = NFACE_CELL - CTVAL2 = 0 - MAXSEG = MAXVAL(FACE_CELL(1,1:NFACE_CELL)) - THRES = HUGE(1); IF(REAL(MAXSEG*NFACE_CELL,EB)**2 0 ) CYCLE +! Main Loop over Geometries: +MAIN_GEOM_LOOP : DO IG=1,N_GEOMETRY - ! New face, not counted: - FACECELL_NUM(JFACE) = ICELL - NEWFACE = .TRUE. - NUM_FACE = NUM_FACE-1 - EXIT - ENDDO - ENDIF - IF (NEWFACE) THEN - IFACE = JFACE - EXIT - ENDIF - ENDDO + IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE + DELBIN = GEOMETRY(IG)%TBAXIS(X1AXIS)%DELBIN + MIN_MESHGEOM = GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(1)%X1_LOW + ILO_BIN = MAX(1,CEILING((X1PLN-GEOMEPS-MIN_MESHGEOM)/DELBIN)) + IHI_BIN = MIN(GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS,CEILING((X1PLN+GEOMEPS-MIN_MESHGEOM)/DELBIN)) - ! Test for all faces that have regular edges with faces that belong to icell: - IF (.NOT.NEWFACE) THEN - KFACE_LOOP : DO KFACE=1,NFACE_CELL - IF ( FACECELL_NUM(KFACE) == 0 ) THEN ! Not associated yet - NFACEK = FACE_CELL(1,KFACE) - DO ISEG=1,NFACEK - LOCSEG = FACEDG_CELL(ISEG,KFACE) - IF ( EDGFAC_CELL(1,LOCSEG) == 2) THEN ! Found a regular edge - DO JJ=2,EDGFAC_CELL(1,LOCSEG)+1 - JFACE = EDGFAC_CELL(JJ,LOCSEG) - IF ( KFACE == JFACE ) CYCLE - IF ( FACECELL_NUM(JFACE) /= ICELL) CYCLE - ! New face, not counted: - FACECELL_NUM(KFACE) = FACECELL_NUM(JFACE) - NEWFACE = .TRUE. - IFACE = KFACE - NUM_FACE = NUM_FACE-1 - EXIT KFACE_LOOP - ENDDO - ENDIF - ENDDO - ENDIF - ENDDO KFACE_LOOP - ENDIF + ! Find for this geometry where does the plane lay on triangle bins: + IBIN_DO : DO IBIN=ILO_BIN,IHI_BIN !1,GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS - ! Haven't found new face, either num_face=0, or we need a new icell: - IF (.NOT.NEWFACE) EXIT INF_LOOP2 - CTVAL = CTVAL + 1 - IF (CTVAL > THRES) THEN - CYCLE_CELL = .TRUE. - EXIT INF_LOOP2 - ENDIF + IF ( X1PLN < GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE + IF ( X1PLN > GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE - ENDDO INF_LOOP2 - ! Test if there are any faces left: - IF ( NUM_FACE <= 0 ) THEN - EXIT - ELSE ! New cell, find new face set iface - DO IFACE=1,NFACE_CELL - IF (FACECELL_NUM(IFACE) == 0) THEN ! NOT COUNTED YET. - ! ASSUMES IT HAS AT LEAST ONE REGULAR EDGE. - ICELL = ICELL + 1 - EXIT - ENDIF - ENDDO - IF(IFACE > NFACE_CELL) EXIT INF_LOOP1 ! Case all faces associated. - ENDIF - CTVAL2 = CTVAL2 + 1 - IF (CTVAL2 > THRES) CYCLE_CELL = .TRUE. - IF (CYCLE_CELL) EXIT INF_LOOP1 - ENDDO INF_LOOP1 + ! Loop surface triangles: +! DO IWSEL =1,GEOMETRY(IG)%N_FACES + DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL - CYCLE_CELL_COND : IF (CYCLE_CELL) THEN - CELLRT(I,J,K) = .TRUE. - MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 - ! Here if needed reallocate SPCELL_LIST: - NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) - IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN - ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) - DEALLOCATE(MESHES(NM)%SPCELL_LIST) - ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED - DEALLOCATE(SPCELL_LIST) - ENDIF - MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) - ! Add to cells to block list: - N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK + 1 - CTVAL = SIZE(SPCELLS_TO_BLOCK,DIM=1) - IF( CTVAL 0) THEN - IBOD = 1; ITRI = 1 - IF (MESHES(NM)%CUT_FACE(IDCF)%NFACE > 0) THEN - IBOD = MESHES(NM)%CUT_FACE(IDCF)%BODTRI(1,1) - ITRI = MESHES(NM)%CUT_FACE(IDCF)%BODTRI(2,1) - ENDIF - CALL FACE_DEALLOC(NM,IDCF) - CALL NEW_FACE_ALLOC(NM,IDCF,8,6,4+1) ! Reallocate CUT_FACE entry with 8 vertices, 6 faces, 4 verts per face. - NIBFACE = 0 - XYZVERT = 0._EB - NVERT_CELL = 0 - CFELEM = 0 - ! Define from SOLID FACES CFACES for the cell: - IED = I-1; JED = J-1; KED = K-1 - AXIS_LOOP : DO MYAXIS=IAXIS,KAXIS - SELECT CASE(MYAXIS) - CASE(IAXIS) - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) - AREAI = DYCELL(J) * DZCELL(K) - CASE(JAXIS) - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) - AREAI = DXCELL(I) * DZCELL(K) - CASE(KAXIS) - XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - AREAI = DXCELL(I) * DYCELL(J) - END SELECT + ! Test low-high vertices of triangle along x1axis vs plane (O(NT) operation): + IF( (FACECUBE( LOW_IND,X1AXIS)-X1PLN) > GEOMEPS) CYCLE + IF( (X1PLN-FACECUBE(HIGH_IND,X1AXIS)) > GEOMEPS) CYCLE - SIDE_LOOP : DO SIDE=LOW_IND,HIGH_IND - IF (FSID_XYZ(SIDE ,MYAXIS) /= CC_SOLID) CYCLE SIDE_LOOP - NIBFACE = NIBFACE + 1 - ! Define vertices of CFACE and insert add to MESHES(NM)%CUT_FACE(IDCF)%XYZVERT - NP = 0 - XYZC(IAXIS:KAXIS) = 0._EB - DO IP=NOD1,NOD4 - ! xl,yl,zl - XYZ(IAXIS:KAXIS) = XYZLH(IAXIS:KAXIS,IP,SIDE) - XYZC(IAXIS:KAXIS)= XYZC(IAXIS:KAXIS) + XYZ(IAXIS:KAXIS) - CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) - NP = NP + 1 - CFELEM(1) = NP - CFELEM(NP+1) = INOD - ENDDO + IF(RAYTRACE_X2_ONLY) THEN + IF( (X3LO_RT-FACECUBE(HIGH_IND,X3AXIS)) > GEOMEPS) CYCLE + IF( (FACECUBE( LOW_IND,X3AXIS)-X3HI_RT) > GEOMEPS) CYCLE + ELSE + LO_X2_TEST=(X2FACE(X2LO)-FACECUBE(HIGH_IND,X2AXIS)) > GEOMEPS + LO_X3_TEST=(X3FACE(X3LO)-FACECUBE(HIGH_IND,X3AXIS)) > GEOMEPS + IF( LO_X2_TEST .AND. LO_X3_TEST ) CYCLE + HI_X2_TEST=(FACECUBE( LOW_IND,X2AXIS)-X2FACE(X2HI)) > GEOMEPS + IF( HI_X2_TEST .AND. LO_X3_TEST ) CYCLE + HI_X3_TEST=(FACECUBE( LOW_IND,X3AXIS)-X3FACE(X3HI)) > GEOMEPS + IF( LO_X2_TEST .AND. HI_X3_TEST ) CYCLE + IF( HI_X2_TEST .AND. HI_X3_TEST ) CYCLE + ENDIF + + ! Compute simplified dot(PLNORMAL,XYZV-XYZPLANE): + DOT1 = XYZV(X1AXIS,NOD1) - X1PLN + DOT2 = XYZV(X1AXIS,NOD2) - X1PLN + DOT3 = XYZV(X1AXIS,NOD3) - X1PLN + IF ( ABS(DOT1) <= GEOMEPS ) DOT1 = 0._EB + IF ( ABS(DOT2) <= GEOMEPS ) DOT2 = 0._EB + IF ( ABS(DOT3) <= GEOMEPS ) DOT3 = 0._EB + + ! Test if IWSEL lays in X1PLN: + IF ( (ABS(DOT1)+ABS(DOT2)+ABS(DOT3)) == 0._EB ) THEN + + ! Force nodes location in X1PLN plane: + XYZV(X1AXIS,NOD1:NOD3) = X1PLN + + ! Index to point 1 of triangle in BODINT_PLANE%XYZ list: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD1),IND_P(NOD1)) + + ! Index to point 2 of triangle in BODINT_PLANE%XYZ list: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD2),IND_P(NOD2)) + + ! Index to point 3 of triangle in BODINT_PLANE%XYZ list: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZV(IAXIS:KAXIS,NOD3),IND_P(NOD3)) + + ! Do we need to test if we already have this triangle on + ! the list? Shouldn't unless repeated -> Possibility for + ! zero thickness. + NTRIS = BODINT_PLANE % NTRIS + 1 + BODINT_PLANE % NTRIS = NTRIS + BODINT_PLANE % TRIS(NOD1:NOD3,NTRIS) = IND_P + BODINT_PLANE % INDTRI(1:2,NTRIS) = (/ IWSEL, IG /) - ! Define CFELEM connectivity, also CFACE area and Centroid add to corresponding CUT_FACE(IDCF) entries. - MESHES(NM)%CUT_FACE(IDCF)%CFELEM(1:5,NIBFACE) = CFELEM(1:5) - MESHES(NM)%CUT_FACE(IDCF)%AREA(NIBFACE) = AREAI - MESHES(NM)%CUT_FACE(IDCF)%XYZCEN(IAXIS:KAXIS,NIBFACE) = 0.25_EB*XYZC(IAXIS:KAXIS) - ! Fields for cut-cell volume/centroid computation: - MESHES(NM)%CUT_FACE(IDCF)%INXAREA(NIBFACE) = 0._EB - MESHES(NM)%CUT_FACE(IDCF)%INXSQAREA(NIBFACE) = 0._EB - MESHES(NM)%CUT_FACE(IDCF)%JNYSQAREA(NIBFACE) = 0._EB - MESHES(NM)%CUT_FACE(IDCF)%KNZSQAREA(NIBFACE) = 0._EB + CYCLE ! Next WSELEM - ! Define Body-triangle reference: - MESHES(NM)%CUT_FACE(IDCF)%BODTRI(1:2,NIBFACE)= (/ IBOD, ITRI /) + ENDIF - ! Assign surf-index: Depending on GEOMETRY: - ! Here we might just add the INERT SURF_ID: - MESHES(NM)%CUT_FACE(IDCF)%SURF_INDEX(NIBFACE) = GEOMETRY(IBOD)%SURFS(ITRI) + ! Test if we are looking for intersection triangles only: + ONLY_TRIANG_EDGES_COND : IF (.NOT.TRI_ONPLANE_ONLY) THEN + ! Case a: Typical intersections: + ! Points 1,2 on on side of plane, point 3 on the other: + IF ( ((DOT1 > 0._EB) .AND. (DOT2 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT2 < 0._EB) .AND. (DOT3 > 0._EB)) ) THEN - ! Finally add to FACE_LIST from N_GAS_CFACES on: - NFACE_CELL = N_GAS_CFACES + NIBFACE - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB,0,0,IDCF, NIBFACE,CC_UNDEFINED /) - ENDDO SIDE_LOOP - ENDDO AXIS_LOOP - IF(NIBFACE==0) THEN - MESHES(NM)%CUT_FACE(IDCF)%STATUS = CC_SOLID - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED - ELSE - MESHES(NM)%CUT_FACE(IDCF)%NFACE = NIBFACE - MESHES(NM)%CUT_FACE(IDCF)%NVERT = NVERT_CELL - MESHES(NM)%CUT_FACE(IDCF)%XYZVERT(IAXIS:KAXIS,1:NVERT_CELL) = XYZVERT(IAXIS:KAXIS,1:NVERT_CELL) - ENDIF - ENDIF IDCF_COND + ! Line 1, from node 2 to 3: + LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) + LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - ! Now define a coarse cut-cell (no INBOUNDARY cut-faces): - NCELL = 1 - ! Test NFACE_CELL not > SIZE_FACE_CCELEM: - IF (NFACE_CELL > SIZE_FACE_CCELEM) THEN - DFCT = CEILING(REAL(NFACE_CELL-SIZE_FACE_CCELEM,EB)/REAL(DELTA_FACE,EB)) - SIZE_FACE_CCELEM = SIZE_FACE_CCELEM + DFCT*DELTA_FACE - DEALLOCATE(CCELEM) - ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) - ENDIF - CCELEM(1:NFACE_CELL+1,NCELL) = (/ NFACE_CELL, (IFACE, IFACE=1,NFACE_CELL) /) - VOL(NCELL) = DXCELL(I)*DYCELL(J)*DZCELL(K) - NOADVANCE(NCELL) = NOT_BLOCKED - XYZCEN(IAXIS:KAXIS,NCELL) = (/ XCELL(I), YCELL(J), ZCELL(K) /) + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) - ELSE CYCLE_CELL_COND + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - ! Create CCELEM array: - NCELL = MAXVAL(FACECELL_NUM(:)) - ! Test NCELL not > SIZE_CELL_CCELEM; NFACE_CELL not > SIZE_FACE_CCELEM: - IF (NFACE_CELL > SIZE_FACE_CCELEM) THEN - DFCT = CEILING(REAL(NFACE_CELL-SIZE_FACE_CCELEM,EB)/REAL(DELTA_FACE,EB)) - SIZE_FACE_CCELEM = SIZE_FACE_CCELEM + DFCT*DELTA_FACE - DEALLOCATE(CCELEM) - ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) - ENDIF - IF (NCELL > SIZE_CELL_CCELEM) THEN - DFCT = CEILING(REAL(NCELL-SIZE_CELL_CCELEM,EB)/REAL(DELTA_CELL,EB)) - SIZE_CELL_CCELEM = SIZE_CELL_CCELEM + DFCT*DELTA_CELL - DEALLOCATE(CCELEM,NOADVANCE,VOL,XYZCEN) - ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) - ALLOCATE(NOADVANCE(1:SIZE_CELL_CCELEM),VOL(1:SIZE_CELL_CCELEM),XYZCEN(IAXIS:KAXIS,1:SIZE_CELL_CCELEM)) - ENDIF - CCELEM= CC_UNDEFINED - DO ICELL=1,NCELL - NP = 0 - DO IFACE=1,NFACE_CELL - IF ( FACECELL_NUM(IFACE) == ICELL ) THEN - NP = NP + 1 - CCELEM(1,ICELL) = NP - CCELEM(NP+1,ICELL) = IFACE - ENDIF - ENDDO - ENDDO + ! Line 2, from node 1 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - ! Compute volumes and centroids for the found cut-cells: - VOL(1:NCELL) = 0._EB - NOADVANCE(1:NCELL) = NOT_BLOCKED - XYZCEN(IAXIS:KAXIS,1:NCELL) = 0._EB - DO ICELL=1,NCELL - NP = CCELEM(1,ICELL) - DO II=2,NP+1 - IFACE = CCELEM(II,ICELL) - ! Volume: - VOL(ICELL) = VOL(ICELL) + AREAVARS(1,IFACE) - ! xyzcen: - XYZCEN(IAXIS:KAXIS,ICELL) = XYZCEN(IAXIS:KAXIS,ICELL)+AREAVARS(2:4,IFACE) - ENDDO - VOL(ICELL) = ABS(VOL(ICELL)) + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) - ! Define if cut-cell is very small -> NOADVANCE(ICELL)=BLOCKED_SMALL_CELL: - IF(DO_NOADVANCE .AND. VOL(ICELL)/(DXCELL(I)*DYCELL(J)*DZCELL(K))DXCELL(I)*DYCELL(J)*DZCELL(K)) VOL(ICELL) = DXCELL(I)*DYCELL(J)*DZCELL(K) - IF(VOL(ICELL) < GEOMEPS) THEN ! Volume too small for correct calculation of XYZCEN-> take cartcell centroid. - IF(.NOT.DO_NOADVANCE .AND. VOL(ICELL)XFACE(I)) XYZCEN(IAXIS,ICELL) = XCELL(I) - IF(XYZCEN(JAXIS,ICELL)YFACE(J)) XYZCEN(JAXIS,ICELL) = YCELL(J) - IF(XYZCEN(KAXIS,ICELL)ZFACE(K)) XYZCEN(KAXIS,ICELL) = ZCELL(K) - ENDIF - ENDDO + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) - ENDIF CYCLE_CELL_COND + ! Now add segment: + NSEGS = BODINT_PLANE % NSEGS + 1 + BODINT_PLANE % NSEGS = NSEGS + IF ( DOT1 > 0._EB ) THEN ! First case, counterclockwise p1 to p2 + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) + ENDIF + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) - ! Load into CUT_CELL data structure - NCUTCELL = MESHES(NM)%N_CUTCELL_MESH + MESHES(NM)%N_GCCUTCELL_MESH + 1 - IF (IBNDINT==LOW_IND) THEN - MESHES(NM)%N_CUTCELL_MESH = NCUTCELL - ELSE - MESHES(NM)%N_GCCUTCELL_MESH = MESHES(NM)%N_GCCUTCELL_MESH + 1 - ENDIF - MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = NCUTCELL + CYCLE ! Next WSELEM - ! Resize array MESHES(NM)%CUT_CELL if necessary: - CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) + ENDIF + ! Points 2,3 on one side of plane, point 1 on the other: + IF ( ((DOT2 > 0._EB) .AND. (DOT3 > 0._EB) .AND. (DOT1 < 0._EB)) .OR. & + ((DOT2 < 0._EB) .AND. (DOT3 < 0._EB) .AND. (DOT1 > 0._EB)) ) THEN - ! Add cut-cell NCUTCELL entry: - MESHES(NM)%CUT_CELL(NCUTCELL)%IJK(IAXIS:KAXIS) = (/ I, J, K /) - MESHES(NM)%CUT_CELL(NCUTCELL)%NCELL = NCELL - MESHES(NM)%CUT_CELL(NCUTCELL)%NFACE_CELL= NFACE_CELL - NCFACE_CUTCELL = MAXVAL(CCELEM(1,1:NCELL)) + 1 - CALL NEW_CELL_ALLOC(NM,NCUTCELL,NCELL,NFACE_CELL,NCFACE_CUTCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%CCELEM(1:NCFACE_CUTCELL,1:NCELL) = CCELEM(1:NCFACE_CUTCELL,1:NCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) = & - FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%VOLUME(1:NCELL) = VOL(1:NCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%XYZCEN(IAXIS:KAXIS,1:NCELL) = XYZCEN(IAXIS:KAXIS,1:NCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%NOADVANCE(1:NCELL) = NOADVANCE(1:NCELL) + ! Line 1, from node 1 to 2: + LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) - ! Test for sliver cells blocking: - XYZCELL(IAXIS,LOW_IND) = XFACE(I-1); XYZCELL(IAXIS,HIGH_IND) = XFACE(I); - XYZCELL(JAXIS,LOW_IND) = YFACE(J-1); XYZCELL(JAXIS,HIGH_IND) = YFACE(J); - XYZCELL(KAXIS,LOW_IND) = ZFACE(K-1); XYZCELL(KAXIS,HIGH_IND) = ZFACE(K); - MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) - MINMAX_XYZ_CC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) - DO JCC=1,NCELL - ! Get cut-cell bounding box: - CALL CUT_CELL_BOUNDING_BOX(NM,NCUTCELL,JCC,XYZCELL,MINMAX_XYZ_CC) - ! Perform Tests: - DO MYAXIS=IAXIS,KAXIS - CELL_DELTA(MYAXIS) = ABS(MINMAX_XYZ_CC(MYAXIS,HIGH_IND)-MINMAX_XYZ_CC(MYAXIS,LOW_IND)) - ENDDO - ! Axis with minimum width: - AX_MIN = MINLOC(CELL_DELTA(IAXIS:KAXIS),DIM=1) - SELECT CASE(AX_MIN) - CASE(IAXIS); AX_OTHERS(1:2) = (/ JAXIS, KAXIS /); - CASE(JAXIS); AX_OTHERS(1:2) = (/ IAXIS, KAXIS /); - CASE(KAXIS); AX_OTHERS(1:2) = (/ IAXIS, JAXIS /); - END SELECT - ! Perform Test: - BLOCK_SLIM_IF = (CELL_DELTA(AX_MIN) 0._EB ) THEN ! Second case, counterclockwise p2 to p1 + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + ENDIF + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - NCUTCEL = 0 - DO ICELL=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - NCUTCEL = NCUTCEL + MESHES(NM)%CUT_CELL(ICELL)%NCELL - ENDDO - WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-cells mesh/gc : ',NCUTCEL,'. ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & - ' sec. Cut-cells mesh/gc : ',NCUTCEL,'. ' - ENDIF -ENDIF + CYCLE ! Next WSELEM -RETURN + ENDIF + ! Points 1,3 on one side of plane, point 2 on the other: + IF ( ((DOT1 > 0._EB) .AND. (DOT3 > 0._EB) .AND. (DOT2 < 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT3 < 0._EB) .AND. (DOT2 > 0._EB)) ) THEN -CONTAINS + ! Line 1, from node 1 to 2: + LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) -SUBROUTINE REALLOCATE_LOCAL_FC_VARS + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) -IF (NFACE_CELL > SIZE_CFELEM_FC) THEN - ! FACE_LIST, AREAVARS, FACE_CELL - ALLOCATE(FACE_LIST_AUX(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC+DELTA_FACE)); - FACE_LIST_AUX=CC_UNDEFINED - ALLOCATE(AREAVARS_AUX(1:MAX_DIM+1,1:SIZE_CFELEM_FC+DELTA_FACE)); AREAVARS_AUX = 0._EB - ALLOCATE(FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC+DELTA_FACE)); - FACE_CELL_AUX=CC_UNDEFINED - ! Assign: - FACE_LIST_AUX(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)= & - FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC) - AREAVARS_AUX(1:MAX_DIM+1,1:SIZE_CFELEM_FC) = AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC) - FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) = & - FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) - ! Reallocate: - SIZE_CFELEM_FC = SIZE_CFELEM_FC + DELTA_FACE - DEALLOCATE(FACE_LIST,AREAVARS,FACE_CELL); - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)) - ALLOCATE(AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC)) - ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) - ! Dump back data: - FACE_LIST(:,:) = FACE_LIST_AUX(:,:) - AREAVARS(:,:) = AREAVARS_AUX(:,:) - FACE_CELL(:,:) = FACE_CELL_AUX(:,:) - DEALLOCATE(FACE_LIST_AUX,AREAVARS_AUX,FACE_CELL_AUX) -ENDIF -RETURN -END SUBROUTINE REALLOCATE_LOCAL_FC_VARS + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -SUBROUTINE REALLOCATE_FACE_CELL_VERTS + ! Line 2, from node 2 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) -IF (NP+1 > SIZE_VERTS_FC) THEN - DFCT=CEILING(REAL(NP+1-SIZE_VERTS_FC,EB)/REAL(DELTA_VERT,EB)) - ALLOCATE(FACE_CELL_AUX(1:SIZE_VERTS_FC+DFCT*DELTA_VERT,1:SIZE_CFELEM_FC)); - FACE_CELL_AUX=CC_UNDEFINED - ! Assign: - FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) = & - FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) - ! Reallocate: - SIZE_VERTS_FC = SIZE_VERTS_FC + DFCT*DELTA_VERT - DEALLOCATE(FACE_CELL); ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) - FACE_CELL(:,:) = FACE_CELL_AUX(:,:) - DEALLOCATE(FACE_CELL_AUX) - ! Now FACE_CELL_DUM: - DEALLOCATE(FACE_CELL_DUM); ALLOCATE(FACE_CELL_DUM(1:SIZE_VERTS_FC)) -ENDIF + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) -RETURN -END SUBROUTINE REALLOCATE_FACE_CELL_VERTS + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -END SUBROUTINE GET_CARTCELL_CUTCELLS + ! Now add segment: + NSEGS = BODINT_PLANE % NSEGS + 1 + BODINT_PLANE % NSEGS = NSEGS + IF ( DOT1 > 0._EB ) THEN ! Third case, counterclockwise p1 to p2 + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) + ENDIF + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) + CYCLE ! Next WSELEM -! ------------------------ CUT_CELL_BOUNDING_BOX ------------------------------------ + ENDIF -SUBROUTINE CUT_CELL_BOUNDING_BOX(NM,ICC,JCC,XYZCELL,MINMAX_XYZ_JCC) + ! Case b: only one point intersection. They will be used to define + ! Solid vertex points in case of coincidence. + ! Point 1 is on the plane: + IF ( (DOT1 == 0._EB) .AND. ( ((DOT2 > 0._EB) .AND. (DOT3 > 0._EB)) .OR. & + ((DOT2 < 0._EB) .AND. (DOT3 < 0._EB)) ) ) THEN -! Computes bounding box for cut-cell (ICC,JCC) in mesh NM. -! Underlaying cartesian cell bounds XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND) has to be provided. + ! First node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN -INTEGER, INTENT(IN) :: NM,ICC,JCC -REAL(EB),INTENT(IN) :: XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND) -REAL(EB),INTENT(OUT):: MINMAX_XYZ_JCC(IAXIS:KAXIS,LOW_IND:HIGH_IND) + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -! Local Variables: -INTEGER :: IFC,IFACE,LOHI,HILO,X1AXIS,IFCX,JFCX,IVERT,AXIS -REAL(EB):: XYZFACE(IAXIS:KAXIS,LOW_IND:HIGH_IND),XYZ(IAXIS:KAXIS) -TYPE(CC_CUTCELL_TYPE), POINTER :: CC -TYPE(CC_CUTFACE_TYPE), POINTER :: CF + ! Add index to singles: + ! Find if oriented segment is in list: + INLIST = .FALSE. + DO ISGL=1,BODINT_PLANE%NSGLS + IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + ISGL = BODINT_PLANE%NSGLS + 1 + BODINT_PLANE % NSGLS = ISGL + BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) + ENDIF -CC => MESHES(NM)%CUT_CELL(ICC) + CYCLE ! Next WSELEM -! Get cut-cell bounding box: -MINMAX_XYZ_JCC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) -MINMAX_XYZ_JCC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) -DO IFC=1,CC%CCELEM(1,JCC) ! Loop over cut-faces boundary of this cell. - IFACE=CC%CCELEM(IFC+1,JCC) - LOHI = CC%FACE_LIST(2,IFACE) - HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND - X1AXIS = CC%FACE_LIST(3,IFACE) - IFCX = CC%FACE_LIST(4,IFACE) - JFCX = CC%FACE_LIST(5,IFACE) + ENDIF + ! Point 2 is on the plane: + IF ( (DOT2 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT3 > 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT3 < 0._EB)) ) ) THEN - SELECT CASE(CC%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_RCGAS) ! Regular Gas face with a regular cell on one side and a cut-cell on the other. - XYZFACE = XYZCELL; XYZFACE(X1AXIS,HILO) = XYZFACE(X1AXIS,LOHI) ! Same location in X1AXIS for both sides of face. - DO AXIS=IAXIS,KAXIS - MINMAX_XYZ_JCC(AXIS,LOW_IND) = MIN(MINMAX_XYZ_JCC(AXIS,LOW_IND) ,XYZFACE(AXIS,LOW_IND)) - MINMAX_XYZ_JCC(AXIS,HIGH_IND)= MAX(MINMAX_XYZ_JCC(AXIS,HIGH_IND),XYZFACE(AXIS,HIGH_IND)) - ENDDO + ! Second node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN - CASE(CC_FTYPE_CFGAS,CC_FTYPE_CFINB) ! GAS or Boundary cut-face: - CF => MESHES(NM)%CUT_FACE(IFCX) - DO IVERT=1,CF%CFELEM(1,JFCX) - XYZ(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(IVERT+1,JFCX)) - DO AXIS=IAXIS,KAXIS - MINMAX_XYZ_JCC(AXIS,LOW_IND) = MIN(MINMAX_XYZ_JCC(AXIS,LOW_IND) ,XYZ(AXIS)) - MINMAX_XYZ_JCC(AXIS,HIGH_IND)= MAX(MINMAX_XYZ_JCC(AXIS,HIGH_IND),XYZ(AXIS)) - ENDDO - ENDDO + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - END SELECT -ENDDO + ! Add index to singles: + ! Find if oriented segment is in list: + INLIST = .FALSE. + DO ISGL=1,BODINT_PLANE%NSGLS + IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + ISGL = BODINT_PLANE%NSGLS + 1 + BODINT_PLANE % NSGLS = ISGL + BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) + ENDIF -END SUBROUTINE CUT_CELL_BOUNDING_BOX + CYCLE ! Next WSELEM + ENDIF + ! Point 3 is on the plane: + IF ( (DOT3 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT2 > 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT2 < 0._EB)) ) ) THEN -! -------------------------CUT_CELL_ARRAY_REALLOC------------------------------------ + ! Third node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN -SUBROUTINE CUT_CELL_ARRAY_REALLOC(NM,ICC) + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -INTEGER, INTENT(IN) :: NM,ICC + ! Add index to singles: + ! Find if single element is in list: + INLIST = .FALSE. + DO ISGL=1,BODINT_PLANE%NSGLS + IF (BODINT_PLANE%SGLS(NOD1,ISGL) == IND_P(NOD1)) THEN + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + ISGL = BODINT_PLANE%NSGLS + 1 + BODINT_PLANE % NSGLS = ISGL + BODINT_PLANE % SGLS(NOD1,ISGL) = IND_P(NOD1) + ENDIF -! Local Variables: -INTEGER :: ICC1,SIZE_CUT_CELL + CYCLE ! Next WSELEM -! Here test if we need to reallocate cut-cell: -SIZE_CUT_CELL = SIZE(MESHES(NM)%CUT_CELL,DIM=1) -IF (ICC > SIZE_CUT_CELL) THEN - ALLOCATE(CUT_CELL_AUX(SIZE_CUT_CELL+GLOBAL_DELTA_CELL)) - DO ICC1=1,ICC-1 - CALL CUT_CELL_MOVE(MESHES(NM)%CUT_CELL(ICC1),CUT_CELL_AUX(ICC1)) - ENDDO - CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL) -ENDIF + ENDIF -RETURN -END SUBROUTINE CUT_CELL_ARRAY_REALLOC + ! Case c: one node is part of the intersection: + ! Node 1 is in the plane: + IF ( (DOT1 == 0._EB) .AND. ( ((DOT2 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & + ((DOT2 < 0._EB) .AND. (DOT3 > 0._EB)) ) ) THEN -! ------------------------ CUT_CELL_MOVE ----------------------------------- + ! First node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN -SUBROUTINE CUT_CELL_MOVE(CUT_CELL_FROM,CUT_CELL_TO) + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -TYPE(CC_CUTCELL_TYPE), INTENT(INOUT) :: CUT_CELL_FROM,CUT_CELL_TO + ! Line 2, from node 2 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) -CUT_CELL_TO%NCELL = CUT_CELL_FROM%NCELL -CUT_CELL_TO%NFACE_CELL = CUT_CELL_FROM%NFACE_CELL -CUT_CELL_TO%NFACE_DROPPED = CUT_CELL_FROM%NFACE_DROPPED -CUT_CELL_TO%IJK = CUT_CELL_FROM%IJK + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%CCELEM ,TO=CUT_CELL_TO%CCELEM) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%FACE_LIST ,TO=CUT_CELL_TO%FACE_LIST) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%FACE_LIST_DROPPED,TO=CUT_CELL_TO%FACE_LIST_DROPPED) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%IJK_LINK ,TO=CUT_CELL_TO%IJK_LINK) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%LINK_LEV ,TO=CUT_CELL_TO%LINK_LEV) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%VOLUME ,TO=CUT_CELL_TO%VOLUME) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%XYZCEN ,TO=CUT_CELL_TO%XYZCEN) + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHO ,TO=CUT_CELL_TO%RHO) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHOS ,TO=CUT_CELL_TO%RHOS) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RSUM ,TO=CUT_CELL_TO%RSUM) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%TMP ,TO=CUT_CELL_TO%TMP) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%D ,TO=CUT_CELL_TO%D) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DS ,TO=CUT_CELL_TO%DS) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DVOL ,TO=CUT_CELL_TO%DVOL) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DVOL_PR ,TO=CUT_CELL_TO%DVOL_PR) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%Q ,TO=CUT_CELL_TO%Q) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%QR ,TO=CUT_CELL_TO%QR) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%D_SOURCE ,TO=CUT_CELL_TO%D_SOURCE) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%CHI_R ,TO=CUT_CELL_TO%CHI_R) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%MIX_TIME ,TO=CUT_CELL_TO%MIX_TIME) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%Q_REAC ,TO=CUT_CELL_TO%Q_REAC) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%REAC_SOURCE_TERM ,TO=CUT_CELL_TO%REAC_SOURCE_TERM) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%ZZ ,TO=CUT_CELL_TO%ZZ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%ZZS ,TO=CUT_CELL_TO%ZZS) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%M_DOT_PPP ,TO=CUT_CELL_TO%M_DOT_PPP) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%UNKH ,TO=CUT_CELL_TO%UNKH) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%UNKZ ,TO=CUT_CELL_TO%UNKZ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%KRES ,TO=CUT_CELL_TO%KRES) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%H ,TO=CUT_CELL_TO%H) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%HS ,TO=CUT_CELL_TO%HS) + ! Now add segment: + NSEGS = BODINT_PLANE % NSEGS + 1 + BODINT_PLANE % NSEGS = NSEGS + IF ( DOT2 > 0._EB ) THEN ! Second case, counterclockwise p2 to p1 + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + ENDIF + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RTRM ,TO=CUT_CELL_TO%RTRM) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%R_H_G ,TO=CUT_CELL_TO%R_H_G) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%RHO_0 ,TO=CUT_CELL_TO%RHO_0) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%WVEL ,TO=CUT_CELL_TO%WVEL) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DDDTVOL ,TO=CUT_CELL_TO%DDDTVOL) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DELTA_RHO ,TO=CUT_CELL_TO%DELTA_RHO) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DELTA_RHO_ZZ ,TO=CUT_CELL_TO%DELTA_RHO_ZZ) + CYCLE ! Next WSELEM -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_IJK ,TO=CUT_CELL_TO%INT_IJK ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_COEF ,TO=CUT_CELL_TO%INT_COEF ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_XYZBF ,TO=CUT_CELL_TO%INT_XYZBF ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NOUT ,TO=CUT_CELL_TO%INT_NOUT ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_INBFC ,TO=CUT_CELL_TO%INT_INBFC ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NPE ,TO=CUT_CELL_TO%INT_NPE ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_XN ,TO=CUT_CELL_TO%INT_XN ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_CN ,TO=CUT_CELL_TO%INT_CN ) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_CCVARS ,TO=CUT_CELL_TO%INT_CCVARS) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%INT_NOMIND ,TO=CUT_CELL_TO%INT_NOMIND) + ENDIF + ! Node 2 is in the plane: + IF ( (DOT2 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT3 < 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT3 > 0._EB)) ) ) THEN -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DEL_RHO_D_DEL_Z_VOL ,TO=CUT_CELL_TO%DEL_RHO_D_DEL_Z_VOL) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%U_DOT_DEL_RHO_Z_VOL ,TO=CUT_CELL_TO%U_DOT_DEL_RHO_Z_VOL) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%NOADVANCE ,TO=CUT_CELL_TO%NOADVANCE) -CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%NOMICC ,TO=CUT_CELL_TO%NOMICC) + ! Second node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN -RETURN -END SUBROUTINE CUT_CELL_MOVE + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -! ------------------------- CELL_DEALLOC ----------------------------------- + ! Line 2, from node 1 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) -SUBROUTINE CELL_DEALLOC(NM,ICC) + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) -INTEGER, INTENT(IN) :: NM,ICC + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -MESHES(NM)%CUT_CELL(ICC)%NCELL = 0 -IF (.NOT.ALLOCATED(MESHES(NM)%CUT_CELL(ICC)%CCELEM)) RETURN + ! Now add segment: + NSEGS = BODINT_PLANE % NSEGS + 1 + BODINT_PLANE % NSEGS = NSEGS + IF ( DOT1 > 0._EB ) THEN + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) + ENDIF + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) -! Deallocate ICC entries: -DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%CCELEM) -DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST) -DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%IJK_LINK,MESHES(NM)%CUT_CELL(ICC)%LINK_LEV) -DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%VOLUME, MESHES(NM)%CUT_CELL(ICC)%XYZCEN) -DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%NOADVANCE,MESHES(NM)%CUT_CELL(ICC)%UNKZ) + CYCLE ! Next WSELEM -RETURN + ENDIF + ! Node 3 is in the plane: + IF ( (DOT3 == 0._EB) .AND. ( ((DOT1 > 0._EB) .AND. (DOT2 < 0._EB)) .OR. & + ((DOT1 < 0._EB) .AND. (DOT2 > 0._EB)) ) ) THEN -END SUBROUTINE CELL_DEALLOC + ! Third node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN -! -------------------------- NEW_CELL_ALLOC ------------------------------------- + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -SUBROUTINE NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + ! Line 2, from node 1 to 2: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) -INTEGER, INTENT(IN) :: NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) -! Allocate ICC entries: -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%CCELEM(1:NCFACE_CUTCELL,1:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%IJK_LINK(IAXIS:KAXIS+2,1:NCELL),MESHES(NM)%CUT_CELL(ICC)%LINK_LEV(1:NCELL)) -MESHES(NM)%CUT_CELL(ICC)%CCELEM = CC_UNDEFINED -MESHES(NM)%CUT_CELL(ICC)%FACE_LIST = CC_UNDEFINED -MESHES(NM)%CUT_CELL(ICC)%IJK_LINK = CC_UNDEFINED -MESHES(NM)%CUT_CELL(ICC)%LINK_LEV = 0 ! Root of link Hierarchy is zero. + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%VOLUME(1:NCELL),MESHES(NM)%CUT_CELL(ICC)%NOADVANCE(1:NCELL)) -MESHES(NM)%CUT_CELL(ICC)%VOLUME = 0._EB -MESHES(NM)%CUT_CELL(ICC)%NOADVANCE= NOT_BLOCKED + ! Now add segment: + NSEGS = BODINT_PLANE % NSEGS + 1 + BODINT_PLANE % NSEGS = NSEGS + IF ( DOT1 > 0._EB ) THEN + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD2), IND_P(NOD1) /) + ELSE + BODINT_PLANE%SEGS(NOD1:NOD2,NSEGS) = (/ IND_P(NOD1), IND_P(NOD2) /) + ENDIF + BODINT_PLANE%INDSEG(1:4,NSEGS) = (/ 1, IWSEL, 0, IG /) + BODINT_PLANE%SEGTYPE(1:2,NSEGS)= (/ CC_SOLID, CC_GASPHASE /) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,1:NCELL)) -MESHES(NM)%CUT_CELL(ICC)%XYZCEN = 0._EB -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%UNKZ(1:NCELL)); MESHES(NM)%CUT_CELL(ICC)%UNKZ = CC_UNDEFINED -RETURN -END SUBROUTINE NEW_CELL_ALLOC + CYCLE ! Next WSELEM + ENDIF + ENDIF ONLY_TRIANG_EDGES_COND -! -------------------------- ALLOC_CELL_STATE_VARS ------------------------------------- + ! Case D: A triangle segment is in the plane. + ! Intersection is line 1-2: + IF ( (DOT1 == 0._EB) .AND. (DOT2 == 0._EB) ) THEN -SUBROUTINE ALLOC_CELL_STATE_VARS(NM,ICC,NCELL) + ! First node: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN -INTEGER, INTENT(IN) :: NM,ICC,NCELL + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -! Allocate ICC entries: -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%RHO(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%RHOS(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%RSUM(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%TMP(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%D(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%DVOL(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%DVOL_PR(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%Q(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%QR(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%D_SOURCE(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%CHI_R(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%DS(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%MIX_TIME(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%H(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%HS(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%RTRM(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%R_H_G(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%RHO_0(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%WVEL(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%KRES(1:NCELL), MESHES(NM)%CUT_CELL(ICC)%DDDTVOL(1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%DELTA_RHO(1:NCELL),MESHES(NM)%CUT_CELL(ICC)%DELTA_RHO_ZZ(1:NCELL)) + ! Second node: + XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT2(X1AXIS) = X1PLN -MESHES(NM)%CUT_CELL(ICC)%RHO = 0._EB -MESHES(NM)%CUT_CELL(ICC)%RHOS = 0._EB -MESHES(NM)%CUT_CELL(ICC)%RSUM = 0._EB -MESHES(NM)%CUT_CELL(ICC)%TMP = 0._EB -MESHES(NM)%CUT_CELL(ICC)%D = 0._EB -MESHES(NM)%CUT_CELL(ICC)%DS = 0._EB -MESHES(NM)%CUT_CELL(ICC)%DVOL = 0._EB -MESHES(NM)%CUT_CELL(ICC)%DVOL_PR = 0._EB -MESHES(NM)%CUT_CELL(ICC)%Q = 0._EB -MESHES(NM)%CUT_CELL(ICC)%QR = 0._EB -MESHES(NM)%CUT_CELL(ICC)%D_SOURCE = 0._EB -MESHES(NM)%CUT_CELL(ICC)%CHI_R = 0._EB -MESHES(NM)%CUT_CELL(ICC)%MIX_TIME = 0._EB -MESHES(NM)%CUT_CELL(ICC)%KRES = 0._EB -MESHES(NM)%CUT_CELL(ICC)%H = 0._EB -MESHES(NM)%CUT_CELL(ICC)%HS = 0._EB -MESHES(NM)%CUT_CELL(ICC)%RTRM = 0._EB -MESHES(NM)%CUT_CELL(ICC)%R_H_G = 0._EB -MESHES(NM)%CUT_CELL(ICC)%RHO_0 = 0._EB -MESHES(NM)%CUT_CELL(ICC)%WVEL = 0._EB -MESHES(NM)%CUT_CELL(ICC)%DDDTVOL = 0._EB -MESHES(NM)%CUT_CELL(ICC)%DELTA_RHO= 0._EB -MESHES(NM)%CUT_CELL(ICC)%DELTA_RHO_ZZ= 0._EB + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%Q_REAC(1:N_REACTIONS,1:NCELL)) -MESHES(NM)%CUT_CELL(ICC)%Q_REAC = 0._EB + ! Set oriented segment regarding plane: + IF ( DOT3 > 0._EB ) THEN + SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) + ENDIF + ! Find if oriented segment is in list: + EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG1,IWSEL) ! 1st edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. + VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) + VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) + VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) + INLIST = .FALSE. + DO ISEG=1,BODINT_PLANE%NSEGS + FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & + ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) + IF ( FOUND_SEG .AND. & + (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & + (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & + (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + ISEG = BODINT_PLANE%NSEGS + 1 + BODINT_PLANE%NSEGS = ISEG + BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG + BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) + ENDIF -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%REAC_SOURCE_TERM(1:N_TOTAL_SCALARS,1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%ZZ(1:N_TOTAL_SCALARS,1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%ZZS(1:N_TOTAL_SCALARS,1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%M_DOT_PPP(1:N_TOTAL_SCALARS,1:NCELL)) -MESHES(NM)%CUT_CELL(ICC)%REAC_SOURCE_TERM = 0._EB -MESHES(NM)%CUT_CELL(ICC)%ZZ = 0._EB -MESHES(NM)%CUT_CELL(ICC)%ZZS = 0._EB -MESHES(NM)%CUT_CELL(ICC)%M_DOT_PPP = 0._EB + CYCLE ! Next WSELEM -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%UNKH(1:NCELL)); MESHES(NM)%CUT_CELL(ICC)%UNKH = CC_UNDEFINED -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_IJK(IAXIS:KAXIS,(NCELL+1)*DELTA_INT)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_COEF((NCELL+1)*DELTA_INT)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_XYZBF(IAXIS:KAXIS,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_NOUT(IAXIS:KAXIS,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_INBFC(1:3,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_NPE(LOW_IND:HIGH_IND,0:KAXIS,1:INT_N_EXT_PTS,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_XN(0:INT_N_EXT_PTS,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_CN(0:INT_N_EXT_PTS,0:NCELL)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_CCVARS(1:N_INT_FVARS,(NCELL+1)*DELTA_INT)) -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%INT_NOMIND(LOW_IND:HIGH_IND,(NCELL+1)*DELTA_INT)) + ENDIF + ! Intersection is line 2-3: + IF ( (DOT2 == 0._EB) .AND. (DOT3 == 0._EB) ) THEN -MESHES(NM)%CUT_CELL(ICC)%INT_IJK = CC_UNDEFINED -MESHES(NM)%CUT_CELL(ICC)%INT_COEF = 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_XYZBF = 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_NOUT = 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_INBFC = CC_UNDEFINED -MESHES(NM)%CUT_CELL(ICC)%INT_NPE = 0 -MESHES(NM)%CUT_CELL(ICC)%INT_XN = 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_CN = 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_CCVARS= 0._EB -MESHES(NM)%CUT_CELL(ICC)%INT_NOMIND= CC_UNDEFINED + ! Second node: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN + + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) + + ! Third node: + XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT2(X1AXIS) = X1PLN + + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) + + ! Set oriented segment regarding plane: + IF ( DOT1 > 0._EB ) THEN + SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) + ENDIF + ! Find if oriented segment is in list: + EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG2,IWSEL) ! 2nd edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. + VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) + VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) + VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) + INLIST = .FALSE. + DO ISEG=1,BODINT_PLANE%NSEGS + FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & + ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) + IF ( FOUND_SEG .AND. & + (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & + (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & + (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + ISEG = BODINT_PLANE%NSEGS + 1 + BODINT_PLANE%NSEGS = ISEG + BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG + BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) + ENDIF -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%DEL_RHO_D_DEL_Z_VOL(1:N_TOTAL_SCALARS,1:NCELL), & - MESHES(NM)%CUT_CELL(ICC)%U_DOT_DEL_RHO_Z_VOL(1:N_TOTAL_SCALARS,1:NCELL)) -MESHES(NM)%CUT_CELL(ICC)%DEL_RHO_D_DEL_Z_VOL = 0._EB; MESHES(NM)%CUT_CELL(ICC)%U_DOT_DEL_RHO_Z_VOL = 0._EB + CYCLE ! Next WSELEM -RETURN + ENDIF + ! Intersection is line 3-1: + IF ( (DOT3 == 0._EB) .AND. (DOT1 == 0._EB) ) THEN -END SUBROUTINE ALLOC_CELL_STATE_VARS + ! Third node: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -! ------------------------ GET_TRIANG_FACE_INT ---------------------------------- + ! First node: + XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT2(X1AXIS) = X1PLN -SUBROUTINE GET_TRIANG_FACE_INT(X2AXIS,X3AXIS,FVERT,CEI,NM, & - INB_FLG,NVERT,XYVERT,NEDGE,CEELEM,INDSEG) + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -INTEGER, INTENT(IN) :: X2AXIS, X3AXIS, CEI, NM -REAL(EB), INTENT(IN) :: FVERT(IAXIS:JAXIS,NOD1:NOD4) -LOGICAL, INTENT(OUT):: INB_FLG -INTEGER, INTENT(OUT):: NVERT,NEDGE,CEELEM(NOD1:NOD2,1:CC_MAXCEELEM_FACE) -INTEGER, INTENT(OUT):: INDSEG(CC_MAX_WSTRIANG_SEG+3,CC_MAXCEELEM_FACE) -REAL(EB), INTENT(OUT):: XYVERT(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) + ! Set oriented segment regarding plane: + IF ( DOT2 > 0._EB ) THEN + SEG(NOD1:NOD2) = (/ IND_P(NOD1), IND_P(NOD2) /) + ELSE + SEG(NOD1:NOD2) = (/ IND_P(NOD2), IND_P(NOD1) /) + ENDIF + ! Find if oriented segment is in list: + EDGE_TRI= GEOMETRY(IG)%FACE_EDGES(EDG3,IWSEL) ! 3rd edge: Ed1 NOD1-NOD2, Ed2 NOD2-NOD3, Ed3 NOD3-NOD1. + VEC3(1) = GEOMETRY(IG)%EDGE_FACES(1,EDGE_TRI) + VEC3(2) = GEOMETRY(IG)%EDGE_FACES(2,EDGE_TRI) + VEC3(3) = GEOMETRY(IG)%EDGE_FACES(4,EDGE_TRI) + INLIST = .FALSE. + DO ISEG=1,BODINT_PLANE%NSEGS + FOUND_SEG = ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD1)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD2))) .OR. & + ((BODINT_PLANE%SEGS(NOD1,ISEG) == SEG(NOD2)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == SEG(NOD1))) + IF ( FOUND_SEG .AND. & + (BODINT_PLANE%INDSEG(2,ISEG) == VEC3(2)) .AND. & + (BODINT_PLANE%INDSEG(3,ISEG) == VEC3(3)) .AND. & + (BODINT_PLANE%INDSEG(4,ISEG) == IG) ) THEN + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + ISEG = BODINT_PLANE%NSEGS + 1 + BODINT_PLANE%NSEGS = ISEG + BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) = SEG + BODINT_PLANE%INDSEG(1:4,ISEG) = (/ VEC3(1), VEC3(2), VEC3(3), IG /) + ENDIF -! Local Variables: -REAL(EB) :: X2FMIN, X2FMAX, X3FMIN, X3FMAX, DUMMY(IAXIS:JAXIS) -INTEGER :: SEG(NOD1:NOD2), TRI(NOD1:NOD3), ITRI, INOD -LOGICAL :: INTEST, OUTX2, OUTX3, OUTFACE, TRUETHAT, XIALIGNED, OUTSEG, SEG_IN_SIDE -INTEGER :: TSEGS(NOD1:NOD2,EDG1:EDG3) -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FVERT_IN_TRIANG, TRIVERT_IN_FACE -INTEGER :: NFVERT, NTVERT, NINTP -INTEGER :: TRINODS(CC_MAXVERTS_FACE) -REAL(EB) :: ATANTRI(1:CC_MAXVERTS_FACE+1), ATTRI -INTEGER :: II(1:CC_MAXVERTS_FACE+1), INTP, IINS, IDUM, INP, NINTP_TRI, IPT, JPL, IEDGE, IPF, ISEG -INTEGER :: LOCTRI, LOCBOD, EDGETRI(NOD1:NOD2,1:CC_MAXCEELEM_FACE), VEC3(1:3) -REAL(EB) :: XY1(IAXIS:JAXIS), XY2(IAXIS:JAXIS), XP1(IAXIS:JAXIS), XP2(IAXIS:JAXIS) -REAL(EB) :: XP(IAXIS:JAXIS), FD(1:2), VEC(IAXIS:JAXIS) -INTEGER :: MYAXIS, XIAXIS, XJAXIS -REAL(EB) :: XIPLNS(LOW_IND:HIGH_IND), XJPLNS(LOW_IND:HIGH_IND), DOT1, DOT2 -REAL(EB) :: MINXI, MAXXI, MINXJ, MAXXJ, DS, SVARI, XJPLN, XCEN(IAXIS:JAXIS) -REAL(EB) :: VECS(IAXIS:JAXIS), VECP1(IAXIS:JAXIS), VECP2(IAXIS:JAXIS), CROSSP1, CROSSP2 -REAL(EB) :: XYEL(IAXIS:JAXIS,NOD1:NOD3) -LOGICAL :: INLIST, OUTPLANE1, OUTPLANE2 -INTEGER :: EDGE_TRI + CYCLE ! Next WSELEM -REAL(EB), ALLOCATABLE, SAVE, DIMENSION(:,:) :: X2X3VERT -INTEGER, SAVE :: SIZE_X2X3VERT + ENDIF -INTEGER :: IWSSEG,NSVERT,NINTP_SEG,SEGNODS(NOD1:NOD2) + ! If you get to this point -> you have a problem: + IF (.NOT.TRI_ONPLANE_ONLY) print*, "Error GET_BODINT_PLANE: Missed wet surface Triangle =",IWSEL -! Default return values: -INB_FLG = .FALSE. -NVERT = 0 -NEDGE = 0 -IF(.NOT.ALLOCATED(X2X3VERT)) THEN - SIZE_X2X3VERT = DELTA_VERT - ALLOCATE(X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT)) -ENDIF -X2X3VERT = 0._EB -CEELEM = CC_UNDEFINED -INDSEG = CC_UNDEFINED -IF ( CEI /= 0 ) THEN - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT - NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + ENDDO ! IWSEL - IF (NVERT > SIZE_X2X3VERT) THEN - DEALLOCATE(X2X3VERT) - SIZE_X2X3VERT = NVERT + DELTA_VERT - ALLOCATE(X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT)); X2X3VERT = 0._EB - ENDIF + EXIT IBIN_DO ! No need to test more bins. - X2X3VERT(IAXIS,1:NVERT) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(X2AXIS,1:NVERT) - X2X3VERT(JAXIS,1:NVERT) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(X3AXIS,1:NVERT) + ENDDO IBIN_DO - CEELEM(NOD1:NOD2,1:NEDGE) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGE) - INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:NEDGE) = & - MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:NEDGE) - MESHES(NM)%CUT_EDGE(CEI)%NEDGE1=NEDGE -ENDIF +ENDDO MAIN_GEOM_LOOP -! Quick discard test: -X2FMIN = MINVAL(FVERT(IAXIS,NOD1:NOD4)); X2FMAX = MAXVAL(FVERT(IAXIS,NOD1:NOD4)) -X3FMIN = MINVAL(FVERT(JAXIS,NOD1:NOD4)); X3FMAX = MAXVAL(FVERT(JAXIS,NOD1:NOD4)) -! Loop in-plane Surface Elements: -INTEST = .FALSE. -DO ITRI=1,BODINT_PLANE%NTRIS - ! Elements nodes location, in x2-x3 coordinates: - TRI(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) - DO INOD=NOD1,NOD3 - XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,TRI(INOD)) - ENDDO - OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(IAXIS,NOD1:NOD3))-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir - OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(JAXIS,NOD1:NOD3))-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 - IF (.NOT.OUTFACE) THEN - INTEST = .TRUE. - EXIT - ENDIF -ENDDO -! Run on Triangle edges found: -DO ISEG=1,BODINT_PLANE%NSEGS - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - DO INOD=NOD1,NOD2 - XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,SEG(INOD)) - ENDDO - OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(IAXIS,NOD1:NOD2))-X2FMAX) > GEOMEPS) ! Segment out of Face in x2 dir - OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(JAXIS,NOD1:NOD2))-X3FMAX) > GEOMEPS) ! Segment out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 - IF (.NOT.OUTFACE) THEN - INTEST = .TRUE. - EXIT - ENDIF -ENDDO -IF (.NOT.INTEST) RETURN +! Next step is to Test triangles sides normals on plane against the obtained +! segments normals. If two identical segments found contain oposite +! normals, drop the segment in BODINT_PLANE%SEGS: +IF ( BODINT_PLANE%NTRIS > 0 ) THEN -! Now if intest is true figure out if there are triangles-face intersection -! Polygons: -NFVERT = 4 -NTVERT = 3 -NSVERT = 2 + DO ITRI=1,BODINT_PLANE%NTRIS -! First Vertices: -ALLOCATE(FVERT_IN_TRIANG(1:NFVERT,BODINT_PLANE%NTRIS)); FVERT_IN_TRIANG = 0 -ALLOCATE(TRIVERT_IN_FACE(1:NTVERT,BODINT_PLANE%NTRIS)); TRIVERT_IN_FACE = 0 + ! Triang conectivities: + ELEM(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) -NINTP = NVERT + ! Coordinates in x2, x3 directions: + X2X3(IAXIS,NOD1:NOD3) = (/ BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD1)), & + BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD2)), & + BODINT_PLANE%XYZ(X2AXIS,ELEM(NOD3)) /) + X2X3(JAXIS,NOD1:NOD3) = (/ BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD1)), & + BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD2)), & + BODINT_PLANE%XYZ(X3AXIS,ELEM(NOD3)) /) -! Loop in-plane Surface Elements: -DO ITRI=1,BODINT_PLANE%NTRIS + ! Test Area sign, if -ve switch node order: + AREALOC = 0.5_EB*(X2X3(IAXIS,NOD1)*X2X3(JAXIS,NOD2) - X2X3(IAXIS,NOD2)*X2X3(JAXIS,NOD1) + & + X2X3(IAXIS,NOD2)*X2X3(JAXIS,NOD3) - X2X3(IAXIS,NOD3)*X2X3(JAXIS,NOD2) + & + X2X3(IAXIS,NOD3)*X2X3(JAXIS,NOD1) - X2X3(IAXIS,NOD1)*X2X3(JAXIS,NOD3)) + IF (AREALOC < 0._EB) THEN + ISEG = ELEM(3) + ELEM(3) = ELEM(2) + ELEM(2) = ISEG + ENDIF - NINTP_TRI = 0 - TRINODS = CC_UNDEFINED + ! Now corresponding segments, ordered normal outside of plane x2-x3. + EDGES(NOD1:NOD2,1) = (/ ELEM(1), ELEM(2) /) ! edge 1. + EDGES(NOD1:NOD2,2) = (/ ELEM(2), ELEM(3) /) ! edge 2. + EDGES(NOD1:NOD2,3) = (/ ELEM(3), ELEM(1) /) - ! Elements nodes location, in x2-x3 coordinates: - TRI(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) - DO INOD=NOD1,NOD3 - XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,TRI(INOD)) - ENDDO + ! Now Test against segments, Beast approach: + DO IEDGE=1,3 + DO ISEG=1,BODINT_PLANE%NSEGS + IF ( (BODINT_PLANE%SEGS(NOD1,ISEG) == EDGES(NOD2,IEDGE)) .AND. & + (BODINT_PLANE%SEGS(NOD2,ISEG) == EDGES(NOD1,IEDGE)) ) THEN ! Edge normals + ! oriented in opposite dirs. + ! Set to SOLID SOLID segtype from BODINT_PLANE.SEGS + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG)=(/ CC_SOLID, CC_SOLID /) - ! Cycle if Triangles BBOX not intersecting face: - OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(IAXIS,NOD1:NOD3))-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir - OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(JAXIS,NOD1:NOD3))-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 - IF (OUTFACE) CYCLE + ENDIF + ENDDO + ENDDO - IF (BODINT_PLANE%X1NVEC(ITRI) < 0) THEN ! ROTATE NODE 2 AND 3 LOCATIONS - DUMMY(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,NOD2) - XYEL(IAXIS:JAXIS,NOD2) = XYEL(IAXIS:JAXIS,NOD3) - XYEL(IAXIS:JAXIS,NOD3) = DUMMY(IAXIS:JAXIS) + ENDDO +ENDIF - TSEGS(NOD1:NOD2,EDG1) = BODINT_PLANE%TRIS( (/ 2, 1 /) ,ITRI) - TSEGS(NOD1:NOD2,EDG2) = BODINT_PLANE%TRIS( (/ 3, 2 /) ,ITRI) - TSEGS(NOD1:NOD2,EDG3) = BODINT_PLANE%TRIS( (/ 1, 3 /) ,ITRI) - ELSE - TSEGS(NOD1:NOD2,EDG1) = BODINT_PLANE%TRIS( (/ 1, 2 /) ,ITRI) - TSEGS(NOD1:NOD2,EDG2) = BODINT_PLANE%TRIS( (/ 2, 3 /) ,ITRI) - TSEGS(NOD1:NOD2,EDG3) = BODINT_PLANE%TRIS( (/ 3, 1 /) ,ITRI) - ENDIF +! For segments that are related to 2 Wet Surface triangles, test if they are of type GG or SS: +DO ISEG=1,BODINT_PLANE%NSEGS + IF (BODINT_PLANE%INDSEG(1,ISEG) > 1) THEN ! Related to 2 WS triangles: - ! a. Test if Triangles vertices Lay on Faces area, including face boundary: - DO IPT=1,NTVERT - OUTX2= ((X2FMIN-XYEL(IAXIS,IPT)) > GEOMEPS) .OR. & - ((XYEL(IAXIS,IPT)-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir - OUTX3= ((X3FMIN-XYEL(JAXIS,IPT)) > GEOMEPS) .OR. & - ((XYEL(JAXIS,IPT)-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - IF ( OUTFACE ) CYCLE + ! Segment nodes positions: + XP1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/X2AXIS,X3AXIS/) ,SEG(NOD1)) + XP2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/X2AXIS,X3AXIS/) ,SEG(NOD2)) - ! Insertion add point to intersection list: - XP(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,IPT) - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) + ! Unit normal versor along x2p (axis directed from NOD2 to NOD1): + NMTX2P = SQRT( (XP1(IAXIS)-XP2(IAXIS))**2._EB + (XP1(JAXIS)-XP2(JAXIS))**2._EB ) + TX2P(IAXIS:JAXIS) = (XP1(IAXIS:JAXIS)-XP2(IAXIS:JAXIS)) * NMTX2P**(-1._EB) + ! Versor along x3p. + TX3P(IAXIS:JAXIS) = (/ -TX2P(JAXIS), TX2P(IAXIS) /) - ! Insert sort node to triangles local list - TRUETHAT = .TRUE. - DO INP=1,NINTP_TRI - IF (TRINODS(INP) == INOD) THEN - TRUETHAT = .FALSE. - EXIT - ENDIF - ENDDO - IF ( TRUETHAT ) THEN ! new inod entry on list - NINTP_TRI = NINTP_TRI + 1 - TRINODS(NINTP_TRI) = INOD - ENDIF + ! Now related WS triangles centroids: + IWSEL1 = BODINT_PLANE%INDSEG(2,ISEG) + IWSEL2 = BODINT_PLANE%INDSEG(3,ISEG) + IG = BODINT_PLANE%INDSEG(4,ISEG) - TRIVERT_IN_FACE(IPT,ITRI) = 1 + ! Centroid of WS elem 1: + ELEM1(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL1-1)+1:NODS_WSEL*IWSEL1) + XYZ1(IAXIS:KAXIS) = ( GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD1)-1)+1:MAX_DIM*ELEM1(NOD1)) + & + GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD2)-1)+1:MAX_DIM*ELEM1(NOD2)) + & + GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM1(NOD3)-1)+1:MAX_DIM*ELEM1(NOD3)) ) / 3._EB + NXYZ1(IAXIS:KAXIS)= GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL1) + ! Normal versor in x3p-x1 direction: + NX3P1 = TX3P(IAXIS)*NXYZ1(X2AXIS) + TX3P(JAXIS)*NXYZ1(X3AXIS) + N1(IAXIS:JAXIS) = (/ NX3P1, NXYZ1(X1AXIS) /) + NMNL = SQRT( N1(IAXIS)**2._EB + N1(JAXIS)**2._EB ) + N1 = N1 * NMNL**(-1._EB) - ENDDO + ! Centroid of WS elem 2: + ELEM2(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL2-1)+1:NODS_WSEL*IWSEL2) + XYZ2(IAXIS:KAXIS) = ( GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD1)-1)+1:MAX_DIM*ELEM2(NOD1)) + & + GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD2)-1)+1:MAX_DIM*ELEM2(NOD2)) + & + GEOMETRY(IG)%VERTS(MAX_DIM*(ELEM2(NOD3)-1)+1:MAX_DIM*ELEM2(NOD3)) ) / 3._EB + NXYZ2(IAXIS:KAXIS)= GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,IWSEL2) + ! Normal versor in x3p-x1 direction: + NX3P2 = TX3P(IAXIS)*NXYZ2(X2AXIS) + TX3P(JAXIS)*NXYZ2(X3AXIS) + N2(IAXIS:JAXIS) = (/ NX3P2, NXYZ2(X1AXIS) /) + NMNL = SQRT( N2(IAXIS)**2._EB + N2(JAXIS)**2._EB ) + N2 = N2 * NMNL**(-1._EB) - ! b. Test if Face vertices lay on triangle, including triangle edges: - DO IPF=1,NFVERT - ! Transform back to master Element coordinates - ! location of point i,j in x2-x3 coordinates: - FD(1:2) = (/ FVERT(IAXIS,IPF)-XYEL(IAXIS,NOD3), FVERT(JAXIS,IPF)-XYEL(JAXIS,NOD3) /) - ! Here xi in vec(1) and eta in vec(2) - VEC(IAXIS) = BODINT_PLANE%AINV(1,1,ITRI)*FD(1) + BODINT_PLANE%AINV(1,2,ITRI)*FD(2) - VEC(JAXIS) = BODINT_PLANE%AINV(2,1,ITRI)*FD(1) + BODINT_PLANE%AINV(2,2,ITRI)*FD(2) + ! Define points in plane x3p-x1: + ! vertex point: + X3PVERT = TX3P(IAXIS)*XP1(IAXIS) + TX3P(JAXIS)*XP1(JAXIS) + PVERT(IAXIS:JAXIS) = (/ X3PVERT, X1PLN /) + ! First triangle centroid: + X3P1 = TX3P(IAXIS)*XYZ1(X2AXIS) + TX3P(JAXIS)*XYZ1(X3AXIS) + P1CEN(IAXIS:JAXIS) = (/ X3P1, XYZ1(X1AXIS) /) + ! Second triangle centroid: + X3P2 = TX3P(IAXIS)*XYZ2(X2AXIS) + TX3P(JAXIS)*XYZ2(X3AXIS) + P2CEN(IAXIS:JAXIS) = (/ X3P2, XYZ2(X1AXIS) /) - ! Test for vertex point within triangle, considers Triangle Edges: - IF ( (VEC(IAXIS) >= (0._EB-GEOMEPS)) .AND. & - (VEC(JAXIS) >= (0._EB-GEOMEPS)) .AND. & - (1._EB-VEC(IAXIS)-VEC(JAXIS) >= (0._EB-GEOMEPS)) ) THEN + VCT(1:2) = 0 + PCT(IAXIS:JAXIS,1:2) = 0._EB - ! Insertion add point to intersection list: - XP(IAXIS:JAXIS) = FVERT(IAXIS:JAXIS,IPF) - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) + ! Segment on triangle 1: + V1(IAXIS:JAXIS) = P1CEN(IAXIS:JAXIS) - PVERT(IAXIS:JAXIS) + CRSSNV = N1(IAXIS)*V1(JAXIS) - N1(JAXIS)*V1(IAXIS) + IF (CRSSNV > 0._EB) THEN + ! v1 stays as is, and is second segment: + VEC(IAXIS:JAXIS,2) = V1(IAXIS:JAXIS) + PCT(IAXIS:JAXIS,2) = P1CEN(IAXIS:JAXIS) + VCT(2) = 1 + ELSE + ! -v1 is the first segment: + VEC(IAXIS:JAXIS,1) = -V1(IAXIS:JAXIS) + PCT(IAXIS:JAXIS,1) = P1CEN(IAXIS:JAXIS) + VCT(1) = 1 + ENDIF - ! Insert sort node to triangles local list - TRUETHAT = .TRUE. - DO INP=1,NINTP_TRI - IF (TRINODS(INP) == INOD) THEN - TRUETHAT = .FALSE. - EXIT - ENDIF - ENDDO - IF ( TRUETHAT ) THEN ! new inod entry on list - NINTP_TRI = NINTP_TRI + 1 - TRINODS(NINTP_TRI) = INOD - ENDIF + ! Segment on triangle 2: + V2(IAXIS:JAXIS) = P2CEN(IAXIS:JAXIS) - PVERT(IAXIS:JAXIS) + CRSSNV = N2(IAXIS)*V2(JAXIS) - N2(JAXIS)*V2(IAXIS) + IF (CRSSNV > 0._EB) THEN + ! v2 stays as is, and is second segment: + VEC(IAXIS:JAXIS,2) = V2(IAXIS:JAXIS) + PCT(IAXIS:JAXIS,2) = P2CEN(IAXIS:JAXIS) + VCT(2) = 1 + ELSE + ! -v2 is the first segment: + VEC(IAXIS:JAXIS,1) = -V2(IAXIS:JAXIS) + PCT(IAXIS:JAXIS,1) = P2CEN(IAXIS:JAXIS) + VCT(1) = 1 + ENDIF - FVERT_IN_TRIANG(IPF,ITRI) = 1 + IF ( (VCT(1) == 0) .OR. (VCT(2) == 0) ) THEN + print*, "Error GET_BODINT_PLANE: One component of vct == 0." + ENDIF - ENDIF - ENDDO + ! Cross product of v1 and v2 gives magnitude along x2p axis: + CTST = VEC(IAXIS,1)*VEC(JAXIS,2) - VEC(JAXIS,1)*VEC(IAXIS,2) - ! Now add face edge - triangle edge intersection points: - ! x2 segments: - DO MYAXIS=IAXIS,JAXIS - SELECT CASE(MYAXIS) - CASE(IAXIS) - XIAXIS = IAXIS - XJAXIS = JAXIS - XIPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) - XJPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) - CASE(JAXIS) - XIAXIS = JAXIS - XJAXIS = IAXIS - XIPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) - XJPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) - END SELECT + ! Now tests: + ! Start with SOLID GASPHASE definition for segtype: + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_GASPHASE /) - DO JPL=LOW_IND,HIGH_IND + ! Test for SOLID SOLID condition: + IF ( ((PCT(JAXIS,1)-X1PLN) > -GEOMEPS) .AND. & + ((PCT(JAXIS,2)-X1PLN) > -GEOMEPS) .AND. (CTST < GEOMEPS) ) THEN + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_SOLID /) + CYCLE + ELSEIF (((PCT(JAXIS,1)-X1PLN) < GEOMEPS) .AND. & + ((PCT(JAXIS,2)-X1PLN) < GEOMEPS) .AND. (CTST < GEOMEPS) ) THEN + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_SOLID /) + CYCLE + ENDIF - XJPLN = XJPLNS(JPL) + ! Test for GASPHASE GASPHASE condition: + IF ( ((PCT(JAXIS,1)-X1PLN) > GEOMEPS) .AND. & + ((PCT(JAXIS,2)-X1PLN) > GEOMEPS) .AND. (CTST > GEOMEPS) ) THEN + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_GASPHASE, CC_GASPHASE /) + CYCLE + ELSEIF (((PCT(JAXIS,1)-X1PLN) < -GEOMEPS) .AND. & + ((PCT(JAXIS,2)-X1PLN) < -GEOMEPS) .AND. (CTST > GEOMEPS) ) THEN + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_GASPHASE, CC_GASPHASE /) + CYCLE + ENDIF - DO IPT=1,NTVERT + ENDIF +ENDDO - XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD1,IPT) ) - XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD2,IPT) ) - ! Drop if Triangle edge on one side of segment ray: - MAXXJ = MAX(XY1(XJAXIS),XY2(XJAXIS)) - MINXJ = MIN(XY1(XJAXIS),XY2(XJAXIS)) - OUTPLANE1 = ((XJPLN-MAXXJ) > GEOMEPS) .OR. ((MINXJ-XJPLN) > GEOMEPS) - IF ( OUTPLANE1 ) CYCLE +! For the time being, as BODINT_PLANE is used to create Cartesian face cut-faces +! We eliminate from the list the SEGTYPE=[SOLID SOLID] segments: +ALLOCATE(SEGAUX(NOD1:NOD2,BODINT_PLANE%NSEGS)) +ALLOCATE(INDSEGAUX(CC_MAX_WSTRIANG_SEG+2,BODINT_PLANE%NSEGS)) +ALLOCATE(SEGTYPEAUX(NOD1:NOD2,BODINT_PLANE%NSEGS)) - ! Also drop if Triangle edge ouside of face edge limits: - MAXXI = MAX(XY1(XIAXIS),XY2(XIAXIS)) - MINXI = MIN(XY1(XIAXIS),XY2(XIAXIS)) - OUTPLANE2 = ((XIPLNS(LOW_IND)-MAXXI) > GEOMEPS) .OR. ((MINXI-XIPLNS(HIGH_IND)) > GEOMEPS) - IF ( OUTPLANE2 ) CYCLE +ISEG_NEW = 0 +IF(.NOT.TRI_ONPLANE_ONLY) THEN + DO ISEG=1,BODINT_PLANE%NSEGS + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) + IF( NORM2(XYZ2((/X2AXIS,X3AXIS/))-XYZ1((/X2AXIS,X3AXIS/))) < 0.1_EB*GEOMEPS) CYCLE + IF ( (BODINT_PLANE%SEGTYPE(NOD1,ISEG) == CC_SOLID) .AND. & + (BODINT_PLANE%SEGTYPE(NOD2,ISEG) == CC_SOLID) ) CYCLE - ! Test if segment aligned with xi - XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) - IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. + ISEG_NEW = ISEG_NEW + 1 + SEGAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+2,ISEG_NEW) = & + BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) + SEGTYPEAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) + ENDDO +ELSE + DO ISEG=1,BODINT_PLANE%NSEGS + IF ( (BODINT_PLANE%SEGTYPE(NOD1,ISEG) == CC_SOLID) .AND. & + (BODINT_PLANE%SEGTYPE(NOD2,ISEG) == CC_SOLID) ) THEN - ! Drop intersections in triangle segment nodes: already added. - ! Compute: dot(plnormal, xyzv - xypl): - DOT1 = XY1(XJAXIS) - XJPLN - DOT2 = XY2(XJAXIS) - XJPLN + ISEG_NEW = ISEG_NEW + 1 + SEGAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+2,ISEG_NEW) = & + BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) + SEGTYPEAUX(NOD1:NOD2,ISEG_NEW) = BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) + ENDIF + ENDDO +ENDIF - IF ( ABS(DOT1) <= GEOMEPS ) CYCLE - IF ( ABS(DOT2) <= GEOMEPS ) CYCLE +BODINT_PLANE%NSEGS = ISEG_NEW +BODINT_PLANE%SEGS(NOD1:NOD2,1:ISEG_NEW) = SEGAUX(NOD1:NOD2,1:ISEG_NEW) +BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:ISEG_NEW) = INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+2,1:ISEG_NEW) +BODINT_PLANE%SEGTYPE(NOD1:NOD2,1:ISEG_NEW) = SEGTYPEAUX(NOD1:NOD2,1:ISEG_NEW) - ! Finally regular case: - ! Points 1 on one side of x2 segment, point 2 on the other: - !IF ((DOT1 > 0._EB & DOT2 < 0._EB) .OR. (DOT1 < 0._EB & DOT2 > 0._EB)) - IF ( DOT1*DOT2 < 0._EB ) THEN +DEALLOCATE(SEGAUX,INDSEGAUX,SEGTYPEAUX) - ! Intersection Point along segment: - DS = (XJPLN-XY1(XJAXIS))/(XY2(XJAXIS)-XY1(XJAXIS)) - SVARI = XY1(XIAXIS) + DS*(XY2(XIAXIS)-XY1(XIAXIS)) +IF(TRI_ONPLANE_ONLY .OR. (BODINT_PLANE%NSEGS == 0)) THEN + T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) = T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) + CURRENT_TIME() - TNOW + RETURN +ENDIF + +! Segments Crossings fields: +! Initialize nbcross with segment nodes locations: +IF ( ALLOCATED(BODINT_PLANE%NBCROSS) ) DEALLOCATE(BODINT_PLANE%NBCROSS) +IF ( ALLOCATED(BODINT_PLANE%SVAR) ) DEALLOCATE(BODINT_PLANE%SVAR) +ALLOCATE(BODINT_PLANE%NBCROSS(1:BODINT_PLANE%NSEGS),BODINT_PLANE%SVAR(1:CC_DELTA_NBCROSS,1:BODINT_PLANE%NSEGS)) +BODINT_PLANE%NBCROSS(1:BODINT_PLANE%NSEGS) = 0 +BODINT_PLANE%SVAR(1:CC_DELTA_NBCROSS,1:BODINT_PLANE%NSEGS) = -1._EB + +BODINT_PLANE%BOX(LOW_IND:HIGH_IND,IAXIS:KAXIS) = 0._EB +BODINT_PLANE%BOX(LOW_IND, X2AXIS) = MINVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))-10._EB*GEOMEPS +BODINT_PLANE%BOX(HIGH_IND,X2AXIS) = MAXVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))+10._EB*GEOMEPS +BODINT_PLANE%BOX(LOW_IND, X3AXIS) = MINVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))-10._EB*GEOMEPS +BODINT_PLANE%BOX(HIGH_IND,X3AXIS) = MAXVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))+10._EB*GEOMEPS +IF (RAYTRACE_X2_ONLY) THEN + AXIS = X3AXIS + BODINT_PLANE%TBAXIS(AXIS)%DELBIN = BODINT_PLANE%BOX(HIGH_IND,AXIS)-BODINT_PLANE%BOX(LOW_IND,AXIS) + IBIN = 1 + BODINT_PLANE%TBAXIS(AXIS)%N_BINS = IBIN + ! If needed, deallocate the TRIBIN container for this AXIS: + IF(ALLOCATED(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN)) DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN) + ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)) + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_LOW = BODINT_PLANE%BOX( LOW_IND,AXIS) + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_HIGH = BODINT_PLANE%BOX(HIGH_IND,AXIS) + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL = BODINT_PLANE%NSEGS + ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(BODINT_PLANE%NSEGS)) + DO ISEG=1,BODINT_PLANE%NSEGS; BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(ISEG) = ISEG; ENDDO + RETURN +ENDIF - OUTSEG= ((XIPLNS(LOW_IND)-SVARI) > -GEOMEPS) .OR. ((SVARI-XIPLNS(HIGH_IND)) > -GEOMEPS) - IF ( OUTSEG ) CYCLE - ! Insertion add point to intersection list: - XP(XIAXIS) = SVARI - XP(XJAXIS) = XJPLN - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) +! Initialize nbcross with segment nodes locations: +! Add segment ends as crossings: +ALLOCATE(SEGS_NODE(BODINT_PLANE%NNODS)); SEGS_NODE = 0 +MEAN_SLEN=0._EB +DO ISEG=1,BODINT_PLANE%NSEGS - ! Insert sort node to triangles local list - TRUETHAT = .TRUE. - DO INP=1,NINTP_TRI - IF (TRINODS(INP) == INOD) THEN - TRUETHAT = .FALSE. - EXIT - ENDIF - ENDDO - IF (TRUETHAT) THEN ! new inod entry on list - NINTP_TRI = NINTP_TRI + 1 - TRINODS(NINTP_TRI) = INOD - ENDIF - CYCLE - ENDIF - ENDDO - ENDDO - ENDDO + ! End nodes to cross: + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) - IF ( NINTP_TRI == 0 ) CYCLE + IF(ANY(BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG)/=CC_GASPHASE)) THEN + SEGS_NODE(SEG(NOD1)) = SEGS_NODE(SEG(NOD1)) + 1 + SEGS_NODE(SEG(NOD2)) = SEGS_NODE(SEG(NOD2)) + 1 + ENDIF - ! Reorder points given normal on x1 direction: - ! Centroid: - XCEN(IAXIS:JAXIS) = 0._EB - DO INTP=1,NINTP_TRI - XCEN(IAXIS:JAXIS) = XCEN(IAXIS:JAXIS) + X2X3VERT(IAXIS:JAXIS,TRINODS(INTP)) - ENDDO - XCEN(IAXIS:JAXIS)= XCEN(IAXIS:JAXIS) * REAL(NINTP_TRI,EB)**(-1._EB) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) - ATANTRI(1:CC_MAXVERTS_FACE+1) = 1._EB / GEOMEPS - II(1:CC_MAXVERTS_FACE+1) = CC_UNDEFINED - DO INTP=1,NINTP_TRI - ATTRI = ATAN2(X2X3VERT(JAXIS,TRINODS(INTP))-XCEN(JAXIS), & - X2X3VERT(IAXIS,TRINODS(INTP))-XCEN(IAXIS)) + PI - ! Insertion sort: - DO IINS=1,INTP+1 - IF (ATTRI < ATANTRI(IINS)) EXIT - ENDDO - ! copy from the back: - DO IDUM=INTP+1,IINS+1,-1 - ATANTRI(IDUM) = ATANTRI(IDUM-1) - II(IDUM) = II(IDUM-1) - ENDDO - ATANTRI(IINS) = ATTRI - II(IINS) = INTP - ENDDO + ! Is segment aligned with x3 direction? + BODINT_PLANE%X3ALIGNED(ISEG) = (ABS(XYZ2(X2AXIS)-XYZ1(X2AXIS)) < GEOMEPS) + ! Is segment aligned with x2 rays?: + BODINT_PLANE%X2ALIGNED(ISEG) = (ABS(XYZ2(X3AXIS)-XYZ1(X3AXIS)) < GEOMEPS) - ! Reorder nodes: - TRINODS(1:NINTP_TRI) = TRINODS(II(1:NINTP_TRI)) + ! x2_x3 of segment point 1: + X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) + ! x2_x3 of segment point 2: + X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) - ! Define and Insertion add segments to CFELEM, indseg - EDGETRI = CC_UNDEFINED - DO IEDGE=1,NINTP_TRI-1 - EDGETRI((/NOD1,NOD2/),IEDGE) = (/ TRINODS(IEDGE), TRINODS(IEDGE+1) /) - ENDDO - EDGETRI((/NOD1,NOD2/),NINTP_TRI) = (/ TRINODS(NINTP_TRI), TRINODS(1) /) + ! Segment length: + SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) + MEAN_SLEN = MEAN_SLEN + SLEN - LOCTRI = BODINT_PLANE%INDTRI(1,ITRI) - LOCBOD = BODINT_PLANE%INDTRI(2,ITRI) + ! First node: + SBOD = 0._EB + ! Add crossing to BODINT_PLANE: + NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + 1 + BODINT_PLANE%NBCROSS(ISEG) = NBCROSS + BODINT_PLANE%SVAR(NBCROSS,ISEG) = SBOD - DO IEDGE=1,NINTP_TRI + ! Second node: + SBOD = SLEN + ! Add crossing to BODINT_PLANE: + NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + 1 + BODINT_PLANE%NBCROSS(ISEG) = NBCROSS + BODINT_PLANE%SVAR(NBCROSS,ISEG) = SBOD - IF ( EDGETRI(NOD1,IEDGE) == EDGETRI(NOD2,IEDGE) ) CYCLE +ENDDO - ! Test if Edge already on list: - INLIST = .FALSE. - DO ISEG=1,NEDGE +! Spread Segments in BINs in the x2-x3 directions: +MEAN_SLEN = MEAN_SLEN / REAL(BODINT_PLANE%NSEGS,EB) +VAXIS(IAXIS:JAXIS) = (/ X2AXIS, X3AXIS /) +DO I = 1,2 + AXIS = VAXIS(I) + LXI = BODINT_PLANE%BOX(HIGH_IND,AXIS)-BODINT_PLANE%BOX(LOW_IND,AXIS) + IF (BODINT_PLANE%NSEGS < 100) THEN + BODINT_PLANE%TBAXIS(AXIS)%N_BINS = MAX(1 ,CEILING(LXI/(MEAN_SLEN))) + ELSE + BODINT_PLANE%TBAXIS(AXIS)%N_BINS = MAX(10,CEILING(LXI/(MEAN_SLEN))) + ENDIF - IF ( (EDGETRI(NOD1,IEDGE) == CEELEM(NOD1,ISEG)) .AND. & ! same inod1 - (EDGETRI(NOD2,IEDGE) == CEELEM(NOD2,ISEG)) .AND. & ! same inod2 - (LOCBOD == INDSEG(4,ISEG)) ) THEN ! same ibod + ! Allocate TRIBIN field: + IF(ALLOCATED(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN)) DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN) + ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(1:BODINT_PLANE%TBAXIS(AXIS)%N_BINS)) - SELECT CASE(INDSEG(1,ISEG)) - ! Only one triangle in list: - CASE(1) - IF ( LOCTRI /= INDSEG(2,ISEG) ) THEN - INDSEG(1,ISEG) = 2 - INDSEG(3,ISEG) = LOCTRI ! add triangle 2nd. - ENDIF - INLIST = .TRUE. - EXIT - ! Two triangles in list: - CASE(2) - IF ( (LOCTRI == INDSEG(2,ISEG)) .OR. & - (LOCTRI == INDSEG(3,ISEG)) ) THEN - INLIST = .TRUE. - EXIT - ENDIF - END SELECT + ! Set BIN boundaries and make initial allocation of TRI_LIST (here for SEGS) for each bin: + DELBIN = LXI / REAL(BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB) + BODINT_PLANE%TBAXIS(AXIS)%DELBIN = DELBIN + DO IBIN=1,BODINT_PLANE%TBAXIS(AXIS)%N_BINS + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_LOW = BODINT_PLANE%BOX( LOW_IND,AXIS) + REAL(IBIN-1,EB)*DELBIN + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%X1_HIGH = BODINT_PLANE%BOX( LOW_IND,AXIS) + REAL(IBIN ,EB)*DELBIN + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL = 0 + IF(ALLOCATED(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST)) & + DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST) + ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(DELTA_SEGBIN)) + ENDDO + ! Finally, populate TRI_LIST (here for SEGS) for AXIS bins: + DO ISEG=1,BODINT_PLANE%NSEGS + XIV(NOD1:NOD2) = BODINT_PLANE%XYZ(AXIS,BODINT_PLANE%SEGS(NOD1:NOD2,ISEG)) + XIV_LO = MINVAL(XIV(NOD1:NOD2)); XIV_HI = MAXVAL(XIV(NOD1:NOD2)) + AVAL = (XIV_LO-GEOMEPS-BODINT_PLANE%BOX(LOW_IND,AXIS))/DELBIN + ILO_BIN= MAX(1, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB),ABS(AVAL)) )) + AVAL = (XIV_HI+GEOMEPS-BODINT_PLANE%BOX(LOW_IND,AXIS))/DELBIN + IHI_BIN= MIN(BODINT_PLANE%TBAXIS(AXIS)%N_BINS, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(AXIS)%N_BINS,EB),ABS(AVAL)) )) + DO IBIN=ILO_BIN,IHI_BIN + NTL = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL + 1 + SZE = SIZE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST,DIM=1) + IF (NTL > SZE) THEN + ! Reallocate: + ALLOCATE(TRI_LIST(1:SZE)); TRI_LIST(1:SZE)=BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) + DEALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST) + ALLOCATE(BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE+DELTA_SEGBIN)) + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) = TRI_LIST(1:SZE) + DEALLOCATE(TRI_LIST) ENDIF + ! Add Triangle index to BINs TRI_LIST + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL = NTL + BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(NTL) = ISEG ENDDO + ENDDO +ENDDO - IF ( .NOT.INLIST ) THEN ! Edge not in list. - NEDGE = NEDGE + 1 - CEELEM(NOD1:NOD2,NEDGE) = EDGETRI(NOD1:NOD2,IEDGE) +! Add Segments intersections: +DO IBIN=1,BODINT_PLANE%TBAXIS(AXIS)%N_BINS + NTL = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%NTL + ! Now double loop, cost O(1/2*NTL^2): + DO BISEG=1,NTL + ISEGV(EDG1) = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(BISEG) + SEGV(NOD1:NOD2,EDG1) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEGV(EDG1)) + P1(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1,EDG1)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1,EDG1))/) + D1(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD2,EDG1)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD2,EDG1))/) + D1 = D1 - P1 + S1_X2_MIN=MINVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG1))) + S1_X2_MAX=MAXVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG1))) + S1_X3_MIN=MINVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG1))) + S1_X3_MAX=MAXVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG1))) + DO BIISEG=BISEG+1,NTL + ! Test for segment-segment intersection: + ISEGV(EDG2) = BODINT_PLANE%TBAXIS(AXIS)%TRIBIN(IBIN)%TRI_LIST(BIISEG) + SEGV(NOD1:NOD2,EDG2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEGV(EDG2)) + P2(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1,EDG2)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1,EDG2))/) + D2(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD2,EDG2)), BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD2,EDG2))/) + D2 = D2 - P2 - ! Here we have to figure out if segment belongs to a triangles side: - SEG_IN_SIDE = .FALSE. - DO IPT=1,NTVERT + ! Tests for quick discard: + IF( MAXVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG2)))+GEOMEPS < S1_X2_MIN) CYCLE + IF( MINVAL(BODINT_PLANE%XYZ(X2AXIS,SEGV(NOD1:NOD2,EDG2)))-GEOMEPS > S1_X2_MAX) CYCLE + IF( MAXVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG2)))+GEOMEPS < S1_X3_MIN) CYCLE + IF( MINVAL(BODINT_PLANE%XYZ(X3AXIS,SEGV(NOD1:NOD2,EDG2)))-GEOMEPS > S1_X3_MAX) CYCLE - ! Triangle side nodes: - XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD1,IPT) ) - XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD2,IPT) ) + ! Test for segment-segment intersection: + CALL GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) - ! Segment points: - XP1(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD1,NEDGE)) - XP2(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD2,NEDGE)) + ! Now discard repeated intersections: + ! If crossing is already defined in SEG don't add: + DO ICROSS=1,INT_FLG + DO ISX = EDG1,EDG2 + SBOD = SVARV(ICROSS,ISX) + ! Discard intersections already present in segment, including ends: + INLIST = .FALSE. + DO ISVAR=1,BODINT_PLANE%NBCROSS(ISEGV(ISX)) + IF ( ABS(SBOD-BODINT_PLANE%SVAR(ISVAR,ISEGV(ISX))) < GEOMEPS ) THEN + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (INLIST) CYCLE + + ! Add crossing to BODINT_PLANE, insertion sort: + NBCROSS = BODINT_PLANE%NBCROSS(ISEGV(ISX)) + 1 + ! Test-reallocate BODINT_PLANE%SVAR + NBCROSS_SVAR = SIZE(BODINT_PLANE%SVAR,DIM=1) + IF (NBCROSS > NBCROSS_SVAR) THEN + ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB + SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) + CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) + ENDIF + BODINT_PLANE%SVAR(NBCROSS,ISEGV(ISX)) = 1._EB/GEOMEPS + DO IBCR=1,NBCROSS + IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEGV(ISX)) ) EXIT + ENDDO + IBCR = MIN(IBCR,NBCROSS) + + ! Here copy from the back (updated nbcross) to the ibcr location: + DO IDUM = NBCROSS,IBCR+1,-1 + BODINT_PLANE%SVAR(IDUM,ISEGV(ISX)) = BODINT_PLANE%SVAR(IDUM-1,ISEGV(ISX)) + ENDDO + BODINT_PLANE%SVAR(IBCR,ISEGV(ISX)) = SBOD + BODINT_PLANE%NBCROSS(ISEGV(ISX)) = NBCROSS - VECS(IAXIS:JAXIS) = XY2(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) - VECP1(IAXIS:JAXIS) = XP1(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) - VECP2(IAXIS:JAXIS) = XP2(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) + ! Here we have an intersection inside a segment, note it in FACERT: + IF ( ISX==EDG1 ) THEN + ! X2AXIS, X3AXIS location of intersection: + XY(IAXIS:JAXIS) = P1(IAXIS:JAXIS) + SBOD*D1(IAXIS:JAXIS)/NORM2(D1(IAXIS:JAXIS)) + ELSE + ! X2AXIS, X3AXIS location of intersection: + XY(IAXIS:JAXIS) = P2(IAXIS:JAXIS) + SBOD*D2(IAXIS:JAXIS)/NORM2(D2(IAXIS:JAXIS)) + ENDIF + XPOS = XY(IAXIS) + IF ( X2NOC==0 ) THEN + JJ2_LO = FLOOR((XPOS-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + JJ2_HI = FLOOR((XPOS+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + IF (ALL((/JJ2_LO,JJ2_HI/) < X2LO_CELL) .OR. ALL((/JJ2_LO,JJ2_HI/) > X2HI_CELL)) CYCLE + JJ2_LO = MAX(JJ2_LO,X2LO_CELL); JJ2_HI = MIN(JJ2_HI,X2HI_CELL) + ELSE + FOUND_SEG = .FALSE.; JJ2_LO = -100; JJ2_HI = -100 + DO JJ2=X2LO_CELL,X2HI_CELL + ! Check if XPOS is within this segment JJ2: + IF ( ((XPOS-X2FACE(JJ2-1))>-GEOMEPS) .AND. ((X2FACE(JJ2)-XPOS)>-GEOMEPS) ) THEN + IF (JJ2_LO > -100) THEN + JJ2_HI = JJ2 + EXIT + ELSE + JJ2_LO = JJ2 + JJ2_HI = JJ2 + ENDIF + FOUND_SEG = .TRUE. + ENDIF + ENDDO + IF (.NOT.FOUND_SEG) CYCLE + ENDIF + XPOS = XY(JAXIS) + IF ( X3NOC==0 ) THEN + KK2_LO = FLOOR((XPOS-GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + KK2_HI = FLOOR((XPOS+GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + IF (ALL((/KK2_LO,KK2_HI/) < X3LO_CELL) .OR. ALL((/KK2_LO,KK2_HI/) > X3HI_CELL)) CYCLE + KK2_LO = MAX(KK2_LO,X3LO_CELL); KK2_HI = MIN(KK2_HI,X3HI_CELL) + ELSE + FOUND_SEG = .FALSE.; KK2_LO = -100; KK2_HI = -100 + DO KK2=X3LO_CELL,X3HI_CELL + ! Check if XPOS is within this segment KK2: + IF ( ((XPOS-X3FACE(KK2-1))>-GEOMEPS) .AND. ((X3FACE(KK2)-XPOS)>-GEOMEPS) ) THEN + IF (KK2_LO > -100) THEN + KK2_HI = KK2 + EXIT + ELSE + KK2_LO = KK2 + KK2_HI = KK2 + ENDIF + FOUND_SEG = .TRUE. + ENDIF + ENDDO + IF (.NOT.FOUND_SEG) CYCLE + ENDIF - CROSSP1 = ABS(VECS(IAXIS)*VECP1(JAXIS)-VECS(JAXIS)*VECP1(IAXIS)) - CROSSP2 = ABS(VECS(IAXIS)*VECP2(JAXIS)-VECS(JAXIS)*VECP2(IAXIS)) + ! Here JJ2 and KK2 have the face containing the intersection: + DO KK2=KK2_LO,KK2_HI + DO JJ2=JJ2_LO,JJ2_HI + FACERT(JJ2,KK2) = .TRUE. + ENDDO + ENDDO - IF ( (CROSSP1+CROSSP2) < GEOMEPS ) THEN - SEG_IN_SIDE = .TRUE. - EXIT - ENDIF + ENDDO ENDDO - IF ( SEG_IN_SIDE ) THEN - EDGE_TRI = GEOMETRY(LOCBOD)%FACE_EDGES(IPT,LOCTRI) ! WSTRIED - VEC3(1) = GEOMETRY(LOCBOD)%EDGE_FACES(1,EDGE_TRI) ! WSEDTRI - VEC3(2) = GEOMETRY(LOCBOD)%EDGE_FACES(2,EDGE_TRI) - VEC3(3) = GEOMETRY(LOCBOD)%EDGE_FACES(4,EDGE_TRI) - INDSEG((/1,2,3,4/),NEDGE) = (/ VEC3(1), VEC3(2), VEC3(3), LOCBOD /) - ELSE - INDSEG((/1,2,3,4/),NEDGE) = (/ 1, LOCTRI, 0, LOCBOD /) - ENDIF - ENDIF + ENDDO ENDDO - ENDDO -! Now define cut-edges from solid-solid segments: -DO IWSSEG=1,BODINT_PLANE%NSEGS - - NINTP_SEG = 0 - SEGNODS = CC_UNDEFINED - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,IWSSEG) - DO INOD=NOD1,NOD2 - XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,SEG(INOD)) - ENDDO - ! Cycle if Edges BBOX not intersecting face: - OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(IAXIS,NOD1:NOD2))-X2FMAX) > GEOMEPS) ! Segment out of Face in x2 dir - OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & - ((MINVAL(XYEL(JAXIS,NOD1:NOD2))-X3FMAX) > GEOMEPS) ! Segment out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 - IF (OUTFACE) CYCLE +! Loop nodes and test in SEG_NODES: if more than 2 segments end in the +! node, note it in FACERT. +MAX_SEG_NODE = MAXVAL(SEGS_NODE(1:BODINT_PLANE%NNODS)) +ALLOCATE(ISEG_NODE(MAX_SEG_NODE+1,BODINT_PLANE%NNODS)); ISEG_NODE = 0 +ALLOCATE(ANGS_NODE(MAX_SEG_NODE ,BODINT_PLANE%NNODS)); ANGS_NODE = 0._EB +ANGNODE_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS + ! End nodes to cross: + IF( ANY(BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG)/=CC_GASPHASE) ) THEN + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + DX2 = BODINT_PLANE%XYZ(X2AXIS,SEG(NOD2))-BODINT_PLANE%XYZ(X2AXIS,SEG(NOD1)) + DX3 = BODINT_PLANE%XYZ(X3AXIS,SEG(NOD2))-BODINT_PLANE%XYZ(X3AXIS,SEG(NOD1)) + NOD_LOOP : DO INOD=NOD1,NOD2 + ! Compute angle, for NOD2 the seg andgle is -ANG. + ANG=REAL(NOD2-INOD,EB)*ATAN2(DX3,DX2) + REAL(INOD-NOD1,EB)*ATAN2(-DX3,-DX2) + IF(ANG < 0._EB) ANG = ANG + TWOPI ! Make angle from 0 to 2*pi. + ! Insert-add segment into ISEG_NODE depending on angle value: + NSN = ISEG_NODE(1,SEG(INOD)) + ISEG_NODE(1 ,SEG(INOD)) = NSN+1 + FOUND_SEG=.FALSE.; ISEG2=1 + IF (NSN>0) THEN + DO ISEG2=1,NSN + IF (ANGS_NODE(ISEG2,SEG(INOD)) > ANG) THEN + FOUND_SEG=.TRUE.; EXIT + ENDIF + ENDDO + ENDIF + IF (FOUND_SEG) THEN + DO ISEG3=NSN+1,ISEG2+1,-1 + ISEG_NODE(ISEG3+1,SEG(INOD)) = ISEG_NODE(ISEG3 ,SEG(INOD)) + ANGS_NODE(ISEG3 ,SEG(INOD)) = ANGS_NODE(ISEG3-1,SEG(INOD)) + ENDDO + ENDIF + ISEG_NODE(ISEG2+1,SEG(INOD)) = ISEG + ANGS_NODE(ISEG2 ,SEG(INOD)) = ANG + ENDDO NOD_LOOP + ENDIF +ENDDO ANGNODE_LOOP - ! Now define nodes for this CEELEM: - ! a-1. Test if Segments vertices Lay on Faces area, including face boundary: - DO IPT=1,NSVERT - OUTX2= ((X2FMIN-XYEL(IAXIS,IPT)) > GEOMEPS) .OR. & - ((XYEL(IAXIS,IPT)-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir - OUTX3= ((X3FMIN-XYEL(JAXIS,IPT)) > GEOMEPS) .OR. & - ((XYEL(JAXIS,IPT)-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir - OUTFACE = OUTX2 .OR. OUTX3 - IF ( OUTFACE ) CYCLE +ALLOCATE(CIRC_MED(MAX_SEG_NODE+1)) +INOD_LOOP : DO INOD = 1,BODINT_PLANE%NNODS + IF (SEGS_NODE(INOD) < 3) CYCLE INOD_LOOP - ! Insertion add point to intersection list: - XP(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,IPT) - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) + ! Test case of even number of segments: + IF (MOD(SEGS_NODE(INOD),2)==0) THEN ! Case of even number of segments. + ! Test if circling around the node we have media discontinuity. + NSN=ISEG_NODE(1,INOD); COUNT=0 + DO ISEG2=2,NSN+1 + ISEG =ISEG_NODE(ISEG2,INOD) + COUNT=COUNT+1 + SEG = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + IF (INOD==SEG(NOD2)) THEN + CIRC_MED(COUNT) = BODINT_PLANE%SEGTYPE(NOD2,ISEG) + ELSE + CIRC_MED(COUNT) = BODINT_PLANE%SEGTYPE(NOD1,ISEG) + ENDIF + ENDDO + CIRC_MED(COUNT+1)=CIRC_MED(1) + CRS_FLG=.FALSE. + DO COUNT=1,NSN + IF(CIRC_MED(COUNT)==CIRC_MED(COUNT+1)) THEN + CRS_FLG=.TRUE.; EXIT + ENDIF + ENDDO + IF (.NOT.CRS_FLG) CYCLE INOD_LOOP + ENDIF - ! Insert sort node to triangles local list - TRUETHAT = .TRUE. - DO INP=1,NINTP_SEG - IF (SEGNODS(INP) == INOD) THEN - TRUETHAT = .FALSE. - EXIT - ENDIF - ENDDO - IF ( TRUETHAT ) THEN ! new inod entry on list - NINTP_SEG = NINTP_SEG + 1 - SEGNODS(NINTP_SEG) = INOD - ENDIF - ENDDO + ! X2AXIS, X3AXIS location of intersection: + XY(IAXIS:JAXIS) = (/BODINT_PLANE%XYZ(X2AXIS,INOD), BODINT_PLANE%XYZ(X3AXIS,INOD)/) + XPOS = XY(IAXIS) + IF ( X2NOC==0 ) THEN + JJ2_LO = FLOOR((XPOS-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + JJ2_HI = FLOOR((XPOS+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + IF (ALL((/JJ2_LO,JJ2_HI/) < X2LO_CELL) .OR. ALL((/JJ2_LO,JJ2_HI/) > X2HI_CELL)) CYCLE INOD_LOOP + JJ2_LO = MAX(JJ2_LO,X2LO_CELL); JJ2_HI = MIN(JJ2_HI,X2HI_CELL) + ELSE + FOUND_SEG = .FALSE.; JJ2_LO = -100; JJ2_HI = -100 + DO JJ2=X2LO_CELL,X2HI_CELL + ! Check if XPOS is within this segment JJ2: + IF ( ((XPOS-X2FACE(JJ2-1))>-GEOMEPS) .AND. ((X2FACE(JJ2)-XPOS)>-GEOMEPS) ) THEN + IF (JJ2_LO > -100) THEN + JJ2_HI = JJ2 + EXIT + ELSE + JJ2_LO = JJ2 + JJ2_HI = JJ2 + ENDIF + FOUND_SEG = .TRUE. + ENDIF + ENDDO + IF (.NOT.FOUND_SEG) CYCLE INOD_LOOP + ENDIF + XPOS = XY(JAXIS) + IF ( X3NOC==0 ) THEN + KK2_LO = FLOOR((XPOS-GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + KK2_HI = FLOOR((XPOS+GEOMEPS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + IF (ALL((/KK2_LO,KK2_HI/) < X3LO_CELL) .OR. ALL((/KK2_LO,KK2_HI/) > X3HI_CELL)) CYCLE INOD_LOOP + KK2_LO = MAX(KK2_LO,X3LO_CELL); KK2_HI = MIN(KK2_HI,X3HI_CELL) + ELSE + FOUND_SEG = .FALSE.; KK2_LO = -100; KK2_HI = -100 + DO KK2=X3LO_CELL,X3HI_CELL + ! Check if XPOS is within this segment KK2: + IF ( ((XPOS-X3FACE(KK2-1))>-GEOMEPS) .AND. ((X3FACE(KK2)-XPOS)>-GEOMEPS) ) THEN + IF (KK2_LO > -100) THEN + KK2_HI = KK2 + EXIT + ELSE + KK2_LO = KK2 + KK2_HI = KK2 + ENDIF + FOUND_SEG = .TRUE. + ENDIF + ENDDO + IF (.NOT.FOUND_SEG) CYCLE INOD_LOOP + ENDIF - IF(NINTP_SEG < 2) THEN - ! b. Now add face edge - SS edge intersection points: - ! x2 segments: - DO MYAXIS=IAXIS,JAXIS - SELECT CASE(MYAXIS) - CASE(IAXIS) - XIAXIS = IAXIS - XJAXIS = JAXIS - XIPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) - XJPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) - CASE(JAXIS) - XIAXIS = JAXIS - XJAXIS = IAXIS - XIPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) - XJPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) - END SELECT + ! Here JJ2 and KK2 have the face containing the intersection: + DO KK2=KK2_LO,KK2_HI + DO JJ2=JJ2_LO,JJ2_HI + FACERT(JJ2,KK2) = .TRUE. + ENDDO + ENDDO +ENDDO INOD_LOOP +DEALLOCATE(SEGS_NODE,ISEG_NODE,ANGS_NODE,CIRC_MED) - DO JPL=LOW_IND,HIGH_IND +T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) = T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) + CURRENT_TIME() - TNOW - XJPLN = XJPLNS(JPL) +IF (DEBUG_SET_CUTCELLS) THEN + ! Write out: + IF(INDX1 < 0) THEN + WRITE(BIPL_FILE,'(A,A,I3.3,A,I1.1,A,I2.1,A)') TRIM(CHID),'_BODINT_PLANE_',MY_RANK,'_',X1AXIS,'_',INDX1,'.csv' + ELSE + WRITE(BIPL_FILE,'(A,A,I3.3,A,I1.1,A,I2.2,A)') TRIM(CHID),'_BODINT_PLANE_',MY_RANK,'_',X1AXIS,'_',INDX1,'.csv' + ENDIF + LU_DB_SETCC = GET_FILE_NUMBER() + OPEN(LU_DB_SETCC,FILE=TRIM(BIPL_FILE),STATUS='UNKNOWN') + WRITE(LU_DB_SETCC,*) 'X1AXIS,X2AXIS,X3AXIS,X1PLN,GEOMEPS' + WRITE(LU_DB_SETCC,*) X1AXIS,X2AXIS,X3AXIS,X1PLN,GEOMEPS + WRITE(LU_DB_SETCC,*) 'NNODS, NSEGS, NSGLS, NTRIS' + WRITE(LU_DB_SETCC,*) BODINT_PLANE%NNODS,BODINT_PLANE%NSEGS,BODINT_PLANE%NSGLS,BODINT_PLANE%NTRIS + DO INOD=1,BODINT_PLANE%NNODS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%XYZ(IAXIS:KAXIS,INOD) + END DO + DO INOD=1,BODINT_PLANE%NNODS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%NOD_PERM(INOD) + ENDDO + DO ISEG=1,BODINT_PLANE%NSEGS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + END DO + DO ISEG=1,BODINT_PLANE%NSEGS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) + END DO + DO ISGL=1,BODINT_PLANE%NSGLS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%SGLS(NOD1,ISGL) + END DO + DO ITRI=1,BODINT_PLANE%NTRIS + WRITE(LU_DB_SETCC,*) BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) + ENDDO + CLOSE(333) +ENDIF - XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD1) ) - XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD2) ) +RETURN +END SUBROUTINE GET_BODINT_PLANE +SUBROUTINE GET_X2_INTERSECTIONS(X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN) - ! b-1. Drop if Edge on one side of segment ray: - MAXXJ = MAX(XY1(XJAXIS),XY2(XJAXIS)) - MINXJ = MIN(XY1(XJAXIS),XY2(XJAXIS)) - OUTPLANE1 = ((XJPLN-MAXXJ) > GEOMEPS) .OR. ((MINXJ-XJPLN) > GEOMEPS) - IF ( OUTPLANE1 ) CYCLE +INTEGER, INTENT(IN) :: X1AXIS, X2AXIS, X3AXIS +REAL(EB),INTENT(IN) :: X3RAY,X1PLN - ! b-2. Also drop if Edge ouside of face edge limits: - MAXXI = MAX(XY1(XIAXIS),XY2(XIAXIS)) - MINXI = MIN(XY1(XIAXIS),XY2(XIAXIS)) - OUTPLANE2 = ((XIPLNS(LOW_IND)-MAXXI) > GEOMEPS) .OR. ((MINXI-XIPLNS(HIGH_IND)) > GEOMEPS) - IF ( OUTPLANE2 ) CYCLE +! Local Variables: +INTEGER :: ISGL, SGL, ISEG, SEG(NOD1:NOD2) +REAL(EB):: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, DOT1, DOT2 +REAL(EB):: SVARI, STANI(IAXIS:JAXIS) +INTEGER :: ICRSI(LOW_IND:HIGH_IND+1), SCRSI, ISSEG(LOW_IND:HIGH_IND), GAM(LOW_IND:HIGH_IND) +REAL(EB):: X3MIN, X3MAX, DV12(MAX_DIM), MODTI, NOMLI(IAXIS:JAXIS) +LOGICAL :: OUTRAY +REAL(EB):: DELBIN, AVAL +INTEGER :: ILO_BIN,IHI_BIN,IBIN,IISEG,ICR - ! Test if segment aligned with xi - XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) - IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. +REAL(EB) :: TNOW +! INTEGER :: IAUX - ! Drop intersections in EDGE nodes: already added. - ! Compute: dot(plnormal, xyzv - xypl): - DOT1 = XY1(XJAXIS) - XJPLN - DOT2 = XY2(XJAXIS) - XJPLN +TNOW = CURRENT_TIME() - IF ( ABS(DOT1) <= GEOMEPS ) CYCLE - IF ( ABS(DOT2) <= GEOMEPS ) CYCLE +! Initialize crossings arrays: +CC_N_CRS = 0 +CC_SVAR_CRS = 1._EB / GEOMEPS +CC_IS_CRS = CC_UNDEFINED +CC_IS_CRS2 = CC_UNDEFINED +CC_SEG_TAN = 0._EB +CC_SEG_CRS = 0 +CC_BDNUM_CRS = 0 ! Size (0:CC_MAXCROSS_X2) +CC_BDNUM_CRS_AUX= 0 ! Size (0:CC_MAXCROSS_X2) - ! Finally regular case: - ! Points 1 on one side of x2 segment, point 2 on the other: - IF ( DOT1*DOT2 < 0._EB ) THEN +! First Single points: +! Treat them as [GASPHASE GASPHASE] crossings: +DO ISGL=1,BODINT_PLANE%NSGLS + SGL = BODINT_PLANE%SGLS(NOD1,ISGL) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SGL) + ! x2-x3 coordinates of point: + X2_1 = XYZ1(X2AXIS) + X3_1 = XYZ1(X3AXIS) - ! Intersection Point along segment: - DS = (XJPLN-XY1(XJAXIS))/(XY2(XJAXIS)-XY1(XJAXIS)) - SVARI = XY1(XIAXIS) + DS*(XY2(XIAXIS)-XY1(XIAXIS)) + ! Dot product dot(X_1-XRAY,e3) + DOT1 = X3_1-X3RAY + IF (ABS(DOT1) <= GEOMEPS) DOT1=0._EB + IF ( ABS(DOT1) == 0._EB ) THEN + ! Point 1: + SVARI = X2_1 + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_GASPHASE, CC_UNDEFINED /) + SCRSI = -ISGL + STANI(IAXIS:JAXIS) = 0._EB - OUTSEG= ((XIPLNS(LOW_IND)-SVARI) > -GEOMEPS) .OR. ((SVARI-XIPLNS(HIGH_IND)) > -GEOMEPS) - IF ( OUTSEG ) CYCLE + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) ! Modifies crossings arrays. + ENDIF +ENDDO - ! Insertion add point to intersection list: - XP(XIAXIS) = SVARI - XP(XJAXIS) = XJPLN - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) +! Now Segments: +NSEGS_COND : IF (BODINT_PLANE%NSEGS > 0) THEN - ! Insert sort node to EDGES local list - TRUETHAT = .TRUE. - DO INP=1,NINTP_SEG - IF (SEGNODS(INP) == INOD) THEN - TRUETHAT = .FALSE. - EXIT - ENDIF - ENDDO - IF (TRUETHAT) THEN ! new inod entry on list - NINTP_SEG = NINTP_SEG + 1 - SEGNODS(NINTP_SEG) = INOD - ENDIF - CYCLE - ENDIF - ENDDO - ENDDO - ENDIF +DELBIN = BODINT_PLANE%TBAXIS(X3AXIS)%DELBIN +AVAL = (X3RAY-GEOMEPS-BODINT_PLANE%BOX(LOW_IND,X3AXIS))/DELBIN +ILO_BIN= MAX(1, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS,EB),ABS(AVAL)) )) +AVAL = (X3RAY+GEOMEPS-BODINT_PLANE%BOX(LOW_IND,X3AXIS))/DELBIN +IHI_BIN= MIN(BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE%TBAXIS(X3AXIS)%N_BINS,EB),ABS(AVAL)) )) +IBIN_DO : DO IBIN=ILO_BIN,IHI_BIN - IF ( (NINTP_SEG < 2) .OR. (SEGNODS(NOD1) == SEGNODS(NOD2)) ) CYCLE + IF (X3RAY < BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%X1_LOW -GEOMEPS) CYCLE + IF (X3RAY > BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE - ! Test if Edge already on list: - INLIST = .FALSE. - DO ISEG=1,NEDGE + TRIBIN_DO : DO IISEG=1,BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%NTL - IF ( (SEGNODS(NOD1) == CEELEM(NOD1,ISEG)) .AND. & ! same inod1 - (SEGNODS(NOD2) == CEELEM(NOD2,ISEG)) .AND. & ! same inod2 - (BODINT_PLANE%INDSEG(4,IWSSEG) == INDSEG(4,ISEG)) ) THEN ! same ibod + ISEG = BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) +!SEGMENTS_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS - IF (ANY(BODINT_PLANE%INDSEG(2:3,IWSSEG) == INDSEG(2,ISEG))) THEN - ! Edge already in list, Use SS Edge INDSEG: - INDSEG(1:4,ISEG) = BODINT_PLANE%INDSEG(1:4,IWSSEG) - INLIST = .TRUE. - EXIT - ELSE - WRITE(LU_ERR,*) "Error in GET_TRIANG_FACE_INT: SS EDGE Triangles not on 2 WS triang list INDSEG." - ENDIF - ENDIF - ENDDO + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) - IF ( .NOT.INLIST ) THEN ! Edge not in list. - NEDGE = NEDGE + 1 - CEELEM(NOD1:NOD2,NEDGE) = SEGNODS(NOD1:NOD2) - INDSEG(1:4,NEDGE) = BODINT_PLANE%INDSEG(1:4,IWSSEG) - ENDIF -ENDDO + ! x2,x3 coordinates of segment: + X2_1 = XYZ1(X2AXIS) + X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. + X2_2 = XYZ2(X2AXIS) + X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. -! Populate XYVERT points array: -IF(SIZE_X2X3VERT > SIZE(XYVERT,DIM=2)) THEN - WRITE(LU_ERR,*) 'Error in GET_TRIANG_FACE_INT : SIZE_X2X3VERT in greater than SIZE(XYVERT,DIM=2).' - CALL SHUTDOWN('Shutting down..') -ENDIF -XYVERT = 0._EB -XYVERT(IAXIS:JAXIS,1:SIZE_X2X3VERT) = X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT) -NVERT = NINTP -IF (NVERT > 0) INB_FLG = .TRUE. + ! First Test if the whole segment is on one side of the Ray: + ! Test segment crosses the ray, or is in geomepsilon proximity + ! of it: + X3MIN = MIN(X3_1,X3_2) + X3MAX = MAX(X3_1,X3_2) + OUTRAY=(((X3RAY-X3MAX) > GEOMEPS) .OR. ((X3MIN-X3RAY) > GEOMEPS)) -DEALLOCATE(FVERT_IN_TRIANG, TRIVERT_IN_FACE) + IF (OUTRAY) CYCLE -RETURN -END SUBROUTINE GET_TRIANG_FACE_INT + DOT1 = X3_1-X3RAY + DOT2 = X3_2-X3RAY -! ------------------------- INSERT_POINT_2D ------------------------------------- + IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB + IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB -SUBROUTINE INSERT_POINT_2D(XP,NVERT,SIZE_XYVERT,XYVERT,INOD) + ! Segment tangent unit vector. + DV12(IAXIS:JAXIS) = XYZ2( (/ X2AXIS, X3AXIS /) ) - XYZ1( (/ X2AXIS, X3AXIS /) ) + MODTI = SQRT( DV12(IAXIS)**2._EB + DV12(JAXIS)**2._EB ) + STANI(IAXIS:JAXIS) = DV12(IAXIS:JAXIS) * MODTI**(-1._EB) + NOMLI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) + ISSEG(LOW_IND:HIGH_IND) = BODINT_PLANE%SEGTYPE(LOW_IND:HIGH_IND,ISEG) -REAL(EB), INTENT(IN) :: XP(IAXIS:JAXIS) -INTEGER, INTENT(INOUT) :: NVERT -INTEGER, INTENT(INOUT) :: SIZE_XYVERT -REAL(EB), ALLOCATABLE, INTENT(INOUT) :: XYVERT(:,:) -INTEGER, INTENT(OUT) :: INOD + ! For x2, in local x2-x3 coords e2=(1,0): + GAM(LOW_IND) = (1 + NINT(SIGN( 1._EB, NOMLI(IAXIS))) ) / 2 !(1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; + GAM(HIGH_IND)= (1 - NINT(SIGN( 1._EB, NOMLI(IAXIS))) ) / 2 !(1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; -! Local Variables: -LOGICAL :: INLIST -REAL(EB):: DV(IAXIS:JAXIS), DVNORM -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYVERT_AUX + ! Test if whole segment is in ray, if so add segment nodes as crossings: + IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN -INLIST = .FALSE. -DO INOD=1,NVERT - DV(IAXIS:JAXIS) = XP(IAXIS:JAXIS) - XYVERT(IAXIS:JAXIS,INOD) - DVNORM = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB ) - IF ( DVNORM < GEOMEPS ) THEN - INLIST = .TRUE. - EXIT - ENDIF -ENDDO -IF ( .NOT.INLIST ) THEN - NVERT = NVERT + 1 - INOD = NVERT - ! If NVERT > SIZE(XYVERT,DIM=2) reallocate: - IF(NVERT > SIZE_XYVERT) THEN - ALLOCATE(XYVERT_AUX(IAXIS:JAXIS,1:SIZE_XYVERT)); XYVERT_AUX(:,:) = XYVERT(:,:) - DEALLOCATE(XYVERT); ALLOCATE(XYVERT(IAXIS:JAXIS,SIZE_XYVERT+DELTA_VERT)); XYVERT = 0._EB - XYVERT(IAXIS:JAXIS,1:SIZE_XYVERT) = XYVERT_AUX(IAXIS:JAXIS,1:SIZE_XYVERT) - SIZE_XYVERT = SIZE_XYVERT + DELTA_VERT - ENDIF - XYVERT(IAXIS:JAXIS,INOD) = XP(IAXIS:JAXIS) -ENDIF + ! Count both points as crossings: + ! Point 1: + SVARI = MIN(X2_1,X2_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) + SCRSI = ISEG + + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) -RETURN -END SUBROUTINE INSERT_POINT_2D + DO ICR=2,BODINT_PLANE%NBCROSS(ISEG)-1 + SVARI = X2_1 + BODINT_PLANE%SVAR(ICR,ISEG)*STANI(IAXIS) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ENDDO -! ---------------------------- DEBUG_WAIT --------------------------------------- + ! Point 2: + SVARI = MAX(X2_1,X2_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) + SCRSI = ISEG -SUBROUTINE DEBUG_WAIT -USE COMP_FUNCTIONS, ONLY: FDS_SLEEP -INTEGER I -INTEGER, PARAMETER :: N_SEG=20 -WRITE(LU_ERR,'(A,I6,A,I2,A)') 'Process ID=',MY_RANK,'; execution halted for ',N_SEG,' seconds : ' -DO I=1,N_SEG - CALL FDS_SLEEP(1._EB) - IF (I 0. .AND. DOT2 < 0.) .OR. (DOT1 < 0. .AND. DOT2 > 0.)) + IF ( DOT1*DOT2 < 0._EB ) THEN -INTEGER :: ILINE, IERR -INTEGER :: IG, IVERT + ! Intersection Point along segment: + !DS = (X3RAY-X3_1) / (X3_2-X3_1) + !SVARI = X2_1 + DS*(X2_2-X2_1) + SVARI = X2_1 + (X3RAY-X3_1) * (X2_2-X2_1) / (X3_2-X3_1) -INTEGER, ALLOCATABLE, DIMENSION(:) :: GEOM_LINE,GEOM_LINE2 -INTEGER, PARAMETER :: DELTA_GEOM_LINE=1000 -INTEGER :: GEOM_LINE_SIZE + ! LOW and HIGH media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND) = GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1) = CC_UNDEFINED + SCRSI = ISEG -NAMELIST /GEOM/ BNDF_GEOM,BINARY_FILE,CELL_BLOCK_IOR,CELL_BLOCK_ORIENTATION,COLOR,CYLINDER_ORIGIN,CYLINDER_AXIS,& - CYLINDER_RADIUS,CYLINDER_LENGTH,CYLINDER_NSEG_THETA,CYLINDER_NSEG_AXIS,& - EXTRUDE,EXTEND_TERRAIN,FACES,FYI,ID,IJK,IS_TERRAIN,MOVE_ID,N_LAT,N_LEVELS,N_LONG,POLY,& - RGB,SPHERE_ORIGIN,SPHERE_RADIUS,SPHERE_TYPE,SURF_ID,SURF_IDS,SURF_ID6,& - TEXTURE_MAPPING,TEXTURE_ORIGIN,TEXTURE_SCALE,TRANSPARENCY,& - VERTS,XB,ZMIN,ZVALS,ZVAL_HORIZON + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) -! first pass - count number of &GEOM lines. + CYCLE -N_GEOMETRY=0 -ALLOCATE(GEOM_LINE(DELTA_GEOM_LINE)); GEOM_LINE = 0 -GEOM_LINE_SIZE = SIZE(GEOM_LINE,DIM=1) -REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 -COUNT_GEOM_LOOP: DO - CALL CHECKREAD('GEOM',LU_INPUT,IOS) ; IF (STOP_STATUS==SETUP_STOP) RETURN - IF (IOS==1) EXIT COUNT_GEOM_LOOP - IF(N_GEOMETRY+1 > GEOM_LINE_SIZE) THEN - ALLOCATE(GEOM_LINE2(GEOM_LINE_SIZE)) - GEOM_LINE2(1:GEOM_LINE_SIZE) = GEOM_LINE(1:GEOM_LINE_SIZE) - DEALLOCATE(GEOM_LINE) - ALLOCATE(GEOM_LINE(GEOM_LINE_SIZE+DELTA_GEOM_LINE)); GEOM_LINE = 0 - GEOM_LINE(1:GEOM_LINE_SIZE) = GEOM_LINE2(1:GEOM_LINE_SIZE) - GEOM_LINE_SIZE = SIZE(GEOM_LINE,DIM=1) - DEALLOCATE(GEOM_LINE2) ENDIF - READ(LU_INPUT,'(A)')BUFFER - N_GEOMETRY=N_GEOMETRY+1 - GEOM_LINE(N_GEOMETRY) = INPUT_FILE_LINE_NUMBER -ENDDO COUNT_GEOM_LOOP -REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 -IF (N_GEOMETRY==0) RETURN -! Allocate GEOMETRY array + print*, "Error GET_X2INTERSECTIONS: Missed segment=",ISEG -ALLOCATE(GEOMETRY(0:N_GEOMETRY),STAT=IZERO) -CALL ChkMemErr('READ_GEOM','GEOMETRY',IZERO) + ENDDO TRIBIN_DO +ENDDO IBIN_DO +!ENDDO SEGMENTS_LOOP -! third pass - read GEOM data +ENDIF NSEGS_COND -READ_GEOM_LOOP: DO N=1,N_GEOMETRY - G=>GEOMETRY(N) +! Do we have any intersections? +IF ( CC_N_CRS == 0 ) RETURN - CALL CHECKREAD('GEOM',LU_INPUT,IOS) ; IF (STOP_STATUS==SETUP_STOP) RETURN - IF (IOS==1) EXIT READ_GEOM_LOOP +! Collapse crossings to single SVARs: +CALL COLLAPSE_CROSSINGS(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,1) - IF(MAX_ZVALS/=MAXIMUM_GEOMETRY_ZVALS) THEN ! Reset to default GEOMETRY values and allocate ARRAYS. - MAX_ZVALS=0; MAX_VERTS=0; MAX_FACES=0; MAX_VOLUS=0; MAX_IDS=0; MAX_SURF_IDS=0; MAX_POLY_VERTS=0 - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - CALL ALLOCATE_BUFFERS - ENDIF - GEOM_RESIZE_DO : DO - DONE=.TRUE. - CALL SET_GEOM_DEFAULTS - READ(LU_INPUT,GEOM,END=35,ERR=22,IOSTAT=IOS) - 22 IF (IOS>0) THEN - IF ( (ZVALS(MAX_ZVALS+1) < MAX_VAL) .OR. (VERTS(3*MAX_VERTS+1) < MAX_VAL) .OR.& - (FACES(4*MAX_FACES+1) > 0) .OR. (VOLUS(4*MAX_VOLUS+1) > 0)) THEN - ! Resize MAX_ZVALS, MAX_VERTS, MAX_FACES, MAX_VOLUS: - MAX_ZVALS = MAX_ZVALS + 25000 - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - CALL ALLOCATE_BUFFERS - DONE=.FALSE. - ELSE - WRITE(BUFFER,'(A,A,A)') 'ERROR(101): GEOM ID=',TRIM(ID),'. Check &GEOM input line.' - CALL SHUTDOWN(TRIM(BUFFER)) - RETURN - ENDIF - REWIND(LU_INPUT); DO ILINE=1,GEOM_LINE(N)-1; READ(LU_INPUT,'(A)') BUFFER; ENDDO - ENDIF - IF (DONE) EXIT GEOM_RESIZE_DO - ENDDO GEOM_RESIZE_DO +! Write out: +! print*, "X3RAY=",X3RAY,", Intersect X2=",CC_N_CRS +! DO ICRS=1,CC_N_CRS +! print*, ICRS,", ",CC_SVAR_CRS(ICRS),", ",CC_IS_CRS(ICRS) +! ENDDO - IF (COLOR/='null') THEN - CALL COLOR2RGB(RGB,COLOR) - ENDIF - G%CELL_BLOCK_IOR = CELL_BLOCK_IOR - G%CELL_BLOCK_ORIENTATION = CELL_BLOCK_ORIENTATION - G%RGB = RGB - G%TRANSPARENCY = TRANSPARENCY - N_VERTS=0 - N_FACES=0 - TFACES(1:6*MAX_FACES) = -1.0_EB - N_VOLUS=0 - N_ZVALS=0 - N_POLY_VERTS=0 - IF(TRIM(BINARY_FILE)/='null') READ_BINARY = .TRUE. ! In case a binary name is provided, read the binary. - G%READ_BINARY = READ_BINARY +T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW - ! Get number of SURF_IDs defined for the GEOM: - N_SURF_ID = 0 - DO I = 1, MAX_SURF_IDS - IF( SURF_ID(I)=='null' ) EXIT ! First 'null' - N_SURF_ID = N_SURF_ID + 1 - ENDDO +RETURN +END SUBROUTINE GET_X2_INTERSECTIONS - READ_BIN_COND : IF (.NOT.READ_BINARY) THEN - ! count VERTS - DO I = 1, MAX_VERTS - IF (ANY(VERTS(3*I-2:3*I)>=MAX_VAL)) EXIT - N_VERTS = N_VERTS+1 - ENDDO - ! count POLY Verts: - DO I = 1,MAX_POLY_VERTS - IF (POLY(I)==0) EXIT - N_POLY_VERTS = N_POLY_VERTS+1 - ENDDO +! ------------------------ COLLAPSE_CROSSINGS ----------------------------------- + +SUBROUTINE COLLAPSE_CROSSINGS(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,ITITLE) + +TYPE(BODINT_PLANE_TYPE), INTENT(IN) :: BODINT_PLANE2 +INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,ITITLE +REAL(EB), INTENT(IN) :: X3RAY,X1PLN + +! Local Variables: +INTEGER :: CC_N_CRS_AUX +REAL(EB):: CC_SVAR_CRS_AUX(CC_MAXCROSS_X2) +INTEGER :: CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_MAXCROSS_X2),BODNUM(CC_MAXCROSS_X2) +REAL(EB):: CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_MAXCROSS_X2) +INTEGER :: CC_SEG_CRS_AUX(CC_MAXCROSS_X2) +INTEGER :: CRS_NUM(CC_MAXCROSS_X2),IND_CRS(LOW_IND:HIGH_IND,CC_MAXCROSS_X2) +INTEGER :: LEFT_MEDIA, NCRS_REMAIN +INTEGER :: ICRS, ICRS1, ICRS2, IDCR, IDCR2, IND_LEFT, IND_RIGHT, NUBD, IBDNUM, ISEG, IUBD, SBOD +LOGICAL :: DROP_SS_GG, FOUND_LEFT, NOT_COUNTED(CC_MAXCROSS_X2), USE_INT_POINT(CC_MAXCROSS_X2), ALGN_CROSS +INTEGER, ALLOCATABLE, DIMENSION(:) :: UBOD - ! count FACES - DO I = 1, MAX_FACES - IF (ALL(FACES(4*(I-1)+1:4*(I-1)+3)==0)) EXIT - N_FACES = N_FACES+1 - ENDDO +CC_N_CRS_AUX = 0 +CC_SVAR_CRS_AUX = 1._EB/GEOMEPS ! svar = x2_intersection +CC_IS_CRS2_AUX = CC_UNDEFINED ! Is the intersection an actual GS. +CC_SEG_CRS_AUX = 0 ! Segment containing the crossing. +CC_SEG_TAN_AUX = 0._EB ! Segment orientation for each intersection. - ! Now split FACES array into FACES (connectivity), and SURFS, i.e. local surf ID: - IF(N_FACES > 0) THEN - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)) - DO I = 1, N_FACES - FACES(3*(I-1)+1:3*(I-1)+3) = FACES(4*(I-1)+1:4*(I-1)+3) - SURFS(I) = FACES(4*(I-1)+4) - IF(SURFS(I) > N_SURF_ID) THEN - WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(701): problem with GEOM ',TRIM(ID),& - ', local SURF_ID index for FACE ',I,'out of bounds.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - ENDIF +! Count how many crossings with different SVAR: +CRS_NUM(:) = 0 +ICRS = 1 +CRS_NUM(ICRS) = 1 +IND_CRS(:,:) = 0 +IND_CRS(LOW_IND, CRS_NUM(ICRS)) = ICRS-1 +IND_CRS(HIGH_IND,CRS_NUM(ICRS)) = IND_CRS(HIGH_IND,ICRS)+1 - ! count VOLUS - DO I = 1, MAX_VOLUS - IF (ANY(VOLUS(4*I-3:4*I)==0)) EXIT - N_VOLUS = N_VOLUS+1 - ENDDO +DO ICRS=2,CC_N_CRS + IF ( ABS(CC_SVAR_CRS(ICRS)-CC_SVAR_CRS(ICRS-1)) < GEOMEPS ) THEN + CRS_NUM(ICRS) = CRS_NUM(ICRS-1) + ELSE + CRS_NUM(ICRS) = CRS_NUM(ICRS-1)+1 + IND_CRS(LOW_IND,CRS_NUM(ICRS)) = ICRS-1 + ENDIF + IND_CRS(HIGH_IND,CRS_NUM(ICRS)) = IND_CRS(HIGH_IND,CRS_NUM(ICRS))+1 +ENDDO - ! count ZVALS - DO I = 1, MAX_ZVALS - IF (ZVALS(I)>MAX_VAL) EXIT - N_ZVALS=N_ZVALS+1 - ENDDO +! Computation of CC_BDNUM_CRS_AUX requires knowledge of how many different +! bodies reach an intersection: +BODNUM(:) = 0 +ALLOCATE(UBOD(N_GEOMETRY)); UBOD=0 +IDCR_DO_1 : DO IDCR=1,CRS_NUM(CC_N_CRS) + ! Load body numbers: + DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + ISEG=CC_SEG_CRS(IDCR2) + IF (ISEG > 0) BODNUM(IDCR2)=BODINT_PLANE2%INDSEG(4,ISEG) + ENDDO + ! Unique bodies: + NUBD = 0 + DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF ( BODNUM(IDCR2)<1 ) CYCLE + IF ((NUBD > 0) .AND. ANY(UBOD(1:NUBD)==BODNUM(IDCR2))) CYCLE + NUBD = NUBD + 1 + UBOD(NUBD) = BODNUM(IDCR2) + ENDDO + ! Now assign CC_BDNUM_CRS_AUX(IDCR): + SBOD = 0 + DO IUBD=1,NUBD + ! Drop extra intersections (same intersection type, same body): + USE_INT_POINT(IND_CRS(LOW_IND,IDCR)+1:IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR)) = .TRUE. + DO ICRS1=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF (.NOT.USE_INT_POINT(ICRS1)) CYCLE ! Don't use collapsed point as pivot. + ! Collapse GS or SG points: + DO ICRS2 = IND_CRS(LOW_IND,IDCR)+1 , IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF ( (ICRS2==ICRS1) .OR. .NOT.USE_INT_POINT(ICRS2) ) CYCLE ! Don't use pivot, or collapsed point. + IF ((CC_IS_CRS2(LOW_IND ,ICRS1) == CC_IS_CRS2(LOW_IND ,ICRS2)) .AND. & + (CC_IS_CRS2(HIGH_IND,ICRS1) == CC_IS_CRS2(HIGH_IND,ICRS2)) .AND. & + (BODNUM(ICRS1) == BODNUM(ICRS2))) THEN + USE_INT_POINT(ICRS2) = .FALSE. + ENDIF + ENDDO + ENDDO + IBDNUM=0 + DO IDCR2=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF (BODNUM(IDCR2) /= UBOD(IUBD)) CYCLE + IF ( .NOT.USE_INT_POINT(IDCR2) ) CYCLE + IBDNUM = IBDNUM + CC_BDNUM_CRS(IDCR2) + ENDDO + IF (IBDNUM /= 0) SBOD = SBOD + SIGN(1,IBDNUM) + ENDDO + IF (IDCR == 1) THEN + CC_BDNUM_CRS_AUX(IDCR) = SBOD + ELSE + CC_BDNUM_CRS_AUX(IDCR) = CC_BDNUM_CRS_AUX(IDCR-1) + SBOD + ENDIF +ENDDO IDCR_DO_1 +DEALLOCATE(UBOD) - ELSE READ_BIN_COND - ! Read Binary file, reset values of other geometry types to default: - ! Defaults for terrain, sphere, cylinder, box, etc. - XB=1.001_EB*MAX_VAL - SPHERE_ORIGIN = 1.001_EB*MAX_VAL - SPHERE_RADIUS = 1.001_EB*MAX_VAL - CYLINDER_LENGTH = 1.001_EB*MAX_VAL - CYLINDER_RADIUS = 1.001_EB*MAX_VAL - CYLINDER_ORIGIN = 1.001_EB*MAX_VAL - CYLINDER_AXIS = 1.001_EB*MAX_VAL - CYLINDER_NSEG_THETA = -1 - CYLINDER_NSEG_AXIS = -1 - N_LEVELS=-1 - N_LAT=-1 - N_LONG=-1 - SPHERE_TYPE=-1 - ! This is to add the SURF_IDS to SURF_ID for analytical geometries being read from bingeom: - IF (TRIM(SURF_ID(1))=='null' .AND. TRIM(SURF_IDS(1))/='null') THEN ! Case of cylinders. - SURF_ID(1:3) = SURF_IDS(1:3) - N_SURF_ID = 3 - DO I=2,3 - IF (TRIM(SURF_ID(I))=='null') THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR(702): problem with GEOM ',TRIM(ID),', SURF_IDS not defined properly.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - ENDIF +! This is where we merge intersections at same svar location (i.e. same CRS_NUM value): +! Loop over different crossings: +LEFT_MEDIA = CC_GASPHASE ! Here we could change the initial LEFT_MEDIA to CC_SOLID if needed. Would require adding + ! CC_BDNUM_CRS(LOW_IND,0) = 1, i.e crossed into SOLID at x2 -> -Inf. +IDCR_DO_2 : DO IDCR=1,CRS_NUM(CC_N_CRS) - ! Read Binary - OPEN(UNIT=731,FILE=TRIM(BINARY_FILE),STATUS='OLD',FORM='UNFORMATTED',ACTION='READ',ERR=221,IOSTAT=IOS) - IF (IOS==0) THEN - READ(731) GEOM_TYPE - READ(731) N_VERTS,N_FACES,N_SURF_ID2,N_VOLUS - IF(GEOM_TYPE==TERRAIN_GEOM_TYPE) THEN - IS_TERRAIN=.TRUE. - ELSE ! If GEOM is of any type other than terrains, set it to CAD type. - GEOM_TYPE=CAD_GEOM_TYPE - ENDIF - ! Now reallocate if necessary, twice size is to make sure terrains have sufficient array size allocated: - IF (2*N_VERTS > MAX_VERTS) THEN; MAX_VERTS=2*N_VERTS; DEALLOCATE(VERTS); ALLOCATE(VERTS(1:3*MAX_VERTS)); ENDIF - IF (2*N_FACES > MAX_FACES) THEN - MAX_FACES=2*N_FACES - DEALLOCATE(FACES); ALLOCATE(FACES(1:3*MAX_FACES)) - DEALLOCATE(TFACES); ALLOCATE(TFACES(1:6*MAX_FACES)) - ENDIF - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(MAX_FACES)) - IF (2*N_VOLUS > MAX_VOLUS) THEN; MAX_VOLUS=2*N_VOLUS; DEALLOCATE(VOLUS); ALLOCATE(VOLUS(1:4*N_VOLUS)); ENDIF - ! Read Vertices, Faces, Surfs and Volus: - IF (N_VERTS > 0 ) READ(731) VERTS(1:3*N_VERTS) - IF (N_FACES > 0 ) THEN - READ(731) FACES(1:3*N_FACES) - READ(731) SURFS(1:N_FACES) - ENDIF - IF (N_VOLUS > 0 ) READ(731) VOLUS(1:4*N_VOLUS) - CLOSE(731) - IF (ANY(SURFS(1:N_FACES)>0) .AND. TRIM(SURF_ID(1))=='null') THEN - WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR(703): missing SURF_ID in &GEOM line ',TRIM(ID),& - ' for binary file ',TRIM(BINARY_FILE),& - '. Add SURF_ID in said &GEOM line.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - IF(N_SURF_ID2 /= N_SURF_ID) THEN - WRITE(MESSAGE,'(A,A,A,I8,A,I8,A,A,A)') 'ERROR(704): problem with GEOM ',TRIM(ID),& - ', number of surfaces in SURF_ID field (',N_SURF_ID, & - ') not equal to number of surfaces (',N_SURF_ID2,& - ') defined in bingeom ',TRIM(BINARY_FILE),'.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - DO I = 1, N_FACES - IF(SURFS(I) > N_SURF_ID) THEN - WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(701): problem with GEOM ',TRIM(ID),& - ', local SURF_ID index for FACE ',I,'out of bounds.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - ENDIF -221 IF(IOS > 0) THEN - WRITE(MESSAGE,'(A,A,A,A,A)') 'ERROR(705): could not read binary connectivity for GEOM ',TRIM(ID),& - ' in binary file ',TRIM(BINARY_FILE),& - '. Check file exists.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDIF READ_BIN_COND + CC_N_CRS_AUX = CC_N_CRS_AUX + 1 + ! Case of single crossing with new svar: + SNGL_CRS_IF : IF ( IND_CRS(HIGH_IND,IDCR) == 1 ) THEN - N_VERTS_ORIG = N_VERTS - N_FACES_ORIG = N_FACES - N_VOLUS_ORIG = N_VOLUS + ICRS =IND_CRS(LOW_IND,IDCR) + 1 - !--- setup a 2D surface (terrain) object (ZVALS keyword ) - ZVALS_IF: IF (N_ZVALS>0) THEN - GEOM_TYPE = TERRAIN_GEOM_TYPE - TERRAIN_CASE= .TRUE. - CALL CHECK_XB(XB) - IF (N_ZVALS/=IJK(1)*IJK(2) ) THEN - WRITE(MESSAGE,'(A,I4,A,I4)') 'ERROR(706): Expected ',IJK(1)*IJK(2),' Z values, found ',N_ZVALS - CALL SHUTDOWN(MESSAGE) - ENDIF - IF (IJK(1)<2 .OR. IJK(2)<2) THEN - CALL SHUTDOWN('ERROR(707): IJK(1) and IJK(2) on &GEOM line needs to be at least 2.') - ENDIF - NXB=0 - DO I = 1, 4 ! first 4 XB values must be set, don't care about 5th and 6th - IF (XB(I)1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN + ! Test if already inside an Object. + CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) = CC_SOLID + ELSEIF ( CC_IS_CRS2(LOW_IND,ICRS) /= LEFT_MEDIA ) THEN - IF (EXTEND_TERRAIN) THEN - ! Find XLOW,XHI,YLOW,YHI for the set of NM meshes defined: - XLOW = 1.E10_EB - XHI =-1.E10_EB - YLOW = 1.E10_EB - YHI =-1.E10_EB - DO NM=1,NMESHES - XLOW = MIN(XLOW,MESHES(NM)%XS) - XHI = MAX(XHI ,MESHES(NM)%XF) - YLOW = MIN(YLOW,MESHES(NM)%YS) - YHI = MAX(YHI ,MESHES(NM)%YF) - ENDDO - WRITE_WARNING=.FALSE. - IF((XB(1)<=XLOW) .OR. (XB(2)>=XHI)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF((XB(3)<=YLOW) .OR. (XB(4)>=YHI)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF(MY_RANK==0 .AND. WRITE_WARNING) WRITE(LU_ERR,'(A,A,A)') 'Warning : Terrain &GEOM ',TRIM(ID),& - ' cannot be extended. When setting EXTEND_TERRAIN=T, make sure it lays entirely within the computational domain.' + ! Check if this is a single point SGLS which was initially tagged as CC_GASPHASE, + ! if so switch media type to LEFT_MEDIA + IF (CC_SEG_CRS(ICRS) < 0) THEN + CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) = LEFT_MEDIA + ELSE + IF (ITITLE==1) THEN + WRITE(LU_ERR,*) "Error GET_X2INTERSECTIONS: IS_CRS(LOW_IND,ICRS) ~= LEFT_MEDIA, media continuity problem" + WRITE(LU_ERR,*) "X1AXIS,X1PLN=",X1AXIS,X1PLN,", X2AXIS,X3AXIS=",X2AXIS,X3AXIS,", RAY X3 POSITION=",X3RAY + ELSEIF (ITITLE==2) THEN + WRITE(LU_ERR,*) "Error GET_IS_SOLID_PT: IS_CRS(LOW_IND,ICRS) ~= LEFT_MEDIA, media continuity problem" + WRITE(LU_ERR,*) "X1AXIS,X1PLN=",X1AXIS,X1PLN,", X2AXIS,X3AXIS=",X2AXIS,X3AXIS,", RAY X3 POSITION=",X3RAY + ENDIF + IF (IDCR==1) THEN + ! FIXME: this should be the error message, IG should be made available here + ! WRITE(MESSAGE,'(A,A,A)') "ERROR: GEOM ID='", TRIM(GEOMETRY(IG)%ID), & + ! "': Face normals are probably pointing in the wrong direction. Check they point towards the gas phase." + IF (POSITIVE_ERROR_TEST) THEN + WRITE(LU_ERR,'(A)') " SUCCESS: GEOM ID Unknown:" + ELSE + WRITE(LU_ERR,'(A)') " ERROR(726): GEOM ID Unknown:" + ENDIF + WRITE(LU_ERR,'(A)') " Face normals are probably pointing in the wrong direction. " + WRITE(LU_ERR,'(A)') " Check they point towards the gas phase." + ENDIF + CALL SHUTDOWN("") ; RETURN + ENDIF ENDIF - ! Move Low Z position of terrain to less that number od cutcells, s.t. they don't get computed on the bottom. - ZMIN2= 1.E10_EB - DO NM=1,NMESHES - ZMIN2 = MIN( ZMIN2 , MESHES(NM)%ZS-REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) - ENDDO - ZHI = MAXVAL(ZVALS(1:N_ZVALS)) - ZLOW = MINVAL(ZVALS(1:N_ZVALS)) - ZLOW = MIN(REAL(FLOOR(ZLOW-0.1_EB*(ZHI-ZLOW)),EB),ZMIN,ZMIN2) + CC_SVAR_CRS_AUX(CC_N_CRS_AUX) = CC_SVAR_CRS(ICRS) + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) + CC_SEG_CRS_AUX(CC_N_CRS_AUX) = CC_SEG_CRS(ICRS) + CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_N_CRS_AUX) = CC_SEG_TAN(IAXIS:JAXIS,ICRS) + LEFT_MEDIA = CC_IS_CRS2(HIGH_IND,ICRS) - ZVAL_FACTOR = 1._EB - IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. + CYCLE - N_VOLUS = 0; N_VOLUS_ORIG = N_VOLUS + ENDIF SNGL_CRS_IF - ALLOCATE(B_IND(2*(IJK(1)+IJK(2))-3)); B_IND=-1 - ALLOCATE(E_IND(2*(IJK(1)+IJK(2))-3)); E_IND=-1 - ALLOCATE(F_IND(2*(IJK(1)+IJK(2))-3)); F_IND=-1 + ! Case of several crossings with new svar: + DROP_SS_GG = .FALSE. + DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF ( CC_IS_CRS2(LOW_IND,ICRS) /= CC_IS_CRS2(HIGH_IND,ICRS) ) THEN + DROP_SS_GG = .TRUE. + EXIT + ENDIF + ENDDO - ! First add terrain IJK(1)*IJK(2) vertices: - IJ = 1 - DO J = 1, IJK(2) - DO I = 1, IJK(1) - VERTS(3*IJ-2) = (XB(1)*REAL(IJK(1)-I,EB) + XB(2)*REAL(I-1,EB))/REAL(IJK(1)-1,EB) - VERTS(3*IJ-1) = (XB(3)*REAL(IJK(2)-J,EB) + XB(4)*REAL(J-1,EB))/REAL(IJK(2)-1,EB) - VERTS(3*IJ) = ZVALS(IJ) - IJ = IJ + 1 + ! Variables related to new svar crossing: + ICRS = IND_CRS(LOW_IND,IDCR) + 1 + CC_SVAR_CRS_AUX(CC_N_CRS_AUX) = CC_SVAR_CRS(ICRS) + CC_SEG_CRS_AUX(CC_N_CRS_AUX) = CC_SEG_CRS(ICRS) + CC_SEG_TAN_AUX(IAXIS:JAXIS,CC_N_CRS_AUX) = CC_SEG_TAN(IAXIS:JAXIS,ICRS) + + ! Case of intersection inside segment aligned with SVAR location, i.e. + ! intersection among two bodies or self intersection: + ALGN_CROSS=.FALSE. + DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF ( CC_IS_CRS2(HIGH_IND+1,ICRS) /= CC_SOLID ) CYCLE + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID + ALGN_CROSS=.TRUE. + EXIT + ENDDO + IF ( ALGN_CROSS ) CYCLE + + ! Now figure out the type of crossing: + NOT_COUNTED = .TRUE. + NCRS_REMAIN = IND_CRS(HIGH_IND,IDCR) + DROP_SS_GG_IF : IF (DROP_SS_GG) THEN + + ! Points of the same type are collapsed: + USE_INT_POINT(IND_CRS(LOW_IND,IDCR)+1:IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR)) = .TRUE. + DO ICRS1 = IND_CRS(LOW_IND,IDCR)+1, IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) ! Pivot Loop + IF(.NOT.USE_INT_POINT(ICRS1)) CYCLE ! Don't use collapsed point as pivot. + DO ICRS2 = IND_CRS(LOW_IND,IDCR)+1, IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + IF( (ICRS2==ICRS1) .OR. .NOT.USE_INT_POINT(ICRS2) ) CYCLE ! Don't use pivot, or collapsed point. + IF( (CC_IS_CRS2(LOW_IND ,ICRS1) == CC_IS_CRS2(LOW_IND ,ICRS2)) .AND. & + (CC_IS_CRS2(HIGH_IND,ICRS1) == CC_IS_CRS2(HIGH_IND,ICRS2)) .AND. & + (BODNUM(ICRS1) == BODNUM(ICRS2)) ) USE_INT_POINT(ICRS2) = .FALSE. ENDDO ENDDO - N_VERTS_ORIG = IJ-1 - ! Boundary indexes: - IJB = 1 - DO J=1,1 - DO I=1,IJK(1) - B_IND(IJB)=(J-1)*IJK(1)+I - IJB = IJB + 1 - ENDDO - ENDDO - DO J=2,IJK(2) - DO I=IJK(1),IJK(1) - B_IND(IJB)=(J-1)*IJK(1)+I - IJB = IJB + 1 - ENDDO - ENDDO - DO J=IJK(2),IJK(2) - DO I=IJK(1)-1,1,-1 - B_IND(IJB)=(J-1)*IJK(1)+I - IJB = IJB + 1 - ENDDO - ENDDO - DO J=IJK(2)-1,2,-1 - DO I=1,1 - B_IND(IJB)=(J-1)*IJK(1)+I - IJB = IJB + 1 - ENDDO + ! Left Side: + FOUND_LEFT = .FALSE. + IND_LEFT = 0 + IND_RIGHT = 0 + DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + ! Case crossing type GG or SS, drop: + IF (CC_IS_CRS2(LOW_IND,ICRS) == CC_IS_CRS2(HIGH_IND,ICRS)) CYCLE + ! Case collapsed point, drop: + IF (.NOT.USE_INT_POINT(ICRS)) CYCLE + + IND_LEFT = IND_LEFT + CC_IS_CRS2(LOW_IND,ICRS) + IND_RIGHT = IND_RIGHT + CC_IS_CRS2(HIGH_IND,ICRS) ENDDO - B_IND(IJB)= B_IND(1) ! Last point equal to first. - ! Now add terrain 2*(IJK(1)-1)*(IJK(2)-1) faces: - IJF = 1 - DO J = 1, IJK(2) - 1 - DO I = 1, IJK(1) - 1 - I1 = (J-1)*IJK(1) + I - I2 = I1 + 1 - I3 = I2 + IJK(1) - I4 = I3 - 1 + IF (IND_LEFT /= 0) IND_LEFT = SIGN(1,IND_LEFT) + IF (IND_RIGHT /= 0) IND_RIGHT = SIGN(1,IND_RIGHT) - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 + IF ( (IDCR>1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN + ! Test if we are inside an Object. + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID; ! GS or SG. - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO - ENDDO - N_FACES_ORIG = IJF-1 + ELSEIF (ABS(IND_LEFT)+ABS(IND_RIGHT) == 0) THEN ! Same number of SG and GS crossings, + ! both sides of the crossing + ! defined as left_media: + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = LEFT_MEDIA + ELSEIF (IND_LEFT == LEFT_MEDIA) THEN + CC_IS_CRS2_AUX((/ LOW_IND, HIGH_IND/),CC_N_CRS_AUX) = (/ IND_LEFT, IND_RIGHT /) ! GS or SG. + ELSE + IF (ITITLE==1) THEN + WRITE(LU_ERR,*) "Error GET_X2INTERSECTIONS: DROP_SS_GG = .TRUE., Didn't find left side continuity." + ELSEIF (ITITLE==2) THEN + WRITE(LU_ERR,*) "Error GET_IS_SOLID_PT: DROP_SS_GG = .TRUE., Didn't find left side continuity." + ENDIF + ! WRITE(LU_ERR,*) "BODINT_PLANE, NSGLS, NSEGS=",BODINT_PLANE%NSGLS,BODINT_PLANE%NSEGS + ! WRITE(LU_ERR,*) "X1PLN, X2AXIS, X3AXIS, X3RAY=",X1PLN,X2AXIS,X3AXIS,X3RAY + ! WRITE(LU_ERR,*) "CC_N_CRS=",CC_N_CRS,", IDCR=",IDCR + ! WRITE(LU_ERR,*) ICRS,"IND_LEFT=",IND_LEFT,", IND_RIGHT=",IND_RIGHT + ! WRITE(LU_ERR,*) "CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS)",CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) + ! DO IAUX=1,CC_N_CRS + ! WRITE(LU_ERR,*) IAUX,CRS_NUM(CC_N_CRS),IND_LEFT,IND_RIGHT,CC_SVAR_CRS(IND_CRS(LOW_IND,IAUX)+1) + ! ENDDO + ! WRITE(LU_ERR,*) ' ' + ! CALL DEBUG_WAIT + ENDIF + LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) - IF (EXTEND_TERRAIN) THEN - ! Then add 2*(IJK(1)+IJK(2))-4 extended points: - DELX = (XHI - XLOW)/REAL(IJK(1)-1,EB) - DELY = (YHI - YLOW)/REAL(IJK(2)-1,EB) + ELSE ! Intersections are either GG or SS - IJE = 1 - ! Low Y along X: from IJK(1)*IJK(2)+1 : IJK(1)*IJK(2) + IJK(1) - DO J=1,1 - DO I=1,IJK(1) - VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) - VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) - VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON - E_IND(IJE) = IJ - IJE= IJE + 1 - IJ = IJ + 1 - ENDDO - ENDDO + ! Left side: + FOUND_LEFT = .FALSE. + DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) - ! Hi X along Y: from IJK(1)*IJK(2) + IJK(1) + 1 : IJK(1)*IJK(2) + IJK(1) + IJK(2) - 2 - DO J=2,IJK(2) - DO I=IJK(1),IJK(1) - VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) - VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) - VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON - E_IND(IJE) = IJ - IJE= IJE + 1 - IJ = IJ + 1 - ENDDO - ENDDO + ! Case GG or SS with CC_IS_CRS2(LOW_IND,ICRS) == LEFT_MEDIA: + ! This collapses all types SS or GG that have the left side + ! type. Note they should all be one type (either GG or SS): + IF (CC_IS_CRS2(LOW_IND,ICRS) == LEFT_MEDIA) THEN + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_IS_CRS2(LOW_IND:HIGH_IND,ICRS) + NOT_COUNTED(ICRS) = .FALSE. + NCRS_REMAIN = NCRS_REMAIN-1 + FOUND_LEFT = .TRUE. + ENDIF + ENDDO - ! Hi Y along X: from IJK(1)*IJK(2) + IJK(1) + IJK(2) - 1 : IJK(1)*IJK(2) + 2*IJK(1) + IJK(2) - 2 - DO J=IJK(2),IJK(2) - DO I=IJK(1)-1,1,-1 - VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) - VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) - VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON - E_IND(IJE) = IJ - IJE= IJE + 1 - IJ = IJ + 1 - ENDDO - ENDDO + IF ( (IDCR>1) .AND. (CC_BDNUM_CRS_AUX(IDCR-1)>0) .AND. (CC_BDNUM_CRS_AUX(IDCR)>0) ) THEN + ! Test if we are inside an Object. + CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,CC_N_CRS_AUX) = CC_SOLID + LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) + CYCLE + ENDIF - ! Low X Along Y: from IJK(1)*IJK(2) + 2*IJK(1) + IJK(2) - 1 : IJK(1)*IJK(2) + 2*(IJK(1)+IJK(2)) - 4 - DO J=IJK(2)-1,2,-1 - DO I=1,1 - VERTS(3*IJ-2) = XLOW + DELX*REAL(I-1,EB) - VERTS(3*IJ-1) = YLOW + DELY*REAL(J-1,EB) - VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*ZVALS((J-1)*IJK(1)+I) + ZVAL_FACTOR*ZVAL_HORIZON - E_IND(IJE) = IJ - IJE= IJE + 1 - IJ = IJ + 1 - ENDDO - ENDDO - E_IND(IJE) = E_IND(1) ! Last point equal to first. + IF (.NOT.FOUND_LEFT) print*, "Error GET_X2INTERSECTIONS: DROP_SS_GG = .FALSE., Didn't find left side continuity." + IF ( NCRS_REMAIN /= 0) print*, "Error GET_X2INTERSECTIONS: DROP_SS_GG = .FALSE., NCRS_REMAIN /= 0." - DO I=1,IJE-1 - VERTS(3*IJ-2) = VERTS(3*E_IND(I)-2) - VERTS(3*IJ-1) = VERTS(3*E_IND(I)-1) - VERTS(3*IJ) = ZLOW - F_IND(I) = IJ - IJ = IJ + 1 - ENDDO - F_IND(IJE) = F_IND(1) ! Last lower point equal to the first. + LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) - ! Remaining Faces: - ! Extension faces: - DO I=1,2*(IJK(1)+IJK(2))-4 - I1 = E_IND(I) - I2 = E_IND(I+1) - I3 = B_IND(I+1) - I4 = B_IND(I) + ENDIF DROP_SS_GG_IF - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +ENDDO IDCR_DO_2 - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO +! Copy final results: +CC_N_CRS = CC_N_CRS_AUX +CC_SVAR_CRS(1:CC_MAXCROSS_X2) = CC_SVAR_CRS_AUX(1:CC_MAXCROSS_X2) +CC_SEG_CRS(1:CC_MAXCROSS_X2) = CC_SEG_CRS_AUX(1:CC_MAXCROSS_X2) +CC_SEG_TAN(IAXIS:JAXIS,1:CC_MAXCROSS_X2) = CC_SEG_TAN_AUX(IAXIS:JAXIS,1:CC_MAXCROSS_X2) +! CC_IS_CRS2(LOW_IND:HIGH_IND,1:CC_MAXCROSS_X2) = CC_IS_CRS2_AUX(LOW_IND:HIGH_IND,1:CC_MAXCROSS_X2) - ! Side faces: - DO I=1,2*(IJK(1)+IJK(2))-4 - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = E_IND(I+1) - I4 = E_IND(I) +DO ICRS=1,CC_N_CRS + CC_IS_CRS(ICRS) = 2*( CC_IS_CRS2_AUX(LOW_IND,ICRS) + 1 ) - CC_IS_CRS2_AUX(HIGH_IND,ICRS) +ENDDO - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +RETURN +END SUBROUTINE COLLAPSE_CROSSINGS - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO - ELSE - ! Do not Extend to domain boundary: - DO I=1,IJB-1 - VERTS(3*IJ-2) = VERTS(3*B_IND(I)-2) - VERTS(3*IJ-1) = VERTS(3*B_IND(I)-1) - VERTS(3*IJ) = ZLOW - F_IND(I) = IJ - IJ = IJ + 1 - ENDDO - F_IND(IJB) = F_IND(1) ! Last lower point equal to the first. +! ------------------------- INSERT_RAY_CROSS ------------------------------------ - ! Side faces: - DO I=1,2*(IJK(1)+IJK(2))-4 - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = B_IND(I+1) - I4 = B_IND(I) +SUBROUTINE INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +REAL(EB), INTENT(IN) :: SVARI, STANI(IAXIS:JAXIS) +INTEGER, INTENT(IN) :: ICRSI(LOW_IND:HIGH_IND+1), SCRSI - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO +! Local Variables: +INTEGER :: ICRS, IDUM +REAL(EB), ALLOCATABLE, DIMENSION(:) :: CC_SVAR_CRS_DUM +INTEGER, ALLOCATABLE, DIMENSION(:) :: CC_IS_CRS_DUM,CC_SEG_CRS_DUM,CC_BDNUM_CRS_DUM,CC_BDNUM_CRS_AUX_DUM +INTEGER, ALLOCATABLE, DIMENSION(:,:):: CC_IS_CRS2_DUM +REAL(EB), ALLOCATABLE, DIMENSION(:,:):: CC_SEG_TAN_DUM - ENDIF - ! Bottom Faces: - ! First Face: - I = 1 - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = F_IND(2*(IJK(1)+IJK(2))-3-I) - FACES(3*IJF-2) = I2 - FACES(3*IJF-1) = I1 - FACES(3*IJF) = I3 - IJF = IJF + 1 +CC_N_CRS = CC_N_CRS + 1 - DO I=2,(2*(IJK(1)+IJK(2))-6)/2 - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = F_IND(2*(IJK(1)+IJK(2))-3-I) - I4 = F_IND(2*(IJK(1)+IJK(2))-2-I) +! Test maximum crossings defined: +IF ( CC_N_CRS > CC_MAXCROSS_X2) THEN + IDUM = CC_MAXCROSS_X2 + CC_MAXCROSS_X2 = IDUM + DELTA_CROSS_X2 + ! Allocate Intersection variables: + ALLOCATE(CC_SVAR_CRS_DUM(CC_MAXCROSS_X2),CC_IS_CRS_DUM(CC_MAXCROSS_X2),CC_SEG_CRS_DUM(CC_MAXCROSS_X2)) + CC_SVAR_CRS_DUM = 1._EB/GEOMEPS; CC_SVAR_CRS_DUM(1:IDUM) = CC_SVAR_CRS(1:IDUM) + CC_IS_CRS_DUM = CC_UNDEFINED; + CC_SEG_CRS_DUM = 0; CC_SEG_CRS_DUM(1:IDUM) = CC_SEG_CRS(1:IDUM) + ALLOCATE(CC_BDNUM_CRS_DUM(0:CC_MAXCROSS_X2),CC_BDNUM_CRS_AUX_DUM(0:CC_MAXCROSS_X2)) + CC_BDNUM_CRS_DUM = 0; CC_BDNUM_CRS_DUM(0:IDUM) = CC_BDNUM_CRS(0:IDUM) + CC_BDNUM_CRS_AUX_DUM= 0; CC_BDNUM_CRS_AUX_DUM(0:IDUM) = CC_BDNUM_CRS_AUX(0:IDUM) + ALLOCATE(CC_IS_CRS2_DUM(LOW_IND:HIGH_IND+1,CC_MAXCROSS_X2),CC_SEG_TAN_DUM(IAXIS:JAXIS,CC_MAXCROSS_X2)) + CC_IS_CRS2_DUM = CC_UNDEFINED; CC_IS_CRS2_DUM(LOW_IND:HIGH_IND+1,1:IDUM) = CC_IS_CRS2(LOW_IND:HIGH_IND+1,1:IDUM) + CC_SEG_TAN_DUM = 0._EB; CC_SEG_TAN_DUM(IAXIS:JAXIS,1:IDUM) = CC_SEG_TAN(IAXIS:JAXIS,1:IDUM) + CALL MOVE_ALLOC(FROM=CC_SVAR_CRS_DUM,TO=CC_SVAR_CRS) + CALL MOVE_ALLOC(FROM=CC_IS_CRS_DUM,TO=CC_IS_CRS) + CALL MOVE_ALLOC(FROM=CC_SEG_CRS_DUM,TO=CC_SEG_CRS) + CALL MOVE_ALLOC(FROM=CC_BDNUM_CRS_DUM,TO=CC_BDNUM_CRS) + CALL MOVE_ALLOC(FROM=CC_BDNUM_CRS_AUX_DUM,TO=CC_BDNUM_CRS_AUX) + CALL MOVE_ALLOC(FROM=CC_IS_CRS2_DUM,TO=CC_IS_CRS2) + CALL MOVE_ALLOC(FROM=CC_SEG_TAN_DUM,TO=CC_SEG_TAN) +ENDIF - FACES(3*IJF-2) = I2 - FACES(3*IJF-1) = I1 - FACES(3*IJF) = I4 - IJF = IJF + 1 +! Add in place, ascending value order: +DO ICRS=1,CC_N_CRS ! The updated CC_N_CRS is for ICRS to reach the + ! initialization value CC_SVAR_CRS(ICRS)=1/GEOMEPS. + IF ( SVARI < CC_SVAR_CRS(ICRS) ) EXIT +ENDDO - FACES(3*IJF-2) = I2 - FACES(3*IJF-1) = I4 - FACES(3*IJF) = I3 - IJF = IJF + 1 - ENDDO +! Here copy from the back (updated CC_N_CRS) to the ICRS location: +! if ICRS=CC_N_CRS -> nothing gets copied: +DO IDUM = CC_N_CRS,ICRS+1,-1 + CC_SVAR_CRS(IDUM) = CC_SVAR_CRS(IDUM-1) + CC_IS_CRS2(LOW_IND:HIGH_IND+1,IDUM) = CC_IS_CRS2(LOW_IND:HIGH_IND+1,IDUM-1) + CC_SEG_CRS(IDUM) = CC_SEG_CRS(IDUM-1); + CC_SEG_TAN(IAXIS:JAXIS,IDUM)= CC_SEG_TAN(IAXIS:JAXIS,IDUM-1); + CC_BDNUM_CRS(IDUM) = CC_BDNUM_CRS(IDUM-1) +ENDDO - ! Last Face: - I = (2*(IJK(1)+IJK(2))-4)/2 - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = F_IND(I+2) - FACES(3*IJF-2) = I2 - FACES(3*IJF-1) = I1 - FACES(3*IJF) = I3 - IJF = IJF + 1 +CC_SVAR_CRS(ICRS) = SVARI ! x2 location. +CC_IS_CRS2(LOW_IND:HIGH_IND+1,ICRS) = ICRSI(LOW_IND:HIGH_IND+1) ! Does point separate GASPHASE from SOLID? +CC_SEG_CRS(ICRS) = SCRSI ! Segment on BOINT_PLANE the crossing belongs to. +CC_SEG_TAN(IAXIS:JAXIS,ICRS) = STANI(IAXIS:JAXIS) ! CC_SEG_TAN might not be needed in new implementation. +CC_BDNUM_CRS(ICRS) = 0 +IF (SCRSI > 0) THEN + IF(ICRSI(LOW_IND) == CC_GASPHASE .AND. ICRSI(HIGH_IND) == CC_SOLID) THEN + CC_BDNUM_CRS(ICRS) = 1 + ELSEIF(ICRSI(LOW_IND) == CC_SOLID .AND. ICRSI(HIGH_IND) == CC_GASPHASE) THEN + CC_BDNUM_CRS(ICRS) =-1 + ENDIF +ENDIF +RETURN +END SUBROUTINE INSERT_RAY_CROSS - N_VERTS = IJ - 1 - N_FACES = IJF - 1 +! ----------------------- GET_BODINT_NODE_INDEX ---------------------------------- - DEALLOCATE(B_IND,E_IND,F_IND) +SUBROUTINE GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ,IND_PI) - ELSEIF(IS_TERRAIN) THEN ZVALS_IF +TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE +INTEGER, INTENT(IN) :: X2AXIS,X3AXIS +REAL(EB), INTENT(IN) :: XYZ(MAX_DIM) +INTEGER, INTENT(OUT) :: IND_PI - GEOM_TYPE = TERRAIN_GEOM_TYPE - TERRAIN_CASE= .TRUE. +! Local variables: +INTEGER :: INOD=1, PIVOT(LOW_IND:HIGH_IND), INOD2 +REAL(EB):: DIFFX2, DIFFX3 - ! Here estimate final number of Faces and if necessary reallocate FACE, VERTS, SURFS arrays: - IF ( (2*N_FACES>MAX_FACES) .AND. .NOT.READ_BINARY) THEN - ALLOCATE(VERTS_AUX(3*N_VERTS)); VERTS_AUX(1:3*N_VERTS)= VERTS(1:3*N_VERTS) - ALLOCATE(FACES_AUX(4*N_FACES)); FACES_AUX(1:4*N_FACES)= FACES(1:4*N_FACES) - ALLOCATE(SURFS2(N_FACES)); SURFS2(1:N_FACES) = SURFS(1:N_FACES) - MAX_FACES = 2*N_FACES ! Enough for square structured triangulations of more that 200 triangs with domain extension. - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - DEALLOCATE(VERTS,FACES,TFACES); - ALLOCATE(VERTS(3*MAX_VERTS+1)); ALLOCATE(TFACES(6*MAX_FACES+1)); ALLOCATE(FACES(4*MAX_FACES+1)) - VERTS=1.001_EB*MAX_VAL; FACES=0 - VERTS(1:3*N_VERTS) = VERTS_AUX(1:3*N_VERTS) - FACES(1:4*N_FACES) = FACES_AUX(1:4*N_FACES) - DEALLOCATE(SURFS); ALLOCATE(SURFS(MAX_FACES)); - IF(SURF_INDEX_PER_FACE) THEN - SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). - ELSE - SURFS(:) = 0 ! All external faces point to default surf ID. +! Test if XYZ is already on BODINT_PLANE%XYZ: +IND_PI = -1 ! Initialize to negative index. +IF (BODINT_PLANE%NNODS < LINSEARCH_LIMIT) THEN + ! Linear Search: + DO INOD=1,BODINT_PLANE%NNODS + DIFFX2 = BODINT_PLANE%XYZ(X2AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X2AXIS) + IF( DIFFX2 > GEOMEPS ) THEN + EXIT + ELSEIF( ABS(DIFFX2) <= GEOMEPS) THEN + DIFFX3 = BODINT_PLANE%XYZ(X3AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X3AXIS) + IF ( DIFFX3 > GEOMEPS ) THEN + EXIT + ELSEIF ( ABS(DIFFX3) <= GEOMEPS ) THEN + IND_PI = BODINT_PLANE%NOD_PERM(INOD) + RETURN ENDIF - SURFS(1:N_FACES) = SURFS2(1:N_FACES) - DEALLOCATE(VERTS_AUX,FACES_AUX,SURFS2) ENDIF + ENDDO +ELSE + ! Binary Search: + PIVOT(LOW_IND) = 0 + PIVOT(HIGH_IND)= BODINT_PLANE%NNODS + 1 + DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) + INOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 + DIFFX2 = BODINT_PLANE%XYZ(X2AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X2AXIS) + IF( DIFFX2 < -GEOMEPS ) THEN + PIVOT(LOW_IND) = INOD + ELSEIF( DIFFX2 > GEOMEPS ) THEN + PIVOT(HIGH_IND)= INOD + ELSE ! ABS(DIFFX2) < GEOMEPS + DIFFX3 = BODINT_PLANE%XYZ(X3AXIS,BODINT_PLANE%NOD_PERM(INOD))-XYZ(X3AXIS) + IF ( DIFFX3 < -GEOMEPS ) THEN + PIVOT(LOW_IND) = INOD + ELSEIF( DIFFX3 > GEOMEPS ) THEN + PIVOT(HIGH_IND)= INOD + ELSE ! ABS(DIFFX3) < GEOMEPS + IND_PI = BODINT_PLANE%NOD_PERM(INOD) + RETURN + ENDIF + ENDIF + ENDDO + INOD=PIVOT(HIGH_IND) +ENDIF - - ! First get EDGES arrays to find edges attached to only one face: - I = SIZE(FACES,DIM=1) - ALLOCATE(EDGES(NOD1:NOD2,3*N_FACES),FACE_EDGES(EDG1:EDG3,N_FACES),EDGE_FACES(5,3*N_FACES)) - CALL GET_GEOM_EDGES(N_VERTS,N_FACES,I,FACES,N_EDGES,EDGES,FACE_EDGES,EDGE_FACES) - - ! FIND SET OF EDGES: - ALLOCATE(NBND_EDGE(1:N_EDGES)); NBND_EDGE(1:N_EDGES) = 2 - EDGE_FACES(1,1:N_EDGES) ! 0 if interior edge, 1 bnd. - N_BEDGES = SUM(NBND_EDGE(1:N_EDGES)) - ALLOCATE(BOUND_EDGES(2,N_BEDGES),BOUND_EDGES2(2,N_BEDGES)); BOUND_EDGES = 0; BOUND_EDGES2 = 0 - ALLOCATE(COUNTED_EDGES(1:N_BEDGES)); COUNTED_EDGES = 0 - ! Reorder Edges in counter-clockwise (x-y plane) direction: - ! First copy edges in correct counter-clockwise outside node order: - J=0 - DO I=1,N_EDGES - IF(NBND_EDGE(I)/=1) CYCLE - J=J+1 - IF(EDGE_FACES(2,I)>0) THEN - BOUND_EDGES(NOD1:NOD2,J) = EDGES( (/ NOD1,NOD2 /) , I ) - ELSEIF(EDGE_FACES(4,I)>0) THEN - BOUND_EDGES(NOD1:NOD2,J) = EDGES( (/ NOD2,NOD1 /) , I ) +! Insert add NOD_PERM permutation array, O(NP) operation: +DO INOD2=BODINT_PLANE%NNODS+1,INOD+1,-1 + BODINT_PLANE%NOD_PERM(INOD2) = BODINT_PLANE%NOD_PERM(INOD2-1) +ENDDO +IND_PI = BODINT_PLANE%NNODS + 1 +BODINT_PLANE%NNODS = IND_PI +BODINT_PLANE%NOD_PERM(INOD) = IND_PI +BODINT_PLANE%XYZ(IAXIS:KAXIS,IND_PI) = XYZ(IAXIS:KAXIS) + +RETURN +END SUBROUTINE GET_BODINT_NODE_INDEX +SUBROUTINE GET_X2_VERTVAR(X1AXIS,X2LO,X2HI,NM,I,KK) + +INTEGER, INTENT(IN) :: X1AXIS,X2LO,X2HI,NM,I,KK + +! Local Variables: +INTEGER :: ICRS,ICRS1,JSTR,JEND,JJ,X2LO_LOC,X2HI_LOC +REAL(EB):: TNOW + +TNOW=CURRENT_TIME() + +! Work By Edge, Only one X1AXIS=IAXIS needs to be used: +SELECT CASE(X1AXIS) +CASE(IAXIS) + X2LO_LOC = X2LO + X2HI_LOC = X2HI + ! Case of GG, SS points: + DO ICRS=1,CC_N_CRS + ! If is_crs(icrs) == GG, SS, SGG see if crossing is + ! exactly on a Cartesian cell vertex: + SELECT CASE(CC_IS_CRS(ICRS)) + CASE(CC_GG,CC_SS) + JSTR = X2LO_LOC; JEND = X2HI_LOC + IF(X2NOC==0) THEN + ! Optimized and will ONLY work for Uniform Grids: + JSTR = MAX(X2LO_LOC, FLOOR((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) + JEND = MIN(X2HI_LOC, CEILING((CC_SVAR_CRS(ICRS)+GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) ENDIF - ENDDO - ! Then reorder-copy edges: - J = 1; I = 1 - BOUND_EDGES2(NOD1:NOD2,J) = BOUND_EDGES(NOD1:NOD2,I); COUNTED_EDGES(I) = 1 - DO J=2,N_BEDGES - DO I=1,N_BEDGES - IF(COUNTED_EDGES(I)==1) CYCLE - IF(BOUND_EDGES2(NOD2,J-1)==BOUND_EDGES(NOD1,I)) THEN ! Found new edge: - BOUND_EDGES2(NOD1:NOD2,J) = BOUND_EDGES(NOD1:NOD2,I); COUNTED_EDGES(I) = 1 + DO JJ=JSTR,JEND + ! Crossing on Vertex? + IF ( ABS(X2FACE(JJ)-CC_SVAR_CRS(ICRS)) < GEOMEPS ) THEN + MESHES(NM)%VERTVAR(I,JJ,KK,CC_VGSC) = CC_SOLID EXIT ENDIF ENDDO - IF(I>N_BEDGES) THEN ! Error - WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(709): For terrain GEOM ',TRIM(ID),& - ' unconnected boundary edge at node number,',BOUND_EDGES2(NOD2,J-1),'.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - DO I=1,N_BEDGES - IF (COUNTED_EDGES(I) /= 1) THEN - WRITE(MESSAGE,'(A,A,A,2I8,A)') 'ERROR(710): For terrain GEOM ',TRIM(ID),& - ' unconnected boundary edge at nodes,',BOUND_EDGES(NOD1:NOD2,I),'.' - CALL SHUTDOWN(MESSAGE); RETURN + + END SELECT + ENDDO + + ! Other cases: + DO ICRS=1,CC_N_CRS-1 + ! Case GS-SG: All Cartesian vertices are set to CC_SOLID. + IF (CC_IS_CRS(ICRS) == CC_GS) THEN + ! Find corresponding SG intersection: + DO ICRS1=ICRS+1,CC_N_CRS + IF (CC_IS_CRS(ICRS1) == CC_SG) EXIT + ENDDO + JSTR = X2LO_LOC; JEND = X2HI_LOC + IF(X2NOC==0) THEN + ! Optimized for UG: + JSTR = MAX(X2LO_LOC, CEILING(( CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) + JEND = MIN(X2HI_LOC, FLOOR((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2LO_LOC))/DX2FACE(X2LO_LOC)) + X2LO_LOC) + ELSE + IF ((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2LO_LOC)) < 0._EB) THEN + JSTR=X2LO_LOC + ELSEIF((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(X2HI_LOC)) >= 0._EB) THEN + JSTR=X2HI_LOC+1 + ELSE + DO JJ=X2LO_LOC,X2HI_LOC + IF((CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. & + (CC_SVAR_CRS(ICRS)-GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN + JSTR = JJ+1 + EXIT + ENDIF + ENDDO + ENDIF + IF ((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2LO_LOC)) < 0._EB) THEN + JEND=X2LO_LOC-1 + ELSEIF((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(X2HI)) >= 0._EB) THEN + JEND=X2HI_LOC + ELSE + DO JJ=X2LO_LOC,X2HI_LOC + IF((CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. & + (CC_SVAR_CRS(ICRS1)+GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN + JEND = JJ + EXIT + ENDIF + ENDDO + ENDIF ENDIF - ENDDO - ! Here all edges are counted and SUM(COUNTED_EDGES(1:N_BEDGES)==N_BEDGES): - BOUND_EDGES(NOD1:NOD2,1:N_BEDGES) = BOUND_EDGES2(NOD1:NOD2,1:N_BEDGES); - DEALLOCATE(NBND_EDGE,COUNTED_EDGES,BOUND_EDGES2) - IF (EXTEND_TERRAIN) THEN - ! Find XLOW,XHI,YLOW,YHI for the set of NM meshes defined: - XLOW = 1.E10_EB - XHI =-1.E10_EB - YLOW = 1.E10_EB - YHI =-1.E10_EB - DO NM=1,NMESHES - XLOW = MIN(XLOW,MESHES(NM)%XS) - XHI = MAX(XHI ,MESHES(NM)%XF) - YLOW = MIN(YLOW,MESHES(NM)%YS) - YHI = MAX(YHI ,MESHES(NM)%YF) + DO JJ=JSTR,JEND + MESHES(NM)%VERTVAR(I,JJ,KK,CC_VGSC) = CC_SOLID ENDDO - WRITE_WARNING=.FALSE. - IF(ANY(VERTS(1:3:3*N_VERTS-2) <= XLOW)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF(ANY(VERTS(1:3:3*N_VERTS-2) >= XHI )) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF(ANY(VERTS(2:3:3*N_VERTS-1) <= YLOW)) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF(ANY(VERTS(2:3:3*N_VERTS-1) >= YHI )) THEN; WRITE_WARNING =.TRUE.; EXTEND_TERRAIN=.FALSE.; ENDIF - IF(MY_RANK==0 .AND. WRITE_WARNING) WRITE(LU_ERR,'(A,A,A)') 'Warning : Terrain &GEOM ',TRIM(ID),& - ' cannot be extended. When setting EXTEND_TERRAIN=T, make sure it lays entirely within the computational domain.' ENDIF - ! Move Low Z position of terrain to less that number od cutcells, s.t. they don't get computed on the bottom. - ZMIN2= 1.E10_EB - DELTZ= 0._EB - DO NM=1,NMESHES - DELTZ = MAX( DELTZ , REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) - ZMIN2 = MIN( ZMIN2 , MESHES(NM)%ZS-REAL(NGUARD,EB)/REAL(MESHES(NM)%KBAR,EB)*(MESHES(NM)%ZF-MESHES(NM)%ZS) ) - ENDDO - ZHI =-1.E10_EB - ZLOW = 1.E10_EB - DO I=1,N_VERTS - ZLOW = MIN(ZLOW,VERTS(3*I)) - ZHI = MAX(ZHI ,VERTS(3*I)) - ENDDO - ! Take the min of LOWZ_VERTS-NGUARD*DZ, ZMIN from input, ZMIN_MESH-NGUARD*DZ: - ZLOW = MIN(ZLOW-DELTZ,ZMIN,ZMIN2) - - ZVAL_FACTOR = 1._EB - IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. + ENDDO +END SELECT - N_VOLUS = 0 +T_CC_USED(GET_X2_VERTVAR_TIME_INDEX) = T_CC_USED(GET_X2_VERTVAR_TIME_INDEX) + CURRENT_TIME() - TNOW - ALLOCATE(B_IND(2*N_BEDGES+1)); B_IND=-1 - ALLOCATE(E_IND(2*N_BEDGES+1)); E_IND=-1 - ALLOCATE(F_IND(2*N_BEDGES+1)); F_IND=-1 +RETURN +END SUBROUTINE GET_X2_VERTVAR - B_IND(1:N_BEDGES) = BOUND_EDGES(NOD1,1:N_BEDGES); B_IND(N_BEDGES+1) = B_IND(1) ! Last equal to first +! -------------------------- GET_CARTEDGE_CUTEDGES ------------------------------ - ! All vertices in counter-clockwise dir are in BOUND_EDGES(NOD1,1:N_BEDGES) - ! IF EXTEND_TERRAIN, of this vertex list find the 4 points SW, SE, NW, NE closest to the boundary of the domain. - IF (EXTEND_TERRAIN) THEN +SUBROUTINE GET_CARTEDGE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & + NM,X2LO_CELL,X2HI_CELL,INDX1,KK) - B_IND(N_BEDGES+1:2*N_BEDGES) = B_IND(1:N_BEDGES) - B_IND(2*N_BEDGES+1) = B_IND(1) +INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & + NM,X2LO_CELL,X2HI_CELL,INDX1(MAX_DIM),KK - ! Find the 4 points closest to SE, NE, NW, SW corners. - CORNER_PT(IAXIS:JAXIS,NOD1) = (/ XHI , YLOW /) ! SE - CORNER_PT(IAXIS:JAXIS,NOD2) = (/ XHI , YHI /) ! NE - CORNER_PT(IAXIS:JAXIS,NOD3) = (/ XLOW, YHI /) ! NW - CORNER_PT(IAXIS:JAXIS,NOD4) = (/ XLOW, YLOW /) ! SW - CORNER_PT(IAXIS:JAXIS,NOD4+1)= CORNER_PT(IAXIS:JAXIS,NOD1) ! SE - CLOSE_PT(:) = 0 - DO ICPT=NOD1,NOD4 - ! Search in B_IND vertices which is closest: - DIST=1.E10_EB - DO I=1,N_BEDGES - DISTI = SQRT( ( CORNER_PT(IAXIS,ICPT)-VERTS(3*B_IND(I)-2) )**2._EB + & - ( CORNER_PT(JAXIS,ICPT)-VERTS(3*B_IND(I)-1) )**2._EB ) - IF(DISTI >= DIST) CYCLE - CLOSE_PT(ICPT) = I - DIST = DISTI - ENDDO - ENDDO - DO ICPT=NOD2,NOD4 - IF(CLOSE_PT(ICPT) < CLOSE_PT(ICPT-1)) CLOSE_PT(ICPT) = CLOSE_PT(ICPT) + N_BEDGES ! Pad corner nodes. - ENDDO - CLOSE_PT(NOD4+1) = CLOSE_PT(NOD1) + N_BEDGES +! Local Variables: +INTEGER :: NEDGECROSS, NEDGECROSS_OLD, NCUTEDGE, JJ, INDXI(MAX_DIM), INDI, INDJ, INDK +INTEGER :: INDI1, INDJ1, INDK1, INDIE, INDJE, INDKE, NCROSS, ICROSS, ICRS, JSTR +INTEGER :: JJLOW, JJHIGH, JJADD +REAL(EB):: DELJJ +LOGICAL :: VSOLID, DIF, VFLUID +REAL(EB):: X123VERT(MAX_DIM,CC_MAXCROSS_EDGE), XCEN, YCEN, ZCEN, SCEN, XYZCEN(IAXIS:KAXIS) +INTEGER :: VERT_LIST(4,CC_MAXCROSS_EDGE),NEDGE, NVERT, IVERT +LOGICAL :: IS_GASPHASE +REAL(EB):: TNOW - ! These points are mapped to domain external corners, rest of the points are mapped to corresponding domain - ! External boundaries. - IJ = N_VERTS + 1 - DO ICPT=NOD1,NOD4 - IJE = CLOSE_PT(ICPT+1) - CLOSE_PT(ICPT); - IF (IJE <= 0) THEN - WRITE(MESSAGE,'(A,A,A,I8,A)') 'ERROR(711): For terrain GEOM ',TRIM(ID),& - ' same boundary vertex ',B_IND(CLOSE_PT(ICPT)),' closest to 2 domain corners.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - DISTI = SQRT( ( CORNER_PT(IAXIS,ICPT+1)-CORNER_PT(IAXIS,ICPT) )**2._EB + & - ( CORNER_PT(JAXIS,ICPT+1)-CORNER_PT(JAXIS,ICPT) )**2._EB ) / REAL(IJE,EB) - ! Place points in extended domain: - J = 0 - DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 - VERTS(3*IJ-2) = CORNER_PT(IAXIS,ICPT) + DISTI*VERXY(IAXIS,ICPT)*REAL(J,EB) - VERTS(3*IJ-1) = CORNER_PT(JAXIS,ICPT) + DISTI*VERXY(JAXIS,ICPT)*REAL(J,EB) - VERTS(3*IJ) = (1._EB-ZVAL_FACTOR)*VERTS(3*B_IND(I)) + ZVAL_FACTOR*ZVAL_HORIZON - E_IND(I) = IJ - IJ = IJ + 1 - J = J + 1 - ENDDO - ENDDO - E_IND(CLOSE_PT(NOD4+1)) = E_IND(CLOSE_PT(NOD1)) +LOGICAL :: FOUND_EDGE +REAL(EB):: XVJJ, DELJJ1 - ! Add the floor F_IND Vertices: - X_CEN = 0 - Y_CEN = 0 - DO ICPT=NOD1,NOD4 - DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 - VERTS(3*IJ-2) = VERTS(3*E_IND(I)-2) - VERTS(3*IJ-1) = VERTS(3*E_IND(I)-1) - VERTS(3*IJ) = ZLOW - F_IND(I) = IJ - X_CEN = X_CEN + VERTS(3*E_IND(I)-2) - Y_CEN = Y_CEN + VERTS(3*E_IND(I)-1) - IJ = IJ + 1 - ENDDO - ENDDO - F_IND(CLOSE_PT(NOD4+1)) = F_IND(CLOSE_PT(NOD1)) +TNOW=CURRENT_TIME() - ! Add center point: - VERTS(3*IJ-2) = X_CEN / REAL(N_BEDGES,EB) - VERTS(3*IJ-1) = Y_CEN / REAL(N_BEDGES,EB) - VERTS(3*IJ) = ZLOW - IJ = IJ + 1 +! INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CEELEMAUX, INDSEGAUX +! INTEGER :: NEDGE_SIZE - ! Add extend faces: - IJF = N_FACES + 1 - DO ICPT=NOD1,NOD4 - DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 - I1 = E_IND(I) - I2 = E_IND(I+1) - I3 = B_IND(I+1) - I4 = B_IND(I) +! Now define Crossings on Cartesian Edges and Body segments: +! - Edges: MESHES(NM) % ECVAR(:,:,:,CC_EGSC,IAXIS) = +! ECVAR(:,:,:,CC_EGSC,JAXIS) = CC_GASPHASE, CC_SOLID or CC_CUTCFE +! ECVAR(:,:,:,CC_EGSC,KAXIS) = +! ECVAR(:,:,:,CC_ECRS,IAXIS) = +! ECVAR(:,:,:,CC_ECRS,JAXIS) = Index to Corresponding EDGE_CROSS array. +! ECVAR(:,:,:,CC_ECRS,KAXIS) = +! MESHES(NM) % EDGE_CROSS: Data structure with +! crossings per cartesian edge information. +! .NCROSS = Number of crossings. +! .SVAR(1:NCROSS) = distances along edge from lower +! Cartesian vertex. +! Note: Crossings right on vertices do not need to be added, +! they are taken care of by setting VERTVAR(iv,jv,kv,CC_VGSC,lb)=CC_SOLID. +! MESHES(NM) % CUT_EDGE: Data structure with info on CC_GASPHASE cut-edges, +! per Cartesian Edge and CC_INBOUNDARY cut-edges, per +! Cartesian Face: +! .NVERT = number of vertices on cut-edges. +! .NEDGE = number of cut-edges. +! .XYZVERT(IAXIS:KAXIS,1:NVERT) = Segments Vertices +! .CEELEM(NOD1:NOD2,1:NEDGE) = Segments connectivity list. +! .STATUS = CC_GASPHASE or CC_INBOUNDARY; if latter +! .IJK = [I J K AXIS] for Cartesian Edge if status = CC_GASPHASE +! = [I J K AXIS] for Cartesian Face if status = CC_INBOUNDARY +! .INDSEG(1:4,1:NEDGE) = [nwel iwel1 iwel2 ibod] if status = CC_INBOUNDARY +! Also: +! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = +! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = index on CUT_EDGE location. +! ECVAR(:,:,:,CC_IDCE,IAXIS,:) = +! +! Now figure out which segment the intersections belong to, also +! add intersections to body segments. +! As defined, a Cartesian CUT_EDGE is defined by: +! 1. A crossing. +! 2. A VERTVAR(iv,jv,kv,CC_VGSC,lb) = CC_SOLID and another +! VERTVAR(iv,jv,kv,CC_VGSC,lb) = CC_GASPHASE - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +! Set initially edges with MESHES(NM)%VERTVAR vertices == CC_SOLID to CC_SOLID status: +DO JJ=X2LO_CELL,X2HI_CELL - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO - ENDDO + ! Vert at index JJ-1: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ-1, KK /) ! Local x1,x2,x3 + INDI=INDXI(XIAXIS) + INDJ=INDXI(XJAXIS) + INDK=INDXI(XKAXIS) + ! Vert at index JJ: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ, KK /) ! Local x1,x2,x3 + INDI1=INDXI(XIAXIS) + INDJ1=INDXI(XJAXIS) + INDK1=INDXI(XKAXIS) + ! Edge at index JJ: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ, KK /) ! Local x1,x2,x3 + INDIE=INDXI(XIAXIS) + INDJE=INDXI(XJAXIS) + INDKE=INDXI(XKAXIS) - ! Add side faces: - DO ICPT=NOD1,NOD4 - DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = E_IND(I+1) - I4 = E_IND(I) + IF ((MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & + (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) ) & + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +ENDDO - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO - ENDDO - ! Add bottom faces: - DO ICPT=NOD1,NOD4 - DO I=CLOSE_PT(ICPT),CLOSE_PT(ICPT+1)-1 - I1 = F_IND(I) - I2 = IJ - 1 ! ZLOW center vert. - I3 = F_IND(I+1) +NEDGECROSS_OLD = MESHES(NM) % N_EDGE_CROSS +! Edges with Crossings not on VERTICES: +ICRS_DO : DO ICRS=1,CC_N_CRS - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 - ENDDO - ENDDO + ! Skip SOLID-SOLID intersections, as there is no media crossing: + IF (CC_IS_CRS(ICRS) == CC_SS) CYCLE - ELSE + ! Check location on grid of crossing: + ! See if crossing is exactly on a Cartesian cell vertex: + IF (X2NOC==0) THEN + ! Optimized for UG: + JSTR = FLOOR( (CC_SVAR_CRS(ICRS)-GEOMEPS-X2CELL(X2LO_CELL))/DX2CELL(X2LO_CELL) ) + X2LO_CELL + ! Discard cut-edges on Cartesian edges laying > X2HI_CELL. + IF (JSTR < X2LO_CELL-1) CYCLE + IF (JSTR > X2HI_CELL+1) CYCLE - ! Add the floor F_IND Vertices: - IJ = N_VERTS + 1 - X_CEN = 0 - Y_CEN = 0 - DO I=1,N_BEDGES - VERTS(3*IJ-2) = VERTS(3*B_IND(I)-2) - VERTS(3*IJ-1) = VERTS(3*B_IND(I)-1) - VERTS(3*IJ) = ZLOW - F_IND(I) = IJ - X_CEN = X_CEN + VERTS(3*B_IND(I)-2) - Y_CEN = Y_CEN + VERTS(3*B_IND(I)-1) - IJ = IJ + 1 - ENDDO - F_IND(N_BEDGES+1) = F_IND(1) ! Last lower point equal to the first. + JJ = JSTR + DELJJ = ABS(X2CELL(JJ)-CC_SVAR_CRS(ICRS)) - DX2CELL(X2LO_CELL)/2._EB + ! Crossing on Vertex? + IF ( ABS(DELJJ) < GEOMEPS ) THEN ! Add crossing to two edges: + JJLOW=0; JJHIGH=1 + ELSEIF ( DELJJ < -GEOMEPS ) THEN ! Crossing in jj Edge. + JJLOW=0; JJHIGH=0 + ELSEIF ( DELJJ > GEOMEPS ) THEN ! Crossing in jj+1 Edge. + JJLOW=1; JJHIGH=1 + ENDIF + ELSE + FOUND_EDGE=.FALSE. + JJLOW = -1000000 + JJHIGH= 1000000 + DO JJ=X2LO_CELL-1,X2HI_CELL + DELJJ = CC_SVAR_CRS(ICRS)-X2CELL(JJ) + XVJJ = X2CELL(JJ) + DX2CELL(JJ)/2._EB + DELJJ1= CC_SVAR_CRS(ICRS)-X2CELL(JJ+1) + ! First two edges: + IF(ABS(CC_SVAR_CRS(ICRS)-XVJJ) < GEOMEPS) THEN ! Both JJ and JJ+1 + FOUND_EDGE=.TRUE. + JJLOW=0; JJHIGH=1 + EXIT + ELSEIF (ABS(DELJJ) < DX2CELL(JJ)/2._EB) THEN ! JJ + FOUND_EDGE=.TRUE. + JJLOW=0; JJHIGH=0 + EXIT + ELSEIF (ABS(DELJJ1)< DX2CELL(JJ+1)/2._EB) THEN ! JJ+1 + FOUND_EDGE=.TRUE. + JJLOW=1; JJHIGH=1 + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_EDGE) CYCLE + ENDIF - ! Add center point: - VERTS(3*IJ-2) = X_CEN / REAL(N_BEDGES,EB) - VERTS(3*IJ-1) = Y_CEN / REAL(N_BEDGES,EB) - VERTS(3*IJ) = ZLOW - IJ = IJ + 1 + DO JJADD=JJLOW,JJHIGH + ! Edge in the left: + ! Edge at index JJ or JJ+1: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ+JJADD, KK /) ! Local x1,x2,x3 + INDIE=INDXI(XIAXIS) + INDJE=INDXI(XJAXIS) + INDKE=INDXI(XKAXIS) - ! Add side faces: - IJF = N_FACES + 1 - DO I=1,N_BEDGES - I1 = F_IND(I) - I2 = F_IND(I+1) - I3 = B_IND(I+1) - I4 = B_IND(I) + ! Set MESHES(NM)%ECVAR(IE,JE,KE,CC_EGSC,X2AXIS) = CC_CUTCFE: + ICROSS = MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_ECRS,X2AXIS) - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 + IF ( ICROSS > 0 ) THEN ! Edge has crossings already. - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO + ! Populate EDGECROSS struct: + NCROSS = MESHES(NM)%EDGE_CROSS(ICROSS)%NCROSS + 1 + MESHES(NM)%EDGE_CROSS(ICROSS) % NCROSS = NCROSS + MESHES(NM)%EDGE_CROSS(ICROSS) % SVAR(NCROSS) = CC_SVAR_CRS(ICRS) + MESHES(NM)%EDGE_CROSS(ICROSS) % ISVAR(NCROSS)= CC_IS_CRS(ICRS) - ! Add bottom faces: - DO I=1,N_BEDGES - I1 = F_IND(I) - I2 = IJ - 1 ! ZLOW center vert. - I3 = F_IND(I+1) + ELSE ! No crossings yet. - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 - ENDDO + NEDGECROSS = MESHES(NM)%N_EDGE_CROSS + 1 + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_CUTCFE + MESHES(NM)%N_EDGE_CROSS = NEDGECROSS + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_ECRS,X2AXIS) = NEDGECROSS - ENDIF + CALL EDGE_CROSS_ARRAY_REALLOCATE(NM,NEDGECROSS) - N_VERTS = IJ - 1 - N_FACES = IJF - 1 + ! Populate EDGECROSS struct: + NCROSS = 1 + MESHES(NM)%EDGE_CROSS(NEDGECROSS) % NCROSS = NCROSS + MESHES(NM)%EDGE_CROSS(NEDGECROSS) % SVAR(NCROSS) = CC_SVAR_CRS(ICRS) + MESHES(NM)%EDGE_CROSS(NEDGECROSS) % ISVAR(NCROSS)= CC_IS_CRS(ICRS) + MESHES(NM)%EDGE_CROSS(NEDGECROSS) % IJK(1:4) = (/ INDIE, INDJE, INDKE, X2AXIS /) - DEALLOCATE(B_IND,E_IND,F_IND,BOUND_EDGES) + ENDIF - ENDIF ZVALS_IF + ENDDO - !--- setup a block object (XB keyword ) +ENDDO ICRS_DO - NXB=0 - DO I = 1, 6 - IF (XB(I) MAX_VOLUS) THEN - MAX_VOLUS = N_VOLUS - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - DEALLOCATE(VERTS,FACES,TFACES,VOLUS); - ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1),VOLUS(4*MAX_VOLUS+1)) - VERTS=1.001_EB*MAX_VAL; FACES=0; VOLUS = 0; - ENDIF + ! Discard edge outside of blocks ranges for ray on x2axis: + IF ( (MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS) < X2LO_CELL) .OR. & + (MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS) > X2HI_CELL) ) CYCLE - ! define verts in box + NCROSS = MESHES(NM)%EDGE_CROSS(ICROSS)%NCROSS - N_VERTS = 0 - DO K = 0, IJK(3)-1 - BOX_XYZ(3) = (REAL(IJK(3)-1-K,EB)*XB(5) + REAL(K,EB)*XB(6))/REAL(IJK(3)-1,EB) - DO J = 0, IJK(2)-1 - BOX_XYZ(2) = (REAL(IJK(2)-1-J,EB)*XB(3) + REAL(J,EB)*XB(4))/REAL(IJK(2)-1,EB) - DO I = 0, IJK(1)-1 - BOX_XYZ(1) = (REAL(IJK(1)-1-I,EB)*XB(1) + REAL(I,EB)*XB(2))/REAL(IJK(1)-1,EB) - VERTS(3*N_VERTS+1:3*N_VERTS+3) = BOX_XYZ(1:3) - N_VERTS = N_VERTS + 1 - ENDDO - ENDDO - ENDDO + ! Edge Location in x1,x2,x3 axes: + ! Vert at index JJ-1: + INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)-1, & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 + INDI=INDXI(XIAXIS) + INDJ=INDXI(XJAXIS) + INDK=INDXI(XKAXIS) + ! Vert at index JJ: + INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS), & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 + INDI1=INDXI(XIAXIS) + INDJ1=INDXI(XJAXIS) + INDK1=INDXI(XKAXIS) + ! Edge at index jj: + INDXI(IAXIS:KAXIS) = (/ MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X1AXIS), & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS), & + MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X3AXIS) /) ! Local x1,x2,x3 + INDIE=INDXI(XIAXIS) ! i.e. MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(IAXIS), etc. + INDJE=INDXI(XJAXIS) + INDKE=INDXI(XKAXIS) - ! define tetrahedrons in box + ! Discard Edge with one EDGECROSS and both vertices having VERTVAR = CC_SOLID: + ! The crossing is on one of the edge vertices. + IF ( (NCROSS == 1) .AND. & + (MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & + (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) ) THEN - N_VOLUS = 0 - NI = IJK(1) - NIJ = IJK(1)*IJK(2) - DO K = 0, IJK(3)-2 - DO J = 0, IJK(2)-2 - DO I = 0, IJK(1)-2 + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID + CYCLE - ! 8-------7 - ! / . / | - ! 5-------6 | - ! | . | | - ! | . | | - ! | 4-------3 - ! | / | / - ! 1-------2 - BOXVERTLIST(1) = K*NIJ + J*NI + I + 1 - BOXVERTLIST(2) = BOXVERTLIST(1) + 1 - BOXVERTLIST(3) = BOXVERTLIST(2) + NI - BOXVERTLIST(4) = BOXVERTLIST(3) - 1 - BOXVERTLIST(5) = BOXVERTLIST(1) + NIJ - BOXVERTLIST(6) = BOXVERTLIST(2) + NIJ - BOXVERTLIST(7) = BOXVERTLIST(3) + NIJ - BOXVERTLIST(8) = BOXVERTLIST(4) + NIJ - CALL BOX2TETRA(BOXVERTLIST,VOLUS(4*N_VOLUS+1:4*N_VOLUS+24)) - N_VOLUS = N_VOLUS + 6 - ENDDO - ENDDO - ENDDO - N_FACES=0 - ENDIF NXB_IF + ENDIF - ! setup a sphere object (SPHERE_RADIUS and SPHERE_ORIGIN keywords) + ! Discard cases for edge with two crossings: + IF ( NCROSS == 2 ) THEN - IF (SPHERE_RADIUS MESHES(1) - DX = M%DXMIN + ! Test if crossings lay on same location + solid vertices: + DIF = ( MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(2) - & + MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(1) ) < GEOMEPS + IF (DIF .AND. VSOLID) THEN + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID + CYCLE + ENDIF - ! 2*PI*R/(5*2^N_LEVELS) ~= DX, solve for N_LEVELS + DIF = (ABS(X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)-1 ) - & + MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(1)) < GEOMEPS) .AND. & + (ABS(X2FACE(MESHES(NM)%EDGE_CROSS(ICROSS)%IJK(X2AXIS)) - & + MESHES(NM)%EDGE_CROSS(ICROSS)%SVAR(2)) < GEOMEPS) - IF (SPHERE_RADIUS<100.0_EB*TWENTY_EPSILON_EB) SPHERE_RADIUS = 100.0_EB*TWENTY_EPSILON_EB + VFLUID = (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(1) == CC_GS) .AND. & + (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(2) == CC_SG) - IF (SPHERE_TYPE/=2) SPHERE_TYPE = 1 - IF (N_LEVELS<0 .AND. N_LAT>0 .AND. N_LONG>0) SPHERE_TYPE = 2 - IF (SPHERE_TYPE==1) THEN - IF (N_LEVELS==-1) N_LEVELS = INT(LOG(2.0_EB*PI*SPHERE_RADIUS/(5.0_EB*DX))/LOG(2.0_EB)) - N_LEVELS = MIN(7,MAX(0,N_LEVELS)) - N_FACES = 20*(4**N_LEVELS+1) ! NOTE : Number larger than actual value. - ELSE - IF (N_LONG<6) N_LONG = MAX(6,INT(2.0_EB*PI*SPHERE_RADIUS/DX)+1) - IF (N_LAT<3) N_LAT = MAX(3,INT(PI*SPHERE_RADIUS/DX)+1) - N_FACES = 2*N_LAT*N_LONG ! NOTE : Number larger than actual value. - ENDIF - IF (N_FACES > MAX_FACES) THEN - MAX_FACES = N_FACES - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - DEALLOCATE(VERTS,FACES,TFACES); - ALLOCATE(VERTS(3*MAX_VERTS+1)); ALLOCATE(TFACES(6*MAX_FACES+1)); ALLOCATE(FACES(4*MAX_FACES+1)) - VERTS=1.001_EB*MAX_VAL; FACES=0 - ENDIF - IF (SPHERE_TYPE==1) THEN - CALL INIT_SPHERE(N_LEVELS,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,VERTS,FACES) - ELSE - CALL INIT_SPHERE2(N_VERTS,N_FACES,N_LAT,N_LONG,VERTS,FACES) + IF (DIF .AND. VSOLID .AND. VFLUID) THEN + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID + CYCLE ENDIF - DO I = 0, N_VERTS-1 - VERTS(3*I+1:3*I+3) = SPHERE_ORIGIN(1:3) + SPHERE_RADIUS*VERTS(3*I+1:3*I+3) - ENDDO - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 - IF (TRIM(SURF_ID(1))/='null') SURFS = 1 ! First single SURF_ID entry takes precedence. + ENDIF - ! Setup a cylinder object (CYLINDER_RADIUS, CYLINDER_LENGTH, CYLINDER_ORIGIN, CYLINDER_AXIS keywords): - DEFINE_CYLINDER_IF: IF ( CYLINDER_LENGTH MAX_FACES) THEN - MAX_FACES = N_FACES - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - DEALLOCATE(VERTS,FACES,TFACES); ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1)) - VERTS=1.001_EB*MAX_VAL; FACES=0 + ! Allocate new edge XYZVERT, CEELEM, INDSEG + CALL NEW_EDGE_ALLOC(NM,NCUTEDGE,NVERT,CC_ALLOC_DELEM) + DO IVERT=1,MESHES(NM)%CUT_EDGE(NCUTEDGE)%NVERT + MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT(IAXIS:KAXIS,IVERT) = & + X123VERT( (/ XIAXIS, XJAXIS, XKAXIS /) ,IVERT) + ENDDO + + ! Now Cut Edges: + ! Node List: + VERT_LIST(:,:) = CC_UNDEFINED + VERT_LIST(1,:) = CC_VTYPE_NINB ! Nodes by default are in boundary. + CE=>MESHES(NM)%CUT_EDGE(NCUTEDGE) + DO IVERT=1,CE%NVERT + ! NOD1: + IF(ABS(CE%XYZVERT(IAXIS,IVERT)-XFACE(INDI )) 0) THEN - IF ( ABS(EXTRUDE) < GEOMEPS ) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR(712): For extruded Polygon GEOM ',TRIM(ID),& - ' : extrusion distance in EXTRUDE field not defined or zero. Define EXTRUDE value in &GEOM.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF + ! Do a SOLID crossing count up to XYZcen(x2axis): + SCEN=XYZCEN(X2AXIS) + CALL GET_IS_GASPHASE(SCEN,IS_GASPHASE) - ! Do some tests in POLY, Repeated vertex, etc.: - IF (N_POLY_VERTS > N_VERTS) THEN - WRITE(MESSAGE,'(A,A,A,I6,A,I6,A)') 'ERROR(713): For extruded Polygon GEOM ',TRIM(ID),& - ' : Number of POLY indexes ',N_POLY_VERTS,' greater than Number of VERTS ',N_VERTS,'.' - CALL SHUTDOWN(MESSAGE); RETURN + IF ( IS_GASPHASE ) THEN + NEDGE = NEDGE + 1 + ! Test for size of CEELEM, INDSEG, if smaller than NEDGE reallocate: + CALL REALLOCATE_EDGE_ELEM(NM,NCUTEDGE,NEDGE) + MESHES(NM)%CUT_EDGE(NCUTEDGE)%NEDGE = NEDGE + MESHES(NM)%CUT_EDGE(NCUTEDGE)%CEELEM(NOD1:NOD2,NEDGE) = (/ IVERT, IVERT+1 /) ENDIF - DO J=1,N_POLY_VERTS - DO I=J+1,N_POLY_VERTS - IF (POLY(I)==POLY(J)) THEN - WRITE(MESSAGE,'(A,A,A,I6,A)') 'ERROR(714): For extruded Polygon GEOM ',TRIM(ID),& - ' : Repeated vertex ',POLY(I),' in Polyline.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - IF (NORM2(VERTS(3*POLY(I)-2:3*POLY(I))-VERTS(3*POLY(J)-2:3*POLY(J))) < GEOMEPS) THEN - WRITE(MESSAGE,'(A,A,A,I6,A,I6,A)') 'ERROR(715): For extruded Polygon GEOM ',TRIM(ID),& - ' : Vertices ',POLY(I),' and ',POLY(J),' have same position.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - ENDDO + ENDDO + + IF (MESHES(NM)%CUT_EDGE(NCUTEDGE)%NEDGE == 0) THEN ! REWIND + DEALLOCATE(MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT) + DEALLOCATE(MESHES(NM)%CUT_EDGE(NCUTEDGE)%CEELEM) + DEALLOCATE(MESHES(NM)%CUT_EDGE(NCUTEDGE)%INDSEG) + DEALLOCATE(MESHES(NM)%CUT_EDGE(NCUTEDGE)%VERT_LIST) + NCUTEDGE = NCUTEDGE - 1 + MESHES(NM)%N_CUTEDGE_MESH = NCUTEDGE + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_IDCE,X2AXIS) = 0 + ENDIF - N_FACES = 5*N_POLY_VERTS ! NOTE : Number larger than actual value. - IF (N_FACES > MAX_FACES) THEN - MAX_FACES = N_FACES - CALL GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) - DEALLOCATE(VERTS,FACES,TFACES); ALLOCATE(VERTS(3*MAX_VERTS+1),TFACES(6*MAX_FACES+1),FACES(4*MAX_FACES+1)) - VERTS=1.001_EB*MAX_VAL; FACES=0 - ENDIF +ENDDO - CALL DEFINE_EXTRUDED_POLY(MAX_VERTS,N_VERTS,VERTS,MAX_POLY_VERTS,N_POLY_VERTS,POLY,& - EXTRUDE,MAX_FACES,N_FACES,START_FACE_LO,START_FACE_HI,START_FACE_MID,FACES,IERR) +T_CC_USED(GET_CARTEDGE_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTEDGE_CUTEDGES_TIME_INDEX) + CURRENT_TIME() - TNOW - IF(IERR /= 0) RETURN +RETURN +END SUBROUTINE GET_CARTEDGE_CUTEDGES - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 - IF (TRIM(SURF_ID(1))/='null') THEN ! First single SURF_ID entry takes precedence. - SURFS = 1 - ELSEIF (TRIM(SURF_IDS(1))/='null' .AND. TRIM(SURF_IDS(2))/='null' .AND. TRIM(SURF_IDS(3))/='null') THEN - SURF_ID(1:3) = SURF_IDS(1:3) - ! Then SURF_IDS(1:3), where (1) is top, (2) sides (3) bottom. - SURFS(START_FACE_HI +1:START_FACE_HI+START_FACE_MID) = 1 - SURFS(START_FACE_MID+1:N_FACES) = 2 - SURFS(START_FACE_LO +1:START_FACE_LO+START_FACE_HI) = 3 - ENDIF +! ------------------------EDGE_CROSS_ARRAY_REALLOCATE---------------------------- - ENDIF POLY_COND +SUBROUTINE EDGE_CROSS_ARRAY_REALLOCATE(NM,CEI) - G%N_LEVELS = N_LEVELS - G%SPHERE_ORIGIN = SPHERE_ORIGIN - G%SPHERE_RADIUS = SPHERE_RADIUS - G%CYLINDER_LENGTH = CYLINDER_LENGTH - G%CYLINDER_RADIUS = CYLINDER_RADIUS - G%CYLINDER_ORIGIN = CYLINDER_ORIGIN - G%CYLINDER_AXIS = CYLINDER_AXIS - G%IJK = IJK - G%GEOM_TYPE = GEOM_TYPE - ! If terrain GEOM and CELL_BLOCK_IOR not set in input line, block in the -3 direction: - IF(GEOM_TYPE==TERRAIN_GEOM_TYPE .AND. CELL_BLOCK_IOR==0) G%CELL_BLOCK_IOR = -KAXIS +INTEGER, INTENT(IN) :: NM, CEI - LOGTEST = GEOM_TYPE==CAD_GEOM_TYPE .OR. GEOM_TYPE==TERRAIN_GEOM_TYPE - IF (.NOT.LOGTEST) THEN - ! The geometry has been constructed from predefined object : Terrain, cube, sphere, etc. - ! This requires removing duplicate verts. - ! For geometries where VERTS, FACES are being read, GEOM_TYPE=CAD_GEOM_TYPE, it is assumed duplicate vertices - ! have already been removed. - FIRST_FACE_INDEX=1 - CALL REMOVE_DUPLICATE_VERTS(N_VERTS,N_FACES,N_VOLUS,MAX_VERTS,MAX_FACES,MAX_VOLUS,FIRST_FACE_INDEX,& - VERTS,FACES,VOLUS,GEOMEPS) - ENDIF +! Local Variables: +INTEGER :: CEI1, SIZE_EDGE_CROSS - ! wrap up +SIZE_EDGE_CROSS = SIZE(MESHES(NM)%EDGE_CROSS,DIM=1) +IF(CEI > SIZE_EDGE_CROSS) THEN + ALLOCATE(EDGE_CROSS_AUX(SIZE_EDGE_CROSS+GLOBAL_DELTA_EDGE)) + DO CEI1=1,CEI-1 + EDGE_CROSS_AUX(CEI1)%NCROSS = MESHES(NM)%EDGE_CROSS(CEI1)%NCROSS + EDGE_CROSS_AUX(CEI1)%SVAR = MESHES(NM)%EDGE_CROSS(CEI1)%SVAR + EDGE_CROSS_AUX(CEI1)%ISVAR = MESHES(NM)%EDGE_CROSS(CEI1)%ISVAR + EDGE_CROSS_AUX(CEI1)%IJK = MESHES(NM)%EDGE_CROSS(CEI1)%IJK + ENDDO + CALL MOVE_ALLOC(FROM=EDGE_CROSS_AUX, TO=MESHES(NM)%EDGE_CROSS) +ENDIF - G%ID = ID - G%N_VOLUS_BASE = N_VOLUS - G%N_FACES_BASE = N_FACES - G%N_VERTS_BASE = N_VERTS +RETURN +END SUBROUTINE EDGE_CROSS_ARRAY_REALLOCATE - ! Check if SURF_ID(1) has been defined: - N_SURF_ID = 0 - IF (TRIM(SURF_ID(1))=='null') THEN - SURF_INDEX_PER_FACE = .FALSE. - HAVE_SURF = .FALSE. - ALLOCATE(G%SURF_ID(1)) - G%SURF_ID(1) = 'null' - ELSE - SURF_INDEX_PER_FACE = .TRUE. - ! Check that elements of the list of SURF_IDs are in list of SURFS: - ! How many SURF_ID entries are different than Null, where in SURFACE they belong: - DO I = 1, MAX_SURF_IDS - IF( SURF_ID(I)=='null' ) EXIT ! First 'null' - N_SURF_ID = N_SURF_ID + 1 - ENDDO - ALLOCATE(G%SURF_ID(1:N_SURF_ID)) - G%SURF_ID(1:N_SURF_ID) = SURF_ID(1:N_SURF_ID) - ! Now find correspondence with SURFACE(N)%ID: - IF (ALLOCATED(SURF_ID_IND)) DEALLOCATE(SURF_ID_IND) - ALLOCATE(SURF_ID_IND(N_SURF_ID)) - DO I = 1, N_SURF_ID - ! Get Surf Index: - IN_LIST = .FALSE. - DO J = 0, N_SURF - IF (TRIM(SURF_ID(I))/=TRIM(SURFACE(J)%ID)) CYCLE - SURF_ID_IND(I)=J - IN_LIST = .TRUE. - EXIT - ENDDO - IF(.NOT.IN_LIST) THEN - WRITE(MESSAGE,'(A,I4,3A)') 'ERROR(716): problem with GEOM, the surface ID(',I,') =',& - TRIM(SURF_ID(I)),' is not defined.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - ENDDO - ENDIF - G%HAVE_SURF = HAVE_SURF +! --------------------------CUT_EDGE_ARRAY_REALLOC------------------------------- - IF (MATL_ID=='null') THEN - HAVE_MATL = .FALSE. - ENDIF - G%MATL_ID = MATL_ID - G%HAVE_MATL = HAVE_MATL +SUBROUTINE CUT_EDGE_ARRAY_REALLOC(NM,CEI) - IF (N_VERTS>0) THEN +INTEGER, INTENT(IN) :: NM, CEI - TXMIN = VERTS(1) - TXMAX = TXMIN - TYMIN = VERTS(2) - TYMAX = TYMIN - DO I = 1, N_VERTS - TX = VERTS(3*I-2) - TY = VERTS(3*I-1) - IF (TXTXMAX)TXMAX=TX - IF (TYTYMAX)TYMAX=TY - ENDDO - TEXTURE_ORIGIN(1)=TXMIN - TEXTURE_ORIGIN(2)=TYMIN - TEXTURE_SCALE(1)=TXMAX-TXMIN - TEXTURE_SCALE(2)=TYMAX-TYMIN - ENDIF +! Local Variables: +INTEGER :: CEI1, SIZE_CUT_EDGE - G%TEXTURE_ORIGIN = TEXTURE_ORIGIN - G%TEXTURE_SCALE = TEXTURE_SCALE - IF ( TRIM(TEXTURE_MAPPING)/='SPHERICAL' .AND. TRIM(TEXTURE_MAPPING)/='RECTANGULAR') TEXTURE_MAPPING = 'RECTANGULAR' - G%TEXTURE_MAPPING = TEXTURE_MAPPING - G%IS_TERRAIN = IS_TERRAIN +SIZE_CUT_EDGE = SIZE(MESHES(NM)%CUT_EDGE,DIM=1) +IF (CEI > SIZE_CUT_EDGE) THEN + ALLOCATE(CUT_EDGE_AUX(SIZE_CUT_EDGE+GLOBAL_DELTA_EDGE)) + DO CEI1=1,CEI-1 + CUT_EDGE_AUX(CEI1)%NVERT = MESHES(NM)%CUT_EDGE(CEI1)%NVERT + CUT_EDGE_AUX(CEI1)%NEDGE = MESHES(NM)%CUT_EDGE(CEI1)%NEDGE + CUT_EDGE_AUX(CEI1)%NEDGE1 = MESHES(NM)%CUT_EDGE(CEI1)%NEDGE1 + CUT_EDGE_AUX(CEI1)%STATUS = MESHES(NM)%CUT_EDGE(CEI1)%STATUS + CUT_EDGE_AUX(CEI1)%IJK = MESHES(NM)%CUT_EDGE(CEI1)%IJK + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%XYZVERT, TO=CUT_EDGE_AUX(CEI1)%XYZVERT) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%CEELEM, TO=CUT_EDGE_AUX(CEI1)%CEELEM) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%INDSEG, TO=CUT_EDGE_AUX(CEI1)%INDSEG) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%VERT_LIST, TO=CUT_EDGE_AUX(CEI1)%VERT_LIST) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%NOD_PERM, TO=CUT_EDGE_AUX(CEI1)%NOD_PERM) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%DXX, TO=CUT_EDGE_AUX(CEI1)%DXX) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%FACE_LIST, TO=CUT_EDGE_AUX(CEI1)%FACE_LIST) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%DUIDXJ, TO=CUT_EDGE_AUX(CEI1)%DUIDXJ) + CALL MOVE_ALLOC(FROM=MESHES(NM)%CUT_EDGE(CEI1)%MU_DUIDXJ, TO=CUT_EDGE_AUX(CEI1)%MU_DUIDXJ) + ENDDO + CALL MOVE_ALLOC(FROM=CUT_EDGE_AUX, TO=MESHES(NM)%CUT_EDGE) +ENDIF - ! setup volumes +RETURN +END SUBROUTINE CUT_EDGE_ARRAY_REALLOC - N_VOLUS_IF: IF (N_VOLUS>0) THEN - ALLOCATE(G%VOLUS(4*N_VOLUS),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%VOLUS',IZERO) - DO I = 0, N_VOLUS-1 - VOL(1:4)=> VOLUS(4*I+1:4*I+4) - V1(1:3) => VERTS(3*VOL(1)-2:3*VOL(1)) - V2(1:3) => VERTS(3*VOL(2)-2:3*VOL(2)) - V3(1:3) => VERTS(3*VOL(3)-2:3*VOL(3)) - V4(1:3) => VERTS(3*VOL(4)-2:3*VOL(4)) - VOLUME = TETRAHEDRON_VOLUME(V3,V4,V2,V1) - IF ( VOLUME<0.0_EB ) THEN ! reorder vertices if tetrahedron volume is negative - IVOL=VOL(3) - VOL(3)=VOL(4) - VOL(4)=IVOL - ENDIF - ENDDO - G%VOLUS(1: 4*N_VOLUS) = VOLUS(1:4*N_VOLUS) - IF (ANY(VOLUS(1:4*N_VOLUS)<1 .OR. VOLUS(1:4*N_VOLUS)>N_VERTS)) THEN - CALL SHUTDOWN('ERROR(717): problem with GEOM, vertex index out of bounds.') - ENDIF - ALLOCATE(G%MATLS(N_VOLUS),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%MATLS',IZERO) - MATL_INDEX = GET_MATL_INDEX(MATL_ID) - ! The following constraint is removed for the time being. When Tetrahedrons are actually used for heat transfer - ! and pyrolysis this will be needed. - !IF (MATL_INDEX==0) THEN - ! IF (TRIM(MATL_ID)=='null') THEN - ! WRITE(MESSAGE,'(A)') 'ERROR: problem with GEOM, the material keyword, MATL_ID, is not defined.' - ! ELSE - ! WRITE(MESSAGE,'(3A)') 'ERROR: problem with GEOM, the material ',TRIM(MATL_ID),' is not defined.' - ! ENDIF - ! CALL SHUTDOWN(MESSAGE) - !ENDIF - G%MATLS(1:N_VOLUS) = MATL_INDEX +! ----------------------------- NEW_EDGE_ALLOC ---------------------------------- - ! construct an array of external faces +SUBROUTINE NEW_EDGE_ALLOC(NM,CEI,NVERTALLOC,NEDGEALLOC) - ! determine which tetrahedron faces are external +INTEGER, INTENT(IN) :: NM, CEI, NVERTALLOC, NEDGEALLOC - IF (N_FACES==0) THEN - N_FACES = 4*N_VOLUS - IF(ALLOCATED(IS_EXTERNAL)) DEALLOCATE(IS_EXTERNAL) - ALLOCATE(IS_EXTERNAL(0:N_FACES-1),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','IS_EXTERNAL',IZERO) +IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT) +IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM) +IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%CEELEM)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM) +IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%INDSEG)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%INDSEG) +IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST)) DEALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST) - IS_EXTERNAL(0:N_FACES-1)=.TRUE. ! start off by assuming all faces are external +ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:NVERTALLOC)) +ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(1:NVERTALLOC)) +ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGEALLOC)) +ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%INDSEG(CC_MAX_WSTRIANG_SEG+3,1:NEDGEALLOC)) +ALLOCATE(MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(CC_MAX_WSTRIANG_SEG+2,1:NVERTALLOC)) - ! reorder face indices so the the first index is always the smallest +MESHES(NM)%CUT_EDGE(CEI)%XYZVERT = 0._EB +MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM = CC_UNDEFINED +MESHES(NM)%CUT_EDGE(CEI)%CEELEM = CC_UNDEFINED +MESHES(NM)%CUT_EDGE(CEI)%INDSEG = CC_UNDEFINED +MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST= CC_UNDEFINED - ! 1 - ! /|\ . - ! / | \ . - ! / | \ . - ! / | \ . - ! / | \ . - ! / 4 \ . - ! / . . \ . - ! / . . \ . - ! / . . \ . - ! / . . \ . - ! / . . \ . - ! / . .\ . - ! 2-------------------------3 +RETURN - DO I = 0, N_VOLUS-1 - FACES(12*I+1) = VOLUS(4*I+1) - FACES(12*I+2) = VOLUS(4*I+2) - FACES(12*I+3) = VOLUS(4*I+3) - CALL REORDER_VERTS(FACES(12*I+1:12*I+3)) +END SUBROUTINE NEW_EDGE_ALLOC - FACES(12*I+4) = VOLUS(4*I+1) - FACES(12*I+5) = VOLUS(4*I+3) - FACES(12*I+6) = VOLUS(4*I+4) - CALL REORDER_VERTS(FACES(12*I+4:12*I+6)) +! ------------------ REALLOCATE_EDGE_VERT(NM,CEI,NVERT) ------------------------- + +SUBROUTINE REALLOCATE_EDGE_VERT(NM,CEI,NVERT) + +INTEGER, INTENT(IN) :: NM, CEI, NVERT - FACES(12*I+7) = VOLUS(4*I+1) - FACES(12*I+8) = VOLUS(4*I+4) - FACES(12*I+9) = VOLUS(4*I+2) - CALL REORDER_VERTS(FACES(12*I+7:12*I+9)) +! Local Variables: +INTEGER :: NVERT_SIZE +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZVERTAUX +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: VERT_LISTAUX +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOD_PERMAUX - FACES(12*I+10) = VOLUS(4*I+2) - FACES(12*I+11) = VOLUS(4*I+4) - FACES(12*I+12) = VOLUS(4*I+3) - CALL REORDER_VERTS(FACES(12*I+10:12*I+12)) - ENDDO +NVERT_SIZE = SIZE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT, DIM=2) - ! find faces that match +IF (NVERT > NVERT_SIZE) THEN ! Reallocate XYZVERT + ALLOCATE(XYZVERTAUX(IAXIS:KAXIS,1:NVERT_SIZE+CC_ALLOC_DVERT)); XYZVERTAUX = 0._EB + XYZVERTAUX(IAXIS:KAXIS,1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:NVERT_SIZE) + CALL MOVE_ALLOC(FROM=XYZVERTAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%XYZVERT) - SORT_FACES=2 - IF (GEOM_TYPE == SPHERE_GEOM_TYPE) SORT_FACES = 3 ! Case of sphere. + ALLOCATE(NOD_PERMAUX(1:NVERT_SIZE+CC_ALLOC_DVERT)); NOD_PERMAUX = CC_UNDEFINED + NOD_PERMAUX(1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(1:NVERT_SIZE) + CALL MOVE_ALLOC(FROM=NOD_PERMAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM) - SORT_FACES_IF: IF (SORT_FACES==1 ) THEN ! O(n*log(n)) algorithm for determining external faces - ALLOCATE(OFACES(N_FACES),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','OFACES',IZERO) - CALL ORDER_FACES(OFACES,N_FACES) - DO I = 1, N_FACES-1 - FACEI=>FACES(3*OFACES(I)-2:3*OFACES(I)) - FACEJ=>FACES(3*OFACES(I)+1:3*OFACES(I)+3) - IF (FACEI(1)==FACEJ(1) .AND. & - MIN(FACEI(2),FACEI(3))==MIN(FACEJ(2),FACEJ(3)) .AND. & - MAX(FACEI(2),FACEI(3))==MAX(FACEJ(2),FACEJ(3))) THEN - IS_EXTERNAL(OFACES(I))=.FALSE. - IS_EXTERNAL(OFACES(I-1))=.FALSE. - IF (FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(3)) THEN - WRITE(LU_ERR,*) 'WARNING: duplicate faces found:', FACEI(1),FACEI(2),FACEI(3) - ENDIF - ENDIF - ENDDO - DEALLOCATE(OFACES) - ELSEIF(SORT_FACES==2 ) THEN - DO I = 0, N_FACES-1 ! O(n^2) algorithm for determining external faces - FACEI=>FACES(3*I+1:3*I+3) - ! Sort FACEI: - DO J = 0, N_FACES-1 - IF (I==J) CYCLE - FACEJ=>FACES(3*J+1:3*J+3) - IF (FACEI(1)==FACEJ(1)) THEN - IF ((FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(3)) .OR. & - (FACEI(2)==FACEJ(3) .AND. FACEI(3)==FACEJ(2))) THEN - IS_EXTERNAL(I) = .FALSE. - IS_EXTERNAL(J) = .FALSE. - ENDIF - ELSEIF (FACEI(1)==FACEJ(2)) THEN - IF ((FACEI(2)==FACEJ(1) .AND. FACEI(3)==FACEJ(3)) .OR. & - (FACEI(2)==FACEJ(3) .AND. FACEI(3)==FACEJ(1))) THEN - IS_EXTERNAL(I) = .FALSE. - IS_EXTERNAL(J) = .FALSE. - ENDIF - ELSEIF (FACEI(1)==FACEJ(3)) THEN - IF ((FACEI(2)==FACEJ(1) .AND. FACEI(3)==FACEJ(2)) .OR. & - (FACEI(2)==FACEJ(2) .AND. FACEI(3)==FACEJ(1))) THEN - IS_EXTERNAL(I) = .FALSE. - IS_EXTERNAL(J) = .FALSE. - ENDIF - ENDIF - ENDDO - ENDDO - ELSEIF(SORT_FACES==3 ) THEN - DO I = 0,N_FACES-1 - ! Check that no verts are at the spheres center: - DO II=1,3 - II1=FACES(3*I+II) - IF ( SQRT((VERTS(3*II1-2)-SPHERE_ORIGIN(IAXIS))**2 + & - (VERTS(3*II1-1)-SPHERE_ORIGIN(JAXIS))**2 + & - (VERTS(3*II1 )-SPHERE_ORIGIN(KAXIS))**2) < GEOMEPS) & - IS_EXTERNAL(I) = .FALSE. - ENDDO - ENDDO - ENDIF SORT_FACES_IF + ALLOCATE(VERT_LISTAUX(1:4,1:NVERT_SIZE+CC_ALLOC_DVERT)); VERT_LISTAUX = CC_UNDEFINED + VERT_LISTAUX(1:4,1:NVERT_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,1:NVERT_SIZE) + CALL MOVE_ALLOC(FROM=VERT_LISTAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST) +ENDIF - ! create new FACES index array keeping only external faces +RETURN - N_FACES_TEMP = N_FACES - N_FACES=0 - DO I = 0, N_FACES_TEMP-1 - FACE_FROM=>FACES(3*I+1:3*I+3) - ! Drop triangles with zero area: - IF ( (FACE_FROM(1)==FACE_FROM(2)).OR.(FACE_FROM(1)==FACE_FROM(3)).OR.(FACE_FROM(2)==FACE_FROM(3)) ) CYCLE - IF (IS_EXTERNAL(I)) THEN - FACE_TO=>FACES(3*N_FACES+1:3*N_FACES+3) - FACE_TO(1:3) = FACE_FROM(1:3) - N_FACES=N_FACES+1 - ENDIF - ENDDO - G%N_FACES_BASE = N_FACES +END SUBROUTINE REALLOCATE_EDGE_VERT - IF (GEOM_TYPE == SPHERE_GEOM_TYPE) THEN - DO I = 0,N_FACES-1 - ! Check that no verts are at the spheres center: - DO II=1,3 - II1=FACES(3*I+II) - IF ( SQRT((VERTS(3*II1-2)-SPHERE_ORIGIN(IAXIS))**2 + & - (VERTS(3*II1-1)-SPHERE_ORIGIN(JAXIS))**2 + & - (VERTS(3*II1 )-SPHERE_ORIGIN(KAXIS))**2) < GEOMEPS) & - WRITE(LU_ERR,*) 'On External Faces, face/vertex ',I,II,II1,' located at center.' - ENDDO - II1=FACES(3*I+1) - II2=FACES(3*I+2) - II3=FACES(3*I+3) - DV1(IAXIS:KAXIS)= VERTS(3*II2-2:3*II2) - VERTS(3*II1-2:3*II1) - DV2(IAXIS:KAXIS)= VERTS(3*II3-2:3*II3) - VERTS(3*II1-2:3*II1) - CALL CROSS_PRODUCT(NVECI,DV1,DV2) - DXCEN= 1._EB/3._EB*(VERTS(3*II1-2:3*II1)+VERTS(3*II2-2:3*II2)+VERTS(3*II3-2:3*II3)) - & - SPHERE_ORIGIN(IAXIS:KAXIS) - DOTI = NVECI(IAXIS)*DXCEN(IAXIS) + NVECI(JAXIS)*DXCEN(JAXIS) + NVECI(KAXIS)*DXCEN(KAXIS) +! ------------------ REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) ------------------------- - IF (SIGN(1._EB,DOTI) < 0._EB) THEN - WRITE(LU_ERR,*) I,' has (-) sign normal.' - FACES(3*I+2) = II3 - FACES(3*I+3) = II2 - ENDIF - ENDDO - ENDIF - CALL COMPUTE_TEXTURES(VERTS,FACES,TFACES,MAX_VERTS,MAX_FACES,N_FACES) +SUBROUTINE REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) - ! Surf IDs for generated GEOM: - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) - ALLOCATE(SURFS(N_FACES)) - IF(SURF_INDEX_PER_FACE) THEN - SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). - ELSE - SURFS(:) = 0 ! All external faces point to default surf ID. - ENDIF - ENDIF - ENDIF N_VOLUS_IF +INTEGER, INTENT(IN) :: NM, CEI, NEDGE - ! Terrain case built with ZVALS, optimized way, define SURFS(:): - IF (N_ZVALS > 0) THEN - ! Surf IDs for generated GEOM: - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) - ALLOCATE(SURFS(N_FACES)) - IF(SURF_INDEX_PER_FACE) THEN - SURFS(:) = 1 ! All external faces point to only entry SURF_ID(1). - ELSE - SURFS(:) = 0 ! All external faces point to default surf ID. - ENDIF - ELSEIF(IS_TERRAIN) THEN - ! Finally Enhance SURFS to accomodate new faces. - ALLOCATE(SURFS2(N_FACES)); - ! Here define what SURF to assign to added faces. - IF(SURF_INDEX_PER_FACE) THEN - SURFS2(:) = 1 ! All external faces point to only entry SURF_ID(1). - ELSE - SURFS2(:) = 0 ! All external faces point to default surf ID. - ENDIF - SURFS2(1:N_FACES_ORIG) = SURFS(1:N_FACES_ORIG) - CALL MOVE_ALLOC(FROM=SURFS2,TO=SURFS) - ENDIF +! Local Variables: +INTEGER :: NEDGE_SIZE, CC_ALLOC_ELEM +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CEELEMAUX, INDSEGAUX +INTEGER, ALLOCATABLE, DIMENSION(:,:,:):: FACE_LIST_AUX +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: DXX_AUX,DUIDXJ_AUX,MU_DUIDXJ_AUX - N_FACES_IF: IF (N_FACES>0) THEN - ALLOCATE(G%FACES(3*N_FACES),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%FACES',IZERO) - G%FACES(1:3*N_FACES) = FACES(1:3*N_FACES) +NEDGE_SIZE = SIZE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM, DIM=2) - ! Check FACES for out of bounds indexes: - I = MINVAL(FACES(1:3*N_FACES)); II= MINLOC(FACES(1:3*N_FACES),DIM=1) - IF (I < 1) THEN - WRITE(MESSAGE,'(3A,I8,A,I8,A)') 'ERROR(718): Out of Bounds. GEOM: ',TRIM(ID), ', FACE=',& - II/3+1,', has vertex index ',I,' less than 1.' - CALL SHUTDOWN(MESSAGE) - RETURN - ENDIF - I = MAXVAL(FACES(1:3*N_FACES)); II= MAXLOC(FACES(1:3*N_FACES),DIM=1) - IF (I > N_VERTS) THEN - WRITE(MESSAGE,'(3A,I8,A,I8,A,I8,A)') 'ERROR(719): Out of Bounds. GEOM: ',TRIM(ID), ', FACE=',& - II/3+1,', has vertex index ',I,', higher than number of vertices defined ',N_VERTS,'.' - CALL SHUTDOWN(MESSAGE) - RETURN - ENDIF +IF (NEDGE > NEDGE_SIZE) THEN ! Reallocate CEELEM, - ALLOCATE(G%TFACES(6*N_FACES),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%TFACES',IZERO) - G%TFACES(1:6*N_FACES) = TFACES(1:6*N_FACES) + CC_ALLOC_ELEM = MAX(NEDGE-NEDGE_SIZE,CC_ALLOC_DELEM) - ALLOCATE(G%SURFS(N_FACES),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%SURFS',IZERO) + ALLOCATE(CEELEMAUX(NOD1:NOD2,1:NEDGE_SIZE+CC_ALLOC_ELEM), INDSEGAUX(CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE+CC_ALLOC_ELEM)) + CEELEMAUX = CC_UNDEFINED; INDSEGAUX = CC_UNDEFINED - PER_FACE_IF: IF (SURF_INDEX_PER_FACE) THEN - DO I=1,N_FACES - IF ( SURFS(I) <= 0 ) THEN - G%SURFS(I) = DEFAULT_SURF_INDEX ! If local SURF ID index <= 0, use default surf ID. - ELSE - G%SURFS(I) = SURF_ID_IND(SURFS(I)) - ENDIF - ENDDO - DEALLOCATE(SURF_ID_IND) - ELSE - G%SURFS(1:N_FACES) = DEFAULT_SURF_INDEX - BOX_TYPE_IF: IF ( GEOM_TYPE==BOX_GEOM_TYPE .AND. & - (SURF_ID(1)/='null' .OR. ALL(SURF_IDS/='null') .OR. ALL(SURF_ID6/='null')) )THEN - ! This loop allows GEOM to behave similarly to OBST - FACE_LOOP: DO I=1,N_FACES - II1=G%FACES(3*(I-1)+1) - II2=G%FACES(3*(I-1)+2) - II3=G%FACES(3*(I-1)+3) - DV1(IAXIS:KAXIS)= VERTS(3*II2-2:3*II2) - VERTS(3*II1-2:3*II1) - DV2(IAXIS:KAXIS)= VERTS(3*II3-2:3*II3) - VERTS(3*II1-2:3*II1) - CALL CROSS_PRODUCT(NVECI,DV1,DV2) - SURF_LOOP: DO NNN=0,N_SURF - IF (SURF_ID(1)==SURFACE(NNN)%ID .AND. ANY(ABS(NVECI(:))>TWENTY_EPSILON_EB)) G%SURFS(I) = NNN ! all sides - IF (SURF_IDS(2)==SURFACE(NNN)%ID .AND. (ABS(NVECI(1))>TWENTY_EPSILON_EB .OR. ABS(NVECI(2))>TWENTY_EPSILON_EB) ) & - G%SURFS(I) = NNN ! sides - IF (SURF_IDS(1)==SURFACE(NNN)%ID .AND. NVECI(3)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! top - IF (SURF_IDS(3)==SURFACE(NNN)%ID .AND. NVECI(3)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! bottom - IF (SURF_ID6(1)==SURFACE(NNN)%ID .AND. NVECI(1)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! X1 - IF (SURF_ID6(2)==SURFACE(NNN)%ID .AND. NVECI(1)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! X2 - IF (SURF_ID6(3)==SURFACE(NNN)%ID .AND. NVECI(2)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Y1 - IF (SURF_ID6(4)==SURFACE(NNN)%ID .AND. NVECI(2)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Y2 - IF (SURF_ID6(5)==SURFACE(NNN)%ID .AND. NVECI(3)<-TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Z1 - IF (SURF_ID6(6)==SURFACE(NNN)%ID .AND. NVECI(3)> TWENTY_EPSILON_EB) G%SURFS(I) = NNN ! Z2 - ENDDO SURF_LOOP - ENDDO FACE_LOOP - ENDIF BOX_TYPE_IF - ENDIF PER_FACE_IF + CEELEMAUX(NOD1:NOD2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGE_SIZE) + INDSEGAUX(1:CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:NEDGE_SIZE) - ! Test for Unsupported surfaces: - DO I=1,N_FACES - ! HERE do tests on surfaces, is not supported by GEOMs throw error: - UNSUPPORTED_SURF_FIELD : IF(SURFACE(G%SURFS(I))%BURN_AWAY) THEN - WRITE(MESSAGE,'(5A)') 'ERROR(720): GEOM: ',TRIM(ID),& - ', has currently unsupported BURN_AWAY feature in surface : ',TRIM(SURFACE(G%SURFS(I))%ID),'.' - CALL SHUTDOWN(MESSAGE) - RETURN - ENDIF UNSUPPORTED_SURF_FIELD - ! Others.. - ENDDO + CALL MOVE_ALLOC(FROM=CEELEMAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%CEELEM) + CALL MOVE_ALLOC(FROM=INDSEGAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%INDSEG) + + IF (ALLOCATED(MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST)) THEN + ! FACE_LIST, DXX, DUIDXJ, MU_DUIDXJ: + ALLOCATE(FACE_LIST_AUX(1:3,-2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); FACE_LIST_AUX=CC_UNDEFINED + FACE_LIST_AUX(1:3,-2:2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,1:NEDGE_SIZE) + CALL MOVE_ALLOC(FROM=FACE_LIST_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%FACE_LIST) - ENDIF N_FACES_IF + ALLOCATE(DXX_AUX(1:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); DXX_AUX=0._EB + DXX_AUX(1:2,1:NEDGE_SIZE) = MESHES(NM)%CUT_EDGE(CEI)%DXX(1:2,1:NEDGE_SIZE) + CALL MOVE_ALLOC(FROM=DXX_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%DXX) - IF (N_VERTS>0) THEN - ALLOCATE(G%VERTS_BASE(3*N_VERTS),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%VERTS_BASE',IZERO) - G%VERTS_BASE(1:3*N_VERTS) = VERTS(1:3*N_VERTS) + ALLOCATE(DUIDXJ_AUX( -2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); DUIDXJ_AUX = 0._EB + ALLOCATE(MU_DUIDXJ_AUX(-2:2,1:NEDGE_SIZE+CC_ALLOC_ELEM)); MU_DUIDXJ_AUX= 0._EB - ALLOCATE(G%VERTS(3*N_VERTS),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%VERTS',IZERO) + CALL MOVE_ALLOC(FROM=DUIDXJ_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%DUIDXJ) + CALL MOVE_ALLOC(FROM=MU_DUIDXJ_AUX,TO=MESHES(NM)%CUT_EDGE(CEI)%MU_DUIDXJ) ENDIF - G%MOVE_ID = MOVE_ID - G%IS_DYNAMIC = .FALSE. +ENDIF - ! Prevent drawing of boundary info if desired +RETURN - G%SHOW_BNDF = BNDF_GEOM +END SUBROUTINE REALLOCATE_EDGE_ELEM - ! Case of false READ_BINARY, Process 0 writes a binary file with the geom: - IF(MY_RANK == 0 .AND. .NOT.READ_BINARY) THEN - WRITE(FN_BINGEOM,'(A,A,A,A,A)') './',TRIM(BINGEOM_DIR)//TRIM(CHID),'_',TRIM(ID),'.bingeom' - OPEN(UNIT=LU_BINGEOM,FILE=TRIM(FN_BINGEOM),STATUS='UNKNOWN',ACTION='WRITE',FORM='UNFORMATTED') - WRITE(LU_BINGEOM) GEOM_TYPE - IF (GEOM_TYPE==TERRAIN_GEOM_TYPE) THEN - WRITE(LU_BINGEOM) N_VERTS_ORIG,N_FACES_ORIG,N_SURF_ID,N_VOLUS_ORIG - WRITE(LU_BINGEOM) VERTS(1:3*N_VERTS_ORIG) - WRITE(LU_BINGEOM) FACES(1:3*N_FACES_ORIG) - WRITE(LU_BINGEOM) SURFS(1:N_FACES_ORIG) - WRITE(LU_BINGEOM) VOLUS(1:4*N_VOLUS_ORIG) - ELSE - WRITE(LU_BINGEOM) N_VERTS,N_FACES,N_SURF_ID,N_VOLUS - WRITE(LU_BINGEOM) VERTS(1:3*N_VERTS) - WRITE(LU_BINGEOM) FACES(1:3*N_FACES) - WRITE(LU_BINGEOM) SURFS(1:N_FACES) - WRITE(LU_BINGEOM) VOLUS(1:4*N_VOLUS) - ENDIF - CLOSE(LU_BINGEOM) - ENDIF +! -------------------------- GET_ISGASPHASE ------------------------------------- -ENDDO READ_GEOM_LOOP -35 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 +SUBROUTINE GET_IS_GASPHASE(SCEN,IS_GASPHASE) -CALL CONVERTGEOM(T_BEGIN) +REAL(EB), INTENT(IN) :: SCEN +LOGICAL, INTENT(OUT) :: IS_GASPHASE -DO IG = 1, N_GEOMETRY +! Local Variables: +LOGICAL :: IS_GASPHASE_LEFT, IS_GASPHASE_RIGHT +INTEGER :: ICRS - G=>GEOMETRY(IG) +! Count GS,SG intersections from both sides: +IS_GASPHASE_LEFT = .TRUE. +DO ICRS=1,CC_N_CRS + IF (SCEN < CC_SVAR_CRS(ICRS)-GEOMEPS/2._EB) CYCLE + ! If solid change state: + IF ( (CC_IS_CRS(ICRS) == CC_GS) .OR. (CC_IS_CRS(ICRS) == CC_SG) ) THEN + IS_GASPHASE_LEFT = .NOT.IS_GASPHASE_LEFT + ENDIF +ENDDO - ! Define box containing Geometry: - DO X1AXIS=IAXIS,KAXIS - G%GEOM_BOX( LOW_IND,X1AXIS) = 1._EB/GEOMEPS ! Initialize min location in X1AXIS dir to large (+) number. - G%GEOM_BOX(HIGH_IND,X1AXIS) =-1._EB/GEOMEPS ! Initialize max location in X1AXIS dir to large (-) number. - DO IVERT=1,G%N_VERTS - G%GEOM_BOX( LOW_IND,X1AXIS) = MIN(G%GEOM_BOX( LOW_IND,X1AXIS),G%VERTS(MAX_DIM*(IVERT-1)+X1AXIS)) - G%GEOM_BOX(HIGH_IND,X1AXIS) = MAX(G%GEOM_BOX(HIGH_IND,X1AXIS),G%VERTS(MAX_DIM*(IVERT-1)+X1AXIS)) - ENDDO - ENDDO +IS_GASPHASE_RIGHT = .TRUE. +DO ICRS=CC_N_CRS,1,-1 + IF (SCEN > CC_SVAR_CRS(ICRS)+GEOMEPS/2._EB) CYCLE + ! If solid change state: + IF ( (CC_IS_CRS(ICRS) == CC_GS) .OR. (CC_IS_CRS(ICRS) == CC_SG) ) THEN + IS_GASPHASE_RIGHT = .NOT.IS_GASPHASE_RIGHT + ENDIF +ENDDO - ! Check for duct nodes +! If at least one of left and right are true -> add +! CC_GASPHASE cut-edge: +IS_GASPHASE = IS_GASPHASE_LEFT .OR. IS_GASPHASE_RIGHT - DO J = 1,G%N_FACES - IF (SURFACE(G%SURFS(J))%NODE_ID/='null') THEN - G%HAVE_NODE = .TRUE. - EXIT - ENDIF - ENDDO +RETURN +END SUBROUTINE GET_IS_GASPHASE -ENDDO +! --------------------- GET_BODX2_INTERSECTIONS --------------------------------- -IF(ALLOCATED(VOLUS)) DEALLOCATE(VOLUS) -IF(ALLOCATED(FACES)) DEALLOCATE(FACES) -IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS) -IF(ALLOCATED(VERTS)) DEALLOCATE(VERTS) -IF(ALLOCATED(ZVALS)) DEALLOCATE(ZVALS) -IF(ALLOCATED(TFACES))DEALLOCATE(TFACES) +SUBROUTINE GET_BODX2_INTERSECTIONS(X2AXIS,X3AXIS,X3RAY) -DEALLOCATE(GEOM_LINE) +INTEGER, INTENT(IN) :: X2AXIS,X3AXIS +REAL(EB),INTENT(IN) :: X3RAY -IF( (T_END-T_BEGIN) < TWENTY_EPSILON_EB) RETURN +! Local Variables: +REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN, SBOD +REAL(EB) :: STANI(IAXIS:JAXIS), DV(IAXIS:JAXIS) +INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IBCR, IDUM, NBCROSS_SVAR +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX +REAL(EB) :: DX3_1, DX3_2, XI1, XI2 +REAL(EB) :: TNOW -CC_IBM = .TRUE. +! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX3_1Q,DX3_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) -! If unstructured projection defined set Pressure solver on unstructured grid. -IF (PRES_FLAG/=UGLMAT_FLAG) THEN - PRES_METHOD = 'ULMAT' - PRES_FLAG = ULMAT_FLAG -ENDIF -PRES_ON_WHOLE_DOMAIN = .FALSE. -IF (ABS(CCVOL_LINK-0.95_EB) GEOMEPS) CYCLE + IF( (MIN(BODINT_PLANE%XYZ(X3AXIS,SEG(NOD1)),BODINT_PLANE%XYZ(X3AXIS,SEG(NOD2)))-X3RAY) > GEOMEPS) CYCLE + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) -IERR = 1 + ! x2_x3 of segment point 1: + X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) + ! x2_x3 of segment point 2: + X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) -! Define PVERTS: -ALLOCATE(PVERTS(1:2*MAX_DIM*N_POLY_VERTS)); PVERTS=0._EB -MINMAX_POS( LOW_IND,IAXIS:KAXIS) = 1._EB/GEOMEPS -MINMAX_POS(HIGH_IND,IAXIS:KAXIS) =-1._EB/GEOMEPS -DO I=1,N_POLY_VERTS - PVERTS(3*I-2:3*I) = VERTS(3*POLY(I)-2:3*POLY(I)) - MINMAX_POS( LOW_IND,IAXIS) = MIN(MINMAX_POS( LOW_IND,IAXIS),PVERTS(3*I-2)) - MINMAX_POS( LOW_IND,JAXIS) = MIN(MINMAX_POS( LOW_IND,JAXIS),PVERTS(3*I-1)) - MINMAX_POS( LOW_IND,KAXIS) = MIN(MINMAX_POS( LOW_IND,KAXIS),PVERTS(3*I )) - MINMAX_POS(HIGH_IND,IAXIS) = MAX(MINMAX_POS(HIGH_IND,IAXIS),PVERTS(3*I-2)) - MINMAX_POS(HIGH_IND,JAXIS) = MAX(MINMAX_POS(HIGH_IND,JAXIS),PVERTS(3*I-1)) - MINMAX_POS(HIGH_IND,KAXIS) = MAX(MINMAX_POS(HIGH_IND,KAXIS),PVERTS(3*I )) -ENDDO -PVERTS(3*(N_POLY_VERTS+1)-2:3*(N_POLY_VERTS+1)) = PVERTS(1:3) -! Define average normal: -XYZCEN(IAXIS:KAXIS)=0._EB -DO I=1,N_POLY_VERTS - XYZCEN(IAXIS:KAXIS) = XYZCEN(IAXIS:KAXIS) + PVERTS(3*I-2:3*I) -ENDDO -XYZCEN = XYZCEN / REAL(N_POLY_VERTS,EB) -! Define an area averaged normal vector (note: this might need to change to average normal to the set of points in a -! least squares sense, i.e. eigenvector associated with smallest eigenvalue of the covariance matrix of vertices positions -! respect to XYZCEN): -NVEC(IAXIS:KAXIS)=0._EB -DO I=1,N_POLY_VERTS - DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - XYZCEN(IAXIS:KAXIS) - DV2(IAXIS:KAXIS) = PVERTS(3*I+1:3*(I+1)) - XYZCEN(IAXIS:KAXIS) - CALL CROSS_PRODUCT(N,DV1,DV2) - NVEC(IAXIS:KAXIS) = NVEC(IAXIS:KAXIS) + N(IAXIS:KAXIS) -ENDDO -IF(NORM2(NVEC) > TWENTY_EPSILON_EB) NVEC=NVEC/NORM2(NVEC) + ! IF (.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + ! Segment length: + SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) -! Test all segments are in plane normal to NVEC, tolerance for distance to plane given by XYZCEN, NVEC is -! 5% of the bounding box diagonal for the polygon: -BBLEN = SQRT( (MINMAX_POS(HIGH_IND,IAXIS)-MINMAX_POS( LOW_IND,IAXIS))**2._EB + & - (MINMAX_POS(HIGH_IND,JAXIS)-MINMAX_POS( LOW_IND,JAXIS))**2._EB + & - (MINMAX_POS(HIGH_IND,KAXIS)-MINMAX_POS( LOW_IND,KAXIS))**2._EB ) -THLEN = 0.05_EB * BBLEN ! Threshold distance to polygon average plane. -DO I=1,N_POLY_VERTS - DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - XYZCEN(IAXIS:KAXIS) - IF (ABS(DOT_PRODUCT(DV1,NVEC)) > THLEN) THEN - WRITE(MESSAGE,'(A,A,A,I3,A)') 'ERROR(721): For extruded Polygon GEOM ',TRIM(ID),& - ' : Node (',POLY(I),') not in the plane of the polygon. Check VERTS.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF -ENDDO + ! Unit vector along segment: + STANI(IAXIS:JAXIS) = 1._EB/SLEN * (/ (X2_2-X2_1), (X3_2-X3_1) /) -! Here project all points to average plane. Do seg-seg intersection tests: -DO I=1,N_POLY_VERTS - DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I)-XYZCEN(IAXIS:KAXIS) - DV2(IAXIS:KAXIS) = DV1(IAXIS:KAXIS) - DOT_PRODUCT(DV1,NVEC) * NVEC(IAXIS:KAXIS) - PVERTS(3*(I+N_POLY_VERTS)-2:3*(I+N_POLY_VERTS)) = XYZCEN(IAXIS:KAXIS) + DV2(IAXIS:KAXIS) -ENDDO -! Define local coordinate system SVEC,PVEC,NVEC: -IF(ABS(NVEC(IAXIS))>TWENTY_EPSILON_EB .OR. ABS(NVEC(JAXIS))>TWENTY_EPSILON_EB) PVEC(IAXIS:KAXIS)=(/NVEC(JAXIS),-NVEC(IAXIS),0._EB/) -IF(ABS(NVEC(IAXIS))0) THEN - WRITE(MESSAGE,'(A,I3,A,I3,A,I3,A,I3,A)') 'ERROR(722): Segments (',POLY(I-N_POLY_VERTS),'-',POLY(IP1-N_POLY_VERTS),& - ') and (',POLY(J-N_POLY_VERTS),'-',POLY(JP1-N_POLY_VERTS),') intersect in average POLY plane.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF + ! S coordinate along segment: + DX3_1 = X3_2 - X3RAY + DX3_2 = X3RAY- X3_1 + XI1 = DX3_1 / (X3_2-X3_1) + XI2 = DX3_2 / (X3_2-X3_1) + DV(IAXIS:JAXIS) = (/ (XI1-1._EB)*X2_1+XI2*X2_2 , DX3_2 /) + SBOD = DV(IAXIS)*STANI(IAXIS)+DV(JAXIS)*STANI(JAXIS) + ! ELSE + ! ! Segment length: + ! X2_21Q = (REAL(X2_2,QB)-REAL(X2_1,QB)) + ! X3_21Q = (REAL(X3_2,QB)-REAL(X3_1,QB)) + ! SLENQ = SQRT( X2_21Q**2._QB + X3_21Q**2._QB ) + ! + ! ! Unit vector along segment: + ! STANIQ(IAXIS:JAXIS) = 1._QB/SLENQ * (/ X2_21Q, X3_21Q /) + ! + ! ! S coordinate along segment: + ! DX3_1Q = REAL(X3_2,QB) - REAL(X3RAY,QB) + ! DX3_2Q = REAL(X3RAY,QB)- REAL(X3_1,QB) + ! XI1Q = DX3_1Q / X3_21Q + ! XI2Q = DX3_2Q / X3_21Q + ! DVQ(IAXIS:JAXIS) = (/ (XI1Q-1._QB)*REAL(X2_1,QB)+XI2Q*REAL(X2_2,QB) , DX3_2Q /) + ! SBOD = REAL(DVQ(IAXIS)*STANIQ(IAXIS)+DVQ(JAXIS)*STANIQ(JAXIS),EB) + ! ENDIF + + ! If crossing is already defined, cycle: + DO IBCR=1,BODINT_PLANE%NBCROSS(ISEG) + IF ( ABS(SBOD-BODINT_PLANE%SVAR(IBCR,ISEG)) < GEOMEPS ) EXIT ENDDO -ENDDO + IF (IBCR NBCROSS_SVAR) THEN + ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB + SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) + CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) + ENDIF + BODINT_PLANE%SVAR(NBCROSS,ISEG) = 1._EB/GEOMEPS + DO IBCR=1,NBCROSS + IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEG) ) EXIT + ENDDO -IS_CONVEX=.TRUE. -ALLOCATE(NODE_FLG(1:N_POLY_VERTS+1)); NODE_FLG=1 -DO I=1,N_POLY_VERTS - IM1 = I - 1 - IF (I==1) IM1=N_POLY_VERTS - IP1 = I + 1 - IF (I==N_POLY_VERTS) IP1=1 - DV1(IAXIS:KAXIS) = PVERTS(3*I-2:3*I ) - PVERTS(3*IM1-2:3*IM1 ); DV1=DV1/NORM2(DV1) - DV2(IAXIS:KAXIS) = PVERTS(3*IP1-2:3*IP1) - PVERTS(3*I-2:3*I ); DV2=DV2/NORM2(DV2) - CALL CROSS_PRODUCT(N,DV1,DV2) - SINANG = NORM2(N) - IF ( DOT_PRODUCT(NVEC,N) < -GEOMEPS ) IS_CONVEX=.FALSE. - IF ( SINANG < GEOMEPS ) NODE_FLG(I)= 0 ! Vertex located in line joining neighbors. -ENDDO + ! Here copy from the back (updated nbcross) to the ibcr location: + DO IDUM = NBCROSS,IBCR+1,-1 + BODINT_PLANE%SVAR(IDUM,ISEG) = BODINT_PLANE%SVAR(IDUM-1,ISEG) + ENDDO + BODINT_PLANE%SVAR(IBCR,ISEG) = SBOD + BODINT_PLANE%NBCROSS(ISEG) = NBCROSS -NVERTS2 = SUM(NODE_FLG(1:N_POLY_VERTS)); -IF (NVERTS2 < 3) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR(723): For extruded Polygon GEOM ',TRIM(ID),' : Not enough valid vertices on the polygon.' - CALL SHUTDOWN(MESSAGE); RETURN -ENDIF -ALLOCATE(PVERTS2(1:2*MAX_DIM*N_POLY_VERTS)); PVERTS2=0._EB -ALLOCATE(VERT_LIST(NVERTS2+1)); VERT_LIST=0 -ALLOCATE(NODE_EXISTS(NVERTS2+1)); NODE_EXISTS=.TRUE. -COUNT = 0 -DO I=1,N_POLY_VERTS - IF (NODE_FLG(I)==0) CYCLE - COUNT= COUNT + 1 - PVERTS2(3*COUNT-2:3*COUNT) = PVERTS(3*I-2:3*I) - VERT_LIST(COUNT) = COUNT ENDDO -PVERTS(1:3*NVERTS2) = PVERTS2(1:3*NVERTS2) -VERT_LIST(NVERTS2+1) = VERT_LIST(1) -DEALLOCATE(PVERTS2) +T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW +RETURN +END SUBROUTINE GET_BODX2_INTERSECTIONS -! Now do the Ear clip: -N_FACES = 0 -START_FACE_LO = N_FACES -IS_CONVEX_IF : IF (IS_CONVEX) THEN ! Convex POLY. - VERT_START = VERT_LIST(1) - DO I = 1,NVERTS2 - IP1 = I+1; IF (I==NVERTS2) IP1=1 - IF (I==VERT_START .OR. IP1==VERT_START) CYCLE - N_FACES = N_FACES + 1 - FACES(3*N_FACES-2) = VERT_LIST(VERT_START) - FACES(3*N_FACES-1) = VERT_LIST(I) - FACES(3*N_FACES ) = VERT_LIST(IP1) - ENDDO -ELSE IS_CONVEX_IF ! Simple polygon, ear clipping. - NLIST = NVERTS2 - COUNT_OUT = 0 - OUTER_LOOP : DO WHILE(NLIST>=3) ! OUTER LOOP - COUNT_OUT = COUNT_OUT + 1 - IF (COUNT_OUT > NVERTS2**4) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR(724): For extruded Polygon GEOM ',TRIM(ID),' : Could not triangulate polygon.' - CALL SHUTDOWN(MESSAGE); RETURN - ENDIF - IVERT = 1 - INNER_LOOP : DO WHILE(IVERT<=NLIST) ! INNER LOOP - IVM1 = IVERT-1; IV=IVERT; IVP1=IVERT+1 - IF (IVERT==1) IVM1=NLIST - V0 = VERT_LIST(IVM1); V1 = VERT_LIST(IV ); V2 = VERT_LIST(IVP1); - IF (.NOT.NODE_EXISTS(IVP1)) EXIT INNER_LOOP - DV1(IAXIS:KAXIS) = PVERTS(3*V1-2:3*V1)-PVERTS(3*V0-2:3*V0) - IF (NORM2(DV1)GEOMEPS - IF (NOPT_INTRI) THEN - DO I=1,NVERTS2 - IF(ANY( (/V0,V1,V2/) == I)) CYCLE - IF (POINT_IN_TRIANGLE(PVERTS(3*I-2:3*I), PVERTS(3*V0-2:3*V0), PVERTS(3*V1-2:3*V1), PVERTS(3*V2-2:3*V2))) THEN - NOPT_INTRI=.FALSE. - EXIT - ENDIF - ENDDO - ENDIF - IF ( NLIST==3 .OR. NOPT_INTRI ) THEN - N_FACES = N_FACES + 1 - FACES(3*N_FACES-2) = V0 - FACES(3*N_FACES-1) = V1 - FACES(3*N_FACES ) = V2 - IF (NLIST == 3) EXIT OUTER_LOOP - NODE_EXISTS(IVERT) =.FALSE. - IF (IVERT==1) NODE_EXISTS(NLIST+1)=.FALSE. - IVERT = IVERT + 2 - ELSE - IVERT = IVERT + 1 +! ----------------------- GET_BODX3_INTERSECTIONS ------------------------------- + +SUBROUTINE GET_BODX3_INTERSECTIONS(X2AXIS,X3AXIS,X2LO,X2HI) + +INTEGER, INTENT(IN) :: X2AXIS,X3AXIS,X2LO,X2HI + +! Local Variables: +REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN, SBOD +REAL(EB) :: STANI(IAXIS:JAXIS), DV(IAXIS:JAXIS), MINX, MAXX, XI1, XI2, DX2_1, DX2_2 +INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IBCR, IDUM, JSTR, JEND, JJ, NBCROSS_SVAR +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: SVAR_AUX +LOGICAL :: ISCONT +REAL(EB) :: TNOW + +! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX2_1Q,DX2_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) + +TNOW=CURRENT_TIME() + +DO ISEG=1,BODINT_PLANE%NSEGS + + IF (BODINT_PLANE%X3ALIGNED(ISEG)) CYCLE ! This segment is not aligned with x3. + + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) + + ! x2_x3 of segment point 1: + X2_1 = XYZ1(X2AXIS); X3_1 = XYZ1(X3AXIS) + ! x2_x3 of segment point 2: + X2_2 = XYZ2(X2AXIS); X3_2 = XYZ2(X3AXIS) + + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + ! Segment length: + SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) + ! Unit vector along segment: + STANI(IAXIS:JAXIS) = (/ (X2_2-X2_1), (X3_2-X3_1) /)*SLEN**(-1._EB) + ! ELSE + ! ! Segment length: + ! X2_21Q = (REAL(X2_2,QB)-REAL(X2_1,QB)) + ! X3_21Q = (REAL(X3_2,QB)-REAL(X3_1,QB)) + ! SLENQ = SQRT( X2_21Q**2._QB + X3_21Q**2._QB ) + ! ! Unit vector along segment: + ! STANIQ(IAXIS:JAXIS) = 1._QB/SLENQ * (/ X2_21Q, X3_21Q /) + ! ENDIF + + MINX = MIN(X2_1,X2_2) + MAXX = MAX(X2_1,X2_2) + IF(X2NOC==0) THEN + ! Optimized for UG: + JSTR = MAX(X2LO, CEILING(( MINX-GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO))+X2LO) + JEND = MIN(X2HI, FLOOR(( MAXX+GEOMEPS-X2FACE(X2LO))/DX2FACE(X2LO))+X2LO) + ELSE + IF ((MINX-GEOMEPS-X2FACE(X2LO)) < 0._EB) THEN + JSTR=X2LO + ELSEIF((MINX-GEOMEPS-X2FACE(X2HI)) >= 0._EB) THEN + JSTR=X2HI+1 + ELSE + DO JJ=X2LO,X2HI + IF((MINX-GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. (MINX-GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN + JSTR = JJ+1 + EXIT ENDIF - ENDDO INNER_LOOP - NLIST_OLD = NLIST - NLIST = 0 - DO I = 1,NLIST_OLD - IF (NODE_EXISTS(I)) THEN - NLIST = NLIST + 1 - VERT_LIST(NLIST) = VERT_LIST(I) - ENDIF ENDDO - VERT_LIST(NLIST+1) = VERT_LIST(1) - NODE_EXISTS(1:NLIST+1) =.TRUE. - - ! Test for nodes connecting parallel edges, if found drop them: - VERT_DROPPED=.FALSE. - DO I=1,NLIST - IVM1 = I-1; IV=I; IVP1=I+1; IF (I==1) IVM1=NLIST - V0 = VERT_LIST(IVM1); V1 = VERT_LIST(IV ); V2 = VERT_LIST(IVP1) - DV1(IAXIS:KAXIS) = PVERTS(3*V1-2:3*V1)-PVERTS(3*V0-2:3*V0) - IF (NORM2(DV1)= 0._EB) THEN + JEND=X2HI + ELSE + DO JJ=X2LO,X2HI + IF((MAXX+GEOMEPS-X2FACE(JJ)) >= 0._EB .AND. (MAXX+GEOMEPS-X2FACE(JJ+1)) < 0._EB ) THEN + JEND = JJ + EXIT ENDIF ENDDO - IF (VERT_DROPPED) THEN ! Repeat List generation: - NLIST_OLD = NLIST; NLIST = 0 - DO I = 1,NLIST_OLD - IF (NODE_EXISTS(I)) THEN - NLIST = NLIST + 1 - VERT_LIST(NLIST) = VERT_LIST(I) - ENDIF - ENDDO - VERT_LIST(NLIST+1) = VERT_LIST(1) - NODE_EXISTS(1:NLIST+1)=.TRUE. - ENDIF - ENDDO OUTER_LOOP -ENDIF IS_CONVEX_IF + ENDIF + ENDIF + + DO JJ=JSTR,JEND + + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + ! S coordinate along segment: + DX2_1 = X2_2 - X2FACE(JJ) + DX2_2 = X2FACE(JJ) - X2_1 + XI1 = DX2_1 / (X2_2-X2_1) + XI2 = DX2_2 / (X2_2-X2_1) + DV(IAXIS:JAXIS) = (/ DX2_2, (XI1-1._EB)*X3_1+XI2*X3_2 /) + SBOD = DV(IAXIS)*STANI(IAXIS)+DV(JAXIS)*STANI(JAXIS) + ! ELSE + ! ! S coordinate along segment: + ! DX2_1Q = REAL(X2_2,QB) - REAL(X2FACE(JJ),QB) + ! DX2_2Q = REAL(X2FACE(JJ),QB)- REAL(X2_1,QB) + ! XI1Q = DX2_1Q / X2_21Q + ! XI2Q = DX2_2Q / X2_21Q + ! DVQ(IAXIS:JAXIS) = (/ DX2_2Q, (XI1Q-1._QB)*REAL(X3_1,QB)+XI2Q*REAL(X3_2,QB) /) + ! SBOD = REAL(DVQ(IAXIS)*STANIQ(IAXIS)+DVQ(JAXIS)*STANIQ(JAXIS),EB) + ! ENDIF + + + ! If crossing is already defined, cycle: + NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + ISCONT = .FALSE. + DO IBCR=1,NBCROSS + IF ( ABS(SBOD-BODINT_PLANE%SVAR(IBCR,ISEG)) < GEOMEPS ) THEN + ISCONT = .TRUE. + EXIT + ENDIF + ENDDO + IF (ISCONT) CYCLE -! Add top faces and Revert lo faces normal: -START_FACE_HI = N_FACES -DO IFACE=1,N_FACES - FACES(3*(START_FACE_HI+IFACE)-2:3*(START_FACE_HI+IFACE)) = FACES(3*IFACE-2:3*IFACE) + NVERTS2 - IDUM=FACES(3*IFACE-1); FACES(3*IFACE-1)=FACES(3*IFACE); FACES(3*IFACE)=IDUM -ENDDO -N_FACES = 2*N_FACES + ! Add crossing to BODINT_PLANE, insertion sort: + NBCROSS = BODINT_PLANE%NBCROSS(ISEG) + 1 + ! Test-reallocate BODINT_PLANE%SVAR + NBCROSS_SVAR = SIZE(BODINT_PLANE%SVAR,DIM=1) + IF (NBCROSS > NBCROSS_SVAR) THEN + ALLOCATE(SVAR_AUX(NBCROSS_SVAR+CC_DELTA_NBCROSS,BODINT_PLANE%NSEGS)); SVAR_AUX = -1._EB + SVAR_AUX(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) = BODINT_PLANE%SVAR(1:NBCROSS-1,1:BODINT_PLANE%NSEGS) + CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_PLANE%SVAR) + ENDIF + BODINT_PLANE%SVAR(NBCROSS,ISEG) = 1._EB/GEOMEPS + DO IBCR=1,NBCROSS + IF ( SBOD < BODINT_PLANE%SVAR(IBCR,ISEG) ) EXIT + ENDDO -! Now replicate Vertices at a distance EXTRUDE in the normal direction. -N_VERTS = 2*NVERTS2 -VERTS(1:3*NVERTS2) = PVERTS(1:3*NVERTS2) -DO I=1,NVERTS2 - VERTS(3*(I+NVERTS2)-2:3*(I+NVERTS2)) = PVERTS(3*I-2:3*I) + EXTRUDE*NVEC(IAXIS:KAXIS) -ENDDO + ! Here copy from the back (updated nbcross) to the ibcr location: + DO IDUM = NBCROSS,IBCR+1,-1 + BODINT_PLANE%SVAR(IDUM,ISEG) = BODINT_PLANE%SVAR(IDUM-1,ISEG) + ENDDO + BODINT_PLANE%SVAR(IBCR,ISEG) = SBOD + BODINT_PLANE%NBCROSS(ISEG) = NBCROSS + + ENDDO -! Add side faces: -START_FACE_MID=N_FACES -DO IVERT=1,NVERTS2 - I1 = IVERT; I2 = IVERT+1; I3 = IVERT+NVERTS2; I4 = IVERT+NVERTS2+1 - IF (IVERT==NVERTS2) THEN - I2 = 1; I4 = 1+NVERTS2 - ENDIF - N_FACES = N_FACES + 1 - FACES(3*N_FACES-2:3*N_FACES) = (/ I1, I2, I4 /) - N_FACES = N_FACES + 1 - FACES(3*N_FACES-2:3*N_FACES) = (/ I1, I4, I3 /) ENDDO -! Revert Faces order if EXTRUDE -ve: -IF (EXTRUDE < 0) THEN - DO IFACE=1,N_FACES - IDUM=FACES(3*IFACE-1); FACES(3*IFACE-1)=FACES(3*IFACE); FACES(3*IFACE)=IDUM - ENDDO -ENDIF +T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW -DEALLOCATE(PVERTS,NODE_FLG,VERT_LIST,NODE_EXISTS) +RETURN +END SUBROUTINE GET_BODX3_INTERSECTIONS -IERR = 0 +! ----------------------- GET_CARTFACE_CUTEDGES --------------------------------- -RETURN +SUBROUTINE GET_CARTFACE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS, & + XIAXIS,XJAXIS,XKAXIS,NM , & + X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL, & + X3LO_CELL,X3HI_CELL,INDX1,X1PLN) -END SUBROUTINE DEFINE_EXTRUDED_POLY +INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS,NM, & + X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL, & + X3LO_CELL,X3HI_CELL,INDX1(MAX_DIM) +REAL(EB), INTENT(IN) :: X1PLN +! Local Variables: +REAL(EB) :: XYZ1(MAX_DIM), XYZ2(MAX_DIM), X2_1, X2_2, X3_1, X3_2, SLEN +REAL(EB) :: STANI(IAXIS:JAXIS), SNORI(IAXIS:JAXIS), X2RAY, X3RAY +INTEGER :: ISEG, SEG(NOD1:NOD2), NBCROSS, IEDGE, JJ, KK, JJ2, KK2, IPFACE, NPFACE, INOD1, INOD2 +LOGICAL :: ADD2FACES, INRAY, CONDAX +INTEGER :: INDSEG(1:CC_MAX_WSTRIANG_SEG+2), NTRISEG, CETYPE, JJ2VEC(LOW_IND:HIGH_IND), KK2VEC(LOW_IND:HIGH_IND) +REAL(EB) :: SVAR1, SVAR2, SVAR12, XPOS, XY(IAXIS:JAXIS) +INTEGER :: INDXI(IAXIS:KAXIS), INDIF, INDJF, INDKF, CEI, NVERT, NEDGE, DIRAXIS, IDG +REAL(EB) :: XYZV1(IAXIS:KAXIS), XYZV1LC(IAXIS:KAXIS) +REAL(EB) :: XYZV2(IAXIS:KAXIS), XYZV2LC(IAXIS:KAXIS) +REAL(EB) :: TNOW +INTEGER :: INIT_CUT_EDGES,IVERT,IADD,JADD,KADD +LOGICAL :: FOUND_SEG, IS_SOLID +TNOW=CURRENT_TIME() -SUBROUTINE DEFINE_CYLINDER(VERTS,MAXVERTS,NVERTS,FACES,MAXFACES,NFACES,VOLS,MAXVOLS,NVOLS,CYL_FIND) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +INIT_CUT_EDGES = MESHES(NM)%N_CUTEDGE_MESH+1 -INTEGER, INTENT(IN) :: MAXVERTS,MAXFACES,MAXVOLS -INTEGER, INTENT(OUT) :: NFACES, NVERTS -REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) -INTEGER, INTENT(OUT) :: FACES(4*MAXFACES) -INTEGER, INTENT(OUT) :: NVOLS -INTEGER, INTENT(OUT) :: VOLS(4*MAXVOLS) -INTEGER, INTENT(OUT) :: CYL_FIND(LOW_IND:HIGH_IND,1:3) +! Segment by segment define the INBOUNDARY MESHES(NM)%CUT_EDGEs between crossings +! and individualize the Cartesian face they belong to. +! NCUTEDGEOLD = MESHES(NM)%N_CUTEDGE_MESH + 1 +SEGS_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS -! Local Variables: -REAL(EB), PARAMETER :: EX(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) -REAL(EB) :: E1(IAXIS:KAXIS), E2(IAXIS:KAXIS), E3(IAXIS:KAXIS), TGL(3,3), V(IAXIS:KAXIS,1), R(IAXIS:KAXIS,1) -INTEGER :: NP_L,NP_T,IVERT,IFACE,ILE,ITH,IFC -REAL(EB):: DELTA_L,DELTA_T,THETA,POS_1,POS_2,POS_3, LEN + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) + IF (MAX(XYZ1(X2AXIS),XYZ2(X2AXIS)) < X2FACE(X2LO)-GEOMEPS) CYCLE + IF (MIN(XYZ1(X2AXIS),XYZ2(X2AXIS)) > X2FACE(X2HI)+GEOMEPS) CYCLE + IF (MAX(XYZ1(X3AXIS),XYZ2(X3AXIS)) < X3FACE(X3LO)-GEOMEPS) CYCLE + IF (MIN(XYZ1(X3AXIS),XYZ2(X3AXIS)) > X3FACE(X3HI)+GEOMEPS) CYCLE + NBCROSS = BODINT_PLANE%NBCROSS(ISEG) ! Cross points include Node1, Node2 -! Check if CYLINDER axis is any of IAXIS, JAXIS, KAXIS: -IF (ABS(CYLINDER_AXIS(JAXIS)) 0._EB ) THEN ! add 1 to index kk (i.e. lower face index) + KK2VEC(LOW_IND) = KK + 1 + ELSE + KK2VEC(LOW_IND)= KK + ENDIF + ENDIF + + DO IPFACE=1,NPFACE + + KK2 = KK2VEC(IPFACE) + + ! Figure out which cut faces the inboundary cut-edges of + ! this segment belong to: + ! We have nbcross-1 INBOUNDARY CUT_EDGEs to generate. + DO IEDGE=1,NBCROSS-1 + + ! Location along Segment: + SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) + SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) + ! Location of midpoint of cut-edge: + SVAR12 = 0.5_EB * (SVAR1+SVAR2) + ! Define Cartesian segment this cut-edge belongs: + XPOS = X2_1 + SVAR12*STANI(IAXIS) + IF (X2NOC==0) THEN + JJ2 = FLOOR((XPOS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + ! Discard cut-edges on faces laying on x2hi. + IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO JJ2=X2LO_CELL,X2HI_CELL + ! Check if XPOS is within this segment JJ2: + IF((XPOS-X2FACE(JJ2-1)) >= 0._EB .AND. (X2FACE(JJ2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF + + IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE + + ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. + ! If segment is inside the solid region mark cells surrounding face + ! to be treated in special manner (only if they happen to be type CUTCFE), + ! then drop segment. + XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) + CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) + IF (IS_SOLID) CYCLE + + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 + INDIF=INDXI(XIAXIS) + INDJF=INDXI(XJAXIS) + INDKF=INDXI(XKAXIS) + + ! Now the face is, FCVAR (x1axis): + IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already + ! an entry in CUT_EDGE. + CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) + ELSE ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF + ENDIF + + ! Add vertices, non repeated vertex entries at this point. + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT + ! Define vertices for this segment: + ! xv1 yv1 zv1 + XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) + XYZV1(IAXIS) = XYZV1LC(XIAXIS) + XYZV1(JAXIS) = XYZV1LC(XJAXIS) + XYZV1(KAXIS) = XYZV1LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) + ! xv2 yv2 zv2 + XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) + XYZV2(IAXIS) = XYZV2LC(XIAXIS) + XYZV2(JAXIS) = XYZV2LC(XJAXIS) + XYZV2(KAXIS) = XYZV2LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) - ! E2 in direction normal to plane EX x E1: - CALL CROSS_PRODUCT(E2,EX,E1) - LEN = SQRT(E2(IAXIS)**2._EB + E2(JAXIS)**2._EB + E2(KAXIS)**2._EB) - E2(IAXIS:KAXIS) = 1/LEN * E2(IAXIS:KAXIS) + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) + IF ( NPFACE == 1 ) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ELSE + DIRAXIS = X2AXIS + CONDAX = (XYZV2(DIRAXIS)-XYZV1(DIRAXIS)) > 0 + IF ( KK2 == KK ) THEN + IF (CONDAX) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ELSE + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) + ENDIF + ELSE + IF (CONDAX) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) + ELSE + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ENDIF + ENDIF + ENDIF + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & + BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = 0 !Edges in face boundary counted once. + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE - ! E3 in direction of E1 x E2 - CALL CROSS_PRODUCT(E3,E1,E2) -ENDIF + ! Test for Repeated edge -> If so note FACERT: + DO IDG=1,NEDGE + IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & + ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN + FACERT(JJ2,KK2) =.TRUE. + EXIT + ENDIF + ENDDO -! Define transformation matrix from local to global axes: -TGL(IAXIS:KAXIS,IAXIS) = E1(IAXIS:KAXIS) -TGL(IAXIS:KAXIS,JAXIS) = E2(IAXIS:KAXIS) -TGL(IAXIS:KAXIS,KAXIS) = E3(IAXIS:KAXIS) + ENDDO + ENDDO + CYCLE ! Skips rest of iseg loop, for this ISEG. + ENDIF -! Now define cylinder in local axes E1,E2,E3, using CYLINDER_RADIUS and CYLINDER_LENGTH, centered at zero origin: -! Define vertices: -NP_L = CYLINDER_NSEG_AXIS + 1 -NP_T = CYLINDER_NSEG_THETA -DELTA_L = CYLINDER_LENGTH / REAL(CYLINDER_NSEG_AXIS,EB) -DELTA_T = 2._EB*PI / REAL(CYLINDER_NSEG_THETA,EB) -IVERT= 0 + ! Second check if segment geomepsilon aligned with x3: + ELSEIF (BODINT_PLANE%X3ALIGNED(ISEG)) THEN -! Low plane center vertex: -POS_1 = -CYLINDER_LENGTH/2._EB -POS_2 = 0._EB; POS_3 = 0._EB; -IVERT = IVERT + 1 -VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) + ! Test if node1 of segment is in geomepsilon vicinity of an x3 ray + DO JJ=X2LO,X2HI + ! x2 location of ray along x3, on the x2-x3 plane: + X2RAY = X2FACE(JJ) + IF ( ABS(X2RAY-X2_1) < GEOMEPS ) THEN + INRAY = .TRUE. + EXIT + ENDIF + ENDDO -VERTEX_LOOP : DO ILE=1,NP_L - POS_1 = -CYLINDER_LENGTH/2._EB + REAL(ILE-1,EB)*DELTA_L - DO ITH=1,NP_T + IF (INRAY) THEN ! Segment in x3 ray defined by x2 face index JJ - THETA = REAL(ITH-1,EB)*DELTA_T - POS_2 = CYLINDER_RADIUS*COS(THETA) - POS_3 = CYLINDER_RADIUS*SIN(THETA) + ! 1. INB cut-edges on top of an x3 gridline, assign to cut-face + ! defined by normal out. + JJ2VEC(LOW_IND:HIGH_IND) = 0 + IF (ADD2FACES) THEN + NPFACE = 2 + JJ2VEC(LOW_IND) = JJ + 1 + JJ2VEC(HIGH_IND) = JJ + ELSE + NPFACE = 1 + IF ( SNORI(IAXIS) > 0._EB ) THEN ! add 1 to index jj (i.e. lower face index) + JJ2VEC(LOW_IND) = JJ + 1 + ELSE + JJ2VEC(LOW_IND) = JJ + ENDIF + ENDIF - IVERT = IVERT + 1 - VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) + DO IPFACE=1,NPFACE - ENDDO -ENDDO VERTEX_LOOP + JJ2 = JJ2VEC(IPFACE) -! High plane center vertex: -POS_1 = CYLINDER_LENGTH/2._EB -POS_2 = 0._EB; POS_3 = 0._EB; -IVERT = IVERT + 1 -VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) + ! Figure out which cut faces the inboundary cut-edges of + ! this segment belong to: + ! We have NBCROSS-1 INBOUNDARY CUT_EDGEs to generate. + DO IEDGE=1,NBCROSS-1 -NVERTS = IVERT + ! Location along Segment: + SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) + SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) + ! Location of midpoint of cut-edge: + SVAR12 = 0.5_EB * (SVAR1+SVAR2) -! Define faces: -! Low axis plane: -IFACE=0 -IVERT=1 -CYL_FIND(LOW_IND,3) = IFACE + 1 -DO IFC=1,NP_T - IF (IFC < NP_T) THEN - I1 = 1 + IFC + 1 - I2 = 1 + IFC - I3 = IVERT - ELSE - I1 = IVERT + 1 - I2 = IFC + 1 - I3 = IVERT - ENDIF - IFACE=IFACE+1 - FACES(3*IFACE-2:3*IFACE) = (/I1, I2, I3 /) -ENDDO -CYL_FIND(HIGH_IND,3) = IFACE + ! Define Cartesian segment this cut-edge belongs: + XPOS = X3_1 + SVAR12*STANI(JAXIS) + IF (X3NOC==0) THEN + KK2 = FLOOR((XPOS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + ! Discard cut-edges on faces laying on x3hi. + IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO KK2=X3LO_CELL,X3HI_CELL + ! Check if XPOS is within this segment KK2: + IF((XPOS-X3FACE(KK2-1)) >= 0._EB .AND. (X3FACE(KK2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF -! Cylinder side faces: -CYL_FIND(LOW_IND,2) = IFACE + 1 -FACE_LOOP : DO ILE=2,NP_L - DO IFC=1,NP_T + IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE - ! Locate first vertex index: - IF (IFC < NP_T) THEN - I1 = (ILE-1)*NP_T + 1 + IFC - I2 = (ILE-1)*NP_T + 1 + IFC + 1 - I3 = (ILE-2)*NP_T + 1 + IFC - I4 = (ILE-2)*NP_T + 1 + IFC + 1 - ELSE - I1 = (ILE-1)*NP_T + 1 + IFC - I2 = (ILE-1)*NP_T + 1 + 1 - I3 = (ILE-2)*NP_T + 1 + IFC - I4 = (ILE-2)*NP_T + 1 + 1 - ENDIF + ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. + ! If segment is inside the solid region mark cells surrounding face + ! to be treated in special manner (only if they happen to be type CUTCFE), + ! then drop segment. + XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) + CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) + IF (IS_SOLID) CYCLE - IFACE=IFACE+1 - FACES(3*IFACE-2:3*IFACE) = (/I1, I3, I2/) - IFACE=IFACE+1 - FACES(3*IFACE-2:3*IFACE) = (/I3, I4, I2/) + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 + INDIF=INDXI(XIAXIS) + INDJF=INDXI(XJAXIS) + INDKF=INDXI(XKAXIS) - ENDDO -ENDDO FACE_LOOP -CYL_FIND(HIGH_IND,2) = IFACE + ! Now the face is, FCVAR (x1axis): + IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already + ! an entry in CUT_EDGE. + CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) + ELSE ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF + ENDIF -! High axis plane: -IVERT=NVERTS -CYL_FIND(LOW_IND,1) = IFACE + 1 -DO IFC=1,NP_T - IF (IFC < NP_T) THEN - I1 = (NP_L-1)*NP_T + 1 + IFC - I2 = (NP_L-1)*NP_T + 1 + IFC + 1 - I3 = IVERT - ELSE - I1 = (NP_L-1)*NP_T + 1 + IFC - I2 = (NP_L-1)*NP_T + 1 + 1 - I3 = IVERT - ENDIF - IFACE=IFACE+1 - FACES(3*IFACE-2:3*IFACE) = (/I1, I2, I3 /) -ENDDO -CYL_FIND(HIGH_IND,1) = IFACE -NFACES = IFACE + ! Add vertices, non repeated vertex entries at this point. + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT + ! Define vertices for this segment: + ! xv1 yv1 zv1 + XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) + XYZV1(IAXIS) = XYZV1LC(XIAXIS) + XYZV1(JAXIS) = XYZV1LC(XJAXIS) + XYZV1(KAXIS) = XYZV1LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) + ! xv2 yv2 zv2 + XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) + XYZV2(IAXIS) = XYZV2LC(XIAXIS) + XYZV2(JAXIS) = XYZV2LC(XJAXIS) + XYZV2(KAXIS) = XYZV2LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) -! Transform vertices to global axes: -DO IVERT=1,NVERTS - V(IAXIS:KAXIS,1) = VERTS(3*IVERT-2:3*IVERT) - R = MATMUL(TGL,V) - VERTS(3*IVERT-2:3*IVERT) = R(IAXIS:KAXIS,1) + CYLINDER_ORIGIN(IAXIS:KAXIS) -ENDDO + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) + IF ( NPFACE == 1 ) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ELSE + DIRAXIS = X3AXIS + CONDAX = (XYZV2(DIRAXIS)-XYZV1(DIRAXIS)) > 0 + IF ( JJ2 == JJ ) THEN + IF (CONDAX) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) + ELSE + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ENDIF + ELSE + IF (CONDAX) THEN + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + ELSE + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD2, INOD1 /) + ENDIF + ENDIF + ENDIF + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & + BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = 0 !Edges in face boundary counted once. + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE -! No volumes being defined. -NVOLS = 0 -VOLS = 0 + ! Test for Repeated edge -> If so note FACERT + DO IDG=1,NEDGE + IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & + ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN + FACERT(JJ2,KK2) =.TRUE. + EXIT + ENDIF + ENDDO -! WRITE(LU_ERR,*) 'Vertices:' -! DO IVERT=1,NVERTS -! WRITE(LU_ERR,*) VERTS(3*IVERT-2:3*IVERT) -! ENDDO -! WRITE(LU_ERR,*) ' ' -! WRITE(LU_ERR,*) 'Faces:' -! DO IFACE=1,NFACES -! WRITE(LU_ERR,*) FACES(3*IFACE-2:3*IFACE) -! ENDDO + ENDDO + ENDDO + CYCLE ! Skips rest of iseg loop, for this ISEG. + ENDIF -RETURN -END SUBROUTINE DEFINE_CYLINDER + ENDIF -! ---------------------------- GET_GEOM_INFO ---------------------------------------- + ! 3. Regular case: INB cut-edge with centroid inside a + ! Cartesian face, assign to corresponding FCVAR CC_IDCE variable. + ! This is the most common case, INBOUNDARY edges defined inside x1 faces. + ! We have NBCROSS-1 INBOUNDARY CUT_EDGEs to generate. + DO IEDGE=1,NBCROSS-1 -SUBROUTINE GET_GEOM_INFO(MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS) ! LU_INPUT not used for now. + ! Location along Segment: + SVAR1 = BODINT_PLANE%SVAR(IEDGE ,ISEG) + SVAR2 = BODINT_PLANE%SVAR(IEDGE+1,ISEG) + ! Location of midpoint of cut-edge: + SVAR12 = 0.5_EB * (SVAR1+SVAR2) -! Count number of various geometry types on the current &GEOM line -! Assume a maximum number of faces and ZVALS, which can be modified in the &MISC line. + ! Define Cartesian face this cut-edge belongs: + XPOS = X2_1 + SVAR12*STANI(IAXIS) + IF (X2NOC==0) THEN + JJ2 = FLOOR((XPOS-X2FACE(X2LO))/DX2FACE(X2LO)) + X2LO_CELL + IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO JJ2=X2LO_CELL,X2HI_CELL + ! Check if XPOS is within this segment JJ2: + IF((XPOS-X2FACE(JJ2-1)) >= 0._EB .AND. (X2FACE(JJ2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF + XPOS = X3_1 + SVAR12*STANI(JAXIS) + IF(X3NOC==0) THEN + KK2 = FLOOR((XPOS-X3FACE(X3LO))/DX3FACE(X3LO)) + X3LO_CELL + IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO KK2=X3LO_CELL,X3HI_CELL + ! Check if XPOS is within this segment KK2: + IF((XPOS-X3FACE(KK2-1)) >= 0._EB .AND. (X3FACE(KK2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF -INTEGER, INTENT(INOUT) :: MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS + ! HERE IF NEEDED TEST IF SEG IS INSIDE OR OUTSIDE. + ! If segment is inside the solid region mark cells surrounding face + ! to be treated in special manner (only if they happen to be type CUTCFE), + ! then drop segment. + XY(IAXIS:JAXIS) = (/ X2_1, X3_1 /) + SVAR12*STANI(IAXIS:JAXIS) + CALL GET_IS_SOLID_PT(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,XY,SNORI,X1PLN,IS_SOLID) + IF (IS_SOLID) CYCLE -MAX_ZVALS = MAX(MAX_ZVALS, MAXIMUM_GEOMETRY_ZVALS) -MAX_VOLUS = MAX(MAX_VOLUS,6*MAX_ZVALS, MAXIMUM_GEOMETRY_VOLUS) -MAX_FACES = MAX(MAX_FACES,4*MAX_VOLUS, MAXIMUM_GEOMETRY_FACES) -MAX_VERTS = MAX(MAX_VERTS,4*MAX_VOLUS,3*MAX_FACES, MAXIMUM_GEOMETRY_VERTS) -MAX_IDS = MAX(MAX_IDS, MAXIMUM_GEOMETRY_IDS) -MAX_SURF_IDS = MAX(MAX_SURF_IDS, MAXIMUM_GEOMETRY_SURFIDS) -MAX_POLY_VERTS= MAX(MAX_POLY_VERTS, MAXIMUM_POLY_VERTS) + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 + INDIF=INDXI(XIAXIS) + INDJF=INDXI(XJAXIS) + INDKF=INDXI(XKAXIS) -END SUBROUTINE GET_GEOM_INFO + ! Now the face is, FCVAR (x1axis): + IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) > 0) THEN ! There is already + ! an entry in CUT_EDGE. + CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) + ELSE ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS)= CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ INDIF, INDJF, INDKF, X1AXIS, CETYPE /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF + ENDIF -! ---------------------------- ALLOCATE_BUFFERS ---------------------------------------- + ! Add vertices, non repeated vertex entries at this point. + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT -SUBROUTINE ALLOCATE_BUFFERS + ! Define vertices for this segment: + ! xv1 yv1 zv1 + XYZV1LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR1, X3_1+STANI(JAXIS)*SVAR1 /) + XYZV1(IAXIS) = XYZV1LC(XIAXIS) + XYZV1(JAXIS) = XYZV1LC(XJAXIS) + XYZV1(KAXIS) = XYZV1LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) + ! xv2 yv2 zv2 + XYZV2LC(IAXIS:KAXIS)= (/ X1FACE(INDX1(X1AXIS)), X2_1+STANI(IAXIS)*SVAR2, X3_1+STANI(JAXIS)*SVAR2 /) + XYZV2(IAXIS) = XYZV2LC(XIAXIS) + XYZV2(JAXIS) = XYZV2LC(XJAXIS) + XYZV2(KAXIS) = XYZV2LC(XKAXIS) + CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) -IF(ALLOCATED(SURF_ID)) DEALLOCATE(SURF_ID) -ALLOCATE(SURF_ID(MAX_SURF_IDS+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','SURF_ID',IZERO) + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE+1) + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE+1) = (/ INOD1, INOD2 /) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE+1) = & + BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,ISEG) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG( CC_MAX_WSTRIANG_SEG+3,NEDGE+1) = & + -SUM(BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG))/2 + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE+1 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1= MESHES(NM)%CUT_EDGE(CEI)%NEDGE -IF(ALLOCATED(ZVALS)) DEALLOCATE(ZVALS) -ALLOCATE(ZVALS(MAX_ZVALS+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','ZVALS',IZERO) + ! Test for Repeated edge -> If so note FACERT + DO IDG=1,NEDGE + IF( ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD1 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD2 ) .OR. & + ( MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IDG) == INOD2 .AND. & + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IDG) == INOD1 ) ) THEN + FACERT(JJ2,KK2) =.TRUE. + EXIT + ENDIF + ENDDO -IF(ALLOCATED(VERTS)) DEALLOCATE(VERTS) -ALLOCATE(VERTS(3*MAX_VERTS+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','VERTS',IZERO) + ENDDO -IF(ALLOCATED(TFACES)) DEALLOCATE(TFACES) -ALLOCATE(TFACES(6*MAX_FACES+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','TFACES',IZERO) +ENDDO SEGS_LOOP -IF(ALLOCATED(FACES)) DEALLOCATE(FACES) -ALLOCATE(FACES(4*MAX_FACES+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','FACES',IZERO) +! Here TAG any CUT_EDGE vertices in VERT_LIST that lay in cartesian cell vertices: +DO CEI=INIT_CUT_EDGES,MESHES(NM)%N_CUTEDGE_MESH + INDIF = MESHES(NM)%CUT_EDGE(CEI)%IJK(IAXIS) + INDJF = MESHES(NM)%CUT_EDGE(CEI)%IJK(JAXIS) + INDKF = MESHES(NM)%CUT_EDGE(CEI)%IJK(KAXIS) + SELECT CASE(X1AXIS) ! INBOUNDCF edge, X1AXIS axis normal to face that edge is assigned to. + CASE(IAXIS) + IVERT_DOI : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB + ! INDJF-1:INDJF,INDKF-1:INDKF + DO KADD=-1,0 + DO JADD=-1,0 + IF(ABS(YFACE(INDJF+JADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,IVERT))>GEOMEPS) CYCLE + IF(ABS(ZFACE(INDKF+KADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,IVERT))>GEOMEPS) CYCLE + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF, INDJF+JADD, INDKF+KADD /) + CYCLE IVERT_DOI + ENDDO + ENDDO + ENDDO IVERT_DOI + CASE(JAXIS) + IVERT_DOJ : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB + ! INDIF-1:INDIF,INDKF-1:INDKF + DO KADD=-1,0 + DO IADD=-1,0 + IF(ABS(XFACE(INDIF+IADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,IVERT))>GEOMEPS) CYCLE + IF(ABS(ZFACE(INDKF+KADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,IVERT))>GEOMEPS) CYCLE + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF+IADD, INDJF, INDKF+KADD /) + CYCLE IVERT_DOJ + ENDDO + ENDDO + ENDDO IVERT_DOJ + CASE(KAXIS) + IVERT_DOK : DO IVERT=1,MESHES(NM)%CUT_EDGE(CEI)%NVERT + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1,IVERT) = CC_VTYPE_NINB + ! INDJF-1:INDJF,INDKF-1:INDKF + DO IADD=-1,0 + DO JADD=-1,0 + IF(ABS(YFACE(INDJF+JADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,IVERT))>GEOMEPS) CYCLE + IF(ABS(XFACE(INDIF+IADD)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,IVERT))>GEOMEPS) CYCLE + MESHES(NM)%CUT_EDGE(CEI)%VERT_LIST(1:4,IVERT) = (/ CC_VTYPE_VINB, INDIF+IADD, INDJF+JADD, INDKF /) + CYCLE IVERT_DOK + ENDDO + ENDDO + ENDDO IVERT_DOK + END SELECT +ENDDO -IF(ALLOCATED(VOLUS)) DEALLOCATE(VOLUS) -ALLOCATE(VOLUS(4*MAX_VOLUS+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','VOLUS',IZERO) +! Note cells in CELLRT due to FCERT intersections in GET_BODINT_PLANE: +DO KK2=X3LO_CELL,X3HI_CELL + DO JJ2=X2LO_CELL,X2HI_CELL + IF(.NOT.FACERT(JJ2,KK2)) CYCLE + ! Low cell indexes: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 + INDIF=INDXI(XIAXIS); INDJF=INDXI(XJAXIS); INDKF=INDXI(XKAXIS) + CELLRT(INDIF,INDJF,INDKF) =.TRUE. -IF(ALLOCATED(POLY)) DEALLOCATE(POLY) -ALLOCATE(POLY(MAX_POLY_VERTS+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','POLY',IZERO) -END SUBROUTINE ALLOCATE_BUFFERS + ! High cell indexes: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS)+1, JJ2, KK2 /) ! Local x1,x2,x3 + INDIF=INDXI(XIAXIS); INDJF=INDXI(XJAXIS); INDKF=INDXI(XKAXIS) + CELLRT(INDIF,INDJF,INDKF) =.TRUE. + ENDDO +ENDDO -! ---------------------------- SET_GEOM_DEFAULTS ---------------------------------------- +T_CC_USED(GET_CARTFACE_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTEDGES_TIME_INDEX) + CURRENT_TIME() - TNOW -SUBROUTINE SET_GEOM_DEFAULTS +RETURN +END SUBROUTINE GET_CARTFACE_CUTEDGES - ! Set defaults +! -------------------------- GET_IS_SOLID_PT ------------------------------------ - ZMIN=ZS_MIN - WRITE(ID,'(A,I0)') 'geom_',N - SURF_ID(:)='null' - SURF_IDS = 'null' - SURF_ID6 = 'null' - MATL_ID = 'null' - MOVE_ID = 'null' - DEVC_ID = 'null' - CTRL_ID = 'null' - FYI = 'null' - HAVE_SURF = .TRUE. - HAVE_MATL = .TRUE. - TEXTURE_ORIGIN = 0.0_EB - TEXTURE_MAPPING = 'RECTANGULAR' - TEXTURE_SCALE = 1.0_EB - TRANSPARENCY = -1._EB - VERTS=1.001_EB*MAX_VAL - ZVALS=1.001_EB*MAX_VAL - XB=1.001_EB*MAX_VAL - FACES=0 - VOLUS=0 - POLY =0 - IJK = 2 ! minimize number of triangles by default - IS_GEOMETRY_DYNAMIC = .FALSE. - EXTEND_TERRAIN = .FALSE. - IS_TERRAIN = .FALSE. - ZVAL_HORIZON = 1.001_EB*MAX_VAL - SPHERE_ORIGIN = 1.001_EB*MAX_VAL - SPHERE_RADIUS = 1.001_EB*MAX_VAL - CYLINDER_LENGTH = 1.001_EB*MAX_VAL - CYLINDER_RADIUS = 1.001_EB*MAX_VAL - CYLINDER_ORIGIN = 1.001_EB*MAX_VAL - CYLINDER_AXIS = 1.001_EB*MAX_VAL - EXTRUDE = 0._EB - CYLINDER_NSEG_THETA = -1 - CYLINDER_NSEG_AXIS = -1 - N_LEVELS=-1 - N_LAT=-1 - N_LONG=-1 - SPHERE_TYPE=-1 - GEOM_TYPE=CAD_GEOM_TYPE - BNDF_GEOM=BNDF_DEFAULT - READ_BINARY = .FALSE. - BINARY_FILE = 'null' - RGB=-1 - CELL_BLOCK_IOR=0 - CELL_BLOCK_ORIENTATION = 0._EB - COLOR='null' +SUBROUTINE GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) -END SUBROUTINE SET_GEOM_DEFAULTS +TYPE(BODINT_PLANE_TYPE), INTENT(IN) :: BODINT_PLANE2 +INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS +REAL(EB), INTENT(IN) :: XY(IAXIS:JAXIS),NVEC(IAXIS:JAXIS),X1PLN +LOGICAL, INTENT(OUT):: IS_SOLID -! ! ---------------------------- EXTRUDE_SPHERE ---------------------------------------- -! -! SUBROUTINE EXTRUDE_SPHERE(ZCENTER,VERTS,MAXVERTS,NVERTS,FACES,NFACES,VOLS,MAXVOLS, NVOLS) -! -! ! convert a closed surface defined by VERTS and FACES into a solid -! -! INTEGER, INTENT(IN) :: NFACES, MAXVERTS,MAXVOLS -! INTEGER, INTENT(INOUT) :: NVERTS -! REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) -! INTEGER, INTENT(IN) :: FACES(3*NFACES) -! INTEGER, INTENT(OUT) :: NVOLS -! INTEGER, INTENT(OUT) :: VOLS(4*MAXVOLS) -! REAL(EB), INTENT(IN) :: ZCENTER(3) -! -! INTEGER :: I -! -! ! define a new vertex at ZCENTER -! VERTS(3*NVERTS+1:3*NVERTS+3)=ZCENTER(1:3) -! -! ! form a tetrahedron using each face and the vertex ZCENTER -! DO I = 1, NFACES -! VOLS(4*I-3:4*I)=(/FACES(3*I-2:3*I),NVERTS+1/) -! ENDDO -! NVERTS=NVERTS+1 -! NVOLS=NFACES -! -! END SUBROUTINE EXTRUDE_SPHERE +! Local Variables +REAL(EB):: XYZ1(IAXIS:KAXIS), XYZ2(IAXIS:KAXIS), SCEN, XRAY +REAL(EB):: X2_1, X2_2, X3_1, X3_2, X2MIN, X2MAX, X3MIN, X3MAX, DOT1, DOT2, DELBIN, MODTI, SVARI, AVAL +REAL(EB):: STANI(IAXIS:JAXIS), NOMLI(IAXIS:JAXIS), DV12(IAXIS:JAXIS) +INTEGER :: SEG(NOD1:NOD2), ISSEG(LOW_IND:HIGH_IND), ISEG, IISEG, XAXIS, IBIN, ICR, SCRSI, ILO_BIN, IHI_BIN,& + ICRSI(LOW_IND:HIGH_IND+1), GAM(LOW_IND:HIGH_IND) +LOGICAL :: OUTRAY, IS_GASPHASE -! ! ---------------------------- EXTRUDE_SURFACE ---------------------------------------- -! -! SUBROUTINE EXTRUDE_SURFACE(ZMIN,VERTS,MAXVERTS,NVERTS,FACES,NFACES,VOLS,MAXVOLS, NVOLS) -! -! ! extend a 2D surface defined by VERTS and FACES to a plane defined by ZMIN -! -! INTEGER, INTENT(IN) :: NFACES, MAXVERTS,MAXVOLS -! INTEGER, INTENT(INOUT) :: NVERTS -! REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) -! INTEGER, INTENT(IN) :: FACES(3*NFACES) -! INTEGER, INTENT(OUT) :: NVOLS -! INTEGER, INTENT(OUT) :: VOLS(4*MAXVOLS) -! REAL(EB), INTENT(IN) :: ZMIN -! INTEGER :: PRISM(6) -! -! INTEGER :: I -! REAL(EB), POINTER, DIMENSION(:) :: VNEW, VOLD -! -! ! define a new vertex on the plane z=ZMIN for each vertex in original list -! DO I = 1, NVERTS -! VNEW=>VERTS(3*NVERTS+3*I-2:3*NVERTS+3*I) -! VOLD=>VERTS(3*I-2:3*I) -! VNEW(1:3)=(/VOLD(1:2),ZMIN/) -! ENDDO -! ! construct 3 tetrahedrons for each prism (solid between original face and face on plane z=zplane) -! DO I = 1, NFACES -! PRISM(1:3)=FACES(3*I-2:3*I) -! PRISM(4:6)=FACES(3*I-2:3*I)+NVERTS -! CALL PRISM2TETRA(PRISM,VOLS(12*I-11:12*I)) -! ENDDO -! NVOLS=3*NFACES -! NVERTS=2*NVERTS -! -! END SUBROUTINE EXTRUDE_SURFACE +! Initialize crossings arrays: +CC_N_CRS = 0 +CC_SVAR_CRS(:) = 1._EB/GEOMEPS +CC_IS_CRS(:) = CC_UNDEFINED +CC_IS_CRS2(:,:)= CC_UNDEFINED +CC_SEG_TAN(:,:)= 0._EB +CC_SEG_CRS(:) = 0 +CC_BDNUM_CRS(:)= 0 +CC_BDNUM_CRS_AUX(:)= 0 -! ---------------------------- BOX2TETRA ---------------------------------------- +! Define crossings: +IF(ABS(NVEC(IAXIS)) > ABS(NVEC(JAXIS))) THEN ! Do X2 ray + SCEN = XY(IAXIS); XRAY=XY(JAXIS); XAXIS=X3AXIS -SUBROUTINE BOX2TETRA(BOX,TETRAS) + DELBIN = BODINT_PLANE2%TBAXIS(XAXIS)%DELBIN + AVAL = (XRAY-GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN + ILO_BIN= MAX(1, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) + AVAL = (XRAY+GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN + IHI_BIN= MIN(BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) + DO IBIN=ILO_BIN,IHI_BIN + IF (XRAY < BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE + IF (XRAY > BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE + DO IISEG=1,BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%NTL + ISEG = BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) + SEG(NOD1:NOD2) = BODINT_PLANE2%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD2)) -! split a box defined by a list of 8 vertices (not necessarily cubic) into 6 stackable tetrahedrons + ! x2,x3 coordinates of segment: + X2_1 = XYZ1(X2AXIS) + X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. + X2_2 = XYZ2(X2AXIS) + X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. -! 8-------7 -! / . / | -! 5-------6 | -! | . | | -! | . | | -! | 4-------3 -! | / | / -! 1-------2 + ! First Test if the whole segment is on one side of the Ray: + ! Test segment crosses the ray, or is in geomepsilon proximity + ! of it: + X3MIN = MIN(X3_1,X3_2); X3MAX = MAX(X3_1,X3_2); + OUTRAY=(((XRAY-X3MAX) > GEOMEPS) .OR. ((X3MIN-XRAY) > GEOMEPS)) + IF (OUTRAY) CYCLE + DOT1 = X3_1-XRAY; DOT2 = X3_2-XRAY + IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB + IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB -INTEGER, INTENT(IN) :: BOX(8) -INTEGER, INTENT(OUT) :: TETRAS(1:24) + ! Segment tangent unit vector. + DV12(IAXIS:JAXIS) = XYZ2( (/ X2AXIS, X3AXIS /) ) - XYZ1( (/ X2AXIS, X3AXIS /) ) + MODTI = SQRT( DV12(IAXIS)**2._EB + DV12(JAXIS)**2._EB ) + STANI(IAXIS:JAXIS) = DV12(IAXIS:JAXIS) * MODTI**(-1._EB) + NOMLI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) + ISSEG(LOW_IND:HIGH_IND) = BODINT_PLANE2%SEGTYPE(LOW_IND:HIGH_IND,ISEG) -TETRAS(1:4) = (/BOX(1),BOX(2),BOX(4),BOX(5)/) -TETRAS(5:8) = (/BOX(4),BOX(5),BOX(2),BOX(6)/) -TETRAS(9:12) = (/BOX(4),BOX(5),BOX(6),BOX(8)/) -TETRAS(13:16) = (/BOX(2),BOX(3),BOX(4),BOX(6)/) -TETRAS(17:20) = (/BOX(4),BOX(6),BOX(3),BOX(8)/) -TETRAS(21:24) = (/BOX(6),BOX(3),BOX(8),BOX(7)/) + ! For x2, in local x2-x3 coords e2=(1,0): + GAM(LOW_IND) = (1 + NINT(SIGN(1._EB,NOMLI(IAXIS)))) / 2 ! (1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; + GAM(HIGH_IND)= (1 - NINT(SIGN(1._EB,NOMLI(IAXIS)))) / 2 ! (1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; -END SUBROUTINE BOX2TETRA + ! Test if whole segment is in ray, if so add segment nodes as crossings: + IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN + ! Count both points as crossings: + ! Point 1: + SVARI = MIN(X2_1,X2_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + DO ICR=2,BODINT_PLANE2%NBCROSS(ISEG)-1 + SVARI = X2_1 + BODINT_PLANE2%SVAR(ICR,ISEG)*STANI(IAXIS) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ENDDO + ! Point 2: + SVARI = max(X2_1,X2_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + ! Now nodes individually: + IF ( ABS(DOT1) == 0._EB ) THEN + ! Point 1: + SVARI = X2_1 + ! LOW and HIGH media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + IF ( ABS(DOT2) == 0._EB ) THEN + ! Point 2: + SVARI = X2_2 + ! LOW and HIGH_IND media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + ! Finally regular case: + ! Points 1 on one side of ray, point 2 on the other: + IF ( DOT1*DOT2 < 0._EB ) THEN + ! Intersection Point along segment: + ! DS = (XRAY-X3_1) / (X3_2-X3_1) + ! SVARI = X2_1 + DS*(X2_2-X2_1) + SVARI = X2_1 + (XRAY-X3_1) * (X2_2-X2_1) / (X3_2-X3_1) + ! LOW and HIGH media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + WRITE(LU_ERR,*) 'Error GET_IS_SOLID_PT NVEC(IAXIS): Missed segment=',ISEG + ENDDO + ENDDO -! ! ---------------------------- PRISM2TETRA ---------------------------------------- -! -! SUBROUTINE PRISM2TETRA(PRISM,TETRAS) -! -! ! split a prism defined by a list of 6 vertices into 3 tetrahedrons -! -! ! 6 -! ! /.\ . -! ! / . \ . -! ! / . \ . -! ! 4-----------5 -! ! | . | -! ! | . | -! ! | 3 | -! ! | / \ | -! ! | / \ | -! ! |/ \| -! ! 1-----------2 -! INTEGER, INTENT(IN) :: PRISM(6) -! INTEGER, INTENT(OUT) :: TETRAS(1:12) -! -! TETRAS(1:4) = (/PRISM(1),PRISM(6),PRISM(4),PRISM(5)/) -! TETRAS(5:8) = (/PRISM(1),PRISM(3),PRISM(6),PRISM(5)/) -! TETRAS(9:12) = (/PRISM(1),PRISM(2),PRISM(3),PRISM(5)/) -! -! END SUBROUTINE PRISM2TETRA +ELSE ! Do X3 ray + SCEN=XY(JAXIS); XRAY=XY(IAXIS); XAXIS=X2AXIS; -! ! ---------------------------- SPLIT_TETRA ---------------------------------------- -! -! SUBROUTINE SPLIT_TETRA(VERTS,MAXVERTS,NVERTS,TETRAS) -! ! split a tetrahedron defined by a list of 4 vertices into 4 tetrahedrons -! -! ! 1 -! ! | -! ! .|. -! ! .|. -! ! . | . -! ! . 7 . -! ! . | . -! ! . 4 . -! ! 5 / \ 6 -! ! . / \ . -! ! . / \ . -! ! . / \ . -! ! ./ \. -! ! / \. -! ! 2-------------3 -! -! INTEGER, INTENT(IN) :: MAXVERTS -! INTEGER, INTENT(INOUT) :: NVERTS -! REAL(EB), INTENT(INOUT), TARGET :: VERTS(3*MAXVERTS) -! INTEGER, INTENT(INOUT) :: TETRAS(16) -! -! REAL(EB), POINTER, DIMENSION(:) :: VERT1, VERT2, VERT3, VERT4, VERT5, VERT6, VERT7 -! INTEGER :: TETRANEW(16) -! -! VERT1=>VERTS(3*TETRAS(1)-2:3*TETRAS(1)) -! VERT2=>VERTS(3*TETRAS(2)-2:3*TETRAS(2)) -! VERT3=>VERTS(3*TETRAS(3)-2:3*TETRAS(3)) -! VERT4=>VERTS(3*TETRAS(4)-2:3*TETRAS(4)) -! VERT5=>VERTS(3*NVERTS+1:3*NVERTS+3) -! VERT6=>VERTS(3*NVERTS+4:3*NVERTS+6) -! VERT7=>VERTS(3*NVERTS+7:3*NVERTS+9) -! -! ! add 3 vertices -! VERT5(1:3) = ( VERT1(1:3)+VERT2(1:3) )/2.0_EB -! VERT6(1:3) = ( VERT1(1:3)+VERT3(1:3) )/2.0_EB -! VERT7(1:3) = ( VERT1(1:3)+VERT4(1:3) )/2.0_EB -! TETRAS(5)=NVERTS+1 -! TETRAS(6)=NVERTS+2 -! TETRAS(7)=NVERTS+3 -! NVERTS=NVERTS+3 -! -! TETRANEW(1:4)=(/TETRAS(1),TETRAS(5),TETRAS(6),TETRAS(7)/) -! CALL PRISM2TETRA(TETRAS(2:7),TETRANEW(5:16)) -! TETRAS(1:16)=TETRANEW(1:16) -! -! END SUBROUTINE SPLIT_TETRA + DELBIN = BODINT_PLANE2%TBAXIS(XAXIS)%DELBIN + AVAL = (XRAY-GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN + ILO_BIN= MAX(1, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) + AVAL = (XRAY+GEOMEPS-BODINT_PLANE2%BOX(LOW_IND,XAXIS))/DELBIN + IHI_BIN= MIN(BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS, & + CEILING( SIGN(1._EB,AVAL)*MIN(REAL(2*BODINT_PLANE2%TBAXIS(XAXIS)%N_BINS,EB),ABS(AVAL)) )) + DO IBIN=ILO_BIN,IHI_BIN + IF (XRAY < BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE + IF (XRAY > BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE + DO IISEG=1,BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%NTL + ISEG = BODINT_PLANE2%TBAXIS(XAXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) + SEG(NOD1:NOD2) = BODINT_PLANE2%SEGS(NOD1:NOD2,ISEG) + XYZ1(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE2%XYZ(IAXIS:KAXIS,SEG(NOD2)) -! ---------------------------- ORDER_FACES ---------------------------------------- + ! x2,x3 coordinates of segment: + X2_1 = XYZ1(X2AXIS) + X3_1 = XYZ1(X3AXIS) ! Lower index endpoint. + X2_2 = XYZ2(X2AXIS) + X3_2 = XYZ2(X3AXIS) ! Upper index endpoint. -SUBROUTINE ORDER_FACES(ORDER,N) ! -INTEGER, INTENT(IN) :: N -INTEGER, INTENT(OUT) :: ORDER(1:N) + ! First Test if the whole segment is on one side of the Ray: + ! Test segment crosses the ray, or is in geomepsilon proximity + ! of it: + X2MIN = MIN(X2_1,X2_2) + X2MAX = MAX(X2_1,X2_2) + OUTRAY=(((XRAY-X2MAX) > GEOMEPS) .OR. ((X2MIN-XRAY) > GEOMEPS)) -INTEGER, ALLOCATABLE, DIMENSION(:) :: WORK -INTEGER :: I, IZERO + IF (OUTRAY) CYCLE + DOT1 = X2_1-XRAY; DOT2 = X2_2-XRAY + IF (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB + IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB -DO I = 1, N - ORDER(I) = I -ENDDO -ALLOCATE(WORK(N),STAT=IZERO) -CALL ChkMemErr('ORDER_FACES','WORK',IZERO) -CALL ORDER_FACES1(ORDER,WORK,1,N,N) -END SUBROUTINE ORDER_FACES + ! Segment tangent unit vector. + DV12(IAXIS:JAXIS) = XYZ2( (/ X2AXIS, X3AXIS /) ) - XYZ1( (/ X2AXIS, X3AXIS /) ) + MODTI = SQRT( DV12(IAXIS)**2._EB + DV12(JAXIS)**2._EB ) + STANI(IAXIS:JAXIS) = DV12(IAXIS:JAXIS) * MODTI**(-1._EB) + NOMLI(IAXIS:JAXIS) = (/ STANI(JAXIS), -STANI(IAXIS) /) + ISSEG(LOW_IND:HIGH_IND) = BODINT_PLANE2%SEGTYPE(LOW_IND:HIGH_IND,ISEG) -! ---------------------------- ORDER_FACES1 ---------------------------------------- + ! For x3, in local x2-x3 coords e2=(0,1): + GAM(LOW_IND) = (1 + NINT(SIGN(1._EB,NOMLI(JAXIS)))) / 2 ! (1+SIGN(DOT_PRODUCT(NOMLI,e2)))/2; + GAM(HIGH_IND)= (1 - NINT(SIGN(1._EB,NOMLI(JAXIS)))) / 2 ! (1-SIGN(DOT_PRODUCT(NOMLI,e2)))/2; -RECURSIVE SUBROUTINE ORDER_FACES1(ORDER,WORK,LEFT,RIGHT,N) -INTEGER, INTENT(IN) :: N, LEFT, RIGHT -INTEGER, INTENT(INOUT) :: ORDER(1:N) -INTEGER :: TEMP -INTEGER :: I1, I2 -INTEGER, INTENT(OUT) :: WORK(N) -INTEGER :: ICOUNT + ! Test if whole segment is in ray, if so add segment nodes as crossings: + IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN + ! Count both points as crossings: + ! Point 1: + SVARI = MIN(X3_1,X3_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_GASPHASE, CC_SOLID, CC_UNDEFINED /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + DO ICR=2,BODINT_PLANE2%NBCROSS(ISEG)-1 + SVARI = X3_1 + BODINT_PLANE2%SVAR(ICR,ISEG)*STANI(JAXIS) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_SOLID, CC_SOLID /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ENDDO + ! Point 2: + SVARI = MAX(X3_1,X3_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + ! Now nodes individually: + IF ( ABS(DOT1) == 0._EB ) THEN + ! Point 1: + SVARI = X3_1 + ! LOW and HIGH media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + IF ( ABS(DOT2) == 0._EB ) THEN + ! Point 2: + SVARI = X3_2 + ! LOW and HIGH_IND media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + ! Finally regular case: + ! Points 1 on one side of ray, point 2 on the other: + IF ( DOT1*DOT2 < 0._EB ) THEN + ! Intersection Point along segment: + ! DS = (XRAY-X2_1) / (X2_2-X2_1) + ! SVARI = X3_1 + DS*(X3_2-X3_1) + SVARI = X3_1 + (XRAY-X2_1) * (X3_2-X3_1) / (X2_2-X2_1) + ! LOW and HIGH media type, using the segment definition: + ICRSI(LOW_IND) = GAM(LOW_IND)*ISSEG(LOW_IND) + GAM(HIGH_IND)*ISSEG(HIGH_IND) + ICRSI(HIGH_IND)= GAM(LOW_IND)*ISSEG(HIGH_IND)+ GAM(HIGH_IND)*ISSEG(LOW_IND) + ICRSI(HIGH_IND+1)=CC_UNDEFINED + SCRSI = ISEG + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + CYCLE + ENDIF + WRITE(LU_ERR,*) 'Error GET_IS_SOLID_PT NVEC(JAXIS): Missed segment=',ISEG + ENDDO + ENDDO -INTEGER :: NMID +ENDIF -IF (RIGHT-LEFT>1) THEN - NMID = (LEFT+RIGHT)/2 - CALL ORDER_FACES1(ORDER,WORK,LEFT,NMID,N) - CALL ORDER_FACES1(ORDER,WORK,NMID+1,RIGHT,N) - I1=LEFT - I2=NMID+1 - ICOUNT=LEFT - DO WHILE (I1<=NMID .OR. I2<=RIGHT) - IF (I1<=NMID .AND. I2<=RIGHT) THEN - IF (COMPARE_FACES(ORDER(I1),ORDER(I2))==-1) THEN - WORK(ICOUNT)=ORDER(I1) - I1=I1+1 - ELSE - WORK(ICOUNT)=ORDER(I2) - I2=I2+1 - ENDIF - ELSE IF (I1<=NMID .AND. I2>RIGHT) THEN - WORK(ICOUNT)=ORDER(I1) - I1=I1+1 - ELSE IF (I1>NMID .AND. I2<=RIGHT) THEN - WORK(ICOUNT)=ORDER(I2) - I2=I2+1 - ENDIF - ICOUNT=ICOUNT+1 - ENDDO - ORDER(LEFT:RIGHT)=WORK(LEFT:RIGHT) -ELSE IF (RIGHT-LEFT==1) THEN - IF (COMPARE_FACES(ORDER(LEFT),ORDER(RIGHT))==1) RETURN - TEMP=ORDER(LEFT) - ORDER(LEFT) = ORDER(RIGHT) - ORDER(RIGHT) = TEMP +! Do we have any intersections? +IF ( CC_N_CRS == 0 ) THEN + IS_SOLID =.FALSE. + RETURN ENDIF -END SUBROUTINE ORDER_FACES1 +CALL COLLAPSE_CROSSINGS(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XRAY,X1PLN,2) +CALL GET_IS_GASPHASE(SCEN,IS_GASPHASE) -! ---------------------------- COMPARE_FACES ---------------------------------------- +IS_SOLID = .NOT.IS_GASPHASE -INTEGER FUNCTION COMPARE_FACES(INDEX1,INDEX2) -INTEGER, INTENT(IN) :: INDEX1, INDEX2 -INTEGER, POINTER, DIMENSION(:) :: FACE1, FACE2 -INTEGER :: F1(3), F2(3) +RETURN +END SUBROUTINE GET_IS_SOLID_PT -FACE1=>FACES(3*INDEX1-2:3*INDEX1) -FACE2=>FACES(3*INDEX2-2:3*INDEX2) -F1(1:3) = (/FACE1(1),MIN(FACE1(2),FACE1(3)),MAX(FACE1(2),FACE1(3))/) -F2(1:3) = (/FACE2(1),MIN(FACE2(2),FACE2(3)),MAX(FACE2(2),FACE2(3))/) -COMPARE_FACES=0 -IF (F1(1)F2(1)) THEN - COMPARE_FACES=-1 -ENDIF -IF (COMPARE_FACES/=0) RETURN +! ------------------------- INSERT_FACE_VERT ------------------------------------ -IF (F1(2)F2(2)) THEN - COMPARE_FACES=-1 -ENDIF -IF (COMPARE_FACES/=0) RETURN +SUBROUTINE INSERT_FACE_VERT(XYZV,NM,CEI,NVERT,INOD) + +REAL(EB), INTENT(IN) :: XYZV(MAX_DIM) +INTEGER, INTENT(IN) :: NM,CEI +INTEGER, INTENT(INOUT):: NVERT +INTEGER, INTENT(OUT) :: INOD + +! Local Variables: +! INTEGER :: JNOD, JNOD2, PIVOT(LOW_IND:HIGH_IND) +! REAL(EB) :: DV(MAX_DIM) +! IF (NVERT < LINSEARCH_LIMIT) THEN +! ! Linear Search: +! DO JNOD=1,NVERT +! DV(IAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(IAXIS) +! IF( DV(IAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF( ABS(DV(IAXIS)) <= GEOMEPS) THEN +! DV(JAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(JAXIS) +! IF ( DV(JAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF ( ABS(DV(JAXIS)) <= GEOMEPS ) THEN +! DV(KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(KAXIS) +! IF ( DV(KAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF ( ABS(DV(KAXIS)) <= GEOMEPS ) THEN +! INOD = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) +! RETURN ! XYZV is in XYZVERT(IAXIS:KAXIS,NOD_PERM(JNOD)) +! ENDIF +! ENDIF +! ENDIF +! ENDDO +! ELSE +! ! Binary Search: +! PIVOT(LOW_IND) = 0 +! PIVOT(HIGH_IND)= NVERT + 1 +! DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) +! JNOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 +! DV(IAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(IAXIS) +! IF( DV(IAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(IAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(IAXIS)) < GEOMEPS +! DV(JAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(JAXIS) +! IF ( DV(JAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(JAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(JAXIS)) < GEOMEPS +! DV(KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD)) - XYZV(KAXIS) +! IF ( DV(KAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(KAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(KAXIS)) < GEOMEPS +! INOD = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) +! RETURN +! ENDIF +! ENDIF +! ENDIF +! ENDDO +! JNOD=PIVOT(HIGH_IND) +! ENDIF +! ! Insert add NOD_PERM permutation array, O(NP) operation: +! INOD = NVERT + 1 +! NVERT = INOD +! CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT) +! DO JNOD2=NVERT,JNOD+1,-1 +! MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD2) = MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD2-1) +! ENDDO +! MESHES(NM)%CUT_EDGE(CEI)%NOD_PERM(JNOD) = INOD +! MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) + +DO INOD=1,NVERT + IF( ABS(XYZV(IAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS,INOD)) > GEOMEPS ) CYCLE + IF( ABS(XYZV(JAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(JAXIS,INOD)) > GEOMEPS ) CYCLE + IF( ABS(XYZV(KAXIS)-MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(KAXIS,INOD)) > GEOMEPS ) CYCLE + RETURN +ENDDO +NVERT = NVERT + 1 +INOD = NVERT +CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT) +MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) -IF (F1(3)F2(3)) THEN - COMPARE_FACES=-1 -ENDIF -END FUNCTION COMPARE_FACES +RETURN +END SUBROUTINE INSERT_FACE_VERT -END SUBROUTINE READ_GEOM +! ------------------------- INSERT_FACE_VERT_LOC(XYZ,NVERT,INOD1,XYZVERT) +SUBROUTINE INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,NVERT,INOD,XYZVERT) -! ---------------------------- INIT_SPHERE ---------------------------------------- +INTEGER, INTENT(IN) :: MAXVERTS +REAL(EB), INTENT(IN) :: XYZV(MAX_DIM) +REAL(EB), INTENT(INOUT), DIMENSION(IAXIS:KAXIS,1:MAXVERTS) :: XYZVERT ! Locations of vertices. +INTEGER, INTENT(INOUT):: NVERT +INTEGER, INTENT(OUT) :: INOD -SUBROUTINE INIT_SPHERE(N_LEVELS,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +REAL(EB), PARAMETER :: VERT_PROX_FCT = 1000._EB -INTEGER, INTENT(IN) :: N_LEVELS -INTEGER, INTENT(OUT) :: N_VERTS, N_FACES -INTEGER, INTENT(IN) :: MAX_VERTS, MAX_FACES -REAL(EB), TARGET, INTENT(OUT) :: SPHERE_VERTS(3*MAX_VERTS) -INTEGER, TARGET, INTENT(OUT) :: SPHERE_FACES(3*MAX_FACES) +! Local Variables: +! INTEGER :: JNOD, JNOD2, PIVOT(LOW_IND:HIGH_IND) +! REAL(EB) :: DV(MAX_DIM) +! INTEGER, SAVE :: NOD_PERM(CC_MAXVERTS_CELL) +! IF (NVERT < LINSEARCH_LIMIT) THEN +! ! Linear Search: +! DO JNOD=1,NVERT +! DV(IAXIS) = XYZVERT(IAXIS,NOD_PERM(JNOD)) - XYZV(IAXIS) +! IF( DV(IAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF( ABS(DV(IAXIS)) <= GEOMEPS) THEN +! DV(JAXIS) = XYZVERT(JAXIS,NOD_PERM(JNOD)) - XYZV(JAXIS) +! IF ( DV(JAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF ( ABS(DV(JAXIS)) <= GEOMEPS ) THEN +! DV(KAXIS) = XYZVERT(KAXIS,NOD_PERM(JNOD)) - XYZV(KAXIS) +! IF ( DV(KAXIS) > GEOMEPS ) THEN +! EXIT +! ELSEIF ( ABS(DV(KAXIS)) <= GEOMEPS ) THEN +! INOD = NOD_PERM(JNOD) +! RETURN ! XYZV is in XYZVERT(IAXIS:KAXIS,NOD_PERM(JNOD)) +! ENDIF +! ENDIF +! ENDIF +! ENDDO +! ELSE +! ! Binary Search: +! PIVOT(LOW_IND) = 0 +! PIVOT(HIGH_IND)= NVERT + 1 +! DO WHILE( (PIVOT(HIGH_IND)-PIVOT(LOW_IND)) > 1) +! JNOD = (PIVOT(LOW_IND)+PIVOT(HIGH_IND))/2 +! DV(IAXIS) = XYZVERT(IAXIS,NOD_PERM(JNOD)) - XYZV(IAXIS) +! IF( DV(IAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(IAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(IAXIS)) < GEOMEPS +! DV(JAXIS) = XYZVERT(JAXIS,NOD_PERM(JNOD)) - XYZV(JAXIS) +! IF ( DV(JAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(JAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(JAXIS)) < GEOMEPS +! DV(KAXIS) = XYZVERT(KAXIS,NOD_PERM(JNOD)) - XYZV(KAXIS) +! IF ( DV(KAXIS) < -GEOMEPS ) THEN +! PIVOT(LOW_IND) = JNOD +! ELSEIF( DV(KAXIS) > GEOMEPS ) THEN +! PIVOT(HIGH_IND)= JNOD +! ELSE ! ABS(DV(KAXIS)) < GEOMEPS +! INOD = NOD_PERM(JNOD) +! RETURN +! ENDIF +! ENDIF +! ENDIF +! ENDDO +! JNOD=PIVOT(HIGH_IND) +! ENDIF +! ! Insert add NOD_PERM permutation array, O(NP) operation: +! INOD = NVERT + 1 +! NVERT = INOD +! IF (NVERT>MAXVERTS) WRITE(LU_ERR,*) 'geom.f90: INSERT_FACE_VERT_LOC, NVERT',NVERT,', higher than CC_MAXVERTS',MAXVERTS +! DO JNOD2=NVERT,JNOD+1,-1 +! NOD_PERM(JNOD2) = NOD_PERM(JNOD2-1) +! ENDDO +! NOD_PERM(JNOD) = INOD +! XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) -REAL(EB) :: ARG -REAL(EB), DIMENSION(3) :: VERT -INTEGER :: I,IFACE -INTEGER, DIMENSION(60) :: FACE_LIST +DO INOD=1,NVERT + IF( ABS(XYZV(IAXIS)-XYZVERT(IAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE + IF( ABS(XYZV(JAXIS)-XYZVERT(JAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE + IF( ABS(XYZV(KAXIS)-XYZVERT(KAXIS,INOD)) > VERT_PROX_FCT*GEOMEPS ) CYCLE + RETURN +ENDDO +NVERT = NVERT + 1 +INOD = NVERT +IF (NVERT>MAXVERTS) WRITE(LU_ERR,*) 'geom.f90: INSERT_FACE_VERT_LOC, NVERT',NVERT,', higher than CC_MAXVERTS',MAXVERTS +XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) -DATA (FACE_LIST(I),I=1,60) / & - 1, 2, 3, 1, 3, 4, 1, 4, 5, 1, 5, 6, 1, 6,2, & - 2, 7, 3, 3, 7, 8, 3, 8, 4, 4, 8, 9, 4, 9,5, & - 5, 9,10, 5,10, 6, 6,10,11, 6,11, 2, 2,11,7, & - 12, 8,7, 12, 9,8, 12,10,9, 12,11,10, 12,7,11 & - / +RETURN +END SUBROUTINE INSERT_FACE_VERT_LOC -N_VERTS = 12 -N_FACES = 20 +! ----------------------- GET_CARTFACE_CUTFACES --------------------------------- -SPHERE_VERTS(1:3) = (/0.0,0.0,1.0/) ! 1 -DO I=2, 6 - ARG = REAL(I-2,EB)*72.0_EB - ARG = 2.0_EB*PI*ARG/360.0_EB - VERT = (/COS(ARG),SIN(ARG),1.0_EB/SQRT(5.0_EB)/) - SPHERE_VERTS(3*I-2:3*I) = VERT/NORM2(VERT) ! 2-6 -ENDDO -DO I=7, 11 - ARG = 36.0_EB+REAL(I-7,EB)*72.0_EB - ARG = 2.0_EB*PI*ARG/360.0_EB - VERT = (/COS(ARG),SIN(ARG),-1.0_EB/SQRT(5.0_EB)/) - SPHERE_VERTS(3*I-2:3*I) = VERT/NORM2(VERT) ! 7-11 -ENDDO -SPHERE_VERTS(34:36) = (/0.0,0.0,-1.0/) ! 12 +SUBROUTINE GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) -SPHERE_FACES(1:60) = FACE_LIST(1:60) +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN) :: BNDINT_FLAG -! refine each triangle of the icosahedron recursively until the -! refined triangle sides are the same size as the grid mesh +! Local Variables: +INTEGER :: X1AXIS, X2AXIS, X3AXIS +INTEGER :: XIAXIS, XJAXIS, XKAXIS +INTEGER :: X1LO, X1HI, X2LO, X2HI, X3LO, X3HI +INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI +INTEGER :: II,II2,JJ,KK, CEI +INTEGER :: INDXI(MAX_DIM), INDI, INDJ, INDK +INTEGER :: INDXI1(MAX_DIM), INDI1, INDJ1, INDK1 +INTEGER :: INDXI2(MAX_DIM), INDI2, INDJ2, INDK2 +INTEGER :: INDXI3(MAX_DIM), INDI3, INDJ3, INDK3 +INTEGER :: INDXI4(MAX_DIM), INDI4, INDJ4, INDK4 +INTEGER :: INDLC(MAX_DIM), IEDG, JEDG, KEDG +INTEGER :: NSEG, ISEG, ISEG2, NVERT, NFACE, NEDGE, IEDGE, NVERT_CART, NSEG_CART +LOGICAL :: OUTFACE1, OUTFACE2, NOTDONE -DO IFACE = 1, 20 ! can't use N_FACES since N_FACES is altered by each call to REFINE_FACE - CALL REFINE_FACE(N_LEVELS,IFACE,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) -ENDDO -END SUBROUTINE INIT_SPHERE +INTEGER, DIMENSION(NOD1:NOD2+3,1:CC_MAXCEELEM_FACE) :: SEG_FACE, SEG_FACE_CART, SEG_FACEAUX +INTEGER, DIMENSION(NOD1:NOD3+1,1:CC_MAXCEELEM_FACE) :: SEG_FACE2 +REAL(EB), DIMENSION(CC_MAXCEELEM_FACE) :: ANGSEG, ANGSEGAUX +REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) :: XYZVERT, XYZVERT_CART ! Locations of vertices. -! ---------------------------- COMPUTE_TEXTURES ---------------------------------------- +INTEGER, SAVE :: SIZE_CFACES_CFELEM, SIZE_VERTS_CFELEM +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CFELEM2,CEDGES,CEDGES2 +INTEGER, ALLOCATABLE, DIMENSION(:) :: CFE, CFEL -SUBROUTINE COMPUTE_TEXTURES(SPHERE_VERTS,SPHERE_FACES,SPHERE_TFACES,MAX_VERTS,MAX_FACES,N_FACES) -INTEGER, INTENT(IN) :: N_FACES,MAX_VERTS,MAX_FACES -REAL(EB), TARGET, INTENT(IN) :: SPHERE_VERTS(3*MAX_VERTS) -REAL(EB), INTENT(OUT), TARGET :: SPHERE_TFACES(6*MAX_FACES) -INTEGER, TARGET, INTENT(IN) :: SPHERE_FACES(3*MAX_FACES) +INTEGER, SAVE :: SIZE_EDGES_NODEDG, SIZE_VERTS_NODEDG +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NODEDG_FACE -INTEGER :: IFACE -REAL(EB) :: EPS_TEXTURE -REAL(EB), POINTER, DIMENSION(:) :: TFACE, VERTPTR -INTEGER, POINTER, DIMENSION(:) :: FACEPTR +LOGICAL :: SEG_FLAG(CC_MAXCEELEM_FACE) +INTEGER :: NUMEDG_NODE(CC_MAXVERTS_FACE) -EPS_TEXTURE=0.25_EB -IFACE_LOOP: DO IFACE=0, N_FACES-1 +INTEGER :: INOD, INOD1, INOD2, SEG(NOD1:NOD2) +REAL(EB):: X1, X2, X3, DX2, DX3, XYZV(MAX_DIM), XYZLC(MAX_DIM) +INTEGER :: NUMNOD1, NUMNOD2, NEDI, ICF, ISS, NEWSEG, COUNT, N2COUNT, CTSTART, NSEG_LEFT +REAL(EB):: ANGCOUNT, DANG, DANGI +LOGICAL :: FOUNDSEG, PTSFLAG +INTEGER :: ICF1, ICF2, ICF_PT, IPT, NP, NP1, NP2, NFACE2, NCUTFACE, NVERTFACE +REAL(EB), DIMENSION(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) :: XY +REAL(EB):: AREA, AREA1, AREA2, AREAH, CX2, CX3, DIST12, D12 +REAL(EB), DIMENSION(IAXIS:JAXIS) :: XYC1, XYC2, XYH - FACEPTR=>SPHERE_FACES(3*IFACE+1:3*IFACE+3) - TFACE=>SPHERE_TFACES(6*IFACE+1:6*IFACE+6) +REAL(EB), DIMENSION(CC_MAXCFELEM_FACE) :: AREAV ! Cut-faces areas. +REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXCFELEM_FACE) :: XYZCEN ! Cut-faces centroid locations. +REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXCFELEM_FACE) :: INXAREA, INXSQAREA +INTEGER, DIMENSION(CC_MAXCFELEM_FACE) :: FINFACE +INTEGER :: IBNDINT,BNDINT_LOW,BNDINT_HIGH,ILOC,BODNUM(1:CC_MAXCEELEM_FACE),& +SEGTYPE(CC_MAXCEELEM_FACE),SEGTYPEAUX(CC_MAXCEELEM_FACE),VEC(2),IDUM,IBOD,STYPE +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED - VERTPTR=>SPHERE_VERTS(3*FACEPTR(1)-2:3*FACEPTR(1)) - CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(1:2)) +INTEGER :: NSSEG, NSVERT, NSFACE, NSFACE2 +LOGICAL :: ASCDESC, INLIST +INTEGER :: NV,IV,V(1:CC_MAXVERTS_FACE) +REAL(EB):: XVERT1(1:CC_MAXVERTS_FACE),XVERT2(1:CC_MAXVERTS_FACE) - VERTPTR=>SPHERE_VERTS(3*FACEPTR(2)-2:3*FACEPTR(2)) - CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(3:4)) +INTEGER, PARAMETER :: NODC1(1:4) = (/ 1, 2, 1, 2 /) +INTEGER, PARAMETER :: NODC2(1:4) = (/ 1, 2, 2, 1 /) +INTEGER :: SNOD1(NOD1:NOD2), SNOD2(NOD1:NOD2) +REAL(EB) :: XYZ_SEG1(IAXIS:KAXIS,NOD1:NOD2), XYZ_SEG2(IAXIS:KAXIS,NOD1:NOD2) +LOGICAL :: DIFF(1:4) +LOGICAL :: GET_SOLID_CUTFACES = .TRUE. +LOGICAL, ALLOCATABLE, DIMENSION(:) :: DROPFACE +REAL(EB) :: TNOW - VERTPTR=>SPHERE_VERTS(3*FACEPTR(3)-2:3*FACEPTR(3)) - CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(5:6)) +! INTEGER :: ETYPE, AXIS, SIDE, IEC, JEC, CEIJK(4), IIF, JJF ,KKF +! REAL(EB):: X1E(IAXIS:KAXIS), X1V(IAXIS:KAXIS), X2E(IAXIS:KAXIS), X2V(IAXIS:KAXIS) - ! adjust texture coordinates when a triangle crosses the "prime meridian" +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +INTEGER :: NCUTFCE - IF (TFACE(1)>1.0_EB-EPS_TEXTURE .AND. TFACE(3)1.0_EB-EPS_TEXTURE .AND. TFACE(5)1.0_EB-EPS_TEXTURE .AND. TFACE(1)1.0_EB-EPS_TEXTURE .AND. TFACE(5)1.0_EB-EPS_TEXTURE .AND. TFACE(1)1.0_EB-EPS_TEXTURE .AND. TFACE(3)MAX_FACES .OR. N_VERTS+3>MAX_VERTS) RETURN ! prevent memory overwrites + ! Drop if face not cut-face: + ! Test for FACE Cartesian edges being cut: + ! If outface1 is true -> All regular edges for this face: + ! Edge at index KK-1: + INDXI1(IAXIS:KAXIS) = (/ II, JJ, KK-1 /) ! Local x1,x2,x3 + INDI1 = INDXI1(XIAXIS) + INDJ1 = INDXI1(XJAXIS) + INDK1 = INDXI1(XKAXIS) + ! Edge at index KK: + INDXI2(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI2 = INDXI2(XIAXIS) + INDJ2 = INDXI2(XJAXIS) + INDK2 = INDXI2(XKAXIS) + ! Edge at index JJ-1: + INDXI3(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 + INDI3 = INDXI3(XIAXIS) + INDJ3 = INDXI3(XJAXIS) + INDK3 = INDXI3(XKAXIS) + ! Edge at index jj: + INDXI4(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI4 = INDXI4(XIAXIS) + INDJ4 = INDXI4(XJAXIS) + INDK4 = INDXI4(XKAXIS) + + OUTFACE1 = (MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) /= CC_CUTCFE) -FACE1(1:3)=>SPHERE_FACES(3*IFACE-2:3*IFACE) ! original face and 1st new face -FACE2(1:3)=>SPHERE_FACES(3*N_FACES+1:3*N_FACES+3) ! 2nd new face -FACE3(1:3)=>SPHERE_FACES(3*N_FACES+4:3*N_FACES+6) ! 3rd new face -FACE4(1:3)=>SPHERE_FACES(3*N_FACES+7:3*N_FACES+9) ! 4th new face + ! Test for face with INB edges: + ! If outface2 is true -> no INB Edges associated with this face: + OUTFACE2 = (MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) <= 0) -V1(1:3)=>SPHERE_VERTS(3*FACE1(1)-2:3*FACE1(1)) ! FACE1(1) -V2(1:3)=>SPHERE_VERTS(3*FACE1(2)-2:3*FACE1(2)) ! FACE1(2) -V3(1:3)=>SPHERE_VERTS(3*FACE1(3)-2:3*FACE1(3)) ! FACE1(3) + ! Drop if outface1 & outface2 + IF (OUTFACE1 .AND. OUTFACE2) THEN + ! Test if face is SOLID: + IF ((MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) == CC_SOLID) ) THEN + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID + ENDIF + CYCLE + ENDIF -V12(1:3)=>SPHERE_VERTS(3*N_VERTS+1:3*N_VERTS+3) -V13(1:3)=>SPHERE_VERTS(3*N_VERTS+4:3*N_VERTS+6) -V23(1:3)=>SPHERE_VERTS(3*N_VERTS+7:3*N_VERTS+9) + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_CUTCFE -V12 = (V1+V2)/2.0_EB -V13 = (V1+V3)/2.0_EB -V23 = (V2+V3)/2.0_EB -V12 = V12/NORM2(V12) ! N_VERTS + 1 -V13 = V13/NORM2(V13) ! N_VERTS + 2 -V23 = V23/NORM2(V23) ! N_VERTS + 3 + ! Build segment list: + NSEG = 0 + NVERT = 0 + NFACE = 0 -! split triangle 123 into 4 triangles + SEG_FACE (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED + XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) = 0._EB + ANGSEG(1:CC_MAXCEELEM_FACE) = 0._EB + BODNUM(1:CC_MAXCEELEM_FACE) = 1000000000 + SEGTYPE(1:CC_MAXCEELEM_FACE) = 0 -! 1 -! /F1\ . -! 12----13 -! /F2\F3/F4\ i. -! 2 --- 23----3 -FACE2(1:3) = (/N_VERTS+1,FACE1(2),N_VERTS+3/) -FACE3(1:3) = (/N_VERTS+1,N_VERTS+3,N_VERTS+2/) -FACE4(1:3) = (/N_VERTS+2,N_VERTS+3,FACE1(3)/) -FACE1(1:3) = (/ FACE1(1),N_VERTS+1,N_VERTS+2/) + ! 1. Cartesian CC_GASPHASE edges, cut-edges: + ! a. Make a list of segments: + ! Low x2 cut-edges: + INDLC(IAXIS:KAXIS) = INDXI3(IAXIS:KAXIS) + IEDG=INDI3; JEDG=INDJ3; KEDG=INDK3 + CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X3AXIS) + IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: + IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X3AXIS) /= CC_SOLID) THEN + ! x,y,z of node 1: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -N1 = IFACE -N2 = N_FACES+1 -N3 = N_FACES+2 -N4 = N_FACES+3 + ! x,y,z of node 2: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)-1) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) -N_FACES = N_FACES + 3 -N_VERTS = N_VERTS + 3 -IF (N_LEVELS==1) RETURN ! stop recursion + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, LOW_IND, X2AXIS /) + ANGSEG(NSEG) = - PI / 2._EB + ENDIF + ELSE ! Cut-edge, load CUT_EDGE(CEI) segments + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) -CALL REFINE_FACE(N_LEVELS-1,N1,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) -CALL REFINE_FACE(N_LEVELS-1,N2,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) -CALL REFINE_FACE(N_LEVELS-1,N3,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) -CALL REFINE_FACE(N_LEVELS-1,N4,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -END SUBROUTINE REFINE_FACE + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) -! ---------------------------- COMPUTE_TEXTURE ---------------------------------------- + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) + ANGSEG(NSEG) = - PI / 2._EB + ENDDO + ENDIF -SUBROUTINE COMPUTE_TEXTURE(XYZ,TEXT_COORDS) -REAL(EB), INTENT(IN), DIMENSION(3) :: XYZ -REAL(EB), INTENT(OUT), DIMENSION(2) :: TEXT_COORDS -REAL(EB), DIMENSION(2) :: ANGLES -REAL(EB) :: NORM2_XYZ, Z_ANGLE + ! High x2 cut-edges: + INDLC(IAXIS:KAXIS) = INDXI4(IAXIS:KAXIS) + IEDG=INDI4; JEDG=INDJ4; KEDG=INDK4 + CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X3AXIS) + IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: + IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X3AXIS) /= CC_SOLID) THEN + ! x,y,z of node 1: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)-1) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -NORM2_XYZ = NORM2(XYZ) -IF (NORM2_XYZ < TWENTY_EPSILON_EB) THEN - Z_ANGLE = 0.0_EB -ELSE - Z_ANGLE = ASIN(XYZ(3)/NORM2_XYZ) -ENDIF -ANGLES = (/ATAN2(XYZ(2),XYZ(1)),Z_ANGLE/) + ! x,y,z of node 2: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) -!convert back to texture coordinates -TEXT_COORDS = (/ 0.5_EB + 0.5_EB*ANGLES(1)/PI,0.5_EB + ANGLES(2)/PI /) -END SUBROUTINE COMPUTE_TEXTURE + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, HIGH_IND, X2AXIS /) + ANGSEG(NSEG) = PI / 2._EB + ENDIF + ELSE ! Cut-edge, load CUT_EDGE(CEI) segments + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) -! ---------------------------- GET_GEOM_ID ---------------------------------------- + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -INTEGER FUNCTION GET_GEOM_ID(ID,N_LAST) + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) -! return the index of the geometry array with label ID + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) + ANGSEG(NSEG) = PI / 2._EB + ENDDO + ENDIF -CHARACTER(30), INTENT(IN) :: ID -INTEGER, INTENT(IN) :: N_LAST + ! Low x3 cut-edges: + INDLC(IAXIS:KAXIS) = INDXI1(IAXIS:KAXIS) + IEDG=INDI1; JEDG=INDJ1; KEDG=INDK1 + CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X2AXIS) + IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: + IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X2AXIS) /= CC_SOLID) THEN + ! x,y,z of node 1: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)-1), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -INTEGER :: N -TYPE(GEOMETRY_TYPE), POINTER :: G + ! x,y,z of node 2: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) -GET_GEOM_ID = 0 -DO N=1,N_LAST - G=>GEOMETRY(N) - IF (TRIM(G%ID)==TRIM(ID)) THEN - GET_GEOM_ID = N - RETURN - ENDIF -ENDDO -END FUNCTION GET_GEOM_ID + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, LOW_IND, X3AXIS /) + ANGSEG(NSEG) = 0._EB + ENDIF + ELSE ! Cut-edge, load CUT_EDGE(CEI) segments + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) -! ---------------------------- GEOMCLIPS ---------------------------------------- + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -SUBROUTINE GEOMCLIPS -USE BOXTETRA_ROUTINES, ONLY : GEOMCLIP -REAL(EB) :: XB(6) -INTEGER :: I -TYPE(GEOMETRY_TYPE), POINTER :: G + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) - ! clip geometries to mesh + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) + ANGSEG(NSEG) = 0._EB + ENDDO + ENDIF -XB(1)=-1.0 -XB(2)=0.0 -XB(3)=-1.0 -XB(4)=0.0 -XB(5)=0.0 -XB(6)=1.0 -DO I = 1, N_GEOMETRY - G=>GEOMETRY(I) - CALL GEOMCLIP(G%VERTS, G%N_VERTS, G%FACES, G%N_FACES, XB) -END DO -END SUBROUTINE GEOMCLIPS + ! High x3 cut-edges: + INDLC(IAXIS:KAXIS) = INDXI2(IAXIS:KAXIS) + IEDG=INDI2; JEDG=INDJ2; KEDG=INDK2 + CEI = MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_IDCE,X2AXIS) + IF ( CEI == 0 ) THEN ! Regular Edge, build segment from grid: + IF (MESHES(NM)%ECVAR(IEDG,JEDG,KEDG,CC_EGSC,X2AXIS) /= CC_SOLID) THEN + ! x,y,z of node 1: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -! ---------------------------- PROCESS_GEOM ---------------------------------------- + ! x,y,z of node 2: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDLC(IAXIS)), & + X2FACE(INDLC(JAXIS)-1), & + X3FACE(INDLC(KAXIS)) /) + X1 = XYZLC(XIAXIS) + X2 = XYZLC(XJAXIS) + X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) -SUBROUTINE PROCESS_GEOM(IS_DYNAMIC,TIME, N_VERTS, N_FACES, N_VOLUS) + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, HIGH_IND, X3AXIS /) + ANGSEG(NSEG) = PI + ENDIF + ELSE ! Cut-edge, load CUT_EDGE(CEI) segments + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) -USE GEOMETRY_FUNCTIONS, ONLY: TRANSFORM_COORDINATES + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) -! transform (scale, rotate and translate) vectors found on each &GEOM line + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) - LOGICAL, INTENT(IN) :: IS_DYNAMIC - REAL(EB), INTENT(IN) :: TIME - INTEGER, INTENT(OUT) :: N_VERTS, N_FACES, N_VOLUS + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) + ANGSEG(NSEG) = PI + ENDDO + ENDIF - INTEGER :: I, IVERT, IMOVE, MOVE_INDEX, IFACE - TYPE(GEOMETRY_TYPE), POINTER :: G - REAL(EB) :: DELTA_T, VEC(1:3) ! M(3,3) - TYPE(MOVEMENT_TYPE), POINTER :: MV + ! Store Segment and Vertex list from Cartesian face boundary: + XYZVERT_CART(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) + SEG_FACE_CART(NOD1:NOD2+3,1:NSEG) = SEG_FACE(NOD1:NOD2+3,1:NSEG) + NVERT_CART=NVERT; NSEG_CART = NSEG - IF (IS_DYNAMIC) THEN - DELTA_T = TIME - T_BEGIN - ELSE - DELTA_T = 0.0_EB - ENDIF + ! 2. CC_INBOUNDARY cut-edges assigned to this face: + CEI = MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) + IF ( CEI > 0 ) THEN ! There are inboundary cut-edges + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) - DO I = 1, N_GEOMETRY - G=>GEOMETRY(I) - IF ((IS_DYNAMIC .AND. G%IS_DYNAMIC) .OR. (.NOT.IS_DYNAMIC .AND. .NOT.G%IS_DYNAMIC)) THEN - G%N_VERTS = G%N_VERTS_BASE - G%N_FACES = G%N_FACES_BASE - G%N_VOLUS = G%N_VOLUS_BASE - ENDIF - ENDDO + IBOD = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) + STYPE = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(5,IEDGE) - DO I = 1, N_GEOMETRY - G=>GEOMETRY(I) - IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE - IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE - MOVE_INDEX = 0 - IF (TRIM(G%MOVE_ID)/='null') THEN - DO IMOVE=1,N_MOVE - IF (TRIM(G%MOVE_ID)==TRIM(MOVEMENT(IMOVE)%ID)) THEN - MOVE_INDEX = MOVEMENT(IMOVE)%INDEX - EXIT - ENDIF - ENDDO - IF (MOVE_INDEX==0) THEN - WRITE(MESSAGE,'(A,A,A)') 'ERROR(725): &GEOM ',TRIM(G%ID),' MOVE_ID is not recognized' - CALL SHUTDOWN(MESSAGE) ; RETURN - ENDIF - DO IVERT=1,G%N_VERTS - VEC(1:3) = G%VERTS_BASE(3*IVERT-2:3*IVERT) - CALL TRANSFORM_COORDINATES(VEC(1),VEC(2),VEC(3),MOVE_INDEX,1) ! Eventually, time varying motion dealt with here. - G%VERTS(3*IVERT-2:3*IVERT) = VEC(1:3) - ENDDO - ! Swap face connectivities if we have reflections: - MV => MOVEMENT(MOVE_INDEX) - IF (MV%DET < -TWENTY_EPSILON_EB) THEN ! Swap vertices 2 and 3: - DO IFACE=1,G%N_FACES - IVERT = G%FACES(3*(IFACE-1)+2) - G%FACES(3*(IFACE-1)+2) = G%FACES(3*(IFACE-1)+3) - G%FACES(3*(IFACE-1)+3) = IVERT - ENDDO - ENDIF - ELSE - DO IVERT=1,G%N_VERTS - G%VERTS(3*IVERT-2:3*IVERT) = G%VERTS_BASE(3*IVERT-2:3*IVERT) - ENDDO - ENDIF + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD1,XYZVERT) - ENDDO + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NVERT,INOD2,XYZVERT) - ! remove this if statement when GEOMCLIPS is ready for use - IF ( I .EQ. 0 ) THEN - CALL GEOMCLIPS - ENDIF + ! ADD segment: + VEC(NOD1:NOD2) = (/ INOD1, INOD2 /) + ! Insertion ADD segment: + INLIST =.FALSE. + DO IDUM = 1,NSEG + IF ( (SEG_FACE(NOD1,IDUM)==VEC(NOD1)) .AND. (SEG_FACE(NOD2,IDUM)==VEC(NOD2)) ) THEN + IF ( (STYPE >= SEGTYPE(IDUM)) .AND. (BODNUM(IDUM) > IBOD) ) THEN + BODNUM(IDUM) = IBOD + SEGTYPE(IDUM)=STYPE + ENDIF + INLIST =.TRUE. + EXIT + ENDIF + IF ( (SEG_FACE(NOD2,IDUM)==VEC(NOD1)) .AND. (SEG_FACE(NOD1,IDUM)==VEC(NOD2)) ) THEN + IF ( (STYPE >= SEGTYPE(IDUM)) .AND. (BODNUM(IDUM) > IBOD) ) THEN + SEG_FACE(NOD1:NOD2,IDUM) = VEC(NOD1:NOD2) + BODNUM(IDUM) = IBOD + SEGTYPE(IDUM) =STYPE + ENDIF + INLIST =.TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ VEC(NOD1:NOD2), CC_ETYPE_CFINB, CEI, IEDGE /) + BODNUM(NSEG) = IBOD + SEGTYPE(NSEG) = STYPE + DX3 = XYZVERT(X3AXIS,INOD2)-XYZVERT(X3AXIS,INOD1) + DX2 = XYZVERT(X2AXIS,INOD2)-XYZVERT(X2AXIS,INOD1) + ANGSEG(NSEG) = ATAN2(DX3,DX2) + ENDIF + ENDDO + ENDIF - CALL GEOM2TEXTURE - N_VERTS = 0 - N_FACES = 0 - N_VOLUS = 0 - DO I = 1, N_GEOMETRY ! count vertices and faces - G=>GEOMETRY(I) - IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE - IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE - N_VERTS = N_VERTS + G%N_VERTS - N_FACES = N_FACES + G%N_FACES - N_VOLUS = N_VOLUS + G%N_VOLUS - ENDDO + ! IF(INDI==14 .AND. INDJ==2 .AND. INDK==5 .AND. X1AXIS==KAXIS) THEN + ! OPEN(666,FILE='VERTS_FC0.txt',STATUS='REPLACE') + ! DO IDUM=1,NVERT + ! WRITE(666,*) XYZVERT(1:3,IDUM) + ! ENDDO + ! CLOSE(666) + ! OPEN(666,FILE='SEGS_FC0.txt',STATUS='REPLACE') + ! DO ISEG=1,NSEG + ! WRITE(666,*) SEG_FACE(NOD1:NOD2,ISEG),ANGSEG(ISEG),SEGTYPE(ISEG) + ! ENDDO + ! CLOSE(666) + ! ENDIF -END SUBROUTINE PROCESS_GEOM + NOTDONE = .TRUE. + DO WHILE(NOTDONE) + NOTDONE = .FALSE. + ! Counts edges that reach nodes: + NUMEDG_NODE(1:CC_MAXVERTS_FACE) = 0 + DO ISEG=1,NSEG + DO II2=NOD1,NOD2 + INOD = SEG_FACE(II2,ISEG) + NUMEDG_NODE(INOD) = NUMEDG_NODE(INOD) + 1 + ENDDO + ENDDO -! ---------------------------- GEOM2TEXTURE ---------------------------------------- + ! Drop segments with NUMEDG_NODE(INOD)=1: + ! The assumption here is that they are CC_GG CC_INBOUNDCF + ! segments with one node inside the Cartface i.e. case Fig + ! 9(a) in the CompGeom3D notes): + COUNT = 0 + SEG_FACEAUX (NOD1:NOD2+3,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED + ANGSEGAUX(1:CC_MAXCEELEM_FACE) = 0._EB + SEGTYPEAUX(1:CC_MAXCEELEM_FACE) = CC_UNDEFINED + DO ISEG=1,NSEG + NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) + NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) + IF ((NUMNOD1 > 1) .AND. (NUMNOD2 > 1)) THEN + COUNT = COUNT + 1 + SEG_FACEAUX(NOD1:NOD2+3,COUNT) = SEG_FACE(NOD1:NOD2+3,ISEG) + ANGSEGAUX(COUNT) = ANGSEG(ISEG) + SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) + ELSE + NOTDONE = .TRUE. + ENDIF + ENDDO + NSEG = COUNT + SEG_FACE = SEG_FACEAUX + ANGSEG = ANGSEGAUX + SEGTYPE = SEGTYPEAUX + ENDDO -SUBROUTINE GEOM2TEXTURE - INTEGER :: I,J,K,JJ - TYPE(GEOMETRY_TYPE), POINTER :: G - REAL(EB), POINTER, DIMENSION(:) :: XYZ, TFACES - INTEGER, POINTER, DIMENSION(:) :: FACES - INTEGER :: SURF_INDEX - TYPE(SURFACE_TYPE), POINTER :: SF + ! Discard face with no conected edges: + IF ( (NSEG==0) .OR. (NSEG==2 .AND. ( ANY(SEG_FACE(NOD1:NOD2,1)==SEG_FACE(NOD2,2)) .AND. & + ANY(SEG_FACE(NOD1:NOD2,1)==SEG_FACE(NOD1,2)) )) ) THEN + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID + CYCLE + ENDIF - DO I = 1, N_GEOMETRY - G=>GEOMETRY(I) - IF (G%TEXTURE_MAPPING/='RECTANGULAR') CYCLE - DO J = 0, G%N_FACES-1 - SURF_INDEX = G%SURFS(1+J) - SF=>SURFACE(SURF_INDEX) - IF (TRIM(SF%TEXTURE_MAP)=='null') CYCLE - FACES(1:3)=>G%FACES(1+3*J:3+3*J) - TFACES(1:6)=>G%TFACES(1+6*J:6+6*J) - DO K = 0, 2 - JJ = FACES(1+K) + ! Add segments which have both ends attached to more than two segs: + count = 0 + DO ISEG=1,NSEG + COUNT = COUNT + 1 + SEG_FACEAUX (NOD1:NOD2+3,COUNT) = SEG_FACE(NOD1:NOD2+3,ISEG) + ANGSEGAUX(COUNT) = ANGSEG(ISEG) + !SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) + IF (SEGTYPE(ISEG)==1) THEN + COUNT = COUNT + 1 + SEG_FACEAUX (NOD1:NOD2+3,COUNT) = SEG_FACE( (/ NOD2, NOD1, 3, 4, 5 /),ISEG) + !SEGTYPEAUX(COUNT)= SEGTYPE(ISEG) + IF (ANGSEG(ISEG) > 0._EB) THEN + ANGSEGAUX(COUNT) = ANGSEG(ISEG) - PI + ELSE + ANGSEGAUX(COUNT) = ANGSEG(ISEG) + PI + ENDIF + ENDIF + ENDDO + NSEG = COUNT + SEG_FACE = SEG_FACEAUX + ANGSEG = ANGSEGAUX + !SEGTYPE = SEGTYPEAUX - XYZ(1:3) => G%VERTS(3*JJ-2:3*JJ) - TFACES(1+2*K:2+2*K) = (XYZ(1:2) - G%TEXTURE_ORIGIN(1:2))/G%TEXTURE_SCALE(1:2) - ENDDO - ENDDO - ENDDO -END SUBROUTINE GEOM2TEXTURE + ! Fill NODEDG_FACE(IEDGE,INOD), where iedge are edges + ! that contain inod as first node. This assumes edges are + ! ordered using the right hand rule on x2-x3 plane. + ! Also compute the edges angles in x2-x3 plane: + ! Reallocate NODEDG_FACE if NSEG+1 > SIZE_EDGES_NODEDG, or NVERT > SIZE_VERTS_NODEDG: + CALL REALLOCATE_NODEDG_FACE(NSEG,NVERT) + NODEDG_FACE(:,:) = 0 + DO ISEG=1,NSEG + INOD1 = SEG_FACE(NOD1,ISEG) + NEDI = NODEDG_FACE(1,INOD1) + 1 ! Increase number of edges connected to node by 1. + NODEDG_FACE( 1,INOD1) = NEDI + NODEDG_FACE(NEDI+1,INOD1) = ISEG + ENDDO -! ---------------------------- MERGE_GEOMS ---------------------------------------- + ! Now Reorder Segments, do tests: + SEG_FACE2(NOD1:NOD3+1,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED ! [INOD1 INOD2 ICF] + SEG_FLAG(1:CC_MAXCEELEM_FACE) = .TRUE. -SUBROUTINE MERGE_GEOMS(VERTS,N_VERTS,FACES,TFACES,GEOM_IDS,SURF_IDS,N_FACES,VOLUS,MATL_IDS,N_VOLUS,IS_DYNAMIC) + ICF = 1 + ISEG = 1 + NEWSEG = ISEG + COUNT= 1 + CTSTART=COUNT + SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG), SEG_FACE(NOD2,NEWSEG), ICF, NEWSEG /) + SEG_FLAG(ISEG) = .FALSE. + NSEG_LEFT = NSEG - 1 -! combine vectors and faces found on all &GEOM lines into one set of VECTOR and FACE arrays + ! Infamous infinite loop: + INF_LOOP : DO -INTEGER, INTENT(IN) :: N_VERTS, N_FACES, N_VOLUS -LOGICAL, INTENT(IN) :: IS_DYNAMIC -REAL(EB), DIMENSION(:), INTENT(OUT) :: VERTS(3*N_VERTS), TFACES(6*N_FACES) -INTEGER, DIMENSION(:), INTENT(OUT) :: FACES(3*N_FACES), VOLUS(4*N_VOLUS), MATL_IDS(N_VOLUS), GEOM_IDS(N_FACES), SURF_IDS(N_FACES) + FOUNDSEG = .FALSE. + N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. + ANGCOUNT = ANGSEG(NEWSEG) -INTEGER :: I -TYPE(GEOMETRY_TYPE), POINTER :: G -INTEGER :: IVERT, ITFACE, IFACE, IVOLUS, IMATL, IGEOM, ISURF, OFFSET + ! Find Segment starting on Node 2 with smaller ANGSEG respect to COUNT. + DANG = -1._EB / GEOMEPS + DO ISS=2,NODEDG_FACE(1,N2COUNT)+1 + ISEG = NODEDG_FACE(ISS,N2COUNT) + IF ( SEG_FLAG(ISEG) ) THEN ! This seg hasn't been added to SEG_FACE2 + ! Drop if seg is the opposite of count seg, only when 2nd node is connected to more than 2 segments: + IF ( (SEG_FACE2(NOD1,COUNT)==SEG_FACE(NOD2,ISEG)) .AND. (NUMEDG_NODE(N2COUNT)>2) ) CYCLE + DANGI = ANGSEG(ISEG) - ANGCOUNT + IF ( DANGI < 0._EB ) DANGI = DANGI + 2._EB * PI + IF ( DANGI > DANG ) THEN + NEWSEG = ISEG + DANG = DANGI + FOUNDSEG = .TRUE. + ENDIF + ENDIF + ENDDO -IVERT = 0 -ITFACE = 0 -IFACE = 0 -IVOLUS = 0 -IGEOM = 0 -ISURF = 0 -IMATL = 0 -OFFSET = 0 -DO I = 1, N_GEOMETRY - G=>GEOMETRY(I) - IF (G%IS_DYNAMIC .AND. .NOT.IS_DYNAMIC) CYCLE - IF (.NOT.G%IS_DYNAMIC .AND. IS_DYNAMIC) CYCLE + ! Found a seg add to SEG_FACE2: + IF ( FOUNDSEG ) THEN + COUNT = COUNT + 1 + SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG),SEG_FACE(NOD2,NEWSEG),ICF,NEWSEG /) + SEG_FLAG(NEWSEG) = .FALSE. + NSEG_LEFT = NSEG_LEFT - 1 + ENDIF - IF (G%N_VERTS>0) THEN - VERTS(1+IVERT:3*G%N_VERTS+IVERT) = G%VERTS(1:3*G%N_VERTS) - IVERT = IVERT + 3*G%N_VERTS - ENDIF - IF (G%N_FACES>0) THEN - FACES(1+IFACE:3*G%N_FACES + IFACE) = G%FACES(1:3*G%N_FACES)+OFFSET - IFACE = IFACE + 3*G%N_FACES + ! Test if line has closed on point shared any other cutface: + IF ( SEG_FACE2(NOD2,COUNT) == SEG_FACE2(NOD1,CTSTART) ) THEN + ! Go for new cut-face on this Cartesian face. + ELSEIF ( FOUNDSEG ) THEN + CYCLE + ENDIF - TFACES(1+ITFACE:6*G%N_FACES + ITFACE) = G%TFACES(1:6*G%N_FACES) - ITFACE = ITFACE + 6*G%N_FACES + ! Break loop: + IF ( NSEG_LEFT == 0 ) EXIT - GEOM_IDS(1+IGEOM:G%N_FACES+IGEOM) = I - IGEOM = IGEOM + G%N_FACES + ! Start a new cut-face on this Cartesian face: + ICF = ICF + 1 + DO ISEG=1,NSEG + IF ( SEG_FLAG(ISEG) ) THEN + COUNT = COUNT + 1 + CTSTART= COUNT + SEG_FACE2((/NOD1,NOD2,NOD3,NOD3+1/),COUNT) = (/ SEG_FACE(NOD1,ISEG), SEG_FACE(NOD2,ISEG), ICF, ISEG /) + SEG_FLAG(ISEG) = .FALSE. + NSEG_LEFT = NSEG_LEFT - 1 + EXIT + ENDIF + ENDDO - SURF_IDS(1+ISURF:G%N_FACES+ISURF) = G%SURFS(1:G%N_FACES) - ISURF = ISURF + G%N_FACES - ENDIF - IF (G%N_VOLUS>0) THEN - VOLUS(1+IVOLUS:4*G%N_VOLUS + IVOLUS) = G%VOLUS(1:4*G%N_VOLUS)+OFFSET - IVOLUS = IVOLUS + 4*G%N_VOLUS + ENDDO INF_LOOP - MATL_IDS(1+IMATL:G%N_VOLUS+IMATL) = G%MATLS(1:G%N_VOLUS) - IMATL = IMATL + G%N_VOLUS - ENDIF - OFFSET = OFFSET + G%N_VERTS -ENDDO + ! Load ordered nodes to CFELEM: + NFACE = ICF + ! Reallocate CFELEM ARRAY if necessary: + CALL REALLOCATE_LOCAL_CFELEM(NSEG,NFACE) + CFELEM(:,:) = CC_UNDEFINED; CEDGES(:,:) = CC_UNDEFINED + DO ICF=1,NFACE + NP = 0 + DO ISEG=1,NSEG + IF ( SEG_FACE2(NOD3,ISEG) == ICF ) THEN + NP = NP + 1 + CFELEM(1,ICF) = NP + CFELEM(NP+1,ICF) = SEG_FACE2(NOD1,ISEG) + CEDGES(1,ICF) = CFELEM(1,ICF); CEDGES(NP+1,ICF) = SEG_FACE2(NOD3+1,ISEG) ! Index in SEG_FACE. + ENDIF + ENDDO + ENDDO -END SUBROUTINE MERGE_GEOMS + ALLOCATE(CFELEM2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CFELEM2 = CC_UNDEFINED + ALLOCATE(CEDGES2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CEDGES2 = CC_UNDEFINED + NP=0 + DO ICF=1,NFACE + IF(CFELEM(1,ICF)>2) THEN + NP=NP+1 + CFELEM2(:,NP) = CFELEM(:,ICF) + CEDGES2(:,NP) = CEDGES(:,ICF) + ENDIF + ENDDO + CALL MOVE_ALLOC(FROM=CFELEM2,TO=CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES2,TO=CEDGES) + NFACE = NP -! ---------------------------- CONVERTGEOM ---------------------------------------- + ! Compute area and Centroid, in local x1, x2, x3 coords: + ALLOCATE(DROPFACE(1:NFACE)); DROPFACE=.FALSE. + AREAV(1:NFACE) = 0._EB + XYZCEN(IAXIS:KAXIS,1:NFACE) = 0._EB + INXAREA(IAXIS:KAXIS,1:NFACE) = 0._EB + INXSQAREA(IAXIS:KAXIS,1:NFACE) = 0._EB + DO ICF=1,NFACE + NP = CFELEM(1,ICF) + DO IPT=2,NP+1 + ICF_PT = CFELEM(IPT,ICF) + ! Define closed Polygon centered in First Point: + XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & + XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) + ENDDO + ICF_PT = CFELEM(2,ICF) + XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & + XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) -SUBROUTINE CONVERTGEOM(TIME) + ! Get Area and Centroid properties of Cut-face: + AREA = 0._EB + DO II2=1,NP + AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & + XY(JAXIS,II2) * XY(IAXIS,II2+1) ) + ENDDO + AREA = AREA / 2._EB + IF ( (AREA dot(e2,nc)=0: + INXSQAREA(JAXIS,ICF) = 0._EB + ! dot(e3,nc)*int(x3^2)dA, where nc=e1 => dot(e3,nc)=0: + INXSQAREA(KAXIS,ICF) = 0._EB -N_VERTS = N_VERTS_S + N_VERTS_D -N_FACES = N_FACES_S + N_FACES_D -N_VOLUS = N_VOLUS_S + N_VOLUS_D + ENDDO + + ALLOCATE(CFELEM2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CFELEM2 = CC_UNDEFINED + ALLOCATE(CEDGES2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CEDGES2 = CC_UNDEFINED + NP=0 + DO ICF=1,NFACE + IF(.NOT.DROPFACE(ICF)) THEN + NP=NP+1 + CFELEM2(:,NP) = CFELEM(:,ICF) + CEDGES2(:,NP) = CEDGES(:,ICF) + ENDIF + ENDDO + CALL MOVE_ALLOC(FROM=CFELEM2,TO=CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES2,TO=CEDGES) + DEALLOCATE(DROPFACE) + IF (NP==0) THEN + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID + CYCLE + ENDIF + NFACE = NP -ALLOCATE(VERTS(MAX(1,3*N_VERTS)),STAT=IZERO) ! create arrays to contain all vertices and faces -CALL ChkMemErr('CONVERTGEOM','VERTS',IZERO) + ! Figure out if a cut-face is completely inside any of the + ! others (that is, it is a hole on the GASPHASE): + FINFACE = 0 + NFACE2 = NFACE + DO ICF1=1,NFACE2 + ! Test that ICF1 has a negative area (case of holes) + AREA1 = AREAV(ICF1) + IF ( AREA1 < -GEOMEPS ) THEN + DO ICF2=1,NFACE2 + ! Drop if same face: + IF ( ICF1 == ICF2 ) CYCLE -ALLOCATE(TFACES(MAX(1,6*N_FACES)),STAT=IZERO) ! create arrays to contain all vertices and faces -CALL ChkMemErr('CONVERTGEOM','TVERTS',IZERO) + ! Centroid node for ICF1: + XYC1(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF1 ) ! [x2axis x3axis] -ALLOCATE(FACES(MAX(1,3*N_FACES)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','FACES',IZERO) + ! Polygon nodes for ICF2: + NP2 = CFELEM(1,ICF2) + DO IPT=2,NP2+1 + ICF_PT = CFELEM(IPT,ICF2) + ! Define closed Polygon: + XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) + ENDDO -ALLOCATE(SURF_IDS(MAX(1,N_FACES)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','SURF_IDS',IZERO) + CALL TEST_PT_INPOLY(NP2,XY,XYC1,PTSFLAG) -ALLOCATE(GEOM_IDS(MAX(1,N_FACES)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','SURF_IDS',IZERO) + IF ( PTSFLAG ) THEN ! Centroid of face 1 inside Face 2. -ALLOCATE(VOLUS(MAX(1,4*N_VOLUS)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','VOLUS',IZERO) + FINFACE(ICF1) = ICF2 + NFACE = NFACE - 1 -ALLOCATE(MATL_IDS(MAX(1,N_VOLUS)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','MATL_IDS',IZERO) + ! Redefine areas in case of faces with holes: + AREA2 = AREAV(ICF2) -IF (N_VERTS_S>0 .AND. (N_FACES_S>0 .OR. N_VOLUS_S>0)) THEN ! merge static geometry - CALL MERGE_GEOMS(VERTS(1:3*N_VERTS_S),N_VERTS_S,& - FACES(1:3*N_FACES_S),TFACES(1:3*N_FACES_S),GEOM_IDS(1:N_FACES_S),SURF_IDS(1:N_FACES_S),N_FACES_S,& - VOLUS(1:3*N_VOLUS_S),MATL_IDS(1:N_VOLUS_S),N_VOLUS_S,.FALSE.) -ENDIF -IF (N_VERTS_D>0 .AND. (N_FACES_D>0 .OR. N_VOLUS_D>0)) THEN ! merge dynamic geometry - CALL MERGE_GEOMS(VERTS(3*N_VERTS_S+1:3*N_VERTS),N_VERTS_D,& - FACES(3*N_FACES_S+1:3*N_FACES),TFACES(3*N_FACES_S+1:3*N_FACES),GEOM_IDS,SURF_IDS(N_FACES_S+1:N_FACES),N_FACES_D,& - VOLUS(3*N_VOLUS_S+1:3*N_VOLUS),MATL_IDS(N_VOLUS_S+1:N_VOLUS),N_VOLUS_D,.TRUE.) -ENDIF + ! Area with hole, AREA1 has negative sign: + AREAH = AREA2 + AREA1 -RETURN -END SUBROUTINE CONVERTGEOM + IF (ABS(AREAH) < GEOMEPS) THEN ! Hole of same size as cut-face, drop both. + FINFACE(ICF2) = ICF1 + CYCLE + ENDIF -! ---------------------------- REORDER_FACE ---------------------------------------- + ! Centroid with hole: + XYC2(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF2 ) ! [x2axis x3axis] + XYH(1:2) = (AREA1 * XYC1(1:2) + AREA2 * XYC2(1:2)) / AREAH -SUBROUTINE REORDER_VERTS(VERTS) -! the VERTS triplet V1, V2, V3 defines a face -! reorder V1,V2,V3 so that V1 has the smallest index -INTEGER, INTENT(INOUT) :: VERTS(3) + ! So ICF2 has the area with hole properties: + AREAV(ICF2) = AREAH + XYZCEN(JAXIS,ICF2) = XYH(IAXIS) + XYZCEN(KAXIS,ICF2) = XYH(JAXIS) -INTEGER :: VERTS_TEMP(5) + ! Other geom variables: + INXAREA(IAXIS:KAXIS,ICF2) = INXAREA(IAXIS:KAXIS,ICF2)+ INXAREA(IAXIS:KAXIS,ICF1) + INXSQAREA(IAXIS:KAXIS,ICF2)=INXSQAREA(IAXIS:KAXIS,ICF2)+INXSQAREA(IAXIS:KAXIS,ICF1) -IF ( VERTS(1) 0 ) THEN ! Allows for up to one hole per CC_GASPHASE cut-face. + ! Load points + NP1 = CFELEM(1,ICF1) + NP2 = CFELEM(1,ICF2) + NP = (NP1+1) + (NP2+1) -IF (VERTS(2) SIZE_VERTS_CFELEM: + CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) + CFE(1) = NP -! ---------------------------- OUTGEOM ---------------------------------------- + DO II2=2,NP1+1 + CFE(II2) = CFELEM(II2,ICF1) + ENDDO + II2 = (NP1+1) + 1 + CFE(II2) = CFELEM(2,ICF1) -SUBROUTINE OUTGEOM(LUNIT,LUNIT2,IS_DYNAMIC,TIME,APPLY_TRAN,TRAN) - INTEGER, INTENT(IN) :: LUNIT, LUNIT2 - REAL(EB), INTENT(IN) :: TIME - TYPE(TRANSFORM_TYPE), POINTER, INTENT(IN) :: TRAN - LOGICAL, INTENT(IN) :: IS_DYNAMIC, APPLY_TRAN - INTEGER :: N_VERTS, N_FACES, N_VOLUS - INTEGER :: I - INTEGER, ALLOCATABLE, DIMENSION(:) :: FACES, VOLUS, MATL_IDS, GEOM_IDS, SURF_IDS - REAL(EB), ALLOCATABLE, DIMENSION(:) :: VERTS, TFACES - INTEGER :: IZERO + ! Load last point location: + ILOC = 2 + DIST12 = 1._EB / GEOMEPS + XYC1(1:2) = (/ XYZVERT(X2AXIS,CFE(II2)), XYZVERT(X3AXIS,CFE(II2)) /) + DO COUNT=2,NP2+1 + XYC2(1:2) = (/ XYZVERT(X2AXIS,CFELEM(COUNT,ICF2)), XYZVERT(X3AXIS,CFELEM(COUNT,ICF2)) /) + D12 = SQRT( (XYC1(1)-XYC2(1))**2._EB + (XYC1(2)-XYC2(2))**2._EB ) + IF( D12 < DIST12 ) THEN + DIST12 = D12 + ILOC = COUNT + ENDIF + ENDDO + IF (ILOC > 2) THEN + ! Rebuild CFELEM(:,ICF2) such that the first point is ILOC: + CFEL(2:2+(NP2+1)-ILOC) = CFELEM(ILOC:NP2+1,ICF2) + CFEL(3+(NP2+1)-ILOC:NP2+1)= CFELEM(2:ILOC-1 ,ICF2) + CFELEM(2:NP2+1 ,ICF2) = CFEL(2:NP2+1) + CFEL(2:2+(NP2+1)-ILOC) = CEDGES(ILOC:NP2+1,ICF2) + CFEL(3+(NP2+1)-ILOC:NP2+1)= CEDGES(2:ILOC-1 ,ICF2) + CEDGES(2:NP2+1 ,ICF2) = CFEL(2:NP2+1) + ENDIF - CALL PROCESS_GEOM(IS_DYNAMIC,TIME,N_VERTS, N_FACES, N_VOLUS) ! scale, rotate, translate GEOM vertices + COUNT = 1 + DO II2=(NP1+1)+2,(NP1+1)+1+NP2 + COUNT = COUNT + 1 + CFE(II2) = CFELEM(COUNT,ICF2) + ENDDO + II2 = NP + 1 + CFE(II2) = CFELEM(2,ICF2) - ALLOCATE(VERTS(MAX(1,3*N_VERTS)),STAT=IZERO) ! create arrays to contain all vertices and faces - CALL ChkMemErr('OUTGEOM','VERTS',IZERO) + ! Copy CFE into CFELEM(1:np+1,icf2): + CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) - ALLOCATE(TFACES(MAX(1,6*N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','VERTS',IZERO) + ! Rearrange CEDGES + CFEL(1) = NP + CFEL(2:NP1+1) = CEDGES(2:NP1+1,ICF1) + CFEL(NP1+2) = 0 ! ENTRY 0 in EDGE_LIST, EDGE inside the SOLID. + CFEL(NP1+3:NP1+2+NP2)= CEDGES(2:NP2+1,ICF2) + CFEL(NP+1) = 0 ! ENTRY 0 in EDGE_LIST, EDGE inside the SOLID. + CEDGES(1:NP+1,ICF2) = CFEL(1:NP+1) - ALLOCATE(FACES(MAX(1,3*N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','FACES',IZERO) + ENDIF + ENDDO - ALLOCATE(GEOM_IDS(MAX(1,N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','GEOM_IDS',IZERO) + NVERTFACE = MAXVAL(CFELEM(1,1:NFACE)) + 1 - ALLOCATE(SURF_IDS(MAX(1,N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','SURF_IDS',IZERO) + ! This is a cut-face, allocate space: + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (BNDINT_FLAG) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCF,X1AXIS) = NCUTFACE - ALLOCATE(VOLUS(MAX(1,4*N_VOLUS)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','VOLUS',IZERO) + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) - ALLOCATE(MATL_IDS(MAX(1,N_VOLUS)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','MATL_IDS',IZERO) + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ INDI, INDJ, INDK, X1AXIS /) + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE,IBNDINT) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) + ALLOCATE(CF%EDGE_LIST(3,0:NSEG)); + CF%EDGE_LIST( : , 0) = CC_UNDEFINED ! Segment inside the solid volume. + CF%EDGE_LIST(1:3,1:NSEG) = SEG_FACE(3:5,1:NSEG) + ALLOCATE(CF%CEDGES(SIZE(CEDGES,DIM=1),SIZE(CEDGES,DIM=2))) + CF%CEDGES = CC_UNDEFINED + ! Load Ordered nodes to CFELEM and geom properties: + COUNT = 0 + DO ICF=1,NFACE2 + IF ( FINFACE(ICF) > 0 ) CYCLE ! icf is a hole on another cut-face. + COUNT = COUNT + 1 + ! Connectivity: + CF%CFELEM(1:NVERTFACE,COUNT) = CFELEM(1:NVERTFACE, ICF) + CF%CEDGES(1:NVERTFACE,COUNT) = CEDGES(1:NVERTFACE, ICF) + ! Geom Properties: + CF%AREA(COUNT) = AREAV(ICF) + CF%XYZCEN(IAXIS:KAXIS,COUNT) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,ICF) + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: + CF%INXAREA(COUNT) = INXAREA(XIAXIS,ICF) + ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: + CF%INXSQAREA(COUNT) = INXSQAREA(XIAXIS,ICF) + ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: + CF%JNYSQAREA(COUNT) = INXSQAREA(XJAXIS,ICF) + ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: + CF%KNZSQAREA(COUNT) = INXSQAREA(XKAXIS,ICF) + ENDDO + ! Final number of cut-faces in the gas region of the face: + NFACE = COUNT + CF%NFACE = NFACE - IF (N_VERTS>0 .AND. (N_FACES>0 .OR. N_VOLUS>0)) THEN - CALL MERGE_GEOMS(VERTS,N_VERTS,FACES,TFACES,GEOM_IDS,SURF_IDS,N_FACES,VOLUS,MATL_IDS,N_VOLUS,IS_DYNAMIC) - ENDIF + ! ! Test that cut-edge nodes in EDGE list match nodes defined in CF XYZVERT: + ! IIF= CF%IJK(IAXIS) + ! JJF= CF%IJK(JAXIS) + ! KKF= CF%IJK(KAXIS) + ! DO ICF = 1, CF%NFACE + ! DO ISEG=1,CF%CEDGES(1,ICF) + ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) + ! IF (ISEGGEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN + ! WRITE(LU_ERR,*) 'Found difference in RGGAS SEGMENT=',NCUTFACE,ICF,ISEG,':',X1AXIS,AXIS,SIDE + ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) + ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) + ! ENDIF + ! CASE(CC_ETYPE_CFGAS) + ! IEC=CF%EDGE_LIST(2,IEDGE); JEC=CF%EDGE_LIST(3,IEDGE) + ! INOD1 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(1,JEC) + ! INOD2 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(2,JEC) + ! CEIJK(1:4) = MESHES(NM)%CUT_EDGE(IEC)%IJK(1:4) + ! SELECT CASE(X1AXIS) + ! CASE(IAXIS) + ! IF (CEIJK(4)==JAXIS) THEN + ! IF(CEIJK(KAXIS)==KKF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ELSEIF(CEIJK(KAXIS)==KKF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ENDIF + ! ELSEIF(CEIJK(4)==KAXIS) THEN + ! IF(CEIJK(JAXIS)==JJF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ELSEIF(CEIJK(JAXIS)==JJF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ENDIF + ! ENDIF + ! CASE(JAXIS) + ! IF (CEIJK(4)==IAXIS) THEN + ! IF(CEIJK(KAXIS)==KKF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ELSEIF(CEIJK(KAXIS)==KKF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ENDIF + ! ELSEIF(CEIJK(4)==KAXIS) THEN + ! IF(CEIJK(IAXIS)==IIF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ELSEIF(CEIJK(IAXIS)==IIF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ENDIF + ! ENDIF + ! CASE(KAXIS) + ! IF (CEIJK(4)==IAXIS) THEN + ! IF(CEIJK(JAXIS)==JJF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ELSEIF(CEIJK(JAXIS)==JJF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ENDIF + ! ELSEIF(CEIJK(4)==JAXIS) THEN + ! IF(CEIJK(IAXIS)==IIF-1) THEN ! LOW_IND + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! ELSEIF(CEIJK(IAXIS)==IIF) THEN ! HIGH_SIDE + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! ENDIF + ! ENDIF + ! END SELECT + ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN + ! WRITE(LU_ERR,*) 'Found difference in CFGAS SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC + ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) + ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) + ! ENDIF + ! CASE(CC_ETYPE_CFINB) + ! IEC=CF%EDGE_LIST(2,IEDGE); JEC=CF%EDGE_LIST(3,IEDGE) + ! INOD1 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(1,JEC) + ! INOD2 = MESHES(NM)%CUT_EDGE(IEC)%CEELEM(2,JEC) + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! IF(NORM2(X1E-X1V)>GEOMEPS) THEN + ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT + ! ENDIF + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN + ! WRITE(LU_ERR,*) 'CARTF Found difference in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC + ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) + ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) + ! ENDIF + ! END SELECT + ! ENDDO + ! ENDDO - WRITE(LUNIT) REAL(TIME,FB) - WRITE(LUNIT) N_VERTS, N_FACES, N_VOLUS - IF (N_VERTS>0) THEN - IF (APPLY_TRAN) THEN - DO I = 1, N_VERTS - VERTS(3*I) = VERTS(3*I) + TRAN%Z_OFFSET - ENDDO - ENDIF - WRITE(LUNIT) (REAL(VERTS(I),FB), I=1,3*N_VERTS) - ENDIF - IF (N_FACES>0) THEN - WRITE(LUNIT) (FACES(I), I=1,3*N_FACES) - WRITE(LUNIT) (SURF_IDS(I), I=1,N_FACES) - WRITE(LUNIT) (REAL(TFACES(I),FB), I=1,6*N_FACES) + ! HERE WE LOAD CARTESIAN CUT FACES THAT BELONG TO THE SOLID REGION, FOR SLICE PLOTTING + ! PURPOSES: + ! ------------------------------------------------------------------------------------ + SOLID_FACE_IF : IF (GET_SOLID_CUTFACES) THEN + ! Build segment list: + NSSEG = 0 + NSVERT = 0 + NSFACE = 0 - WRITE(LUNIT2) N_FACES - WRITE(LUNIT2) (GEOM_IDS(I), I=1,N_FACES) - ENDIF - IF (N_VOLUS>0) THEN - WRITE(LUNIT) (VOLUS(I), I=1,4*N_VOLUS) - WRITE(LUNIT) (MATL_IDS(I), I=1,N_VOLUS) - ENDIF + SEG_FACE (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED + XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) = 0._EB + ANGSEG(1:CC_MAXCEELEM_FACE) = 0._EB -END SUBROUTINE OUTGEOM + ! First Add to vertex list INBOUNDARY vertices and SOLID Cartesian vertices: + CEI = MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) + IF ( CEI > 0 ) THEN ! There are inboundary cut-edges + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) -! ---------------------------- WRITE_GEOM_ALL ------------------------------------ + ! Here we use the SOLID orientation NOD1:NOD2 for right hand rule (inverse of GASPHASE cut-faces) + ! x,y,z of node 1: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) -SUBROUTINE WRITE_GEOM_ALL -CALL WRITE_GEOM(T_BEGIN) ! write out both static and dynamic data at t=T_BEGIN -END SUBROUTINE WRITE_GEOM_ALL + ! x,y,z of node 2: + XYZV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD2,XYZVERT) -! ---------------------------- WRITE_GEOM ---------------------------------------- + ! ADD segment: + NSSEG = NSSEG + 1 + SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ INOD1, INOD2 /) + DX3 = XYZVERT(X3AXIS,INOD2)-XYZVERT(X3AXIS,INOD1) + DX2 = XYZVERT(X2AXIS,INOD2)-XYZVERT(X2AXIS,INOD1) + ANGSEG(NSSEG) = ATAN2(DX3,DX2) -SUBROUTINE WRITE_GEOM(TIME) + ENDDO + ENDIF -! output geometries to a .ge file + ! Now add CC_SOLID Type vertices: + ! Vertex at index JJ-1,KK-1: + INDXI1(IAXIS:KAXIS) = (/ II, JJ-1, KK-1 /) ! Local x1,x2,x3 + INDI1 = INDXI1(XIAXIS) + INDJ1 = INDXI1(XJAXIS) + INDK1 = INDXI1(XKAXIS) + ! Vertex at index JJ,KK-1: + INDXI2(IAXIS:KAXIS) = (/ II, JJ , KK-1 /) ! Local x1,x2,x3 + INDI2 = INDXI2(XIAXIS) + INDJ2 = INDXI2(XJAXIS) + INDK2 = INDXI2(XKAXIS) + ! Vertex at index JJ,KK: + INDXI3(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 + INDI3 = INDXI3(XIAXIS) + INDJ3 = INDXI3(XJAXIS) + INDK3 = INDXI3(XKAXIS) + ! Vertex at index JJ-1,KK: + INDXI4(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 + INDI4 = INDXI4(XIAXIS) + INDJ4 = INDXI4(XJAXIS) + INDK4 = INDXI4(XKAXIS) -REAL(EB), INTENT(IN) :: TIME -INTEGER :: ONE=1, ZERO=0, VERSION=2 -TYPE(TRANSFORM_TYPE), POINTER :: T + IF(MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID ) THEN + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI1(IAXIS)), X2FACE(INDXI1(JAXIS)), X3FACE(INDXI1(KAXIS)) /) + X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) + ENDIF -IF (N_GEOMETRY<=0) RETURN + IF(MESHES(NM)%VERTVAR(INDI2,INDJ2,INDK2,CC_VGSC) == CC_SOLID ) THEN + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI2(IAXIS)), X2FACE(INDXI2(JAXIS)), X3FACE(INDXI2(KAXIS)) /) + X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) + ENDIF -IF (WRITE_GEOM_FIRST) THEN - OPEN(LU_GEOM(1),FILE=TRIM(FN_GEOM(1)),FORM='UNFORMATTED',STATUS='REPLACE') - OPEN(LU_GEOM(2),FILE=TRIM(FN_GEOM(2)),FORM='UNFORMATTED',STATUS='REPLACE') - WRITE(LU_GEOM(1)) ONE - WRITE(LU_GEOM(1)) VERSION - WRITE(LU_GEOM(1)) ZERO, ZERO, ONE ! n floats, n ints, first frame static - CALL OUTGEOM(LU_GEOM(1),LU_GEOM(2),.FALSE.,TIME,.FALSE.,T) ! write out static data -ELSE - OPEN(LU_GEOM(1),FILE=TRIM(FN_GEOM(1)),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND') - OPEN(LU_GEOM(2),FILE=TRIM(FN_GEOM(2)),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND') -ENDIF -CALL OUTGEOM(LU_GEOM(1),LU_GEOM(2),.TRUE.,TIME,.FALSE.,T) ! write out dynamic data -CLOSE(LU_GEOM(1)) -CLOSE(LU_GEOM(2)) + IF(MESHES(NM)%VERTVAR(INDI3,INDJ3,INDK3,CC_VGSC) == CC_SOLID ) THEN + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI3(IAXIS)), X2FACE(INDXI3(JAXIS)), X3FACE(INDXI3(KAXIS)) /) + X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) + ENDIF -WRITE_GEOM_FIRST = .FALSE. + IF(MESHES(NM)%VERTVAR(INDI4,INDJ4,INDK4,CC_VGSC) == CC_SOLID ) THEN + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI4(IAXIS)), X2FACE(INDXI4(JAXIS)), X3FACE(INDXI4(KAXIS)) /) + X1 = XYZLC(XIAXIS); X2 = XYZLC(XJAXIS); X3 = XYZLC(XKAXIS) + XYZV(IAXIS:KAXIS) = (/ X1, X2, X3 /) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZV,NSVERT,INOD1,XYZVERT) + ENDIF -END SUBROUTINE WRITE_GEOM + ! Make List of HIGH X2 vertices, in ascending X3 order. Add segments: + ASCDESC=.TRUE. + XVERT1(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) + XVERT2(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) + CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X2FACE(JJ),ASCDESC,NV,V) + DO IV=1,NV-1 + NSSEG=NSSEG + 1 + SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) + ANGSEG(NSSEG) = PI / 2._EB + ENDDO + ! Make list of HIGH X3 vertices, in descending X2 order. Add segments: + ASCDESC=.FALSE. + XVERT1(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) + XVERT2(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) + CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X3FACE(KK),ASCDESC,NV,V) + DO IV=1,NV-1 + NSSEG=NSSEG + 1 + SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) + ANGSEG(NSSEG) = PI + ENDDO -! ---------------------------- TRIANGLE_AREA ---------------------------------------- + ! Make list of LOW X2 vertices, in descending X3 order. Add segments: + ASCDESC=.FALSE. + XVERT1(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) + XVERT2(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) + CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X2FACE(JJ-1),ASCDESC,NV,V) + DO IV=1,NV-1 + NSSEG=NSSEG + 1 + SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) + ANGSEG(NSSEG) = - PI / 2._EB + ENDDO -REAL(EB) FUNCTION TRIANGLE_AREA(V1,V2,V3) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT + ! Make list of LOW X3 vertices, in ascending X2 order. Add segments: + ASCDESC=.TRUE. + XVERT1(1:NSVERT) = XYZVERT(X3AXIS,1:NSVERT) + XVERT2(1:NSVERT) = XYZVERT(X2AXIS,1:NSVERT) + CALL SORT_VERTS(CC_MAXVERTS_FACE,NSVERT,XVERT1,XVERT2,X3FACE(KK-1),ASCDESC,NV,V) + DO IV=1,NV-1 + NSSEG=NSSEG + 1 + SEG_FACE((/NOD1,NOD2/),NSSEG) = (/ V(IV), V(IV+1) /) + ANGSEG(NSSEG) = 0._EB + ENDDO -REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3) -REAL(EB) :: N(3),R1(3),R2(3) + ! Use list of segments on gasphase region from CUT_EDGE: + ! These are to discard from SEGS computed before: + COUNT=0 + SEG_FACEAUX(NOD1:NOD2,1:NSSEG) = SEG_FACE(NOD1:NOD2,1:NSSEG) + ANGSEGAUX(1:NSSEG)=ANGSEG(1:NSSEG) + SEG_FLAG(1:NSSEG) = .FALSE. + OUTER : DO ISEG=1,NSSEG + ! Test against GASPHASE segments: + INNER1 : DO ISEG2=1,NSEG_CART + SNOD1(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG) + SNOD2(NOD1:NOD2)= SEG_FACE_CART(NOD1:NOD2,ISEG2) + XYZ_SEG1(IAXIS:KAXIS,NOD1:NOD2) = XYZVERT(IAXIS:KAXIS,SNOD1(NOD1:NOD2)) + XYZ_SEG2(IAXIS:KAXIS,NOD1:NOD2) = XYZVERT_CART(IAXIS:KAXIS,SNOD2(NOD1:NOD2)) + ! Test for possible node combination: + DO INOD=1,4 + INOD1=NODC1(INOD) ! [ 1 2 1 2 ] + INOD2=NODC2(INOD) ! [ 1 2 2 1] + DIFF(INOD) = SQRT((XYZ_SEG1(IAXIS,INOD1)-XYZ_SEG2(IAXIS,INOD2))**2._EB + & + (XYZ_SEG1(JAXIS,INOD1)-XYZ_SEG2(JAXIS,INOD2))**2._EB + & + (XYZ_SEG1(KAXIS,INOD1)-XYZ_SEG2(KAXIS,INOD2))**2._EB ) < GEOMEPS + ENDDO + IF(DIFF(1) .AND. DIFF(2)) SEG_FLAG(ISEG)=.TRUE. ! Nodes of two segs coincide, its a GASPHASE segment. + IF(DIFF(3) .AND. DIFF(4)) SEG_FLAG(ISEG)=.TRUE. ! Nodes of two segs coincide, its a GASPHASE segment. + ENDDO INNER1 + ! Test against itself: + INNER2 : DO ISEG2=1,NSSEG + IF (ISEG==ISEG2) CYCLE + SNOD1(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG) + SNOD2(NOD1:NOD2)= SEG_FACEAUX(NOD1:NOD2,ISEG2) + IF(SNOD1(NOD1)==SNOD2(NOD2) .AND. SNOD1(NOD2)==SNOD2(NOD1)) SEG_FLAG(ISEG)=.TRUE. + ENDDO INNER2 + ENDDO OUTER + DO ISEG=1,NSSEG + IF(SEG_FLAG(ISEG)) CYCLE + COUNT=COUNT+1 + SEG_FACE(NOD1:NOD2,COUNT)=SEG_FACEAUX(NOD1:NOD2,ISEG) + ANGSEG(COUNT) = ANGSEGAUX(ISEG) + ENDDO -R1 = V2-V1 -R2 = V3-V1 -CALL CROSS_PRODUCT(N,R1,R2) + NSSEG=COUNT -TRIANGLE_AREA = 0.5_EB*NORM2(N) + ! Build Solid side faces: + NOTDONE = .TRUE. + DO WHILE(NOTDONE) + NOTDONE = .FALSE. + ! Counts edges that reach nodes: + NUMEDG_NODE(1:CC_MAXVERTS_FACE) = 0 + DO ISEG=1,NSSEG + DO II2=NOD1,NOD2 + INOD = SEG_FACE(II2,ISEG) + NUMEDG_NODE(INOD) = NUMEDG_NODE(INOD) + 1 + ENDDO + ENDDO -END FUNCTION TRIANGLE_AREA + ! Drop segments with NUMEDG_NODE(INOD)=1: + ! The assumption here is that they are CC_SS CC_INBOUNDCF + ! segments with one node inside the Cartface i.e. case Fig + ! 9(a) in the CompGeom3D notes): + COUNT = 0 + SEG_FACEAUX (NOD1:NOD2,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED + ANGSEGAUX(1:CC_MAXCEELEM_FACE) = 0._EB + DO ISEG=1,NSSEG + NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) + NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) + IF ((NUMNOD1 > 1) .AND. (NUMNOD2 > 1)) THEN + COUNT = COUNT + 1 + SEG_FACEAUX(NOD1:NOD2,COUNT) = SEG_FACE(NOD1:NOD2,ISEG) + ANGSEGAUX(COUNT) = ANGSEG(ISEG) + ELSE + NOTDONE = .TRUE. + ENDIF + ENDDO + NSSEG = COUNT + SEG_FACE = SEG_FACEAUX + ANGSEG = ANGSEGAUX + ENDDO + ! Discard face with less than 3 edges (triangle): + IF ( NSSEG < 3 ) CYCLE -! ---------------------------- POINT_IN_BOX_2D ---------------------------------------- + ! Add segments which have both ends attached to more than two segs: + count = 0 + DO ISEG=1,NSSEG + NUMNOD1 = NUMEDG_NODE(SEG_FACE(NOD1,ISEG)) + NUMNOD2 = NUMEDG_NODE(SEG_FACE(NOD2,ISEG)) + IF ((NUMNOD1 > 2) .AND. (NUMNOD2 > 2)) THEN + COUNT = COUNT + 1 + SEG_FACE(NOD1:NOD2,NSSEG+COUNT) = SEG_FACE( (/ NOD2, NOD1 /) ,ISEG) + IF (ANGSEG(ISEG) >= 0._EB) THEN + ANGSEG(NSSEG+COUNT) = ANGSEG(ISEG) - PI + ELSE + ANGSEG(NSSEG+COUNT) = ANGSEG(ISEG) + PI + ENDIF + ENDIF + ENDDO + NSSEG = NSSEG + COUNT -LOGICAL FUNCTION POINT_IN_BOX_2D(P,BB,IOR) + ! Fill NODEDG_FACE(IEDGE,INOD), where iedge are edges + ! that contain inod as first node. This assumes edges are + ! ordered using the right hand rule on x2-x3 plane. + ! Also compute the edges angles in x2-x3 plane + CALL REALLOCATE_NODEDG_FACE(NSSEG,NSVERT) + NODEDG_FACE(:,:) = 0 + DO ISEG=1,NSSEG + INOD1 = SEG_FACE(NOD1,ISEG) + NEDI = NODEDG_FACE(1,INOD1) + 1 ! Increase number of edges connected to node by 1. + NODEDG_FACE( 1,INOD1) = NEDI + NODEDG_FACE(NEDI+1,INOD1) = ISEG + ENDDO -REAL(EB), INTENT(IN) :: P(3),BB(6) -INTEGER, INTENT(IN) :: IOR + ! Now Reorder Segments, do tests: + SEG_FACE2(NOD1:NOD3,1:CC_MAXCEELEM_FACE) = CC_UNDEFINED ! [INOD1 INOD2 ICF] + SEG_FLAG(1:CC_MAXCEELEM_FACE) = .TRUE. -POINT_IN_BOX_2D=.FALSE. + ICF = 1 + ISEG = 1 + NEWSEG = ISEG + COUNT= 1 + CTSTART=COUNT + SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG),SEG_FACE(NOD2,NEWSEG),ICF /) + SEG_FLAG(ISEG) = .FALSE. + NSEG_LEFT = NSSEG - 1 -SELECT CASE(ABS(IOR)) - CASE(1) ! YZ plane - IF ( P(2)>=BB(3) .AND. P(2)<=BB(4) .AND. & - P(3)>=BB(5) .AND. P(3)<=BB(6) ) POINT_IN_BOX_2D=.TRUE. - CASE(2) ! XZ plane - IF ( P(1)>=BB(1) .AND. P(1)<=BB(2) .AND. & - P(3)>=BB(5) .AND. P(3)<=BB(6) ) POINT_IN_BOX_2D=.TRUE. - CASE(3) ! XY plane - IF ( P(1)>=BB(1) .AND. P(1)<=BB(2) .AND. & - P(2)>=BB(3) .AND. P(2)<=BB(4) ) POINT_IN_BOX_2D=.TRUE. -END SELECT + ! Infamous infinite loop: + INF_LOOP2 : DO -END FUNCTION POINT_IN_BOX_2D + FOUNDSEG = .FALSE. + N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. + ANGCOUNT = ANGSEG(NEWSEG) -! ---------------------------- POINT_IN_TETRAHEDRON ---------------------------------------- + ! Find Segment starting on Node 2 with smaller ANGSEG respect to COUNT. + DANG = -1._EB / GEOMEPS + DO ISS=2,NODEDG_FACE(1,N2COUNT)+1 + ISEG = NODEDG_FACE(ISS,N2COUNT) + IF ( SEG_FLAG(ISEG) ) THEN ! This seg hasn't been added to SEG_FACE2 + ! Drop if seg is the opposite of count seg: + IF ( SEG_FACE2(NOD1,COUNT) == SEG_FACE(NOD2,ISEG) ) CYCLE + DANGI = ANGSEG(ISEG) - ANGCOUNT + IF ( DANGI < 0._EB ) DANGI = DANGI + 2._EB * PI -LOGICAL FUNCTION POINT_IN_TETRAHEDRON(XP,V1,V2,V3,V4,BB) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT + IF ( DANGI > DANG ) THEN + NEWSEG = ISEG + DANG = DANGI + FOUNDSEG = .TRUE. + ENDIF + ENDIF + ENDDO -REAL(EB), INTENT(IN) :: XP(3),V1(3),V2(3),V3(3),V4(3),BB(6) -REAL(EB) :: U_VEC(3),V_VEC(3),N_VEC(3),Q_VEC(3),R_VEC(3) -INTEGER :: I + ! Found a seg add to SEG_FACE2: + IF ( FOUNDSEG ) THEN + COUNT = COUNT + 1 + SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,NEWSEG), SEG_FACE(NOD2,NEWSEG), ICF /) + SEG_FLAG(NEWSEG) = .FALSE. + NSEG_LEFT = NSEG_LEFT - 1 + ENDIF -! In this routine, we test all four faces of the tet volume defined by the points X(i),Y(i),Z(i); i=1:4. -! If the point is on the negative side of all the faces, it is inside the volume. + ! Test if line has closed on point shared any other cutface: + IF ( SEG_FACE2(NOD2,COUNT) == SEG_FACE2(NOD1,CTSTART) ) THEN + ! Go for new cut-face on this Cartesian face. + ELSEIF ( FOUNDSEG ) THEN + CYCLE + ENDIF -POINT_IN_TETRAHEDRON=.FALSE. + ! Break loop: + IF ( NSEG_LEFT == 0 ) EXIT -! first test bounding box + ! Start a new cut-face on this Cartesian face: + ICF = ICF + 1 + DO ISEG=1,NSSEG + IF ( SEG_FLAG(ISEG) ) THEN + COUNT = COUNT + 1 + CTSTART= COUNT + SEG_FACE2((/NOD1,NOD2,NOD3/),COUNT) = (/ SEG_FACE(NOD1,ISEG), SEG_FACE(NOD2,ISEG), ICF /) + SEG_FLAG(ISEG) = .FALSE. + NSEG_LEFT = NSEG_LEFT - 1 + EXIT + ENDIF + ENDDO -IF (XP(1)BB(2)) RETURN -IF (XP(2)BB(4)) RETURN -IF (XP(3)BB(6)) RETURN + ENDDO INF_LOOP2 -POINT_IN_TETRAHEDRON=.TRUE. + ! Load ordered nodes to CFELEM: + NSFACE = ICF + ! Reallocate CFELEM ARRAY if necessary: + CALL REALLOCATE_LOCAL_CFELEM(NSSEG,NSFACE) + CFELEM(:,:) = CC_UNDEFINED + COUNT = 0 + DO ICF=1,NSFACE + NP = 0 + DO ISEG=1,NSSEG + IF ( SEG_FACE2(NOD3,ISEG) == ICF ) NP = NP + 1 + ENDDO + IF (NP < 3) CYCLE ! Drop face if it has less than 2 3 vertices + COUNT=COUNT+1 + NP = 0 + DO ISEG=1,NSSEG + IF ( SEG_FACE2(NOD3,ISEG) == ICF ) THEN + NP = NP + 1 + CFELEM(1,COUNT) = NP + CFELEM(NP+1,COUNT) = SEG_FACE2(NOD1,ISEG) + ENDIF + ENDDO + ! Does Face Have zero Area? If so drop, rewind: + DO IPT=2,NP+1 + ICF_PT = CFELEM(IPT,COUNT) + ! Define closed Polygon: + XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) + ENDDO + ICF_PT = CFELEM(2,COUNT) + XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) ! Close Polygon. + AREA = 0._EB + DO II2=1,NP + AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & + XY(JAXIS,II2) * XY(IAXIS,II2+1) ) + ENDDO + IF (ABS(AREA) < GEOMEPS**2._EB) THEN + CFELEM(:,COUNT) = CC_UNDEFINED + COUNT = COUNT - 1 + ENDIF + ENDDO + NSFACE = COUNT; IF(NSFACE==0) CYCLE -FACE_LOOP: DO I=1,4 + ! Compute area and Centroid, in local x1, x2, x3 coords: + ALLOCATE(DROPFACE(1:NSFACE)); DROPFACE=.FALSE. + AREAV(1:NSFACE) = 0._EB + XYZCEN(IAXIS:KAXIS,1:NSFACE) = 0._EB + DO ICF=1,NSFACE + NP = CFELEM(1,ICF) + DO IPT=2,NP+1 + ICF_PT = CFELEM(IPT,ICF) + ! Define closed Polygon centered in First Point: + XY((/IAXIS,JAXIS/),IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & + XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) + ENDDO + ICF_PT = CFELEM(2,ICF) + XY((/IAXIS,JAXIS/),NP+1) = (/ XYZVERT(X2AXIS,ICF_PT)-XYZVERT(X2AXIS,CFELEM(2,ICF)), & + XYZVERT(X3AXIS,ICF_PT)-XYZVERT(X3AXIS,CFELEM(2,ICF)) /) - SELECT CASE(I) - CASE(1) - ! vertex ordering = 1,2,3,4 - Q_VEC = XP-(/V1(1),V1(2),V1(3)/) ! form a vector from a point on the triangular surface to the point XP - R_VEC = (/V4(1),V4(2),V4(3)/)-(/V1(1),V1(2),V1(3)/) ! vector from the tri to other point of volume defining inside - U_VEC = (/V2(1)-V1(1),V2(2)-V1(2),V2(3)-V1(3)/) ! vectors forming the sides of the triangle - V_VEC = (/V3(1)-V1(1),V3(2)-V1(2),V3(3)-V1(3)/) - CASE(2) - ! vertex ordering = 1,3,4,2 - Q_VEC = XP-(/V1(1),V1(2),V1(3)/) - R_VEC = (/V2(1),V2(2),V2(3)/)-(/V1(1),V1(2),V1(3)/) - U_VEC = (/V3(1)-V1(1),V3(2)-V1(2),V3(3)-V1(3)/) - V_VEC = (/V4(1)-V1(1),V4(2)-V1(2),V4(3)-V1(3)/) - CASE(3) - ! vertex ordering = 1,4,2,3 - Q_VEC = XP-(/V1(1),V1(2),V1(3)/) - R_VEC = (/V2(1),V2(2),V2(3)/)-(/V1(1),V1(2),V1(3)/) - U_VEC = (/V4(1)-V1(1),V4(2)-V1(2),V4(3)-V1(3)/) - V_VEC = (/V2(1)-V1(1),V2(2)-V1(2),V2(3)-V1(3)/) - CASE(4) - ! vertex ordering = 2,4,3,1 - Q_VEC = XP-(/V2(1),V2(2),V2(3)/) - R_VEC = (/V1(1),V1(2),V1(3)/)-(/V2(1),V2(2),V2(3)/) - U_VEC = (/V4(1)-V2(1),V4(2)-V2(2),V4(3)-V2(3)/) - V_VEC = (/V3(1)-V2(1),V3(2)-V2(2),V3(3)-V2(3)/) - END SELECT + ! Get Area and Centroid properties of Cut-face: + AREA = 0._EB + DO II2=1,NP + AREA = AREA + ( XY(IAXIS,II2) * XY(JAXIS,II2+1) - & + XY(JAXIS,II2) * XY(IAXIS,II2+1) ) + ENDDO + AREA = AREA / 2._EB + IF ( (AREATWENTY_EPSILON_EB ) THEN - POINT_IN_TETRAHEDRON=.FALSE. - RETURN - ENDIF + ! Add to cut-face: + AREAV(ICF) = AREA + XYZCEN((/IAXIS,JAXIS,KAXIS/),ICF) = (/ X1FACE(II), CX2, CX3 /) -ENDDO FACE_LOOP + ENDDO -END FUNCTION POINT_IN_TETRAHEDRON + ALLOCATE(CFELEM2(SIZE(CFELEM,DIM=1),SIZE(CFELEM,DIM=2))); CFELEM2 = CC_UNDEFINED + NP=0 + DO ICF=1,NSFACE + IF(.NOT.DROPFACE(ICF)) THEN + NP=NP+1 + CFELEM2(:,NP) = CFELEM(:,ICF) + ENDIF + ENDDO + CFELEM = CFELEM2 + DEALLOCATE(CFELEM2,DROPFACE) + IF (NP==0) CYCLE + NSFACE = NP + ! Figure out if a cut-face is completely inside any of the + ! others (that is, it is a hole on the GASPHASE): + FINFACE = 0 + NSFACE2 = NSFACE + DO ICF1=1,NSFACE2 + ! Test that ICF1 has a negative area (case of holes) + AREA1 = AREAV(ICF1) + IF ( AREA1 < -GEOMEPS ) THEN + DO ICF2=1,NSFACE2 + ! Drop if same face: + IF ( ICF1 == ICF2 ) CYCLE -! ---------------------------- VALID_TRIANGLE ---------------------------------------- + ! Centroid node for ICF1: + XYC1(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF1 ) ! [x2axis x3axis] -LOGICAL FUNCTION VALID_TRIANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3,VERT_FLAG) + ! Polygon nodes for ICF2: + NP2 = CFELEM(1,ICF2) + DO IPT=2,NP2+1 + ICF_PT = CFELEM(IPT,ICF2) + ! Define closed Polygon: + XY(IAXIS:JAXIS,IPT-1) = (/ XYZVERT(X2AXIS,ICF_PT), XYZVERT(X3AXIS,ICF_PT) /) + ENDDO -INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3, VERT_FLAG(0:300) -REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) + CALL TEST_PT_INPOLY(NP2,XY,XYC1,PTSFLAG) -REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB -REAL(FB), POINTER, DIMENSION(:) :: V, V1, V2, V3 -REAL(FB) :: U1(3), U2(3), U1XU2, D123 + IF ( PTSFLAG ) THEN ! Centroid of face 1 inside Face 2. -INTEGER :: I + FINFACE(ICF1) = ICF2 + NSFACE = NSFACE - 1 -VALID_TRIANGLE = .FALSE. + ! Redefine areas in case of faces with holes: + AREA2 = AREAV(ICF2) -V1(1:3)=>VERTS(3*IV1-2:3*IV1) -V2(1:3)=>VERTS(3*IV2-2:3*IV2) -V3(1:3)=>VERTS(3*IV3-2:3*IV3) + ! Area with hole, AREA1 has negative sign: + AREAH = AREA2 + AREA1 -U1 = V2 - V1; -U2 = V3 - V2; + IF (ABS(AREAH) < GEOMEPS) THEN ! Hole of same size as cut-face, drop both. + FINFACE(ICF2) = ICF1 + CYCLE + ENDIF -! triangle is invalid if angle at V2 is > 180 deg + ! Centroid with hole: + XYC2(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF2 ) ! [x2axis x3axis] + XYH(1:2) = (AREA1 * XYC1(1:2) + AREA2 * XYC2(1:2)) / AREAH -IF(DIR==1) THEN - U1(1) = U1(2) - U1(2) = U1(3) - U2(1) = U2(2) - U2(2) = U2(3) -ELSE IF(DIR==2) THEN - U1(2) = U1(1) - U1(1) = U1(3) - U2(2) = U2(1) - U2(1) = U2(3) -ELSE - U1(1) = U1(1) - U1(2) = U1(2) - U2(1) = U2(1) - U2(2) = U2(2) -ENDIF -U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize -U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize -U1XU2 = U1(1)*U2(2)-U1(2)*U2(1) ! U1 x U2 -IF (U1XU2 < EPS_FB) RETURN + ! So ICF2 has the area with hole properties: + AREAV(ICF2) = AREAH + XYZCEN(JAXIS,ICF2) = XYH(IAXIS) + XYZCEN(KAXIS,ICF2) = XYH(JAXIS) + EXIT + ENDIF + ENDDO + ENDIF + ENDDO -DO I = 1, NVERTS - IF (VERT_FLAG(I) == 0) CYCLE - IF (I == IV1 .OR. I == IV2 .OR.I == IV3 ) CYCLE - V(1:3)=>VERTS(3*I-2:3*I) - ! These CYCLE tests are done to treat holes properly: - D123=SQRT( (V(1)-V1(1))**2._FB + (V(2)-V1(2))**2._FB + (V(3)-V1(3))**2._FB ) - IF (D123 < EPS_FB) CYCLE - D123=SQRT( (V(1)-V2(1))**2._FB + (V(2)-V2(2))**2._FB + (V(3)-V2(3))**2._FB ) - IF (D123 < EPS_FB) CYCLE - D123=SQRT( (V(1)-V3(1))**2._FB + (V(2)-V3(2))**2._FB + (V(3)-V3(3))**2._FB ) - IF (D123 < EPS_FB) CYCLE - IF (POINT_IN_TRIANGLE_FB(V, V1, V2, V3)) RETURN -ENDDO + ! Now enhance CFELEM for faces with holes nodes: + DO ICF1=1,NSFACE2 + ICF2 = FINFACE(ICF1) + IF ( ICF2 > 0 ) THEN ! Allows for up to one hole per CC_GASPHASE cut-face. + ! Load points + NP1 = CFELEM(1,ICF1) + NP2 = CFELEM(1,ICF2) + NP = (NP1+1) + (NP2+1) -VALID_TRIANGLE = .TRUE. -END FUNCTION VALID_TRIANGLE + ! Here reallocate CFELEM, CFE, CFEL if NP > SIZE_VERTS_CFELEM: + CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) + CFE(1) = NP -! ----------------------------- DIFF_ANGLE ----------------------------------------- + DO II2=2,np1+1 + CFE(II2) = CFELEM(II2,icf1) + ENDDO + II2 = (np1+1) + 1 + CFE(II2) = CFELEM(2,icf1) -LOGICAL FUNCTION DIFF_ANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3, ABS_FLG) + COUNT = 1 + DO II2=(NP1+1)+2,(NP1+1)+1+NP2 + COUNT = COUNT + 1 + CFE(II2) = CFELEM(COUNT,ICF2) + ENDDO + II2 = NP + 1 + CFE(II2) = CFELEM(2,ICF2) -INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3 -REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) -LOGICAL, INTENT(IN) :: ABS_FLG + ! Copy CFE into CFELEM(1:np+1,icf2): + CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) -REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB -REAL(FB), PARAMETER :: EPS_MID= 1.E-4_FB -REAL(FB), POINTER, DIMENSION(:) :: V1, V2, V3 -REAL(FB) :: U1(3), U2(3), CRPD(3), NORMU(2) -LOGICAL :: TEST_FLAG=.FALSE. + ENDIF + ENDDO -DIFF_ANGLE = .FALSE. + NVERTFACE = MAXVAL(CFELEM(1,1:NSFACE2)) + 1 -V1(1:3)=>VERTS(3*IV1-2:3*IV1) -V2(1:3)=>VERTS(3*IV2-2:3*IV2) -V3(1:3)=>VERTS(3*IV3-2:3*IV3) + ! Up to this point we have all SOLID side cut-faces in CFELEM, SOLID_SIDE nodes in XYZVERT and + ! Area properties: Add these to Existing CUT_FACE info: + MESHES(NM)%CUT_FACE(NCUTFACE)%NSVERT = NSVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NSFACE = NSFACE + CALL FACE_REALLOC(NM,NCUTFACE,NVERT,NFACE,NSVERT,NSFACE,NVERTFACE) + MESHES(NM)%CUT_FACE(NCUTFACE)%XYZVERT(IAXIS:KAXIS,NVERT+1:NVERT+NSVERT)=XYZVERT(IAXIS:KAXIS,1:NSVERT) -U1 = V2 - V1; -U2 = V3 - V2; + ! Load Ordered nodes to CFELEM and geom properties: + COUNT = NFACE + DO ICF=1,NSFACE2 + IF ( FINFACE(ICF) > 0 ) CYCLE ! icf is a hole on another cut-face. + COUNT = COUNT + 1 + ! Connectivity: + NV=CFELEM(1, ICF) + CFELEM(2:NV+1,ICF)=CFELEM(2:NV+1,ICF) + NVERT ! Re-index to total number of vertices. + MESHES(NM)%CUT_FACE(NCUTFACE)%CFELEM(1:NVERTFACE,COUNT) = CFELEM(1:NVERTFACE, ICF) + ! Geom Properties SOLID: + MESHES(NM)%CUT_FACE(NCUTFACE)%AREA(COUNT) = AREAV(ICF) + MESHES(NM)%CUT_FACE(NCUTFACE)%XYZCEN(IAXIS:KAXIS,COUNT) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,ICF) + ENDDO + ! Final number of cut-faces in the solid region of the face: + MESHES(NM)%CUT_FACE(NCUTFACE)%NSFACE = COUNT-NFACE -NORMU(1)=SQRT(U1(1)**2._FB+U1(2)**2._FB+U1(3)**2._FB) -NORMU(2)=SQRT(U2(1)**2._FB+U2(2)**2._FB+U2(3)**2._FB) + ENDIF SOLID_FACE_IF -IF(ANY(NORMU(1:2) 180 deg -SELECT CASE(DIR) -CASE(IAXIS) - U1(1) = U1(2) - U1(2) = U1(3) - U2(1) = U2(2) - U2(2) = U2(3) -CASE(JAXIS) - U1(2) = U1(1) - U1(1) = U1(3) - U2(2) = U2(1) - U2(1) = U2(3) -CASE(KAXIS) - U1(1) = U1(1) - U1(2) = U1(2) - U2(1) = U2(1) - U2(2) = U2(2) -CASE(0) ! 3D Cross for Inboundary faces: - U1(1:3) = U1(1:3) / NORMU(1) ! Normalize - U2(1:3) = U2(1:3) / NORMU(2) ! Normalize - CRPD(1) = U1(2)*U2(3)-U1(3)*U2(2) - CRPD(2) = U1(3)*U2(1)-U1(1)*U2(3) - CRPD(3) = U1(1)*U2(2)-U1(2)*U2(1) - ! ABS_FLG always .TRUE. in the 3D case: - IF (SQRT(CRPD(1)**2._FB+CRPD(2)**2._FB+CRPD(3)**2._FB) < EPS_FB) DIFF_ANGLE = .TRUE. - RETURN -END SELECT + DEALLOCATE(X1FACE,X2FACE,X3FACE) -U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize -U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize -IF (ABS_FLG) THEN - TEST_FLAG=ABS(U1(1)*U2(2)-U1(2)*U2(1)) < EPS_MID -ELSE - TEST_FLAG= U1(1)*U2(2)-U1(2)*U2(1) < EPS_FB -ENDIF -IF (TEST_FLAG) DIFF_ANGLE = .TRUE. + ENDDO XIAXIS_LOOP -RETURN +ENDDO IBNDINT_LOOP -END FUNCTION DIFF_ANGLE +IF (BNDINT_FLAG) THEN + ! Here we mark faces on the guard-cell region for the computaiton of grid aligned INBOUNDARY faces + ! on CARTCELL_CUTFACES to work correctly: + XIAXIS_LOOP_2 : DO X1AXIS=IAXIS,KAXIS -! ---------------------------- POINT_IN_TRIANGLE_FB ---------------------------------------- + SELECT CASE(X1AXIS) + case(IAXIS) -LOGICAL FUNCTION POINT_IN_TRIANGLE_FB(P_FB,V1_FB,V2_FB,V3_FB) + X2AXIS = JAXIS + X3AXIS = KAXIS -REAL(FB), INTENT(IN) :: P_FB(3),V1_FB(3),V2_FB(3),V3_FB(3) -REAL(EB) :: P_EB(3),V1_EB(3),V2_EB(3),V3_EB(3) + ! IAXIS gasphase cut-faces: + ILO = ILO_FACE-CCGUARD; IHI = IHI_FACE+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD - P_EB = REAL( P_FB,EB) -V1_EB = REAL(V1_FB,EB) -V2_EB = REAL(V2_FB,EB) -V3_EB = REAL(V3_FB,EB) -POINT_IN_TRIANGLE_FB = POINT_IN_TRIANGLE(P_EB,V1_EB,V2_EB,V3_EB) + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS -END FUNCTION POINT_IN_TRIANGLE_FB + ! Local indexing in x1, x2, x3: + X1LO = ILO; X1HI = IHI + X2LO = JLO; X2HI = JHI + X3LO = KLO; X3HI = KHI -! ---------------------------- POINT_IN_TRIANGLE ---------------------------------------- + CASE(JAXIS) -LOGICAL FUNCTION POINT_IN_TRIANGLE(P,V1,V2,V3) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT + X2AXIS = KAXIS + X3AXIS = IAXIS -REAL(EB), INTENT(IN) :: P(3),V1(3),V2(3),V3(3) -REAL(EB) :: E(3),E1(3),E2(3),N(3),R(3),Q(3) -INTEGER :: I -REAL(EB), PARAMETER :: EPS=1.E-16_EB + ! JAXIS gasphase cut-faces: + JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD -! This routine tests whether the projection of P, in the plane normal -! direction, onto to the plane defined by the triangle (V1,V2,V3) is -! inside the triangle. + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS -POINT_IN_TRIANGLE=.TRUE. ! start by assuming the point is inside + ! Local indexing in x1, x2, x3: + X1LO = JLO; X1HI = JHI + X2LO = KLO; X2HI = KHI + X3LO = ILO; X3HI = IHI -! compute face normal -E1 = V2-V1 -E2 = V3-V1 -CALL CROSS_PRODUCT(N,E1,E2) + CASE(KAXIS) -EDGE_LOOP: DO I=1,3 - SELECT CASE(I) - CASE(1) - E = V2-V1 - R = P-V1 - CASE(2) - E = V3-V2 - R = P-V2 - CASE(3) - E = V1-V3 - R = P-V3 - END SELECT - CALL CROSS_PRODUCT(Q,E,R) - IF ( DOT_PRODUCT(Q,N) < -EPS ) THEN - POINT_IN_TRIANGLE=.FALSE. - RETURN - ENDIF -ENDDO EDGE_LOOP + X2AXIS = IAXIS + X3AXIS = JAXIS -END FUNCTION POINT_IN_TRIANGLE + ! KAXIS gasphase cut-faces: + KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD -! ---------------------------- TRIANGULATE ---------------------------------------- + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS -SUBROUTINE TRIANGULATE(DIR,VERTS,NVERTS,VERT_OFFSET,FACES,LOCTYPE) + ! Local indexing in x1, x2, x3: + X1LO = KLO; X1HI = KHI + X2LO = ILO; X2HI = IHI + X3LO = JLO; X3HI = JHI -INTEGER, INTENT(IN) :: DIR, NVERTS, VERT_OFFSET -REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) -INTEGER, INTENT(OUT) :: FACES(3*(NVERTS-2)) -INTEGER, INTENT(OUT) :: LOCTYPE(NVERTS-2) + END SELECT -INTEGER :: IFACE, NLIST, NLIST_OLD -INTEGER :: VERT_LIST(0:1024), VERT_FLAG(0:1023), EDGE_LIST(2,1:1024) -LOGICAL :: NODE_EXISTS(1024) -INTEGER :: IM1, I, IP1, V0, V1, V2, IVERT, IEDGE -LOGICAL HAVE_TRIANGLE -REAL(FB), POINTER, DIMENSION(:) :: VV1, VV2, VV3 -REAL(FB) :: U1(3), U2(3), U1XU2 -REAL(FB), PARAMETER :: EPS_FB = 1.E-7_FB -INTEGER :: NBIG_ANGLES, VERT_START -LOGICAL :: VERT_DROPPED, FLAG + ! Loop on Cartesian faces, local x1, x2, x3 indexes: + DO II=X1LO,X1HI + DO KK=X3LO,X3HI + DO JJ=X2LO,X2HI -INTEGER :: HIDEDGE(3), EDGEI(1:2), NVERTS2, NEDGES, COUNT -INTEGER, PARAMETER :: SHFT_NODE(1:4) = (/ 2, 1, 0, 2 /) + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI = INDXI(XIAXIS) + INDJ = INDXI(XJAXIS) + INDK = INDXI(XKAXIS) -INTEGER :: COUNT_OUT + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE -FLAG = .TRUE. + ! Drop if face not cut-face: + ! Test for FACE Cartesian edges being cut: + ! If outface1 is true -> All regular edges for this face: + ! Edge at index KK-1: + INDXI1(IAXIS:KAXIS) = (/ II, JJ , KK-1 /) ! Local x1,x2,x3 + INDI1 = INDXI1(XIAXIS) + INDJ1 = INDXI1(XJAXIS) + INDK1 = INDXI1(XKAXIS) + ! Edge at index KK: + INDXI2(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 + INDI2 = INDXI2(XIAXIS) + INDJ2 = INDXI2(XJAXIS) + INDK2 = INDXI2(XKAXIS) + ! Edge at index JJ-1: + INDXI3(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 + INDI3 = INDXI3(XIAXIS) + INDJ3 = INDXI3(XJAXIS) + INDK3 = INDXI3(XKAXIS) + ! Edge at index jj: + INDXI4(IAXIS:KAXIS) = (/ II, JJ , KK /) ! Local x1,x2,x3 + INDI4 = INDXI4(XIAXIS) + INDJ4 = INDXI4(XJAXIS) + INDK4 = INDXI4(XKAXIS) -! Drop vertices that are repeated, close verts in EB precision that are fused in FB: -VERT_FLAG(1:NVERTS)=1 -I = 1 -VV1(1:3)=>VERTS(3*NVERTS-2:3*NVERTS) -VV2(1:3)=>VERTS(3*I-2:3*I) -IF ( ABS(VV1(1)-VV2(1))+ABS(VV1(2)-VV2(2))+ABS(VV1(3)-VV2(3)) < 10._FB*EPS_FB) VERT_FLAG(I)=0 -DO I = 2, NVERTS - VV1(1:3)=>VERTS(3*(I-1)-2:3*(I-1)) - VV2(1:3)=>VERTS(3*I-2:3*I) - IF ( ABS(VV1(1)-VV2(1))+ABS(VV1(2)-VV2(2))+ABS(VV1(3)-VV2(3)) < 10._FB*EPS_FB) VERT_FLAG(I)=0 -ENDDO -NLIST = SUM(VERT_FLAG(1:NVERTS)) -NVERTS2= NLIST -COUNT = 0 -DO I = 1, NVERTS - IF(VERT_FLAG(I)==0) CYCLE - COUNT= COUNT + 1 - VERT_LIST(COUNT) = I -ENDDO -VERT_LIST(0) = VERT_LIST(NLIST) -VERT_LIST(NLIST+1) = VERT_LIST(1) + OUTFACE1 = (MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) /= CC_CUTCFE) .AND. & + (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) /= CC_CUTCFE) -! Now drop vertices contained whithin lines of the polygon: -DO I=1,NLIST - IM1 = VERT_LIST(I-1) - IVERT = VERT_LIST(I) - IP1 = VERT_LIST(I+1) - IF ( DIFF_ANGLE(DIR,VERTS,NVERTS,IM1,IVERT,IP1,.TRUE.) ) VERT_FLAG(IVERT)=0 -ENDDO + ! Test for face with INB edges: + ! If outface2 is true -> no INB Edges associated with this face: + OUTFACE2 = (MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCE,X1AXIS) <= 0) -! Redo List: -NLIST = SUM(VERT_FLAG(1:NVERTS)) + ! Drop if outface1 & outface2 + IF (OUTFACE1 .AND. OUTFACE2) THEN + ! Test if face is SOLID: + IF ((MESHES(NM)%ECVAR(INDI1,INDJ1,INDK1,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI2,INDJ2,INDK2,CC_EGSC,X2AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI3,INDJ3,INDK3,CC_EGSC,X3AXIS) == CC_SOLID) .AND. & + (MESHES(NM)%ECVAR(INDI4,INDJ4,INDK4,CC_EGSC,X3AXIS) == CC_SOLID) ) THEN + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_SOLID + ENDIF + CYCLE + ENDIF -IF (NLIST < 3) THEN - FACES(1:3*(NVERTS-2)) = VERT_OFFSET + 1 - LOCTYPE(1:NVERTS-2) = 4+8+16 - RETURN -ENDIF + ENDDO ! JJ + ENDDO ! KK + ENDDO ! II -NVERTS2= NLIST -NEDGES = NLIST -COUNT = 0 -DO I = 1, NVERTS - IF(VERT_FLAG(I)==0) CYCLE - COUNT= COUNT + 1 - VERT_LIST(COUNT) = I -ENDDO -VERT_LIST(0) = VERT_LIST(NLIST) -VERT_LIST(NLIST+1) = VERT_LIST(1) -NODE_EXISTS(1:NLIST+1) = .TRUE. -DO I = 1, NLIST-1 - EDGE_LIST((/1,2/),I) = (/ VERT_LIST(I), VERT_LIST(I+1) /) -ENDDO -EDGE_LIST((/1,2/),NLIST) = (/ VERT_LIST(NEDGES), VERT_LIST(1) /) -FACES(1:3*(NVERTS-2)) = VERT_OFFSET+VERT_LIST(NLIST) + ENDDO XIAXIS_LOOP_2 -IF (DIR == 0) THEN ! INBOUNDARY cut-face, always convex polygon. - VERT_START = VERT_LIST(1) - IFACE = 0 - DO I = 1, NVERTS2 - IP1 = I + 1 - IF (I==NVERTS2) IP1=1 - IF (I==VERT_START .OR. IP1==VERT_START) CYCLE - FACES(3*IFACE+1) = VERT_OFFSET+VERT_LIST(VERT_START) - FACES(3*IFACE+2) = VERT_OFFSET+VERT_LIST(I) - FACES(3*IFACE+3) = VERT_OFFSET+VERT_LIST(IP1) - IFACE = IFACE + 1 - ENDDO - ! Here test edges to define LOCTYPE: - LOCTYPE(:) = 4+8+16 - DO IFACE=1,NVERTS2-2 - HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. - DO IEDGE=1,3 - ! Nodes i,i+1: - EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) - DO I=1,NEDGES - IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN - HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. - EXIT - ENDIF - ENDDO - ENDDO - LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) - ENDDO - RETURN +ELSE + DEALLOCATE(IJK_COUNTED) ENDIF -IF (FLAG) THEN ! find number of angles > 180 deg - NBIG_ANGLES = 0 - VERT_START = VERT_LIST(1) - DO I = 1, NVERTS2 - IM1 = I - 1 - IF (I==1)IM1 = NVERTS2 - IP1 = I + 1 - IF (I==NVERTS2)IP1 = 1 - IF ( DIFF_ANGLE(DIR,VERTS,NVERTS,VERT_LIST(IM1),VERT_LIST(I),VERT_LIST(IP1),.FALSE.) ) THEN - NBIG_ANGLES = NBIG_ANGLES + 1 - VERT_START = I - ENDIF - END DO +DEALLOCATE(NODEDG_FACE) +DEALLOCATE(CFELEM,CEDGES,CFE,CFEL) - ! if 0 angles (convex) or 1 angle (simple concave) then triangulate using a fan - IF ( NBIG_ANGLES <= 1 ) THEN - IFACE = 0 - DO I = 1, NVERTS2 - IP1 = I + 1 - IF (I==NVERTS2) IP1=1 - IF (I==VERT_START .OR. IP1==VERT_START) CYCLE - FACES(3*IFACE+1) = VERT_OFFSET+VERT_LIST(VERT_START) - FACES(3*IFACE+2) = VERT_OFFSET+VERT_LIST(I) - FACES(3*IFACE+3) = VERT_OFFSET+VERT_LIST(IP1) - IFACE = IFACE + 1 +T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW + +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + NCUTFCE = 0 + IF (BNDINT_FLAG) THEN + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_GASPHASE) CYCLE + NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE ENDDO - ! Here test edges to define LOCTYPE: - LOCTYPE(:) = 4+8+16 - DO IFACE=1,NVERTS2-2 - HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. - DO IEDGE=1,3 - ! Nodes i,i+1: - EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) - DO I=1,NEDGES - IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN - HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. - EXIT - ENDIF - ENDDO - ENDDO - LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) + ELSE + DO ICF=MESHES(NM)%N_CUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_GASPHASE) CYCLE + NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE ENDDO - RETURN + ENDIF + WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-faces : ',NCUTFCE,'. ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-faces : ',NCUTFCE,'. ' ENDIF ENDIF -! more than 1 angles in polygon > 180 deg -COUNT_OUT = 0 -IFACE = 1 -OUTER: DO WHILE (NLIST>=3) - COUNT_OUT = COUNT_OUT + 1 - IF(COUNT_OUT > NVERTS**4) THEN - ! Revert to Convex poly solution: - DO IVERT = 1, NVERTS - 2 ! for now assume face is convex - ! vertex indices 1, 2, ..., NVF - ! faces (1,2,3), (1,3,4), ..., (1,NVF-1,NVF) - FACES(3*IVERT-2) = VERT_OFFSET+1 - FACES(3*IVERT-1) = VERT_OFFSET+1+IVERT - FACES(3*IVERT) = VERT_OFFSET+2+IVERT - ENDDO - EXIT - ENDIF - IVERT = 1 - HAVE_TRIANGLE = .FALSE. - INNER: DO WHILE (IVERT<=NLIST) - V0 = VERT_LIST(IVERT-1) - V1 = VERT_LIST(IVERT) - V2 = VERT_LIST(IVERT+1) - IF(.NOT.NODE_EXISTS(IVERT+1))EXIT INNER - IF(NLIST==3.OR.VALID_TRIANGLE(DIR,VERTS,NVERTS,V0,V1,V2,VERT_FLAG)) THEN - FACES(IFACE ) = VERT_OFFSET+V0 - FACES(IFACE+1) = VERT_OFFSET+V1 - FACES(IFACE+2) = VERT_OFFSET+V2 - IF (NLIST == 3) EXIT OUTER - IFACE = IFACE + 3 - NODE_EXISTS(IVERT) = .FALSE. - IF(IVERT==1) NODE_EXISTS(NLIST+1) = .FALSE. - HAVE_TRIANGLE = .TRUE. - IVERT = IVERT + 2 - ELSE - IVERT = IVERT + 1 - ENDIF - ENDDO INNER - NLIST_OLD = NLIST - NLIST = 0 - DO I = 1, NLIST_OLD - IF(NODE_EXISTS(I))THEN - NLIST = NLIST + 1 - VERT_LIST(NLIST) = VERT_LIST(I) - ENDIF - ENDDO - VERT_LIST(0) = VERT_LIST(NLIST) - VERT_LIST(NLIST+1) = VERT_LIST(1) - NODE_EXISTS(1:NLIST+1) = .TRUE. +RETURN - ! Test for nodes connecting parallel edges, if found drop them: - VERT_DROPPED=.FALSE. - DO I=1,NLIST - V0=VERT_LIST(I-1); V1=VERT_LIST(I); V2=VERT_LIST(I+1); - VV1(1:3)=>VERTS(3*V0-2:3*V0) - VV2(1:3)=>VERTS(3*V1-2:3*V1) - VV3(1:3)=>VERTS(3*V2-2:3*V2) - U1 = VV2 - VV1; - U2 = VV3 - VV2; - SELECT CASE(DIR) - CASE(IAXIS) - U1(1) = U1(2); U1(2) = U1(3) - U2(1) = U2(2); U2(2) = U2(3) - CASE(JAXIS) - U1(2) = U1(1); U1(1) = U1(3) - U2(2) = U2(1); U2(1) = U2(3) - CASE(KAXIS) - U1(1) = U1(1); U1(2) = U1(2) - U2(1) = U2(1); U2(2) = U2(2) - END SELECT - U1(1:2) = U1(1:2) / SQRT(U1(1)**2._FB+U1(2)**2._FB) ! Normalize - U2(1:2) = U2(1:2) / SQRT(U2(1)**2._FB+U2(2)**2._FB) ! Normalize - IF (U1(1)*U2(1)+U1(2)*U2(2) > -EPS_FB) CYCLE - U1XU2 = U1(1)*U2(2)-U1(2)*U2(1) ! U1 x U2 - IF (ABS(U1XU2) < EPS_FB) THEN ! Triple product less than EPS - VERT_DROPPED=.TRUE.; NODE_EXISTS(I)=.FALSE. - IF (IFACE < 3*(NVERTS2-2)) THEN - FACES(IFACE ) = VERT_OFFSET+V0 - FACES(IFACE+1) = VERT_OFFSET+V1 - FACES(IFACE+2) = VERT_OFFSET+V2 - IFACE = IFACE + 3 - ENDIF - IF (NLIST == 3) EXIT OUTER - ENDIF - ENDDO - IF (VERT_DROPPED) THEN - ! Repeat List generation: - NLIST_OLD = NLIST - NLIST = 0 - DO I = 1, NLIST_OLD - IF(NODE_EXISTS(I))THEN - NLIST = NLIST + 1 - VERT_LIST(NLIST) = VERT_LIST(I) - ENDIF - ENDDO - VERT_LIST(0) = VERT_LIST(NLIST) - VERT_LIST(NLIST+1) = VERT_LIST(1) - NODE_EXISTS(1:NLIST+1) = .TRUE. - ENDIF -ENDDO OUTER +CONTAINS + +SUBROUTINE REALLOCATE_NODEDG_FACE(N_SEG_CFACE,N_VERT_CFACE) + +INTEGER, INTENT(IN) :: N_SEG_CFACE,N_VERT_CFACE +INTEGER :: DFCTE,DFCTV + +IF ( (N_SEG_CFACE+1 > SIZE_EDGES_NODEDG) .OR. (N_VERT_CFACE > SIZE_VERTS_NODEDG)) THEN + ! Allocation factors: + DFCTE = MAX(0,CEILING(REAL(N_SEG_CFACE+1-SIZE_EDGES_NODEDG,EB)/REAL(DELTA_EDGE,EB))) + DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE -SIZE_VERTS_NODEDG,EB)/REAL(DELTA_VERT,EB))) + DEALLOCATE(NODEDG_FACE) + SIZE_VERTS_NODEDG = SIZE_VERTS_NODEDG + DFCTV*DELTA_VERT + SIZE_EDGES_NODEDG = SIZE_EDGES_NODEDG + DFCTE*DELTA_EDGE + ALLOCATE(NODEDG_FACE(1:SIZE_EDGES_NODEDG,1:SIZE_VERTS_NODEDG)) +ENDIF +RETURN +END SUBROUTINE REALLOCATE_NODEDG_FACE + +SUBROUTINE REALLOCATE_LOCAL_CFELEM(N_VERT_CFACE,N_FACE_CFACE) + +INTEGER, INTENT(IN) :: N_VERT_CFACE, N_FACE_CFACE +INTEGER :: DFCTF,DFCTV + +IF ( (N_FACE_CFACE > SIZE_CFACES_CFELEM) .OR. (N_VERT_CFACE+1 > SIZE_VERTS_CFELEM)) THEN + DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE+1-SIZE_VERTS_CFELEM,EB)/REAL(DELTA_VERT,EB))) + DFCTF = MAX(0,CEILING(REAL(N_FACE_CFACE-SIZE_CFACES_CFELEM,EB)/REAL(DELTA_FACE,EB))) + DEALLOCATE(CFELEM) + SIZE_CFACES_CFELEM = SIZE_CFACES_CFELEM + DFCTF*DELTA_FACE + SIZE_VERTS_CFELEM = SIZE_VERTS_CFELEM + DFCTV*DELTA_VERT + ALLOCATE(CFELEM(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) + DEALLOCATE(CFE,CFEL); ALLOCATE(CFE(1:SIZE_VERTS_CFELEM),CFEL(1:SIZE_VERTS_CFELEM)) + IF(ALLOCATED(CEDGES)) DEALLOCATE(CEDGES); ALLOCATE(CEDGES(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM)) +ENDIF +RETURN +END SUBROUTINE REALLOCATE_LOCAL_CFELEM -! Here test edges to define LOCTYPE: -LOCTYPE(:) = 4+8+16 -DO IFACE=1,NVERTS2-2 - HIDEDGE(1:3) = 1 ! Initialize to hidden all edges. - DO IEDGE=1,3 - ! Nodes i,i+1: - EDGEI(1:2) = (/ FACES(3*IFACE-SHFT_NODE(IEDGE))-VERT_OFFSET, FACES(3*IFACE-SHFT_NODE(IEDGE+1))-VERT_OFFSET /) - DO I=1,NEDGES - IF(EDGE_LIST(1,I)==EDGEI(1) .AND. EDGE_LIST(2,I)==EDGEI(2)) THEN - HIDEDGE(IEDGE) = 0 ! Edge belongs to polygon, set to plot. - EXIT - ENDIF - ENDDO - ENDDO - LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) -ENDDO +SUBROUTINE REALLOCATE_LOCAL_VERT_CFELEM(N_VERT_CFACE) + +INTEGER, INTENT(IN) :: N_VERT_CFACE +INTEGER :: DFCTV +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM_AUX,CEDGES_AUX + +IF( N_VERT_CFACE > SIZE_VERTS_CFELEM ) THEN + DFCTV = MAX(0,CEILING(REAL(N_VERT_CFACE-SIZE_VERTS_CFELEM,EB)/REAL(DELTA_VERT,EB))) + ALLOCATE(CFELEM_AUX(1:SIZE_VERTS_CFELEM+DFCTV*DELTA_VERT,1:SIZE_CFACES_CFELEM)) + CFELEM_AUX(:,:) = CC_UNDEFINED + CFELEM_AUX(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) = CFELEM(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) + ALLOCATE(CEDGES_AUX(1:SIZE_VERTS_CFELEM+DFCTV*DELTA_VERT,1:SIZE_CFACES_CFELEM)) + CEDGES_AUX(:,:) = CC_UNDEFINED + CEDGES_AUX(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) = CEDGES(1:SIZE_VERTS_CFELEM,1:SIZE_CFACES_CFELEM) + SIZE_VERTS_CFELEM = SIZE_VERTS_CFELEM + DFCTV*DELTA_VERT + CALL MOVE_ALLOC(FROM=CFELEM_AUX,TO=CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=CEDGES) + ! Now Reallocate CFE, CFEL: + DEALLOCATE(CFE,CFEL); ALLOCATE(CFE(1:SIZE_VERTS_CFELEM),CFEL(1:SIZE_VERTS_CFELEM)) +ENDIF RETURN -END SUBROUTINE TRIANGULATE +END SUBROUTINE REALLOCATE_LOCAL_VERT_CFELEM -! ---------------------------- RAY_TRIANGLE_INTERSECT_PT ---------------------------------------- +END SUBROUTINE GET_CARTFACE_CUTFACES -SUBROUTINE RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,D,IS_INTERSECT,POS) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -! V1(3), V2(3), V3(3) triangle vertices coordinates. -! XP(3) -> Ray origin coordinates. -! D(3) -> Ray direction. -! OUTPUT : -! IS_INTERSECT, .TRUE. if these is intersection. -! POS(3), coordinates of intersection point. +! ---------------- DEFINE_REGULAR_CUTFACES -------------------------- -REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3),XP(3),D(3) -LOGICAL, INTENT(OUT):: IS_INTERSECT -REAL(EB), INTENT(OUT):: POS(3) +SUBROUTINE DEFINE_REGULAR_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) -REAL(EB) :: E1(3),E2(3),P(3),S(3),Q(3),U,V,TMP,T -REAL(EB), PARAMETER :: EPS=1.E-10_EB +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN) :: BNDINT_FLAG -! Schneider and Eberly, Section 11.1 -IS_INTERSECT = .FALSE. -POS(1:3) = 1._EB/TWENTY_EPSILON_EB +! Local Variables: +INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI,X1AXIS,NVERT,NFACE,I,J,K,NCUTFACE +INTEGER :: IBNDINT,BNDINT_LOW,BNDINT_HIGH -E1 = V2-V1 -E2 = V3-V1 +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED -CALL CROSS_PRODUCT(P,D,E2) +CALL POINT_TO_MESH(NM) -TMP = DOT_PRODUCT(P,E1) +! Mesh sizes: +NXB=IBAR +NYB=JBAR +NZB=KBAR -IF ( ABS(TMP)(1._EB+EPS)) RETURN ! No intersection. -CALL CROSS_PRODUCT(Q,S,E1) -V = TMP*DOT_PRODUCT(D,Q) -IF (V<-EPS .OR. (U+V)>(1._EB+EPS)) RETURN ! No intersection. +! Main Loop on block NM: +IF (BNDINT_FLAG) THEN + ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. + BNDINT_LOW = 1 + BNDINT_HIGH = 3 +ELSE + BNDINT_LOW = 4 + BNDINT_HIGH = 4 +ENDIF -T = TMP*DOT_PRODUCT(E2,Q) -IF (T <= 0._EB) RETURN ! No intersection. +IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, + ! 4 guard-cell faces. -IS_INTERSECT = .TRUE. -POS = XP + T*D ! the intersection point + ! When switching to internal faces, copy number of external faces already computed. + IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH -RETURN -END SUBROUTINE RAY_TRIANGLE_INTERSECT_PT + ! First tag and define Gasphase cut-faces in X,Y,Z directions. + ! X direction: + ! IAXIS gasphase cut-faces: + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + ILO = ILO_FACE; IHI = ILO_FACE + CASE(2) + ILO = IHI_FACE; IHI = IHI_FACE + CASE(3) + ILO = ILO_FACE+1; IHI = IHI_FACE-1 + CASE(4) + ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT + X1AXIS=IAXIS + NVERT = 4 + NFACE = 1 + DO I=ILO,IHI + DO J=JLO,JHI + DO K=KLO,KHI -! ---------------------------- TRILINEAR ---------------------------------------- + ! If cut-cell centroid is outside the test box -> drop: + IF(XFACE(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XFACE(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE + IF(YCELL(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YCELL(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE + IF(ZCELL(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZCELL(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE -REAL(EB) FUNCTION TRILINEAR(UU,DXI,LL) + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. -REAL(EB), INTENT(IN) :: UU(0:1,0:1,0:1),DXI(3),LL(3) -REAL(EB) :: XX,YY,ZZ + FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE -! Comments: -! -! see http://local.wasp.uwa.edu.au/~pbourke/miscellaneous/interpolation/index.html -! with appropriate scaling. LL is length of side. -! -! UU(1,1,1) -! z /----------/ -! ^/ / | -! ------------ | Particle position -! | | | -! LL(3) | o<-----|------- DXI = [DXI(1),DXI(2),DXI(3)] -! | | / -! | |/ Particle property at XX = TRILINEAR -! ------------> x -! ^ -! | -! X0 = [0,0,0] -! -! UU(0,0,0) -! -!=========================================================== + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (BNDINT_FLAG) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF -XX = DXI(1)/LL(1) -YY = DXI(2)/LL(2) -ZZ = DXI(3)/LL(3) + FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE -TRILINEAR = UU(0,0,0)*(1._EB-XX)*(1._EB-YY)*(1._EB-ZZ) + & - UU(1,0,0)*XX*(1._EB-YY)*(1._EB-ZZ) + & - UU(0,1,0)*(1._EB-XX)*YY*(1._EB-ZZ) + & - UU(0,0,1)*(1._EB-XX)*(1._EB-YY)*ZZ + & - UU(1,0,1)*XX*(1._EB-YY)*ZZ + & - UU(0,1,1)*(1._EB-XX)*YY*ZZ + & - UU(1,1,0)*XX*YY*(1._EB-ZZ) + & - UU(1,1,1)*XX*YY*ZZ + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, X1AXIS /) + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERT+1,IBNDINT) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) + + ! Vertices: + CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) + CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) + CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) + CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) + + ! Centroid: + CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & + (/ XFACE(I )+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) + + ! Load Ordered nodes to CFELEM and geom properties: + CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) + CF%AREA(NFACE) = DYCELL(J)*DZCELL(K) + + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: + CF%INXAREA(NFACE) = XFACE(I)*CF%AREA(NFACE) + ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: + CF%INXSQAREA(NFACE) = XFACE(I)**2._EB*CF%AREA(NFACE) + ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: + CF%JNYSQAREA(NFACE) = 0._EB + ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: + CF%KNZSQAREA(NFACE) = 0._EB + ENDDO + ENDDO + ENDDO + + ! Y direction: + ! JAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + JLO = JLO_FACE; JHI = JLO_FACE + CASE(2) + JLO = JHI_FACE; JHI = JHI_FACE + CASE(3) + JLO = JLO_FACE+1; JHI = JHI_FACE-1 + CASE(4) + JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT + X1AXIS=JAXIS + NVERT = 4 + NFACE = 1 + DO I=ILO,IHI + DO J=JLO,JHI + DO K=KLO,KHI -END FUNCTION TRILINEAR + ! If cut-cell centroid is outside the test box -> drop: + IF(XCELL(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XCELL(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE + IF(YFACE(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YFACE(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE + IF(ZCELL(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZCELL(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE -! ---------------------------- POINT_IN_BB ---------------------------------------- + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. -LOGICAL FUNCTION POINT_IN_BB(V1,BB) + FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE -REAL(EB), INTENT(IN) :: V1(3),BB(6) + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (BNDINT_FLAG) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF -POINT_IN_BB=.FALSE. -IF ( V1(1)>=BB(1) .AND. V1(1)<=BB(2) .AND. & - V1(2)>=BB(3) .AND. V1(2)<=BB(4) .AND. & - V1(3)>=BB(5) .AND. V1(3)<=BB(6) ) THEN - POINT_IN_BB=.TRUE. - RETURN -ENDIF + FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE -RETURN -END FUNCTION POINT_IN_BB + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -! ---------------------------- POLYGON_AREA ---------------------------------------- + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, X1AXIS /) + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERT+1,IBNDINT) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) -REAL(EB) FUNCTION POLYGON_AREA(NP,PC) -! Calculate the area of a polygon + ! Vertices: + CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) + CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) + CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) + CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) -INTEGER, INTENT(IN) :: NP -REAL(EB), INTENT(IN) :: PC(60) -INTEGER :: I,K -REAL(EB) :: V1(3),V2(3),V3(3) + ! Centroid: + CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & + (/ XFACE(I-1)+XFACE(I ), YFACE(J )+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) -POLYGON_AREA = 0._EB -V3 = POLYGON_CENTROID(NP,PC) + ! Load Ordered nodes to CFELEM and geom properties: + CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) + CF%AREA(NFACE) = DXCELL(I)*DZCELL(K) -DO I=1,NP - IF (I < NP) THEN - DO K=1,3 - V1(K) = PC((I-1)*3+K) - V2(K) = PC(I*3+K) - ENDDO - ELSE - DO K=1,3 - V1(K) = PC((I-1)*3+K) - V2(K) = PC(K) + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: + CF%INXAREA(NFACE) = 0._EB + ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: + CF%INXSQAREA(NFACE) = 0._EB + ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: + CF%JNYSQAREA(NFACE) = YFACE(J)**2._EB*CF%AREA(NFACE) + ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: + CF%KNZSQAREA(NFACE) = 0._EB + ENDDO ENDDO - ENDIF - POLYGON_AREA = POLYGON_AREA+TRIANGLE_AREA(V1,V2,V3) -ENDDO + ENDDO -RETURN -END FUNCTION POLYGON_AREA + ! Z direction: + ! KAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + KLO = KLO_FACE; KHI = KLO_FACE + CASE(2) + KLO = KHI_FACE; KHI = KHI_FACE + CASE(3) + KLO = KLO_FACE+1; KHI = KHI_FACE-1 + CASE(4) + KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + END SELECT + X1AXIS=KAXIS + NVERT = 4 + NFACE = 1 + DO I=ILO,IHI + DO J=JLO,JHI + DO K=KLO,KHI -! ---------------------------- POLYGON_CENTROID ---------------------------------------- + ! If cut-cell centroid is outside the test box -> drop: + IF(XCELL(I) < (VAL_TESTX_LOW +GEOMEPS)) CYCLE; IF(XCELL(I) > (VAL_TESTX_HIGH-GEOMEPS)) CYCLE + IF(YCELL(J) < (VAL_TESTY_LOW +GEOMEPS)) CYCLE; IF(YCELL(J) > (VAL_TESTY_HIGH-GEOMEPS)) CYCLE + IF(ZFACE(K) < (VAL_TESTZ_LOW +GEOMEPS)) CYCLE; IF(ZFACE(K) > (VAL_TESTZ_HIGH-GEOMEPS)) CYCLE -REAL(EB) FUNCTION POLYGON_CENTROID(NP,PC) -! Calculate the centroid of polygon vertices + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. -DIMENSION :: POLYGON_CENTROID(3) -INTEGER, INTENT(IN) :: NP -REAL(EB), INTENT(IN) :: PC(60) -INTEGER :: I,K + FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE -POLYGON_CENTROID = 0._EB -DO I=1,NP - DO K=1,3 - POLYGON_CENTROID(K) = POLYGON_CENTROID(K)+PC((I-1)*3+K)/NP - ENDDO -ENDDO + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (BNDINT_FLAG) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF -RETURN -END FUNCTION POLYGON_CENTROID + FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE -! ---------------------------- INTERSECT_SPHERE_AABB ---------------------------------------- + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -! Algorithm from Schneider and Eberly, p. 644 -! Intersection of Sphere and Axis-Aligned Bounding Box + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, X1AXIS /) + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERT+1,IBNDINT) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) -LOGICAL FUNCTION INTERSECT_SPHERE_AABB(X0,RADIUS,XB) + ! Vertices: + CF%XYZVERT(IAXIS:KAXIS,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) + CF%XYZVERT(IAXIS:KAXIS,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) + CF%XYZVERT(IAXIS:KAXIS,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) + CF%XYZVERT(IAXIS:KAXIS,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) -REAL(EB), INTENT(IN) :: X0(3),RADIUS,XB(6) -REAL(EB) :: DIST_SQUARED + ! Centroid: + CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & + (/ XFACE(I-1)+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K )+ZFACE(K ) /) -INTERSECT_SPHERE_AABB=.TRUE. + ! Load Ordered nodes to CFELEM and geom properties: + CF%CFELEM(1:NVERT+1,NFACE) = (/ NVERT, 1, 2, 3, 4 /) + CF%AREA(NFACE) = DXCELL(I)*DYCELL(J) -! Compute distance in each direction, summing as we go -DIST_SQUARED = 0._EB -IF (X0(1)XB(2)) THEN - DIST_SQUARED = DIST_SQUARED + (X0(1)-XB(2))**2 -ENDIF -IF (X0(2)XB(4)) THEN - DIST_SQUARED = DIST_SQUARED + (X0(2)-XB(4))**2 -ENDIF -IF (X0(3)XB(6)) THEN - DIST_SQUARED = DIST_SQUARED + (X0(3)-XB(6))**2 -ENDIF + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: + CF%INXAREA(NFACE) = 0._EB + ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: + CF%INXSQAREA(NFACE) = 0._EB + ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: + CF%JNYSQAREA(NFACE) = 0._EB + ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: + CF%KNZSQAREA(NFACE) = ZFACE(K)**2._EB*CF%AREA(NFACE) + ENDDO + ENDDO + ENDDO -! Compare squared distance to radius squared -IF (DIST_SQUARED > (RADIUS*RADIUS-TWENTY_EPSILON_EB)) INTERSECT_SPHERE_AABB=.FALSE. +ENDDO IBNDINT_LOOP -RETURN -END FUNCTION INTERSECT_SPHERE_AABB +IF (.NOT.BNDINT_FLAG) DEALLOCATE( IJK_COUNTED ) -! ---------------------------- INTERSECT_CYLINDER_AABB ---------------------------------------- +RETURN +END SUBROUTINE DEFINE_REGULAR_CUTFACES -! Intersection of Cylinder and Axis-Aligned Bounding Box -! -! Cylinder is represented by: -! X_IN = bottom-center of cylinder (X,Y,Z) in grid reference frame -! H = length of cylinder -! RADIUS = radius of cylinder -! AX_VEC = unit vector pointing along cylinder axis (which leads to ROT_MAT using ROTATION_MATRIX) -! -! The basic algorithm is: -! 1. rotate the cylinder into a frame where the axis points in the vertical direction (+zbar in new frame) -! 2. find the vertex point locations of AABB in this new frame -! 3. test each vertex location against the end caps of cylinder -! 4. test each vertex against radius of cylinder -LOGICAL FUNCTION INTERSECT_CYLINDER_AABB(X_IN,H,RADIUS,ROTMAT,XB) +! ---------------------------- SORT_VERTS --------------------------------------- -REAL(EB), INTENT(IN) :: X_IN(3),H,RADIUS,ROTMAT(3,3),XB(6) -REAL(EB) :: X(3),U(3),V(3),DUX(2),Z0,ZH,R2,DIST_SQUARED +SUBROUTINE SORT_VERTS(MAXVERTS,NVERTS,VERTS1,VERTS2,XV,ASCDESC,NV,V) -INTERSECT_CYLINDER_AABB=.FALSE. +INTEGER, INTENT(IN) :: MAXVERTS, NVERTS +REAL(EB),INTENT(IN) :: VERTS1(MAXVERTS),VERTS2(MAXVERTS),XV +LOGICAL, INTENT(IN) :: ASCDESC +INTEGER, INTENT(OUT):: NV,V(MAXVERTS) -X = MATMUL(ROTMAT,X_IN) ! transform center -Z0 = X(3) ! lower cap in new reference frame -ZH = X(3) + H ! upper cap in new reference frame +! Local Variables: +INTEGER :: IV, IIV, JJV +INTEGER :: V2(MAXVERTS) +LOGICAL :: FOUND -! transform vertices and test against end caps, then radius -R2 = RADIUS*RADIUS -V = (/0.5_EB*(XB(1)+XB(2)),0.5_EB*(XB(3)+XB(4)),0.5_EB*(XB(5)+XB(6))/) -U = MATMUL(ROTMAT,V) -IF (U(3)>=Z0 .AND. U(3)<=ZH) THEN - ! centroid is within end-cap range, now test against radius - ! in new frame the distance from centroid to cylinder axis only requires the 1st and 2nd vector components - DUX = U(1:2) - X(1:2) - DIST_SQUARED = DOT_PRODUCT(DUX,DUX) - IF (DIST_SQUARED < R2+TWENTY_EPSILON_EB) THEN - INTERSECT_CYLINDER_AABB = .TRUE. - RETURN +V(:) = 0 +NV = 0 +DO IV=1,NVERTS + IF (ABS(VERTS1(IV)-XV) < GEOMEPS) THEN + IF (NV==0) THEN + NV=1; V(NV)=IV + ELSE + ! Insert add IV, using ascending X3: + FOUND=.FALSE. + DO IIV=1,NV + IF ( (VERTS2(IV)-VERTS2(V(IIV))) < 0._EB ) THEN + FOUND=.TRUE. + EXIT + ENDIF + ENDDO + IF (FOUND) THEN + DO JJV=NV+1,IIV+1,-1 + V(JJV) = V(JJV-1) + ENDDO + V(IIV) = IV + ELSE + V(IIV) = IV ! Here IIV = NV+1, as loop leaves it to that value. + ENDIF + NV=NV+1 + ENDIF ENDIF +ENDDO +IF (.NOT.ASCDESC) THEN + V2(1:NV) = V(1:NV) + DO IV=1,NV; V(NV+1-IV)=V2(IV); ENDDO ENDIF RETURN -END FUNCTION INTERSECT_CYLINDER_AABB - -! ---------------------------- ROTATION_MATRIX ---------------------------------------- +END SUBROUTINE SORT_VERTS -SUBROUTINE ROTATION_MATRIX(R_OUT,A_IN,THETA) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +! ----------------------------- FACE_REALLOC ------------------------------------- -REAL(EB), INTENT(OUT) :: R_OUT(3,3) -REAL(EB), INTENT(IN) :: A_IN(3),THETA -REAL(EB) :: A(3),C,DENOM,V(3),A1(3),A2(3),A3(3),B1(3),B2(3),B3(3),R_THETA(3,3) +SUBROUTINE FACE_REALLOC(NM,ICF,NVERT,NFACE,NSVERT,NSFACE,NVERTFACE_NEW) -! initialize 2D rotation matrix -! this is a counterclockwise rotation -R_THETA = 0._EB -R_THETA(1,1) = COS(THETA*DEG2RAD); R_THETA(1,2) = SIN(THETA*DEG2RAD) -R_THETA(2,1) = -SIN(THETA*DEG2RAD); R_THETA(2,2) = COS(THETA*DEG2RAD) -R_THETA(3,3) = 1._EB +INTEGER, INTENT(IN) :: NM,ICF,NVERT,NFACE,NSVERT,NSFACE +INTEGER, INTENT(INOUT) :: NVERTFACE_NEW -! initialize R_OUT as 2D rotation matrix -R_OUT = R_THETA +! Local Variables: +INTEGER :: NVERTFACE +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZVERT, XYZCEN, REAL2D +REAL(EB), ALLOCATABLE, DIMENSION(:) :: AREA, REAL1D +INTEGER, ALLOCATABLE, DIMENSION(:) :: INT1D +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM, INT2D ! Cut-faces connectivities. +INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: INT3D +LOGICAL, ALLOCATABLE, DIMENSION(:) :: SHARED -! normalize input vector -DENOM = SQRT(DOT_PRODUCT(A_IN,A_IN)) -IF (DENOM0._EB) THEN - RETURN - ELSE - R_OUT = -R_OUT - RETURN - ENDIF -ENDIF + ALLOCATE(AREA(1:NFACE+NSFACE),XYZCEN(IAXIS:KAXIS,1:NFACE+NSFACE)); AREA = 0._EB; XYZCEN = 0._EB + AREA(1:NFACE)=MESHES(NM)%CUT_FACE(ICF)%AREA(1:NFACE) + XYZCEN(IAXIS:KAXIS,1:NFACE)=MESHES(NM)%CUT_FACE(ICF)%XYZCEN(IAXIS:KAXIS,1:NFACE) + CALL MOVE_ALLOC(FROM=AREA,TO=MESHES(NM)%CUT_FACE(ICF)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=MESHES(NM)%CUT_FACE(ICF)%XYZCEN) -! find orthnormal basis for A=A3 in old system + ! This is only used for reallocation of INB faces when blocking cut-cells: + IF (MESHES(NM)%CUT_FACE(ICF)%STATUS == CC_INBOUNDARY) THEN -A3 = A -CALL CROSS_PRODUCT(A2,B3,A3) -CALL CROSS_PRODUCT(A1,A2,A3) + ALLOCATE(SHARED(1:NFACE+NSFACE)); SHARED = .FALSE. + SHARED(1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%SHARED(1:NFACE) + CALL MOVE_ALLOC(FROM=SHARED,TO=MESHES(NM)%CUT_FACE(ICF)%SHARED) -! rotation matrix (direction cosines), Pope (2000), Eq. (A.11) + ALLOCATE(SHARED(1:NFACE+NSFACE)); SHARED = .FALSE. + SHARED(1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%BLK_TAG(1:NFACE) + CALL MOVE_ALLOC(FROM=SHARED,TO=MESHES(NM)%CUT_FACE(ICF)%BLK_TAG) -R_OUT(1,1) = DOT_PRODUCT(A1,B1); R_OUT(1,2) = DOT_PRODUCT(A1,B2); R_OUT(1,3) = DOT_PRODUCT(A1,B3) -R_OUT(2,1) = DOT_PRODUCT(A2,B1); R_OUT(2,2) = DOT_PRODUCT(A2,B2); R_OUT(2,3) = DOT_PRODUCT(A2,B3) -R_OUT(3,1) = DOT_PRODUCT(A3,B1); R_OUT(3,2) = DOT_PRODUCT(A3,B2); R_OUT(3,3) = DOT_PRODUCT(A3,B3) + ALLOCATE(INT2D(1:2,1:NFACE+NSFACE)); INT2D=CC_UNDEFINED + INT2D(1:2,1:NFACE)=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1:2,1:NFACE) + CALL MOVE_ALLOC(FROM=INT2D,TO=MESHES(NM)%CUT_FACE(ICF)%BODTRI) -R_OUT = MATMUL(R_OUT,R_THETA) + ALLOCATE(INT2D(LOW_IND:HIGH_IND,1:NFACE+NSFACE)); INT2D = CC_UNDEFINED + INT2D(LOW_IND:HIGH_IND,1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%UNKZ(LOW_IND:HIGH_IND,1:NFACE) + CALL MOVE_ALLOC(FROM=INT2D,TO=MESHES(NM)%CUT_FACE(ICF)%UNKZ) -! ! test -! print *,R_OUT(1,:) -! print *,R_OUT(2,:) -! print *,R_OUT(3,:) -! print *,MATMUL(R_OUT,A) ! result should be B3 -! stop + ALLOCATE(REAL2D(IAXIS:KAXIS,1:NFACE+NSFACE)); REAL2D = 0._EB + REAL2D(IAXIS:KAXIS,1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%XCENLOW(IAXIS:KAXIS,1:NFACE) + CALL MOVE_ALLOC(FROM=REAL2D,TO=MESHES(NM)%CUT_FACE(ICF)%XCENLOW) + ALLOCATE(REAL2D(IAXIS:KAXIS,1:NFACE+NSFACE)); REAL2D = 0._EB + REAL2D(IAXIS:KAXIS,1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%XCENHIGH(IAXIS:KAXIS,1:NFACE) + CALL MOVE_ALLOC(FROM=REAL2D,TO=MESHES(NM)%CUT_FACE(ICF)%XCENHIGH) -END SUBROUTINE ROTATION_MATRIX + ALLOCATE(INT3D(MAX_DIM+1,LOW_IND:HIGH_IND,1:NFACE+NSFACE)); INT3D = CC_UNDEFINED + INT3D(1:MAX_DIM+1,LOW_IND:HIGH_IND,1:NFACE) = & + MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(1:MAX_DIM+1,LOW_IND:HIGH_IND,1:NFACE) + CALL MOVE_ALLOC(FROM=INT3D,TO=MESHES(NM)%CUT_FACE(ICF)%CELL_LIST) -! ---------------------------- INTERSECT_CONE_AABB ---------------------------------------- + ALLOCATE(INT1D(1:NFACE+NSFACE)); INT1D=CC_UNDEFINED + INT1D(1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX(1:NFACE) + CALL MOVE_ALLOC(FROM=INT1D,TO=MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX) -! This routine basically follows the INTERSECT_CYLINDER_AABB algorithm, with radius = R(Z) + ALLOCATE(REAL1D(1:NFACE+NSFACE)); REAL1D = 1._EB + CALL MOVE_ALLOC(FROM=REAL1D,TO=MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST) -LOGICAL FUNCTION INTERSECT_CONE_AABB(X_IN,H,RADIUS,ROTMAT,XB) + ALLOCATE(INT1D(1:NFACE+NSFACE)); INT1D=NOT_BLOCKED + INT1D(1:NFACE) = MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN(1:NFACE) + CALL MOVE_ALLOC(FROM=INT1D,TO=MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN) -REAL(EB), INTENT(IN) :: X_IN(3),H,RADIUS,ROTMAT(3,3),XB(6) -REAL(EB) :: X(3),U(3),V(3),DUX(2),Z0,ZH,DIST_SQUARED,R_Z -INTEGER :: II,JJ,KK + ENDIF +ENDIF -INTERSECT_CONE_AABB=.FALSE. +RETURN -X = MATMUL(ROTMAT,X_IN) ! transform center -Z0 = X(3) ! lower cap in new reference frame -ZH = X(3) + H ! upper cap in new reference frame +END SUBROUTINE FACE_REALLOC -! transform vertices and test against end caps, then radius -DO KK=5,6 - DO JJ=3,4 - DO II=1,2 - V = (/XB(II),XB(JJ),XB(KK)/) - U = MATMUL(ROTMAT,V) - IF (U(3)>=Z0 .AND. U(3)<=ZH) THEN - ! vertex is within end-cap range, now test against radius - ! in new frame the distance from vertex to CONE axis only requires the 1st and 2nd vector components - DUX = U(1:2) - X(1:2) - DIST_SQUARED = DOT_PRODUCT(DUX,DUX) - R_Z = RADIUS*(1._EB-(U(3)-Z0)/H) - IF (DIST_SQUARED < R_Z*R_Z+TWENTY_EPSILON_EB) THEN - INTERSECT_CONE_AABB = .TRUE. - RETURN - ENDIF - ENDIF - ENDDO - ENDDO -ENDDO -RETURN -END FUNCTION INTERSECT_CONE_AABB +! ---------------------- CUT_FACE_ARRAY_REALLOC ------------------------------- -! ---------------------------- INTERSECT_OBB_AABB ---------------------------------------- +SUBROUTINE CUT_FACE_ARRAY_REALLOC(NM,ICF) -! Intersect an Oriented Bounding Box (OBB) with an Axis-Aligned Bounding Box (AABB) -! First, rotate AABB into OBB frame. -! Then test each vertex. +INTEGER, INTENT(IN) :: NM,ICF -LOGICAL FUNCTION INTERSECT_OBB_AABB(X_IN,L,W,H,ROTMAT,XB) +! Local Variables: +INTEGER :: ICF1, SIZE_CUT_FACE -REAL(EB), INTENT(IN) :: X_IN(3),L,W,H,ROTMAT(3,3),XB(6) -REAL(EB) :: X(3),U(3),V(3),X0,XL,Y0,YW,Z0,ZH -INTEGER :: II,JJ,KK +SIZE_CUT_FACE = SIZE(MESHES(NM)%CUT_FACE,DIM=1) -INTERSECT_OBB_AABB=.FALSE. +IF(ICF > SIZE_CUT_FACE) THEN -X = MATMUL(ROTMAT,X_IN) ! transform center -X0 = X(1) - 0.5_EB*L - TWENTY_EPSILON_EB -XL = X(1) + 0.5_EB*L + TWENTY_EPSILON_EB -Y0 = X(2) - 0.5_EB*W - TWENTY_EPSILON_EB -YW = X(2) + 0.5_EB*W + TWENTY_EPSILON_EB -Z0 = X(3) - 0.5_EB*H - TWENTY_EPSILON_EB -ZH = X(3) + 0.5_EB*H + TWENTY_EPSILON_EB + ALLOCATE(CUT_FACE_AUX(SIZE_CUT_FACE+GLOBAL_DELTA_FACE)) -! transform and test vertices (probably a more efficient way, but just to get going...) -DO KK=5,6 - DO JJ=3,4 - DO II=1,2 - V = (/XB(II),XB(JJ),XB(KK)/) - U = MATMUL(ROTMAT,V) - IF (U(1)>X0 .AND. U(1)Y0 .AND. U(2)Z0 .AND. U(3) FACES(3*I-2:3*I) - V(1:3) = VERT_UNIQUE(V(1:3)) - VERT_VALS(V(1)) = VERT_VALS(V(1)) + FACE_VALS(I) - COUNT(V(1)) = COUNT(V(1)) + 1 - VERT_VALS(V(2)) = VERT_VALS(V(2)) + FACE_VALS(I) - COUNT(V(2)) = COUNT(V(2)) + 1 - VERT_VALS(V(3)) = VERT_VALS(V(3)) + FACE_VALS(I) - COUNT(V(3)) = COUNT(V(3)) + 1 -ENDDO -DO I = 1, NVERTS - IF (COUNT(I) .GT. 1) VERT_VALS(I) = VERT_VALS(I)/REAL(COUNT(I), FB) -ENDDO -DO I = 1, NVERTS - IF (VERT_UNIQUE(I) .NE. I) VERT_VALS(I) = VERT_VALS(VERT_UNIQUE(I)) -ENDDO +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_IJK, TO=CUT_FACE_TO%INT_IJK) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_COEF, TO=CUT_FACE_TO%INT_COEF) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_DCOEF, TO=CUT_FACE_TO%INT_DCOEF) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_XYZBF, TO=CUT_FACE_TO%INT_XYZBF) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NOUT, TO=CUT_FACE_TO%INT_NOUT) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_INBFC, TO=CUT_FACE_TO%INT_INBFC) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NPE, TO=CUT_FACE_TO%INT_NPE) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_XN, TO=CUT_FACE_TO%INT_XN) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_CN, TO=CUT_FACE_TO%INT_CN) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_FVARS, TO=CUT_FACE_TO%INT_FVARS) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_NOMIND, TO=CUT_FACE_TO%INT_NOMIND) -END SUBROUTINE AVERAGE_FACE_VALUES +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%INT_CVARS, TO=CUT_FACE_TO%INT_CVARS) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%UNKF, TO=CUT_FACE_TO%UNKF) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%CFACE_INDEX, TO=CUT_FACE_TO%CFACE_INDEX) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%SURF_INDEX, TO=CUT_FACE_TO%SURF_INDEX) +CALL MOVE_ALLOC(FROM=CUT_FACE_FROM%NOMICF, TO=CUT_FACE_TO%NOMICF) +RETURN +END SUBROUTINE CUT_FACE_MOVE -! ---------------------------- MAKE_UNIQUE_VERT_ARRAY ---------------------------------------- -! construct an array that points to first vertex in a vertex array when one or more vertices are identical +! ---------------------------- FACE_DEALLOC ------------------------------------- -SUBROUTINE MAKE_UNIQUE_VERT_ARRAY(VERTS, VERT_UNIQUE, NVERTS) -INTEGER, INTENT(IN) :: NVERTS -REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) -INTEGER, INTENT(OUT) :: VERT_UNIQUE(NVERTS) +SUBROUTINE FACE_DEALLOC(NM,ICF,DO_BNCF) -INTEGER :: PERM(NVERTS) -INTEGER :: I, RESULT +INTEGER, INTENT(IN) :: NM,ICF +INTEGER, OPTIONAL, INTENT(IN) :: DO_BNCF -DO I = 1, NVERTS - PERM(I) = I - VERT_UNIQUE(I) = I -ENDDO -CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, 1, NVERTS) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XYZVERT)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZVERT) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CFELEM)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFELEM) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CEDGES)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CEDGES) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%AREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST) +IF(.NOT.PRESENT(DO_BNCF)) THEN + MESHES(NM)%CUT_FACE(ICF)%NFACE = 0 + IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XYZCEN)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZCEN) +ENDIF +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%SHARED)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SHARED) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA) -DO I = 1, NVERTS - 1 - CALL COMPARE_VERTS(VERTS, NVERTS, PERM(I), PERM(I+1), RESULT) - IF (RESULT == 0) VERT_UNIQUE(PERM(I+1)) = VERT_UNIQUE(PERM(I)) -END DO +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%BODTRI)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI) -END SUBROUTINE MAKE_UNIQUE_VERT_ARRAY +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%UNKH)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKH) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%UNKZ)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKZ) -! ---------------------------- COMPARE_VERTS ---------------------------------------- +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XCENLOW)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENLOW) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH) -! returns -1, 0, 1 when a vertex I is less than, the same or greater than vertex J +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX) -SUBROUTINE COMPARE_VERTS(VERTS, NVERTS, I, J, RESULT) -INTEGER, INTENT(IN) :: NVERTS -REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) -INTEGER, INTENT(IN) :: I, J -INTEGER, INTENT(OUT) :: RESULT -REAL(FB) :: TOLERANCE=0.00001_FB -IF (VERTS(3*I-2) < VERTS(3*J-2) - TOLERANCE) THEN - RESULT = -1 - RETURN -ENDIF -IF (VERTS(3*I-2) > VERTS(3*J-2) + TOLERANCE) THEN - RESULT = 1 - RETURN -ENDIF -IF (VERTS(3*I-1) < VERTS(3*J-1) - TOLERANCE) THEN - RESULT = -1 - RETURN -ENDIF -IF (VERTS(3*I-1) > VERTS(3*J-1) + TOLERANCE) THEN - RESULT = 1 - RETURN -ENDIF -IF (VERTS(3*I ) < VERTS(3*J ) - TOLERANCE) THEN - RESULT = -1 - RETURN -ENDIF -IF (VERTS(3*I ) > VERTS(3*J ) + TOLERANCE) THEN - RESULT = 1 - RETURN -ENDIF -RESULT = 0 RETURN -END SUBROUTINE COMPARE_VERTS +END SUBROUTINE FACE_DEALLOC -! ---------------------------- MAKE_PERMUTATION_ARRAY ---------------------------------------- +! -------------------------- NEW_FACE_ALLOC ------------------------------------- -! sort a vertex array in increasing order and store the order in a permutation array -! PERM(1) is the 1st vertex, PERM(2) is the 2nd and so on +SUBROUTINE NEW_FACE_ALLOC(NM,ICF,NVERT,NFACE,NVERTFACE,IBNDINT) -RECURSIVE SUBROUTINE MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, FIRST, LAST) -INTEGER, INTENT(IN) :: NVERTS -REAL(FB), INTENT(IN) :: VERTS(3*NVERTS) -INTEGER, INTENT(INOUT) :: PERM(NVERTS) -INTEGER, INTENT(IN) :: FIRST, LAST -INTEGER :: PERM_COPY(NVERTS) -INTEGER RESULT +INTEGER, INTENT(IN) :: NM,ICF,NVERT,NFACE,NVERTFACE +INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT -INTEGER :: MID, I, I1, I2, IP1, IP2, N, N1, N2 +! Allocate and initialize NVERT related fields: +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZVERT(IAXIS:KAXIS,1:NVERT)); MESHES(NM)%CUT_FACE(ICF)%XYZVERT = 0._EB -IF (FIRST .EQ. LAST)RETURN ! only one element in list so don't need to sort +! Allocate and initialize NFACE, NVERTFACE related fields: +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFELEM(1:NVERTFACE,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFELEM = CC_UNDEFINED +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%AREA = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XYZCEN(IAXIS:KAXIS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%XYZCEN = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SHARED(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%SHARED = .FALSE. +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BLK_TAG(1:NFACE));MESHES(NM)%CUT_FACE(ICF)%BLK_TAG= .FALSE. +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%LINK_LEV(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%LINK_LEV = CC_UNDEFINED -! FIRST .... LAST original list -! FIRST ... MID first half of list -! MID+1 ... LAST 2nd half of list +!Integrals to be used in cut-cell volume and centroid computations. +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%INXAREA = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%INXSQAREA = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA = 0._EB -MID = (FIRST + LAST)/2 +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI(1:2,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%BODTRI = CC_UNDEFINED -CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, FIRST, MID) ! sort first half of list -CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, MID+1, LAST) ! sort 2nd half of list +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKZ(LOW_IND:HIGH_IND,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%UNKZ = CC_UNDEFINED -! combine two lists into one -I1 = 1 -I2 = 1 -N1 = MID + 1 - FIRST -N2 = LAST - MID -N = LAST + 1 - FIRST -DO I = 1, N - IF (I1 .GT. N1 ) THEN ! no more in 1st half so copy item from 2nd half - IP2 = PERM(MID + I2) - PERM_COPY(I) = IP2 - I2 = I2 + 1 - CYCLE - ENDIF +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENLOW(IAXIS:KAXIS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%XCENLOW = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%XCENHIGH(IAXIS:KAXIS,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%XCENHIGH = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(MAX_DIM+1,LOW_IND:HIGH_IND,1:NFACE)) +MESHES(NM)%CUT_FACE(ICF)%CELL_LIST = CC_UNDEFINED - IF (I2 .GT. N2 ) THEN ! no more in 2nd half so copy item from first half - IP1 = PERM(FIRST + I1 - 1) - PERM_COPY(I) = IP1 - I1 = I1 + 1 - CYCLE +IF(MESHES(NM)%CUT_FACE(ICF)%STATUS==CC_INBOUNDARY) THEN + ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST = 1._EB + ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFACE_ORIGIN = NOT_BLOCKED +ELSE + IF(PRESENT(IBNDINT)) THEN + IF(IBNDINT>2) RETURN ! Gas cut-face not in block boundary. ENDIF +ENDIF +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%SURF_INDEX = CC_UNDEFINED - IP1 = PERM(FIRST + I1 - 1) - IP2 = PERM(MID + I2) - CALL COMPARE_VERTS(VERTS, NVERTS, IP1, IP2, RESULT) - IF (RESULT .EQ. -1) THEN ! sort in increasing order - PERM_COPY(I) = IP1 - I1 = I1 + 1 - ELSE - PERM_COPY(I) = IP2 - I2 = I2 + 1 - ENDIF -END DO -DO I = 1, N - PERM(FIRST + I - 1) = PERM_COPY(I) -END DO +RETURN +END SUBROUTINE NEW_FACE_ALLOC -END SUBROUTINE MAKE_PERMUTATION_ARRAY -END MODULE COMPLEX_GEOMETRY +! -------------------------- ALLOC_FACE_STATE_VARS ------------------------------------- +SUBROUTINE ALLOC_FACE_STATE_VARS(NM,ICF,NFACE,IBNDINT) -!> \brief Grid related complex-geometry routines. +INTEGER, INTENT(IN) :: NM,ICF,NFACE +INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT -MODULE COMPLEX_GEOMETRY_GRID -USE PRECISION_PARAMETERS, ONLY: EB -USE GLOBAL_CONSTANTS -USE MESH_POINTERS -USE COMP_FUNCTIONS, ONLY: CURRENT_TIME -USE TYPES, ONLY: BOUNDARY_COORD_TYPE, BOUNDARY_PROP1_TYPE, CFACE_TYPE, CC_CUTCELL_TYPE, CC_CUTFACE_TYPE, & - CC_CUTEDGE_TYPE, WALL_TYPE, EXTERNAL_WALL_TYPE -USE COMPLEX_GEOMETRY, ONLY: BLOCK_CC_SOLID_EXTWALLCELLS,GEOFCT,CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,CCGUARD, & - CC_MATVEC_DEFINED,GEOMEPS,DELTA_INT,DELTA_VERT,DEBUG_SET_CUTCELLS,DEBUG_WAIT,DIST_THRES, & - GET_CARTCELL_CUTCELLS_TIME_INDEX,BODINT_PLANE_TYPE,INTERSECT_CONE_AABB,INTERSECT_CYLINDER_AABB, & - INTERSECT_OBB_AABB,INTERSECT_SPHERE_AABB,READ_GEOM,ROTATION_MATRIX,WRITE_GEOM,WRITE_GEOM_ALL,CC_SOLID, & - CC_VGSC,CC_CGSC,CC_FGSC,CC_IDCF,CC_UNKZ,CC_GASPHASE,CC_CUTCFE,CC_IDRC,CC_FTYPE_CFGAS,CC_FTYPE_CFINB, & - CC_FTYPE_RGGAS,CC_IDCC,CC_EGSC,CC_IDCE,CC_INBOUNDARY,CC_UNDEFINED,CC_NCVARS,CC_UNKH,CC_UNKF, & - FDS_AREA_GEOM,INDEX_UNDEFINED,INIT_CFACE_CELL,INT_N_EXT_PTS,INT_P_IND,INT_TMP_IND,INT_VEL_IND, & - INT_RHO_IND,INT_H_IND,INT_RSUM_IND,INT_MU_IND,INT_MUDNS_IND,INT_RHO0_IND,INT_FV_IND,INT_DHDX_IND, & - INT_WCEN_IND,INT_VELS_IND,CC_ETYPE_EP,CC_ETYPE_SCINB,CC_FTYPE_SVERT,CC_ETYPE_RCGAS,CC_ETYPE_RGGAS, & - CC_ETYPE_CFGAS,CC_FTYPE_RCGAS,CC_FTYPE_CCGAS,GET_REGULAR_CUT_EDGES_BC,GET_SOLID_CUTCELL_EDGES_BC, & - LOOSEPS,LU_SETCC,MAX_INTERP_POINTS,MESH_CC_EXCHANGE_TIME_INDEX,CCCOMPUTE_RADIATION_TIME_INDEX, & - CC_DENSITY_TIME_INDEX,CC_SET_DATA_TIME_INDEX,INIT_CUTCELL_DATA_TIME_INDEX,CC_VELOCITY_FLUX_TIME_INDEX, & - CC_COMPUTE_VISCOSITY_TIME_INDEX,CC_INTERP_FACE_VEL_TIME_INDEX,CC_DIVERGENCE_PART_1_TIME_INDEX, & - CC_END_STEP_TIME_INDEX,CC_TARGET_VELOCITY_TIME_INDEX,CC_NO_FLUX_TIME_INDEX, & - CC_COMPUTE_VELOCITY_ERROR_TIME_INDEX,MIN_VOL_FACTOR,NQT2C,N_CUTCELLS_PROC,NGUARD,N_INB_CUTFACES_PROC, & - N_INT_CVARS,N_INT_CCVARS,N_REG_CUTFACES_PROC,NNZ_ROW_H,N_INT_FVARS,N_LINK_ATTMP_F, & - N_SET_CUTCELLS_3D_CALLS,NM_START,N_REQ11,N_REQ12,N_REQ112,N_REQ13,REQ11,REQ112,REQ12,REQ13, & - BODINT_PLANE,BODINT_PLANE2,CELLRT,FACERT,XFACE,YFACE,ZFACE,XCELL,YCELL,ZCELL,DXFACE,DYFACE,DZFACE, & - DXCELL,DYCELL,DZCELL,X1FACE,X2FACE,X3FACE,X2CELL,X3CELL,DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL, & - CC_N_CRS,CC_MAXCROSS_X2,CC_SVAR_CRS,CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX,CC_IS_CRS2, & - CC_SEG_TAN,X1NOC,X2NOC,X3NOC,SPCELLS_TO_BLOCK,SPCELLS_TO_BLOCK_AUX,N_SPCELLS_TO_BLOCK,IPARM, & - POINT_IN_POLYGON,SEARCH_OTHER_MESHES_FACE,CHECK_WALL_CELL_PLANE_MATCH,CC_INIT_GEOM, & - ALLOCATE_BODINT_PLANE,GET_BODINT_PLANE,GET_X2_INTERSECTIONS,GET_X2_VERTVAR,GET_CARTEDGE_CUTEDGES, & - GET_BODX2_INTERSECTIONS,GET_BODX3_INTERSECTIONS,GET_CARTFACE_CUTEDGES,GET_CARTCELL_CUTEDGES, & - GET_CARTFACE_CUTFACES,GET_CARTCELL_CUTFACES,GET_CARTCELL_CUTCELLS,GET_CELL_LINK_INFO, & - EXCHANGE_CC_NOADVANCE_INFO,BLOCK_SMALL_UNLINKED_CUTCELLS,ALLOC_FACE_STATE_VARS,ALLOC_CELL_STATE_VARS, & - SET_CUTCELLS_TIME_INDEX,TRIANGULATE,TRILINEAR,VALID_TRIANGLE,VAL_TESTX_LOW,VAL_TESTX_HIGH, & - VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH,T_CC_USED,WRITE_SET_CUTCELLS_TIMINGS, & - MAKE_UNIQUE_VERT_ARRAY,AVERAGE_FACE_VALUES,ADIFF_INFO_FACTOR,SNAP_DIST_FACTOR,CC_INBOUNDCC, & - CC_INBOUNDCF,CC_NVVARS,CC_NEVARS,CC_NFVARS,CC_ETYPE_CFINB,NODS_WSEL,EDGS_WSEL,NODS_VLEL,GAMMA_MULT, & - DELTA_TBIN,GLOBAL_DELTA_CELL,GLOBAL_DELTA_EDGE,GLOBAL_DELTA_FACE,BLOCKED_SPECIAL_CELL,CC_NEDGECROSS, & - CC_NCUTEDGE,CC_NCUTFACE,CC_NCUTCELL,ILO_CELL,IHI_CELL,JLO_CELL,JHI_CELL,KLO_CELL,KHI_CELL,ILO_FACE, & - IHI_FACE,JLO_FACE,JHI_FACE,KLO_FACE,KHI_FACE,NXB,NYB,NZB,INSERT_CUT_CELL,INSERT_CUT_FACE, & - CUT_EDGE_ARRAY_REALLOC,NEW_EDGE_ALLOC,CUT_FACE_ARRAY_REALLOC,FACE_DEALLOC,NEW_FACE_ALLOC, & - CUT_CELL_ARRAY_REALLOC,CELL_DEALLOC,NEW_CELL_ALLOC,NOT_BLOCKED,BLOCKED_SPLIT_CELL,BLOCKED_REFI_INTER, & - BLOCKED_CAVITY_CELL +! !Integrals to be used in cut-cell volume and centroid computations. +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%INXSQAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JNYSQAREA) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%KNZSQAREA) -IMPLICIT NONE (TYPE,EXTERNAL) -PRIVATE +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKH(LOW_IND:HIGH_IND,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%UNKH = CC_UNDEFINED +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%RHO_D_DZDN(1:N_TOTAL_SCALARS,1:NFACE)) +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%H_RHO_D_DZDN(1:N_TOTAL_SCALARS,1:NFACE)) +MESHES(NM)%CUT_FACE(ICF)%RHO_D_DZDN = 0._EB +MESHES(NM)%CUT_FACE(ICF)%H_RHO_D_DZDN = 0._EB -PUBLIC :: GET_CFACE_INDEX, POINT_IN_CFACE, RANDOM_CFACE_XYZ, SET_CUTCELLS_3D +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%ZZ_FACE(1:N_TOTAL_SCALARS,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%ZZ_FACE = 0._EB +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%TMP_FACE(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%TMP_FACE = 0._EB -CONTAINS +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%VEL(1:NFACE), MESHES(NM)%CUT_FACE(ICF)%VELS(1:NFACE), & + MESHES(NM)%CUT_FACE(ICF)%FN(1:NFACE), MESHES(NM)%CUT_FACE(ICF)%FN_B(1:NFACE), & + MESHES(NM)%CUT_FACE(ICF)%VEL_SAVE(1:NFACE)) +MESHES(NM)%CUT_FACE(ICF)%VEL = 0._EB; MESHES(NM)%CUT_FACE(ICF)%VELS = 0._EB +MESHES(NM)%CUT_FACE(ICF)%FN = 0._EB; MESHES(NM)%CUT_FACE(ICF)%VEL_SAVE = 0._EB +MESHES(NM)%CUT_FACE(ICF)%FN_B = 0._EB; -SUBROUTINE SET_CUTCELLS_3D -USE MPI_F08 -USE TRAN, ONLY : TRANS +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%JDH(1:2,1:2,1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%JDH = CC_UNDEFINED +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKF(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%UNKF = CC_UNDEFINED + +IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) THEN + IF(PRESENT(IBNDINT)) THEN + IF(IBNDINT>2) RETURN ! Gas cut-face not in block boundary. + ENDIF +ENDIF +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%CFACE_INDEX(1:NFACE)); MESHES(NM)%CUT_FACE(ICF)%CFACE_INDEX = CC_UNDEFINED -! Local indexes: -INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI -INTEGER :: I,J,K,KK -INTEGER :: X1AXIS, X2AXIS, X3AXIS -INTEGER :: XIAXIS, XJAXIS, XKAXIS -INTEGER :: X2LO, X2HI, X3LO, X3HI -INTEGER :: X2LO_CELL, X2HI_CELL, X3LO_CELL, X3HI_CELL -INTEGER :: ISTR, IEND, JSTR, JEND, KSTR, KEND -INTEGER :: NM, NOM +RETURN +END SUBROUTINE ALLOC_FACE_STATE_VARS -! Miscellaneous: -REAL(EB), DIMENSION(MAX_DIM) :: PLNORMAL -INTEGER, DIMENSION(MAX_DIM) :: INDX1 -REAL(EB) :: X1PLN, X3RAY -LOGICAL :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY -INTEGER :: NCUTFACE_IAXIS, NCUTFACE_JAXIS, NCUTFACE_KAXIS, ICE1, ICF1, NFACE, IERR, & - NCUTEDGE_IBCC, NCUTEDGE_IBCF -REAL(EB):: CF_AREA_IAXIS=0._EB, CF_AREA_JAXIS=0._EB, CF_AREA_KAXIS=0._EB, & - CF_INXAREA_IAXIS=0._EB,CF_INXAREA_JAXIS=0._EB,CF_INXAREA_KAXIS=0._EB, & - CF_INXSQAREA_IAXIS=0._EB,CF_INXSQAREA_JAXIS=0._EB,CF_INXSQAREA_KAXIS=0._EB, & - CF_JNYSQAREA_IAXIS=0._EB,CF_JNYSQAREA_JAXIS=0._EB,CF_JNYSQAREA_KAXIS=0._EB, & - CF_KNZSQAREA_IAXIS=0._EB,CF_KNZSQAREA_JAXIS=0._EB,CF_KNZSQAREA_KAXIS=0._EB -REAL(EB):: SLEN_GEOM, AREA_GEOM, VOLUME_GEOM, SLEN_IBCC, SLEN, DV(MAX_DIM), XYZCEN_GEOM(MAX_DIM), & - DM_XYZCEN(MAX_DIM), CCGP_XYZCEN(MAX_DIM), DM_XYZCEN_AUX(MAX_DIM), CCGP_XYZCEN_AUX(MAX_DIM) -INTEGER :: SEG(NOD1:NOD2), NEDGE, IEDGE, IFACE, IG +! ---------------------- GET_CARTCELL_CUTEDGES ---------------------------------- -INTEGER :: NCUTFACE_INB, ICC1, ICC2, NCELL, IGC, ICF2, JCF2, JCF, FTYPE, ILH, CELL_BLOCK_IOR -REAL(EB):: CF_AREA_INB=0._EB, CF_INXAREA_INB=0._EB, CF_INXSQAREA_INB=0._EB, & - CF_JNYSQAREA_INB=0._EB, CF_KNZSQAREA_INB=0._EB, CF_AREA_INB_AUX=0._EB, ACRT -REAL(EB):: CC_VOLUME_INB=0._EB, DM_VOLUME=0._EB, GP_VOLUME=0._EB, & - CC_VOLUME_INB_AUX=0._EB, DM_VOLUME_AUX=0._EB, GP_VOLUME_AUX=0._EB -INTEGER, DIMENSION(5) :: MIN_CC_IJK_ICCJCC, MAX_CC_IJK_ICCJCC -REAL(EB):: MIN_CC_VOL, MAX_CC_VOL, MIN_ALPHA_CV, MAX_ALPHA_CV -LOGICAL, ALLOCATABLE, DIMENSION(:) :: CC_COMPUTE_MESH, CC_COMPUTE_MESH_AUX -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_ZMAX_AUX +SUBROUTINE GET_CARTCELL_CUTEDGES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) -INTEGER :: IW,II,JJ,IIF,JJF,KKF,IIOF,JJOF,KKOF,LOHIF,IOR,CT,NCFACE_CUTCELL,NFACE_CELL,AX,SIDE,ICC,JCC,ICFC,IFC -TYPE(MESH_TYPE), POINTER :: M, M2 -TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC -TYPE(WALL_TYPE), POINTER :: WC -TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC -TYPE(BOUNDARY_PROP1_TYPE), POINTER :: B1 -TYPE(CC_CUTCELL_TYPE), POINTER :: CC -TYPE(CC_CUTFACE_TYPE), POINTER :: CF -TYPE(CC_CUTEDGE_TYPE), POINTER :: CE -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME -INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) -INTEGER :: IIO,JJO,KKO,IOGC,JOGC,KOGC +USE TRAN, ONLY : TRANS -REAL(EB) :: TNOW +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -LOGICAL :: WRITE_CFACE_STATS = .FALSE. -LOGICAL :: EARLY_RETURN_FROM_SET_CUTCELLS +! Local Variables: +INTEGER :: II2, JJ2, KK2, IG, IWSEDG, SEG(NOD1:NOD2),X1AXIS, X1LO, X1HI, IPLN, LSTR, LEND +REAL(EB):: XYZ1(IAXIS:KAXIS), XYZ2(IAXIS:KAXIS), PLNORMAL(IAXIS:KAXIS), X1PLN, MINX, MAXX +LOGICAL :: DROPSEG, OUTPLANE, SAMEINT +REAL(EB):: DOT1, DOT2, DENOM, PLANEEQ, SVARI, XYZV1(IAXIS:KAXIS), XYZV2(IAXIS:KAXIS), SLEN, STANI(IAXIS:KAXIS) +INTEGER :: NWCROSS, IBCR, IDUM, INOD1, INOD2, NVERT, NEDGE, IEDGE, CEI, NWCROSS_SVAR, X1NOC +REAL(EB):: SVAR1, SVAR2, SVAR12, XPOS, DV(IAXIS:KAXIS) +REAL(EB), ALLOCATABLE, DIMENSION(:) :: SVAR_AUX +INTEGER :: X2AXIS, EDGE_START, COUNT, CEI2, I, J, K, I_NP, IFCELL, ITRI, IG1 +REAL(EB):: XP(IAXIS:KAXIS), NP(IAXIS:KAXIS), ADD_XSEG(IAXIS:KAXIS), X1X2(IAXIS:KAXIS), X1O1(IAXIS:KAXIS), X1O2(IAXIS:KAXIS), & + X1T1_OPNOD, X1T2_OPNOD +LOGICAL :: TWOBOD_EDG, INPL_TEST, ANG_FLG1, ANG_FLG2, ANG_FLG3 +INTEGER, PARAMETER :: AXIS(1:6)=(/ IAXIS, IAXIS, JAXIS, JAXIS, KAXIS, KAXIS /) +INTEGER, PARAMETER :: IADD(1:6)=(/ -1, 0, 0, 0, 0, 0 /) +INTEGER, PARAMETER :: JADD(1:6)=(/ 0, 0, -1, 0, 0, 0 /) +INTEGER, PARAMETER :: KADD(1:6)=(/ 0, 0, 0, 0, -1, 0 /) +LOGICAL, ALLOCATABLE, DIMENSION(:) :: SOLID_EDGE +INTEGER, PARAMETER :: ON(1:3) =(/ 3, 1, 2 /) +INTEGER :: T1, E1, ON1, T2, E2, ON2 +REAL(EB) :: TNOW, EDGECUBE(LOW_IND:HIGH_IND,IAXIS:KAXIS) +TYPE(BODINT_CELL_EDGE_TYPE) :: BODINT_CELL_EDGE +LOGICAL :: FOUND_SEG -INTEGER, SAVE :: CALL_COUNT = 0 +! REAL(QB) :: DVQ(IAXIS:KAXIS), SLENQ, STANIQ(IAXIS:KAXIS), DENOMQ, PLANEEQQ -! GET_CUTCELL_VERBOSE variables: -INTEGER :: IPROC, NMESH_CC, NMESH_CC_AUX, TAG -TYPE (MPI_STATUS) :: MPISTATUS -CHARACTER(MESSAGE_LENGTH) :: VERBOSE_FILE, VERBOSE_FILE_AUX -CHARACTER(1), DIMENSION(3), PARAMETER :: AXSTR(1:3) = (/ 'X', 'Y', 'Z' /) -REAL(EB) :: CPUTIME, CPUTIME_START, CPUTIME_MESH, CPUTIME_START_MESH -INTEGER :: MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL, SUM_FACE, SUM_CCELL=0 -TYPE(CFACE_TYPE), POINTER :: CFA -REAL(EB), ALLOCATABLE, DIMENSION(:) :: GEOM_AREA_SURF -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW -INTEGER, ALLOCATABLE, DIMENSION(:) :: GEOM_SURF -INTEGER :: ICF, SURF_INDEX, SUM_CC, IDIM +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +INTEGER :: NCUTEDG -LOGICAL, SAVE :: FIRST_CALL_ARG=.TRUE., FIRST_CALL_ARG2=.TRUE. +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTEDGES for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTEDGES for mesh :',NM,' ..' +ENDIF -REAL(EB):: VERT_AUX(IAXIS:KAXIS),CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) -INTEGER :: ING,INOD,IWSEL,IEL,FACE_AUX(NOD1:NOD3),VOL_AUX(NOD1:NOD4),N_SPCELLCF_TOT,N_SPCELL_TOT -CHARACTER(100) :: FILENAME +TNOW=CURRENT_TIME() -CALL CC_GRID_GLOBAL_INIT -IF (STOP_STATUS==SETUP_STOP) RETURN +EDGE_START= MESHES(NM)%N_CUTEDGE_MESH + 1 -CALL CC_GRID_ALLOCATE_BUILD_SCRATCH +! BODINT_CELL: +GEOM_LOOP : DO IG=1,N_GEOMETRY -! Main Loop over Meshes: -MAIN_MESH_LOOP : DO NM=1,NMESHES - CALL CC_GRID_BUILD_CUTCELL_MESH(NM) - IF (STOP_STATUS==SETUP_STOP) RETURN -ENDDO MAIN_MESH_LOOP + ! The IG wet surface edges will be used to obtain intersections with grid planes on + ! increasing svar order. + ALLOCATE(BODINT_CELL_EDGE%SVAR(CC_DELTA_NBCROSS)) -CALL CC_GRID_RELEASE_BUILD_SCRATCH + IWSEDG_LOOP : DO IWSEDG=1,GEOMETRY(IG)%N_EDGES -POSTBUILD_MESH_LOOP : DO NM=1,NMESHES - CALL CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) - IF (STOP_STATUS==SETUP_STOP) RETURN -ENDDO POSTBUILD_MESH_LOOP + ! Seg Nodes location: + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEDG) -CALL CC_GRID_EXCHANGE_AND_REBLOCK + XYZ1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) -MAIN_MESH_LOOP_3 : DO NM=1,NMESHES - CALL CC_GRID_POSTPROCESS_AND_CLEANUP(NM) -ENDDO MAIN_MESH_LOOP_3 + DO X1AXIS=IAXIS,KAXIS + EDGECUBE( LOW_IND,X1AXIS) = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) + EDGECUBE(HIGH_IND,X1AXIS) = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) + ENDDO -! Finally allocate Face and cell variables, compute area and volume factors: -MAIN_MESH_LOOP_4 : DO NM=1,NMESHES - CALL CC_GRID_ALLOCATE_STATE_VARS(NM) -ENDDO MAIN_MESH_LOOP_4 + ! Discard if segment is outside of volume of interest: + IF (EDGECUBE( LOW_IND,IAXIS) > X(IBAR)+REAL(NGUARD,EB)*DX(IBAR)) CYCLE + IF (EDGECUBE(HIGH_IND,IAXIS) < X( 0)-REAL(NGUARD,EB)*DX( 1)) CYCLE + IF (EDGECUBE( LOW_IND,JAXIS) > Y(JBAR)+REAL(NGUARD,EB)*DY(JBAR)) CYCLE + IF (EDGECUBE(HIGH_IND,JAXIS) < Y( 0)-REAL(NGUARD,EB)*DY( 1)) CYCLE + IF (EDGECUBE( LOW_IND,KAXIS) > Z(KBAR)+REAL(NGUARD,EB)*DZ(KBAR)) CYCLE + IF (EDGECUBE(HIGH_IND,KAXIS) < Z( 0)-REAL(NGUARD,EB)*DZ( 1)) CYCLE -CALL CC_GRID_LOG_PROCESSING_TIME + ! Test if Segment lays on plane, If so drop, unless SOLID-SOLID with triangles off plane, it was taken care of + ! previously: This is expensive think of switching to pointer X1FACEP. + DROPSEG = .FALSE. + ADD_XSEG= 0._EB + X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS + SELECT CASE(X1AXIS) + CASE(IAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) + ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE + ALLOCATE(DX1FACE(ISTR:IEND)); DX1FACE = DXFACE + X1LO = ILO_FACE-CCGUARD; X1HI = IHI_FACE+CCGUARD + CASE(JAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 1._EB, 0._EB /) + ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE + ALLOCATE(DX1FACE(JSTR:JEND)); DX1FACE = DYFACE + X1LO = JLO_FACE-CCGUARD; X1HI = JHI_FACE+CCGUARD + CASE(KAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 0._EB, 1._EB /) + ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE + ALLOCATE(DX1FACE(KSTR:KEND)); DX1FACE = DZFACE + X1LO = KLO_FACE-CCGUARD; X1HI = KHI_FACE+CCGUARD + END SELECT -CALL CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST + ! Optimized for UG: + X1NOC=TRANS(NM)%NOC(X1AXIS) + MINX = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) + MAXX = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) -! Fill Guardcells for CCVAR CC_CGSC and CUT_CELL for meshes assigned to MPI process: -CALL SET_GC_CUTCELLS_3D + IF (MAXX-MINX < GEOMEPS) THEN ! SEGMENT ALIGNED WITH PLANE. + LSTR = X1LO; LEND = X1HI + IF(X1NOC==0) THEN ! Optimized for Uniform Grid. + LSTR = MAX(X1LO, FLOOR((MINX-GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) + LEND = MIN(X1HI,CEILING((MAXX+GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) + ENDIF + X1X2(IAXIS:KAXIS) = XYZ2(IAXIS:KAXIS)-XYZ1(IAXIS:KAXIS); X1X2=X1X2/NORM2(X1X2) + T1 = GEOMETRY(IG)%EDGE_FACES(2,IWSEDG) + E1 = GEOMETRY(IG)%EDGE_FACES(3,IWSEDG) + ON1= GEOMETRY(IG)%FACES(3*(T1-1)+ON(E1)) + X1T1_OPNOD = GEOMETRY(IG)%VERTS(MAX_DIM*(ON1-1)+X1AXIS) + T2 = GEOMETRY(IG)%EDGE_FACES(4,IWSEDG) + E2 = GEOMETRY(IG)%EDGE_FACES(5,IWSEDG) + ON2= GEOMETRY(IG)%FACES(3*(T2-1)+ON(E2)) + X1T2_OPNOD = GEOMETRY(IG)%VERTS(MAX_DIM*(ON2-1)+X1AXIS) -! Allocate and define entries for solid side CFACES: -IF(PERIODIC_TEST/=105) CALL GET_EXT_INB_CUTFACES_TO_CFACE + X1O1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(ON1-1)+IAXIS:MAX_DIM*(ON1-1)+KAXIS)-XYZ1(IAXIS:KAXIS) + X1O2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(ON2-1)+IAXIS:MAX_DIM*(ON2-1)+KAXIS)-XYZ1(IAXIS:KAXIS) + X1O1 = X1O1/NORM2(X1O1); X1O2 = X1O2/NORM2(X1O2) + DO IPLN=LSTR,LEND + X1PLN = X1FACE(IPLN) + INPL_TEST = ABS(X1PLN-MAXX) < GEOMEPS + SPECIAL_SEG_IF : IF (INPL_TEST) THEN + ! Test that nodes on seg triangles not part of SEG are on + ! on side of X1PLN, and both normals have component in -X1AXIS dir. + IF ( (X1T1_OPNOD-X1PLN)<-GEOMEPS .AND. (X1T2_OPNOD-X1PLN)<-GEOMEPS ) THEN !-X1AXIS + ANG_FLG1 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T1)GEOMEPS .AND. X1O2(X1AXIS)GEOMEPS .AND. X1O1(X1AXIS)GEOMEPS .AND. (X1T2_OPNOD-X1PLN)>GEOMEPS ) THEN !+X1AXIS + ANG_FLG1 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T1)>-GEOMEPS .AND. GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T2)>-GEOMEPS + ANG_FLG2 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T2)<-GEOMEPS .AND. X1O2(X1AXIS)>X1O1(X1AXIS) + ANG_FLG3 = GEOMETRY(IG)%FACES_NORMAL(X1AXIS,T1)<-GEOMEPS .AND. X1O1(X1AXIS)>X1O2(X1AXIS) + IF (ANG_FLG1 .OR. ANG_FLG2 .OR. ANG_FLG3) THEN + ADD_XSEG(X1AXIS)= 10._EB*GEOMEPS + INPL_TEST =.FALSE. + ENDIF + ENDIF + ENDIF SPECIAL_SEG_IF + DROPSEG=( INPL_TEST .OR. ((X1FACE(X1LO)-MAXX)>GEOMEPS) .OR. ((MAXX-X1FACE(X1HI))>GEOMEPS)) + IF (DROPSEG) EXIT + ENDDO + ENDIF + IF (DROPSEG) THEN + DEALLOCATE(X1FACE,DX1FACE) + EXIT ! EXIT X1AXIS=IAXIS:KAXIS LOOP + ENDIF + DEALLOCATE(X1FACE,DX1FACE) + ENDDO X1AXIS_LOOP + IF (DROPSEG) CYCLE -CALL CC_GRID_FINALIZE_BOOKKEEPING(EARLY_RETURN_FROM_SET_CUTCELLS) -IF (EARLY_RETURN_FROM_SET_CUTCELLS) RETURN + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + ! Edge length and tangent unit vector: + DV(IAXIS:KAXIS) = XYZ2(IAXIS:KAXIS) - XYZ1(IAXIS:KAXIS) + SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) ! Segment length. + STANI(IAXIS:KAXIS) = DV(IAXIS:KAXIS) * SLEN**(-1._EB) ! Segment tangent versor. + ! ELSE + ! ! Edge length and tangent unit vector: + ! DVQ(IAXIS:KAXIS) = REAL(XYZ2(IAXIS:KAXIS),QB) - REAL(XYZ1(IAXIS:KAXIS),QB) + ! SLENQ = SQRT( DVQ(IAXIS)**2._QB + DVQ(JAXIS)**2._QB + DVQ(KAXIS)**2._QB ) ! Segment length. + ! STANIQ(IAXIS:KAXIS) = DVQ(IAXIS:KAXIS) * SLENQ**(-1._QB) ! Segment tangent versor. + ! SLEN = REAL(SLENQ,EB) + ! STANI(IAXIS:KAXIS) = REAL(STANIQ(IAXIS:KAXIS),EB) + ! ENDIF -CALL CC_GRID_WRITE_VERBOSE_SUMMARY + ! Add segment ends as intersections: + BODINT_CELL_EDGE%NWCROSS = 2 ! Nodes 1,2 of segment are considered intersection. + BODINT_CELL_EDGE%SVAR(1) = 0 ! Coordinate along stani of Node 1. + BODINT_CELL_EDGE%SVAR(2) = SLEN ! Coordinate along stani of Node 2. -RETURN -CONTAINS + ! Now find intersections: + X1AXIS_LOOP2 : DO X1AXIS=IAXIS,KAXIS + SELECT CASE(X1AXIS) + CASE(IAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) + ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE + ALLOCATE(DX1FACE(ISTR:IEND)); DX1FACE = DXFACE + X1LO = ILO_FACE-CCGUARD; X1HI = IHI_FACE+CCGUARD + CASE(JAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 1._EB, 0._EB /) + ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE + ALLOCATE(DX1FACE(JSTR:JEND)); DX1FACE = DYFACE + X1LO = JLO_FACE-CCGUARD; X1HI = JHI_FACE+CCGUARD + CASE(KAXIS) + PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 0._EB, 1._EB /) + ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE + ALLOCATE(DX1FACE(KSTR:KEND)); DX1FACE = DZFACE + X1LO = KLO_FACE-CCGUARD; X1HI = KHI_FACE+CCGUARD + END SELECT -SUBROUTINE CC_GRID_GLOBAL_INIT + ! Optimized for UG: + X1NOC=TRANS(NM)%NOC(X1AXIS) + MINX = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) + MAXX = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) + LSTR = X1LO; LEND = X1HI + IF(X1NOC==0) THEN ! Optimized for Uniform Grid. + LSTR = MAX(X1LO, FLOOR((MINX-GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) + LEND = MIN(X1HI,CEILING((MAXX+GEOMEPS-X1FACE(X1LO))/DX1FACE(X1LO)) + X1LO) + ENDIF -IF (MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN - WRITE(LU_ERR,*) ' ' - WRITE(LU_ERR,*) 'SET_CUTCELLS_3D : Cut-Cell computation in VERBOSE mode, 4 tasks to perform:' -ENDIF + DO IPLN=LSTR,LEND + X1PLN = X1FACE(IPLN); + OUTPLANE = ((X1PLN-MAXX) > GEOMEPS) .OR. ((MINX-X1PLN) > GEOMEPS) + IF (OUTPLANE) CYCLE ! Make sure to drop jstr, jend if out of segment length. -! Reset variables: -CC_NEDGECROSS = 0 -CC_NCUTEDGE = 0 -CC_NCUTFACE = 0 -CC_NCUTCELL = 0 + ! Drop intersections in segment nodes: + ! Compute: dot(plnormal, xyzv - xypl): + DOT1 = XYZ1(X1AXIS) - X1PLN + DOT2 = XYZ2(X1AXIS) - X1PLN + IF (ABS(DOT1) <= GEOMEPS) CYCLE + IF (ABS(DOT2) <= GEOMEPS) CYCLE -! Check Meshes Boundaries match, requirement to get consistent ghost and internal cut-cells. -CALL CHECK_WALL_CELL_PLANE_MATCH; IF (STOP_STATUS==SETUP_STOP) RETURN -! Get geometry triangle bins in Cartesian directions: -CALL GET_GEOM_TRIBIN + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + ! Now regular case: Find svar and insert in BODINT_CELL%SVAR(:,IWSEDG): + DENOM = STANI(X1AXIS) ! dot(stani,plnormal) + PLANEEQ= DOT1 ! dot(xyz1(IAXIS:KAXIS),plnormal) - x1pln + SVARI = - PLANEEQ / DENOM + ! ELSE + ! DENOMQ = STANIQ(X1AXIS) ! dot(stani,plnormal) + ! PLANEEQQ = REAL(DOT1,QB) ! dot(xyz1(IAXIS:KAXIS),plnormal) - x1pln + ! SVARI = REAL(-PLANEEQQ/DENOMQ,EB) + ! ENDIF -! Snap to grid planes node positions in the work volume of this process: -CALL SNAP_GEOM_NODES -! Initialize GEOMETRY fields used by CC_IBM: -CALL CC_INIT_GEOM; IF (STOP_STATUS==SETUP_STOP) RETURN + ! Insertion sort, discard repeated intersections: + NWCROSS = BODINT_CELL_EDGE%NWCROSS + 1 + NWCROSS_SVAR = SIZE(BODINT_CELL_EDGE%SVAR,DIM=1) + IF (NWCROSS > NWCROSS_SVAR) THEN + ALLOCATE(SVAR_AUX(NWCROSS_SVAR+CC_DELTA_NBCROSS)); SVAR_AUX = -1._EB + SVAR_AUX(1:NWCROSS-1) = BODINT_CELL_EDGE%SVAR(1:NWCROSS-1) + CALL MOVE_ALLOC(FROM=SVAR_AUX,TO=BODINT_CELL_EDGE%SVAR) + ENDIF + BODINT_CELL_EDGE%SVAR(NWCROSS) = 1._EB / GEOMEPS + SAMEINT = .FALSE. + DO IBCR=1,NWCROSS + IF (ABS(SVARI - BODINT_CELL_EDGE%SVAR(IBCR)) < GEOMEPS) THEN + SAMEINT = .TRUE. + EXIT + ENDIF + IF ( SVARI < BODINT_CELL_EDGE%SVAR(IBCR) ) EXIT + ENDDO + IF (SAMEINT) CYCLE -TNOW=CURRENT_TIME() + ! Here copy from the back (updated nbcross) to the ibcr location: + DO IDUM = NWCROSS,IBCR+1,-1 + BODINT_CELL_EDGE%SVAR(IDUM) = BODINT_CELL_EDGE%SVAR(IDUM-1) + ENDDO + BODINT_CELL_EDGE%SVAR(IBCR) = SVARI + BODINT_CELL_EDGE%NWCROSS = NWCROSS -DEBUG_SET_CUTCELLS_COND : IF (DEBUG_SET_CUTCELLS) THEN - ! Write meshes file: - WRITE(FILENAME,'(A,A)') TRIM(CHID),'_meshes.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8)') NMESHES - MESH_LOOP : DO NM=1,NMESHES + ENDDO + DEALLOCATE(X1FACE,DX1FACE) + ENDDO X1AXIS_LOOP2 - IF (PROCESS(NM)/=MY_RANK) CYCLE + ! 3. The increasing svar intersections are used to define the INBOUNDCC type + ! cut-edges and Cartesian Cells containing them. Add to CUT_EDGE, define the + ! CUT_EDGE entry in CCVAR(i,j,k,CC_IDCE): + DO IEDGE=1,BODINT_CELL_EDGE%NWCROSS-1 - ! Mesh sizes: - NXB=MESHES(NM)%IBAR - NYB=MESHES(NM)%JBAR - NZB=MESHES(NM)%KBAR + ! Location along Segment: + SVAR1 = BODINT_CELL_EDGE%SVAR(IEDGE ) + SVAR2 = BODINT_CELL_EDGE%SVAR(IEDGE+1) - WRITE(33,'(4I8,6F24.16)') NM,NXB,NYB,NZB,MESHES(NM)%X(0),MESHES(NM)%X(NXB),& - MESHES(NM)%Y(0),MESHES(NM)%Y(NYB),& - MESHES(NM)%Z(0),MESHES(NM)%Z(NZB) - DO I=0,NXB - WRITE(33,'(4F24.16)') MESHES(NM)%X(I),MESHES(NM)%XC(I),MESHES(NM)%DXN(I),MESHES(NM)%DX(I) - ENDDO - DO J=0,NYB - WRITE(33,'(4F24.16)') MESHES(NM)%Y(J),MESHES(NM)%YC(J),MESHES(NM)%DYN(J),MESHES(NM)%DY(J) - ENDDO - DO K=0,NZB - WRITE(33,'(4F24.16)') MESHES(NM)%Z(K),MESHES(NM)%ZC(K),MESHES(NM)%DZN(K),MESHES(NM)%DZ(K) - ENDDO + ! Location of midpoint of cut-edge: + SVAR12 = 0.5_EB * (SVAR1+SVAR2) - ENDDO MESH_LOOP - CLOSE(33) + ! Define Cartesian cell this cut-edge belongs: + ! Optimized for UG version: + XPOS = XYZ1(IAXIS) + SVAR12*STANI(IAXIS) + ADD_XSEG(IAXIS) + IF(TRANS(NM)%NOC(IAXIS)==0)THEN + II2 = FLOOR( (XPOS-XFACE(ILO_FACE))/DXFACE(ILO_FACE) ) + ILO_CELL + ! Discard cut-edges on faces laying on x2hi and x3hi. + IF ( (II2 < ILO_CELL-CCGUARD) .OR. (II2 > IHI_CELL+CCGUARD) ) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO II2=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD + IF((XPOS-XFACE(II2-1)) >= 0._EB .AND. (XFACE(II2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF - ! Write geometry files: - WRITE(FILENAME,'(A,A)') TRIM(CHID),'_num_geometries.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I6,4F24.16)') N_GEOMETRY, GEOMEPS - CLOSE(33) - GEOM_LOOP : DO ING=1,N_GEOMETRY + XPOS = XYZ1(JAXIS) + SVAR12*STANI(JAXIS) + ADD_XSEG(JAXIS) + IF(TRANS(NM)%NOC(JAXIS)==0)THEN + JJ2 = FLOOR( (XPOS-YFACE(JLO_FACE))/DYFACE(JLO_FACE) ) + JLO_CELL + IF ( (JJ2 < JLO_CELL-CCGUARD) .OR. (JJ2 > JHI_CELL+CCGUARD) ) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO JJ2=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD + IF((XPOS-YFACE(JJ2-1)) >= 0._EB .AND. (YFACE(JJ2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF - ! Write Vertices: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_verts.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO INOD=1,GEOMETRY(ING)%N_VERTS - VERT_AUX(IAXIS:KAXIS) = GEOMETRY(ING)%VERTS(MAX_DIM*(INOD-1)+1:MAX_DIM*INOD) - WRITE(33,'(3F24.16)') VERT_AUX(IAXIS:KAXIS) - ENDDO - CLOSE(33) + XPOS = XYZ1(KAXIS) + SVAR12*STANI(KAXIS) + ADD_XSEG(KAXIS) + IF(TRANS(NM)%NOC(KAXIS)==0)THEN + KK2 = FLOOR( (XPOS-ZFACE(KLO_FACE))/DZFACE(KLO_FACE) ) + KLO_CELL + IF ( (KK2 < KLO_CELL-CCGUARD) .OR. (KK2 > KHI_CELL+CCGUARD) ) CYCLE + ELSE + FOUND_SEG=.FALSE. + DO KK2=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD + IF((XPOS-ZFACE(KK2-1)) >= 0._EB .AND. (ZFACE(KK2)-XPOS) > 0._EB) THEN + FOUND_SEG=.TRUE. + EXIT + ENDIF + ENDDO + IF(.NOT.FOUND_SEG) CYCLE + ENDIF - ! Write faces: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_faces.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IWSEL=1,GEOMETRY(ING)%N_FACES - FACE_AUX(NOD1:NOD3)=GEOMETRY(ING)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) - WRITE(33,'(4I10)') FACE_AUX(NOD1:NOD3),GEOMETRY(ING)%SURFS(IWSEL) - ENDDO - CLOSE(33) + ! CCVAR edge number: + IF ( MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) > 0 ) THEN ! There is already + ! an entry in CUT_EDGE. + CEI = MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) + ELSE ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%CCVAR(II2,JJ2,KK2,CC_IDCE) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ II2, JJ2, KK2, 0, CC_GS /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCC + ENDIF - ! Write Volumes: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_volus.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_VOLUS - VOL_AUX(NOD1:NOD4)=GEOMETRY(ING)%VOLUS(NODS_VLEL*(IEL-1)+1:NODS_VLEL*IEL) - WRITE(33,'(4I10)') VOL_AUX(NOD1:NOD4) + ! Add vertices, non repeated vertex entries at this point. + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT + ! Define vertices for this segment: + ! xv1 yv1 zv1 + ! IF(.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + XYZV1(IAXIS:KAXIS) = (/ XYZ1(IAXIS)+SVAR1*STANI(IAXIS), & + XYZ1(JAXIS)+SVAR1*STANI(JAXIS), & + XYZ1(KAXIS)+SVAR1*STANI(KAXIS) /) + CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) + ! xv2 yv2 zv2 + XYZV2(IAXIS:KAXIS) = (/ XYZ1(IAXIS)+SVAR2*STANI(IAXIS), & + XYZ1(JAXIS)+SVAR2*STANI(JAXIS), & + XYZ1(KAXIS)+SVAR2*STANI(KAXIS) /) + CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) + ! ELSE + ! XYZV1(IAXIS:KAXIS) = REAL((/ REAL(XYZ1(IAXIS),QB)+REAL(SVAR1,QB)*STANIQ(IAXIS), & + ! REAL(XYZ1(JAXIS),QB)+REAL(SVAR1,QB)*STANIQ(JAXIS), & + ! REAL(XYZ1(KAXIS),QB)+REAL(SVAR1,QB)*STANIQ(KAXIS) /),EB) + ! CALL INSERT_FACE_VERT(XYZV1,NM,CEI,NVERT,INOD1) + ! ! xv2 yv2 zv2 + ! XYZV2(IAXIS:KAXIS) = REAL((/ REAL(XYZ1(IAXIS),QB)+REAL(SVAR2,QB)*STANIQ(IAXIS), & + ! REAL(XYZ1(JAXIS),QB)+REAL(SVAR2,QB)*STANIQ(JAXIS), & + ! REAL(XYZ1(KAXIS),QB)+REAL(SVAR2,QB)*STANIQ(KAXIS) /),EB) + ! CALL INSERT_FACE_VERT(XYZV2,NM,CEI,NVERT,INOD2) + ! ENDIF + + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + 1 + CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE) = (/ INOD1, INOD2 /) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,NEDGE) = & + (/ GEOMETRY(IG)%EDGE_FACES(1,IWSEDG), & + GEOMETRY(IG)%EDGE_FACES(2,IWSEDG), & + GEOMETRY(IG)%EDGE_FACES(4,IWSEDG), IG /) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE ENDDO - CLOSE(33) - ! Write Edges: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edges.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_EDGES - WRITE(33,'(2I10)') GEOMETRY(ING)%EDGES(NOD1:NOD2,IEL) - ENDDO - CLOSE(33) + ENDDO IWSEDG_LOOP - ! Write FACE_EDGES: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_fcedg.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_FACES - WRITE(33,'(3I10)') GEOMETRY(ING)%FACE_EDGES(NOD1:NOD3,IEL) - ENDDO - CLOSE(33) + ! Deallocate BODINT_CELL_EDGE: + DEALLOCATE(BODINT_CELL_EDGE%SVAR) - ! Write EDGE_FACES: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edfac.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_EDGES - WRITE(33,'(5I10)') GEOMETRY(ING)%EDGE_FACES(NOD1:NOD4+1,IEL) +ENDDO GEOM_LOOP + +! Now filter out CC_INBOUNDCC cut-edges that lay within the SOLID: +DO CEI=EDGE_START,MESHES(NM)%N_CUTEDGE_MESH + ! Here we have cut-edges on the cell belonging to two or more bodies: + I = MESHES(NM)%CUT_EDGE(CEI)%IJK(IAXIS) + J = MESHES(NM)%CUT_EDGE(CEI)%IJK(JAXIS) + K = MESHES(NM)%CUT_EDGE(CEI)%IJK(KAXIS) + + ! First cut-edges in the cell: + NEDGE =MESHES(NM)%CUT_EDGE(CEI)%NEDGE + TWOBOD_EDG=.FALSE. + IF (NEDGE > 0) IG1 = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,1) + DO IEDGE=2,NEDGE + IF (MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) /= IG1) THEN + TWOBOD_EDG =.TRUE. + EXIT + ENDIF + ENDDO + ! Low-High x,y,z face Edges: + IF(.NOT.TWOBOD_EDG) THEN + IFCELL_DO : DO IFCELL=1,6 + CEI2 = MESHES(NM)%FCVAR(I+IADD(IFCELL),J+JADD(IFCELL),K+KADD(IFCELL),CC_IDCE,AXIS(IFCELL)) + IF (CEI2 < 1) CYCLE + DO IEDGE=1,MESHES(NM)%CUT_EDGE(CEI2)%NEDGE + IF (MESHES(NM)%CUT_EDGE(CEI2)%INDSEG(4,IEDGE) /= IG1) THEN + TWOBOD_EDG =.TRUE. + EXIT IFCELL_DO + ENDIF + ENDDO + ENDDO IFCELL_DO + ENDIF + IF(.NOT.TWOBOD_EDG) CYCLE + + ! Here we have cut-edges on the cell belonging to two or more bodies: + ! First discard if CELLRT=true, we won't be using cut-edges: + IF (CELLRT(I,J,K)) CYCLE + + ! Now figure out which edges are inside other SOLIDS: + ! Ray tracing in either X, Y or Z directions: + ! 1. For the segment center point P provide: + ! a. Its coordinates P={xp,yp,zp}. + ! b. Direction X1 for Ray shooting (IAXIS,JAXIS,KAXIS). + ALLOCATE(SOLID_EDGE(1:NEDGE)); SOLID_EDGE(1:NEDGE)=.FALSE. + DO IEDGE=1,NEDGE + ! No body associated with segment. Might not be needed. + IG = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) + IF ( IG < 1 ) CYCLE + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + XP(IAXIS:KAXIS) = 0.5_EB*(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + & + MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2))) + ! Direction NP: + NP(IAXIS:KAXIS) = 0._EB + DO I_NP=1,MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,IEDGE) + ITRI = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1+I_NP,IEDGE) + NP(IAXIS:KAXIS) = NP(IAXIS:KAXIS) + GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,ITRI) ENDDO - CLOSE(33) + X2AXIS = MAXLOC(ABS(NP(IAXIS:KAXIS)),DIM=1) + CALL GET_IS_SOLID_3D(X2AXIS,XP,I,J,K,SOLID_EDGE(IEDGE)) + ENDDO - ENDDO GEOM_LOOP -ENDIF DEBUG_SET_CUTCELLS_COND + ! Now drop SEGS with SOLID_EDGE(IEDGE)=true: + COUNT = 0 + DO IEDGE=1,NEDGE + IF (SOLID_EDGE(IEDGE)) CYCLE + COUNT=COUNT+1 + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,COUNT) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,COUNT) = & + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,IEDGE) + ENDDO -! Select MESHES assigned to MY_RANK and OMESHES of these. Cut-cells computed for all of them. Done in GET_GEOM_TRIBIN + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = COUNT + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,COUNT+1:NEDGE) = CC_UNDEFINED + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,COUNT+1:NEDGE) = CC_UNDEFINED + DEALLOCATE(SOLID_EDGE) +ENDDO + +T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX ) + CURRENT_TIME() - TNOW IF (GET_CUTCELLS_VERBOSE) THEN - NMESH_CC=0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH(NOM)) NMESH_CC = NMESH_CC + 1 + CALL CPU_TIME(CPUTIME) + NCUTEDG = 0 + DO CEI=1,MESHES(NM)%N_CUTEDGE_MESH + NCUTEDG = NCUTEDG + MESHES(NM)%CUT_EDGE(CEI)%NEDGE ENDDO - ! MY_RANK = 0 writes first: + WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-edges in mesh : ',NCUTEDG,'. ' IF (MY_RANK==0) THEN - ! Open file to write SET_CUTCELLS_3D progress: - WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' - OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') - WRITE(LU_ERR,*) ' ' - WRITE(LU_ERR,*) '2. Generate Cut-cells in Meshes :' - WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC, & - ' meshes in file ',TRIM(VERBOSE_FILE),'.' - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' - WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC,' meshes.' - WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' - WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process : ' - NMESH_CC_AUX = 0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH(NOM)) THEN - NMESH_CC_AUX = NMESH_CC_AUX + 1 - IF(NMESH_CC_AUX < NMESH_CC) THEN - WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' - WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' - ELSE - WRITE(LU_ERR,'(I4.4,A)') NOM,'.' - WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' - ENDIF - ENDIF - ENDDO - ENDIF - IF (N_MPI_PROCESSES > 1) THEN - IF (MY_RANK==0) ALLOCATE(CC_COMPUTE_MESH_AUX(1:NMESHES)) - ! Now rest of processes pass their mesh info to process 0: - DO IPROC=1,N_MPI_PROCESSES-1 - TAG = 0 - IF (MY_RANK==IPROC) THEN ! Send CC_COMPUTE_MESH array. - TAG=IPROC - CALL MPI_SEND(CC_COMPUTE_MESH(1),NMESHES,MPI_LOGICAL,0,TAG,MPI_COMM_WORLD,IERR) - ! Open file to write SET_CUTCELLS_3D progress: - WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' - OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' - WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC,' meshes.' - WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process :' - NMESH_CC_AUX = 0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH(NOM)) THEN - NMESH_CC_AUX = NMESH_CC_AUX + 1 - IF ( NMESH_CC_AUX < NMESH_CC ) THEN - WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' - ELSE - WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' - ENDIF - ENDIF - ENDDO - ELSEIF (MY_RANK==0) THEN ! Receive CC_COMPUTE_MESH array and write. - TAG=IPROC - CALL MPI_RECV(CC_COMPUTE_MESH_AUX(1),NMESHES,MPI_LOGICAL,IPROC,TAG,MPI_COMM_WORLD,MPISTATUS,IERR) - ! Write to LU_ERR: - NMESH_CC=0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH_AUX(NOM)) NMESH_CC = NMESH_CC + 1 - ENDDO - WRITE(VERBOSE_FILE_AUX,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',IPROC,'.log' - WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC, & - ' meshes in file ',TRIM(VERBOSE_FILE_AUX),'.' - WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' - NMESH_CC_AUX = 0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH_AUX(NOM)) THEN - NMESH_CC_AUX = NMESH_CC_AUX + 1 - IF ( NMESH_CC_AUX < NMESH_CC ) THEN - WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' - ELSE - WRITE(LU_ERR,'(I4.4,A)') NOM,'.' - ENDIF - ENDIF - ENDDO - ENDIF - CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) - ENDDO - IF (MY_RANK==0) DEALLOCATE(CC_COMPUTE_MESH_AUX) + WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-edges in mesh : ',NCUTEDG,'. ' ENDIF - CALL CPU_TIME(CPUTIME_START_MESH) ENDIF -IF(N_GEOMETRY>0) THEN - ALLOCATE(GEOM_AREA_SURF_OLD(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_OLD=0._EB - ALLOCATE(GEOM_AREA_SURF_NEW(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_NEW=0._EB +RETURN +END SUBROUTINE GET_CARTCELL_CUTEDGES + +! ------------------------- GET_IS_SOLID_3D ------------------------------------- + +SUBROUTINE GET_IS_SOLID_3D(X2AXIS,XP,I,J,K,IS_SOLID) + +INTEGER, INTENT(IN) :: X2AXIS,I,J,K +REAL(EB), INTENT(IN) :: XP(IAXIS:KAXIS) +LOGICAL, INTENT(OUT):: IS_SOLID + +! Logical Variables: +INTEGER :: IJK(IAXIS:KAXIS) +REAL(EB):: NVEC(IAXIS:JAXIS)=(/ 1._EB, 0._EB /), XY(IAXIS:JAXIS), PLNORMAL(IAXIS:KAXIS), X1PLN, X3RAY +INTEGER :: X1AXIS, X3AXIS, X2LO, X2HI, X3LO, X3HI +LOGICAL :: TRI_ONPLANE_ONLY =.FALSE., RAYTRACE_X2_ONLY =.TRUE. + +IJK(IAXIS:KAXIS) = (/ I, J, K /) + +SELECT CASE(X2AXIS) + CASE(JAXIS) + X1AXIS = IAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 1._EB, 0._EB, 0._EB /) + ! x2, x3 axes parameters: + X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD + X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD + X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) + ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: + X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS + CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & + X2LO,X2HI,X3LO,X3HI,YFACE,ZFACE,JLO_CELL,JHI_CELL,& + KLO_CELL,KHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) + CASE(KAXIS) + X1AXIS = JAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 1._EB, 0._EB /) + ! x2, x3 axes parameters: + X2LO = KLO_FACE-CCGUARD; X2HI = KHI_FACE+CCGUARD + X3AXIS = IAXIS; X3LO = ILO_FACE-CCGUARD; X3HI = IHI_FACE+CCGUARD + X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) + ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: + X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS + CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & + X2LO,X2HI,X3LO,X3HI,ZFACE,XFACE,KLO_CELL,KHI_CELL,& + ILO_CELL,IHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) + CASE(IAXIS) + X1AXIS = KAXIS; PLNORMAL(IAXIS:KAXIS) = (/ 0._EB, 0._EB, 1._EB /) + ! x2, x3 axes parameters: + X2LO = ILO_FACE-CCGUARD; X2HI = IHI_FACE+CCGUARD + X3AXIS = JAXIS; X3LO = JLO_FACE-CCGUARD; X3HI = JHI_FACE+CCGUARD + X1PLN = XP(X1AXIS); X3RAY = XP(X3AXIS) + ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: + X3LO_RT = X3RAY - 10._EB*GEOMEPS; X3HI_RT = X3RAY + 10._EB*GEOMEPS + CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS, & + X2LO,X2HI,X3LO,X3HI,XFACE,YFACE,ILO_CELL,IHI_CELL,& + JLO_CELL,JHI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE2) +END SELECT + +IF (BODINT_PLANE2%NSEGS == 0) THEN + IS_SOLID =.FALSE. + RETURN ENDIF -END SUBROUTINE CC_GRID_GLOBAL_INIT +XY(IAXIS:JAXIS) = (/ XP(X2AXIS), X3RAY /) +CALL GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) -SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH +RETURN +END SUBROUTINE GET_IS_SOLID_3D -! Allocate BODINT_PLANE for plane intersections on X1AXIS loop: -IF(PERIODIC_TEST/=7 .AND. PERIODIC_TEST/=11) THEN - CALL ALLOCATE_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) ! To be used in SET_CUTCELLS_3D, GET_CARTCELL_CUTFACES. - CALL ALLOCATE_BODINT_PLANE(BODINT_PLANE2,FIRST_CALL_ARG2) ! To be used in GET_IS_SOLID_3D. -ENDIF -! Allocate Intersection variables: -ALLOCATE(CC_SVAR_CRS(CC_MAXCROSS_X2),CC_IS_CRS(CC_MAXCROSS_X2),CC_SEG_CRS(CC_MAXCROSS_X2)) -ALLOCATE(CC_BDNUM_CRS(0:CC_MAXCROSS_X2),CC_BDNUM_CRS_AUX(0:CC_MAXCROSS_X2)) -ALLOCATE(CC_IS_CRS2(LOW_IND:HIGH_IND+1,CC_MAXCROSS_X2),CC_SEG_TAN(IAXIS:JAXIS,CC_MAXCROSS_X2)) +! ---------------------- GET_CARTCELL_CUTFACES ---------------------------------- -END SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH +SUBROUTINE GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) -SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE) -CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE2) +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN) :: BNDINT_FLAG -! Deallocate Intersection variables: -DEALLOCATE(CC_SVAR_CRS,CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX,CC_IS_CRS2,CC_SEG_TAN) + ! Local Variables: +INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI +INTEGER :: I,J,K, JJ, KK +INTEGER, DIMENSION(LOW_IND:HIGH_IND,IAXIS:KAXIS) :: FSID_XYZ, CEIB_XYZ +LOGICAL :: OUTCELL1 +INTEGER :: X1AXIS, X2AXIS, X3AXIS +INTEGER :: XIAXIS, XJAXIS, XKAXIS +INTEGER :: X2LO, X2HI, X3LO, X3HI +INTEGER :: X2LO_CELL, X2HI_CELL, X3LO_CELL, X3HI_CELL +REAL(EB), DIMENSION(MAX_DIM) :: PLNORMAL +INTEGER, DIMENSION(MAX_DIM) :: IJK +REAL(EB) :: X1PLN +LOGICAL :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY +INTEGER :: NVERT, NEDGE, NFACE, NSEG, NCF, FNVERT, FNEDGE, CEI, NSEG_FACE +REAL(EB) :: FVERT(IAXIS:JAXIS,NOD1:NOD4) +LOGICAL :: INB_FLG +INTEGER :: CEELEM(NOD1:NOD2,1:CC_MAXCEELEM_FACE) +INTEGER :: INDSEG(CC_MAX_WSTRIANG_SEG+3,CC_MAXCEELEM_FACE) +REAL(EB) :: XYVERT(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) +INTEGER :: TRIS(NOD1:NOD3), ITRI +REAL(EB) :: XYEL(IAXIS:JAXIS,NOD1:NOD3), VAL, DUMMY(IAXIS:JAXIS) +REAL(EB) :: A_COEF, B_COEF, C_COEF, D_COEF, DENOM +INTEGER :: INDXI(IAXIS:KAXIS), INDIF, INDJF, INDKF +REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) :: XYZVERT, XYZVERTF -END SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL,SEG_CELL_AUX +INTEGER, SAVE :: SIZE_CEELEM_SEG_CELL -SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH(NM) +INTEGER, DIMENSION(NOD1:NOD2+1,1:CC_MAXCEELEM_FACE) :: SEG_FACE, SEG_FACE2 +INTEGER, DIMENSION(1:2,1:CC_MAXCFELEM_FACE) :: BOD_TRI +LOGICAL :: SEG_FLAG(1:CC_MAXCEELEM_FACE), INLIST, EQUAL1, EQUAL2, RH_ORIENTED +INTEGER :: COUNTR, CTR, CTSTART, FAXIS, ILH, IEDGE, SEG(NOD1:NOD2), STRI(1:CC_MAX_WSTRIANG_SEG+2), ISEG +INTEGER :: INOD1, INOD2, VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5), IDUM, IEQ1, IEQ2, NBODTRI +REAL(EB), DIMENSION(IAXIS:KAXIS) :: XYZ, NORMTRI, XCENI, XCEN, X1, X2, XC1, XC2, X12, VC1, V12, CROSSV +INTEGER, PARAMETER :: INDVERTBOD(1:3) = (/ 1, 2, 6 /) +INTEGER, PARAMETER :: INDVERTBOD2(1:3) = (/ 2, 1, 6 /) +INTEGER :: NCUTFACE, ICF, NSEG_LEFT, ISEG_FACE, IBOD, NP, IX, IBODTRI, NVSIZE +REAL(EB) :: AREAI, AREA, INXAREA, INT2 +REAL(EB), DIMENSION(IAXIS:KAXIS) :: ACEN, SQAREA -INTEGER, INTENT(IN) :: NM +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNTED +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:):: IJK_COUNTF -IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. -IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES -CALL POINT_TO_MESH(NM) -M => MESHES(NM) -! Mesh sizes: -NXB=IBAR -NYB=JBAR -NZB=KBAR +INTEGER :: NVERT_AUX, NEDGE_OLD, IVERT, COUNT, IEOLD, INOD, NPOLY, CT_EDGES +INTEGER :: NSG_POLY(1:MAX_CELL_POLYLINES), ILO_POLY(1:MAX_CELL_POLYLINES) +LOGICAL :: FOUND +REAL(EB):: XYZV(IAXIS:KAXIS), NXP(IAXIS:KAXIS), XP(IAXIS:KAXIS), D12(IAXIS:KAXIS), D23(IAXIS:KAXIS), NNORM -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) -CALL CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) +INTEGER :: I_NP, IG, XAXIS, NSPCELL_LIST +LOGICAL, ALLOCATABLE, DIMENSION(:) :: SOLID_EDGE +INTEGER, ALLOCATABLE, DIMENSION(:) :: VERT_SEGS, SEG_POS +INTEGER, ALLOCATABLE, DIMENSION(:,:):: SPCELL_LIST +LOGICAL :: CYCLE_CELL, IFLG +REAL(EB) :: XMIN(IAXIS:KAXIS),XMAX(IAXIS:KAXIS) -REGCC_REGION_IF : IF(PERIODIC_TEST==7 .OR. PERIODIC_TEST==11) THEN +REAL(EB) :: TNOW - CALL GET_REGULAR_CUTCELLS_BOX +INTEGER :: ETYPE,JEC +REAL(EB) :: X1V(IAXIS:KAXIS), X2V(IAXIS:KAXIS) +! INTEGER :: IEC +! REAL(EB) :: X1E(IAXIS:KAXIS), X2E(IAXIS:KAXIS) + +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +INTEGER :: NCUTFCE + +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + IF (BNDINT_FLAG) THEN ! Boundary and internal cartface cut-faces: + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating internal CARTCELL_CUTFACES for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating internal CARTCELL_CUTFACES for mesh :',NM,' ..' + ELSE + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTCELL_CUTFACES for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating ghost-cell CARTCELL_CUTFACES for mesh :',NM,' ..' + ENDIF +ENDIF + +TNOW=CURRENT_TIME() + +SIZE_CEELEM_SEG_CELL = DELTA_EDGE +ALLOCATE(SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL),SEG_POS(1:SIZE_CEELEM_SEG_CELL)) +! Define which cells are cut-cell, and which are solid: +IF (BNDINT_FLAG) THEN + ALLOCATE( MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,DELTA_CELL) ); MESHES(NM)%SPCELL_LIST = CC_UNDEFINED + ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND) ); IJK_COUNTED=.FALSE. + ALLOCATE( IJK_COUNTF(ISTR:IEND,JSTR:JEND,KSTR:KEND,MAX_DIM) ); IJK_COUNTF=.FALSE. + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL ELSE + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD +ENDIF + +! Loop on Cartesian cells, define cut cells and solid cells ISSO: +DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI + + IF(IJK_COUNTED(I,J,K)) CYCLE + + ! Face type of bounding Cartesian faces: + FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) + FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) + FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) + FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) + FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) + FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) + + ! For this cell check if no Cartesian boundary faces are CC_CUTCFE: + ! If outcell1 is true -> All regular faces for this face: + OUTCELL1 = (FSID_XYZ(LOW_IND ,IAXIS) /= CC_CUTCFE) .AND. & + (FSID_XYZ(HIGH_IND,IAXIS) /= CC_CUTCFE) .AND. & + (FSID_XYZ(LOW_IND ,JAXIS) /= CC_CUTCFE) .AND. & + (FSID_XYZ(HIGH_IND,JAXIS) /= CC_CUTCFE) .AND. & + (FSID_XYZ(LOW_IND ,KAXIS) /= CC_CUTCFE) .AND. & + (FSID_XYZ(HIGH_IND,KAXIS) /= CC_CUTCFE) + + ! Drop if outcell1 & outcell2 + IF (OUTCELL1) THEN + IF ( (FSID_XYZ(LOW_IND ,IAXIS) == CC_SOLID) .AND. & + (FSID_XYZ(HIGH_IND,IAXIS) == CC_SOLID) .AND. & + (FSID_XYZ(LOW_IND ,JAXIS) == CC_SOLID) .AND. & + (FSID_XYZ(HIGH_IND,JAXIS) == CC_SOLID) .AND. & + (FSID_XYZ(LOW_IND ,KAXIS) == CC_SOLID) .AND. & + (FSID_XYZ(HIGH_IND,KAXIS) == CC_SOLID) ) THEN + MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_SOLID + ENDIF + CYCLE + ENDIF + + MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE + + ENDDO + ENDDO +ENDDO + +! First add edges stemming from triangles laying on gridline planes: +! Dump triangle aligned segments as cut-cell cut-edges, on face cases: +! BNDINT_COND : IF (BNDINT_FLAG) THEN ! Do Loop for different x1 planes: X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS @@ -22599,3984 +22757,4315 @@ SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH(NM) ! location in I,J,K of x2,x2,x3 axes: XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)) - X1FACE = ZFACE; DX1FACE = DZFACE - ALLOCATE(X2FACE(ISTR:IEND),DX2FACE(ISTR:IEND)) - X2FACE = XFACE; DX2FACE = DXFACE - ALLOCATE(X3FACE(JSTR:JEND),DX3FACE(JSTR:JEND)) - X3FACE = YFACE; DX3FACE = DYFACE - - ! x2 cell center parameters: - X2LO_CELL = ILO_CELL-CCGUARD; X2HI_CELL = IHI_CELL+CCGUARD - ALLOCATE(X2CELL(ISTR:IEND),DX2CELL(ISTR:IEND)) - X2CELL = XCELL; DX2CELL = DXCELL - - ! x3 cell center parameters: - X3LO_CELL = JLO_CELL-CCGUARD; X3HI_CELL = JHI_CELL+CCGUARD - ALLOCATE(X3CELL(JSTR:JEND),DX3CELL(JSTR:JEND)) - X3CELL = YCELL; DX3CELL = DYCELL - - END SELECT - - ! Variable that states if raytracing is necessary to define segments - ! status in a cartesian face. - ALLOCATE(FACERT(X2LO_CELL:X2HI_CELL,X3LO_CELL:X3HI_CELL)); - - ! Stretched grid vars: - X1NOC=TRANS(NM)%NOC(X1AXIS) - X2NOC=TRANS(NM)%NOC(X2AXIS) - X3NOC=TRANS(NM)%NOC(X3AXIS) - - IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - IF(X1AXIS < KAXIS) THEN - WRITE(LU_SETCC,'(A,A,A,3I2,A)') ' Computing GEOMs-grid planes intersections for planes in ', & - AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A,A,A,3I2,A)') ' Computing GEOMs-grid planes intersections for planes in ', & - AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' - ENDIF - ELSE - WRITE(LU_SETCC,'(A,A,A,3I2,A)',advance="no") ' Computing GEOMs-grid planes intersections for planes in ', & - AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A,A,A,3I2,A)',advance="no") ' Computing GEOMs-grid planes intersections for planes in ', & - AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' - ENDIF - ENDIF - ENDIF - - ! Loop Coordinate Planes: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI - - ! Which Plane? - INDX1(IAXIS:KAXIS) = (/ I, J, K /) - X1PLN = X1FACE(INDX1(X1AXIS)) - - ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: - TRI_ONPLANE_ONLY =.FALSE. - RAYTRACE_X2_ONLY =.FALSE. - FACERT(:,:) =.FALSE. - CALL GET_BODINT_PLANE(X1AXIS,X1PLN,INDX1(X1AXIS),PLNORMAL,X2AXIS,X3AXIS,& - X2LO,X2HI,X3LO,X3HI,X2FACE,X3FACE,X2LO_CELL,& - X2HI_CELL,X3LO_CELL,X3HI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE) - - ! Test that there is an intersection: - IF ((BODINT_PLANE%NSGLS+BODINT_PLANE%NSEGS+BODINT_PLANE%NTRIS) == 0) CYCLE - - ! Drop if node locations outside block plane area: - IF ((X2FACE(X2LO)-MAXVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE - IF ((MINVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))-X2FACE(X2HI)) > GEOMEPS) CYCLE - IF ((X3FACE(X3LO)-MAXVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE - IF ((MINVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))-X3FACE(X3HI)) > GEOMEPS) CYCLE - - ! IF (GET_CUTCELLS_VERBOSE) THEN - ! WRITE(LU_SETCC,'(I2,A,F14.8,A,3I8)') X1AXIS,', position :',X1PLN, & - ! '; Single Points, Segments, Triangles :', BODINT_PLANE%NSGLS,BODINT_PLANE%NSEGS,BODINT_PLANE%NTRIS - ! IF (MY_RANK==0) & - ! WRITE(LU_ERR ,'(I2,A,F14.8,A,3I8)') X1AXIS,', position :',X1PLN, & - ! '; Single Points, Segments, Triangles :', BODINT_PLANE%NSGLS,BODINT_PLANE%NSEGS,BODINT_PLANE%NTRIS - ! ENDIF - - ! For plane normal to X1AXIS, shoot rays along X2AXIS on all X3AXIS gridline - ! locations, get intersection data: Loop x3 axis locations - DO KK=X3LO,X3HI - - ! x3 location of ray along x2, on the x2-x3 plane: - X3RAY = X3FACE(KK) - - ! Intersections along x2 for X3RAY x3 location: - CALL GET_X2_INTERSECTIONS(X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN) - IF (STOP_STATUS==SETUP_STOP) RETURN - - ! Drop x2 ray if all intersections are outside of the MESH block domain: - IF (CC_N_CRS > 0) THEN - IF ((X2FACE(X2LO)-CC_SVAR_CRS(CC_N_CRS)) > GEOMEPS) THEN - CYCLE - ELSEIF (CC_SVAR_CRS(1)-X2FACE(X2HI) > GEOMEPS) THEN - CYCLE - ENDIF - ENDIF - - ! Highest Z crossing for I,J=KK,INDX1(X1AXIS) location, clip at ZF+DZ(KBAR): - IF(TERRAIN_CASE .AND. X2AXIS==KAXIS .AND. CC_N_CRS>0) & - GEOM_ZMAX_AUX(KK,INDX1(X1AXIS)) = MIN(X2FACE(KBP1),CC_SVAR_CRS(CC_N_CRS)) - - ! Now for this ray, set vertex types in MESHES(NM)%VERTVAR(:,:,:,CC_VGSC): - CALL GET_X2_VERTVAR(X1AXIS,X2LO,X2HI,NM,I,KK) - - ! Now define Crossings on Cartesian Edges and Body segments: - ! Cartesian cut-edges: - CALL GET_CARTEDGE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & - NM,X2LO_CELL,X2HI_CELL,INDX1,KK) - - ! Set segment crossings: - ! This data is defined by plane, add to current: - ! - BODINT_PLANE : Data structure with information for crossings on - ! body segments. - ! % NBCROSS(1:NSEGS) = Number of crossings - ! on the segment. - ! % SVAR(1:NBCROSS,1:NSEGS) = distance from node 1 - ! along the segment. - CALL GET_BODX2_INTERSECTIONS(X2AXIS,X3AXIS,X3RAY) - - ENDDO ! KK - x3 gridlines. - - ! Now for segments not aligned with x3, define - ! intersections with grid line vertices: - CALL GET_BODX3_INTERSECTIONS(X2AXIS,X3AXIS,X2LO,X2HI) - - ! After these loops all segments should contain points from Node1, - ! cross 1, cross 2, ..., Node2, in ascending sbod order. - ! Time to generate the body CC_INBOUNDARY edges on faces and add - ! to MESHES(NM)%CUT_EDGE: - CALL GET_CARTFACE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS, & - XIAXIS,XJAXIS,XKAXIS,NM, & - X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL,& - X3LO_CELL,X3HI_CELL,INDX1,X1PLN) - - ENDDO ! I index - ENDDO ! J index - ENDDO ! K index - - ! Deallocate local plane arrays: - DEALLOCATE(X1FACE,X2FACE,X3FACE,X2CELL,X3CELL) - DEALLOCATE(DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL) - DEALLOCATE(FACERT) - - ENDDO X1AXIS_LOOP - - IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' - IF (MY_RANK==0) WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' - ENDIF - - ! Now Define the INBOUNDARY cut-edge inside Cartesian cells: - CALL GET_CARTCELL_CUTEDGES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) - - ! 1. Cartesian GASPHASE cut-faces: - ! Loops for IAXIS, JAXIS, KAXIS faces: For FCVAR i,j,k, axis - ! - Define Cartesian Boundary Edges indexes. - ! - From ECVAR(i,j,k,IDCE,axis) figure out Entries in CUT_EDGE (GASPHASE segs). - ! - From FCVAR(i,j,k,IDCE,axis) figure out entries in CUT_EDGE (INBOUNDCF segs). - ! - Reorder Edges, figure out if there are disjoint areas present. - ! - Load into CUT_FACE <=> FCVAR(i,j,k,IDCF,axis). - CALL GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.TRUE.) - - ! 2. INBOUNDARY cut-faces: - CALL GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.TRUE.) - - ! Guard-cell Cartesian GASPHASE and INBOUNDARY cut-faces: - CALL GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.FALSE.) - CALL GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.FALSE.) - - ! Finally: Definition of cut-cells: - CELLRT = .FALSE. - MESHES(NM)%N_SPCELL_CF = MESHES(NM)%N_SPCELL - CALL GET_CARTCELL_CUTCELLS(NM) - -ENDIF REGCC_REGION_IF - -CALL CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) -CALL CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -IF (ALLOCATED(CELLRT)) DEALLOCATE(CELLRT) - -END SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH - -SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) - -INTEGER, INTENT(IN) :: NM + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)) + X1FACE = ZFACE; DX1FACE = DZFACE + ALLOCATE(X2FACE(ISTR:IEND),DX2FACE(ISTR:IEND)) + X2FACE = XFACE; DX2FACE = DXFACE + ALLOCATE(X3FACE(JSTR:JEND),DX3FACE(JSTR:JEND)) + X3FACE = YFACE; DX3FACE = DYFACE -IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. -IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 + ! x2 cell center parameters: + X2LO_CELL = ILO_CELL-CCGUARD; X2HI_CELL = IHI_CELL+CCGUARD + ALLOCATE(X2CELL(ISTR:IEND),DX2CELL(ISTR:IEND)) + X2CELL = XCELL; DX2CELL = DXCELL -CALL POINT_TO_MESH(NM) -M => MESHES(NM) -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + ! x3 cell center parameters: + X3LO_CELL = JLO_CELL-CCGUARD; X3HI_CELL = JHI_CELL+CCGUARD + ALLOCATE(X3CELL(JSTR:JEND),DX3CELL(JSTR:JEND)) + X3CELL = YCELL; DX3CELL = DYCELL -CALL CC_GRID_BLOCK_SPECIAL_CELLS(NM) -CALL CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) + END SELECT -IF (ONE_CC_PER_CARTESIAN_CELL) THEN - ! Here Block all cells that have volume less (or equal) than the first largest cell found. - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%CUT_CELL(ICC1) - NCELL=0 - DO J=1,CC%NCELL - IF(CC%NOADVANCE(J)==NOT_BLOCKED) NCELL=NCELL+1 - ENDDO - IF(NCELL<2) CYCLE - ! Find if any GEOMETRY related to CC_INBOUNDARY faces has CELL_BLOCK_IOR>0: - CELL_BLOCK_IOR=0; CELL_BLOCK_ORIENTATION = 0._EB - NCELL_LOOP_1 : DO J=1,CC%NCELL - DO I=2,CC%CCELEM(1,J)+1 - IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN - ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) - IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) - IF(IG>0) THEN - IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN - CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION - ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN - CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR - EXIT NCELL_LOOP_1 - ENDIF - ENDIF - ENDIF - ENDDO - ENDDO NCELL_LOOP_1 - ALLOCATE(VOLUME(1:CC%NCELL)); VOLUME(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN - ! Cell Block Orientation: - DO J=1,CC%NCELL; VOLUME(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)); ENDDO - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN - ! Make search for double precision min/max unambiguous. - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS,IAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) - CASE(-JAXIS,JAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) - CASE(-KAXIS,KAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) - END SELECT - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( IAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-JAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( JAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-KAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( KAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - END SELECT - ENDIF - DEALLOCATE(VOLUME) - NCELL_LOOP_2 : DO J=1,CC%NCELL - IF(J==I) CYCLE NCELL_LOOP_2 - IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL - ENDDO NCELL_LOOP_2 - ENDDO -ENDIF + ! Loop Slices: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) + IJK(IAXIS:KAXIS) = (/ I, J, K /) -! Here: 1,2. Define Linking information for cut-cells. -CALL GET_CELL_LINK_INFO(NM) + ! Plane: + X1PLN = X1FACE(IJK(X1AXIS)) -IF(PROCESS(NM)==MY_RANK) THEN ! Here Add Blocked Areas per SURF_ID: - ALLOCATE(MESHES(NM)%INBCF_AREA(0:MESHES(NM)%IBP1,0:MESHES(NM)%JBP1,0:MESHES(NM)%KBP1)) - DO K=1,M%KBAR - DO J=1,M%JBAR - DO I=1,M%IBAR - ICC = MESHES(NM)%CCVAR(I,J,K,CC_IDCC); IF(ICC<1) CYCLE - CC =>MESHES(NM)%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)<1) CYCLE - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE=CC%CCELEM(IFC,JCC) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE - ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO -ENDIF -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) + ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: + TRI_ONPLANE_ONLY = .TRUE. + RAYTRACE_X2_ONLY = .FALSE. + CALL GET_BODINT_PLANE(X1AXIS,X1PLN,IJK(X1AXIS),PLNORMAL,X2AXIS,X3AXIS,& + X2LO,X2HI,X3LO,X3HI,X2FACE,X3FACE,X2LO_CELL,& + X2HI_CELL,X3LO_CELL,X3HI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE) -END SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH + ! Test that there is an intersection: + IF ((BODINT_PLANE%NTRIS) == 0) CYCLE -SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK + ! Drop if node locations outside block plane area: + IF ((X2FACE(X2LO)-MAXVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE + IF ((MINVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))-X2FACE(X2HI)) > GEOMEPS) CYCLE + IF ((X3FACE(X3LO)-MAXVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE + IF ((MINVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))-X3FACE(X3HI)) > GEOMEPS) CYCLE -DO IDIM=1,MAX_DIM + ! Allocate triangles variables: + ALLOCATE(BODINT_PLANE%X1NVEC(1:BODINT_PLANE%NTRIS), & + BODINT_PLANE%AINV(1:2,1:2,1:BODINT_PLANE%NTRIS)) -! Exchange CC%NOADVANCE(JCC)>0 information among NEIGHBOURING meshes: -CALL EXCHANGE_CC_NOADVANCE_INFO -! Add CC%NOADVANCE(JCC) where needed: -CALL ADD_NEIGHBOR_BLOCKED_CELLS + ! Triangles inverses: + DO ITRI=1,BODINT_PLANE%NTRIS -MAIN_MESH_LOOP_1 : DO NM=1,NMESHES + TRIS(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 + ! This is local IAXIS:JAXIS + XYEL(IAXIS:JAXIS,NOD1) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD1)), & + BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD1)) /) + XYEL(IAXIS:JAXIS,NOD2) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD2)), & + BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD2)) /) + XYEL(IAXIS:JAXIS,NOD3) = (/ BODINT_PLANE%XYZ(X2AXIS,TRIS(NOD3)), & + BODINT_PLANE%XYZ(X3AXIS,TRIS(NOD3)) /) - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + ! Test that x1-x2-x3 obeys right hand rule: + VAL = (XYEL(IAXIS,NOD2)-XYEL(IAXIS,NOD1)) * (XYEL(JAXIS,NOD3)-XYEL(JAXIS,NOD1))- & + (XYEL(JAXIS,NOD2)-XYEL(JAXIS,NOD1)) * (XYEL(IAXIS,NOD3)-XYEL(IAXIS,NOD1)) + BODINT_PLANE%X1NVEC(ITRI) = SIGN(1._EB,VAL) - ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) + ! Transformation Matrix for this triangle in x2x3 plane: + IF (BODINT_PLANE%X1NVEC(ITRI) < 0._EB) THEN ! Rotate node 2 and 3 locations + DUMMY(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,NOD2) + XYEL(IAXIS:JAXIS,NOD2) = XYEL(IAXIS:JAXIS,NOD3) + XYEL(IAXIS:JAXIS,NOD3) = DUMMY(IAXIS:JAXIS) + ENDIF - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) - ENDIF + ! Inverse of Master to physical triangle transform matrix: + A_COEF = XYEL(IAXIS,NOD1) - XYEL(IAXIS,NOD3) + B_COEF = XYEL(IAXIS,NOD2) - XYEL(IAXIS,NOD3) + C_COEF = XYEL(JAXIS,NOD1) - XYEL(JAXIS,NOD3) + D_COEF = XYEL(JAXIS,NOD2) - XYEL(JAXIS,NOD3) + DENOM = A_COEF * D_COEF - B_COEF * C_COEF + BODINT_PLANE%AINV(1,1,ITRI) = D_COEF / DENOM + BODINT_PLANE%AINV(2,1,ITRI) = -C_COEF / DENOM + BODINT_PLANE%AINV(1,2,ITRI) = -B_COEF / DENOM + BODINT_PLANE%AINV(2,2,ITRI) = A_COEF / DENOM - ! Block any cells that contain only one gas cut-face (cavity type cut-cells): - K = 0 - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%CUT_CELL(ICC1) - DO J=1,CC%NCELL - SUM_FACE=0; SUM_CCELL=0 - DO I=2,CC%CCELEM(1,J) - SELECT CASE(CC%FACE_LIST(1,CC%CCELEM(I,J))) - CASE(CC_FTYPE_CFGAS); SUM_FACE = SUM_FACE+1 - CASE(CC_FTYPE_RCGAS); SUM_CCELL=SUM_CCELL+1 - END SELECT - ENDDO - IF(SUM_FACE>1 .OR. SUM_CCELL>0) CYCLE - IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J)=BLOCKED_CAVITY_CELL - K=K+1 - ENDDO - ENDDO - IF (K>0) THEN - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) - ENDIF - ENDIF - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -ENDDO MAIN_MESH_LOOP_1 + ENDDO -! Call tag boundary cut-cells for blocking in refinement interfaces: -CALL TAG_CC_BLOCKING_REFINEMENT + ! There are triangles aligned with this x1pln: + ! Run by Face: + ! First solid Faces: x1 Faces, Check where they lay: + DO KK=X3LO_CELL,X3HI_CELL + DO JJ=X2LO_CELL,X2HI_CELL -ENDDO + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ IJK(X1AXIS), JJ, KK /) ! Local x1,x2,x3 + INDIF = INDXI(XIAXIS) + INDJF = INDXI(XJAXIS) + INDKF = INDXI(XKAXIS) -FINAL_BLOCK_MESH_LOOP : DO NM=1,NMESHES + IF (IJK_COUNTF(INDIF,INDJF,INDKF,X1AXIS)) CYCLE - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 + IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_FGSC,X1AXIS) /= CC_GASPHASE ) THEN - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + FVERT(IAXIS:JAXIS,NOD1) = (/ X2FACE(JJ-1), X3FACE(KK-1) /) + FVERT(IAXIS:JAXIS,NOD2) = (/ X2FACE(JJ ), X3FACE(KK-1) /) + FVERT(IAXIS:JAXIS,NOD3) = (/ X2FACE(JJ ), X3FACE(KK ) /) + FVERT(IAXIS:JAXIS,NOD4) = (/ X2FACE(JJ-1), X3FACE(KK ) /) - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + ! Get triangle face intersection: + CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) - ! Here: 1,2. Define Linking information for cut-cells. - CALL GET_CELL_LINK_INFO(NM) + ! Triangle - face intersection vertices and edges: + CALL GET_TRIANG_FACE_INT(X2AXIS,X3AXIS,FVERT,CEI,NM, & + INB_FLG,FNVERT,XYVERT,FNEDGE,CEELEM,INDSEG) - ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) - ENDIF + ! XYvert to XYZvert: + IF ( INB_FLG ) THEN + XYZVERTF = 0._EB + XYZVERTF(X1AXIS,1:FNVERT) = X1PLN + XYZVERTF(X2AXIS,1:FNVERT) = XYVERT(IAXIS,1:FNVERT) + XYZVERTF(X3AXIS,1:FNVERT) = XYVERT(JAXIS,1:FNVERT) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -ENDDO FINAL_BLOCK_MESH_LOOP + ! Test for edges inside SOLID Region: + ALLOCATE(SOLID_EDGE(1:FNEDGE)); SOLID_EDGE(1:FNEDGE)=.FALSE. + DO IEDGE=1,FNEDGE + ! No body associated with segment. Might not be needed. + IG = INDSEG(4,IEDGE) + IF ( IG < 1) CYCLE + SEG(NOD1:NOD2) = CEELEM(NOD1:NOD2,IEDGE) + XP(IAXIS:KAXIS)= 0.5_EB*(XYZVERTF(IAXIS:KAXIS,SEG(NOD1))+XYZVERTF(IAXIS:KAXIS,SEG(NOD2))) + ! Direction NP: + NXP(IAXIS:KAXIS) = 0._EB + DO I_NP=1,INDSEG(1,IEDGE) + ITRI = INDSEG(1+I_NP,IEDGE) + NXP(IAXIS:KAXIS) = NXP(IAXIS:KAXIS) + GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,ITRI) + ENDDO + NXP = NXP/NORM2(NXP); XAXIS=MAXLOC(ABS(NXP(IAXIS:KAXIS)),DIM=1) + ! Perturb XP in the average normal NP direction: + IF (INDSEG(1,IEDGE) > 1) XP = XP + 10._EB*GEOMEPS*NXP + CALL GET_IS_SOLID_3D(XAXIS,XP,INDIF,INDJF,INDKF,SOLID_EDGE(IEDGE)) + ENDDO + ! Now drop SEGS with SOLID_EDGE(IEDGE)=true: + COUNT = 0 + DO IEDGE=1,FNEDGE + IF (SOLID_EDGE(IEDGE)) CYCLE + COUNT=COUNT+1 + CEELEM(NOD1:NOD2,COUNT) = CEELEM(NOD1:NOD2,IEDGE) + INDSEG(1:CC_MAX_WSTRIANG_SEG+2,COUNT) = INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) + ENDDO + CEELEM(NOD1:NOD2,COUNT+1:FNEDGE) = CC_UNDEFINED + INDSEG(1:CC_MAX_WSTRIANG_SEG+2,COUNT+1:FNEDGE) = CC_UNDEFINED + FNEDGE = COUNT + DEALLOCATE(SOLID_EDGE) -END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK + ! Here ADD nodes and vertices to what is already + ! there: + IF (CEI == 0) THEN ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = FNVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = FNEDGE + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,FNVERT,FNEDGE) + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = & + (/ INDIF, INDJF, INDKF, X1AXIS, CC_GS /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF + MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:FNVERT) = & + XYZVERTF(IAXIS:KAXIS,1:FNVERT) + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:FNEDGE) = & + CEELEM(NOD1:NOD2,1:FNEDGE) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:FNEDGE) = & + INDSEG(1:CC_MAX_WSTRIANG_SEG+3,1:FNEDGE) + ELSE -SUBROUTINE CC_GRID_POSTPROCESS_AND_CLEANUP(NM) + NVERT_AUX=MESHES(NM)%CUT_EDGE(CEI)%NVERT + NEDGE_OLD=MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IVERT=1,FNVERT + XYZV(IAXIS:KAXIS) = XYZVERTF(IAXIS:KAXIS,IVERT) + CALL INSERT_FACE_VERT(XYZV,NM,CEI,NVERT_AUX,INOD) + DO IEDGE=1,FNEDGE + IF(CEELEM(NOD1,IEDGE)==IVERT) CEELEM(NOD1,IEDGE)=INOD + IF(CEELEM(NOD2,IEDGE)==IVERT) CEELEM(NOD2,IEDGE)=INOD + ENDDO + ENDDO + CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE_OLD+FNEDGE) + COUNT = NEDGE_OLD + OUTER :DO IEDGE=1,FNEDGE + FOUND=.FALSE. + INNER1 : DO IEOLD=1,NEDGE_OLD + IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IEOLD) /= CEELEM(NOD1,IEDGE)) CYCLE INNER1 + IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IEOLD) /= CEELEM(NOD2,IEDGE)) CYCLE INNER1 + IF(MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEOLD) /= INDSEG(4,IEDGE)) CYCLE INNER1 + FOUND=.TRUE. + ENDDO INNER1 + INNER2 : DO IEOLD=1,NEDGE_OLD + IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,IEOLD) /= CEELEM(NOD1,IEDGE)) CYCLE INNER2 + IF(MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,IEOLD) /= CEELEM(NOD2,IEDGE)) CYCLE INNER2 + IF(MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEOLD) /= INDSEG(4,IEDGE)) CYCLE INNER2 + FOUND=.TRUE. + ENDDO INNER2 + IF(FOUND) CYCLE OUTER + COUNT=COUNT+1 + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,COUNT) = CEELEM(NOD1:NOD2,IEDGE) + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+3,COUNT)=& + INDSEG(1:CC_MAX_WSTRIANG_SEG+3,IEDGE) + ENDDO OUTER + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT_AUX + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = COUNT -INTEGER, INTENT(IN) :: NM + ENDIF -CALL CC_GRID_RELEASE_BLOCKED_CELL_LISTS(NM) + ! MESHES(NM)%CUT_EDGE(CEI)%NVERT = FNVERT + ! MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,1:FNVERT) = & + ! XYZVERTF(IAXIS:KAXIS,1:FNVERT) + ! MESHES(NM)%CUT_EDGE(CEI)%NEDGE = FNEDGE + ! WRITE(LU_ERR,*) 'CUT_EDGE=',CEI,SIZE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM,DIM=2),FNEDGE + ! WRITE(LU_ERR,*) 'CEELEM=',SIZE(CEELEM,DIM=2) + ! MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:FNEDGE) = & + ! CEELEM(NOD1,IEDGE)) CYCLE:NOD2,1:FNEDGE) + ! MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:FNEDGE) = & + ! INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:FNEDGE) -IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. -IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 + ENDIF + IJK_COUNTF(INDIF,INDJF,INDKF,X1AXIS)=.TRUE. -CALL POINT_TO_MESH(NM) -M => MESHES(NM) + ENDIF + ENDDO + ENDDO -! Here Add Areas per SURF_ID: -IF (PROCESS(NM)==MY_RANK) THEN - DO ICF=1,M%N_CUTFACE_MESH - CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE - DO J=1,CF%NFACE - IF(.NOT.CF%BLK_TAG(J)) CYCLE - GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & - GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) - ENDDO - ENDDO -ENDIF -! Deallocate arrays: -IF (GET_CUTCELLS_VERBOSE) THEN - IF(M%N_CUTCELL_MESH > 0) THEN - MIN_FACES_PER_CUTCELL = 1000000 !HUGE(MIN_FACES_PER_CUTCELL) - MAX_FACES_PER_CUTCELL = 0 - MEAN_FACES_PER_CUTCELL= 0 - SUM_FACE = 0 - SUM_CCELL= 0 - DO ICC1=1,M%N_CUTCELL_MESH - IF (M%CUT_CELL(ICC1)%NCELL==0) CYCLE - SUM_CCELL = SUM_CCELL + M%CUT_CELL(ICC1)%NCELL - DO ICC2=1,M%CUT_CELL(ICC1)%NCELL - MAX_FACES_PER_CUTCELL = MAX(MAX_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) - MIN_FACES_PER_CUTCELL = MIN(MIN_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) - SUM_FACE = SUM_FACE + M%CUT_CELL(ICC1)%CCELEM(1,ICC2) - ENDDO - ENDDO - IF(SUM_CCELL > TWENTY_EPSILON_EB) MEAN_FACES_PER_CUTCELL = SUM_FACE / SUM_CCELL - ! Write to file: - WRITE(LU_SETCC,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& - MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL - IF (MEAN_FACES_PER_CUTCELL > 30) THEN - WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN - WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ENDIF - ! Write to ERR file: - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& - MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL - IF (MEAN_FACES_PER_CUTCELL > 30) THEN - WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN - WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ENDIF - ENDIF - ENDIF - WRITE(LU_SETCC,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' - WRITE(LU_SETCC,'(A)') ' ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' - WRITE(LU_ERR ,'(A)') ' ' - ENDIF -ENDIF + DEALLOCATE(BODINT_PLANE%X1NVEC,BODINT_PLANE%AINV) + ENDDO ! I + ENDDO ! J + ENDDO ! K -! Here we have to deallocate if no geometric entities were defined: -! EDGE_CROSS is deallocated: -IF (ALLOCATED(M%EDGE_CROSS)) DEALLOCATE(M%EDGE_CROSS) -IF (M%N_CUTEDGE_MESH == 0 .OR. PROCESS(NM)/=MY_RANK) THEN - IF (ALLOCATED(M%CUT_EDGE)) DEALLOCATE(M%CUT_EDGE) -ENDIF -IF (M%N_CUTFACE_MESH+M%N_BBCUTFACE_MESH+M%N_GCCUTFACE_MESH == 0) THEN - IF (ALLOCATED(M%CUT_FACE)) DEALLOCATE(M%CUT_FACE) -ENDIF -IF(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH == 0) THEN - IF (ALLOCATED(M%CUT_CELL)) DEALLOCATE(M%CUT_CELL) -ENDIF + ! Deallocate local plane arrays: + DEALLOCATE(X1FACE,X2FACE,X3FACE,X2CELL,X3CELL) + DEALLOCATE(DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL) -! Sanity tests on cut-faces, cut-cells: -IF (DEBUG_SET_CUTCELLS) THEN - CUTFACE_TEST_LOOP : DO ICF=1,M%N_CUTFACE_MESH - NFACE = M%CUT_FACE(ICF)%NFACE - I = M%CUT_FACE(ICF)%IJK(IAXIS) - J = M%CUT_FACE(ICF)%IJK(JAXIS) - K = M%CUT_FACE(ICF)%IJK(KAXIS) - X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) - DO I=1,NFACE - IF(M%CUT_FACE(ICF)%AREA(I) MESHES(NM) + NVERT = 0 + NFACE = 0 + XYZVERT = 0._EB -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CF => M%CUT_FACE(ICF); IF(CF%NFACE==0) CYCLE - ICF1=3 ! BLOCK boundary flag, when == 1,2. - IF (CF%STATUS == CC_GASPHASE) THEN - I = CF%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE - J = CF%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE - K = CF%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE - SELECT CASE(CF%IJK(KAXIS+1)) ! X1AXIS - CASE(IAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DY(J)*DZ(K)); IF(I==0 .OR. I==M%IBAR) ICF1=1 - CASE(JAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DZ(K)*DX(I)); IF(J==0 .OR. J==M%JBAR) ICF1=1 - CASE(KAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DX(I)*DY(J)); IF(K==0 .OR. K==M%KBAR) ICF1=1 - END SELECT - ENDIF - CALL ALLOC_FACE_STATE_VARS(NM,ICF,CF%NFACE,ICF1) -ENDDO + ! CUT_EDGE index of bounding Cartesian faces: + CEIB_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCE,IAXIS) + CEIB_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCE,IAXIS) + CEIB_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCE,JAXIS) + CEIB_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCE,JAXIS) + CEIB_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCE,KAXIS) + CEIB_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCE,KAXIS) -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC); IF(CC%NCELL==0) CYCLE - I = CC%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE - J = CC%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE - K = CC%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE - CC%ALPHA_CC = SUM(CC%VOLUME(1:CC%NCELL))/(DX(I)*DY(J)*DZ(K)) - CALL ALLOC_CELL_STATE_VARS(NM,ICC,CC%NCELL) -ENDDO + ! Cartesian Faces INBOUNDARY segments: + DO FAXIS=IAXIS,KAXIS + DO ILH=LOW_IND,HIGH_IND + ! By segment: Add Vertices/Segments to local arrays: + CEI = CEIB_XYZ(ILH,FAXIS) + IF ( CEI > 0 ) THEN ! There are inboundary cut-edges + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE -! Allocate array of indexes of chemically active cut-cells -SUM_CC = 0 -DO ICC=1,M%N_CUTCELL_MESH - SUM_CC = SUM_CC + CC%NCELL -ENDDO -ALLOCATE(M%CHEM_ACTIVE_CC(SUM_CC,3)) -M%CHEM_ACTIVE_CC=-1 + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + STRI(1:CC_MAX_WSTRIANG_SEG+2) = & + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) -END SUBROUTINE CC_GRID_ALLOCATE_STATE_VARS + ! x,y,z of node 1: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD1,XYZVERT) + ! x,y,z of node 2: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD2,XYZVERT) -SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST + VEC(NOD1:NOD2) = (/ INOD1, INOD2 /) + VEC(NOD2+1:NOD2+CC_MAX_WSTRIANG_SEG+2) = STRI(1:CC_MAX_WSTRIANG_SEG+2) + VEC(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7) = (/ CC_ETYPE_CFINB, CEI, IEDGE /) + ! Insertion ADD segment: + INLIST = .FALSE. + DO IDUM = 1,NSEG + DO IEQ1=1,3 + EQUAL1 = SEG_CELL(INDVERTBOD(IEQ1),IDUM) == VEC(INDVERTBOD(IEQ1)) + IF (.NOT.EQUAL1) EXIT + ENDDO + DO IEQ2=1,3 + EQUAL2 = SEG_CELL(INDVERTBOD(IEQ2),IDUM) == VEC(INDVERTBOD2(IEQ2)) + IF (.NOT.EQUAL2) EXIT + ENDDO + IF ( EQUAL1 .OR. EQUAL2 ) THEN + IF ( SEG_CELL(3,IDUM) > VEC(3) ) THEN + ! DO NOTHING: + ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN + SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 + SEG_CELL(5,IDUM) = VEC(4) + ENDIF + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + NSEG = NSEG + 1 + CALL REALLOCATE_SEG_CELL + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + ENDIF + ENDDO + ENDIF + ENDDO + ENDDO -! ALL REDUCE areas per surface: -IF(N_GEOMETRY>0) THEN -CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_OLD(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) -CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) -ENDIF -! Define AREA_ADJUST per SURF_ID: -DO J=1,N_GEOMETRY - DO I=0,N_SURF - IF(GEOM_AREA_SURF_NEW(I,J)>TWENTY_EPSILON_EB) THEN - GEOM_AREA_SURF_NEW(I,J) = GEOM_AREA_SURF_OLD(I,J)/GEOM_AREA_SURF_NEW(I,J) - ELSE; GEOM_AREA_SURF_NEW(I,J) = 1._EB - ENDIF - ENDDO -ENDDO -DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE - DO J=1,CF%NFACE - IF(.NOT.CF%BLK_TAG(J)) CYCLE - CF%AREA_ADJUST(J) = CF%AREA_ADJUST(J)*GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) - ENDDO - ENDDO - DEALLOCATE(MESHES(NM)%INBCF_AREA) -ENDDO + ! Cells INBOUNDARY segments: + CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCE) + IF ( CEI > 0 ) THEN ! There are inboundary cut-edges + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + DO IEDGE=1,NEDGE -! GEOM_AREA_SURF_NEW = 0._EB -! DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX -! DO ICF=1,MESHES(NM)%N_CUTFACE_MESH -! CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE -! DO J=1,CF%NFACE -! IF(.NOT.CF%BLK_TAG(J)) CYCLE -! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & -! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) -! ENDDO -! ENDDO -! ENDDO -! CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW,(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) -! DO J=1,N_GEOMETRY -! DO I=0,N_SURF -! IF(MY_RANK==0) WRITE(LU_ERR,*) 'IG,N_SURF,AOLD,ANEW=',J,I,GEOM_AREA_SURF_OLD(I,J),GEOM_AREA_SURF_NEW(I,J) -! ENDDO -! ENDDO -IF(ALLOCATED(GEOM_AREA_SURF_OLD)) DEALLOCATE(GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + STRI(1:CC_MAX_WSTRIANG_SEG+2) = & + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) -END SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST + ! x,y,z of node 1: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD1,XYZVERT) + ! x,y,z of node 2: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD2,XYZVERT) -SUBROUTINE CC_GRID_LOG_PROCESSING_TIME + IF (INOD1 == INOD2) CYCLE -! Add to SET_CUTCELLS_3D loop time: -T_CC_USED(SET_CUTCELLS_TIME_INDEX) = T_CC_USED(SET_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW + VEC(NOD1:NOD2) = (/ INOD1, INOD2 /) + VEC(NOD2+1:NOD2+CC_MAX_WSTRIANG_SEG+2) = STRI(1:CC_MAX_WSTRIANG_SEG+2) + VEC(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7) = (/ CC_ETYPE_CFINB, CEI, IEDGE /) + ! Insertion ADD segment: + INLIST = .FALSE. + DO IDUM = 1,NSEG + DO IEQ1=1,3 + EQUAL1 = SEG_CELL(INDVERTBOD(IEQ1),IDUM) == VEC(INDVERTBOD(IEQ1)) + IF (.NOT.EQUAL1) EXIT + ENDDO + DO IEQ2=1,3 + EQUAL2 = SEG_CELL(INDVERTBOD(IEQ2),IDUM) == VEC(INDVERTBOD2(IEQ2)) + IF (.NOT.EQUAL2) EXIT + ENDDO + IF ( EQUAL1 .OR. EQUAL2 ) THEN + IF ( SEG_CELL(3,IDUM) > VEC(3) ) THEN + ! DO NOTHING: + ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN + SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 + SEG_CELL(5,IDUM) = VEC(4) + ENDIF + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + NSEG = NSEG + 1 + CALL REALLOCATE_SEG_CELL + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + ENDIF + ENDDO + ENDIF -IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_MESH) - WRITE(LU_SETCC,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' - WRITE(LU_SETCC,'(A)') ' ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' - WRITE(LU_ERR,'(A)') ' ' - ENDIF -ENDIF + ! Drop segments that are unconnected: + ALLOCATE(VERT_SEGS(1:NVERT)); VERT_SEGS(1:NVERT)=0 + DO IDUM = 1,NSEG + IF (SEG_CELL(NOD1,IDUM) == SEG_CELL(NOD2,IDUM)) CYCLE + VERT_SEGS(SEG_CELL(NOD1,IDUM)) = VERT_SEGS(SEG_CELL(NOD1,IDUM)) + 1 + VERT_SEGS(SEG_CELL(NOD2,IDUM)) = VERT_SEGS(SEG_CELL(NOD2,IDUM)) + 1 + ENDDO + ALLOCATE(SEG_CELL_AUX(SIZE(SEG_CELL,DIM=1),SIZE(SEG_CELL,DIM=2))) + SEG_CELL_AUX = SEG_CELL + COUNT = 0 + DO IDUM = 1,NSEG + IF ( (SEG_CELL_AUX(NOD1,IDUM) /= SEG_CELL_AUX(NOD2,IDUM)) .AND. & + (VERT_SEGS(SEG_CELL_AUX(NOD1,IDUM))>1) .AND. (VERT_SEGS(SEG_CELL_AUX(NOD2,IDUM))>1) ) THEN + COUNT = COUNT + 1 + SEG_CELL(:,COUNT) = SEG_CELL_AUX(:,IDUM) + CYCLE + ENDIF + ENDDO + NSEG = COUNT + DEALLOCATE(SEG_CELL_AUX,VERT_SEGS) -END SUBROUTINE CC_GRID_LOG_PROCESSING_TIME + ! Now obtain body-triangle combinations present: + BOD_TRI = CC_UNDEFINED + NBODTRI = 0 + DO ISEG=1,NSEG -SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING(EARLY_RETURN) + ! First triangle location (Assume one body and at + ! most two triangs per seg). + INLIST = .FALSE. + DO IBODTRI=1,NBODTRI + IF ( (BOD_TRI(1,IBODTRI) == SEG_CELL(6,ISEG)) .AND. & + (BOD_TRI(2,IBODTRI) == SEG_CELL(4,ISEG)) ) THEN + ! Body/triang already on list. + INLIST = .TRUE. + CYCLE + ENDIF + enddo + IF (.NOT.INLIST) THEN + ! Add first triang to list: + NBODTRI = NBODTRI + 1 + BOD_TRI(1:2,NBODTRI) = SEG_CELL( (/ 6, 4 /) , ISEG) + ENDIF -LOGICAL, INTENT(OUT) :: EARLY_RETURN + ! No second triangle associated: + IF ( SEG_CELL(3,ISEG) < 2 ) CYCLE -EARLY_RETURN = .FALSE. + ! Second triangle location + INLIST = .FALSE. + DO IBODTRI=1,NBODTRI + IF ( (BOD_TRI(1,IBODTRI) == SEG_CELL(6,ISEG)) .AND. & + (BOD_TRI(2,IBODTRI) == SEG_CELL(5,ISEG)) ) THEN + ! Body/triang already on list. + INLIST = .TRUE. + CYCLE + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + ! Add first triang to list: + NBODTRI = NBODTRI + 1 + BOD_TRI(1:2,NBODTRI) = SEG_CELL( (/ 6, 5 /) , ISEG) + ENDIF + ENDDO ! ISEG. -IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) + ! Do Test for cycling when all body-triangle combinations produce two or less segments: + SEG_FLAG(1)=.TRUE. + DO ICF=1,NBODTRI + IBOD = BOD_TRI(1,ICF) + ITRI = BOD_TRI(2,ICF) + NSEG_FACE = 0 + DO ISEG=1,NSEG + IF ((SEG_CELL(6,ISEG) == IBOD) .AND. & + ((SEG_CELL(4,ISEG) == ITRI) .OR. (SEG_CELL(5,ISEG) == ITRI)) ) THEN + NSEG_FACE = NSEG_FACE + 1 + ENDIF + ENDDO + ! If only one or two seg => continue: + IF ( NSEG_FACE <= 2 ) CYCLE + SEG_FLAG(1)=.FALSE. + EXIT + ENDDO + IF (SEG_FLAG(1)) CYCLE ! CYCLES I,J,K loop. -IF(GET_CUTCELLS_VERBOSE) THEN - WRITE(LU_SETCC,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' - WRITE(LU_SETCC,'(A)') ' ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' - WRITE(LU_ERR ,'(A)') ' ' - ENDIF -ENDIF + ! This is a cut-face, allocate space: + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (BNDINT_FLAG) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF + MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE -! Write out: -! Increase SET_CUTCELLS_3D call counter by 1: -CALL_COUNT = CALL_COUNT + 1 -IF(PERIODIC_TEST==105) THEN - CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) - IF(CALL_COUNT > 1) THEN - EARLY_RETURN = .TRUE. - RETURN - ENDIF -ENDIF + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -END SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, 0 /) ! No axis = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_INBOUNDARY + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NBODTRI,CC_MAXVERT_CUTFACE) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) + ALLOCATE(CF%EDGE_LIST(3,NSEG)) + CF%EDGE_LIST(1:3,1:NSEG) = SEG_CELL(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7,1:NSEG) + ALLOCATE(CF%CEDGES(SIZE(CF%CFELEM,DIM=1),SIZE(CF%CFELEM,DIM=2))); CF%CEDGES = CC_UNDEFINED -SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY + ! Running by body-triangle combination, define list of + ! segments that belong to each pair. + ICF_LOOP : DO ICF=1,NBODTRI -! Loop over geometry: -CCVERBOSE_COND : IF(GET_CUTCELLS_VERBOSE) THEN - SLEN_GEOM = 0._EB; AREA_GEOM = 0._EB; VOLUME_GEOM = 0._EB; XYZCEN_GEOM(IAXIS:KAXIS) = 0._EB - DO IG=1,N_GEOMETRY - ! Add length of wet surface edges: - DO IEDGE=1,GEOMETRY(IG)%N_EDGES - SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IEDGE) - DV(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - & - GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) - SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) - SLEN_GEOM = SLEN_GEOM + SLEN - ENDDO - ! Add to wet surface Areas: - AREA_GEOM = AREA_GEOM + GEOMETRY(IG)%GEOM_AREA - ! Add to GEOMETRY volume: - VOLUME_GEOM = VOLUME_GEOM + GEOMETRY(IG)%GEOM_VOLUME - ! Add to XYZCEN for geometries: - XYZCEN_GEOM(IAXIS:KAXIS)= XYZCEN_GEOM(IAXIS:KAXIS) + GEOMETRY(IG)%GEOM_VOLUME * GEOMETRY(IG)%GEOM_XYZCEN(IAXIS:KAXIS) - ENDDO - IF(N_GEOMETRY > 0) XYZCEN_GEOM(IAXIS:KAXIS)=XYZCEN_GEOM(IAXIS:KAXIS)/VOLUME_GEOM + IBOD = BOD_TRI(1,ICF) + ITRI = BOD_TRI(2,ICF) - ! Loop over meshes: - NCUTFACE_INB = 0 - CF_AREA_INB=0._EB - CC_VOLUME_INB=0._EB - GP_VOLUME=0._EB - DM_XYZCEN(IAXIS:KAXIS) = 0._EB - CCGP_XYZCEN(IAXIS:KAXIS) = 0._EB - TESTS_MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - DO ICF1 = 1,MESHES(NM)%N_CUTFACE_MESH - IF (CUT_FACE(ICF1)%STATUS == CC_INBOUNDARY) THEN - NFACE = CUT_FACE(ICF1)%NFACE - CF_AREA_INB = CF_AREA_INB + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - ENDIF - ENDDO - DO ICC1 = 1,MESHES(NM)%N_CUTCELL_MESH - NCELL = CUT_CELL(ICC1)%NCELL - DO ICC2=1,NCELL - CCGP_XYZCEN(IAXIS:KAXIS) = CCGP_XYZCEN(IAXIS:KAXIS) + CUT_CELL(ICC1)%VOLUME(ICC2) * & - CUT_CELL(ICC1)%XYZCEN(IAXIS:KAXIS,ICC2) - IF (CUT_CELL(ICC1)%VOLUME(ICC2) NSEG_FACE**3 ) THEN + CYCLE_CELL = .TRUE. + MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 + NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) + IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN + ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) + DEALLOCATE(MESHES(NM)%SPCELL_LIST) + ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED + DEALLOCATE(SPCELL_LIST) + ENDIF + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) + EXIT INF_LOOP + + IF (DEBUG_SET_CUTCELLS) THEN + WRITE(LU_ERR,*) "Error GET_CARTCELL_CUTFACES: ctr > nseg_face^3 ,",BNDINT_FLAG,I,J,K,NCUTFACE,& + CF%NFACE + WRITE(LU_ERR,*) "Cannot build boundary cut faces in cell (NM,I,J,K):",NM,I,J,K + WRITE(LU_ERR,*) "Located in position:",XCELL(I),YCELL(J),ZCELL(K) + WRITE(LU_ERR,*) "Check for Geometry surface inconsistencies at said location." + WRITE(LU_ERR,*) 'Cartesian CELL:',BNDINT_FLAG,MESHES(NM)%CCVAR(I,J,K,CC_CGSC),CC_CUTCFE,I,J,K + LU_DB_SETCC = GET_FILE_NUMBER() + OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_cutfaces.dat", STATUS='REPLACE') + ! Info pertaining to the Cartesian Cell: + WRITE(LU_DB_SETCC,*) 'I,J,K:' + WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS + WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' + WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) ! MESHES(NM)%XC(I),MESHES(NM)%DX(I) + WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) ! MESHES(NM)%YC(J),MESHES(NM)%DY(J) + WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) ! MESHES(NM)%ZC(K),MESHES(NM)%DZ(K) + WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT:' + WRITE(LU_DB_SETCC,*) NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT + WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' + DO IDUM=1,NVERT + WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) + ENDDO + WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' + DO IDUM=1,NSEG + WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(NOD1:NOD2,IDUM),SEG_CELL(3:6,IDUM) + ENDDO + WRITE(LU_DB_SETCC,*) 'SEG_FACE(NOD1:NOD2,1:NSEG_FACE):' + DO IDUM=1,NSEG_FACE + WRITE(LU_DB_SETCC,*) IDUM,SEG_FACE(NOD1:NOD2,IDUM) + ENDDO + WRITE(LU_DB_SETCC,*) 'SEG_FACE2(NOD1:NOD21:COUNTR):' + DO IDUM=1,COUNTR + WRITE(33,*) IDUM,SEG_FACE2(NOD1:NOD2,IDUM) + ENDDO + WRITE(LU_DB_SETCC,*) 'ICF,BOD_TRI:' + WRITE(LU_DB_SETCC,*) ICF,NBODTRI + DO IDUM=1,NBODTRI + WRITE(LU_DB_SETCC,*) BOD_TRI(1:2,IDUM) + ENDDO + CLOSE(LU_DB_SETCC) + CALL DEBUG_WAIT + ENDIF - GP_VOLUME_AUX = GP_VOLUME - CALL MPI_ALLREDUCE(GP_VOLUME_AUX, GP_VOLUME, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) + ENDIF - DM_VOLUME_AUX = DM_VOLUME - CALL MPI_ALLREDUCE(DM_VOLUME_AUX, DM_VOLUME, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) + ENDDO INF_LOOP + IF (CYCLE_CELL) EXIT ICF_LOOP - CCGP_XYZCEN_AUX(IAXIS:KAXIS) = CCGP_XYZCEN(IAXIS:KAXIS) - CALL MPI_ALLREDUCE(CCGP_XYZCEN_AUX(1), CCGP_XYZCEN(1), 3, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) + IF ( COUNTR /= NSEG_FACE) & + PRINT*, "Building INBOUND faces: ~isequal(countr,nseg)" - DM_XYZCEN_AUX(IAXIS:KAXIS) = DM_XYZCEN(IAXIS:KAXIS) - CALL MPI_ALLREDUCE(DM_XYZCEN_AUX(1), DM_XYZCEN(1), 3, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) - ENDIF - CCGP_XYZCEN(IAXIS:KAXIS) = CCGP_XYZCEN(IAXIS:KAXIS) / (CC_VOLUME_INB+GP_VOLUME+TWENTY_EPSILON_EB) - DM_XYZCEN(IAXIS:KAXIS) = DM_XYZCEN(IAXIS:KAXIS) / (DM_VOLUME+TWENTY_EPSILON_EB) + ! Using triangles normal, reorder nodes as in right hand rule. + NORMTRI(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,ITRI) - IF (MY_RANK == 0) THEN - WRITE(LU_ERR,"(A,E11.4,A,E11.4,A,E11.4)") & - ' GEOM Gas Volume=',DM_VOLUME-VOLUME_GEOM,', Cut/Regl Gas cells Volume=',GP_VOLUME+CC_VOLUME_INB, & - ', Relative Difference=',((DM_VOLUME-VOLUME_GEOM)-(GP_VOLUME+CC_VOLUME_INB))/(DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - WRITE(LU_SETCC,"(A,E11.4,A,E11.4,A,E11.4)") & - ' GEOM Gas Volume=',DM_VOLUME-VOLUME_GEOM,', Cut/Regl Gas cells Volume=',GP_VOLUME+CC_VOLUME_INB, & - ', Relative Difference=',((DM_VOLUME-VOLUME_GEOM)-(GP_VOLUME+CC_VOLUME_INB))/(DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - WRITE(LU_ERR,"(A,3E12.4)") & - ' GEOM Centroid =',XYZCEN_GEOM(IAXIS:KAXIS) - WRITE(LU_ERR,"(A,3E12.4)") & - ' DOMAIN-GEOM Centroid =',(DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & - (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - WRITE(LU_ERR,"(A,3E12.4)") & - ' Cut/Regl Gas cells Centroid =',CCGP_XYZCEN(IAXIS:KAXIS) - WRITE(LU_ERR,"(A,3E12.4)") & - ' Centroid Relative Difference=',CCGP_XYZCEN(IAXIS:KAXIS)-& - (DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & - (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - WRITE(LU_SETCC,"(A,3E12.4)") & - ' GEOM Centroid =',XYZCEN_GEOM(IAXIS:KAXIS) - WRITE(LU_SETCC,"(A,3E12.4)") & - ' DOMAIN-GEOM Centroid =',(DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & - (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - WRITE(LU_SETCC,"(A,3E12.4)") & - ' Cut/Regl Gas cells Centroid =',CCGP_XYZCEN(IAXIS:KAXIS) - WRITE(LU_SETCC,"(A,3E12.4)") & - ' Centroid Relative Difference=',CCGP_XYZCEN(IAXIS:KAXIS)-& - (DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & - (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - ENDIF + ! First test if INB face is on Cartesian face and pointing + ! outside of Cartesian cell. If so drop: + ! Get min max in face for VERTS x,y,z: + XMIN(IAXIS:KAXIS)= 1._EB/TWENTY_EPSILON_EB + XMAX(IAXIS:KAXIS)=-1._EB/TWENTY_EPSILON_EB + DO ISEG_FACE=1,NSEG_FACE + XMIN(IAXIS) = MIN(XMIN(IAXIS), XYZVERT(IAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + XMIN(JAXIS) = MIN(XMIN(JAXIS), XYZVERT(JAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + XMIN(KAXIS) = MIN(XMIN(KAXIS), XYZVERT(KAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + XMAX(IAXIS) = MAX(XMAX(IAXIS), XYZVERT(IAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + XMAX(JAXIS) = MAX(XMAX(JAXIS), XYZVERT(JAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + XMAX(KAXIS) = MAX(XMAX(KAXIS), XYZVERT(KAXIS,SEG_FACE2(NOD1,ISEG_FACE))) + ENDDO + ! IAXIS: + IF ( (ABS(NORMTRI(IAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(XFACE(I-1)-XMIN(IAXIS)) < GEOMEPS) .AND. & + (ABS(XFACE(I-1)-XMAX(IAXIS)) < GEOMEPS)) CYCLE ! Low Face + IF ( (ABS(NORMTRI(IAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(XFACE(I )-XMIN(IAXIS)) < GEOMEPS) .AND. & + (ABS(XFACE(I )-XMAX(IAXIS)) < GEOMEPS)) CYCLE ! High Face + ! JAXIS: + IF ( (ABS(NORMTRI(JAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(YFACE(J-1)-XMIN(JAXIS)) < GEOMEPS) .AND. & + (ABS(YFACE(J-1)-XMAX(JAXIS)) < GEOMEPS)) CYCLE ! Low Face + IF ( (ABS(NORMTRI(JAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(YFACE(J )-XMIN(JAXIS)) < GEOMEPS) .AND. & + (ABS(YFACE(J )-XMAX(JAXIS)) < GEOMEPS)) CYCLE ! High Face + ! KAXIS: + IF ( (ABS(NORMTRI(KAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(ZFACE(K-1)-XMIN(KAXIS)) < GEOMEPS) .AND. & + (ABS(ZFACE(K-1)-XMAX(KAXIS)) < GEOMEPS)) CYCLE ! Low Face + IF ( (ABS(NORMTRI(KAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(ZFACE(K )-XMIN(KAXIS)) < GEOMEPS) .AND. & + (ABS(ZFACE(K )-XMAX(KAXIS)) < GEOMEPS)) CYCLE ! High Face - ! Write out the GEOM Area per SURF_ID: - ALLOCATE(GEOM_AREA_SURF(0:N_SURF)); GEOM_AREA_SURF=0._EB - ALLOCATE(GEOM_SURF(0:N_SURF)); GEOM_SURF=0 - SURF_MESH_LOOP : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - DO ICF=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - CFA=>CFACE(ICF) - GEOM_AREA_SURF(CFA%SURF_INDEX) = GEOM_AREA_SURF(CFA%SURF_INDEX) + CFA%AREA - GEOM_SURF(CFA%SURF_INDEX) = 1 - ENDDO - ENDDO SURF_MESH_LOOP - CALL MPI_ALLREDUCE(MPI_IN_PLACE, GEOM_AREA_SURF(0), N_SURF+1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) - CALL MPI_ALLREDUCE(MPI_IN_PLACE, GEOM_SURF(0), N_SURF+1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, IERR) - IF (MY_RANK==0) THEN - DO SURF_INDEX=0,N_SURF - IF (GEOM_SURF(SURF_INDEX)>0) & - WRITE(LU_ERR,"(A,1E14.6)") ' SURF_ID = '//TRIM(SURFACE(SURF_INDEX)%ID)//', Area : ',GEOM_AREA_SURF(SURF_INDEX) - WRITE(LU_SETCC,"(A,1E14.6)")' SURF_ID = '//TRIM(SURFACE(SURF_INDEX)%ID)//', Area : ',GEOM_AREA_SURF(SURF_INDEX) - ENDDO - ENDIF - DEALLOCATE(GEOM_AREA_SURF, GEOM_SURF) + ! Face Vertices average location: + XCEN(IAXIS:KAXIS) = 0._EB + DO ISEG_FACE=1,NSEG_FACE + XCEN(IAXIS:KAXIS) = XCEN(IAXIS:KAXIS) + XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE)) + ENDDO + XCEN(IAXIS:KAXIS) = XCEN(IAXIS:KAXIS) / REAL(NSEG_FACE,EB) - ! Write out special cells info: - N_SPCELLCF_TOT=0; N_SPCELL_TOT=0 - DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - N_SPCELLCF_TOT = N_SPCELLCF_TOT + MESHES(NM)%N_SPCELL_CF - N_SPCELL_TOT = N_SPCELL_TOT + MESHES(NM)%N_SPCELL - WRITE(LU_SETCC,"(A,3I8)") 'MESH, Number of Special Cells CF, Total=',NM,MESHES(NM)%N_SPCELL_CF,MESHES(NM)%N_SPCELL - DO ICC1=1,MESHES(NM)%N_SPCELL - WRITE(LU_SETCC,"(A,2I8,A,3I8)") 'NM,CELL IJK=',NM,ICC1,':',MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,ICC1) - ENDDO - ENDDO - CALL MPI_ALLREDUCE(MPI_IN_PLACE, N_SPCELLCF_TOT, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, IERR) - CALL MPI_ALLREDUCE(MPI_IN_PLACE, N_SPCELL_TOT, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, IERR) - IF (MY_RANK==0) WRITE(LU_ERR,"(A,2I8)") 'Total Number of Special Cells CF, Total=',N_SPCELLCF_TOT,N_SPCELL_TOT + ISEG_FACE = 1 + VC1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE )) - XCEN(IAXIS:KAXIS) + V12(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE+1)) - & + XYZVERT(IAXIS:KAXIS,SEG_FACE2(NOD1,ISEG_FACE )) - ! Write out more detailed stats: - WRITE_CFACE_STATS_COND : IF (WRITE_CFACE_STATS) THEN - ! Loop over meshes: - TESTS_MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - NCUTEDGE_IBCC = 0; SLEN_IBCC = 0._EB - NCUTEDGE_IBCF = 0 - ! Number of CUT_EDGE for this mesh: - IF(ALLOCATED(MESHES(NM)%CUT_EDGE)) THEN - DO ICE1 = 1,MESHES(NM)%N_CUTEDGE_MESH - SELECT CASE(MESHES(NM)%CUT_EDGE(ICE1)%STATUS) - CASE(CC_INBOUNDCC) - NEDGE = MESHES(NM)%CUT_EDGE(ICE1)%NEDGE - NCUTEDGE_IBCC = NCUTEDGE_IBCC + NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(ICE1)%CEELEM(NOD1:NOD2,IEDGE) - DV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(ICE1)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - & - MESHES(NM)%CUT_EDGE(ICE1)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) - SLEN_IBCC = SLEN_IBCC + SLEN - ENDDO - CASE(CC_INBOUNDCF) - SELECT CASE(MESHES(NM)%CUT_EDGE(ICE1)%IJK(4)) - CASE(IAXIS) - IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(IAXIS) == IBAR) CYCLE - CASE(JAXIS) - IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(JAXIS) == JBAR) CYCLE - CASE(KAXIS) - IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(KAXIS) == KBAR) CYCLE - END SELECT - NCUTEDGE_IBCF = NCUTEDGE_IBCF + MESHES(NM)%CUT_EDGE(ICE1)%NEDGE - END SELECT - ENDDO - ENDIF + CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) + CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) + CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'MESH=',NM - WRITE(LU_SETCC,*) 'CUTEDGE=',PROCESS(NM),NM,MESHES(NM)%N_CUTEDGE_MESH,MESHES(NM)%N_EDGE_CROSS - !WRITE(LU_SETCC,*) 'NCUTEDGE_IBCF =',NCUTEDGE_IBCF - !WRITE(LU_SETCC,*) 'NCUTEDGE_IBCC =',NCUTEDGE_IBCC, ', SLEN_IBCC =',SLEN_IBCC,', SLEN_GEOM =',SLEN_GEOM + RH_ORIENTED = ( NORMTRI(IAXIS)*CROSSV(IAXIS) + & + NORMTRI(JAXIS)*CROSSV(JAXIS) + & + NORMTRI(KAXIS)*CROSSV(KAXIS) ) > 0._EB - NCUTFACE_IAXIS = 0 - NCUTFACE_JAXIS = 0 - NCUTFACE_KAXIS = 0 - CF_AREA_IAXIS=0._EB; CF_AREA_JAXIS=0._EB; CF_AREA_KAXIS=0._EB - CF_INXAREA_IAXIS=0._EB; CF_INXAREA_JAXIS=0._EB; CF_INXAREA_KAXIS=0._EB - CF_INXSQAREA_IAXIS=0._EB; CF_INXSQAREA_JAXIS=0._EB; CF_INXSQAREA_KAXIS=0._EB - CF_JNYSQAREA_IAXIS=0._EB; CF_JNYSQAREA_JAXIS=0._EB; CF_JNYSQAREA_KAXIS=0._EB - CF_KNZSQAREA_IAXIS=0._EB; CF_KNZSQAREA_JAXIS=0._EB; CF_KNZSQAREA_KAXIS=0._EB - NCUTFACE_INB = 0 - CF_AREA_INB=0._EB; CF_INXAREA_INB=0._EB; - CF_INXSQAREA_INB=0._EB; CF_JNYSQAREA_INB=0._EB; CF_KNZSQAREA_INB=0._EB - DO ICF1 = 1,MESHES(NM)%N_CUTFACE_MESH - IF (CUT_FACE(ICF1)%STATUS == CC_GASPHASE) THEN - NFACE = CUT_FACE(ICF1)%NFACE - X1AXIS= CUT_FACE(ICF1)%IJK(MAX_DIM+1) - SELECT CASE(X1AXIS) - CASE(IAXIS) - NCUTFACE_IAXIS = NCUTFACE_IAXIS + NFACE - CF_AREA_IAXIS = CF_AREA_IAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_IAXIS = CF_INXAREA_IAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_IAXIS=CF_INXSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_IAXIS=CF_JNYSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_IAXIS=CF_KNZSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - CASE(JAXIS) - NCUTFACE_JAXIS = NCUTFACE_JAXIS + NFACE - CF_AREA_JAXIS = CF_AREA_JAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_JAXIS = CF_INXAREA_JAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_JAXIS=CF_INXSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_JAXIS=CF_JNYSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_JAXIS=CF_KNZSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - CASE(KAXIS) - NCUTFACE_KAXIS = NCUTFACE_KAXIS + NFACE - CF_AREA_KAXIS = CF_AREA_KAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_KAXIS = CF_INXAREA_KAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_KAXIS=CF_INXSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_KAXIS=CF_JNYSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_KAXIS=CF_KNZSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - END SELECT - ELSE ! CC_INBOUNDARY.. - NFACE = CUT_FACE(ICF1)%NFACE - CF_AREA_INB = CF_AREA_INB + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_INB = CF_INXAREA_INB + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_INB=CF_INXSQAREA_INB+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_INB=CF_JNYSQAREA_INB+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_INB=CF_KNZSQAREA_INB+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - ENDIF - ENDDO - !WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'CUTFACE=',PROCESS(NM),NM,MESHES(NM)%N_CUTFACE_MESH - WRITE(LU_SETCC,*) 'CUTFACE X Y Z=',NCUTFACE_IAXIS,NCUTFACE_JAXIS,NCUTFACE_KAXIS - !WRITE(LU_SETCC,*) 'CF_AREA X Y Z=',CF_AREA_IAXIS,CF_AREA_JAXIS,CF_AREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_INXAREA X Y Z=',CF_INXAREA_IAXIS,CF_INXAREA_JAXIS,CF_INXAREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_INXSQAREA X Y Z=',CF_INXSQAREA_IAXIS,CF_INXSQAREA_JAXIS,CF_INXSQAREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_JNYSQAREA X Y Z=',CF_JNYSQAREA_IAXIS,CF_JNYSQAREA_JAXIS,CF_JNYSQAREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_KNZSQAREA X Y Z=',CF_KNZSQAREA_IAXIS,CF_KNZSQAREA_JAXIS,CF_KNZSQAREA_KAXIS - !WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'CUTFACE INB=',NCUTFACE_INB - !WRITE(LU_SETCC,*) 'CF_AREA, CF_INXAREA INB=',CF_AREA_INB,CF_INXAREA_INB - !WRITE(LU_SETCC,*) 'CF_INXSQAREA INB =',CF_INXSQAREA_INB,CF_JNYSQAREA_INB,CF_KNZSQAREA_INB + NP = NSEG_FACE + NCF = CF%NFACE + 1 + NVSIZE=SIZE(CF%CFELEM,DIM=1) + IF(NP+1 > NVSIZE) THEN + ALLOCATE(CFELEM(1:NP+1+DELTA_VERT,1:NBODTRI)); CFELEM = CC_UNDEFINED + CFELEM(1:NVSIZE,1:NBODTRI) = CF%CFELEM(1:NVSIZE,1:NBODTRI) + CALL MOVE_ALLOC(FROM=CFELEM,TO=CF%CFELEM) + ALLOCATE(CFELEM(1:NP+1+DELTA_VERT,1:NBODTRI)); CFELEM = CC_UNDEFINED + CFELEM(1:NVSIZE,1:NBODTRI) = CF%CEDGES(1:NVSIZE,1:NBODTRI) + CALL MOVE_ALLOC(FROM=CFELEM,TO=CF%CEDGES) + ENDIF + CF%CFELEM(1,NCF) = NP; CF%CEDGES(1,NCF) = NP + IF (RH_ORIENTED) THEN + DO IDUM=1,NP + CF%CFELEM(IDUM+1,NCF) = SEG_FACE2(NOD1 ,IDUM) + CF%CEDGES(IDUM+1,NCF) = SEG_FACE2(NOD2+1,IDUM) ! Segment index in SEG_CELL/EDGE_LIST + ENDDO + ELSE + DO IDUM=1,NP + CF%CFELEM(IDUM+1,NCF) = SEG_FACE2(NOD1 ,NP+1-IDUM) + CF%CEDGES(IDUM+1,NCF) = SEG_FACE2(NOD2+1,NP+1-IDUM) ! Segment index in SEG_CELL/EDGE_LIST + ENDDO + IDUM = CF%CEDGES(2,NCF) + CF%CEDGES(2:NP,NCF) = CF%CEDGES(3:NP+1,NCF); CF%CEDGES(NP+1,NCF) = IDUM + ENDIF + CF%NFACE = NCF - ! Cut-cells: - MIN_CC_IJK_ICCJCC(1:5) = 0 - MAX_CC_IJK_ICCJCC(1:5) = 0 - MIN_CC_VOL = 1.E20_EB; MIN_ALPHA_CV = 1.E20_EB - MAX_CC_VOL =-1.E20_EB; MAX_ALPHA_CV =-1.E20_EB - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH - CC => CUT_CELL(ICC1) - DO ICC2=1,CC%NCELL - IF(CC%VOLUME(ICC2) < MIN_CC_VOL) THEN - MIN_CC_VOL = CC%VOLUME(ICC2) - MIN_ALPHA_CV = MIN_CC_VOL / ( DX(CC%IJK(IAXIS))*DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) ) - MIN_CC_IJK_ICCJCC(1:5) = (/ CC%IJK(1:3), ICC1, ICC2 /) - ENDIF - IF(CC%VOLUME(ICC2) > MAX_CC_VOL) THEN - MAX_CC_VOL = CC%VOLUME(ICC2) - MAX_ALPHA_CV = MAX_CC_VOL / ( DX(CC%IJK(IAXIS))*DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) ) - MAX_CC_IJK_ICCJCC(1:5) = (/ CC%IJK(1:3), ICC1, ICC2 /) - ENDIF + ! Compute Sections area and centroid: + AREA = 0._EB + ACEN(IAXIS:KAXIS) = 0._EB + INXAREA = 0._EB + SQAREA(IAXIS:KAXIS) = 0._EB + DO ISEG_FACE=1,NSEG_FACE-1 + + IDUM = CF%CFELEM(1+ISEG_FACE,NCF) + X1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) + IDUM = CF%CFELEM(2+ISEG_FACE,NCF) + X2(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) + VC1(IAXIS:KAXIS) = X1(IAXIS:KAXIS) - XCEN(IAXIS:KAXIS) + V12(IAXIS:KAXIS) = X2(IAXIS:KAXIS) - X1(IAXIS:KAXIS) + XCENI(IAXIS:KAXIS) = (XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) / 3._EB + + CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) + CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) + CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) + + AREAI = 0.5_EB * SQRT( CROSSV(IAXIS)**2._EB + CROSSV(JAXIS)**2._EB + CROSSV(KAXIS)**2._EB ) + AREA = AREA + AREAI + ACEN(IAXIS:KAXIS) = ACEN(IAXIS:KAXIS) + AREAI * XCENI(IAXIS:KAXIS) + ! volume computation variables: + XC1(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS)) + XC2(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) + X12(IAXIS:KAXIS) = 0.5_EB*( X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) + ! dot(i,nc) int(x)dA + INXAREA = INXAREA + NORMTRI(IAXIS)*XCENI(IAXIS)*AREAI ! Single Gauss pt integration. + ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA + DO IX=IAXIS,KAXIS + INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB + SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREAI ! Midpoint rule. + ENDDO ENDDO - ENDDO - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'CUTCELL=',PROCESS(NM),NM,MESHES(NM)%N_CUTCELL_MESH - WRITE(LU_SETCC,*) 'MIN VOL=',MIN_CC_IJK_ICCJCC(1:5),MIN_CC_VOL,MIN_ALPHA_CV - WRITE(LU_SETCC,*) 'MAX VOL=',MAX_CC_IJK_ICCJCC(1:5),MAX_CC_VOL,MAX_ALPHA_CV + ! Final seg: + IDUM = CF%CFELEM(1+NSEG_FACE,NCF) + X1(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) + IDUM = CF%CFELEM(1+1 ,NCF) + X2(IAXIS:KAXIS) = XYZVERT(IAXIS:KAXIS,IDUM) - ! Dump info for Max Size Cut-cell: - DO IG=1,2 - IF(IG==1) THEN; ICC1 = MIN_CC_IJK_ICCJCC(4); ICC2 = MIN_CC_IJK_ICCJCC(5); ENDIF - IF(IG==2) THEN; ICC1 = MAX_CC_IJK_ICCJCC(4); ICC2 = MAX_CC_IJK_ICCJCC(5); ENDIF - IF(ICC1==0) CYCLE - CC => CUT_CELL(ICC1) - I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF(IG==1) THEN; WRITE(LU_SETCC,*) 'MIN VOL CC cut-faces:',I,J,K; ENDIF - IF(IG==2) THEN; WRITE(LU_SETCC,*) 'MAX VOL CC cut-faces:',I,J,K; ENDIF - DO JCF=2,CC%CCELEM(1,ICC2)+1 - IFACE = CC%CCELEM(JCF,ICC2) - FTYPE = CC%FACE_LIST(1,IFACE) - ILH = CC%FACE_LIST(2,IFACE) - 2 ! -1 for LOW_IND, 0 for HIGH_IND - X1AXIS= CC%FACE_LIST(3,IFACE) - SELECT CASE(FTYPE) - CASE(CC_FTYPE_RCGAS) - SELECT CASE(X1AXIS) - CASE(IAXIS); I=CC%IJK(IAXIS)+ILH; ACRT = DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) - CASE(JAXIS); J=CC%IJK(JAXIS)+ILH; ACRT = DX(CC%IJK(IAXIS))*DZ(CC%IJK(KAXIS)) - CASE(KAXIS); K=CC%IJK(KAXIS)+ILH; ACRT = DY(CC%IJK(JAXIS))*DX(CC%IJK(IAXIS)) - END SELECT - WRITE(LU_SETCC,*) JCF-1,' RCGAS ',I,J,K,X1AXIS,ACRT,ACRT/ACRT - CASE(CC_FTYPE_CFGAS) - SELECT CASE(X1AXIS) - CASE(IAXIS); ACRT = DY(J)*DZ(K) - CASE(JAXIS); ACRT = DX(I)*DZ(K) - CASE(KAXIS); ACRT = DY(J)*DX(I) - END SELECT - ICF2 = CC%FACE_LIST(4,IFACE) - JCF2 = CC%FACE_LIST(5,IFACE) - WRITE(LU_SETCC,*) JCF-1,' CFGAS ',CUT_FACE(ICF2)%IJK(1:KAXIS+1),CUT_FACE(ICF2)%AREA(JCF2),& - CUT_FACE(ICF2)%AREA(JCF2)/ACRT - CASE(CC_FTYPE_CFINB) - ICF2 = CC%FACE_LIST(4,IFACE) - JCF2 = CC%FACE_LIST(5,IFACE) - ACRT = 1._EB/3._EB*(DY(J)*DZ(K)+DX(I)*DZ(K)+DY(J)*DX(I)) - WRITE(LU_SETCC,*) JCF-1,' CFINB ',CUT_FACE(ICF2)%IJK(1:KAXIS+1),CUT_FACE(ICF2)%AREA(JCF2) - END SELECT + VC1(IAXIS:KAXIS) = X1(IAXIS:KAXIS) - XCEN(IAXIS:KAXIS) + V12(IAXIS:KAXIS) = X2(IAXIS:KAXIS) - X1(IAXIS:KAXIS) + XCENI(IAXIS:KAXIS) = (XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) / 3._EB + + CROSSV(IAXIS) = VC1(JAXIS)*V12(KAXIS) - VC1(KAXIS)*V12(JAXIS) + CROSSV(JAXIS) = VC1(KAXIS)*V12(IAXIS) - VC1(IAXIS)*V12(KAXIS) + CROSSV(KAXIS) = VC1(IAXIS)*V12(JAXIS) - VC1(JAXIS)*V12(IAXIS) + + AREAI = 0.5_EB * SQRT( CROSSV(IAXIS)**2._EB + CROSSV(JAXIS)**2._EB + CROSSV(KAXIS)**2._EB ) + AREA = AREA + AREAI + ACEN(IAXIS:KAXIS) = (ACEN(IAXIS:KAXIS) + AREAI * XCENI(IAXIS:KAXIS))/AREA + ! volume computation variables: + XC1(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X1(IAXIS:KAXIS)) + XC2(IAXIS:KAXIS) = 0.5_EB*(XCEN(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) + X12(IAXIS:KAXIS) = 0.5_EB*( X1(IAXIS:KAXIS) + X2(IAXIS:KAXIS)) + ! dot(i,nc) int(x)dA + INXAREA = INXAREA + NORMTRI(IAXIS)*XCENI(IAXIS)*AREAI ! Single Gauss pt integration. + ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA + DO IX=IAXIS,KAXIS + INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB + SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREAI ! Midpoint rule. ENDDO - ENDDO + CF%AREA(NCF) = AREA + CF%XYZCEN(IAXIS:KAXIS,NCF) = ACEN(IAXIS:KAXIS) + ! Fields for cut-cell volume/centroid computation: + CF%INXAREA(NCF) = INXAREA ! dot(i,nc)*int(x)dA + CF%INXSQAREA(NCF) = SQAREA(IAXIS) ! dot(i,nc)*int(x^2)dA + CF%JNYSQAREA(NCF) = SQAREA(JAXIS) ! dot(j,nc)*int(y^2)dA + CF%KNZSQAREA(NCF) = SQAREA(KAXIS) ! dot(k,nc)*int(z^2)dA + ! Define Body-triangle reference: + CF%BODTRI(1:2,NCF)= (/ IBOD, ITRI /) + ! Assign surf-index: Depending on GEOMETRY: + CF%SURF_INDEX(NCF) = GEOMETRY(IBOD)%SURFS(ITRI) - ENDDO TESTS_MESH_LOOP_2 - ENDIF WRITE_CFACE_STATS_COND -ENDIF CCVERBOSE_COND + ENDDO ICF_LOOP -END SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY + ! IF((NM==3 .AND. I==4 .AND. J==6 .AND. K==36)) THEN + ! LU_DB_SETCC = GET_FILE_NUMBER() + ! WRITE(LU_ERR,*) 'Writing Cartcell_cutfaces.dat... 11111' + ! OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_cutfaces.dat", STATUS='REPLACE') + ! ! Info pertaining to the Cartesian Cell: + ! WRITE(LU_DB_SETCC,*) 'I,J,K:',CF%NFACE + ! WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS + ! WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' + ! WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) ! MESHES(NM)%XC(I),MESHES(NM)%DX(I) + ! WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) ! MESHES(NM)%YC(J),MESHES(NM)%DY(J) + ! WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) ! MESHES(NM)%ZC(K),MESHES(NM)%DZ(K) + ! WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT:' + ! WRITE(LU_DB_SETCC,*) NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT,CF%NFACE + ! WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' + ! DO IDUM=1,NVERT + ! WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' + ! DO IDUM=1,NSEG + ! WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(NOD1:NOD2,IDUM),SEG_CELL(3:6,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'ICF,BOD_TRI:' + ! WRITE(LU_DB_SETCC,*) ICF,NBODTRI + ! DO IDUM=1,NBODTRI + ! WRITE(LU_DB_SETCC,*) BOD_TRI(1:2,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'CFELEM:' + ! DO IDUM=1,CF%NFACE + ! WRITE(LU_DB_SETCC,*) IDUM,CF%CFELEM(1:CF%CFELEM(1,IDUM)+1,IDUM) + ! ENDDO + ! CLOSE(LU_DB_SETCC) + ! ENDIF + + ! IF(.NOT.CYCLE_CELL) THEN + ! DO ICF = 1, CF%NFACE + ! DO ISEG=1,CF%CEDGES(1,ICF) + ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) + ! IF (ISEGGEOMEPS) THEN + ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT + ! ENDIF + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN + ! WRITE(LU_ERR,*) 'CARTC Found difference in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC,CYCLE_CELL + ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) + ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) + ! ENDIF + ! END SELECT + ! ENDDO + ! ENDDO + ! ENDIF + ! WRITE(LU_ERR,*) 'CORRECT CELL I,J,K CUT_FACES',I,J,K,CF%NFACE,NSEG,RH_ORIENTED + ! DO ICF = 1, CF%NFACE + ! WRITE(LU_ERR,*) CF%CEDGES(1:CF%CEDGES(1,ICF)+1,ICF),':',CF%CFELEM(2:CF%CFELEM(1,ICF)+1,ICF) + ! ITRI = CF%EDGE_LIST(2,CF%CEDGES(2,ICF)); IBOD = CF%EDGE_LIST(3,CF%CEDGES(2,ICF)) + ! WRITE(LU_ERR,*) 'E1 N1=',MESHES(NM)%CUT_EDGE(ITRI)%XYZVERT(:,MESHES(NM)%CUT_EDGE(ITRI)%CEELEM(1,IBOD)),& + ! CF%XYZVERT(:,CF%CFELEM(2,ICF)) + ! ITRI = CF%EDGE_LIST(2,CF%CEDGES(2,ICF)); IBOD = CF%EDGE_LIST(3,CF%CEDGES(2,ICF)) + ! WRITE(LU_ERR,*) 'E1 N2=',MESHES(NM)%CUT_EDGE(ITRI)%XYZVERT(:,MESHES(NM)%CUT_EDGE(ITRI)%CEELEM(2,IBOD)),& + ! CF%XYZVERT(:,CF%CFELEM(3,ICF)) + ! ENDDO + ! DO ICF = 1, NSEG + ! WRITE(LU_ERR,*) ICF,CF%EDGE_LIST(1:3,ICF) + ! ENDDO + + ! Here if CFACES could not be built, flag the cell as SPECIAL & reduce NCUTFACE by one: + IF (CYCLE_CELL) THEN + CELLRT(I,J,K) =.TRUE. + IJK_COUNTED(I,J,K)=.FALSE. + MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED; + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = 0 ! No axis = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_UNDEFINED + CALL FACE_DEALLOC(NM,NCUTFACE) + ! This is a cut-face, allocate space: + NCUTFACE = NCUTFACE-1 + IF (BNDINT_FLAG) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH - 1 + ENDIF + ! Now cleanup CUT_EDGES that live on this cell: This space will be used later when trying to linearize the + ! surface. + CEI=MESHES(NM)%CCVAR(I,J,K,CC_IDCE); + IF ( CEI > 0 ) THEN + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + MESHES(NM)%CUT_EDGE(CEI)%INDSEG = 0 + ENDIF + ENDIF + + ENDDO ! I + ENDDO ! J +ENDDO ! K -SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS +! Now process special cells of type CELLRT=T: +! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: +DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -USE TRAN, ONLY: GET_IJK -INTEGER :: NM2,ICELL,I2,J2,K2,BLOCK_TAG -LOGICAL :: IND_FOUND -REAL(EB):: XCO,YCO,ZCO,VOL_NM,VOL_NOM,X1,Y1,Z1 -TYPE(MESH_TYPE), POINTER :: M2 + IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE -MESH_LOOP : DO NM=1,NMESHES + IF (.NOT.CELLRT(I,J,K)) CYCLE ! Special cell with bod-bod or self intersection. - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 + IF (IJK_COUNTED(I,J,K)) CYCLE; IJK_COUNTED(I,J,K)=.TRUE. - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + ! Start cut-cell INB cut-faces computation: + ! Loop local arrays to cell: + NSEG = 0 + SEG_CELL = CC_UNDEFINED - ! Compute average cell volume for mesh NM - VOL_NM = (M%XF-M%XS)*(M%YF-M%YS)*(M%ZF-M%ZS) / REAL(M%IBAR*M%JBAR*M%KBAR,EB) + NVERT = 0 + NFACE = 0 + XYZVERT = 0._EB - ! Process blocked cut-cells from neighboring meshes: - NEIGHBORING_MESHES_DO : DO NM2=1,M%N_NEIGHBORING_MESHES - NOM = M%NEIGHBORING_MESH(NM2); IF (NOM==NM) CYCLE - M2 => MESHES(NOM) + ! CUT_EDGE index of bounding Cartesian faces: + CEIB_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCE,IAXIS) + CEIB_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCE,IAXIS) + CEIB_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCE,JAXIS) + CEIB_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCE,JAXIS) + CEIB_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCE,KAXIS) + CEIB_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCE,KAXIS) - ICELL_DO : DO ICELL=1,M2%N_CC_BLOCKED - XCO = M2%XYZ_CC_BLOCKED(IAXIS,ICELL) - YCO = M2%XYZ_CC_BLOCKED(JAXIS,ICELL) - ZCO = M2%XYZ_CC_BLOCKED(KAXIS,ICELL) - BLOCK_TAG = M2%JBT_CC_BLOCKED(2,ICELL) + ! Cartesian Faces INBOUNDARY segments: + DO FAXIS=IAXIS,KAXIS + DO ILH=LOW_IND,HIGH_IND + ! By segment: Add Vertices/Segments to local arrays: + CEI = CEIB_XYZ(ILH,FAXIS) + IF ( CEI > 0 ) THEN ! There are inboundary cut-edges + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE1 + DO IEDGE=1,NEDGE - CALL GET_IJK(XCO,YCO,ZCO,NOM,X1,Y1,Z1,I2,J2,K2) - VOL_NOM = M2%DX(I2)*M2%DY(J2)*M2%DZ(K2) + SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,IEDGE) + STRI(1:CC_MAX_WSTRIANG_SEG+2) = & + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,IEDGE) - IF (VOL_NM > 1.5_EB * VOL_NOM) THEN ! NM is COARSE, NOM is FINE - IF(XCO < M2%XS .OR. XCO > M2%XF .OR. & - YCO < M2%YS .OR. YCO > M2%YF .OR. & - ZCO < M2%ZS .OR. ZCO > M2%ZF) CYCLE ICELL_DO - IF(XCO > M2%X(1) .AND. XCO < M2%X(M2%IBAR-1) .AND. & - YCO > M2%Y(1) .AND. YCO < M2%Y(M2%JBAR-1) .AND. & - ZCO > M2%Z(1) .AND. ZCO < M2%Z(M2%KBAR-1)) CYCLE ICELL_DO + ! x,y,z of node 1: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD1,XYZVERT) + ! x,y,z of node 2: + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_FACE,XYZ,NVERT,INOD2,XYZVERT) - ! Find I,J,K in NM where (XCO,YCO,ZCO) falls within cell bounds - IND_FOUND = .FALSE. - DO I=ILO_CELL-1,IHI_CELL+1 - IF (XCO < XFACE(I-1)-GEOMEPS .OR. XCO > XFACE(I)+GEOMEPS) CYCLE - DO J=JLO_CELL-1,JHI_CELL+1 - IF (YCO < YFACE(J-1)-GEOMEPS .OR. YCO > YFACE(J)+GEOMEPS) CYCLE - DO K=KLO_CELL-1,KHI_CELL+1 - IF (ZCO < ZFACE(K-1)-GEOMEPS .OR. ZCO > ZFACE(K)+GEOMEPS) CYCLE - IF (I > ILO_CELL-1 .AND. I < IHI_CELL+1 .AND. & - J > JLO_CELL-1 .AND. J < JHI_CELL+1 .AND. & - K > KLO_CELL-1 .AND. K < KHI_CELL+1) CYCLE - IND_FOUND = .TRUE. - EXIT + VEC(NOD1:NOD2) = (HIGH_IND-ILH)*(/ INOD1, INOD2 /) + (ILH-LOW_IND)*(/ INOD2, INOD1 /) + VEC(NOD2+1:NOD2+CC_MAX_WSTRIANG_SEG+2) = STRI(1:CC_MAX_WSTRIANG_SEG+2) + VEC(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7) = (/ CC_ETYPE_CFINB, CEI, IEDGE /) + ! Insertion ADD segment: + INLIST = .FALSE. + DO IDUM = 1,NSEG + DO IEQ1=1,3 + EQUAL1 = SEG_CELL(INDVERTBOD(IEQ1),IDUM) == VEC(INDVERTBOD(IEQ1)) + IF (.NOT.EQUAL1) EXIT + ENDDO + DO IEQ2=1,3 + EQUAL2 = SEG_CELL(INDVERTBOD(IEQ2),IDUM) == VEC(INDVERTBOD2(IEQ2)) + IF (.NOT.EQUAL2) EXIT + ENDDO + IF ( EQUAL1 .OR. EQUAL2 ) THEN + IF ( SEG_CELL(3,IDUM) > VEC(3) ) THEN + ! DO NOTHING: + ELSEIF (SEG_CELL(3,IDUM) < VEC(3)) THEN + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + ELSEIF (SEG_CELL(4,IDUM) /= VEC(4)) THEN + SEG_CELL(3,IDUM) = SEG_CELL(3,IDUM) + 1 + SEG_CELL(5,IDUM) = VEC(4) + ENDIF + INLIST = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.INLIST) THEN + NSEG = NSEG + 1 + CALL REALLOCATE_SEG_CELL + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,NSEG) = VEC(1:NOD2+CC_MAX_WSTRIANG_SEG+5) + SEG_POS(NSEG) = (2*ILH-3)*FAXIS + ENDIF ENDDO - IF (IND_FOUND) EXIT - ENDDO - IF (IND_FOUND) EXIT + ENDIF ENDDO - IF (.NOT.IND_FOUND) CYCLE ICELL_DO + ENDDO - ! Tag the coarse ghost-cell in NM that contains the blocked fine cell. - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF (ICC > 0) THEN - DO JCC = 1, M%CUT_CELL(ICC)%NCELL - IF (M%CUT_CELL(ICC)%NOADVANCE(JCC) == NOT_BLOCKED) & - M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCK_TAG - ENDDO + ! Drop segments that are unconnected: + ALLOCATE(VERT_SEGS(1:NVERT)); VERT_SEGS(1:NVERT)=0 + DO IDUM = 1,NSEG + VERT_SEGS(SEG_CELL(NOD1,IDUM)) = VERT_SEGS(SEG_CELL(NOD1,IDUM)) + 1 + VERT_SEGS(SEG_CELL(NOD2,IDUM)) = VERT_SEGS(SEG_CELL(NOD2,IDUM)) + 1 + ENDDO + ALLOCATE(SEG_CELL_AUX(SIZE(SEG_CELL,DIM=1),SIZE(SEG_CELL,DIM=2))) + SEG_CELL_AUX = SEG_CELL + COUNT = 0 + DO IDUM = 1,NSEG + IF ( SEG_CELL_AUX(NOD1,IDUM)==SEG_CELL_AUX(NOD2,IDUM) ) CYCLE + IF ( (VERT_SEGS(SEG_CELL_AUX(NOD1,IDUM))>1) .AND. (VERT_SEGS(SEG_CELL_AUX(NOD2,IDUM))>1) ) THEN + COUNT = COUNT + 1 + SEG_CELL(:,COUNT) = SEG_CELL_AUX(:,IDUM) + CYCLE + ENDIF + ENDDO + NSEG = COUNT + DEALLOCATE(SEG_CELL_AUX,VERT_SEGS) + + IF (NSEG < 3 ) CYCLE + + ! IF(NM==1 .AND. I==37 .AND. J==6 .AND. K==32) THEN + ! LU_DB_SETCC = GET_FILE_NUMBER() + ! WRITE(LU_ERR,*) 'Writing Cartcell_SEGCELL.dat...' + ! OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_SEGCELL.dat", STATUS='REPLACE') + ! ! Info pertaining to the Cartesian Cell: + ! WRITE(LU_DB_SETCC,*) 'I,J,K:',CF%NFACE + ! WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS + ! WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' + ! WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) + ! WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) + ! WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) + ! WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,SIZE_CEELEM_SEG_CELL,CC_MAX_WSTRIANG_SEG:' + ! WRITE(LU_DB_SETCC,*) NVERT,NSEG,SIZE_CEELEM_SEG_CELL,CC_MAX_WSTRIANG_SEG + ! WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' + ! DO IDUM=1,NVERT + ! WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG):' + ! DO IDUM=1,NSEG + ! WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,IDUM),SEG_POS(IDUM) + ! ENDDO + ! CLOSE(LU_DB_SETCC) + ! ENDIF + + + ! Ear clipping algorithm by TRIANGLE and BODY: + ! 1. Define closed 3D polyline: + CALL GET_CLOSED_POLYLINES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,SEG_POS,IFLG,NPOLY,ILO_POLY,NSG_POLY) + + IF (IFLG) THEN + IF(DEBUG_SET_CUTCELLS .AND. MY_RANK==PROCESS(NM)) WRITE(LU_ERR,*) 'IFLG ~=0, could not close polyline, ',& + BNDINT_FLAG,': ',NM,I,J,K,' NPOLY=',NPOLY,IFLG,'NSEG=',NSEG + MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 + NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) + IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN + ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) + DEALLOCATE(MESHES(NM)%SPCELL_LIST) + ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED + DEALLOCATE(SPCELL_LIST) + ENDIF + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) + ! Add to cells to block list: + N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK + 1 + COUNT = SIZE(SPCELLS_TO_BLOCK,DIM=1) + IF( COUNT MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) + ALLOCATE(CF%EDGE_LIST(3,CT_EDGES),CF%CEDGES(NOD3+1,NFACE)); CF%CEDGES = CC_UNDEFINED + CF%EDGE_LIST(1:3,1:CT_EDGES) = SEG_CELL_AUX(CC_MAX_WSTRIANG_SEG+5:CC_MAX_WSTRIANG_SEG+7,1:CT_EDGES) - ! Here we have found the I,J,K indices of the blocked cut-cell: - ICC=M%CCVAR(I,J,K,CC_IDCC) - IF(ICC>0) M%CUT_CELL(ICC)%NOADVANCE(M2%JBT_CC_BLOCKED(1,ICELL)) = BLOCK_TAG + ! Assign surf-index: Depending on GEOMETRY: + NCF = 0 + DO ICF=1,NFACE + IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) - ENDIF - ENDDO ICELL_DO - ENDDO NEIGHBORING_MESHES_DO - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -ENDDO MESH_LOOP + ! Area properties for special cfaces: + ! Computed from the cross product: + D23 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + D12 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + CALL CROSS_PRODUCT(NORMTRI,D12,D23) + ! Test RH rule for CFACE normal outside of body (into gas phase): + RH_ORIENTED = ( GEOMETRY(IBOD)%FACES_NORMAL(IAXIS,ITRI)*NORMTRI(IAXIS) + & + GEOMETRY(IBOD)%FACES_NORMAL(JAXIS,ITRI)*NORMTRI(JAXIS) + & + GEOMETRY(IBOD)%FACES_NORMAL(KAXIS,ITRI)*NORMTRI(KAXIS) ) > -TWENTY_EPSILON_EB + IF(.NOT.RH_ORIENTED) THEN ! Swap normal for triangle: + IDUM = CFELEM(1+NOD2,ICF); CFELEM(1+NOD2,ICF) = CFELEM(1+NOD1,ICF); CFELEM(1+NOD1,ICF) = IDUM + D23 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + D12 = XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) - XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + CALL CROSS_PRODUCT(NORMTRI,D12,D23) + ENDIF + NNORM = NORM2(NORMTRI) + IF (NNORM < 2._EB*GEOMEPS**2._EB) CYCLE + NORMTRI(IAXIS:KAXIS) = NORMTRI(IAXIS:KAXIS) / NNORM -END SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS + ! First test if INB face is on Cartesian face and pointing + ! outside of Cartesian cell. If so drop: + ! Face Vertices average location: + ACEN(IAXIS:KAXIS) = 1._EB/3._EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & + XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + & + XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) + ! IAXIS: + IF ( (ABS(NORMTRI(IAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(XFACE(I-1)-ACEN(IAXIS)) < GEOMEPS) ) CYCLE ! Low Face + IF ( (ABS(NORMTRI(IAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(XFACE(I )-ACEN(IAXIS)) < GEOMEPS) ) CYCLE ! High Face + ! JAXIS: + IF ( (ABS(NORMTRI(JAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(YFACE(J-1)-ACEN(JAXIS)) < GEOMEPS) ) CYCLE ! Low Face + IF ( (ABS(NORMTRI(JAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(YFACE(J )-ACEN(JAXIS)) < GEOMEPS) ) CYCLE ! High Face + ! KAXIS: + IF ( (ABS(NORMTRI(KAXIS)+1._EB) < GEOMEPS) .AND. & + (ABS(ZFACE(K-1)-ACEN(KAXIS)) < GEOMEPS) ) CYCLE ! Low Face + IF ( (ABS(NORMTRI(KAXIS)-1._EB) < GEOMEPS) .AND. & + (ABS(ZFACE(K )-ACEN(KAXIS)) < GEOMEPS) ) CYCLE ! High Face + ! Area: + AREA = 0.5_EB*NNORM -SUBROUTINE DEFINE_XYZFACE_CELL(ALLOC_FLG) + ! dot(i,nc) int(x)dA + INXAREA = NORMTRI(IAXIS)*ACEN(IAXIS)*AREA ! Single Gauss pt integration. -LOGICAL, INTENT(IN) :: ALLOC_FLG + XC1(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF)) + & + XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) ! X23 + XC2(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & + XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD3,ICF))) + X12(IAXIS:KAXIS) = 0.5_EB*(XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD1,ICF)) + & + XYZVERT(IAXIS:KAXIS,CFELEM(1+NOD2,ICF))) + ! dot(i,nc) int(x^2)dA, dot(j,nc) int(y^2)dA, dot(k,nc) int(z^2)dA + SQAREA(IAXIS:KAXIS) = 0._EB + DO IX=IAXIS,KAXIS + INT2 = (XC1(IX)**2._EB + XC2(IX)**2._EB + X12(IX)**2._EB) / 3._EB + SQAREA(IX) = SQAREA(IX) + NORMTRI(IX)*INT2*AREA ! Midpoint rule. + ENDDO -IF (ALLOC_FLG) THEN + NCF = NCF + 1 + CF%AREA(NCF) = AREA + CF%XYZCEN(IAXIS:KAXIS,NCF) = ACEN(IAXIS:KAXIS) - ! X direction bounds: - ILO_FACE = 0 ! Low mesh boundary face index. - IHI_FACE = M%IBAR ! High mesh boundary face index. - ILO_CELL = ILO_FACE + 1 ! First internal cell index. See notes. - IHI_CELL = IHI_FACE ! Last internal cell index. - ISTR = ILO_FACE - NGUARD ! Allocation start x arrays. - IEND = IHI_FACE + NGUARD ! Allocation end x arrays. + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA: + CF%INXAREA(NCF) = INXAREA + ! dot(i,nc)*int(x^2)dA: + CF%INXSQAREA(NCF) = SQAREA(IAXIS) + ! dot(j,nc)*int(y^2)dA: + CF%JNYSQAREA(NCF) = SQAREA(JAXIS) + ! dot(k,nc)*int(z^2)dA: + CF%KNZSQAREA(NCF) = SQAREA(KAXIS) - ! Y direction bounds: - JLO_FACE = 0 ! Low mesh boundary face index. - JHI_FACE = M%JBAR ! High mesh boundary face index. - JLO_CELL = JLO_FACE + 1 ! First internal cell index. See notes. - JHI_CELL = JHI_FACE ! Last internal cell index. - JSTR = JLO_FACE - NGUARD ! Allocation start y arrays. - JEND = JHI_FACE + NGUARD ! Allocation end y arrays. + ! Define Body-triangle reference: + CF%BODTRI(1:2,NCF)= (/ IBOD, ITRI /) - ! Z direction bounds: - KLO_FACE = 0 ! Low mesh boundary face index. - KHI_FACE = M%KBAR ! High mesh boundary face index. - KLO_CELL = KLO_FACE + 1 ! First internal cell index. See notes. - KHI_CELL = KHI_FACE ! Last internal cell index. - KSTR = KLO_FACE - NGUARD ! Allocation start z arrays. - KEND = KHI_FACE + NGUARD ! Allocation end z arrays. + CF%SURF_INDEX(NCF) = GEOMETRY(IBOD)%SURFS(ITRI) - ! Define grid arrays for this mesh: - ! Populate position and cell size arrays: Uniform grid implementation. - ! X direction: - ALLOCATE(DXCELL(ISTR:IEND)); DXCELL(ILO_CELL-1:IHI_CELL+1) = M%DX(ILO_CELL-1:IHI_CELL+1) - DO IGC=2,NGUARD - DXCELL(ILO_CELL-IGC)=DXCELL(ILO_CELL-IGC+1) - DXCELL(IHI_CELL+IGC)=DXCELL(IHI_CELL+IGC-1) - ENDDO - ALLOCATE(DXFACE(ISTR:IEND)); DXFACE(ILO_FACE:IHI_FACE)= M%DXN(ILO_FACE:IHI_FACE) - DO IGC=1,NGUARD - DXFACE(ILO_FACE-IGC)=DXFACE(ILO_FACE-IGC+1) - DXFACE(IHI_FACE+IGC)=DXFACE(ILO_FACE+IGC-1) - ENDDO - ALLOCATE(XCELL(ISTR:IEND)); XCELL = 1._EB/GEOMEPS ! Initialize huge. - XCELL(ILO_CELL-1:IHI_CELL+1) = M%XC(ILO_CELL-1:IHI_CELL+1) - DO IGC=2,NGUARD - XCELL(ILO_CELL-IGC)=XCELL(ILO_CELL-IGC+1)-DXFACE(ILO_FACE-IGC+1) - XCELL(IHI_CELL+IGC)=XCELL(IHI_CELL+IGC-1)+DXFACE(IHI_FACE+IGC-1) - ENDDO - ALLOCATE(XFACE(ISTR:IEND)); XFACE = 1._EB/GEOMEPS ! Initialize huge. - XFACE(ILO_FACE:IHI_FACE) = M%X(ILO_FACE:IHI_FACE) - DO IGC=1,NGUARD - XFACE(ILO_FACE-IGC)=XFACE(ILO_FACE-IGC+1)-DXCELL(ILO_CELL-IGC) - XFACE(IHI_FACE+IGC)=XFACE(IHI_FACE+IGC-1)+DXCELL(IHI_CELL+IGC) - ENDDO + ! All faces connectivities: + CF%CFELEM(1:1+NOD3,NCF) = CFELEM(1:1+NOD3,ICF) + CF%CEDGES(1:1+NOD3,NCF) = CEDGES(1:1+NOD3,ICF) - ! Y direction: - ALLOCATE(DYCELL(JSTR:JEND)); DYCELL(JLO_CELL-1:JHI_CELL+1)= M%DY(JLO_CELL-1:JHI_CELL+1) - DO IGC=2,NGUARD - DYCELL(JLO_CELL-IGC)=DYCELL(JLO_CELL-IGC+1) - DYCELL(JHI_CELL+IGC)=DYCELL(JHI_CELL+IGC-1) - ENDDO - ALLOCATE(DYFACE(JSTR:JEND)); DYFACE(JLO_FACE:JHI_FACE)= M%DYN(JLO_FACE:JHI_FACE) - DO IGC=1,NGUARD - DYFACE(JLO_FACE-IGC)=DYFACE(JLO_FACE-IGC+1) - DYFACE(JHI_FACE+IGC)=DYFACE(JHI_FACE+IGC-1) - ENDDO - ALLOCATE(YCELL(JSTR:JEND)); YCELL = 1._EB/GEOMEPS ! Initialize huge. - YCELL(JLO_CELL-1:JHI_CELL+1) = M%YC(JLO_CELL-1:JHI_CELL+1) - DO IGC=2,NGUARD - YCELL(JLO_CELL-IGC)=YCELL(JLO_CELL-IGC+1)-DYFACE(JLO_FACE-IGC+1) - YCELL(JHI_CELL+IGC)=YCELL(JHI_CELL+IGC-1)+DYFACE(JHI_FACE+IGC-1) - ENDDO - ALLOCATE(YFACE(JSTR:JEND)); YFACE = 1._EB/GEOMEPS ! Initialize huge. - YFACE(JLO_FACE:JHI_FACE) = M%Y(JLO_FACE:JHI_FACE) - DO IGC=1,NGUARD - YFACE(JLO_FACE-IGC)=YFACE(JLO_FACE-IGC+1)-DYCELL(JLO_CELL-IGC) - YFACE(JHI_FACE+IGC)=YFACE(JHI_FACE+IGC-1)+DYCELL(JHI_CELL+IGC) - ENDDO + ENDDO + DEALLOCATE(CFELEM,SEG_CELL_AUX,CEDGES) + CF%NFACE = NCF - ! Z direction: - ALLOCATE(DZCELL(KSTR:KEND)); DZCELL(KLO_CELL-1:KHI_CELL+1)= M%DZ(KLO_CELL-1:KHI_CELL+1) - DO IGC=2,NGUARD - DZCELL(KLO_CELL-IGC)=DZCELL(KLO_CELL-IGC+1) - DZCELL(KHI_CELL+IGC)=DZCELL(KHI_CELL+IGC-1) - ENDDO - ALLOCATE(DZFACE(KSTR:KEND)); DZFACE(KLO_FACE:KHI_FACE)= M%DZN(KLO_FACE:KHI_FACE) - DO IGC=1,NGUARD - DZFACE(KLO_FACE-IGC)=DZFACE(KLO_FACE-IGC+1) - DZFACE(KHI_FACE+IGC)=DZFACE(KHI_FACE+IGC-1) - ENDDO - ALLOCATE(ZCELL(KSTR:KEND)); ZCELL = 1._EB/GEOMEPS ! Initialize huge. - ZCELL(KLO_CELL-1:KHI_CELL+1) = M%ZC(KLO_CELL-1:KHI_CELL+1) - DO IGC=2,NGUARD - ZCELL(KLO_CELL-IGC)=ZCELL(KLO_CELL-IGC+1)-DZFACE(KLO_FACE-IGC+1) - ZCELL(KHI_CELL+IGC)=ZCELL(KHI_CELL+IGC-1)+DZFACE(KHI_FACE+IGC-1) - ENDDO - ALLOCATE(ZFACE(KSTR:KEND)); ZFACE = 1._EB/GEOMEPS ! Initialize huge. - ZFACE(KLO_FACE:KHI_FACE) = M%Z(KLO_FACE:KHI_FACE) - DO IGC=1,NGUARD - ZFACE(KLO_FACE-IGC)=ZFACE(KLO_FACE-IGC+1)-DZCELL(KLO_CELL-IGC) - ZFACE(KHI_FACE+IGC)=ZFACE(KHI_FACE+IGC-1)+DZCELL(KHI_CELL+IGC) - ENDDO + ! IF((NM==1 .AND. I==37 .AND. J==6 .AND. K==32)) THEN + ! LU_DB_SETCC = GET_FILE_NUMBER() + ! WRITE(LU_ERR,*) 'Writing Cartcell_cutfaces.dat...' + ! OPEN(UNIT=LU_DB_SETCC,FILE="./Cartcell_cutfaces.dat", STATUS='REPLACE') + ! ! Info pertaining to the Cartesian Cell: + ! WRITE(LU_DB_SETCC,*) 'I,J,K:',CF%NFACE + ! WRITE(LU_DB_SETCC,*) I,J,K,GEOMEPS + ! WRITE(LU_DB_SETCC,*) 'XC(I),DX(I),YC(J),DY(J),ZC(K),DZ(K):' + ! WRITE(LU_DB_SETCC,*) XCELL(I),DXCELL(I) ! MESHES(NM)%XC(I),MESHES(NM)%DX(I) + ! WRITE(LU_DB_SETCC,*) YCELL(J),DYCELL(J) ! MESHES(NM)%YC(J),MESHES(NM)%DY(J) + ! WRITE(LU_DB_SETCC,*) ZCELL(K),DZCELL(K) ! MESHES(NM)%ZC(K),MESHES(NM)%DZ(K) + ! WRITE(LU_DB_SETCC,*) 'NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT:' + ! WRITE(LU_DB_SETCC,*) NVERT,NSEG,NSEG_FACE,COUNTR,NSEG_LEFT,CF%NFACE + ! WRITE(LU_DB_SETCC,*) 'XYZVERT(IAXIS:KAXIS,1:NVERT):' + ! DO IDUM=1,NVERT + ! WRITE(LU_DB_SETCC,*) IDUM,XYZVERT(IAXIS:KAXIS,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'SEG_CELL(NOD1:NOD2,1:NSEG),SEG_CELL(3:6,1:NSEG),SEG_POS(NSEG):' + ! DO IDUM=1,NSEG + ! WRITE(LU_DB_SETCC,*) IDUM,SEG_CELL(NOD1:NOD2,IDUM),SEG_CELL(3:6,IDUM),SEG_POS(IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'ICF,BOD_TRI:' + ! WRITE(LU_DB_SETCC,*) ICF,NBODTRI + ! DO IDUM=1,NBODTRI + ! WRITE(LU_DB_SETCC,*) BOD_TRI(1:2,IDUM) + ! ENDDO + ! WRITE(LU_DB_SETCC,*) 'CFELEM:' + ! DO IDUM=1,CF%NFACE + ! WRITE(LU_DB_SETCC,*) IDUM,CF%CFELEM(1:CF%CFELEM(1,IDUM)+1,IDUM) + ! ENDDO + ! CLOSE(LU_DB_SETCC) + ! ENDIF + + ! Now add cut-edges product of linearization to CUT_EDGE: + DO ICF = 1, CF%NFACE + IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) + DO ISEG=1,CF%CEDGES(1,ICF) + X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) + IF (ISEG 0 ) THEN + CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCE) + ELSE ! We need a new entry in CUT_EDGE + CEI = MESHES(NM)%N_CUTEDGE_MESH + 1 + MESHES(NM)%N_CUTEDGE_MESH = CEI + MESHES(NM)%CCVAR(I,J,K,CC_IDCE) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + MESHES(NM)%CUT_EDGE(CEI)%NVERT = 0 + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + MESHES(NM)%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ I, J, K, 0, CC_GS /) + MESHES(NM)%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCC + ENDIF + + ! Add vertices, non repeated vertex entries at this point. + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE + ! Define vertices for this segment: + CALL INSERT_FACE_VERT(X1V,NM,CEI,NVERT,INOD1) + CALL INSERT_FACE_VERT(X2V,NM,CEI,NVERT,INOD2) + DO JEC=1,MESHES(NM)%CUT_EDGE(CEI)%NEDGE + IEQ1 = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1,JEC) + IEQ2 = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD2,JEC) + IF((IEQ1==INOD1 .AND. IEQ2==INOD2) .OR. (IEQ1==INOD2 .AND. IEQ2==INOD1)) THEN ! SEG NODES found + EXIT + ENDIF + ENDDO + IF(JEC > MESHES(NM)%CUT_EDGE(CEI)%NEDGE) THEN ! JEC can be NEDGE+1, new cut-edge. + NEDGE = JEC; CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) + MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,NEDGE) = (/ INOD1, INOD2 /) + ENDIF + CF%EDGE_LIST(1:3,IEDGE) = (/CC_ETYPE_CFINB, CEI, JEC /) -ELSE + NCF = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) + IF (NCF==0) THEN + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) = NCF+1 + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(2,JEC) = ITRI + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,JEC) = IBOD + ELSEIF(NCF==1) THEN + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1,JEC) = NCF+1 + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(3,JEC) = ITRI + ENDIF + MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT + MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE - ! Face centered positions and cell sizes: - IF (ALLOCATED(XFACE)) DEALLOCATE(XFACE) - IF (ALLOCATED(YFACE)) DEALLOCATE(YFACE) - IF (ALLOCATED(ZFACE)) DEALLOCATE(ZFACE) - IF (ALLOCATED(DXFACE)) DEALLOCATE(DXFACE) - IF (ALLOCATED(DYFACE)) DEALLOCATE(DYFACE) - IF (ALLOCATED(DZFACE)) DEALLOCATE(DZFACE) + ENDIF + ENDDO + ENDDO - ! Cell centered positions and cell sizes: - IF (ALLOCATED(XCELL)) DEALLOCATE(XCELL) - IF (ALLOCATED(YCELL)) DEALLOCATE(YCELL) - IF (ALLOCATED(ZCELL)) DEALLOCATE(ZCELL) - IF (ALLOCATED(DXCELL)) DEALLOCATE(DXCELL) - IF (ALLOCATED(DYCELL)) DEALLOCATE(DYCELL) - IF (ALLOCATED(DZCELL)) DEALLOCATE(DZCELL) + ! DO ICF = 1, CF%NFACE + ! IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) + ! DO ISEG=1,CF%CEDGES(1,ICF) + ! X1V(IAXIS:KAXIS) = CF%XYZVERT(IAXIS:KAXIS,CF%CFELEM(ISEG+1,ICF)) + ! IF (ISEGGEOMEPS) THEN + ! COUNT = INOD1; INOD1 = INOD2; INOD2 = COUNT + ! ENDIF + ! X1E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD1) + ! X2E(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(IEC)%XYZVERT(IAXIS:KAXIS,INOD2) + ! IF(NORM2(X1E-X1V)>GEOMEPS .OR. NORM2(X2E-X2V)>GEOMEPS) THEN + ! WRITE(LU_ERR,*) 'CARTC CYC CELL Found diff in CFINB SEGMENT=',NCUTFACE,ICF,ISEG,IEC,JEC,CYCLE_CELL + ! WRITE(LU_ERR,*) 'X1,X1V=',X1E(IAXIS:KAXIS),X1V(IAXIS:KAXIS) + ! WRITE(LU_ERR,*) 'X2,X2V=',X2E(IAXIS:KAXIS),X2V(IAXIS:KAXIS) + ! ENDIF + ! ENDDO + ! ENDDO + ! WRITE(LU_ERR,*) 'ERR CELL I,J,K CUT_FACES',I,J,K,CF%NFACE,CT_EDGES + ! DO ICF = 1, CF%NFACE + ! WRITE(LU_ERR,*) CF%CEDGES(1:4,ICF),':',CF%CFELEM(2:4,ICF) + ! ENDDO + ! DO ICF = 1, CT_EDGES + ! WRITE(LU_ERR,*) ICF,CF%EDGE_LIST(1:3,ICF) + ! ENDDO -ENDIF + ENDDO ! I + ENDDO ! J +ENDDO ! K -RETURN -END SUBROUTINE DEFINE_XYZFACE_CELL +IF (.NOT.BNDINT_FLAG) DEALLOCATE(IJK_COUNTED,IJK_COUNTF) +DEALLOCATE(SEG_CELL,SEG_POS) +T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW -SUBROUTINE TAG_CC_BLOCKING_REFINEMENT +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + NCUTFCE = 0 + IF (BNDINT_FLAG) THEN + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) CYCLE + NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE + ENDDO + ELSE + DO ICF=MESHES(NM)%N_CUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + IF (MESHES(NM)%CUT_FACE(ICF)%STATUS /= CC_INBOUNDARY) CYCLE + NCUTFCE = NCUTFCE + MESHES(NM)%CUT_FACE(ICF)%NFACE + ENDDO + ENDIF + WRITE(LU_SETCC,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-faces : ',NCUTFCE,'. ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A,I8,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START, & + ' sec. Cut-faces : ',NCUTFCE,'. ' + ENDIF +ENDIF -LOGICAL, PARAMETER :: DO_RAY_TRACING=.TRUE. -INTEGER :: DUM,II1,JJ1,KK1,IIO1,JJO1,KKO1,IIO2,JJO2,KKO2,IIG,JJG,KKG,IIOG,JJOG,KKOG +RETURN -IF ( DO_RAY_TRACING) THEN +CONTAINS - ! This loop is to block cut-cells on fine side grids for which coarse grid cut-cells have been blocked. - MAIN_MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX +SUBROUTINE REALLOCATE_SEG_CELL - CALL POINT_TO_MESH(NM) - M => MESHES(NM) +IF(NSEG > SIZE_CEELEM_SEG_CELL) THEN + ! First SEG_CELL + ALLOCATE(SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)); SEG_CELL_AUX = CC_UNDEFINED + SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) = & + SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) + DEALLOCATE(SEG_CELL); ALLOCATE(SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)) + SEG_CELL(:,:) = SEG_CELL_AUX(:,:) + ! Then SEG_POS: + SEG_CELL_AUX(1,1:SIZE_CEELEM_SEG_CELL) = SEG_POS(1:SIZE_CEELEM_SEG_CELL) + DEALLOCATE(SEG_POS); ALLOCATE(SEG_POS(1:SIZE_CEELEM_SEG_CELL+DELTA_EDGE)) + SEG_POS(:) = SEG_CELL_AUX(1,:) + SIZE_CEELEM_SEG_CELL = SIZE_CEELEM_SEG_CELL + DELTA_EDGE + DEALLOCATE(SEG_CELL_AUX) +ENDIF - ! Set all fine side cut-cells in cells next to external boundaries which have SOLID coarse mesh faces - ! to CC%NOADVANCE(J)=BLOCKED_REFI_INTER and block them. - EXT_WALL_LOOP_1 : DO IW=1,M%N_EXTERNAL_WALL_CELLS - WC=>WALL(IW) - EWC=>EXTERNAL_WALL(IW) - BC =>BOUNDARY_COORD(WC%BC_INDEX) - IIG = BC%IIG;JJG = BC%JJG;KKG = BC%KKG; - II = BC%II; JJ = BC%JJ; KK = BC%KK; IOR = BC%IOR; X1AXIS=ABS(IOR) - NOM = EWC%NOM; IF(NOM<1 .OR. NOM==NM) CYCLE EXT_WALL_LOOP_1 - M2 => MESHES(NOM) - IIF=II; JJF=JJ; KKF=KK - SELECT CASE(IOR) - CASE(-IAXIS); IIF=IIF-1; - CASE(-JAXIS); JJF=JJF-1; - CASE(-KAXIS); KKF=KKF-1; - END SELECT - IF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)==1) THEN +RETURN +END SUBROUTINE REALLOCATE_SEG_CELL - ! Find if omesh cells under both IIG,JJG,KKG, and II,JJ,KK cells - ! are of type CC_CUTCFE and test if these small size cells have centroids within the SOLID. - IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN - IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN - SELECT CASE(IOR) - CASE( IAXIS); IIOG=IIO+1 - CASE(-IAXIS); IIOG=IIO-1 - CASE( JAXIS); JJOG=JJO+1 - CASE(-JAXIS); JJOG=JJO-1 - CASE( KAXIS); KKOG=KKO+1 - CASE(-KAXIS); KKOG=KKO-1 - END SELECT +END SUBROUTINE GET_CARTCELL_CUTFACES - ! Test for cut/reg-cells in II,JJ,KK, respect to IIO,JJO,KKO, AND IIG,JJG,KKG respect to IIOG,JJOG,KKOG: - DO DUM=1,2 - IF(DUM==1) THEN; II1 = II; JJ1 = JJ; KK1 = KK; IIO1= IIO; JJO1= JJO; KKO1= KKO - ELSE; II1 = IIG; JJ1 = JJG; KK1 = KKG; IIO1=IIOG; JJO1=JJOG; KKO1=KKOG - ENDIF - CALL TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL=.TRUE.) - ENDDO - ! Test for cut/reg-cells in corner respect to OMESH undelying cell if needed: - IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN - IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(KKG>1 .AND. KKG1 .AND. IIG1 .AND. JJG1) THEN +SUBROUTINE GET_CLOSED_POLYLINES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,SEG_POS,IFLG,NPOLY,ILO_POLY,NSG_POLY) - ! If needed, block ghost cells of the other mesh which has finer cells. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - IIOG=IIO; JJOG=JJO; KKOG=KKO; II=BC%II; JJ=BC%JJ; KK=BC%KK; IIG=BC%IIG; JJG=BC%JJG; KKG=BC%KKG - SELECT CASE(IOR) - CASE( IAXIS); IIOG=IIO+1 - CASE(-IAXIS); IIOG=IIO-1 - CASE( JAXIS); JJOG=JJO+1 - CASE(-JAXIS); JJOG=JJO-1 - CASE( KAXIS); KKOG=KKO+1 - CASE(-KAXIS); KKOG=KKO-1 - END SELECT - DO DUM=1,2 - IF(DUM==1) THEN; II1 = II; JJ1 = JJ; KK1 = KK; IIO1= IIO; JJO1= JJO; KKO1= KKO - ELSE; II1 = IIG; JJ1 = JJG; KK1 = KKG; IIO1=IIOG; JJO1=JJOG; KKO1=KKOG - ENDIF - CALL TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL=.FALSE.) - ENDDO +INTEGER, INTENT(IN) :: SIZE_CEELEM_SEG_CELL +INTEGER, INTENT(INOUT) :: NSEG +INTEGER, INTENT(INOUT) :: SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) +INTEGER, INTENT(INOUT) :: SEG_POS(1:SIZE_CEELEM_SEG_CELL) +LOGICAL, INTENT(OUT):: IFLG +INTEGER, INTENT(OUT):: NPOLY,ILO_POLY(1:MAX_CELL_POLYLINES),NSG_POLY(1:MAX_CELL_POLYLINES) - ! Test for OMESH cut/reg-cells in corner respect to this mesh undelying cell if needed: - IIO2=IIO; JJO2=JJO; KKO2=KKO - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(KKOG>1 .AND. KKOG1 .AND. IIOG1 .AND. JJOG MESHES(NM) +DO ISEG=1,NSEG + IF (COUNTED(ISEG)/=0) CYCLE + CISEG = 0 + DO ISEG2=1,NSEG + IF (COUNTED(ISEG2)/=0) CYCLE + IF ( ISEG2==ISEG ) CYCLE + IF ( (SEG_CELL(NOD1,ISEG)==SEG_CELL(NOD1,ISEG2)) .AND. (SEG_CELL(NOD2,ISEG)==SEG_CELL(NOD2,ISEG2)) ) THEN + IF (SEG_CELL(6,ISEG)==BOD(MIBOD)) THEN + ! ISEG should be COUNTED +1; ISEG2 -1. + COUNTED(ISEG) = 1 + COUNTED(ISEG2)=-1 + CISEG = 1 + ELSE + ! ISEG should be COUNTED -1; ISEG2 +1. + COUNTED(ISEG) =-1 + COUNTED(ISEG2)= 1 + CISEG = 1 + ENDIF + ENDIF + ENDDO + IF (CISEG==0) COUNTED(ISEG) = 1 +ENDDO - ! Set all fine side cut-cells in cells next to external boundaries which have SOLID coarse mesh faces - ! to CC%NOADVANCE(J)=BLOCKED_REFI_INTER and block them. - EXT_WALL_LOOP : DO IW=1,M%N_EXTERNAL_WALL_CELLS - WC=>WALL(IW); IF (WC%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY) CYCLE EXT_WALL_LOOP - EWC=>EXTERNAL_WALL(IW) - BC =>BOUNDARY_COORD(WC%BC_INDEX) - II = BC%II; JJ = BC%JJ; KK = BC%KK; IOR = BC%IOR; X1AXIS=ABS(IOR) - NOM = EWC%NOM - M2 => MESHES(NOM) - IIF=II; JJF=JJ; KKF=KK - SELECT CASE(IOR) - CASE(-IAXIS); IIF=IIF-1; - CASE(-JAXIS); JJF=JJF-1; - CASE(-KAXIS); KKF=KKF-1; - END SELECT - IF (EWC%AREA_RATIO<0.9_EB) THEN +NEWSEG = 0 +DO ISEG=1,NSEG + IF (COUNTED(ISEG)/=1) CYCLE + NEWSEG = NEWSEG + 1 + SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) + SEG_POS2(NEWSEG) = SEG_POS(ISEG) +ENDDO +NSEG = NEWSEG +SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:NSEG) = SEG_CELL2(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:NSEG) +SEG_POS(1:NSEG) = SEG_POS2(1:NSEG) - ! Check if other mesh boundary face set to SOLID and current mesh face set to .NOT.SOLID: - IIOF=EWC%IIO_MIN; JJOF=EWC%JJO_MIN; KKOF=EWC%KKO_MIN; LOHIF=HIGH_IND - SELECT CASE(IOR) - CASE(-IAXIS); IIOF=IIOF-1; LOHIF=LOW_IND - CASE(-JAXIS); JJOF=JJOF-1; LOHIF=LOW_IND - CASE(-KAXIS); KKOF=KKOF-1; LOHIF=LOW_IND - END SELECT - IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) CYCLE EXT_WALL_LOOP ! No need to do anything. - IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_SOLID) THEN ! Coarse side face is solid. - ! Set II,JJ,KK fine cells next to this EWC for blocking. - IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell in this location, set to Block. - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II)*M%DY(JJ)*M%DZ(KK) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II),M%YC(JJ),M%ZC(KK) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = BLOCKED_REFI_INTER - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_FGSC,AX) == & - CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NM,II,JJ,KK,ICC); M => MESHES(NM) - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) - ELSEIF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_CUTCFE) THEN - ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. - ICC=M%CCVAR(II,JJ,KK,CC_IDCC); CC=> M%CUT_CELL(ICC) - JCC_LOOP_1 : DO JCC=1,CC%NCELL - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE = CC%CCELEM(IFC,JCC) - IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & - CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN - IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER - CYCLE JCC_LOOP_1 - ENDIF - ENDDO - ENDDO JCC_LOOP_1 - ENDIF - !ELSEIF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_CUTCFE) THEN - ! Coarse side is a cut-face in the boundary. - ENDIF - ELSEIF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)>1) THEN +! Now make closed polylines: +SEG_CELL2 = 0; SEG_POS2 =0; COUNTED = 0; +NPOLY = 0; ILO_POLY = 0; NSG_POLY = 0; SEG_POLY = 0; ! Polyline number for the segment. +SEG_LEFT = NSEG +DO ! This exterior while loop defined closed polylines in the cell. + ! Count one more polyline: + NPOLY = NPOLY + 1 + IF (NPOLY==1) THEN + ILO_POLY(NPOLY) = 0 + ELSE + ILO_POLY(NPOLY) = ILO_POLY(NPOLY-1) + NSG_POLY(NPOLY-1) + ENDIF - IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) THEN ! Coarse side face is solid. - ! If needed, block ghost cells of the other mesh which has finer cells. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - IIOF=IIO; JJOF=JJO; KKOF=KKO; IOGC=IIO; JOGC=JJO; KOGC=KKO; LOHIF=LOW_IND - SELECT CASE(IOR) - CASE( IAXIS); IOGC=IOGC+1; - CASE(-IAXIS); IIOF= IIO-1; LOHIF=HIGH_IND - CASE( JAXIS); JOGC=JOGC+1; - CASE(-JAXIS); JJOF= JJO-1; LOHIF=HIGH_IND - CASE( KAXIS); KOGC=KOGC+1; - CASE(-KAXIS); KKOF= KKO-1; LOHIF=HIGH_IND - END SELECT - IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_SOLID) CYCLE ! No need to do anything. + ! Find first segment of next polyline: + FOUNDSEG = .FALSE. + DO ISEG=1,NSEG + IF (COUNTED(ISEG) == 0) THEN + FOUNDSEG = .TRUE. + EXIT + ENDIF + ENDDO + IF (.NOT.FOUNDSEG) EXIT ! Escape if there are no new segments. - ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking. - IF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell in this location, set to Block. - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M2%DX(IOGC)*M2%DY(JOGC)*M2%DZ(KOGC) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M2%XC(IOGC),M2%YC(JOGC),M2%ZC(KOGC) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = BLOCKED_REFI_INTER - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND; ICFC=& - M2%FCVAR(IOGC+ADDI(SIDE,AX),JOGC+ADDJ(SIDE,AX),KOGC+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF( & - M2%FCVAR(IOGC+ADDI(SIDE,AX),JOGC+ADDJ(SIDE,AX),KOGC+ADDK(SIDE,AX),CC_FGSC,AX)& - == CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NOM,IOGC,JOGC,KOGC,ICC); M2 => MESHES(NOM) - CALL NEW_CELL_ALLOC(NOM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M2%CUT_CELL(ICC)%NCELL = NCELL - M2%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M2%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M2%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M2%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M2%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M2%CUT_CELL(ICC)%NOADVANCE) - ELSEIF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_CUTCFE) THEN - ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. - ICC=M2%CCVAR(IOGC,JOGC,KOGC,CC_IDCC); CC=> M2%CUT_CELL(ICC) - JCC_LOOP_3 : DO JCC=1,CC%NCELL - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE = CC%CCELEM(IFC,JCC) - IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & - CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN - IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER - CYCLE JCC_LOOP_3 - ENDIF - ENDDO - ENDDO JCC_LOOP_3 - ENDIF - ENDDO - ENDDO - ENDDO - !ELSEIF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_CUTCFE) THEN - ! Coarse side is a cut-face in the boundary. - ENDIF + ! Create new closed polyline: + NEWSEG = ILO_POLY(NPOLY) + 1 + SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) + SEG_POS2(NEWSEG) = SEG_POS(ISEG) + COUNTED(ISEG) = 1 + STNOD = SEG_CELL2(NOD1,NEWSEG) + PIVNOD = SEG_CELL2(NOD2,NEWSEG) ! Pivot Vertex, used to find next segment. + NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 + SEG_POLY(NEWSEG) = NPOLY + SEG_LEFT = SEG_LEFT - 1 + DO NEWSEG = ILO_POLY(NPOLY)+2,NSEG + FOUNDSEG = .FALSE. + DO ISEG=1,NSEG + IF (COUNTED(ISEG) > 0) CYCLE + IF (SEG_CELL(NOD1,ISEG)==PIVNOD) THEN ! Found the next segment + FOUNDSEG = .TRUE. + SEG_CELL2(:,NEWSEG) = SEG_CELL(:,ISEG) + SEG_POS2(NEWSEG) = SEG_POS(ISEG) + COUNTED(ISEG) = 1 + PIVNOD = SEG_CELL2(NOD2,NEWSEG); ! Pivot Vertex, used to find next segment. + NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 + SEG_POLY(NEWSEG) = NPOLY; + SEG_LEFT = SEG_LEFT - 1 + EXIT + ELSEIF (SEG_CELL(NOD2,ISEG)==PIVNOD) THEN ! Found the next segment + FOUNDSEG = .TRUE. + SEG_CELL2(:,NEWSEG) = (/ SEG_CELL(NOD2,ISEG), SEG_CELL(NOD1,ISEG), SEG_CELL(3:9,ISEG) /) + SEG_POS2(NEWSEG) = SEG_POS(ISEG) + COUNTED(ISEG) = 1 + PIVNOD = SEG_CELL2(NOD2,NEWSEG) ! Pivot Vertex, used to find next segment. + NSG_POLY(NPOLY) = NSG_POLY(NPOLY) + 1 + SEG_POLY(NEWSEG) = NPOLY + SEG_LEFT = SEG_LEFT - 1 + EXIT ENDIF - ENDDO EXT_WALL_LOOP - ENDDO MAIN_MESH_LOOP_2 + ENDDO + ! Check if for this NEWSEG we didn't find an ISEG: + IF (.NOT.FOUNDSEG) EXIT + ENDDO + ! Finally, test if polyline is closed: + IF ( SEG_CELL2(NOD2,ILO_POLY(NPOLY)+NSG_POLY(NPOLY)) /= STNOD ) RETURN + + ! End of new polyline creation. + ! Here if we have less that 3 segments not counted exit while loop. + IF (SEG_LEFT < 3) EXIT +ENDDO + +! Per polyline, move last SEG if SEG-1 is different body number: +DO IPOLY=1,NPOLY + FOUND_CHG=.FALSE. + ILO =ILO_POLY(IPOLY)+1 + IHI =ILO_POLY(IPOLY)+NSG_POLY(IPOLY) + CT =0 + DO ISEG=ILO,IHI-1 + CT=CT+1 + IF (SEG_CELL2(6,ISEG) /= SEG_CELL2(6,ISEG+1)) THEN + FOUND_CHG=.TRUE. + EXIT + ENDIF + ENDDO + IF (FOUND_CHG) THEN + SEG_CELL(:,ILO:IHI-CT) = SEG_CELL2(:,ISEG+1:IHI) + SEG_POS(ILO:IHI-CT) = SEG_POS2(ISEG+1:IHI) + SEG_CELL(:,IHI-CT+1:IHI) = SEG_CELL2(:,ILO:ISEG) + SEG_POS(IHI-CT+1:IHI) = SEG_POS2(ILO:ISEG) + ELSE + SEG_CELL(:,ILO:IHI) = SEG_CELL2(:,ILO:IHI) + SEG_POS(ILO:IHI) = SEG_POS2(ILO:IHI) + ENDIF +ENDDO + +! Finally cycle segments to redefine polylines (case of two or more polys +! sharing one point. +STNOD=SEG_CELL(NOD1,1) +NPOLY=1; COUNT=1 +DO ISEG=2,NSEG + COUNT=COUNT+1 + SEG_POLY(ISEG)=NPOLY + IF (SEG_CELL(NOD2,ISEG)==STNOD) THEN + NSG_POLY(NPOLY) = COUNT + IF (ISEG==NSEG) EXIT + NPOLY=NPOLY+1 + ILO_POLY(NPOLY) = ILO_POLY(NPOLY-1) + NSG_POLY(NPOLY-1) + COUNT=0; STNOD=SEG_CELL(NOD1,ISEG+1) + ENDIF +ENDDO + +DEALLOCATE(SEG_CELL2,SEG_POS2,COUNTED,BOD,SEG_POLY) + +IFLG=.FALSE. -ENDIF RETURN -END SUBROUTINE TAG_CC_BLOCKING_REFINEMENT +END SUBROUTINE GET_CLOSED_POLYLINES -SUBROUTINE TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL) -INTEGER, INTENT(IN) :: NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1 -LOGICAL, INTENT(IN) :: FINE_CELL -TYPE(MESH_TYPE), POINTER :: M,M2 -M =>MESHES( NM) -M2=>MESHES(NOM) +! --------------------------- EAR_CLIP_CFACES ----------------------------------- -IF (FINE_CELL) THEN +SUBROUTINE EAR_CLIP_CFACES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,XYZVERT,& + INDIF,INDJF,INDKF,NPOLY,ILO_POLY,NSG_POLY,NFACE,& + CFELEM,BOD_TRI,CEDGES,SEG_CELL_AUX,COUNT_CEDGE) - ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC); ICC = 0 - IF ( ICC2 > 0 .OR. M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN ! There are cut-cells in omesh cartesian cell. - IF(M%CCVAR(II1,JJ1,KK1,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell is this location: - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II1)*M%DY(JJ1)*M%DZ(KK1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II1),M%YC(JJ1),M%ZC(KK1) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) NOADVANCE(1) = BLOCKED_REFI_INTER - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_FGSC,AX) == & - CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 +INTEGER, INTENT(IN) :: SIZE_CEELEM_SEG_CELL +INTEGER, INTENT(IN) :: NSEG, INDIF, INDJF, INDKF, NPOLY +INTEGER, INTENT(IN) :: ILO_POLY(1:MAX_CELL_POLYLINES),NSG_POLY(1:MAX_CELL_POLYLINES) +INTEGER, INTENT(IN) :: SEG_CELL(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:SIZE_CEELEM_SEG_CELL) +REAL(EB),INTENT(IN) :: XYZVERT(IAXIS:KAXIS,1:CC_MAXVERTS_FACE) +INTEGER, INTENT(OUT):: NFACE,CFELEM(4,3*NSEG),BOD_TRI(1:2,1:CC_MAXCFELEM_FACE),CEDGES(4,3*NSEG) +INTEGER, INTENT(INOUT) :: SEG_CELL_AUX(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:3*NSEG) +INTEGER, INTENT(OUT):: COUNT_CEDGE + +! Local Variables: +REAL(EB) :: DV(IAXIS:KAXIS), NP(IAXIS:KAXIS), XP(IAXIS:KAXIS) +REAL(EB), ALLOCATABLE, DIMENSION(:) :: LEN_SEG +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: N +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL2 +LOGICAL :: SEG_FLAG(1:MAX_CELL_POLYLINES), FOUND_ISEG1, IS_SOLID, TWOTRI +INTEGER :: ILO, IHI, NSGP, LEFT_SEGS, COUNTEXT, COUNT, BOD, TRI, ISEG, ISEG1, IPOLY, XAXIS, IFACE +INTEGER :: CONN(1:3),CONN2(1:6) + +ALLOCATE(LEN_SEG(1:3*NSEG)); LEN_SEG = 0._EB +ALLOCATE(N(IAXIS:KAXIS,1:3*NSEG)); N = 0._EB +ALLOCATE(SEG_CELL2(1:NOD2+CC_MAX_WSTRIANG_SEG+5,1:3*NSEG)); SEG_CELL2 = 0 +COUNT_CEDGE = 0 + +! Compute segments director unit vectors and normals: +!DO ISEG=1,NSEG +! DV = XYZVERT(IAXIS:KAXIS,SEG_CELL(NOD2,ISEG)) - XYZVERT(IAXIS:KAXIS,SEG_CELL(NOD1,ISEG)) +! LEN_SEG(ISEG) = NORM2(DV) +! N(IAXIS:KAXIS,ISEG) = 1._EB/LEN_SEG(ISEG) * DV +!ENDDO + +! First sweep across segments defining triangles for all consecutive segments with same triangle and body: +NFACE = 0 +! Ear clipping algorithm by polyline: +DO IPOLY=1,NPOLY + ILO = ILO_POLY(IPOLY)+1 + NSGP = NSG_POLY(IPOLY) + IHI = ILO_POLY(IPOLY)+NSGP + SEG_CELL2(:,1:NSGP) = SEG_CELL(:,ILO:IHI) + DO ISEG=1,NSGP ! Compute segments director unit vectors and normals + DV = XYZVERT(IAXIS:KAXIS,SEG_CELL2(NOD2,ISEG)) - XYZVERT(IAXIS:KAXIS,SEG_CELL2(NOD1,ISEG)) + LEN_SEG(ISEG) = NORM2(DV) + N(IAXIS:KAXIS,ISEG) = 1._EB/LEN_SEG(ISEG) * DV + ENDDO + SEG_CELL_AUX(:,COUNT_CEDGE+1:COUNT_CEDGE+NSGP) = SEG_CELL(:,ILO:IHI) + COUNT_CEDGE = COUNT_CEDGE + NSGP + SEG_FLAG(1:NSGP) = .FALSE. + LEFT_SEGS = NSGP + DO COUNTEXT=1,3 ! Search segmets first that belong to same triangle (1), + ! second that belong to same body (2), third all the rest. + DO COUNT=1,2 ! Search first last uncounted segment (1), second the rest. + IF (LEFT_SEGS < 3) EXIT ! should break out of COUNTEXT loop. + IF (COUNT==1) THEN + ISEG = NSGP-1 + DO ISEG1=1,NSGP + IF (.NOT.SEG_FLAG(ISEG1)) EXIT + ENDDO + ELSE + ISEG = 0 + ENDIF + DO WHILE (ISEG < NSGP) + ISEG = ISEG + 1 + IF (SEG_FLAG(ISEG)) CYCLE + FOUND_ISEG1 =.FALSE. + IF (COUNT==1) THEN + IF (.NOT.SEG_FLAG(ISEG1)) FOUND_ISEG1 =.TRUE. + ELSE + DO ISEG1=ISEG+1,NSGP + IF (.NOT.SEG_FLAG(ISEG1)) THEN + FOUND_ISEG1 =.TRUE. + EXIT + ENDIF + ENDDO + ENDIF + IF(.NOT.FOUND_ISEG1) CYCLE + + TRI = 0 + ! Test if triangle given by ISEG ISEG+1 DIAG is valid. + ! First, drop if Body not the same: + IF ( (COUNTEXT<3) .AND. (SEG_CELL2(6,ISEG)/=SEG_CELL2(6,ISEG1)) ) CYCLE + + ! Second, drop if segments are on the same line: + IF (ABS(ABS(DOT_PRODUCT(N(IAXIS:KAXIS,ISEG),N(IAXIS:KAXIS,ISEG1)))-1._EB) < 1.e-12_EB) CYCLE + + ! Now drop if triangles don't match: + TWOTRI = .FALSE. + IF (COUNTEXT<3) THEN + IF( (SEG_CELL2(4,ISEG)/=0) .AND. (SEG_CELL2(4,ISEG)==SEG_CELL2(4,ISEG1) .OR. & + SEG_CELL2(4,ISEG)==SEG_CELL2(5,ISEG1)) ) THEN + TWOTRI = .TRUE. + TRI = SEG_CELL2(4,ISEG) + BOD = SEG_CELL2(6,ISEG) + ELSEIF ( (SEG_CELL2(5,ISEG)/=0) .AND. (SEG_CELL2(5,ISEG)==SEG_CELL2(4,ISEG1) .OR. & + SEG_CELL2(5,ISEG)==SEG_CELL2(5,ISEG1)) ) THEN + TWOTRI = .TRUE. + TRI = SEG_CELL2(5,ISEG) + BOD = SEG_CELL2(6,ISEG) + ENDIF + ENDIF + IF ( (COUNTEXT/=1) .AND. (TRI==0) ) THEN + ! Define TRI as the longest seg one: + IF ( LEN_SEG(ISEG) >= LEN_SEG(ISEG1) ) THEN + TRI = SEG_CELL2(4,ISEG) + BOD = SEG_CELL2(6,ISEG) + ELSE + TRI = SEG_CELL2(4,ISEG1) + BOD = SEG_CELL2(6,ISEG1) + ENDIF + ENDIF + + IF ( TRI == 0 ) THEN + CYCLE + ELSE ! Found two segments with matching triangle. + + ! Test that triangle found is not internal to GEOMs: + CONN(1:3) = (/ SEG_CELL2(1:2,ISEG), SEG_CELL2(2,ISEG1) /) + IF (TWOTRI) THEN + NP(IAXIS:KAXIS)=GEOMETRY(BOD)%FACES_NORMAL(IAXIS:KAXIS,TRI) + XP(IAXIS:KAXIS)=1._EB/3._EB*(XYZVERT(IAXIS:KAXIS,CONN(NOD1)) + & + XYZVERT(IAXIS:KAXIS,CONN(NOD2)) + & + XYZVERT(IAXIS:KAXIS,CONN(NOD3))) + 10._EB*GEOMEPS*NP(IAXIS:KAXIS) + XAXIS = MAXLOC(ABS(NP(IAXIS:KAXIS)),DIM=1) + CALL GET_IS_SOLID_3D(XAXIS,XP,INDIF,INDJF,INDKF,IS_SOLID) + IF (IS_SOLID) CYCLE + ENDIF + + NFACE = NFACE + 1 + CFELEM(1:4,NFACE) = (/ 3, CONN(1:3) /) + BOD_TRI(1:2,NFACE) = (/ BOD, TRI /) + SEG_CELL2(1:6,ISEG) = (/ SEG_CELL2(1,ISEG), SEG_CELL2(2,ISEG1), 1, TRI, 0, BOD /) + SEG_CELL_AUX(1:6,COUNT_CEDGE+1) = SEG_CELL2(1:6,ISEG) + COUNT_CEDGE = COUNT_CEDGE + 1 + DV = XYZVERT(IAXIS:KAXIS,SEG_CELL2(2,ISEG))-XYZVERT(IAXIS:KAXIS,SEG_CELL2(1,ISEG)) + LEN_SEG(ISEG) = NORM2(DV) + IF(LEN_SEG(ISEG) < GEOMEPS) CYCLE + N(IAXIS:KAXIS,ISEG) = 1._EB/LEN_SEG(ISEG) * DV + + ! Erase Segment ISEG1: + SEG_CELL2(:,ISEG1) = 0 + SEG_FLAG(ISEG1) = .TRUE. + N(IAXIS:KAXIS,ISEG1)= 0._EB + LEFT_SEGS = LEFT_SEGS - 1 + IF (COUNT/=1) ISEG = ISEG - 1 ENDIF ENDDO ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NM,II1,JJ1,KK1,ICC); M => MESHES(NM) - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) - ELSEIF(M%CCVAR(II1,JJ1,KK1,CC_IDCC)>0) THEN - ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC) - ENDIF - ! Here Test if cut-cells in II,KK,KK are blocked or not in IIO,JJO,KKO: - IF(ICC>0) THEN - IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN - WHERE(M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL)==NOT_BLOCKED) & - M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL) = BLOCKED_REFI_INTER - ELSE; CALL TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) - ENDIF - ENDIF - ENDIF - -ELSE + ENDDO +ENDDO +DEALLOCATE(LEN_SEG,N,SEG_CELL2) - ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC); ICC2 = 0 - IF(ICC>0) THEN - ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking. - IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell in this location, set to Block. - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M2%DX(IIO1)*M2%DY(JJO1)*M2%DZ(KKO1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M2%XC(IIO1),M2%YC(JJO1),M2%ZC(KKO1) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND; ICFC=& - M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF( & - M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_FGSC,AX)& - == CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 +! Finally define CEDGES: +CEDGES(1,1:NFACE) = 3 +DO IFACE=1,NFACE + CONN2(1:6) = (/ CFELEM(2:3,IFACE), CFELEM(3:4,IFACE), CFELEM(2,IFACE), CFELEM(4,IFACE) /) + DO ISEG=1,3 + CONN(1:2) = CONN2(2*ISEG-1:2*ISEG) + DO ISEG1=1,COUNT_CEDGE + IF(SEG_CELL_AUX(1,ISEG1)==CONN(1) .AND. SEG_CELL_AUX(2,ISEG1)==CONN(2)) THEN + CEDGES(ISEG+1,IFACE) = ISEG1 + EXIT ENDIF - ENDDO ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NOM,IIO1,JJO1,KKO1,ICC2); M2 => MESHES(NOM) - CALL NEW_CELL_ALLOC(NOM,ICC2,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M2%CUT_CELL(ICC2)%NCELL = NCELL - M2%CUT_CELL(ICC2)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M2%CUT_CELL(ICC2)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M2%CUT_CELL(ICC2)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M2%CUT_CELL(ICC2)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M2%CUT_CELL(ICC2)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M2%CUT_CELL(ICC2)%NOADVANCE) - ELSEIF(M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC)>0) THEN - ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC) - ENDIF - ! Here Test if cut-cells in IIO,JJO,KKO are blocked or not in II,JJ,KK: - IF(ICC2>0) CALL TEST_CC_FOR_BLOCKING(NOM,ICC2,NM,II1,JJ1,KK1,ICC) - ENDIF + ENDDO +ENDDO -ENDIF +RETURN +END SUBROUTINE EAR_CLIP_CFACES -END SUBROUTINE TAG_BLOCK_CELL +! ----------------------- GET_CARTCELL_CUTCELLS --------------------------------- -SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) +SUBROUTINE GET_CARTCELL_CUTCELLS(NM) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2 +! Local Variables: +INTEGER :: I, II, J, JJ, K, ILO, IHI, JLO, JHI, KLO, KHI +INTEGER, DIMENSION(LOW_IND:HIGH_IND,IAXIS:KAXIS) :: FSID_XYZ, IDCF_XYZ +INTEGER :: NVERT_CELL, NSEG_CELL, NFACE_CELL, NCELL +INTEGER :: IED, JED, KED, MYAXIS, SIDE +REAL(EB), DIMENSION(IAXIS:KAXIS,NOD1:NOD4,LOW_IND:HIGH_IND) :: XYZLH +REAL(EB) :: AREAI, AREAVARSI(1:MAX_DIM+1,LOW_IND:HIGH_IND), FCT, XYZ(IAXIS:KAXIS), XYZC(IAXIS:KAXIS) +INTEGER :: CEI_AXIS(LOW_IND:HIGH_IND) +INTEGER :: IP, NP, ICF, CEI, INOD, FNOD +REAL(EB), DIMENSION(IAXIS:KAXIS,1:CC_MAXVERTS_CELL) :: XYZVERT -INTEGER :: JCC,FC_FOUND,FC_TYPE,INBFC,INBFC_LOC,VERT_CUTFACE,NVERT,X1AXIS,X2AXIS,X3AXIS,NCROSS,DIRRAY,IFC1,JFC1,& - NVERT2,VERT_CUTFACE2,IV,IFCC,IFACE2,IFC2,JFC2 -TYPE(MESH_TYPE), POINTER :: M,M2 -TYPE(CC_CUTCELL_TYPE), POINTER :: CC,CC2 -TYPE(CC_CUTFACE_TYPE), POINTER :: CF2 -INTEGER, PARAMETER :: EAST=1,WEST=2,FRONT=3,BACK=4,SOUTH=5,NORTH=6 -INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM,CFELEM2 -REAL(EB),ALLOCATABLE, DIMENSION(:,:):: XYZVERTIJK,XYZVERTSTN -REAL(EB):: XYZCEN(MAX_DIM),NVEC(MAX_DIM),P0(MAX_DIM),A,B,C,D,XYZ_P(MAX_DIM),PTCEN(IAXIS:JAXIS),X1F,XC2(MAX_DIM),XC3(MAX_DIM),& - XLO,XHI,YLO,YHI,ZLO,ZHI,XLO2,XHI2,YLO2,YHI2,ZLO2,ZHI2,CFCEN(MAX_DIM),XYZC(MAX_DIM,1),N(MAX_DIM,1),S(MAX_DIM,1),& - T(MAX_DIM,1),TBN(MAX_DIM,MAX_DIM),XYZCSTN(MAX_DIM,1),NN(MAX_DIM,1),XN_CEN,XN_INT,XYZC2(IAXIS:KAXIS,1) -REAL(EB), PARAMETER :: SCALE_FCT=1.E-4_EB -LOGICAL :: IN_CFACE,BLOCK_CELL,FGPOINT -! INTEGER :: LU_CCELL -! CHARACTER(50) :: FILENAME +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL,SEG_CELL_AUX,EDGFAC_CELL,EDGFAC_CELL_AUX +INTEGER, SAVE :: SIZE_CEELEM_EDGFAC, SIZE_CFELEM_EDGFAC +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FACEDG_CELL,FACEDG_CELL_AUX +INTEGER, SAVE :: SIZE_CEELEM_FACEDG, SIZE_CFELEM_FACEDG -M =>MESHES( NM) -M2=>MESHES(NOM) +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FACE_CELL,FACE_CELL_AUX +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FACE_LIST,FACE_LIST_AUX,SPCELL_LIST +REAL(EB), ALLOCATABLE, DIMENSION(:,:):: AREAVARS,AREAVARS_AUX +INTEGER, ALLOCATABLE, DIMENSION(:) :: FACECELL_NUM +INTEGER, ALLOCATABLE, DIMENSION(:) :: FACE_CELL_DUM +INTEGER, SAVE :: SIZE_VERTS_FC, SIZE_CFELEM_FC -INBFC=M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCF); IF(INBFC<1) RETURN ! No CC_INBOUNDARY faces in this cartesian cell. +INTEGER, ALLOCATABLE, DIMENSION(:) :: IPTS -CC =>M%CUT_CELL( ICC) -CC2=>M2%CUT_CELL(ICC2) -CF2=>M2%CUT_FACE(INBFC) -VERT_CUTFACE = SIZE(CF2%CFELEM, DIM=1); ALLOCATE(CFELEM(1:VERT_CUTFACE)) -NVERT = SIZE(CF2%XYZVERT,DIM=2) -! For each cut-cell in CC, test if its centroid Xc is in the SOLID region of CC2: -! We do this by finding a direction to a Cartesian face type CC_GASPHASE or CC_SOLID and intersection point XE, -FC_FOUND=0; FC_TYPE=CC_UNDEFINED; DIRRAY=CC_UNDEFINED -! Then counting INBOUNDARY cut-face intersections from XE point to Xc. -SELECT CASE(M2%FCVAR(IIO1-1,JJO1,KKO1,CC_FGSC,IAXIS)) -CASE(CC_GASPHASE) -FC_FOUND=WEST; FC_TYPE =CC_GASPHASE; DIRRAY=IAXIS -IF(IIO1==0) THEN; X1F=M2%X(IIO1)-M2%DX(IIO1); ELSE; X1F=M2%X(IIO1-1); ENDIF -CASE(CC_SOLID ) -FC_FOUND=WEST; FC_TYPE =CC_SOLID; DIRRAY=IAXIS -IF(IIO1==0) THEN; X1F=M2%X(IIO1)-M2%DX(IIO1); ELSE; X1F=M2%X(IIO1-1); ENDIF -END SELECT -IF(FC_FOUND<1) THEN - SELECT CASE(M2%FCVAR(IIO1 ,JJO1,KKO1,CC_FGSC,IAXIS)) - CASE(CC_GASPHASE) - FC_FOUND=EAST; FC_TYPE =CC_GASPHASE; DIRRAY=-IAXIS - IF(IIO1==M2%IBP1) THEN; X1F=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; X1F=M2%X(IIO1); ENDIF - CASE(CC_SOLID ) - FC_FOUND=EAST; FC_TYPE =CC_SOLID; DIRRAY=-IAXIS - IF(IIO1==M2%IBP1) THEN; X1F=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; X1F=M2%X(IIO1); ENDIF - END SELECT -ENDIF -IF(FC_FOUND<1) THEN - SELECT CASE(M2%FCVAR(IIO1,JJO1-1,KKO1,CC_FGSC,JAXIS)) - CASE(CC_GASPHASE) - FC_FOUND=FRONT; FC_TYPE =CC_GASPHASE; DIRRAY=JAXIS - IF(JJO1==0) THEN; X1F=M2%Y(JJO1)-M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1-1); ENDIF - CASE(CC_SOLID ) - FC_FOUND=FRONT; FC_TYPE =CC_SOLID; DIRRAY=JAXIS - IF(JJO1==0) THEN; X1F=M2%Y(JJO1)-M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1-1); ENDIF - END SELECT -ENDIF -IF(FC_FOUND<1) THEN - SELECT CASE(M2%FCVAR(IIO1,JJO1 ,KKO1,CC_FGSC,JAXIS)) - CASE(CC_GASPHASE) - FC_FOUND=BACK; FC_TYPE =CC_GASPHASE; DIRRAY=-JAXIS - IF(JJO1==M2%JBP1) THEN; X1F=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1); ENDIF - CASE(CC_SOLID ) - FC_FOUND=BACK; FC_TYPE =CC_SOLID; DIRRAY=-JAXIS - IF(JJO1==M2%JBP1) THEN; X1F=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; X1F=M2%Y(JJO1); ENDIF - END SELECT -ENDIF -IF(FC_FOUND<1) THEN - SELECT CASE(M2%FCVAR(IIO1,JJO1,KKO1-1,CC_FGSC,KAXIS)) - CASE(CC_GASPHASE) - FC_FOUND=SOUTH; FC_TYPE =CC_GASPHASE; DIRRAY=KAXIS - IF(KKO1==0) THEN; X1F=M2%Z(KKO1)-M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1-1); ENDIF - CASE(CC_SOLID ) - FC_FOUND=SOUTH; FC_TYPE =CC_SOLID; DIRRAY=KAXIS - IF(KKO1==0) THEN; X1F=M2%Z(KKO1)-M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1-1); ENDIF - END SELECT -ENDIF -IF(FC_FOUND<1) THEN - SELECT CASE(M2%FCVAR(IIO1,JJO1,KKO1 ,CC_FGSC,KAXIS)) - CASE(CC_GASPHASE) - FC_FOUND=NORTH; FC_TYPE =CC_GASPHASE; DIRRAY=-KAXIS - IF(KKO1==M2%KBP1) THEN; X1F=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1); ENDIF - CASE(CC_SOLID ) - FC_FOUND=NORTH; FC_TYPE =CC_SOLID; DIRRAY=-KAXIS - IF(KKO1==M2%KBP1) THEN; X1F=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; X1F=M2%Z(KKO1); ENDIF - END SELECT +INTEGER, SAVE :: SIZE_FACE_CCELEM, SIZE_CELL_CCELEM +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOL ! Cut-cell volumes. +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE + +REAL(EB) :: XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND),MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND:HIGH_IND),CELL_DELTA(IAXIS:KAXIS) + +INTEGER :: IFACE, IEDGE, ISEG, SEG(NOD1:NOD2), ICELL, NFACEI, JCC, AX_MIN, AX_OTHERS(2) +LOGICAL :: INLIST, TEST1, TEST2, NEWFACE +INTEGER :: NIEDGE, NEF, LOCSEG, JFACE, KFACE, NFACEK, NUM_FACE, NCUTCELL, NCFACE_CUTCELL +INTEGER :: DFCT, CFELEM(5), CTVAL, CTVAL2, IBOD, ITRI, IDCF, MAXSEG, N_GAS_CFACES, NIBFACE, THRES, NSPCELL_LIST +LOGICAL :: CYCLE_CELL, BLOCK_SLIM_IF + +INTEGER :: IBNDINT +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNT +REAL(EB) :: TNOW + +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +INTEGER :: NCUTCEL + +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_SETCC,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTCELLS for mesh :',NM,' ..' + IF (MY_RANK==0) WRITE(LU_ERR,'(A,I10,A)',advance='no') ' Generating CARTCELL_CUTCELLS for mesh :',NM,' ..' ENDIF -IF(FC_FOUND<1) RETURN ! Here or before we can switch to a point in polygon test whithin JCC_LOOP. +TNOW=CURRENT_TIME() + +! Allocate work arrays for this mesh: +SIZE_CEELEM_EDGFAC = DELTA_EDGE +SIZE_CFELEM_EDGFAC = DELTA_FACE +ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) +ALLOCATE(SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC)) + +SIZE_CEELEM_FACEDG = DELTA_EDGE +SIZE_CFELEM_FACEDG = DELTA_FACE +ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) +ALLOCATE(IPTS(1:SIZE_CEELEM_FACEDG+1)) ! Note that SIZE_CEELEM_FACEDG should be ~= SIZE_VERTS_FC. + ! (we have equal number of vertices and edges for a closed polygon.) + +SIZE_VERTS_FC = DELTA_VERT +SIZE_CFELEM_FC = DELTA_FACE +ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) +ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)) +ALLOCATE(AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC)) +ALLOCATE(FACECELL_NUM(1:SIZE_CFELEM_FC)) +ALLOCATE(FACE_CELL_DUM(1:SIZE_VERTS_FC)) + +SIZE_FACE_CCELEM = DELTA_FACE +SIZE_CELL_CCELEM = DELTA_CELL +ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) +ALLOCATE(NOADVANCE(1:SIZE_CELL_CCELEM),VOL(1:SIZE_CELL_CCELEM),XYZCEN(IAXIS:KAXIS,1:SIZE_CELL_CCELEM)) + +! Definition of cut-cells: +! For each cartesian cell being cut into one or several cut-cells (NCELL), fill +! entries on a MESHES(NM)%CUT_CELL struct. On each local entry ICC: +! - Add number of faces that are boundary of cut-cell. +! MESHES(NM)%CUT_CELL(ICELL)%CCELEM(1:NFACE_CELL+1,ICC), ICC=1,...,MESHES(NM)%CUT_CELL(ICELL)%NCELL +! - Add list of corresponding regular faces, or cut-faces in CUT_FACE: +! + 5 Indexes: +! MESHES(NM)%CUT_CELL(ICELL)%FACES_LIST = [ FACE_TYPE LOW/HIGH AXIS cei icf ] +! where in MESHES(NM)%CUT_FACE(CEI), which icf. +! - Compute Volume properties for each disjoint volume, add an unknown +! number for scalars, pressure, etc. + +IBNDINT_LOOP : DO IBNDINT=LOW_IND,HIGH_IND ! 1 refers to blocks internal cells, 2 refers to block guard cells. -SELECT CASE(ABS(DIRRAY)) -CASE(IAXIS); X1AXIS = IAXIS; X2AXIS = JAXIS; X3AXIS = KAXIS -CASE(JAXIS); X1AXIS = JAXIS; X2AXIS = KAXIS; X3AXIS = IAXIS -CASE(KAXIS); X1AXIS = KAXIS; X2AXIS = IAXIS; X3AXIS = JAXIS +SELECT CASE(IBNDINT) +CASE(LOW_IND) + ALLOCATE(IJK_COUNT(ILO_CELL-NGUARD:IHI_CELL+NGUARD,JLO_CELL-NGUARD:JHI_CELL+NGUARD,KLO_CELL-NGUARD:KHI_CELL+NGUARD)) + IJK_COUNT = .FALSE. + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL +CASE(HIGH_IND) + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD END SELECT -! IF(NM==1 .AND. ICC<30) THEN -! LU_CCELL = 797 -! WRITE(FILENAME,'(A,I6.6,A)') 'FACESBLK_',ICC,'.txt' -! OPEN(UNIT=LU_CCELL,FILE=FILENAME,STATUS='UNKNOWN') -! WRITE(LU_CCELL,*) NVERT,VERT_CUTFACE,X1AXIS,X2AXIS,X3AXIS,CF2%NFACE -! ENDIF +! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: +DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -I=CC%IJK(IAXIS); J=CC%IJK(JAXIS); K=CC%IJK(KAXIS) -IF(I== 0) THEN; XLO=M%X( I)-M%DX( I); ELSE; XLO=M%X(I-1); ENDIF -IF(I==M%IBP1) THEN; XHI=M%X(I-1)+M%DX( I); ELSE; XHI=M%X( I); ENDIF -IF(J== 0) THEN; YLO=M%Y( J)-M%DY( J); ELSE; YLO=M%Y(J-1); ENDIF -IF(J==M%JBP1) THEN; YHI=M%Y(J-1)+M%DY( J); ELSE; YHI=M%Y( J); ENDIF -IF(K== 0) THEN; ZLO=M%Z( K)-M%DZ( K); ELSE; ZLO=M%Z(K-1); ENDIF -IF(K==M%KBP1) THEN; ZHI=M%Z(K-1)+M%DZ( K); ELSE; ZHI=M%Z( K); ENDIF + IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE -IF(IIO1== 0) THEN; XLO2=M2%X( IIO1)-M2%DX(IIO1); ELSE; XLO2=M2%X(IIO1-1); ENDIF -IF(IIO1==M2%IBP1) THEN; XHI2=M2%X(IIO1-1)+M2%DX(IIO1); ELSE; XHI2=M2%X( IIO1); ENDIF -IF(JJO1== 0) THEN; YLO2=M2%Y( JJO1)-M2%DY(JJO1); ELSE; YLO2=M2%Y(JJO1-1); ENDIF -IF(JJO1==M2%JBP1) THEN; YHI2=M2%Y(JJO1-1)+M2%DY(JJO1); ELSE; YHI2=M2%Y( JJO1); ENDIF -IF(KKO1== 0) THEN; ZLO2=M2%Z( KKO1)-M2%DZ(KKO1); ELSE; ZLO2=M2%Z(KKO1-1); ENDIF -IF(KKO1==M2%KBP1) THEN; ZHI2=M2%Z(KKO1-1)+M2%DZ(KKO1); ELSE; ZHI2=M2%Z( KKO1); ENDIF + IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. -IFC1 = M%CCVAR(I,J,K,CC_IDCF) -IF(IFC1>0) THEN - NVERT2 = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) - ALLOCATE(XYZVERTIJK(MAX_DIM,NVERT2)); XYZVERTIJK = M%CUT_FACE(IFC1)%XYZVERT - ALLOCATE(XYZVERTSTN(MAX_DIM,NVERT2)) - VERT_CUTFACE2 = SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1); ALLOCATE(CFELEM2(VERT_CUTFACE2)) -ENDIF -JCC_LOOP : DO JCC=1,CC%NCELL - ! Get point within gas region of cut-cell: - FGPOINT=.FALSE. - IFC_LOOP : DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - IFC1 = CC%FACE_LIST(4,IFACE) - JFC1 = CC%FACE_LIST(5,IFACE) - IF (CC%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE - CFCEN(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) - CFELEM(1:3) = M%CUT_FACE(IFC1)%CFELEM(1:3,JFC1) - XC2(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,CFELEM(2))-CFCEN(IAXIS:KAXIS) - XC3(IAXIS:KAXIS) = M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,CFELEM(3))-CFCEN(IAXIS:KAXIS) - CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) - IF (NORM2(NVEC) XHI-GEOMEPS) CYCLE - IF(XYZC(JAXIS,1) < YLO+GEOMEPS .OR. XYZC(JAXIS,1) > YHI-GEOMEPS) CYCLE - IF(XYZC(KAXIS,1) < ZLO+GEOMEPS .OR. XYZC(KAXIS,1) > ZHI-GEOMEPS) CYCLE - IF(XYZC(IAXIS,1) < XLO2+GEOMEPS .OR. XYZC(IAXIS,1) > XHI2-GEOMEPS) CYCLE - IF(XYZC(JAXIS,1) < YLO2+GEOMEPS .OR. XYZC(JAXIS,1) > YHI2-GEOMEPS) CYCLE - IF(XYZC(KAXIS,1) < ZLO2+GEOMEPS .OR. XYZC(KAXIS,1) > ZHI2-GEOMEPS) CYCLE + ! Local variables: + ! Geometric entities related to the Cartesian cell: + NVERT_CELL = 0 + NSEG_CELL = 0 + NFACE_CELL = 0 + SEG_CELL = CC_UNDEFINED + FACE_CELL = CC_UNDEFINED + FACE_LIST = CC_UNDEFINED + XYZVERT = 0._EB + AREAVARS = 0._EB - ! Build S,T,N transformation matrix: - N(:,1) = -NVEC; S(:,1) = XC2/NORM2(XC2); CALL CROSS_PRODUCT(T(:,1),N(:,1),S(:,1)) - TBN(1,:)= S(:,1); TBN(2,:)= T(:,1); TBN(3,:)= N(:,1) + ! Add Cartesian Regular faces + GASPHASE cut-faces + vertices: + IED = I-1; JED = J-1; KED = K-1 + MYAXIS_LOOP : DO MYAXIS=IAXIS,KAXIS + SELECT CASE(MYAXIS) + CASE(IAXIS) - ! Check that cut-face centroid is within its polygon. - XYZC2(IAXIS:KAXIS,1) = CFCEN(IAXIS:KAXIS); XYZCSTN = MATMUL(TBN,XYZC2) - DO IV = 1,NVERT2; XYZVERTSTN(:,IV) = MATMUL(TBN,XYZVERTIJK(:,IV))-XYZCSTN(:,1); ENDDO - CFELEM2(1:VERT_CUTFACE2) =M%CUT_FACE(IFC1)%CFELEM(1:VERT_CUTFACE2,JFC1) - PTCEN(IAXIS:JAXIS) = 0._EB; CALL POINT_IN_POLYGON(PTCEN,VERT_CUTFACE2,CFELEM2,NVERT2,1,2,XYZVERTSTN,IN_CFACE) - IF(.NOT.IN_CFACE) CYCLE + XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) - ! Run again over all CFACES of the JCC cut-cell (except IFC) and check for other intersections within their polygons: - ! 1. First of all compute XYZCENSTN, allocate XYZVERTSTN and populate it. Compute XYZVERTSTN-XYZCENSTN. - XYZCSTN = MATMUL(TBN,XYZC) - DO IV = 1,NVERT2 - XYZVERTSTN(:,IV) = MATMUL(TBN,XYZVERTIJK(:,IV))-XYZCSTN(:,1) - ENDDO + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) - ! 2. Run over CFACEs, copy CFELEM and find if intersection point in CFACE + point location: - DO IFCC=1,CC%CCELEM(1,JCC) - IF(IFCC==IFC) CYCLE - IFACE2 = CC%CCELEM(IFCC+1,JCC) - IFC2 = CC%FACE_LIST(4,IFACE2) - JFC2 = CC%FACE_LIST(5,IFACE2) - IF (CC%FACE_LIST(1,IFACE2) /= CC_FTYPE_CFINB) CYCLE + AREAI = DYCELL(J) * DZCELL(K) + AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/-XFACE(IED )*AREAI, -XFACE(IED )**2._EB*AREAI, 0._EB, 0._EB /) + AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ XFACE(IED+1)*AREAI, XFACE(IED+1)**2._EB*AREAI, 0._EB, 0._EB /) + CASE(JAXIS) - CFCEN(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZCEN(IAXIS:KAXIS,JFC2) - CFELEM2(1:VERT_CUTFACE2) = M%CUT_FACE(IFC2)%CFELEM(1:VERT_CUTFACE2,JFC2) - XC2(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZVERT(IAXIS:KAXIS,CFELEM2(2))-CFCEN(IAXIS:KAXIS) - XC3(IAXIS:KAXIS) = M%CUT_FACE(IFC2)%XYZVERT(IAXIS:KAXIS,CFELEM2(3))-CFCEN(IAXIS:KAXIS) - CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) - IF (NORM2(NVEC)XN_CEN+GEOMEPS) CYCLE - ! Found an intersection in a face closer to XYZC than original CF centroid, try another point. - CYCLE IFC_LOOP - ENDIF - ENDDO - ! Did not find intersection, XYZC is inside the cut-cell, use as XYZCEN: - FGPOINT=.TRUE. - XYZCEN(IAXIS:KAXIS) = XYZC(IAXIS:KAXIS,1) - EXIT IFC_LOOP - ENDDO IFC_LOOP - ! If point in inside cut-cell not found - fall back to using cut-cell centroid: - IF(.NOT.FGPOINT) XYZCEN(IAXIS:KAXIS) = CC%XYZCEN(IAXIS:KAXIS,JCC) - PTCEN(IAXIS:JAXIS) = XYZCEN( (/ X2AXIS, X3AXIS /) ) + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) - NCROSS=0; - IF(FC_TYPE==CC_SOLID ) BLOCK_CELL=.TRUE. - IF(FC_TYPE==CC_GASPHASE) BLOCK_CELL=.FALSE. - ! Here do ray-tracing from FC_FOUND to centroid location for this cut cell, use point in poly to note the - ! intersections with CC_INBOUNDARY cut-faces: - ! IF(NM==1 .AND. ICC<30) THEN - ! WRITE(LU_CCELL,*) PTCEN(IAXIS:JAXIS) - ! DO I=1,NVERT - ! WRITE(LU_CCELL,*) CF2%XYZVERT(:,I) - ! ENDDO - ! ENDIF - INBFC_LOC_LOOP : DO INBFC_LOC=1,CF2%NFACE - ! Normal, max normal component, define plane X2AXIS,X3AXIS to do search: - CFELEM(1:VERT_CUTFACE) = CF2%CFELEM(1:VERT_CUTFACE,INBFC_LOC) - XC2(IAXIS:KAXIS) = CF2%XYZVERT(IAXIS:KAXIS,CFELEM(2))-CF2%XYZCEN(IAXIS:KAXIS,INBFC_LOC) - XC3(IAXIS:KAXIS) = CF2%XYZVERT(IAXIS:KAXIS,CFELEM(3))-CF2%XYZCEN(IAXIS:KAXIS,INBFC_LOC) - CALL CROSS_PRODUCT(NVEC(IAXIS:KAXIS),XC2(IAXIS:KAXIS),XC3(IAXIS:KAXIS)) + AREAI = DXCELL(I) * DZCELL(K) + AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/ 0._EB, 0._EB, -YFACE(JED )**2._EB*AREAI, 0._EB /) + AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ 0._EB, 0._EB, YFACE(JED+1)**2._EB*AREAI, 0._EB /) + CASE(KAXIS) - IF (NORM2(NVEC)X1F +GEOMEPS) CYCLE INBFC_LOC_LOOP - ELSE - IF(XYZ_P(X1AXIS)XYZCEN(X1AXIS)+GEOMEPS) CYCLE INBFC_LOC_LOOP - ENDIF - NCROSS = NCROSS + 1 ! Add crossing between face and cut-cell centroid. - BLOCK_CELL=.NOT.BLOCK_CELL - ENDIF - ! IF(NM==1 .AND. ICC<30) THEN - ! IF(MY_RANK==0) WRITE(0,*) 'TESTS INBFC_LOC_LOOP',INBFC_LOC,PTCEN(IAXIS:JAXIS),XYZCEN(X1AXIS),XYZ_P(X1AXIS),& - ! NVEC(2),D,IN_CFACE,BLOCK_CELL - ! ENDIF - ENDDO INBFC_LOC_LOOP - ! Here set no ADVANCE if BLOCK_CELL=T: - IF(BLOCK_CELL .AND. CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC) = BLOCKED_REFI_INTER -ENDDO JCC_LOOP + XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) -! IF(NM==1 .AND. ICC<30) CLOSE(LU_CCELL) + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND)= (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND)= (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND)= (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + + AREAI = DXCELL(I) * DYCELL(J) + AREAVARSI(1:MAX_DIM+1,LOW_IND) =(/ 0._EB, 0._EB, 0._EB, -ZFACE(KED )**2._EB*AREAI /) + AREAVARSI(1:MAX_DIM+1,HIGH_IND)=(/ 0._EB, 0._EB, 0._EB, ZFACE(KED+1)**2._EB*AREAI /) + END SELECT + + CEI_AXIS(LOW_IND:HIGH_IND) = IDCF_XYZ(LOW_IND:HIGH_IND,MYAXIS) + + DO SIDE=LOW_IND,HIGH_IND + ! Low High face: + IF ( FSID_XYZ(SIDE,MYAXIS) == CC_GASPHASE ) THEN -DEALLOCATE(CFELEM) -IF(ALLOCATED(XYZVERTIJK)) DEALLOCATE(XYZVERTIJK,XYZVERTSTN,CFELEM2) -RETURN -END SUBROUTINE TEST_CC_FOR_BLOCKING + ! Regular Face, build 4 vertices + face: + NP = 0 + NFACE_CELL = NFACE_CELL + 1 -SUBROUTINE GET_CC_FACE_CELL_LIST_INFO(NM,PHASE) + ! Here, reallocate FACE_LIST, AREAVARS, FACE_CELL if NFACE_CELL > SIZE_CFELEM_FC: + ! Also no need to reallocate FACE_CELL vert dimension, as for regular cells vert size = 5. + CALL REALLOCATE_LOCAL_FC_VARS + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_RCGAS, SIDE, MYAXIS, 0, 0, CC_UNDEFINED /) + ! CC_FTYPE_RCGAS=0, regular face. + AREAVARS(1:MAX_DIM+1,NFACE_CELL) = AREAVARSI(1:MAX_DIM+1,SIDE) -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: PHASE + ! Vertices arranged normal out of cartesian cell: + DO IP=NOD1,NOD4 + ! xl,yl,zl + XYZ(IAXIS:KAXIS) = XYZLH(IAXIS:KAXIS,IP,SIDE) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) -! Local Vars: -INTEGER :: ICC,JCC,IFC,IFACE,ICF1,ICF2,JCF,ICE,JCE,IIE,JJE,KKE,IIF,JJF,KKF,X1AXIS,EAXIS,IEDG_LOC,IEDGE -TYPE(MESH_TYPE), POINTER :: M -M=>MESHES(NM) + NP = NP + 1 + FACE_CELL(1,NFACE_CELL) = NP + FACE_CELL(NP+1,NFACE_CELL) = INOD + ENDDO -! FACE-CELL incidence: -CUT_CELL_LOOP : DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC) - IF(PHASE==2) THEN - IF(CC%IJK(IAXIS)<-1 .OR. CC%IJK(IAXIS)>M%IBAR+2) CYCLE CUT_CELL_LOOP - IF(CC%IJK(JAXIS)<-1 .OR. CC%IJK(JAXIS)>M%JBAR+2) CYCLE CUT_CELL_LOOP - IF(CC%IJK(KAXIS)<-1 .OR. CC%IJK(KAXIS)>M%KBAR+2) CYCLE CUT_CELL_LOOP - ENDIF - DO JCC=1,CC%NCELL - ! Loop faces and test: - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - SELECT CASE(CC%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_CFGAS) ! GASPHASE cut-face: - ICF1 = CC%FACE_LIST(4,IFACE) - ICF2 = CC%FACE_LIST(5,IFACE); CF => M%CUT_FACE(ICF1) - IF (CC%FACE_LIST(2,IFACE) == LOW_IND) THEN ! Cut-face on low side of cut-cell: - CF%CELL_LIST(IAXIS:KAXIS+1,HIGH_IND,ICF2) = & - (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) - ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. - CF%XCENHIGH(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) - ELSE ! HIGH - CF%CELL_LIST(IAXIS:KAXIS+1,LOW_IND,ICF2) = & - (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) - ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. - CF%XCENLOW(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) - ENDIF - CASE(CC_FTYPE_CFINB) ! INBOUNDARY cut-face: - ICF1 = CC%FACE_LIST(4,IFACE) - ICF2 = CC%FACE_LIST(5,IFACE); CF => M%CUT_FACE(ICF1) - ! We add the cut-cell related info in LOW_IND - CF%CELL_LIST(IAXIS:KAXIS+1,LOW_IND,ICF2) = & - (/ CC_FTYPE_CFGAS, ICC, JCC, IFC /) - ! Cut-cell CUT_CELL(icc),CCELEM(jcc,:) is cut vol. - CF%XCENLOW(IAXIS:KAXIS,ICF2) = CC%XYZCEN(IAXIS:KAXIS,JCC) - END SELECT - ENDDO - ENDDO -ENDDO CUT_CELL_LOOP + ELSEIF (FSID_XYZ(SIDE,MYAXIS) == CC_CUTCFE ) THEN -! EDGE-FACE incidence: -! First Allocate DXX and FACE_LIST for CUT_EDGEs: -DO ICE=1,M%N_CUTEDGE_MESH - CE => M%CUT_EDGE(ICE) - IF(ALLOCATED(CE%DXX)) DEALLOCATE(CE%DXX) - IF(ALLOCATED(CE%FACE_LIST)) DEALLOCATE(CE%FACE_LIST) - IF(ALLOCATED(CE%DUIDXJ)) DEALLOCATE(CE%DUIDXJ) - IF(ALLOCATED(CE%MU_DUIDXJ)) DEALLOCATE(CE%MU_DUIDXJ) - ! DXX(1), DXX(2) - ALLOCATE(CE%DXX(1:2,SIZE(CE%CEELEM,DIM=2))); CE%DXX = 0._EB - ! ! ICF JCF, dir -2 -1 1 2, JCE. - ALLOCATE(CE%FACE_LIST(1:3,-2:2,SIZE(CE%CEELEM,DIM=2))); CE%FACE_LIST = CC_UNDEFINED -ENDDO + FCT = REAL(2*SIDE-3,EB) !2*(side-3/2); + ! GasPhase CUT_FACE, add all cut-faces on these Cartesian cell + nodes: + CEI = CEI_AXIS(SIDE) + DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE + NFACE_CELL = NFACE_CELL + 1 + ! Here, reallocate FACE_LIST, AREAVARS, FACE_CELL if NFACE_CELL > SIZE_CFELEM_FC: + CALL REALLOCATE_LOCAL_FC_VARS + ! Also reallocate FACE_CELL vert dimension, if needed. + NP = MESHES(NM)%CUT_FACE(CEI)%CFELEM(1,ICF) + CALL REALLOCATE_FACE_CELL_VERTS -CUTFACE_LOOP : DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CF => M%CUT_FACE(ICF); IF(CF%STATUS/=CC_GASPHASE) CYCLE - IIF= CF%IJK(IAXIS); JJF= CF%IJK(JAXIS); KKF= CF%IJK(KAXIS); X1AXIS= CF%IJK(KAXIS+1) - IF(PHASE==2) THEN - SELECT CASE (X1AXIS) - CASE(IAXIS) - IF(IIF<-2 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP - IF(JJF<-1 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP - IF(KKF<-1 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP - CASE(JAXIS) - IF(IIF<-1 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP - IF(JJF<-2 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP - IF(KKF<-1 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP - CASE(KAXIS) - IF(IIF<-1 .OR. IIF>M%IBAR+2) CYCLE CUTFACE_LOOP - IF(JJF<-1 .OR. JJF>M%JBAR+2) CYCLE CUTFACE_LOOP - IF(KKF<-2 .OR. KKF>M%KBAR+2) CYCLE CUTFACE_LOOP - END SELECT - ENDIF - DO JCF=1,CF%NFACE - DO IEDG_LOC=2,CF%CEDGES(1,JCF)+1 - IEDGE = CF%CEDGES(IEDG_LOC,JCF) - SELECT CASE(CF%EDGE_LIST(1,IEDGE)) - CASE(CC_ETYPE_RGGAS) ! RCEDGE to be defined in .. - ! LOHI = CF%EDGE_LIST(2,IEDGE) - ! AXIS = CF%EDGE_LIST(3,IEDGE) - ! CC_RCEDGE.. Filled once RCEDGES are built. - CASE(CC_ETYPE_CFGAS) ! Gas cut-edge - ICE = CF%EDGE_LIST(2,IEDGE) - JCE = CF%EDGE_LIST(3,IEDGE) - CE => M%CUT_EDGE(ICE) - IIE = CE%IJK(IAXIS); JJE = CE%IJK(JAXIS); KKE = CE%IJK(KAXIS) - EAXIS= CE%IJK(KAXIS+1) - SELECT CASE(EAXIS) - CASE(IAXIS) ! Edge in x dir. - IF(X1AXIS==KAXIS) THEN ! Face in z dir, +/- y. - CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(YFACE(JJE)-CF%XYZCEN(JAXIS,JCF)) - IF(JJF==JJE) THEN ! Face -1, resp to IEDGE. - CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(JJF==JJE+1) THEN - CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) - ENDIF - ELSEIF(X1AXIS==JAXIS) THEN ! Face in y dir, +/- z: - CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(ZFACE(KKE)-CF%XYZCEN(KAXIS,JCF)) - IF(KKF==KKE) THEN ! Face -2, resp to IEDGE. - CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(KKF==KKE+1) THEN - CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) - ENDIF + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFGAS,SIDE,MYAXIS,CEI,ICF,CC_UNDEFINED /) + ! CC_FTYPE_CFGAS=1 + AREAVARS(1:MAX_DIM+1,NFACE_CELL) =(/ MESHES(NM)%CUT_FACE(CEI)%INXAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%INXSQAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%JNYSQAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%KNZSQAREA(ICF) /)*FCT + ! FCT considers Normal out. + FACE_CELL(1,NFACE_CELL) = NP + DO IP=2,NP+1 + FNOD = MESHES(NM)%CUT_FACE(CEI)%CFELEM(IP,ICF) + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_FACE(CEI)%XYZVERT(IAXIS:KAXIS,FNOD) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) + FACE_CELL(IP,NFACE_CELL) = INOD + ENDDO + ENDDO ENDIF - CASE(JAXIS) ! Edge in y dir. - IF(X1AXIS==IAXIS) THEN ! Face in x dir, +/- z. - CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(ZFACE(KKE)-CF%XYZCEN(KAXIS,JCF)) - IF(KKF==KKE) THEN ! Face -1, resp to IEDGE. - CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(KKF==KKE+1) THEN - CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) - ENDIF - ELSEIF(X1AXIS==KAXIS) THEN ! Face in z dir, +/- x - CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(XFACE(IIE)-CF%XYZCEN(IAXIS,JCF)) - IF(IIF==IIE) THEN ! Face -2, resp to IEDGE. - CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(IIF==IIE+1) THEN - CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) + ENDDO + ENDDO MYAXIS_LOOP + + N_GAS_CFACES = NFACE_CELL + + ! Now add INBOUNDARY faces of the cell: + CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) + IF ( CEI > 0 ) THEN + FCT = -1._EB + DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE + NFACE_CELL = NFACE_CELL + 1 + ! Here, reallocate FACE_LIST, AREAVARS, FACE_CELL if NFACE_CELL > SIZE_CFELEM_FC: + CALL REALLOCATE_LOCAL_FC_VARS + ! Also reallocate FACE_CELL, FACE_CELL_DUM vert dimension, if needed. + NP = MESHES(NM)%CUT_FACE(CEI)%CFELEM(1,ICF) + CALL REALLOCATE_FACE_CELL_VERTS + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB, 0, 0, CEI, ICF, CC_UNDEFINED /) + ! CC_FTYPE_CFINB in Cart-cell. + AREAVARS(1:MAX_DIM+1,NFACE_CELL) = (/ MESHES(NM)%CUT_FACE(CEI)%INXAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%INXSQAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%JNYSQAREA(ICF), & + MESHES(NM)%CUT_FACE(CEI)%KNZSQAREA(ICF) /)*FCT + ! Normal out of cut-cell. + FACE_CELL(1,NFACE_CELL) = NP + DO IP=2,NP+1 + FNOD = MESHES(NM)%CUT_FACE(CEI)%CFELEM(IP,ICF) + XYZ(IAXIS:KAXIS) = MESHES(NM)%CUT_FACE(CEI)%XYZVERT(IAXIS:KAXIS,FNOD) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) + FACE_CELL(IP,NFACE_CELL) = INOD + ENDDO + ! At this point the face in face cell is ordered + ! throught the normal outside the body. Reorganize + ! to normal outside cut-cell (inside body). + FACE_CELL_DUM(1:NP+1) = FACE_CELL(1:NP+1,NFACE_CELL) + DO IP=2,NP+1 + FACE_CELL(IP,NFACE_CELL) = FACE_CELL_DUM( (NP+1)+2-IP ) + ENDDO + ENDDO + ENDIF + + ! IF(I==14 .AND. J==2 .AND. K==6) THEN + ! WRITE(LU_ERR,*) 'CC 1 I,J,K,INB NFACE,NFACE_CELL=',I,J,K,& + ! MESHES(NM)%CUT_FACE(CEI)%NFACE,NFACE_CELL + ! OPEN(666,FILE='VERTS.txt',STATUS='REPLACE') + ! DO IP=1,NVERT_CELL + ! WRITE(666,*) XYZVERT(1:3,IP) + ! ENDDO + ! CLOSE(666) + ! IFACE=MAXVAL(FACE_CELL(1,1:NFACE_CELL)) + ! OPEN(666,FILE='FACES.txt',STATUS='REPLACE') + ! DO IP=1,NFACE_CELL + ! WRITE(666,*) FACE_CELL(1:IFACE+1,IP),FACE_LIST(1,IP) + ! ENDDO + ! CLOSE(666) + ! ENDIF + + ! Here we have in XYZvert all the vertices that define the + ! cut-cells within Cartesian cell I,J,K. We have the faces, + ! boundary of said cut-cells in face_cell. + ! We have in face_list the list of cut-cell boundary faces + ! and if they are regular or cut-face. + ! We want to reorder face list, such that we have the + ! subgroups of faces that make cut-cells. + + ! Make list of edges: + EDGFAC_CELL(:,:) = CC_UNDEFINED + FACEDG_CELL(:,:) = CC_UNDEFINED + + ! Here reallocate FACEDG_CELL if NFACE_CELL > SIZE_CFELEM_FACEDG: + IF (NFACE_CELL > SIZE_CFELEM_FACEDG) THEN + DFCT = CEILING(REAL(NFACE_CELL-SIZE_CFELEM_FACEDG,EB)/REAL(DELTA_FACE,EB)) + ALLOCATE(FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG+DFCT*DELTA_FACE)); + FACEDG_CELL_AUX = CC_UNDEFINED + ! Copy data into FACEDG_CELL_AUX: + FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & + FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) + ! New SIZE_CFELEM_FACEDG: + SIZE_CFELEM_FACEDG = SIZE_CFELEM_FACEDG + DFCT*DELTA_FACE + DEALLOCATE(FACEDG_CELL); ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) + ! Dump data back into FACEDG_CELL: + FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & + FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) + DEALLOCATE(FACEDG_CELL_AUX) + ENDIF + + DO IFACE=1,NFACE_CELL + NIEDGE = FACE_CELL(1,IFACE) + + ! Here reallocate if NIEDGE > SIZE_CEELEM_FACEDG: + IF (NIEDGE > SIZE_CEELEM_FACEDG) THEN + DFCT = CEILING(REAL(NIEDGE-SIZE_CEELEM_FACEDG,EB)/REAL(DELTA_EDGE,EB)) + ALLOCATE(FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG+DFCT*DELTA_EDGE,1:SIZE_CFELEM_FACEDG)); + FACEDG_CELL_AUX = CC_UNDEFINED + ! Copy data into FACEDG_CELL_AUX: + FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & + FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) + ! New SIZE_CEELEM_FACEDG: + SIZE_CEELEM_FACEDG = SIZE_CEELEM_FACEDG + DFCT*DELTA_EDGE + DEALLOCATE(FACEDG_CELL); ALLOCATE(FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG)) + ! Dump data back into FACEDG_CELL: + FACEDG_CELL(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) = & + FACEDG_CELL_AUX(1:SIZE_CEELEM_FACEDG,1:SIZE_CFELEM_FACEDG) + DEALLOCATE(FACEDG_CELL_AUX) + DEALLOCATE(IPTS); ALLOCATE(IPTS(1:SIZE_CEELEM_FACEDG+1)) + ENDIF + + IPTS(1:NIEDGE) = FACE_CELL(2:NIEDGE+1,IFACE); IPTS(NIEDGE+1) = FACE_CELL(2,IFACE) + DO IEDGE=1,NIEDGE + SEG(NOD1:NOD2)= (/ IPTS(IEDGE), IPTS(IEDGE+1) /) + INLIST = .FALSE. + DO ISEG=1,NSEG_CELL + TEST1 = (SEG_CELL(NOD1,ISEG) == SEG(NOD1)) .AND. (SEG_CELL(NOD2,ISEG) == SEG(NOD2)) + TEST2 = (SEG_CELL(NOD2,ISEG) == SEG(NOD1)) .AND. (SEG_CELL(NOD1,ISEG) == SEG(NOD2)) + + IF ( TEST1 .OR. TEST2 ) THEN + INLIST = .TRUE. + EXIT ENDIF - ENDIF - CASE(KAXIS) ! Edge in z dir. - IF(X1AXIS==JAXIS) THEN ! Face in y dir, +/- x. - CE%DXX(1,JCE) = CE%DXX(1,JCE) + ABS(XFACE(IIE)-CF%XYZCEN(IAXIS,JCF)) - IF(IIF==IIE) THEN ! Face -1, resp to IEDGE. - CE%FACE_LIST(1:3,-1,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(IIF==IIE+1) THEN - CE%FACE_LIST(1:3, 1,JCE) = (/ICF,JCF,IEDGE/) + enddo + IF (.NOT.INLIST) THEN + NSEG_CELL = NSEG_CELL + 1 + + ! Test the NSEG_CELL doesn't overrun SIZE_CEELEM_EDGFAC, if so reallocate EDGFAC_CELL: + IF(NSEG_CELL > SIZE_CEELEM_EDGFAC) THEN + ! 1. EDGFAC_CELL: + ALLOCATE(EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC+DELTA_EDGE)); + EDGFAC_CELL_AUX = CC_UNDEFINED + ! Copy data into EDGFAC_CELL_AUX: + EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & + EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) + ! 1. SEG_CELL: + ALLOCATE(SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC+DELTA_EDGE)); SEG_CELL_AUX = CC_UNDEFINED + ! Copy data to SEG_CELL_AUX: + SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) = SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) + + ! New SIZE_CEELEM_EDGFAC: + SIZE_CEELEM_EDGFAC = SIZE_CEELEM_EDGFAC + DELTA_EDGE + + ! 2. EDGFAC_CELL: + DEALLOCATE(EDGFAC_CELL); ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) + ! Dump data back into EDGFAC_CELL: + EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & + EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) + DEALLOCATE(EDGFAC_CELL_AUX) + ! 2. SEG_CELL: + DEALLOCATE(SEG_CELL); ALLOCATE(SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC)) + ! Dump data back into SEG_CELL: + SEG_CELL(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) = SEG_CELL_AUX(NOD1:NOD2,1:SIZE_CEELEM_EDGFAC) + DEALLOCATE(SEG_CELL_AUX) ENDIF - ELSEIF(X1AXIS==IAXIS) THEN ! Face in x dir, +/- y. - CE%DXX(2,JCE) = CE%DXX(2,JCE) + ABS(YFACE(JJE)-CF%XYZCEN(JAXIS,JCF)) - IF(JJF==JJE) THEN ! Face -2, resp to IEDGE. - CE%FACE_LIST(1:3,-2,JCE) = (/ICF,JCF,IEDGE/) - ELSEIF(JJF==JJE+1) THEN - CE%FACE_LIST(1:3, 2,JCE) = (/ICF,JCF,IEDGE/) + SEG_CELL(NOD1:NOD2,NSEG_CELL) = SEG(NOD1:NOD2) + NEF = 1 + EDGFAC_CELL(1,NSEG_CELL) = NEF + EDGFAC_CELL(NEF+1,NSEG_CELL)= IFACE + FACEDG_CELL(IEDGE,IFACE) = NSEG_CELL + ELSE + NEF = EDGFAC_CELL(1,ISEG) + 1 + ! Test NEF+1 doesn't overrun SIZE_CFELEM_EDGFAC, if so reallocate EDGFAC_CELL: + IF(NEF+1 > SIZE_CFELEM_EDGFAC) THEN + ALLOCATE(EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC+DELTA_FACE,1:SIZE_CEELEM_EDGFAC)); + EDGFAC_CELL_AUX = CC_UNDEFINED + ! Copy data into EDGFAC_CELL_AUX: + EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & + EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) + ! New SIZE_CFELEM_EDGFAC: + SIZE_CFELEM_EDGFAC = SIZE_CFELEM_EDGFAC + DELTA_FACE + DEALLOCATE(EDGFAC_CELL); ALLOCATE(EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC)) + ! Dump data back into EDGFAC_CELL: + EDGFAC_CELL(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) = & + EDGFAC_CELL_AUX(1:SIZE_CFELEM_EDGFAC,1:SIZE_CEELEM_EDGFAC) + DEALLOCATE(EDGFAC_CELL_AUX) ENDIF + EDGFAC_CELL(1,ISEG) = NEF + EDGFAC_CELL(NEF+1,ISEG) = IFACE + FACEDG_CELL(IEDGE,IFACE) = ISEG ENDIF - END SELECT - - CASE(CC_ETYPE_CFINB) ! Inboundary cut-edge (face) - - END SELECT - ENDDO - ENDDO -ENDDO CUTFACE_LOOP + ENDDO + ENDDO -! Allocate for gas CUT_EDGEs DUIDXJ, MU_DUIDXJ -DO ICE=1,M%N_CUTEDGE_MESH - CE => M%CUT_EDGE(ICE); IF(CE%STATUS/=CC_GASPHASE) CYCLE - IF(.NOT.ALLOCATED(CE%DUIDXJ)) THEN - ALLOCATE(CE%DUIDXJ( -2:2,1:SIZE(CE%CEELEM,DIM=2))); CE%DUIDXJ = 0._EB - ALLOCATE(CE%MU_DUIDXJ(-2:2,1:SIZE(CE%CEELEM,DIM=2))); CE%MU_DUIDXJ = 0._EB - ENDIF - ! Assign DXX to grid size for cut-edges with unassigned deltas: - I=CE%IJK(IAXIS); J=CE%IJK(JAXIS); K=CE%IJK(KAXIS); X1AXIS=CE%IJK(KAXIS+1) - DO JCE=1,CE%NEDGE - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(CE%DXX(1,JCE) SIZE(FACECELL_NUM,DIM=1): + NUM_FACE = SIZE(FACECELL_NUM,DIM=1) + IF (NFACE_CELL > NUM_FACE) THEN + DFCT = CEILING(REAL(NFACE_CELL-NUM_FACE,EB)/REAL(DELTA_FACE,EB)) + DEALLOCATE(FACECELL_NUM); ALLOCATE(FACECELL_NUM(1:NFACE_CELL+DFCT*DELTA_FACE)) + ENDIF -IF(DEBUG_SET_CUTCELLS) THEN + FACECELL_NUM = 0 + ICELL = 1 + IFACE = 1 + NUM_FACE = NFACE_CELL + CTVAL2 = 0 + MAXSEG = MAXVAL(FACE_CELL(1,1:NFACE_CELL)) + THRES = HUGE(1); IF(REAL(MAXSEG*NFACE_CELL,EB)**2M%CUT_FACE(ICF1) - WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE,CF%STATUS - DO ICF2=1,CF%NFACE - WRITE(33,'(I8,3F16.8,F16.8)') ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) - ICC=CF%CELL_LIST(2,LOW_IND,ICF2); JCC=CF%CELL_LIST(3,LOW_IND,ICF2) - WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& - M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) - CC=>M%CUT_CELL(ICC) - IFACE = CC%CCELEM(CF%CELL_LIST(4,LOW_IND,ICF2)+1,JCC) - IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN - WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& - ICF2,CC%FACE_LIST(5,IFACE) - ENDIF + ! Now loop to find new face: + DO ISEG=1,NFACEI + LOCSEG = FACEDG_CELL(ISEG,IFACE) + IF ( EDGFAC_CELL(1,LOCSEG) == 2 ) THEN ! Found a regular edge + DO JJ=2,EDGFAC_CELL(1,LOCSEG)+1 + JFACE = EDGFAC_CELL(JJ,LOCSEG) + ! Drop for same face: + IF ( IFACE == JFACE ) CYCLE + ! Drop if face already counted: + IF ( FACECELL_NUM(JFACE) > 0 ) CYCLE - IF(CF%STATUS==CC_GASPHASE) THEN - ICC=CF%CELL_LIST(2,HIGH_IND,ICF2); JCC=CF%CELL_LIST(3,HIGH_IND,ICF2) - WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& - M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) - CC=>M%CUT_CELL(ICC) - IFACE = CC%CCELEM(CF%CELL_LIST(4,HIGH_IND,ICF2)+1,JCC) - IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN - WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& - ICF2,CC%FACE_LIST(5,IFACE) - ENDIF + ! New face, not counted: + FACECELL_NUM(JFACE) = ICELL + NEWFACE = .TRUE. + NUM_FACE = NUM_FACE-1 + EXIT + ENDDO + ENDIF + IF (NEWFACE) THEN + IFACE = JFACE + EXIT + ENDIF + ENDDO + ! Test for all faces that have regular edges with faces that belong to icell: + IF (.NOT.NEWFACE) THEN + KFACE_LOOP : DO KFACE=1,NFACE_CELL + IF ( FACECELL_NUM(KFACE) == 0 ) THEN ! Not associated yet + NFACEK = FACE_CELL(1,KFACE) + DO ISEG=1,NFACEK + LOCSEG = FACEDG_CELL(ISEG,KFACE) + IF ( EDGFAC_CELL(1,LOCSEG) == 2) THEN ! Found a regular edge + DO JJ=2,EDGFAC_CELL(1,LOCSEG)+1 + JFACE = EDGFAC_CELL(JJ,LOCSEG) + IF ( KFACE == JFACE ) CYCLE + IF ( FACECELL_NUM(JFACE) /= ICELL) CYCLE + ! New face, not counted: + FACECELL_NUM(KFACE) = FACECELL_NUM(JFACE) + NEWFACE = .TRUE. + IFACE = KFACE + NUM_FACE = NUM_FACE-1 + EXIT KFACE_LOOP + ENDDO + ENDIF + ENDDO ENDIF - ENDDO + ENDDO KFACE_LOOP ENDIF - ENDDO - X1AXIS=0 - IF(M%CCVAR(I,J,K,CC_IDCF)>0)THEN - ICF1=M%CCVAR(I,J,K,CC_IDCF); CF=>M%CUT_FACE(ICF1) - WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE,CF%STATUS - DO ICF2=1,CF%NFACE - WRITE(33,'(I8,3F16.8,F16.8)') ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) - ICC=CF%CELL_LIST(2,LOW_IND,ICF2); JCC=CF%CELL_LIST(3,LOW_IND,ICF2) - WRITE(33,'(3I8,F16.8,3F16.8)') M%CUT_CELL(ICC)%IJK(1:3),& - M%CUT_CELL(ICC)%VOLUME(JCC),M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) - CC=>M%CUT_CELL(ICC) - IFACE = CC%CCELEM(CF%CELL_LIST(4,LOW_IND,ICF2)+1,JCC) - IF(ICF1/=CC%FACE_LIST(4,IFACE) .OR. ICF2/=CC%FACE_LIST(5,IFACE)) THEN - WRITE(LU_ERR,*) 'WRONG CELL-FACE INC=',I,J,K,X1AXIS,':',ICC,JCC,ICF1,CC%FACE_LIST(4,IFACE),& - ICF2,CC%FACE_LIST(5,IFACE) - ENDIF + + ! Haven't found new face, either num_face=0, or we need a new icell: + IF (.NOT.NEWFACE) EXIT INF_LOOP2 + CTVAL = CTVAL + 1 + IF (CTVAL > THRES) THEN + CYCLE_CELL = .TRUE. + EXIT INF_LOOP2 + ENDIF + + ENDDO INF_LOOP2 + ! Test if there are any faces left: + IF ( NUM_FACE <= 0 ) THEN + EXIT + ELSE ! New cell, find new face set iface + DO IFACE=1,NFACE_CELL + IF (FACECELL_NUM(IFACE) == 0) THEN ! NOT COUNTED YET. + ! ASSUMES IT HAS AT LEAST ONE REGULAR EDGE. + ICELL = ICELL + 1 + EXIT + ENDIF ENDDO + IF(IFACE > NFACE_CELL) EXIT INF_LOOP1 ! Case all faces associated. ENDIF - ENDDO - ENDDO - ENDDO - CLOSE(33) + CTVAL2 = CTVAL2 + 1 + IF (CTVAL2 > THRES) CYCLE_CELL = .TRUE. + IF (CYCLE_CELL) EXIT INF_LOOP1 + ENDDO INF_LOOP1 - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFACES.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,A,I8,I8,I8,I8)') I,J,K,':',& - M%ECVAR(I,J,K,CC_EGSC,IAXIS),M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) - DO X1AXIS=IAXIS,KAXIS - IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN - ICE=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(ICE) - WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE - DO JCE=1,CE%NEDGE - WRITE(33,'(I8,F12.8,F12.8)') JCE,CE%DXX(1,JCE),CE%DXX(2,JCE) - DO JCF=-2,2 - IF(JCF==0) CYCLE - ! Face JCF: - ICF1=CE%FACE_LIST(1,JCF,JCE); ICF2=CE%FACE_LIST(2,JCF,JCE) - CF=>M%CUT_FACE(ICF1) - WRITE(33,'(4I8,I8,3F16.8,F16.8)') CF%IJK(1:4),ICF2,CF%XYZCEN(IAXIS:KAXIS,ICF2),CF%AREA(ICF2) - ENDDO - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) -ENDIF + CYCLE_CELL_COND : IF (CYCLE_CELL) THEN + CELLRT(I,J,K) = .TRUE. + MESHES(NM)%N_SPCELL = MESHES(NM)%N_SPCELL + 1 + ! Here if needed reallocate SPCELL_LIST: + NSPCELL_LIST = SIZE(MESHES(NM)%SPCELL_LIST,DIM=2) + IF (NSPCELL_LIST < MESHES(NM)%N_SPCELL) THEN + ALLOCATE(SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST)); SPCELL_LIST(:,:)=MESHES(NM)%SPCELL_LIST(:,:) + DEALLOCATE(MESHES(NM)%SPCELL_LIST) + ALLOCATE(MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+DELTA_CELL)); + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST)=SPCELL_LIST(IAXIS:KAXIS,1:NSPCELL_LIST) + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,NSPCELL_LIST+1:NSPCELL_LIST+DELTA_CELL) = CC_UNDEFINED + DEALLOCATE(SPCELL_LIST) + ENDIF + MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,MESHES(NM)%N_SPCELL) = (/ I, J, K /) + ! Add to cells to block list: + N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK + 1 + CTVAL = SIZE(SPCELLS_TO_BLOCK,DIM=1) + IF( CTVAL 0) THEN + IBOD = 1; ITRI = 1 + IF (MESHES(NM)%CUT_FACE(IDCF)%NFACE > 0) THEN + IBOD = MESHES(NM)%CUT_FACE(IDCF)%BODTRI(1,1) + ITRI = MESHES(NM)%CUT_FACE(IDCF)%BODTRI(2,1) + ENDIF + CALL FACE_DEALLOC(NM,IDCF) + CALL NEW_FACE_ALLOC(NM,IDCF,8,6,4+1) ! Reallocate CUT_FACE entry with 8 vertices, 6 faces, 4 verts per face. + NIBFACE = 0 + XYZVERT = 0._EB + NVERT_CELL = 0 + CFELEM = 0 + ! Define from SOLID FACES CFACES for the cell: + IED = I-1; JED = J-1; KED = K-1 + AXIS_LOOP : DO MYAXIS=IAXIS,KAXIS + SELECT CASE(MYAXIS) + CASE(IAXIS) + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) + AREAI = DYCELL(J) * DZCELL(K) + CASE(JAXIS) + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) + AREAI = DXCELL(I) * DZCELL(K) + CASE(KAXIS) + XYZLH(IAXIS:KAXIS,NOD1,HIGH_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD2,HIGH_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD3,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD4,HIGH_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED+1) /) + XYZLH(IAXIS:KAXIS,NOD1,LOW_IND) = (/ XFACE(IED ), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD2,LOW_IND) = (/ XFACE(IED+1), YFACE(JED ), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD3,LOW_IND) = (/ XFACE(IED+1), YFACE(JED+1), ZFACE(KED ) /) + XYZLH(IAXIS:KAXIS,NOD4,LOW_IND) = (/ XFACE(IED ), YFACE(JED+1), ZFACE(KED ) /) + AREAI = DXCELL(I) * DYCELL(J) + END SELECT + SIDE_LOOP : DO SIDE=LOW_IND,HIGH_IND + IF (FSID_XYZ(SIDE ,MYAXIS) /= CC_SOLID) CYCLE SIDE_LOOP + NIBFACE = NIBFACE + 1 + ! Define vertices of CFACE and insert add to MESHES(NM)%CUT_FACE(IDCF)%XYZVERT + NP = 0 + XYZC(IAXIS:KAXIS) = 0._EB + DO IP=NOD1,NOD4 + ! xl,yl,zl + XYZ(IAXIS:KAXIS) = XYZLH(IAXIS:KAXIS,IP,SIDE) + XYZC(IAXIS:KAXIS)= XYZC(IAXIS:KAXIS) + XYZ(IAXIS:KAXIS) + CALL INSERT_FACE_VERT_LOC(CC_MAXVERTS_CELL,XYZ,NVERT_CELL,INOD,XYZVERT) + NP = NP + 1 + CFELEM(1) = NP + CFELEM(NP+1) = INOD + ENDDO -! ---------------------- GET_REGULAR_CUTCELLS_BOX ------------------------------ + ! Define CFELEM connectivity, also CFACE area and Centroid add to corresponding CUT_FACE(IDCF) entries. + MESHES(NM)%CUT_FACE(IDCF)%CFELEM(1:5,NIBFACE) = CFELEM(1:5) + MESHES(NM)%CUT_FACE(IDCF)%AREA(NIBFACE) = AREAI + MESHES(NM)%CUT_FACE(IDCF)%XYZCEN(IAXIS:KAXIS,NIBFACE) = 0.25_EB*XYZC(IAXIS:KAXIS) + ! Fields for cut-cell volume/centroid computation: + MESHES(NM)%CUT_FACE(IDCF)%INXAREA(NIBFACE) = 0._EB + MESHES(NM)%CUT_FACE(IDCF)%INXSQAREA(NIBFACE) = 0._EB + MESHES(NM)%CUT_FACE(IDCF)%JNYSQAREA(NIBFACE) = 0._EB + MESHES(NM)%CUT_FACE(IDCF)%KNZSQAREA(NIBFACE) = 0._EB -SUBROUTINE GET_REGULAR_CUTCELLS_BOX + ! Define Body-triangle reference: + MESHES(NM)%CUT_FACE(IDCF)%BODTRI(1:2,NIBFACE)= (/ IBOD, ITRI /) -! Local Variables: -INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: GEOMCELL -INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: GEOMFACE -INTEGER :: IBNDINT,INTGC_FLG,BNDINT_LOW,BNDINT_HIGH,II,JJ,KK,X1LO,X1HI,X2LO,X2HI,X3LO,X3HI,INDXI(IAXIS:KAXIS) -INTEGER :: INDI,INDJ,INDK,INDI1,INDJ1,INDK1,INDI2,INDJ2,INDK2,INDI3,INDJ3,INDK3,INDI4,INDJ4,INDK4 -INTEGER :: INDXI1(IAXIS:KAXIS),INDXI2(IAXIS:KAXIS),INDXI3(IAXIS:KAXIS),INDXI4(IAXIS:KAXIS) -INTEGER :: NVERT,NFACE,NVERTFACE,NCUTFACE,NCUTCELL,FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS),CFELEM(1:NOD4+1,6),& - IDCF_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) -INTEGER :: LOHI,IWSEL,I1,I2,I3,IBOD(6),ITRI(6),FACE_LIST(1:CC_NPARAM_CCFACE,1:6),CEI_AXIS(LOW_IND:HIGH_IND),& - CEI,SIDE,NCFACE_CUTCELL,NFACE_CELL -REAL(EB):: DIST, DIST2, VOL(1) -REAL(EB):: XYZLC(IAXIS:KAXIS),XYZVERT(IAXIS:KAXIS,NOD1:NOD4+20),AREA(6),XYZCEN(IAXIS:KAXIS,6),XCEN(IAXIS:KAXIS) -REAL(EB):: INXAREA(IAXIS:KAXIS,1:6)=0._EB,INXSQAREA(IAXIS:KAXIS,1:6)=0._EB -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNTED2,IJK_COUNT + ! Assign surf-index: Depending on GEOMETRY: + ! Here we might just add the INERT SURF_ID: + MESHES(NM)%CUT_FACE(IDCF)%SURF_INDEX(NIBFACE) = GEOMETRY(IBOD)%SURFS(ITRI) + ! Finally add to FACE_LIST from N_GAS_CFACES on: + NFACE_CELL = N_GAS_CFACES + NIBFACE + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB,0,0,IDCF, NIBFACE,CC_UNDEFINED /) + ENDDO SIDE_LOOP + ENDDO AXIS_LOOP + IF(NIBFACE==0) THEN + MESHES(NM)%CUT_FACE(IDCF)%STATUS = CC_SOLID + MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED + ELSE + MESHES(NM)%CUT_FACE(IDCF)%NFACE = NIBFACE + MESHES(NM)%CUT_FACE(IDCF)%NVERT = NVERT_CELL + MESHES(NM)%CUT_FACE(IDCF)%XYZVERT(IAXIS:KAXIS,1:NVERT_CELL) = XYZVERT(IAXIS:KAXIS,1:NVERT_CELL) + ENDIF + ENDIF IDCF_COND -! Allocate Face - Geom numbering and Cell - Geom numbering arrays -ALLOCATE(GEOMFACE(ISTR:IEND,JSTR:JEND,KSTR:KEND,MAX_DIM)); GEOMFACE = CC_GASPHASE -ALLOCATE(GEOMCELL(ISTR:IEND,JSTR:JEND,KSTR:KEND)); GEOMCELL = CC_GASPHASE + ! Now define a coarse cut-cell (no INBOUNDARY cut-faces): + NCELL = 1 + ! Test NFACE_CELL not > SIZE_FACE_CCELEM: + IF (NFACE_CELL > SIZE_FACE_CCELEM) THEN + DFCT = CEILING(REAL(NFACE_CELL-SIZE_FACE_CCELEM,EB)/REAL(DELTA_FACE,EB)) + SIZE_FACE_CCELEM = SIZE_FACE_CCELEM + DFCT*DELTA_FACE + DEALLOCATE(CCELEM) + ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) + ENDIF + CCELEM(1:NFACE_CELL+1,NCELL) = (/ NFACE_CELL, (IFACE, IFACE=1,NFACE_CELL) /) + VOL(NCELL) = DXCELL(I)*DYCELL(J)*DZCELL(K) + NOADVANCE(NCELL) = NOT_BLOCKED + XYZCEN(IAXIS:KAXIS,NCELL) = (/ XCELL(I), YCELL(J), ZCELL(K) /) -! First tag cells: NM is set and we have all the mesh info in MESHES(NM) -DO K=KLO_CELL-NGUARD,KHI_CELL+NGUARD - DO J=JLO_CELL-NGUARD,JHI_CELL+NGUARD - DO I=ILO_CELL-NGUARD,IHI_CELL+NGUARD - DO IG=1,N_GEOMETRY - IF(XCELL(I) < GEOMETRY(IG)%XB(1)) CYCLE - IF(XCELL(I) > GEOMETRY(IG)%XB(2)) CYCLE - IF(YCELL(J) < GEOMETRY(IG)%XB(3)) CYCLE - IF(YCELL(J) > GEOMETRY(IG)%XB(4)) CYCLE - IF(ZCELL(K) < GEOMETRY(IG)%XB(5)) CYCLE - IF(ZCELL(K) > GEOMETRY(IG)%XB(6)) CYCLE - GEOMCELL(I,J,K) = IG - MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_SOLID - EXIT - ENDDO - ENDDO - ENDDO -ENDDO + ELSE CYCLE_CELL_COND -! Now Tag cut-cells: The -2, +2 is to be able to define cut-face types below on boundary of GC cut-cells. -DO K=KLO_CELL-NGUARD+1,KHI_CELL+NGUARD-1 - DO J=JLO_CELL-NGUARD+1,JHI_CELL+NGUARD-1 - DO I=ILO_CELL-NGUARD+1,IHI_CELL+NGUARD-1 - IF(MESHES(NM)%CCVAR(I,J,K,CC_CGSC)==CC_SOLID) THEN - ! Set all vertices to Solid: - MESHES(NM)%VERTVAR(I-1,J ,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I-1,J-1,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I-1,J-1,K-1,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I-1,J ,K-1,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J ,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J-1,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J-1,K-1,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J ,K-1,CC_VGSC) = CC_SOLID - CYCLE - ENDIF - IF(ANY(MESHES(NM)%CCVAR(I-1:I+1,J-1:J+1,K-1:K+1,CC_CGSC) == CC_SOLID)) & - MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE - ENDDO - ENDDO -ENDDO + ! Create CCELEM array: + NCELL = MAXVAL(FACECELL_NUM(:)) + ! Test NCELL not > SIZE_CELL_CCELEM; NFACE_CELL not > SIZE_FACE_CCELEM: + IF (NFACE_CELL > SIZE_FACE_CCELEM) THEN + DFCT = CEILING(REAL(NFACE_CELL-SIZE_FACE_CCELEM,EB)/REAL(DELTA_FACE,EB)) + SIZE_FACE_CCELEM = SIZE_FACE_CCELEM + DFCT*DELTA_FACE + DEALLOCATE(CCELEM) + ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) + ENDIF + IF (NCELL > SIZE_CELL_CCELEM) THEN + DFCT = CEILING(REAL(NCELL-SIZE_CELL_CCELEM,EB)/REAL(DELTA_CELL,EB)) + SIZE_CELL_CCELEM = SIZE_CELL_CCELEM + DFCT*DELTA_CELL + DEALLOCATE(CCELEM,NOADVANCE,VOL,XYZCEN) + ALLOCATE(CCELEM(1:SIZE_FACE_CCELEM+1,1:SIZE_CELL_CCELEM)) + ALLOCATE(NOADVANCE(1:SIZE_CELL_CCELEM),VOL(1:SIZE_CELL_CCELEM),XYZCEN(IAXIS:KAXIS,1:SIZE_CELL_CCELEM)) + ENDIF + CCELEM= CC_UNDEFINED + DO ICELL=1,NCELL + NP = 0 + DO IFACE=1,NFACE_CELL + IF ( FACECELL_NUM(IFACE) == ICELL ) THEN + NP = NP + 1 + CCELEM(1,ICELL) = NP + CCELEM(NP+1,ICELL) = IFACE + ENDIF + ENDDO + ENDDO -! Then tag faces: -! X Faces: -DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD - DO J=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD - DO I=ILO_FACE-CCGUARD,IHI_FACE+CCGUARD - ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: - IF(ANY(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_GASPHASE)) CYCLE + ! Compute volumes and centroids for the found cut-cells: + VOL(1:NCELL) = 0._EB + NOADVANCE(1:NCELL) = NOT_BLOCKED + XYZCEN(IAXIS:KAXIS,1:NCELL) = 0._EB + DO ICELL=1,NCELL + NP = CCELEM(1,ICELL) + DO II=2,NP+1 + IFACE = CCELEM(II,ICELL) + ! Volume: + VOL(ICELL) = VOL(ICELL) + AREAVARS(1,IFACE) + ! xyzcen: + XYZCEN(IAXIS:KAXIS,ICELL) = XYZCEN(IAXIS:KAXIS,ICELL)+AREAVARS(2:4,IFACE) + ENDDO + VOL(ICELL) = ABS(VOL(ICELL)) - ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: - IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_SOLID)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID - GEOMFACE(I,J,K,IAXIS) = GEOMCELL(I,J,K) - CYCLE - ENDIF + ! Define if cut-cell is very small -> NOADVANCE(ICELL)=BLOCKED_SMALL_CELL: + IF(DO_NOADVANCE .AND. VOL(ICELL)/(DXCELL(I)*DYCELL(J)*DZCELL(K))DXCELL(I)*DYCELL(J)*DZCELL(K)) VOL(ICELL) = DXCELL(I)*DYCELL(J)*DZCELL(K) + IF(VOL(ICELL) < GEOMEPS) THEN ! Volume too small for correct calculation of XYZCEN-> take cartcell centroid. + IF(.NOT.DO_NOADVANCE .AND. VOL(ICELL)XFACE(I)) XYZCEN(IAXIS,ICELL) = XCELL(I) + IF(XYZCEN(JAXIS,ICELL)YFACE(J)) XYZCEN(JAXIS,ICELL) = YCELL(J) + IF(XYZCEN(KAXIS,ICELL)ZFACE(K)) XYZCEN(KAXIS,ICELL) = ZCELL(K) + ENDIF + ENDDO - ! Now Gasphase cut-faces: All CCVAR == CUTCFE - IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_CUTCFE)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_CUTCFE - ! GEOMFACE(I,J,K,IAXIS) stays CC_GASPHASE - CYCLE - ENDIF + ENDIF CYCLE_CELL_COND - ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: - IF (GEOMCELL(I,J,K)*GEOMCELL(I+1,J,K) < 0) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID - GEOMFACE(I,J,K,IAXIS) = MAXVAL(GEOMCELL(I:I+1,J,K)) ! This is because one is ==CC_GASPHASE==-1 - CYCLE + ! Load into CUT_CELL data structure + NCUTCELL = MESHES(NM)%N_CUTCELL_MESH + MESHES(NM)%N_GCCUTCELL_MESH + 1 + IF (IBNDINT==LOW_IND) THEN + MESHES(NM)%N_CUTCELL_MESH = NCUTCELL + ELSE + MESHES(NM)%N_GCCUTCELL_MESH = MESHES(NM)%N_GCCUTCELL_MESH + 1 ENDIF - ENDDO - ENDDO -ENDDO + MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = NCUTCELL -! Y Faces: -DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD - DO J=JLO_FACE-CCGUARD,JHI_FACE+CCGUARD - DO I=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD - ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: - IF(ANY(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_GASPHASE)) CYCLE + ! Resize array MESHES(NM)%CUT_CELL if necessary: + CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) - ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: - IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_SOLID)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_SOLID - GEOMFACE(I,J,K,JAXIS) = GEOMCELL(I,J,K) - CYCLE - ENDIF + ! Add cut-cell NCUTCELL entry: + MESHES(NM)%CUT_CELL(NCUTCELL)%IJK(IAXIS:KAXIS) = (/ I, J, K /) + MESHES(NM)%CUT_CELL(NCUTCELL)%NCELL = NCELL + MESHES(NM)%CUT_CELL(NCUTCELL)%NFACE_CELL= NFACE_CELL + NCFACE_CUTCELL = MAXVAL(CCELEM(1,1:NCELL)) + 1 + CALL NEW_CELL_ALLOC(NM,NCUTCELL,NCELL,NFACE_CELL,NCFACE_CUTCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%CCELEM(1:NCFACE_CUTCELL,1:NCELL) = CCELEM(1:NCFACE_CUTCELL,1:NCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) = & + FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%VOLUME(1:NCELL) = VOL(1:NCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%XYZCEN(IAXIS:KAXIS,1:NCELL) = XYZCEN(IAXIS:KAXIS,1:NCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%NOADVANCE(1:NCELL) = NOADVANCE(1:NCELL) - ! Now Gasphase cut-faces: All CCVAR == CUTCFE - IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_CUTCFE)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_CUTCFE - ! GEOMFACE(I,J,K,JAXIS) stays CC_GASPHASE - CYCLE - ENDIF + ! Test for sliver cells blocking: + XYZCELL(IAXIS,LOW_IND) = XFACE(I-1); XYZCELL(IAXIS,HIGH_IND) = XFACE(I); + XYZCELL(JAXIS,LOW_IND) = YFACE(J-1); XYZCELL(JAXIS,HIGH_IND) = YFACE(J); + XYZCELL(KAXIS,LOW_IND) = ZFACE(K-1); XYZCELL(KAXIS,HIGH_IND) = ZFACE(K); + MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) + MINMAX_XYZ_CC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) + DO JCC=1,NCELL + ! Get cut-cell bounding box: + CALL CUT_CELL_BOUNDING_BOX(NM,NCUTCELL,JCC,XYZCELL,MINMAX_XYZ_CC) + ! Perform Tests: + DO MYAXIS=IAXIS,KAXIS + CELL_DELTA(MYAXIS) = ABS(MINMAX_XYZ_CC(MYAXIS,HIGH_IND)-MINMAX_XYZ_CC(MYAXIS,LOW_IND)) + ENDDO + ! Axis with minimum width: + AX_MIN = MINLOC(CELL_DELTA(IAXIS:KAXIS),DIM=1) + SELECT CASE(AX_MIN) + CASE(IAXIS); AX_OTHERS(1:2) = (/ JAXIS, KAXIS /); + CASE(JAXIS); AX_OTHERS(1:2) = (/ IAXIS, KAXIS /); + CASE(KAXIS); AX_OTHERS(1:2) = (/ IAXIS, JAXIS /); + END SELECT + ! Perform Test: + BLOCK_SLIM_IF = (CELL_DELTA(AX_MIN) SIZE_CFELEM_FC) THEN + ! FACE_LIST, AREAVARS, FACE_CELL + ALLOCATE(FACE_LIST_AUX(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC+DELTA_FACE)); + FACE_LIST_AUX=CC_UNDEFINED + ALLOCATE(AREAVARS_AUX(1:MAX_DIM+1,1:SIZE_CFELEM_FC+DELTA_FACE)); AREAVARS_AUX = 0._EB + ALLOCATE(FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC+DELTA_FACE)); + FACE_CELL_AUX=CC_UNDEFINED + ! Assign: + FACE_LIST_AUX(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)= & + FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC) + AREAVARS_AUX(1:MAX_DIM+1,1:SIZE_CFELEM_FC) = AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC) + FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) = & + FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) + ! Reallocate: + SIZE_CFELEM_FC = SIZE_CFELEM_FC + DELTA_FACE + DEALLOCATE(FACE_LIST,AREAVARS,FACE_CELL); + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:SIZE_CFELEM_FC)) + ALLOCATE(AREAVARS(1:MAX_DIM+1,1:SIZE_CFELEM_FC)) + ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) + ! Dump back data: + FACE_LIST(:,:) = FACE_LIST_AUX(:,:) + AREAVARS(:,:) = AREAVARS_AUX(:,:) + FACE_CELL(:,:) = FACE_CELL_AUX(:,:) + DEALLOCATE(FACE_LIST_AUX,AREAVARS_AUX,FACE_CELL_AUX) +ENDIF +RETURN +END SUBROUTINE REALLOCATE_LOCAL_FC_VARS + +SUBROUTINE REALLOCATE_FACE_CELL_VERTS - ! When switching to internal faces, copy number of external faces already computed. - IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH +IF (NP+1 > SIZE_VERTS_FC) THEN + DFCT=CEILING(REAL(NP+1-SIZE_VERTS_FC,EB)/REAL(DELTA_VERT,EB)) + ALLOCATE(FACE_CELL_AUX(1:SIZE_VERTS_FC+DFCT*DELTA_VERT,1:SIZE_CFELEM_FC)); + FACE_CELL_AUX=CC_UNDEFINED + ! Assign: + FACE_CELL_AUX(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) = & + FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC) + ! Reallocate: + SIZE_VERTS_FC = SIZE_VERTS_FC + DFCT*DELTA_VERT + DEALLOCATE(FACE_CELL); ALLOCATE(FACE_CELL(1:SIZE_VERTS_FC,1:SIZE_CFELEM_FC)) + FACE_CELL(:,:) = FACE_CELL_AUX(:,:) + DEALLOCATE(FACE_CELL_AUX) + ! Now FACE_CELL_DUM: + DEALLOCATE(FACE_CELL_DUM); ALLOCATE(FACE_CELL_DUM(1:SIZE_VERTS_FC)) +ENDIF - X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS - SELECT CASE(X1AXIS) - CASE(IAXIS) - X2AXIS = JAXIS; X3AXIS = KAXIS - ! IAXIS gasphase cut-faces: - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - ILO = ILO_FACE; IHI = ILO_FACE - CASE(2) - ILO = IHI_FACE; IHI = IHI_FACE - CASE(3) - ILO = ILO_FACE+1; IHI = IHI_FACE-1 - CASE(4) - ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS - ! Local indexing in x1, x2, x3: - X1LO = ILO; X1HI = IHI - X2LO = JLO; X2HI = JHI - X3LO = KLO; X3HI = KHI - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE - ALLOCATE(X2FACE(JSTR:JEND)); X2FACE = YFACE - ALLOCATE(X3FACE(KSTR:KEND)); X3FACE = ZFACE +RETURN +END SUBROUTINE REALLOCATE_FACE_CELL_VERTS - CASE(JAXIS) - X2AXIS = KAXIS; X3AXIS = IAXIS - ! JAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - JLO = JLO_FACE; JHI = JLO_FACE - CASE(2) - JLO = JHI_FACE; JHI = JHI_FACE - CASE(3) - JLO = JLO_FACE+1; JHI = JHI_FACE-1 - CASE(4) - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS - ! Local indexing in x1, x2, x3: - X1LO = JLO; X1HI = JHI - X2LO = KLO; X2HI = KHI - X3LO = ILO; X3HI = IHI - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE - ALLOCATE(X2FACE(KSTR:KEND)); X2FACE = ZFACE - ALLOCATE(X3FACE(ISTR:IEND)); X3FACE = XFACE +END SUBROUTINE GET_CARTCELL_CUTCELLS +! ------------------------ GET_TRIANG_FACE_INT ---------------------------------- - CASE(KAXIS) - X2AXIS = IAXIS; X3AXIS = JAXIS - ! KAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - KLO = KLO_FACE; KHI = KLO_FACE - CASE(2) - KLO = KHI_FACE; KHI = KHI_FACE - CASE(3) - KLO = KLO_FACE+1; KHI = KHI_FACE-1 - CASE(4) - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - END SELECT - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS - ! Local indexing in x1, x2, x3: - X1LO = KLO; X1HI = KHI - X2LO = ILO; X2HI = IHI - X3LO = JLO; X3HI = JHI - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE - ALLOCATE(X2FACE(ISTR:IEND)); X2FACE = XFACE - ALLOCATE(X3FACE(JSTR:JEND)); X3FACE = YFACE +SUBROUTINE GET_TRIANG_FACE_INT(X2AXIS,X3AXIS,FVERT,CEI,NM, & + INB_FLG,NVERT,XYVERT,NEDGE,CEELEM,INDSEG) - END SELECT +INTEGER, INTENT(IN) :: X2AXIS, X3AXIS, CEI, NM +REAL(EB), INTENT(IN) :: FVERT(IAXIS:JAXIS,NOD1:NOD4) +LOGICAL, INTENT(OUT):: INB_FLG +INTEGER, INTENT(OUT):: NVERT,NEDGE,CEELEM(NOD1:NOD2,1:CC_MAXCEELEM_FACE) +INTEGER, INTENT(OUT):: INDSEG(CC_MAX_WSTRIANG_SEG+3,CC_MAXCEELEM_FACE) +REAL(EB), INTENT(OUT):: XYVERT(IAXIS:JAXIS,1:CC_MAXVERTS_FACE) - ! Loop on Cartesian faces, local x1, x2, x3 indexes: - DO II=X1LO,X1HI - DO KK=X3LO,X3HI - DO JJ=X2LO,X2HI - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI = INDXI(XIAXIS) - INDJ = INDXI(XJAXIS) - INDK = INDXI(XKAXIS) - ! Drop if not CUTCFE: - IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE; IJK_COUNTED(INDI,INDJ,INDK,X1AXIS)=.TRUE. - IF(MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE +! Local Variables: +REAL(EB) :: X2FMIN, X2FMAX, X3FMIN, X3FMAX, DUMMY(IAXIS:JAXIS) +INTEGER :: SEG(NOD1:NOD2), TRI(NOD1:NOD3), ITRI, INOD +LOGICAL :: INTEST, OUTX2, OUTX3, OUTFACE, TRUETHAT, XIALIGNED, OUTSEG, SEG_IN_SIDE +INTEGER :: TSEGS(NOD1:NOD2,EDG1:EDG3) +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FVERT_IN_TRIANG, TRIVERT_IN_FACE +INTEGER :: NFVERT, NTVERT, NINTP +INTEGER :: TRINODS(CC_MAXVERTS_FACE) +REAL(EB) :: ATANTRI(1:CC_MAXVERTS_FACE+1), ATTRI +INTEGER :: II(1:CC_MAXVERTS_FACE+1), INTP, IINS, IDUM, INP, NINTP_TRI, IPT, JPL, IEDGE, IPF, ISEG +INTEGER :: LOCTRI, LOCBOD, EDGETRI(NOD1:NOD2,1:CC_MAXCEELEM_FACE), VEC3(1:3) +REAL(EB) :: XY1(IAXIS:JAXIS), XY2(IAXIS:JAXIS), XP1(IAXIS:JAXIS), XP2(IAXIS:JAXIS) +REAL(EB) :: XP(IAXIS:JAXIS), FD(1:2), VEC(IAXIS:JAXIS) +INTEGER :: MYAXIS, XIAXIS, XJAXIS +REAL(EB) :: XIPLNS(LOW_IND:HIGH_IND), XJPLNS(LOW_IND:HIGH_IND), DOT1, DOT2 +REAL(EB) :: MINXI, MAXXI, MINXJ, MAXXJ, DS, SVARI, XJPLN, XCEN(IAXIS:JAXIS) +REAL(EB) :: VECS(IAXIS:JAXIS), VECP1(IAXIS:JAXIS), VECP2(IAXIS:JAXIS), CROSSP1, CROSSP2 +REAL(EB) :: XYEL(IAXIS:JAXIS,NOD1:NOD3) +LOGICAL :: INLIST, OUTPLANE1, OUTPLANE2 +INTEGER :: EDGE_TRI +REAL(EB), ALLOCATABLE, SAVE, DIMENSION(:,:) :: X2X3VERT +INTEGER, SAVE :: SIZE_X2X3VERT - ! Vertex at index II,JJ-1,KK-1: - INDXI1(IAXIS:KAXIS) = (/ II, JJ-1, KK-1 /) ! Local x1,x2,x3 - INDI1 = INDXI1(XIAXIS) - INDJ1 = INDXI1(XJAXIS) - INDK1 = INDXI1(XKAXIS) - ! Vertex at index II,JJ,KK-1: - INDXI2(IAXIS:KAXIS) = (/ II, JJ, KK-1 /) ! Local x1,x2,x3 - INDI2 = INDXI2(XIAXIS) - INDJ2 = INDXI2(XJAXIS) - INDK2 = INDXI2(XKAXIS) - ! Vertex at index II,JJ,KK: - INDXI3(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI3 = INDXI3(XIAXIS) - INDJ3 = INDXI3(XJAXIS) - INDK3 = INDXI3(XKAXIS) - ! Vertex at index II,JJ-1,KK: - INDXI4(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 - INDI4 = INDXI4(XIAXIS) - INDJ4 = INDXI4(XJAXIS) - INDK4 = INDXI4(XKAXIS) +INTEGER :: IWSSEG,NSVERT,NINTP_SEG,SEGNODS(NOD1:NOD2) - ! First, normal direction in x1 direction. - ! For this face: XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - ! Vert 1: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI1(IAXIS)), X2FACE(INDXI1(JAXIS)), X3FACE(INDXI1(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) - ! Vert 2: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI2(IAXIS)), X2FACE(INDXI2(JAXIS)), X3FACE(INDXI2(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) - ! Vert 3: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI3(IAXIS)), X2FACE(INDXI3(JAXIS)), X3FACE(INDXI3(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) - ! Vert 4: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI4(IAXIS)), X2FACE(INDXI4(JAXIS)), X3FACE(INDXI4(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) +! Default return values: +INB_FLG = .FALSE. +NVERT = 0 +NEDGE = 0 +IF(.NOT.ALLOCATED(X2X3VERT)) THEN + SIZE_X2X3VERT = DELTA_VERT + ALLOCATE(X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT)) +ENDIF +X2X3VERT = 0._EB +CEELEM = CC_UNDEFINED +INDSEG = CC_UNDEFINED +IF ( CEI /= 0 ) THEN + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT + NEDGE = MESHES(NM)%CUT_EDGE(CEI)%NEDGE - CFELEM(1:5,1) = (/ 4, NOD1, NOD2, NOD3, NOD4 /) + IF (NVERT > SIZE_X2X3VERT) THEN + DEALLOCATE(X2X3VERT) + SIZE_X2X3VERT = NVERT + DELTA_VERT + ALLOCATE(X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT)); X2X3VERT = 0._EB + ENDIF - ! Area: - AREA(1) = (X2FACE(INDXI2(JAXIS))-X2FACE(INDXI1(JAXIS)))*(X3FACE(INDXI4(KAXIS))-X3FACE(INDXI1(KAXIS))) + X2X3VERT(IAXIS,1:NVERT) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(X2AXIS,1:NVERT) + X2X3VERT(JAXIS,1:NVERT) = MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(X3AXIS,1:NVERT) - ! XYZCEN in Local Coords: - XYZCEN(IAXIS:KAXIS,1)= (/ X1FACE(II), 0.5_EB*(X2FACE(INDXI2(JAXIS))+X2FACE(INDXI1(JAXIS))), & - 0.5_EB*(X3FACE(INDXI4(KAXIS))+X3FACE(INDXI1(KAXIS))) /) + CEELEM(NOD1:NOD2,1:NEDGE) = MESHES(NM)%CUT_EDGE(CEI)%CEELEM(NOD1:NOD2,1:NEDGE) + INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:NEDGE) = & + MESHES(NM)%CUT_EDGE(CEI)%INDSEG(1:CC_MAX_WSTRIANG_SEG+2,1:NEDGE) + MESHES(NM)%CUT_EDGE(CEI)%NEDGE1=NEDGE +ENDIF - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(IAXIS,1) = 1._EB * X1FACE(II) * AREA(1) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(IAXIS,1) = 1._EB * X1FACE(II)**2._EB * AREA(1) +! Quick discard test: +X2FMIN = MINVAL(FVERT(IAXIS,NOD1:NOD4)); X2FMAX = MAXVAL(FVERT(IAXIS,NOD1:NOD4)) +X3FMIN = MINVAL(FVERT(JAXIS,NOD1:NOD4)); X3FMAX = MAXVAL(FVERT(JAXIS,NOD1:NOD4)) + +! Loop in-plane Surface Elements: +INTEST = .FALSE. +DO ITRI=1,BODINT_PLANE%NTRIS + ! Elements nodes location, in x2-x3 coordinates: + TRI(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) + DO INOD=NOD1,NOD3 + XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,TRI(INOD)) + ENDDO + OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(IAXIS,NOD1:NOD3))-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir + OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(JAXIS,NOD1:NOD3))-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 + IF (.NOT.OUTFACE) THEN + INTEST = .TRUE. + EXIT + ENDIF +ENDDO +! Run on Triangle edges found: +DO ISEG=1,BODINT_PLANE%NSEGS + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) + DO INOD=NOD1,NOD2 + XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,SEG(INOD)) + ENDDO + OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(IAXIS,NOD1:NOD2))-X2FMAX) > GEOMEPS) ! Segment out of Face in x2 dir + OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(JAXIS,NOD1:NOD2))-X3FMAX) > GEOMEPS) ! Segment out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 + IF (.NOT.OUTFACE) THEN + INTEST = .TRUE. + EXIT + ENDIF +ENDDO +IF (.NOT.INTEST) RETURN - ! This is a new cut-face, allocate space: - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (INTGC_FLG==LOW_IND) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCF,X1AXIS) = NCUTFACE +! Now if intest is true figure out if there are triangles-face intersection +! Polygons: +NFVERT = 4 +NTVERT = 3 +NSVERT = 2 - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +! First Vertices: +ALLOCATE(FVERT_IN_TRIANG(1:NFVERT,BODINT_PLANE%NTRIS)); FVERT_IN_TRIANG = 0 +ALLOCATE(TRIVERT_IN_FACE(1:NTVERT,BODINT_PLANE%NTRIS)); TRIVERT_IN_FACE = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ INDI, INDJ, INDK, X1AXIS /) - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE,IBNDINT) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) +NINTP = NVERT - ! Connectivity: - CF%CFELEM(1:NVERTFACE,NFACE) = CFELEM(1:NVERTFACE,1) - ! Geom Properties: - CF%AREA(NFACE) = AREA(1) - CF%XYZCEN(IAXIS:KAXIS,NFACE) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,1) +! Loop in-plane Surface Elements: +DO ITRI=1,BODINT_PLANE%NTRIS - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: - CF%INXAREA(NFACE) = INXAREA(XIAXIS,1) - ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: - CF%INXSQAREA(NFACE) = INXSQAREA(XIAXIS,1) - ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: - CF%JNYSQAREA(NFACE) = INXSQAREA(XJAXIS,1) - ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: - CF%KNZSQAREA(NFACE) = INXSQAREA(XKAXIS,1) + NINTP_TRI = 0 + TRINODS = CC_UNDEFINED - ENDDO - ENDDO - ENDDO - DEALLOCATE(X1FACE,X2FACE,X3FACE) - ENDDO X1AXIS_LOOP - ENDDO IBNDINT_LOOP + ! Elements nodes location, in x2-x3 coordinates: + TRI(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) + DO INOD=NOD1,NOD3 + XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,TRI(INOD)) + ENDDO - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED ) + ! Cycle if Triangles BBOX not intersecting face: + OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(IAXIS,NOD1:NOD3))-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir + OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD3))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(JAXIS,NOD1:NOD3))-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 + IF (OUTFACE) CYCLE - ! INBOUNDARY cut-faces: - IF (INTGC_FLG==LOW_IND) THEN - ALLOCATE( IJK_COUNTED2(ISTR:IEND,JSTR:JEND,KSTR:KEND) ); IJK_COUNTED2=.FALSE. - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL + IF (BODINT_PLANE%X1NVEC(ITRI) < 0) THEN ! ROTATE NODE 2 AND 3 LOCATIONS + DUMMY(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,NOD2) + XYEL(IAXIS:JAXIS,NOD2) = XYEL(IAXIS:JAXIS,NOD3) + XYEL(IAXIS:JAXIS,NOD3) = DUMMY(IAXIS:JAXIS) + + TSEGS(NOD1:NOD2,EDG1) = BODINT_PLANE%TRIS( (/ 2, 1 /) ,ITRI) + TSEGS(NOD1:NOD2,EDG2) = BODINT_PLANE%TRIS( (/ 3, 2 /) ,ITRI) + TSEGS(NOD1:NOD2,EDG3) = BODINT_PLANE%TRIS( (/ 1, 3 /) ,ITRI) ELSE - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD + TSEGS(NOD1:NOD2,EDG1) = BODINT_PLANE%TRIS( (/ 1, 2 /) ,ITRI) + TSEGS(NOD1:NOD2,EDG2) = BODINT_PLANE%TRIS( (/ 2, 3 /) ,ITRI) + TSEGS(NOD1:NOD2,EDG3) = BODINT_PLANE%TRIS( (/ 3, 1 /) ,ITRI) ENDIF - ! Loop on Cartesian cells: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI + ! a. Test if Triangles vertices Lay on Faces area, including face boundary: + DO IPT=1,NTVERT + OUTX2= ((X2FMIN-XYEL(IAXIS,IPT)) > GEOMEPS) .OR. & + ((XYEL(IAXIS,IPT)-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir + OUTX3= ((X3FMIN-XYEL(JAXIS,IPT)) > GEOMEPS) .OR. & + ((XYEL(JAXIS,IPT)-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 - IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE + IF ( OUTFACE ) CYCLE - IF(IJK_COUNTED2(I,J,K)) CYCLE; IJK_COUNTED2(I,J,K)=.TRUE. + ! Insertion add point to intersection list: + XP(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,IPT) + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) + ! Insert sort node to triangles local list + TRUETHAT = .TRUE. + DO INP=1,NINTP_TRI + IF (TRINODS(INP) == INOD) THEN + TRUETHAT = .FALSE. + EXIT + ENDIF + ENDDO + IF ( TRUETHAT ) THEN ! new inod entry on list + NINTP_TRI = NINTP_TRI + 1 + TRINODS(NINTP_TRI) = INOD + ENDIF - IF ( ALL(FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) /= CC_SOLID) ) CYCLE + TRIVERT_IN_FACE(IPT,ITRI) = 1 - NVERT = 0; NFACE = 0 - INXAREA = 0._EB - INXSQAREA = 0._EB - ! XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - X1AXIS_LOOP2 : DO X1AXIS=IAXIS,KAXIS - LOHI_DO : DO LOHI=LOW_IND,HIGH_IND - IF (FSID_XYZ(LOHI,X1AXIS) /= CC_SOLID) CYCLE - NFACE = NFACE + 1 - SELECT CASE(X1AXIS) - CASE(IAXIS) + ENDDO - ! Vertices: - XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K ) /) - IF(LOHI==LOW_IND)THEN - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) - ELSE - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) - ENDIF - ! Area: - AREA(NFACE) = (YFACE(J )-YFACE(J-1))*(ZFACE(K )-ZFACE(K-1)) - ! XYZCEN: - XYZCEN(IAXIS:KAXIS,NFACE) = (/ XFACE(I-2+LOHI), 0.5_EB*(YFACE(J )+YFACE(J-1)), & - 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI) * AREA(NFACE) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI)**2._EB * AREA(NFACE) + ! b. Test if Face vertices lay on triangle, including triangle edges: + DO IPF=1,NFVERT + ! Transform back to master Element coordinates + ! location of point i,j in x2-x3 coordinates: + FD(1:2) = (/ FVERT(IAXIS,IPF)-XYEL(IAXIS,NOD3), FVERT(JAXIS,IPF)-XYEL(JAXIS,NOD3) /) + ! Here xi in vec(1) and eta in vec(2) + VEC(IAXIS) = BODINT_PLANE%AINV(1,1,ITRI)*FD(1) + BODINT_PLANE%AINV(1,2,ITRI)*FD(2) + VEC(JAXIS) = BODINT_PLANE%AINV(2,1,ITRI)*FD(1) + BODINT_PLANE%AINV(2,2,ITRI)*FD(2) - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I-2+LOHI,J,K,X1AXIS) - CASE(JAXIS) + ! Test for vertex point within triangle, considers Triangle Edges: + IF ( (VEC(IAXIS) >= (0._EB-GEOMEPS)) .AND. & + (VEC(JAXIS) >= (0._EB-GEOMEPS)) .AND. & + (1._EB-VEC(IAXIS)-VEC(JAXIS) >= (0._EB-GEOMEPS)) ) THEN - ! Vertices: - XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K-1) /) - IF(LOHI==LOW_IND)THEN - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) - ELSE - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) - ENDIF - ! Area: - AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(ZFACE(K )-ZFACE(K-1)) - ! XYZCEN: - XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), YFACE(J-2+LOHI), & - 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI) * AREA(NFACE) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI)**2._EB * AREA(NFACE) + ! Insertion add point to intersection list: + XP(IAXIS:JAXIS) = FVERT(IAXIS:JAXIS,IPF) + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I,J-2+LOHI,K,X1AXIS) - CASE(KAXIS) + ! Insert sort node to triangles local list + TRUETHAT = .TRUE. + DO INP=1,NINTP_TRI + IF (TRINODS(INP) == INOD) THEN + TRUETHAT = .FALSE. + EXIT + ENDIF + ENDDO + IF ( TRUETHAT ) THEN ! new inod entry on list + NINTP_TRI = NINTP_TRI + 1 + TRINODS(NINTP_TRI) = INOD + ENDIF - ! Vertices: - XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K-2+LOHI) /) - XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K-2+LOHI) /) - XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J ), ZFACE(K-2+LOHI) /) - XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K-2+LOHI) /) - IF(LOHI==LOW_IND)THEN - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) - ELSE - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) - ENDIF - ! Area: - AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(YFACE(J )-YFACE(J-1)) - ! XYZCEN: - XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), 0.5_EB*(YFACE(J )+YFACE(J-1)), & - ZFACE(K-2+LOHI) /) - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI) * AREA(NFACE) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI)**2._EB * AREA(NFACE) + FVERT_IN_TRIANG(IPF,ITRI) = 1 - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I,J,K-2+LOHI,X1AXIS) - END SELECT + ENDIF + ENDDO - ! With IBOD and cut-face XYZCEN defined, find closest triangle: - DIST = 1.E20_EB - ITRI(NFACE) = 1 - DO IWSEL=1,GEOMETRY(IBOD(NFACE))%N_FACES - I1 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-2) - I2 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-1) - I3 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL ) - XCEN(IAXIS:KAXIS) = 1._EB/3._EB * ( GEOMETRY(IBOD(NFACE))%VERTS(3*(I1-1)+IAXIS:3*(I1-1)+KAXIS)+ & - GEOMETRY(IBOD(NFACE))%VERTS(3*(I2-1)+IAXIS:3*(I2-1)+KAXIS)+ & - GEOMETRY(IBOD(NFACE))%VERTS(3*(I3-1)+IAXIS:3*(I3-1)+KAXIS) ) - ! Drop Triangles not on the face: - IF (ABS(XYZCEN(X1AXIS,NFACE)-XCEN(X1AXIS)) > GEOMEPS) CYCLE - DIST2 = NORM2(XYZCEN(IAXIS:KAXIS,NFACE)-XCEN(IAXIS:KAXIS)) - IF (DIST > DIST2) THEN - DIST = DIST2 - ITRI(NFACE) = IWSEL - ENDIF - ENDDO + ! Now add face edge - triangle edge intersection points: + ! x2 segments: + DO MYAXIS=IAXIS,JAXIS + SELECT CASE(MYAXIS) + CASE(IAXIS) + XIAXIS = IAXIS + XJAXIS = JAXIS + XIPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) + XJPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) + CASE(JAXIS) + XIAXIS = JAXIS + XJAXIS = IAXIS + XIPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) + XJPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) + END SELECT - NVERT = NVERT + 4 + DO JPL=LOW_IND,HIGH_IND - ENDDO LOHI_DO - ENDDO X1AXIS_LOOP2 + XJPLN = XJPLNS(JPL) + DO IPT=1,NTVERT - ! This is a cut-face, allocate space: - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (INTGC_FLG==LOW_IND) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE + XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD1,IPT) ) + XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD2,IPT) ) - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + ! Drop if Triangle edge on one side of segment ray: + MAXXJ = MAX(XY1(XJAXIS),XY2(XJAXIS)) + MINXJ = MIN(XY1(XJAXIS),XY2(XJAXIS)) + OUTPLANE1 = ((XJPLN-MAXXJ) > GEOMEPS) .OR. ((MINXJ-XJPLN) > GEOMEPS) + IF ( OUTPLANE1 ) CYCLE - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, 0 /) ! No axis = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_INBOUNDARY - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - CF%CFELEM(1:5,1:NFACE) = CFELEM(1:5,1:NFACE) + ! Also drop if Triangle edge ouside of face edge limits: + MAXXI = MAX(XY1(XIAXIS),XY2(XIAXIS)) + MINXI = MIN(XY1(XIAXIS),XY2(XIAXIS)) + OUTPLANE2 = ((XIPLNS(LOW_IND)-MAXXI) > GEOMEPS) .OR. ((MINXI-XIPLNS(HIGH_IND)) > GEOMEPS) + IF ( OUTPLANE2 ) CYCLE - CF%AREA(1:NFACE) = AREA(1:NFACE) - CF%XYZCEN(IAXIS:KAXIS,1:NFACE) = XYZCEN(IAXIS:KAXIS,1:NFACE) + ! Test if segment aligned with xi + XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) + IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA: - CF%INXAREA(1:NFACE) = INXAREA(IAXIS,1:NFACE) - ! dot(i,nc)*int(x^2)dA: - CF%INXSQAREA(1:NFACE) = INXSQAREA(IAXIS,NFACE) - ! dot(j,nc)*int(y^2)dA: - CF%JNYSQAREA(1:NFACE) = INXSQAREA(JAXIS,NFACE) - ! dot(k,nc)*int(z^2)dA: - CF%KNZSQAREA(1:NFACE) = INXSQAREA(KAXIS,NFACE) + ! Drop intersections in triangle segment nodes: already added. + ! Compute: dot(plnormal, xyzv - xypl): + DOT1 = XY1(XJAXIS) - XJPLN + DOT2 = XY2(XJAXIS) - XJPLN - ! Define Body-triangle reference: - CF%BODTRI(1,1:NFACE)= IBOD(1:NFACE) - CF%BODTRI(2,1:NFACE)= ITRI(1:NFACE) + IF ( ABS(DOT1) <= GEOMEPS ) CYCLE + IF ( ABS(DOT2) <= GEOMEPS ) CYCLE - ! Assign surf-index: Depending on GEOMETRY: - DO IFACE=1,NFACE - CF%SURF_INDEX(IFACE) = GEOMETRY(IBOD(IFACE))%SURFS(ITRI(IFACE)) - ENDDO + ! Finally regular case: + ! Points 1 on one side of x2 segment, point 2 on the other: + !IF ((DOT1 > 0._EB & DOT2 < 0._EB) .OR. (DOT1 < 0._EB & DOT2 > 0._EB)) + IF ( DOT1*DOT2 < 0._EB ) THEN + + ! Intersection Point along segment: + DS = (XJPLN-XY1(XJAXIS))/(XY2(XJAXIS)-XY1(XJAXIS)) + SVARI = XY1(XIAXIS) + DS*(XY2(XIAXIS)-XY1(XIAXIS)) + + OUTSEG= ((XIPLNS(LOW_IND)-SVARI) > -GEOMEPS) .OR. ((SVARI-XIPLNS(HIGH_IND)) > -GEOMEPS) + IF ( OUTSEG ) CYCLE + + ! Insertion add point to intersection list: + XP(XIAXIS) = SVARI + XP(XJAXIS) = XJPLN + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) + ! Insert sort node to triangles local list + TRUETHAT = .TRUE. + DO INP=1,NINTP_TRI + IF (TRINODS(INP) == INOD) THEN + TRUETHAT = .FALSE. + EXIT + ENDIF + ENDDO + IF (TRUETHAT) THEN ! new inod entry on list + NINTP_TRI = NINTP_TRI + 1 + TRINODS(NINTP_TRI) = INOD + ENDIF + CYCLE + ENDIF ENDDO ENDDO ENDDO - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED2 ) - -ENDDO INTGC_FLG_LOOP + IF ( NINTP_TRI == 0 ) CYCLE + ! Reorder points given normal on x1 direction: + ! Centroid: + XCEN(IAXIS:JAXIS) = 0._EB + DO INTP=1,NINTP_TRI + XCEN(IAXIS:JAXIS) = XCEN(IAXIS:JAXIS) + X2X3VERT(IAXIS:JAXIS,TRINODS(INTP)) + ENDDO + XCEN(IAXIS:JAXIS)= XCEN(IAXIS:JAXIS) * REAL(NINTP_TRI,EB)**(-1._EB) -! Finally Build cut-cells: -NCFACE_CUTCELL = 7; NFACE_CELL = 6; NCELL = 1 -INTGC_FLG_LOOP2 : DO INTGC_FLG=LOW_IND,HIGH_IND ! 1 refers to blocks internal cells, 2 refers to block guard cells. + ATANTRI(1:CC_MAXVERTS_FACE+1) = 1._EB / GEOMEPS + II(1:CC_MAXVERTS_FACE+1) = CC_UNDEFINED + DO INTP=1,NINTP_TRI + ATTRI = ATAN2(X2X3VERT(JAXIS,TRINODS(INTP))-XCEN(JAXIS), & + X2X3VERT(IAXIS,TRINODS(INTP))-XCEN(IAXIS)) + PI + ! Insertion sort: + DO IINS=1,INTP+1 + IF (ATTRI < ATANTRI(IINS)) EXIT + ENDDO + ! copy from the back: + DO IDUM=INTP+1,IINS+1,-1 + ATANTRI(IDUM) = ATANTRI(IDUM-1) + II(IDUM) = II(IDUM-1) + ENDDO + ATANTRI(IINS) = ATTRI + II(IINS) = INTP + ENDDO - SELECT CASE(INTGC_FLG) - CASE(LOW_IND) - ALLOCATE(IJK_COUNT(ILO_CELL-NGUARD:IHI_CELL+NGUARD,JLO_CELL-NGUARD:JHI_CELL+NGUARD, & - KLO_CELL-NGUARD:KHI_CELL+NGUARD)) - IJK_COUNT = .FALSE. - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - CASE(HIGH_IND) - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD - END SELECT + ! Reorder nodes: + TRINODS(1:NINTP_TRI) = TRINODS(II(1:NINTP_TRI)) - ! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI + ! Define and Insertion add segments to CFELEM, indseg + EDGETRI = CC_UNDEFINED + DO IEDGE=1,NINTP_TRI-1 + EDGETRI((/NOD1,NOD2/),IEDGE) = (/ TRINODS(IEDGE), TRINODS(IEDGE+1) /) + ENDDO + EDGETRI((/NOD1,NOD2/),NINTP_TRI) = (/ TRINODS(NINTP_TRI), TRINODS(1) /) - IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE + LOCTRI = BODINT_PLANE%INDTRI(1,ITRI) + LOCBOD = BODINT_PLANE%INDTRI(2,ITRI) - IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. + DO IEDGE=1,NINTP_TRI - ! Start with Cartesian Faces: - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) + IF ( EDGETRI(NOD1,IEDGE) == EDGETRI(NOD2,IEDGE) ) CYCLE - ! Cut-face number of bounding Cartesian faces: - IDCF_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCF,IAXIS) - IDCF_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCF,IAXIS) - IDCF_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCF,JAXIS) - IDCF_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCF,JAXIS) - IDCF_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCF,KAXIS) - IDCF_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCF,KAXIS) + ! Test if Edge already on list: + INLIST = .FALSE. + DO ISEG=1,NEDGE - NFACE_CELL = 0 + IF ( (EDGETRI(NOD1,IEDGE) == CEELEM(NOD1,ISEG)) .AND. & ! same inod1 + (EDGETRI(NOD2,IEDGE) == CEELEM(NOD2,ISEG)) .AND. & ! same inod2 + (LOCBOD == INDSEG(4,ISEG)) ) THEN ! same ibod - X1AXIS_LOOP3 : DO X1AXIS=IAXIS,KAXIS - CEI_AXIS(LOW_IND:HIGH_IND) = IDCF_XYZ(LOW_IND:HIGH_IND,X1AXIS) - DO SIDE=LOW_IND,HIGH_IND - ! Low High face: - IF ( FSID_XYZ(SIDE,X1AXIS) == CC_GASPHASE ) THEN - ! Regular Face, build 4 vertices + face: - NFACE_CELL = NFACE_CELL + 1 - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED/) - ! CC_FTYPE_RCGAS=0, regular face. - ELSEIF (FSID_XYZ(SIDE,X1AXIS) == CC_CUTCFE ) THEN - ! GasPhase CUT_FACE, add all cut-faces on these Cartesian cell + nodes - CEI = CEI_AXIS(SIDE) - DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE - NFACE_CELL = NFACE_CELL + 1 - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL)=(/ CC_FTYPE_CFGAS,SIDE,X1AXIS,CEI,ICF,CC_UNDEFINED/) - ! CC_FTYPE_CFGAS=1 - ENDDO + SELECT CASE(INDSEG(1,ISEG)) + ! Only one triangle in list: + CASE(1) + IF ( LOCTRI /= INDSEG(2,ISEG) ) THEN + INDSEG(1,ISEG) = 2 + INDSEG(3,ISEG) = LOCTRI ! add triangle 2nd. ENDIF - ENDDO - ENDDO X1AXIS_LOOP3 - - ! Now add INBOUNDARY faces of the cell: - CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) - IF ( CEI > 0 ) THEN - DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE - NFACE_CELL = NFACE_CELL + 1 - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB, 0, 0, CEI, ICF, CC_UNDEFINED /) - ! CC_FTYPE_CFINB in Cart-cell. - ENDDO - ENDIF - - VOL(1) = DXCELL(I)*DYCELL(J)*DZCELL(K) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZCELL(K) /) - - ! Load into CUT_CELL data structure - NCUTCELL = MESHES(NM)%N_CUTCELL_MESH + MESHES(NM)%N_GCCUTCELL_MESH + 1 - IF (INTGC_FLG==LOW_IND) THEN - MESHES(NM)%N_CUTCELL_MESH = NCUTCELL - ELSE - MESHES(NM)%N_GCCUTCELL_MESH = MESHES(NM)%N_GCCUTCELL_MESH + 1 - ENDIF - MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = NCUTCELL - - ! Resize array MESHES(NM)%CUT_CELL if necessary: - CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) - - ! Add cut-cell NCUTCELL entry: - MESHES(NM)%CUT_CELL(NCUTCELL)%IJK(IAXIS:KAXIS) = (/ I, J, K /) - MESHES(NM)%CUT_CELL(NCUTCELL)%NCELL = NCELL - MESHES(NM)%CUT_CELL(NCUTCELL)%NFACE_CELL= NFACE_CELL - CALL NEW_CELL_ALLOC(NM,NCUTCELL,NCELL,NFACE_CELL,NCFACE_CUTCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%CCELEM(1:NCFACE_CUTCELL,1) = (/ 6, 1, 2, 3, 4, 5, 6 /) - MESHES(NM)%CUT_CELL(NCUTCELL)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) = & - FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%VOLUME(1:NCELL) = VOL(1:NCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%XYZCEN(IAXIS:KAXIS,1:NCELL) = XYZCEN(IAXIS:KAXIS,1:NCELL) - - ENDDO + INLIST = .TRUE. + EXIT + ! Two triangles in list: + CASE(2) + IF ( (LOCTRI == INDSEG(2,ISEG)) .OR. & + (LOCTRI == INDSEG(3,ISEG)) ) THEN + INLIST = .TRUE. + EXIT + ENDIF + END SELECT + ENDIF ENDDO - ENDDO - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNT ) + IF ( .NOT.INLIST ) THEN ! Edge not in list. + NEDGE = NEDGE + 1 + CEELEM(NOD1:NOD2,NEDGE) = EDGETRI(NOD1:NOD2,IEDGE) -ENDDO INTGC_FLG_LOOP2 + ! Here we have to figure out if segment belongs to a triangles side: + SEG_IN_SIDE = .FALSE. + DO IPT=1,NTVERT + ! Triangle side nodes: + XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD1,IPT) ) + XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD2,IPT) ) -DEALLOCATE(GEOMFACE,GEOMCELL) + ! Segment points: + XP1(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD1,NEDGE)) + XP2(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD2,NEDGE)) -END SUBROUTINE GET_REGULAR_CUTCELLS_BOX + VECS(IAXIS:JAXIS) = XY2(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) + VECP1(IAXIS:JAXIS) = XP1(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) + VECP2(IAXIS:JAXIS) = XP2(IAXIS:JAXIS) - XY1(IAXIS:JAXIS) + CROSSP1 = ABS(VECS(IAXIS)*VECP1(JAXIS)-VECS(JAXIS)*VECP1(IAXIS)) + CROSSP2 = ABS(VECS(IAXIS)*VECP2(JAXIS)-VECS(JAXIS)*VECP2(IAXIS)) -! --------------------- DEALLOCATE_CUTCELLS_CONN_MESH -------------------------- + IF ( (CROSSP1+CROSSP2) < GEOMEPS ) THEN + SEG_IN_SIDE = .TRUE. + EXIT + ENDIF + ENDDO + IF ( SEG_IN_SIDE ) THEN + EDGE_TRI = GEOMETRY(LOCBOD)%FACE_EDGES(IPT,LOCTRI) ! WSTRIED + VEC3(1) = GEOMETRY(LOCBOD)%EDGE_FACES(1,EDGE_TRI) ! WSEDTRI + VEC3(2) = GEOMETRY(LOCBOD)%EDGE_FACES(2,EDGE_TRI) + VEC3(3) = GEOMETRY(LOCBOD)%EDGE_FACES(4,EDGE_TRI) + INDSEG((/1,2,3,4/),NEDGE) = (/ VEC3(1), VEC3(2), VEC3(3), LOCBOD /) + ELSE + INDSEG((/1,2,3,4/),NEDGE) = (/ 1, LOCTRI, 0, LOCBOD /) + ENDIF + ENDIF + ENDDO -SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH(NM) +ENDDO -INTEGER, INTENT(IN) :: NM +! Now define cut-edges from solid-solid segments: +DO IWSSEG=1,BODINT_PLANE%NSEGS -INTEGER :: ICC, ICF, I, J, K, DO_BNCF=1 -INTEGER, PARAMETER :: LOIN=-1 -INTEGER, PARAMETER :: HIIN= 2 + NINTP_SEG = 0 + SEGNODS = CC_UNDEFINED -! Cut-cells and GASPHASE cut-faces: -DO K=-CCGUARD,MESHES(NM)%KBAR+CCGUARD - IF(K>LOIN .AND. KMESHES(NM)%KBAR+LOIN .AND. KLOIN .AND. JMESHES(NM)%JBAR+LOIN .AND. JLOIN .AND. IMESHES(NM)%IBAR+LOIN .AND. I0) CALL CELL_DEALLOC(NM,ICC) ! Deallocate this CUT_CELL array container: - ! IAXIS cut-face: - ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,IAXIS) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) - ! JAXIS cut-face: - ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,JAXIS) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) - ! KAXIS cut-face: - ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,KAXIS) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) - ENDDO + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,IWSSEG) + DO INOD=NOD1,NOD2 + XYEL(IAXIS:JAXIS,INOD) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) ,SEG(INOD)) ENDDO -ENDDO -! INBOUNDARY cut-faces: -DO K=-CCGUARD,MESHES(NM)%KBAR+CCGUARD - DO J=-CCGUARD,MESHES(NM)%JBAR+CCGUARD - DO I=-CCGUARD,MESHES(NM)%IBAR+CCGUARD - ICF = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF,DO_BNCF) ! Deallocate this CUT_FACE array fields, except NFACE, XYZCEN. + ! Cycle if Edges BBOX not intersecting face: + OUTX2= ((X2FMIN-MAXVAL(XYEL(IAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(IAXIS,NOD1:NOD2))-X2FMAX) > GEOMEPS) ! Segment out of Face in x2 dir + OUTX3= ((X3FMIN-MAXVAL(XYEL(JAXIS,NOD1:NOD2))) > GEOMEPS) .OR. & + ((MINVAL(XYEL(JAXIS,NOD1:NOD2))-X3FMAX) > GEOMEPS) ! Segment out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 + IF (OUTFACE) CYCLE + + ! Now define nodes for this CEELEM: + ! a-1. Test if Segments vertices Lay on Faces area, including face boundary: + DO IPT=1,NSVERT + OUTX2= ((X2FMIN-XYEL(IAXIS,IPT)) > GEOMEPS) .OR. & + ((XYEL(IAXIS,IPT)-X2FMAX) > GEOMEPS) ! Triang out of Face in x2 dir + OUTX3= ((X3FMIN-XYEL(JAXIS,IPT)) > GEOMEPS) .OR. & + ((XYEL(JAXIS,IPT)-X3FMAX) > GEOMEPS) ! Triang out of Face in x3 dir + OUTFACE = OUTX2 .OR. OUTX3 + IF ( OUTFACE ) CYCLE + + ! Insertion add point to intersection list: + XP(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,IPT) + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) + + ! Insert sort node to triangles local list + TRUETHAT = .TRUE. + DO INP=1,NINTP_SEG + IF (SEGNODS(INP) == INOD) THEN + TRUETHAT = .FALSE. + EXIT + ENDIF ENDDO + IF ( TRUETHAT ) THEN ! new inod entry on list + NINTP_SEG = NINTP_SEG + 1 + SEGNODS(NINTP_SEG) = INOD + ENDIF ENDDO -ENDDO -IF(ALLOCATED(MESHES(NM)%VERTVAR)) DEALLOCATE(MESHES(NM)%VERTVAR) -IF(ALLOCATED(MESHES(NM)%ECVAR)) DEALLOCATE(MESHES(NM)%ECVAR) -RETURN -END SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH + IF(NINTP_SEG < 2) THEN + ! b. Now add face edge - SS edge intersection points: + ! x2 segments: + DO MYAXIS=IAXIS,JAXIS + SELECT CASE(MYAXIS) + CASE(IAXIS) + XIAXIS = IAXIS + XJAXIS = JAXIS + XIPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) + XJPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) + CASE(JAXIS) + XIAXIS = JAXIS + XJAXIS = IAXIS + XIPLNS(LOW_IND:HIGH_IND) = (/ X3FMIN, X3FMAX /) + XJPLNS(LOW_IND:HIGH_IND) = (/ X2FMIN, X2FMAX /) + END SELECT -! ----------------------- DEALLOCATE_BODINT_PLANE ------------------------------ + DO JPL=LOW_IND,HIGH_IND -SUBROUTINE DEALLOCATE_BODINT_PLANE(BODINT_PLANE) + XJPLN = XJPLNS(JPL) -TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE + XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD1) ) + XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD2) ) -IF ( ALLOCATED(BODINT_PLANE%XYZ) ) DEALLOCATE(BODINT_PLANE%XYZ) -IF ( ALLOCATED(BODINT_PLANE%SGLS) ) DEALLOCATE(BODINT_PLANE%SGLS) -IF ( ALLOCATED(BODINT_PLANE%SEGS) ) DEALLOCATE(BODINT_PLANE%SEGS) -IF ( ALLOCATED(BODINT_PLANE%TRIS) ) DEALLOCATE(BODINT_PLANE%TRIS) -IF ( ALLOCATED(BODINT_PLANE%INDSEG) ) DEALLOCATE(BODINT_PLANE%INDSEG) -IF ( ALLOCATED(BODINT_PLANE%INDTRI) ) DEALLOCATE(BODINT_PLANE%INDTRI) -IF ( ALLOCATED(BODINT_PLANE%X2ALIGNED) ) DEALLOCATE(BODINT_PLANE%X2ALIGNED) -IF ( ALLOCATED(BODINT_PLANE%X3ALIGNED) ) DEALLOCATE(BODINT_PLANE%X3ALIGNED) -IF ( ALLOCATED(BODINT_PLANE%SEGTYPE) ) DEALLOCATE(BODINT_PLANE%SEGTYPE) -IF ( ALLOCATED(BODINT_PLANE%NOD_PERM) ) DEALLOCATE(BODINT_PLANE%NOD_PERM) -IF ( ALLOCATED(BODINT_PLANE%NBCROSS) ) DEALLOCATE(BODINT_PLANE%NBCROSS) -IF ( ALLOCATED(BODINT_PLANE%SVAR) ) DEALLOCATE(BODINT_PLANE%SVAR) -IF ( ALLOCATED(BODINT_PLANE%X1NVEC) ) DEALLOCATE(BODINT_PLANE%X1NVEC) -IF ( ALLOCATED(BODINT_PLANE%AINV) ) DEALLOCATE(BODINT_PLANE%AINV) -IF ( ALLOCATED(BODINT_PLANE%TBAXIS(IAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(IAXIS)%TRIBIN) -IF ( ALLOCATED(BODINT_PLANE%TBAXIS(JAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(JAXIS)%TRIBIN) -IF ( ALLOCATED(BODINT_PLANE%TBAXIS(KAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(KAXIS)%TRIBIN) + ! b-1. Drop if Edge on one side of segment ray: + MAXXJ = MAX(XY1(XJAXIS),XY2(XJAXIS)) + MINXJ = MIN(XY1(XJAXIS),XY2(XJAXIS)) + OUTPLANE1 = ((XJPLN-MAXXJ) > GEOMEPS) .OR. ((MINXJ-XJPLN) > GEOMEPS) + IF ( OUTPLANE1 ) CYCLE -RETURN -END SUBROUTINE DEALLOCATE_BODINT_PLANE + ! b-2. Also drop if Edge ouside of face edge limits: + MAXXI = MAX(XY1(XIAXIS),XY2(XIAXIS)) + MINXI = MIN(XY1(XIAXIS),XY2(XIAXIS)) + OUTPLANE2 = ((XIPLNS(LOW_IND)-MAXXI) > GEOMEPS) .OR. ((MINXI-XIPLNS(HIGH_IND)) > GEOMEPS) + IF ( OUTPLANE2 ) CYCLE -! ---------------------- GET_EXT_INB_CUTFACES_TO_CFACE -------------------------------- + ! Test if segment aligned with xi + XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) + IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. -SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE + ! Drop intersections in EDGE nodes: already added. + ! Compute: dot(plnormal, xyzv - xypl): + DOT1 = XY1(XJAXIS) - XJPLN + DOT2 = XY2(XJAXIS) - XJPLN -! Local Variables: -INTEGER :: ICF, CFACE_INDEX_LOCAL, SURF_INDEX -INTEGER :: IVENT -REAL(EB):: ADDMAT(IAXIS:KAXIS,LOW_IND:HIGH_IND) + IF ( ABS(DOT1) <= GEOMEPS ) CYCLE + IF ( ABS(DOT2) <= GEOMEPS ) CYCLE -! GET_CUTCELLS_VERBOSE variables: -INTEGER, ALLOCATABLE, DIMENSION(:) :: NCFACE_BY_MESH + ! Finally regular case: + ! Points 1 on one side of x2 segment, point 2 on the other: + IF ( DOT1*DOT2 < 0._EB ) THEN -TYPE(VENTS_TYPE), POINTER :: VT -TYPE(CFACE_TYPE), POINTER :: CFA + ! Intersection Point along segment: + DS = (XJPLN-XY1(XJAXIS))/(XY2(XJAXIS)-XY1(XJAXIS)) + SVARI = XY1(XIAXIS) + DS*(XY2(XIAXIS)-XY1(XIAXIS)) -IF(GET_CUTCELLS_VERBOSE) CALL CPU_TIME(CPUTIME_START) + OUTSEG= ((XIPLNS(LOW_IND)-SVARI) > -GEOMEPS) .OR. ((SVARI-XIPLNS(HIGH_IND)) > -GEOMEPS) + IF ( OUTSEG ) CYCLE -ALLOCATE(NCFACE_BY_MESH(1:NMESHES)); NCFACE_BY_MESH(1:NMESHES) = 0 -MESH_LOOP_0 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - ! First N_EXTERNAL_CFACE_CELLS: - DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE - CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE - CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE - END SELECT - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO - ! Second N_INTWALL_CFACE_CELLS: - DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - CASE(JAXIS) - IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - CASE(KAXIS) - IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - END SELECT - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO - ! Second N_INTERNAL_CFACE_CELLS: - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE - ! Don't count INB cut-faces inside an OBST: - IF (CELL(CELL_INDEX(CF%IJK(IAXIS),CF%IJK(JAXIS),CF%IJK(KAXIS)))%SOLID) CYCLE - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO -ENDDO MESH_LOOP_0 + ! Insertion add point to intersection list: + XP(XIAXIS) = SVARI + XP(XJAXIS) = XJPLN + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) -IF(GET_CUTCELLS_VERBOSE) THEN - CALL MPI_ALLREDUCE(MPI_IN_PLACE,NCFACE_BY_MESH(1),NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) - WRITE(LU_SETCC,'(A,I10)',advance='no') ' 4. Generating CFACES from cut-faces, total CFACE_CELLS=', & - SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,I10)') ' Total number of CFACES in all processes=', & - SUM(NCFACE_BY_MESH(1:NMESHES)) - WRITE(LU_ERR ,'(A,I10)',advance='no') & - ' 4. Process 0 Generating CFACES from cut-faces, total CFACE_CELLS=', & - SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) + ! Insert sort node to EDGES local list + TRUETHAT = .TRUE. + DO INP=1,NINTP_SEG + IF (SEGNODS(INP) == INOD) THEN + TRUETHAT = .FALSE. + EXIT + ENDIF + ENDDO + IF (TRUETHAT) THEN ! new inod entry on list + NINTP_SEG = NINTP_SEG + 1 + SEGNODS(NINTP_SEG) = INOD + ENDIF + CYCLE + ENDIF + ENDDO + ENDDO ENDIF -ENDIF -! First mesh Loop, Allocate storage for CFACES, CFACE geometric info: -MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) + IF ( (NINTP_SEG < 2) .OR. (SEGNODS(NOD1) == SEGNODS(NOD2)) ) CYCLE - ! ALLOCATE to zero size - IF(ALLOCATED(MESHES(NM)%CFACE)) DEALLOCATE(MESHES(NM)%CFACE) - MESHES(NM)%N_CFACE_CELLS_DIM = NCFACE_BY_MESH(NM) - ALLOCATE(MESHES(NM)%CFACE(0:MESHES(NM)%N_CFACE_CELLS_DIM)) + ! Test if Edge already on list: + INLIST = .FALSE. + DO ISEG=1,NEDGE - ALLOCATE(MESHES(NM)%FACE_WORK1(MESHES(NM)%N_CFACE_CELLS_DIM)) - ALLOCATE(MESHES(NM)%FACE_WORK2(MESHES(NM)%N_CFACE_CELLS_DIM)) - ALLOCATE(MESHES(NM)%FACE_WORK3(MESHES(NM)%N_CFACE_CELLS_DIM)) + IF ( (SEGNODS(NOD1) == CEELEM(NOD1,ISEG)) .AND. & ! same inod1 + (SEGNODS(NOD2) == CEELEM(NOD2,ISEG)) .AND. & ! same inod2 + (BODINT_PLANE%INDSEG(4,IWSSEG) == INDSEG(4,ISEG)) ) THEN ! same ibod - ! Define pointers among External CC_GASPHASE CUT_FACE and CFACE (N_EXTERNAL_CFACE_CELLS): - CFACE_INDEX_LOCAL = 0 - DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE - CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE - CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE - END SELECT - ! Now get WALL cell SURF_INDEX: - IW = 0 - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (I==0 ) IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-1) - IF (I==IBAR) IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( 1) - CASE(JAXIS) - IF (J==0 ) IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-2) - IF (J==JBAR) IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( 2) - CASE(KAXIS) - IF (K==0 ) IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-3) - IF (K==KBAR) IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( 3) - END SELECT - SURF_INDEX = WALL(IW)%SURF_INDEX - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) - ENDDO - ENDDO - MESHES(NM)%N_EXTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - ! Define pointers among internal CC_GASPHASE CUT_FACE and CFACE (N_INTWALL_CFACE_CELLS): - DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST, or don't lay on a WALL_CELL: - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE - ENDIF - CASE(JAXIS) - IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE - ENDIF - CASE(KAXIS) - IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + IF (ANY(BODINT_PLANE%INDSEG(2:3,IWSSEG) == INDSEG(2,ISEG))) THEN + ! Edge already in list, Use SS Edge INDSEG: + INDSEG(1:4,ISEG) = BODINT_PLANE%INDSEG(1:4,IWSSEG) + INLIST = .TRUE. + EXIT + ELSE + WRITE(LU_ERR,*) "Error in GET_TRIANG_FACE_INT: SS EDGE Triangles not on 2 WS triang list INDSEG." ENDIF - END SELECT - SURF_INDEX = WALL(IW)%SURF_INDEX - IF(.NOT.ALLOCATED(CF%CFACE_INDEX)) THEN; ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) - ELSEIF (SIZE(CF%CFACE_INDEX,DIM=1)/=CF%NFACE)THEN - DEALLOCATE(CF%CFACE_INDEX); ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) - ENDIF - IF(.NOT.ALLOCATED(CF%SURF_INDEX)) THEN; ALLOCATE(CF%SURF_INDEX(CF%NFACE)) - ELSEIF (SIZE(CF%SURF_INDEX,DIM=1)/=CF%NFACE)THEN - DEALLOCATE(CF%SURF_INDEX); ALLOCATE(CF%SURF_INDEX(CF%NFACE)) ENDIF - - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) - ENDDO - ENDDO - MESHES(NM)%N_INTWALL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%N_EXTERNAL_CFACE_CELLS - MESHES(NM)%INTERNAL_CFACE_CELLS_LB = MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%N_INTWALL_CFACE_CELLS - ! Define pointers among CC_INBOUNDARY CUT_FACE and CFACE (N_INTERNAL_CFACE_CELLS): - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - CF => MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS) - ! Don't count INB cut-faces inside an OBST: - IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - SURF_INDEX = CF%SURF_INDEX(IFACE) - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.TRUE.) - ENDDO - IF(ALLOCATED(CF%CFACE_ORIGIN)) DEALLOCATE(CF%CFACE_ORIGIN) ENDDO - MESHES(NM)%N_INTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%INTERNAL_CFACE_CELLS_LB -ENDDO MESH_LOOP_1 -! Second loop, apply VENTS to change SURF_ID associated with CFACEs: -MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) + IF ( .NOT.INLIST ) THEN ! Edge not in list. + NEDGE = NEDGE + 1 + CEELEM(NOD1:NOD2,NEDGE) = SEGNODS(NOD1:NOD2) + INDSEG(1:4,NEDGE) = BODINT_PLANE%INDSEG(1:4,IWSSEG) + ENDIF +ENDDO - ! ! Currently : Modify CFACE SURF_INDEX with VENT information: This needs more development. +! Populate XYVERT points array: +IF(SIZE_X2X3VERT > SIZE(XYVERT,DIM=2)) THEN + WRITE(LU_ERR,*) 'Error in GET_TRIANG_FACE_INT : SIZE_X2X3VERT in greater than SIZE(XYVERT,DIM=2).' + CALL SHUTDOWN('Shutting down..') +ENDIF +XYVERT = 0._EB +XYVERT(IAXIS:JAXIS,1:SIZE_X2X3VERT) = X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT) +NVERT = NINTP +IF (NVERT > 0) INB_FLG = .TRUE. - VENT_LOOP : DO IVENT=1,MESHES(NM)%N_VENT - VT => VENTS(IVENT) - IF(.NOT.VT%GEOM) CYCLE VENT_LOOP ! Do not apply vent to Geometries. +DEALLOCATE(FVERT_IN_TRIANG, TRIVERT_IN_FACE) - ! This test is a simplified test for VENTS changing the CFACE SURF_ID to VENT SURF_ID for all CFACEs whose - ! centroid locations lay within the frame of the IOR grid aligned VENT: - ADDMAT = 0._EB; - SELECT CASE(ABS(VT%IOR)) - CASE(IAXIS) - ADDMAT(IAXIS,LOW_IND) = -(XF_MAX-XS_MIN) ! -DX(VT%I1) Set normal size to 2 times domain size. - ADDMAT(IAXIS,HIGH_IND) = (XF_MAX-XS_MIN) ! DX(VT%I2) XF_MAX, etc. defined in cons.f90. - CASE(JAXIS) - ADDMAT(JAXIS,LOW_IND) = -(YF_MAX-YS_MIN) ! -DY(VT%J1) - ADDMAT(JAXIS,HIGH_IND) = (YF_MAX-YS_MIN) ! DY(VT%J2) - CASE(KAXIS) - ADDMAT(KAXIS,LOW_IND) = -(ZF_MAX-ZS_MIN) ! -DZ(VT%K1) - ADDMAT(KAXIS,HIGH_IND) = (ZF_MAX-ZS_MIN) ! DZ(VT%K2) - END SELECT - ! CFACE Loop to modify SURF_INDEX in INTERNAL_CFACE_CELLS: - CFACE_LOOP_2 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - CFA => CFACE(CFACE_INDEX_LOCAL) - BC => BOUNDARY_COORD(CFA%BC_INDEX) - IF (BC%X < X(VT%I1)+ADDMAT(IAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%X > X(VT%I2)+ADDMAT(IAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - IF (BC%Y < Y(VT%J1)+ADDMAT(JAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%Y > Y(VT%J2)+ADDMAT(JAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - IF (BC%Z < Z(VT%K1)+ADDMAT(KAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%Z > Z(VT%K2)+ADDMAT(KAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - CFA%VENT_INDEX = IVENT - CFA%SURF_INDEX = VT%SURF_INDEX - ENDDO CFACE_LOOP_2 - ENDDO VENT_LOOP -ENDDO MESH_LOOP_2 -! - At this pont all final values of SURF_INDEX have been given to CFACEs. +RETURN +END SUBROUTINE GET_TRIANG_FACE_INT -! Third loop, 1. Compute final FDS area integrals by SURF_ID and GEOM. -! 2. Compute input areas by SURF_ID and GEOM. First sum over GEOM FACES SURF_IDs, -! then VENTS input surfaces are assigned to corresponding GEOMs and SURF_IDs if present (VENTs take precedence). -IF(N_GEOMETRY>0) THEN - ALLOCATE(FDS_AREA_GEOM(0:N_SURF,N_GEOMETRY)); FDS_AREA_GEOM = 0._EB -ENDIF -MESH_LOOP_3 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - CFA => CFACE(CFACE_INDEX_LOCAL) - ICF = CFA%CUT_FACE_IND1; IFACE= CFA%CUT_FACE_IND2 - I = CUT_FACE(ICF)%BODTRI(1,IFACE) - IF(I>0) FDS_AREA_GEOM(CFA%SURF_INDEX,I) = FDS_AREA_GEOM(CFA%SURF_INDEX,I) + CFA%AREA - ENDDO -ENDDO MESH_LOOP_3 -! Sum FDS and INPUT areas per SURF_ID and GEOM (all reduce sum): -IF(N_GEOMETRY>0) & -CALL MPI_ALLREDUCE(MPI_IN_PLACE, FDS_AREA_GEOM(0,1), (N_SURF+1)*N_GEOMETRY, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) +! ------------------------- INSERT_POINT_2D ------------------------------------- -! Fourth Loop: Assign AREA_ADJUST for CFACEs, and assign BC info to CFACEs: -MESH_LOOP_4 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) +SUBROUTINE INSERT_POINT_2D(XP,NVERT,SIZE_XYVERT,XYVERT,INOD) - ! BCs related information for INTERNAL CFACE CELLS: - CFACE_LOOP_4 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - ICF = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND1 - IFACE = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND2 - SURF_INDEX = CFACE(CFACE_INDEX_LOCAL)%SURF_INDEX - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_TWO,IS_INB=.TRUE.) - ENDDO CFACE_LOOP_4 +REAL(EB), INTENT(IN) :: XP(IAXIS:JAXIS) +INTEGER, INTENT(INOUT) :: NVERT +INTEGER, INTENT(INOUT) :: SIZE_XYVERT +REAL(EB), ALLOCATABLE, INTENT(INOUT) :: XYVERT(:,:) +INTEGER, INTENT(OUT) :: INOD -ENDDO MESH_LOOP_4 +! Local Variables: +LOGICAL :: INLIST +REAL(EB):: DV(IAXIS:JAXIS), DVNORM +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYVERT_AUX -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' - IF (MY_RANK==0) WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' +INLIST = .FALSE. +DO INOD=1,NVERT + DV(IAXIS:JAXIS) = XP(IAXIS:JAXIS) - XYVERT(IAXIS:JAXIS,INOD) + DVNORM = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB ) + IF ( DVNORM < GEOMEPS ) THEN + INLIST = .TRUE. + EXIT + ENDIF +ENDDO +IF ( .NOT.INLIST ) THEN + NVERT = NVERT + 1 + INOD = NVERT + ! If NVERT > SIZE(XYVERT,DIM=2) reallocate: + IF(NVERT > SIZE_XYVERT) THEN + ALLOCATE(XYVERT_AUX(IAXIS:JAXIS,1:SIZE_XYVERT)); XYVERT_AUX(:,:) = XYVERT(:,:) + DEALLOCATE(XYVERT); ALLOCATE(XYVERT(IAXIS:JAXIS,SIZE_XYVERT+DELTA_VERT)); XYVERT = 0._EB + XYVERT(IAXIS:JAXIS,1:SIZE_XYVERT) = XYVERT_AUX(IAXIS:JAXIS,1:SIZE_XYVERT) + SIZE_XYVERT = SIZE_XYVERT + DELTA_VERT + ENDIF + XYVERT(IAXIS:JAXIS,INOD) = XP(IAXIS:JAXIS) ENDIF RETURN -END SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE - - -! ------------------------- SET_GC_CUTCELLS_3D ----------------------------------- - -SUBROUTINE SET_GC_CUTCELLS_3D +END SUBROUTINE INSERT_POINT_2D -! Local Variables: -INTEGER :: IW,II,JJ,KK,IOR,IIO,JJO,KKO,IIF,JJF,KKF,IIOF,JJOF,KKOF,ICF,ICOF,X1AXIS,ICC,NMICC,NOFC,N_CF,N_CRT -REAL(EB):: XNM, XNOM -TYPE (WALL_TYPE), POINTER :: WC -TYPE (EXTERNAL_WALL_TYPE), POINTER :: EWC -LOGICAL :: WC_PERIODIC, TEST_ICC -REAL(EB):: AREA_NM, AREA_NOM, AREA_CRT +! ----------------------- DEALLOCATE_BODINT_PLANE ------------------------------ +SUBROUTINE DEALLOCATE_BODINT_PLANE(BODINT_PLANE) -IF (CCGUARD == 0) RETURN +TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE -IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' - ENDIF -ENDIF +IF ( ALLOCATED(BODINT_PLANE%XYZ) ) DEALLOCATE(BODINT_PLANE%XYZ) +IF ( ALLOCATED(BODINT_PLANE%SGLS) ) DEALLOCATE(BODINT_PLANE%SGLS) +IF ( ALLOCATED(BODINT_PLANE%SEGS) ) DEALLOCATE(BODINT_PLANE%SEGS) +IF ( ALLOCATED(BODINT_PLANE%TRIS) ) DEALLOCATE(BODINT_PLANE%TRIS) +IF ( ALLOCATED(BODINT_PLANE%INDSEG) ) DEALLOCATE(BODINT_PLANE%INDSEG) +IF ( ALLOCATED(BODINT_PLANE%INDTRI) ) DEALLOCATE(BODINT_PLANE%INDTRI) +IF ( ALLOCATED(BODINT_PLANE%X2ALIGNED) ) DEALLOCATE(BODINT_PLANE%X2ALIGNED) +IF ( ALLOCATED(BODINT_PLANE%X3ALIGNED) ) DEALLOCATE(BODINT_PLANE%X3ALIGNED) +IF ( ALLOCATED(BODINT_PLANE%SEGTYPE) ) DEALLOCATE(BODINT_PLANE%SEGTYPE) +IF ( ALLOCATED(BODINT_PLANE%NOD_PERM) ) DEALLOCATE(BODINT_PLANE%NOD_PERM) +IF ( ALLOCATED(BODINT_PLANE%NBCROSS) ) DEALLOCATE(BODINT_PLANE%NBCROSS) +IF ( ALLOCATED(BODINT_PLANE%SVAR) ) DEALLOCATE(BODINT_PLANE%SVAR) +IF ( ALLOCATED(BODINT_PLANE%X1NVEC) ) DEALLOCATE(BODINT_PLANE%X1NVEC) +IF ( ALLOCATED(BODINT_PLANE%AINV) ) DEALLOCATE(BODINT_PLANE%AINV) +IF ( ALLOCATED(BODINT_PLANE%TBAXIS(IAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(IAXIS)%TRIBIN) +IF ( ALLOCATED(BODINT_PLANE%TBAXIS(JAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(JAXIS)%TRIBIN) +IF ( ALLOCATED(BODINT_PLANE%TBAXIS(KAXIS)%TRIBIN) ) DEALLOCATE(BODINT_PLANE%TBAXIS(KAXIS)%TRIBIN) -! Meshes Loop: -! First Mesh Loop: -! Test if NOM mesh cells are of the same size or smaller than NM mesh that areas match: -MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX +RETURN +END SUBROUTINE DEALLOCATE_BODINT_PLANE - IF (MESHES(NM)%N_CUTFACE_MESH==0) CYCLE MESH_LOOP_1 - CALL POINT_TO_MESH(NM) +SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH_WORK(FIRST_CALL_ARG,FIRST_CALL_ARG2) - EXTERNAL_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS +LOGICAL, INTENT(INOUT) :: FIRST_CALL_ARG, FIRST_CALL_ARG2 - WC=>WALL(IW) - EWC=>EXTERNAL_WALL(IW) - BC=>BOUNDARY_COORD(WC%BC_INDEX) - B1=>BOUNDARY_PROP1(WC%B1_INDEX) - IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & - WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_1 +! Allocate BODINT_PLANE for plane intersections on X1AXIS loop: +IF(PERIODIC_TEST/=7 .AND. PERIODIC_TEST/=11) THEN + CALL ALLOCATE_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) ! To be used in SET_CUTCELLS_3D, GET_CARTCELL_CUTFACES. + CALL ALLOCATE_BODINT_PLANE(BODINT_PLANE2,FIRST_CALL_ARG2) ! To be used in GET_IS_SOLID_3D. +ENDIF - II = BC%II - JJ = BC%JJ - KK = BC%KK - IOR = BC%IOR +! Allocate Intersection variables: +ALLOCATE(CC_SVAR_CRS(CC_MAXCROSS_X2),CC_IS_CRS(CC_MAXCROSS_X2),CC_SEG_CRS(CC_MAXCROSS_X2)) +ALLOCATE(CC_BDNUM_CRS(0:CC_MAXCROSS_X2),CC_BDNUM_CRS_AUX(0:CC_MAXCROSS_X2)) +ALLOCATE(CC_IS_CRS2(LOW_IND:HIGH_IND+1,CC_MAXCROSS_X2),CC_SEG_TAN(IAXIS:JAXIS,CC_MAXCROSS_X2)) - ! Skip if no cut-faces present on this WC: - ! Define underlying Cartesian faces indexes: - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-IAXIS) ! Higher X boundary for Mesh NM. - IIF = II - 1; JJF = JJ ; KKF = KK - CASE( JAXIS) ! Lower Y boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-JAXIS) ! Higher Y boundary for Mesh NM. - IIF = II ; JJF = JJ - 1; KKF = KK - CASE( KAXIS) ! Lower Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-KAXIS) ! Higher Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - 1 - END SELECT - X1AXIS = ABS(IOR) - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE EXTERNAL_WALL_LOOP_1 +END SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH_WORK - ! Gas cut-face area in wall-cell IW face: - ICF = FCVAR(IIF,JJF,KKF,CC_IDCF,X1AXIS) - AREA_NM = SUM(CUT_FACE(ICF)%AREA(1:CUT_FACE(ICF)%NFACE)) - IF(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN - NOM = EWC%NOM ! Use Other Mesh Data. - IF(MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_1 - ! Now Obtain the CUT_FACE for the same face on NM-NOM: +SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH_WORK - AREA_NOM = 0._EB; N_CF=0; N_CRT=0 - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) - CASE(-IAXIS) ! Higher X boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO- 1; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) - CASE( JAXIS) ! Lower Y boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) - CASE(-JAXIS) ! Higher Y boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO ; JJOF= JJO- 1; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) - CASE( KAXIS) ! Lower Z boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) - CASE(-KAXIS) ! Higher Z boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO- 1; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) - END SELECT - IF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_FGSC,X1AXIS) == CC_GASPHASE) THEN - AREA_NOM = AREA_NOM + AREA_CRT - N_CRT = N_CRT + 1 - ELSEIF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) > 0) THEN ! there are gasphase cut-faces - ICOF = MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) - AREA_NOM = AREA_NOM + SUM(MESHES(NOM)%CUT_FACE(ICOF)%AREA(1:MESHES(NOM)%CUT_FACE(ICOF)%NFACE)) - N_CF = N_CF + 1 - ENDIF - ENDDO - ENDDO - ENDDO +CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE) +CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE2) - ! Check if: - ! 1. other mesh faces are more than one -> areas match. - ! 2. other mesh face and size of cartesian faces the same -> areas match. - ! 3. Left the case of fine mesh face with OMESH face coarse. - NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 - IF ( (NOFC > 1) .OR. (ABS(B1%AREA-AREA_CRT) < GEOMEPS) )THEN - IF(ABS(AREA_NM-AREA_NOM) > ADIFF_INFO_FACTOR*AREA_CRT) THEN - WRITE(LU_ERR,*) 'SET_GC_CUTCELLS_3D Error: MESH=',NM,', CUT_FACE=',ICF,' does not match OMESH=',& - NOM,', with CUT_FACEs,CRT_FACEs=',N_CF,N_CRT,', area difference=',& - ABS(AREA_NM-AREA_NOM),', GEOMEPS=',GEOMEPS - WRITE(LU_ERR,*) 'CUT FACE=',ICF,MESHES(NM)%CUT_FACE(ICF)%IJK(1:4),':',MESHES(NM)%CUT_FACE(ICF)%STATUS - ENDIF - ENDIF +! Deallocate Intersection variables: +DEALLOCATE(CC_SVAR_CRS,CC_IS_CRS,CC_SEG_CRS,CC_BDNUM_CRS,CC_BDNUM_CRS_AUX,CC_IS_CRS2,CC_SEG_TAN) - ENDIF +END SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH_WORK - ENDDO EXTERNAL_WALL_LOOP_1 -ENDDO MESH_LOOP_1 +SUBROUTINE CC_GRID_ALLOCATE_CELLRT(ISTR,IEND,JSTR,JEND,KSTR,KEND) +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -! Second mesh loop: -! Define cut-cell data on guard-cell region to be communicated: -MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX +IF (ALLOCATED(CELLRT)) DEALLOCATE(CELLRT) +ALLOCATE(CELLRT(ISTR:IEND,JSTR:JEND,KSTR:KEND)) +CELLRT(:,:,:) = .FALSE. - IF ((MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH)==0) CYCLE MESH_LOOP_2 +END SUBROUTINE CC_GRID_ALLOCATE_CELLRT - CALL POINT_TO_MESH(NM) - EXTERNAL_WALL_LOOP_2 : DO IW=1,N_EXTERNAL_WALL_CELLS +SUBROUTINE CC_GRID_RELEASE_CELLRT - WC=>WALL(IW) - BC=>BOUNDARY_COORD(WC%BC_INDEX) - EWC=>EXTERNAL_WALL(IW) - IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & - WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_2 +IF (ALLOCATED(CELLRT)) DEALLOCATE(CELLRT) - II = BC%II - JJ = BC%JJ - KK = BC%KK - IOR = BC%IOR - NOM = EWC%NOM ! Use Other Mesh Data. +END SUBROUTINE CC_GRID_RELEASE_CELLRT - IF (NOM>0) THEN - IF (MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_2 - ENDIF - IF (WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN +SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH_WORK(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) +USE TRAN, ONLY : TRANS - ! Skip if no cut-faces present on this WC: - ! Define underlying Cartesian faces indexes: - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-IAXIS) ! Higher X boundary for Mesh NM. - IIF = II - 1; JJF = JJ ; KKF = KK - CASE( JAXIS) ! Lower Y boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-JAXIS) ! Higher Y boundary for Mesh NM. - IIF = II ; JJF = JJ - 1; KKF = KK - CASE( KAXIS) ! Lower Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-KAXIS) ! Higher Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - 1 - END SELECT - X1AXIS = ABS(IOR) - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) CYCLE EXTERNAL_WALL_LOOP_2 +INTEGER, INTENT(IN) :: NM, ISTR, IEND, JSTR, JEND, KSTR, KEND +REAL(EB), INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX - IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN - TEST_ICC = .TRUE. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - TEST_ICC = TEST_ICC .AND. (MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) <= 0) - ENDDO - ENDDO - ENDDO +INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI +INTEGER :: I,J,K,KK +INTEGER :: X1AXIS, X2AXIS, X3AXIS +INTEGER :: XIAXIS, XJAXIS, XKAXIS +INTEGER :: X2LO, X2HI, X3LO, X3HI +INTEGER :: X2LO_CELL, X2HI_CELL, X3LO_CELL, X3HI_CELL +INTEGER, DIMENSION(MAX_DIM) :: INDX1 +REAL(EB), DIMENSION(MAX_DIM) :: PLNORMAL +REAL(EB) :: X1PLN, X3RAY +LOGICAL :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY +REAL(EB) :: CPUTIME, CPUTIME_START +CHARACTER(1), DIMENSION(3), PARAMETER :: AXSTR(1:3) = (/ 'X', 'Y', 'Z' /) - NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) - ! Do test for PERIODIC boundaries. Note: PERIODIC boundaries at this point have been redefined as INTERPOLATED_BOUNDARY, - ! so we test using the Mesh center relative locations. - IF (WC%BOUNDARY_TYPE==INTERPOLATED_BOUNDARY .AND. NMICC > 0 .AND. TEST_ICC) THEN - WC_PERIODIC=.FALSE. - SELECT CASE(IOR) - CASE(-IAXIS) ! High X wall cell. - XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( IAXIS) ! Low X wall cell. - XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE(-JAXIS) ! High Y wall cell. - XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( JAXIS) ! Low Y wall cell. - XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE(-KAXIS) ! High Z wall cell. - XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( KAXIS) ! Low Z wall cell. - XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - END SELECT - IF (WC_PERIODIC) THEN - MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) = 0 ! Set NMICC = 0. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - IF(MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_CGSC)==CC_SOLID) THEN - MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC)=CC_SOLID ! set to Solid. - CYCLE EXTERNAL_WALL_LOOP_2 - ENDIF - ENDDO - ENDDO - ENDDO - ENDIF - ENDIF +CALL POINT_TO_MESH(NM) +M => MESHES(NM) - NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 - ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 - N_CF = 0 - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) - IF (ICC > 0) THEN - N_CF = N_CF + 1 - MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,N_CF) = (/ NOM, ICC /) - NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL - ! Add NCELL cut-cells to OM%NCC_R: - MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 - MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL - ENDIF - ENDDO - ENDDO - ENDDO - MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = N_CF - ENDIF +! Mesh sizes: +NXB=IBAR +NYB=JBAR +NZB=KBAR - ! Here add cut or regular faces to every face on this wall cell: - ! This requires defining the sets of cut and regular faces within the area of each cut or - ! regular face. Option : Use POINT_IN_POLYGON with centroids. To do. +! Do Loop for different x1 planes: +X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS - ELSEIF(WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) THEN - NOM = NM ! Use gas cell data, same mesh. - IIO = BC%IIG - JJO = BC%JJG - KKO = BC%KKG - ! CYCLE if OBJECT face is in the Mirror Boundary, normal out into ghost-cell: - SELECT CASE(IOR) - CASE( IAXIS) - IF(FCVAR(IIO-1,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE - CASE(-IAXIS) - IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE - CASE( JAXIS) - IF(FCVAR(IIO ,JJO-1,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE - CASE(-JAXIS) - IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE - CASE( KAXIS) - IF(FCVAR(IIO ,JJO ,KKO-1,CC_FGSC,KAXIS) == CC_SOLID) CYCLE - CASE(-KAXIS) - IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,KAXIS) == CC_SOLID) CYCLE - END SELECT - IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN - ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC); IF (ICC<1) CYCLE - NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) - NOFC = 1 - ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 - MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,NOFC) = (/ NOM, ICC /) - MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = NOFC - NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL - ! Add NCELL cut-cells to OM%NCC_R: - MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 - MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL - ENDIF + SELECT CASE(X1AXIS) + CASE(IAXIS) + + PLNORMAL = (/ 1._EB, 0._EB, 0._EB/) + ILO = ILO_FACE-CCGUARD; IHI = IHI_FACE+CCGUARD + JLO = JLO_FACE; JHI = JLO_FACE + KLO = KLO_FACE; KHI = KLO_FACE + + ! x2, x3 axes parameters: + X2AXIS = JAXIS; X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD + X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD + + ! location in I,J,K of x2,x2,x3 axes: + XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS + + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(ISTR:IEND),DX1FACE(ISTR:IEND)) + X1FACE = XFACE; DX1FACE = DXFACE + ALLOCATE(X2FACE(JSTR:JEND),DX2FACE(JSTR:JEND)) + X2FACE = YFACE; DX2FACE = DYFACE + ALLOCATE(X3FACE(KSTR:KEND),DX3FACE(KSTR:KEND)) + X3FACE = ZFACE; DX3FACE = DZFACE + + ! x2 cell center parameters: + X2LO_CELL = JLO_CELL-CCGUARD; X2HI_CELL = JHI_CELL+CCGUARD + ALLOCATE(X2CELL(JSTR:JEND),DX2CELL(JSTR:JEND)) + X2CELL = YCELL; DX2CELL = DYCELL + + ! x3 cell center parameters: + X3LO_CELL = KLO_CELL-CCGUARD; X3HI_CELL = KHI_CELL+CCGUARD + ALLOCATE(X3CELL(KSTR:KEND),DX3CELL(KSTR:KEND)) + X3CELL = ZCELL; DX3CELL = DZCELL + + CASE(JAXIS) + + PLNORMAL = (/ 0._EB, 1._EB, 0._EB/) + ILO = ILO_FACE; IHI = ILO_FACE + JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD + KLO = KLO_FACE; KHI = KLO_FACE + + ! x2, x3 axes parameters: + X2AXIS = KAXIS; X2LO = KLO_FACE-CCGUARD; X2HI = KHI_FACE+CCGUARD + X3AXIS = IAXIS; X3LO = ILO_FACE-CCGUARD; X3HI = IHI_FACE+CCGUARD + + ! location in I,J,K of x2,x2,x3 axes: + XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS + + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(JSTR:JEND),DX1FACE(JSTR:JEND)) + X1FACE = YFACE; DX1FACE = DYFACE + ALLOCATE(X2FACE(KSTR:KEND),DX2FACE(KSTR:KEND)) + X2FACE = ZFACE; DX2FACE = DZFACE + ALLOCATE(X3FACE(ISTR:IEND),DX3FACE(ISTR:IEND)) + X3FACE = XFACE; DX3FACE = DXFACE + + ! x2 cell center parameters: + X2LO_CELL = KLO_CELL-CCGUARD; X2HI_CELL = KHI_CELL+CCGUARD + ALLOCATE(X2CELL(KSTR:KEND),DX2CELL(KSTR:KEND)) + X2CELL = ZCELL; DX2CELL = DZCELL + + ! x3 cell center parameters: + X3LO_CELL = ILO_CELL-CCGUARD; X3HI_CELL = IHI_CELL+CCGUARD + ALLOCATE(X3CELL(ISTR:IEND),DX3CELL(ISTR:IEND)) + X3CELL = XCELL; DX3CELL = DXCELL + + CASE(KAXIS) + + PLNORMAL = (/ 0._EB, 0._EB, 1._EB/) + ILO = ILO_FACE; IHI = ILO_FACE + JLO = JLO_FACE; JHI = JLO_FACE + KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD + + ! x2, x3 axes parameters: + X2AXIS = IAXIS; X2LO = ILO_FACE-CCGUARD; X2HI = IHI_FACE+CCGUARD + X3AXIS = JAXIS; X3LO = JLO_FACE-CCGUARD; X3HI = JHI_FACE+CCGUARD + + ! location in I,J,K of x2,x2,x3 axes: + XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS + + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)) + X1FACE = ZFACE; DX1FACE = DZFACE + ALLOCATE(X2FACE(ISTR:IEND),DX2FACE(ISTR:IEND)) + X2FACE = XFACE; DX2FACE = DXFACE + ALLOCATE(X3FACE(JSTR:JEND),DX3FACE(JSTR:JEND)) + X3FACE = YFACE; DX3FACE = DYFACE + + ! x2 cell center parameters: + X2LO_CELL = ILO_CELL-CCGUARD; X2HI_CELL = IHI_CELL+CCGUARD + ALLOCATE(X2CELL(ISTR:IEND),DX2CELL(ISTR:IEND)) + X2CELL = XCELL; DX2CELL = DXCELL + + ! x3 cell center parameters: + X3LO_CELL = JLO_CELL-CCGUARD; X3HI_CELL = JHI_CELL+CCGUARD + ALLOCATE(X3CELL(JSTR:JEND),DX3CELL(JSTR:JEND)) + X3CELL = YCELL; DX3CELL = DYCELL + + END SELECT + + ! Variable that states if raytracing is necessary to define segments + ! status in a cartesian face. + ALLOCATE(FACERT(X2LO_CELL:X2HI_CELL,X3LO_CELL:X3HI_CELL)); + + ! Stretched grid vars: + X1NOC=TRANS(NM)%NOC(X1AXIS) + X2NOC=TRANS(NM)%NOC(X2AXIS) + X3NOC=TRANS(NM)%NOC(X3AXIS) + + IF(GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + IF(X1AXIS < KAXIS) THEN + WRITE(LU_SETCC,'(A,A,A,3I2,A)') ' Computing GEOMs-grid planes intersections for planes in ', & + AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A,A,A,3I2,A)') ' Computing GEOMs-grid planes intersections for planes in ', & + AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' + ENDIF + ELSE + WRITE(LU_SETCC,'(A,A,A,3I2,A)',advance="no") ' Computing GEOMs-grid planes intersections for planes in ', & + AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A,A,A,3I2,A)',advance="no") ' Computing GEOMs-grid planes intersections for planes in ', & + AXSTR(X1AXIS),' direction, local axes X1, X2, X3:',X1AXIS,X2AXIS,X3AXIS,' ..' ENDIF + ENDIF + ENDIF + ! Loop Coordinate Planes: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI - ENDDO EXTERNAL_WALL_LOOP_2 + ! Which Plane? + INDX1(IAXIS:KAXIS) = (/ I, J, K /) + X1PLN = X1FACE(INDX1(X1AXIS)) + + ! Get intersection of body on plane defined by X1PLN, normal to X1AXIS: + TRI_ONPLANE_ONLY =.FALSE. + RAYTRACE_X2_ONLY =.FALSE. + FACERT(:,:) =.FALSE. + CALL GET_BODINT_PLANE(X1AXIS,X1PLN,INDX1(X1AXIS),PLNORMAL,X2AXIS,X3AXIS,& + X2LO,X2HI,X3LO,X3HI,X2FACE,X3FACE,X2LO_CELL,& + X2HI_CELL,X3LO_CELL,X3HI_CELL,TRI_ONPLANE_ONLY,RAYTRACE_X2_ONLY,BODINT_PLANE) + + ! Test that there is an intersection: + IF ((BODINT_PLANE%NSGLS+BODINT_PLANE%NSEGS+BODINT_PLANE%NTRIS) == 0) CYCLE + + ! Drop if node locations outside block plane area: + IF ((X2FACE(X2LO)-MAXVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE + IF ((MINVAL(BODINT_PLANE%XYZ(X2AXIS,1:BODINT_PLANE%NNODS))-X2FACE(X2HI)) > GEOMEPS) CYCLE + IF ((X3FACE(X3LO)-MAXVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))) > GEOMEPS) CYCLE + IF ((MINVAL(BODINT_PLANE%XYZ(X3AXIS,1:BODINT_PLANE%NNODS))-X3FACE(X3HI)) > GEOMEPS) CYCLE + + ! For plane normal to X1AXIS, shoot rays along X2AXIS on all X3AXIS gridline + ! locations, get intersection data: Loop x3 axis locations + DO KK=X3LO,X3HI -ENDDO MESH_LOOP_2 + ! x3 location of ray along x2, on the x2-x3 plane: + X3RAY = X3FACE(KK) + + ! Intersections along x2 for X3RAY x3 location: + CALL GET_X2_INTERSECTIONS(X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN) + IF (STOP_STATUS==SETUP_STOP) RETURN + + ! Drop x2 ray if all intersections are outside of the MESH block domain: + IF (CC_N_CRS > 0) THEN + IF ((X2FACE(X2LO)-CC_SVAR_CRS(CC_N_CRS)) > GEOMEPS) THEN + CYCLE + ELSEIF (CC_SVAR_CRS(1)-X2FACE(X2HI) > GEOMEPS) THEN + CYCLE + ENDIF + ENDIF + + ! Highest Z crossing for I,J=KK,INDX1(X1AXIS) location, clip at ZF+DZ(KBAR): + IF(TERRAIN_CASE .AND. X2AXIS==KAXIS .AND. CC_N_CRS>0) & + GEOM_ZMAX_AUX(KK,INDX1(X1AXIS)) = MIN(X2FACE(KBP1),CC_SVAR_CRS(CC_N_CRS)) + + ! Now for this ray, set vertex types in MESHES(NM)%VERTVAR(:,:,:,CC_VGSC): + CALL GET_X2_VERTVAR(X1AXIS,X2LO,X2HI,NM,I,KK) + + ! Now define Crossings on Cartesian Edges and Body segments: + ! Cartesian cut-edges: + CALL GET_CARTEDGE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & + NM,X2LO_CELL,X2HI_CELL,INDX1,KK) + + ! Set segment crossings: + ! This data is defined by plane, add to current: + ! - BODINT_PLANE : Data structure with information for crossings on + ! body segments. + ! % NBCROSS(1:NSEGS) = Number of crossings + ! on the segment. + ! % SVAR(1:NBCROSS,1:NSEGS) = distance from node 1 + ! along the segment. + CALL GET_BODX2_INTERSECTIONS(X2AXIS,X3AXIS,X3RAY) + + ENDDO ! KK - x3 gridlines. + + ! Now for segments not aligned with x3, define + ! intersections with grid line vertices: + CALL GET_BODX3_INTERSECTIONS(X2AXIS,X3AXIS,X2LO,X2HI) + + ! After these loops all segments should contain points from Node1, + ! cross 1, cross 2, ..., Node2, in ascending sbod order. + ! Time to generate the body CC_INBOUNDARY edges on faces and add + ! to MESHES(NM)%CUT_EDGE: + CALL GET_CARTFACE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS, & + XIAXIS,XJAXIS,XKAXIS,NM, & + X2LO,X2HI,X3LO,X3HI,X2LO_CELL,X2HI_CELL,& + X3LO_CELL,X3HI_CELL,INDX1,X1PLN) + + ENDDO ! I index + ENDDO ! J index + ENDDO ! K index + + ! Deallocate local plane arrays: + DEALLOCATE(X1FACE,X2FACE,X3FACE,X2CELL,X3CELL) + DEALLOCATE(DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL) + DEALLOCATE(FACERT) + +ENDDO X1AXIS_LOOP IF(GET_CUTCELLS_VERBOSE) THEN CALL CPU_TIME(CPUTIME) WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' - ENDIF + IF (MY_RANK==0) WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' ENDIF -RETURN +! Now Define the INBOUNDARY cut-edge inside Cartesian cells: +CALL GET_CARTCELL_CUTEDGES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) -END SUBROUTINE SET_GC_CUTCELLS_3D +! 1. Cartesian GASPHASE cut-faces: +! Loops for IAXIS, JAXIS, KAXIS faces: For FCVAR i,j,k, axis +! - Define Cartesian Boundary Edges indexes. +! - From ECVAR(i,j,k,IDCE,axis) figure out Entries in CUT_EDGE (GASPHASE segs). +! - From FCVAR(i,j,k,IDCE,axis) figure out entries in CUT_EDGE (INBOUNDCF segs). +! - Reorder Edges, figure out if there are disjoint areas present. +! - Load into CUT_FACE <=> FCVAR(i,j,k,IDCF,axis). +CALL GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.TRUE.) +! 2. INBOUNDARY cut-faces: +CALL GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.TRUE.) -! --------------------------- GET_GEOM_TRIBIN -------------------------------------- +! Guard-cell Cartesian GASPHASE and INBOUNDARY cut-faces: +CALL GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.FALSE.) +CALL GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.FALSE.) -SUBROUTINE GET_GEOM_TRIBIN +! Finally: Definition of cut-cells: +CELLRT = .FALSE. +MESHES(NM)%N_SPCELL_CF = MESHES(NM)%N_SPCELL +CALL GET_CARTCELL_CUTCELLS(NM) + +END SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH_WORK -! This routine separates lists of triangles for each GEOMETRY in interval -! bins in each direction. They are used in SET_CUTCELLS_3D/GET_BODINT_PLANE to optimize -! cut-cell generation. + +SUBROUTINE CC_GRID_GET_REGULAR_CUTCELLS_BOX(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) + +INTEGER, INTENT(IN) :: NM, ISTR, IEND, JSTR, JEND, KSTR, KEND ! Local Variables: -INTEGER :: IG, IWSEL, IEDGE, NTL, SZE, IBIN, ILO_BIN, IHI_BIN, WSELEM(NOD1:NOD3) -REAL(EB):: LEDGE, DXYZE(MAX_DIM), LX1, DELBIN, X1V_LO, X1V_HI, X1V(NOD1:NOD3) -INTEGER, ALLOCATABLE, DIMENSION(:) :: TRI_LIST -REAL(EB):: MINMAX_MESHES(LOW_IND:HIGH_IND,IAXIS:KAXIS),MIN_MESHGEOM,MAX_MESHGEOM -TYPE(GEOMETRY_TYPE), POINTER :: G -INTEGER :: DELTA_TBIN2 +INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: GEOMCELL +INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: GEOMFACE +INTEGER :: IBNDINT,INTGC_FLG,BNDINT_LOW,BNDINT_HIGH,II,JJ,KK,IG,ILO,IHI,JLO,JHI,KLO,KHI,X1LO,X1HI,X2LO,X2HI,X3LO,X3HI, & + INDXI(IAXIS:KAXIS) +INTEGER :: INDI,INDJ,INDK,INDI1,INDJ1,INDK1,INDI2,INDJ2,INDK2,INDI3,INDJ3,INDK3,INDI4,INDJ4,INDK4 +INTEGER :: INDXI1(IAXIS:KAXIS),INDXI2(IAXIS:KAXIS),INDXI3(IAXIS:KAXIS),INDXI4(IAXIS:KAXIS) +INTEGER :: NVERT,NFACE,NVERTFACE,NCUTFACE,NCUTCELL,FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS),CFELEM(1:NOD4+1,6),& + IDCF_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) +INTEGER :: LOHI,IWSEL,I1,I2,I3,IBOD(6),ITRI(6),FACE_LIST(1:CC_NPARAM_CCFACE,1:6),CEI_AXIS(LOW_IND:HIGH_IND),& + CEI,SIDE,NCFACE_CUTCELL,NFACE_CELL +REAL(EB):: DIST, DIST2, VOL(1) +REAL(EB):: XYZLC(IAXIS:KAXIS),XYZVERT(IAXIS:KAXIS,NOD1:NOD4+20),AREA(6),XYZCEN(IAXIS:KAXIS,6),XCEN(IAXIS:KAXIS) +REAL(EB):: INXAREA(IAXIS:KAXIS,1:6)=0._EB,INXSQAREA(IAXIS:KAXIS,1:6)=0._EB +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNTED2,IJK_COUNT +INTEGER :: I,J,K,X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS,IFACE,ICF,NCELL +CALL POINT_TO_MESH(NM) +M => MESHES(NM) -! Define boundary region of Meshes handled by MPI process and their connected meshes: -! Select MESHES assigned to processor and OMESHES of these. Cut-cells will be computed for all of them. -IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) -ALLOCATE(CC_COMPUTE_MESH(1:NMESHES)); CC_COMPUTE_MESH = .FALSE. -MINMAX_MESHES( LOW_IND,:)= 1._EB/TWENTY_EPSILON_EB -MINMAX_MESHES(HIGH_IND,:)= -1._EB/TWENTY_EPSILON_EB -DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CC_COMPUTE_MESH(NM)=.TRUE. ! Compute cut-cells for my meshes. - ! Min-max locations of MESH + halo region. - IG = MESHES(NM)%IBAR - MINMAX_MESHES( LOW_IND,IAXIS) = MIN(MINMAX_MESHES( LOW_IND,IAXIS),MESHES(NM)%XS-REAL(NGUARD,EB)*MESHES(NM)%DX( 1)) - MINMAX_MESHES(HIGH_IND,IAXIS) = MAX(MINMAX_MESHES(HIGH_IND,IAXIS),MESHES(NM)%XF+REAL(NGUARD,EB)*MESHES(NM)%DX(IG)) - IG = MESHES(NM)%JBAR - MINMAX_MESHES( LOW_IND,JAXIS) = MIN(MINMAX_MESHES( LOW_IND,JAXIS),MESHES(NM)%YS-REAL(NGUARD,EB)*MESHES(NM)%DY( 1)) - MINMAX_MESHES(HIGH_IND,JAXIS) = MAX(MINMAX_MESHES(HIGH_IND,JAXIS),MESHES(NM)%YF+REAL(NGUARD,EB)*MESHES(NM)%DY(IG)) - IG = MESHES(NM)%KBAR - MINMAX_MESHES( LOW_IND,KAXIS) = MIN(MINMAX_MESHES( LOW_IND,KAXIS),MESHES(NM)%ZS-REAL(NGUARD,EB)*MESHES(NM)%DZ( 1)) - MINMAX_MESHES(HIGH_IND,KAXIS) = MAX(MINMAX_MESHES(HIGH_IND,KAXIS),MESHES(NM)%ZF+REAL(NGUARD,EB)*MESHES(NM)%DZ(IG)) - DO NOM=1,NMESHES - IF (MESHES(NM)%OMESH(NOM)%NIC_R > 0) THEN - CC_COMPUTE_MESH(NOM)=.TRUE. ! There are cells from mesh NOM that are guardcells of mesh NM. - ! Min-max locations of MESH + halo region. - IG = MESHES(NOM)%IBAR - MINMAX_MESHES( LOW_IND,IAXIS) = MIN(MINMAX_MESHES( LOW_IND,IAXIS),MESHES(NOM)%XS-REAL(NGUARD,EB)*MESHES(NOM)%DX( 1)) - MINMAX_MESHES(HIGH_IND,IAXIS) = MAX(MINMAX_MESHES(HIGH_IND,IAXIS),MESHES(NOM)%XF+REAL(NGUARD,EB)*MESHES(NOM)%DX(IG)) - IG = MESHES(NOM)%JBAR - MINMAX_MESHES( LOW_IND,JAXIS) = MIN(MINMAX_MESHES( LOW_IND,JAXIS),MESHES(NOM)%YS-REAL(NGUARD,EB)*MESHES(NOM)%DY( 1)) - MINMAX_MESHES(HIGH_IND,JAXIS) = MAX(MINMAX_MESHES(HIGH_IND,JAXIS),MESHES(NOM)%YF+REAL(NGUARD,EB)*MESHES(NOM)%DY(IG)) - IG = MESHES(NOM)%KBAR - MINMAX_MESHES( LOW_IND,KAXIS) = MIN(MINMAX_MESHES( LOW_IND,KAXIS),MESHES(NOM)%ZS-REAL(NGUARD,EB)*MESHES(NOM)%DZ( 1)) - MINMAX_MESHES(HIGH_IND,KAXIS) = MAX(MINMAX_MESHES(HIGH_IND,KAXIS),MESHES(NOM)%ZF+REAL(NGUARD,EB)*MESHES(NOM)%DZ(IG)) - ENDIF +! Allocate Face - Geom numbering and Cell - Geom numbering arrays +ALLOCATE(GEOMFACE(ISTR:IEND,JSTR:JEND,KSTR:KEND,MAX_DIM)); GEOMFACE = CC_GASPHASE +ALLOCATE(GEOMCELL(ISTR:IEND,JSTR:JEND,KSTR:KEND)); GEOMCELL = CC_GASPHASE + +! First tag cells: NM is set and we have all the mesh info in MESHES(NM) +DO K=KLO_CELL-NGUARD,KHI_CELL+NGUARD + DO J=JLO_CELL-NGUARD,JHI_CELL+NGUARD + DO I=ILO_CELL-NGUARD,IHI_CELL+NGUARD + DO IG=1,N_GEOMETRY + IF(XCELL(I) < GEOMETRY(IG)%XB(1)) CYCLE + IF(XCELL(I) > GEOMETRY(IG)%XB(2)) CYCLE + IF(YCELL(J) < GEOMETRY(IG)%XB(3)) CYCLE + IF(YCELL(J) > GEOMETRY(IG)%XB(4)) CYCLE + IF(ZCELL(K) < GEOMETRY(IG)%XB(5)) CYCLE + IF(ZCELL(K) > GEOMETRY(IG)%XB(6)) CYCLE + GEOMCELL(I,J,K) = IG + MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_SOLID + EXIT + ENDDO + ENDDO + ENDDO +ENDDO + +! Now Tag cut-cells: The -2, +2 is to be able to define cut-face types below on boundary of GC cut-cells. +DO K=KLO_CELL-NGUARD+1,KHI_CELL+NGUARD-1 + DO J=JLO_CELL-NGUARD+1,JHI_CELL+NGUARD-1 + DO I=ILO_CELL-NGUARD+1,IHI_CELL+NGUARD-1 + IF(MESHES(NM)%CCVAR(I,J,K,CC_CGSC)==CC_SOLID) THEN + ! Set all vertices to Solid: + MESHES(NM)%VERTVAR(I-1,J ,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I-1,J-1,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I-1,J-1,K-1,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I-1,J ,K-1,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J ,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J-1,K ,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J-1,K-1,CC_VGSC) = CC_SOLID + MESHES(NM)%VERTVAR(I ,J ,K-1,CC_VGSC) = CC_SOLID + CYCLE + ENDIF + IF(ANY(MESHES(NM)%CCVAR(I-1:I+1,J-1:J+1,K-1:K+1,CC_CGSC) == CC_SOLID)) & + MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE + ENDDO ENDDO ENDDO +! Then tag faces: +! X Faces: +DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD + DO J=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD + DO I=ILO_FACE-CCGUARD,IHI_FACE+CCGUARD + ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: + IF(ANY(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_GASPHASE)) CYCLE -! Loop geometries: -LOOP_GEOM : DO IG = 1, N_GEOMETRY + ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: + IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_SOLID)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID + GEOMFACE(I,J,K,IAXIS) = GEOMCELL(I,J,K) + CYCLE + ENDIF - G=>GEOMETRY(IG) + ! Now Gasphase cut-faces: All CCVAR == CUTCFE + IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_CUTCFE)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_CUTCFE + ! GEOMFACE(I,J,K,IAXIS) stays CC_GASPHASE + CYCLE + ENDIF - ! Define EDGE sizes and FACE cointaining boxes: - G%MAX_LEDGE = GEOMEPS ! Initialize to a small number. - G%MIN_LEDGE = 1._EB/GEOMEPS ! Initialize to a large number. - G%MEAN_LEDGE= 0._EB ! Initialize to 0. + ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: + IF (GEOMCELL(I,J,K)*GEOMCELL(I+1,J,K) < 0) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID + GEOMFACE(I,J,K,IAXIS) = MAXVAL(GEOMCELL(I:I+1,J,K)) ! This is because one is ==CC_GASPHASE==-1 + CYCLE + ENDIF + ENDDO + ENDDO +ENDDO + +! Y Faces: +DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD + DO J=JLO_FACE-CCGUARD,JHI_FACE+CCGUARD + DO I=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD + ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: + IF(ANY(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_GASPHASE)) CYCLE + + ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: + IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_SOLID)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_SOLID + GEOMFACE(I,J,K,JAXIS) = GEOMCELL(I,J,K) + CYCLE + ENDIF + + ! Now Gasphase cut-faces: All CCVAR == CUTCFE + IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_CUTCFE)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_CUTCFE + ! GEOMFACE(I,J,K,JAXIS) stays CC_GASPHASE + CYCLE + ENDIF + + ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: + IF (GEOMCELL(I,J,K)*GEOMCELL(I,J+1,K) < 0) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_SOLID + GEOMFACE(I,J,K,JAXIS) = MAXVAL(GEOMCELL(I,J:J+1,K)) ! This is because one is ==CC_GASPHASE==-1 + CYCLE + ENDIF + ENDDO + ENDDO +ENDDO - ! Loop Faces: - DO IWSEL = 0,G%N_FACES-1 - WSELEM(NOD1:NOD3) = G%FACES(3*IWSEL+1:3*IWSEL+3) +! Z Faces: +DO K=KLO_FACE-CCGUARD,KHI_FACE+CCGUARD + DO J=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD + DO I=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD + ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: + IF(ANY(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_GASPHASE)) CYCLE - ! Obtain edges length, test against MAX_LEDGE: - DO IEDGE=1,3 - ! DX = XYZ2 - XYZ1: - DXYZE(IAXIS:KAXIS) = G%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) - & - G%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) - LEDGE = sqrt( DXYZE(IAXIS)**2._EB + DXYZE(JAXIS)**2._EB + DXYZE(KAXIS)**2._EB ) + ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: + IF(ALL(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_SOLID)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_SOLID + GEOMFACE(I,J,K,KAXIS) = GEOMCELL(I,J,K) + CYCLE + ENDIF - G%MAX_LEDGE = MAX(G%MAX_LEDGE,LEDGE) - G%MIN_LEDGE = MIN(G%MIN_LEDGE,LEDGE) - G%MEAN_LEDGE= G%MEAN_LEDGE + LEDGE + ! Now Gasphase cut-faces: All CCVAR == CUTCFE + IF(ALL(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_CUTCFE)) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_CUTCFE + ! GEOMFACE(I,J,K,KAXIS) stays CC_GASPHASE + CYCLE + ENDIF - WSELEM=CSHIFT(WSELEM,1) ! Shift cyclically array by 1 entry. This rotates nodes connectivities. - ! i.e: initially WSELEM=(/1,2,3/), 1st call gives WSELEM=(/2,3,1/), 2nd - ! call gives WSELEM=(/3,1,2/). + ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: + IF (GEOMCELL(I,J,K)*GEOMCELL(I,J,K+1) < 0) THEN + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_SOLID + GEOMFACE(I,J,K,KAXIS) = MAXVAL(GEOMCELL(I,J,K:K+1)) ! This is because one is ==CC_GASPHASE==-1 + CYCLE + ENDIF ENDDO - ENDDO - ! Mean length of Edge: - G%MEAN_LEDGE = G%MEAN_LEDGE / REAL(G%N_FACES*EDGS_WSEL,EB) !Num EDGES summed in NUM_FACES * NUM edges on a face. +ENDDO - ! Now define Bin sizes to distribute Faces subsets: - DO X1AXIS=IAXIS,KAXIS +! Now define Gasphase and boundary cut-faces: 1 Boundary, 2 internal, 3 guard cell faces: +INTGC_FLG_LOOP : DO INTGC_FLG=LOW_IND,HIGH_IND - ! Here reduce the X1_LOW to X1_HIGH distance to the smallest of FDS Mesh and connected meshes BBOX or Geometry: - MIN_MESHGEOM = MAX(MINMAX_MESHES( LOW_IND,X1AXIS),G%GEOM_BOX( LOW_IND,X1AXIS)-G%MEAN_LEDGE) - MAX_MESHGEOM = MIN(MINMAX_MESHES(HIGH_IND,X1AXIS),G%GEOM_BOX(HIGH_IND,X1AXIS)+G%MEAN_LEDGE) - LX1 = MAX_MESHGEOM - MIN_MESHGEOM + ! GASPHASE cut-faces: + NVERT = 4; NFACE = 1; NVERTFACE = 5 + IF (INTGC_FLG==LOW_IND) THEN + ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. + BNDINT_LOW = 1; BNDINT_HIGH = 3 + ELSE + BNDINT_LOW = 4; BNDINT_HIGH = 4 + ENDIF - ! Define number of bins in direction X1AXIS: - G%TBAXIS(X1AXIS)%N_BINS = CEILING(LX1/(GAMMA_MULT*G%MEAN_LEDGE)) + IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, + ! 4 guard-cell faces. - ! No overlap between procs meshes and Geometry, cycle: - IF (G%TBAXIS(X1AXIS)%N_BINS < 1) THEN; G%TBAXIS(X1AXIS)%N_BINS = 0; CYCLE; ENDIF + ! When switching to internal faces, copy number of external faces already computed. + IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH - DELTA_TBIN2 = MAX(DELTA_TBIN,CEILING(0.05_EB*LX1/(G%GEOM_BOX(HIGH_IND,X1AXIS)-G%GEOM_BOX(LOW_IND,X1AXIS))*& - REAL(G%N_FACES,EB)/REAL(G%TBAXIS(X1AXIS)%N_BINS+1,EB))) + X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS + SELECT CASE(X1AXIS) + CASE(IAXIS) + X2AXIS = JAXIS; X3AXIS = KAXIS + ! IAXIS gasphase cut-faces: + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + ILO = ILO_FACE; IHI = ILO_FACE + CASE(2) + ILO = IHI_FACE; IHI = IHI_FACE + CASE(3) + ILO = ILO_FACE+1; IHI = IHI_FACE-1 + CASE(4) + ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS + ! Local indexing in x1, x2, x3: + X1LO = ILO; X1HI = IHI + X2LO = JLO; X2HI = JHI + X3LO = KLO; X3HI = KHI + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE + ALLOCATE(X2FACE(JSTR:JEND)); X2FACE = YFACE + ALLOCATE(X3FACE(KSTR:KEND)); X3FACE = ZFACE - ! Allocate TRIBIN field: - IF(ALLOCATED(G%TBAXIS(X1AXIS)%TRIBIN)) DEALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN) - ALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN(1:G%TBAXIS(X1AXIS)%N_BINS)) + CASE(JAXIS) + X2AXIS = KAXIS; X3AXIS = IAXIS + ! JAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + JLO = JLO_FACE; JHI = JLO_FACE + CASE(2) + JLO = JHI_FACE; JHI = JHI_FACE + CASE(3) + JLO = JLO_FACE+1; JHI = JHI_FACE-1 + CASE(4) + JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + KLO = KLO-CCGUARD; KHI = KHI+CCGUARD + END SELECT + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS + ! Local indexing in x1, x2, x3: + X1LO = JLO; X1HI = JHI + X2LO = KLO; X2HI = KHI + X3LO = ILO; X3HI = IHI + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE + ALLOCATE(X2FACE(KSTR:KEND)); X2FACE = ZFACE + ALLOCATE(X3FACE(ISTR:IEND)); X3FACE = XFACE - ! Set BIN boundaries and make initial allocation of TRI_LIST for each bin: - DELBIN = LX1 / REAL(G%TBAXIS(X1AXIS)%N_BINS,EB) - G%TBAXIS(X1AXIS)%DELBIN = DELBIN - DO IBIN=1,G%TBAXIS(X1AXIS)%N_BINS - G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW = MIN_MESHGEOM + REAL(IBIN-1,EB)*DELBIN - G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH = MIN_MESHGEOM + REAL(IBIN ,EB)*DELBIN - G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL = 0 - ALLOCATE(G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(DELTA_TBIN2)) - ENDDO + CASE(KAXIS) + X2AXIS = IAXIS; X3AXIS = JAXIS + ! KAXIS gasphase cut-faces: + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + SELECT CASE(IBNDINT) + CASE(1) + KLO = KLO_FACE; KHI = KLO_FACE + CASE(2) + KLO = KHI_FACE; KHI = KHI_FACE + CASE(3) + KLO = KLO_FACE+1; KHI = KHI_FACE-1 + CASE(4) + KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD + ILO = ILO-CCGUARD; IHI = IHI+CCGUARD + JLO = JLO-CCGUARD; JHI = JHI+CCGUARD + END SELECT + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS + ! Local indexing in x1, x2, x3: + X1LO = KLO; X1HI = KHI + X2LO = ILO; X2HI = IHI + X3LO = JLO; X3HI = JHI + ! Face coordinates in x1,x2,x3 axes: + ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE + ALLOCATE(X2FACE(ISTR:IEND)); X2FACE = XFACE + ALLOCATE(X3FACE(JSTR:JEND)); X3FACE = YFACE - ! Finally, populate TRI_LIST for X1AXIS bins: - DO IWSEL = 0,G%N_FACES-1 - WSELEM(NOD1:NOD3) = G%FACES(3*IWSEL+1:3*IWSEL+3) - X1V(NOD1:NOD3) = G%VERTS(MAX_DIM*(WSELEM(NOD1:NOD3)-1)+X1AXIS) - X1V_LO = MINVAL(X1V(NOD1:NOD3)); - X1V_HI = MAXVAL(X1V(NOD1:NOD3)); - ILO_BIN = MAX(1,CEILING((X1V_LO-GEOMEPS-MIN_MESHGEOM)/DELBIN)) - IHI_BIN = MIN(G%TBAXIS(X1AXIS)%N_BINS,CEILING((X1V_HI+GEOMEPS-MIN_MESHGEOM)/DELBIN)) - DO IBIN=ILO_BIN,IHI_BIN - NTL = G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL + 1 - SZE = SIZE(G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST,DIM=1) - IF (NTL > SZE) THEN - ! Reallocate: - ALLOCATE(TRI_LIST(1:SZE+DELTA_TBIN2)); - TRI_LIST(1:SZE)=G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(1:SZE) - CALL MOVE_ALLOC(FROM=TRI_LIST,TO=G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST) - ENDIF - ! Add Triangle index to BINs TRI_LIST - G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL = NTL - G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(NTL) = IWSEL+1 + END SELECT - ENDDO - ENDDO - END DO + ! Loop on Cartesian faces, local x1, x2, x3 indexes: + DO II=X1LO,X1HI + DO KK=X3LO,X3HI + DO JJ=X2LO,X2HI + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI = INDXI(XIAXIS) + INDJ = INDXI(XJAXIS) + INDK = INDXI(XKAXIS) + ! Drop if not CUTCFE: + IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE; IJK_COUNTED(INDI,INDJ,INDK,X1AXIS)=.TRUE. + IF(MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE - ! WRITE(LU_ERR,*) 'GEOMETRY=',IG,'NBINS=',G%TBAXIS(IAXIS)%N_BINS,G%TBAXIS(JAXIS)%N_BINS,G%TBAXIS(KAXIS)%N_BINS - ! DO X1AXIS=IAXIS,KAXIS - ! DO IBIN=1,G%TBAXIS(X1AXIS)%N_BINS - ! WRITE(LU_ERR,*) X1AXIS,'IBIN, NTL=',IBIN,G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL, & - ! G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW,G%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH - ! END DO - ! END DO -ENDDO LOOP_GEOM + ! Vertex at index II,JJ-1,KK-1: + INDXI1(IAXIS:KAXIS) = (/ II, JJ-1, KK-1 /) ! Local x1,x2,x3 + INDI1 = INDXI1(XIAXIS) + INDJ1 = INDXI1(XJAXIS) + INDK1 = INDXI1(XKAXIS) + ! Vertex at index II,JJ,KK-1: + INDXI2(IAXIS:KAXIS) = (/ II, JJ, KK-1 /) ! Local x1,x2,x3 + INDI2 = INDXI2(XIAXIS) + INDJ2 = INDXI2(XJAXIS) + INDK2 = INDXI2(XKAXIS) + ! Vertex at index II,JJ,KK: + INDXI3(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI3 = INDXI3(XIAXIS) + INDJ3 = INDXI3(XJAXIS) + INDK3 = INDXI3(XKAXIS) + ! Vertex at index II,JJ-1,KK: + INDXI4(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 + INDI4 = INDXI4(XIAXIS) + INDJ4 = INDXI4(XJAXIS) + INDK4 = INDXI4(XKAXIS) -RETURN -END SUBROUTINE GET_GEOM_TRIBIN + ! First, normal direction in x1 direction. + ! For this face: XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + ! Vert 1: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI1(IAXIS)), X2FACE(INDXI1(JAXIS)), X3FACE(INDXI1(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) + ! Vert 2: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI2(IAXIS)), X2FACE(INDXI2(JAXIS)), X3FACE(INDXI2(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) + ! Vert 3: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI3(IAXIS)), X2FACE(INDXI3(JAXIS)), X3FACE(INDXI3(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) + ! Vert 4: + XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI4(IAXIS)), X2FACE(INDXI4(JAXIS)), X3FACE(INDXI4(KAXIS)) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) + + CFELEM(1:5,1) = (/ 4, NOD1, NOD2, NOD3, NOD4 /) + + ! Area: + AREA(1) = (X2FACE(INDXI2(JAXIS))-X2FACE(INDXI1(JAXIS)))*(X3FACE(INDXI4(KAXIS))-X3FACE(INDXI1(KAXIS))) + + ! XYZCEN in Local Coords: + XYZCEN(IAXIS:KAXIS,1)= (/ X1FACE(II), 0.5_EB*(X2FACE(INDXI2(JAXIS))+X2FACE(INDXI1(JAXIS))), & + 0.5_EB*(X3FACE(INDXI4(KAXIS))+X3FACE(INDXI1(KAXIS))) /) + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(IAXIS,1) = 1._EB * X1FACE(II) * AREA(1) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(IAXIS,1) = 1._EB * X1FACE(II)**2._EB * AREA(1) -! --------------------------- SNAP_GEOM_NODES -------------------------------------- + ! This is a new cut-face, allocate space: + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (INTGC_FLG==LOW_IND) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCF,X1AXIS) = NCUTFACE -SUBROUTINE SNAP_GEOM_NODES + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -INTEGER :: IBIN,IWSELDUM,IWSEL,WSELEM(NOD1:NOD3),X1LO,X1HI,X1IND,ILO_BIN,IHI_BIN -REAL(EB):: MIN_MESHGEOM,DELBIN -REAL(EB) :: CPUTIME_START, CPUTIME + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ INDI, INDJ, INDK, X1AXIS /) + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE,IBNDINT) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) -IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_ERR,'(A)',advance="no") ' 1a. Snap node position to grid planes : SNAP_GEOM_NODES' -ENDIF + ! Connectivity: + CF%CFELEM(1:NVERTFACE,NFACE) = CFELEM(1:NVERTFACE,1) + ! Geom Properties: + CF%AREA(NFACE) = AREA(1) + CF%XYZCEN(IAXIS:KAXIS,NFACE) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,1) -! Main Loop over Geometries, set nodes to SNAP_NODE=T: -MAIN_GEOM_LOOP_1 : DO IG=1,N_GEOMETRY - ALLOCATE(GEOMETRY(IG)%SNAP_NODE(IAXIS:KAXIS,1:GEOMETRY(IG)%N_VERTS)); GEOMETRY(IG)%SNAP_NODE = .FALSE. - AXIS_LOOP_1 : DO X1AXIS=IAXIS,KAXIS - IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE - ! Run all bin on this geometry and set nodes involved to SNAP_NODE=T: - IBIN_DO_1 : DO IBIN=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS - ! Loop surface triangles: - DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL - IWSEL=GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(IWSELDUM) - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(MAX_DIM*(IWSEL-1)+1:MAX_DIM*IWSEL) - GEOMETRY(IG)%SNAP_NODE(X1AXIS, (/WSELEM(NOD1:NOD3)/) ) = .TRUE. ! Set nodes to test for snapping to grid planes. - ENDDO - ENDDO IBIN_DO_1 - ENDDO AXIS_LOOP_1 -ENDDO MAIN_GEOM_LOOP_1 + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: + CF%INXAREA(NFACE) = INXAREA(XIAXIS,1) + ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: + CF%INXSQAREA(NFACE) = INXSQAREA(XIAXIS,1) + ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: + CF%JNYSQAREA(NFACE) = INXSQAREA(XJAXIS,1) + ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: + CF%KNZSQAREA(NFACE) = INXSQAREA(XKAXIS,1) -! Now Mesh loop on mesh + guard planes to test against -! Main Loop over Meshes: -MAIN_MESH_LOOP : DO NM=1,NMESHES + ENDDO + ENDDO + ENDDO + DEALLOCATE(X1FACE,X2FACE,X3FACE) + ENDDO X1AXIS_LOOP + ENDDO IBNDINT_LOOP - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) - ! Run by coordinate direction, define planes X1PLN on this mesh, look for involved GEOMETRY vertices using TBAXIS and - ! after positive test of SNAP_NODE check if node is to be snapped to plane. - AXIS_LOOP_2 : DO X1AXIS=IAXIS,KAXIS + IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED ) - SELECT CASE(X1AXIS) - CASE(IAXIS) - X1LO = ILO_FACE-CCGUARD; X1HI = IHI_FACE+CCGUARD - ALLOCATE(X1FACE(ISTR:IEND),DX1FACE(ISTR:IEND)); X1FACE = XFACE; DX1FACE = DXFACE - CASE(JAXIS) - X1LO = JLO_FACE-CCGUARD; X1HI = JHI_FACE+CCGUARD - ALLOCATE(X1FACE(JSTR:JEND),DX1FACE(JSTR:JEND)); X1FACE = YFACE; DX1FACE = DYFACE - CASE(KAXIS) - X1LO = KLO_FACE-CCGUARD; X1HI = KHI_FACE+CCGUARD - ALLOCATE(X1FACE(KSTR:KEND),DX1FACE(KSTR:KEND)); X1FACE = ZFACE; DX1FACE = DZFACE - END SELECT + ! INBOUNDARY cut-faces: + IF (INTGC_FLG==LOW_IND) THEN + ALLOCATE( IJK_COUNTED2(ISTR:IEND,JSTR:JEND,KSTR:KEND) ); IJK_COUNTED2=.FALSE. + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + ELSE + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD + ENDIF - ! Loop planes in X1AXIS direction: - X1PLN_LOOP : DO X1IND=X1LO,X1HI - X1PLN = X1FACE(X1IND) ! Plane position. - MAIN_GEOM_LOOP_2 : DO IG=1,N_GEOMETRY - IF (GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS<1) CYCLE - DELBIN = GEOMETRY(IG)%TBAXIS(X1AXIS)%DELBIN - MIN_MESHGEOM = GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(1)%X1_LOW - ILO_BIN = MAX(1,CEILING((X1PLN-GEOMEPS-MIN_MESHGEOM)/DELBIN)) - IHI_BIN = MIN(GEOMETRY(IG)%TBAXIS(X1AXIS)%N_BINS,CEILING((X1PLN+GEOMEPS-MIN_MESHGEOM)/DELBIN)) - IBIN_DO_2 : DO IBIN=ILO_BIN,IHI_BIN - IF ( X1PLN < GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE - IF ( X1PLN > GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE - ! Loop surface triangles: - DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL - IWSEL=GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%TRI_LIST(IWSELDUM) - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(MAX_DIM*(IWSEL-1)+1:MAX_DIM*IWSEL) - ! Triangles NODES coordinates: - DO INOD=NOD1,NOD3 - IF(.NOT.GEOMETRY(IG)%SNAP_NODE(X1AXIS,WSELEM(INOD))) CYCLE - ! Do test to snap to: - IF(ABS(GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+X1AXIS)-X1PLN) < SNAP_DIST_FACTOR*DX1FACE(X1IND) ) THEN - GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(INOD)-1)+X1AXIS) = X1PLN ! Set node position to plane value. - GEOMETRY(IG)%SNAP_NODE(X1AXIS,WSELEM(INOD)) = .FALSE. ! No need to snap again. - ENDIF - ENDDO - ENDDO - ENDDO IBIN_DO_2 - ENDDO MAIN_GEOM_LOOP_2 - ENDDO X1PLN_LOOP + ! Loop on Cartesian cells: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI - DEALLOCATE(X1FACE,DX1FACE) + IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE - ENDDO AXIS_LOOP_2 - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -ENDDO MAIN_MESH_LOOP + IF(IJK_COUNTED2(I,J,K)) CYCLE; IJK_COUNTED2(I,J,K)=.TRUE. -! Deallocate SNAP_NODE in geometries: -DO IG=1,N_GEOMETRY - DEALLOCATE(GEOMETRY(IG)%SNAP_NODE) -ENDDO + ! Face type of bounding Cartesian faces: + FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) + FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) + FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) + FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) + FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) + FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) -IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN - WRITE(LU_ERR,'(A)',advance="no") '.. done.' - CALL CPU_TIME(CPUTIME) - WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken : ',CPUTIME-CPUTIME_START,' sec.' -ENDIF + IF ( ALL(FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) /= CC_SOLID) ) CYCLE -END SUBROUTINE SNAP_GEOM_NODES + NVERT = 0; NFACE = 0 + INXAREA = 0._EB + INXSQAREA = 0._EB + ! XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + X1AXIS_LOOP2 : DO X1AXIS=IAXIS,KAXIS + LOHI_DO : DO LOHI=LOW_IND,HIGH_IND + IF (FSID_XYZ(LOHI,X1AXIS) /= CC_SOLID) CYCLE + NFACE = NFACE + 1 + SELECT CASE(X1AXIS) + CASE(IAXIS) -SUBROUTINE CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) + ! Vertices: + XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K ) /) + IF(LOHI==LOW_IND)THEN + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) + ELSE + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) + ENDIF + ! Area: + AREA(NFACE) = (YFACE(J )-YFACE(J-1))*(ZFACE(K )-ZFACE(K-1)) + ! XYZCEN: + XYZCEN(IAXIS:KAXIS,NFACE) = (/ XFACE(I-2+LOHI), 0.5_EB*(YFACE(J )+YFACE(J-1)), & + 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI) * AREA(NFACE) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI)**2._EB * AREA(NFACE) -INTEGER, INTENT(IN) :: NM,ISTR,IEND,JSTR,JEND,KSTR,KEND -REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX + ! Define IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I-2+LOHI,J,K,X1AXIS) + CASE(JAXIS) -! Initialize CC_IBM arrays for mesh NM: -! Vertices: -IF (.NOT. ALLOCATED(MESHES(NM)%VERTVAR)) & - ALLOCATE(MESHES(NM)%VERTVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NVVARS)) -MESHES(NM)%VERTVAR = 0 -MESHES(NM)%VERTVAR(:,:,:,CC_VGSC) = CC_GASPHASE + ! Vertices: + XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K-1) /) + IF(LOHI==LOW_IND)THEN + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) + ELSE + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) + ENDIF + ! Area: + AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(ZFACE(K )-ZFACE(K-1)) + ! XYZCEN: + XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), YFACE(J-2+LOHI), & + 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI) * AREA(NFACE) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI)**2._EB * AREA(NFACE) -! Cartesian Edges: -IF (.NOT. ALLOCATED(MESHES(NM)%ECVAR)) & - ALLOCATE(MESHES(NM)%ECVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NEVARS,MAX_DIM)) -MESHES(NM)%ECVAR = 0 -MESHES(NM)%ECVAR(:,:,:,CC_EGSC,:) = CC_GASPHASE + ! Define IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I,J-2+LOHI,K,X1AXIS) + CASE(KAXIS) -! Cartesian Faces: -IF (.NOT. ALLOCATED(MESHES(NM)%FCVAR)) & - ALLOCATE(MESHES(NM)%FCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NFVARS,MAX_DIM)) -MESHES(NM)%FCVAR = 0 -MESHES(NM)%FCVAR(:,:,:,CC_FGSC,:) = CC_GASPHASE + ! Vertices: + XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K-2+LOHI) /) + XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K-2+LOHI) /) + XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J ), ZFACE(K-2+LOHI) /) + XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K-2+LOHI) /) + IF(LOHI==LOW_IND)THEN + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) + ELSE + CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) + ENDIF + ! Area: + AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(YFACE(J )-YFACE(J-1)) + ! XYZCEN: + XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), 0.5_EB*(YFACE(J )+YFACE(J-1)), & + ZFACE(K-2+LOHI) /) + ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: + INXAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI) * AREA(NFACE) + ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: + INXSQAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI)**2._EB * AREA(NFACE) -! Cartesian Cells: -IF (.NOT. ALLOCATED(MESHES(NM)%CCVAR)) & - ALLOCATE(MESHES(NM)%CCVAR(ISTR:IEND,JSTR:JEND,KSTR:KEND,CC_NCVARS)) -MESHES(NM)%CCVAR = 0 -MESHES(NM)%CCVAR(:,:,:,CC_CGSC) = CC_GASPHASE + ! Define IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I,J,K-2+LOHI,X1AXIS) + END SELECT -! When TERRAIN_CASE = TRUE, allocate GEOM_ZMAX for the mesh: -IF (TERRAIN_CASE) THEN - ALLOCATE(GEOM_ZMAX_AUX(ISTR:IEND,JSTR:JEND)) - GEOM_ZMAX_AUX = -1._EB/GEOMEPS -ENDIF + ! With IBOD and cut-face XYZCEN defined, find closest triangle: + DIST = 1.E20_EB + ITRI(NFACE) = 1 + DO IWSEL=1,GEOMETRY(IBOD(NFACE))%N_FACES + I1 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-2) + I2 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-1) + I3 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL ) + XCEN(IAXIS:KAXIS) = 1._EB/3._EB * ( GEOMETRY(IBOD(NFACE))%VERTS(3*(I1-1)+IAXIS:3*(I1-1)+KAXIS)+ & + GEOMETRY(IBOD(NFACE))%VERTS(3*(I2-1)+IAXIS:3*(I2-1)+KAXIS)+ & + GEOMETRY(IBOD(NFACE))%VERTS(3*(I3-1)+IAXIS:3*(I3-1)+KAXIS) ) + ! Drop Triangles not on the face: + IF (ABS(XYZCEN(X1AXIS,NFACE)-XCEN(X1AXIS)) > GEOMEPS) CYCLE + DIST2 = NORM2(XYZCEN(IAXIS:KAXIS,NFACE)-XCEN(IAXIS:KAXIS)) + IF (DIST > DIST2) THEN + DIST = DIST2 + ITRI(NFACE) = IWSEL + ENDIF + ENDDO -! Write mesh number allocation if GET_CUTCELLS_VERBOSE: -IF (GET_CUTCELLS_VERBOSE) THEN - WRITE(LU_SETCC,'(A)') ' ' - WRITE(LU_SETCC,'(A,I5,A,I10)') ' Processing Mesh : ',NM - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A)') ' ' - WRITE(LU_ERR,'(A,I5,A,I10)') ' Processing Mesh : ',NM - ENDIF -ENDIF + NVERT = NVERT + 4 -! Here we have to allocate the size of MESHES(NM)%EDGE_CROSS: -MESHES(NM)%N_EDGE_CROSS = 0 ! Reset EDCROSS counter for mesh NM. -IF (ALLOCATED(MESHES(NM)%EDGE_CROSS)) DEALLOCATE(MESHES(NM)%EDGE_CROSS) -ALLOCATE(MESHES(NM)%EDGE_CROSS(GLOBAL_DELTA_EDGE)) + ENDDO LOHI_DO + ENDDO X1AXIS_LOOP2 -! Here we have to allocate the size of MESHES(NM)%CUT_EDGE: -MESHES(NM)%N_CUTEDGE_MESH = 0 ! Reset CUTEDGE counter for mesh NM. -IF (ALLOCATED(MESHES(NM)%CUT_EDGE)) DEALLOCATE(MESHES(NM)%CUT_EDGE) -ALLOCATE(MESHES(NM)%CUT_EDGE(GLOBAL_DELTA_EDGE)) -! Here we have to allocate the size of MESHES(NM)%CUT_FACE: -MESHES(NM)%N_CUTFACE_MESH = 0 ! Reset CUTFACE counter for mesh NM. -MESHES(NM)%N_BBCUTFACE_MESH = 0 -MESHES(NM)%N_GCCUTFACE_MESH = 0 -IF (ALLOCATED(MESHES(NM)%CUT_FACE)) DEALLOCATE(MESHES(NM)%CUT_FACE) -ALLOCATE(MESHES(NM)%CUT_FACE(GLOBAL_DELTA_FACE)) + ! This is a cut-face, allocate space: + NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 + IF (INTGC_FLG==LOW_IND) THEN + MESHES(NM)%N_CUTFACE_MESH = NCUTFACE + ELSE + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 + ENDIF + MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE -! Here we have to allocate the size of MESHES(NM)%CUT_CELL: -MESHES(NM)%N_CUTCELL_MESH = 0 ! Reset CUTCELL counter for mesh NM. -MESHES(NM)%N_GCCUTCELL_MESH = 0 -IF (ALLOCATED(MESHES(NM)%CUT_CELL)) DEALLOCATE(MESHES(NM)%CUT_CELL) -ALLOCATE(MESHES(NM)%CUT_CELL(GLOBAL_DELTA_CELL)) + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -! Allocate array for special cells containing geometry intersections: -ALLOCATE(CELLRT(ISTR:IEND,JSTR:JEND,KSTR:KEND)) -CELLRT(:,:,:) = .FALSE. + MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT + MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE + MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, 0 /) ! No axis = 0 + MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_INBOUNDARY + CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE) + CF => MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) + CF%CFELEM(1:5,1:NFACE) = CFELEM(1:5,1:NFACE) -! List of special cells to block (either from GET_CARTCELL_CUTCELLS or -! cells flagged as polyline could not be built in GET_CARTCELL_CUTFACES): -ALLOCATE(SPCELLS_TO_BLOCK(1:GLOBAL_DELTA_CELL)) -N_SPCELLS_TO_BLOCK = 0 -MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 -IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) + CF%AREA(1:NFACE) = AREA(1:NFACE) + CF%XYZCEN(IAXIS:KAXIS,1:NFACE) = XYZCEN(IAXIS:KAXIS,1:NFACE) -END SUBROUTINE CC_GRID_INIT_MESH_STORAGE + ! Fields for cut-cell volume/centroid computation: + ! dot(i,nc)*int(x)dA: + CF%INXAREA(1:NFACE) = INXAREA(IAXIS,1:NFACE) + ! dot(i,nc)*int(x^2)dA: + CF%INXSQAREA(1:NFACE) = INXSQAREA(IAXIS,NFACE) + ! dot(j,nc)*int(y^2)dA: + CF%JNYSQAREA(1:NFACE) = INXSQAREA(JAXIS,NFACE) + ! dot(k,nc)*int(z^2)dA: + CF%KNZSQAREA(1:NFACE) = INXSQAREA(KAXIS,NFACE) + ! Define Body-triangle reference: + CF%BODTRI(1,1:NFACE)= IBOD(1:NFACE) + CF%BODTRI(2,1:NFACE)= ITRI(1:NFACE) -SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) + ! Assign surf-index: Depending on GEOMETRY: + DO IFACE=1,NFACE + CF%SURF_INDEX(IFACE) = GEOMETRY(IBOD(IFACE))%SURFS(ITRI(IFACE)) + ENDDO -INTEGER, INTENT(IN) :: NM -INTEGER, ALLOCATABLE, DIMENSION(:) :: SPCELLS_TO_BLOCK_TMP + ENDDO + ENDDO + ENDDO -MESHES(NM)%N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK -IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) + IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED2 ) -IF (N_SPCELLS_TO_BLOCK < 1) THEN - IF (ALLOCATED(SPCELLS_TO_BLOCK)) DEALLOCATE(SPCELLS_TO_BLOCK) - RETURN -ENDIF +ENDDO INTGC_FLG_LOOP -IF (SIZE(SPCELLS_TO_BLOCK,DIM=1) > N_SPCELLS_TO_BLOCK) THEN - ALLOCATE(SPCELLS_TO_BLOCK_TMP(1:N_SPCELLS_TO_BLOCK)) - SPCELLS_TO_BLOCK_TMP(1:N_SPCELLS_TO_BLOCK) = SPCELLS_TO_BLOCK(1:N_SPCELLS_TO_BLOCK) - DEALLOCATE(SPCELLS_TO_BLOCK) - CALL MOVE_ALLOC(FROM=SPCELLS_TO_BLOCK_TMP,TO=MESHES(NM)%SPCELLS_TO_BLOCK) -ELSE - CALL MOVE_ALLOC(FROM=SPCELLS_TO_BLOCK,TO=MESHES(NM)%SPCELLS_TO_BLOCK) -ENDIF -END SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK +! Finally Build cut-cells: +NCFACE_CUTCELL = 7; NFACE_CELL = 6; NCELL = 1 +INTGC_FLG_LOOP2 : DO INTGC_FLG=LOW_IND,HIGH_IND ! 1 refers to blocks internal cells, 2 refers to block guard cells. + + SELECT CASE(INTGC_FLG) + CASE(LOW_IND) + ALLOCATE(IJK_COUNT(ILO_CELL-NGUARD:IHI_CELL+NGUARD,JLO_CELL-NGUARD:JHI_CELL+NGUARD, & + KLO_CELL-NGUARD:KHI_CELL+NGUARD)) + IJK_COUNT = .FALSE. + ILO = ILO_CELL; IHI = IHI_CELL + JLO = JLO_CELL; JHI = JHI_CELL + KLO = KLO_CELL; KHI = KHI_CELL + CASE(HIGH_IND) + ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD + JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD + KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD + END SELECT + ! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -SUBROUTINE CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) + IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE -INTEGER, INTENT(IN) :: NM -REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX -INTEGER :: I,J + IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. -! Case of terrain, populate GEOM_ZMAX: -IF (.NOT.TERRAIN_CASE) RETURN + ! Start with Cartesian Faces: + ! Face type of bounding Cartesian faces: + FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) + FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) + FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) + FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) + FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) + FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) -IF (ALLOCATED(MESHES(NM)%GEOM_ZMAX)) DEALLOCATE(MESHES(NM)%GEOM_ZMAX) -ALLOCATE(MESHES(NM)%GEOM_ZMAX(0:IBAR,0:JBAR)) -DO J=0,JBAR - DO I=0,IBAR - ! Clip at ZS-DZ(1): - MESHES(NM)%GEOM_ZMAX(I,J) = MAX(ZFACE(-1),GEOM_ZMAX_AUX(I,J)) - ENDDO -ENDDO -DEALLOCATE(GEOM_ZMAX_AUX) + ! Cut-face number of bounding Cartesian faces: + IDCF_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCF,IAXIS) + IDCF_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCF,IAXIS) + IDCF_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCF,JAXIS) + IDCF_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCF,JAXIS) + IDCF_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCF,KAXIS) + IDCF_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCF,KAXIS) -END SUBROUTINE CC_GRID_FINALIZE_TERRAIN + NFACE_CELL = 0 + X1AXIS_LOOP3 : DO X1AXIS=IAXIS,KAXIS + CEI_AXIS(LOW_IND:HIGH_IND) = IDCF_XYZ(LOW_IND:HIGH_IND,X1AXIS) + DO SIDE=LOW_IND,HIGH_IND + ! Low High face: + IF ( FSID_XYZ(SIDE,X1AXIS) == CC_GASPHASE ) THEN + ! Regular Face, build 4 vertices + face: + NFACE_CELL = NFACE_CELL + 1 + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED/) + ! CC_FTYPE_RCGAS=0, regular face. + ELSEIF (FSID_XYZ(SIDE,X1AXIS) == CC_CUTCFE ) THEN + ! GasPhase CUT_FACE, add all cut-faces on these Cartesian cell + nodes + CEI = CEI_AXIS(SIDE) + DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE + NFACE_CELL = NFACE_CELL + 1 + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL)=(/ CC_FTYPE_CFGAS,SIDE,X1AXIS,CEI,ICF,CC_UNDEFINED/) + ! CC_FTYPE_CFGAS=1 + ENDDO + ENDIF + ENDDO + ENDDO X1AXIS_LOOP3 -SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS(NM) + ! Now add INBOUNDARY faces of the cell: + CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) + IF ( CEI > 0 ) THEN + DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE + NFACE_CELL = NFACE_CELL + 1 + FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB, 0, 0, CEI, ICF, CC_UNDEFINED /) + ! CC_FTYPE_CFINB in Cart-cell. + ENDDO + ENDIF -INTEGER, INTENT(IN) :: NM -INTEGER :: ICC,ICC1,I,J,K + VOL(1) = DXCELL(I)*DYCELL(J)*DZCELL(K) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZCELL(K) /) -! Block SPCELLS, cells in cut-cell region where cut-cells could not be built: -IF (MESHES(NM)%N_SPCELLS_TO_BLOCK < 1 .OR. .NOT.ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) RETURN + ! Load into CUT_CELL data structure + NCUTCELL = MESHES(NM)%N_CUTCELL_MESH + MESHES(NM)%N_GCCUTCELL_MESH + 1 + IF (INTGC_FLG==LOW_IND) THEN + MESHES(NM)%N_CUTCELL_MESH = NCUTCELL + ELSE + MESHES(NM)%N_GCCUTCELL_MESH = MESHES(NM)%N_GCCUTCELL_MESH + 1 + ENDIF + MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = NCUTCELL -DO ICC=1,MESHES(NM)%N_SPCELLS_TO_BLOCK - I = MESHES(NM)%SPCELL_LIST(IAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) - J = MESHES(NM)%SPCELL_LIST(JAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) - K = MESHES(NM)%SPCELL_LIST(KAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) - ICC1 = MESHES(NM)%CCVAR(I,J,K,CC_IDCC) - IF (ICC1 > 0) THEN - CC => MESHES(NM)%CUT_CELL(ICC1) - CC%NOADVANCE(1:CC%NCELL) = BLOCKED_SPECIAL_CELL - ENDIF -ENDDO + ! Resize array MESHES(NM)%CUT_CELL if necessary: + CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) -END SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS + ! Add cut-cell NCUTCELL entry: + MESHES(NM)%CUT_CELL(NCUTCELL)%IJK(IAXIS:KAXIS) = (/ I, J, K /) + MESHES(NM)%CUT_CELL(NCUTCELL)%NCELL = NCELL + MESHES(NM)%CUT_CELL(NCUTCELL)%NFACE_CELL= NFACE_CELL + CALL NEW_CELL_ALLOC(NM,NCUTCELL,NCELL,NFACE_CELL,NCFACE_CUTCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%CCELEM(1:NCFACE_CUTCELL,1) = (/ 6, 1, 2, 3, 4, 5, 6 /) + MESHES(NM)%CUT_CELL(NCUTCELL)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) = & + FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%VOLUME(1:NCELL) = VOL(1:NCELL) + MESHES(NM)%CUT_CELL(NCUTCELL)%XYZCEN(IAXIS:KAXIS,1:NCELL) = XYZCEN(IAXIS:KAXIS,1:NCELL) + ENDDO + ENDDO + ENDDO -SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) + IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNT ) -INTEGER, INTENT(IN) :: NM +ENDDO INTGC_FLG_LOOP2 -IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) -MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 -END SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK +DEALLOCATE(GEOMFACE,GEOMCELL) -END SUBROUTINE SET_CUTCELLS_3D +END SUBROUTINE CC_GRID_GET_REGULAR_CUTCELLS_BOX diff --git a/Source/pres.f90 b/Source/pres.f90 index 5be14cc958c..cc33083bbd8 100644 --- a/Source/pres.f90 +++ b/Source/pres.f90 @@ -3033,7 +3033,7 @@ MODULE GLOBMAT_SOLVER USE GLOBAL_CONSTANTS USE MESH_POINTERS USE COMPLEX_GEOMETRY, ONLY : CALL_FOR_GLMAT, CC_CGSC,CC_FGSC, CC_UNKH, CC_NCVARS, & - NM_START,IPARM,NNZ_ROW_H,CALL_FROM_GLMAT_SETUP + NM_START,CALL_FROM_GLMAT_SETUP USE CC_SCALARS, ONLY : GET_H_CUTFACES, GET_BOUNDFACE_GEOM_INFO_H, ADD_INPLACE_NNZ_H_WHLDOM, & COPY_CC_MUNKH_TO_UNKH, COPY_CC_UNKH_TO_HS @@ -3587,9 +3587,7 @@ SUBROUTINE GLMAT_SOLVER_SETUP(STAGE_FLAG) ! fields on each mesh: CALL GET_BOUNDFACE_GEOM_INFO_H - ! 6. Get nonzeros graph of the Poisson matrix, defined as: - ! - NNZ_D_MAT_H(1:NUNKH_LOCAL) Number of nonzeros on per matrix row. - ! - JD_MAT_H(1:NNZ_ROW_H,1:NUNKH_LOCAL) Column location of nonzeros, global numeration. + ! 6. Get nonzeros graph of the Poisson matrix: CALL GET_MATRIXGRAPH_H_WHLDOM ! Define the Graph of the Matrix for Gasphase cells on whole domain. ! 7. Build discrete Laplace operator matrix: From f1abafab6a7ba4a22b1f1fab61eea1cd811382d2 Mon Sep 17 00:00:00 2001 From: Marcos Vanella Date: Fri, 3 Apr 2026 15:34:00 -0400 Subject: [PATCH 04/18] FDS Source : Move some parameters to COMPLEX_GEOMETRY_GRID. --- Source/geom.f90 | 52 ++++++++++++++++++++----------------------------- 1 file changed, 21 insertions(+), 31 deletions(-) diff --git a/Source/geom.f90 b/Source/geom.f90 index fc447961cec..7ec3742c256 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -15,15 +15,10 @@ MODULE COMPLEX_GEOMETRY IMPLICIT NONE (TYPE,EXTERNAL) PRIVATE - CHARACTER(2*MESSAGE_LENGTH) :: MESSAGE !! --------------------------------------------------------------------------------- -! Debug Parameter: -LOGICAL, PARAMETER :: DEBUG_SET_CUTCELLS = .FALSE. - -!! --------------------------------------------------------------------------------- -! Start Variable declaration for cut-cell definition: +! Start Variable declaration for geometry routines: ! Local constants used on routines: ! LOGICAL, PARAMETER :: DO_QUAD_PRECISION_CUTCELLS = .FALSE. REAL(EB), SAVE :: GEOMEPS=1.E-12_EB @@ -31,12 +26,6 @@ MODULE COMPLEX_GEOMETRY REAL(EB), PARAMETER :: GEOMQUALITYFCT=1000._EB ! Factor for GEOMs quality check REAL(EB), PARAMETER :: GEOFCT=10._EB -! Threshold cut-cell volume ratio used to define very small cut-cells, tied to NOADVANCE. -REAL(EB), PARAMETER :: MIN_VOL_FACTOR = 5.E-4_EB -REAL(EB), PARAMETER :: ADIFF_INFO_FACTOR= 1.E-1_EB -REAL(EB), PARAMETER :: SNAP_DIST_FACTOR = 1.E-4_EB -REAL(EB), PARAMETER :: MIN_LENGTH_FACTOR= 1.E-2_EB - INTEGER, SAVE :: NGUARD = 5 ! Layers of guard-cells. INTEGER, SAVE :: CCGUARD= 5 - 2 ! Layers of guard cut-cells. @@ -119,9 +108,7 @@ MODULE COMPLEX_GEOMETRY ! Matrix vector building variables: LOGICAL, SAVE :: CC_MATVEC_DEFINED=.FALSE. -! Here H variables, case of solver from geom: -! Everything related to GLMAT_FROM_GEOM will be erased when GLMAT from pres.f90 is -! complete. +! Here H variables: INTEGER :: NM_START LOGICAL :: CALL_FOR_GLMAT = .FALSE. ! Flag to avoid MESH_CC_EXCHANGE(5) whithin GLMAT calls in PRESSURE_ITERATION_SCHEME. @@ -170,31 +157,25 @@ MODULE COMPLEX_GEOMETRY ! --------------------------------------------------------------------------------- PUBLIC :: GEOFCT,CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,CCGUARD,CC_MATVEC_DEFINED, & - GEOMEPS,DEBUG_SET_CUTCELLS,DEBUG_WAIT, & - SET_CUTCELLS_TIME_INDEX,GET_BODINT_PLANE_TIME_INDEX,GET_X2_INTERSECTIONS_TIME_INDEX, & + GEOMEPS,DEBUG_WAIT,SET_CUTCELLS_TIME_INDEX,GET_BODINT_PLANE_TIME_INDEX,GET_X2_INTERSECTIONS_TIME_INDEX, & GET_X2_VERTVAR_TIME_INDEX,GET_CARTEDGE_CUTEDGES_TIME_INDEX,GET_BODX2X3_INTERSECTIONS_TIME_INDEX, & GET_CARTFACE_CUTEDGES_TIME_INDEX,GET_CARTCELL_CUTEDGES_TIME_INDEX,GET_CARTFACE_CUTFACES_TIME_INDEX, & GET_CARTCELL_CUTFACES_TIME_INDEX,GET_CARTCELL_CUTCELLS_TIME_INDEX,INTERSECT_CONE_AABB,INTERSECT_CYLINDER_AABB, & INTERSECT_OBB_AABB,INTERSECT_SPHERE_AABB,READ_GEOM,ROTATION_MATRIX,WRITE_GEOM,WRITE_GEOM_ALL, & CC_SOLID,CC_VGSC,CC_CGSC,CC_FGSC,CC_IDCF,CC_UNKZ,CC_GASPHASE,CC_CUTCFE,CC_IDRC,CC_FTYPE_CFGAS, & CC_FTYPE_CFINB,CC_FTYPE_RGGAS,CC_IDCC,CC_EGSC,CC_IDCE,CC_ECRS,CC_INBOUNDARY,CC_UNDEFINED, & - CC_GG,CC_SS,CC_GS,CC_SG,CC_NCVARS, & - CC_UNKH,CC_UNKF,CC_ETYPE_EP,CC_ETYPE_SCINB,CC_FTYPE_SVERT,CC_ETYPE_RCGAS, & - CC_ETYPE_RGGAS,CC_ETYPE_CFGAS,CC_FTYPE_RCGAS,CC_FTYPE_CCGAS,LOOSEPS,LU_SETCC, & - MESH_CC_EXCHANGE_TIME_INDEX, & + CC_GG,CC_SS,CC_GS,CC_SG,CC_NCVARS,CC_UNKH,CC_UNKF,CC_ETYPE_EP,CC_ETYPE_SCINB,CC_FTYPE_SVERT,CC_ETYPE_RCGAS, & + CC_ETYPE_RGGAS,CC_ETYPE_CFGAS,CC_FTYPE_RCGAS,CC_FTYPE_CCGAS,LOOSEPS,LU_SETCC,MESH_CC_EXCHANGE_TIME_INDEX, & CCCOMPUTE_RADIATION_TIME_INDEX,CC_DENSITY_TIME_INDEX,CC_SET_DATA_TIME_INDEX, & INIT_CUTCELL_DATA_TIME_INDEX,CC_VELOCITY_FLUX_TIME_INDEX,CC_COMPUTE_VISCOSITY_TIME_INDEX, & CC_INTERP_FACE_VEL_TIME_INDEX,CC_DIVERGENCE_PART_1_TIME_INDEX,CC_END_STEP_TIME_INDEX, & - CC_TARGET_VELOCITY_TIME_INDEX,CC_NO_FLUX_TIME_INDEX,CC_COMPUTE_VELOCITY_ERROR_TIME_INDEX, & - MIN_VOL_FACTOR,MIN_LENGTH_FACTOR,NGUARD, & - N_SET_CUTCELLS_3D_CALLS,NM_START,N_REQ11, & - N_REQ12,N_REQ112,N_REQ13,REQ11,REQ112,REQ12,REQ13, & + CC_TARGET_VELOCITY_TIME_INDEX,CC_NO_FLUX_TIME_INDEX,CC_COMPUTE_VELOCITY_ERROR_TIME_INDEX,NGUARD, & + N_SET_CUTCELLS_3D_CALLS,NM_START,N_REQ11,N_REQ12,N_REQ112,N_REQ13,REQ11,REQ112,REQ12,REQ13, & POINT_IN_POLYGON,TEST_PT_INPOLY,RAY_TRIANGLE_INTERSECT_PT,SEARCH_OTHER_MESHES_FACE,CC_INIT_GEOM, & - GET_SEGSEG_INTERSECTION,LINE_INTERSECT_COORDPLANE, & - TRIANGULATE,TRILINEAR,VALID_TRIANGLE,VAL_TESTX_LOW,VAL_TESTX_HIGH, & + GET_SEGSEG_INTERSECTION,LINE_INTERSECT_COORDPLANE,TRIANGULATE,TRILINEAR,VALID_TRIANGLE,VAL_TESTX_LOW,VAL_TESTX_HIGH,& VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH,T_CC_USED, & - WRITE_SET_CUTCELLS_TIMINGS,MAKE_UNIQUE_VERT_ARRAY,AVERAGE_FACE_VALUES,ADIFF_INFO_FACTOR, & - SNAP_DIST_FACTOR,CC_INBOUNDCC,CC_INBOUNDCF,CC_NVVARS,CC_NEVARS,CC_NFVARS,CC_ETYPE_CFINB, & + WRITE_SET_CUTCELLS_TIMINGS,MAKE_UNIQUE_VERT_ARRAY,AVERAGE_FACE_VALUES,CC_INBOUNDCC,CC_INBOUNDCF, & + CC_NVVARS,CC_NEVARS,CC_NFVARS,CC_ETYPE_CFINB, & CC_VTYPE_VGAS,CC_VTYPE_VINB,CC_VTYPE_NINB,NODS_WSEL,EDGS_WSEL,NODS_VLEL CONTAINS @@ -5258,8 +5239,7 @@ MODULE COMPLEX_GEOMETRY_GRID USE TYPES, ONLY: BOUNDARY_COORD_TYPE, BOUNDARY_PROP1_TYPE, CFACE_TYPE, CC_CUTCELL_TYPE, CC_CUTFACE_TYPE, & CC_CUTEDGE_TYPE, CC_EDGECROSS_TYPE, CC_INBCF_AREA_TYPE, WALL_TYPE, EXTERNAL_WALL_TYPE, TBAXIS_TYPE -USE COMPLEX_GEOMETRY, ONLY: DEBUG_SET_CUTCELLS,GEOMEPS,LOOSEPS,MIN_VOL_FACTOR,ADIFF_INFO_FACTOR, & - SNAP_DIST_FACTOR,MIN_LENGTH_FACTOR,NGUARD,CCGUARD,CC_INBOUNDCC,CC_INBOUNDCF,CC_GASPHASE, & +USE COMPLEX_GEOMETRY, ONLY: GEOMEPS,LOOSEPS,NGUARD,CCGUARD,CC_INBOUNDCC,CC_INBOUNDCF,CC_GASPHASE, & CC_CUTCFE,CC_SOLID,CC_INBOUNDARY,CC_UNDEFINED,CC_GG,CC_SS,CC_GS,CC_SG,CC_VGSC,CC_NVVARS, & CC_EGSC,CC_IDCE,CC_ECRS,CC_NEVARS,CC_FGSC,CC_IDCF,CC_IDRC,CC_UNKF,CC_NFVARS,CC_CGSC, & CC_IDCC,CC_UNKZ,CC_UNKH,CC_NCVARS,CC_VTYPE_VGAS,CC_VTYPE_VINB,CC_VTYPE_NINB,CC_ETYPE_RGGAS, & @@ -5279,6 +5259,16 @@ MODULE COMPLEX_GEOMETRY_GRID INTEGER :: LU_DB_SETCC +!! --------------------------------------------------------------------------------- +! Debug Parameter: +LOGICAL, PARAMETER :: DEBUG_SET_CUTCELLS = .FALSE. + +! Local build/tuning constants: +REAL(EB), PARAMETER :: MIN_VOL_FACTOR = 5.E-4_EB +REAL(EB), PARAMETER :: ADIFF_INFO_FACTOR = 1.E-1_EB +REAL(EB), PARAMETER :: SNAP_DIST_FACTOR = 1.E-4_EB +REAL(EB), PARAMETER :: MIN_LENGTH_FACTOR = 1.E-2_EB + ! Engage NOADVANCE for small cut-cells to be dropped: LOGICAL, PARAMETER :: DO_NOADVANCE = .TRUE. From 1232822250e5eea6eec9e2f36cbf67220ccc9d64 Mon Sep 17 00:00:00 2001 From: Marcos Vanella Date: Fri, 3 Apr 2026 16:02:41 -0400 Subject: [PATCH 05/18] FDS Source: declare IPARM in GLOBMAT_SOLVER. --- Source/pres.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Source/pres.f90 b/Source/pres.f90 index 377795c160b..61307ef0876 100644 --- a/Source/pres.f90 +++ b/Source/pres.f90 @@ -3118,7 +3118,11 @@ MODULE GLOBMAT_SOLVER ! Define CC pointers: TYPE(CC_CUTCELL_TYPE), POINTER :: CC -! Pardiso or Sparse cluster solver message level: + +! Pardiso or Sparse cluster solver IPARM and message level: +#ifdef WITH_MKL +INTEGER, ALLOCATABLE :: IPARM( : ) +#endif INTEGER, SAVE :: MSGLVL = 0 ! 0 no messages, 1 print statistical information ! Factor to drop DY in cylindrical axisymmetric coordinates. From 76c82387d9fe2bbd0e45a32e6d9875dec1a04c8a Mon Sep 17 00:00:00 2001 From: Marcos Vanella Date: Fri, 3 Apr 2026 16:15:28 -0400 Subject: [PATCH 06/18] FDS Source : add SET_CVS_3D skeleton. --- Source/geom.f90 | 54 ++++++++++++++++++++++++++++++++++++------------- 1 file changed, 40 insertions(+), 14 deletions(-) diff --git a/Source/geom.f90 b/Source/geom.f90 index 7ec3742c256..8e1c0048669 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -5395,8 +5395,8 @@ MODULE COMPLEX_GEOMETRY_GRID INTEGER, PARAMETER :: BLOCKED_UNLINK_CELL= 5 INTEGER, PARAMETER :: BLOCKED_SPECIAL_CELL=6 -PUBLIC :: GET_CFACE_INDEX, POINT_IN_CFACE, RANDOM_CFACE_XYZ, SET_CUTCELLS_3D, BLOCK_CC_SOLID_EXTWALLCELLS, & - INIT_CFACE_CELL, GET_REGULAR_CUT_EDGES_BC, GET_SOLID_CUTCELL_EDGES_BC +PUBLIC :: GET_CFACE_INDEX, POINT_IN_CFACE, RANDOM_CFACE_XYZ, SET_CUTCELLS_3D, SET_CVS_3D, & + BLOCK_CC_SOLID_EXTWALLCELLS, INIT_CFACE_CELL, GET_REGULAR_CUT_EDGES_BC, GET_SOLID_CUTCELL_EDGES_BC PUBLIC :: DELTA_INT, DELTA_VERT, DIST_THRES, FDS_AREA_GEOM, INDEX_UNDEFINED, INT_N_EXT_PTS, INT_P_IND, & INT_TMP_IND, INT_VEL_IND, INT_RHO_IND, INT_H_IND, INT_RSUM_IND, INT_MU_IND, INT_MUDNS_IND, & INT_RHO0_IND, INT_WCEN_IND, INT_VELS_IND, MAX_INTERP_POINTS, NQT2C, N_CUTCELLS_PROC, & @@ -8188,6 +8188,26 @@ SUBROUTINE ALLOC_CELL_STATE_VARS(NM,ICC,NCELL) END SUBROUTINE ALLOC_CELL_STATE_VARS +SUBROUTINE SET_CVS_3D + +! Skeleton for the future control-volume driver. +! The raw cut-cell build phase has been isolated inside SET_CUTCELLS_3D and will be +! promoted to module scope before this routine is wired into callers. +! +! Future Phase 1: +! CALL CC_GRID_BUILD_RAW_CUTCELLS +! IF (STOP_STATUS==SETUP_STOP) RETURN +! +! Future Phase 2: +! BLOCK ONLY INVALID/SPECIAL CELLS +! BUILD GCELLS +! BUILD FACE TOPOLOGY +! BUILD IDENTITY CVS +! APPLY SAME-MESH AND INTER-MESH CV LINKING + +RETURN +END SUBROUTINE SET_CVS_3D + SUBROUTINE SET_CUTCELLS_3D USE MPI_F08 @@ -8248,7 +8268,6 @@ SUBROUTINE SET_CUTCELLS_3D INTEGER :: IPROC, NMESH_CC, NMESH_CC_AUX, TAG TYPE (MPI_STATUS) :: MPISTATUS CHARACTER(MESSAGE_LENGTH) :: VERBOSE_FILE, VERBOSE_FILE_AUX -CHARACTER(1), DIMENSION(3), PARAMETER :: AXSTR(1:3) = (/ 'X', 'Y', 'Z' /) REAL(EB) :: CPUTIME, CPUTIME_START, CPUTIME_MESH, CPUTIME_START_MESH INTEGER :: MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL, SUM_FACE, SUM_CCELL=0 TYPE(CFACE_TYPE), POINTER :: CFA @@ -8263,19 +8282,9 @@ SUBROUTINE SET_CUTCELLS_3D INTEGER :: ING,INOD,IWSEL,IEL,FACE_AUX(NOD1:NOD3),VOL_AUX(NOD1:NOD4),N_SPCELLCF_TOT,N_SPCELL_TOT CHARACTER(100) :: FILENAME -CALL CC_GRID_GLOBAL_INIT +CALL CC_GRID_BUILD_RAW_CUTCELLS IF (STOP_STATUS==SETUP_STOP) RETURN -CALL CC_GRID_ALLOCATE_BUILD_SCRATCH - -! Main Loop over Meshes: -MAIN_MESH_LOOP : DO NM=1,NMESHES - CALL CC_GRID_BUILD_CUTCELL_MESH(NM) - IF (STOP_STATUS==SETUP_STOP) RETURN -ENDDO MAIN_MESH_LOOP - -CALL CC_GRID_RELEASE_BUILD_SCRATCH - POSTBUILD_MESH_LOOP : DO NM=1,NMESHES CALL CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) IF (STOP_STATUS==SETUP_STOP) RETURN @@ -8311,6 +8320,23 @@ SUBROUTINE SET_CUTCELLS_3D CONTAINS +SUBROUTINE CC_GRID_BUILD_RAW_CUTCELLS + +CALL CC_GRID_GLOBAL_INIT +IF (STOP_STATUS==SETUP_STOP) RETURN + +CALL CC_GRID_ALLOCATE_BUILD_SCRATCH + +! Main Loop over Meshes: +MAIN_MESH_LOOP : DO NM=1,NMESHES + CALL CC_GRID_BUILD_CUTCELL_MESH(NM) + IF (STOP_STATUS==SETUP_STOP) RETURN +ENDDO MAIN_MESH_LOOP + +CALL CC_GRID_RELEASE_BUILD_SCRATCH + +END SUBROUTINE CC_GRID_BUILD_RAW_CUTCELLS + SUBROUTINE CC_GRID_GLOBAL_INIT IF (MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN From 59d907714fd493dfb06fdfcf46790be795504e7e Mon Sep 17 00:00:00 2001 From: Marcos Vanella Date: Wed, 8 Apr 2026 15:38:07 -0400 Subject: [PATCH 07/18] FDS Source: Move CC_GRID_BUILD_RAW_CUTCELLS out of SET_CUTCELLS_3D. --- Source/geom.f90 | 3416 +++++++++++++++++++---------------------------- 1 file changed, 1378 insertions(+), 2038 deletions(-) diff --git a/Source/geom.f90 b/Source/geom.f90 index e67a5828fec..e4c868f7aef 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -8186,13 +8186,20 @@ END SUBROUTINE ALLOC_CELL_STATE_VARS SUBROUTINE SET_CVS_3D +INTEGER :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, ALLOCATABLE, DIMENSION(:) :: CC_COMPUTE_MESH +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_ZMAX_AUX +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW +REAL(EB) :: TNOW, CPUTIME_START_MESH +LOGICAL, SAVE :: FIRST_CALL_ARG=.TRUE., FIRST_CALL_ARG2=.TRUE. + ! Skeleton for the future control-volume driver. -! The raw cut-cell build phase has been isolated inside SET_CUTCELLS_3D and will be -! promoted to module scope before this routine is wired into callers. ! -! Future Phase 1: -! CALL CC_GRID_BUILD_RAW_CUTCELLS -! IF (STOP_STATUS==SETUP_STOP) RETURN +! Phase 1 now reuses the shared raw cut-cell build path. +CALL CC_GRID_BUILD_RAW_CUTCELLS(ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH,GEOM_ZMAX_AUX, & + TNOW,CPUTIME_START_MESH,GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW, & + FIRST_CALL_ARG,FIRST_CALL_ARG2) +IF (STOP_STATUS==SETUP_STOP) RETURN ! ! Future Phase 2: ! BLOCK ONLY INVALID/SPECIAL CELLS @@ -8213,7 +8220,6 @@ SUBROUTINE SET_CUTCELLS_3D INTEGER :: NM, NOM ! Miscellaneous: -REAL(EB) :: X1PLN INTEGER :: NCUTFACE_IAXIS, NCUTFACE_JAXIS, NCUTFACE_KAXIS, ICE1, ICF1, NFACE, IERR, & NCUTEDGE_IBCC, NCUTEDGE_IBCF REAL(EB):: CF_AREA_IAXIS=0._EB, CF_AREA_JAXIS=0._EB, CF_AREA_KAXIS=0._EB, & @@ -8225,14 +8231,14 @@ SUBROUTINE SET_CUTCELLS_3D DM_XYZCEN(MAX_DIM), CCGP_XYZCEN(MAX_DIM), DM_XYZCEN_AUX(MAX_DIM), CCGP_XYZCEN_AUX(MAX_DIM) INTEGER :: SEG(NOD1:NOD2), NEDGE, IEDGE, IFACE, IG -INTEGER :: NCUTFACE_INB, ICC1, ICC2, NCELL, IGC, ICF2, JCF2, JCF, FTYPE, ILH, CELL_BLOCK_IOR +INTEGER :: NCUTFACE_INB, ICC1, ICC2, NCELL, ICF2, JCF2, JCF, FTYPE, ILH, CELL_BLOCK_IOR REAL(EB):: CF_AREA_INB=0._EB, CF_INXAREA_INB=0._EB, CF_INXSQAREA_INB=0._EB, & CF_JNYSQAREA_INB=0._EB, CF_KNZSQAREA_INB=0._EB, CF_AREA_INB_AUX=0._EB, ACRT REAL(EB):: CC_VOLUME_INB=0._EB, DM_VOLUME=0._EB, GP_VOLUME=0._EB, & CC_VOLUME_INB_AUX=0._EB, DM_VOLUME_AUX=0._EB, GP_VOLUME_AUX=0._EB INTEGER, DIMENSION(5) :: MIN_CC_IJK_ICCJCC, MAX_CC_IJK_ICCJCC REAL(EB):: MIN_CC_VOL, MAX_CC_VOL, MIN_ALPHA_CV, MAX_ALPHA_CV -LOGICAL, ALLOCATABLE, DIMENSION(:) :: CC_COMPUTE_MESH, CC_COMPUTE_MESH_AUX +LOGICAL, ALLOCATABLE, DIMENSION(:) :: CC_COMPUTE_MESH REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_ZMAX_AUX INTEGER :: IW,II,JJ,IIF,JJF,KKF,IIOF,JJOF,KKOF,LOHIF,IOR,CT,NCFACE_CUTCELL,NFACE_CELL,AX,SIDE,ICC,JCC,ICFC,IFC @@ -8261,9 +8267,6 @@ SUBROUTINE SET_CUTCELLS_3D INTEGER, SAVE :: CALL_COUNT = 0 ! GET_CUTCELL_VERBOSE variables: -INTEGER :: IPROC, NMESH_CC, NMESH_CC_AUX, TAG -TYPE (MPI_STATUS) :: MPISTATUS -CHARACTER(MESSAGE_LENGTH) :: VERBOSE_FILE, VERBOSE_FILE_AUX REAL(EB) :: CPUTIME, CPUTIME_START, CPUTIME_MESH, CPUTIME_START_MESH INTEGER :: MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL, SUM_FACE, SUM_CCELL=0 TYPE(CFACE_TYPE), POINTER :: CFA @@ -8274,11 +8277,13 @@ SUBROUTINE SET_CUTCELLS_3D LOGICAL, SAVE :: FIRST_CALL_ARG=.TRUE., FIRST_CALL_ARG2=.TRUE. -REAL(EB):: VERT_AUX(IAXIS:KAXIS),CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) -INTEGER :: ING,INOD,IWSEL,IEL,FACE_AUX(NOD1:NOD3),VOL_AUX(NOD1:NOD4),N_SPCELLCF_TOT,N_SPCELL_TOT +REAL(EB):: CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) +INTEGER :: N_SPCELLCF_TOT,N_SPCELL_TOT CHARACTER(100) :: FILENAME -CALL CC_GRID_BUILD_RAW_CUTCELLS +CALL CC_GRID_BUILD_RAW_CUTCELLS(ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH,GEOM_ZMAX_AUX, & + TNOW,CPUTIME_START_MESH,GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW, & + FIRST_CALL_ARG,FIRST_CALL_ARG2) IF (STOP_STATUS==SETUP_STOP) RETURN POSTBUILD_MESH_LOOP : DO NM=1,NMESHES @@ -8316,725 +8321,445 @@ SUBROUTINE SET_CUTCELLS_3D CONTAINS -SUBROUTINE CC_GRID_BUILD_RAW_CUTCELLS - -CALL CC_GRID_GLOBAL_INIT -IF (STOP_STATUS==SETUP_STOP) RETURN - -CALL CC_GRID_ALLOCATE_BUILD_SCRATCH +SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) -! Main Loop over Meshes: -MAIN_MESH_LOOP : DO NM=1,NMESHES - CALL CC_GRID_BUILD_CUTCELL_MESH(NM) - IF (STOP_STATUS==SETUP_STOP) RETURN -ENDDO MAIN_MESH_LOOP +INTEGER, INTENT(IN) :: NM -CALL CC_GRID_RELEASE_BUILD_SCRATCH +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 -END SUBROUTINE CC_GRID_BUILD_RAW_CUTCELLS +CALL POINT_TO_MESH(NM) +M => MESHES(NM) +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) -SUBROUTINE CC_GRID_GLOBAL_INIT +CALL CC_GRID_BLOCK_SPECIAL_CELLS(NM) +CALL CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) -IF (MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN - WRITE(LU_ERR,*) ' ' - WRITE(LU_ERR,*) 'SET_CUTCELLS_3D : Cut-Cell computation in VERBOSE mode, 4 tasks to perform:' +IF (ONE_CC_PER_CARTESIAN_CELL) THEN + ! Here Block all cells that have volume less (or equal) than the first largest cell found. + DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + CC=>MESHES(NM)%CUT_CELL(ICC1) + NCELL=0 + DO J=1,CC%NCELL + IF(CC%NOADVANCE(J)==NOT_BLOCKED) NCELL=NCELL+1 + ENDDO + IF(NCELL<2) CYCLE + ! Find if any GEOMETRY related to CC_INBOUNDARY faces has CELL_BLOCK_IOR>0: + CELL_BLOCK_IOR=0; CELL_BLOCK_ORIENTATION = 0._EB + NCELL_LOOP_1 : DO J=1,CC%NCELL + DO I=2,CC%CCELEM(1,J)+1 + IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN + ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) + IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) + IF(IG>0) THEN + IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN + CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION + ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN + CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR + EXIT NCELL_LOOP_1 + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO NCELL_LOOP_1 + ALLOCATE(VOLUME(1:CC%NCELL)); VOLUME(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN + ! Cell Block Orientation: + DO J=1,CC%NCELL; VOLUME(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)); ENDDO + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN + ! Make search for double precision min/max unambiguous. + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS,IAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) + CASE(-JAXIS,JAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) + CASE(-KAXIS,KAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) + END SELECT + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( IAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE(-JAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( JAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE(-KAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( KAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + END SELECT + ENDIF + DEALLOCATE(VOLUME) + NCELL_LOOP_2 : DO J=1,CC%NCELL + IF(J==I) CYCLE NCELL_LOOP_2 + IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL + ENDDO NCELL_LOOP_2 + ENDDO ENDIF -! Reset variables: -CC_NEDGECROSS = 0 -CC_NCUTEDGE = 0 -CC_NCUTFACE = 0 -CC_NCUTCELL = 0 +CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) -! Check Meshes Boundaries match, requirement to get consistent ghost and internal cut-cells. -CALL CHECK_WALL_CELL_PLANE_MATCH; IF (STOP_STATUS==SETUP_STOP) RETURN +! Here: 1,2. Define Linking information for cut-cells. +CALL GET_CELL_LINK_INFO(NM) -! Get geometry triangle bins in Cartesian directions: -CALL GET_GEOM_TRIBIN +IF(PROCESS(NM)==MY_RANK) THEN ! Here Add Blocked Areas per SURF_ID: + ALLOCATE(MESHES(NM)%INBCF_AREA(0:MESHES(NM)%IBP1,0:MESHES(NM)%JBP1,0:MESHES(NM)%KBP1)) + DO K=1,M%KBAR + DO J=1,M%JBAR + DO I=1,M%IBAR + ICC = MESHES(NM)%CCVAR(I,J,K,CC_IDCC); IF(ICC<1) CYCLE + CC =>MESHES(NM)%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + IF(CC%NOADVANCE(JCC)<1) CYCLE + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE=CC%CCELEM(IFC,JCC) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO +ENDIF +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) -! Snap to grid planes node positions in the work volume of this process: -CALL SNAP_GEOM_NODES +END SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH -! Initialize GEOMETRY fields used by CC_IBM: -CALL CC_INIT_GEOM; IF (STOP_STATUS==SETUP_STOP) RETURN +! ----------------------- BLOCK_SMALL_UNLINKED_CUTCELLS ---------------------------- -TNOW=CURRENT_TIME() +SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS(NM,NBLKCELLS) -DEBUG_SET_CUTCELLS_COND : IF (DEBUG_SET_CUTCELLS) THEN - ! Write meshes file: - WRITE(FILENAME,'(A,A)') TRIM(CHID),'_meshes.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8)') NMESHES - MESH_LOOP : DO NM=1,NMESHES +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(OUT):: NBLKCELLS - IF (PROCESS(NM)/=MY_RANK) CYCLE +INTEGER :: ICC,JCC,I,J,K,IFC,IEC,JEC,IVR,DUM,NSEG,ISEG,JFC,INOD1,INOD2,X1AXIS,COUNT,NCELL +TYPE(MESH_TYPE), POINTER :: M +CHARACTER(100) :: FILENAME - ! Mesh sizes: - NXB=MESHES(NM)%IBAR - NYB=MESHES(NM)%JBAR - NZB=MESHES(NM)%KBAR +M => MESHES(NM) +NBLKCELLS = 0 - WRITE(33,'(4I8,6F24.16)') NM,NXB,NYB,NZB,MESHES(NM)%X(0),MESHES(NM)%X(NXB),& - MESHES(NM)%Y(0),MESHES(NM)%Y(NYB),& - MESHES(NM)%Z(0),MESHES(NM)%Z(NZB) - DO I=0,NXB - WRITE(33,'(4F24.16)') MESHES(NM)%X(I),MESHES(NM)%XC(I),MESHES(NM)%DXN(I),MESHES(NM)%DX(I) +IF(DEBUG_SET_CUTCELLS) THEN + + ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges1.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH + DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH + CE=>MESHES(NM)%CUT_EDGE(IEC) + WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) + DO IVR=1,CE%NVERT + WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) ENDDO - DO J=0,NYB - WRITE(33,'(4F24.16)') MESHES(NM)%Y(J),MESHES(NM)%YC(J),MESHES(NM)%DYN(J),MESHES(NM)%DY(J) + DO IVR=1,CE%NVERT + WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) ENDDO - DO K=0,NZB - WRITE(33,'(4F24.16)') MESHES(NM)%Z(K),MESHES(NM)%ZC(K),MESHES(NM)%DZN(K),MESHES(NM)%DZ(K) + DO JEC=1,CE%NEDGE + WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) ENDDO - - ENDDO MESH_LOOP + DO JEC=1,CE%NEDGE + WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& + CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) + ENDDO + ENDDO CLOSE(33) - ! Write geometry files: - WRITE(FILENAME,'(A,A)') TRIM(CHID),'_num_geometries.dat' + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces1.dat' OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I6,4F24.16)') N_GEOMETRY, GEOMEPS - CLOSE(33) - GEOM_LOOP : DO ING=1,N_GEOMETRY - - ! Write Vertices: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_verts.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO INOD=1,GEOMETRY(ING)%N_VERTS - VERT_AUX(IAXIS:KAXIS) = GEOMETRY(ING)%VERTS(MAX_DIM*(INOD-1)+1:MAX_DIM*INOD) - WRITE(33,'(3F24.16)') VERT_AUX(IAXIS:KAXIS) + WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH + DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 + IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 + WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) + DO IVR=1,CF%NVERT + WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) ENDDO - CLOSE(33) - - ! Write faces: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_faces.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IWSEL=1,GEOMETRY(ING)%N_FACES - FACE_AUX(NOD1:NOD3)=GEOMETRY(ING)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) - WRITE(33,'(4I10)') FACE_AUX(NOD1:NOD3),GEOMETRY(ING)%SURFS(IWSEL) + DO JFC=1,CF%NFACE + WRITE(33,'(I6,I6)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) + DO DUM=1,CF%CFELEM(1,JFC) + WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) + ENDDO + DO DUM=1,CF%CEDGES(1,JFC) + WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) + ENDDO ENDDO - CLOSE(33) - - ! Write Volumes: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_volus.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_VOLUS - VOL_AUX(NOD1:NOD4)=GEOMETRY(ING)%VOLUS(NODS_VLEL*(IEL-1)+1:NODS_VLEL*IEL) - WRITE(33,'(4I10)') VOL_AUX(NOD1:NOD4) + DO ISEG=1,NSEG + WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) ENDDO - CLOSE(33) - - ! Write Edges: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edges.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_EDGES - WRITE(33,'(2I10)') GEOMETRY(ING)%EDGES(NOD1:NOD2,IEL) + DO JFC=1,CF%NFACE + WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) ENDDO - CLOSE(33) + ENDDO + CLOSE(33) +ENDIF - ! Write FACE_EDGES: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_fcedg.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_FACES - WRITE(33,'(3I10)') GEOMETRY(ING)%FACE_EDGES(NOD1:NOD3,IEL) +! Create new cut-edges and faces: +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + JCC_LOOP : DO JCC=1,M%CUT_CELL(ICC)%NCELL + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP + NBLKCELLS = NBLKCELLS + 1 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,1) + ENDDO JCC_LOOP ENDDO - CLOSE(33) + ENDDO +ENDDO - ! Write EDGE_FACES: - WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edfac.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - DO IEL=1,GEOMETRY(ING)%N_EDGES - WRITE(33,'(5I10)') GEOMETRY(ING)%EDGE_FACES(NOD1:NOD4+1,IEL) +! Drop cut-edges and faces that were gas or boundary of blocked cells. +COUNT=0 +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + NCELL = M%CUT_CELL(ICC)%NCELL + JCC_LOOP_2 : DO JCC=1,NCELL + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_2 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,2) + ENDDO JCC_LOOP_2 ENDDO - CLOSE(33) - - ENDDO GEOM_LOOP -ENDIF DEBUG_SET_CUTCELLS_COND + ENDDO +ENDDO -! Select MESHES assigned to MY_RANK and OMESHES of these. Cut-cells computed for all of them. Done in GET_GEOM_TRIBIN +! Drop blocked cells: +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + NCELL = M%CUT_CELL(ICC)%NCELL + JCC_LOOP_3 : DO JCC=NCELL,1,-1 + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_3 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,3) + ENDDO JCC_LOOP_3 + ENDDO + ENDDO +ENDDO +! Build remaining Regular shaped GASPHASE cut-faces: +CALL GET_REMAINING_CUTFACES(NM) +! Build remaining Regular shaped GASPHASE cut-cells: +CALL GET_REMAINING_CUTCELLS(NM) +! Clean up CUT_CELL, CUT_FACE arrays: +CALL CUT_CELL_FACE_ARRAYS_CLEANUP(NM) -IF (GET_CUTCELLS_VERBOSE) THEN - NMESH_CC=0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH(NOM)) NMESH_CC = NMESH_CC + 1 +IF(DEBUG_SET_CUTCELLS) THEN + ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges2.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH + DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH + CE=>MESHES(NM)%CUT_EDGE(IEC) + WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) + DO IVR=1,CE%NVERT + WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) + ENDDO + DO IVR=1,CE%NVERT + WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& + CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) + ENDDO ENDDO - ! MY_RANK = 0 writes first: - IF (MY_RANK==0) THEN - ! Open file to write SET_CUTCELLS_3D progress: - WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' - OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') - WRITE(LU_ERR,*) ' ' - WRITE(LU_ERR,*) '2. Generate Cut-cells in Meshes :' - WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC, & - ' meshes in file ',TRIM(VERBOSE_FILE),'.' - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' - WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC,' meshes.' - WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' - WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process : ' - NMESH_CC_AUX = 0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH(NOM)) THEN - NMESH_CC_AUX = NMESH_CC_AUX + 1 - IF(NMESH_CC_AUX < NMESH_CC) THEN - WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' - WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' - ELSE - WRITE(LU_ERR,'(I4.4,A)') NOM,'.' - WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' - ENDIF - ENDIF + CLOSE(33) + + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces2.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH + DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 + IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 + WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) + DO IVR=1,CF%NVERT + WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) ENDDO - ENDIF - IF (N_MPI_PROCESSES > 1) THEN - IF (MY_RANK==0) ALLOCATE(CC_COMPUTE_MESH_AUX(1:NMESHES)) - ! Now rest of processes pass their mesh info to process 0: - DO IPROC=1,N_MPI_PROCESSES-1 - TAG = 0 - IF (MY_RANK==IPROC) THEN ! Send CC_COMPUTE_MESH array. - TAG=IPROC - CALL MPI_SEND(CC_COMPUTE_MESH(1),NMESHES,MPI_LOGICAL,0,TAG,MPI_COMM_WORLD,IERR) - ! Open file to write SET_CUTCELLS_3D progress: - WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' - OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' - WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC,' meshes.' - WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process :' - NMESH_CC_AUX = 0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH(NOM)) THEN - NMESH_CC_AUX = NMESH_CC_AUX + 1 - IF ( NMESH_CC_AUX < NMESH_CC ) THEN - WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' - ELSE - WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' - ENDIF + DO JFC=1,CF%NFACE + WRITE(33,'(I8,I8)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) + DO DUM=1,CF%CFELEM(1,JFC) + WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) + ENDDO + DO DUM=1,CF%CEDGES(1,JFC) + WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) + ENDDO + ENDDO + DO ISEG=1,NSEG + WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) + ENDDO + ENDDO + CLOSE(33) + + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeECVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%ECVAR(I,J,K,CC_EGSC,IAXIS),& + M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) + DO X1AXIS=IAXIS,KAXIS + IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN + IEC=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) + IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT EDGE does not match ECVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE + DO JEC=1,CE%NEDGE + INOD1=CE%CEELEM(NOD1,JEC) + INOD2=CE%CEELEM(NOD2,JEC) + WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) + WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) + IF(CE%VERT_LIST(1,INOD1)==CE%VERT_LIST(1,INOD2) .AND. & + CE%VERT_LIST(2,INOD1)==CE%VERT_LIST(2,INOD2) .AND. & + CE%VERT_LIST(3,INOD1)==CE%VERT_LIST(3,INOD2) .AND. & + CE%VERT_LIST(4,INOD1)==CE%VERT_LIST(4,INOD2)) THEN + IF(CE%VERT_LIST(1,INOD1)/=CC_VTYPE_NINB) & + WRITE(LU_ERR,*) 'Edge with same node types=',IEC,JEC,CE%NEDGE,CE%XYZVERT(:,INOD1),& + CE%XYZVERT(:,INOD2),CE%VERT_LIST(1:4,INOD1) + ENDIF + ENDDO ENDIF ENDDO - ELSEIF (MY_RANK==0) THEN ! Receive CC_COMPUTE_MESH array and write. - TAG=IPROC - CALL MPI_RECV(CC_COMPUTE_MESH_AUX(1),NMESHES,MPI_LOGICAL,IPROC,TAG,MPI_COMM_WORLD,MPISTATUS,IERR) - ! Write to LU_ERR: - NMESH_CC=0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH_AUX(NOM)) NMESH_CC = NMESH_CC + 1 - ENDDO - WRITE(VERBOSE_FILE_AUX,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',IPROC,'.log' - WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC, & - ' meshes in file ',TRIM(VERBOSE_FILE_AUX),'.' - WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' - NMESH_CC_AUX = 0 - DO NOM=1,NMESHES - IF(CC_COMPUTE_MESH_AUX(NOM)) THEN - NMESH_CC_AUX = NMESH_CC_AUX + 1 - IF ( NMESH_CC_AUX < NMESH_CC ) THEN - WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' - ELSE - WRITE(LU_ERR,'(I4.4,A)') NOM,'.' - ENDIF + ENDDO + ENDDO + ENDDO + CLOSE(33) + + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + DO X1AXIS=IAXIS,KAXIS + IF(M%FCVAR(I,J,K,CC_IDCE,X1AXIS)>0)THEN + IEC=M%FCVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) + IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT EDGE does not match FCVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE + DO JEC=1,CE%NEDGE + INOD1=CE%CEELEM(NOD1,JEC) + INOD2=CE%CEELEM(NOD2,JEC) + WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) + WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) + ENDDO ENDIF ENDDO - ENDIF - CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) + ENDDO ENDDO - IF (MY_RANK==0) DEALLOCATE(CC_COMPUTE_MESH_AUX) - ENDIF - CALL CPU_TIME(CPUTIME_START_MESH) -ENDIF - -IF(N_GEOMETRY>0) THEN - ALLOCATE(GEOM_AREA_SURF_OLD(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_OLD=0._EB - ALLOCATE(GEOM_AREA_SURF_NEW(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_NEW=0._EB -ENDIF - -END SUBROUTINE CC_GRID_GLOBAL_INIT + ENDDO + CLOSE(33) -SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH -CALL CC_GRID_ALLOCATE_BUILD_SCRATCH_WORK(FIRST_CALL_ARG,FIRST_CALL_ARG2) + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaceFCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%FCVAR(I,J,K,CC_FGSC,IAXIS),& + M%FCVAR(I,J,K,CC_FGSC,JAXIS),M%FCVAR(I,J,K,CC_FGSC,KAXIS) + DO X1AXIS=IAXIS,KAXIS + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)==CC_CUTCFE)THEN + IEC=M%FCVAR(I,J,K,CC_IDCF,X1AXIS); CF=>M%CUT_FACE(IEC) + IF(CF%IJK(IAXIS)/=I .OR. CF%IJK(JAXIS)/=J .OR. CF%IJK(KAXIS)/=K .OR. CF%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT FACE does not match FCVAR',I,J,K,X1AXIS,':',CF%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE + DO JEC=1,CF%NFACE + WRITE(33,'(I8,3F16.8,F16.8)') CF%IJK(4),CF%XYZCEN(:,JEC),CF%AREA(JEC) + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CLOSE(33) -END SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH - -SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH - -CALL CC_GRID_RELEASE_BUILD_SCRATCH_WORK - -END SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH - -SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH(NM) - -INTEGER, INTENT(IN) :: NM - -IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. -IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 - -CALL POINT_TO_MESH(NM) -M => MESHES(NM) -! Mesh sizes: -NXB=IBAR -NYB=JBAR -NZB=KBAR - -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) -CALL CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) - -REGCC_REGION_IF : IF(PERIODIC_TEST==7 .OR. PERIODIC_TEST==11) THEN - - CALL GET_REGULAR_CUTCELLS_BOX - -ELSE - - CALL CC_GRID_BUILD_CUTCELL_MESH_WORK(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) - -ENDIF REGCC_REGION_IF - -CALL CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) -CALL CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -CALL CC_GRID_RELEASE_CELLRT - -END SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH - -SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) - -INTEGER, INTENT(IN) :: NM - -IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. -IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 - -CALL POINT_TO_MESH(NM) -M => MESHES(NM) -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) - -CALL CC_GRID_BLOCK_SPECIAL_CELLS(NM) -CALL CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) - -IF (ONE_CC_PER_CARTESIAN_CELL) THEN - ! Here Block all cells that have volume less (or equal) than the first largest cell found. - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%CUT_CELL(ICC1) - NCELL=0 - DO J=1,CC%NCELL - IF(CC%NOADVANCE(J)==NOT_BLOCKED) NCELL=NCELL+1 - ENDDO - IF(NCELL<2) CYCLE - ! Find if any GEOMETRY related to CC_INBOUNDARY faces has CELL_BLOCK_IOR>0: - CELL_BLOCK_IOR=0; CELL_BLOCK_ORIENTATION = 0._EB - NCELL_LOOP_1 : DO J=1,CC%NCELL - DO I=2,CC%CCELEM(1,J)+1 - IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN - ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) - IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) - IF(IG>0) THEN - IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN - CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION - ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN - CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR - EXIT NCELL_LOOP_1 - ENDIF - ENDIF - ENDIF - ENDDO - ENDDO NCELL_LOOP_1 - ALLOCATE(VOLUME(1:CC%NCELL)); VOLUME(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN - ! Cell Block Orientation: - DO J=1,CC%NCELL; VOLUME(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)); ENDDO - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN - ! Make search for double precision min/max unambiguous. - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS,IAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) - CASE(-JAXIS,JAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) - CASE(-KAXIS,KAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) - END SELECT - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( IAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-JAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( JAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-KAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( KAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - END SELECT - ENDIF - DEALLOCATE(VOLUME) - NCELL_LOOP_2 : DO J=1,CC%NCELL - IF(J==I) CYCLE NCELL_LOOP_2 - IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL - ENDDO NCELL_LOOP_2 - ENDDO -ENDIF - -CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) - -! Here: 1,2. Define Linking information for cut-cells. -CALL GET_CELL_LINK_INFO(NM) - -IF(PROCESS(NM)==MY_RANK) THEN ! Here Add Blocked Areas per SURF_ID: - ALLOCATE(MESHES(NM)%INBCF_AREA(0:MESHES(NM)%IBP1,0:MESHES(NM)%JBP1,0:MESHES(NM)%KBP1)) - DO K=1,M%KBAR - DO J=1,M%JBAR - DO I=1,M%IBAR - ICC = MESHES(NM)%CCVAR(I,J,K,CC_IDCC); IF(ICC<1) CYCLE - CC =>MESHES(NM)%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)<1) CYCLE - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE=CC%CCELEM(IFC,JCC) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE - ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutcellCCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8)') I,J,K,M%CCVAR(I,J,K,CC_CGSC) + IF(M%CCVAR(I,J,K,CC_CGSC)==CC_CUTCFE)THEN + IEC=M%CCVAR(I,J,K,CC_IDCC); CC=>M%CUT_CELL(IEC) + IF(CC%IJK(IAXIS)/=I .OR. CC%IJK(JAXIS)/=J .OR. CC%IJK(KAXIS)/=K) & + WRITE(LU_ERR,*) 'CUT CELL does not match CCVAR',I,J,K,':',CC%IJK(IAXIS:KAXIS) + WRITE(33,'(I8,I8,I8,I8,I8)') CC%IJK(1:3),CC%NCELL + DO JEC=1,CC%NCELL + WRITE(33,'(I8,3F16.8,F16.8)') JEC,CC%XYZCEN(:,JEC),CC%VOLUME(JEC) ENDDO - ENDDO + ENDIF ENDDO ENDDO ENDDO + CLOSE(33) ENDIF -CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -END SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH +RETURN +END SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS -! ----------------------- BLOCK_SMALL_UNLINKED_CUTCELLS ---------------------------- +! ------------------------- GET_REMAINING_CUTCELLS -------------------------------- -SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS(NM,NBLKCELLS) +SUBROUTINE GET_REMAINING_CUTCELLS(NM) +! Define regular cut-cells for regular cartesian cells surrounded by a gas cut-face. INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(OUT):: NBLKCELLS -INTEGER :: ICC,JCC,I,J,K,IFC,IEC,JEC,IVR,DUM,NSEG,ISEG,JFC,INOD1,INOD2,X1AXIS,COUNT,NCELL +! Local Variables: +INTEGER :: I,J,K,CT,X1AXIS,SIDE,ICC,JCC,IFACE,ICF,JCF,ICFC,ICFINB,NCFACE_CUTCELL,NCELL,NFACE_CELL +INTEGER :: NCC_MESH,NGC_MESH,NCELL_IN,NCELL_GC,COUNT_CC,COUNT_GC +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME +INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) TYPE(MESH_TYPE), POINTER :: M -CHARACTER(100) :: FILENAME +TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX +LOGICAL, PARAMETER :: OPT=.TRUE. M => MESHES(NM) -NBLKCELLS = 0 - -IF(DEBUG_SET_CUTCELLS) THEN - - ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges1.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH - DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH - CE=>MESHES(NM)%CUT_EDGE(IEC) - WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) - DO IVR=1,CE%NVERT - WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO IVR=1,CE%NVERT - WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& - CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) - ENDDO - ENDDO - CLOSE(33) - - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces1.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH - DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 - IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 - WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) - DO IVR=1,CF%NVERT - WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(I6,I6)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) - DO DUM=1,CF%CFELEM(1,JFC) - WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) - ENDDO - DO DUM=1,CF%CEDGES(1,JFC) - WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) - ENDDO - ENDDO - DO ISEG=1,NSEG - WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) - ENDDO - ENDDO - CLOSE(33) -ENDIF -! Create new cut-edges and faces: +! First thing is, for known cut-cells with reg faces that have changed to cut-faces to change the +! FACE_LIST incidence: DO K=-1,M%KBAR+2 DO J=-1,M%JBAR+2 DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - JCC_LOOP : DO JCC=1,M%CUT_CELL(ICC)%NCELL - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP - NBLKCELLS = NBLKCELLS + 1 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,1) - ENDDO JCC_LOOP + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_CUTCFE) CYCLE + ICC=M%CCVAR(I,J,K,CC_IDCC) + CC=>M%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + DO ICF=2,CC%CCELEM(1,JCC)+1 + IFACE = CC%CCELEM(ICF,JCC) + SIDE = CC%FACE_LIST(2,IFACE) + X1AXIS= CC%FACE_LIST(3,IFACE) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE + ICFC = M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS) + IF(ICFC>0) CC%FACE_LIST(:,IFACE) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) ! New cut-face. + ENDDO + ENDDO ENDDO ENDDO ENDDO -! Drop cut-edges and faces that were gas or boundary of blocked cells. -COUNT=0 -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - NCELL = M%CUT_CELL(ICC)%NCELL - JCC_LOOP_2 : DO JCC=1,NCELL - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_2 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,2) - ENDDO JCC_LOOP_2 - ENDDO - ENDDO -ENDDO - -! Drop blocked cells: -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - NCELL = M%CUT_CELL(ICC)%NCELL - JCC_LOOP_3 : DO JCC=NCELL,1,-1 - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_3 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,3) - ENDDO JCC_LOOP_3 - ENDDO - ENDDO -ENDDO -! Build remaining Regular shaped GASPHASE cut-faces: -CALL GET_REMAINING_CUTFACES(NM) -! Build remaining Regular shaped GASPHASE cut-cells: -CALL GET_REMAINING_CUTCELLS(NM) -! Clean up CUT_CELL, CUT_FACE arrays: -CALL CUT_CELL_FACE_ARRAYS_CLEANUP(NM) - -IF(DEBUG_SET_CUTCELLS) THEN - ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges2.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH - DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH - CE=>MESHES(NM)%CUT_EDGE(IEC) - WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) - DO IVR=1,CE%NVERT - WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO IVR=1,CE%NVERT - WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& - CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) - ENDDO - ENDDO - CLOSE(33) - - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces2.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH - DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 - IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 - WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) - DO IVR=1,CF%NVERT - WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(I8,I8)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) - DO DUM=1,CF%CFELEM(1,JFC) - WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) - ENDDO - DO DUM=1,CF%CEDGES(1,JFC) - WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) - ENDDO - ENDDO - DO ISEG=1,NSEG - WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) - ENDDO - ENDDO - CLOSE(33) - - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeECVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%ECVAR(I,J,K,CC_EGSC,IAXIS),& - M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) - DO X1AXIS=IAXIS,KAXIS - IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN - IEC=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) - IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT EDGE does not match ECVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE - DO JEC=1,CE%NEDGE - INOD1=CE%CEELEM(NOD1,JEC) - INOD2=CE%CEELEM(NOD2,JEC) - WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) - WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) - IF(CE%VERT_LIST(1,INOD1)==CE%VERT_LIST(1,INOD2) .AND. & - CE%VERT_LIST(2,INOD1)==CE%VERT_LIST(2,INOD2) .AND. & - CE%VERT_LIST(3,INOD1)==CE%VERT_LIST(3,INOD2) .AND. & - CE%VERT_LIST(4,INOD1)==CE%VERT_LIST(4,INOD2)) THEN - IF(CE%VERT_LIST(1,INOD1)/=CC_VTYPE_NINB) & - WRITE(LU_ERR,*) 'Edge with same node types=',IEC,JEC,CE%NEDGE,CE%XYZVERT(:,INOD1),& - CE%XYZVERT(:,INOD2),CE%VERT_LIST(1:4,INOD1) - ENDIF - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) - - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - DO X1AXIS=IAXIS,KAXIS - IF(M%FCVAR(I,J,K,CC_IDCE,X1AXIS)>0)THEN - IEC=M%FCVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) - IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT EDGE does not match FCVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE - DO JEC=1,CE%NEDGE - INOD1=CE%CEELEM(NOD1,JEC) - INOD2=CE%CEELEM(NOD2,JEC) - WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) - WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) - - - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaceFCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%FCVAR(I,J,K,CC_FGSC,IAXIS),& - M%FCVAR(I,J,K,CC_FGSC,JAXIS),M%FCVAR(I,J,K,CC_FGSC,KAXIS) - DO X1AXIS=IAXIS,KAXIS - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)==CC_CUTCFE)THEN - IEC=M%FCVAR(I,J,K,CC_IDCF,X1AXIS); CF=>M%CUT_FACE(IEC) - IF(CF%IJK(IAXIS)/=I .OR. CF%IJK(JAXIS)/=J .OR. CF%IJK(KAXIS)/=K .OR. CF%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT FACE does not match FCVAR',I,J,K,X1AXIS,':',CF%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE - DO JEC=1,CF%NFACE - WRITE(33,'(I8,3F16.8,F16.8)') CF%IJK(4),CF%XYZCEN(:,JEC),CF%AREA(JEC) - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) - - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutcellCCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8)') I,J,K,M%CCVAR(I,J,K,CC_CGSC) - IF(M%CCVAR(I,J,K,CC_CGSC)==CC_CUTCFE)THEN - IEC=M%CCVAR(I,J,K,CC_IDCC); CC=>M%CUT_CELL(IEC) - IF(CC%IJK(IAXIS)/=I .OR. CC%IJK(JAXIS)/=J .OR. CC%IJK(KAXIS)/=K) & - WRITE(LU_ERR,*) 'CUT CELL does not match CCVAR',I,J,K,':',CC%IJK(IAXIS:KAXIS) - WRITE(33,'(I8,I8,I8,I8,I8)') CC%IJK(1:3),CC%NCELL - DO JEC=1,CC%NCELL - WRITE(33,'(I8,3F16.8,F16.8)') JEC,CC%XYZCEN(:,JEC),CC%VOLUME(JEC) - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - CLOSE(33) -ENDIF - -RETURN -END SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS - -! ------------------------- GET_REMAINING_CUTCELLS -------------------------------- - -SUBROUTINE GET_REMAINING_CUTCELLS(NM) - -! Define regular cut-cells for regular cartesian cells surrounded by a gas cut-face. -INTEGER, INTENT(IN) :: NM - -! Local Variables: -INTEGER :: I,J,K,CT,X1AXIS,SIDE,ICC,JCC,IFACE,ICF,JCF,ICFC,ICFINB,NCFACE_CUTCELL,NCELL,NFACE_CELL -INTEGER :: NCC_MESH,NGC_MESH,NCELL_IN,NCELL_GC,COUNT_CC,COUNT_GC -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME -INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX -LOGICAL, PARAMETER :: OPT=.TRUE. - -M => MESHES(NM) - -! First thing is, for known cut-cells with reg faces that have changed to cut-faces to change the -! FACE_LIST incidence: -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_CUTCFE) CYCLE - ICC=M%CCVAR(I,J,K,CC_IDCC) - CC=>M%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - DO ICF=2,CC%CCELEM(1,JCC)+1 - IFACE = CC%CCELEM(ICF,JCC) - SIDE = CC%FACE_LIST(2,IFACE) - X1AXIS= CC%FACE_LIST(3,IFACE) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE - ICFC = M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS) - IF(ICFC>0) CC%FACE_LIST(:,IFACE) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) ! New cut-face. - ENDDO - ENDDO - ENDDO - ENDDO -ENDDO - -IF (OPT) THEN - -NCC_MESH = M%N_CUTCELL_MESH -NGC_MESH = M%N_GCCUTCELL_MESH - -! First count how many new cells are goint to be created inside, and in ghost cell region: -NCELL_IN=0 -NCELL_GC=0 +IF (OPT) THEN + +NCC_MESH = M%N_CUTCELL_MESH +NGC_MESH = M%N_GCCUTCELL_MESH + +! First count how many new cells are goint to be created inside, and in ghost cell region: +NCELL_IN=0 +NCELL_GC=0 DO K=-1,M%KBAR+2 DO J=-1,M%JBAR+2 DO I=-1,M%IBAR+2 @@ -11777,7 +11502,7 @@ SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK CALL POINT_TO_MESH(NM) M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) @@ -11811,7 +11536,7 @@ SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK CALL GET_CELL_LINK_INFO(NM) ENDIF ENDIF - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) ENDDO MAIN_MESH_LOOP_1 ! Call tag boundary cut-cells for blocking in refinement interfaces: @@ -11826,7 +11551,7 @@ SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK CALL POINT_TO_MESH(NM) M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) @@ -11840,7 +11565,7 @@ SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK CALL GET_CELL_LINK_INFO(NM) ENDIF - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) ENDDO FINAL_BLOCK_MESH_LOOP END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK @@ -12478,7 +12203,7 @@ SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS CALL POINT_TO_MESH(NM) M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) ! Compute average cell volume for mesh NM VOL_NM = (M%XF-M%XS)*(M%YF-M%YS)*(M%ZF-M%ZS) / REAL(M%IBAR*M%JBAR*M%KBAR,EB) @@ -12571,146 +12296,18 @@ SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS ENDIF ENDDO ICELL_DO ENDDO NEIGHBORING_MESHES_DO - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) ENDDO MESH_LOOP END SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS -SUBROUTINE DEFINE_XYZFACE_CELL(ALLOC_FLG) +SUBROUTINE TAG_CC_BLOCKING_REFINEMENT -LOGICAL, INTENT(IN) :: ALLOC_FLG +LOGICAL, PARAMETER :: DO_RAY_TRACING=.TRUE. +INTEGER :: DUM,II1,JJ1,KK1,IIO1,JJO1,KKO1,IIO2,JJO2,KKO2,IIG,JJG,KKG,IIOG,JJOG,KKOG -IF (ALLOC_FLG) THEN - - ! X direction bounds: - ILO_FACE = 0 ! Low mesh boundary face index. - IHI_FACE = M%IBAR ! High mesh boundary face index. - ILO_CELL = ILO_FACE + 1 ! First internal cell index. See notes. - IHI_CELL = IHI_FACE ! Last internal cell index. - ISTR = ILO_FACE - NGUARD ! Allocation start x arrays. - IEND = IHI_FACE + NGUARD ! Allocation end x arrays. - - ! Y direction bounds: - JLO_FACE = 0 ! Low mesh boundary face index. - JHI_FACE = M%JBAR ! High mesh boundary face index. - JLO_CELL = JLO_FACE + 1 ! First internal cell index. See notes. - JHI_CELL = JHI_FACE ! Last internal cell index. - JSTR = JLO_FACE - NGUARD ! Allocation start y arrays. - JEND = JHI_FACE + NGUARD ! Allocation end y arrays. - - ! Z direction bounds: - KLO_FACE = 0 ! Low mesh boundary face index. - KHI_FACE = M%KBAR ! High mesh boundary face index. - KLO_CELL = KLO_FACE + 1 ! First internal cell index. See notes. - KHI_CELL = KHI_FACE ! Last internal cell index. - KSTR = KLO_FACE - NGUARD ! Allocation start z arrays. - KEND = KHI_FACE + NGUARD ! Allocation end z arrays. - - ! Define grid arrays for this mesh: - ! Populate position and cell size arrays: Uniform grid implementation. - ! X direction: - ALLOCATE(DXCELL(ISTR:IEND)); DXCELL(ILO_CELL-1:IHI_CELL+1) = M%DX(ILO_CELL-1:IHI_CELL+1) - DO IGC=2,NGUARD - DXCELL(ILO_CELL-IGC)=DXCELL(ILO_CELL-IGC+1) - DXCELL(IHI_CELL+IGC)=DXCELL(IHI_CELL+IGC-1) - ENDDO - ALLOCATE(DXFACE(ISTR:IEND)); DXFACE(ILO_FACE:IHI_FACE)= M%DXN(ILO_FACE:IHI_FACE) - DO IGC=1,NGUARD - DXFACE(ILO_FACE-IGC)=DXFACE(ILO_FACE-IGC+1) - DXFACE(IHI_FACE+IGC)=DXFACE(ILO_FACE+IGC-1) - ENDDO - ALLOCATE(XCELL(ISTR:IEND)); XCELL = 1._EB/GEOMEPS ! Initialize huge. - XCELL(ILO_CELL-1:IHI_CELL+1) = M%XC(ILO_CELL-1:IHI_CELL+1) - DO IGC=2,NGUARD - XCELL(ILO_CELL-IGC)=XCELL(ILO_CELL-IGC+1)-DXFACE(ILO_FACE-IGC+1) - XCELL(IHI_CELL+IGC)=XCELL(IHI_CELL+IGC-1)+DXFACE(IHI_FACE+IGC-1) - ENDDO - ALLOCATE(XFACE(ISTR:IEND)); XFACE = 1._EB/GEOMEPS ! Initialize huge. - XFACE(ILO_FACE:IHI_FACE) = M%X(ILO_FACE:IHI_FACE) - DO IGC=1,NGUARD - XFACE(ILO_FACE-IGC)=XFACE(ILO_FACE-IGC+1)-DXCELL(ILO_CELL-IGC) - XFACE(IHI_FACE+IGC)=XFACE(IHI_FACE+IGC-1)+DXCELL(IHI_CELL+IGC) - ENDDO - - ! Y direction: - ALLOCATE(DYCELL(JSTR:JEND)); DYCELL(JLO_CELL-1:JHI_CELL+1)= M%DY(JLO_CELL-1:JHI_CELL+1) - DO IGC=2,NGUARD - DYCELL(JLO_CELL-IGC)=DYCELL(JLO_CELL-IGC+1) - DYCELL(JHI_CELL+IGC)=DYCELL(JHI_CELL+IGC-1) - ENDDO - ALLOCATE(DYFACE(JSTR:JEND)); DYFACE(JLO_FACE:JHI_FACE)= M%DYN(JLO_FACE:JHI_FACE) - DO IGC=1,NGUARD - DYFACE(JLO_FACE-IGC)=DYFACE(JLO_FACE-IGC+1) - DYFACE(JHI_FACE+IGC)=DYFACE(JHI_FACE+IGC-1) - ENDDO - ALLOCATE(YCELL(JSTR:JEND)); YCELL = 1._EB/GEOMEPS ! Initialize huge. - YCELL(JLO_CELL-1:JHI_CELL+1) = M%YC(JLO_CELL-1:JHI_CELL+1) - DO IGC=2,NGUARD - YCELL(JLO_CELL-IGC)=YCELL(JLO_CELL-IGC+1)-DYFACE(JLO_FACE-IGC+1) - YCELL(JHI_CELL+IGC)=YCELL(JHI_CELL+IGC-1)+DYFACE(JHI_FACE+IGC-1) - ENDDO - ALLOCATE(YFACE(JSTR:JEND)); YFACE = 1._EB/GEOMEPS ! Initialize huge. - YFACE(JLO_FACE:JHI_FACE) = M%Y(JLO_FACE:JHI_FACE) - DO IGC=1,NGUARD - YFACE(JLO_FACE-IGC)=YFACE(JLO_FACE-IGC+1)-DYCELL(JLO_CELL-IGC) - YFACE(JHI_FACE+IGC)=YFACE(JHI_FACE+IGC-1)+DYCELL(JHI_CELL+IGC) - ENDDO - - ! Z direction: - ALLOCATE(DZCELL(KSTR:KEND)); DZCELL(KLO_CELL-1:KHI_CELL+1)= M%DZ(KLO_CELL-1:KHI_CELL+1) - DO IGC=2,NGUARD - DZCELL(KLO_CELL-IGC)=DZCELL(KLO_CELL-IGC+1) - DZCELL(KHI_CELL+IGC)=DZCELL(KHI_CELL+IGC-1) - ENDDO - ALLOCATE(DZFACE(KSTR:KEND)); DZFACE(KLO_FACE:KHI_FACE)= M%DZN(KLO_FACE:KHI_FACE) - DO IGC=1,NGUARD - DZFACE(KLO_FACE-IGC)=DZFACE(KLO_FACE-IGC+1) - DZFACE(KHI_FACE+IGC)=DZFACE(KHI_FACE+IGC-1) - ENDDO - ALLOCATE(ZCELL(KSTR:KEND)); ZCELL = 1._EB/GEOMEPS ! Initialize huge. - ZCELL(KLO_CELL-1:KHI_CELL+1) = M%ZC(KLO_CELL-1:KHI_CELL+1) - DO IGC=2,NGUARD - ZCELL(KLO_CELL-IGC)=ZCELL(KLO_CELL-IGC+1)-DZFACE(KLO_FACE-IGC+1) - ZCELL(KHI_CELL+IGC)=ZCELL(KHI_CELL+IGC-1)+DZFACE(KHI_FACE+IGC-1) - ENDDO - ALLOCATE(ZFACE(KSTR:KEND)); ZFACE = 1._EB/GEOMEPS ! Initialize huge. - ZFACE(KLO_FACE:KHI_FACE) = M%Z(KLO_FACE:KHI_FACE) - DO IGC=1,NGUARD - ZFACE(KLO_FACE-IGC)=ZFACE(KLO_FACE-IGC+1)-DZCELL(KLO_CELL-IGC) - ZFACE(KHI_FACE+IGC)=ZFACE(KHI_FACE+IGC-1)+DZCELL(KHI_CELL+IGC) - ENDDO - -ELSE - - ! Face centered positions and cell sizes: - IF (ALLOCATED(XFACE)) DEALLOCATE(XFACE) - IF (ALLOCATED(YFACE)) DEALLOCATE(YFACE) - IF (ALLOCATED(ZFACE)) DEALLOCATE(ZFACE) - IF (ALLOCATED(DXFACE)) DEALLOCATE(DXFACE) - IF (ALLOCATED(DYFACE)) DEALLOCATE(DYFACE) - IF (ALLOCATED(DZFACE)) DEALLOCATE(DZFACE) - - ! Cell centered positions and cell sizes: - IF (ALLOCATED(XCELL)) DEALLOCATE(XCELL) - IF (ALLOCATED(YCELL)) DEALLOCATE(YCELL) - IF (ALLOCATED(ZCELL)) DEALLOCATE(ZCELL) - IF (ALLOCATED(DXCELL)) DEALLOCATE(DXCELL) - IF (ALLOCATED(DYCELL)) DEALLOCATE(DYCELL) - IF (ALLOCATED(DZCELL)) DEALLOCATE(DZCELL) - -ENDIF - -RETURN -END SUBROUTINE DEFINE_XYZFACE_CELL - - -SUBROUTINE TAG_CC_BLOCKING_REFINEMENT - -LOGICAL, PARAMETER :: DO_RAY_TRACING=.TRUE. -INTEGER :: DUM,II1,JJ1,KK1,IIO1,JJO1,KKO1,IIO2,JJO2,KKO2,IIG,JJG,KKG,IIOG,JJOG,KKOG - -IF ( DO_RAY_TRACING) THEN +IF ( DO_RAY_TRACING) THEN ! This loop is to block cut-cells on fine side grids for which coarse grid cut-cells have been blocked. MAIN_MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX @@ -13687,1330 +13284,1107 @@ SUBROUTINE GET_CC_FACE_CELL_LIST_INFO(NM,PHASE) END SUBROUTINE GET_CC_FACE_CELL_LIST_INFO -! ---------------------- GET_REGULAR_CUTCELLS_BOX ------------------------------ - -SUBROUTINE GET_REGULAR_CUTCELLS_BOX - -CALL CC_GRID_GET_REGULAR_CUTCELLS_BOX(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) +! --------------------- DEALLOCATE_CUTCELLS_CONN_MESH -------------------------- -#if 0 -! Local Variables: -INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: GEOMCELL -INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: GEOMFACE -INTEGER :: IBNDINT,INTGC_FLG,BNDINT_LOW,BNDINT_HIGH,II,JJ,KK,IG,ILO,IHI,JLO,JHI,KLO,KHI,X1LO,X1HI,X2LO,X2HI,X3LO,X3HI, & - INDXI(IAXIS:KAXIS) -INTEGER :: INDI,INDJ,INDK,INDI1,INDJ1,INDK1,INDI2,INDJ2,INDK2,INDI3,INDJ3,INDK3,INDI4,INDJ4,INDK4 -INTEGER :: INDXI1(IAXIS:KAXIS),INDXI2(IAXIS:KAXIS),INDXI3(IAXIS:KAXIS),INDXI4(IAXIS:KAXIS) -INTEGER :: NVERT,NFACE,NVERTFACE,NCUTFACE,NCUTCELL,FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS),CFELEM(1:NOD4+1,6),& - IDCF_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) -INTEGER :: LOHI,IWSEL,I1,I2,I3,IBOD(6),ITRI(6),FACE_LIST(1:CC_NPARAM_CCFACE,1:6),CEI_AXIS(LOW_IND:HIGH_IND),& - CEI,SIDE,NCFACE_CUTCELL,NFACE_CELL -REAL(EB):: DIST, DIST2, VOL(1) -REAL(EB):: XYZLC(IAXIS:KAXIS),XYZVERT(IAXIS:KAXIS,NOD1:NOD4+20),AREA(6),XYZCEN(IAXIS:KAXIS,6),XCEN(IAXIS:KAXIS) -REAL(EB):: INXAREA(IAXIS:KAXIS,1:6)=0._EB,INXSQAREA(IAXIS:KAXIS,1:6)=0._EB -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNTED2,IJK_COUNT +SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH(NM) +INTEGER, INTENT(IN) :: NM -! Allocate Face - Geom numbering and Cell - Geom numbering arrays -ALLOCATE(GEOMFACE(ISTR:IEND,JSTR:JEND,KSTR:KEND,MAX_DIM)); GEOMFACE = CC_GASPHASE -ALLOCATE(GEOMCELL(ISTR:IEND,JSTR:JEND,KSTR:KEND)); GEOMCELL = CC_GASPHASE +INTEGER :: ICC, ICF, I, J, K, DO_BNCF=1 +INTEGER, PARAMETER :: LOIN=-1 +INTEGER, PARAMETER :: HIIN= 2 -! First tag cells: NM is set and we have all the mesh info in MESHES(NM) -DO K=KLO_CELL-NGUARD,KHI_CELL+NGUARD - DO J=JLO_CELL-NGUARD,JHI_CELL+NGUARD - DO I=ILO_CELL-NGUARD,IHI_CELL+NGUARD - DO IG=1,N_GEOMETRY - IF(XCELL(I) < GEOMETRY(IG)%XB(1)) CYCLE - IF(XCELL(I) > GEOMETRY(IG)%XB(2)) CYCLE - IF(YCELL(J) < GEOMETRY(IG)%XB(3)) CYCLE - IF(YCELL(J) > GEOMETRY(IG)%XB(4)) CYCLE - IF(ZCELL(K) < GEOMETRY(IG)%XB(5)) CYCLE - IF(ZCELL(K) > GEOMETRY(IG)%XB(6)) CYCLE - GEOMCELL(I,J,K) = IG - MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_SOLID - EXIT - ENDDO +! Cut-cells and GASPHASE cut-faces: +DO K=-CCGUARD,MESHES(NM)%KBAR+CCGUARD + IF(K>LOIN .AND. KMESHES(NM)%KBAR+LOIN .AND. KLOIN .AND. JMESHES(NM)%JBAR+LOIN .AND. JLOIN .AND. IMESHES(NM)%IBAR+LOIN .AND. I0) CALL CELL_DEALLOC(NM,ICC) ! Deallocate this CUT_CELL array container: + ! IAXIS cut-face: + ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,IAXIS) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) + ! JAXIS cut-face: + ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,JAXIS) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) + ! KAXIS cut-face: + ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,KAXIS) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) ENDDO ENDDO ENDDO - -! Now Tag cut-cells: The -2, +2 is to be able to define cut-face types below on boundary of GC cut-cells. -DO K=KLO_CELL-NGUARD+1,KHI_CELL+NGUARD-1 - DO J=JLO_CELL-NGUARD+1,JHI_CELL+NGUARD-1 - DO I=ILO_CELL-NGUARD+1,IHI_CELL+NGUARD-1 - IF(MESHES(NM)%CCVAR(I,J,K,CC_CGSC)==CC_SOLID) THEN - ! Set all vertices to Solid: - MESHES(NM)%VERTVAR(I-1,J ,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I-1,J-1,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I-1,J-1,K-1,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I-1,J ,K-1,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J ,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J-1,K ,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J-1,K-1,CC_VGSC) = CC_SOLID - MESHES(NM)%VERTVAR(I ,J ,K-1,CC_VGSC) = CC_SOLID - CYCLE - ENDIF - IF(ANY(MESHES(NM)%CCVAR(I-1:I+1,J-1:J+1,K-1:K+1,CC_CGSC) == CC_SOLID)) & - MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE +! INBOUNDARY cut-faces: +DO K=-CCGUARD,MESHES(NM)%KBAR+CCGUARD + DO J=-CCGUARD,MESHES(NM)%JBAR+CCGUARD + DO I=-CCGUARD,MESHES(NM)%IBAR+CCGUARD + ICF = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) + IF (ICF>0) CALL FACE_DEALLOC(NM,ICF,DO_BNCF) ! Deallocate this CUT_FACE array fields, except NFACE, XYZCEN. ENDDO ENDDO ENDDO +IF(ALLOCATED(MESHES(NM)%VERTVAR)) DEALLOCATE(MESHES(NM)%VERTVAR) +IF(ALLOCATED(MESHES(NM)%ECVAR)) DEALLOCATE(MESHES(NM)%ECVAR) +RETURN +END SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH -! Then tag faces: -! X Faces: -DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD - DO J=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD - DO I=ILO_FACE-CCGUARD,IHI_FACE+CCGUARD - ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: - IF(ANY(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_GASPHASE)) CYCLE - ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: - IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_SOLID)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID - GEOMFACE(I,J,K,IAXIS) = GEOMCELL(I,J,K) - CYCLE - ENDIF - ! Now Gasphase cut-faces: All CCVAR == CUTCFE - IF(ALL(MESHES(NM)%CCVAR(I:I+1,J,K,CC_CGSC) == CC_CUTCFE)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_CUTCFE - ! GEOMFACE(I,J,K,IAXIS) stays CC_GASPHASE - CYCLE - ENDIF +! ---------------------- GET_EXT_INB_CUTFACES_TO_CFACE -------------------------------- - ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: - IF (GEOMCELL(I,J,K)*GEOMCELL(I+1,J,K) < 0) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) = CC_SOLID - GEOMFACE(I,J,K,IAXIS) = MAXVAL(GEOMCELL(I:I+1,J,K)) ! This is because one is ==CC_GASPHASE==-1 - CYCLE - ENDIF - ENDDO - ENDDO -ENDDO +SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE -! Y Faces: -DO K=KLO_CELL-CCGUARD,KHI_CELL+CCGUARD - DO J=JLO_FACE-CCGUARD,JHI_FACE+CCGUARD - DO I=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD - ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: - IF(ANY(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_GASPHASE)) CYCLE +! Local Variables: +INTEGER :: ICF, CFACE_INDEX_LOCAL, SURF_INDEX +INTEGER :: IVENT +REAL(EB):: ADDMAT(IAXIS:KAXIS,LOW_IND:HIGH_IND) - ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: - IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_SOLID)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_SOLID - GEOMFACE(I,J,K,JAXIS) = GEOMCELL(I,J,K) - CYCLE - ENDIF +! GET_CUTCELLS_VERBOSE variables: +INTEGER, ALLOCATABLE, DIMENSION(:) :: NCFACE_BY_MESH - ! Now Gasphase cut-faces: All CCVAR == CUTCFE - IF(ALL(MESHES(NM)%CCVAR(I,J:J+1,K,CC_CGSC) == CC_CUTCFE)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_CUTCFE - ! GEOMFACE(I,J,K,JAXIS) stays CC_GASPHASE - CYCLE - ENDIF +TYPE(VENTS_TYPE), POINTER :: VT +TYPE(CFACE_TYPE), POINTER :: CFA - ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: - IF (GEOMCELL(I,J,K)*GEOMCELL(I,J+1,K) < 0) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) = CC_SOLID - GEOMFACE(I,J,K,JAXIS) = MAXVAL(GEOMCELL(I,J:J+1,K)) ! This is because one is ==CC_GASPHASE==-1 - CYCLE +IF(GET_CUTCELLS_VERBOSE) CALL CPU_TIME(CPUTIME_START) + +ALLOCATE(NCFACE_BY_MESH(1:NMESHES)); NCFACE_BY_MESH(1:NMESHES) = 0 +MESH_LOOP_0 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + ! First N_EXTERNAL_CFACE_CELLS: + DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE + CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE + CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE + END SELECT + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE + ENDDO + ! Second N_INTWALL_CFACE_CELLS: + DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS)==0) CYCLE ENDIF - ENDDO + CASE(JAXIS) + IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS)==0) CYCLE + ENDIF + CASE(KAXIS) + IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS)==0) CYCLE + ENDIF + END SELECT + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE ENDDO -ENDDO + ! Second N_INTERNAL_CFACE_CELLS: + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE + ! Don't count INB cut-faces inside an OBST: + IF (CELL(CELL_INDEX(CF%IJK(IAXIS),CF%IJK(JAXIS),CF%IJK(KAXIS)))%SOLID) CYCLE + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE + ENDDO +ENDDO MESH_LOOP_0 -! Z Faces: -DO K=KLO_FACE-CCGUARD,KHI_FACE+CCGUARD - DO J=JLO_CELL-CCGUARD,JHI_CELL+CCGUARD - DO I=ILO_CELL-CCGUARD,IHI_CELL+CCGUARD - ! Drop if any of the two cells is Regular gasphase, means face is regular gasphase: - IF(ANY(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_GASPHASE)) CYCLE +IF(GET_CUTCELLS_VERBOSE) THEN + CALL MPI_ALLREDUCE(MPI_IN_PLACE,NCFACE_BY_MESH(1),NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + WRITE(LU_SETCC,'(A,I10)',advance='no') ' 4. Generating CFACES from cut-faces, total CFACE_CELLS=', & + SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,I10)') ' Total number of CFACES in all processes=', & + SUM(NCFACE_BY_MESH(1:NMESHES)) + WRITE(LU_ERR ,'(A,I10)',advance='no') & + ' 4. Process 0 Generating CFACES from cut-faces, total CFACE_CELLS=', & + SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) + ENDIF +ENDIF - ! Now test if all are Solid set FCVAR to CC_SOLID, GEOMFACE to low side SOLID value of GEOMCELL: - IF(ALL(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_SOLID)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_SOLID - GEOMFACE(I,J,K,KAXIS) = GEOMCELL(I,J,K) - CYCLE - ENDIF +! First mesh Loop, Allocate storage for CFACES, CFACE geometric info: +MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) - ! Now Gasphase cut-faces: All CCVAR == CUTCFE - IF(ALL(MESHES(NM)%CCVAR(I,J,K:K+1,CC_CGSC) == CC_CUTCFE)) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_CUTCFE - ! GEOMFACE(I,J,K,KAXIS) stays CC_GASPHASE - CYCLE - ENDIF + ! ALLOCATE to zero size + IF(ALLOCATED(MESHES(NM)%CFACE)) DEALLOCATE(MESHES(NM)%CFACE) + MESHES(NM)%N_CFACE_CELLS_DIM = NCFACE_BY_MESH(NM) + ALLOCATE(MESHES(NM)%CFACE(0:MESHES(NM)%N_CFACE_CELLS_DIM)) - ! Finally one cut-cell and one solid: Set FCVAR to solid, keep in GEOMFACE GEOM number: - IF (GEOMCELL(I,J,K)*GEOMCELL(I,J,K+1) < 0) THEN - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) = CC_SOLID - GEOMFACE(I,J,K,KAXIS) = MAXVAL(GEOMCELL(I,J,K:K+1)) ! This is because one is ==CC_GASPHASE==-1 - CYCLE - ENDIF + ALLOCATE(MESHES(NM)%FACE_WORK1(MESHES(NM)%N_CFACE_CELLS_DIM)) + ALLOCATE(MESHES(NM)%FACE_WORK2(MESHES(NM)%N_CFACE_CELLS_DIM)) + ALLOCATE(MESHES(NM)%FACE_WORK3(MESHES(NM)%N_CFACE_CELLS_DIM)) + + ! Define pointers among External CC_GASPHASE CUT_FACE and CFACE (N_EXTERNAL_CFACE_CELLS): + CFACE_INDEX_LOCAL = 0 + DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE + CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE + CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE + END SELECT + ! Now get WALL cell SURF_INDEX: + IW = 0 + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF (I==0 ) IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-1) + IF (I==IBAR) IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( 1) + CASE(JAXIS) + IF (J==0 ) IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-2) + IF (J==JBAR) IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( 2) + CASE(KAXIS) + IF (K==0 ) IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-3) + IF (K==KBAR) IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( 3) + END SELECT + SURF_INDEX = WALL(IW)%SURF_INDEX + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) ENDDO ENDDO -ENDDO - + MESHES(NM)%N_EXTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL + ! Define pointers among internal CC_GASPHASE CUT_FACE and CFACE (N_INTWALL_CFACE_CELLS): + DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST, or don't lay on a WALL_CELL: + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + ENDIF + CASE(JAXIS) + IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + ENDIF + CASE(KAXIS) + IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + ENDIF + END SELECT + SURF_INDEX = WALL(IW)%SURF_INDEX + IF(.NOT.ALLOCATED(CF%CFACE_INDEX)) THEN; ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) + ELSEIF (SIZE(CF%CFACE_INDEX,DIM=1)/=CF%NFACE)THEN + DEALLOCATE(CF%CFACE_INDEX); ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) + ENDIF + IF(.NOT.ALLOCATED(CF%SURF_INDEX)) THEN; ALLOCATE(CF%SURF_INDEX(CF%NFACE)) + ELSEIF (SIZE(CF%SURF_INDEX,DIM=1)/=CF%NFACE)THEN + DEALLOCATE(CF%SURF_INDEX); ALLOCATE(CF%SURF_INDEX(CF%NFACE)) + ENDIF -! Now define Gasphase and boundary cut-faces: 1 Boundary, 2 internal, 3 guard cell faces: -INTGC_FLG_LOOP : DO INTGC_FLG=LOW_IND,HIGH_IND + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) + ENDDO + ENDDO + MESHES(NM)%N_INTWALL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%INTERNAL_CFACE_CELLS_LB = MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%N_INTWALL_CFACE_CELLS + ! Define pointers among CC_INBOUNDARY CUT_FACE and CFACE (N_INTERNAL_CFACE_CELLS): + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + CF => MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS) + ! Don't count INB cut-faces inside an OBST: + IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + SURF_INDEX = CF%SURF_INDEX(IFACE) + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.TRUE.) + ENDDO + IF(ALLOCATED(CF%CFACE_ORIGIN)) DEALLOCATE(CF%CFACE_ORIGIN) + ENDDO + MESHES(NM)%N_INTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%INTERNAL_CFACE_CELLS_LB +ENDDO MESH_LOOP_1 - ! GASPHASE cut-faces: - NVERT = 4; NFACE = 1; NVERTFACE = 5 - IF (INTGC_FLG==LOW_IND) THEN - ALLOCATE( IJK_COUNTED(ISTR:IEND,JSTR:JEND,KSTR:KEND,IAXIS:KAXIS) ); IJK_COUNTED=.FALSE. - BNDINT_LOW = 1; BNDINT_HIGH = 3 - ELSE - BNDINT_LOW = 4; BNDINT_HIGH = 4 - ENDIF +! Second loop, apply VENTS to change SURF_ID associated with CFACEs: +MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) - IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, - ! 4 guard-cell faces. + ! ! Currently : Modify CFACE SURF_INDEX with VENT information: This needs more development. - ! When switching to internal faces, copy number of external faces already computed. - IF (IBNDINT == 3) MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + VENT_LOOP : DO IVENT=1,MESHES(NM)%N_VENT + VT => VENTS(IVENT) + IF(.NOT.VT%GEOM) CYCLE VENT_LOOP ! Do not apply vent to Geometries. - X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS - SELECT CASE(X1AXIS) - CASE(IAXIS) - X2AXIS = JAXIS; X3AXIS = KAXIS - ! IAXIS gasphase cut-faces: - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - ILO = ILO_FACE; IHI = ILO_FACE - CASE(2) - ILO = IHI_FACE; IHI = IHI_FACE - CASE(3) - ILO = ILO_FACE+1; IHI = IHI_FACE-1 - CASE(4) - ILO = ILO_FACE-CCGUARD; IHI= IHI_FACE+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS - ! Local indexing in x1, x2, x3: - X1LO = ILO; X1HI = IHI - X2LO = JLO; X2HI = JHI - X3LO = KLO; X3HI = KHI - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(ISTR:IEND)); X1FACE = XFACE - ALLOCATE(X2FACE(JSTR:JEND)); X2FACE = YFACE - ALLOCATE(X3FACE(KSTR:KEND)); X3FACE = ZFACE + ! This test is a simplified test for VENTS changing the CFACE SURF_ID to VENT SURF_ID for all CFACEs whose + ! centroid locations lay within the frame of the IOR grid aligned VENT: + ADDMAT = 0._EB; + SELECT CASE(ABS(VT%IOR)) + CASE(IAXIS) + ADDMAT(IAXIS,LOW_IND) = -(XF_MAX-XS_MIN) ! -DX(VT%I1) Set normal size to 2 times domain size. + ADDMAT(IAXIS,HIGH_IND) = (XF_MAX-XS_MIN) ! DX(VT%I2) XF_MAX, etc. defined in cons.f90. + CASE(JAXIS) + ADDMAT(JAXIS,LOW_IND) = -(YF_MAX-YS_MIN) ! -DY(VT%J1) + ADDMAT(JAXIS,HIGH_IND) = (YF_MAX-YS_MIN) ! DY(VT%J2) + CASE(KAXIS) + ADDMAT(KAXIS,LOW_IND) = -(ZF_MAX-ZS_MIN) ! -DZ(VT%K1) + ADDMAT(KAXIS,HIGH_IND) = (ZF_MAX-ZS_MIN) ! DZ(VT%K2) + END SELECT + ! CFACE Loop to modify SURF_INDEX in INTERNAL_CFACE_CELLS: + CFACE_LOOP_2 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + CFA => CFACE(CFACE_INDEX_LOCAL) + BC => BOUNDARY_COORD(CFA%BC_INDEX) + IF (BC%X < X(VT%I1)+ADDMAT(IAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%X > X(VT%I2)+ADDMAT(IAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + IF (BC%Y < Y(VT%J1)+ADDMAT(JAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%Y > Y(VT%J2)+ADDMAT(JAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + IF (BC%Z < Z(VT%K1)+ADDMAT(KAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%Z > Z(VT%K2)+ADDMAT(KAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + CFA%VENT_INDEX = IVENT + CFA%SURF_INDEX = VT%SURF_INDEX + ENDDO CFACE_LOOP_2 + ENDDO VENT_LOOP +ENDDO MESH_LOOP_2 +! - At this pont all final values of SURF_INDEX have been given to CFACEs. - CASE(JAXIS) - X2AXIS = KAXIS; X3AXIS = IAXIS - ! JAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - JLO = JLO_FACE; JHI = JLO_FACE - CASE(2) - JLO = JHI_FACE; JHI = JHI_FACE - CASE(3) - JLO = JLO_FACE+1; JHI = JHI_FACE-1 - CASE(4) - JLO = JLO_FACE-CCGUARD; JHI = JHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - KLO = KLO-CCGUARD; KHI = KHI+CCGUARD - END SELECT - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS - ! Local indexing in x1, x2, x3: - X1LO = JLO; X1HI = JHI - X2LO = KLO; X2HI = KHI - X3LO = ILO; X3HI = IHI - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(JSTR:JEND)); X1FACE = YFACE - ALLOCATE(X2FACE(KSTR:KEND)); X2FACE = ZFACE - ALLOCATE(X3FACE(ISTR:IEND)); X3FACE = XFACE +! Third loop, 1. Compute final FDS area integrals by SURF_ID and GEOM. +! 2. Compute input areas by SURF_ID and GEOM. First sum over GEOM FACES SURF_IDs, +! then VENTS input surfaces are assigned to corresponding GEOMs and SURF_IDs if present (VENTs take precedence). +IF(N_GEOMETRY>0) THEN + ALLOCATE(FDS_AREA_GEOM(0:N_SURF,N_GEOMETRY)); FDS_AREA_GEOM = 0._EB +ENDIF +MESH_LOOP_3 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + CFA => CFACE(CFACE_INDEX_LOCAL) + ICF = CFA%CUT_FACE_IND1; IFACE= CFA%CUT_FACE_IND2 + I = CUT_FACE(ICF)%BODTRI(1,IFACE) + IF(I>0) FDS_AREA_GEOM(CFA%SURF_INDEX,I) = FDS_AREA_GEOM(CFA%SURF_INDEX,I) + CFA%AREA + ENDDO +ENDDO MESH_LOOP_3 +! Sum FDS and INPUT areas per SURF_ID and GEOM (all reduce sum): +IF(N_GEOMETRY>0) & +CALL MPI_ALLREDUCE(MPI_IN_PLACE, FDS_AREA_GEOM(0,1), (N_SURF+1)*N_GEOMETRY, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) - CASE(KAXIS) - X2AXIS = IAXIS; X3AXIS = JAXIS - ! KAXIS gasphase cut-faces: - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - SELECT CASE(IBNDINT) - CASE(1) - KLO = KLO_FACE; KHI = KLO_FACE - CASE(2) - KLO = KHI_FACE; KHI = KHI_FACE - CASE(3) - KLO = KLO_FACE+1; KHI = KHI_FACE-1 - CASE(4) - KLO = KLO_FACE-CCGUARD; KHI = KHI_FACE+CCGUARD - ILO = ILO-CCGUARD; IHI = IHI+CCGUARD - JLO = JLO-CCGUARD; JHI = JHI+CCGUARD - END SELECT - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS - ! Local indexing in x1, x2, x3: - X1LO = KLO; X1HI = KHI - X2LO = ILO; X2HI = IHI - X3LO = JLO; X3HI = JHI - ! Face coordinates in x1,x2,x3 axes: - ALLOCATE(X1FACE(KSTR:KEND)); X1FACE = ZFACE - ALLOCATE(X2FACE(ISTR:IEND)); X2FACE = XFACE - ALLOCATE(X3FACE(JSTR:JEND)); X3FACE = YFACE +! Fourth Loop: Assign AREA_ADJUST for CFACEs, and assign BC info to CFACEs: +MESH_LOOP_4 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) - END SELECT + ! BCs related information for INTERNAL CFACE CELLS: + CFACE_LOOP_4 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + ICF = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND1 + IFACE = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND2 + SURF_INDEX = CFACE(CFACE_INDEX_LOCAL)%SURF_INDEX + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_TWO,IS_INB=.TRUE.) + ENDDO CFACE_LOOP_4 - ! Loop on Cartesian faces, local x1, x2, x3 indexes: - DO II=X1LO,X1HI - DO KK=X3LO,X3HI - DO JJ=X2LO,X2HI - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI = INDXI(XIAXIS) - INDJ = INDXI(XJAXIS) - INDK = INDXI(XKAXIS) - ! Drop if not CUTCFE: - IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE; IJK_COUNTED(INDI,INDJ,INDK,X1AXIS)=.TRUE. - IF(MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE +ENDDO MESH_LOOP_4 +IF (GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' + IF (MY_RANK==0) WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' +ENDIF - ! Vertex at index II,JJ-1,KK-1: - INDXI1(IAXIS:KAXIS) = (/ II, JJ-1, KK-1 /) ! Local x1,x2,x3 - INDI1 = INDXI1(XIAXIS) - INDJ1 = INDXI1(XJAXIS) - INDK1 = INDXI1(XKAXIS) - ! Vertex at index II,JJ,KK-1: - INDXI2(IAXIS:KAXIS) = (/ II, JJ, KK-1 /) ! Local x1,x2,x3 - INDI2 = INDXI2(XIAXIS) - INDJ2 = INDXI2(XJAXIS) - INDK2 = INDXI2(XKAXIS) - ! Vertex at index II,JJ,KK: - INDXI3(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI3 = INDXI3(XIAXIS) - INDJ3 = INDXI3(XJAXIS) - INDK3 = INDXI3(XKAXIS) - ! Vertex at index II,JJ-1,KK: - INDXI4(IAXIS:KAXIS) = (/ II, JJ-1, KK /) ! Local x1,x2,x3 - INDI4 = INDXI4(XIAXIS) - INDJ4 = INDXI4(XJAXIS) - INDK4 = INDXI4(XKAXIS) +RETURN +END SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE - ! First, normal direction in x1 direction. - ! For this face: XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - ! Vert 1: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI1(IAXIS)), X2FACE(INDXI1(JAXIS)), X3FACE(INDXI1(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) - ! Vert 2: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI2(IAXIS)), X2FACE(INDXI2(JAXIS)), X3FACE(INDXI2(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) - ! Vert 3: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI3(IAXIS)), X2FACE(INDXI3(JAXIS)), X3FACE(INDXI3(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) - ! Vert 4: - XYZLC(IAXIS:KAXIS) = (/ X1FACE(INDXI4(IAXIS)), X2FACE(INDXI4(JAXIS)), X3FACE(INDXI4(KAXIS)) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XYZLC(XIAXIS), XYZLC(XJAXIS), XYZLC(XKAXIS) /) - CFELEM(1:5,1) = (/ 4, NOD1, NOD2, NOD3, NOD4 /) +! ------------------------- SET_GC_CUTCELLS_3D ----------------------------------- - ! Area: - AREA(1) = (X2FACE(INDXI2(JAXIS))-X2FACE(INDXI1(JAXIS)))*(X3FACE(INDXI4(KAXIS))-X3FACE(INDXI1(KAXIS))) +SUBROUTINE SET_GC_CUTCELLS_3D - ! XYZCEN in Local Coords: - XYZCEN(IAXIS:KAXIS,1)= (/ X1FACE(II), 0.5_EB*(X2FACE(INDXI2(JAXIS))+X2FACE(INDXI1(JAXIS))), & - 0.5_EB*(X3FACE(INDXI4(KAXIS))+X3FACE(INDXI1(KAXIS))) /) +! Local Variables: +INTEGER :: IW,II,JJ,KK,IOR,IIO,JJO,KKO,IIF,JJF,KKF,IIOF,JJOF,KKOF,ICF,ICOF,X1AXIS,ICC,NMICC,NOFC,N_CF,N_CRT +REAL(EB):: XNM, XNOM +TYPE (WALL_TYPE), POINTER :: WC +TYPE (EXTERNAL_WALL_TYPE), POINTER :: EWC +LOGICAL :: WC_PERIODIC, TEST_ICC +REAL(EB):: AREA_NM, AREA_NOM, AREA_CRT - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(IAXIS,1) = 1._EB * X1FACE(II) * AREA(1) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(IAXIS,1) = 1._EB * X1FACE(II)**2._EB * AREA(1) - ! This is a new cut-face, allocate space: - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (INTGC_FLG==LOW_IND) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_IDCF,X1AXIS) = NCUTFACE +IF (CCGUARD == 0) RETURN - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +IF(GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME_START) + WRITE(LU_SETCC,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' + ENDIF +ENDIF - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ INDI, INDJ, INDK, X1AXIS /) - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_GASPHASE - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE,IBNDINT) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) +! Meshes Loop: +! First Mesh Loop: +! Test if NOM mesh cells are of the same size or smaller than NM mesh that areas match: +MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - ! Connectivity: - CF%CFELEM(1:NVERTFACE,NFACE) = CFELEM(1:NVERTFACE,1) - ! Geom Properties: - CF%AREA(NFACE) = AREA(1) - CF%XYZCEN(IAXIS:KAXIS,NFACE) = XYZCEN( (/ XIAXIS, XJAXIS, XKAXIS /) ,1) + IF (MESHES(NM)%N_CUTFACE_MESH==0) CYCLE MESH_LOOP_1 + CALL POINT_TO_MESH(NM) - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA, where nc=j => dot(i,nc)=0: - CF%INXAREA(NFACE) = INXAREA(XIAXIS,1) - ! dot(i,nc)*int(x^2)dA, where nc=j => dot(i,nc)=0: - CF%INXSQAREA(NFACE) = INXSQAREA(XIAXIS,1) - ! dot(j,nc)*int(y^2)dA, where y=yface(J) constant nc=j: - CF%JNYSQAREA(NFACE) = INXSQAREA(XJAXIS,1) - ! dot(k,nc)*int(z^2)dA, where nc=j => dot(k,nc)=0: - CF%KNZSQAREA(NFACE) = INXSQAREA(XKAXIS,1) + EXTERNAL_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS - ENDDO - ENDDO - ENDDO - DEALLOCATE(X1FACE,X2FACE,X3FACE) - ENDDO X1AXIS_LOOP - ENDDO IBNDINT_LOOP - - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED ) + WC=>WALL(IW) + EWC=>EXTERNAL_WALL(IW) + BC=>BOUNDARY_COORD(WC%BC_INDEX) + B1=>BOUNDARY_PROP1(WC%B1_INDEX) + IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & + WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_1 - ! INBOUNDARY cut-faces: - IF (INTGC_FLG==LOW_IND) THEN - ALLOCATE( IJK_COUNTED2(ISTR:IEND,JSTR:JEND,KSTR:KEND) ); IJK_COUNTED2=.FALSE. - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - ELSE - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD - ENDIF + II = BC%II + JJ = BC%JJ + KK = BC%KK + IOR = BC%IOR - ! Loop on Cartesian cells: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI + ! Skip if no cut-faces present on this WC: + ! Define underlying Cartesian faces indexes: + SELECT CASE(IOR) + CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-IAXIS) ! Higher X boundary for Mesh NM. + IIF = II - 1; JJF = JJ ; KKF = KK + CASE( JAXIS) ! Lower Y boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-JAXIS) ! Higher Y boundary for Mesh NM. + IIF = II ; JJF = JJ - 1; KKF = KK + CASE( KAXIS) ! Lower Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-KAXIS) ! Higher Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK - 1 + END SELECT + X1AXIS = ABS(IOR) + IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE EXTERNAL_WALL_LOOP_1 - IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE + ! Gas cut-face area in wall-cell IW face: + ICF = FCVAR(IIF,JJF,KKF,CC_IDCF,X1AXIS) + AREA_NM = SUM(CUT_FACE(ICF)%AREA(1:CUT_FACE(ICF)%NFACE)) - IF(IJK_COUNTED2(I,J,K)) CYCLE; IJK_COUNTED2(I,J,K)=.TRUE. + IF(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN + NOM = EWC%NOM ! Use Other Mesh Data. + IF(MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_1 + ! Now Obtain the CUT_FACE for the same face on NM-NOM: - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) + AREA_NOM = 0._EB; N_CF=0; N_CRT=0 + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + SELECT CASE(IOR) + CASE( IAXIS) ! Lower X boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) + CASE(-IAXIS) ! Higher X boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO- 1; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) + CASE( JAXIS) ! Lower Y boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) + CASE(-JAXIS) ! Higher Y boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO ; JJOF= JJO- 1; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) + CASE( KAXIS) ! Lower Z boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) + CASE(-KAXIS) ! Higher Z boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO- 1; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) + END SELECT + IF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_FGSC,X1AXIS) == CC_GASPHASE) THEN + AREA_NOM = AREA_NOM + AREA_CRT + N_CRT = N_CRT + 1 + ELSEIF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) > 0) THEN ! there are gasphase cut-faces + ICOF = MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) + AREA_NOM = AREA_NOM + SUM(MESHES(NOM)%CUT_FACE(ICOF)%AREA(1:MESHES(NOM)%CUT_FACE(ICOF)%NFACE)) + N_CF = N_CF + 1 + ENDIF + ENDDO + ENDDO + ENDDO - IF ( ALL(FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) /= CC_SOLID) ) CYCLE + ! Check if: + ! 1. other mesh faces are more than one -> areas match. + ! 2. other mesh face and size of cartesian faces the same -> areas match. + ! 3. Left the case of fine mesh face with OMESH face coarse. + NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 + IF ( (NOFC > 1) .OR. (ABS(B1%AREA-AREA_CRT) < GEOMEPS) )THEN + IF(ABS(AREA_NM-AREA_NOM) > ADIFF_INFO_FACTOR*AREA_CRT) THEN + WRITE(LU_ERR,*) 'SET_GC_CUTCELLS_3D Error: MESH=',NM,', CUT_FACE=',ICF,' does not match OMESH=',& + NOM,', with CUT_FACEs,CRT_FACEs=',N_CF,N_CRT,', area difference=',& + ABS(AREA_NM-AREA_NOM),', GEOMEPS=',GEOMEPS + WRITE(LU_ERR,*) 'CUT FACE=',ICF,MESHES(NM)%CUT_FACE(ICF)%IJK(1:4),':',MESHES(NM)%CUT_FACE(ICF)%STATUS + ENDIF + ENDIF - NVERT = 0; NFACE = 0 - INXAREA = 0._EB - INXSQAREA = 0._EB - ! XYZVERT, CFELEM, AREA, XYZCEN, INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - X1AXIS_LOOP2 : DO X1AXIS=IAXIS,KAXIS - LOHI_DO : DO LOHI=LOW_IND,HIGH_IND - IF (FSID_XYZ(LOHI,X1AXIS) /= CC_SOLID) CYCLE - NFACE = NFACE + 1 - SELECT CASE(X1AXIS) - CASE(IAXIS) + ENDIF - ! Vertices: - XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I-2+LOHI), YFACE(J ), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-2+LOHI), YFACE(J-1), ZFACE(K ) /) - IF(LOHI==LOW_IND)THEN - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) - ELSE - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) - ENDIF - ! Area: - AREA(NFACE) = (YFACE(J )-YFACE(J-1))*(ZFACE(K )-ZFACE(K-1)) - ! XYZCEN: - XYZCEN(IAXIS:KAXIS,NFACE) = (/ XFACE(I-2+LOHI), 0.5_EB*(YFACE(J )+YFACE(J-1)), & - 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI) * AREA(NFACE) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(IAXIS,NFACE) = 1._EB * XFACE(I-2+LOHI)**2._EB * AREA(NFACE) + ENDDO EXTERNAL_WALL_LOOP_1 - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I-2+LOHI,J,K,X1AXIS) - CASE(JAXIS) +ENDDO MESH_LOOP_1 - ! Vertices: - XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I-1), YFACE(J-2+LOHI), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I ), YFACE(J-2+LOHI), ZFACE(K-1) /) - IF(LOHI==LOW_IND)THEN - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) - ELSE - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) - ENDIF - ! Area: - AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(ZFACE(K )-ZFACE(K-1)) - ! XYZCEN: - XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), YFACE(J-2+LOHI), & - 0.5_EB*(ZFACE(K )+ZFACE(K-1)) /) - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI) * AREA(NFACE) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(JAXIS,NFACE) = 1._EB * YFACE(J-2+LOHI)**2._EB * AREA(NFACE) - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I,J-2+LOHI,K,X1AXIS) - CASE(KAXIS) +! Second mesh loop: +! Define cut-cell data on guard-cell region to be communicated: +MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - ! Vertices: - XYZVERT(IAXIS:KAXIS,NVERT+1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K-2+LOHI) /) - XYZVERT(IAXIS:KAXIS,NVERT+2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K-2+LOHI) /) - XYZVERT(IAXIS:KAXIS,NVERT+3) = (/ XFACE(I ), YFACE(J ), ZFACE(K-2+LOHI) /) - XYZVERT(IAXIS:KAXIS,NVERT+4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K-2+LOHI) /) - IF(LOHI==LOW_IND)THEN - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+2, NVERT+3, NVERT+4 /) - ELSE - CFELEM(1:5,NFACE) = (/ 4, NVERT+1, NVERT+4, NVERT+3, NVERT+2 /) - ENDIF - ! Area: - AREA(NFACE) = (XFACE(I )-XFACE(I-1))*(YFACE(J )-YFACE(J-1)) - ! XYZCEN: - XYZCEN(IAXIS:KAXIS,NFACE) = (/ 0.5_EB*(XFACE(I )+XFACE(I-1)), 0.5_EB*(YFACE(J )+YFACE(J-1)), & - ZFACE(K-2+LOHI) /) - ! INXAREA, INXQAREA,JNYSQAREA,KNZSQAREA: - INXAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI) * AREA(NFACE) - ! dot(e1,nc)*int(x1^2)dA, where x=x1face(ii) constant and nc=e1: - INXSQAREA(KAXIS,NFACE) = 1._EB * ZFACE(K-2+LOHI)**2._EB * AREA(NFACE) + IF ((MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH)==0) CYCLE MESH_LOOP_2 - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I,J,K-2+LOHI,X1AXIS) - END SELECT + CALL POINT_TO_MESH(NM) - ! With IBOD and cut-face XYZCEN defined, find closest triangle: - DIST = 1.E20_EB - ITRI(NFACE) = 1 - DO IWSEL=1,GEOMETRY(IBOD(NFACE))%N_FACES - I1 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-2) - I2 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL-1) - I3 = GEOMETRY(IBOD(NFACE))%FACES(3*IWSEL ) - XCEN(IAXIS:KAXIS) = 1._EB/3._EB * ( GEOMETRY(IBOD(NFACE))%VERTS(3*(I1-1)+IAXIS:3*(I1-1)+KAXIS)+ & - GEOMETRY(IBOD(NFACE))%VERTS(3*(I2-1)+IAXIS:3*(I2-1)+KAXIS)+ & - GEOMETRY(IBOD(NFACE))%VERTS(3*(I3-1)+IAXIS:3*(I3-1)+KAXIS) ) - ! Drop Triangles not on the face: - IF (ABS(XYZCEN(X1AXIS,NFACE)-XCEN(X1AXIS)) > GEOMEPS) CYCLE - DIST2 = NORM2(XYZCEN(IAXIS:KAXIS,NFACE)-XCEN(IAXIS:KAXIS)) - IF (DIST > DIST2) THEN - DIST = DIST2 - ITRI(NFACE) = IWSEL - ENDIF - ENDDO + EXTERNAL_WALL_LOOP_2 : DO IW=1,N_EXTERNAL_WALL_CELLS - NVERT = NVERT + 4 + WC=>WALL(IW) + BC=>BOUNDARY_COORD(WC%BC_INDEX) + EWC=>EXTERNAL_WALL(IW) + IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & + WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_2 - ENDDO LOHI_DO - ENDDO X1AXIS_LOOP2 + II = BC%II + JJ = BC%JJ + KK = BC%KK + IOR = BC%IOR + NOM = EWC%NOM ! Use Other Mesh Data. + IF (NOM>0) THEN + IF (MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_2 + ENDIF - ! This is a cut-face, allocate space: - NCUTFACE = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + 1 - IF (INTGC_FLG==LOW_IND) THEN - MESHES(NM)%N_CUTFACE_MESH = NCUTFACE - ELSE - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH + 1 - ENDIF - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE + IF (WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + ! Skip if no cut-faces present on this WC: + ! Define underlying Cartesian faces indexes: + SELECT CASE(IOR) + CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-IAXIS) ! Higher X boundary for Mesh NM. + IIF = II - 1; JJF = JJ ; KKF = KK + CASE( JAXIS) ! Lower Y boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-JAXIS) ! Higher Y boundary for Mesh NM. + IIF = II ; JJF = JJ - 1; KKF = KK + CASE( KAXIS) ! Lower Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-KAXIS) ! Higher Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK - 1 + END SELECT + X1AXIS = ABS(IOR) + IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) CYCLE EXTERNAL_WALL_LOOP_2 - MESHES(NM)%CUT_FACE(NCUTFACE)%NVERT = NVERT - MESHES(NM)%CUT_FACE(NCUTFACE)%NFACE = NFACE - MESHES(NM)%CUT_FACE(NCUTFACE)%IJK(1:MAX_DIM+1) = (/ I, J, K, 0 /) ! No axis = 0 - MESHES(NM)%CUT_FACE(NCUTFACE)%STATUS = CC_INBOUNDARY - CALL NEW_FACE_ALLOC(NM,NCUTFACE,NVERT,NFACE,NVERTFACE) - CF => MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) - CF%CFELEM(1:5,1:NFACE) = CFELEM(1:5,1:NFACE) - - CF%AREA(1:NFACE) = AREA(1:NFACE) - CF%XYZCEN(IAXIS:KAXIS,1:NFACE) = XYZCEN(IAXIS:KAXIS,1:NFACE) - - ! Fields for cut-cell volume/centroid computation: - ! dot(i,nc)*int(x)dA: - CF%INXAREA(1:NFACE) = INXAREA(IAXIS,1:NFACE) - ! dot(i,nc)*int(x^2)dA: - CF%INXSQAREA(1:NFACE) = INXSQAREA(IAXIS,NFACE) - ! dot(j,nc)*int(y^2)dA: - CF%JNYSQAREA(1:NFACE) = INXSQAREA(JAXIS,NFACE) - ! dot(k,nc)*int(z^2)dA: - CF%KNZSQAREA(1:NFACE) = INXSQAREA(KAXIS,NFACE) - - ! Define Body-triangle reference: - CF%BODTRI(1,1:NFACE)= IBOD(1:NFACE) - CF%BODTRI(2,1:NFACE)= ITRI(1:NFACE) - - ! Assign surf-index: Depending on GEOMETRY: - DO IFACE=1,NFACE - CF%SURF_INDEX(IFACE) = GEOMETRY(IBOD(IFACE))%SURFS(ITRI(IFACE)) + IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN + TEST_ICC = .TRUE. + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + TEST_ICC = TEST_ICC .AND. (MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) <= 0) + ENDDO + ENDDO ENDDO - ENDDO - ENDDO - ENDDO - - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED2 ) - -ENDDO INTGC_FLG_LOOP - - -! Finally Build cut-cells: -NCFACE_CUTCELL = 7; NFACE_CELL = 6; NCELL = 1 -INTGC_FLG_LOOP2 : DO INTGC_FLG=LOW_IND,HIGH_IND ! 1 refers to blocks internal cells, 2 refers to block guard cells. - - SELECT CASE(INTGC_FLG) - CASE(LOW_IND) - ALLOCATE(IJK_COUNT(ILO_CELL-NGUARD:IHI_CELL+NGUARD,JLO_CELL-NGUARD:JHI_CELL+NGUARD, & - KLO_CELL-NGUARD:KHI_CELL+NGUARD)) - IJK_COUNT = .FALSE. - ILO = ILO_CELL; IHI = IHI_CELL - JLO = JLO_CELL; JHI = JHI_CELL - KLO = KLO_CELL; KHI = KHI_CELL - CASE(HIGH_IND) - ILO = ILO_CELL-CCGUARD; IHI = IHI_CELL+CCGUARD - JLO = JLO_CELL-CCGUARD; JHI = JHI_CELL+CCGUARD - KLO = KLO_CELL-CCGUARD; KHI = KHI_CELL+CCGUARD - END SELECT - - ! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI - - IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE - - IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. - - ! Start with Cartesian Faces: - ! Face type of bounding Cartesian faces: - FSID_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_FGSC,IAXIS) - FSID_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_FGSC,IAXIS) - FSID_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_FGSC,JAXIS) - FSID_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_FGSC,JAXIS) - FSID_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_FGSC,KAXIS) - FSID_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_FGSC,KAXIS) - - ! Cut-face number of bounding Cartesian faces: - IDCF_XYZ(LOW_IND ,IAXIS) = MESHES(NM)%FCVAR(I-1,J,K,CC_IDCF,IAXIS) - IDCF_XYZ(HIGH_IND,IAXIS) = MESHES(NM)%FCVAR(I ,J,K,CC_IDCF,IAXIS) - IDCF_XYZ(LOW_IND ,JAXIS) = MESHES(NM)%FCVAR(I,J-1,K,CC_IDCF,JAXIS) - IDCF_XYZ(HIGH_IND,JAXIS) = MESHES(NM)%FCVAR(I,J ,K,CC_IDCF,JAXIS) - IDCF_XYZ(LOW_IND ,KAXIS) = MESHES(NM)%FCVAR(I,J,K-1,CC_IDCF,KAXIS) - IDCF_XYZ(HIGH_IND,KAXIS) = MESHES(NM)%FCVAR(I,J,K ,CC_IDCF,KAXIS) - - NFACE_CELL = 0 - - X1AXIS_LOOP3 : DO X1AXIS=IAXIS,KAXIS - CEI_AXIS(LOW_IND:HIGH_IND) = IDCF_XYZ(LOW_IND:HIGH_IND,X1AXIS) - DO SIDE=LOW_IND,HIGH_IND - ! Low High face: - IF ( FSID_XYZ(SIDE,X1AXIS) == CC_GASPHASE ) THEN - ! Regular Face, build 4 vertices + face: - NFACE_CELL = NFACE_CELL + 1 - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED/) - ! CC_FTYPE_RCGAS=0, regular face. - ELSEIF (FSID_XYZ(SIDE,X1AXIS) == CC_CUTCFE ) THEN - ! GasPhase CUT_FACE, add all cut-faces on these Cartesian cell + nodes - CEI = CEI_AXIS(SIDE) - DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE - NFACE_CELL = NFACE_CELL + 1 - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL)=(/ CC_FTYPE_CFGAS,SIDE,X1AXIS,CEI,ICF,CC_UNDEFINED/) - ! CC_FTYPE_CFGAS=1 + NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) + ! Do test for PERIODIC boundaries. Note: PERIODIC boundaries at this point have been redefined as INTERPOLATED_BOUNDARY, + ! so we test using the Mesh center relative locations. + IF (WC%BOUNDARY_TYPE==INTERPOLATED_BOUNDARY .AND. NMICC > 0 .AND. TEST_ICC) THEN + WC_PERIODIC=.FALSE. + SELECT CASE(IOR) + CASE(-IAXIS) ! High X wall cell. + XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) + IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE( IAXIS) ! Low X wall cell. + XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) + IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE(-JAXIS) ! High Y wall cell. + XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) + IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE( JAXIS) ! Low Y wall cell. + XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) + IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE(-KAXIS) ! High Z wall cell. + XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) + IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + CASE( KAXIS) ! Low Z wall cell. + XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) + IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. + END SELECT + IF (WC_PERIODIC) THEN + MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) = 0 ! Set NMICC = 0. + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + IF(MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_CGSC)==CC_SOLID) THEN + MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC)=CC_SOLID ! set to Solid. + CYCLE EXTERNAL_WALL_LOOP_2 + ENDIF + ENDDO ENDDO - ENDIF - ENDDO - ENDDO X1AXIS_LOOP3 - - ! Now add INBOUNDARY faces of the cell: - CEI = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) - IF ( CEI > 0 ) THEN - DO ICF=1,MESHES(NM)%CUT_FACE(CEI)%NFACE - NFACE_CELL = NFACE_CELL + 1 - FACE_LIST(1:CC_NPARAM_CCFACE,NFACE_CELL) = (/ CC_FTYPE_CFINB, 0, 0, CEI, ICF, CC_UNDEFINED /) - ! CC_FTYPE_CFINB in Cart-cell. - ENDDO - ENDIF - - VOL(1) = DXCELL(I)*DYCELL(J)*DZCELL(K) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZCELL(K) /) - - ! Load into CUT_CELL data structure - NCUTCELL = MESHES(NM)%N_CUTCELL_MESH + MESHES(NM)%N_GCCUTCELL_MESH + 1 - IF (INTGC_FLG==LOW_IND) THEN - MESHES(NM)%N_CUTCELL_MESH = NCUTCELL - ELSE - MESHES(NM)%N_GCCUTCELL_MESH = MESHES(NM)%N_GCCUTCELL_MESH + 1 + ENDDO + ENDIF ENDIF - MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = NCUTCELL - - ! Resize array MESHES(NM)%CUT_CELL if necessary: - CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) - - ! Add cut-cell NCUTCELL entry: - MESHES(NM)%CUT_CELL(NCUTCELL)%IJK(IAXIS:KAXIS) = (/ I, J, K /) - MESHES(NM)%CUT_CELL(NCUTCELL)%NCELL = NCELL - MESHES(NM)%CUT_CELL(NCUTCELL)%NFACE_CELL= NFACE_CELL - CALL NEW_CELL_ALLOC(NM,NCUTCELL,NCELL,NFACE_CELL,NCFACE_CUTCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%CCELEM(1:NCFACE_CUTCELL,1) = (/ 6, 1, 2, 3, 4, 5, 6 /) - MESHES(NM)%CUT_CELL(NCUTCELL)%FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) = & - FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%VOLUME(1:NCELL) = VOL(1:NCELL) - MESHES(NM)%CUT_CELL(NCUTCELL)%XYZCEN(IAXIS:KAXIS,1:NCELL) = XYZCEN(IAXIS:KAXIS,1:NCELL) - - ENDDO - ENDDO - ENDDO - - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNT ) - -ENDDO INTGC_FLG_LOOP2 - - -DEALLOCATE(GEOMFACE,GEOMCELL) - -#endif -END SUBROUTINE GET_REGULAR_CUTCELLS_BOX - - -! --------------------- DEALLOCATE_CUTCELLS_CONN_MESH -------------------------- - -SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH(NM) - -INTEGER, INTENT(IN) :: NM - -INTEGER :: ICC, ICF, I, J, K, DO_BNCF=1 -INTEGER, PARAMETER :: LOIN=-1 -INTEGER, PARAMETER :: HIIN= 2 - -! Cut-cells and GASPHASE cut-faces: -DO K=-CCGUARD,MESHES(NM)%KBAR+CCGUARD - IF(K>LOIN .AND. KMESHES(NM)%KBAR+LOIN .AND. KLOIN .AND. JMESHES(NM)%JBAR+LOIN .AND. JLOIN .AND. IMESHES(NM)%IBAR+LOIN .AND. I0) CALL CELL_DEALLOC(NM,ICC) ! Deallocate this CUT_CELL array container: - ! IAXIS cut-face: - ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,IAXIS) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) - ! JAXIS cut-face: - ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,JAXIS) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) - ! KAXIS cut-face: - ICF = MESHES(NM)%FCVAR(I,J,K,CC_IDCF,KAXIS) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF) - ENDDO - ENDDO -ENDDO -! INBOUNDARY cut-faces: -DO K=-CCGUARD,MESHES(NM)%KBAR+CCGUARD - DO J=-CCGUARD,MESHES(NM)%JBAR+CCGUARD - DO I=-CCGUARD,MESHES(NM)%IBAR+CCGUARD - ICF = MESHES(NM)%CCVAR(I,J,K,CC_IDCF) - IF (ICF>0) CALL FACE_DEALLOC(NM,ICF,DO_BNCF) ! Deallocate this CUT_FACE array fields, except NFACE, XYZCEN. - ENDDO - ENDDO -ENDDO -IF(ALLOCATED(MESHES(NM)%VERTVAR)) DEALLOCATE(MESHES(NM)%VERTVAR) -IF(ALLOCATED(MESHES(NM)%ECVAR)) DEALLOCATE(MESHES(NM)%ECVAR) -RETURN -END SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH - - -! ---------------------- GET_EXT_INB_CUTFACES_TO_CFACE -------------------------------- - -SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE - -! Local Variables: -INTEGER :: ICF, CFACE_INDEX_LOCAL, SURF_INDEX -INTEGER :: IVENT -REAL(EB):: ADDMAT(IAXIS:KAXIS,LOW_IND:HIGH_IND) - -! GET_CUTCELLS_VERBOSE variables: -INTEGER, ALLOCATABLE, DIMENSION(:) :: NCFACE_BY_MESH - -TYPE(VENTS_TYPE), POINTER :: VT -TYPE(CFACE_TYPE), POINTER :: CFA - -IF(GET_CUTCELLS_VERBOSE) CALL CPU_TIME(CPUTIME_START) - -ALLOCATE(NCFACE_BY_MESH(1:NMESHES)); NCFACE_BY_MESH(1:NMESHES) = 0 -MESH_LOOP_0 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - ! First N_EXTERNAL_CFACE_CELLS: - DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE - CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE - CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE - END SELECT - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO - ! Second N_INTWALL_CFACE_CELLS: - DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - CASE(JAXIS) - IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - CASE(KAXIS) - IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - END SELECT - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO - ! Second N_INTERNAL_CFACE_CELLS: - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE - ! Don't count INB cut-faces inside an OBST: - IF (CELL(CELL_INDEX(CF%IJK(IAXIS),CF%IJK(JAXIS),CF%IJK(KAXIS)))%SOLID) CYCLE - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO -ENDDO MESH_LOOP_0 - -IF(GET_CUTCELLS_VERBOSE) THEN - CALL MPI_ALLREDUCE(MPI_IN_PLACE,NCFACE_BY_MESH(1),NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) - WRITE(LU_SETCC,'(A,I10)',advance='no') ' 4. Generating CFACES from cut-faces, total CFACE_CELLS=', & - SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,I10)') ' Total number of CFACES in all processes=', & - SUM(NCFACE_BY_MESH(1:NMESHES)) - WRITE(LU_ERR ,'(A,I10)',advance='no') & - ' 4. Process 0 Generating CFACES from cut-faces, total CFACE_CELLS=', & - SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) - ENDIF -ENDIF - -! First mesh Loop, Allocate storage for CFACES, CFACE geometric info: -MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - - ! ALLOCATE to zero size - IF(ALLOCATED(MESHES(NM)%CFACE)) DEALLOCATE(MESHES(NM)%CFACE) - MESHES(NM)%N_CFACE_CELLS_DIM = NCFACE_BY_MESH(NM) - ALLOCATE(MESHES(NM)%CFACE(0:MESHES(NM)%N_CFACE_CELLS_DIM)) - - ALLOCATE(MESHES(NM)%FACE_WORK1(MESHES(NM)%N_CFACE_CELLS_DIM)) - ALLOCATE(MESHES(NM)%FACE_WORK2(MESHES(NM)%N_CFACE_CELLS_DIM)) - ALLOCATE(MESHES(NM)%FACE_WORK3(MESHES(NM)%N_CFACE_CELLS_DIM)) - - ! Define pointers among External CC_GASPHASE CUT_FACE and CFACE (N_EXTERNAL_CFACE_CELLS): - CFACE_INDEX_LOCAL = 0 - DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE - CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE - CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE - END SELECT - ! Now get WALL cell SURF_INDEX: - IW = 0 - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (I==0 ) IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-1) - IF (I==IBAR) IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( 1) - CASE(JAXIS) - IF (J==0 ) IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-2) - IF (J==JBAR) IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( 2) - CASE(KAXIS) - IF (K==0 ) IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-3) - IF (K==KBAR) IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( 3) - END SELECT - SURF_INDEX = WALL(IW)%SURF_INDEX - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) - ENDDO - ENDDO - MESHES(NM)%N_EXTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - ! Define pointers among internal CC_GASPHASE CUT_FACE and CFACE (N_INTWALL_CFACE_CELLS): - DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST, or don't lay on a WALL_CELL: - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE - ENDIF - CASE(JAXIS) - IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE - ENDIF - CASE(KAXIS) - IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 + ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 + N_CF = 0 + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) + IF (ICC > 0) THEN + N_CF = N_CF + 1 + MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,N_CF) = (/ NOM, ICC /) + NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL + ! Add NCELL cut-cells to OM%NCC_R: + MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 + MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL + ENDIF + ENDDO + ENDDO + ENDDO + MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = N_CF ENDIF - END SELECT - SURF_INDEX = WALL(IW)%SURF_INDEX - IF(.NOT.ALLOCATED(CF%CFACE_INDEX)) THEN; ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) - ELSEIF (SIZE(CF%CFACE_INDEX,DIM=1)/=CF%NFACE)THEN - DEALLOCATE(CF%CFACE_INDEX); ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) - ENDIF - IF(.NOT.ALLOCATED(CF%SURF_INDEX)) THEN; ALLOCATE(CF%SURF_INDEX(CF%NFACE)) - ELSEIF (SIZE(CF%SURF_INDEX,DIM=1)/=CF%NFACE)THEN - DEALLOCATE(CF%SURF_INDEX); ALLOCATE(CF%SURF_INDEX(CF%NFACE)) - ENDIF - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) - ENDDO - ENDDO - MESHES(NM)%N_INTWALL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%N_EXTERNAL_CFACE_CELLS - MESHES(NM)%INTERNAL_CFACE_CELLS_LB = MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%N_INTWALL_CFACE_CELLS - ! Define pointers among CC_INBOUNDARY CUT_FACE and CFACE (N_INTERNAL_CFACE_CELLS): - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - CF => MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS) - ! Don't count INB cut-faces inside an OBST: - IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - SURF_INDEX = CF%SURF_INDEX(IFACE) - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.TRUE.) - ENDDO - IF(ALLOCATED(CF%CFACE_ORIGIN)) DEALLOCATE(CF%CFACE_ORIGIN) - ENDDO - MESHES(NM)%N_INTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%INTERNAL_CFACE_CELLS_LB -ENDDO MESH_LOOP_1 + ! Here add cut or regular faces to every face on this wall cell: + ! This requires defining the sets of cut and regular faces within the area of each cut or + ! regular face. Option : Use POINT_IN_POLYGON with centroids. To do. -! Second loop, apply VENTS to change SURF_ID associated with CFACEs: -MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) + ELSEIF(WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) THEN + NOM = NM ! Use gas cell data, same mesh. + IIO = BC%IIG + JJO = BC%JJG + KKO = BC%KKG + ! CYCLE if OBJECT face is in the Mirror Boundary, normal out into ghost-cell: + SELECT CASE(IOR) + CASE( IAXIS) + IF(FCVAR(IIO-1,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE + CASE(-IAXIS) + IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE + CASE( JAXIS) + IF(FCVAR(IIO ,JJO-1,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE + CASE(-JAXIS) + IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE + CASE( KAXIS) + IF(FCVAR(IIO ,JJO ,KKO-1,CC_FGSC,KAXIS) == CC_SOLID) CYCLE + CASE(-KAXIS) + IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,KAXIS) == CC_SOLID) CYCLE + END SELECT + IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN + ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC); IF (ICC<1) CYCLE + NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) + NOFC = 1 + ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 + MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,NOFC) = (/ NOM, ICC /) + MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = NOFC + NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL + ! Add NCELL cut-cells to OM%NCC_R: + MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 + MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL + ENDIF + ENDIF - ! ! Currently : Modify CFACE SURF_INDEX with VENT information: This needs more development. - VENT_LOOP : DO IVENT=1,MESHES(NM)%N_VENT - VT => VENTS(IVENT) - IF(.NOT.VT%GEOM) CYCLE VENT_LOOP ! Do not apply vent to Geometries. + ENDDO EXTERNAL_WALL_LOOP_2 - ! This test is a simplified test for VENTS changing the CFACE SURF_ID to VENT SURF_ID for all CFACEs whose - ! centroid locations lay within the frame of the IOR grid aligned VENT: - ADDMAT = 0._EB; - SELECT CASE(ABS(VT%IOR)) - CASE(IAXIS) - ADDMAT(IAXIS,LOW_IND) = -(XF_MAX-XS_MIN) ! -DX(VT%I1) Set normal size to 2 times domain size. - ADDMAT(IAXIS,HIGH_IND) = (XF_MAX-XS_MIN) ! DX(VT%I2) XF_MAX, etc. defined in cons.f90. - CASE(JAXIS) - ADDMAT(JAXIS,LOW_IND) = -(YF_MAX-YS_MIN) ! -DY(VT%J1) - ADDMAT(JAXIS,HIGH_IND) = (YF_MAX-YS_MIN) ! DY(VT%J2) - CASE(KAXIS) - ADDMAT(KAXIS,LOW_IND) = -(ZF_MAX-ZS_MIN) ! -DZ(VT%K1) - ADDMAT(KAXIS,HIGH_IND) = (ZF_MAX-ZS_MIN) ! DZ(VT%K2) - END SELECT - ! CFACE Loop to modify SURF_INDEX in INTERNAL_CFACE_CELLS: - CFACE_LOOP_2 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - CFA => CFACE(CFACE_INDEX_LOCAL) - BC => BOUNDARY_COORD(CFA%BC_INDEX) - IF (BC%X < X(VT%I1)+ADDMAT(IAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%X > X(VT%I2)+ADDMAT(IAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - IF (BC%Y < Y(VT%J1)+ADDMAT(JAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%Y > Y(VT%J2)+ADDMAT(JAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - IF (BC%Z < Z(VT%K1)+ADDMAT(KAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%Z > Z(VT%K2)+ADDMAT(KAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - CFA%VENT_INDEX = IVENT - CFA%SURF_INDEX = VT%SURF_INDEX - ENDDO CFACE_LOOP_2 - ENDDO VENT_LOOP ENDDO MESH_LOOP_2 -! - At this pont all final values of SURF_INDEX have been given to CFACEs. -! Third loop, 1. Compute final FDS area integrals by SURF_ID and GEOM. -! 2. Compute input areas by SURF_ID and GEOM. First sum over GEOM FACES SURF_IDs, -! then VENTS input surfaces are assigned to corresponding GEOMs and SURF_IDs if present (VENTs take precedence). -IF(N_GEOMETRY>0) THEN - ALLOCATE(FDS_AREA_GEOM(0:N_SURF,N_GEOMETRY)); FDS_AREA_GEOM = 0._EB +IF(GET_CUTCELLS_VERBOSE) THEN + CALL CPU_TIME(CPUTIME) + WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' + ENDIF ENDIF -MESH_LOOP_3 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - CFA => CFACE(CFACE_INDEX_LOCAL) - ICF = CFA%CUT_FACE_IND1; IFACE= CFA%CUT_FACE_IND2 - I = CUT_FACE(ICF)%BODTRI(1,IFACE) - IF(I>0) FDS_AREA_GEOM(CFA%SURF_INDEX,I) = FDS_AREA_GEOM(CFA%SURF_INDEX,I) + CFA%AREA - ENDDO -ENDDO MESH_LOOP_3 -! Sum FDS and INPUT areas per SURF_ID and GEOM (all reduce sum): -IF(N_GEOMETRY>0) & -CALL MPI_ALLREDUCE(MPI_IN_PLACE, FDS_AREA_GEOM(0,1), (N_SURF+1)*N_GEOMETRY, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) -! Fourth Loop: Assign AREA_ADJUST for CFACEs, and assign BC info to CFACEs: -MESH_LOOP_4 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) +RETURN - ! BCs related information for INTERNAL CFACE CELLS: - CFACE_LOOP_4 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - ICF = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND1 - IFACE = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND2 - SURF_INDEX = CFACE(CFACE_INDEX_LOCAL)%SURF_INDEX - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_TWO,IS_INB=.TRUE.) - ENDDO CFACE_LOOP_4 +END SUBROUTINE SET_GC_CUTCELLS_3D -ENDDO MESH_LOOP_4 -IF (GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' - IF (MY_RANK==0) WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' +SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS(NM) + +INTEGER, INTENT(IN) :: NM +INTEGER :: ICC,ICC1,I,J,K + +! Block SPCELLS, cells in cut-cell region where cut-cells could not be built: +IF (MESHES(NM)%N_SPCELLS_TO_BLOCK < 1 .OR. .NOT.ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) RETURN + +DO ICC=1,MESHES(NM)%N_SPCELLS_TO_BLOCK + I = MESHES(NM)%SPCELL_LIST(IAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + J = MESHES(NM)%SPCELL_LIST(JAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + K = MESHES(NM)%SPCELL_LIST(KAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + ICC1 = MESHES(NM)%CCVAR(I,J,K,CC_IDCC) + IF (ICC1 > 0) THEN + CC => MESHES(NM)%CUT_CELL(ICC1) + CC%NOADVANCE(1:CC%NCELL) = BLOCKED_SPECIAL_CELL + ENDIF +ENDDO + +END SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS + + +SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) + +INTEGER, INTENT(IN) :: NM + +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) +MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 + +END SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK + +END SUBROUTINE SET_CUTCELLS_3D + +SUBROUTINE CC_GRID_BUILD_RAW_CUTCELLS(ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH,GEOM_ZMAX_AUX, & + TNOW,CPUTIME_START_MESH,GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW, & + FIRST_CALL_ARG,FIRST_CALL_ARG2) + +INTEGER :: NM +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, ALLOCATABLE, INTENT(INOUT), DIMENSION(:) :: CC_COMPUTE_MESH +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX +REAL(EB), INTENT(INOUT) :: TNOW, CPUTIME_START_MESH +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW +LOGICAL, INTENT(INOUT) :: FIRST_CALL_ARG, FIRST_CALL_ARG2 + +CALL CC_GRID_GLOBAL_INIT(ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH,TNOW,CPUTIME_START_MESH, & + GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) +IF (STOP_STATUS==SETUP_STOP) RETURN + +CALL CC_GRID_ALLOCATE_BUILD_SCRATCH_WORK(FIRST_CALL_ARG,FIRST_CALL_ARG2) + +! Main Loop over Meshes: +MAIN_MESH_LOOP : DO NM=1,NMESHES + CALL CC_GRID_BUILD_CUTCELL_MESH(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH,GEOM_ZMAX_AUX) + IF (STOP_STATUS==SETUP_STOP) RETURN +ENDDO MAIN_MESH_LOOP + +CALL CC_GRID_RELEASE_BUILD_SCRATCH_WORK + +END SUBROUTINE CC_GRID_BUILD_RAW_CUTCELLS + +SUBROUTINE CC_GRID_GLOBAL_INIT(ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH,TNOW,CPUTIME_START_MESH, & + GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) +USE MPI_F08 + +INTEGER :: I, J, K, NM, NOM, IPROC, NMESH_CC, NMESH_CC_AUX, TAG, ING, INOD, IWSEL, IEL, IERR +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +TYPE(MPI_STATUS) :: MPISTATUS +CHARACTER(MESSAGE_LENGTH) :: VERBOSE_FILE, VERBOSE_FILE_AUX +CHARACTER(100) :: FILENAME +REAL(EB) :: VERT_AUX(IAXIS:KAXIS) +INTEGER :: FACE_AUX(NOD1:NOD3), VOL_AUX(NOD1:NOD4) +LOGICAL, ALLOCATABLE, DIMENSION(:) :: CC_COMPUTE_MESH_AUX +LOGICAL, ALLOCATABLE, INTENT(INOUT), DIMENSION(:) :: CC_COMPUTE_MESH +REAL(EB), INTENT(INOUT) :: TNOW, CPUTIME_START_MESH +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW + +IF (MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN + WRITE(LU_ERR,*) ' ' + WRITE(LU_ERR,*) 'SET_CUTCELLS_3D : Cut-Cell computation in VERBOSE mode, 4 tasks to perform:' ENDIF -RETURN -END SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE +! Reset variables: +CC_NEDGECROSS = 0 +CC_NCUTEDGE = 0 +CC_NCUTFACE = 0 +CC_NCUTCELL = 0 +! Check Meshes Boundaries match, requirement to get consistent ghost and internal cut-cells. +CALL CHECK_WALL_CELL_PLANE_MATCH; IF (STOP_STATUS==SETUP_STOP) RETURN -! ------------------------- SET_GC_CUTCELLS_3D ----------------------------------- +! Get geometry triangle bins in Cartesian directions: +CALL GET_GEOM_TRIBIN(CC_COMPUTE_MESH) -SUBROUTINE SET_GC_CUTCELLS_3D +! Snap to grid planes node positions in the work volume of this process: +CALL SNAP_GEOM_NODES(ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH) -! Local Variables: -INTEGER :: IW,II,JJ,KK,IOR,IIO,JJO,KKO,IIF,JJF,KKF,IIOF,JJOF,KKOF,ICF,ICOF,X1AXIS,ICC,NMICC,NOFC,N_CF,N_CRT -REAL(EB):: XNM, XNOM -TYPE (WALL_TYPE), POINTER :: WC -TYPE (EXTERNAL_WALL_TYPE), POINTER :: EWC -LOGICAL :: WC_PERIODIC, TEST_ICC -REAL(EB):: AREA_NM, AREA_NOM, AREA_CRT +! Initialize GEOMETRY fields used by CC_IBM: +CALL CC_INIT_GEOM; IF (STOP_STATUS==SETUP_STOP) RETURN + +TNOW=CURRENT_TIME() + +DEBUG_SET_CUTCELLS_COND : IF (DEBUG_SET_CUTCELLS) THEN + ! Write meshes file: + WRITE(FILENAME,'(A,A)') TRIM(CHID),'_meshes.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8)') NMESHES + MESH_LOOP : DO NM=1,NMESHES + + IF (PROCESS(NM)/=MY_RANK) CYCLE + + ! Mesh sizes: + NXB=MESHES(NM)%IBAR + NYB=MESHES(NM)%JBAR + NZB=MESHES(NM)%KBAR + + WRITE(33,'(4I8,6F24.16)') NM,NXB,NYB,NZB,MESHES(NM)%X(0),MESHES(NM)%X(NXB),& + MESHES(NM)%Y(0),MESHES(NM)%Y(NYB),& + MESHES(NM)%Z(0),MESHES(NM)%Z(NZB) + DO I=0,NXB + WRITE(33,'(4F24.16)') MESHES(NM)%X(I),MESHES(NM)%XC(I),MESHES(NM)%DXN(I),MESHES(NM)%DX(I) + ENDDO + DO J=0,NYB + WRITE(33,'(4F24.16)') MESHES(NM)%Y(J),MESHES(NM)%YC(J),MESHES(NM)%DYN(J),MESHES(NM)%DY(J) + ENDDO + DO K=0,NZB + WRITE(33,'(4F24.16)') MESHES(NM)%Z(K),MESHES(NM)%ZC(K),MESHES(NM)%DZN(K),MESHES(NM)%DZ(K) + ENDDO + + ENDDO MESH_LOOP + CLOSE(33) + + ! Write geometry files: + WRITE(FILENAME,'(A,A)') TRIM(CHID),'_num_geometries.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I6,4F24.16)') N_GEOMETRY, GEOMEPS + CLOSE(33) + GEOM_LOOP : DO ING=1,N_GEOMETRY + + ! Write Vertices: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_verts.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO INOD=1,GEOMETRY(ING)%N_VERTS + VERT_AUX(IAXIS:KAXIS) = GEOMETRY(ING)%VERTS(MAX_DIM*(INOD-1)+1:MAX_DIM*INOD) + WRITE(33,'(3F24.16)') VERT_AUX(IAXIS:KAXIS) + ENDDO + CLOSE(33) + + ! Write faces: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_faces.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IWSEL=1,GEOMETRY(ING)%N_FACES + FACE_AUX(NOD1:NOD3)=GEOMETRY(ING)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + WRITE(33,'(4I10)') FACE_AUX(NOD1:NOD3),GEOMETRY(ING)%SURFS(IWSEL) + ENDDO + CLOSE(33) + + ! Write Volumes: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_volus.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_VOLUS + VOL_AUX(NOD1:NOD4)=GEOMETRY(ING)%VOLUS(NODS_VLEL*(IEL-1)+1:NODS_VLEL*IEL) + WRITE(33,'(4I10)') VOL_AUX(NOD1:NOD4) + ENDDO + CLOSE(33) + + ! Write Edges: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edges.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_EDGES + WRITE(33,'(2I10)') GEOMETRY(ING)%EDGES(NOD1:NOD2,IEL) + ENDDO + CLOSE(33) + + ! Write FACE_EDGES: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_fcedg.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_FACES + WRITE(33,'(3I10)') GEOMETRY(ING)%FACE_EDGES(NOD1:NOD3,IEL) + ENDDO + CLOSE(33) + + ! Write EDGE_FACES: + WRITE(FILENAME,'(A,A,I4.4,A)') TRIM(CHID),'_geometry_',ING,'_edfac.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + DO IEL=1,GEOMETRY(ING)%N_EDGES + WRITE(33,'(5I10)') GEOMETRY(ING)%EDGE_FACES(NOD1:NOD4+1,IEL) + ENDDO + CLOSE(33) + ENDDO GEOM_LOOP +ENDIF DEBUG_SET_CUTCELLS_COND -IF (CCGUARD == 0) RETURN +! Select MESHES assigned to MY_RANK and OMESHES of these. Cut-cells computed for all of them. Done in GET_GEOM_TRIBIN -IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' +IF (GET_CUTCELLS_VERBOSE) THEN + NMESH_CC=0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH(NOM)) NMESH_CC = NMESH_CC + 1 + ENDDO + ! MY_RANK = 0 writes first: IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' + ! Open file to write SET_CUTCELLS_3D progress: + WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' + OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') + WRITE(LU_ERR,*) ' ' + WRITE(LU_ERR,*) '2. Generate Cut-cells in Meshes :' + WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC, & + ' meshes in file ',TRIM(VERBOSE_FILE),'.' + WRITE(LU_SETCC,*) ' ' + WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' + WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',MY_RANK,', will process M=',NMESH_CC,' meshes.' + WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' + WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process : ' + NMESH_CC_AUX = 0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH(NOM)) THEN + NMESH_CC_AUX = NMESH_CC_AUX + 1 + IF(NMESH_CC_AUX < NMESH_CC) THEN + WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' + WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' + ELSE + WRITE(LU_ERR,'(I4.4,A)') NOM,'.' + WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' + ENDIF + ENDIF + ENDDO + ENDIF + IF (N_MPI_PROCESSES > 1) THEN + IF (MY_RANK==0) ALLOCATE(CC_COMPUTE_MESH_AUX(1:NMESHES)) + ! Now rest of processes pass their mesh info to process 0: + DO IPROC=1,N_MPI_PROCESSES-1 + TAG = 0 + IF (MY_RANK==IPROC) THEN ! Send CC_COMPUTE_MESH array. + TAG=IPROC + CALL MPI_SEND(CC_COMPUTE_MESH(1),NMESHES,MPI_LOGICAL,0,TAG,MPI_COMM_WORLD,IERR) + ! Open file to write SET_CUTCELLS_3D progress: + WRITE(VERBOSE_FILE,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',MY_RANK,'.log' + OPEN(UNIT=LU_SETCC,FILE=TRIM(VERBOSE_FILE),STATUS='UNKNOWN') + WRITE(LU_SETCC,*) ' ' + WRITE(LU_SETCC,*) '2. Generate Cut-cells in Meshes :' + WRITE(LU_SETCC,'(A,I4,A,I4,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC,' meshes.' + WRITE(LU_SETCC,'(A)',advance="no") ' Meshes to Process :' + NMESH_CC_AUX = 0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH(NOM)) THEN + NMESH_CC_AUX = NMESH_CC_AUX + 1 + IF ( NMESH_CC_AUX < NMESH_CC ) THEN + WRITE(LU_SETCC,'(I4.4,A)',advance="no") NOM,', ' + ELSE + WRITE(LU_SETCC,'(I4.4,A)') NOM,'.' + ENDIF + ENDIF + ENDDO + ELSEIF (MY_RANK==0) THEN ! Receive CC_COMPUTE_MESH array and write. + TAG=IPROC + CALL MPI_RECV(CC_COMPUTE_MESH_AUX(1),NMESHES,MPI_LOGICAL,IPROC,TAG,MPI_COMM_WORLD,MPISTATUS,IERR) + ! Write to LU_ERR: + NMESH_CC=0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH_AUX(NOM)) NMESH_CC = NMESH_CC + 1 + ENDDO + WRITE(VERBOSE_FILE_AUX,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_cutcell_',IPROC,'.log' + WRITE(LU_ERR,'(A,I4,A,I4,A,A,A)',advance="no") ' Process MY_RANK=',IPROC,', will process M=',NMESH_CC, & + ' meshes in file ',TRIM(VERBOSE_FILE_AUX),'.' + WRITE(LU_ERR,'(A)',advance="no") ' Meshes to Process : ' + NMESH_CC_AUX = 0 + DO NOM=1,NMESHES + IF(CC_COMPUTE_MESH_AUX(NOM)) THEN + NMESH_CC_AUX = NMESH_CC_AUX + 1 + IF ( NMESH_CC_AUX < NMESH_CC ) THEN + WRITE(LU_ERR,'(I4.4,A)',advance="no") NOM,', ' + ELSE + WRITE(LU_ERR,'(I4.4,A)') NOM,'.' + ENDIF + ENDIF + ENDDO + ENDIF + CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) + ENDDO + IF (MY_RANK==0) DEALLOCATE(CC_COMPUTE_MESH_AUX) ENDIF + CALL CPU_TIME(CPUTIME_START_MESH) ENDIF -! Meshes Loop: -! First Mesh Loop: -! Test if NOM mesh cells are of the same size or smaller than NM mesh that areas match: -MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - - IF (MESHES(NM)%N_CUTFACE_MESH==0) CYCLE MESH_LOOP_1 - CALL POINT_TO_MESH(NM) - - EXTERNAL_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS - - WC=>WALL(IW) - EWC=>EXTERNAL_WALL(IW) - BC=>BOUNDARY_COORD(WC%BC_INDEX) - B1=>BOUNDARY_PROP1(WC%B1_INDEX) - IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & - WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_1 - - II = BC%II - JJ = BC%JJ - KK = BC%KK - IOR = BC%IOR +IF(N_GEOMETRY>0) THEN + ALLOCATE(GEOM_AREA_SURF_OLD(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_OLD=0._EB + ALLOCATE(GEOM_AREA_SURF_NEW(0:N_SURF,1:N_GEOMETRY)); GEOM_AREA_SURF_NEW=0._EB +ENDIF - ! Skip if no cut-faces present on this WC: - ! Define underlying Cartesian faces indexes: - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-IAXIS) ! Higher X boundary for Mesh NM. - IIF = II - 1; JJF = JJ ; KKF = KK - CASE( JAXIS) ! Lower Y boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-JAXIS) ! Higher Y boundary for Mesh NM. - IIF = II ; JJF = JJ - 1; KKF = KK - CASE( KAXIS) ! Lower Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-KAXIS) ! Higher Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - 1 - END SELECT - X1AXIS = ABS(IOR) - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE EXTERNAL_WALL_LOOP_1 +END SUBROUTINE CC_GRID_GLOBAL_INIT - ! Gas cut-face area in wall-cell IW face: - ICF = FCVAR(IIF,JJF,KKF,CC_IDCF,X1AXIS) - AREA_NM = SUM(CUT_FACE(ICF)%AREA(1:CUT_FACE(ICF)%NFACE)) +SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH,GEOM_ZMAX_AUX) - IF(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN - NOM = EWC%NOM ! Use Other Mesh Data. - IF(MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_1 - ! Now Obtain the CUT_FACE for the same face on NM-NOM: +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, ALLOCATABLE, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX - AREA_NOM = 0._EB; N_CF=0; N_CRT=0 - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) - CASE(-IAXIS) ! Higher X boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO- 1; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) - CASE( JAXIS) ! Lower Y boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) - CASE(-JAXIS) ! Higher Y boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO ; JJOF= JJO- 1; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) - CASE( KAXIS) ! Lower Z boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) - CASE(-KAXIS) ! Higher Z boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO- 1; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) - END SELECT - IF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_FGSC,X1AXIS) == CC_GASPHASE) THEN - AREA_NOM = AREA_NOM + AREA_CRT - N_CRT = N_CRT + 1 - ELSEIF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) > 0) THEN ! there are gasphase cut-faces - ICOF = MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) - AREA_NOM = AREA_NOM + SUM(MESHES(NOM)%CUT_FACE(ICOF)%AREA(1:MESHES(NOM)%CUT_FACE(ICOF)%NFACE)) - N_CF = N_CF + 1 - ENDIF - ENDDO - ENDDO - ENDDO +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 - ! Check if: - ! 1. other mesh faces are more than one -> areas match. - ! 2. other mesh face and size of cartesian faces the same -> areas match. - ! 3. Left the case of fine mesh face with OMESH face coarse. - NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 - IF ( (NOFC > 1) .OR. (ABS(B1%AREA-AREA_CRT) < GEOMEPS) )THEN - IF(ABS(AREA_NM-AREA_NOM) > ADIFF_INFO_FACTOR*AREA_CRT) THEN - WRITE(LU_ERR,*) 'SET_GC_CUTCELLS_3D Error: MESH=',NM,', CUT_FACE=',ICF,' does not match OMESH=',& - NOM,', with CUT_FACEs,CRT_FACEs=',N_CF,N_CRT,', area difference=',& - ABS(AREA_NM-AREA_NOM),', GEOMEPS=',GEOMEPS - WRITE(LU_ERR,*) 'CUT FACE=',ICF,MESHES(NM)%CUT_FACE(ICF)%IJK(1:4),':',MESHES(NM)%CUT_FACE(ICF)%STATUS - ENDIF - ENDIF +CALL POINT_TO_MESH(NM) +M => MESHES(NM) +! Mesh sizes: +NXB=IBAR +NYB=JBAR +NZB=KBAR - ENDIF +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) +CALL CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) - ENDDO EXTERNAL_WALL_LOOP_1 +REGCC_REGION_IF : IF(PERIODIC_TEST==7 .OR. PERIODIC_TEST==11) THEN -ENDDO MESH_LOOP_1 + CALL CC_GRID_GET_REGULAR_CUTCELLS_BOX(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) +ELSE -! Second mesh loop: -! Define cut-cell data on guard-cell region to be communicated: -MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL CC_GRID_BUILD_CUTCELL_MESH_WORK(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) - IF ((MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH)==0) CYCLE MESH_LOOP_2 +ENDIF REGCC_REGION_IF - CALL POINT_TO_MESH(NM) +CALL CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) +CALL CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) +CALL CC_GRID_RELEASE_CELLRT - EXTERNAL_WALL_LOOP_2 : DO IW=1,N_EXTERNAL_WALL_CELLS +END SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH - WC=>WALL(IW) - BC=>BOUNDARY_COORD(WC%BC_INDEX) - EWC=>EXTERNAL_WALL(IW) - IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & - WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_2 +SUBROUTINE DEFINE_XYZFACE_CELL(NM,ALLOC_FLG,ISTR,IEND,JSTR,JEND,KSTR,KEND) - II = BC%II - JJ = BC%JJ - KK = BC%KK - IOR = BC%IOR - NOM = EWC%NOM ! Use Other Mesh Data. +INTEGER, INTENT(IN) :: NM +LOGICAL, INTENT(IN) :: ALLOC_FLG +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +INTEGER :: IGC - IF (NOM>0) THEN - IF (MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_2 - ENDIF +CALL POINT_TO_MESH(NM) +M => MESHES(NM) - IF (WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN +IF (ALLOC_FLG) THEN - ! Skip if no cut-faces present on this WC: - ! Define underlying Cartesian faces indexes: - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-IAXIS) ! Higher X boundary for Mesh NM. - IIF = II - 1; JJF = JJ ; KKF = KK - CASE( JAXIS) ! Lower Y boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-JAXIS) ! Higher Y boundary for Mesh NM. - IIF = II ; JJF = JJ - 1; KKF = KK - CASE( KAXIS) ! Lower Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-KAXIS) ! Higher Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - 1 - END SELECT - X1AXIS = ABS(IOR) - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) CYCLE EXTERNAL_WALL_LOOP_2 + ! X direction bounds: + ILO_FACE = 0 ! Low mesh boundary face index. + IHI_FACE = M%IBAR ! High mesh boundary face index. + ILO_CELL = ILO_FACE + 1 ! First internal cell index. See notes. + IHI_CELL = IHI_FACE ! Last internal cell index. + ISTR = ILO_FACE - NGUARD ! Allocation start x arrays. + IEND = IHI_FACE + NGUARD ! Allocation end x arrays. - IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN - TEST_ICC = .TRUE. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - TEST_ICC = TEST_ICC .AND. (MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) <= 0) - ENDDO - ENDDO - ENDDO + ! Y direction bounds: + JLO_FACE = 0 ! Low mesh boundary face index. + JHI_FACE = M%JBAR ! High mesh boundary face index. + JLO_CELL = JLO_FACE + 1 ! First internal cell index. See notes. + JHI_CELL = JHI_FACE ! Last internal cell index. + JSTR = JLO_FACE - NGUARD ! Allocation start y arrays. + JEND = JHI_FACE + NGUARD ! Allocation end y arrays. - NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) - ! Do test for PERIODIC boundaries. Note: PERIODIC boundaries at this point have been redefined as INTERPOLATED_BOUNDARY, - ! so we test using the Mesh center relative locations. - IF (WC%BOUNDARY_TYPE==INTERPOLATED_BOUNDARY .AND. NMICC > 0 .AND. TEST_ICC) THEN - WC_PERIODIC=.FALSE. - SELECT CASE(IOR) - CASE(-IAXIS) ! High X wall cell. - XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( IAXIS) ! Low X wall cell. - XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE(-JAXIS) ! High Y wall cell. - XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( JAXIS) ! Low Y wall cell. - XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE(-KAXIS) ! High Z wall cell. - XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( KAXIS) ! Low Z wall cell. - XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - END SELECT - IF (WC_PERIODIC) THEN - MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) = 0 ! Set NMICC = 0. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - IF(MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_CGSC)==CC_SOLID) THEN - MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC)=CC_SOLID ! set to Solid. - CYCLE EXTERNAL_WALL_LOOP_2 - ENDIF - ENDDO - ENDDO - ENDDO - ENDIF - ENDIF + ! Z direction bounds: + KLO_FACE = 0 ! Low mesh boundary face index. + KHI_FACE = M%KBAR ! High mesh boundary face index. + KLO_CELL = KLO_FACE + 1 ! First internal cell index. See notes. + KHI_CELL = KHI_FACE ! Last internal cell index. + KSTR = KLO_FACE - NGUARD ! Allocation start z arrays. + KEND = KHI_FACE + NGUARD ! Allocation end z arrays. - NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 - ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 - N_CF = 0 - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) - IF (ICC > 0) THEN - N_CF = N_CF + 1 - MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,N_CF) = (/ NOM, ICC /) - NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL - ! Add NCELL cut-cells to OM%NCC_R: - MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 - MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL - ENDIF - ENDDO - ENDDO - ENDDO - MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = N_CF - ENDIF + ! Define grid arrays for this mesh: + ! Populate position and cell size arrays: Uniform grid implementation. + ! X direction: + ALLOCATE(DXCELL(ISTR:IEND)); DXCELL(ILO_CELL-1:IHI_CELL+1) = M%DX(ILO_CELL-1:IHI_CELL+1) + DO IGC=2,NGUARD + DXCELL(ILO_CELL-IGC)=DXCELL(ILO_CELL-IGC+1) + DXCELL(IHI_CELL+IGC)=DXCELL(IHI_CELL+IGC-1) + ENDDO + ALLOCATE(DXFACE(ISTR:IEND)); DXFACE(ILO_FACE:IHI_FACE)= M%DXN(ILO_FACE:IHI_FACE) + DO IGC=1,NGUARD + DXFACE(ILO_FACE-IGC)=DXFACE(ILO_FACE-IGC+1) + DXFACE(IHI_FACE+IGC)=DXFACE(ILO_FACE+IGC-1) + ENDDO + ALLOCATE(XCELL(ISTR:IEND)); XCELL = 1._EB/GEOMEPS ! Initialize huge. + XCELL(ILO_CELL-1:IHI_CELL+1) = M%XC(ILO_CELL-1:IHI_CELL+1) + DO IGC=2,NGUARD + XCELL(ILO_CELL-IGC)=XCELL(ILO_CELL-IGC+1)-DXFACE(ILO_FACE-IGC+1) + XCELL(IHI_CELL+IGC)=XCELL(IHI_CELL+IGC-1)+DXFACE(IHI_FACE+IGC-1) + ENDDO + ALLOCATE(XFACE(ISTR:IEND)); XFACE = 1._EB/GEOMEPS ! Initialize huge. + XFACE(ILO_FACE:IHI_FACE) = M%X(ILO_FACE:IHI_FACE) + DO IGC=1,NGUARD + XFACE(ILO_FACE-IGC)=XFACE(ILO_FACE-IGC+1)-DXCELL(ILO_CELL-IGC) + XFACE(IHI_FACE+IGC)=XFACE(IHI_FACE+IGC-1)+DXCELL(IHI_CELL+IGC) + ENDDO - ! Here add cut or regular faces to every face on this wall cell: - ! This requires defining the sets of cut and regular faces within the area of each cut or - ! regular face. Option : Use POINT_IN_POLYGON with centroids. To do. + ! Y direction: + ALLOCATE(DYCELL(JSTR:JEND)); DYCELL(JLO_CELL-1:JHI_CELL+1)= M%DY(JLO_CELL-1:JHI_CELL+1) + DO IGC=2,NGUARD + DYCELL(JLO_CELL-IGC)=DYCELL(JLO_CELL-IGC+1) + DYCELL(JHI_CELL+IGC)=DYCELL(JHI_CELL+IGC-1) + ENDDO + ALLOCATE(DYFACE(JSTR:JEND)); DYFACE(JLO_FACE:JHI_FACE)= M%DYN(JLO_FACE:JHI_FACE) + DO IGC=1,NGUARD + DYFACE(JLO_FACE-IGC)=DYFACE(JLO_FACE-IGC+1) + DYFACE(JHI_FACE+IGC)=DYFACE(JHI_FACE+IGC-1) + ENDDO + ALLOCATE(YCELL(JSTR:JEND)); YCELL = 1._EB/GEOMEPS ! Initialize huge. + YCELL(JLO_CELL-1:JHI_CELL+1) = M%YC(JLO_CELL-1:JHI_CELL+1) + DO IGC=2,NGUARD + YCELL(JLO_CELL-IGC)=YCELL(JLO_CELL-IGC+1)-DYFACE(JLO_FACE-IGC+1) + YCELL(JHI_CELL+IGC)=YCELL(JHI_CELL+IGC-1)+DYFACE(JHI_FACE+IGC-1) + ENDDO + ALLOCATE(YFACE(JSTR:JEND)); YFACE = 1._EB/GEOMEPS ! Initialize huge. + YFACE(JLO_FACE:JHI_FACE) = M%Y(JLO_FACE:JHI_FACE) + DO IGC=1,NGUARD + YFACE(JLO_FACE-IGC)=YFACE(JLO_FACE-IGC+1)-DYCELL(JLO_CELL-IGC) + YFACE(JHI_FACE+IGC)=YFACE(JHI_FACE+IGC-1)+DYCELL(JHI_CELL+IGC) + ENDDO - ELSEIF(WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) THEN - NOM = NM ! Use gas cell data, same mesh. - IIO = BC%IIG - JJO = BC%JJG - KKO = BC%KKG - ! CYCLE if OBJECT face is in the Mirror Boundary, normal out into ghost-cell: - SELECT CASE(IOR) - CASE( IAXIS) - IF(FCVAR(IIO-1,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE - CASE(-IAXIS) - IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,IAXIS) == CC_SOLID) CYCLE - CASE( JAXIS) - IF(FCVAR(IIO ,JJO-1,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE - CASE(-JAXIS) - IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,JAXIS) == CC_SOLID) CYCLE - CASE( KAXIS) - IF(FCVAR(IIO ,JJO ,KKO-1,CC_FGSC,KAXIS) == CC_SOLID) CYCLE - CASE(-KAXIS) - IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,KAXIS) == CC_SOLID) CYCLE - END SELECT - IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN - ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC); IF (ICC<1) CYCLE - NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) - NOFC = 1 - ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 - MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,NOFC) = (/ NOM, ICC /) - MESHES(NM)%CUT_CELL(NMICC)%N_NOMICC = NOFC - NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL - ! Add NCELL cut-cells to OM%NCC_R: - MESHES(NM)%OMESH(NOM)%NICC_R(1) = MESHES(NM)%OMESH(NOM)%NICC_R(1) + 1 - MESHES(NM)%OMESH(NOM)%NICC_R(2) = MESHES(NM)%OMESH(NOM)%NICC_R(2) + NCELL - ENDIF - ENDIF + ! Z direction: + ALLOCATE(DZCELL(KSTR:KEND)); DZCELL(KLO_CELL-1:KHI_CELL+1)= M%DZ(KLO_CELL-1:KHI_CELL+1) + DO IGC=2,NGUARD + DZCELL(KLO_CELL-IGC)=DZCELL(KLO_CELL-IGC+1) + DZCELL(KHI_CELL+IGC)=DZCELL(KHI_CELL+IGC-1) + ENDDO + ALLOCATE(DZFACE(KSTR:KEND)); DZFACE(KLO_FACE:KHI_FACE)= M%DZN(KLO_FACE:KHI_FACE) + DO IGC=1,NGUARD + DZFACE(KLO_FACE-IGC)=DZFACE(KLO_FACE-IGC+1) + DZFACE(KHI_FACE+IGC)=DZFACE(KHI_FACE+IGC-1) + ENDDO + ALLOCATE(ZCELL(KSTR:KEND)); ZCELL = 1._EB/GEOMEPS ! Initialize huge. + ZCELL(KLO_CELL-1:KHI_CELL+1) = M%ZC(KLO_CELL-1:KHI_CELL+1) + DO IGC=2,NGUARD + ZCELL(KLO_CELL-IGC)=ZCELL(KLO_CELL-IGC+1)-DZFACE(KLO_FACE-IGC+1) + ZCELL(KHI_CELL+IGC)=ZCELL(KHI_CELL+IGC-1)+DZFACE(KHI_FACE+IGC-1) + ENDDO + ALLOCATE(ZFACE(KSTR:KEND)); ZFACE = 1._EB/GEOMEPS ! Initialize huge. + ZFACE(KLO_FACE:KHI_FACE) = M%Z(KLO_FACE:KHI_FACE) + DO IGC=1,NGUARD + ZFACE(KLO_FACE-IGC)=ZFACE(KLO_FACE-IGC+1)-DZCELL(KLO_CELL-IGC) + ZFACE(KHI_FACE+IGC)=ZFACE(KHI_FACE+IGC-1)+DZCELL(KHI_CELL+IGC) + ENDDO +ELSE - ENDDO EXTERNAL_WALL_LOOP_2 + ! Face centered positions and cell sizes: + IF (ALLOCATED(XFACE)) DEALLOCATE(XFACE) + IF (ALLOCATED(YFACE)) DEALLOCATE(YFACE) + IF (ALLOCATED(ZFACE)) DEALLOCATE(ZFACE) + IF (ALLOCATED(DXFACE)) DEALLOCATE(DXFACE) + IF (ALLOCATED(DYFACE)) DEALLOCATE(DYFACE) + IF (ALLOCATED(DZFACE)) DEALLOCATE(DZFACE) -ENDDO MESH_LOOP_2 + ! Cell centered positions and cell sizes: + IF (ALLOCATED(XCELL)) DEALLOCATE(XCELL) + IF (ALLOCATED(YCELL)) DEALLOCATE(YCELL) + IF (ALLOCATED(ZCELL)) DEALLOCATE(ZCELL) + IF (ALLOCATED(DXCELL)) DEALLOCATE(DXCELL) + IF (ALLOCATED(DYCELL)) DEALLOCATE(DYCELL) + IF (ALLOCATED(DZCELL)) DEALLOCATE(DZCELL) -IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME) - WRITE(LU_SETCC,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,' sec.' - ENDIF ENDIF RETURN - -END SUBROUTINE SET_GC_CUTCELLS_3D - +END SUBROUTINE DEFINE_XYZFACE_CELL ! --------------------------- GET_GEOM_TRIBIN -------------------------------------- -SUBROUTINE GET_GEOM_TRIBIN +SUBROUTINE GET_GEOM_TRIBIN(CC_COMPUTE_MESH) ! This routine separates lists of triangles for each GEOMETRY in interval -! bins in each direction. They are used in SET_CUTCELLS_3D/GET_BODINT_PLANE to optimize -! cut-cell generation. +! bins in each direction. They are used in CC_GRID_BUILD_RAW_CUTCELLS/GET_BODINT_PLANE +! to optimize cut-cell generation. ! Local Variables: +LOGICAL, ALLOCATABLE, INTENT(INOUT), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER :: NM, NOM, X1AXIS INTEGER :: IG, IWSEL, IEDGE, NTL, SZE, IBIN, ILO_BIN, IHI_BIN, WSELEM(NOD1:NOD3) REAL(EB):: LEDGE, DXYZE(MAX_DIM), LX1, DELBIN, X1V_LO, X1V_HI, X1V(NOD1:NOD3) INTEGER, ALLOCATABLE, DIMENSION(:) :: TRI_LIST @@ -15081,8 +14455,8 @@ SUBROUTINE GET_GEOM_TRIBIN G%MEAN_LEDGE= G%MEAN_LEDGE + LEDGE WSELEM=CSHIFT(WSELEM,1) ! Shift cyclically array by 1 entry. This rotates nodes connectivities. - ! i.e: initially WSELEM=(/1,2,3/), 1st call gives WSELEM=(/2,3,1/), 2nd - ! call gives WSELEM=(/3,1,2/). + ! i.e: initially WSELEM=(/1,2,3/), 1st call gives WSELEM=(/2,3,1/), 2nd + ! call gives WSELEM=(/3,1,2/). ENDDO ENDDO @@ -15158,13 +14532,15 @@ SUBROUTINE GET_GEOM_TRIBIN RETURN END SUBROUTINE GET_GEOM_TRIBIN - ! --------------------------- SNAP_GEOM_NODES -------------------------------------- -SUBROUTINE SNAP_GEOM_NODES +SUBROUTINE SNAP_GEOM_NODES(ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH) +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, ALLOCATABLE, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER :: IG, INOD, NM, X1AXIS INTEGER :: IBIN,IWSELDUM,IWSEL,WSELEM(NOD1:NOD3),X1LO,X1HI,X1IND,ILO_BIN,IHI_BIN -REAL(EB):: MIN_MESHGEOM,DELBIN +REAL(EB):: MIN_MESHGEOM,DELBIN,X1PLN REAL(EB) :: CPUTIME_START, CPUTIME IF(MY_RANK==0 .AND. GET_CUTCELLS_VERBOSE) THEN @@ -15197,7 +14573,7 @@ SUBROUTINE SNAP_GEOM_NODES IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 CALL POINT_TO_MESH(NM) M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) ! Run by coordinate direction, define planes X1PLN on this mesh, look for involved GEOMETRY vertices using TBAXIS and ! after positive test of SNAP_NODE check if node is to be snapped to plane. AXIS_LOOP_2 : DO X1AXIS=IAXIS,KAXIS @@ -15247,7 +14623,7 @@ SUBROUTINE SNAP_GEOM_NODES DEALLOCATE(X1FACE,DX1FACE) ENDDO AXIS_LOOP_2 - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) ENDDO MAIN_MESH_LOOP ! Deallocate SNAP_NODE in geometries: @@ -15344,7 +14720,6 @@ SUBROUTINE CC_GRID_INIT_MESH_STORAGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_ END SUBROUTINE CC_GRID_INIT_MESH_STORAGE - SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) INTEGER, INTENT(IN) :: NM @@ -15369,7 +14744,6 @@ SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) END SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK - SUBROUTINE CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) INTEGER, INTENT(IN) :: NM @@ -15391,40 +14765,6 @@ SUBROUTINE CC_GRID_FINALIZE_TERRAIN(NM,GEOM_ZMAX_AUX) END SUBROUTINE CC_GRID_FINALIZE_TERRAIN - -SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS(NM) - -INTEGER, INTENT(IN) :: NM -INTEGER :: ICC,ICC1,I,J,K - -! Block SPCELLS, cells in cut-cell region where cut-cells could not be built: -IF (MESHES(NM)%N_SPCELLS_TO_BLOCK < 1 .OR. .NOT.ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) RETURN - -DO ICC=1,MESHES(NM)%N_SPCELLS_TO_BLOCK - I = MESHES(NM)%SPCELL_LIST(IAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) - J = MESHES(NM)%SPCELL_LIST(JAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) - K = MESHES(NM)%SPCELL_LIST(KAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) - ICC1 = MESHES(NM)%CCVAR(I,J,K,CC_IDCC) - IF (ICC1 > 0) THEN - CC => MESHES(NM)%CUT_CELL(ICC1) - CC%NOADVANCE(1:CC%NCELL) = BLOCKED_SPECIAL_CELL - ENDIF -ENDDO - -END SUBROUTINE CC_GRID_BLOCK_SPECIAL_CELLS - - -SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) - -INTEGER, INTENT(IN) :: NM - -IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) -MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 - -END SUBROUTINE CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK - -END SUBROUTINE SET_CUTCELLS_3D - SUBROUTINE ALLOCATE_BODINT_PLANE(BODINT_PLANE,FIRST_CALL_ARG) TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE From b546bedb1a57a602c77fd462f7daa4c782da3c25 Mon Sep 17 00:00:00 2001 From: Marcos Vanella Date: Mon, 13 Apr 2026 09:16:04 -0400 Subject: [PATCH 08/18] FDS Source: Fix argument type. --- Source/geom.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Source/geom.f90 b/Source/geom.f90 index e4c868f7aef..24839d36484 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -25455,7 +25455,7 @@ SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH_WORK(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM USE TRAN, ONLY : TRANS INTEGER, INTENT(IN) :: NM, ISTR, IEND, JSTR, JEND, KSTR, KEND -REAL(EB), INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI INTEGER :: I,J,K,KK From da63a749f8406939514fc7ddebbfbfb372aac67f Mon Sep 17 00:00:00 2001 From: Marcos Vanella Date: Thu, 16 Apr 2026 16:41:04 -0400 Subject: [PATCH 09/18] FDS Source : Move contained routines out of SET_CUTCELLS_3D, add GCELL type. --- Source/geom.f90 | 8299 ++++++++++++++++++++++++----------------------- Source/mesh.f90 | 4 + Source/type.f90 | 15 + 3 files changed, 4217 insertions(+), 4101 deletions(-) diff --git a/Source/geom.f90 b/Source/geom.f90 index 24839d36484..4765df57908 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -38,6 +38,9 @@ MODULE COMPLEX_GEOMETRY INTEGER, PARAMETER :: CC_INBOUNDARY= 2 INTEGER, PARAMETER :: CC_UNDEFINED =-11 +INTEGER, PARAMETER :: CC_GCELL_CUT = 1 ! GCELL from a cut-cell piece. +INTEGER, PARAMETER :: CC_GCELL_REG = 2 ! GCELL from a regular adjacent cell. + ! Intersection type definition parameters: INTEGER, PARAMETER :: CC_GG = 1 ! Gas - Gas intersection. INTEGER, PARAMETER :: CC_SS = 3 ! Solid - Solid intersection. @@ -176,7 +179,8 @@ MODULE COMPLEX_GEOMETRY VAL_TESTY_LOW,VAL_TESTY_HIGH,VAL_TESTZ_LOW,VAL_TESTZ_HIGH,T_CC_USED, & WRITE_SET_CUTCELLS_TIMINGS,MAKE_UNIQUE_VERT_ARRAY,AVERAGE_FACE_VALUES,CC_INBOUNDCC,CC_INBOUNDCF, & CC_NVVARS,CC_NEVARS,CC_NFVARS,CC_ETYPE_CFINB, & - CC_VTYPE_VGAS,CC_VTYPE_VINB,CC_VTYPE_NINB,NODS_WSEL,EDGS_WSEL,NODS_VLEL + CC_VTYPE_VGAS,CC_VTYPE_VINB,CC_VTYPE_NINB,NODS_WSEL,EDGS_WSEL,NODS_VLEL, & + CC_GCELL_CUT,CC_GCELL_REG CONTAINS @@ -5236,7 +5240,7 @@ MODULE COMPLEX_GEOMETRY_GRID CC_CUTEDGE_TYPE, CC_EDGECROSS_TYPE, CC_INBCF_AREA_TYPE, WALL_TYPE, EXTERNAL_WALL_TYPE, TBAXIS_TYPE USE COMPLEX_GEOMETRY, ONLY: GEOMEPS,LOOSEPS,NGUARD,CCGUARD,CC_INBOUNDCC,CC_INBOUNDCF,CC_GASPHASE, & - CC_CUTCFE,CC_SOLID,CC_INBOUNDARY,CC_UNDEFINED,CC_GG,CC_SS,CC_GS,CC_SG,CC_VGSC,CC_NVVARS, & + CC_CUTCFE,CC_SOLID,CC_INBOUNDARY,CC_UNDEFINED,CC_GCELL_CUT,CC_GCELL_REG,CC_GG,CC_SS,CC_GS,CC_SG,CC_VGSC,CC_NVVARS, & CC_EGSC,CC_IDCE,CC_ECRS,CC_NEVARS,CC_FGSC,CC_IDCF,CC_IDRC,CC_UNKF,CC_NFVARS,CC_CGSC, & CC_IDCC,CC_UNKZ,CC_UNKH,CC_NCVARS,CC_VTYPE_VGAS,CC_VTYPE_VINB,CC_VTYPE_NINB,CC_ETYPE_RGGAS, & CC_ETYPE_CFGAS,CC_ETYPE_CFINB,CC_FTYPE_RGGAS,CC_FTYPE_CFGAS,CC_FTYPE_CFINB,CC_FTYPE_SVERT, & @@ -8200,10 +8204,12 @@ SUBROUTINE SET_CVS_3D TNOW,CPUTIME_START_MESH,GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW, & FIRST_CALL_ARG,FIRST_CALL_ARG2) IF (STOP_STATUS==SETUP_STOP) RETURN + +! Phase 2: build mesh-owned GCELL map from raw cut-cell data. +CALL CC_GRID_BUILD_GCELLS ! -! Future Phase 2: +! Future: ! BLOCK ONLY INVALID/SPECIAL CELLS -! BUILD GCELLS ! BUILD FACE TOPOLOGY ! BUILD IDENTITY CVS ! APPLY SAME-MESH AND INTER-MESH CV LINKING @@ -8214,97 +8220,48 @@ END SUBROUTINE SET_CVS_3D SUBROUTINE SET_CUTCELLS_3D USE MPI_F08 -INTEGER :: I,J,K,KK -INTEGER :: X1AXIS INTEGER :: ISTR, IEND, JSTR, JEND, KSTR, KEND -INTEGER :: NM, NOM +INTEGER :: NM ! Miscellaneous: -INTEGER :: NCUTFACE_IAXIS, NCUTFACE_JAXIS, NCUTFACE_KAXIS, ICE1, ICF1, NFACE, IERR, & - NCUTEDGE_IBCC, NCUTEDGE_IBCF -REAL(EB):: CF_AREA_IAXIS=0._EB, CF_AREA_JAXIS=0._EB, CF_AREA_KAXIS=0._EB, & - CF_INXAREA_IAXIS=0._EB,CF_INXAREA_JAXIS=0._EB,CF_INXAREA_KAXIS=0._EB, & - CF_INXSQAREA_IAXIS=0._EB,CF_INXSQAREA_JAXIS=0._EB,CF_INXSQAREA_KAXIS=0._EB, & - CF_JNYSQAREA_IAXIS=0._EB,CF_JNYSQAREA_JAXIS=0._EB,CF_JNYSQAREA_KAXIS=0._EB, & - CF_KNZSQAREA_IAXIS=0._EB,CF_KNZSQAREA_JAXIS=0._EB,CF_KNZSQAREA_KAXIS=0._EB -REAL(EB):: SLEN_GEOM, AREA_GEOM, VOLUME_GEOM, SLEN_IBCC, SLEN, DV(MAX_DIM), XYZCEN_GEOM(MAX_DIM), & - DM_XYZCEN(MAX_DIM), CCGP_XYZCEN(MAX_DIM), DM_XYZCEN_AUX(MAX_DIM), CCGP_XYZCEN_AUX(MAX_DIM) -INTEGER :: SEG(NOD1:NOD2), NEDGE, IEDGE, IFACE, IG - -INTEGER :: NCUTFACE_INB, ICC1, ICC2, NCELL, ICF2, JCF2, JCF, FTYPE, ILH, CELL_BLOCK_IOR -REAL(EB):: CF_AREA_INB=0._EB, CF_INXAREA_INB=0._EB, CF_INXSQAREA_INB=0._EB, & - CF_JNYSQAREA_INB=0._EB, CF_KNZSQAREA_INB=0._EB, CF_AREA_INB_AUX=0._EB, ACRT -REAL(EB):: CC_VOLUME_INB=0._EB, DM_VOLUME=0._EB, GP_VOLUME=0._EB, & - CC_VOLUME_INB_AUX=0._EB, DM_VOLUME_AUX=0._EB, GP_VOLUME_AUX=0._EB -INTEGER, DIMENSION(5) :: MIN_CC_IJK_ICCJCC, MAX_CC_IJK_ICCJCC -REAL(EB):: MIN_CC_VOL, MAX_CC_VOL, MIN_ALPHA_CV, MAX_ALPHA_CV LOGICAL, ALLOCATABLE, DIMENSION(:) :: CC_COMPUTE_MESH REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_ZMAX_AUX -INTEGER :: IW,II,JJ,IIF,JJF,KKF,IIOF,JJOF,KKOF,LOHIF,IOR,CT,NCFACE_CUTCELL,NFACE_CELL,AX,SIDE,ICC,JCC,ICFC,IFC -TYPE(MESH_TYPE), POINTER :: M, M2 -TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC -TYPE(WALL_TYPE), POINTER :: WC -TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC -TYPE(BOUNDARY_PROP1_TYPE), POINTER :: B1 -TYPE(CC_CUTCELL_TYPE), POINTER :: CC -TYPE(CC_CUTFACE_TYPE), POINTER :: CF -TYPE(CC_CUTEDGE_TYPE), POINTER :: CE -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME -INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) -INTEGER :: IIO,JJO,KKO,IOGC,JOGC,KOGC - REAL(EB) :: TNOW -LOGICAL :: WRITE_CFACE_STATS = .FALSE. LOGICAL :: EARLY_RETURN_FROM_SET_CUTCELLS INTEGER, SAVE :: CALL_COUNT = 0 ! GET_CUTCELL_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START, CPUTIME_MESH, CPUTIME_START_MESH -INTEGER :: MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL, SUM_FACE, SUM_CCELL=0 -TYPE(CFACE_TYPE), POINTER :: CFA -REAL(EB), ALLOCATABLE, DIMENSION(:) :: GEOM_AREA_SURF +REAL(EB) :: CPUTIME_START_MESH REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW -INTEGER, ALLOCATABLE, DIMENSION(:) :: GEOM_SURF -INTEGER :: ICF, SURF_INDEX, SUM_CC, IDIM LOGICAL, SAVE :: FIRST_CALL_ARG=.TRUE., FIRST_CALL_ARG2=.TRUE. - -REAL(EB):: CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) -INTEGER :: N_SPCELLCF_TOT,N_SPCELL_TOT -CHARACTER(100) :: FILENAME - CALL CC_GRID_BUILD_RAW_CUTCELLS(ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH,GEOM_ZMAX_AUX, & TNOW,CPUTIME_START_MESH,GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW, & FIRST_CALL_ARG,FIRST_CALL_ARG2) IF (STOP_STATUS==SETUP_STOP) RETURN POSTBUILD_MESH_LOOP : DO NM=1,NMESHES - CALL CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) + CALL CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM,CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_AREA_SURF_OLD) IF (STOP_STATUS==SETUP_STOP) RETURN ENDDO POSTBUILD_MESH_LOOP -CALL CC_GRID_EXCHANGE_AND_REBLOCK +CALL CC_GRID_EXCHANGE_AND_REBLOCK(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) MAIN_MESH_LOOP_3 : DO NM=1,NMESHES - CALL CC_GRID_POSTPROCESS_AND_CLEANUP(NM) + CALL CC_GRID_POSTPROCESS_AND_CLEANUP(NM,CC_COMPUTE_MESH,GEOM_AREA_SURF_NEW) ENDDO MAIN_MESH_LOOP_3 ! Finally allocate Face and cell variables, compute area and volume factors: MAIN_MESH_LOOP_4 : DO NM=1,NMESHES - CALL CC_GRID_ALLOCATE_STATE_VARS(NM) + CALL CC_GRID_ALLOCATE_STATE_VARS(NM,CC_COMPUTE_MESH) ENDDO MAIN_MESH_LOOP_4 -CALL CC_GRID_LOG_PROCESSING_TIME +CALL CC_GRID_LOG_PROCESSING_TIME(TNOW,CPUTIME_START_MESH) -CALL CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST +CALL CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST(GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) ! Fill Guardcells for CCVAR CC_CGSC and CUT_CELL for meshes assigned to MPI process: CALL SET_GC_CUTCELLS_3D @@ -8312,3889 +8269,3764 @@ SUBROUTINE SET_CUTCELLS_3D ! Allocate and define entries for solid side CFACES: IF(PERIODIC_TEST/=105) CALL GET_EXT_INB_CUTFACES_TO_CFACE -CALL CC_GRID_FINALIZE_BOOKKEEPING(EARLY_RETURN_FROM_SET_CUTCELLS) +CALL CC_GRID_FINALIZE_BOOKKEEPING(CC_COMPUTE_MESH,CALL_COUNT,EARLY_RETURN_FROM_SET_CUTCELLS) IF (EARLY_RETURN_FROM_SET_CUTCELLS) RETURN CALL CC_GRID_WRITE_VERBOSE_SUMMARY RETURN -CONTAINS +END SUBROUTINE SET_CUTCELLS_3D -SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM) +! ------------------------------ ADD_CUTEDGE_TO_FACE -------------------------------- -INTEGER, INTENT(IN) :: NM +SUBROUTINE ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IEC2,JEC2,IFC,JFC,KFC,X1AXFC) -IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. -IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 +INTEGER, INTENT(IN) :: NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IFC,JFC,KFC,X1AXFC +INTEGER, INTENT(OUT):: IEC2,JEC2 -CALL POINT_TO_MESH(NM) -M => MESHES(NM) -CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) +! Local variables: +INTEGER :: INOD1,INOD2,VL1(1:4),VL2(1:4),NVERT,NEDGE,IEDGE +INTEGER, ALLOCATABLE :: EDGE_LIST_AUX(:,:) +REAL(EB):: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) +TYPE(MESH_TYPE), POINTER :: M -CALL CC_GRID_BLOCK_SPECIAL_CELLS(NM) -CALL CC_GRID_RELEASE_SPECIAL_CELLS_TO_BLOCK(NM) +IEDGE=JCF2 ! Dummy for now FACE_LIST not filled for ETYPE_CFINB edges. + +M =>MESHES(NM) +IEC2=M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) +IF(IEC2<1) THEN ! Allocate space for CFINB cut-edge on this cut-face. + + ! Allocate space for cut-edge in CUT_EDGE: + IEC2 = M%N_CUTEDGE_MESH + 1 + M%N_CUTEDGE_MESH = IEC2 + M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = IEC2 + CALL CUT_EDGE_ARRAY_REALLOC(NM,IEC2) + M%CUT_EDGE(IEC2)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,IEC2,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + M%CUT_EDGE(IEC2)%NEDGE = 0 + M%CUT_EDGE(IEC2)%NEDGE1 = 0 + M%CUT_EDGE(IEC2)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. + M%CUT_EDGE(IEC2)%STATUS = CC_INBOUNDCF + ALLOCATE(M%CUT_EDGE(IEC2)%DXX(1:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%DXX = 0._EB + ALLOCATE(M%CUT_EDGE(IEC2)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%FACE_LIST = CC_UNDEFINED -IF (ONE_CC_PER_CARTESIAN_CELL) THEN - ! Here Block all cells that have volume less (or equal) than the first largest cell found. - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%CUT_CELL(ICC1) - NCELL=0 - DO J=1,CC%NCELL - IF(CC%NOADVANCE(J)==NOT_BLOCKED) NCELL=NCELL+1 - ENDDO - IF(NCELL<2) CYCLE - ! Find if any GEOMETRY related to CC_INBOUNDARY faces has CELL_BLOCK_IOR>0: - CELL_BLOCK_IOR=0; CELL_BLOCK_ORIENTATION = 0._EB - NCELL_LOOP_1 : DO J=1,CC%NCELL - DO I=2,CC%CCELEM(1,J)+1 - IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN - ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) - IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) - IF(IG>0) THEN - IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN - CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION - ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN - CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR - EXIT NCELL_LOOP_1 - ENDIF - ENDIF - ENDIF - ENDDO - ENDDO NCELL_LOOP_1 - ALLOCATE(VOLUME(1:CC%NCELL)); VOLUME(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN - ! Cell Block Orientation: - DO J=1,CC%NCELL; VOLUME(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)); ENDDO - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN - ! Make search for double precision min/max unambiguous. - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS,IAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) - CASE(-JAXIS,JAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) - CASE(-KAXIS,KAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) - END SELECT - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( IAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-JAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( JAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-KAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( KAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - END SELECT - ENDIF - DEALLOCATE(VOLUME) - NCELL_LOOP_2 : DO J=1,CC%NCELL - IF(J==I) CYCLE NCELL_LOOP_2 - IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL - ENDDO NCELL_LOOP_2 - ENDDO ENDIF -CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) +! Edge nodes location and type: +INOD1 = M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE) +INOD2 = M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE) +XV1(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD1) +XV2(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD2) +VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD1) ! [CC_VTYPE I J K] +VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD2) -! Here: 1,2. Define Linking information for cut-cells. -CALL GET_CELL_LINK_INFO(NM) +! Add cut-edge: +NVERT = M%CUT_EDGE(IEC2)%NVERT +CALL REALLOCATE_EDGE_VERT(NM,IEC2,NVERT+2) +CALL INSERT_FACE_VERT(XV1,NM,IEC2,NVERT,INOD1) +CALL INSERT_FACE_VERT(XV2,NM,IEC2,NVERT,INOD2) -IF(PROCESS(NM)==MY_RANK) THEN ! Here Add Blocked Areas per SURF_ID: - ALLOCATE(MESHES(NM)%INBCF_AREA(0:MESHES(NM)%IBP1,0:MESHES(NM)%JBP1,0:MESHES(NM)%KBP1)) - DO K=1,M%KBAR - DO J=1,M%JBAR - DO I=1,M%IBAR - ICC = MESHES(NM)%CCVAR(I,J,K,CC_IDCC); IF(ICC<1) CYCLE - CC =>MESHES(NM)%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)<1) CYCLE - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE=CC%CCELEM(IFC,JCC) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE - ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO +DO NEDGE=1,M%CUT_EDGE(IEC2)%NEDGE + IF( (INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) .OR. & + (INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) ) THEN + JEC2=NEDGE; RETURN ! Edge already in Face cut-edges list. + ENDIF +ENDDO +JEC2=NEDGE +CALL REALLOCATE_EDGE_ELEM(NM,IEC2,NEDGE) + +! Check first node type, if gas vertex make it boundary vertex and change VERTVAR to CC_SOLID: +M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = VL1(1:4) +IF(VL1(1)==CC_VTYPE_VGAS) THEN + M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,VL1(2),VL1(3),VL1(4)/) + M%VERTVAR(VL1(2),VL1(3),VL1(4),CC_VGSC) = CC_SOLID +ENDIF +M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = VL2(1:4) +IF(VL2(1)==CC_VTYPE_VGAS) THEN + M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,VL2(2),VL2(3),VL2(4)/) + M%VERTVAR(VL2(2),VL2(3),VL2(4),CC_VGSC) = CC_SOLID ENDIF -CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) -END SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH +! Add edge: Assumes XV1 < XV2 in X1AXEG direction: +M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) +IF(ILHF==-1) M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) -! ----------------------- BLOCK_SMALL_UNLINKED_CUTCELLS ---------------------------- +M%CUT_EDGE(IEC2)%NVERT = NVERT +M%CUT_EDGE(IEC2)%NEDGE = NEDGE -SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS(NM,NBLKCELLS) +M%CUT_EDGE(IEC2)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(OUT):: NBLKCELLS +! Define Edge as INB CUT_EDGE, find corresponding CFGAS EDGE associated cut-face and replace it +IF(ICF2>0) THEN + ! Reallocate EDGE_LIST if JCE2 exceeds current size + NVERT = 0 + IF(ALLOCATED(M%CUT_FACE(ICF2)%EDGE_LIST)) NVERT = SIZE(M%CUT_FACE(ICF2)%EDGE_LIST,DIM=2)-1 + IF(JCE2 > NVERT) THEN + ALLOCATE(EDGE_LIST_AUX(3,0:JCE2)) + EDGE_LIST_AUX = CC_UNDEFINED + IF(NVERT > 0) EDGE_LIST_AUX(1:3,0:NVERT) = M%CUT_FACE(ICF2)%EDGE_LIST(1:3,0:NVERT) + CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX, TO=M%CUT_FACE(ICF2)%EDGE_LIST) + ENDIF + M%CUT_FACE(ICF2)%EDGE_LIST(1:3,JCE2) = (/CC_ETYPE_CFINB, IEC2, JEC2/) +ENDIF -INTEGER :: ICC,JCC,I,J,K,IFC,IEC,JEC,IVR,DUM,NSEG,ISEG,JFC,INOD1,INOD2,X1AXIS,COUNT,NCELL -TYPE(MESH_TYPE), POINTER :: M -CHARACTER(100) :: FILENAME +END SUBROUTINE ADD_CUTEDGE_TO_FACE -M => MESHES(NM) -NBLKCELLS = 0 -IF(DEBUG_SET_CUTCELLS) THEN +! ------------------------------ ADD_CUTEDGE_TO_EDGE ------------------------------- - ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges1.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH - DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH - CE=>MESHES(NM)%CUT_EDGE(IEC) - WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) - DO IVR=1,CE%NVERT - WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO IVR=1,CE%NVERT - WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& - CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) - ENDDO - ENDDO - CLOSE(33) +SUBROUTINE ADD_CUTEDGE_TO_EDGE(NM,ILHF,IEG,JEG,KEG,X1AXEG,XV1,XV2) - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces1.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH - DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 - IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 - WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) - DO IVR=1,CF%NVERT - WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(I6,I6)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) - DO DUM=1,CF%CFELEM(1,JFC) - WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) - ENDDO - DO DUM=1,CF%CEDGES(1,JFC) - WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) - ENDDO - ENDDO - DO ISEG=1,NSEG - WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) - ENDDO - ENDDO - CLOSE(33) -ENDIF +INTEGER, INTENT(IN) :: NM,ILHF,IEG,JEG,KEG,X1AXEG +REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) -! Create new cut-edges and faces: -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - JCC_LOOP : DO JCC=1,M%CUT_CELL(ICC)%NCELL - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP - NBLKCELLS = NBLKCELLS + 1 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,1) - ENDDO JCC_LOOP - ENDDO - ENDDO -ENDDO +! Local Variables: +INTEGER :: NVERT,INOD1,INOD2,ICF,CEI,NEDGE,NOD1_TYPE,NOD2_TYPE,LOHI,AXIS +TYPE(MESH_TYPE), POINTER :: M -! Drop cut-edges and faces that were gas or boundary of blocked cells. -COUNT=0 -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - NCELL = M%CUT_CELL(ICC)%NCELL - JCC_LOOP_2 : DO JCC=1,NCELL - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_2 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,2) - ENDDO JCC_LOOP_2 - ENDDO - ENDDO -ENDDO +M=>MESHES(NM) +IF(M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG)==CC_SOLID) RETURN -! Drop blocked cells: -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF(ICC<1) CYCLE ! No Cut-cell. - NCELL = M%CUT_CELL(ICC)%NCELL - JCC_LOOP_3 : DO JCC=NCELL,1,-1 - IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_3 - CALL BLOCK_CUT_CELL(NM,ICC,JCC,3) - ENDDO JCC_LOOP_3 - ENDDO - ENDDO -ENDDO -! Build remaining Regular shaped GASPHASE cut-faces: -CALL GET_REMAINING_CUTFACES(NM) -! Build remaining Regular shaped GASPHASE cut-cells: -CALL GET_REMAINING_CUTCELLS(NM) -! Clean up CUT_CELL, CUT_FACE arrays: -CALL CUT_CELL_FACE_ARRAYS_CLEANUP(NM) +! Define Gas Cut-edge: +CEI = M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) +IF(CEI<1) THEN + ! Allocate space for cut-edge in CUT_EDGE: + CEI = M%N_CUTEDGE_MESH + 1 + M%N_CUTEDGE_MESH = CEI + M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG) = CC_CUTCFE + M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + M%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + M%CUT_EDGE(CEI)%NEDGE = 0 + M%CUT_EDGE(CEI)%NEDGE1 = 0 + M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+1) = (/ IEG,JEG,KEG,X1AXEG /) ! Gas right to solid left. + M%CUT_EDGE(CEI)%STATUS = CC_GASPHASE + ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB + ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED -IF(DEBUG_SET_CUTCELLS) THEN - ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges2.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH - DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH - CE=>MESHES(NM)%CUT_EDGE(IEC) - WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) - DO IVR=1,CE%NVERT - WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO IVR=1,CE%NVERT - WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) - ENDDO - DO JEC=1,CE%NEDGE - WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC),& - CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) - ENDDO - ENDDO - CLOSE(33) +ELSE ! CUT_EDGE + IF(ILHF==-1) THEN + INOD2 = M%CUT_EDGE(CEI)%CEELEM(NOD2,M%CUT_EDGE(CEI)%NEDGE) ! High node of last gas segment. + M%CUT_EDGE(CEI)%VERT_LIST(1,INOD2) = CC_VTYPE_VINB + ELSE + INOD1 = M%CUT_EDGE(CEI)%CEELEM(NOD1,1) ! Low node of first gas segment. + M%CUT_EDGE(CEI)%VERT_LIST(1,INOD1) = CC_VTYPE_VINB + ENDIF + RETURN +ENDIF - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces2.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH - DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 - IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 - WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) - DO IVR=1,CF%NVERT - WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(I8,I8)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) - DO DUM=1,CF%CFELEM(1,JFC) - WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) - ENDDO - DO DUM=1,CF%CEDGES(1,JFC) - WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) - ENDDO - ENDDO - DO ISEG=1,NSEG - WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) - ENDDO - DO JFC=1,CF%NFACE - WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) - ENDDO - ENDDO - CLOSE(33) +! Add new cut-edge created from regular edge: +NVERT = M%CUT_EDGE(CEI)%NVERT +CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) +CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) +CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeECVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%ECVAR(I,J,K,CC_EGSC,IAXIS),& - M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) - DO X1AXIS=IAXIS,KAXIS - IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN - IEC=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) - IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT EDGE does not match ECVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE - DO JEC=1,CE%NEDGE - INOD1=CE%CEELEM(NOD1,JEC) - INOD2=CE%CEELEM(NOD2,JEC) - WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) - WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) - IF(CE%VERT_LIST(1,INOD1)==CE%VERT_LIST(1,INOD2) .AND. & - CE%VERT_LIST(2,INOD1)==CE%VERT_LIST(2,INOD2) .AND. & - CE%VERT_LIST(3,INOD1)==CE%VERT_LIST(3,INOD2) .AND. & - CE%VERT_LIST(4,INOD1)==CE%VERT_LIST(4,INOD2)) THEN - IF(CE%VERT_LIST(1,INOD1)/=CC_VTYPE_NINB) & - WRITE(LU_ERR,*) 'Edge with same node types=',IEC,JEC,CE%NEDGE,CE%XYZVERT(:,INOD1),& - CE%XYZVERT(:,INOD2),CE%VERT_LIST(1:4,INOD1) - ENDIF - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) +NEDGE = M%CUT_EDGE(CEI)%NEDGE+1 +CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - DO X1AXIS=IAXIS,KAXIS - IF(M%FCVAR(I,J,K,CC_IDCE,X1AXIS)>0)THEN - IEC=M%FCVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) - IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT EDGE does not match FCVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE - DO JEC=1,CE%NEDGE - INOD1=CE%CEELEM(NOD1,JEC) - INOD2=CE%CEELEM(NOD2,JEC) - WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) - WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) +! Define Vert List for newly defined cut-edge: +IF (ILHF==-1) THEN + NOD1_TYPE = CC_VTYPE_VGAS + NOD2_TYPE = CC_VTYPE_VINB +ELSE + NOD1_TYPE = CC_VTYPE_VINB + NOD2_TYPE = CC_VTYPE_VGAS +ENDIF +SELECT CASE(X1AXEG) +CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG-1,JEG ,KEG /) +CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG-1,KEG /) +CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG ,KEG-1/) +END SELECT +M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/NOD2_TYPE,IEG ,JEG ,KEG /) +! Add edge: Assumes XV1 < XV2 in X1AXEG direction: +M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaceFCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%FCVAR(I,J,K,CC_FGSC,IAXIS),& - M%FCVAR(I,J,K,CC_FGSC,JAXIS),M%FCVAR(I,J,K,CC_FGSC,KAXIS) - DO X1AXIS=IAXIS,KAXIS - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)==CC_CUTCFE)THEN - IEC=M%FCVAR(I,J,K,CC_IDCF,X1AXIS); CF=>M%CUT_FACE(IEC) - IF(CF%IJK(IAXIS)/=I .OR. CF%IJK(JAXIS)/=J .OR. CF%IJK(KAXIS)/=K .OR. CF%IJK(KAXIS+1)/=X1AXIS) & - WRITE(LU_ERR,*) 'CUT FACE does not match FCVAR',I,J,K,X1AXIS,':',CF%IJK(IAXIS:KAXIS+1) - WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE - DO JEC=1,CF%NFACE - WRITE(33,'(I8,3F16.8,F16.8)') CF%IJK(4),CF%XYZCEN(:,JEC),CF%AREA(JEC) - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - CLOSE(33) +M%CUT_EDGE(CEI)%NVERT = NVERT +M%CUT_EDGE(CEI)%NEDGE = NEDGE - WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutcellCCVAR.dat' - OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') - WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 - DO K=0,M%KBAR+1 - DO J=0,M%JBAR+1 - DO I=0,M%IBAR+1 - WRITE(33,'(I8,I8,I8,I8)') I,J,K,M%CCVAR(I,J,K,CC_CGSC) - IF(M%CCVAR(I,J,K,CC_CGSC)==CC_CUTCFE)THEN - IEC=M%CCVAR(I,J,K,CC_IDCC); CC=>M%CUT_CELL(IEC) - IF(CC%IJK(IAXIS)/=I .OR. CC%IJK(JAXIS)/=J .OR. CC%IJK(KAXIS)/=K) & - WRITE(LU_ERR,*) 'CUT CELL does not match CCVAR',I,J,K,':',CC%IJK(IAXIS:KAXIS) - WRITE(33,'(I8,I8,I8,I8,I8)') CC%IJK(1:3),CC%NCELL - DO JEC=1,CC%NCELL - WRITE(33,'(I8,3F16.8,F16.8)') JEC,CC%XYZCEN(:,JEC),CC%VOLUME(JEC) - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - CLOSE(33) -ENDIF +! There might be cut-faces that note this EDGE as a regular Gas edge, change incidence in their EDGE_LIST: +SELECT CASE(X1AXEG) +CASE(IAXIS) + ! Face at LOC=-2, located at low Z normal to Y axis: + ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC=-1, located at low Y normal to Z axis: + ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 1, located at high Y normal to Z axis: + ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 2, located at high Z normal to Y axis: + ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) +CASE(JAXIS) + ! Face at LOC=-2, located at low X normal to Z axis: + ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC=-1, located at low Z normal to X axis: + ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 1, located at high Z normal to X axis: + ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=KAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 2, located at high X normal to Z axis: + ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) +CASE(KAXIS) + ! Face at LOC=-2, located at low Y normal to X axis: + ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC=-1, located at low X normal to Y axis: + ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! IF(IEG==7 .AND. JEG==4 .AND. KEG==4) THEN + ! WRITE(LU_ERR,*) 'Found EDGE IN CUTEDGE To EDGE IF,JF,KF,AXIS,ICF=',IEG,JEG,KEG,JAXIS,ICF,CEI + ! DO INOD1=1,SIZE(M%CUT_FACE(ICF)%EDGE_LIST,DIM=2)-1 + ! WRITE(LU_ERR,*) M%CUT_FACE(ICF)%EDGE_LIST(:,INOD1) + ! ENDDO + ! ENDIF + ! Face at LOC= 1, located at high X normal to Y axis: + ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=IAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) + ! Face at LOC= 2, located at high Y normal to X axis: + ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=JAXIS + CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) +END SELECT -RETURN -END SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS +END SUBROUTINE ADD_CUTEDGE_TO_EDGE -! ------------------------- GET_REMAINING_CUTCELLS -------------------------------- +! --------------------------- REPL_CUTEDGE_IN_LIST_EDGES --------------------------- -SUBROUTINE GET_REMAINING_CUTCELLS(NM) +SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,IEC,JEC,LOHI,AXIS) -! Define regular cut-cells for regular cartesian cells surrounded by a gas cut-face. -INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: NM,ICF,IEC,JEC,LOHI,AXIS +INTEGER :: IEDGE,DUM + +IF(ICF>0) THEN + DUM=0; IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST)) DUM=SIZE(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST,DIM=2) + DO IEDGE=1,DUM-1 + IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE + IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE + IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(3,IEDGE)/=AXIS) CYCLE + MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFGAS,IEC,JEC/) + RETURN + ENDDO +ENDIF +END SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES + +! ------------------------------ ADD_REGEDGE_TO_FACE ------------------------------- + +SUBROUTINE ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD,XV1,XV2,CEI,NEDGE,IV_LIST) + + +! ILHF -1 face in low side of edge, 0 face on high side of edge. + +INTEGER, INTENT(IN) :: NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD +REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) +INTEGER, INTENT(OUT):: CEI,NEDGE +LOGICAL, INTENT(IN) :: IV_LIST ! Local Variables: -INTEGER :: I,J,K,CT,X1AXIS,SIDE,ICC,JCC,IFACE,ICF,JCF,ICFC,ICFINB,NCFACE_CUTCELL,NCELL,NFACE_CELL -INTEGER :: NCC_MESH,NGC_MESH,NCELL_IN,NCELL_GC,COUNT_CC,COUNT_GC -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME -INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) +INTEGER :: NVERT,INOD1,INOD2,ICF,IEDGE,LOHI TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX -LOGICAL, PARAMETER :: OPT=.TRUE. +TYPE(CC_CUTFACE_TYPE), POINTER :: CF -M => MESHES(NM) +M=>MESHES(NM) +IF(M%FCVAR(IFC,JFC,KFC,CC_FGSC,X1AXFC)==CC_SOLID) RETURN -! First thing is, for known cut-cells with reg faces that have changed to cut-faces to change the -! FACE_LIST incidence: -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_CUTCFE) CYCLE - ICC=M%CCVAR(I,J,K,CC_IDCC) - CC=>M%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - DO ICF=2,CC%CCELEM(1,JCC)+1 - IFACE = CC%CCELEM(ICF,JCC) - SIDE = CC%FACE_LIST(2,IFACE) - X1AXIS= CC%FACE_LIST(3,IFACE) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE - ICFC = M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS) - IF(ICFC>0) CC%FACE_LIST(:,IFACE) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) ! New cut-face. - ENDDO - ENDDO - ENDDO - ENDDO +! Define Edge as INB cut-edge, add to CUT_EDGE: +CEI = M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) +IF (CEI < 1) THEN + ! Allocate space for cut-edge in CUT_EDGE: + CEI = M%N_CUTEDGE_MESH + 1 + M%N_CUTEDGE_MESH = CEI + M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = CEI + CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) + M%CUT_EDGE(CEI)%NVERT = 0 + CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) + M%CUT_EDGE(CEI)%NEDGE = 0 + M%CUT_EDGE(CEI)%NEDGE1 = 0 + M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. + M%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF + ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB + ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED +ENDIF + +! Add cut-edge: +NVERT = M%CUT_EDGE(CEI)%NVERT +CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) +CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) +CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) + +DO NEDGE=1,M%CUT_EDGE(CEI)%NEDGE + IF( (INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) .OR. & + (INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) ) THEN + RETURN ! Edge already in Face cut-edges list. + ENDIF ENDDO +CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) -IF (OPT) THEN +SELECT CASE(X1AXEG) +CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG-1,JEG ,KEG /) +CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG-1,KEG /) +CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG ,KEG-1/) +END SELECT +M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,IEG ,JEG ,KEG /) +IF(IV_LIST) THEN + ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: + M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) + IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) +ELSE + ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: + M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) + IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) +ENDIF -NCC_MESH = M%N_CUTCELL_MESH -NGC_MESH = M%N_GCCUTCELL_MESH +M%CUT_EDGE(CEI)%NVERT = NVERT +M%CUT_EDGE(CEI)%NEDGE = NEDGE -! First count how many new cells are goint to be created inside, and in ghost cell region: -NCELL_IN=0 -NCELL_GC=0 -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE - ! Test for gas cut-faces: - CT=0 - IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - IF(K<1 .OR. K>M%KBAR .OR. J<1 .OR. J>M%JBAR .OR. I<1 .OR. I>M%IBAR) THEN - NCELL_GC = NCELL_GC + 1 - ELSE - NCELL_IN = NCELL_IN + 1 - ENDIF - ENDDO - ENDDO -ENDDO +M%CUT_EDGE(CEI)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) -! Reset CCVAR, CELL_LIST indexes: -DO K=-CCGUARD,M%KBAR+CCGUARD - DO J=-CCGUARD,M%JBAR+CCGUARD - DO I=-CCGUARD,M%IBAR+CCGUARD - ! All GC cut-cells get their index + NCELL_IN - IF(M%CCVAR(I,J,K,CC_IDCC)<=NCC_MESH) CYCLE - M%CCVAR(I,J,K,CC_IDCC)=M%CCVAR(I,J,K,CC_IDCC) + NCELL_IN - ENDDO - ENDDO -ENDDO -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - DO JCF=1,M%CUT_FACE(ICF)%NFACE - IF(M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>NCC_MESH) & - M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + NCELL_IN - IF(M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>NCC_MESH) & - M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + NCELL_IN +ICF = M%FCVAR(IFC,JFC,KFC,CC_IDCF,X1AXFC) +IF (ICF>0) THEN ! There are cut-faces in this face + LOHI= LOW_IND; IF(ILHF==-1) LOHI=HIGH_IND + ! Define Edge as INB CUT_EDGE, find corresponding RGGAS EDGE associated cut-face and replace it + CF=>M%CUT_FACE(ICF); + INOD1=0; IF(ALLOCATED(CF%EDGE_LIST)) INOD1=SIZE(CF%EDGE_LIST,DIM=2) + DO IEDGE=1,INOD1-1 + IF(CF%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE + IF(CF%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE + IF(CF%EDGE_LIST(3,IEDGE)/=X1AXIS) CYCLE + CF%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFINB, CEI, NEDGE/) + RETURN ENDDO -ENDDO +ENDIF -! Make space for NCELL_IN, NCELL_GC cut-cell entries. -ALLOCATE(CUT_CELL_AUX( MAX(SIZE(M%CUT_CELL,DIM=1),NCC_MESH + NCELL_IN +NGC_MESH + NCELL_GC) )) -CUT_CELL_AUX(1:NCC_MESH) = M%CUT_CELL(1:NCC_MESH) -CUT_CELL_AUX(NCC_MESH+NCELL_IN+1:NCC_MESH+NCELL_IN+NGC_MESH) = M%CUT_CELL(NCC_MESH+1:NCC_MESH+NGC_MESH) -CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL); M=> MESHES(NM) +END SUBROUTINE ADD_REGEDGE_TO_FACE -! Then build new regular cut-cells: -COUNT_CC = 0 -COUNT_GC = 0 -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE - ! Test for gas cut-faces: - CT=0 - IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE +! --------------------------------- DROP_REG_FACE ------------------------------------------- - ! Count allocation number for faces boundary of this cut-cell: - CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT +SUBROUTINE DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED +INTEGER, INTENT(IN) :: NM,I,J,K,ILHF,X1AXIS - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO X1AXIS=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO +SELECT CASE(X1AXIS) +CASE(IAXIS) + ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: + MESHES(NM)%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID + MESHES(NM)%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: + MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_EGSC,JAXIS)= CC_SOLID ! X2 + MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_IDCE,JAXIS)= CC_UNDEFINED + MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_EGSC,KAXIS)= CC_SOLID ! X3 + MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_IDCE,KAXIS)= CC_UNDEFINED + ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: + MESHES(NM)%VERTVAR(I+ILHF, J-1:J, K-1:K,CC_VGSC) = CC_SOLID +CASE(JAXIS) + ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: + MESHES(NM)%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID + MESHES(NM)%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: + MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_EGSC,KAXIS)= CC_SOLID ! X2 + MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_IDCE,KAXIS)= CC_UNDEFINED + MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_EGSC,IAXIS)= CC_SOLID ! X3 + MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_IDCE,IAXIS)= CC_UNDEFINED + ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: + MESHES(NM)%VERTVAR( I-1:I,J+ILHF, K-1:K,CC_VGSC) = CC_SOLID +CASE(KAXIS) + ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: + MESHES(NM)%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID + MESHES(NM)%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED + ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: + MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_EGSC,IAXIS)= CC_SOLID ! X2 + MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_IDCE,IAXIS)= CC_UNDEFINED + MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_EGSC,JAXIS)= CC_SOLID ! X3 + MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_IDCE,JAXIS)= CC_UNDEFINED + ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: + MESHES(NM)%VERTVAR( I-1:I, J-1:J,K+ILHF,CC_VGSC) = CC_SOLID +END SELECT - ! Add INB cut-face if any present: - IF(ICFINB>0) THEN - DO JCF=1,M%CUT_FACE(ICFINB)%NFACE - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDDO - ENDIF +END SUBROUTINE DROP_REG_FACE - ! Insert cut_cell: - IF(K<1 .OR. K>MESHES(NM)%KBAR .OR. J<1 .OR. J>MESHES(NM)%JBAR .OR. I<1 .OR. I>MESHES(NM)%IBAR) THEN - COUNT_GC = COUNT_GC + 1 - ICC = NCC_MESH + NCELL_IN + NGC_MESH + COUNT_GC - ELSE - COUNT_CC = COUNT_CC + 1 - ICC = NCC_MESH + COUNT_CC - ENDIF - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - M%CUT_CELL(ICC)%NFACE_DROPPED = 0 - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) - M%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) - M%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE - M%CCVAR(I,J,K,CC_IDCC) = ICC - ENDDO - ENDDO -ENDDO -M%N_CUTCELL_MESH = NCC_MESH + NCELL_IN -M%N_GCCUTCELL_MESH = NGC_MESH + NCELL_GC +! --------------------------- INSERT_CUT_CELL ----------------------------------------------- -ELSE +SUBROUTINE INSERT_CUT_CELL(NM,I,J,K,ICC) -! Then build new regular cut-cells: -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE - ! Test for gas cut-faces: - CT=0 - IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE +! Adds a cut-cell entry ICF in the CUT_CELL array, assumes no cut-cell defined in cell I,J,K. +INTEGER, INTENT(IN) :: NM,I,J,K +INTEGER, INTENT(OUT):: ICC - ! Count allocation number for faces boundary of this cut-cell: - CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT +INTEGER :: DUM,KDUM,JDUM,IDUM,ICF,JCF - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED +TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO X1AXIS=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO +IF( 00) THEN - DO JCF=1,M%CUT_FACE(ICFINB)%NFACE - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDDO - ENDIF +! Reallocate CUT_CELL: +ALLOCATE(CUT_CELL_AUX( MAX(SIZE(MESHES(NM)%CUT_CELL,DIM=1),MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH) )) +DO DUM=1,ICC-1 + CALL CUT_CELL_MOVE(MESHES(NM)%CUT_CELL(DUM),CUT_CELL_AUX(DUM)) +ENDDO +DO DUM=ICC,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH-1 + CALL CUT_CELL_MOVE(MESHES(NM)%CUT_CELL(DUM),CUT_CELL_AUX(DUM+1)) +ENDDO +CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL) - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NM,I,J,K,ICC); M => MESHES(NM) - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) +! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): +DO KDUM=-CCGUARD,MESHES(NM)%KBAR+CCGUARD + DO JDUM=-CCGUARD,MESHES(NM)%JBAR+CCGUARD + DO IDUM=-CCGUARD,MESHES(NM)%IBAR+CCGUARD + IF(MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC)>=ICC) & + MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC) + 1 ENDDO ENDDO ENDDO +DO ICF=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + DO JCF=1,MESHES(NM)%CUT_FACE(ICF)%NFACE + IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>ICC) & + MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + 1 + IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>ICC) & + MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + 1 + ENDDO +ENDDO -ENDIF - -END SUBROUTINE GET_REMAINING_CUTCELLS - - -! ------------------------- GET_REMAINING_CUTFACES -------------------------------- - -SUBROUTINE GET_REMAINING_CUTFACES(NM) +MESHES(NM)%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) +MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE +MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = ICC -! Running by axes define regular cut-faces, add to CUT_FACE array. +RETURN +END SUBROUTINE INSERT_CUT_CELL -INTEGER, INTENT(IN) :: NM +! --------------------------- INSERT_CUT_FACE ----------------------------------------------- -! Local Variables: -INTEGER :: I,J,K,CT,X1AXIS,X2AXIS,X3AXIS,IFC,CEI,CEIF,ICC,JCC,ICE,IEDGE,ILOC,IFACE -INTEGER :: NBD_MESH,NCF_MESH,NGF_MESH,NFC_BND,NFC_MSH,NFC_GCR,CT_BND,CT_MSH,CT_GCR,FCINDEX -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES,EDGE_LIST -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZVERT,XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA -TYPE(MESH_TYPE), POINTER :: M -LOGICAL, PARAMETER :: OPT=.TRUE. +SUBROUTINE INSERT_CUT_FACE(NM,I,J,K,AXIS,ICF,INZONE) -M => MESHES(NM) +! This routine add a cut-face entry ICF in the CUT_FACE array: +! 1. IF AXIS = 0 INBOUNDARY face: +! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK is an interior cell. +! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK is a guard cell. +! 2. IF AXIS = 1,2,3 GASPHASE face: +! ICF = MESHES(NM)%N_BBCUTFACE_MESH+1 if II,JJ,KK,AXIS is a boundary face. +! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK,AXIS is an interior face. +! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK,AXIS is a guard face. +INTEGER, INTENT(IN) :: NM,I,J,K,AXIS +INTEGER, INTENT(OUT):: ICF +LOGICAL, OPTIONAL, INTENT(IN) :: INZONE -IF (OPT) THEN -NBD_MESH = M%N_BBCUTFACE_MESH -NCF_MESH = M%N_CUTFACE_MESH -NGF_MESH = M%N_GCCUTFACE_MESH +INTEGER :: ICC,JCC,IFC,IFACE,IFCX,DUM,IDUM,JDUM,KDUM,X1AXIS,ICE,ILOC,IEDGE +TYPE(CC_CUTFACE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_FACE_AUX +TYPE(CC_CUTEDGE_TYPE), POINTER :: CE -! First count EXT Boundary, In meshm and ghost cell region cut-faces: -NFC_BND = 0 -NFC_MSH = 0 -NFC_GCR = 0 -! IAXIS cut-faces: -X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS -DO K=-1,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-2,M%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%IBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External - ELSEIF(I==0 .OR. I==M%IBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary - ENDIF - ELSE; NFC_GCR = NFC_GCR + 1 ! External +IF(AXIS==0) THEN + IF( 0MESHES(NM)%IBAR) THEN ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ELSEIF(I==0 .OR. I==MESHES(NM)%IBAR) THEN ! Block boundary + MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 + MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 + ICF = MESHES(NM)%N_BBCUTFACE_MESH ENDIF - ENDDO - ENDDO -ENDDO -! JAXIS cut-faces: -X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS -DO K=-1,M%KBAR+2 - DO J=-2,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%JBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External - ELSEIF(J==0 .OR. J==M%JBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary - ENDIF - ELSE; NFC_GCR = NFC_GCR + 1 ! External + ELSE ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ENDIF + CASE(JAXIS) + IF(0MESHES(NM)%JBAR) THEN ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ELSEIF(J==0 .OR. J==MESHES(NM)%JBAR) THEN ! Block boundary + MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 + MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 + ICF = MESHES(NM)%N_BBCUTFACE_MESH ENDIF - ENDDO - ENDDO -ENDDO -! KAXIS cut-faces: -X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS -DO K=-2,M%KBAR+2 - DO J=-1,M%JBAR+2 - DO I=-1,M%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%KBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External - ELSEIF(K==0 .OR. K==M%KBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary - ENDIF - ELSE; NFC_GCR = NFC_GCR + 1 ! External + ELSE ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ENDIF + CASE(KAXIS) + IF(0MESHES(NM)%KBAR) THEN ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ELSEIF(K==0 .OR. K==MESHES(NM)%KBAR) THEN ! Block boundary + MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 + MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 + ICF = MESHES(NM)%N_BBCUTFACE_MESH ENDIF - ENDDO - ENDDO + ELSE ! External + MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 + ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH + ENDIF + END SELECT +ENDIF + +! Reallocate CUT_FACE: +ALLOCATE(CUT_FACE_AUX( MAX(SIZE(MESHES(NM)%CUT_FACE,DIM=1),MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH) )) +DO DUM=1,ICF-1 + CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM)) +ENDDO +DO DUM=ICF,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH-1 + CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM+1)) ENDDO +CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE) ! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): -DO K=-CCGUARD,M%KBAR+CCGUARD - DO J=-CCGUARD,M%JBAR+CCGUARD - DO I=-CCGUARD,M%IBAR+CCGUARD - FCINDEX = M%CCVAR(I,J,K,CC_IDCF) - IF(M%CCVAR(I,J,K,CC_IDCF)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(M%CCVAR(I,J,K,CC_IDCF)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - M%CCVAR(I,J,K,CC_IDCF) = FCINDEX +DO KDUM=-CCGUARD,MESHES(NM)%KBAR+CCGUARD + DO JDUM=-CCGUARD,MESHES(NM)%JBAR+CCGUARD + DO IDUM=-CCGUARD,MESHES(NM)%IBAR+CCGUARD + IF(MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)>=ICF) & + MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF) + 1 DO X1AXIS=IAXIS,KAXIS - FCINDEX = M%FCVAR(I,J,K,CC_IDCF,X1AXIS) - IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = FCINDEX + IF(MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS)>=ICF) & + MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) = MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) + 1 ENDDO ENDDO ENDDO ENDDO -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - SELECT CASE(CC%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_RCGAS); CYCLE - CASE DEFAULT - FCINDEX = CC%FACE_LIST(4,IFACE) - IF(CC%FACE_LIST(4,IFACE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(CC%FACE_LIST(4,IFACE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - CC%FACE_LIST(4,IFACE) = FCINDEX - END SELECT +DO ICC=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + DO JCC=1,MESHES(NM)%CUT_CELL(ICC)%NCELL + DO IFC=1,MESHES(NM)%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = MESHES(NM)%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + IF(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) CYCLE + IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) = IFCX+1 ENDDO ENDDO + DO IFACE=1,MESHES(NM)%CUT_CELL(ICC)%NFACE_DROPPED + IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) + IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) = IFCX+1 + ENDDO ENDDO -DO ICE=1,M%N_CUTEDGE_MESH - CE=>M%CUT_EDGE(ICE) +DO ICE=1,MESHES(NM)%N_CUTEDGE_MESH + CE=>MESHES(NM)%CUT_EDGE(ICE) DO IEDGE=1,CE%NEDGE DO ILOC=-2,2 - FCINDEX = CE%FACE_LIST(1,ILOC,IEDGE) - IF(CE%FACE_LIST(1,ILOC,IEDGE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND - IF(CE%FACE_LIST(1,ILOC,IEDGE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH - CE%FACE_LIST(1,ILOC,IEDGE) = FCINDEX + IF(CE%FACE_LIST(1,ILOC,IEDGE)>=ICF) CE%FACE_LIST(1,ILOC,IEDGE)=CE%FACE_LIST(1,ILOC,IEDGE)+1 ENDDO ENDDO ENDDO +IF(PRESENT(INZONE)) THEN + IF (INZONE) THEN + DO KDUM=0,MESHES(NM)%KBP1 + DO JDUM=0,MESHES(NM)%JBP1 + DO IDUM=0,MESHES(NM)%IBP1 + DO JCC=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%NCELL + DO IFACE=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NWFACE + IF(MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE)>=ICF) & + MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) = & + MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) + 1 + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDIF +ENDIF -! Reallocate CUT_FACE: -ALLOCATE(CUT_FACE_AUX( MAX(SIZE(MESHES(NM)%CUT_FACE,DIM=1), NCF_MESH+NFC_BND+NFC_MSH + NGF_MESH+NFC_GCR ) )) -CUT_FACE_AUX(1:NBD_MESH) = M%CUT_FACE(1:NBD_MESH) -CUT_FACE_AUX(NBD_MESH+NFC_BND+1:NCF_MESH+NFC_BND) = M%CUT_FACE(NBD_MESH+1:NCF_MESH) -CUT_FACE_AUX(NCF_MESH+NFC_BND+NFC_MSH+1:NCF_MESH+NFC_BND+NFC_MSH+NGF_MESH) = M%CUT_FACE(NCF_MESH+1:NCF_MESH+NGF_MESH) -CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE); M => MESHES(NM) +IF(AXIS==0) THEN + MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = ICF + MESHES(NM)%CUT_FACE(ICF)%STATUS = CC_INBOUNDARY +ELSE + MESHES(NM)%FCVAR(I,J,K,CC_FGSC,AXIS) = CC_CUTCFE + MESHES(NM)%FCVAR(I,J,K,CC_IDCF,AXIS) = ICF + MESHES(NM)%CUT_FACE(ICF)%STATUS = CC_GASPHASE +ENDIF +MESHES(NM)%CUT_FACE(ICF)%IJK(1:4) = (/I, J, K, AXIS/) -! Finally, add new cut-faces: -CT_BND = 0 -CT_MSH = 0 -CT_GCR = 0 -! IAXIS cut-faces: -X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-2,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%IBAR) THEN ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ELSEIF(I==0 .OR. I==M%IBAR) THEN ! Block boundary - CT_BND = CT_BND + 1 - IFC = NBD_MESH + CT_BND - ENDIF - ELSE ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ENDIF - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XFACE(I), YCELL(J), ZCELL(K) /); AREA(1) = DYCELL(J)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC - M%CUT_FACE(IFC)%STATUS = CC_GASPHASE - M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) - ENDDO - ENDDO -ENDDO +RETURN +END SUBROUTINE INSERT_CUT_FACE -! JAXIS cut-faces: -X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-2,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%JBAR) THEN ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ELSEIF(J==0 .OR. J==M%JBAR) THEN ! Block boundary - CT_BND = CT_BND + 1 - IFC = NBD_MESH + CT_BND - ENDIF - ELSE ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ENDIF - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC - M%CUT_FACE(IFC)%STATUS = CC_GASPHASE - M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) - ENDDO +! --------------------------------- DROP_CUT_EDGE ------------------------------------------- + +SUBROUTINE DROP_CUT_EDGE(NM,ICE,JCE,ETYPE) + +INTEGER, INTENT(IN) :: NM,ICE,JCE,ETYPE + +INTEGER :: CT,DUM,ILH,ICF1,IEDGE +INTEGER, ALLOCATABLE, DIMENSION(:) :: IND +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTEDGE_TYPE), POINTER :: CE + +IF(ICE<1) RETURN +M =>MESHES(NM) +CE=>M%CUT_EDGE(ICE) + +NEDGE_IF_1 : IF(CE%NEDGE>1) THEN + ALLOCATE(IND(CE%NEDGE)); IND = 0 + CT=0; + DO DUM=1,CE%NEDGE + IF(DUM==JCE) CYCLE + CT = CT + 1 + IND(DUM) = CT ENDDO -ENDDO + ! Collapse NEDGE variables: + DO DUM=1,CE%NEDGE + IF(DUM==JCE) CYCLE + CE%CEELEM( :,IND(DUM)) = CE%CEELEM( :,DUM) + CE%INDSEG( :,IND(DUM)) = CE%INDSEG( :,DUM) + CE%FACE_LIST(:,:,IND(DUM)) = CE%FACE_LIST(:,:,DUM) + CE%DXX( :,IND(DUM)) = CE%DXX( :,DUM) -! KAXIS cut-faces: -X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS -DO K=-2,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE - IF(0M%KBAR) THEN ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ELSEIF(K==0 .OR. K==M%KBAR) THEN ! Block boundary - CT_BND = CT_BND + 1 - IFC = NBD_MESH + CT_BND - ENDIF - ELSE ! External - CT_GCR = CT_GCR + 1 - IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR - ENDIF - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC - M%CUT_FACE(IFC)%STATUS = CC_GASPHASE - M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) + ! Finally change EDGE_LIST of involved faces: + DO ILH=-2,2 + ICF1 = CE%FACE_LIST(1,ILH,IND(DUM)); IF(ICF1<1) CYCLE + IEDGE = CE%FACE_LIST(3,ILH,IND(DUM)) + M%CUT_FACE(ICF1)%EDGE_LIST(3,IEDGE) = IND(DUM) ENDDO ENDDO -ENDDO +ENDIF NEDGE_IF_1 -M%N_BBCUTFACE_MESH = NBD_MESH + NFC_BND -M%N_CUTFACE_MESH = NCF_MESH + NFC_BND + NFC_MSH -M%N_GCCUTFACE_MESH = NGF_MESH + NFC_GCR +CE%NEDGE = CE%NEDGE - 1 +IF(CE%NEDGE < 1) THEN + IF(ETYPE==CC_ETYPE_CFGAS) THEN + M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_EGSC,CE%IJK(KAXIS+1)) = CC_SOLID + M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED + ELSEIF(ETYPE==CC_ETYPE_CFINB) THEN + IF(CE%IJK(KAXIS+1)>0) THEN + M%FCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED + ELSE + M%CCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE) = CC_UNDEFINED + ENDIF + ENDIF + CE%STATUS = CC_SOLID +ENDIF -ELSE +END SUBROUTINE DROP_CUT_EDGE -! IAXIS cut-faces: -X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-2,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - ! Insert cut-face in CUT_FACE array: - CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XFACE(I), YCELL(J), ZCELL(K) /); AREA(1) = DYCELL(J)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - ENDDO - ENDDO -ENDDO +! ----------------------------- DROP_CUTFACE -------------------------------------- -! JAXIS cut-faces: -X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS -DO K=-1,MESHES(NM)%KBAR+2 - DO J=-2,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - ! Insert cut-face in CUT_FACE array: - CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) +SUBROUTINE DROP_CUTFACE(NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC) + +! Drop cut-face CUT_FACE(ICF)%CFELEM(:,JCF): +! 0. For garphase cut-faces, move gas edges (reg and cut) to INB face CUT_EDGEs where it corresponds. +! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). +! 2. Change second index for cut-faces of cells attached to ICF,JCF +! 3. If zero remaining cut-faces in CUT_FACE(ICF) => make FCVAR,CCVAR GSC and IDCF indexes SOLID and INDEFINED. + +INTEGER, INTENT(IN) :: NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC + +INTEGER :: CT,DUM,ILH,ICC1,JCC1,IFACE,IFC1,IFACE2 +INTEGER, ALLOCATABLE, DIMENSION(:) :: IND +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTFACE_TYPE), POINTER :: CF + +M => MESHES(NM) +CF=> M%CUT_FACE(IFC) + +! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). +NFACE_IF_1 : IF(CF%NFACE>1) THEN + ALLOCATE(IND(CF%NFACE)); IND = 0 + CT=0; + DO DUM=1,CF%NFACE + IF(DUM==JFC) CYCLE + CT = CT + 1 + IND(DUM) = CT + ENDDO + ! Collapse NFACE variables: + DO DUM=1,CF%NFACE + IF(DUM==JFC) CYCLE + CF%CFELEM( :,IND(DUM)) = CF%CFELEM( :,DUM) + CF%CEDGES( :,IND(DUM)) = CF%CEDGES( :,DUM) + CF%AREA( IND(DUM)) = CF%AREA( DUM) + CF%XYZCEN( :,IND(DUM)) = CF%XYZCEN( :,DUM) + CF%SHARED( IND(DUM)) = CF%SHARED( DUM) + CF%CELL_LIST(:,:,IND(DUM)) = CF%CELL_LIST(:,:,DUM) + ! Finally change FACE_LIST of involved cells: + CT = HIGH_IND + IF(FTYPE==CC_FTYPE_CFINB) THEN + CT = LOW_IND + CF%BODTRI( :,IND(DUM)) = CF%BODTRI( :,DUM) + CF%SURF_INDEX( IND(DUM)) = CF%SURF_INDEX( DUM) + CF%BLK_TAG( IND(DUM)) = CF%BLK_TAG( DUM) + CF%CFACE_ORIGIN( IND(DUM)) = CF%CFACE_ORIGIN( DUM) + CF%AREA_ADJUST( IND(DUM)) = CF%AREA_ADJUST( DUM) + ENDIF + DO ILH=LOW_IND,CT + ICC1 = CF%CELL_LIST(2,ILH,IND(DUM)) + JCC1 = CF%CELL_LIST(3,ILH,IND(DUM)) + IFC1 = CF%CELL_LIST(4,ILH,IND(DUM)) + IFACE= M%CUT_CELL(ICC1)%CCELEM(IFC1+1,JCC1) + ! Dropping gas-cut cells, do not reindex local JCF for INBOUNDARY faces. These have been changed already. + IF(FTYPE==CC_FTYPE_CFINB .OR. (FTYPE==CC_FTYPE_CFGAS .AND. M%CUT_CELL(ICC1)%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB)) & + M%CUT_CELL(ICC1)%FACE_LIST(5,IFACE) = IND(DUM) + DO IFACE2=1,M%CUT_CELL(ICC1)%NFACE_DROPPED + IF(M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & + M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(4,IFACE2)==IFC .AND. & + M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)==DUM) & + M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)=IND(DUM) + ENDDO ENDDO ENDDO -ENDDO + CF%CFELEM( :,CF%NFACE) = CC_UNDEFINED + CF%CEDGES( :,CF%NFACE) = CC_UNDEFINED + CF%AREA( CF%NFACE) = 0._EB + CF%XYZCEN( :,CF%NFACE) = 0._EB + CF%SHARED( CF%NFACE) = .FALSE. + CF%BLK_TAG( CF%NFACE) = .FALSE. + CF%CELL_LIST(:,:,CF%NFACE) = CC_UNDEFINED + IF(FTYPE==CC_FTYPE_CFINB) THEN + CF%BODTRI( :,CF%NFACE) = CC_UNDEFINED + CF%SURF_INDEX( CF%NFACE) = CC_UNDEFINED + CF%CFACE_ORIGIN( CF%NFACE) = CC_UNDEFINED + ENDIF + DEALLOCATE(IND) +ENDIF NFACE_IF_1 -! KAXIS cut-faces: -X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS -DO K=-2,MESHES(NM)%KBAR+2 - DO J=-1,MESHES(NM)%JBAR+2 - DO I=-1,MESHES(NM)%IBAR+2 - IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE - ! Test if there are cut-edges in ECVAR: - CT=0 - IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 - IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 - IF(CT<1) CYCLE - ! Insert cut-face in CUT_FACE array: - CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) - CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) - ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: - ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) - XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) - XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) - ALLOCATE(CFELEM(5,1),CEDGES(5,1)) - CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) - ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED - CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) - EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: - CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: - CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: - CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: - CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) - IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) - ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) - ENDIF - M%CUT_FACE(IFC)%NVERT = 4 - M%CUT_FACE(IFC)%NFACE = 1 - CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) - CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) - CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) - CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) - CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) - ENDDO +CF%NFACE = MAX(0,CF%NFACE - 1) + +IF(FTYPE==CC_FTYPE_CFGAS .AND. CF%NSFACE>0) THEN ! Bring down SOLID faces used for SLCF plotting. + CT=CF%NFACE + DO DUM=1,CF%NSFACE + CT=CT+1 + CF%CFELEM( :,CT) = CF%CFELEM( :,CT+1) + CF%CEDGES( :,CT) = CF%CEDGES( :,CT+1) + CF%AREA( CT) = CF%AREA( CT+1) + CF%XYZCEN( :,CT) = CF%XYZCEN( :,CT+1) ENDDO -ENDDO +ENDIF +IF(CF%NFACE < 1) THEN + CF%STATUS = CC_SOLID + CF%NSFACE = 0 + IF (FTYPE == CC_FTYPE_CFGAS) THEN + SELECT CASE(X1AXIS) + CASE(IAXIS) + M%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + M%ECVAR(I+ILHF,J-1:J,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J-1:J,K,CC_IDCE,KAXIS) = CC_UNDEFINED + M%ECVAR(I+ILHF,J,K-1:K,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J,K-1:K,CC_IDCE,JAXIS) = CC_UNDEFINED + CASE(JAXIS) + M%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED + M%ECVAR(I-1:I,J+ILHF,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I-1:I,J+ILHF,K,CC_IDCE,KAXIS) = CC_UNDEFINED + M%ECVAR(I,J+ILHF,K-1:K,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J+ILHF,K-1:K,CC_IDCE,IAXIS) = CC_UNDEFINED + CASE(KAXIS) + M%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED + M%ECVAR(I-1:I,J,K+ILHF,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I-1:I,J,K+ILHF,CC_IDCE,JAXIS) = CC_UNDEFINED + M%ECVAR(I,J-1:J,K+ILHF,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J-1:J,K+ILHF,CC_IDCE,IAXIS) = CC_UNDEFINED + END SELECT + ELSEIF (FTYPE == CC_FTYPE_CFINB) THEN + M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED + ENDIF ENDIF -END SUBROUTINE GET_REMAINING_CUTFACES +RETURN +END SUBROUTINE DROP_CUTFACE +! ----------------------------- DROP_CUTCELL -------------------------------------- -! ---------------------- CUT_CELL_FACE_ARRAYS_CLEANUP ----------------------------- +SUBROUTINE DROP_CUTCELL(NM,ICC,JCC) -SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP(NM) +! Remove cut-cell CUT_CELL(ICC)%CCELEM(:,JCC): +! 1. If CUT_CELL(ICC)%NCELL==1 drop INBOUNDARY faces of ICC,JCC, make CCVAR CGSC SOLID and IDCC,IDCF undefined. +! 2. If more than 1 NCELL, drop JCc from CCELEM, IJK_LINK, LINK_LEV, VOLUME, XYZCEN lists and NCELL=NCELL-1 -INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: NM,ICC,JCC -INTEGER, ALLOCATABLE, DIMENSION(:) :: CCIND,CFIND,AUXV -INTEGER :: I,J,K,X1AXIS,ICC,JCC,IFC,IFACE,ICF,JCF,IFC1,CT,CTC,CTF,ILH,& - N_CUTCELL_MESH_NEW,N_GCCUTCELL_MESH_NEW,N_CUTFACE_MESH_NEW,N_GCCUTFACE_MESH_NEW,N_BBCUTFACE_MESH_NEW,& - NEDG,IEDG,LOHI,DIR,ICE +! Local Variables +INTEGER :: I,J,K,JCC2,IFC,CT +INTEGER, ALLOCATABLE, DIMENSION(:) :: IND TYPE(MESH_TYPE), POINTER :: M M => MESHES(NM) -ALLOCATE(CCIND(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH),CFIND(M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH)); CCIND=0; CFIND=0 - -! Count cut-cells and face entries with NCELL, NFACE > 0: -CTC=0; N_CUTCELL_MESH_NEW=0; N_GCCUTCELL_MESH_NEW=0 -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - IF(M%CUT_CELL(ICC)%NCELL<1) CYCLE - CTC=CTC+1 - CCIND(ICC) = CTC - IF (ICC<=M%N_CUTCELL_MESH) THEN; N_CUTCELL_MESH_NEW = N_CUTCELL_MESH_NEW + 1 - ELSE; N_GCCUTCELL_MESH_NEW = N_GCCUTCELL_MESH_NEW + 1; ENDIF -ENDDO -CTF=0; N_CUTFACE_MESH_NEW=0; N_GCCUTFACE_MESH_NEW=0; N_BBCUTFACE_MESH_NEW=0 -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - IF(M%CUT_FACE(ICF)%NFACE<1) CYCLE - CTF=CTF+1 - CFIND(ICF) = CTF - IF (ICF<=M%N_BBCUTFACE_MESH) N_BBCUTFACE_MESH_NEW = N_BBCUTFACE_MESH_NEW + 1 - IF (ICF<=M%N_CUTFACE_MESH) THEN; N_CUTFACE_MESH_NEW = N_CUTFACE_MESH_NEW + 1 - ELSE; N_GCCUTFACE_MESH_NEW = N_GCCUTFACE_MESH_NEW + 1; ENDIF -ENDDO -! Move Cut-cells to new location, NCELL=0 entries are dropped: -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - IF(M%CUT_CELL(ICC)%NCELL<1 .OR. ICC==CCIND(ICC)) CYCLE - CALL CUT_CELL_MOVE(M%CUT_CELL(ICC),M%CUT_CELL(CCIND(ICC))) -ENDDO -M%N_CUTCELL_MESH = N_CUTCELL_MESH_NEW -M%N_GCCUTCELL_MESH = N_GCCUTCELL_MESH_NEW +I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS) -! Now Cut-faces: -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - IF(M%CUT_FACE(ICF)%NFACE<1 .OR. ICF==CFIND(ICF)) CYCLE - CALL CUT_FACE_MOVE(M%CUT_FACE(ICF),M%CUT_FACE(CFIND(ICF))) -ENDDO -M%N_CUTFACE_MESH = N_CUTFACE_MESH_NEW -M%N_GCCUTFACE_MESH = N_GCCUTFACE_MESH_NEW -M%N_BBCUTFACE_MESH = N_BBCUTFACE_MESH_NEW +! Check if JCC is the only cut-cell in CUT_CELL(ICC): +IF (M%CUT_CELL(ICC)%NCELL==1) THEN + ! Set cut-cell to solid + M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID + M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED + M%CUT_CELL(ICC)%NCELL = 0 + ! Then drop INBOUNDARY cut-faces in I,J,K if there are any left: + IFC=M%CCVAR(I,J,K,CC_IDCF) + IF (IFC>0) THEN + M%CUT_FACE(IFC)%STATUS = CC_SOLID + M%CUT_FACE(IFC)%NFACE = 0 + ENDIF + M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED + RETURN +ENDIF -! Finally fix ICC and ICF in CCVAR, FCVAR, CELL_LIST and FACE_LIST arrays -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC=>M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS); - M%CCVAR(I,J,K,CC_IDCC) = ICC; - DO JCC=1,CC%NCELL - ALLOCATE(AUXV(CC%CCELEM(1,JCC))); AUXV = 0 - DO IFC=1,CC%CCELEM(1,JCC) - IFACE = CC%CCELEM(IFC+1,JCC) - AUXV(IFC) = 1 - IF ( .NOT.(CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB .OR. & - CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) ) CYCLE - IFC1 = CC%FACE_LIST(4,IFACE) - CC%FACE_LIST(4,IFACE) = 0; IF(IFC1>0) CC%FACE_LIST(4,IFACE) = CFIND(IFC1) - IF(CC%FACE_LIST(4,IFACE)<1) AUXV(IFC) = 0 - ENDDO - IFC1=0 - DO IFC=1,CC%CCELEM(1,JCC) - IF(AUXV(IFC)<1) CYCLE - IFC1 = IFC1+1 - CC%CCELEM(IFC1+1,JCC) = CC%CCELEM(IFC+1,JCC) - ENDDO - CC%CCELEM(1,JCC) = SUM(AUXV(:)) - DEALLOCATE(AUXV) - ENDDO - ! Deallocate FACE_LIST_DROPPED - CC%NFACE_DROPPED = 0 - IF(ALLOCATED(CC%FACE_LIST_DROPPED)) DEALLOCATE(CC%FACE_LIST_DROPPED) +! First count: +ALLOCATE(IND(1:M%CUT_CELL(ICC)%NCELL)); IND=0 +CT=0 +DO JCC2=1,M%CUT_CELL(ICC)%NCELL + IF (JCC2==JCC) CYCLE + CT = CT + 1 + IND(JCC2) = CT ENDDO -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CT = HIGH_IND - I = M%CUT_FACE(ICF)%IJK(IAXIS); J = M%CUT_FACE(ICF)%IJK(JAXIS); K = M%CUT_FACE(ICF)%IJK(KAXIS) - X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) - SELECT CASE(M%CUT_FACE(ICF)%STATUS) - CASE(CC_INBOUNDARY) - CT = LOW_IND - M%CCVAR(I,J,K,CC_IDCF) = ICF - CASE(CC_GASPHASE) - M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = ICF - END SELECT - DO JCF=1,M%CUT_FACE(ICF)%NFACE - DO ILH=LOW_IND,CT - IF (M%CUT_FACE(ICF)%CELL_LIST(1,ILH,JCF)==CC_FTYPE_CFGAS) THEN - ICC = M%CUT_FACE(ICF)%CELL_LIST(2,ILH,JCF) - M%CUT_FACE(ICF)%CELL_LIST(2,ILH,JCF) = CCIND(ICC) - ENDIF - ENDDO - ENDDO +! Then drop JCC: +DO JCC2=1,M%CUT_CELL(ICC)%NCELL + IF (JCC2==JCC) CYCLE + M%CUT_CELL(ICC)%CCELEM(:,IND(JCC2)) = M%CUT_CELL(ICC)%CCELEM(:,JCC2) + M%CUT_CELL(ICC)%IJK_LINK(:,IND(JCC2)) = M%CUT_CELL(ICC)%IJK_LINK(:,JCC2) + M%CUT_CELL(ICC)%LINK_LEV(IND(JCC2)) = M%CUT_CELL(ICC)%LINK_LEV(JCC2) + M%CUT_CELL(ICC)%VOLUME(IND(JCC2)) = M%CUT_CELL(ICC)%VOLUME(JCC2) + M%CUT_CELL(ICC)%XYZCEN(:,IND(JCC2)) = M%CUT_CELL(ICC)%XYZCEN(:,JCC2) + M%CUT_CELL(ICC)%NOADVANCE(IND(JCC2)) = M%CUT_CELL(ICC)%NOADVANCE(JCC2) ENDDO -! Finally, some cut-faces might have regular Edges which are in CUT_EDGE, renumber in EDGE_LIST: -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_GASPHASE) CYCLE - NEDG=SIZE(CF%EDGE_LIST,DIM=2); I=CF%IJK(IAXIS); J=CF%IJK(JAXIS); K=CF%IJK(KAXIS); X1AXIS=CF%IJK(KAXIS+1) - DO IEDG=1,NEDG-1 - IF(CF%EDGE_LIST(1,IEDG)/=CC_ETYPE_RGGAS) CYCLE - LOHI=CF%EDGE_LIST(2,IEDG)-2 ! -1 for LOW_IND, 0 for HIGH_IND - DIR =CF%EDGE_LIST(3,IEDG) - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(DIR==JAXIS) THEN - ICE=M%ECVAR(I,J+LOHI,K,CC_IDCE,KAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ELSEIF(DIR==KAXIS) THEN - ICE=M%ECVAR(I,J,K+LOHI,CC_IDCE,JAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ENDIF - CASE(JAXIS) - IF(DIR==IAXIS) THEN - ICE=M%ECVAR(I+LOHI,J,K,CC_IDCE,KAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ELSEIF(DIR==KAXIS) THEN - ICE=M%ECVAR(I,J,K+LOHI,CC_IDCE,IAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ENDIF - CASE(KAXIS) - IF(DIR==IAXIS) THEN - ICE=M%ECVAR(I+LOHI,J,K,CC_IDCE,JAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ELSEIF(DIR==JAXIS) THEN - ICE=M%ECVAR(I,J+LOHI,K,CC_IDCE,IAXIS) - IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) - ENDIF - END SELECT - ENDDO -ENDDO +M%CUT_CELL(ICC)%NCELL = M%CUT_CELL(ICC)%NCELL - 1 -DEALLOCATE(CCIND,CFIND) +DEALLOCATE(IND) RETURN -END SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP - -! ---------------------------- BLOCK_CUT_CELL ------------------------------------- +END SUBROUTINE DROP_CUTCELL -SUBROUTINE BLOCK_CUT_CELL(NM,ICC,JCC,BLOCK_PHASE) +! ------------------------- GET_REMAINING_CUTCELLS -------------------------------- -! 1. Find Body and triangle with largest boundary cut-face area in cut-cell ICC,JCC. -! 2. Loop on faces of ICC,JCC (IFC_LOOP): -! a. If face is regular face, define it as Boundary cut-face of cell sharing it with ICC,JCC. -! a1. Make space for all surrounding Cartesian cells that will turn into cut-cells. -! a2. Make space for CFINB cut-edges and cut-faces in cell sharing with ICC,JCC, define cut-cell in said -! Cartesian cell. -! a3. Drop regular face, set FCVAR, ECVAR for edges involved => SOLID. Make VERTVAR for vertices involved SOLID. -! b. If face is type CFGAS. -! b1. Make space for all surrounding Cartesain cells that will turn into cut-cells. -! b2. Make space for CFINB cut-edges and cut-faces in CUT_CELL sharing with ICC,JCC. -! b3. Add INB cut-face to surrounding cut-cell, drop regular face, set FCVAR, ECVAR for edges involved => SOLID. -! Make VERTVAR for vertices involved SOLID. +SUBROUTINE GET_REMAINING_CUTCELLS(NM) -INTEGER, INTENT(IN) :: NM,ICC,JCC,BLOCK_PHASE +! Define regular cut-cells for regular cartesian cells surrounded by a gas cut-face. +INTEGER, INTENT(IN) :: NM -INTEGER :: I,J,K,II,JJ,KK,IFC,IFC1,JFC1,IFACE,LOHI,ILH,X1AXIS,NSVERT,NSFACE,NVERTFACE_NEW,COUNT,DUM,IBOD,ITRI,& - HILO,ILHF,ICC2,JCC2,IFC2,IFACE2,IFCX,JFCX,IV,IVERT,MAXVERTS,INOD,INDFC(1:4),ICCNXT,& - IADD,JADD,KADD,EDGE_LIST_REG(1:3,1:4),DIMCE(2),IEDGE,CEI,LOHIE,AXISF,AXISE,LOWI,HIGI,LOWJ,HIGJ,LOWK,HIGK,& - IEG,JEG,KEG,ICE,JCE,ICF2,JCF2,JCE2,IEC2,JEC2,VL1(4),VL2(4),NFCD,IFCIN,JFCIN,KFCIN,X1AXIN,SZDUM -REAL(EB):: XYZV(IAXIS:KAXIS),XYZVERT(MAX_DIM,4) -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BODTRI,EDGE_LIST_AUX,CEDGES_AUX,CEDGES_AUX2,FACE_LIST_DROPPED -INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM -REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA -LOGICAL :: REALLOC_FLG, NEW_FACE_FLG, DROP_FACE, INZONE +! Local Variables: +INTEGER :: I,J,K,CT,X1AXIS,SIDE,ICC,JCC,IFACE,ICF,JCF,ICFC,ICFINB,NCFACE_CUTCELL,NCELL,NFACE_CELL +INTEGER :: NCC_MESH,NGC_MESH,NCELL_IN,NCELL_GC,COUNT_CC,COUNT_GC +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME +INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_INBCF_AREA_TYPE), POINTER :: INBCF_AREA +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX +LOGICAL, PARAMETER :: OPT=.TRUE. + M => MESHES(NM) -I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS); -! Find Body and triangle to associate to the cell to be blocked: -IBOD = 0; ITRI = 0 -COUNT= 0; DUM = 0 -DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 -ENDDO -IF (COUNT>0) THEN - ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 - DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE - DO DUM=1,COUNT - IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & - BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT +! First thing is, for known cut-cells with reg faces that have changed to cut-faces to change the +! FACE_LIST incidence: +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_CUTCFE) CYCLE + ICC=M%CCVAR(I,J,K,CC_IDCC) + CC=>M%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + DO ICF=2,CC%CCELEM(1,JCC)+1 + IFACE = CC%CCELEM(ICF,JCC) + SIDE = CC%FACE_LIST(2,IFACE) + X1AXIS= CC%FACE_LIST(3,IFACE) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_RCGAS) CYCLE + ICFC = M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS) + IF(ICFC>0) CC%FACE_LIST(:,IFACE) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) ! New cut-face. + ENDDO + ENDDO ENDDO - IF(DUM > COUNT) THEN ! No match in previous loop DUM=COUNT+1 - BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) - COUNT = DUM - ENDIF - AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) ENDDO - IF (COUNT>0) THEN - ! Now set IBOD, ITRI - DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. - IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) - ENDIF - DEALLOCATE(BODTRI,AREA) -ELSE - ! Look in surrounding cells: - DO KK=K-1,K+1 - DO JJ=J-1,J+1 - DO II=I-1,I+1 - ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) - IF (ICC2>0) THEN - DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) - IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 - ENDDO - ENDDO - ENDIF - ENDDO +ENDDO + +IF (OPT) THEN + +NCC_MESH = M%N_CUTCELL_MESH +NGC_MESH = M%N_GCCUTCELL_MESH + +! First count how many new cells are goint to be created inside, and in ghost cell region: +NCELL_IN=0 +NCELL_GC=0 +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE + ! Test for gas cut-faces: + CT=0 + IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + IF(K<1 .OR. K>M%KBAR .OR. J<1 .OR. J>M%JBAR .OR. I<1 .OR. I>M%IBAR) THEN + NCELL_GC = NCELL_GC + 1 + ELSE + NCELL_IN = NCELL_IN + 1 + ENDIF ENDDO ENDDO - IF (COUNT>0) THEN - ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 - DO KK=K-1,K+1 - DO JJ=J-1,J+1 - DO II=I-1,I+1 - ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) - IF (ICC2>0) THEN - DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) - IFC1 = M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE) - JFC1 = M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE) - IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE - DO DUM=1,COUNT - IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & - BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT - ENDDO - IF(DUM > COUNT) THEN - BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) - COUNT = DUM - ENDIF - AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) - ENDDO - ENDDO - ENDIF - ENDDO - ENDDO +ENDDO + +! Reset CCVAR, CELL_LIST indexes: +DO K=-CCGUARD,M%KBAR+CCGUARD + DO J=-CCGUARD,M%JBAR+CCGUARD + DO I=-CCGUARD,M%IBAR+CCGUARD + ! All GC cut-cells get their index + NCELL_IN + IF(M%CCVAR(I,J,K,CC_IDCC)<=NCC_MESH) CYCLE + M%CCVAR(I,J,K,CC_IDCC)=M%CCVAR(I,J,K,CC_IDCC) + NCELL_IN ENDDO - IF (COUNT>0) THEN - ! Now set IBOD, ITRI - DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. - IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) - ENDIF - DEALLOCATE(BODTRI,AREA) - ENDIF -ENDIF + ENDDO +ENDDO +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + DO JCF=1,M%CUT_FACE(ICF)%NFACE + IF(M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>NCC_MESH) & + M%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + NCELL_IN + IF(M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>NCC_MESH) & + M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = M%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + NCELL_IN + ENDDO +ENDDO -! For cut-cell ICC, JCC run through its boundary faces and generate new boundary EDGES, CUT-FACES and cells: -BLOCK_PHASE_IF : IF(BLOCK_PHASE==1) THEN +! Make space for NCELL_IN, NCELL_GC cut-cell entries. +ALLOCATE(CUT_CELL_AUX( MAX(SIZE(M%CUT_CELL,DIM=1),NCC_MESH + NCELL_IN +NGC_MESH + NCELL_GC) )) +CUT_CELL_AUX(1:NCC_MESH) = M%CUT_CELL(1:NCC_MESH) +CUT_CELL_AUX(NCC_MESH+NCELL_IN+1:NCC_MESH+NCELL_IN+NGC_MESH) = M%CUT_CELL(NCC_MESH+1:NCC_MESH+NGC_MESH) +CALL MOVE_ALLOC(FROM=CUT_CELL_AUX,TO=MESHES(NM)%CUT_CELL); M=> MESHES(NM) -! Add areas of corresponding INB faces: -INZONE = (I>=0 .AND. I<=M%IBP1 .AND. J>=0 .AND. J<=M%JBP1 .AND. K>=0 .AND. K<=M%KBP1) .AND. MY_RANK==PROCESS(NM) -IF(INZONE) THEN - INBCF_AREA => M%INBCF_AREA(I,J,K) - IF(INBCF_AREA%NCELL == 0) THEN - INBCF_AREA%NCELL = M%CUT_CELL(ICC)%NCELL - ALLOCATE(INBCF_AREA%AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%AINB = 0._EB - ALLOCATE(INBCF_AREA%NEW_AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%NEW_AINB = 0._EB - ALLOCATE(INBCF_AREA%SURF_INDEX(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%SURF_INDEX = 0 - ALLOCATE(INBCF_AREA%IJCF(M%CUT_CELL(ICC)%NCELL)) - ENDIF - IF(IBOD>0) M%INBCF_AREA(I,J,K)%SURF_INDEX(JCC) = GEOMETRY(IBOD)%SURFS(ITRI) - DUM = 0; M%INBCF_AREA(I,J,K)%AINB(JCC) = 0._EB - DO IFC=2,M%CUT_CELL(ICC)%CCELEM(1,JCC)+1 - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC,JCC) - IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) - SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_CFINB) - M%INBCF_AREA(I,J,K)%AINB(JCC) = M%INBCF_AREA(I,J,K)%AINB(JCC) + & - M%CUT_FACE(IFC1)%AREA(JFC1)*M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1) - CASE(CC_FTYPE_CFGAS,CC_FTYPE_RCGAS) - DUM=DUM+1 - END SELECT - ENDDO - IF(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE>0) THEN - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = 0; - DEALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB) - ENDIF - IF(.NOT.ALLOCATED(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB)) THEN - ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB = 0 - ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB = 0 - ENDIF -ENDIF +! Then build new regular cut-cells: +COUNT_CC = 0 +COUNT_GC = 0 +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE + ! Test for gas cut-faces: + CT=0 + IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE -IFC_LOOP : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) - HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND - ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND - ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND - X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) - IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + ! Count allocation number for faces boundary of this cut-cell: + CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT - FACE_TYPE_IF : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & - M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN - LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) - HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) - LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) - HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) - IF(LOWI>0 .AND. LOWJ>0) THEN - IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) CYCLE IFC_LOOP + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO X1AXIS=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND + ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO + ENDDO + + ! Add INB cut-face if any present: + IF(ICFINB>0) THEN + DO JCF=1,M%CUT_FACE(ICFINB)%NFACE + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDDO ENDIF - ENDIF - ! If needed reallocate CUT_FACE to accomodate INBOUNDARY face in neighbor cell. - SELECT CASE(X1AXIS) - CASE(IAXIS); II=I+ILH; JJ=J; KK=K - CASE(JAXIS); II=I; JJ=J+ILH; KK=K - CASE(KAXIS); II=I; JJ=J; KK=K+ILH - END SELECT - IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP - ICCNXT=0; IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) ICCNXT=1 + ! Insert cut_cell: + IF(K<1 .OR. K>MESHES(NM)%KBAR .OR. J<1 .OR. J>MESHES(NM)%JBAR .OR. I<1 .OR. I>MESHES(NM)%IBAR) THEN + COUNT_GC = COUNT_GC + 1 + ICC = NCC_MESH + NCELL_IN + NGC_MESH + COUNT_GC + ELSE + COUNT_CC = COUNT_CC + 1 + ICC = NCC_MESH + COUNT_CC + ENDIF + CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M%CUT_CELL(ICC)%NCELL = NCELL + M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + M%CUT_CELL(ICC)%NFACE_DROPPED = 0 + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) + M%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) + M%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE + M%CCVAR(I,J,K,CC_IDCC) = ICC + ENDDO + ENDDO +ENDDO - IFC1 = M%CCVAR(II,JJ,KK,CC_IDCF) ! INBOUNDARY cut-faces in neighbor cartesian cell. - NEW_FACE_FLG = .FALSE. - IF (IFC1 < 1) THEN - ! Insert IFC1: - CALL INSERT_CUT_FACE(NM,II,JJ,KK,0,IFC1,INZONE=INZONE); M => MESHES(NM) ! Make space for INBOUNDARY cut-face - NEW_FACE_FLG = .TRUE. - ENDIF +M%N_CUTCELL_MESH = NCC_MESH + NCELL_IN +M%N_GCCUTCELL_MESH = NGC_MESH + NCELL_GC - REALLOC_FLG = .FALSE. - NSVERT = 0; NSFACE = 0; - IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) NVERTFACE_NEW = 5 - IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) NVERTFACE_NEW = M%CUT_FACE(IFCX)%CFELEM(1,JFCX)+1 - SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CFELEM)) SZDUM = SIZE(M%CUT_FACE(IFC1)%CFELEM, DIM=1) - IF(SZDUM < NVERTFACE_NEW) REALLOC_FLG = .TRUE. - SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%XYZVERT)) SZDUM = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) - IF(SZDUM < M%CUT_FACE(IFC1)%NVERT+NVERTFACE_NEW-1) THEN - REALLOC_FLG = .TRUE. - NSVERT = NVERTFACE_NEW-1 - ENDIF - SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%AREA)) SZDUM = SIZE(M%CUT_FACE(IFC1)%AREA,DIM=1) - IF(SZDUM < M%CUT_FACE(IFC1)%NFACE+1) THEN - REALLOC_FLG = .TRUE. - NSFACE = 1 - ENDIF - JFC1 = M%CUT_FACE(IFC1)%NFACE+1 +ELSE - ! Reallocate CUT_FACE(IFC1) entry: - IF(NEW_FACE_FLG) THEN - CALL FACE_DEALLOC(NM,IFC1); CALL NEW_FACE_ALLOC(NM,IFC1,NSVERT,NSFACE,NVERTFACE_NEW) - ELSEIF(REALLOC_FLG) THEN - CALL FACE_REALLOC(NM,IFC1,M%CUT_FACE(IFC1)%NVERT,M%CUT_FACE(IFC1)%NFACE,NSVERT,NSFACE,NVERTFACE_NEW) - ENDIF +! Then build new regular cut-cells: +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE + ! Test for gas cut-faces: + CT=0 + IF(ANY(M%FCVAR(I-1:I,J,K,CC_FGSC,IAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE - M=>MESHES(NM) - ! Provide GEOM surface information to newly created INBOUNDARY face: - M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) = (/ IBOD, ITRI /) - M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = 0 ! Default surf. - M%CUT_FACE(IFC1)%CFACE_ORIGIN(JFC1) = M%CUT_CELL(ICC)%NOADVANCE(JCC) - IF(IBOD>0) M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = GEOMETRY(IBOD)%SURFS(ITRI) - M%CUT_FACE(IFC1)%NFACE = JFC1 - ENDIF FACE_TYPE_IF + ! Count allocation number for faces boundary of this cut-cell: + CT = 6; ICFINB=M%CCVAR(I,J,K,CC_IDCF); IF(ICFINB>0) CT = CT + M%CUT_FACE(ICFINB)%NFACE + NCFACE_CUTCELL = CT + 1 + NCELL = 1 + NFACE_CELL = CT - SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_RCGAS) ! This regular face has to be connecting two small cut-cells. - ! Scheme: - ! 0. Add REG edges as INB cut-edges in corresponding cartesian cut faces. Define normal edges to new INB cut-edge - ! as CFGAS cut-edges. Set VERTVAR to SOLID in EDGE corners: - EDGE_LIST_REG(1:3,1:4) = CC_UNDEFINED; EDGE_LIST_REG(1,1:4) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. - SELECT CASE(X1AXIS) - CASE(IAXIS) - ! First INB cut edges in surrounding faces: - ! I+ILHF location. - ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 - XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) - XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) - ! Edge 1: V1-V2 add to face (I+2*ILHF+1,J ,K-1,KAXIS) - ! side on blocked cell,[I,J,K,X1EDGE], [I,J,K,X1FACE] - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K-1,JAXIS,I+2*ILHF+1,J ,K-1,KAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) - ! Edge 2: V2-V3 add to face (I+2*ILHF+1,J ,K ,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,KAXIS,I+2*ILHF+1,J ,K ,JAXIS,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) - ! Edge 3: V4-V3 add to face (I+2*ILHF+1,J ,K ,KAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,JAXIS,I+2*ILHF+1,J ,K ,KAXIS,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) - ! Edge 4: V1-V4 add to face (I+2*ILHF+1,J-1,K ,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J-1,K ,KAXIS,I+2*ILHF+1,J-1,K ,JAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) + ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED + ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED + ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=DXCELL(I)*DYCELL(J)*DZCELL(K) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I),YCELL(J),ZCELL(K) /) + ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - ! Second CFGAS cut-edges in edges normal to face: - DO KADD=-1,0 - DO JADD=-1,0 - ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ! Add one by one regular and gas cut faces: + CT = 1; CCELEM(1,1) = 0 + DO X1AXIS=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND + ICFC=M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_IDCF,X1AXIS); + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, X1AXIS,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF(M%FCVAR(I+ADDI(SIDE,X1AXIS),J+ADDJ(SIDE,X1AXIS),K+ADDK(SIDE,X1AXIS),CC_FGSC,X1AXIS)==CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, X1AXIS, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF ENDDO ENDDO - CASE(JAXIS) - ! J+ILHF location. - ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) - ! Edge 1: V1-V2 add to face (I-1,J+2*ILHF+1,K ,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J+ILHF,K ,KAXIS,I-1,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) - ! Edge 2: V2-V3 add to face (I ,J+2*ILHF+1,K ,KAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,IAXIS,I ,J+2*ILHF+1,K ,KAXIS,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) - ! Edge 3: V4-V3 add to face (I ,J+2*ILHF+1,K ,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,KAXIS,I ,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) - ! Edge 4: V1-V4 add to face (I ,J+2*ILHF+1,K-1,KAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K-1,IAXIS,I ,J+2*ILHF+1,K-1,KAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) - - ! Second CFGAS cut-edges in edges normal to face: - DO KADD=-1,0 - DO IADD=-1,0 - ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ! Add INB cut-face if any present: + IF(ICFINB>0) THEN + DO JCF=1,M%CUT_FACE(ICFINB)%NFACE + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFINB, 0, 0, ICFINB, JCF, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 ENDDO - ENDDO + ENDIF - CASE(KAXIS) - ! K+ILHF location. - ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /) - XYZVERT(:,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) - ! Edge 1: V1-V2 add to face (I,J-1,K+2*ILHF+1,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J-1,K+ILHF,IAXIS,I ,J-1,K+2*ILHF+1,JAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) - ! Edge 2: V2-V3 add to face (I,J ,K+2*ILHF+1,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,JAXIS,I ,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) - ! Edge 3: V4-V3 add to face (I,J ,K+2*ILHF+1,JAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,IAXIS,I ,J ,K+2*ILHF+1,JAXIS,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) - ! Edge 4: V1-V4 add to face (I-1,J,K+2*ILHF+1,IAXIS) - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J ,K+ILHF,JAXIS,I-1,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) + ! Insert cut_cell: + CALL INSERT_CUT_CELL(NM,I,J,K,ICC); M => MESHES(NM) + CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + M%CUT_CELL(ICC)%NCELL = NCELL + M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL + CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) + ENDDO + ENDDO +ENDDO - ! Second CFGAS cut-edges in edges normal to face: - DO JADD=-1,0 - DO IADD=-1,0 - ! Edge (I+IADD,J+JADD,K+2*ILHF+1,KAXIS): From V(I+IADD,J+JADD,K+2*ILHF) to V(I+IADD,J+JADD,K+2*ILHF+1) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+JADD,K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO +ENDIF - END SELECT +END SUBROUTINE GET_REMAINING_CUTCELLS +! ------------------------- GET_REMAINING_CUTFACES -------------------------------- - ! 1. Add INBOUNDARY cut-face with size of RGGAS in CUT_FACE for this face (IFC1,JFC1). - DUM = M%CUT_FACE(IFC1)%NVERT + 1 - SELECT CASE(X1AXIS) - CASE(IAXIS) - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) - M%CUT_FACE(IFC1)%AREA(JFC1) = DYCELL(J)*DZCELL(K) - M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XFACE(I+ILHF), YCELL(J), ZCELL(K) /) - CASE(JAXIS) - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) - M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DZCELL(K) - M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YFACE(J+ILHF), ZCELL(K) /) - CASE(KAXIS) - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /); DUM = DUM + 1 - M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) - M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DYCELL(J) - M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YCELL(J), ZFACE(K+ILHF) /) - END SELECT - INDFC(1:4) = (/ 1, 2, 3, 4 /); INDFC = INDFC + M%CUT_FACE(IFC1)%NVERT - M%CUT_FACE(IFC1)%NVERT = DUM +SUBROUTINE GET_REMAINING_CUTFACES(NM) - ! All faces connectivities: (/ NNODS, NOD1, NOD2, NOD3, NOD4 /) ! Conn. into gas region of new cell. - IF (LOHI==HIGH_IND) THEN; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(2), INDFC(3), INDFC(4) /) - ELSE; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(4), INDFC(3), INDFC(2) /); ENDIF +! Running by axes define regular cut-faces, add to CUT_FACE array. - ! Add new edges to EDGE_LIST: - DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) - ALLOCATE(EDGE_LIST_AUX(3,DUM+4)); - IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) - EDGE_LIST_AUX(1:3,DUM+1:DUM+4) = EDGE_LIST_REG(1:3,1:4); - CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) - ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) - DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN - DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) - ENDIF - IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) - IF (LOHI==HIGH_IND) THEN; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+2, DUM+3, DUM+4 /) - ELSE; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+4, DUM+3, DUM+2 /); ENDIF - CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) +INTEGER, INTENT(IN) :: NM - IF(INZONE) THEN - M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 - ENDIF +! Local Variables: +INTEGER :: I,J,K,CT,X1AXIS,X2AXIS,X3AXIS,IFC,CEI,CEIF,ICC,JCC,ICE,IEDGE,ILOC,IFACE +INTEGER :: NBD_MESH,NCF_MESH,NGF_MESH,NFC_BND,NFC_MSH,NFC_GCR,CT_BND,CT_MSH,CT_GCR,FCINDEX +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES,EDGE_LIST +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZVERT,XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTEDGE_TYPE), POINTER :: CE +TYPE(CC_CUTFACE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_FACE_AUX +LOGICAL, PARAMETER :: OPT=.TRUE. - ! 2. Find cut-cell sharing this RGGAS face, and where in FACE_LIST this face is. - IF( ICCNXT==0 ) THEN - ! 3. Change in FACE_LIST -> (/CC_FTYPE_RCGAS,SIDE,MYAXIS,0,0/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/). - ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) - JCC2_LOOP_1 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) - IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_RCGAS .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(2,IFACE2)==HILO .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(3,IFACE2)==X1AXIS) THEN - M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) - M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1)= (/ CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) - EXIT JCC2_LOOP_1 - ENDIF - ENDDO - ENDDO JCC2_LOOP_1 - ENDIF +M => MESHES(NM) - CASE(CC_FTYPE_CFGAS) +IF (OPT) THEN - ! Scheme: - ! 0. Add REG and CFGAS cut edges as INB cut edges for the normal faces where it corresponds: - DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) - ALLOCATE(EDGE_LIST_AUX(3,DUM+M%CUT_FACE(IFCX)%CEDGES(1,JFCX))); - EDGE_LIST_AUX = CC_UNDEFINED; EDGE_LIST_REG(1,:) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. - IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) - ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) - DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN - DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) - ENDIF - IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) - CEDGES_AUX(1,JFC1) = M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - SELECT CASE(X1AXIS) - CASE(IAXIS) - XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) - XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) - ! Loop face edges/cut-edges: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) +NBD_MESH = M%N_BBCUTFACE_MESH +NCF_MESH = M%N_CUTFACE_MESH +NGF_MESH = M%N_GCCUTFACE_MESH + +! First count EXT Boundary, In meshm and ghost cell region cut-faces: +NFC_BND = 0 +NFC_MSH = 0 +NFC_GCR = 0 +! IAXIS cut-faces: +X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-2,M%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%IBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External + ELSEIF(I==0 .OR. I==M%IBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary ENDIF - CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! First INB cut edges in surrounding faces: - ! I+ILHF location. - ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 - LOWJ=-1; HIGJ=0; LOWK=-1; HIGK=0; - IF(AXISF==JAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J-1; KEG=K ; HIGJ=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J-1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; LOWJ= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ENDIF - ELSEIF(AXISF==KAXIS) THEN - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J ; KEG=K-1; HIGK=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K-1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; LOWK= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ENDIF - ENDIF - DO KADD=LOWK,HIGK - DO JADD=LOWJ,HIGJ - ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO - CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge - ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; - ! Find Edge: - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. - SELECT CASE(AXISE) - CASE(KAXIS) ! Edge in z dir. For surrounding faces in X dir -> 2*ILHF+1 = -1 or 1. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=JAXIS - CASE(JAXIS) ! Edge in y dir. For surrounding faces in X dir -> 4*ILHF+2 = -2 or 2. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=KAXIS - END SELECT - ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: - ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: - CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) - - ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: - EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) - - ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: - VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - IF(VL1(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL1(3)), ZFACE(VL1(4)) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL1(3)), ZFACE(VL1(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL1(3),VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - IF(VL2(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL2(3)), ZFACE(VL2(4)) /) - XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL2(3)), ZFACE(VL2(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL2(3),VL2(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge - ! New edge list for the heighboring cell Boundary cut-faces is inherited. - EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) - END SELECT - ENDDO - - CASE(JAXIS) - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) - XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) - XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) - ! Loop face edges/cut-edges: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) - ENDIF - CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! First INB cut edges in surrounding faces: - ! J+ILHF location. - ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - LOWI=-1; HIGI=0; LOWK=-1; HIGK=0; - IF(AXISF==KAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J+ILHF; KEG=K-1; HIGK=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K-1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ELSE - IEG=I; JEG=J+ILHF; KEG=K ; LOWK= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ENDIF - ELSEIF(AXISF==IAXIS) THEN - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J+ILHF; KEG=K ; HIGI=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ELSE - IEG=I ; JEG=J+ILHF; KEG=K ; LOWI= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ENDIF - ENDIF - DO KADD=LOWK,HIGK - DO IADD=LOWI,HIGI - ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO - CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge - ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; - ! Find Edge: - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. - SELECT CASE(AXISE) - CASE(IAXIS) ! Edge in x dir. For surrounding faces in Y dir -> 2*ILHF+1 = -1 or 1. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=KAXIS - CASE(KAXIS) ! Edge in z dir. For surrounding faces in Y dir -> 4*ILHF+2 = -2 or 2. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); - X1AXIN=IAXIS - END SELECT - - ! IF(ICF2<1) THEN - ! WRITE(LU_ERR,*) 'ADD CUT_EDGE TO FACE IFCX,JFCX,I,J,K,X1AXIS=',& - ! IFCX,JFCX,M%CUT_FACE(IFCX)%IJK(1:4),':',M%FCVAR(7,7,7,CC_IDCF,2),M%FCVAR(7,7,7,CC_FGSC,2) - ! WRITE(LU_ERR,*) 'IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4)=',& - ! IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4),4*ILHF+2 - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-2,JCE) - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-1,JCE) - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 1,JCE) - ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 2,JCE) - ! ENDIF - - ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: - ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: - CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) - - ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: - EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) - - ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: - VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - IF(VL1(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF ), ZFACE(VL1(4)) /) - XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF+1), ZFACE(VL1(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),J+2*ILHF+1,VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - IF(VL2(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - XYZVERT(:,1) = (/ XFACE(VL2(2)), YFACE(J+2*ILHF ), ZFACE(VL2(4)) /) - XYZVERT(:,2) = (/ XFACE(VL2(2)), YFACE(J+2*ILHF+1), ZFACE(VL2(4)) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL2(2),J+2*ILHF+1,VL2(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge - ! New edge list for the heighboring cell Boundary cut-faces is inherited. - EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) - END SELECT - ENDDO - CASE(KAXIS) - XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /) - XYZVERT(:,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /) - XYZVERT(:,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) - ! Loop face edges/cut-edges: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) - ENDIF - CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! First INB cut edges in surrounding faces: - ! K+ILHF location. - ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] - ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 - LOWI=-1; HIGI=0; LOWJ=-1; HIGJ=0; - IF(AXISF==IAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J; KEG=K+ILHF; HIGI=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ELSE - IEG=I ; JEG=J; KEG=K+ILHF; LOWI= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) - ENDIF - ELSEIF(AXISF==JAXIS) THEN - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J-1; KEG=K+ILHF; HIGJ=-1 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J-1,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ELSE - IEG=I; JEG=J ; KEG=K+ILHF; LOWJ= 0 - CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & - XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) - ENDIF - ENDIF - DO JADD=LOWJ,HIGJ - DO IADD=LOWI,HIGI - ! Edge (I+IADD,J+JADD,K+2*ILHF+1,KAXIS): From V(I+IADD,J+JADD,K+2*ILHF) to V(I+IADD,J+JADD,K+2*ILHF+1) - XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+JADD,K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDDO - ENDDO - CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge - ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; - ! Find Edge: - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. - SELECT CASE(AXISE) - CASE(JAXIS) ! Edge in y dir. For surrounding faces in Z dir -> 2*ILHF+1 = -1 or 1. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; - X1AXIN=IAXIS - CASE(IAXIS) ! Edge in x dir. For surrounding faces in Z dir -> 4*ILHF+2 = -2 or 2. - ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) - JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) - JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) - IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; - X1AXIN=JAXIS - END SELECT - - ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: - ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: - CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) - - ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: - EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) - - ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: - VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - IF(VL1(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) - XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),VL1(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - IF(VL2(1)==CC_VTYPE_VGAS) THEN - !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) - XYZVERT(:,1) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF ) /) - XYZVERT(:,2) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF+1) /) - CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL2(2),VL2(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) - ENDIF - CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge - ! New edge list for the heighboring cell Boundary cut-faces is inherited. - EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) - END SELECT - ENDDO - END SELECT - CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) - CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) - - ! 1. Add INBOUNDARY cut-face in CUT_FACE for this face (IFC1,JFC1). - ! Add XYZVERT, AREA, XYZCEN and CFELEM entry in CUT_FACE(IFC1) for this (IFCX,JFCX) CFGAS face. - M%CUT_FACE(IFC1)%CFELEM(1,JFC1) = M%CUT_FACE(IFCX)%CFELEM(1,JFCX) - MAXVERTS = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) - COUNT=1 - DO IVERT=1,M%CUT_FACE(IFCX)%CFELEM(1,JFCX) - IV=M%CUT_FACE(IFCX)%CFELEM(IVERT+1,JFCX) - XYZV(IAXIS:KAXIS) =M%CUT_FACE(IFCX)%XYZVERT(IAXIS:KAXIS,IV) - CALL INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,M%CUT_FACE(IFC1)%NVERT,INOD,M%CUT_FACE(IFC1)%XYZVERT) - COUNT=COUNT+1 - IF(COUNT>SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1)) THEN - ALLOCATE(CEDGES_AUX2(COUNT+1,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED - CEDGES_AUX2(1:COUNT-1,:)=M%CUT_FACE(IFC1)%CFELEM(1:COUNT-1,:) - CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=M%CUT_FACE(IFC1)%CFELEM) + ELSE; NFC_GCR = NFC_GCR + 1 ! External ENDIF - M%CUT_FACE(IFC1)%CFELEM(COUNT,JFC1)=INOD ENDDO - IF (HILO==HIGH_IND) THEN ! Mirror the connectivity, s.t. normal pointing inside: - COUNT=M%CUT_FACE(IFC1)%CFELEM(1,JFC1) - ALLOCATE(CFELEM(COUNT)); CFELEM(1:COUNT) = M%CUT_FACE(IFC1)%CFELEM(COUNT+1:2:-1,JFC1) - M%CUT_FACE(IFC1)%CFELEM(2:COUNT+1,JFC1) = CFELEM(1:COUNT) - DEALLOCATE(CFELEM) - ENDIF - M%CUT_FACE(IFC1)%AREA(JFC1) = M%CUT_FACE(IFCX)%AREA(JFCX) - M%CUT_FACE(IFC1)%XYZCEN(:,JFC1) = M%CUT_FACE(IFCX)%XYZCEN(:,JFCX) - - ! 2. Find cut-cell sharing this CFGAS face (IFCX,JFCX), find where in saids cell FACE_LIST this face is. - ! 3. Change in FACE_LIST -> (/CC_FTYPE_CFGAS,SIDE,MYAXIS,IFCX,JFCX/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/) - ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) - JCC2_LOOP_2 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) - IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_CFGAS .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE2)==IFCX .AND. & - M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE2)==JFCX) THEN - ! Add to FACE_LIST_DROPPED: - M%CUT_CELL(ICC2)%NFACE_DROPPED = M%CUT_CELL(ICC2)%NFACE_DROPPED + 1 - NFCD=0; IF(ALLOCATED(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED)) NFCD=SIZE(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED,DIM=2) - IF(M%CUT_CELL(ICC2)%NFACE_DROPPED>NFCD) THEN - ALLOCATE(FACE_LIST_DROPPED(6,M%CUT_CELL(ICC2)%NFACE_DROPPED)) - IF(NFCD>0) FACE_LIST_DROPPED(1:6,1:NFCD) = M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1:6,1:NFCD) - FACE_LIST_DROPPED(1:6,NFCD+1) = M%CUT_CELL(ICC2)%FACE_LIST(1:6,IFACE2) - CALL MOVE_ALLOC(FROM=FACE_LIST_DROPPED,TO=M%CUT_CELL(ICC2)%FACE_LIST_DROPPED) - ENDIF - ! Now write CC_FTYPE_CFINB entry: - M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) - M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1) =(/CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) - IF(INZONE) THEN - M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 - M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 - ENDIF - EXIT JCC2_LOOP_2 + ENDDO +ENDDO +! JAXIS cut-faces: +X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS +DO K=-1,M%KBAR+2 + DO J=-2,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%JBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External + ELSEIF(J==0 .OR. J==M%JBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary ENDIF - ENDDO - ENDDO JCC2_LOOP_2 - END SELECT - -ENDDO IFC_LOOP + ELSE; NFC_GCR = NFC_GCR + 1 ! External + ENDIF + ENDDO + ENDDO +ENDDO +! KAXIS cut-faces: +X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS +DO K=-2,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%KBAR) THEN; NFC_GCR = NFC_GCR + 1 ! External + ELSEIF(K==0 .OR. K==M%KBAR) THEN; NFC_BND = NFC_BND + 1 ! Block boundary + ENDIF + ELSE; NFC_GCR = NFC_GCR + 1 ! External + ENDIF + ENDDO + ENDDO +ENDDO -IF(INZONE) THEN - DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE - IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) - JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) - M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) = M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) + M%CUT_FACE(IFC1)%AREA(JFC1) +! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): +DO K=-CCGUARD,M%KBAR+CCGUARD + DO J=-CCGUARD,M%JBAR+CCGUARD + DO I=-CCGUARD,M%IBAR+CCGUARD + FCINDEX = M%CCVAR(I,J,K,CC_IDCF) + IF(M%CCVAR(I,J,K,CC_IDCF)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(M%CCVAR(I,J,K,CC_IDCF)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + M%CCVAR(I,J,K,CC_IDCF) = FCINDEX + DO X1AXIS=IAXIS,KAXIS + FCINDEX = M%FCVAR(I,J,K,CC_IDCF,X1AXIS) + IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(M%FCVAR(I,J,K,CC_IDCF,X1AXIS)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = FCINDEX + ENDDO + ENDDO ENDDO - DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE - IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) - JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) - M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)= & - M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)*M%INBCF_AREA(I,J,K)%AINB(JCC)/M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) +ENDDO +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC => M%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + SELECT CASE(CC%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_RCGAS); CYCLE + CASE DEFAULT + FCINDEX = CC%FACE_LIST(4,IFACE) + IF(CC%FACE_LIST(4,IFACE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(CC%FACE_LIST(4,IFACE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + CC%FACE_LIST(4,IFACE) = FCINDEX + END SELECT + ENDDO ENDDO -ENDIF +ENDDO +DO ICE=1,M%N_CUTEDGE_MESH + CE=>M%CUT_EDGE(ICE) + DO IEDGE=1,CE%NEDGE + DO ILOC=-2,2 + FCINDEX = CE%FACE_LIST(1,ILOC,IEDGE) + IF(CE%FACE_LIST(1,ILOC,IEDGE)>NBD_MESH) FCINDEX = FCINDEX + NFC_BND + IF(CE%FACE_LIST(1,ILOC,IEDGE)>NCF_MESH) FCINDEX = FCINDEX + NFC_MSH + CE%FACE_LIST(1,ILOC,IEDGE) = FCINDEX + ENDDO + ENDDO +ENDDO -ELSEIF(BLOCK_PHASE==2) THEN BLOCK_PHASE_IF +! Reallocate CUT_FACE: +ALLOCATE(CUT_FACE_AUX( MAX(SIZE(MESHES(NM)%CUT_FACE,DIM=1), NCF_MESH+NFC_BND+NFC_MSH + NGF_MESH+NFC_GCR ) )) +CUT_FACE_AUX(1:NBD_MESH) = M%CUT_FACE(1:NBD_MESH) +CUT_FACE_AUX(NBD_MESH+NFC_BND+1:NCF_MESH+NFC_BND) = M%CUT_FACE(NBD_MESH+1:NCF_MESH) +CUT_FACE_AUX(NCF_MESH+NFC_BND+NFC_MSH+1:NCF_MESH+NFC_BND+NFC_MSH+NGF_MESH) = M%CUT_FACE(NCF_MESH+1:NCF_MESH+NGF_MESH) +CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE); M => MESHES(NM) -! Drop Edges and Faces: -IFC_LOOP_2 : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) - HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND - ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND - ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND - X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) - IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) +! Finally, add new cut-faces: +CT_BND = 0 +CT_MSH = 0 +CT_GCR = 0 +! IAXIS cut-faces: +X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-2,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%IBAR) THEN ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ELSEIF(I==0 .OR. I==M%IBAR) THEN ! Block boundary + CT_BND = CT_BND + 1 + IFC = NBD_MESH + CT_BND + ENDIF + ELSE ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ENDIF + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XFACE(I), YCELL(J), ZCELL(K) /); AREA(1) = DYCELL(J)*DZCELL(K) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I,J,K-1,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I,J ,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I,J,K ,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I,J-1,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC + M%CUT_FACE(IFC)%STATUS = CC_GASPHASE + M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) + ENDDO + ENDDO +ENDDO - FACE_TYPE_IF_2 : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & - M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN +! JAXIS cut-faces: +X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-2,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%JBAR) THEN ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ELSEIF(J==0 .OR. J==M%JBAR) THEN ! Block boundary + CT_BND = CT_BND + 1 + IFC = NBD_MESH + CT_BND + ENDIF + ELSE ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ENDIF + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC + M%CUT_FACE(IFC)%STATUS = CC_GASPHASE + M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) + ENDDO + ENDDO +ENDDO - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN - LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) - HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) - LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) - HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) - IF(LOWI>0 .AND. LOWJ>0) THEN - IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. & ! This is to drop this cut-face on the second hit. - M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0 .AND. M%CUT_FACE(IFCX)%SHARED(JFCX)) THEN - M%CUT_FACE(IFCX)%SHARED(JFCX) =.FALSE. - CYCLE IFC_LOOP_2 +! KAXIS cut-faces: +X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS +DO K=-2,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1; IF(CT<1) CYCLE + IF(0M%KBAR) THEN ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR + ELSEIF(K==0 .OR. K==M%KBAR) THEN ! Block boundary + CT_BND = CT_BND + 1 + IFC = NBD_MESH + CT_BND ENDIF + ELSE ! External + CT_GCR = CT_GCR + 1 + IFC = NCF_MESH + NFC_BND + NFC_MSH + NGF_MESH + CT_GCR ENDIF - ENDIF - - SELECT CASE(X1AXIS) - CASE(IAXIS); II=I+ILH; JJ=J; KK=K - CASE(JAXIS); II=I; JJ=J+ILH; KK=K - CASE(KAXIS); II=I; JJ=J; KK=K+ILH - END SELECT - IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP_2 - - ENDIF FACE_TYPE_IF_2 - - SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) - CASE(CC_FTYPE_RCGAS) - ! 4. Make FCVAR(I,J,K,CC_CGSC,X1AXIS)=CC_SOLID, ECVAR and VERTVAR CC_SOLID where corresponds: - CALL DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) - CASE(CC_FTYPE_CFGAS) - ! Drop Face and Edges test: - DROP_FACE=.FALSE. - ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: - LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) - HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) - LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) - HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) - IF(LOWI>0 .AND. LOWJ>0) THEN - IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) THEN - DROP_FACE=.TRUE. - M%CUT_FACE(IFCX)%SHARED(JFCX) =.TRUE. - ENDIF + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + M%FCVAR(I,J,K,CC_FGSC,X1AXIS) = CC_CUTCFE + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = IFC + M%CUT_FACE(IFC)%STATUS = CC_GASPHASE + M%CUT_FACE(IFC)%IJK(1:4) = (/I, J, K, X1AXIS/) + ENDDO + ENDDO +ENDDO - ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) - JCC2_LOOP_3 : DO IFACE2=1,M%CUT_CELL(ICC2)%NFACE_DROPPED - IF(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & - M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(4,IFACE2)==IFCX .AND. & - M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(5,IFACE2)==JFCX) THEN - DROP_FACE=.TRUE. - EXIT JCC2_LOOP_3 - ENDIF - ENDDO JCC2_LOOP_3 - - DROP_FACE_IF : IF (DROP_FACE) THEN - SELECT CASE(X1AXIS) - CASE(IAXIS) - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - IF(AXISF==KAXIS) THEN - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J ; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ELSEIF(AXISF==JAXIS) THEN - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I+ILHF; JEG=J-1; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ENDIF - CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! Drop edge JCE: - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - END SELECT - ENDDO - - CASE(JAXIS) - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - IF(AXISF==KAXIS) THEN - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J+ILHF; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I; JEG=J+ILHF; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ELSEIF(AXISF==IAXIS) THEN - AXISE=KAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I ; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ENDIF - CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! Drop edge JCE: - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - END SELECT - ENDDO - CASE(KAXIS) - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge - LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - IF(AXISF==IAXIS) THEN - AXISE=JAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I-1; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I ; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ELSEIF(AXISF==JAXIS) THEN - AXISE=IAXIS - IF(LOHIE==LOW_IND) THEN - IEG=I; JEG=J-1; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ELSE - IEG=I; JEG=J ; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID - ENDIF - ENDIF - CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - ! Drop edge JCE: - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - END SELECT - ENDDO - END SELECT - - ! Drop (IFCX,JFCX) from CUT_FACE(IFCX): - CALL DROP_CUTFACE(NM,CC_FTYPE_CFGAS,I,J,K,ILHF,X1AXIS,IFCX,JFCX) - ENDIF DROP_FACE_IF - CASE(CC_FTYPE_CFINB) - - ! Drop cut-edges whithin the Cartesian cell I,J,K that belong to this INBOUNDARY cut-face: - DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) - CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) - IF(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)/=CC_ETYPE_CFINB) CYCLE - ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) - JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) - AXISE=M%CUT_EDGE(ICE)%IJK(4) - IF(AXISE>0) CYCLE - CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) - ENDDO - - ! Scheme: - ! 1. Drop (IFC2,JFC2) from CUT_FACE(IFC2). Note this changes the face arrays, so FACE_LIST face indexes - ! for cut-cells on this CUT_CELL(ICC) entry need to be updated. - CALL DROP_CUTFACE(NM,CC_FTYPE_CFINB,I,J,K,ILHF,X1AXIS,IFCX,JFCX) - - END SELECT +M%N_BBCUTFACE_MESH = NBD_MESH + NFC_BND +M%N_CUTFACE_MESH = NCF_MESH + NFC_BND + NFC_MSH +M%N_GCCUTFACE_MESH = NGF_MESH + NFC_GCR -ENDDO IFC_LOOP_2 +ELSE -ELSEIF(BLOCK_PHASE==3) THEN BLOCK_PHASE_IF +! IAXIS cut-faces: +X1AXIS=IAXIS; X2AXIS=JAXIS; X3AXIS=KAXIS +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-2,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + ! Insert cut-face in CUT_FACE array: + CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I), YFACE(J ), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I), YFACE(J ), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I), YFACE(J-1), ZFACE(K ) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XFACE(I), YCELL(J), ZCELL(K) /); AREA(1) = DYCELL(J)*DZCELL(K) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I,J,K-1,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I,J ,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I,J,K ,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I,J-1,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + ENDDO + ENDDO +ENDDO -! At this point all faces defining the ICC,JCC cut-cell have been dropped in the CUT_FACE, CUT_CELL trees. -! We can drop JCC from CUT_CELL(ICC)%CCELEM, etc. -CALL DROP_CUTCELL(NM,ICC,JCC) +! JAXIS cut-faces: +X1AXIS=JAXIS; X2AXIS=KAXIS; X3AXIS=IAXIS +DO K=-1,MESHES(NM)%KBAR+2 + DO J=-2,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I,J,K-1:K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + ! Insert cut-face in CUT_FACE array: + CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J), ZFACE(K-1) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I-1), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J), ZFACE(K ) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I ), YFACE(J), ZFACE(K-1) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YFACE(J), ZCELL(K) /); AREA(1) = DXCELL(I)*DZCELL(K) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I,J,K ,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K ,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I,J,K-1,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J,K-1,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + ENDDO + ENDDO +ENDDO -ENDIF BLOCK_PHASE_IF +! KAXIS cut-faces: +X1AXIS=KAXIS; X2AXIS=IAXIS; X3AXIS=JAXIS +DO K=-2,MESHES(NM)%KBAR+2 + DO J=-1,MESHES(NM)%JBAR+2 + DO I=-1,MESHES(NM)%IBAR+2 + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)/=CC_GASPHASE) CYCLE + ! Test if there are cut-edges in ECVAR: + CT=0 + IF(ANY(M%ECVAR(I-1:I,J,K,CC_EGSC,X3AXIS)==CC_CUTCFE)) CT=CT+1 + IF(ANY(M%ECVAR(I,J-1:J,K,CC_EGSC,X2AXIS)==CC_CUTCFE)) CT=CT+1 + IF(CT<1) CYCLE + ! Insert cut-face in CUT_FACE array: + CALL INSERT_CUT_FACE(NM,I,J,K,X1AXIS,IFC); M => MESHES(NM) + CALL FACE_DEALLOC(NM,IFC); CALL NEW_FACE_ALLOC(NM,IFC,0,1,5) + ! Define XYZVERT, CFELEM, XYZCEN, AREA, CEDGES, EDGE_LIST: + ALLOCATE(XYZVERT(IAXIS:KAXIS,4)) + XYZVERT(IAXIS:KAXIS,NOD1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD3) = (/ XFACE(I ), YFACE(J ), ZFACE(K) /) + XYZVERT(IAXIS:KAXIS,NOD4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K) /) + ALLOCATE(CFELEM(5,1),CEDGES(5,1)) + CFELEM(1:5,1) = (/4, 1, 2, 3, 4/); CEDGES(1:5,1) = CFELEM(1:5,1) + ALLOCATE(XYZCEN(IAXIS:KAXIS,1),AREA(1)) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZFACE(K) /); AREA(1) = DXCELL(I)*DYCELL(J) + ALLOCATE(EDGE_LIST(3,0:4)); EDGE_LIST(:,0) = CC_UNDEFINED + CEIF= M%FCVAR(I,J,K,CC_IDCE,X1AXIS) + EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_RGGAS, LOW_IND,X3AXIS/) ! Edge 1-2: + CEI = M%ECVAR(I,J-1,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J-1,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG1) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_RGGAS,HIGH_IND,X2AXIS/) ! Edge 2-3: + CEI = M%ECVAR(I ,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I ,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG2) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_RGGAS,HIGH_IND,X3AXIS/) ! Edge 3-4: + CEI = M%ECVAR(I,J ,K,CC_IDCE,X2AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I,J ,K,CC_EGSC,X2AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG3) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_RGGAS, LOW_IND,X2AXIS/) ! Edge 4-1: + CEI = M%ECVAR(I-1,J,K,CC_IDCE,X3AXIS) + IF (CEI>0) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFGAS,CEI ,EDG1/) + ELSEIF(M%ECVAR(I-1,J,K,CC_EGSC,X3AXIS)==CC_SOLID) THEN; EDGE_LIST(1:3,EDG4) = (/CC_ETYPE_CFINB,CEIF,EDG1/) + ENDIF + M%CUT_FACE(IFC)%NVERT = 4 + M%CUT_FACE(IFC)%NFACE = 1 + CALL MOVE_ALLOC(FROM=AREA, TO=M%CUT_FACE(IFC)%AREA) + CALL MOVE_ALLOC(FROM=XYZCEN,TO=M%CUT_FACE(IFC)%XYZCEN) + CALL MOVE_ALLOC(FROM=XYZVERT,TO=M%CUT_FACE(IFC)%XYZVERT) + CALL MOVE_ALLOC(FROM=CFELEM,TO=M%CUT_FACE(IFC)%CFELEM) + CALL MOVE_ALLOC(FROM=CEDGES,TO=M%CUT_FACE(IFC)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST,TO=M%CUT_FACE(IFC)%EDGE_LIST) + ENDDO + ENDDO +ENDDO -RETURN -END SUBROUTINE BLOCK_CUT_CELL +ENDIF +END SUBROUTINE GET_REMAINING_CUTFACES -! ------------------------------ ADD_CUTEDGE_TO_FACE -------------------------------- +! ---------------------- CUT_CELL_FACE_ARRAYS_CLEANUP ----------------------------- -SUBROUTINE ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IEC2,JEC2,IFC,JFC,KFC,X1AXFC) +SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP(NM) -INTEGER, INTENT(IN) :: NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IFC,JFC,KFC,X1AXFC -INTEGER, INTENT(OUT):: IEC2,JEC2 +INTEGER, INTENT(IN) :: NM -! Local variables: -INTEGER :: INOD1,INOD2,VL1(1:4),VL2(1:4),NVERT,NEDGE,IEDGE -INTEGER, ALLOCATABLE :: EDGE_LIST_AUX(:,:) -REAL(EB):: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) +INTEGER, ALLOCATABLE, DIMENSION(:) :: CCIND,CFIND,AUXV +INTEGER :: I,J,K,X1AXIS,ICC,JCC,IFC,IFACE,ICF,JCF,IFC1,CT,CTC,CTF,ILH,& + N_CUTCELL_MESH_NEW,N_GCCUTCELL_MESH_NEW,N_CUTFACE_MESH_NEW,N_GCCUTFACE_MESH_NEW,N_BBCUTFACE_MESH_NEW,& + NEDG,IEDG,LOHI,DIR,ICE TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTFACE_TYPE), POINTER :: CF -IEDGE=JCF2 ! Dummy for now FACE_LIST not filled for ETYPE_CFINB edges. - -M =>MESHES(NM) -IEC2=M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) -IF(IEC2<1) THEN ! Allocate space for CFINB cut-edge on this cut-face. - - ! Allocate space for cut-edge in CUT_EDGE: - IEC2 = M%N_CUTEDGE_MESH + 1 - M%N_CUTEDGE_MESH = IEC2 - M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = IEC2 - CALL CUT_EDGE_ARRAY_REALLOC(NM,IEC2) - M%CUT_EDGE(IEC2)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,IEC2,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - M%CUT_EDGE(IEC2)%NEDGE = 0 - M%CUT_EDGE(IEC2)%NEDGE1 = 0 - M%CUT_EDGE(IEC2)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. - M%CUT_EDGE(IEC2)%STATUS = CC_INBOUNDCF - ALLOCATE(M%CUT_EDGE(IEC2)%DXX(1:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%DXX = 0._EB - ALLOCATE(M%CUT_EDGE(IEC2)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(IEC2)%CEELEM,DIM=2))); M%CUT_EDGE(IEC2)%FACE_LIST = CC_UNDEFINED - -ENDIF - -! Edge nodes location and type: -INOD1 = M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE) -INOD2 = M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE) -XV1(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD1) -XV2(IAXIS:KAXIS) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,INOD2) -VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD1) ! [CC_VTYPE I J K] -VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,INOD2) - -! Add cut-edge: -NVERT = M%CUT_EDGE(IEC2)%NVERT -CALL REALLOCATE_EDGE_VERT(NM,IEC2,NVERT+2) -CALL INSERT_FACE_VERT(XV1,NM,IEC2,NVERT,INOD1) -CALL INSERT_FACE_VERT(XV2,NM,IEC2,NVERT,INOD2) +M => MESHES(NM) +ALLOCATE(CCIND(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH),CFIND(M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH)); CCIND=0; CFIND=0 -DO NEDGE=1,M%CUT_EDGE(IEC2)%NEDGE - IF( (INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) .OR. & - (INOD2==M%CUT_EDGE(IEC2)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(IEC2)%CEELEM(NOD2,NEDGE)) ) THEN - JEC2=NEDGE; RETURN ! Edge already in Face cut-edges list. - ENDIF +! Count cut-cells and face entries with NCELL, NFACE > 0: +CTC=0; N_CUTCELL_MESH_NEW=0; N_GCCUTCELL_MESH_NEW=0 +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + IF(M%CUT_CELL(ICC)%NCELL<1) CYCLE + CTC=CTC+1 + CCIND(ICC) = CTC + IF (ICC<=M%N_CUTCELL_MESH) THEN; N_CUTCELL_MESH_NEW = N_CUTCELL_MESH_NEW + 1 + ELSE; N_GCCUTCELL_MESH_NEW = N_GCCUTCELL_MESH_NEW + 1; ENDIF +ENDDO +CTF=0; N_CUTFACE_MESH_NEW=0; N_GCCUTFACE_MESH_NEW=0; N_BBCUTFACE_MESH_NEW=0 +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + IF(M%CUT_FACE(ICF)%NFACE<1) CYCLE + CTF=CTF+1 + CFIND(ICF) = CTF + IF (ICF<=M%N_BBCUTFACE_MESH) N_BBCUTFACE_MESH_NEW = N_BBCUTFACE_MESH_NEW + 1 + IF (ICF<=M%N_CUTFACE_MESH) THEN; N_CUTFACE_MESH_NEW = N_CUTFACE_MESH_NEW + 1 + ELSE; N_GCCUTFACE_MESH_NEW = N_GCCUTFACE_MESH_NEW + 1; ENDIF ENDDO -JEC2=NEDGE -CALL REALLOCATE_EDGE_ELEM(NM,IEC2,NEDGE) - -! Check first node type, if gas vertex make it boundary vertex and change VERTVAR to CC_SOLID: -M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = VL1(1:4) -IF(VL1(1)==CC_VTYPE_VGAS) THEN - M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,VL1(2),VL1(3),VL1(4)/) - M%VERTVAR(VL1(2),VL1(3),VL1(4),CC_VGSC) = CC_SOLID -ENDIF -M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = VL2(1:4) -IF(VL2(1)==CC_VTYPE_VGAS) THEN - M%CUT_EDGE(IEC2)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,VL2(2),VL2(3),VL2(4)/) - M%VERTVAR(VL2(2),VL2(3),VL2(4),CC_VGSC) = CC_SOLID -ENDIF - -! Add edge: Assumes XV1 < XV2 in X1AXEG direction: -M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) -IF(ILHF==-1) M%CUT_EDGE(IEC2)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) - -M%CUT_EDGE(IEC2)%NVERT = NVERT -M%CUT_EDGE(IEC2)%NEDGE = NEDGE - -M%CUT_EDGE(IEC2)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) - -! Define Edge as INB CUT_EDGE, find corresponding CFGAS EDGE associated cut-face and replace it -IF(ICF2>0) THEN - ! Reallocate EDGE_LIST if JCE2 exceeds current size - NVERT = 0 - IF(ALLOCATED(M%CUT_FACE(ICF2)%EDGE_LIST)) NVERT = SIZE(M%CUT_FACE(ICF2)%EDGE_LIST,DIM=2)-1 - IF(JCE2 > NVERT) THEN - ALLOCATE(EDGE_LIST_AUX(3,0:JCE2)) - EDGE_LIST_AUX = CC_UNDEFINED - IF(NVERT > 0) EDGE_LIST_AUX(1:3,0:NVERT) = M%CUT_FACE(ICF2)%EDGE_LIST(1:3,0:NVERT) - CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX, TO=M%CUT_FACE(ICF2)%EDGE_LIST) - ENDIF - M%CUT_FACE(ICF2)%EDGE_LIST(1:3,JCE2) = (/CC_ETYPE_CFINB, IEC2, JEC2/) -ENDIF -END SUBROUTINE ADD_CUTEDGE_TO_FACE +! Move Cut-cells to new location, NCELL=0 entries are dropped: +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + IF(M%CUT_CELL(ICC)%NCELL<1 .OR. ICC==CCIND(ICC)) CYCLE + CALL CUT_CELL_MOVE(M%CUT_CELL(ICC),M%CUT_CELL(CCIND(ICC))) +ENDDO +M%N_CUTCELL_MESH = N_CUTCELL_MESH_NEW +M%N_GCCUTCELL_MESH = N_GCCUTCELL_MESH_NEW +! Now Cut-faces: +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + IF(M%CUT_FACE(ICF)%NFACE<1 .OR. ICF==CFIND(ICF)) CYCLE + CALL CUT_FACE_MOVE(M%CUT_FACE(ICF),M%CUT_FACE(CFIND(ICF))) +ENDDO +M%N_CUTFACE_MESH = N_CUTFACE_MESH_NEW +M%N_GCCUTFACE_MESH = N_GCCUTFACE_MESH_NEW +M%N_BBCUTFACE_MESH = N_BBCUTFACE_MESH_NEW -! ------------------------------ ADD_CUTEDGE_TO_EDGE ------------------------------- +! Finally fix ICC and ICF in CCVAR, FCVAR, CELL_LIST and FACE_LIST arrays +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC=>M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS); + M%CCVAR(I,J,K,CC_IDCC) = ICC; + DO JCC=1,CC%NCELL + ALLOCATE(AUXV(CC%CCELEM(1,JCC))); AUXV = 0 + DO IFC=1,CC%CCELEM(1,JCC) + IFACE = CC%CCELEM(IFC+1,JCC) + AUXV(IFC) = 1 + IF ( .NOT.(CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFINB .OR. & + CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) ) CYCLE + IFC1 = CC%FACE_LIST(4,IFACE) + CC%FACE_LIST(4,IFACE) = 0; IF(IFC1>0) CC%FACE_LIST(4,IFACE) = CFIND(IFC1) + IF(CC%FACE_LIST(4,IFACE)<1) AUXV(IFC) = 0 + ENDDO + IFC1=0 + DO IFC=1,CC%CCELEM(1,JCC) + IF(AUXV(IFC)<1) CYCLE + IFC1 = IFC1+1 + CC%CCELEM(IFC1+1,JCC) = CC%CCELEM(IFC+1,JCC) + ENDDO + CC%CCELEM(1,JCC) = SUM(AUXV(:)) + DEALLOCATE(AUXV) + ENDDO + ! Deallocate FACE_LIST_DROPPED + CC%NFACE_DROPPED = 0 + IF(ALLOCATED(CC%FACE_LIST_DROPPED)) DEALLOCATE(CC%FACE_LIST_DROPPED) +ENDDO -SUBROUTINE ADD_CUTEDGE_TO_EDGE(NM,ILHF,IEG,JEG,KEG,X1AXEG,XV1,XV2) +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + CT = HIGH_IND + I = M%CUT_FACE(ICF)%IJK(IAXIS); J = M%CUT_FACE(ICF)%IJK(JAXIS); K = M%CUT_FACE(ICF)%IJK(KAXIS) + X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) + SELECT CASE(M%CUT_FACE(ICF)%STATUS) + CASE(CC_INBOUNDARY) + CT = LOW_IND + M%CCVAR(I,J,K,CC_IDCF) = ICF + CASE(CC_GASPHASE) + M%FCVAR(I,J,K,CC_IDCF,X1AXIS) = ICF + END SELECT + DO JCF=1,M%CUT_FACE(ICF)%NFACE + DO ILH=LOW_IND,CT + IF (M%CUT_FACE(ICF)%CELL_LIST(1,ILH,JCF)==CC_FTYPE_CFGAS) THEN + ICC = M%CUT_FACE(ICF)%CELL_LIST(2,ILH,JCF) + M%CUT_FACE(ICF)%CELL_LIST(2,ILH,JCF) = CCIND(ICC) + ENDIF + ENDDO + ENDDO +ENDDO -INTEGER, INTENT(IN) :: NM,ILHF,IEG,JEG,KEG,X1AXEG -REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) +! Finally, some cut-faces might have regular Edges which are in CUT_EDGE, renumber in EDGE_LIST: +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_GASPHASE) CYCLE + NEDG=SIZE(CF%EDGE_LIST,DIM=2); I=CF%IJK(IAXIS); J=CF%IJK(JAXIS); K=CF%IJK(KAXIS); X1AXIS=CF%IJK(KAXIS+1) + DO IEDG=1,NEDG-1 + IF(CF%EDGE_LIST(1,IEDG)/=CC_ETYPE_RGGAS) CYCLE + LOHI=CF%EDGE_LIST(2,IEDG)-2 ! -1 for LOW_IND, 0 for HIGH_IND + DIR =CF%EDGE_LIST(3,IEDG) + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(DIR==JAXIS) THEN + ICE=M%ECVAR(I,J+LOHI,K,CC_IDCE,KAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ELSEIF(DIR==KAXIS) THEN + ICE=M%ECVAR(I,J,K+LOHI,CC_IDCE,JAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ENDIF + CASE(JAXIS) + IF(DIR==IAXIS) THEN + ICE=M%ECVAR(I+LOHI,J,K,CC_IDCE,KAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ELSEIF(DIR==KAXIS) THEN + ICE=M%ECVAR(I,J,K+LOHI,CC_IDCE,IAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ENDIF + CASE(KAXIS) + IF(DIR==IAXIS) THEN + ICE=M%ECVAR(I+LOHI,J,K,CC_IDCE,JAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ELSEIF(DIR==JAXIS) THEN + ICE=M%ECVAR(I,J+LOHI,K,CC_IDCE,IAXIS) + IF(ICE>0) CF%EDGE_LIST(1:3,IEDG) = (/CC_ETYPE_CFGAS,ICE,1/) + ENDIF + END SELECT + ENDDO +ENDDO -! Local Variables: -INTEGER :: NVERT,INOD1,INOD2,ICF,CEI,NEDGE,NOD1_TYPE,NOD2_TYPE,LOHI,AXIS -TYPE(MESH_TYPE), POINTER :: M +DEALLOCATE(CCIND,CFIND) -M=>MESHES(NM) -IF(M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG)==CC_SOLID) RETURN +RETURN +END SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP -! Define Gas Cut-edge: -CEI = M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) -IF(CEI<1) THEN - ! Allocate space for cut-edge in CUT_EDGE: - CEI = M%N_CUTEDGE_MESH + 1 - M%N_CUTEDGE_MESH = CEI - M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG) = CC_CUTCFE - M%ECVAR(IEG,JEG,KEG,CC_IDCE,X1AXEG) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - M%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - M%CUT_EDGE(CEI)%NEDGE = 0 - M%CUT_EDGE(CEI)%NEDGE1 = 0 - M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+1) = (/ IEG,JEG,KEG,X1AXEG /) ! Gas right to solid left. - M%CUT_EDGE(CEI)%STATUS = CC_GASPHASE - ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB - ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED +! ----------------------- BLOCK_SMALL_UNLINKED_CUTCELLS ---------------------------- -ELSE ! CUT_EDGE - IF(ILHF==-1) THEN - INOD2 = M%CUT_EDGE(CEI)%CEELEM(NOD2,M%CUT_EDGE(CEI)%NEDGE) ! High node of last gas segment. - M%CUT_EDGE(CEI)%VERT_LIST(1,INOD2) = CC_VTYPE_VINB - ELSE - INOD1 = M%CUT_EDGE(CEI)%CEELEM(NOD1,1) ! Low node of first gas segment. - M%CUT_EDGE(CEI)%VERT_LIST(1,INOD1) = CC_VTYPE_VINB - ENDIF - RETURN -ENDIF +SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS(NM,NBLKCELLS) -! Add new cut-edge created from regular edge: -NVERT = M%CUT_EDGE(CEI)%NVERT -CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) -CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) -CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(OUT):: NBLKCELLS -NEDGE = M%CUT_EDGE(CEI)%NEDGE+1 -CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) +INTEGER :: ICC,JCC,I,J,K,IFC,IEC,JEC,IVR,DUM,NSEG,ISEG,JFC,INOD1,INOD2,X1AXIS,COUNT,NCELL +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTFACE_TYPE), POINTER :: CF +TYPE(CC_CUTEDGE_TYPE), POINTER :: CE +CHARACTER(100) :: FILENAME -! Define Vert List for newly defined cut-edge: -IF (ILHF==-1) THEN - NOD1_TYPE = CC_VTYPE_VGAS - NOD2_TYPE = CC_VTYPE_VINB -ELSE - NOD1_TYPE = CC_VTYPE_VINB - NOD2_TYPE = CC_VTYPE_VGAS -ENDIF -SELECT CASE(X1AXEG) -CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG-1,JEG ,KEG /) -CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG-1,KEG /) -CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/NOD1_TYPE,IEG, JEG ,KEG-1/) -END SELECT -M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/NOD2_TYPE,IEG ,JEG ,KEG /) +M => MESHES(NM) +NBLKCELLS = 0 -! Add edge: Assumes XV1 < XV2 in X1AXEG direction: -M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) +IF(DEBUG_SET_CUTCELLS) THEN -M%CUT_EDGE(CEI)%NVERT = NVERT -M%CUT_EDGE(CEI)%NEDGE = NEDGE + ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges1.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH + DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH + CE=>MESHES(NM)%CUT_EDGE(IEC) + WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) + DO IVR=1,CE%NVERT + WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) + ENDDO + DO IVR=1,CE%NVERT + WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC), & + CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) + ENDDO + ENDDO + CLOSE(33) -! There might be cut-faces that note this EDGE as a regular Gas edge, change incidence in their EDGE_LIST: -SELECT CASE(X1AXEG) -CASE(IAXIS) - ! Face at LOC=-2, located at low Z normal to Y axis: - ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC=-1, located at low Y normal to Z axis: - ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 1, located at high Y normal to Z axis: - ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 2, located at high Z normal to Y axis: - ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) -CASE(JAXIS) - ! Face at LOC=-2, located at low X normal to Z axis: - ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,KAXIS); LOHI=HIGH_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC=-1, located at low Z normal to X axis: - ICF=M%FCVAR(IEG,JEG,KEG ,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 1, located at high Z normal to X axis: - ICF=M%FCVAR(IEG,JEG,KEG+1,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=KAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 2, located at high X normal to Z axis: - ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,KAXIS); LOHI= LOW_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) -CASE(KAXIS) - ! Face at LOC=-2, located at low Y normal to X axis: - ICF=M%FCVAR(IEG,JEG ,KEG,CC_IDCF,IAXIS); LOHI=HIGH_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC=-1, located at low X normal to Y axis: - ICF=M%FCVAR(IEG ,JEG,KEG,CC_IDCF,JAXIS); LOHI=HIGH_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! IF(IEG==7 .AND. JEG==4 .AND. KEG==4) THEN - ! WRITE(LU_ERR,*) 'Found EDGE IN CUTEDGE To EDGE IF,JF,KF,AXIS,ICF=',IEG,JEG,KEG,JAXIS,ICF,CEI - ! DO INOD1=1,SIZE(M%CUT_FACE(ICF)%EDGE_LIST,DIM=2)-1 - ! WRITE(LU_ERR,*) M%CUT_FACE(ICF)%EDGE_LIST(:,INOD1) - ! ENDDO - ! ENDIF - ! Face at LOC= 1, located at high X normal to Y axis: - ICF=M%FCVAR(IEG+1,JEG,KEG,CC_IDCF,JAXIS); LOHI= LOW_IND; AXIS=IAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) - ! Face at LOC= 2, located at high Y normal to X axis: - ICF=M%FCVAR(IEG,JEG+1,KEG,CC_IDCF,IAXIS); LOHI= LOW_IND; AXIS=JAXIS - CALL REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,CEI,NEDGE,LOHI,AXIS) -END SELECT + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces1.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH + DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 + IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 + WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) + DO IVR=1,CF%NVERT + WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(I6,I6)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) + DO DUM=1,CF%CFELEM(1,JFC) + WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) + ENDDO + DO DUM=1,CF%CEDGES(1,JFC) + WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) + ENDDO + ENDDO + DO ISEG=1,NSEG + WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) + ENDDO + ENDDO + CLOSE(33) +ENDIF -END SUBROUTINE ADD_CUTEDGE_TO_EDGE +! Create new cut-edges and faces: +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + JCC_LOOP : DO JCC=1,M%CUT_CELL(ICC)%NCELL + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP + NBLKCELLS = NBLKCELLS + 1 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,1) + ENDDO JCC_LOOP + ENDDO + ENDDO +ENDDO -! --------------------------- REPL_CUTEDGE_IN_LIST_EDGES --------------------------- +! Drop cut-edges and faces that were gas or boundary of blocked cells. +COUNT=0 +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + NCELL = M%CUT_CELL(ICC)%NCELL + JCC_LOOP_2 : DO JCC=1,NCELL + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_2 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,2) + ENDDO JCC_LOOP_2 + ENDDO + ENDDO +ENDDO -SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,IEC,JEC,LOHI,AXIS) +! Drop blocked cells: +DO K=-1,M%KBAR+2 + DO J=-1,M%JBAR+2 + DO I=-1,M%IBAR+2 + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF(ICC<1) CYCLE ! No Cut-cell. + NCELL = M%CUT_CELL(ICC)%NCELL + JCC_LOOP_3 : DO JCC=NCELL,1,-1 + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC)<1 .OR. M%CUT_CELL(ICC)%IJK_LINK(1,JCC)/=CC_SOLID) CYCLE JCC_LOOP_3 + CALL BLOCK_CUT_CELL(NM,ICC,JCC,3) + ENDDO JCC_LOOP_3 + ENDDO + ENDDO +ENDDO +! Build remaining Regular shaped GASPHASE cut-faces: +CALL GET_REMAINING_CUTFACES(NM) +! Build remaining Regular shaped GASPHASE cut-cells: +CALL GET_REMAINING_CUTCELLS(NM) +! Clean up CUT_CELL, CUT_FACE arrays: +CALL CUT_CELL_FACE_ARRAYS_CLEANUP(NM) -INTEGER, INTENT(IN) :: NM,ICF,IEC,JEC,LOHI,AXIS -INTEGER :: IEDGE,DUM +IF(DEBUG_SET_CUTCELLS) THEN + ! Write, CUT_EDGE (with node type included), INBOUNDARY and GASPHASE cut-face files: + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedges2.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8)') NM,MESHES(NM)%N_CUTEDGE_MESH + DO IEC=1,MESHES(NM)%N_CUTEDGE_MESH + CE=>MESHES(NM)%CUT_EDGE(IEC) + WRITE(33,'(I6,I6,I6,I6,4I6)') IEC,CE%STATUS,CE%NVERT,CE%NEDGE,CE%IJK(1:4) + DO IVR=1,CE%NVERT + WRITE(33,'(3F18.10)') CE%XYZVERT(IAXIS:KAXIS,IVR) + ENDDO + DO IVR=1,CE%NVERT + WRITE(33,'(4I6)') CE%VERT_LIST(1:4,IVR) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I8,6I8)') CE%CEELEM(NOD1:NOD2,JEC),CE%INDSEG(1:4,JEC) + ENDDO + DO JEC=1,CE%NEDGE + WRITE(33,'(2I6,2I6,2I6,2I6)') CE%FACE_LIST(1:2,-2,JEC),CE%FACE_LIST(1:2,-1,JEC), & + CE%FACE_LIST(1:2, 1,JEC),CE%FACE_LIST(1:2, 2,JEC) + ENDDO + ENDDO + CLOSE(33) -IF(ICF>0) THEN - DUM=0; IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST)) DUM=SIZE(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST,DIM=2) - DO IEDGE=1,DUM-1 - IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE - IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE - IF(MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(3,IEDGE)/=AXIS) CYCLE - MESHES(NM)%CUT_FACE(ICF)%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFGAS,IEC,JEC/) - RETURN + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaces2.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8)') NM,MESHES(NM)%N_BBCUTFACE_MESH,MESHES(NM)%N_CUTFACE_MESH,MESHES(NM)%N_GCCUTFACE_MESH + DO IFC=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH + CF=>MESHES(NM)%CUT_FACE(IFC); NSEG=0 + IF(ALLOCATED(CF%EDGE_LIST)) NSEG=SIZE(CF%EDGE_LIST,DIM=2); IF(CF%STATUS==CC_GASPHASE) NSEG=NSEG-1 + WRITE(33,'(I6,I6,I6,I6,I6,4I6)') IFC,CF%STATUS,CF%NVERT,CF%NFACE,NSEG,CF%IJK(1:4) + DO IVR=1,CF%NVERT + WRITE(33,'(3F18.10)') CF%XYZVERT(IAXIS:KAXIS,IVR) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(I8,I8)') CF%CFELEM(1,JFC),CF%CEDGES(1,JFC) + DO DUM=1,CF%CFELEM(1,JFC) + WRITE(33,'(I6)') CF%CFELEM(DUM+1,JFC) + ENDDO + DO DUM=1,CF%CEDGES(1,JFC) + WRITE(33,'(I6)') CF%CEDGES(DUM+1,JFC) + ENDDO + ENDDO + DO ISEG=1,NSEG + WRITE(33,'(3I6)') CF%EDGE_LIST(1:3,ISEG) + ENDDO + DO JFC=1,CF%NFACE + WRITE(33,'(4I6,4I6)') CF%CELL_LIST(1:4,LOW_IND,JFC),CF%CELL_LIST(1:4,HIGH_IND,JFC) + ENDDO ENDDO -ENDIF -END SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES + CLOSE(33) -! ------------------------------ ADD_REGEDGE_TO_FACE ------------------------------- + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeECVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%ECVAR(I,J,K,CC_EGSC,IAXIS), & + M%ECVAR(I,J,K,CC_EGSC,JAXIS),M%ECVAR(I,J,K,CC_EGSC,KAXIS) + DO X1AXIS=IAXIS,KAXIS + IF(M%ECVAR(I,J,K,CC_EGSC,X1AXIS)==CC_CUTCFE)THEN + IEC=M%ECVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) + IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT EDGE does not match ECVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE + DO JEC=1,CE%NEDGE + INOD1=CE%CEELEM(NOD1,JEC) + INOD2=CE%CEELEM(NOD2,JEC) + WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) + WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) + IF(CE%VERT_LIST(1,INOD1)==CE%VERT_LIST(1,INOD2) .AND. & + CE%VERT_LIST(2,INOD1)==CE%VERT_LIST(2,INOD2) .AND. & + CE%VERT_LIST(3,INOD1)==CE%VERT_LIST(3,INOD2) .AND. & + CE%VERT_LIST(4,INOD1)==CE%VERT_LIST(4,INOD2)) THEN + IF(CE%VERT_LIST(1,INOD1)/=CC_VTYPE_NINB) & + WRITE(LU_ERR,*) 'Edge with same node types=',IEC,JEC,CE%NEDGE,CE%XYZVERT(:,INOD1), & + CE%XYZVERT(:,INOD2),CE%VERT_LIST(1:4,INOD1) + ENDIF + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CLOSE(33) -SUBROUTINE ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD,XV1,XV2,CEI,NEDGE,IV_LIST) + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutedgeFCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + DO X1AXIS=IAXIS,KAXIS + IF(M%FCVAR(I,J,K,CC_IDCE,X1AXIS)>0)THEN + IEC=M%FCVAR(I,J,K,CC_IDCE,X1AXIS); CE=>M%CUT_EDGE(IEC) + IF(CE%IJK(IAXIS)/=I .OR. CE%IJK(JAXIS)/=J .OR. CE%IJK(KAXIS)/=K .OR. CE%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT EDGE does not match FCVAR',I,J,K,X1AXIS,':',CE%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CE%IJK(1:4),CE%NEDGE + DO JEC=1,CE%NEDGE + INOD1=CE%CEELEM(NOD1,JEC) + INOD2=CE%CEELEM(NOD2,JEC) + WRITE(33,'(I8,3F16.8,3F16.8)') CE%IJK(4),CE%XYZVERT(:,INOD1),CE%XYZVERT(:,INOD2) + WRITE(33,'(I8,I8,A,4I8,4I8)') CE%IJK(4),JEC,';',CE%VERT_LIST(1:4,INOD1),CE%VERT_LIST(1:4,INOD2) + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CLOSE(33) -! ILHF -1 face in low side of edge, 0 face on high side of edge. + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaceFCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8,I8,I8)') I,J,K,M%FCVAR(I,J,K,CC_FGSC,IAXIS), & + M%FCVAR(I,J,K,CC_FGSC,JAXIS),M%FCVAR(I,J,K,CC_FGSC,KAXIS) + DO X1AXIS=IAXIS,KAXIS + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)==CC_CUTCFE)THEN + IEC=M%FCVAR(I,J,K,CC_IDCF,X1AXIS); CF=>M%CUT_FACE(IEC) + IF(CF%IJK(IAXIS)/=I .OR. CF%IJK(JAXIS)/=J .OR. CF%IJK(KAXIS)/=K .OR. CF%IJK(KAXIS+1)/=X1AXIS) & + WRITE(LU_ERR,*) 'CUT FACE does not match FCVAR',I,J,K,X1AXIS,':',CF%IJK(IAXIS:KAXIS+1) + WRITE(33,'(I8,I8,I8,I8,I8)') CF%IJK(1:4),CF%NFACE + DO JEC=1,CF%NFACE + WRITE(33,'(I8,3F16.8,F16.8)') CF%IJK(4),CF%XYZCEN(:,JEC),CF%AREA(JEC) + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CLOSE(33) -INTEGER, INTENT(IN) :: NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD -REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) -INTEGER, INTENT(OUT):: CEI,NEDGE -LOGICAL, INTENT(IN) :: IV_LIST + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutcellCCVAR.dat' + OPEN(UNIT=33, file=TRIM(FILENAME), status='unknown') + WRITE(33,'(I8,I8,I8,I8,I8,I8,I8)') NM,0,M%IBAR+1,0,M%JBAR+1,0,M%KBAR+1 + DO K=0,M%KBAR+1 + DO J=0,M%JBAR+1 + DO I=0,M%IBAR+1 + WRITE(33,'(I8,I8,I8,I8)') I,J,K,M%CCVAR(I,J,K,CC_CGSC) + IF(M%CCVAR(I,J,K,CC_CGSC)==CC_CUTCFE)THEN + IEC=M%CCVAR(I,J,K,CC_IDCC); CC=>M%CUT_CELL(IEC) + IF(CC%IJK(IAXIS)/=I .OR. CC%IJK(JAXIS)/=J .OR. CC%IJK(KAXIS)/=K) & + WRITE(LU_ERR,*) 'CUT CELL does not match CCVAR',I,J,K,':',CC%IJK(IAXIS:KAXIS) + WRITE(33,'(I8,I8,I8,I8,I8)') CC%IJK(1:3),CC%NCELL + DO JEC=1,CC%NCELL + WRITE(33,'(I8,3F16.8,F16.8)') JEC,CC%XYZCEN(:,JEC),CC%VOLUME(JEC) + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + CLOSE(33) +ENDIF -! Local Variables: -INTEGER :: NVERT,INOD1,INOD2,ICF,IEDGE,LOHI -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTFACE_TYPE), POINTER :: CF +RETURN +END SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS -M=>MESHES(NM) -IF(M%FCVAR(IFC,JFC,KFC,CC_FGSC,X1AXFC)==CC_SOLID) RETURN +! ---------------------------- BLOCK_CUT_CELL ------------------------------------- -! Define Edge as INB cut-edge, add to CUT_EDGE: -CEI = M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) -IF (CEI < 1) THEN - ! Allocate space for cut-edge in CUT_EDGE: - CEI = M%N_CUTEDGE_MESH + 1 - M%N_CUTEDGE_MESH = CEI - M%FCVAR(IFC,JFC,KFC,CC_IDCE,X1AXFC) = CEI - CALL CUT_EDGE_ARRAY_REALLOC(NM,CEI) - M%CUT_EDGE(CEI)%NVERT = 0 - CALL NEW_EDGE_ALLOC(NM,CEI,CC_ALLOC_DVERT,CC_ALLOC_DELEM) - M%CUT_EDGE(CEI)%NEDGE = 0 - M%CUT_EDGE(CEI)%NEDGE1 = 0 - M%CUT_EDGE(CEI)%IJK(1:MAX_DIM+2) = (/ IFC,JFC,KFC,X1AXFC,CC_GS /) ! Gas right to solid left. - M%CUT_EDGE(CEI)%STATUS = CC_INBOUNDCF - ALLOCATE(M%CUT_EDGE(CEI)%DXX(1:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%DXX = 0._EB - ALLOCATE(M%CUT_EDGE(CEI)%FACE_LIST(1:3,-2:2,SIZE(M%CUT_EDGE(CEI)%CEELEM,DIM=2))); M%CUT_EDGE(CEI)%FACE_LIST = CC_UNDEFINED -ENDIF +SUBROUTINE BLOCK_CUT_CELL(NM,ICC,JCC,BLOCK_PHASE) + +! 1. Find Body and triangle with largest boundary cut-face area in cut-cell ICC,JCC. +! 2. Loop on faces of ICC,JCC (IFC_LOOP): +! a. If face is regular face, define it as Boundary cut-face of cell sharing it with ICC,JCC. +! a1. Make space for all surrounding Cartesian cells that will turn into cut-cells. +! a2. Make space for CFINB cut-edges and cut-faces in cell sharing with ICC,JCC, define cut-cell in said +! Cartesian cell. +! a3. Drop regular face, set FCVAR, ECVAR for edges involved => SOLID. Make VERTVAR for vertices involved SOLID. +! b. If face is type CFGAS. +! b1. Make space for all surrounding Cartesain cells that will turn into cut-cells. +! b2. Make space for CFINB cut-edges and cut-faces in CUT_CELL sharing with ICC,JCC. +! b3. Add INB cut-face to surrounding cut-cell, drop regular face, set FCVAR, ECVAR for edges involved => SOLID. +! Make VERTVAR for vertices involved SOLID. -! Add cut-edge: -NVERT = M%CUT_EDGE(CEI)%NVERT -CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT+2) -CALL INSERT_FACE_VERT(XV1,NM,CEI,NVERT,INOD1) -CALL INSERT_FACE_VERT(XV2,NM,CEI,NVERT,INOD2) +INTEGER, INTENT(IN) :: NM,ICC,JCC,BLOCK_PHASE -DO NEDGE=1,M%CUT_EDGE(CEI)%NEDGE - IF( (INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) .OR. & - (INOD2==M%CUT_EDGE(CEI)%CEELEM(NOD1,NEDGE) .AND. INOD1==M%CUT_EDGE(CEI)%CEELEM(NOD2,NEDGE)) ) THEN - RETURN ! Edge already in Face cut-edges list. - ENDIF -ENDDO -CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) +INTEGER :: I,J,K,II,JJ,KK,IFC,IFC1,JFC1,IFACE,LOHI,ILH,X1AXIS,NSVERT,NSFACE,NVERTFACE_NEW,COUNT,DUM,IBOD,ITRI,& + HILO,ILHF,ICC2,JCC2,IFC2,IFACE2,IFCX,JFCX,IV,IVERT,MAXVERTS,INOD,INDFC(1:4),ICCNXT,& + IADD,JADD,KADD,EDGE_LIST_REG(1:3,1:4),DIMCE(2),IEDGE,CEI,LOHIE,AXISF,AXISE,LOWI,HIGI,LOWJ,HIGJ,LOWK,HIGK,& + IEG,JEG,KEG,ICE,JCE,ICF2,JCF2,JCE2,IEC2,JEC2,VL1(4),VL2(4),NFCD,IFCIN,JFCIN,KFCIN,X1AXIN,SZDUM +REAL(EB):: XYZV(IAXIS:KAXIS),XYZVERT(MAX_DIM,4) +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BODTRI,EDGE_LIST_AUX,CEDGES_AUX,CEDGES_AUX2,FACE_LIST_DROPPED +INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM +REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA +LOGICAL :: REALLOC_FLG, NEW_FACE_FLG, DROP_FACE, INZONE +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_INBCF_AREA_TYPE), POINTER :: INBCF_AREA +M => MESHES(NM) -SELECT CASE(X1AXEG) -CASE(IAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG-1,JEG ,KEG /) -CASE(JAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG-1,KEG /) -CASE(KAXIS); M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD1) = (/CC_VTYPE_VINB,IEG, JEG ,KEG-1/) -END SELECT -M%CUT_EDGE(CEI)%VERT_LIST(1:4,INOD2) = (/CC_VTYPE_VINB,IEG ,JEG ,KEG /) -IF(IV_LIST) THEN - ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: - M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) - IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) +I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS); +! Find Body and triangle to associate to the cell to be blocked: +IBOD = 0; ITRI = 0 +COUNT= 0; DUM = 0 +DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 +ENDDO +IF (COUNT>0) THEN + ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 + DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE + DO DUM=1,COUNT + IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & + BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT + ENDDO + IF(DUM > COUNT) THEN ! No match in previous loop DUM=COUNT+1 + BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) + COUNT = DUM + ENDIF + AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) + ENDDO + IF (COUNT>0) THEN + ! Now set IBOD, ITRI + DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. + IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) + ENDIF + DEALLOCATE(BODTRI,AREA) ELSE - ! Add edge: Assumes XV1 < XV2 in X1AXEG direction, note edge connectivity is such that: - M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) - IF(ILHF==-1) M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD2,INOD1/) + ! Look in surrounding cells: + DO KK=K-1,K+1 + DO JJ=J-1,J+1 + DO II=I-1,I+1 + ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) + IF (ICC2>0) THEN + DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) + IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 + ENDDO + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + IF (COUNT>0) THEN + ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 + DO KK=K-1,K+1 + DO JJ=J-1,J+1 + DO II=I-1,I+1 + ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) + IF (ICC2>0) THEN + DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) + IFC1 = M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE) + JFC1 = M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE) + IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE + DO DUM=1,COUNT + IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & + BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT + ENDDO + IF(DUM > COUNT) THEN + BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) + COUNT = DUM + ENDIF + AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) + ENDDO + ENDDO + ENDIF + ENDDO + ENDDO + ENDDO + IF (COUNT>0) THEN + ! Now set IBOD, ITRI + DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. + IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) + ENDIF + DEALLOCATE(BODTRI,AREA) + ENDIF ENDIF -M%CUT_EDGE(CEI)%NVERT = NVERT -M%CUT_EDGE(CEI)%NEDGE = NEDGE - -M%CUT_EDGE(CEI)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) +! For cut-cell ICC, JCC run through its boundary faces and generate new boundary EDGES, CUT-FACES and cells: +BLOCK_PHASE_IF : IF(BLOCK_PHASE==1) THEN -ICF = M%FCVAR(IFC,JFC,KFC,CC_IDCF,X1AXFC) -IF (ICF>0) THEN ! There are cut-faces in this face - LOHI= LOW_IND; IF(ILHF==-1) LOHI=HIGH_IND - ! Define Edge as INB CUT_EDGE, find corresponding RGGAS EDGE associated cut-face and replace it - CF=>M%CUT_FACE(ICF); - INOD1=0; IF(ALLOCATED(CF%EDGE_LIST)) INOD1=SIZE(CF%EDGE_LIST,DIM=2) - DO IEDGE=1,INOD1-1 - IF(CF%EDGE_LIST(1,IEDGE)/=CC_ETYPE_RGGAS) CYCLE - IF(CF%EDGE_LIST(2,IEDGE)/=LOHI) CYCLE - IF(CF%EDGE_LIST(3,IEDGE)/=X1AXIS) CYCLE - CF%EDGE_LIST(1:3,IEDGE) =(/CC_ETYPE_CFINB, CEI, NEDGE/) - RETURN +! Add areas of corresponding INB faces: +INZONE = (I>=0 .AND. I<=M%IBP1 .AND. J>=0 .AND. J<=M%JBP1 .AND. K>=0 .AND. K<=M%KBP1) .AND. MY_RANK==PROCESS(NM) +IF(INZONE) THEN + INBCF_AREA => M%INBCF_AREA(I,J,K) + IF(INBCF_AREA%NCELL == 0) THEN + INBCF_AREA%NCELL = M%CUT_CELL(ICC)%NCELL + ALLOCATE(INBCF_AREA%AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%AINB = 0._EB + ALLOCATE(INBCF_AREA%NEW_AINB(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%NEW_AINB = 0._EB + ALLOCATE(INBCF_AREA%SURF_INDEX(M%CUT_CELL(ICC)%NCELL)); INBCF_AREA%SURF_INDEX = 0 + ALLOCATE(INBCF_AREA%IJCF(M%CUT_CELL(ICC)%NCELL)) + ENDIF + IF(IBOD>0) M%INBCF_AREA(I,J,K)%SURF_INDEX(JCC) = GEOMETRY(IBOD)%SURFS(ITRI) + DUM = 0; M%INBCF_AREA(I,J,K)%AINB(JCC) = 0._EB + DO IFC=2,M%CUT_CELL(ICC)%CCELEM(1,JCC)+1 + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC,JCC) + IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_CFINB) + M%INBCF_AREA(I,J,K)%AINB(JCC) = M%INBCF_AREA(I,J,K)%AINB(JCC) + & + M%CUT_FACE(IFC1)%AREA(JFC1)*M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1) + CASE(CC_FTYPE_CFGAS,CC_FTYPE_RCGAS) + DUM=DUM+1 + END SELECT ENDDO + IF(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE>0) THEN + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = 0; + DEALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB) + ENDIF + IF(.NOT.ALLOCATED(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB)) THEN + ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB = 0 + ALLOCATE(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(DUM)); M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB = 0 + ENDIF ENDIF -END SUBROUTINE ADD_REGEDGE_TO_FACE +IFC_LOOP : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) + HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND + ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND + ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND + X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) + IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) + FACE_TYPE_IF : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & + M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN -! --------------------------------- DROP_REG_FACE ------------------------------------------- + ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: + IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN + LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) + HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) + LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) + HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) + IF(LOWI>0 .AND. LOWJ>0) THEN + IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) CYCLE IFC_LOOP + ENDIF + ENDIF -SUBROUTINE DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) + ! If needed reallocate CUT_FACE to accomodate INBOUNDARY face in neighbor cell. + SELECT CASE(X1AXIS) + CASE(IAXIS); II=I+ILH; JJ=J; KK=K + CASE(JAXIS); II=I; JJ=J+ILH; KK=K + CASE(KAXIS); II=I; JJ=J; KK=K+ILH + END SELECT + IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP + ICCNXT=0; IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) ICCNXT=1 -INTEGER, INTENT(IN) :: NM,I,J,K,ILHF,X1AXIS + IFC1 = M%CCVAR(II,JJ,KK,CC_IDCF) ! INBOUNDARY cut-faces in neighbor cartesian cell. + NEW_FACE_FLG = .FALSE. + IF (IFC1 < 1) THEN + ! Insert IFC1: + CALL INSERT_CUT_FACE(NM,II,JJ,KK,0,IFC1,INZONE=INZONE); M => MESHES(NM) ! Make space for INBOUNDARY cut-face + NEW_FACE_FLG = .TRUE. + ENDIF -SELECT CASE(X1AXIS) -CASE(IAXIS) - ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: - MESHES(NM)%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID - MESHES(NM)%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: - MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_EGSC,JAXIS)= CC_SOLID ! X2 - MESHES(NM)%ECVAR(I+ILHF, J , K-1:K,CC_IDCE,JAXIS)= CC_UNDEFINED - MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_EGSC,KAXIS)= CC_SOLID ! X3 - MESHES(NM)%ECVAR(I+ILHF, J-1:J, K ,CC_IDCE,KAXIS)= CC_UNDEFINED - ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: - MESHES(NM)%VERTVAR(I+ILHF, J-1:J, K-1:K,CC_VGSC) = CC_SOLID -CASE(JAXIS) - ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: - MESHES(NM)%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID - MESHES(NM)%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: - MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_EGSC,KAXIS)= CC_SOLID ! X2 - MESHES(NM)%ECVAR( I-1:I,J+ILHF, K ,CC_IDCE,KAXIS)= CC_UNDEFINED - MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_EGSC,IAXIS)= CC_SOLID ! X3 - MESHES(NM)%ECVAR( I ,J+ILHF, K-1:K,CC_IDCE,IAXIS)= CC_UNDEFINED - ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: - MESHES(NM)%VERTVAR( I-1:I,J+ILHF, K-1:K,CC_VGSC) = CC_SOLID -CASE(KAXIS) - ! SET FCVAR FGSC to SOLID, IDCF to UNDEFINED: - MESHES(NM)%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID - MESHES(NM)%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED - ! SET ECVAR for 4 EDGES in FRAME of REG face to SOLID, IDCE to UNDEFINED: - MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_EGSC,IAXIS)= CC_SOLID ! X2 - MESHES(NM)%ECVAR( I , J-1:J,K+ILHF,CC_IDCE,IAXIS)= CC_UNDEFINED - MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_EGSC,JAXIS)= CC_SOLID ! X3 - MESHES(NM)%ECVAR( I-1:I, J ,K+ILHF,CC_IDCE,JAXIS)= CC_UNDEFINED - ! SET VERTVAR CC_VGSC to SOLID on 4 vertices: - MESHES(NM)%VERTVAR( I-1:I, J-1:J,K+ILHF,CC_VGSC) = CC_SOLID -END SELECT + REALLOC_FLG = .FALSE. + NSVERT = 0; NSFACE = 0; + IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) NVERTFACE_NEW = 5 + IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) NVERTFACE_NEW = M%CUT_FACE(IFCX)%CFELEM(1,JFCX)+1 + SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CFELEM)) SZDUM = SIZE(M%CUT_FACE(IFC1)%CFELEM, DIM=1) + IF(SZDUM < NVERTFACE_NEW) REALLOC_FLG = .TRUE. + SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%XYZVERT)) SZDUM = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) + IF(SZDUM < M%CUT_FACE(IFC1)%NVERT+NVERTFACE_NEW-1) THEN + REALLOC_FLG = .TRUE. + NSVERT = NVERTFACE_NEW-1 + ENDIF + SZDUM = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%AREA)) SZDUM = SIZE(M%CUT_FACE(IFC1)%AREA,DIM=1) + IF(SZDUM < M%CUT_FACE(IFC1)%NFACE+1) THEN + REALLOC_FLG = .TRUE. + NSFACE = 1 + ENDIF + JFC1 = M%CUT_FACE(IFC1)%NFACE+1 -END SUBROUTINE DROP_REG_FACE + ! Reallocate CUT_FACE(IFC1) entry: + IF(NEW_FACE_FLG) THEN + CALL FACE_DEALLOC(NM,IFC1); CALL NEW_FACE_ALLOC(NM,IFC1,NSVERT,NSFACE,NVERTFACE_NEW) + ELSEIF(REALLOC_FLG) THEN + CALL FACE_REALLOC(NM,IFC1,M%CUT_FACE(IFC1)%NVERT,M%CUT_FACE(IFC1)%NFACE,NSVERT,NSFACE,NVERTFACE_NEW) + ENDIF + M=>MESHES(NM) + ! Provide GEOM surface information to newly created INBOUNDARY face: + M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) = (/ IBOD, ITRI /) + M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = 0 ! Default surf. + M%CUT_FACE(IFC1)%CFACE_ORIGIN(JFC1) = M%CUT_CELL(ICC)%NOADVANCE(JCC) + IF(IBOD>0) M%CUT_FACE(IFC1)%SURF_INDEX(JFC1) = GEOMETRY(IBOD)%SURFS(ITRI) + M%CUT_FACE(IFC1)%NFACE = JFC1 + ENDIF FACE_TYPE_IF -! --------------------------- INSERT_CUT_CELL ----------------------------------------------- + SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_RCGAS) ! This regular face has to be connecting two small cut-cells. + ! Scheme: + ! 0. Add REG edges as INB cut-edges in corresponding cartesian cut faces. Define normal edges to new INB cut-edge + ! as CFGAS cut-edges. Set VERTVAR to SOLID in EDGE corners: + EDGE_LIST_REG(1:3,1:4) = CC_UNDEFINED; EDGE_LIST_REG(1,1:4) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. + SELECT CASE(X1AXIS) + CASE(IAXIS) + ! First INB cut edges in surrounding faces: + ! I+ILHF location. + ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 + XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) + XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) + ! Edge 1: V1-V2 add to face (I+2*ILHF+1,J ,K-1,KAXIS) + ! side on blocked cell,[I,J,K,X1EDGE], [I,J,K,X1FACE] + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K-1,JAXIS,I+2*ILHF+1,J ,K-1,KAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) + ! Edge 2: V2-V3 add to face (I+2*ILHF+1,J ,K ,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,KAXIS,I+2*ILHF+1,J ,K ,JAXIS,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) + ! Edge 3: V4-V3 add to face (I+2*ILHF+1,J ,K ,KAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J ,K ,JAXIS,I+2*ILHF+1,J ,K ,KAXIS,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) + ! Edge 4: V1-V4 add to face (I+2*ILHF+1,J-1,K ,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I+ILHF,J-1,K ,KAXIS,I+2*ILHF+1,J-1,K ,JAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) -SUBROUTINE INSERT_CUT_CELL(NM,I,J,K,ICC) + ! Second CFGAS cut-edges in edges normal to face: + DO KADD=-1,0 + DO JADD=-1,0 + ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO -! Adds a cut-cell entry ICF in the CUT_CELL array, assumes no cut-cell defined in cell I,J,K. -INTEGER, INTENT(IN) :: NM,I,J,K -INTEGER, INTENT(OUT):: ICC + CASE(JAXIS) + ! J+ILHF location. + ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) + ! Edge 1: V1-V2 add to face (I-1,J+2*ILHF+1,K ,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J+ILHF,K ,KAXIS,I-1,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) + ! Edge 2: V2-V3 add to face (I ,J+2*ILHF+1,K ,KAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,IAXIS,I ,J+2*ILHF+1,K ,KAXIS,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) + ! Edge 3: V4-V3 add to face (I ,J+2*ILHF+1,K ,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K ,KAXIS,I ,J+2*ILHF+1,K ,IAXIS,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) + ! Edge 4: V1-V4 add to face (I ,J+2*ILHF+1,K-1,KAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J+ILHF,K-1,IAXIS,I ,J+2*ILHF+1,K-1,KAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) -INTEGER :: DUM,KDUM,JDUM,IDUM,ICF,JCF + ! Second CFGAS cut-edges in edges normal to face: + DO KADD=-1,0 + DO IADD=-1,0 + ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO -TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX + CASE(KAXIS) + ! K+ILHF location. + ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /) + XYZVERT(:,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /) + XYZVERT(:,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /) + XYZVERT(:,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) + ! Edge 1: V1-V2 add to face (I,J-1,K+2*ILHF+1,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J-1,K+ILHF,IAXIS,I ,J-1,K+2*ILHF+1,JAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_REG(2,1),EDGE_LIST_REG(3,1),IV_LIST=.FALSE.) + ! Edge 2: V2-V3 add to face (I,J ,K+2*ILHF+1,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,JAXIS,I ,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_REG(2,2),EDGE_LIST_REG(3,2),IV_LIST=.TRUE.) + ! Edge 3: V4-V3 add to face (I,J ,K+2*ILHF+1,JAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I ,J ,K+ILHF,IAXIS,I ,J ,K+2*ILHF+1,JAXIS,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_REG(2,3),EDGE_LIST_REG(3,3),IV_LIST=.FALSE.) + ! Edge 4: V1-V4 add to face (I-1,J,K+2*ILHF+1,IAXIS) + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,I-1,J ,K+ILHF,JAXIS,I-1,J ,K+2*ILHF+1,IAXIS,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_REG(2,4),EDGE_LIST_REG(3,4),IV_LIST=.TRUE.) -IF( 0=ICC) & - MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCC) + 1 - ENDDO - ENDDO -ENDDO -DO ICF=1,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH - DO JCF=1,MESHES(NM)%CUT_FACE(ICF)%NFACE - IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF)>ICC) & - MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,LOW_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2, LOW_IND,JCF) + 1 - IF(MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF)>ICC) & - MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) = MESHES(NM)%CUT_FACE(ICF)%CELL_LIST(2,HIGH_IND,JCF) + 1 - ENDDO -ENDDO -MESHES(NM)%CUT_CELL(ICC)%IJK(IAXIS:KAXIS) = (/ I, J, K/) -MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE -MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = ICC + ! 1. Add INBOUNDARY cut-face with size of RGGAS in CUT_FACE for this face (IFC1,JFC1). + DUM = M%CUT_FACE(IFC1)%NVERT + 1 + SELECT CASE(X1AXIS) + CASE(IAXIS) + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) + M%CUT_FACE(IFC1)%AREA(JFC1) = DYCELL(J)*DZCELL(K) + M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XFACE(I+ILHF), YCELL(J), ZCELL(K) /) + CASE(JAXIS) + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) + M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DZCELL(K) + M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YFACE(J+ILHF), ZCELL(K) /) + CASE(KAXIS) + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /); DUM = DUM + 1 + M%CUT_FACE(IFC1)%XYZVERT(IAXIS:KAXIS,DUM) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) + M%CUT_FACE(IFC1)%AREA(JFC1) = DXCELL(I)*DYCELL(J) + M%CUT_FACE(IFC1)%XYZCEN(IAXIS:KAXIS,JFC1) = (/ XCELL(I), YCELL(J), ZFACE(K+ILHF) /) + END SELECT + INDFC(1:4) = (/ 1, 2, 3, 4 /); INDFC = INDFC + M%CUT_FACE(IFC1)%NVERT + M%CUT_FACE(IFC1)%NVERT = DUM -RETURN -END SUBROUTINE INSERT_CUT_CELL + ! All faces connectivities: (/ NNODS, NOD1, NOD2, NOD3, NOD4 /) ! Conn. into gas region of new cell. + IF (LOHI==HIGH_IND) THEN; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(2), INDFC(3), INDFC(4) /) + ELSE; M%CUT_FACE(IFC1)%CFELEM(1:5,JFC1)= (/ 4, INDFC(1), INDFC(4), INDFC(3), INDFC(2) /); ENDIF -! --------------------------- INSERT_CUT_FACE ----------------------------------------------- + ! Add new edges to EDGE_LIST: + DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) + ALLOCATE(EDGE_LIST_AUX(3,DUM+4)); + IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) + EDGE_LIST_AUX(1:3,DUM+1:DUM+4) = EDGE_LIST_REG(1:3,1:4); + CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) + ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) + DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN + DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) + ENDIF + IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) + IF (LOHI==HIGH_IND) THEN; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+2, DUM+3, DUM+4 /) + ELSE; CEDGES_AUX(1:5,JFC1)= (/ 4, DUM+1, DUM+4, DUM+3, DUM+2 /); ENDIF + CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) -SUBROUTINE INSERT_CUT_FACE(NM,I,J,K,AXIS,ICF,INZONE) + IF(INZONE) THEN + M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 + ENDIF + + ! 2. Find cut-cell sharing this RGGAS face, and where in FACE_LIST this face is. + IF( ICCNXT==0 ) THEN + ! 3. Change in FACE_LIST -> (/CC_FTYPE_RCGAS,SIDE,MYAXIS,0,0/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/). + ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) + JCC2_LOOP_1 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) + IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_RCGAS .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(2,IFACE2)==HILO .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(3,IFACE2)==X1AXIS) THEN + M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) + M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1)= (/ CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) + EXIT JCC2_LOOP_1 + ENDIF + ENDDO + ENDDO JCC2_LOOP_1 + ENDIF + + CASE(CC_FTYPE_CFGAS) + + ! Scheme: + ! 0. Add REG and CFGAS cut edges as INB cut edges for the normal faces where it corresponds: + DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) + ALLOCATE(EDGE_LIST_AUX(3,DUM+M%CUT_FACE(IFCX)%CEDGES(1,JFCX))); + EDGE_LIST_AUX = CC_UNDEFINED; EDGE_LIST_REG(1,:) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. + IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) + ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) + DIMCE = 0; IF(ALLOCATED(M%CUT_FACE(IFC1)%CEDGES)) THEN + DIMCE(1)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=1); DIMCE(2)=SIZE(M%CUT_FACE(IFC1)%CEDGES,DIM=2) + ENDIF + IF(ALL(DIMCE>0)) CEDGES_AUX(1:DIMCE(1),1:DIMCE(2))=M%CUT_FACE(IFC1)%CEDGES(1:DIMCE(1),1:DIMCE(2)) + CEDGES_AUX(1,JFC1) = M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + SELECT CASE(X1AXIS) + CASE(IAXIS) + XYZVERT(:,1) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K-1) /) + XYZVERT(:,3) = (/ XFACE(I+ILHF), YFACE(J ), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I+ILHF), YFACE(J-1), ZFACE(K ) /) + ! Loop face edges/cut-edges: + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) + ENDIF + CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! First INB cut edges in surrounding faces: + ! I+ILHF location. + ! Vertices 1-2-3-4 = [J-1,K-1] - [J,K-1] - [J,K] - [J-1,K] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V4-V3 - V1-V4 + LOWJ=-1; HIGJ=0; LOWK=-1; HIGK=0; + IF(AXISF==JAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J-1; KEG=K ; HIGJ=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J-1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; LOWJ= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ENDIF + ELSEIF(AXISF==KAXIS) THEN + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J ; KEG=K-1; HIGK=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K-1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; LOWK= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I+2*ILHF+1,J ,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ENDIF + ENDIF + DO KADD=LOWK,HIGK + DO JADD=LOWJ,HIGJ + ! Edge (I+2*ILHF+1,J+JADD,K+KADD,IAXIS): From V(I+2*ILHF,J+JADD,K+KADD) to V(I+2*ILHF+1,J+JADD,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(J+JADD), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(J+JADD), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,J+JADD,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO + CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge + ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; + ! Find Edge: + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. + SELECT CASE(AXISE) + CASE(KAXIS) ! Edge in z dir. For surrounding faces in X dir -> 2*ILHF+1 = -1 or 1. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=JAXIS + CASE(JAXIS) ! Edge in y dir. For surrounding faces in X dir -> 4*ILHF+2 = -2 or 2. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS)+ILHF+1; JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=KAXIS + END SELECT + ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: + ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: + CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) -! This routine add a cut-face entry ICF in the CUT_FACE array: -! 1. IF AXIS = 0 INBOUNDARY face: -! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK is an interior cell. -! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK is a guard cell. -! 2. IF AXIS = 1,2,3 GASPHASE face: -! ICF = MESHES(NM)%N_BBCUTFACE_MESH+1 if II,JJ,KK,AXIS is a boundary face. -! ICF = MESHES(NM)%N_CUTFACE_MESH+1 if II,JJ,KK,AXIS is an interior face. -! ICF = MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH+1 if II,JJ,KK,AXIS is a guard face. -INTEGER, INTENT(IN) :: NM,I,J,K,AXIS -INTEGER, INTENT(OUT):: ICF -LOGICAL, OPTIONAL, INTENT(IN) :: INZONE + ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: + EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) + ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: + VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + IF(VL1(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL1(3)), ZFACE(VL1(4)) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL1(3)), ZFACE(VL1(4)) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL1(3),VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + IF(VL2(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + XYZVERT(:,1) = (/ XFACE(I+2*ILHF ), YFACE(VL2(3)), ZFACE(VL2(4)) /) + XYZVERT(:,2) = (/ XFACE(I+2*ILHF+1), YFACE(VL2(3)), ZFACE(VL2(4)) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+2*ILHF+1,VL2(3),VL2(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge + ! New edge list for the heighboring cell Boundary cut-faces is inherited. + EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) + END SELECT + ENDDO -INTEGER :: ICC,JCC,IFC,IFACE,IFCX,DUM,IDUM,JDUM,KDUM,X1AXIS,ICE,ILOC,IEDGE -TYPE(CC_CUTFACE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_FACE_AUX + CASE(JAXIS) + XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K-1) /) + XYZVERT(:,2) = (/ XFACE(I-1), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,3) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K ) /) + XYZVERT(:,4) = (/ XFACE(I ), YFACE(J+ILHF), ZFACE(K-1) /) + ! Loop face edges/cut-edges: + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) + ENDIF + CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! First INB cut edges in surrounding faces: + ! J+ILHF location. + ! Vertices 1-2-3-4 = [I-1,K-1] - [I-1,K] - [I,K] - [I,K-1] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + LOWI=-1; HIGI=0; LOWK=-1; HIGK=0; + IF(AXISF==KAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J+ILHF; KEG=K-1; HIGK=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K-1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ELSE + IEG=I; JEG=J+ILHF; KEG=K ; LOWK= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ENDIF + ELSEIF(AXISF==IAXIS) THEN + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J+ILHF; KEG=K ; HIGI=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ELSE + IEG=I ; JEG=J+ILHF; KEG=K ; LOWI= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J+2*ILHF+1,K ,AXISF,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ENDIF + ENDIF + DO KADD=LOWK,HIGK + DO IADD=LOWI,HIGI + ! Edge (I+IADD,J+2*ILHF+1,K+KADD,JAXIS): From V(I+IADD,J+2*ILHF,K+KADD) to V(I+IADD,J+2*ILHF+1,K+KADD) + XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+2*ILHF ), ZFACE(K+KADD) /) + XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+2*ILHF+1), ZFACE(K+KADD) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+2*ILHF+1,K+KADD,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDDO + ENDDO + CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge + ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; + ! Find Edge: + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. + SELECT CASE(AXISE) + CASE(IAXIS) ! Edge in x dir. For surrounding faces in Y dir -> 2*ILHF+1 = -1 or 1. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=KAXIS + CASE(KAXIS) ! Edge in z dir. For surrounding faces in Y dir -> 4*ILHF+2 = -2 or 2. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS)+ILHF+1; KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS); + X1AXIN=IAXIS + END SELECT -IF(AXIS==0) THEN - IF( 0MESHES(NM)%IBAR) THEN ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ELSEIF(I==0 .OR. I==MESHES(NM)%IBAR) THEN ! Block boundary - MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 - MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 - ICF = MESHES(NM)%N_BBCUTFACE_MESH - ENDIF - ELSE ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ENDIF - CASE(JAXIS) - IF(0MESHES(NM)%JBAR) THEN ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ELSEIF(J==0 .OR. J==MESHES(NM)%JBAR) THEN ! Block boundary - MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 - MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 - ICF = MESHES(NM)%N_BBCUTFACE_MESH - ENDIF - ELSE ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ENDIF - CASE(KAXIS) - IF(0MESHES(NM)%KBAR) THEN ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ELSEIF(K==0 .OR. K==MESHES(NM)%KBAR) THEN ! Block boundary - MESHES(NM)%N_BBCUTFACE_MESH = MESHES(NM)%N_BBCUTFACE_MESH+1 - MESHES(NM)%N_CUTFACE_MESH = MESHES(NM)%N_CUTFACE_MESH + 1 - ICF = MESHES(NM)%N_BBCUTFACE_MESH - ENDIF - ELSE ! External - MESHES(NM)%N_GCCUTFACE_MESH = MESHES(NM)%N_GCCUTFACE_MESH+1 - ICF = MESHES(NM)%N_CUTFACE_MESH + MESHES(NM)%N_GCCUTFACE_MESH - ENDIF - END SELECT -ENDIF + ! IF(ICF2<1) THEN + ! WRITE(LU_ERR,*) 'ADD CUT_EDGE TO FACE IFCX,JFCX,I,J,K,X1AXIS=',& + ! IFCX,JFCX,M%CUT_FACE(IFCX)%IJK(1:4),':',M%FCVAR(7,7,7,CC_IDCF,2),M%FCVAR(7,7,7,CC_FGSC,2) + ! WRITE(LU_ERR,*) 'IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4)=',& + ! IEDGE,CEI,ICE,JCE,M%CUT_EDGE(ICE)%IJK(1:4),4*ILHF+2 + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-2,JCE) + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:,-1,JCE) + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 1,JCE) + ! WRITE(LU_ERR,*) M%CUT_EDGE(ICE)%FACE_LIST(:, 2,JCE) + ! ENDIF -! Reallocate CUT_FACE: -ALLOCATE(CUT_FACE_AUX( MAX(SIZE(MESHES(NM)%CUT_FACE,DIM=1),MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH) )) -DO DUM=1,ICF-1 - CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM)) -ENDDO -DO DUM=ICF,MESHES(NM)%N_CUTFACE_MESH+MESHES(NM)%N_GCCUTFACE_MESH-1 - CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(DUM),CUT_FACE_AUX(DUM+1)) -ENDDO -CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE) + ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: + ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: + CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) -! Reset FACE_LIST, FCVAR and CCVAR (CC_IDCF): -DO KDUM=-CCGUARD,MESHES(NM)%KBAR+CCGUARD - DO JDUM=-CCGUARD,MESHES(NM)%JBAR+CCGUARD - DO IDUM=-CCGUARD,MESHES(NM)%IBAR+CCGUARD - IF(MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)>=ICF) & - MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF)=MESHES(NM)%CCVAR(IDUM,JDUM,KDUM,CC_IDCF) + 1 - DO X1AXIS=IAXIS,KAXIS - IF(MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS)>=ICF) & - MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) = MESHES(NM)%FCVAR(IDUM,JDUM,KDUM,CC_IDCF,X1AXIS) + 1 + ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: + EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) + + ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: + VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + IF(VL1(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF ), ZFACE(VL1(4)) /) + XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(J+2*ILHF+1), ZFACE(VL1(4)) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),J+2*ILHF+1,VL1(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + IF(VL2(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + XYZVERT(:,1) = (/ XFACE(VL2(2)), YFACE(J+2*ILHF ), ZFACE(VL2(4)) /) + XYZVERT(:,2) = (/ XFACE(VL2(2)), YFACE(J+2*ILHF+1), ZFACE(VL2(4)) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL2(2),J+2*ILHF+1,VL2(4),X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge + ! New edge list for the heighboring cell Boundary cut-faces is inherited. + EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) + END SELECT ENDDO - ENDDO - ENDDO -ENDDO -DO ICC=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - DO JCC=1,MESHES(NM)%CUT_CELL(ICC)%NCELL - DO IFC=1,MESHES(NM)%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = MESHES(NM)%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - IF(MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS) CYCLE - IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST(4,IFACE) = IFCX+1 - ENDDO - ENDDO - DO IFACE=1,MESHES(NM)%CUT_CELL(ICC)%NFACE_DROPPED - IFCX = MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) - IF(IFCX >= ICF) MESHES(NM)%CUT_CELL(ICC)%FACE_LIST_DROPPED(4,IFACE) = IFCX+1 - ENDDO -ENDDO -DO ICE=1,MESHES(NM)%N_CUTEDGE_MESH - CE=>MESHES(NM)%CUT_EDGE(ICE) - DO IEDGE=1,CE%NEDGE - DO ILOC=-2,2 - IF(CE%FACE_LIST(1,ILOC,IEDGE)>=ICF) CE%FACE_LIST(1,ILOC,IEDGE)=CE%FACE_LIST(1,ILOC,IEDGE)+1 - ENDDO - ENDDO -ENDDO -IF(PRESENT(INZONE)) THEN - IF (INZONE) THEN - DO KDUM=0,MESHES(NM)%KBP1 - DO JDUM=0,MESHES(NM)%JBP1 - DO IDUM=0,MESHES(NM)%IBP1 - DO JCC=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%NCELL - DO IFACE=1,MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NWFACE - IF(MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE)>=ICF) & - MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) = & - MESHES(NM)%INBCF_AREA(IDUM,JDUM,KDUM)%IJCF(JCC)%NEW_ICFINB(IFACE) + 1 + CASE(KAXIS) + XYZVERT(:,1) = (/ XFACE(I-1), YFACE(J-1), ZFACE(K+ILHF) /) + XYZVERT(:,2) = (/ XFACE(I ), YFACE(J-1), ZFACE(K+ILHF) /) + XYZVERT(:,3) = (/ XFACE(I ), YFACE(J ), ZFACE(K+ILHF) /) + XYZVERT(:,4) = (/ XFACE(I-1), YFACE(J ), ZFACE(K+ILHF) /) + ! Loop face edges/cut-edges: + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + IF(IEDGE+1>SIZE(CEDGES_AUX,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(IEDGE+2,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:IEDGE,:)=CEDGES_AUX(1:IEDGE,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=CEDGES_AUX) + ENDIF + CEDGES_AUX(IEDGE+1,JFC1) = DUM+IEDGE + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! First INB cut edges in surrounding faces: + ! K+ILHF location. + ! Vertices 1-2-3-4 = [I-1,J-1] - [I,J-1] - [I,J] - [I-1,J] + ! Corr Edges 1-2-3-4 = V1-V2 - V2-V3 - V3-V4 - V4-V1 + LOWI=-1; HIGI=0; LOWJ=-1; HIGJ=0; + IF(AXISF==IAXIS) THEN ! Define vertices in the Edge and face to receive INB edge: + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J; KEG=K+ILHF; HIGI=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I-1,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,4),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ELSE + IEG=I ; JEG=J; KEG=K+ILHF; LOWI= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,2),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.TRUE.) + ENDIF + ELSEIF(AXISF==JAXIS) THEN + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J-1; KEG=K+ILHF; HIGJ=-1 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J-1,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,1),XYZVERT(:,2),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ELSE + IEG=I; JEG=J ; KEG=K+ILHF; LOWJ= 0 + CALL ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,AXISE,I ,J ,K+2*ILHF+1,AXISF,ITRI,IBOD, & + XYZVERT(:,4),XYZVERT(:,3),EDGE_LIST_AUX(2,DUM+IEDGE),EDGE_LIST_AUX(3,DUM+IEDGE),IV_LIST=.FALSE.) + ENDIF + ENDIF + DO JADD=LOWJ,HIGJ + DO IADD=LOWI,HIGI + ! Edge (I+IADD,J+JADD,K+2*ILHF+1,KAXIS): From V(I+IADD,J+JADD,K+2*ILHF) to V(I+IADD,J+JADD,K+2*ILHF+1) + XYZVERT(:,1) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF ) /) + XYZVERT(:,2) = (/ XFACE(I+IADD), YFACE(J+JADD), ZFACE(K+2*ILHF+1) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,I+IADD,J+JADD,K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) ENDDO ENDDO - ENDDO - ENDDO - ENDDO - ENDIF -ENDIF - -IF(AXIS==0) THEN - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = ICF - MESHES(NM)%CUT_FACE(ICF)%STATUS = CC_INBOUNDARY -ELSE - MESHES(NM)%FCVAR(I,J,K,CC_FGSC,AXIS) = CC_CUTCFE - MESHES(NM)%FCVAR(I,J,K,CC_IDCF,AXIS) = ICF - MESHES(NM)%CUT_FACE(ICF)%STATUS = CC_GASPHASE -ENDIF -MESHES(NM)%CUT_FACE(ICF)%IJK(1:4) = (/I, J, K, AXIS/) + CASE(CC_ETYPE_CFGAS) ! Gas cut-face Edge + ! Find normal cut-face and change edge type, drop gas cut-edge from CUT_EDGE, add edge to ICF1 cut-face cut-edges; + ! Find Edge: + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + AXISE=M%CUT_EDGE(ICE)%IJK(4) ! Cut-edge axis. + SELECT CASE(AXISE) + CASE(JAXIS) ! Edge in y dir. For surrounding faces in Z dir -> 2*ILHF+1 = -1 or 1. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,2*ILHF+1,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,2*ILHF+1,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,2*ILHF+1,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; + X1AXIN=IAXIS + CASE(IAXIS) ! Edge in x dir. For surrounding faces in Z dir -> 4*ILHF+2 = -2 or 2. + ICF2 = M%CUT_EDGE(ICE)%FACE_LIST(1,4*ILHF+2,JCE) + JCF2 = M%CUT_EDGE(ICE)%FACE_LIST(2,4*ILHF+2,JCE) + JCE2 = M%CUT_EDGE(ICE)%FACE_LIST(3,4*ILHF+2,JCE) + IFCIN =M%CUT_EDGE(ICE)%IJK(IAXIS); JFCIN=M%CUT_EDGE(ICE)%IJK(JAXIS); KFCIN=M%CUT_EDGE(ICE)%IJK(KAXIS)+ILHF+1; + X1AXIN=JAXIS + END SELECT -RETURN -END SUBROUTINE INSERT_CUT_FACE + ! Create new CFINB cut-edge and add it to CUT_EDGE, FCVAR for ICF2: + ! Find ICE2 index to cut-edge from cut-face ICF2,JCF2: + CALL ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,ITRI,IBOD,IEC2,JEC2,IFCIN,JFCIN,KFCIN,X1AXIN) -! --------------------------------- DROP_CUT_EDGE ------------------------------------------- + ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: + EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) -SUBROUTINE DROP_CUT_EDGE(NM,ICE,JCE,ETYPE) + ! If any vertex node has been changed to SOLID -> define cut-edge normal to face: + VL1(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + IF(VL1(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD1,JCE)) + XYZVERT(:,1) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF ) /) + XYZVERT(:,2) = (/ XFACE(VL1(2)), YFACE(VL1(3)), ZFACE(K+2*ILHF+1) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL1(2),VL1(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + VL2(1:4) = M%CUT_EDGE(ICE)%VERT_LIST(1:4,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + IF(VL2(1)==CC_VTYPE_VGAS) THEN + !XYZVERT(:,1) = M%CUT_EDGE(ICE)%XYZVERT(IAXIS:KAXIS,M%CUT_EDGE(ICE)%CEELEM(NOD2,JCE)) + XYZVERT(:,1) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF ) /) + XYZVERT(:,2) = (/ XFACE(VL2(2)), YFACE(VL2(3)), ZFACE(K+2*ILHF+1) /) + CALL ADD_CUTEDGE_TO_EDGE(NM,ILHF,VL2(2),VL2(3),K+2*ILHF+1,X1AXIS,XYZVERT(:,1),XYZVERT(:,2)) + ENDIF + CASE(CC_ETYPE_CFINB) ! Boundary Surface Edge + ! New edge list for the heighboring cell Boundary cut-faces is inherited. + EDGE_LIST_AUX(:,DUM+IEDGE) = M%CUT_FACE(IFCX)%EDGE_LIST(:,CEI) + END SELECT + ENDDO + END SELECT + CALL MOVE_ALLOC(FROM=CEDGES_AUX,TO=M%CUT_FACE(IFC1)%CEDGES) + CALL MOVE_ALLOC(FROM=EDGE_LIST_AUX,TO=M%CUT_FACE(IFC1)%EDGE_LIST) -INTEGER, INTENT(IN) :: NM,ICE,JCE,ETYPE + ! 1. Add INBOUNDARY cut-face in CUT_FACE for this face (IFC1,JFC1). + ! Add XYZVERT, AREA, XYZCEN and CFELEM entry in CUT_FACE(IFC1) for this (IFCX,JFCX) CFGAS face. + M%CUT_FACE(IFC1)%CFELEM(1,JFC1) = M%CUT_FACE(IFCX)%CFELEM(1,JFCX) + MAXVERTS = SIZE(M%CUT_FACE(IFC1)%XYZVERT,DIM=2) + COUNT=1 + DO IVERT=1,M%CUT_FACE(IFCX)%CFELEM(1,JFCX) + IV=M%CUT_FACE(IFCX)%CFELEM(IVERT+1,JFCX) + XYZV(IAXIS:KAXIS) =M%CUT_FACE(IFCX)%XYZVERT(IAXIS:KAXIS,IV) + CALL INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,M%CUT_FACE(IFC1)%NVERT,INOD,M%CUT_FACE(IFC1)%XYZVERT) + COUNT=COUNT+1 + IF(COUNT>SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1)) THEN + ALLOCATE(CEDGES_AUX2(COUNT+1,1:SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))); CEDGES_AUX2=CC_UNDEFINED + CEDGES_AUX2(1:COUNT-1,:)=M%CUT_FACE(IFC1)%CFELEM(1:COUNT-1,:) + CALL MOVE_ALLOC(FROM=CEDGES_AUX2,TO=M%CUT_FACE(IFC1)%CFELEM) + ENDIF + M%CUT_FACE(IFC1)%CFELEM(COUNT,JFC1)=INOD + ENDDO + IF (HILO==HIGH_IND) THEN ! Mirror the connectivity, s.t. normal pointing inside: + COUNT=M%CUT_FACE(IFC1)%CFELEM(1,JFC1) + ALLOCATE(CFELEM(COUNT)); CFELEM(1:COUNT) = M%CUT_FACE(IFC1)%CFELEM(COUNT+1:2:-1,JFC1) + M%CUT_FACE(IFC1)%CFELEM(2:COUNT+1,JFC1) = CFELEM(1:COUNT) + DEALLOCATE(CFELEM) + ENDIF + M%CUT_FACE(IFC1)%AREA(JFC1) = M%CUT_FACE(IFCX)%AREA(JFCX) + M%CUT_FACE(IFC1)%XYZCEN(:,JFC1) = M%CUT_FACE(IFCX)%XYZCEN(:,JFCX) -INTEGER :: CT,DUM,ILH,ICF1,IEDGE -INTEGER, ALLOCATABLE, DIMENSION(:) :: IND -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTEDGE_TYPE), POINTER :: CE + ! 2. Find cut-cell sharing this CFGAS face (IFCX,JFCX), find where in saids cell FACE_LIST this face is. + ! 3. Change in FACE_LIST -> (/CC_FTYPE_CFGAS,SIDE,MYAXIS,IFCX,JFCX/) to (/CC_FTYPE_CFINB,0,0,IFC1,JFC1/) + ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) + JCC2_LOOP_2 : DO JCC2=1,M%CUT_CELL(ICC2)%NCELL + DO IFC2=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE2 = M%CUT_CELL(ICC2)%CCELEM(IFC2+1,JCC2) + IF( M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE2)==CC_FTYPE_CFGAS .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE2)==IFCX .AND. & + M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE2)==JFCX) THEN + ! Add to FACE_LIST_DROPPED: + M%CUT_CELL(ICC2)%NFACE_DROPPED = M%CUT_CELL(ICC2)%NFACE_DROPPED + 1 + NFCD=0; IF(ALLOCATED(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED)) NFCD=SIZE(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED,DIM=2) + IF(M%CUT_CELL(ICC2)%NFACE_DROPPED>NFCD) THEN + ALLOCATE(FACE_LIST_DROPPED(6,M%CUT_CELL(ICC2)%NFACE_DROPPED)) + IF(NFCD>0) FACE_LIST_DROPPED(1:6,1:NFCD) = M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1:6,1:NFCD) + FACE_LIST_DROPPED(1:6,NFCD+1) = M%CUT_CELL(ICC2)%FACE_LIST(1:6,IFACE2) + CALL MOVE_ALLOC(FROM=FACE_LIST_DROPPED,TO=M%CUT_CELL(ICC2)%FACE_LIST_DROPPED) + ENDIF + ! Now write CC_FTYPE_CFINB entry: + M%CUT_CELL(ICC2)%FACE_LIST(1:5,IFACE2) = (/ CC_FTYPE_CFINB, 0, 0, IFC1, JFC1 /) + M%CUT_FACE(IFC1)%CELL_LIST(1:4,LOW_IND,JFC1) =(/CC_FTYPE_CFGAS, ICC2, JCC2, IFC2 /) + IF(INZONE) THEN + M%CUT_FACE(IFC1)%BLK_TAG(JFC1) = .TRUE. ! Tag a new INBOUNDARY face. + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + 1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = IFC1 + M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE) = JFC1 + ENDIF + EXIT JCC2_LOOP_2 + ENDIF + ENDDO + ENDDO JCC2_LOOP_2 + END SELECT -IF(ICE<1) RETURN -M =>MESHES(NM) -CE=>M%CUT_EDGE(ICE) +ENDDO IFC_LOOP -NEDGE_IF_1 : IF(CE%NEDGE>1) THEN - ALLOCATE(IND(CE%NEDGE)); IND = 0 - CT=0; - DO DUM=1,CE%NEDGE - IF(DUM==JCE) CYCLE - CT = CT + 1 - IND(DUM) = CT +IF(INZONE) THEN + DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) + JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) + M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) = M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) + M%CUT_FACE(IFC1)%AREA(JFC1) ENDDO - ! Collapse NEDGE variables: - DO DUM=1,CE%NEDGE - IF(DUM==JCE) CYCLE - CE%CEELEM( :,IND(DUM)) = CE%CEELEM( :,DUM) - CE%INDSEG( :,IND(DUM)) = CE%INDSEG( :,DUM) - CE%FACE_LIST(:,:,IND(DUM)) = CE%FACE_LIST(:,:,DUM) - CE%DXX( :,IND(DUM)) = CE%DXX( :,DUM) - - ! Finally change EDGE_LIST of involved faces: - DO ILH=-2,2 - ICF1 = CE%FACE_LIST(1,ILH,IND(DUM)); IF(ICF1<1) CYCLE - IEDGE = CE%FACE_LIST(3,ILH,IND(DUM)) - M%CUT_FACE(ICF1)%EDGE_LIST(3,IEDGE) = IND(DUM) - ENDDO + DO IFC=1,M%INBCF_AREA(I,J,K)%IJCF(JCC)%NWFACE + IFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_ICFINB(IFC) + JFC1 = M%INBCF_AREA(I,J,K)%IJCF(JCC)%NEW_JCFINB(IFC) + M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)= & + M%CUT_FACE(IFC1)%AREA_ADJUST(JFC1)*M%INBCF_AREA(I,J,K)%AINB(JCC)/M%INBCF_AREA(I,J,K)%NEW_AINB(JCC) ENDDO -ENDIF NEDGE_IF_1 - -CE%NEDGE = CE%NEDGE - 1 -IF(CE%NEDGE < 1) THEN - IF(ETYPE==CC_ETYPE_CFGAS) THEN - M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_EGSC,CE%IJK(KAXIS+1)) = CC_SOLID - M%ECVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED - ELSEIF(ETYPE==CC_ETYPE_CFINB) THEN - IF(CE%IJK(KAXIS+1)>0) THEN - M%FCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE,CE%IJK(KAXIS+1)) = CC_UNDEFINED - ELSE - M%CCVAR(CE%IJK(IAXIS),CE%IJK(JAXIS),CE%IJK(KAXIS),CC_IDCE) = CC_UNDEFINED - ENDIF - ENDIF - CE%STATUS = CC_SOLID ENDIF -END SUBROUTINE DROP_CUT_EDGE - - -! ----------------------------- DROP_CUTFACE -------------------------------------- - -SUBROUTINE DROP_CUTFACE(NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC) - -! Drop cut-face CUT_FACE(ICF)%CFELEM(:,JCF): -! 0. For garphase cut-faces, move gas edges (reg and cut) to INB face CUT_EDGEs where it corresponds. -! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). -! 2. Change second index for cut-faces of cells attached to ICF,JCF -! 3. If zero remaining cut-faces in CUT_FACE(ICF) => make FCVAR,CCVAR GSC and IDCF indexes SOLID and INDEFINED. - -INTEGER, INTENT(IN) :: NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC +ELSEIF(BLOCK_PHASE==2) THEN BLOCK_PHASE_IF -INTEGER :: CT,DUM,ILH,ICC1,JCC1,IFACE,IFC1,IFACE2 -INTEGER, ALLOCATABLE, DIMENSION(:) :: IND -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTFACE_TYPE), POINTER :: CF +! Drop Edges and Faces: +IFC_LOOP_2 : DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) + IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) + LOHI = M%CUT_CELL(ICC)%FACE_LIST(2,IFACE) + HILO = 3-LOHI ! 2 for LOW_IND, 1 for HIGH_IND + ILH = 2*LOHI-3 ! -1 for LOW_IND, 1 for HIGH_IND + ILHF = LOHI-2 ! -1 for LOW_IND, 0 for HIGH_IND + X1AXIS = M%CUT_CELL(ICC)%FACE_LIST(3,IFACE) + IFCX = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) + JFCX = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) -M => MESHES(NM) -CF=> M%CUT_FACE(IFC) + FACE_TYPE_IF_2 : IF(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. & + M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN -! 1. Remove it from (1:NFACE) CFELEM,AREA,XYZCEN,SHARED, CELL_LIST lists in CUT_FACE(ICF). -NFACE_IF_1 : IF(CF%NFACE>1) THEN - ALLOCATE(IND(CF%NFACE)); IND = 0 - CT=0; - DO DUM=1,CF%NFACE - IF(DUM==JFC) CYCLE - CT = CT + 1 - IND(DUM) = CT - ENDDO - ! Collapse NFACE variables: - DO DUM=1,CF%NFACE - IF(DUM==JFC) CYCLE - CF%CFELEM( :,IND(DUM)) = CF%CFELEM( :,DUM) - CF%CEDGES( :,IND(DUM)) = CF%CEDGES( :,DUM) - CF%AREA( IND(DUM)) = CF%AREA( DUM) - CF%XYZCEN( :,IND(DUM)) = CF%XYZCEN( :,DUM) - CF%SHARED( IND(DUM)) = CF%SHARED( DUM) - CF%CELL_LIST(:,:,IND(DUM)) = CF%CELL_LIST(:,:,DUM) - ! Finally change FACE_LIST of involved cells: - CT = HIGH_IND - IF(FTYPE==CC_FTYPE_CFINB) THEN - CT = LOW_IND - CF%BODTRI( :,IND(DUM)) = CF%BODTRI( :,DUM) - CF%SURF_INDEX( IND(DUM)) = CF%SURF_INDEX( DUM) - CF%BLK_TAG( IND(DUM)) = CF%BLK_TAG( DUM) - CF%CFACE_ORIGIN( IND(DUM)) = CF%CFACE_ORIGIN( DUM) - CF%AREA_ADJUST( IND(DUM)) = CF%AREA_ADJUST( DUM) + IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) THEN + LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) + HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) + LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) + HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) + IF(LOWI>0 .AND. LOWJ>0) THEN + IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. & ! This is to drop this cut-face on the second hit. + M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0 .AND. M%CUT_FACE(IFCX)%SHARED(JFCX)) THEN + M%CUT_FACE(IFCX)%SHARED(JFCX) =.FALSE. + CYCLE IFC_LOOP_2 + ENDIF + ENDIF ENDIF - DO ILH=LOW_IND,CT - ICC1 = CF%CELL_LIST(2,ILH,IND(DUM)) - JCC1 = CF%CELL_LIST(3,ILH,IND(DUM)) - IFC1 = CF%CELL_LIST(4,ILH,IND(DUM)) - IFACE= M%CUT_CELL(ICC1)%CCELEM(IFC1+1,JCC1) - ! Dropping gas-cut cells, do not reindex local JCF for INBOUNDARY faces. These have been changed already. - IF(FTYPE==CC_FTYPE_CFINB .OR. (FTYPE==CC_FTYPE_CFGAS .AND. M%CUT_CELL(ICC1)%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB)) & - M%CUT_CELL(ICC1)%FACE_LIST(5,IFACE) = IND(DUM) - DO IFACE2=1,M%CUT_CELL(ICC1)%NFACE_DROPPED - IF(M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & - M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(4,IFACE2)==IFC .AND. & - M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)==DUM) & - M%CUT_CELL(ICC1)%FACE_LIST_DROPPED(5,IFACE2)=IND(DUM) - ENDDO - ENDDO - ENDDO - CF%CFELEM( :,CF%NFACE) = CC_UNDEFINED - CF%CEDGES( :,CF%NFACE) = CC_UNDEFINED - CF%AREA( CF%NFACE) = 0._EB - CF%XYZCEN( :,CF%NFACE) = 0._EB - CF%SHARED( CF%NFACE) = .FALSE. - CF%BLK_TAG( CF%NFACE) = .FALSE. - CF%CELL_LIST(:,:,CF%NFACE) = CC_UNDEFINED - IF(FTYPE==CC_FTYPE_CFINB) THEN - CF%BODTRI( :,CF%NFACE) = CC_UNDEFINED - CF%SURF_INDEX( CF%NFACE) = CC_UNDEFINED - CF%CFACE_ORIGIN( CF%NFACE) = CC_UNDEFINED - ENDIF - DEALLOCATE(IND) -ENDIF NFACE_IF_1 - -CF%NFACE = MAX(0,CF%NFACE - 1) - -IF(FTYPE==CC_FTYPE_CFGAS .AND. CF%NSFACE>0) THEN ! Bring down SOLID faces used for SLCF plotting. - CT=CF%NFACE - DO DUM=1,CF%NSFACE - CT=CT+1 - CF%CFELEM( :,CT) = CF%CFELEM( :,CT+1) - CF%CEDGES( :,CT) = CF%CEDGES( :,CT+1) - CF%AREA( CT) = CF%AREA( CT+1) - CF%XYZCEN( :,CT) = CF%XYZCEN( :,CT+1) - ENDDO -ENDIF -IF(CF%NFACE < 1) THEN - CF%STATUS = CC_SOLID - CF%NSFACE = 0 - IF (FTYPE == CC_FTYPE_CFGAS) THEN SELECT CASE(X1AXIS) - CASE(IAXIS) - M%FCVAR(I+ILHF,J,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I+ILHF,J,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - M%ECVAR(I+ILHF,J-1:J,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J-1:J,K,CC_IDCE,KAXIS) = CC_UNDEFINED - M%ECVAR(I+ILHF,J,K-1:K,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I+ILHF,J,K-1:K,CC_IDCE,JAXIS) = CC_UNDEFINED - CASE(JAXIS) - M%FCVAR(I,J+ILHF,K,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J+ILHF,K,CC_IDCF,X1AXIS) = CC_UNDEFINED - M%ECVAR(I-1:I,J+ILHF,K,CC_EGSC,KAXIS) = CC_SOLID; M%ECVAR(I-1:I,J+ILHF,K,CC_IDCE,KAXIS) = CC_UNDEFINED - M%ECVAR(I,J+ILHF,K-1:K,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J+ILHF,K-1:K,CC_IDCE,IAXIS) = CC_UNDEFINED - CASE(KAXIS) - M%FCVAR(I,J,K+ILHF,CC_FGSC,X1AXIS) = CC_SOLID; M%FCVAR(I,J,K+ILHF,CC_IDCF,X1AXIS) = CC_UNDEFINED - M%ECVAR(I-1:I,J,K+ILHF,CC_EGSC,JAXIS) = CC_SOLID; M%ECVAR(I-1:I,J,K+ILHF,CC_IDCE,JAXIS) = CC_UNDEFINED - M%ECVAR(I,J-1:J,K+ILHF,CC_EGSC,IAXIS) = CC_SOLID; M%ECVAR(I,J-1:J,K+ILHF,CC_IDCE,IAXIS) = CC_UNDEFINED + CASE(IAXIS); II=I+ILH; JJ=J; KK=K + CASE(JAXIS); II=I; JJ=J+ILH; KK=K + CASE(KAXIS); II=I; JJ=J; KK=K+ILH END SELECT - ELSEIF (FTYPE == CC_FTYPE_CFINB) THEN - M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED - ENDIF -ENDIF + IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_SOLID) CYCLE IFC_LOOP_2 -RETURN -END SUBROUTINE DROP_CUTFACE + ENDIF FACE_TYPE_IF_2 + SELECT CASE(M%CUT_CELL(ICC)%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_RCGAS) + ! 4. Make FCVAR(I,J,K,CC_CGSC,X1AXIS)=CC_SOLID, ECVAR and VERTVAR CC_SOLID where corresponds: + CALL DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) + CASE(CC_FTYPE_CFGAS) + ! Drop Face and Edges test: + DROP_FACE=.FALSE. + ! Check in CELL_LIST of both surrounding cut-cells are to be dropped, IF so drop cut-face: + LOWI=M%CUT_FACE(IFCX)%CELL_LIST(2, LOW_IND,JFCX) + HIGI=M%CUT_FACE(IFCX)%CELL_LIST(3, LOW_IND,JFCX) + LOWJ=M%CUT_FACE(IFCX)%CELL_LIST(2,HIGH_IND,JFCX) + HIGJ=M%CUT_FACE(IFCX)%CELL_LIST(3,HIGH_IND,JFCX) + IF(LOWI>0 .AND. LOWJ>0) THEN + IF(M%CUT_CELL(LOWI)%NOADVANCE(HIGI)>0 .AND. M%CUT_CELL(LOWJ)%NOADVANCE(HIGJ)>0) THEN + DROP_FACE=.TRUE. + M%CUT_FACE(IFCX)%SHARED(JFCX) =.TRUE. + ENDIF + ENDIF -! ----------------------------- DROP_CUTCELL -------------------------------------- + ICC2 = M%CCVAR(II,JJ,KK,CC_IDCC) + JCC2_LOOP_3 : DO IFACE2=1,M%CUT_CELL(ICC2)%NFACE_DROPPED + IF(M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(1,IFACE2)==CC_FTYPE_CFGAS .AND. & + M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(4,IFACE2)==IFCX .AND. & + M%CUT_CELL(ICC2)%FACE_LIST_DROPPED(5,IFACE2)==JFCX) THEN + DROP_FACE=.TRUE. + EXIT JCC2_LOOP_3 + ENDIF + ENDDO JCC2_LOOP_3 -SUBROUTINE DROP_CUTCELL(NM,ICC,JCC) + DROP_FACE_IF : IF (DROP_FACE) THEN + SELECT CASE(X1AXIS) + CASE(IAXIS) + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + IF(AXISF==KAXIS) THEN + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J ; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ELSEIF(AXISF==JAXIS) THEN + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I+ILHF; JEG=J-1; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I+ILHF; JEG=J ; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ENDIF + CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! Drop edge JCE: + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + END SELECT + ENDDO -! Remove cut-cell CUT_CELL(ICC)%CCELEM(:,JCC): -! 1. If CUT_CELL(ICC)%NCELL==1 drop INBOUNDARY faces of ICC,JCC, make CCVAR CGSC SOLID and IDCC,IDCF undefined. -! 2. If more than 1 NCELL, drop JCc from CCELEM, IJK_LINK, LINK_LEV, VOLUME, XYZCEN lists and NCELL=NCELL-1 + CASE(JAXIS) + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + IF(AXISF==KAXIS) THEN + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J+ILHF; KEG=K-1; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I; JEG=J+ILHF; KEG=K ; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ELSEIF(AXISF==IAXIS) THEN + AXISE=KAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I ; JEG=J+ILHF; KEG=K; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ENDIF + CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! Drop edge JCE: + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + END SELECT + ENDDO + CASE(KAXIS) + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + SELECT CASE(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + CASE(CC_ETYPE_RGGAS) ! Regular Gas Edge + LOHIE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + AXISF=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + IF(AXISF==IAXIS) THEN + AXISE=JAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I-1; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I ; JEG=J; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ELSEIF(AXISF==JAXIS) THEN + AXISE=IAXIS + IF(LOHIE==LOW_IND) THEN + IEG=I; JEG=J-1; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ELSE + IEG=I; JEG=J ; KEG=K+ILHF; M%ECVAR(IEG,JEG,KEG,CC_EGSC,AXISE) = CC_SOLID + ENDIF + ENDIF + CASE(CC_ETYPE_CFGAS,CC_ETYPE_CFINB) ! Gas or INB cut-edge + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + ! Drop edge JCE: + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + END SELECT + ENDDO + END SELECT -INTEGER, INTENT(IN) :: NM,ICC,JCC + ! Drop (IFCX,JFCX) from CUT_FACE(IFCX): + CALL DROP_CUTFACE(NM,CC_FTYPE_CFGAS,I,J,K,ILHF,X1AXIS,IFCX,JFCX) + ENDIF DROP_FACE_IF + CASE(CC_FTYPE_CFINB) -! Local Variables -INTEGER :: I,J,K,JCC2,IFC,CT -INTEGER, ALLOCATABLE, DIMENSION(:) :: IND -TYPE(MESH_TYPE), POINTER :: M -M => MESHES(NM) + ! Drop cut-edges whithin the Cartesian cell I,J,K that belong to this INBOUNDARY cut-face: + DO IEDGE=1,M%CUT_FACE(IFCX)%CEDGES(1,JFCX) + CEI =M%CUT_FACE(IFCX)%CEDGES(IEDGE+1,JFCX) + IF(M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)/=CC_ETYPE_CFINB) CYCLE + ICE=M%CUT_FACE(IFCX)%EDGE_LIST(2,CEI) + JCE=M%CUT_FACE(IFCX)%EDGE_LIST(3,CEI) + AXISE=M%CUT_EDGE(ICE)%IJK(4) + IF(AXISE>0) CYCLE + CALL DROP_CUT_EDGE(NM,ICE,JCE,M%CUT_FACE(IFCX)%EDGE_LIST(1,CEI)) + ENDDO -I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS) + ! Scheme: + ! 1. Drop (IFC2,JFC2) from CUT_FACE(IFC2). Note this changes the face arrays, so FACE_LIST face indexes + ! for cut-cells on this CUT_CELL(ICC) entry need to be updated. + CALL DROP_CUTFACE(NM,CC_FTYPE_CFINB,I,J,K,ILHF,X1AXIS,IFCX,JFCX) -! Check if JCC is the only cut-cell in CUT_CELL(ICC): -IF (M%CUT_CELL(ICC)%NCELL==1) THEN - ! Set cut-cell to solid - M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID - M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED - M%CUT_CELL(ICC)%NCELL = 0 - ! Then drop INBOUNDARY cut-faces in I,J,K if there are any left: - IFC=M%CCVAR(I,J,K,CC_IDCF) - IF (IFC>0) THEN - M%CUT_FACE(IFC)%STATUS = CC_SOLID - M%CUT_FACE(IFC)%NFACE = 0 - ENDIF - M%CCVAR(I,J,K,CC_IDCF) = CC_UNDEFINED - RETURN -ENDIF + END SELECT -! First count: -ALLOCATE(IND(1:M%CUT_CELL(ICC)%NCELL)); IND=0 -CT=0 -DO JCC2=1,M%CUT_CELL(ICC)%NCELL - IF (JCC2==JCC) CYCLE - CT = CT + 1 - IND(JCC2) = CT -ENDDO +ENDDO IFC_LOOP_2 -! Then drop JCC: -DO JCC2=1,M%CUT_CELL(ICC)%NCELL - IF (JCC2==JCC) CYCLE - M%CUT_CELL(ICC)%CCELEM(:,IND(JCC2)) = M%CUT_CELL(ICC)%CCELEM(:,JCC2) - M%CUT_CELL(ICC)%IJK_LINK(:,IND(JCC2)) = M%CUT_CELL(ICC)%IJK_LINK(:,JCC2) - M%CUT_CELL(ICC)%LINK_LEV(IND(JCC2)) = M%CUT_CELL(ICC)%LINK_LEV(JCC2) - M%CUT_CELL(ICC)%VOLUME(IND(JCC2)) = M%CUT_CELL(ICC)%VOLUME(JCC2) - M%CUT_CELL(ICC)%XYZCEN(:,IND(JCC2)) = M%CUT_CELL(ICC)%XYZCEN(:,JCC2) - M%CUT_CELL(ICC)%NOADVANCE(IND(JCC2)) = M%CUT_CELL(ICC)%NOADVANCE(JCC2) -ENDDO +ELSEIF(BLOCK_PHASE==3) THEN BLOCK_PHASE_IF -M%CUT_CELL(ICC)%NCELL = M%CUT_CELL(ICC)%NCELL - 1 +! At this point all faces defining the ICC,JCC cut-cell have been dropped in the CUT_FACE, CUT_CELL trees. +! We can drop JCC from CUT_CELL(ICC)%CCELEM, etc. +CALL DROP_CUTCELL(NM,ICC,JCC) -DEALLOCATE(IND) +ENDIF BLOCK_PHASE_IF RETURN -END SUBROUTINE DROP_CUTCELL - -SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK - -DO IDIM=1,MAX_DIM +END SUBROUTINE BLOCK_CUT_CELL -! Exchange CC%NOADVANCE(JCC)>0 information among NEIGHBOURING meshes: -CALL EXCHANGE_CC_NOADVANCE_INFO -! Add CC%NOADVANCE(JCC) where needed: -CALL ADD_NEIGHBOR_BLOCKED_CELLS +! ---------------------- GET_EXT_INB_CUTFACES_TO_CFACE -------------------------------- -MAIN_MESH_LOOP_1 : DO NM=1,NMESHES +SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 +! Local Variables: +INTEGER :: ICF, CFACE_INDEX_LOCAL, SURF_INDEX +INTEGER :: IVENT +REAL(EB):: ADDMAT(IAXIS:KAXIS,LOW_IND:HIGH_IND) +INTEGER :: NM,I,J,K,X1AXIS,IW,IFACE,IERR +REAL(EB) :: CPUTIME_START, CPUTIME +TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC +TYPE(CC_CUTFACE_TYPE), POINTER :: CF - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) +! GET_CUTCELLS_VERBOSE variables: +INTEGER, ALLOCATABLE, DIMENSION(:) :: NCFACE_BY_MESH - ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) +TYPE(VENTS_TYPE), POINTER :: VT +TYPE(CFACE_TYPE), POINTER :: CFA - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) - ENDIF +IF(GET_CUTCELLS_VERBOSE) CALL CPU_TIME(CPUTIME_START) - ! Block any cells that contain only one gas cut-face (cavity type cut-cells): - K = 0 - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%CUT_CELL(ICC1) - DO J=1,CC%NCELL - SUM_FACE=0; SUM_CCELL=0 - DO I=2,CC%CCELEM(1,J) - SELECT CASE(CC%FACE_LIST(1,CC%CCELEM(I,J))) - CASE(CC_FTYPE_CFGAS); SUM_FACE = SUM_FACE+1 - CASE(CC_FTYPE_RCGAS); SUM_CCELL=SUM_CCELL+1 - END SELECT - ENDDO - IF(SUM_FACE>1 .OR. SUM_CCELL>0) CYCLE - IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J)=BLOCKED_CAVITY_CELL - K=K+1 - ENDDO +ALLOCATE(NCFACE_BY_MESH(1:NMESHES)); NCFACE_BY_MESH(1:NMESHES) = 0 +MESH_LOOP_0 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + ! First N_EXTERNAL_CFACE_CELLS: + DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE + CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE + CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE + END SELECT + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE ENDDO - IF (K>0) THEN - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) - ENDIF - ENDIF - CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) -ENDDO MAIN_MESH_LOOP_1 - -! Call tag boundary cut-cells for blocking in refinement interfaces: -CALL TAG_CC_BLOCKING_REFINEMENT - -ENDDO - -FINAL_BLOCK_MESH_LOOP : DO NM=1,NMESHES + ! Second N_INTWALL_CFACE_CELLS: + DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS)==0) CYCLE + ENDIF + CASE(JAXIS) + IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS)==0) CYCLE + ENDIF + CASE(KAXIS) + IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS)==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IF (CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS)==0) CYCLE + ENDIF + END SELECT + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE + ENDDO + ! Second N_INTERNAL_CFACE_CELLS: + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE + ! Don't count INB cut-faces inside an OBST: + IF (CELL(CELL_INDEX(CF%IJK(IAXIS),CF%IJK(JAXIS),CF%IJK(KAXIS)))%SOLID) CYCLE + NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE + ENDDO +ENDDO MESH_LOOP_0 - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 +IF(GET_CUTCELLS_VERBOSE) THEN + CALL MPI_ALLREDUCE(MPI_IN_PLACE,NCFACE_BY_MESH(1),NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + WRITE(LU_SETCC,'(A,I10)',advance='no') ' 4. Generating CFACES from cut-faces, total CFACE_CELLS=', & + SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,I10)') ' Total number of CFACES in all processes=', & + SUM(NCFACE_BY_MESH(1:NMESHES)) + WRITE(LU_ERR ,'(A,I10)',advance='no') & + ' 4. Process 0 Generating CFACES from cut-faces, total CFACE_CELLS=', & + SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) + ENDIF +ENDIF +! First mesh Loop, Allocate storage for CFACES, CFACE geometric info: +MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + ! ALLOCATE to zero size + IF(ALLOCATED(MESHES(NM)%CFACE)) DEALLOCATE(MESHES(NM)%CFACE) + MESHES(NM)%N_CFACE_CELLS_DIM = NCFACE_BY_MESH(NM) + ALLOCATE(MESHES(NM)%CFACE(0:MESHES(NM)%N_CFACE_CELLS_DIM)) - ! Here: 1,2. Define Linking information for cut-cells. - CALL GET_CELL_LINK_INFO(NM) + ALLOCATE(MESHES(NM)%FACE_WORK1(MESHES(NM)%N_CFACE_CELLS_DIM)) + ALLOCATE(MESHES(NM)%FACE_WORK2(MESHES(NM)%N_CFACE_CELLS_DIM)) + ALLOCATE(MESHES(NM)%FACE_WORK3(MESHES(NM)%N_CFACE_CELLS_DIM)) - ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) - ENDIF + ! Define pointers among External CC_GASPHASE CUT_FACE and CFACE (N_EXTERNAL_CFACE_CELLS): + CFACE_INDEX_LOCAL = 0 + DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST: + SELECT CASE(X1AXIS) + CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE + CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE + CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE + END SELECT + ! Now get WALL cell SURF_INDEX: + IW = 0 + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF (I==0 ) IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-1) + IF (I==IBAR) IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( 1) + CASE(JAXIS) + IF (J==0 ) IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-2) + IF (J==JBAR) IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( 2) + CASE(KAXIS) + IF (K==0 ) IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-3) + IF (K==KBAR) IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( 3) + END SELECT + SURF_INDEX = WALL(IW)%SURF_INDEX + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) + ENDDO + ENDDO + MESHES(NM)%N_EXTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL + ! Define pointers among internal CC_GASPHASE CUT_FACE and CFACE (N_INTWALL_CFACE_CELLS): + DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH + CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) + ! Don't count cut-faces inside an OBST, or don't lay on a WALL_CELL: + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + ENDIF + CASE(JAXIS) + IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + ENDIF + CASE(KAXIS) + IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE + ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE + ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN + IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE + ENDIF + END SELECT + SURF_INDEX = WALL(IW)%SURF_INDEX + IF(.NOT.ALLOCATED(CF%CFACE_INDEX)) THEN; ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) + ELSEIF (SIZE(CF%CFACE_INDEX,DIM=1)/=CF%NFACE)THEN + DEALLOCATE(CF%CFACE_INDEX); ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) + ENDIF + IF(.NOT.ALLOCATED(CF%SURF_INDEX)) THEN; ALLOCATE(CF%SURF_INDEX(CF%NFACE)) + ELSEIF (SIZE(CF%SURF_INDEX,DIM=1)/=CF%NFACE)THEN + DEALLOCATE(CF%SURF_INDEX); ALLOCATE(CF%SURF_INDEX(CF%NFACE)) + ENDIF - CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) -ENDDO FINAL_BLOCK_MESH_LOOP + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) + ENDDO + ENDDO + MESHES(NM)%N_INTWALL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%INTERNAL_CFACE_CELLS_LB = MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%N_INTWALL_CFACE_CELLS + ! Define pointers among CC_INBOUNDARY CUT_FACE and CFACE (N_INTERNAL_CFACE_CELLS): + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + CF => MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE + I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS) + ! Don't count INB cut-faces inside an OBST: + IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE + DO IFACE=1,CF%NFACE + CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 + ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. + CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL + SURF_INDEX = CF%SURF_INDEX(IFACE) + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.TRUE.) + ENDDO + IF(ALLOCATED(CF%CFACE_ORIGIN)) DEALLOCATE(CF%CFACE_ORIGIN) + ENDDO + MESHES(NM)%N_INTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%INTERNAL_CFACE_CELLS_LB +ENDDO MESH_LOOP_1 -END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK +! Second loop, apply VENTS to change SURF_ID associated with CFACEs: +MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) -SUBROUTINE CC_GRID_POSTPROCESS_AND_CLEANUP(NM) + ! ! Currently : Modify CFACE SURF_INDEX with VENT information: This needs more development. -INTEGER, INTENT(IN) :: NM + VENT_LOOP : DO IVENT=1,MESHES(NM)%N_VENT + VT => VENTS(IVENT) + IF(.NOT.VT%GEOM) CYCLE VENT_LOOP ! Do not apply vent to Geometries. -CALL CC_GRID_RELEASE_BLOCKED_CELL_LISTS(NM) + ! This test is a simplified test for VENTS changing the CFACE SURF_ID to VENT SURF_ID for all CFACEs whose + ! centroid locations lay within the frame of the IOR grid aligned VENT: + ADDMAT = 0._EB; + SELECT CASE(ABS(VT%IOR)) + CASE(IAXIS) + ADDMAT(IAXIS,LOW_IND) = -(XF_MAX-XS_MIN) ! -DX(VT%I1) Set normal size to 2 times domain size. + ADDMAT(IAXIS,HIGH_IND) = (XF_MAX-XS_MIN) ! DX(VT%I2) XF_MAX, etc. defined in cons.f90. + CASE(JAXIS) + ADDMAT(JAXIS,LOW_IND) = -(YF_MAX-YS_MIN) ! -DY(VT%J1) + ADDMAT(JAXIS,HIGH_IND) = (YF_MAX-YS_MIN) ! DY(VT%J2) + CASE(KAXIS) + ADDMAT(KAXIS,LOW_IND) = -(ZF_MAX-ZS_MIN) ! -DZ(VT%K1) + ADDMAT(KAXIS,HIGH_IND) = (ZF_MAX-ZS_MIN) ! DZ(VT%K2) + END SELECT + ! CFACE Loop to modify SURF_INDEX in INTERNAL_CFACE_CELLS: + CFACE_LOOP_2 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + CFA => CFACE(CFACE_INDEX_LOCAL) + BC => BOUNDARY_COORD(CFA%BC_INDEX) + IF (BC%X < X(VT%I1)+ADDMAT(IAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%X > X(VT%I2)+ADDMAT(IAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + IF (BC%Y < Y(VT%J1)+ADDMAT(JAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%Y > Y(VT%J2)+ADDMAT(JAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + IF (BC%Z < Z(VT%K1)+ADDMAT(KAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 + IF (BC%Z > Z(VT%K2)+ADDMAT(KAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 + CFA%VENT_INDEX = IVENT + CFA%SURF_INDEX = VT%SURF_INDEX + ENDDO CFACE_LOOP_2 + ENDDO VENT_LOOP +ENDDO MESH_LOOP_2 +! - At this pont all final values of SURF_INDEX have been given to CFACEs. -IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. -IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 +! Third loop, 1. Compute final FDS area integrals by SURF_ID and GEOM. +! 2. Compute input areas by SURF_ID and GEOM. First sum over GEOM FACES SURF_IDs, +! then VENTS input surfaces are assigned to corresponding GEOMs and SURF_IDs if present (VENTs take precedence). +IF(N_GEOMETRY>0) THEN + ALLOCATE(FDS_AREA_GEOM(0:N_SURF,N_GEOMETRY)); FDS_AREA_GEOM = 0._EB +ENDIF +MESH_LOOP_3 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + CFA => CFACE(CFACE_INDEX_LOCAL) + ICF = CFA%CUT_FACE_IND1; IFACE= CFA%CUT_FACE_IND2 + I = CUT_FACE(ICF)%BODTRI(1,IFACE) + IF(I>0) FDS_AREA_GEOM(CFA%SURF_INDEX,I) = FDS_AREA_GEOM(CFA%SURF_INDEX,I) + CFA%AREA + ENDDO +ENDDO MESH_LOOP_3 +! Sum FDS and INPUT areas per SURF_ID and GEOM (all reduce sum): +IF(N_GEOMETRY>0) & +CALL MPI_ALLREDUCE(MPI_IN_PLACE, FDS_AREA_GEOM(0,1), (N_SURF+1)*N_GEOMETRY, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) -CALL POINT_TO_MESH(NM) -M => MESHES(NM) +! Fourth Loop: Assign AREA_ADJUST for CFACEs, and assign BC info to CFACEs: +MESH_LOOP_4 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) -! Here Add Areas per SURF_ID: -IF (PROCESS(NM)==MY_RANK) THEN - DO ICF=1,M%N_CUTFACE_MESH - CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE - DO J=1,CF%NFACE - IF(.NOT.CF%BLK_TAG(J)) CYCLE - GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & - GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) - ENDDO - ENDDO -ENDIF -! Deallocate arrays: -IF (GET_CUTCELLS_VERBOSE) THEN - IF(M%N_CUTCELL_MESH > 0) THEN - MIN_FACES_PER_CUTCELL = 1000000 !HUGE(MIN_FACES_PER_CUTCELL) - MAX_FACES_PER_CUTCELL = 0 - MEAN_FACES_PER_CUTCELL= 0 - SUM_FACE = 0 - SUM_CCELL= 0 - DO ICC1=1,M%N_CUTCELL_MESH - IF (M%CUT_CELL(ICC1)%NCELL==0) CYCLE - SUM_CCELL = SUM_CCELL + M%CUT_CELL(ICC1)%NCELL - DO ICC2=1,M%CUT_CELL(ICC1)%NCELL - MAX_FACES_PER_CUTCELL = MAX(MAX_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) - MIN_FACES_PER_CUTCELL = MIN(MIN_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) - SUM_FACE = SUM_FACE + M%CUT_CELL(ICC1)%CCELEM(1,ICC2) - ENDDO - ENDDO - IF(SUM_CCELL > TWENTY_EPSILON_EB) MEAN_FACES_PER_CUTCELL = SUM_FACE / SUM_CCELL - ! Write to file: - WRITE(LU_SETCC,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& - MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL - IF (MEAN_FACES_PER_CUTCELL > 30) THEN - WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN - WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ENDIF - ! Write to ERR file: - IF (MY_RANK==0) THEN - WRITE(LU_ERR,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& - MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL - IF (MEAN_FACES_PER_CUTCELL > 30) THEN - WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN - WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& - ' This might make the calculation unnecessarily expensive.' - ENDIF - ENDIF - ENDIF - WRITE(LU_SETCC,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' - WRITE(LU_SETCC,'(A)') ' ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' - WRITE(LU_ERR ,'(A)') ' ' - ENDIF -ENDIF + ! BCs related information for INTERNAL CFACE CELLS: + CFACE_LOOP_4 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS + ICF = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND1 + IFACE = CFACE(CFACE_INDEX_LOCAL)%CUT_FACE_IND2 + SURF_INDEX = CFACE(CFACE_INDEX_LOCAL)%SURF_INDEX + CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_TWO,IS_INB=.TRUE.) + ENDDO CFACE_LOOP_4 -! Here we have to deallocate if no geometric entities were defined: -! EDGE_CROSS is deallocated: -IF (ALLOCATED(M%EDGE_CROSS)) DEALLOCATE(M%EDGE_CROSS) -IF (M%N_CUTEDGE_MESH == 0 .OR. PROCESS(NM)/=MY_RANK) THEN - IF (ALLOCATED(M%CUT_EDGE)) DEALLOCATE(M%CUT_EDGE) -ENDIF -IF (M%N_CUTFACE_MESH+M%N_BBCUTFACE_MESH+M%N_GCCUTFACE_MESH == 0) THEN - IF (ALLOCATED(M%CUT_FACE)) DEALLOCATE(M%CUT_FACE) -ENDIF -IF(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH == 0) THEN - IF (ALLOCATED(M%CUT_CELL)) DEALLOCATE(M%CUT_CELL) -ENDIF +ENDDO MESH_LOOP_4 -! Sanity tests on cut-faces, cut-cells: -IF (DEBUG_SET_CUTCELLS) THEN - CUTFACE_TEST_LOOP : DO ICF=1,M%N_CUTFACE_MESH - NFACE = M%CUT_FACE(ICF)%NFACE - I = M%CUT_FACE(ICF)%IJK(IAXIS) - J = M%CUT_FACE(ICF)%IJK(JAXIS) - K = M%CUT_FACE(ICF)%IJK(KAXIS) - X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) - DO I=1,NFACE - IF(M%CUT_FACE(ICF)%AREA(I) MESHES(NM) +! Meshes Loop: +! First Mesh Loop: +! Test if NOM mesh cells are of the same size or smaller than NM mesh that areas match: +MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX -DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH - CF => M%CUT_FACE(ICF); IF(CF%NFACE==0) CYCLE - ICF1=3 ! BLOCK boundary flag, when == 1,2. - IF (CF%STATUS == CC_GASPHASE) THEN - I = CF%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE - J = CF%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE - K = CF%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE - SELECT CASE(CF%IJK(KAXIS+1)) ! X1AXIS - CASE(IAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DY(J)*DZ(K)); IF(I==0 .OR. I==M%IBAR) ICF1=1 - CASE(JAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DZ(K)*DX(I)); IF(J==0 .OR. J==M%JBAR) ICF1=1 - CASE(KAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DX(I)*DY(J)); IF(K==0 .OR. K==M%KBAR) ICF1=1 - END SELECT - ENDIF - CALL ALLOC_FACE_STATE_VARS(NM,ICF,CF%NFACE,ICF1) -ENDDO + IF (MESHES(NM)%N_CUTFACE_MESH==0) CYCLE MESH_LOOP_1 + CALL POINT_TO_MESH(NM) -DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC); IF(CC%NCELL==0) CYCLE - I = CC%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE - J = CC%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE - K = CC%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE - CC%ALPHA_CC = SUM(CC%VOLUME(1:CC%NCELL))/(DX(I)*DY(J)*DZ(K)) - CALL ALLOC_CELL_STATE_VARS(NM,ICC,CC%NCELL) -ENDDO + EXTERNAL_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS -! Allocate array of indexes of chemically active cut-cells -SUM_CC = 0 -DO ICC=1,M%N_CUTCELL_MESH - SUM_CC = SUM_CC + CC%NCELL -ENDDO -ALLOCATE(M%CHEM_ACTIVE_CC(SUM_CC,3)) -M%CHEM_ACTIVE_CC=-1 + WC=>WALL(IW) + EWC=>EXTERNAL_WALL(IW) + BC=>BOUNDARY_COORD(WC%BC_INDEX) + B1=>BOUNDARY_PROP1(WC%B1_INDEX) + IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & + WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_1 -END SUBROUTINE CC_GRID_ALLOCATE_STATE_VARS + II = BC%II + JJ = BC%JJ + KK = BC%KK + IOR = BC%IOR -SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST + ! Skip if no cut-faces present on this WC: + ! Define underlying Cartesian faces indexes: + SELECT CASE(IOR) + CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-IAXIS) ! Higher X boundary for Mesh NM. + IIF = II - 1; JJF = JJ ; KKF = KK + CASE( JAXIS) ! Lower Y boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-JAXIS) ! Higher Y boundary for Mesh NM. + IIF = II ; JJF = JJ - 1; KKF = KK + CASE( KAXIS) ! Lower Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK + CASE(-KAXIS) ! Higher Z boundary for Mesh NM. + IIF = II ; JJF = JJ ; KKF = KK - 1 + END SELECT + X1AXIS = ABS(IOR) + IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE EXTERNAL_WALL_LOOP_1 -! ALL REDUCE areas per surface: -IF(N_GEOMETRY>0) THEN -CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_OLD(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) -CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) -ENDIF -! Define AREA_ADJUST per SURF_ID: -DO J=1,N_GEOMETRY - DO I=0,N_SURF - IF(GEOM_AREA_SURF_NEW(I,J)>TWENTY_EPSILON_EB) THEN - GEOM_AREA_SURF_NEW(I,J) = GEOM_AREA_SURF_OLD(I,J)/GEOM_AREA_SURF_NEW(I,J) - ELSE; GEOM_AREA_SURF_NEW(I,J) = 1._EB - ENDIF - ENDDO -ENDDO -DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE - DO J=1,CF%NFACE - IF(.NOT.CF%BLK_TAG(J)) CYCLE - CF%AREA_ADJUST(J) = CF%AREA_ADJUST(J)*GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) - ENDDO - ENDDO - DEALLOCATE(MESHES(NM)%INBCF_AREA) -ENDDO + ! Gas cut-face area in wall-cell IW face: + ICF = FCVAR(IIF,JJF,KKF,CC_IDCF,X1AXIS) + AREA_NM = SUM(CUT_FACE(ICF)%AREA(1:CUT_FACE(ICF)%NFACE)) -! GEOM_AREA_SURF_NEW = 0._EB -! DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX -! DO ICF=1,MESHES(NM)%N_CUTFACE_MESH -! CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE -! DO J=1,CF%NFACE -! IF(.NOT.CF%BLK_TAG(J)) CYCLE -! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & -! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) -! ENDDO -! ENDDO -! ENDDO -! CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW,(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) -! DO J=1,N_GEOMETRY -! DO I=0,N_SURF -! IF(MY_RANK==0) WRITE(LU_ERR,*) 'IG,N_SURF,AOLD,ANEW=',J,I,GEOM_AREA_SURF_OLD(I,J),GEOM_AREA_SURF_NEW(I,J) -! ENDDO -! ENDDO -IF(ALLOCATED(GEOM_AREA_SURF_OLD)) DEALLOCATE(GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) + IF(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN + NOM = EWC%NOM ! Use Other Mesh Data. + IF(MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_1 + ! Now Obtain the CUT_FACE for the same face on NM-NOM: -END SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST + AREA_NOM = 0._EB; N_CF=0; N_CRT=0 + DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + SELECT CASE(IOR) + CASE( IAXIS) ! Lower X boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) + CASE(-IAXIS) ! Higher X boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO- 1; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) + CASE( JAXIS) ! Lower Y boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) + CASE(-JAXIS) ! Higher Y boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO ; JJOF= JJO- 1; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) + CASE( KAXIS) ! Lower Z boundary for Mesh NM, Higher for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) + CASE(-KAXIS) ! Higher Z boundary for Mesh NM, Lower for mesh NOM. + IIOF= IIO ; JJOF= JJO ; KKOF= KKO- 1; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) + END SELECT + IF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_FGSC,X1AXIS) == CC_GASPHASE) THEN + AREA_NOM = AREA_NOM + AREA_CRT + N_CRT = N_CRT + 1 + ELSEIF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) > 0) THEN ! there are gasphase cut-faces + ICOF = MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) + AREA_NOM = AREA_NOM + SUM(MESHES(NOM)%CUT_FACE(ICOF)%AREA(1:MESHES(NOM)%CUT_FACE(ICOF)%NFACE)) + N_CF = N_CF + 1 + ENDIF + ENDDO + ENDDO + ENDDO -SUBROUTINE CC_GRID_LOG_PROCESSING_TIME + ! Check if: + ! 1. other mesh faces are more than one -> areas match. + ! 2. other mesh face and size of cartesian faces the same -> areas match. + ! 3. Left the case of fine mesh face with OMESH face coarse. + NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 + IF ( (NOFC > 1) .OR. (ABS(B1%AREA-AREA_CRT) < GEOMEPS) )THEN + IF(ABS(AREA_NM-AREA_NOM) > ADIFF_INFO_FACTOR*AREA_CRT) THEN + WRITE(LU_ERR,*) 'SET_GC_CUTCELLS_3D Error: MESH=',NM,', CUT_FACE=',ICF,' does not match OMESH=',& + NOM,', with CUT_FACEs,CRT_FACEs=',N_CF,N_CRT,', area difference=',& + ABS(AREA_NM-AREA_NOM),', GEOMEPS=',GEOMEPS + WRITE(LU_ERR,*) 'CUT FACE=',ICF,MESHES(NM)%CUT_FACE(ICF)%IJK(1:4),':',MESHES(NM)%CUT_FACE(ICF)%STATUS + ENDIF + ENDIF -! Add to SET_CUTCELLS_3D loop time: -T_CC_USED(SET_CUTCELLS_TIME_INDEX) = T_CC_USED(SET_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW + ENDIF -IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_MESH) - WRITE(LU_SETCC,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' - WRITE(LU_SETCC,'(A)') ' ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' - WRITE(LU_ERR,'(A)') ' ' - ENDIF -ENDIF + ENDDO EXTERNAL_WALL_LOOP_1 -END SUBROUTINE CC_GRID_LOG_PROCESSING_TIME +ENDDO MESH_LOOP_1 -SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING(EARLY_RETURN) -LOGICAL, INTENT(OUT) :: EARLY_RETURN +! Second mesh loop: +! Define cut-cell data on guard-cell region to be communicated: +MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX -EARLY_RETURN = .FALSE. + IF ((MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH)==0) CYCLE MESH_LOOP_2 -IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) + CALL POINT_TO_MESH(NM) -IF(GET_CUTCELLS_VERBOSE) THEN - WRITE(LU_SETCC,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' - WRITE(LU_SETCC,'(A)') ' ' - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' - WRITE(LU_ERR ,'(A)') ' ' - ENDIF -ENDIF + EXTERNAL_WALL_LOOP_2 : DO IW=1,N_EXTERNAL_WALL_CELLS -! Write out: -! Increase SET_CUTCELLS_3D call counter by 1: -CALL_COUNT = CALL_COUNT + 1 -IF(PERIODIC_TEST==105) THEN - CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) - IF(CALL_COUNT > 1) THEN - EARLY_RETURN = .TRUE. - RETURN - ENDIF -ENDIF + WC=>WALL(IW) + BC=>BOUNDARY_COORD(WC%BC_INDEX) + EWC=>EXTERNAL_WALL(IW) + IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & + WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_2 -END SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING + II = BC%II + JJ = BC%JJ + KK = BC%KK + IOR = BC%IOR + NOM = EWC%NOM ! Use Other Mesh Data. -SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY + IF (NOM>0) THEN + IF (MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_2 + ENDIF -! Loop over geometry: -CCVERBOSE_COND : IF(GET_CUTCELLS_VERBOSE) THEN - SLEN_GEOM = 0._EB; AREA_GEOM = 0._EB; VOLUME_GEOM = 0._EB; XYZCEN_GEOM(IAXIS:KAXIS) = 0._EB - DO IG=1,N_GEOMETRY - ! Add length of wet surface edges: - DO IEDGE=1,GEOMETRY(IG)%N_EDGES - SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IEDGE) - DV(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - & - GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) - SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) - SLEN_GEOM = SLEN_GEOM + SLEN - ENDDO - ! Add to wet surface Areas: - AREA_GEOM = AREA_GEOM + GEOMETRY(IG)%GEOM_AREA - ! Add to GEOMETRY volume: - VOLUME_GEOM = VOLUME_GEOM + GEOMETRY(IG)%GEOM_VOLUME - ! Add to XYZCEN for geometries: - XYZCEN_GEOM(IAXIS:KAXIS)= XYZCEN_GEOM(IAXIS:KAXIS) + GEOMETRY(IG)%GEOM_VOLUME * GEOMETRY(IG)%GEOM_XYZCEN(IAXIS:KAXIS) - ENDDO - IF(N_GEOMETRY > 0) XYZCEN_GEOM(IAXIS:KAXIS)=XYZCEN_GEOM(IAXIS:KAXIS)/VOLUME_GEOM + IF (WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN - ! Loop over meshes: - NCUTFACE_INB = 0 - CF_AREA_INB=0._EB - CC_VOLUME_INB=0._EB - GP_VOLUME=0._EB - DM_XYZCEN(IAXIS:KAXIS) = 0._EB - CCGP_XYZCEN(IAXIS:KAXIS) = 0._EB - TESTS_MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - DO ICF1 = 1,MESHES(NM)%N_CUTFACE_MESH - IF (CUT_FACE(ICF1)%STATUS == CC_INBOUNDARY) THEN - NFACE = CUT_FACE(ICF1)%NFACE - CF_AREA_INB = CF_AREA_INB + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - ENDIF - ENDDO - DO ICC1 = 1,MESHES(NM)%N_CUTCELL_MESH - NCELL = CUT_CELL(ICC1)%NCELL - DO ICC2=1,NCELL - CCGP_XYZCEN(IAXIS:KAXIS) = CCGP_XYZCEN(IAXIS:KAXIS) + CUT_CELL(ICC1)%VOLUME(ICC2) * & - CUT_CELL(ICC1)%XYZCEN(IAXIS:KAXIS,ICC2) - IF (CUT_CELL(ICC1)%VOLUME(ICC2) 1) THEN - CC_VOLUME_INB_AUX = CC_VOLUME_INB - CALL MPI_ALLREDUCE(CC_VOLUME_INB_AUX, CC_VOLUME_INB, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) - - GP_VOLUME_AUX = GP_VOLUME - CALL MPI_ALLREDUCE(GP_VOLUME_AUX, GP_VOLUME, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) +RETURN - DM_VOLUME_AUX = DM_VOLUME - CALL MPI_ALLREDUCE(DM_VOLUME_AUX, DM_VOLUME, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) +END SUBROUTINE SET_GC_CUTCELLS_3D - CCGP_XYZCEN_AUX(IAXIS:KAXIS) = CCGP_XYZCEN(IAXIS:KAXIS) - CALL MPI_ALLREDUCE(CCGP_XYZCEN_AUX(1), CCGP_XYZCEN(1), 3, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) +SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) - DM_XYZCEN_AUX(IAXIS:KAXIS) = DM_XYZCEN(IAXIS:KAXIS) - CALL MPI_ALLREDUCE(DM_XYZCEN_AUX(1), DM_XYZCEN(1), 3, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) - ENDIF - CCGP_XYZCEN(IAXIS:KAXIS) = CCGP_XYZCEN(IAXIS:KAXIS) / (CC_VOLUME_INB+GP_VOLUME+TWENTY_EPSILON_EB) - DM_XYZCEN(IAXIS:KAXIS) = DM_XYZCEN(IAXIS:KAXIS) / (DM_VOLUME+TWENTY_EPSILON_EB) +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER :: IDIM,NM,SUM_CCELL,SUM_FACE,K,ICC1,J,I +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTCELL_TYPE), POINTER :: CC - IF (MY_RANK == 0) THEN - WRITE(LU_ERR,"(A,E11.4,A,E11.4,A,E11.4)") & - ' GEOM Gas Volume=',DM_VOLUME-VOLUME_GEOM,', Cut/Regl Gas cells Volume=',GP_VOLUME+CC_VOLUME_INB, & - ', Relative Difference=',((DM_VOLUME-VOLUME_GEOM)-(GP_VOLUME+CC_VOLUME_INB))/(DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - WRITE(LU_SETCC,"(A,E11.4,A,E11.4,A,E11.4)") & - ' GEOM Gas Volume=',DM_VOLUME-VOLUME_GEOM,', Cut/Regl Gas cells Volume=',GP_VOLUME+CC_VOLUME_INB, & - ', Relative Difference=',((DM_VOLUME-VOLUME_GEOM)-(GP_VOLUME+CC_VOLUME_INB))/(DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - WRITE(LU_ERR,"(A,3E12.4)") & - ' GEOM Centroid =',XYZCEN_GEOM(IAXIS:KAXIS) - WRITE(LU_ERR,"(A,3E12.4)") & - ' DOMAIN-GEOM Centroid =',(DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & - (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - WRITE(LU_ERR,"(A,3E12.4)") & - ' Cut/Regl Gas cells Centroid =',CCGP_XYZCEN(IAXIS:KAXIS) - WRITE(LU_ERR,"(A,3E12.4)") & - ' Centroid Relative Difference=',CCGP_XYZCEN(IAXIS:KAXIS)-& - (DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & - (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - WRITE(LU_SETCC,"(A,3E12.4)") & - ' GEOM Centroid =',XYZCEN_GEOM(IAXIS:KAXIS) - WRITE(LU_SETCC,"(A,3E12.4)") & - ' DOMAIN-GEOM Centroid =',(DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & - (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - WRITE(LU_SETCC,"(A,3E12.4)") & - ' Cut/Regl Gas cells Centroid =',CCGP_XYZCEN(IAXIS:KAXIS) - WRITE(LU_SETCC,"(A,3E12.4)") & - ' Centroid Relative Difference=',CCGP_XYZCEN(IAXIS:KAXIS)-& - (DM_XYZCEN(IAXIS:KAXIS)*DM_VOLUME - XYZCEN_GEOM(IAXIS:KAXIS)*VOLUME_GEOM) / & - (DM_VOLUME-VOLUME_GEOM+TWENTY_EPSILON_EB) - ENDIF +DO IDIM=1,MAX_DIM - ! Write out the GEOM Area per SURF_ID: - ALLOCATE(GEOM_AREA_SURF(0:N_SURF)); GEOM_AREA_SURF=0._EB - ALLOCATE(GEOM_SURF(0:N_SURF)); GEOM_SURF=0 - SURF_MESH_LOOP : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - DO ICF=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - CFA=>CFACE(ICF) - GEOM_AREA_SURF(CFA%SURF_INDEX) = GEOM_AREA_SURF(CFA%SURF_INDEX) + CFA%AREA - GEOM_SURF(CFA%SURF_INDEX) = 1 - ENDDO - ENDDO SURF_MESH_LOOP - CALL MPI_ALLREDUCE(MPI_IN_PLACE, GEOM_AREA_SURF(0), N_SURF+1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, IERR) - CALL MPI_ALLREDUCE(MPI_IN_PLACE, GEOM_SURF(0), N_SURF+1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, IERR) - IF (MY_RANK==0) THEN - DO SURF_INDEX=0,N_SURF - IF (GEOM_SURF(SURF_INDEX)>0) & - WRITE(LU_ERR,"(A,1E14.6)") ' SURF_ID = '//TRIM(SURFACE(SURF_INDEX)%ID)//', Area : ',GEOM_AREA_SURF(SURF_INDEX) - WRITE(LU_SETCC,"(A,1E14.6)")' SURF_ID = '//TRIM(SURFACE(SURF_INDEX)%ID)//', Area : ',GEOM_AREA_SURF(SURF_INDEX) - ENDDO - ENDIF - DEALLOCATE(GEOM_AREA_SURF, GEOM_SURF) +! Exchange CC%NOADVANCE(JCC)>0 information among NEIGHBOURING meshes: +CALL EXCHANGE_CC_NOADVANCE_INFO +! Add CC%NOADVANCE(JCC) where needed: +CALL ADD_NEIGHBOR_BLOCKED_CELLS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) - ! Write out special cells info: - N_SPCELLCF_TOT=0; N_SPCELL_TOT=0 - DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - N_SPCELLCF_TOT = N_SPCELLCF_TOT + MESHES(NM)%N_SPCELL_CF - N_SPCELL_TOT = N_SPCELL_TOT + MESHES(NM)%N_SPCELL - WRITE(LU_SETCC,"(A,3I8)") 'MESH, Number of Special Cells CF, Total=',NM,MESHES(NM)%N_SPCELL_CF,MESHES(NM)%N_SPCELL - DO ICC1=1,MESHES(NM)%N_SPCELL - WRITE(LU_SETCC,"(A,2I8,A,3I8)") 'NM,CELL IJK=',NM,ICC1,':',MESHES(NM)%SPCELL_LIST(IAXIS:KAXIS,ICC1) - ENDDO - ENDDO - CALL MPI_ALLREDUCE(MPI_IN_PLACE, N_SPCELLCF_TOT, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, IERR) - CALL MPI_ALLREDUCE(MPI_IN_PLACE, N_SPCELL_TOT, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, IERR) - IF (MY_RANK==0) WRITE(LU_ERR,"(A,2I8)") 'Total Number of Special Cells CF, Total=',N_SPCELLCF_TOT,N_SPCELL_TOT +MAIN_MESH_LOOP_1 : DO NM=1,NMESHES - ! Write out more detailed stats: - WRITE_CFACE_STATS_COND : IF (WRITE_CFACE_STATS) THEN - ! Loop over meshes: - TESTS_MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - NCUTEDGE_IBCC = 0; SLEN_IBCC = 0._EB - NCUTEDGE_IBCF = 0 - ! Number of CUT_EDGE for this mesh: - IF(ALLOCATED(MESHES(NM)%CUT_EDGE)) THEN - DO ICE1 = 1,MESHES(NM)%N_CUTEDGE_MESH - SELECT CASE(MESHES(NM)%CUT_EDGE(ICE1)%STATUS) - CASE(CC_INBOUNDCC) - NEDGE = MESHES(NM)%CUT_EDGE(ICE1)%NEDGE - NCUTEDGE_IBCC = NCUTEDGE_IBCC + NEDGE - DO IEDGE=1,NEDGE - SEG(NOD1:NOD2) = MESHES(NM)%CUT_EDGE(ICE1)%CEELEM(NOD1:NOD2,IEDGE) - DV(IAXIS:KAXIS) = MESHES(NM)%CUT_EDGE(ICE1)%XYZVERT(IAXIS:KAXIS,SEG(NOD2)) - & - MESHES(NM)%CUT_EDGE(ICE1)%XYZVERT(IAXIS:KAXIS,SEG(NOD1)) - SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) - SLEN_IBCC = SLEN_IBCC + SLEN - ENDDO - CASE(CC_INBOUNDCF) - SELECT CASE(MESHES(NM)%CUT_EDGE(ICE1)%IJK(4)) - CASE(IAXIS) - IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(IAXIS) == IBAR) CYCLE - CASE(JAXIS) - IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(JAXIS) == JBAR) CYCLE - CASE(KAXIS) - IF(MESHES(NM)%CUT_EDGE(ICE1)%IJK(KAXIS) == KBAR) CYCLE - END SELECT - NCUTEDGE_IBCF = NCUTEDGE_IBCF + MESHES(NM)%CUT_EDGE(ICE1)%NEDGE - END SELECT - ENDDO - ENDIF + IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. + IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'MESH=',NM - WRITE(LU_SETCC,*) 'CUTEDGE=',PROCESS(NM),NM,MESHES(NM)%N_CUTEDGE_MESH,MESHES(NM)%N_EDGE_CROSS - !WRITE(LU_SETCC,*) 'NCUTEDGE_IBCF =',NCUTEDGE_IBCF - !WRITE(LU_SETCC,*) 'NCUTEDGE_IBCC =',NCUTEDGE_IBCC, ', SLEN_IBCC =',SLEN_IBCC,', SLEN_GEOM =',SLEN_GEOM + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) - NCUTFACE_IAXIS = 0 - NCUTFACE_JAXIS = 0 - NCUTFACE_KAXIS = 0 - CF_AREA_IAXIS=0._EB; CF_AREA_JAXIS=0._EB; CF_AREA_KAXIS=0._EB - CF_INXAREA_IAXIS=0._EB; CF_INXAREA_JAXIS=0._EB; CF_INXAREA_KAXIS=0._EB - CF_INXSQAREA_IAXIS=0._EB; CF_INXSQAREA_JAXIS=0._EB; CF_INXSQAREA_KAXIS=0._EB - CF_JNYSQAREA_IAXIS=0._EB; CF_JNYSQAREA_JAXIS=0._EB; CF_JNYSQAREA_KAXIS=0._EB - CF_KNZSQAREA_IAXIS=0._EB; CF_KNZSQAREA_JAXIS=0._EB; CF_KNZSQAREA_KAXIS=0._EB - NCUTFACE_INB = 0 - CF_AREA_INB=0._EB; CF_INXAREA_INB=0._EB; - CF_INXSQAREA_INB=0._EB; CF_JNYSQAREA_INB=0._EB; CF_KNZSQAREA_INB=0._EB - DO ICF1 = 1,MESHES(NM)%N_CUTFACE_MESH - IF (CUT_FACE(ICF1)%STATUS == CC_GASPHASE) THEN - NFACE = CUT_FACE(ICF1)%NFACE - X1AXIS= CUT_FACE(ICF1)%IJK(MAX_DIM+1) - SELECT CASE(X1AXIS) - CASE(IAXIS) - NCUTFACE_IAXIS = NCUTFACE_IAXIS + NFACE - CF_AREA_IAXIS = CF_AREA_IAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_IAXIS = CF_INXAREA_IAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_IAXIS=CF_INXSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_IAXIS=CF_JNYSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_IAXIS=CF_KNZSQAREA_IAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - CASE(JAXIS) - NCUTFACE_JAXIS = NCUTFACE_JAXIS + NFACE - CF_AREA_JAXIS = CF_AREA_JAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_JAXIS = CF_INXAREA_JAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_JAXIS=CF_INXSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_JAXIS=CF_JNYSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_JAXIS=CF_KNZSQAREA_JAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - CASE(KAXIS) - NCUTFACE_KAXIS = NCUTFACE_KAXIS + NFACE - CF_AREA_KAXIS = CF_AREA_KAXIS + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_KAXIS = CF_INXAREA_KAXIS + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_KAXIS=CF_INXSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_KAXIS=CF_JNYSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_KAXIS=CF_KNZSQAREA_KAXIS+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - END SELECT - ELSE ! CC_INBOUNDARY.. - NFACE = CUT_FACE(ICF1)%NFACE - CF_AREA_INB = CF_AREA_INB + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) - CF_INXAREA_INB = CF_INXAREA_INB + SUM(CUT_FACE(ICF1)%INXAREA(1:NFACE)) - CF_INXSQAREA_INB=CF_INXSQAREA_INB+SUM(CUT_FACE(ICF1)%INXSQAREA(1:NFACE)) - CF_JNYSQAREA_INB=CF_JNYSQAREA_INB+SUM(CUT_FACE(ICF1)%JNYSQAREA(1:NFACE)) - CF_KNZSQAREA_INB=CF_KNZSQAREA_INB+SUM(CUT_FACE(ICF1)%KNZSQAREA(1:NFACE)) - ENDIF - ENDDO - !WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'CUTFACE=',PROCESS(NM),NM,MESHES(NM)%N_CUTFACE_MESH - WRITE(LU_SETCC,*) 'CUTFACE X Y Z=',NCUTFACE_IAXIS,NCUTFACE_JAXIS,NCUTFACE_KAXIS - !WRITE(LU_SETCC,*) 'CF_AREA X Y Z=',CF_AREA_IAXIS,CF_AREA_JAXIS,CF_AREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_INXAREA X Y Z=',CF_INXAREA_IAXIS,CF_INXAREA_JAXIS,CF_INXAREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_INXSQAREA X Y Z=',CF_INXSQAREA_IAXIS,CF_INXSQAREA_JAXIS,CF_INXSQAREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_JNYSQAREA X Y Z=',CF_JNYSQAREA_IAXIS,CF_JNYSQAREA_JAXIS,CF_JNYSQAREA_KAXIS - !WRITE(LU_SETCC,*) 'CF_KNZSQAREA X Y Z=',CF_KNZSQAREA_IAXIS,CF_KNZSQAREA_JAXIS,CF_KNZSQAREA_KAXIS - !WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'CUTFACE INB=',NCUTFACE_INB - !WRITE(LU_SETCC,*) 'CF_AREA, CF_INXAREA INB=',CF_AREA_INB,CF_INXAREA_INB - !WRITE(LU_SETCC,*) 'CF_INXSQAREA INB =',CF_INXSQAREA_INB,CF_JNYSQAREA_INB,CF_KNZSQAREA_INB + ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: + CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) - ! Cut-cells: - MIN_CC_IJK_ICCJCC(1:5) = 0 - MAX_CC_IJK_ICCJCC(1:5) = 0 - MIN_CC_VOL = 1.E20_EB; MIN_ALPHA_CV = 1.E20_EB - MAX_CC_VOL =-1.E20_EB; MAX_ALPHA_CV =-1.E20_EB - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH - CC => CUT_CELL(ICC1) - DO ICC2=1,CC%NCELL - IF(CC%VOLUME(ICC2) < MIN_CC_VOL) THEN - MIN_CC_VOL = CC%VOLUME(ICC2) - MIN_ALPHA_CV = MIN_CC_VOL / ( DX(CC%IJK(IAXIS))*DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) ) - MIN_CC_IJK_ICCJCC(1:5) = (/ CC%IJK(1:3), ICC1, ICC2 /) - ENDIF - IF(CC%VOLUME(ICC2) > MAX_CC_VOL) THEN - MAX_CC_VOL = CC%VOLUME(ICC2) - MAX_ALPHA_CV = MAX_CC_VOL / ( DX(CC%IJK(IAXIS))*DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) ) - MAX_CC_IJK_ICCJCC(1:5) = (/ CC%IJK(1:3), ICC1, ICC2 /) - ENDIF - ENDDO - ENDDO - WRITE(LU_SETCC,*) ' ' - WRITE(LU_SETCC,*) 'CUTCELL=',PROCESS(NM),NM,MESHES(NM)%N_CUTCELL_MESH - WRITE(LU_SETCC,*) 'MIN VOL=',MIN_CC_IJK_ICCJCC(1:5),MIN_CC_VOL,MIN_ALPHA_CV - WRITE(LU_SETCC,*) 'MAX VOL=',MAX_CC_IJK_ICCJCC(1:5),MAX_CC_VOL,MAX_ALPHA_CV + IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + CALL GET_CELL_LINK_INFO(NM) + ENDIF - ! Dump info for Max Size Cut-cell: - DO IG=1,2 - IF(IG==1) THEN; ICC1 = MIN_CC_IJK_ICCJCC(4); ICC2 = MIN_CC_IJK_ICCJCC(5); ENDIF - IF(IG==2) THEN; ICC1 = MAX_CC_IJK_ICCJCC(4); ICC2 = MAX_CC_IJK_ICCJCC(5); ENDIF - IF(ICC1==0) CYCLE - CC => CUT_CELL(ICC1) - I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) - IF(IG==1) THEN; WRITE(LU_SETCC,*) 'MIN VOL CC cut-faces:',I,J,K; ENDIF - IF(IG==2) THEN; WRITE(LU_SETCC,*) 'MAX VOL CC cut-faces:',I,J,K; ENDIF - DO JCF=2,CC%CCELEM(1,ICC2)+1 - IFACE = CC%CCELEM(JCF,ICC2) - FTYPE = CC%FACE_LIST(1,IFACE) - ILH = CC%FACE_LIST(2,IFACE) - 2 ! -1 for LOW_IND, 0 for HIGH_IND - X1AXIS= CC%FACE_LIST(3,IFACE) - SELECT CASE(FTYPE) - CASE(CC_FTYPE_RCGAS) - SELECT CASE(X1AXIS) - CASE(IAXIS); I=CC%IJK(IAXIS)+ILH; ACRT = DY(CC%IJK(JAXIS))*DZ(CC%IJK(KAXIS)) - CASE(JAXIS); J=CC%IJK(JAXIS)+ILH; ACRT = DX(CC%IJK(IAXIS))*DZ(CC%IJK(KAXIS)) - CASE(KAXIS); K=CC%IJK(KAXIS)+ILH; ACRT = DY(CC%IJK(JAXIS))*DX(CC%IJK(IAXIS)) - END SELECT - WRITE(LU_SETCC,*) JCF-1,' RCGAS ',I,J,K,X1AXIS,ACRT,ACRT/ACRT - CASE(CC_FTYPE_CFGAS) - SELECT CASE(X1AXIS) - CASE(IAXIS); ACRT = DY(J)*DZ(K) - CASE(JAXIS); ACRT = DX(I)*DZ(K) - CASE(KAXIS); ACRT = DY(J)*DX(I) - END SELECT - ICF2 = CC%FACE_LIST(4,IFACE) - JCF2 = CC%FACE_LIST(5,IFACE) - WRITE(LU_SETCC,*) JCF-1,' CFGAS ',CUT_FACE(ICF2)%IJK(1:KAXIS+1),CUT_FACE(ICF2)%AREA(JCF2),& - CUT_FACE(ICF2)%AREA(JCF2)/ACRT - CASE(CC_FTYPE_CFINB) - ICF2 = CC%FACE_LIST(4,IFACE) - JCF2 = CC%FACE_LIST(5,IFACE) - ACRT = 1._EB/3._EB*(DY(J)*DZ(K)+DX(I)*DZ(K)+DY(J)*DX(I)) - WRITE(LU_SETCC,*) JCF-1,' CFINB ',CUT_FACE(ICF2)%IJK(1:KAXIS+1),CUT_FACE(ICF2)%AREA(JCF2) - END SELECT - ENDDO + ! Block any cells that contain only one gas cut-face (cavity type cut-cells): + K = 0 + DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + CC=>MESHES(NM)%CUT_CELL(ICC1) + DO J=1,CC%NCELL + SUM_FACE=0; SUM_CCELL=0 + DO I=2,CC%CCELEM(1,J) + SELECT CASE(CC%FACE_LIST(1,CC%CCELEM(I,J))) + CASE(CC_FTYPE_CFGAS); SUM_FACE = SUM_FACE+1 + CASE(CC_FTYPE_RCGAS); SUM_CCELL=SUM_CCELL+1 + END SELECT ENDDO + IF(SUM_FACE>1 .OR. SUM_CCELL>0) CYCLE + IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J)=BLOCKED_CAVITY_CELL + K=K+1 + ENDDO + ENDDO + IF (K>0) THEN + CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) + IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + CALL GET_CELL_LINK_INFO(NM) + ENDIF + ENDIF + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) +ENDDO MAIN_MESH_LOOP_1 - ENDDO TESTS_MESH_LOOP_2 - ENDIF WRITE_CFACE_STATS_COND -ENDIF CCVERBOSE_COND +! Call tag boundary cut-cells for blocking in refinement interfaces: +CALL TAG_CC_BLOCKING_REFINEMENT -END SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY +ENDDO -SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS +FINAL_BLOCK_MESH_LOOP : DO NM=1,NMESHES + + IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. + IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 + + CALL POINT_TO_MESH(NM) + M => MESHES(NM) + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) + + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + + ! Here: 1,2. Define Linking information for cut-cells. + CALL GET_CELL_LINK_INFO(NM) + + ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: + CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) + IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + CALL GET_CELL_LINK_INFO(NM) + ENDIF + + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) +ENDDO FINAL_BLOCK_MESH_LOOP + +END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK + +SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) USE TRAN, ONLY: GET_IJK -INTEGER :: NM2,ICELL,I2,J2,K2,BLOCK_TAG +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER :: NM,NOM,I,J,K,ICC,JCC,NM2,ICELL,I2,J2,K2,BLOCK_TAG LOGICAL :: IND_FOUND REAL(EB):: XCO,YCO,ZCO,VOL_NM,VOL_NOM,X1,Y1,Z1 -TYPE(MESH_TYPE), POINTER :: M2 +TYPE(MESH_TYPE), POINTER :: M,M2 MESH_LOOP : DO NM=1,NMESHES @@ -12301,11 +12133,25 @@ SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS END SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS - SUBROUTINE TAG_CC_BLOCKING_REFINEMENT LOGICAL, PARAMETER :: DO_RAY_TRACING=.TRUE. +INTEGER :: NM,NOM,IW,II,JJ,KK,IIF,JJF,KKF,IIOF,JJOF,KKOF,LOHIF,IOR,CT,NCFACE_CUTCELL,NFACE_CELL,AX,SIDE,ICC,JCC,ICFC,IFC,IFACE +INTEGER :: IIO,JJO,KKO,IOGC,JOGC,KOGC INTEGER :: DUM,II1,JJ1,KK1,IIO1,JJO1,KKO1,IIO2,JJO2,KKO2,IIG,JJG,KKG,IIOG,JJOG,KKOG +INTEGER :: X1AXIS,NCELL +TYPE(MESH_TYPE), POINTER :: M,M2 +TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC +TYPE(WALL_TYPE), POINTER :: WC +TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME +INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) IF ( DO_RAY_TRACING) THEN @@ -12619,7 +12465,16 @@ SUBROUTINE TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL) INTEGER, INTENT(IN) :: NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1 LOGICAL, INTENT(IN) :: FINE_CELL +INTEGER :: CT,NCFACE_CUTCELL,NCELL,NFACE_CELL,AX,SIDE,ICFC,ICC,ICC2 TYPE(MESH_TYPE), POINTER :: M,M2 +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE +REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN +REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME +INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) + M =>MESHES( NM) M2=>MESHES(NOM) @@ -12736,6 +12591,7 @@ SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) INTEGER, INTENT(IN) :: NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2 +INTEGER :: I,J,K,IFC,IFACE INTEGER :: JCC,FC_FOUND,FC_TYPE,INBFC,INBFC_LOC,VERT_CUTFACE,NVERT,X1AXIS,X2AXIS,X3AXIS,NCROSS,DIRRAY,IFC1,JFC1,& NVERT2,VERT_CUTFACE2,IV,IFCC,IFACE2,IFC2,JFC2 TYPE(MESH_TYPE), POINTER :: M,M2 @@ -13012,8 +12868,14 @@ SUBROUTINE GET_CC_FACE_CELL_LIST_INFO(NM,PHASE) INTEGER, INTENT(IN) :: PHASE ! Local Vars: -INTEGER :: ICC,JCC,IFC,IFACE,ICF1,ICF2,JCF,ICE,JCE,IIE,JJE,KKE,IIF,JJF,KKF,X1AXIS,EAXIS,IEDG_LOC,IEDGE +INTEGER :: I,J,K,ICC,JCC,ICF,IFC,IFACE,ICF1,ICF2,JCF,ICE,JCE,IIE,JJE,KKE,IIF,JJF,KKF +INTEGER :: X1AXIS,EAXIS,IEDG_LOC,IEDGE +CHARACTER(100) :: FILENAME TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTFACE_TYPE), POINTER :: CF +TYPE(CC_CUTEDGE_TYPE), POINTER :: CE + M=>MESHES(NM) ! FACE-CELL incidence: @@ -13283,8 +13145,15 @@ SUBROUTINE GET_CC_FACE_CELL_LIST_INFO(NM,PHASE) RETURN END SUBROUTINE GET_CC_FACE_CELL_LIST_INFO +SUBROUTINE CC_GRID_RELEASE_BLOCKED_CELL_LISTS(NM) + +INTEGER, INTENT(IN) :: NM + +MESHES(NM)%N_CC_BLOCKED = 0 +IF(ALLOCATED(MESHES(NM)%XYZ_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED) +IF(ALLOCATED(MESHES(NM)%JBT_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%JBT_CC_BLOCKED) -! --------------------- DEALLOCATE_CUTCELLS_CONN_MESH -------------------------- +END SUBROUTINE CC_GRID_RELEASE_BLOCKED_CELL_LISTS SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH(NM) @@ -13333,617 +13202,780 @@ SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH(NM) RETURN END SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH +SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM,CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_AREA_SURF_OLD) +INTEGER, INTENT(IN) :: NM +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_AREA_SURF_OLD -! ---------------------- GET_EXT_INB_CUTFACES_TO_CFACE -------------------------------- +INTEGER :: I,J,K,IFC,IFACE,ICF,JCF,IG,ICC,ICC1,NCELL,JCC,CELL_BLOCK_IOR +REAL(EB) :: CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) +REAL(EB), ALLOCATABLE, DIMENSION(:) :: VOLUME +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTFACE_TYPE), POINTER :: CF -SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 -! Local Variables: -INTEGER :: ICF, CFACE_INDEX_LOCAL, SURF_INDEX -INTEGER :: IVENT -REAL(EB):: ADDMAT(IAXIS:KAXIS,LOW_IND:HIGH_IND) +CALL POINT_TO_MESH(NM) +M => MESHES(NM) +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) -! GET_CUTCELLS_VERBOSE variables: -INTEGER, ALLOCATABLE, DIMENSION(:) :: NCFACE_BY_MESH +! Block SPCELLS, cells in cut-cell region where cut-cells could not be built. +IF (MESHES(NM)%N_SPCELLS_TO_BLOCK > 0 .AND. ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) THEN + DO ICC=1,MESHES(NM)%N_SPCELLS_TO_BLOCK + I = MESHES(NM)%SPCELL_LIST(IAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + J = MESHES(NM)%SPCELL_LIST(JAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + K = MESHES(NM)%SPCELL_LIST(KAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) + ICC1 = MESHES(NM)%CCVAR(I,J,K,CC_IDCC) + IF (ICC1 > 0) THEN + CC => MESHES(NM)%CUT_CELL(ICC1) + CC%NOADVANCE(1:CC%NCELL) = BLOCKED_SPECIAL_CELL + ENDIF + ENDDO +ENDIF +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) +MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 -TYPE(VENTS_TYPE), POINTER :: VT -TYPE(CFACE_TYPE), POINTER :: CFA +IF (ONE_CC_PER_CARTESIAN_CELL) THEN + ! Here Block all cells that have volume less (or equal) than the first largest cell found. + DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + CC=>MESHES(NM)%CUT_CELL(ICC1) + NCELL=0 + DO J=1,CC%NCELL + IF(CC%NOADVANCE(J)==NOT_BLOCKED) NCELL=NCELL+1 + ENDDO + IF(NCELL<2) CYCLE + ! Find if any GEOMETRY related to CC_INBOUNDARY faces has CELL_BLOCK_IOR>0: + CELL_BLOCK_IOR=0; CELL_BLOCK_ORIENTATION = 0._EB + NCELL_LOOP_1 : DO J=1,CC%NCELL + DO I=2,CC%CCELEM(1,J)+1 + IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN + ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) + IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) + IF(IG>0) THEN + IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN + CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION + ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN + CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR + EXIT NCELL_LOOP_1 + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO NCELL_LOOP_1 + ALLOCATE(VOLUME(1:CC%NCELL)); VOLUME(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN + ! Cell Block Orientation: + DO J=1,CC%NCELL; VOLUME(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)); ENDDO + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN + ! Make search for double precision min/max unambiguous. + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS,IAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) + CASE(-JAXIS,JAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) + CASE(-KAXIS,KAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) + END SELECT + DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( IAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE(-JAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( JAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE(-KAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) + CASE( KAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) + END SELECT + ENDIF + DEALLOCATE(VOLUME) + NCELL_LOOP_2 : DO J=1,CC%NCELL + IF(J==I) CYCLE NCELL_LOOP_2 + IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL + ENDDO NCELL_LOOP_2 + ENDDO +ENDIF -IF(GET_CUTCELLS_VERBOSE) CALL CPU_TIME(CPUTIME_START) +CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) -ALLOCATE(NCFACE_BY_MESH(1:NMESHES)); NCFACE_BY_MESH(1:NMESHES) = 0 -MESH_LOOP_0 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - ! First N_EXTERNAL_CFACE_CELLS: - DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE - CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE - CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE - END SELECT - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO - ! Second N_INTWALL_CFACE_CELLS: - DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - CASE(JAXIS) - IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - CASE(KAXIS) - IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS)==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IF (CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS)==0) CYCLE - ENDIF - END SELECT - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO - ! Second N_INTERNAL_CFACE_CELLS: - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE - ! Don't count INB cut-faces inside an OBST: - IF (CELL(CELL_INDEX(CF%IJK(IAXIS),CF%IJK(JAXIS),CF%IJK(KAXIS)))%SOLID) CYCLE - NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE - ENDDO -ENDDO MESH_LOOP_0 +! Here: 1,2. Define Linking information for cut-cells. +CALL GET_CELL_LINK_INFO(NM) -IF(GET_CUTCELLS_VERBOSE) THEN - CALL MPI_ALLREDUCE(MPI_IN_PLACE,NCFACE_BY_MESH(1),NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) - WRITE(LU_SETCC,'(A,I10)',advance='no') ' 4. Generating CFACES from cut-faces, total CFACE_CELLS=', & - SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) - IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A,I10)') ' Total number of CFACES in all processes=', & - SUM(NCFACE_BY_MESH(1:NMESHES)) - WRITE(LU_ERR ,'(A,I10)',advance='no') & - ' 4. Process 0 Generating CFACES from cut-faces, total CFACE_CELLS=', & - SUM(NCFACE_BY_MESH(LOWER_MESH_INDEX:UPPER_MESH_INDEX)) - ENDIF +IF(PROCESS(NM)==MY_RANK) THEN ! Here Add Blocked Areas per SURF_ID: + ALLOCATE(MESHES(NM)%INBCF_AREA(0:MESHES(NM)%IBP1,0:MESHES(NM)%JBP1,0:MESHES(NM)%KBP1)) + DO K=1,M%KBAR + DO J=1,M%JBAR + DO I=1,M%IBAR + ICC = MESHES(NM)%CCVAR(I,J,K,CC_IDCC); IF(ICC<1) CYCLE + CC =>MESHES(NM)%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + IF(CC%NOADVANCE(JCC)<1) CYCLE + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE=CC%CCELEM(IFC,JCC) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO ENDIF +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) -! First mesh Loop, Allocate storage for CFACES, CFACE geometric info: -MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) +END SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH - ! ALLOCATE to zero size - IF(ALLOCATED(MESHES(NM)%CFACE)) DEALLOCATE(MESHES(NM)%CFACE) - MESHES(NM)%N_CFACE_CELLS_DIM = NCFACE_BY_MESH(NM) - ALLOCATE(MESHES(NM)%CFACE(0:MESHES(NM)%N_CFACE_CELLS_DIM)) +SUBROUTINE CC_GRID_POSTPROCESS_AND_CLEANUP(NM,CC_COMPUTE_MESH,GEOM_AREA_SURF_NEW) - ALLOCATE(MESHES(NM)%FACE_WORK1(MESHES(NM)%N_CFACE_CELLS_DIM)) - ALLOCATE(MESHES(NM)%FACE_WORK2(MESHES(NM)%N_CFACE_CELLS_DIM)) - ALLOCATE(MESHES(NM)%FACE_WORK3(MESHES(NM)%N_CFACE_CELLS_DIM)) +INTEGER, INTENT(IN) :: NM +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_AREA_SURF_NEW - ! Define pointers among External CC_GASPHASE CUT_FACE and CFACE (N_EXTERNAL_CFACE_CELLS): - CFACE_INDEX_LOCAL = 0 - DO ICF=1,MESHES(NM)%N_BBCUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST: - SELECT CASE(X1AXIS) - CASE(IAXIS); IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) CYCLE - CASE(JAXIS); IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) CYCLE - CASE(KAXIS); IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) CYCLE - END SELECT - ! Now get WALL cell SURF_INDEX: - IW = 0 - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (I==0 ) IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-1) - IF (I==IBAR) IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( 1) - CASE(JAXIS) - IF (J==0 ) IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-2) - IF (J==JBAR) IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( 2) - CASE(KAXIS) - IF (K==0 ) IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-3) - IF (K==KBAR) IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( 3) - END SELECT - SURF_INDEX = WALL(IW)%SURF_INDEX - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) - ENDDO - ENDDO - MESHES(NM)%N_EXTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - ! Define pointers among internal CC_GASPHASE CUT_FACE and CFACE (N_INTWALL_CFACE_CELLS): - DO ICF=MESHES(NM)%N_BBCUTFACE_MESH+1,MESHES(NM)%N_CUTFACE_MESH - CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_GASPHASE) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS); X1AXIS = CF%IJK(KAXIS+1) - ! Don't count cut-faces inside an OBST, or don't lay on a WALL_CELL: - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF (ALL(CELL(CELL_INDEX(I:I+1,J,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I:I+1,J,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I+1,J,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I+1,J,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I ,J,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE - ENDIF - CASE(JAXIS) - IF (ALL(CELL(CELL_INDEX(I,J:J+1,K))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J:J+1,K))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J+1,K))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J+1,K))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J ,K))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE - ENDIF - CASE(KAXIS) - IF (ALL(CELL(CELL_INDEX(I,J,K:K+1))%SOLID) .OR. ALL(.NOT.CELL(CELL_INDEX(I,J,K:K+1))%SOLID)) THEN; CYCLE - ELSEIF( CELL(CELL_INDEX(I,J,K))%SOLID .AND. .NOT.CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J,K+1))%WALL_INDEX(-X1AXIS); IF (IW==0) CYCLE - ELSEIF(.NOT.CELL(CELL_INDEX(I,J,K))%SOLID .AND. CELL(CELL_INDEX(I,J,K+1))%SOLID) THEN - IW = CELL(CELL_INDEX(I,J,K ))%WALL_INDEX( X1AXIS); IF (IW==0) CYCLE - ENDIF - END SELECT - SURF_INDEX = WALL(IW)%SURF_INDEX - IF(.NOT.ALLOCATED(CF%CFACE_INDEX)) THEN; ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) - ELSEIF (SIZE(CF%CFACE_INDEX,DIM=1)/=CF%NFACE)THEN - DEALLOCATE(CF%CFACE_INDEX); ALLOCATE(CF%CFACE_INDEX(CF%NFACE)) - ENDIF - IF(.NOT.ALLOCATED(CF%SURF_INDEX)) THEN; ALLOCATE(CF%SURF_INDEX(CF%NFACE)) - ELSEIF (SIZE(CF%SURF_INDEX,DIM=1)/=CF%NFACE)THEN - DEALLOCATE(CF%SURF_INDEX); ALLOCATE(CF%SURF_INDEX(CF%NFACE)) - ENDIF +INTEGER :: I,J,K,X1AXIS,ICF,ICC1,ICC2,MIN_FACES_PER_CUTCELL,MAX_FACES_PER_CUTCELL +INTEGER :: MEAN_FACES_PER_CUTCELL,SUM_FACE,SUM_CCELL,NFACE,NCELL +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTFACE_TYPE), POINTER :: CF - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.FALSE.,IW=IW) +CALL CC_GRID_RELEASE_BLOCKED_CELL_LISTS(NM) + +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 + +CALL POINT_TO_MESH(NM) +M => MESHES(NM) + +! Here Add Areas per SURF_ID: +IF (PROCESS(NM)==MY_RANK) THEN + DO ICF=1,M%N_CUTFACE_MESH + CF=>M%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE + DO J=1,CF%NFACE + IF(.NOT.CF%BLK_TAG(J)) CYCLE + GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & + GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) ENDDO ENDDO - MESHES(NM)%N_INTWALL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%N_EXTERNAL_CFACE_CELLS - MESHES(NM)%INTERNAL_CFACE_CELLS_LB = MESHES(NM)%N_EXTERNAL_CFACE_CELLS + MESHES(NM)%N_INTWALL_CFACE_CELLS - ! Define pointers among CC_INBOUNDARY CUT_FACE and CFACE (N_INTERNAL_CFACE_CELLS): - DO ICF=1,MESHES(NM)%N_CUTFACE_MESH - CF => MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE - I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS) - ! Don't count INB cut-faces inside an OBST: - IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE - DO IFACE=1,CF%NFACE - CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 - ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. - CF%CFACE_INDEX(IFACE) = CFACE_INDEX_LOCAL - SURF_INDEX = CF%SURF_INDEX(IFACE) - CALL INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX_LOCAL,SURF_INDEX,INTEGER_ONE,IS_INB=.TRUE.) +ENDIF +! Deallocate arrays: +IF (GET_CUTCELLS_VERBOSE) THEN + IF(M%N_CUTCELL_MESH > 0) THEN + MIN_FACES_PER_CUTCELL = 1000000 !HUGE(MIN_FACES_PER_CUTCELL) + MAX_FACES_PER_CUTCELL = 0 + MEAN_FACES_PER_CUTCELL= 0 + SUM_FACE = 0 + SUM_CCELL= 0 + DO ICC1=1,M%N_CUTCELL_MESH + IF (M%CUT_CELL(ICC1)%NCELL==0) CYCLE + SUM_CCELL = SUM_CCELL + M%CUT_CELL(ICC1)%NCELL + DO ICC2=1,M%CUT_CELL(ICC1)%NCELL + MAX_FACES_PER_CUTCELL = MAX(MAX_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) + MIN_FACES_PER_CUTCELL = MIN(MIN_FACES_PER_CUTCELL,M%CUT_CELL(ICC1)%CCELEM(1,ICC2)) + SUM_FACE = SUM_FACE + M%CUT_CELL(ICC1)%CCELEM(1,ICC2) + ENDDO ENDDO - IF(ALLOCATED(CF%CFACE_ORIGIN)) DEALLOCATE(CF%CFACE_ORIGIN) - ENDDO - MESHES(NM)%N_INTERNAL_CFACE_CELLS = CFACE_INDEX_LOCAL - MESHES(NM)%INTERNAL_CFACE_CELLS_LB -ENDDO MESH_LOOP_1 - -! Second loop, apply VENTS to change SURF_ID associated with CFACEs: -MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - CALL POINT_TO_MESH(NM) - - ! ! Currently : Modify CFACE SURF_INDEX with VENT information: This needs more development. + IF(SUM_CCELL > TWENTY_EPSILON_EB) MEAN_FACES_PER_CUTCELL = SUM_FACE / SUM_CCELL + ! Write to file: + WRITE(LU_SETCC,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& + MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL + IF (MEAN_FACES_PER_CUTCELL > 30) THEN + WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN + WRITE(LU_SETCC,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ENDIF + ! Write to ERR file: + IF (MY_RANK==0) THEN + WRITE(LU_ERR,'(A,3I8)') ' Min, Max, Mean Faces per cut-cell in mesh : ',& + MIN_FACES_PER_CUTCELL, MAX_FACES_PER_CUTCELL, MEAN_FACES_PER_CUTCELL + IF (MEAN_FACES_PER_CUTCELL > 30) THEN + WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is EXTREMELY fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ELSEIF (MEAN_FACES_PER_CUTCELL > 15) THEN + WRITE(LU_ERR,'(A,A)') ' NOTE : GEOMETRY triangulation is fine for FDS Cartesian mesh.',& + ' This might make the calculation unnecessarily expensive.' + ENDIF + ENDIF + ENDIF + WRITE(LU_SETCC,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' + WRITE(LU_SETCC,'(A)') ' ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A,I8,A)') ' Processing mesh : ',NM,' finished.' + WRITE(LU_ERR ,'(A)') ' ' + ENDIF +ENDIF - VENT_LOOP : DO IVENT=1,MESHES(NM)%N_VENT - VT => VENTS(IVENT) - IF(.NOT.VT%GEOM) CYCLE VENT_LOOP ! Do not apply vent to Geometries. +! Here we have to deallocate if no geometric entities were defined: +! EDGE_CROSS is deallocated: +IF (ALLOCATED(M%EDGE_CROSS)) DEALLOCATE(M%EDGE_CROSS) +IF (M%N_CUTEDGE_MESH == 0 .OR. PROCESS(NM)/=MY_RANK) THEN + IF (ALLOCATED(M%CUT_EDGE)) DEALLOCATE(M%CUT_EDGE) +ENDIF +IF (M%N_CUTFACE_MESH+M%N_BBCUTFACE_MESH+M%N_GCCUTFACE_MESH == 0) THEN + IF (ALLOCATED(M%CUT_FACE)) DEALLOCATE(M%CUT_FACE) +ENDIF +IF(M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH == 0) THEN + IF (ALLOCATED(M%CUT_CELL)) DEALLOCATE(M%CUT_CELL) +ENDIF - ! This test is a simplified test for VENTS changing the CFACE SURF_ID to VENT SURF_ID for all CFACEs whose - ! centroid locations lay within the frame of the IOR grid aligned VENT: - ADDMAT = 0._EB; - SELECT CASE(ABS(VT%IOR)) - CASE(IAXIS) - ADDMAT(IAXIS,LOW_IND) = -(XF_MAX-XS_MIN) ! -DX(VT%I1) Set normal size to 2 times domain size. - ADDMAT(IAXIS,HIGH_IND) = (XF_MAX-XS_MIN) ! DX(VT%I2) XF_MAX, etc. defined in cons.f90. - CASE(JAXIS) - ADDMAT(JAXIS,LOW_IND) = -(YF_MAX-YS_MIN) ! -DY(VT%J1) - ADDMAT(JAXIS,HIGH_IND) = (YF_MAX-YS_MIN) ! DY(VT%J2) - CASE(KAXIS) - ADDMAT(KAXIS,LOW_IND) = -(ZF_MAX-ZS_MIN) ! -DZ(VT%K1) - ADDMAT(KAXIS,HIGH_IND) = (ZF_MAX-ZS_MIN) ! DZ(VT%K2) - END SELECT - ! CFACE Loop to modify SURF_INDEX in INTERNAL_CFACE_CELLS: - CFACE_LOOP_2 : DO CFACE_INDEX_LOCAL=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS - CFA => CFACE(CFACE_INDEX_LOCAL) - BC => BOUNDARY_COORD(CFA%BC_INDEX) - IF (BC%X < X(VT%I1)+ADDMAT(IAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%X > X(VT%I2)+ADDMAT(IAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - IF (BC%Y < Y(VT%J1)+ADDMAT(JAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%Y > Y(VT%J2)+ADDMAT(JAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - IF (BC%Z < Z(VT%K1)+ADDMAT(KAXIS,LOW_IND )) CYCLE CFACE_LOOP_2 - IF (BC%Z > Z(VT%K2)+ADDMAT(KAXIS,HIGH_IND)) CYCLE CFACE_LOOP_2 - CFA%VENT_INDEX = IVENT - CFA%SURF_INDEX = VT%SURF_INDEX - ENDDO CFACE_LOOP_2 - ENDDO VENT_LOOP -ENDDO MESH_LOOP_2 -! - At this pont all final values of SURF_INDEX have been given to CFACEs. +! Sanity tests on cut-faces, cut-cells: +IF (DEBUG_SET_CUTCELLS) THEN + CUTFACE_TEST_LOOP : DO ICF=1,M%N_CUTFACE_MESH + NFACE = M%CUT_FACE(ICF)%NFACE + I = M%CUT_FACE(ICF)%IJK(IAXIS) + J = M%CUT_FACE(ICF)%IJK(JAXIS) + K = M%CUT_FACE(ICF)%IJK(KAXIS) + X1AXIS = M%CUT_FACE(ICF)%IJK(KAXIS+1) + DO I=1,NFACE + IF(M%CUT_FACE(ICF)%AREA(I) MESHES(NM) + +DO ICF=1,M%N_CUTFACE_MESH+M%N_GCCUTFACE_MESH + CF => M%CUT_FACE(ICF); IF(CF%NFACE==0) CYCLE + ICF1=3 ! BLOCK boundary flag, when == 1,2. + IF (CF%STATUS == CC_GASPHASE) THEN + I = CF%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE + J = CF%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE + K = CF%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE + SELECT CASE(CF%IJK(KAXIS+1)) ! X1AXIS + CASE(IAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DY(J)*DZ(K)); IF(I==0 .OR. I==M%IBAR) ICF1=1 + CASE(JAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DZ(K)*DX(I)); IF(J==0 .OR. J==M%JBAR) ICF1=1 + CASE(KAXIS); CF%ALPHA_CF = SUM(CF%AREA(1:CF%NFACE))/(DX(I)*DY(J)); IF(K==0 .OR. K==M%KBAR) ICF1=1 + END SELECT + ENDIF + CALL ALLOC_FACE_STATE_VARS(NM,ICF,CF%NFACE,ICF1) +ENDDO +DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC => M%CUT_CELL(ICC); IF(CC%NCELL==0) CYCLE + I = CC%IJK(IAXIS); IF(I<0 .OR. I>M%IBP1) CYCLE + J = CC%IJK(JAXIS); IF(J<0 .OR. J>M%JBP1) CYCLE + K = CC%IJK(KAXIS); IF(K<0 .OR. K>M%KBP1) CYCLE + CC%ALPHA_CC = SUM(CC%VOLUME(1:CC%NCELL))/(DX(I)*DY(J)*DZ(K)) + CALL ALLOC_CELL_STATE_VARS(NM,ICC,CC%NCELL) +ENDDO -! ------------------------- SET_GC_CUTCELLS_3D ----------------------------------- +! Allocate array of indexes of chemically active cut-cells +SUM_CC = 0 +DO ICC=1,M%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC) + SUM_CC = SUM_CC + CC%NCELL +ENDDO +ALLOCATE(M%CHEM_ACTIVE_CC(SUM_CC,3)) +M%CHEM_ACTIVE_CC=-1 -SUBROUTINE SET_GC_CUTCELLS_3D +END SUBROUTINE CC_GRID_ALLOCATE_STATE_VARS -! Local Variables: -INTEGER :: IW,II,JJ,KK,IOR,IIO,JJO,KKO,IIF,JJF,KKF,IIOF,JJOF,KKOF,ICF,ICOF,X1AXIS,ICC,NMICC,NOFC,N_CF,N_CRT -REAL(EB):: XNM, XNOM -TYPE (WALL_TYPE), POINTER :: WC -TYPE (EXTERNAL_WALL_TYPE), POINTER :: EWC -LOGICAL :: WC_PERIODIC, TEST_ICC -REAL(EB):: AREA_NM, AREA_NOM, AREA_CRT +SUBROUTINE CC_GRID_LOG_PROCESSING_TIME(TNOW,CPUTIME_START_MESH) +REAL(EB), INTENT(IN) :: TNOW, CPUTIME_START_MESH -IF (CCGUARD == 0) RETURN +REAL(EB) :: CPUTIME_MESH + +! Add to SET_CUTCELLS_3D loop time: +T_CC_USED(SET_CUTCELLS_TIME_INDEX) = T_CC_USED(SET_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW IF(GET_CUTCELLS_VERBOSE) THEN - CALL CPU_TIME(CPUTIME_START) - WRITE(LU_SETCC,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' + CALL CPU_TIME(CPUTIME_MESH) + WRITE(LU_SETCC,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' + WRITE(LU_SETCC,'(A)') ' ' IF (MY_RANK==0) THEN - WRITE(LU_ERR ,'(A)',advance='no') ' 3. Define boundary CUT_FACES, ghost-cell CUT_CELLs relation to NOM ones ..' + WRITE(LU_ERR ,'(A,F8.3,A)') ' Time taken to process meshes : ',CPUTIME_MESH-CPUTIME_START_MESH,', sec.' + WRITE(LU_ERR,'(A)') ' ' ENDIF ENDIF -! Meshes Loop: -! First Mesh Loop: -! Test if NOM mesh cells are of the same size or smaller than NM mesh that areas match: -MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX - - IF (MESHES(NM)%N_CUTFACE_MESH==0) CYCLE MESH_LOOP_1 - CALL POINT_TO_MESH(NM) - - EXTERNAL_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS - - WC=>WALL(IW) - EWC=>EXTERNAL_WALL(IW) - BC=>BOUNDARY_COORD(WC%BC_INDEX) - B1=>BOUNDARY_PROP1(WC%B1_INDEX) - IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & - WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_1 - - II = BC%II - JJ = BC%JJ - KK = BC%KK - IOR = BC%IOR - - ! Skip if no cut-faces present on this WC: - ! Define underlying Cartesian faces indexes: - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-IAXIS) ! Higher X boundary for Mesh NM. - IIF = II - 1; JJF = JJ ; KKF = KK - CASE( JAXIS) ! Lower Y boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-JAXIS) ! Higher Y boundary for Mesh NM. - IIF = II ; JJF = JJ - 1; KKF = KK - CASE( KAXIS) ! Lower Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-KAXIS) ! Higher Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - 1 - END SELECT - X1AXIS = ABS(IOR) - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE EXTERNAL_WALL_LOOP_1 - - ! Gas cut-face area in wall-cell IW face: - ICF = FCVAR(IIF,JJF,KKF,CC_IDCF,X1AXIS) - AREA_NM = SUM(CUT_FACE(ICF)%AREA(1:CUT_FACE(ICF)%NFACE)) +END SUBROUTINE CC_GRID_LOG_PROCESSING_TIME - IF(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN - NOM = EWC%NOM ! Use Other Mesh Data. - IF(MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_1 - ! Now Obtain the CUT_FACE for the same face on NM-NOM: +SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING(CC_COMPUTE_MESH,CALL_COUNT,EARLY_RETURN) - AREA_NOM = 0._EB; N_CF=0; N_CRT=0 - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) - CASE(-IAXIS) ! Higher X boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO- 1; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DY(JJOF)*MESHES(NOM)%DZ(KKOF) - CASE( JAXIS) ! Lower Y boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) - CASE(-JAXIS) ! Higher Y boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO ; JJOF= JJO- 1; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DZ(KKOF) - CASE( KAXIS) ! Lower Z boundary for Mesh NM, Higher for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO ; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) - CASE(-KAXIS) ! Higher Z boundary for Mesh NM, Lower for mesh NOM. - IIOF= IIO ; JJOF= JJO ; KKOF= KKO- 1; AREA_CRT = MESHES(NOM)%DX(IIOF)*MESHES(NOM)%DY(JJOF) - END SELECT - IF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_FGSC,X1AXIS) == CC_GASPHASE) THEN - AREA_NOM = AREA_NOM + AREA_CRT - N_CRT = N_CRT + 1 - ELSEIF(MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) > 0) THEN ! there are gasphase cut-faces - ICOF = MESHES(NOM)%FCVAR(IIOF,JJOF,KKOF,CC_IDCF,X1AXIS) - AREA_NOM = AREA_NOM + SUM(MESHES(NOM)%CUT_FACE(ICOF)%AREA(1:MESHES(NOM)%CUT_FACE(ICOF)%NFACE)) - N_CF = N_CF + 1 - ENDIF - ENDDO - ENDDO - ENDDO +LOGICAL, ALLOCATABLE, INTENT(INOUT), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER, INTENT(INOUT) :: CALL_COUNT +LOGICAL, INTENT(OUT) :: EARLY_RETURN - ! Check if: - ! 1. other mesh faces are more than one -> areas match. - ! 2. other mesh face and size of cartesian faces the same -> areas match. - ! 3. Left the case of fine mesh face with OMESH face coarse. - NOFC = EWC%NIC_MAX - EWC%NIC_MIN + 1 - IF ( (NOFC > 1) .OR. (ABS(B1%AREA-AREA_CRT) < GEOMEPS) )THEN - IF(ABS(AREA_NM-AREA_NOM) > ADIFF_INFO_FACTOR*AREA_CRT) THEN - WRITE(LU_ERR,*) 'SET_GC_CUTCELLS_3D Error: MESH=',NM,', CUT_FACE=',ICF,' does not match OMESH=',& - NOM,', with CUT_FACEs,CRT_FACEs=',N_CF,N_CRT,', area difference=',& - ABS(AREA_NM-AREA_NOM),', GEOMEPS=',GEOMEPS - WRITE(LU_ERR,*) 'CUT FACE=',ICF,MESHES(NM)%CUT_FACE(ICF)%IJK(1:4),':',MESHES(NM)%CUT_FACE(ICF)%STATUS - ENDIF - ENDIF +INTEGER :: IERR - ENDIF +EARLY_RETURN = .FALSE. - ENDDO EXTERNAL_WALL_LOOP_1 +IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) -ENDDO MESH_LOOP_1 +IF(GET_CUTCELLS_VERBOSE) THEN + WRITE(LU_SETCC,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' + WRITE(LU_SETCC,'(A)') ' ' + IF (MY_RANK==0) THEN + WRITE(LU_ERR ,'(A)') ' SET_CUTCELLS_3D : Cut-cell definition finished.' + WRITE(LU_ERR ,'(A)') ' ' + ENDIF +ENDIF +! Write out: +! Increase SET_CUTCELLS_3D call counter by 1: +CALL_COUNT = CALL_COUNT + 1 +IF(PERIODIC_TEST==105) THEN + CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) + IF(CALL_COUNT > 1) THEN + EARLY_RETURN = .TRUE. + RETURN + ENDIF +ENDIF -! Second mesh loop: -! Define cut-cell data on guard-cell region to be communicated: -MESH_LOOP_2 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX +END SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING - IF ((MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH)==0) CYCLE MESH_LOOP_2 +SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST(GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) - CALL POINT_TO_MESH(NM) +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW - EXTERNAL_WALL_LOOP_2 : DO IW=1,N_EXTERNAL_WALL_CELLS +INTEGER :: I,J,NM,ICF,IERR +TYPE(CC_CUTFACE_TYPE), POINTER :: CF - WC=>WALL(IW) - BC=>BOUNDARY_COORD(WC%BC_INDEX) - EWC=>EXTERNAL_WALL(IW) - IF (.NOT.(WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY .OR. & - WC%BOUNDARY_TYPE == MIRROR_BOUNDARY) ) CYCLE EXTERNAL_WALL_LOOP_2 +! ALL REDUCE areas per surface: +IF(N_GEOMETRY>0) THEN +CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_OLD(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) +CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW(0,1),(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) +ENDIF +! Define AREA_ADJUST per SURF_ID: +DO J=1,N_GEOMETRY + DO I=0,N_SURF + IF(GEOM_AREA_SURF_NEW(I,J)>TWENTY_EPSILON_EB) THEN + GEOM_AREA_SURF_NEW(I,J) = GEOM_AREA_SURF_OLD(I,J)/GEOM_AREA_SURF_NEW(I,J) + ELSE; GEOM_AREA_SURF_NEW(I,J) = 1._EB + ENDIF + ENDDO +ENDDO +DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + DO ICF=1,MESHES(NM)%N_CUTFACE_MESH + CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE + DO J=1,CF%NFACE + IF(.NOT.CF%BLK_TAG(J)) CYCLE + CF%AREA_ADJUST(J) = CF%AREA_ADJUST(J)*GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + ENDDO + ENDDO + DEALLOCATE(MESHES(NM)%INBCF_AREA) +ENDDO - II = BC%II - JJ = BC%JJ - KK = BC%KK - IOR = BC%IOR - NOM = EWC%NOM ! Use Other Mesh Data. +! GEOM_AREA_SURF_NEW = 0._EB +! DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX +! DO ICF=1,MESHES(NM)%N_CUTFACE_MESH +! CF=>MESHES(NM)%CUT_FACE(ICF); IF(CF%STATUS/=CC_INBOUNDARY) CYCLE +! DO J=1,CF%NFACE +! IF(.NOT.CF%BLK_TAG(J)) CYCLE +! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) = & +! GEOM_AREA_SURF_NEW(CF%SURF_INDEX(J),CF%BODTRI(1,J)) + CF%AREA(J)*CF%AREA_ADJUST(J) +! ENDDO +! ENDDO +! ENDDO +! CALL MPI_ALLREDUCE(MPI_IN_PLACE,GEOM_AREA_SURF_NEW,(N_SURF+1)*N_GEOMETRY,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,IERR) +! DO J=1,N_GEOMETRY +! DO I=0,N_SURF +! IF(MY_RANK==0) WRITE(LU_ERR,*) 'IG,N_SURF,AOLD,ANEW=',J,I,GEOM_AREA_SURF_OLD(I,J),GEOM_AREA_SURF_NEW(I,J) +! ENDDO +! ENDDO +IF(ALLOCATED(GEOM_AREA_SURF_OLD)) DEALLOCATE(GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) - IF (NOM>0) THEN - IF (MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_2 - ENDIF +END SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST - IF (WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) THEN +SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY - ! Skip if no cut-faces present on this WC: - ! Define underlying Cartesian faces indexes: - SELECT CASE(IOR) - CASE( IAXIS) ! Lower X boundary for Mesh NM. Note we are using ghost cell II,JJ,KK. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-IAXIS) ! Higher X boundary for Mesh NM. - IIF = II - 1; JJF = JJ ; KKF = KK - CASE( JAXIS) ! Lower Y boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-JAXIS) ! Higher Y boundary for Mesh NM. - IIF = II ; JJF = JJ - 1; KKF = KK - CASE( KAXIS) ! Lower Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - CASE(-KAXIS) ! Higher Z boundary for Mesh NM. - IIF = II ; JJF = JJ ; KKF = KK - 1 - END SELECT - X1AXIS = ABS(IOR) - IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) == CC_SOLID) CYCLE EXTERNAL_WALL_LOOP_2 +INTEGER :: NM, I, J, K, IG, IEDGE, NEDGE, IFACE, ICF, ICF1, ICF2, JCF, JCF2, ICC1, ICC2, NCELL, NFACE +INTEGER :: X1AXIS, ILH, FTYPE, SURF_INDEX, IERR, NCUTFACE_IAXIS, NCUTFACE_JAXIS, NCUTFACE_KAXIS, NCUTFACE_INB +INTEGER :: NCUTEDGE_IBCC, NCUTEDGE_IBCF, ICE1, N_SPCELLCF_TOT, N_SPCELL_TOT +INTEGER :: SEG(NOD1:NOD2), MIN_CC_IJK_ICCJCC(1:5), MAX_CC_IJK_ICCJCC(1:5) +LOGICAL :: WRITE_CFACE_STATS = .FALSE. +REAL(EB) :: SLEN_GEOM, AREA_GEOM, VOLUME_GEOM, SLEN_IBCC, SLEN, DV(MAX_DIM), XYZCEN_GEOM(MAX_DIM), & + DM_XYZCEN(MAX_DIM), CCGP_XYZCEN(MAX_DIM), DM_XYZCEN_AUX(MAX_DIM), CCGP_XYZCEN_AUX(MAX_DIM) +REAL(EB) :: CF_AREA_IAXIS=0._EB, CF_AREA_JAXIS=0._EB, CF_AREA_KAXIS=0._EB, & + CF_INXAREA_IAXIS=0._EB,CF_INXAREA_JAXIS=0._EB,CF_INXAREA_KAXIS=0._EB, & + CF_INXSQAREA_IAXIS=0._EB,CF_INXSQAREA_JAXIS=0._EB,CF_INXSQAREA_KAXIS=0._EB, & + CF_JNYSQAREA_IAXIS=0._EB,CF_JNYSQAREA_JAXIS=0._EB,CF_JNYSQAREA_KAXIS=0._EB, & + CF_KNZSQAREA_IAXIS=0._EB,CF_KNZSQAREA_JAXIS=0._EB,CF_KNZSQAREA_KAXIS=0._EB +REAL(EB) :: CF_AREA_INB=0._EB, CF_INXAREA_INB=0._EB, CF_INXSQAREA_INB=0._EB, & + CF_JNYSQAREA_INB=0._EB, CF_KNZSQAREA_INB=0._EB, CF_AREA_INB_AUX=0._EB, ACRT +REAL(EB) :: CC_VOLUME_INB=0._EB, DM_VOLUME=0._EB, GP_VOLUME=0._EB, & + CC_VOLUME_INB_AUX=0._EB, DM_VOLUME_AUX=0._EB, GP_VOLUME_AUX=0._EB +REAL(EB) :: MIN_CC_VOL, MAX_CC_VOL, MIN_ALPHA_CV, MAX_ALPHA_CV +REAL(EB), ALLOCATABLE, DIMENSION(:) :: GEOM_AREA_SURF +INTEGER, ALLOCATABLE, DIMENSION(:) :: GEOM_SURF +TYPE(CFACE_TYPE), POINTER :: CFA +TYPE(CC_CUTCELL_TYPE), POINTER :: CC - IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN - TEST_ICC = .TRUE. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - TEST_ICC = TEST_ICC .AND. (MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) <= 0) - ENDDO - ENDDO - ENDDO +! Loop over geometry: +CCVERBOSE_COND : IF(GET_CUTCELLS_VERBOSE) THEN + SLEN_GEOM = 0._EB; AREA_GEOM = 0._EB; VOLUME_GEOM = 0._EB; XYZCEN_GEOM(IAXIS:KAXIS) = 0._EB + DO IG=1,N_GEOMETRY + ! Add length of wet surface edges: + DO IEDGE=1,GEOMETRY(IG)%N_EDGES + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IEDGE) + DV(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD2)-1)+1:MAX_DIM*SEG(NOD2)) - & + GEOMETRY(IG)%VERTS(MAX_DIM*(SEG(NOD1)-1)+1:MAX_DIM*SEG(NOD1)) + SLEN = SQRT( DV(IAXIS)**2._EB + DV(JAXIS)**2._EB + DV(KAXIS)**2._EB ) + SLEN_GEOM = SLEN_GEOM + SLEN + ENDDO + ! Add to wet surface Areas: + AREA_GEOM = AREA_GEOM + GEOMETRY(IG)%GEOM_AREA + ! Add to GEOMETRY volume: + VOLUME_GEOM = VOLUME_GEOM + GEOMETRY(IG)%GEOM_VOLUME + ! Add to XYZCEN for geometries: + XYZCEN_GEOM(IAXIS:KAXIS)= XYZCEN_GEOM(IAXIS:KAXIS) + GEOMETRY(IG)%GEOM_VOLUME * GEOMETRY(IG)%GEOM_XYZCEN(IAXIS:KAXIS) + ENDDO + IF(N_GEOMETRY > 0) XYZCEN_GEOM(IAXIS:KAXIS)=XYZCEN_GEOM(IAXIS:KAXIS)/VOLUME_GEOM - NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) - ! Do test for PERIODIC boundaries. Note: PERIODIC boundaries at this point have been redefined as INTERPOLATED_BOUNDARY, - ! so we test using the Mesh center relative locations. - IF (WC%BOUNDARY_TYPE==INTERPOLATED_BOUNDARY .AND. NMICC > 0 .AND. TEST_ICC) THEN - WC_PERIODIC=.FALSE. - SELECT CASE(IOR) - CASE(-IAXIS) ! High X wall cell. - XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( IAXIS) ! Low X wall cell. - XNM =0.5_EB*(MESHES(NM)%XS+MESHES(NM)%XF); XNOM=0.5_EB*(MESHES(NOM)%XS+MESHES(NOM)%XF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE(-JAXIS) ! High Y wall cell. - XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( JAXIS) ! Low Y wall cell. - XNM =0.5_EB*(MESHES(NM)%YS+MESHES(NM)%YF); XNOM=0.5_EB*(MESHES(NOM)%YS+MESHES(NOM)%YF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE(-KAXIS) ! High Z wall cell. - XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) - IF( (XNOM-XNM) < TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - CASE( KAXIS) ! Low Z wall cell. - XNM =0.5_EB*(MESHES(NM)%ZS+MESHES(NM)%ZF); XNOM=0.5_EB*(MESHES(NOM)%ZS+MESHES(NOM)%ZF) - IF( (XNOM-XNM) > -TWENTY_EPSILON_EB ) WC_PERIODIC=.TRUE. - END SELECT - IF (WC_PERIODIC) THEN - MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) = 0 ! Set NMICC = 0. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - IF(MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_CGSC)==CC_SOLID) THEN - MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC)=CC_SOLID ! set to Solid. - CYCLE EXTERNAL_WALL_LOOP_2 - ENDIF - ENDDO - ENDDO - ENDDO + ! Loop over meshes: + NCUTFACE_INB = 0 + CF_AREA_INB=0._EB + CC_VOLUME_INB=0._EB + GP_VOLUME=0._EB + DM_XYZCEN(IAXIS:KAXIS) = 0._EB + CCGP_XYZCEN(IAXIS:KAXIS) = 0._EB + TESTS_MESH_LOOP_1 : DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + DO ICF1 = 1,MESHES(NM)%N_CUTFACE_MESH + IF (CUT_FACE(ICF1)%STATUS == CC_INBOUNDARY) THEN + NFACE = CUT_FACE(ICF1)%NFACE + CF_AREA_INB = CF_AREA_INB + SUM(CUT_FACE(ICF1)%AREA(1:NFACE)) + ENDIF + ENDDO + DO ICC1 = 1,MESHES(NM)%N_CUTCELL_MESH + NCELL = CUT_CELL(ICC1)%NCELL + DO ICC2=1,NCELL + CCGP_XYZCEN(IAXIS:KAXIS) = CCGP_XYZCEN(IAXIS:KAXIS) + CUT_CELL(ICC1)%VOLUME(ICC2) * & + CUT_CELL(ICC1)%XYZCEN(IAXIS:KAXIS,ICC2) + IF (CUT_CELL(ICC1)%VOLUME(ICC2) MESHES(NM) + + IF (ALLOCATED(M%GCELL%CELL_TYPE)) DEALLOCATE(M%GCELL%CELL_TYPE) + IF (ALLOCATED(M%GCELL%IJK)) DEALLOCATE(M%GCELL%IJK) + IF (ALLOCATED(M%GCELL%ICC)) DEALLOCATE(M%GCELL%ICC) + IF (ALLOCATED(M%GCELL%JCC)) DEALLOCATE(M%GCELL%JCC) + IF (ALLOCATED(M%GCELL%STATUS)) DEALLOCATE(M%GCELL%STATUS) + IF (ALLOCATED(M%GCELL%VOLUME)) DEALLOCATE(M%GCELL%VOLUME) + IF (ALLOCATED(M%GCELL%XYZCEN)) DEALLOCATE(M%GCELL%XYZCEN) + + ! Count GCELLs: one per cut-cell sub-cell. + M%GCELL%N = 0 + DO ICC=1,M%N_CUTCELL_MESH + M%GCELL%N = M%GCELL%N + CUT_CELL(ICC)%NCELL + ENDDO + + IF (M%GCELL%N == 0) CYCLE + + ALLOCATE(M%GCELL%CELL_TYPE(1:M%GCELL%N)) + ALLOCATE(M%GCELL%IJK(IAXIS:KAXIS,1:M%GCELL%N)) + ALLOCATE(M%GCELL%ICC(1:M%GCELL%N)) + ALLOCATE(M%GCELL%JCC(1:M%GCELL%N)) + ALLOCATE(M%GCELL%STATUS(1:M%GCELL%N)) + ALLOCATE(M%GCELL%VOLUME(1:M%GCELL%N)) + ALLOCATE(M%GCELL%XYZCEN(IAXIS:KAXIS,1:M%GCELL%N)) + + M%GCELL%CELL_TYPE = CC_UNDEFINED + M%GCELL%IJK = 0 + M%GCELL%ICC = 0 + M%GCELL%JCC = 0 + M%GCELL%STATUS = 0 + M%GCELL%VOLUME = 0._EB + M%GCELL%XYZCEN = 0._EB + + IG = 0 + DO ICC=1,M%N_CUTCELL_MESH + DO JCC=1,CUT_CELL(ICC)%NCELL + IG = IG + 1 + M%GCELL%CELL_TYPE(IG) = CC_GCELL_CUT + M%GCELL%IJK(IAXIS:KAXIS,IG) = CUT_CELL(ICC)%IJK(IAXIS:KAXIS) + M%GCELL%ICC(IG) = ICC + M%GCELL%JCC(IG) = JCC + M%GCELL%STATUS(IG) = 0 + M%GCELL%VOLUME(IG) = CUT_CELL(ICC)%VOLUME(JCC) + M%GCELL%XYZCEN(IAXIS:KAXIS,IG) = CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) + ENDDO + ENDDO +ENDDO + +END SUBROUTINE CC_GRID_BUILD_GCELLS + + SUBROUTINE CC_GRID_GLOBAL_INIT(ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH,TNOW,CPUTIME_START_MESH, & GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) USE MPI_F08 diff --git a/Source/mesh.f90 b/Source/mesh.f90 index 2ee0f79069b..e94aedeec77 100644 --- a/Source/mesh.f90 +++ b/Source/mesh.f90 @@ -246,6 +246,8 @@ MODULE MESH_VARIABLES TYPE(CC_CUTFACE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_FACE TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL + TYPE(CC_GCELL_TYPE) :: GCELL + INTEGER :: CC_NREGFACE_Z(MAX_DIM)=0, CC_NBBREGFACE_Z(MAX_DIM)=0 TYPE(CC_REGFACEZ_TYPE), ALLOCATABLE, DIMENSION(:) :: CC_REGFACE_IAXIS_Z, CC_REGFACE_JAXIS_Z, CC_REGFACE_KAXIS_Z INTEGER :: CC_NRCFACE_Z=0, CC_NBBRCFACE_Z=0, CC_NRCFACE_H=0 @@ -431,6 +433,7 @@ MODULE MESH_POINTERS TYPE(CC_CUTEDGE_TYPE), POINTER, DIMENSION(:) :: CUT_EDGE TYPE(CC_CUTFACE_TYPE), POINTER, DIMENSION(:) :: CUT_FACE TYPE(CC_CUTCELL_TYPE), POINTER, DIMENSION(:) :: CUT_CELL +TYPE(CC_GCELL_TYPE), POINTER :: GCELL TYPE(CC_REGFACEZ_TYPE), POINTER, DIMENSION(:) :: CC_REGFACE_IAXIS_Z, CC_REGFACE_JAXIS_Z, CC_REGFACE_KAXIS_Z TYPE(CC_RCFACE_TYPE), POINTER, DIMENSION(:):: RC_FACE TYPE(CC_EDGE_TYPE), POINTER, DIMENSION(:):: CC_RCEDGE, CC_IBEDGE @@ -782,6 +785,7 @@ SUBROUTINE POINT_TO_MESH(NM) CUT_EDGE=>M%CUT_EDGE CUT_FACE=>M%CUT_FACE CUT_CELL=>M%CUT_CELL +GCELL=>M%GCELL CC_REGFACE_IAXIS_Z=>M%CC_REGFACE_IAXIS_Z CC_REGFACE_JAXIS_Z=>M%CC_REGFACE_JAXIS_Z CC_REGFACE_KAXIS_Z=>M%CC_REGFACE_KAXIS_Z diff --git a/Source/type.f90 b/Source/type.f90 index e94e68a697a..3dda8890a05 100644 --- a/Source/type.f90 +++ b/Source/type.f90 @@ -1439,6 +1439,21 @@ MODULE TYPES END TYPE CC_CUTCELL_TYPE +!> \brief Mesh-owned GCELL storage in SoA form. +!! One GCELL slot IG = one connected gas polyhedron in the active complex-geometry region. + +TYPE CC_GCELL_TYPE + INTEGER :: N = 0 + INTEGER, ALLOCATABLE, DIMENSION(:) :: CELL_TYPE !< (1:N) CC_GCELL_CUT or CC_GCELL_REG. + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IJK !< (IAXIS:KAXIS,1:N) host Cartesian cell indices. + INTEGER, ALLOCATABLE, DIMENSION(:) :: ICC !< (1:N) CUT_CELL index (0 if regular cell). + INTEGER, ALLOCATABLE, DIMENSION(:) :: JCC !< (1:N) sub-cell index within CUT_CELL (0 if regular). + INTEGER, ALLOCATABLE, DIMENSION(:) :: STATUS !< (1:N) active / blocked. + REAL(EB), ALLOCATABLE, DIMENSION(:) :: VOLUME !< (1:N) cached volume. + REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZCEN !< (IAXIS:KAXIS,1:N) cached centroid. +END TYPE CC_GCELL_TYPE + + !> \brief Regular faces type that contains indexes for construction of H Poisson discretization matrix. TYPE CC_REGFACE_TYPE From 9c674e328670231b666655eff2f36847f1866a7b Mon Sep 17 00:00:00 2001 From: Marcos Vanella Date: Tue, 21 Apr 2026 11:49:45 -0400 Subject: [PATCH 10/18] FDS Source : more helper routine promotions in SET_CUTCELLS_3D. --- Source/geom.f90 | 1409 +++++++++++++++++++++++++++-------------------- 1 file changed, 812 insertions(+), 597 deletions(-) diff --git a/Source/geom.f90 b/Source/geom.f90 index 4765df57908..8da4f3ddc57 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -11928,110 +11928,291 @@ SUBROUTINE SET_GC_CUTCELLS_3D END SUBROUTINE SET_GC_CUTCELLS_3D -SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) +SUBROUTINE CC_GRID_REBUILD_PHASE2_FACE_AND_LINK_INFO(NM) + +INTEGER, INTENT(IN) :: NM + +CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + +! Here: 1,2. Define Linking information for cut-cells. +CALL GET_CELL_LINK_INFO(NM) + +END SUBROUTINE CC_GRID_REBUILD_PHASE2_FACE_AND_LINK_INFO + +SUBROUTINE CC_GRID_TAG_CAVITY_CUTCELLS(NM,N_CAVITY_CELLS) + +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(OUT) :: N_CAVITY_CELLS + +INTEGER :: ICC1,J,I,N_GAS_FACES,N_REGULAR_NEIGHBORS +TYPE(CC_CUTCELL_TYPE), POINTER :: CC + +N_CAVITY_CELLS = 0 + +DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + CC=>MESHES(NM)%CUT_CELL(ICC1) + DO J=1,CC%NCELL + N_GAS_FACES = 0 + N_REGULAR_NEIGHBORS = 0 + DO I=2,CC%CCELEM(1,J) + SELECT CASE(CC%FACE_LIST(1,CC%CCELEM(I,J))) + CASE(CC_FTYPE_CFGAS) + N_GAS_FACES = N_GAS_FACES + 1 + CASE(CC_FTYPE_RCGAS) + N_REGULAR_NEIGHBORS = N_REGULAR_NEIGHBORS + 1 + END SELECT + ENDDO + IF(N_GAS_FACES>1 .OR. N_REGULAR_NEIGHBORS>0) CYCLE + IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J)=BLOCKED_CAVITY_CELL + N_CAVITY_CELLS = N_CAVITY_CELLS + 1 + ENDDO +ENDDO + +END SUBROUTINE CC_GRID_TAG_CAVITY_CUTCELLS + +SUBROUTINE CC_GRID_REBLOCK_MESH_AFTER_NEIGHBOR_EXCHANGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) + +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND + +INTEGER :: SUM_CCELL,N_CAVITY_CELLS + +CALL POINT_TO_MESH(NM) +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) + +! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: +CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) +IF(SUM_CCELL>0) CALL CC_GRID_REBUILD_PHASE2_FACE_AND_LINK_INFO(NM) + +! Block any cells that contain only one gas cut-face (cavity type cut-cells). +CALL CC_GRID_TAG_CAVITY_CUTCELLS(NM,N_CAVITY_CELLS) +IF (N_CAVITY_CELLS>0) THEN + CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) + IF(SUM_CCELL>0) CALL CC_GRID_REBUILD_PHASE2_FACE_AND_LINK_INFO(NM) +ENDIF + +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) + +END SUBROUTINE CC_GRID_REBLOCK_MESH_AFTER_NEIGHBOR_EXCHANGE +SUBROUTINE CC_GRID_FINAL_REBLOCK_MESH(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) + +INTEGER, INTENT(IN) :: NM INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND + +INTEGER :: SUM_CCELL + +CALL POINT_TO_MESH(NM) +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) + +CALL CC_GRID_REBUILD_PHASE2_FACE_AND_LINK_INFO(NM) + +! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: +CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) +IF(SUM_CCELL>0) CALL CC_GRID_REBUILD_PHASE2_FACE_AND_LINK_INFO(NM) + +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) + +END SUBROUTINE CC_GRID_FINAL_REBLOCK_MESH + +LOGICAL FUNCTION CC_GRID_SHOULD_PROCESS_MESH(NM,CC_COMPUTE_MESH) + +INTEGER, INTENT(IN) :: NM LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH -INTEGER :: IDIM,NM,SUM_CCELL,SUM_FACE,K,ICC1,J,I -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTCELL_TYPE), POINTER :: CC -DO IDIM=1,MAX_DIM +CC_GRID_SHOULD_PROCESS_MESH = CC_COMPUTE_MESH(NM) +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CC_GRID_SHOULD_PROCESS_MESH = .FALSE. + +END FUNCTION CC_GRID_SHOULD_PROCESS_MESH + +SUBROUTINE CC_GRID_EXCHANGE_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) + +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER :: NM ! Exchange CC%NOADVANCE(JCC)>0 information among NEIGHBOURING meshes: CALL EXCHANGE_CC_NOADVANCE_INFO ! Add CC%NOADVANCE(JCC) where needed: CALL ADD_NEIGHBOR_BLOCKED_CELLS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) -MAIN_MESH_LOOP_1 : DO NM=1,NMESHES +DO NM=1,NMESHES + IF (.NOT.CC_GRID_SHOULD_PROCESS_MESH(NM,CC_COMPUTE_MESH)) CYCLE + CALL CC_GRID_REBLOCK_MESH_AFTER_NEIGHBOR_EXCHANGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) +ENDDO - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 +! Call tag boundary cut-cells for blocking in refinement interfaces: +CALL TAG_CC_BLOCKING_REFINEMENT - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) +END SUBROUTINE CC_GRID_EXCHANGE_REBLOCK_PASS - ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) +SUBROUTINE CC_GRID_FINAL_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) - ENDIF +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER :: NM - ! Block any cells that contain only one gas cut-face (cavity type cut-cells): - K = 0 - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%CUT_CELL(ICC1) - DO J=1,CC%NCELL - SUM_FACE=0; SUM_CCELL=0 - DO I=2,CC%CCELEM(1,J) - SELECT CASE(CC%FACE_LIST(1,CC%CCELEM(I,J))) - CASE(CC_FTYPE_CFGAS); SUM_FACE = SUM_FACE+1 - CASE(CC_FTYPE_RCGAS); SUM_CCELL=SUM_CCELL+1 - END SELECT - ENDDO - IF(SUM_FACE>1 .OR. SUM_CCELL>0) CYCLE - IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J)=BLOCKED_CAVITY_CELL - K=K+1 - ENDDO - ENDDO - IF (K>0) THEN - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) - ENDIF - ENDIF - CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) -ENDDO MAIN_MESH_LOOP_1 +DO NM=1,NMESHES + IF (.NOT.CC_GRID_SHOULD_PROCESS_MESH(NM,CC_COMPUTE_MESH)) CYCLE + CALL CC_GRID_FINAL_REBLOCK_MESH(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) +ENDDO -! Call tag boundary cut-cells for blocking in refinement interfaces: -CALL TAG_CC_BLOCKING_REFINEMENT +END SUBROUTINE CC_GRID_FINAL_REBLOCK_PASS +SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) + +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER :: IDIM + +DO IDIM=1,MAX_DIM + CALL CC_GRID_EXCHANGE_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) ENDDO -FINAL_BLOCK_MESH_LOOP : DO NM=1,NMESHES +CALL CC_GRID_FINAL_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 +END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) +SUBROUTINE CC_GRID_TAG_COARSE_CELL_FROM_NEIGHBOR_BLOCK(M,M2,XCO,YCO,ZCO,BLOCK_TAG) - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) +TYPE(MESH_TYPE), POINTER :: M,M2 +REAL(EB), INTENT(IN) :: XCO,YCO,ZCO +INTEGER, INTENT(IN) :: BLOCK_TAG - ! Here: 1,2. Define Linking information for cut-cells. - CALL GET_CELL_LINK_INFO(NM) +INTEGER :: I,J,K,ICC,JCC +LOGICAL :: IND_FOUND - ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) - IF(SUM_CCELL>0) THEN ! Rebuild incidences and cell linking information: - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - CALL GET_CELL_LINK_INFO(NM) +IF(XCO < M2%XS .OR. XCO > M2%XF .OR. & + YCO < M2%YS .OR. YCO > M2%YF .OR. & + ZCO < M2%ZS .OR. ZCO > M2%ZF) RETURN +IF(XCO > M2%X(1) .AND. XCO < M2%X(M2%IBAR-1) .AND. & + YCO > M2%Y(1) .AND. YCO < M2%Y(M2%JBAR-1) .AND. & + ZCO > M2%Z(1) .AND. ZCO < M2%Z(M2%KBAR-1)) RETURN + +! Find I,J,K in NM where (XCO,YCO,ZCO) falls within cell bounds +IND_FOUND = .FALSE. +DO I=ILO_CELL-1,IHI_CELL+1 + IF (XCO < XFACE(I-1)-GEOMEPS .OR. XCO > XFACE(I)+GEOMEPS) CYCLE + DO J=JLO_CELL-1,JHI_CELL+1 + IF (YCO < YFACE(J-1)-GEOMEPS .OR. YCO > YFACE(J)+GEOMEPS) CYCLE + DO K=KLO_CELL-1,KHI_CELL+1 + IF (ZCO < ZFACE(K-1)-GEOMEPS .OR. ZCO > ZFACE(K)+GEOMEPS) CYCLE + IF (I > ILO_CELL-1 .AND. I < IHI_CELL+1 .AND. & + J > JLO_CELL-1 .AND. J < JHI_CELL+1 .AND. & + K > KLO_CELL-1 .AND. K < KHI_CELL+1) CYCLE + IND_FOUND = .TRUE. + EXIT + ENDDO + IF (IND_FOUND) EXIT + ENDDO + IF (IND_FOUND) EXIT +ENDDO +IF (.NOT.IND_FOUND) RETURN + +! Tag the coarse ghost-cell in NM that contains the blocked fine cell. +ICC = M%CCVAR(I,J,K,CC_IDCC) +IF (ICC > 0) THEN + DO JCC = 1, M%CUT_CELL(ICC)%NCELL + IF (M%CUT_CELL(ICC)%NOADVANCE(JCC) == NOT_BLOCKED) & + M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCK_TAG + ENDDO +ENDIF + +END SUBROUTINE CC_GRID_TAG_COARSE_CELL_FROM_NEIGHBOR_BLOCK + +SUBROUTINE CC_GRID_TAG_NEIGHBOR_BLOCK_BY_CENTROID(M,XCO,YCO,ZCO,REMOTE_JCC,BLOCK_TAG) + +TYPE(MESH_TYPE), POINTER :: M +REAL(EB), INTENT(IN) :: XCO,YCO,ZCO +INTEGER, INTENT(IN) :: REMOTE_JCC,BLOCK_TAG + +INTEGER :: I,J,K,ICC +LOGICAL :: IND_FOUND + +IND_FOUND = .FALSE. +DO I=ILO_CELL-1,IHI_CELL+1 + IF (ABS(XCO-XCELL(I))0) M%CUT_CELL(ICC)%NOADVANCE(REMOTE_JCC) = BLOCK_TAG -END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK +END SUBROUTINE CC_GRID_TAG_NEIGHBOR_BLOCK_BY_CENTROID -SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) +SUBROUTINE CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL(M,M2,NOM,ICELL,VOL_NM) USE TRAN, ONLY: GET_IJK + +TYPE(MESH_TYPE), POINTER :: M,M2 +INTEGER, INTENT(IN) :: NOM,ICELL +REAL(EB), INTENT(IN) :: VOL_NM + +INTEGER :: I2,J2,K2,BLOCK_TAG,REMOTE_JCC +REAL(EB) :: XCO,YCO,ZCO,VOL_NOM,X1,Y1,Z1 + +XCO = M2%XYZ_CC_BLOCKED(IAXIS,ICELL) +YCO = M2%XYZ_CC_BLOCKED(JAXIS,ICELL) +ZCO = M2%XYZ_CC_BLOCKED(KAXIS,ICELL) +REMOTE_JCC = M2%JBT_CC_BLOCKED(1,ICELL) +BLOCK_TAG = M2%JBT_CC_BLOCKED(2,ICELL) + +CALL GET_IJK(XCO,YCO,ZCO,NOM,X1,Y1,Z1,I2,J2,K2) +VOL_NOM = M2%DX(I2)*M2%DY(J2)*M2%DZ(K2) + +IF (VOL_NM > 1.5_EB * VOL_NOM) THEN ! NM is COARSE, NOM is FINE + CALL CC_GRID_TAG_COARSE_CELL_FROM_NEIGHBOR_BLOCK(M,M2,XCO,YCO,ZCO,BLOCK_TAG) +ELSE + ! Same refinement level (or refinement handled by EXT_WALL_LOOP) - use centroid matching + CALL CC_GRID_TAG_NEIGHBOR_BLOCK_BY_CENTROID(M,XCO,YCO,ZCO,REMOTE_JCC,BLOCK_TAG) +ENDIF + +END SUBROUTINE CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL + +SUBROUTINE CC_GRID_ADD_BLOCKED_CELLS_FROM_NEIGHBOR_MESH(M,M2,NOM,VOL_NM) + +TYPE(MESH_TYPE), POINTER :: M,M2 +INTEGER, INTENT(IN) :: NOM +REAL(EB), INTENT(IN) :: VOL_NM + +INTEGER :: ICELL + +DO ICELL=1,M2%N_CC_BLOCKED + CALL CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL(M,M2,NOM,ICELL,VOL_NM) +ENDDO + +END SUBROUTINE CC_GRID_ADD_BLOCKED_CELLS_FROM_NEIGHBOR_MESH + +SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH -INTEGER :: NM,NOM,I,J,K,ICC,JCC,NM2,ICELL,I2,J2,K2,BLOCK_TAG -LOGICAL :: IND_FOUND -REAL(EB):: XCO,YCO,ZCO,VOL_NM,VOL_NOM,X1,Y1,Z1 +INTEGER :: NM,NOM,NM2 +REAL(EB):: VOL_NM TYPE(MESH_TYPE), POINTER :: M,M2 MESH_LOOP : DO NM=1,NMESHES - IF (.NOT.CC_COMPUTE_MESH(NM)) CYCLE ! Only MESHES assigned to processor and OMESHES of these. - IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CYCLE ! Don't do OMESHES for PERIODIC_TEST==105 + IF (.NOT.CC_GRID_SHOULD_PROCESS_MESH(NM,CC_COMPUTE_MESH)) CYCLE CALL POINT_TO_MESH(NM) M => MESHES(NM) @@ -12044,107 +12225,171 @@ SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,K NEIGHBORING_MESHES_DO : DO NM2=1,M%N_NEIGHBORING_MESHES NOM = M%NEIGHBORING_MESH(NM2); IF (NOM==NM) CYCLE M2 => MESHES(NOM) + CALL CC_GRID_ADD_BLOCKED_CELLS_FROM_NEIGHBOR_MESH(M,M2,NOM,VOL_NM) + ENDDO NEIGHBORING_MESHES_DO + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) +ENDDO MESH_LOOP - ICELL_DO : DO ICELL=1,M2%N_CC_BLOCKED - XCO = M2%XYZ_CC_BLOCKED(IAXIS,ICELL) - YCO = M2%XYZ_CC_BLOCKED(JAXIS,ICELL) - ZCO = M2%XYZ_CC_BLOCKED(KAXIS,ICELL) - BLOCK_TAG = M2%JBT_CC_BLOCKED(2,ICELL) - - CALL GET_IJK(XCO,YCO,ZCO,NOM,X1,Y1,Z1,I2,J2,K2) - VOL_NOM = M2%DX(I2)*M2%DY(J2)*M2%DZ(K2) - - IF (VOL_NM > 1.5_EB * VOL_NOM) THEN ! NM is COARSE, NOM is FINE - IF(XCO < M2%XS .OR. XCO > M2%XF .OR. & - YCO < M2%YS .OR. YCO > M2%YF .OR. & - ZCO < M2%ZS .OR. ZCO > M2%ZF) CYCLE ICELL_DO - IF(XCO > M2%X(1) .AND. XCO < M2%X(M2%IBAR-1) .AND. & - YCO > M2%Y(1) .AND. YCO < M2%Y(M2%JBAR-1) .AND. & - ZCO > M2%Z(1) .AND. ZCO < M2%Z(M2%KBAR-1)) CYCLE ICELL_DO - - ! Find I,J,K in NM where (XCO,YCO,ZCO) falls within cell bounds - IND_FOUND = .FALSE. - DO I=ILO_CELL-1,IHI_CELL+1 - IF (XCO < XFACE(I-1)-GEOMEPS .OR. XCO > XFACE(I)+GEOMEPS) CYCLE - DO J=JLO_CELL-1,JHI_CELL+1 - IF (YCO < YFACE(J-1)-GEOMEPS .OR. YCO > YFACE(J)+GEOMEPS) CYCLE - DO K=KLO_CELL-1,KHI_CELL+1 - IF (ZCO < ZFACE(K-1)-GEOMEPS .OR. ZCO > ZFACE(K)+GEOMEPS) CYCLE - IF (I > ILO_CELL-1 .AND. I < IHI_CELL+1 .AND. & - J > JLO_CELL-1 .AND. J < JHI_CELL+1 .AND. & - K > KLO_CELL-1 .AND. K < KHI_CELL+1) CYCLE - IND_FOUND = .TRUE. - EXIT - ENDDO - IF (IND_FOUND) EXIT - ENDDO - IF (IND_FOUND) EXIT - ENDDO - IF (.NOT.IND_FOUND) CYCLE ICELL_DO - - ! Tag the coarse ghost-cell in NM that contains the blocked fine cell. - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF (ICC > 0) THEN - DO JCC = 1, M%CUT_CELL(ICC)%NCELL - IF (M%CUT_CELL(ICC)%NOADVANCE(JCC) == NOT_BLOCKED) & - M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCK_TAG - ENDDO - ENDIF +END SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS +SUBROUTINE CC_GRID_TAG_BLOCK_CELL_PAIR(NM,NOM,II,JJ,KK,IIG,JJG,KKG,IIO,JJO,KKO,IIOG,JJOG,KKOG,FINE_CELL) - ELSE - ! ===================================================== - ! Same refinement level (or refinement handled by EXT_WALL_LOOP) - use centroid matching - ! ===================================================== - IND_FOUND = .FALSE. - DO I=ILO_CELL-1,IHI_CELL+1 - IF (ABS(XCO-XCELL(I))0) M%CUT_CELL(ICC)%NOADVANCE(M2%JBT_CC_BLOCKED(1,ICELL)) = BLOCK_TAG +CALL TAG_BLOCK_CELL(NM,II ,JJ ,KK ,NOM,IIO ,JJO ,KKO ,FINE_CELL=FINE_CELL) +CALL TAG_BLOCK_CELL(NM,IIG,JJG,KKG,NOM,IIOG,JJOG,KKOG,FINE_CELL=FINE_CELL) - ENDIF - ENDDO ICELL_DO - ENDDO NEIGHBORING_MESHES_DO - CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) -ENDDO MESH_LOOP +END SUBROUTINE CC_GRID_TAG_BLOCK_CELL_PAIR -END SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS +SUBROUTINE CC_GRID_TAG_RAYTRACE_SINGLE_COVER_WALL(NM,NOM,IOR,X1AXIS,EWC,II,JJ,KK,IIG,JJG,KKG,SKIP_WALL) -SUBROUTINE TAG_CC_BLOCKING_REFINEMENT +INTEGER, INTENT(IN) :: NM,NOM,IOR,X1AXIS,II,JJ,KK,IIG,JJG,KKG +TYPE(EXTERNAL_WALL_TYPE), POINTER, INTENT(IN) :: EWC +LOGICAL, INTENT(OUT) :: SKIP_WALL -LOGICAL, PARAMETER :: DO_RAY_TRACING=.TRUE. -INTEGER :: NM,NOM,IW,II,JJ,KK,IIF,JJF,KKF,IIOF,JJOF,KKOF,LOHIF,IOR,CT,NCFACE_CUTCELL,NFACE_CELL,AX,SIDE,ICC,JCC,ICFC,IFC,IFACE -INTEGER :: IIO,JJO,KKO,IOGC,JOGC,KOGC -INTEGER :: DUM,II1,JJ1,KK1,IIO1,JJO1,KKO1,IIO2,JJO2,KKO2,IIG,JJG,KKG,IIOG,JJOG,KKOG -INTEGER :: X1AXIS,NCELL -TYPE(MESH_TYPE), POINTER :: M,M2 -TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC -TYPE(WALL_TYPE), POINTER :: WC -TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC -TYPE(CC_CUTCELL_TYPE), POINTER :: CC +INTEGER :: IIO,JJO,KKO,IIOG,JJOG,KKOG +INTEGER :: II_LOC,JJ_LOC,KK_LOC,IIG_LOC,JJG_LOC,KKG_LOC +TYPE(MESH_TYPE), POINTER :: M + +M => MESHES(NM) +SKIP_WALL = .FALSE. + +! Find if omesh cells under both IIG,JJG,KKG, and II,JJ,KK cells +! are of type CC_CUTCFE and test if these small size cells have centroids within the SOLID. +IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN +IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN +SELECT CASE(IOR) +CASE( IAXIS); IIOG=IIO+1 +CASE(-IAXIS); IIOG=IIO-1 +CASE( JAXIS); JJOG=JJO+1 +CASE(-JAXIS); JJOG=JJO-1 +CASE( KAXIS); KKOG=KKO+1 +CASE(-KAXIS); KKOG=KKO-1 +END SELECT + +! Test for cut/reg-cells in II,JJ,KK, respect to IIO,JJO,KKO, AND IIG,JJG,KKG respect to IIOG,JJOG,KKOG: +CALL CC_GRID_TAG_BLOCK_CELL_PAIR(NM,NOM,II,JJ,KK,IIG,JJG,KKG,IIO,JJO,KKO,IIOG,JJOG,KKOG,FINE_CELL=.TRUE.) + +! Test for cut/reg-cells in corner respect to OMESH underlying cell if needed: +IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN +IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN +II_LOC = II; JJ_LOC = JJ; KK_LOC = KK +IIG_LOC = IIG; JJG_LOC = JJG; KKG_LOC = KKG +SELECT CASE(X1AXIS) +CASE(IAXIS) + IF(KKG_LOC>1 .AND. KKG_LOC1 .AND. IIG_LOC1 .AND. JJG_LOC MESHES(NOM) + +! If needed, block ghost cells of the other mesh which has finer cells. +DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + IIOG=IIO; JJOG=JJO; KKOG=KKO + II=BC%II; JJ=BC%JJ; KK=BC%KK + IIG=BC%IIG; JJG=BC%JJG; KKG=BC%KKG + SELECT CASE(IOR) + CASE( IAXIS); IIOG=IIO+1 + CASE(-IAXIS); IIOG=IIO-1 + CASE( JAXIS); JJOG=JJO+1 + CASE(-JAXIS); JJOG=JJO-1 + CASE( KAXIS); KKOG=KKO+1 + CASE(-KAXIS); KKOG=KKO-1 + END SELECT + CALL CC_GRID_TAG_BLOCK_CELL_PAIR(NM,NOM,II,JJ,KK,IIG,JJG,KKG,IIO,JJO,KKO,IIOG,JJOG,KKOG,FINE_CELL=.FALSE.) + + ! Test for OMESH cut/reg-cells in corner respect to this mesh underlying cell if needed: + IIO2=IIO; JJO2=JJO; KKO2=KKO + SELECT CASE(X1AXIS) + CASE(IAXIS) + IF(KKOG>1 .AND. KKOG1 .AND. IIOG1 .AND. JJOG MESHES(NM) + +CT = 6 +NCFACE_CUTCELL = CT + 1 +NCELL = 1 +NFACE_CELL = CT +ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED +ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED +ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II)*M%DY(JJ)*M%DZ(KK) +ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II),M%YC(JJ),M%ZC(KK) /) +ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = INITIAL_NOADVANCE + +! Add one by one regular and gas cut faces: +CT = 1 +CCELEM(1,1) = 0 +DO AX=IAXIS,KAXIS + DO SIDE=LOW_IND,HIGH_IND + ICFC=M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_IDCF,AX) + IF(ICFC>0) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ELSEIF(M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_FGSC,AX) == CC_GASPHASE) THEN + FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) + CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 + ENDIF + ENDDO +ENDDO + +CALL INSERT_CUT_CELL(NM,II,JJ,KK,ICC) +M => MESHES(NM) +CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) +M%CUT_CELL(ICC)%NCELL = NCELL +M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL +CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) +CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) +CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) +CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) +CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) + +END SUBROUTINE CC_GRID_INSERT_SINGLE_CARTESIAN_CUTCELL + +SUBROUTINE CC_GRID_TAG_NONRAY_SINGLE_COVER_WALL(NM,NOM,IOR,X1AXIS,EWC,II,JJ,KK,IIF,JJF,KKF) + +INTEGER, INTENT(IN) :: NM,NOM,IOR,X1AXIS,II,JJ,KK,IIF,JJF,KKF +TYPE(EXTERNAL_WALL_TYPE), POINTER, INTENT(IN) :: EWC + +INTEGER :: IIOF,JJOF,KKOF,LOHIF,ICC,JCC,IFC,IFACE +TYPE(MESH_TYPE), POINTER :: M,M2 +TYPE(CC_CUTCELL_TYPE), POINTER :: CC + +M => MESHES(NM) +M2 => MESHES(NOM) + +! Check if other mesh boundary face set to SOLID and current mesh face set to .NOT.SOLID: +IIOF=EWC%IIO_MIN; JJOF=EWC%JJO_MIN; KKOF=EWC%KKO_MIN; LOHIF=HIGH_IND +SELECT CASE(IOR) +CASE(-IAXIS); IIOF=IIOF-1; LOHIF=LOW_IND +CASE(-JAXIS); JJOF=JJOF-1; LOHIF=LOW_IND +CASE(-KAXIS); KKOF=KKOF-1; LOHIF=LOW_IND +END SELECT +IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) RETURN +IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)/=CC_SOLID) RETURN + +! Set II,JJ,KK fine cells next to this EWC for blocking. +IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) THEN + CALL CC_GRID_INSERT_SINGLE_CARTESIAN_CUTCELL(NM,II,JJ,KK,BLOCKED_REFI_INTER,ICC) + M => MESHES(NM) +ELSEIF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_CUTCFE) THEN + ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. + ICC=M%CCVAR(II,JJ,KK,CC_IDCC) + CC=> M%CUT_CELL(ICC) + JCC_LOOP_1 : DO JCC=1,CC%NCELL + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE = CC%CCELEM(IFC,JCC) + IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & + CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN + IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER + CYCLE JCC_LOOP_1 + ENDIF + ENDDO + ENDDO JCC_LOOP_1 +ENDIF +! If coarse side is a cut-face in the boundary, do nothing here. + +END SUBROUTINE CC_GRID_TAG_NONRAY_SINGLE_COVER_WALL + +SUBROUTINE CC_GRID_TAG_NONRAY_MULTI_COVER_WALL(NM,NOM,IOR,X1AXIS,EWC,IIF,JJF,KKF) + +INTEGER, INTENT(IN) :: NM,NOM,IOR,X1AXIS,IIF,JJF,KKF +TYPE(EXTERNAL_WALL_TYPE), POINTER, INTENT(IN) :: EWC + +INTEGER :: IIO,JJO,KKO,IIOF,JJOF,KKOF,IOGC,JOGC,KOGC,LOHIF +INTEGER :: ICC,JCC,IFC,IFACE +TYPE(MESH_TYPE), POINTER :: M,M2 +TYPE(CC_CUTCELL_TYPE), POINTER :: CC + +M => MESHES(NM) +M2 => MESHES(NOM) + +IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)/=CC_SOLID) RETURN + +! If needed, block ghost cells of the other mesh which has finer cells. +DO KKO=EWC%KKO_MIN,EWC%KKO_MAX + DO JJO=EWC%JJO_MIN,EWC%JJO_MAX + DO IIO=EWC%IIO_MIN,EWC%IIO_MAX + IIOF=IIO; JJOF=JJO; KKOF=KKO + IOGC=IIO; JOGC=JJO; KOGC=KKO + LOHIF=LOW_IND + SELECT CASE(IOR) + CASE( IAXIS) + IOGC=IOGC+1 + CASE(-IAXIS) + IIOF= IIO-1 + LOHIF=HIGH_IND + CASE( JAXIS) + JOGC=JOGC+1 + CASE(-JAXIS) + JJOF= JJO-1 + LOHIF=HIGH_IND + CASE( KAXIS) + KOGC=KOGC+1 + CASE(-KAXIS) + KKOF= KKO-1 + LOHIF=HIGH_IND + END SELECT + IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_SOLID) CYCLE + + ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking. + IF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_GASPHASE) THEN + CALL CC_GRID_INSERT_SINGLE_CARTESIAN_CUTCELL(NOM,IOGC,JOGC,KOGC,BLOCKED_REFI_INTER,ICC) + M2 => MESHES(NOM) + ELSEIF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_CUTCFE) THEN + ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. + ICC=M2%CCVAR(IOGC,JOGC,KOGC,CC_IDCC) + CC=> M2%CUT_CELL(ICC) + JCC_LOOP_3 : DO JCC=1,CC%NCELL + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE = CC%CCELEM(IFC,JCC) + IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & + CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN + IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER + CYCLE JCC_LOOP_3 + ENDIF + ENDDO + ENDDO JCC_LOOP_3 + ENDIF + ENDDO + ENDDO +ENDDO +! If coarse side is a cut-face in the boundary, do nothing here. + +END SUBROUTINE CC_GRID_TAG_NONRAY_MULTI_COVER_WALL + +SUBROUTINE TAG_CC_BLOCKING_REFINEMENT + +LOGICAL, PARAMETER :: DO_RAY_TRACING=.TRUE. +INTEGER :: NM,NOM,IW,II,JJ,KK,IIF,JJF,KKF,IOR +INTEGER :: IIG,JJG,KKG +INTEGER :: X1AXIS +TYPE(MESH_TYPE), POINTER :: M +TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC +TYPE(WALL_TYPE), POINTER :: WC +TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC +LOGICAL :: SKIP_WALL + IF ( DO_RAY_TRACING) THEN ! This loop is to block cut-cells on fine side grids for which coarse grid cut-cells have been blocked. @@ -12170,7 +12580,6 @@ SUBROUTINE TAG_CC_BLOCKING_REFINEMENT IIG = BC%IIG;JJG = BC%JJG;KKG = BC%KKG; II = BC%II; JJ = BC%JJ; KK = BC%KK; IOR = BC%IOR; X1AXIS=ABS(IOR) NOM = EWC%NOM; IF(NOM<1 .OR. NOM==NM) CYCLE EXT_WALL_LOOP_1 - M2 => MESHES(NOM) IIF=II; JJF=JJ; KKF=KK SELECT CASE(IOR) CASE(-IAXIS); IIF=IIF-1; @@ -12179,112 +12588,12 @@ SUBROUTINE TAG_CC_BLOCKING_REFINEMENT END SELECT IF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)==1) THEN - ! Find if omesh cells under both IIG,JJG,KKG, and II,JJ,KK cells - ! are of type CC_CUTCFE and test if these small size cells have centroids within the SOLID. - IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN - IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN - SELECT CASE(IOR) - CASE( IAXIS); IIOG=IIO+1 - CASE(-IAXIS); IIOG=IIO-1 - CASE( JAXIS); JJOG=JJO+1 - CASE(-JAXIS); JJOG=JJO-1 - CASE( KAXIS); KKOG=KKO+1 - CASE(-KAXIS); KKOG=KKO-1 - END SELECT - - ! Test for cut/reg-cells in II,JJ,KK, respect to IIO,JJO,KKO, AND IIG,JJG,KKG respect to IIOG,JJOG,KKOG: - DO DUM=1,2 - IF(DUM==1) THEN; II1 = II; JJ1 = JJ; KK1 = KK; IIO1= IIO; JJO1= JJO; KKO1= KKO - ELSE; II1 = IIG; JJ1 = JJG; KK1 = KKG; IIO1=IIOG; JJO1=JJOG; KKO1=KKOG - ENDIF - CALL TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL=.TRUE.) - ENDDO - - ! Test for cut/reg-cells in corner respect to OMESH undelying cell if needed: - IIO = EWC%IIO_MIN; JJO = EWC%JJO_MIN; KKO = EWC%KKO_MIN - IIOG= EWC%IIO_MIN; JJOG= EWC%JJO_MIN; KKOG= EWC%KKO_MIN - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(KKG>1 .AND. KKG1 .AND. IIG1 .AND. JJG1) THEN - ! If needed, block ghost cells of the other mesh which has finer cells. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - IIOG=IIO; JJOG=JJO; KKOG=KKO; II=BC%II; JJ=BC%JJ; KK=BC%KK; IIG=BC%IIG; JJG=BC%JJG; KKG=BC%KKG - SELECT CASE(IOR) - CASE( IAXIS); IIOG=IIO+1 - CASE(-IAXIS); IIOG=IIO-1 - CASE( JAXIS); JJOG=JJO+1 - CASE(-JAXIS); JJOG=JJO-1 - CASE( KAXIS); KKOG=KKO+1 - CASE(-KAXIS); KKOG=KKO-1 - END SELECT - DO DUM=1,2 - IF(DUM==1) THEN; II1 = II; JJ1 = JJ; KK1 = KK; IIO1= IIO; JJO1= JJO; KKO1= KKO - ELSE; II1 = IIG; JJ1 = JJG; KK1 = KKG; IIO1=IIOG; JJO1=JJOG; KKO1=KKOG - ENDIF - CALL TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL=.FALSE.) - ENDDO - - ! Test for OMESH cut/reg-cells in corner respect to this mesh undelying cell if needed: - IIO2=IIO; JJO2=JJO; KKO2=KKO - SELECT CASE(X1AXIS) - CASE(IAXIS) - IF(KKOG>1 .AND. KKOG1 .AND. IIOG1 .AND. JJOGBOUNDARY_COORD(WC%BC_INDEX) II = BC%II; JJ = BC%JJ; KK = BC%KK; IOR = BC%IOR; X1AXIS=ABS(IOR) NOM = EWC%NOM - M2 => MESHES(NOM) IIF=II; JJF=JJ; KKF=KK SELECT CASE(IOR) CASE(-IAXIS); IIF=IIF-1; @@ -12314,145 +12622,10 @@ SUBROUTINE TAG_CC_BLOCKING_REFINEMENT END SELECT IF (EWC%AREA_RATIO<0.9_EB) THEN - ! Check if other mesh boundary face set to SOLID and current mesh face set to .NOT.SOLID: - IIOF=EWC%IIO_MIN; JJOF=EWC%JJO_MIN; KKOF=EWC%KKO_MIN; LOHIF=HIGH_IND - SELECT CASE(IOR) - CASE(-IAXIS); IIOF=IIOF-1; LOHIF=LOW_IND - CASE(-JAXIS); JJOF=JJOF-1; LOHIF=LOW_IND - CASE(-KAXIS); KKOF=KKOF-1; LOHIF=LOW_IND - END SELECT - IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) CYCLE EXT_WALL_LOOP ! No need to do anything. - IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_SOLID) THEN ! Coarse side face is solid. - ! Set II,JJ,KK fine cells next to this EWC for blocking. - IF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell in this location, set to Block. - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II)*M%DY(JJ)*M%DZ(KK) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II),M%YC(JJ),M%ZC(KK) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = BLOCKED_REFI_INTER - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(II+ADDI(SIDE,AX),JJ+ADDJ(SIDE,AX),KK+ADDK(SIDE,AX),CC_FGSC,AX) == & - CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NM,II,JJ,KK,ICC); M => MESHES(NM) - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) - ELSEIF(M%CCVAR(II,JJ,KK,CC_CGSC)==CC_CUTCFE) THEN - ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. - ICC=M%CCVAR(II,JJ,KK,CC_IDCC); CC=> M%CUT_CELL(ICC) - JCC_LOOP_1 : DO JCC=1,CC%NCELL - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE = CC%CCELEM(IFC,JCC) - IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & - CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN - IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER - CYCLE JCC_LOOP_1 - ENDIF - ENDDO - ENDDO JCC_LOOP_1 - ENDIF - !ELSEIF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_CUTCFE) THEN - ! Coarse side is a cut-face in the boundary. - ENDIF + CALL CC_GRID_TAG_NONRAY_SINGLE_COVER_WALL(NM,NOM,IOR,X1AXIS,EWC,II,JJ,KK,IIF,JJF,KKF) ELSEIF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)>1) THEN - IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) THEN ! Coarse side face is solid. - ! If needed, block ghost cells of the other mesh which has finer cells. - DO KKO=EWC%KKO_MIN,EWC%KKO_MAX - DO JJO=EWC%JJO_MIN,EWC%JJO_MAX - DO IIO=EWC%IIO_MIN,EWC%IIO_MAX - IIOF=IIO; JJOF=JJO; KKOF=KKO; IOGC=IIO; JOGC=JJO; KOGC=KKO; LOHIF=LOW_IND - SELECT CASE(IOR) - CASE( IAXIS); IOGC=IOGC+1; - CASE(-IAXIS); IIOF= IIO-1; LOHIF=HIGH_IND - CASE( JAXIS); JOGC=JOGC+1; - CASE(-JAXIS); JJOF= JJO-1; LOHIF=HIGH_IND - CASE( KAXIS); KOGC=KOGC+1; - CASE(-KAXIS); KKOF= KKO-1; LOHIF=HIGH_IND - END SELECT - IF(M2%FCVAR(IIOF,JJOF,KKOF,CC_CGSC,X1AXIS)==CC_SOLID) CYCLE ! No need to do anything. - - ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking. - IF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell in this location, set to Block. - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M2%DX(IOGC)*M2%DY(JOGC)*M2%DZ(KOGC) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M2%XC(IOGC),M2%YC(JOGC),M2%ZC(KOGC) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = BLOCKED_REFI_INTER - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND; ICFC=& - M2%FCVAR(IOGC+ADDI(SIDE,AX),JOGC+ADDJ(SIDE,AX),KOGC+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF( & - M2%FCVAR(IOGC+ADDI(SIDE,AX),JOGC+ADDJ(SIDE,AX),KOGC+ADDK(SIDE,AX),CC_FGSC,AX)& - == CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NOM,IOGC,JOGC,KOGC,ICC); M2 => MESHES(NOM) - CALL NEW_CELL_ALLOC(NOM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M2%CUT_CELL(ICC)%NCELL = NCELL - M2%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M2%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M2%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M2%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M2%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M2%CUT_CELL(ICC)%NOADVANCE) - ELSEIF(M2%CCVAR(IOGC,JOGC,KOGC,CC_CGSC)==CC_CUTCFE) THEN - ! Find face in IIF,JFF,JJF,X1AXIS location and set the owner cell to block. - ICC=M2%CCVAR(IOGC,JOGC,KOGC,CC_IDCC); CC=> M2%CUT_CELL(ICC) - JCC_LOOP_3 : DO JCC=1,CC%NCELL - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE = CC%CCELEM(IFC,JCC) - IF( (CC%FACE_LIST(1,IFACE)==CC_FTYPE_RCGAS .OR. CC%FACE_LIST(1,IFACE)==CC_FTYPE_CFGAS) .AND. & - CC%FACE_LIST(2,IFACE)==LOHIF .AND. CC%FACE_LIST(3,IFACE)==X1AXIS ) THEN - IF(CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC)=BLOCKED_REFI_INTER - CYCLE JCC_LOOP_3 - ENDIF - ENDDO - ENDDO JCC_LOOP_3 - ENDIF - ENDDO - ENDDO - ENDDO - !ELSEIF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_CUTCFE) THEN - ! Coarse side is a cut-face in the boundary. - ENDIF + CALL CC_GRID_TAG_NONRAY_MULTI_COVER_WALL(NM,NOM,IOR,X1AXIS,EWC,IIF,JJF,KKF) ENDIF ENDDO EXT_WALL_LOOP ENDDO MAIN_MESH_LOOP_2 @@ -12461,125 +12634,76 @@ SUBROUTINE TAG_CC_BLOCKING_REFINEMENT RETURN END SUBROUTINE TAG_CC_BLOCKING_REFINEMENT -SUBROUTINE TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL) +SUBROUTINE CC_GRID_TAG_BLOCK_FINE_CELL_CASE(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1) INTEGER, INTENT(IN) :: NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1 -LOGICAL, INTENT(IN) :: FINE_CELL -INTEGER :: CT,NCFACE_CUTCELL,NCELL,NFACE_CELL,AX,SIDE,ICFC,ICC,ICC2 + +INTEGER :: ICC,ICC2,INITIAL_NOADVANCE TYPE(MESH_TYPE), POINTER :: M,M2 -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM,FACE_LIST -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE -REAL(EB),ALLOCATABLE, DIMENSION(:,:) :: XYZCEN -REAL(EB),ALLOCATABLE, DIMENSION(:) :: VOLUME -INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) -INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) M =>MESHES( NM) M2=>MESHES(NOM) -IF (FINE_CELL) THEN - - ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC); ICC = 0 - IF ( ICC2 > 0 .OR. M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN ! There are cut-cells in omesh cartesian cell. - IF(M%CCVAR(II1,JJ1,KK1,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell is this location: - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M%DX(II1)*M%DY(JJ1)*M%DZ(KK1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M%XC(II1),M%YC(JJ1),M%ZC(KK1) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) NOADVANCE(1) = BLOCKED_REFI_INTER - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND - ICFC=M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF(M%FCVAR(II1+ADDI(SIDE,AX),JJ1+ADDJ(SIDE,AX),KK1+ADDK(SIDE,AX),CC_FGSC,AX) == & - CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NM,II1,JJ1,KK1,ICC); M => MESHES(NM) - CALL NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M%CUT_CELL(ICC)%NCELL = NCELL - M%CUT_CELL(ICC)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M%CUT_CELL(ICC)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M%CUT_CELL(ICC)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M%CUT_CELL(ICC)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M%CUT_CELL(ICC)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M%CUT_CELL(ICC)%NOADVANCE) - ELSEIF(M%CCVAR(II1,JJ1,KK1,CC_IDCC)>0) THEN +ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC) +ICC = 0 +IF ( ICC2 > 0 .OR. M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN ! There are cut-cells in omesh cartesian cell. + IF(M%CCVAR(II1,JJ1,KK1,CC_CGSC)==CC_GASPHASE) THEN + INITIAL_NOADVANCE = NOT_BLOCKED + IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) INITIAL_NOADVANCE = BLOCKED_REFI_INTER + CALL CC_GRID_INSERT_SINGLE_CARTESIAN_CUTCELL(NM,II1,JJ1,KK1,INITIAL_NOADVANCE,ICC) + M => MESHES(NM) + ELSEIF(M%CCVAR(II1,JJ1,KK1,CC_IDCC)>0) THEN ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC) - ENDIF - ! Here Test if cut-cells in II,KK,KK are blocked or not in IIO,JJO,KKO: - IF(ICC>0) THEN - IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN - WHERE(M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL)==NOT_BLOCKED) & - M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL) = BLOCKED_REFI_INTER - ELSE; CALL TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) - ENDIF + ENDIF + ! Here test if cut-cells in II,JJ,KK are blocked or not in IIO,JJO,KKO: + IF(ICC>0) THEN + IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN + WHERE(M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL)==NOT_BLOCKED) & + M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL) = BLOCKED_REFI_INTER + ELSE + CALL TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) ENDIF ENDIF +ENDIF -ELSE +END SUBROUTINE CC_GRID_TAG_BLOCK_FINE_CELL_CASE - ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC); ICC2 = 0 - IF(ICC>0) THEN - ! Set IOGC,JOGC,KOGC fine cells next to this EWC for blocking. - IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_GASPHASE) THEN - ! Insert cut-cell in this location, set to Block. - CT = 6; - NCFACE_CUTCELL = CT + 1 - NCELL = 1 - NFACE_CELL = CT - ALLOCATE(CCELEM(1:NCFACE_CUTCELL,1:NCELL)); CCELEM = CC_UNDEFINED - ALLOCATE(FACE_LIST(1:CC_NPARAM_CCFACE,1:NFACE_CELL)); FACE_LIST = CC_UNDEFINED - ALLOCATE(VOLUME(1:NCELL)); VOLUME(1)=M2%DX(IIO1)*M2%DY(JJO1)*M2%DZ(KKO1) - ALLOCATE(XYZCEN(IAXIS:KAXIS,1:NCELL)); XYZCEN(IAXIS:KAXIS,1) = (/ M2%XC(IIO1),M2%YC(JJO1),M2%ZC(KKO1) /) - ALLOCATE(NOADVANCE(1:NCELL)); NOADVANCE(1) = NOT_BLOCKED - ! Add one by one regular and gas cut faces: - CT = 1; CCELEM(1,1) = 0 - DO AX=IAXIS,KAXIS - DO SIDE=LOW_IND,HIGH_IND; ICFC=& - M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_IDCF,AX); - IF(ICFC>0) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_CFGAS, SIDE, AX,ICFC, 1, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ELSEIF( & - M2%FCVAR(IIO1+ADDI(SIDE,AX),JJO1+ADDJ(SIDE,AX),KKO1+ADDK(SIDE,AX),CC_FGSC,AX)& - == CC_GASPHASE) THEN - FACE_LIST(1:CC_NPARAM_CCFACE,CT) = (/ CC_FTYPE_RCGAS, SIDE, AX, 0, 0, CC_UNDEFINED /) - CCELEM(1,1) = CCELEM(1,1) + 1; CCELEM(CCELEM(1,1)+1,1) = CT; CT=CT+1 - ENDIF - ENDDO - ENDDO - ! Insert cut_cell: - CALL INSERT_CUT_CELL(NOM,IIO1,JJO1,KKO1,ICC2); M2 => MESHES(NOM) - CALL NEW_CELL_ALLOC(NOM,ICC2,NCELL,NFACE_CELL,NCFACE_CUTCELL) - M2%CUT_CELL(ICC2)%NCELL = NCELL - M2%CUT_CELL(ICC2)%NFACE_CELL = NFACE_CELL - CALL MOVE_ALLOC(FROM=CCELEM ,TO=M2%CUT_CELL(ICC2)%CCELEM) - CALL MOVE_ALLOC(FROM=FACE_LIST,TO=M2%CUT_CELL(ICC2)%FACE_LIST) - CALL MOVE_ALLOC(FROM=VOLUME ,TO=M2%CUT_CELL(ICC2)%VOLUME) - CALL MOVE_ALLOC(FROM=XYZCEN ,TO=M2%CUT_CELL(ICC2)%XYZCEN) - CALL MOVE_ALLOC(FROM=NOADVANCE,TO=M2%CUT_CELL(ICC2)%NOADVANCE) - ELSEIF(M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC)>0) THEN +SUBROUTINE CC_GRID_TAG_BLOCK_COARSE_CELL_CASE(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1) + +INTEGER, INTENT(IN) :: NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1 + +INTEGER :: ICC,ICC2 +TYPE(MESH_TYPE), POINTER :: M,M2 + +M =>MESHES( NM) +M2=>MESHES(NOM) + +ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC) +ICC2 = 0 +IF(ICC>0) THEN + ! Set IIO1,JJO1,KKO1 fine cells next to this EWC for blocking. + IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_GASPHASE) THEN + CALL CC_GRID_INSERT_SINGLE_CARTESIAN_CUTCELL(NOM,IIO1,JJO1,KKO1,NOT_BLOCKED,ICC2) + M2 => MESHES(NOM) + ELSEIF(M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC)>0) THEN ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC) - ENDIF - ! Here Test if cut-cells in IIO,JJO,KKO are blocked or not in II,JJ,KK: - IF(ICC2>0) CALL TEST_CC_FOR_BLOCKING(NOM,ICC2,NM,II1,JJ1,KK1,ICC) ENDIF + ! Here test if cut-cells in IIO,JJO,KKO are blocked or not in II,JJ,KK: + IF(ICC2>0) CALL TEST_CC_FOR_BLOCKING(NOM,ICC2,NM,II1,JJ1,KK1,ICC) +ENDIF + +END SUBROUTINE CC_GRID_TAG_BLOCK_COARSE_CELL_CASE + +SUBROUTINE TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL) + +INTEGER, INTENT(IN) :: NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1 +LOGICAL, INTENT(IN) :: FINE_CELL + +IF (FINE_CELL) THEN + CALL CC_GRID_TAG_BLOCK_FINE_CELL_CASE(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1) + +ELSE + CALL CC_GRID_TAG_BLOCK_COARSE_CELL_CASE(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1) ENDIF @@ -13202,28 +13326,14 @@ SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH(NM) RETURN END SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH -SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM,CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_AREA_SURF_OLD) +SUBROUTINE CC_GRID_APPLY_SPECIAL_CELL_BLOCKING(NM) INTEGER, INTENT(IN) :: NM -LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH -INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_AREA_SURF_OLD -INTEGER :: I,J,K,IFC,IFACE,ICF,JCF,IG,ICC,ICC1,NCELL,JCC,CELL_BLOCK_IOR -REAL(EB) :: CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) -REAL(EB), ALLOCATABLE, DIMENSION(:) :: VOLUME -TYPE(MESH_TYPE), POINTER :: M +INTEGER :: I,J,K,ICC,ICC1 TYPE(CC_CUTCELL_TYPE), POINTER :: CC -TYPE(CC_CUTFACE_TYPE), POINTER :: CF - -IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. -IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 -CALL POINT_TO_MESH(NM) -M => MESHES(NM) -CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) - -! Block SPCELLS, cells in cut-cell region where cut-cells could not be built. +! Block cells in the cut-cell region where cut-cells could not be built. IF (MESHES(NM)%N_SPCELLS_TO_BLOCK > 0 .AND. ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) THEN DO ICC=1,MESHES(NM)%N_SPCELLS_TO_BLOCK I = MESHES(NM)%SPCELL_LIST(IAXIS,MESHES(NM)%SPCELLS_TO_BLOCK(ICC)) @@ -13236,95 +13346,200 @@ SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM,CC_COMPUTE_MESH,ISTR,IEND,JS ENDIF ENDDO ENDIF + IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 -IF (ONE_CC_PER_CARTESIAN_CELL) THEN - ! Here Block all cells that have volume less (or equal) than the first largest cell found. - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%CUT_CELL(ICC1) - NCELL=0 - DO J=1,CC%NCELL - IF(CC%NOADVANCE(J)==NOT_BLOCKED) NCELL=NCELL+1 - ENDDO - IF(NCELL<2) CYCLE - ! Find if any GEOMETRY related to CC_INBOUNDARY faces has CELL_BLOCK_IOR>0: - CELL_BLOCK_IOR=0; CELL_BLOCK_ORIENTATION = 0._EB - NCELL_LOOP_1 : DO J=1,CC%NCELL - DO I=2,CC%CCELEM(1,J)+1 - IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN - ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) - IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) - IF(IG>0) THEN - IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN - CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION - ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN - CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR - EXIT NCELL_LOOP_1 - ENDIF - ENDIF +END SUBROUTINE CC_GRID_APPLY_SPECIAL_CELL_BLOCKING + +SUBROUTINE CC_GRID_GET_SINGLE_CELL_POLICY(NM,CC,CELL_BLOCK_IOR,CELL_BLOCK_ORIENTATION) + +INTEGER, INTENT(IN) :: NM +TYPE(CC_CUTCELL_TYPE), POINTER, INTENT(IN) :: CC +INTEGER, INTENT(OUT) :: CELL_BLOCK_IOR +REAL(EB), INTENT(OUT) :: CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) + +INTEGER :: I,J,ICF,JCF,IG + +! Find if any GEOMETRY related to CC_INBOUNDARY faces prescribes a preferred survivor. +CELL_BLOCK_IOR = 0 +CELL_BLOCK_ORIENTATION = 0._EB + +NCELL_LOOP_1 : DO J=1,CC%NCELL + DO I=2,CC%CCELEM(1,J)+1 + IF(CC%FACE_LIST(1,CC%CCELEM(I,J))==CC_FTYPE_CFINB) THEN + ICF=CC%FACE_LIST(4,CC%CCELEM(I,J)); JCF=CC%FACE_LIST(5,CC%CCELEM(I,J)) + IG=MESHES(NM)%CUT_FACE(ICF)%BODTRI(1,JCF) + IF(IG>0) THEN + IF (NORM2(GEOMETRY(IG)%CELL_BLOCK_ORIENTATION(IAXIS:KAXIS))>TWENTY_EPSILON_EB) THEN + CELL_BLOCK_ORIENTATION = GEOMETRY(IG)%CELL_BLOCK_ORIENTATION + ELSEIF (ABS(GEOMETRY(IG)%CELL_BLOCK_IOR)>0) THEN + CELL_BLOCK_IOR = GEOMETRY(IG)%CELL_BLOCK_IOR + EXIT NCELL_LOOP_1 ENDIF - ENDDO - ENDDO NCELL_LOOP_1 - ALLOCATE(VOLUME(1:CC%NCELL)); VOLUME(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN - ! Cell Block Orientation: - DO J=1,CC%NCELL; VOLUME(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)); ENDDO - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN - ! Make search for double precision min/max unambiguous. - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS,IAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) - CASE(-JAXIS,JAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) - CASE(-KAXIS,KAXIS); VOLUME(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) - END SELECT - DO J=1,CC%NCELL; VOLUME(J) = VOLUME(J)*(1._EB+REAL(J-1,EB)*GEOMEPS); ENDDO - SELECT CASE(CELL_BLOCK_IOR) - CASE(-IAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( IAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-JAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( JAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE(-KAXIS); I=MAXLOC(VOLUME(1:CC%NCELL),DIM=1) - CASE( KAXIS); I=MINLOC(VOLUME(1:CC%NCELL),DIM=1) - END SELECT + ENDIF ENDIF - DEALLOCATE(VOLUME) - NCELL_LOOP_2 : DO J=1,CC%NCELL - IF(J==I) CYCLE NCELL_LOOP_2 - IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL - ENDDO NCELL_LOOP_2 ENDDO +ENDDO NCELL_LOOP_1 + +END SUBROUTINE CC_GRID_GET_SINGLE_CELL_POLICY + +SUBROUTINE CC_GRID_SELECT_SURVIVOR_JCC(CC,CELL_BLOCK_IOR,CELL_BLOCK_ORIENTATION,SURVIVOR_JCC) + +TYPE(CC_CUTCELL_TYPE), POINTER, INTENT(IN) :: CC +INTEGER, INTENT(IN) :: CELL_BLOCK_IOR +REAL(EB), INTENT(IN) :: CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) +INTEGER, INTENT(OUT) :: SURVIVOR_JCC + +INTEGER :: J +REAL(EB), ALLOCATABLE, DIMENSION(:) :: SCORE + +ALLOCATE(SCORE(1:CC%NCELL)) + +SCORE(1:CC%NCELL) = CC%VOLUME(1:CC%NCELL) +DO J=1,CC%NCELL + SCORE(J) = SCORE(J)*(1._EB+REAL(J-1,EB)*GEOMEPS) +ENDDO +SURVIVOR_JCC = MAXLOC(SCORE(1:CC%NCELL),DIM=1) + +IF(NORM2(CELL_BLOCK_ORIENTATION)>TWENTY_EPSILON_EB) THEN + ! Cell block orientation overrides volume-based choice. + DO J=1,CC%NCELL + SCORE(J) = DOT_PRODUCT(CELL_BLOCK_ORIENTATION,CC%XYZCEN(IAXIS:KAXIS,J)) + ENDDO + DO J=1,CC%NCELL + SCORE(J) = SCORE(J)*(1._EB+REAL(J-1,EB)*GEOMEPS) + ENDDO + SURVIVOR_JCC = MINLOC(SCORE(1:CC%NCELL),DIM=1) +ELSEIF(ABS(CELL_BLOCK_IOR)>0) THEN + ! Make search for double precision min/max unambiguous. + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS,IAXIS); SCORE(1:CC%NCELL) = CC%XYZCEN(IAXIS,1:CC%NCELL) + CASE(-JAXIS,JAXIS); SCORE(1:CC%NCELL) = CC%XYZCEN(JAXIS,1:CC%NCELL) + CASE(-KAXIS,KAXIS); SCORE(1:CC%NCELL) = CC%XYZCEN(KAXIS,1:CC%NCELL) + END SELECT + DO J=1,CC%NCELL + SCORE(J) = SCORE(J)*(1._EB+REAL(J-1,EB)*GEOMEPS) + ENDDO + SELECT CASE(CELL_BLOCK_IOR) + CASE(-IAXIS); SURVIVOR_JCC=MAXLOC(SCORE(1:CC%NCELL),DIM=1) + CASE( IAXIS); SURVIVOR_JCC=MINLOC(SCORE(1:CC%NCELL),DIM=1) + CASE(-JAXIS); SURVIVOR_JCC=MAXLOC(SCORE(1:CC%NCELL),DIM=1) + CASE( JAXIS); SURVIVOR_JCC=MINLOC(SCORE(1:CC%NCELL),DIM=1) + CASE(-KAXIS); SURVIVOR_JCC=MAXLOC(SCORE(1:CC%NCELL),DIM=1) + CASE( KAXIS); SURVIVOR_JCC=MINLOC(SCORE(1:CC%NCELL),DIM=1) + END SELECT ENDIF +DEALLOCATE(SCORE) + +END SUBROUTINE CC_GRID_SELECT_SURVIVOR_JCC + +SUBROUTINE CC_GRID_TAG_BLOCKED_SPLIT_PIECES(CC,SURVIVOR_JCC) + +TYPE(CC_CUTCELL_TYPE), POINTER, INTENT(INOUT) :: CC +INTEGER, INTENT(IN) :: SURVIVOR_JCC + +INTEGER :: J + +DO J=1,CC%NCELL + IF(J==SURVIVOR_JCC) CYCLE + IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J) = BLOCKED_SPLIT_CELL +ENDDO + +END SUBROUTINE CC_GRID_TAG_BLOCKED_SPLIT_PIECES + +SUBROUTINE CC_GRID_ENFORCE_ONE_CC_PER_CARTESIAN_CELL(NM) + +INTEGER, INTENT(IN) :: NM + +INTEGER :: J,ICC1,NACTIVE,SURVIVOR_JCC,CELL_BLOCK_IOR +REAL(EB) :: CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) +TYPE(CC_CUTCELL_TYPE), POINTER :: CC + +IF (.NOT.ONE_CC_PER_CARTESIAN_CELL) RETURN + +! Legacy policy: keep only one surviving cut-cell piece per host Cartesian cell. +DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + CC=>MESHES(NM)%CUT_CELL(ICC1) + NACTIVE=0 + DO J=1,CC%NCELL + IF(CC%NOADVANCE(J)==NOT_BLOCKED) NACTIVE=NACTIVE+1 + ENDDO + IF(NACTIVE<2) CYCLE + + CALL CC_GRID_GET_SINGLE_CELL_POLICY(NM,CC,CELL_BLOCK_IOR,CELL_BLOCK_ORIENTATION) + CALL CC_GRID_SELECT_SURVIVOR_JCC(CC,CELL_BLOCK_IOR,CELL_BLOCK_ORIENTATION,SURVIVOR_JCC) + CALL CC_GRID_TAG_BLOCKED_SPLIT_PIECES(CC,SURVIVOR_JCC) +ENDDO + +END SUBROUTINE CC_GRID_ENFORCE_ONE_CC_PER_CARTESIAN_CELL + +SUBROUTINE CC_GRID_REBUILD_LOCAL_FACE_AND_LINK_INFO(NM) + +INTEGER, INTENT(IN) :: NM + CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) ! Here: 1,2. Define Linking information for cut-cells. CALL GET_CELL_LINK_INFO(NM) -IF(PROCESS(NM)==MY_RANK) THEN ! Here Add Blocked Areas per SURF_ID: - ALLOCATE(MESHES(NM)%INBCF_AREA(0:MESHES(NM)%IBP1,0:MESHES(NM)%JBP1,0:MESHES(NM)%KBP1)) - DO K=1,M%KBAR - DO J=1,M%JBAR - DO I=1,M%IBAR - ICC = MESHES(NM)%CCVAR(I,J,K,CC_IDCC); IF(ICC<1) CYCLE - CC =>MESHES(NM)%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)<1) CYCLE - DO IFC=2,CC%CCELEM(1,JCC)+1 - IFACE=CC%CCELEM(IFC,JCC) - IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE - ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & - GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) - ENDDO +END SUBROUTINE CC_GRID_REBUILD_LOCAL_FACE_AND_LINK_INFO + +SUBROUTINE CC_GRID_ACCUMULATE_BLOCKED_INB_AREA_OLD(NM,GEOM_AREA_SURF_OLD) + +INTEGER, INTENT(IN) :: NM +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_AREA_SURF_OLD + +INTEGER :: I,J,K,IFC,IFACE,ICF,JCF,ICC,JCC +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTFACE_TYPE), POINTER :: CF + +IF(PROCESS(NM)/=MY_RANK) RETURN + +M => MESHES(NM) + +! Here Add Blocked Areas per SURF_ID: +ALLOCATE(MESHES(NM)%INBCF_AREA(0:MESHES(NM)%IBP1,0:MESHES(NM)%JBP1,0:MESHES(NM)%KBP1)) +DO K=1,M%KBAR + DO J=1,M%JBAR + DO I=1,M%IBAR + ICC = MESHES(NM)%CCVAR(I,J,K,CC_IDCC); IF(ICC<1) CYCLE + CC =>MESHES(NM)%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + IF(CC%NOADVANCE(JCC)<1) CYCLE + DO IFC=2,CC%CCELEM(1,JCC)+1 + IFACE=CC%CCELEM(IFC,JCC) + IF(CC%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + ICF=CC%FACE_LIST(4,IFACE); JCF=CC%FACE_LIST(5,IFACE); CF=>MESHES(NM)%CUT_FACE(ICF) + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) = & + GEOM_AREA_SURF_OLD(CF%SURF_INDEX(JCF),CF%BODTRI(1,JCF)) + CF%AREA(JCF) ENDDO ENDDO ENDDO ENDDO -ENDIF +ENDDO + +END SUBROUTINE CC_GRID_ACCUMULATE_BLOCKED_INB_AREA_OLD + +SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM,CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_AREA_SURF_OLD) + +INTEGER, INTENT(IN) :: NM +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_AREA_SURF_OLD + +IF (.NOT.CC_COMPUTE_MESH(NM)) RETURN ! Only MESHES assigned to processor and OMESHES of these. +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) RETURN ! Don't do OMESHES for PERIODIC_TEST==105 + +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) + +CALL CC_GRID_APPLY_SPECIAL_CELL_BLOCKING(NM) +CALL CC_GRID_ENFORCE_ONE_CC_PER_CARTESIAN_CELL(NM) +CALL CC_GRID_REBUILD_LOCAL_FACE_AND_LINK_INFO(NM) +CALL CC_GRID_ACCUMULATE_BLOCKED_INB_AREA_OLD(NM,GEOM_AREA_SURF_OLD) + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) END SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH From b5191d527a6de38904898529145dc4f9f65c07ac Mon Sep 17 00:00:00 2001 From: Marcos Vanella Date: Tue, 21 Apr 2026 13:51:59 -0400 Subject: [PATCH 11/18] FDS Source: Define some low level primitives for GET_CELL_LINK_INFO. --- Source/geom.f90 | 158 +++++++++++++++++++++++++++++------------------- 1 file changed, 96 insertions(+), 62 deletions(-) diff --git a/Source/geom.f90 b/Source/geom.f90 index 8da4f3ddc57..093d2eafe46 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -5608,22 +5608,13 @@ END SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO ! -------------------------- GET_CELL_LINK_INFO ----------------------------------- -SUBROUTINE GET_CELL_LINK_INFO(NM) - -! Small cell linking subroutine in the mesh. Builds linking information for cutcell ICC,JCC: -! CUT_CELL(ICC)%IJK_LINK(1:KAXIS+2,JCC) of cell linked to, and CUT_CELL(ICC)%LINK_LEV(JCC) level within link tree. +SUBROUTINE CC_GRID_RESET_LINK_STATE_AND_TAG_SLIVERS(NM) INTEGER, INTENT(IN) :: NM -! Local Variables: -INTEGER :: ICC,JCC,ICC2,JCC2,JCC_LNK,I,J,K,I_LNK,J_LNK,K_LNK,IFC,IFC2,IFACE,IFACE2,IFACE3,IBOD,IWSEL,VAL_UNKZ,& - LINK_ITER,INGH,JNGH,KNGH,X1AXIS,ILH,INRM(1:3),DUM,LNK_LEV,ULINK_COUNT,LINK_LEV_UP,AX_MIN,AX_OTHERS(2) -REAL(EB):: AREA,AF,NRML(IAXIS:KAXIS),VAL_CVOL,CCVOL_THRES, XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND),& - MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND:HIGH_IND),CELL_DELTA(IAXIS:KAXIS) -LOGICAL :: QUITLINK_FLG,CRTCELL_FLG,MASK(IAXIS:KAXIS),BLOCK_SLIM_IF,SOLID_FACES -CHARACTER(MESSAGE_LENGTH) :: UNLINKED_FILE -INTEGER, SAVE :: LU_UNLNK -LOGICAL, SAVE :: UNLINKED_1ST_CALL=.TRUE. +INTEGER :: ICC,JCC,I,J,K,DUM,AX_MIN,AX_OTHERS(2) +REAL(EB) :: XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND),MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND:HIGH_IND),CELL_DELTA(IAXIS:KAXIS) +LOGICAL :: BLOCK_SLIM_IF,SOLID_FACES TYPE (MESH_TYPE), POINTER :: M TYPE (CC_CUTCELL_TYPE), POINTER :: CC @@ -5632,17 +5623,20 @@ SUBROUTINE GET_CELL_LINK_INFO(NM) ! Initialize UNKZ, used here to define if cell has been noted in linking hierarchy. Assume CCVAR has been allocated: M%CCVAR(:,:,:,CC_UNKZ) = CC_UNDEFINED DO ICC=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH - CC => M%CUT_CELL(ICC); I=CC%IJK(IAXIS); J=CC%IJK(JAXIS); K=CC%IJK(KAXIS) + CC => M%CUT_CELL(ICC) + I = CC%IJK(IAXIS) + J = CC%IJK(JAXIS) + K = CC%IJK(KAXIS) ! Test for sliver trapped cells blocking: - XYZCELL(IAXIS,LOW_IND) = XFACE(I-1); XYZCELL(IAXIS,HIGH_IND) = XFACE(I); - XYZCELL(JAXIS,LOW_IND) = YFACE(J-1); XYZCELL(JAXIS,HIGH_IND) = YFACE(J); - XYZCELL(KAXIS,LOW_IND) = ZFACE(K-1); XYZCELL(KAXIS,HIGH_IND) = ZFACE(K); + XYZCELL(IAXIS,LOW_IND) = XFACE(I-1); XYZCELL(IAXIS,HIGH_IND) = XFACE(I) + XYZCELL(JAXIS,LOW_IND) = YFACE(J-1); XYZCELL(JAXIS,HIGH_IND) = YFACE(J) + XYZCELL(KAXIS,LOW_IND) = ZFACE(K-1); XYZCELL(KAXIS,HIGH_IND) = ZFACE(K) MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND) = HUGE(EB) MINMAX_XYZ_CC(IAXIS:KAXIS,HIGH_IND)= -HUGE(EB) DO JCC=1,CC%NCELL ! Get cut-cell bounding box: CALL CUT_CELL_BOUNDING_BOX(NM,ICC,JCC,XYZCELL,MINMAX_XYZ_CC) - ! Perform Tests: + ! Perform tests: DO DUM=IAXIS,KAXIS CELL_DELTA(DUM) = ABS(MINMAX_XYZ_CC(DUM,HIGH_IND)-MINMAX_XYZ_CC(DUM,LOW_IND)) ENDDO @@ -5653,7 +5647,6 @@ SUBROUTINE GET_CELL_LINK_INFO(NM) CASE(JAXIS); AX_OTHERS(1:2) = (/ IAXIS, KAXIS /); SOLID_FACES = ALL(M%FCVAR(I,J-1:J,K,CC_FGSC,JAXIS)==CC_SOLID) CASE(KAXIS); AX_OTHERS(1:2) = (/ IAXIS, JAXIS /); SOLID_FACES = ALL(M%FCVAR(I,J,K-1:K,CC_FGSC,KAXIS)==CC_SOLID) END SELECT - ! Perform Test: BLOCK_SLIM_IF = (CELL_DELTA(AX_MIN)<10._EB*MIN_LENGTH_FACTOR*CELL_DELTA(AX_OTHERS(1))) .AND. & (CELL_DELTA(AX_MIN)<10._EB*MIN_LENGTH_FACTOR*CELL_DELTA(AX_OTHERS(2))) IF(BLOCK_SLIM_IF .AND. SOLID_FACES) CC%NOADVANCE(JCC) = BLOCKED_SMALL_CELL @@ -5664,22 +5657,34 @@ SUBROUTINE GET_CELL_LINK_INFO(NM) ENDDO ENDDO +END SUBROUTINE CC_GRID_RESET_LINK_STATE_AND_TAG_SLIVERS + +SUBROUTINE CC_GRID_SEED_LINK_UNKZ(NM) + +INTEGER, INTENT(IN) :: NM + +INTEGER :: ICC,JCC,I,J,K,INGH,JNGH,KNGH +REAL(EB) :: CCVOL_THRES +TYPE (MESH_TYPE), POINTER :: M + +M => MESHES(NM) + ! Loop on Cartesian cells, number unknowns for cells type CC_CUTCFE and surrounding CC_GASPHASE: DO K=0,M%KBP1 DO J=0,M%JBP1 DO I=0,M%IBP1 - IF ( M%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE - ! First Add the Cut-Cell - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF (ICC <= M%N_CUTCELL_MESH .AND. .NOT. M%CELL(M%CELL_INDEX(I,J,K))%SOLID ) THEN ! Don't number GC cut-cells, - ! or cutcells inside an OBST. + IF (M%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE) CYCLE + ! First add the cut-cell + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF (ICC <= M%N_CUTCELL_MESH .AND. .NOT. M%CELL(M%CELL_INDEX(I,J,K))%SOLID) THEN ! Don't number GC cut-cells, + ! or cutcells inside an OBST. CCVOL_THRES = CCVOL_LINK * (M%DX(I)*M%DY(J)*M%DZ(K)) DO JCC=1,M%CUT_CELL(ICC)%NCELL - IF ( M%CUT_CELL(ICC)%NOADVANCE(JCC)>0 ) CYCLE - IF ( M%CUT_CELL(ICC)%VOLUME(JCC) > CCVOL_THRES) M%CUT_CELL(ICC)%UNKZ(JCC) = 1 + IF (M%CUT_CELL(ICC)%NOADVANCE(JCC)>0) CYCLE + IF (M%CUT_CELL(ICC)%VOLUME(JCC) > CCVOL_THRES) M%CUT_CELL(ICC)%UNKZ(JCC) = 1 ENDDO ENDIF - ! Run over Neighbors: Case 27 cells. Only Internal cells for the mesh in the stencil (I-1:I+1,J-1:J+1,K-1:K+1) + ! Run over neighbors: case 27 cells. Only internal cells for the mesh in the stencil (I-1:I+1,J-1:J+1,K-1:K+1) ! around Cartesian cell I,J,K of type CC_CUTCFE: DO KNGH=K-1,K+1 IF ( (KNGH < 1) .OR. (KNGH > M%KBAR) ) CYCLE @@ -5694,11 +5699,68 @@ SUBROUTINE GET_CELL_LINK_INFO(NM) ENDDO ENDDO ENDDO - ENDDO ENDDO ENDDO +END SUBROUTINE CC_GRID_SEED_LINK_UNKZ + +SUBROUTINE GET_ICC2_JCC2(NM,ICC,IFACE,INXT,JNXT,KNXT,ICC2,JCC2) + +INTEGER, INTENT(IN) :: NM,ICC,IFACE,INXT,JNXT,KNXT +INTEGER, INTENT(OUT):: ICC2, JCC2 + +INTEGER :: IFC, IFACE2 +TYPE (MESH_TYPE), POINTER :: M +TYPE(CC_CUTCELL_TYPE), POINTER :: CC2 + +M => MESHES(NM) + +ICC2 = 0 +JCC2 = 0 +ICC2=M%CCVAR(INXT,JNXT,KNXT,CC_IDCC) +IF (ICC2<=0) RETURN +CC2 => M%CUT_CELL(ICC2) +DO JCC2=1,CC2%NCELL + ! Loop faces and test: + DO IFC=1,CC2%CCELEM(1,JCC2) + IFACE2 = CC2%CCELEM(IFC+1,JCC2) + ! If face type in face_list is not CC_FTYPE_RCGAS, drop: + IF(CC2%FACE_LIST(1,IFACE2) /= CC_FTYPE_RCGAS) CYCLE + ! Does X1AXIS match and LOWHIGH are different? + IF(CC2%FACE_LIST(3,IFACE2) /= M%CUT_CELL(ICC)%FACE_LIST(3,IFACE)) CYCLE ! X1AXIS is different. + IF(ABS(CC2%FACE_LIST(2,IFACE2) - M%CUT_CELL(ICC)%FACE_LIST(2,IFACE)) < 1) CYCLE ! Same LOWHIGH. + ! Found the cut-cell ICC2,JCC2 on the other side of IFACE for cut-cell ICC,JCC. + RETURN + ENDDO +ENDDO +JCC2=0 +RETURN +END SUBROUTINE GET_ICC2_JCC2 + +SUBROUTINE GET_CELL_LINK_INFO(NM) + +! Small cell linking subroutine in the mesh. Builds linking information for cutcell ICC,JCC: +! CUT_CELL(ICC)%IJK_LINK(1:KAXIS+2,JCC) of cell linked to, and CUT_CELL(ICC)%LINK_LEV(JCC) level within link tree. + +INTEGER, INTENT(IN) :: NM + +! Local Variables: +INTEGER :: ICC,JCC,ICC2,JCC2,JCC_LNK,I,J,K,I_LNK,J_LNK,K_LNK,IFC,IFC2,IFACE,IFACE2,IFACE3,IBOD,IWSEL,VAL_UNKZ,& + LINK_ITER,X1AXIS,ILH,INRM(1:3),DUM,LNK_LEV,ULINK_COUNT,LINK_LEV_UP +REAL(EB):: AREA,AF,NRML(IAXIS:KAXIS),VAL_CVOL,CCVOL_THRES +LOGICAL :: QUITLINK_FLG,CRTCELL_FLG,MASK(IAXIS:KAXIS) +CHARACTER(MESSAGE_LENGTH) :: UNLINKED_FILE +INTEGER, SAVE :: LU_UNLNK +LOGICAL, SAVE :: UNLINKED_1ST_CALL=.TRUE. +TYPE (MESH_TYPE), POINTER :: M +TYPE (CC_CUTCELL_TYPE), POINTER :: CC + +M => MESHES(NM) + +CALL CC_GRID_RESET_LINK_STATE_AND_TAG_SLIVERS(NM) +CALL CC_GRID_SEED_LINK_UNKZ(NM) + ! Now link small cells to surrounding cells in the mesh: ! NOTE: This scheme links two unknowns local to the mesh, therefore parallel consistency is not maintained. ! 1. Try linking them to adjacent regular cell with UNKZ > 0. Attempt going in surface normal direction first. @@ -5876,7 +5938,7 @@ SUBROUTINE GET_CELL_LINK_INFO(NM) SELECT CASE(X1AXIS) CASE(IAXIS) IF(M%CCVAR(I+ILH,J,K,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I+ILH,J,K,ICC2,JCC2) + CALL GET_ICC2_JCC2(NM,ICC,IFACE,I+ILH,J,K,ICC2,JCC2) IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 I_LNK = I+ILH; J_LNK = J; K_LNK = K; JCC_LNK = JCC2 @@ -5885,7 +5947,7 @@ SUBROUTINE GET_CELL_LINK_INFO(NM) ENDIF CASE(JAXIS) IF(M%CCVAR(I,J+ILH,K,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I,J+ILH,K,ICC2,JCC2) + CALL GET_ICC2_JCC2(NM,ICC,IFACE,I,J+ILH,K,ICC2,JCC2) IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 I_LNK = I; J_LNK = J+ILH; K_LNK = K; JCC_LNK = JCC2 @@ -5894,7 +5956,7 @@ SUBROUTINE GET_CELL_LINK_INFO(NM) ENDIF CASE(KAXIS) IF(M%CCVAR(I,J,K+ILH,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I,J,K+ILH,ICC2,JCC2) + CALL GET_ICC2_JCC2(NM,ICC,IFACE,I,J,K+ILH,ICC2,JCC2) IF(ANY((/ICC2,JCC2/)==0))CYCLE IFC_LOOP_3; IF(M%CUT_CELL(ICC2)%UNKZ(JCC2)<1)CYCLE IFC_LOOP_3 IF(M%CUT_CELL(ICC2)%LINK_LEV(JCC2)/=LINK_LEV_UP)CYCLE IFC_LOOP_3 I_LNK = I; J_LNK = J; K_LNK = K+ILH; JCC_LNK = JCC2 @@ -5949,7 +6011,7 @@ SUBROUTINE GET_CELL_LINK_INFO(NM) SELECT CASE(X1AXIS) CASE(IAXIS) IF(M%CCVAR(I+ILH,J,K,CC_UNKZ) <= 0) THEN ! Cut - cell. - CALL GET_ICC2_JCC2(ICC,IFACE,I+ILH,J,K,ICC2,JCC2) + CALL GET_ICC2_JCC2(NM,ICC,IFACE,I+ILH,J,K,ICC2,JCC2) IF(ANY((/ ICC2, JCC2 /) == 0)) CYCLE IFC_LOOP_4 IF(M%CUT_CELL(ICC2)%VOLUME(JCC2) M%CUT_CELL(ICC2) -DO JCC2=1,CC2%NCELL - ! Loop faces and test: - DO IFC=1,CC2%CCELEM(1,JCC2) - IFACE2 = CC2%CCELEM(IFC+1,JCC2) - ! If face type in face_list is not CC_FTYPE_RCGAS, drop: - IF(CC2%FACE_LIST(1,IFACE2) /= CC_FTYPE_RCGAS) CYCLE - ! Does X1AXIS match and LOWHIGH are different? - IF( CC2%FACE_LIST(3,IFACE2) /= M%CUT_CELL(ICC)%FACE_LIST(3,IFACE)) CYCLE ! X1AXIS is different. - IF(ABS(CC2%FACE_LIST(2,IFACE2) - M%CUT_CELL(ICC)%FACE_LIST(2,IFACE)) < 1) CYCLE ! Same LOWHIGH. - ! Found the cut-cell ICC2,JCC2 on the other side of IFACE for cut-cell ICC,JCC. - RETURN - ENDDO -ENDDO -JCC2=0 -RETURN -END SUBROUTINE GET_ICC2_JCC2 - - END SUBROUTINE GET_CELL_LINK_INFO From 5e37a86451c39213a1523cfff76cb74fd11f6a20 Mon Sep 17 00:00:00 2001 From: Marcos Vanella Date: Mon, 15 Jun 2026 13:21:23 -0400 Subject: [PATCH 12/18] FDS Source: bring master refinement-interface cut-cell blocking into refactored geom.f90. --- Source/geom.f90 | 1049 +++++++++++++++++++++++++++++++++++++---------- 1 file changed, 823 insertions(+), 226 deletions(-) diff --git a/Source/geom.f90 b/Source/geom.f90 index 3101597847c..1b6d046d429 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -1147,8 +1147,8 @@ SUBROUTINE READ_GEOM NAMELIST /GEOM/ BNDF_GEOM,BINARY_FILE,CELL_BLOCK_IOR,CELL_BLOCK_ORIENTATION,COLOR,CYLINDER_ORIGIN,CYLINDER_AXIS,& CYLINDER_RADIUS,CYLINDER_LENGTH,CYLINDER_NSEG_THETA,CYLINDER_NSEG_AXIS,& EXTRUDE,EXTEND_TERRAIN,FACES,FYI,ID,IJK,IS_TERRAIN,MOVE_ID,N_LAT,N_LEVELS,N_LONG,POLY,& - RGB,SPHERE_ORIGIN,SPHERE_RADIUS,SPHERE_TYPE,SURF_ID,SURF_IDS,SURF_ID6,& - TEXTURE_MAPPING,TEXTURE_ORIGIN,TEXTURE_SCALE,TRANSPARENCY,& + RGB,SPHERE_ORIGIN,SPHERE_RADIUS,SURF_ID,SURF_IDS,SURF_ID6,& + TEXTURE_MAPPING,TEXTURE_ORIGIN,TRANSPARENCY,& VERTS,XB,ZMIN,ZVALS,ZVAL_HORIZON ! first pass - count number of &GEOM lines. @@ -5364,6 +5364,9 @@ MODULE COMPLEX_GEOMETRY_GRID INTEGER, ALLOCATABLE, DIMENSION(:) :: SPCELLS_TO_BLOCK, SPCELLS_TO_BLOCK_AUX INTEGER :: N_SPCELLS_TO_BLOCK +! Per-mesh pending flag for iterative refinement-interface blocking re-scan: +LOGICAL, ALLOCATABLE, DIMENSION(:) :: FM_PENDING_BLOCK_SCAN + ! Wet surface edges intersection with Cartesian cells data structure: TYPE BODINT_CELL_EDGE_TYPE INTEGER :: NWCROSS=0 ! Number of intersections with Cartesian grid planes. @@ -5546,47 +5549,118 @@ END SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO - USE MPI_F08 - ! Local Variables: TYPE(CC_CUTCELL_TYPE), POINTER :: CC - INTEGER :: NM,NOM,N,IERR,I,J,K,ICC,JCC + INTEGER :: NM,I,J,K,ICC,JCC,IBOD_DONOR,ITRI_DONOR,NPACK,ICELL TYPE(MESH_TYPE), POINTER :: M - TYPE (MPI_REQUEST), ALLOCATABLE, DIMENSION(:) :: REQ0,REQ0DUM - INTEGER :: N_REQ0 - LOGICAL :: PROCESS_SENDREC ! Define cut-cells to be blocked for exchange: DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX CALL POINT_TO_MESH(NM) M => MESHES(NM) ! Count cut-cells for blocking in mesh: - M%N_CC_BLOCKED = 0 + NPACK = M%N_CC_ELIMINATED DO ICC=1,MESHES(NM)%N_CUTCELL_MESH - CC => CUT_CELL(ICC) + CC => M%CUT_CELL(ICC) DO JCC=1,CC%NCELL - IF(CC%NOADVANCE(JCC)>0) M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 + IF(CC%NOADVANCE(JCC)>0) NPACK = NPACK + 1 + ENDDO + ENDDO + ! Also count CC_SOLID interior cells in the outer 1-cell boundary band, so they get + ! projected to fine ghost cells at refinement interfaces. + DO K=1,M%KBAR + DO J=1,M%JBAR + DO I=1,M%IBAR + IF (M%CCVAR(I,J,K,CC_CGSC)/=CC_SOLID) CYCLE + IF (I>1 .AND. I1 .AND. J1 .AND. K0) THEN + M%N_CC_BLOCKED = NPACK + IF (NPACK>0) THEN IF(ALLOCATED(M%XYZ_CC_BLOCKED)) DEALLOCATE(M%XYZ_CC_BLOCKED) IF(ALLOCATED(M%JBT_CC_BLOCKED)) DEALLOCATE(M%JBT_CC_BLOCKED) - ALLOCATE(M%XYZ_CC_BLOCKED(3,M%N_CC_BLOCKED)) - ALLOCATE(M%JBT_CC_BLOCKED(2,M%N_CC_BLOCKED)) + ALLOCATE(M%XYZ_CC_BLOCKED(3,NPACK)) + ALLOCATE(M%JBT_CC_BLOCKED(4,NPACK)) ! Fill in blocked cut-cell info: M%N_CC_BLOCKED = 0 DO ICC=1,MESHES(NM)%N_CUTCELL_MESH - CC => CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) + CC => M%CUT_CELL(ICC); I = CC%IJK(IAXIS); J = CC%IJK(JAXIS); K = CC%IJK(KAXIS) DO JCC=1,CC%NCELL IF(CC%NOADVANCE(JCC)>0) THEN M%N_CC_BLOCKED = M%N_CC_BLOCKED + 1 - M%XYZ_CC_BLOCKED(1:3,M%N_CC_BLOCKED) = (/XC(I),YC(J),ZC(K)/) - M%JBT_CC_BLOCKED(1:2,M%N_CC_BLOCKED) = (/JCC,CC%NOADVANCE(JCC)/) + M%XYZ_CC_BLOCKED(1:3,M%N_CC_BLOCKED) = (/M%XC(I),M%YC(J),M%ZC(K)/) + CALL GET_BLOCKING_CUTCELL_DONOR(NM,ICC,JCC,IBOD_DONOR,ITRI_DONOR) + M%JBT_CC_BLOCKED(1:4,M%N_CC_BLOCKED) = (/JCC,CC%NOADVANCE(JCC),IBOD_DONOR,ITRI_DONOR/) ENDIF ENDDO ENDDO + ! Fill in CC_SOLID boundary-band coarse cells so they project to fine ghost cells. + DO K=1,M%KBAR + DO J=1,M%JBAR + DO I=1,M%IBAR + IF (M%CCVAR(I,J,K,CC_CGSC)/=CC_SOLID) CYCLE + IF (I>1 .AND. I1 .AND. J1 .AND. K MESHES(NM) + NPACK = M%N_CC_ELIMINATED + M%N_CC_BLOCKED = NPACK + IF (NPACK>0) THEN + IF(ALLOCATED(M%XYZ_CC_BLOCKED)) DEALLOCATE(M%XYZ_CC_BLOCKED) + IF(ALLOCATED(M%JBT_CC_BLOCKED)) DEALLOCATE(M%JBT_CC_BLOCKED) + ALLOCATE(M%XYZ_CC_BLOCKED(3,NPACK)) + ALLOCATE(M%JBT_CC_BLOCKED(4,NPACK)) + DO ICELL=1,NPACK + M%XYZ_CC_BLOCKED(1:3,ICELL) = M%XYZ_CC_ELIMINATED(1:3,ICELL) + M%JBT_CC_BLOCKED(1:4,ICELL) = M%JBT_CC_ELIMINATED(1:4,ICELL) + ENDDO + ELSE + M%N_CC_BLOCKED = 0 ENDIF ENDDO + CALL EXCHANGE_CC_BLOCKED_LISTS +END SUBROUTINE EXCHANGE_CC_ELIMINATED_INFO + +! ----------------------- EXCHANGE_CC_BLOCKED_LISTS ----------------------------- + +SUBROUTINE EXCHANGE_CC_BLOCKED_LISTS + + USE MPI_F08 + + ! Local Variables: + INTEGER :: NM,NOM,N,IERR + TYPE (MPI_REQUEST), ALLOCATABLE, DIMENSION(:) :: REQ0,REQ0DUM + INTEGER :: N_REQ0 + LOGICAL :: PROCESS_SENDREC ! MPI Exchange: IF (N_MPI_PROCESSES>1) THEN @@ -5627,7 +5701,7 @@ SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO IF(ALLOCATED(MESHES(NM)%XYZ_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED) IF(ALLOCATED(MESHES(NM)%JBT_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%JBT_CC_BLOCKED) ALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED(3,MESHES(NM)%N_CC_BLOCKED)) - ALLOCATE(MESHES(NM)%JBT_CC_BLOCKED(2,MESHES(NM)%N_CC_BLOCKED)) + ALLOCATE(MESHES(NM)%JBT_CC_BLOCKED(4,MESHES(NM)%N_CC_BLOCKED)) ENDIF ENDDO @@ -5645,7 +5719,7 @@ SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO CALL MPI_IRECV(MESHES(NM)%XYZ_CC_BLOCKED(1,1),3*MESHES(NM)%N_CC_BLOCKED,& MPI_DOUBLE_PRECISION,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_IRECV(MESHES(NM)%JBT_CC_BLOCKED(1,1),2*MESHES(NM)%N_CC_BLOCKED,& + CALL MPI_IRECV(MESHES(NM)%JBT_CC_BLOCKED(1,1),4*MESHES(NM)%N_CC_BLOCKED,& MPI_INTEGER,PROCESS(NM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) ENDIF ENDDO @@ -5662,7 +5736,7 @@ SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO CALL MPI_ISEND(MESHES(NM)%XYZ_CC_BLOCKED(1,1),3*MESHES(NM)%N_CC_BLOCKED,& MPI_DOUBLE_PRECISION,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) N_REQ0 = N_REQ0 + 1; CALL CHECK_REQ0_SIZE - CALL MPI_ISEND(MESHES(NM)%JBT_CC_BLOCKED(1,1),2*MESHES(NM)%N_CC_BLOCKED,& + CALL MPI_ISEND(MESHES(NM)%JBT_CC_BLOCKED(1,1),4*MESHES(NM)%N_CC_BLOCKED,& MPI_INTEGER,PROCESS(NOM),NM,MPI_COMM_WORLD,REQ0(N_REQ0),IERR) ENDIF ENDDO @@ -5682,7 +5756,52 @@ SUBROUTINE CHECK_REQ0_SIZE ENDIF END SUBROUTINE CHECK_REQ0_SIZE - END SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO + END SUBROUTINE EXCHANGE_CC_BLOCKED_LISTS + +! ----------------------- REGISTER_ELIMINATED_CUTCELL --------------------------- + +SUBROUTINE REGISTER_ELIMINATED_CUTCELL(NM,ICC,JCC) + +INTEGER, INTENT(IN) :: NM,ICC,JCC +INTEGER :: NNEW,NCAP,IBOD_DONOR,ITRI_DONOR +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: JBT_TMP +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZ_TMP +TYPE(MESH_TYPE), POINTER :: M + +IF (PROCESS(NM)/=MY_RANK) RETURN + +M => MESHES(NM) +IF (M%CUT_CELL(ICC)%NOADVANCE(JCC)<=0) RETURN +IF (.NOT.ELIMINATED_AT_REFI_INTERFACE()) RETURN +NNEW = M%N_CC_ELIMINATED + 1 +IF (.NOT.ALLOCATED(M%XYZ_CC_ELIMINATED)) THEN + NCAP = MAX(16,2*NNEW) + ALLOCATE(M%XYZ_CC_ELIMINATED(3,NCAP),M%JBT_CC_ELIMINATED(4,NCAP)) +ELSEIF (NNEW>SIZE(M%XYZ_CC_ELIMINATED,DIM=2)) THEN + NCAP = MAX(16,2*NNEW) + ALLOCATE(XYZ_TMP(3,NCAP),JBT_TMP(4,NCAP)) + IF (M%N_CC_ELIMINATED>0) THEN + XYZ_TMP(:,1:M%N_CC_ELIMINATED) = M%XYZ_CC_ELIMINATED(:,1:M%N_CC_ELIMINATED) + JBT_TMP(:,1:M%N_CC_ELIMINATED) = M%JBT_CC_ELIMINATED(:,1:M%N_CC_ELIMINATED) + ENDIF + CALL MOVE_ALLOC(FROM=XYZ_TMP,TO=M%XYZ_CC_ELIMINATED) + CALL MOVE_ALLOC(FROM=JBT_TMP,TO=M%JBT_CC_ELIMINATED) +ENDIF +M%N_CC_ELIMINATED = NNEW; M%XYZ_CC_ELIMINATED(1:3,NNEW) = M%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,JCC) +CALL GET_BLOCKING_CUTCELL_DONOR(NM,ICC,JCC,IBOD_DONOR,ITRI_DONOR) +M%JBT_CC_ELIMINATED(1:4,NNEW) = (/JCC,M%CUT_CELL(ICC)%NOADVANCE(JCC),IBOD_DONOR,ITRI_DONOR/) + +CONTAINS +LOGICAL FUNCTION ELIMINATED_AT_REFI_INTERFACE() +INTEGER :: I,J,K +ELIMINATED_AT_REFI_INTERFACE = .FALSE. +IF (M%N_NEIGHBORING_MESHES<1) RETURN +I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS) +IF (I<0 .OR. I>M%IBP1 .OR. J<0 .OR. J>M%JBP1 .OR. K<0 .OR. K>M%KBP1) RETURN +! First interior layer only (exclude ghost indices 0/IBP1). +ELIMINATED_AT_REFI_INTERFACE = ((I==1) .OR. (I==M%IBAR) .OR. (J==1) .OR. (J==M%JBAR) .OR. (K==1) .OR. (K==M%KBAR)) +END FUNCTION ELIMINATED_AT_REFI_INTERFACE +END SUBROUTINE REGISTER_ELIMINATED_CUTCELL ! -------------------------- GET_CELL_LINK_INFO ----------------------------------- @@ -5869,6 +5988,7 @@ SUBROUTINE GET_CELL_LINK_INFO(NM) IFACE2 = CC%FACE_LIST(5,IFACE) IBOD = M%CUT_FACE(IFC2)%BODTRI(1,IFACE2) IWSEL = M%CUT_FACE(IFC2)%BODTRI(2,IFACE2) + IF (.NOT.VALID_GEOMETRY_FACE_DONOR(IBOD,IWSEL)) CYCLE AF = M%CUT_FACE(IFC2)%AREA( IFACE2) NRML(IAXIS:KAXIS) = NRML(IAXIS:KAXIS) + GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL)*AF AREA = AREA + AF @@ -5980,6 +6100,7 @@ SUBROUTINE GET_CELL_LINK_INFO(NM) IFACE2 = CC%FACE_LIST(5,IFACE) IBOD = M%CUT_FACE(IFC2)%BODTRI(1,IFACE2) IWSEL = M%CUT_FACE(IFC2)%BODTRI(2,IFACE2) + IF (.NOT.VALID_GEOMETRY_FACE_DONOR(IBOD,IWSEL)) CYCLE AF = M%CUT_FACE(IFC2)%AREA( IFACE2) NRML(IAXIS:KAXIS) = NRML(IAXIS:KAXIS) + GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL)*AF AREA = AREA + AF @@ -6407,7 +6528,13 @@ SUBROUTINE INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX,SURF_INDEX,STAGE_FLG,IS_INB, ELSE IBOD =CF%BODTRI(1,IFACE) IWSEL=CF%BODTRI(2,IFACE) - BC%NVEC(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) + IF (VALID_GEOMETRY_FACE_DONOR(IBOD,IWSEL)) THEN + BC%NVEC(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,IWSEL) + ELSEIF (NORM2(BC%NVEC)>TWENTY_EPSILON_EB) THEN + BC%NVEC(IAXIS:KAXIS) = BC%NVEC(IAXIS:KAXIS)/NORM2(BC%NVEC) + ELSE + BC%NVEC(IAXIS:KAXIS) = 0._EB + ENDIF ENDIF X1AXIS = MAXLOC(ABS(BC%NVEC(IAXIS:KAXIS)),DIM=1) BC%IOR = INT(SIGN(1._EB,BC%NVEC(X1AXIS)))*X1AXIS @@ -6467,24 +6594,26 @@ SUBROUTINE INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX,SURF_INDEX,STAGE_FLG,IS_INB, IF (SF%BACKING==EXPOSED .AND. SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN IG = CF%BODTRI(1,IFACE) TRI = CF%BODTRI(2,IFACE) - XP(IAXIS:KAXIS) = (/ BC%X, BC%Y, BC%Z /) ! CFACE centroid location. - RDIR(IAXIS:KAXIS)= - GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,TRI) ! Normal into the body. - TRI_LOOP : DO IWSEL=1,GEOMETRY(IG)%N_FACES - IF (IWSEL==TRI) CYCLE - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) - ! Triangles NODES coordinates: - V1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) - V2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) - V3(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD3)-1)+1:MAX_DIM*WSELEM(NOD3)) - - ! Fast triangle discard method: To do. - - ! Search for intersection point in POS(IAXIS:KAXIS): - CALL RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,RDIR,IS_INTERSECT,POS) - - IF (IS_INTERSECT) EXIT TRI_LOOP - - ENDDO TRI_LOOP + IF (VALID_GEOMETRY_FACE_DONOR(IG,TRI)) THEN + XP(IAXIS:KAXIS) = (/ BC%X, BC%Y, BC%Z /) ! CFACE centroid location. + RDIR(IAXIS:KAXIS)= - GEOMETRY(IG)%FACES_NORMAL(IAXIS:KAXIS,TRI) ! Normal into the body. + TRI_LOOP : DO IWSEL=1,GEOMETRY(IG)%N_FACES + IF (IWSEL==TRI) CYCLE + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + ! Triangles NODES coordinates: + V1(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD1)-1)+1:MAX_DIM*WSELEM(NOD1)) + V2(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD2)-1)+1:MAX_DIM*WSELEM(NOD2)) + V3(IAXIS:KAXIS) = GEOMETRY(IG)%VERTS(MAX_DIM*(WSELEM(NOD3)-1)+1:MAX_DIM*WSELEM(NOD3)) + + ! Search for intersection point in POS(IAXIS:KAXIS): + CALL RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,RDIR,IS_INTERSECT,POS) + + IF (IS_INTERSECT) EXIT TRI_LOOP + + ENDDO TRI_LOOP + ELSE + IS_INTERSECT = .FALSE. + ENDIF IF (IS_INTERSECT) THEN @@ -8087,6 +8216,7 @@ SUBROUTINE CUT_CELL_MOVE(CUT_CELL_FROM,CUT_CELL_TO) CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%DEL_RHO_D_DEL_Z_VOL ,TO=CUT_CELL_TO%DEL_RHO_D_DEL_Z_VOL) CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%U_DOT_DEL_RHO_Z_VOL ,TO=CUT_CELL_TO%U_DOT_DEL_RHO_Z_VOL) CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%NOADVANCE ,TO=CUT_CELL_TO%NOADVANCE) +CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%BODTRI_DONOR ,TO=CUT_CELL_TO%BODTRI_DONOR) CALL MOVE_ALLOC(FROM=CUT_CELL_FROM%NOMICC ,TO=CUT_CELL_TO%NOMICC) RETURN @@ -8194,6 +8324,7 @@ SUBROUTINE CELL_DEALLOC(NM,ICC) DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%IJK_LINK,MESHES(NM)%CUT_CELL(ICC)%LINK_LEV) DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%VOLUME, MESHES(NM)%CUT_CELL(ICC)%XYZCEN) DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%NOADVANCE,MESHES(NM)%CUT_CELL(ICC)%UNKZ) +IF (ALLOCATED(MESHES(NM)%CUT_CELL(ICC)%BODTRI_DONOR)) DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%BODTRI_DONOR) RETURN @@ -8214,9 +8345,11 @@ SUBROUTINE NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) MESHES(NM)%CUT_CELL(ICC)%IJK_LINK = CC_UNDEFINED MESHES(NM)%CUT_CELL(ICC)%LINK_LEV = 0 ! Root of link Hierarchy is zero. -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%VOLUME(1:NCELL),MESHES(NM)%CUT_CELL(ICC)%NOADVANCE(1:NCELL)) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%VOLUME(1:NCELL),MESHES(NM)%CUT_CELL(ICC)%NOADVANCE(1:NCELL), & + MESHES(NM)%CUT_CELL(ICC)%BODTRI_DONOR(1:2,1:NCELL)) MESHES(NM)%CUT_CELL(ICC)%VOLUME = 0._EB MESHES(NM)%CUT_CELL(ICC)%NOADVANCE= NOT_BLOCKED +MESHES(NM)%CUT_CELL(ICC)%BODTRI_DONOR = 0 ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%XYZCEN(IAXIS:KAXIS,1:NCELL)) MESHES(NM)%CUT_CELL(ICC)%XYZCEN = 0._EB @@ -8402,6 +8535,421 @@ SUBROUTINE SET_CUTCELLS_3D END SUBROUTINE SET_CUTCELLS_3D +! ------------- Refinement-interface blocking helpers (ported from master) ------------- + +LOGICAL FUNCTION VALID_GEOMETRY_FACE_DONOR(IBOD,IWSEL) + +INTEGER, INTENT(IN) :: IBOD,IWSEL + +VALID_GEOMETRY_FACE_DONOR = .FALSE. +IF (.NOT.ALLOCATED(GEOMETRY)) RETURN +IF (IBOD<1 .OR. IBOD>SIZE(GEOMETRY,DIM=1)) RETURN +IF (.NOT.ALLOCATED(GEOMETRY(IBOD)%FACES_NORMAL)) RETURN +IF (IWSEL<1 .OR. IWSEL>SIZE(GEOMETRY(IBOD)%FACES_NORMAL,DIM=2)) RETURN +VALID_GEOMETRY_FACE_DONOR = .TRUE. + +END FUNCTION VALID_GEOMETRY_FACE_DONOR + +SUBROUTINE ACCUMULATE_BLOCKING_BODTRI(BODTRI_FACE,FACE_AREA,COUNT,BODTRI_ACC,AREA_ACC) + +INTEGER, INTENT(IN) :: BODTRI_FACE(1:2) +REAL(EB), INTENT(IN) :: FACE_AREA +INTEGER, INTENT(INOUT) :: COUNT +INTEGER, INTENT(INOUT), DIMENSION(:,:) :: BODTRI_ACC +REAL(EB), INTENT(INOUT), DIMENSION(:) :: AREA_ACC +INTEGER :: DUM + +IF (SIZE(BODTRI_ACC,DIM=1)<2 .OR. SIZE(AREA_ACC)<1) RETURN +IF (BODTRI_FACE(1)<1 .OR. BODTRI_FACE(2)<1) RETURN +DUM = 1 +DO DUM=1,COUNT + IF (ALL(BODTRI_ACC(1:2,DUM)==BODTRI_FACE(1:2))) EXIT +ENDDO +IF (DUM>COUNT) THEN + BODTRI_ACC(1:2,DUM) = BODTRI_FACE(1:2) + COUNT = DUM +ENDIF +AREA_ACC(DUM) = AREA_ACC(DUM) + MAX(FACE_AREA,0._EB) + +END SUBROUTINE ACCUMULATE_BLOCKING_BODTRI + +SUBROUTINE GET_BLOCKING_CUTCELL_DONOR(NM_LOC,ICC_LOC,JCC_LOC,IBOD_OUT,ITRI_OUT) + +INTEGER, INTENT(IN) :: NM_LOC,ICC_LOC,JCC_LOC +INTEGER, INTENT(OUT) :: IBOD_OUT,ITRI_OUT +INTEGER :: I_LOC,J_LOC,K_LOC,II,JJ,KK,ICC2,JCC2,IFC,IFACE,IFC1,JFC1,COUNT,COUNT_MAX,DUM +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BODTRI_ACC +REAL(EB), ALLOCATABLE, DIMENSION(:) :: AREA_ACC +TYPE(MESH_TYPE), POINTER :: MT + +IBOD_OUT = 0 +ITRI_OUT = 0 +MT => MESHES(NM_LOC) +IBOD_OUT = MT%CUT_CELL(ICC_LOC)%BODTRI_DONOR(1,JCC_LOC) +ITRI_OUT = MT%CUT_CELL(ICC_LOC)%BODTRI_DONOR(2,JCC_LOC) +IF (IBOD_OUT>0 .AND. ITRI_OUT>0) RETURN + +COUNT_MAX = MAX(1,MT%CUT_CELL(ICC_LOC)%CCELEM(1,JCC_LOC)) +ALLOCATE(BODTRI_ACC(1:2,COUNT_MAX+1),AREA_ACC(COUNT_MAX+1)) +BODTRI_ACC = 0; AREA_ACC = 0._EB;COUNT = 0 +DO IFC=1,MT%CUT_CELL(ICC_LOC)%CCELEM(1,JCC_LOC) + IFACE = MT%CUT_CELL(ICC_LOC)%CCELEM(IFC+1,JCC_LOC) + IF (MT%CUT_CELL(ICC_LOC)%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + IFC1 = MT%CUT_CELL(ICC_LOC)%FACE_LIST(4,IFACE) + JFC1 = MT%CUT_CELL(ICC_LOC)%FACE_LIST(5,IFACE) + IF (IFC1<1 .OR. IFC1>MT%N_CUTFACE_MESH+MT%N_GCCUTFACE_MESH) CYCLE + IF (.NOT.ALLOCATED(MT%CUT_FACE(IFC1)%BODTRI)) CYCLE + IF (JFC1<1 .OR. JFC1>SIZE(MT%CUT_FACE(IFC1)%BODTRI,DIM=2)) CYCLE + CALL ACCUMULATE_BLOCKING_BODTRI(MT%CUT_FACE(IFC1)%BODTRI(1:2,JFC1),MT%CUT_FACE(IFC1)%AREA(JFC1), & + COUNT,BODTRI_ACC,AREA_ACC) +ENDDO +IF (COUNT<1) THEN + DEALLOCATE(BODTRI_ACC,AREA_ACC) + COUNT_MAX = 0 + I_LOC = MT%CUT_CELL(ICC_LOC)%IJK(IAXIS) + J_LOC = MT%CUT_CELL(ICC_LOC)%IJK(JAXIS) + K_LOC = MT%CUT_CELL(ICC_LOC)%IJK(KAXIS) + DO KK=K_LOC-1,K_LOC+1 + DO JJ=J_LOC-1,J_LOC+1 + DO II=I_LOC-1,I_LOC+1 + ICC2 = MT%CCVAR(II,JJ,KK,CC_IDCC); IF (ICC2<1) CYCLE + DO JCC2=1,MT%CUT_CELL(ICC2)%NCELL + COUNT_MAX = COUNT_MAX + MT%CUT_CELL(ICC2)%CCELEM(1,JCC2) + ENDDO + ENDDO + ENDDO + ENDDO + IF (COUNT_MAX<1) RETURN + ALLOCATE(BODTRI_ACC(1:2,COUNT_MAX+1),AREA_ACC(COUNT_MAX+1)) + BODTRI_ACC = 0 + AREA_ACC = 0._EB + COUNT = 0 + DO KK=K_LOC-1,K_LOC+1 + DO JJ=J_LOC-1,J_LOC+1 + DO II=I_LOC-1,I_LOC+1 + ICC2 = MT%CCVAR(II,JJ,KK,CC_IDCC); IF (ICC2<1) CYCLE + DO JCC2=1,MT%CUT_CELL(ICC2)%NCELL + DO IFC=1,MT%CUT_CELL(ICC2)%CCELEM(1,JCC2) + IFACE = MT%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) + IF (MT%CUT_CELL(ICC2)%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + IFC1 = MT%CUT_CELL(ICC2)%FACE_LIST(4,IFACE) + JFC1 = MT%CUT_CELL(ICC2)%FACE_LIST(5,IFACE) + IF (IFC1<1 .OR. IFC1>MT%N_CUTFACE_MESH+MT%N_GCCUTFACE_MESH) CYCLE + IF (.NOT.ALLOCATED(MT%CUT_FACE(IFC1)%BODTRI)) CYCLE + IF (JFC1<1 .OR. JFC1>SIZE(MT%CUT_FACE(IFC1)%BODTRI,DIM=2)) CYCLE + CALL ACCUMULATE_BLOCKING_BODTRI(MT%CUT_FACE(IFC1)%BODTRI(1:2,JFC1),MT%CUT_FACE(IFC1)%AREA(JFC1), & + COUNT,BODTRI_ACC,AREA_ACC) + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO +ENDIF +IF (COUNT>0) THEN + DUM = MAXLOC(AREA_ACC(1:COUNT),DIM=1) + IBOD_OUT = BODTRI_ACC(1,DUM) + ITRI_OUT = BODTRI_ACC(2,DUM) + MT%CUT_CELL(ICC_LOC)%BODTRI_DONOR(1:2,JCC_LOC) = (/ IBOD_OUT, ITRI_OUT /) +ENDIF +IF (ALLOCATED(BODTRI_ACC)) DEALLOCATE(BODTRI_ACC) +IF (ALLOCATED(AREA_ACC)) DEALLOCATE(AREA_ACC) + +END SUBROUTINE GET_BLOCKING_CUTCELL_DONOR + +LOGICAL FUNCTION CELL_HAS_BLOCKED_CUTCELL(NM_LOC,I_LOC,J_LOC,K_LOC) +INTEGER, INTENT(IN) :: NM_LOC,I_LOC,J_LOC,K_LOC +INTEGER :: ICC_LOC +CELL_HAS_BLOCKED_CUTCELL = .FALSE. +ICC_LOC = MESHES(NM_LOC)%CCVAR(I_LOC,J_LOC,K_LOC,CC_IDCC); IF (ICC_LOC<1) RETURN +CELL_HAS_BLOCKED_CUTCELL = ANY(MESHES(NM_LOC)%CUT_CELL(ICC_LOC)%NOADVANCE(1:MESHES(NM_LOC)%CUT_CELL(ICC_LOC)%NCELL)>0) +END FUNCTION CELL_HAS_BLOCKED_CUTCELL + +SUBROUTINE GET_FINE_CELL_FROM_COARSE_WALL(IOR_COARSE,IIO_LOC,JJO_LOC,KKO_LOC,I_FINE,J_FINE,K_FINE) + +INTEGER, INTENT(IN) :: IOR_COARSE,IIO_LOC,JJO_LOC,KKO_LOC +INTEGER, INTENT(OUT) :: I_FINE,J_FINE,K_FINE + +I_FINE = IIO_LOC; J_FINE = JJO_LOC; K_FINE = KKO_LOC +SELECT CASE(ABS(IOR_COARSE)) +CASE(IAXIS); I_FINE = I_FINE + SIGN(1,IOR_COARSE) +CASE(JAXIS); J_FINE = J_FINE + SIGN(1,IOR_COARSE) +CASE(KAXIS); K_FINE = K_FINE + SIGN(1,IOR_COARSE) +END SELECT +END SUBROUTINE GET_FINE_CELL_FROM_COARSE_WALL + +SUBROUTINE GET_REFINEMENT_CELL_DONOR(NM_LOC,I_LOC,J_LOC,K_LOC,IBOD_OUT,ITRI_OUT) + +INTEGER, INTENT(IN) :: NM_LOC,I_LOC,J_LOC,K_LOC +INTEGER, INTENT(OUT) :: IBOD_OUT,ITRI_OUT +INTEGER :: II,JJ,KK,ICC_LOC,JCC_LOC,IFC,IFACE,IFC1,JFC1,COUNT,COUNT_MAX,DUM,PASS +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BODTRI_ACC +REAL(EB), ALLOCATABLE, DIMENSION(:) :: AREA_ACC +TYPE(MESH_TYPE), POINTER :: MT + +IBOD_OUT = 0; ITRI_OUT = 0 +MT => MESHES(NM_LOC) +DO PASS=1,2 + DO KK=K_LOC-1,K_LOC+1 + DO JJ=J_LOC-1,J_LOC+1 + DO II=I_LOC-1,I_LOC+1 + ICC_LOC = MT%CCVAR(II,JJ,KK,CC_IDCC); IF (ICC_LOC<1) CYCLE + DO JCC_LOC=1,MT%CUT_CELL(ICC_LOC)%NCELL + IF (PASS==1 .AND. MT%CUT_CELL(ICC_LOC)%NOADVANCE(JCC_LOC)<=0) CYCLE + IBOD_OUT = MT%CUT_CELL(ICC_LOC)%BODTRI_DONOR(1,JCC_LOC) + ITRI_OUT = MT%CUT_CELL(ICC_LOC)%BODTRI_DONOR(2,JCC_LOC) + IF (IBOD_OUT>0 .AND. ITRI_OUT>0) RETURN + ENDDO + ENDDO + ENDDO + ENDDO +ENDDO +COUNT_MAX = 0 +DO KK=K_LOC-1,K_LOC+1 + DO JJ=J_LOC-1,J_LOC+1 + DO II=I_LOC-1,I_LOC+1 + ICC_LOC = MT%CCVAR(II,JJ,KK,CC_IDCC); IF (ICC_LOC<1) CYCLE + DO JCC_LOC=1,MT%CUT_CELL(ICC_LOC)%NCELL + COUNT_MAX = COUNT_MAX + MT%CUT_CELL(ICC_LOC)%CCELEM(1,JCC_LOC) + ENDDO + ENDDO + ENDDO +ENDDO +IF (COUNT_MAX<1) RETURN +ALLOCATE(BODTRI_ACC(1:2,COUNT_MAX+1),AREA_ACC(COUNT_MAX+1)) +BODTRI_ACC = 0; AREA_ACC = 0._EB; COUNT = 0; +DO KK=K_LOC-1,K_LOC+1 + DO JJ=J_LOC-1,J_LOC+1 + DO II=I_LOC-1,I_LOC+1 + ICC_LOC = MT%CCVAR(II,JJ,KK,CC_IDCC); IF (ICC_LOC<1) CYCLE + DO JCC_LOC=1,MT%CUT_CELL(ICC_LOC)%NCELL + DO IFC=1,MT%CUT_CELL(ICC_LOC)%CCELEM(1,JCC_LOC) + IFACE = MT%CUT_CELL(ICC_LOC)%CCELEM(IFC+1,JCC_LOC) + IF (MT%CUT_CELL(ICC_LOC)%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB) CYCLE + IFC1 = MT%CUT_CELL(ICC_LOC)%FACE_LIST(4,IFACE) + JFC1 = MT%CUT_CELL(ICC_LOC)%FACE_LIST(5,IFACE) + IF (IFC1<1 .OR. IFC1>MT%N_CUTFACE_MESH+MT%N_GCCUTFACE_MESH) CYCLE + IF (.NOT.ALLOCATED(MT%CUT_FACE(IFC1)%BODTRI)) CYCLE + IF (JFC1<1 .OR. JFC1>SIZE(MT%CUT_FACE(IFC1)%BODTRI,DIM=2)) CYCLE + CALL ACCUMULATE_BLOCKING_BODTRI(MT%CUT_FACE(IFC1)%BODTRI(1:2,JFC1),MT%CUT_FACE(IFC1)%AREA(JFC1), & + COUNT,BODTRI_ACC,AREA_ACC) + ENDDO + ENDDO + ENDDO + ENDDO +ENDDO +IF (COUNT>0) THEN + DUM = MAXLOC(AREA_ACC(1:COUNT),DIM=1) + IBOD_OUT = BODTRI_ACC(1,DUM) + ITRI_OUT = BODTRI_ACC(2,DUM) +ENDIF +DEALLOCATE(BODTRI_ACC,AREA_ACC) +END SUBROUTINE GET_REFINEMENT_CELL_DONOR + +SUBROUTINE SET_REFINEMENT_CUTCELL_DONOR(NM_LOC,ICC_LOC,JCC_LOC,IBOD_IN,ITRI_IN) +INTEGER, INTENT(IN) :: NM_LOC,ICC_LOC,JCC_LOC,IBOD_IN,ITRI_IN +INTEGER :: IBOD_LOC,ITRI_LOC + +IF (IBOD_IN>0 .AND. ITRI_IN>0) THEN + MESHES(NM_LOC)%CUT_CELL(ICC_LOC)%BODTRI_DONOR(1:2,JCC_LOC) = (/ IBOD_IN, ITRI_IN /) +ELSE + CALL GET_BLOCKING_CUTCELL_DONOR(NM_LOC,ICC_LOC,JCC_LOC,IBOD_LOC,ITRI_LOC) +ENDIF +END SUBROUTINE SET_REFINEMENT_CUTCELL_DONOR + +LOGICAL FUNCTION FACE_INDEX_IN_BOUNDS(NM_LOC,I_LOC,J_LOC,K_LOC,AX_LOC) + +INTEGER, INTENT(IN) :: NM_LOC,I_LOC,J_LOC,K_LOC,AX_LOC + +FACE_INDEX_IN_BOUNDS = NM_LOC>=1 .AND. NM_LOC<=NMESHES; IF (.NOT.FACE_INDEX_IN_BOUNDS) RETURN +FACE_INDEX_IN_BOUNDS = I_LOC>=LBOUND(MESHES(NM_LOC)%FCVAR,DIM=1) .AND. I_LOC<=UBOUND(MESHES(NM_LOC)%FCVAR,DIM=1) .AND. & + J_LOC>=LBOUND(MESHES(NM_LOC)%FCVAR,DIM=2) .AND. J_LOC<=UBOUND(MESHES(NM_LOC)%FCVAR,DIM=2) .AND. & + K_LOC>=LBOUND(MESHES(NM_LOC)%FCVAR,DIM=3) .AND. K_LOC<=UBOUND(MESHES(NM_LOC)%FCVAR,DIM=3) .AND. & + AX_LOC>=LBOUND(MESHES(NM_LOC)%FCVAR,DIM=5) .AND. AX_LOC<=UBOUND(MESHES(NM_LOC)%FCVAR,DIM=5) +END FUNCTION FACE_INDEX_IN_BOUNDS + +SUBROUTINE TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT(NM_LOC,I_LOC,J_LOC,K_LOC,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR,CELL_CHANGED) + +INTEGER, INTENT(IN) :: NM_LOC,I_LOC,J_LOC,K_LOC,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR +LOGICAL, INTENT(OUT) :: CELL_CHANGED +INTEGER :: ICC_LOC,JCC_LOC,AX_LOC,SIDE_LOC,ICFC_LOC,CT_LOC,NCFACE_CUTCELL_LOC,NFACE_CELL_LOC,NCELL_LOC +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CCELEM_LOC,FACE_LIST_LOC +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOADVANCE_LOC +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZCEN_LOC +REAL(EB), ALLOCATABLE, DIMENSION(:) :: VOLUME_LOC +TYPE(MESH_TYPE), POINTER :: MT +INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) + +CELL_CHANGED = .FALSE. +MT => MESHES(NM_LOC) + +SELECT CASE(MT%CCVAR(I_LOC,J_LOC,K_LOC,CC_CGSC)) +CASE(CC_SOLID) + RETURN +CASE(CC_CUTCFE) + ICC_LOC = MT%CCVAR(I_LOC,J_LOC,K_LOC,CC_IDCC) + IF (ICC_LOC<1) RETURN + DO JCC_LOC=1,MT%CUT_CELL(ICC_LOC)%NCELL + IF (MT%CUT_CELL(ICC_LOC)%NOADVANCE(JCC_LOC)/=NOT_BLOCKED) CYCLE + MT%CUT_CELL(ICC_LOC)%NOADVANCE(JCC_LOC) = BLOCK_TAG + CALL SET_REFINEMENT_CUTCELL_DONOR(NM_LOC,ICC_LOC,JCC_LOC,IBOD_DONOR,ITRI_DONOR) + CELL_CHANGED = .TRUE. + ENDDO +CASE(CC_GASPHASE) + CT_LOC = 6 + NCFACE_CUTCELL_LOC = CT_LOC + 1 + NCELL_LOC = 1; NFACE_CELL_LOC = CT_LOC + ALLOCATE(CCELEM_LOC(1:NCFACE_CUTCELL_LOC,1:NCELL_LOC)); CCELEM_LOC = CC_UNDEFINED + ALLOCATE(FACE_LIST_LOC(1:CC_NPARAM_CCFACE,1:NFACE_CELL_LOC)); FACE_LIST_LOC = CC_UNDEFINED + ALLOCATE(VOLUME_LOC(1:NCELL_LOC)); VOLUME_LOC(1) = MT%DX(I_LOC)*MT%DY(J_LOC)*MT%DZ(K_LOC) + ALLOCATE(XYZCEN_LOC(IAXIS:KAXIS,1:NCELL_LOC)) + XYZCEN_LOC(IAXIS:KAXIS,1) = (/ MT%XC(I_LOC), MT%YC(J_LOC), MT%ZC(K_LOC) /) + ALLOCATE(NOADVANCE_LOC(1:NCELL_LOC)); NOADVANCE_LOC(1) = BLOCK_TAG + CT_LOC = 1; CCELEM_LOC(1,1) = 0 + DO AX_LOC=IAXIS,KAXIS + DO SIDE_LOC=LOW_IND,HIGH_IND + IF (.NOT.FACE_INDEX_IN_BOUNDS(NM_LOC,I_LOC+ADDI(SIDE_LOC,AX_LOC),J_LOC+ADDJ(SIDE_LOC,AX_LOC), & + K_LOC+ADDK(SIDE_LOC,AX_LOC),AX_LOC)) CYCLE + ICFC_LOC = MT%FCVAR(I_LOC+ADDI(SIDE_LOC,AX_LOC),J_LOC+ADDJ(SIDE_LOC,AX_LOC), & + K_LOC+ADDK(SIDE_LOC,AX_LOC),CC_IDCF,AX_LOC) + IF (ICFC_LOC>0) THEN + FACE_LIST_LOC(1:CC_NPARAM_CCFACE,CT_LOC) = (/ CC_FTYPE_CFGAS, SIDE_LOC, AX_LOC,ICFC_LOC, 1, CC_UNDEFINED /) + CCELEM_LOC(1,1) = CCELEM_LOC(1,1) + 1 + CCELEM_LOC(CCELEM_LOC(1,1)+1,1) = CT_LOC + CT_LOC = CT_LOC + 1 + ELSEIF (MT%FCVAR(I_LOC+ADDI(SIDE_LOC,AX_LOC),J_LOC+ADDJ(SIDE_LOC,AX_LOC), & + K_LOC+ADDK(SIDE_LOC,AX_LOC),CC_FGSC,AX_LOC)==CC_GASPHASE) THEN + FACE_LIST_LOC(1:CC_NPARAM_CCFACE,CT_LOC) = (/ CC_FTYPE_RCGAS, SIDE_LOC, AX_LOC, 0, 0, CC_UNDEFINED /) + CCELEM_LOC(1,1) = CCELEM_LOC(1,1) + 1 + CCELEM_LOC(CCELEM_LOC(1,1)+1,1) = CT_LOC + CT_LOC = CT_LOC + 1 + ENDIF + ENDDO + ENDDO + CALL INSERT_CUT_CELL(NM_LOC,I_LOC,J_LOC,K_LOC,ICC_LOC) + MT => MESHES(NM_LOC) + CALL NEW_CELL_ALLOC(NM_LOC,ICC_LOC,NCELL_LOC,NFACE_CELL_LOC,NCFACE_CUTCELL_LOC) + MT%CUT_CELL(ICC_LOC)%NCELL = NCELL_LOC + MT%CUT_CELL(ICC_LOC)%NFACE_CELL = NFACE_CELL_LOC + CALL MOVE_ALLOC(FROM=CCELEM_LOC,TO=MT%CUT_CELL(ICC_LOC)%CCELEM) + CALL MOVE_ALLOC(FROM=FACE_LIST_LOC,TO=MT%CUT_CELL(ICC_LOC)%FACE_LIST) + CALL MOVE_ALLOC(FROM=VOLUME_LOC,TO=MT%CUT_CELL(ICC_LOC)%VOLUME) + CALL MOVE_ALLOC(FROM=XYZCEN_LOC,TO=MT%CUT_CELL(ICC_LOC)%XYZCEN) + CALL MOVE_ALLOC(FROM=NOADVANCE_LOC,TO=MT%CUT_CELL(ICC_LOC)%NOADVANCE) + CALL SET_REFINEMENT_CUTCELL_DONOR(NM_LOC,ICC_LOC,1,IBOD_DONOR,ITRI_DONOR) + CELL_CHANGED = .TRUE. +END SELECT + +END SUBROUTINE TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT + +SUBROUTINE TAG_FINE_CELLS_IN_COARSE_CELL_VOLUME(NM_COARSE,I_COARSE,J_COARSE,K_COARSE,NM_FINE,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR) +INTEGER, INTENT(IN) :: NM_COARSE,I_COARSE,J_COARSE,K_COARSE,NM_FINE,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR +INTEGER :: I_FINE,J_FINE,K_FINE +REAL(EB) :: XLO,XHI,YLO,YHI,ZLO,ZHI,EPS_LOC +LOGICAL :: CELL_CHANGED +TYPE(MESH_TYPE), POINTER :: MC,MF + +MC => MESHES(NM_COARSE) +MF => MESHES(NM_FINE) +XLO = MC%X(I_COARSE-1); XHI = MC%X(I_COARSE) +YLO = MC%Y(J_COARSE-1); YHI = MC%Y(J_COARSE) +ZLO = MC%Z(K_COARSE-1); ZHI = MC%Z(K_COARSE) +EPS_LOC = 10._EB*GEOMEPS +DO K_FINE=0,MF%KBP1 + IF (MF%ZC(K_FINE)ZHI+EPS_LOC) CYCLE + DO J_FINE=0,MF%JBP1 + IF (MF%YC(J_FINE)YHI+EPS_LOC) CYCLE + DO I_FINE=0,MF%IBP1 + IF (I_FINE>=1 .AND. I_FINE<=MF%IBAR .AND. & + J_FINE>=1 .AND. J_FINE<=MF%JBAR .AND. & + K_FINE>=1 .AND. K_FINE<=MF%KBAR) CYCLE + IF (MF%XC(I_FINE)XHI+EPS_LOC) CYCLE + CALL TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT(NM_FINE,I_FINE,J_FINE,K_FINE,BLOCK_TAG, & + IBOD_DONOR,ITRI_DONOR,CELL_CHANGED) + IF (CELL_CHANGED) FM_PENDING_BLOCK_SCAN(NM_FINE) = .TRUE. + ENDDO + ENDDO +ENDDO +END SUBROUTINE TAG_FINE_CELLS_IN_COARSE_CELL_VOLUME + +SUBROUTINE PROMOTE_REFINEMENT_FOOTPRINTS_FROM_BLOCKED_FINE(NM_FINE) + +INTEGER, INTENT(IN) :: NM_FINE +INTEGER :: NM_COARSE,IW_LOC,II_COARSE,JJ_COARSE,KK_COARSE,IOR_COARSE, & + I_FINE,J_FINE,K_FINE,IIO_LOC,JJO_LOC,KKO_LOC,IBOD_DONOR,ITRI_DONOR +LOGICAL :: FINE_BLOCKED,CELL_CHANGED +TYPE(WALL_TYPE), POINTER :: WC_COARSE +TYPE(EXTERNAL_WALL_TYPE), POINTER :: EWC_COARSE +TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC_COARSE +TYPE(MESH_TYPE), POINTER :: MC + +COARSE_MESH_LOOP : DO NM_COARSE=1,NMESHES + IF (PROCESS(NM_COARSE)/=MY_RANK) CYCLE COARSE_MESH_LOOP + MC => MESHES(NM_COARSE) + COARSE_WALL_LOOP : DO IW_LOC=1,MC%N_EXTERNAL_WALL_CELLS + WC_COARSE => MC%WALL(IW_LOC); IF (WC_COARSE%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY) CYCLE COARSE_WALL_LOOP + EWC_COARSE => MC%EXTERNAL_WALL(IW_LOC); IF (EWC_COARSE%NOM/=NM_FINE) CYCLE COARSE_WALL_LOOP + IF ((EWC_COARSE%IIO_MAX-EWC_COARSE%IIO_MIN+1) * & + (EWC_COARSE%JJO_MAX-EWC_COARSE%JJO_MIN+1) * & + (EWC_COARSE%KKO_MAX-EWC_COARSE%KKO_MIN+1) <= 1) CYCLE COARSE_WALL_LOOP + BC_COARSE => MC%BOUNDARY_COORD(WC_COARSE%BC_INDEX) + II_COARSE = BC_COARSE%IIG; JJ_COARSE = BC_COARSE%JJG; KK_COARSE = BC_COARSE%KKG; IOR_COARSE = BC_COARSE%IOR + + FINE_BLOCKED = .FALSE.; IBOD_DONOR = 0; ITRI_DONOR = 0 + DO KKO_LOC=EWC_COARSE%KKO_MIN,EWC_COARSE%KKO_MAX + DO JJO_LOC=EWC_COARSE%JJO_MIN,EWC_COARSE%JJO_MAX + DO IIO_LOC=EWC_COARSE%IIO_MIN,EWC_COARSE%IIO_MAX + CALL GET_FINE_CELL_FROM_COARSE_WALL(IOR_COARSE,IIO_LOC,JJO_LOC,KKO_LOC,I_FINE,J_FINE,K_FINE) + IF (.NOT.CELL_HAS_BLOCKED_CUTCELL(NM_FINE,I_FINE,J_FINE,K_FINE)) CYCLE + FINE_BLOCKED = .TRUE. + IF (IBOD_DONOR<1 .OR. ITRI_DONOR<1) & + CALL GET_REFINEMENT_CELL_DONOR(NM_FINE,I_FINE,J_FINE,K_FINE,IBOD_DONOR,ITRI_DONOR) + ENDDO + ENDDO + ENDDO + IF (.NOT.FINE_BLOCKED) CYCLE COARSE_WALL_LOOP + CALL TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT(NM_COARSE,II_COARSE,JJ_COARSE,KK_COARSE,BLOCKED_REFI_INTER, & + IBOD_DONOR,ITRI_DONOR,CELL_CHANGED) + IF (CELL_CHANGED) FM_PENDING_BLOCK_SCAN(NM_COARSE) = .TRUE. + ENDDO COARSE_WALL_LOOP +ENDDO COARSE_MESH_LOOP +END SUBROUTINE PROMOTE_REFINEMENT_FOOTPRINTS_FROM_BLOCKED_FINE + +! Apply owner-side NOADVANCE flags from XYZ_CC_BLOCKED/JBT_CC_BLOCKED onto each replica's local CUT_CELL. +SUBROUTINE APPLY_OWN_BLOCKED_TO_REPLICAS(CC_COMPUTE_MESH) + +USE TRAN, ONLY: GET_IJK + +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER :: NM_LOC,ICELL,JCC_LOC,I_LOC,J_LOC,K_LOC,BLOCK_TAG,ICC_LOC +REAL(EB) :: XCO,YCO,ZCO,X1,Y1,Z1 + +MESH_LOOP_APPLY : DO NM_LOC=1,NMESHES + IF (.NOT.CC_COMPUTE_MESH(NM_LOC)) CYCLE ! Only meshes with state on this rank. + IF (PROCESS(NM_LOC)==MY_RANK) CYCLE ! Owner already wrote authoritative state. + IF (.NOT.ALLOCATED(MESHES(NM_LOC)%XYZ_CC_BLOCKED)) CYCLE + IF (MESHES(NM_LOC)%N_CC_BLOCKED<=0) CYCLE + DO ICELL=1,MESHES(NM_LOC)%N_CC_BLOCKED + JCC_LOC = MESHES(NM_LOC)%JBT_CC_BLOCKED(1,ICELL); IF (JCC_LOC<=0) CYCLE ! Skip CC_SOLID boundary-band entries. + BLOCK_TAG = MESHES(NM_LOC)%JBT_CC_BLOCKED(2,ICELL); IF (BLOCK_TAG==NOT_BLOCKED) CYCLE + XCO = MESHES(NM_LOC)%XYZ_CC_BLOCKED(IAXIS,ICELL) + YCO = MESHES(NM_LOC)%XYZ_CC_BLOCKED(JAXIS,ICELL) + ZCO = MESHES(NM_LOC)%XYZ_CC_BLOCKED(KAXIS,ICELL) + CALL GET_IJK(XCO,YCO,ZCO,NM_LOC,X1,Y1,Z1,I_LOC,J_LOC,K_LOC) + IF (I_LOC<1 .OR. I_LOC>MESHES(NM_LOC)%IBAR .OR. J_LOC<1 .OR. J_LOC>MESHES(NM_LOC)%JBAR .OR. & + K_LOC<1 .OR. K_LOC>MESHES(NM_LOC)%KBAR) CYCLE + ICC_LOC = MESHES(NM_LOC)%CCVAR(I_LOC,J_LOC,K_LOC,CC_IDCC) + IF (ICC_LOC<=0) CYCLE ! No matching cut-cell on this replica. + IF (MESHES(NM_LOC)%CUT_CELL(ICC_LOC)%NOADVANCE(JCC_LOC)==NOT_BLOCKED) THEN + MESHES(NM_LOC)%CUT_CELL(ICC_LOC)%NOADVANCE(JCC_LOC) = BLOCK_TAG + IF (MESHES(NM_LOC)%JBT_CC_BLOCKED(3,ICELL)>0 .AND. MESHES(NM_LOC)%JBT_CC_BLOCKED(4,ICELL)>0) & + MESHES(NM_LOC)%CUT_CELL(ICC_LOC)%BODTRI_DONOR(1:2,JCC_LOC) = MESHES(NM_LOC)%JBT_CC_BLOCKED(3:4,ICELL) + ENDIF + ENDDO +ENDDO MESH_LOOP_APPLY +END SUBROUTINE APPLY_OWN_BLOCKED_TO_REPLICAS + ! ------------------------------ ADD_CUTEDGE_TO_FACE -------------------------------- SUBROUTINE ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IEC2,JEC2,IFC,JFC,KFC,X1AXFC) @@ -9101,6 +9649,9 @@ SUBROUTINE DROP_CUTFACE(NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC) ICC1 = CF%CELL_LIST(2,ILH,IND(DUM)) JCC1 = CF%CELL_LIST(3,ILH,IND(DUM)) IFC1 = CF%CELL_LIST(4,ILH,IND(DUM)) + ! One side may have already been dropped to CC_SOLID (CELL_LIST entries set to + ! CC_UNDEFINED). Skip those entries safely; no cell exists on that side to reindex. + IF (ICC1<1 .OR. JCC1<1 .OR. IFC1<1) CYCLE IFACE= M%CUT_CELL(ICC1)%CCELEM(IFC1+1,JCC1) ! Dropping gas-cut cells, do not reindex local JCF for INBOUNDARY faces. These have been changed already. IF(FTYPE==CC_FTYPE_CFINB .OR. (FTYPE==CC_FTYPE_CFGAS .AND. M%CUT_CELL(ICC1)%FACE_LIST(1,IFACE)/=CC_FTYPE_CFINB)) & @@ -9187,6 +9738,7 @@ SUBROUTINE DROP_CUTCELL(NM,ICC,JCC) ! Check if JCC is the only cut-cell in CUT_CELL(ICC): IF (M%CUT_CELL(ICC)%NCELL==1) THEN + CALL REGISTER_ELIMINATED_CUTCELL(NM,ICC,JCC) ! Set cut-cell to solid M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED @@ -10493,14 +11045,13 @@ SUBROUTINE BLOCK_CUT_CELL(NM,ICC,JCC,BLOCK_PHASE) INTEGER, INTENT(IN) :: NM,ICC,JCC,BLOCK_PHASE -INTEGER :: I,J,K,II,JJ,KK,IFC,IFC1,JFC1,IFACE,LOHI,ILH,X1AXIS,NSVERT,NSFACE,NVERTFACE_NEW,COUNT,DUM,IBOD,ITRI,& +INTEGER :: I,J,K,II,JJ,KK,IFC,IFC1,JFC1,IFACE,LOHI,ILH,X1AXIS,NSVERT,NSFACE,NVERTFACE_NEW,COUNT,DUM,DUM2,IBOD,ITRI,& HILO,ILHF,ICC2,JCC2,IFC2,IFACE2,IFCX,JFCX,IV,IVERT,MAXVERTS,INOD,INDFC(1:4),ICCNXT,& IADD,JADD,KADD,EDGE_LIST_REG(1:3,1:4),DIMCE(2),IEDGE,CEI,LOHIE,AXISF,AXISE,LOWI,HIGI,LOWJ,HIGJ,LOWK,HIGK,& IEG,JEG,KEG,ICE,JCE,ICF2,JCF2,JCE2,IEC2,JEC2,VL1(4),VL2(4),NFCD,IFCIN,JFCIN,KFCIN,X1AXIN,SZDUM REAL(EB):: XYZV(IAXIS:KAXIS),XYZVERT(MAX_DIM,4) -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BODTRI,EDGE_LIST_AUX,CEDGES_AUX,CEDGES_AUX2,FACE_LIST_DROPPED +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: EDGE_LIST_AUX,CEDGES_AUX,CEDGES_AUX2,FACE_LIST_DROPPED INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM -REAL(EB),ALLOCATABLE, DIMENSION(:) :: AREA LOGICAL :: REALLOC_FLG, NEW_FACE_FLG, DROP_FACE, INZONE TYPE(MESH_TYPE), POINTER :: M TYPE(CC_INBCF_AREA_TYPE), POINTER :: INBCF_AREA @@ -10508,88 +11059,7 @@ SUBROUTINE BLOCK_CUT_CELL(NM,ICC,JCC,BLOCK_PHASE) I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS); ! Find Body and triangle to associate to the cell to be blocked: -IBOD = 0; ITRI = 0 -COUNT= 0; DUM = 0 -DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 -ENDDO -IF (COUNT>0) THEN - ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 - DO IFC=1,M%CUT_CELL(ICC)%CCELEM(1,JCC) - IFACE = M%CUT_CELL(ICC)%CCELEM(IFC+1,JCC) - IFC1 = M%CUT_CELL(ICC)%FACE_LIST(4,IFACE) - JFC1 = M%CUT_CELL(ICC)%FACE_LIST(5,IFACE) - IF (M%CUT_CELL(ICC)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE - DO DUM=1,COUNT - IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & - BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT - ENDDO - IF(DUM > COUNT) THEN ! No match in previous loop DUM=COUNT+1 - BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) - COUNT = DUM - ENDIF - AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) - ENDDO - IF (COUNT>0) THEN - ! Now set IBOD, ITRI - DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. - IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) - ENDIF - DEALLOCATE(BODTRI,AREA) -ELSE - ! Look in surrounding cells: - DO KK=K-1,K+1 - DO JJ=J-1,J+1 - DO II=I-1,I+1 - ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) - IF (ICC2>0) THEN - DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) - IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) COUNT = COUNT + 1 - ENDDO - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - IF (COUNT>0) THEN - ALLOCATE(BODTRI(2,COUNT+1),AREA(COUNT+1)); BODTRI=0; AREA=0._EB; COUNT = 0 - DO KK=K-1,K+1 - DO JJ=J-1,J+1 - DO II=I-1,I+1 - ICC2=M%CCVAR(II,JJ,KK,CC_IDCC) - IF (ICC2>0) THEN - DO JCC2=1,M%CUT_CELL(ICC2)%NCELL - DO IFC=1,M%CUT_CELL(ICC2)%CCELEM(1,JCC2) - IFACE = M%CUT_CELL(ICC2)%CCELEM(IFC+1,JCC2) - IFC1 = M%CUT_CELL(ICC2)%FACE_LIST(4,IFACE) - JFC1 = M%CUT_CELL(ICC2)%FACE_LIST(5,IFACE) - IF (M%CUT_CELL(ICC2)%FACE_LIST(1,IFACE) /= CC_FTYPE_CFINB) CYCLE - DO DUM=1,COUNT - IF( BODTRI(1,DUM)==M%CUT_FACE(IFC1)%BODTRI(1,JFC1) .AND. & - BODTRI(2,DUM)==M%CUT_FACE(IFC1)%BODTRI(2,JFC1) ) EXIT - ENDDO - IF(DUM > COUNT) THEN - BODTRI(1:2,DUM)=M%CUT_FACE(IFC1)%BODTRI(1:2,JFC1) - COUNT = DUM - ENDIF - AREA(DUM) = AREA(DUM) + M%CUT_FACE(IFC1)%AREA(JFC1) - ENDDO - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO - IF (COUNT>0) THEN - ! Now set IBOD, ITRI - DUM = MAXLOC(AREA,DIM=1) ! BOD,TRI and SURF_ID with max area in cc being blocked. - IBOD= BODTRI(1,DUM); ITRI= BODTRI(2,DUM) - ENDIF - DEALLOCATE(BODTRI,AREA) - ENDIF -ENDIF +CALL GET_BLOCKING_CUTCELL_DONOR(NM,ICC,JCC,IBOD,ITRI) ! For cut-cell ICC, JCC run through its boundary faces and generate new boundary EDGES, CUT-FACES and cells: BLOCK_PHASE_IF : IF(BLOCK_PHASE==1) THEN @@ -10886,7 +11356,8 @@ SUBROUTINE BLOCK_CUT_CELL(NM,ICC,JCC,BLOCK_PHASE) ! Scheme: ! 0. Add REG and CFGAS cut edges as INB cut edges for the normal faces where it corresponds: DUM=0; IF(ALLOCATED(M%CUT_FACE(IFC1)%EDGE_LIST)) DUM=SIZE(M%CUT_FACE(IFC1)%EDGE_LIST,DIM=2) - ALLOCATE(EDGE_LIST_AUX(3,DUM+M%CUT_FACE(IFCX)%CEDGES(1,JFCX))); + DUM2 = M%CUT_FACE(IFCX)%CEDGES(1,JFCX); IF(DUM2<0) DUM2 = 0 + ALLOCATE(EDGE_LIST_AUX(3,DUM+DUM2)); EDGE_LIST_AUX = CC_UNDEFINED; EDGE_LIST_REG(1,:) = CC_ETYPE_CFINB ! Initialize EDGE_LIST addition. IF(DUM>0) EDGE_LIST_AUX(1:3,1:DUM) = M%CUT_FACE(IFC1)%EDGE_LIST(1:3,1:DUM) ALLOCATE(CEDGES_AUX(SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=1),SIZE(M%CUT_FACE(IFC1)%CFELEM,DIM=2))) @@ -11559,6 +12030,8 @@ SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE CF => CUT_FACE(ICF); IF(CF%STATUS /= CC_INBOUNDARY) CYCLE ! Don't count INB cut-faces inside an OBST: IF (CELL(CELL_INDEX(CF%IJK(IAXIS),CF%IJK(JAXIS),CF%IJK(KAXIS)))%SOLID) CYCLE + ! Don't count INB cut-faces of cut-cells eliminated to solid during blocking (no gas cut-cell backs the CFACE): + IF (MESHES(NM)%CCVAR(CF%IJK(IAXIS),CF%IJK(JAXIS),CF%IJK(KAXIS),CC_CGSC)==CC_SOLID) CYCLE NCFACE_BY_MESH(NM) = NCFACE_BY_MESH(NM) + CF%NFACE ENDDO ENDDO MESH_LOOP_0 @@ -11675,6 +12148,8 @@ SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE I = CF%IJK(IAXIS); J = CF%IJK(JAXIS); K = CF%IJK(KAXIS) ! Don't count INB cut-faces inside an OBST: IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE + ! Don't count INB cut-faces of cut-cells eliminated to solid during blocking (no gas cut-cell backs the CFACE): + IF (MESHES(NM)%CCVAR(I,J,K,CC_CGSC)==CC_SOLID) CYCLE DO IFACE=1,CF%NFACE CFACE_INDEX_LOCAL = CFACE_INDEX_LOCAL + 1 ! Index in CFACE for cut-face in (ICF,IFACE) of CUT_FACE. @@ -12003,7 +12478,7 @@ SUBROUTINE SET_GC_CUTCELLS_3D DO JJO=EWC%JJO_MIN,EWC%JJO_MAX DO IIO=EWC%IIO_MIN,EWC%IIO_MAX ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) - IF (ICC > 0) THEN + IF (ICC > 0 .AND. MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_CGSC)==CC_CUTCFE) THEN N_CF = N_CF + 1 MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,N_CF) = (/ NOM, ICC /) NCELL = MESHES(NOM)%CUT_CELL(ICC)%NCELL @@ -12042,7 +12517,8 @@ SUBROUTINE SET_GC_CUTCELLS_3D IF(FCVAR(IIO ,JJO ,KKO ,CC_FGSC,KAXIS) == CC_SOLID) CYCLE END SELECT IF (MESHES(NM)%CCVAR(II,JJ,KK,CC_CGSC) == CC_CUTCFE) THEN - ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC); IF (ICC<1) CYCLE + ICC = MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_IDCC) + IF (ICC<1 .OR. MESHES(NOM)%CCVAR(IIO,JJO,KKO,CC_CGSC)/=CC_CUTCFE) CYCLE NMICC = MESHES(NM)%CCVAR(II,JJ,KK,CC_IDCC) NOFC = 1 ALLOCATE(MESHES(NM)%CUT_CELL(NMICC)%NOMICC(2,NOFC)); MESHES(NM)%CUT_CELL(NMICC)%NOMICC(1:2,1:NOFC) = 0 @@ -12088,30 +12564,81 @@ SUBROUTINE CC_GRID_TAG_CAVITY_CUTCELLS(NM,N_CAVITY_CELLS) INTEGER, INTENT(IN) :: NM INTEGER, INTENT(OUT) :: N_CAVITY_CELLS -INTEGER :: ICC1,J,I,N_GAS_FACES,N_REGULAR_NEIGHBORS +INTEGER :: ICC1,J,I,IFACE,SIDE,X1AXIS,IIF,JJF,KKF,SUM_FACE,SUM_CCELL,ICF1 +REAL(EB) :: ACRT +LOGICAL :: MESH_BOUNDARY_FACE TYPE(CC_CUTCELL_TYPE), POINTER :: CC +TYPE(CC_CUTFACE_TYPE), POINTER :: CF +TYPE(MESH_TYPE), POINTER :: M +INTEGER, PARAMETER :: ADDI(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/-1,0, 0,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDJ(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0,-1,0, 0,0/),(/2,3/)) +INTEGER, PARAMETER :: ADDK(LOW_IND:HIGH_IND,IAXIS:KAXIS) = RESHAPE((/ 0,0, 0,0,-1,0/),(/2,3/)) N_CAVITY_CELLS = 0 +M => MESHES(NM) -DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%CUT_CELL(ICC1) +! Block any cells that contain only one gas cut-face (cavity type cut-cells): +DO ICC1=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC=>M%CUT_CELL(ICC1) DO J=1,CC%NCELL - N_GAS_FACES = 0 - N_REGULAR_NEIGHBORS = 0 + SUM_FACE=0; SUM_CCELL=0 DO I=2,CC%CCELEM(1,J) SELECT CASE(CC%FACE_LIST(1,CC%CCELEM(I,J))) - CASE(CC_FTYPE_CFGAS) - N_GAS_FACES = N_GAS_FACES + 1 - CASE(CC_FTYPE_RCGAS) - N_REGULAR_NEIGHBORS = N_REGULAR_NEIGHBORS + 1 + CASE(CC_FTYPE_CFGAS); SUM_FACE = SUM_FACE+1 + CASE(CC_FTYPE_RCGAS); SUM_CCELL=SUM_CCELL+1 END SELECT ENDDO - IF(N_GAS_FACES>1 .OR. N_REGULAR_NEIGHBORS>0) CYCLE + IF(SUM_FACE>1 .OR. SUM_CCELL>0) CYCLE IF(CC%NOADVANCE(J)==NOT_BLOCKED) CC%NOADVANCE(J)=BLOCKED_CAVITY_CELL N_CAVITY_CELLS = N_CAVITY_CELLS + 1 ENDDO ENDDO +! Block cells trapped against a mesh boundary whose only same-mesh gas opening is a small cut-face. +DO ICC1=1,M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH + CC=>M%CUT_CELL(ICC1) + DO J=1,CC%NCELL + IF(CC%NOADVANCE(J)/=NOT_BLOCKED) CYCLE + SUM_FACE=0; SUM_CCELL=0; ICF1=0 + DO I=1,CC%CCELEM(1,J) + IFACE = CC%CCELEM(I+1,J) + SELECT CASE(CC%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_CFGAS,CC_FTYPE_RCGAS) + SIDE = CC%FACE_LIST(2,IFACE) + X1AXIS = CC%FACE_LIST(3,IFACE) + IIF = CC%IJK(IAXIS) + ADDI(SIDE,X1AXIS) + JJF = CC%IJK(JAXIS) + ADDJ(SIDE,X1AXIS) + KKF = CC%IJK(KAXIS) + ADDK(SIDE,X1AXIS) + MESH_BOUNDARY_FACE = .FALSE. + SELECT CASE(X1AXIS) + CASE(IAXIS); MESH_BOUNDARY_FACE = IIF==0 .OR. IIF==M%IBAR + CASE(JAXIS); MESH_BOUNDARY_FACE = JJF==0 .OR. JJF==M%JBAR + CASE(KAXIS); MESH_BOUNDARY_FACE = KKF==0 .OR. KKF==M%KBAR + END SELECT + IF(MESH_BOUNDARY_FACE) CYCLE + SELECT CASE(CC%FACE_LIST(1,IFACE)) + CASE(CC_FTYPE_CFGAS) + SUM_FACE = SUM_FACE+1 + ICF1 = CC%FACE_LIST(4,IFACE) + CASE(CC_FTYPE_RCGAS) + SUM_CCELL = SUM_CCELL+1 + END SELECT + END SELECT + ENDDO + IF(SUM_FACE/=1 .OR. SUM_CCELL>0) CYCLE + CF => M%CUT_FACE(ICF1) + IIF=CF%IJK(IAXIS); JJF=CF%IJK(JAXIS); KKF=CF%IJK(KAXIS) + SELECT CASE(CF%IJK(KAXIS+1)) + CASE(IAXIS); ACRT = DYFACE(JJF)*DZFACE(KKF) + CASE(JAXIS); ACRT = DZFACE(KKF)*DXFACE(IIF) + CASE(KAXIS); ACRT = DXFACE(IIF)*DYFACE(JJF) + END SELECT + IF(SUM(CF%AREA(1:CF%NFACE))/ACRT>=CCVOL_LINK) CYCLE + CC%NOADVANCE(J)=BLOCKED_CAVITY_CELL + N_CAVITY_CELLS = N_CAVITY_CELLS + 1 + ENDDO +ENDDO + END SUBROUTINE CC_GRID_TAG_CAVITY_CUTCELLS SUBROUTINE CC_GRID_REBLOCK_MESH_AFTER_NEIGHBOR_EXCHANGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) @@ -12130,10 +12657,7 @@ SUBROUTINE CC_GRID_REBLOCK_MESH_AFTER_NEIGHBOR_EXCHANGE(NM,ISTR,IEND,JSTR,JEND,K ! Block any cells that contain only one gas cut-face (cavity type cut-cells). CALL CC_GRID_TAG_CAVITY_CUTCELLS(NM,N_CAVITY_CELLS) -IF (N_CAVITY_CELLS>0) THEN - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) - IF(SUM_CCELL>0) CALL CC_GRID_REBUILD_PHASE2_FACE_AND_LINK_INFO(NM) -ENDIF +IF (N_CAVITY_CELLS>0) FM_PENDING_BLOCK_SCAN(NM) = .TRUE. CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) @@ -12175,16 +12699,51 @@ SUBROUTINE CC_GRID_EXCHANGE_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KST LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH INTEGER :: NM +FM_PENDING_BLOCK_SCAN = .FALSE. +DO NM=1,NMESHES; MESHES(NM)%N_CC_ELIMINATED = 0; ENDDO + ! Exchange CC%NOADVANCE(JCC)>0 information among NEIGHBOURING meshes: CALL EXCHANGE_CC_NOADVANCE_INFO +! Mirror owner-side NOADVANCE flags onto OMESH replicas of the same mesh: +CALL APPLY_OWN_BLOCKED_TO_REPLICAS(CC_COMPUTE_MESH) ! Add CC%NOADVANCE(JCC) where needed: CALL ADD_NEIGHBOR_BLOCKED_CELLS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) +! Reblock each mesh (block small/unlinked cut-cells + cavity cut-cells); sets FM_PENDING_BLOCK_SCAN: DO NM=1,NMESHES IF (.NOT.CC_GRID_SHOULD_PROCESS_MESH(NM,CC_COMPUTE_MESH)) CYCLE CALL CC_GRID_REBLOCK_MESH_AFTER_NEIGHBOR_EXCHANGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) ENDDO +! Propagate DROP_CUTCELL eliminations (fine interior, NCELL==1) to coarse ghost band; +! ghost solidifies, then TAG_CC_BLOCKING_REFINEMENT closes fine footprint. +CALL EXCHANGE_CC_ELIMINATED_INFO +CALL APPLY_OWN_BLOCKED_TO_REPLICAS(CC_COMPUTE_MESH) +CALL ADD_NEIGHBOR_BLOCKED_CELLS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) +DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + IF (MESHES(NM)%N_CC_ELIMINATED>0) FM_PENDING_BLOCK_SCAN(NM) = .TRUE. +ENDDO +DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX; MESHES(NM)%N_CC_ELIMINATED = 0; ENDDO + +! Promote refinement footprints from blocked fine cells, then relink affected meshes: +IF (ANY(FM_PENDING_BLOCK_SCAN)) THEN + DO WHILE (ANY(FM_PENDING_BLOCK_SCAN)) + DO NM=1,NMESHES + IF (.NOT.FM_PENDING_BLOCK_SCAN(NM)) CYCLE + FM_PENDING_BLOCK_SCAN(NM) = .FALSE. + CALL PROMOTE_REFINEMENT_FOOTPRINTS_FROM_BLOCKED_FINE(NM) + ENDDO + ENDDO + FM_PENDING_BLOCK_SCAN = .FALSE. + DO NM=1,NMESHES + IF (.NOT.CC_GRID_SHOULD_PROCESS_MESH(NM,CC_COMPUTE_MESH)) CYCLE + CALL CC_GRID_FINAL_REBLOCK_MESH(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) + ENDDO +ENDIF +CALL EXCHANGE_CC_NOADVANCE_INFO +CALL APPLY_OWN_BLOCKED_TO_REPLICAS(CC_COMPUTE_MESH) +CALL ADD_NEIGHBOR_BLOCKED_CELLS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) + ! Call tag boundary cut-cells for blocking in refinement interfaces: CALL TAG_CC_BLOCKING_REFINEMENT @@ -12196,6 +12755,11 @@ SUBROUTINE CC_GRID_FINAL_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,K LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH INTEGER :: NM +! Propagate TAG_CC_BLOCKING_REFINEMENT effects across ranks before the final BLOCK_SMALL pass: +CALL EXCHANGE_CC_NOADVANCE_INFO +CALL APPLY_OWN_BLOCKED_TO_REPLICAS(CC_COMPUTE_MESH) +CALL ADD_NEIGHBOR_BLOCKED_CELLS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) + DO NM=1,NMESHES IF (.NOT.CC_GRID_SHOULD_PROCESS_MESH(NM,CC_COMPUTE_MESH)) CYCLE CALL CC_GRID_FINAL_REBLOCK_MESH(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) @@ -12207,7 +12771,17 @@ SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH -INTEGER :: IDIM +INTEGER :: IDIM,NM + +IF (ALLOCATED(FM_PENDING_BLOCK_SCAN)) DEALLOCATE(FM_PENDING_BLOCK_SCAN) +ALLOCATE(FM_PENDING_BLOCK_SCAN(1:NMESHES)); FM_PENDING_BLOCK_SCAN = .FALSE. + +! Promote refinement footprints from initially blocked fine cells (e.g., slivers tagged +! BLOCKED_SMALL_CELL in GET_CARTCELL_CUTCELLS / GET_CELL_LINK_INFO): +DO NM=1,NMESHES + IF (.NOT.CC_GRID_SHOULD_PROCESS_MESH(NM,CC_COMPUTE_MESH)) CYCLE + CALL PROMOTE_REFINEMENT_FOOTPRINTS_FROM_BLOCKED_FINE(NM) +ENDDO DO IDIM=1,MAX_DIM CALL CC_GRID_EXCHANGE_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) @@ -12215,104 +12789,100 @@ SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR CALL CC_GRID_FINAL_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) +IF (ALLOCATED(FM_PENDING_BLOCK_SCAN)) DEALLOCATE(FM_PENDING_BLOCK_SCAN) + END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK -SUBROUTINE CC_GRID_TAG_COARSE_CELL_FROM_NEIGHBOR_BLOCK(M,M2,XCO,YCO,ZCO,BLOCK_TAG) +SUBROUTINE CC_GRID_TAG_COARSE_CELL_FROM_NEIGHBOR_BLOCK(NM,M,M2,I2,J2,K2,XCO,YCO,ZCO,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR) +INTEGER, INTENT(IN) :: NM,I2,J2,K2 TYPE(MESH_TYPE), POINTER :: M,M2 REAL(EB), INTENT(IN) :: XCO,YCO,ZCO -INTEGER, INTENT(IN) :: BLOCK_TAG +INTEGER, INTENT(IN) :: BLOCK_TAG,IBOD_DONOR,ITRI_DONOR INTEGER :: I,J,K,ICC,JCC -LOGICAL :: IND_FOUND - -IF(XCO < M2%XS .OR. XCO > M2%XF .OR. & - YCO < M2%YS .OR. YCO > M2%YF .OR. & - ZCO < M2%ZS .OR. ZCO > M2%ZF) RETURN -IF(XCO > M2%X(1) .AND. XCO < M2%X(M2%IBAR-1) .AND. & - YCO > M2%Y(1) .AND. YCO < M2%Y(M2%JBAR-1) .AND. & - ZCO > M2%Z(1) .AND. ZCO < M2%Z(M2%KBAR-1)) RETURN - -! Find I,J,K in NM where (XCO,YCO,ZCO) falls within cell bounds -IND_FOUND = .FALSE. -DO I=ILO_CELL-1,IHI_CELL+1 - IF (XCO < XFACE(I-1)-GEOMEPS .OR. XCO > XFACE(I)+GEOMEPS) CYCLE - DO J=JLO_CELL-1,JHI_CELL+1 - IF (YCO < YFACE(J-1)-GEOMEPS .OR. YCO > YFACE(J)+GEOMEPS) CYCLE - DO K=KLO_CELL-1,KHI_CELL+1 - IF (ZCO < ZFACE(K-1)-GEOMEPS .OR. ZCO > ZFACE(K)+GEOMEPS) CYCLE - IF (I > ILO_CELL-1 .AND. I < IHI_CELL+1 .AND. & - J > JLO_CELL-1 .AND. J < JHI_CELL+1 .AND. & - K > KLO_CELL-1 .AND. K < KHI_CELL+1) CYCLE - IND_FOUND = .TRUE. - EXIT - ENDDO - IF (IND_FOUND) EXIT - ENDDO - IF (IND_FOUND) EXIT -ENDDO -IF (.NOT.IND_FOUND) RETURN +REAL(EB) :: XMAP,YMAP,ZMAP +LOGICAL :: FINE_AT_REFI,CELL_CHANGED + +IF(XCO < M2%XS .OR. XCO > M2%XF .OR. YCO < M2%YS .OR. YCO > M2%YF .OR. ZCO < M2%ZS .OR. ZCO > M2%ZF) RETURN +FINE_AT_REFI = (I2==1 .OR. I2==M2%IBAR .OR. J2==1 .OR. J2==M2%JBAR .OR. K2==1 .OR. K2==M2%KBAR) +IF (.NOT.FINE_AT_REFI) THEN + IF(XCO > M2%X(1) .AND. XCO < M2%X(M2%IBAR-1) .AND. & + YCO > M2%Y(1) .AND. YCO < M2%Y(M2%JBAR-1) .AND. & + ZCO > M2%Z(1) .AND. ZCO < M2%Z(M2%KBAR-1)) RETURN +ENDIF +IF (FINE_AT_REFI) THEN + XMAP = M2%XC(I2); YMAP = M2%YC(J2); ZMAP = M2%ZC(K2) +ELSE + XMAP = XCO; YMAP = YCO; ZMAP = ZCO +ENDIF -! Tag the coarse ghost-cell in NM that contains the blocked fine cell. +! Find I,J,K in NM where blocked fine cell maps (ghost band only). +I = MINLOC(ABS(XCELL(ILO_CELL-1:IHI_CELL+1)-XMAP),DIM=1) + ILO_CELL - 2 +J = MINLOC(ABS(YCELL(JLO_CELL-1:JHI_CELL+1)-YMAP),DIM=1) + JLO_CELL - 2 +K = MINLOC(ABS(ZCELL(KLO_CELL-1:KHI_CELL+1)-ZMAP),DIM=1) + KLO_CELL - 2 +IF (XMAP < XFACE(I-1)-GEOMEPS .OR. XMAP > XFACE(I)+GEOMEPS .OR. & + YMAP < YFACE(J-1)-GEOMEPS .OR. YMAP > YFACE(J)+GEOMEPS .OR. & + ZMAP < ZFACE(K-1)-GEOMEPS .OR. ZMAP > ZFACE(K)+GEOMEPS) RETURN +IF (I>ILO_CELL-1 .AND. IJLO_CELL-1 .AND. JKLO_CELL-1 .AND. K 0) THEN DO JCC = 1, M%CUT_CELL(ICC)%NCELL - IF (M%CUT_CELL(ICC)%NOADVANCE(JCC) == NOT_BLOCKED) & + IF (M%CUT_CELL(ICC)%NOADVANCE(JCC) == NOT_BLOCKED) THEN M%CUT_CELL(ICC)%NOADVANCE(JCC) = BLOCK_TAG + IF (IBOD_DONOR>0 .AND. ITRI_DONOR>0) M%CUT_CELL(ICC)%BODTRI_DONOR(1:2,JCC) = (/IBOD_DONOR,ITRI_DONOR/) + FM_PENDING_BLOCK_SCAN(NM) = .TRUE. + ENDIF ENDDO +ELSEIF (M%CCVAR(I,J,K,CC_CGSC)==CC_GASPHASE) THEN + CALL TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT(NM,I,J,K,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR,CELL_CHANGED) + IF (CELL_CHANGED) FM_PENDING_BLOCK_SCAN(NM) = .TRUE. ENDIF END SUBROUTINE CC_GRID_TAG_COARSE_CELL_FROM_NEIGHBOR_BLOCK -SUBROUTINE CC_GRID_TAG_NEIGHBOR_BLOCK_BY_CENTROID(M,XCO,YCO,ZCO,REMOTE_JCC,BLOCK_TAG) +SUBROUTINE CC_GRID_TAG_NEIGHBOR_BLOCK_BY_CENTROID(M,XCO,YCO,ZCO,REMOTE_JCC,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR) TYPE(MESH_TYPE), POINTER :: M REAL(EB), INTENT(IN) :: XCO,YCO,ZCO -INTEGER, INTENT(IN) :: REMOTE_JCC,BLOCK_TAG +INTEGER, INTENT(IN) :: REMOTE_JCC,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR INTEGER :: I,J,K,ICC -LOGICAL :: IND_FOUND -IND_FOUND = .FALSE. -DO I=ILO_CELL-1,IHI_CELL+1 - IF (ABS(XCO-XCELL(I))=GEOMEPS .OR. ABS(YCO-YCELL(J))>=GEOMEPS .OR. & + ABS(ZCO-ZCELL(K))>=GEOMEPS) RETURN ! Here we have found the I,J,K indices of the blocked cut-cell: ICC=M%CCVAR(I,J,K,CC_IDCC) -IF(ICC>0) M%CUT_CELL(ICC)%NOADVANCE(REMOTE_JCC) = BLOCK_TAG +IF (ICC>0) THEN + IF (REMOTE_JCC>0) THEN + IF (REMOTE_JCC<=M%CUT_CELL(ICC)%NCELL) THEN + M%CUT_CELL(ICC)%NOADVANCE(REMOTE_JCC) = BLOCK_TAG + IF (IBOD_DONOR>0 .AND. ITRI_DONOR>0) & + M%CUT_CELL(ICC)%BODTRI_DONOR(1:2,REMOTE_JCC) = (/IBOD_DONOR,ITRI_DONOR/) + ENDIF + ENDIF +ENDIF END SUBROUTINE CC_GRID_TAG_NEIGHBOR_BLOCK_BY_CENTROID -SUBROUTINE CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL(M,M2,NOM,ICELL,VOL_NM) +SUBROUTINE CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL(NM,M,M2,NOM,ICELL,VOL_NM) USE TRAN, ONLY: GET_IJK +INTEGER, INTENT(IN) :: NM TYPE(MESH_TYPE), POINTER :: M,M2 INTEGER, INTENT(IN) :: NOM,ICELL REAL(EB), INTENT(IN) :: VOL_NM -INTEGER :: I2,J2,K2,BLOCK_TAG,REMOTE_JCC +INTEGER :: I2,J2,K2,BLOCK_TAG,REMOTE_JCC,IBOD_DONOR,ITRI_DONOR REAL(EB) :: XCO,YCO,ZCO,VOL_NOM,X1,Y1,Z1 XCO = M2%XYZ_CC_BLOCKED(IAXIS,ICELL) @@ -12320,21 +12890,27 @@ SUBROUTINE CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL(M,M2,NOM,ICELL,VOL_NM) ZCO = M2%XYZ_CC_BLOCKED(KAXIS,ICELL) REMOTE_JCC = M2%JBT_CC_BLOCKED(1,ICELL) BLOCK_TAG = M2%JBT_CC_BLOCKED(2,ICELL) +IBOD_DONOR = M2%JBT_CC_BLOCKED(3,ICELL) +ITRI_DONOR = M2%JBT_CC_BLOCKED(4,ICELL) CALL GET_IJK(XCO,YCO,ZCO,NOM,X1,Y1,Z1,I2,J2,K2) +IF (I2<1 .OR. I2>M2%IBAR .OR. J2<1 .OR. J2>M2%JBAR .OR. K2<1 .OR. K2>M2%KBAR) RETURN VOL_NOM = M2%DX(I2)*M2%DY(J2)*M2%DZ(K2) IF (VOL_NM > 1.5_EB * VOL_NOM) THEN ! NM is COARSE, NOM is FINE - CALL CC_GRID_TAG_COARSE_CELL_FROM_NEIGHBOR_BLOCK(M,M2,XCO,YCO,ZCO,BLOCK_TAG) + CALL CC_GRID_TAG_COARSE_CELL_FROM_NEIGHBOR_BLOCK(NM,M,M2,I2,J2,K2,XCO,YCO,ZCO,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR) +ELSEIF (VOL_NOM > 1.5_EB * VOL_NM) THEN ! NM is FINE, NOM is COARSE + CALL TAG_FINE_CELLS_IN_COARSE_CELL_VOLUME(NOM,I2,J2,K2,NM,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR) ELSE ! Same refinement level (or refinement handled by EXT_WALL_LOOP) - use centroid matching - CALL CC_GRID_TAG_NEIGHBOR_BLOCK_BY_CENTROID(M,XCO,YCO,ZCO,REMOTE_JCC,BLOCK_TAG) + CALL CC_GRID_TAG_NEIGHBOR_BLOCK_BY_CENTROID(M,XCO,YCO,ZCO,REMOTE_JCC,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR) ENDIF END SUBROUTINE CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL -SUBROUTINE CC_GRID_ADD_BLOCKED_CELLS_FROM_NEIGHBOR_MESH(M,M2,NOM,VOL_NM) +SUBROUTINE CC_GRID_ADD_BLOCKED_CELLS_FROM_NEIGHBOR_MESH(NM,M,M2,NOM,VOL_NM) +INTEGER, INTENT(IN) :: NM TYPE(MESH_TYPE), POINTER :: M,M2 INTEGER, INTENT(IN) :: NOM REAL(EB), INTENT(IN) :: VOL_NM @@ -12342,7 +12918,7 @@ SUBROUTINE CC_GRID_ADD_BLOCKED_CELLS_FROM_NEIGHBOR_MESH(M,M2,NOM,VOL_NM) INTEGER :: ICELL DO ICELL=1,M2%N_CC_BLOCKED - CALL CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL(M,M2,NOM,ICELL,VOL_NM) + CALL CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL(NM,M,M2,NOM,ICELL,VOL_NM) ENDDO END SUBROUTINE CC_GRID_ADD_BLOCKED_CELLS_FROM_NEIGHBOR_MESH @@ -12369,7 +12945,7 @@ SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,K NEIGHBORING_MESHES_DO : DO NM2=1,M%N_NEIGHBORING_MESHES NOM = M%NEIGHBORING_MESH(NM2); IF (NOM==NM) CYCLE M2 => MESHES(NOM) - CALL CC_GRID_ADD_BLOCKED_CELLS_FROM_NEIGHBOR_MESH(M,M2,NOM,VOL_NM) + CALL CC_GRID_ADD_BLOCKED_CELLS_FROM_NEIGHBOR_MESH(NM,M,M2,NOM,VOL_NM) ENDDO NEIGHBORING_MESHES_DO CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) ENDDO MESH_LOOP @@ -12782,7 +13358,7 @@ SUBROUTINE CC_GRID_TAG_BLOCK_FINE_CELL_CASE(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1) INTEGER, INTENT(IN) :: NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1 -INTEGER :: ICC,ICC2,INITIAL_NOADVANCE +INTEGER :: ICC,ICC2,JCC_LOC,IBOD_LOC,ITRI_LOC TYPE(MESH_TYPE), POINTER :: M,M2 M =>MESHES( NM) @@ -12791,19 +13367,22 @@ SUBROUTINE CC_GRID_TAG_BLOCK_FINE_CELL_CASE(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1) ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC) ICC = 0 IF ( ICC2 > 0 .OR. M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN ! There are cut-cells in omesh cartesian cell. + CALL GET_REFINEMENT_CELL_DONOR(NOM,IIO1,JJO1,KKO1,IBOD_LOC,ITRI_LOC) IF(M%CCVAR(II1,JJ1,KK1,CC_CGSC)==CC_GASPHASE) THEN - INITIAL_NOADVANCE = NOT_BLOCKED - IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) INITIAL_NOADVANCE = BLOCKED_REFI_INTER - CALL CC_GRID_INSERT_SINGLE_CARTESIAN_CUTCELL(NM,II1,JJ1,KK1,INITIAL_NOADVANCE,ICC) - M => MESHES(NM) + ! Skip rank-asymmetric cut-cell insertion (owner-only); keep CC_GASPHASE on all ranks. + ! The gasphase footprint is closed later via TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT. + ICC = 0 ELSEIF(M%CCVAR(II1,JJ1,KK1,CC_IDCC)>0) THEN ICC = M%CCVAR(II1,JJ1,KK1,CC_IDCC) ENDIF ! Here test if cut-cells in II,JJ,KK are blocked or not in IIO,JJO,KKO: IF(ICC>0) THEN IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_SOLID) THEN - WHERE(M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL)==NOT_BLOCKED) & - M%CUT_CELL(ICC)%NOADVANCE(1:M%CUT_CELL(ICC)%NCELL) = BLOCKED_REFI_INTER + DO JCC_LOC=1,M%CUT_CELL(ICC)%NCELL + IF(M%CUT_CELL(ICC)%NOADVANCE(JCC_LOC)/=NOT_BLOCKED) CYCLE + M%CUT_CELL(ICC)%NOADVANCE(JCC_LOC) = BLOCKED_REFI_INTER + CALL SET_REFINEMENT_CUTCELL_DONOR(NM,ICC,JCC_LOC,IBOD_LOC,ITRI_LOC) + ENDDO ELSE CALL TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) ENDIF @@ -12819,6 +13398,8 @@ SUBROUTINE CC_GRID_TAG_BLOCK_COARSE_CELL_CASE(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1) INTEGER :: ICC,ICC2 TYPE(MESH_TYPE), POINTER :: M,M2 +IF (PROCESS(NOM)/=MY_RANK) RETURN + M =>MESHES( NM) M2=>MESHES(NOM) @@ -12827,8 +13408,8 @@ SUBROUTINE CC_GRID_TAG_BLOCK_COARSE_CELL_CASE(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1) IF(ICC>0) THEN ! Set IIO1,JJO1,KKO1 fine cells next to this EWC for blocking. IF(M2%CCVAR(IIO1,JJO1,KKO1,CC_CGSC)==CC_GASPHASE) THEN - CALL CC_GRID_INSERT_SINGLE_CARTESIAN_CUTCELL(NOM,IIO1,JJO1,KKO1,NOT_BLOCKED,ICC2) - M2 => MESHES(NOM) + ! Skip rank-asymmetric cut-cell insertion (owner-only); keep CC_GASPHASE on all ranks of NOM. + ICC2 = 0 ELSEIF(M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC)>0) THEN ICC2 = M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCC) ENDIF @@ -12861,7 +13442,7 @@ SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) INTEGER :: I,J,K,IFC,IFACE INTEGER :: JCC,FC_FOUND,FC_TYPE,INBFC,INBFC_LOC,VERT_CUTFACE,NVERT,X1AXIS,X2AXIS,X3AXIS,NCROSS,DIRRAY,IFC1,JFC1,& - NVERT2,VERT_CUTFACE2,IV,IFCC,IFACE2,IFC2,JFC2 + NVERT2,VERT_CUTFACE2,IV,IFCC,IFACE2,IFC2,JFC2,IBOD_DONOR,ITRI_DONOR TYPE(MESH_TYPE), POINTER :: M,M2 TYPE(CC_CUTCELL_TYPE), POINTER :: CC,CC2 TYPE(CC_CUTFACE_TYPE), POINTER :: CF2 @@ -12878,6 +13459,7 @@ SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) M =>MESHES( NM) M2=>MESHES(NOM) +CALL GET_REFINEMENT_CELL_DONOR(NOM,IIO1,JJO1,KKO1,IBOD_DONOR,ITRI_DONOR) INBFC=M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCF); IF(INBFC<1) RETURN ! No CC_INBOUNDARY faces in this cartesian cell. @@ -13120,7 +13702,10 @@ SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) ! ENDIF ENDDO INBFC_LOC_LOOP ! Here set no ADVANCE if BLOCK_CELL=T: - IF(BLOCK_CELL .AND. CC%NOADVANCE(JCC)==NOT_BLOCKED) CC%NOADVANCE(JCC) = BLOCKED_REFI_INTER + IF(BLOCK_CELL .AND. CC%NOADVANCE(JCC)==NOT_BLOCKED) THEN + CC%NOADVANCE(JCC) = BLOCKED_REFI_INTER + CALL SET_REFINEMENT_CUTCELL_DONOR(NM,ICC,JCC,IBOD_DONOR,ITRI_DONOR) + ENDIF ENDDO JCC_LOOP ! IF(NM==1 .AND. ICC<30) CLOSE(LU_CCELL) @@ -13416,10 +14001,22 @@ END SUBROUTINE GET_CC_FACE_CELL_LIST_INFO SUBROUTINE CC_GRID_RELEASE_BLOCKED_CELL_LISTS(NM) INTEGER, INTENT(IN) :: NM +INTEGER :: ICC MESHES(NM)%N_CC_BLOCKED = 0 +MESHES(NM)%N_CC_ELIMINATED = 0 IF(ALLOCATED(MESHES(NM)%XYZ_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%XYZ_CC_BLOCKED) IF(ALLOCATED(MESHES(NM)%JBT_CC_BLOCKED)) DEALLOCATE(MESHES(NM)%JBT_CC_BLOCKED) +IF(ALLOCATED(MESHES(NM)%XYZ_CC_ELIMINATED)) DEALLOCATE(MESHES(NM)%XYZ_CC_ELIMINATED) +IF(ALLOCATED(MESHES(NM)%JBT_CC_ELIMINATED)) DEALLOCATE(MESHES(NM)%JBT_CC_ELIMINATED) +! BODTRI_DONOR is consumed only during the setup blocking / refinement-interface passes +! above. Free it here so it doesn't sit allocated for the lifetime of the run. +IF (ALLOCATED(MESHES(NM)%CUT_CELL)) THEN + DO ICC=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH + IF (ALLOCATED(MESHES(NM)%CUT_CELL(ICC)%BODTRI_DONOR)) & + DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%BODTRI_DONOR) + ENDDO +ENDIF END SUBROUTINE CC_GRID_RELEASE_BLOCKED_CELL_LISTS @@ -23010,14 +23607,14 @@ SUBROUTINE GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) CYCLE ENDIF enddo - IF (.NOT.INLIST) THEN + IF (.NOT.INLIST .AND. SEG_CELL(6,ISEG)>0 .AND. SEG_CELL(4,ISEG)>0) THEN ! Add first triang to list: NBODTRI = NBODTRI + 1 BOD_TRI(1:2,NBODTRI) = SEG_CELL( (/ 6, 4 /) , ISEG) ENDIF ! No second triangle associated: - IF ( SEG_CELL(3,ISEG) < 2 ) CYCLE + IF ( SEG_CELL(3,ISEG) < 2 .OR. SEG_CELL(6,ISEG)<1 .OR. SEG_CELL(5,ISEG)<1 ) CYCLE ! Second triangle location INLIST = .FALSE. @@ -24219,7 +24816,7 @@ SUBROUTINE EAR_CLIP_CFACES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,XYZVERT,& ENDIF IF(.NOT.FOUND_ISEG1) CYCLE - TRI = 0 + TRI = 0; BOD = 0 ! Test if triangle given by ISEG ISEG+1 DIAG is valid. ! First, drop if Body not the same: IF ( (COUNTEXT<3) .AND. (SEG_CELL2(6,ISEG)/=SEG_CELL2(6,ISEG1)) ) CYCLE @@ -24253,7 +24850,7 @@ SUBROUTINE EAR_CLIP_CFACES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,XYZVERT,& ENDIF ENDIF - IF ( TRI == 0 ) THEN + IF ( BOD<1 .OR. TRI<1 ) THEN CYCLE ELSE ! Found two segments with matching triangle. From dc01618e0b0371f9de86d53132f83414f439ca51 Mon Sep 17 00:00:00 2001 From: Jason Floyd Date: Wed, 17 Jun 2026 08:20:46 -0400 Subject: [PATCH 13/18] FDS Source: fix PATH OBSCURATION XB order bug Issue #16338 --- Source/read.f90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/Source/read.f90 b/Source/read.f90 index d8480394842..969e5f35d9f 100644 --- a/Source/read.f90 +++ b/Source/read.f90 @@ -13903,11 +13903,14 @@ SUBROUTINE READ_DEVC OVERLAPPING_Y = .TRUE. OVERLAPPING_Z = .TRUE. IF (XB(1)==XB(2) .AND. (XB(1)> M%XF .OR. XB(2)< M%XS)) OVERLAPPING_X = .FALSE. - IF (XB(1)/=XB(2) .AND. (MIN(XB(2),M%XF)-MAX(XB(1),M%XS) M%YF .OR. XB(4)< M%YS)) OVERLAPPING_Y = .FALSE. - IF (XB(3)/=XB(4) .AND. (MIN(XB(4),M%YF)-MAX(XB(3),M%YS) M%ZF .OR. XB(6)< M%ZS)) OVERLAPPING_Z = .FALSE. - IF (XB(5)/=XB(6) .AND. (MIN(XB(6),M%ZF)-MAX(XB(5),M%ZS) Date: Sun, 21 Jun 2026 10:39:27 -0400 Subject: [PATCH 14/18] FDS Validation: Remove . from RGB --- .../Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_1.fds | 2 +- .../FDS_Input_Files/BITTERN_10.fds | 2 +- .../FDS_Input_Files/BITTERN_12.fds | 2 +- .../FDS_Input_Files/BITTERN_13.fds | 2 +- .../FDS_Input_Files/BITTERN_14.fds | 2 +- .../FDS_Input_Files/BITTERN_15.fds | 2 +- .../FDS_Input_Files/BITTERN_16.fds | 2 +- .../FDS_Input_Files/BITTERN_17.fds | 2 +- .../FDS_Input_Files/BITTERN_18.fds | 2 +- .../FDS_Input_Files/BITTERN_19.fds | 2 +- .../Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_2.fds | 2 +- .../FDS_Input_Files/BITTERN_20.fds | 2 +- .../FDS_Input_Files/BITTERN_21.fds | 2 +- .../FDS_Input_Files/BITTERN_22.fds | 2 +- .../Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_3.fds | 2 +- .../Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_4.fds | 2 +- .../Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_5.fds | 2 +- .../Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_6.fds | 2 +- .../Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_7.fds | 2 +- .../Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_8.fds | 2 +- .../Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_9.fds | 2 +- 21 files changed, 21 insertions(+), 21 deletions(-) diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_1.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_1.fds index 75b87667942..7ff9dbd9f9c 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_1.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_1.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_10.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_10.fds index 14cc2bb39c0..c19c0c7bc3e 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_10.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_10.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_12.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_12.fds index af2e41b183a..c3a6a75b930 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_12.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_12.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_13.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_13.fds index c98fd1c0418..27439aa2fc3 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_13.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_13.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_14.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_14.fds index 97fa7e39c0f..9f5de603b9c 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_14.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_14.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_15.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_15.fds index 878de465277..7ba506a3365 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_15.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_15.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_16.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_16.fds index a234dd4a859..2324def2394 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_16.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_16.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_17.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_17.fds index b09aa6b939a..df46f0109f9 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_17.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_17.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_18.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_18.fds index 2647820c123..4b89aabce33 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_18.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_18.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_19.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_19.fds index 9b4345431ee..4e98f214c89 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_19.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_19.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_2.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_2.fds index 162aaf1d8cb..b5d1334800f 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_2.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_2.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_20.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_20.fds index 13d124f78a8..3ceb865b076 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_20.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_20.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_21.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_21.fds index 4380343f212..6664427f9ce 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_21.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_21.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_22.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_22.fds index 64cb0f1d07a..b80bc7cee34 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_22.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_22.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_3.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_3.fds index c366bdab0a0..56e4c61dbb5 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_3.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_3.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_4.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_4.fds index 3c1fe35fc30..659afed551c 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_4.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_4.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_5.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_5.fds index daef99fa2cc..7c2b5aaa89d 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_5.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_5.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_6.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_6.fds index 3b5c3d533c7..c034125bf7b 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_6.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_6.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_7.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_7.fds index 820896ff2b3..5b79e3018d7 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_7.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_7.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_8.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_8.fds index 093fb00e959..5292a07fb49 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_8.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_8.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ diff --git a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_9.fds b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_9.fds index 7c9ed91bbfc..0ddd286d80f 100644 --- a/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_9.fds +++ b/Validation/Bittern_Sprinkler_Experiments/FDS_Input_Files/BITTERN_9.fds @@ -71,7 +71,7 @@ Materials and surfaces EMISSIVITY=0.5/ &SURF ID='GYPSUM BOARD', DEFAULT=.TRUE. - RGB=242.0,237.0,237.0, + RGB=242,237,237, MATL_ID='GYPSUM BOARD', THICKNESS=0.01/ From 8b22b78a41a67e41082da62ffaeb78d42c6f7521 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Mon, 22 Jun 2026 04:42:22 +0000 Subject: [PATCH 15/18] Bump actions/checkout from 6 to 7 Bumps [actions/checkout](https://github.com/actions/checkout) from 6 to 7. - [Release notes](https://github.com/actions/checkout/releases) - [Changelog](https://github.com/actions/checkout/blob/main/CHANGELOG.md) - [Commits](https://github.com/actions/checkout/compare/v6...v7) --- updated-dependencies: - dependency-name: actions/checkout dependency-version: '7' dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] --- .github/workflows/Line_Endings.yml | 2 +- .github/workflows/cmake.yml | 6 +++--- .github/workflows/linux.yml | 6 +++--- .github/workflows/osx.yml | 2 +- .github/workflows/windows.yml | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/.github/workflows/Line_Endings.yml b/.github/workflows/Line_Endings.yml index 294115df591..727191e5b1b 100644 --- a/.github/workflows/Line_Endings.yml +++ b/.github/workflows/Line_Endings.yml @@ -21,7 +21,7 @@ jobs: # Steps represent a sequence of tasks that will be executed as part of the job steps: # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it - - uses: actions/checkout@v6 + - uses: actions/checkout@v7 - name: Check for CRLF line endings run: | diff --git a/.github/workflows/cmake.yml b/.github/workflows/cmake.yml index 5696fc33e15..c23be942b29 100644 --- a/.github/workflows/cmake.yml +++ b/.github/workflows/cmake.yml @@ -91,7 +91,7 @@ jobs: sudo apt-get -y update sudo apt-get -y install libopenmpi-dev openmpi-bin - - uses: actions/checkout@v6 + - uses: actions/checkout@v7 - run: git config --global --add safe.directory /__w/fds/fds - name: set linux-gnu compiler @@ -165,7 +165,7 @@ jobs: runs-on: ${{ matrix.os }} steps: - name: Checkout code - uses: actions/checkout@v6 + uses: actions/checkout@v7 - name: install openmpi run: brew install gcc@15 open-mpi @@ -243,7 +243,7 @@ jobs: shell: cmd steps: - - uses: actions/checkout@v6 + - uses: actions/checkout@v7 # install oneapi components from web installer based on # oneapi-ci/scripts/install_windows.bat diff --git a/.github/workflows/linux.yml b/.github/workflows/linux.yml index 7d329f936f5..f182d46d44b 100644 --- a/.github/workflows/linux.yml +++ b/.github/workflows/linux.yml @@ -39,7 +39,7 @@ jobs: mkl@2026.0.0 prune: false - - uses: actions/checkout@v6 + - uses: actions/checkout@v7 - name: build fds debug run: | @@ -74,7 +74,7 @@ jobs: mkl@2025.1.0 prune: false - - uses: actions/checkout@v6 + - uses: actions/checkout@v7 - name: build fds debug run: | source /opt/intel/oneapi/setvars.sh @@ -96,7 +96,7 @@ jobs: runs-on: [ubuntu-latest] steps: - - uses: actions/checkout@v6 + - uses: actions/checkout@v7 - uses: actions/setup-python@v6 with: diff --git a/.github/workflows/osx.yml b/.github/workflows/osx.yml index ddb1fe2778b..b5c8c036d22 100644 --- a/.github/workflows/osx.yml +++ b/.github/workflows/osx.yml @@ -34,7 +34,7 @@ jobs: shell: bash steps: - - uses: actions/checkout@v6 + - uses: actions/checkout@v7 - name: install openmpi run: | brew install gcc@15 open-mpi diff --git a/.github/workflows/windows.yml b/.github/workflows/windows.yml index 7af7908dab0..0e7a8a4f3f9 100644 --- a/.github/workflows/windows.yml +++ b/.github/workflows/windows.yml @@ -42,7 +42,7 @@ jobs: shell: cmd steps: - - uses: actions/checkout@v6 + - uses: actions/checkout@v7 # install oneapi components from web installer based on # oneapi-ci/scripts/install_windows.bat From b66f4064cfac75f514cd262c3710894abe5e149a Mon Sep 17 00:00:00 2001 From: rmcdermo Date: Tue, 23 Jun 2026 15:02:20 -0400 Subject: [PATCH 16/18] FDS Source: subtract SOLID from AREA calc with SPATIAL_STATISTIC=AREA --- Source/dump.f90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/Source/dump.f90 b/Source/dump.f90 index aaf68620c7e..01ef4bc2a43 100644 --- a/Source/dump.f90 +++ b/Source/dump.f90 @@ -6825,14 +6825,17 @@ SUBROUTINE UPDATE_DEVICES_1(T,DT,NM) CASE('AREA INTEGRAL','AREA') IF (DV%SPATIAL_STATISTIC=='AREA') VALUE=1._EB IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) THEN + AREA = 0._EB IF (CFACE_AREA>TWENTY_EPSILON_EB) THEN AREA = CFACE_AREA ELSE - SELECT CASE (ABS(DV%IOR_ASSUMED)) - CASE(1); AREA=RC(I)*DY(J)*DZ(K) - CASE(2); AREA=DX(I)*DZ(K) - CASE(3); AREA=DX(I)*RC(I)*DY(J) - END SELECT + IF (.NOT.CELL(CELL_INDEX(I,J,K))%SOLID) THEN + SELECT CASE (ABS(DV%IOR_ASSUMED)) + CASE(1); AREA=RC(I)*DY(J)*DZ(K) + CASE(2); AREA=DX(I)*DZ(K) + CASE(3); AREA=DX(I)*RC(I)*DY(J) + END SELECT + ENDIF ENDIF SDV%VALUE_1 = SDV%VALUE_1 + AREA*VALUE ENDIF From dd433f8688f7855d2b1ead16d8de81b28a91fb89 Mon Sep 17 00:00:00 2001 From: marcosvanella Date: Tue, 23 Jun 2026 17:14:31 -0400 Subject: [PATCH 17/18] FDS Source: add cross-mesh back-CFACE BCs and thickness-based backing discard. --- Source/ccib.f90 | 224 +++++++++++++++++++++++++++++++++++++++++++++++- Source/geom.f90 | 193 +++++++++++++++++++++++------------------ Source/main.f90 | 7 +- Source/type.f90 | 6 ++ Source/wall.f90 | 12 +-- 5 files changed, 348 insertions(+), 94 deletions(-) diff --git a/Source/ccib.f90 b/Source/ccib.f90 index 070235de865..3be7e5fe131 100644 --- a/Source/ccib.f90 +++ b/Source/ccib.f90 @@ -24,13 +24,15 @@ MODULE CC_SCALARS INT_RHO0_IND,INT_WCEN_IND,INT_VELS_IND,MAX_INTERP_POINTS,NQT2C,N_CUTCELLS_PROC,N_INB_CUTFACES_PROC, & N_INT_CVARS,N_INT_CCVARS,N_REG_CUTFACES_PROC,N_LINK_ATTMP_F,GLOBAL_DELTA_CELL,GLOBAL_DELTA_EDGE, & GLOBAL_DELTA_FACE,SET_CUTCELLS_3D,BLOCK_CC_SOLID_EXTWALLCELLS,INIT_CFACE_CELL,GET_REGULAR_CUT_EDGES_BC, & - GET_SOLID_CUTCELL_EDGES_BC + GET_SOLID_CUTCELL_EDGES_BC,GET_BACK_CFACE_INDEX USE PRECISION_PARAMETERS USE GLOBAL_CONSTANTS USE MESH_POINTERS USE MESH_VARIABLES, ONLY: MESHES, MESH_TYPE USE COMP_FUNCTIONS, ONLY: CURRENT_TIME, GET_FILE_NUMBER USE MATH_FUNCTIONS, ONLY: GET_SCALAR_FACE_VALUE +USE MEMORY_FUNCTIONS, ONLY: ALLOCATE_STORAGE +USE GEOMETRY_FUNCTIONS, ONLY: SEARCH_OTHER_MESHES IMPLICIT NONE (TYPE,EXTERNAL) PRIVATE @@ -135,10 +137,225 @@ MODULE CC_SCALARS FINISH_CC, INIT_CUTCELL_DATA,MESH_CC_EXCHANGE,NUMBER_UNKH_CUTCELLS,& ROTATED_CUBE_ANN_SOLN,ROTATED_CUBE_VELOCITY_FLUX,ROTATED_CUBE_RHS_ZZ,& SET_EXIMADVFLX_3D,SET_EXIMDIFFLX_3D,SET_EXIMRHOHSLIM_3D,& - SET_EXIMRHOZZLIM_3D,UNSTRUCTURED_POISSON_RESIDUAL,UNSTRUCTURED_POISSON_RESIDUAL_RC + SET_EXIMRHOZZLIM_3D,UNSTRUCTURED_POISSON_RESIDUAL,UNSTRUCTURED_POISSON_RESIDUAL_RC,& + INITIALIZE_BACK_CFACE_EXCHANGE,EXCHANGE_BACK_CFACE_DATA + +! Persistent layout for the per-step cross-mesh BACK CFACE gas-side data exchange (see INITIALIZE_BACK_CFACE_EXCHANGE +! and EXCHANGE_BACK_CFACE_DATA). N_CF_BACK_SEND/RECV are the per-process query totals on the requester/owner side. +LOGICAL, SAVE :: CF_BACK_EXCHANGE_ACTIVE=.FALSE. +INTEGER, SAVE :: N_CF_BACK_SEND=0,N_CF_BACK_RECV=0 +INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: CF_BACK_SEND_CNT3,CF_BACK_SDISPL3,CF_BACK_RECV_CNT3,CF_BACK_RDISPL3 +INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: CF_BACK_SEND_NOM,CF_BACK_MAP_IDX !< Requester side: owner mesh and back CFACE index per query +INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: CF_BACK_RECV_NOM,CF_BACK_RECV_IDX !< Owner side: owner mesh and resolved local CFACE index per query CONTAINS +! ------------------------ INITIALIZE_BACK_CFACE_EXCHANGE --------------------------- +SUBROUTINE INITIALIZE_BACK_CFACE_EXCHANGE + +INTEGER :: NM,NOM,IQ,NQ,IIO,JJO,KKO,NOM2,ICFACE,SURF_B,FRONT,OD_INDEX,N_RESOLVED,N_GLOBAL,IP,K,P,TOTAL_SEND,TOTAL_RECV,IERR +REAL(EB) :: POS(3) +INTEGER, ALLOCATABLE :: SEND_CNT(:),RECV_CNT(:),SDISPL(:),RDISPL(:),CNT3_S(:),CNT3_R(:),DSP3_S(:),DSP3_R(:),COUNTER(:) +INTEGER, ALLOCATABLE :: SEND_NOM(:),RECV_NOM(:),REPLY_IDX(:),REPLY_SURF(:),REPLY_DIM(:), & + REPLY_BACK(:),REPLY_BSURF(:),REPLY_BDIM(:),MAP_NM(:),MAP_FRONT(:) +REAL(EB), ALLOCATABLE :: SEND_POS(:),RECV_POS(:) + +N_RESOLVED = 0 +ALLOCATE(SEND_CNT(0:N_MPI_PROCESSES-1)) ; SEND_CNT = 0 +DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + DO NOM=1,NMESHES + IF (NOM==NM) CYCLE + NQ = MESHES(NM)%OMESH(NOM)%N_CFACE_QUERY + IF (NQ==0) CYCLE + IF (PROCESS(NOM)==MY_RANK) THEN ! Owner is on this process: resolve directly. + DO IQ=1,NQ + POS(1:3) = MESHES(NM)%OMESH(NOM)%CFACE_QUERY_XYZ(IAXIS:KAXIS,IQ) + CALL SEARCH_OTHER_MESHES(POS(1),POS(2),POS(3),NOM2,IIO,JJO,KKO) + IF (NOM2/=NOM) CYCLE + ICFACE = GET_BACK_CFACE_INDEX(NOM,IIO,JJO,KKO,POS,-1,-1) + IF (ICFACE>0) THEN + FRONT = MESHES(NM)%OMESH(NOM)%CFACE_QUERY_FRONT(IQ) + OD_INDEX = MESHES(NM)%CFACE(FRONT)%OD_INDEX + IF (OD_INDEX>0) THEN + MESHES(NM)%BOUNDARY_ONE_D(OD_INDEX)%BACK_MESH = NOM + MESHES(NM)%BOUNDARY_ONE_D(OD_INDEX)%BACK_INDEX = ICFACE + MESHES(NM)%BOUNDARY_ONE_D(OD_INDEX)%BACK_SURF = MESHES(NOM)%CFACE(ICFACE)%SURF_INDEX + N_RESOLVED = N_RESOLVED + 1 + ENDIF + ENDIF + ENDDO + ELSE ! Owner on another process: count for the all-to-all exchange below. + SEND_CNT(PROCESS(NOM)) = SEND_CNT(PROCESS(NOM)) + NQ + ENDIF + ENDDO +ENDDO + +CROSS_PROCESS_IF: IF (N_MPI_PROCESSES>1) THEN + + ALLOCATE(RECV_CNT(0:N_MPI_PROCESSES-1)) ; RECV_CNT = 0 + CALL MPI_ALLTOALL(SEND_CNT,1,MPI_INTEGER,RECV_CNT,1,MPI_INTEGER,MPI_COMM_WORLD,IERR) + + ALLOCATE(SDISPL(0:N_MPI_PROCESSES-1),RDISPL(0:N_MPI_PROCESSES-1)) + ALLOCATE(CNT3_S(0:N_MPI_PROCESSES-1),CNT3_R(0:N_MPI_PROCESSES-1)) + ALLOCATE(DSP3_S(0:N_MPI_PROCESSES-1),DSP3_R(0:N_MPI_PROCESSES-1)) + SDISPL(0) = 0 ; RDISPL(0) = 0 + DO IP=1,N_MPI_PROCESSES-1 + SDISPL(IP) = SDISPL(IP-1) + SEND_CNT(IP-1) + RDISPL(IP) = RDISPL(IP-1) + RECV_CNT(IP-1) + ENDDO + TOTAL_SEND = SDISPL(N_MPI_PROCESSES-1) + SEND_CNT(N_MPI_PROCESSES-1) + TOTAL_RECV = RDISPL(N_MPI_PROCESSES-1) + RECV_CNT(N_MPI_PROCESSES-1) + CNT3_S = 3*SEND_CNT ; CNT3_R = 3*RECV_CNT ; DSP3_S = 3*SDISPL ; DSP3_R = 3*RDISPL + ALLOCATE(SEND_NOM(MAX(TOTAL_SEND,1)),SEND_POS(MAX(3*TOTAL_SEND,1)),MAP_NM(MAX(TOTAL_SEND,1)), & + MAP_FRONT(MAX(TOTAL_SEND,1)),REPLY_BACK(MAX(TOTAL_SEND,1)),REPLY_BSURF(MAX(TOTAL_SEND,1)), & + REPLY_BDIM(MAX(TOTAL_SEND,1))) + ALLOCATE(RECV_NOM(MAX(TOTAL_RECV,1)),RECV_POS(MAX(3*TOTAL_RECV,1)),REPLY_IDX(MAX(TOTAL_RECV,1)), & + REPLY_SURF(MAX(TOTAL_RECV,1)),REPLY_DIM(MAX(TOTAL_RECV,1))) + ALLOCATE(COUNTER(0:N_MPI_PROCESSES-1)) ; COUNTER = SDISPL + + ! Pack cross-process queries grouped by destination process (matching the SDISPL ordering). MAP_NM and + ! MAP_FRONT record the local front CFACE associated with each query so the reply can be applied in order. + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + DO NOM=1,NMESHES + IF (NOM==NM) CYCLE + IF (PROCESS(NOM)==MY_RANK) CYCLE + NQ = MESHES(NM)%OMESH(NOM)%N_CFACE_QUERY + IF (NQ==0) CYCLE + IP = PROCESS(NOM) + DO IQ=1,NQ + P = COUNTER(IP) + 1 ; COUNTER(IP) = P + SEND_NOM(P) = NOM + SEND_POS(3*P-2:3*P) = MESHES(NM)%OMESH(NOM)%CFACE_QUERY_XYZ(IAXIS:KAXIS,IQ) + MAP_NM(P) = NM + MAP_FRONT(P) = MESHES(NM)%OMESH(NOM)%CFACE_QUERY_FRONT(IQ) + ENDDO + ENDDO + ENDDO + CALL MPI_ALLTOALLV(SEND_NOM,SEND_CNT,SDISPL,MPI_INTEGER,RECV_NOM,RECV_CNT,RDISPL,MPI_INTEGER,MPI_COMM_WORLD,IERR) + CALL MPI_ALLTOALLV(SEND_POS,CNT3_S,DSP3_S,MPI_DOUBLE_PRECISION,RECV_POS,CNT3_R,DSP3_R,MPI_DOUBLE_PRECISION,& + MPI_COMM_WORLD,IERR) + + ! Owner side: resolve each received query against its local cut-face data. + DO K=1,TOTAL_RECV + NOM = RECV_NOM(K) + POS(1:3) = RECV_POS(3*K-2:3*K) + CALL SEARCH_OTHER_MESHES(POS(1),POS(2),POS(3),NOM2,IIO,JJO,KKO) + ICFACE = 0 ; SURF_B = 0 + IF (NOM2==NOM) ICFACE = GET_BACK_CFACE_INDEX(NOM,IIO,JJO,KKO,POS,-1,-1) + IF (ICFACE>0) SURF_B = MESHES(NOM)%CFACE(ICFACE)%SURF_INDEX + REPLY_IDX(K) = ICFACE + REPLY_SURF(K) = SURF_B + REPLY_DIM(K) = 0 ; IF (ICFACE>0) REPLY_DIM(K) = MESHES(NOM)%N_CFACE_CELLS_DIM + ENDDO + + ! Reverse all-to-all: return the resolved BACK CFACE index, SURF_INDEX and owner CFACE dimension to requesters. + CALL MPI_ALLTOALLV(REPLY_IDX, RECV_CNT,RDISPL,MPI_INTEGER,REPLY_BACK, SEND_CNT,SDISPL,MPI_INTEGER,MPI_COMM_WORLD,IERR) + CALL MPI_ALLTOALLV(REPLY_SURF,RECV_CNT,RDISPL,MPI_INTEGER,REPLY_BSURF,SEND_CNT,SDISPL,MPI_INTEGER,MPI_COMM_WORLD,IERR) + CALL MPI_ALLTOALLV(REPLY_DIM, RECV_CNT,RDISPL,MPI_INTEGER,REPLY_BDIM, SEND_CNT,SDISPL,MPI_INTEGER,MPI_COMM_WORLD,IERR) + + ! Requester side: store BACK_MESH / BACK_INDEX / BACK_SURF and allocate a ghost CFACE (with its boundary + ! storage) in MESHES(NOM) so the per-step exchange can deposit the back gas-side state and the solid heat + ! transfer solver can read it exactly as it reads a same-mesh back CFACE. + DO P=1,TOTAL_SEND + ICFACE = REPLY_BACK(P) + IF (ICFACE>0) THEN + NM = MAP_NM(P) + FRONT = MAP_FRONT(P) + NOM = SEND_NOM(P) + SURF_B = REPLY_BSURF(P) + OD_INDEX = MESHES(NM)%CFACE(FRONT)%OD_INDEX + IF (OD_INDEX>0) THEN + MESHES(NM)%BOUNDARY_ONE_D(OD_INDEX)%BACK_MESH = NOM + MESHES(NM)%BOUNDARY_ONE_D(OD_INDEX)%BACK_INDEX = ICFACE + MESHES(NM)%BOUNDARY_ONE_D(OD_INDEX)%BACK_SURF = SURF_B + N_RESOLVED = N_RESOLVED + 1 + ! Allocate the ghost CFACE once per (NOM,ICFACE). + IF (.NOT.ALLOCATED(MESHES(NOM)%CFACE)) THEN + MESHES(NOM)%N_CFACE_CELLS_DIM = REPLY_BDIM(P) + ALLOCATE(MESHES(NOM)%CFACE(0:MESHES(NOM)%N_CFACE_CELLS_DIM)) + ENDIF + IF (ICFACE>UBOUND(MESHES(NOM)%CFACE,1)) THEN + CALL ALLOCATE_STORAGE(NOM,CFACE_INDEX=ICFACE,SURF_INDEX=SURF_B) + ELSEIF (MESHES(NOM)%CFACE(ICFACE)%B1_INDEX<=0) THEN + CALL ALLOCATE_STORAGE(NOM,CFACE_INDEX=ICFACE,SURF_INDEX=SURF_B) + ENDIF + ENDIF + ENDIF + ENDDO + + ! Define exchange layout so EXCHANGE_BACK_CFACE_DATA can move the back gas-side state every step. + N_CF_BACK_SEND = TOTAL_SEND + N_CF_BACK_RECV = TOTAL_RECV + ALLOCATE(CF_BACK_SEND_CNT3(0:N_MPI_PROCESSES-1),CF_BACK_SDISPL3(0:N_MPI_PROCESSES-1)) + ALLOCATE(CF_BACK_RECV_CNT3(0:N_MPI_PROCESSES-1),CF_BACK_RDISPL3(0:N_MPI_PROCESSES-1)) + CF_BACK_SEND_CNT3 = CNT3_S ; CF_BACK_SDISPL3 = DSP3_S + CF_BACK_RECV_CNT3 = CNT3_R ; CF_BACK_RDISPL3 = DSP3_R + ALLOCATE(CF_BACK_SEND_NOM(MAX(TOTAL_SEND,1)),CF_BACK_MAP_IDX(MAX(TOTAL_SEND,1))) + ALLOCATE(CF_BACK_RECV_NOM(MAX(TOTAL_RECV,1)),CF_BACK_RECV_IDX(MAX(TOTAL_RECV,1))) + IF (TOTAL_SEND>0) THEN + CF_BACK_SEND_NOM(1:TOTAL_SEND) = SEND_NOM(1:TOTAL_SEND) + CF_BACK_MAP_IDX(1:TOTAL_SEND) = REPLY_BACK(1:TOTAL_SEND) + ENDIF + IF (TOTAL_RECV>0) THEN + CF_BACK_RECV_NOM(1:TOTAL_RECV) = RECV_NOM(1:TOTAL_RECV) + CF_BACK_RECV_IDX(1:TOTAL_RECV) = REPLY_IDX(1:TOTAL_RECV) + ENDIF + N_GLOBAL = TOTAL_SEND + CALL MPI_ALLREDUCE(MPI_IN_PLACE,N_GLOBAL,1,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) + IF (N_GLOBAL>0) CF_BACK_EXCHANGE_ACTIVE = .TRUE. + + DEALLOCATE(RECV_CNT,SDISPL,RDISPL,CNT3_S,CNT3_R,DSP3_S,DSP3_R,COUNTER,SEND_NOM,SEND_POS,MAP_NM,MAP_FRONT, & + REPLY_BACK,REPLY_BSURF,REPLY_BDIM,RECV_NOM,RECV_POS,REPLY_IDX,REPLY_SURF,REPLY_DIM) + +ENDIF CROSS_PROCESS_IF +DEALLOCATE(SEND_CNT) + +!IF (N_RESOLVED>0) & +! WRITE(LU_ERR,'(A,I0,A,I0)') ' BACK CFACE exchange: process ',MY_RANK,' resolved cross-mesh back CFACEs: ',N_RESOLVED + +END SUBROUTINE INITIALIZE_BACK_CFACE_EXCHANGE + + +! ------------------------ EXCHANGE_BACK_CFACE_DATA -------------------------------- +SUBROUTINE EXCHANGE_BACK_CFACE_DATA + +INTEGER :: K,P,NOM,ICFACE,B1,IERR +REAL(EB), ALLOCATABLE :: SBUF(:),RBUF(:) + +IF (.NOT.CF_BACK_EXCHANGE_ACTIVE .OR. N_MPI_PROCESSES==1) RETURN +ALLOCATE(SBUF(MAX(3*N_CF_BACK_RECV,1))) ; SBUF = 0._EB +ALLOCATE(RBUF(MAX(3*N_CF_BACK_SEND,1))) ; RBUF = 0._EB + +! Owner side: pack the back gas-side state of each resolved CFACE. +DO K=1,N_CF_BACK_RECV + ICFACE = CF_BACK_RECV_IDX(K) + IF (ICFACE<=0) CYCLE + NOM = CF_BACK_RECV_NOM(K) + B1 = MESHES(NOM)%CFACE(ICFACE)%B1_INDEX + IF (B1<=0) CYCLE + SBUF(3*K-2) = MESHES(NOM)%BOUNDARY_PROP1(B1)%TMP_G + SBUF(3*K-1) = MESHES(NOM)%BOUNDARY_PROP1(B1)%HEAT_TRANS_COEF + SBUF(3*K ) = MESHES(NOM)%BOUNDARY_PROP1(B1)%Q_RAD_IN +ENDDO +CALL MPI_ALLTOALLV(SBUF,CF_BACK_RECV_CNT3,CF_BACK_RDISPL3,MPI_DOUBLE_PRECISION, & + RBUF,CF_BACK_SEND_CNT3,CF_BACK_SDISPL3,MPI_DOUBLE_PRECISION,MPI_COMM_WORLD,IERR) + +! Requester side: deposit the received state into the ghost CFACE so the solver reads it like a same-mesh back CFACE. +DO P=1,N_CF_BACK_SEND + ICFACE = CF_BACK_MAP_IDX(P) + IF (ICFACE<=0) CYCLE + NOM = CF_BACK_SEND_NOM(P) + B1 = MESHES(NOM)%CFACE(ICFACE)%B1_INDEX + IF (B1<=0) CYCLE + MESHES(NOM)%BOUNDARY_PROP1(B1)%TMP_G = RBUF(3*P-2) + MESHES(NOM)%BOUNDARY_PROP1(B1)%HEAT_TRANS_COEF = RBUF(3*P-1) + MESHES(NOM)%BOUNDARY_PROP1(B1)%Q_RAD_IN = RBUF(3*P) +ENDDO +DEALLOCATE(SBUF,RBUF) + +END SUBROUTINE EXCHANGE_BACK_CFACE_DATA + + ! ------------------------ COPY_UNST_DM_TO_CART ------------------------------------- SUBROUTINE COPY_UNST_DM_TO_CART(NM) @@ -3736,6 +3953,9 @@ SUBROUTINE MESH_CC_EXCHANGE(CODE) INTEGER :: EP,INPE,INT_NPE_LO,INT_NPE_HI,VIND,ICELL,IEDGE,IFEP REAL(EB) :: TNOW,TINTP +! On the end-of-step (CODE=6) exchange, move the gas-side state of cross-mesh BACK CFACEs. +IF (CODE==6) CALL EXCHANGE_BACK_CFACE_DATA + ! For solid phase only return. All variables exchanged currently here are gas-phase. IF (SOLID_PHASE_ONLY) RETURN ! In case of initialization code from main return. diff --git a/Source/geom.f90 b/Source/geom.f90 index 1b6d046d429..6330570ed14 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -5478,7 +5478,8 @@ MODULE COMPLEX_GEOMETRY_GRID INTEGER, PARAMETER :: BLOCKED_SPECIAL_CELL=6 PUBLIC :: GET_CFACE_INDEX, POINT_IN_CFACE, RANDOM_CFACE_XYZ, SET_CUTCELLS_3D, SET_CVS_3D, & - BLOCK_CC_SOLID_EXTWALLCELLS, INIT_CFACE_CELL, GET_REGULAR_CUT_EDGES_BC, GET_SOLID_CUTCELL_EDGES_BC + BLOCK_CC_SOLID_EXTWALLCELLS, INIT_CFACE_CELL, GET_REGULAR_CUT_EDGES_BC, GET_SOLID_CUTCELL_EDGES_BC, & + GET_BACK_CFACE_INDEX PUBLIC :: DELTA_INT, DELTA_VERT, DIST_THRES, FDS_AREA_GEOM, INDEX_UNDEFINED, INT_N_EXT_PTS, INT_P_IND, & INT_TMP_IND, INT_VEL_IND, INT_RHO_IND, INT_H_IND, INT_RSUM_IND, INT_MU_IND, INT_MUDNS_IND, & INT_RHO0_IND, INT_WCEN_IND, INT_VELS_IND, MAX_INTERP_POINTS, NQT2C, N_CUTCELLS_PROC, & @@ -6479,10 +6480,9 @@ SUBROUTINE INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX,SURF_INDEX,STAGE_FLG,IS_INB, TYPE(BOUNDARY_PROP1_TYPE), POINTER :: B1,WC_B1 INTEGER :: IBOD, IWSEL, ICC, JCC -INTEGER :: IG, TRI, WSELEM(NOD1:NOD3), NOM, IIO, JJO, KKO, IIV(3), JJV(3), KKV(3), ICF2, JCF2, JCF22, ICF3, JCF3, & - II, JJ, KK, III, JJJ, KKK, ICFACE, ICFF, IOR, X1AXIS -REAL(EB):: XP(IAXIS:KAXIS),RDIR(IAXIS:KAXIS),V1(IAXIS:KAXIS),V2(IAXIS:KAXIS),V3(IAXIS:KAXIS),POS(IAXIS:KAXIS),DIST,DIST2 -LOGICAL :: IS_INTERSECT=.FALSE., BACK_CFACE_FOUND=.FALSE. +INTEGER :: IG, TRI, WSELEM(NOD1:NOD3), NOM, IIO, JJO, KKO, ICFACE, IOR, X1AXIS +REAL(EB):: XP(IAXIS:KAXIS),RDIR(IAXIS:KAXIS),V1(IAXIS:KAXIS),V2(IAXIS:KAXIS),V3(IAXIS:KAXIS),POS(IAXIS:KAXIS) +LOGICAL :: IS_INTERSECT=.FALSE. TYPE (SURFACE_TYPE), POINTER :: SF TYPE (WALL_TYPE), POINTER :: WC TYPE (MESH_TYPE), POINTER :: M @@ -6617,97 +6617,31 @@ SUBROUTINE INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX,SURF_INDEX,STAGE_FLG,IS_INB, IF (IS_INTERSECT) THEN - ! Check that distance is less than cell diagonal size: + ! Check that the distance in excess of the SURF THICKNESS is less than the cell diagonal size: ! For longer distances from CFACE to BACK CFACE BC is 'VOID'. - IF(NORM2(XP-POS) > SQRT(DX(BC%IIG)**2 + DY(BC%JJG)**2 + DZ(BC%KKG)**2)) RETURN + IF(NORM2(XP-POS) - SF%THICKNESS > SQRT(DX(BC%IIG)**2 + DY(BC%JJG)**2 + DZ(BC%KKG)**2)) RETURN ! We Found an intersection with IWSEL in position POS(IAXIS:KAXIS): ! Find indexes and mesh of cell containing intersection point: CALL SEARCH_OTHER_MESHES(POS(IAXIS),POS(JAXIS),POS(KAXIS),NOM,IIO,JJO,KKO) - ! This test and restriction of NOM==NM is temporary. Discard when parallel CFACE info is in place. + ! Intersection point lies outside of the computational domain: treat backing as VOID. + IF (NOM==0) RETURN + + ! If the back CFACE lies in a different mesh than the front CFACE, defer to INITIALIZE_BACK_CFACE_EXCHANGE. IF (NOM/=NM) THEN - IF(NOM==0) RETURN - WRITE(LU_ERR,*) 'WARNING: BACK CFACE search, other mesh NOM not equal to working mesh NM. NM=',NM,& - ', NOM and other cell IIO,JJO,KKO=',NOM,IIO,JJO,KKO,', intersection pt=',POS(IAXIS:KAXIS) + IF (CFA%OD_INDEX>0) CALL ADD_BACK_CFACE_QUERY(NM,NOM,CFACE_INDEX,POS) RETURN ENDIF - IF (NOM>0) THEN - IF (ALLOCATED(MESHES(NOM)%CCVAR)) THEN - IIV(1:3) = (/ IIO, MAX(IIO-1,1), MIN(IIO+1,MESHES(NOM)%IBAR) /) - JJV(1:3) = (/ JJO, MAX(JJO-1,1), MIN(JJO+1,MESHES(NOM)%JBAR) /) - KKV(1:3) = (/ KKO, MAX(KKO-1,1), MIN(KKO+1,MESHES(NOM)%KBAR) /) - - DIST= 1._EB/TWENTY_EPSILON_EB; ICFF=0; JCF2=0 - K_LOOP : DO KKK=1,3 - KK=KKV(KKK) - DO JJJ=1,3 - JJ=JJV(JJJ) - DO III=1,3 - II=IIV(III) - ICF2 = MESHES(NOM)%CCVAR(II,JJ,KK,CC_IDCF) - ICF2_COND : IF (ICF2>0) THEN - - ! Use cut-face with closest centroid to POS: - DO JCF22=1,MESHES(NOM)%CUT_FACE(ICF2)%NFACE - IF(ICF==ICF2 .AND. IFACE==JCF22) CYCLE - DIST2 = (POS(IAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(IAXIS,JCF22))**2._EB + & - (POS(JAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(JAXIS,JCF22))**2._EB + & - (POS(KAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(KAXIS,JCF22))**2._EB - IF (DIST20 .AND. CFA%OD_INDEX>0) THEN - M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_MESH = NOM - M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_INDEX = ICFACE - ENDIF - - ! Write error for testing: - ELSE - WRITE(LU_ERR,*) 'WARNING: BACK CFACE search, MESH, CFACE_INDEX=',NM,CFACE_INDEX,& - ', back CFACE not found in mesh NOM,IIO,JJO,KKO=',NOM,IIO,JJO,KKO - RETURN - ENDIF - ELSE ! Intersection in mesh furher away than neighboring meshes. - ! To Do stop. - - ENDIF - - ELSE ! Intersection outside of domain. - ! To Do stop. - + ! Back CFACE is in the same (local) mesh: resolve its index now, excluding the front CFACE itself. + ICFACE = GET_BACK_CFACE_INDEX(NM,IIO,JJO,KKO,POS,ICF,IFACE) + IF (ICFACE>0 .AND. CFA%OD_INDEX>0) THEN + M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_MESH = NM + M%BOUNDARY_ONE_D(CFA%OD_INDEX)%BACK_INDEX = ICFACE ENDIF - ELSE ! Did not find intersection with other triangles. - ! To Do : Here we can add a test to check if CFACE is indeed within geometry IG. Geometry intersection and - ! linearization lead need to CFACES lay outside of the geometry. - WRITE(LU_ERR,*) 'WARNING: BACK CFACE search did NOT Find Intersection. MESH=',NM,', GEOM=',IG,& - ', CFACE_INDEX, Centroid location=',CFACE_INDEX,XP(:) + ELSE ! Did not find intersection with other triangles. Leave VOID BC. RETURN ENDIF @@ -6796,6 +6730,95 @@ SUBROUTINE INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX,SURF_INDEX,STAGE_FLG,IS_INB, END SUBROUTINE INIT_CFACE_CELL +! ----------------------- ADD_BACK_CFACE_QUERY ----------------------------- +SUBROUTINE ADD_BACK_CFACE_QUERY(NM,NOM,FRONT_CFACE,POS) + +INTEGER, INTENT(IN) :: NM,NOM,FRONT_CFACE +REAL(EB), INTENT(IN) :: POS(IAXIS:KAXIS) +INTEGER :: N,NDIM +REAL(EB), ALLOCATABLE :: XYZ_DUMMY(:,:) +INTEGER, ALLOCATABLE :: FRONT_DUMMY(:) + +ASSOCIATE(M3=>MESHES(NM)%OMESH(NOM)) +IF (.NOT.ALLOCATED(M3%CFACE_QUERY_XYZ)) THEN + M3%N_CFACE_QUERY_DIM = 64 + ALLOCATE(M3%CFACE_QUERY_XYZ(IAXIS:KAXIS,M3%N_CFACE_QUERY_DIM)) + ALLOCATE(M3%CFACE_QUERY_FRONT(M3%N_CFACE_QUERY_DIM)) + M3%N_CFACE_QUERY = 0 +ENDIF +IF (M3%N_CFACE_QUERY+1 > M3%N_CFACE_QUERY_DIM) THEN ! Grow the query arrays. + NDIM = M3%N_CFACE_QUERY_DIM + ALLOCATE(XYZ_DUMMY(IAXIS:KAXIS,NDIM)) ; XYZ_DUMMY = M3%CFACE_QUERY_XYZ(IAXIS:KAXIS,1:NDIM) + ALLOCATE(FRONT_DUMMY(NDIM)) ; FRONT_DUMMY = M3%CFACE_QUERY_FRONT(1:NDIM) + DEALLOCATE(M3%CFACE_QUERY_XYZ,M3%CFACE_QUERY_FRONT) + M3%N_CFACE_QUERY_DIM = 2*NDIM + ALLOCATE(M3%CFACE_QUERY_XYZ(IAXIS:KAXIS,M3%N_CFACE_QUERY_DIM)) + ALLOCATE(M3%CFACE_QUERY_FRONT(M3%N_CFACE_QUERY_DIM)) + M3%CFACE_QUERY_XYZ(IAXIS:KAXIS,1:NDIM) = XYZ_DUMMY + M3%CFACE_QUERY_FRONT(1:NDIM) = FRONT_DUMMY + DEALLOCATE(XYZ_DUMMY,FRONT_DUMMY) +ENDIF +N = M3%N_CFACE_QUERY + 1 +M3%N_CFACE_QUERY = N +M3%CFACE_QUERY_XYZ(IAXIS:KAXIS,N) = POS(IAXIS:KAXIS) +M3%CFACE_QUERY_FRONT(N) = FRONT_CFACE +END ASSOCIATE + +END SUBROUTINE ADD_BACK_CFACE_QUERY + +! ----------------------- GET_BACK_CFACE_INDEX ----------------------------- +INTEGER FUNCTION GET_BACK_CFACE_INDEX(NOM,IIO,JJO,KKO,POS,ICF_EXCLUDE,IFACE_EXCLUDE) + +INTEGER, INTENT(IN) :: NOM,IIO,JJO,KKO,ICF_EXCLUDE,IFACE_EXCLUDE +REAL(EB), INTENT(IN) :: POS(IAXIS:KAXIS) +INTEGER :: IIV(3),JJV(3),KKV(3),III,JJJ,KKK,II,JJ,KK,ICF2,JCF22,ICFF,JCFF,ICF3,JCF3 +REAL(EB) :: DIST,DIST2 +LOGICAL :: BACK_CFACE_FOUND + +GET_BACK_CFACE_INDEX = 0 +IF (NOM<1) RETURN +IF (.NOT.ALLOCATED(MESHES(NOM)%CCVAR)) RETURN + +IIV(1:3) = (/ IIO, MAX(IIO-1,1), MIN(IIO+1,MESHES(NOM)%IBAR) /) +JJV(1:3) = (/ JJO, MAX(JJO-1,1), MIN(JJO+1,MESHES(NOM)%JBAR) /) +KKV(1:3) = (/ KKO, MAX(KKO-1,1), MIN(KKO+1,MESHES(NOM)%KBAR) /) +DIST = 1._EB/TWENTY_EPSILON_EB; ICFF=0; JCFF=0; BACK_CFACE_FOUND=.FALSE. +DO KKK=1,3 + KK=KKV(KKK) + DO JJJ=1,3 + JJ=JJV(JJJ) + DO III=1,3 + II=IIV(III) + ICF2 = MESHES(NOM)%CCVAR(II,JJ,KK,CC_IDCF) + IF (ICF2>0) THEN + ! Use cut-face with closest centroid to POS: + DO JCF22=1,MESHES(NOM)%CUT_FACE(ICF2)%NFACE + IF (ICF_EXCLUDE==ICF2 .AND. IFACE_EXCLUDE==JCF22) CYCLE + DIST2 = (POS(IAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(IAXIS,JCF22))**2._EB + & + (POS(JAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(JAXIS,JCF22))**2._EB + & + (POS(KAXIS) - MESHES(NOM)%CUT_FACE(ICF2)%XYZCEN(KAXIS,JCF22))**2._EB + IF (DIST20 .AND. BACK_MESH==NM) THEN - CFA_BACK => CFACE(BACK_INDEX) - B1_BACK => BOUNDARY_PROP1(CFA_BACK%B1_INDEX) - B2_BACK => BOUNDARY_PROP2(CFA_BACK%B2_INDEX) - BC_BACK => BOUNDARY_COORD(CFA_BACK%BC_INDEX) + IF (BACK_INDEX>0) THEN + CFA_BACK => MESHES(BACK_MESH)%CFACE(BACK_INDEX) + B1_BACK => MESHES(BACK_MESH)%BOUNDARY_PROP1(CFA_BACK%B1_INDEX) + B2_BACK => MESHES(BACK_MESH)%BOUNDARY_PROP2(CFA_BACK%B2_INDEX) + BC_BACK => MESHES(BACK_MESH)%BOUNDARY_COORD(CFA_BACK%BC_INDEX) SF_BACK => SURFACE(CFA_BACK%SURF_INDEX) ENDIF BACKING = SF%BACKING - IF (ONE_D%BACK_INDEX==0 .AND. SF%BACKING==EXPOSED) BACKING = VOID + IF (SF%BACKING==EXPOSED .AND. ONE_D%BACK_INDEX==0) BACKING = VOID ELSEIF (PRESENT(PARTICLE_INDEX)) THEN UNPACK_WALL_PARTICLE From 2257dc78778248aef1c8df582d9ae0664b6a64db Mon Sep 17 00:00:00 2001 From: mcgratta Date: Wed, 24 Jun 2026 13:35:07 -0400 Subject: [PATCH 18/18] FDS Source: Fix bugs related to restarting HT3D --- Source/dump.f90 | 10 +++------- Source/main.f90 | 26 ++++++++++++++++++++------ 2 files changed, 23 insertions(+), 13 deletions(-) diff --git a/Source/dump.f90 b/Source/dump.f90 index 01ef4bc2a43..e84995288ed 100644 --- a/Source/dump.f90 +++ b/Source/dump.f90 @@ -3634,8 +3634,6 @@ SUBROUTINE DUMP_RESTART(T,DT,NM) ENDDO WRITE(LU_CORE(NM)) N_BOUNDARY_COORD_DIM,N_BOUNDARY_ONE_D_DIM,N_BOUNDARY_PROP1_DIM,N_BOUNDARY_PROP2_DIM,N_BOUNDARY_RADIA_DIM -WRITE(LU_CORE(NM)) NEXT_AVAILABLE_BOUNDARY_COORD_SLOT,NEXT_AVAILABLE_BOUNDARY_ONE_D_SLOT,& - NEXT_AVAILABLE_BOUNDARY_PROP1_SLOT,NEXT_AVAILABLE_BOUNDARY_PROP2_SLOT,NEXT_AVAILABLE_BOUNDARY_RADIA_SLOT WRITE(LU_CORE(NM)) N_WALL_CELLS,N_WALL_CELLS_DIM OS => WALL_STORAGE @@ -3643,7 +3641,7 @@ SUBROUTINE DUMP_RESTART(T,DT,NM) WC => WALL(IW) RC=0 ; IC=0 ; LC=0 CALL PACK_WALL(NM,OS,WC,WC%SURF_INDEX,RC,IC,LC,UNPACK_IT=.FALSE.,COUNT_ONLY=.FALSE.,CHECK_BOUNDS=.FALSE.) - WRITE(LU_CORE(NM)) WC%SURF_INDEX + WRITE(LU_CORE(NM)) WC%SURF_INDEX,WC%TD_INDEX WRITE(LU_CORE(NM)) OS%REALS,OS%INTEGERS,OS%LOGICALS ENDDO @@ -3831,8 +3829,6 @@ SUBROUTINE READ_RESTART(T,DT,NM) ENDDO READ(LU_RESTART(NM)) N_BOUNDARY_COORD_DIM,N_BOUNDARY_ONE_D_DIM,N_BOUNDARY_PROP1_DIM,N_BOUNDARY_PROP2_DIM,N_BOUNDARY_RADIA_DIM -READ(LU_RESTART(NM)) NEXT_AVAILABLE_BOUNDARY_COORD_SLOT,NEXT_AVAILABLE_BOUNDARY_ONE_D_SLOT,& - NEXT_AVAILABLE_BOUNDARY_PROP1_SLOT,NEXT_AVAILABLE_BOUNDARY_PROP2_SLOT,NEXT_AVAILABLE_BOUNDARY_RADIA_SLOT IF (ALLOCATED(MESHES(NM)%BOUNDARY_COORD_OCCUPANCY)) DEALLOCATE(MESHES(NM)%BOUNDARY_COORD_OCCUPANCY) IF (ALLOCATED(MESHES(NM)%BOUNDARY_ONE_D_OCCUPANCY)) DEALLOCATE(MESHES(NM)%BOUNDARY_ONE_D_OCCUPANCY) @@ -3865,11 +3861,11 @@ SUBROUTINE READ_RESTART(T,DT,NM) IF (ALLOCATED(MESHES(NM)%WALL)) DEALLOCATE(MESHES(NM)%WALL) ; ALLOCATE(MESHES(NM)%WALL(0:N_WALL_CELLS_DIM)) OS => WALL_STORAGE DO IW=1,N_WALL_CELLS - READ(LU_RESTART(NM)) SURF_INDEX + WC => MESHES(NM)%WALL(IW) + READ(LU_RESTART(NM)) SURF_INDEX,WC%TD_INDEX READ(LU_RESTART(NM)) OS%REALS,OS%INTEGERS,OS%LOGICALS RC=0 ; IC=0 ; LC=0 CALL ALLOCATE_STORAGE(NM,SURF_INDEX=SURF_INDEX,WALL_INDEX=IW) - WC => MESHES(NM)%WALL(IW) CALL PACK_WALL(NM,OS,WC,SURF_INDEX,RC,IC,LC,UNPACK_IT=.TRUE.,COUNT_ONLY=.FALSE.,CHECK_BOUNDS=.TRUE.) ENDDO diff --git a/Source/main.f90 b/Source/main.f90 index 33c7a62a55f..0abf9b4029c 100644 --- a/Source/main.f90 +++ b/Source/main.f90 @@ -51,7 +51,7 @@ PROGRAM FDS ! Miscellaneous declarations -LOGICAL :: EX=.FALSE.,DIAGNOSTICS,CTRL_STOP_STATUS,CHECK_FREEZE_VELOCITY=.TRUE.,EXTERNAL_FAIL +LOGICAL :: EX=.FALSE.,DIAGNOSTICS,CTRL_STOP_STATUS,CHECK_FREEZE_VELOCITY=.TRUE.,EXTERNAL_FAIL,FIRST_RESTART_TIME_STEP INTEGER :: LO10,NM,IZERO,ANG_INC_COUNTER REAL(EB) :: T,DT,TNOW REAL :: CPUTIME @@ -553,18 +553,28 @@ PROGRAM FDS INITIALIZATION_PHASE = .FALSE. +! If the simulation is restarted, there are some tasks to do during the first time step of the restarted simulation + +IF (RESTART) THEN + FIRST_RESTART_TIME_STEP = .TRUE. +ELSE + FIRST_RESTART_TIME_STEP = .FALSE. +ENDIF + +! Special feature allowing the user to delay the gas phase CFD simulation until a specified UNFREEZE_TIME + IF (UNFREEZE_TIME > 0._EB) THEN FREEZE_VELOCITY=.TRUE. SOLID_PHASE_ONLY=.TRUE. LOCK_TIME_STEP=.TRUE. ENDIF -IF (MY_RANK==0 .AND. VERBOSE) CALL VERBOSE_PRINTOUT('Starting the time-stepping') - !*********************************************************************************************************************************** ! MAIN TIMESTEPPING LOOP !*********************************************************************************************************************************** +IF (MY_RANK==0 .AND. VERBOSE) CALL VERBOSE_PRINTOUT('Starting the time-stepping') + MAIN_LOOP: DO ICYC = ICYC + 1 ! Time step iterations @@ -591,11 +601,13 @@ PROGRAM FDS IF ((T+DT+DT_END_FILL)>T_END) DT = MAX(T_END-T+TWENTY_EPSILON_EB,DT_END_MINIMUM) - ! Determine when to dump out diagnostics to the .out file + ! Determine if diagnostics should be dumped to the .out file at the end of this time step LO10 = INT(LOG10(REAL(MAX(1,ABS(ICYC)),EB))) IF (MOD(ICYC,10**LO10)==0 .OR. MOD(ICYC,DIAGNOSTICS_INTERVAL)==0 .OR. (T+DT)>=T_END) DIAGNOSTICS = .TRUE. + ! Determine if a delayed gas phase simulation should be started + IF ((UNFREEZE_TIME > 0._EB).AND.(T>UNFREEZE_TIME)) THEN FREEZE_VELOCITY=.FALSE. SOLID_PHASE_ONLY=.FALSE. @@ -1038,6 +1050,8 @@ PROGRAM FDS IF (T>=T_END .AND. ICYC>0) EXIT MAIN_LOOP + FIRST_RESTART_TIME_STEP = .FALSE. + ENDDO MAIN_LOOP !*********************************************************************************************************************************** @@ -3598,7 +3612,7 @@ SUBROUTINE MESH_EXCHANGE(CODE) IW = OS%ITEM_INDEX(I) WC => MESHES(NOM)%WALL(IW) CALL PACK_WALL(NOM,OS,WC,OS%SURF_INDEX(I),RC,IC,LC,UNPACK_IT=.TRUE.,COUNT_ONLY=.FALSE.,& - CHECK_BOUNDS=INITIALIZATION_PHASE) + CHECK_BOUNDS=(INITIALIZATION_PHASE.OR.FIRST_RESTART_TIME_STEP)) ENDDO ENDIF RECEIVE_BACK_WALL @@ -3609,7 +3623,7 @@ SUBROUTINE MESH_EXCHANGE(CODE) IW = OS%ITEM_INDEX(I) TW => MESHES(NOM)%THIN_WALL(IW) CALL PACK_THIN_WALL(NOM,OS,TW,OS%SURF_INDEX(I),RC,IC,LC,UNPACK_IT=.TRUE.,COUNT_ONLY=.FALSE.,& - CHECK_BOUNDS=INITIALIZATION_PHASE) + CHECK_BOUNDS=(INITIALIZATION_PHASE.OR.FIRST_RESTART_TIME_STEP)) ENDDO ENDIF RECEIVE_BACK_THIN_WALL