Skip to content

Commit 2f23462

Browse files
committed
FDS Source : Clean PRES_ON_WHOLE_DOMAIN, ccib.f90.
1 parent 5c8ba22 commit 2f23462

File tree

2 files changed

+38
-193
lines changed

2 files changed

+38
-193
lines changed

Source/ccib.f90

Lines changed: 36 additions & 191 deletions
Original file line numberDiff line numberDiff line change
@@ -2469,29 +2469,9 @@ SUBROUTINE CC_PROJECT_VELOCITY(NM,DT,STORE_FLG)
24692469
END SELECT
24702470
ENDDO WALL_CELL_LOOP_1
24712471

2472-
IF(.NOT.PRES_ON_WHOLE_DOMAIN) THEN
2473-
DO K=1,KBAR
2474-
DO J=1,JBAR
2475-
DO I=0,IBAR
2476-
IF(FCVAR(I,J,K,CC_FGSC,IAXIS)==CC_SOLID) US(I,J,K) = 0._EB
2477-
ENDDO
2478-
ENDDO
2479-
ENDDO
2480-
DO K=1,KBAR
2481-
DO J=0,JBAR
2482-
DO I=1,IBAR
2483-
IF(FCVAR(I,J,K,CC_FGSC,JAXIS)==CC_SOLID) VS(I,J,K) = 0._EB
2484-
ENDDO
2485-
ENDDO
2486-
ENDDO
2487-
DO K=0,KBAR
2488-
DO J=1,JBAR
2489-
DO I=1,IBAR
2490-
IF(FCVAR(I,J,K,CC_FGSC,KAXIS)==CC_SOLID) WS(I,J,K) = 0._EB
2491-
ENDDO
2492-
ENDDO
2493-
ENDDO
2494-
ENDIF
2472+
WHERE(FCVAR(0:IBAR,1:JBAR,1:KBAR,CC_FGSC,IAXIS)==CC_SOLID) US(0:IBAR,1:JBAR,1:KBAR) = 0._EB
2473+
WHERE(FCVAR(1:IBAR,0:JBAR,1:KBAR,CC_FGSC,JAXIS)==CC_SOLID) VS(1:IBAR,0:JBAR,1:KBAR) = 0._EB
2474+
WHERE(FCVAR(1:IBAR,1:JBAR,0:KBAR,CC_FGSC,KAXIS)==CC_SOLID) WS(1:IBAR,1:JBAR,0:KBAR) = 0._EB
24952475

24962476
ELSE PRED_CORR_IF
24972477

@@ -2631,29 +2611,9 @@ SUBROUTINE CC_PROJECT_VELOCITY(NM,DT,STORE_FLG)
26312611

26322612
DEALLOCATE(U_STORE,V_STORE,W_STORE)
26332613

2634-
IF(.NOT.PRES_ON_WHOLE_DOMAIN) THEN
2635-
DO K=1,KBAR
2636-
DO J=1,JBAR
2637-
DO I=0,IBAR
2638-
IF(FCVAR(I,J,K,CC_FGSC,IAXIS)==CC_SOLID) U(I,J,K) = 0._EB
2639-
ENDDO
2640-
ENDDO
2641-
ENDDO
2642-
DO K=1,KBAR
2643-
DO J=0,JBAR
2644-
DO I=1,IBAR
2645-
IF(FCVAR(I,J,K,CC_FGSC,JAXIS)==CC_SOLID) V(I,J,K) = 0._EB
2646-
ENDDO
2647-
ENDDO
2648-
ENDDO
2649-
DO K=0,KBAR
2650-
DO J=1,JBAR
2651-
DO I=1,IBAR
2652-
IF(FCVAR(I,J,K,CC_FGSC,KAXIS)==CC_SOLID) W(I,J,K) = 0._EB
2653-
ENDDO
2654-
ENDDO
2655-
ENDDO
2656-
ENDIF
2614+
WHERE(FCVAR(0:IBAR,1:JBAR,1:KBAR,CC_FGSC,IAXIS)==CC_SOLID) U(0:IBAR,1:JBAR,1:KBAR) = 0._EB
2615+
WHERE(FCVAR(1:IBAR,0:JBAR,1:KBAR,CC_FGSC,JAXIS)==CC_SOLID) V(1:IBAR,0:JBAR,1:KBAR) = 0._EB
2616+
WHERE(FCVAR(1:IBAR,1:JBAR,0:KBAR,CC_FGSC,KAXIS)==CC_SOLID) W(1:IBAR,1:JBAR,0:KBAR) = 0._EB
26572617

