preprocessingModules.F90

Go to the documentation of this file.

module indirecthalo
    !
    !       This local module contains the derived data type used to
    !       determine the indirect halo's as well as an array of this type.
    !
    use precision
    implicit none
    save
 
    public
    private :: lessequalindirecthalotype
    private :: lessindirecthalotype
    !
    !       The definition of the derived data type indirectHaloType.
    !
    type indirecthalotype
 
        ! myBlock      : Local block ID of the halo.
        ! myI, myJ, myK: i,j,k indices of the halo.
        ! myDirectHalo : Index in the haloListType where the
        !                corresponding direct halo is stored.
        ! levOfInd     : Level of indirectness.
        ! donorProc    : Processor where donor of the direct halo is
        !                stored. In case this halo is a boundary
        !                halo, donorProc is set to -1.
 
        integer(kind=intType) :: myblock
        integer(kind=intType) :: myi, myj, myk
        integer(kind=intType) :: mydirecthalo
        integer(kind=intType) :: levofind
        integer(kind=intType) :: donorproc
 
    end type indirecthalotype
 
    ! Interface for the extension of the operators <= and <.
    ! These are needed for the sorting of indirectHaloType.
 
    interface operator(<=)
        module procedure lessequalindirecthalotype
    end interface operator(<=)
 
    interface operator(<)
        module procedure lessindirecthalotype
    end interface operator(<)
 
    ! nIndHalo         : Number of indirect halo's to be treated.
    ! indHalo(nIndHalo): The indirect halo's.
 
    integer(kind=intType) :: nindhalo
    type(indirecthalotype), dimension(:), allocatable :: indhalo
 
    ! nLevOfInd               : Number of levels of indirectness
    ! nHaloPerLev(0:nLevOfInd): Number of indirect halo's per level
    !                           of indirectness; stored in
    !                           cumulative storage format.
    ! nHaloPerProc(0:nProc)   : Number of indirect halo's per
    !                           processor for a given level of
    !                           indirectness; cumulative storage.
    !                           nHaloPerProc(0) is not 0,
    !                           because of the presence of boundary
    !                           halo's, which get proc ID -1.
 
    integer(kind=intType) :: nlevofind
    integer(kind=intType), dimension(:), allocatable :: nhaloperlev
    integer(kind=intType), dimension(:), allocatable :: nhaloperproc
 
contains
    !
    !         Functions to simulate the operators <= and <.
    !
    logical function lessequalindirecthalotype(g1, g2)
        !
        !         This function returns .true. if g1 <= g2 and .false.
        !         otherwise. The comparison is firstly based on the level of
        !         indirectness followed by the donor processor, the
        !         corresponding direct halo, my block ID and finally the i, j
        !         and k indices.
        !
        implicit none
        !
        !        Function arguments.
        !
        type(indirecthalotype), intent(in) :: g1, g2
 
        ! Compare the level of indirectness. If not equal, set
        ! lessEqual appropriately and return.
 
        if (g1%levOfInd < g2%levOfInd) then
            lessequalindirecthalotype = .true.
            return
        else if (g1%levOfInd > g2%levOfInd) then
            lessequalindirecthalotype = .false.
            return
        end if
 
        ! Compare the donor processors.
 
        if (g1%donorProc < g2%donorProc) then
            lessequalindirecthalotype = .true.
            return
        else if (g1%donorProc > g2%donorProc) then
            lessequalindirecthalotype = .false.
            return
        end if
 
        ! Compare the direct halo.
 
        if (g1%myDirectHalo < g2%myDirectHalo) then
            lessequalindirecthalotype = .true.
            return
        else if (g1%myDirectHalo > g2%myDirectHalo) then
            lessequalindirecthalotype = .false.
            return
        end if
 
        ! Compare my block ID.
 
        if (g1%myBlock < g2%myBlock) then
            lessequalindirecthalotype = .true.
            return
        else if (g1%myBlock > g2%myBlock) then
            lessequalindirecthalotype = .false.
            return
        end if
 
        ! Finally compare the halo indices. Start with k.
 
        if (g1%myK < g2%myK) then
            lessequalindirecthalotype = .true.
            return
        else if (g1%myK > g2%myK) then
            lessequalindirecthalotype = .false.
            return
        end if
 
        ! The j index.
 
        if (g1%myJ < g2%myJ) then
            lessequalindirecthalotype = .true.
            return
        else if (g1%myJ > g2%myJ) then
            lessequalindirecthalotype = .false.
            return
        end if
 
        ! The i index.
 
        if (g1%myI < g2%myI) then
            lessequalindirecthalotype = .true.
            return
        else if (g1%myI > g2%myI) then
            lessequalindirecthalotype = .false.
            return
        end if
 
        ! Both entities are identical. So set lessEqual to .true.
 
        lessequalindirecthalotype = .true.
 
    end function lessequalindirecthalotype
 
    !        ================================================================
 
    logical function lessindirecthalotype(g1, g2)
        !
        !         This function returns .true. If g1 < g2 and .false.
        !         otherwise. It is basically the same as the lessEqual
        !         function, except that the equality is now considered as
        !         .false.
        !
        implicit none
        !
        !        Function arguments.
        !
        type(indirecthalotype), intent(in) :: g1, g2
 
        ! Compare the level of indirectness. If not equal, set
        ! lessIndirectHaloType appropriately and return.
 
        if (g1%levOfInd < g2%levOfInd) then
            lessindirecthalotype = .true.
            return
        else if (g1%levOfInd > g2%levOfInd) then
            lessindirecthalotype = .false.
            return
        end if
 
        ! Compare the donor processors.
 
        if (g1%donorProc < g2%donorProc) then
            lessindirecthalotype = .true.
            return
        else if (g1%donorProc > g2%donorProc) then
            lessindirecthalotype = .false.
            return
        end if
 
        ! Compare the direct halo.
 
        if (g1%myDirectHalo < g2%myDirectHalo) then
            lessindirecthalotype = .true.
            return
        else if (g1%myDirectHalo > g2%myDirectHalo) then
            lessindirecthalotype = .false.
            return
        end if
 
        ! Compare my block id.
 
        if (g1%myBlock < g2%myBlock) then
            lessindirecthalotype = .true.
            return
        else if (g1%myBlock > g2%myBlock) then
            lessindirecthalotype = .false.
            return
        end if
 
        ! Finally compare the halo indices. Start with k.
 
        if (g1%myK < g2%myK) then
            lessindirecthalotype = .true.
            return
        else if (g1%myK > g2%myK) then
            lessindirecthalotype = .false.
            return
        end if
 
        ! The j index.
 
        if (g1%myJ < g2%myJ) then
            lessindirecthalotype = .true.
            return
        else if (g1%myJ > g2%myJ) then
            lessindirecthalotype = .false.
            return
        end if
 
        ! The i index.
 
        if (g1%myI < g2%myI) then
            lessindirecthalotype = .true.
            return
        else if (g1%myI > g2%myI) then
            lessindirecthalotype = .false.
            return
        end if
 
        ! Both entities are identical.
        ! So set lessIndirectHaloType to .false.
 
        lessindirecthalotype = .false.
 
    end function lessindirecthalotype
 
