File: RELATIVE:/../../../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 initialize the      !
11     !        MPPIC model                                                   !
12     !                                                                      !
13     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
14           SUBROUTINE CHECK_IC_MPPIC
15     
16     
17     ! Runtime Flag: Generate initial particle configuration.
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     
24     ! Flag indicating that the IC region is defined.
25           USE ic, only: IC_DEFINED
26     ! IC Region gas volume fraction.
27           USE ic, only: IC_EP_G
28     ! IC Region solid volume fraction.
29           USE ic, only: IC_EP_S
30     
31           USE param1, only: ZERO, ONE
32     
33     ! MPPIC specific IC region specification.
34           USE ic, only: IC_PIC_CONST_NPC, IC_PIC_CONST_STATWT
35     ! Maximum number of IC regions and solids phases
36           USE param, only: DIMENSION_IC
37     
38     ! direction wise spans of the domain and grid spacing in each direction
39           Use geometry, only: zlength, dz
40     
41           USE mpi_utility
42           USE functions
43     
44     ! Use the error manager for posting error messages.
45     !---------------------------------------------------------------------//
46           use error_manager
47     
48           implicit none
49     
50     ! Temp logical variables for checking constant npc and statwt specification
51           LOGICAL :: CONST_NPC, CONST_STATWT
52     
53     ! Volume of the cell
54           INTEGER :: ICV, M
55     
56           IF (.NOT.GENER_PART_CONFIG) RETURN
57     
58     ! Initialize the error manager.
59           CALL INIT_ERR_MSG("CHECK_IC_MPPIC")
60     
61     ! First check if either a constant npc or constant statwt
62     ! is specified for each IC
63           DO ICV = 1, DIMENSION_IC
64     
65              IF(.not.ic_defined(icv)) cycle
66     
67              IF (IC_EP_G(ICV).lt.ONE) THEN
68                 DO M = 1, DES_MMAX
69                    CONST_NPC    = (IC_PIC_CONST_NPC   (ICV, M) .ne. 0)
70                    CONST_STATWT = (IC_PIC_CONST_STATWT(ICV, M) .ne. ZERO  )
71                    IF(CONST_NPC.and.CONST_STATWT.and.ic_ep_s(icv,m).gt.zero) then
72                       WRITE(ERR_MSG, 1100) ICV, M
73                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
74                    ENDIF
75     
76                    IF(.not.CONST_NPC.and.(.not.CONST_STATWT).and. &
77                    ic_ep_s(icv,m).gt.zero) then
78                       WRITE(ERR_MSG, 1101) ICV, M
79                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
80                    ENDIF
81                 ENDDO
82              ENDIF
83           ENDDO
84     
85      1100 FORMAT('Error 1100: In MPPIC model for IC # ',i5, &
86           ' and solid phase # ', i5, /, &
87           'Non zero Values specified for both ', &
88           'IC_PIC_CONST_NPC and IC_PIC_CONST_STATWT.', /, &
89           'Choose between constant number of parcels per cell or ', &
90           'constant statistical weight', /, &
91           'See MFIX readme',/'Please correct the data file.')
92     
93     
94      1101 FORMAT('Error 1101: In MPPIC model for IC # ',i5, &
95           ' and solid phase # ', i5, /, &
96           'A non-zero value not specified for ', &
97           'IC_PIC_CONST_NPC or IC_PIC_CONST_STATWT. ', /, &
98           'Choose between constant number of parcels per cell or ', &
99           'constant statistical weight', /, &
100           'See MFIX readme',/'Please correct the data file.')
101     
102     
103     
104           IF(DIMN.EQ.2) THEN
105     ! require that DZ(1)/ZLENGTH be specified for 2-dimensional case.
106     ! unclear why this cannot be one - other than the user may be unaware
107     ! that a depth has been set (a value of one implies default setting)
108              IF (DZ(1) == ONE) THEN
109                 WRITE(*,'(5X,A,A,/5X,A,A)') &
110                 'For DIMN = 2, specify a value for DZ(1) or ',&
111                 'ZLENGTH in mfix.dat which is not',&
112                 'equal to one. If you want it to be one then ',&
113                 'set it close to one but not exactly one'
114                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
115              ENDIF
116     
117              IF (DZ(1) .NE. ZLENGTH) THEN
118                 WRITE(ERR_MSG,'(5X,A,/5x,A,/5X,2(A20,2X,G17.8))')        &
119                 'For DIMN = 2, DZ(1) and ZLENGTH are used ',         &
120                 'interchangeably', ' Specify same values for ',      &
121                 'DZ(1) and ZLENGTH','DZ(1) = ', DZ(1), 'ZLENGTH = ', &
122                 ZLENGTH
123                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
124              ENDIF
125           ENDIF
126     
127     
128           CALL FINL_ERR_MSG
129     
130           END SUBROUTINE CHECK_IC_MPPIC
131     
132