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
module DAMASK_interface
use, intrinsic :: iso_fortran_env
use, intrinsic :: ISO_fortran_env
use PETScSys

2
src/DAMASK_marc.f90
View File

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

57
src/IO.f90
View File

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

22
src/parallelization.f90
View File

@ -3,8 +3,8 @@
!> @brief Inquires variables related to parallelization (openMP, MPI)
!--------------------------------------------------------------------------------------------------
module parallelization
use prec
use, intrinsic :: iso_fortran_env
use, intrinsic :: ISO_fortran_env, only: &
OUTPUT_UNIT
#ifdef PETSc
#include <petsc/finclude/petscsys.h>
@ -12,6 +12,8 @@ module parallelization
#endif
!$ use OMP_LIB
use prec
implicit none
private
@ -29,14 +31,14 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine parallelization_init
integer :: err, typeSize
integer :: err, typeSize
!$ integer :: got_env, DAMASK_NUM_THREADS, threadLevel
!$ character(len=6) NumThreadsString
#ifdef PETSc
PetscErrorCode :: petsc_err
#else
print'(/,a)', ' <<<+- parallelization init -+>>>'; flush(6)
print'(/,a)', ' <<<+- parallelization init -+>>>'; flush(OUTPUT_UNIT)
#endif
#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'
#endif
mainProcess: if (worldrank == 0) then
if (output_unit /= 6) error stop 'STDOUT != 6'
if (error_unit /= 0) error stop 'STDERR != 0'
else mainProcess
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
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
!$ call get_environment_variable(name='DAMASK_NUM_THREADS',value=NumThreadsString,STATUS=got_env)
!$ if(got_env /= 0) then

2
src/prec.f90
View File

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