end module indirecthalo
module halolist
    !
    !       This local module contains temporary variables to create the
    !       list of halo cells and nodes.
    !
    use precision
    implicit none
    save
 
    public
    private :: lessequalhalolisttype
    private :: lesshalolisttype
    !
    !       The definition of the variables for the 3 lists.
    !
    type halolisttype
 
        ! myBlock:           local block ID of the halo.
        ! myI, myJ, myK:     i,j,k indices of the halo.
        ! donorProc :        processor where donor is stored. In case
        !                    the halo is a boundary halo, donorProc
        !                    is set to -1.
        ! donorBlock:        block ID of the donor. In case the halo
        !                    is a boundary halo donorBlock is set
        !                    to the corresponding boundary condition.
        ! dI, dJ, dK:        i,j,k indices of the donor.
        ! levOfInd:          level of indirectness.
        ! interp(..):        interpolants for the donor stencil; only
        !                    allocated for lists requiring this info.
        ! nPeriodicSubfaces: Number of periodic subfaces that are
        !                    crossed when going from the halo to the
        !                    donor. This is at most the level of
        !                    indirectness of the halo.
        ! periodicSubfaces:  The corresponding subfaces ID's according
        !                    to the sequence defined in periodicGlobal.
 
        integer(kind=intType) :: myblock
        integer(kind=intType) :: myi, myj, myk
        integer(kind=intType) :: donorproc, donorblock
        integer(kind=intType) :: di, dj, dk
        integer(kind=intType) :: levofind
        real(kind=realtype), dimension(:), pointer :: interp
 
        integer(kind=intType) :: nperiodicsubfaces
        integer(kind=intType), dimension(:), pointer :: periodicsubfaces
 
    end type halolisttype
 
    ! Interface for the extension of the operators <= and <.
    ! These are needed for the sorting of haloListType.
 
    interface operator(<=)
        module procedure lessequalhalolisttype
    end interface operator(<=)
 
    interface operator(<)
        module procedure lesshalolisttype
    end interface operator(<)
 
    ! nCellHalo1st: # of 1st level cell halo's
    ! nCellHalo2nd: # of 2nd level cell halo's
    ! nNodeHalo1st: # of 1st level node halo's
 
    integer(kind=intType) :: ncellhalo1st, ncellhalo2nd
    integer(kind=intType) :: nnodehalo1st
 
    ! iiCell1st: Counter variable for the 1st level cell halo's
    ! iiCell2nd: Counter variable for the 2nd level cell halo's
    ! iiNode1st: Counter variable for the 1st level node halo's
 
    integer(kind=intType) :: iicell1st, iicell2nd, iinode1st
 
    ! cellHalo1st(nCellHalo1st) :: List of halo info for 1st
    !                              level cell halo's.
    ! cellHalo2nd(nCellHalo2nd) :: Idem for 2nd level cell halo's.
    ! nodeHalo1st(nNodeHalo1st) :: Idem for 1st level node halo's.
 
    type(halolisttype), dimension(:), allocatable :: cellhalo1st
    type(halolisttype), dimension(:), allocatable :: cellhalo2nd
    type(halolisttype), dimension(:), allocatable :: nodehalo1st
 
    ! transformCell(nCellHalo1st,3) :: Short hand for the transformation
    !                                  matrix between the halo and
    !                                  the donor for cell based halo's.
    !                                  In principle the size equals the
    !                                  number of faces (i.e. direct)
    !                                  halo's, but the difference is
    !                                  not so large.
    ! transformNode(nNodeHalo1st,3) :: Idem for the nodes.
 
    integer(kind=intType), dimension(:, :), allocatable :: transformcell
    integer(kind=intType), dimension(:, :), allocatable :: transformnode
    !
    !       The definition of the index variables, which store for each
    !       i,j,k in the block the index in the corresponding list.
    !       I know I'm wasting memory here (because only the halo's are
    !       relevant), but that's not too much of a problem. The reason is
    !       that neither the metrics nor the variables have been allocated
    !       yet. So later on, much more memory is needed than the single
    !       integer for each cell/node used here.
    !
    type indexlisttype
 
        ! entryList(:,:,:)  :: Corresponding entry in the list.
        !                      Dimensions are either 0:ie,0:je,0:ke for
        !                      the node or 0:ib,0:jb,0:kb for the cell
        !                      based halo's. The latter is then suited
        !                      for the 2nd level halo's.
 
        integer(kind=intType), dimension(:, :, :), pointer :: entrylist
 
    end type indexlisttype
 
    ! nodeIndex(nDom) :: The node indices for every block.
    ! cellIndex(nDom) :: Idem for the cells.
 
    type(indexlisttype), allocatable, dimension(:) :: nodeindex
    type(indexlisttype), allocatable, dimension(:) :: cellindex
 
