summaryrefslogtreecommitdiffstats
path: root/hl/fortran/test/tstimage.f90
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2015-06-08 21:13:15 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2015-06-08 21:13:15 (GMT)
commit32703c9fc5a315a005abf26965d5545043fd3605 (patch)
tree342146825782a26babcd939201f7d657520c84dc /hl/fortran/test/tstimage.f90
parent8641814c4e5b4211e0980df783c3d2d25f484226 (diff)
downloadhdf5-32703c9fc5a315a005abf26965d5545043fd3605.zip
hdf5-32703c9fc5a315a005abf26965d5545043fd3605.tar.gz
hdf5-32703c9fc5a315a005abf26965d5545043fd3605.tar.bz2
[svn-r27164] various bug fixes for DT
Diffstat (limited to 'hl/fortran/test/tstimage.f90')
-rw-r--r--hl/fortran/test/tstimage.f90339
1 files changed, 0 insertions, 339 deletions
diff --git a/hl/fortran/test/tstimage.f90 b/hl/fortran/test/tstimage.f90
deleted file mode 100644
index 0bff6b2..0000000
--- a/hl/fortran/test/tstimage.f90
+++ /dev/null
@@ -1,339 +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. *
-! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-!
-!
-! 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 = 500 ! width of image
-integer(hsize_t), parameter :: height = 200 ! height of image
-integer, parameter :: pal_entries = 9 ! palette number of entries
-integer, dimension(width*height) :: buf1 ! data buffer
-integer, dimension(width*height) :: bufr1 ! data buffer
-integer, dimension(width*height*3) :: buf2 ! data buffer
-integer, 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, j, n ! general purpose integers
-!
-! palette
-! create a 9 entry palette
-!
-character(len=4), parameter :: pal_name = "pal1" ! dataset name
-integer(hsize_t), dimension(2) :: pal_dims = (/pal_entries,3/) ! palette dimensions
-integer(hsize_t), dimension(2) :: pal_dims_out ! palette dimensions
-integer, dimension(pal_entries*3) :: pal_data_out ! data buffer
-integer(hsize_t) :: npals ! number of palettes
-integer :: pal_number ! palette number
-integer :: is_palette ! is palette
-integer :: space
-integer, dimension(pal_entries*3) :: pal_data_in = (/&
- 0,0,168,& ! dark blue
- 0,0,252,& ! blue
- 0,168,252,& ! ocean blue
- 84,252,252,& ! light blue
- 168,252,168,& ! light green
- 0,252,168,& ! green
- 252,252,84,& ! yellow
- 252,168,0,& ! orange
- 252,0,0/) ! red
-
-
-! create an 8bit image of 9 values divided evenly by the array
-!
-space = width*height / pal_entries;
-n = 0; j = 0;
-do i = 1, width*height
- buf1(i) = n
- if ( j > space ) then
- n = n + 1;
- j = 0;
- endif
- if (n>pal_entries-1) n=0;
- j = j +1;
-end do
-
-!
-! create a 3 byte rgb image
-!
-n = 0; j = 0;
-do i = 1, width*height*3
- buf2(i) = n;
- if (j == 3) then
- n = n + 1;
- j = 0;
- endif
- if (n>255) n=0;
- j = j +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) /= 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 /= widthr) .or. (heightr /= height) .or. (planesr /= 1)) then
- print *, 'h5imget_image_info_f bad value'
- stop
-endif
-
-is_image = h5imis_image_f(file_id,dsetname1)
-if ( is_image /= 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) /= 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 /= widthr) .or. (heightr /= height) .or. (planesr /= 3)) then
- print *, 'h5imget_image_info_f bad value'
- stop
-endif
-
-is_image = h5imis_image_f(file_id,dsetname2)
-if ( is_image /= 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, pal_entries*3
- if ( pal_data_in(i) /= 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 /= 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) /= pal_dims(1)) .or. (pal_dims_out(2) /= 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 /= 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 /= 0) then
- print *, 'h5imget_npalettes_f bad value'
- stop
-endif
-
-
-!
-! link palette again
-!
-call h5imlink_palette_f(file_id,dsetname1,pal_name,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 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