coarseUtils.F90

Go to the documentation of this file.

module coarseutils
 
contains
 
    subroutine createcoarseblocks(level)
        !
        !       createCoarseBlocks creates the block data structure for the
        !       given coarse grid from the 1 level finer grid. Only direct
        !       info is created, like owned coordinates, block sizes and
        !       subface info. Indirect info, like face normals, volumes, wall
        !       distances, etc. Are created later on. That info can be created
        !       independent of the finer grid.
        !
        use constants
        use block
        use inputtimespectral
        use coarse1to1subface
        use coarseninginfo
        use utils, only: terminate
        implicit none
        !
        !      Subroutine arguments.
        !
        integer(kind=intType), intent(in) :: level
        !
        !      Local variables.
        !
        integer :: ierr
 
        integer(kind=intType) :: i, j, k, ii, jj, kk, n1to1
        integer(kind=intType) :: nn, mm, iil, jjl, kkl, il, jl, kl
        integer(kind=intType) :: iBeg, jBeg, kBeg, iEnd, jEnd, kEnd
        integer(kind=intType) :: l1, L2, l3
        integer(kind=intType) :: levm1, donorOffset, fact
 
        integer(kind=intType), dimension(:), allocatable :: imap, iimap
        integer(kind=intType), dimension(:), allocatable :: jmap, jjmap
        integer(kind=intType), dimension(:), allocatable :: kmap, kkmap
 
        integer(kind=intType), dimension(:), pointer :: dfine
 
        logical, dimension(:), pointer :: iCo, jCo, kCo
 
        ! Store the finer grid level in levm1
 
        levm1 = level - 1
 
        ! Determine the total number of 1 to 1 block faces on this
        ! processor for the fine grid level.
 
        nsubface1to1 = 0
        do nn = 1, ndom
            nsubface1to1 = nsubface1to1 + flowdoms(nn, levm1, 1)%n1to1
        end do
 
        ! Allocate the memory for subface1to1 and coarseInfo.
 
        allocate (subface1to1(nsubface1to1), coarseinfo(ndom), stat=ierr)
        if (ierr /= 0) &
             call terminate("createCoarseBlocks", &
             "Memory allocation failure for subface1to1 &
             &and coarseInfo")
 
        ! Loop over the number of blocks on this processor.
 
        n1to1 = 0
        domains: do nn = 1, ndom
 
            ! If levm1 is 1, i.e. the finest grid, set the coarsenings to
            ! regular, as this is a regular grid.
 
            if (levm1 == 1) then
                flowdoms(nn, levm1, 1)%iCoarsened = regular
                flowdoms(nn, levm1, 1)%jCoarsened = regular
                flowdoms(nn, levm1, 1)%kCoarsened = regular
            end if
 
            ! Copy cgns block id, blockIsMoving and addGridVelocities.
            ! Although identical to the values on the finest grid level,
            ! it is copied anyway for consistency reasons.
 
            flowdoms(nn, level, 1)%cgnsBlockID = &
                flowdoms(nn, levm1, 1)%cgnsBlockID
            flowdoms(nn, level, 1)%blockIsMoving = &
                flowdoms(nn, levm1, 1)%blockIsMoving
            flowdoms(nn, level, 1)%addGridVelocities = &
                flowdoms(nn, levm1, 1)%addGridVelocities
 
            ! Store the number of fine nodes a bit easier and allocate the
            ! memory for the logicals iCo, jCo and kCo and for coarseIs1to1.
 
            iil = flowdoms(nn, levm1, 1)%il
            jjl = flowdoms(nn, levm1, 1)%jl
            kkl = flowdoms(nn, levm1, 1)%kl
 
            ii = flowdoms(nn, levm1, 1)%n1to1
            allocate (flowdoms(nn, levm1, 1)%iCo(iil), &
                      flowdoms(nn, levm1, 1)%jCo(jjl), &
                      flowdoms(nn, levm1, 1)%kCo(kkl), &
                      coarseinfo(nn)%coarseIs1to1(ii), stat=ierr)
            if (ierr /= 0) &
                 call terminate("createCoarseBlocks", &
                 "Memory allocation failure for iCo, jCo, kCo &
                 &and coarseIs1to1")
 
            ! Initialize iCo, jCo and kCo such that the block boundaries
            ! remain, but all other nodes can disappear. Set pointers to
            ! make the code more readable.
 
            ico => flowdoms(nn, levm1, 1)%iCo
            jco => flowdoms(nn, levm1, 1)%jCo
            kco => flowdoms(nn, levm1, 1)%kCo
 
            ico = .false.; ico(1) = .true.; ico(iil) = .true.
            jco = .false.; jco(1) = .true.; jco(jjl) = .true.
            kco = .false.; kco(1) = .true.; kco(kkl) = .true.
 
            ! Loop over the subfaces to keep their boundaries. Also internal
            ! block boundaries are kept.
 
            do i = 1, flowdoms(nn, levm1, 1)%nSubface
                ico(flowdoms(nn, levm1, 1)%inBeg(i)) = .true.
                ico(flowdoms(nn, levm1, 1)%inEnd(i)) = .true.
 
                jco(flowdoms(nn, levm1, 1)%jnBeg(i)) = .true.
                jco(flowdoms(nn, levm1, 1)%jnEnd(i)) = .true.
 
                kco(flowdoms(nn, levm1, 1)%knBeg(i)) = .true.
                kco(flowdoms(nn, levm1, 1)%knEnd(i)) = .true.
            end do
 
            ! Create the coarser grid in i-direction. In case the fine grid
            ! was already a nonregular coarsened block, start at the
            ! opposite boundary. For a regular grid simply start at the
            ! left boundary.
 
            if (flowdoms(nn, levm1, 1)%iCoarsened == leftstarted) then
 
                flowdoms(nn, level, 1)%iCoarsened = rightstarted
 
                do i = (iil - 1), 2, -1
                    if (.not. ico(i + 1)) ico(i) = .true.
                end do
 
            else
 
                flowdoms(nn, level, 1)%iCoarsened = leftstarted
 
                do i = 2, (iil - 1)
                    if (.not. ico(i - 1)) ico(i) = .true.
                end do
 
            end if
 
            ! Create the coarser grid in j-direction. Same story as in
            ! i-direction.
 
            if (flowdoms(nn, levm1, 1)%jCoarsened == leftstarted) then
 
                flowdoms(nn, level, 1)%jCoarsened = rightstarted
 
                do j = (jjl - 1), 2, -1
                    if (.not. jco(j + 1)) jco(j) = .true.
                end do
 
            else
 
                flowdoms(nn, level, 1)%jCoarsened = leftstarted
 
                do j = 2, (jjl - 1)
                    if (.not. jco(j - 1)) jco(j) = .true.
                end do
 
            end if
 
            ! Create the coarser grid in k-direction. Same story as in
            ! i- and j-direction.
 
            if (flowdoms(nn, levm1, 1)%kCoarsened == leftstarted) then
 
                flowdoms(nn, level, 1)%kCoarsened = rightstarted
 
                do k = (kkl - 1), 2, -1
                    if (.not. kco(k + 1)) kco(k) = .true.
                end do
 
            else
 
                flowdoms(nn, level, 1)%kCoarsened = leftstarted
 
                do k = 2, (kkl - 1)
                    if (.not. kco(k - 1)) kco(k) = .true.
                end do
 
            end if
 
            ! Determine the number of points in each direction for the
            ! coarse grid.
 
            il = 0
            do i = 1, iil
                if (ico(i)) il = il + 1
            end do
 
            jl = 0
            do j = 1, jjl
                if (jco(j)) jl = jl + 1
            end do
 
            kl = 0
            do k = 1, kkl
                if (kco(k)) kl = kl + 1
            end do
 
            ! Store the number of nodes and cells in the three directions
            ! and the dimensions for the halo based quantities.
 
            flowdoms(nn, level, 1)%il = il
            flowdoms(nn, level, 1)%jl = jl
            flowdoms(nn, level, 1)%kl = kl
 
            flowdoms(nn, level, 1)%nx = il - 1
            flowdoms(nn, level, 1)%ny = jl - 1
            flowdoms(nn, level, 1)%nz = kl - 1
 
            flowdoms(nn, level, 1)%ie = il + 1
            flowdoms(nn, level, 1)%je = jl + 1
            flowdoms(nn, level, 1)%ke = kl + 1
 
            flowdoms(nn, level, 1)%ib = il + 2
            flowdoms(nn, level, 1)%jb = jl + 2
            flowdoms(nn, level, 1)%kb = kl + 2
 
            ! If the coarsening was regular, i.e. if the number of fine
            ! grid cells is twice the number of coarse grid cells, reset
            ! the coarsening to regular.
 
            if (flowdoms(nn, levm1, 1)%nx == 2 * flowdoms(nn, level, 1)%nx) &
                flowdoms(nn, level, 1)%iCoarsened = regular
            if (flowdoms(nn, levm1, 1)%ny == 2 * flowdoms(nn, level, 1)%ny) &
                flowdoms(nn, level, 1)%jCoarsened = regular
            if (flowdoms(nn, levm1, 1)%nz == 2 * flowdoms(nn, level, 1)%nz) &
                flowdoms(nn, level, 1)%kCoarsened = regular
            !
            !         The variables, which control the restriction to and the
            !         interpolation from the coarser grid level.
            !
            ! Allocate the memory.
 
            i = flowdoms(nn, level, 1)%ie
            j = flowdoms(nn, level, 1)%je
            k = flowdoms(nn, level, 1)%ke
 
            allocate (flowdoms(nn, level, 1)%mgIFine(1:i, 2), &
                      flowdoms(nn, level, 1)%mgJFine(1:j, 2), &
                      flowdoms(nn, level, 1)%mgKFine(1:k, 2), &
                      flowdoms(nn, level, 1)%mgIWeight(2:il), &
                      flowdoms(nn, level, 1)%mgJWeight(2:jl), &
                      flowdoms(nn, level, 1)%mgKWeight(2:kl), &
                      flowdoms(nn, levm1, 1)%mgICoarse(2:iil, 2), &
                      flowdoms(nn, levm1, 1)%mgJCoarse(2:jjl, 2), &
                      flowdoms(nn, levm1, 1)%mgKCoarse(2:kkl, 2), stat=ierr)
            if (ierr /= 0) &
                 call terminate("createCoarseBlocks", &
                 "Memory allocation failure for interpolation &
                 &variables")
 
            ! Set the halo values to the halo indices of the fine level.
 
            flowdoms(nn, level, 1)%mgIFine(1, 1:2) = (/0, 1/)
            flowdoms(nn, level, 1)%mgJFine(1, 1:2) = (/0, 1/)
            flowdoms(nn, level, 1)%mgKFine(1, 1:2) = (/0, 1/)
 
            flowdoms(nn, level, 1)%mgIFine(i, 1) = flowdoms(nn, levm1, 1)%ie
            flowdoms(nn, level, 1)%mgIFine(i, 2) = flowdoms(nn, levm1, 1)%ib
            flowdoms(nn, level, 1)%mgJFine(j, 1) = flowdoms(nn, levm1, 1)%je
            flowdoms(nn, level, 1)%mgJFine(j, 2) = flowdoms(nn, levm1, 1)%jb
            flowdoms(nn, level, 1)%mgKFine(k, 1) = flowdoms(nn, levm1, 1)%ke
            flowdoms(nn, level, 1)%mgKFine(k, 2) = flowdoms(nn, levm1, 1)%kb
 
            ! Determine the restriction variables in i-direction.
 
            ii = 2
            do i = 2, iil
                if (ico(i)) then
                    if (ico(i - 1)) then
                        flowdoms(nn, level, 1)%mgIFine(ii, 1) = i
                        flowdoms(nn, level, 1)%mgIFine(ii, 2) = i
                        flowdoms(nn, level, 1)%mgIWeight(ii) = half
                    else
                        flowdoms(nn, level, 1)%mgIFine(ii, 1) = i - 1
                        flowdoms(nn, level, 1)%mgIFine(ii, 2) = i
                        flowdoms(nn, level, 1)%mgIWeight(ii) = one
                    end if
                    ii = ii + 1
                end if
            end do
 
            ! Determine the restriction variables in j-direction.
 
            jj = 2
            do j = 2, jjl
                if (jco(j)) then
                    if (jco(j - 1)) then
                        flowdoms(nn, level, 1)%mgJFine(jj, 1) = j
                        flowdoms(nn, level, 1)%mgJFine(jj, 2) = j
                        flowdoms(nn, level, 1)%mgJWeight(jj) = half
                    else
                        flowdoms(nn, level, 1)%mgJFine(jj, 1) = j - 1
                        flowdoms(nn, level, 1)%mgJFine(jj, 2) = j
                        flowdoms(nn, level, 1)%mgJWeight(jj) = one
                    end if
                    jj = jj + 1
                end if
            end do
 
            ! Determine the restriction variables in k-direction.
 
            kk = 2
            do k = 2, kkl
                if (kco(k)) then
                    if (kco(k - 1)) then
                        flowdoms(nn, level, 1)%mgKFine(kk, 1) = k
                        flowdoms(nn, level, 1)%mgKFine(kk, 2) = k
                        flowdoms(nn, level, 1)%mgKWeight(kk) = half
                    else
                        flowdoms(nn, level, 1)%mgKFine(kk, 1) = k - 1
                        flowdoms(nn, level, 1)%mgKFine(kk, 2) = k
                        flowdoms(nn, level, 1)%mgKWeight(kk) = one
                    end if
                    kk = kk + 1
                end if
            end do
 
            ! Determine the interpolation variables in i-direction.
 
            ii = 2
            do i = 2, iil
                if (ico(i)) then
                    if (ico(i - 1)) then
                        flowdoms(nn, levm1, 1)%mgICoarse(i, 1) = ii
                        flowdoms(nn, levm1, 1)%mgICoarse(i, 2) = ii
                    else
                        flowdoms(nn, levm1, 1)%mgICoarse(i, 1) = ii
                        flowdoms(nn, levm1, 1)%mgICoarse(i, 2) = ii + 1
                    end if
                    ii = ii + 1
                else
                    flowdoms(nn, levm1, 1)%mgICoarse(i, 1) = ii
                    flowdoms(nn, levm1, 1)%mgICoarse(i, 2) = ii - 1
                end if
            end do
 
            ! Determine the interpolation variables in j-direction.
 
            jj = 2
            do j = 2, jjl
                if (jco(j)) then
                    if (jco(j - 1)) then
                        flowdoms(nn, levm1, 1)%mgJCoarse(j, 1) = jj
                        flowdoms(nn, levm1, 1)%mgJCoarse(j, 2) = jj
                    else
                        flowdoms(nn, levm1, 1)%mgJCoarse(j, 1) = jj
                        flowdoms(nn, levm1, 1)%mgJCoarse(j, 2) = jj + 1
                    end if
                    jj = jj + 1
                else
                    flowdoms(nn, levm1, 1)%mgJCoarse(j, 1) = jj
                    flowdoms(nn, levm1, 1)%mgJCoarse(j, 2) = jj - 1
                end if
            end do
 
            ! Determine the interpolation variables in k-direction.
 
            kk = 2
            do k = 2, kkl
                if (kco(k)) then
                    if (kco(k - 1)) then
                        flowdoms(nn, levm1, 1)%mgKCoarse(k, 1) = kk
                        flowdoms(nn, levm1, 1)%mgKCoarse(k, 2) = kk
                    else
                        flowdoms(nn, levm1, 1)%mgKCoarse(k, 1) = kk
                        flowdoms(nn, levm1, 1)%mgKCoarse(k, 2) = kk + 1
                    end if
                    kk = kk + 1
                else
                    flowdoms(nn, levm1, 1)%mgKCoarse(k, 1) = kk
                    flowdoms(nn, levm1, 1)%mgKCoarse(k, 2) = kk - 1
                end if
            end do
            !
            !         The coordinate mapping from fine to coarse and coarse to
            !         fine. These are needed to determine the coarse grid subface
            !         info.
            !
            ! Allocate the memory.
 
            allocate (imap(iil), jmap(jjl), kmap(kkl), &
                      iimap(il), jjmap(jl), kkmap(kl), stat=ierr)
            if (ierr /= 0) &
                call terminate("createCoarseBlocks", &
                               "Memory allocation failure for imap, etc")
 
            ! Set the values of imap and iimap.
 
            ii = 1
            do i = 1, iil
                if (ico(i)) then
                    imap(i) = ii
                    iimap(ii) = i
                    ii = ii + 1
                end if
            end do
 
            ! Set the values of jmap and jjmap.
 
            jj = 1
            do j = 1, jjl
                if (jco(j)) then
                    jmap(j) = jj
                    jjmap(jj) = j
                    jj = jj + 1
                end if
            end do
 
            ! Set the values of kmap and kkmap.
 
            kk = 1
            do k = 1, kkl
                if (kco(k)) then
                    kmap(k) = kk
                    kkmap(kk) = k
                    kk = kk + 1
                end if
            end do
            !
            !         The subface info. Except for the subface range all other
            !         data can be copied. The range must be adapted and the donor
            !         range is created later, because the coarsening info of the
            !         donor block must be known.
            !
            flowdoms(nn, level, 1)%nSubface = flowdoms(nn, levm1, 1)%nSubface
            flowdoms(nn, level, 1)%n1to1 = flowdoms(nn, levm1, 1)%n1to1
            flowdoms(nn, level, 1)%nBocos = flowdoms(nn, levm1, 1)%nBocos
            flowdoms(nn, level, 1)%nViscBocos = flowdoms(nn, levm1, 1)%nViscBocos
 
            ! Allocate the memory.
 
            mm = flowdoms(nn, level, 1)%nSubface
            allocate (flowdoms(nn, level, 1)%BCType(mm), &
                      flowdoms(nn, level, 1)%BCFaceID(mm), &
                      flowdoms(nn, level, 1)%cgnsSubface(mm), &
                      flowdoms(nn, level, 1)%neighBlock(mm), &
                      flowdoms(nn, level, 1)%neighProc(mm), &
                      flowdoms(nn, level, 1)%groupNum(mm), &
                      flowdoms(nn, level, 1)%inBeg(mm), &
                      flowdoms(nn, level, 1)%jnBeg(mm), &
                      flowdoms(nn, level, 1)%knBeg(mm), &
                      flowdoms(nn, level, 1)%inEnd(mm), &
                      flowdoms(nn, level, 1)%jnEnd(mm), &
                      flowdoms(nn, level, 1)%knEnd(mm), &
                      flowdoms(nn, level, 1)%dinBeg(mm), &
                      flowdoms(nn, level, 1)%djnBeg(mm), &
                      flowdoms(nn, level, 1)%dknBeg(mm), &
                      flowdoms(nn, level, 1)%dinEnd(mm), &
                      flowdoms(nn, level, 1)%djnEnd(mm), &
                      flowdoms(nn, level, 1)%dknEnd(mm), &
                      flowdoms(nn, level, 1)%l1(mm), &
                      flowdoms(nn, level, 1)%l2(mm), &
                      flowdoms(nn, level, 1)%l3(mm), &
                      stat=ierr)
            if (ierr /= 0) &
                call terminate("createCoarseBlocks", &
                               "Memory allocation failure for subface info")
 
            ! Loop over the subfaces.
 
            subfaces: do mm = 1, flowdoms(nn, level, 1)%nSubface
 
                ! Determine the range of the coarse subface.
 
                flowdoms(nn, level, 1)%inBeg(mm) = &
                    imap(flowdoms(nn, levm1, 1)%inBeg(mm))
                flowdoms(nn, level, 1)%jnBeg(mm) = &
                    jmap(flowdoms(nn, levm1, 1)%jnBeg(mm))
                flowdoms(nn, level, 1)%knBeg(mm) = &
                    kmap(flowdoms(nn, levm1, 1)%knBeg(mm))
 
                flowdoms(nn, level, 1)%inEnd(mm) = &
                    imap(flowdoms(nn, levm1, 1)%inEnd(mm))
                flowdoms(nn, level, 1)%jnEnd(mm) = &
                    jmap(flowdoms(nn, levm1, 1)%jnEnd(mm))
                flowdoms(nn, level, 1)%knEnd(mm) = &
                    kmap(flowdoms(nn, levm1, 1)%knEnd(mm))
 
                ! Copy the rest of the subface info.
 
                flowdoms(nn, level, 1)%BCType(mm) = &
                    flowdoms(nn, levm1, 1)%BCType(mm)
                flowdoms(nn, level, 1)%BCFaceID(mm) = &
                    flowdoms(nn, levm1, 1)%BCFaceID(mm)
                flowdoms(nn, level, 1)%neighBlock(mm) = &
                    flowdoms(nn, levm1, 1)%neighBlock(mm)
                flowdoms(nn, level, 1)%neighProc(mm) = &
                    flowdoms(nn, levm1, 1)%neighProc(mm)
                flowdoms(nn, level, 1)%groupNum(mm) = &
                    flowdoms(nn, levm1, 1)%groupNum(mm)
                flowdoms(nn, level, 1)%cgnsSubface(mm) = &
                    flowdoms(nn, levm1, 1)%cgnsSubface(mm)
 
                flowdoms(nn, level, 1)%l1(mm) = flowdoms(nn, levm1, 1)%l1(mm)
                flowdoms(nn, level, 1)%l2(mm) = flowdoms(nn, levm1, 1)%l2(mm)
                flowdoms(nn, level, 1)%l3(mm) = flowdoms(nn, levm1, 1)%l3(mm)
 
                ! Create some info if this is a 1 to 1 subface. This is stored
                ! in the array subface1to1 and is needed to determine the donor
                ! info and to check if this is still a 1 to 1 subface on the
                ! coarse grid.
 
                subface_1to1: if (mm > flowdoms(nn, level, 1)%nBocos .and. &
                                  mm <= (flowdoms(nn, level, 1)%nBocos &
                                         + flowdoms(nn, level, 1)%n1to1)) then
 
                    ! Update the counter.
 
                    n1to1 = n1to1 + 1
 
                    ! Store the range of the 1 to 1 subface.
 
                    subface1to1(n1to1)%iBeg = flowdoms(nn, level, 1)%inBeg(mm)
                    subface1to1(n1to1)%jBeg = flowdoms(nn, level, 1)%jnBeg(mm)
                    subface1to1(n1to1)%kBeg = flowdoms(nn, level, 1)%knBeg(mm)
                    subface1to1(n1to1)%iEnd = flowdoms(nn, level, 1)%inEnd(mm)
                    subface1to1(n1to1)%jEnd = flowdoms(nn, level, 1)%jnEnd(mm)
                    subface1to1(n1to1)%kEnd = flowdoms(nn, level, 1)%knEnd(mm)
 
                    ! Store the new range of this subface a bit easier.
                    ! Make sure that i1, etc contains the lowest index.
 
                    ibeg = min(subface1to1(n1to1)%iBeg, subface1to1(n1to1)%iEnd)
                    jbeg = min(subface1to1(n1to1)%jBeg, subface1to1(n1to1)%jEnd)
                    kbeg = min(subface1to1(n1to1)%kBeg, subface1to1(n1to1)%kEnd)
 
                    iend = max(subface1to1(n1to1)%iBeg, subface1to1(n1to1)%iEnd)
                    jend = max(subface1to1(n1to1)%jBeg, subface1to1(n1to1)%jEnd)
                    kend = max(subface1to1(n1to1)%kBeg, subface1to1(n1to1)%kEnd)
 
                    ! And copy it back into subface1to1.
 
                    subface1to1(n1to1)%iBeg = ibeg
                    subface1to1(n1to1)%jBeg = jbeg
                    subface1to1(n1to1)%kBeg = kbeg
                    subface1to1(n1to1)%iEnd = iend
                    subface1to1(n1to1)%jEnd = jend
                    subface1to1(n1to1)%kEnd = kend
 
                    ! Store the processor and block ID of the donor.
 
                    subface1to1(n1to1)%neighProc = &
                        flowdoms(nn, level, 1)%neighProc(mm)
                    subface1to1(n1to1)%neighBlock = &
                        flowdoms(nn, level, 1)%neighBlock(mm)
 
                    ! Store the shorthand for the transformation matrix a
                    ! bit easier.
 
                    l1 = flowdoms(nn, level, 1)%l1(mm)
                    l2 = flowdoms(nn, level, 1)%l2(mm)
                    l3 = flowdoms(nn, level, 1)%l3(mm)
 
                    ! Determine the fine grid donor indices of the subface.
                    ! i-direction.
 
                    fact = 1
                    if (l1 < 0) fact = -1
                    ii = iend - ibeg + 1
 
                    l1 = abs(l1)
                    select case (l1)
                    case (1_inttype)
                        allocate (subface1to1(n1to1)%idfine(ii), stat=ierr)
                        dfine => subface1to1(n1to1)%idfine
                        subface1to1(n1to1)%ndi = ii
                        donoroffset = flowdoms(nn, levm1, 1)%dinBeg(mm)
                    case (2_inttype)
                        allocate (subface1to1(n1to1)%jdfine(ii), stat=ierr)
                        dfine => subface1to1(n1to1)%jdfine
                        subface1to1(n1to1)%ndj = ii
                        donoroffset = flowdoms(nn, levm1, 1)%djnBeg(mm)
                    case (3_inttype)
                        allocate (subface1to1(n1to1)%kdfine(ii), stat=ierr)
                        dfine => subface1to1(n1to1)%kdfine
                        subface1to1(n1to1)%ndk = ii
                        donoroffset = flowdoms(nn, levm1, 1)%dknBeg(mm)
                    end select
 
                    if (ierr /= 0) &
                        call terminate("createCoarseBlocks", &
                                       "Memory allocation failure for idfine")
 
                    ii = 1
                    do i = ibeg, iend
                        jj = fact * (iimap(i) - flowdoms(nn, levm1, 1)%inBeg(mm))
                        dfine(ii) = jj + donoroffset
                        ii = ii + 1
                    end do
 
                    ! Determine the fine grid donor indices of the subface.
                    ! j-direction.
 
                    fact = 1
                    if (l2 < 0) fact = -1
                    ii = jend - jbeg + 1
 
                    l2 = abs(l2)
                    select case (l2)
                    case (1_inttype)
                        allocate (subface1to1(n1to1)%idfine(ii), stat=ierr)
                        dfine => subface1to1(n1to1)%idfine
                        subface1to1(n1to1)%ndi = ii
                        donoroffset = flowdoms(nn, levm1, 1)%dinBeg(mm)
                    case (2_inttype)
                        allocate (subface1to1(n1to1)%jdfine(ii), stat=ierr)
                        dfine => subface1to1(n1to1)%jdfine
                        subface1to1(n1to1)%ndj = ii
                        donoroffset = flowdoms(nn, levm1, 1)%djnBeg(mm)
                    case (3_inttype)
                        allocate (subface1to1(n1to1)%kdfine(ii), stat=ierr)
                        dfine => subface1to1(n1to1)%kdfine
                        subface1to1(n1to1)%ndk = ii
                        donoroffset = flowdoms(nn, levm1, 1)%dknBeg(mm)
                    end select
 
                    if (ierr /= 0) &
                        call terminate("createCoarseBlocks", &
                                       "Memory allocation failure for jdfine")
 
                    jj = 1
                    do j = jbeg, jend
                        ii = fact * (jjmap(j) - flowdoms(nn, levm1, 1)%jnBeg(mm))
                        dfine(jj) = ii + donoroffset
                        jj = jj + 1
                    end do
 
                    ! Determine the fine grid donor indices of the subface.
                    ! k-direction.
 
                    fact = 1
                    if (l3 < 0) fact = -1
                    ii = kend - kbeg + 1
 
                    l3 = abs(l3)
                    select case (l3)
                    case (1_inttype)
                        allocate (subface1to1(n1to1)%idfine(ii), stat=ierr)
                        dfine => subface1to1(n1to1)%idfine
                        subface1to1(n1to1)%ndi = ii
                        donoroffset = flowdoms(nn, levm1, 1)%dinBeg(mm)
                    case (2_inttype)
                        allocate (subface1to1(n1to1)%jdfine(ii), stat=ierr)
                        dfine => subface1to1(n1to1)%jdfine
                        subface1to1(n1to1)%ndj = ii
                        donoroffset = flowdoms(nn, levm1, 1)%djnBeg(mm)
                    case (3_inttype)
                        allocate (subface1to1(n1to1)%kdfine(ii), stat=ierr)
                        dfine => subface1to1(n1to1)%kdfine
                        subface1to1(n1to1)%ndk = ii
                        donoroffset = flowdoms(nn, levm1, 1)%dknBeg(mm)
                    end select
 
                    if (ierr /= 0) &
                        call terminate("createCoarseBlocks", &
                                       "Memory allocation failure for kdfine")
 
                    kk = 1
                    do k = kbeg, kend
                        ii = fact * (kkmap(k) - flowdoms(nn, levm1, 1)%knBeg(mm))
                        dfine(kk) = ii + donoroffset
                        kk = kk + 1
                    end do
 
                end if subface_1to1
 
            end do subfaces
 
            ! Release the local memory allocated inside this loop.
 
            deallocate (imap, jmap, kmap, iimap, jjmap, kkmap, stat=ierr)
            if (ierr /= 0) &
                call terminate("createCoarseBlocks", &
                               "Deallocation error for imap, iimap, etc.")
 
            ! Allocate the memory for the coordinates of all time spectral
            ! solutions.
 
            ii = flowdoms(nn, level, 1)%ie
            jj = flowdoms(nn, level, 1)%je
            kk = flowdoms(nn, level, 1)%ke
 
            do mm = 1, ntimeintervalsspectral
                allocate (flowdoms(nn, level, mm)%x(0:ii, 0:jj, 0:kk, 3), stat=ierr)
                if (ierr /= 0) &
                    call terminate("createCoarseBlocks", &
                                   "Memory allocation failure for x")
            end do
 
            ! Copy the scalars such that they are known for all time
            ! spectral solutions.
 
            do mm = 2, ntimeintervalsspectral
 
                flowdoms(nn, level, mm)%nx = flowdoms(nn, level, 1)%nx
                flowdoms(nn, level, mm)%ny = flowdoms(nn, level, 1)%ny
                flowdoms(nn, level, mm)%nz = flowdoms(nn, level, 1)%nz
 
                flowdoms(nn, level, mm)%il = flowdoms(nn, level, 1)%il
                flowdoms(nn, level, mm)%jl = flowdoms(nn, level, 1)%jl
                flowdoms(nn, level, mm)%kl = flowdoms(nn, level, 1)%kl
 
                flowdoms(nn, level, mm)%ie = flowdoms(nn, level, 1)%ie
                flowdoms(nn, level, mm)%je = flowdoms(nn, level, 1)%je
                flowdoms(nn, level, mm)%ke = flowdoms(nn, level, 1)%ke
 
                flowdoms(nn, level, mm)%ib = flowdoms(nn, level, 1)%ib
                flowdoms(nn, level, mm)%jb = flowdoms(nn, level, 1)%jb
                flowdoms(nn, level, mm)%kb = flowdoms(nn, level, 1)%kb
 
                flowdoms(nn, level, mm)%nSubface = flowdoms(nn, level, 1)%nSubface
                flowdoms(nn, level, mm)%n1to1 = flowdoms(nn, level, 1)%n1to1
                flowdoms(nn, level, mm)%nBocos = flowdoms(nn, level, 1)%nBocos
                flowdoms(nn, level, mm)%nViscBocos = flowdoms(nn, level, 1)%nViscBocos
 
                flowdoms(nn, level, mm)%iCoarsened = flowdoms(nn, level, 1)%iCoarsened
                flowdoms(nn, level, mm)%jCoarsened = flowdoms(nn, level, 1)%jCoarsened
                flowdoms(nn, level, mm)%kCoarsened = flowdoms(nn, level, 1)%kCoarsened
 
                flowdoms(nn, level, mm)%blockIsMoving = &
                    flowdoms(nn, level, 1)%blockIsMoving
                flowdoms(nn, level, mm)%cgnsBlockID = &
                    flowdoms(nn, level, 1)%cgnsBlockID
 
                flowdoms(nn, level, mm)%addGridVelocities = &
                    flowdoms(nn, level, 1)%addGridVelocities
 
            end do
 
        end do domains
 
        ! Determine the owned coordinates.
 
        call coarseownedcoordinates(level)
 
        ! Determine the donor info for the internal block boundaries.
 
        call coarsedonorinfo(level)
 
        ! Remove possible coarse grid non-matching block boundaries from
        ! the 1 to 1 list.
 
        call checkcoarse1to1(level)
 
        ! Release the memory of the coarsening info.
 
        do nn = 1, ndom
            deallocate (coarseinfo(nn)%coarseIs1to1, stat=ierr)
            if (ierr /= 0) &
                call terminate("createCoarseBlocks", &
                               "Deallocation error for coarseIs1to1")
        end do
 
        deallocate (coarseinfo, stat=ierr)
        if (ierr /= 0) &
            call terminate("createCoarseBlocks", &
                           "Deallocation error for coarseInfo")
 
    end subroutine createcoarseblocks
 
    !      ==================================================================
 
    subroutine coarseownedcoordinates(level)
        !
        !       coarseOwnedCoordinates determines from the coarsening info
        !       the owned coordinates of the coarse grid. This is done in a
        !       separate routine, because in unsteady moving mesh mode or for
        !       deforming meshes only new coordinates need to be computed,
        !       while the connectivity remains the same.
        !
        use block
        use inputtimespectral
        implicit none
        !
        !      Subroutine arguments.
        !
        integer(kind=intType), intent(in) :: level
        !
        !      Local variables.
        !
        integer(kind=intType) :: i, j, k, ii, jj, kk
        integer(kind=intType) :: nn, mm, il, jl, kl, levm1
 
        logical, dimension(:), pointer :: iCo, jCo, kCo
 
        ! Store the finer grid level in levm1
 
        levm1 = level - 1
 
        ! Loop over the number of blocks on this processor
 
        domains: do nn = 1, ndom
 
            ! Easier storage of some variables of this block.
 
            il = flowdoms(nn, levm1, 1)%il
            jl = flowdoms(nn, levm1, 1)%jl
            kl = flowdoms(nn, levm1, 1)%kl
 
            ico => flowdoms(nn, levm1, 1)%iCo
            jco => flowdoms(nn, levm1, 1)%jCo
            kco => flowdoms(nn, levm1, 1)%kCo
 
            ! Loop over the fine grid lines in the three directions and
            ! determine which should be kept on the coarse grid.
 
            kk = 1
            do k = 1, kl
                if (kco(k)) then
                    jj = 1
                    do j = 1, jl
                        if (jco(j)) then
                            ii = 1
                            do i = 1, il
                                if (ico(i)) then
 
                                    ! Loop over the spectral solutions and copy the
                                    ! coordinates from the fine grid.
 
                                    do mm = 1, ntimeintervalsspectral
                                        flowdoms(nn, level, mm)%x(ii, jj, kk, 1) = &
                                            flowdoms(nn, levm1, mm)%x(i, j, k, 1)
                                        flowdoms(nn, level, mm)%x(ii, jj, kk, 2) = &
                                            flowdoms(nn, levm1, mm)%x(i, j, k, 2)
                                        flowdoms(nn, level, mm)%x(ii, jj, kk, 3) = &
                                            flowdoms(nn, levm1, mm)%x(i, j, k, 3)
                                    end do
 
                                    ii = ii + 1
                                end if
                            end do
                            jj = jj + 1
                        end if
                    end do
                    kk = kk + 1
                end if
            end do
 
        end do domains
 
    end subroutine coarseownedcoordinates
 
    subroutine update1to1coarse(level, subface)
        !
        !       update1to1Coarse determines whether or not the given 1 to 1
        !       block boundary subface on the fine level is still a 1 to 1
        !       subface on the coarser grid level.
        !
        use block
        use coarse1to1subface
        use coarseninginfo
        use utils, only: terminate
        implicit none
        !
        !      Subroutine arguments.
        !
        integer(kind=intType), intent(in) :: level
        type(coarse1to1subfacetype), intent(in) :: subface
        !
        !      Local variables.
        !
        integer(kind=intType) :: levm1, nn, mm, ii, jj, kk, ll
        integer(kind=intType) :: i, j, k
        integer(kind=intType) :: iBeg, jBeg, kBeg, iEnd, jEnd, kEnd
 
        logical :: subfaceFound, idir, jdir, kdir
 
        ! Store the finer grid level in levm1
 
        levm1 = level - 1
 
        ! Store the local block id a bit easier and store the minimum and
        ! maximum index in the three coordinate directions for the fine
        ! grid.
 
        nn = subface%neighBlock
 
        mm = subface%ndi
        ibeg = min(subface%idfine(1), subface%idfine(mm))
        iend = max(subface%idfine(1), subface%idfine(mm))
 
        mm = subface%ndj
        jbeg = min(subface%jdfine(1), subface%jdfine(mm))
        jend = max(subface%jdfine(1), subface%jdfine(mm))
 
        mm = subface%ndk
        kbeg = min(subface%kdfine(1), subface%kdfine(mm))
        kend = max(subface%kdfine(1), subface%kdfine(mm))
 
        ! Find the subface id of the block, which corresponds to the
        ! given subface of the subroutine header.
 
        subfacefound = .false.
        findsubface: do ii = 1, flowdoms(nn, levm1, 1)%n1to1
 
            mm = ii + flowdoms(nn, levm1, 1)%nBocos
 
            ! Check if this subface is the correct one.
 
            kk = min(flowdoms(nn, levm1, 1)%inBeg(mm), &
                     flowdoms(nn, levm1, 1)%inEnd(mm))
            ll = max(flowdoms(nn, levm1, 1)%inBeg(mm), &
                     flowdoms(nn, levm1, 1)%inEnd(mm))
 
            if (kk == ibeg .and. ll == iend) then
                kk = min(flowdoms(nn, levm1, 1)%jnBeg(mm), &
                         flowdoms(nn, levm1, 1)%jnEnd(mm))
                ll = max(flowdoms(nn, levm1, 1)%jnBeg(mm), &
                         flowdoms(nn, levm1, 1)%jnEnd(mm))
 
                if (kk == jbeg .and. ll == jend) then
                    kk = min(flowdoms(nn, levm1, 1)%knBeg(mm), &
                             flowdoms(nn, levm1, 1)%knEnd(mm))
                    ll = max(flowdoms(nn, levm1, 1)%knBeg(mm), &
                             flowdoms(nn, levm1, 1)%knEnd(mm))
 
                    if (kk == kbeg .and. ll == kend) subfacefound = .true.
                end if
            end if
 
            ! Exit the loop if this is indeed the subface.
 
            if (subfacefound) exit
        end do findsubface
 
        ! The subface must be found on the fine grid. Check this.
 
        if (.not. subfacefound) &
            call terminate("update1to1Coarse", &
                           "Invalid fine grid 1 to 1 subface connectivity")
 
        ! Check the i-direction of the coarse grid subface to see if it
        ! is still a 1 to 1 subface. First check the number of grid lines.
        ! If these are identical, check each coarse grid line.
 
        idir = .true.
        ii = abs(flowdoms(nn, level, 1)%inEnd(mm) &
                 - flowdoms(nn, level, 1)%inBeg(mm)) + 1
 
        if (ii == subface%ndi) then
            do i = 1, subface%ndi
                ii = subface%idfine(i)
                if (.not. flowdoms(nn, levm1, 1)%ico(ii)) idir = .false.
            end do
        else
            idir = .false.
        end if
 
        ! Check the j-direction of the coarse grid subface to see if it
        ! is still a 1 to 1 subface. First check the number of grid lines.
        ! If these are identical, check each coarse grid line.
 
        jdir = .true.
        jj = abs(flowdoms(nn, level, 1)%jnEnd(mm) &
                 - flowdoms(nn, level, 1)%jnBeg(mm)) + 1
 
        if (jj == subface%ndj) then
            do j = 1, subface%ndj
                jj = subface%jdfine(j)
                if (.not. flowdoms(nn, levm1, 1)%jco(jj)) jdir = .false.
            end do
        else
            jdir = .false.
        end if
 
        ! Check the k-direction of the coarse grid subface to see if it
        ! is still a 1 to 1 subface. First check the number of grid lines.
        ! If these are identical, check each coarse grid line.
 
        kdir = .true.
        kk = abs(flowdoms(nn, level, 1)%knEnd(mm) &
                 - flowdoms(nn, level, 1)%knBeg(mm)) + 1
 
        if (kk == subface%ndk) then
            do k = 1, subface%ndk
                kk = subface%kdfine(k)
                if (.not. flowdoms(nn, levm1, 1)%kco(kk)) kdir = .false.
            end do
        else
            kdir = .false.
        end if
 
        ! Set coarseIs1to1 to .true. if the subface on the coarse grid
        ! is still a 1 to 1 subface. Otherwise set it to .false.
 
        ii = mm - flowdoms(nn, levm1, 1)%nBocos
        if (idir .and. jdir .and. kdir) then
            coarseinfo(nn)%coarseIs1to1(ii) = .true.
        else
            coarseinfo(nn)%coarseIs1to1(ii) = .false.
        end if
 
        ! Store the donor range. It is possible that the lower and
        ! upper boundary must be reversed.
 
        if (flowdoms(nn, levm1, 1)%dinBeg(mm) < &
            flowdoms(nn, levm1, 1)%dinEnd(mm)) then
            flowdoms(nn, level, 1)%dinBeg(mm) = subface%iBeg
            flowdoms(nn, level, 1)%dinEnd(mm) = subface%iEnd
        else
            flowdoms(nn, level, 1)%dinBeg(mm) = subface%iEnd
            flowdoms(nn, level, 1)%dinEnd(mm) = subface%iBeg
        end if
 
        if (flowdoms(nn, levm1, 1)%djnBeg(mm) < &
            flowdoms(nn, levm1, 1)%djnEnd(mm)) then
            flowdoms(nn, level, 1)%djnBeg(mm) = subface%jBeg
            flowdoms(nn, level, 1)%djnEnd(mm) = subface%jEnd
        else
            flowdoms(nn, level, 1)%djnBeg(mm) = subface%jEnd
            flowdoms(nn, level, 1)%djnEnd(mm) = subface%jBeg
        end if
 
        if (flowdoms(nn, levm1, 1)%dknBeg(mm) < &
            flowdoms(nn, levm1, 1)%dknEnd(mm)) then
            flowdoms(nn, level, 1)%dknBeg(mm) = subface%kBeg
            flowdoms(nn, level, 1)%dknEnd(mm) = subface%kEnd
        else
            flowdoms(nn, level, 1)%dknBeg(mm) = subface%kEnd
            flowdoms(nn, level, 1)%dknEnd(mm) = subface%kBeg
        end if
 
    end subroutine update1to1coarse
    subroutine coarsedonorinfo(level)
        !
        !       coarseDonorInfo creates the donor info for the internal
        !       block boundaries on the given coarse grid level.
        !
        use communication
        use coarse1to1subface
        use utils, only: terminate
        implicit none
        !
        !      Subroutine arguments.
        !
        integer(kind=intType), intent(in) :: level
        !
        !      Local variables.
        !
        integer :: proc, size, ierr
 
        integer, dimension(mpi_status_size) :: mpiStatus
        integer, dimension(nProc) :: sizeMessage
 
        integer(kind=intType) :: nn, mm, ii, i
        integer(kind=intType) :: nMessageReceive, nMessageSend
 
        integer(kind=intType), dimension(0:nProc) :: size2proc
        integer(kind=intType), dimension(nProc) :: tmp
 
        integer(kind=intType), dimension(:), allocatable :: sendBuf
        integer(kind=intType), dimension(:), allocatable, target :: recvBuf
 
        type(coarse1to1subfacetype) :: tmpSubface
 
        ! Determine the number of integers sent to every processor.
 
        size2proc = 0
        do nn = 1, nsubface1to1
            mm = subface1to1(nn)%neighProc + 1    ! Proc ID's start at 0.
 
            size2proc(mm) = size2proc(mm) + 13 &
                            + subface1to1(nn)%iEnd - subface1to1(nn)%iBeg &
                            + subface1to1(nn)%jEnd - subface1to1(nn)%jBeg &
                            + subface1to1(nn)%kEnd - subface1to1(nn)%kBeg
        end do
 
        ! No message is sent to myself, so set the corresponding entry in
        ! size2proc to 0. The processor id's start at 0, which explains
        ! the +1.
 
        size2proc(myid + 1) = 0
 
        ! Determine the number of messages i have to sent. Store in tmp
        ! a 0 or a 1, depending whether or not a message must be sent
        ! to the corresponding processor. This info is needed to determine
        ! the number of messages i will receive.
 
        nmessagesend = 0
        do nn = 1, nproc
            if (size2proc(nn) > 0) then
                nmessagesend = nmessagesend + 1
                tmp(nn) = 1
            else
                tmp(nn) = 0
            end if
        end do
 
        ! Determine the number of messages i will receive.
 
        sizemessage = 1
        call mpi_reduce_scatter(tmp, nmessagereceive, sizemessage, &
                                adflow_integer, mpi_sum, adflow_comm_world, &
                                ierr)
 
        ! Put size2proc in cumulative storage format and store the
        ! starting entry in tmp, which is used as a counter.
 
        do nn = 1, nproc
            size2proc(nn) = size2proc(nn) + size2proc(nn - 1)
            tmp(nn) = size2proc(nn - 1)
        end do
 
        ! Allocate the memory for the send buffer.
 
        allocate (sendbuf(size2proc(nproc)), stat=ierr)
        if (ierr /= 0) &
            call terminate("coarseDonorInfo", &
                           "Memory allocation failure for sendBuf")
 
        ! Loop over the number of 1 to 1 subfaces to fill the send buffer.
 
        unownedsubfaces: do nn = 1, nsubface1to1
 
            ! Only info that must be sent to other processors must be stored.
 
            if (subface1to1(nn)%neighProc /= myid) then
 
                ! Store the entry in tmp in mm.
                ! Note that the proc id's start at 0.
 
                mm = subface1to1(nn)%neighProc + 1
 
                ! Store the block id of the donor and the coarse grid range of
                ! the current subface in the send buffer. Update the counter
                ! tmp(mm) accordingly.
 
                tmp(mm) = tmp(mm) + 1
                sendbuf(tmp(mm)) = subface1to1(nn)%neighBlock
 
                tmp(mm) = tmp(mm) + 1
                sendbuf(tmp(mm)) = subface1to1(nn)%iBeg
 
                tmp(mm) = tmp(mm) + 1
                sendbuf(tmp(mm)) = subface1to1(nn)%jBeg
 
                tmp(mm) = tmp(mm) + 1
                sendbuf(tmp(mm)) = subface1to1(nn)%kBeg
 
                tmp(mm) = tmp(mm) + 1
                sendbuf(tmp(mm)) = subface1to1(nn)%iEnd
 
                tmp(mm) = tmp(mm) + 1
                sendbuf(tmp(mm)) = subface1to1(nn)%jEnd
 
                tmp(mm) = tmp(mm) + 1
                sendbuf(tmp(mm)) = subface1to1(nn)%kEnd
 
                ! Store the number of points in the three coordinate
                ! directions of the coarse grid donor face.
 
                tmp(mm) = tmp(mm) + 1
                sendbuf(tmp(mm)) = subface1to1(nn)%ndi
 
                tmp(mm) = tmp(mm) + 1
                sendbuf(tmp(mm)) = subface1to1(nn)%ndj
 
                tmp(mm) = tmp(mm) + 1
                sendbuf(tmp(mm)) = subface1to1(nn)%ndk
 
                ! Store the i-donor indices of the fine grid in sendBuf.
 
                do i = 1, subface1to1(nn)%ndi
                    tmp(mm) = tmp(mm) + 1
                    sendbuf(tmp(mm)) = subface1to1(nn)%idfine(i)
                end do
 
                ! Store the j-donor indices of the fine grid in sendBuf.
 
                do i = 1, subface1to1(nn)%ndj
                    tmp(mm) = tmp(mm) + 1
                    sendbuf(tmp(mm)) = subface1to1(nn)%jdfine(i)
                end do
 
                ! Store the k-donor indices of the fine grid in sendBuf.
 
                do i = 1, subface1to1(nn)%ndk
                    tmp(mm) = tmp(mm) + 1
                    sendbuf(tmp(mm)) = subface1to1(nn)%kdfine(i)
                end do
 
            end if
 
        end do unownedsubfaces
 
        ! Send the data i have to send.
 
        mm = 0
        sends: do nn = 1, nproc
 
            if (size2proc(nn) > size2proc(nn - 1)) then
 
                ! Update mm and store the processor id, the size of the
                ! message and the starting index in sendbuf.
 
                mm = mm + 1
                proc = nn - 1
                size = size2proc(nn) - size2proc(nn - 1)
                ii = size2proc(nn - 1) + 1
 
                ! Send the message.
 
                call mpi_isend(sendbuf(ii), size, adflow_integer, proc, proc, &
                               adflow_comm_world, sendrequests(mm), ierr)
 
            end if
 
        end do sends
 
        ! Loop over the number of 1 to 1 subfaces stored on this processor
        ! and update the locally stored info.
 
        do nn = 1, nsubface1to1
            if (subface1to1(nn)%neighProc == myid) &
                call update1to1coarse(level, subface1to1(nn))
        end do
 
        ! Release the memory of subface1to1.
 
        do nn = 1, nsubface1to1
            deallocate (subface1to1(nn)%idfine, subface1to1(nn)%jdfine, &
                        subface1to1(nn)%kdfine, stat=ierr)
            if (ierr /= 0) &
                call terminate("coarseDonorInfo", &
                               "Deallocation error for idfine, etc")
        end do
 
        deallocate (subface1to1, stat=ierr)
        if (ierr /= 0) &
            call terminate("coarseDonorInfo", &
                           "Deallocation error for subface1to1")
 
        ! Loop over the number of messages i must receive to determine
        ! info from externally stored neighboring subfaces.
 
        receives: do nn = 1, nmessagereceive
 
            ! Block until a message arrives.
 
            call mpi_probe(mpi_any_source, myid, adflow_comm_world, &
                           mpistatus, ierr)
 
            ! Find the source and size of the message.
 
            proc = mpistatus(mpi_source)
            call mpi_get_count(mpistatus, adflow_integer, size, ierr)
 
            ! Check in debug mode that the incoming message is of
            ! correct size.
 
            if (debug) then
                if (size == mpi_undefined) &
                    call terminate("coarseDonorInfo", &
                                   "Unexpected size of message")
            end if
 
            ! Allocate the memory for the receive buffer.
 
            allocate (recvbuf(size), stat=ierr)
            if (ierr /= 0) &
                call terminate("coarseDonorInfo", &
                               "Memory allocation failure for recvBuf")
 
            ! Receive the messsage. As it has already arrived a blocking
            ! receive can be used.
 
            call mpi_recv(recvbuf, size, adflow_integer, proc, myid, &
                          adflow_comm_world, mpistatus, ierr)
 
            ! Loop to extract the 1 to 1 subface info from the buffer.
 
            ii = 1
            extractsubface: do
                ! Exit the loop if no more info is present.
 
                if (ii > size) exit
 
                ! Store the info of this subface in tmpSubface.
 
                tmpsubface%neighProc = proc
                tmpsubface%neighBlock = recvbuf(ii); ii = ii + 1
 
                tmpsubface%iBeg = recvbuf(ii); ii = ii + 1
                tmpsubface%jBeg = recvbuf(ii); ii = ii + 1
                tmpsubface%kBeg = recvbuf(ii); ii = ii + 1
 
                tmpsubface%iEnd = recvbuf(ii); ii = ii + 1
                tmpsubface%jEnd = recvbuf(ii); ii = ii + 1
                tmpsubface%kEnd = recvbuf(ii); ii = ii + 1
 
                tmpsubface%ndi = recvbuf(ii); ii = ii + 1
                tmpsubface%ndj = recvbuf(ii); ii = ii + 1
                tmpsubface%ndk = recvbuf(ii); ii = ii + 1
 
                mm = ii + tmpsubface%ndi
                tmpsubface%idfine => recvbuf(ii:(mm - 1))
                ii = mm
 
                mm = ii + tmpsubface%ndj
                tmpsubface%jdfine => recvbuf(ii:(mm - 1))
                ii = mm
 
                mm = ii + tmpsubface%ndk
                tmpsubface%kdfine => recvbuf(ii:(mm - 1))
                ii = mm
 
                ! Update the 1 to 1 subface info.
 
                call update1to1coarse(level, tmpsubface)
 
            end do extractsubface
 
            ! Release the memory of the receive buffer.
 
            deallocate (recvbuf, stat=ierr)
            if (ierr /= 0) &
                call terminate("coarseDonorInfo", &
                               "Deallocation failure for recvBuf")
 
        end do receives
 
        ! Complete the nonblocking sends.
 
        size = nmessagesend
        do nn = 1, nmessagesend
            call mpi_waitany(size, sendrequests, proc, mpistatus, ierr)
        end do
 
        ! Release the memory of the send buffer.
 
        deallocate (sendbuf, stat=ierr)
        if (ierr /= 0) &
            call terminate("coarseDonorInfo", &
                           "Deallocation failure for sendBuf")
 
        ! Synchronize the processors, because wild cards have been used.
 
        call mpi_barrier(adflow_comm_world, ierr)
 
    end subroutine coarsedonorinfo
 
    subroutine checkcoarse1to1(level)
        !
        !       checkCoarse1to1 removes the nonmatching block boundaries
        !       from the list of 1 to 1 matching ones. They are in there,
        !       because they are 1 to 1 matching on the finer grids.
        !
        use constants
        use cgnsgrid
        use block
        use inputtimespectral
        use coarseninginfo
        use utils, only: terminate
        use commonformats, only: strings
        implicit none
        !
        !      Subroutine arguments.
        !
        integer(kind=intType), intent(in) :: level
        !
        !      Local variables.
        !
        character(len=maxStringLen) :: errorMessage
 
        integer(kind=intType) :: i, nn, mm, kk, ll
 
        ! Loop over the number of domains.
 
        domains: do nn = 1, ndom
 
            ! Loop over the number of 1 to 1 subfaces. As this number can
            ! change during the loop, the control statement is done via
            ! an exit.
 
            i = 1
            n1to1: do
 
                ! Exit the loop if the counter is larger than the number
                ! of 1 to 1 subfaces.
 
                if (i > flowdoms(nn, level, 1)%n1to1) exit
 
                ! Add the offset to i to store the correct place in the
                ! subface info.
 
                mm = i + flowdoms(nn, level, 1)%nBocos
 
                ! Test if this is still a 1 to 1 subface on the coarse grid.
 
                is1to1: if (coarseinfo(nn)%coarseIs1to1(i)) then
 
                    ! Subface is still a 1 to 1 subface on the coarse grid.
                    ! Only the counter i must be updated.
 
                    i = i + 1
 
                    else is1to1
 
                    ! Due to the coarsening the subface is not a 1 to 1 block
                    ! boundary anymore. Swap the current entry with the entry
                    ! kk.
 
                    kk = flowdoms(nn, level, 1)%nBocos + flowdoms(nn, level, 1)%n1to1
 
                    ! The range info.
 
                    ll = flowdoms(nn, level, 1)%inBeg(mm)
                    flowdoms(nn, level, 1)%inBeg(mm) = flowdoms(nn, level, 1)%inBeg(kk)
                    flowdoms(nn, level, 1)%inBeg(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%jnBeg(mm)
                    flowdoms(nn, level, 1)%jnBeg(mm) = flowdoms(nn, level, 1)%jnBeg(kk)
                    flowdoms(nn, level, 1)%jnBeg(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%knBeg(mm)
                    flowdoms(nn, level, 1)%knBeg(mm) = flowdoms(nn, level, 1)%knBeg(kk)
                    flowdoms(nn, level, 1)%knBeg(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%inEnd(mm)
                    flowdoms(nn, level, 1)%inEnd(mm) = flowdoms(nn, level, 1)%inEnd(kk)
                    flowdoms(nn, level, 1)%inEnd(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%jnEnd(mm)
                    flowdoms(nn, level, 1)%jnEnd(mm) = flowdoms(nn, level, 1)%jnEnd(kk)
                    flowdoms(nn, level, 1)%jnEnd(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%knEnd(mm)
                    flowdoms(nn, level, 1)%knEnd(mm) = flowdoms(nn, level, 1)%knEnd(kk)
                    flowdoms(nn, level, 1)%knEnd(kk) = ll
 
                    ! The donor info.
 
                    ll = flowdoms(nn, level, 1)%dinBeg(mm)
                    flowdoms(nn, level, 1)%dinBeg(mm) = flowdoms(nn, level, 1)%dinBeg(kk)
                    flowdoms(nn, level, 1)%dinBeg(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%djnBeg(mm)
                    flowdoms(nn, level, 1)%djnBeg(mm) = flowdoms(nn, level, 1)%djnBeg(kk)
                    flowdoms(nn, level, 1)%djnBeg(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%dknBeg(mm)
                    flowdoms(nn, level, 1)%dknBeg(mm) = flowdoms(nn, level, 1)%dknBeg(kk)
                    flowdoms(nn, level, 1)%dknBeg(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%dinEnd(mm)
                    flowdoms(nn, level, 1)%dinEnd(mm) = flowdoms(nn, level, 1)%dinEnd(kk)
                    flowdoms(nn, level, 1)%dinEnd(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%djnEnd(mm)
                    flowdoms(nn, level, 1)%djnEnd(mm) = flowdoms(nn, level, 1)%djnEnd(kk)
                    flowdoms(nn, level, 1)%djnEnd(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%dknEnd(mm)
                    flowdoms(nn, level, 1)%dknEnd(mm) = flowdoms(nn, level, 1)%dknEnd(kk)
                    flowdoms(nn, level, 1)%dknEnd(kk) = ll
 
                    ! The transformation matrix.
 
                    ll = flowdoms(nn, level, 1)%l1(mm)
                    flowdoms(nn, level, 1)%l1(mm) = flowdoms(nn, level, 1)%l1(kk)
                    flowdoms(nn, level, 1)%l1(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%l2(mm)
                    flowdoms(nn, level, 1)%l2(mm) = flowdoms(nn, level, 1)%l2(kk)
                    flowdoms(nn, level, 1)%l2(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%l3(mm)
                    flowdoms(nn, level, 1)%l3(mm) = flowdoms(nn, level, 1)%l3(kk)
                    flowdoms(nn, level, 1)%l3(kk) = ll
 
                    ! The rest of the subface info.
 
                    ll = flowdoms(nn, level, 1)%BCType(mm)
                    flowdoms(nn, level, 1)%BCType(mm) = &
                        flowdoms(nn, level, 1)%BCType(kk)
                    flowdoms(nn, level, 1)%BCType(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%BCFaceID(mm)
                    flowdoms(nn, level, 1)%BCFaceID(mm) = &
                        flowdoms(nn, level, 1)%BCFaceID(kk)
                    flowdoms(nn, level, 1)%BCFaceID(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%neighBlock(mm)
                    flowdoms(nn, level, 1)%neighBlock(mm) = &
                        flowdoms(nn, level, 1)%neighBlock(kk)
                    flowdoms(nn, level, 1)%neighBlock(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%neighProc(mm)
                    flowdoms(nn, level, 1)%neighProc(mm) = &
                        flowdoms(nn, level, 1)%neighProc(kk)
                    flowdoms(nn, level, 1)%neighProc(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%groupNum(mm)
                    flowdoms(nn, level, 1)%groupNum(mm) = &
                        flowdoms(nn, level, 1)%groupNum(kk)
                    flowdoms(nn, level, 1)%groupNum(kk) = ll
 
                    ll = flowdoms(nn, level, 1)%cgnsSubface(mm)
                    flowdoms(nn, level, 1)%cgnsSubface(mm) = &
                        flowdoms(nn, level, 1)%cgnsSubface(kk)
                    flowdoms(nn, level, 1)%cgnsSubface(kk) = ll
 
                    ! Decrease the number of 1 to 1 block boundaries. Note the
                    ! counter i should not be updated.
 
                    flowdoms(nn, level, 1)%n1to1 = flowdoms(nn, level, 1)%n1to1 - 1
 
                    ll = flowdoms(nn, 1, 1)%cgnsBlockID
                    write (errormessage, strings) "Non-matching block-to-block face on zone ", cgnsdoms(ll)%zoneName, &
                        "...Support not implemented yet."
                    call terminate("checkCoarse1to1", errormessage)
 
                end if is1to1
 
            end do n1to1
 
            ! Copy the number of internal subfaces for the rest of
            ! the spectral solutions.
 
            do i = 2, ntimeintervalsspectral
                flowdoms(nn, level, i)%n1to1 = flowdoms(nn, level, 1)%n1to1
            end do
 
        end do domains
 
    end subroutine checkcoarse1to1
 
end module coarseutils