26582618
ENDIF PRED_CORR_IF
26592619

@@ -6810,7 +6770,7 @@ SUBROUTINE CC_H_INTERP
68106770
! Local Variables:
68116771
REAL(EB), POINTER, DIMENSION(:,:,:) :: UP,VP,WP,HP
68126772
INTEGER :: NM, ICC, NCELL, I, J ,K
6813-
REAL(EB):: U_IBM, V_IBM, W_IBM, VCRT
6773+
REAL(EB):: VCRT
68146774
LOGICAL :: VOLFLG
68156775

68166776
! This routine interpolates H to cut cells/Cartesian cells at the end of step.
@@ -6866,52 +6826,12 @@ SUBROUTINE CC_H_INTERP
68666826
ENDDO ICC_LOOP
68676827

68686828
! Finally set HP to zero inside immersed solids:
6869-
IF (.NOT.PRES_ON_WHOLE_DOMAIN) THEN
6870-
DO K=0,KBP1
6871-
DO J=0,JBP1
6872-
DO I=0,IBP1
6873-
IF (MESHES(NM)%CCVAR(I,J,K,CC_CGSC) /= CC_SOLID) CYCLE
6874-
HP(I,J,K) = 0._EB
6875-
ENDDO
6876-
ENDDO
6877-
ENDDO
6878-
ENDIF
6879-
6880-
! In case of .NOT. PRES_ON_WHOLE_DOMAIN set velocities on solid faces to zero:
6881-
IF (.NOT.PRES_ON_WHOLE_DOMAIN) THEN
6882-
! Force U velocities in CC_SOLID faces to zero
6883-
U_IBM = 0._EB ! Body doesn't move.
6884-
DO K=1,KBAR
6885-
DO J=1,JBAR
6886-
DO I=0,IBAR
6887-
IF (MESHES(NM)%FCVAR(I,J,K,CC_FGSC,IAXIS) /= CC_SOLID ) CYCLE
6888-
UP(I,J,K) = U_IBM
6889-
ENDDO
6890-
ENDDO
6891-
ENDDO
6892-
6893-
! Force V velocities in CC_SOLID faces to zero
6894-
V_IBM = 0._EB ! Body doesn't move.
6895-
DO K=1,KBAR
6896-
DO J=0,JBAR
6897-
DO I=1,IBAR
6898-
IF (MESHES(NM)%FCVAR(I,J,K,CC_FGSC,JAXIS) /= CC_SOLID ) CYCLE
6899-
VP(I,J,K) = V_IBM
6900-
ENDDO
6901-
ENDDO
6902-
ENDDO
6829+
WHERE(MESHES(NM)%CCVAR(0:IBP1,0:JBP1,0:KBP1,CC_CGSC)==CC_SOLID) HP(0:IBP1,0:JBP1,0:KBP1) = 0._EB
69036830

6904-
! Force W velocities in CC_SOLID faces to zero
6905-
W_IBM = 0._EB ! Body doesn't move.
6906-
DO K=0,KBAR
6907-
DO J=1,JBAR
6908-
DO I=1,IBAR
6909-
IF (MESHES(NM)%FCVAR(I,J,K,CC_FGSC,KAXIS) /= CC_SOLID ) CYCLE
6910-
WP(I,J,K) = W_IBM
6911-
ENDDO
6912-
ENDDO
6913-
ENDDO
6914-
ENDIF
6831+
! Set velocities on solid faces to zero:
6832+
WHERE(MESHES(NM)%FCVAR(0:IBAR,1:JBAR,1:KBAR,CC_FGSC,IAXIS)==CC_SOLID) UP(0:IBAR,1:JBAR,1:KBAR) = 0._EB
6833+
WHERE(MESHES(NM)%FCVAR(1:IBAR,0:JBAR,1:KBAR,CC_FGSC,JAXIS)==CC_SOLID) VP(1:IBAR,0:JBAR,1:KBAR) = 0._EB
6834+
WHERE(MESHES(NM)%FCVAR(1:IBAR,1:JBAR,0:KBAR,CC_FGSC,KAXIS)==CC_SOLID) WP(1:IBAR,1:JBAR,0:KBAR) = 0._EB
69156835

