summaryrefslogtreecommitdiffstats
path: root/hl/fortran/test/tstds.F90
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2015-08-11 01:22:33 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2015-08-11 01:22:33 (GMT)
commit3b4696ccd16c2b98e2700a46bf7a5c76ef4a9764 (patch)
treef301ab5333168d7bfa691bee703dd076f569fc46 /hl/fortran/test/tstds.F90
parent415eb5512b0726716b5f8f72de3dda11ecff8091 (diff)
downloadhdf5-3b4696ccd16c2b98e2700a46bf7a5c76ef4a9764.zip
hdf5-3b4696ccd16c2b98e2700a46bf7a5c76ef4a9764.tar.gz
hdf5-3b4696ccd16c2b98e2700a46bf7a5c76ef4a9764.tar.bz2
[svn-r27489] reverted merge of branch
Diffstat (limited to 'hl/fortran/test/tstds.F90')
-rw-r--r--hl/fortran/test/tstds.F90353
1 files changed, 0 insertions, 353 deletions
diff --git a/hl/fortran/test/tstds.F90 b/hl/fortran/test/tstds.F90
deleted file mode 100644
index cbf6c38..0000000
--- a/hl/fortran/test/tstds.F90
+++ /dev/null
@@ -1,353 +0,0 @@
-! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-! * Copyright by The HDF Group. *
-! * Copyright by the Board of Trustees of the University of Illinois. *
-! * All rights reserved. *
-! * *
-! * This file is part of HDF5. The full HDF5 copyright notice, including *
-! * terms governing use, modification, and redistribution, is contained in *
-! * the files COPYING and Copyright.html. COPYING can be found at the root *
-! * of the source code distribution tree; Copyright.html can be found at the *
-! * root level of an installed copy of the electronic HDF5 document set and *
-! * is linked from the top-level documents page. It can also be found at *
-! * http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have *
-! * access to either file, you may request a copy from help@hdfgroup.org. *
-! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-PROGRAM test_ds
-
- IMPLICIT NONE
-
- INTEGER :: err
-
- CALL test_testds(err)
-
- IF(err.LT.0)THEN
- WRITE(*,'(5X,A)') "DIMENSION SCALES TEST *FAILED*"
- ENDIF
-
-END PROGRAM test_ds
-
-SUBROUTINE test_testds(err)
-
- USE HDF5
- USE H5LT
- USE H5DS
-
- IMPLICIT NONE
-
- INTEGER, PARAMETER :: RANK = 2 ! rank of DATA dataset
- INTEGER, PARAMETER :: DIM_DATA = 12
- INTEGER, PARAMETER :: DIM1_SIZE = 3
- INTEGER, PARAMETER :: DIM2_SIZE = 4
- INTEGER, PARAMETER :: DIM1 = 1
- INTEGER, PARAMETER :: DIM2 = 2
- INTEGER, PARAMETER :: FAILED = -1
-
- CHARACTER(LEN=6), PARAMETER :: DSET_NAME = "Mydata"
- CHARACTER(LEN=5), PARAMETER :: DS_1_NAME = "Yaxis"
- CHARACTER(LEN=5), PARAMETER :: DS_1_NAME_A = "Yaxiz"
- CHARACTER(LEN=5), PARAMETER :: DS_2_NAME = "Xaxis"
-
-
- INTEGER(hid_t) :: fid ! file ID
- INTEGER(hid_t) :: did ! dataset ID
- INTEGER(hid_t) :: dsid ! DS dataset ID
- INTEGER :: rankds = 1 ! rank of DS dataset
- INTEGER(hsize_t), DIMENSION(1:rank) :: dims = (/DIM2_SIZE,DIM1_SIZE/) ! size of DATA dataset
- INTEGER, DIMENSION(1:DIM_DATA) :: buf = (/1,2,3,4,5,6,7,8,9,10,11,12/) ! DATA of DATA dataset
- INTEGER(hsize_t), DIMENSION(1:1) :: s1_dim = (/DIM1_SIZE/) ! size of DS 1 dataset
- INTEGER(hsize_t), DIMENSION(1:1) :: s2_dim = (/DIM2_SIZE/) ! size of DS 2 dataset
- REAL, DIMENSION(1:DIM1_SIZE) :: s1_wbuf = (/10,20,30/) ! DATA of DS 1 dataset
- INTEGER, DIMENSION(1:DIM2_SIZE) :: s2_wbuf = (/10,20,50,100/) ! DATA of DS 2 dataset
- INTEGER :: err
- INTEGER :: num_scales
- INTEGER(size_t) :: name_len
- CHARACTER(LEN=80) :: name
- INTEGER(size_t) :: label_len
- CHARACTER(LEN=80) :: label
- LOGICAL :: is_attached, is_scale
-
- !
- ! Initialize FORTRAN predefined datatypes.
- !
- CALL h5open_f(err)
- IF(err.LT.0) RETURN
-
- ! create a file using default properties
- CALL H5Fcreate_f("tstds.h5",H5F_ACC_TRUNC_F, fid, err)
- IF(err.LT.0) RETURN
-
- ! make a dataset
- CALL H5LTmake_dataset_int_f(fid,DSET_NAME,rank,dims,buf, err)
- IF(err.LT.0) RETURN
-
- ! make a DS dataset for the first dimension
- CALL H5LTmake_dataset_float_f(fid,DS_1_NAME,rankds,s1_dim,s1_wbuf,err)
- IF(err.LT.0) RETURN
-
- ! make a DS dataset for the second dimension
- CALL H5LTmake_dataset_int_f(fid,DS_2_NAME,rankds,s2_dim,s2_wbuf,err)
- IF(err.LT.0) RETURN
-
- !-------------------------------------------------------------------------
- ! attach the DS_1_NAME dimension scale to DSET_NAME at dimension 1
- !-------------------------------------------------------------------------
-
- CALL test_begin(' Test Attaching Dimension Scale ')
-
- ! get the dataset id for DSET_NAME
- CALL H5Dopen_f(fid, DSET_NAME, did, err)
- IF(err.LT.0) RETURN
-
- ! get the DS dataset id
- CALL H5Dopen_f(fid, DS_1_NAME, dsid, err)
- IF(err.LT.0) RETURN
-
- ! check attaching to a non-existent dimension; should fail
- CALL H5DSattach_scale_f(did, dsid, 20, err)
- IF(err.NE.-1) THEN
- err = FAILED ! should fail, mark as an error
- CALL write_test_status(err)
- RETURN
- ENDIF
-
- ! attach the DS_1_NAME dimension scale to DSET_NAME at dimension index 1
- CALL H5DSattach_scale_f(did, dsid, DIM1, err)
- IF(err.EQ.-1) THEN
- CALL write_test_status(err)
- RETURN
- ENDIF
- CALL write_test_status(err)
-
- CALL test_begin(' Test If Dimension Scale Attached ')
-
- CALL H5DSis_attached_f(did, dsid, DIM1, is_attached, err)
- IF(err.EQ.-1.OR..NOT.is_attached) THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
- CALL write_test_status(err)
-
- ! Check to see how many Dimension Scales are attached
-
- CALL test_begin(' Test Getting Number Dimension Scales ')
-
- CALL H5DSget_num_scales_f(did, DIM1, num_scales, err)
- IF(err.LT.0.OR.num_scales.NE.1)THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
- CALL write_test_status(err)
-
- CALL test_begin(' Test Detaching Dimension Scale ')
-
- ! Detach scale
- CALL H5DSdetach_scale_f(did, dsid, DIM1, err)
- IF(err.LT.0) RETURN
-
- ! Check to see if a dimension scale is attached, should be .false.
- CALL H5DSis_attached_f(did, dsid, DIM1, is_attached, err)
- IF(err.LT.0.OR.is_attached)THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
- CALL write_test_status(err)
-
- !-------------------------------------------------------------------------
- ! set the DS_1_NAME dimension scale to DSET_NAME at dimension 0
- !-------------------------------------------------------------------------
-
- CALL test_begin(' Test Setting Dimension Scale ')
-
- CALL H5DSset_scale_f(dsid, err, "Dimension Scale Set 1")
- IF(err.LT.0.OR.is_attached)THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
- CALL write_test_status(err)
-
- CALL test_begin(' Test If Dimension Scale ')
-
- CALL H5DSis_scale_f(dsid, is_scale, err)
- IF(err.LT.0.OR..NOT.is_scale)THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
- CALL write_test_status(err)
-
- ! Get scale name; test to large character buffer
-
- CALL test_begin(' Test Getting Dimension Scale By Name ')
-
- name_len = 25
- name = ''
- CALL H5DSget_scale_name_f(dsid, name, name_len, err)
- IF(err.LT.0 .OR. &
- name_len.NE.21 .OR. &
- TRIM(name).NE."Dimension Scale Set 1" .OR. &
- name(22:25).NE.' ')THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
-
- ! Get scale name; test exact size character buffer
- name_len = 21
- name = ''
- CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err)
- IF(err.LT.0.OR.name_len.NE.21.OR.TRIM(name).NE."Dimension Scale Set 1")THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
-
- ! Get scale name; test to small character buffer
- name_len = 5
- name = ''
- CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err)
- IF(err.LT.0.OR.name_len.NE.21.OR.TRIM(name).NE."Dimen")THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
-
- ! close DS id
- CALL H5Dclose_f(dsid, err)
- IF(err.LT.0) RETURN
-
- !-------------------------------------------------------------------------
- ! attach the DS_2_NAME dimension scale to DSET_NAME
- !-------------------------------------------------------------------------
-
- ! get the DS dataset id
- CALL H5Dopen_f(fid, DS_2_NAME, dsid, err)
- IF(err.LT.0) RETURN
-
- ! attach the DS_2_NAME dimension scale to DSET_NAME as the 2nd dimension (index 2)
- CALL H5DSattach_scale_f(did, dsid, DIM2, err)
- IF(err.LT.0) RETURN
-
- CALL H5DSis_attached_f(did, dsid, DIM2, is_attached, err)
- IF(err.LT.0) RETURN
-
- ! test sending no Dimension Scale name
-
- CALL H5DSset_scale_f(dsid, err)
- IF(err.LT.0)THEN
- CALL write_test_status(err)
- RETURN
- ENDIF
-
- CALL H5DSis_scale_f(dsid, is_scale, err)
- IF(err.LT.0.OR..NOT.is_scale)THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
-
- ! Get scale name when there is no scale name
- name_len = 5
- name = ''
- CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err)
- IF(err.LT.0.OR.name_len.NE.0)THEN ! name_len is 0 if no name is found
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
-
- CALL write_test_status(err)
-
- CALL test_begin(' Test Setting Dimension Scale Label ')
-
- CALL H5DSset_label_f(did, DIM2, "Label12", err)
- IF(err.LT.0)THEN
- CALL write_test_status(err)
- RETURN
- ENDIF
-
- ! Test label where character length is to small
-
- label_len = 5
- label = ''
- CALL H5DSget_label_f(did, DIM2, label(1:label_len), label_len, err)
- IF(err.LT.0.OR.label(1:5).NE."Label".OR.label_len.NE.7)THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
-
- ! Test label where character length is exact
-
- label_len = 7
- label = ''
- CALL H5DSget_label_f(did, DIM2, label(1:label_len), label_len, err)
- IF(err.LT.0.OR.label(1:label_len).NE."Label12".OR.label_len.NE.7)THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
-
- ! Test label where character length is to big
-
- label_len = 25
- label = ''
- CALL H5DSget_label_f(did, DIM2, label, label_len, err)
- IF(err.LT.0.OR. &
- label(1:label_len).NE."Label12" .OR. &
- label_len.NE.7 .OR. &
- label(8:25).NE.' ')THEN
- err = FAILED
- CALL write_test_status(err)
- RETURN
- ENDIF
- CALL write_test_status(err)
-
- ! close DS id
- CALL H5Dclose_f(dsid, err)
- IF(err.LT.0) RETURN
-
- ! close file
- CALL H5Fclose_f(fid, err)
- IF(err.LT.0) RETURN
-
-END SUBROUTINE test_testds
-
-!-------------------------------------------------------------------------
-! test_begin
-!-------------------------------------------------------------------------
-
-SUBROUTINE test_begin(string)
- CHARACTER(LEN=*), INTENT(IN) :: string
- WRITE(*, fmt = '(A)', advance = 'no') ADJUSTL(string)
-END SUBROUTINE test_begin
-
-!-------------------------------------------------------------------------
-! passed/failed
-!-------------------------------------------------------------------------
-SUBROUTINE write_test_status( test_result)
-
-! Writes the results of the tests
-
- IMPLICIT NONE
-
- INTEGER, INTENT(IN) :: test_result ! negative, failed
- ! 0 , passed
-
-! Controls the output style for reporting test results
-
- CHARACTER(LEN=8) :: error_string
- CHARACTER(LEN=8), PARAMETER :: success = ' PASSED '
- CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*'
-
- error_string = failure
- IF (test_result .EQ. 0) THEN
- error_string = success
- ENDIF
-
- WRITE(*, fmt = '(T34, A)') error_string
-
-END SUBROUTINE write_test_status