mirror of
https://github.com/TREX-CoE/trexio.git
synced 2024-08-25 06:31:43 +02:00
add top-level read/write functions for string arrays [fortran]
This commit is contained in:
parent
eadc2c63ac
commit
b92a15cce7
1
src/.gitignore
vendored
1
src/.gitignore
vendored
@ -1,6 +1,7 @@
|
||||
templates_front/*.c
|
||||
templates_front/*.h
|
||||
templates_front/*.f90
|
||||
templates_front/*.fh_90
|
||||
templates_front/*.dump
|
||||
templates_front/populated/
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user