2020-09-12 19:36:33 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
|
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
|
|
|
|
|
!> @brief Inquires variables related to parallelization (openMP, MPI)
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
|
module parallelization
|
2020-09-19 14:20:32 +05:30
|
|
|
use, intrinsic :: ISO_fortran_env, only: &
|
|
|
|
|
OUTPUT_UNIT
|
2020-09-12 19:36:33 +05:30
|
|
|
|
2021-07-08 18:35:01 +05:30
|
|
|
#ifdef PETSC
|
2020-09-12 19:36:33 +05:30
|
|
|
#include <petsc/finclude/petscsys.h>
|
2021-07-08 18:51:35 +05:30
|
|
|
use PETScSys
|
2021-07-09 18:20:29 +05:30
|
|
|
#if !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) && !defined(PETSC_HAVE_MPI_F90MODULE)
|
2021-07-08 18:51:35 +05:30
|
|
|
use MPI_f08
|
|
|
|
|
#endif
|
2020-09-12 19:36:33 +05:30
|
|
|
!$ use OMP_LIB
|
2021-02-02 13:33:41 +05:30
|
|
|
#endif
|
2020-09-19 14:20:32 +05:30
|
|
|
use prec
|
|
|
|
|
|
2020-09-12 19:36:33 +05:30
|
|
|
implicit none
|
|
|
|
|
private
|
|
|
|
|
|
2020-09-13 13:49:38 +05:30
|
|
|
integer, protected, public :: &
|
|
|
|
|
worldrank = 0, & !< MPI worldrank (/=0 for MPI simulations only)
|
|
|
|
|
worldsize = 1 !< MPI worldsize (/=1 for MPI simulations only)
|
|
|
|
|
|
2021-07-08 18:35:01 +05:30
|
|
|
#ifdef PETSC
|
2020-09-12 19:36:33 +05:30
|
|
|
public :: &
|
|
|
|
|
parallelization_init
|
|
|
|
|
|
|
|
|
|
contains
|
|
|
|
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
2021-05-23 03:40:46 +05:30
|
|
|
!> @brief Initialize shared memory (openMP) and distributed memory (MPI) parallelization.
|
2020-09-12 19:36:33 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
|
subroutine parallelization_init
|
|
|
|
|
|
2020-09-19 14:20:32 +05:30
|
|
|
integer :: err, typeSize
|
2021-02-02 13:33:41 +05:30
|
|
|
!$ integer :: got_env, threadLevel
|
|
|
|
|
!$ integer(pI32) :: OMP_NUM_THREADS
|
2020-09-12 19:55:58 +05:30
|
|
|
!$ character(len=6) NumThreadsString
|
|
|
|
|
|
|
|
|
|
|
2021-02-02 13:33:41 +05:30
|
|
|
PetscErrorCode :: petsc_err
|
2020-09-13 13:49:38 +05:30
|
|
|
#ifdef _OPENMP
|
|
|
|
|
! If openMP is enabled, check if the MPI libary supports it and initialize accordingly.
|
|
|
|
|
! Otherwise, the first call to PETSc will do the initialization.
|
|
|
|
|
call MPI_Init_Thread(MPI_THREAD_FUNNELED,threadLevel,err)
|
2021-05-23 03:40:46 +05:30
|
|
|
if (err /= 0) error stop 'MPI init failed'
|
|
|
|
|
if (threadLevel<MPI_THREAD_FUNNELED) error stop 'MPI library does not support OpenMP'
|
2020-09-13 13:49:38 +05:30
|
|
|
#endif
|
2020-09-13 16:31:38 +05:30
|
|
|
|
2020-11-28 16:17:20 +05:30
|
|
|
#if defined(DEBUG)
|
|
|
|
|
call PetscInitialize(PETSC_NULL_CHARACTER,petsc_err)
|
|
|
|
|
#else
|
|
|
|
|
call PetscInitializeNoArguments(petsc_err)
|
|
|
|
|
#endif
|
2020-09-13 13:49:38 +05:30
|
|
|
CHKERRQ(petsc_err)
|
|
|
|
|
|
2020-11-12 02:00:11 +05:30
|
|
|
#if defined(DEBUG) && defined(__INTEL_COMPILER)
|
2020-11-11 16:16:12 +05:30
|
|
|
call PetscSetFPTrap(PETSC_FP_TRAP_ON,petsc_err)
|
|
|
|
|
#else
|
|
|
|
|
call PetscSetFPTrap(PETSC_FP_TRAP_OFF,petsc_err)
|
|
|
|
|
#endif
|
|
|
|
|
CHKERRQ(petsc_err)
|
|
|
|
|
|
2021-07-08 18:51:35 +05:30
|
|
|
call MPI_Comm_rank(MPI_COMM_WORLD,worldrank,err)
|
2020-09-28 01:58:22 +05:30
|
|
|
if (err /= 0) error stop 'Could not determine worldrank'
|
2020-09-13 16:31:38 +05:30
|
|
|
|
2020-09-14 00:51:55 +05:30
|
|
|
if (worldrank == 0) print'(/,a)', ' <<<+- parallelization init -+>>>'
|
2020-09-13 16:31:38 +05:30
|
|
|
|
2021-07-08 18:51:35 +05:30
|
|
|
call MPI_Comm_size(MPI_COMM_WORLD,worldsize,err)
|
2020-09-28 01:58:22 +05:30
|
|
|
if (err /= 0) error stop 'Could not determine worldsize'
|
|
|
|
|
if (worldrank == 0) print'(a,i3)', ' MPI processes: ',worldsize
|
2020-09-13 13:49:38 +05:30
|
|
|
|
|
|
|
|
call MPI_Type_size(MPI_INTEGER,typeSize,err)
|
|
|
|
|
if (err /= 0) error stop 'Could not determine MPI integer size'
|
|
|
|
|
if (typeSize*8 /= bit_size(0)) error stop 'Mismatch between MPI and DAMASK integer'
|
|
|
|
|
|
|
|
|
|
call MPI_Type_size(MPI_DOUBLE,typeSize,err)
|
|
|
|
|
if (err /= 0) error stop 'Could not determine MPI real size'
|
|
|
|
|
if (typeSize*8 /= storage_size(0.0_pReal)) error stop 'Mismatch between MPI and DAMASK real'
|
|
|
|
|
|
2020-09-19 14:20:32 +05:30
|
|
|
if (worldrank /= 0) then
|
|
|
|
|
close(OUTPUT_UNIT) ! disable output
|
|
|
|
|
open(OUTPUT_UNIT,file='/dev/null',status='replace') ! close() alone will leave some temp files in cwd
|
|
|
|
|
endif
|
2020-09-13 13:49:38 +05:30
|
|
|
|
2021-01-13 17:18:20 +05:30
|
|
|
!$ call get_environment_variable(name='OMP_NUM_THREADS',value=NumThreadsString,STATUS=got_env)
|
2020-09-13 13:49:38 +05:30
|
|
|
!$ if(got_env /= 0) then
|
2021-04-22 11:34:02 +05:30
|
|
|
!$ print*, 'Could not get $OMP_NUM_THREADS, using default'
|
|
|
|
|
!$ OMP_NUM_THREADS = 4_pI32
|
2020-09-12 19:55:58 +05:30
|
|
|
!$ else
|
2021-01-13 17:18:20 +05:30
|
|
|
!$ read(NumThreadsString,'(i6)') OMP_NUM_THREADS
|
|
|
|
|
!$ if (OMP_NUM_THREADS < 1_pI32) then
|
2021-04-22 11:34:02 +05:30
|
|
|
!$ print*, 'Invalid OMP_NUM_THREADS: "'//trim(NumThreadsString)//'", using default'
|
|
|
|
|
!$ OMP_NUM_THREADS = 4_pI32
|
2020-09-12 19:55:58 +05:30
|
|
|
!$ endif
|
|
|
|
|
!$ endif
|
2021-01-13 17:18:20 +05:30
|
|
|
!$ print'(a,i2)', ' OMP_NUM_THREADS: ',OMP_NUM_THREADS
|
|
|
|
|
!$ call omp_set_num_threads(OMP_NUM_THREADS)
|
2020-09-13 13:49:38 +05:30
|
|
|
|
2020-09-12 19:36:33 +05:30
|
|
|
end subroutine parallelization_init
|
2021-02-02 13:33:41 +05:30
|
|
|
#endif
|
2020-09-12 19:36:33 +05:30
|
|
|
|
|
|
|
|
end module parallelization
|
