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