contains
    !
    !         Functions to simulate the operators <= and <.
    !
    logical function lessequalhalolisttype(g1, g2)
        !
        !         lessEqual returns .true. if g1 <= g2 and .false. otherwise.
        !         The comparison is firstly based on the processor ID of the
        !         donor. After that it depends whether the halo is a boundary
        !         halo or not. Note that boundary halo's have a donor processor
        !         if of -1, such that they are always first in the list.
        !
        implicit none
        !
        !        Function arguments.
        !
        type(halolisttype), intent(in) :: g1, g2
 
        ! Compare the donor processors first. If not equal,
        ! set lessEqual appropriately and return.
 
        if (g1%donorProc < g2%donorProc) then
            lessequalhalolisttype = .true.
            return
        else if (g1%donorProc > g2%donorProc) then
            lessequalhalolisttype = .false.
            return
        end if
 
        ! Donor processors are identical. Now it depends whether we are
        ! dealing with boundary halo's or not.
 
        boundary: if (g1%donorProc == -1) then ! And thus
            ! g2%donorProc == -1
 
            ! Both halo's are boundary halo's. Compare the block ID of
            ! the halo's.
 
            if (g1%myBlock < g2%myBlock) then
                lessequalhalolisttype = .true.
                return
            else if (g1%myBlock > g2%myBlock) then
                lessequalhalolisttype = .false.
                return
            end if
 
            ! Compare the boundary conditions, which are stored in
            ! donorBlock. Note that the sequence in BCTypes is such that
            ! the most important BC has the highest number.
 
            if (g1%donorBlock < g2%donorBlock) then
                lessequalhalolisttype = .true.
                return
            else if (g1%donorBlock > g2%donorBlock) then
                lessequalhalolisttype = .false.
                return
            end if
 
            ! As it is possible that indirect halo's need donor info from
            ! direct halo's or even indirect halo's with a smaller level
            ! of indirectness, compare the level of indirectness.
 
            if (g1%levOfInd < g2%levOfInd) then
                lessequalhalolisttype = .true.
                return
            else if (g1%levOfInd > g2%levOfInd) then
                lessequalhalolisttype = .false.
                return
            end if
 
            ! Compare the indices of the halo. First k, then j and
            ! finally i.
 
            if (g1%myK < g2%myK) then
                lessequalhalolisttype = .true.
                return
            else if (g1%myK > g2%myK) then
                lessequalhalolisttype = .false.
                return
            end if
 
            if (g1%myJ < g2%myJ) then
                lessequalhalolisttype = .true.
                return
            else if (g1%myJ > g2%myJ) then
                lessequalhalolisttype = .false.
                return
            end if
 
            if (g1%myI < g2%myI) then
                lessequalhalolisttype = .true.
                return
            else if (g1%myI > g2%myI) then
                lessequalhalolisttype = .false.
                return
            end if
 
            ! No need to compare anything else; g1 == g2.
 
            else boundary
 
            ! Both halo's are internal halo's, whose donor is stored on
            ! the same processor. Compare the donor blocks.
 
            if (g1%donorBlock < g2%donorBlock) then
                lessequalhalolisttype = .true.
                return
            else if (g1%donorBlock > g2%donorBlock) then
                lessequalhalolisttype = .false.
                return
            end if
 
            ! Also the blocks are identical. Compare the donor indices.
            ! First the k index.
 
            if (g1%dK < g2%dK) then
                lessequalhalolisttype = .true.
                return
            else if (g1%dK > g2%dK) then
                lessequalhalolisttype = .false.
                return
            end if
 
            ! The j index.
 
            if (g1%dJ < g2%dJ) then
                lessequalhalolisttype = .true.
                return
            else if (g1%dJ > g2%dJ) then
                lessequalhalolisttype = .false.
                return
            end if
 
            ! And the i index.
 
            if (g1%dI < g2%dI) then
                lessequalhalolisttype = .true.
                return
            else if (g1%dI > g2%dI) then
                lessequalhalolisttype = .false.
                return
            end if
 
            ! The donors are identical. Compare the halo's.
            ! First the block id.
 
            if (g1%myBlock < g2%myBlock) then
                lessequalhalolisttype = .true.
                return
            else if (g1%myBlock > g2%myBlock) then
                lessequalhalolisttype = .false.
                return
            end if
 
            ! Halo blocks are also identical. Finally compare the
            ! halo indices. Start with k.
 
            if (g1%myK < g2%myK) then
                lessequalhalolisttype = .true.
                return
            else if (g1%myK > g2%myK) then
                lessequalhalolisttype = .false.
                return
            end if
 
            ! The j index.
 
            if (g1%myJ < g2%myJ) then
                lessequalhalolisttype = .true.
                return
            else if (g1%myJ > g2%myJ) then
                lessequalhalolisttype = .false.
                return
            end if
 
            ! The i index.
 
            if (g1%myI < g2%myI) then
                lessequalhalolisttype = .true.
                return
            else if (g1%myI > g2%myI) then
                lessequalhalolisttype = .false.
                return
            end if
 
        end if boundary
 
        ! Both entities are identical. So set lessEqual to .true.
 
        lessequalhalolisttype = .true.
 
    end function lessequalhalolisttype
 
    !        ================================================================
 
    logical function lesshalolisttype(g1, g2)
        !
        !         This function returns .true. if g1 < g2 and .false.
        !         otherwise. It is basically the same as the lessEqual
        !         function, except that the equality is now considered as
        !         .false.
        !
        implicit none
        !
        !        Function arguments.
        !
        type(halolisttype), intent(in) :: g1, g2
 
        ! Compare the donor processors first. If not equal,
        ! set the function appropriately and return.
 
        if (g1%donorProc < g2%donorProc) then
            lesshalolisttype = .true.
            return
        else if (g1%donorProc > g2%donorProc) then
            lesshalolisttype = .false.
            return
        end if
 
        ! Donor processors are identical. Now it depends whether we are
        ! dealing with boundary halo's or not.
 
        boundary: if (g1%donorProc == -1) then ! And thus
            ! g2%donorProc == -1
 
            ! Both halo's are boundary halo's. Compare the block ID of
            ! the halo's.
 
            if (g1%myBlock < g2%myBlock) then
                lesshalolisttype = .true.
                return
            else if (g1%myBlock > g2%myBlock) then
                lesshalolisttype = .false.
                return
            end if
 
            ! Compare the boundary conditions, which are stored in
            ! donorBlock. Note that the sequence in BCTypes is such that
            ! the most important bc has the highest number.
 
            if (g1%donorBlock < g2%donorBlock) then
                lesshalolisttype = .true.
                return
            else if (g1%donorBlock > g2%donorBlock) then
                lesshalolisttype = .false.
                return
            end if
 
            ! As it is possible that indirect halo's need donor info from
            ! direct halo's or even indirect halo's with a smaller level
            ! of indirectness, compare the level of indirectness.
 
            if (g1%levOfInd < g2%levOfInd) then
                lesshalolisttype = .true.
                return
            else if (g1%levOfInd > g2%levOfInd) then
                lesshalolisttype = .false.
                return
            end if
 
            ! Compare the indices of the halo. First k, then j and
            ! finally i.
 
            if (g1%myK < g2%myK) then
                lesshalolisttype = .true.
                return
            else if (g1%myK > g2%myK) then
                lesshalolisttype = .false.
                return
            end if
 
            if (g1%myJ < g2%myJ) then
                lesshalolisttype = .true.
                return
            else if (g1%myJ > g2%myJ) then
                lesshalolisttype = .false.
                return
            end if
 
            if (g1%myI < g2%myI) then
                lesshalolisttype = .true.
                return
            else if (g1%myI > g2%myI) then
                lesshalolisttype = .false.
                return
            end if
 
            ! No need to compare anything else. G1 == g2.
 
            else boundary
 
            ! Both halo's are internal halo's, whose donor is stored on
            ! the same processor. Compare the donor blocks.
 
            if (g1%donorBlock < g2%donorBlock) then
                lesshalolisttype = .true.
                return
            else if (g1%donorBlock > g2%donorBlock) then
                lesshalolisttype = .false.
                return
            end if
 
            ! Also the blocks are identical. Compare the donor indices.
            ! First the k index.
 
            if (g1%dK < g2%dK) then
                lesshalolisttype = .true.
                return
            else if (g1%dK > g2%dK) then
                lesshalolisttype = .false.
                return
            end if
 
            ! The j index.
 
            if (g1%dJ < g2%dJ) then
                lesshalolisttype = .true.
                return
            else if (g1%dJ > g2%dJ) then
                lesshalolisttype = .false.
                return
            end if
 
            ! And the i index.
 
            if (g1%dI < g2%dI) then
                lesshalolisttype = .true.
                return
            else if (g1%dI > g2%dI) then
                lesshalolisttype = .false.
                return
            end if
 
            ! The donors are identical. Compare the halo's.
            ! First the block id.
 
            if (g1%myBlock < g2%myBlock) then
                lesshalolisttype = .true.
                return
            else if (g1%myBlock > g2%myBlock) then
                lesshalolisttype = .false.
                return
            end if
 
            ! Halo blocks are also identical. Finally compare the
            ! halo indices. Start with k.
 
            if (g1%myK < g2%myK) then
                lesshalolisttype = .true.
                return
            else if (g1%myK > g2%myK) then
                lesshalolisttype = .false.
                return
            end if
 
            ! The j index.
 
            if (g1%myJ < g2%myJ) then
                lesshalolisttype = .true.
                return
            else if (g1%myJ > g2%myJ) then
                lesshalolisttype = .false.
                return
            end if
 
            ! The i index.
 
            if (g1%myI < g2%myI) then
                lesshalolisttype = .true.
                return
            else if (g1%myI > g2%myI) then
                lesshalolisttype = .false.
                return
            end if
 
        end if boundary
 
        ! Both entities are identical.
        ! So set lessHaloListType to .false.
 
        lesshalolisttype = .false.
 
    end function lesshalolisttype
 
