From 5e7565f99f135e871fe7a58cc40d80284e2a3bdc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 9 Jan 2024 14:25:02 +0100 Subject: [PATCH] status needs to be passed --- src/Marc/DAMASK_Marc.f90 | 2 +- src/parallelization.f90 | 21 +++++++++++++-------- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/src/Marc/DAMASK_Marc.f90 b/src/Marc/DAMASK_Marc.f90 index 539bc49d2..6f34f5354 100644 --- a/src/Marc/DAMASK_Marc.f90 +++ b/src/Marc/DAMASK_Marc.f90 @@ -16,8 +16,8 @@ #endif #include "../prec.f90" -#include "../parallelization.f90" #include "../constants.f90" +#include "../parallelization.f90" #include "../misc.f90" #include "../IO.f90" #include "../YAML_types.f90" diff --git a/src/parallelization.f90 b/src/parallelization.f90 index 20ab75336..775a68f6c 100644 --- a/src/parallelization.f90 +++ b/src/parallelization.f90 @@ -7,6 +7,8 @@ module parallelization OUTPUT_UNIT, & ERROR_UNIT + use constants + #ifdef PETSC #include use PETScSys @@ -63,6 +65,7 @@ subroutine parallelization_init() !$ integer(pI32) :: OMP_NUM_THREADS !$ character(len=6) NumThreadsString PetscErrorCode :: err_PETSc + integer(kind(STATUS_OK)) :: status #ifdef _OPENMP @@ -116,28 +119,30 @@ subroutine parallelization_init() #endif call MPI_Comm_size(MPI_COMM_WORLD,worldsize,err_MPI) - if (err_MPI /= 0_MPI_INTEGER_KIND) & - error stop 'Could not determine worldsize' + call parallelization_chkerr(err_MPI) if (worldrank == 0) print'(/,1x,a,i0)', 'MPI processes: ',worldsize call MPI_Type_size(MPI_INTEGER,typeSize,err_MPI) - if (err_MPI /= 0_MPI_INTEGER_KIND) & - error stop 'Could not determine size of MPI_INTEGER' + call parallelization_chkerr(err_MPI) if (typeSize*8_MPI_INTEGER_KIND /= int(bit_size(0),MPI_INTEGER_KIND)) & error stop 'Mismatch between MPI_INTEGER and DAMASK default integer' call MPI_Type_size(MPI_INTEGER8,typeSize,err_MPI) - if (err_MPI /= 0) & - error stop 'Could not determine size of MPI_INTEGER8' + call parallelization_chkerr(err_MPI) if (typeSize*8_MPI_INTEGER_KIND /= int(bit_size(0_pI64),MPI_INTEGER_KIND)) & error stop 'Mismatch between MPI_INTEGER8 and DAMASK pI64' call MPI_Type_size(MPI_DOUBLE,typeSize,err_MPI) - if (err_MPI /= 0_MPI_INTEGER_KIND) & - error stop 'Could not determine size of MPI_DOUBLE' + call parallelization_chkerr(err_MPI) if (typeSize*8_MPI_INTEGER_KIND /= int(storage_size(0.0_pREAL),MPI_INTEGER_KIND)) & 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) !$ if (got_env /= 0) then !$ print'(1x,a)', 'Could not get $OMP_NUM_THREADS, using default'