Module fd4_couple_mod


Uses:
    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_mod
Types:
    public type fd4_couple_local_desc
    public type fd4_couple
Variables:
    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
Subroutines 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)

Coupling of FD4 to other parallel model.

Limitations:

Preprocessor options: Example:
  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.
  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:

TODO:

Author: Matthias Lieber

See also: module fd4_domain_mod


Description of Types

fd4_couple_local_desc

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_desc
Components:
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
Description of one local coupling array. Used only internally.


fd4_couple

public type fd4_couple
    type (fd4_domain), pointer :: domain => NULL ()
    integer (kind=i_k), dimension (3,2) :: loopbnd
    integer, pointer, dimension (:,:,:,:,:) :: arraytypes
    type (fd4_mpitype), pointer, dimension (:) :: commtype
    integer (kind=i_k) :: toff
    integer (kind=i_k) :: ncplarrays = 0
    integer (kind=i_k), pointer, dimension (:,:,:) :: rankbnd
    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_couple
Components:
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
The FD4 couple context.

Description of Subroutines and Functions

fd4_couple_debug_metadata

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_metadata
Parameters:
cpl couple context
name file name prefix
Print some debug information about coupling meta data to files for each rank

fd4_couple_create

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_create
Parameters:
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)
Create FD4 couple context.

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!


fd4_couple_add_array

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_array
Parameters:
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
Add a coupling array to the FD4 couple context.

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').


fd4_couple_set_local_3D_array

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_array
Parameters:
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
Add a local 3D coupling array to the FD4 couple context.

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.


fd4_couple_set_local_4D_array

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_array
Parameters:
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
Add a local 4D coupling array to the FD4 couple context.

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.


fd4_couple_chg_local_3D_array

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_array
Parameters:
cpl couple context
cplarridx local couple array index, value returned by fd4_couple_add_array
array data array
err error status: 0...ok
Change a local 3D coupling array to the FD4 couple context.

Only allowed after fd4_couple_commit.


fd4_couple_chg_local_4D_array

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_array
Parameters:
cpl couple context
cplarridx local couple array index, value returned by fd4_couple_add_array
array4 data array
err error status: 0...ok
Change a local 4D coupling array to the FD4 couple context.

Only allowed after fd4_couple_commit.


fd4_couple_commit

public subroutine fd4_couple_commit (cpl, err)
    type (fd4_couple), intent(inout) :: cpl
    integer (kind=i_k), intent(out) :: err
end subroutine fd4_couple_commit
Parameters:
cpl couple context
err error status: 0...ok
Commit FD4 couple context.

TODO:


fd4_couple_build_cplarray_type

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_type
Parameters:
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
Build an MPI data type for a couple array and an FD4 block. Internal routine.

fd4_couple_delete

public subroutine fd4_couple_delete (cpl, err)
    type (fd4_couple), intent(inout) :: cpl
    integer (kind=i_k), intent(out) :: err
end subroutine fd4_couple_delete
Parameters:
cpl couple context
err error status: 0...ok
Delete the couple context and all its memory.

fd4_couple_put

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_put
Parameters:
cpl couple context
err error status: 0...ok
Put data to the framework. Each process contributes several blocks of data. desc%abnd has to be set in all processes correctly. You must supply the same desc as in fd4_couple_create, the only allowed change is the pointer to the data (desc%array).

TODO:


fd4_couple_get

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_get
Parameters:
cpl couple context
err error status: 0...ok
opt_novnull do not initalize the receiver arrays with vnull
Get data from the framework. Each process asks for several blocks of data. desc%abnd has to be set in all processes correctly.

Additional limitation for face variables: The upper face cell plane of the blocks is just cut and not transferred to the couple arrays!

TODO:


fd4_couple_blocktype

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_blocktype
Parameters:
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
Get an MPI data type for the variable described by (idx, st), a block of size ext, and a spatial subsection within the block described by bbnd. If an MPI data type with same properties has already been created, this type will be re-used.

Internal routine. Used in fd4_couple_put and fd4_couple_get.


fd4_couple_mark_blocks

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_blocks
Parameters:
cpl couple context
err error status: 0...ok
Pretend putting data to the framework and mark all framework blocks which need to be created to fully capture all threshold variables.

Use this in a 3-stage coupling process:

You must use the same parameters for fd4_couple_mark_blocks as for fd4_couple_put.

TODO:


fd4_couple_stack_global_merge

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_merge
Parameters:
mpi the domain's mpi context
st the stack
err error status: 0...ok
Merge the process-local stacks st to one global stack in every process.

Duplicates will be removed, the stack will be sorted. It is assumed that the process local stacks are already sorted.

Internal routine.