File: RELATIVE:/../../../mfix.git/model/allocate_arrays.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Subroutinee: ALLOCATE_ARRAYS                                        C
4     !  Purpose: allocate arrays                                            C
5     !                                                                      C
6     !  Author: M. Syamlal                                Date: 17-DEC-98   C
7     !  Reviewer:                                                           C
8     !                                                                      C
9     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
10     
11           SUBROUTINE ALLOCATE_ARRAYS
12     
13     !-----------------------------------------------
14     ! Modules
15     !-----------------------------------------------
16           USE param
17           USE param1
18           Use ambm
19           Use cont
20           Use drag
21           Use energy
22           Use fldvar
23           Use geometry
24           Use indices
25           Use pgcor
26           Use physprop
27           Use pscor
28           Use residual
29           Use rxns
30           Use run
31           Use scalars
32           Use turb
33           Use tau_g
34           Use tau_s
35           Use tmp_array
36           Use tmp_array1
37           Use trace
38           Use visc_g
39           Use visc_s
40           Use xsi_array
41           Use vshear
42           Use mflux
43           USE ghdtheory
44           use kintheory
45           Use cdist
46           Use des_rxns
47     
48           IMPLICIT NONE
49     
50     !-----------------------------------------------
51     ! Variables
52     !-----------------------------------------------
53     
54     !ambm
55           Allocate( A_m(DIMENSION_3, -3:3, 0:DIMENSION_M) )
56           Allocate( B_m(DIMENSION_3, 0:DIMENSION_M) )
57     
58     !cont
59           Allocate( DO_CONT(0:DIMENSION_M) )
60     
61     !drag
62           Allocate(  F_gs(DIMENSION_3, DIMENSION_M) )
63           Allocate(  F_ss(DIMENSION_3, 0:DIMENSION_LM) )
64     
65     !Off diagonal friction coefficient in HYS drag relation
66           IF(DRAG_TYPE_ENUM.EQ.HYS) &
67              Allocate(  beta_ij(DIMENSION_3, 0:DIMENSION_M, 0:DIMENSION_M) )
68     
69     !energy
70           Allocate(  HOR_g (DIMENSION_3) )
71           Allocate(  HOR_s (DIMENSION_3, DIMENSION_M) )
72           Allocate(  GAMA_gs (DIMENSION_3, DIMENSION_M) )
73           Allocate(  GAMA_Rg (DIMENSION_3) )
74           Allocate(  GAMA_Rs (DIMENSION_3, DIMENSION_M) )
75           Allocate(  T_Rg (DIMENSION_3) )
76           Allocate(  T_Rs (DIMENSION_3, DIMENSION_M) )
77     
78     !fldvar
79           Allocate(  EP_g (DIMENSION_3) )
80           Allocate(  epg_jfac (DIMENSION_3p) )
81           Allocate(  epg_ifac (DIMENSION_3p) )
82           Allocate(  eps_ifac (DIMENSION_3p, DIMENSION_M) )
83           Allocate(  EP_go (DIMENSION_3p) )
84           Allocate(  P_g (DIMENSION_3) )
85           Allocate(  P_go (DIMENSION_3p) )
86           Allocate(  RO_g (DIMENSION_3) )
87           Allocate(  RO_go (DIMENSION_3p) )
88           Allocate(  ROP_g (DIMENSION_3) )
89           Allocate(  ROP_go (DIMENSION_3p) )
90           Allocate(  RO_S (DIMENSION_3, DIMENSION_M) )
91           Allocate(  RO_So (DIMENSION_3p, DIMENSION_M) )
92           Allocate(  ROP_s (DIMENSION_3, DIMENSION_M) )
93           Allocate(  ROP_so (DIMENSION_3p, DIMENSION_M) )
94     
95           Allocate(  EP_SS(DIMENSION_3,DIMENSION_M,DIMENSION_N_S) )
96           Allocate(  ERR_ARRAY(DIMENSION_3,DIMENSION_M) )
97     
98           Allocate(  T_g (DIMENSION_3) )
99           Allocate(  T_s (DIMENSION_3, DIMENSION_M) )
100           Allocate(  T_go (DIMENSION_3p) )
101           Allocate(  T_so (DIMENSION_3p, DIMENSION_M) )
102           Allocate(  X_g (DIMENSION_3, DIMENSION_N_g) )
103           Allocate(  X_s (DIMENSION_3, DIMENSION_M, DIMENSION_N_s) )
104           Allocate(  X_go (DIMENSION_3p, DIMENSION_N_g) )
105           Allocate(  X_so (DIMENSION_3p, DIMENSION_M, DIMENSION_N_s) )
106           Allocate(  U_g (DIMENSION_3) )
107           Allocate(  U_go (DIMENSION_3p) )
108           Allocate(  U_s (DIMENSION_3, DIMENSION_M) )
109           Allocate(  U_so (DIMENSION_3p, DIMENSION_M) )
110           Allocate(  V_g (DIMENSION_3) )
111           Allocate(  V_go (DIMENSION_3p) )
112           Allocate(  V_s (DIMENSION_3, DIMENSION_M) )
113           Allocate(  V_so (DIMENSION_3p, DIMENSION_M) )
114           Allocate(  W_g (DIMENSION_3) )
115           Allocate(  W_go (DIMENSION_3p) )
116           Allocate(  W_s (DIMENSION_3, DIMENSION_M) )
117           Allocate(  W_so (DIMENSION_3p, DIMENSION_M) )
118           Allocate(  P_s (DIMENSION_3, DIMENSION_M) )
119           Allocate(  P_s_c (DIMENSION_3, DIMENSION_M) )
120           Allocate(  P_s_v (DIMENSION_3) )
121           Allocate(  P_s_f (DIMENSION_3) )
122           Allocate(  P_s_p (DIMENSION_3) )
123           Allocate(  P_star (DIMENSION_3) )
124           Allocate(  P_staro (DIMENSION_3p) )
125           Allocate(  THETA_m (DIMENSION_3, DIMENSION_M) )
126           Allocate(  THETA_mo (DIMENSION_3p, DIMENSION_M) )
127     
128           IF(K_Epsilon)THEN
129             Allocate(  K_Turb_G (DIMENSION_3) )
130             Allocate(  K_Turb_Go (DIMENSION_3p) )
131             Allocate(  E_Turb_G (DIMENSION_3) )
132             Allocate(  E_Turb_Go (DIMENSION_3p) )
133           ENDIF
134     
135           IF(DIMENSION_Scalar /= 0) THEN
136             Allocate(  Scalar (DIMENSION_3,  DIMENSION_Scalar) )
137             Allocate(  Scalaro (DIMENSION_3p, DIMENSION_Scalar) )
138           ENDIF
139     
140     
141     !pgcor
142           Allocate(  d_e(DIMENSION_3p, 0:DIMENSION_M) )
143           Allocate(  d_n(DIMENSION_3p, 0:DIMENSION_M) )
144           Allocate(  d_t(DIMENSION_3p, 0:DIMENSION_M) )
145           Allocate(  Pp_g(DIMENSION_3p) )
146           Allocate(  PHASE_4_P_g(DIMENSION_3p) )
147     
148     !physprop
149           Allocate(  MU_g (DIMENSION_3) )
150           Allocate(  C_pg (DIMENSION_3) )
151           Allocate(  C_ps (DIMENSION_3, DIMENSION_M) )
152           Allocate(  K_g (DIMENSION_3) )
153           Allocate(  K_s (DIMENSION_3, DIMENSION_M) )
154           Allocate(  Kth_s (DIMENSION_3, DIMENSION_M) )
155           Allocate(  Kphi_s (DIMENSION_3, DIMENSION_M) )
156           Allocate(  DIF_g (DIMENSION_3p, DIMENSION_N_g) )
157           Allocate(  DIF_s (DIMENSION_3p, DIMENSION_M, DIMENSION_N_s) )
158           Allocate(  MW_MIX_g (DIMENSION_3) )
159     
160     !pscor
161           Allocate(  e_e(DIMENSION_3p) )
162           Allocate(  e_n(DIMENSION_3p) )
163           Allocate(  e_t(DIMENSION_3p) )
164           Allocate(  K_cp(DIMENSION_3p) )
165           Allocate(  EPp(DIMENSION_3p) )
166           Allocate(  PHASE_4_P_s(DIMENSION_3p) )
167     
168     !residual
169           Allocate( RESID(NRESID, 0:DIMENSION_M) )
170           Allocate( MAX_RESID(NRESID, 0:DIMENSION_M) )
171           Allocate( IJK_RESID(NRESID, 0:DIMENSION_M) )
172           Allocate( NUM_RESID(NRESID, 0:DIMENSION_M) )
173           Allocate( DEN_RESID(NRESID, 0:DIMENSION_M) )
174           Allocate( RESID_PACK(NRESID*2*(DIMENSION_M+1)))
175     
176     !rxns
177           if (nRR .gt. 0) Allocate( ReactionRates(DIMENSION_3,nRR) )
178           Allocate(  R_gp (DIMENSION_3p, DIMENSION_N_g) )
179           Allocate(  R_sp (DIMENSION_3p, DIMENSION_M, DIMENSION_N_s) )
180           Allocate(  RoX_gc (DIMENSION_3p, DIMENSION_N_g) )
181           Allocate(  RoX_sc (DIMENSION_3p, DIMENSION_M, DIMENSION_N_s) )
182           Allocate(  SUM_R_g (DIMENSION_3p) )
183           Allocate(  SUM_R_s (DIMENSION_3p, DIMENSION_M) )
184           Allocate(  R_phase (DIMENSION_3, DIMENSION_LM+DIMENSION_M-1) )
185     
186     !scalars
187           IF(DIMENSION_Scalar /= 0) then
188             Allocate(  Scalar_c (DIMENSION_3p,  DIMENSION_Scalar) )
189             Allocate(  Scalar_p (DIMENSION_3p,  DIMENSION_Scalar) )
190             Allocate(  Dif_Scalar (DIMENSION_3p, DIMENSION_Scalar) )
191           ENDIF
192     
193     ! add by rong for dqmom
194           Allocate(  D_p  (DIMENSION_3, DIMENSION_M) )
195           Allocate(  D_po (DIMENSION_3, DIMENSION_M) )
196     !      Allocate(  ome  (DIMENSION_3, DIMENSION_M) )
197     !      Allocate(  ome_o (DIMENSION_3, DIMENSION_M) )
198           Allocate(  Source_a(DIMENSION_3, DIMENSION_M) )
199           Allocate(  S_bar( 0:DIM_Scalar2-1 ))
200           Allocate(  Matrix_a(DIM_Scalar2,DIM_scalar2))
201           Allocate(  Matrix_b(DIM_Scalar2,DIM_scalar2))
202           Allocate(  Matrix_c(DIM_Scalar2,DIM_scalar2))
203           Allocate(  Inv_a(DIM_Scalar2,DIM_scalar2))
204           Allocate(  A( 1:DIMENSION_Scalar))
205           Allocate(  omega(1:DIMENSION_m))
206           ALLocate(  beta_a( DIM_Scalar,DIM_Scalar))
207           ALLocate(  ystart( 1:DIM_Scalar2))
208     !     ALLocate(  g_a( 1:DIMENSION_Scalar))
209     
210     ! K-Epsilon Turbulence model
211           IF(K_Epsilon) THEN
212             Allocate(  K_Turb_G_c   (DIMENSION_3p) )
213             Allocate(  K_Turb_G_p   (DIMENSION_3p) )
214             Allocate(  Dif_K_Turb_G (DIMENSION_3p) )
215             Allocate(  E_Turb_G_c   (DIMENSION_3p) )
216             Allocate(  E_Turb_G_p   (DIMENSION_3p) )
217             Allocate(  Dif_E_Turb_G (DIMENSION_3p) )
218           ENDIF
219     
220     ! Simonin or Ahmadi model
221           IF(KT_TYPE_ENUM==SIMONIN_1996 .OR.&
222              KT_TYPE_ENUM==AHMADI_1995) THEN
223             Allocate(  K_12 (DIMENSION_3) )
224             Allocate(  Tau_12 (DIMENSION_3) )
225             Allocate(  Tau_1 (DIMENSION_3) )
226           ENDIF
227     
228     !tau_g
229           Allocate(  TAU_U_g(DIMENSION_3p) )
230           Allocate(  TAU_V_g(DIMENSION_3p) )
231           Allocate(  TAU_W_g(DIMENSION_3p) )
232           Allocate(  DF_gu(DIMENSION_3p, -3:3) )
233           Allocate(  DF_gv(DIMENSION_3p, -3:3) )
234           Allocate(  DF_gw(DIMENSION_3p, -3:3) )
235           Allocate(  CTAU_U_G(DIMENSION_3P))
236           Allocate(  CTAU_V_G(DIMENSION_3P))
237           Allocate(  CTAU_W_G(DIMENSION_3P))
238     
239     !tau_s
240           Allocate(  TAU_U_s(DIMENSION_3p, DIMENSION_M) )
241           Allocate(  TAU_V_s(DIMENSION_3p, DIMENSION_M) )
242           Allocate(  TAU_W_s(DIMENSION_3p, DIMENSION_M) )
243     
244     !tmp_array
245           Allocate(  Array1(DIMENSION_3) )
246           Allocate(  Array2(DIMENSION_3) )
247           Allocate(  Array3(DIMENSION_3) )
248           Allocate(  Array4(DIMENSION_3) )
249           Allocate(  Array1i(DIMENSION_3) )
250           Allocate(  Array1c(DIMENSION_3) )
251           Allocate(  TMP4(DIMENSION_4) )
252           Allocate(  ArrayLM (DIMENSION_3, DIMENSION_LM) )  !S. Dartevelle, LANL, Feb. 2004
253     
254     
255     !tmp_array1
256           Allocate(  Arraym1(DIMENSION_3, DIMENSION_M) )
257     
258     !trace
259           Allocate(  trD_s_C (DIMENSION_3, DIMENSION_M) )
260           Allocate(  trD_s2 (DIMENSION_3, DIMENSION_M) )
261           Allocate(  trD_s_Co (DIMENSION_3, DIMENSION_M) )
262           Allocate(  trD_s_Co2 (DIMENSION_3, DIMENSION_M) )
263     !visc_g
264           Allocate(  trD_g(DIMENSION_3) )
265           Allocate(  MU_gt (DIMENSION_3) )
266           Allocate(  EPMU_gt (DIMENSION_3p) )
267           Allocate(  LAMBDA_gt (DIMENSION_3p) )
268           Allocate(  EPLAMBDA_gt (DIMENSION_3) )
269           Allocate(  L_scale (DIMENSION_3) )
270     
271     !visc_s
272           Allocate(  MU_s (DIMENSION_3, DIMENSION_M) )
273           Allocate(  EPMU_s (DIMENSION_3p, DIMENSION_M) )
274           Allocate(  LAMBDA_s (DIMENSION_3, DIMENSION_M) )
275           Allocate(  EPLAMBDA_s (DIMENSION_3p, DIMENSION_M) )
276           Allocate(  ALPHA_s (DIMENSION_3, DIMENSION_M) )
277           Allocate(  MU_s_c (DIMENSION_3, DIMENSION_M) )
278           Allocate(  LAMBDA_s_c (DIMENSION_3, DIMENSION_M) )
279           Allocate(  LAMBDA_s_v (DIMENSION_3) )
280           Allocate(  LAMBDA_s_f (DIMENSION_3) )
281           Allocate(  LAMBDA_s_p (DIMENSION_3) )
282           Allocate(  MU_s_v (DIMENSION_3) )
283           Allocate(  MU_s_f (DIMENSION_3) )
284           Allocate(  MU_s_p (DIMENSION_3) )
285           Allocate(  MU_b_v (DIMENSION_3) )
286           Allocate(  EP_star_array (DIMENSION_3) )
287           Allocate(  EP_g_blend_start (DIMENSION_3) )
288           Allocate(  EP_g_blend_end (DIMENSION_3) )
289           Allocate(  trD_s(DIMENSION_3, DIMENSION_M) )
290           Allocate(  I2_devD_s (DIMENSION_3) )
291           Allocate(  TrM_s (DIMENSION_3) )
292           Allocate(  TrDM_s (DIMENSION_3) )
293     
294     !xsi_array
295           Allocate(  Xsi_e(DIMENSION_3) )
296           Allocate(  Xsi_n(DIMENSION_3) )
297           Allocate(  Xsi_t(DIMENSION_3) )
298     
299     !shear quantities
300           Allocate(  VSH(DIMENSION_3) )
301           Allocate(  VSHE(DIMENSION_3) )
302     
303     
304     !mflux
305           Allocate( Flux_gE(DIMENSION_3p) )
306           Allocate( Flux_sE(DIMENSION_3p, DIMENSION_M) )
307           Allocate( Flux_gN(DIMENSION_3p) )
308           Allocate( Flux_sN(DIMENSION_3p, DIMENSION_M) )
309           Allocate( Flux_gT(DIMENSION_3p) )
310           Allocate( Flux_sT(DIMENSION_3p, DIMENSION_M) )
311           IF(ADDED_MASS) THEN ! Fluxes calculated for just one 'bubble' species (M=M_AM)
312              Allocate( Flux_gSE(DIMENSION_3p) )
313              Allocate( Flux_sSE(DIMENSION_3p) )
314              Allocate( Flux_gSN(DIMENSION_3p) )
315              Allocate( Flux_sSN(DIMENSION_3p) )
316              Allocate( Flux_gST(DIMENSION_3p) )
317              Allocate( Flux_sST(DIMENSION_3p) )
318           ENDIF
319           Allocate( ROP_gE(DIMENSION_3p) )
320           Allocate( ROP_sE(DIMENSION_3p, DIMENSION_M) )
321           Allocate( ROP_gN(DIMENSION_3p) )
322           Allocate( ROP_sN(DIMENSION_3p, DIMENSION_M) )
323           Allocate( ROP_gT(DIMENSION_3p) )
324           Allocate( ROP_sT(DIMENSION_3p, DIMENSION_M) )
325     
326     ! allocate variables for GHD Theory
327           IF (KT_TYPE_ENUM == GHD_2007) THEN
328             Allocate(  Flux_nE(DIMENSION_3p) )
329             Allocate(  Flux_nN(DIMENSION_3p) )
330             Allocate(  Flux_nT(DIMENSION_3p) )
331             Allocate(  Zeta0(DIMENSION_3p) )   ! zeroth rate of cooling
332             Allocate(  ZetaU(DIMENSION_3p) )   ! 1st order cooling rate transport coefficient
333             Allocate(  DiT(DIMENSION_3p, DIMENSION_M) )   ! thermal diffusivity
334             Allocate(  DijF(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )   ! mass mobility
335             Allocate(  Lij(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )   ! thermal mobility
336             Allocate(  Dij(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )   ! ordinary diffusion
337             Allocate(  DijQ(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )   ! Dufour coeff.
338             Allocate(  JoiX(DIMENSION_3p, DIMENSION_M) )   ! X- species mass flux
339             Allocate(  JoiY(DIMENSION_3p, DIMENSION_M) )   ! Y- species mass flux
340             Allocate(  JoiZ(DIMENSION_3p, DIMENSION_M) )   ! Z- species mass flux
341             Allocate(  FiX(DIMENSION_3p, DIMENSION_M) )   ! X- external force
342             Allocate(  FiY(DIMENSION_3p, DIMENSION_M) )   ! Y- external force
343             Allocate(  FiZ(DIMENSION_3p, DIMENSION_M) )   ! Z- external force
344             Allocate(  FiXvel(DIMENSION_3p, DIMENSION_M) )   ! X- external force
345             Allocate(  FiYvel(DIMENSION_3p, DIMENSION_M) )   ! Y- external force
346             Allocate(  FiZvel(DIMENSION_3p, DIMENSION_M) )   ! Z- external force
347             Allocate(  DELTAU(DIMENSION_3p, DIMENSION_M) )
348             Allocate(  DELTAV(DIMENSION_3p, DIMENSION_M) )
349             Allocate(  DELTAW(DIMENSION_3p, DIMENSION_M) )
350             Allocate(  dragFx(DIMENSION_3p, DIMENSION_M) )   ! X- drag force
351             Allocate(  dragFy(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
352             Allocate(  dragFz(DIMENSION_3p, DIMENSION_M) )   ! Z- drag force
353             Allocate(  dragFxflux(DIMENSION_3p, DIMENSION_M) )   ! X- drag force
354             Allocate(  dragFyflux(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
355             Allocate(  dragFzflux(DIMENSION_3p, DIMENSION_M) )   ! Z- drag force
356             Allocate(  FiMinusDragX(DIMENSION_3p, DIMENSION_M) )   ! X- drag force
357             Allocate(  JoiMinusDragX(DIMENSION_3p, DIMENSION_M) )   ! X- drag force
358             Allocate(  FiMinusDragY(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
359             Allocate(  JoiMinusDragY(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
360             Allocate(  FiMinusDragZ(DIMENSION_3p, DIMENSION_M) )   ! Z- drag force
361             Allocate(  JoiMinusDragZ(DIMENSION_3p, DIMENSION_M) )   ! Z- drag force
362             Allocate(  beta_cell_X(DIMENSION_3p, DIMENSION_M) )   ! X- drag force
363             Allocate(  beta_cell_Y(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
364             Allocate(  beta_cell_Z(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
365             Allocate(  beta_ij_cell_X(DIMENSION_3p, DIMENSION_M,DIMENSION_M) )   ! X- drag force
366             Allocate(  beta_ij_cell_Y(DIMENSION_3p, DIMENSION_M,DIMENSION_M) )   ! Y- drag force
367             Allocate(  beta_ij_cell_Z(DIMENSION_3p, DIMENSION_M,DIMENSION_M) )   ! Y- drag force
368             Allocate(  DEL_DOT_J(DIMENSION_3p, DIMENSION_M) )
369             Allocate(  DiT_HarmE(DIMENSION_3p) )
370             Allocate(  DiT_HarmN(DIMENSION_3p) )
371             Allocate(  DiT_HarmT(DIMENSION_3p) )
372             Allocate(  Dij_HarmE(DIMENSION_3p, DIMENSION_M) )
373             Allocate(  Dij_HarmN(DIMENSION_3p, DIMENSION_M) )
374             Allocate(  Dij_HarmT(DIMENSION_3p, DIMENSION_M) )
375             Allocate(  DijF_HarmE(DIMENSION_3p, DIMENSION_M) )
376             Allocate(  DijF_HarmN(DIMENSION_3p, DIMENSION_M) )
377             Allocate(  DijF_HarmT(DIMENSION_3p, DIMENSION_M) )
378           ENDIF
379     
380     
381     ! We need to set this even when KT_TYPE is not set to IA_NONEP - at
382     ! least in the current version of the code and needs to be revisited
383           Allocate(  KTMOM_U_s(DIMENSION_3p, DIMENSION_M) )
384           Allocate(  KTMOM_V_s(DIMENSION_3p, DIMENSION_M) )
385           Allocate(  KTMOM_W_s(DIMENSION_3p, DIMENSION_M) )
386     
387     ! allocate variables for Iddir & Arastoopour (2005) kinetic theory
388     ! EDvel_sM_ip & EDT_s_ip are also used for Garzy & Dufty (1999) kinetic theory
389           IF (KT_TYPE_ENUM == IA_2005) THEN
390              Allocate(  trD_s2_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
391              Allocate(  MU_sM_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
392              Allocate(  MU_sL_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
393              Allocate(  XI_sM_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
394              Allocate(  XI_sL_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
395              Allocate(  Fnu_s_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
396              Allocate(  FT_sM_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
397              Allocate(  FT_sL_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
398              Allocate(  Kth_sL_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
399              Allocate(  Knu_sM_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
400              Allocate(  Knu_sL_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
401              Allocate(  Kvel_s_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
402              Allocate(  EDvel_sL_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
403              Allocate(  ED_ss_ip(DIMENSION_3p, 0:DIMENSION_LM) )
404           ENDIF
405           IF (KT_TYPE_ENUM == GTSH_2012) THEN
406              Allocate(  A2_gtsh(DIMENSION_3) )
407              Allocate(  xsi_gtsh(DIMENSION_3) )
408           ENDIF
409           IF (KT_TYPE_ENUM == IA_2005 .OR. &
410               KT_TYPE_ENUM == GD_1999 .OR. &
411               KT_TYPE_ENUM == GTSH_2012) THEN
412              Allocate(  EDT_s_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
413              Allocate(  EDvel_sM_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
414           ENDIF
415     
416     
417           RETURN
418           END SUBROUTINE ALLOCATE_ARRAYS
419     
420     
421     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
422     !                                                                      !
423     !  Module name: ALLOCATE_ARRAYS_GEOMETRY                               !
424     !  Author: M. Syamlal                                 Date: 21-JAN-92  !
425     !                                                                      !
426     !  Purpose: Calculate X, X_E,  oX, oX_E                                !
427     !                                                                      !
428     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
429           SUBROUTINE ALLOCATE_ARRAYS_GEOMETRY
430     
431     ! Global Variables:
432     !---------------------------------------------------------------------//
433     ! Domain decomposition and dimensions
434           use geometry, only: oDX, oDX_E
435           use geometry, only: oDZ, oDZ_T
436           use geometry, only: oDY, oDY_N
437           use geometry, only: X, X_E, oX, oX_E, cyl_X, cyl_X_E
438           use geometry, only: Z, Z_T
439     ! Averaging factors.
440           use geometry, only: FX_E, FX_E_bar, FX, FX_bar
441           use geometry, only: FY_N, FY_N_bar
442           use geometry, only: FZ_T, FZ_T_bar
443     ! Domain flags.
444           use geometry, only: ICBC_FLAG
445           use geometry, only: FLAG, FLAG3
446           use geometry, only: FLAG_E, FLAG_N, FLAG_T
447     ! Domain volumes and areas.
448           use geometry, only: VOL, VOL_SURR, AYZ, AXZ, AXY! Scalar grid
449           use geometry, only: VOL_U, AYZ_U, AXZ_U, AXY_U  ! X-Momentum
450           use geometry, only: VOL_V, AYZ_V, AXZ_V, AXY_V  ! Y-Momentum
451           use geometry, only: VOL_W, AYZ_W, AXZ_W, AXY_W  ! Z-Momentum
452     ! Axis decomposition
453           USE param, only: DIMENSION_I, DIMENSION_J, DIMENSION_K
454           USE param, only: DIMENSION_3, DIMENSION_4
455           USE param, only: DIMENSION_3L, DIMENSION_3P
456     ! Flag for POST_MFIX
457           use cdist, only: bDoing_postmfix
458     
459     ! Module procedures
460     !---------------------------------------------------------------------//
461           use mpi_utility, only: GLOBAL_ALL_SUM
462           use error_manager
463     
464           IMPLICIT NONE
465     
466     ! Local Variables:
467     !---------------------------------------------------------------------//
468     ! Error Flag
469           INTEGER :: IER
470     ! Flag indicating that the arrays were previously allocated.
471           INTEGER, SAVE :: CALLED = -1
472     !......................................................................!
473     
474           CALLED = CALLED + 1
475     
476           IF(CALLED > 0) THEN
477              IF(.NOT.bDoing_postmfix) THEN
478                 RETURN
479              ELSEIF(mod(CALLED,2) /= 0) THEN
480                 RETURN
481              ENDIF
482           ENDIF
483     
484     ! Initialize the error manager.
485           CALL INIT_ERR_MSG("ALLOCATE_ARRAYS_GEOMETRY")
486     
487     ! Allocate geometry components related to the mesh. Check the
488     ! allocation error status and abort if any failure is detected.
489           ALLOCATE( X     (0:DIMENSION_I), STAT=IER)
490           ALLOCATE( cyl_X     (0:DIMENSION_I), STAT=IER)
491           ALLOCATE( X_E   (0:DIMENSION_I), STAT=IER)
492           ALLOCATE( cyl_X_E   (0:DIMENSION_I), STAT=IER)
493           ALLOCATE( oX    (0:DIMENSION_I), STAT=IER)
494           ALLOCATE( oX_E  (0:DIMENSION_I), STAT=IER)
495           ALLOCATE( oDX   (0:DIMENSION_I), STAT=IER)
496           ALLOCATE( oDX_E (0:DIMENSION_I), STAT=IER)
497           IF(IER /= 0) goto 500
498     
499           ALLOCATE( oDY   (0:DIMENSION_J), STAT=IER )
500           ALLOCATE( oDY_N (0:DIMENSION_J), STAT=IER )
501           IF(IER /= 0) goto 500
502     
503           ALLOCATE( Z     (0:DIMENSION_K), STAT=IER )
504           ALLOCATE( Z_T   (0:DIMENSION_K), STAT=IER )
505           ALLOCATE( oDZ   (0:DIMENSION_K), STAT=IER )
506           ALLOCATE( oDZ_T (0:DIMENSION_K), STAT=IER )
507           IF(IER /= 0) goto 500
508     
509           ALLOCATE( FX     (0:DIMENSION_I), STAT=IER)
510           ALLOCATE( FX_bar (0:DIMENSION_I), STAT=IER)
511           IF(IER /= 0) goto 500
512     
513           ALLOCATE( FX_E     (0:DIMENSION_I), STAT=IER)
514           ALLOCATE( FX_E_bar (0:DIMENSION_I), STAT=IER)
515           IF(IER /= 0) goto 500
516     
517           ALLOCATE( FY_N     (0:DIMENSION_J), STAT=IER )
518           ALLOCATE( FY_N_bar (0:DIMENSION_J), STAT=IER )
519           IF(IER /= 0) goto 500
520     
521           ALLOCATE( FZ_T     (0:DIMENSION_K), STAT=IER )
522           ALLOCATE( FZ_T_bar (0:DIMENSION_K), STAT=IER )
523           IF(IER /= 0) goto 500
524     
525     ! Flags for the scalar grid.
526           Allocate( FLAG  (DIMENSION_3), STAT=IER )
527           Allocate( FLAG3 (DIMENSION_4), STAT=IER )
528           IF(IER /= 0) goto 500
529     
530     ! Flags for the momentum grids.
531           Allocate( FLAG_E (DIMENSION_3), STAT=IER )
532           Allocate( FLAG_N (DIMENSION_3), STAT=IER )
533           Allocate( FLAG_T (DIMENSION_3), STAT=IER )
534           IF(IER /= 0) goto 500
535     
536     ! Text flags for scalar grid.
537           Allocate( ICBC_FLAG (DIMENSION_3L), STAT=IER )
538           IF(IER /= 0) goto 500
539     
540     ! Volume and face-areas of scalar grid.
541           Allocate( VOL (DIMENSION_3),  STAT=IER )
542           Allocate( AYZ (DIMENSION_3P), STAT=IER )
543           Allocate( AXZ (DIMENSION_3P), STAT=IER )
544           Allocate( AXY (DIMENSION_3P), STAT=IER )
545           IF(IER /= 0) goto 500
546     
547           ! total volume of each cell's surrounding stencil cells
548           Allocate( VOL_SURR (DIMENSION_3), STAT=IER )
549     
550     ! Volume and face-areas of X-Momentumn grid.
551           Allocate( VOL_U (DIMENSION_3),  STAT=IER )
552           Allocate( AYZ_U (DIMENSION_3P), STAT=IER )
553           Allocate( AXZ_U (DIMENSION_3P), STAT=IER )
554           Allocate( AXY_U (DIMENSION_3P), STAT=IER )
555           IF(IER /= 0) goto 500
556     
557     ! Volume and face-areas of Y-Momentum grid.
558           Allocate( VOL_V (DIMENSION_3),  STAT=IER )
559           Allocate( AYZ_V (DIMENSION_3P), STAT=IER )
560           Allocate( AXZ_V (DIMENSION_3P), STAT=IER )
561           Allocate( AXY_V (DIMENSION_3P), STAT=IER )
562           IF(IER /= 0) goto 500
563     
564     ! Volume and face-areas of Z-Momentum grid.
565           Allocate( VOL_W (DIMENSION_3),  STAT=IER )
566           Allocate( AYZ_W (DIMENSION_3P), STAT=IER )
567           Allocate( AXZ_W (DIMENSION_3P), STAT=IER )
568           Allocate( AXY_W (DIMENSION_3P), STAT=IER )
569           IF(IER /= 0) goto 500
570     
571     ! Collect the error flags from all ranks. If all allocaitons were
572     ! successfull, do nothing. Otherwise, flag the error and abort.
573     ! Note that the allocation status is checked in groups. This can
574     ! be increase if tracking the source of an allocation failure.
575       500 CALL GLOBAL_ALL_SUM(IER)
576     
577           IF(IER /= 0) THEN
578              WRITE(ERR_MSG,1100)
579              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
580           ENDIF
581     
582      1100 FORMAT('Error 1100: Failure during array allocation.')
583     
584           CALL FINL_ERR_MSG
585     
586           RETURN
587           END SUBROUTINE ALLOCATE_ARRAYS_GEOMETRY
588     
589     
590     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
591     !                                                                      !
592     !  Module name: ALLOCATE_ARRAYS_INCREMENTS                             !
593     !  Author: M. Syamlal, W. Rogers                      Date: 10-DEC-91  !
594     !                                                                      !
595     !  Purpose: The purpose of this module is to create increments to be   !
596     !           stored in the array STORE_INCREMENT which will be added    !
597     !           to cell index ijk to find the effective indices of its     !
598     !           neighbors. These increments are found using the 'class'    !
599     !           of cell ijk. The class is determined based on the          !
600     !           neighboring cell type, i.e. wall or fluid.                 !
601     !                                                                      !
602     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
603           SUBROUTINE ALLOCATE_ARRAYS_INCREMENTS
604     
605           USE param
606           USE param1
607           USE indices
608           USE geometry
609           USE compar
610           USE physprop
611           USE fldvar
612           USE funits
613     
614     ! Module procedures
615     !---------------------------------------------------------------------//
616           use mpi_utility, only: GLOBAL_ALL_SUM
617           use error_manager
618     
619     
620           IMPLICIT NONE
621     
622     
623     ! Local Variables:
624     !---------------------------------------------------------------------//
625     ! Error flag.
626           INTEGER :: IER
627     ! Flag indicating that the arrays were previously allocated.
628           LOGICAL, SAVE :: ALREADY_ALLOCATED = .FALSE.
629     !......................................................................!
630     
631           IF(ALREADY_ALLOCATED) RETURN
632     
633     ! Initialize the error manager.
634           CALL INIT_ERR_MSG("ALLOCATE_ARRAYS_INCREMENTS")
635     
636     ! Allocate increment arrays and report an allocation errors.
637           Allocate( I_OF (DIMENSION_3), STAT=IER)
638           Allocate( J_OF (DIMENSION_3), STAT=IER)
639           Allocate( K_OF (DIMENSION_3), STAT=IER)
640           IF(IER /= 0) goto 500
641     
642           Allocate( Im1 (0:DIMENSION_I), STAT=IER)
643           Allocate( Ip1 (0:DIMENSION_I), STAT=IER)
644           IF(IER /= 0) goto 500
645     
646           Allocate( Jm1 (0:DIMENSION_J), STAT=IER)
647           Allocate( Jp1 (0:DIMENSION_J), STAT=IER)
648           IF(IER /= 0) goto 500
649     
650           Allocate( Km1 (0:DIMENSION_K), STAT=IER)
651           Allocate( Kp1 (0:DIMENSION_K), STAT=IER)
652           IF(IER /= 0) goto 500
653     
654           Allocate( STORE_LM (DIMENSION_M, DIMENSION_M), STAT=IER)
655           Allocate( CELL_CLASS (DIMENSION_3), STAT=IER)
656           IF(IER /= 0) goto 500
657     
658     
659     ! Allocate increment arrays and report an allocation errors.
660           Allocate( I3_OF (DIMENSION_4), STAT=IER)
661           Allocate( J3_OF (DIMENSION_4), STAT=IER)
662           Allocate( K3_OF (DIMENSION_4), STAT=IER)
663           IF(IER /= 0) goto 500
664     
665           Allocate( Im1_3 (-1:DIMENSION_I+1), STAT=IER)
666           Allocate( Ip1_3 (-1:DIMENSION_I+1), STAT=IER)
667           IF(IER /= 0) goto 500
668     
669           Allocate( Jm1_3 (-1:DIMENSION_J+1), STAT=IER)
670           Allocate( Jp1_3 (-1:DIMENSION_J+1), STAT=IER)
671           IF(IER /= 0) goto 500
672     
673           Allocate( Km1_3 (-1:DIMENSION_K+1), STAT=IER)
674           Allocate( Kp1_3 (-1:DIMENSION_K+1), STAT=IER)
675           IF(IER /= 0) goto 500
676     
677           Allocate( CELL_CLASS3 (DIMENSION_4), STAT=IER)
678           IF(IER /= 0) goto 500
679     
680     
681     ! Collect the error flags from all ranks. If all allocaitons were
682     ! successfull, do nothing. Otherwise, flag the error and abort.
683     ! Note that the allocation status is checked in groups. This can
684     ! be increase if tracking the source of an allocation failure.
685       500 CALL GLOBAL_ALL_SUM(IER)
686     
687           IF(IER /= 0) THEN
688              WRITE(ERR_MSG,1100)
689              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
690           ENDIF
691     
692      1100 FORMAT('Error 1100: Failure during array allocation.')
693     
694           ALREADY_ALLOCATED = .TRUE.
695     
696           CALL FINL_ERR_MSG
697     
698           RETURN
699           END SUBROUTINE ALLOCATE_ARRAYS_INCREMENTS
700