From fcac1db487d3aaab6cbe6ac81936102a16a8decc Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Fri, 27 Jul 2012 21:37:57 -0300 Subject: [PATCH] Move domain subroutines to new module DOMAINS. --- src/domains.F90 | 478 +++++++++++++++++++++++++++++++++++++++++++++++ src/makefile | 22 ++- src/mesh.F90 | 3 +- src/problems.F90 | 385 +------------------------------------- 4 files changed, 493 insertions(+), 395 deletions(-) create mode 100644 src/domains.F90 diff --git a/src/domains.F90 b/src/domains.F90 new file mode 100644 index 0000000..1b17192 --- /dev/null +++ b/src/domains.F90 @@ -0,0 +1,478 @@ +!!****************************************************************************** +!! +!! This file is part of the AMUN source code, a program to perform +!! Newtonian or relativistic magnetohydrodynamical simulations on uniform or +!! adaptive mesh. +!! +!! Copyright (C) 2008-2012 Grzegorz Kowal +!! +!! This program is free software: you can redistribute it and/or modify +!! it under the terms of the GNU General Public License as published by +!! the Free Software Foundation, either version 3 of the License, or +!! (at your option) any later version. +!! +!! This program is distributed in the hope that it will be useful, +!! but WITHOUT ANY WARRANTY; without even the implied warranty of +!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!! GNU General Public License for more details. +!! +!! You should have received a copy of the GNU General Public License +!! along with this program. If not, see . +!! +!!****************************************************************************** +!! +!! module: DOMAINS +!! +!! This module handles the initialization of the problem domains. +!! +!! +!!****************************************************************************** +! +module domains + +! module variables are not implicit by default +! + implicit none + +! module variable to store the problem name +! + character(len=32), save :: problem = "blast" + +! by default everything is private +! + private + +! declare public subroutines +! + public :: initialize_domains, setup_domain + +!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! + contains +! +!=============================================================================== +!! +!!*** PUBLIC SUBROUTINES ***************************************************** +!! +!=============================================================================== +! +! subroutine INITIALIZE_DOMAINS: +! ----------------------------- +! +! Subroutine prepares module DOMAINS. +! +! +!=============================================================================== +! + subroutine initialize_domains() + +! include external procedures and variables +! + use parameters, only : get_parameter_string + +! local variables are not implicit by default +! + implicit none +! +!------------------------------------------------------------------------------- +! +! get the problem name +! + call get_parameter_string("problem", problem) + +!------------------------------------------------------------------------------- +! + end subroutine initialize_domains +! +!=============================================================================== +! +! subroutine SETUP_DOMAIN: +! ----------------------- +! +! Subroutine sets up the domain for selected problem. If there is no special +! domain required, sets up the default domain. +! +! +!=============================================================================== +! + subroutine setup_domain() + +! local variables are not implicit by default +! + implicit none +! +!------------------------------------------------------------------------------- +! +! select the domain setup depending on the problem name +! + select case(problem) + case default + call setup_domain_default() + end select + +!------------------------------------------------------------------------------- +! + end subroutine setup_domain +! +!=============================================================================== +!! +!!*** PRIVATE SUBROUTINES **************************************************** +!! +!=============================================================================== +! +! subroutine SETUP_DOMAIN_DEFAULT: +! ------------------------------- +! +! Subroutine sets the default domain of N₁xN₂xN₃ blocks in the right +! configuration. +! +! +!=============================================================================== +! + subroutine setup_domain_default() + +! include external procedures and variables +! + use blocks , only : pointer_meta, block_meta, block_data & + , append_metablock, append_datablock & + , associate_blocks, metablock_set_leaf & + , metablock_set_config, metablock_set_level & + , metablock_set_coord, metablock_set_bounds + use blocks , only : nsides, nfaces + use boundaries , only : xlbndry, xubndry, ylbndry, yubndry, zlbndry, zubndry + use coordinates, only : xmin, xmax, ymin, ymax, zmin, zmax + use coordinates, only : ir, jr, kr, res + +! local variables are not implicit by default +! + implicit none + +! local variables +! + integer :: i, j, k, n, p, il, jl, kl + real :: xl, xmn, xmx, yl, ymn, ymx, zl, zmn, zmx + +! local arrays +! + integer, dimension(3) :: loc, del + +! local pointers +! + type(block_meta), pointer :: pmeta, pnext + type(block_data), pointer :: pdata + +! allocatable arrays +! + integer, dimension(:,:,:), allocatable :: cfg + +! local pointer array +! + type(pointer_meta), dimension(:,:,:), allocatable :: block_array +! +!------------------------------------------------------------------------------- +! +! obtain the number of blocks +! + n = ir * jr * kr + +!! PREPARE BLOCK CONFIGURATION ARRAY +!! +! allocate the configuration array +! + allocate(cfg(ir,jr,kr)) + +! set the block configurations +! + cfg(1:ir,1:jr:2,1:kr:2) = 12 + + if (jr .gt. 1) then + cfg(1:ir,2:jr:2,1:kr:2) = 43 + cfg( ir,1:jr ,1:kr:2) = 13 + end if + + if (kr .gt. 1) then + cfg(1:ir,1:jr:2,2:kr:2) = 65 + if (jr .gt. 1) then + cfg(1:ir,2:jr:2,2:kr:2) = 78 + cfg( ir,1:jr ,2:kr:2) = 75 + end if + if (ir .eq. 1 .or. mod(jr,2) .eq. 1) then + cfg( ir, jr ,1:kr ) = 15 + else + cfg( 1 , jr ,1:kr ) = 48 + end if + end if + +!! ALLOCATE AND GENERATE META BLOCK CHAIN AND SET BLOCK CONFIGURATIONS +!! +! allocate the block pointer array +! + allocate(block_array(ir,jr,kr)) + +! generate the gray code for a given configuration and link the block in +! the proper order +! + loc(:) = (/ 0, 0, 0 /) + del(:) = (/ 1, 1, 1 /) + + p = 1 + do k = 1, kr + if (del(3) .eq. 1) loc(3) = loc(3) + del(3) + do j = 1, jr + if (del(2) .eq. 1) loc(2) = loc(2) + del(2) + do i = 1, ir + if (del(1) .eq. 1) loc(1) = loc(1) + del(1) + +! append a new metablock +! + call append_metablock(block_array(loc(1),loc(2),loc(3))%ptr) + +! set the configuration type +! + call metablock_set_config(block_array(loc(1),loc(2),loc(3))%ptr & + , cfg(loc(1),loc(2),loc(3))) + +! increase the block number +! + p = p + 1 + + if (del(1) .eq. -1) loc(1) = loc(1) + del(1) + end do + if (del(2) .eq. -1) loc(2) = loc(2) + del(2) + del(1) = - del(1) + end do + if (del(3) .eq. -1) loc(3) = loc(3) + del(3) + del(2) = - del(2) + end do + +! deallocate the configuration array +! + deallocate(cfg) + +!! FILL OUT THE REMAINING FIELDS AND ALLOCATE AND ASSOCIATE DATA BLOCKS +!! +! calculate block sizes +! + xl = (xmax - xmin) / ir + yl = (ymax - ymin) / jr + zl = (zmax - zmin) / kr + +! fill out block structure fields +! + do k = 1, kr + +! claculate the block position along Z +! + kl = (k - 1) * res(1,3) + +! calculate the Z bounds +! + zmn = zmin + (k - 1) * zl + zmx = zmin + k * zl + + do j = 1, jr + +! claculate the block position along Y +! + jl = (j - 1) * res(1,2) + +! calculate the Y bounds +! + ymn = ymin + (j - 1) * yl + ymx = ymin + j * yl + + do i = 1, ir + +! claculate the block position along Y +! + il = (i - 1) * res(1,1) + +! calculate the Z bounds +! + xmn = xmin + (i - 1) * xl + xmx = xmin + i * xl + +! assign a pointer +! + pmeta => block_array(i,j,k)%ptr + +! mark it as the leaf +! + call metablock_set_leaf(pmeta) + +! set the level +! + call metablock_set_level(pmeta, 1) + +! create a new data block +! + call append_datablock(pdata) + +! associate meta and data blocks +! + call associate_blocks(pmeta, pdata) + +! set block coordinates +! + call metablock_set_coord(pmeta, il, jl, kl) + +! set the bounds +! + call metablock_set_bounds(pmeta, xmn, xmx, ymn, ymx, zmn, zmx) + end do + end do + end do + +!! ASSIGN THE BLOCK NEIGHBORS +!! +! assign boundaries along the X direction +! + do k = 1, kr + do j = 1, jr + do i = 1, ir - 1 + +! assign a pointer +! + pmeta => block_array(i ,j,k)%ptr + +! assign neighbor +! + pnext => block_array(i+1,j,k)%ptr + +! assign their neighbor pointers +! + do p = 1, nfaces + pmeta%neigh(1,2,p)%ptr => pnext + pnext%neigh(1,1,p)%ptr => pmeta + end do + + end do + end do + end do + +! if periodic boundary conditions set edge block neighbors +! + if (xlbndry .eq. 'periodic' .and. xubndry .eq. 'periodic') then + do k = 1, kr + do j = 1, jr + +! assign pointers +! + pmeta => block_array( 1 ,j,k)%ptr + pnext => block_array(ir,j,k)%ptr + +! assign their neighbor pointers +! + do p = 1, nfaces + pmeta%neigh(1,1,p)%ptr => pnext + pnext%neigh(1,2,p)%ptr => pmeta + end do + end do + end do + end if + +! assign boundaries along the Y direction +! + do k = 1, kr + do j = 1, jr - 1 + do i = 1, ir + +! assign a pointer +! + pmeta => block_array(i,j ,k)%ptr + +! assign neighbor +! + pnext => block_array(i,j+1,k)%ptr + +! assign their neighbor pointers +! + do p = 1, nfaces + pmeta%neigh(2,2,p)%ptr => pnext + pnext%neigh(2,1,p)%ptr => pmeta + end do + + end do + end do + end do + +! if periodic boundary conditions set edge block neighbors +! + if (ylbndry .eq. 'periodic' .and. yubndry .eq. 'periodic') then + do k = 1, kr + do i = 1, ir + +! assign pointers +! + pmeta => block_array(i, 1 ,k)%ptr + pnext => block_array(i,jr,k)%ptr + +! assign their neighbor pointers +! + do p = 1, nfaces + pmeta%neigh(2,1,p)%ptr => pnext + pnext%neigh(2,2,p)%ptr => pmeta + end do + end do + end do + end if +#if NDIMS == 3 + +! assign boundaries along the Z direction +! + do k = 1, kr - 1 + do j = 1, jr + do i = 1, ir + +! assign a pointer +! + pmeta => block_array(i,j,k )%ptr + +! assign neighbor +! + pnext => block_array(i,j,k+1)%ptr + +! assign their neighbor pointers +! + do p = 1, nfaces + pmeta%neigh(3,2,p)%ptr => pnext + pnext%neigh(3,1,p)%ptr => pmeta + end do + + end do + end do + end do + +! if periodic boundary conditions set edge block neighbors +! + if (zlbndry .eq. 'periodic' .and. zubndry .eq. 'periodic') then + do j = 1, jr + do i = 1, ir + +! assign pointers +! + pmeta => block_array(i,j, 1 )%ptr + pnext => block_array(i,j,kr)%ptr + +! assign their neighbor pointers +! + do p = 1, nfaces + pmeta%neigh(3,1,p)%ptr => pnext + pnext%neigh(3,2,p)%ptr => pmeta + end do + end do + end do + end if +#endif /* NDIMS == 3 */ + +! deallocate the block pointer array +! + deallocate(block_array) + +!------------------------------------------------------------------------------- +! + end subroutine setup_domain_default + +!=============================================================================== +! +end module domains diff --git a/src/makefile b/src/makefile index 7ef001c..6c9d115 100644 --- a/src/makefile +++ b/src/makefile @@ -161,12 +161,12 @@ name = amun default: $(name).x sources = blocks.F90 boundaries.F90 config.F90 constants.F90 coordinates.F90 \ - driver.F90 equations.F90 error.F90 evolution.F90 forcing.F90 \ - integrals.F90 interpolations.F90 io.F90 mesh.F90 mpitools.F90 \ - parameters.F90 problems.F90 random.F90 refinement.F90 scheme.F90 \ - timers.F90 variables.F90 -objects = blocks.o boundaries.o config.o constants.o coordinates.o driver.o \ - equations.o error.o evolution.o forcing.o integrals.o \ + domains.F90 driver.F90 equations.F90 error.F90 evolution.F90 \ + forcing.F90 integrals.F90 interpolations.F90 io.F90 mesh.F90 \ + mpitools.F90 parameters.F90 problems.F90 random.F90 refinement.F90 \ + scheme.F90 timers.F90 variables.F90 +objects = blocks.o boundaries.o config.o constants.o coordinates.o domains.o \ + driver.o equations.o error.o evolution.o forcing.o integrals.o \ interpolations.o io.o mesh.o mpitools.o parameters.o problems.o \ random.o refinement.o scheme.o timers.o variables.o files = $(sources) makefile make.default config.in license.txt hosts @@ -217,6 +217,7 @@ error.o : error.F90 evolution.o : evolution.F90 blocks.o boundaries.o config.o coordinates.o \ forcing.o interpolations.o mesh.o mpitools.o problems.o \ scheme.o variables.o +domains.o : domains.F90 blocks.o boundaries.o coordinates.o parameters.o forcing.o : forcing.F90 constants.o coordinates.o mpitools.o \ parameters.o random.o variables.o integrals.o : integrals.F90 blocks.o coordinates.o evolution.o mpitools.o \ @@ -225,12 +226,13 @@ interpolations.o : interpolations.F90 blocks.o coordinates.o parameters.o \ variables.o io.o : io.F90 blocks.o config.o coordinates.o error.o evolution.o \ mpitools.o random.o scheme.o variables.o -mesh.o : mesh.F90 blocks.o coordinates.o error.o interpolations.o \ - mpitools.o problems.o refinement.o variables.o +mesh.o : mesh.F90 blocks.o coordinates.o domains.o error.o \ + interpolations.o mpitools.o problems.o refinement.o \ + variables.o mpitools.o : mpitools.F90 timers.o parameters.o : parameters.F90 mpitools.o -problems.o : problems.F90 blocks.o boundaries.o coordinates.o \ - equations.o error.o parameters.o scheme.o variables.o +problems.o : problems.F90 blocks.o coordinates.o equations.o error.o \ + parameters.o scheme.o variables.o refinement.o : refinement.F90 blocks.o coordinates.o parameters.o \ scheme.o variables.o scheme.o : scheme.F90 blocks.o coordinates.o interpolations.o \ diff --git a/src/mesh.F90 b/src/mesh.F90 index da3681c..6959167 100644 --- a/src/mesh.F90 +++ b/src/mesh.F90 @@ -154,9 +154,10 @@ module mesh use blocks , only : nchild, nsides, nfaces use blocks , only : get_mblocks, get_nleafs use coordinates, only : minlev, maxlev, res + use domains , only : setup_domain use error , only : print_info, print_error use mpitools, only : master, nproc, nprocs - use problems , only : setup_domain, setup_problem + use problems , only : setup_problem use refinement , only : check_refinement_criterion implicit none diff --git a/src/problems.F90 b/src/problems.F90 index 3922576..1ef56eb 100644 --- a/src/problems.F90 +++ b/src/problems.F90 @@ -45,7 +45,7 @@ module problems ! declare public subroutines ! - public :: initialize_problems, setup_domain, setup_problem + public :: initialize_problems, setup_problem !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! @@ -87,36 +87,6 @@ module problems ! !=============================================================================== ! -! subroutine SETUP_DOMAIN: -! ----------------------- -! -! Subroutine sets up the domain for selected problem. If there is no special -! domain required, sets up the default domain. -! -! -!=============================================================================== -! - subroutine setup_domain() - -! local variables are not implicit by default -! - implicit none -! -!------------------------------------------------------------------------------- -! -! select the domain setup depending on the problem name -! - select case(problem) - case default - call setup_domain_default() - end select - -!------------------------------------------------------------------------------- -! - end subroutine setup_domain -! -!=============================================================================== -! ! subroutine SETUP_PROBLEM: ! ------------------------ ! @@ -171,359 +141,6 @@ module problems !! !=============================================================================== ! -! subroutine SETUP_DOMAIN_DEFAULT: -! ------------------------------- -! -! Subroutine sets the default domain of N₁xN₂xN₃ blocks in the right -! configuration. -! -! -!=============================================================================== -! - subroutine setup_domain_default() - -! include external procedures and variables -! - use blocks , only : pointer_meta, block_meta, block_data & - , append_metablock, append_datablock & - , associate_blocks, metablock_set_leaf & - , metablock_set_config, metablock_set_level & - , metablock_set_coord, metablock_set_bounds - use blocks , only : nsides, nfaces - use boundaries , only : xlbndry, xubndry, ylbndry, yubndry, zlbndry, zubndry - use coordinates, only : xmin, xmax, ymin, ymax, zmin, zmax - use coordinates, only : ir, jr, kr, res - -! local variables are not implicit by default -! - implicit none - -! local variables -! - integer :: i, j, k, n, p, il, jl, kl - real :: xl, xmn, xmx, yl, ymn, ymx, zl, zmn, zmx - -! local arrays -! - integer, dimension(3) :: loc, del - -! local pointers -! - type(block_meta), pointer :: pmeta, pnext - type(block_data), pointer :: pdata - -! allocatable arrays -! - integer, dimension(:,:,:), allocatable :: cfg - -! local pointer array -! - type(pointer_meta), dimension(:,:,:), allocatable :: block_array -! -!------------------------------------------------------------------------------- -! -! obtain the number of blocks -! - n = ir * jr * kr - -!! PREPARE BLOCK CONFIGURATION ARRAY -!! -! allocate the configuration array -! - allocate(cfg(ir,jr,kr)) - -! set the block configurations -! - cfg(1:ir,1:jr:2,1:kr:2) = 12 - - if (jr .gt. 1) then - cfg(1:ir,2:jr:2,1:kr:2) = 43 - cfg( ir,1:jr ,1:kr:2) = 13 - end if - - if (kr .gt. 1) then - cfg(1:ir,1:jr:2,2:kr:2) = 65 - if (jr .gt. 1) then - cfg(1:ir,2:jr:2,2:kr:2) = 78 - cfg( ir,1:jr ,2:kr:2) = 75 - end if - if (ir .eq. 1 .or. mod(jr,2) .eq. 1) then - cfg( ir, jr ,1:kr ) = 15 - else - cfg( 1 , jr ,1:kr ) = 48 - end if - end if - -!! ALLOCATE AND GENERATE META BLOCK CHAIN AND SET BLOCK CONFIGURATIONS -!! -! allocate the block pointer array -! - allocate(block_array(ir,jr,kr)) - -! generate the gray code for a given configuration and link the block in -! the proper order -! - loc(:) = (/ 0, 0, 0 /) - del(:) = (/ 1, 1, 1 /) - - p = 1 - do k = 1, kr - if (del(3) .eq. 1) loc(3) = loc(3) + del(3) - do j = 1, jr - if (del(2) .eq. 1) loc(2) = loc(2) + del(2) - do i = 1, ir - if (del(1) .eq. 1) loc(1) = loc(1) + del(1) - -! append a new metablock -! - call append_metablock(block_array(loc(1),loc(2),loc(3))%ptr) - -! set the configuration type -! - call metablock_set_config(block_array(loc(1),loc(2),loc(3))%ptr & - , cfg(loc(1),loc(2),loc(3))) - -! increase the block number -! - p = p + 1 - - if (del(1) .eq. -1) loc(1) = loc(1) + del(1) - end do - if (del(2) .eq. -1) loc(2) = loc(2) + del(2) - del(1) = - del(1) - end do - if (del(3) .eq. -1) loc(3) = loc(3) + del(3) - del(2) = - del(2) - end do - -! deallocate the configuration array -! - deallocate(cfg) - -!! FILL OUT THE REMAINING FIELDS AND ALLOCATE AND ASSOCIATE DATA BLOCKS -!! -! calculate block sizes -! - xl = (xmax - xmin) / ir - yl = (ymax - ymin) / jr - zl = (zmax - zmin) / kr - -! fill out block structure fields -! - do k = 1, kr - -! claculate the block position along Z -! - kl = (k - 1) * res(1,3) - -! calculate the Z bounds -! - zmn = zmin + (k - 1) * zl - zmx = zmin + k * zl - - do j = 1, jr - -! claculate the block position along Y -! - jl = (j - 1) * res(1,2) - -! calculate the Y bounds -! - ymn = ymin + (j - 1) * yl - ymx = ymin + j * yl - - do i = 1, ir - -! claculate the block position along Y -! - il = (i - 1) * res(1,1) - -! calculate the Z bounds -! - xmn = xmin + (i - 1) * xl - xmx = xmin + i * xl - -! assign a pointer -! - pmeta => block_array(i,j,k)%ptr - -! mark it as the leaf -! - call metablock_set_leaf(pmeta) - -! set the level -! - call metablock_set_level(pmeta, 1) - -! create a new data block -! - call append_datablock(pdata) - -! associate meta and data blocks -! - call associate_blocks(pmeta, pdata) - -! set block coordinates -! - call metablock_set_coord(pmeta, il, jl, kl) - -! set the bounds -! - call metablock_set_bounds(pmeta, xmn, xmx, ymn, ymx, zmn, zmx) - end do - end do - end do - -!! ASSIGN THE BLOCK NEIGHBORS -!! -! assign boundaries along the X direction -! - do k = 1, kr - do j = 1, jr - do i = 1, ir - 1 - -! assign a pointer -! - pmeta => block_array(i ,j,k)%ptr - -! assign neighbor -! - pnext => block_array(i+1,j,k)%ptr - -! assign their neighbor pointers -! - do p = 1, nfaces - pmeta%neigh(1,2,p)%ptr => pnext - pnext%neigh(1,1,p)%ptr => pmeta - end do - - end do - end do - end do - -! if periodic boundary conditions set edge block neighbors -! - if (xlbndry .eq. 'periodic' .and. xubndry .eq. 'periodic') then - do k = 1, kr - do j = 1, jr - -! assign pointers -! - pmeta => block_array( 1 ,j,k)%ptr - pnext => block_array(ir,j,k)%ptr - -! assign their neighbor pointers -! - do p = 1, nfaces - pmeta%neigh(1,1,p)%ptr => pnext - pnext%neigh(1,2,p)%ptr => pmeta - end do - end do - end do - end if - -! assign boundaries along the Y direction -! - do k = 1, kr - do j = 1, jr - 1 - do i = 1, ir - -! assign a pointer -! - pmeta => block_array(i,j ,k)%ptr - -! assign neighbor -! - pnext => block_array(i,j+1,k)%ptr - -! assign their neighbor pointers -! - do p = 1, nfaces - pmeta%neigh(2,2,p)%ptr => pnext - pnext%neigh(2,1,p)%ptr => pmeta - end do - - end do - end do - end do - -! if periodic boundary conditions set edge block neighbors -! - if (ylbndry .eq. 'periodic' .and. yubndry .eq. 'periodic') then - do k = 1, kr - do i = 1, ir - -! assign pointers -! - pmeta => block_array(i, 1 ,k)%ptr - pnext => block_array(i,jr,k)%ptr - -! assign their neighbor pointers -! - do p = 1, nfaces - pmeta%neigh(2,1,p)%ptr => pnext - pnext%neigh(2,2,p)%ptr => pmeta - end do - end do - end do - end if -#if NDIMS == 3 - -! assign boundaries along the Z direction -! - do k = 1, kr - 1 - do j = 1, jr - do i = 1, ir - -! assign a pointer -! - pmeta => block_array(i,j,k )%ptr - -! assign neighbor -! - pnext => block_array(i,j,k+1)%ptr - -! assign their neighbor pointers -! - do p = 1, nfaces - pmeta%neigh(3,2,p)%ptr => pnext - pnext%neigh(3,1,p)%ptr => pmeta - end do - - end do - end do - end do - -! if periodic boundary conditions set edge block neighbors -! - if (zlbndry .eq. 'periodic' .and. zubndry .eq. 'periodic') then - do j = 1, jr - do i = 1, ir - -! assign pointers -! - pmeta => block_array(i,j, 1 )%ptr - pnext => block_array(i,j,kr)%ptr - -! assign their neighbor pointers -! - do p = 1, nfaces - pmeta%neigh(3,1,p)%ptr => pnext - pnext%neigh(3,2,p)%ptr => pmeta - end do - end do - end do - end if -#endif /* NDIMS == 3 */ - -! deallocate the block pointer array -! - deallocate(block_array) - -!------------------------------------------------------------------------------- -! - end subroutine setup_domain_default -! !=============================================================================== ! ! subroutine SETUP_PROBLEM_BLAST: