add top-level read/write functions for string arrays [fortran]

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/
 

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

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
 

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;

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)
+  rc = trexio_write_nucleus_label(trex_file, label, 5)
-  deallocate(label_str)
   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

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