69166836
NULLIFY(UP,VP,WP,HP)
69176837

@@ -7356,11 +7276,9 @@ SUBROUTINE INIT_CUTCELL_DATA(T,DT,FIRST_CALL)
73567276
LOGICAL, INTENT(IN) :: FIRST_CALL
73577277

73587278
! Local Variables:
7359-
INTEGER :: NM,I,J,K,N,ICC,JCC,X1AXIS,NFACE,ICF,IFACE
7279+
INTEGER :: NM,I,J,K,N,ICC,JCC,X1AXIS,NFACE,ICF
73607280
REAL(EB) TMP_CC,RHO_CC,AREAT,VEL_CF !,Z_CC,TMP_0_CC,P_0_CC
73617281
REAL(EB), ALLOCATABLE, DIMENSION(:) :: ZZ_CC
7362-
INTEGER :: INDADD, INDF, IFC, IFACE2, ICFC
7363-
REAL(EB):: FSCU, AREATOT
73647282
INTEGER :: IW,IROW_LOC
73657283

73667284
REAL(EB) :: TNOW
@@ -7599,57 +7517,8 @@ SUBROUTINE INIT_CUTCELL_DATA(T,DT,FIRST_CALL)
75997517
ENDDO
76007518
ENDDO
76017519

7602-
! Then INBOUNDARY cut-faces:
7603-
ICC_LOOP : DO ICC=1,MESHES(NM)%N_CUTCELL_MESH
7604-
I = CUT_CELL(ICC)%IJK(IAXIS)
7605-
J = CUT_CELL(ICC)%IJK(JAXIS)
7606-
K = CUT_CELL(ICC)%IJK(KAXIS)
7607-
FSCU = 0._EB
7608-
7609-
! Loop on cells neighbors and test if they are of type CC_SOLID, if so
7610-
! Add to velocity flux:
7611-
! X faces
7612-
DO INDADD=-1,1,2
7613-
INDF = I - 1 + (INDADD+1)/2
7614-
IF( FCVAR(INDF,J,K,CC_FGSC,IAXIS) /= CC_SOLID) CYCLE
7615-
FSCU = FSCU + REAL(INDADD,EB)*U(INDF,J,K)*DY(J)*DZ(K)
7616-
ENDDO
7617-
! Y faces
7618-
DO INDADD=-1,1,2
7619-
INDF = J - 1 + (INDADD+1)/2
7620-
IF( FCVAR(I,INDF,K,CC_FGSC,JAXIS) /= CC_SOLID ) CYCLE
7621-
FSCU = FSCU + REAL(INDADD,EB)*V(I,INDF,K)*DX(I)*DZ(K)
7622-
ENDDO
7623-
! Z faces
7624-
DO INDADD=-1,1,2
7625-
INDF = K - 1 + (INDADD+1)/2
7626-
IF( FCVAR(I,J,INDF,CC_FGSC,KAXIS) /= CC_SOLID ) CYCLE
7627-
FSCU = FSCU + REAL(INDADD,EB)*W(I,J,INDF)*DX(I)*DY(J)
7628-
ENDDO
7629-
7630-
! Now Define total area of INBOUNDARY cut-faces:
7631-
ICF=CCVAR(I,J,K,CC_IDCF);
7632-
ICF_COND : IF (ICF > 0) THEN
7633-
NFACE = CUT_FACE(ICF)%NFACE
7634-
AREATOT = SUM ( CUT_FACE(ICF)%AREA(1:NFACE) )
7635-
DO JCC =1,CUT_CELL(ICC)%NCELL
7636-
IFC_LOOP : DO IFC=1,CUT_CELL(ICC)%CCELEM(1,JCC)
7637-
IFACE = CUT_CELL(ICC)%CCELEM(IFC+1,JCC)
7638-
IF (CUT_CELL(ICC)%FACE_LIST(1,IFACE) == CC_FTYPE_CFINB) THEN
7639-
IFACE2 = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
7640-
ICFC = CUT_FACE(ICF)%CFACE_INDEX(IFACE2)
7641-
IF(PRES_ON_WHOLE_DOMAIN) THEN
7642-
CUT_FACE(ICF)%VELS(IFACE2) = 1._EB/AREATOT*FSCU ! +ve into the solid Velocity error
7643-
CUT_FACE(ICF)%VEL( IFACE2) = 1._EB/AREATOT*FSCU
7644-
ELSE
7645-
CUT_FACE(ICF)%VELS(IFACE2) = 0._EB
7646-
CUT_FACE(ICF)%VEL( IFACE2) = 0._EB
7647-
ENDIF
7648-
ENDIF
7649-
ENDDO IFC_LOOP
7650-
ENDDO
7651-
ENDIF ICF_COND
7652-
ENDDO ICC_LOOP
7520+
! INBOUNDARY cut-faces are initialized with 0._EB velocity, that will be changed in
7521+
! CFACE_PREDICT_NORMAL_VELOCITY.
76537522

