source: CIVL/mods/dev.civl.abc/examples/fortran/flash/heat_min/amr_initialize.F90

main
Last change on this file was aad342c, checked in by Stephen Siegel <siegel@…>, 3 years ago

Performing huge refactor to incorporate ABC, GMC, and SARL into CIVL repo and use Java modules.

git-svn-id: ​svn://vsl.cis.udel.edu/civl/trunk@5664 fb995dde-84ed-4084-dfe6-e5aef3e2452c
  • Property mode set to 100644
File size: 35.6 KB
Line 
1
2#include "paramesh_preprocessor.fh"
3
4
5!----------------------------------------------------------------
6
7 Subroutine amr_initialize
8
9!-----Use statements
10 Use paramesh_dimensions
11 Use physicaldata
12 Use tree
13 Use workspace
14 Use mpi_morton
15 Use timings
16 Use prolong_arrays
17 Use timings
18 Use paramesh_comm_data
19
20 Use paramesh_interfaces, only : amr_1blk_guardcell_reset, &
21 amr_prolong_fun_init, &
22 amr_bcset_init
23
24 Implicit None
25
26!-----Include statements
27 Include 'mpif.h'
28
29!-----Integer variables
30 Integer :: nfield, nprocs, mype, maxprocs
31 Integer :: i
32 Integer :: ierr
33
34!-----Real variables
35 Real :: test1,test2
36 Real :: real_test_in(2),real_test_out(2)
37
38!-----Double Precision variables
39 Double Precision :: time1
40
41!----------------------------------------------------------------
42!-----Begin Executable code section
43!----------------------------------------------------------------
44
45!-----START UP MPI
46
47 Call comm_start(maxprocs,nprocs,mype)
48 Call MPI_BARRIER(amr_mpi_meshComm, ierr)
49
50!-----Set the type for passing reals using MPI
51#ifdef REAL8
52 amr_mpi_real = MPI_DOUBLE_PRECISION
53#else
54 amr_mpi_real = MPI_REAL
55#endif
56
57!-----test mpi real communitcation
58 real_test_in(1) = 100. + real(mype)
59 real_test_in(2) = 1000. + 2.*real(mype)
60
61 Call mpi_real_allreduce(real_test_in, real_test_out, 2, &
62 amr_mpi_real, &
63 MPI_MAX, amr_mpi_meshComm, ierr)
64 test1 = 100. + real(nprocs-1)
65 test2 = 1000. + 2.*real(nprocs-1)
66 If (real_test_out(1).ne.test1.or.real_test_out(2).ne.test2) Then
67 If (mype == 0) Then
68 Write(*,*) 'PARAMESH ERROR: A test of mpi communication of ', &
69 'REAL type failed. Possible cause is using -r8 ', &
70 'without defining the preprocessor variable REAL8' &
71 ,' real_test_in ',real_test_in,' real_test_out ', &
72 real_test_out,' test1 test2 ', test1, test2
73 End If ! End If (mype == 0)
74 Call MPI_BARRIER(amr_mpi_meshComm,ierr)
75 Call amr_abort()
76 End If ! End If(real_test_out(1).ne.test1.or.real_test_out(2).ne.test2)
77
78!-----Read in 'amr_runtime_parameters' file
79 Call amr_set_runtime_parameters()
80
81 If (timing_mpi) Then
82 time1 = mpi_wtime()
83 End If ! End If (timing_mpi)
84
85!-----If nvar, nfacevar, nvaredge, and nvarcorn are all zero, then abort with
86!-----a warning message.
87 If (nvar <= 0 .and. &
88 nfacevar <= 0 .and. &
89 nvaredge <= 0 .and. &
90 nvarcorn <= 0) Then
91 If (mype == 0) then
92 print *,' PARAMESH ERROR: nvar = 0, nfacevar = 0, nvaredge = 0, '
93 print *,' and nvarcorn = 0. Reset one of these values to be >= 1 '
94 print *,' rerun '
95 End If ! End If (mype == 0)
96 Call amr_abort()
97 End If ! End If (nvar ...
98
99!-----Set other variables based on what was just read in from 'amr_runtime_parameters'.
100#ifdef LIBRARY
101 If (no_permanent_guardcells) Then
102 npgs = 0
103 Else
104 npgs = 1
105 End If ! End If (no_pemanent_guardcells)
106#endif
107
108 If (var_dt) Then
109 advance_all_levels = .true.
110 End If ! End if (var_dt)
111
112 If (curvilinear .and. .not.cartesian_pm) Then
113 consv_fluxes = .true.
114 consv_flux_densities = .false.
115 edge_value_integ = .true.
116 edge_value = .false.
117 Else If (.not.curvilinear) Then ! End If (curvilinear .and. .not. cartesian_pm)
118 curvilinear_conserve = .false.
119 cartesian_pm = .false.
120 cylindrical_pm = .false.
121 spherical_pm = .false.
122 polar_pm = .false.
123 End If ! End If (.not.curvilinear)
124
125!-----Perform other computation necessary for setting up arrays.
126#ifdef LIBRARY
127 If (ndim == 1) then
128 nyb = 1
129 End If ! End if (ndim == 1)
130 If (ndim <= 2) Then
131 nzb = 1
132 End If ! End If (ndim == 2)
133#endif
134
135#ifdef LIBRARY
136 nbedges = ndim*2**(ndim-1)
137 k3d = (ndim-1)/2
138 k2d = ndim/2
139 k1d = 1
140#endif
141 red_f = 0.25
142
143 If (consv_fluxes) Then
144 If (ndim == 3) Then
145 red_f = 1.0
146 Else If (ndim == 2) Then
147 red_f = 0.5
148 Else If (ndim == 1) Then
149 red_f = 0.25
150 End If
151 End If ! End If (consv_fluxes)
152
153 nchild = 2**ndim
154 nfaces = 2*ndim
155
156 If (nboundaries < 2*ndim) Then
157 nboundaries=2*ndim
158 End If ! End If (nboundaries < 2*ndim)
159
160#ifdef LIBRARY
161 nbndvar = Max(1,nfacevar)
162#endif
163 nbndvare = Max(1,nvaredge)
164 nbndvarc = Max(1,nvarcorn)
165
166 nfluxes = Max(1,nfluxvar)
167 nbndmax = Max(nbndvar,nfluxes)
168
169 nedgevar = Max(nedgevar1,nvaredge)
170 nedges = Max(1,nedgevar)
171
172#ifdef LIBRARY
173 maxdim = Max(nxb,nyb,nzb)
174#endif
175 gc_off_x = Mod(nxb,2)
176 gc_off_y = Mod(nyb,2)
177 gc_off_z = Mod(nzb,2)
178#ifdef LIBRARY
179 il_bnd = 1
180 jl_bnd = 1
181 kl_bnd = 1
182 iu_bnd = nxb+2*nguard*npgs
183 ju_bnd = nyb+2*nguard*npgs*k2d
184 ku_bnd = nzb+2*nguard*npgs*k3d
185 il_bndi = nguard*npgs+1
186 iu_bndi = nguard*npgs+nxb
187 jl_bndi = nguard*npgs*k2d+1
188 ju_bndi = nguard*npgs*k2d+nyb
189 kl_bndi = nguard*npgs*k3d+1
190 ku_bndi = nguard*npgs*k3d+nzb
191#endif
192 len_block = iu_bnd*ju_bnd*ku_bnd*nvar
193 len_blockfx = (iu_bnd+1)*ju_bnd*ku_bnd
194 len_blockfy = iu_bnd*(ju_bnd+k2d)*ku_bnd
195 len_blockfz = iu_bnd*ju_bnd*(ku_bnd+k3d)
196 len_blockex = iu_bnd*(ju_bnd+k2d)*(ku_bnd+k3d)
197 len_blockey = (iu_bnd+1)*ju_bnd*(ku_bnd+k3d)
198 len_blockez = (iu_bnd+1)*(ju_bnd+k2d)*ku_bnd
199 len_blockn = (iu_bnd+1)*(ju_bnd+k2d)*(ku_bnd+k3d)
200 len_blockfxf = 2*ju_bnd*ku_bnd
201 len_blockfyf = iu_bnd*2*ku_bnd
202 len_blockfzf = iu_bnd*ju_bnd*2
203#ifdef LIBRARY
204 il_bnd1 = 1
205 jl_bnd1 = 1
206 kl_bnd1 = 1
207 iu_bnd1 = nxb+2*nguard
208 ju_bnd1 = nyb+2*nguard*k2d
209 ku_bnd1 = nzb+2*nguard*k3d
210#endif
211 len_block1 = iu_bnd1*ju_bnd1*ku_bnd1*nvar
212 len_blockfx1 = (iu_bnd1+1)*ju_bnd1*ku_bnd1
213 len_blockfy1 = iu_bnd1*(ju_bnd1+k2d)*ku_bnd1
214 len_blockfz1 = iu_bnd1*ju_bnd1*(ku_bnd1+k3d)
215 len_blockex1 = iu_bnd1*(ju_bnd1+k2d)*(ku_bnd1+k3d)
216 len_blockey1 = (iu_bnd1+1)*ju_bnd1*(ku_bnd1+k3d)
217 len_blockez1 = (iu_bnd1+1)*(ju_bnd1+1)*ku_bnd1
218 len_blockn1 = (iu_bnd1+1)*(ju_bnd1+1)*(ku_bnd1+k3d)
219#ifdef LIBRARY
220 ilw = 1
221 jlw = 1
222 klw = 1
223 ngw2 = 2*nguard_work
224 iuw = nxb+ngw2*npgs
225 juw = nyb+ngw2*npgs*k2d
226 kuw = nzb+ngw2*npgs*k3d
227#endif
228 len_wblock = iuw*juw*kuw
229#ifdef LIBRARY
230 ilw1 = 1
231 jlw1 = 1
232 klw1 = 1
233 iuw1 = nxb+ngw2
234 juw1 = nyb+ngw2*k2d
235 kuw1 = nzb+ngw2*k3d
236#endif
237 len_wblock1 = iuw1*juw1*kuw1
238
239 If (ndim == 1) Then
240 nmax_lays = nxb/2
241 End If ! End if (ndim == 1)
242
243 If (ndim == 2) Then
244 nmax_lays = Min(nxb/2,nyb/2)
245 End If ! End If (ndim == 2)
246
247 If (ndim == 3) Then
248 nmax_lays = Min(nxb/2,nyb/2,nzb/2)
249 End If ! End If (ndim == 3)
250
251#ifdef LIBRARY
252 maxblocks_alloc = maxblocks * 10
253#endif
254
255 maxblocksf = 1+(maxblocks-1)*Min(1,nfacevar)
256 maxblocksue = 1+(maxblocks-1)*Min(1,nvaredge)
257 maxblocksn = 1+(maxblocks-1)*Min(1,nvarcorn)
258 maxblocks_gt = (maxblocks-1)*(1-npgs)+1
259 maxblocksf_gt = (maxblocksf-1)*(1-npgs)+1
260 maxblocksue_gt = (maxblocksue-1)*(1-npgs)+1
261 maxblocksn_gt = (maxblocksn-1)*(1-npgs)+1
262 maxblocksfl = 1+(maxblocks-1)*Min(1,nfluxvar)
263 maxblockse = 1+(maxblocks-1)*Min(1,nedgevar)
264
265!-----Allocate storage for PARAMESH arrays according to settings read in
266!-----from 'amr_runtime_parameters'
267
268!-----Allocate storage for cell-centered data and their support arrays
269
270 If (nvar <= 0) Then
271
272 Allocate(unk(1,1,1,1,1))
273 Allocate(interp_mask_unk(1))
274 Allocate(interp_mask_unk_res(1))
275 Allocate(gcell_on_cc_pointer(1))
276 Allocate(gcell_on_cc(1))
277 Allocate(int_gcell_on_cc(1))
278 Allocate(checkp_on_cc(1))
279
280 Else
281
282 Allocate( &
283 unk(nvar, &
284 il_bnd:iu_bnd, &
285 jl_bnd:ju_bnd, &
286 kl_bnd:ku_bnd, &
287 maxblocks))
288 Allocate(unk1(nvar, &
289 il_bnd1:iu_bnd1, &
290 jl_bnd1:ju_bnd1, &
291 kl_bnd1:ku_bnd1, &
292 npblks))
293 Allocate( &
294 gt_unk(nvar, &
295 il_bnd:iu_bnd, &
296 jl_bnd:ju_bnd, &
297 kl_bnd:ku_bnd, &
298 maxblocks_gt))
299
300 If (var_dt .or. pred_corr) Then
301 Allocate( &
302 t_unk(nvar, &
303 il_bnd:iu_bnd, &
304 jl_bnd:ju_bnd, &
305 kl_bnd:ku_bnd, &
306 maxblocks))
307 End If ! End If (var_dt .or. pred_corr)
308
309 Allocate(interp_mask_unk(nvar))
310 Allocate(interp_mask_unk_res(nvar))
311 Allocate(gcell_on_cc_pointer(nvar))
312 Allocate(gcell_on_cc(nvar))
313 Allocate(int_gcell_on_cc(nvar))
314 Allocate(checkp_on_cc(nvar))
315
316 End If ! End If (nvar <= 0)
317
318!-----Allocate and initialize arrays for face variables
319
320 If (nfacevar <= 0) Then
321
322 Allocate(facevarx(1,1,1,1,1))
323 Allocate(facevary(1,1,1,1,1))
324 Allocate(facevarz(1,1,1,1,1))
325
326 Else
327
328 Allocate( &
329 facevarx(nbndvar, &
330 il_bnd:iu_bnd+1, &
331 jl_bnd:ju_bnd, &
332 kl_bnd:ku_bnd, &
333 maxblocksf))
334 Allocate( &
335 facevary(nbndvar, &
336 il_bnd:iu_bnd, &
337 jl_bnd:ju_bnd+k2d, &
338 kl_bnd:ku_bnd, &
339 maxblocksf))
340 Allocate( &
341 facevarz(nbndvar, &
342 il_bnd:iu_bnd, &
343 jl_bnd:ju_bnd, &
344 kl_bnd:ku_bnd+k3d, &
345 maxblocksf))
346 facevarx(:,:,:,:,:) = 0.
347 facevary(:,:,:,:,:) = 0.
348 facevarz(:,:,:,:,:) = 0.
349
350 Allocate(facevarx1(nbndvar, &
351 il_bnd1:iu_bnd1+1, &
352 jl_bnd1:ju_bnd1, &
353 kl_bnd1:ku_bnd1, &
354 npblks))
355 Allocate(facevary1(nbndvar, &
356 il_bnd1:iu_bnd1, &
357 jl_bnd1:ju_bnd1+k2d, &
358 kl_bnd1:ku_bnd1, &
359 npblks))
360 Allocate(facevarz1(nbndvar, &
361 il_bnd1:iu_bnd1, &
362 jl_bnd1:ju_bnd1, &
363 kl_bnd1:ku_bnd1+k3d, &
364 npblks))
365 If (no_permanent_guardcells) Then
366 Allocate( &
367 gt_facevarx(nbndvar, &
368 il_bnd:iu_bnd+1, &
369 jl_bnd:ju_bnd, &
370 kl_bnd:ku_bnd, &
371 maxblocksf_gt))
372 Allocate( &
373 gt_facevary(nbndvar, &
374 il_bnd:iu_bnd, &
375 jl_bnd:ju_bnd+k2d, &
376 kl_bnd:ku_bnd, &
377 maxblocksf_gt))
378 Allocate( &
379 gt_facevarz(nbndvar, &
380 il_bnd:iu_bnd, &
381 jl_bnd:ju_bnd, &
382 kl_bnd:ku_bnd+k3d, &
383 maxblocksf_gt))
384 Else ! Else for If (no_permanent_guardcells)
385 Allocate( &
386 gt_facevarx(nbndvar, &
387 1:2, &
388 jl_bnd:ju_bnd, &
389 kl_bnd:ku_bnd, &
390 maxblocksf))
391 Allocate( &
392 gt_facevary(nbndvar, &
393 il_bnd:iu_bnd, &
394 1:1+k2d, &
395 kl_bnd:ku_bnd, &
396 maxblocksf))
397 Allocate( &
398 gt_facevarz(nbndvar, &
399 il_bnd:iu_bnd, &
400 jl_bnd:ju_bnd, &
401 1:1+k3d, &
402 maxblocksf))
403 End If ! End If (no_permanent_guardcells)
404
405 If (var_dt .or. pred_corr) Then
406 Allocate( &
407 tfacevarx(nbndvar, &
408 il_bnd:iu_bnd+1, &
409 jl_bnd:ju_bnd, &
410 kl_bnd:ku_bnd, &
411 maxblocksf))
412 Allocate( &
413 tfacevary(nbndvar, &
414 il_bnd:iu_bnd, &
415 jl_bnd:ju_bnd+k2d, &
416 kl_bnd:ku_bnd, &
417 maxblocksf))
418 Allocate( &
419 tfacevarz(nbndvar, &
420 il_bnd:iu_bnd, &
421 jl_bnd:ju_bnd, &
422 kl_bnd:ku_bnd+k3d, &
423 maxblocksf))
424
425 End If ! End if (var_dt .or. pred_corr)
426
427 End If ! End If (nfacevar > 0)
428
429 Allocate(gcell_on_fc_pointer(3,nbndvar))
430 Allocate(gcell_on_fc(3,nbndvar))
431 Allocate(int_gcell_on_fc(3,nbndvar))
432 Allocate(interp_mask_facex(nbndvar))
433 Allocate(interp_mask_facey(nbndvar))
434 Allocate(interp_mask_facez(nbndvar))
435 Allocate(interp_mask_facex_res(nbndvar))
436 Allocate(interp_mask_facey_res(nbndvar))
437 Allocate(interp_mask_facez_res(nbndvar))
438 Allocate(checkp_on_fc(3,nbndvar))
439
440!-----Allocate and intialize edge variables
441
442 If (nvaredge <= 0) Then
443
444 Allocate(unk_e_x(1,1,1,1,1))
445 Allocate(unk_e_y(1,1,1,1,1))
446 Allocate(unk_e_z(1,1,1,1,1))
447
448 Else
449
450 Allocate( &
451 unk_e_x(nbndvare, &
452 il_bnd:iu_bnd, &
453 jl_bnd:ju_bnd+k2d, &
454 kl_bnd:ku_bnd+k3d, &
455 maxblocksue))
456 Allocate( &
457 unk_e_y(nbndvare, &
458 il_bnd:iu_bnd+1, &
459 jl_bnd:ju_bnd, &
460 kl_bnd:ku_bnd+k3d, &
461 maxblocksue))
462 Allocate( &
463 unk_e_z(nbndvare, &
464 il_bnd:iu_bnd+1, &
465 jl_bnd:ju_bnd+k2d, &
466 kl_bnd:ku_bnd, &
467 maxblocksue))
468 unk_e_x(:,:,:,:,:) = 0.
469 unk_e_y(:,:,:,:,:) = 0.
470 unk_e_z(:,:,:,:,:) = 0.
471
472 Allocate(unk_e_x1(nbndvare, &
473 il_bnd1:iu_bnd1, &
474 jl_bnd1:ju_bnd1+k2d, &
475 kl_bnd1:ku_bnd1+k3d, &
476 npblks))
477 Allocate(unk_e_y1(nbndvare, &
478 il_bnd1:iu_bnd1+1, &
479 jl_bnd1:ju_bnd1, &
480 kl_bnd1:ku_bnd1+k3d, &
481 npblks))
482 Allocate(unk_e_z1(nbndvare, &
483 il_bnd1:iu_bnd1+1, &
484 jl_bnd1:ju_bnd1+k2d, &
485 kl_bnd1:ku_bnd1, &
486 npblks))
487 Allocate( &
488 gt_unk_e_x(nbndvare, &
489 il_bnd:iu_bnd, &
490 jl_bnd:ju_bnd+k2d, &
491 kl_bnd:ku_bnd+k3d, &
492 maxblocksue_gt))
493 Allocate( &
494 gt_unk_e_y(nbndvare, &
495 il_bnd:iu_bnd+1, &
496 jl_bnd:ju_bnd, &
497 kl_bnd:ku_bnd+k3d, &
498 maxblocksue_gt))
499 Allocate( &
500 gt_unk_e_z(nbndvare, &
501 il_bnd:iu_bnd+1, &
502 jl_bnd:ju_bnd+k2d, &
503 kl_bnd:ku_bnd, &
504 maxblocksue_gt))
505
506 If (var_dt .or. pred_corr) Then
507
508 Allocate( &
509 t_unk_e_x(nbndvare, &
510 il_bnd:iu_bnd, &
511 jl_bnd:ju_bnd+k2d, &
512 kl_bnd:ku_bnd+k3d, &
513 maxblocksue))
514 Allocate( &
515 t_unk_e_y(nbndvare, &
516 il_bnd:iu_bnd+1, &
517 jl_bnd:ju_bnd, &
518 kl_bnd:ku_bnd+k3d, &
519 maxblocksue))
520 Allocate( &
521 t_unk_e_z(nbndvare, &
522 il_bnd:iu_bnd+1, &
523 jl_bnd:ju_bnd+k2d, &
524 kl_bnd:ku_bnd, &
525 maxblocksue))
526
527 End If ! End If (var_dt .or. pred_corr)
528
529 End If ! End If (nvaredge > 0)
530
531 Allocate(interp_mask_ec(nbndvare))
532 Allocate(interp_mask_ec_res(nbndvare))
533 Allocate(gcell_on_ec(3,nbndvare))
534 Allocate(gcell_on_ec_pointer(3,nbndvare))
535 Allocate(int_gcell_on_ec(3,nbndvare))
536 Allocate(checkp_on_ec(3,nbndvare))
537
538!-----Allocate and initialize corner data
539
540 If (nvarcorn <= 0) Then
541
542 Allocate(unk_n(1,1,1,1,1))
543
544 Else
545
546 Allocate(unk_n(nbndvarc, &
547 il_bnd:iu_bnd+1, &
548 jl_bnd:ju_bnd+k2d, &
549 kl_bnd:ku_bnd+k3d, &
550 maxblocksn))
551 unk_n(:,:,:,:,:) = 0.
552 Allocate(unk_n1(nbndvarc, &
553 il_bnd1:iu_bnd1+1, &
554 jl_bnd1:ju_bnd1+k2d, &
555 kl_bnd1:ku_bnd1+k3d, &
556 npblks))
557 Allocate( &
558 gt_unk_n(nbndvarc, &
559 il_bnd:iu_bnd+1, &
560 jl_bnd:ju_bnd+k2d, &
561 kl_bnd:ku_bnd+k3d, &
562 maxblocksn_gt))
563
564 If (var_dt .or. pred_corr) Then
565 Allocate( &
566 t_unk_n(nbndvarc, &
567 il_bnd:iu_bnd+1, &
568 jl_bnd:ju_bnd+k2d, &
569 kl_bnd:ku_bnd+k3d, &
570 maxblocksn))
571 End If ! End If (var_dt .or. pred_corr)
572
573 End If ! End If (nvarcorn <= 0)
574
575 Allocate(interp_mask_nc(nbndvarc))
576 Allocate(interp_mask_nc_res(nbndvarc))
577 Allocate(gcell_on_nc(nbndvarc))
578 Allocate(gcell_on_nc_pointer(nbndvarc))
579 Allocate(int_gcell_on_nc(nbndvarc))
580 Allocate(checkp_on_nc(nbndvarc))
581
582!-----Allocate arrays for variable time stepping support
583
584 Allocate(time_loc(maxblocks_alloc))
585 Allocate(ldtcomplete(maxblocks_alloc))
586 ldtcomplete = .false.
587
588!-----Allocate arrays for flux fix-up at refinement jumps
589
590 Allocate( &
591 flux_x(nfluxes, &
592 1:2, &
593 jl_bndi:ju_bndi, &
594 kl_bndi:ku_bndi, &
595 maxblocksfl))
596 Allocate( &
597 flux_y(nfluxes, &
598 il_bndi:iu_bndi, &
599 1:2, &
600 kl_bndi:ku_bndi, &
601 maxblocksfl))
602 Allocate( &
603 flux_z(nfluxes, &
604 il_bndi:iu_bndi, &
605 jl_bndi:ju_bndi, &
606 1:2, &
607 maxblocksfl))
608 Allocate( &
609 tflux_x(nfluxes, &
610 1:2, &
611 jl_bndi:ju_bndi, &
612 kl_bndi:ku_bndi, &
613 maxblocksfl))
614 Allocate( &
615 tflux_y(nfluxes, &
616 il_bndi:iu_bndi, &
617 1:2, &
618 kl_bndi:ku_bndi, &
619 maxblocksfl))
620 Allocate( &
621 tflux_z(nfluxes, &
622 il_bndi:iu_bndi, &
623 jl_bndi:ju_bndi, &
624 1:2, &
625 maxblocksfl))
626
627!-----Allocate arrrays for edge data fix-up at refinement jumps
628
629 Allocate( &
630 bedge_facex_y(nedges, &
631 1:2, &
632 jl_bnd:ju_bnd+1, &
633 kl_bnd:ku_bnd+1, &
634 maxblockse))
635 Allocate( &
636 bedge_facex_z(nedges, &
637 1:2, &
638 jl_bnd:ju_bnd+1, &
639 kl_bnd:ku_bnd+1, &
640 maxblockse))
641 Allocate( &
642 bedge_facey_x(nedges, &
643 il_bnd:iu_bnd+1, &
644 1:2, &
645 kl_bnd:ku_bnd+1, &
646 maxblockse))
647 Allocate( &
648 bedge_facey_z(nedges, &
649 il_bnd:iu_bnd+1, &
650 1:2, &
651 kl_bnd:ku_bnd+1, &
652 maxblockse))
653 Allocate( &
654 bedge_facez_x(nedges, &
655 il_bnd:iu_bnd+1, &
656 jl_bnd:ju_bnd+1, &
657 1:2, &
658 maxblockse))
659 Allocate( &
660 bedge_facez_y(nedges, &
661 il_bnd:iu_bnd+1, &
662 jl_bnd:ju_bnd+1, &
663 1:2, &
664 maxblockse))
665 Allocate( &
666 recvarx1e(nedges, &
667 1:2, &
668 jl_bnd:ju_bnd+1, &
669 kl_bnd:ku_bnd+1))
670 Allocate( &
671 recvary1e(nedges, &
672 il_bnd:iu_bnd+1, &
673 1:2, &
674 kl_bnd:ku_bnd+1))
675 Allocate( &
676 recvarz1e(nedges, &
677 il_bnd:iu_bnd+1, &
678 jl_bnd:ju_bnd+1, &
679 1:2))
680 Allocate( &
681 recvarx2e(nedges, &
682 1:2, &
683 jl_bnd:ju_bnd+1, &
684 kl_bnd:ku_bnd+1))
685 Allocate( &
686 recvary2e(nedges, &
687 il_bnd:iu_bnd+1, &
688 1:2, &
689 kl_bnd:ku_bnd+1))
690 Allocate( &
691 recvarz2e(nedges, &
692 il_bnd:iu_bnd+1, &
693 jl_bnd:ju_bnd+1, &
694 1:2))
695 Allocate( &
696 tbedge_facex_y(nedges, &
697 1:2, &
698 jl_bnd:ju_bnd+1, &
699 kl_bnd:ku_bnd+1, &
700 maxblockse))
701 Allocate( &
702 tbedge_facex_z(nedges, &
703 1:2, &
704 jl_bnd:ju_bnd+1, &
705 kl_bnd:ku_bnd+1, &
706 maxblockse))
707 Allocate( &
708 tbedge_facey_x(nedges, &
709 il_bnd:iu_bnd+1, &
710 1:2, &
711 kl_bnd:ku_bnd+1, &
712 maxblockse))
713 Allocate( &
714 tbedge_facey_z(nedges, &
715 il_bnd:iu_bnd+1, &
716 1:2, &
717 kl_bnd:ku_bnd+1, &
718 maxblockse))
719 Allocate( &
720 tbedge_facez_x(nedges, &
721 il_bnd:iu_bnd+1, &
722 jl_bnd:ju_bnd+1, &
723 1:2, &
724 maxblockse))
725 Allocate( &
726 tbedge_facez_y(nedges, &
727 il_bnd:iu_bnd+1, &
728 jl_bnd:ju_bnd+1, &
729 1:2, &
730 maxblockse))
731
732 Allocate(recvarxf(nfluxes,1:2,jl_bndi:ju_bndi,kl_bndi:ku_bndi))
733 Allocate(recvaryf(nfluxes,il_bndi:iu_bndi,1:2,kl_bndi:ku_bndi))
734 Allocate(recvarzf(nfluxes,il_bndi:iu_bndi,jl_bndi:ju_bndi,1:2))
735 Allocate(bndtempx1(nfluxes,1:2,jl_bndi:ju_bndi,kl_bndi:ku_bndi))
736 Allocate(bndtempy1(nfluxes,il_bndi:iu_bndi,1:2,kl_bndi:ku_bndi))
737 Allocate(bndtempz1(nfluxes,il_bndi:iu_bndi,jl_bndi:ju_bndi,1:2))
738
739 len_block_bndx = 2*(ju_bndi-jl_bndi+1)*(ku_bndi-kl_bndi+1)
740 len_block_bndy = 2*(iu_bndi-il_bndi+1)*(ku_bndi-kl_bndi+1)
741 len_block_bndz = 2*(iu_bndi-il_bndi+1)*(ju_bndi-jl_bndi+1)
742 len_block_ex = 2*(ju_bnd+k2d)*(ku_bnd+k3d)
743 len_block_ey = 2*(iu_bnd+1 )*(ku_bnd+k3d)
744 len_block_ez = 2*(iu_bnd+1 )*(ju_bnd+k2d)
745
746!-----Allocate tree data
747
748 maxblocks_tr = 10*maxblocks
749
750 Allocate(neigh(2,mfaces,maxblocks_tr))
751 Allocate(child(2,mchild,maxblocks_tr))
752 Allocate(which_child(maxblocks_tr))
753 Allocate(parent(2,maxblocks_tr))
754 Allocate(lrefine(maxblocks_tr))
755 Allocate(nodetype(maxblocks_tr))
756 Allocate(empty(maxblocks_tr))
757 Allocate(bflags(mflags,maxblocks_tr))
758 Allocate(newchild(maxblocks_tr))
759 Allocate(derefine(maxblocks_tr))
760 Allocate(refine(maxblocks_tr))
761 Allocate(stay(maxblocks_tr))
762 Allocate(work_block(maxblocks_tr))
763 Allocate(coord(mdim,maxblocks_tr))
764 Allocate(bsize(mdim,maxblocks_tr))
765 Allocate(bnd_box(2,mdim,maxblocks_tr))
766 Allocate(level_cell_sizes(mdim,maxlevels))
767 Allocate(laddress(1:2,1:maxblocks_alloc))
768 Allocate(surr_blks(3,3,1+2*k2d,1+2*k3d,maxblocks_alloc))
769#ifdef SAVE_MORTS
770 Allocate(surr_morts(6,3,1+2*k2d,1+2*k3d,maxblocks_alloc))
771#endif
772 Allocate(boundary_box(2,mdim,mboundaries))
773 Allocate(boundary_index(mboundaries))
774
775!-----Allocate workspace data
776
777 if (nvar_work <= 0) then
778
779 Allocate(work(1,1,1,1,1))
780 Allocate(interp_mask_work(1))
781 Allocate(interp_mask_work_res(1))
782
783 Else
784
785 Allocate(work(ilw:iuw, &
786 jlw:juw, &
787 klw:kuw, &
788 maxblocks, &
789 nvar_work))
790 Allocate(interp_mask_work(nvar_work))
791 Allocate(interp_mask_work_res(nvar_work))
792 Allocate(recvw(ilw:iuw,jlw:juw,klw:kuw))
793 Allocate(sendw(ilw:iuw,jlw:juw,klw:kuw))
794 Allocate(tempw(ilw:iuw,jlw:juw,klw:kuw))
795 Allocate(work1(ilw1:iuw1,jlw1:juw1,klw1:kuw1,npblks))
796 Allocate(recvw1(ilw1:iuw1,jlw1:juw1,klw1:kuw1,npblks))
797 Allocate(tempw1(ilw1:iuw1,jlw1:juw1,klw1:kuw1))
798
799 End If ! End If (nvar_work <= 0)
800
801!-----Allocate morton data
802
803 Allocate(laddress_guard(1:2,1:maxblocks_alloc))
804 Allocate(laddress_prol(1:2,1:maxblocks_alloc))
805 Allocate(laddress_flux(1:2,1:maxblocks_alloc))
806 Allocate(laddress_restrict(1:2,1:maxblocks_alloc))
807
808!-----Allocate prolong_arrays data
809
810 Allocate(prol_dx(il_bnd1:iu_bnd1))
811 Allocate(prol_dy(jl_bnd1:ju_bnd1))
812 Allocate(prol_dz(kl_bnd1:ku_bnd1))
813 Allocate(prol_indexx(2,il_bnd1:iu_bnd1,2))
814 Allocate(prol_indexy(2,jl_bnd1:ju_bnd1,2))
815 Allocate(prol_indexz(2,kl_bnd1:ku_bnd1,2))
816 Allocate(prol_f_dx(il_bnd1:iu_bnd1+1))
817 Allocate(prol_f_dy(jl_bnd1:ju_bnd1+k2d))
818 Allocate(prol_f_dz(kl_bnd1:ku_bnd1+k3d))
819 Allocate(prol_f_indexx(2,il_bnd1:iu_bnd1+1,2))
820 Allocate(prol_f_indexy(2,jl_bnd1:ju_bnd1+k2d,2))
821 Allocate(prol_f_indexz(2,kl_bnd1:ku_bnd1+k3d,2))
822 Allocate(prolw_dx(ilw1:iuw1))
823 Allocate(prolw_dy(jlw1:juw1))
824 Allocate(prolw_dz(klw1:kuw1))
825 Allocate(prolw_indexx(2,ilw1:iuw1,2))
826 Allocate(prolw_indexy(2,jlw1:juw1,2))
827 Allocate(prolw_indexz(2,klw1:kuw1,2))
828
829!-----Allocate an array for timings
830
831 Allocate(timer_amr_1blk_to_perm(0:1+nvar_work))
832
833 If (var_dt) Then
834 Allocate( &
835 ttflux_x(nfluxes, &
836 1:2, &
837 jl_bnd:ju_bnd, &
838 kl_bnd:ku_bnd, &
839 maxblocksfl))
840 Allocate( &
841 ttflux_y(nfluxes, &
842 il_bnd:iu_bnd, &
843 1:2, &
844 kl_bnd:ku_bnd, &
845 maxblocksfl))
846 Allocate( &
847 ttflux_z(nfluxes, &
848 il_bnd:iu_bnd, &
849 jl_bnd:ju_bnd, &
850 1:2, &
851 maxblocksfl))
852 Allocate( &
853 ttbedge_facex_y(nedges, &
854 1:2, &
855 jl_bnd:ju_bnd+1, &
856 kl_bnd:ku_bnd+1, &
857 maxblockse))
858 Allocate( &
859 ttbedge_facex_z(nedges, &
860 1:2, &
861 jl_bnd:ju_bnd+1, &
862 kl_bnd:ku_bnd+1, &
863 maxblockse))
864 Allocate( &
865 ttbedge_facey_x(nedges, &
866 il_bnd:iu_bnd+1, &
867 1:2, &
868 kl_bnd:ku_bnd+1, &
869 maxblockse))
870 Allocate( &
871 ttbedge_facey_z(nedges, &
872 il_bnd:iu_bnd+1, &
873 1:2, &
874 kl_bnd:ku_bnd+1, &
875 maxblockse))
876 Allocate( &
877 ttbedge_facez_x(nedges, &
878 il_bnd:iu_bnd+1, &
879 jl_bnd:ju_bnd+1, &
880 1:2, &
881 maxblockse))
882 Allocate( &
883 ttbedge_facez_y(nedges, &
884 il_bnd:iu_bnd+1, &
885 jl_bnd:ju_bnd+1, &
886 1:2, &
887 maxblockse))
888 End If ! End If (var_dt)
889
890
891 If (curvilinear) Then
892 Allocate(cell_vol(il_bnd1:iu_bnd1, &
893 jl_bnd1:ju_bnd1, &
894 kl_bnd1:ku_bnd1))
895 Allocate(cell_area1(il_bnd1:iu_bnd1+1, &
896 jl_bnd1:ju_bnd1, &
897 kl_bnd1:ku_bnd1))
898 Allocate(cell_area2(il_bnd1:iu_bnd1, &
899 jl_bnd1:ju_bnd1+k2d, &
900 kl_bnd1:ku_bnd1))
901 Allocate(cell_area3(il_bnd1:iu_bnd1, &
902 jl_bnd1:ju_bnd1, &
903 kl_bnd1:ku_bnd1+k3d))
904 Allocate(cell_leng1(il_bnd1:iu_bnd1, &
905 jl_bnd1:ju_bnd1+k2d, &
906 kl_bnd1:ku_bnd1+k3d))
907 Allocate(cell_leng2(il_bnd1:iu_bnd1+1, &
908 jl_bnd1:ju_bnd1, &
909 kl_bnd1:ku_bnd1+k3d))
910 Allocate(cell_leng3(il_bnd1:iu_bnd1+1, &
911 jl_bnd1:ju_bnd1+k2d, &
912 kl_bnd1:ku_bnd1))
913 Allocate(cell_face_coord1(il_bnd1:iu_bnd1+1))
914 Allocate(cell_face_coord2(jl_bnd1:ju_bnd1+k2d))
915 Allocate(cell_face_coord3(kl_bnd1:ku_bnd1+k3d))
916 Allocate(cell_vol_w(ilw1:iuw1,jlw1:juw1,klw1:kuw1))
917 end if ! End If (curvilinear)
918
919 Allocate(ladd_strt(0:nprocs-1))
920 Allocate(ladd_end(0:nprocs-1))
921
922! initialize tree data structure
923 bsize(:,:) = -1.
924 lrefine(:) = -1
925 nodetype(:) = -1
926 stay(:) = .TRUE.
927 refine(:) = .FALSE.
928 derefine(:) = .FALSE.
929 parent(:,:) = -1
930 child(:,:,:) = -1
931 which_child(:) = -1
932 coord(:,:) = -1.
933 bnd_box(:,:,:) = -1.
934 neigh(:,:,:) = -1
935 empty(:) = 0
936 bflags(:,:) = -1
937 work_block(:) = 0.
938 surr_blks(:,:,:,:,:) = -1
939#ifdef SAVE_MORTS
940 surr_morts(:,:,:,:,:) = -1
941#endif
942
943!-------initialize solution arrays
944 unk(:,:,:,:,:) = 0.
945
946!-------initialize boundary location arrays for mpi use.
947 boundary_box(:,:,:nboundaries) = 0.
948 boundary_index(:nboundaries) = -1
949
950!-----Initialization required for prolongation routines
951 Call amr_prolong_fun_init
952
953!-----Set default values for gcell logical control arrays
954 Do i = 1, nvar
955 gcell_on_cc_pointer(i) = i
956 End Do ! End Do i = 1,nvar
957 gcell_on_cc(:) = .true.
958 int_gcell_on_cc(:) = .true.
959
960 Do i = 1, nfacevar
961 gcell_on_fc_pointer(:,i) = i
962 End Do ! End Do i = 1,nfacevar
963 gcell_on_fc(:,:) = .true.
964 int_gcell_on_fc(:,:) = .true.
965
966 Do i = 1, nedgevar
967 gcell_on_ec_pointer(:,i) = i
968 End Do ! End Do i = 1,nedgevar
969 gcell_on_ec(:,:) = .true.
970 int_gcell_on_ec(:,:) = .true.
971
972 Do i = 1, nvarcorn
973 gcell_on_nc_pointer(i) = i
974 End Do ! End Do i = 1, nvarcorn
975 gcell_on_nc(:) = .true.
976 int_gcell_on_nc(:) = .true.
977
978!-----Set default values for checkpointing
979 checkp_on_cc = .true.
980 checkp_on_fc = .true.
981 checkp_on_ec = .true.
982 checkp_on_nc = .true.
983
984!-----Set default values for interp_masks for prolongation
985 interp_mask_unk(:) = 1
986 interp_mask_work(:) = 1
987 interp_mask_facex(:) = 1
988 interp_mask_facey(:) = 1
989 interp_mask_facez(:) = 1
990 interp_mask_ec(:) = 1
991 interp_mask_nc(:) = 1
992
993!-----Set default values for interp_masks for restriction
994 interp_mask_unk_res(:) = 1
995 interp_mask_work_res(:) = 1
996 interp_mask_facex_res(:) = 1
997 interp_mask_facey_res(:) = 1
998 interp_mask_facez_res(:) = 1
999 interp_mask_ec_res(:) = 1
1000 interp_mask_nc_res(:) = 1
1001
1002!-----Initialize index array defining the variables which
1003!-----constitute any divergence free fields
1004 Allocate(i_divf_fc_vars(3,nfield_divf))
1005 Do nfield = 1, nfield_divf
1006 i_divf_fc_vars(:,nfield) = nfield
1007 End Do ! End Do nfield = 1, nfield_divf
1008
1009!-----Initialization required for boundary condition routine
1010 Call amr_bcset_init
1011 Call amr_1blk_guardcell_reset
1012
1013!-----Mark amr_gsurrounding_blks uncalled. This will be set to +1 if
1014!-----and when amr_gsurrounding_blks is called.
1015 gsurrblks_set = -1
1016
1017!-----Initialize grid change marker flag
1018!-----Initial value = 1 reflects a changed grid.
1019 grid_changed = 1
1020
1021!-----Initialize flag to detect if amr_checkpoint_re or amr_refine_derefine
1022!-----have been called. grid_analysed_mpi = +1 means tha one of them has, so
1023!-----the mpi version will have control info for any communication dependent
1024!-----routines.
1025 grid_analysed_mpi = -1
1026
1027!-----Initialize mpi communication pattern id
1028 mpi_pattern_id = 0
1029
1030!-----set state flags used by mpi communications
1031 lrestrict_in_progress = .false.
1032 lprolong_in_progress = .false.
1033 lguard_in_progress = .false.
1034
1035!-----set state flags used by mpi block boundary info list
1036!---- -1 is unset. When set, it will have value 100.
1037 bc_block_neighs_status = -1
1038
1039!-----Initialize some arrays used in controling mpi communications
1040 commatrix_recv(:) = 0
1041 commatrix_send(:) = 0
1042
1043!-----initialize the instance counter
1044 instance = 0
1045
1046!-----FLASH: Ensure use_flash_surr_blks_fill is in an initialized state.
1047!-----At the moment it is only ever flipped to .true. by FLASH.
1048 use_flash_surr_blks_fill = .false.
1049
1050!-----FLASH: Add a flag that indicates whether surr_blks is in a
1051!-----valid state. The orrery surr_blk computation is run if
1052!-----set to .false.. Note: This flag is only referenced if
1053!-----use_flash_surr_blks_fill is .true..
1054 surr_blks_valid = .false.
1055
1056
1057 Call MPI_BARRIER(amr_mpi_meshComm,ierr)
1058
1059 If (timing_mpi) Then
1060 timer_amr_initialize = timer_amr_initialize &
1061 + mpi_wtime() - time1
1062 End If ! End If (timing_mpi)
1063
1064 Return
1065 End Subroutine amr_initialize
Note: See TracBrowser for help on using the repository browser.