add Fortran interface for sparse data

src/templates_front/templator_front.org

@@ -2396,10 +2396,8 @@ def has_$group_dset$(trexio_file) -> bool:
 
      #+begin_src c :tangle hrw_dset_sparse_front.h :exports none
 trexio_exit_code trexio_has_$group_sparse_dset$(trexio_t* const file);
-trexio_exit_code trexio_read_$group_sparse_dset$(trexio_t* const file, const int64_t offset_file, const int64_t size, int32_t* const index_sparse, double* const value_sparse);
+trexio_exit_code trexio_read_$group_sparse_dset$(trexio_t* const file, const int64_t offset_file, const int64_t buffer_size, int32_t* const index_sparse, double* const value_sparse);
-trexio_exit_code trexio_write_$group_sparse_dset$(trexio_t* const file, const int64_t offset_file, const int64_t size, const int32_t* index_sparse, const double* value_sparse);
+trexio_exit_code trexio_write_$group_sparse_dset$(trexio_t* const file, const int64_t offset_file, const int64_t buffer_size, const int32_t* index_sparse, const double* value_sparse);
-//trexio_exit_code trexio_read_$group_sparse_dset$_value(trexio_t* const file, const uint64_t offset, const uint_64_t size, int32_t* const value_sparse);
-//trexio_exit_code trexio_write_$group_sparse_dset$_value(trexio_t* const file, const uint64_t offset, const uint_64_t size, double* const value_sparse);
      #+end_src
 
 **** Source code for default functions
