File: /nfs/home/0/users/jenkins/mfix.git/model/check_data/check_ic_common_discrete.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: CHECK_IC_COMMON_DISCRETE                                !
4     !  Author:   R.Garg                                   Date: 11-Mar-14  !
5     !                                                                      !
6     !  Purpose: check the initial conditions input section common to both  !
7     !           DEM and MPPIC models                                       !
8     !     - ensure the first IC is defined over the entire domain with     !
9     !        ep_g = 1 when more than one IC has solids                     !
10     !     - ensure the ICs are non-overlapping                             !
11     !                                                                      !
12     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
13           SUBROUTINE CHECK_IC_COMMON_DISCRETE
14     
15     ! Runtime Flag: Generate initial particle configuation.
16           USE discretelement, only : gener_part_config
17     ! Simulation dimension (2D/3D)
18           USE discretelement, only: DIMN
19     ! Number of DEM solids phases.
20           USE discretelement, only: DES_MMAX
21     ! Flag indicating that the IC region is defined.
22           USE ic, only: IC_DEFINED
23     ! IC Region gas volume fraction.
24           USE ic, only: IC_EP_G
25     ! IC Region solid volume fraction.
26           USE ic, only: IC_EP_S
27     ! IC Region gas volume fraction.
28           USE ic, only: IC_THETA_M
29     
30           USE ic, only: IC_X_w, IC_X_e, IC_Y_s, IC_Y_n, IC_Z_b, IC_Z_t
31     
32           USE param1, only: UNDEFINED, UNDEFINED_I, ZERO, ONE
33     
34     ! direction wise spans of the domain and grid spacing in each direction
35           Use geometry, only: xlength, ylength, zlength
36     
37     
38     ! Maximum number of IC regions
39           USE param, only: DIMENSION_IC
40     
41           ! Use the error manager for posting error messages.
42     !---------------------------------------------------------------------//
43           use error_manager
44     
45           implicit none
46     
47           INTEGER :: ICV, ICV2, M, IDIM
48           INTEGER :: COUNT_IC, COUNT_IC_WITH_SOLS
49           INTEGER :: FIRST_DEF_IC
50     
51           DOUBLE PRECISION :: IC_ORIG(3), IC_END(3), IC2_ORIG(3) , IC2_END(3)
52           DOUBLE PRECISION :: IC_MIN, IC_MAX, IC2_MIN, IC2_MAX , TOL_IC_REG
53     
54           LOGICAL :: SEP_AXIS, first_ic_ok
55     
56           IF (.NOT.GENER_PART_CONFIG) RETURN
57     
58     ! Initialize the error manager.
59           CALL INIT_ERR_MSG("CHECK_IC_COMMON_DISCRETE")
60     
61     ! First check if multiple IC regions are defined for non-zero solids volume
62     ! fraction, then check if the first IC is specified over the whole domain with IC_EP_g = 1
63     
64           !total count of defined ICs
65           COUNT_IC           = 0
66           !total count of defined IC's with solids
67           COUNT_IC_WITH_SOLS = 0
68           FIRST_DEF_IC = UNDEFINED_I
69           DO ICV = 1, DIMENSION_IC
70     
71              IF (IC_DEFINED(ICV)) THEN
72                 COUNT_IC = COUNT_IC + 1
73                 FIRST_DEF_IC = MIN(FIRST_DEF_IC, ICV)
74     
75                 IF(IC_EP_G(ICV).LT.ONE) COUNT_IC_WITH_SOLS &
76                 = COUNT_IC_WITH_SOLS  + 1
77     
78              ENDIF ! if(ic_defined(icv))
79           end DO
80     
81           IF(COUNT_IC_WITH_SOLS >= 1 .AND. &
82              COUNT_IC > COUNT_IC_WITH_SOLS+1) THEN
83     
84     ! If the number of IC's with solids is greater than one, make sure the
85     ! first IC spans the entire domain with voidage of one. This ensures
86     ! that the entire domain has valid ICs defined.
87              ICV = FIRST_DEF_IC
88              FIRST_IC_OK = .FALSE.
89              IF(IC_EP_G(ICV).EQ.ONE &
90                .AND.IC_X_W(ICV).LE.ZERO.AND.IC_X_E(ICV).GE.XLENGTH         &
91                .AND.IC_Y_S(ICV).LE.ZERO.AND.IC_Y_N(ICV).GE.YLENGTH)        &
92                 FIRST_IC_OK = .TRUE.
93     
94              IF (FIRST_IC_OK .AND. IC_Z_B(ICV) <= ZERO .AND. &
95                 IC_Z_T(ICV) >= ZLENGTH) FIRST_IC_OK = .TRUE.
96     
97              IF(.NOT.FIRST_IC_OK) THEN
98                 WRITE(ERR_MSG, 1003)
99                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
100              ENDIF
101     
102      1003 FORMAT(' Error 1003: Particle seeding with more than one IC ',   &
103              'region requires',/'that IC 1 span the entire domain and ',   &
104              'have IC_EP_g(1) = 1.0.',/'Please correct the mfix.dat file.')
105     
106           ENDIF
107     
108     ! Check if the ICs are non-overlapping.
109           TOL_IC_REG  = 1E-04
110           ICVLOOP : DO ICV = 1, DIMENSION_IC
111     
112              IF(.NOT.IC_DEFINED(ICV)) CYCLE ICVLOOP
113              IF(IC_EP_G(ICV) == 1.d0) CYCLE ICVLOOP
114              IC_ORIG(1) = IC_X_W(ICV)
115              IC_ORIG(2) = IC_Y_S(ICV)
116              IC_ORIG(3) = IC_Z_B(ICV)
117              IC_END(1)  = IC_X_E(ICV)
118              IC_END(2)  = IC_Y_N(ICV)
119              IC_END(3)  = IC_Z_T(ICV)
120              ICVTWOLOOP : DO ICV2 = ICV+1, DIMENSION_IC
121     
122                 IF(.NOT.IC_DEFINED(ICV2)) CYCLE ICVTWOLOOP
123                 IF(IC_EP_G(ICV2) == 1.0d0) CYCLE ICVTWOLOOP
124     
125                 IC2_ORIG(1) = IC_X_W(ICV2)
126                 IC2_ORIG(2) = IC_Y_S(ICV2)
127                 IC2_ORIG(3) = IC_Z_B(ICV2)
128                 IC2_END(1)  = IC_X_E(ICV2)
129                 IC2_END(2)  = IC_Y_N(ICV2)
130                 IC2_END(3)  = IC_Z_T(ICV2)
131     
132                 sep_axis  = .false.
133                 DO idim = 1, dimn
134     
135                    ic_min = IC_ORIG(idim)
136                    ic_max = IC_END(idim)
137                    ic2_min = IC2_ORIG(idim)
138                    ic2_max = ic2_END(idim)
139     
140     ! Check for separating axis. If the separating axis exists, then the IC
141     ! regions can't overlap generally equality implies lack of sep_axis,
142     ! and thus, overlapping. However, doing so will flag all IC's as
143     ! overlapping since IC's have to share common edges. So here the
144     ! equality is considered as existence of a separating axis, and hence,
145     ! no overlap equality is also considered as separating axis which is
146                    if ((ic_min .ge. ic2_max)  .or. (ic_max .le. ic2_min) ) then
147                       sep_axis = .true.
148                       exit
149                    endif
150                 end DO
151     
152     ! Implies the IC regions could not find a separating axis and are
153     ! thereofre overlapping.
154                 IF(.NOT.sep_axis) THEN
155                    WRITE(ERR_MSG, 1004) ICV, ICV2
156                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
157                 ENDIF
158     
159      1004 FORMAT('Error 1004: Overlapping IC regions with nonzero solids ',&
160              'volume',/'fraction detected. This is not supported for ',    &
161              'discrete solids.',2/'Overlapping ICs: ',2(2x,I4),2/,         &
162              'Please correct the mfix.dat file.')
163     
164              end DO ICVTWOLOOP
165           end DO ICVLOOP
166     
167     
168     
169     ! Check if IC_theta_M is specified for solids phases wherever IC_EP_g lt 1
170           DO ICV = 1, DIMENSION_IC
171     
172              IF (IC_DEFINED(ICV).and.IC_EP_G(ICV).LT.ONE) THEN
173                 DO M = 1, DES_MMAX
174                    IF(IC_THETA_M(ICV,M)==UNDEFINED) THEN
175                       IF(IC_EP_S(ICV,M).gt.Zero) THEN
176                          WRITE(ERR_MSG, 1000) trim(iVar('IC_THETA_M',ICV,M))
177                          CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
178                       ELSE
179                          IC_Theta_M(ICV,M) = ZERO
180                       ENDIF
181                    ENDIF
182                 ENDDO
183              ENDIF
184           ENDDO
185     
186           CALL FINL_ERR_MSG
187     
188           RETURN
189     
190      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
191              'correct the mfix.dat file.')
192     
193           END SUBROUTINE CHECK_IC_COMMON_DISCRETE
194