diff options
Diffstat (limited to 'hl/fortran/src')
-rw-r--r-- | hl/fortran/src/H5DSff.F90 | 68 | ||||
-rw-r--r-- | hl/fortran/src/H5HL_buildiface.F90 | 50 | ||||
-rw-r--r-- | hl/fortran/src/H5IMff.F90 | 102 | ||||
-rw-r--r-- | hl/fortran/src/H5LTff.F90 | 90 | ||||
-rw-r--r-- | hl/fortran/src/H5TBff.F90 | 128 |
5 files changed, 219 insertions, 219 deletions
diff --git a/hl/fortran/src/H5DSff.F90 b/hl/fortran/src/H5DSff.F90 index 5488bb2..6dcb450 100644 --- a/hl/fortran/src/H5DSff.F90 +++ b/hl/fortran/src/H5DSff.F90 @@ -26,7 +26,7 @@ CONTAINS !------------------------------------------------------------------------- ! Function: H5DSset_scale_f ! -! Purpose: Convert dataset dsid to a dimension scale, with optional name, dimname. +! Purpose: Convert dataset dsid to a dimension scale, with optional name, dimname. ! ! Return: Success: 0, Failure: -1 ! @@ -93,28 +93,28 @@ CONTAINS IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: did ! the dataset - INTEGER(hid_t), INTENT(in) :: dsid ! the scale to be attached + INTEGER(hid_t), INTENT(in) :: dsid ! the scale to be attached INTEGER , INTENT(in) :: idx ! the dimension of did that dsid is associated with. INTEGER :: errcode ! error code INTEGER :: c_idx - + INTERFACE INTEGER FUNCTION H5DSattach_scale_c(did, dsid, idx) & - BIND(C,NAME='h5dsattach_scale_c') + BIND(C,NAME='h5dsattach_scale_c') IMPORT :: HID_T IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: did ! the dataset - INTEGER(hid_t), INTENT(in) :: dsid ! the scale to be attached + INTEGER(hid_t), INTENT(in) :: dsid ! the scale to be attached INTEGER , INTENT(in) :: idx ! the dimension of did that dsid is associated with. END FUNCTION H5DSattach_scale_c END INTERFACE - c_idx = idx -1 ! account for C-dimensions starting at 0 - + c_idx = idx -1 ! account for C-dimensions starting at 0 + errcode = H5DSattach_scale_c( did, dsid, c_idx) - + END SUBROUTINE H5DSattach_scale_f - + !------------------------------------------------------------------------- ! Function: H5DSdetach_scale_f ! @@ -133,37 +133,37 @@ CONTAINS !------------------------------------------------------------------------- SUBROUTINE H5DSdetach_scale_f( did, dsid, idx, errcode) - + IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: did ! the dataset - INTEGER(hid_t), INTENT(in) :: dsid ! the scale to be detached + INTEGER(hid_t), INTENT(in) :: dsid ! the scale to be detached INTEGER , INTENT(in) :: idx ! the dimension of did to detach INTEGER :: errcode ! error code INTEGER :: c_idx - + INTERFACE INTEGER FUNCTION H5DSdetach_scale_c(did, dsid, idx) & BIND(C,NAME='h5dsdetach_scale_c') IMPORT :: HID_T IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: did ! the dataset - INTEGER(hid_t), INTENT(in) :: dsid ! the scale to be detached + INTEGER(hid_t), INTENT(in) :: dsid ! the scale to be detached INTEGER , INTENT(in) :: idx ! the dimension of did to detach END FUNCTION H5DSdetach_scale_c END INTERFACE - c_idx = idx - 1 ! account for C-dimensions starting at 0 + c_idx = idx - 1 ! account for C-dimensions starting at 0 errcode = H5DSdetach_scale_c( did, dsid, c_idx) - + END SUBROUTINE H5DSdetach_scale_f !------------------------------------------------------------------------- ! Function: H5DSis_attached_f ! -! Purpose: Report if dimension scale dsid is currently attached to dimension idx of dataset did. +! Purpose: Report if dimension scale dsid is currently attached to dimension idx of dataset did. ! ! Return: Success: 0, Failure: -1 ! @@ -178,32 +178,32 @@ CONTAINS !------------------------------------------------------------------------- SUBROUTINE H5DSis_attached_f( did, dsid, idx, is_attached, errcode) - + IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: did ! the dataset INTEGER(hid_t), INTENT(in) :: dsid ! the scale to be attached INTEGER , INTENT(in) :: idx ! the dimension of did that dsid is associated with - LOGICAL , INTENT(out) :: is_attached ! logical: dimension scale dsid is currently attached to + LOGICAL , INTENT(out) :: is_attached ! logical: dimension scale dsid is currently attached to ! dimension idx of dataset did INTEGER :: errcode ! error code INTEGER :: c_is_attached INTEGER :: c_idx - + INTERFACE INTEGER FUNCTION H5DSis_attached_c(did, dsid, idx, c_is_attached) & BIND(C,NAME='h5dsis_attached_c') IMPORT :: HID_T IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: did ! the dataset - INTEGER(hid_t), INTENT(in) :: dsid ! the scale to be detached + INTEGER(hid_t), INTENT(in) :: dsid ! the scale to be detached INTEGER , INTENT(in) :: idx ! the dimension of did to detach - INTEGER , INTENT(out) :: c_is_attached ! dimension scale dsid is currently attached to + INTEGER , INTENT(out) :: c_is_attached ! dimension scale dsid is currently attached to END FUNCTION H5DSis_attached_c END INTERFACE - c_idx = idx - 1 ! account for C-dimensions starting at 0 - + c_idx = idx - 1 ! account for C-dimensions starting at 0 + errcode = H5DSis_attached_c(did, dsid, c_idx, c_is_attached) is_attached = .FALSE. ! default @@ -212,7 +212,7 @@ CONTAINS ELSE IF(errcode.LT.0)THEN errcode = -1 ENDIF - + END SUBROUTINE H5DSis_attached_f ! @@ -222,7 +222,7 @@ CONTAINS !------------------------------------------------------------------------- ! Function: H5DSis_scale_f ! -! Purpose: Determines whether dset is a Dimension Scale. +! Purpose: Determines whether dset is a Dimension Scale. ! ! Return: Success: 0, Failure: -1 ! @@ -237,15 +237,15 @@ CONTAINS !------------------------------------------------------------------------- SUBROUTINE H5DSis_scale_f( did, is_scale, errcode) - + IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: did ! the data set to query - LOGICAL , INTENT(out) :: is_scale ! logical: + LOGICAL , INTENT(out) :: is_scale ! logical: ! .TRUE. if did is a Dimension Scale INTEGER :: errcode ! error code INTEGER :: c_is_scale - + INTERFACE INTEGER FUNCTION H5DSis_scale_c(did,c_is_scale) & BIND(C,NAME='h5dsis_scale_c') @@ -255,7 +255,7 @@ CONTAINS INTEGER, INTENT(out) :: c_is_scale END FUNCTION H5DSis_scale_c END INTERFACE - + errcode = H5DSis_scale_c(did, c_is_scale) is_scale = .FALSE. ! default @@ -264,7 +264,7 @@ CONTAINS ELSE IF(errcode.LT.0)THEN errcode = -1 ENDIF - + END SUBROUTINE H5DSis_scale_f !------------------------------------------------------------------------- @@ -319,7 +319,7 @@ CONTAINS !------------------------------------------------------------------------- ! Function: H5DSget_label_f ! -! Purpose: Read the label for dimension idx of did into buffer label. +! Purpose: Read the label for dimension idx of did into buffer label. ! ! Return: Success: 0, Failure: -1 ! @@ -431,7 +431,7 @@ CONTAINS INTEGER , INTENT(INOUT) :: num_scales ! the number of Dimension Scales associated with did INTEGER :: errcode ! error code INTEGER :: c_idx - + INTERFACE INTEGER FUNCTION H5DSget_num_scales_c(did, idx, num_scales) & BIND(C,NAME='h5dsget_num_scales_c') @@ -442,10 +442,10 @@ CONTAINS INTEGER , INTENT(INOUT) :: num_scales ! the number of Dimension Scales associated with did END FUNCTION H5DSget_num_scales_c END INTERFACE - + c_idx = idx - 1 errcode = H5DSget_num_scales_c(did, c_idx, num_scales) - + END SUBROUTINE H5DSget_num_scales_f END MODULE h5ds diff --git a/hl/fortran/src/H5HL_buildiface.F90 b/hl/fortran/src/H5HL_buildiface.F90 index 1c5d9c8..7aac9a2 100644 --- a/hl/fortran/src/H5HL_buildiface.F90 +++ b/hl/fortran/src/H5HL_buildiface.F90 @@ -13,8 +13,8 @@ ! depending on which of the KIND values are found. ! ! NOTES -! This program uses the Fortran 2008 intrinsic function STORAGE_SIZE or SIZEOF -! depending on availablity.It generates code that makes use of +! This program uses the Fortran 2008 intrinsic function STORAGE_SIZE or SIZEOF +! depending on availablity.It generates code that makes use of ! STORAGE_SIZE/SIZEOF in H5fortran_detect.f90. STORAGE_SIZE is standard ! compliant and should always be chosen over SIZEOF. ! @@ -88,7 +88,7 @@ PROGRAM H5HL_buildiface ! ! Developer's notes: ! -! Only interfaces with arrays of rank 7 and less are provided. Even-though the F2008 +! Only interfaces with arrays of rank 7 and less are provided. Even-though the F2008 ! standard extended the maximum rank to 15, it was decided that they should use the ! new APIs to handle those use cases. Handling rank 7 and less is for backward compatibility ! with the Fortran 90/95 APIs codes which could never handle rank 8-15 array sizes. @@ -266,7 +266,7 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' INTEGER :: errcode ' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') ' errcode = h5ltmake_dataset_c(loc_id,namelen,dset_name,rank,dims,type_id,f_ptr)' @@ -297,7 +297,7 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' INTEGER :: errcode ' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') ' errcode = h5ltread_dataset_c(loc_id,namelen,dset_name,type_id,f_ptr)' @@ -327,8 +327,8 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER :: errcode ' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' - + WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') ' errcode = h5ltmake_dataset_c(loc_id,namelen,dset_name,rank,dims,H5T_NATIVE_REAL,f_ptr)' @@ -357,8 +357,8 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(INOUT)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER :: errcode ' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' - + WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') ' errcode = h5ltread_dataset_c(loc_id,namelen,dset_name,H5T_NATIVE_REAL,f_ptr)' @@ -387,8 +387,8 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER :: errcode ' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' - + WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') ' errcode = h5ltmake_dataset_c(loc_id,namelen,dset_name,rank,dims,H5T_NATIVE_DOUBLE,f_ptr)' @@ -417,8 +417,8 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(INOUT)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER :: errcode ' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' - + WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') ' errcode = h5ltread_dataset_c(loc_id,namelen,dset_name,H5T_NATIVE_DOUBLE,f_ptr)' @@ -450,7 +450,7 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' INTEGER :: errcode ' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') ' errcode = h5ltmake_dataset_c(loc_id, namelen, dset_name, rank, dims, type_id, f_ptr)' @@ -482,7 +482,7 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' WRITE(11,'(A)') ' INTEGER(hid_t) :: type_id' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') ' type_id = h5kind_to_type(KIND('//f_ptr_line(j)(19:36)//'), H5_INTEGER_KIND)' @@ -680,10 +680,10 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' INTEGER(size_t), INTENT(in) :: type_size' WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN), DIMENSION(*), TARGET :: buf' WRITE(11,'(A)') ' INTEGER :: errcode ' - WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' - WRITE(11,'(A)') ' INTEGER(size_t) :: namelen1' + WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' + WRITE(11,'(A)') ' INTEGER(size_t) :: namelen1' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') ' namelen1 = LEN(field_name)' @@ -714,10 +714,10 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' INTEGER(size_t), INTENT(in) :: type_size' WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(INOUT), DIMENSION(*), TARGET :: buf' WRITE(11,'(A)') ' INTEGER :: errcode ' - WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' - WRITE(11,'(A)') ' INTEGER(size_t) :: namelen1' + WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' + WRITE(11,'(A)') ' INTEGER(size_t) :: namelen1' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') ' namelen1 = LEN(field_name)' @@ -748,9 +748,9 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' INTEGER(size_t), INTENT(in) :: type_size' WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN), DIMENSION(*), TARGET :: buf' WRITE(11,'(A)') ' INTEGER :: errcode ' - WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' + WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') & @@ -782,7 +782,7 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' INTEGER :: errcode ' WRITE(11,'(A)') ' INTEGER(size_t) :: namelen' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') & @@ -814,7 +814,7 @@ PROGRAM H5HL_buildiface WRITE(11,'(A)') ' INTEGER(size_t) :: namelen1' WRITE(11,'(A)') ' INTEGER :: errcode' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' namelen = LEN(dset_name)' WRITE(11,'(A)') ' namelen1 = LEN(field_name)' diff --git a/hl/fortran/src/H5IMff.F90 b/hl/fortran/src/H5IMff.F90 index ac4b794..ffa18aa 100644 --- a/hl/fortran/src/H5IMff.F90 +++ b/hl/fortran/src/H5IMff.F90 @@ -22,7 +22,7 @@ ! **** | | | |\/| | ___/| | | | _ / | | / /\ \ | . ` | | | **** ! **** _| |_| | | | | | |__| | | \ \ | |/ ____ \| |\ | | | **** ! |_____|_| |_|_| \____/|_| \_\ |_/_/ \_\_| \_| |_| -! +! ! If you add a new function here then you MUST add the function name to the ! Windows dll file 'hdf5_hl_fortrandll.def.in' in the hl/fortran/src directory. ! This is needed for Windows based operating systems. @@ -82,10 +82,10 @@ CONTAINS INTEGER , INTENT(in), DIMENSION(*) :: buf ! 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 !------------------------------------------------------------------------- @@ -110,7 +110,7 @@ CONTAINS 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(inout), DIMENSION(*) :: buf ! buffer @@ -129,10 +129,10 @@ CONTAINS INTEGER, INTENT(inout), DIMENSION(*) :: buf ! 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 !------------------------------------------------------------------------- @@ -159,7 +159,7 @@ CONTAINS il,& buf,& errcode ) - + IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier @@ -171,7 +171,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER(size_t) :: ILEN ! name length - + INTERFACE INTEGER FUNCTION h5immake_image_24bit_c(loc_id,namelen,dset_name,ILEN,il,width,height,buf) & BIND(C,NAME='h5immake_image_24bit_c') @@ -186,14 +186,14 @@ CONTAINS INTEGER, INTENT(in), DIMENSION(*) :: buf ! buffer INTEGER(size_t) :: namelen ! length of name buffer INTEGER(size_t) :: 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 !------------------------------------------------------------------------- @@ -222,7 +222,7 @@ CONTAINS interlace,& npals,& errcode ) - + IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier @@ -235,7 +235,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER(size_t) :: ILEN ! name length - + INTERFACE INTEGER FUNCTION h5imget_image_info_c(loc_id,namelen,dset_name,width,height,planes,npals,ILEN,interlace) & BIND(C,NAME='h5imget_image_info_c') @@ -253,11 +253,11 @@ CONTAINS INTEGER(size_t) :: 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 !------------------------------------------------------------------------- @@ -286,7 +286,7 @@ CONTAINS CHARACTER(len=*), INTENT(in) :: dset_name ! name of the dataset INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length - + INTERFACE INTEGER FUNCTION h5imis_image_c(loc_id,namelen,dset_name) & BIND(C,NAME='h5imis_image_c') @@ -298,13 +298,13 @@ CONTAINS CHARACTER(KIND=C_CHAR), DIMENSION(*), 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 @@ -328,16 +328,16 @@ CONTAINS 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, INTENT(in), DIMENSION(*) :: buf ! buffer INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length - + INTERFACE INTEGER FUNCTION h5immake_palette_c(loc_id,namelen,dset_name,pal_dims,buf) & BIND(C,NAME='h5immake_palette_c') @@ -351,12 +351,12 @@ CONTAINS INTEGER, INTENT(in), DIMENSION(*) :: buf ! 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 ! @@ -378,16 +378,16 @@ CONTAINS 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(size_t) :: namelen ! name length INTEGER(size_t) :: ILEN ! name length - + INTERFACE INTEGER FUNCTION h5imlink_palette_c(loc_id,namelen,dset_name,ILEN,pal_name) & BIND(C,NAME='h5imlink_palette_c') @@ -401,13 +401,13 @@ CONTAINS INTEGER(size_t) :: 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 @@ -430,7 +430,7 @@ CONTAINS dset_name,& pal_name,& errcode ) - + IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier @@ -439,7 +439,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER(size_t) :: ILEN ! name length - + INTERFACE INTEGER FUNCTION h5imunlink_palette_c(loc_id,namelen,dset_name,ILEN,pal_name) & BIND(C,NAME='h5imunlink_palette_c') @@ -453,13 +453,13 @@ CONTAINS INTEGER(size_t) :: 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 ! @@ -481,7 +481,7 @@ CONTAINS dset_name,& npals,& errcode ) - + IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier @@ -489,7 +489,7 @@ CONTAINS INTEGER(hsize_t), INTENT(inout) :: npals ! palettes INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length - + INTERFACE INTEGER FUNCTION h5imget_npalettes_c(loc_id,namelen,dset_name,npals) & BIND(C,NAME='h5imget_npalettes_c') @@ -502,10 +502,10 @@ CONTAINS INTEGER(size_t) :: 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 @@ -531,7 +531,7 @@ CONTAINS pal_number,& dims,& errcode ) - + IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier @@ -540,7 +540,7 @@ CONTAINS INTEGER(hsize_t), DIMENSION(*), INTENT(inout) :: dims ! dimensions INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length - + INTERFACE INTEGER FUNCTION h5imget_palette_info_c(loc_id,namelen,dset_name,pal_number,dims) & BIND(C,NAME='h5imget_palette_info_c') @@ -554,10 +554,10 @@ CONTAINS INTEGER(size_t) :: 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 !------------------------------------------------------------------------- @@ -582,7 +582,7 @@ CONTAINS pal_number,& buf,& errcode ) - + IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier @@ -591,7 +591,7 @@ CONTAINS INTEGER, INTENT(inout), DIMENSION(*) :: buf ! buffer INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length - + INTERFACE INTEGER FUNCTION h5imget_palette_c(loc_id,namelen,dset_name,pal_number,buf) & BIND(C,NAME='h5imget_palette_c') @@ -605,10 +605,10 @@ CONTAINS INTEGER, INTENT(inout), DIMENSION(*) :: buf ! 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 @@ -638,7 +638,7 @@ CONTAINS CHARACTER(len=*), INTENT(in) :: dset_name ! name of the dataset INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length - + INTERFACE INTEGER FUNCTION h5imis_palette_c(loc_id,namelen,dset_name) & BIND(C,NAME='h5imis_palette_c') @@ -650,11 +650,11 @@ CONTAINS CHARACTER(KIND=C_CHAR), DIMENSION(*), 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 MODULE H5IM diff --git a/hl/fortran/src/H5LTff.F90 b/hl/fortran/src/H5LTff.F90 index 80f6ac5..bc8734f 100644 --- a/hl/fortran/src/H5LTff.F90 +++ b/hl/fortran/src/H5LTff.F90 @@ -22,7 +22,7 @@ ! **** | | | |\/| | ___/| | | | _ / | | / /\ \ | . ` | | | **** ! **** _| |_| | | | | | |__| | | \ \ | |/ ____ \| |\ | | | **** ! |_____|_| |_|_| \____/|_| \_\ |_/_/ \_\_| \_| |_| -! +! ! If you add a new function here then you MUST add the function name to the ! Windows dll file 'hdf5_hl_fortrandll.def.in' in the hl/fortran/src directory. ! This is needed for Windows based operating systems. @@ -130,7 +130,7 @@ CONTAINS ! ! Comments: ! - ! Modifications: + ! Modifications: ! !------------------------------------------------------------------------- @@ -321,7 +321,7 @@ CONTAINS SUBROUTINE h5ltmake_dataset_f_int7(loc_id, dset_name, rank, dims, & type_id, 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 @@ -371,7 +371,7 @@ CONTAINS INTEGER(hid_t), INTENT(in) :: type_id ! datatype identifier TYPE(C_PTR) :: buf ! data buffer INTEGER :: errcode ! error code - INTEGER(size_t) :: namelen + INTEGER(size_t) :: namelen namelen = LEN(dset_name) errcode = h5ltread_dataset_c(loc_id,namelen,dset_name,type_id, buf) @@ -409,7 +409,7 @@ CONTAINS INTEGER(hsize_t), DIMENSION(*), INTENT(in) :: dims ! size of the buffer buf INTEGER, INTENT(inout), DIMENSION(*), TARGET :: buf ! data buffer INTEGER :: errcode ! error code - INTEGER(size_t) :: namelen + INTEGER(size_t) :: namelen TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1)) @@ -451,7 +451,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2)), TARGET :: buf + DIMENSION(dims(1),dims(2)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1)) @@ -476,7 +476,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2),dims(3)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1)) @@ -497,7 +497,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2),dims(3),dims(4)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1)) @@ -518,7 +518,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1,1)) @@ -556,7 +556,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1,1,1)) @@ -577,7 +577,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1,1,1,1)) @@ -621,7 +621,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length TYPE(C_PTR) :: f_ptr - + f_ptr = C_LOC(buf(1)) namelen = LEN(dset_name) @@ -644,7 +644,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(in), & - DIMENSION(dims(1),dims(2)), TARGET :: buf + DIMENSION(dims(1),dims(2)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1)) @@ -669,7 +669,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(in), & - DIMENSION(dims(1),dims(2),dims(3)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1)) @@ -690,7 +690,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(in), & - DIMENSION(dims(1),dims(2),dims(3),dims(4)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1)) @@ -711,7 +711,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(in), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1,1)) @@ -732,7 +732,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(in), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1,1,1)) @@ -753,7 +753,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(in), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1,1,1,1)) @@ -793,7 +793,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1)), TARGET :: buf + DIMENSION(dims(1)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1)) @@ -816,7 +816,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2)), TARGET :: buf + DIMENSION(dims(1),dims(2)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1)) @@ -839,7 +839,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2),dims(3)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1)) @@ -858,7 +858,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2),dims(3),dims(4)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1)) @@ -877,7 +877,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1,1)) @@ -896,7 +896,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1,1,1)) @@ -915,7 +915,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER, INTENT(inout), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)), TARGET :: buf + DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)), TARGET :: buf TYPE(C_PTR) :: f_ptr f_ptr = C_LOC(buf(1,1,1,1,1,1,1)) @@ -1059,14 +1059,14 @@ CONTAINS TYPE(C_PTR) :: buf ! data buffer CHARACTER(LEN=*), INTENT(in) :: buf_type ! valid data types are: ! CHARACTER, INTEGER or REAL - ! NOTE: only the first character matters and is case insensitive + ! NOTE: only the first character matters and is case insensitive INTEGER(size_t), INTENT(in) :: size ! size of attribute array - INTEGER(size_t), INTENT(in) :: SizeOf_buf_type ! size of buf's data type + INTEGER(size_t), INTENT(in) :: SizeOf_buf_type ! size of buf's data type INTEGER, INTENT(out) :: errcode ! error code INTEGER(size_t) :: namelen ! name length - INTEGER(size_t) :: attrlen ! name length - CHARACTER(KIND=C_CHAR) :: buf_type_uppercase + INTEGER(size_t) :: attrlen ! name length + CHARACTER(KIND=C_CHAR) :: buf_type_uppercase namelen = LEN(dset_name) attrlen = LEN(attr_name) @@ -1117,7 +1117,7 @@ CONTAINS INTEGER :: errcode ! error code INTEGER, DIMENSION(*), TARGET :: buf ! data buffer INTEGER(size_t) :: namelen ! name length - INTEGER(size_t) :: attrlen ! name length + INTEGER(size_t) :: attrlen ! name length TYPE(C_PTR) :: f_ptr INTEGER(size_t) :: SizeOf_buf_type @@ -1168,7 +1168,7 @@ CONTAINS INTEGER :: errcode ! error code REAL(KIND=C_FLOAT), INTENT(in), DIMENSION(*), TARGET :: buf ! data buffer INTEGER(size_t) :: namelen ! name length - INTEGER(size_t) :: attrlen ! name length + INTEGER(size_t) :: attrlen ! name length TYPE(C_PTR) :: f_ptr INTEGER(size_t) :: SizeOf_buf_type @@ -1222,7 +1222,7 @@ CONTAINS TYPE(C_PTR) :: f_ptr INTEGER(size_t) :: SizeOf_buf_type - f_ptr = C_LOC(buf(1)) + f_ptr = C_LOC(buf(1)) #if H5_FORTRAN_HAVE_STORAGE_SIZE!=0 SizeOf_buf_type = STORAGE_SIZE(buf(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) @@ -1269,7 +1269,7 @@ CONTAINS CHARACTER(LEN=*), DIMENSION(*), INTENT(in), TARGET :: buf ! data buffer INTEGER(size_t) :: namelen ! name length INTEGER(size_t) :: attrlen ! name length - INTEGER(size_t) :: buflen ! data buffer length + INTEGER(size_t) :: buflen ! data buffer length TYPE(C_PTR) :: f_ptr INTEGER(size_t) :: SizeOf_buf_type @@ -1321,7 +1321,7 @@ CONTAINS ! CHARACTER, INTEGER or REAL ! NOTE: only the first character matters and is case insensitive INTEGER(size_t), INTENT(in) :: SizeOf_buf_type ! size of buf's data type - INTEGER, INTENT(out) :: errcode ! error code + INTEGER, INTENT(out) :: errcode ! error code INTEGER(size_t) :: namelen ! name length INTEGER(size_t) :: attrlen ! attr length CHARACTER(KIND=C_CHAR) :: buf_type_uppercase @@ -1373,11 +1373,11 @@ CONTAINS INTEGER :: errcode ! error code INTEGER, INTENT(inout), DIMENSION(*), TARGET :: buf! data buffer INTEGER(size_t) :: namelen ! name length - INTEGER(size_t) :: attrlen ! name length + INTEGER(size_t) :: attrlen ! name length TYPE(C_PTR) :: f_ptr INTEGER(size_t) :: SizeOf_buf - f_ptr = C_LOC(buf(1)) + f_ptr = C_LOC(buf(1)) #if H5_FORTRAN_HAVE_STORAGE_SIZE!=0 SizeOf_buf = STORAGE_SIZE(buf(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) @@ -1420,7 +1420,7 @@ CONTAINS INTEGER :: errcode ! error code REAL(KIND=C_FLOAT), INTENT(inout), DIMENSION(*), TARGET :: buf INTEGER(size_t) :: namelen ! name length - INTEGER(size_t) :: attrlen ! name length + INTEGER(size_t) :: attrlen ! name length TYPE(C_PTR) :: f_ptr INTEGER(size_t) :: SizeOf_buf @@ -1470,7 +1470,7 @@ CONTAINS TYPE(C_PTR) :: f_ptr INTEGER(size_t) :: SizeOf_buf - f_ptr = C_LOC(buf(1)) + f_ptr = C_LOC(buf(1)) #if H5_FORTRAN_HAVE_STORAGE_SIZE!=0 SizeOf_buf = STORAGE_SIZE(buf(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) #else @@ -1514,7 +1514,7 @@ CONTAINS CHARACTER(LEN=*), INTENT(inout) :: buf INTEGER(size_t) :: namelen ! name length INTEGER(size_t) :: attrlen ! name length - INTEGER(size_t) :: buf_size ! buf size + INTEGER(size_t) :: buf_size ! buf size INTERFACE INTEGER FUNCTION h5ltget_attribute_string_c(loc_id,namelen,dset_name,attrlen,attr_name,buf,buf_size) & @@ -1812,7 +1812,7 @@ CONTAINS !------------------------------------------------------------------------- ! Function: h5ltpath_valid_f ! - ! Purpose: Validates a path + ! Purpose: Validates a path ! ! Return: Success: 0, Failure: -1 ! @@ -1831,8 +1831,8 @@ CONTAINS IMPLICIT NONE INTEGER(hid_t) , INTENT(IN) :: loc_id ! An identifier of an object in the file. CHARACTER(LEN=*), INTENT(IN) :: path ! Path to the object to check, relative to loc_id. - LOGICAL , INTENT(IN) :: check_object_valid ! Indicates whether to check if the final component - ! of the path resolves to a valid object + LOGICAL , INTENT(IN) :: check_object_valid ! Indicates whether to check if the final component + ! of the path resolves to a valid object LOGICAL , INTENT(OUT) :: path_valid ! Object status INTEGER , INTENT(OUT) :: errcode ! Error code: 0 on success and -1 on failure @@ -1846,7 +1846,7 @@ CONTAINS IMPORT :: C_CHAR IMPORT :: HID_T, SIZE_T, HSIZE_T IMPLICIT NONE - INTEGER(hid_t), INTENT(in) :: loc_id + INTEGER(hid_t), INTENT(in) :: loc_id CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(in) :: path INTEGER(size_t) :: pathlen INTEGER :: check_object_valid_c @@ -1856,7 +1856,7 @@ CONTAINS ! Initialize path_valid = .FALSE. errcode = 0 - + check_object_valid_c = 0 IF(check_object_valid) check_object_valid_c = 1 @@ -1868,7 +1868,7 @@ CONTAINS ELSE IF(status.LT.0)THEN errcode = -1 ENDIF - + END SUBROUTINE h5ltpath_valid_f END MODULE H5LT_CONST diff --git a/hl/fortran/src/H5TBff.F90 b/hl/fortran/src/H5TBff.F90 index 40adf95..c3db01e 100644 --- a/hl/fortran/src/H5TBff.F90 +++ b/hl/fortran/src/H5TBff.F90 @@ -23,7 +23,7 @@ ! **** | | | |\/| | ___/| | | | _ / | | / /\ \ | . ` | | | **** ! **** _| |_| | | | | | |__| | | \ \ | |/ ____ \| |\ | | | **** ! |_____|_| |_|_| \____/|_| \_\ |_/_/ \_\_| \_| |_| -! +! ! If you add a new function here then you MUST add the function name to the ! Windows dll file 'hdf5_hl_fortrandll.def.in' in the hl/fortran/src directory. ! This is needed for Windows based operating systems. @@ -31,7 +31,7 @@ #include "H5config_f.inc" MODULE h5tb_CONST - + USE, INTRINSIC :: ISO_C_BINDING USE h5fortran_types USE hdf5 @@ -40,22 +40,22 @@ MODULE h5tb_CONST MODULE PROCEDURE h5tbwrite_field_name_f_int MODULE PROCEDURE h5tbwrite_field_name_f_string END INTERFACE - + INTERFACE h5tbread_field_name_f MODULE PROCEDURE h5tbread_field_name_f_int MODULE PROCEDURE h5tbread_field_name_f_string END INTERFACE - + INTERFACE h5tbwrite_field_index_f MODULE PROCEDURE h5tbwrite_field_index_f_int MODULE PROCEDURE h5tbwrite_field_index_f_string END INTERFACE - + INTERFACE h5tbread_field_index_f MODULE PROCEDURE h5tbread_field_index_f_int MODULE PROCEDURE h5tbread_field_index_f_string END INTERFACE - + INTERFACE h5tbinsert_field_f MODULE PROCEDURE h5tbinsert_field_f_int MODULE PROCEDURE h5tbinsert_field_f_string @@ -162,7 +162,7 @@ MODULE h5tb_CONST INTEGER(size_t) :: namelen1 ! name length length END FUNCTION h5tbinsert_field_c END INTERFACE - + CONTAINS !------------------------------------------------------------------------- @@ -251,16 +251,16 @@ CONTAINS INTEGER(size_t) :: max_char_size_field_names ! character len of field names END FUNCTION h5tbmake_table_c END INTERFACE - + namelen = LEN(dset_name) namelen1 = LEN(table_title) - + ! Find the size of each character string in the array DO i = 1, nfields char_len_field_names(i) = LEN_TRIM(field_names(i)) END DO - - max_char_size_field_names = LEN(field_names(1)) + + max_char_size_field_names = LEN(field_names(1)) errcode = h5tbmake_table_c(namelen1, table_title, loc_id, namelen, dset_name, nfields, nrecords,& type_size, field_offset, field_types, chunk_size, compress, char_len_field_names, & @@ -346,16 +346,16 @@ CONTAINS TYPE(C_PTR), INTENT(in), VALUE :: data END FUNCTION h5tbmake_table_ptr_c END INTERFACE - + namelen = LEN(dset_name) namelen1 = LEN(table_title) - + ! Find the size of each character string in the array DO i = 1, nfields char_len_field_names(i) = LEN_TRIM(field_names(i)) END DO - - max_char_size_field_names = LEN(field_names(1)) + + max_char_size_field_names = LEN(field_names(1)) errcode = h5tbmake_table_ptr_c(namelen1, table_title, loc_id, namelen, dset_name, nfields, nrecords,& type_size, field_offset, field_types, chunk_size, fill_data, compress, char_len_field_names, & @@ -395,7 +395,7 @@ CONTAINS IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier CHARACTER(LEN=1), INTENT(in) :: table_name ! name of the dataset - INTEGER(hsize_t), INTENT(in) :: nfields + INTEGER(hsize_t), INTENT(in) :: nfields INTEGER(size_t), INTENT(in) :: dst_size ! type size INTEGER(size_t), DIMENSION(1:nfields), INTENT(in) :: dst_offset ! An array containing the sizes of the fields INTEGER(size_t), DIMENSION(1:nfields), INTENT(in) :: dst_sizes ! An array containing the sizes of the fields @@ -404,7 +404,7 @@ CONTAINS END FUNCTION h5tbread_table_c END INTERFACE - + namelen = LEN(table_name) errcode = h5tbread_table_c(loc_id,& @@ -442,7 +442,7 @@ CONTAINS type_size,& 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 @@ -455,14 +455,14 @@ CONTAINS INTEGER(size_t) :: namelen ! name length INTEGER(size_t) :: namelen1 ! name length TYPE(C_PTR) :: f_ptr - + f_ptr = C_LOC(buf(1)) namelen = LEN(dset_name) namelen1 = LEN(field_name) - + errcode = h5tbwrite_field_name_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,f_ptr) - + END SUBROUTINE h5tbwrite_field_name_f_int @@ -488,15 +488,15 @@ CONTAINS INTEGER(size_t) :: namelen ! name length INTEGER(size_t) :: namelen1 TYPE(C_PTR) :: f_ptr - + f_ptr = C_LOC(buf(1)(1:1)) namelen = LEN(dset_name) namelen1 = LEN(field_name) - + errcode = h5tbwrite_field_name_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,f_ptr) - + END SUBROUTINE h5tbwrite_field_name_f_string @@ -537,15 +537,15 @@ CONTAINS INTEGER(size_t) :: namelen ! name length INTEGER(size_t) :: namelen1 TYPE(C_PTR) :: f_ptr - + f_ptr = C_LOC(buf(1)) ! name length namelen = LEN(dset_name) namelen1 = LEN(field_name) - + errcode = h5tbread_field_name_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,f_ptr) - + END SUBROUTINE h5tbread_field_name_f_int SUBROUTINE h5tbread_field_name_f_string(loc_id,& @@ -569,15 +569,15 @@ CONTAINS INTEGER(size_t) :: namelen ! name length INTEGER(size_t) :: namelen1 ! name length TYPE(C_PTR) :: f_ptr - - f_ptr = C_LOC(buf(1)(1:1)) + + f_ptr = C_LOC(buf(1)(1:1)) namelen = LEN(dset_name) namelen1 = LEN(field_name) - + errcode = h5tbread_field_name_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,f_ptr) - + END SUBROUTINE h5tbread_field_name_f_string @@ -595,7 +595,7 @@ CONTAINS ! Modifications: ! !------------------------------------------------------------------------- - + SUBROUTINE h5tbwrite_field_index_f_int(loc_id,& dset_name,& field_index,& @@ -604,7 +604,7 @@ CONTAINS type_size,& 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 @@ -616,14 +616,14 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length TYPE(C_PTR) :: f_ptr - + f_ptr = C_LOC(buf(1)) namelen = LEN(dset_name) - + errcode = h5tbwrite_field_index_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,f_ptr) - + END SUBROUTINE h5tbwrite_field_index_f_int SUBROUTINE h5tbwrite_field_index_f_string(loc_id,& @@ -634,7 +634,7 @@ CONTAINS type_size,& 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 @@ -646,13 +646,13 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length TYPE(C_PTR) :: f_ptr - + f_ptr = C_LOC(buf(1)(1:1)) namelen = LEN(dset_name) - + errcode = h5tbwrite_field_index_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,f_ptr) - + END SUBROUTINE h5tbwrite_field_index_f_string @@ -679,7 +679,7 @@ CONTAINS type_size,& 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 @@ -691,13 +691,13 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length TYPE(C_PTR) :: f_ptr - + f_ptr = C_LOC(buf(1)) namelen = LEN(dset_name) - + errcode = h5tbread_field_index_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,f_ptr) - + END SUBROUTINE h5tbread_field_index_f_int SUBROUTINE h5tbread_field_index_f_string(loc_id,& @@ -720,13 +720,13 @@ CONTAINS INTEGER :: errcode ! error code INTEGER(size_t) :: namelen ! name length TYPE(C_PTR) :: f_ptr - + f_ptr = C_LOC(buf(1)(1:1)) namelen = LEN(dset_name) - + errcode = h5tbread_field_index_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,f_ptr) - + END SUBROUTINE h5tbread_field_index_f_string !------------------------------------------------------------------------- @@ -762,12 +762,12 @@ CONTAINS INTEGER(size_t) :: namelen1 ! name length INTEGER :: errcode ! error code TYPE(C_PTR) :: f_ptr - + f_ptr = C_LOC(buf(1)) namelen = LEN(dset_name) namelen1 = LEN(field_name) - + errcode = h5tbinsert_field_c(loc_id,namelen,dset_name,namelen1,field_name,& field_type,field_index,f_ptr) @@ -791,15 +791,15 @@ CONTAINS INTEGER(size_t) :: namelen1 ! name length INTEGER :: errcode ! error code TYPE(C_PTR) :: f_ptr - + f_ptr = C_LOC(buf(1)(1:1)) - + namelen = LEN(dset_name) namelen1 = LEN(field_name) - + errcode = h5tbinsert_field_c(loc_id,namelen,dset_name,namelen1,field_name,& field_type,field_index,f_ptr) - + END SUBROUTINE h5tbinsert_field_f_string !------------------------------------------------------------------------- @@ -898,9 +898,9 @@ CONTAINS namelen = LEN(dset_name) errcode = h5tbget_table_info_c(loc_id,namelen,dset_name,nfields,nrecords) - + END SUBROUTINE h5tbget_table_info_f - + !------------------------------------------------------------------------- ! Function: h5tbget_field_info_f @@ -915,9 +915,9 @@ CONTAINS ! ! Comments: ! -! Modifications: +! Modifications: ! Added optional parameter for returning the maximum character length -! in the field name array. March 3, 2011 +! in the field name array. March 3, 2011 ! !------------------------------------------------------------------------- @@ -929,7 +929,7 @@ CONTAINS field_offsets,& type_size,& errcode, maxlen_out ) - + IMPLICIT NONE INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset @@ -945,7 +945,7 @@ CONTAINS INTEGER(hsize_t) :: i ! general purpose integer INTEGER(size_t) :: maxlen INTEGER(size_t) :: c_maxlen_out - + INTERFACE INTEGER FUNCTION h5tbget_field_info_c(loc_id,namelen,dset_name,nfields,& field_sizes,field_offsets,type_size,namelen2, maxlen, field_names, c_maxlen_out) & @@ -963,7 +963,7 @@ CONTAINS INTEGER(size_t) :: namelen ! name length INTEGER(size_t) :: maxlen ! maxiumum length of input field names INTEGER(size_t), DIMENSION(1:nfields) :: namelen2 ! name lengths - INTEGER(size_t) :: c_maxlen_out ! maximum character length of a field array element + INTEGER(size_t) :: c_maxlen_out ! maximum character length of a field array element END FUNCTION h5tbget_field_info_c END INTERFACE @@ -973,14 +973,14 @@ CONTAINS END DO maxlen = LEN(field_names(1)) c_maxlen_out = 0 - + errcode = h5tbget_field_info_c(loc_id, namelen,dset_name, nfields, & field_sizes, field_offsets, type_size, namelen2, maxlen, field_names, c_maxlen_out) - + IF(PRESENT(maxlen_out)) maxlen_out = c_maxlen_out - + END SUBROUTINE h5tbget_field_info_f - + END MODULE H5TB_CONST |