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 stack_mod module stack3_mod module rbtree_int_mod module rbtree_int8_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 = 5Subroutines and functions:
public subroutine fd4_couple_debug_metadata (cpl, name) public subroutine fd4_couple_create (cpl, domain, err, opt_nvar, opt_nabnd) 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) 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 (fd4_mpitype), pointer, dimension (:) :: commtype => NULL () integer (kind=i_k) :: toff 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 end type fd4_coupleComponents:
domain | the domain |
loopbnd | bounds for the loop over blocks |
arraytypes | pre-built mpi types for couple arrays |
commtype | couple array mpi types for each dest rank |
toff | offset of types for send/receive in commtype array |
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 |
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) 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 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) |
User may pass hints for the meta data creation. Giving accurate hints speeds up the process of adding coupling arrays and reduces memory consumption. If possible, make use of these hints!
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) type (fd4_couple), intent(inout), target :: cpl integer (kind=i_k), intent(out) :: err end subroutine fd4_couple_commitParameters:
cpl | couple context |
err | error status: 0...ok |
TODO:
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.