76547523
ENDIF PERIODIC_TEST_COND
76557524

@@ -11590,7 +11459,7 @@ SUBROUTINE CC_DENSITY_EXPLICIT(T,DT)
1159011459
F_Z(:) = 0._EB
1159111460
CALL GET_EXPLICIT_ADVDIFFVECTOR_SCALAR_3D(N)
1159211461

11593-
! Add Advective fluxes due to PRES_ON_WHOLE_DOMAIN for F_Z:
11462+
! Add Advective fluxes for F_Z:
1159411463
CALL GET_ADVDIFFVECTOR_SCALAR_3D(N)
1159511464

1159611465
! Here add the reaction source term M_DOT_PPP, treated explicitly:
@@ -12144,9 +12013,6 @@ SUBROUTINE GET_EXPLICIT_ADVDIFFVECTOR_SCALAR_3D(N)
1214412013

1214512014
ENDDO
1214612015

12147-
! Case of PRES_ON_WHOLE_DOMAIN, we have non-zero velocities on INBOUNDARY cut-faces:
12148-
! Done on CALL GET_ADVDIFFVECTOR_SCALAR_3D(N)
12149-
1215012016
! Then add (Del rho D Del Z)*dv computed on CCDIVERGENCE_PART_1:
1215112017
! Loop over regular cells on CC region:
1215212018
DO K=1,KBAR
@@ -15800,7 +15666,7 @@ SUBROUTINE CC_CHECK_DIVERGENCE(T,DT,PREDVEL)
1580015666
ENDIF
1580115667
ENDDO ICC_LOOP
1580215668

15803-
IF(.NOT.PRES_ON_WHOLE_DOMAIN .AND. STORE_CARTESIAN_DIVERGENCE) THEN
15669+
IF(STORE_CARTESIAN_DIVERGENCE) THEN
1580415670
DO K=1,KBAR
1580515671
DO J=1,JBAR
1580615672
DO I=1,IBAR
@@ -19774,16 +19640,11 @@ SUBROUTINE GET_CC_UNKH(I,J,K,IUNKH)
1977419640
INTEGER :: ICC
1977519641

1977619642
IUNKH = CC_UNDEFINED ! This is < 0.
19777-
IF(.NOT.PRES_ON_WHOLE_DOMAIN ) THEN
19778-
19779-
! Regular gas cell, taken care of before.
19780-
! Check cut-cell:
19781-
ICC = CCVAR(I,J,K,CC_IDCC)
19782-
! If theres is a cut-cell ICC then CUT_CELL(ICC)%UNKH(1) has been populated.
19783-
IF (ICC > 0) IUNKH = CUT_CELL(ICC)%UNKH(1)
19784-
19785-
ENDIF
19786-
19643+
! Regular gas cell, taken care of before.
19644+
! Check cut-cell:
19645+
ICC = CCVAR(I,J,K,CC_IDCC)
19646+
! If theres is a cut-cell ICC then CUT_CELL(ICC)%UNKH(1) has been populated.
19647+
IF (ICC > 0) IUNKH = CUT_CELL(ICC)%UNKH(1)
1978719648