end module halolist
 
module checkvolblock
    !
    !       Local module, which contains the definition of the derived
    !       datatype used to test for negative volumes in the grid.
    !
    implicit none
    save
 
    type checkvolblocktype
 
        ! blockHasNegVol:              Whether or not the block
        !                              contains negative volumes.
        ! volumeIsNeg(2:il,2:jl,2:kl): Whether or not the owned volumes
        !                              are negative.
 
        logical :: blockhasnegvol
        logical, dimension(:, :, :), pointer :: volumeisneg
        logical :: blockhasskewedvol
        logical, dimension(:, :, :), pointer :: volumeisskewed
 
    end type checkvolblocktype
 
end module checkvolblock
module periodicinfo
    !
    !       Local module that contains derived datatypes as well as arrays
    !       of these derived datatypes to store information related to
    !       periodicity.
    !
    use precision
    implicit none
    save
 
    public
    private :: lesscgnsperiodictype
    private :: equalcgnsperiodictype
    private :: lessperiodicsubfaceshalot
    private :: lessequalperiodicsubfaceshalot
    private :: equalperiodicsubfaceshalot
 
    ! Definition of the derived data type for storing the periodic
    ! faces of the cgns grid a bit easier.
 
    type cgnsperiodictype
 
        ! cgnsBlock   :: the block ID in the cgns grid.
        ! cgnsSubface :: the suface ID in this block.
 
        integer(kind=intType) :: cgnsblock, cgnssubface
 
    end type cgnsperiodictype
 
    ! Interface for the extension of the operators < and ==.
    ! These are needed for the sorting and searching of
    ! cgnsPeriodicType.
 
    interface operator(<)
        module procedure lesscgnsperiodictype
    end interface operator(<)
 
    interface operator(==)
        module procedure equalcgnsperiodictype
    end interface operator(==)
 
    ! nPeriodicGlobal :: Total number of periodic faces in cgns grid.
    ! periodicGlobal  :: The corresponding faces.
 
    integer(kind=intType) :: nperiodicglobal
    type(cgnsperiodictype), dimension(:), allocatable :: periodicglobal
 
    ! Definition of the derived data type to store the periodic
    ! subfaces that are crossed when the halo and the donor are
    ! connected. The direction is from the halo to the donor.
 
    type periodicsubfaceshalotype
 
        ! internalHalo:      Whether or not the halo is an internal
        !                    halo, i.e. it is stored on the
        !                    same processor as the donor.
        ! indexInHaloList:   The corresponding index in either the
        !                    node or cell halo list.
        ! nPeriodicSubfaces: Number of periodic subfaces that are
        !                    crossed. This is at most the level of
        !                    indirectness of the halo.
        ! periodicSubfaces:  The corresponding subfaces ID's according
        !                    to the sequence defined in periodicGlobal.
 
        logical :: internalhalo
        integer(kind=intType) :: indexinhalolist
        integer(kind=intType) :: nperiodicsubfaces
        integer(kind=intType), dimension(:), pointer :: periodicsubfaces
 
    end type periodicsubfaceshalotype
 
    ! Interface for the extension of the operators <, <= and ==.
    ! This is needed for the sorting and comparing of variables of
    ! the type periodicSubfacesHaloType
 
    interface operator(<)
        module procedure lessperiodicsubfaceshalot
    end interface operator(<)
 
    interface operator(<=)
        module procedure lessequalperiodicsubfaceshalot
    end interface operator(<=)
 
    interface operator(==)
        module procedure equalperiodicsubfaceshalot
    end interface operator(==)
 
    !=================================================================
 
