Skip to content

Commit

Permalink
cleanup done in branch add_mpi
Browse files Browse the repository at this point in the history
  • Loading branch information
@Simkern
Simkern committed Jul 18, 2024
2 parents 5c79b08 + 1dfb25f commit aba85ed
Show file tree
Hide file tree
Showing 4 changed files with 158 additions and 101 deletions.
129 changes: 39 additions & 90 deletions src/Constants.f90
View file
Original file line number Diff line number Diff line change
@@ -1,101 +1,50 @@
module LightKrylov_Constants
use stdlib_logger, only: logger => global_logger
use LightKrylov_Logger
#ifdef MPI
use mpi_f08
#endif
implicit none
private

integer, private :: nid = 0
integer, private :: comm_size = 1
integer, private :: nio = 0

integer , parameter, public :: sp = selected_real_kind(6, 37)
!! Definition of the single precision data type.
real(sp), parameter, public :: atol_sp = 10.0_sp ** -precision(1.0_sp)
!! Definition of the absolute tolerance for single precision computations.
real(sp), parameter, public :: rtol_sp = sqrt(atol_sp)
!! Definition of the relative tolerance for single precision computations.

integer , parameter, public :: dp = selected_real_kind(15, 307)
!! Definition of the double precision data type.
real(dp), parameter, public :: atol_dp = 10.0_dp ** -precision(1.0_dp)
!! Definition of the absolute tolerance for double precision computations.
real(dp), parameter, public :: rtol_dp = sqrt(atol_dp)
!! Definition of the relative tolerance for double precision computations.

real(sp), parameter, public :: one_rsp = 1.0_sp
real(sp), parameter, public :: zero_rsp = 0.0_sp
real(dp), parameter, public :: one_rdp = 1.0_dp
real(dp), parameter, public :: zero_rdp = 0.0_dp
complex(sp), parameter, public :: one_csp = cmplx(1.0_sp, 0.0_sp, kind=sp)
complex(sp), parameter, public :: one_im_csp = cmplx(0.0_sp, 1.0_sp, kind=sp)
complex(sp), parameter, public :: zero_csp = cmplx(0.0_sp, 0.0_sp, kind=sp)
complex(dp), parameter, public :: one_cdp = cmplx(1.0_dp, 0.0_dp, kind=dp)
complex(sp), parameter, public :: one_im_cdp = cmplx(0.0_dp, 1.0_dp, kind=dp)
complex(dp), parameter, public :: zero_cdp = cmplx(0.0_dp, 0.0_dp, kind=dp)

! MPI subroutines
public :: comm_setup, comm_close

! Getter/setter
public :: set_io_rank
public :: io_rank
public :: get_rank
implicit none
private

integer, private :: nid = 0
integer, private :: comm_size = 1
integer, private :: nio = 0

integer , parameter, public :: sp = selected_real_kind(6, 37)
!! Definition of the single precision data type.
real(sp), parameter, public :: atol_sp = 10.0_sp ** -precision(1.0_sp)
!! Definition of the absolute tolerance for single precision computations.
real(sp), parameter, public :: rtol_sp = sqrt(atol_sp)
!! Definition of the relative tolerance for single precision computations.

integer , parameter, public :: dp = selected_real_kind(15, 307)
!! Definition of the double precision data type.
real(dp), parameter, public :: atol_dp = 10.0_dp ** -precision(1.0_dp)
!! Definition of the absolute tolerance for double precision computations.
real(dp), parameter, public :: rtol_dp = sqrt(atol_dp)
!! Definition of the relative tolerance for double precision computations.

real(sp), parameter, public :: one_rsp = 1.0_sp
real(sp), parameter, public :: zero_rsp = 0.0_sp
real(dp), parameter, public :: one_rdp = 1.0_dp
real(dp), parameter, public :: zero_rdp = 0.0_dp
complex(sp), parameter, public :: one_csp = cmplx(1.0_sp, 0.0_sp, kind=sp)
complex(sp), parameter, public :: one_im_csp = cmplx(0.0_sp, 1.0_sp, kind=sp)
complex(sp), parameter, public :: zero_csp = cmplx(0.0_sp, 0.0_sp, kind=sp)
complex(dp), parameter, public :: one_cdp = cmplx(1.0_dp, 0.0_dp, kind=dp)
complex(sp), parameter, public :: one_im_cdp = cmplx(0.0_dp, 1.0_dp, kind=dp)
complex(dp), parameter, public :: zero_cdp = cmplx(0.0_dp, 0.0_dp, kind=dp)

