diff --git a/.github/workflows/Line_Endings.yml b/.github/workflows/Line_Endings.yml index 294115df59..727191e5b1 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 5696fc33e1..c23be942b2 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 7d329f936f..f182d46d44 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 ddb1fe2778..b5c8c036d2 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 7af7908dab..0e7a8a4f3f 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 diff --git a/Source/ccib.f90 b/Source/ccib.f90 index bfcbf07b5c..c53d1289ff 100644 --- a/Source/ccib.f90 +++ b/Source/ccib.f90 @@ -6,13 +6,33 @@ ! MODULE CC_SCALARS -USE COMPLEX_GEOMETRY +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,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 @@ -117,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) @@ -3722,6 +3957,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/dump.f90 b/Source/dump.f90 index 1e510caace..f3ac181f39 100644 --- a/Source/dump.f90 +++ b/Source/dump.f90 @@ -3909,8 +3909,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 @@ -3918,7 +3916,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 @@ -4106,8 +4104,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) @@ -4140,11 +4136,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 @@ -7995,14 +7991,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 diff --git a/Source/geom.f90 b/Source/geom.f90 index ca152e91c1..ba248ace61 100644 --- a/Source/geom.f90 +++ b/Source/geom.f90 @@ -19,19 +19,10 @@ MODULE COMPLEX_GEOMETRY IMPLICIT NONE (TYPE,EXTERNAL) PRIVATE - CHARACTER(2*MESSAGE_LENGTH) :: MESSAGE !! --------------------------------------------------------------------------------- -! 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: +! 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 @@ -39,12 +30,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 = 2.5E-3_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. @@ -57,6 +42,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. @@ -120,113 +108,19 @@ 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. -! 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 -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 @@ -267,236 +161,38 @@ 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,GET_CFACE_INDEX,GETU,& - INTERSECT_CONE_AABB,INTERSECT_CYLINDER_AABB,INTERSECT_OBB_AABB,INTERSECT_SPHERE_AABB, & - IN_SPHERE_PT,IN_CYLINDER_PT,IN_CONE_PT,IN_OBB_PT, & - 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 :: GEOFCT,CALL_FOR_GLMAT,CALL_FROM_GLMAT_SETUP,CCGUARD,CC_MATVEC_DEFINED, & + 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,IN_SPHERE_PT,IN_CYLINDER_PT,IN_CONE_PT,IN_OBB_PT, & + 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, & + 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,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,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_GCELL_CUT,CC_GCELL_REG 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) -! -! ! 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 --------------------------------------------- @@ -661,8140 +357,5475 @@ SUBROUTINE POINT_IN_POLYGON(PT,CFELEM_SIZE,CFELEM,NVERT,IAXLOC,JAXLOC,XYZVERT,IN END SUBROUTINE POINT_IN_POLYGON -! --------------------------- POINT_IN_CFACE ------------------------------------ +! -------------------------- TEST_PT_INPOLY ------------------------------------- -SUBROUTINE POINT_IN_CFACE(NM,XP,YP,ZP,CFACE_INDEX,IN_CFACE) +SUBROUTINE TEST_PT_INPOLY(NP,XY,XY1,PTSFLAG) -REAL(EB), INTENT(IN) :: XP,YP,ZP -INTEGER, INTENT(IN) :: NM,CFACE_INDEX -LOGICAL, INTENT(OUT) :: IN_CFACE +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 -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 +! Local Variables: +INTEGER :: RCROSS, LCROSS, IP +REAL(EB):: XPT +LOGICAL :: RS, LS -INBFC = CFACE(CFACE_INDEX)%CUT_FACE_IND1 -INBFC_LOC = CFACE(CFACE_INDEX)%CUT_FACE_IND2 +PTSFLAG = .FALSE. +RCROSS = 0 +LCROSS = 0 -! 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) - -! 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) +! ADD first point location at the end of XY (assumes CC_MAXVERTS_FACE > NP): +XY(IAXIS:JAXIS,NP+1) = XY(IAXIS:JAXIS,1) -! 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 /) ) +! Shift origin to XY1: +DO IP=1,NP+1 + XY(IAXIS:JAXIS,IP) = XY(IAXIS:JAXIS,IP) - XY1(IAXIS:JAXIS) +ENDDO -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) +! 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) -! 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) + 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)) -DEALLOCATE(CFELEM) + IF (RS .AND. (XPT > 0._EB)) RCROSS = RCROSS + 1 + IF (LS .AND. (XPT < 0._EB)) LCROSS = LCROSS + 1 + ENDIF +ENDDO -RETURN -END SUBROUTINE POINT_IN_CFACE +IF ( MOD(RCROSS,2) /= MOD(LCROSS,2) ) THEN ! Point on edge + PTSFLAG = .TRUE. + RETURN +ENDIF +IF ( MOD(RCROSS,2) == 1) THEN ! Point inside + PTSFLAG = .TRUE. + RETURN +ENDIF -! ---------------------------- SET_CUTCELLS_3D ------------------------------------- +RETURN +END SUBROUTINE TEST_PT_INPOLY -SUBROUTINE SET_CUTCELLS_3D -#ifdef WITHOUT_MPIF08 -USE MPI -#else -USE MPI_F08 -#endif -USE TRAN, ONLY : TRANS -! 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 -! Miscellaneous: -REAL(EB), DIMENSION(MAX_DIM) :: PLNORMAL -INTEGER, DIMENSION(MAX_DIM) :: INDX1 -REAL(EB) :: X1PLN, X3RAY -LOGICAL :: TRI_ONPLANE_ONLY, RAYTRACE_X2_ONLY, MESH_BOUNDARY_FACE -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, & - 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 +! ------------------------ GET_SEGSEG_INTERSECTION ------------------------------ -INTEGER :: IW,II,JJ,IIF,JJF,KKF,IIOF,JJOF,KKOF,LOHIF,IOR,CT,NCFACE_CUTCELL,NFACE_CELL,AX,SIDE,ICC,JCC,ICFC,IFC, & - IBOD_DONOR,ITRI_DONOR -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 -LOGICAL :: FM_PENDING_BLOCK_SCAN(1:NMESHES) +SUBROUTINE GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) -REAL(EB) :: TNOW +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 -LOGICAL :: WRITE_CFACE_STATS = .FALSE. +! Local Variables: +REAL(EB) :: SVR, TVR, KRS, KRS2, E2, L12, L22, E(IAXIS:JAXIS), S1, S2, SMIN, SMAX -INTEGER, SAVE :: CALL_COUNT = 0 +! 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 -! GET_CUTCELL_VERBOSE variables: -INTEGER :: IPROC, NMESH_CC, NMESH_CC_AUX, TAG -#ifdef WITHOUT_MPIF08 -INTEGER :: MPISTATUS(MPI_STATUS_SIZE) -#else -TYPE (MPI_STATUS) :: MPISTATUS -#endif -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 +! 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 -LOGICAL, SAVE :: FIRST_CALL_ARG=.TRUE., FIRST_CALL_ARG2=.TRUE. +RETURN +END SUBROUTINE GET_SEGSEG_INTERSECTION -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 -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 +! -------------------- LINE_INTERSECT_COORDPLANE -------------------------------- -! Reset variables: -CC_NEDGECROSS = 0 -CC_NCUTEDGE = 0 -CC_NCUTFACE = 0 -CC_NCUTCELL = 0 +SUBROUTINE LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LNC,XYZ_INT,INTFLG) -IF (FIRST_CALL) THEN +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 - ! 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 +! 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 - ! Get geometry triangle bins in Cartesian directions: - CALL GET_GEOM_TRIBIN - ! Snap to grid planes node positions in the work volume of this process: - CALL SNAP_GEOM_NODES +! Initialize: +INTFLG = .FALSE. +XYZ_INT(IAXIS:KAXIS) = 0._EB - ! Initialize GEOMETRY fields used by CC_IBM: - CALL CC_INIT_GEOM; IF (STOP_STATUS==SETUP_STOP) RETURN - FIRST_CALL = .FALSE. +! 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 -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 +! 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 - IF (PROCESS(NM)/=MY_RANK) CYCLE +INTFLG = .TRUE. - ! Mesh sizes: - NXB=MESHES(NM)%IBAR - NYB=MESHES(NM)%JBAR - NZB=MESHES(NM)%KBAR +RETURN +END SUBROUTINE LINE_INTERSECT_COORDPLANE - 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) +! ------------------------- CC_INIT_GEOM --------------------------------------- - ! 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 +SUBROUTINE CC_INIT_GEOM - ! 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) +! 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 - ! 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) +REAL(EB) :: CPUTIME_START, CPUTIME - ! 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(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 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) +! In this subroutine the quality of the GEOM lines is checked +! Calc local squared epsilon for GEOM quality check +GEOMEPSSQ = (GEOMEPS * GEOMQUALITYFCT)**2._EB - ! 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) +! Geometry loop: +GEOMETRY_LOOP : DO IG=1,N_GEOMETRY - ! 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) + NWSEL = GEOMETRY(IG)%N_FACES + NVERT = GEOMETRY(IG)%N_VERTS - ENDDO GEOM_LOOP -ENDIF DEBUG_SET_CUTCELLS_COND + 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 -! Select MESHES assigned to MY_RANK and OMESHES of these. Cut-cells computed for all of them. Done in GET_GEOM_TRIBIN + ! 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] -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 + ! COUNTED_VERT used for test of loose vertices: + ALLOCATE(COUNTED_VERT(1:NVERT)); COUNTED_VERT = .FALSE. -! 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. -ENDIF + GEOMETRY(IG)%GEOM_VOLUME = 0._EB + GEOMETRY(IG)%GEOM_AREA = 0._EB + GEOMETRY(IG)%GEOM_XYZCEN(:) = 0._EB -! 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 + ! Compute normal, area and volume: + SQAREA(IAXIS:KAXIS) = 0._EB + DO IWSEL=1,NWSEL - 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 + WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - ! Mesh sizes: - NXB=IBAR - NYB=JBAR - NZB=KBAR - - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) - - ! 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 + COUNTED_VERT(WSELEM(NOD1:NOD3)) = .TRUE. - ! 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 + ! 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 - ! 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 ) ) + 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) - ! 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 ) ) + ! 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 - ! 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 ) ) + ! 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 - ! 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 ) ) + XCEN = (XYZV(IAXIS,NOD1) + XYZV(IAXIS,NOD2) + XYZV(IAXIS,NOD3)) / 3._EB - ! Allocate array for special cells containing geometry intersections: - ALLOCATE(CELLRT(ISTR:IEND,JSTR:JEND,KSTR:KEND)); CELLRT(:,:,:)=.FALSE. + ! 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 - ! 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 + ! 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 - REGCC_REGION_IF : IF(PERIODIC_TEST==7 .OR. PERIODIC_TEST==11) THEN + ! 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) - CALL GET_REGULAR_CUTCELLS_BOX + ! 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 - ELSE + ! 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 - ! Do Loop for different x1 planes: - X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS + ! Geometry Centroid: + DO IX=IAXIS,KAXIS + GEOMETRY(IG)%GEOM_XYZCEN(IX) = SQAREA(IX) / (2._EB * GEOMETRY(IG)%GEOM_VOLUME) + ENDDO - SELECT CASE(X1AXIS) - CASE(IAXIS) + ! 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) - 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 + ! 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 - ! x2, x3 axes parameters: - X2AXIS = JAXIS; X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD - X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD + 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 - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS + 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 - ! 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 + ENDDO + DEALLOCATE(EDGES2) - ! 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 + ! 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 - ! 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 + ! 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) - CASE(JAXIS) + GEOMETRY(IG)%N_EDGES = NWSEDG - 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 + ! At this point the surface is manifold, well oriented, and closed. - ! 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 + 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 - ! 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 +ENDDO GEOMETRY_LOOP - ! 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 +! 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 - CASE(KAXIS) +RETURN +END SUBROUTINE CC_INIT_GEOM - 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 +! ------------------------ GET_GEOM_EDGES --------------------------------------- - ! x2, x3 axes parameters: - X2AXIS = IAXIS; X2LO = ILO_FACE-CCGUARD; X2HI = IHI_FACE+CCGUARD - X3AXIS = JAXIS; X3LO = JLO_FACE-CCGUARD; X3HI = JHI_FACE+CCGUARD +SUBROUTINE GET_GEOM_EDGES(NVERT,NWSEL,SIZEFC,FACES,NWSEDG,EDGES,FACE_EDGES,EDGE_FACES) - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS +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) - ! 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 +! 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 - ! 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 +NWSEDG = 0 - ! 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 +! 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 - END SELECT +! 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. - ! 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 IWSEL=1,NWSEL + WSELEM(NOD1:NOD3) = FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) - ! Stretched grid vars: - X1NOC=TRANS(NM)%NOC(X1AXIS) - X2NOC=TRANS(NM)%NOC(X2AXIS) - X3NOC=TRANS(NM)%NOC(X3AXIS) + 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(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 + 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 - 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,' ..' + 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 - ! Loop Coordinate Planes: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI + 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 - ! Which Plane? - INDX1(IAXIS:KAXIS) = (/ I, J, K /) - X1PLN = X1FACE(INDX1(X1AXIS)) + WSELEM=CSHIFT(WSELEM,1) + ENDDO +ENDDO - ! 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) +! 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 - ! Test that there is an intersection: - IF ((BODINT_PLANE%NSGLS+BODINT_PLANE%NSEGS+BODINT_PLANE%NTRIS) == 0) CYCLE +! 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 - ! 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 +DEALLOCATE(NELVERT,ISTVERT,EDGES2,EDGE_FACES2,EDGE_RNK) - ! 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 +RETURN +END SUBROUTINE GET_GEOM_EDGES - ! 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 +! ---------------------------- DEBUG_WAIT --------------------------------------- - ! x3 location of ray along x2, on the x2-x3 plane: - X3RAY = X3FACE(KK) +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) 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 +! ---------------------------- READ_GEOM ---------------------------------------- - ! 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 +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 +#ifdef WITHOUT_MPIF08 +USE MPI +#else +USE MPI_F08 +#endif +USE OUTPUT_DATA, ONLY: COLOR2RGB - ! Deallocate local plane arrays: - DEALLOCATE(X1FACE,X2FACE,X3FACE,X2CELL,X3CELL) - DEALLOCATE(DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL) - DEALLOCATE(FACERT) +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 - ENDDO X1AXIS_LOOP +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) - 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 +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 - ! 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 - - ! 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 +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 +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. - ! 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 +REAL(EB), PARAMETER :: MAX_VAL=1.0E20_EB - 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 +LOGICAL :: READ_BINARY - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) +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 - ! Here: 1,2. Define Linking information for cut-cells. - CALL GET_CELL_LINK_INFO(NM) +LOGICAL :: IS_TERRAIN,EXTEND_TERRAIN,WRITE_WARNING +REAL(EB):: ZVAL_HORIZON, ZVAL_FACTOR - 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 (ALLOCATED(CELLRT)) DEALLOCATE(CELLRT) - IF (ALLOCATED(SPCELLS_TO_BLOCK)) DEALLOCATE(SPCELLS_TO_BLOCK) -ENDDO MAIN_MESH_LOOP +INTEGER :: START_FACE_LO, START_FACE_MID, START_FACE_HI -! 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_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 PROMOTE_REFINEMENT_FOOTPRINTS_FROM_BLOCKED_FINE(NM) -ENDDO +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' -CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE) -CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE2) +LOGICAL :: DONE -! 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) +INTEGER :: ILINE, IERR +INTEGER :: IG, IVERT -DO IDIM=1,MAX_DIM +INTEGER, ALLOCATABLE, DIMENSION(:) :: GEOM_LINE,GEOM_LINE2 +INTEGER, PARAMETER :: DELTA_GEOM_LINE=1000 +INTEGER :: GEOM_LINE_SIZE -FM_PENDING_BLOCK_SCAN = .FALSE. -DO NM=1,NMESHES; MESHES(NM)%N_CC_ELIMINATED = 0; ENDDO +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,SURF_ID,SURF_IDS,SURF_ID6,& + TEXTURE_MAPPING,TEXTURE_ORIGIN,TRANSPARENCY,& + VERTS,XB,ZMIN,ZVALS,ZVAL_HORIZON -! Exchange CC%NOADVANCE(JCC)>0 information among NEIGHBOURING meshes: -CALL EXCHANGE_CC_NOADVANCE_INFO -CALL APPLY_OWN_BLOCKED_TO_REPLICAS ! Mirror owner-side NOADVANCE flags onto OMESH replicas of the same mesh -! Add CC%NOADVANCE(JCC) where needed: -CALL ADD_NEIGHBOR_BLOCKED_CELLS +! first pass - count number of &GEOM lines. -MAIN_MESH_LOOP_1 : DO NM=1,NMESHES +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 - 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 GEOMETRY array - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) +ALLOCATE(GEOMETRY(0:N_GEOMETRY),STAT=IZERO) +CALL ChkMemErr('READ_GEOM','GEOMETRY',IZERO) - ! Block cut-cells whose volume factor is less than MIN_VOL_FACTOR, or remain unlinked: - CALL BLOCK_SMALL_UNLINKED_CUTCELLS(NM,SUM_CCELL) +! third pass - read GEOM data - 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 +READ_GEOM_LOOP: DO N=1,N_GEOMETRY + G=>GEOMETRY(N) - ! 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 + CALL CHECKREAD('GEOM',LU_INPUT,IOS) ; IF (STOP_STATUS==SETUP_STOP) RETURN + IF (IOS==1) EXIT READ_GEOM_LOOP - ! Block cells trapped against a mesh boundary whose only same-mesh gas opening is a small cut-face. - DO ICC1=1,MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH - CC=>MESHES(NM)%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 - K=K+1 - ENDDO - ENDDO - IF (K>0) THEN - FM_PENDING_BLOCK_SCAN(NM) = .TRUE. + 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 - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -ENDDO MAIN_MESH_LOOP_1 - -! Propagate DROP_CUTCELL eliminations (fine interior, NCELL==1) to coarse ghost band; -! ghost solidifies in MAIN_MESH_LOOP_1B, then TAG_CC_BLOCKING_REFINEMENT closes fine footprint. -! Do not PROMOTE_ELIMINATED to coarse interior here — that over-blocks 5mm. -CALL EXCHANGE_CC_ELIMINATED_INFO -CALL APPLY_OWN_BLOCKED_TO_REPLICAS -CALL ADD_NEIGHBOR_BLOCKED_CELLS -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 - -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. - MAIN_MESH_LOOP_1B : 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) - CALL GET_CELL_LINK_INFO(NM) - 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) + 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 - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) - ENDDO MAIN_MESH_LOOP_1B -ENDIF -CALL EXCHANGE_CC_NOADVANCE_INFO -CALL APPLY_OWN_BLOCKED_TO_REPLICAS -CALL ADD_NEIGHBOR_BLOCKED_CELLS - -! Call tag boundary cut-cells for blocking in refinement interfaces: -CALL TAG_CC_BLOCKING_REFINEMENT - -ENDDO - -! 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 -CALL ADD_NEIGHBOR_BLOCKED_CELLS - -MAIN_MESH_LOOP_3 : 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.) + IF (DONE) EXIT GEOM_RESIZE_DO + ENDDO GEOM_RESIZE_DO - CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) + 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 - ! Here: 1,2. Define Linking information for cut-cells. - CALL GET_CELL_LINK_INFO(NM) + ! 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 - ! 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 + 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 - ! 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 + ! count POLY Verts: + DO I = 1,MAX_POLY_VERTS + IF (POLY(I)==0) EXIT + N_POLY_VERTS = N_POLY_VERTS+1 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 - ! 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 + ! 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 - ! 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)MAX_VAL) EXIT + N_ZVALS=N_ZVALS+1 ENDDO - ENDIF -ENDDO -! Finally allocate Face and cell variables, compute area and volume factors: -MAIN_MESH_LOOP_4 : 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) + 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 - 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 + ! 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 - 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 - -ENDDO MAIN_MESH_LOOP_4 -! Add to SET_CUTCELLS_3D loop time: -T_CC_USED(SET_CUTCELLS_TIME_INDEX) = T_CC_USED(SET_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW + ! 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(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 + N_VERTS_ORIG = N_VERTS + N_FACES_ORIG = N_FACES + N_VOLUS_ORIG = N_VOLUS -! 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 + !--- 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 - 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)) + 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)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 (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.' + ENDIF -! Fill Guardcells for CCVAR CC_CGSC and CUT_CELL for meshes assigned to MPI process: -CALL SET_GC_CUTCELLS_3D + ! 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) -! Allocate and define entries for solid side CFACES: -IF(PERIODIC_TEST/=105) CALL GET_EXT_INB_CUTFACES_TO_CFACE + ZVAL_FACTOR = 1._EB + IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. -IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) + N_VOLUS = 0; N_VOLUS_ORIG = N_VOLUS -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 + 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 -! 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) RETURN -ENDIF + ! 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 -! 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 + ! 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 - ! 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) 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 + 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) - 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 + FACES(3*IJF-2) = I2 + FACES(3*IJF-1) = I1 + FACES(3*IJF) = I4 + IJF = IJF + 1 -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. + FACES(3*IJF-2) = I2 + FACES(3*IJF-1) = I4 + FACES(3*IJF) = I3 + IJF = IJF + 1 ENDDO - ENDDO -ENDDO -END SUBROUTINE TAG_FINE_CELLS_IN_COARSE_CELL_VOLUME -SUBROUTINE GET_FINE_CELL_FROM_COARSE_WALL(IOR_COARSE,IIO_LOC,JJO_LOC,KKO_LOC,I_FINE,J_FINE,K_FINE) + ! 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 -INTEGER, INTENT(IN) :: IOR_COARSE,IIO_LOC,JJO_LOC,KKO_LOC -INTEGER, INTENT(OUT) :: I_FINE,J_FINE,K_FINE + N_VERTS = IJ - 1 + N_FACES = IJF - 1 -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 + DEALLOCATE(B_IND,E_IND,F_IND) -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 + ELSEIF(IS_TERRAIN) THEN ZVALS_IF -SUBROUTINE GET_REFINEMENT_CELL_DONOR(NM_LOC,I_LOC,J_LOC,K_LOC,IBOD_OUT,ITRI_OUT) + GEOM_TYPE = TERRAIN_GEOM_TYPE + TERRAIN_CASE= .TRUE. -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 + ! 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 -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 + + ! 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 ) + ENDIF 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) + + ! 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 - 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 + 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) + + 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 - 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 + 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) -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 + ZVAL_FACTOR = 1._EB + IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. -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 + N_VOLUS = 0 -SUBROUTINE TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT(NM_LOC,I_LOC,J_LOC,K_LOC,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR,CELL_CHANGED) + 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 -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 + B_IND(1:N_BEDGES) = BOUND_EDGES(NOD1,1:N_BEDGES); B_IND(N_BEDGES+1) = B_IND(1) ! Last equal to first -CELL_CHANGED = .FALSE. -MT => MESHES(NM_LOC) + ! 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 -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 + B_IND(N_BEDGES+1:2*N_BEDGES) = B_IND(1:N_BEDGES) + B_IND(2*N_BEDGES+1) = B_IND(1) -END SUBROUTINE TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT + ! 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)) -LOGICAL FUNCTION FACE_INDEX_IN_BOUNDS(NM_LOC,I_LOC,J_LOC,K_LOC,AX_LOC) + ! 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, INTENT(IN) :: NM_LOC,I_LOC,J_LOC,K_LOC,AX_LOC + ! 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 -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 + ! 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) -SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 -USE TRAN, ONLY: GET_IJK -INTEGER :: NM2,ICELL,I2,J2,K2,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR -REAL(EB):: XCO,YCO,ZCO,VOL_NM,VOL_NOM,X1,Y1,Z1,XMAP,YMAP,ZMAP -LOGICAL :: FINE_AT_REFI,CELL_CHANGED -TYPE(MESH_TYPE), POINTER :: M2 + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO + ENDDO -CELL_CHANGED = .FALSE. -MESH_LOOP : DO NM=1,NMESHES + ! 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 (.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 + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 - CALL POINT_TO_MESH(NM) - M => MESHES(NM) - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.TRUE.) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO + ENDDO - ! 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) + ! 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) - ! 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) + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 + ENDDO + ENDDO - 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) - IF (I2<1 .OR. I2>M2%IBAR .OR. J2<1 .OR. J2>M2%JBAR .OR. K2<1 .OR. K2>M2%KBAR) CYCLE ICELL_DO - 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 - 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)) CYCLE ICELL_DO - 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 + ELSE - ! 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) CYCLE ICELL_DO - 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) 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 - 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, & - M2%JBT_CC_BLOCKED(3,ICELL),M2%JBT_CC_BLOCKED(4,ICELL)) + ! 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. - ELSE - ! Same refinement level (or refinement handled by EXT_WALL_LOOP) - use centroid matching - I = MINLOC(ABS(XCELL(ILO_CELL-1:IHI_CELL+1)-XCO),DIM=1) + ILO_CELL - 2 - J = MINLOC(ABS(YCELL(JLO_CELL-1:JHI_CELL+1)-YCO),DIM=1) + JLO_CELL - 2 - K = MINLOC(ABS(ZCELL(KLO_CELL-1:KHI_CELL+1)-ZCO),DIM=1) + KLO_CELL - 2 - IF (ABS(XCO-XCELL(I))>=GEOMEPS .OR. ABS(YCO-YCELL(J))>=GEOMEPS .OR. & - ABS(ZCO-ZCELL(K))>=GEOMEPS) CYCLE ICELL_DO - ! 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) THEN - IF (M2%JBT_CC_BLOCKED(1,ICELL)>0) THEN - IF (M2%JBT_CC_BLOCKED(1,ICELL)<=M%CUT_CELL(ICC)%NCELL) THEN - M%CUT_CELL(ICC)%NOADVANCE(M2%JBT_CC_BLOCKED(1,ICELL)) = BLOCK_TAG - IF (M2%JBT_CC_BLOCKED(3,ICELL)>0 .AND. M2%JBT_CC_BLOCKED(4,ICELL)>0) & - M%CUT_CELL(ICC)%BODTRI_DONOR(1:2,M2%JBT_CC_BLOCKED(1,ICELL)) = M2%JBT_CC_BLOCKED(3:4,ICELL) - ENDIF - ENDIF - ENDIF - ENDIF - ENDDO ICELL_DO - ENDDO NEIGHBORING_MESHES_DO - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -ENDDO MESH_LOOP -END SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS + ! 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 + ! 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) -! ----------------------- APPLY_OWN_BLOCKED_TO_REPLICAS ---------------------------- -! 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 + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I2 + FACES(3*IJF) = I3 + IJF = IJF + 1 -USE TRAN, ONLY: GET_IJK + FACES(3*IJF-2) = I1 + FACES(3*IJF-1) = I3 + FACES(3*IJF) = I4 + IJF = IJF + 1 + ENDDO -INTEGER :: NM_LOC,ICELL,JCC_LOC,I_LOC,J_LOC,K_LOC,BLOCK_TAG,ICC_LOC -REAL(EB) :: XCO,YCO,ZCO,X1,Y1,Z1 + ! 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 -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 -SUBROUTINE DEFINE_XYZFACE_CELL(ALLOC_FLG) + N_VERTS = IJ - 1 + N_FACES = IJF - 1 -LOGICAL, INTENT(IN) :: ALLOC_FLG + DEALLOCATE(B_IND,E_IND,F_IND,BOUND_EDGES) -IF (ALLOC_FLG) THEN + ENDIF ZVALS_IF - ! 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. + !--- setup a block object (XB keyword ) - ! 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. + 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 - ! 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 + ! define verts in box - ! 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 + 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 - ! 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 + ! define tetrahedrons in box -ELSE + 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 - ! 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) + ! 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 - ! 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) + ! setup a sphere object (SPHERE_RADIUS and SPHERE_ORIGIN keywords) -ENDIF + IF (SPHERE_RADIUS MESHES(1) + DX = M%DXMIN + ! 2*PI*R/(5*2^N_LEVELS) ~= DX, solve for N_LEVELS -SUBROUTINE TAG_CC_BLOCKING_REFINEMENT + IF (SPHERE_RADIUS<100.0_EB*TWENTY_EPSILON_EB) SPHERE_RADIUS = 100.0_EB*TWENTY_EPSILON_EB -LOGICAL, PARAMETER :: DO_RAY_TRACING=.TRUE. -INTEGER :: DUM,II1,JJ1,KK1,IIO1,JJO1,KKO1,IIO2,JJO2,KKO2,IIG,JJG,KKG,IIOG,JJOG,KKOG + 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 -IF ( DO_RAY_TRACING) THEN + ! Setup a cylinder object (CYLINDER_RADIUS, CYLINDER_LENGTH, CYLINDER_ORIGIN, CYLINDER_AXIS keywords): + DEFINE_CYLINDER_IF: IF ( CYLINDER_LENGTH MESHES(NM) + IF (CYLINDER_NSEG_THETA ==-1) CYLINDER_NSEG_THETA = 8 + IF (CYLINDER_NSEG_AXIS ==-1) CYLINDER_NSEG_AXIS = 1 - ! 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 + 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 - ! 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 + ! 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) - ! 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 + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 - ! 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 + ENDIF DEFINE_CYLINDER_IF - ! 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 + ! 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 - ! 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 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 -ELSE + 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 - ! 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 + 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) - CALL POINT_TO_MESH(NM) - M => MESHES(NM) + IF(IERR /= 0) RETURN - ! 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 + IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 - ! 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. - CALL GET_REFINEMENT_CELL_DONOR(NOM,IIOF,JJOF,KKOF,IBOD_DONOR,ITRI_DONOR) - ! 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) - CALL SET_REFINEMENT_CUTCELL_DONOR(NM,ICC,1,IBOD_DONOR,ITRI_DONOR) - 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 - CALL SET_REFINEMENT_CUTCELL_DONOR(NM,ICC,JCC,IBOD_DONOR,ITRI_DONOR) - 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 + 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 - IF(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)==CC_SOLID) THEN ! Coarse side face is solid. - IF (PROCESS(NOM)/=MY_RANK) CYCLE EXT_WALL_LOOP - CALL GET_REFINEMENT_CELL_DONOR(NM,IIF,JJF,KKF,IBOD_DONOR,ITRI_DONOR) - ! 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) - CALL SET_REFINEMENT_CUTCELL_DONOR(NOM,ICC,1,IBOD_DONOR,ITRI_DONOR) - 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 - CALL SET_REFINEMENT_CUTCELL_DONOR(NOM,ICC,JCC,IBOD_DONOR,ITRI_DONOR) - 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 + ENDIF POLY_COND -ENDIF -RETURN -END SUBROUTINE TAG_CC_BLOCKING_REFINEMENT + 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 -SUBROUTINE TAG_BLOCK_CELL(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1,FINE_CELL) + 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 -INTEGER, INTENT(IN) :: NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1 -LOGICAL, INTENT(IN) :: FINE_CELL -INTEGER :: JCC_LOC,IBOD_LOC,ITRI_LOC -TYPE(MESH_TYPE), POINTER :: M,M2 -M =>MESHES( NM) -M2=>MESHES(NOM) + ! wrap up -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. - CALL GET_REFINEMENT_CELL_DONOR(NOM,IIO1,JJO1,KKO1,IBOD_LOC,ITRI_LOC) - IF(M%CCVAR(II1,JJ1,KK1,CC_CGSC)==CC_GASPHASE) THEN - ! Skip rank-asymmetric cut-cell insertion (owner-only); keep CC_GASPHASE on all ranks. - 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,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 - 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 - ENDIF - ENDIF -ELSE - IF (PROCESS(NOM)/=MY_RANK) RETURN - 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 - ! 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 - ! 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 + G%ID = ID + G%N_VOLUS_BASE = N_VOLUS + G%N_FACES_BASE = N_FACES + G%N_VERTS_BASE = N_VERTS -END SUBROUTINE TAG_BLOCK_CELL + ! 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) -SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) + ! 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 -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT + IF (MATL_ID=='null') THEN + HAVE_MATL = .FALSE. + ENDIF + G%MATL_ID = MATL_ID + G%HAVE_MATL = HAVE_MATL -INTEGER, INTENT(IN) :: NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2 + IF (N_VERTS>0) THEN -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,IBOD_DONOR,ITRI_DONOR -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 + 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 -M =>MESHES( NM) -M2=>MESHES(NOM) -CALL GET_REFINEMENT_CELL_DONOR(NOM,IIO1,JJO1,KKO1,IBOD_DONOR,ITRI_DONOR) + 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 -INBFC=M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCF); IF(INBFC<1) RETURN ! No CC_INBOUNDARY faces in this cartesian cell. + ! setup volumes -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 + 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 -IF(FC_FOUND<1) RETURN ! Here or before we can switch to a point in polygon test whithin JCC_LOOP. + 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 -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 + ! construct an array of external faces -! 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 + ! determine which tetrahedron faces are external -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 (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(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 + IS_EXTERNAL(0:N_FACES-1)=.TRUE. ! start off by assuming all faces are external -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 + 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)) - ! 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) + 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)) - ! 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 + 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)) - ! 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 + 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 - ! 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 + ! find faces that match - 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 /) ) + 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 - 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)) + ! create new FACES index array keeping only external faces - IF (NORM2(NVEC)X1F +GEOMEPS) CYCLE INBFC_LOC_LOOP + 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 + ENDIF + CALL COMPUTE_TEXTURES(VERTS,FACES,TFACES,MAX_VERTS,MAX_FACES,N_FACES) + + ! 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 - IF(XYZ_P(X1AXIS)XYZCEN(X1AXIS)+GEOMEPS) CYCLE INBFC_LOC_LOOP + SURFS(:) = 0 ! All external faces point to default surf ID. 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) 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) + ENDIF N_VOLUS_IF -DEALLOCATE(CFELEM) -IF(ALLOCATED(XYZVERTIJK)) DEALLOCATE(XYZVERTIJK,XYZVERTSTN,CFELEM2) -RETURN -END SUBROUTINE TEST_CC_FOR_BLOCKING + ! 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 + 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) -SUBROUTINE GET_CC_FACE_CELL_LIST_INFO(NM,PHASE) + ! 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 -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: PHASE + 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) -! 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) + ALLOCATE(G%SURFS(N_FACES),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%SURFS',IZERO) -! 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) + 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 - 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 + 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 - ENDDO -ENDDO CUT_CELL_LOOP -! 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 + ENDIF N_FACES_IF -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 + 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(G%VERTS(3*N_VERTS),STAT=IZERO) + CALL ChkMemErr('READ_GEOM','G%VERTS',IZERO) 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) + G%MOVE_ID = MOVE_ID + G%IS_DYNAMIC = .FALSE. - END SELECT - ENDDO - ENDDO -ENDDO CUTFACE_LOOP + ! Prevent drawing of boundary info if desired -! 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 + G%SHOW_BNDF = BNDF_GEOM + + ! 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 - ! 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 +DO IG = 1, N_GEOMETRY - 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 + G=>GEOMETRY(IG) - 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 + ! 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 - CLOSE(33) - 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 + ! Check for duct nodes -RETURN -END SUBROUTINE GET_CC_FACE_CELL_LIST_INFO + DO J = 1,G%N_FACES + IF (SURFACE(G%SURFS(J))%NODE_ID/='null') THEN + G%HAVE_NODE = .TRUE. + EXIT + ENDIF + ENDDO +ENDDO -! ---------------------- GET_REGULAR_CUTCELLS_BOX ------------------------------ +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_REGULAR_CUTCELLS_BOX +DEALLOCATE(GEOM_LINE) -! 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 +IF( (T_END-T_BEGIN) < TWENTY_EPSILON_EB) RETURN +CC_IBM = .TRUE. -! 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 +! For unstructured projection define Pressure solver on unstructured grid. +PRES_ON_WHOLE_DOMAIN = .FALSE. +IF (ABS(CCVOL_LINK-0.95_EB) 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 +CONTAINS -! 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 +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 - ! 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 +! 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) - ! 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 +IERR = 1 - ! 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 +! 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) -! 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 +! 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 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 +! 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 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 +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 -! 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 +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 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 +! 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. - ! 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 + ! 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) MESHES(NM)%CUT_FACE(NCUTFACE) - CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) +! 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 - ! 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) +! 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 /) - ! 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) +VERTEX_LOOP : DO ILE=1,NP_L + POS_1 = -CYLINDER_LENGTH/2._EB + REAL(ILE-1,EB)*DELTA_L + DO ITH=1,NP_T - ENDDO - ENDDO - ENDDO - DEALLOCATE(X1FACE,X2FACE,X3FACE) - ENDDO X1AXIS_LOOP - ENDDO IBNDINT_LOOP + THETA = REAL(ITH-1,EB)*DELTA_T + POS_2 = CYLINDER_RADIUS*COS(THETA) + POS_3 = CYLINDER_RADIUS*SIN(THETA) - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED ) + IVERT = IVERT + 1 + VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) - ! 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 +ENDDO VERTEX_LOOP - ! Loop on Cartesian cells: - DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI +! 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 /) - IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE +NVERTS = IVERT - IF(IJK_COUNTED2(I,J,K)) CYCLE; IJK_COUNTED2(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) +! 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 - IF ( ALL(FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) /= CC_SOLID) ) CYCLE +! Cylinder side faces: +CYL_FIND(LOW_IND,2) = IFACE + 1 +FACE_LOOP : DO ILE=2,NP_L + DO IFC=1,NP_T - 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) + ! 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 - ! 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) + IFACE=IFACE+1 + FACES(3*IFACE-2:3*IFACE) = (/I1, I3, I2/) + IFACE=IFACE+1 + FACES(3*IFACE-2:3*IFACE) = (/I3, I4, I2/) - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I-2+LOHI,J,K,X1AXIS) - CASE(JAXIS) + ENDDO +ENDDO FACE_LOOP +CYL_FIND(HIGH_IND,2) = IFACE - ! 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) +! 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 - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I,J-2+LOHI,K,X1AXIS) - CASE(KAXIS) +! 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 - ! 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) +! No volumes being defined. +NVOLS = 0 +VOLS = 0 - ! Define IBOD and ITRI: - IBOD(NFACE) = GEOMFACE(I,J,K-2+LOHI,X1AXIS) - END SELECT +! 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 - ! 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 +RETURN +END SUBROUTINE DEFINE_CYLINDER - NVERT = NVERT + 4 +! ---------------------------- GET_GEOM_INFO ---------------------------------------- - ENDDO LOHI_DO - ENDDO X1AXIS_LOOP2 +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. +! 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. - ! 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(INOUT) :: MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +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) - 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) +END SUBROUTINE GET_GEOM_INFO - CF%AREA(1:NFACE) = AREA(1:NFACE) - CF%XYZCEN(IAXIS:KAXIS,1:NFACE) = XYZCEN(IAXIS:KAXIS,1:NFACE) +! ---------------------------- ALLOCATE_BUFFERS ---------------------------------------- - ! 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) +SUBROUTINE ALLOCATE_BUFFERS - ! Define Body-triangle reference: - CF%BODTRI(1,1:NFACE)= IBOD(1:NFACE) - CF%BODTRI(2,1:NFACE)= ITRI(1:NFACE) +IF(ALLOCATED(SURF_ID)) DEALLOCATE(SURF_ID) +ALLOCATE(SURF_ID(MAX_SURF_IDS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','SURF_ID',IZERO) - ! Assign surf-index: Depending on GEOMETRY: - DO IFACE=1,NFACE - CF%SURF_INDEX(IFACE) = GEOMETRY(IBOD(IFACE))%SURFS(ITRI(IFACE)) - ENDDO +IF(ALLOCATED(ZVALS)) DEALLOCATE(ZVALS) +ALLOCATE(ZVALS(MAX_ZVALS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','ZVALS',IZERO) - ENDDO - ENDDO - ENDDO +IF(ALLOCATED(VERTS)) DEALLOCATE(VERTS) +ALLOCATE(VERTS(3*MAX_VERTS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','VERTS',IZERO) - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNTED2 ) +IF(ALLOCATED(TFACES)) DEALLOCATE(TFACES) +ALLOCATE(TFACES(6*MAX_FACES+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','TFACES',IZERO) -ENDDO INTGC_FLG_LOOP +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) -! 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. +IF(ALLOCATED(POLY)) DEALLOCATE(POLY) +ALLOCATE(POLY(MAX_POLY_VERTS+1),STAT=IZERO) +CALL ChkMemErr('ALLOCATE_BUFFERS','POLY',IZERO) +END SUBROUTINE ALLOCATE_BUFFERS - 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 +! ---------------------------- SET_GEOM_DEFAULTS ---------------------------------------- - ! 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 SET_GEOM_DEFAULTS - IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE + ! Set defaults - IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. + 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' - ! 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) +END SUBROUTINE SET_GEOM_DEFAULTS - ! 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 +! ---------------------------- BOX2TETRA ---------------------------------------- - 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 BOX2TETRA(BOX,TETRAS) - ! 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 +! split a box defined by a list of 8 vertices (not necessarily cubic) into 6 stackable tetrahedrons - VOL(1) = DXCELL(I)*DYCELL(J)*DZCELL(K) - XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZCELL(K) /) +! 8-------7 +! / . / | +! 5-------6 | +! | . | | +! | . | | +! | 4-------3 +! | / | / +! 1-------2 - ! 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) +INTEGER, INTENT(IN) :: BOX(8) +INTEGER, INTENT(OUT) :: TETRAS(1:24) - ! 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) +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)/) - ENDDO - ENDDO - ENDDO +END SUBROUTINE BOX2TETRA - IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNT ) -ENDDO INTGC_FLG_LOOP2 +! ---------------------------- ORDER_FACES ---------------------------------------- +SUBROUTINE ORDER_FACES(ORDER,N) ! +INTEGER, INTENT(IN) :: N +INTEGER, INTENT(OUT) :: ORDER(1:N) -DEALLOCATE(GEOMFACE,GEOMCELL) +INTEGER, ALLOCATABLE, DIMENSION(:) :: WORK +INTEGER :: I, IZERO -END SUBROUTINE GET_REGULAR_CUTCELLS_BOX +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 +! ---------------------------- ORDER_FACES1 ---------------------------------------- -! --------------------- DEALLOCATE_CUTCELLS_CONN_MESH -------------------------- +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 -SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH(NM) +INTEGER :: NMID -INTEGER, INTENT(IN) :: 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 -INTEGER :: ICC, ICF, I, J, K, DO_BNCF=1 -INTEGER, PARAMETER :: LOIN=-1 -INTEGER, PARAMETER :: HIIN= 2 +! ---------------------------- COMPARE_FACES ---------------------------------------- -! 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 +INTEGER FUNCTION COMPARE_FACES(INDEX1,INDEX2) +INTEGER, INTENT(IN) :: INDEX1, INDEX2 +INTEGER, POINTER, DIMENSION(:) :: FACE1, FACE2 +INTEGER :: F1(3), F2(3) + +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 + +IF (F1(2)F2(2)) THEN + COMPARE_FACES=-1 +ENDIF +IF (COMPARE_FACES/=0) RETURN + +IF (F1(3)F2(3)) THEN + COMPARE_FACES=-1 +ENDIF +END FUNCTION COMPARE_FACES + +END SUBROUTINE READ_GEOM + + +! ---------------------------- INIT_SPHERE ---------------------------------------- + +SUBROUTINE INIT_SPHERE(N_LEVELS,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) + +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) + +REAL(EB) :: ARG +REAL(EB), DIMENSION(3) :: VERT +INTEGER :: I,IFACE +INTEGER, DIMENSION(60) :: FACE_LIST + +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 & + / + +N_VERTS = 12 +N_FACES = 20 + +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 -! 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 +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 -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 +SPHERE_VERTS(34:36) = (/0.0,0.0,-1.0/) ! 12 +SPHERE_FACES(1:60) = FACE_LIST(1:60) -! ----------------------- DEALLOCATE_BODINT_PLANE ------------------------------ +! refine each triangle of the icosahedron recursively until the +! refined triangle sides are the same size as the grid mesh -SUBROUTINE DEALLOCATE_BODINT_PLANE(BODINT_PLANE) +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 -TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE +! ---------------------------- COMPUTE_TEXTURES ---------------------------------------- -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) +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) -RETURN -END SUBROUTINE DEALLOCATE_BODINT_PLANE +INTEGER :: IFACE +REAL(EB) :: EPS_TEXTURE +REAL(EB), POINTER, DIMENSION(:) :: TFACE, VERTPTR +INTEGER, POINTER, DIMENSION(:) :: FACEPTR -! ---------------------- GET_EXT_INB_CUTFACES_TO_CFACE -------------------------------- +EPS_TEXTURE=0.25_EB +IFACE_LOOP: DO IFACE=0, N_FACES-1 -SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE + FACEPTR=>SPHERE_FACES(3*IFACE+1:3*IFACE+3) + TFACE=>SPHERE_TFACES(6*IFACE+1:6*IFACE+6) -! Local Variables: -INTEGER :: ICF, CFACE_INDEX_LOCAL, SURF_INDEX -INTEGER :: IVENT -REAL(EB):: ADDMAT(IAXIS:KAXIS,LOW_IND:HIGH_IND) + VERTPTR=>SPHERE_VERTS(3*FACEPTR(1)-2:3*FACEPTR(1)) + CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(1:2)) -! GET_CUTCELLS_VERBOSE variables: -INTEGER, ALLOCATABLE, DIMENSION(:) :: NCFACE_BY_MESH + VERTPTR=>SPHERE_VERTS(3*FACEPTR(2)-2:3*FACEPTR(2)) + CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(3:4)) -TYPE(VENTS_TYPE), POINTER :: VT -TYPE(CFACE_TYPE), POINTER :: CFA + VERTPTR=>SPHERE_VERTS(3*FACEPTR(3)-2:3*FACEPTR(3)) + CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(5:6)) -IF(GET_CUTCELLS_VERBOSE) CALL CPU_TIME(CPUTIME_START) + ! adjust texture coordinates when a triangle crosses the "prime meridian" -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 (TFACE(1)>1.0_EB-EPS_TEXTURE .AND. TFACE(3)1.0_EB-EPS_TEXTURE .AND. TFACE(5) 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 + 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 - 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 +ENDDO IFACE_LOOP +END SUBROUTINE COMPUTE_TEXTURES -! 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) +! ---------------------------- INIT_SPHERE2 ---------------------------------------- - ! ! Currently : Modify CFACE SURF_INDEX with VENT information: This needs more development. +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) - 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. +INTEGER :: I , J, IJ, I11, I12, I21, I22 - ! 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. +N_VERTS = NLONG*(NLAT-2) + 2 +N_FACES = (NLAT-2)*NLONG*2 -! 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) +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 -! 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) +! define vertices - ! 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 +! north pole -ENDDO MESH_LOOP_4 +SPHERE_VERTS(1:3) = (/0.0_EB,0.0_EB,1.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) WRITE(LU_ERR ,'(A,F8.3,A)') ' done. Time taken : ',CPUTIME-CPUTIME_START,', sec.' -ENDIF +! middle latitudes -RETURN -END SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE +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 +! south pole -! ------------------------- SET_GC_CUTCELLS_3D ----------------------------------- +SPHERE_VERTS(IJ:IJ+2) = (/0.0_EB,0.0_EB,-1.0_EB/) -SUBROUTINE SET_GC_CUTCELLS_3D +! define faces -! 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 +! 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 +DO ILAT = 2, NLAT - 2 + DO ILONG = 1, NLONG -IF (CCGUARD == 0) RETURN + 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 -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 + SPHERE_FACES(IJ:IJ+2) = (/I12,I11,I22/) + SPHERE_FACES(IJ+3:IJ+5) = (/I22,I11,I21/) + IJ = IJ + 6 + ENDDO +ENDDO -! 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 +! faces connected to south pole - IF (MESHES(NM)%N_CUTFACE_MESH==0) CYCLE MESH_LOOP_1 - CALL POINT_TO_MESH(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 - EXTERNAL_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS +! ---------------------------- REFINE_FACE ---------------------------------------- - 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 +RECURSIVE SUBROUTINE REFINE_FACE(N_LEVELS,IFACE,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) - II = BC%II - JJ = BC%JJ - KK = BC%KK - IOR = BC%IOR +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) - ! 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 +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 - ! 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 (N_LEVELS==0 .OR. N_FACES+3>MAX_FACES .OR. N_VERTS+3>MAX_VERTS) RETURN ! prevent memory overwrites - 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: +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 - 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 +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) - ! 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 +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) - 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 - ENDDO EXTERNAL_WALL_LOOP_1 +! split triangle 123 into 4 triangles -ENDDO MESH_LOOP_1 +! 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/) -! 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 +N1 = IFACE +N2 = N_FACES+1 +N3 = N_FACES+2 +N4 = N_FACES+3 - IF ((MESHES(NM)%N_CUTCELL_MESH+MESHES(NM)%N_GCCUTCELL_MESH)==0) CYCLE MESH_LOOP_2 +N_FACES = N_FACES + 3 +N_VERTS = N_VERTS + 3 +IF (N_LEVELS==1) RETURN ! stop recursion - CALL POINT_TO_MESH(NM) +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) - EXTERNAL_WALL_LOOP_2 : DO IW=1,N_EXTERNAL_WALL_CELLS +END SUBROUTINE REFINE_FACE - 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 +! ---------------------------- COMPUTE_TEXTURE ---------------------------------------- - II = BC%II - JJ = BC%JJ - KK = BC%KK - IOR = BC%IOR - NOM = EWC%NOM ! Use Other Mesh Data. +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 - IF (NOM>0) THEN - IF (MESHES(NOM)%N_CUTFACE_MESH==0) CYCLE EXTERNAL_WALL_LOOP_2 - ENDIF +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/) - IF (WC%BOUNDARY_TYPE == INTERPOLATED_BOUNDARY) 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 - ! 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 +! ---------------------------- GET_GEOM_ID ---------------------------------------- - 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 FUNCTION GET_GEOM_ID(ID,N_LAST) - 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 +! return the index of the geometry array with label ID - 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 .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 - ! 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 +CHARACTER(30), INTENT(IN) :: ID +INTEGER, INTENT(IN) :: N_LAST - ! 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. +INTEGER :: N +TYPE(GEOMETRY_TYPE), POINTER :: G - 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 .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 - 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 +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 +! ---------------------------- GEOMCLIPS ---------------------------------------- - ENDDO EXTERNAL_WALL_LOOP_2 +SUBROUTINE GEOMCLIPS +USE BOXTETRA_ROUTINES, ONLY : GEOMCLIP +REAL(EB) :: XB(6) +INTEGER :: I +TYPE(GEOMETRY_TYPE), POINTER :: G -ENDDO MESH_LOOP_2 + ! clip geometries to mesh -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 +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 -RETURN +! ---------------------------- PROCESS_GEOM ---------------------------------------- -END SUBROUTINE SET_GC_CUTCELLS_3D +SUBROUTINE PROCESS_GEOM(IS_DYNAMIC,TIME, N_VERTS, N_FACES, N_VOLUS) +USE GEOMETRY_FUNCTIONS, ONLY: TRANSFORM_COORDINATES -! --------------------------- GET_GEOM_TRIBIN -------------------------------------- +! transform (scale, rotate and translate) vectors found on each &GEOM line -SUBROUTINE GET_GEOM_TRIBIN + LOGICAL, INTENT(IN) :: IS_DYNAMIC + REAL(EB), INTENT(IN) :: TIME + INTEGER, INTENT(OUT) :: N_VERTS, N_FACES, N_VOLUS -! 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. + 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 -! 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 + IF (IS_DYNAMIC) THEN + DELTA_T = TIME - T_BEGIN + ELSE + DELTA_T = 0.0_EB + ENDIF + 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 -! 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. -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)) + 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 + ENDDO -ENDDO + ! remove this if statement when GEOMCLIPS is ready for use + IF ( I .EQ. 0 ) THEN + CALL GEOMCLIPS + ENDIF -! Loop geometries: -LOOP_GEOM : DO IG = 1, N_GEOMETRY + CALL GEOM2TEXTURE - G=>GEOMETRY(IG) + 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 - ! 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. +END SUBROUTINE PROCESS_GEOM - ! Loop Faces: - DO IWSEL = 0,G%N_FACES-1 - WSELEM(NOD1:NOD3) = G%FACES(3*IWSEL+1:3*IWSEL+3) +! ---------------------------- GEOM2TEXTURE ---------------------------------------- - ! 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 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 - G%MAX_LEDGE = MAX(G%MAX_LEDGE,LEDGE) - G%MIN_LEDGE = MIN(G%MIN_LEDGE,LEDGE) - G%MEAN_LEDGE= G%MEAN_LEDGE + LEDGE + 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) - 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/). + 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 - ! 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. +END SUBROUTINE GEOM2TEXTURE - ! Now define Bin sizes to distribute Faces subsets: - DO X1AXIS=IAXIS,KAXIS - - ! 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 +! ---------------------------- MERGE_GEOMS ---------------------------------------- - ! Define number of bins in direction X1AXIS: - G%TBAXIS(X1AXIS)%N_BINS = CEILING(LX1/(GAMMA_MULT*G%MEAN_LEDGE)) +SUBROUTINE MERGE_GEOMS(VERTS,N_VERTS,FACES,TFACES,GEOM_IDS,SURF_IDS,N_FACES,VOLUS,MATL_IDS,N_VOLUS,IS_DYNAMIC) - ! No overlap between procs meshes and Geometry, cycle: - IF (G%TBAXIS(X1AXIS)%N_BINS < 1) THEN; G%TBAXIS(X1AXIS)%N_BINS = 0; CYCLE; ENDIF +! combine vectors and faces found on all &GEOM lines into one set of VECTOR and FACE arrays - 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))) +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) - ! 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)) +INTEGER :: I +TYPE(GEOMETRY_TYPE), POINTER :: G +INTEGER :: IVERT, ITFACE, IFACE, IVOLUS, IMATL, IGEOM, ISURF, OFFSET - ! 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 +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 - ! 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 + 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 - ENDDO - END DO + TFACES(1+ITFACE:6*G%N_FACES + ITFACE) = G%TFACES(1:6*G%N_FACES) + ITFACE = ITFACE + 6*G%N_FACES - ! 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 + GEOM_IDS(1+IGEOM:G%N_FACES+IGEOM) = I + IGEOM = IGEOM + G%N_FACES -ENDDO LOOP_GEOM + 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 -RETURN -END SUBROUTINE GET_GEOM_TRIBIN + 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 +END SUBROUTINE MERGE_GEOMS -! --------------------------- SNAP_GEOM_NODES -------------------------------------- +! ---------------------------- CONVERTGEOM ---------------------------------------- -SUBROUTINE SNAP_GEOM_NODES +SUBROUTINE CONVERTGEOM(TIME) -INTEGER :: IBIN,IWSELDUM,IWSEL,WSELEM(NOD1:NOD3),X1LO,X1HI,X1IND,ILO_BIN,IHI_BIN -REAL(EB):: MIN_MESHGEOM,DELBIN -REAL(EB) :: CPUTIME_START, CPUTIME +REAL(EB), INTENT(IN) :: TIME -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 +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 -! 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 +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 -! Now mesh loop on mesh + guard planes to test against. -! Main Loop over Meshes: -MAIN_MESH_LOOP : DO NM=1,NMESHES +N_VERTS = N_VERTS_S + N_VERTS_D +N_FACES = N_FACES_S + N_FACES_D +N_VOLUS = N_VOLUS_S + N_VOLUS_D - 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 +ALLOCATE(VERTS(MAX(1,3*N_VERTS)),STAT=IZERO) ! create arrays to contain all vertices and faces +CALL ChkMemErr('CONVERTGEOM','VERTS',IZERO) - 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 +ALLOCATE(TFACES(MAX(1,6*N_FACES)),STAT=IZERO) ! create arrays to contain all vertices and faces +CALL ChkMemErr('CONVERTGEOM','TVERTS',IZERO) - ! 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 +ALLOCATE(FACES(MAX(1,3*N_FACES)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','FACES',IZERO) - DEALLOCATE(X1FACE,DX1FACE) +ALLOCATE(SURF_IDS(MAX(1,N_FACES)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','SURF_IDS',IZERO) - ENDDO AXIS_LOOP_2 - CALL DEFINE_XYZFACE_CELL(ALLOC_FLG=.FALSE.) -ENDDO MAIN_MESH_LOOP +ALLOCATE(GEOM_IDS(MAX(1,N_FACES)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','SURF_IDS',IZERO) +ALLOCATE(VOLUS(MAX(1,4*N_VOLUS)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','VOLUS',IZERO) -! Deallocate SNAP_NODE in geometries: -DO IG=1,N_GEOMETRY - DEALLOCATE(GEOMETRY(IG)%SNAP_NODE) -ENDDO +ALLOCATE(MATL_IDS(MAX(1,N_VOLUS)),STAT=IZERO) +CALL ChkMemErr('CONVERTGEOM','MATL_IDS',IZERO) -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.' +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 -END SUBROUTINE SNAP_GEOM_NODES - -END SUBROUTINE SET_CUTCELLS_3D +RETURN +END SUBROUTINE CONVERTGEOM -SUBROUTINE ACCUMULATE_BLOCKING_BODTRI(BODTRI_FACE,FACE_AREA,COUNT,BODTRI_ACC,AREA_ACC) +! ---------------------------- REORDER_FACE ---------------------------------------- -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 +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) -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) +INTEGER :: VERTS_TEMP(5) -END SUBROUTINE ACCUMULATE_BLOCKING_BODTRI +IF ( VERTS(1) 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 +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 -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 + CALL PROCESS_GEOM(IS_DYNAMIC,TIME,N_VERTS, N_FACES, N_VOLUS) ! scale, rotate, translate GEOM vertices + + ALLOCATE(VERTS(MAX(1,3*N_VERTS)),STAT=IZERO) ! create arrays to contain all vertices and faces + CALL ChkMemErr('OUTGEOM','VERTS',IZERO) + + ALLOCATE(TFACES(MAX(1,6*N_FACES)),STAT=IZERO) + CALL ChkMemErr('OUTGEOM','VERTS',IZERO) + + ALLOCATE(FACES(MAX(1,3*N_FACES)),STAT=IZERO) + CALL ChkMemErr('OUTGEOM','FACES',IZERO) + + ALLOCATE(GEOM_IDS(MAX(1,N_FACES)),STAT=IZERO) + CALL ChkMemErr('OUTGEOM','GEOM_IDS',IZERO) + + ALLOCATE(SURF_IDS(MAX(1,N_FACES)),STAT=IZERO) + CALL ChkMemErr('OUTGEOM','SURF_IDS',IZERO) + + ALLOCATE(VOLUS(MAX(1,4*N_VOLUS)),STAT=IZERO) + CALL ChkMemErr('OUTGEOM','VOLUS',IZERO) + + ALLOCATE(MATL_IDS(MAX(1,N_VOLUS)),STAT=IZERO) + CALL ChkMemErr('OUTGEOM','MATL_IDS',IZERO) + + 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 + + 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 - 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) + 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) -END SUBROUTINE GET_BLOCKING_CUTCELL_DONOR + 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 +END SUBROUTINE OUTGEOM -LOGICAL FUNCTION VALID_GEOMETRY_FACE_DONOR(IBOD,IWSEL) +! ---------------------------- WRITE_GEOM_ALL ------------------------------------ -INTEGER, INTENT(IN) :: IBOD,IWSEL +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 -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. +! ---------------------------- WRITE_GEOM ---------------------------------------- -END FUNCTION VALID_GEOMETRY_FACE_DONOR +SUBROUTINE WRITE_GEOM(TIME) -! ----------------------- CHECK_WALL_CELL_PLANE_MATCH ---------------------------- +! output geometries to a .ge file -SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH +REAL(EB), INTENT(IN) :: TIME +INTEGER :: ONE=1, ZERO=0, VERSION=2 +TYPE(TRANSFORM_TYPE), POINTER :: T -! 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. +IF (N_GEOMETRY<=0) RETURN -USE MPI_F08 +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)) -! 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 +WRITE_GEOM_FIRST = .FALSE. -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 +END SUBROUTINE WRITE_GEOM -! 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 +! ---------------------------- TRIANGLE_AREA ---------------------------------------- -! ----------------------- EXCHANGE_CC_NOADVANCE_INFO ---------------------------- +REAL(EB) FUNCTION TRIANGLE_AREA(V1,V2,V3) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO +REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3) +REAL(EB) :: N(3),R1(3),R2(3) - INTEGER :: NM,I,J,K,ICC,JCC,IBOD_DONOR,ITRI_DONOR,NPACK,ICELL - TYPE(MESH_TYPE), POINTER :: M +R1 = V2-V1 +R2 = V3-V1 +CALL CROSS_PRODUCT(N,R1,R2) - ! 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: - NPACK = M%N_CC_ELIMINATED - DO ICC=1,MESHES(NM)%N_CUTCELL_MESH - CC => M%CUT_CELL(ICC) - DO JCC=1,CC%NCELL - 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 - 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)) - ! Fill in blocked cut-cell info: - M%N_CC_BLOCKED = 0 - DO ICC=1,MESHES(NM)%N_CUTCELL_MESH - 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) = (/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 +REAL(EB), INTENT(IN) :: P(3),BB(6) +INTEGER, INTENT(IN) :: IOR -! ----------------------- EXCHANGE_CC_BLOCKED_LISTS ----------------------------- +POINT_IN_BOX_2D=.FALSE. -SUBROUTINE EXCHANGE_CC_BLOCKED_LISTS +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 - USE MPI_F08 - INTEGER :: NM,NOM,N,IERR - TYPE (MPI_REQUEST), ALLOCATABLE, DIMENSION(:) :: REQ0,REQ0DUM - INTEGER :: N_REQ0 - LOGICAL :: PROCESS_SENDREC +END FUNCTION POINT_IN_BOX_2D - 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) +! ---------------------------- POINT_IN_TETRAHEDRON ---------------------------------------- - ! 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(4,MESHES(NM)%N_CC_BLOCKED)) - ENDIF - ENDDO +LOGICAL FUNCTION POINT_IN_TETRAHEDRON(XP,V1,V2,V3,V4,BB) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - ! 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),4*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),4*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) :: 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 - ! Deallocate REQ0: - IF(ALLOCATED(REQ0)) DEALLOCATE(REQ0) - 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. - 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) +POINT_IN_TETRAHEDRON=.FALSE. + +! first test bounding box + +IF (XP(1)BB(2)) RETURN +IF (XP(2)BB(4)) RETURN +IF (XP(3)BB(6)) RETURN + +POINT_IN_TETRAHEDRON=.TRUE. + +FACE_LOOP: DO I=1,4 + + 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 + + ! 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 - END SUBROUTINE CHECK_REQ0_SIZE -END SUBROUTINE EXCHANGE_CC_BLOCKED_LISTS -! ----------------------- REGISTER_ELIMINATED_CUTCELL --------------------------- +ENDDO FACE_LOOP -SUBROUTINE REGISTER_ELIMINATED_CUTCELL(NM,ICC,JCC) +END FUNCTION POINT_IN_TETRAHEDRON -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 +! ---------------------------- VALID_TRIANGLE ---------------------------------------- -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 +LOGICAL FUNCTION VALID_TRIANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3,VERT_FLAG) -! ----------------------- BLOCK_SMALL_UNLINKED_CUTCELLS ---------------------------- +INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3, VERT_FLAG(0:300) +REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) -SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS(NM,NBLKCELLS) +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 -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(OUT):: NBLKCELLS +INTEGER :: I -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 +VALID_TRIANGLE = .FALSE. -M => MESHES(NM) -NBLKCELLS = 0 +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(DEBUG_SET_CUTCELLS) THEN +U1 = V2 - V1; +U2 = V3 - V2; - ! 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) +! triangle is invalid if angle at V2 is > 180 deg - 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) +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 -! 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 +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 -! 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 +VALID_TRIANGLE = .TRUE. +END FUNCTION VALID_TRIANGLE -! 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) +! ----------------------------- DIFF_ANGLE ----------------------------------------- - 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) +LOGICAL FUNCTION DIFF_ANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3, ABS_FLG) - 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) +INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3 +REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) +LOGICAL, INTENT(IN) :: ABS_FLG - 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) +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. +DIFF_ANGLE = .FALSE. - 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) +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) - 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 +U1 = V2 - V1; +U2 = V3 - V2; -RETURN -END SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS +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) -! ------------------------- GET_REMAINING_CUTCELLS -------------------------------- +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 -! Define regular cut-cells for regular cartesian cells surrounded by a gas cut-face. -INTEGER, INTENT(IN) :: NM +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. -! 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. +RETURN -M => MESHES(NM) +END FUNCTION DIFF_ANGLE -! 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 +! ---------------------------- POINT_IN_TRIANGLE_FB ---------------------------------------- -IF (OPT) THEN +LOGICAL FUNCTION POINT_IN_TRIANGLE_FB(P_FB,V1_FB,V2_FB,V3_FB) -NCC_MESH = M%N_CUTCELL_MESH -NGC_MESH = M%N_GCCUTCELL_MESH +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) -! 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 + 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) -! 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 +END FUNCTION POINT_IN_TRIANGLE_FB -! 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) +! ---------------------------- POINT_IN_TRIANGLE ---------------------------------------- -! 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 +LOGICAL FUNCTION POINT_IN_TRIANGLE(P,V1,V2,V3) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - ! 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 +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 - 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 +! 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. - ! 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 +POINT_IN_TRIANGLE=.TRUE. ! start by assuming the point is inside - ! 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 +! compute face normal +E1 = V2-V1 +E2 = V3-V1 +CALL CROSS_PRODUCT(N,E1,E2) - ! 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 +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 -M%N_CUTCELL_MESH = NCC_MESH + NCELL_IN -M%N_GCCUTCELL_MESH = NGC_MESH + NCELL_GC +END FUNCTION POINT_IN_TRIANGLE -ELSE +! ---------------------------- TRIANGULATE ---------------------------------------- -! 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 +SUBROUTINE TRIANGULATE(DIR,VERTS,NVERTS,VERT_OFFSET,FACES,LOCTYPE) - ! 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, 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) - 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 :: 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 - ! 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 +INTEGER :: HIDEDGE(3), EDGEI(1:2), NVERTS2, NEDGES, COUNT +INTEGER, PARAMETER :: SHFT_NODE(1:4) = (/ 2, 1, 0, 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 - ENDIF +INTEGER :: COUNT_OUT - ! 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 +FLAG = .TRUE. -ENDIF +! 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) -END SUBROUTINE GET_REMAINING_CUTCELLS +! 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 +! Redo List: +NLIST = SUM(VERT_FLAG(1:NVERTS)) -! ------------------------- GET_REMAINING_CUTFACES -------------------------------- +IF (NLIST < 3) THEN + FACES(1:3*(NVERTS-2)) = VERT_OFFSET + 1 + LOCTYPE(1:NVERTS-2) = 4+8+16 + RETURN +ENDIF -SUBROUTINE GET_REMAINING_CUTFACES(NM) +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) -! Running by axes define regular cut-faces, add to CUT_FACE array. +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 -INTEGER, INTENT(IN) :: NM +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 -! 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. - -M => MESHES(NM) - -IF (OPT) THEN - -NBD_MESH = M%N_BBCUTFACE_MESH -NCF_MESH = M%N_CUTFACE_MESH -NGF_MESH = M%N_GCCUTFACE_MESH + ! 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 -! 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 +! 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 -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 + VERT_LIST(0) = VERT_LIST(NLIST) + 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 + 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 - ENDDO + IF (NLIST == 3) EXIT OUTER + ENDIF 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 + 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 - ENDDO -ENDDO + VERT_LIST(0) = VERT_LIST(NLIST) + VERT_LIST(NLIST+1) = VERT_LIST(1) + NODE_EXISTS(1:NLIST+1) = .TRUE. + ENDIF +ENDDO OUTER -! 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 +! 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 -! 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 +RETURN +END SUBROUTINE TRIANGULATE -! 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 +! ---------------------------- TRILINEAR ---------------------------------------- -! 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 +REAL(EB) FUNCTION TRILINEAR(UU,DXI,LL) -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), INTENT(IN) :: UU(0:1,0:1,0:1),DXI(3),LL(3) +REAL(EB) :: XX,YY,ZZ -ELSE +! 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) +! +!=========================================================== -! 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 +XX = DXI(1)/LL(1) +YY = DXI(2)/LL(2) +ZZ = DXI(3)/LL(3) -! 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 +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 -! 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 +END FUNCTION TRILINEAR -ENDIF +! ---------------------------- RAY_TRIANGLE_INTERSECT_PT ---------------------------------------- -END SUBROUTINE GET_REMAINING_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. -! ---------------------- CUT_CELL_FACE_ARRAYS_CLEANUP ----------------------------- +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 CUT_CELL_FACE_ARRAYS_CLEANUP(NM) +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 +! Schneider and Eberly, Section 11.1 +IS_INTERSECT = .FALSE. +POS(1:3) = 1._EB/TWENTY_EPSILON_EB -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 +E1 = V2-V1 +E2 = V3-V1 -! 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 +CALL CROSS_PRODUCT(P,D,E2) -! 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 +TMP = DOT_PRODUCT(P,E1) -! 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 ( ABS(TMP)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 - -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 +U = TMP*DOT_PRODUCT(S,P) +IF (U<-EPS .OR. U>(1._EB+EPS)) RETURN ! No intersection. -! 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 +CALL CROSS_PRODUCT(Q,S,E1) +V = TMP*DOT_PRODUCT(D,Q) +IF (V<-EPS .OR. (U+V)>(1._EB+EPS)) RETURN ! No intersection. -! Invalidate CCVAR at (I,J,K) pointing at cut-cells dropped from the active pool: -DO K=-CCGUARD,M%KBAR+CCGUARD - DO J=-CCGUARD,M%JBAR+CCGUARD - DO I=-CCGUARD,M%IBAR+CCGUARD - ICC = M%CCVAR(I,J,K,CC_IDCC) - IF (ICC < 1) CYCLE - IF (ICC > M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH) THEN - M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID - M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED - ELSEIF (M%CUT_CELL(ICC)%NCELL < 1 .OR. & - M%CUT_CELL(ICC)%IJK(IAXIS) /= I .OR. & - M%CUT_CELL(ICC)%IJK(JAXIS) /= J .OR. & - M%CUT_CELL(ICC)%IJK(KAXIS) /= K) THEN - M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID - M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED - ENDIF - ENDDO - ENDDO -ENDDO +T = TMP*DOT_PRODUCT(E2,Q) +IF (T <= 0._EB) RETURN ! No intersection. -DEALLOCATE(CCIND,CFIND) +IS_INTERSECT = .TRUE. +POS = XP + T*D ! the intersection point RETURN -END SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP +END SUBROUTINE RAY_TRIANGLE_INTERSECT_PT -! ---------------------------- BLOCK_CUT_CELL ------------------------------------- +! ---------------------------- POINT_IN_BB ---------------------------------------- -SUBROUTINE BLOCK_CUT_CELL(NM,ICC,JCC,BLOCK_PHASE) +LOGICAL FUNCTION POINT_IN_BB(V1,BB) -! 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. +REAL(EB), INTENT(IN) :: V1(3),BB(6) -INTEGER, INTENT(IN) :: NM,ICC,JCC,BLOCK_PHASE +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 -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(:,:) :: EDGE_LIST_AUX,CEDGES_AUX,CEDGES_AUX2,FACE_LIST_DROPPED -INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM -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) +RETURN +END FUNCTION POINT_IN_BB -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: -CALL GET_BLOCKING_CUTCELL_DONOR(NM,ICC,JCC,IBOD,ITRI) +! ---------------------------- POLYGON_AREA ---------------------------------------- -! 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 +REAL(EB) FUNCTION POLYGON_AREA(NP,PC) +! Calculate the area of a polygon -! 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 +INTEGER, INTENT(IN) :: NP +REAL(EB), INTENT(IN) :: PC(60) +INTEGER :: I,K +REAL(EB) :: V1(3),V2(3),V3(3) -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) +POLYGON_AREA = 0._EB +V3 = POLYGON_CENTROID(NP,PC) - 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 +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 - ! 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 +RETURN +END FUNCTION POLYGON_AREA - ! 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 +! ---------------------------- POLYGON_CENTROID ---------------------------------------- - 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 +REAL(EB) FUNCTION POLYGON_CENTROID(NP,PC) +! Calculate the centroid of polygon vertices - 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 +DIMENSION :: POLYGON_CENTROID(3) +INTEGER, INTENT(IN) :: NP +REAL(EB), INTENT(IN) :: PC(60) +INTEGER :: I,K - ! 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 +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 - 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 +RETURN +END FUNCTION POLYGON_CENTROID - 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.) +! ---------------------------- INTERSECT_SPHERE_AABB ---------------------------------------- - ! 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 +! Algorithm from Schneider and Eberly, p. 644 +! Intersection of Sphere and Axis-Aligned Bounding Box - 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.) +LOGICAL FUNCTION INTERSECT_SPHERE_AABB(X0,RADIUS,XB) - ! 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 +REAL(EB), INTENT(IN) :: X0(3),RADIUS,XB(6) +REAL(EB) :: DIST_SQUARED - 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.) +INTERSECT_SPHERE_AABB=.TRUE. - ! 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 +! 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 - END SELECT +! Compare squared distance to radius squared +IF (DIST_SQUARED > (RADIUS*RADIUS-TWENTY_EPSILON_EB)) INTERSECT_SPHERE_AABB=.FALSE. +RETURN +END FUNCTION INTERSECT_SPHERE_AABB - ! 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 +! ---------------------------- INTERSECT_CYLINDER_AABB ---------------------------------------- - ! 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 +! 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 - ! 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 FUNCTION INTERSECT_CYLINDER_AABB(X_IN,H,RADIUS,ROTMAT,XB) - 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 +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 - ! 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 +INTERSECT_CYLINDER_AABB=.FALSE. - CASE(CC_FTYPE_CFGAS) +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 - ! 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) - 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))) - 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) +! 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 - ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: - EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) +RETURN +END FUNCTION INTERSECT_CYLINDER_AABB - ! 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 +! ---------------------------- ROTATION_MATRIX ---------------------------------------- - 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 +SUBROUTINE ROTATION_MATRIX(R_OUT,A_IN,THETA) +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - ! 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 +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) - ! 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) +! 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 - ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: - EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) +! initialize R_OUT as 2D rotation matrix +R_OUT = R_THETA - ! 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 +! normalize input vector +DENOM = SQRT(DOT_PRODUCT(A_IN,A_IN)) +IF (DENOM 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) +IF (DOT_PRODUCT(V,V)0._EB) THEN + RETURN + ELSE + R_OUT = -R_OUT + RETURN + ENDIF +ENDIF - ! 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) +! find orthnormal basis for A=A3 in old system - ! 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 +A3 = A +CALL CROSS_PRODUCT(A2,B3,A3) +CALL CROSS_PRODUCT(A1,A2,A3) -ENDDO IFC_LOOP +! rotation matrix (direction cosines), Pope (2000), Eq. (A.11) -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 +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) -ELSEIF(BLOCK_PHASE==2) THEN BLOCK_PHASE_IF +R_OUT = MATMUL(R_OUT,R_THETA) -! 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) +! ! test +! print *,R_OUT(1,:) +! print *,R_OUT(2,:) +! print *,R_OUT(3,:) +! print *,MATMUL(R_OUT,A) ! result should be B3 +! stop - 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 +END SUBROUTINE ROTATION_MATRIX - 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 +! ---------------------------- INTERSECT_CONE_AABB ---------------------------------------- - 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 +! This routine basically follows the INTERSECT_CYLINDER_AABB algorithm, with radius = R(Z) - ENDIF FACE_TYPE_IF_2 +LOGICAL FUNCTION INTERSECT_CONE_AABB(X_IN,H,RADIUS,ROTMAT,XB) - 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 +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 - 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 +INTERSECT_CONE_AABB=.FALSE. - 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 +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 - 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 +! 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 - ! 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) +RETURN +END FUNCTION INTERSECT_CONE_AABB - ! 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 +! ---------------------------- INTERSECT_OBB_AABB ---------------------------------------- - ! 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) +! Intersect an Oriented Bounding Box (OBB) with an Axis-Aligned Bounding Box (AABB) +! First, rotate AABB into OBB frame. +! Then test each vertex. - END SELECT +LOGICAL FUNCTION INTERSECT_OBB_AABB(X_IN,L,W,H,ROTMAT,XB) -ENDDO IFC_LOOP_2 +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 -ELSEIF(BLOCK_PHASE==3) THEN BLOCK_PHASE_IF +INTERSECT_OBB_AABB=.FALSE. -! 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) +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 -ENDIF BLOCK_PHASE_IF +! 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) (RADIUS*RADIUS+TWENTY_EPSILON_EB)) IN_SPHERE_PT=.FALSE. +END FUNCTION IN_SPHERE_PT -IEDGE=JCF2 ! Dummy for now FACE_LIST not filled for ETYPE_CFINB edges. +! ---------------------------- IN_CYLINDER_PT ---------------------------------------- -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. +LOGICAL FUNCTION IN_CYLINDER_PT(X_IN,H,RADIUS,ROTMAT,XP) - ! 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 +REAL(EB), INTENT(IN) :: X_IN(3),H,RADIUS,ROTMAT(3,3),XP(3) +REAL(EB) :: X(3),U(3),DUX(2),R2,DIST_SQUARED +IN_CYLINDER_PT=.FALSE. +X = MATMUL(ROTMAT,X_IN) ! transform center +R2 = RADIUS*RADIUS +U = MATMUL(ROTMAT,XP) +IF (U(3)>X(3)-TWENTY_EPSILON_EB .AND. U(3)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) +IN_CONE_PT=.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 +U = MATMUL(ROTMAT,XP) +IF (U(3)>Z0-TWENTY_EPSILON_EB .AND. U(3)X(1)+0.5_EB*L+TWENTY_EPSILON_EB) RETURN +IF (U(2)X(2)+0.5_EB*W+TWENTY_EPSILON_EB) RETURN +IF (U(3)X(3)+0.5_EB*H+TWENTY_EPSILON_EB) RETURN +IN_OBB_PT = .TRUE. -M=>MESHES(NM) -IF(M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG)==CC_SOLID) RETURN +END FUNCTION IN_OBB_PT -! 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 -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 +! ---------------------------- AVERAGE_FACE_VALUES ---------------------------------------- -! 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) +! for each node, compute the average values of faces connected to that node -NEDGE = M%CUT_EDGE(CEI)%NEDGE+1 -CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) +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) -! 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 /) +INTEGER, DIMENSION(:), POINTER :: V +INTEGER :: I +INTEGER :: COUNT(NVERTS) -! Add edge: Assumes XV1 < XV2 in X1AXEG direction: -M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) +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 -M%CUT_EDGE(CEI)%NVERT = NVERT -M%CUT_EDGE(CEI)%NEDGE = NEDGE +END SUBROUTINE AVERAGE_FACE_VALUES -! 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 -END SUBROUTINE ADD_CUTEDGE_TO_EDGE +! ---------------------------- MAKE_UNIQUE_VERT_ARRAY ---------------------------------------- -! --------------------------- REPL_CUTEDGE_IN_LIST_EDGES --------------------------- +! construct an array that points to first vertex in a vertex array when one or more vertices are identical -SUBROUTINE REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,IEC,JEC,LOHI,AXIS) +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, INTENT(IN) :: NM,ICF,IEC,JEC,LOHI,AXIS -INTEGER :: IEDGE,DUM +INTEGER :: PERM(NVERTS) +INTEGER :: I, RESULT -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 +DO I = 1, NVERTS + PERM(I) = I + VERT_UNIQUE(I) = I +ENDDO +CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, 1, NVERTS) -! ------------------------------ ADD_REGEDGE_TO_FACE ------------------------------- +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 -SUBROUTINE ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD,XV1,XV2,CEI,NEDGE,IV_LIST) +END SUBROUTINE MAKE_UNIQUE_VERT_ARRAY +! ---------------------------- COMPARE_VERTS ---------------------------------------- -! ILHF -1 face in low side of edge, 0 face on high side of edge. +! returns -1, 0, 1 when a vertex I is less than, the same or greater than vertex J -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 +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 -! 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 +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 -! 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) +! ---------------------------- MAKE_PERMUTATION_ARRAY ---------------------------------------- -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) +! 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 -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 +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 -M%CUT_EDGE(CEI)%NVERT = NVERT -M%CUT_EDGE(CEI)%NEDGE = NEDGE +INTEGER :: MID, I, I1, I2, IP1, IP2, N, N1, N2 -M%CUT_EDGE(CEI)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) +IF (FIRST .EQ. LAST)RETURN ! only one element in list so don't need to sort -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 +! FIRST .... LAST original list +! FIRST ... MID first half of list +! MID+1 ... LAST 2nd half of list -END SUBROUTINE ADD_REGEDGE_TO_FACE +MID = (FIRST + LAST)/2 +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 -! --------------------------------- DROP_REG_FACE ------------------------------------------- +! 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 -SUBROUTINE DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) + 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 -INTEGER, INTENT(IN) :: NM,I,J,K,ILHF,X1AXIS + 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 -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 +END SUBROUTINE MAKE_PERMUTATION_ARRAY -END SUBROUTINE DROP_REG_FACE +END MODULE COMPLEX_GEOMETRY -! --------------------------- INSERT_CUT_CELL ----------------------------------------------- +!> \brief Grid related complex-geometry routines. -SUBROUTINE INSERT_CUT_CELL(NM,I,J,K,ICC) +MODULE COMPLEX_GEOMETRY_GRID -! 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 +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: GEOMEPS,LOOSEPS,NGUARD,CCGUARD,CC_INBOUNDCC,CC_INBOUNDCF,CC_GASPHASE, & + 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, & + 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 -INTEGER :: DUM,KDUM,JDUM,IDUM,ICF,JCF +IMPLICIT NONE (TYPE,EXTERNAL) +PRIVATE -TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX +INTEGER :: LU_DB_SETCC -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 +! Engage NOADVANCE for small cut-cells to be dropped: +LOGICAL, PARAMETER :: DO_NOADVANCE = .TRUE. -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 +! 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 INSERT_CUT_CELL +! Auxiliary variables: +REAL(EB), PARAMETER :: GAMMA_MULT = 1._EB +INTEGER, PARAMETER :: DELTA_TBIN = 200, DELTA_SEGBIN = 50 -! --------------------------- INSERT_CUT_FACE ----------------------------------------------- +INTEGER, ALLOCATABLE, DIMENSION(:) :: SPCELLS_TO_BLOCK, SPCELLS_TO_BLOCK_AUX +INTEGER :: N_SPCELLS_TO_BLOCK -SUBROUTINE INSERT_CUT_FACE(NM,I,J,K,AXIS,ICF,INZONE) +! Per-mesh pending flag for iterative refinement-interface blocking re-scan: +LOGICAL, ALLOCATABLE, DIMENSION(:) :: FM_PENDING_BLOCK_SCAN -! 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 +! 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 (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 -INTEGER :: ICC,JCC,IFC,IFACE,IFCX,DUM,IDUM,JDUM,KDUM,X1AXIS,ICE,ILOC,IEDGE -TYPE(CC_CUTFACE_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_FACE_AUX +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTFACE_TYPE), POINTER :: CF +TYPE(CC_CUTEDGE_TYPE), POINTER :: CE -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 +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 -! 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) +!> 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 -! 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 +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 -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/) +INTEGER, SAVE :: N_CUTCELLS_PROC=0, N_INB_CUTFACES_PROC=0, N_REG_CUTFACES_PROC=0 -RETURN -END SUBROUTINE INSERT_CUT_FACE +! 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 -! --------------------------------- DROP_CUT_EDGE ------------------------------------------- +! 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 -SUBROUTINE DROP_CUT_EDGE(NM,ICE,JCE,ETYPE) +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)). -INTEGER, INTENT(IN) :: NM,ICE,JCE,ETYPE +! 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 -INTEGER :: CT,DUM,ILH,ICF1,IEDGE -INTEGER, ALLOCATABLE, DIMENSION(:) :: IND -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTEDGE_TYPE), POINTER :: CE +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. -IF(ICE<1) RETURN -M =>MESHES(NM) -CE=>M%CUT_EDGE(ICE) +! 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) -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) +! Areas per SURF and GEOM: +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: FDS_AREA_GEOM - ! 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 +! 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 +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, & + 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, & + 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 -! ----------------------------- DROP_CUTFACE -------------------------------------- +CONTAINS -SUBROUTINE DROP_CUTFACE(NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC) +! ----------------------- CHECK_WALL_CELL_PLANE_MATCH ---------------------------- -! 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. +SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH -INTEGER, INTENT(IN) :: NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC +! 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. -INTEGER :: CT,DUM,ILH,ICC1,JCC1,IFACE,IFC1,IFACE2 -INTEGER, ALLOCATABLE, DIMENSION(:) :: IND -TYPE(MESH_TYPE), POINTER :: M -TYPE(CC_CUTFACE_TYPE), POINTER :: CF +USE MPI_F08 -M => MESHES(NM) -CF=> M%CUT_FACE(IFC) +! 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 -! 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) +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 - 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)) - ! 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)) & - 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) + ENDDO EXT_WALL_LOOP_1 +ENDDO MESH_LP -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 +! Now All-Reduce mismatch +CALL MPI_ALLREDUCE(MPI_IN_PLACE,BUFF(1,1),2*NMESHES,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR) -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 +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 -ENDIF +ENDDO +DEALLOCATE(BUFF) +END SUBROUTINE CHECK_WALL_CELL_PLANE_MATCH -RETURN -END SUBROUTINE DROP_CUTFACE +! ----------------------- EXCHANGE_CC_NOADVANCE_INFO ---------------------------- +SUBROUTINE EXCHANGE_CC_NOADVANCE_INFO -! ----------------------------- DROP_CUTCELL -------------------------------------- + ! Local Variables: + TYPE(CC_CUTCELL_TYPE), POINTER :: CC + INTEGER :: NM,I,J,K,ICC,JCC,IBOD_DONOR,ITRI_DONOR,NPACK,ICELL + TYPE(MESH_TYPE), POINTER :: M -SUBROUTINE DROP_CUTCELL(NM,ICC,JCC) + ! 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: + NPACK = M%N_CC_ELIMINATED + DO ICC=1,MESHES(NM)%N_CUTCELL_MESH + CC => M%CUT_CELL(ICC) + DO JCC=1,CC%NCELL + 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 + 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)) + ! Fill in blocked cut-cell info: + M%N_CC_BLOCKED = 0 + DO ICC=1,MESHES(NM)%N_CUTCELL_MESH + 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) = (/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) +! ----------------------- EXCHANGE_CC_ELIMINATED_INFO --------------------------- -I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS) +SUBROUTINE EXCHANGE_CC_ELIMINATED_INFO -! 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 - 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 + INTEGER :: NM,ICELL,NPACK + TYPE(MESH_TYPE), POINTER :: M + DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX + CALL POINT_TO_MESH(NM) + M => 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 + 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) + + ! 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(4,MESHES(NM)%N_CC_BLOCKED)) + ENDIF + 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. + 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),4*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),4*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 - 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 + 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 -! 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 + END SUBROUTINE EXCHANGE_CC_BLOCKED_LISTS -M%CUT_CELL(ICC)%NCELL = M%CUT_CELL(ICC)%NCELL - 1 +! ----------------------- REGISTER_ELIMINATED_CUTCELL --------------------------- -DEALLOCATE(IND) +SUBROUTINE REGISTER_ELIMINATED_CUTCELL(NM,ICC,JCC) -RETURN -END SUBROUTINE DROP_CUTCELL +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 -! -------------------------- GET_CELL_LINK_INFO ----------------------------------- +IF (PROCESS(NM)/=MY_RANK) RETURN -SUBROUTINE GET_CELL_LINK_INFO(NM) +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/) -! 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. +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 ----------------------------------- + +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 @@ -8803,17 +5834,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 @@ -8824,7 +5858,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 @@ -8835,22 +5868,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 @@ -8865,54 +5910,111 @@ SUBROUTINE GET_CELL_LINK_INFO(NM) ENDDO ENDDO ENDDO - ENDDO ENDDO ENDDO -! 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. +END SUBROUTINE CC_GRID_SEED_LINK_UNKZ - 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)) +SUBROUTINE GET_ICC2_JCC2(NM,ICC,IFACE,INXT,JNXT,KNXT,ICC2,JCC2) - 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) - 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 - ENDDO +INTEGER, INTENT(IN) :: NM,ICC,IFACE,INXT,JNXT,KNXT +INTEGER, INTENT(OUT):: ICC2, JCC2 - ! 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. +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. +! 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 (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) + 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 + ENDDO + + ! 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) @@ -9049,7 +6151,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 @@ -9058,7 +6160,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 @@ -9067,7 +6169,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 @@ -9122,7 +6224,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 @@ -9349,6 +6423,7 @@ SUBROUTINE BLOCK_CC_SOLID_EXTWALLCELLS(FIRST_CALL) LOGICAL, INTENT(IN) :: FIRST_CALL ! Local variables: +TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC INTEGER :: NM,IW,IIF,JJF,KKF,II,JJ,KK,IOR,X1AXIS TYPE (WALL_TYPE), POINTER :: WC @@ -9413,12 +6488,13 @@ SUBROUTINE INIT_CFACE_CELL(NM,ICF,IFACE,CFACE_INDEX,SURF_INDEX,STAGE_FLG,IS_INB, INTEGER, OPTIONAL, INTENT(IN) :: IW ! Local Variables: +TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC,WC_BC +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 @@ -9553,97 +6629,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 @@ -9732,6 +6742,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 (DIST2 MESHES(NM)%CUT_CELL(ICC) -INTEGER :: WSELEM(NOD1:NOD3), MYAXIS -REAL(EB):: FACECUBE(LOW_IND:HIGH_IND,IAXIS:KAXIS) +! 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) -IG = INDX1 -TNOW = CURRENT_TIME() + 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 -! Now allocate BODINT_PLANE: -BODINT_PLANE%NNODS = 0 -BODINT_PLANE%NSGLS = 0 -BODINT_PLANE%NSEGS = 0 -BODINT_PLANE%NTRIS = 0 + 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 -! Main Loop over Geometries: -MAIN_GEOM_LOOP : DO IG=1,N_GEOMETRY + END SELECT +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)) +END SUBROUTINE CUT_CELL_BOUNDING_BOX - ! 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 +! -------------------------CUT_CELL_ARRAY_REALLOC------------------------------------ - 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 CUT_CELL_ARRAY_REALLOC(NM,ICC) - ! Loop surface triangles: -! DO IWSEL =1,GEOMETRY(IG)%N_FACES - DO IWSELDUM=1,GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%NTL +INTEGER, INTENT(IN) :: NM,ICC - 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 :: ICC1,SIZE_CUT_CELL +TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX - ! 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 +! 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 - 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 +RETURN +END SUBROUTINE CUT_CELL_ARRAY_REALLOC - ! 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 +! ------------------------- CELL_DEALLOC ----------------------------------- - ! Test if IWSEL lays in X1PLN: - IF ( (ABS(DOT1)+ABS(DOT2)+ABS(DOT3)) == 0._EB ) THEN +SUBROUTINE CELL_DEALLOC(NM,ICC) - ! Force nodes location in X1PLN plane: - XYZV(X1AXIS,NOD1:NOD3) = X1PLN +INTEGER, INTENT(IN) :: NM,ICC +INTEGER :: I,J,K - ! 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)) +MESHES(NM)%CUT_CELL(ICC)%NCELL = 0 +IF (.NOT.ALLOCATED(MESHES(NM)%CUT_CELL(ICC)%CCELEM)) THEN + I = MESHES(NM)%CUT_CELL(ICC)%IJK(IAXIS) + J = MESHES(NM)%CUT_CELL(ICC)%IJK(JAXIS) + K = MESHES(NM)%CUT_CELL(ICC)%IJK(KAXIS) + IF (I>=LBOUND(MESHES(NM)%CCVAR,1) .AND. I<=UBOUND(MESHES(NM)%CCVAR,1) .AND. & + J>=LBOUND(MESHES(NM)%CCVAR,2) .AND. J<=UBOUND(MESHES(NM)%CCVAR,2) .AND. & + K>=LBOUND(MESHES(NM)%CCVAR,3) .AND. K<=UBOUND(MESHES(NM)%CCVAR,3)) THEN + IF (MESHES(NM)%CCVAR(I,J,K,CC_IDCC)==ICC) MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED + ENDIF + RETURN +ENDIF - ! 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)) +! 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 (ALLOCATED(MESHES(NM)%CUT_CELL(ICC)%BODTRI_DONOR)) DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%BODTRI_DONOR) - ! 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)) +RETURN - ! 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 /) +END SUBROUTINE CELL_DEALLOC - CYCLE ! Next WSELEM +! -------------------------- NEW_CELL_ALLOC ------------------------------------- - ENDIF +SUBROUTINE NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) - ! 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 +INTEGER, INTENT(IN) :: NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL - ! Line 1, from node 2 to 3: - LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) - LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) +! 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. - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) +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 - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +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 - ! Line 2, from node 1 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) +! -------------------------- ALLOC_CELL_STATE_VARS ------------------------------------- - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) +SUBROUTINE ALLOC_CELL_STATE_VARS(NM,ICC,NCELL) - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +INTEGER, INTENT(IN) :: NM,ICC,NCELL - ! 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 +! 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)) - ! Line 1, from node 1 to 2: - LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) +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 - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) +ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%Q_REAC(1:N_REACTIONS,1:NCELL)) +MESHES(NM)%CUT_CELL(ICC)%Q_REAC = 0._EB - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +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 - ! Line 2, from node 1 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) +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)) - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) +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 - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +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 - ! 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 /) +RETURN - CYCLE ! Next WSELEM +END SUBROUTINE ALLOC_CELL_STATE_VARS - 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 +SUBROUTINE SET_CVS_3D - ! Line 1, from node 1 to 2: - LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) +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. - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) +! Skeleton for the future control-volume driver. +! +! 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 + +! Phase 2: build mesh-owned GCELL map from raw cut-cell data. +CALL CC_GRID_BUILD_GCELLS +! +! Future: +! BLOCK ONLY INVALID/SPECIAL CELLS +! BUILD FACE TOPOLOGY +! BUILD IDENTITY CVS +! APPLY SAME-MESH AND INTER-MESH CV LINKING - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +RETURN +END SUBROUTINE SET_CVS_3D - ! Line 2, from node 2 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) +SUBROUTINE SET_CUTCELLS_3D +#ifdef WITHOUT_MPIF08 +USE MPI +#else +USE MPI_F08 +#endif - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) +INTEGER :: ISTR, IEND, JSTR, JEND, KSTR, KEND +INTEGER :: NM - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +! Miscellaneous: +LOGICAL, ALLOCATABLE, DIMENSION(:) :: CC_COMPUTE_MESH +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_ZMAX_AUX - ! 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 /) +REAL(EB) :: TNOW - CYCLE ! Next WSELEM +LOGICAL :: EARLY_RETURN_FROM_SET_CUTCELLS - ENDIF +INTEGER, SAVE :: CALL_COUNT = 0 - ! 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 +! GET_CUTCELL_VERBOSE variables: +REAL(EB) :: CPUTIME_START_MESH +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW - ! First node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN +LOGICAL, SAVE :: FIRST_CALL_ARG=.TRUE., FIRST_CALL_ARG2=.TRUE. +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 - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +POSTBUILD_MESH_LOOP : DO NM=1,NMESHES + 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 - ! 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 +CALL CC_GRID_EXCHANGE_AND_REBLOCK(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) - CYCLE ! Next WSELEM +MAIN_MESH_LOOP_3 : DO NM=1,NMESHES + CALL CC_GRID_POSTPROCESS_AND_CLEANUP(NM,CC_COMPUTE_MESH,GEOM_AREA_SURF_NEW) +ENDDO MAIN_MESH_LOOP_3 - 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 +! 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,CC_COMPUTE_MESH) +ENDDO MAIN_MESH_LOOP_4 - ! Second node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN +CALL CC_GRID_LOG_PROCESSING_TIME(TNOW,CPUTIME_START_MESH) - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +CALL CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST(GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) - ! 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 +! Fill Guardcells for CCVAR CC_CGSC and CUT_CELL for meshes assigned to MPI process: +CALL SET_GC_CUTCELLS_3D - CYCLE ! Next WSELEM +! Allocate and define entries for solid side CFACES: +IF(PERIODIC_TEST/=105) CALL GET_EXT_INB_CUTFACES_TO_CFACE - 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 +CALL CC_GRID_FINALIZE_BOOKKEEPING(CC_COMPUTE_MESH,CALL_COUNT,EARLY_RETURN_FROM_SET_CUTCELLS) +IF (EARLY_RETURN_FROM_SET_CUTCELLS) RETURN - ! Third node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN +CALL CC_GRID_WRITE_VERBOSE_SUMMARY - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +RETURN - ! 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 +END SUBROUTINE SET_CUTCELLS_3D - CYCLE ! Next WSELEM +! ------------- Refinement-interface blocking helpers (ported from master) ------------- - ENDIF +LOGICAL FUNCTION VALID_GEOMETRY_FACE_DONOR(IBOD,IWSEL) - ! 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 +INTEGER, INTENT(IN) :: IBOD,IWSEL - ! First node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN +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. - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +END FUNCTION VALID_GEOMETRY_FACE_DONOR - ! Line 2, from node 2 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) +SUBROUTINE ACCUMULATE_BLOCKING_BODTRI(BODTRI_FACE,FACE_AREA,COUNT,BODTRI_ACC,AREA_ACC) - 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)) +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 - ! 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 /) +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) - CYCLE ! Next WSELEM +END SUBROUTINE ACCUMULATE_BLOCKING_BODTRI - 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 +SUBROUTINE GET_BLOCKING_CUTCELL_DONOR(NM_LOC,ICC_LOC,JCC_LOC,IBOD_OUT,ITRI_OUT) - ! Second node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN +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 - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +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 - ! Line 2, from node 1 to 3: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) +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) - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) +END SUBROUTINE GET_BLOCKING_CUTCELL_DONOR - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +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 - ! 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 /) +SUBROUTINE GET_FINE_CELL_FROM_COARSE_WALL(IOR_COARSE,IIO_LOC,JJO_LOC,KKO_LOC,I_FINE,J_FINE,K_FINE) - CYCLE ! Next WSELEM +INTEGER, INTENT(IN) :: IOR_COARSE,IIO_LOC,JJO_LOC,KKO_LOC +INTEGER, INTENT(OUT) :: I_FINE,J_FINE,K_FINE - 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 +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 - ! Third node is an intersection point: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN +SUBROUTINE GET_REFINEMENT_CELL_DONOR(NM_LOC,I_LOC,J_LOC,K_LOC,IBOD_OUT,ITRI_OUT) - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +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 - ! Line 2, from node 1 to 2: - LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) - LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) +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 - CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) +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 - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +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 - ! 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 /) +LOGICAL FUNCTION FACE_INDEX_IN_BOUNDS(NM_LOC,I_LOC,J_LOC,K_LOC,AX_LOC) - CYCLE ! Next WSELEM +INTEGER, INTENT(IN) :: NM_LOC,I_LOC,J_LOC,K_LOC,AX_LOC - ENDIF - ENDIF ONLY_TRIANG_EDGES_COND - - ! 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 +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 - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +SUBROUTINE TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT(NM_LOC,I_LOC,J_LOC,K_LOC,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR,CELL_CHANGED) - ! Second node: - XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT2(X1AXIS) = X1PLN +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/)) - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +CELL_CHANGED = .FALSE. +MT => MESHES(NM_LOC) - ! 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 /) +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 - CYCLE ! Next WSELEM +END SUBROUTINE TAG_CELL_BLOCKED_BY_REFINEMENT_FOOTPRINT - ENDIF - ! Intersection is line 2-3: - IF ( (DOT2 == 0._EB) .AND. (DOT3 == 0._EB) ) THEN +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 - ! Second node: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN +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 - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +SUBROUTINE PROMOTE_REFINEMENT_FOOTPRINTS_FROM_BLOCKED_FINE(NM_FINE) - ! Third node: - XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT2(X1AXIS) = X1PLN +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 - ! Index to XYZ_INT2: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) +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 - ! 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 + 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 - 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 ! Next WSELEM - - ENDIF - ! Intersection is line 3-1: - IF ( (DOT3 == 0._EB) .AND. (DOT1 == 0._EB) ) THEN - - ! Third node: - XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN + 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 - ! Index to XYZ_INT1: - CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) +! 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) - ! First node: - XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT2(X1AXIS) = X1PLN +USE TRAN, ONLY: GET_IJK - ! 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 - - CYCLE ! Next WSELEM +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 - ! 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 +! ------------------------------ ADD_CUTEDGE_TO_FACE -------------------------------- - ENDDO ! IWSEL +SUBROUTINE ADD_CUTEDGE_TO_FACE(NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IEC2,JEC2,IFC,JFC,KFC,X1AXFC) - EXIT IBIN_DO ! No need to test more bins. +INTEGER, INTENT(IN) :: NM,ILHF,ICE,JCE,ICF2,JCF2,JCE2,TRI,IBOD,IFC,JFC,KFC,X1AXFC +INTEGER, INTENT(OUT):: IEC2,JEC2 - ENDDO IBIN_DO +! 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 -ENDDO MAIN_GEOM_LOOP +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. -! 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 + ! 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 - DO ITRI=1,BODINT_PLANE%NTRIS +ENDIF - ! Triang conectivities: - ELEM(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) +! 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) - ! 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)) /) +! 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) - ! 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 +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) - ! 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) /) +! 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 - ! 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 /) +! 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 - ENDDO - ENDDO +M%CUT_EDGE(IEC2)%NVERT = NVERT +M%CUT_EDGE(IEC2)%NEDGE = NEDGE - ENDDO +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 -! 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: +END SUBROUTINE ADD_CUTEDGE_TO_FACE - 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)) +! ------------------------------ ADD_CUTEDGE_TO_EDGE ------------------------------- - ! 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) /) +SUBROUTINE ADD_CUTEDGE_TO_EDGE(NM,ILHF,IEG,JEG,KEG,X1AXEG,XV1,XV2) - ! Now related WS triangles centroids: - IWSEL1 = BODINT_PLANE%INDSEG(2,ISEG) - IWSEL2 = BODINT_PLANE%INDSEG(3,ISEG) - IG = BODINT_PLANE%INDSEG(4,ISEG) +INTEGER, INTENT(IN) :: NM,ILHF,IEG,JEG,KEG,X1AXEG +REAL(EB),INTENT(IN) :: XV1(IAXIS:KAXIS),XV2(IAXIS:KAXIS) - ! 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) +! Local Variables: +INTEGER :: NVERT,INOD1,INOD2,ICF,CEI,NEDGE,NOD1_TYPE,NOD2_TYPE,LOHI,AXIS +TYPE(MESH_TYPE), POINTER :: M - ! 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) +M=>MESHES(NM) +IF(M%ECVAR(IEG,JEG,KEG,CC_EGSC,X1AXEG)==CC_SOLID) RETURN - ! 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) /) +! 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 - VCT(1:2) = 0 - PCT(IAXIS:JAXIS,1:2) = 0._EB +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 - ! 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 - - ! 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 - - IF ( (VCT(1) == 0) .OR. (VCT(2) == 0) ) THEN - print*, "Error GET_BODINT_PLANE: One component of vct == 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) - ! 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 = M%CUT_EDGE(CEI)%NEDGE+1 +CALL REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) - ! Now tests: - ! Start with SOLID GASPHASE definition for segtype: - BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_GASPHASE /) +! 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 /) - ! 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 +! Add edge: Assumes XV1 < XV2 in X1AXEG direction: +M%CUT_EDGE(CEI)%CEELEM(1:2,NEDGE) = (/INOD1,INOD2/) - ! 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 +M%CUT_EDGE(CEI)%NVERT = NVERT +M%CUT_EDGE(CEI)%NEDGE = NEDGE - ENDIF -ENDDO +! 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 +END SUBROUTINE ADD_CUTEDGE_TO_EDGE -! 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)) +! --------------------------- REPL_CUTEDGE_IN_LIST_EDGES --------------------------- -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 REPL_CUTEDGE_IN_LIST_EDGES(NM,ICF,IEC,JEC,LOHI,AXIS) - 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, INTENT(IN) :: NM,ICF,IEC,JEC,LOHI,AXIS +INTEGER :: IEDGE,DUM - 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 +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 -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) - -DEALLOCATE(SEGAUX,INDSEGAUX,SEGTYPEAUX) +! ------------------------------ ADD_REGEDGE_TO_FACE ------------------------------- -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 +SUBROUTINE ADD_REGEDGE_TO_FACE(NM,ILHF,X1AXIS,IEG,JEG,KEG,X1AXEG,IFC,JFC,KFC,X1AXFC,TRI,IBOD,XV1,XV2,CEI,NEDGE,IV_LIST) -! 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 +! 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 -! 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 +! Local Variables: +INTEGER :: NVERT,INOD1,INOD2,ICF,IEDGE,LOHI +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTFACE_TYPE), POINTER :: CF - ! End nodes to cross: - SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) +M=>MESHES(NM) +IF(M%FCVAR(IFC,JFC,KFC,CC_FGSC,X1AXFC)==CC_SOLID) RETURN - 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 +! 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 - XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) - XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) +! 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) - ! 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) +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) - ! 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) +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 length: - SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) - MEAN_SLEN = MEAN_SLEN + SLEN +M%CUT_EDGE(CEI)%NVERT = NVERT +M%CUT_EDGE(CEI)%NEDGE = NEDGE - ! 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 +M%CUT_EDGE(CEI)%INDSEG(1:5,NEDGE) = (/ 2, TRI, TRI, IBOD, 0 /) - ! 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 +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 -ENDDO +END SUBROUTINE ADD_REGEDGE_TO_FACE -! 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 +! --------------------------------- DROP_REG_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)) +SUBROUTINE DROP_REG_FACE(NM,I,J,K,ILHF,X1AXIS) - ! 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 +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 + +END SUBROUTINE DROP_REG_FACE + + +! --------------------------- INSERT_CUT_CELL ----------------------------------------------- + +SUBROUTINE INSERT_CUT_CELL(NM,I,J,K,ICC) + +! 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 + +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 -! 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 +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 - ! 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 +RETURN +END SUBROUTINE INSERT_CUT_CELL - ! Test for segment-segment intersection: - CALL GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) +! --------------------------- INSERT_CUT_FACE ----------------------------------------------- - ! 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 +SUBROUTINE INSERT_CUT_FACE(NM,I,J,K,AXIS,ICF,INZONE) - ! 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) +! 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 - ! 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 - ! 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 +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 - ! 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(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 - ENDDO +! 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 - - -! 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)) +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 - ENDIF - ISEG_NODE(ISEG2+1,SEG(INOD)) = ISEG - ANGS_NODE(ISEG2 ,SEG(INOD)) = ANG - ENDDO NOD_LOOP + ENDDO + ENDDO 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 +ENDIF - ! 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 +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/) - ! 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 +RETURN +END SUBROUTINE INSERT_CUT_FACE - ! 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) +! --------------------------------- DROP_CUT_EDGE ------------------------------------------- -T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) = T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) + CURRENT_TIME() - TNOW +SUBROUTINE DROP_CUT_EDGE(NM,ICE,JCE,ETYPE) -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) +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 - 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) + ! 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 - CLOSE(333) +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 GET_BODINT_PLANE +END SUBROUTINE DROP_CUT_EDGE +! ----------------------------- DROP_CUTFACE -------------------------------------- -! ------------------------ GET_SEGSEG_INTERSECTION ------------------------------ +SUBROUTINE DROP_CUTFACE(NM,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC) -SUBROUTINE GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) +! 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. -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,FTYPE,I,J,K,ILHF,X1AXIS,IFC,JFC -! Local Variables: -REAL(EB) :: SVR, TVR, KRS, KRS2, E2, L12, L22, E(IAXIS:JAXIS), S1, S2, SMIN, SMAX +INTEGER :: CT,DUM,ILH,ICC1,JCC1,IFACE,IFC1,IFACE2 +INTEGER, ALLOCATABLE, DIMENSION(:) :: IND +TYPE(MESH_TYPE), POINTER :: M +TYPE(CC_CUTFACE_TYPE), POINTER :: CF -! 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 +M => MESHES(NM) +CF=> M%CUT_FACE(IFC) -! 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 +! 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)) + ! 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)) & + 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 -RETURN -END SUBROUTINE GET_SEGSEG_INTERSECTION +CF%NFACE = MAX(0,CF%NFACE - 1) -! -------------------------- GET_X2INTERSECTIONS -------------------------------- +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 -SUBROUTINE GET_X2_INTERSECTIONS(X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN) +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 -INTEGER, INTENT(IN) :: X1AXIS, X2AXIS, X3AXIS -REAL(EB),INTENT(IN) :: X3RAY,X1PLN +RETURN +END SUBROUTINE DROP_CUTFACE -! 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 +! ----------------------------- DROP_CUTCELL -------------------------------------- -REAL(EB) :: TNOW -! INTEGER :: IAUX +SUBROUTINE DROP_CUTCELL(NM,ICC,JCC) -TNOW = CURRENT_TIME() +! 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 -! 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, INTENT(IN) :: NM,ICC,JCC -! 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) +! Local Variables +INTEGER :: I,J,K,JCC2,IFC,CT +INTEGER, ALLOCATABLE, DIMENSION(:) :: IND +TYPE(MESH_TYPE), POINTER :: M +M => MESHES(NM) - ! 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 +I = M%CUT_CELL(ICC)%IJK(IAXIS); J = M%CUT_CELL(ICC)%IJK(JAXIS); K = M%CUT_CELL(ICC)%IJK(KAXIS) - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) ! Modifies crossings arrays. +! 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 + 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 + +! 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 -! Now Segments: -NSEGS_COND : IF (BODINT_PLANE%NSEGS > 0) THEN +! 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 -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 +M%CUT_CELL(ICC)%NCELL = M%CUT_CELL(ICC)%NCELL - 1 - IF (X3RAY < BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%X1_LOW -GEOMEPS) CYCLE - IF (X3RAY > BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE +DEALLOCATE(IND) - TRIBIN_DO : DO IISEG=1,BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%NTL +RETURN +END SUBROUTINE DROP_CUTCELL - ISEG = BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) -!SEGMENTS_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS +! ------------------------- GET_REMAINING_CUTCELLS -------------------------------- - 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)) +SUBROUTINE GET_REMAINING_CUTCELLS(NM) - ! 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. +! Define regular cut-cells for regular cartesian cells surrounded by a gas cut-face. +INTEGER, INTENT(IN) :: NM - ! 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)) - - IF (OUTRAY) CYCLE - - DOT1 = X3_1-X3RAY - DOT2 = X3_2-X3RAY - - 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_PLANE%SEGTYPE(LOW_IND:HIGH_IND,ISEG) +! 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), POINTER :: CC +TYPE(CC_CUTCELL_TYPE), ALLOCATABLE, DIMENSION(:) :: CUT_CELL_AUX +LOGICAL, PARAMETER :: OPT=.TRUE. - ! 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; +M => MESHES(NM) - ! Test if whole segment is in ray, if so add segment nodes as crossings: - IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) 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 - ! 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 +IF (OPT) THEN - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) +NCC_MESH = M%N_CUTCELL_MESH +NGC_MESH = M%N_GCCUTCELL_MESH - 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) +! 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 - ! 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) +! 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 - CYCLE +! 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) - 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 - ! Now nodes individually: - IF ( ABS(DOT1) == 0._EB ) THEN + ! 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 - ! Point 1: - SVARI = X2_1 + 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 - ! 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 + ! 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 - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ! 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 - CYCLE + ! 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 - ENDIF - IF ( ABS(DOT2) == 0._EB ) THEN +M%N_CUTCELL_MESH = NCC_MESH + NCELL_IN +M%N_GCCUTCELL_MESH = NGC_MESH + NCELL_GC - ! Point 2: - SVARI = X2_2 +ELSE - ! 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 +! 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 - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + ! 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 - CYCLE + 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 - 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 - ! 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 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 - ! 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) + ! 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 - ! 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 +ENDIF + +END SUBROUTINE GET_REMAINING_CUTCELLS + +! ------------------------- GET_REMAINING_CUTFACES -------------------------------- + +SUBROUTINE GET_REMAINING_CUTFACES(NM) + +! Running by axes define regular cut-faces, add to CUT_FACE array. + +INTEGER, INTENT(IN) :: NM + +! 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. + +M => MESHES(NM) + +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 + +! 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 - ! Insertion sort: - CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) +! 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 - CYCLE +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 - ENDIF +ELSE - print*, "Error GET_X2INTERSECTIONS: Missed segment=",ISEG +! 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 - ENDDO TRIBIN_DO -ENDDO IBIN_DO -!ENDDO SEGMENTS_LOOP +! 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 NSEGS_COND +! 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 -! Do we have any intersections? -IF ( CC_N_CRS == 0 ) RETURN +ENDIF -! Collapse crossings to single SVARs: -CALL COLLAPSE_CROSSINGS(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,1) +END SUBROUTINE GET_REMAINING_CUTFACES +! ---------------------- CUT_CELL_FACE_ARRAYS_CLEANUP ----------------------------- -! 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 +SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP(NM) -T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW +INTEGER, INTENT(IN) :: NM -RETURN -END SUBROUTINE GET_X2_INTERSECTIONS +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 +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 -! ------------------------ COLLAPSE_CROSSINGS ----------------------------------- +! 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 COLLAPSE_CROSSINGS(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,ITITLE) +! 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 -TYPE(BODINT_PLANE_TYPE), INTENT(IN) :: BODINT_PLANE2 -INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,ITITLE -REAL(EB), INTENT(IN) :: X3RAY,X1PLN +! 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 -! 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 +! 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 -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. +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 -! 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 +! 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 -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 +! Invalidate CCVAR at (I,J,K) pointing at cut-cells dropped from the active pool: +DO K=-CCGUARD,M%KBAR+CCGUARD + DO J=-CCGUARD,M%JBAR+CCGUARD + DO I=-CCGUARD,M%IBAR+CCGUARD + ICC = M%CCVAR(I,J,K,CC_IDCC) + IF (ICC < 1) CYCLE + IF (ICC > M%N_CUTCELL_MESH+M%N_GCCUTCELL_MESH) THEN + M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID + M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED + ELSEIF (M%CUT_CELL(ICC)%NCELL < 1 .OR. & + M%CUT_CELL(ICC)%IJK(IAXIS) /= I .OR. & + M%CUT_CELL(ICC)%IJK(JAXIS) /= J .OR. & + M%CUT_CELL(ICC)%IJK(KAXIS) /= K) THEN + M%CCVAR(I,J,K,CC_CGSC) = CC_SOLID + M%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED + ENDIF + ENDDO + ENDDO 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) +DEALLOCATE(CCIND,CFIND) + +RETURN +END SUBROUTINE CUT_CELL_FACE_ARRAYS_CLEANUP +! ----------------------- BLOCK_SMALL_UNLINKED_CUTCELLS ---------------------------- -! 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) +SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS(NM,NBLKCELLS) - 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 +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(OUT):: NBLKCELLS - ICRS =IND_CRS(LOW_IND,IDCR) + 1 +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 - 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 +M => MESHES(NM) +NBLKCELLS = 0 - ! 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 +IF(DEBUG_SET_CUTCELLS) THEN - 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) + ! 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) - CYCLE + 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 - ENDIF SNGL_CRS_IF +! 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 - ! 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 +! 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 - ! 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) +! 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) - ! 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 +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 - 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 + CLOSE(33) - ! 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. + 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) - ! 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) + 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 (IND_LEFT /= 0) IND_LEFT = SIGN(1,IND_LEFT) - IF (IND_RIGHT /= 0) IND_RIGHT = SIGN(1,IND_RIGHT) - - 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) - - 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) - - ! 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 + 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 - 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 - - 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." - - LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) +RETURN +END SUBROUTINE BLOCK_SMALL_UNLINKED_CUTCELLS - ENDIF DROP_SS_GG_IF +! ---------------------------- BLOCK_CUT_CELL ------------------------------------- -ENDDO IDCR_DO_2 +SUBROUTINE BLOCK_CUT_CELL(NM,ICC,JCC,BLOCK_PHASE) -! 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) +! 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. -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 +INTEGER, INTENT(IN) :: NM,ICC,JCC,BLOCK_PHASE -RETURN -END SUBROUTINE COLLAPSE_CROSSINGS +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(:,:) :: EDGE_LIST_AUX,CEDGES_AUX,CEDGES_AUX2,FACE_LIST_DROPPED +INTEGER, ALLOCATABLE, DIMENSION(:) :: CFELEM +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) +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: +CALL GET_BLOCKING_CUTCELL_DONOR(NM,ICC,JCC,IBOD,ITRI) -! ------------------------- INSERT_RAY_CROSS ------------------------------------ +! 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 -SUBROUTINE INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) +! 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 -REAL(EB), INTENT(IN) :: SVARI, STANI(IAXIS:JAXIS) -INTEGER, INTENT(IN) :: ICRSI(LOW_IND:HIGH_IND+1), SCRSI +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) -! 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 + 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 + ! 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 -CC_N_CRS = CC_N_CRS + 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 -! 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 + 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 -! 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 + 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 -! 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 + ! 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 -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 + 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 -! ----------------------- GET_BODINT_NODE_INDEX ---------------------------------- + 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 GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ,IND_PI) + ! 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 -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 + 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.) -! Local variables: -INTEGER :: INOD=1, PIVOT(LOW_IND:HIGH_IND), INOD2 -REAL(EB):: DIFFX2, DIFFX3 + ! 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 -! 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 + 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 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) + ! 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 -RETURN -END SUBROUTINE GET_BODINT_NODE_INDEX + END SELECT -! ---------------------- GET_BODINT_NODE_INDEX ---------------------------------- + ! 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_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 + ! 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 + ! 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_INTERSECT_COORDPLANE -------------------------------- + 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 -SUBROUTINE LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LNC,XYZ_INT,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 + ENDIF + ENDDO + ENDDO JCC2_LOOP_1 + ENDIF -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 + CASE(CC_FTYPE_CFGAS) -! 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 + ! 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) + 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))) + 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) + ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: + EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) -! Initialize: -INTFLG = .FALSE. -XYZ_INT(IAXIS:KAXIS) = 0._EB + ! 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(.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 + ! 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 -! 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 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) -! 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 + ! Also, assign this CFINB cut-edge in IFC1 EDGE_LIST_AUX: + EDGE_LIST_AUX(1:3,DUM+IEDGE) = (/CC_ETYPE_CFINB,IEC2,JEC2/) -INTFLG = .TRUE. + ! 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 -RETURN -END SUBROUTINE LINE_INTERSECT_COORDPLANE + ! 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/) -! ------------------------- CC_INIT_GEOM --------------------------------------- + ! 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) -SUBROUTINE CC_INIT_GEOM + ! 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) -! 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 + ! 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 -REAL(EB) :: CPUTIME_START, CPUTIME +ENDDO IFC_LOOP -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 : ' +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 -! In this subroutine the quality of the GEOM lines is checked -! Calc local squared epsilon for GEOM quality check -GEOMEPSSQ = (GEOMEPS * GEOMQUALITYFCT)**2._EB +ELSEIF(BLOCK_PHASE==2) THEN BLOCK_PHASE_IF -! Geometry loop: -GEOMETRY_LOOP : DO IG=1,N_GEOMETRY +! 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) - NWSEL = GEOMETRY(IG)%N_FACES - NVERT = GEOMETRY(IG)%N_VERTS + 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 - 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 + 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 - ! 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] + 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 - ! COUNTED_VERT used for test of loose vertices: - ALLOCATE(COUNTED_VERT(1:NVERT)); COUNTED_VERT = .FALSE. + ENDIF FACE_TYPE_IF_2 - GEOMETRY(IG)%GEOM_VOLUME = 0._EB - GEOMETRY(IG)%GEOM_AREA = 0._EB - GEOMETRY(IG)%GEOM_XYZCEN(:) = 0._EB + 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 - ! Compute normal, area and volume: - SQAREA(IAXIS:KAXIS) = 0._EB - DO IWSEL=1,NWSEL + 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 - WSELEM(NOD1:NOD3) = GEOMETRY(IG)%FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) + 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 - COUNTED_VERT(WSELEM(NOD1:NOD3)) = .TRUE. + 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 - ! 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 + ! 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) - 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) + ! 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 - ! 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 + ! 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) - ! 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 + END SELECT - XCEN = (XYZV(IAXIS,NOD1) + XYZV(IAXIS,NOD2) + XYZV(IAXIS,NOD3)) / 3._EB +ENDDO IFC_LOOP_2 - ! 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 +ELSEIF(BLOCK_PHASE==3) THEN BLOCK_PHASE_IF - ! 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 +! 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) - ! 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) +ENDIF BLOCK_PHASE_IF - ! 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 +RETURN +END SUBROUTINE BLOCK_CUT_CELL - ! 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 +! ---------------------- GET_EXT_INB_CUTFACES_TO_CFACE -------------------------------- - ! Geometry Centroid: - DO IX=IAXIS,KAXIS - GEOMETRY(IG)%GEOM_XYZCEN(IX) = SQAREA(IX) / (2._EB * GEOMETRY(IG)%GEOM_VOLUME) - ENDDO +SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE - ! 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) +! 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 - ! 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 +! GET_CUTCELLS_VERBOSE variables: +INTEGER, ALLOCATABLE, DIMENSION(:) :: NCFACE_BY_MESH - 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 +TYPE(VENTS_TYPE), POINTER :: VT +TYPE(CFACE_TYPE), POINTER :: CFA - 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) CALL CPU_TIME(CPUTIME_START) - ENDIF +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 - 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), ")" + ! 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 - CALL SHUTDOWN("") ; RETURN - 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 - - ! 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." + ! 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 + ! 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 - DEALLOCATE(COUNTED_VERT) - - GEOMETRY(IG)%N_EDGES = NWSEDG - - ! At this point the surface is manifold, well oriented, and closed. +ENDDO MESH_LOOP_0 - 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 +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 -ENDDO GEOMETRY_LOOP +! 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) -! 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 + ! 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)) -RETURN -END SUBROUTINE CC_INIT_GEOM + 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)) -! ------------------------ GET_GEOM_EDGES --------------------------------------- + ! 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 -SUBROUTINE GET_GEOM_EDGES(NVERT,NWSEL,SIZEFC,FACES,NWSEDG,EDGES,FACE_EDGES,EDGE_FACES) + 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 + ! 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. + 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 -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) +! 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) -! 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 + ! ! Currently : Modify CFACE SURF_INDEX with VENT information: This needs more development. -NWSEDG = 0 + 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. -! 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 + ! 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. -! 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. +! 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) -DO IWSEL=1,NWSEL - WSELEM(NOD1:NOD3) = FACES(NODS_WSEL*(IWSEL-1)+1:NODS_WSEL*IWSEL) +! 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) - 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. + ! 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 - 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 +ENDDO MESH_LOOP_4 - 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 +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 - 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 +RETURN +END SUBROUTINE GET_EXT_INB_CUTFACES_TO_CFACE - 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 +! ------------------------- SET_GC_CUTCELLS_3D ----------------------------------- -! 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 +SUBROUTINE SET_GC_CUTCELLS_3D -DEALLOCATE(NELVERT,ISTVERT,EDGES2,EDGE_FACES2,EDGE_RNK) +! 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 +INTEGER :: NM,NOM,NCELL +REAL(EB) :: CPUTIME_START, CPUTIME +TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC +TYPE(BOUNDARY_PROP1_TYPE), POINTER :: B1 -RETURN -END SUBROUTINE GET_GEOM_EDGES -! ------------------------- GET_X2_VERTVAR -------------------------------------- +IF (CCGUARD == 0) RETURN -SUBROUTINE GET_X2_VERTVAR(X1AXIS,X2LO,X2HI,NM,I,KK) +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 -INTEGER, INTENT(IN) :: X1AXIS,X2LO,X2HI,NM,I,KK +! 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 -! Local Variables: -INTEGER :: ICRS,ICRS1,JSTR,JEND,JJ,X2LO_LOC,X2HI_LOC -REAL(EB):: TNOW + IF (MESHES(NM)%N_CUTFACE_MESH==0) CYCLE MESH_LOOP_1 + CALL POINT_TO_MESH(NM) -TNOW=CURRENT_TIME() + EXTERNAL_WALL_LOOP_1 : DO IW=1,N_EXTERNAL_WALL_CELLS -! 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 + 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 - 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 + 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 - ENDDO + X1AXIS = ABS(IOR) + IF(FCVAR(IIF,JJF,KKF,CC_FGSC,X1AXIS) /= CC_CUTCFE) CYCLE EXTERNAL_WALL_LOOP_1 - ! 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 + ! 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: + + 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 - 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 + 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 -RETURN -END SUBROUTINE GET_X2_VERTVAR + ! 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 -! -------------------------- GET_CARTEDGE_CUTEDGES ------------------------------ + 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 -SUBROUTINE GET_CARTEDGE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & - NM,X2LO_CELL,X2HI_CELL,INDX1,KK) + 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 -INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & - NM,X2LO_CELL,X2HI_CELL,INDX1(MAX_DIM),KK + 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 .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 + ! 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 -! 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 + ! 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 :: FOUND_EDGE -REAL(EB):: XVJJ, DELJJ1 + 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 .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 + 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 -TNOW=CURRENT_TIME() -! INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CEELEMAUX, INDSEGAUX -! INTEGER :: NEDGE_SIZE + ENDDO EXTERNAL_WALL_LOOP_2 -! 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 +ENDDO MESH_LOOP_2 -! Set initially edges with MESHES(NM)%VERTVAR vertices == CC_SOLID to CC_SOLID status: -DO JJ=X2LO_CELL,X2HI_CELL +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 - ! 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) +RETURN - 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 +END SUBROUTINE SET_GC_CUTCELLS_3D -ENDDO +SUBROUTINE CC_GRID_REBUILD_PHASE2_FACE_AND_LINK_INFO(NM) +INTEGER, INTENT(IN) :: NM -NEDGECROSS_OLD = MESHES(NM) % N_EDGE_CROSS -! Edges with Crossings not on VERTICES: -ICRS_DO : DO ICRS=1,CC_N_CRS +CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=2) - ! Skip SOLID-SOLID intersections, as there is no media crossing: - IF (CC_IS_CRS(ICRS) == CC_SS) CYCLE +! Here: 1,2. Define Linking information for cut-cells. +CALL GET_CELL_LINK_INFO(NM) - ! 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 +END SUBROUTINE CC_GRID_REBUILD_PHASE2_FACE_AND_LINK_INFO - 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 +SUBROUTINE CC_GRID_TAG_CAVITY_CUTCELLS(NM,N_CAVITY_CELLS) - 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) +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(OUT) :: N_CAVITY_CELLS - ! Set MESHES(NM)%ECVAR(IE,JE,KE,CC_EGSC,X2AXIS) = CC_CUTCFE: - ICROSS = MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_ECRS,X2AXIS) +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/)) - IF ( ICROSS > 0 ) THEN ! Edge has crossings already. +N_CAVITY_CELLS = 0 +M => MESHES(NM) - ! 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) +! 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 + 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 + N_CAVITY_CELLS = N_CAVITY_CELLS + 1 + ENDDO +ENDDO - ELSE ! No crossings yet. +! 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 - 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 +END SUBROUTINE CC_GRID_TAG_CAVITY_CUTCELLS - CALL EDGE_CROSS_ARRAY_REALLOCATE(NM,NEDGECROSS) +SUBROUTINE CC_GRID_REBLOCK_MESH_AFTER_NEIGHBOR_EXCHANGE(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) - ! 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 /) +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND - ENDIF +INTEGER :: SUM_CCELL,N_CAVITY_CELLS - ENDDO +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) -ENDDO ICRS_DO +! 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) -! Now Define MESHES(NM)%CUT_EDGE for CC_GASPHASE cut-edges: -DO ICROSS=NEDGECROSS_OLD+1,MESHES(NM)%N_EDGE_CROSS +! 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) FM_PENDING_BLOCK_SCAN(NM) = .TRUE. - ! 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 +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) - NCROSS = MESHES(NM)%EDGE_CROSS(ICROSS)%NCROSS +END SUBROUTINE CC_GRID_REBLOCK_MESH_AFTER_NEIGHBOR_EXCHANGE - ! 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) +SUBROUTINE CC_GRID_FINAL_REBLOCK_MESH(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) - ! 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 +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID - CYCLE +INTEGER :: SUM_CCELL - ENDIF +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) - ! Discard cases for edge with two crossings: - IF ( NCROSS == 2 ) THEN +CALL CC_GRID_REBUILD_PHASE2_FACE_AND_LINK_INFO(NM) - VSOLID = (MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & - (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) +! 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) - ! 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 +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) - 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) +END SUBROUTINE CC_GRID_FINAL_REBLOCK_MESH - VFLUID = (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(1) == CC_GS) .AND. & - (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(2) == CC_SG) +LOGICAL FUNCTION CC_GRID_SHOULD_PROCESS_MESH(NM,CC_COMPUTE_MESH) - IF (DIF .AND. VSOLID .AND. VFLUID) THEN - MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID - CYCLE - ENDIF +INTEGER, INTENT(IN) :: NM +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH - ENDIF +CC_GRID_SHOULD_PROCESS_MESH = CC_COMPUTE_MESH(NM) +IF (PERIODIC_TEST==105 .AND. PROCESS(NM)/=MY_RANK) CC_GRID_SHOULD_PROCESS_MESH = .FALSE. - ! 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 +END FUNCTION CC_GRID_SHOULD_PROCESS_MESH - CALL CUT_EDGE_ARRAY_REALLOC(NM,NCUTEDGE) +SUBROUTINE CC_GRID_EXCHANGE_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) - 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)) +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER :: NM - ! 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 +FM_PENDING_BLOCK_SCAN = .FALSE. +DO NM=1,NMESHES; MESHES(NM)%N_CC_ELIMINATED = 0; 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 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) - ! ! 1st Node: - ! IF(MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC)==CC_GASPHASE) VERT_LIST(1:4,1) =(/ CC_VTYPE_VGAS, INDI, INDJ, INDK /) - ! IF(MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC)==CC_SOLID) VERT_LIST(1:4,1) =(/ CC_VTYPE_VINB, INDI, INDJ, INDK /) - ! ! Internal nodes: - ! !VERT_LIST(1,2:NVERT-1) = CC_VTYPE_NINB ! Nodes crossing inside the segment are in boundary. - ! ! Last Node: - ! IF(MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC)==CC_GASPHASE .AND. & - ! MESHES(NM)%CUT_EDGE(NCUTEDGE)%IJK(4)==IAXIS) WRITE(LU_ERR,*) 'Found Gas Vert',INDI1,INDJ1,INDK1,NVERT - ! IF(MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC)==CC_SOLID .AND. & - ! MESHES(NM)%CUT_EDGE(NCUTEDGE)%IJK(4)==IAXIS) WRITE(LU_ERR,*) 'Found Sol Vert',INDI1,INDJ1,INDK1,NVERT - ! IF(MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC)==CC_GASPHASE) VERT_LIST(1:4,NVERT) =(/ CC_VTYPE_VGAS, INDI1, INDJ1, INDK1 /) - ! IF(MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC)==CC_SOLID) VERT_LIST(1:4,NVERT) =(/ CC_VTYPE_VINB, INDI1, INDJ1, INDK1 /) - MESHES(NM)%CUT_EDGE(NCUTEDGE)%VERT_LIST(1:4,1:NVERT) = VERT_LIST(1:4,1:NVERT) +! 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 - ! This assumes crossings are ordered for increasing svar, no repeated svar: - NEDGE = 0 - MESHES(NM)%CUT_EDGE(NCUTEDGE)%NEDGE = NEDGE - DO IVERT=1,MESHES(NM)%CUT_EDGE(NCUTEDGE)%NVERT-1 +! 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 - ! Drop zero length edge (in x2 local dir): - IF (ABS(X123VERT(JAXIS,IVERT)-X123VERT(JAXIS,IVERT+1)) < GEOMEPS) CYCLE +! 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) - ! Define if the cut-edge is gasphase: - ! Ray tracing for the center of the cut-edge most robust. - XCEN = 0.5_EB*(MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT(IAXIS,IVERT ) + & - MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT(IAXIS,IVERT+1)) - YCEN = 0.5_EB*(MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT(JAXIS,IVERT ) + & - MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT(JAXIS,IVERT+1)) - ZCEN = 0.5_EB*(MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT(KAXIS,IVERT ) + & - MESHES(NM)%CUT_EDGE(NCUTEDGE)%XYZVERT(KAXIS,IVERT+1)) - XYZCEN(IAXIS:KAXIS) = (/ XCEN, YCEN, ZCEN /) +! Call tag boundary cut-cells for blocking in refinement interfaces: +CALL TAG_CC_BLOCKING_REFINEMENT - ! Do a SOLID crossing count up to XYZcen(x2axis): - SCEN=XYZCEN(X2AXIS) - CALL GET_IS_GASPHASE(SCEN,IS_GASPHASE) +END SUBROUTINE CC_GRID_EXCHANGE_REBLOCK_PASS - 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 - ENDDO +SUBROUTINE CC_GRID_FINAL_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) - 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 +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER :: NM -ENDDO +! 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) -T_CC_USED(GET_CARTEDGE_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTEDGE_CUTEDGES_TIME_INDEX) + CURRENT_TIME() - TNOW +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 -RETURN -END SUBROUTINE GET_CARTEDGE_CUTEDGES +END SUBROUTINE CC_GRID_FINAL_REBLOCK_PASS +SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) -! ------------------------EDGE_CROSS_ARRAY_REALLOCATE---------------------------- +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER :: IDIM,NM -SUBROUTINE EDGE_CROSS_ARRAY_REALLOCATE(NM,CEI) +IF (ALLOCATED(FM_PENDING_BLOCK_SCAN)) DEALLOCATE(FM_PENDING_BLOCK_SCAN) +ALLOCATE(FM_PENDING_BLOCK_SCAN(1:NMESHES)); FM_PENDING_BLOCK_SCAN = .FALSE. -INTEGER, INTENT(IN) :: NM, CEI +! 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 -! Local Variables: -INTEGER :: CEI1, SIZE_EDGE_CROSS +DO IDIM=1,MAX_DIM + CALL CC_GRID_EXCHANGE_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) +ENDDO -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 +CALL CC_GRID_FINAL_REBLOCK_PASS(CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND) -RETURN -END SUBROUTINE EDGE_CROSS_ARRAY_REALLOCATE +IF (ALLOCATED(FM_PENDING_BLOCK_SCAN)) DEALLOCATE(FM_PENDING_BLOCK_SCAN) +END SUBROUTINE CC_GRID_EXCHANGE_AND_REBLOCK -! --------------------------CUT_EDGE_ARRAY_REALLOC------------------------------- +SUBROUTINE CC_GRID_TAG_COARSE_CELL_FROM_NEIGHBOR_BLOCK(NM,M,M2,I2,J2,K2,XCO,YCO,ZCO,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR) -SUBROUTINE CUT_EDGE_ARRAY_REALLOC(NM,CEI) +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,IBOD_DONOR,ITRI_DONOR -INTEGER, INTENT(IN) :: NM, CEI +INTEGER :: I,J,K,ICC,JCC +REAL(EB) :: XMAP,YMAP,ZMAP +LOGICAL :: FINE_AT_REFI,CELL_CHANGED -! Local Variables: -INTEGER :: CEI1, SIZE_CUT_EDGE +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 -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) +! 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) 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 - CALL MOVE_ALLOC(FROM=CUT_EDGE_AUX, TO=MESHES(NM)%CUT_EDGE) +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 -RETURN -END SUBROUTINE CUT_EDGE_ARRAY_REALLOC +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,IBOD_DONOR,ITRI_DONOR) -! ----------------------------- NEW_EDGE_ALLOC ---------------------------------- +TYPE(MESH_TYPE), POINTER :: M +REAL(EB), INTENT(IN) :: XCO,YCO,ZCO +INTEGER, INTENT(IN) :: REMOTE_JCC,BLOCK_TAG,IBOD_DONOR,ITRI_DONOR + +INTEGER :: I,J,K,ICC + +I = MINLOC(ABS(XCELL(ILO_CELL-1:IHI_CELL+1)-XCO),DIM=1) + ILO_CELL - 2 +J = MINLOC(ABS(YCELL(JLO_CELL-1:JHI_CELL+1)-YCO),DIM=1) + JLO_CELL - 2 +K = MINLOC(ABS(ZCELL(KLO_CELL-1:KHI_CELL+1)-ZCO),DIM=1) + KLO_CELL - 2 +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) 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 -SUBROUTINE NEW_EDGE_ALLOC(NM,CEI,NVERTALLOC,NEDGEALLOC) +END SUBROUTINE CC_GRID_TAG_NEIGHBOR_BLOCK_BY_CENTROID -INTEGER, INTENT(IN) :: NM, CEI, NVERTALLOC, NEDGEALLOC +SUBROUTINE CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL(NM,M,M2,NOM,ICELL,VOL_NM) -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) +USE TRAN, ONLY: GET_IJK -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)) +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,IBOD_DONOR,ITRI_DONOR +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) +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(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,IBOD_DONOR,ITRI_DONOR) +ENDIF -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 +END SUBROUTINE CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL -RETURN +SUBROUTINE CC_GRID_ADD_BLOCKED_CELLS_FROM_NEIGHBOR_MESH(NM,M,M2,NOM,VOL_NM) -END SUBROUTINE NEW_EDGE_ALLOC +INTEGER, INTENT(IN) :: NM +TYPE(MESH_TYPE), POINTER :: M,M2 +INTEGER, INTENT(IN) :: NOM +REAL(EB), INTENT(IN) :: VOL_NM -! ------------------ REALLOCATE_EDGE_VERT(NM,CEI,NVERT) ------------------------- +INTEGER :: ICELL -SUBROUTINE REALLOCATE_EDGE_VERT(NM,CEI,NVERT) +DO ICELL=1,M2%N_CC_BLOCKED + CALL CC_GRID_PROCESS_NEIGHBOR_BLOCKED_CELL(NM,M,M2,NOM,ICELL,VOL_NM) +ENDDO -INTEGER, INTENT(IN) :: NM, CEI, NVERT +END SUBROUTINE CC_GRID_ADD_BLOCKED_CELLS_FROM_NEIGHBOR_MESH -! Local Variables: -INTEGER :: NVERT_SIZE -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZVERTAUX -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: VERT_LISTAUX -INTEGER, ALLOCATABLE, DIMENSION(:) :: NOD_PERMAUX +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,NM2 +REAL(EB):: VOL_NM +TYPE(MESH_TYPE), POINTER :: M,M2 -NVERT_SIZE = SIZE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT, DIM=2) +MESH_LOOP : DO NM=1,NMESHES -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) + IF (.NOT.CC_GRID_SHOULD_PROCESS_MESH(NM,CC_COMPUTE_MESH)) CYCLE - 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) + 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) - 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 + ! 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) -RETURN + ! 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) + 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 -END SUBROUTINE REALLOCATE_EDGE_VERT +END SUBROUTINE ADD_NEIGHBOR_BLOCKED_CELLS -! ------------------ REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) ------------------------- +SUBROUTINE CC_GRID_TAG_BLOCK_CELL_PAIR(NM,NOM,II,JJ,KK,IIG,JJG,KKG,IIO,JJO,KKO,IIOG,JJOG,KKOG,FINE_CELL) -SUBROUTINE REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) +INTEGER, INTENT(IN) :: NM,NOM,II,JJ,KK,IIG,JJG,KKG,IIO,JJO,KKO,IIOG,JJOG,KKOG +LOGICAL, INTENT(IN) :: FINE_CELL -INTEGER, INTENT(IN) :: NM, CEI, NEDGE +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) -! 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 +END SUBROUTINE CC_GRID_TAG_BLOCK_CELL_PAIR -NEDGE_SIZE = SIZE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM, DIM=2) +SUBROUTINE CC_GRID_TAG_RAYTRACE_SINGLE_COVER_WALL(NM,NOM,IOR,X1AXIS,EWC,II,JJ,KK,IIG,JJG,KKG,SKIP_WALL) -IF (NEDGE > NEDGE_SIZE) THEN ! Reallocate CEELEM, +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 - CC_ALLOC_ELEM = MAX(NEDGE-NEDGE_SIZE,CC_ALLOC_DELEM) +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 - 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 +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 - 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 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.) - CALL MOVE_ALLOC(FROM=CEELEMAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%CEELEM) - CALL MOVE_ALLOC(FROM=INDSEGAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%INDSEG) +! 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) -END SUBROUTINE REALLOCATE_EDGE_ELEM +! 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.) -! -------------------------- GET_ISGASPHASE ------------------------------------- + ! 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 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 +M => 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 -! If at least one of left and right are true -> add -! CC_GASPHASE cut-edge: -IS_GASPHASE = IS_GASPHASE_LEFT .OR. IS_GASPHASE_RIGHT +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) -RETURN -END SUBROUTINE GET_IS_GASPHASE +END SUBROUTINE CC_GRID_INSERT_SINGLE_CARTESIAN_CUTCELL -! --------------------- GET_BODX2_INTERSECTIONS --------------------------------- +SUBROUTINE CC_GRID_TAG_NONRAY_SINGLE_COVER_WALL(NM,NOM,IOR,X1AXIS,EWC,II,JJ,KK,IIF,JJF,KKF) -SUBROUTINE GET_BODX2_INTERSECTIONS(X2AXIS,X3AXIS,X3RAY) +INTEGER, INTENT(IN) :: NM,NOM,IOR,X1AXIS,II,JJ,KK,IIF,JJF,KKF +TYPE(EXTERNAL_WALL_TYPE), POINTER, INTENT(IN) :: EWC -INTEGER, INTENT(IN) :: X2AXIS,X3AXIS -REAL(EB),INTENT(IN) :: X3RAY +INTEGER :: IIOF,JJOF,KKOF,LOHIF,ICC,JCC,IFC,IFACE +TYPE(MESH_TYPE), POINTER :: M,M2 +TYPE(CC_CUTCELL_TYPE), POINTER :: CC -! 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 +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 -! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX3_1Q,DX3_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) +! 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. -TNOW=CURRENT_TIME() +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) -IF ( BODINT_PLANE%NSEGS == 0) RETURN +INTEGER, INTENT(IN) :: NM,NOM,IOR,X1AXIS,IIF,JJF,KKF +TYPE(EXTERNAL_WALL_TYPE), POINTER, INTENT(IN) :: EWC -DO ISEG=1,BODINT_PLANE%NSEGS +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 - 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)) +M => MESHES(NM) +M2 => MESHES(NOM) - ! 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(M%FCVAR(IIF,JJF,KKF,CC_CGSC,X1AXIS)/=CC_SOLID) RETURN - ! IF (.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN - ! Segment length: - SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) +! 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. - ! Unit vector along segment: - STANI(IAXIS:JAXIS) = 1._EB/SLEN * (/ (X2_2-X2_1), (X3_2-X3_1) /) +END SUBROUTINE CC_GRID_TAG_NONRAY_MULTI_COVER_WALL - ! 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 +SUBROUTINE TAG_CC_BLOCKING_REFINEMENT - ! 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 ( DO_RAY_TRACING) THEN - ! 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 + ! 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 -ENDDO + CALL POINT_TO_MESH(NM) + M => MESHES(NM) -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 + ! 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 + 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 -! ----------------------- GET_BODX3_INTERSECTIONS ------------------------------- + CALL CC_GRID_TAG_RAYTRACE_SINGLE_COVER_WALL(NM,NOM,IOR,X1AXIS,EWC,II,JJ,KK,IIG,JJG,KKG,SKIP_WALL) + IF (SKIP_WALL) CYCLE EXT_WALL_LOOP_1 -SUBROUTINE GET_BODX3_INTERSECTIONS(X2AXIS,X3AXIS,X2LO,X2HI) + ELSEIF((EWC%IIO_MAX-EWC%IIO_MIN+1)*(EWC%JJO_MAX-EWC%JJO_MIN+1)*(EWC%KKO_MAX-EWC%KKO_MIN+1)>1) THEN -INTEGER, INTENT(IN) :: X2AXIS,X3AXIS,X2LO,X2HI + CALL CC_GRID_TAG_RAYTRACE_MULTI_COVER_WALL(NM,NOM,IOR,X1AXIS,EWC,BC) + ENDIF + ENDDO EXT_WALL_LOOP_1 + ENDDO MAIN_MESH_LOOP_1 -! 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 +ELSE -! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX2_1Q,DX2_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) + ! 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 -TNOW=CURRENT_TIME() + CALL POINT_TO_MESH(NM) + M => MESHES(NM) -DO ISEG=1,BODINT_PLANE%NSEGS + ! 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 + 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 - IF (BODINT_PLANE%X3ALIGNED(ISEG)) CYCLE ! This segment is not aligned with x3. + 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 - 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 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 - ! 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) +ENDIF +RETURN +END SUBROUTINE TAG_CC_BLOCKING_REFINEMENT - ! 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 +SUBROUTINE CC_GRID_TAG_BLOCK_FINE_CELL_CASE(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1) - 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 +INTEGER, INTENT(IN) :: NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1 + +INTEGER :: ICC,ICC2,JCC_LOC,IBOD_LOC,ITRI_LOC +TYPE(MESH_TYPE), POINTER :: M,M2 + +M =>MESHES( NM) +M2=>MESHES(NOM) + +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 + ! 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 + 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 - 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 + CALL TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) ENDIF ENDIF +ENDIF + +END SUBROUTINE CC_GRID_TAG_BLOCK_FINE_CELL_CASE + +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 + +IF (PROCESS(NOM)/=MY_RANK) RETURN + +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 + ! 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 + ! 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 - DO JJ=JSTR,JEND +END SUBROUTINE CC_GRID_TAG_BLOCK_COARSE_CELL_CASE - ! 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 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 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 +IF (FINE_CELL) THEN + CALL CC_GRID_TAG_BLOCK_FINE_CELL_CASE(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1) - ! 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 +ELSE + CALL CC_GRID_TAG_BLOCK_COARSE_CELL_CASE(NM,II1,JJ1,KK1,NOM,IIO1,JJO1,KKO1) - ! 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 +ENDIF - ENDDO +END SUBROUTINE TAG_BLOCK_CELL -ENDDO +SUBROUTINE TEST_CC_FOR_BLOCKING(NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2) -T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT -RETURN -END SUBROUTINE GET_BODX3_INTERSECTIONS +INTEGER, INTENT(IN) :: NM,ICC,NOM,IIO1,JJO1,KKO1,ICC2 -! ----------------------- GET_CARTFACE_CUTEDGES --------------------------------- +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,IBOD_DONOR,ITRI_DONOR +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 -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) +M =>MESHES( NM) +M2=>MESHES(NOM) +CALL GET_REFINEMENT_CELL_DONOR(NOM,IIO1,JJO1,KKO1,IBOD_DONOR,ITRI_DONOR) -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 +INBFC=M2%CCVAR(IIO1,JJO1,KKO1,CC_IDCF); IF(INBFC<1) RETURN ! No CC_INBOUNDARY faces in this cartesian cell. -! 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 +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 -TNOW=CURRENT_TIME() +IF(FC_FOUND<1) RETURN ! Here or before we can switch to a point in polygon test whithin JCC_LOOP. -INIT_CUT_EDGES = MESHES(NM)%N_CUTEDGE_MESH+1 +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 -! 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 +! 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 - 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)) +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 (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(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 - NBCROSS = BODINT_PLANE%NBCROSS(ISEG) ! Cross points include Node1, Node2 +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 - INDSEG(1:CC_MAX_WSTRIANG_SEG+2) = BODINT_PLANE%INDSEG(1:CC_MAX_WSTRIANG_SEG+2, ISEG) - NTRISEG = INDSEG(1) + ! 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) + + ! 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 - 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. + ! 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 - INRAY = .FALSE. + ! 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 - ! Different cases: - ! First check if segment geomepsilon aligned with x2: - IF (BODINT_PLANE%X2ALIGNED(ISEG)) THEN + 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 /) ) - IF (INRAY) THEN ! Segment in x2 ray defined by x3 face index kk. + 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)) - ! 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 + IF (NORM2(NVEC)X1F +GEOMEPS) CYCLE INBFC_LOC_LOOP 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 + 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) THEN + CC%NOADVANCE(JCC) = BLOCKED_REFI_INTER + CALL SET_REFINEMENT_CUTCELL_DONOR(NM,ICC,JCC,IBOD_DONOR,ITRI_DONOR) + ENDIF +ENDDO JCC_LOOP - DO IPFACE=1,NPFACE +! IF(NM==1 .AND. ICC<30) CLOSE(LU_CCELL) - KK2 = KK2VEC(IPFACE) +DEALLOCATE(CFELEM) +IF(ALLOCATED(XYZVERTIJK)) DEALLOCATE(XYZVERTIJK,XYZVERTSTN,CFELEM2) +RETURN +END SUBROUTINE TEST_CC_FOR_BLOCKING - ! 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 +SUBROUTINE GET_CC_FACE_CELL_LIST_INFO(NM,PHASE) - ! 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 +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: PHASE + +! Local Vars: +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: +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 + +! 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 + +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 - - 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 + 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 - - ! 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) - 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 + 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 - 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 + END SELECT - ! Second check if segment geomepsilon aligned with x3: - ELSEIF (BODINT_PLANE%X3ALIGNED(ISEG)) THEN + CASE(CC_ETYPE_CFINB) ! Inboundary cut-edge (face) - ! 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 + END SELECT ENDDO + ENDDO +ENDDO CUTFACE_LOOP - IF (INRAY) THEN ! Segment in x3 ray defined by x2 face index JJ +! 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) 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 +IF(DEBUG_SET_CUTCELLS) THEN - DO IPFACE=1,NPFACE + WRITE(FILENAME,'(A,A,I3.3,A)') TRIM(CHID),'_',NM,'_cutfaceCELLS.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 - JJ2 = JJ2VEC(IPFACE) + 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%FCVAR(I,J,K,CC_FGSC,IAXIS),M%FCVAR(I,J,K,CC_FGSC,JAXIS),M%FCVAR(I,J,K,CC_FGSC,KAXIS),& + M%CCVAR(I,J,K,CC_CGSC) + DO X1AXIS=IAXIS,KAXIS + IF(M%FCVAR(I,J,K,CC_FGSC,X1AXIS)==CC_CUTCFE)THEN + ICF1=M%FCVAR(I,J,K,CC_IDCF,X1AXIS); 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 - ! 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(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 - ! 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) + 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) - ! 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 + 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 - IF(.NOT.FOUND_SEG) CYCLE ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + CLOSE(33) +ENDIF - IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_CELL)) CYCLE +RETURN +END SUBROUTINE GET_CC_FACE_CELL_LIST_INFO - ! 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 +SUBROUTINE CC_GRID_RELEASE_BLOCKED_CELL_LISTS(NM) - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS) - INDJF=INDXI(XJAXIS) - INDKF=INDXI(XKAXIS) +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 - ! 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 +END SUBROUTINE CC_GRID_RELEASE_BLOCKED_CELL_LISTS - ! 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) +SUBROUTINE DEALLOCATE_CUTCF_CONN_MESH(NM) - 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 +INTEGER, INTENT(IN) :: NM - ! 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 +INTEGER :: ICC, ICF, I, J, K, DO_BNCF=1 +INTEGER, PARAMETER :: LOIN=-1 +INTEGER, PARAMETER :: HIIN= 2 - ENDDO - ENDDO - CYCLE ! Skips rest of iseg loop, for this ISEG. - ENDIF +! 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 - ENDIF +SUBROUTINE CC_GRID_APPLY_SPECIAL_CELL_BLOCKING(NM) - ! 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 +INTEGER, INTENT(IN) :: NM - ! 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) +INTEGER :: I,J,K,ICC,ICC1 +TYPE(CC_CUTCELL_TYPE), POINTER :: CC - ! 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 +! 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)) + 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 - ! 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 +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) +MESHES(NM)%N_SPCELLS_TO_BLOCK = 0 - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 - INDIF=INDXI(XIAXIS) - INDJF=INDXI(XJAXIS) - INDKF=INDXI(XKAXIS) +END SUBROUTINE CC_GRID_APPLY_SPECIAL_CELL_BLOCKING - ! 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 +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 + ENDIF ENDIF + ENDDO +ENDDO NCELL_LOOP_1 - ! Add vertices, non repeated vertex entries at this point. - NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT +END SUBROUTINE CC_GRID_GET_SINGLE_CELL_POLICY - ! 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) +SUBROUTINE CC_GRID_SELECT_SURVIVOR_JCC(CC,CELL_BLOCK_IOR,CELL_BLOCK_ORIENTATION,SURVIVOR_JCC) - 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 +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 - ! 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 +INTEGER :: J +REAL(EB), ALLOCATABLE, DIMENSION(:) :: SCORE - ENDDO +ALLOCATE(SCORE(1:CC%NCELL)) -ENDDO SEGS_LOOP +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) -! 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 +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 -ENDDO + 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 -! 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. +DEALLOCATE(SCORE) - ! 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 +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 -T_CC_USED(GET_CARTFACE_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTEDGES_TIME_INDEX) + CURRENT_TIME() - TNOW +END SUBROUTINE CC_GRID_TAG_BLOCKED_SPLIT_PIECES -RETURN -END SUBROUTINE GET_CARTFACE_CUTEDGES +SUBROUTINE CC_GRID_ENFORCE_ONE_CC_PER_CARTESIAN_CELL(NM) -! -------------------------- GET_IS_SOLID_PT ------------------------------------ +INTEGER, INTENT(IN) :: NM -SUBROUTINE GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) +INTEGER :: J,ICC1,NACTIVE,SURVIVOR_JCC,CELL_BLOCK_IOR +REAL(EB) :: CELL_BLOCK_ORIENTATION(IAXIS:KAXIS) +TYPE(CC_CUTCELL_TYPE), POINTER :: CC -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 (.NOT.ONE_CC_PER_CARTESIAN_CELL) RETURN -! 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 +! 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 -! 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 + 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 -! Define crossings: -IF(ABS(NVEC(IAXIS)) > ABS(NVEC(JAXIS))) THEN ! Do X2 ray - SCEN = XY(IAXIS); XRAY=XY(JAXIS); XAXIS=X3AXIS +END SUBROUTINE CC_GRID_ENFORCE_ONE_CC_PER_CARTESIAN_CELL - 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)) +SUBROUTINE CC_GRID_REBUILD_LOCAL_FACE_AND_LINK_INFO(NM) - ! 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, INTENT(IN) :: NM - ! 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)) +CALL GET_CC_FACE_CELL_LIST_INFO(NM,PHASE=1) - 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 +! Here: 1,2. Define Linking information for cut-cells. +CALL GET_CELL_LINK_INFO(NM) - ! 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) +END SUBROUTINE CC_GRID_REBUILD_LOCAL_FACE_AND_LINK_INFO - ! 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 CC_GRID_ACCUMULATE_BLOCKED_INB_AREA_OLD(NM,GEOM_AREA_SURF_OLD) - ! 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) +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 - ! 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 - ENDDO + ENDDO +ENDDO -ELSE ! Do X3 ray - SCEN=XY(JAXIS); XRAY=XY(IAXIS); XAXIS=X2AXIS; +END SUBROUTINE CC_GRID_ACCUMULATE_BLOCKED_INB_AREA_OLD - 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)) +SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH(NM,CC_COMPUTE_MESH,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_AREA_SURF_OLD) - ! 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, 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 - ! 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)) +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 - 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 +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.TRUE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) - ! 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) +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) - ! 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; +CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) - ! 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 +END SUBROUTINE CC_GRID_POSTBUILD_BLOCK_AND_LINK_MESH + +SUBROUTINE CC_GRID_POSTPROCESS_AND_CLEANUP(NM,CC_COMPUTE_MESH,GEOM_AREA_SURF_NEW) + +INTEGER, INTENT(IN) :: NM +LOGICAL, INTENT(IN), DIMENSION(:) :: CC_COMPUTE_MESH +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_AREA_SURF_NEW + +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 + +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 - 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 + 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) +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) -REAL(EB), INTENT(IN) :: XYZV(MAX_DIM) -INTEGER, INTENT(IN) :: NM,CEI -INTEGER, INTENT(INOUT):: NVERT -INTEGER, INTENT(OUT) :: INOD +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 -! 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 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 -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 +! 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 -NVERT = NVERT + 1 -INOD = NVERT -CALL REALLOCATE_EDGE_VERT(NM,CEI,NVERT) -MESHES(NM)%CUT_EDGE(CEI)%XYZVERT(IAXIS:KAXIS,INOD) = XYZV(IAXIS:KAXIS) +ALLOCATE(M%CHEM_ACTIVE_CC(SUM_CC,3)) +M%CHEM_ACTIVE_CC=-1 + +END SUBROUTINE CC_GRID_ALLOCATE_STATE_VARS + +SUBROUTINE CC_GRID_LOG_PROCESSING_TIME(TNOW,CPUTIME_START_MESH) + +REAL(EB), INTENT(IN) :: TNOW, CPUTIME_START_MESH -RETURN -END SUBROUTINE INSERT_FACE_VERT +REAL(EB) :: CPUTIME_MESH -! ------------------------- INSERT_FACE_VERT_LOC(XYZ,NVERT,INOD1,XYZVERT) +! Add to SET_CUTCELLS_3D loop time: +T_CC_USED(SET_CUTCELLS_TIME_INDEX) = T_CC_USED(SET_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW -SUBROUTINE INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,NVERT,INOD,XYZVERT) +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 -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 +END SUBROUTINE CC_GRID_LOG_PROCESSING_TIME -REAL(EB), PARAMETER :: VERT_PROX_FCT = 1000._EB +SUBROUTINE CC_GRID_FINALIZE_BOOKKEEPING(CC_COMPUTE_MESH,CALL_COUNT,EARLY_RETURN) -! 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) +LOGICAL, ALLOCATABLE, INTENT(INOUT), DIMENSION(:) :: CC_COMPUTE_MESH +INTEGER, INTENT(INOUT) :: CALL_COUNT +LOGICAL, INTENT(OUT) :: EARLY_RETURN -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) +INTEGER :: IERR -RETURN -END SUBROUTINE INSERT_FACE_VERT_LOC +EARLY_RETURN = .FALSE. -! ----------------------- GET_CARTFACE_CUTFACES --------------------------------- +IF(ALLOCATED(CC_COMPUTE_MESH)) DEALLOCATE(CC_COMPUTE_MESH) -SUBROUTINE GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) +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 -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -LOGICAL, INTENT(IN) :: BNDINT_FLAG +! 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 -! 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 CC_GRID_FINALIZE_BOOKKEEPING -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. +SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST(GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW) -INTEGER, SAVE :: SIZE_CFACES_CFELEM, SIZE_VERTS_CFELEM -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CFELEM2,CEDGES,CEDGES2 -INTEGER, ALLOCATABLE, DIMENSION(:) :: CFE, CFEL +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_AREA_SURF_OLD,GEOM_AREA_SURF_NEW -INTEGER, SAVE :: SIZE_EDGES_NODEDG, SIZE_VERTS_NODEDG -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NODEDG_FACE +INTEGER :: I,J,NM,ICF,IERR +TYPE(CC_CUTFACE_TYPE), POINTER :: CF -LOGICAL :: SEG_FLAG(CC_MAXCEELEM_FACE) -INTEGER :: NUMEDG_NODE(CC_MAXVERTS_FACE) +! 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 -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 +! 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) -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 +END SUBROUTINE CC_GRID_UPDATE_INBOUNDARY_AREA_ADJUST -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) +SUBROUTINE CC_GRID_WRITE_VERBOSE_SUMMARY -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 :: 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 -! 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) +! 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) MESHES(NM) - ! 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 + 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) - ! 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) + ! 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 - 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) + 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 - ! 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) +END SUBROUTINE CC_GRID_BUILD_GCELLS - ! 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 - MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_CUTCFE +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) +#ifdef WITHOUT_MPIF08 +USE MPI +#else +USE MPI_F08 +#endif - ! Build segment list: - NSEG = 0 - NVERT = 0 - NFACE = 0 +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 +#ifdef WITHOUT_MPIF08 +INTEGER :: MPISTATUS(MPI_STATUS_SIZE) +#else +TYPE(MPI_STATUS) :: MPISTATUS +#endif +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 - 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 (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 +! Reset variables: +CC_NEDGECROSS = 0 +CC_NCUTEDGE = 0 +CC_NCUTFACE = 0 +CC_NCUTCELL = 0 - ! 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) +! 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 - ! 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) +! Get geometry triangle bins in Cartesian directions: +CALL GET_GEOM_TRIBIN(CC_COMPUTE_MESH) - ! 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) +! 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) - ! 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) +! Initialize GEOMETRY fields used by CC_IBM: +CALL CC_INIT_GEOM; IF (STOP_STATUS==SETUP_STOP) RETURN - ! 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) +TNOW=CURRENT_TIME() - ! 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 +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 - ! 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) + IF (PROCESS(NM)/=MY_RANK) CYCLE - ! 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) + ! Mesh sizes: + NXB=MESHES(NM)%IBAR + NYB=MESHES(NM)%JBAR + NZB=MESHES(NM)%KBAR - ! 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) + 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 - ! 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) + ENDDO MESH_LOOP + CLOSE(33) - ! 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 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 - ! 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 + ! 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) - ! 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) + ! 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) - ! 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) + ! 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) - ! 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) + ! 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) - ! 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) + ! 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 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 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) - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) - ANGSEG(NSEG) = 0._EB - ENDDO - ENDIF + ENDDO GEOM_LOOP +ENDIF DEBUG_SET_CUTCELLS_COND - ! 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) +! Select MESHES assigned to MY_RANK and OMESHES of these. Cut-cells computed for all of them. Done in GET_GEOM_TRIBIN - ! 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) +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 - ! 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) +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 - ! 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 CC_GRID_GLOBAL_INIT - ! 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) +SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH,GEOM_ZMAX_AUX) - ! ADD segment: - NSEG = NSEG + 1 - SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) - ANGSEG(NSEG) = PI - ENDDO - ENDIF +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 - ! 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 (.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 - ! 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) +CALL POINT_TO_MESH(NM) +M => MESHES(NM) +! Mesh sizes: +NXB=IBAR +NYB=JBAR +NZB=KBAR - IBOD = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) - STYPE = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(5,IEDGE) +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) - ! 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) +REGCC_REGION_IF : IF(PERIODIC_TEST==7 .OR. PERIODIC_TEST==11) THEN - ! 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_GET_REGULAR_CUTCELLS_BOX(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) - ! 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 +ELSE + CALL CC_GRID_BUILD_CUTCELL_MESH_WORK(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) - ! 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 +ENDIF REGCC_REGION_IF - 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 +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 - ! 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 +END SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH - ! 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 +SUBROUTINE DEFINE_XYZFACE_CELL(NM,ALLOC_FLG,ISTR,IEND,JSTR,JEND,KSTR,KEND) - ! 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 +INTEGER, INTENT(IN) :: NM +LOGICAL, INTENT(IN) :: ALLOC_FLG +INTEGER, INTENT(INOUT) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +INTEGER :: IGC - ! 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 +CALL POINT_TO_MESH(NM) +M => MESHES(NM) - ! 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. +IF (ALLOC_FLG) THEN - 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 + ! 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. - ! Infamous infinite loop: - INF_LOOP : DO + ! 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. - FOUNDSEG = .FALSE. - N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. - ANGCOUNT = ANGSEG(NEWSEG) + ! 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. - ! 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 + ! 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 - ! 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 + ! 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 - ! 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 + ! 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 - ! Break loop: - IF ( NSEG_LEFT == 0 ) EXIT +ELSE - ! 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 + ! 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 INF_LOOP + ! 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) - ! 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 +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 +RETURN +END SUBROUTINE DEFINE_XYZFACE_CELL - ! 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)) /) +! --------------------------- GET_GEOM_TRIBIN -------------------------------------- - ! 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 +! 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 - 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 +! Loop geometries: +LOOP_GEOM : DO IG = 1, N_GEOMETRY - ! 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 + G=>GEOMETRY(IG) - ! Centroid node for ICF1: - XYC1(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF1 ) ! [x2axis x3axis] + ! 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. - ! 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 + ! Loop Faces: + DO IWSEL = 0,G%N_FACES-1 + WSELEM(NOD1:NOD3) = G%FACES(3*IWSEL+1:3*IWSEL+3) - CALL TEST_PT_INPOLY(NP2,XY,XYC1,PTSFLAG) + ! 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 ( PTSFLAG ) THEN ! Centroid of face 1 inside Face 2. + G%MAX_LEDGE = MAX(G%MAX_LEDGE,LEDGE) + G%MIN_LEDGE = MIN(G%MIN_LEDGE,LEDGE) + G%MEAN_LEDGE= G%MEAN_LEDGE + LEDGE - FINFACE(ICF1) = ICF2 - NFACE = NFACE - 1 + 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 - ! Redefine areas in case of faces with holes: - AREA2 = AREAV(ICF2) + 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. - ! Area with hole, AREA1 has negative sign: - AREAH = AREA2 + AREA1 + ! Now define Bin sizes to distribute Faces subsets: + DO X1AXIS=IAXIS,KAXIS - IF (ABS(AREAH) < GEOMEPS) THEN ! Hole of same size as cut-face, drop both. - FINFACE(ICF2) = ICF1 - CYCLE - ENDIF + ! 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 - ! Centroid with hole: - XYC2(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF2 ) ! [x2axis x3axis] - XYH(1:2) = (AREA1 * XYC1(1:2) + AREA2 * XYC2(1:2)) / AREAH + ! Define number of bins in direction X1AXIS: + G%TBAXIS(X1AXIS)%N_BINS = CEILING(LX1/(GAMMA_MULT*G%MEAN_LEDGE)) - ! So ICF2 has the area with hole properties: - AREAV(ICF2) = AREAH - XYZCEN(JAXIS,ICF2) = XYH(IAXIS) - XYZCEN(KAXIS,ICF2) = XYH(JAXIS) + ! No overlap between procs meshes and Geometry, cycle: + IF (G%TBAXIS(X1AXIS)%N_BINS < 1) THEN; G%TBAXIS(X1AXIS)%N_BINS = 0; CYCLE; ENDIF - ! 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) + 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))) - EXIT - ENDIF - ENDDO - ENDIF - ENDDO + ! 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)) - ! 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) + ! 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 - ! Here reallocate CFELEM, CEDGES CFE, CFEL if NP > SIZE_VERTS_CFELEM: - CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) - CFE(1) = NP + ! 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 - DO II2=2,NP1+1 - CFE(II2) = CFELEM(II2,ICF1) - ENDDO - II2 = (NP1+1) + 1 - CFE(II2) = CFELEM(2,ICF1) + ENDDO + ENDDO + END DO - ! 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 + ! 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 - 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) +ENDDO LOOP_GEOM - ! Copy CFE into CFELEM(1:np+1,icf2): - CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) +RETURN +END SUBROUTINE GET_GEOM_TRIBIN - ! 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) +! --------------------------- SNAP_GEOM_NODES -------------------------------------- - ENDIF - ENDDO +SUBROUTINE SNAP_GEOM_NODES(ISTR,IEND,JSTR,JEND,KSTR,KEND,CC_COMPUTE_MESH) - NVERTFACE = MAXVAL(CFELEM(1,1:NFACE)) + 1 +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,X1PLN +REAL(EB) :: CPUTIME_START, CPUTIME - ! 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 +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 - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +! 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 - 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 +! Now Mesh loop on mesh + guard planes to test against +! Main Loop over Meshes: +MAIN_MESH_LOOP : DO NM=1,NMESHES - ! ! 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 (.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) + ! 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 - ! 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 + DEALLOCATE(X1FACE,DX1FACE) - 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 + ENDDO AXIS_LOOP_2 + CALL DEFINE_XYZFACE_CELL(NM,ALLOC_FLG=.FALSE.,ISTR=ISTR,IEND=IEND,JSTR=JSTR,JEND=JEND,KSTR=KSTR,KEND=KEND) +ENDDO MAIN_MESH_LOOP - ! 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) +! Deallocate SNAP_NODE in geometries: +DO IG=1,N_GEOMETRY + DEALLOCATE(GEOMETRY(IG)%SNAP_NODE) +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) +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 - ! 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) +END SUBROUTINE SNAP_GEOM_NODES - ! 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 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 - ENDDO - ENDIF +! 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 - ! 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) +! 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)) - 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 +! 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(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 +! 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)) - 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 +! 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(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 +! Allocate array for special cells containing geometry intersections: +CALL CC_GRID_ALLOCATE_CELLRT(ISTR,IEND,JSTR,JEND,KSTR,KEND) - ! 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 +! 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) - ! 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 +END SUBROUTINE CC_GRID_INIT_MESH_STORAGE - ! 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 +SUBROUTINE CC_GRID_STORE_SPECIAL_CELLS_TO_BLOCK(NM) - ! 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 +INTEGER, INTENT(IN) :: NM +INTEGER, ALLOCATABLE, DIMENSION(:) :: SPCELLS_TO_BLOCK_TMP - ! 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 +MESHES(NM)%N_SPCELLS_TO_BLOCK = N_SPCELLS_TO_BLOCK +IF (ALLOCATED(MESHES(NM)%SPCELLS_TO_BLOCK)) DEALLOCATE(MESHES(NM)%SPCELLS_TO_BLOCK) - NSSEG=COUNT +IF (N_SPCELLS_TO_BLOCK < 1) THEN + IF (ALLOCATED(SPCELLS_TO_BLOCK)) DEALLOCATE(SPCELLS_TO_BLOCK) + RETURN +ENDIF - ! 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 (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 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 - ! 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 + FIRST_CALL =.FALSE. +ENDIF - ! Discard face with less than 3 edges (triangle): - IF ( NSSEG < 3 ) CYCLE +IF (.NOT.FIRST_CALL_ARG) RETURN - ! 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 +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) - ! 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 +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)) - ! 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. +FIRST_CALL_ARG=.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 +END SUBROUTINE ALLOCATE_BODINT_PLANE - ! Infamous infinite loop: - INF_LOOP2 : DO +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) - FOUNDSEG = .FALSE. - N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. - ANGCOUNT = ANGSEG(NEWSEG) +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 - ! 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 +! 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 - IF ( DANGI > DANG ) THEN - NEWSEG = ISEG - DANG = DANGI - FOUNDSEG = .TRUE. - ENDIF - ENDIF - 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 - ! 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 +INTEGER :: WSELEM(NOD1:NOD3), MYAXIS +REAL(EB):: FACECUBE(LOW_IND:HIGH_IND,IAXIS:KAXIS) - ! 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 +IG = INDX1 +TNOW = CURRENT_TIME() - ! Break loop: - IF ( NSEG_LEFT == 0 ) EXIT +! Now allocate BODINT_PLANE: +BODINT_PLANE%NNODS = 0 +BODINT_PLANE%NSGLS = 0 +BODINT_PLANE%NSEGS = 0 +BODINT_PLANE%NTRIS = 0 - ! 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 +! Main Loop over Geometries: +MAIN_GEOM_LOOP : DO IG=1,N_GEOMETRY - ENDDO INF_LOOP2 + 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)) - ! 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 + ! 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 - ! 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 ( X1PLN < GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_LOW-GEOMEPS) CYCLE + IF ( X1PLN > GEOMETRY(IG)%TBAXIS(X1AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE - ! 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 GEOMEPS) CYCLE + IF( (X1PLN-FACECUBE(HIGH_IND,X1AXIS)) > GEOMEPS) CYCLE - 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 - 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 + ! 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 - ! 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 + ! Test if IWSEL lays in X1PLN: + IF ( (ABS(DOT1)+ABS(DOT2)+ABS(DOT3)) == 0._EB ) THEN - ! Centroid node for ICF1: - XYC1(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF1 ) ! [x2axis x3axis] + ! Force nodes location in X1PLN plane: + XYZV(X1AXIS,NOD1:NOD3) = X1PLN - ! 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 + ! 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)) - CALL TEST_PT_INPOLY(NP2,XY,XYC1,PTSFLAG) + ! 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)) - IF ( PTSFLAG ) THEN ! Centroid of face 1 inside Face 2. + ! 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)) - FINFACE(ICF1) = ICF2 - NSFACE = NSFACE - 1 + ! 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 /) - ! Redefine areas in case of faces with holes: - AREA2 = AREAV(ICF2) + CYCLE ! Next WSELEM - ! Area with hole, AREA1 has negative sign: - AREAH = AREA2 + AREA1 + ENDIF - IF (ABS(AREAH) < GEOMEPS) THEN ! Hole of same size as cut-face, drop both. - FINFACE(ICF2) = ICF1 - CYCLE - 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 - ! Centroid with hole: - XYC2(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF2 ) ! [x2axis x3axis] - XYH(1:2) = (AREA1 * XYC1(1:2) + AREA2 * XYC2(1:2)) / AREAH + ! Line 1, from node 2 to 3: + LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) + LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - ! 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 + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) - ! 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) + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - ! Here reallocate CFELEM, CFE, CFEL if NP > SIZE_VERTS_CFELEM: - CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) + ! Line 2, from node 1 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - CFE(1) = NP + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) - DO II2=2,np1+1 - CFE(II2) = CFELEM(II2,icf1) - ENDDO - II2 = (np1+1) + 1 - CFE(II2) = CFELEM(2,icf1) + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) - 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) + ! 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 /) - ! Copy CFE into CFELEM(1:np+1,icf2): - CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) + CYCLE ! Next WSELEM - ENDIF - ENDDO + 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 - NVERTFACE = MAXVAL(CFELEM(1,1:NSFACE2)) + 1 + ! Line 1, from node 1 to 2: + LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) - ! 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) + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) - ! 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 + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - ENDIF SOLID_FACE_IF + ! Line 2, from node 1 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - ENDDO ! JJ - ENDDO ! KK - ENDDO ! II + 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 /) - DEALLOCATE(X1FACE,X2FACE,X3FACE) + CYCLE ! Next WSELEM - ENDDO XIAXIS_LOOP + 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 -ENDDO IBNDINT_LOOP + ! Line 1, from node 1 to 2: + LN1(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN1(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) -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 + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN1,XYZ_INT1,INTFLG) - SELECT CASE(X1AXIS) - case(IAXIS) + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - X2AXIS = JAXIS - X3AXIS = KAXIS + ! Line 2, from node 2 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) - ! 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 + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) - ! Local indexing in x1, x2, x3: - X1LO = ILO; X1HI = IHI - X2LO = JLO; X2HI = JHI - X3LO = KLO; X3HI = KHI + ! 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 /) - CASE(JAXIS) + CYCLE ! Next WSELEM - X2AXIS = KAXIS - X3AXIS = IAXIS + ENDIF - ! 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 + ! 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 - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS + ! First node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN - ! Local indexing in x1, x2, x3: - X1LO = JLO; X1HI = JHI - X2LO = KLO; X2HI = KHI - X3LO = ILO; X3HI = IHI + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - CASE(KAXIS) + ! 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 - X2AXIS = IAXIS - X3AXIS = JAXIS + CYCLE ! Next WSELEM - ! 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 + 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 - ! location in I,J,K od x2,x2,x3 axes: - XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS + ! Second node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN - ! Local indexing in x1, x2, x3: - X1LO = KLO; X1HI = KHI - X2LO = ILO; X2HI = IHI - X3LO = JLO; X3HI = JHI + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - END SELECT + ! 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 - ! Loop on Cartesian faces, local x1, x2, x3 indexes: - DO II=X1LO,X1HI - DO KK=X3LO,X3HI - DO JJ=X2LO,X2HI + CYCLE ! Next WSELEM - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 - INDI = INDXI(XIAXIS) - INDJ = INDXI(XJAXIS) - INDK = INDXI(XKAXIS) + 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 - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE + ! Third node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN - ! 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) + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - 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) + ! 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 - ! 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) + CYCLE ! Next WSELEM - ! 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 + ENDIF - ENDDO ! JJ - ENDDO ! KK - ENDDO ! II + ! 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 XIAXIS_LOOP_2 + ! First node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN -ELSE - DEALLOCATE(IJK_COUNTED) -ENDIF + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -DEALLOCATE(NODEDG_FACE) -DEALLOCATE(CFELEM,CEDGES,CFE,CFEL) + ! Line 2, from node 2 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD2) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) -T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) -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 + ! 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 /) -RETURN + CYCLE ! Next WSELEM -CONTAINS + 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 -SUBROUTINE REALLOCATE_NODEDG_FACE(N_SEG_CFACE,N_VERT_CFACE) + ! Second node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT1(X1AXIS) = X1PLN -INTEGER, INTENT(IN) :: N_SEG_CFACE,N_VERT_CFACE -INTEGER :: DFCTE,DFCTV + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -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 + ! Line 2, from node 1 to 3: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD3) -SUBROUTINE REALLOCATE_LOCAL_CFELEM(N_VERT_CFACE,N_FACE_CFACE) + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) -INTEGER, INTENT(IN) :: N_VERT_CFACE, N_FACE_CFACE -INTEGER :: DFCTF,DFCTV + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -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 + ! 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 /) + CYCLE ! Next WSELEM -SUBROUTINE REALLOCATE_LOCAL_VERT_CFELEM(N_VERT_CFACE) + 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 -INTEGER, INTENT(IN) :: N_VERT_CFACE -INTEGER :: DFCTV -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM_AUX,CEDGES_AUX + ! Third node is an intersection point: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN -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 + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -END SUBROUTINE GET_CARTFACE_CUTFACES + ! Line 2, from node 1 to 2: + LN2(IAXIS:KAXIS,NOD1) = XYZV(IAXIS:KAXIS,NOD1) + LN2(IAXIS:KAXIS,NOD2) = XYZV(IAXIS:KAXIS,NOD2) + CALL LINE_INTERSECT_COORDPLANE(X1AXIS,X1PLN,PLNORMAL,LN2,XYZ_INT2,INTFLG) -! ---------------- DEFINE_REGULAR_CUTFACES -------------------------- + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -SUBROUTINE DEFINE_REGULAR_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) + ! 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 /) -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -LOGICAL, INTENT(IN) :: BNDINT_FLAG + CYCLE ! Next WSELEM -! Local Variables: -INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI,X1AXIS,NVERT,NFACE,I,J,K,NCUTFACE -INTEGER :: IBNDINT,BNDINT_LOW,BNDINT_HIGH + ENDIF + ENDIF ONLY_TRIANG_EDGES_COND -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED + ! Case D: A triangle segment is in the plane. + ! Intersection is line 1-2: + IF ( (DOT1 == 0._EB) .AND. (DOT2 == 0._EB) ) THEN -CALL POINT_TO_MESH(NM) + ! First node: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT1(X1AXIS) = X1PLN -! Mesh sizes: -NXB=IBAR -NYB=JBAR -NZB=KBAR + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) -! 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 + ! Second node: + XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD2); XYZ_INT2(X1AXIS) = X1PLN + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) -! 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 + ! 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 -IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, - ! 4 guard-cell faces. + CYCLE ! Next WSELEM - ! 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 + ENDIF + ! Intersection is line 2-3: + IF ( (DOT2 == 0._EB) .AND. (DOT3 == 0._EB) ) THEN - ! 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 + ! 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 - ! 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 + CYCLE ! Next WSELEM - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. + ENDIF + ! Intersection is line 3-1: + IF ( (DOT3 == 0._EB) .AND. (DOT1 == 0._EB) ) THEN - FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE + ! Third node: + XYZ_INT1 = XYZV(IAXIS:KAXIS,NOD3); XYZ_INT1(X1AXIS) = X1PLN - 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 + ! Index to XYZ_INT1: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT1,IND_P(NOD1)) - FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE + ! First node: + XYZ_INT2 = XYZV(IAXIS:KAXIS,NOD1); XYZ_INT2(X1AXIS) = X1PLN - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + ! Index to XYZ_INT2: + CALL GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ_INT2,IND_P(NOD2)) - 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) + ! 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 - ! 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 ) /) + CYCLE ! Next WSELEM - ! Centroid: - CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & - (/ XFACE(I )+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) + ENDIF - ! 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) + ! 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 - ! 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 + ENDDO ! IWSEL - ! 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 + EXIT IBIN_DO ! No need to test more bins. - ! 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 + ENDDO IBIN_DO - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. +ENDDO MAIN_GEOM_LOOP - 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 +! 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 - FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE + DO ITRI=1,BODINT_PLANE%NTRIS - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + ! Triang conectivities: + ELEM(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) - 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) + ! 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)) /) - ! 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) /) + ! 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 - ! Centroid: - CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & - (/ XFACE(I-1)+XFACE(I ), YFACE(J )+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) + ! 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) /) - ! 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) + ! 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 /) - ! 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 + ENDIF ENDDO ENDDO + 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 +! 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)) + + ! 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) /) + + ! Now related WS triangles centroids: + IWSEL1 = BODINT_PLANE%INDSEG(2,ISEG) + IWSEL2 = BODINT_PLANE%INDSEG(3,ISEG) + IG = BODINT_PLANE%INDSEG(4,ISEG) + + ! 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) - ! 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 + ! 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) - ! Drop if cut-face has already been counted: - IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. + ! 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) /) - FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE + VCT(1:2) = 0 + PCT(IAXIS:JAXIS,1:2) = 0._EB - 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 + ! 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 - FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE + ! 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 - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + IF ( (VCT(1) == 0) .OR. (VCT(2) == 0) ) THEN + print*, "Error GET_BODINT_PLANE: One component of vct == 0." + 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) = (/ 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) + ! Cross product of v1 and v2 gives magnitude along x2p axis: + CTST = VEC(IAXIS,1)*VEC(JAXIS,2) - VEC(JAXIS,1)*VEC(IAXIS,2) - ! 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) /) + ! Now tests: + ! Start with SOLID GASPHASE definition for segtype: + BODINT_PLANE%SEGTYPE(NOD1:NOD2,ISEG) = (/ CC_SOLID, CC_GASPHASE /) - ! Centroid: - CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & - (/ XFACE(I-1)+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K )+ZFACE(K ) /) + ! 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 - ! 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) + ! 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 - ! 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 + ENDIF +ENDDO -ENDDO IBNDINT_LOOP -IF (.NOT.BNDINT_FLAG) DEALLOCATE( IJK_COUNTED ) +! 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)) -RETURN -END SUBROUTINE DEFINE_REGULAR_CUTFACES +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 -! ---------------------------- SORT_VERTS --------------------------------------- + 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 SORT_VERTS(MAXVERTS,NVERTS,VERTS1,VERTS2,XV,ASCDESC,NV,V) +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) -INTEGER, INTENT(IN) :: MAXVERTS, NVERTS -REAL(EB),INTENT(IN) :: VERTS1(MAXVERTS),VERTS2(MAXVERTS),XV -LOGICAL, INTENT(IN) :: ASCDESC -INTEGER, INTENT(OUT):: NV,V(MAXVERTS) +DEALLOCATE(SEGAUX,INDSEGAUX,SEGTYPEAUX) -! Local Variables: -INTEGER :: IV, IIV, JJV -INTEGER :: V2(MAXVERTS) -LOGICAL :: FOUND +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 -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 +! 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 -RETURN -END SUBROUTINE SORT_VERTS -! ----------------------------- FACE_REALLOC ------------------------------------- +! 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 -SUBROUTINE FACE_REALLOC(NM,ICF,NVERT,NFACE,NSVERT,NSFACE,NVERTFACE_NEW) + ! End nodes to cross: + SEG(NOD1:NOD2) = BODINT_PLANE%SEGS(NOD1:NOD2,ISEG) -INTEGER, INTENT(IN) :: NM,ICF,NVERT,NFACE,NSVERT,NSFACE -INTEGER, INTENT(INOUT) :: NVERTFACE_NEW + 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 -! 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 + XYZ1(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD1)) + XYZ2(IAXIS:KAXIS) = BODINT_PLANE%XYZ(IAXIS:KAXIS,SEG(NOD2)) -NVERTFACE=SIZE(MESHES(NM)%CUT_FACE(ICF)%CFELEM,DIM=1) -NVERTFACE_NEW = MAX(NVERTFACE_NEW,NVERTFACE) + ! 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) -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 + ! 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(SIZE(MESHES(NM)%CUT_FACE(ICF)%AREA,DIM=1) 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 - 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) +! 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 - 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) + ! 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 - 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) + ! Test for segment-segment intersection: + CALL GET_SEGSEG_INTERSECTION(P1,D1,P2,D2,SVARV,SLENV,INT_FLG) - ALLOCATE(REAL1D(1:NFACE+NSFACE)); REAL1D = 1._EB - CALL MOVE_ALLOC(FROM=REAL1D,TO=MESHES(NM)%CUT_FACE(ICF)%AREA_ADJUST) + ! 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 - 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) + ! 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) - ENDIF -ENDIF + ! 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 -RETURN + ! 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 SUBROUTINE FACE_REALLOC + ! 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 -! ---------------------- CUT_FACE_ARRAY_REALLOC ------------------------------- -SUBROUTINE CUT_FACE_ARRAY_REALLOC(NM,ICF) +! 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 -INTEGER, INTENT(IN) :: NM,ICF +ALLOCATE(CIRC_MED(MAX_SEG_NODE+1)) +INOD_LOOP : DO INOD = 1,BODINT_PLANE%NNODS + IF (SEGS_NODE(INOD) < 3) CYCLE INOD_LOOP -! Local Variables: -INTEGER :: ICF1, SIZE_CUT_FACE + ! 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 -SIZE_CUT_FACE = SIZE(MESHES(NM)%CUT_FACE,DIM=1) + ! 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(ICF > SIZE_CUT_FACE) THEN + ! 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) - ALLOCATE(CUT_FACE_AUX(SIZE_CUT_FACE+GLOBAL_DELTA_FACE)) +T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) = T_CC_USED(GET_BODINT_PLANE_TIME_INDEX) + CURRENT_TIME() - TNOW - DO ICF1=1,ICF-1 - CALL CUT_FACE_MOVE(MESHES(NM)%CUT_FACE(ICF1),CUT_FACE_AUX(ICF1)) +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 - CALL MOVE_ALLOC(FROM=CUT_FACE_AUX,TO=MESHES(NM)%CUT_FACE) + 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 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) - -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 GET_BODINT_PLANE +SUBROUTINE GET_X2_INTERSECTIONS(X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN) -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) +INTEGER, INTENT(IN) :: X1AXIS, X2AXIS, X3AXIS +REAL(EB),INTENT(IN) :: X3RAY,X1PLN -RETURN -END SUBROUTINE CUT_FACE_MOVE +! 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 +REAL(EB) :: TNOW +! INTEGER :: IAUX -! ---------------------------- FACE_DEALLOC ------------------------------------- +TNOW = CURRENT_TIME() -SUBROUTINE FACE_DEALLOC(NM,ICF,DO_BNCF) +! 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, INTENT(IN) :: NM,ICF -INTEGER, OPTIONAL, INTENT(IN) :: DO_BNCF +! 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) -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) + ! 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 -IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%BODTRI)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI) + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) ! Modifies crossings arrays. + ENDIF +ENDDO -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) +! Now Segments: +NSEGS_COND : IF (BODINT_PLANE%NSEGS > 0) THEN -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) +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(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) + IF (X3RAY < BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%X1_LOW -GEOMEPS) CYCLE + IF (X3RAY > BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%X1_HIGH+GEOMEPS) CYCLE + TRIBIN_DO : DO IISEG=1,BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%NTL -RETURN -END SUBROUTINE FACE_DEALLOC + ISEG = BODINT_PLANE%TBAXIS(X3AXIS)%TRIBIN(IBIN)%TRI_LIST(IISEG) +!SEGMENTS_LOOP : DO ISEG=1,BODINT_PLANE%NSEGS -! -------------------------- NEW_FACE_ALLOC ------------------------------------- + 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)) -SUBROUTINE NEW_FACE_ALLOC(NM,ICF,NVERT,NFACE,NVERTFACE,IBNDINT) + ! 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, INTENT(IN) :: NM,ICF,NVERT,NFACE,NVERTFACE -INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT + ! 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)) -! 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 (OUTRAY) CYCLE -! 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 + DOT1 = X3_1-X3RAY + DOT2 = X3_2-X3RAY -!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 (ABS(DOT1) <= GEOMEPS) DOT1 = 0._EB + IF (ABS(DOT2) <= GEOMEPS) DOT2 = 0._EB -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI(1:2,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%BODTRI = CC_UNDEFINED + ! 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) -ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%UNKZ(LOW_IND:HIGH_IND,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%UNKZ = CC_UNDEFINED + ! 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; -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 + ! Test if whole segment is in ray, if so add segment nodes as crossings: + IF ( (ABS(DOT1)+ABS(DOT2)) == 0._EB ) THEN -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 + ! 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 -RETURN -END SUBROUTINE NEW_FACE_ALLOC + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + 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 -! -------------------------- ALLOC_FACE_STATE_VARS ------------------------------------- + ! Point 2: + SVARI = MAX(X2_1,X2_2) + ICRSI(LOW_IND:HIGH_IND+1) = (/ CC_SOLID, CC_GASPHASE, CC_UNDEFINED /) + SCRSI = ISEG -SUBROUTINE ALLOC_FACE_STATE_VARS(NM,ICF,NFACE,IBNDINT) + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) -INTEGER, INTENT(IN) :: NM,ICF,NFACE -INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT + CYCLE + ENDIF -! !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) + ! Now nodes individually: + IF ( ABS(DOT1) == 0._EB ) THEN -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 + ! Point 1: + SVARI = X2_1 -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 + ! 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 -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; + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) -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 + CYCLE -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 + IF ( ABS(DOT2) == 0._EB ) THEN -RETURN -END SUBROUTINE ALLOC_FACE_STATE_VARS + ! Point 2: + SVARI = X2_2 -! -------------------------- TEST_PT_INPOLY ------------------------------------- + ! 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 TEST_PT_INPOLY(NP,XY,XY1,PTSFLAG) + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) -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 + CYCLE -! Local Variables: -INTEGER :: RCROSS, LCROSS, IP -REAL(EB):: XPT -LOGICAL :: RS, LS + ENDIF -PTSFLAG = .FALSE. -RCROSS = 0 -LCROSS = 0 + ! 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 first point location at the end of XY (assumes CC_MAXVERTS_FACE > NP): -XY(IAXIS:JAXIS,NP+1) = XY(IAXIS:JAXIS,1) + ! 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) + + ! 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 -! Shift origin to XY1: -DO IP=1,NP+1 - XY(IAXIS:JAXIS,IP) = XY(IAXIS:JAXIS,IP) - XY1(IAXIS:JAXIS) -enddo + ! Insertion sort: + CALL INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) + + CYCLE -! 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 ( 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)) + print*, "Error GET_X2INTERSECTIONS: Missed segment=",ISEG - IF (RS .AND. (XPT > 0._EB)) RCROSS = RCROSS + 1 - IF (LS .AND. (XPT < 0._EB)) LCROSS = LCROSS + 1 - ENDIF -ENDDO + ENDDO TRIBIN_DO +ENDDO IBIN_DO +!ENDDO SEGMENTS_LOOP -IF ( MOD(RCROSS,2) /= MOD(LCROSS,2) ) THEN ! Point on edge - PTSFLAG = .TRUE. - RETURN -ENDIF +ENDIF NSEGS_COND -IF ( MOD(RCROSS,2) == 1) THEN ! Point inside - PTSFLAG = .TRUE. - RETURN -ENDIF +! Do we have any intersections? +IF ( CC_N_CRS == 0 ) RETURN -RETURN -END SUBROUTINE TEST_PT_INPOLY +! Collapse crossings to single SVARs: +CALL COLLAPSE_CROSSINGS(BODINT_PLANE,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,1) -! ---------------------- GET_CARTCELL_CUTEDGES ---------------------------------- +! 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 -SUBROUTINE GET_CARTCELL_CUTEDGES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) +T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_X2_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW -USE TRAN, ONLY : TRANS +RETURN +END SUBROUTINE GET_X2_INTERSECTIONS -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -! 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 +! ------------------------ COLLAPSE_CROSSINGS ----------------------------------- -! REAL(QB) :: DVQ(IAXIS:KAXIS), SLENQ, STANIQ(IAXIS:KAXIS), DENOMQ, PLANEEQQ +SUBROUTINE COLLAPSE_CROSSINGS(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,X3RAY,X1PLN,ITITLE) -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -INTEGER :: NCUTEDG +TYPE(BODINT_PLANE_TYPE), INTENT(IN) :: BODINT_PLANE2 +INTEGER, INTENT(IN) :: X1AXIS,X2AXIS,X3AXIS,ITITLE +REAL(EB), INTENT(IN) :: X3RAY,X1PLN -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 +! 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 -TNOW=CURRENT_TIME() +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. -EDGE_START= MESHES(NM)%N_CUTEDGE_MESH + 1 +! 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 -! BODINT_CELL: -GEOM_LOOP : DO IG=1,N_GEOMETRY +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 - ! 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)) +! 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) - IWSEDG_LOOP : DO IWSEDG=1,GEOMETRY(IG)%N_EDGES - ! Seg Nodes location: - SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEDG) +! 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) - 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)) + 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 - DO X1AXIS=IAXIS,KAXIS - EDGECUBE( LOW_IND,X1AXIS) = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) - EDGECUBE(HIGH_IND,X1AXIS) = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) - ENDDO + ICRS =IND_CRS(LOW_IND,IDCR) + 1 - ! 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 ( (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 - ! 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 + ! 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 + + 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) - ! Optimized for UG: - X1NOC=TRANS(NM)%NOC(X1AXIS) - MINX = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) - MAXX = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) + CYCLE - 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) + ENDIF SNGL_CRS_IF - 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 + ! 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 - ! 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 + ! 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) - ! 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. + ! 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 - ! 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 + ! 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 - ! 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) + ! 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 + + IF (IND_LEFT /= 0) IND_LEFT = SIGN(1,IND_LEFT) + IF (IND_RIGHT /= 0) IND_RIGHT = SIGN(1,IND_RIGHT) + + 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) - 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. + ELSE ! Intersections are either GG or SS - ! 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 + ! Left side: + FOUND_LEFT = .FALSE. + DO ICRS=IND_CRS(LOW_IND,IDCR)+1,IND_CRS(LOW_IND,IDCR)+IND_CRS(HIGH_IND,IDCR) + ! 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 - ! 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 + 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 + 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." - ! 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 + LEFT_MEDIA = CC_IS_CRS2_AUX(HIGH_IND,CC_N_CRS_AUX) - ! 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 + ENDIF DROP_SS_GG_IF - ENDDO - DEALLOCATE(X1FACE,DX1FACE) - ENDDO X1AXIS_LOOP2 +ENDDO IDCR_DO_2 - ! 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 +! 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) - ! Location along Segment: - SVAR1 = BODINT_CELL_EDGE%SVAR(IEDGE ) - SVAR2 = BODINT_CELL_EDGE%SVAR(IEDGE+1) +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 - ! Location of midpoint of cut-edge: - SVAR12 = 0.5_EB * (SVAR1+SVAR2) +RETURN +END SUBROUTINE COLLAPSE_CROSSINGS - ! 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 - 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 +! ------------------------- INSERT_RAY_CROSS ------------------------------------ - 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 +SUBROUTINE INSERT_RAY_CROSS(SVARI,ICRSI,SCRSI,STANI) - ! 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 +REAL(EB), INTENT(IN) :: SVARI, STANI(IAXIS:JAXIS) +INTEGER, INTENT(IN) :: ICRSI(LOW_IND:HIGH_IND+1), SCRSI - ! 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 +! 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 - 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 - ENDDO IWSEDG_LOOP +CC_N_CRS = CC_N_CRS + 1 - ! Deallocate BODINT_CELL_EDGE: - DEALLOCATE(BODINT_CELL_EDGE%SVAR) +! 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 -ENDDO GEOM_LOOP +! 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 -! 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) +! 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 - ! 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 +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 - IF(.NOT.TWOBOD_EDG) CYCLE +ENDIF +RETURN +END SUBROUTINE INSERT_RAY_CROSS - ! 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 +! ----------------------- GET_BODINT_NODE_INDEX ---------------------------------- - ! 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)) +SUBROUTINE GET_BODINT_NODE_INDEX(BODINT_PLANE,X2AXIS,X3AXIS,XYZ,IND_PI) + +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 + +! 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 + ENDIF 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) +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 - 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) +! 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) -T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX ) + CURRENT_TIME() - TNOW +RETURN +END SUBROUTINE GET_BODINT_NODE_INDEX +SUBROUTINE GET_X2_VERTVAR(X1AXIS,X2LO,X2HI,NM,I,KK) -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 +INTEGER, INTENT(IN) :: X1AXIS,X2LO,X2HI,NM,I,KK -RETURN -END SUBROUTINE GET_CARTCELL_CUTEDGES +! Local Variables: +INTEGER :: ICRS,ICRS1,JSTR,JEND,JJ,X2LO_LOC,X2HI_LOC +REAL(EB):: TNOW -! ------------------------- GET_IS_SOLID_3D ------------------------------------- +TNOW=CURRENT_TIME() -SUBROUTINE GET_IS_SOLID_3D(X2AXIS,XP,I,J,K,IS_SOLID) +! 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 -INTEGER, INTENT(IN) :: X2AXIS,I,J,K -REAL(EB), INTENT(IN) :: XP(IAXIS:KAXIS) -LOGICAL, INTENT(OUT):: IS_SOLID + 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 -! 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. + END SELECT + ENDDO -IJK(IAXIS:KAXIS) = (/ I, J, K /) + ! 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 -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) + DO JJ=JSTR,JEND + MESHES(NM)%VERTVAR(I,JJ,KK,CC_VGSC) = CC_SOLID + ENDDO + ENDIF + ENDDO END SELECT -IF (BODINT_PLANE2%NSEGS == 0) THEN - IS_SOLID =.FALSE. - RETURN -ENDIF - -XY(IAXIS:JAXIS) = (/ XP(X2AXIS), X3RAY /) -CALL GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) +T_CC_USED(GET_X2_VERTVAR_TIME_INDEX) = T_CC_USED(GET_X2_VERTVAR_TIME_INDEX) + CURRENT_TIME() - TNOW RETURN -END SUBROUTINE GET_IS_SOLID_3D +END SUBROUTINE GET_X2_VERTVAR +! -------------------------- GET_CARTEDGE_CUTEDGES ------------------------------ -! ---------------------- GET_CARTCELL_CUTFACES ---------------------------------- +SUBROUTINE GET_CARTEDGE_CUTEDGES(X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS, & + NM,X2LO_CELL,X2HI_CELL,INDX1,KK) -SUBROUTINE GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) +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 -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +! Set initially edges with MESHES(NM)%VERTVAR vertices == CC_SOLID to CC_SOLID status: +DO JJ=X2LO_CELL,X2HI_CELL -INTEGER, INTENT(IN) :: NM -INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND -LOGICAL, INTENT(IN) :: BNDINT_FLAG + ! 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) - ! 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 + 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, ALLOCATABLE, DIMENSION(:,:) :: SEG_CELL,SEG_CELL_AUX -INTEGER, SAVE :: SIZE_CEELEM_SEG_CELL +ENDDO -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 +NEDGECROSS_OLD = MESHES(NM) % N_EDGE_CROSS +! Edges with Crossings not on VERTICES: +ICRS_DO : DO ICRS=1,CC_N_CRS -INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES + ! Skip SOLID-SOLID intersections, as there is no media crossing: + IF (CC_IS_CRS(ICRS) == CC_SS) CYCLE -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 + ! 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 -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) + 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 -REAL(EB) :: TNOW + 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) -INTEGER :: ETYPE,JEC -REAL(EB) :: X1V(IAXIS:KAXIS), X2V(IAXIS:KAXIS) -! INTEGER :: IEC -! REAL(EB) :: X1E(IAXIS:KAXIS), X2E(IAXIS:KAXIS) + ! Set MESHES(NM)%ECVAR(IE,JE,KE,CC_EGSC,X2AXIS) = CC_CUTCFE: + ICROSS = MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_ECRS,X2AXIS) -! GET_CUTCELLS_VERBOSE variables: -REAL(EB) :: CPUTIME, CPUTIME_START -INTEGER :: NCUTFCE + IF ( ICROSS > 0 ) THEN ! Edge has crossings already. -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 + ! 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) -TNOW=CURRENT_TIME() + ELSE ! No crossings yet. -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)) + 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 -! 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 + CALL EDGE_CROSS_ARRAY_REALLOCATE(NM,NEDGECROSS) -! Loop on Cartesian cells, define cut cells and solid cells ISSO: -DO K=KLO,KHI - DO J=JLO,JHI - DO I=ILO,IHI + ! 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(IJK_COUNTED(I,J,K)) CYCLE + ENDIF - ! 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 - ! 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) +ENDDO ICRS_DO - ! 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 +! Now Define MESHES(NM)%CUT_EDGE for CC_GASPHASE cut-edges: +DO ICROSS=NEDGECROSS_OLD+1,MESHES(NM)%N_EDGE_CROSS - MESHES(NM)%CCVAR(I,J,K,CC_CGSC) = CC_CUTCFE + ! 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 - ENDDO - ENDDO -ENDDO + 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) -! 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 + ! 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 - SELECT CASE(X1AXIS) - CASE(IAXIS) + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID + CYCLE - 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 + ENDIF - ! x2, x3 axes parameters: - X2AXIS = JAXIS; X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD - X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD + ! Discard cases for edge with two crossings: + IF ( NCROSS == 2 ) THEN - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS + VSOLID = (MESHES(NM)%VERTVAR(INDI ,INDJ ,INDK ,CC_VGSC) == CC_SOLID) .AND. & + (MESHES(NM)%VERTVAR(INDI1,INDJ1,INDK1,CC_VGSC) == CC_SOLID) - ! 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 + ! 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 - ! 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 + 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) - ! 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 + VFLUID = (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(1) == CC_GS) .AND. & + (MESHES(NM)%EDGE_CROSS(ICROSS)%ISVAR(2) == CC_SG) - CASE(JAXIS) + IF (DIF .AND. VSOLID .AND. VFLUID) THEN + MESHES(NM)%ECVAR(INDIE,INDJE,INDKE,CC_EGSC,X2AXIS) = CC_SOLID + CYCLE + 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 + ENDIF - ! x2, x3 axes parameters: - X2AXIS = KAXIS; X2LO = KLO_FACE-CCGUARD; X2HI = KHI_FACE+CCGUARD - X3AXIS = IAXIS; X3LO = ILO_FACE-CCGUARD; X3HI = IHI_FACE+CCGUARD + ! 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 - ! location in I,J,K of x2,x2,x3 axes: - XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS + CALL CUT_EDGE_ARRAY_REALLOC(NM,NCUTEDGE) - ! 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 + 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)) - ! 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 + ! 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 - ! 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 + ! 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 )) 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 +INTEGER, INTENT(IN) :: NM, CEI - ! Allocate triangles variables: - ALLOCATE(BODINT_PLANE%X1NVEC(1:BODINT_PLANE%NTRIS), & - BODINT_PLANE%AINV(1:2,1:2,1:BODINT_PLANE%NTRIS)) +! Local Variables: +INTEGER :: CEI1, SIZE_EDGE_CROSS - ! Triangles inverses: - DO ITRI=1,BODINT_PLANE%NTRIS +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 - TRIS(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) +RETURN +END SUBROUTINE EDGE_CROSS_ARRAY_REALLOCATE - ! 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)) /) - ! 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) +! --------------------------CUT_EDGE_ARRAY_REALLOC------------------------------- - ! 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 +SUBROUTINE CUT_EDGE_ARRAY_REALLOC(NM,CEI) - ! 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 +INTEGER, INTENT(IN) :: NM, CEI - ENDDO +! Local Variables: +INTEGER :: CEI1, SIZE_CUT_EDGE - ! 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 +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 - ! Face indexes: - INDXI(IAXIS:KAXIS) = (/ IJK(X1AXIS), JJ, KK /) ! Local x1,x2,x3 - INDIF = INDXI(XIAXIS) - INDJF = INDXI(XJAXIS) - INDKF = INDXI(XKAXIS) +RETURN +END SUBROUTINE CUT_EDGE_ARRAY_REALLOC - IF (IJK_COUNTF(INDIF,INDJF,INDKF,X1AXIS)) CYCLE - IF (MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_FGSC,X1AXIS) /= CC_GASPHASE ) THEN +! ----------------------------- NEW_EDGE_ALLOC ---------------------------------- - 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 ) /) +SUBROUTINE NEW_EDGE_ALLOC(NM,CEI,NVERTALLOC,NEDGEALLOC) - ! Get triangle face intersection: - CEI = MESHES(NM)%FCVAR(INDIF,INDJF,INDKF,CC_IDCE,X1AXIS) +INTEGER, INTENT(IN) :: NM, CEI, NVERTALLOC, NEDGEALLOC - ! Triangle - face intersection vertices and edges: - CALL GET_TRIANG_FACE_INT(X2AXIS,X3AXIS,FVERT,CEI,NM, & - INB_FLG,FNVERT,XYVERT,FNEDGE,CEELEM,INDSEG) +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) - ! 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) +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)) - ! 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) +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 - ! 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 +RETURN - 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 SUBROUTINE NEW_EDGE_ALLOC - ENDIF +! ------------------ REALLOCATE_EDGE_VERT(NM,CEI,NVERT) ------------------------- - ! 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) +SUBROUTINE REALLOCATE_EDGE_VERT(NM,CEI,NVERT) - ENDIF - IJK_COUNTF(INDIF,INDJF,INDKF,X1AXIS)=.TRUE. +INTEGER, INTENT(IN) :: NM, CEI, NVERT - ENDIF - ENDDO - ENDDO +! Local Variables: +INTEGER :: NVERT_SIZE +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYZVERTAUX +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: VERT_LISTAUX +INTEGER, ALLOCATABLE, DIMENSION(:) :: NOD_PERMAUX - DEALLOCATE(BODINT_PLANE%X1NVEC,BODINT_PLANE%AINV) - ENDDO ! I - ENDDO ! J - ENDDO ! K +NVERT_SIZE = SIZE(MESHES(NM)%CUT_EDGE(CEI)%XYZVERT, DIM=2) - ! Deallocate local plane arrays: - DEALLOCATE(X1FACE,X2FACE,X3FACE,X2CELL,X3CELL) - DEALLOCATE(DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL) +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) - ENDDO X1AXIS_LOOP -! ENDIF BNDINT_COND + 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) -! 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 + 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 - IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE +RETURN - IF (CELLRT(I,J,K)) CYCLE ! Special cell with bod-bod or self intersection. +END SUBROUTINE REALLOCATE_EDGE_VERT - IF(IJK_COUNTED(I,J,K)) CYCLE; IJK_COUNTED(I,J,K)=.TRUE. +! ------------------ REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) ------------------------- - ! 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) +SUBROUTINE REALLOCATE_EDGE_ELEM(NM,CEI,NEDGE) - ! Start cut-cell INB cut-faces computation: - ! Loop local arrays to cell: - NSEG = 0 - SEG_CELL = CC_UNDEFINED +INTEGER, INTENT(IN) :: NM, CEI, NEDGE - NVERT = 0 - NFACE = 0 - XYZVERT = 0._EB +! 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 - ! 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) +NEDGE_SIZE = SIZE(MESHES(NM)%CUT_EDGE(CEI)%CEELEM, DIM=2) - ! 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 (NEDGE > NEDGE_SIZE) THEN ! Reallocate CEELEM, - 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) + CC_ALLOC_ELEM = MAX(NEDGE-NEDGE_SIZE,CC_ALLOC_DELEM) - ! 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) + 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 - 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 + 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) - ! 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 + CALL MOVE_ALLOC(FROM=CEELEMAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%CEELEM) + CALL MOVE_ALLOC(FROM=INDSEGAUX,TO=MESHES(NM)%CUT_EDGE(CEI)%INDSEG) - 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 (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) - ! 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) + 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 (INOD1 == INOD2) CYCLE + 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 - 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 + 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 - ! 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) +ENDIF - ! Now obtain body-triangle combinations present: - BOD_TRI = CC_UNDEFINED - NBODTRI = 0 - DO ISEG=1,NSEG +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 .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 +END SUBROUTINE REALLOCATE_EDGE_ELEM - ! No second triangle associated: - IF ( SEG_CELL(3,ISEG) < 2 .OR. SEG_CELL(6,ISEG)<1 .OR. SEG_CELL(5,ISEG)<1 ) CYCLE +! -------------------------- GET_ISGASPHASE ------------------------------------- - ! 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. +SUBROUTINE GET_IS_GASPHASE(SCEN,IS_GASPHASE) - ! 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. +REAL(EB), INTENT(IN) :: SCEN +LOGICAL, INTENT(OUT) :: IS_GASPHASE + +! Local Variables: +LOGICAL :: IS_GASPHASE_LEFT, IS_GASPHASE_RIGHT +INTEGER :: ICRS + +! 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 - ! 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 +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 - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) +! If at least one of left and right are true -> add +! CC_GASPHASE cut-edge: +IS_GASPHASE = IS_GASPHASE_LEFT .OR. IS_GASPHASE_RIGHT - 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 +RETURN +END SUBROUTINE GET_IS_GASPHASE - ! Running by body-triangle combination, define list of - ! segments that belong to each pair. - ICF_LOOP : DO ICF=1,NBODTRI +! --------------------- GET_BODX2_INTERSECTIONS --------------------------------- - IBOD = BOD_TRI(1,ICF) - ITRI = BOD_TRI(2,ICF) +SUBROUTINE GET_BODX2_INTERSECTIONS(X2AXIS,X3AXIS,X3RAY) - 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 +INTEGER, INTENT(IN) :: X2AXIS,X3AXIS +REAL(EB),INTENT(IN) :: X3RAY - ! If only one or two seg => continue: - IF ( NSEG_FACE <= 2 ) CYCLE +! 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 - ! 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 +! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX3_1Q,DX3_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) - 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 +TNOW=CURRENT_TIME() - 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 +IF ( BODINT_PLANE%NSEGS == 0) RETURN - 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 +DO ISEG=1,BODINT_PLANE%NSEGS - ENDIF + 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)) - ENDDO INF_LOOP - IF (CYCLE_CELL) EXIT ICF_LOOP + ! 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 ( COUNTR /= NSEG_FACE) & - PRINT*, "Building INBOUND faces: ~isequal(countr,nseg)" + ! IF (.NOT.DO_QUAD_PRECISION_CUTCELLS) THEN + ! Segment length: + SLEN = SQRT( (X2_2-X2_1)**2._EB + (X3_2-X3_1)**2._EB ) - ! Using triangles normal, reorder nodes as in right hand rule. - NORMTRI(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,ITRI) + ! Unit vector along segment: + STANI(IAXIS:JAXIS) = 1._EB/SLEN * (/ (X2_2-X2_1), (X3_2-X3_1) /) - ! 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 + ! 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 + 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 - ! 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) + ! 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 - 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 )) +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) +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 - RH_ORIENTED = ( NORMTRI(IAXIS)*CROSSV(IAXIS) + & - NORMTRI(JAXIS)*CROSSV(JAXIS) + & - NORMTRI(KAXIS)*CROSSV(KAXIS) ) > 0._EB +! ----------------------- GET_BODX3_INTERSECTIONS ------------------------------- - 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 +SUBROUTINE GET_BODX3_INTERSECTIONS(X2AXIS,X3AXIS,X2LO,X2HI) - ! 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 +INTEGER, INTENT(IN) :: X2AXIS,X3AXIS,X2LO,X2HI - 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 +! 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 - 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) +! REAL(QB) :: X2_21Q,X3_21Q,SLENQ,STANIQ(IAXIS:JAXIS),DX2_1Q,DX2_2Q,XI1Q,XI2Q,DVQ(IAXIS:JAXIS) - 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) +TNOW=CURRENT_TIME() - 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 +DO ISEG=1,BODINT_PLANE%NSEGS - 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) + IF (BODINT_PLANE%X3ALIGNED(ISEG)) CYCLE ! This segment is not aligned with x3. - 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) + 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)) - ENDDO ICF_LOOP + ! 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((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.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 - ! 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 + 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 - ! 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 + 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 - ENDDO ! I - ENDDO ! J -ENDDO ! K + ! 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 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 + ! 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 ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE + ENDDO - IF (.NOT.CELLRT(I,J,K)) CYCLE ! Special cell with bod-bod or self intersection. +ENDDO - IF (IJK_COUNTED(I,J,K)) CYCLE; IJK_COUNTED(I,J,K)=.TRUE. +T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) = T_CC_USED(GET_BODX2X3_INTERSECTIONS_TIME_INDEX) + CURRENT_TIME() - TNOW - ! Start cut-cell INB cut-faces computation: - ! Loop local arrays to cell: - NSEG = 0 - SEG_CELL = CC_UNDEFINED +RETURN +END SUBROUTINE GET_BODX3_INTERSECTIONS - NVERT = 0 - NFACE = 0 - XYZVERT = 0._EB +! ----------------------- GET_CARTFACE_CUTEDGES --------------------------------- - ! 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) +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) - ! 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 +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 - 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) +! 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 - ! 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) +TNOW=CURRENT_TIME() - 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 +INIT_CUT_EDGES = MESHES(NM)%N_CUTEDGE_MESH+1 - ! 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) +! 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 - IF (NSEG < 3 ) CYCLE + 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(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 (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. - ! 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) + INRAY = .FALSE. - 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 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 - MESHES(NM)%CCVAR(I,J,K,CC_IDCF) = NCUTFACE - CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) + DO IPFACE=1,NPFACE - 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) + KK2 = KK2VEC(IPFACE) - ! Assign surf-index: Depending on GEOMETRY: - NCF = 0 - DO ICF=1,NFACE - IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) + ! 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 - ! 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 + ! 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 - ! 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 + IF ((KK2 < X3LO_CELL) .OR. (KK2 > X3HI_CELL)) CYCLE - ! Area: - AREA = 0.5_EB*NNORM + ! 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 - ! dot(i,nc) int(x)dA - INXAREA = NORMTRI(IAXIS)*ACEN(IAXIS)*AREA ! Single Gauss pt integration. + ! 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) + 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 + + ! 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 - 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 + ENDDO + CYCLE ! Skips rest of iseg loop, for this ISEG. + ENDIF - NCF = NCF + 1 - CF%AREA(NCF) = AREA - CF%XYZCEN(IAXIS:KAXIS,NCF) = ACEN(IAXIS:KAXIS) + ! Second check if segment geomepsilon aligned with x3: + ELSEIF (BODINT_PLANE%X3ALIGNED(ISEG)) THEN - ! 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) + ! 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 - ! Define Body-triangle reference: - CF%BODTRI(1:2,NCF)= (/ IBOD, ITRI /) + IF (INRAY) THEN ! Segment in x3 ray defined by x2 face index JJ - CF%SURF_INDEX(NCF) = GEOMETRY(IBOD)%SURFS(ITRI) + ! 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 - ! 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) + DO IPFACE=1,NPFACE - ENDDO - DEALLOCATE(CFELEM,SEG_CELL_AUX,CEDGES) - CF%NFACE = NCF + JJ2 = JJ2VEC(IPFACE) - ! 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 + ! 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 - ! 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 + ! 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 - 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 + ! 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(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(.NOT.FOUND_SEG) CYCLE + 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 + IF ((JJ2 < X2LO_CELL) .OR. (JJ2 > X2HI_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) + + 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 - MESHES(NM)%CUT_EDGE(CEI)%NVERT = NVERT - MESHES(NM)%CUT_EDGE(CEI)%NEDGE = NEDGE + 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) - ENDIF - ENDDO + ! 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 - ! 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 + ! 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 ! I - ENDDO ! J -ENDDO ! K + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ INDX1(X1AXIS), JJ2, KK2 /) ! Local x1,x2,x3 + INDIF=INDXI(XIAXIS) + INDJF=INDXI(XJAXIS) + INDKF=INDXI(XKAXIS) -IF (.NOT.BNDINT_FLAG) DEALLOCATE(IJK_COUNTED,IJK_COUNTF) -DEALLOCATE(SEG_CELL,SEG_POS) + ! 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 -T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW + ! Add vertices, non repeated vertex entries at this point. + NVERT = MESHES(NM)%CUT_EDGE(CEI)%NVERT -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 + ! 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 - 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 + ENDDO -CONTAINS +ENDDO SEGS_LOOP -SUBROUTINE REALLOCATE_SEG_CELL +! 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(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 +! 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_CARTFACE_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTFACE_CUTEDGES_TIME_INDEX) + CURRENT_TIME() - TNOW RETURN -END SUBROUTINE REALLOCATE_SEG_CELL +END SUBROUTINE GET_CARTFACE_CUTEDGES -END SUBROUTINE GET_CARTCELL_CUTFACES +! -------------------------- GET_IS_SOLID_PT ------------------------------------ +SUBROUTINE GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) -! ------------------------ GET_CLOSED_POLYLINES --------------------------------- +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 -SUBROUTINE GET_CLOSED_POLYLINES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,SEG_POS,IFLG,NPOLY,ILO_POLY,NSG_POLY) +! 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 -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) +! 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 -! 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 +! Define crossings: +IF(ABS(NVEC(IAXIS)) > ABS(NVEC(JAXIS))) THEN ! Do X2 ray + SCEN = XY(IAXIS); XRAY=XY(JAXIS); XAXIS=X3AXIS -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 + 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 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) + ! 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. -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 + ! 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)) -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) + 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 -! 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 + ! 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) - ! 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. + ! 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; - ! 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 + ! 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 - ! 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 + ENDDO + +ELSE ! Do X3 ray + SCEN=XY(JAXIS); XRAY=XY(IAXIS); XAXIS=X2AXIS; + + 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)) - ! End of new polyline creation. - ! Here if we have less that 3 segments not counted exit while loop. - IF (SEG_LEFT < 3) EXIT -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. -! 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 + ! 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)) -! 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 + 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 -DEALLOCATE(SEG_CELL2,SEG_POS2,COUNTED,BOD,SEG_POLY) + ! 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) -IFLG=.FALSE. + ! 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; -RETURN -END SUBROUTINE GET_CLOSED_POLYLINES + ! 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 +ENDIF -! --------------------------- EAR_CLIP_CFACES ----------------------------------- +! 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) -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) +IS_SOLID = .NOT.IS_GASPHASE -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 +RETURN +END SUBROUTINE GET_IS_SOLID_PT -! 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 +! ------------------------- INSERT_FACE_VERT ------------------------------------ -! 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 +SUBROUTINE INSERT_FACE_VERT(XYZV,NM,CEI,NVERT,INOD) -! 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 +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) - 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 +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) - ! 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 +RETURN +END SUBROUTINE INSERT_FACE_VERT - ! 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 +! ------------------------- INSERT_FACE_VERT_LOC(XYZ,NVERT,INOD1,XYZVERT) - IF ( BOD<1 .OR. TRI<1 ) THEN - CYCLE - ELSE ! Found two segments with matching triangle. +SUBROUTINE INSERT_FACE_VERT_LOC(MAXVERTS,XYZV,NVERT,INOD,XYZVERT) - ! 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 +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 - 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 +REAL(EB), PARAMETER :: VERT_PROX_FCT = 1000._EB - ! 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) +! 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) -! 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 +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 EAR_CLIP_CFACES +END SUBROUTINE INSERT_FACE_VERT_LOC -! ----------------------- GET_CARTCELL_CUTCELLS --------------------------------- +! ----------------------- GET_CARTFACE_CUTFACES --------------------------------- -SUBROUTINE GET_CARTCELL_CUTCELLS(NM) +SUBROUTINE GET_CARTFACE_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN) :: BNDINT_FLAG ! 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 :: 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 + +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. -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 +INTEGER, SAVE :: SIZE_CFACES_CFELEM, SIZE_VERTS_CFELEM +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CFELEM2,CEDGES,CEDGES2 +INTEGER, ALLOCATABLE, DIMENSION(:) :: CFE, CFEL -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 +INTEGER, SAVE :: SIZE_EDGES_NODEDG, SIZE_VERTS_NODEDG +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NODEDG_FACE -INTEGER, ALLOCATABLE, DIMENSION(:) :: IPTS +LOGICAL :: SEG_FLAG(CC_MAXCEELEM_FACE) +INTEGER :: NUMEDG_NODE(CC_MAXVERTS_FACE) -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 :: 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 -REAL(EB) :: XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND),MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND:HIGH_IND),CELL_DELTA(IAXIS: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 -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 :: 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 :: IBNDINT -LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNT +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 :: ETYPE, AXIS, SIDE, IEC, JEC, CEIJK(4), IIF, JJF ,KKF +! REAL(EB):: X1E(IAXIS:KAXIS), X1V(IAXIS:KAXIS), X2E(IAXIS:KAXIS), X2V(IAXIS:KAXIS) + ! GET_CUTCELLS_VERBOSE variables: REAL(EB) :: CPUTIME, CPUTIME_START -INTEGER :: NCUTCEL +INTEGER :: NCUTFCE 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 (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 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(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 - - 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) +! 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)) - ! 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) +! 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 - ! 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 +! Test to check cut-cell definition scaling: +IF (PERIODIC_TEST == 105) GET_SOLID_CUTFACES = .FALSE. - ! 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) +! 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 - 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 ) /) +IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, + ! 4 guard-cell faces. - 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) /) + ! 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 - 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) + XIAXIS_LOOP : DO X1AXIS=IAXIS,KAXIS - 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) /) + SELECT CASE(X1AXIS) + case(IAXIS) - 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 = JAXIS + X3AXIS = 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) + ! 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 - 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 = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS - 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 = ILO; X1HI = IHI + X2LO = JLO; X2HI = JHI + X3LO = KLO; X3HI = KHI - 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 + ! 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 - CEI_AXIS(LOW_IND:HIGH_IND) = IDCF_XYZ(LOW_IND:HIGH_IND,MYAXIS) + CASE(JAXIS) - DO SIDE=LOW_IND,HIGH_IND - ! Low High face: - IF ( FSID_XYZ(SIDE,MYAXIS) == CC_GASPHASE ) THEN + X2AXIS = KAXIS + X3AXIS = IAXIS - ! Regular Face, build 4 vertices + face: - NP = 0 - NFACE_CELL = NFACE_CELL + 1 + ! 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 - ! 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) + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS - ! 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 indexing in x1, x2, x3: + X1LO = JLO; X1HI = JHI + X2LO = KLO; X2HI = KHI + X3LO = ILO; X3HI = IHI - NP = NP + 1 - FACE_CELL(1,NFACE_CELL) = NP - FACE_CELL(NP+1,NFACE_CELL) = INOD - ENDDO + ! 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 - ELSEIF (FSID_XYZ(SIDE,MYAXIS) == CC_CUTCFE ) THEN + CASE(KAXIS) - 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 + X2AXIS = IAXIS + X3AXIS = JAXIS - 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 + ! 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 - N_GAS_CFACES = NFACE_CELL + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS - ! 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 + ! Local indexing in x1, x2, x3: + X1LO = KLO; X1HI = KHI + X2LO = ILO; X2HI = IHI + X3LO = JLO; X3HI = JHI - ! 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 + ! 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 - ! 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. + END SELECT - ! Make list of edges: - EDGFAC_CELL(:,:) = CC_UNDEFINED - FACEDG_CELL(:,:) = CC_UNDEFINED + ! Loop on Cartesian faces, local x1, x2, x3 indexes: + DO II=X1LO,X1HI + DO KK=X3LO,X3HI + DO JJ=X2LO,X2HI - ! 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 + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI = INDXI(XIAXIS) + INDJ = INDXI(XJAXIS) + INDK = INDXI(XKAXIS) - DO IFACE=1,NFACE_CELL - NIEDGE = FACE_CELL(1,IFACE) + ! 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 - ! 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 + ! 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) - 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)) + 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) - IF ( TEST1 .OR. TEST2 ) THEN - INLIST = .TRUE. - EXIT - ENDIF - enddo - IF (.NOT.INLIST) THEN - NSEG_CELL = NSEG_CELL + 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) - ! 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) + ! 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 - ! New SIZE_CEELEM_EDGFAC: - SIZE_CEELEM_EDGFAC = SIZE_CEELEM_EDGFAC + DELTA_EDGE + MESHES(NM)%FCVAR(INDI,INDJ,INDK,CC_FGSC,X1AXIS) = CC_CUTCFE - ! 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 + ! Build segment list: + NSEG = 0 + NVERT = 0 + NFACE = 0 - ! 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 + 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 - 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 + ! 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) - ! 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 + ! 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) - ! 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 + ! 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) - ! 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 + ! 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 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 + ! 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 - 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) + ! 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) + + ! 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 - 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 + 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) - 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 + ! 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) - ! 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 + ! 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) - ! Define Body-triangle reference: - MESHES(NM)%CUT_FACE(IDCF)%BODTRI(1:2,NIBFACE)= (/ IBOD, ITRI /) + ! 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 - ! 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) + ! 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) - ! 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) + ! 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) + + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_RGGAS, LOW_IND, X3AXIS /) + ANGSEG(NSEG) = 0._EB ENDIF - ENDIF IDCF_COND + 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) - ! 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) /) + ! 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) - ELSE CYCLE_CELL_COND + ! 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) - ! 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 + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) + ANGSEG(NSEG) = 0._EB + ENDDO + ENDIF + + ! 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) + + ! 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) + + ! 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) - ! 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)) + ! 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) - ! 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 + ! ADD segment: + NSEG = NSEG + 1 + SEG_FACE(NOD1:NOD2+3,NSEG) = (/ INOD1, INOD2, CC_ETYPE_CFGAS, CEI, IEDGE /) + ANGSEG(NSEG) = PI + ENDDO + ENDIF - ENDIF CYCLE_CELL_COND + ! 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 - ! 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 + ! 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) - ! Resize array MESHES(NM)%CUT_CELL if necessary: - CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) + IBOD = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(4,IEDGE) + STYPE = MESHES(NM)%CUT_EDGE(CEI)%INDSEG(5,IEDGE) - ! 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) + ! 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) - ! 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)= 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 - ENDDO ! I - ENDDO ! J -ENDDO ! K -ENDDO IBNDINT_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 -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) + 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 -T_CC_USED(GET_CARTCELL_CUTCELLS_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW + ! 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 -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 + ! 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 + + ! 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 -RETURN + ! 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 -CONTAINS + ! 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 REALLOCATE_LOCAL_FC_VARS + 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 -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 + ! Infamous infinite loop: + INF_LOOP : DO -SUBROUTINE REALLOCATE_FACE_CELL_VERTS + FOUNDSEG = .FALSE. + N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. + ANGCOUNT = ANGSEG(NEWSEG) -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 + ! 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 -RETURN -END SUBROUTINE REALLOCATE_FACE_CELL_VERTS + ! 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 -END SUBROUTINE GET_CARTCELL_CUTCELLS + ! 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 + ! Break loop: + IF ( NSEG_LEFT == 0 ) EXIT -! ------------------------ CUT_CELL_BOUNDING_BOX ------------------------------------ + ! 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 -SUBROUTINE CUT_CELL_BOUNDING_BOX(NM,ICC,JCC,XYZCELL,MINMAX_XYZ_JCC) + ENDDO INF_LOOP -! 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. + ! 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 -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) + 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 -! 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 + ! 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)) /) -CC => MESHES(NM)%CUT_CELL(ICC) + ! 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 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 + ! 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 - END SELECT -ENDDO + ENDDO -END SUBROUTINE CUT_CELL_BOUNDING_BOX + 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 + ! 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 -! -------------------------CUT_CELL_ARRAY_REALLOC------------------------------------ + ! Centroid node for ICF1: + XYC1(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF1 ) ! [x2axis x3axis] -SUBROUTINE CUT_CELL_ARRAY_REALLOC(NM,ICC) + ! 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) :: NM,ICC + CALL TEST_PT_INPOLY(NP2,XY,XYC1,PTSFLAG) -! Local Variables: -INTEGER :: ICC1,SIZE_CUT_CELL + IF ( PTSFLAG ) THEN ! Centroid of face 1 inside Face 2. -! 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 + FINFACE(ICF1) = ICF2 + NFACE = NFACE - 1 -RETURN -END SUBROUTINE CUT_CELL_ARRAY_REALLOC + ! Redefine areas in case of faces with holes: + AREA2 = AREAV(ICF2) -! ------------------------ CUT_CELL_MOVE ----------------------------------- + ! Area with hole, AREA1 has negative sign: + AREAH = AREA2 + AREA1 -SUBROUTINE CUT_CELL_MOVE(CUT_CELL_FROM,CUT_CELL_TO) + IF (ABS(AREAH) < GEOMEPS) THEN ! Hole of same size as cut-face, drop both. + FINFACE(ICF2) = ICF1 + CYCLE + ENDIF -TYPE(CC_CUTCELL_TYPE), INTENT(INOUT) :: CUT_CELL_FROM,CUT_CELL_TO + ! Centroid with hole: + XYC2(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF2 ) ! [x2axis x3axis] + XYH(1:2) = (AREA1 * XYC1(1:2) + AREA2 * XYC2(1:2)) / AREAH -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 + ! So ICF2 has the area with hole properties: + AREAV(ICF2) = AREAH + XYZCEN(JAXIS,ICF2) = XYH(IAXIS) + XYZCEN(KAXIS,ICF2) = XYH(JAXIS) -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) + ! 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) -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) + EXIT + ENDIF + ENDDO + ENDIF + ENDDO -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) + ! 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) -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) + ! Here reallocate CFELEM, CEDGES CFE, CFEL if NP > SIZE_VERTS_CFELEM: + CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) + CFE(1) = NP -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) + DO II2=2,NP1+1 + CFE(II2) = CFELEM(II2,ICF1) + ENDDO + II2 = (NP1+1) + 1 + CFE(II2) = CFELEM(2,ICF1) -RETURN -END SUBROUTINE CUT_CELL_MOVE + ! 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 -! ------------------------- CELL_DEALLOC ----------------------------------- + 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) -SUBROUTINE CELL_DEALLOC(NM,ICC) + ! Copy CFE into CFELEM(1:np+1,icf2): + CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) -INTEGER, INTENT(IN) :: NM,ICC -INTEGER :: I,J,K + ! 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) -MESHES(NM)%CUT_CELL(ICC)%NCELL = 0 -IF (.NOT.ALLOCATED(MESHES(NM)%CUT_CELL(ICC)%CCELEM)) THEN - I = MESHES(NM)%CUT_CELL(ICC)%IJK(IAXIS) - J = MESHES(NM)%CUT_CELL(ICC)%IJK(JAXIS) - K = MESHES(NM)%CUT_CELL(ICC)%IJK(KAXIS) - IF (I>=LBOUND(MESHES(NM)%CCVAR,1) .AND. I<=UBOUND(MESHES(NM)%CCVAR,1) .AND. & - J>=LBOUND(MESHES(NM)%CCVAR,2) .AND. J<=UBOUND(MESHES(NM)%CCVAR,2) .AND. & - K>=LBOUND(MESHES(NM)%CCVAR,3) .AND. K<=UBOUND(MESHES(NM)%CCVAR,3)) THEN - IF (MESHES(NM)%CCVAR(I,J,K,CC_IDCC)==ICC) MESHES(NM)%CCVAR(I,J,K,CC_IDCC) = CC_UNDEFINED - ENDIF - RETURN -ENDIF + ENDIF + ENDDO -! 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 (ALLOCATED(MESHES(NM)%CUT_CELL(ICC)%BODTRI_DONOR)) DEALLOCATE(MESHES(NM)%CUT_CELL(ICC)%BODTRI_DONOR) + NVERTFACE = MAXVAL(CFELEM(1,1:NFACE)) + 1 -RETURN + ! 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 -END SUBROUTINE CELL_DEALLOC + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -! -------------------------- NEW_CELL_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) = (/ 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 -SUBROUTINE NEW_CELL_ALLOC(NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL) + ! ! 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 -INTEGER, INTENT(IN) :: NM,ICC,NCELL,NFACE_CELL,NCFACE_CUTCELL + ! 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 -! 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. + 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 -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 + ! 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) -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 + ! 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) + ! 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) -! -------------------------- ALLOC_CELL_STATE_VARS ------------------------------------- + ! 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 ALLOC_CELL_STATE_VARS(NM,ICC,NCELL) + ENDDO + ENDIF -INTEGER, INTENT(IN) :: NM,ICC,NCELL + ! 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 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)) + 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 -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 + 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 -ALLOCATE(MESHES(NM)%CUT_CELL(ICC)%Q_REAC(1:N_REACTIONS,1:NCELL)) -MESHES(NM)%CUT_CELL(ICC)%Q_REAC = 0._EB + 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 -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 + 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 -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)) + ! 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 -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 + ! 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 -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 + ! 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 -RETURN + ! 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 -END SUBROUTINE ALLOC_CELL_STATE_VARS + ! 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 + NSSEG=COUNT -! ------------------------ GET_TRIANG_FACE_INT ---------------------------------- + ! 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 -SUBROUTINE GET_TRIANG_FACE_INT(X2AXIS,X3AXIS,FVERT,CEI,NM, & - INB_FLG,NVERT,XYVERT,NEDGE,CEELEM,INDSEG) + ! 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 -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) + ! Discard face with less than 3 edges (triangle): + IF ( NSSEG < 3 ) 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 + ! 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 -REAL(EB), ALLOCATABLE, SAVE, DIMENSION(:,:) :: X2X3VERT -INTEGER, SAVE :: SIZE_X2X3VERT + ! 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 -INTEGER :: IWSSEG,NSVERT,NINTP_SEG,SEGNODS(NOD1:NOD2) + ! 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. -! 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 + 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 - IF (NVERT > SIZE_X2X3VERT) THEN - DEALLOCATE(X2X3VERT) - SIZE_X2X3VERT = NVERT + DELTA_VERT - ALLOCATE(X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT)); X2X3VERT = 0._EB - ENDIF + ! Infamous infinite loop: + INF_LOOP2 : DO - 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) + FOUNDSEG = .FALSE. + N2COUNT = SEG_FACE2(NOD2,COUNT) ! Node 2 of segment COUNT. + ANGCOUNT = ANGSEG(NEWSEG) - 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 + ! 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 -! 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)) + IF ( DANGI > DANG ) THEN + NEWSEG = ISEG + DANG = DANGI + FOUNDSEG = .TRUE. + ENDIF + ENDIF + ENDDO -! 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 + ! 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 if intest is true figure out if there are triangles-face intersection -! Polygons: -NFVERT = 4 -NTVERT = 3 -NSVERT = 2 + ! 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 -! 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 + ! Break loop: + IF ( NSEG_LEFT == 0 ) EXIT -NINTP = NVERT + ! 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 -! Loop in-plane Surface Elements: -DO ITRI=1,BODINT_PLANE%NTRIS + ENDDO INF_LOOP2 - NINTP_TRI = 0 - TRINODS = CC_UNDEFINED + ! 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 - ! 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 + ! 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)) /) - ! 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 + ! 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 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 + ! 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 - IF ( OUTFACE ) CYCLE + ! Centroid node for ICF1: + XYC1(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF1 ) ! [x2axis x3axis] - ! Insertion add point to intersection list: - XP(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,IPT) - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) + ! 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 - ! 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 + CALL TEST_PT_INPOLY(NP2,XY,XYC1,PTSFLAG) - TRIVERT_IN_FACE(IPT,ITRI) = 1 + IF ( PTSFLAG ) THEN ! Centroid of face 1 inside Face 2. - ENDDO + FINFACE(ICF1) = ICF2 + NSFACE = NSFACE - 1 - ! 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) + ! Redefine areas in case of faces with holes: + AREA2 = AREAV(ICF2) - ! 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 + ! Area with hole, AREA1 has negative sign: + AREAH = AREA2 + AREA1 - ! 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(AREAH) < GEOMEPS) THEN ! Hole of same size as cut-face, drop both. + FINFACE(ICF2) = ICF1 + CYCLE + 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 + ! Centroid with hole: + XYC2(1:2) = XYZCEN( (/ JAXIS, KAXIS /) , ICF2 ) ! [x2axis x3axis] + XYH(1:2) = (AREA1 * XYC1(1:2) + AREA2 * XYC2(1:2)) / AREAH - FVERT_IN_TRIANG(IPF,ITRI) = 1 + ! 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 - 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) - ! 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 + ! Here reallocate CFELEM, CFE, CFEL if NP > SIZE_VERTS_CFELEM: + CALL REALLOCATE_LOCAL_VERT_CFELEM(NP+1) - DO JPL=LOW_IND,HIGH_IND + CFE(1) = NP - XJPLN = XJPLNS(JPL) + DO II2=2,np1+1 + CFE(II2) = CFELEM(II2,icf1) + ENDDO + II2 = (np1+1) + 1 + CFE(II2) = CFELEM(2,icf1) - DO IPT=1,NTVERT + 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) - XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD1,IPT) ) - XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD2,IPT) ) + ! Copy CFE into CFELEM(1:np+1,icf2): + CFELEM(1:NP+1,ICF2) = CFE(1:NP+1) - ! 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 + ENDIF + ENDDO - ! 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 + NVERTFACE = MAXVAL(CFELEM(1,1:NSFACE2)) + 1 - ! Test if segment aligned with xi - XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) - IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. + ! 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) - ! Drop intersections in triangle segment nodes: already added. - ! Compute: dot(plnormal, xyzv - xypl): - DOT1 = XY1(XJAXIS) - XJPLN - DOT2 = XY2(XJAXIS) - XJPLN + ! 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 - IF ( ABS(DOT1) <= GEOMEPS ) CYCLE - IF ( ABS(DOT2) <= GEOMEPS ) CYCLE + ENDIF SOLID_FACE_IF - ! 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 + ENDDO ! JJ + ENDDO ! KK + ENDDO ! II - ! Intersection Point along segment: - DS = (XJPLN-XY1(XJAXIS))/(XY2(XJAXIS)-XY1(XJAXIS)) - SVARI = XY1(XIAXIS) + DS*(XY2(XIAXIS)-XY1(XIAXIS)) + DEALLOCATE(X1FACE,X2FACE,X3FACE) - OUTSEG= ((XIPLNS(LOW_IND)-SVARI) > -GEOMEPS) .OR. ((SVARI-XIPLNS(HIGH_IND)) > -GEOMEPS) - IF ( OUTSEG ) CYCLE + ENDDO XIAXIS_LOOP - ! Insertion add point to intersection list: - XP(XIAXIS) = SVARI - XP(XJAXIS) = XJPLN - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) +ENDDO IBNDINT_LOOP - ! 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 (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 + + SELECT CASE(X1AXIS) + case(IAXIS) - IF ( NINTP_TRI == 0 ) CYCLE + X2AXIS = JAXIS + X3AXIS = KAXIS - ! 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) + ! 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 - 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 + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS - ! Reorder nodes: - TRINODS(1:NINTP_TRI) = TRINODS(II(1:NINTP_TRI)) + ! Local indexing in x1, x2, x3: + X1LO = ILO; X1HI = IHI + X2LO = JLO; X2HI = JHI + X3LO = KLO; X3HI = KHI - ! 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) /) + CASE(JAXIS) - LOCTRI = BODINT_PLANE%INDTRI(1,ITRI) - LOCBOD = BODINT_PLANE%INDTRI(2,ITRI) + X2AXIS = KAXIS + X3AXIS = IAXIS - DO IEDGE=1,NINTP_TRI + ! 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 - IF ( EDGETRI(NOD1,IEDGE) == EDGETRI(NOD2,IEDGE) ) CYCLE + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = KAXIS; XJAXIS = IAXIS; XKAXIS = JAXIS - ! Test if Edge already on list: - INLIST = .FALSE. - DO ISEG=1,NEDGE + ! Local indexing in x1, x2, x3: + X1LO = JLO; X1HI = JHI + X2LO = KLO; X2HI = KHI + X3LO = ILO; X3HI = IHI - 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 + CASE(KAXIS) - 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 + X2AXIS = IAXIS + X3AXIS = JAXIS - IF ( .NOT.INLIST ) THEN ! Edge not in list. - NEDGE = NEDGE + 1 - CEELEM(NOD1:NOD2,NEDGE) = EDGETRI(NOD1:NOD2,IEDGE) + ! 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 - ! Here we have to figure out if segment belongs to a triangles side: - SEG_IN_SIDE = .FALSE. - DO IPT=1,NTVERT + ! location in I,J,K od x2,x2,x3 axes: + XIAXIS = JAXIS; XJAXIS = KAXIS; XKAXIS = IAXIS - ! 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) ) + ! Local indexing in x1, x2, x3: + X1LO = KLO; X1HI = KHI + X2LO = ILO; X2HI = IHI + X3LO = JLO; X3HI = JHI - ! Segment points: - XP1(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD1,NEDGE)) - XP2(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD2,NEDGE)) + END SELECT - 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) + ! Loop on Cartesian faces, local x1, x2, x3 indexes: + DO II=X1LO,X1HI + DO KK=X3LO,X3HI + DO JJ=X2LO,X2HI - CROSSP1 = ABS(VECS(IAXIS)*VECP1(JAXIS)-VECS(JAXIS)*VECP1(IAXIS)) - CROSSP2 = ABS(VECS(IAXIS)*VECP2(JAXIS)-VECS(JAXIS)*VECP2(IAXIS)) + ! Face indexes: + INDXI(IAXIS:KAXIS) = (/ II, JJ, KK /) ! Local x1,x2,x3 + INDI = INDXI(XIAXIS) + INDJ = INDXI(XJAXIS) + INDK = INDXI(XKAXIS) - 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 + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(INDI,INDJ,INDK,X1AXIS) ) CYCLE -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) -! Now define cut-edges from solid-solid segments: -DO IWSSEG=1,BODINT_PLANE%NSEGS + 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) - NINTP_SEG = 0 - SEGNODS = CC_UNDEFINED + ! 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) - 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 + ! 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 - ! 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 + ENDDO ! JJ + ENDDO ! KK + ENDDO ! II - ! Insertion add point to intersection list: - XP(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,IPT) - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) + ENDDO XIAXIS_LOOP_2 - ! Insert sort node to triangles local list - TRUETHAT = .TRUE. - DO INP=1,NINTP_SEG - IF (SEGNODS(INP) == INOD) THEN - TRUETHAT = .FALSE. - EXIT - ENDIF +ELSE + DEALLOCATE(IJK_COUNTED) +ENDIF + +DEALLOCATE(NODEDG_FACE) +DEALLOCATE(CFELEM,CEDGES,CFE,CFEL) + +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 - IF ( TRUETHAT ) THEN ! new inod entry on list - NINTP_SEG = NINTP_SEG + 1 - SEGNODS(NINTP_SEG) = INOD - ENDIF - 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(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 +RETURN - DO JPL=LOW_IND,HIGH_IND +CONTAINS - XJPLN = XJPLNS(JPL) +SUBROUTINE REALLOCATE_NODEDG_FACE(N_SEG_CFACE,N_VERT_CFACE) - XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD1) ) - XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD2) ) +INTEGER, INTENT(IN) :: N_SEG_CFACE,N_VERT_CFACE +INTEGER :: DFCTE,DFCTV - ! 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 ( (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 - ! 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 +SUBROUTINE REALLOCATE_LOCAL_CFELEM(N_VERT_CFACE,N_FACE_CFACE) - ! Test if segment aligned with xi - XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) - IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. +INTEGER, INTENT(IN) :: N_VERT_CFACE, N_FACE_CFACE +INTEGER :: DFCTF,DFCTV - ! Drop intersections in EDGE nodes: already added. - ! Compute: dot(plnormal, xyzv - xypl): - DOT1 = XY1(XJAXIS) - XJPLN - DOT2 = XY2(XJAXIS) - XJPLN +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 - IF ( ABS(DOT1) <= GEOMEPS ) CYCLE - IF ( ABS(DOT2) <= GEOMEPS ) CYCLE - ! Finally regular case: - ! Points 1 on one side of x2 segment, point 2 on the other: - IF ( DOT1*DOT2 < 0._EB ) THEN +SUBROUTINE REALLOCATE_LOCAL_VERT_CFELEM(N_VERT_CFACE) - ! Intersection Point along segment: - DS = (XJPLN-XY1(XJAXIS))/(XY2(XJAXIS)-XY1(XJAXIS)) - SVARI = XY1(XIAXIS) + DS*(XY2(XIAXIS)-XY1(XIAXIS)) +INTEGER, INTENT(IN) :: N_VERT_CFACE +INTEGER :: DFCTV +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM_AUX,CEDGES_AUX - OUTSEG= ((XIPLNS(LOW_IND)-SVARI) > -GEOMEPS) .OR. ((SVARI-XIPLNS(HIGH_IND)) > -GEOMEPS) - IF ( OUTSEG ) CYCLE +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 - ! Insertion add point to intersection list: - XP(XIAXIS) = SVARI - XP(XJAXIS) = XJPLN - CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) +END SUBROUTINE GET_CARTFACE_CUTFACES - ! 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 - IF ( (NINTP_SEG < 2) .OR. (SEGNODS(NOD1) == SEGNODS(NOD2)) ) CYCLE +! ---------------- DEFINE_REGULAR_CUTFACES -------------------------- - ! Test if Edge already on list: - INLIST = .FALSE. - DO ISEG=1,NEDGE +SUBROUTINE DEFINE_REGULAR_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) - 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 +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN) :: BNDINT_FLAG - 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 +! Local Variables: +INTEGER :: ILO,IHI,JLO,JHI,KLO,KHI,X1AXIS,NVERT,NFACE,I,J,K,NCUTFACE +INTEGER :: IBNDINT,BNDINT_LOW,BNDINT_HIGH - 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 +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: IJK_COUNTED -! 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. +CALL POINT_TO_MESH(NM) -DEALLOCATE(FVERT_IN_TRIANG, TRIVERT_IN_FACE) +! Mesh sizes: +NXB=IBAR +NYB=JBAR +NZB=KBAR -RETURN -END SUBROUTINE GET_TRIANG_FACE_INT +! 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 -! ------------------------- INSERT_POINT_2D ------------------------------------- -SUBROUTINE INSERT_POINT_2D(XP,NVERT,SIZE_XYVERT,XYVERT,INOD) +! 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 -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 +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: -LOGICAL :: INLIST -REAL(EB):: DV(IAXIS:JAXIS), DVNORM -REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYVERT_AUX + ! 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 -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 + ! 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 -RETURN -END SUBROUTINE INSERT_POINT_2D + ! 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 -! ---------------------------- DEBUG_WAIT --------------------------------------- + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. -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)%CUT_FACE(NCUTFACE) -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 + ! 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 ) /) -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 + ! Centroid: + CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & + (/ XFACE(I )+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) -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. + ! 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) -REAL(EB), PARAMETER :: MAX_VAL=1.0E20_EB + ! 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 -LOGICAL :: READ_BINARY + ! 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 -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 + ! 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 -LOGICAL :: IS_TERRAIN,EXTEND_TERRAIN,WRITE_WARNING -REAL(EB):: ZVAL_HORIZON, ZVAL_FACTOR + ! Drop if cut-face has already been counted: + IF( IJK_COUNTED(I,J,K,X1AXIS) ) CYCLE; IJK_COUNTED(I,J,K,X1AXIS)=.TRUE. -INTEGER :: START_FACE_LO, START_FACE_MID, START_FACE_HI + FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE -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' + 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 -LOGICAL :: DONE + FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE -INTEGER :: ILINE, IERR -INTEGER :: IG, IVERT + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -INTEGER, ALLOCATABLE, DIMENSION(:) :: GEOM_LINE,GEOM_LINE2 -INTEGER, PARAMETER :: DELTA_GEOM_LINE=1000 -INTEGER :: GEOM_LINE_SIZE + 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) -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,SURF_ID,SURF_IDS,SURF_ID6,& - TEXTURE_MAPPING,TEXTURE_ORIGIN,TRANSPARENCY,& - VERTS,XB,ZMIN,ZVALS,ZVAL_HORIZON + ! 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) /) -! first pass - count number of &GEOM lines. + ! Centroid: + CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & + (/ XFACE(I-1)+XFACE(I ), YFACE(J )+YFACE(J ), ZFACE(K-1)+ZFACE(K ) /) -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 + ! 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) -! Allocate GEOMETRY array + ! 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 + + ! 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 + + ! 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. + + FCVAR(I,J,K,CC_FGSC,X1AXIS)=CC_CUTCFE -ALLOCATE(GEOMETRY(0:N_GEOMETRY),STAT=IZERO) -CALL ChkMemErr('READ_GEOM','GEOMETRY',IZERO) + 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 -! third pass - read GEOM data + FCVAR(I,J,K,CC_IDCF,X1AXIS) = NCUTFACE -READ_GEOM_LOOP: DO N=1,N_GEOMETRY - G=>GEOMETRY(N) + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) - CALL CHECKREAD('GEOM',LU_INPUT,IOS) ; IF (STOP_STATUS==SETUP_STOP) RETURN - IF (IOS==1) EXIT READ_GEOM_LOOP + 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) - 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 + ! 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) /) - 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 + ! Centroid: + CF%XYZCEN(IAXIS:KAXIS,NFACE) = 0.5_EB* & + (/ XFACE(I-1)+XFACE(I ), YFACE(J-1)+YFACE(J ), ZFACE(K )+ZFACE(K ) /) - 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 + ! 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) - ! 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 + ! 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 - 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 IBNDINT_LOOP - ! count POLY Verts: - DO I = 1,MAX_POLY_VERTS - IF (POLY(I)==0) EXIT - N_POLY_VERTS = N_POLY_VERTS+1 - ENDDO +IF (.NOT.BNDINT_FLAG) DEALLOCATE( IJK_COUNTED ) - ! 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 +RETURN +END SUBROUTINE DEFINE_REGULAR_CUTFACES - ! 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 VOLUS - DO I = 1, MAX_VOLUS - IF (ANY(VOLUS(4*I-3:4*I)==0)) EXIT - N_VOLUS = N_VOLUS+1 - ENDDO +! ---------------------------- SORT_VERTS --------------------------------------- - ! count ZVALS - DO I = 1, MAX_ZVALS - IF (ZVALS(I)>MAX_VAL) EXIT - N_ZVALS=N_ZVALS+1 - ENDDO +SUBROUTINE SORT_VERTS(MAXVERTS,NVERTS,VERTS1,VERTS2,XV,ASCDESC,NV,V) - 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 +INTEGER, INTENT(IN) :: MAXVERTS, NVERTS +REAL(EB),INTENT(IN) :: VERTS1(MAXVERTS),VERTS2(MAXVERTS),XV +LOGICAL, INTENT(IN) :: ASCDESC +INTEGER, INTENT(OUT):: NV,V(MAXVERTS) - ! 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 +! Local Variables: +INTEGER :: IV, IIV, JJV +INTEGER :: V2(MAXVERTS) +LOGICAL :: FOUND - ! 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 +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 -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 + 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 SUBROUTINE SORT_VERTS + +! ----------------------------- FACE_REALLOC ------------------------------------- + +SUBROUTINE FACE_REALLOC(NM,ICF,NVERT,NFACE,NSVERT,NSFACE,NVERTFACE_NEW) - N_VERTS_ORIG = N_VERTS - N_FACES_ORIG = N_FACES - N_VOLUS_ORIG = N_VOLUS +INTEGER, INTENT(IN) :: NM,ICF,NVERT,NFACE,NSVERT,NSFACE +INTEGER, INTENT(INOUT) :: NVERTFACE_NEW - !--- 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 +NVERTFACE=SIZE(MESHES(NM)%CUT_FACE(ICF)%CFELEM,DIM=1) +NVERTFACE_NEW = MAX(NVERTFACE_NEW,NVERTFACE) - ! 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) +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 - ZVAL_FACTOR = 1._EB - IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. +IF(SIZE(MESHES(NM)%CUT_FACE(ICF)%AREA,DIM=1) SIZE_CUT_FACE) THEN - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO + ALLOCATE(CUT_FACE_AUX(SIZE_CUT_FACE+GLOBAL_DELTA_FACE)) - 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. + 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 - ! 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) +RETURN +END SUBROUTINE CUT_FACE_ARRAY_REALLOC - 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 +! --------------------------- CUT_FACE_MOVE ------------------------------------- - ENDIF +SUBROUTINE CUT_FACE_MOVE(CUT_FACE_FROM,CUT_FACE_TO) - ! 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 +TYPE(CC_CUTFACE_TYPE), INTENT(INOUT) :: CUT_FACE_FROM, CUT_FACE_TO - 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) +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 - FACES(3*IJF-2) = I2 - FACES(3*IJF-1) = I1 - FACES(3*IJF) = I4 - IJF = IJF + 1 +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) - FACES(3*IJF-2) = I2 - FACES(3*IJF-1) = I4 - FACES(3*IJF) = I3 - IJF = IJF + 1 - 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) - ! 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 +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) - N_VERTS = IJ - 1 - N_FACES = IJF - 1 +RETURN +END SUBROUTINE CUT_FACE_MOVE - DEALLOCATE(B_IND,E_IND,F_IND) - ELSEIF(IS_TERRAIN) THEN ZVALS_IF +! ---------------------------- FACE_DEALLOC ------------------------------------- - GEOM_TYPE = TERRAIN_GEOM_TYPE - TERRAIN_CASE= .TRUE. +SUBROUTINE FACE_DEALLOC(NM,ICF,DO_BNCF) - ! 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 +INTEGER, INTENT(IN) :: NM,ICF +INTEGER, OPTIONAL, INTENT(IN) :: DO_BNCF + +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) +IF(ALLOCATED(MESHES(NM)%CUT_FACE(ICF)%BODTRI)) DEALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI) - ! 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) +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) - ! 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 +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) + +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) - ! 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) - 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) +RETURN +END SUBROUTINE FACE_DEALLOC - ZVAL_FACTOR = 1._EB - IF(ZVAL_HORIZON > MAX_VAL) ZVAL_FACTOR = 0._EB ! Not defined, use boundary polygon heights. +! -------------------------- NEW_FACE_ALLOC ------------------------------------- - N_VOLUS = 0 +SUBROUTINE NEW_FACE_ALLOC(NM,ICF,NVERT,NFACE,NVERTFACE,IBNDINT) - 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 +INTEGER, INTENT(IN) :: NM,ICF,NVERT,NFACE,NVERTFACE +INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT - B_IND(1:N_BEDGES) = BOUND_EDGES(NOD1,1:N_BEDGES); B_IND(N_BEDGES+1) = B_IND(1) ! Last equal to first +! 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 - ! 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 +! 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 - B_IND(N_BEDGES+1:2*N_BEDGES) = B_IND(1:N_BEDGES) - B_IND(2*N_BEDGES+1) = B_IND(1) +!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 - ! 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 +ALLOCATE(MESHES(NM)%CUT_FACE(ICF)%BODTRI(1:2,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%BODTRI = CC_UNDEFINED - ! 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(MESHES(NM)%CUT_FACE(ICF)%UNKZ(LOW_IND:HIGH_IND,1:NFACE));MESHES(NM)%CUT_FACE(ICF)%UNKZ = CC_UNDEFINED - ! 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)) +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 - ! 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(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 - ! 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) +RETURN +END SUBROUTINE NEW_FACE_ALLOC - 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 +! -------------------------- ALLOC_FACE_STATE_VARS ------------------------------------- - ! 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) +SUBROUTINE ALLOC_FACE_STATE_VARS(NM,ICF,NFACE,IBNDINT) - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +INTEGER, INTENT(IN) :: NM,ICF,NFACE +INTEGER, OPTIONAL, INTENT(IN) :: IBNDINT - 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) +! !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) - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 - 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 - ELSE +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 - ! 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. +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; - ! 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 +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 - ! 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) +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 ALLOC_FACE_STATE_VARS - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 +! ---------------------- GET_CARTCELL_CUTEDGES ---------------------------------- - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I3 - FACES(3*IJF) = I4 - IJF = IJF + 1 - ENDDO +SUBROUTINE GET_CARTCELL_CUTEDGES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) - ! Add bottom faces: - DO I=1,N_BEDGES - I1 = F_IND(I) - I2 = IJ - 1 ! ZLOW center vert. - I3 = F_IND(I+1) +USE TRAN, ONLY : TRANS - FACES(3*IJF-2) = I1 - FACES(3*IJF-1) = I2 - FACES(3*IJF) = I3 - IJF = IJF + 1 - ENDDO +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND - 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 - N_VERTS = IJ - 1 - N_FACES = IJF - 1 +! REAL(QB) :: DVQ(IAXIS:KAXIS), SLENQ, STANIQ(IAXIS:KAXIS), DENOMQ, PLANEEQQ - DEALLOCATE(B_IND,E_IND,F_IND,BOUND_EDGES) +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +INTEGER :: NCUTEDG - ENDIF ZVALS_IF +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 - !--- setup a block object (XB keyword ) +TNOW=CURRENT_TIME() - 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 +! BODINT_CELL: +GEOM_LOOP : DO IG=1,N_GEOMETRY - ! define verts in box + ! 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)) - 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 + IWSEDG_LOOP : DO IWSEDG=1,GEOMETRY(IG)%N_EDGES - ! define tetrahedrons in box + ! Seg Nodes location: + SEG(NOD1:NOD2) = GEOMETRY(IG)%EDGES(NOD1:NOD2,IWSEDG) - 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 + 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)) - ! 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 + DO X1AXIS=IAXIS,KAXIS + EDGECUBE( LOW_IND,X1AXIS) = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) + EDGECUBE(HIGH_IND,X1AXIS) = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) ENDDO - N_FACES=0 - ENDIF NXB_IF - ! setup a sphere object (SPHERE_RADIUS and SPHERE_ORIGIN keywords) - - IF (SPHERE_RADIUS 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 - M => MESHES(1) - DX = M%DXMIN + ! 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 - ! 2*PI*R/(5*2^N_LEVELS) ~= DX, solve for N_LEVELS + ! Optimized for UG: + X1NOC=TRANS(NM)%NOC(X1AXIS) + MINX = MIN(XYZ1(X1AXIS),XYZ2(X1AXIS)) + MAXX = MAX(XYZ1(X1AXIS),XYZ2(X1AXIS)) - IF (SPHERE_RADIUS<100.0_EB*TWENTY_EPSILON_EB) SPHERE_RADIUS = 100.0_EB*TWENTY_EPSILON_EB + 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) - 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 + 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 - ! 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 + ! 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 - ! 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) + ! 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(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 + 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. - 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 + ! 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 - ENDIF DEFINE_CYLINDER_IF - ! 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 + ! 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 - ! 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 - 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 + ! 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 - 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) + ! 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 - IF(IERR /= 0) RETURN + ENDDO + DEALLOCATE(X1FACE,DX1FACE) + ENDDO X1AXIS_LOOP2 - IF(ALLOCATED(SURFS)) DEALLOCATE(SURFS); ALLOCATE(SURFS(N_FACES)); SURFS = 0 + ! 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 - 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 + ! Location along Segment: + SVAR1 = BODINT_CELL_EDGE%SVAR(IEDGE ) + SVAR2 = BODINT_CELL_EDGE%SVAR(IEDGE+1) - ENDIF POLY_COND + ! Location of midpoint of cut-edge: + SVAR12 = 0.5_EB * (SVAR1+SVAR2) - 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 + ! 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 - 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 + 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 - ! wrap up + 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 + + ! 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 - G%ID = ID - G%N_VOLUS_BASE = N_VOLUS - G%N_FACES_BASE = N_FACES - G%N_VERTS_BASE = N_VERTS + ! 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 - ! 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 + 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 - 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 + ENDDO IWSEDG_LOOP - IF (MATL_ID=='null') THEN - HAVE_MATL = .FALSE. - ENDIF - G%MATL_ID = MATL_ID - G%HAVE_MATL = HAVE_MATL + ! Deallocate BODINT_CELL_EDGE: + DEALLOCATE(BODINT_CELL_EDGE%SVAR) - IF (N_VERTS>0) THEN +ENDDO GEOM_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 +! 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) - 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 + ! 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 - ! setup volumes + ! 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 - 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 + ! 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 - 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 + X2AXIS = MAXLOC(ABS(NP(IAXIS:KAXIS)),DIM=1) + CALL GET_IS_SOLID_3D(X2AXIS,XP,I,J,K,SOLID_EDGE(IEDGE)) + ENDDO - ! determine which tetrahedron faces are external + ! 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 - 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) + 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 - IS_EXTERNAL(0:N_FACES-1)=.TRUE. ! start off by assuming all faces are external +T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTEDGES_TIME_INDEX ) + CURRENT_TIME() - TNOW - ! reorder face indices so the the first index is always the smallest +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 - ! 1 - ! /|\ . - ! / | \ . - ! / | \ . - ! / | \ . - ! / | \ . - ! / 4 \ . - ! / . . \ . - ! / . . \ . - ! / . . \ . - ! / . . \ . - ! / . . \ . - ! / . .\ . - ! 2-------------------------3 +RETURN +END SUBROUTINE GET_CARTCELL_CUTEDGES - 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)) +! ------------------------- GET_IS_SOLID_3D ------------------------------------- - 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 GET_IS_SOLID_3D(X2AXIS,XP,I,J,K,IS_SOLID) - 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)) +INTEGER, INTENT(IN) :: X2AXIS,I,J,K +REAL(EB), INTENT(IN) :: XP(IAXIS:KAXIS) +LOGICAL, INTENT(OUT):: IS_SOLID - 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 +! 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. - ! find faces that match +IJK(IAXIS:KAXIS) = (/ I, J, K /) - SORT_FACES=2 - IF (GEOM_TYPE == SPHERE_GEOM_TYPE) SORT_FACES = 3 ! Case of sphere. +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 - 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 +IF (BODINT_PLANE2%NSEGS == 0) THEN + IS_SOLID =.FALSE. + RETURN +ENDIF - ! create new FACES index array keeping only external faces +XY(IAXIS:JAXIS) = (/ XP(X2AXIS), X3RAY /) +CALL GET_IS_SOLID_PT(BODINT_PLANE2,X1AXIS,X2AXIS,X3AXIS,XY,NVEC,X1PLN,IS_SOLID) - 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 +RETURN +END SUBROUTINE GET_IS_SOLID_3D - 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 - ENDIF - CALL COMPUTE_TEXTURES(VERTS,FACES,TFACES,MAX_VERTS,MAX_FACES,N_FACES) +! ---------------------- GET_CARTCELL_CUTFACES ---------------------------------- - ! 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 +SUBROUTINE GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,BNDINT_FLAG) - ! 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 +USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT - 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) +INTEGER, INTENT(IN) :: NM +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND +LOGICAL, INTENT(IN) :: BNDINT_FLAG + + ! 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 + +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 - ! 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 +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNTED +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:):: IJK_COUNTF - 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) +INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CFELEM,CEDGES - ALLOCATE(G%SURFS(N_FACES),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%SURFS',IZERO) +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 - 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 :: 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) - ! 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 +REAL(EB) :: TNOW - ENDIF N_FACES_IF +INTEGER :: ETYPE,JEC +REAL(EB) :: X1V(IAXIS:KAXIS), X2V(IAXIS:KAXIS) +! INTEGER :: IEC +! REAL(EB) :: X1E(IAXIS:KAXIS), X2E(IAXIS: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) +! GET_CUTCELLS_VERBOSE variables: +REAL(EB) :: CPUTIME, CPUTIME_START +INTEGER :: NCUTFCE - ALLOCATE(G%VERTS(3*N_VERTS),STAT=IZERO) - CALL ChkMemErr('READ_GEOM','G%VERTS',IZERO) +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 - G%MOVE_ID = MOVE_ID - G%IS_DYNAMIC = .FALSE. +TNOW=CURRENT_TIME() - ! Prevent drawing of boundary info if desired +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)) - G%SHOW_BNDF = BNDF_GEOM +! 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 - ! 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 +! Loop on Cartesian cells, define cut cells and solid cells ISSO: +DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -ENDDO READ_GEOM_LOOP -35 REWIND(LU_INPUT) ; INPUT_FILE_LINE_NUMBER = 0 + IF(IJK_COUNTED(I,J,K)) CYCLE -CALL CONVERTGEOM(T_BEGIN) + ! 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 IG = 1, N_GEOMETRY + ! 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) - G=>GEOMETRY(IG) + ! 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 - ! 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 +ENDDO - ! Check for duct nodes - DO J = 1,G%N_FACES - IF (SURFACE(G%SURFS(J))%NODE_ID/='null') THEN - G%HAVE_NODE = .TRUE. - EXIT - ENDIF - 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 -ENDDO + SELECT CASE(X1AXIS) + CASE(IAXIS) -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) + 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 -DEALLOCATE(GEOM_LINE) + ! x2, x3 axes parameters: + X2AXIS = JAXIS; X2LO = JLO_FACE-CCGUARD; X2HI = JHI_FACE+CCGUARD + X3AXIS = KAXIS; X3LO = KLO_FACE-CCGUARD; X3HI = KHI_FACE+CCGUARD -IF( (T_END-T_BEGIN) < TWENTY_EPSILON_EB) RETURN + ! location in I,J,K of x2,x2,x3 axes: + XIAXIS = IAXIS; XJAXIS = JAXIS; XKAXIS = KAXIS -CC_IBM = .TRUE. + ! 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 -! For unstructured projection define Pressure solver on unstructured grid. -PRES_ON_WHOLE_DOMAIN = .FALSE. -IF (ABS(CCVOL_LINK-0.95_EB) TWENTY_EPSILON_EB) NVEC=NVEC/NORM2(NVEC) + ! 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 -! 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 + ! 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 -! 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 + ! 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) -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 + 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 -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) + ! 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 -! 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. + ! 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 - ! 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) 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 + ! Allocate triangles variables: + ALLOCATE(BODINT_PLANE%X1NVEC(1:BODINT_PLANE%NTRIS), & + BODINT_PLANE%AINV(1:2,1:2,1:BODINT_PLANE%NTRIS)) + ! Triangles inverses: + DO ITRI=1,BODINT_PLANE%NTRIS -SUBROUTINE DEFINE_CYLINDER(VERTS,MAXVERTS,NVERTS,FACES,MAXFACES,NFACES,VOLS,MAXVOLS,NVOLS,CYL_FIND) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT + TRIS(NOD1:NOD3) = BODINT_PLANE%TRIS(NOD1:NOD3,ITRI) -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) + ! 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)) /) -! 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 + ! 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) + ! 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 + ! 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 -! Check if CYLINDER axis is any of IAXIS, JAXIS, KAXIS: -IF (ABS(CYLINDER_AXIS(JAXIS)) 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) + + ! 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 + + 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 - IVERT = IVERT + 1 - VERTS(3*IVERT-2:3*IVERT) = (/ POS_1, POS_2, POS_3 /) + ENDIF - ENDDO -ENDDO VERTEX_LOOP + ! 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) -! 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 /) + ENDIF + IJK_COUNTF(INDIF,INDJF,INDKF,X1AXIS)=.TRUE. -NVERTS = IVERT + ENDIF + ENDDO + ENDDO -! 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 + DEALLOCATE(BODINT_PLANE%X1NVEC,BODINT_PLANE%AINV) + ENDDO ! I + ENDDO ! J + ENDDO ! K -! Cylinder side faces: -CYL_FIND(LOW_IND,2) = IFACE + 1 -FACE_LOOP : DO ILE=2,NP_L - DO IFC=1,NP_T + ! Deallocate local plane arrays: + DEALLOCATE(X1FACE,X2FACE,X3FACE,X2CELL,X3CELL) + DEALLOCATE(DX1FACE,DX2FACE,DX3FACE,DX2CELL,DX3CELL) - ! 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 X1AXIS_LOOP +! ENDIF BNDINT_COND - IFACE=IFACE+1 - FACES(3*IFACE-2:3*IFACE) = (/I1, I3, I2/) - IFACE=IFACE+1 - FACES(3*IFACE-2:3*IFACE) = (/I3, I4, I2/) +! 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 - ENDDO -ENDDO FACE_LOOP -CYL_FIND(HIGH_IND,2) = IFACE + IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE -! 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 + IF (CELLRT(I,J,K)) CYCLE ! Special cell with bod-bod or self intersection. -! 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(IJK_COUNTED(I,J,K)) CYCLE; IJK_COUNTED(I,J,K)=.TRUE. -! No volumes being defined. -NVOLS = 0 -VOLS = 0 + ! 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) -! 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 + ! Start cut-cell INB cut-faces computation: + ! Loop local arrays to cell: + NSEG = 0 + SEG_CELL = CC_UNDEFINED -RETURN -END SUBROUTINE DEFINE_CYLINDER + NVERT = 0 + NFACE = 0 + XYZVERT = 0._EB -! ---------------------------- GET_GEOM_INFO ---------------------------------------- + ! 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) -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. + ! 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 -! 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. + 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) -INTEGER, INTENT(INOUT) :: MAX_ZVALS,MAX_VERTS,MAX_FACES,MAX_VOLUS,MAX_IDS,MAX_SURF_IDS,MAX_POLY_VERTS + ! 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) -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) + 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 -END SUBROUTINE GET_GEOM_INFO + ! 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 -! ---------------------------- ALLOCATE_BUFFERS ---------------------------------------- + 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) -SUBROUTINE ALLOCATE_BUFFERS + ! 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(SURF_ID)) DEALLOCATE(SURF_ID) -ALLOCATE(SURF_ID(MAX_SURF_IDS+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','SURF_ID',IZERO) + IF (INOD1 == INOD2) CYCLE -IF(ALLOCATED(ZVALS)) DEALLOCATE(ZVALS) -ALLOCATE(ZVALS(MAX_ZVALS+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','ZVALS',IZERO) + 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(ALLOCATED(VERTS)) DEALLOCATE(VERTS) -ALLOCATE(VERTS(3*MAX_VERTS+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','VERTS',IZERO) + ! 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) -IF(ALLOCATED(TFACES)) DEALLOCATE(TFACES) -ALLOCATE(TFACES(6*MAX_FACES+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','TFACES',IZERO) + ! Now obtain body-triangle combinations present: + BOD_TRI = CC_UNDEFINED + NBODTRI = 0 + DO ISEG=1,NSEG -IF(ALLOCATED(FACES)) DEALLOCATE(FACES) -ALLOCATE(FACES(4*MAX_FACES+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','FACES',IZERO) + ! 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 .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 -IF(ALLOCATED(VOLUS)) DEALLOCATE(VOLUS) -ALLOCATE(VOLUS(4*MAX_VOLUS+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','VOLUS',IZERO) + ! No second triangle associated: + IF ( SEG_CELL(3,ISEG) < 2 .OR. SEG_CELL(6,ISEG)<1 .OR. SEG_CELL(5,ISEG)<1 ) CYCLE -IF(ALLOCATED(POLY)) DEALLOCATE(POLY) -ALLOCATE(POLY(MAX_POLY_VERTS+1),STAT=IZERO) -CALL ChkMemErr('ALLOCATE_BUFFERS','POLY',IZERO) -END SUBROUTINE ALLOCATE_BUFFERS + ! 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. -! ---------------------------- SET_GEOM_DEFAULTS ---------------------------------------- + ! 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. -SUBROUTINE SET_GEOM_DEFAULTS + ! 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 - ! Set defaults + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) - 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' + 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 -END SUBROUTINE SET_GEOM_DEFAULTS + ! Running by body-triangle combination, define list of + ! segments that belong to each pair. + ICF_LOOP : DO ICF=1,NBODTRI -! ! ---------------------------- 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 + IBOD = BOD_TRI(1,ICF) + ITRI = BOD_TRI(2,ICF) -! ! ---------------------------- 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 + 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 -! ---------------------------- BOX2TETRA ---------------------------------------- + ! If only one or two seg => continue: + IF ( NSEG_FACE <= 2 ) CYCLE -SUBROUTINE BOX2TETRA(BOX,TETRAS) + ! 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 -! split a box defined by a list of 8 vertices (not necessarily cubic) into 6 stackable tetrahedrons + 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 -! 8-------7 -! / . / | -! 5-------6 | -! | . | | -! | . | | -! | 4-------3 -! | / | / -! 1-------2 + 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 -INTEGER, INTENT(IN) :: BOX(8) -INTEGER, INTENT(OUT) :: TETRAS(1:24) + 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 -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)/) + ENDIF -END SUBROUTINE BOX2TETRA + ENDDO INF_LOOP + IF (CYCLE_CELL) EXIT ICF_LOOP -! ! ---------------------------- 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 ( COUNTR /= NSEG_FACE) & + PRINT*, "Building INBOUND faces: ~isequal(countr,nseg)" -! ! ---------------------------- 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 + ! Using triangles normal, reorder nodes as in right hand rule. + NORMTRI(IAXIS:KAXIS) = GEOMETRY(IBOD)%FACES_NORMAL(IAXIS:KAXIS,ITRI) -! ---------------------------- ORDER_FACES ---------------------------------------- + ! 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 -SUBROUTINE ORDER_FACES(ORDER,N) ! -INTEGER, INTENT(IN) :: N -INTEGER, INTENT(OUT) :: ORDER(1:N) + ! 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) -INTEGER, ALLOCATABLE, DIMENSION(:) :: WORK -INTEGER :: I, IZERO + 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 = 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 + 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) -! ---------------------------- ORDER_FACES1 ---------------------------------------- + RH_ORIENTED = ( NORMTRI(IAXIS)*CROSSV(IAXIS) + & + NORMTRI(JAXIS)*CROSSV(JAXIS) + & + NORMTRI(KAXIS)*CROSSV(KAXIS) ) > 0._EB -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 + 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 -INTEGER :: NMID + ! 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 -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 + 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 -! ---------------------------- COMPARE_FACES ---------------------------------------- + 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) -INTEGER FUNCTION COMPARE_FACES(INDEX1,INDEX2) -INTEGER, INTENT(IN) :: INDEX1, INDEX2 -INTEGER, POINTER, DIMENSION(:) :: FACE1, FACE2 -INTEGER :: F1(3), F2(3) + 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) -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))/) + 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 -COMPARE_FACES=0 -IF (F1(1)F2(1)) THEN - COMPARE_FACES=-1 -ENDIF -IF (COMPARE_FACES/=0) RETURN + 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) -IF (F1(2)F2(2)) THEN - COMPARE_FACES=-1 -ENDIF -IF (COMPARE_FACES/=0) RETURN + 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) -IF (F1(3)F2(3)) THEN - COMPARE_FACES=-1 -ENDIF -END FUNCTION COMPARE_FACES + ENDDO ICF_LOOP -END SUBROUTINE READ_GEOM + ! 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 -! ---------------------------- INIT_SPHERE ---------------------------------------- + ENDDO ! I + ENDDO ! J +ENDDO ! K -SUBROUTINE INIT_SPHERE(N_LEVELS,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +! 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 -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 ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE -REAL(EB) :: ARG -REAL(EB), DIMENSION(3) :: VERT -INTEGER :: I,IFACE -INTEGER, DIMENSION(60) :: FACE_LIST + IF (.NOT.CELLRT(I,J,K)) CYCLE ! Special cell with bod-bod or self intersection. -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 & - / + IF (IJK_COUNTED(I,J,K)) CYCLE; IJK_COUNTED(I,J,K)=.TRUE. -N_VERTS = 12 -N_FACES = 20 + ! Start cut-cell INB cut-faces computation: + ! Loop local arrays to cell: + NSEG = 0 + SEG_CELL = CC_UNDEFINED -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 + NVERT = 0 + NFACE = 0 + XYZVERT = 0._EB -SPHERE_FACES(1:60) = FACE_LIST(1:60) + ! 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) -! refine each triangle of the icosahedron recursively until the -! refined triangle sides are the same size as the grid mesh + ! 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 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 + 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) -! ---------------------------- COMPUTE_TEXTURES ---------------------------------------- + ! 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 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) + 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 -INTEGER :: IFACE -REAL(EB) :: EPS_TEXTURE -REAL(EB), POINTER, DIMENSION(:) :: TFACE, VERTPTR -INTEGER, POINTER, DIMENSION(:) :: FACEPTR + ! 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) -EPS_TEXTURE=0.25_EB -IFACE_LOOP: DO IFACE=0, N_FACES-1 + IF (NSEG < 3 ) CYCLE - FACEPTR=>SPHERE_FACES(3*IFACE+1:3*IFACE+3) - TFACE=>SPHERE_TFACES(6*IFACE+1:6*IFACE+6) + ! 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 - 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)) + ! 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) - VERTPTR=>SPHERE_VERTS(3*FACEPTR(3)-2:3*FACEPTR(3)) - CALL COMPUTE_TEXTURE(VERTPTR(1:3),TFACE(5:6)) + 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( COUNT1.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)%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) - ! make adjustments when face is at a pole + ! Assign surf-index: Depending on GEOMETRY: + NCF = 0 + DO ICF=1,NFACE + IBOD = BOD_TRI(1,ICF); ITRI = BOD_TRI(2,ICF) - 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 + ! 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 - 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 + ! 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 -ENDDO IFACE_LOOP -END SUBROUTINE COMPUTE_TEXTURES + ! Area: + AREA = 0.5_EB*NNORM -! ---------------------------- INIT_SPHERE2 ---------------------------------------- + ! dot(i,nc) int(x)dA + INXAREA = NORMTRI(IAXIS)*ACEN(IAXIS)*AREA ! Single Gauss pt integration. -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) + 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 -INTEGER :: I , J, IJ, I11, I12, I21, I22 + NCF = NCF + 1 + CF%AREA(NCF) = AREA + CF%XYZCEN(IAXIS:KAXIS,NCF) = ACEN(IAXIS:KAXIS) -N_VERTS = NLONG*(NLAT-2) + 2 -N_FACES = (NLAT-2)*NLONG*2 + ! 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) -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 + ! Define Body-triangle reference: + CF%BODTRI(1:2,NCF)= (/ IBOD, ITRI /) -! define vertices + CF%SURF_INDEX(NCF) = GEOMETRY(IBOD)%SURFS(ITRI) -! north pole + ! 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) -SPHERE_VERTS(1:3) = (/0.0_EB,0.0_EB,1.0_EB/) + ENDDO + DEALLOCATE(CFELEM,SEG_CELL_AUX,CEDGES) + CF%NFACE = NCF -! middle latitudes + ! 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 -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 + ! 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 -! south pole + ! 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 /) -SPHERE_VERTS(IJ:IJ+2) = (/0.0_EB,0.0_EB,-1.0_EB/) + 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 -! define faces + ENDIF + ENDDO + ENDDO -! 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 + ! 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 -DO ILAT = 2, NLAT - 2 - DO ILONG = 1, NLONG + ENDDO ! I + ENDDO ! J +ENDDO ! K - 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 +IF (.NOT.BNDINT_FLAG) DEALLOCATE(IJK_COUNTED,IJK_COUNTF) +DEALLOCATE(SEG_CELL,SEG_POS) - SPHERE_FACES(IJ:IJ+2) = (/I12,I11,I22/) - SPHERE_FACES(IJ+3:IJ+5) = (/I22,I11,I21/) - IJ = IJ + 6 - ENDDO -ENDDO +T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTFACES_TIME_INDEX) + CURRENT_TIME() - TNOW -! faces connected to south pole +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 -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 +RETURN -! ---------------------------- REFINE_FACE ---------------------------------------- +CONTAINS -RECURSIVE SUBROUTINE REFINE_FACE(N_LEVELS,IFACE,N_VERTS,N_FACES,MAX_VERTS,MAX_FACES,SPHERE_VERTS,SPHERE_FACES) +SUBROUTINE REALLOCATE_SEG_CELL -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) +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 -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 +RETURN +END SUBROUTINE REALLOCATE_SEG_CELL -IF (N_LEVELS==0 .OR. N_FACES+3>MAX_FACES .OR. N_VERTS+3>MAX_VERTS) RETURN ! prevent memory overwrites +END SUBROUTINE GET_CARTCELL_CUTFACES -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 -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) +! ------------------------ GET_CLOSED_POLYLINES --------------------------------- -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) +SUBROUTINE GET_CLOSED_POLYLINES(SIZE_CEELEM_SEG_CELL,NSEG,SEG_CELL,SEG_POS,IFLG,NPOLY,ILO_POLY,NSG_POLY) -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 +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) -! split triangle 123 into 4 triangles +! 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 -! 1 -! /F1\ . -! 12----13 -! /F2\F3/F4\ i. -! 2 --- 23----3 +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 -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/) +! 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) -N1 = IFACE -N2 = N_FACES+1 -N3 = N_FACES+2 -N4 = N_FACES+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 -N_FACES = N_FACES + 3 -N_VERTS = N_VERTS + 3 -IF (N_LEVELS==1) RETURN ! stop recursion +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) -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) +! 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 -END SUBROUTINE REFINE_FACE + ! 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. -! ---------------------------- COMPUTE_TEXTURE ---------------------------------------- + ! 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 -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 + ! End of new polyline creation. + ! Here if we have less that 3 segments not counted exit while loop. + IF (SEG_LEFT < 3) EXIT +ENDDO -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/) +! 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 -!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 +! 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 -! ---------------------------- GET_GEOM_ID ---------------------------------------- +DEALLOCATE(SEG_CELL2,SEG_POS2,COUNTED,BOD,SEG_POLY) -INTEGER FUNCTION GET_GEOM_ID(ID,N_LAST) +IFLG=.FALSE. -! return the index of the geometry array with label ID +RETURN +END SUBROUTINE GET_CLOSED_POLYLINES -CHARACTER(30), INTENT(IN) :: ID -INTEGER, INTENT(IN) :: N_LAST -INTEGER :: N -TYPE(GEOMETRY_TYPE), POINTER :: G +! --------------------------- EAR_CLIP_CFACES ----------------------------------- -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 +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) -! ---------------------------- SETUP_TRANSFORM ---------------------------------------- +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 -! 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 +! 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) -! ---------------------------- SETUP_ROTATE ---------------------------------------- +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 -! 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 +! 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 -! ! ---------------------------- `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 +! 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 -! ---------------------------- `TRANSLATE_VEC_INPLACE` ---------------------------------------- + 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 -! 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 + ! 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 -! ---------------------------- ROTATE_VEC ---------------------------------------- + ! 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 -! 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 + IF ( BOD<1 .OR. TRI<1 ) THEN + CYCLE + ELSE ! Found two segments with matching triangle. -! ---------------------------- GEOMCLIPS ---------------------------------------- + ! 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 -SUBROUTINE GEOMCLIPS -USE BOXTETRA_ROUTINES, ONLY : GEOMCLIP -REAL(EB) :: XB(6) -INTEGER :: I -TYPE(GEOMETRY_TYPE), POINTER :: G + 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 - ! clip geometries to mesh + ! 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) -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 +! 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 -! ---------------------------- PROCESS_GEOM ---------------------------------------- +RETURN +END SUBROUTINE EAR_CLIP_CFACES -SUBROUTINE PROCESS_GEOM(IS_DYNAMIC,TIME, N_VERTS, N_FACES, N_VOLUS) +! ----------------------- GET_CARTCELL_CUTCELLS --------------------------------- -USE GEOMETRY_FUNCTIONS, ONLY: TRANSFORM_COORDINATES +SUBROUTINE GET_CARTCELL_CUTCELLS(NM) -! transform (scale, rotate and translate) vectors found on each &GEOM line +INTEGER, INTENT(IN) :: NM - LOGICAL, INTENT(IN) :: IS_DYNAMIC - REAL(EB), INTENT(IN) :: TIME - INTEGER, INTENT(OUT) :: N_VERTS, N_FACES, N_VOLUS +! 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 :: 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 +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 - IF (IS_DYNAMIC) THEN - DELTA_T = TIME - T_BEGIN - ELSE - DELTA_T = 0.0_EB - ENDIF +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 - 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 +INTEGER, ALLOCATABLE, DIMENSION(:) :: IPTS - 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 +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 - ENDDO +REAL(EB) :: XYZCELL(IAXIS:KAXIS,LOW_IND:HIGH_IND),MINMAX_XYZ_CC(IAXIS:KAXIS,LOW_IND:HIGH_IND),CELL_DELTA(IAXIS:KAXIS) - ! remove this if statement when GEOMCLIPS is ready for use - IF ( I .EQ. 0 ) THEN - CALL GEOMCLIPS - ENDIF +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 - CALL GEOM2TEXTURE +INTEGER :: IBNDINT +LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: IJK_COUNT +REAL(EB) :: TNOW - 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 +! 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 -END SUBROUTINE PROCESS_GEOM +TNOW=CURRENT_TIME() -! ---------------------------- GEOM2TEXTURE ---------------------------------------- +! 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)) -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 +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.) - 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) +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)) - 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 +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)) -! ---------------------------- MERGE_GEOMS ---------------------------------------- +! 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. -SUBROUTINE MERGE_GEOMS(VERTS,N_VERTS,FACES,TFACES,GEOM_IDS,SURF_IDS,N_FACES,VOLUS,MATL_IDS,N_VOLUS,IS_DYNAMIC) +IBNDINT_LOOP : DO IBNDINT=LOW_IND,HIGH_IND ! 1 refers to blocks internal cells, 2 refers to block guard cells. -! combine vectors and faces found on all &GEOM lines into one set of VECTOR and FACE arrays +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 -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) +! 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 :: I -TYPE(GEOMETRY_TYPE), POINTER :: G -INTEGER :: IVERT, ITFACE, IFACE, IVOLUS, IMATL, IGEOM, ISURF, OFFSET + IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE -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 + IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. - 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 + ! 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) - TFACES(1+ITFACE:6*G%N_FACES + ITFACE) = G%TFACES(1:6*G%N_FACES) - ITFACE = ITFACE + 6*G%N_FACES + ! 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) - GEOM_IDS(1+IGEOM:G%N_FACES+IGEOM) = I - IGEOM = IGEOM + G%N_FACES + ! 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 - 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 + ! 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) - 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 + 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 ) /) -END SUBROUTINE MERGE_GEOMS + 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) /) -! ---------------------------- CONVERTGEOM ---------------------------------------- + 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) -SUBROUTINE CONVERTGEOM(TIME) + 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) /) -REAL(EB), INTENT(IN) :: TIME + 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 ) /) -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 + 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) -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 + 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 ) /) -N_VERTS = N_VERTS_S + N_VERTS_D -N_FACES = N_FACES_S + N_FACES_D -N_VOLUS = N_VOLUS_S + N_VOLUS_D + 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) /) -ALLOCATE(VERTS(MAX(1,3*N_VERTS)),STAT=IZERO) ! create arrays to contain all vertices and faces -CALL ChkMemErr('CONVERTGEOM','VERTS',IZERO) + 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 -ALLOCATE(TFACES(MAX(1,6*N_FACES)),STAT=IZERO) ! create arrays to contain all vertices and faces -CALL ChkMemErr('CONVERTGEOM','TVERTS',IZERO) + CEI_AXIS(LOW_IND:HIGH_IND) = IDCF_XYZ(LOW_IND:HIGH_IND,MYAXIS) -ALLOCATE(FACES(MAX(1,3*N_FACES)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','FACES',IZERO) + DO SIDE=LOW_IND,HIGH_IND + ! Low High face: + IF ( FSID_XYZ(SIDE,MYAXIS) == CC_GASPHASE ) THEN -ALLOCATE(SURF_IDS(MAX(1,N_FACES)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','SURF_IDS',IZERO) + ! Regular Face, build 4 vertices + face: + NP = 0 + NFACE_CELL = NFACE_CELL + 1 -ALLOCATE(GEOM_IDS(MAX(1,N_FACES)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','SURF_IDS',IZERO) + ! 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) -ALLOCATE(VOLUS(MAX(1,4*N_VOLUS)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','VOLUS',IZERO) + ! 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) -ALLOCATE(MATL_IDS(MAX(1,N_VOLUS)),STAT=IZERO) -CALL ChkMemErr('CONVERTGEOM','MATL_IDS',IZERO) + NP = NP + 1 + FACE_CELL(1,NFACE_CELL) = NP + FACE_CELL(NP+1,NFACE_CELL) = INOD + 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 + ELSEIF (FSID_XYZ(SIDE,MYAXIS) == CC_CUTCFE ) THEN -RETURN -END SUBROUTINE CONVERTGEOM + 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 -! ---------------------------- REORDER_FACE ---------------------------------------- + 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 -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) + N_GAS_CFACES = NFACE_CELL -INTEGER :: VERTS_TEMP(5) + ! 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 ( VERTS(1) 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 -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 + DO IFACE=1,NFACE_CELL + NIEDGE = FACE_CELL(1,IFACE) - CALL PROCESS_GEOM(IS_DYNAMIC,TIME,N_VERTS, N_FACES, N_VOLUS) ! scale, rotate, translate GEOM vertices + ! 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 - ALLOCATE(VERTS(MAX(1,3*N_VERTS)),STAT=IZERO) ! create arrays to contain all vertices and faces - CALL ChkMemErr('OUTGEOM','VERTS',IZERO) + 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)) - ALLOCATE(TFACES(MAX(1,6*N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','VERTS',IZERO) + IF ( TEST1 .OR. TEST2 ) THEN + INLIST = .TRUE. + EXIT + ENDIF + enddo + IF (.NOT.INLIST) THEN + NSEG_CELL = NSEG_CELL + 1 - ALLOCATE(FACES(MAX(1,3*N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','FACES',IZERO) + ! 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) - ALLOCATE(GEOM_IDS(MAX(1,N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','GEOM_IDS',IZERO) + ! New SIZE_CEELEM_EDGFAC: + SIZE_CEELEM_EDGFAC = SIZE_CEELEM_EDGFAC + DELTA_EDGE - ALLOCATE(SURF_IDS(MAX(1,N_FACES)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','SURF_IDS',IZERO) + ! 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 - ALLOCATE(VOLUS(MAX(1,4*N_VOLUS)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','VOLUS',IZERO) + ! 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 - ALLOCATE(MATL_IDS(MAX(1,N_VOLUS)),STAT=IZERO) - CALL ChkMemErr('OUTGEOM','MATL_IDS',IZERO) + 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)**20 .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 + NEWFACE = .FALSE. + NFACEI = FACE_CELL(1,IFACE) - 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 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 - 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 + ! 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 -END SUBROUTINE OUTGEOM + ! 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 -! ---------------------------- WRITE_GEOM_ALL ------------------------------------ + ! 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 -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 + 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 -! ---------------------------- WRITE_GEOM ---------------------------------------- + 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 -! output geometries to a .ge file + 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 -REAL(EB), INTENT(IN) :: TIME -INTEGER :: ONE=1, ZERO=0, VERSION=2 -TYPE(TRANSFORM_TYPE), POINTER :: T + ! 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 -IF (N_GEOMETRY<=0) RETURN + ! Define Body-triangle reference: + MESHES(NM)%CUT_FACE(IDCF)%BODTRI(1:2,NIBFACE)= (/ IBOD, ITRI /) -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)) + ! 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) -WRITE_GEOM_FIRST = .FALSE. + ! 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 -END SUBROUTINE WRITE_GEOM + ! 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) /) -! ---------------------------- WRITE_GEOM_DATA----------------------------------- + ELSE CYCLE_CELL_COND -! 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 + ! 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 -! ! ---------------------------- 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 + ! 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)) -! ---------------------------- TRIANGLE_AREA ---------------------------------------- + ! 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 -REAL(EB) FUNCTION TRIANGLE_AREA(V1,V2,V3) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT + ENDIF CYCLE_CELL_COND -REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3) -REAL(EB) :: N(3),R1(3),R2(3) + ! 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 -R1 = V2-V1 -R2 = V3-V1 -CALL CROSS_PRODUCT(N,R1,R2) + ! Resize array MESHES(NM)%CUT_CELL if necessary: + CALL CUT_CELL_ARRAY_REALLOC(NM,NCUTCELL) -TRIANGLE_AREA = 0.5_EB*NORM2(N) + ! 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) -END FUNCTION TRIANGLE_AREA + ! 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)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 + ! 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 -! ! ---------------------------- 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 + ENDDO ! I + ENDDO ! J +ENDDO ! K -! ---------------------------- POINT_IN_BOX_2D ---------------------------------------- +ENDDO IBNDINT_LOOP -LOGICAL FUNCTION POINT_IN_BOX_2D(P,BB,IOR) +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) -REAL(EB), INTENT(IN) :: P(3),BB(6) -INTEGER, INTENT(IN) :: IOR +T_CC_USED(GET_CARTCELL_CUTCELLS_TIME_INDEX) = T_CC_USED(GET_CARTCELL_CUTCELLS_TIME_INDEX) + CURRENT_TIME() - TNOW -POINT_IN_BOX_2D=.FALSE. +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 -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 +RETURN -END FUNCTION POINT_IN_BOX_2D +CONTAINS -! ---------------------------- POINT_IN_TETRAHEDRON ---------------------------------------- +SUBROUTINE REALLOCATE_LOCAL_FC_VARS -LOGICAL FUNCTION POINT_IN_TETRAHEDRON(XP,V1,V2,V3,V4,BB) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +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 -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 +SUBROUTINE REALLOCATE_FACE_CELL_VERTS -! 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 (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 -POINT_IN_TETRAHEDRON=.FALSE. +RETURN +END SUBROUTINE REALLOCATE_FACE_CELL_VERTS -! first test bounding box +END SUBROUTINE GET_CARTCELL_CUTCELLS +! ------------------------ GET_TRIANG_FACE_INT ---------------------------------- -IF (XP(1)BB(2)) RETURN -IF (XP(2)BB(4)) RETURN -IF (XP(3)BB(6)) RETURN +SUBROUTINE GET_TRIANG_FACE_INT(X2AXIS,X3AXIS,FVERT,CEI,NM, & + INB_FLG,NVERT,XYVERT,NEDGE,CEELEM,INDSEG) -POINT_IN_TETRAHEDRON=.TRUE. +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) -FACE_LOOP: DO I=1,4 +! 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 - 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 +REAL(EB), ALLOCATABLE, SAVE, DIMENSION(:,:) :: X2X3VERT +INTEGER, SAVE :: SIZE_X2X3VERT - ! if the sign of the dot products are equal, the point is inside, else it is outside and we return +INTEGER :: IWSSEG,NSVERT,NINTP_SEG,SEGNODS(NOD1:NOD2) - 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 +! 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 + + IF (NVERT > SIZE_X2X3VERT) THEN + DEALLOCATE(X2X3VERT) + SIZE_X2X3VERT = NVERT + DELTA_VERT + ALLOCATE(X2X3VERT(IAXIS:JAXIS,1:SIZE_X2X3VERT)); X2X3VERT = 0._EB ENDIF -ENDDO FACE_LOOP + 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) -END FUNCTION POINT_IN_TETRAHEDRON + 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 -! ! ---------------------------- 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 ---------------------------------------- +! 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 -LOGICAL FUNCTION VALID_TRIANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3,VERT_FLAG) +! Now if intest is true figure out if there are triangles-face intersection +! Polygons: +NFVERT = 4 +NTVERT = 3 +NSVERT = 2 -INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3, VERT_FLAG(0:300) -REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) +! 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 -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 +NINTP = NVERT -INTEGER :: I +! Loop in-plane Surface Elements: +DO ITRI=1,BODINT_PLANE%NTRIS -VALID_TRIANGLE = .FALSE. + NINTP_TRI = 0 + TRINODS = CC_UNDEFINED -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) + ! 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 -U1 = V2 - V1; -U2 = V3 - V2; + ! 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 -! triangle is invalid if angle at V2 is > 180 deg + 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) -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 + 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 -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 + ! 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 -VALID_TRIANGLE = .TRUE. -END FUNCTION VALID_TRIANGLE + IF ( OUTFACE ) CYCLE -! ------------------------- PT_LINE_DISTANCE_2D ------------------------------------ + ! Insertion add point to intersection list: + XP(IAXIS:JAXIS) = XYEL(IAXIS:JAXIS,IPT) + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) -! 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 + ! 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 + TRIVERT_IN_FACE(IPT,ITRI) = 1 -! ----------------------------- DIFF_ANGLE ----------------------------------------- + ENDDO -LOGICAL FUNCTION DIFF_ANGLE(DIR, VERTS, NVERTS, IV1, IV2, IV3, ABS_FLG) + ! 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) -INTEGER, INTENT(IN) :: DIR, NVERTS, IV1, IV2, IV3 -REAL(FB), INTENT(IN), TARGET :: VERTS(3*NVERTS) -LOGICAL, INTENT(IN) :: ABS_FLG + ! 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 -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. + ! Insertion add point to intersection list: + XP(IAXIS:JAXIS) = FVERT(IAXIS:JAXIS,IPF) + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) -DIFF_ANGLE = .FALSE. + ! 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 -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) + FVERT_IN_TRIANG(IPF,ITRI) = 1 -U1 = V2 - V1; -U2 = V3 - V2; + ENDIF + ENDDO -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) + ! 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 -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 + XJPLN = XJPLNS(JPL) -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. + DO IPT=1,NTVERT -RETURN + XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD1,IPT) ) + XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , TSEGS(NOD2,IPT) ) -END FUNCTION DIFF_ANGLE + ! 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 -! ---------------------------- POINT_IN_TRIANGLE_FB ---------------------------------------- + ! 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 + + ! Test if segment aligned with xi + XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) + IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. -LOGICAL FUNCTION POINT_IN_TRIANGLE_FB(P_FB,V1_FB,V2_FB,V3_FB) + ! Drop intersections in triangle segment nodes: already added. + ! Compute: dot(plnormal, xyzv - xypl): + DOT1 = XY1(XJAXIS) - XJPLN + DOT2 = XY2(XJAXIS) - XJPLN -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 ( ABS(DOT1) <= GEOMEPS ) CYCLE + IF ( ABS(DOT2) <= GEOMEPS ) CYCLE - 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) + ! 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 -END FUNCTION POINT_IN_TRIANGLE_FB + ! Intersection Point along segment: + DS = (XJPLN-XY1(XJAXIS))/(XY2(XJAXIS)-XY1(XJAXIS)) + SVARI = XY1(XIAXIS) + DS*(XY2(XIAXIS)-XY1(XIAXIS)) -! ---------------------------- POINT_IN_TRIANGLE ---------------------------------------- + OUTSEG= ((XIPLNS(LOW_IND)-SVARI) > -GEOMEPS) .OR. ((SVARI-XIPLNS(HIGH_IND)) > -GEOMEPS) + IF ( OUTSEG ) CYCLE -LOGICAL FUNCTION POINT_IN_TRIANGLE(P,V1,V2,V3) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT + ! Insertion add point to intersection list: + XP(XIAXIS) = SVARI + XP(XJAXIS) = XJPLN + CALL INSERT_POINT_2D(XP,NINTP,SIZE_X2X3VERT,X2X3VERT,INOD) -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 + ! 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 -! 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. + IF ( NINTP_TRI == 0 ) CYCLE -POINT_IN_TRIANGLE=.TRUE. ! start by assuming the point is inside + ! 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) -! compute face normal -E1 = V2-V1 -E2 = V3-V1 -CALL CROSS_PRODUCT(N,E1,E2) + 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 -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 + ! Reorder nodes: + TRINODS(1:NINTP_TRI) = TRINODS(II(1:NINTP_TRI)) -END FUNCTION POINT_IN_TRIANGLE + ! 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) /) -! ---------------------------- TRIANGULATE ---------------------------------------- + LOCTRI = BODINT_PLANE%INDTRI(1,ITRI) + LOCBOD = BODINT_PLANE%INDTRI(2,ITRI) -SUBROUTINE TRIANGULATE(DIR,VERTS,NVERTS,VERT_OFFSET,FACES,LOCTYPE) + DO IEDGE=1,NINTP_TRI -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) + IF ( EDGETRI(NOD1,IEDGE) == EDGETRI(NOD2,IEDGE) ) CYCLE -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 + ! Test if Edge already on list: + INLIST = .FALSE. + DO ISEG=1,NEDGE -INTEGER :: HIDEDGE(3), EDGEI(1:2), NVERTS2, NEDGES, COUNT -INTEGER, PARAMETER :: SHFT_NODE(1:4) = (/ 2, 1, 0, 2 /) + 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 -INTEGER :: COUNT_OUT + 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 -FLAG = .TRUE. + IF ( .NOT.INLIST ) THEN ! Edge not in list. + NEDGE = NEDGE + 1 + CEELEM(NOD1:NOD2,NEDGE) = EDGETRI(NOD1:NOD2,IEDGE) -! 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) + ! Here we have to figure out if segment belongs to a triangles side: + SEG_IN_SIDE = .FALSE. + DO IPT=1,NTVERT -! 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 + ! 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) ) -! Redo List: -NLIST = SUM(VERT_FLAG(1:NVERTS)) + ! Segment points: + XP1(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD1,NEDGE)) + XP2(IAXIS:JAXIS) = X2X3VERT(IAXIS:JAXIS,CEELEM(NOD2,NEDGE)) -IF (NLIST < 3) THEN - FACES(1:3*(NVERTS-2)) = VERT_OFFSET + 1 - LOCTYPE(1:NVERTS-2) = 4+8+16 - RETURN -ENDIF + 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) -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) + CROSSP1 = ABS(VECS(IAXIS)*VECP1(JAXIS)-VECS(JAXIS)*VECP1(IAXIS)) + CROSSP2 = ABS(VECS(IAXIS)*VECP2(JAXIS)-VECS(JAXIS)*VECP2(IAXIS)) -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. + IF ( (CROSSP1+CROSSP2) < GEOMEPS ) THEN + SEG_IN_SIDE = .TRUE. EXIT ENDIF ENDDO - ENDDO - LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) + 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 - 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 - ! 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 +! Now define cut-edges from solid-solid segments: +DO IWSSEG=1,BODINT_PLANE%NSEGS -! 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 + 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 - VERT_LIST(0) = VERT_LIST(NLIST) - VERT_LIST(NLIST+1) = VERT_LIST(1) - NODE_EXISTS(1:NLIST+1) = .TRUE. + ! 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 - ! 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 + ! 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 - IF (NLIST == 3) EXIT OUTER + ENDDO + IF ( TRUETHAT ) THEN ! new inod entry on list + NINTP_SEG = NINTP_SEG + 1 + SEGNODS(NINTP_SEG) = INOD 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 + + 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 + + DO JPL=LOW_IND,HIGH_IND + + XJPLN = XJPLNS(JPL) + + XY1(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD1) ) + XY2(IAXIS:JAXIS) = BODINT_PLANE%XYZ( (/ X2AXIS, X3AXIS /) , SEG(NOD2) ) + + ! 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 + + ! 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 + + ! Test if segment aligned with xi + XIALIGNED = ((MAXXJ-MINXJ) < GEOMEPS) + IF ( XIALIGNED ) CYCLE ! Aligned and on top of xjpln: Intersection points already added. + + ! Drop intersections in EDGE 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 + + ! Finally regular case: + ! Points 1 on one side of x2 segment, point 2 on the other: + 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 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 - 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. + IF ( (NINTP_SEG < 2) .OR. (SEGNODS(NOD1) == SEGNODS(NOD2)) ) CYCLE + + ! 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 - ENDDO + ENDIF ENDDO - LOCTYPE(IFACE) = 4 * HIDEDGE(1) + 8 * HIDEDGE(2) + 16 * HIDEDGE(3) + + 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 +! 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. + +DEALLOCATE(FVERT_IN_TRIANG, TRIVERT_IN_FACE) + RETURN -END SUBROUTINE TRIANGULATE +END SUBROUTINE GET_TRIANG_FACE_INT -! ! ---------------------------- 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 -! +! ------------------------- INSERT_POINT_2D ------------------------------------- -! ---------------------------- RAY_TRIANGLE_INTERSECT_PT ---------------------------------------- +SUBROUTINE INSERT_POINT_2D(XP,NVERT,SIZE_XYVERT,XYVERT,INOD) -SUBROUTINE RAY_TRIANGLE_INTERSECT_PT(V1,V2,V3,XP,D,IS_INTERSECT,POS) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT +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 -! 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. +! Local Variables: +LOGICAL :: INLIST +REAL(EB):: DV(IAXIS:JAXIS), DVNORM +REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: XYVERT_AUX -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) +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 -REAL(EB) :: E1(3),E2(3),P(3),S(3),Q(3),U,V,TMP,T -REAL(EB), PARAMETER :: EPS=1.E-10_EB +RETURN +END SUBROUTINE INSERT_POINT_2D -! Schneider and Eberly, Section 11.1 -IS_INTERSECT = .FALSE. -POS(1:3) = 1._EB/TWENTY_EPSILON_EB +! ----------------------- DEALLOCATE_BODINT_PLANE ------------------------------ -E1 = V2-V1 -E2 = V3-V1 +SUBROUTINE DEALLOCATE_BODINT_PLANE(BODINT_PLANE) -CALL CROSS_PRODUCT(P,D,E2) +TYPE(BODINT_PLANE_TYPE), INTENT(INOUT) :: BODINT_PLANE -TMP = DOT_PRODUCT(P,E1) +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) -IF ( ABS(TMP)(1._EB+EPS)) RETURN ! No intersection. +SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH_WORK(FIRST_CALL_ARG,FIRST_CALL_ARG2) -CALL CROSS_PRODUCT(Q,S,E1) -V = TMP*DOT_PRODUCT(D,Q) -IF (V<-EPS .OR. (U+V)>(1._EB+EPS)) RETURN ! No intersection. +LOGICAL, INTENT(INOUT) :: FIRST_CALL_ARG, FIRST_CALL_ARG2 -T = TMP*DOT_PRODUCT(E2,Q) -IF (T <= 0._EB) RETURN ! No intersection. +! 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 -IS_INTERSECT = .TRUE. -POS = XP + T*D ! the intersection point +! 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)) -RETURN -END SUBROUTINE RAY_TRIANGLE_INTERSECT_PT +END SUBROUTINE CC_GRID_ALLOCATE_BUILD_SCRATCH_WORK -! ---------------------------- TRILINEAR ---------------------------------------- -REAL(EB) FUNCTION TRILINEAR(UU,DXI,LL) +SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH_WORK -REAL(EB), INTENT(IN) :: UU(0:1,0:1,0:1),DXI(3),LL(3) -REAL(EB) :: XX,YY,ZZ +CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE) +CALL DEALLOCATE_BODINT_PLANE(BODINT_PLANE2) -! 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) -! -!=========================================================== +! 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) -XX = DXI(1)/LL(1) -YY = DXI(2)/LL(2) -ZZ = DXI(3)/LL(3) +END SUBROUTINE CC_GRID_RELEASE_BUILD_SCRATCH_WORK + + +SUBROUTINE CC_GRID_ALLOCATE_CELLRT(ISTR,IEND,JSTR,JEND,KSTR,KEND) + +INTEGER, INTENT(IN) :: ISTR, IEND, JSTR, JEND, KSTR, KEND + +IF (ALLOCATED(CELLRT)) DEALLOCATE(CELLRT) +ALLOCATE(CELLRT(ISTR:IEND,JSTR:JEND,KSTR:KEND)) +CELLRT(:,:,:) = .FALSE. + +END SUBROUTINE CC_GRID_ALLOCATE_CELLRT + + +SUBROUTINE CC_GRID_RELEASE_CELLRT + +IF (ALLOCATED(CELLRT)) DEALLOCATE(CELLRT) + +END SUBROUTINE CC_GRID_RELEASE_CELLRT + + +SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH_WORK(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,GEOM_ZMAX_AUX) +USE TRAN, ONLY : TRANS + +INTEGER, INTENT(IN) :: NM, ISTR, IEND, JSTR, JEND, KSTR, KEND +REAL(EB), ALLOCATABLE, INTENT(INOUT), DIMENSION(:,:) :: GEOM_ZMAX_AUX + +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' /) + +CALL POINT_TO_MESH(NM) +M => MESHES(NM) + +! Mesh sizes: +NXB=IBAR +NYB=JBAR +NZB=KBAR + +! Do Loop for different x1 planes: +X1AXIS_LOOP : DO X1AXIS=IAXIS,KAXIS -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 + SELECT CASE(X1AXIS) + CASE(IAXIS) -END FUNCTION TRILINEAR + 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 -! ---------------------------- GETU ---------------------------------------- + END SELECT -SUBROUTINE GETU(U_DATA,DXI,XI_IN,I_VEL,NM) + ! 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)); -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) + ! Stretched grid vars: + X1NOC=TRANS(NM)%NOC(X1AXIS) + X2NOC=TRANS(NM)%NOC(X2AXIS) + X3NOC=TRANS(NM)%NOC(X3AXIS) -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 + 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 -!II = INDU(1) -!JJ = INDU(2) -!KK = INDU(3) -! -!IF (XI(1) 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 -SELECT CASE(I_VEL) - CASE(1) - U_DATA(0,0,0) = UU(II,JJ,KK) - U_DATA(1,0,0) = UU(II+1,JJ,KK) - U_DATA(0,1,0) = UU(II,JJ+1,KK) - U_DATA(0,0,1) = UU(II,JJ,KK+1) - U_DATA(1,0,1) = UU(II+1,JJ,KK+1) - U_DATA(0,1,1) = UU(II,JJ+1,KK+1) - U_DATA(1,1,0) = UU(II+1,JJ+1,KK) - U_DATA(1,1,1) = UU(II+1,JJ+1,KK+1) - CASE(2) - U_DATA(0,0,0) = VV(II,JJ,KK) - U_DATA(1,0,0) = VV(II+1,JJ,KK) - U_DATA(0,1,0) = VV(II,JJ+1,KK) - U_DATA(0,0,1) = VV(II,JJ,KK+1) - U_DATA(1,0,1) = VV(II+1,JJ,KK+1) - U_DATA(0,1,1) = VV(II,JJ+1,KK+1) - U_DATA(1,1,0) = VV(II+1,JJ+1,KK) - U_DATA(1,1,1) = VV(II+1,JJ+1,KK+1) - CASE(3) - U_DATA(0,0,0) = WW(II,JJ,KK) - U_DATA(1,0,0) = WW(II+1,JJ,KK) - U_DATA(0,1,0) = WW(II,JJ+1,KK) - U_DATA(0,0,1) = WW(II,JJ,KK+1) - U_DATA(1,0,1) = WW(II+1,JJ,KK+1) - U_DATA(0,1,1) = WW(II,JJ+1,KK+1) - U_DATA(1,1,0) = WW(II+1,JJ+1,KK) - U_DATA(1,1,1) = WW(II+1,JJ+1,KK+1) - CASE(4) ! viscosity - U_DATA(0,0,0) = M%MU(II,JJ,KK) - U_DATA(1,0,0) = M%MU(II+1,JJ,KK) - U_DATA(0,1,0) = M%MU(II,JJ+1,KK) - U_DATA(0,0,1) = M%MU(II,JJ,KK+1) - U_DATA(1,0,1) = M%MU(II+1,JJ,KK+1) - U_DATA(0,1,1) = M%MU(II,JJ+1,KK+1) - U_DATA(1,1,0) = M%MU(II+1,JJ+1,KK) - U_DATA(1,1,1) = M%MU(II+1,JJ+1,KK+1) -END SELECT + ! x3 location of ray along x2, on the x2-x3 plane: + X3RAY = X3FACE(KK) -END SUBROUTINE GETU + ! 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 -! ! ---------------------------- TRI_PLANE_BOX_INTERSECT ---------------------------------------- -! -! SUBROUTINE TRI_PLANE_BOX_INTERSECT(NP,PC,V1,V2,V3,BB) -! USE MATH_FUNCTIONS -! ! get the intersection points (cooridnates) of the BB's 12 edges and the plane of the trianlge -! ! regular intersection polygons with 0, 3, 4, 5, or 6 corners -! ! irregular intersection case (corner, edge, or face intersection) should also be ok. -! -! INTEGER, INTENT(OUT) :: NP -! REAL(EB), INTENT(OUT) :: PC(18) ! max 6 points but maybe repeated at the vertices -! REAL(EB), INTENT(IN) :: V1(3),V2(3),V3(3),BB(6) -! REAL(EB) :: P0(3),P1(3),Q(3),PC_TMP(60) -! INTEGER :: I,J,IERR,IERR2 -! -! NP = 0 -! EDGE_LOOP: DO I=1,12 -! SELECT CASE(I) -! CASE(1) -! P0(1)=BB(1) -! P0(2)=BB(3) -! P0(3)=BB(5) -! P1(1)=BB(2) -! P1(2)=BB(3) -! P1(3)=BB(5) -! CASE(2) -! P0(1)=BB(2) -! P0(2)=BB(3) -! P0(3)=BB(5) -! P1(1)=BB(2) -! P1(2)=BB(4) -! P1(3)=BB(5) -! CASE(3) -! P0(1)=BB(2) -! P0(2)=BB(4) -! P0(3)=BB(5) -! P1(1)=BB(1) -! P1(2)=BB(4) -! P1(3)=BB(5) -! CASE(4) -! P0(1)=BB(1) -! P0(2)=BB(4) -! P0(3)=BB(5) -! P1(1)=BB(1) -! P1(2)=BB(3) -! P1(3)=BB(5) -! CASE(5) -! P0(1)=BB(1) -! P0(2)=BB(3) -! P0(3)=BB(6) -! P1(1)=BB(2) -! P1(2)=BB(3) -! P1(3)=BB(6) -! CASE(6) -! P0(1)=BB(2) -! P0(2)=BB(3) -! P0(3)=BB(6) -! P1(1)=BB(2) -! P1(2)=BB(4) -! P1(3)=BB(6) -! CASE(7) -! P0(1)=BB(2) -! P0(2)=BB(4) -! P0(3)=BB(6) -! P1(1)=BB(1) -! P1(2)=BB(4) -! P1(3)=BB(6) -! CASE(8) -! P0(1)=BB(1) -! P0(2)=BB(4) -! P0(3)=BB(6) -! P1(1)=BB(1) -! P1(2)=BB(3) -! P1(3)=BB(6) -! CASE(9) -! P0(1)=BB(1) -! P0(2)=BB(3) -! P0(3)=BB(5) -! P1(1)=BB(1) -! P1(2)=BB(3) -! P1(3)=BB(6) -! CASE(10) -! P0(1)=BB(2) -! P0(2)=BB(3) -! P0(3)=BB(5) -! P1(1)=BB(2) -! P1(2)=BB(3) -! P1(3)=BB(6) -! CASE(11) -! P0(1)=BB(2) -! P0(2)=BB(4) -! P0(3)=BB(5) -! P1(1)=BB(2) -! P1(2)=BB(4) -! P1(3)=BB(6) -! CASE(12) -! P0(1)=BB(1) -! P0(2)=BB(4) -! P0(3)=BB(5) -! P1(1)=BB(1) -! P1(2)=BB(4) -! P1(3)=BB(6) -! END SELECT -! CALL LINE_SEG_TRI_PLANE_INTERSECT(IERR,IERR2,Q,V1,V2,V3,P0,P1) -! -! IF (IERR==1) THEN -! NP=NP+1 -! DO J=1,3 -! PC_TMP((NP-1)*3+J)=Q(J) -! ENDDO -! ENDIF -! ENDDO EDGE_LOOP -! -! ! For more than 3 intersection points -! ! they have to be sorted in order to create a convex polygon -! CALL ELIMATE_REPEATED_POINTS(NP,PC_TMP) -! IF ( NP > 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 + ! 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 -! ! ---------------------------- 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 +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 -! ! ---------------------------- 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 +! Now Define the INBOUNDARY cut-edge inside Cartesian cells: +CALL GET_CARTCELL_CUTEDGES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) -! ! ---------------------------- 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 +! 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.) -! ---------------------------- POINT_IN_BB ---------------------------------------- +! 2. INBOUNDARY cut-faces: +CALL GET_CARTCELL_CUTFACES(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND,.TRUE.) -LOGICAL FUNCTION POINT_IN_BB(V1,BB) +! 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.) -REAL(EB), INTENT(IN) :: V1(3),BB(6) +! Finally: Definition of cut-cells: +CELLRT = .FALSE. +MESHES(NM)%N_SPCELL_CF = MESHES(NM)%N_SPCELL +CALL GET_CARTCELL_CUTCELLS(NM) -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 +END SUBROUTINE CC_GRID_BUILD_CUTCELL_MESH_WORK -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 +SUBROUTINE CC_GRID_GET_REGULAR_CUTCELLS_BOX(NM,ISTR,IEND,JSTR,JEND,KSTR,KEND) -! ---------------------------- POLYGON_AREA ---------------------------------------- +INTEGER, INTENT(IN) :: NM, ISTR, IEND, JSTR, JEND, KSTR, KEND -REAL(EB) FUNCTION POLYGON_AREA(NP,PC) -! Calculate the area of a polygon +! 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 +INTEGER :: I,J,K,X1AXIS,X2AXIS,X3AXIS,XIAXIS,XJAXIS,XKAXIS,IFACE,ICF,NCELL -INTEGER, INTENT(IN) :: NP -REAL(EB), INTENT(IN) :: PC(60) -INTEGER :: I,K -REAL(EB) :: V1(3),V2(3),V3(3) +CALL POINT_TO_MESH(NM) +M => MESHES(NM) -POLYGON_AREA = 0._EB -V3 = POLYGON_CENTROID(NP,PC) +! 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 -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) +! 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 - ELSE - DO K=1,3 - V1(K) = PC((I-1)*3+K) - V2(K) = PC(K) + 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 - ENDIF - POLYGON_AREA = POLYGON_AREA+TRIANGLE_AREA(V1,V2,V3) + ENDDO ENDDO -RETURN -END FUNCTION POLYGON_AREA +! 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 -! ---------------------------- POLYGON_CENTROID ---------------------------------------- + ! 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 + + ! 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 -REAL(EB) FUNCTION POLYGON_CENTROID(NP,PC) -! Calculate the centroid of polygon vertices + ! 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 -DIMENSION :: POLYGON_CENTROID(3) -INTEGER, INTENT(IN) :: NP -REAL(EB), INTENT(IN) :: PC(60) -INTEGER :: I,K + ! 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 -POLYGON_CENTROID = 0._EB -DO I=1,NP - DO K=1,3 - POLYGON_CENTROID(K) = POLYGON_CENTROID(K)+PC((I-1)*3+K)/NP + ! 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 -RETURN -END FUNCTION POLYGON_CENTROID +! 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 -! ---------------------------- INTERSECT_SPHERE_AABB ---------------------------------------- + ! 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 -! Algorithm from Schneider and Eberly, p. 644 -! Intersection of Sphere and Axis-Aligned Bounding Box + ! 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 -LOGICAL FUNCTION INTERSECT_SPHERE_AABB(X0,RADIUS,XB) + ! 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 -REAL(EB), INTENT(IN) :: X0(3),RADIUS,XB(6) -REAL(EB) :: DIST_SQUARED +! 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 -INTERSECT_SPHERE_AABB=.TRUE. + ! 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 -! 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 + IBNDINT_LOOP : DO IBNDINT=BNDINT_LOW,BNDINT_HIGH ! 1,2 refers to block boundary faces, 3 to internal faces, + ! 4 guard-cell faces. -! Compare squared distance to radius squared -IF (DIST_SQUARED > (RADIUS*RADIUS-TWENTY_EPSILON_EB)) INTERSECT_SPHERE_AABB=.FALSE. + ! 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 FUNCTION INTERSECT_SPHERE_AABB + 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 -! ---------------------------- INTERSECT_CYLINDER_AABB ---------------------------------------- + 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 -! 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 + 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 -LOGICAL FUNCTION INTERSECT_CYLINDER_AABB(X_IN,H,RADIUS,ROTMAT,XB) + END SELECT -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 + ! 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 -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 + ! 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) -! 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 + ! 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) /) -RETURN -END FUNCTION INTERSECT_CYLINDER_AABB + CFELEM(1:5,1) = (/ 4, NOD1, NOD2, NOD3, NOD4 /) -! ---------------------------- ROTATION_MATRIX ---------------------------------------- + ! Area: + AREA(1) = (X2FACE(INDXI2(JAXIS))-X2FACE(INDXI1(JAXIS)))*(X3FACE(INDXI4(KAXIS))-X3FACE(INDXI1(KAXIS))) -SUBROUTINE ROTATION_MATRIX(R_OUT,A_IN,THETA) -USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT + ! 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))) /) -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) + ! 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) -! 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 + ! 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 -! initialize R_OUT as 2D rotation matrix -R_OUT = R_THETA + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -! normalize input vector -DENOM = SQRT(DOT_PRODUCT(A_IN,A_IN)) -IF (DENOM MESHES(NM)%CUT_FACE(NCUTFACE) + CF%XYZVERT(IAXIS:KAXIS,1:NVERT) = XYZVERT(IAXIS:KAXIS,1:NVERT) -! orthonormal basis in new system -B1 = (/1._EB,0._EB,0._EB/) -B2 = (/0._EB,1._EB,0._EB/) -B3 = (/0._EB,0._EB,1._EB/) + ! 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) -CALL CROSS_PRODUCT(V,A,B3) -C = DOT_PRODUCT(A,B3) + ! 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 (DOT_PRODUCT(V,V)0._EB) THEN - RETURN + ENDDO + ENDDO + ENDDO + DEALLOCATE(X1FACE,X2FACE,X3FACE) + ENDDO X1AXIS_LOOP + ENDDO IBNDINT_LOOP + + 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 - R_OUT = -R_OUT - RETURN + 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 -ENDIF - -! find orthnormal basis for A=A3 in old system -A3 = A -CALL CROSS_PRODUCT(A2,B3,A3) -CALL CROSS_PRODUCT(A1,A2,A3) + ! Loop on Cartesian cells: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -! rotation matrix (direction cosines), Pope (2000), Eq. (A.11) + IF ( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE -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) + IF(IJK_COUNTED2(I,J,K)) CYCLE; IJK_COUNTED2(I,J,K)=.TRUE. -R_OUT = MATMUL(R_OUT,R_THETA) + ! 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) -! ! test -! print *,R_OUT(1,:) -! print *,R_OUT(2,:) -! print *,R_OUT(3,:) -! print *,MATMUL(R_OUT,A) ! result should be B3 -! stop + IF ( ALL(FSID_XYZ(LOW_IND:HIGH_IND,IAXIS:KAXIS) /= CC_SOLID) ) CYCLE -END SUBROUTINE ROTATION_MATRIX + 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) -! ---------------------------- INTERSECT_CONE_AABB ---------------------------------------- + ! 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) -! This routine basically follows the INTERSECT_CYLINDER_AABB algorithm, with radius = R(Z) + ! Define IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I-2+LOHI,J,K,X1AXIS) + CASE(JAXIS) -LOGICAL FUNCTION INTERSECT_CONE_AABB(X_IN,H,RADIUS,ROTMAT,XB) + ! 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) -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 IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I,J-2+LOHI,K,X1AXIS) + CASE(KAXIS) -INTERSECT_CONE_AABB=.FALSE. + ! 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) -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 + ! Define IBOD and ITRI: + IBOD(NFACE) = GEOMFACE(I,J,K-2+LOHI,X1AXIS) + END SELECT -! 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 + ! 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 -RETURN -END FUNCTION INTERSECT_CONE_AABB + NVERT = NVERT + 4 -! ---------------------------- INTERSECT_OBB_AABB ---------------------------------------- + ENDDO LOHI_DO + ENDDO X1AXIS_LOOP2 -! Intersect an Oriented Bounding Box (OBB) with an Axis-Aligned Bounding Box (AABB) -! First, rotate AABB into OBB frame. -! Then test each vertex. -LOGICAL FUNCTION INTERSECT_OBB_AABB(X_IN,L,W,H,ROTMAT,XB) + ! 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(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 + CALL CUT_FACE_ARRAY_REALLOC(NM,NCUTFACE) -INTERSECT_OBB_AABB=.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) -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 + CF%AREA(1:NFACE) = AREA(1:NFACE) + CF%XYZCEN(IAXIS:KAXIS,1:NFACE) = XYZCEN(IAXIS:KAXIS,1:NFACE) -! 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) (RADIUS*RADIUS+TWENTY_EPSILON_EB)) IN_SPHERE_PT=.FALSE. -END FUNCTION IN_SPHERE_PT + ! Loop on Cartesian cells, define cut cells and solid cells CC_CGSC: + DO K=KLO,KHI + DO J=JLO,JHI + DO I=ILO,IHI -! ---------------------------- IN_CYLINDER_PT ---------------------------------------- + IF( MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_CUTCFE ) CYCLE -LOGICAL FUNCTION IN_CYLINDER_PT(X_IN,H,RADIUS,ROTMAT,XP) + IF( IJK_COUNT(I,J,K) ) CYCLE; IJK_COUNT(I,J,K) = .TRUE. -REAL(EB), INTENT(IN) :: X_IN(3),H,RADIUS,ROTMAT(3,3),XP(3) -REAL(EB) :: X(3),U(3),DUX(2),R2,DIST_SQUARED + ! 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) -IN_CYLINDER_PT=.FALSE. -X = MATMUL(ROTMAT,X_IN) ! transform center -R2 = RADIUS*RADIUS -U = MATMUL(ROTMAT,XP) -IF (U(3)>X(3)-TWENTY_EPSILON_EB .AND. U(3) 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 -REAL(EB), INTENT(IN) :: X_IN(3),H,RADIUS,ROTMAT(3,3),XP(3) -REAL(EB) :: X(3),U(3),DUX(2),Z0,ZH,DIST_SQUARED,R_Z + VOL(1) = DXCELL(I)*DYCELL(J)*DZCELL(K) + XYZCEN(IAXIS:KAXIS,1) = (/ XCELL(I), YCELL(J), ZCELL(K) /) -IN_CONE_PT=.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 -U = MATMUL(ROTMAT,XP) -IF (U(3)>Z0-TWENTY_EPSILON_EB .AND. U(3)X(1)+0.5_EB*L+TWENTY_EPSILON_EB) RETURN -IF (U(2)X(2)+0.5_EB*W+TWENTY_EPSILON_EB) RETURN -IF (U(3)X(3)+0.5_EB*H+TWENTY_EPSILON_EB) RETURN -IN_OBB_PT = .TRUE. + ENDDO + ENDDO + ENDDO -END FUNCTION IN_OBB_PT + IF(INTGC_FLG==HIGH_IND) DEALLOCATE( IJK_COUNT ) +ENDDO INTGC_FLG_LOOP2 + + +DEALLOCATE(GEOMFACE,GEOMCELL) + +END SUBROUTINE CC_GRID_GET_REGULAR_CUTCELLS_BOX -! ! ---------------------------- 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 ---------------------------------------- +SUBROUTINE GET_CFACE_INDEX(NM,I,J,K,XPT,YPT,ZPT,ICF) -! for each node, compute the average values of faces connected to that node +INTEGER, INTENT(IN) :: NM,I,J,K +REAL(EB),INTENT(IN) :: XPT,YPT,ZPT +INTEGER, INTENT(OUT):: ICF -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) +! 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 -INTEGER, DIMENSION(:), POINTER :: V -INTEGER :: I -INTEGER :: COUNT(NVERTS) +ICF = 0 +IF(.NOT.ALLOCATED(MESHES(NM)%CCVAR)) RETURN ! Case of NO GEOMs, return and give an error. -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 +ILO = MAX(I-DELTA_IJK,1) +IHI = MIN(I+DELTA_IJK,MESHES(NM)%IBAR) -END SUBROUTINE AVERAGE_FACE_VALUES +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) -! ---------------------------- MAKE_UNIQUE_VERT_ARRAY ---------------------------------------- +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 -! construct an array that points to first vertex in a vertex array when one or more vertices are identical +END SUBROUTINE GET_CFACE_INDEX -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 +SUBROUTINE RANDOM_CFACE_XYZ(NM,CFA,CFA_X,CFA_Y,CFA_Z) -DO I = 1, NVERTS - PERM(I) = I - VERT_UNIQUE(I) = I -ENDDO -CALL MAKE_PERMUTATION_ARRAY(VERTS, PERM, NVERTS, 1, NVERTS) +INTEGER, INTENT(IN) :: NM +TYPE(CFACE_TYPE), INTENT(IN) :: CFA +REAL(EB), INTENT(OUT) :: CFA_X,CFA_Y,CFA_Z -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 +! 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 -END SUBROUTINE MAKE_UNIQUE_VERT_ARRAY +IND1 = CFA%CUT_FACE_IND1 +IND2 = CFA%CUT_FACE_IND2 +BC => MESHES(NM)%BOUNDARY_COORD(CFA%BC_INDEX) -! ---------------------------- COMPARE_VERTS ---------------------------------------- +! 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) -! returns -1, 0, 1 when a vertex I is less than, the same or greater than vertex J +! 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) -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 + ! 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 /) -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 + 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 -! ---------------------------- MAKE_PERMUTATION_ARRAY ---------------------------------------- +! 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 -! 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 +! 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) -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 RANDOM_CFACE_XYZ -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 POINT_IN_CFACE(NM,XP,YP,ZP,CFACE_INDEX,IN_CFACE) -! FIRST .... LAST original list -! FIRST ... MID first half of list -! MID+1 ... LAST 2nd half of list +REAL(EB), INTENT(IN) :: XP,YP,ZP +INTEGER, INTENT(IN) :: NM,CFACE_INDEX +LOGICAL, INTENT(OUT) :: IN_CFACE -MID = (FIRST + LAST)/2 +! 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 -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 +CFA => MESHES(NM)%CFACE(CFACE_INDEX) +INBFC = CFA%CUT_FACE_IND1 +INBFC_LOC = CFA%CUT_FACE_IND2 -! 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 +! 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) - 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 +! 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) - 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 +! 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 /) ) -END SUBROUTINE MAKE_PERMUTATION_ARRAY +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) -END MODULE COMPLEX_GEOMETRY +DEALLOCATE(CFELEM) + +END SUBROUTINE POINT_IN_CFACE + +END MODULE COMPLEX_GEOMETRY_GRID diff --git a/Source/init.f90 b/Source/init.f90 index 78b5ad2485..6bcd5fafba 100644 --- a/Source/init.f90 +++ b/Source/init.f90 @@ -2579,7 +2579,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/main.f90 b/Source/main.f90 index 5515572364..2c887041f4 100644 --- a/Source/main.f90 +++ b/Source/main.f90 @@ -39,7 +39,7 @@ PROGRAM FDS CCCOMPUTE_RADIATION,CC_NO_FLUX,CC_COMPUTE_VELOCITY_ERROR, & CC_NO_FLUX,CC_COMPUTE_VELOCITY_ERROR,FINISH_CC, & INIT_CUTCELL_DATA,MESH_CC_EXCHANGE,ROTATED_CUBE_ANN_SOLN, & - CC_RESTORE_UVW_UNLINKED + CC_RESTORE_UVW_UNLINKED,INITIALIZE_BACK_CFACE_EXCHANGE USE OPENMP_FDS #ifdef WITHOUT_MPIF08 USE MPI @@ -60,7 +60,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 @@ -324,6 +324,11 @@ PROGRAM FDS IF (MY_RANK==0 .AND. VERBOSE) CALL VERBOSE_PRINTOUT('Completed INITIALIZE_BACK_WALL_EXCHANGE') +IF (CC_IBM) THEN + CALL INITIALIZE_BACK_CFACE_EXCHANGE + IF (MY_RANK==0 .AND. VERBOSE) CALL VERBOSE_PRINTOUT('Completed INITIALIZE_BACK_CFACE_EXCHANGE') +ENDIF + CALL STOP_CHECK(1) ! Initialize turb arrays @@ -647,18 +652,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 @@ -685,11 +700,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. @@ -1155,6 +1172,8 @@ PROGRAM FDS IF (T>=T_END .AND. ICYC>0) EXIT MAIN_LOOP + FIRST_RESTART_TIME_STEP = .FALSE. + ENDDO MAIN_LOOP #ifdef WITH_HDF5 @@ -3729,7 +3748,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 @@ -3740,7 +3759,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 diff --git a/Source/mesh.f90 b/Source/mesh.f90 index 2a4fd4d4e6..18f2bce9c6 100644 --- a/Source/mesh.f90 +++ b/Source/mesh.f90 @@ -247,6 +247,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 @@ -267,6 +269,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 @@ -439,6 +443,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 @@ -792,6 +797,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/part.f90 b/Source/part.f90 index 7793231c80..e763b11584 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 @@ -1824,7 +1824,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 diff --git a/Source/pres.f90 b/Source/pres.f90 index fce877bae9..ef17195ac6 100644 --- a/Source/pres.f90 +++ b/Source/pres.f90 @@ -3136,7 +3136,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, CC_IDCC, & - 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 @@ -3170,7 +3170,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. @@ -3875,9 +3879,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: diff --git a/Source/read.f90 b/Source/read.f90 index 4caedacbc0..cb511c3c7e 100644 --- a/Source/read.f90 +++ b/Source/read.f90 @@ -14017,11 +14017,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) \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 diff --git a/Source/wall.f90 b/Source/wall.f90 index 9851191777..926bcd6f41 100644 --- a/Source/wall.f90 +++ b/Source/wall.f90 @@ -1950,15 +1950,15 @@ SUBROUTINE SOLID_HEAT_TRANSFER(NM,T,DT_BC,PARTICLE_INDEX,WALL_INDEX,CFACE_INDEX, ELSE Q_LIQUID_F = B1%Q_CONDENSE ENDIF - IF (BACK_INDEX>0 .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 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 75b8766794..7ff9dbd9f9 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 14cc2bb39c..c19c0c7bc3 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 af2e41b183..c3a6a75b93 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 c98fd1c041..27439aa2fc 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 97fa7e39c0..9f5de603b9 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 878de46527..7ba506a336 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 a234dd4a85..2324def239 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 b09aa6b939..df46f0109f 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 2647820c12..4b89aabce3 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 9b4345431e..4e98f214c8 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 162aaf1d8c..b5d1334800 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 13d124f78a..3ceb865b07 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 4380343f21..6664427f9c 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 64cb0f1d07..b80bc7cee3 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 c366bdab0a..56e4c61dbb 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 3c1fe35fc3..659afed551 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 daef99fa2c..7c2b5aaa89 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 3b5c3d533c..c034125bf7 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 820896ff2b..5b79e3018d 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 093fb00e95..5292a07fb4 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 7c9ed91bbf..0ddd286d80 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/