PB3D_utilities.f90

Go to the documentation of this file.

!------------------------------------------------------------------------------!
!------------------------------------------------------------------------------!
module pb3d_utilities
#include <PB3D_macros.h>
    use str_utilities
    use messages
    use num_vars, only: dp, pi, max_str_ln, max_name_ln
    use hdf5_vars, only: var_1d_type
 
    implicit none
    private
    public conv_1d2nd, setup_rich_id, setup_par_id
    
    ! interfaces
    
    interface conv_1d2nd
        module procedure conv_1d2nd_1d
        module procedure conv_1d2nd_2d
        module procedure conv_1d2nd_3d
        module procedure conv_1d2nd_4d
        module procedure conv_1d2nd_6d
        module procedure conv_1d2nd_7d
    end interface
    
contains
    subroutine conv_1d2nd_1d(var_in,var_out)
        ! input / output
        type(var_1d_type), intent(in) :: var_in
        real(dp), intent(inout), allocatable :: var_out(:)
        
        ! allocate and copy variable
        if (allocated(var_out)) deallocate(var_out)
        allocate(var_out(var_in%tot_i_min(1):var_in%tot_i_max(1)))
        var_out = reshape(var_in%p,shape(var_out))
    end subroutine conv_1d2nd_1d
    subroutine conv_1d2nd_2d(var_in,var_out)
        ! input / output
        type(var_1d_type), intent(in) :: var_in
        real(dp), intent(inout), allocatable :: var_out(:,:)
        
        ! allocate and copy variable
        if (allocated(var_out)) deallocate(var_out)
        allocate(var_out(&
            &var_in%tot_i_min(1):var_in%tot_i_max(1),&
            &var_in%tot_i_min(2):var_in%tot_i_max(2)))
        var_out = reshape(var_in%p,[&
            &var_in%tot_i_max(1)-var_in%tot_i_min(1)+1,&
            &var_in%tot_i_max(2)-var_in%tot_i_min(2)+1])
    end subroutine conv_1d2nd_2d
    subroutine conv_1d2nd_3d(var_in,var_out)
        ! input / output
        type(var_1d_type), intent(in) :: var_in
        real(dp), intent(inout), allocatable :: var_out(:,:,:)
        
        ! allocate and copy variable
        if (allocated(var_out)) deallocate(var_out)
        allocate(var_out(&
            &var_in%tot_i_min(1):var_in%tot_i_max(1),&
            &var_in%tot_i_min(2):var_in%tot_i_max(2),&
            &var_in%tot_i_min(3):var_in%tot_i_max(3)))
        var_out = reshape(var_in%p,shape(var_out))
    end subroutine conv_1d2nd_3d
    subroutine conv_1d2nd_4d(var_in,var_out)
        ! input / output
        type(var_1d_type), intent(in) :: var_in
        real(dp), intent(inout), allocatable :: var_out(:,:,:,:)
        
        ! allocate and copy variable
        if (allocated(var_out)) deallocate(var_out)
        allocate(var_out(&
            &var_in%tot_i_min(1):var_in%tot_i_max(1),&
            &var_in%tot_i_min(2):var_in%tot_i_max(2),&
            &var_in%tot_i_min(3):var_in%tot_i_max(3),&
            &var_in%tot_i_min(4):var_in%tot_i_max(4)))
        var_out = reshape(var_in%p,shape(var_out))
    end subroutine conv_1d2nd_4d
    subroutine conv_1d2nd_6d(var_in,var_out)
        ! input / output
        type(var_1d_type), intent(in) :: var_in
        real(dp), intent(inout), allocatable :: var_out(:,:,:,:,:,:)
        
        ! allocate and copy variable
        if (allocated(var_out)) deallocate(var_out)
        allocate(var_out(&
            &var_in%tot_i_min(1):var_in%tot_i_max(1),&
            &var_in%tot_i_min(2):var_in%tot_i_max(2),&
            &var_in%tot_i_min(3):var_in%tot_i_max(3),&
            &var_in%tot_i_min(4):var_in%tot_i_max(4),&
            &var_in%tot_i_min(5):var_in%tot_i_max(5),&
            &var_in%tot_i_min(6):var_in%tot_i_max(6)))
        var_out = reshape(var_in%p,shape(var_out))
    end subroutine conv_1d2nd_6d
    subroutine conv_1d2nd_7d(var_in,var_out)
        ! input / output
        type(var_1d_type), intent(in) :: var_in
        real(dp), intent(inout), allocatable :: var_out(:,:,:,:,:,:,:)
        
        ! allocate and copy variable
        if (allocated(var_out)) deallocate(var_out)
        allocate(var_out(&
            &var_in%tot_i_min(1):var_in%tot_i_max(1),&
            &var_in%tot_i_min(2):var_in%tot_i_max(2),&
            &var_in%tot_i_min(3):var_in%tot_i_max(3),&
            &var_in%tot_i_min(4):var_in%tot_i_max(4),&
            &var_in%tot_i_min(5):var_in%tot_i_max(5),&
            &var_in%tot_i_min(6):var_in%tot_i_max(6),&
            &var_in%tot_i_min(7):var_in%tot_i_max(7)))
        var_out = reshape(var_in%p,shape(var_out))
    end subroutine conv_1d2nd_7d
    
    function setup_par_id(grid,rich_lvl_max,rich_lvl_loc,tot_rich,par_lim,&
        &par_id_mem) result(par_id)
        use grid_vars, only: grid_type
        
        ! input / output
        type(grid_type), intent(in) :: grid
        integer, intent(in) :: rich_lvl_max
        integer, intent(in) :: rich_lvl_loc
        logical, intent(in), optional :: tot_rich
        integer, intent(in), optional :: par_lim(2)
        integer, intent(inout), optional :: par_id_mem(2)
        integer :: par_id(3)
        
        ! local variables
        integer :: s                                                            ! stride
        integer :: p                                                            ! lower limit in memory
        integer :: n                                                            ! b-a+1
        logical :: tot_rich_loc                                                 ! local tot_rich
        integer :: par_lim_loc(2)                                               ! local par_lim
        
        ! set up local tot_rich and par_lim
        tot_rich_loc = .false.
        if (present(tot_rich) .and. rich_lvl_max.gt.1) tot_rich_loc = tot_rich  ! only for higher Richardson levels
        par_lim_loc = [1,grid%n(1)]
        if (present(par_lim)) par_lim_loc = par_lim
        
        ! set up parallel indices
        n = par_lim_loc(2)-par_lim_loc(1)+1
        if (tot_rich_loc) then
            if (rich_lvl_loc.eq.1) then
                s = 2**(rich_lvl_max-1)
                p = 1
            else
                s = 2**(rich_lvl_max+1-rich_lvl_loc)
                p = 1 + s/2
            end if
        else
            s = 1
            p = 1
        end if
        par_id(1) = 1 + modulo(p-par_lim_loc(1),s)
        par_id(2) = n - s + 1 + modulo(p-par_lim_loc(2)-1,s)
        par_id(3) = s
        
        ! set par_id in memory if requested
        if (present(par_id_mem)) par_id_mem = &
            &1 + (par_lim_loc(1)-1-p+par_id(1:2))/s
    end function setup_par_id
    
    function setup_rich_id(rich_lvl_max,tot_rich) result(rich_id)
        ! input / output
        integer, intent(in) :: rich_lvl_max
        logical, intent(in), optional :: tot_rich
        integer :: rich_id(2)
        
        ! set up rich_id
        rich_id = [rich_lvl_max,rich_lvl_max]
        if (present(tot_rich) .and. rich_lvl_max.gt.1) then                     ! only for higher Richardson levels
            if (tot_rich) rich_id = [1,rich_lvl_max]
        end if
    end function setup_rich_id
end module pb3d_utilities