diff --git a/src/.gitignore b/src/.gitignore index 4c12f54..c485d0b 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -1,6 +1,7 @@ templates_front/*.c templates_front/*.h templates_front/*.f90 +templates_front/*.fh_90 templates_front/*.dump templates_front/populated/ diff --git a/src/templates_front/build.sh b/src/templates_front/build.sh index f20f78a..25d2261 100644 --- a/src/templates_front/build.sh +++ b/src/templates_front/build.sh @@ -12,6 +12,9 @@ cat populated/pop_*.h >> trexio.h # fortran front end cat populated/pop_*.f90 >> trexio_f.f90 +# add helper functions +cat helper_fortran.f90 >> trexio_f.f90 +cat populated/pop_*.fh_90 >> trexio_f.f90 # suffixes cat suffix_s_front.h >> trexio_s.h diff --git a/src/templates_front/templator_front.org b/src/templates_front/templator_front.org index ec0ea98..b839252 100644 --- a/src/templates_front/templator_front.org +++ b/src/templates_front/templator_front.org @@ -1762,23 +1762,23 @@ trexio_has_$group_dset$ (trexio_t* const file) #+begin_src f90 :tangle write_dset_str_front_fortran.f90 interface - integer function trexio_write_$group_dset$ (trex_file, dset, max_str_len) bind(C, name="trexio_write_$group_dset$_low") + integer function trexio_write_$group_dset$_low (trex_file, dset, max_str_len) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file character, intent(in) :: dset(*) integer(4), intent(in), value :: max_str_len - end function trexio_write_$group_dset$ + end function trexio_write_$group_dset$_low end interface #+end_src #+begin_src f90 :tangle read_dset_str_front_fortran.f90 interface - integer function trexio_read_$group_dset$ (trex_file, dset, max_str_len) bind(C, name="trexio_read_$group_dset$_low") + integer function trexio_read_$group_dset$_low (trex_file, dset, max_str_len) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file character, intent(out) :: dset(*) integer(4), intent(in), value :: max_str_len - end function trexio_read_$group_dset$ + end function trexio_read_$group_dset$_low end interface #+end_src @@ -1791,6 +1791,59 @@ interface end interface #+end_src + #+begin_src f90 :tangle helper_read_dset_str_front_fortran.fh_90 + integer function trexio_read_$group_dset$ (trex_file, dset, max_str_len) + use, intrinsic :: iso_c_binding + implicit none + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: max_str_len + character(len=*), intent(inout) :: dset(*) + + character, allocatable :: str_compiled(:) + integer(8) :: $group_dset_dim$ + integer :: rc + + rc = trexio_read_$group_dset_dim$_64(trex_file, $group_dset_dim$) + if (rc /= TREXIO_SUCCESS) trexio_read_$group_dset$ = rc + + allocate(str_compiled($group_dset_dim$*(max_str_len+1)+1)) + + rc = trexio_read_$group_dset$_low(trex_file, str_compiled, max_str_len) + if (rc /= TREXIO_SUCCESS) then + deallocate(str_compiled) + trexio_read_$group_dset$ = rc + else + call trexio_str2strarray(str_compiled, $group_dset_dim$, max_str_len, dset) + deallocate(str_compiled) + trexio_read_$group_dset$ = TREXIO_SUCCESS + endif + + end function trexio_read_$group_dset$ + #+end_src + + #+begin_src f90 :tangle helper_write_dset_str_front_fortran.fh_90 + integer function trexio_write_$group_dset$ (trex_file, dset, max_str_len) + use, intrinsic :: iso_c_binding + implicit none + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: max_str_len + character(len=*), intent(in) :: dset(*) + + character(len=:), allocatable :: str_compiled + integer(8) :: $group_dset_dim$ + integer :: rc + + rc = trexio_read_$group_dset_dim$_64(trex_file, $group_dset_dim$) + if (rc /= TREXIO_SUCCESS) then + trexio_write_$group_dset$ = rc + else + call trexio_strarray2str(dset, $group_dset_dim$, max_str_len, str_compiled) + trexio_write_$group_dset$ = trexio_write_$group_dset$_low(trex_file, str_compiled, max_str_len) + endif + + end function trexio_write_$group_dset$ + #+end_src + ** Templates for front end has/read/write a single string attribute *** Introduction @@ -1945,7 +1998,7 @@ end interface unlike strings in Fortran. Note, that Fortran interface calls the main ~TREXIO~ API, which is written in C. - #+begin_src f90 :tangle suffix_fortran.f90 + #+begin_src f90 :tangle helper_fortran.f90 contains integer(8) function trexio_open (filename, mode, backend) use, intrinsic :: iso_c_binding @@ -1964,14 +2017,14 @@ contains as a delimeter and adds ~NULL~ character in the end in order to properly pass the desired string to C API. This is needed due to the fact that strings in C are terminated by ~NULL~ character ~\0~. - #+begin_src f90 :tangle suffix_fortran.f90 + #+begin_src f90 :tangle helper_fortran.f90 subroutine trexio_strarray2str(str_array, max_num_str, max_len_str, str_res) use, intrinsic :: iso_c_binding, only : c_null_char implicit none - integer, intent(in), value :: max_num_str ! number of elements in strign array + integer(8), intent(in), value :: max_num_str ! number of elements in strign array integer, intent(in), value :: max_len_str ! maximum length of a string in an array - character(len=max_len_str), intent(in) :: str_array(*) + character(len=*), intent(in) :: str_array(*) character(len=:), allocatable, intent(out) :: str_res integer :: i @@ -1984,11 +2037,51 @@ contains end subroutine trexio_strarray2str #+end_src + The subroutine below does the reverse tranformation from one big string with delimeters into an array of Fortran strings. + + #+begin_src f90 :tangle helper_fortran.f90 + subroutine trexio_str2strarray(str_flat, max_num_str, max_len_str, str_array) + use, intrinsic :: iso_c_binding, only : c_null_char + implicit none + + integer(8), intent(in), value :: max_num_str ! number of elements in strign array + integer, intent(in), value :: max_len_str ! maximum length of a string in an array + character, intent(in) :: str_flat(*) + character(len=*), intent(inout) :: str_array(*) + + character(len=max_len_str) :: tmp_str + integer :: i, j, k, ind, offset + integer(8) :: len_flat + + len_flat = (max_len_str+1)*max_num_str + 1 + + ind=1 + offset=1 + do i=1,max_num_str + k = 1 + tmp_str='' + do j=ind,len_flat + if ( str_flat(j)==TREXIO_DELIM ) then + ind=j+1 + exit + endif + tmp_str(k:k) = str_flat(j) + k = k + 1 + enddo + str_array(i)=tmp_str + !write(*,*) str_array(i) + offset=ind + enddo + + end subroutine trexio_str2strarray + #+end_src + + The subroutine is a Fortran analogue of ~assert~ in C. It check that the the return code of the TREXIO API call is equal to a given return code. It can optionally print a success message if the two code are identical, i.e. if the ~assert~ statement pass. - #+begin_src f90 :tangle suffix_fortran.f90 + #+begin_src f90 :tangle helper_fortran.f90 subroutine trexio_assert(trexio_rc, check_rc, success_message) implicit none diff --git a/tests/test.c b/tests/test.c index 9f9c0f0..badebae 100644 --- a/tests/test.c +++ b/tests/test.c @@ -16,14 +16,14 @@ int main() { assert (rc == 0); test_write("test_write.h5", TREXIO_HDF5); test_read ("test_write.h5", TREXIO_HDF5); -// rc = system("rm -rf test_write.h5"); + rc = system("rm -rf test_write.h5"); assert (rc == 0); rc = system("rm -rf test_write.dir"); assert (rc == 0); test_write("test_write.dir", TREXIO_TEXT); test_read ("test_write.dir", TREXIO_TEXT); -// rc = system("rm -rf test_write.dir"); + rc = system("rm -rf test_write.dir"); assert (rc == 0); return 0; diff --git a/tests/test_f.f90 b/tests/test_f.f90 index eae672f..a8622f5 100644 --- a/tests/test_f.f90 +++ b/tests/test_f.f90 @@ -38,9 +38,8 @@ subroutine test_write(file_name, back_end) double precision :: charge(12) double precision :: coord(3,12) - character(len=:), allocatable :: label_str character(len=:), allocatable :: sym_str - character(len=4):: label(12) + character(len=:), allocatable :: label(:) ! parameters to be written num = 12 @@ -61,8 +60,6 @@ subroutine test_write(file_name, back_end) label = [character(len=8) :: 'C', 'Na','C', 'C 66', 'C','C', 'H 99', 'Ru', 'H', 'H', 'H', 'H' ] - call trexio_strarray2str(label, num, 4, label_str) - sym_str = 'B3U with some comments' // c_null_char ! ================= START OF TEST ===================== ! @@ -84,8 +81,7 @@ subroutine test_write(file_name, back_end) rc = trexio_write_nucleus_coord(trex_file, coord) call trexio_assert(rc, TREXIO_SUCCESS, 'SUCCESS WRITE COORD') - rc = trexio_write_nucleus_label(trex_file, label_str, 5) - deallocate(label_str) + rc = trexio_write_nucleus_label(trex_file, label, 5) call trexio_assert(rc, TREXIO_SUCCESS, 'SUCCESS WRITE LABEL') rc = trexio_write_nucleus_point_group(trex_file, sym_str, 32) @@ -127,7 +123,7 @@ subroutine test_read(file_name, back_end) character :: label_str(128) character(len=4) :: tmp_str - character(len=4) :: label(12) + character(len=4) :: label(12) ! also works with allocatable arrays character(len=32) :: sym_str @@ -170,30 +166,8 @@ subroutine test_read(file_name, back_end) endif - rc = trexio_read_nucleus_label(trex_file, label_str, 2) + rc = trexio_read_nucleus_label(trex_file, label, 2) call trexio_assert(rc, TREXIO_SUCCESS) - ! -------------------------------------------------- - ! dummy parser of big string with TREXIO_DELIM delimeters - ! -------------------------------------------------- - ind=1 - offset=1 - do i=1,num - k = 1 - tmp_str='' - do j=ind,128 - - if ( (label_str(j)==TREXIO_DELIM) ) then - ind=j+1 - exit - endif - tmp_str(k:k) = label_str(j) - k = k + 1 - enddo - label(i)=tmp_str - write(*,*) label(i) - offset=ind - enddo - ! -------------------------------------------------- if (trim(label(2)) == 'Na') then write(*,*) 'SUCCESS READ LABEL' else diff --git a/tools/generator_tools.py b/tools/generator_tools.py index 633f012..ee2950e 100644 --- a/tools/generator_tools.py +++ b/tools/generator_tools.py @@ -119,7 +119,7 @@ def recursive_populate_file(fname: str, paths: dict, detailed_source: dict) -> N if not dim.isdigit() and not dim in num_written: num_written.append(dim) templine = line.replace('$group_dset_dim$', dim) - if '_read' in templine: + if '_read' in templine and (not 'fortran' in fname): line_toadd = indentlevel*" " + rc_line templine += line_toadd