MPI_vars.f90

Go to the documentation of this file.

!------------------------------------------------------------------------------!
!------------------------------------------------------------------------------!
module mpi_vars
#include <PB3D_macros.h>
    use num_vars, only: max_str_ln, dp, plot_dir, data_dir, script_dir
    use str_utilities, only: i2str, r2str, r2strt
    use mpi
    
    implicit none
    private
    public init_lock, dealloc_lock, &
        &hdf5_lock
 
    type, public :: lock_type
        integer, allocatable :: wl(:)
        integer :: wl_win
        integer :: wu_tag
        logical :: blocking
    contains
        procedure :: init => init_lock                                          
        procedure :: dealloc => dealloc_lock                                    
    end type lock_type
    
    ! global variables
    type(lock_type) :: hdf5_lock
    
contains
    integer function init_lock(lock_loc,wu_tag) result(ierr)
        use num_vars, only: n_procs, rank
        
        character(*), parameter :: rout_name = 'init_lock'
        
        ! input / output
        class(lock_type), intent(inout) :: lock_loc
        integer, intent(in) :: wu_tag
        
        ! local variables
        integer(kind=MPI_ADDRESS_KIND) :: intlb                                 ! lower bound of int type
        integer(kind=MPI_ADDRESS_KIND) :: intex                                 ! extent of int type
        
        ! initialize ierr
        ierr = 0
        
        call mpi_type_get_extent(mpi_integer,intlb,intex,ierr)
        chckerr('Failed to get extent of int')
        
        if (rank.eq.0) then                                                     ! master
            allocate(lock_loc%wl(n_procs))
            
            lock_loc%wl = 0
            call mpi_win_create(lock_loc%wl,n_procs*intex,int(intex),&
                &mpi_info_null,mpi_comm_world,lock_loc%wl_win,ierr)
            chckerr('Failed to create window to lock_loc')
        else
            allocate(lock_loc%wl(0))
            
            call mpi_win_create(lock_loc%wl,0*intex,int(intex),mpi_info_null,&
                &mpi_comm_world,lock_loc%wl_win,ierr)
            chckerr('Failed to create window to lock_loc')
        end if
        
        lock_loc%wu_tag = wu_tag
        
        ! set fences
        call mpi_win_fence(0,lock_loc%wl_win,ierr) 
        chckerr('Couldn''t set fence') 
    end function init_lock
    
    integer function dealloc_lock(lock_loc) result(ierr)
        character(*), parameter :: rout_name = 'dealloc_lock'
        
        ! input / output
        class(lock_type), intent(inout) :: lock_loc
        
        ! initialize ierr
        ierr = 0
        
        ! free lock window
        call mpi_win_free(lock_loc%wl_win,ierr)
        chckerr('Failed to free window to HDF5_lock')
        
        ! deallocate lock
        deallocate(lock_loc%wl)
    end function dealloc_lock
end module mpi_vars