! Getter/setter routines
public :: get_rank
public :: set_io_rank
public :: io_rank

contains

subroutine comm_setup()
! internal
integer :: ierr
logical :: mpi_is_initialized
character(len=128) :: msg
#ifdef MPI
! check if MPI has already been initialized and if not, initialize
call MPI_Initialized(mpi_is_initialized, ierr)
if (.not. mpi_is_initialized) then
call logger%log_debug('Set up parallel run with MPI.', module='LightKrylov', procedure='comm_setup')
call MPI_Init(ierr)
if (ierr /= MPI_SUCCESS) call stop_error("Error initializing MPI", module='LightKrylov',procedure='mpi_init')
else
call logger%log_debug('MPI already initialized.', module='LightKrylov', procedure='comm_setup')
end if
call MPI_Comm_rank(MPI_COMM_WORLD, nid, ierr)
call MPI_Comm_size(MPI_COMM_WORLD, comm_size, ierr)
write(msg, '(A,I4,A,I4)') 'rank', nid, ', comm_size = ', comm_size
call logger%log_debug(trim(msg), module='LightKrylov', procedure='comm_setup')
#else
write(msg, *) 'Setup serial run'
call logger%log_debug(trim(msg), module='LightKrylov', procedure='comm_setup')
#endif
call set_io_rank(0)
return
end subroutine comm_setup

subroutine comm_close()
integer :: ierr
#ifdef MPI
character(len=128) :: msg
! Finalize MPI
call MPI_Finalize(ierr)
if (ierr /= MPI_SUCCESS) call stop_error("Error finalizing MPI", module='LightKrylov',procedure='comm_close')
#else
ierr = 0
#endif
return
end subroutine comm_close

subroutine set_io_rank(rk)
integer, intent(in) :: rk
character(len=128) :: msg
if (rk > comm_size) then
write(msg, *) 'Invalid I/O rank specified!'
if (io_rank()) call logger%log_message(trim(msg), module='LightKrylov', procedure='set_io_rank')
if (rk > comm_size .or. rk < 0) then
if (io_rank()) print *, 'Invalid I/O rank specified!', rk
else
nio = rk
write(msg, '(A,I4)') 'I/O rank --> rank ', nio
if (io_rank()) call logger%log_message(trim(msg), module='LightKrylov', procedure='set_io_rank')
if (io_rank()) print *, 'I/O rank --> rank ', nio
end if
end

Expand Down
8 changes: 4 additions & 4 deletions src/LightKrylov.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -116,10 +116,10 @@ subroutine greetings()
write (*, *) " |___/ |___/ "

write (*, *)
write (*, *) "Developped by: Jean-Christophe Loiseau"
write (*, *) " J. Simon Kern"
write (*, *) " Arts & Métiers Institute of Technology, 2023."
write (*, *) " jean-christophe.loiseau@ensam.eu"
write (*, *) "Developed by: Jean-Christophe Loiseau"
write (*, *) " J. Simon Kern"
write (*, *) " Arts & Métiers Institute of Technology, 2023."
write (*, *) " jean-christophe.loiseau@ensam.eu"
write (*, *)

write (*, *) "Version -- beta 0.1.0"
Expand Down
8 changes: 4 additions & 4 deletions src/LightKrylov.fypp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -103,10 +103,10 @@ contains
write (*, *) " |___/ |___/ "

write (*, *)
write (*, *) "Developped by: Jean-Christophe Loiseau"
write (*, *) " J. Simon Kern"
write (*, *) " Arts & Métiers Institute of Technology, 2023."
write (*, *) " jean-christophe.loiseau@ensam.eu"
write (*, *) "Developed by: Jean-Christophe Loiseau"
write (*, *) " J. Simon Kern"
write (*, *) " Arts & Métiers Institute of Technology, 2023."
write (*, *) " jean-christophe.loiseau@ensam.eu"
write (*, *)

write (*, *) "Version -- beta 0.1.0"
Expand Down
114 changes: 111 additions & 3 deletions src/Logger.f90
View file
Original file line number Diff line number Diff line change
@@ -1,25 +1,133 @@
module LightKrylov_Logger
#ifdef MPI
use mpi_f08
#endif
! Fortran Standard Library
use stdlib_optval, only : optval
use stdlib_logger
use stdlib_logger, only: logger => global_logger
use stdlib_ascii, only : to_lower
use stdlib_strings, only : chomp, replace_all
! Testdrive
use testdrive, only: error_type, test_failed
! LightKrylov
use LightKrylov_Constants

