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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: CHECK_IC_MPPIC                                          !
4     !  Author:   R.Garg                                   Date: 11-Mar-14  !
5     !                                                                      !
6     !  Purpose: check the initial conditions input section for MPPIC model !
7     !     - ensure the first IC is defined over the entire domain with     !
8     !        ep_g = 1 when more than one IC has solids                     !
9     !     - ensure the ICs are non-overlapping                             !
10     !     - calculate the number of particles needed to initalize the      !
11     !        MPPIC model                                                   !
12     !                                                                      !
13     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
14           SUBROUTINE CHECK_IC_MPPIC
15     
16     
17     ! Runtime Flag: Generate initial particle configuation.
18           USE discretelement, only : gener_part_config
19     ! Simulation dimension (2D/3D)
20           USE discretelement, only: DIMN
21     ! Number of DEM solids phases.
22           USE discretelement, only: DES_MMAX
23     ! DEM solid phase diameters and densities.
24           USE discretelement, only: DES_D_p0, DES_RO_s
25     ! Number of particles seeded per phase
26           USE discretelement, only: PART_MPHASE
27     ! Number of particles seeded, per phase in each IC region
28           USE discretelement, only: PART_MPHASE_BYIC
29     ! Number of particles to read from input file.
30           USE discretelement, only: PARTICLES
31     
32     ! Implied total number of physical particles
33           USE mfix_pic, only: rnp_pic
34     ! Total number of computational particles/parcels
35           USE mfix_pic, only: cnp_pic
36     
37           USE mfix_pic, only: cnp_array
38     ! Flag indicating that the IC region is defined.
39           USE ic, only: IC_DEFINED
40     ! IC Region bulk density (RO_s * EP_s)
41           USE ic, only: IC_ROP_s
42     ! IC Region gas volume fraction.
43           USE ic, only: IC_EP_G
44     ! IC Region solid volume fraction.
45           USE ic, only: IC_EP_S
46     
47           USE ic, only: IC_X_w, IC_X_e, IC_Y_s, IC_Y_n, IC_Z_b, IC_Z_t
48           USE ic, only: IC_I_w, IC_I_e, IC_J_s, IC_J_n, IC_K_b, IC_K_t
49     
50           USE param1, only: UNDEFINED, UNDEFINED_I, ZERO, ONE
51     
52     ! MPPIC specific IC region specification.
53           USE ic, only: IC_PIC_CONST_NPC, IC_PIC_CONST_STATWT
54     ! Maximum number of IC regions and solids phases
55           USE param, only: DIMENSION_IC, DIM_M
56     
57     ! direction wise spans of the domain and grid spacing in each direction
58           Use geometry, only: xlength, ylength, zlength, dx, dy, dz
59     
60     ! Constant: 3.14159...
61           USE constant, only: PI
62     
63           USE mpi_utility
64           USE functions
65     
66     ! Use the error manager for posting error messages.
67     !---------------------------------------------------------------------//
68           use error_manager
69     
70           implicit none
71     
72     ! Temp logical variables for checking constant npc and statwt specification
73           LOGICAL :: CONST_NPC, CONST_STATWT
74     
75     ! Volume of the cell
76           INTEGER :: ICV, M
77     
78           IF (.NOT.GENER_PART_CONFIG) RETURN
79     
80     ! Initialize the error manager.
81           CALL INIT_ERR_MSG("CHECK_IC_MPPIC")
82     
83     ! First check if either a constant npc or constant statwt
84     ! is specified for each IC
85           DO ICV = 1, DIMENSION_IC
86     
87              IF(.not.ic_defined(icv)) cycle
88     
89              IF (IC_EP_G(ICV).lt.ONE) THEN
90                 DO M = 1, DES_MMAX
91                    CONST_NPC    = (IC_PIC_CONST_NPC   (ICV, M) .ne. 0)
92                    CONST_STATWT = (IC_PIC_CONST_STATWT(ICV, M) .ne. ZERO  )
93                    IF(CONST_NPC.and.CONST_STATWT.and.ic_ep_s(icv,m).gt.zero) then
94                       WRITE(ERR_MSG, 1100) ICV, M
95                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
96                    ENDIF
97     
98                    IF(.not.CONST_NPC.and.(.not.CONST_STATWT).and. &
99                    ic_ep_s(icv,m).gt.zero) then
100                       WRITE(ERR_MSG, 1101) ICV, M
101                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
102                    ENDIF
103                 ENDDO
104              ENDIF
105           ENDDO
106     
107      1100 FORMAT('Error 1100: In MPPIC model for IC # ',i5, &
108           ' and solid phase # ', i5, /, &
109           'Non zero Values specified for both ', &
110           'IC_PIC_CONST_NPC and IC_PIC_CONST_STATWT.', /, &
111           'Choose between constant number of parcels per cell or ', &
112           'constant statistical weight', /, &
113           'See MFIX readme',/'Please correct the data file.')
114     
115     
116      1101 FORMAT('Error 1101: In MPPIC model for IC # ',i5, &
117           ' and solid phase # ', i5, /, &
118           'A non-zero value not specified for ', &
119           'IC_PIC_CONST_NPC or IC_PIC_CONST_STATWT. ', /, &
120           'Choose between constant number of parcels per cell or ', &
121           'constant statistical weight', /, &
122           'See MFIX readme',/'Please correct the data file.')
123     
124     
125     
126           IF(DIMN.EQ.2) THEN
127     ! require that DZ(1)/ZLENGTH be specified for 2-dimensional case.
128     ! unclear why this cannot be one - other than the user may be unaware
129     ! that a depth has been set (a value of one implies default setting)
130              IF (DZ(1) == ONE) THEN
131                 WRITE(*,'(5X,A,A,/5X,A,A)') &
132                 'For DIMN = 2, specify a value for DZ(1) or ',&
133                 'ZLENGTH in mfix.dat which is not',&
134                 'equal to one. If you want it to be one then ',&
135                 'set it close to one but not exactly one'
136                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
137              ENDIF
138     
139              IF (DZ(1) .NE. ZLENGTH) THEN
140                 WRITE(ERR_MSG,'(5X,A,/5x,A,/5X,2(A20,2X,G17.8))')        &
141                 'For DIMN = 2, DZ(1) and ZLENGTH are used ',         &
142                 'interchangeably', ' Specify same values for ',      &
143                 'DZ(1) and ZLENGTH','DZ(1) = ', DZ(1), 'ZLENGTH = ', &
144                 ZLENGTH
145                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
146              ENDIF
147           ENDIF
148     
149     
150           CALL FINL_ERR_MSG
151     
152           END SUBROUTINE CHECK_IC_MPPIC
153     
154