From 665e2d5b381db2e35aba3b21f8afe1f7eb2479ad Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Nov 2023 15:03:46 +0100 Subject: [PATCH 01/11] test IO_read and IO_readlines --- src/test/test_IO.f90 | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/src/test/test_IO.f90 b/src/test/test_IO.f90 index cae7f76c4..a5a0ac545 100644 --- a/src/test/test_IO.f90 +++ b/src/test/test_IO.f90 @@ -1,4 +1,5 @@ module test_IO + use prec use IO implicit none(type,external) @@ -10,8 +11,29 @@ 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 + integer :: u,i + + call IO_selfTest() + call random_number(rnd_real) + + do i = 1, size(rnd_real) + rnd_str(i:i) = char(32 + int(rnd_real(i)*(127.-32.))) + end do + open(newunit=u,file='results.out',status='replace',form='formatted') + write(u,'(a)') rnd_str + close(u) + + str_out = IO_read('results.out') + if (rnd_str//IO_EOL /= str_out) error stop 'IO_read' + strarray_out = IO_readlines('results.out') + if (rnd_str /= strarray_out(1)) error stop 'IO_readlines' + end subroutine test_IO_run end module test_IO From febbddd36ab78168931af41d352a163093e4af8e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Nov 2023 15:59:00 +0100 Subject: [PATCH 02/11] starting to test system_routines --- src/materialpoint.f90 | 4 ++- src/system_routines.f90 | 42 +++++++++++++++++++++++++++++++ src/test/DAMASK_test.f90 | 7 +++++- src/test/test_system_routines.f90 | 17 +++++++++++++ 4 files changed, 68 insertions(+), 2 deletions(-) create mode 100644 src/test/test_system_routines.f90 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/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_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 From 57ee7e86e462c5221aadd7595156e45b5158ba83 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Nov 2023 07:35:17 +0100 Subject: [PATCH 03/11] better name --- src/IO.f90 | 4 ++++ src/test/test_IO.f90 | 6 +++--- 2 files changed, 7 insertions(+), 3 deletions(-) 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/test/test_IO.f90 b/src/test/test_IO.f90 index a5a0ac545..c1a750bc0 100644 --- a/src/test/test_IO.f90 +++ b/src/test/test_IO.f90 @@ -25,13 +25,13 @@ subroutine test_IO_run() do i = 1, size(rnd_real) rnd_str(i:i) = char(32 + int(rnd_real(i)*(127.-32.))) end do - open(newunit=u,file='results.out',status='replace',form='formatted') + open(newunit=u,file='test.txt',status='replace',form='formatted') write(u,'(a)') rnd_str close(u) - str_out = IO_read('results.out') + str_out = IO_read('test.txt') if (rnd_str//IO_EOL /= str_out) error stop 'IO_read' - strarray_out = IO_readlines('results.out') + strarray_out = IO_readlines('test.txt') if (rnd_str /= strarray_out(1)) error stop 'IO_readlines' end subroutine test_IO_run From d1432e5bd8fedc8e23494bf02ab84bd9bf91ec29 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Nov 2023 08:15:40 +0100 Subject: [PATCH 04/11] allow MPI parallel execution --- src/test/test_IO.f90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/test/test_IO.f90 b/src/test/test_IO.f90 index c1a750bc0..0ec2495a0 100644 --- a/src/test/test_IO.f90 +++ b/src/test/test_IO.f90 @@ -1,5 +1,6 @@ module test_IO use prec + use parallelization use IO implicit none(type,external) @@ -14,24 +15,25 @@ 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 + 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='test.txt',status='replace',form='formatted') + open(newunit=u,file=fname,status='replace',form='formatted') write(u,'(a)') rnd_str close(u) - str_out = IO_read('test.txt') + str_out = IO_read(fname) if (rnd_str//IO_EOL /= str_out) error stop 'IO_read' - strarray_out = IO_readlines('test.txt') + strarray_out = IO_readlines(fname) if (rnd_str /= strarray_out(1)) error stop 'IO_readlines' end subroutine test_IO_run From 3c62af3fe5120729d1f65dd2e2f26e4f3c009ee7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Nov 2023 08:16:24 +0100 Subject: [PATCH 05/11] test 2D arrays and read-only file opening --- src/test/test_HDF5_utilities.f90 | 30 +++++++++++++++++++++++++----- 1 file changed, 25 insertions(+), 5 deletions(-) diff --git a/src/test/test_HDF5_utilities.f90 b/src/test/test_HDF5_utilities.f90 index fb43de8e2..b4d6f39a3 100644 --- a/src/test/test_HDF5_utilities.f90 +++ b/src/test/test_HDF5_utilities.f90 @@ -20,17 +20,37 @@ 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) :: d1_in,d1_out + real(pREAL), dimension(3,3) :: d2_in,d2_out - call random_number(d_in) + call random_number(d1_in) + call random_number(d2_in) f = HDF5_openFile('test.hdf5','w') - call HDF5_write(d_in,f,'test') - call HDF5_read(d_out,f,'test') + call HDF5_write(d1_in,f,'d1') + call HDF5_write(d2_in,f,'d2') + + call HDF5_read(d1_out,f,'d1') + call HDF5_read(d2_out,f,'d2') + + if (any(d1_in /= d1_out)) error stop 'test_read_write(w)/d1' + if (any(d2_in /= d2_out)) error stop 'test_read_write(w)/d2' + + call HDF5_closeFile(f) + + + f = HDF5_openFile('test.hdf5','r') + + call HDF5_read(d1_out,f,'d1') + call HDF5_read(d2_out,f,'d2') + + if (any(d1_in /= d1_out)) error stop 'test_read_write(r)/d1' + if (any(d2_in /= d2_out)) error stop 'test_read_write(r)/d2' + + call HDF5_closeFile(f) - if (any(d_in /= d_out)) error stop 'test_read_write' end subroutine read_write From 1cf1f9df31d481fcae2c20ee51d416f555d2ca92 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Nov 2023 12:38:35 +0100 Subject: [PATCH 06/11] test more dimensions --- src/test/test_HDF5_utilities.f90 | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/src/test/test_HDF5_utilities.f90 b/src/test/test_HDF5_utilities.f90 index b4d6f39a3..fdab19fbc 100644 --- a/src/test/test_HDF5_utilities.f90 +++ b/src/test/test_HDF5_utilities.f90 @@ -22,21 +22,36 @@ subroutine read_write() integer(HID_T) :: f real(pREAL), dimension(3) :: d1_in,d1_out real(pREAL), dimension(3,3) :: d2_in,d2_out + real(pREAL), dimension(3,3,3) :: d3_in,d3_out + real(pREAL), dimension(3,3,3,3) :: d4_in,d4_out + real(pREAL), dimension(3,3,3,3,3) :: d5_in,d5_out call random_number(d1_in) call random_number(d2_in) + call random_number(d3_in) + call random_number(d4_in) + call random_number(d5_in) f = HDF5_openFile('test.hdf5','w') call HDF5_write(d1_in,f,'d1') call HDF5_write(d2_in,f,'d2') + call HDF5_write(d3_in,f,'d3') + call HDF5_write(d4_in,f,'d4') + call HDF5_write(d5_in,f,'d5') call HDF5_read(d1_out,f,'d1') call HDF5_read(d2_out,f,'d2') + call HDF5_read(d3_out,f,'d3') + call HDF5_read(d4_out,f,'d4') + call HDF5_read(d5_out,f,'d5') if (any(d1_in /= d1_out)) error stop 'test_read_write(w)/d1' if (any(d2_in /= d2_out)) error stop 'test_read_write(w)/d2' + if (any(d3_in /= d3_out)) error stop 'test_read_write(w)/d3' + if (any(d4_in /= d4_out)) error stop 'test_read_write(w)/d4' + if (any(d5_in /= d5_out)) error stop 'test_read_write(w)/d5' call HDF5_closeFile(f) @@ -45,9 +60,15 @@ subroutine read_write() call HDF5_read(d1_out,f,'d1') call HDF5_read(d2_out,f,'d2') + call HDF5_read(d3_out,f,'d3') + call HDF5_read(d4_out,f,'d4') + call HDF5_read(d5_out,f,'d5') if (any(d1_in /= d1_out)) error stop 'test_read_write(r)/d1' if (any(d2_in /= d2_out)) error stop 'test_read_write(r)/d2' + if (any(d3_in /= d3_out)) error stop 'test_read_write(r)/d3' + if (any(d4_in /= d4_out)) error stop 'test_read_write(r)/d4' + if (any(d5_in /= d5_out)) error stop 'test_read_write(r)/d5' call HDF5_closeFile(f) From 8bc5b30e546ff6522a6c08cacfb6fe5594539fe4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Nov 2023 12:49:34 +0100 Subject: [PATCH 07/11] dim 6 and 7 are not used trivial do add if needed --- src/HDF5_utilities.f90 | 318 +---------------------------------------- 1 file changed, 7 insertions(+), 311 deletions(-) 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. !-------------------------------------------------------------------------------------------------- From 246e708e5bc9ef040beeb65062d51b1ae96f4a94 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Nov 2023 13:05:39 +0100 Subject: [PATCH 08/11] systematic testing of read/write --- src/test/test_HDF5_utilities.f90 | 122 ++++++++++++++++++++++--------- 1 file changed, 86 insertions(+), 36 deletions(-) diff --git a/src/test/test_HDF5_utilities.f90 b/src/test/test_HDF5_utilities.f90 index fdab19fbc..905c9ebda 100644 --- a/src/test/test_HDF5_utilities.f90 +++ b/src/test/test_HDF5_utilities.f90 @@ -20,55 +20,105 @@ end subroutine test_HDF5_utilities_run subroutine read_write() integer(HID_T) :: f - real(pREAL), dimension(3) :: d1_in,d1_out - real(pREAL), dimension(3,3) :: d2_in,d2_out - real(pREAL), dimension(3,3,3) :: d3_in,d3_out - real(pREAL), dimension(3,3,3,3) :: d4_in,d4_out - real(pREAL), dimension(3,3,3,3,3) :: d5_in,d5_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(d1_in) - call random_number(d2_in) - call random_number(d3_in) - call random_number(d4_in) - call random_number(d5_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(d1_in,f,'d1') - call HDF5_write(d2_in,f,'d2') - call HDF5_write(d3_in,f,'d3') - call HDF5_write(d4_in,f,'d4') - call HDF5_write(d5_in,f,'d5') - call HDF5_read(d1_out,f,'d1') - call HDF5_read(d2_out,f,'d2') - call HDF5_read(d3_out,f,'d3') - call HDF5_read(d4_out,f,'d4') - call HDF5_read(d5_out,f,'d5') + 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' - if (any(d1_in /= d1_out)) error stop 'test_read_write(w)/d1' - if (any(d2_in /= d2_out)) error stop 'test_read_write(w)/d2' - if (any(d3_in /= d3_out)) error stop 'test_read_write(w)/d3' - if (any(d4_in /= d4_out)) error stop 'test_read_write(w)/d4' - if (any(d5_in /= d5_out)) error stop 'test_read_write(w)/d5' call HDF5_closeFile(f) - f = HDF5_openFile('test.hdf5','r') - call HDF5_read(d1_out,f,'d1') - call HDF5_read(d2_out,f,'d2') - call HDF5_read(d3_out,f,'d3') - call HDF5_read(d4_out,f,'d4') - call HDF5_read(d5_out,f,'d5') - if (any(d1_in /= d1_out)) error stop 'test_read_write(r)/d1' - if (any(d2_in /= d2_out)) error stop 'test_read_write(r)/d2' - if (any(d3_in /= d3_out)) error stop 'test_read_write(r)/d3' - if (any(d4_in /= d4_out)) error stop 'test_read_write(r)/d4' - if (any(d5_in /= d5_out)) error stop 'test_read_write(r)/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(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) From a38ec385c7879bb98c4970a4634d050aebc2e8f5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Nov 2023 19:03:17 +0100 Subject: [PATCH 09/11] test simple tensor operations --- src/math.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/math.f90 b/src/math.f90 index 8d4d3ff9c..c6a358407 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)))) & + error stop 'math_symmetric/skew' + + if (any(dNeq(t33,math_spherical33(t33)+math_deviatoric33(t33)))) & + error stop 'math_spherical/deviatoric' + do while(abs(math_det33(t33))<1.0e-9_pREAL) call random_number(t33) end do From 2018b623ceaad1cd074c78972e73e8a4a510ec2f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Nov 2023 19:09:34 +0100 Subject: [PATCH 10/11] wrong capitalization --- DAMASK_prerequisites.sh | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) 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__))" From 1fb5e159adf3139aa6b5f43769fe11e29393dbbd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 27 Nov 2023 06:39:59 +0100 Subject: [PATCH 11/11] larger tolerance (test failed on Intel) --- src/math.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index c6a358407..863661c2c 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -1380,10 +1380,10 @@ 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)))) & + 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)))) & + 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)