mirror of
https://github.com/HDFGroup/hdf5.git
synced 2025-04-12 17:31:09 +08:00
[svn-r9644] Purpose:
add hl fortran Description: Solution: Platforms tested: linux (absfot and pgf90) solaris (32 and 64 bit) AIX note : HP gives a compiling error , to be fixed in the future Misc. update:
This commit is contained in:
Pedro Vicente Nunes
parent
38eedcb94c
commit
dd7c794469
19
MANIFEST
19
MANIFEST
@ -1569,5 +1569,24 @@
|
||||
./hl/test/test_table_be.hdf5
|
||||
./hl/test/test_table_cray.hdf5
|
||||
|
||||
# hl fortran
|
||||
./hl/fortran/src/Dependencies
|
||||
./hl/fortran/src/H5f90i.h
|
||||
./hl/fortran/src/H5IMfc.c
|
||||
./hl/fortran/src/H5IMff.f90
|
||||
./hl/fortran/src/H5LTf90proto.h
|
||||
./hl/fortran/src/H5LTfc.c
|
||||
./hl/fortran/src/H5LTff.f90
|
||||
./hl/fortran/src/H5TBfc.c
|
||||
./hl/fortran/src/H5TBff.f90
|
||||
./hl/fortran/src/Makefile.in
|
||||
./hl/fortran/test/Makefile.in
|
||||
./hl/fortran/test/tstimage.f90
|
||||
./hl/fortran/test/tstlite.f90
|
||||
./hl/fortran/test/tsttable.f90
|
||||
./hl/fortran/test/Dependencies
|
||||
./hl/fortran/Makefile.in
|
||||
|
||||
|
||||
|
||||
./windows/all.zip
|
||||
|
||||
@ -25,7 +25,8 @@ srcdir=@srcdir@
|
||||
# Subdirectories in build-order (not including `examples')
|
||||
# TESTPARALLEL must be after test since it uses libtest.a. Putting it
|
||||
# before tools allows parallel tests to run sooner.
|
||||
SUBDIRS=src test @TESTPARALLEL@ tools @HL@ @PABLO@ @HDF5_INTERFACES@
|
||||
# HL must be last because it might depend on the FORTRAN library
|
||||
SUBDIRS=src test @TESTPARALLEL@ tools @PABLO@ @HDF5_INTERFACES@ @HL@
|
||||
|
||||
##############################################################################
|
||||
## T A R G E T S
|
||||
|
||||
@ -261,7 +261,7 @@ done
|
||||
|
||||
if test -n "$F9XMODFLAG"; then
|
||||
echo $F9XMODFLAG 1>&6
|
||||
FFLAGS="$F9XMODFLAG. $F9XMODFLAG../src $FFLAGS"
|
||||
FFLAGS="$F9XMODFLAG. $F9XMODFLAG../src $F9XMODFLAG../../../fortran/src $FFLAGS"
|
||||
else
|
||||
echo unknown 1>&6
|
||||
fi
|
||||
|
||||
19
configure
vendored
19
configure
vendored
@ -7454,7 +7454,7 @@ done
|
||||
|
||||
if test -n "$F9XMODFLAG"; then
|
||||
echo $F9XMODFLAG 1>&6
|
||||
FFLAGS="$F9XMODFLAG. $F9XMODFLAG../src $FFLAGS"
|
||||
FFLAGS="$F9XMODFLAG. $F9XMODFLAG../src $F9XMODFLAG../../../fortran/src $FFLAGS"
|
||||
else
|
||||
echo unknown 1>&6
|
||||
fi
|
||||
@ -33928,6 +33928,8 @@ fi
|
||||
|
||||
|
||||
HL=""
|
||||
# name of fortran folder inside "hl", if FORTRAN compile is requested
|
||||
HL_FOR=""
|
||||
echo "$as_me:$LINENO: checking if high level library is enabled" >&5
|
||||
echo $ECHO_N "checking if high level library is enabled... $ECHO_C" >&6
|
||||
# Check whether --enable-hl or --disable-hl was given.
|
||||
@ -34014,14 +34016,24 @@ if test "X$HDF_CXX" = "Xyes"; then
|
||||
fi
|
||||
|
||||
# conditionally generate the high level makefiles
|
||||
# to do : fortran with hl
|
||||
|
||||
if test "X$HDF5_HL" = "Xyes"; then
|
||||
HL_FILES="hl/Makefile
|
||||
hl/src/Makefile
|
||||
hl/test/Makefile"
|
||||
fi
|
||||
|
||||
# with FORTRAN support
|
||||
if test "X$HDF5_HL" = "Xyes" && test "X$HDF_FORTRAN" = "Xyes"; then
|
||||
HL_FILES="hl/Makefile
|
||||
hl/src/Makefile
|
||||
hl/test/Makefile
|
||||
hl/fortran/Makefile
|
||||
hl/fortran/src/Makefile
|
||||
hl/fortran/test/Makefile"
|
||||
# name of folder inside "hl"
|
||||
HL_FOR="fortran"
|
||||
fi
|
||||
|
||||
|
||||
|
||||
ac_config_files="$ac_config_files src/libhdf5.settings config/depend1 config/depend2 config/depend3 config/depend4 config/dependN config/commence config/conclude Makefile src/Makefile $PABLO_MAKE test/Makefile $PARALLEL_MAKE perform/Makefile tools/Makefile tools/h5dump/Makefile tools/h5dump/testh5dump.sh tools/h5import/Makefile tools/h5diff/Makefile tools/h5repack/Makefile tools/h5repack/h5repack.sh tools/h5ls/Makefile tools/lib/Makefile tools/misc/Makefile tools/misc/h5cc tools/gifconv/Makefile tools/h5jam/Makefile tools/h5jam/testh5jam.sh examples/Makefile doc/Makefile doc/html/Makefile doc/html/ed_libs/Makefile doc/html/ed_styles/Makefile doc/html/ADGuide/Makefile doc/html/Graphics/Makefile doc/html/Intro/Makefile doc/html/PSandPDF/Makefile doc/html/TechNotes/Makefile doc/html/Tutor/Makefile doc/html/Tutor/Graphics/Makefile doc/html/Tutor/examples/Makefile doc/html/cpplus/Makefile doc/html/fortran/Makefile $FORTRAN_FILES $CXX_FILES $HL_FILES"
|
||||
@ -34723,6 +34735,7 @@ s,@CC_VERSION@,$CC_VERSION,;t t
|
||||
s,@ROOT@,$ROOT,;t t
|
||||
s,@DYNAMIC_DIRS@,$DYNAMIC_DIRS,;t t
|
||||
s,@HL@,$HL,;t t
|
||||
s,@HL_FOR@,$HL_FOR,;t t
|
||||
/@COMMENCE@/r $COMMENCE
|
||||
s,@COMMENCE@,,;t t
|
||||
/@CONCLUDE@/r $CONCLUDE
|
||||
|
||||
16
configure.in
16
configure.in
@ -2820,6 +2820,8 @@ dnl Check if they would like the High Level library compiled
|
||||
dnl
|
||||
|
||||
AC_SUBST(HL) HL=""
|
||||
# name of fortran folder inside "hl", if FORTRAN compile is requested
|
||||
AC_SUBST(HL_FOR) HL_FOR=""
|
||||
AC_MSG_CHECKING([if high level library is enabled])
|
||||
AC_ARG_ENABLE([hl],
|
||||
[AC_HELP_STRING([--enable-hl],
|
||||
@ -2916,14 +2918,24 @@ if test "X$HDF_CXX" = "Xyes"; then
|
||||
fi
|
||||
|
||||
# conditionally generate the high level makefiles
|
||||
# to do : fortran with hl
|
||||
|
||||
if test "X$HDF5_HL" = "Xyes"; then
|
||||
HL_FILES="hl/Makefile
|
||||
hl/src/Makefile
|
||||
hl/test/Makefile"
|
||||
fi
|
||||
|
||||
# with FORTRAN support
|
||||
if test "X$HDF5_HL" = "Xyes" && test "X$HDF_FORTRAN" = "Xyes"; then
|
||||
HL_FILES="hl/Makefile
|
||||
hl/src/Makefile
|
||||
hl/test/Makefile
|
||||
hl/fortran/Makefile
|
||||
hl/fortran/src/Makefile
|
||||
hl/fortran/test/Makefile"
|
||||
# name of folder inside "hl"
|
||||
HL_FOR="fortran"
|
||||
fi
|
||||
|
||||
|
||||
|
||||
AC_CONFIG_FILES([src/libhdf5.settings
|
||||
|
||||
@ -14,7 +14,7 @@ srcdir=@srcdir@
|
||||
|
||||
|
||||
# Subdirectories in build-order
|
||||
SUBDIRS=src test
|
||||
SUBDIRS=src test @HL_FOR@
|
||||
|
||||
##############################################################################
|
||||
## T A R G E T S
|
||||
|
||||
100
hl/fortran/Makefile.in
Normal file
100
hl/fortran/Makefile.in
Normal file
@ -0,0 +1,100 @@
|
||||
## Top-level HDF5 Makefile(.in)
|
||||
##
|
||||
## Copyright (C) 2001 National Center for Supercomputing Applications.
|
||||
## All rights reserved.
|
||||
##
|
||||
##
|
||||
## This makefile mostly just reinvokes make in the various subdirectories
|
||||
## but does so in the correct order. You can alternatively invoke make from
|
||||
## each subdirectory manually.
|
||||
##
|
||||
top_srcdir=@top_srcdir@
|
||||
top_builddir=../..
|
||||
srcdir=@srcdir@
|
||||
|
||||
|
||||
# Subdirectories in build-order
|
||||
SUBDIRS=src test
|
||||
|
||||
##############################################################################
|
||||
## T A R G E T S
|
||||
##
|
||||
## all: Build libraries, header files, tests, and programs in the
|
||||
## various subdirectories but does not run tests or install the
|
||||
## library, header files, or programs. The components can be
|
||||
## built individually with the targets lib, progs, and tests.
|
||||
## check: Test the uninstalled library to make sure it works. You may
|
||||
## also say `test' or `_test' (`test' doesn't work from the top
|
||||
## level directory for some versions of make because `test' is
|
||||
## also a directory).
|
||||
## install: Installs libraries, header files, programs, and documentation
|
||||
## in the various directories under the prefix directory (lib,
|
||||
## include, bin, man, info). Use the `--prefix=PATH' option
|
||||
## to `configure' (or `config.status') or say `--help' for
|
||||
## other alternatives. The default prefix is `/usr/local'.
|
||||
## uninstall: Delete all the installed files that the `install' target
|
||||
## created (but not the noninstalled files such as `make all'
|
||||
## created).
|
||||
## clean: Removes temporary files except those that record the
|
||||
## configuration and those that are part of the distribution.
|
||||
## mostlyclean: Like `clean' except it doesn't delete a few files like
|
||||
## libraries, programs, and/or generated header files because
|
||||
## regenerating them is rarely necessary and takes a lot of time.
|
||||
## distclean: Deletes all files that are created by configuring or building
|
||||
## HDF5. If you have unpacked the source and built HDF5 without
|
||||
## creating any other files, then `make distclean' will leave
|
||||
## only the files that were in the distrubution.
|
||||
## maintainer-clean:
|
||||
## Like `distclean' except it deletes more files. It deletes
|
||||
## all generated files. This target is not intended for normal
|
||||
## users; it deletes files that may require special tools to
|
||||
## rebuild.
|
||||
## TAGS: Updates the tags table for this program.
|
||||
## dep depend: Builds dependencies in all subdirectories. These targets
|
||||
## might not be available on certain combinations of make
|
||||
## programs and C compilers. At the other extreme, the GNU
|
||||
## make used in combination with gcc will maintain dependency
|
||||
## information automatically.
|
||||
lib progs check test _test uninstall:
|
||||
@@SETX@; for d in $(SUBDIRS); do \
|
||||
(cd $$d && $(MAKE) $@) || exit 1; \
|
||||
done
|
||||
|
||||
tests TAGS dep depend:
|
||||
@@SETX@; for d in $(SUBDIRS); do \
|
||||
(cd $$d && $(MAKE) $@) || exit 1; \
|
||||
done
|
||||
|
||||
install:
|
||||
@@SETX@; for d in $(SUBDIRS); do \
|
||||
(cd $$d && $(MAKE) $@) || exit 1; \
|
||||
done
|
||||
|
||||
install-doc:
|
||||
(cd doc && $(MAKE) $@) || exit 1;
|
||||
|
||||
uninstall-doc:
|
||||
(cd doc && $(MAKE) $@) || exit 1;
|
||||
|
||||
.PHONY: all lib progs test _test install uninstall dep depend clean \
|
||||
mostlyclean distclean maintainer-clean
|
||||
|
||||
clean mostlyclean:
|
||||
@@SETX@; for d in $(SUBDIRS); do \
|
||||
(cd $$d && $(MAKE) $@); \
|
||||
done
|
||||
|
||||
distclean:
|
||||
@@SETX@; for d in $(SUBDIRS); do \
|
||||
(cd $$d && $(MAKE) $@); \
|
||||
done
|
||||
-$(RM) Makefile
|
||||
|
||||
maintainer-clean:
|
||||
@echo "This target is intended for maintainers to use;"
|
||||
@echo "it deletes files that may require special tools to rebuild."
|
||||
@@SETX@; for d in $(SUBDIRS); do \
|
||||
(cd $$d && $(MAKE) $@); \
|
||||
done
|
||||
|
||||
|
||||
4
hl/fortran/src/Dependencies
Normal file
4
hl/fortran/src/Dependencies
Normal file
@ -0,0 +1,4 @@
|
||||
H5LTff.lo: $(srcdir)/H5LTff.f90
|
||||
H5IMff.lo: $(srcdir)/H5IMff.f90
|
||||
H5TBff.lo: $(srcdir)/H5TBff.f90
|
||||
|
||||
705
hl/fortran/src/H5IMfc.c
Executable file
705
hl/fortran/src/H5IMfc.c
Executable file
@ -0,0 +1,705 @@
|
||||
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
* 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
|
||||
* access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
|
||||
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
|
||||
|
||||
/* This files contains C stubs for H5D Fortran APIs */
|
||||
|
||||
#include "H5IM.h"
|
||||
#include "H5LTf90proto.h"
|
||||
#include <stdlib.h>
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5immake_image_8bit_c
|
||||
*
|
||||
* Purpose: Call H5IMmake_image_8bit
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 05, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5immake_image_8bit_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *width,
|
||||
hsize_t_f *height,
|
||||
unsigned char *buf)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5IMmake_image_8bit function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
ret = H5IMmake_image_8bit(c_loc_id,c_name,*width,*height,buf);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5imread_image_c
|
||||
*
|
||||
* Purpose: Call H5IMread_image
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 05, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5imread_image_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
unsigned char *buf)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5IMread_image function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
ret = H5IMread_image(c_loc_id,c_name,buf);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5immake_image_24bit_c
|
||||
*
|
||||
* Purpose: Call H5IMmake_image_24bit
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 05, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5immake_image_24bit_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *ilen,
|
||||
_fcd il,
|
||||
hsize_t_f *width,
|
||||
hsize_t_f *height,
|
||||
unsigned char *buf)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
char *c_il;
|
||||
int c_ilen;
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
c_ilen = *ilen;
|
||||
c_il = (char *)HD5f2cstring(il, c_ilen);
|
||||
if (c_il == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5IMmake_image_24bit function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
ret = H5IMmake_image_24bit(c_loc_id,c_name,*width,*height,c_il,buf);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5imget_image_info_c
|
||||
*
|
||||
* Purpose: Call H5IMget_image_info
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 05, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5imget_image_info_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *width,
|
||||
hsize_t_f *height,
|
||||
hsize_t_f *planes,
|
||||
hsize_t_f *npals,
|
||||
int_f *ilen,
|
||||
_fcd interlace)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
hsize_t c_width;
|
||||
hsize_t c_height;
|
||||
hsize_t c_planes;
|
||||
hssize_t c_npals;
|
||||
char *c_buf=NULL; /* Buffer to hold C string */
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Allocate buffer to hold name of an attribute
|
||||
*/
|
||||
if ((c_buf = malloc((size_t)*ilen +1)) == NULL)
|
||||
return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5IMget_image_info function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
ret = H5IMget_image_info(c_loc_id,c_name,&c_width,&c_height,&c_planes,c_buf,&c_npals);
|
||||
|
||||
*width = (hsize_t_f) c_width;
|
||||
*height = (hsize_t_f) c_height;
|
||||
*planes = (hsize_t_f) c_planes;
|
||||
*npals = (hsize_t_f) c_npals;
|
||||
|
||||
|
||||
/*
|
||||
* Convert C name to FORTRAN and place it in the given buffer
|
||||
*/
|
||||
HD5packFstring(c_buf, _fcdtocp(interlace), (size_t)*ilen);
|
||||
|
||||
if(c_buf) free(c_buf);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5imis_image_c
|
||||
*
|
||||
* Purpose: Call H5IMis_image
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 06, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5imis_image_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name)
|
||||
{
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return -1;
|
||||
|
||||
/*
|
||||
* Call H5LTget_dataset_ndims function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
return( H5IMis_image(c_loc_id, c_name));
|
||||
|
||||
}
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5immake_palette_c
|
||||
*
|
||||
* Purpose: Call H5IMmake_palette
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 06, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5immake_palette_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *dims,
|
||||
unsigned char *buf)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
hsize_t *c_dims;
|
||||
int i;
|
||||
int rank=2;
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
c_dims = malloc(sizeof(hsize_t) * (rank ));
|
||||
if (!c_dims) return ret_value;
|
||||
|
||||
for (i = 0; i < rank ; i++) {
|
||||
c_dims[i] = dims[i];
|
||||
}
|
||||
|
||||
/*
|
||||
* Call H5IMmake_palette function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
ret = H5IMmake_palette(c_loc_id,c_name,c_dims,buf);
|
||||
|
||||
free (c_dims);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5imlink_palette_c
|
||||
*
|
||||
* Purpose: Call H5IMlink_palette
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 06, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5imlink_palette_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *ilen,
|
||||
_fcd pal_name)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
char *c_namepal;
|
||||
int c_namelenpal;
|
||||
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
c_namelenpal = *ilen;
|
||||
c_namepal = (char *)HD5f2cstring(pal_name, c_namelenpal);
|
||||
if (c_namepal == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5IMlink_palette function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
ret = H5IMlink_palette(c_loc_id,c_name,c_namepal);
|
||||
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5imunlink_palette_c
|
||||
*
|
||||
* Purpose: Call H5IMunlink_palette
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 06, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5imunlink_palette_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *ilen,
|
||||
_fcd pal_name)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
char *c_namepal;
|
||||
int c_namelenpal;
|
||||
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
c_namelenpal = *ilen;
|
||||
c_namepal = (char *)HD5f2cstring(pal_name, c_namelenpal);
|
||||
if (c_namepal == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5IMunlink_palette function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
ret = H5IMunlink_palette(c_loc_id,c_name,c_namepal);
|
||||
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5imget_npalettes_c
|
||||
*
|
||||
* Purpose: Call H5IMget_npalettes
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 06 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5imget_npalettes_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *npals)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
hssize_t c_npals;
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5IMget_image_info function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
ret = H5IMget_npalettes(c_loc_id,c_name,&c_npals);
|
||||
|
||||
*npals = (hsize_t_f) c_npals;
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5imget_palette_info_c
|
||||
*
|
||||
* Purpose: Call H5IMget_palette_info
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 06 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
|
||||
int_f
|
||||
nh5imget_palette_info_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *pal_number,
|
||||
hsize_t_f *dims)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
hsize_t c_dims[2];
|
||||
int i;
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5IMget_image_info function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
ret = H5IMget_palette_info(c_loc_id,c_name,*pal_number,c_dims);
|
||||
|
||||
for (i = 0; i < 2 ; i++) {
|
||||
dims[i] = (hsize_t_f) c_dims[i];
|
||||
}
|
||||
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5imget_palette_c
|
||||
*
|
||||
* Purpose: Call H5IMget_palette
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 06 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
|
||||
int_f
|
||||
nh5imget_palette_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *pal_number,
|
||||
unsigned char *buf)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5IMget_image_info function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
ret = H5IMget_palette(c_loc_id,c_name,*pal_number,buf);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5imis_palette_c
|
||||
*
|
||||
* Purpose: Call H5IMis_palette
|
||||
*
|
||||
* Return: true, false, fail
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 06, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5imis_palette_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name)
|
||||
{
|
||||
hid_t c_loc_id;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return -1;
|
||||
|
||||
/*
|
||||
* Call H5IMis_palette function.
|
||||
*/
|
||||
c_loc_id = (hid_t)*loc_id;
|
||||
|
||||
return( H5IMis_palette(c_loc_id, c_name));
|
||||
|
||||
}
|
||||
674
hl/fortran/src/H5IMff.f90
Executable file
674
hl/fortran/src/H5IMff.f90
Executable file
@ -0,0 +1,674 @@
|
||||
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
! 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
|
||||
! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
|
||||
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
!
|
||||
!
|
||||
! This file contains FORTRAN90 interfaces for H5IM functions
|
||||
!
|
||||
|
||||
module H5IM
|
||||
use H5FORTRAN_TYPES
|
||||
use HDF5
|
||||
contains
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5immake_image_8bit_f
|
||||
!
|
||||
! Purpose: Creates and writes an image an 8 bit image
|
||||
!
|
||||
! Return: Success: 0, Failure: -1
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 05, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine h5immake_image_8bit_f(loc_id,&
|
||||
dset_name,&
|
||||
width,&
|
||||
height,&
|
||||
buf,&
|
||||
errcode )
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer(HSIZE_T), intent(IN) :: width ! width of image
|
||||
integer(HSIZE_T), intent(IN) :: height ! height of image
|
||||
integer*1, intent(IN), dimension(*) :: buf ! 1 byte integer data buffer
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
|
||||
interface
|
||||
integer function h5immake_image_8bit_c(loc_id,namelen,dset_name,width,height,buf)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMMAKE_IMAGE_8BIT_C'::h5immake_image_8bit_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
integer :: namelen ! lenght of name buffer
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer(HSIZE_T), intent(IN) :: width ! width of image
|
||||
integer(HSIZE_T), intent(IN) :: height ! height of image
|
||||
integer*1, intent(IN), dimension(*) :: buf ! 1 byte integer data buffer
|
||||
end function h5immake_image_8bit_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
errcode = h5immake_image_8bit_c(loc_id,namelen,dset_name,width,height,buf)
|
||||
|
||||
end subroutine h5immake_image_8bit_f
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5imread_image_f
|
||||
!
|
||||
! Purpose: Reads image data from disk.
|
||||
!
|
||||
! Return: Success: 0, Failure: -1
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 05, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
|
||||
subroutine h5imread_image_f(loc_id,&
|
||||
dset_name,&
|
||||
buf,&
|
||||
errcode )
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer*1, intent(INOUT), dimension(*) :: buf ! 1 byte integer data buffer
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
|
||||
interface
|
||||
integer function h5imread_image_c(loc_id,namelen,dset_name,buf)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMREAD_IMAGE_C'::h5imread_image_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
integer :: namelen ! lenght of name buffer
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer*1, intent(INOUT), dimension(*) :: buf ! 1 byte integer data buffer
|
||||
end function h5imread_image_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
errcode = h5imread_image_c(loc_id,namelen,dset_name,buf)
|
||||
|
||||
end subroutine h5imread_image_f
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5immake_image_24bit_f
|
||||
!
|
||||
! Purpose: Creates and writes an image a 24 bit image
|
||||
!
|
||||
! Return: Success: 0, Failure: -1
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 05, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine h5immake_image_24bit_f(loc_id,&
|
||||
dset_name,&
|
||||
width,&
|
||||
height,&
|
||||
il,&
|
||||
buf,&
|
||||
errcode )
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer(HSIZE_T), intent(IN) :: width ! width of image
|
||||
integer(HSIZE_T), intent(IN) :: height ! height of image
|
||||
character(LEN=*), intent(IN) :: il ! interlace
|
||||
integer*1, intent(IN), dimension(*) :: buf ! 1 byte integer data buffer
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
integer :: ilen ! name length
|
||||
|
||||
interface
|
||||
integer function h5immake_image_24bit_c(loc_id,namelen,dset_name,ilen,il,width,height,buf)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMMAKE_IMAGE_24BIT_C'::h5immake_image_24bit_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
!DEC$ATTRIBUTES reference :: il
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer(HSIZE_T), intent(IN) :: width ! width of image
|
||||
integer(HSIZE_T), intent(IN) :: height ! height of image
|
||||
character(LEN=*), intent(IN) :: il ! interlace
|
||||
integer*1, intent(IN), dimension(*) :: buf ! 1 byte integer data buffer
|
||||
integer :: namelen ! lenght of name buffer
|
||||
integer :: ilen ! name length
|
||||
|
||||
end function h5immake_image_24bit_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
ilen = len(il)
|
||||
errcode = h5immake_image_24bit_c(loc_id,namelen,dset_name,ilen,il,width,height,buf)
|
||||
|
||||
end subroutine h5immake_image_24bit_f
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5imget_image_info_f
|
||||
!
|
||||
! Purpose: Gets information about an image dataset (dimensions, interlace mode
|
||||
! and number of associated palettes).
|
||||
!
|
||||
! Return: Success: 0, Failure: -1
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 05, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine h5imget_image_info_f(loc_id,&
|
||||
dset_name,&
|
||||
width,&
|
||||
height,&
|
||||
planes,&
|
||||
interlace,&
|
||||
npals,&
|
||||
errcode )
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer(HSIZE_T), intent(INOUT) :: width ! width of image
|
||||
integer(HSIZE_T), intent(INOUT) :: height ! height of image
|
||||
integer(HSIZE_T), intent(INOUT) :: planes ! color planes
|
||||
integer(HSIZE_T), intent(INOUT) :: npals ! palettes
|
||||
character(LEN=*), intent(INOUT) :: interlace ! interlace
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
integer :: ilen ! name length
|
||||
|
||||
interface
|
||||
integer function h5imget_image_info_c(loc_id,namelen,dset_name,width,height,planes,npals,ilen,interlace)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMGET_IMAGE_INFO_C'::h5imget_image_info_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
!DEC$ATTRIBUTES reference :: interlace
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer(HSIZE_T), intent(INOUT) :: width ! width of image
|
||||
integer(HSIZE_T), intent(INOUT) :: height ! height of image
|
||||
integer(HSIZE_T), intent(INOUT) :: planes ! color planes
|
||||
integer(HSIZE_T), intent(INOUT) :: npals ! palettes
|
||||
character(LEN=*), intent(INOUT) :: interlace ! interlace
|
||||
integer :: namelen ! name length
|
||||
integer :: ilen ! name length
|
||||
end function h5imget_image_info_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
ilen = len(interlace)
|
||||
errcode = h5imget_image_info_c(loc_id,namelen,dset_name,width,height,planes,npals,ilen,interlace)
|
||||
|
||||
end subroutine h5imget_image_info_f
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5imis_image_f
|
||||
!
|
||||
! Purpose: Inquires if a dataset is an image
|
||||
!
|
||||
! Return: Success: 0, Failure: -1
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 05, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
integer function h5imis_image_f(loc_id,&
|
||||
dset_name)
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
|
||||
interface
|
||||
integer function h5imis_image_c(loc_id,namelen,dset_name)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMIS_IMAGE_C'::h5imis_image_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
integer :: namelen ! lenght of name buffer
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
end function h5imis_image_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
errcode = h5imis_image_c(loc_id,namelen,dset_name)
|
||||
h5imis_image_f = errcode
|
||||
|
||||
end function h5imis_image_f
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5immake_palette_f
|
||||
!
|
||||
! Purpose: Creates and writes a palette
|
||||
!
|
||||
! Return: Success: 0, Failure: -1
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 06, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine h5immake_palette_f(loc_id,&
|
||||
dset_name,&
|
||||
pal_dims,&
|
||||
buf,&
|
||||
errcode )
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer(HSIZE_T), intent(IN), dimension(*) :: pal_dims ! dimensions
|
||||
integer*1, intent(IN), dimension(*) :: buf ! 1 byte integer data buffer
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
|
||||
interface
|
||||
integer function h5immake_palette_c(loc_id,namelen,dset_name,pal_dims,buf)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMMAKE_PALETTE_C'::h5immake_palette_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
integer :: namelen ! lenght of name buffer
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer(HSIZE_T), intent(IN), dimension(*) :: pal_dims ! dimensions
|
||||
integer*1, intent(IN), dimension(*) :: buf ! 1 byte integer data buffer
|
||||
end function h5immake_palette_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
errcode = h5immake_palette_c(loc_id,namelen,dset_name,pal_dims,buf)
|
||||
|
||||
end subroutine h5immake_palette_f
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5imlink_palette_f
|
||||
!
|
||||
! Purpose: This function attaches a palette to an existing image dataset
|
||||
!
|
||||
! Return: Success: 0, Failure: -1
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 06, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine h5imlink_palette_f(loc_id,&
|
||||
dset_name,&
|
||||
pal_name,&
|
||||
errcode )
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
character(LEN=*), intent(IN) :: pal_name ! palette name
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
integer :: ilen ! name length
|
||||
|
||||
interface
|
||||
integer function h5imlink_palette_c(loc_id,namelen,dset_name,ilen,pal_name)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMLINK_PALETTE_C'::h5imlink_palette_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
!DEC$ATTRIBUTES reference :: pal_name
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
character(LEN=*), intent(IN) :: pal_name ! palette name
|
||||
integer :: namelen ! name length
|
||||
integer :: ilen ! name length
|
||||
end function h5imlink_palette_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
ilen = len(pal_name)
|
||||
errcode = h5imlink_palette_c(loc_id,namelen,dset_name,ilen,pal_name)
|
||||
|
||||
end subroutine h5imlink_palette_f
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5imunlink_palette_f
|
||||
!
|
||||
! Purpose: This function dettaches a palette to an existing image dataset
|
||||
!
|
||||
! Return: Success: 0, Failure: -1
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 06, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine h5imunlink_palette_f(loc_id,&
|
||||
dset_name,&
|
||||
pal_name,&
|
||||
errcode )
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
character(LEN=*), intent(IN) :: pal_name ! palette name
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
integer :: ilen ! name length
|
||||
|
||||
interface
|
||||
integer function h5imunlink_palette_c(loc_id,namelen,dset_name,ilen,pal_name)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMUNLINK_PALETTE_C'::h5imunlink_palette_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
!DEC$ATTRIBUTES reference :: pal_name
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
character(LEN=*), intent(IN) :: pal_name ! palette name
|
||||
integer :: namelen ! name length
|
||||
integer :: ilen ! name length
|
||||
end function h5imunlink_palette_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
ilen = len(pal_name)
|
||||
errcode = h5imunlink_palette_c(loc_id,namelen,dset_name,ilen,pal_name)
|
||||
|
||||
end subroutine h5imunlink_palette_f
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5imget_npalettes_f
|
||||
!
|
||||
! Purpose: Gets the number of palettes associated to an image
|
||||
!
|
||||
! Return: Success: 0, Failure: -1
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 05, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine h5imget_npalettes_f(loc_id,&
|
||||
dset_name,&
|
||||
npals,&
|
||||
errcode )
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer(HSIZE_T), intent(INOUT) :: npals ! palettes
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
|
||||
interface
|
||||
integer function h5imget_npalettes_c(loc_id,namelen,dset_name,npals)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMGET_NPALETTES_C'::h5imget_npalettes_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer(HSIZE_T), intent(INOUT) :: npals ! palettes
|
||||
integer :: namelen ! name length
|
||||
end function h5imget_npalettes_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
errcode = h5imget_npalettes_c(loc_id,namelen,dset_name,npals)
|
||||
|
||||
end subroutine h5imget_npalettes_f
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5imget_palette_info_f
|
||||
!
|
||||
! Purpose: Get palette information
|
||||
!
|
||||
! Return: Success: 0, Failure: -1
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 06, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine h5imget_palette_info_f(loc_id,&
|
||||
dset_name,&
|
||||
pal_number,&
|
||||
dims,&
|
||||
errcode )
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer, intent(IN) :: pal_number ! palette number
|
||||
integer(HSIZE_T), dimension(*), intent(INOUT) :: dims ! dimensions
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
|
||||
interface
|
||||
integer function h5imget_palette_info_c(loc_id,namelen,dset_name,pal_number,dims)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMGET_PALETTE_INFO_C'::h5imget_palette_info_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer, intent(IN) :: pal_number ! palette number
|
||||
integer(HSIZE_T), dimension(*), intent(INOUT) :: dims ! dimensions
|
||||
integer :: namelen ! name length
|
||||
end function h5imget_palette_info_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
errcode = h5imget_palette_info_c(loc_id,namelen,dset_name,pal_number,dims)
|
||||
|
||||
end subroutine h5imget_palette_info_f
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5imget_palette_f
|
||||
!
|
||||
! Purpose: Reads palette
|
||||
!
|
||||
! Return: Success: 0, Failure: -1
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 06, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
|
||||
subroutine h5imget_palette_f(loc_id,&
|
||||
dset_name,&
|
||||
pal_number,&
|
||||
buf,&
|
||||
errcode )
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer, intent(IN) :: pal_number ! palette number
|
||||
integer*1, intent(INOUT), dimension(*) :: buf ! 1 byte integer data buffer
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
|
||||
interface
|
||||
integer function h5imget_palette_c(loc_id,namelen,dset_name,pal_number,buf)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMGET_PALETTE_C'::h5imget_palette_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
integer :: namelen ! lenght of name buffer
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer, intent(IN) :: pal_number ! palette number
|
||||
integer*1, intent(INOUT), dimension(*) :: buf ! 1 byte integer data buffer
|
||||
end function h5imget_palette_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
errcode = h5imget_palette_c(loc_id,namelen,dset_name,pal_number,buf)
|
||||
|
||||
end subroutine h5imget_palette_f
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Function: h5imis_palette_f
|
||||
!
|
||||
! Purpose: Inquires if a dataset is a palette
|
||||
!
|
||||
! Return: true, false, fail
|
||||
!
|
||||
! Programmer: pvn@ncsa.uiuc.edu
|
||||
!
|
||||
! Date: October 06, 2004
|
||||
!
|
||||
! Comments:
|
||||
!
|
||||
! Modifications:
|
||||
!
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
integer function h5imis_palette_f(loc_id,&
|
||||
dset_name)
|
||||
|
||||
implicit none
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
integer :: errcode ! error code
|
||||
integer :: namelen ! name length
|
||||
|
||||
interface
|
||||
integer function h5imis_palette_c(loc_id,namelen,dset_name)
|
||||
use H5GLOBAL
|
||||
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
|
||||
!MS$ATTRIBUTES C,reference,alias:'_H5IMIS_PALETTE_C'::h5imis_palette_c
|
||||
!DEC$ ENDIF
|
||||
!DEC$ATTRIBUTES reference :: dset_name
|
||||
integer(HID_T), intent(IN) :: loc_id ! file or group identifier
|
||||
integer :: namelen ! lenght of name buffer
|
||||
character(LEN=*), intent(IN) :: dset_name ! name of the dataset
|
||||
end function h5imis_palette_c
|
||||
end interface
|
||||
|
||||
namelen = len(dset_name)
|
||||
errcode = h5imis_palette_c(loc_id,namelen,dset_name)
|
||||
h5imis_palette_f = errcode
|
||||
|
||||
end function h5imis_palette_f
|
||||
|
||||
|
||||
! end
|
||||
!
|
||||
end module H5IM
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
525
hl/fortran/src/H5LTf90proto.h
Executable file
525
hl/fortran/src/H5LTf90proto.h
Executable file
@ -0,0 +1,525 @@
|
||||
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
* 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
|
||||
* access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
|
||||
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
|
||||
|
||||
|
||||
#ifndef _H5LTf90proto_H
|
||||
#define _H5LTf90proto_H
|
||||
|
||||
#include "H5f90i.h"
|
||||
|
||||
H5_DLL char* HD5f2cstring (_fcd fdesc, int len);
|
||||
H5_DLL void HD5packFstring (char *src, char *dest, size_t len);
|
||||
|
||||
|
||||
/*
|
||||
* Functions from H5LTfc.c
|
||||
*/
|
||||
#ifndef H5Ff90_FNAMES
|
||||
# define H5Ff90_FNAMES
|
||||
#ifdef DF_CAPFNAMES
|
||||
# define nh5ltmake_dataset_c FNAME(H5LTMAKE_DATASET_C)
|
||||
# define nh5ltread_dataset_c FNAME(H5LTREAD_DATASET_C)
|
||||
# define nh5ltmake_dataset_string_c FNAME(H5LTMAKE_DATASET_STRING_C)
|
||||
# define nh5ltread_dataset_string_c FNAME(H5LTREAD_DATASET_STRING_C)
|
||||
|
||||
|
||||
# define nh5ltset_attribute_int_c FNAME(H5LTSET_ATTRIBUTE_INT_C)
|
||||
# define nh5ltset_attribute_float_c FNAME(H5LTSET_ATTRIBUTE_FLOAT_C)
|
||||
# define nh5ltset_attribute_double_c FNAME(H5LTSET_ATTRIBUTE_DOUBLE_C)
|
||||
# define nh5ltset_attribute_string_c FNAME(H5LTSET_ATTRIBUTE_STRING_C)
|
||||
|
||||
# define nh5ltget_attribute_int_c FNAME(H5LTGET_ATTRIBUTE_INT_C)
|
||||
# define nh5ltget_attribute_float_c FNAME(H5LTGET_ATTRIBUTE_FLOAT_C)
|
||||
# define nh5ltget_attribute_double_c FNAME(H5LTGET_ATTRIBUTE_DOUBLE_C)
|
||||
# define nh5ltget_attribute_string_c FNAME(H5LTGET_ATTRIBUTE_STRING_C)
|
||||
|
||||
# define nh5ltget_dataset_ndims_c FNAME(H5LTGET_DATASET_NDIMS_C)
|
||||
# define nh5ltfind_dataset_c FNAME(H5LTFIND_DATASET_C)
|
||||
# define nh5ltget_dataset_info_c FNAME(H5LTGET_DATASET_INFO_C)
|
||||
|
||||
# define nh5ltget_attribute_ndims_c FNAME(H5LTGET_ATTRIBUTE_NDIMS_C)
|
||||
# define nh5ltget_attribute_info_c FNAME(H5LTGET_ATTRIBUTE_INFO_C)
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Image
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
# define nh5immake_image_8bit_c FNAME(H5IMMAKE_IMAGE_8BIT_C)
|
||||
# define nh5immake_image_24bit_c FNAME(H5IMMAKE_IMAGE_24BIT_C)
|
||||
# define nh5imread_image_c FNAME(H5IMREAD_IMAGE_C)
|
||||
# define nh5imget_image_info_c FNAME(H5IMGET_IMAGE_INFO_C)
|
||||
# define nh5imis_image_c FNAME(H5IMIS_IMAGE_C)
|
||||
# define nh5immake_palette_c FNAME(H5IMMAKE_PALETTE_C)
|
||||
# define nh5imlink_palette_c FNAME(H5IMLINK_PALETTE_C)
|
||||
# define nh5imunlink_palette_c FNAME(H5IMUNLINK_PALETTE_C)
|
||||
# define nh5imget_npalettes_c FNAME(H5IMGET_NPALETTES_C)
|
||||
# define nh5imget_palette_info_c FNAME(H5IMGET_PALETTE_INFO_C)
|
||||
# define nh5imget_palette_c FNAME(H5IMGET_PALETTE_C)
|
||||
# define nh5imis_palette_c FNAME(H5IMIS_PALETTE_C)
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Table
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
# define nh5tbmake_table_c FNAME(H5TBMAKE_TABLE_C)
|
||||
# define nh5tbwrite_field_name_c FNAME(H5TBWRITE_FIELD_NAME_C)
|
||||
# define nh5tbread_field_name_c FNAME(H5TBREAD_FIELD_NAME_C)
|
||||
# define nh5tbwrite_field_index_c FNAME(H5TBWRITE_FIELD_INDEX_C)
|
||||
# define nh5tbread_field_index_c FNAME(H5TBREAD_FIELD_INDEX_C)
|
||||
# define nh5tbinsert_field_c FNAME(H5TBINSERT_FIELD_C)
|
||||
# define nh5tbdelete_field_c FNAME(H5TBDELETE_FIELD_C)
|
||||
# define nh5tbget_table_info_c FNAME(H5TBGET_TABLE_INFO_C)
|
||||
# define nh5tbget_field_info_c FNAME(H5TBGET_FIELD_INFO_C)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#else /* !DF_CAPFNAMES */
|
||||
|
||||
# define nh5ltmake_dataset_c FNAME(h5ltmake_dataset_c)
|
||||
# define nh5ltread_dataset_c FNAME(h5ltread_dataset_c)
|
||||
# define nh5ltmake_dataset_string_c FNAME(h5ltmake_dataset_string_c)
|
||||
# define nh5ltread_dataset_string_c FNAME(h5ltread_dataset_string_c)
|
||||
|
||||
# define nh5ltset_attribute_int_c FNAME(h5ltset_attribute_int_c)
|
||||
# define nh5ltset_attribute_float_c FNAME(h5ltset_attribute_float_c)
|
||||
# define nh5ltset_attribute_double_c FNAME(h5ltset_attribute_double_c)
|
||||
# define nh5ltset_attribute_string_c FNAME(h5ltset_attribute_string_c)
|
||||
|
||||
# define nh5ltget_attribute_int_c FNAME(h5ltget_attribute_int_c)
|
||||
# define nh5ltget_attribute_float_c FNAME(h5ltget_attribute_float_c)
|
||||
# define nh5ltget_attribute_double_c FNAME(h5ltget_attribute_double_c)
|
||||
# define nh5ltget_attribute_string_c FNAME(h5ltget_attribute_string_c)
|
||||
|
||||
# define nh5ltget_dataset_ndims_c FNAME(h5ltget_dataset_ndims_c)
|
||||
# define nh5ltfind_dataset_c FNAME(h5ltfind_dataset_c)
|
||||
# define nh5ltget_dataset_info_c FNAME(h5ltget_dataset_info_c)
|
||||
|
||||
# define nh5ltget_attribute_ndims_c FNAME(h5ltget_attribute_ndims_c)
|
||||
# define nh5ltget_attribute_info_c FNAME(h5ltget_attribute_info_c)
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Image
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
# define nh5immake_image_8bit_c FNAME(h5immake_image_8bit_c)
|
||||
# define nh5immake_image_24bit_c FNAME(h5immake_image_24bit_c)
|
||||
# define nh5imread_image_c FNAME(h5imread_image_c)
|
||||
# define nh5imget_image_info_c FNAME(h5imget_image_info_c)
|
||||
# define nh5imis_image_c FNAME(h5imis_image_c)
|
||||
# define nh5immake_palette_c FNAME(h5immake_palette_c)
|
||||
# define nh5imlink_palette_c FNAME(h5imlink_palette_c)
|
||||
# define nh5imunlink_palette_c FNAME(h5imunlink_palette_c)
|
||||
# define nh5imget_npalettes_c FNAME(h5imget_npalettes_c)
|
||||
# define nh5imget_palette_info_c FNAME(h5imget_palette_info_c)
|
||||
# define nh5imget_palette_c FNAME(h5imget_palette_c)
|
||||
# define nh5imis_palette_c FNAME(h5imis_palette_c)
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Table
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
# define nh5tbmake_table_c FNAME(h5tbmake_table_c)
|
||||
# define nh5tbwrite_field_name_c FNAME(h5tbwrite_field_name_c)
|
||||
# define nh5tbread_field_name_c FNAME(h5tbread_field_name_c)
|
||||
# define nh5tbwrite_field_index_c FNAME(h5tbwrite_field_index_c)
|
||||
# define nh5tbread_field_index_c FNAME(h5tbread_field_index_c)
|
||||
# define nh5tbinsert_field_c FNAME(h5tbinsert_field_c)
|
||||
# define nh5tbdelete_field_c FNAME(h5tbdelete_field_c)
|
||||
# define nh5tbget_table_info_c FNAME(h5tbget_table_info_c)
|
||||
# define nh5tbget_field_info_c FNAME(h5tbget_field_info_c)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#endif /* DF_CAPFNAMES */
|
||||
#endif /* H5Ff90_FNAMES */
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltmake_dataset_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *rank,
|
||||
hsize_t_f *dims,
|
||||
hid_t_f *type_id,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltread_dataset_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hid_t_f *type_id,
|
||||
void *buf,
|
||||
hsize_t_f *dims);
|
||||
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltset_attribute_int_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd dsetname,
|
||||
int_f *attrnamelen,
|
||||
_fcd attrname,
|
||||
size_t_f *size,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltset_attribute_float_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd dsetname,
|
||||
int_f *attrnamelen,
|
||||
_fcd attrname,
|
||||
size_t_f *size,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltset_attribute_double_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd dsetname,
|
||||
int_f *attrnamelen,
|
||||
_fcd attrname,
|
||||
size_t_f *size,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltset_attribute_string_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd dsetname,
|
||||
int_f *attrnamelen,
|
||||
_fcd attrname,
|
||||
void *buf);
|
||||
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltget_attribute_int_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd dsetname,
|
||||
int_f *attrnamelen,
|
||||
_fcd attrname,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltget_attribute_float_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd dsetname,
|
||||
int_f *attrnamelen,
|
||||
_fcd attrname,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltget_attribute_double_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd dsetname,
|
||||
int_f *attrnamelen,
|
||||
_fcd attrname,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltget_attribute_string_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd dsetname,
|
||||
int_f *attrnamelen,
|
||||
_fcd attrname,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
h5ltget_dataset_ndims_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *rank);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltfind_dataset_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltget_dataset_info_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *dims,
|
||||
int_f *type_class,
|
||||
size_t_f *type_size);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltget_attribute_ndims_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd dsetname,
|
||||
int_f *attrnamelen,
|
||||
_fcd attrname,
|
||||
int_f *rank);
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltget_attribute_info_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *attrnamelen,
|
||||
_fcd attrname,
|
||||
hsize_t_f *dims,
|
||||
int_f *type_class,
|
||||
size_t_f *type_size);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltmake_dataset_string_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
char *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5ltread_dataset_string_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
char *buf);
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Image
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5immake_image_8bit_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *width,
|
||||
hsize_t_f *height,
|
||||
unsigned char *buf);
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5imread_image_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
unsigned char *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5immake_image_24bit_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *ilen,
|
||||
_fcd il,
|
||||
hsize_t_f *width,
|
||||
hsize_t_f *height,
|
||||
unsigned char *buf);
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5imget_image_info_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *width,
|
||||
hsize_t_f *height,
|
||||
hsize_t_f *planes,
|
||||
hsize_t_f *npals,
|
||||
int_f *ilen,
|
||||
_fcd interlace);
|
||||
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5imis_image_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name);
|
||||
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5immake_palette_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *dims,
|
||||
unsigned char *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5imlink_palette_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *ilen,
|
||||
_fcd pal_name);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5imunlink_palette_c (hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *ilen,
|
||||
_fcd pal_name);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5imget_npalettes_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *npals);
|
||||
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5imget_palette_info_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *pal_number,
|
||||
hsize_t_f *dims);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5imget_palette_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *pal_number,
|
||||
unsigned char *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5imis_palette_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name);
|
||||
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Table
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5tbmake_table_c(int_f *namelen1,
|
||||
_fcd name1,
|
||||
hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *nfields,
|
||||
hsize_t_f *nrecords,
|
||||
size_t_f *type_size,
|
||||
size_t_f *field_offset,
|
||||
hid_t_f *field_types,
|
||||
hsize_t_f *chunk_size,
|
||||
int_f *compress,
|
||||
int_f *len, /* field_names lenghts */
|
||||
_fcd buf); /* field_names */
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5tbwrite_field_name_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *namelen1,
|
||||
_fcd field_name,
|
||||
hsize_t_f *start,
|
||||
hsize_t_f *nrecords,
|
||||
size_t_f *type_size,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5tbread_field_name_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *namelen1,
|
||||
_fcd field_name,
|
||||
hsize_t_f *start,
|
||||
hsize_t_f *nrecords,
|
||||
size_t_f *type_size,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5tbwrite_field_index_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *field_index,
|
||||
hsize_t_f *start,
|
||||
hsize_t_f *nrecords,
|
||||
size_t_f *type_size,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5tbread_field_index_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *field_index,
|
||||
hsize_t_f *start,
|
||||
hsize_t_f *nrecords,
|
||||
size_t_f *type_size,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5tbinsert_field_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *namelen1,
|
||||
_fcd field_name,
|
||||
hid_t_f *field_type,
|
||||
int_f *position,
|
||||
void *buf);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5tbdelete_field_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *namelen1,
|
||||
_fcd field_name);
|
||||
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5tbget_table_info_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *nfields,
|
||||
hsize_t_f *nrecords);
|
||||
|
||||
H5_DLL
|
||||
int_f
|
||||
nh5tbget_field_info_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *nfields,
|
||||
size_t_f *field_sizes,
|
||||
size_t_f *field_offsets,
|
||||
size_t_f *type_size,
|
||||
int_f *namelen2, /* field_names lenghts */
|
||||
_fcd field_names) ; /* field_names */
|
||||
|
||||
|
||||
|
||||
|
||||
#endif /* _H5LTf90proto_H */
|
||||
1012
hl/fortran/src/H5LTfc.c
Executable file
1012
hl/fortran/src/H5LTfc.c
Executable file
File diff suppressed because it is too large
Load Diff
2991
hl/fortran/src/H5LTff.f90
Executable file
2991
hl/fortran/src/H5LTff.f90
Executable file
File diff suppressed because it is too large
Load Diff
715
hl/fortran/src/H5TBfc.c
Executable file
715
hl/fortran/src/H5TBfc.c
Executable file
@ -0,0 +1,715 @@
|
||||
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
* 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
|
||||
* access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
|
||||
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
|
||||
|
||||
/* This files contains C stubs for H5D Fortran APIs */
|
||||
|
||||
#include "H5TA.h"
|
||||
#include "H5LTf90proto.h"
|
||||
#include <stdlib.h>
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5tbmake_table_c
|
||||
*
|
||||
* Purpose: Call H5TBmake_table
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 06, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
int_f
|
||||
nh5tbmake_table_c(int_f *namelen1,
|
||||
_fcd name1,
|
||||
hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *nfields,
|
||||
hsize_t_f *nrecords,
|
||||
size_t_f *type_size,
|
||||
size_t_f *field_offset,
|
||||
hid_t_f *field_types,
|
||||
hsize_t_f *chunk_size,
|
||||
int_f *compress,
|
||||
int_f *namelen2, /* field_names lenghts */
|
||||
_fcd field_names) /* field_names */
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
char *c_name1;
|
||||
int c_namelen1;
|
||||
hsize_t num_elem;
|
||||
int i;
|
||||
int max_len=1;
|
||||
hid_t c_loc_id = *loc_id;
|
||||
hsize_t c_nfields = *nfields;
|
||||
hsize_t c_nrecords = *nrecords;
|
||||
hsize_t c_chunk_size = *chunk_size;
|
||||
int c_compress = *compress;
|
||||
size_t c_type_size = *type_size;
|
||||
size_t *c_field_offset;
|
||||
hid_t *c_field_types;
|
||||
char **c_field_names;
|
||||
char *tmp, *tmp_p;
|
||||
|
||||
num_elem = *nfields;
|
||||
|
||||
for (i=0; i < num_elem; i++) {
|
||||
if (namelen2[i] > max_len) max_len = namelen2[i];
|
||||
}
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
c_namelen1 = *namelen1;
|
||||
c_name1 = (char *)HD5f2cstring(name1, c_namelen1);
|
||||
if (c_name1 == NULL) return ret_value;
|
||||
|
||||
c_field_offset = (size_t*)malloc(sizeof(size_t) * (size_t)c_nfields);
|
||||
if (!c_field_offset) return ret_value;
|
||||
|
||||
c_field_types = (hid_t*)malloc(sizeof(hid_t) * (size_t)c_nfields);
|
||||
if (!c_field_types) return ret_value;
|
||||
|
||||
for (i=0; i < num_elem; i++) {
|
||||
c_field_offset[i] = field_offset[i];
|
||||
c_field_types[i] = field_types[i];
|
||||
}
|
||||
|
||||
/*
|
||||
* Allocate array of character pointers
|
||||
*/
|
||||
c_field_names = (char **)malloc((size_t)num_elem * sizeof(char *));
|
||||
if (c_field_names == NULL) return ret_value;
|
||||
|
||||
/* Copy data to long C string */
|
||||
tmp = (char *)HD5f2cstring(field_names, (int)(max_len*num_elem));
|
||||
if (tmp == NULL) {
|
||||
free(c_field_names);
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
/*
|
||||
* Move data from temorary buffer
|
||||
*/
|
||||
tmp_p = tmp;
|
||||
for (i=0; i < num_elem; i++) {
|
||||
c_field_names[i] = (char *) malloc((size_t)namelen2[i]+1);
|
||||
memcpy(c_field_names[i], tmp_p, (size_t)namelen2[i]);
|
||||
c_field_names[i][namelen2[i]] = '\0';
|
||||
tmp_p = tmp_p + max_len;
|
||||
}
|
||||
|
||||
/*
|
||||
* Call H5TBmake_table function.
|
||||
*/
|
||||
|
||||
ret = H5TBmake_table(c_name1,c_loc_id,c_name,c_nfields,c_nrecords,c_type_size,
|
||||
c_field_names,c_field_offset,c_field_types,c_chunk_size,NULL,*compress,NULL);
|
||||
|
||||
for (i=0; i < num_elem; i++) {
|
||||
free (c_field_names[i]);
|
||||
}
|
||||
free(c_field_names);
|
||||
free(tmp);
|
||||
free(c_field_offset);
|
||||
free(c_field_types);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5tbwrite_field_name_c
|
||||
*
|
||||
* Purpose: Call H5TBwrite_fields_name
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 12, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5tbwrite_field_name_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *namelen1,
|
||||
_fcd field_name,
|
||||
hsize_t_f *start,
|
||||
hsize_t_f *nrecords,
|
||||
size_t_f *type_size,
|
||||
void *buf)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
char *c_name1;
|
||||
int c_namelen1;
|
||||
hid_t c_loc_id = *loc_id;
|
||||
hsize_t c_start = *start;
|
||||
hsize_t c_nrecords = *nrecords;
|
||||
size_t c_type_size = *type_size;
|
||||
size_t c_type_sizes[1];
|
||||
|
||||
c_type_sizes[0] = c_type_size;
|
||||
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
c_namelen1 = *namelen1;
|
||||
c_name1 = (char *)HD5f2cstring(field_name, c_namelen1);
|
||||
if (c_name1 == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5TBwrite_fields_name function.
|
||||
*/
|
||||
|
||||
ret = H5TBwrite_fields_name(c_loc_id,c_name,c_name1,c_start,c_nrecords,c_type_size,
|
||||
0,c_type_sizes,buf);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5tbread_field_name_c
|
||||
*
|
||||
* Purpose: Call H5TBread_fields_name
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 12, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5tbread_field_name_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *namelen1,
|
||||
_fcd field_name,
|
||||
hsize_t_f *start,
|
||||
hsize_t_f *nrecords,
|
||||
size_t_f *type_size,
|
||||
void *buf)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
char *c_name1;
|
||||
int c_namelen1;
|
||||
hid_t c_loc_id = *loc_id;
|
||||
hsize_t c_start = *start;
|
||||
hsize_t c_nrecords = *nrecords;
|
||||
size_t c_type_size = *type_size;
|
||||
size_t c_type_sizes[1];
|
||||
|
||||
c_type_sizes[0] = c_type_size;
|
||||
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
c_namelen1 = *namelen1;
|
||||
c_name1 = (char *)HD5f2cstring(field_name, c_namelen1);
|
||||
if (c_name1 == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5TBread_fields_name function.
|
||||
*/
|
||||
|
||||
ret = H5TBread_fields_name(c_loc_id,c_name,c_name1,c_start,c_nrecords,c_type_size,
|
||||
0,c_type_sizes,buf);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5tbwrite_field_index_c
|
||||
*
|
||||
* Purpose: Call H5TBwrite_fields_index
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 12, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5tbwrite_field_index_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *field_index,
|
||||
hsize_t_f *start,
|
||||
hsize_t_f *nrecords,
|
||||
size_t_f *type_size,
|
||||
void *buf)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
hid_t c_loc_id = *loc_id;
|
||||
hsize_t c_start = *start;
|
||||
hsize_t c_nrecords = *nrecords;
|
||||
size_t c_type_size = *type_size;
|
||||
size_t c_type_sizes[1];
|
||||
int c_field_index[1];
|
||||
|
||||
c_type_sizes[0] = c_type_size;
|
||||
c_field_index[0] = *field_index - 1; /* C zero based index */
|
||||
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
|
||||
/*
|
||||
* Call H5TBwrite_fields_name function.
|
||||
*/
|
||||
|
||||
ret = H5TBwrite_fields_index(c_loc_id,c_name,1,c_field_index,c_start,c_nrecords,c_type_size,
|
||||
0,c_type_sizes,buf);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5tbread_field_index_c
|
||||
*
|
||||
* Purpose: Call H5TBread_fields_index
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 12, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5tbread_field_index_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *field_index,
|
||||
hsize_t_f *start,
|
||||
hsize_t_f *nrecords,
|
||||
size_t_f *type_size,
|
||||
void *buf)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
hid_t c_loc_id = *loc_id;
|
||||
hsize_t c_start = *start;
|
||||
hsize_t c_nrecords = *nrecords;
|
||||
size_t c_type_size = *type_size;
|
||||
size_t c_type_sizes[1];
|
||||
int c_field_index[1];
|
||||
|
||||
c_type_sizes[0] = c_type_size;
|
||||
c_field_index[0] = *field_index - 1; /* C zero based index */
|
||||
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5TBread_fields_index function.
|
||||
*/
|
||||
|
||||
ret = H5TBread_fields_index(c_loc_id,c_name,1,c_field_index,c_start,c_nrecords,c_type_size,
|
||||
0,c_type_sizes,buf);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5tbinsert_field_c
|
||||
*
|
||||
* Purpose: Call H5TBinsert_field
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 13, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5tbinsert_field_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *namelen1,
|
||||
_fcd field_name,
|
||||
hid_t_f *field_type,
|
||||
int_f *position,
|
||||
void *buf)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
char *c_name1;
|
||||
int c_namelen1;
|
||||
hid_t c_loc_id = *loc_id;
|
||||
hid_t c_field_type = *field_type;
|
||||
hsize_t c_position = *position;
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
c_namelen1 = *namelen1;
|
||||
c_name1 = (char *)HD5f2cstring(field_name, c_namelen1);
|
||||
if (c_name1 == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5TBinsert_field function.
|
||||
*/
|
||||
|
||||
ret = H5TBinsert_field(c_loc_id,c_name,c_name1,c_field_type,c_position,NULL,buf);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5tbdelete_field_c
|
||||
*
|
||||
* Purpose: Call H5TBdelete_field
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 13, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5tbdelete_field_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
int_f *namelen1,
|
||||
_fcd field_name)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
char *c_name1;
|
||||
int c_namelen1;
|
||||
hid_t c_loc_id = *loc_id;
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
c_namelen1 = *namelen1;
|
||||
c_name1 = (char *)HD5f2cstring(field_name, c_namelen1);
|
||||
if (c_name1 == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5TBinsert_field function.
|
||||
*/
|
||||
|
||||
ret = H5TBdelete_field(c_loc_id,c_name,c_name1);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5tbget_table_info_c
|
||||
*
|
||||
* Purpose: Call H5TBread_fields_index
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 12, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int_f
|
||||
nh5tbget_table_info_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *nfields,
|
||||
hsize_t_f *nrecords)
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
hid_t c_loc_id = *loc_id;
|
||||
hsize_t c_nfields;
|
||||
hsize_t c_nrecords;
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
/*
|
||||
* Call H5TBread_fields_index function.
|
||||
*/
|
||||
|
||||
ret = H5TBget_table_info(c_loc_id,c_name,&c_nfields,&c_nrecords);
|
||||
|
||||
*nfields = (hsize_t_f) c_nfields;;
|
||||
*nrecords = (hsize_t_f) c_nrecords;
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*-------------------------------------------------------------------------
|
||||
* Function: h5tbget_field_info_c
|
||||
*
|
||||
* Purpose: Call H5TBget_field_info
|
||||
*
|
||||
* Return: Success: 0, Failure: -1
|
||||
*
|
||||
* Programmer: pvn@ncsa.uiuc.edu
|
||||
*
|
||||
* Date: October 13, 2004
|
||||
*
|
||||
* Comments:
|
||||
*
|
||||
* Modifications:
|
||||
*
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
int_f
|
||||
nh5tbget_field_info_c(hid_t_f *loc_id,
|
||||
int_f *namelen,
|
||||
_fcd name,
|
||||
hsize_t_f *nfields,
|
||||
size_t_f *field_sizes,
|
||||
size_t_f *field_offsets,
|
||||
size_t_f *type_size,
|
||||
int_f *namelen2, /* field_names lenghts */
|
||||
_fcd field_names) /* field_names */
|
||||
|
||||
{
|
||||
int ret_value = -1;
|
||||
herr_t ret;
|
||||
char *c_name;
|
||||
int c_namelen;
|
||||
hsize_t num_elem;
|
||||
int i;
|
||||
int max_len=1;
|
||||
hid_t c_loc_id = *loc_id;
|
||||
hsize_t c_nfields = *nfields;
|
||||
size_t *c_field_sizes;
|
||||
size_t *c_field_offsets;
|
||||
size_t c_type_size;
|
||||
char **c_field_names;
|
||||
char *tmp, *tmp_p;
|
||||
int c_lenmax=HLTB_MAX_FIELD_LEN;
|
||||
size_t length = 0;
|
||||
|
||||
num_elem = c_nfields;
|
||||
|
||||
for (i=0; i < num_elem; i++) {
|
||||
if (namelen2[i] > max_len) max_len = namelen2[i];
|
||||
}
|
||||
|
||||
/*
|
||||
* Convert FORTRAN name to C name
|
||||
*/
|
||||
c_namelen = *namelen;
|
||||
c_name = (char *)HD5f2cstring(name, c_namelen);
|
||||
if (c_name == NULL) return ret_value;
|
||||
|
||||
|
||||
c_field_offsets = (size_t*)malloc(sizeof(size_t) * (size_t)c_nfields);
|
||||
if (!c_field_offsets) return ret_value;
|
||||
|
||||
c_field_sizes = (size_t*)malloc(sizeof(size_t) * (size_t)c_nfields);
|
||||
if (!c_field_sizes) return ret_value;
|
||||
|
||||
c_field_names = malloc( sizeof(char*) * (size_t)c_nfields );
|
||||
if (!c_field_names) return ret_value;
|
||||
for ( i = 0; i < c_nfields; i++)
|
||||
{
|
||||
c_field_names[i] = malloc( sizeof(char) * HLTB_MAX_FIELD_LEN );
|
||||
}
|
||||
|
||||
/*
|
||||
* Call H5TBget_field_info function.
|
||||
*/
|
||||
|
||||
ret = H5TBget_field_info(c_loc_id,c_name,c_field_names,c_field_sizes,c_field_offsets,
|
||||
&c_type_size);
|
||||
|
||||
/* return values*/
|
||||
|
||||
/* names array */
|
||||
tmp = (char *)malloc(c_lenmax* (hsize_t_f) c_nfields + 1);
|
||||
tmp_p = tmp;
|
||||
memset(tmp,' ', c_lenmax* (hsize_t_f) c_nfields);
|
||||
tmp[c_lenmax*c_nfields] = '\0';
|
||||
for (i=0; i < c_nfields; i++) {
|
||||
memcpy(tmp_p, c_field_names[i], strlen(c_field_names[i]));
|
||||
namelen2[i] = (int_f)strlen(c_field_names[i]);
|
||||
length = MAX(length, strlen(c_field_names[i]));
|
||||
tmp_p = tmp_p + c_lenmax;
|
||||
}
|
||||
HD5packFstring(tmp, _fcdtocp(field_names), (int)(c_lenmax*c_nfields));
|
||||
|
||||
|
||||
*type_size = c_type_size;
|
||||
for (i=0; i < num_elem; i++)
|
||||
{
|
||||
field_sizes[i] = c_field_sizes[i];
|
||||
field_offsets[i] = c_field_offsets[i];
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* free */
|
||||
|
||||
for (i=0; i < num_elem; i++) {
|
||||
free (c_field_names[i]);
|
||||
}
|
||||
free(c_field_names);
|
||||
free(tmp);
|
||||
free(c_field_offsets);
|
||||
free(c_field_sizes);
|
||||
|
||||
if (ret < 0) return ret_value;
|
||||
ret_value = 0;
|
||||
return ret_value;
|
||||
}
|
||||
|
||||
1684
hl/fortran/src/H5TBff.f90
Executable file
1684
hl/fortran/src/H5TBff.f90
Executable file
File diff suppressed because it is too large
Load Diff
228
hl/fortran/src/H5f90i.h
Executable file
228
hl/fortran/src/H5f90i.h
Executable file
@ -0,0 +1,228 @@
|
||||
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
* 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
|
||||
* access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
|
||||
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
|
||||
|
||||
|
||||
#ifndef _H5f90i_H
|
||||
#define _H5f90i_H
|
||||
|
||||
/*
|
||||
* Standard header files needed all the time
|
||||
*/
|
||||
|
||||
#if (defined (UNICOS) || (defined (_UNICOS)))
|
||||
|
||||
#include <fortran.h>
|
||||
|
||||
/*typedef char* _fcd;*/
|
||||
typedef long hsize_t_f;
|
||||
typedef long hssize_t_f;
|
||||
typedef long size_t_f;
|
||||
typedef long int_f;
|
||||
typedef long hid_t_f;
|
||||
typedef double real_f;
|
||||
#define DF_CAPFNAMES
|
||||
/*#define _fcdtocp(desc) (desc)*/
|
||||
|
||||
#endif /* UNICOS */
|
||||
|
||||
#if defined(IBM6000) || defined(_AIX)
|
||||
|
||||
typedef char *_fcd;
|
||||
typedef long long hsize_t_f;
|
||||
typedef long long hssize_t_f;
|
||||
typedef int size_t_f;
|
||||
typedef int int_f;
|
||||
typedef int hid_t_f;
|
||||
typedef float real_f;
|
||||
#define _fcdtocp(desc) (desc)
|
||||
#endif /*IBM6000*/
|
||||
|
||||
/* MAC APPLE definitions with IBM XL compiler*/
|
||||
#if defined(__APPLE__)
|
||||
typedef char *_fcd;
|
||||
typedef long long hsize_t_f;
|
||||
typedef long long hssize_t_f;
|
||||
typedef int size_t_f;
|
||||
typedef int int_f;
|
||||
typedef int hid_t_f;
|
||||
typedef float real_f;
|
||||
#define FNAME(x) x
|
||||
#if defined H5_ABSOFT
|
||||
#define DF_CAPFNAMES
|
||||
#endif /*H5_ABSOFT*/
|
||||
#define _fcdtocp(desc) (desc)
|
||||
|
||||
#endif /*APPLE*/
|
||||
|
||||
|
||||
/* LINUX definitions */
|
||||
#if (defined(i386) || defined(__i386__)) && (defined(linux) || defined(__linux__))
|
||||
|
||||
|
||||
/*#error "LINUX definitions"*/
|
||||
|
||||
typedef char *_fcd;
|
||||
typedef long long hsize_t_f;
|
||||
typedef long long hssize_t_f;
|
||||
typedef int size_t_f;
|
||||
typedef int int_f;
|
||||
typedef int hid_t_f;
|
||||
typedef float real_f;
|
||||
#if defined H5_ABSOFT
|
||||
#define DF_CAPFNAMES
|
||||
#else
|
||||
#define FNAME_POST_UNDERSCORE
|
||||
#endif /*H5_ABSOFT*/
|
||||
#define _fcdtocp(desc) (desc)
|
||||
|
||||
#endif /*LINUX*/
|
||||
|
||||
/* LINUX64 definitions */
|
||||
#if defined __x86_64__
|
||||
|
||||
typedef char *_fcd;
|
||||
typedef long long hsize_t_f;
|
||||
typedef long long hssize_t_f;
|
||||
typedef int size_t_f;
|
||||
typedef int int_f;
|
||||
typedef int hid_t_f;
|
||||
typedef float real_f;
|
||||
#define FNAME_POST_UNDERSCORE
|
||||
#define _fcdtocp(desc) (desc)
|
||||
#endif /*LINUX64*/
|
||||
|
||||
/* IA64 LINUX definitions */
|
||||
#if defined __ia64
|
||||
|
||||
typedef char *_fcd;
|
||||
typedef long hsize_t_f;
|
||||
typedef long hssize_t_f;
|
||||
typedef long size_t_f;
|
||||
typedef int int_f;
|
||||
typedef int hid_t_f;
|
||||
typedef float real_f;
|
||||
#define FNAME_POST_UNDERSCORE
|
||||
#define _fcdtocp(desc) (desc)
|
||||
|
||||
#endif /* IA64 LINUX*/
|
||||
|
||||
#if defined(IRIX) || defined(IRIS4) || defined(sgi) || defined(__sgi__) || defined(__sgi)
|
||||
|
||||
typedef char *_fcd;
|
||||
typedef long hsize_t_f;
|
||||
typedef long hssize_t_f;
|
||||
typedef long size_t_f;
|
||||
typedef int int_f;
|
||||
typedef int hid_t_f;
|
||||
typedef float real_f;
|
||||
#define FNAME_POST_UNDERSCORE
|
||||
#define _fcdtocp(desc) (desc)
|
||||
#endif /* IRIX */
|
||||
|
||||
#if (defined(SUN) || defined(sun) || defined(__sun__) || defined(__SUNPRO_C)) & !defined(__i386)
|
||||
|
||||
typedef char *_fcd;
|
||||
typedef long long hssize_t_f;
|
||||
typedef long long hsize_t_f;
|
||||
typedef int size_t_f;
|
||||
typedef int int_f;
|
||||
typedef int hid_t_f;
|
||||
typedef float real_f;
|
||||
#define FNAME_POST_UNDERSCORE
|
||||
#define _fcdtocp(desc) (desc)
|
||||
|
||||
#endif /*SUN*/
|
||||
|
||||
#if defined DEC_ALPHA || (defined __alpha && defined __unix__ && !defined __linux__)
|
||||
|
||||
typedef char *_fcd;
|
||||
typedef long hsize_t_f;
|
||||
typedef long hssize_t_f;
|
||||
typedef long size_t_f;
|
||||
typedef int int_f;
|
||||
typedef int hid_t_f;
|
||||
typedef float real_f;
|
||||
#define FNAME_POST_UNDERSCORE
|
||||
#define _fcdtocp(desc) (desc)
|
||||
|
||||
#endif /* DEC_ALPHA */
|
||||
|
||||
#if defined __alpha__ && defined __linux__
|
||||
|
||||
typedef char *_fcd;
|
||||
typedef long long hsize_t_f;
|
||||
typedef long long hssize_t_f;
|
||||
typedef long long size_t_f;
|
||||
typedef int int_f;
|
||||
typedef int hid_t_f;
|
||||
typedef float real_f;
|
||||
#define FNAME_POST2_UNDERSCORE
|
||||
#define _fcdtocp(desc) (desc)
|
||||
|
||||
#endif /* DEC_ALPHA_LINUX */
|
||||
|
||||
#if defined(HP9000) || (!defined(__convexc__) && (defined(hpux) || defined(__hpux)))
|
||||
|
||||
typedef char *_fcd;
|
||||
typedef long long hsize_t_f;
|
||||
typedef long long hssize_t_f;
|
||||
typedef long size_t_f;
|
||||
typedef int int_f;
|
||||
typedef int hid_t_f;
|
||||
typedef float real_f;
|
||||
#define _fcdtocp(desc) (desc)
|
||||
|
||||
#endif /* HP9000 */
|
||||
|
||||
|
||||
#if defined _WINDOWS || defined WIN32
|
||||
|
||||
typedef char *_fcd;
|
||||
typedef int hsize_t_f;
|
||||
typedef int hssize_t_f;
|
||||
typedef int size_t_f;
|
||||
typedef int int_f;
|
||||
typedef int hid_t_f;
|
||||
typedef float real_f;
|
||||
|
||||
#define DF_CAPFNAMES
|
||||
#define _fcdtocp(desc) (desc)
|
||||
|
||||
#endif /*WINDOWS */
|
||||
|
||||
/*----------------------------------------------------------------
|
||||
** MACRO FNAME for any fortran callable routine name.
|
||||
**
|
||||
** This macro prepends, appends, or does not modify a name
|
||||
** passed as a macro parameter to it based on the FNAME_PRE_UNDERSCORE,
|
||||
** FNAME_POST_UNDERSCORE macros set for a specific system.
|
||||
**
|
||||
**---------------------------------------------------------------*/
|
||||
#if defined(FNAME_PRE_UNDERSCORE) && defined(FNAME_POST_UNDERSCORE)
|
||||
# define FNAME(x) _##x##_
|
||||
#endif
|
||||
#if defined(FNAME_PRE_UNDERSCORE) && !defined(FNAME_POST_UNDERSCORE)
|
||||
# define FNAME(x) _##x
|
||||
#endif
|
||||
#if !defined(FNAME_PRE_UNDERSCORE) && defined(FNAME_POST_UNDERSCORE)
|
||||
# define FNAME(x) x##_
|
||||
#endif
|
||||
#if !defined(FNAME_PRE_UNDERSCORE) && !defined(FNAME_POST_UNDERSCORE)
|
||||
# define FNAME(x) x
|
||||
#endif
|
||||
#if !defined(FNAME_PRE_UNDERSCORE) && defined(FNAME_POST2_UNDERSCORE)
|
||||
# define FNAME(x) x##__
|
||||
#endif
|
||||
|
||||
#endif /* _H5f90i_H */
|
||||
75
hl/fortran/src/Makefile.in
Normal file
75
hl/fortran/src/Makefile.in
Normal file
@ -0,0 +1,75 @@
|
||||
##
|
||||
## 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have
|
||||
## access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu.
|
||||
##
|
||||
## HDF5 Fortran Library Makefile(.in)
|
||||
##
|
||||
top_srcdir=@top_srcdir@
|
||||
top_builddir=../../..
|
||||
srcdir=@srcdir@
|
||||
@COMMENCE@
|
||||
|
||||
HDF_FORTRAN="yes"
|
||||
|
||||
hdf5_srcdir=$(top_srcdir)/src
|
||||
hdf5_builddir=$(top_builddir)/src
|
||||
hl_dir=$(top_srcdir)/hl/src
|
||||
TRACE=perl $(top_srcdir)/bin/trace
|
||||
|
||||
## Add `-I.' to the C preprocessor flags.
|
||||
CPPFLAGS=-I. -I$(hdf5_builddir) -I$(hdf5_srcdir) -I$(srcdir) -I$(hl_dir) @CPPFLAGS@
|
||||
|
||||
## This is our main target
|
||||
LIB=libhdf5hl_fortran.la
|
||||
|
||||
## C hl
|
||||
HL_LIB=$(top_builddir)/hl/src/libhdf5_hl.la
|
||||
|
||||
|
||||
|
||||
|
||||
## h5fc and libhdf5_fortran.settings are generated during configure.
|
||||
## Remove them only when distclean.
|
||||
DISTCLEAN=
|
||||
|
||||
## Public header files (to be installed)...
|
||||
PUB_HDR=
|
||||
PUB_PROGS=
|
||||
|
||||
## Source and object files for the library
|
||||
ADD_PARALLEL_FILES=
|
||||
|
||||
FPAR_MOD=${ADD_PARALLEL_FILES:yes=HDF5mpio.f90}
|
||||
|
||||
CPARALLEL=${ADD_PARALLEL_FILES:yes=H5FDmpiof.c}
|
||||
CLIB_SRC=H5LTfc.c H5IMfc.c H5TBfc.c
|
||||
|
||||
FPARALLEL=${ADD_PARALLEL_FILES:yes=H5FDmpioff.f90}
|
||||
FLIB_SRC=H5LTff.f90 H5IMff.f90 H5TBff.f90
|
||||
|
||||
LIB_SRC=$(CLIB_SRC) $(FLIB_SRC)
|
||||
#LIB_OBJ=$(CLIB_SRC:.c=.lo) $(FLIB_SRC:.f90=.lo)
|
||||
LIB_OBJ=$(CLIB_SRC:.c=.lo) $(FLIB_SRC:.f90=.lo) $(HL_LIB)
|
||||
|
||||
## Hardcode the dependencies of these files. There isn't a known way of
|
||||
## determining this automagically (like we do with the C files). So, when
|
||||
## doing a parallel make, some modules could be made way before the
|
||||
## modules they depend upon are actually made. *sigh*
|
||||
H5LTff.lo: $(srcdir)/H5LTff.f90
|
||||
H5IMff.lo: $(srcdir)/H5IMff.f90
|
||||
H5TBff.lo: $(srcdir)/H5TBff.f90
|
||||
|
||||
|
||||
|
||||
ARFLAGS=rc
|
||||
|
||||
@CONCLUDE@
|
||||
3
hl/fortran/test/Dependencies
Normal file
3
hl/fortran/test/Dependencies
Normal file
@ -0,0 +1,3 @@
|
||||
## This file is machine generated on GNU systems.
|
||||
## Only temporary changes may be made here.
|
||||
|
||||
70
hl/fortran/test/Makefile.in
Normal file
70
hl/fortran/test/Makefile.in
Normal file
@ -0,0 +1,70 @@
|
||||
##
|
||||
## 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have
|
||||
## access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu.
|
||||
##
|
||||
## HDF5-Fortran test/Makefile(.in)
|
||||
##
|
||||
top_srcdir=@top_srcdir@
|
||||
top_builddir=../../..
|
||||
srcdir=@srcdir@
|
||||
@COMMENCE@
|
||||
|
||||
HDF_FORTRAN="yes"
|
||||
|
||||
hdf5_srcdir=$(top_srcdir)/src
|
||||
hdf5_builddir=$(top_builddir)/src
|
||||
CPPFLAGS=-I. -I$(hdf5_builddir) -I$(hdf5_srcdir) @CPPFLAGS@
|
||||
|
||||
## Add include directory to the C preprocessor flags and the h5test and hdf5
|
||||
## libraries to the library list.
|
||||
## C hdf5
|
||||
HDF5LIB=$(top_srcdir)/src/libhdf5.la
|
||||
## fortran hdf5
|
||||
FLIB=$(top_srcdir)/fortran/src/libhdf5_fortran.la
|
||||
## C hl
|
||||
HL_LIB=$(top_srcdir)/hl/src/libhdf5_hl.la
|
||||
## fortran hl
|
||||
HL_FLIB=$(top_srcdir)/hl/fortran/src/libhdf5hl_fortran.la
|
||||
|
||||
|
||||
TCLIB=
|
||||
LIB_CSRC=
|
||||
LIB_FSRC=
|
||||
LIB_OBJ=$(LIB_FSRC:.f90=.lo) $(LIB_CSRC:.c=.lo)
|
||||
|
||||
TEST_PROGS_SRC=tstlite.f90 tstimage.f90 tsttable.f90
|
||||
TEST_PROGS=$(TEST_PROGS_SRC:.f90=)
|
||||
|
||||
# fortranlib_test settting
|
||||
FORTLIBTEST_FSRC=
|
||||
FORTLIBTEST_CSRC=
|
||||
FORTLIBTEST_OBJ=$(FORTLIBTEST_FSRC:.f90=.lo) $(FORTLIBTEST_CSRC:.c=.lo)
|
||||
|
||||
TEST_OBJ=$(FORTLIBTEST_OBJ) $(TEST_PROGS_SRC:.f90=.lo)
|
||||
|
||||
## Temporary files
|
||||
MOSTLYCLEAN=*.h5 *.tmp
|
||||
|
||||
$(TEST_PROGS): $(LIB) $(FLIB) $(HL_LIB) $(HL_FLIB)
|
||||
|
||||
tstlite: tstlite.lo
|
||||
@$(LT_LINK_FEXE) $(FFLAGS) -o $@ tstlite.lo $(HL_LIB) $(HL_FLIB) $(FLIB) $(LIBS) $(HDF5LIB)
|
||||
|
||||
tstimage: tstimage.lo
|
||||
@$(LT_LINK_FEXE) $(FFLAGS) -o $@ tstimage.lo $(HL_LIB) $(HL_FLIB) $(FLIB) $(LIBS) $(HDF5LIB)
|
||||
|
||||
tsttable: tsttable.lo
|
||||
@$(LT_LINK_FEXE) $(FFLAGS) -o $@ tsttable.lo $(HL_LIB) $(HL_FLIB) $(FLIB) $(LIBS) $(HDF5LIB)
|
||||
|
||||
|
||||
|
||||
@CONCLUDE@
|
||||
316
hl/fortran/test/tstimage.f90
Executable file
316
hl/fortran/test/tstimage.f90
Executable file
@ -0,0 +1,316 @@
|
||||
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
! 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 errcode 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
|
||||
! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
|
||||
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
!
|
||||
!
|
||||
! This file contains the FORTRAN90 tests for H5LT
|
||||
!
|
||||
|
||||
program image_test
|
||||
|
||||
call make_image1()
|
||||
|
||||
end program image_test
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! make_image1
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine make_image1()
|
||||
|
||||
use H5IM ! module of H5IM
|
||||
use HDF5 ! module of HDF5 library
|
||||
|
||||
implicit none
|
||||
|
||||
character(len=8), parameter :: filename = "f1img.h5" ! File name
|
||||
character(LEN=4), parameter :: dsetname1 = "img1" ! Dataset name
|
||||
character(LEN=4), parameter :: dsetname2 = "img2" ! Dataset name
|
||||
character(LEN=15), parameter :: il ="INTERLACE_PIXEL"! Dataset name
|
||||
integer(HID_T) :: file_id ! File identifier
|
||||
integer(HSIZE_T), parameter :: width = 30 ! width
|
||||
integer(HSIZE_T), parameter :: height = 10 ! width
|
||||
integer*1, dimension(width*height) :: buf1 ! Data buffer
|
||||
integer*1, dimension(width*height) :: bufr1 ! Data buffer
|
||||
integer*1, dimension(width*height*3) :: buf2 ! Data buffer
|
||||
integer*1, dimension(width*height*3) :: bufr2 ! Data buffer
|
||||
integer(HSIZE_T) :: widthr ! width of image
|
||||
integer(HSIZE_T) :: heightr ! height of image
|
||||
integer(HSIZE_T) :: planesr ! color planes
|
||||
integer(HSIZE_T) :: npalsr ! palettes
|
||||
character(LEN=15) :: interlacer ! interlace
|
||||
integer :: errcode ! Error flag
|
||||
integer :: is_image ! Error flag
|
||||
integer :: i, n ! general purpose integer
|
||||
!
|
||||
! palette
|
||||
! create a 9 entry grey palette
|
||||
!
|
||||
character(LEN=4), parameter :: pal_name = "pal1" ! Dataset name
|
||||
integer(HSIZE_T), dimension(2) :: pal_dims = (/9,3/) ! Dataset dimensions
|
||||
integer(HSIZE_T), dimension(2) :: pal_dims_out ! Dataset dimensions
|
||||
integer*1, dimension(9*3) :: pal_data_in = (/0,0,0,25,25,25,50,50,50,75,75,75,100,100,100,&
|
||||
125,125,125,125,125,125,125,125,125,125,125,125/)
|
||||
integer*1, dimension(9*3) :: pal_data_out ! Data buffer
|
||||
integer(HSIZE_T) :: npals ! number of palettes
|
||||
integer :: pal_number ! palette number
|
||||
integer :: is_palette ! is palette
|
||||
|
||||
!
|
||||
! Initialize the data array.
|
||||
!
|
||||
n = 0
|
||||
do i = 1, width*height
|
||||
buf1(i) = n;
|
||||
n = n + 1;
|
||||
end do
|
||||
|
||||
n = 0
|
||||
do i = 1, width*height*3
|
||||
buf2(i) = n;
|
||||
n = n + 1;
|
||||
end do
|
||||
|
||||
!
|
||||
! Initialize FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5open_f(errcode)
|
||||
|
||||
!
|
||||
! Create a new file using default properties.
|
||||
!
|
||||
call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! indexed image
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Make/Read image 8bit ')
|
||||
|
||||
!
|
||||
! write image.
|
||||
!
|
||||
call h5immake_image_8bit_f(file_id,dsetname1,width,height,buf1,errcode)
|
||||
|
||||
!
|
||||
! read image.
|
||||
!
|
||||
call h5imread_image_f(file_id,dsetname1,bufr1,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, width*height
|
||||
if ( buf1(i) .ne. bufr1(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr1(i), ' and ', buf1(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
!
|
||||
! get image info.
|
||||
!
|
||||
call h5imget_image_info_f(file_id,dsetname1,widthr,heightr,planesr,interlacer,npalsr,errcode)
|
||||
|
||||
if ( (widthr .ne. widthr) .or. (heightr .ne. height) .or. (planesr .ne. 1)) then
|
||||
print *, 'h5imget_image_info_f bad value'
|
||||
stop
|
||||
endif
|
||||
|
||||
is_image = h5imis_image_f(file_id,dsetname1)
|
||||
if ( is_image .ne. 1) then
|
||||
print *, 'h5imis_image_f bad value'
|
||||
stop
|
||||
endif
|
||||
|
||||
|
||||
call passed()
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! true color image
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Make/Read image 24bit ')
|
||||
|
||||
!
|
||||
! write image.
|
||||
!
|
||||
call h5immake_image_24bit_f(file_id,dsetname2,width,height,il,buf2,errcode)
|
||||
|
||||
!
|
||||
! read image.
|
||||
!
|
||||
call h5imread_image_f(file_id,dsetname2,bufr2,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, width*height*3
|
||||
if ( buf2(i) .ne. bufr2(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr2(i), ' and ', buf2(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
!
|
||||
! get image info.
|
||||
!
|
||||
call h5imget_image_info_f(file_id,dsetname2,widthr,heightr,planesr,interlacer,npalsr,errcode)
|
||||
|
||||
if ( (widthr .ne. widthr) .or. (heightr .ne. height) .or. (planesr .ne. 3)) then
|
||||
print *, 'h5imget_image_info_f bad value'
|
||||
stop
|
||||
endif
|
||||
|
||||
is_image = h5imis_image_f(file_id,dsetname2)
|
||||
if ( is_image .ne. 1) then
|
||||
print *, 'h5imis_image_f bad value'
|
||||
stop
|
||||
endif
|
||||
|
||||
|
||||
|
||||
call passed()
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! palette
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Make palette ')
|
||||
|
||||
!
|
||||
! make palette.
|
||||
!
|
||||
call h5immake_palette_f(file_id,pal_name,pal_dims,pal_data_in,errcode)
|
||||
|
||||
call passed()
|
||||
|
||||
|
||||
call test_begin(' Link/Unlink palette ')
|
||||
|
||||
!
|
||||
! link palette.
|
||||
!
|
||||
call h5imlink_palette_f(file_id,dsetname1,pal_name,errcode)
|
||||
|
||||
|
||||
!
|
||||
! read palette.
|
||||
!
|
||||
pal_number = 0
|
||||
call h5imget_palette_f(file_id,dsetname1,pal_number,pal_data_out,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, 9*3
|
||||
if ( pal_data_in(i) .ne. pal_data_out(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, pal_data_in(i), ' and ', pal_data_out(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
!
|
||||
! get number of palettes
|
||||
!
|
||||
call h5imget_npalettes_f(file_id,dsetname1,npals,errcode)
|
||||
|
||||
if ( npals .ne. 1) then
|
||||
print *, 'h5imget_npalettes_f bad value'
|
||||
stop
|
||||
endif
|
||||
|
||||
!
|
||||
! get palette info
|
||||
!
|
||||
pal_number = 0
|
||||
call h5imget_palette_info_f(file_id,dsetname1,pal_number,pal_dims_out,errcode)
|
||||
|
||||
if ( (pal_dims_out(1) .ne. pal_dims(1)) .or. (pal_dims_out(2) .ne. pal_dims(2))) then
|
||||
print *, 'h5imget_palette_info_f bad value'
|
||||
stop
|
||||
endif
|
||||
|
||||
!
|
||||
! is palette
|
||||
!
|
||||
is_palette = h5imis_palette_f(file_id,pal_name)
|
||||
|
||||
if ( is_palette .ne. 1 ) then
|
||||
print *, 'h5imis_palette_f bad value'
|
||||
stop
|
||||
endif
|
||||
|
||||
!
|
||||
! unlink palette.
|
||||
!
|
||||
call h5imunlink_palette_f(file_id,dsetname1,pal_name,errcode)
|
||||
|
||||
!
|
||||
! get number of palettes
|
||||
!
|
||||
call h5imget_npalettes_f(file_id,dsetname1,npals,errcode )
|
||||
|
||||
if ( npals .ne. 0) then
|
||||
print *, 'h5imget_npalettes_f bad value'
|
||||
stop
|
||||
endif
|
||||
|
||||
call passed()
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! end
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! Close the file.
|
||||
!
|
||||
call h5fclose_f(file_id, errcode)
|
||||
|
||||
!
|
||||
! Close FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5close_f(errcode)
|
||||
|
||||
|
||||
!
|
||||
! end function.
|
||||
!
|
||||
end subroutine make_image1
|
||||
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! test_begin
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine test_begin(string)
|
||||
character(LEN=*), intent(IN) :: string
|
||||
write(*, fmt = '(14a)', advance = 'no') string
|
||||
write(*, fmt = '(40x,a)', advance = 'no') ' '
|
||||
end subroutine test_begin
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! passed
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine passed()
|
||||
write(*, fmt = '(6a)') 'PASSED'
|
||||
end subroutine passed
|
||||
955
hl/fortran/test/tstlite.f90
Normal file
955
hl/fortran/test/tstlite.f90
Normal file
@ -0,0 +1,955 @@
|
||||
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
! 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 errcode 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
|
||||
! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
|
||||
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
!
|
||||
!
|
||||
! This file contains the FORTRAN90 tests for H5LT
|
||||
!
|
||||
|
||||
program lite_test
|
||||
|
||||
call test_dataset1D()
|
||||
call test_dataset2D()
|
||||
call test_dataset3D()
|
||||
call test_datasets()
|
||||
call test_attributes()
|
||||
|
||||
end program lite_test
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! test_dataset1D
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine test_dataset1D()
|
||||
|
||||
use H5LT ! module of H5LT
|
||||
use HDF5 ! module of HDF5 library
|
||||
|
||||
implicit none
|
||||
|
||||
integer, parameter :: DIM1 = 4; ! Dimension of array
|
||||
character(len=9), parameter :: filename = "dsetf1.h5"! File name
|
||||
character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name
|
||||
character(LEN=5), parameter :: dsetname2 = "dset2" ! Dataset name
|
||||
character(LEN=5), parameter :: dsetname3 = "dset3" ! Dataset name
|
||||
integer(HID_T) :: file_id ! File identifier
|
||||
integer(HSIZE_T), dimension(1) :: dims = (/DIM1/) ! Dataset dimensions
|
||||
integer :: rank = 1 ! Dataset rank
|
||||
integer, dimension(DIM1) :: buf1 ! Data buffer
|
||||
integer, dimension(DIM1) :: bufr1 ! Data buffer
|
||||
real, dimension(DIM1) :: buf2 ! Data buffer
|
||||
real, dimension(DIM1) :: bufr2 ! Data buffer
|
||||
double precision, dimension(DIM1) :: buf3 ! Data buffer
|
||||
double precision, dimension(DIM1) :: bufr3 ! Data buffer
|
||||
integer :: errcode ! Error flag
|
||||
integer :: i ! general purpose integer
|
||||
|
||||
|
||||
call test_begin(' Make/Read datasets (1D) ')
|
||||
|
||||
|
||||
!
|
||||
! Initialize the data array.
|
||||
!
|
||||
do i = 1, DIM1
|
||||
buf1(i) = i;
|
||||
buf2(i) = i;
|
||||
buf3(i) = i;
|
||||
end do
|
||||
|
||||
!
|
||||
! Initialize FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5open_f(errcode)
|
||||
|
||||
!
|
||||
! Create a new file using default properties.
|
||||
!
|
||||
call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! H5T_NATIVE_INTEGER
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf1, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr1, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, DIM1
|
||||
if ( buf1(i) .ne. bufr1(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr1(i), ' and ', buf1(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! H5T_NATIVE_REAL
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_REAL, buf2, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_REAL, bufr2, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, DIM1
|
||||
if ( buf2(i) .ne. bufr2(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr2(i), ' and ', buf2(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! H5T_NATIVE_DOUBLE
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_DOUBLE, buf3, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_DOUBLE, bufr3, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, DIM1
|
||||
if ( buf3(i) .ne. bufr3(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr3(i), ' and ', buf3(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
!
|
||||
! Close the file.
|
||||
!
|
||||
call h5fclose_f(file_id, errcode)
|
||||
|
||||
!
|
||||
! Close FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5close_f(errcode)
|
||||
|
||||
call passed()
|
||||
!
|
||||
! end function.
|
||||
!
|
||||
end subroutine test_dataset1D
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! test_dataset2D
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine test_dataset2D()
|
||||
|
||||
use H5LT ! module of H5LT
|
||||
use HDF5 ! module of HDF5 library
|
||||
|
||||
implicit none
|
||||
|
||||
|
||||
integer, parameter :: DIM1 = 4; ! columns
|
||||
integer, parameter :: DIM2 = 6; ! rows
|
||||
character(len=9), parameter :: filename = "dsetf2.h5"! File name
|
||||
character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name
|
||||
character(LEN=5), parameter :: dsetname2 = "dset2" ! Dataset name
|
||||
character(LEN=5), parameter :: dsetname3 = "dset3" ! Dataset name
|
||||
character(LEN=5), parameter :: dsetname4 = "dset4" ! Dataset name
|
||||
integer(HID_T) :: file_id ! File identifier
|
||||
integer(HSIZE_T), dimension(2) :: dims = (/4,6/) ! Dataset dimensions
|
||||
integer :: rank = 2 ! Dataset rank
|
||||
integer, dimension(DIM1*DIM2) :: buf ! Data buffer
|
||||
integer, dimension(DIM1*DIM2) :: bufr ! Data buffer
|
||||
integer, dimension(DIM1,DIM2) :: buf2 ! Data buffer
|
||||
integer, dimension(DIM1,DIM2) :: buf2r ! Data buffer
|
||||
real, dimension(DIM1,DIM2) :: buf3 ! Data buffer
|
||||
real, dimension(DIM1,DIM2) :: buf3r ! Data buffer
|
||||
double precision, dimension(DIM1,DIM2) :: buf4 ! Data buffer
|
||||
double precision, dimension(DIM1,DIM2) :: buf4r ! Data buffer
|
||||
integer :: errcode ! Error flag
|
||||
integer :: i, j, n ! general purpose integers
|
||||
|
||||
call test_begin(' Make/Read datasets (2D) ')
|
||||
|
||||
|
||||
!
|
||||
! Initialize the data arrays.
|
||||
!
|
||||
n=1
|
||||
do i = 1, DIM1*DIM2
|
||||
buf(i) = n;
|
||||
n = n + 1
|
||||
end do
|
||||
|
||||
do i = 1, dims(1)
|
||||
do j = 1, dims(2)
|
||||
buf2(i,j) = (i-1)*dims(2) + j;
|
||||
buf3(i,j) = (i-1)*dims(2) + j;
|
||||
buf4(i,j) = (i-1)*dims(2) + j;
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
!
|
||||
! Initialize FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5open_f(errcode)
|
||||
|
||||
!
|
||||
! Create a new file using default properties.
|
||||
!
|
||||
call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! H5T_NATIVE_INT 1D buffer
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, DIM1*DIM2
|
||||
if ( buf(i) .ne. bufr(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr(i), ' and ', buf(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! H5T_NATIVE_INT 2D buffer
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, dims(1)
|
||||
do j = 1, dims(2)
|
||||
if ( buf2(i,j) .ne. buf2r(i,j) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, buf2r(i,j), ' and ', buf2(i,j)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
end do
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! H5T_NATIVE_REAL
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, dims(1)
|
||||
do j = 1, dims(2)
|
||||
if ( buf3(i,j) .ne. buf3r(i,j) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, buf3r(i,j), ' and ', buf3(i,j)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
end do
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! H5T_NATIVE_DOUBLE
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, buf4, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, buf4r, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, dims(1)
|
||||
do j = 1, dims(2)
|
||||
if ( buf4(i,j) .ne. buf4r(i,j) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, buf4r(i,j), ' and ', buf4(i,j)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
end do
|
||||
|
||||
!
|
||||
! Close the file.
|
||||
!
|
||||
call h5fclose_f(file_id, errcode)
|
||||
|
||||
!
|
||||
! Close FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5close_f(errcode)
|
||||
|
||||
call passed()
|
||||
!
|
||||
! end function.
|
||||
!
|
||||
end subroutine test_dataset2D
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! test_dataset3D
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
|
||||
subroutine test_dataset3D()
|
||||
|
||||
use H5LT ! module of H5LT
|
||||
use HDF5 ! module of HDF5 library
|
||||
|
||||
implicit none
|
||||
|
||||
integer, parameter :: DIM1 = 6; ! columns
|
||||
integer, parameter :: DIM2 = 4; ! rows
|
||||
integer, parameter :: DIM3 = 2; ! layers
|
||||
character(len=9), parameter :: filename = "dsetf3.h5" ! File name
|
||||
character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name
|
||||
character(LEN=5), parameter :: dsetname2 = "dset2" ! Dataset name
|
||||
character(LEN=5), parameter :: dsetname3 = "dset3" ! Dataset name
|
||||
character(LEN=5), parameter :: dsetname4 = "dset4" ! Dataset name
|
||||
integer(HID_T) :: file_id ! File identifier
|
||||
integer(HSIZE_T), dimension(3) :: dims = (/DIM1,DIM2,DIM3/) ! Dataset dimensions
|
||||
integer, dimension(DIM1*DIM2*DIM3) :: buf ! Data buffer
|
||||
integer, dimension(DIM1*DIM2*DIM3) :: bufr ! Data buffer
|
||||
integer, dimension(DIM1,DIM2,DIM3) :: buf2 ! Data buffer
|
||||
integer, dimension(DIM1,DIM2,DIM3) :: buf2r ! Data buffer
|
||||
real, dimension(DIM1,DIM2,DIM3) :: buf3 ! Data buffer
|
||||
real, dimension(DIM1,DIM2,DIM3) :: buf3r ! Data buffer
|
||||
double precision, dimension(DIM1,DIM2,DIM3) :: buf4 ! Data buffer
|
||||
double precision, dimension(DIM1,DIM2,DIM3) :: buf4r ! Data buffer
|
||||
integer :: rank = 3 ! Dataset rank
|
||||
integer :: errcode ! Error flag
|
||||
integer :: i, j, k, n ! general purpose integers
|
||||
|
||||
call test_begin(' Make/Read datasets (3D) ')
|
||||
|
||||
|
||||
!
|
||||
! Initialize the data array.
|
||||
!
|
||||
n=1
|
||||
do i = 1, DIM1*DIM2*DIM3
|
||||
buf(i) = n;
|
||||
n = n + 1
|
||||
end do
|
||||
|
||||
n = 1
|
||||
do i = 1, dims(1)
|
||||
do j = 1, dims(2)
|
||||
do k = 1, dims(3)
|
||||
buf2(i,j,k) = n;
|
||||
buf3(i,j,k) = n;
|
||||
buf4(i,j,k) = n;
|
||||
n = n + 1
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
!
|
||||
! Initialize FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5open_f(errcode)
|
||||
|
||||
!
|
||||
! Create a new file using default properties.
|
||||
!
|
||||
call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! H5T_NATIVE_INT 1D buffer
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, DIM1*DIM2*DIM3
|
||||
if ( buf(i) .ne. bufr(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr(i), ' and ', buf(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! H5T_NATIVE_INT 3D buffer
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, dims(1)
|
||||
do j = 1, dims(2)
|
||||
do k = 1, dims(3)
|
||||
if ( buf2(i,j,k) .ne. buf2r(i,j,k) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, buf2r(i,j,k), ' and ', buf2(i,j,k)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! H5T_NATIVE_REAL
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, dims(1)
|
||||
do j = 1, dims(2)
|
||||
do k = 1, dims(3)
|
||||
if ( buf3(i,j,k) .ne. buf3r(i,j,k) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, buf3r(i,j,k), ' and ', buf3(i,j,k)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! H5T_NATIVE_DOUBLE
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, buf4, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, buf4r, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, dims(1)
|
||||
do j = 1, dims(2)
|
||||
do k = 1, dims(3)
|
||||
if ( buf4(i,j,k) .ne. buf4r(i,j,k) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, buf4r(i,j,k), ' and ', buf4(i,j,k)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
!
|
||||
! Close the file.
|
||||
!
|
||||
call h5fclose_f(file_id, errcode)
|
||||
|
||||
!
|
||||
! Close FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5close_f(errcode)
|
||||
|
||||
call passed()
|
||||
!
|
||||
! end function.
|
||||
!
|
||||
end subroutine test_dataset3D
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! test_datasets
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine test_datasets()
|
||||
|
||||
use H5LT ! module of H5LT
|
||||
use HDF5 ! module of HDF5 library
|
||||
|
||||
implicit none
|
||||
|
||||
character(len=9), parameter :: filename = "dsetf4.h5"! File name
|
||||
integer(HID_T) :: file_id ! File identifier
|
||||
integer :: errcode ! Error flag
|
||||
integer, parameter :: DIM1 = 10; ! Dimension of array
|
||||
character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name
|
||||
character(LEN=5), parameter :: dsetname2 = "dset2" ! Dataset name
|
||||
character(LEN=5), parameter :: dsetname3 = "dset3" ! Dataset name
|
||||
character(LEN=5), parameter :: dsetname4 = "dset4" ! Dataset name
|
||||
integer(HSIZE_T), dimension(1) :: dims = (/DIM1/) ! Dataset dimensions
|
||||
integer(HSIZE_T), dimension(1) :: dimsr ! Dataset dimensions
|
||||
integer :: rank = 1 ! Dataset rank
|
||||
integer :: rankr ! Dataset rank
|
||||
character(LEN=8), parameter :: buf1 = "mystring" ! Data buffer
|
||||
character(LEN=8) :: buf1r ! Data buffer
|
||||
integer, dimension(DIM1) :: buf2 ! Data buffer
|
||||
integer, dimension(DIM1) :: bufr2 ! Data buffer
|
||||
real, dimension(DIM1) :: buf3 ! Data buffer
|
||||
real, dimension(DIM1) :: bufr3 ! Data buffer
|
||||
double precision, dimension(DIM1) :: buf4 ! Data buffer
|
||||
double precision, dimension(DIM1) :: bufr4 ! Data buffer
|
||||
integer :: i, n ! general purpose integer
|
||||
integer :: has ! general purpose integer
|
||||
integer :: type_class
|
||||
integer(SIZE_T) :: type_size
|
||||
|
||||
!
|
||||
! Initialize FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5open_f(errcode)
|
||||
|
||||
!
|
||||
! Create a new file using default properties.
|
||||
!
|
||||
call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
|
||||
|
||||
!
|
||||
! Initialize the data array.
|
||||
!
|
||||
n = 1
|
||||
do i = 1, DIM1
|
||||
buf2(i) = n;
|
||||
buf3(i) = n;
|
||||
buf4(i) = n;
|
||||
n = n + 1;
|
||||
end do
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! int
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Make/Read datasets (integer) ')
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_int_f(file_id, dsetname2, rank, dims, buf2, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_int_f(file_id, dsetname2, bufr2, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, DIM1
|
||||
if ( buf2(i) .ne. bufr2(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr2(i), ' and ', buf2(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call passed()
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! real
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Make/Read datasets (float) ')
|
||||
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_float_f(file_id, dsetname3, rank, dims, buf3, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_float_f(file_id, dsetname3, bufr3, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, DIM1
|
||||
if ( buf3(i) .ne. bufr3(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr3(i), ' and ', buf3(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call passed()
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! double
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Make/Read datasets (double) ')
|
||||
|
||||
|
||||
!
|
||||
! write dataset.
|
||||
!
|
||||
call h5ltmake_dataset_double_f(file_id, dsetname4, rank, dims, buf4, errcode)
|
||||
|
||||
!
|
||||
! read dataset.
|
||||
!
|
||||
call h5ltread_dataset_double_f(file_id, dsetname4, bufr4, dims, errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, DIM1
|
||||
if ( buf4(i) .ne. bufr4(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr4(i), ' and ', buf4(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call passed()
|
||||
|
||||
call test_begin(' Get dataset dimensions ')
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! h5ltget_dataset_ndims_f
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call h5ltget_dataset_ndims_f(file_id, dsetname4, rankr, errcode)
|
||||
|
||||
if ( rankr .ne. rank ) then
|
||||
print *, 'h5ltget_dataset_ndims_f return error'
|
||||
stop
|
||||
endif
|
||||
|
||||
call passed()
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! test find dataset function
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Find dataset ')
|
||||
|
||||
|
||||
has = h5ltfind_dataset_f(file_id,dsetname4)
|
||||
if ( has .ne. 1 ) then
|
||||
print *, 'h5ltfind_dataset_f return error'
|
||||
stop
|
||||
endif
|
||||
|
||||
!
|
||||
! Close the file.
|
||||
!
|
||||
call h5fclose_f(file_id, errcode)
|
||||
!
|
||||
! Close FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5close_f(errcode)
|
||||
|
||||
call passed()
|
||||
!
|
||||
! end function.
|
||||
!
|
||||
end subroutine test_datasets
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! test_attributes
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine test_attributes()
|
||||
|
||||
use H5LT ! module of H5LT
|
||||
use HDF5 ! module of HDF5 library
|
||||
|
||||
implicit none
|
||||
|
||||
character(len=9), parameter :: filename = "dsetf4.h5"! File name
|
||||
integer(HID_T) :: file_id ! File identifier
|
||||
integer, parameter :: DIM1 = 10; ! Dimension of array
|
||||
character(LEN=5), parameter :: attrname1 = "attr1" ! Attribute name
|
||||
character(LEN=5), parameter :: attrname2 = "attr2" ! Attribute name
|
||||
character(LEN=5), parameter :: attrname3 = "attr3" ! Attribute name
|
||||
character(LEN=5), parameter :: attrname4 = "attr4" ! Attribute name
|
||||
character(LEN=8), parameter :: buf1 = "mystring" ! Data buffer
|
||||
character(LEN=8) :: bufr1 ! Data buffer
|
||||
integer, dimension(DIM1) :: buf2 ! Data buffer
|
||||
integer, dimension(DIM1) :: bufr2 ! Data buffer
|
||||
real, dimension(DIM1) :: buf3 ! Data buffer
|
||||
real, dimension(DIM1) :: bufr3 ! Data buffer
|
||||
double precision, dimension(DIM1) :: buf4 ! Data buffer
|
||||
double precision, dimension(DIM1) :: bufr4 ! Data buffer
|
||||
integer :: errcode ! Error flag
|
||||
integer :: i, n ! general purpose integer
|
||||
integer(SIZE_T) size ! size of attribute array
|
||||
integer :: rankr ! rank
|
||||
integer(HSIZE_T), dimension(1) :: dimsr ! attribute dimensions
|
||||
integer :: type_class
|
||||
integer(SIZE_T) :: type_size
|
||||
integer(HSIZE_T), dimension(1) :: dims = (/DIM1/) ! Dataset dimensions
|
||||
integer :: rank = 1 ! Dataset rank
|
||||
character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name
|
||||
integer, dimension(DIM1) :: buf ! Data buffer
|
||||
|
||||
!
|
||||
! Initialize FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5open_f(errcode)
|
||||
!
|
||||
! Create a new file using default properties.
|
||||
!
|
||||
call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
|
||||
!
|
||||
! make a dataset.
|
||||
!
|
||||
call h5ltmake_dataset_int_f(file_id, dsetname1, rank, dims, buf, errcode)
|
||||
|
||||
!
|
||||
! Initialize the data array.
|
||||
!
|
||||
size = DIM1
|
||||
n = 1
|
||||
do i = 1, DIM1
|
||||
buf2(i) = n;
|
||||
buf3(i) = n;
|
||||
buf4(i) = n;
|
||||
n = n + 1;
|
||||
end do
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! int
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Set/Get attributes int ')
|
||||
|
||||
|
||||
!
|
||||
! write attribute.
|
||||
!
|
||||
call h5ltset_attribute_int_f(file_id,dsetname1,attrname2,buf2,size,errcode)
|
||||
|
||||
!
|
||||
! read attribute.
|
||||
!
|
||||
call h5ltget_attribute_int_f(file_id,dsetname1,attrname2,bufr2,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, DIM1
|
||||
if ( buf2(i) .ne. bufr2(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr2(i), ' and ', buf2(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call passed()
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! float
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Set/Get attributes float ')
|
||||
|
||||
|
||||
!
|
||||
! write attribute.
|
||||
!
|
||||
call h5ltset_attribute_float_f(file_id,dsetname1,attrname3,buf3,size,errcode)
|
||||
|
||||
!
|
||||
! read attribute.
|
||||
!
|
||||
call h5ltget_attribute_float_f(file_id,dsetname1,attrname3,bufr3,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, DIM1
|
||||
if ( buf3(i) .ne. bufr3(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr3(i), ' and ', buf3(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
|
||||
call passed()
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! double
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Set/Get attributes double ')
|
||||
|
||||
|
||||
!
|
||||
! write attribute.
|
||||
!
|
||||
call h5ltset_attribute_double_f(file_id,dsetname1,attrname4,buf4,size,errcode)
|
||||
|
||||
!
|
||||
! read attribute.
|
||||
!
|
||||
call h5ltget_attribute_double_f(file_id,dsetname1,attrname4,bufr4,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, DIM1
|
||||
if ( buf4(i) .ne. bufr4(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufr4(i), ' and ', buf4(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call passed()
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! get attribute rank
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Get attribute rank ')
|
||||
|
||||
|
||||
call h5ltget_attribute_ndims_f(file_id,dsetname1,attrname2,rankr,errcode)
|
||||
|
||||
if ( rankr .ne. 1 ) then
|
||||
print *, 'h5ltget_attribute_ndims_f return error'
|
||||
stop
|
||||
endif
|
||||
|
||||
|
||||
!
|
||||
! Close the file.
|
||||
!
|
||||
call h5fclose_f(file_id, errcode)
|
||||
!
|
||||
! Close FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5close_f(errcode)
|
||||
|
||||
call passed()
|
||||
!
|
||||
! end function.
|
||||
!
|
||||
end subroutine test_attributes
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! test_begin
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine test_begin(string)
|
||||
character(LEN=*), intent(IN) :: string
|
||||
write(*, fmt = '(14a)', advance = 'no') string
|
||||
write(*, fmt = '(40x,a)', advance = 'no') ' '
|
||||
end subroutine test_begin
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! passed
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine passed()
|
||||
write(*, fmt = '(6a)') 'PASSED'
|
||||
end subroutine passed
|
||||
435
hl/fortran/test/tsttable.f90
Executable file
435
hl/fortran/test/tsttable.f90
Executable file
@ -0,0 +1,435 @@
|
||||
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
! 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 errcode 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
|
||||
! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
|
||||
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||||
!
|
||||
!
|
||||
! This file contains the FORTRAN90 tests for H5LT
|
||||
!
|
||||
|
||||
program table_test
|
||||
|
||||
call test_table1()
|
||||
|
||||
|
||||
end program table_test
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! test_table1
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine test_table1()
|
||||
|
||||
use H5TB ! module of H5TB
|
||||
use HDF5 ! module of HDF5 library
|
||||
|
||||
implicit none
|
||||
|
||||
character(len=8), parameter :: filename = "f1tab.h5" ! File name
|
||||
character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name
|
||||
integer(HID_T) :: file_id ! File identifier
|
||||
integer(HSIZE_T), parameter :: nfields = 4; ! nfields
|
||||
integer(HSIZE_T), parameter :: nrecords = 5; ! nrecords
|
||||
character(LEN=6), dimension(nfields) :: field_names ! field names
|
||||
integer(SIZE_T), dimension(nfields) :: field_offset ! field offset
|
||||
integer(HID_T), dimension(nfields) :: field_types ! field types
|
||||
integer(HSIZE_T), parameter :: chunk_size = 5 ! chunk size
|
||||
integer, parameter :: compress = 0 ! compress
|
||||
integer :: errcode ! Error flag
|
||||
integer :: i ! general purpose integer
|
||||
integer(SIZE_T) :: type_size ! Size of the datatype
|
||||
integer(SIZE_T) :: type_sizec ! Size of the character datatype
|
||||
integer(SIZE_T) :: type_sizei ! Size of the integer datatype
|
||||
integer(SIZE_T) :: type_sized ! Size of the double precision datatype
|
||||
integer(SIZE_T) :: type_sizer ! Size of the real datatype
|
||||
integer(HID_T) :: type_id_c ! Memory datatype identifier (for character field)
|
||||
integer(SIZE_T) :: offset ! Member's offset
|
||||
integer(HSIZE_T) :: start ! start record
|
||||
integer, dimension(nrecords) :: bufi ! Data buffer
|
||||
integer, dimension(nrecords) :: bufir ! Data buffer
|
||||
real, dimension(nrecords) :: bufr ! Data buffer
|
||||
real, dimension(nrecords) :: bufrr ! Data buffer
|
||||
double precision, dimension(nrecords) :: bufd ! Data buffer
|
||||
double precision, dimension(nrecords) :: bufdr ! Data buffer
|
||||
character(LEN=2), dimension(nrecords), parameter :: bufs = (/"AB","CD","EF","GH","IJ"/) ! Data buffer
|
||||
character(LEN=2), dimension(nrecords) :: bufsr ! Data buffer
|
||||
integer(HSIZE_T) :: nfieldsr ! nfields
|
||||
integer(HSIZE_T) :: nrecordsr ! nrecords
|
||||
character(LEN=6), dimension(nfields) :: field_namesr ! field names
|
||||
integer(SIZE_T), dimension(nfields) :: field_offsetr ! field offset
|
||||
integer(SIZE_T), dimension(nfields) :: field_sizesr ! field sizes
|
||||
integer(SIZE_T) :: type_sizeout ! size of the datatype
|
||||
|
||||
|
||||
!
|
||||
! Initialize the data arrays.
|
||||
!
|
||||
do i = 1, nrecords
|
||||
bufi(i) = i;
|
||||
bufr(i) = i;
|
||||
bufd(i) = i;
|
||||
end do
|
||||
|
||||
!
|
||||
! Initialize FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5open_f(errcode)
|
||||
|
||||
!
|
||||
! Create a new file using default properties.
|
||||
!
|
||||
call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! make table
|
||||
! initialize the table parameters
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
field_names(1) = "field1"
|
||||
field_names(2) = "field2"
|
||||
field_names(3) = "field3"
|
||||
field_names(4) = "field4"
|
||||
|
||||
!
|
||||
! calculate total size by calculating sizes of each member
|
||||
!
|
||||
call h5tcopy_f(H5T_NATIVE_CHARACTER, type_id_c, errcode)
|
||||
type_size = 2
|
||||
call h5tset_size_f(type_id_c, type_size, errcode)
|
||||
call h5tget_size_f(type_id_c, type_sizec, errcode)
|
||||
call h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, errcode)
|
||||
call h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, errcode)
|
||||
call h5tget_size_f(H5T_NATIVE_REAL, type_sizer, errcode)
|
||||
type_size = type_sizec + type_sizei + type_sized + type_sizer
|
||||
|
||||
!
|
||||
! type ID's
|
||||
!
|
||||
field_types(1) = type_id_c
|
||||
field_types(2) = H5T_NATIVE_INTEGER
|
||||
field_types(3) = H5T_NATIVE_DOUBLE
|
||||
field_types(4) = H5T_NATIVE_REAL
|
||||
|
||||
!
|
||||
! offsets
|
||||
!
|
||||
offset = 0
|
||||
field_offset(1) = offset
|
||||
offset = offset + type_sizec ! Offset of the second memeber is 2
|
||||
field_offset(2) = offset
|
||||
offset = offset + type_sizei ! Offset of the second memeber is 6
|
||||
field_offset(3) = offset
|
||||
offset = offset + type_sized ! Offset of the second memeber is 14
|
||||
field_offset(4) = offset
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! make table
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Make table ')
|
||||
|
||||
|
||||
call h5tbmake_table_f(dsetname1,&
|
||||
file_id,&
|
||||
dsetname1,&
|
||||
nfields,&
|
||||
nrecords,&
|
||||
type_size,&
|
||||
field_names,&
|
||||
field_offset,&
|
||||
field_types,&
|
||||
chunk_size,&
|
||||
compress,&
|
||||
errcode )
|
||||
|
||||
call passed()
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! write field
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Read/Write field by name ')
|
||||
|
||||
call h5tbwrite_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,&
|
||||
bufs,errcode)
|
||||
|
||||
call h5tbwrite_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,&
|
||||
bufi,errcode)
|
||||
|
||||
call h5tbwrite_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,&
|
||||
bufd,errcode)
|
||||
|
||||
call h5tbwrite_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,&
|
||||
bufr,errcode)
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! read field
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call h5tbread_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,&
|
||||
bufsr,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, nrecords
|
||||
if ( bufsr(i) .ne. bufs(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufsr(i), ' and ', bufs(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call h5tbread_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,&
|
||||
bufir,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, nrecords
|
||||
if ( bufir(i) .ne. bufi(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufir(i), ' and ', bufi(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call h5tbread_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,&
|
||||
bufdr,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, nrecords
|
||||
if ( bufdr(i) .ne. bufd(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufdr(i), ' and ', bufd(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call h5tbread_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,&
|
||||
bufrr,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, nrecords
|
||||
if ( bufrr(i) .ne. bufr(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufrr(i), ' and ', bufr(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
|
||||
call passed()
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! write field
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Read/Write field by index ')
|
||||
|
||||
call h5tbwrite_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,&
|
||||
bufs,errcode)
|
||||
|
||||
call h5tbwrite_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,&
|
||||
bufi,errcode)
|
||||
|
||||
call h5tbwrite_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,&
|
||||
bufd,errcode)
|
||||
|
||||
call h5tbwrite_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,&
|
||||
bufr,errcode)
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! read field
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call h5tbread_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,&
|
||||
bufsr,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, nrecords
|
||||
if ( bufsr(i) .ne. bufs(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufsr(i), ' and ', bufs(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call h5tbread_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,&
|
||||
bufir,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, nrecords
|
||||
if ( bufir(i) .ne. bufi(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufir(i), ' and ', bufi(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call h5tbread_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,&
|
||||
bufdr,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, nrecords
|
||||
if ( bufdr(i) .ne. bufd(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufdr(i), ' and ', bufd(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call h5tbread_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,&
|
||||
bufrr,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, nrecords
|
||||
if ( bufrr(i) .ne. bufr(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufrr(i), ' and ', bufr(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
|
||||
call passed()
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Insert field
|
||||
! we insert a field callsed "field5" with the same type and buffer as field 4 (Real)
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Insert field ')
|
||||
|
||||
call h5tbinsert_field_f(file_id,dsetname1,"field5",field_types(4),4,bufr,errcode)
|
||||
|
||||
call h5tbread_field_index_f(file_id,dsetname1,5,start,nrecords,type_sizer,&
|
||||
bufrr,errcode)
|
||||
|
||||
!
|
||||
! compare read and write buffers.
|
||||
!
|
||||
do i = 1, nrecords
|
||||
if ( bufrr(i) .ne. bufr(i) ) then
|
||||
print *, 'read buffer differs from write buffer'
|
||||
print *, bufrr(i), ' and ', bufr(i)
|
||||
stop
|
||||
endif
|
||||
end do
|
||||
|
||||
call passed()
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Delete field
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Delete field ')
|
||||
|
||||
call h5tbdelete_field_f(file_id,dsetname1,"field4",errcode)
|
||||
|
||||
call passed()
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Gets the number of records and fields
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
call test_begin(' Get table info ')
|
||||
|
||||
call h5tbget_table_info_f(file_id,dsetname1,nfieldsr,nrecordsr,errcode )
|
||||
|
||||
if ( nfieldsr .ne. nfields .and. nrecordsr .ne. nrecords ) then
|
||||
print *, 'h5tbget_table_info_f return error'
|
||||
stop
|
||||
endif
|
||||
|
||||
call passed()
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! Get information about fields
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!call test_begin(' Get fields info ')
|
||||
|
||||
!call h5tbget_field_info_f(file_id,dsetname1,nfields,field_namesr,field_sizesr,&
|
||||
! field_offsetr,type_sizeout,errcode )
|
||||
|
||||
|
||||
!call passed()
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! end
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
!
|
||||
! Close the file.
|
||||
!
|
||||
call h5fclose_f(file_id, errcode)
|
||||
|
||||
!
|
||||
! Close FORTRAN predefined datatypes.
|
||||
!
|
||||
call h5close_f(errcode)
|
||||
|
||||
|
||||
!
|
||||
! end function.
|
||||
!
|
||||
end subroutine test_table1
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! test_begin
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine test_begin(string)
|
||||
character(LEN=*), intent(IN) :: string
|
||||
write(*, fmt = '(14a)', advance = 'no') string
|
||||
write(*, fmt = '(40x,a)', advance = 'no') ' '
|
||||
end subroutine test_begin
|
||||
|
||||
!-------------------------------------------------------------------------
|
||||
! passed
|
||||
!-------------------------------------------------------------------------
|
||||
|
||||
subroutine passed()
|
||||
write(*, fmt = '(6a)') 'PASSED'
|
||||
end subroutine passed
|
||||
|
||||
|
||||
@ -10,7 +10,7 @@ srcdir=@srcdir@
|
||||
@COMMENCE@
|
||||
|
||||
## Add `-I.' to the C preprocessor flags.
|
||||
CPPFLAGS=-I. -I$(srcdir) -I$(top_builddir)/src -I$(top_srcdir)/src -I$(top_srcdir)/tools/lib @CPPFLAGS@
|
||||
CPPFLAGS=-I. -I$(srcdir) -I$(top_builddir)/src -I$(top_srcdir)/src -I$(top_srcdir)/hl/src @CPPFLAGS@
|
||||
|
||||
## This is our main target, but also remove the settings file when cleaning.
|
||||
LIB=libhdf5_hl.la
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user