contains
 
    !=================================================================
    !
    !         Functions to simulate the operators < and ==.
    !
    logical function lesscgnsperiodictype(g1, g2)
        !
        !         lessCGNSPeriodicType returns .true. if g1 is considered
        !         smaller than g2. This comparison is first based on the block
        !         ID followed by the subface id.
        !
        implicit none
        !
        !        Function arguments.
        !
        type(cgnsperiodictype), intent(in) :: g1, g2
 
        ! Compare the block ID. If not equal set lessCGNSPeriodicType
        ! accordingly.
 
        if (g1%cgnsBlock < g2%cgnsBlock) then
            lesscgnsperiodictype = .true.
            return
        else if (g1%cgnsBlock > g2%cgnsBlock) then
            lesscgnsperiodictype = .false.
            return
        end if
 
        ! Block ID's are identical. Compare the subfaces.
 
        if (g1%cgnsSubface < g2%cgnsSubface) then
            lesscgnsperiodictype = .true.
            return
        else if (g1%cgnsSubface > g2%cgnsSubface) then
            lesscgnsperiodictype = .false.
            return
        end if
 
        ! Both objects are identical.
        ! Set lessCGNSPeriodicType to .false.
 
        lesscgnsperiodictype = .false.
 
    end function lesscgnsperiodictype
 
    !        ================================================================
 
    logical function equalcgnsperiodictype(g1, g2)
        !
        !         equalCGNSPeriodicType returns .true. if g1 is considered
        !         equal to g2, i.e. both the block and subface ID must match,
        !
        implicit none
        !
        !        Function arguments.
        !
        type(cgnsperiodictype), intent(in) :: g1, g2
 
        equalcgnsperiodictype = .false.
        if (g1%cgnsBlock == g2%cgnsBlock .and. &
            g1%cgnsSubface == g2%cgnsSubface) &
            equalcgnsperiodictype = .true.
 
    end function equalcgnsperiodictype
 
    !        ================================================================
 
    logical function lessperiodicsubfaceshalot(g1, g2)
        !
        !         lessPeriodicSubfacesHaloT returns .true. if g1 is
        !         considered smaller than g2.
        !
        implicit none
        !
        !        Function arguments.
        !
        type(periodicsubfaceshalotype), intent(in) :: g1, g2
        !
        !        Local variables.
        !
        integer(kind=intType) :: nn, i1, i2
 
        ! First compare whether or not both g1 and g2 are internal
        ! halo's. Fortran does not allow a direct comparison of
        ! logicals and therefore the integers i1 and i2 are used.
 
        i1 = 1; if (g1%internalHalo) i1 = 0
        i2 = 1; if (g2%internalHalo) i2 = 0
 
        if (i1 < i2) then
            lessperiodicsubfaceshalot = .true.
            return
        else if (i1 > i2) then
            lessperiodicsubfaceshalot = .false.
            return
        end if
 
        ! Compare the number of periodic subfaces.
 
        if (g1%nPeriodicSubfaces < g2%nPeriodicSubfaces) then
            lessperiodicsubfaceshalot = .true.
            return
        else if (g1%nPeriodicSubfaces > g2%nPeriodicSubfaces) then
            lessperiodicsubfaceshalot = .false.
            return
        end if
 
        ! The number of periodic subfaces is the same. Compare the
        ! subfaces themselves. It is assumed that the subfaces are
        ! sorted in increading order. This can be done, because the
        ! periodic transformations are commuting matrices.
 
        do nn = 1, g1%nPeriodicSubfaces
            if (g1%periodicSubfaces(nn) < g2%periodicSubfaces(nn)) then
                lessperiodicsubfaceshalot = .true.
                return
            else if (g1%periodicSubfaces(nn) > g2%periodicSubfaces(nn)) then
                lessperiodicsubfaceshalot = .false.
                return
            end if
        end do
 
        ! The periodic subfaces are identical as well. Compare the
        ! indices in the list.
 
        if (g1%indexInHaloList < g2%indexInHaloList) then
            lessperiodicsubfaceshalot = .true.
            return
        else if (g1%indexInHaloList > g2%indexInHaloList) then
            lessperiodicsubfaceshalot = .false.
            return
        end if
 
        ! Both objects are the same. Return .false.
 
        lessperiodicsubfaceshalot = .false.
 
    end function lessperiodicsubfaceshalot
 
    !        ================================================================
 
    logical function lessequalperiodicsubfaceshalot(g1, g2)
        !
        !         lessEqualPeriodicSubfacesHaloT returns .true. if g1 is
        !         considered smaller than or equal to g2.
        !
        implicit none
        !
        !        Function arguments.
        !
        type(periodicsubfaceshalotype), intent(in) :: g1, g2
        !
        !        Local variables.
        !
        integer(kind=intType) :: nn, i1, i2
 
        ! First compare whether or not both g1 and g2 are internal
        ! halo's. Fortran does not allow a direct comparison of
        ! logicals and therefore the integers i1 and i2 are used.
 
        i1 = 1; if (g1%internalHalo) i1 = 0
        i2 = 1; if (g2%internalHalo) i2 = 0
 
        if (i1 < i2) then
            lessequalperiodicsubfaceshalot = .true.
            return
        else if (i1 > i2) then
            lessequalperiodicsubfaceshalot = .false.
            return
        end if
 
        ! Compare the number of periodic subfaces.
 
        if (g1%nPeriodicSubfaces < g2%nPeriodicSubfaces) then
            lessequalperiodicsubfaceshalot = .true.
            return
        else if (g1%nPeriodicSubfaces > g2%nPeriodicSubfaces) then
            lessequalperiodicsubfaceshalot = .false.
            return
        end if
 
        ! The number of periodic subfaces is the same. Compare the
        ! subfaces themselves. It is assumed that the subfaces are
        ! sorted in increading order. This can be done, because the
        ! periodic transformations are commuting matrices.
 
        do nn = 1, g1%nPeriodicSubfaces
            if (g1%periodicSubfaces(nn) < g2%periodicSubfaces(nn)) then
                lessequalperiodicsubfaceshalot = .true.
                return
            else if (g1%periodicSubfaces(nn) > g2%periodicSubfaces(nn)) then
                lessequalperiodicsubfaceshalot = .false.
                return
            end if
        end do
 
        ! The periodic subfaces are identical as well. Compare the
        ! indices in the list.
 
        if (g1%indexInHaloList < g2%indexInHaloList) then
            lessequalperiodicsubfaceshalot = .true.
            return
        else if (g1%indexInHaloList > g2%indexInHaloList) then
            lessequalperiodicsubfaceshalot = .false.
            return
        end if
 
        ! Both objects are the same. Return .true.
 
        lessequalperiodicsubfaceshalot = .true.
 
    end function lessequalperiodicsubfaceshalot
 
    !        ================================================================
 
    logical function equalperiodicsubfaceshalot(g1, g2)
        !
        !         equalPeriodicSubfacesHaloT returns .true. if g1 is
        !         considered equal to g2. The equal operator is only used to
        !         find the different number of periodic transformations in
        !         determinePeriodicData. Hence only the periodic subfaces of
        !         the halo's are compared and g1 and g2 are considered equal
        !         if the subfaces are equal, even if other member variables
        !         differ.
        !
        implicit none
        !
        !        Function arguments.
        !
        type(periodicsubfaceshalotype), intent(in) :: g1, g2
        !
        !        Local variables.
        !
        integer(kind=intType) :: nn
 
        if (g1%nPeriodicSubfaces /= g2%nPeriodicSubfaces) then
            equalperiodicsubfaceshalot = .false.
            return
        end if
 
        do nn = 1, g1%nPeriodicSubfaces
            if (g1%periodicSubfaces(nn) /= g2%periodicSubfaces(nn)) then
                equalperiodicsubfaceshalot = .false.
                return
            end if
        end do
 
        equalperiodicsubfaceshalot = .true.
 
    end function equalperiodicsubfaceshalot
 
