diff --git a/DAMASK_prerequisites.sh b/DAMASK_prerequisites.sh index ba054dc8b..662fbbdc7 100755 --- a/DAMASK_prerequisites.sh +++ b/DAMASK_prerequisites.sh @@ -1,13 +1,13 @@ #!/usr/bin/env bash #================================================================================================== -# Execute this script (type './DAMASK_prerequisites.sh') +# Execute this script (type './DAMASK_prerequisites.sh') # and send system_report.txt to damask@mpie.de for support #================================================================================================== OUTFILE="system_report.txt" echo =========================================== -echo + Generating $OUTFILE +echo + Generating $OUTFILE echo + Send to damask@mpie.de for support echo + view with \'cat $OUTFILE\' echo =========================================== @@ -47,7 +47,7 @@ echo # redirect STDOUT and STDERR to logfile # https://stackoverflow.com/questions/11229385/redirect-all-output-in-a-bash-script-when-using-set-x^ exec > $OUTFILE 2>&1 - + # directory, file is not a symlink by definition # https://stackoverflow.com/questions/59895/getting-the-source-directory-of-a-bash-script-from-within DAMASK_ROOT="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" @@ -88,7 +88,7 @@ done secondLevel "Details on $DEFAULT_PYTHON:" echo $(ls -la $(which $DEFAULT_PYTHON)) for MODULE in numpy scipy pandas matplotlib yaml h5py;do - thirdLevel $module + thirdLevel $MODULE $DEFAULT_PYTHON -c "import $MODULE; \ print('Version: {}'.format($MODULE.__version__)); \ print('Location: {}'.format($MODULE.__file__))" diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 77b87c7ed..65ee66af9 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -38,16 +38,12 @@ module HDF5_utilities module procedure HDF5_read_real3 module procedure HDF5_read_real4 module procedure HDF5_read_real5 - module procedure HDF5_read_real6 - module procedure HDF5_read_real7 module procedure HDF5_read_int1 module procedure HDF5_read_int2 module procedure HDF5_read_int3 module procedure HDF5_read_int4 module procedure HDF5_read_int5 - module procedure HDF5_read_int6 - module procedure HDF5_read_int7 end interface HDF5_read !-------------------------------------------------------------------------------------------------- @@ -56,20 +52,19 @@ module HDF5_utilities !-------------------------------------------------------------------------------------------------- interface HDF5_write #if defined(__GFORTRAN__) + ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=105674 + ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=105687 module procedure HDF5_write_real1 module procedure HDF5_write_real2 module procedure HDF5_write_real3 module procedure HDF5_write_real4 module procedure HDF5_write_real5 - module procedure HDF5_write_real6 - module procedure HDF5_write_real7 + module procedure HDF5_write_int1 module procedure HDF5_write_int2 module procedure HDF5_write_int3 module procedure HDF5_write_int4 module procedure HDF5_write_int5 - module procedure HDF5_write_int6 - module procedure HDF5_write_int7 #else module procedure HDF5_write_real module procedure HDF5_write_int @@ -811,76 +806,6 @@ subroutine HDF5_read_real5(dataset,loc_id,datasetName,parallel) end subroutine HDF5_read_real5 -!-------------------------------------------------------------------------------------------------- -!> @brief read dataset of type real with 6 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_real6(dataset,loc_id,datasetName,parallel) - - real(pREAL), intent(out), dimension(:,:,:,:,:,:) :: dataset !< data read from file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes - - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) - integer :: hdferr - - - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - - call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, & - myStart,totalShape,loc_id,myShape,datasetName, & - misc_optional(parallel,parallel_default)) - -if (any(totalShape == 0)) return - - call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& - file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - call HDF5_chkerr(hdferr) - - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) - -end subroutine HDF5_read_real6 - -!-------------------------------------------------------------------------------------------------- -!> @brief read dataset of type real with 7 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_real7(dataset,loc_id,datasetName,parallel) - - real(pREAL), intent(out), dimension(:,:,:,:,:,:,:) :: dataset !< data read from file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes - - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) - integer :: hdferr - - - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - - call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, & - myStart,totalShape,loc_id,myShape,datasetName, & - misc_optional(parallel,parallel_default)) - - if (any(totalShape == 0)) return - - call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& - file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - call HDF5_chkerr(hdferr) - - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) - -end subroutine HDF5_read_real7 - !-------------------------------------------------------------------------------------------------- !> @brief read dataset of type integer with 1 dimension @@ -1053,78 +978,8 @@ subroutine HDF5_read_int5(dataset,loc_id,datasetName,parallel) end subroutine HDF5_read_int5 -!-------------------------------------------------------------------------------------------------- -!> @brief read dataset of type integer with 6 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_int6(dataset,loc_id,datasetName,parallel) - - integer, intent(out), dimension(:,:,:,:,:,:) :: dataset !< data read from file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes - - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) - integer :: hdferr - - - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - - call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, & - myStart,totalShape,loc_id,myShape,datasetName, & - misc_optional(parallel,parallel_default)) - - if (any(totalShape == 0)) return - - call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& - file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - call HDF5_chkerr(hdferr) - - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) - -end subroutine HDF5_read_int6 - -!-------------------------------------------------------------------------------------------------- -!> @brief read dataset of type integer with 7 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_int7(dataset,loc_id,datasetName,parallel) - - integer, intent(out), dimension(:,:,:,:,:,:,:) :: dataset !< data read from file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes - - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) - integer :: hdferr - - - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - - call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, & - myStart,totalShape,loc_id,myShape,datasetName, & - misc_optional(parallel,parallel_default)) - - if (any(totalShape == 0)) return - - call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& - file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - call HDF5_chkerr(hdferr) - - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) - -end subroutine HDF5_read_int7 #if defined(__GFORTRAN__) - !-------------------------------------------------------------------------------------------------- !> @brief write dataset of type real with 1 dimension !-------------------------------------------------------------------------------------------------- @@ -1311,84 +1166,10 @@ subroutine HDF5_write_real5(dataset,loc_id,datasetName,parallel) end subroutine HDF5_write_real5 -!-------------------------------------------------------------------------------------------------- -!> @brief write dataset of type real with 6 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_real6(dataset,loc_id,datasetName,parallel) - - real(pREAL), intent(in), dimension(:,:,:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes - - - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) - -!--------------------------------------------------------------------------------------------------- -! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - - call initialize_write(dset_id,filespace_id,memspace_id,plist_id, & - myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE, & - misc_optional(parallel,parallel_default)) - - if (product(totalShape) /= 0) then - call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& - file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - call HDF5_chkerr(hdferr) - end if - - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) - -end subroutine HDF5_write_real6 - -!-------------------------------------------------------------------------------------------------- -!> @brief write dataset of type real with 7 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_real7(dataset,loc_id,datasetName,parallel) - - real(pREAL), intent(in), dimension(:,:,:,:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes - - - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) - -!--------------------------------------------------------------------------------------------------- -! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - - call initialize_write(dset_id,filespace_id,memspace_id,plist_id, & - myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE, & - misc_optional(parallel,parallel_default)) - - if (product(totalShape) /= 0) then - call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& - file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - call HDF5_chkerr(hdferr) - end if - - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) - -end subroutine HDF5_write_real7 - #else !-------------------------------------------------------------------------------------------------- -!> @brief write dataset of type real with 1-7 dimension +!> @brief write dataset of type real with 1-5 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real(dataset,loc_id,datasetName,parallel) @@ -1431,12 +1212,6 @@ subroutine HDF5_write_real(dataset,loc_id,datasetName,parallel) rank (5) call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - rank (6) - call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& - file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - rank (7) - call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& - file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) end select call HDF5_chkerr(hdferr) end if @@ -1508,8 +1283,8 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName) end subroutine HDF5_write_str -#if defined(__GFORTRAN__) +#if defined(__GFORTRAN__) !-------------------------------------------------------------------------------------------------- !> @brief Write dataset of type integer with 1 dimensions. !-------------------------------------------------------------------------------------------------- @@ -1695,84 +1470,10 @@ subroutine HDF5_write_int5(dataset,loc_id,datasetName,parallel) end subroutine HDF5_write_int5 -!-------------------------------------------------------------------------------------------------- -!> @brief Write dataset of type integer with 6 dimensions. -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_int6(dataset,loc_id,datasetName,parallel) - - integer, intent(in), dimension(:,:,:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes - - - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) - -!--------------------------------------------------------------------------------------------------- -! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - - call initialize_write(dset_id,filespace_id,memspace_id,plist_id, & - myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_INTEGER, & - misc_optional(parallel,parallel_default)) - - if (product(totalShape) /= 0) then - call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& - file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - call HDF5_chkerr(hdferr) - end if - - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) - -end subroutine HDF5_write_int6 - -!-------------------------------------------------------------------------------------------------- -!> @brief Write dataset of type integer with 7 dimensions. -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_int7(dataset,loc_id,datasetName,parallel) - - integer, intent(in), dimension(:,:,:,:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes - - - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(rank(dataset)) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) - -!--------------------------------------------------------------------------------------------------- -! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - - call initialize_write(dset_id,filespace_id,memspace_id,plist_id, & - myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_INTEGER, & - misc_optional(parallel,parallel_default)) - - if (product(totalShape) /= 0) then - call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& - file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - call HDF5_chkerr(hdferr) - end if - - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) - -end subroutine HDF5_write_int7 - #else !-------------------------------------------------------------------------------------------------- -!> @brief Write dataset of type integer with 1-7 dimensions. +!> @brief Write dataset of type integer with 1-5 dimensions. !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int(dataset,loc_id,datasetName,parallel) @@ -1815,12 +1516,6 @@ subroutine HDF5_write_int(dataset,loc_id,datasetName,parallel) rank(5) call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - rank(6) - call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& - file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - rank(7) - call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& - file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) end select call HDF5_chkerr(hdferr) end if @@ -1830,6 +1525,7 @@ subroutine HDF5_write_int(dataset,loc_id,datasetName,parallel) end subroutine HDF5_write_int #endif + !-------------------------------------------------------------------------------------------------- !> @brief Initialize read handles and determine global shape in case of parallel IO. !-------------------------------------------------------------------------------------------------- diff --git a/src/IO.f90 b/src/IO.f90 index 6f34d1b7f..71d51f697 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -247,6 +247,7 @@ function IO_strValue(str,chunkPos,myChunk) integer, intent(in) :: myChunk !< position number of desired chunk character(len=:), allocatable :: IO_strValue + validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then IO_strValue = '' call IO_error(110,'IO_strValue: "'//trim(str)//'"',label1='chunk',ID1=myChunk) @@ -266,6 +267,7 @@ integer function IO_intValue(str,chunkPos,myChunk) integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string integer, intent(in) :: myChunk !< position number of desired chunk + IO_intValue = IO_strAsInt(IO_strValue(str,chunkPos,myChunk)) end function IO_intValue @@ -280,6 +282,7 @@ real(pREAL) function IO_realValue(str,chunkPos,myChunk) integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string integer, intent(in) :: myChunk !< position number of desired chunk + IO_realValue = IO_strAsReal(IO_strValue(str,chunkPos,myChunk)) end function IO_realValue @@ -443,6 +446,7 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2) external :: quit character(len=:), allocatable :: msg + select case (error_ID) !-------------------------------------------------------------------------------------------------- diff --git a/src/materialpoint.f90 b/src/materialpoint.f90 index b92559a72..808cec146 100644 --- a/src/materialpoint.f90 +++ b/src/materialpoint.f90 @@ -5,8 +5,9 @@ !-------------------------------------------------------------------------------------------------- module materialpoint use parallelization - use signal use CLI + use system_routines + use signal use prec use misc use IO @@ -46,6 +47,7 @@ subroutine materialpoint_initAll() call parallelization_init() call CLI_init() ! grid and mesh commandline interface + call system_routines_init() call signal_init() call prec_init() call misc_init() diff --git a/src/math.f90 b/src/math.f90 index 8d4d3ff9c..863661c2c 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -1380,6 +1380,12 @@ subroutine math_selfTest() if (any(dNeq0(math_eye(3),math_inv33(math_I3)))) & error stop 'math_inv33(math_I3)' + if (any(dNeq(t33,math_symmetric33(t33)+math_skew33(t33),1.0e-10_pReal))) & + error stop 'math_symmetric/skew' + + if (any(dNeq(t33,math_spherical33(t33)+math_deviatoric33(t33),1.0e-10_pReal))) & + error stop 'math_spherical/deviatoric' + do while(abs(math_det33(t33))<1.0e-9_pREAL) call random_number(t33) end do diff --git a/src/system_routines.f90 b/src/system_routines.f90 index 5207b5b94..aa4a140d6 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -6,11 +6,14 @@ module system_routines use, intrinsic :: ISO_C_Binding use prec + use IO implicit none(type,external) private public :: & + system_routines_init, & + system_routines_selfTest, & setCWD, & getCWD, & getHostName, & @@ -93,6 +96,18 @@ module system_routines contains +!-------------------------------------------------------------------------------------------------- +!> @brief Do self test. +!-------------------------------------------------------------------------------------------------- +subroutine system_routines_init() + + print'(/,1x,a)', '<<<+- system_routines init -+>>>'; flush(IO_STDOUT) + + call system_routines_selfTest() + +end subroutine system_routines_init + + !-------------------------------------------------------------------------------------------------- !> @brief Set the current working directory. !-------------------------------------------------------------------------------------------------- @@ -103,6 +118,8 @@ logical function setCWD(path) setCWD = setCWD_C(f_c_string(path)) /= 0_C_INT + call system_routines_selfTest() + end function setCWD @@ -212,5 +229,30 @@ pure function f_c_string(f_string) result(c_string) end function f_c_string +!-------------------------------------------------------------------------------------------------- +!> @brief Check correctness of some system_routine functions. +!-------------------------------------------------------------------------------------------------- +subroutine system_routines_selfTest() + + real :: r + real, dimension(:), allocatable :: rnd_real + character(len=:), allocatable :: rnd_str + integer :: i + + + call random_number(r) + allocate(rnd_real(30+int(r*50.))) + call random_number(rnd_real) + allocate(character(size(rnd_real))::rnd_str) + + do i = 1, size(rnd_real) + rnd_str(i:i) = char(32 + int(rnd_real(i)*(127.-32.))) + end do + + if (c_f_string(f_c_string(rnd_str)) /= rnd_str) error stop 'c_f_string/f_c_string' + +end subroutine system_routines_selfTest + + end module system_routines diff --git a/src/test/DAMASK_test.f90 b/src/test/DAMASK_test.f90 index e2566be85..7b35174e1 100644 --- a/src/test/DAMASK_test.f90 +++ b/src/test/DAMASK_test.f90 @@ -5,6 +5,7 @@ program DAMASK_test use IO use test_prec + use test_system_routines use test_misc use test_math use test_polynomials @@ -19,7 +20,7 @@ program DAMASK_test character(len=*), parameter :: & ok = achar(27)//'[32mok'//achar(27)//'[0m', & - fmt = '(3x,a,T19,a,1x)' + fmt = '(3x,a,T20,a,1x)' call parallelization_init() call HDF5_utilities_init() @@ -34,6 +35,10 @@ program DAMASK_test call test_misc_run() write(IO_STDOUT,fmt='(a)') ok + write(IO_STDOUT,fmt=fmt, advance='no') 'system_routines','...' + call test_system_routines_run() + write(IO_STDOUT,fmt='(a)') ok + write(IO_STDOUT,fmt=fmt, advance='no') 'math','...' call test_math_run() write(IO_STDOUT,fmt='(a)') ok diff --git a/src/test/test_HDF5_utilities.f90 b/src/test/test_HDF5_utilities.f90 index fb43de8e2..905c9ebda 100644 --- a/src/test/test_HDF5_utilities.f90 +++ b/src/test/test_HDF5_utilities.f90 @@ -20,17 +20,108 @@ end subroutine test_HDF5_utilities_run subroutine read_write() integer(HID_T) :: f - real(pREAL), dimension(3) :: d_in,d_out + + real(pREAL), dimension(3) :: real_d1_in,real_d1_out + real(pREAL), dimension(3,3) :: real_d2_in,real_d2_out + real(pREAL), dimension(3,3,3) :: real_d3_in,real_d3_out + real(pREAL), dimension(3,3,3,3) :: real_d4_in,real_d4_out + real(pREAL), dimension(3,3,3,3,3) :: real_d5_in,real_d5_out + + integer, dimension(3) :: int_d1_in,int_d1_out + integer, dimension(3,3) :: int_d2_in,int_d2_out + integer, dimension(3,3,3) :: int_d3_in,int_d3_out + integer, dimension(3,3,3,3) :: int_d4_in,int_d4_out + integer, dimension(3,3,3,3,3) :: int_d5_in,int_d5_out - call random_number(d_in) + call random_number(real_d1_in) + call random_number(real_d2_in) + call random_number(real_d3_in) + call random_number(real_d4_in) + call random_number(real_d5_in) + + int_d1_in = int(real_d1_in*2048._pREAL) + int_d2_in = int(real_d2_in*2048._pREAL) + int_d3_in = int(real_d3_in*2048._pREAL) + int_d4_in = int(real_d4_in*2048._pREAL) + int_d5_in = int(real_d5_in*2048._pREAL) + f = HDF5_openFile('test.hdf5','w') - call HDF5_write(d_in,f,'test') - call HDF5_read(d_out,f,'test') - if (any(d_in /= d_out)) error stop 'test_read_write' + call HDF5_write(real_d1_in,f,'real_d1') + call HDF5_write(real_d2_in,f,'real_d2') + call HDF5_write(real_d3_in,f,'real_d3') + call HDF5_write(real_d4_in,f,'real_d4') + call HDF5_write(real_d5_in,f,'real_d5') + + call HDF5_write(int_d1_in,f,'int_d1') + call HDF5_write(int_d2_in,f,'int_d2') + call HDF5_write(int_d3_in,f,'int_d3') + call HDF5_write(int_d4_in,f,'int_d4') + call HDF5_write(int_d5_in,f,'int_d5') + + + call HDF5_read(real_d1_out,f,'real_d1') + call HDF5_read(real_d2_out,f,'real_d2') + call HDF5_read(real_d3_out,f,'real_d3') + call HDF5_read(real_d4_out,f,'real_d4') + call HDF5_read(real_d5_out,f,'real_d5') + + call HDF5_read(int_d1_out,f,'int_d1') + call HDF5_read(int_d2_out,f,'int_d2') + call HDF5_read(int_d3_out,f,'int_d3') + call HDF5_read(int_d4_out,f,'int_d4') + call HDF5_read(int_d5_out,f,'int_d5') + + + if (any(real_d1_in /= real_d1_out)) error stop 'test_read_write(w)/real_d1' + if (any(real_d2_in /= real_d2_out)) error stop 'test_read_write(w)/real_d2' + if (any(real_d3_in /= real_d3_out)) error stop 'test_read_write(w)/real_d3' + if (any(real_d4_in /= real_d4_out)) error stop 'test_read_write(w)/real_d4' + if (any(real_d5_in /= real_d5_out)) error stop 'test_read_write(w)/real_d5' + + if (any(int_d1_in /= int_d1_out)) error stop 'test_read_write(w)/int_d1' + if (any(int_d2_in /= int_d2_out)) error stop 'test_read_write(w)/int_d2' + if (any(int_d3_in /= int_d3_out)) error stop 'test_read_write(w)/int_d3' + if (any(int_d4_in /= int_d4_out)) error stop 'test_read_write(w)/int_d4' + if (any(int_d5_in /= int_d5_out)) error stop 'test_read_write(w)/int_d5' + + + call HDF5_closeFile(f) + + f = HDF5_openFile('test.hdf5','r') + + + call HDF5_read(real_d1_out,f,'real_d1') + call HDF5_read(real_d2_out,f,'real_d2') + call HDF5_read(real_d3_out,f,'real_d3') + call HDF5_read(real_d4_out,f,'real_d4') + call HDF5_read(real_d5_out,f,'real_d5') + + call HDF5_read(int_d1_out,f,'int_d1') + call HDF5_read(int_d2_out,f,'int_d2') + call HDF5_read(int_d3_out,f,'int_d3') + call HDF5_read(int_d4_out,f,'int_d4') + call HDF5_read(int_d5_out,f,'int_d5') + + + if (any(real_d1_in /= real_d1_out)) error stop 'test_read_write(r)/real_d1' + if (any(real_d2_in /= real_d2_out)) error stop 'test_read_write(r)/real_d2' + if (any(real_d3_in /= real_d3_out)) error stop 'test_read_write(r)/real_d3' + if (any(real_d4_in /= real_d4_out)) error stop 'test_read_write(r)/real_d4' + if (any(real_d5_in /= real_d5_out)) error stop 'test_read_write(r)/real_d5' + + if (any(int_d1_in /= int_d1_out)) error stop 'test_read_write(r)/int_d1' + if (any(int_d2_in /= int_d2_out)) error stop 'test_read_write(r)/int_d2' + if (any(int_d3_in /= int_d3_out)) error stop 'test_read_write(r)/int_d3' + if (any(int_d4_in /= int_d4_out)) error stop 'test_read_write(r)/int_d4' + if (any(int_d5_in /= int_d5_out)) error stop 'test_read_write(r)/int_d5' + + + call HDF5_closeFile(f) + end subroutine read_write diff --git a/src/test/test_IO.f90 b/src/test/test_IO.f90 index cae7f76c4..0ec2495a0 100644 --- a/src/test/test_IO.f90 +++ b/src/test/test_IO.f90 @@ -1,4 +1,6 @@ module test_IO + use prec + use parallelization use IO implicit none(type,external) @@ -10,8 +12,30 @@ module test_IO subroutine test_IO_run() + real, dimension(30) :: rnd_real + character(len=size(rnd_real)) :: rnd_str + character(len=pSTRLEN), dimension(1) :: strarray_out + character(len=:), allocatable :: str_out, fname + integer :: u,i + + call IO_selfTest() + call random_number(rnd_real) + fname = 'test'//IO_intAsStr(worldrank)//'.txt' + + do i = 1, size(rnd_real) + rnd_str(i:i) = char(32 + int(rnd_real(i)*(127.-32.))) + end do + open(newunit=u,file=fname,status='replace',form='formatted') + write(u,'(a)') rnd_str + close(u) + + str_out = IO_read(fname) + if (rnd_str//IO_EOL /= str_out) error stop 'IO_read' + strarray_out = IO_readlines(fname) + if (rnd_str /= strarray_out(1)) error stop 'IO_readlines' + end subroutine test_IO_run end module test_IO diff --git a/src/test/test_system_routines.f90 b/src/test/test_system_routines.f90 new file mode 100644 index 000000000..6c1996be4 --- /dev/null +++ b/src/test/test_system_routines.f90 @@ -0,0 +1,17 @@ +module test_system_routines + use system_routines + + implicit none(type,external) + + private + public :: test_system_routines_run + + contains + +subroutine test_system_routines_run() + + call system_routines_selfTest() + +end subroutine test_system_routines_run + +end module test_system_routines