File: N:\mfix\model\des\make_arrays_des.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !  Module name: MAKE_ARRAYS_DES                                        !
3     !  Author: Jay Boyalakuntla                           Date: 12-Jun-04  !
4     !                                                                      !
5     !  Purpose: DES - allocating DES arrays
6     !                                                                      !
7     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
8           SUBROUTINE MAKE_ARRAYS_DES
9     
10           USE calc_collision_wall
11           USE compar
12           use constant, only: PI
13           USE cutcell
14           USE des_rxns
15           USE des_thermo
16           USE desgrid
17           USE discretelement
18           USE error_manager
19           USE functions
20           USE funits
21           use fldvar, only: ro_s
22           USE GENERATE_PARTICLES, only: GENERATE_PARTICLE_CONFIG
23           USE geometry
24           use mfix_pic, only:  MPPIC
25           use mpi_funs_des, only: DES_PAR_EXCHANGE
26           USE mpi_utility
27           USE param1
28           use physprop, only: mmax, ro_s0
29           USE run
30           USE stl
31           USE stl_functions_des
32           use stl_preproc_des, only: add_facet
33     
34           IMPLICIT NONE
35     !-----------------------------------------------
36     ! Local variables
37     !-----------------------------------------------
38           INTEGER :: I, J, K, L, IJK
39           INTEGER :: I1, I2, J1, J2, K1, K2, II, JJ, KK, IJK2
40           INTEGER :: lcurpar, lpip_all(0:numpes-1), lglobal_id
41           INTEGER :: CELL_ID, I_CELL, J_CELL, K_CELL, COUNT, NF
42           INTEGER :: IMINUS1, IPLUS1, JMINUS1, JPLUS1, KMINUS1, KPLUS1
43     
44     ! MPPIC related quantities
45           CALL INIT_ERR_MSG("MAKE_ARRAYS_DES")
46     
47     ! Check interpolation input.
48           CALL SET_FILTER_DES
49     
50     ! cfassign and des_init_bc called before reading the particle info
51           CALL CFASSIGN
52     
53           VOL_SURR(:) = ZERO
54     
55           ! initialize VOL_SURR array
56           DO K = KSTART2, KEND1
57              DO J = JSTART2, JEND1
58                 DO I = ISTART2, IEND1
59                    IF (DEAD_CELL_AT(I,J,K)) CYCLE  ! skip dead cells
60                    IJK = funijk(I,J,K)
61                    I1 = I
62                    I2 = I+1
63                    J1 = J
64                    J2 = J+1
65                    K1 = K
66                    K2 = merge(K, K+1, NO_K)
67     
68     ! looping over stencil points (node values)
69                    DO KK = K1, K2
70                       DO JJ = J1, J2
71                          DO II = I1, I2
72                             IF (DEAD_CELL_AT(II,JJ,KK)) CYCLE  ! skip dead cells
73                             IJK2 = funijk_map_c(II, JJ, KK)
74                             IF(FLUID_AT(IJK2)) VOL_SURR(IJK) = &
75                                VOL_SURR(IJK)+VOL(IJK2)
76                          ENDDO
77                       ENDDO
78                    ENDDO
79                 ENDDO
80              ENDDO
81           ENDDO
82     
83     
84     
85     ! Set the initial particle data.
86           IF(RUN_TYPE == 'NEW') THEN
87              IF(PARTICLES /= 0) THEN
88                 IF(GENER_PART_CONFIG) THEN
89                    CALL GENERATE_PARTICLE_CONFIG
90                 ELSE
91                    CALL READ_PAR_INPUT
92                 ENDIF
93              ENDIF
94     
95     ! Set the global ID for the particles and set the ghost cnt
96              ighost_cnt = 0
97              lpip_all = 0
98              lpip_all(mype) = pip
99              call global_all_sum(lpip_all)
100              lglobal_id = sum(lpip_all(0:mype-1))
101              imax_global_id = 0
102              do lcurpar  = 1,pip
103                 lglobal_id = lglobal_id + 1
104                 iglobal_id(lcurpar) = lglobal_id
105                 imax_global_id = iglobal_id(pip)
106              end do
107              call global_all_max(imax_global_id)
108     
109     ! Initialize old values
110              omega_new(:,:)   = zero
111     
112     ! Particle orientation
113              IF(PARTICLE_ORIENTATION) THEN
114                 ORIENTATION(1,:) = INIT_ORIENTATION(1)
115                 ORIENTATION(2,:) = INIT_ORIENTATION(2)
116                 ORIENTATION(3,:) = INIT_ORIENTATION(3)
117              ENDIF
118     
119     
120              IF (DO_OLD) THEN
121                 omega_old(:,:)   = zero
122                 des_pos_old(:,:) = des_pos_new(:,:)
123                 des_vel_old(:,:) = des_vel_new(:,:)
124              ENDIF
125     
126     ! Read the restart file.
127           ELSEIF(RUN_TYPE == 'RESTART_1' .OR. RUN_TYPE == 'RESTART_2') THEN
128     
129              CALL READ_RES0_DES
130              imax_global_id = maxval(iglobal_id(1:pip))
131              call global_all_max(imax_global_id)
132     
133     ! Initizlie the old values.
134              IF (DO_OLD) THEN
135                 omega_old(:,:)   = omega_new(:,:)
136                 des_pos_old(:,:) = des_pos_new(:,:)
137                 des_vel_old(:,:) = des_vel_new(:,:)
138              ENDIF
139     
140           ELSE
141     
142              WRITE(ERR_MSG, 1100)
143              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
144      1100 FORMAT('Error 1100: Unsupported RUN_TYPE for DES.')
145     
146           ENDIF
147     
148           IF(RUN_TYPE == 'RESTART_2') VTP_FINDEX=0
149     
150     ! setting additional particle properties now that the particles
151     ! have been identified
152           DO L = 1, MAX_PIP
153     ! Skip 'empty' locations when populating the particle property arrays.
154              IF(IS_NONEXISTENT(L)) CYCLE
155              IF(IS_GHOST(L) .OR. IS_ENTERING_GHOST(L) .OR. IS_EXITING_GHOST(L)) CYCLE
156              PVOL(L) = (4.0D0/3.0D0)*PI*DES_RADIUS(L)**3
157              PMASS(L) = PVOL(L)*RO_SOL(L)
158              OMOI(L) = 2.5D0/(PMASS(L)*DES_RADIUS(L)**2) !ONE OVER MOI
159           ENDDO
160     
161           CALL SET_PHASE_INDEX
162           CALL INIT_PARTICLES_IN_CELL
163     
164     ! do_nsearch should be set before calling particle in cell
165           DO_NSEARCH =.TRUE.
166     ! Bin the particles to the DES grid.
167           CALL DESGRID_PIC(PLOCATE=.TRUE.)
168           CALL DES_PAR_EXCHANGE
169           CALL PARTICLES_IN_CELL
170     
171           IF(DEM_SOLIDS) THEN
172              CALL NEIGHBOUR
173              CALL INIT_SETTLING_DEM
174           ENDIF
175     
176           IF(RUN_TYPE == 'NEW') CALL SET_IC_DEM
177     
178     
179     ! Calculate interpolation weights
180           CALL CALC_INTERP_WEIGHTS
181     ! Calculate mean fields using either interpolation or cell averaging.
182           CALL COMP_MEAN_FIELDS
183     
184           IF(MPPIC) CALL CALC_DTPIC
185     
186     
187           IF(RUN_TYPE /= 'RESTART_1' .AND. PRINT_DES_DATA) THEN
188              S_TIME = TIME
189              CALL WRITE_DES_DATA
190           ENDIF
191     
192           CALL FINL_ERR_MSG
193     
194           RETURN
195           END SUBROUTINE MAKE_ARRAYS_DES
196