1978819649
RETURN
1978919650
END SUBROUTINE GET_CC_UNKH
@@ -19798,12 +19659,10 @@ SUBROUTINE GET_CC_IROW(I,J,K,IPZ,IROW)
1979819659

1979919660
! Local variable:
1980019661
INTEGER :: ICC
19801-
IROW = CC_UNDEFINED ! This is < 0.
19802-
IF(.NOT.PRES_ON_WHOLE_DOMAIN) THEN
19803-
ICC = CCVAR(I,J,K,CC_IDCC)
19804-
! If theres is a cut-cell ICC then CUT_CELL(ICC)%UNKH(1) has been populated.
19805-
IF (ICC > 0) IROW = CUT_CELL(ICC)%UNKH(1) - ZONE_SOLVE(IPZ)%UNKH_IND(NM_START)
19806-
ENDIF
19662+
IROW = CC_UNDEFINED ! This is < 0.
19663+
ICC = CCVAR(I,J,K,CC_IDCC)
19664+
! If theres is a cut-cell ICC then CUT_CELL(ICC)%UNKH(1) has been populated.
19665+
IF (ICC > 0) IROW = CUT_CELL(ICC)%UNKH(1) - ZONE_SOLVE(IPZ)%UNKH_IND(NM_START)
1980719666

