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