end module periodicinfo
module bchalo
    !
    !       This local module contains the derived datatype bcHaloType,
    !       which is used to determine the boundary condition for an
    !       indirect halo when the nearest direct halo's are all boundary
    !       halo's.
    !
    use precision
    implicit none
    save
 
    public
    private :: lessequalbchalotype
    !
    !       The definition of the derived datatype.
    !
    type bchalotype
 
        ! directHalo: Index in the haloListType where the
        !             corresponding direct halo is stored.
        ! BC:         Corresponding boundary condition.
 
        integer(kind=intType) :: directhalo, bc
 
    end type bchalotype
 
    ! Interface for the extension of the operator <= needed for the
    ! sorting of bcHaloType. Note that the = operator does not
    ! need to be defined, because bcHaloType only contains
    ! primitive types.
 
    interface operator(<=)
        module procedure lessequalbchalotype
    end interface operator(<=)
 
contains
    !
    logical function lessequalbchalotype(g1, g2)
        !
        !         Function to simulate the operator <= for bcHaloType.
        !         It first compares the boundary condition. If equal the index
        !         of the direct halo is compared, although this is not really
        !         important.
        !         LessEqual returns .true. if g1 <= g2 and .false. otherwise.
        !
        implicit none
        !
        !        Function arguments.
        !
        type(bchalotype), intent(in) :: g1, g2
 
        ! First compare the boundary conditions. Note that the sequence
        ! in BCTypes is such that the most important BC has the
        ! highest number.
 
        if (g1%BC < g2%BC) then
            lessequalbchalotype = .true.
            return
        else if (g1%BC > g2%BC) then
            lessequalbchalotype = .false.
            return
        end if
 
        ! Boundary conditions are equal. Just compare the index.
 
        if (g1%directHalo < g2%directHalo) then
            lessequalbchalotype = .true.
            return
        else if (g1%directHalo > g2%directHalo) then
            lessequalbchalotype = .false.
            return
        end if
 
        ! g1 and g2 are equal. Return .true.
 
        lessequalbchalotype = .true.
 
    end function lessequalbchalotype
 
    !        ================================================================
 
    subroutine sortbchalotype(bcHaloArray, nn)
        !
        !         SortBCHaloType sorts the given number of BCHalo's in
        !         increasing order. Note that this routine is called sort and
        !         not qsort, because only an insertion sort is done here. The
        !         reason is that nn <= 3 and thus an insertion sort is okay.
        !
        implicit none
        !
        !        Subroutine arguments
        !
        integer(kind=intType), intent(in) :: nn
        type(bchalotype), dimension(*), intent(inout) :: bcHaloArray
        !
        !        Local variables.
        !
        integer(kind=intType) :: i, j
 
        type(bchalotype) :: a
 
        do j = 1, nn
            a = bchaloarray(j)
            do i = (j - 1), 1, -1
                if (bchaloarray(i) <= a) exit
                bchaloarray(i + 1) = bchaloarray(i)
            end do
            bchaloarray(i + 1) = a
        end do
 
    end subroutine sortbchalotype
 
