level1_Morton_order Subroutine

public subroutine level1_Morton_order()

Uses

  • proc~~level1_morton_order~~UsesGraph proc~level1_morton_order level1_Morton_order module~mod_forest mod_forest proc~level1_morton_order->module~mod_forest module~mod_global_parameters mod_global_parameters proc~level1_morton_order->module~mod_global_parameters module~mod_basic_types mod_basic_types module~mod_global_parameters->module~mod_basic_types module~mod_connectivity mod_connectivity module~mod_global_parameters->module~mod_connectivity module~mod_constants mod_constants module~mod_global_parameters->module~mod_constants module~mod_physicaldata mod_physicaldata module~mod_global_parameters->module~mod_physicaldata module~mod_variables mod_variables module~mod_global_parameters->module~mod_variables mpi mpi module~mod_global_parameters->mpi module~mod_variables->module~mod_basic_types

build Morton space filling curve for level 1 grid

Arguments

None

Calls

proc~~level1_morton_order~~CallsGraph proc~level1_morton_order level1_Morton_order proc~mortonencode mortonEncode proc~level1_morton_order->proc~mortonencode

Called by

proc~~level1_morton_order~~CalledByGraph proc~level1_morton_order level1_Morton_order proc~init_forest_root init_forest_root proc~init_forest_root->proc~level1_morton_order proc~read_forest read_forest proc~read_forest->proc~level1_morton_order proc~initlevelone initlevelone proc~initlevelone->proc~init_forest_root proc~read_snapshot read_snapshot proc~read_snapshot->proc~read_forest proc~read_snapshot_old read_snapshot_old proc~read_snapshot->proc~read_snapshot_old proc~read_snapshot_old->proc~read_forest proc~main main proc~main->proc~initlevelone proc~main->proc~read_snapshot program~agile agile program~agile->proc~main

Source Code

  subroutine level1_Morton_order
    ! use Morton curve to connect level 1 grid blocks
    use mod_forest
    use mod_global_parameters

    integer, allocatable :: gsq_sfc(:,:,:),seq_sfc(:),seq_ig1(:),seq_ig2(:),&
       seq_ig3(:)
    integer :: ig1,ig2,ig3, ngsq1,ngsq2,ngsq3, isq, total_number
    !integer(kind=8), external :: mortonEncode
    logical, allocatable :: in_domain(:)

    ! use the smallest square/cube to cover the full domain 
    ngsq1=2**ceiling(log(real(ng1(1)))/log(2.0))
    ngsq2=2**ceiling(log(real(ng2(1)))/log(2.0))
    ngsq3=2**ceiling(log(real(ng3(1)))/log(2.0));
    
    ngsq1=max(ngsq1,ngsq2,ngsq3) 
    ngsq2=max(ngsq1,ngsq2,ngsq3) 
    ngsq3=max(ngsq1,ngsq2,ngsq3) 
   
    total_number=ngsq1*ngsq2*ngsq3
    ! Morton number acquired by block numbers
    allocate(gsq_sfc(ngsq1,ngsq2,ngsq3))
    ! Morton number in sequence
    allocate(seq_sfc(total_number))
    ! block numbers in sequence
    allocate(seq_ig1(total_number))
    allocate(seq_ig2(total_number))
    allocate(seq_ig3(total_number))
    allocate(in_domain(total_number))
    in_domain=.true.
    ! get Morton-order numbers in the square/cube
    do ig3=1,ngsq3
    do ig2=1,ngsq2
    do ig1=1,ngsq1
       gsq_sfc(ig1,ig2,ig3)=int(mortonEncode(ig1-1,ig2-1,ig3-1,ndim))+1
       seq_sfc(gsq_sfc(ig1,ig2,ig3))=gsq_sfc(ig1,ig2,ig3)
       seq_ig1(gsq_sfc(ig1,ig2,ig3))=ig1 
       seq_ig2(gsq_sfc(ig1,ig2,ig3))=ig2 
       seq_ig3(gsq_sfc(ig1,ig2,ig3))=ig3 
    end do
    end do
    end do
    ! mark blocks that are out of the domain and change Morton number
    do isq=1,total_number
       if (seq_ig1(isq)>ng1(1).or.seq_ig2(isq)>ng2(1).or.seq_ig3(isq)>ng3(1)) &
          then
         seq_sfc(isq:total_number)=seq_sfc(isq:total_number)-1
         in_domain(isq)=.false.
       end if
    end do
    ! copy the modified Morton numbers to the blocks in the domain
    if(.not. allocated(iglevel1_sfc)) allocate(iglevel1_sfc(ng1(1),ng2(1),&
       ng3(1)))
    if(.not. allocated(sfc_iglevel1)) allocate(sfc_iglevel1(ndim,nglev1))
    do isq=1,total_number
      if(in_domain(isq)) then
        iglevel1_sfc(seq_ig1(isq),seq_ig2(isq),seq_ig3(isq))=seq_sfc(isq)
        sfc_iglevel1(1,seq_sfc(isq))=seq_ig1(isq) 
        sfc_iglevel1(2,seq_sfc(isq))=seq_ig2(isq) 
        sfc_iglevel1(3,seq_sfc(isq))=seq_ig3(isq) 
      end if
    end do

    deallocate(gsq_sfc,seq_sfc,seq_ig1,seq_ig2,seq_ig3,in_domain)

  end subroutine level1_Morton_order