module fd4_globaldef_mod module fd4_vartab_mod module fd4_block_mod module fd4_domain_mod module fd4_iter_mod module fd4_mpi_mod module fd4_mpitype_mod module fd4_comm_mod module fd4_stat_mod module fd4_neigh_mod module rbtree_fd4_neigh_mod module rbtree_int_mod module rbtree_int8_mod module stack_mod module stack3_mod module section_modTypes:
public type fd4_couple_local_desc public type fd4_coupleVariables:
integer (kind=i_k), private, parameter :: CPL_PUT = 1 integer (kind=i_k), private, parameter :: CPL_GET = 2 integer (kind=i_k), private, parameter :: CPL_GET_NOFACE = 3 integer (kind=i_k), private, parameter :: CPL_GET_CASE = 4 integer (kind=i_k), private, parameter :: CPL_GET_CASE_SKIP = 0 integer (kind=i_k), private, parameter :: CPL_GET_CASE_NORMAL = 1 integer (kind=i_k), private, parameter :: CPL_GET_CASE_CHECK_L = 2 integer (kind=i_k), private, parameter :: CPL_GET_CASE_CHECK_R = 3 integer (kind=i_k), private, parameter :: CPL_NEW = 1 integer (kind=i_k), private, parameter :: CPL_CRT = 2 integer (kind=i_k), private, parameter :: CPL_ADD = 3 integer (kind=i_k), private, parameter :: CPL_LADD = 4 integer (kind=i_k), private, parameter :: CPL_CMMT = 5 integer (kind=i_k), public, parameter :: FD4_CPL_GET = 1 integer (kind=i_k), public, parameter :: FD4_CPL_PUT = 2 integer (kind=i_k), public, parameter :: FD4_CPL_BOTH = IOR (FD4_CPL_GET, FD4_CPL_PUT) integer (kind=i_k), private, parameter :: FD4_NEIGH_CPL = 1 integer (kind=i_k), private, parameter :: FD4_NEIGH_FD4 = 2Subroutines and functions:
public subroutine fd4_couple_debug_metadata (cpl, name) public subroutine fd4_couple_create (cpl, domain, err, opt_nvar, opt_nabnd, opt_cpldir) public subroutine fd4_couple_add_array (cpl, rank, idx, st, abnd, cplarridx, err) public subroutine fd4_couple_set_local_3D_array (cpl, cplarridx, array, offset, err) public subroutine fd4_couple_set_local_4D_array (cpl, cplarridx, array4, offset, offset4, err) public subroutine fd4_couple_chg_local_3D_array (cpl, cplarridx, array, err) public subroutine fd4_couple_chg_local_4D_array (cpl, cplarridx, array4, err) public subroutine fd4_couple_commit (cpl, err, opt_face_overlap) private subroutine fd4_couple_build_cplarray_type (desc_local, abnd, bbnd, nbins, datatype, err) public subroutine fd4_couple_delete (cpl, err) public subroutine fd4_couple_put (cpl, err) public subroutine fd4_couple_get (cpl, err, opt_novnull) private subroutine fd4_couple_blocktype (domain, idx, st, ext, bnd, blocktype) public subroutine fd4_couple_mark_blocks (cpl, err) private subroutine fd4_couple_stack_global_merge (mpi, st, err)
Limitations:
real(r_k), allocatable :: array_Rho(:,:,:,:), array_Tmp(:,:,:,:) real(r_k), pointer :: arraypointer(:,:,:) type(fd4_couple) :: couple [...] initialize(array_Rho, array_Tmp, ...) [...] ! Create the couple context. call fd4_couple_create(couple, domain, err) ! Loop over all MPI processes to tell FD4 coupling metadata. do irank=0,nproc-1 ! Set cabnd(3,2) to the bounds of the coupling arrays of current rank. ! (here we simply calculate bounds for an 1D-partitioning) cabnd(1:3,1) = (/ 1+(irank*sizeX)/nproc, 1 , 1 /) cabnd(1:3,2) = (/ ((irank+1)*sizeX)/nproc, sizeY , sizeZ /) ! Add a couple array of current rank with given bounds. Associate it with variable ! index var_Rho and the given time step index. FD4 assigns an index to local couple ! arrays (i.e. those that belong to the calling rank) to caidx_Rho. call fd4_couple_add_array(couple, irank, var_Rho, step, cabnd, caidx_Rho, err) ! Add another couple array of current rank. call fd4_couple_add_array(couple, irank, var_Tmp, step, cabnd, caidx_Tmp, err) end do ! Assign the pointer and offset to relevant data of the local couple array. ! The argument must be a pointer. Use an additional pointer to point to an ! allocatable where required (contiguous subsections are allowed). arraypointer => array_Rho(:,:,:,2) call fd4_couple_set_local_3D_array(couple, caidx_Rho, arraypointer, (/1,1,1/), err) arraypointer => array_Tmp(:,:,:,1) call fd4_couple_set_local_3D_array(couple, caidx_Tmp, arraypointer, (/1,1,1/), err) ! Commit the couple context, FD4 now checks the couple arrays and prepares MPI data types call fd4_couple_commit(couple, err) ! Finally put data to FD4's data structures call fd4_couple_put(couple, err)
Some notes about sorting of the components of the mpi datatypes we are building here:
Author: Matthias Lieber
See also: module fd4_domain_mod
public type fd4_couple_local_desc real (kind=r_k), pointer, dimension (:,:,:) :: array => NULL () real (kind=r_k), pointer, dimension (:,:,:,:) :: array4 => NULL () integer (kind=i_k), dimension (3) :: offset = (/ 1, 1, 1 /) integer (kind=i_k) :: offset4 = 1 integer (kind=MPI_ADDRESS_KIND) :: disp end type fd4_couple_local_descComponents:
array | data array |
array4 | 4-dimensional data array (for variables with bins) |
offset | spatial offset of the data in array, e.g. (/1,1,1/) |
offset4 | offset of the data in the 4th dimension |
disp | memory address of the array |
public type fd4_couple type (fd4_domain), pointer :: domain => NULL () integer (kind=i_k), dimension (3,2) :: loopbnd integer, pointer, dimension (:,:,:,:,:) :: arraytypes => NULL () type (rbtree_fd4_neigh) :: neighstore integer (kind=i_k) :: ncplarrays = 0 integer (kind=i_k), pointer, dimension (:,:,:) :: rankbnd => NULL () integer (kind=i_k), dimension (3) :: faceoffset integer :: state = CPL_NEW integer, pointer, dimension (:) :: desc_rank => NULL () type (stack3) :: desc_var type (stack3) :: desc_abnd type (fd4_couple_local_desc), pointer, dimension (:) :: desc_local => NULL () integer (kind=i_k) :: ins_rank = 0 integer (kind=i_k) :: cpldir = FD4_CPL_BOTH integer (kind=i_k) :: stat_put integer (kind=i_k) :: stat_get logical :: face_overlap = .true. end type fd4_coupleComponents:
domain | the domain |
loopbnd | bounds for the loop over blocks |
arraytypes | pre-built MPI types for couple arrays |
neighstore | MPI types for each communication partner are stored in a rbtree |
ncplarrays | number of local couple arrays in couple description |
rankbnd | union bounds of all couple arrays for each rank |
faceoffset | offset to local block bounds union due to face variables |
state | state of couple context |
desc_rank | starting points in desc_var per rank |
desc_var | (idx, step, abnd_index) of all couple arrays |
desc_abnd | abnd (two stack3 entries) of a couple array |
desc_local | pointer and offset of local coupling arrays |
ins_rank | last inserted rank |
cpldir | direction of coupling (get/put/both) |
stat_put | index of transferred bytes in the statistics object |
stat_get | index of transferred bytes in the statistics object |
face_overlap | do couple arrays for face variables overlap? |
public subroutine fd4_couple_debug_metadata (cpl, name) type (fd4_couple), intent(in), target :: cpl character (len=*), intent(in) :: name end subroutine fd4_couple_debug_metadataParameters:
cpl | couple context |
name | file name prefix |
public subroutine fd4_couple_create (cpl, domain, err, opt_nvar, opt_nabnd, opt_cpldir) type (fd4_couple), intent(inout) :: cpl type (fd4_domain), intent(inout), target :: domain integer (kind=i_k), intent(out) :: err integer (kind=i_k), optional, intent(in) :: opt_nvar integer (kind=i_k), optional, intent(in) :: opt_nabnd integer (kind=i_k), optional, intent(in) :: opt_cpldir end subroutine fd4_couple_createParameters:
cpl | couple context |
domain | the domain |
err | error status: 0...ok |
opt_nvar | number of coupling arrays per rank (hint) |
opt_nabnd | number of different global coupling array bounds per rank (hint) |
opt_cpldir | restriction of use (get/put/both) |
User may pass hints for the meta data creation (opt_nvar, opt_nabnd). Giving accurate hints speeds up the process of adding coupling arrays and reduces memory consumption. If possible, make use of these hints!
With opt_cpldir you can restrict the use of the couple context to fd4_couple_get and fd4_couple_put/fd4_mark_blocks. Use the parameters FD4_CPL_GET and FD4_CPL_PUT for these purpose. The default is no restriction (FD4_CPL_BOTH). The restriction is used by fd4_couple to reduce the effort in preparing MPI data types.
public subroutine fd4_couple_add_array (cpl, rank, idx, st, abnd, cplarridx, err) type (fd4_couple), intent(inout) :: cpl integer (kind=i_k), intent(in) :: rank integer (kind=i_k), intent(in) :: idx integer (kind=i_k), intent(in) :: st integer (kind=i_k), intent(in), dimension (3,2) :: abnd integer (kind=i_k), intent(inout) :: cplarridx integer (kind=i_k), intent(out) :: err end subroutine fd4_couple_add_arrayParameters:
cpl | couple context |
rank | owner of this coupling array |
idx | field index in vartab |
st | time step index |
abnd | bounds of the coupling array in global coordinates |
cplarridx | local couple array index (>0), unchanged if not local |
err | error status: 0...ok |
Only allowed after fd4_couple_create and before fd4_couple_set_local_*D_array. Consecutive calls must have equal or increasing rank arguments. All ranks must call this function for all coupling arrays (own and all other ranks').
public subroutine fd4_couple_set_local_3D_array (cpl, cplarridx, array, offset, err) type (fd4_couple), intent(inout) :: cpl integer (kind=i_k), intent(in) :: cplarridx real (kind=r_k), pointer, dimension (:,:,:) :: array integer (kind=i_k), intent(in), dimension (3) :: offset integer (kind=i_k), intent(out) :: err end subroutine fd4_couple_set_local_3D_arrayParameters:
cpl | couple context |
cplarridx | local couple array index, value returned by fd4_couple_add_array |
array | data array |
offset | spatial offset of the data in array, e.g. (/1,1,1/) |
err | error status: 0...ok |
Only allowed after fd4_couple_add_array and before fd4_couple_commit. Needs to be called for all local coupling arrays which have been added via fd4_couple_add_array with rank parameter == local rank.
public subroutine fd4_couple_set_local_4D_array (cpl, cplarridx, array4, offset, offset4, err) type (fd4_couple), intent(inout) :: cpl integer (kind=i_k), intent(in) :: cplarridx real (kind=r_k), pointer, dimension (:,:,:,:) :: array4 integer (kind=i_k), intent(in), dimension (3) :: offset integer (kind=i_k), intent(in) :: offset4 integer (kind=i_k), intent(out) :: err end subroutine fd4_couple_set_local_4D_arrayParameters:
cpl | couple context |
cplarridx | local couple array index, value returned by fd4_couple_add_array |
array4 | data array |
offset | spatial offset of the data in array, e.g. (/1,1,1/) |
offset4 | offset of the data in the 4th dimension |
err | error status: 0...ok |
Only allowed after fd4_couple_add_array and before fd4_couple_commit. Needs to be called for all local coupling arrays which have been added via fd4_couple_add_array with rank parameter == local rank.
public subroutine fd4_couple_chg_local_3D_array (cpl, cplarridx, array, err) type (fd4_couple), intent(inout) :: cpl integer (kind=i_k), intent(in) :: cplarridx real (kind=r_k), pointer, dimension (:,:,:) :: array integer (kind=i_k), intent(out) :: err end subroutine fd4_couple_chg_local_3D_arrayParameters:
cpl | couple context |
cplarridx | local couple array index, value returned by fd4_couple_add_array |
array | data array |
err | error status: 0...ok |
Only allowed after fd4_couple_commit.
public subroutine fd4_couple_chg_local_4D_array (cpl, cplarridx, array4, err) type (fd4_couple), intent(inout) :: cpl integer (kind=i_k), intent(in) :: cplarridx real (kind=r_k), pointer, dimension (:,:,:,:) :: array4 integer (kind=i_k), intent(out) :: err end subroutine fd4_couple_chg_local_4D_arrayParameters:
cpl | couple context |
cplarridx | local couple array index, value returned by fd4_couple_add_array |
array4 | data array |
err | error status: 0...ok |
Only allowed after fd4_couple_commit.
public subroutine fd4_couple_commit (cpl, err, opt_face_overlap) type (fd4_couple), intent(inout), target :: cpl integer (kind=i_k), intent(out) :: err logical, optional, intent(in) :: opt_face_overlap end subroutine fd4_couple_commitParameters:
cpl | couple context |
err | error status: 0...ok |
opt_face_overlap | Do the couple arrays for face variables overlap at the inner boundaries (one cell in face direction)? Default is yes. |
private subroutine fd4_couple_build_cplarray_type (desc_local, abnd, bbnd, nbins, datatype, err) type (fd4_couple_local_desc), intent(in) :: desc_local integer (kind=i_k), intent(in), dimension (3,2) :: abnd integer (kind=i_k), intent(in), dimension (3,2) :: bbnd integer (kind=i_k), intent(in) :: nbins integer, intent(out) :: datatype integer (kind=i_k), intent(out) :: err end subroutine fd4_couple_build_cplarray_typeParameters:
desc_local | description of couple local array |
abnd | bounds of couple array |
bbnd | bounds of this (locally non-existing) block |
nbins | number of bins of the variable in desc |
datatype | the MPI data type |
err | error status: 0...ok |
public subroutine fd4_couple_delete (cpl, err) type (fd4_couple), intent(inout) :: cpl integer (kind=i_k), intent(out) :: err end subroutine fd4_couple_deleteParameters:
cpl | couple context |
err | error status: 0...ok |
public subroutine fd4_couple_put (cpl, err) type (fd4_couple), intent(inout), target :: cpl integer (kind=i_k), intent(out) :: err end subroutine fd4_couple_putParameters:
cpl | couple context |
err | error status: 0...ok |
TODO:
public subroutine fd4_couple_get (cpl, err, opt_novnull) type (fd4_couple), intent(inout), target :: cpl integer (kind=i_k), intent(out) :: err logical, optional, intent(in) :: opt_novnull end subroutine fd4_couple_getParameters:
cpl | couple context |
err | error status: 0...ok |
opt_novnull | do not initalize the receiver arrays with vnull |
Additional limitation for face variables: The upper face cell plane of the blocks is just cut and not transferred to the couple arrays!
TODO:
private subroutine fd4_couple_blocktype (domain, idx, st, ext, bnd, blocktype) type (fd4_domain), intent(inout) :: domain integer (kind=i_k), intent(in) :: idx integer (kind=i_k), intent(in) :: st integer (kind=i_k), intent(in), dimension (3) :: ext integer (kind=i_k), intent(in), dimension (3,2) :: bnd integer, intent(out) :: blocktype end subroutine fd4_couple_blocktypeParameters:
domain | the domain |
idx | variable index |
st | time step index |
ext | block extents |
bnd | bound of spatial subset |
blocktype | MPI data type for the block |
Internal routine. Used in fd4_couple_put and fd4_couple_get.
public subroutine fd4_couple_mark_blocks (cpl, err) type (fd4_couple), intent(inout), target :: cpl integer (kind=i_k), intent(out) :: err end subroutine fd4_couple_mark_blocksParameters:
cpl | couple context |
err | error status: 0...ok |
Use this in a 3-stage coupling process:
TODO:
private subroutine fd4_couple_stack_global_merge (mpi, st, err) type (fd4_mpi), intent(inout) :: mpi type (stack), intent(inout) :: st integer (kind=i_k), intent(out) :: err end subroutine fd4_couple_stack_global_mergeParameters:
mpi | the domain's mpi context |
st | the stack |
err | error status: 0...ok |
Duplicates will be removed, the stack will be sorted. It is assumed that the process local stacks are already sorted.
Internal routine.