File: N:\mfix\model\allocate_arrays.f

1     ! -*- f90 -*-
2     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
3     !                                                                      C
4     !  Subroutinee: ALLOCATE_ARRAYS                                        C
5     !  Purpose: allocate arrays                                            C
6     !                                                                      C
7     !  Author: M. Syamlal                                Date: 17-DEC-98   C
8     !  Reviewer:                                                           C
9     !                                                                      C
10     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
11     
12           SUBROUTINE ALLOCATE_ARRAYS
13     
14     !-----------------------------------------------
15     ! Modules
16     !-----------------------------------------------
17           use ambm
18           use cdist
19           use cont
20           use des_rxns
21           use drag
22           use energy
23           use fldvar
24           use generate_particles, only: particle_count
25           use geometry
26           use ghdtheory
27           use indices
28           use kintheory
29           use mflux
30           use param
31           use param1
32           use pgcor
33           use physprop
34           use pscor
35           use residual
36           use run
37           use rxns
38           use scalars
39           use iterate, only: errorpercent
40           use tau_g
41           use tau_s
42           use trace
43           use turb
44           use visc_g
45           use visc_s
46           use vshear
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     ! generate_particles / particle_count
245           Allocate(  PARTICLE_COUNT(DIMENSION_3) )
246     
247     !trace
248           Allocate(  trD_s_C (DIMENSION_3, DIMENSION_M) )
249           Allocate(  trD_s2 (DIMENSION_3, DIMENSION_M) )
250           Allocate(  trD_s_Co (DIMENSION_3, DIMENSION_M) )
251           Allocate(  trD_s_Co2 (DIMENSION_3, DIMENSION_M) )
252     !visc_g
253           Allocate(  trD_g(DIMENSION_3) )
254           Allocate(  MU_gt (DIMENSION_3) )
255           Allocate(  EPMU_gt (DIMENSION_3p) )
256           Allocate(  LAMBDA_gt (DIMENSION_3p) )
257           Allocate(  EPLAMBDA_gt (DIMENSION_3) )
258           Allocate(  L_scale (DIMENSION_3) )
259     
260     !visc_s
261           Allocate(  MU_s (DIMENSION_3, DIMENSION_M) )
262           Allocate(  EPMU_s (DIMENSION_3p, DIMENSION_M) )
263           Allocate(  LAMBDA_s (DIMENSION_3, DIMENSION_M) )
264           Allocate(  EPLAMBDA_s (DIMENSION_3p, DIMENSION_M) )
265           Allocate(  ALPHA_s (DIMENSION_3, DIMENSION_M) )
266           Allocate(  MU_s_c (DIMENSION_3, DIMENSION_M) )
267           Allocate(  LAMBDA_s_c (DIMENSION_3, DIMENSION_M) )
268           Allocate(  LAMBDA_s_v (DIMENSION_3) )
269           Allocate(  LAMBDA_s_f (DIMENSION_3) )
270           Allocate(  LAMBDA_s_p (DIMENSION_3) )
271           Allocate(  MU_s_v (DIMENSION_3) )
272           Allocate(  MU_s_f (DIMENSION_3) )
273           Allocate(  MU_s_p (DIMENSION_3) )
274           Allocate(  MU_b_v (DIMENSION_3) )
275           Allocate(  EP_star_array (DIMENSION_3) )
276           Allocate(  EP_g_blend_start (DIMENSION_3) )
277           Allocate(  EP_g_blend_end (DIMENSION_3) )
278           Allocate(  trD_s(DIMENSION_3, DIMENSION_M) )
279           Allocate(  I2_devD_s (DIMENSION_3) )
280           Allocate(  TrM_s (DIMENSION_3) )
281           Allocate(  TrDM_s (DIMENSION_3) )
282     
283     !shear quantities
284           Allocate(  VSH(DIMENSION_3) )
285           Allocate(  VSHE(DIMENSION_3) )
286     
287     !mflux
288           Allocate( Flux_gE(DIMENSION_3p) )
289           Allocate( Flux_sE(DIMENSION_3p, DIMENSION_M) )
290           Allocate( Flux_gN(DIMENSION_3p) )
291           Allocate( Flux_sN(DIMENSION_3p, DIMENSION_M) )
292           Allocate( Flux_gT(DIMENSION_3p) )
293           Allocate( Flux_sT(DIMENSION_3p, DIMENSION_M) )
294           IF(ADDED_MASS) THEN ! Fluxes calculated for just one 'bubble' species (M=M_AM)
295              Allocate( Flux_gSE(DIMENSION_3p) )
296              Allocate( Flux_sSE(DIMENSION_3p) )
297              Allocate( Flux_gSN(DIMENSION_3p) )
298              Allocate( Flux_sSN(DIMENSION_3p) )
299              Allocate( Flux_gST(DIMENSION_3p) )
300              Allocate( Flux_sST(DIMENSION_3p) )
301           ENDIF
302           Allocate( ROP_gE(DIMENSION_3p) )
303           Allocate( ROP_sE(DIMENSION_3p, DIMENSION_M) )
304           Allocate( ROP_gN(DIMENSION_3p) )
305           Allocate( ROP_sN(DIMENSION_3p, DIMENSION_M) )
306           Allocate( ROP_gT(DIMENSION_3p) )
307           Allocate( ROP_sT(DIMENSION_3p, DIMENSION_M) )
308     
309     ! allocate variables for GHD Theory
310           IF (KT_TYPE_ENUM == GHD_2007) THEN
311             Allocate(  Flux_nE(DIMENSION_3p) )
312             Allocate(  Flux_nN(DIMENSION_3p) )
313             Allocate(  Flux_nT(DIMENSION_3p) )
314             Allocate(  Zeta0(DIMENSION_3p) )   ! zeroth rate of cooling
315             Allocate(  ZetaU(DIMENSION_3p) )   ! 1st order cooling rate transport coefficient
316             Allocate(  DiT(DIMENSION_3p, DIMENSION_M) )   ! thermal diffusivity
317             Allocate(  DijF(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )   ! mass mobility
318             Allocate(  Lij(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )   ! thermal mobility
319             Allocate(  Dij(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )   ! ordinary diffusion
320             Allocate(  DijQ(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )   ! Dufour coeff.
321             Allocate(  JoiX(DIMENSION_3p, DIMENSION_M) )   ! X- species mass flux
322             Allocate(  JoiY(DIMENSION_3p, DIMENSION_M) )   ! Y- species mass flux
323             Allocate(  JoiZ(DIMENSION_3p, DIMENSION_M) )   ! Z- species mass flux
324             Allocate(  FiX(DIMENSION_3p, DIMENSION_M) )   ! X- external force
325             Allocate(  FiY(DIMENSION_3p, DIMENSION_M) )   ! Y- external force
326             Allocate(  FiZ(DIMENSION_3p, DIMENSION_M) )   ! Z- external force
327             Allocate(  FiXvel(DIMENSION_3p, DIMENSION_M) )   ! X- external force
328             Allocate(  FiYvel(DIMENSION_3p, DIMENSION_M) )   ! Y- external force
329             Allocate(  FiZvel(DIMENSION_3p, DIMENSION_M) )   ! Z- external force
330             Allocate(  DELTAU(DIMENSION_3p, DIMENSION_M) )
331             Allocate(  DELTAV(DIMENSION_3p, DIMENSION_M) )
332             Allocate(  DELTAW(DIMENSION_3p, DIMENSION_M) )
333             Allocate(  dragFx(DIMENSION_3p, DIMENSION_M) )   ! X- drag force
334             Allocate(  dragFy(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
335             Allocate(  dragFz(DIMENSION_3p, DIMENSION_M) )   ! Z- drag force
336             Allocate(  dragFxflux(DIMENSION_3p, DIMENSION_M) )   ! X- drag force
337             Allocate(  dragFyflux(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
338             Allocate(  dragFzflux(DIMENSION_3p, DIMENSION_M) )   ! Z- drag force
339             Allocate(  FiMinusDragX(DIMENSION_3p, DIMENSION_M) )   ! X- drag force
340             Allocate(  JoiMinusDragX(DIMENSION_3p, DIMENSION_M) )   ! X- drag force
341             Allocate(  FiMinusDragY(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
342             Allocate(  JoiMinusDragY(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
343             Allocate(  FiMinusDragZ(DIMENSION_3p, DIMENSION_M) )   ! Z- drag force
344             Allocate(  JoiMinusDragZ(DIMENSION_3p, DIMENSION_M) )   ! Z- drag force
345             Allocate(  beta_cell_X(DIMENSION_3p, DIMENSION_M) )   ! X- drag force
346             Allocate(  beta_cell_Y(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
347             Allocate(  beta_cell_Z(DIMENSION_3p, DIMENSION_M) )   ! Y- drag force
348             Allocate(  beta_ij_cell_X(DIMENSION_3p, DIMENSION_M,DIMENSION_M) )   ! X- drag force
349             Allocate(  beta_ij_cell_Y(DIMENSION_3p, DIMENSION_M,DIMENSION_M) )   ! Y- drag force
350             Allocate(  beta_ij_cell_Z(DIMENSION_3p, DIMENSION_M,DIMENSION_M) )   ! Y- drag force
351             Allocate(  DEL_DOT_J(DIMENSION_3p, DIMENSION_M) )
352             Allocate(  DiT_HarmE(DIMENSION_3p) )
353             Allocate(  DiT_HarmN(DIMENSION_3p) )
354             Allocate(  DiT_HarmT(DIMENSION_3p) )
355             Allocate(  Dij_HarmE(DIMENSION_3p, DIMENSION_M) )
356             Allocate(  Dij_HarmN(DIMENSION_3p, DIMENSION_M) )
357             Allocate(  Dij_HarmT(DIMENSION_3p, DIMENSION_M) )
358             Allocate(  DijF_HarmE(DIMENSION_3p, DIMENSION_M) )
359             Allocate(  DijF_HarmN(DIMENSION_3p, DIMENSION_M) )
360             Allocate(  DijF_HarmT(DIMENSION_3p, DIMENSION_M) )
361           ENDIF
362     
363     
364     ! We need to set this even when KT_TYPE is not set to IA_NONEP - at
365     ! least in the current version of the code and needs to be revisited
366           Allocate(  KTMOM_U_s(DIMENSION_3p, DIMENSION_M) )
367           Allocate(  KTMOM_V_s(DIMENSION_3p, DIMENSION_M) )
368           Allocate(  KTMOM_W_s(DIMENSION_3p, DIMENSION_M) )
369     
370     ! allocate variables for Iddir & Arastoopour (2005) kinetic theory
371     ! EDvel_sM_ip & EDT_s_ip are also used for Garzy & Dufty (1999) kinetic theory
372           IF (KT_TYPE_ENUM == IA_2005) THEN
373              Allocate(  trD_s2_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
374              Allocate(  MU_sM_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
375              Allocate(  MU_sL_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
376              Allocate(  XI_sM_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
377              Allocate(  XI_sL_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
378              Allocate(  Fnu_s_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
379              Allocate(  FT_sM_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
380              Allocate(  FT_sL_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
381              Allocate(  Kth_sL_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
382              Allocate(  Knu_sM_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
383              Allocate(  Knu_sL_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
384              Allocate(  Kvel_s_ip(DIMENSION_3, DIMENSION_M, DIMENSION_M) )
385              Allocate(  EDvel_sL_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
386              Allocate(  ED_ss_ip(DIMENSION_3p, 0:DIMENSION_LM) )
387           ENDIF
388           IF (KT_TYPE_ENUM == GTSH_2012) THEN
389              Allocate(  A2_gtsh(DIMENSION_3) )
390              Allocate(  xsi_gtsh(DIMENSION_3) )
391           ENDIF
392           IF (KT_TYPE_ENUM == IA_2005 .OR. &
393               KT_TYPE_ENUM == GD_1999 .OR. &
394               KT_TYPE_ENUM == GTSH_2012) THEN
395              Allocate(  EDT_s_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
396              Allocate(  EDvel_sM_ip(DIMENSION_3p, DIMENSION_M, DIMENSION_M) )
397           ENDIF
398     
399           Allocate(errorpercent(0:MMAX))
400     
401           RETURN
402           END SUBROUTINE ALLOCATE_ARRAYS
403     
404     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
405     !                                                                      !
406     !  Module name: ALLOCATE_ARRAYS_GEOMETRY                               !
407     !  Author: M. Syamlal                                 Date: 21-JAN-92  !
408     !                                                                      !
409     !  Purpose: Calculate X, X_E,  oX, oX_E                                !
410     !                                                                      !
411     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
412           SUBROUTINE ALLOCATE_ARRAYS_GEOMETRY
413     
414     ! Global Variables:
415     !---------------------------------------------------------------------//
416     ! Domain decomposition and dimensions
417           use geometry, only: oDX, oDX_E
418           use geometry, only: oDZ, oDZ_T
419           use geometry, only: oDY, oDY_N
420           use geometry, only: X, X_E, oX, oX_E, cyl_X, cyl_X_E
421           use geometry, only: Z, Z_T
422     ! Averaging factors.
423           use geometry, only: FX_E, FX_E_bar, FX, FX_bar
424           use geometry, only: FY_N, FY_N_bar
425           use geometry, only: FZ_T, FZ_T_bar
426     ! Domain flags.
427           use geometry, only: ICBC_FLAG
428           use geometry, only: FLAG, FLAG3
429           use geometry, only: FLAG_E, FLAG_N, FLAG_T
430     ! Domain volumes and areas.
431           use geometry, only: VOL, VOL_SURR, AYZ, AXZ, AXY! Scalar grid
432           use geometry, only: VOL_U, AYZ_U, AXZ_U, AXY_U  ! X-Momentum
433           use geometry, only: VOL_V, AYZ_V, AXZ_V, AXY_V  ! Y-Momentum
434           use geometry, only: VOL_W, AYZ_W, AXZ_W, AXY_W  ! Z-Momentum
435     ! Axis decomposition
436           USE param, only: DIMENSION_I, DIMENSION_J, DIMENSION_K
437           USE param, only: DIMENSION_3, DIMENSION_4
438           USE param, only: DIMENSION_3L, DIMENSION_3P
439     ! Flag for POST_MFIX
440           use cdist, only: bDoing_postmfix
441     
442     ! Module procedures
443     !---------------------------------------------------------------------//
444           use mpi_utility, only: GLOBAL_ALL_SUM
445           use error_manager
446     
447           IMPLICIT NONE
448     
449     ! Local Variables:
450     !---------------------------------------------------------------------//
451     ! Error Flag
452           INTEGER :: IER
453     ! Flag indicating that the arrays were previously allocated.
454           INTEGER, SAVE :: CALLED = -1
455     !......................................................................!
456     
457           CALLED = CALLED + 1
458     
459           IF(CALLED > 0) THEN
460              IF(.NOT.bDoing_postmfix) THEN
461                 RETURN
462              ELSEIF(mod(CALLED,2) /= 0) THEN
463                 RETURN
464              ENDIF
465           ENDIF
466     
467     ! Initialize the error manager.
468           CALL INIT_ERR_MSG("ALLOCATE_ARRAYS_GEOMETRY")
469     
470     ! Allocate geometry components related to the mesh. Check the
471     ! allocation error status and abort if any failure is detected.
472           ALLOCATE( X     (0:DIMENSION_I), STAT=IER)
473           ALLOCATE( cyl_X     (0:DIMENSION_I), STAT=IER)
474           ALLOCATE( X_E   (0:DIMENSION_I), STAT=IER)
475           ALLOCATE( cyl_X_E   (0:DIMENSION_I), STAT=IER)
476           ALLOCATE( oX    (0:DIMENSION_I), STAT=IER)
477           ALLOCATE( oX_E  (0:DIMENSION_I), STAT=IER)
478           ALLOCATE( oDX   (0:DIMENSION_I), STAT=IER)
479           ALLOCATE( oDX_E (0:DIMENSION_I), STAT=IER)
480           IF(IER /= 0) goto 500
481     
482           ALLOCATE( oDY   (0:DIMENSION_J), STAT=IER )
483           ALLOCATE( oDY_N (0:DIMENSION_J), STAT=IER )
484           IF(IER /= 0) goto 500
485     
486           ALLOCATE( Z     (0:DIMENSION_K), STAT=IER )
487           ALLOCATE( Z_T   (0:DIMENSION_K), STAT=IER )
488           ALLOCATE( oDZ   (0:DIMENSION_K), STAT=IER )
489           ALLOCATE( oDZ_T (0:DIMENSION_K), STAT=IER )
490           IF(IER /= 0) goto 500
491     
492           ALLOCATE( FX     (0:DIMENSION_I), STAT=IER)
493           ALLOCATE( FX_bar (0:DIMENSION_I), STAT=IER)
494           IF(IER /= 0) goto 500
495     
496           ALLOCATE( FX_E     (0:DIMENSION_I), STAT=IER)
497           ALLOCATE( FX_E_bar (0:DIMENSION_I), STAT=IER)
498           IF(IER /= 0) goto 500
499     
500           ALLOCATE( FY_N     (0:DIMENSION_J), STAT=IER )
501           ALLOCATE( FY_N_bar (0:DIMENSION_J), STAT=IER )
502           IF(IER /= 0) goto 500
503     
504           ALLOCATE( FZ_T     (0:DIMENSION_K), STAT=IER )
505           ALLOCATE( FZ_T_bar (0:DIMENSION_K), STAT=IER )
506           IF(IER /= 0) goto 500
507     
508     ! Flags for the scalar grid.
509           Allocate( FLAG  (DIMENSION_3), STAT=IER )
510           Allocate( FLAG3 (DIMENSION_4), STAT=IER )
511           IF(IER /= 0) goto 500
512     
513     ! Flags for the momentum grids.
514           Allocate( FLAG_E (DIMENSION_3), STAT=IER )
515           Allocate( FLAG_N (DIMENSION_3), STAT=IER )
516           Allocate( FLAG_T (DIMENSION_3), STAT=IER )
517           IF(IER /= 0) goto 500
518     
519     ! Text flags for scalar grid.
520           Allocate( ICBC_FLAG (DIMENSION_3L), STAT=IER )
521           IF(IER /= 0) goto 500
522     
523     ! Volume and face-areas of scalar grid.
524           Allocate( VOL (DIMENSION_3),  STAT=IER )
525           Allocate( AYZ (DIMENSION_3P), STAT=IER )
526           Allocate( AXZ (DIMENSION_3P), STAT=IER )
527           Allocate( AXY (DIMENSION_3P), STAT=IER )
528           IF(IER /= 0) goto 500
529     
530           ! total volume of each cell's surrounding stencil cells
531           Allocate( VOL_SURR (DIMENSION_3), STAT=IER )
532     
533     ! Volume and face-areas of X-Momentumn grid.
534           Allocate( VOL_U (DIMENSION_3),  STAT=IER )
535           Allocate( AYZ_U (DIMENSION_3P), STAT=IER )
536           Allocate( AXZ_U (DIMENSION_3P), STAT=IER )
537           Allocate( AXY_U (DIMENSION_3P), STAT=IER )
538           IF(IER /= 0) goto 500
539     
540     ! Volume and face-areas of Y-Momentum grid.
541           Allocate( VOL_V (DIMENSION_3),  STAT=IER )
542           Allocate( AYZ_V (DIMENSION_3P), STAT=IER )
543           Allocate( AXZ_V (DIMENSION_3P), STAT=IER )
544           Allocate( AXY_V (DIMENSION_3P), STAT=IER )
545           IF(IER /= 0) goto 500
546     
547     ! Volume and face-areas of Z-Momentum grid.
548           Allocate( VOL_W (DIMENSION_3),  STAT=IER )
549           Allocate( AYZ_W (DIMENSION_3P), STAT=IER )
550           Allocate( AXZ_W (DIMENSION_3P), STAT=IER )
551           Allocate( AXY_W (DIMENSION_3P), STAT=IER )
552           IF(IER /= 0) goto 500
553     
554     ! Collect the error flags from all ranks. If all allocaitons were
555     ! successfull, do nothing. Otherwise, flag the error and abort.
556     ! Note that the allocation status is checked in groups. This can
557     ! be increase if tracking the source of an allocation failure.
558       500 CALL GLOBAL_ALL_SUM(IER)
559     
560           IF(IER /= 0) THEN
561              WRITE(ERR_MSG,1100)
562              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
563           ENDIF
564     
565      1100 FORMAT('Error 1100: Failure during array allocation.')
566     
567           CALL FINL_ERR_MSG
568     
569           RETURN
570           END SUBROUTINE ALLOCATE_ARRAYS_GEOMETRY
571     
572     
573     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
574     !                                                                      !
575     !  Module name: ALLOCATE_ARRAYS_INCREMENTS                             !
576     !  Author: M. Syamlal, W. Rogers                      Date: 10-DEC-91  !
577     !                                                                      !
578     !  Purpose: The purpose of this module is to create increments to be   !
579     !           stored in the array STORE_INCREMENT which will be added    !
580     !           to cell index ijk to find the effective indices of its     !
581     !           neighbors. These increments are found using the 'class'    !
582     !           of cell ijk. The class is determined based on the          !
583     !           neighboring cell type, i.e. wall or fluid.                 !
584     !                                                                      !
585     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
586           SUBROUTINE ALLOCATE_ARRAYS_INCREMENTS
587     
588           USE param
589           USE param1
590           USE indices
591           USE geometry
592           USE compar
593           USE physprop
594           USE fldvar
595           USE funits
596     
597     ! Module procedures
598     !---------------------------------------------------------------------//
599           use mpi_utility, only: GLOBAL_ALL_SUM
600           use error_manager
601     
602     
603           IMPLICIT NONE
604     
605     
606     ! Local Variables:
607     !---------------------------------------------------------------------//
608     ! Error flag.
609           INTEGER :: IER
610     ! Flag indicating that the arrays were previously allocated.
611           LOGICAL, SAVE :: ALREADY_ALLOCATED = .FALSE.
612     !......................................................................!
613     
614           IF(ALREADY_ALLOCATED) RETURN
615     
616     ! Initialize the error manager.
617           CALL INIT_ERR_MSG("ALLOCATE_ARRAYS_INCREMENTS")
618     
619     ! Allocate increment arrays and report an allocation errors.
620           Allocate( I_OF (DIMENSION_3), STAT=IER)
621           Allocate( J_OF (DIMENSION_3), STAT=IER)
622           Allocate( K_OF (DIMENSION_3), STAT=IER)
623           IF(IER /= 0) goto 500
624     
625           Allocate( Im1 (0:DIMENSION_I), STAT=IER)
626           Allocate( Ip1 (0:DIMENSION_I), STAT=IER)
627           IF(IER /= 0) goto 500
628     
629           Allocate( Jm1 (0:DIMENSION_J), STAT=IER)
630           Allocate( Jp1 (0:DIMENSION_J), STAT=IER)
631           IF(IER /= 0) goto 500
632     
633           Allocate( Km1 (0:DIMENSION_K), STAT=IER)
634           Allocate( Kp1 (0:DIMENSION_K), STAT=IER)
635           IF(IER /= 0) goto 500
636     
637           Allocate( STORE_LM (DIMENSION_M, DIMENSION_M), STAT=IER)
638           Allocate( CELL_CLASS (DIMENSION_3), STAT=IER)
639           IF(IER /= 0) goto 500
640     
641     
642     ! Allocate increment arrays and report an allocation errors.
643           Allocate( I3_OF (DIMENSION_4), STAT=IER)
644           Allocate( J3_OF (DIMENSION_4), STAT=IER)
645           Allocate( K3_OF (DIMENSION_4), STAT=IER)
646           IF(IER /= 0) goto 500
647     
648           Allocate( Im1_3 (-1:DIMENSION_I+1), STAT=IER)
649           Allocate( Ip1_3 (-1:DIMENSION_I+1), STAT=IER)
650           IF(IER /= 0) goto 500
651     
652           Allocate( Jm1_3 (-1:DIMENSION_J+1), STAT=IER)
653           Allocate( Jp1_3 (-1:DIMENSION_J+1), STAT=IER)
654           IF(IER /= 0) goto 500
655     
656           Allocate( Km1_3 (-1:DIMENSION_K+1), STAT=IER)
657           Allocate( Kp1_3 (-1:DIMENSION_K+1), STAT=IER)
658           IF(IER /= 0) goto 500
659     
660           Allocate( CELL_CLASS3 (DIMENSION_4), STAT=IER)
661           IF(IER /= 0) goto 500
662     
663     ! Collect the error flags from all ranks. If all allocaitons were
664     ! successfull, do nothing. Otherwise, flag the error and abort.
665     ! Note that the allocation status is checked in groups. This can
666     ! be increase if tracking the source of an allocation failure.
667       500 CALL GLOBAL_ALL_SUM(IER)
668     
669           IF(IER /= 0) THEN
670              WRITE(ERR_MSG,1100)
671              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
672           ENDIF
673     
674      1100 FORMAT('Error 1100: Failure during array allocation.')
675     
676           ALREADY_ALLOCATED = .TRUE.
677     
678           CALL FINL_ERR_MSG
679     
680           RETURN
681           END SUBROUTINE ALLOCATE_ARRAYS_INCREMENTS
682