diff options
Diffstat (limited to 'fortran')
31 files changed, 2943 insertions, 411 deletions
diff --git a/fortran/robodoc.rc b/fortran/robodoc.rc index 1366f77..07b8b35 100644 --- a/fortran/robodoc.rc +++ b/fortran/robodoc.rc @@ -9,13 +9,11 @@ items: AUTHOR CREATION DATE MODIFICATION HISTORY - HISTORY - INPUTS + HISTORY ARGUMENTS OPTIONS PARAMETERS SWITCHES - OUTPUTS SIDE EFFECTS RESULT RETURN VALUE @@ -41,12 +39,77 @@ items: USED BY PARENTS COMMANDS - SOURCE - CONTAINS SUBROUTINES + SOURCE + INPUTS + OUTPUTS OPTIONAL PARAMETERS + CONTAINS SUBROUTINES FILE + Fortran2003 Interface: + Fortran90 Interface: + Fortran2003 Derived Type: + Outputs: + Inputs: + Optional parameters: + Components: ignore items: + NAME COPYRIGHT + SYNOPSIS + USAGE + FUNCTION + DESCRIPTION + PURPOSE + AUTHOR + CREATION DATE + MODIFICATION HISTORY + HISTORY + ARGUMENTS + OPTIONS + PARAMETERS + SWITCHES + SIDE EFFECTS + RESULT + RETURN VALUE + EXAMPLE + NOTES + DIAGNOSTICS + WARNINGS + ERRORS + BUGS + TODO + IDEAS + PORTABILITY + SEE ALSO + METHODS + NEW METHODS + ATTRIBUTES + NEW ATTRIBUTES + TAGS + DERIVED FROM + DERIVED BY + USES + CHILDREN + USED BY + PARENTS + COMMANDS + CONTAINS SUBROUTINES + FILE +item order: + Fortran90 Interface: + Fortran2003 Interface: + Inputs: + Outputs: + Optional parameters: + Fortran2003 Derived Type: + Components: +source items: + Fortran90 Interface: + Fortran2003 Interface: + Fortran2003 Derived Type: + SOURCE + + headertypes: s Subroutines robo_subroutines options: @@ -60,14 +123,19 @@ options: --sections --sectionnameonly --documenttitle "HDF5 FORTRAN Developer's Guide" - --cmode + --footless + --headless + --one_file_per_header ignore files: .svn *~ *.o *e *.mod -accept files: + *_F90.f90 *.c +accept files: + *_F03.f90 + *_F90.f90 *.f90 *.h diff --git a/fortran/src/H5FDmpiof.c b/fortran/src/H5FDmpiof.c index 89b4180..993b5ac 100644 --- a/fortran/src/H5FDmpiof.c +++ b/fortran/src/H5FDmpiof.c @@ -300,3 +300,40 @@ nh5pget_fapl_mpiposix_c(hid_t_f *prp_id, int_f* comm, int_f* flag) ret_value = 0; return ret_value; } + +/****if* H5Pf/h5pget_mpio_actual_io_mode_c + * NAME + * h5pget_mpio_actual_io_mode_c + * PURPOSE + * Calls H5Pget_mpio_actual_io_mode + * + * INPUTS + * dxpl_id - Dataset transfer property list identifier. + * OUTPUTS + * actual_io_mode - The type of I/O performed by this process. + * + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * July 27, 2012 + * SOURCE +*/ +int_f +nh5pget_mpio_actual_io_mode_c(hid_t_f *dxpl_id, int_f *actual_io_mode) +/******/ +{ + int ret_value = -1; + H5D_mpio_actual_io_mode_t c_actual_io_mode; + + /* + * Call H5Pget_mpio_actual_io_mode_f function. + */ + if( (H5Pget_mpio_actual_io_mode((hid_t)*dxpl_id, &c_actual_io_mode)) <0 ) + return ret_value; /* error occurred */ + + *actual_io_mode =(int_f)c_actual_io_mode; + + ret_value = 0; + return ret_value; +} diff --git a/fortran/src/H5FDmpioff.f90 b/fortran/src/H5FDmpioff.f90 index ea9283c..d9faef3 100644 --- a/fortran/src/H5FDmpioff.f90 +++ b/fortran/src/H5FDmpioff.f90 @@ -174,24 +174,23 @@ CONTAINS ! access property list. ! ! INPUTS -! prp_id - file access property list identifier -! comm - MPI-2 communicator -! use_gpfs - logical flag to use the GPFS hints +! prp_id - File access property list identifier. +! comm - MPI-2 communicator. +! use_gpfs - Logical flag to use the GPFS hints. ! OUTPUTS -! hdferr - Returns 0 if successful and -1 if fails +! hdferr - Returns 0 if successful and -1 if fails. ! ! AUTHOR ! Elena Pourmal ! May 6, 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pset_fapl_mpiposix_f(prp_id, comm, use_gpfs, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER, INTENT(IN) :: comm ! MPI communicator to be used for file open - ! as defined in MPI_FILE_OPEN of MPI-2 - LOGICAL, INTENT(IN) :: use_gpfs - INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER, INTENT(IN) :: comm + LOGICAL, INTENT(IN) :: use_gpfs + INTEGER, INTENT(OUT) :: hdferr !***** INTEGER :: flag INTEGER, EXTERNAL :: h5pset_fapl_mpiposix_c @@ -209,22 +208,22 @@ CONTAINS ! Returns MPI communicator information. ! ! INPUTS -! prp_id - file access property list identifier +! prp_id - File access property list identifier. ! OUTPUTS -! comm - MPI-2 communicator -! use_gpfs - flag to use GPFS hints -! hdferr - Returns 0 if successful and -1 if fails +! comm - MPI-2 communicator. +! use_gpfs - Flag to use GPFS hints. +! hdferr - Returns 0 if successful and -1 if fails. ! AUTHOR ! Elena Pourmal ! May 6, 2003 ! -! SOURCE +! Fortran90 Interface: SUBROUTINE h5pget_fapl_mpiposix_f(prp_id, comm, use_gpfs, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER, INTENT(OUT) :: comm ! Buffer to return communicator - LOGICAL, INTENT(OUT) :: use_gpfs - INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER, INTENT(OUT) :: comm + LOGICAL, INTENT(OUT) :: use_gpfs + INTEGER, INTENT(OUT) :: hdferr !***** INTEGER :: flag @@ -234,4 +233,49 @@ CONTAINS IF (flag .EQ. 1) use_gpfs = .TRUE. END SUBROUTINE h5pget_fapl_mpiposix_f + +!****s* H5P/h5pget_mpio_actual_io_mode_f +! NAME +! h5pget_mpio_actual_io_mode_f +! +! PURPOSE +! Retrieves the type of I/O that HDF5 actually performed on the last +! parallel I/O call. This is not necessarily the type of I/O requested. +! +! INPUTS +! dxpl_id - Dataset transfer property list identifier. +! OUTPUTS +! actual_io_mode - The type of I/O performed by this process. +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! July 27, 2012 +! +! HISTORY +! +! Fortran90 Interface: + SUBROUTINE h5pget_mpio_actual_io_mode_f(dxpl_id, actual_io_mode, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dxpl_id + INTEGER , INTENT(OUT) :: actual_io_mode + INTEGER , INTENT(OUT) :: hdferr +!***** + INTERFACE + INTEGER FUNCTION h5pget_mpio_actual_io_mode_c(dxpl_id, actual_io_mode) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5PGET_MPIO_ACTUAL_IO_MODE_C'::h5pget_mpio_actual_io_mode_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: dxpl_id + INTEGER , INTENT(OUT) :: actual_io_mode + END FUNCTION h5pget_mpio_actual_io_mode_c + END INTERFACE + + actual_io_mode = -1 + + hdferr = h5pget_mpio_actual_io_mode_c(dxpl_id, actual_io_mode) + + END SUBROUTINE h5pget_mpio_actual_io_mode_f + END MODULE H5FDMPIO diff --git a/fortran/src/H5Gff.f90 b/fortran/src/H5Gff.f90 index 6bcee7c..155185a 100644 --- a/fortran/src/H5Gff.f90 +++ b/fortran/src/H5Gff.f90 @@ -927,7 +927,7 @@ CONTAINS ! Buffer to hold a comment INTEGER, INTENT(OUT) :: hdferr ! Error code !***** - INTEGER :: namelen ! Lenghth of the current_name string + INTEGER :: namelen ! Length of the current_name string INTERFACE INTEGER FUNCTION h5gget_comment_c(loc_id, name, namelen, size, buffer) diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c index 531f09c..8e75989 100644 --- a/fortran/src/H5Of.c +++ b/fortran/src/H5Of.c @@ -24,6 +24,83 @@ #include "H5f90.h" #include "H5Eprivate.h" +int_f +fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info) { + + struct tm *ts; + + object_info->fileno = Oinfo.fileno; + object_info->addr = (haddr_t_f)Oinfo.addr; + + object_info->type = (int_f)Oinfo.type; + object_info->rc = (int_f)Oinfo.rc; + + ts = HDgmtime(&Oinfo.atime); + + object_info->atime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */ + object_info->atime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */ + object_info->atime[2] = (int_f)ts->tm_mday; + object_info->atime[3] = 0; /* time is expressed as UTC (or GMT timezone) */ + object_info->atime[4] = (int_f)ts->tm_hour; + object_info->atime[5] = (int_f)ts->tm_min; + object_info->atime[6] = (int_f)ts->tm_sec; + object_info->atime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */ + + ts = HDgmtime(&Oinfo.btime); + + object_info->btime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */ + object_info->btime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */ + object_info->btime[2] = (int_f)ts->tm_mday; + object_info->btime[3] = 0; /* time is expressed as UTC (or GMT timezone) */ + object_info->btime[4] = (int_f)ts->tm_hour; + object_info->btime[5] = (int_f)ts->tm_min; + object_info->btime[6] = (int_f)ts->tm_sec; + object_info->btime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */ + + ts = HDgmtime(&Oinfo.ctime); + + object_info->ctime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */ + object_info->ctime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */ + object_info->ctime[2] = (int_f)ts->tm_mday; + object_info->ctime[3] = 0; /* time is expressed as UTC (or GMT timezone) */ + object_info->ctime[4] = (int_f)ts->tm_hour; + object_info->ctime[5] = (int_f)ts->tm_min; + object_info->ctime[6] = (int_f)ts->tm_sec; + object_info->ctime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */ + + ts = HDgmtime(&Oinfo.mtime); + + object_info->mtime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */ + object_info->mtime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */ + object_info->mtime[2] = (int_f)ts->tm_mday; + object_info->mtime[3] = 0; /* time is expressed as UTC (or GMT timezone) */ + object_info->mtime[4] = (int_f)ts->tm_hour; + object_info->mtime[5] = (int_f)ts->tm_min; + object_info->mtime[6] = (int_f)ts->tm_sec; + object_info->mtime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */ + + object_info->num_attrs = (hsize_t_f)Oinfo.num_attrs; + + object_info->hdr.version = (int_f)Oinfo.hdr.version; + object_info->hdr.nmesgs = (int_f)Oinfo.hdr.nmesgs; + object_info->hdr.nchunks = (int_f)Oinfo.hdr.nchunks; + object_info->hdr.flags = (int_f)Oinfo.hdr.flags; + + object_info->hdr.space.total = (hsize_t_f)Oinfo.hdr.space.total; + object_info->hdr.space.meta = (hsize_t_f)Oinfo.hdr.space.meta; + object_info->hdr.space.mesg = (hsize_t_f)Oinfo.hdr.space.mesg; + object_info->hdr.space.free = (hsize_t_f)Oinfo.hdr.space.free; + + object_info->hdr.mesg.present = Oinfo.hdr.mesg.present; + object_info->hdr.mesg.shared = Oinfo.hdr.mesg.shared; + + object_info->meta_size.obj.index_size = (hsize_t_f)Oinfo.meta_size.obj.index_size; + object_info->meta_size.obj.heap_size = (hsize_t_f)Oinfo.meta_size.obj.heap_size; + + return 0; + +} + /****if* H5Of/h5olink_c * NAME * h5olink_c @@ -215,7 +292,7 @@ nh5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id) return ret_value; } -/* ***if* H5Of/H5Oget_info_by_name_c +/****if* H5Of/H5Oget_info_by_name_c * NAME * H5Oget_info_by_name_c * PURPOSE @@ -226,10 +303,7 @@ nh5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id) * namelen - Name length. * lapl_id - Link access property list. * OUTPUTS - * corder_valid - Indicates whether the the creation order data is valid for this attribute. - * corder - Is a positive integer containing the creation order of the attribute. - * cset - Indicates the character set used for the attribute’s name. - * data_size - indicates the size, in the number of characters, of the attribute. + * object_info - Buffer in which to return object information. * * RETURNS * 0 on success, -1 on failure @@ -261,74 +335,100 @@ nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f * &Oinfo, (hid_t)*lapl_id) < 0) HGOTO_DONE(FAIL); - object_info->fileno = Oinfo.fileno; - object_info->addr = (haddr_t_f)Oinfo.addr; - - - object_info->type = (int_f)Oinfo.type; - object_info->rc = (int_f)Oinfo.rc; - - ts = HDgmtime(&Oinfo.atime); - - object_info->atime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */ - object_info->atime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */ - object_info->atime[2] = (int_f)ts->tm_mday; - object_info->atime[3] = 0; /* time is expressed as UTC (or GMT timezone) */ - object_info->atime[4] = (int_f)ts->tm_hour; - object_info->atime[5] = (int_f)ts->tm_min; - object_info->atime[6] = (int_f)ts->tm_sec; - object_info->atime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */ - - ts = HDgmtime(&Oinfo.btime); - - object_info->btime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */ - object_info->btime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */ - object_info->btime[2] = (int_f)ts->tm_mday; - object_info->btime[3] = 0; /* time is expressed as UTC (or GMT timezone) */ - object_info->btime[4] = (int_f)ts->tm_hour; - object_info->btime[5] = (int_f)ts->tm_min; - object_info->btime[6] = (int_f)ts->tm_sec; - object_info->btime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */ + ret_value = fill_h5o_info_t_f(Oinfo,object_info); - ts = HDgmtime(&Oinfo.ctime); - - object_info->ctime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */ - object_info->ctime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */ - object_info->ctime[2] = (int_f)ts->tm_mday; - object_info->ctime[3] = 0; /* time is expressed as UTC (or GMT timezone) */ - object_info->ctime[4] = (int_f)ts->tm_hour; - object_info->ctime[5] = (int_f)ts->tm_min; - object_info->ctime[6] = (int_f)ts->tm_sec; - object_info->ctime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */ + done: + if(c_name) + HDfree(c_name); + return ret_value; +} - ts = HDgmtime(&Oinfo.mtime); +/****if* H5Of/H5Oget_info_by_idx_c + * NAME + * H5Oget_info_by_idx_c + * PURPOSE + * Calls H5Oget_info_by_idx + * INPUTS + * loc_id - File or group identifier specifying location of group in which object is located. + * name - Name of group, relative to loc_id. + * namelen - Name length. + * lapl_id - Link access property list. + * OUTPUTS + * object_info - Buffer in which to return object information. + * + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * December 1, 2008 + * SOURCE +*/ +int_f +nh5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, + int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info) +/******/ +{ + char *c_group_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + H5O_info_t Oinfo; + H5_index_t c_index_field; + H5_iter_order_t c_order; + + /* + * Convert FORTRAN name to C name + */ + if((c_group_name = HD5f2cstring( group_name, (size_t)*namelen)) == NULL) + HGOTO_DONE(FAIL); - object_info->mtime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */ - object_info->mtime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */ - object_info->mtime[2] = (int_f)ts->tm_mday; - object_info->mtime[3] = 0; /* time is expressed as UTC (or GMT timezone) */ - object_info->mtime[4] = (int_f)ts->tm_hour; - object_info->mtime[5] = (int_f)ts->tm_min; - object_info->mtime[6] = (int_f)ts->tm_sec; - object_info->mtime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */ + c_index_field = (H5_index_t)*index_field; + c_order = (H5_iter_order_t)*order; - object_info->num_attrs = (hsize_t_f)Oinfo.num_attrs; + /* + * Call H5Oinfo_by_idx function. + */ + if(H5Oget_info_by_idx((hid_t)*loc_id, c_group_name, c_index_field, c_order, (hsize_t)*n, + &Oinfo, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); - object_info->hdr.version = (int_f)Oinfo.hdr.version; - object_info->hdr.nmesgs = (int_f)Oinfo.hdr.nmesgs; - object_info->hdr.nchunks = (int_f)Oinfo.hdr.nchunks; - object_info->hdr.flags = (int_f)Oinfo.hdr.flags; + ret_value = fill_h5o_info_t_f(Oinfo,object_info); - object_info->hdr.space.total = (hsize_t_f)Oinfo.hdr.space.total; - object_info->hdr.space.meta = (hsize_t_f)Oinfo.hdr.space.meta; - object_info->hdr.space.mesg = (hsize_t_f)Oinfo.hdr.space.mesg; - object_info->hdr.space.free = (hsize_t_f)Oinfo.hdr.space.free; + done: + if(c_group_name) + HDfree(c_group_name); + return ret_value; +} - object_info->hdr.mesg.present = Oinfo.hdr.mesg.present; - object_info->hdr.mesg.shared = Oinfo.hdr.mesg.shared; +/****if* H5Of/H5Oget_info_c + * NAME + * H5Oget_info_c + * PURPOSE + * Calls H5Oget_info + * INPUTS + * object_id - Identifier for target object. + * OUTPUTS + * object_info - Buffer in which to return object information. + * + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * May 16, 2012 + * SOURCE +*/ +int_f +nh5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info) +/******/ +{ + int_f ret_value = 0; /* Return value */ + H5O_info_t Oinfo; + + /* + * Call H5Oinfo_by_name function. + */ + if(H5Oget_info((hid_t)*object_id, &Oinfo) < 0) + HGOTO_DONE(FAIL); - object_info->meta_size.obj.index_size = (hsize_t_f)Oinfo.meta_size.obj.index_size; - object_info->meta_size.obj.heap_size = (hsize_t_f)Oinfo.meta_size.obj.heap_size; + ret_value = fill_h5o_info_t_f(Oinfo,object_info); done: return ret_value; @@ -391,3 +491,428 @@ nh5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, return ret_value; } + +/****if* H5Of/h5ovisit_by_name_c + * NAME + * h5ovisit_by_name_c + * PURPOSE + * Calls H5Ovisit_by_name + * INPUTS + * object_id - Identifier specifying subject group + * index_type - Type of index which determines the order + * order - Order within index + * idx - Iteration position at which to start + * op - Callback function passing data regarding the link to the calling application + * op_data - User-defined pointer to data required by the application for its processing of the link + * + * OUTPUTS + * idx - Position at which an interrupted iteration may be restarted + * + * RETURNS + * >0 on success, 0< on failure + * AUTHOR + * M. Scot Breitenfeld + * May 16, 2012 + * SOURCE +*/ +int_f +nh5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f *index_type, int_f *order, + H5O_iterate_t op, void *op_data, hid_t_f *lapl_id ) +/******/ +{ + int_f ret_value = -1; /* Return value */ + herr_t func_ret_value; /* H5Linterate return value */ + char *c_object_name = NULL; /* Buffer to hold C string */ + + + /* + * Convert FORTRAN name to C name + */ + if( (c_object_name = HD5f2cstring(object_name, (size_t)*namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Ovisit + */ + func_ret_value = H5Ovisit_by_name( (hid_t)*loc_id, c_object_name, (H5_index_t)*index_type, (H5_iter_order_t)*order, + op, op_data, (hid_t)*lapl_id); + ret_value = (int_f)func_ret_value; + + done: + if(c_object_name) + HDfree(c_object_name); + return ret_value; + +} + +/****if* H5Of/h5odecr_refcount_c + * NAME + * h5odecr_refcount_c + * PURPOSE + * Calls H5Odecr_refcount + * INPUTS + * object_id - Object identifier. + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * May 16, 2012 + * SOURCE +*/ +int_f +nh5odecr_refcount_c (hid_t_f *object_id) +/******/ +{ + int_f ret_value = 0; /* Return value */ + + /* + * Call H5Odecr_refcount function. + */ + if((hid_t_f)H5Odecr_refcount((hid_t)*object_id) < 0) + HGOTO_DONE(FAIL); + + done: + return ret_value; +} + +/****if* H5Of/h5oexists_by_name_c + * NAME + * h5oexists_by_name_c + * PURPOSE + * Calls H5Oexists_by_name + * INPUTS + * loc_id - File or group identifier + * name - Attribute access property list + * namelen - Size of name + * lapl_id - Link access property list + * + * RETURNS + * link status: 0 = false, 1 = true, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * May 17, 2012 + * SOURCE +*/ +int_f +nh5oexists_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id) +/******/ +{ + char *c_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + htri_t status = 0; + + /* + * Convert FORTRAN name to C name + */ + if((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Oopen function. + */ + if((ret_value = (int_f)H5Oexists_by_name((hid_t)*loc_id, c_name, (hid_t)*lapl_id)) < 0) + HGOTO_DONE(FAIL); + + done: + if(c_name) + HDfree(c_name); + return ret_value; +} + +/****if* H5Of/h5oincr_refcount_c + * NAME + * h5oincr_refcount_c + * PURPOSE + * Calls H5Oincr_refcount + * INPUTS + * object_id - Object identifier. + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * May 16, 2012 + * SOURCE +*/ +int_f +nh5oincr_refcount_c (hid_t_f *object_id) +/******/ +{ + int_f ret_value = 0; /* Return value */ + + /* + * Call H5Oincr_refcount function. + */ + if((hid_t_f)H5Oincr_refcount((hid_t)*object_id) < 0) + HGOTO_DONE(FAIL); + + done: + return ret_value; +} + +/****if* H5Of/h5oset_comment_c + * NAME + * h5oset_comment_c + * PURPOSE + * Calls H5Oset_comment + * INPUTS + * object_id - Identifier of the target object. + * comment - The new comment. + * commentlen - Length of the comment. + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * May 17, 2012 + * SOURCE +*/ +int_f +nh5oset_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentlen) +/******/ +{ + char *c_comment = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN string to C string + */ + if((c_comment = HD5f2cstring(comment, (size_t)*commentlen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Oset_comment function. + */ + if((hid_t_f)H5Oset_comment((hid_t)*object_id, c_comment) < 0) + HGOTO_DONE(FAIL); + + done: + if(c_comment) + HDfree(c_comment); + return ret_value; +} + +/****if* H5Of/h5oset_comment_by_name_c + * NAME + * h5oset_comment_by_name_c + * PURPOSE + * Calls H5Oset_comment_by_name + * INPUTS + * object_id - Identifier of the target object. + * name - Name of the object whose comment is to be set or reset, + * specified as a path relative to loc_id. + * namelen - Length of the name. + * comment - The new comment. + * commentlen - Length of the comment. + * lapl_id - Link access property list identifier. + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * May 17, 2012 + * SOURCE +*/ +int_f +nh5oset_comment_by_name_c (hid_t_f *object_id, _fcd name, size_t_f *namelen, _fcd comment, size_t_f *commentlen, hid_t_f *lapl_id) +/******/ +{ + char *c_comment = NULL; /* Buffer to hold C string */ + char *c_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN string to C string + */ + if((c_comment = HD5f2cstring(comment, (size_t)*commentlen)) == NULL) + HGOTO_DONE(FAIL); + /* + * Convert FORTRAN string to C string + */ + if((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Oset_comment_by_name function. + */ + if((hid_t_f)H5Oset_comment_by_name((hid_t)*object_id, c_name, c_comment, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + + done: + if(c_name) + HDfree(c_name); + if(c_comment) + HDfree(c_comment); + return ret_value; +} +/****if* H5Of/h5oopen_by_idx_c + * NAME + * h5oopen_by_idx_c + * PURPOSE + * Calls H5Oopen_by_idx_c + * INPUTS + * loc_id - A file or group identifier. + * group_name - Name of group, relative to loc_id, in which object is located. + * group_namelen - Length of group_name + * index_type - Type of index by which objects are ordered. + * order - Order of iteration within index. + * n - Object to open. + * lapl_id - Link access property list. + * OUTPUTS + * obj_id - An object identifier for the opened object. + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * May 17, 2012 + * SOURCE +*/ +int_f +nh5oopen_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id) +/******/ +{ + char *c_group_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; + H5_index_t c_index_type; + H5_iter_order_t c_order; + + /* + * Convert FORTRAN string to C string + */ + if((c_group_name = HD5f2cstring( group_name, (size_t)*group_namelen)) == NULL) + HGOTO_DONE(FAIL); + + c_index_type = (H5_index_t)*index_type; + c_order = (H5_iter_order_t)*order; + + /* + * Call H5Oopen_by_idx function. + */ + if((*obj_id =(hid_t_f)H5Oopen_by_idx((hid_t)*loc_id, c_group_name, c_index_type, c_order, (hsize_t)*n, (hid_t)*lapl_id)) < 0) + HGOTO_DONE(FAIL); + + done: + if(c_group_name) + HDfree(c_group_name); + return ret_value; +} + +/****if* H5Of/h5oget_comment_c + * NAME + * h5oget_comment_c + * PURPOSE + * Calls H5Oget_comment + * INPUTS + * object_id - Identifier for the target object. + * bufsize - Anticipated required size of the comment buffer. + * OUTPUTS + * comment - The comment. + * + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * June 24, 2012 + * SOURCE +*/ +int_f +nh5oget_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentsize, hssize_t_f *bufsize) +/******/ +{ + char *c_comment = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + size_t c_commentsize; + + c_commentsize = (size_t)*commentsize + 1; + + /* + * Allocate buffer to hold comment name + */ + + if(NULL == (c_comment = (char *)HDmalloc(c_commentsize))) + HGOTO_DONE(FAIL); + + /* + * Call H5Oget_comment function. + */ + + if((*bufsize = (hssize_t_f)H5Oget_comment((hid_t)*object_id, c_comment, (size_t)*commentsize)) < 0) + HGOTO_DONE(FAIL); + + /* + * Convert C name to FORTRAN and place it in the given buffer + */ + if(c_comment) + HD5packFstring(c_comment, _fcdtocp(comment), c_commentsize - 1); + return ret_value; + + done: + if(c_comment) + HDfree(c_comment); + + return ret_value; +} + +/****if* H5Of/h5oget_comment_by_name_c + * NAME + * h5oget_comment_by_name_c + * PURPOSE + * Calls H5Oget_comment_by_name + * INPUTS + * object_id - Identifier for the target object. + * bufsize - Anticipated required size of the comment buffer. + * OUTPUTS + * comment - The comment. + * + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * July 6, 2012 + * SOURCE +*/ +int_f +nh5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size, + _fcd comment, size_t_f *commentsize, size_t_f *bufsize, hid_t_f *lapl_id) +/******/ +{ + char *c_comment = NULL; /* Buffer to hold C string */ + char *c_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + size_t c_commentsize; + + /* + * Convert FORTRAN string to C string + */ + if((c_name = HD5f2cstring(name, (size_t)*name_size)) == NULL) + HGOTO_DONE(FAIL); + + c_commentsize = (size_t)*commentsize + 1; + + /* + * Allocate buffer to hold comment name + */ + + if(NULL == (c_comment = (char *)HDmalloc(c_commentsize))) + HGOTO_DONE(FAIL); + + /* + * Call H5Oget_comment_by_name function. + */ + + if((*bufsize = (size_t_f)H5Oget_comment_by_name((hid_t)*loc_id, c_name, c_comment, (size_t)*commentsize,(hid_t)*lapl_id )) < 0) + HGOTO_DONE(FAIL); + + /* + * Convert C name to FORTRAN and place it in the given buffer + */ + if(c_comment) + HD5packFstring(c_comment, _fcdtocp(comment), c_commentsize - 1); + return ret_value; + + done: + if(c_comment) + HDfree(c_comment); + if(c_name) + HDfree(c_name); + + return ret_value; +} diff --git a/fortran/src/H5Off.f90 b/fortran/src/H5Off.f90 index 4f1ea18..ce8c55c 100644 --- a/fortran/src/H5Off.f90 +++ b/fortran/src/H5Off.f90 @@ -119,15 +119,15 @@ CONTAINS ! Opens an object in an HDF5 file by location identifier and path name. ! ! Inputs: -! loc_id - File or group identifier. -! name - Path to the object, relative to loc_id. +! loc_id - File or group identifier. +! name - Path to the object, relative to loc_id. ! ! Outputs: -! obj_id - Object identifier for the opened object. -! hdferr - Returns 0 if successful and -1 if fails. +! obj_id - Object identifier for the opened object. +! hdferr - Returns 0 if successful and -1 if fails. ! ! Optional parameters: -! lapl_id - Access property list identifier for the link pointing to the object. +! lapl_id - Access property list identifier for the link pointing to the object. ! ! AUTHOR ! M. Scot Breitenfeld @@ -215,12 +215,12 @@ CONTAINS ! Opens an object using its address within an HDF5 file. ! ! Inputs: -! loc_id - File or group identifier. -! addr - Object’s address in the file. +! loc_id - File or group identifier. +! addr - Object’s address in the file. ! ! Outputs: -! obj_id - Object identifier for the opened object. -! hdferr - Returns 0 if successful and -1 if fails. +! obj_id - Object identifier for the opened object. +! hdferr - Returns 0 if successful and -1 if fails. ! ! AUTHOR ! M. Scot Breitenfeld @@ -321,5 +321,455 @@ CONTAINS END SUBROUTINE h5ocopy_f +!****s* H5O/h5odecr_refcount_f +! NAME +! h5odecr_refcount_f +! +! PURPOSE +! Decrements an object reference count. +! +! Inputs: +! object_id - Object identifier. +! +! Outputs: +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! May 11, 2012 +! +! Fortran90 Interface: + SUBROUTINE h5odecr_refcount_f(object_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: object_id + INTEGER , INTENT(OUT) :: hdferr +!***** + + INTERFACE + INTEGER FUNCTION h5odecr_refcount_c(object_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5ODECR_REFCOUNT_C'::h5odecr_refcount_c + !DEC$ENDIF + INTEGER(HID_T) , INTENT(IN) :: object_id + END FUNCTION h5odecr_refcount_c + END INTERFACE + + hdferr = h5odecr_refcount_c(object_id) + + END SUBROUTINE h5odecr_refcount_f + +!****s* H5O/h5oexists_by_name_f +! NAME +! h5oexists_by_name_f +! +! PURPOSE +! Determines whether a link resolves to an actual object. +! +! Inputs: +! loc_id - Identifier of the file or group to query. +! name - The name of the link to check. +! +! +! Optional parameters: +! lapl_id - Link access property list identifier. +! +! Outputs: +! link_exists - Existing link resolves to an object. +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! May 11, 2012 +! +! Fortran90 Interface: + SUBROUTINE h5oexists_by_name_f(loc_id, name, link_exists, hdferr, lapl_id) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + LOGICAL , INTENT(OUT) :: link_exists + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lapl_id +!***** + + INTEGER(size_t) :: namelen + INTEGER :: status + INTEGER(HID_T) :: lapl_id_default + + INTERFACE + INTEGER FUNCTION h5oexists_by_name_c(loc_id, name, namelen, lapl_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OEXISTS_BY_NAME_C'::h5oexists_by_name_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(SIZE_T) , INTENT(IN) :: namelen + INTEGER(HID_T) , INTENT(IN) :: lapl_id + + END FUNCTION h5oexists_by_name_c + END INTERFACE + + namelen = LEN(name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + status = h5oexists_by_name_c(loc_id, name, namelen, lapl_id_default) + + link_exists = .FALSE. + IF(status.EQ.1)THEN + link_exists = .TRUE. + ENDIF + + hdferr = 0 + IF(status.LT.0)THEN + hdferr = -1 + ENDIF + + END SUBROUTINE h5oexists_by_name_f + +!****s* H5O/h5oget_comment_f +! NAME +! h5oget_comment_f +! +! PURPOSE +! Retrieves comment for specified object. +! +! Inputs: +! obj_id - Identifier for the target object. +! +! Optional parameters: +! bufsize - Size of the comment buffer. +! +! Outputs: +! comment - The comment. +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! May 11, 2012 +! +! Fortran90 Interface: + SUBROUTINE h5oget_comment_f(obj_id, comment, hdferr, bufsize) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: obj_id + CHARACTER(LEN=*) , INTENT(OUT) :: comment + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HSSIZE_T), INTENT(OUT), OPTIONAL :: bufsize +!***** + + INTEGER(SIZE_T) :: commentsize_default + INTEGER(HSSIZE_T) :: bufsize_default + + INTERFACE + INTEGER FUNCTION h5oget_comment_c(obj_id, comment, commentsize_default, bufsize) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OGET_COMMENT_C'::h5oget_comment_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: comment + INTEGER(HID_T) , INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(OUT) :: comment + INTEGER(SIZE_T) , INTENT(IN) :: commentsize_default + INTEGER(HSSIZE_T) , INTENT(OUT) :: bufsize + END FUNCTION h5oget_comment_c + END INTERFACE + + commentsize_default = LEN(comment) + + hdferr = h5oget_comment_c(obj_id, comment, commentsize_default, bufsize_default) + + IF(PRESENT(bufsize)) bufsize = bufsize_default + + END SUBROUTINE h5oget_comment_f + +!****s* H5O/h5oget_comment_by_name_f +! NAME +! h5oget_comment_by_name_f +! +! PURPOSE +! Retrieves comment for specified object. +! +! Inputs: +! loc_id - Identifier of a file, group, dataset, or named datatype. +! name - Name of the object whose comment is to be retrieved, +! specified as a path relative to loc_id. +! +! Optional parameters: +! bufsize - Size of the comment buffer. +! +! Outputs: +! comment - The comment. +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! July 6, 2012 +! +! Fortran90 Interface: + SUBROUTINE h5oget_comment_by_name_f(loc_id, name, comment, hdferr, bufsize, lapl_id) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + CHARACTER(LEN=*), INTENT(OUT) :: comment + INTEGER , INTENT(OUT) :: hdferr + INTEGER(SIZE_T) , INTENT(OUT), OPTIONAL :: bufsize + INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id +!***** + + INTEGER(SIZE_T) :: commentsize_default + INTEGER(SIZE_T) :: name_size + INTEGER(SIZE_T) :: bufsize_default + INTEGER(HID_T) :: lapl_id_default + INTERFACE + INTEGER FUNCTION h5oget_comment_by_name_c(loc_id, name, name_size, & + comment, commentsize_default, bufsize_default, lapl_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OGET_COMMENT_BY_NAME_C'::h5oget_comment_by_name_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: comment, name + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(SIZE_T) , INTENT(IN) :: name_size + CHARACTER(LEN=*), INTENT(OUT) :: comment + INTEGER(SIZE_T) , INTENT(IN) :: commentsize_default + INTEGER(SIZE_T) , INTENT(OUT) :: bufsize_default + INTEGER(HID_T) , INTENT(IN) :: lapl_id + END FUNCTION h5oget_comment_by_name_c + END INTERFACE + + commentsize_default = LEN(comment) + name_size = LEN(name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5oget_comment_by_name_c(loc_id, name, name_size, & + comment, commentsize_default, bufsize_default, lapl_id_default) + + IF(PRESENT(bufsize)) bufsize = bufsize_default + + END SUBROUTINE h5oget_comment_by_name_f + +!****s* H5O/h5oincr_refcount_f +! NAME +! h5oincr_refcount_f +! +! PURPOSE +! Increments an object reference count. +! +! Inputs: +! obj_id - Object identifier. +! +! Outputs: +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! May 15, 2012 +! +! Fortran90 Interface: + SUBROUTINE h5oincr_refcount_f(obj_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id + INTEGER , INTENT(OUT) :: hdferr +!***** + + INTERFACE + INTEGER FUNCTION h5oincr_refcount_c(obj_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OINCR_REFCOUNT_C'::h5oincr_refcount_c + !DEC$ENDIF + INTEGER(HID_T) , INTENT(IN) :: obj_id + END FUNCTION h5oincr_refcount_c + END INTERFACE + + hdferr = h5oincr_refcount_c(obj_id) + + END SUBROUTINE h5oincr_refcount_f + +!****s* H5O/h5oopen_by_idx_f +! +! NAME +! h5oopen_by_idx_f +! +! PURPOSE +! Open the nth object in a group. +! +! Inputs: +! loc_id - A file or group identifier. +! group_name - Name of group, relative to loc_id, in which object is located. +! index_type - Type of index by which objects are ordered. +! order - Order of iteration within index, NOTE: zero-based. +! n - Object to open. +! +! Outputs: +! obj_id - An object identifier for the opened object. +! hdferr - Returns 0 if successful and -1 if fails. +! +! Optional parameters: +! lapl_id - Link access property list. +! +! AUTHOR +! M. Scot Breitenfeld +! May 17, 2012 +! +! Fortran90 Interface: + SUBROUTINE h5oopen_by_idx_f(loc_id, group_name, index_type, order, n, obj_id, & + hdferr, lapl_id) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER , INTENT(IN) :: index_type + INTEGER , INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T) , INTENT(OUT) :: obj_id + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id +!***** + INTEGER(SIZE_T) :: group_namelen + INTEGER(HID_T) :: lapl_id_default + + INTERFACE + INTEGER FUNCTION h5oopen_by_idx_c(loc_id, group_name, group_namelen, index_type, order, n, obj_id, lapl_id_default) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OOPEN_BY_IDX_C'::h5oopen_by_idx_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: group_name + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER(SIZE_T) , INTENT(IN) :: group_namelen + INTEGER , INTENT(IN) :: index_type + INTEGER , INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T) , INTENT(OUT) :: obj_id + INTEGER(HID_T) , INTENT(IN) :: lapl_id_default + + END FUNCTION h5oopen_by_idx_c + END INTERFACE + + group_namelen = LEN(group_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5oopen_by_idx_c(loc_id, group_name, group_namelen, index_type, order, n, obj_id, lapl_id_default) + + END SUBROUTINE H5Oopen_by_idx_f + +!****s* H5O/h5oset_comment_f +! NAME +! h5oset_comment_f +! +! PURPOSE +! Sets comment for specified object. +! +! Inputs: +! obj_id - Identifier of the target object. +! comment - The new comment. +! +! Outputs: +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! May 15, 2012 +! +! Fortran90 Interface: + SUBROUTINE h5oset_comment_f(obj_id, comment, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(IN) :: comment + INTEGER , INTENT(OUT) :: hdferr +!***** + INTEGER(SIZE_T) :: commentlen + + INTERFACE + INTEGER FUNCTION h5oset_comment_c(obj_id, comment, commentlen) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OSET_COMMENT_C'::h5oset_comment_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: comment + INTEGER(HID_T) , INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(IN) :: comment + INTEGER(SIZE_T) , INTENT(IN) :: commentlen + + END FUNCTION h5oset_comment_c + END INTERFACE + + commentlen = LEN(comment) + + hdferr = h5oset_comment_c(obj_id, comment, commentlen) + + END SUBROUTINE h5oset_comment_f + +!****s* H5O/h5oset_comment_by_name_f +! NAME +! h5oset_comment_by_name_f +! +! PURPOSE +! Sets comment for specified object. +! +! Inputs: +! loc_id - Identifier of a file, group, dataset, or named datatype. +! name - Name of the object whose comment is to be set or reset, +! specified as a path relative to loc_id. +! comment - The new comment. +! +! Outputs: +! hdferr - Returns 0 if successful and -1 if fails. +! +! Optional parameters: +! lapl_id - Link access property list identifier. +! +! AUTHOR +! M. Scot Breitenfeld +! May 15, 2012 +! +! Fortran90 Interface: + SUBROUTINE h5oset_comment_by_name_f(loc_id, name, comment, hdferr, lapl_id) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + CHARACTER(LEN=*), INTENT(IN) :: comment + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lapl_id +!***** + INTEGER(SIZE_T) :: commentlen + INTEGER(SIZE_T) :: namelen + INTEGER(HID_T) :: lapl_id_default + + INTERFACE + INTEGER FUNCTION h5oset_comment_by_name_c(loc_id, name, namelen, comment, commentlen, lapl_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OSET_COMMENT_BY_NAME_C'::h5oset_comment_by_name_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: name, comment + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: comment + INTEGER(SIZE_T) , INTENT(IN) :: commentlen + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(SIZE_T) , INTENT(IN) :: namelen + INTEGER(HID_T) , INTENT(IN) :: lapl_id + END FUNCTION h5oset_comment_by_name_c + END INTERFACE + + commentlen = LEN(comment) + namelen = LEN(name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5oset_comment_by_name_c(loc_id, name, namelen, comment, commentlen, lapl_id_default) + + END SUBROUTINE h5oset_comment_by_name_f + END MODULE H5O diff --git a/fortran/src/H5Off_F03.f90 b/fortran/src/H5Off_F03.f90 index 8eb7a4b..f4ddd3e 100644 --- a/fortran/src/H5Off_F03.f90 +++ b/fortran/src/H5Off_F03.f90 @@ -82,9 +82,9 @@ MODULE H5O_PROVISIONAL ENDTYPE meta_size_t TYPE, BIND(C) :: h5o_info_t - INTEGER(c_long) :: fileno ! File number that object is located in + INTEGER(C_LONG) :: fileno ! File number that object is located in INTEGER(haddr_t) :: addr ! Object address in file - INTEGER :: type ! Basic object type (group, dataset, etc.) + INTEGER(C_INT) :: type ! Basic object type (group, dataset, etc.) INTEGER :: rc ! Reference count of object INTEGER, DIMENSION(8) :: atime ! Access time ! -- NOTE -- @@ -181,14 +181,14 @@ CONTAINS ! Inputs: ! loc_id - File or group identifier specifying location of group ! in which object is located. -! name - Name of group, relative to loc_id +! name - Name of group, relative to loc_id. ! ! Outputs: -! object_info - Buffer in which to return object information -! hdferr - Returns 0 if successful and -1 if fails +! object_info - Buffer in which to return object information. +! hdferr - Returns 0 if successful and -1 if fails. ! ! Optional parameters: -! lapl_id - Link access property list +! lapl_id - Link access property list. ! ! AUTHOR ! M. Scot Breitenfeld @@ -218,11 +218,12 @@ CONTAINS !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OGET_INFO_BY_NAME_C'::h5oget_info_by_name_c !DEC$ENDIF + !DEC$ATTRIBUTES reference :: name INTEGER(HID_T) , INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: name INTEGER(SIZE_T) , INTENT(IN) :: namelen INTEGER(HID_T) , INTENT(IN) :: lapl_id_default - TYPE(C_PTR),value :: object_info + TYPE(C_PTR),VALUE :: object_info END FUNCTION h5oget_info_by_name_c END INTERFACE @@ -238,5 +239,222 @@ CONTAINS END SUBROUTINE H5Oget_info_by_name_f +!****s* H5O (F03)/h5oget_info_f_F03 +! +! NAME +! h5oget_info_f +! +! PURPOSE +! Retrieves the metadata for an object specified by an identifier. +! +! Inputs: +! object_id - Identifier for target object. +! +! Outputs: +! object_info - Buffer in which to return object information. +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! M. Scot Breitenfeld +! May 11, 2012 +! +! Fortran2003 Interface: + SUBROUTINE h5oget_info_f(object_id, object_info, hdferr) + + USE, INTRINSIC :: ISO_C_BINDING + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: object_id + TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info + INTEGER , INTENT(OUT) :: hdferr +!***** + TYPE(C_PTR) :: ptr + + INTERFACE + INTEGER FUNCTION h5oget_info_c(object_id, object_info) + USE H5GLOBAL + USE, INTRINSIC :: ISO_C_BINDING + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OGET_INFO_C'::h5oget_info_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: object_id + TYPE(C_PTR), VALUE :: object_info + + END FUNCTION h5oget_info_c + END INTERFACE + + ptr = C_LOC(object_info) + hdferr = H5Oget_info_c(object_id, ptr) + + END SUBROUTINE H5Oget_info_f + +!****s* H5O (F03)/h5oget_info_by_idx_f_F03 +! +! NAME +! h5oget_info_by_idx_f +! +! PURPOSE +! Retrieves the metadata for an object, identifying the object by an index position. +! +! Inputs: +! loc_id - File or group identifier specifying location of group +! in which object is located. +! group_name - Name of group in which object is located. +! index_field - Index or field that determines the order. +! order - Order within field or index. +! n - Object for which information is to be returned +! +! Outputs: +! object_info - Buffer in which to return object information. +! hdferr - Returns 0 if successful and -1 if fails. +! +! Optional parameters: +! lapl_id - Link access property list. (Not currently used.) +! +! AUTHOR +! M. Scot Breitenfeld +! May 11, 2012 +! +! Fortran2003 Interface: + SUBROUTINE h5oget_info_by_idx_f(loc_id, group_name, index_field, order, n, & + object_info, hdferr, lapl_id) + + USE, INTRINSIC :: ISO_C_BINDING + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER , INTENT(IN) :: index_field + INTEGER , INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id +!***** + INTEGER :: corder_valid + INTEGER(SIZE_T) :: namelen + INTEGER(HID_T) :: lapl_id_default + TYPE(C_PTR) :: ptr + + INTERFACE + INTEGER FUNCTION h5oget_info_by_idx_c(loc_id, group_name, namelen, & + index_field, order, n, lapl_id_default, object_info) + USE H5GLOBAL + USE, INTRINSIC :: ISO_C_BINDING + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OGET_INFO_BY_IDX_C'::h5oget_info_by_idx_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: group_name + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER(SIZE_T) , INTENT(IN) :: namelen + INTEGER , INTENT(IN) :: index_field + INTEGER , INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T) , INTENT(IN) :: lapl_id_default + TYPE(C_PTR), VALUE :: object_info + + END FUNCTION h5oget_info_by_idx_c + END INTERFACE + + namelen = LEN(group_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + ptr = C_LOC(object_info) + hdferr = H5Oget_info_by_idx_c(loc_id, group_name, namelen, index_field, order, n, lapl_id_default, ptr) + + END SUBROUTINE H5Oget_info_by_idx_f + + +!****s* H5O (F03)/h5ovisit_by_name_f_F03 +! +! NAME +! h5ovisit_by_name_f +! +! PURPOSE +! Recursively visits all objects starting from a specified object. +! +! Inputs: +! loc_id - Identifier of a file or group. +! object_name - Name of the object, generally relative to loc_id, that will serve as root of the iteration +! index_type - Type of index; valid values include: +! H5_INDEX_NAME_F +! H5_INDEX_CRT_ORDER_F +! order - Order in which index is traversed; valid values include: +! H5_ITER_DEC_F +! H5_ITER_INC_F +! H5_ITER_NATIVE_F +! op - Callback function passing data regarding the group to the calling application +! op_data - User-defined pointer to data required by the application for its processing of the group +! +! Outputs: +! return_value - Returns the return value of the first operator that returns a positive value, or +! zero if all members were processed with no operator returning non-zero. +! hdferr - Returns 0 if successful and -1 if fails +! +! Optional parameters: +! lapl_id - Link access property list identifier. +! +! AUTHOR +! M. Scot Breitenfeld +! November 19, 2008 +! +! Fortran2003 Interface: + SUBROUTINE h5ovisit_by_name_f(loc_id, object_name, index_type, order, op, op_data, & + return_value, hdferr, lapl_id) + USE, INTRINSIC :: ISO_C_BINDING + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: object_name + INTEGER , INTENT(IN) :: index_type + INTEGER , INTENT(IN) :: order + + TYPE(C_FUNPTR) :: op + TYPE(C_PTR) :: op_data + INTEGER , INTENT(OUT) :: return_value + INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id +!***** + + INTEGER(SIZE_T) :: namelen + INTEGER(HID_T) :: lapl_id_default + TYPE(C_PTR) :: ptr + + INTERFACE + INTEGER FUNCTION h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, & + op, op_data, lapl_id) + USE, INTRINSIC :: ISO_C_BINDING + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OVISIT_BY_NAME_C'::h5ovisit_by_name_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: object_name + INTEGER(HID_T) , INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: object_name + INTEGER(SIZE_T) :: namelen + INTEGER , INTENT(IN) :: index_type + INTEGER , INTENT(IN) :: order + TYPE(C_FUNPTR) , VALUE :: op + TYPE(C_PTR) , VALUE :: op_data + INTEGER(HID_T) , INTENT(IN) :: lapl_id + END FUNCTION h5ovisit_by_name_c + END INTERFACE + + namelen = LEN(object_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + return_value = h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, & + op, op_data, lapl_id_default) + + IF(return_value.GE.0)THEN + hdferr = 0 + ELSE + hdferr = -1 + END IF + + END SUBROUTINE h5ovisit_by_name_f + END MODULE H5O_PROVISIONAL diff --git a/fortran/src/H5Pff.f90 b/fortran/src/H5Pff.f90 index d50e3b9..4254b7f 100644 --- a/fortran/src/H5Pff.f90 +++ b/fortran/src/H5Pff.f90 @@ -6419,3 +6419,5 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) END MODULE H5P + + diff --git a/fortran/src/H5Rf.c b/fortran/src/H5Rf.c index 86e0e61..0799e11 100644 --- a/fortran/src/H5Rf.c +++ b/fortran/src/H5Rf.c @@ -331,6 +331,47 @@ done: return ret_value; } /* end nh5rget_region_region_c() */ +/****if* H5Rf/h5rget_region_ptr_c + * NAME + * h5rget_region_ptr_c + * PURPOSE + * Call H5Rget_region to dereference dataspace region + * INPUTS + * dset_id - dataset identifier + * ref - reference to the dataset region + * OUTPUTS + * space_id - dereferenced dataset dataspace identifier + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * August 4, 2012 + * HISTORY + * + * SOURCE +*/ +int_f +nh5rget_region_ptr_c(hid_t_f *dset_id, void *ref, hid_t_f *space_id) +/******/ +{ + hid_t c_space_id; + hdset_reg_ref_t ref_c; + int_f ret_value = 0; + + /* + * Call H5Rget_region function. + */ + if((c_space_id = H5Rget_region((hid_t)*dset_id, H5R_DATASET_REGION, ref)) < 0) + HGOTO_DONE(FAIL) + + /* Copy the dataspace ID */ + *space_id = (hid_t_f)c_space_id; + +done: + return ret_value; +} /* end nh5rget_region_ptr_c() */ + + /****if* H5Rf/h5rget_object_type_obj_c * NAME * h5rget_object_type_obj_c diff --git a/fortran/src/H5Rff.f90 b/fortran/src/H5Rff.f90 index 35a3ed6..89ffc10 100644 --- a/fortran/src/H5Rff.f90 +++ b/fortran/src/H5Rff.f90 @@ -53,12 +53,6 @@ MODULE H5R ! END TYPE ! - INTERFACE h5rget_region_f - - MODULE PROCEDURE h5rget_region_region_f - - END INTERFACE - INTERFACE h5rget_object_type_f MODULE PROCEDURE h5rget_object_type_obj_f @@ -67,61 +61,6 @@ MODULE H5R CONTAINS -!****s* H5R/h5rget_region_region_f -! -! NAME -! h5rget_region_region_f -! -! PURPOSE -! Retrieves a dataspace with the specified region selected -! -! INPUTS -! dset_id - identifier of the dataset containing -! reference to the regions -! ref - reference to open -! OUTPUTS -! space_id - dataspace identifier -! hdferr - Returns 0 if successful and -1 if fails -! AUTHOR -! Elena Pourmal -! August 12, 1999 -! -! HISTORY -! Explicit Fortran interfaces were added for -! called C functions (it is needed for Windows -! port). February 28, 2001 -! -! NOTES -! This is a module procedure for the h5rget_region_f subroutine. -! -! SOURCE - SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr) - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier - TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference - INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier - INTEGER, INTENT(OUT) :: hdferr ! Error code -!***** - INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference - - INTERFACE - INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id) - USE H5GLOBAL - !DEC$IF DEFINED(HDF5F90_WINDOWS) - !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c - !DEC$ENDIF - INTEGER(HID_T), INTENT(IN) :: dset_id - ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 - INTEGER :: ref_f(REF_REG_BUF_LEN) - INTEGER(HID_T), INTENT(OUT) :: space_id - END FUNCTION h5rget_region_region_c - END INTERFACE - - ref_f = ref%ref - hdferr = h5rget_region_region_c(dset_id, ref_f, space_id ) - - END SUBROUTINE h5rget_region_region_f - !****s* H5R/h5rget_object_type_obj_f ! ! NAME diff --git a/fortran/src/H5Rff_F03.f90 b/fortran/src/H5Rff_F03.f90 index 7f66745..88ec8cf 100644 --- a/fortran/src/H5Rff_F03.f90 +++ b/fortran/src/H5Rff_F03.f90 @@ -37,6 +37,7 @@ !***** MODULE H5R_PROVISIONAL USE H5GLOBAL + USE, INTRINSIC :: ISO_C_BINDING ! If you change the value of these parameters, do not forget to change corresponding ! values in the H5f90.h file. @@ -51,6 +52,19 @@ MODULE H5R_PROVISIONAL ! INTEGER ref(REF_REG_BUF_LEN) ! END TYPE ! + + TYPE :: hdset_reg_ref_t_f03 + INTEGER(C_SIGNED_CHAR), DIMENSION(1:H5R_DSET_REG_REF_BUF_SIZE_F) :: ref + END TYPE hdset_reg_ref_t_f03 + + INTERFACE h5rget_region_f + + MODULE PROCEDURE h5rget_region_region_f ! obsolete + MODULE PROCEDURE h5rget_region_ptr_f ! F2003 + + END INTERFACE + + INTERFACE h5rcreate_f MODULE PROCEDURE h5rcreate_object_f ! obsolete @@ -123,8 +137,114 @@ MODULE H5R_PROVISIONAL END FUNCTION h5rcreate_ptr_c END INTERFACE + INTERFACE + INTEGER FUNCTION h5rget_region_ptr_c(dset_id, ref, space_id) + USE, INTRINSIC :: ISO_C_BINDING + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_PTR_C':: h5rget_region_ptr_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: dset_id + TYPE(C_PTR), VALUE :: ref + INTEGER(HID_T), INTENT(OUT) :: space_id + END FUNCTION h5rget_region_ptr_c + END INTERFACE + CONTAINS +!****s* H5R/h5rget_region_region_f +! +! NAME +! h5rget_region_region_f +! +! PURPOSE +! Retrieves a dataspace with the specified region selected +! +! INPUTS +! dset_id - identifier of the dataset containing +! reference to the regions +! ref - reference to open +! OUTPUTS +! space_id - dataspace identifier +! hdferr - Returns 0 if successful and -1 if fails +! AUTHOR +! Elena Pourmal +! August 12, 1999 +! +! HISTORY +! Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). February 28, 2001 +! +! NOTES +! This is a module procedure for the h5rget_region_f subroutine. +! +! SOURCE + SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference + INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code +!***** + INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference + + INTERFACE + INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: dset_id + ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 + INTEGER :: ref_f(REF_REG_BUF_LEN) + INTEGER(HID_T), INTENT(OUT) :: space_id + END FUNCTION h5rget_region_region_c + END INTERFACE + + ref_f = ref%ref + hdferr = h5rget_region_region_c(dset_id, ref_f, space_id ) + + END SUBROUTINE h5rget_region_region_f + +!****s* H5R/h5rget_region_ptr_f +! +! NAME +! h5rget_region_ptr_f +! +! PURPOSE +! Retrieves a dataspace with the specified region +! selected using pointer +! +! INPUTS +! dset_id - identifier of the dataset containing +! reference to the regions +! ref - reference to open +! OUTPUTS +! space_id - dataspace identifier +! hdferr - Returns 0 if successful and -1 if fails +! AUTHOR +! M. Scot Breitenfeld +! August 4, 2012 +! +! NOTES +! This is a module procedure for the h5rget_region_f subroutine. +! +! SOURCE + SUBROUTINE h5rget_region_ptr_f(dset_id, ref, space_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + TYPE(C_PTR), INTENT(IN) :: ref ! Dataset region reference + INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code +!***** + INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference + + hdferr = h5rget_region_ptr_c(dset_id, ref, space_id ) + + END SUBROUTINE h5rget_region_ptr_f + + !****s* H5R (F03)/h5rcreate_object_f ! ! NAME @@ -175,7 +295,7 @@ CONTAINS END SUBROUTINE h5rcreate_object_f -!****s* H5R (F03)/h5rcreate_region_f +!****s* H5R (F90)/h5rcreate_region_f ! ! NAME ! h5rcreate_region_f @@ -183,16 +303,15 @@ CONTAINS ! PURPOSE ! Creates reference to the dataset region ! -! Inputs: +! INPUTS ! loc_id - location identifier ! name - name of the dataset at the specified location ! space_id - dataspace identifier that describes selected region -! Outputs: +! OUTPUTS ! ref - reference to the dataset region ! hdferr: - error code ! Success: 0 ! Failure: -1 -! ! AUTHOR ! Elena Pourmal ! August 12, 1999 @@ -205,46 +324,39 @@ CONTAINS ! NOTES ! This is a module procedure for the h5rcreate_f subroutine. ! -! Signature: +! SOURCE SUBROUTINE h5rcreate_region_f(loc_id, name, space_id, ref, hdferr) - USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id ! Location identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the dataset at location specified ! by loc_id identifier INTEGER(HID_T), INTENT(IN) :: space_id ! Dataset's dataspace identifier - TYPE(hdset_reg_ref_t_f), INTENT(INOUT), TARGET :: ref ! Dataset region reference + TYPE(hdset_reg_ref_t_f), INTENT(OUT) :: ref ! Dataset region reference INTEGER, INTENT(OUT) :: hdferr ! Error code !***** INTEGER :: namelen ! Name length INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference - TYPE(C_PTR) :: f_ptr - -! !$ INTERFACE -! !$ INTEGER FUNCTION h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id) -! !$ USE H5GLOBAL -! !$ !DEC$IF DEFINED(HDF5F90_WINDOWS) -! !$ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RCREATE_REGION_C':: h5rcreate_region_c -! !$ !DEC$ENDIF -! !$ !DEC$ATTRIBUTES reference :: name -! !$ ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 -! !$ INTEGER :: ref_f(REF_REG_BUF_LEN) -! !$ INTEGER(HID_T), INTENT(IN) :: loc_id -! !$ CHARACTER(LEN=*), INTENT(IN) :: name -! !$ INTEGER :: namelen -! !$ INTEGER(HID_T), INTENT(IN) :: space_id -! !$ END FUNCTION h5rcreate_region_c -! !$ END INTERFACE - - f_ptr = C_LOC(ref) + INTERFACE + INTEGER FUNCTION h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RCREATE_REGION_C':: h5rcreate_region_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: name + ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 + INTEGER :: ref_f(REF_REG_BUF_LEN) + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER :: namelen + INTEGER(HID_T), INTENT(IN) :: space_id + END FUNCTION h5rcreate_region_c + END INTERFACE namelen = LEN(name) - hdferr = h5rcreate_ptr_c(f_ptr, loc_id, name, namelen, 1, space_id) - -! !$ ref_f = 0 -! !$ hdferr = h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id ) -! !$ ref%ref = ref_f + ref_f = 0 + hdferr = h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id ) + ref%ref = ref_f END SUBROUTINE h5rcreate_region_f diff --git a/fortran/src/H5Rff_F90.f90 b/fortran/src/H5Rff_F90.f90 index 3f02825..0190e57 100644 --- a/fortran/src/H5Rff_F90.f90 +++ b/fortran/src/H5Rff_F90.f90 @@ -72,8 +72,73 @@ MODULE H5R_PROVISIONAL END INTERFACE + INTERFACE h5rget_region_f + + MODULE PROCEDURE h5rget_region_region_f + + END INTERFACE + + CONTAINS + +!****s* H5R/h5rget_region_region_f +! +! NAME +! h5rget_region_region_f +! +! PURPOSE +! Retrieves a dataspace with the specified region selected +! +! INPUTS +! dset_id - identifier of the dataset containing +! reference to the regions +! ref - reference to open +! OUTPUTS +! space_id - dataspace identifier +! hdferr - Returns 0 if successful and -1 if fails +! AUTHOR +! Elena Pourmal +! August 12, 1999 +! +! HISTORY +! Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). February 28, 2001 +! +! NOTES +! This is a module procedure for the h5rget_region_f subroutine. +! +! SOURCE + SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference + INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code +!***** + INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference + + INTERFACE + INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: dset_id + ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 + INTEGER :: ref_f(REF_REG_BUF_LEN) + INTEGER(HID_T), INTENT(OUT) :: space_id + END FUNCTION h5rget_region_region_c + END INTERFACE + + ref_f = ref%ref + hdferr = h5rget_region_region_c(dset_id, ref_f, space_id ) + + END SUBROUTINE h5rget_region_region_f + + + !****s* H5R (F90)/h5rcreate_object_f ! ! NAME diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index 7b55384..4c85df2 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -398,7 +398,11 @@ nh5init_flags_c( int_f *h5d_flags, int_f *h5e_flags, hid_t_f *h5e_hid_flags, int h5d_flags[19] = (int_f)H5D_CHUNK_CACHE_NSLOTS_DEFAULT; h5d_flags[20] = (int_f)H5D_CHUNK_CACHE_NBYTES_DEFAULT; h5d_flags[21] = (int_f)H5D_CHUNK_CACHE_W0_DEFAULT; - + h5d_flags[22] = (int_f)H5D_MPIO_NO_COLLECTIVE; + h5d_flags[23] = (int_f)H5D_MPIO_CHUNK_INDEPENDENT; + h5d_flags[24] = (int_f)H5D_MPIO_CHUNK_COLLECTIVE; + h5d_flags[25] = (int_f)H5D_MPIO_CHUNK_MIXED; + h5d_flags[26] = (int_f)H5D_MPIO_CONTIGUOUS_COLLECTIVE; /* * H5E flags */ diff --git a/fortran/src/H5f90global.f90 b/fortran/src/H5f90global.f90 index 6943270..1bef2f2 100644 --- a/fortran/src/H5f90global.f90 +++ b/fortran/src/H5f90global.f90 @@ -354,7 +354,7 @@ MODULE H5GLOBAL ! H5D flags declaration ! - INTEGER, PARAMETER :: H5D_FLAGS_LEN = 22 + INTEGER, PARAMETER :: H5D_FLAGS_LEN = 27 INTEGER H5D_flags(H5D_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) !DEC$ATTRIBUTES DLLEXPORT :: /H5D_FLAGS/ @@ -387,10 +387,17 @@ MODULE H5GLOBAL ! shortened "_DEFAULT" to "_DFLT" to satisfy the limit of 31 ! characters for variable names in Fortran. +! shortened "_CONTIGUOUS" to "_CONTIG" to satisfy the limit of 31 +! characters for variable names in Fortran. INTEGER :: H5D_CHUNK_CACHE_NSLOTS_DFLT_F INTEGER :: H5D_CHUNK_CACHE_NBYTES_DFLT_F INTEGER :: H5D_CHUNK_CACHE_W0_DFLT_F + INTEGER :: H5D_MPIO_NO_COLLECTIVE_F + INTEGER :: H5D_MPIO_CHUNK_INDEPENDENT_F + INTEGER :: H5D_MPIO_CHUNK_COLLECTIVE_F + INTEGER :: H5D_MPIO_CHUNK_MIXED_F + INTEGER :: H5D_MPIO_CONTIG_COLLECTIVE_F EQUIVALENCE(H5D_flags(1), H5D_COMPACT_F) EQUIVALENCE(H5D_flags(2), H5D_CONTIGUOUS_F) @@ -419,6 +426,11 @@ MODULE H5GLOBAL EQUIVALENCE(H5D_flags(20), H5D_CHUNK_CACHE_NSLOTS_DFLT_F) EQUIVALENCE(H5D_flags(21), H5D_CHUNK_CACHE_NBYTES_DFLT_F) EQUIVALENCE(H5D_flags(22), H5D_CHUNK_CACHE_W0_DFLT_F) + EQUIVALENCE(H5D_flags(23), H5D_MPIO_NO_COLLECTIVE_F) + EQUIVALENCE(H5D_flags(24), H5D_MPIO_CHUNK_INDEPENDENT_F) + EQUIVALENCE(H5D_flags(25), H5D_MPIO_CHUNK_COLLECTIVE_F) + EQUIVALENCE(H5D_flags(26), H5D_MPIO_CHUNK_MIXED_F) + EQUIVALENCE(H5D_flags(27), H5D_MPIO_CONTIG_COLLECTIVE_F) ! ! H5E flags declaration diff --git a/fortran/src/H5f90kit.c b/fortran/src/H5f90kit.c index 059685e..0bc721f 100644 --- a/fortran/src/H5f90kit.c +++ b/fortran/src/H5f90kit.c @@ -53,7 +53,7 @@ HD5f2cstring(_fcd fdesc, size_t len) /* Search for the end of the string */ str = _fcdtocp(fdesc); - for(i = (int)len - 1; i >= 0 && !HDisgraph((int)str[i]); i--) + for(i = (int)len - 1; i >= 0 && HDisspace((int)str[i]) && str[i] == ' '; i--) /*EMPTY*/; /* Allocate C string */ diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index d0a8361..9340c2a 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -61,7 +61,7 @@ typedef struct H5O_hdr_info_t_f { typedef struct H5O_info_t_f { unsigned long fileno; /* File number that object is located in */ haddr_t_f addr; /* Object address in file */ - int_f type; /* Basic object type (group, dataset, etc.) */ + int type; /* Basic object type (group, dataset, etc.) */ int_f rc; /* Reference count of object */ int_f atime[8]; /* Access time */ int_f mtime[8]; /* Modification time */ @@ -806,11 +806,21 @@ H5_FCDLL int_f nh5tconvert_c(hid_t_f *src_id, hid_t_f *dst_id, size_t_f *nelmts, #define nh5olink_c H5_FC_FUNC_(h5olink_c, H5OLINK_C) #define nh5oopen_c H5_FC_FUNC_(h5oopen_c, H5OOPEN_C) #define nh5oclose_c H5_FC_FUNC_(h5oclose_c, H5OCLOSE_C) -#define nh5ovisit_c H5_FC_FUNC_(h5ovisit_c,H5OVISIT_C) +#define nh5ovisit_c H5_FC_FUNC_(h5ovisit_c, H5OVISIT_C) +#define nh5ovisit_by_name_c H5_FC_FUNC_(h5ovisit_by_name_c, H5OVISIT_BY_NAME_C) +#define nh5oget_info_c H5_FC_FUNC_(h5oget_info_c, H5OGET_INFO_C) +#define nh5oget_info_by_idx_c H5_FC_FUNC_(h5oget_info_by_idx_c ,H5OGET_INFO_BY_IDX_C) #define nh5oget_info_by_name_c H5_FC_FUNC_(h5oget_info_by_name_c ,H5OGET_INFO_BY_NAME_C) #define nh5oopen_by_addr_c H5_FC_FUNC_(h5oopen_by_addr_c, H5OOPEN_BY_ADDR_C) #define nh5ocopy_c H5_FC_FUNC_(h5ocopy_c, H5OCOPY_C) - +#define nh5odecr_refcount_c H5_FC_FUNC_(h5odecr_refcount_c, H5ODECR_REFCOUNT_C) +#define nh5oincr_refcount_c H5_FC_FUNC_(h5oincr_refcount_c, H5OINCR_REFCOUNT_C) +#define nh5oexists_by_name_c H5_FC_FUNC_(h5oexists_by_name_c, H5OEXISTS_BY_NAME_C) +#define nh5oset_comment_c H5_FC_FUNC_(h5oset_comment_c, H5OSET_COMMENT_C) +#define nh5oset_comment_by_name_c H5_FC_FUNC_(h5oset_comment_by_name_c, H5OSET_COMMENT_BY_NAME_C) +#define nh5oopen_by_idx_c H5_FC_FUNC_(h5oopen_by_idx_c, H5OOPEN_BY_IDX_C) +#define nh5oget_comment_c H5_FC_FUNC_(h5oget_comment_c, H5OGET_COMMENT_C) +#define nh5oget_comment_by_name_c H5_FC_FUNC_(h5oget_comment_by_name_c, H5OGET_COMMENT_BY_NAME_C) H5_FCDLL int_f nh5oopen_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_t_f *obj_id); H5_FCDLL int_f nh5oclose_c (hid_t_f *object_id ); @@ -818,11 +828,26 @@ H5_FCDLL int_f nh5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *ob H5_FCDLL int_f nh5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, size_t_f *namelen, hid_t_f *lcpl_id, hid_t_f *lapl_id); H5_FCDLL int_f nh5ovisit_c (hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data); -H5_FCDLL int_f nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen,hid_t_f *lapl_id, +H5_FCDLL int_f nh5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f *index_type, int_f *order, + H5O_iterate_t op, void *op_data, hid_t_f *lapl_id ); +H5_FCDLL int_f nh5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info); +H5_FCDLL int_f nh5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, + int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info); +H5_FCDLL int_f nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, H5O_info_t_f *object_info); H5_FCDLL int_f nh5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, hid_t_f *ocpypl_id, hid_t_f *lcpl_id ); +H5_FCDLL int_f nh5odecr_refcount_c (hid_t_f *object_id); +H5_FCDLL int_f nh5oincr_refcount_c (hid_t_f *object_id); +H5_FCDLL int_f nh5oexists_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id); +H5_FCDLL int_f nh5oset_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentlen); +H5_FCDLL int_f nh5oset_comment_by_name_c (hid_t_f *object_id, _fcd name, size_t_f *namelen, _fcd comment, size_t_f *commentlen, hid_t_f *lapl_id); +H5_FCDLL int_f nh5oopen_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id); +H5_FCDLL int_f nh5oget_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentsize, hssize_t_f *bufsize); +H5_FCDLL int_f nh5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size, + _fcd comment, size_t_f *commentsize, size_t_f *bufsize, hid_t_f *lapl_id); /* * Functions from H5Pf.c */ @@ -982,6 +1007,7 @@ H5_FCDLL int_f nh5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_nam #define nh5pget_nlinks_c H5_FC_FUNC_(h5pget_nlinks_c, H5PGET_NLINKS_C) #define nh5pset_chunk_cache_c H5_FC_FUNC_(h5pset_chunk_cache_c, H5PSET_CHUNK_CACHE_C) #define nh5pget_chunk_cache_c H5_FC_FUNC_(h5pget_chunk_cache_c, H5PGET_CHUNK_CACHE_C) +#define nh5pget_mpio_actual_io_mode_c H5_FC_FUNC_(h5pget_mpio_actual_io_mode_c, H5PGET_MPIO_ACTUAL_IO_MODE_C) H5_FCDLL int_f nh5pcreate_c ( hid_t_f *cls, hid_t_f *prp_id ); H5_FCDLL int_f nh5pclose_c ( hid_t_f *prp_id ); @@ -1142,6 +1168,7 @@ H5_FCDLL int_f nh5pset_nlinks_c(hid_t_f *lapl_id, size_t_f *nlinks); H5_FCDLL int_f nh5pget_nlinks_c(hid_t_f *lapl_id, size_t_f *nlinks); H5_FCDLL int_f nh5pset_chunk_cache_c(hid_t_f *dapl_id, size_t_f *rdcc_nslots, size_t_f *rdcc_nbytes, real_f *rdcc_w0); H5_FCDLL int_f nh5pget_chunk_cache_c(hid_t_f *dapl_id, size_t_f *rdcc_nslots, size_t_f *rdcc_nbytes, real_f *rdcc_w0); +H5_FCDLL int_f nh5pget_mpio_actual_io_mode_c(hid_t_f *dxpl_id, int_f *actual_io_mode); /* * Functions frome H5Rf.c */ @@ -1152,6 +1179,7 @@ H5_FCDLL int_f nh5pget_chunk_cache_c(hid_t_f *dapl_id, size_t_f *rdcc_nslots, si #define nh5rdereference_object_c H5_FC_FUNC_(h5rdereference_object_c, H5RDEREFERENCE_OBJECT_C) #define nh5rdereference_ptr_c H5_FC_FUNC_(h5rdereference_ptr_c, H5RDEREFERENCE_PTR_C) #define nh5rget_region_region_c H5_FC_FUNC_(h5rget_region_region_c, H5RGET_REGION_REGION_C) +#define nh5rget_region_ptr_c H5_FC_FUNC_(h5rget_region_ptr_c, H5RGET_REGION_PTR_C) #define nh5rget_object_type_obj_c H5_FC_FUNC_(h5rget_object_type_obj_c, H5RGET_OBJECT_TYPE_OBJ_C) #define nh5rget_name_object_c H5_FC_FUNC_(h5rget_name_object_c, H5RGET_NAME_OBJECT_C) #define nh5rget_name_region_c H5_FC_FUNC_(h5rget_name_region_c, H5RGET_NAME_REGION_C) @@ -1166,6 +1194,7 @@ H5_FCDLL int_f nh5rdereference_region_c (hid_t_f *dset_id, int_f *ref, hid_t_f * H5_FCDLL int_f nh5rdereference_object_c (hid_t_f *dset_id, haddr_t_f *ref, hid_t_f *obj_id); H5_FCDLL int_f nh5rdereference_ptr_c (hid_t_f *obj_id, int_f *ref_type, void *ref, hid_t_f *ref_obj_id); H5_FCDLL int_f nh5rget_region_region_c (hid_t_f *dset_id, int_f *ref, hid_t_f *space_id); +H5_FCDLL int_f nh5rget_region_ptr_c(hid_t_f *dset_id, void *ref, hid_t_f *space_id); H5_FCDLL int_f nh5rget_object_type_obj_c (hid_t_f *dset_id, haddr_t_f *ref, int_f *obj_type); H5_FCDLL int_f nh5rget_name_object_c (hid_t_f *loc_id, haddr_t_f *ref, _fcd name, size_t_f *name_len, size_t_f *size_default); H5_FCDLL int_f nh5rget_name_region_c (hid_t_f *loc_id, int_f *ref, _fcd name, size_t_f *name_len, size_t_f *size_default); diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c index 61504ec..4c83d21 100644 --- a/fortran/src/H5match_types.c +++ b/fortran/src/H5match_types.c @@ -533,7 +533,21 @@ int main(void) /* double_f */ #if defined H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND - writeFloatToFiles("Fortran_DOUBLE", "double_f", 16, H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND); + if(H5_C_HAS_REAL_NATIVE_16 != 0) { /* Check if C has 16 byte floats */ + writeFloatToFiles("Fortran_DOUBLE", "double_f", 16, H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND); + } else { +#if defined H5_FORTRAN_HAS_REAL_NATIVE_8_KIND /* Fall back to 8 byte floats */ + writeFloatToFiles("Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_REAL_NATIVE_8_KIND); + } +#elif defined H5_FORTRAN_HAS_REAL_NATIVE_4_KIND /* Fall back to 4 byte floats */ + writeFloatToFiles("Fortran_DOUBLE", "double_f", 4, H5_FORTRAN_HAS_REAL_NATIVE_4_KIND); + } +#else + /* Error: couldn't find a size for double_f when fortran has 16 byte reals */ + return -1; + } +#endif + #elif defined H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND writeFloatToFiles("Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND); #else @@ -541,6 +555,14 @@ int main(void) return -1; #endif + /* Need the buffer size for the fortran derive type 'hdset_reg_ref_t_f03' + * in order to be interoperable with C's structure, the C buffer size + * H5R_DSET_REG_REF_BUF_SIZE is (sizeof(haddr_t)+4) + */ + + fprintf(fort_header, " INTEGER, PARAMETER :: H5R_DSET_REG_REF_BUF_SIZE_F = %u\n", H5_SIZEOF_HADDR_T + 4 ); + + /* Close files */ endCfile(); endFfile(); diff --git a/fortran/src/Makefile.in b/fortran/src/Makefile.in index a8c0546..572f081 100644 --- a/fortran/src/Makefile.in +++ b/fortran/src/Makefile.in @@ -517,7 +517,7 @@ CHECK_CLEANFILES = *.chkexe *.chklog *.clog # Add libtool shared library version numbers to the HDF5 library # See libtool versioning documentation online. LT_VERS_INTERFACE = 6 -LT_VERS_REVISION = 118 +LT_VERS_REVISION = 122 LT_VERS_AGE = 0 # Include src directory in both Fortran and C flags (C compiler is used diff --git a/fortran/src/hdf5_fortrandll.def b/fortran/src/hdf5_fortrandll.def index 29e83f5..d317476 100644 --- a/fortran/src/hdf5_fortrandll.def +++ b/fortran/src/hdf5_fortrandll.def @@ -284,10 +284,25 @@ H5L_mp_H5LIS_REGISTERED_F H5L_mp_H5LMOVE_F
H5L_mp_H5LGET_NAME_BY_IDX_F
; H5O
+H5O_mp_H5OCLOSE_F
H5O_mp_H5OCOPY_F
+H5O_mp_H5ODECR_REFCOUNT_F
+H5O_mp_H5OEXISTS_BY_NAME_F
+H5O_mp_H5OGET_COMMENT_F
+H5O_mp_H5OGET_COMMENT_BY_NAME_F
+H5O_mp_H5OINCR_REFCOUNT_F
H5O_mp_H5OLINK_F
-H5O_mp_H5OOPEN_F
H5O_mp_H5OOPEN_BY_ADDR_F
+H5O_mp_H5OOPEN_BY_IDX_F
+H5O_mp_H5OOPEN_F
+H5O_mp_H5OSET_COMMENT_F
+H5O_mp_H5OSET_COMMENT_BY_NAME_F
+; These should only get compiled with option --enable-fortran2003
+;H5O_PROVISIONAL_mp_H5OGET_INFO_BY_IDX_F
+;H5O_PROVISIONAL_mp_H5OGET_INFO_BY_NAME_F
+;H5O_PROVISIONAL_mp_H5OGET_INFO_F
+;H5O_PROVISIONAL_mp_H5OVISIT_BY_NAME_F
+;H5O_PROVISIONAL_mp_H5OVISIT_F
; H5P
H5P_mp_H5PCREATE_F
H5P_mp_H5PSET_PRESERVE_F
@@ -429,7 +444,8 @@ H5R_PROVISIONAL_mp_H5RCREATE_OBJECT_F H5R_PROVISIONAL_mp_H5RCREATE_REGION_F
H5R_PROVISIONAL_mp_H5RDEREFERENCE_OBJECT_F
H5R_PROVISIONAL_mp_H5RDEREFERENCE_REGION_F
-H5R_mp_H5RGET_REGION_REGION_F
+H5R_PROVISIONAL_mp_H5RGET_REGION_REGION_F
+
H5R_mp_H5RGET_OBJECT_TYPE_OBJ_F
H5R_PROVISIONAL_mp_H5RGET_NAME_OBJECT_F
H5R_PROVISIONAL_mp_H5RGET_NAME_REGION_F
diff --git a/fortran/src/phdf5_fortrandll.def b/fortran/src/phdf5_fortrandll.def index 7a196cd..df61860 100644 --- a/fortran/src/phdf5_fortrandll.def +++ b/fortran/src/phdf5_fortrandll.def @@ -284,10 +284,25 @@ H5L_mp_H5LIS_REGISTERED_F H5L_mp_H5LMOVE_F
H5L_mp_H5LGET_NAME_BY_IDX_F
; H5O
+H5O_mp_H5OCLOSE_F
H5O_mp_H5OCOPY_F
+H5O_mp_H5ODECR_REFCOUNT_F
+H5O_mp_H5OEXISTS_BY_NAME_F
+H5O_mp_H5OGET_COMMENT_F
+H5O_mp_H5OGET_COMMENT_BY_NAME_F
+H5O_mp_H5OINCR_REFCOUNT_F
H5O_mp_H5OLINK_F
-H5O_mp_H5OOPEN_F
H5O_mp_H5OOPEN_BY_ADDR_F
+H5O_mp_H5OOPEN_BY_IDX_F
+H5O_mp_H5OOPEN_F
+H5O_mp_H5OSET_COMMENT_F
+H5O_mp_H5OSET_COMMENT_BY_NAME_F
+; These should only get compiled with option --enable-fortran2003
+;H5O_PROVISIONAL_mp_H5OGET_INFO_BY_IDX_F
+;H5O_PROVISIONAL_mp_H5OGET_INFO_BY_NAME_F
+;H5O_PROVISIONAL_mp_H5OGET_INFO_F
+;H5O_PROVISIONAL_mp_H5OVISIT_BY_NAME_F
+;H5O_PROVISIONAL_mp_H5OVISIT_F
; H5P
H5P_mp_H5PCREATE_F
H5P_mp_H5PSET_PRESERVE_F
@@ -429,7 +444,8 @@ H5R_PROVISIONAL_mp_H5RCREATE_OBJECT_F H5R_PROVISIONAL_mp_H5RCREATE_REGION_F
H5R_PROVISIONAL_mp_H5RDEREFERENCE_OBJECT_F
H5R_PROVISIONAL_mp_H5RDEREFERENCE_REGION_F
-H5R_mp_H5RGET_REGION_REGION_F
+H5R_PROVISIONAL_mp_H5RGET_REGION_REGION_F
+
H5R_mp_H5RGET_OBJECT_TYPE_OBJ_F
H5R_PROVISIONAL_mp_H5RGET_NAME_OBJECT_F
H5R_PROVISIONAL_mp_H5RGET_NAME_REGION_F
@@ -528,4 +544,9 @@ H5Z_mp_H5ZFILTER_AVAIL_F H5Z_mp_H5ZGET_FILTER_INFO_F
; Parallel
H5FDMPIO_mp_H5PSET_FAPL_MPIO_F
+H5FDMPIO_mp_H5PGET_FAPL_MPIO_F
H5FDMPIO_mp_H5PSET_DXPL_MPIO_F
+H5FDMPIO_mp_H5PGET_DXPL_MPIO_F
+H5FDMPIO_mp_H5PSET_FAPL_MPIPOSIX_F
+H5FDMPIO_mp_H5PGET_FAPL_MPIPOSIX_F
+H5FDMPIO_mp_H5PGET_MPIO_ACTUAL_IO_MODE_F
\ No newline at end of file diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt index d19baea..3a3d084 100644 --- a/fortran/test/CMakeLists.txt +++ b/fortran/test/CMakeLists.txt @@ -106,6 +106,7 @@ IF (FORTRAN_HAVE_ISO_C_BINDING AND HDF5_ENABLE_F2003) tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 + tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 ) diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am index b261785..42dd127 100644 --- a/fortran/test/Makefile.am +++ b/fortran/test/Makefile.am @@ -68,7 +68,7 @@ fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \ if FORTRAN_2003_CONDITIONAL_F fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \ - tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90 + tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 endif diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in index e42b080..b9f05e3 100644 --- a/fortran/test/Makefile.in +++ b/fortran/test/Makefile.in @@ -136,11 +136,13 @@ fortranlib_test_1_8_LDADD = $(LDADD) fortranlib_test_1_8_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \ $(LIBH5F) $(LIBHDF5) am__fortranlib_test_F03_SOURCES_DIST = fortranlib_test_F03.f90 \ - tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90 + tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 \ + tH5T_F03.f90 @FORTRAN_2003_CONDITIONAL_F_TRUE@am_fortranlib_test_F03_OBJECTS = fortranlib_test_F03.$(OBJEXT) \ @FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.$(OBJEXT) \ @FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5E_F03.$(OBJEXT) \ @FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5L_F03.$(OBJEXT) \ +@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5O_F03.$(OBJEXT) \ @FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5P_F03.$(OBJEXT) \ @FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5T_F03.$(OBJEXT) fortranlib_test_F03_OBJECTS = $(am_fortranlib_test_F03_OBJECTS) @@ -525,7 +527,7 @@ fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \ tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 @FORTRAN_2003_CONDITIONAL_F_TRUE@fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \ -@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90 +@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 fflush1_SOURCES = fflush1.f90 fflush2_SOURCES = fflush2.f90 diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90 index 321cb99..d3ced72 100644 --- a/fortran/test/fortranlib_test_1_8.f90 +++ b/fortran/test/fortranlib_test_1_8.f90 @@ -94,12 +94,6 @@ PROGRAM fortranlibtest total_error) ret_total_error = 0 - CALL test_nbit(cleanup, ret_total_error ) - CALL write_test_status(ret_total_error, & - ' Testing nbit filter', & - total_error) - - ret_total_error = 0 CALL test_scaleoffset(cleanup, ret_total_error ) CALL write_test_status(ret_total_error, & ' Testing scaleoffset filter', & @@ -401,141 +395,6 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) END SUBROUTINE test_h5s_encode !------------------------------------------------------------------------- -! Function: test_nbit -! -! Purpose: Tests (real) datatype for nbit filter -! -! Return: Success: 0 -! Failure: >0 -! -! Programmer: M. Scot Breitenfeld -! Decemeber 7, 2010 -! -! Modifications: -! -!------------------------------------------------------------------------- -! - -SUBROUTINE test_nbit(cleanup, total_error ) - - USE HDF5 - - IMPLICIT NONE - INTEGER, PARAMETER :: wp = KIND(1.0) - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - INTEGER(hid_t) :: file - - INTEGER(hid_t) :: dataset, datatype, space, dc - INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2,5/) - INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2,5/) - ! orig_data[] are initialized to be within the range that can be represented by - ! dataset datatype (no precision loss during datatype conversion) - ! - REAL(kind=wp), DIMENSION(1:2,1:5) :: orig_data = RESHAPE( (/188384.00, 19.103516, -1.0831790e9, -84.242188, & - 5.2045898, -49140.000, 2350.2500, -3.2110596e-1, 6.4998865e-5, -0.0000000/) , (/2,5/) ) - REAL(kind=wp), DIMENSION(1:2,1:5) :: new_data - INTEGER(size_t) :: PRECISION, offset - INTEGER :: error - LOGICAL :: status - INTEGER*8 :: ii - INTEGER(size_t) :: i, j - - - ! check to see if filter is available - CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error) - IF(.NOT.status)THEN ! We don't have H5Z_FILTER_NBIT_F filter - total_error = -1 ! so return - RETURN - ENDIF - - CALL H5Fcreate_f("nbit.h5", H5F_ACC_TRUNC_F, file, error) - CALL check("H5Fcreate_f", error, total_error) - - ! Define dataset datatype (integer), and set precision, offset - CALL H5Tcopy_f(H5T_IEEE_F32BE, datatype, error) - CALL CHECK(" H5Tcopy_f", error, total_error) - CALL H5Tset_fields_f(datatype, 26_size_t, 20_size_t, 6_size_t, 7_size_t, 13_size_t, error) - CALL CHECK(" H5Tset_fields_f", error, total_error) - offset = 7 - CALL H5Tset_offset_f(datatype, offset, error) - CALL CHECK(" H5Tset_offset_f", error, total_error) - PRECISION = 20 - CALL H5Tset_precision_f(datatype,PRECISION, error) - CALL CHECK(" H5Tset_precision_f", error, total_error) - - CALL H5Tset_size_f(datatype, 4_size_t, error) - CALL CHECK(" H5Tset_size_f", error, total_error) - - CALL H5Tset_ebias_f(datatype, 31_size_t, error) - CALL CHECK(" H5Tset_ebias_f", error, total_error) - - ! Create the data space - CALL H5Screate_simple_f(2, dims, space, error) - CALL CHECK(" H5Screate_simple_f", error, total_error) - - ! USE nbit filter - CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error) - CALL CHECK(" H5Pcreate_f", error, total_error) - - CALL H5Pset_chunk_f(dc, 2, chunk_dim, error) - CALL CHECK(" H5Pset_chunk_f", error, total_error) - CALL H5Pset_nbit_f(dc, error) - CALL CHECK(" H5Pset_nbit_f", error, total_error) - - ! Create the dataset - CALL H5Dcreate_f(file, "nbit_real", datatype, & - space, dataset, error, dc) - CALL CHECK(" H5Dcreate_f", error, total_error) - - !---------------------------------------------------------------------- - ! STEP 1: Test nbit by setting up a chunked dataset and writing - ! to it. - !---------------------------------------------------------------------- - ! - CALL H5Dwrite_f(dataset, H5T_NATIVE_REAL, orig_data, dims, error) - CALL CHECK(" H5Dwrite_f", error, total_error) - - !---------------------------------------------------------------------- - ! STEP 2: Try to read the data we just wrote. - !---------------------------------------------------------------------- - ! - CALL H5Dread_f(dataset, H5T_NATIVE_REAL, new_data, dims, error) - CALL CHECK(" H5Dread_f", error, total_error) - - ! Check that the values read are the same as the values written - ! Assume size of long long = size of double - ! - i_loop: DO i = 1, dims(1) - j_loop: DO j = 1, dims(2) - IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE ! skip IF value is NaN - IF(new_data(i,j) .NE. orig_data(i,j))THEN - total_error = total_error + 1 - WRITE(*,'(" Read different values than written.")') - WRITE(*,'(" At index ", 2(1X,I0))') i, j - EXIT i_loop - END IF - ENDDO j_loop - ENDDO i_loop - - !---------------------------------------------------------------------- - ! Cleanup - !---------------------------------------------------------------------- - ! - CALL H5Tclose_f(datatype, error) - CALL CHECK(" H5Tclose_f", error, total_error) - CALL H5Pclose_f(dc, error) - CALL CHECK(" H5Pclose_f", error, total_error) - CALL H5Sclose_f(space, error) - CALL CHECK(" H5Sclose_f", error, total_error) - CALL H5Dclose_f(dataset, error) - CALL CHECK(" H5Dclose_f", error, total_error) - CALL H5Fclose_f(file, error) - CALL CHECK(" H5Fclose_f", error, total_error) - -END SUBROUTINE test_nbit - -!------------------------------------------------------------------------- ! Function: test_scaleoffset ! ! Purpose: Tests the integer datatype for scaleoffset filter diff --git a/fortran/test/fortranlib_test_F03.f90 b/fortran/test/fortranlib_test_F03.f90 index 1b69f7f..a03241c 100644 --- a/fortran/test/fortranlib_test_F03.f90 +++ b/fortran/test/fortranlib_test_F03.f90 @@ -64,10 +64,7 @@ PROGRAM fortranlibtest_F03 ! CALL write_test_status(ret_total_error, ' Test error API based on data I/O', total_error) WRITE(*,*) -! write(*,*) -! write(*,*) '=========================================' -! write(*,*) 'Testing DATATYPE interface ' -! write(*,*) '=========================================' + ret_total_error = 0 CALL test_array_compound_atomic(ret_total_error) CALL write_test_status(ret_total_error, ' Testing 1-D Array of Compound Datatypes Functionality', total_error) @@ -117,16 +114,16 @@ PROGRAM fortranlibtest_F03 CALL write_test_status(ret_total_error, ' Testing writing/reading string datatypes, using C_LOC', total_error) ret_total_error = 0 + CALL vl_test_special_char(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing string datatypes containing control characters', total_error) + + ret_total_error = 0 CALL test_create(ret_total_error) - CALL write_test_status(ret_total_error, & - ' Testing filling functions', & - total_error) + CALL write_test_status(ret_total_error, ' Testing filling functions', total_error) ret_total_error = 0 CALL test_h5kind_to_type(total_error) - CALL write_test_status(ret_total_error, & - ' Test function h5kind_to_type', & - total_error) + CALL write_test_status(ret_total_error, ' Test function h5kind_to_type', total_error) ret_total_error = 0 CALL test_array_bkg(ret_total_error) @@ -138,14 +135,30 @@ PROGRAM fortranlibtest_F03 ret_total_error = 0 CALL test_iter_group(ret_total_error) - CALL write_test_status(ret_total_error, ' Testing Group Iteration Functionality', total_error) + CALL write_test_status(ret_total_error, ' Testing group iteration functionality', total_error) + + ret_total_error = 0 + CALL test_nbit(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing nbit filter', total_error) + ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing GROUP interface ' ! write(*,*) '=========================================' - + ret_total_error = 0 + CALL test_h5o_refcount(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing object functions ', total_error) + + ret_total_error = 0 + CALL obj_visit(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing object visiting functions ', total_error) + + ret_total_error = 0 + CALL obj_info(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing object info functions ', total_error) + WRITE(*,*) WRITE(*,*) ' ============================================ ' diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90 index 03522f7..cecaded 100644 --- a/fortran/test/tH5A.f90 +++ b/fortran/test/tH5A.f90 @@ -100,7 +100,7 @@ CHARACTER(LEN=35), DIMENSION(2) :: aread_data ! Buffer to put read back ! string attr data CHARACTER :: attr_character_data = 'A' - DOUBLE PRECISION, DIMENSION(1) :: attr_double_data = 3.459 + REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: attr_double_data = 3.459 REAL, DIMENSION(1) :: attr_real_data = 4.0 INTEGER, DIMENSION(1) :: attr_integer_data = 5 INTEGER(HSIZE_T), DIMENSION(7) :: data_dims @@ -109,7 +109,7 @@ CHARACTER :: aread_character_data ! variable to put read back Character attr data INTEGER, DIMENSION(1) :: aread_integer_data ! variable to put read back integer attr data INTEGER, DIMENSION(1) :: aread_null_data = 7 ! variable to put read back null attr data - DOUBLE PRECISION, DIMENSION(1) :: aread_double_data ! variable to put read back double attr data + REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: aread_double_data ! variable to put read back double attr data REAL, DIMENSION(1) :: aread_real_data ! variable to put read back real attr data ! diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90 index 247d1d0..b68e7ca 100644 --- a/fortran/test/tH5O.f90 +++ b/fortran/test/tH5O.f90 @@ -35,15 +35,8 @@ SUBROUTINE test_h5o(cleanup, total_error) INTEGER, INTENT(OUT) :: total_error INTEGER :: error - ! /* Output message about test being performed */ - ! WRITE(*,*) "Testing Objects" - -!!$ test_h5o_open(); /* Test generic OPEN FUNCTION */ -!!$ test_h5o_open_by_addr(); /* Test opening objects by address */ -!!$ test_h5o_close(); /* Test generic CLOSE FUNCTION */ -!!$ test_h5o_refcount(); /* Test incrementing and decrementing reference count */ - CALL test_h5o_plist(total_error) ! /* Test object creation properties */ - CALL test_h5o_link(total_error) ! /* Test object link routine */ + CALL test_h5o_plist(total_error) ! Test object creation properties + CALL test_h5o_link(total_error) ! Test object link routine IF(cleanup) CALL h5_cleanup_f("TestFile", H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) @@ -100,6 +93,19 @@ SUBROUTINE test_h5o_link(total_error) INTEGER(HSIZE_T), DIMENSION(1:1) :: dims2 = (/dim0/) ! size read/write buffer INTEGER , DIMENSION(1:dim0) :: wdata2, & ! Write buffer rdata2 ! Read buffer + LOGICAL :: link_exists + CHARACTER(LEN=8) :: chr_exact + CHARACTER(LEN=10) :: chr_lg + INTEGER(size_t) :: nlinks + INTEGER(HID_T) :: plist = -1 + + CHARACTER(LEN=20) :: dset_comment = "dataset comment" + CHARACTER(LEN=13) :: grp_comment = "group comment" + CHARACTER(LEN=10) :: comment_sm ! to small comment sized buffer + CHARACTER(LEN=15) :: comment ! exact comment sized buffer + CHARACTER(LEN=20) :: comment_lg ! large comment sized buffer + INTEGER(HSSIZE_T) :: comment_size + INTEGER(SIZE_T) :: comment_size2 ! Initialize the raw data DO i = 1, TEST6_DIM1 @@ -131,8 +137,6 @@ SUBROUTINE test_h5o_link(total_error) CALL H5Pset_libver_bounds_f(fapl_id, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) CALL check("H5Pset_libver_bounds_f",error, total_error) -!!$ ret = H5Pset_libver_bounds(fapl_id, (new_format ? H5F_LIBVER_LATEST : H5F_LIBVER_EARLIEST), H5F_LIBVER_LATEST); - ! Create a new HDF5 file CALL H5Fcreate_f(TEST_FILENAME, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl_id) CALL check("H5Fcreate_f", error, total_error) @@ -155,10 +159,9 @@ SUBROUTINE test_h5o_link(total_error) ! Create a dataset with no name using the committed datatype CALL H5Dcreate_anon_f(file_id, type_id, space_id, dset_id, error ) ! using no optional parameters CALL check("H5Dcreate_anon_f",error,total_error) - - + ! ! Verify that we can write to and read from the dataset - + ! ! Write the data to the dataset !EP CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata, dims, error, & @@ -199,7 +202,6 @@ SUBROUTINE test_h5o_link(total_error) CALL h5tclose_f(type_id, error) CALL check("h5tclose_f", error, total_error) - ! Re-open datatype using new link CALL H5Topen_f(group_id, "datatype", type_id, error) CALL check("h5topen_f", error, total_error) @@ -208,12 +210,10 @@ SUBROUTINE test_h5o_link(total_error) CALL H5Olink_f(group_id, file_id, "/group", error) CALL check("H5Olink_f", error, total_error) - CALL h5gclose_f(group_id, error) CALL check("h5gclose_f",error,total_error) ! Open dataset through root group and verify its data - CALL H5Dopen_f(file_id, "/group/inter_group/dataset", dset_id, error) CALL check("test_lcpl.h5dopen_f", error, total_error) @@ -236,7 +236,6 @@ SUBROUTINE test_h5o_link(total_error) CALL h5tclose_f(type_id, error) CALL check("h5tclose_f",error,total_error) - ! Close remaining IDs CALL h5sclose_f(space_id, error) CALL check("h5sclose_f",error,total_error) @@ -264,16 +263,214 @@ SUBROUTINE test_h5o_link(total_error) CALL check("h5gcreate_f", error, total_error) CALL h5gcreate_f(file_id,"/G1/G2/G3",group_id,error) CALL check("h5gcreate_f", error, total_error) + + ! Try putting a comment on the group /G1/G2/G3 by name + CALL h5oset_comment_by_name_f(file_id, "/G1/G2/G3", grp_comment, error) + CALL check("h5oset_comment_by_name_f", error, total_error) + + comment_lg = ' ' + + CALL h5oget_comment_by_name_f(file_id, "/G1/G2/G3", comment_lg, error) + CALL check("h5oget_comment_by_name_f", error, total_error) + + IF(comment_lg(1:13).NE.grp_comment)THEN + CALL check("h5oget_comment_by_name_f", -1, total_error) + ENDIF + IF(comment_lg(14:20).NE.' ')THEN ! make sure no NULL terminator + CALL check("h5oget_comment_by_name_f", -1, total_error) + ENDIF + + ! Try putting a comment on the group /G1/G2/G3 by name with trailing blanks + + CALL h5oset_comment_by_name_f(file_id, "/G1/G2/G3"//' ', grp_comment, error) + CALL check("h5oset_comment_by_name_f", error, total_error) + + comment_lg = ' ' + + CALL h5oget_comment_by_name_f(file_id, "/G1/G2/G3"//' ', comment_lg, error) + CALL check("h5oget_comment_by_name_f", error, total_error) + + IF(comment_lg(1:13).NE.grp_comment)THEN + CALL check("h5oget_comment_by_name_f", -1, total_error) + ENDIF + IF(comment_lg(14:20).NE.' ')THEN ! make sure no NULL terminator + CALL check("h5oget_comment_by_name_f", -1, total_error) + ENDIF + ! ! Create the dataset ! CALL h5dcreate_f(group_id, dataset, H5T_STD_I32LE, space_id, dset_id, error) CALL check("h5dcreate_f", error, total_error) + + ! Putting a comment on the dataset + CALL h5oset_comment_f(dset_id, dset_comment, error) + CALL check("h5oset_comment_f", error, total_error) + + ! Try reading into a buffer that is the correct size + + CALL h5oget_comment_f(dset_id, comment, error) + CALL check("h5oget_comment_f", error, total_error) + + IF(comment(1:15).NE.dset_comment(1:15))THEN + CALL check("h5oget_comment_f", -1, total_error) + ENDIF + + ! Try reading into a buffer that is to small + + CALL h5oget_comment_f(dset_id, comment_sm, error) + CALL check("h5oget_comment_f", error, total_error) + + IF(comment_sm(1:10).NE.dset_comment(1:10))THEN + CALL check("h5oget_comment_f", -1, total_error) + ENDIF + + ! Try reading into a buffer that is larger then needed + + comment_lg = ' ' + + CALL h5oget_comment_f(dset_id, comment_lg, error) + CALL check("h5oget_comment_f", error, total_error) + + IF(comment_lg(1:15).NE.dset_comment)THEN + CALL check("h5oget_comment_f", -1, total_error) + ENDIF + IF(comment_lg(16:20).NE.' ')THEN ! make sure no NULL terminator + CALL check("h5oget_comment_f", -1, total_error) + ENDIF + ! + ! Check optional parameter + ! + CALL h5oget_comment_f(dset_id, comment_lg, error, comment_size) + CALL check("h5oget_comment_f", error, total_error) + + IF( comment_size.NE.15)THEN + CALL check("h5oget_comment_f", -1, total_error) + ENDIF + + ! CHECK h5oget_comment_by_name_f + + ! Try reading into a buffer that is the correct size + + CALL h5oget_comment_by_name_f(dset_id, ".", comment, error) + CALL check("h5oget_comment_by_name_f", error, total_error) + + IF(comment(1:15).NE.dset_comment(1:15))THEN + CALL check("h5oget_comment_by_name_f", -1, total_error) + ENDIF + + ! Try with trailing blanks in the name + + CALL h5oget_comment_by_name_f(dset_id, ". ", comment, error) + CALL check("h5oget_comment_by_name_f", error, total_error) + + IF(comment(1:15).NE.dset_comment(1:15))THEN + CALL check("h5oget_comment_by_name_f", -1, total_error) + ENDIF + + ! + ! Check optional parameter + ! + CALL h5oget_comment_by_name_f(dset_id, ". ", comment_lg, error, comment_size2) + CALL check("h5oget_comment_by_name_f", error, total_error) + + IF( comment_size2.NE.15)THEN + CALL check("h5oget_comment_by_name_f", -1, total_error) + ENDIF + ! ! Write the data to the dataset. ! CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata2, dims2, error) CALL check("h5dwrite_f", error, total_error) + + ! ************************* + ! CHECK H5OEXISTS_BY_NAME_F + ! ************************* + + ! Create a soft link to /G1 + CALL h5lcreate_soft_f("/G1", file_id, "/G1_LINK", error) + CALL check("h5lcreate_soft_f", error, total_error) + + + ! Create a soft link to /G1000, does not exist + CALL h5lcreate_soft_f("/G1000", file_id, "/G1_FALSE", error) + CALL check("h5lcreate_soft_f", error, total_error) + + ! Create a soft link to /G1_LINK + CALL h5lcreate_soft_f("/G1_FALSE", file_id, "/G2_FALSE", error) + CALL check("h5lcreate_soft_f", error, total_error) + + ! See if the link exists + CALL h5oexists_by_name_f(file_id,"/G1_LINK", link_exists, error) + CALL check("h5oexists_by_name_f", error, total_error) + + ! Object should exist + IF(.NOT.link_exists)THEN + CALL check("h5oexists_by_name_f", -1, total_error) + ENDIF + + chr_exact = "/G1_LINK" + ! See if the link exists + CALL h5oexists_by_name_f(file_id,chr_exact, link_exists, error, H5P_DEFAULT_F) + CALL check("h5oexists_by_name_f", error, total_error) + + ! Object should exist + IF(.NOT.link_exists)THEN + CALL check("h5oexists_by_name_f", -1, total_error) + ENDIF + + chr_lg = "/G1_LINK" + ! See if the link exists + CALL h5oexists_by_name_f(file_id,chr_lg, link_exists, error, H5P_DEFAULT_F) + CALL check("h5oexists_by_name_f", error, total_error) + + ! Object should exist + IF(.NOT.link_exists)THEN + CALL check("h5oexists_by_name_f", -1, total_error) + ENDIF + + chr_lg = "/G1_LINK " + ! See if the link exists + CALL h5oexists_by_name_f(file_id,chr_lg, link_exists, error, H5P_DEFAULT_F) + CALL check("h5oexists_by_name_f", error, total_error) + + ! Object should exist + IF(.NOT.link_exists)THEN + CALL check("h5oexists_by_name_f", -1, total_error) + ENDIF + + ! See if the link exists + CALL h5oexists_by_name_f(file_id,"/G1_FALSE", link_exists, error) + CALL check("h5oexists_by_name_f", error, total_error) + + ! Object should not exist + IF(link_exists)THEN + CALL check("h5oexists_by_name_f", -1, total_error) + ENDIF + + ! Check optional parameter + + CALL h5pcreate_f(H5P_LINK_ACCESS_F,plist,error) + CALL check("h5pcreate_f",error,total_error) + + nlinks = 2 + CALL h5pset_nlinks_f(plist, nlinks, error) + CALL check("h5pset_nlinks_f", error, total_error) + ! Ensure that nlinks was set successfully + nlinks = 0 + CALL h5pget_nlinks_f(plist, nlinks, error) + CALL check("h5pget_nlinks_f",error,total_error) + CALL VERIFY("h5pget_nlinks_f", INT(nlinks), 2, total_error) + + ! See if the link exists + CALL h5oexists_by_name_f(file_id,"/G1_LINK", link_exists, error, plist) + CALL check("h5oexists_by_name_f", error, total_error) + + ! Object should exist + IF(.not.link_exists)THEN + CALL check("h5oexists_by_name_f", -1, total_error) + ENDIF ! ! Close and release resources. ! @@ -283,6 +480,14 @@ SUBROUTINE test_h5o_link(total_error) CALL check("h5sclose_f", error, total_error) CALL h5gclose_f(group_id, error) CALL check("h5gclose_f", error, total_error) + + ! Test opening an object by index, note + CALL h5oopen_by_idx_f(file_id, "/G1/G2/G3", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, group_id, error) + CALL check("h5oopen_by_idx_f", error, total_error) + + CALL h5oclose_f(group_id, error) + CALL check("h5gclose_f", error, total_error) + ! ! create property to pass copy options ! @@ -324,7 +529,7 @@ SUBROUTINE test_h5o_link(total_error) CALL h5tcopy_f(H5T_NATIVE_INTEGER, tid, error) CALL check("h5tcopy_f", error, total_error) - ! create named datatype + ! create named datatype CALL h5tcommit_f(file_id, NAME_DATATYPE_SIMPLE, tid, error) CALL check("h5tcommit_f", error, total_error) @@ -346,8 +551,7 @@ SUBROUTINE test_h5o_link(total_error) ! Compare the datatypes CALL h5tequal_f(tid, tid2, flag, error) IF(.NOT.flag)THEN - WRITE(*,*) "h5ocopy_f FAILED" - total_error = total_error + 1 + CALL check("h5ocopy_f FAILED", -1, total_error) ENDIF ! close the destination datatype @@ -436,7 +640,6 @@ SUBROUTINE test_h5o_plist(total_error) CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error) CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error) - ! Create a group, dataset, and committed datatype within the file, ! using the respective type of creation property lists. ! @@ -472,7 +675,6 @@ SUBROUTINE test_h5o_plist(total_error) CALL h5sclose_f(dspace, error) CALL check("h5sclose_f",error,total_error) - ! Close current creation property lists CALL h5pclose_f(gcpl,error) CALL check("h5pclose_f", error, total_error) @@ -482,7 +684,6 @@ SUBROUTINE test_h5o_plist(total_error) CALL check("h5pclose_f", error, total_error) ! Retrieve each object's creation property list - CALL H5Gget_create_plist_f(grp, gcpl, error) CALL check("H5Gget_create_plist", error, total_error) @@ -492,7 +693,6 @@ SUBROUTINE test_h5o_plist(total_error) CALL H5Dget_create_plist_f(dset, dcpl, error) CALL check("H5Dget_create_plist_f", error, total_error) - ! Retrieve attribute phase change values on each creation property list and verify CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f", error, total_error) @@ -509,9 +709,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error) CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error) - ! Close current objects - CALL h5pclose_f(gcpl,error) CALL check("h5pclose_f", error, total_error) CALL h5pclose_f(dcpl,error) @@ -552,7 +750,6 @@ SUBROUTINE test_h5o_plist(total_error) CALL H5Dget_create_plist_f(dset, dcpl, error) CALL check("H5Dget_create_plist_f", error, total_error) - ! Retrieve attribute phase change values on each creation property list and verify CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f", error, total_error) @@ -569,9 +766,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error) CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error) - ! Close current objects - CALL h5pclose_f(gcpl,error) CALL check("h5pclose_f", error, total_error) CALL h5pclose_f(dcpl,error) diff --git a/fortran/test/tH5O_F03.f90 b/fortran/test/tH5O_F03.f90 new file mode 100644 index 0000000..f060a7d --- /dev/null +++ b/fortran/test/tH5O_F03.f90 @@ -0,0 +1,547 @@ +!****h* root/fortran/test/tH5O_F03.f90 +! +! NAME +! tH5O_F03.f90 +! +! FUNCTION +! Test FORTRAN HDF5 H5O APIs which are dependent on FORTRAN 2003 +! features. +! +! COPYRIGHT +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +!***** + +! ***************************************** +! *** H 5 O T E S T S +! ***************************************** +MODULE visit_cb + + USE HDF5 + USE ISO_C_BINDING + + IMPLICIT NONE + + INTEGER, PARAMETER :: info_size = 9 + + !------------------------------------------------------------------------- + ! Function: visit_obj_cb + ! + ! Purpose: Callback routine for visiting objects in a file + ! + ! Return: Success: 0 + ! Failure: -1 + ! + ! Programmer: M.S. Breitenfeld + ! July 12, 2012 + ! Adopted from C test. + ! + !------------------------------------------------------------------------- + ! + ! Object visit structs + TYPE, bind(c) :: obj_visit_t + CHARACTER(LEN=1), DIMENSION(1:180) :: path ! Path to object + INTEGER :: type_obj ! type of object + END TYPE obj_visit_t + + TYPE, bind(c) :: ovisit_ud_t + INTEGER :: idx ! Index in object visit structure + TYPE(obj_visit_t), DIMENSION(1:info_size) :: info ! Pointer to the object visit structure to use + END TYPE ovisit_ud_t + +CONTAINS + + INTEGER FUNCTION visit_obj_cb( group_id, name, oinfo, op_data) bind(C) + + IMPLICIT NONE + + INTEGER(HID_T) :: group_id + CHARACTER(LEN=1), DIMENSION(1:180) :: name + TYPE(h5o_info_t) :: oinfo + TYPE(ovisit_ud_t) :: op_data + + INTEGER :: len, i + INTEGER :: idx + + visit_obj_cb = 0 + + ! Since the name is generated in C and passed to a Fortran string, it + ! will be NULL terminated, so we need to find the end of the string. + + len = 1 + DO len = 1, 180 + IF(name(len) .EQ. C_NULL_CHAR) EXIT + ENDDO + + len = len - 1 + + ! Check for correct object information + + idx = op_data%idx + + DO i = 1, len + IF(op_data%info(idx)%path(i)(1:1) .NE. name(i)(1:1))THEN + visit_obj_cb = -1 + RETURN + ENDIF + + IF(op_data%info(idx)%type_obj .NE. oinfo%type)THEN + visit_obj_cb = -1 + RETURN + ENDIF + + ENDDO + + ! Advance to next location in expected output + op_data%idx = op_data%idx + 1 + + END FUNCTION visit_obj_cb + +END MODULE visit_cb + +!/**************************************************************** +!** +!** test_h5o_refcount(): Test H5O refcounting functions. +!** +!****************************************************************/ + +SUBROUTINE test_h5o_refcount(total_error) + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error + + CHARACTER(LEN=11), PARAMETER :: FILENAME = "th5o_ref.h5" + INTEGER, PARAMETER :: DIM0 = 5 + INTEGER, PARAMETER :: DIM1 = 10 + INTEGER(hid_t) :: fid ! HDF5 File ID + INTEGER(hid_t) :: grp, dset, dtype, dspace ! Object identifiers + TYPE(h5o_info_t) :: oinfo ! Object info struct + INTEGER(hsize_t), DIMENSION(1:2) :: dims + INTEGER :: error ! Value returned from API calls + + ! Create a new HDF5 file + CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid,error) + CALL check("h5fcreate_f", error, total_error) + + ! Create a group, dataset, and committed datatype within the file + ! Create the group + CALL h5gcreate_f(fid, "group", grp, error) + CALL check("h5gcreate_f",error, total_error) + + ! Commit the type inside the group + CALL h5tcopy_f(H5T_NATIVE_INTEGER, dtype, error) + CALL check("H5Tcopy_f",error, total_error) + CALL h5tcommit_f(fid, "datatype", dtype, error) + CALL check("h5tcommit_f", error, total_error) + + ! Create the data space for the dataset. + dims(1) = DIM0 + dims(2) = DIM1 + + CALL h5screate_simple_f(2, dims, dspace, error) + CALL check("h5screate_simple_f", error, total_error) + + ! Create the dataset. + CALL h5dcreate_f(fid, "dataset", H5T_NATIVE_INTEGER, dspace, dset, error) + CALL check("h5dcreate_f", error, total_error) + CALL h5sclose_f(dspace, error) + CALL check("h5sclose_f", error, total_error) + + ! Get ref counts for each object. They should all be 1, since each object has a hard link. + CALL h5oget_info_by_name_f(fid, "group", oinfo, error) + CALL check("h5oget_info_by_name_f", error, total_error) + IF(oinfo%rc.NE.1)THEN + CALL check("h5oget_info_by_name_f", -1, total_error) + ENDIF + CALL h5oget_info_by_name_f(fid, "datatype", oinfo, error) + CALL check("h5oget_info_by_name_f", error, total_error) + IF(oinfo%rc.NE.1)THEN + CALL check("h5oget_info_by_name_f", -1, total_error) + ENDIF + CALL h5oget_info_by_name_f(fid, "dataset", oinfo, error) + CALL check("h5oget_info_by_name_f", error, total_error) + IF(oinfo%rc.NE.1)THEN + CALL check("h5oget_info_by_name_f", -1, total_error) + ENDIF + + ! Check h5oget_info + CALL h5oget_info_f(grp, oinfo, error) + CALL check("h5oget_info_f", error, total_error) + IF(oinfo%rc.NE.1)THEN + CALL check("h5oget_info_f", -1, total_error) + ENDIF + IF(oinfo%type.NE.H5O_TYPE_GROUP_F)THEN + CALL check("h5oget_info_f", -1, total_error) + ENDIF + + ! Increment each object's reference count. + CALL h5oincr_refcount_f(grp, error) + CALL check("h5oincr_refcount_f", error, total_error) + CALL h5oincr_refcount_f(dtype, error) + CALL check("h5oincr_refcount_f", error, total_error) + CALL h5oincr_refcount_f(dset, error) + CALL check("h5oincr_refcount_f", error, total_error) + + ! Get ref counts for each object. They should all be 2 now. + CALL h5oget_info_by_name_f(fid, "group", oinfo, error) + CALL check("h5oget_info_by_name_f", error, total_error) + IF(oinfo%rc.NE.2)THEN + CALL check("h5oget_info_by_name_f", -1, total_error) + ENDIF + CALL h5oget_info_by_name_f(fid, "datatype", oinfo, error) + CALL check("h5oget_info_by_name_f", error, total_error) + IF(oinfo%rc.NE.2)THEN + CALL check("h5oget_info_by_name_f", -1, total_error) + ENDIF + CALL h5oget_info_by_name_f(fid, "dataset", oinfo, error) + CALL check("h5oget_info_by_name_f", error, total_error) + IF(oinfo%rc.NE.2)THEN + CALL check("h5oget_info_by_name_f", -1, total_error) + ENDIF + + ! Decrement the reference counts and check that they decrease back to 1. + CALL h5odecr_refcount_f(grp, error) + CALL check("h5oincr_refcount_f", error, total_error) + CALL h5odecr_refcount_f(dtype, error) + CALL check("h5oincr_refcount_f", error, total_error) + CALL h5odecr_refcount_f(dset, error) + CALL check("h5oincr_refcount_f", error, total_error) + + CALL h5oget_info_by_name_f(fid, "group", oinfo, error) + CALL check("h5oget_info_by_name_f", error, total_error) + IF(oinfo%rc.NE.1)THEN + CALL check("h5oget_info_by_name_f", -1, total_error) + ENDIF + CALL h5oget_info_by_name_f(fid, "datatype", oinfo, error) + CALL check("h5oget_info_by_name_f", error, total_error) + IF(oinfo%rc.NE.1)THEN + CALL check("h5oget_info_by_name_f", -1, total_error) + ENDIF + CALL h5oget_info_by_name_f(fid, "dataset", oinfo, error) + CALL check("h5oget_info_by_name_f", error, total_error) + IF(oinfo%rc.NE.1)THEN + CALL check("h5oget_info_by_name_f", -1, total_error) + ENDIF + + CALL h5gclose_f(grp, error) + CALL check("h5gclose_f",error, total_error) + CALL h5tclose_f(dtype, error) + CALL check("h5tclose_f",error, total_error) + CALL h5dclose_f(dset, error) + CALL check("h5dclose_f",error, total_error) + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error, total_error) + +END SUBROUTINE test_h5o_refcount + +!**************************************************************** +!** +!** test_h5o_refcount(): Test H5O visit functions. +!** +!**************************************************************** + +SUBROUTINE obj_visit(total_error) + + USE HDF5 + + USE visit_cb + USE ISO_C_BINDING + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error + + TYPE(ovisit_ud_t), TARGET :: udata ! User-data for visiting + INTEGER(hid_t) :: fid = -1 + INTEGER(hid_t) :: gid = -1 ! Group ID + TYPE(C_PTR) :: f_ptr + TYPE(C_FUNPTR) :: fun_ptr + CHARACTER(LEN=180) :: object_name + INTEGER :: ret_val + INTEGER :: error + + ! Construct "interesting" file to visit + CALL build_visit_file(fid) + + ! Inialize udata for testing purposes + udata%info(1)%path(1:1) ="." + udata%info(1)%type_obj = H5O_TYPE_GROUP_F + udata%info(2)%path(1:12) = & + (/"D","a","t","a","s","e","t","_","z","e","r","o"/) + udata%info(2)%type_obj =H5O_TYPE_DATASET_F + udata%info(3)%path(1:6) = & + (/"G","r","o","u","p","1"/) + udata%info(3)%type_obj = H5O_TYPE_GROUP_F + udata%info(4)%path(1:18) =& + (/"G","r","o","u","p","1","/","D","a","t","a","s","e","t","_","o","n","e"/) + udata%info(4)%type_obj = H5O_TYPE_DATASET_F + udata%info(5)%path(1:13) =& + (/"G","r","o","u","p","1","/","G","r","o","u","p","2"/) + udata%info(5)%type_obj = H5O_TYPE_GROUP_F + udata%info(6)%path(1:25) =& + (/"G","r","o","u","p","1","/","G","r","o","u","p","2","/","D","a","t","a","s","e","t","_","t","w","o"/) + udata%info(6)%type_obj = H5O_TYPE_DATASET_F + udata%info(7)%path(1:22) =& + (/"G","r","o","u","p","1","/","G","r","o","u","p","2","/","T","y","p","e","_","t","w","o"/) + udata%info(7)%type_obj = H5O_TYPE_NAMED_DATATYPE_F + udata%info(8)%path(1:15) =& + (/"G","r","o","u","p","1","/","T","y","p","e","_","o","n","e"/) + udata%info(8)%type_obj = H5O_TYPE_NAMED_DATATYPE_F + udata%info(9)%path(1:9) =& + (/"T","y","p","e","_","z","e","r","o"/) + udata%info(9)%type_obj = H5O_TYPE_NAMED_DATATYPE_F + + ! Visit all the objects reachable from the root group (with file ID) + udata%idx = 1 + + fun_ptr = C_FUNLOC(visit_obj_cb) + f_ptr = C_LOC(udata) + + ! Test h5ovisit_f + CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error) + CALL check("h5ovisit_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_f", -1, total_error) + ENDIF + + ! Test h5ovisit_by_name_f + + object_name = "/" + udata%idx = 1 + + CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error) + CALL check("h5ovisit_by_name_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_by_name_f", -1, total_error) + ENDIF + + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error, total_error) + +END SUBROUTINE obj_visit + +!**************************************************************** +!** +!** test_h5o_refcount(): Test H5O info functions. +!** +!**************************************************************** + +SUBROUTINE obj_info(total_error) + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(hid_t) :: fid = -1 ! File ID + INTEGER(hid_t) :: gid = -1, gid2 = -1 ! Group IDs + INTEGER(hid_t) :: did ! Dataset ID + INTEGER(hid_t) :: sid ! Dataspace ID + TYPE(hobj_ref_t_f), TARGET :: wref ! Reference to write + TYPE(hobj_ref_t_f), TARGET :: rref ! Reference to read + TYPE(H5O_info_t) :: oinfo ! Object info struct + INTEGER :: count = 0 ! Count within iterated group + INTEGER :: error + TYPE(C_PTR) :: f_ptr + + CHARACTER(LEN=6) :: GROUPNAME = "/group" + CHARACTER(LEN=6) :: GROUPNAME2 = "group2" + CHARACTER(LEN=6) :: GROUPNAME3 = "group3" + CHARACTER(LEN=5) :: DSETNAME = "/dset" + CHARACTER(LEN=5) :: DSETNAME2 = "dset2" + + ! Create file with a group and a dataset containing an object reference to the group + CALL h5fcreate_f("get_info.h5", H5F_ACC_TRUNC_F, fid, error) + CALL check("h5fcreate_f",error, total_error) + + ! Create dataspace to use for dataset + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f",error,total_error) + + ! Create group to refer to + CALL h5gcreate_f(fid, GROUPNAME, gid, error) + CALL check("h5gcreate_f",error,total_error) + + ! Create nested groups + CALL h5gcreate_f(gid, GROUPNAME2, gid2, error) + CALL check("h5gcreate_f",error,total_error) + CALL h5gclose_f(gid2, error) + CALL check("h5gclose_f",error,total_error) + + CALL h5gcreate_f(gid, GROUPNAME3, gid2, error) + CALL check("h5gcreate_f",error,total_error) + CALL h5gclose_f(gid2, error) + CALL check("h5gclose_f",error,total_error) + + ! Create bottom dataset + CALL h5dcreate_f(gid, DSETNAME2, H5T_NATIVE_INTEGER, sid, did, error) + CALL check("h5dcreate_f",error, total_error) + + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5gclose_f(gid, error) + CALL check("h5gclose_f",error,total_error) + + ! Create dataset + CALL h5dcreate_f(fid, DSETNAME, H5T_STD_REF_OBJ, sid, did, error) + CALL check("h5dcreate_f",error, total_error) + + f_ptr = C_LOC(wref) + + ! Create reference to group + CALL h5rcreate_f(fid, GROUPNAME, H5R_OBJECT_F, f_ptr, error) + CALL check("h5rcreate_f",error, total_error) + + ! Write reference to disk + CALL h5dwrite_f(did, H5T_STD_REF_OBJ, f_ptr, error) + CALL check("h5dwrite_f",error, total_error) + + ! Close objects + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f", error, total_error) + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f", error, total_error) + + ! Re-open file + CALL h5fopen_f("get_info.h5", H5F_ACC_RDWR_F, fid, error) + CALL check("h5fopen_f", error, total_error) + + ! Re-open dataset + CALL h5dopen_f(fid, DSETNAME, did, error) + CALL check("h5dopen_f", error, total_error) + + ! Read in the reference + + f_ptr = C_LOC(rref) + + CALL h5dread_f(did, H5T_STD_REF_OBJ, f_ptr, error) + CALL check("H5Dread_f",error, total_error) + + ! Dereference to get the group + + CALL h5rdereference_f(did, H5R_OBJECT_F, f_ptr, gid, error) + CALL check("h5rdereference_f", error, total_error) + + CALL h5oget_info_by_idx_f(gid, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, oinfo, error) + CALL check("h5oget_info_by_idx_f", error, total_error) + + IF(oinfo%rc.NE.1)THEN + CALL check("h5oget_info_by_idx_f", -1, total_error) + ENDIF + + IF(oinfo%type.NE.H5O_TYPE_DATASET_F)THEN + CALL check("h5oget_info_by_idx_f", -1, total_error) + ENDIF + + ! Close objects + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + CALL h5gclose_f(gid, error) + CALL check("h5sclose_f", error, total_error) + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f", error, total_error) + +END SUBROUTINE obj_info + +!------------------------------------------------------------------------- +! Function: build_visit_file +! +! Purpose: Build an "interesting" file to use for visiting links & objects +! +! Programmer: M. Scot Breitenfeld +! July 12, 2012 +! NOTE: Adapted from C test. +! +!------------------------------------------------------------------------- +! + +SUBROUTINE build_visit_file(fid) + + USE HDF5 + IMPLICIT NONE + + INTEGER(hid_t) :: fid ! File ID + INTEGER(hid_t) :: gid = -1, gid2 = -1 ! Group IDs + INTEGER(hid_t) :: sid = -1 ! Dataspace ID + INTEGER(hid_t) :: did = -1 ! Dataset ID + INTEGER(hid_t) :: tid = -1 ! Datatype ID + CHARACTER(LEN=20) :: filename = 'visit.h5' + INTEGER :: error + + ! Create file for visiting + CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, fid, error) + + ! Create group + CALL H5Gcreate_f(fid, "/Group1", gid, error) + + ! Create nested group + CALL H5Gcreate_f(gid, "Group2", gid2, error) + + ! Close groups + CALL h5gclose_f(gid2, error) + CALL h5gclose_f(gid, error) + + ! Create soft links to groups created + CALL H5Lcreate_soft_f("/Group1", fid, "/soft_one", error) + CALL H5Lcreate_soft_f("/Group1/Group2", fid, "/soft_two", error) + + ! Create dangling soft link + CALL H5Lcreate_soft_f("nowhere", fid, "/soft_dangle", error) + + ! Create hard links to all groups + CALL H5Lcreate_hard_f(fid, "/", fid, "hard_zero", error) + CALL H5Lcreate_hard_f(fid, "/Group1", fid, "hard_one", error) + CALL H5Lcreate_hard_f(fid, "/Group1/Group2", fid, "hard_two", error) + + ! Create loops w/hard links + CALL H5Lcreate_hard_f(fid, "/Group1", fid, "/Group1/hard_one", error) + CALL H5Lcreate_hard_f(fid, "/", fid, "/Group1/Group2/hard_zero", error) + + ! Create dataset in each group + CALL H5Screate_f(H5S_SCALAR_F, sid, error) + + CALL H5Dcreate_f(fid, "/Dataset_zero", H5T_NATIVE_INTEGER, sid, did, error) + CALL H5Dclose_f(did, error) + + CALL H5Dcreate_f(fid, "/Group1/Dataset_one", H5T_NATIVE_INTEGER, sid, did, error) + CALL H5Dclose_f(did, error) + + CALL H5Dcreate_f(fid, "/Group1/Group2/Dataset_two", H5T_NATIVE_INTEGER, sid, did, error) + CALL H5Dclose_f(did, error) + + CALL H5Sclose_f(sid, error) + + ! Create named datatype in each group + CALL H5Tcopy_f(H5T_NATIVE_INTEGER, tid, error) + + CALL H5Tcommit_f(fid, "/Type_zero", tid, error) + CALL H5Tclose_f(tid, error) + + CALL H5Tcopy_f(H5T_NATIVE_INTEGER, tid, error) + CALL H5Tcommit_f(fid, "/Group1/Type_one", tid, error) + CALL H5Tclose_f(tid, error) + + CALL H5Tcopy_f(H5T_NATIVE_INTEGER, tid, error) + CALL H5Tcommit_f(fid, "/Group1/Group2/Type_two", tid, error) + CALL H5Tclose_f(tid, error) + +END SUBROUTINE build_visit_file diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 index 9605c45..b42a8e6 100644 --- a/fortran/test/tH5T.f90 +++ b/fortran/test/tH5T.f90 @@ -86,8 +86,8 @@ CHARACTER(LEN=2), DIMENSION(dimsize) :: char_member_out ! Buffer to read data out INTEGER, DIMENSION(dimsize) :: int_member INTEGER, DIMENSION(dimsize) :: int_member_out - DOUBLE PRECISION, DIMENSION(dimsize) :: double_member - DOUBLE PRECISION, DIMENSION(dimsize) :: double_member_out + REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member + REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member_out REAL, DIMENSION(dimsize) :: real_member REAL, DIMENSION(dimsize) :: real_member_out INTEGER :: i diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90 index 215ac9e..1c4da8b 100644 --- a/fortran/test/tH5T_F03.f90 +++ b/fortran/test/tH5T_F03.f90 @@ -103,7 +103,7 @@ SUBROUTINE test_array_compound_atomic(total_error) ! Create file CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid1,error) - CALL check("h5fcreate_f", error, total_error) + CALL check("h5fcreate_f", error, total_error) ! Create dataspace for datasets CALL h5screate_simple_f(SPACE1_RANK, sdims1, sid1, error) @@ -1976,8 +1976,8 @@ SUBROUTINE t_regref(total_error) INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims INTEGER(hssize_t) :: npoints - TYPE(hdset_reg_ref_t_f), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer - TYPE(hdset_reg_ref_t_f), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer + TYPE(hdset_reg_ref_t_f03), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer + TYPE(hdset_reg_ref_t_f03), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer INTEGER(size_t) :: size CHARACTER(LEN=1), DIMENSION(1:ds2dim0,1:ds2dim1), TARGET :: wdata2 @@ -2058,7 +2058,6 @@ SUBROUTINE t_regref(total_error) CALL check("h5sclose_f",error, total_error) CALL h5fclose_f(file , error) CALL check("h5fclose_f",error, total_error) - ! ! Now we begin the read section of this example. ! @@ -2095,10 +2094,11 @@ SUBROUTINE t_regref(total_error) ! Open the referenced object, retrieve its region as a ! dataspace selection. ! - CALL H5Rdereference_f(dset, rdata(i), dset2, error) + f_ptr = C_LOC(rdata(i)) + CALL H5Rdereference_f(dset, H5R_DATASET_REGION_F, f_ptr, dset2, error) CALL check("H5Rdereference_f",error, total_error) - - CALL H5Rget_region_f(dset, rdata(i), space, error) + + CALL H5Rget_region_f(dset, f_ptr, space, error) CALL check("H5Rget_region_f",error, total_error) ! @@ -2754,7 +2754,7 @@ SUBROUTINE t_string(total_error) CALL check("H5Dget_type_f",error, total_error) CALL H5Tget_size_f(filetype, size, error) CALL check("H5Tget_size_f",error, total_error) - CALL VERIFY("H5Tget_size_f", size, sdim, total_error) + CALL VERIFY("H5Tget_size_f", INT(size), INT(sdim), total_error) ! ! Get dataspace. ! @@ -2800,4 +2800,295 @@ SUBROUTINE t_string(total_error) END SUBROUTINE t_string +SUBROUTINE vl_test_special_char(cleanup, total_error) + + USE hdf5 + IMPLICIT NONE + + INTERFACE + SUBROUTINE setup_buffer(data_in, line_lengths, char_type) + USE hdf5 + USE ISO_C_BINDING + IMPLICIT NONE + CHARACTER(len=*), DIMENSION(:) :: data_in + INTEGER(size_t), DIMENSION(:) :: line_lengths + CHARACTER(KIND=C_CHAR,LEN=*) :: char_type + END SUBROUTINE setup_buffer + END INTERFACE + + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=16), PARAMETER :: filename = "t_controlchar.h5" + INTEGER, PARAMETER :: line_length = 10 + INTEGER(hid_t) :: file + INTEGER(hid_t) :: dataset0 + CHARACTER(len=line_length), DIMENSION(1:100) :: data_in + CHARACTER(len=line_length), DIMENSION(1:100) :: data_out + INTEGER(size_t), DIMENSION(1:100) :: line_lengths + INTEGER(hid_t) :: string_id, space, dcpl + INTEGER(hsize_t), DIMENSION(1:1) :: dims = (/0/) + INTEGER(hsize_t), DIMENSION(1:1) :: max_dims = (/0/) + INTEGER(hsize_t), DIMENSION(1:2) :: data_dims = (/0,0/) + INTEGER(hsize_t), DIMENSION(1:1) :: chunk =(/10/) + INTEGER, PARAMETER :: ncontrolchar = 7 + CHARACTER(KIND=C_CHAR,LEN=1), DIMENSION(1:ncontrolchar) :: controlchar = & + (/C_ALERT, C_BACKSPACE,C_CARRIAGE_RETURN, C_FORM_FEED,C_HORIZONTAL_TAB,C_VERTICAL_TAB, C_NEW_LINE/) + INTEGER :: i, j, n, error + n = 8 + ! + ! Create a new file using the default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error) + CALL check("h5fcreate_f",error, total_error) + + max_dims = (/H5S_UNLIMITED_F/) + + ! + ! Create the memory datatype. + ! + CALL h5tcopy_f(h5t_string, string_id, error) + CALL check("h5tcopy_f", error, total_error) + CALL h5tset_strpad_f(string_id, h5t_str_nullpad_f, error) + CALL check("h5tset_strpad_f", error, total_error) + dims(1) = n + ! + ! Create dataspace. + ! + CALL h5screate_simple_f(1, dims, space, error, max_dims) + CALL check("h5screate_simple_f", error, total_error) + CALL h5pcreate_f(h5p_dataset_create_f, dcpl, error) + CALL check("h5pcreate_f", error, total_error) + CALL h5pset_chunk_f(dcpl, 1, chunk, error) + CALL check("h5pset_chunk_f", error, total_error) + + data_dims(1) = line_length + data_dims(2) = n + ! + ! Create data with strings containing various control characters. + ! + DO i = 1, ncontrolchar + ! + ! Create the dataset, for the string with control character and write the string data to it. + ! + CALL h5dcreate_f(file, controlchar(i), string_id, space, dataset0, error, dcpl) + CALL check("h5dcreate_f", error, total_error) + CALL setup_buffer(data_in(1:n), line_lengths, controlchar(i)) + CALL h5dwrite_vl_f(dataset0, string_id, data_in(1:n), data_dims, line_lengths(1:n), error, space) + CALL check("h5dwrite_vl_f", error, total_error) + ! + ! Read the string back. + ! + CALL h5dread_vl_f(dataset0, string_id, data_out(1:n), data_dims, line_lengths(1:n), error, space) + CALL check("h5dread_vl_f", error, total_error) + + DO j = 1, n + IF(data_in(j).NE.data_out(j))THEN + total_error = total_error + 1 + EXIT + ENDIF + ENDDO + + CALL h5dclose_f(dataset0, error) + CALL check("h5dclose_f", error, total_error) + ENDDO + + CALL h5pclose_f(dcpl, error) + CALL check("h5pclose_f", error, total_error) + CALL h5sclose_f(space, error) + CALL check("h5sclose_f", error, total_error) + CALL h5fclose_f(file, error) + CALL check("h5fclose_f", error, total_error) + +END SUBROUTINE vl_test_special_char + + +SUBROUTINE setup_buffer(data_in, line_lengths, char_type) + + USE HDF5 + USE ISO_C_BINDING + + IMPLICIT NONE + + ! Creates a simple "Data_in" consisting of the letters of the alphabet, + ! one per line, with a control character. + + CHARACTER(len=10), DIMENSION(:) :: data_in + INTEGER(size_t), DIMENSION(:) :: line_lengths + INTEGER, DIMENSION(1:3) :: letters + CHARACTER(LEN=3) :: lets + CHARACTER(KIND=C_CHAR,LEN=*) :: char_type + CHARACTER(KIND=C_CHAR,LEN=1) :: char_tmp + INTEGER :: i, j, n, ff + + ! Convert the letters and special character to integers + lets = 'abc' + + READ(lets,'(3A1)') letters + READ(char_type,'(A1)') ff + n = SIZE(data_in) + j = 1 + DO i=1,n-1 + IF( j .EQ. 4 )THEN + WRITE(char_tmp,'(A1)') ff + data_in(i:i) = char_tmp + ELSE + WRITE(char_tmp,'(A1)') letters(j) + data_in(i:i) = char_tmp + ENDIF + line_lengths(i) = LEN_TRIM(data_in(i)) + j = j + 1 + IF( j .EQ. 5 ) j = 1 + END DO + WRITE(char_tmp,'(A1)') ff + data_in(n:n) = char_tmp + line_lengths(n) = 1 + +END SUBROUTINE setup_buffer + +!------------------------------------------------------------------------- +! Function: test_nbit +! +! Purpose: Tests (real, 4 byte) datatype for nbit filter +! +! Return: Success: 0 +! Failure: >0 +! +! Programmer: M. Scot Breitenfeld +! Decemeber 7, 2010 +! +! Modifications: Moved this subroutine from the 1.8 test file and +! modified it to use F2003 features. +! This routine requires 4 byte reals, so we use F2003 features to +! ensure the requirement is satisfied in a portable way. +! The need for this arises when a user specifies the default real is 8 bytes. +! MSB 7/31/12 +! +!------------------------------------------------------------------------- +! + +SUBROUTINE test_nbit(cleanup, total_error ) + + USE HDF5 + USE ISO_C_BINDING + + IMPLICIT NONE + INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER(hid_t) :: file + + INTEGER(hid_t) :: dataset, datatype, space, dc, mem_type_id + INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2,5/) + INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2,5/) + ! orig_data[] are initialized to be within the range that can be represented by + ! dataset datatype (no precision loss during datatype conversion) + ! + REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: orig_data = & + RESHAPE( (/188384.00, 19.103516, -1.0831790e9, -84.242188, & + 5.2045898, -49140.000, 2350.2500, -3.2110596e-1, 6.4998865e-5, -0.0000000/) , (/2,5/) ) + REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: new_data + INTEGER(size_t) :: PRECISION, offset + INTEGER :: error + LOGICAL :: status + INTEGER(size_t) :: i, j + TYPE(C_PTR) :: f_ptr + + ! check to see if filter is available + CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error) + IF(.NOT.status)THEN ! We don't have H5Z_FILTER_NBIT_F filter + total_error = -1 ! so return + RETURN + ENDIF + + CALL H5Fcreate_f("nbit.h5", H5F_ACC_TRUNC_F, file, error) + CALL check("H5Fcreate_f", error, total_error) + + ! Define dataset datatype (integer), and set precision, offset + CALL H5Tcopy_f(H5T_IEEE_F32BE, datatype, error) + CALL CHECK(" H5Tcopy_f", error, total_error) + CALL H5Tset_fields_f(datatype, 26_size_t, 20_size_t, 6_size_t, 7_size_t, 13_size_t, error) + CALL CHECK(" H5Tset_fields_f", error, total_error) + offset = 7 + CALL H5Tset_offset_f(datatype, offset, error) + CALL CHECK(" H5Tset_offset_f", error, total_error) + PRECISION = 20 + CALL H5Tset_precision_f(datatype,PRECISION, error) + CALL CHECK(" H5Tset_precision_f", error, total_error) + + CALL H5Tset_size_f(datatype, 4_size_t, error) + CALL CHECK(" H5Tset_size_f", error, total_error) + + CALL H5Tset_ebias_f(datatype, 31_size_t, error) + CALL CHECK(" H5Tset_ebias_f", error, total_error) + + ! Create the data space + CALL H5Screate_simple_f(2, dims, space, error) + CALL CHECK(" H5Screate_simple_f", error, total_error) + + ! USE nbit filter + CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error) + CALL CHECK(" H5Pcreate_f", error, total_error) + + CALL H5Pset_chunk_f(dc, 2, chunk_dim, error) + CALL CHECK(" H5Pset_chunk_f", error, total_error) + CALL H5Pset_nbit_f(dc, error) + CALL CHECK(" H5Pset_nbit_f", error, total_error) + + ! Create the dataset + CALL H5Dcreate_f(file, "nbit_real", datatype, & + space, dataset, error, dc) + CALL CHECK(" H5Dcreate_f", error, total_error) + + !---------------------------------------------------------------------- + ! STEP 1: Test nbit by setting up a chunked dataset and writing + ! to it. + !---------------------------------------------------------------------- + ! + mem_type_id = h5kind_to_type(wp,H5_REAL_KIND) + + f_ptr = C_LOC(orig_data(1,1)) + CALL H5Dwrite_f(dataset, mem_type_id, f_ptr, error) + CALL CHECK(" H5Dwrite_f", error, total_error) + + !---------------------------------------------------------------------- + ! STEP 2: Try to read the data we just wrote. + !---------------------------------------------------------------------- + ! + f_ptr = C_LOC(new_data(1,1)) + CALL H5Dread_f(dataset, mem_type_id, f_ptr, error) + CALL CHECK(" H5Dread_f", error, total_error) + + ! Check that the values read are the same as the values written + ! Assume size of long long = size of double + ! + i_loop: DO i = 1, dims(1) + j_loop: DO j = 1, dims(2) + IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE ! skip IF value is NaN + IF(new_data(i,j) .NE. orig_data(i,j))THEN + total_error = total_error + 1 + WRITE(*,'(" Read different values than written.")') + WRITE(*,'(" At index ", 2(1X,I0))') i, j + EXIT i_loop + END IF + ENDDO j_loop + ENDDO i_loop + + !---------------------------------------------------------------------- + ! Cleanup + !---------------------------------------------------------------------- + ! + CALL H5Tclose_f(datatype, error) + CALL CHECK(" H5Tclose_f", error, total_error) + CALL H5Pclose_f(dc, error) + CALL CHECK(" H5Pclose_f", error, total_error) + CALL H5Sclose_f(space, error) + CALL CHECK(" H5Sclose_f", error, total_error) + CALL H5Dclose_f(dataset, error) + CALL CHECK(" H5Dclose_f", error, total_error) + CALL H5Fclose_f(file, error) + CALL CHECK(" H5Fclose_f", error, total_error) + +END SUBROUTINE test_nbit + diff --git a/fortran/testpar/hyper.f90 b/fortran/testpar/hyper.f90 index 1d65ae1..1a580ca 100644 --- a/fortran/testpar/hyper.f90 +++ b/fortran/testpar/hyper.f90 @@ -50,6 +50,7 @@ SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) INTEGER :: icount ! number of elements in array CHARACTER(len=80) :: filename ! filename INTEGER :: i + INTEGER :: actual_io_mode ! The type of I/O performed by this process !////////////////////////////////////////////////////////// ! initialize the array data between the processes (3) @@ -180,6 +181,24 @@ SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) CALL check("h5dwrite_f", hdferror, nerrors) + ! Check h5pget_mpio_actual_io_mode_f function + CALL h5pget_mpio_actual_io_mode_f(dxpl_id, actual_io_mode, hdferror) + CALL check("h5pget_mpio_actual_io_mode_f", hdferror, nerrors) + + IF(do_collective.AND.do_chunk)THEN + IF(actual_io_mode.NE.H5D_MPIO_CHUNK_COLLECTIVE_F)THEN + CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) + ENDIF + ELSEIF(.NOT.do_collective)THEN + IF(actual_io_mode.NE.H5D_MPIO_NO_COLLECTIVE_F)THEN + CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) + ENDIF + ELSEIF( do_collective.AND.(.NOT.do_chunk))THEN + IF(actual_io_mode.NE.H5D_MPIO_CONTIG_COLLECTIVE_F)THEN + CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) + ENDIF + ENDIF + !////////////////////////////////////////////////////////// ! close HDF5 I/O !////////////////////////////////////////////////////////// |