From cf3b4fe44979658a4294d0a38e1b49e67a7b9da2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 25 Jun 2021 00:03:06 +0200 Subject: [PATCH] Curved for Cyrus --- devel/qmcchem/qmc_e_curve.irp.f | 43 +- devel/qmcchem/qmc_e_curve2.irp.f | 63 +++ devel/trexio/EZFIO.cfg | 2 +- devel/trexio/export_trexio.irp.f | 23 +- devel/trexio/trexio_f.f90 | 880 ++++++++++++++++++++++++++++--- 5 files changed, 909 insertions(+), 102 deletions(-) create mode 100644 devel/qmcchem/qmc_e_curve2.irp.f diff --git a/devel/qmcchem/qmc_e_curve.irp.f b/devel/qmcchem/qmc_e_curve.irp.f index c0a3b7d..e6135b0 100644 --- a/devel/qmcchem/qmc_e_curve.irp.f +++ b/devel/qmcchem/qmc_e_curve.irp.f @@ -6,16 +6,13 @@ program e_curve integer, allocatable :: iorder(:) double precision , allocatable :: norm_sort(:) double precision :: e_0(N_states) - PROVIDE mo_two_e_integrals_in_map + PROVIDE mo_two_e_integrals_in_map mo_one_e_integrals nab = n_det_alpha_unique+n_det_beta_unique allocate ( norm_sort(0:nab), iorder(0:nab) ) double precision, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:) double precision, allocatable :: u_0(:,:), v_0(:,:) - allocate(u_t(N_states,N_det),v_t(N_states,N_det),s_t(N_states,N_det)) - allocate(u_0(N_states,N_det),v_0(N_states,N_det)) - norm_sort(0) = 0.d0 @@ -24,19 +21,20 @@ program e_curve norm_sort(i) = det_alpha_norm(i) iorder(i) = i enddo - + do i=1,n_det_beta_unique norm_sort(i+n_det_alpha_unique) = det_beta_norm(i) iorder(i+n_det_alpha_unique) = -i enddo - + call dsort(norm_sort(1),iorder(1),nab) if (.not.read_wf) then stop 'Please set read_wf to true' endif - PROVIDE psi_bilinear_matrix_values nuclear_repulsion + PROVIDE psi_bilinear_matrix_values nuclear_repulsion + print *, '' print *, '==============================' print *, 'Energies at different cut-offs' @@ -67,27 +65,11 @@ program e_curve cycle endif - u_0 = psi_bilinear_matrix_values(1:N_det,1:N_states) - v_t = 0.d0 - s_t = 0.d0 - call dtranspose( & - u_0, & - size(u_0, 1), & - u_t, & - size(u_t, 1), & - N_det, N_states) - call H_S2_u_0_nstates_openmp_work(v_t,s_t,u_t,N_states,N_det,1,N_det,0,1) - call dtranspose( & - v_t, & - size(v_t, 1), & - v_0, & - size(v_0, 1), & - N_states, N_det) - - double precision, external :: u_dot_u, u_dot_v - do i=1,N_states - e_0(i) = u_dot_v(v_t(1,i),u_0(1,i),N_det)/u_dot_u(u_0(1,i),N_det) + do k=1,N_states + psi_coef(1:N_det,k) = psi_bilinear_matrix_values(1:N_det,k) + call dset_order(psi_coef(1,k),psi_bilinear_matrix_order_reverse,N_det) enddo + TOUCH psi_det psi_coef m = 0 do k=1,n_det @@ -100,10 +82,11 @@ program e_curve exit endif E = E_0(1) + nuclear_repulsion - norm = u_dot_u(u_0(1,1),N_det) - print '(E9.1,2X,I8,2X,F10.2,2X,F10.8,2X,F12.6)', thresh, m, & + double precision :: u_dot_u + norm = dsqrt(u_dot_u(psi_coef(1,1),N_det)) + print '(E9.1,2X,I8,2X,F10.2,2X,F10.8,2X,F15.10)', thresh, m, & dble( elec_alpha_num**3 + elec_alpha_num**2 * (nab-1) ) / & - dble( elec_alpha_num**3 + elec_alpha_num**2 * (j-1)), norm, E + dble( elec_alpha_num**3 + elec_alpha_num**2 * (j-1)), norm, psi_energy(1) thresh = thresh * dsqrt(10.d0) enddo print *, '==========================================================' diff --git a/devel/qmcchem/qmc_e_curve2.irp.f b/devel/qmcchem/qmc_e_curve2.irp.f new file mode 100644 index 0000000..6386bfb --- /dev/null +++ b/devel/qmcchem/qmc_e_curve2.irp.f @@ -0,0 +1,63 @@ +program e_curve + use bitmasks + implicit none + integer :: i,j,k, kk, nab, m, l + double precision :: norm, E, hij, num, ci, cj + double precision :: e_0(N_states) + PROVIDE mo_two_e_integrals_in_map mo_one_e_integrals + + if (.not.read_wf) then + stop 'Please set read_wf to true' + endif + + PROVIDE psi_bilinear_matrix nuclear_repulsion + PROVIDE psi_coef_sorted psi_det psi_coef + print *, '' + print *, '==============================' + print *, 'Energies at different cut-offs' + print *, '==============================' + print *, '' + print *, '==========================================================' + print '(A8,2X,A8,2X,A12,2X,A10,2X,A12)', 'Thresh.', 'Ndet', 'Cost', 'Norm', 'E' + print *, '==========================================================' + double precision :: thresh + integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:) + thresh = 1.d-10 + + nab = n_det_alpha_unique+n_det_beta_unique + + + do while (thresh < 1.d0) + norm = 0.d0 + do k=1,n_det + if (dabs(psi_coef(k,1)) < thresh) then + psi_coef(k,1) = 0.d0 + endif + norm = norm + psi_coef(k,1)**2 + enddo + TOUCH psi_coef + norm = norm/dsqrt(norm) + + psi_coef(1:N_det,1) = psi_coef_sorted(1:N_det,1) + psi_det(1:N_int,1:2,1:N_det) = psi_det_sorted(1:N_int,1:2,1:N_det) + do k=1,n_det + if (psi_coef(k,1) == 0.d0) then + exit + endif + enddo + n_det = k-1 + TOUCH n_det psi_coef psi_det + + j = n_det_alpha_unique+n_det_beta_unique + call u_0_H_u_0(E,psi_coef,n_det,psi_det,N_int,1,size(psi_coef,1)) + + print '(E9.1,2X,I8,2X,F10.2,2X,F10.8,2X,F15.10)', thresh, n_det, & + dble( elec_alpha_num**3 + elec_alpha_num**2 * (nab-1) ) / & + dble( elec_alpha_num**3 + elec_alpha_num**2 * (nab-j)), norm, & + psi_energy(1) + thresh = thresh * dsqrt(10.d0) + enddo + print *, '==========================================================' + +end + diff --git a/devel/trexio/EZFIO.cfg b/devel/trexio/EZFIO.cfg index 3b09bc1..9da5e95 100644 --- a/devel/trexio/EZFIO.cfg +++ b/devel/trexio/EZFIO.cfg @@ -1,4 +1,4 @@ -[trexio_backend] +[backend] type: integer doc: Back-end used in TREXIO. 0: HDF5, 1:Text interface: ezfio, ocaml, provider diff --git a/devel/trexio/export_trexio.irp.f b/devel/trexio/export_trexio.irp.f index 254b37c..6f6f758 100644 --- a/devel/trexio/export_trexio.irp.f +++ b/devel/trexio/export_trexio.irp.f @@ -11,9 +11,9 @@ program export_trexio print *, 'TREXIO file : '//trim(trexio_filename) print *, '' - if (trexio_backend == 0) then + if (backend == 0) then f = trexio_open(trexio_filename, 'w', TREXIO_HDF5) - else if (trexio_backend == 1) then + else if (backend == 1) then f = trexio_open(trexio_filename, 'w', TREXIO_TEXT) endif if (f == 0) then @@ -45,8 +45,8 @@ program export_trexio rc = trexio_write_nucleus_coord(f, nucl_coord_transp) call check_success(rc) -! rc = trexio_write_nucleus_label(f, nucl_label) -! call check_success(rc) + rc = trexio_write_nucleus_label(f, nucl_label, 32) + call check_success(rc) ! Pseudo-potentials @@ -90,13 +90,16 @@ program export_trexio ! Basis ! ----- -! rc = trexio_write_basis_type(f, 'Gaussian') -! call check_success(rc) - - rc = trexio_write_basis_shell_num(f, shell_num) + rc = trexio_write_basis_type(f, 'Gaussian', len('Gaussian')) call check_success(rc) - rc = trexio_write_basis_shell_center(f, shell_nucl) + rc = trexio_write_basis_num(f, shell_num) + call check_success(rc) + + rc = trexio_write_basis_nucleus_shell_num(f, nucleus_shell_num) + call check_success(rc) + + rc = trexio_write_basis_nucleus_index(f, basis_nucleus_index) call check_success(rc) rc = trexio_write_basis_shell_ang_mom(f, shell_ang_mom) @@ -119,7 +122,7 @@ program export_trexio call check_success(rc) deallocate(factor) - rc = trexio_write_basis_prim_index(f, shell_prim_index) + rc = trexio_write_basis_shell_prim_index(f, shell_prim_index) call check_success(rc) rc = trexio_write_basis_exponent(f, prim_expo) diff --git a/devel/trexio/trexio_f.f90 b/devel/trexio/trexio_f.f90 index 92323ff..42153e6 100644 --- a/devel/trexio/trexio_f.f90 +++ b/devel/trexio/trexio_f.f90 @@ -4,11 +4,14 @@ module trexio implicit none integer, parameter :: trexio_exit_code = 4 + integer, parameter :: trexio_backend = 4 - integer, parameter :: TREXIO_HDF5 = 0 - integer, parameter :: TREXIO_TEXT = 1 -! integer, parameter :: TREXIO_JSON = 2 - integer, parameter :: TREXIO_INVALID_BACK_END = 2 + integer(trexio_backend), parameter :: TREXIO_HDF5 = 0 + integer(trexio_backend), parameter :: TREXIO_TEXT = 1 +! integer(trexio_backend), parameter :: TREXIO_JSON = 2 + integer(trexio_backend), parameter :: TREXIO_INVALID_BACK_END = 2 + + character(kind=c_char), parameter :: TREXIO_DELIM = c_new_line integer(trexio_exit_code), parameter :: TREXIO_FAILURE = -1 integer(trexio_exit_code), parameter :: TREXIO_SUCCESS = 0 @@ -25,14 +28,16 @@ integer(trexio_exit_code), parameter :: TREXIO_ALLOCATION_FAILED = 10 integer(trexio_exit_code), parameter :: TREXIO_HAS_NOT = 11 integer(trexio_exit_code), parameter :: TREXIO_INVALID_NUM = 12 integer(trexio_exit_code), parameter :: TREXIO_NUM_ALREADY_EXISTS = 13 -integer(trexio_exit_code), parameter :: TREXIO_OPEN_ERROR = 14 -integer(trexio_exit_code), parameter :: TREXIO_LOCK_ERROR = 15 -integer(trexio_exit_code), parameter :: TREXIO_UNLOCK_ERROR = 16 -integer(trexio_exit_code), parameter :: TREXIO_FILE_ERROR = 17 -integer(trexio_exit_code), parameter :: TREXIO_GROUP_READ_ERROR = 18 -integer(trexio_exit_code), parameter :: TREXIO_GROUP_WRITE_ERROR = 19 -integer(trexio_exit_code), parameter :: TREXIO_ELEM_READ_ERROR = 20 -integer(trexio_exit_code), parameter :: TREXIO_ELEM_WRITE_ERROR = 21 +integer(trexio_exit_code), parameter :: TREXIO_DSET_ALREADY_EXISTS = 14 +integer(trexio_exit_code), parameter :: TREXIO_OPEN_ERROR = 15 +integer(trexio_exit_code), parameter :: TREXIO_LOCK_ERROR = 16 +integer(trexio_exit_code), parameter :: TREXIO_UNLOCK_ERROR = 17 +integer(trexio_exit_code), parameter :: TREXIO_FILE_ERROR = 18 +integer(trexio_exit_code), parameter :: TREXIO_GROUP_READ_ERROR = 19 +integer(trexio_exit_code), parameter :: TREXIO_GROUP_WRITE_ERROR = 20 +integer(trexio_exit_code), parameter :: TREXIO_ELEM_READ_ERROR = 21 +integer(trexio_exit_code), parameter :: TREXIO_ELEM_WRITE_ERROR = 22 +integer(trexio_exit_code), parameter :: TREXIO_INVALID_STR_LEN = 30 interface subroutine trexio_string_of_error (error, string) bind(C, name='trexio_string_of_error_f') @@ -46,18 +51,50 @@ end interface interface integer(8) function trexio_open_c (filename, mode, backend) bind(C, name="trexio_open") use, intrinsic :: iso_c_binding - character(kind=c_char), dimension(*) :: filename - character, intent(in), value :: mode - integer, intent(in), value :: backend + import + character(kind=c_char), dimension(*) :: filename + character, intent(in), value :: mode + integer(trexio_backend), intent(in), value :: backend end function trexio_open_c end interface +interface + integer function trexio_set_one_based(trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_set_one_based +end interface + interface integer function trexio_close (trex_file) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file end function trexio_close end interface +interface + integer function trexio_has_metadata_description (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_metadata_description +end interface +interface + integer function trexio_has_nucleus_point_group (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_nucleus_point_group +end interface +interface + integer function trexio_has_basis_type (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_basis_type +end interface +interface + integer function trexio_has_mo_type (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_mo_type +end interface interface integer function trexio_has_nucleus_charge (trex_file) bind(C) use, intrinsic :: iso_c_binding @@ -131,10 +168,16 @@ interface end function trexio_has_ecp_non_local_power end interface interface - integer function trexio_has_basis_shell_center (trex_file) bind(C) + integer function trexio_has_basis_nucleus_index (trex_file) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file - end function trexio_has_basis_shell_center + end function trexio_has_basis_nucleus_index +end interface +interface + integer function trexio_has_basis_nucleus_shell_num (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_basis_nucleus_shell_num end interface interface integer function trexio_has_basis_shell_ang_mom (trex_file) bind(C) @@ -155,10 +198,10 @@ interface end function trexio_has_basis_shell_factor end interface interface - integer function trexio_has_basis_prim_index (trex_file) bind(C) + integer function trexio_has_basis_shell_prim_index (trex_file) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file - end function trexio_has_basis_prim_index + end function trexio_has_basis_shell_prim_index end interface interface integer function trexio_has_basis_exponent (trex_file) bind(C) @@ -298,6 +341,48 @@ interface integer(8), intent(in), value :: trex_file end function trexio_has_mo_2e_int_eri_lr end interface +interface + integer function trexio_has_metadata_code (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_metadata_code +end interface +interface + integer function trexio_has_metadata_author (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_metadata_author +end interface +interface + integer function trexio_has_nucleus_label (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_nucleus_label +end interface +interface + integer function trexio_has_mo_class (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_mo_class +end interface +interface + integer function trexio_has_mo_symmetry (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_mo_symmetry +end interface +interface + integer function trexio_has_metadata_code_num (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_metadata_code_num +end interface +interface + integer function trexio_has_metadata_author_num (trex_file) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + end function trexio_has_metadata_author_num +end interface interface integer function trexio_has_electron_up_num (trex_file) bind(C) use, intrinsic :: iso_c_binding @@ -329,10 +414,10 @@ interface end function trexio_has_ecp_non_local_num_n_max end interface interface - integer function trexio_has_basis_shell_num (trex_file) bind(C) + integer function trexio_has_basis_num (trex_file) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file - end function trexio_has_basis_shell_num + end function trexio_has_basis_num end interface interface integer function trexio_has_basis_prim_num (trex_file) bind(C) @@ -358,6 +443,42 @@ interface integer(8), intent(in), value :: trex_file end function trexio_has_mo_num end interface +interface + integer function trexio_read_metadata_description_c (trex_file, str, max_str_len) & + bind(C, name="trexio_read_metadata_description") + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + character, intent(out) :: str(*) + integer(4), intent(in), value :: max_str_len + end function trexio_read_metadata_description_c +end interface +interface + integer function trexio_read_nucleus_point_group_c (trex_file, str, max_str_len) & + bind(C, name="trexio_read_nucleus_point_group") + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + character, intent(out) :: str(*) + integer(4), intent(in), value :: max_str_len + end function trexio_read_nucleus_point_group_c +end interface +interface + integer function trexio_read_basis_type_c (trex_file, str, max_str_len) & + bind(C, name="trexio_read_basis_type") + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + character, intent(out) :: str(*) + integer(4), intent(in), value :: max_str_len + end function trexio_read_basis_type_c +end interface +interface + integer function trexio_read_mo_type_c (trex_file, str, max_str_len) & + bind(C, name="trexio_read_mo_type") + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + character, intent(out) :: str(*) + integer(4), intent(in), value :: max_str_len + end function trexio_read_mo_type_c +end interface interface integer function trexio_read_nucleus_charge_32 (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding @@ -443,11 +564,18 @@ interface end function trexio_read_ecp_non_local_power_32 end interface interface - integer function trexio_read_basis_shell_center_32 (trex_file, dset) bind(C) + integer function trexio_read_basis_nucleus_index_32 (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(out) :: dset(*) - end function trexio_read_basis_shell_center_32 + end function trexio_read_basis_nucleus_index_32 +end interface +interface + integer function trexio_read_basis_nucleus_shell_num_32 (trex_file, dset) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(out) :: dset(*) + end function trexio_read_basis_nucleus_shell_num_32 end interface interface integer function trexio_read_basis_shell_ang_mom_32 (trex_file, dset) bind(C) @@ -471,11 +599,11 @@ interface end function trexio_read_basis_shell_factor_32 end interface interface - integer function trexio_read_basis_prim_index_32 (trex_file, dset) bind(C) + integer function trexio_read_basis_shell_prim_index_32 (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(out) :: dset(*) - end function trexio_read_basis_prim_index_32 + end function trexio_read_basis_shell_prim_index_32 end interface interface integer function trexio_read_basis_exponent_32 (trex_file, dset) bind(C) @@ -723,11 +851,18 @@ interface end function trexio_read_ecp_non_local_power_64 end interface interface - integer function trexio_read_basis_shell_center_64 (trex_file, dset) bind(C) + integer function trexio_read_basis_nucleus_index_64 (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(8), intent(out) :: dset(*) - end function trexio_read_basis_shell_center_64 + end function trexio_read_basis_nucleus_index_64 +end interface +interface + integer function trexio_read_basis_nucleus_shell_num_64 (trex_file, dset) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(8), intent(out) :: dset(*) + end function trexio_read_basis_nucleus_shell_num_64 end interface interface integer function trexio_read_basis_shell_ang_mom_64 (trex_file, dset) bind(C) @@ -751,11 +886,11 @@ interface end function trexio_read_basis_shell_factor_64 end interface interface - integer function trexio_read_basis_prim_index_64 (trex_file, dset) bind(C) + integer function trexio_read_basis_shell_prim_index_64 (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(8), intent(out) :: dset(*) - end function trexio_read_basis_prim_index_64 + end function trexio_read_basis_shell_prim_index_64 end interface interface integer function trexio_read_basis_exponent_64 (trex_file, dset) bind(C) @@ -1003,11 +1138,18 @@ interface end function trexio_read_ecp_non_local_power end interface interface - integer function trexio_read_basis_shell_center (trex_file, dset) bind(C) + integer function trexio_read_basis_nucleus_index (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(out) :: dset(*) - end function trexio_read_basis_shell_center + end function trexio_read_basis_nucleus_index +end interface +interface + integer function trexio_read_basis_nucleus_shell_num (trex_file, dset) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(out) :: dset(*) + end function trexio_read_basis_nucleus_shell_num end interface interface integer function trexio_read_basis_shell_ang_mom (trex_file, dset) bind(C) @@ -1031,11 +1173,11 @@ interface end function trexio_read_basis_shell_factor end interface interface - integer function trexio_read_basis_prim_index (trex_file, dset) bind(C) + integer function trexio_read_basis_shell_prim_index (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(out) :: dset(*) - end function trexio_read_basis_prim_index + end function trexio_read_basis_shell_prim_index end interface interface integer function trexio_read_basis_exponent (trex_file, dset) bind(C) @@ -1198,6 +1340,60 @@ interface real(8), intent(out) :: dset(*) end function trexio_read_mo_2e_int_eri_lr end interface +interface + integer function trexio_read_metadata_code_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_metadata_code_low +end interface +interface + integer function trexio_read_metadata_author_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_metadata_author_low +end interface +interface + integer function trexio_read_nucleus_label_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_nucleus_label_low +end interface +interface + integer function trexio_read_mo_class_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_mo_class_low +end interface +interface + integer function trexio_read_mo_symmetry_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_mo_symmetry_low +end interface +interface + integer function trexio_read_metadata_code_num_32 (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(out) :: num + end function trexio_read_metadata_code_num_32 +end interface +interface + integer function trexio_read_metadata_author_num_32 (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(out) :: num + end function trexio_read_metadata_author_num_32 +end interface interface integer function trexio_read_electron_up_num_32 (trex_file, num) bind(C) use, intrinsic :: iso_c_binding @@ -1234,11 +1430,11 @@ interface end function trexio_read_ecp_non_local_num_n_max_32 end interface interface - integer function trexio_read_basis_shell_num_32 (trex_file, num) bind(C) + integer function trexio_read_basis_num_32 (trex_file, num) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(out) :: num - end function trexio_read_basis_shell_num_32 + end function trexio_read_basis_num_32 end interface interface integer function trexio_read_basis_prim_num_32 (trex_file, num) bind(C) @@ -1268,6 +1464,20 @@ interface integer(4), intent(out) :: num end function trexio_read_mo_num_32 end interface +interface + integer function trexio_read_metadata_code_num_64 (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(8), intent(out) :: num + end function trexio_read_metadata_code_num_64 +end interface +interface + integer function trexio_read_metadata_author_num_64 (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(8), intent(out) :: num + end function trexio_read_metadata_author_num_64 +end interface interface integer function trexio_read_electron_up_num_64 (trex_file, num) bind(C) use, intrinsic :: iso_c_binding @@ -1304,11 +1514,11 @@ interface end function trexio_read_ecp_non_local_num_n_max_64 end interface interface - integer function trexio_read_basis_shell_num_64 (trex_file, num) bind(C) + integer function trexio_read_basis_num_64 (trex_file, num) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(8), intent(out) :: num - end function trexio_read_basis_shell_num_64 + end function trexio_read_basis_num_64 end interface interface integer function trexio_read_basis_prim_num_64 (trex_file, num) bind(C) @@ -1338,6 +1548,20 @@ interface integer(8), intent(out) :: num end function trexio_read_mo_num_64 end interface +interface + integer function trexio_read_metadata_code_num (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(out) :: num + end function trexio_read_metadata_code_num +end interface +interface + integer function trexio_read_metadata_author_num (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(out) :: num + end function trexio_read_metadata_author_num +end interface interface integer function trexio_read_electron_up_num (trex_file, num) bind(C) use, intrinsic :: iso_c_binding @@ -1374,11 +1598,11 @@ interface end function trexio_read_ecp_non_local_num_n_max end interface interface - integer function trexio_read_basis_shell_num (trex_file, num) bind(C) + integer function trexio_read_basis_num (trex_file, num) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(out) :: num - end function trexio_read_basis_shell_num + end function trexio_read_basis_num end interface interface integer function trexio_read_basis_prim_num (trex_file, num) bind(C) @@ -1408,6 +1632,42 @@ interface integer(4), intent(out) :: num end function trexio_read_mo_num end interface +interface + integer function trexio_write_metadata_description_c (trex_file, str, max_str_len) & + bind(C, name="trexio_write_metadata_description") + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + character, intent(in) :: str(*) + integer(4), intent(in), value :: max_str_len + end function trexio_write_metadata_description_c +end interface +interface + integer function trexio_write_nucleus_point_group_c (trex_file, str, max_str_len) & + bind(C, name="trexio_write_nucleus_point_group") + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + character, intent(in) :: str(*) + integer(4), intent(in), value :: max_str_len + end function trexio_write_nucleus_point_group_c +end interface +interface + integer function trexio_write_basis_type_c (trex_file, str, max_str_len) & + bind(C, name="trexio_write_basis_type") + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + character, intent(in) :: str(*) + integer(4), intent(in), value :: max_str_len + end function trexio_write_basis_type_c +end interface +interface + integer function trexio_write_mo_type_c (trex_file, str, max_str_len) & + bind(C, name="trexio_write_mo_type") + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + character, intent(in) :: str(*) + integer(4), intent(in), value :: max_str_len + end function trexio_write_mo_type_c +end interface interface integer function trexio_write_nucleus_charge_32 (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding @@ -1493,11 +1753,18 @@ interface end function trexio_write_ecp_non_local_power_32 end interface interface - integer function trexio_write_basis_shell_center_32 (trex_file, dset) bind(C) + integer function trexio_write_basis_nucleus_index_32 (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(in) :: dset(*) - end function trexio_write_basis_shell_center_32 + end function trexio_write_basis_nucleus_index_32 +end interface +interface + integer function trexio_write_basis_nucleus_shell_num_32 (trex_file, dset) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(in) :: dset(*) + end function trexio_write_basis_nucleus_shell_num_32 end interface interface integer function trexio_write_basis_shell_ang_mom_32 (trex_file, dset) bind(C) @@ -1521,11 +1788,11 @@ interface end function trexio_write_basis_shell_factor_32 end interface interface - integer function trexio_write_basis_prim_index_32 (trex_file, dset) bind(C) + integer function trexio_write_basis_shell_prim_index_32 (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(in) :: dset(*) - end function trexio_write_basis_prim_index_32 + end function trexio_write_basis_shell_prim_index_32 end interface interface integer function trexio_write_basis_exponent_32 (trex_file, dset) bind(C) @@ -1773,11 +2040,18 @@ interface end function trexio_write_ecp_non_local_power_64 end interface interface - integer function trexio_write_basis_shell_center_64 (trex_file, dset) bind(C) + integer function trexio_write_basis_nucleus_index_64 (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(8), intent(in) :: dset(*) - end function trexio_write_basis_shell_center_64 + end function trexio_write_basis_nucleus_index_64 +end interface +interface + integer function trexio_write_basis_nucleus_shell_num_64 (trex_file, dset) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(8), intent(in) :: dset(*) + end function trexio_write_basis_nucleus_shell_num_64 end interface interface integer function trexio_write_basis_shell_ang_mom_64 (trex_file, dset) bind(C) @@ -1801,11 +2075,11 @@ interface end function trexio_write_basis_shell_factor_64 end interface interface - integer function trexio_write_basis_prim_index_64 (trex_file, dset) bind(C) + integer function trexio_write_basis_shell_prim_index_64 (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(8), intent(in) :: dset(*) - end function trexio_write_basis_prim_index_64 + end function trexio_write_basis_shell_prim_index_64 end interface interface integer function trexio_write_basis_exponent_64 (trex_file, dset) bind(C) @@ -2053,11 +2327,18 @@ interface end function trexio_write_ecp_non_local_power end interface interface - integer function trexio_write_basis_shell_center (trex_file, dset) bind(C) + integer function trexio_write_basis_nucleus_index (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(in) :: dset(*) - end function trexio_write_basis_shell_center + end function trexio_write_basis_nucleus_index +end interface +interface + integer function trexio_write_basis_nucleus_shell_num (trex_file, dset) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(in) :: dset(*) + end function trexio_write_basis_nucleus_shell_num end interface interface integer function trexio_write_basis_shell_ang_mom (trex_file, dset) bind(C) @@ -2081,11 +2362,11 @@ interface end function trexio_write_basis_shell_factor end interface interface - integer function trexio_write_basis_prim_index (trex_file, dset) bind(C) + integer function trexio_write_basis_shell_prim_index (trex_file, dset) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(in) :: dset(*) - end function trexio_write_basis_prim_index + end function trexio_write_basis_shell_prim_index end interface interface integer function trexio_write_basis_exponent (trex_file, dset) bind(C) @@ -2248,6 +2529,60 @@ interface real(8), intent(in) :: dset(*) end function trexio_write_mo_2e_int_eri_lr end interface +interface + integer function trexio_write_metadata_code_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_metadata_code_low +end interface +interface + integer function trexio_write_metadata_author_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_metadata_author_low +end interface +interface + integer function trexio_write_nucleus_label_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_nucleus_label_low +end interface +interface + integer function trexio_write_mo_class_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_mo_class_low +end interface +interface + integer function trexio_write_mo_symmetry_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_mo_symmetry_low +end interface +interface + integer function trexio_write_metadata_code_num_32 (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: num + end function trexio_write_metadata_code_num_32 +end interface +interface + integer function trexio_write_metadata_author_num_32 (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: num + end function trexio_write_metadata_author_num_32 +end interface interface integer function trexio_write_electron_up_num_32 (trex_file, num) bind(C) use, intrinsic :: iso_c_binding @@ -2284,11 +2619,11 @@ interface end function trexio_write_ecp_non_local_num_n_max_32 end interface interface - integer function trexio_write_basis_shell_num_32 (trex_file, num) bind(C) + integer function trexio_write_basis_num_32 (trex_file, num) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(in), value :: num - end function trexio_write_basis_shell_num_32 + end function trexio_write_basis_num_32 end interface interface integer function trexio_write_basis_prim_num_32 (trex_file, num) bind(C) @@ -2318,6 +2653,20 @@ interface integer(4), intent(in), value :: num end function trexio_write_mo_num_32 end interface +interface + integer function trexio_write_metadata_code_num_64 (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(8), intent(in), value :: num + end function trexio_write_metadata_code_num_64 +end interface +interface + integer function trexio_write_metadata_author_num_64 (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(8), intent(in), value :: num + end function trexio_write_metadata_author_num_64 +end interface interface integer function trexio_write_electron_up_num_64 (trex_file, num) bind(C) use, intrinsic :: iso_c_binding @@ -2354,11 +2703,11 @@ interface end function trexio_write_ecp_non_local_num_n_max_64 end interface interface - integer function trexio_write_basis_shell_num_64 (trex_file, num) bind(C) + integer function trexio_write_basis_num_64 (trex_file, num) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(8), intent(in), value :: num - end function trexio_write_basis_shell_num_64 + end function trexio_write_basis_num_64 end interface interface integer function trexio_write_basis_prim_num_64 (trex_file, num) bind(C) @@ -2388,6 +2737,20 @@ interface integer(8), intent(in), value :: num end function trexio_write_mo_num_64 end interface +interface + integer function trexio_write_metadata_code_num (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: num + end function trexio_write_metadata_code_num +end interface +interface + integer function trexio_write_metadata_author_num (trex_file, num) bind(C) + use, intrinsic :: iso_c_binding + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: num + end function trexio_write_metadata_author_num +end interface interface integer function trexio_write_electron_up_num (trex_file, num) bind(C) use, intrinsic :: iso_c_binding @@ -2424,11 +2787,11 @@ interface end function trexio_write_ecp_non_local_num_n_max end interface interface - integer function trexio_write_basis_shell_num (trex_file, num) bind(C) + integer function trexio_write_basis_num (trex_file, num) bind(C) use, intrinsic :: iso_c_binding integer(8), intent(in), value :: trex_file integer(4), intent(in), value :: num - end function trexio_write_basis_shell_num + end function trexio_write_basis_num end interface interface integer function trexio_write_basis_prim_num (trex_file, num) bind(C) @@ -2460,15 +2823,410 @@ interface end interface contains integer(8) function trexio_open (filename, mode, backend) - use, intrinsic :: iso_c_binding + use, intrinsic :: iso_c_binding, only : c_null_char implicit none - character(len=*) :: filename - character, intent(in), value :: mode - integer, intent(in), value :: backend + character(len=*), intent(in) :: filename + character, intent(in), value :: mode + integer(trexio_backend), intent(in), value :: backend character(len=len_trim(filename)+1) :: filename_c + integer :: rc filename_c = trim(filename) // c_null_char trexio_open = trexio_open_c(filename_c, mode, backend) + if (trexio_open == 0_8) then + return + endif + rc = trexio_set_one_based(trexio_open) + if (rc /= TREXIO_SUCCESS) then + rc = trexio_close(trexio_open) + trexio_open = 0_8 + endif end function trexio_open +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(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=*), intent(in) :: str_array(*) + character(len=:), allocatable, intent(out) :: str_res + integer :: i + + str_res = '' + do i = 1, max_num_str + str_res = str_res // trim(str_array(i)) // TREXIO_DELIM + enddo + str_res = str_res // c_null_char + +end subroutine trexio_strarray2str + +subroutine trexio_str2strarray(str_flat, max_num_str, max_len_str, str_array) + 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 + offset=ind + enddo + +end subroutine trexio_str2strarray + +subroutine trexio_assert(trexio_rc, check_rc, success_message) + implicit none + + integer, intent(in), value :: trexio_rc + integer, intent(in), value :: check_rc + character(len=*), intent(in), optional :: success_message + + character*(128) :: str + + if (trexio_rc == check_rc) then + if (present(success_message)) write(*,*) success_message + else + call trexio_string_of_error(trexio_rc, str) + print *, trim(str) + call exit(1) + endif + +end subroutine trexio_assert +integer function trexio_read_metadata_description (trex_file, str, max_str_len) + implicit none + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: max_str_len + character, intent(out) :: str(*) + + trexio_read_metadata_description = trexio_read_metadata_description_c(trex_file, str, max_str_len) + +end function trexio_read_metadata_description +integer function trexio_read_nucleus_point_group (trex_file, str, max_str_len) + implicit none + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: max_str_len + character, intent(out) :: str(*) + + trexio_read_nucleus_point_group = trexio_read_nucleus_point_group_c(trex_file, str, max_str_len) + +end function trexio_read_nucleus_point_group +integer function trexio_read_basis_type (trex_file, str, max_str_len) + implicit none + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: max_str_len + character, intent(out) :: str(*) + + trexio_read_basis_type = trexio_read_basis_type_c(trex_file, str, max_str_len) + +end function trexio_read_basis_type +integer function trexio_read_mo_type (trex_file, str, max_str_len) + implicit none + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: max_str_len + character, intent(out) :: str(*) + + trexio_read_mo_type = trexio_read_mo_type_c(trex_file, str, max_str_len) + +end function trexio_read_mo_type +integer function trexio_read_metadata_code (trex_file, dset, max_str_len) + 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) :: metadata_code_num + integer :: rc + + rc = trexio_read_metadata_code_num_64(trex_file, metadata_code_num) + if (rc /= TREXIO_SUCCESS) trexio_read_metadata_code = rc + + allocate(str_compiled(metadata_code_num*(max_str_len+1)+1)) + + rc = trexio_read_metadata_code_low(trex_file, str_compiled, max_str_len) + if (rc /= TREXIO_SUCCESS) then + deallocate(str_compiled) + trexio_read_metadata_code = rc + else + call trexio_str2strarray(str_compiled, metadata_code_num, max_str_len, dset) + deallocate(str_compiled) + trexio_read_metadata_code = TREXIO_SUCCESS + endif + +end function trexio_read_metadata_code +integer function trexio_read_metadata_author (trex_file, dset, max_str_len) + 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) :: metadata_author_num + integer :: rc + + rc = trexio_read_metadata_author_num_64(trex_file, metadata_author_num) + if (rc /= TREXIO_SUCCESS) trexio_read_metadata_author = rc + + allocate(str_compiled(metadata_author_num*(max_str_len+1)+1)) + + rc = trexio_read_metadata_author_low(trex_file, str_compiled, max_str_len) + if (rc /= TREXIO_SUCCESS) then + deallocate(str_compiled) + trexio_read_metadata_author = rc + else + call trexio_str2strarray(str_compiled, metadata_author_num, max_str_len, dset) + deallocate(str_compiled) + trexio_read_metadata_author = TREXIO_SUCCESS + endif + +end function trexio_read_metadata_author +integer function trexio_read_nucleus_label (trex_file, dset, max_str_len) + 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) :: nucleus_num + integer :: rc + + rc = trexio_read_nucleus_num_64(trex_file, nucleus_num) + if (rc /= TREXIO_SUCCESS) trexio_read_nucleus_label = rc + + allocate(str_compiled(nucleus_num*(max_str_len+1)+1)) + + rc = trexio_read_nucleus_label_low(trex_file, str_compiled, max_str_len) + if (rc /= TREXIO_SUCCESS) then + deallocate(str_compiled) + trexio_read_nucleus_label = rc + else + call trexio_str2strarray(str_compiled, nucleus_num, max_str_len, dset) + deallocate(str_compiled) + trexio_read_nucleus_label = TREXIO_SUCCESS + endif + +end function trexio_read_nucleus_label +integer function trexio_read_mo_class (trex_file, dset, max_str_len) + 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) :: mo_num + integer :: rc + + rc = trexio_read_mo_num_64(trex_file, mo_num) + if (rc /= TREXIO_SUCCESS) trexio_read_mo_class = rc + + allocate(str_compiled(mo_num*(max_str_len+1)+1)) + + rc = trexio_read_mo_class_low(trex_file, str_compiled, max_str_len) + if (rc /= TREXIO_SUCCESS) then + deallocate(str_compiled) + trexio_read_mo_class = rc + else + call trexio_str2strarray(str_compiled, mo_num, max_str_len, dset) + deallocate(str_compiled) + trexio_read_mo_class = TREXIO_SUCCESS + endif + +end function trexio_read_mo_class +integer function trexio_read_mo_symmetry (trex_file, dset, max_str_len) + 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) :: mo_num + integer :: rc + + rc = trexio_read_mo_num_64(trex_file, mo_num) + if (rc /= TREXIO_SUCCESS) trexio_read_mo_symmetry = rc + + allocate(str_compiled(mo_num*(max_str_len+1)+1)) + + rc = trexio_read_mo_symmetry_low(trex_file, str_compiled, max_str_len) + if (rc /= TREXIO_SUCCESS) then + deallocate(str_compiled) + trexio_read_mo_symmetry = rc + else + call trexio_str2strarray(str_compiled, mo_num, max_str_len, dset) + deallocate(str_compiled) + trexio_read_mo_symmetry = TREXIO_SUCCESS + endif + +end function trexio_read_mo_symmetry +integer function trexio_write_metadata_description (trex_file, str, max_str_len) + use, intrinsic :: iso_c_binding, only : c_null_char + implicit none + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: max_str_len + character(len=*), intent(in) :: str + + character(len=len_trim(str)+1) :: str_c + + str_c = trim(str) // c_null_char + + trexio_write_metadata_description = trexio_write_metadata_description_c(trex_file, str_c, max_str_len) + +end function trexio_write_metadata_description +integer function trexio_write_nucleus_point_group (trex_file, str, max_str_len) + use, intrinsic :: iso_c_binding, only : c_null_char + implicit none + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: max_str_len + character(len=*), intent(in) :: str + + character(len=len_trim(str)+1) :: str_c + + str_c = trim(str) // c_null_char + + trexio_write_nucleus_point_group = trexio_write_nucleus_point_group_c(trex_file, str_c, max_str_len) + +end function trexio_write_nucleus_point_group +integer function trexio_write_basis_type (trex_file, str, max_str_len) + use, intrinsic :: iso_c_binding, only : c_null_char + implicit none + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: max_str_len + character(len=*), intent(in) :: str + + character(len=len_trim(str)+1) :: str_c + + str_c = trim(str) // c_null_char + + trexio_write_basis_type = trexio_write_basis_type_c(trex_file, str_c, max_str_len) + +end function trexio_write_basis_type +integer function trexio_write_mo_type (trex_file, str, max_str_len) + use, intrinsic :: iso_c_binding, only : c_null_char + implicit none + integer(8), intent(in), value :: trex_file + integer(4), intent(in), value :: max_str_len + character(len=*), intent(in) :: str + + character(len=len_trim(str)+1) :: str_c + + str_c = trim(str) // c_null_char + + trexio_write_mo_type = trexio_write_mo_type_c(trex_file, str_c, max_str_len) + +end function trexio_write_mo_type +integer function trexio_write_metadata_code (trex_file, dset, max_str_len) + 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) :: metadata_code_num + integer :: rc + + rc = trexio_read_metadata_code_num_64(trex_file, metadata_code_num) + if (rc /= TREXIO_SUCCESS) then + trexio_write_metadata_code = rc + else + call trexio_strarray2str(dset, metadata_code_num, max_str_len, str_compiled) + trexio_write_metadata_code = trexio_write_metadata_code_low(trex_file, str_compiled, max_str_len) + endif + +end function trexio_write_metadata_code +integer function trexio_write_metadata_author (trex_file, dset, max_str_len) + 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) :: metadata_author_num + integer :: rc + + rc = trexio_read_metadata_author_num_64(trex_file, metadata_author_num) + if (rc /= TREXIO_SUCCESS) then + trexio_write_metadata_author = rc + else + call trexio_strarray2str(dset, metadata_author_num, max_str_len, str_compiled) + trexio_write_metadata_author = trexio_write_metadata_author_low(trex_file, str_compiled, max_str_len) + endif + +end function trexio_write_metadata_author +integer function trexio_write_nucleus_label (trex_file, dset, max_str_len) + 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) :: nucleus_num + integer :: rc + + rc = trexio_read_nucleus_num_64(trex_file, nucleus_num) + if (rc /= TREXIO_SUCCESS) then + trexio_write_nucleus_label = rc + else + call trexio_strarray2str(dset, nucleus_num, max_str_len, str_compiled) + trexio_write_nucleus_label = trexio_write_nucleus_label_low(trex_file, str_compiled, max_str_len) + endif + +end function trexio_write_nucleus_label +integer function trexio_write_mo_class (trex_file, dset, max_str_len) + 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) :: mo_num + integer :: rc + + rc = trexio_read_mo_num_64(trex_file, mo_num) + if (rc /= TREXIO_SUCCESS) then + trexio_write_mo_class = rc + else + call trexio_strarray2str(dset, mo_num, max_str_len, str_compiled) + trexio_write_mo_class = trexio_write_mo_class_low(trex_file, str_compiled, max_str_len) + endif + +end function trexio_write_mo_class +integer function trexio_write_mo_symmetry (trex_file, dset, max_str_len) + 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) :: mo_num + integer :: rc + + rc = trexio_read_mo_num_64(trex_file, mo_num) + if (rc /= TREXIO_SUCCESS) then + trexio_write_mo_symmetry = rc + else + call trexio_strarray2str(dset, mo_num, max_str_len, str_compiled) + trexio_write_mo_symmetry = trexio_write_mo_symmetry_low(trex_file, str_compiled, max_str_len) + endif + +end function trexio_write_mo_symmetry end module trexio