end module bchalo
 
module coarse1to1subface
    !
    !       This local module contains the derived datatype
    !       coarse1to1SubfaceType, which is used to determine the 1 to 1
    !       block boundaries for the coarser grids.
    !
    use precision
    implicit none
    save
    !
    !       The definition of the derived datatype.
    !
    type coarse1to1subfacetype
 
        ! Nodal range in the three coordinates directions for the
        ! coarse grid subface.
 
        integer(kind=intType) :: ibeg, jbeg, kbeg, iend, jend, kend
 
        ! Processor and block id of the neighboring block.
 
        integer(kind=intType) :: neighproc, neighblock
 
        ! Number of points in the three coordinate directions for the
        ! coarse grid donor subface.
 
        integer(kind=intType) :: ndi, ndj, ndk
 
        ! Corresponding i, j and k indices of the fine grid donor block
        ! for each of the coarse grid subface lines.
 
        integer(kind=intType), dimension(:), pointer :: idfine
        integer(kind=intType), dimension(:), pointer :: jdfine
        integer(kind=intType), dimension(:), pointer :: kdfine
 
    end type coarse1to1subfacetype
 
    ! Number of 1 to 1 fine grid subfaces on this processor.
 
    integer(kind=intType) :: nsubface1to1
 
    ! Array of 1 to 1 subfaces.
 
    type(coarse1to1subfacetype), dimension(:), allocatable :: subface1to1
 
end module coarse1to1subface
 
!      ==================================================================
 
module coarseninginfo
    !
    !       This local module contains the derived datatype
    !       coarseningInfoType, which stores for a given block the grid
    !       lines to keep for the coarse grid.
    !
    type coarseninginfotype
 
        ! Logical, which indicate whether or not a fine grid 1 to 1
        ! block boundary is still a 1 to 1 block boundary on the
        ! coarse grid.
 
        logical, dimension(:), pointer :: coarseis1to1
 
    end type coarseninginfotype
 
    ! Array to store the info for all the blocks.
 
    type(coarseninginfotype), dimension(:), allocatable :: coarseinfo
 
end module coarseninginfo