diff options
Diffstat (limited to 'hl/fortran/test/tstimage.f90')
| -rwxr-xr-x | hl/fortran/test/tstimage.f90 | 140 |
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 |