1980819667
RETURN
1980919668
END SUBROUTINE GET_CC_IROW
@@ -21836,14 +21695,14 @@ SUBROUTINE NUMBER_UNKH_CUTCELLS(FLAG12,NM,IPZ,NUNKH_LC)
2183621695
ENDDO
2183721696
DO ICC=1,MESHES(NM)%N_CUTCELL_MESH
2183821697
CC => CUT_CELL(ICC); I=CC%IJK(IAXIS); J=CC%IJK(JAXIS); K=CC%IJK(KAXIS); IF(CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE
21839-
IF(.NOT.PRES_ON_WHOLE_DOMAIN .AND. ZONE_SOLVE(PRESSURE_ZONE(I,J,K))%CONNECTED_ZONE_PARENT/=IPZ ) CYCLE
21698+
IF(ZONE_SOLVE(PRESSURE_ZONE(I,J,K))%CONNECTED_ZONE_PARENT/=IPZ ) CYCLE
2184021699
NUNKH_LC(NM) = NUNKH_LC(NM) + 1
2184121700
CUT_CELL(ICC)%UNKH(1:CC%NCELL) = NUNKH_LC(NM)
2184221701
ENDDO
2184321702
ELSE
2184421703
DO ICC=1,MESHES(NM)%N_CUTCELL_MESH
2184521704
CC => CUT_CELL(ICC); I=CC%IJK(IAXIS); J=CC%IJK(JAXIS); K=CC%IJK(KAXIS); IF(CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE
21846-
IF(.NOT.PRES_ON_WHOLE_DOMAIN .AND. ZONE_SOLVE(PRESSURE_ZONE(I,J,K))%CONNECTED_ZONE_PARENT/=IPZ ) CYCLE
21705+
IF(ZONE_SOLVE(PRESSURE_ZONE(I,J,K))%CONNECTED_ZONE_PARENT/=IPZ ) CYCLE
2184721706
DO JCC=1,CC%NCELL
2184821707
CUT_CELL(ICC)%UNKH(JCC) = CUT_CELL(ICC)%UNKH(JCC) + ZONE_SOLVE(IPZ)%UNKH_IND(NM)
2184921708
ENDDO
@@ -21885,15 +21744,10 @@ SUBROUTINE COPY_CC_HS_TO_UNKH(NM)
2188521744

2188621745
ICC=CCVAR(II,JJ,KK,CC_IDCC)
2188721746

21888-
IF(.NOT.PRES_ON_WHOLE_DOMAIN) THEN
21889-
IF (ICC > 0) THEN ! Cut-cells on this guard-cell Cartesian cell.
21890-
MESHES(NM)%CUT_CELL(ICC)%UNKH(1) = INT(OM%HS(IIO,JJO,KKO))
21891-
ELSE
21892-
MESHES(NM)%CCVAR(II,JJ,KK,CC_UNKH) = INT(OM%HS(IIO,JJO,KKO))
21893-
ENDIF
21747+
IF (ICC > 0) THEN ! Cut-cells on this guard-cell Cartesian cell.
21748+
MESHES(NM)%CUT_CELL(ICC)%UNKH(1) = INT(OM%HS(IIO,JJO,KKO))
2189421749
ELSE
2189521750
MESHES(NM)%CCVAR(II,JJ,KK,CC_UNKH) = INT(OM%HS(IIO,JJO,KKO))
21896-
IF (ICC > 0) MESHES(NM)%CUT_CELL(ICC)%UNKH(1) = MESHES(NM)%CCVAR(II,JJ,KK,CC_UNKH)
2189721751
ENDIF
2189821752

2189921753
ENDDO EXTERNAL_WALL_LOOP
@@ -21920,21 +21774,12 @@ SUBROUTINE COPY_CC_UNKH_TO_HS(NM)
2192021774
! Local Variables:
2192121775
INTEGER :: I,J,K,ICC
2192221776

21923-
IF(.NOT.PRES_ON_WHOLE_DOMAIN) THEN
21924-
DO ICC=1,MESHES(NM)%N_CUTCELL_MESH
21925-
I = MESHES(NM)%CUT_CELL(ICC)%IJK(IAXIS)
21926-
J = MESHES(NM)%CUT_CELL(ICC)%IJK(JAXIS)
21927-
K = MESHES(NM)%CUT_CELL(ICC)%IJK(KAXIS)
21928-
HS(I,J,K)= REAL(MESHES(NM)%CUT_CELL(ICC)%UNKH(1),EB)
21929-
ENDDO
21930-
ELSE
21931-
DO ICC=1,MESHES(NM)%N_CUTCELL_MESH
21932-
I = MESHES(NM)%CUT_CELL(ICC)%IJK(IAXIS)
21933-
J = MESHES(NM)%CUT_CELL(ICC)%IJK(JAXIS)
21934-
K = MESHES(NM)%CUT_CELL(ICC)%IJK(KAXIS)
21935-
MESHES(NM)%CUT_CELL(ICC)%UNKH(1) = INT(HS(I,J,K))
21936-
ENDDO
21937-
ENDIF
21777+
DO ICC=1,MESHES(NM)%N_CUTCELL_MESH
21778+
I = MESHES(NM)%CUT_CELL(ICC)%IJK(IAXIS)
21779+
J = MESHES(NM)%CUT_CELL(ICC)%IJK(JAXIS)
21780+
K = MESHES(NM)%CUT_CELL(ICC)%IJK(KAXIS)
21781+
HS(I,J,K)= REAL(MESHES(NM)%CUT_CELL(ICC)%UNKH(1),EB)
21782+
ENDDO
2193821783

2193921784
RETURN
2194021785
END SUBROUTINE COPY_CC_UNKH_TO_HS

Source/geom.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4745,8 +4745,8 @@ SUBROUTINE GET_GEOM_TRIBIN
47454745
DO X1AXIS=IAXIS,KAXIS
47464746

47474747
! Here reduce the X1_LOW to X1_HIGH distance to the smallest of FDS Mesh and connected meshes BBOX or Geometry:
4748-
MIN_MESHGEOM = MAX(MINMAX_MESHES( LOW_IND,X1AXIS),G%GEOM_BOX( LOW_IND,X1AXIS))
4749-
MAX_MESHGEOM = MIN(MINMAX_MESHES(HIGH_IND,X1AXIS),G%GEOM_BOX(HIGH_IND,X1AXIS))
4748+
MIN_MESHGEOM = MAX(MINMAX_MESHES( LOW_IND,X1AXIS),G%GEOM_BOX( LOW_IND,X1AXIS)-G%MEAN_LEDGE)
4749+
MAX_MESHGEOM = MIN(MINMAX_MESHES(HIGH_IND,X1AXIS),G%GEOM_BOX(HIGH_IND,X1AXIS)+G%MEAN_LEDGE)
47504750
LX1 = MAX_MESHGEOM - MIN_MESHGEOM
47514751

47524752
! Define number of bins in direction X1AXIS:

0 commit comments

Comments
 (0)