implicit none
private

logical, parameter :: exit_on_error = .true.
logical, parameter :: exit_on_test_error = .true.
character(len=128), parameter, private :: this_module = 'LightKrylov_Logger'

logical, parameter, private :: exit_on_error = .true.
logical, parameter, private :: exit_on_test_error = .true.

public :: stop_error
public :: check_info
public :: check_test
public :: logger

public :: logger_setup

! MPI subroutines
public :: comm_setup
public :: comm_close

contains

subroutine logger_setup(logfile, nio, log_level, log_stdout, log_timestamp)
!! Wrapper to set up MPI if needed and initialize log files
character(len=*), optional, intent(in) :: logfile
!! name of the dedicated LightKrylov logfile
integer, optional, intent(in) :: nio
!! I/O rank for logging
integer, optional, intent(in) :: log_level
!! set logging level
!! 0 : all_level
!! 10 : debug_level
!! 20 : information_level
!! 30 : warning_level
!! 40 : error_level
!! 100 : none_level
logical, optional, intent(in) :: log_stdout
!! duplicate log messages to stdout?
logical, optional, intent(in) :: log_timestamp
!! add timestamp to log messages

! internals
character(len=:), allocatable :: logfile_
integer :: nio_
integer :: log_level_
logical :: log_stdout_
logical :: log_timestamp_
! misc
integer :: stat, iunit

logfile_ = optval(logfile, 'lightkrylov.log')
nio_ = optval(nio, 0)
log_level_ = optval(log_level, 20)
log_level_ = max(0, min(log_level_, 100))
log_stdout_ = optval(log_stdout, .true.)
log_timestamp_ = optval(log_timestamp, .true.)

! set log level
call logger%configure(level=log_level_, time_stamp=log_timestamp_)

! set up LightKrylov log file
call logger%add_log_file(logfile_, unit=iunit, stat=stat)
if (stat /= 0) call stop_error('Unable to open logfile '//trim(logfile_)//'.', module=this_module, procedure='logger_setup')

! Set up comms
call comm_setup()

! Set I/O rank
if (nio_/=0) call set_io_rank(nio_)

! log to stdout
if (log_stdout_) then
call logger%add_log_unit(6, stat=stat)
if (stat /= 0) call stop_error('Unable to add stdout to logger.', module=this_module, procedure='logger_setup')
end if
return
end subroutine logger_setup

subroutine comm_setup()
! internal
integer :: ierr
logical :: mpi_is_initialized
character(len=128) :: msg
#ifdef MPI
! check if MPI has already been initialized and if not, initialize
call MPI_Initialized(mpi_is_initialized, ierr)
if (.not. mpi_is_initialized) then
call logger%log_debug('Set up parallel run with MPI.', module='LightKrylov', procedure='comm_setup')
call MPI_Init(ierr)
if (ierr /= MPI_SUCCESS) call stop_error("Error initializing MPI", module='LightKrylov',procedure='mpi_init')
else
call logger%log_debug('MPI already initialized.', module='LightKrylov', procedure='comm_setup')
end if
call MPI_Comm_rank(MPI_COMM_WORLD, nid, ierr)
call MPI_Comm_size(MPI_COMM_WORLD, comm_size, ierr)
write(msg, '(A,I4,A,I4)') 'rank', nid, ', comm_size = ', comm_size
call logger%log_debug(trim(msg), module='LightKrylov', procedure='comm_setup')
#else
write(msg, *) 'Setup serial run'
call logger%log_debug(trim(msg), module='LightKrylov', procedure='comm_setup')
#endif
return
end subroutine comm_setup

subroutine comm_close()
integer :: ierr
#ifdef MPI
character(len=128) :: msg
! Finalize MPI
call MPI_Finalize(ierr)
if (ierr /= MPI_SUCCESS) call stop_error("Error finalizing MPI", module='LightKrylov',procedure='comm_close')
#else
ierr = 0
#endif
return
end subroutine comm_close

subroutine stop_error(msg, module, procedure)
character(len=*), intent(in) :: msg
!! The name of the procedure in which the call happens
Expand Down

0 comments on commit aba85ed

Please sign in to comment.