TREX/trexio
1
0
Fork 0
mirror of https://github.com/TREX-CoE/trexio.git synced 2025-01-03 10:06:01 +01:00
Code Issues Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
q-posev 2021-06-15 10:20:01 +02:00
parent eadc2c63ac
commit b92a15cce7
6 changed files with 113 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/.gitignore vendored
View File

@ -1,6 +1,7 @@
templates_front/*.c
templates_front/*.h
templates_front/*.f90
templates_front/*.fh_90
templates_front/*.dump
templates_front/populated/

3
src/templates_front/build.sh
View File

@ -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

111
src/templates_front/templator_front.org
View File

@ -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

4
tests/test.c
View File

@ -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;

34
tests/test_f.f90
View File

@ -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

2
tools/generator_tools.py
View File

@ -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