1! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2!   Copyright by The HDF Group.                                               *
3!   Copyright by the Board of Trustees of the University of Illinois.         *
4!   All rights reserved.                                                      *
5!                                                                             *
6!   This file is part of HDF5.  The full HDF5 copyright notice, including     *
7!   terms governing use, modification, and redistribution, is contained in    *
8!   the COPYING file, which can be found at the root of the source code       *
9!   distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases.  *
10!   If you do not have access to either file, you may request a copy from     *
11!   help@hdfgroup.org.                                                        *
12! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
13!
14!
15! This file contains FORTRAN90 interfaces for H5DS functions
16!
17
18MODULE h5ds
19
20  USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR, C_FLOAT, C_DOUBLE, C_LOC, C_CHAR
21  USE h5fortran_types
22  USE hdf5
23
24CONTAINS
25
26!-------------------------------------------------------------------------
27! Function: H5DSset_scale_f
28!
29! Purpose: Convert dataset dsid to a dimension scale, with optional name, dimname.
30!
31! Return: Success: 0, Failure: -1
32!
33! Programmer: M. Scot Breitenfeld
34!
35! Date: April 17, 2011
36!
37! Comments:
38!
39! Modifications:
40!
41!-------------------------------------------------------------------------
42
43  SUBROUTINE H5DSset_scale_f( dsid, errcode, dimname)
44
45    IMPLICIT NONE
46
47    INTEGER(hid_t),   INTENT(in) :: dsid               ! The dataset to be made a Dimension Scale
48    CHARACTER(LEN=*), INTENT(in), OPTIONAL :: dimname  ! The dimension name
49    INTEGER :: errcode                                 ! Error code
50
51    INTEGER(SIZE_T) :: dimname_len                     ! length of dimname (if present)
52
53    INTERFACE
54       INTEGER FUNCTION H5DSset_scale_c(dsid, dimname, dimname_len) &
55            BIND(C,NAME='h5dsset_scale_c')
56         IMPORT :: C_CHAR
57         IMPORT :: HID_T, SIZE_T
58         IMPLICIT NONE
59         INTEGER(hid_t),   INTENT(in) :: dsid     ! The dataset to be made a Dimension Scale
60         CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(in) :: dimname  ! The dimension name
61         INTEGER(SIZE_T),  INTENT(in) :: dimname_len
62       END FUNCTION H5DSset_scale_c
63    END INTERFACE
64
65    IF(PRESENT(dimname))THEN
66       dimname_len = LEN(dimname)
67       errcode = H5DSset_scale_c(dsid, dimname, dimname_len )
68    ELSE
69       errcode = H5DSset_scale_c(dsid, " ", INT(0,SIZE_T) )
70    ENDIF
71
72  END SUBROUTINE H5DSset_scale_f
73
74!-------------------------------------------------------------------------
75! Function: H5DSattach_scale_f
76!
77! Purpose: Attach dimension scale dsid to dimension idx of dataset did.
78!
79! Return: Success: 0, Failure: -1
80!
81! Programmer: M. Scot Breitenfeld
82!
83! Date: April 17, 2011
84!
85! Comments:
86!
87! Modifications:
88!
89!-------------------------------------------------------------------------
90
91  SUBROUTINE H5DSattach_scale_f( did, dsid, idx, errcode)
92
93    IMPLICIT NONE
94
95    INTEGER(hid_t), INTENT(in) :: did     ! the dataset
96    INTEGER(hid_t), INTENT(in) :: dsid    ! the scale to be attached
97    INTEGER       , INTENT(in) :: idx     ! the dimension of did that dsid is associated with.
98    INTEGER                    :: errcode ! error code
99    INTEGER                    :: c_idx
100
101    INTERFACE
102       INTEGER FUNCTION  H5DSattach_scale_c(did, dsid, idx) &
103            BIND(C,NAME='h5dsattach_scale_c')
104         IMPORT :: HID_T
105         IMPLICIT NONE
106         INTEGER(hid_t), INTENT(in) :: did     ! the dataset
107         INTEGER(hid_t), INTENT(in) :: dsid    ! the scale to be attached
108         INTEGER       , INTENT(in) :: idx     ! the dimension of did that dsid is associated with.
109       END FUNCTION H5DSattach_scale_c
110    END INTERFACE
111
112    c_idx = idx -1 ! account for C-dimensions starting at 0
113
114    errcode = H5DSattach_scale_c( did, dsid, c_idx)
115
116  END SUBROUTINE H5DSattach_scale_f
117
118!-------------------------------------------------------------------------
119! Function: H5DSdetach_scale_f
120!
121! Purpose: Detach dimension scale dsid from the dimension idx of Dataset did.
122!
123! Return: Success: 0, Failure: -1
124!
125! Programmer: M. Scot Breitenfeld
126!
127! Date: April 17, 2011
128!
129! Comments:
130!
131! Modifications:
132!
133!-------------------------------------------------------------------------
134
135  SUBROUTINE H5DSdetach_scale_f( did, dsid, idx, errcode)
136
137    IMPLICIT NONE
138
139    INTEGER(hid_t), INTENT(in) :: did     ! the dataset
140    INTEGER(hid_t), INTENT(in) :: dsid    ! the scale to be detached
141    INTEGER       , INTENT(in) :: idx     ! the dimension of did to detach
142    INTEGER                    :: errcode ! error code
143    INTEGER                    :: c_idx
144
145    INTERFACE
146       INTEGER FUNCTION  H5DSdetach_scale_c(did, dsid, idx) &
147            BIND(C,NAME='h5dsdetach_scale_c')
148         IMPORT :: HID_T
149         IMPLICIT NONE
150         INTEGER(hid_t), INTENT(in) :: did     ! the dataset
151         INTEGER(hid_t), INTENT(in) :: dsid    ! the scale to be detached
152         INTEGER       , INTENT(in) :: idx     ! the dimension of did to detach
153       END FUNCTION H5DSdetach_scale_c
154    END INTERFACE
155
156    c_idx = idx - 1 ! account for C-dimensions starting at 0
157
158    errcode = H5DSdetach_scale_c( did, dsid, c_idx)
159
160  END SUBROUTINE H5DSdetach_scale_f
161
162
163!-------------------------------------------------------------------------
164! Function: H5DSis_attached_f
165!
166! Purpose: Report if dimension scale dsid is currently attached to dimension idx of dataset did.
167!
168! Return: Success: 0, Failure: -1
169!
170! Programmer: M. Scot Breitenfeld
171!
172! Date: April 17, 2011
173!
174! Comments:
175!
176! Modifications:
177!
178!-------------------------------------------------------------------------
179
180  SUBROUTINE H5DSis_attached_f( did, dsid, idx, is_attached, errcode)
181
182    IMPLICIT NONE
183
184    INTEGER(hid_t), INTENT(in)  :: did         ! the dataset
185    INTEGER(hid_t), INTENT(in)  :: dsid        ! the scale to be attached
186    INTEGER       , INTENT(in)  :: idx         ! the dimension of did that dsid is associated with
187    LOGICAL       , INTENT(out) :: is_attached ! logical: dimension scale dsid is currently attached to
188                                               ! dimension idx of dataset did
189    INTEGER                     :: errcode     ! error code
190    INTEGER                     :: c_is_attached
191    INTEGER                     :: c_idx
192
193    INTERFACE
194       INTEGER FUNCTION H5DSis_attached_c(did, dsid, idx, c_is_attached) &
195            BIND(C,NAME='h5dsis_attached_c')
196         IMPORT :: HID_T
197         IMPLICIT NONE
198         INTEGER(hid_t), INTENT(in)  :: did         ! the dataset
199         INTEGER(hid_t), INTENT(in)  :: dsid        ! the scale to be detached
200         INTEGER       , INTENT(in)  :: idx         ! the dimension of did to detach
201         INTEGER       , INTENT(out) :: c_is_attached ! dimension scale dsid is currently attached to
202       END FUNCTION H5DSis_attached_c
203    END INTERFACE
204
205    c_idx = idx - 1 ! account for C-dimensions starting at 0
206
207    errcode = H5DSis_attached_c(did, dsid, c_idx, c_is_attached)
208
209    is_attached = .FALSE. ! default
210    IF(c_is_attached.GT.0)THEN
211       is_attached = .TRUE.
212    ELSE IF(errcode.LT.0)THEN
213       errcode = -1
214    ENDIF
215
216  END SUBROUTINE H5DSis_attached_f
217
218!
219! H5DSiterate_scales: Impliment in  F2003
220!
221
222!-------------------------------------------------------------------------
223! Function: H5DSis_scale_f
224!
225! Purpose: Determines whether dset is a Dimension Scale.
226!
227! Return: Success: 0, Failure: -1
228!
229! Programmer: M. Scot Breitenfeld
230!
231! Date: April 18, 2011
232!
233! Comments:
234!
235! Modifications:
236!
237!-------------------------------------------------------------------------
238
239  SUBROUTINE H5DSis_scale_f( did, is_scale, errcode)
240
241    IMPLICIT NONE
242
243    INTEGER(hid_t), INTENT(in)  :: did         ! the data set to query
244    LOGICAL       , INTENT(out) :: is_scale    ! logical:
245                                               ! .TRUE. if did is a Dimension Scale
246    INTEGER                     :: errcode     ! error code
247    INTEGER                     :: c_is_scale
248
249    INTERFACE
250       INTEGER FUNCTION H5DSis_scale_c(did,c_is_scale) &
251            BIND(C,NAME='h5dsis_scale_c')
252         IMPORT :: HID_T
253         IMPLICIT NONE
254         INTEGER(hid_t), INTENT(in) :: did
255         INTEGER, INTENT(out) :: c_is_scale
256       END FUNCTION H5DSis_scale_c
257    END INTERFACE
258
259    errcode = H5DSis_scale_c(did, c_is_scale)
260
261    is_scale = .FALSE. ! default
262    IF(c_is_scale.GT.0)THEN
263       is_scale = .TRUE.
264    ELSE IF(errcode.LT.0)THEN
265       errcode = -1
266    ENDIF
267
268  END SUBROUTINE H5DSis_scale_f
269
270!-------------------------------------------------------------------------
271! Function: H5DSset_label_f
272!
273! Purpose: Set label for the dimension idx of did to the value label
274!
275! Return: Success: 0, Failure: -1
276!
277! Programmer: M. Scot Breitenfeld
278!
279! Date: April 18, 2011
280!
281! Comments:
282!
283! Modifications:
284!
285!-------------------------------------------------------------------------
286
287  SUBROUTINE H5DSset_label_f( did, idx, label, errcode)
288
289    IMPLICIT NONE
290
291    INTEGER(hid_t),   INTENT(in) :: did    ! The dataset
292    INTEGER       ,   INTENT(in) :: idx    ! The dimension
293    CHARACTER(LEN=*), INTENT(in) :: label  ! The label
294    INTEGER :: errcode                     ! Error code
295
296    INTEGER(SIZE_T) :: label_len  ! Length of label
297    INTEGER :: c_idx
298
299    INTERFACE
300       INTEGER FUNCTION H5DSset_label_c(did, idx, label, label_len) &
301            BIND(C,NAME='h5dsset_label_c')
302         IMPORT :: C_CHAR
303         IMPORT :: HID_T, SIZE_T
304         IMPLICIT NONE
305         INTEGER(hid_t),   INTENT(in) :: did        ! The dataset
306         INTEGER       ,   INTENT(in) :: idx        ! The dimension
307         CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(in) :: label ! The label
308         INTEGER(SIZE_T),  INTENT(in) :: label_len  ! Length of label
309       END FUNCTION H5DSset_label_c
310    END INTERFACE
311
312    c_idx = idx - 1
313
314    label_len = LEN(label)
315    errcode = H5DSset_label_c(did, c_idx, label, label_len)
316
317  END SUBROUTINE H5DSset_label_f
318
319!-------------------------------------------------------------------------
320! Function: H5DSget_label_f
321!
322! Purpose: Read the label for dimension idx of did into buffer label.
323!
324! Return: Success: 0, Failure: -1
325!
326! Programmer: M. Scot Breitenfeld
327!
328! Date: April 18, 2011
329!
330! Comments:
331!
332! Modifications:
333!
334!-------------------------------------------------------------------------
335
336  SUBROUTINE H5DSget_label_f( did, idx, label, size, errcode)
337
338    IMPLICIT NONE
339
340    INTEGER(hid_t),   INTENT(in) :: did      ! The dataget
341    INTEGER       ,   INTENT(in) :: idx      ! The dimension
342    CHARACTER(LEN=*), INTENT(INOUT) :: label ! The label
343    INTEGER(size_t) , INTENT(INOUT) :: size  ! The length of the label buffer
344    INTEGER :: errcode                       ! Error code
345    INTEGER :: c_idx
346
347    INTERFACE
348       INTEGER FUNCTION H5DSget_label_c(did, idx, label, size) &
349            BIND(C,NAME='h5dsget_label_c')
350         IMPORT :: C_CHAR
351         IMPORT :: HID_T, SIZE_T
352         IMPLICIT NONE
353         INTEGER(hid_t),   INTENT(in)    :: did        ! The dataget
354         INTEGER       ,   INTENT(in)    :: idx        ! The dimension
355         CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(INOUT) :: label ! The label
356         INTEGER(SIZE_T),  INTENT(inout) :: size       ! Length of label
357       END FUNCTION H5DSget_label_c
358    END INTERFACE
359
360    c_idx = idx - 1
361
362    errcode = H5DSget_label_c(did, c_idx, label, size)
363
364  END SUBROUTINE H5DSget_label_f
365
366
367!-------------------------------------------------------------------------
368! Function: H5DSget_scale_name_f
369!
370! Purpose: Read the name of scale did into buffer name.
371!
372! Return: Success: 0, Failure: -1
373!
374! Programmer: M. Scot Breitenfeld
375!
376! Date: April 18, 2011
377!
378! Comments:
379!
380! Modifications:
381!
382!-------------------------------------------------------------------------
383
384  SUBROUTINE H5DSget_scale_name_f(did, name, size, errcode)
385
386    IMPLICIT NONE
387
388    INTEGER(hid_t),   INTENT(in) :: did     ! The dataget
389    CHARACTER(LEN=*), INTENT(INOUT) :: name ! The name
390    INTEGER(size_t) , INTENT(INOUT) :: size ! The length of the name buffer
391    INTEGER :: errcode                      ! Error code
392
393    INTERFACE
394       INTEGER FUNCTION H5DSget_scale_name_c(did, name, size) &
395            bind(c,name='h5dsget_scale_name_c')
396         IMPORT :: C_CHAR
397         IMPORT :: HID_T, SIZE_T
398         IMPLICIT NONE
399         INTEGER(hid_t),   INTENT(in)    :: did       ! The dataget
400         CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(INOUT) :: name ! The name
401         INTEGER(SIZE_T),  INTENT(inout) :: size      ! Length of name
402       END FUNCTION H5DSget_scale_name_c
403    END INTERFACE
404
405    errcode = H5DSget_scale_name_c(did, name, size)
406
407  END SUBROUTINE H5DSget_scale_name_f
408
409!-------------------------------------------------------------------------
410! Function: H5DSget_num_scales_f
411!
412! Purpose: Determines how many Dimension Scales are attached to dimension idx of did
413!
414! Return: Success: 0, Failure: -1
415!
416! Programmer: M. Scot Breitenfeld
417!
418! Date: April 18, 2011
419!
420! Comments:
421!
422! Modifications:
423!
424!-------------------------------------------------------------------------
425
426  SUBROUTINE H5DSget_num_scales_f( did, idx, num_scales, errcode)
427
428    IMPLICIT NONE
429    INTEGER(hid_t), INTENT(in)  :: did          ! the dataset
430    INTEGER       , INTENT(in)  :: idx          ! the dimension of did to query
431    INTEGER       , INTENT(INOUT) :: num_scales ! the number of Dimension Scales associated with did
432    INTEGER                     :: errcode      ! error code
433    INTEGER                     :: c_idx
434
435    INTERFACE
436       INTEGER FUNCTION H5DSget_num_scales_c(did, idx, num_scales) &
437            BIND(C,NAME='h5dsget_num_scales_c')
438         IMPORT :: HID_T
439         IMPLICIT NONE
440         INTEGER(hid_t), INTENT(in)  :: did          ! the dataset
441         INTEGER       , INTENT(in)  :: idx          ! the dimension of did to query
442         INTEGER       , INTENT(INOUT) :: num_scales ! the number of Dimension Scales associated with did
443       END FUNCTION H5DSget_num_scales_c
444    END INTERFACE
445
446    c_idx = idx - 1
447    errcode = H5DSget_num_scales_c(did, c_idx, num_scales)
448
449  END SUBROUTINE H5DSget_num_scales_f
450
451END MODULE h5ds
452
453
454
455
456
457
458