223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

do not rely on 6=STDOUT, 0=STDERR

This commit is contained in:
Martin Diehl 2020-09-19 10:50:32 +02:00
parent c34bf83e35
commit 1d2e9324f1
5 changed files with 44 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/DAMASK_interface.f90
View File

@ -14,7 +14,7 @@
#define PETSC_MINOR_MAX 13 #define PETSC_MINOR_MAX 13
module DAMASK_interface module DAMASK_interface
use, intrinsic :: iso_fortran_env use, intrinsic :: ISO_fortran_env
use PETScSys use PETScSys

2
src/DAMASK_marc.f90
View File

@ -30,7 +30,7 @@
module DAMASK_interface module DAMASK_interface
use prec use prec
#if __INTEL_COMPILER >= 1800 #if __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: & use, intrinsic :: ISO_fortran_env, only: &
compiler_version, & compiler_version, &
compiler_options compiler_options
#endif #endif

57
src/IO.f90
View File

@ -6,6 +6,10 @@
!> @brief input/output functions !> @brief input/output functions
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module IO module IO
use, intrinsic :: ISO_fortran_env, only: &
OUTPUT_UNIT, &
ERROR_UNIT
use prec use prec
implicit none implicit none
@ -37,7 +41,8 @@ module IO
IO_stringAsFloat, & IO_stringAsFloat, &
IO_stringAsBool, & IO_stringAsBool, &
IO_error, & IO_error, &
IO_warning IO_warning, &
OUTPUT_UNIT
contains contains
@ -538,29 +543,29 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
end select end select
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(0,'(/,a)') ' ┌'//IO_DIVIDER//'┐' write(ERROR_UNIT,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
write(0,'(a,24x,a,40x,a)') ' │','error', '│' write(ERROR_UNIT,'(a,24x,a,40x,a)') ' │','error', '│'
write(0,'(a,24x,i3,42x,a)') ' │',error_ID, '│' write(ERROR_UNIT,'(a,24x,i3,42x,a)') ' │',error_ID, '│'
write(0,'(a)') ' ├'//IO_DIVIDER//'┤' write(ERROR_UNIT,'(a)') ' ├'//IO_DIVIDER//'┤'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',& write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
max(1,72-len_trim(msg)-4),'x,a)' max(1,72-len_trim(msg)-4),'x,a)'
write(0,formatString) '│ ',trim(msg), '│' write(ERROR_UNIT,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then if (present(ext_msg)) then
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',& write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,72-len_trim(ext_msg)-4),'x,a)' max(1,72-len_trim(ext_msg)-4),'x,a)'
write(0,formatString) '│ ',trim(ext_msg), '│' write(ERROR_UNIT,formatString) '│ ',trim(ext_msg), '│'
endif endif
if (present(el)) & if (present(el)) &
write(0,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
if (present(ip)) & if (present(ip)) &
write(0,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│' write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
if (present(g)) & if (present(g)) &
write(0,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│' write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
if (present(instance)) & if (present(instance)) &
write(0,'(a19,1x,i9,44x,a3)') ' │ at instance ',instance, '│' write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at instance ',instance, '│'
write(0,'(a,69x,a)') ' │', '│' write(ERROR_UNIT,'(a,69x,a)') ' │', '│'
write(0,'(a)') ' └'//IO_DIVIDER//'┘' write(ERROR_UNIT,'(a)') ' └'//IO_DIVIDER//'┘'
flush(0) flush(ERROR_UNIT)
call quit(9000+error_ID) call quit(9000+error_ID)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
@ -623,27 +628,27 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg)
end select end select
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(/,a)') ' ┌'//IO_DIVIDER//'┐' write(ERROR_UNIT,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
write(6,'(a,24x,a,38x,a)') ' │','warning', '│' write(ERROR_UNIT,'(a,24x,a,38x,a)') ' │','warning', '│'
write(6,'(a,24x,i3,42x,a)') ' │',warning_ID, '│' write(ERROR_UNIT,'(a,24x,i3,42x,a)') ' │',warning_ID, '│'
write(6,'(a)') ' ├'//IO_DIVIDER//'┤' write(ERROR_UNIT,'(a)') ' ├'//IO_DIVIDER//'┤'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',& write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
max(1,72-len_trim(msg)-4),'x,a)' max(1,72-len_trim(msg)-4),'x,a)'
write(6,formatString) '│ ',trim(msg), '│' write(ERROR_UNIT,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then if (present(ext_msg)) then
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',& write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,72-len_trim(ext_msg)-4),'x,a)' max(1,72-len_trim(ext_msg)-4),'x,a)'
write(6,formatString) '│ ',trim(ext_msg), '│' write(ERROR_UNIT,formatString) '│ ',trim(ext_msg), '│'
endif endif
if (present(el)) & if (present(el)) &
write(6,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
if (present(ip)) & if (present(ip)) &
write(6,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│' write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
if (present(g)) & if (present(g)) &
write(6,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│' write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
write(6,'(a,69x,a)') ' │', '│' write(ERROR_UNIT,'(a,69x,a)') ' │', '│'
write(6,'(a)') ' └'//IO_DIVIDER//'┘' write(ERROR_UNIT,'(a)') ' └'//IO_DIVIDER//'┘'
flush(6) flush(ERROR_UNIT)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
end subroutine IO_warning end subroutine IO_warning

22
src/parallelization.f90
View File

@ -3,8 +3,8 @@
!> @brief Inquires variables related to parallelization (openMP, MPI) !> @brief Inquires variables related to parallelization (openMP, MPI)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module parallelization module parallelization
use prec use, intrinsic :: ISO_fortran_env, only: &
use, intrinsic :: iso_fortran_env OUTPUT_UNIT
#ifdef PETSc #ifdef PETSc
#include <petsc/finclude/petscsys.h> #include <petsc/finclude/petscsys.h>
@ -12,6 +12,8 @@ module parallelization
#endif #endif
!$ use OMP_LIB !$ use OMP_LIB
use prec
implicit none implicit none
private private
@ -29,14 +31,14 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine parallelization_init subroutine parallelization_init
integer :: err, typeSize integer :: err, typeSize
!$ integer :: got_env, DAMASK_NUM_THREADS, threadLevel !$ integer :: got_env, DAMASK_NUM_THREADS, threadLevel
!$ character(len=6) NumThreadsString !$ character(len=6) NumThreadsString
#ifdef PETSc #ifdef PETSc
PetscErrorCode :: petsc_err PetscErrorCode :: petsc_err
#else #else
print'(/,a)', ' <<<+- parallelization init -+>>>'; flush(6) print'(/,a)', ' <<<+- parallelization init -+>>>'; flush(OUTPUT_UNIT)
#endif #endif
#ifdef PETSc #ifdef PETSc
@ -69,14 +71,10 @@ subroutine parallelization_init
if (typeSize*8 /= storage_size(0.0_pReal)) error stop 'Mismatch between MPI and DAMASK real' if (typeSize*8 /= storage_size(0.0_pReal)) error stop 'Mismatch between MPI and DAMASK real'
#endif #endif
mainProcess: if (worldrank == 0) then if (worldrank /= 0) then
if (output_unit /= 6) error stop 'STDOUT != 6' close(OUTPUT_UNIT) ! disable output
if (error_unit /= 0) error stop 'STDERR != 0' open(OUTPUT_UNIT,file='/dev/null',status='replace') ! close() alone will leave some temp files in cwd
else mainProcess endif
close(6) ! disable output for non-master processes (open 6 to rank specific file for debug)
open(6,file='/dev/null',status='replace') ! close(6) alone will leave some temp files in cwd
endif mainProcess
!$ call get_environment_variable(name='DAMASK_NUM_THREADS',value=NumThreadsString,STATUS=got_env) !$ call get_environment_variable(name='DAMASK_NUM_THREADS',value=NumThreadsString,STATUS=got_env)
!$ if(got_env /= 0) then !$ if(got_env /= 0) then

2
src/prec.f90
View File

@ -8,7 +8,7 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module prec module prec
use, intrinsic :: IEEE_arithmetic use, intrinsic :: IEEE_arithmetic
use, intrinsic :: ISO_C_Binding use, intrinsic :: ISO_C_binding
implicit none implicit none
public public