From 7968c506077fceab24d791c4d64344ed7bc4c30d Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Wed, 19 Oct 2011 22:02:52 -0500 Subject: [svn-r21615] Robodoc comment changes. --- fortran/src/H5Off_F03.f90 | 13 +-- fortran/src/H5Pff.f90 | 285 ++++++++++++++++++++++------------------------ fortran/src/H5_ff.f90 | 4 +- fortran/src/H5_ff_F03.f90 | 3 + 4 files changed, 147 insertions(+), 158 deletions(-) diff --git a/fortran/src/H5Off_F03.f90 b/fortran/src/H5Off_F03.f90 index be253ce..b2cbc70 100644 --- a/fortran/src/H5Off_F03.f90 +++ b/fortran/src/H5Off_F03.f90 @@ -40,15 +40,15 @@ MODULE H5O_PROVISIONAL IMPLICIT NONE -!****t* H5T (F03)/h5o_info_t -! -! Fortran2003 Derived Type: -! enum, bind(c) enumerator :: H5O_TYPE_UNKNOWN_F = -1 enumerator :: H5O_TYPE_GROUP_F, H5O_TYPE_DATASET_F, H5O_TYPE_NAMED_DATATYPE_F, H5O_TYPE_NTYPES_F end enum +!****t* H5T (F03)/h5o_info_t +! +! Fortran2003 Derived Type: +! TYPE, BIND(C) :: space_t INTEGER(hsize_t) :: total ! Total space for storing object header in file INTEGER(hsize_t) :: meta ! Space within header for object header metadata information @@ -171,7 +171,7 @@ CONTAINS END SUBROUTINE h5ovisit_f ! -!!$!****s* H5O (F03)/h5oget_info_by_name_f_F03 +!****s* H5O (F03)/h5oget_info_by_name_f_F03 ! ! NAME ! h5oget_info_by_name_f @@ -195,8 +195,7 @@ CONTAINS ! December 1, 2008 ! ! Fortran2003 Interface: - SUBROUTINE h5oget_info_by_name_f(loc_id, name, & - object_info, hdferr, lapl_id) + SUBROUTINE h5oget_info_by_name_f(loc_id, name, object_info, hdferr, lapl_id) USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE diff --git a/fortran/src/H5Pff.f90 b/fortran/src/H5Pff.f90 index a22b2e3..2d874d0 100644 --- a/fortran/src/H5Pff.f90 +++ b/fortran/src/H5Pff.f90 @@ -73,7 +73,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pcreate_f(class, prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: class ! The type of the property list @@ -135,7 +135,7 @@ CONTAINS ! Datatype of the flag parameter is changed from ! INTEGER to LOGICAL June 4, 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_preserve_f(prp_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -193,7 +193,7 @@ CONTAINS ! INTEGER to LOGICAL ! June 4, 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_preserve_f(prp_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -257,7 +257,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_class_f(prp_id, classtype, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -315,7 +315,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pcopy_f(prp_id, new_prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -365,7 +365,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pclose_f(prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -415,7 +415,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_chunk_f(prp_id, ndims, dims, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -471,7 +471,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_chunk_f(prp_id, ndims, dims, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -527,7 +527,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_deflate_f(prp_id, level, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -581,7 +581,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_version_f(prp_id, boot, freelist, & stab, shhdr, hdferr) IMPLICIT NONE @@ -644,7 +644,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_userblock_f (prp_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -696,7 +696,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_userblock_f(prp_id, block_size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -748,7 +748,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_sizes_f (prp_id, sizeof_addr, sizeof_size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -804,7 +804,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_sizes_f(prp_id, sizeof_addr, sizeof_size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -861,7 +861,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_sym_k_f (prp_id, ik, lk, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -916,7 +916,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_sym_k_f(prp_id, ik, lk, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -970,7 +970,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_istore_k_f (prp_id, ik, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1022,7 +1022,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_istore_k_f(prp_id, ik, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1075,7 +1075,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_driver_f(prp_id, driver, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1125,7 +1125,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fapl_stdio_f (prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1213,7 +1213,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fapl_sec2_f (prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1301,7 +1301,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_alignment_f(prp_id, threshold, alignment, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1356,7 +1356,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_alignment_f(prp_id, threshold, alignment, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1410,7 +1410,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fapl_core_f(prp_id, increment, backing_store, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1469,7 +1469,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_fapl_core_f(prp_id, increment, backing_store, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1528,7 +1528,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fapl_family_f(prp_id, memb_size, memb_plist , hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1584,7 +1584,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_fapl_family_f(prp_id, memb_size, memb_plist , hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1647,7 +1647,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_cache_f(prp_id, mdc_nelmts,rdcc_nelmts, rdcc_nbytes, rdcc_w0, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1716,7 +1716,7 @@ CONTAINS ! Bug fix: type of the rdcc_nelmts parameter should be INTEGER ! instead of INTEGER(SIZE_T) October 10, 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_cache_f(prp_id, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, rdcc_w0, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1782,7 +1782,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fapl_split_f(prp_id, meta_ext, meta_plist, raw_ext, raw_plist, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1902,7 +1902,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_gc_references_f (prp_id, gc_reference, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -1956,7 +1956,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_gc_references_f(prp_id, gc_reference, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -2014,7 +2014,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_layout_f (prp_id, layout, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -2074,7 +2074,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_layout_f (prp_id, layout, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -2130,7 +2130,7 @@ CONTAINS ! Elena Pourmal ! February, 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_filter_f(prp_id, filter, flags, cd_nelmts, cd_values, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -2190,7 +2190,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_nfilters_f (prp_id, nfilters, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -2252,7 +2252,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_filter_f(prp_id, filter_number, flags, cd_nelmts, cd_values, namelen, name, filter_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -2326,7 +2326,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_external_f(prp_id, name, offset,bytes, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -2391,7 +2391,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_external_count_f (prp_id, count, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -2450,7 +2450,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_external_f(prp_id, idx, name_size, name, offset,bytes, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -2517,7 +2517,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_btree_ratios_f(prp_id, left, middle, right, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -2577,7 +2577,7 @@ CONTAINS ! called C functions (it is needed for Windows ! port). March 14, 2001 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_btree_ratios_f(prp_id, left, middle, right, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -2637,7 +2637,7 @@ CONTAINS ! HISTORY ! ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_fclose_degree_f(fapl_id, degree, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier @@ -2691,7 +2691,7 @@ CONTAINS ! Elena Pourmal ! September 26, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fclose_degree_f(fapl_id, degree, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier @@ -2741,7 +2741,7 @@ CONTAINS ! Elena Pourmal ! September 30, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pequal_f(plist1_id, plist2_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist1_id ! Property list identifier @@ -2789,7 +2789,7 @@ CONTAINS ! Elena Pourmal ! October 2, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_buffer_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Data transfer property list identifier @@ -2835,7 +2835,7 @@ CONTAINS ! Elena Pourmal ! October 2, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_buffer_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Data transfer property list identifier @@ -2886,7 +2886,7 @@ CONTAINS ! Elena Pourmal ! October 4, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pfill_value_defined_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property list identifier @@ -2938,7 +2938,7 @@ CONTAINS ! Elena Pourmal ! October 4, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_alloc_time_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property list identifier @@ -2992,7 +2992,7 @@ CONTAINS ! Elena Pourmal ! October 4, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_alloc_time_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property list identifier @@ -3044,7 +3044,7 @@ CONTAINS ! Elena Pourmal ! October 4, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fill_time_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property list identifier @@ -3095,7 +3095,7 @@ CONTAINS ! Elena Pourmal ! October 4, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_fill_time_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property list identifier @@ -3142,7 +3142,7 @@ CONTAINS ! Elena Pourmal ! October 7, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_meta_block_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier @@ -3185,7 +3185,7 @@ CONTAINS ! Elena Pourmal ! October 7, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_meta_block_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier @@ -3228,7 +3228,7 @@ CONTAINS ! Elena Pourmal ! October 7, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_sieve_buf_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier @@ -3272,7 +3272,7 @@ CONTAINS ! Elena Pourmal ! October 7, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_sieve_buf_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier @@ -3316,7 +3316,7 @@ CONTAINS ! Elena Pourmal ! October 7, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_small_data_block_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier @@ -3360,7 +3360,7 @@ CONTAINS ! Elena Pourmal ! October 7, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_small_data_block_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier @@ -3404,7 +3404,7 @@ CONTAINS ! Elena Pourmal ! October 7, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_hyper_vector_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset transfer property list identifier @@ -3448,7 +3448,7 @@ CONTAINS ! Elena Pourmal ! October 7, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_hyper_vector_size_f(plist_id, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset transfer property list identifier @@ -3493,7 +3493,7 @@ CONTAINS ! Elena Pourmal ! October 9, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pexist_f(prp_id, name, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -3551,7 +3551,7 @@ CONTAINS ! HISTORY ! ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_size_f(prp_id, name, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -3600,7 +3600,7 @@ CONTAINS ! Elena Pourmal ! October 9, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_nprops_f(prp_id, nprops, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -3650,7 +3650,7 @@ CONTAINS ! HISTORY ! Returned the size of name as an argument ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_class_name_f(prp_id, name, size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -3703,7 +3703,7 @@ CONTAINS ! Elena Pourmal ! October 9, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_class_parent_f(prp_id, parent_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -3748,7 +3748,7 @@ CONTAINS ! Elena Pourmal ! October 9, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pisa_class_f(plist, pclass, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist ! Property list identifier @@ -3797,7 +3797,7 @@ CONTAINS ! Elena Pourmal ! October 9, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pcopy_prop_f(dst_id, src_id, name, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dst_id ! Destination property list @@ -3848,7 +3848,7 @@ CONTAINS ! Elena Pourmal ! October 9, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5premove_f(plid, name, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plid ! Property list identifier @@ -3895,7 +3895,7 @@ CONTAINS ! Elena Pourmal ! October 9, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5punregister_f(class, name, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: class ! property list class identifier @@ -3941,7 +3941,7 @@ CONTAINS ! Elena Pourmal ! October 9, 2002 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pclose_class_f(class, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: class ! Property list class identifier @@ -3978,7 +3978,7 @@ CONTAINS ! Elena Pourmal ! March 12, 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_shuffle_f(prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -4024,7 +4024,7 @@ CONTAINS ! Elena Pourmal ! March 13, 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_edc_check_f(prp_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -4069,7 +4069,7 @@ CONTAINS ! Elena Pourmal ! March 13, 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_edc_check_f(prp_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset transfer property list identifier @@ -4120,7 +4120,7 @@ CONTAINS ! Elena Pourmal ! March 13, 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fletcher32_f(prp_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -4164,7 +4164,7 @@ CONTAINS ! Elena Pourmal ! 19 March 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_family_offset_f(prp_id, offset, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -4213,7 +4213,7 @@ CONTAINS ! Elena Pourmal ! 20 March 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fapl_multi_l(prp_id, memb_map, memb_fapl, memb_name, memb_addr, relax, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier @@ -4281,7 +4281,7 @@ CONTAINS ! Elena Pourmal ! 31 March 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fapl_multi_s(prp_id, relax, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier @@ -4336,7 +4336,7 @@ CONTAINS ! Elena Pourmal ! 24 March 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_fapl_multi_f(prp_id, memb_map, memb_fapl, memb_name, memb_addr, relax, hdferr, maxlen_out) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier @@ -4411,7 +4411,7 @@ CONTAINS ! Elena Pourmal ! April 10 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_szip_f(prp_id, options_mask, pixels_per_block, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset creation property @@ -4468,7 +4468,7 @@ CONTAINS ! Elena Pourmal ! April 10 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pall_filters_avail_f(prp_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset creation property @@ -4527,7 +4527,7 @@ CONTAINS ! Elena Pourmal ! April 10 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_filter_by_id_f(prp_id, filter_id, flags, cd_nelmts, cd_values, namelen, name, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -4593,7 +4593,7 @@ CONTAINS ! Elena Pourmal ! April 10 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pmodify_filter_f(prp_id, filter, flags, cd_nelmts, cd_values, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier @@ -4647,7 +4647,7 @@ CONTAINS ! Quincey Koziol ! January 27 2004 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5premove_filter_f(prp_id, filter, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset creation property list @@ -4698,7 +4698,7 @@ CONTAINS ! M. Scot Breitenfeld ! January, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (dataset or group) creation property list identifier @@ -4749,7 +4749,7 @@ CONTAINS ! M. Scot Breitenfeld ! January, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_attr_creation_order_f(ocpl_id, crt_order_flags , hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (dataset or group) creation property list identifier @@ -4796,7 +4796,7 @@ CONTAINS ! M. Scot Breitenfeld ! January, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_shared_mesg_nindexes_f( plist_id, nindexes, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File creation property list @@ -4849,7 +4849,7 @@ CONTAINS ! M. Scot Breitenfeld ! January, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_shared_mesg_index_f(fcpl_id, index_num, mesg_type_flags, min_mesg_size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fcpl_id ! file creation property list @@ -4904,7 +4904,7 @@ CONTAINS ! M. Scot Breitenfeld ! February, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_attr_creation_order_f(ocpl_id, crt_order_flags, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (group or dataset) creation property list identifier @@ -4955,7 +4955,7 @@ CONTAINS ! M. Scot Breitenfeld ! February 18, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_libver_bounds_f(fapl_id, low, high, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier @@ -5012,7 +5012,7 @@ CONTAINS ! M. Scot Breitenfeld ! February 18, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_link_creation_order_f(gcpl_id, crt_order_flags, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! File access property list identifier @@ -5062,7 +5062,7 @@ CONTAINS ! M. Scot Breitenfeld ! February 20, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier @@ -5112,7 +5112,7 @@ CONTAINS ! M. Scot Breitenfeld ! February 22, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_obj_track_times_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property @@ -5178,7 +5178,7 @@ CONTAINS ! February 22, 2008 ! ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_obj_track_times_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property @@ -5235,7 +5235,7 @@ CONTAINS ! HISTORY ! The long subroutine name (>31) on older f90 compilers causes problems ! so had to shorten the name -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_create_inter_group_f(lcpl_id, crt_intermed_group, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: lcpl_id ! Link creation property list identifier @@ -5284,7 +5284,7 @@ CONTAINS ! M. Scot Breitenfeld ! March 3, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_link_creation_order_f(gcpl_id, crt_order_flags, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier @@ -5335,7 +5335,7 @@ CONTAINS ! M. Scot Breitenfeld ! March 3, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_char_encoding_f(plist_id, encoding, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Property list identifier @@ -5389,7 +5389,7 @@ CONTAINS ! M. Scot Breitenfeld ! March 3, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_char_encoding_f(plist_id, encoding, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Property list identifier @@ -5444,7 +5444,7 @@ CONTAINS ! HISTORY ! ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_copy_object_f(ocp_plist_id, copy_options, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocp_plist_id ! Object copy property list identifier @@ -5497,7 +5497,7 @@ CONTAINS ! HISTORY ! ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_copy_object_f(ocp_plist_id, copy_options, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocp_plist_id ! Object copy property list identifier @@ -5554,7 +5554,7 @@ CONTAINS ! HISTORY ! ! Should hdferr return just 0 or 1 and add another arguement for the size? -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Identifier of the property list or class @@ -5613,7 +5613,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) ! M. Scot Breitenfeld ! March 19, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_data_transform_f(plist_id, expression, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Identifier of the property list or class @@ -5664,7 +5664,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) ! M. Scot Breitenfeld ! March 21, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_local_heap_size_hint_f(gcpl_id, size_hint, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier @@ -5715,7 +5715,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) ! HISTORY ! ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_est_link_info_f(gcpl_id, est_num_entries, est_name_len, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier @@ -5764,7 +5764,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) ! M. Scot Breitenfeld ! March 21, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_local_heap_size_hint_f(gcpl_id, size_hint, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier @@ -5812,7 +5812,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) ! M. Scot Breitenfeld ! March 21, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_est_link_info_f(gcpl_id, est_num_entries, est_name_len, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier @@ -5862,7 +5862,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) ! M. Scot Breitenfeld ! March 21, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier @@ -5913,7 +5913,7 @@ SUBROUTINE h5pset_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferr) ! M. Scot Breitenfeld ! March 21, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier @@ -5965,7 +5965,7 @@ SUBROUTINE h5pset_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdfer ! M. Scot Breitenfeld ! March 21, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier @@ -6018,7 +6018,7 @@ SUBROUTINE h5pset_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdfer ! M. Scot Breitenfeld ! January, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (dataset or group) creation property list identifier @@ -6057,31 +6057,22 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! PURPOSE ! Sets up the use of the N-Bit filter. ! -! INPUTS -! +! Inputs: ! plist_id - Dataset creation property list identifier. -! OUTPUTS ! -! hdferr - Error code -! Success: 0 -! Failure: -1 +! Outputs: +! hdferr - Returns 0 if successful and -1 if fails ! ! AUTHOR ! M. Scot Breitenfeld ! March 21, 2008 ! -! HISTORY -! -! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_nbit_f(plist_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property list identifier - INTEGER, INTENT(OUT) :: hdferr ! Error code - ! 0 on success and -1 on failure -!***** -! MS FORTRAN needs explicit interface for C functions called here. -! + INTEGER(HID_T), INTENT(IN) :: plist_id + INTEGER , INTENT(OUT) :: hdferr +!***** INTERFACE INTEGER FUNCTION H5Pset_nbit_c(plist_id) USE H5GLOBAL @@ -6101,37 +6092,33 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! h5pset_scaleoffset_f ! ! PURPOSE -! Sets up the use of the Scale-Offset filter. +! Sets up the use of the scale-offset filter. ! -! INPUTS -! +! Inputs: ! plist_id - Dataset creation property list identifier. -! scale_type - Flag indicating compression method. +! scale_type - Flag indicating compression method. Valid values: +! H5Z_SO_FLOAT_DSCALE_F +! H5Z_SO_FLOAT_ESCALE_F +! H5Z_SO_INT_F +! ! scale_factor - Parameter related to scale. -! OUTPUTS ! -! hdferr - Error code -! Success: 0 -! Failure: -1 +! Outputs: +! hdferr - Returns 0 if successful and -1 if fails ! ! AUTHOR ! M. Scot Breitenfeld ! March 21, 2008 ! -! HISTORY -! -! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_scaleoffset_f(plist_id, scale_type, scale_factor, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property list identifier - INTEGER, INTENT(IN) :: scale_type ! Flag indicating compression method. - INTEGER, INTENT(IN) :: scale_factor ! Parameter related to scale. - INTEGER, INTENT(OUT) :: hdferr ! Error code - ! 0 on success and -1 on failure + INTEGER(HID_T), INTENT(IN) :: plist_id + INTEGER , INTENT(IN) :: scale_type + INTEGER , INTENT(IN) :: scale_factor + INTEGER , INTENT(OUT) :: hdferr !***** -! MS FORTRAN needs explicit interface for C functions called here. -! + INTERFACE INTEGER FUNCTION h5pset_scaleoffset_c(plist_id, scale_type, scale_factor) USE H5GLOBAL @@ -6173,7 +6160,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! HISTORY ! ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_nlinks_f(lapl_id, nlinks, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: lapl_id ! File access property list identifier @@ -6221,7 +6208,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! M. Scot Breitenfeld ! March 24, 2008 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_nlinks_f(lapl_id, nlinks, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: lapl_id ! File access property list identifier @@ -6272,7 +6259,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! ! The long subroutine name (>31) on older f90 compilers causes problems ! so the name was shortened -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_create_inter_group_f(lcpl_id, crt_intermed_group, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: lcpl_id ! Link creation property list identifier @@ -6337,7 +6324,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! ! HISTORY ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_chunk_cache_f(dapl_id, rdcc_nslots, rdcc_nbytes, rdcc_w0, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dapl_id ! Dataset access property list identifier. @@ -6398,7 +6385,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! ! HISTORY ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_chunk_cache_f(dapl_id, rdcc_nslots, rdcc_nbytes, rdcc_w0, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dapl_id ! Dataset access property list identifier. diff --git a/fortran/src/H5_ff.f90 b/fortran/src/H5_ff.f90 index 96d9eed..dcd1917 100644 --- a/fortran/src/H5_ff.f90 +++ b/fortran/src/H5_ff.f90 @@ -361,11 +361,11 @@ CONTAINS ! ! Inputs: ! kind - Fortran KIND parameter -! flag - whether KIND is of type INTEGER or REAL: +! flag - Whether KIND is of type INTEGER or REAL: ! H5_INTEGER_KIND - integer ! H5_REAL_KIND - real ! Outputs: -! h5_type - returns the type +! h5_type - Returns the type ! ! AUTHOR ! M. Scot Breitenfeld diff --git a/fortran/src/H5_ff_F03.f90 b/fortran/src/H5_ff_F03.f90 index 504f385..f3e7098 100644 --- a/fortran/src/H5_ff_F03.f90 +++ b/fortran/src/H5_ff_F03.f90 @@ -53,6 +53,9 @@ CONTAINS ! M. Scot Breitenfeld ! Augest 25, 2008 ! +! ACKNOWLEDGEMENTS +! Joe Krahn +! ! Fortran2003 Interface: FUNCTION h5offsetof(start,end) RESULT(offset) USE, INTRINSIC :: ISO_C_BINDING -- cgit v0.12