status needs to be passed

This commit is contained in:
Martin Diehl 2024-01-09 14:25:02 +01:00
parent 62bce163cd
commit 5e7565f99f
No known key found for this signature in database
GPG Key ID: 1FD50837275A0A9B
2 changed files with 14 additions and 9 deletions

View File

@ -16,8 +16,8 @@
#endif #endif
#include "../prec.f90" #include "../prec.f90"
#include "../parallelization.f90"
#include "../constants.f90" #include "../constants.f90"
#include "../parallelization.f90"
#include "../misc.f90" #include "../misc.f90"
#include "../IO.f90" #include "../IO.f90"
#include "../YAML_types.f90" #include "../YAML_types.f90"

View File

@ -7,6 +7,8 @@ module parallelization
OUTPUT_UNIT, & OUTPUT_UNIT, &
ERROR_UNIT ERROR_UNIT
use constants
#ifdef PETSC #ifdef PETSC
#include <petsc/finclude/petscsys.h> #include <petsc/finclude/petscsys.h>
use PETScSys use PETScSys
@ -63,6 +65,7 @@ subroutine parallelization_init()
!$ integer(pI32) :: OMP_NUM_THREADS !$ integer(pI32) :: OMP_NUM_THREADS
!$ character(len=6) NumThreadsString !$ character(len=6) NumThreadsString
PetscErrorCode :: err_PETSc PetscErrorCode :: err_PETSc
integer(kind(STATUS_OK)) :: status
#ifdef _OPENMP #ifdef _OPENMP
@ -116,28 +119,30 @@ subroutine parallelization_init()
#endif #endif
call MPI_Comm_size(MPI_COMM_WORLD,worldsize,err_MPI) call MPI_Comm_size(MPI_COMM_WORLD,worldsize,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) & call parallelization_chkerr(err_MPI)
error stop 'Could not determine worldsize'
if (worldrank == 0) print'(/,1x,a,i0)', 'MPI processes: ',worldsize if (worldrank == 0) print'(/,1x,a,i0)', 'MPI processes: ',worldsize
call MPI_Type_size(MPI_INTEGER,typeSize,err_MPI) call MPI_Type_size(MPI_INTEGER,typeSize,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) & call parallelization_chkerr(err_MPI)
error stop 'Could not determine size of MPI_INTEGER'
if (typeSize*8_MPI_INTEGER_KIND /= int(bit_size(0),MPI_INTEGER_KIND)) & if (typeSize*8_MPI_INTEGER_KIND /= int(bit_size(0),MPI_INTEGER_KIND)) &
error stop 'Mismatch between MPI_INTEGER and DAMASK default integer' error stop 'Mismatch between MPI_INTEGER and DAMASK default integer'
call MPI_Type_size(MPI_INTEGER8,typeSize,err_MPI) call MPI_Type_size(MPI_INTEGER8,typeSize,err_MPI)
if (err_MPI /= 0) & call parallelization_chkerr(err_MPI)
error stop 'Could not determine size of MPI_INTEGER8'
if (typeSize*8_MPI_INTEGER_KIND /= int(bit_size(0_pI64),MPI_INTEGER_KIND)) & if (typeSize*8_MPI_INTEGER_KIND /= int(bit_size(0_pI64),MPI_INTEGER_KIND)) &
error stop 'Mismatch between MPI_INTEGER8 and DAMASK pI64' error stop 'Mismatch between MPI_INTEGER8 and DAMASK pI64'
call MPI_Type_size(MPI_DOUBLE,typeSize,err_MPI) call MPI_Type_size(MPI_DOUBLE,typeSize,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) & call parallelization_chkerr(err_MPI)
error stop 'Could not determine size of MPI_DOUBLE'
if (typeSize*8_MPI_INTEGER_KIND /= int(storage_size(0.0_pREAL),MPI_INTEGER_KIND)) & if (typeSize*8_MPI_INTEGER_KIND /= int(storage_size(0.0_pREAL),MPI_INTEGER_KIND)) &
error stop 'Mismatch between MPI_DOUBLE and DAMASK pREAL' error stop 'Mismatch between MPI_DOUBLE and DAMASK pREAL'
call MPI_Type_size(MPI_INTEGER,typeSize,err_MPI)
call parallelization_chkerr(err_MPI)
if (typeSize*8_MPI_INTEGER_KIND /= int(bit_size(status),MPI_INTEGER_KIND)) &
error stop 'Mismatch between MPI_INTEGER and DAMASK status'
!$ call get_environment_variable(name='OMP_NUM_THREADS',value=NumThreadsString,STATUS=got_env) !$ call get_environment_variable(name='OMP_NUM_THREADS',value=NumThreadsString,STATUS=got_env)
!$ if (got_env /= 0) then !$ if (got_env /= 0) then
!$ print'(1x,a)', 'Could not get $OMP_NUM_THREADS, using default' !$ print'(1x,a)', 'Could not get $OMP_NUM_THREADS, using default'