summaryrefslogtreecommitdiffstats
path: root/hl/fortran/test/tstimage.f90
diff options
context:
space:
mode:
authorPedro Vicente Nunes <pvn@hdfgroup.org>2005-05-16 19:08:41 (GMT)
committerPedro Vicente Nunes <pvn@hdfgroup.org>2005-05-16 19:08:41 (GMT)
commit5b6c08e68e94cab82653dff0c74d1725fd2852f4 (patch)
treed08b050aff5fcaa5f51897769e41a023709a7177 /hl/fortran/test/tstimage.f90
parent4977e0ac5163ce29211596f84cb39c3c5e525a16 (diff)
downloadhdf5-5b6c08e68e94cab82653dff0c74d1725fd2852f4.zip
hdf5-5b6c08e68e94cab82653dff0c74d1725fd2852f4.tar.gz
hdf5-5b6c08e68e94cab82653dff0c74d1725fd2852f4.tar.bz2
[svn-r10747] Purpose:
bug fix Description: the fortran type integer*1 has become not portable. define the image fortran datatype as "integer" and make special save, read, and palette functions that use native integer for a memory type and UCHAR as disk type for the image data added some more tests with new palette definitions Solution: Platforms tested: linux solaris Misc. update:
Diffstat (limited to 'hl/fortran/test/tstimage.f90')
-rwxr-xr-xhl/fortran/test/tstimage.f90140
1 files changed, 83 insertions, 57 deletions
diff --git a/hl/fortran/test/tstimage.f90 b/hl/fortran/test/tstimage.f90
index 444cd60..42fe52a 100755
--- a/hl/fortran/test/tstimage.f90
+++ b/hl/fortran/test/tstimage.f90
@@ -29,60 +29,84 @@ end program image_test
subroutine make_image1()
-use H5IM ! module of H5IM
-use HDF5 ! module of HDF5 library
+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
+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 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
+! 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
-
-!
-! Initialize the data array.
-!
-n = 0
+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;
- n = n + 1;
+ 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
-n = 0
+!
+! create a 3 byte rgb image
+!
+n = 0; j = 0;
do i = 1, width*height*3
buf2(i) = n;
- n = n + 1;
+ 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)
@@ -113,7 +137,7 @@ 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
+ if ( buf1(i) /= bufr1(i) ) then
print *, 'read buffer differs from write buffer'
print *, bufr1(i), ' and ', buf1(i)
stop
@@ -125,13 +149,13 @@ end do
!
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
+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 .ne. 1) then
+if ( is_image /= 1) then
print *, 'h5imis_image_f bad value'
stop
endif
@@ -159,7 +183,7 @@ 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
+ if ( buf2(i) /= bufr2(i) ) then
print *, 'read buffer differs from write buffer'
print *, bufr2(i), ' and ', buf2(i)
stop
@@ -171,13 +195,13 @@ end do
!
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
+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 .ne. 1) then
+if ( is_image /= 1) then
print *, 'h5imis_image_f bad value'
stop
endif
@@ -217,8 +241,8 @@ 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
+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
@@ -230,7 +254,7 @@ end do
!
call h5imget_npalettes_f(file_id,dsetname1,npals,errcode)
-if ( npals .ne. 1) then
+if ( npals /= 1) then
print *, 'h5imget_npalettes_f bad value'
stop
endif
@@ -241,7 +265,7 @@ endif
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
+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
@@ -251,7 +275,7 @@ endif
!
is_palette = h5imis_palette_f(file_id,pal_name)
-if ( is_palette .ne. 1 ) then
+if ( is_palette /= 1 ) then
print *, 'h5imis_palette_f bad value'
stop
endif
@@ -266,11 +290,17 @@ call h5imunlink_palette_f(file_id,dsetname1,pal_name,errcode)
!
call h5imget_npalettes_f(file_id,dsetname1,npals,errcode )
-if ( npals .ne. 0) then
+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()
@@ -288,21 +318,17 @@ call h5fclose_f(file_id, errcode)
!
call h5close_f(errcode)
-
!
! end function.
!
end subroutine make_image1
-
-
-
!-------------------------------------------------------------------------
! test_begin
!-------------------------------------------------------------------------
subroutine test_begin(string)
-character(LEN=*), intent(IN) :: string
+character(len=*), intent(in) :: string
write(*, fmt = '(14a)', advance = 'no') string
write(*, fmt = '(40x,a)', advance = 'no') ' '
end subroutine test_begin