@@ -2408,14 +2406,14 @@ trexio_exit_code trexio_write_$group_sparse_dset$(trexio_t* const file, const in
 trexio_exit_code
 trexio_read_$group_sparse_dset$(trexio_t* const file,
                            const int64_t offset_file,
-                           const int64_t size,
+                           const int64_t buffer_size,
                            int32_t* const index_sparse,
                            double* const value_sparse
                            )
 {
   if (file  == NULL) return TREXIO_INVALID_ARG_1;
   if (offset_file < 0L) return TREXIO_INVALID_ARG_2;
-  if (size        <= 0L) return TREXIO_INVALID_ARG_3;
+  if (buffer_size <= 0L) return TREXIO_INVALID_ARG_3;
   if (index_sparse == NULL) return TREXIO_INVALID_ARG_4;
   if (value_sparse == NULL) return TREXIO_INVALID_ARG_5;
 
@@ -2425,7 +2423,7 @@ trexio_read_$group_sparse_dset$(trexio_t* const file,
   trexio_exit_code rc;
 
   // temporary
-  size_max = size;
+  size_max = buffer_size;
   /* TODO
   rc = trexio_read_$group_sparse_dset$_num(file, &size_max);
   if (rc != TREXIO_SUCCESS) return rc;
@@ -2434,12 +2432,12 @@ trexio_read_$group_sparse_dset$(trexio_t* const file,
   switch (file->back_end) {
 
   case TREXIO_TEXT:
-    return trexio_text_read_$group_sparse_dset$(file, offset_file, size, size_max, index_sparse, value_sparse);
+    return trexio_text_read_$group_sparse_dset$(file, offset_file, buffer_size, size_max, index_sparse, value_sparse);
     break;
 
   case TREXIO_HDF5:
 #ifdef HAVE_HDF5
-    return trexio_hdf5_read_$group_sparse_dset$(file, offset_file, size, size_max, index_sparse, value_sparse);
+    return trexio_hdf5_read_$group_sparse_dset$(file, offset_file, buffer_size, size_max, index_sparse, value_sparse);
     break;
 #else
     return TREXIO_BACK_END_MISSING;
@@ -2459,14 +2457,14 @@ trexio_read_$group_sparse_dset$(trexio_t* const file,
 trexio_exit_code
 trexio_write_$group_sparse_dset$(trexio_t* const file,
                            const int64_t offset_file,
-                           const int64_t size,
+                           const int64_t buffer_size,
                            const int32_t* index_sparse,
                            const double* value_sparse
                            )
 {
   if (file  == NULL) return TREXIO_INVALID_ARG_1;
   if (offset_file < 0L) return TREXIO_INVALID_ARG_2;
-  if (size        <= 0L) return TREXIO_INVALID_ARG_3;
+  if (buffer_size <= 0L) return TREXIO_INVALID_ARG_3;
   if (index_sparse == NULL) return TREXIO_INVALID_ARG_4;
   if (value_sparse == NULL) return TREXIO_INVALID_ARG_5;
 
@@ -2476,7 +2474,7 @@ trexio_write_$group_sparse_dset$(trexio_t* const file,
   trexio_exit_code rc;
 
   // temporary
-  size_max = size;
+  size_max = buffer_size;
   /* TODO
   rc = trexio_read_$group_sparse_dset$_num(file, &size_max);
   if (rc != TREXIO_SUCCESS) return rc;
@@ -2485,12 +2483,12 @@ trexio_write_$group_sparse_dset$(trexio_t* const file,
   switch (file->back_end) {
 
   case TREXIO_TEXT:
-    return trexio_text_write_$group_sparse_dset$(file, offset_file, size, size_max, index_sparse, value_sparse);
+    return trexio_text_write_$group_sparse_dset$(file, offset_file, buffer_size, size_max, index_sparse, value_sparse);
     break;
 
   case TREXIO_HDF5:
 #ifdef HAVE_HDF5
-    return trexio_hdf5_write_$group_sparse_dset$(file, offset_file, size, size_max, index_sparse, value_sparse);
+    return trexio_hdf5_write_$group_sparse_dset$(file, offset_file, buffer_size, size_max, index_sparse, value_sparse);
     break;
 #else
     return TREXIO_BACK_END_MISSING;
@@ -2540,6 +2538,50 @@ trexio_has_$group_sparse_dset$ (trexio_t* const file)
 }
      #+end_src
 
+*** Fortran templates for front end
+
+    The ~Fortran~ templates that provide an access to the ~C~ API calls from ~Fortran~.
+    These templates are based on the use of ~iso_c_binding~. Pointers have to be passed by value.
+
+     #+begin_src f90 :tangle write_dset_sparse_front_fortran.f90
+interface
+   integer function trexio_write_$group_sparse_dset$ (trex_file, &
+                                                      offset_file, buffer_size, &
+                                                      index_sparse, value_sparse) bind(C)
+     use, intrinsic :: iso_c_binding
+     integer(8), intent(in), value :: trex_file
+     integer(8), intent(in), value :: offset_file
+     integer(8), intent(in), value :: buffer_size
+     integer(4), intent(in)        :: index_sparse(*)
+     double precision, intent(in)  :: value_sparse(*)
+   end function trexio_write_$group_sparse_dset$
+end interface
+     #+end_src
+
+     #+begin_src f90 :tangle read_dset_sparse_front_fortran.f90
+interface
+   integer function trexio_read_$group_sparse_dset$ (trex_file, &
+                                                     offset_file, buffer_size, &
+                                                     index_sparse, value_sparse) bind(C)
+     use, intrinsic :: iso_c_binding
+     integer(8), intent(in), value :: trex_file
+     integer(8), intent(in), value :: offset_file
+     integer(8), intent(in), value :: buffer_size
+     integer(4), intent(in)        :: index_sparse(*)
+     double precision, intent(out) :: value_sparse(*)
+   end function trexio_read_$group_sparse_dset$
+end interface
+     #+end_src
+
+     #+begin_src f90 :tangle has_dset_sparse_front_fortran.f90
+interface
+   integer function trexio_has_$group_sparse_dset$ (trex_file) bind(C)
+     use, intrinsic :: iso_c_binding
+     integer(8), intent(in), value :: trex_file
+   end function trexio_has_$group_sparse_dset$
+end interface
+     #+end_src
+
 ** Templates for front end has/read/write a dataset of strings
 *** Introduction
    This section concerns API calls related to datasets of strings.

tests/test_f.f90

@@ -61,6 +61,22 @@ subroutine test_write(file_name, back_end)
   character(len=:), allocatable :: sym_str
   character(len=:), allocatable :: label(:)
 
+  ! sparse data
+  integer(4) :: index_sparse_mo_2e_int_eri(400)
+  double precision :: value_sparse_mo_2e_int_eri(100)
+
+  integer :: i, n_buffers = 5
+  integer(8) :: buf_size, offset = 0
+  buf_size = 100/n_buffers
+
+  do i = 1, 100
+    index_sparse_mo_2e_int_eri(4*i-3)   = 4*i   - 3
+    index_sparse_mo_2e_int_eri(4*i+1-3) = 4*i+1 - 3
+    index_sparse_mo_2e_int_eri(4*i+2-3) = 4*i+2 - 3
+    index_sparse_mo_2e_int_eri(4*i+3-3) = 4*i+3 - 3
+    value_sparse_mo_2e_int_eri(i) = 3.14 + float(i)
+  enddo
+
   ! parameters to be written
   num = 12
   charge = (/ 6., 6., 6., 6., 6., 6., 1., 1., 1., 1., 1., 1.  /)
@@ -96,6 +112,9 @@ subroutine test_write(file_name, back_end)
   rc = trexio_has_nucleus_charge(trex_file)
   call trexio_assert(rc, TREXIO_HAS_NOT, 'SUCCESS HAS NOT 2')
 
+  rc = trexio_has_mo_2e_int_eri(trex_file)
+  call trexio_assert(rc, TREXIO_HAS_NOT, 'SUCCESS HAS NOT 3')
+
   rc = trexio_write_nucleus_num(trex_file, num)
   call trexio_assert(rc, TREXIO_SUCCESS, 'SUCCESS WRITE NUM')
 
@@ -119,6 +138,13 @@ subroutine test_write(file_name, back_end)
   rc = trexio_write_basis_nucleus_index(trex_file, basis_nucleus_index)
   call trexio_assert(rc, TREXIO_SUCCESS, 'SUCCESS WRITE INDEX')
 
+  do i = 1, n_buffers
+    rc = trexio_write_mo_2e_int_eri(trex_file, offset, buf_size, &
+	                            index_sparse_mo_2e_int_eri(4*offset+1), &
+				    value_sparse_mo_2e_int_eri(offset+1))
+    call trexio_assert(rc, TREXIO_SUCCESS, 'SUCCESS WRITE SPARSE')
+    offset = offset + buf_size
+  enddo
 
   rc = trexio_has_nucleus_num(trex_file)
   call trexio_assert(rc, TREXIO_SUCCESS, 'SUCCESS HAS 1')
@@ -160,11 +186,20 @@ subroutine test_read(file_name, back_end)
 
   character(len=32) :: sym_str
 
+  ! sparse data
+  integer(4) :: index_sparse_mo_2e_int_eri(80)
+  double precision :: value_sparse_mo_2e_int_eri(20)
+  integer(8) :: read_buf_size = 10
+  integer(8) :: offset_read = 40
+
   character*(128) :: str
 
   num = 12
   basis_shell_num = 24
 
+  index_sparse_mo_2e_int_eri = 0
+  value_sparse_mo_2e_int_eri = 0.0d0
+
 ! ================= START OF TEST ===================== !
 
   trex_file = trexio_open(file_name, 'r', back_end, rc)
@@ -230,6 +265,17 @@ subroutine test_read(file_name, back_end)
   endif
 
 
+  rc = trexio_read_mo_2e_int_eri(trex_file, offset_read, read_buf_size, &
+	                         index_sparse_mo_2e_int_eri(4*5+1), &
+			         value_sparse_mo_2e_int_eri(5+1))
+  call trexio_assert(rc, TREXIO_SUCCESS)
+  if (index_sparse_mo_2e_int_eri(1) == 0 .and. index_sparse_mo_2e_int_eri(5*4+1) == offset_read*4+1) then
+    write(*,*) 'SUCCESS READ SPARSE DATA'
+  else
+    print *, 'FAILURE SPARSE DATA CHECK'
+    call exit(-1)
+  endif
+
   rc = trexio_close(trex_file)
   call trexio_assert(rc, TREXIO_SUCCESS)
 
@@ -262,4 +308,3 @@ subroutine test_read_void(file_name, back_end)
 ! ================= END OF TEST ===================== !
 
 end subroutine test_read_void
-