!##############################################################################
!# 
!# Copyright by The HDF Group.
!# All rights reserved.
!#
!# This file is part of the hl_region High-Level HDF5 APIs.  The full copyright 
!# notice, including terms governing use, modification, and redistribution, 
!# is contained in the file COPYING, which can be found at the root of the
!# source code distribution tree and in the documentation directory (doc/html/). 
!# If you do not have access to this file, you may request a copy of 
!# "the hl_region High-Level HDF5 APIs copyright and license statement" from 
!# help@hdfgroup.org.
!# 
!##############################################################################
!
!   Tests H5LTread_bitfield_value_f
!
PROGRAM main

  INTEGER :: nerrors = 0

  ! test region region references and hyperslab selections
  CALL test_read_bitfield(nerrors)

  ! There was a problem, so exit with a status code > 0
  IF(nerrors.NE.0) STOP 1

END PROGRAM main


SUBROUTINE test_read_bitfield(nerrors)

  USE ISO_C_BINDING
  USE H5LT ! module of H5LT 
  USE HDF5 ! module of HDF5 library 
  USE H5HL_REGION ! module for hl region library

  USE test_util ! Prints results

  IMPLICIT NONE

  INTEGER :: nerrors

  CHARACTER(LEN=16) :: filename = "hl_region_EDR.h5"
  INTEGER, PARAMETER :: DIM0 = 3 ! dataset dimensions
  INTEGER, PARAMETER :: DIM1 = 2
  INTEGER, PARAMETER :: DIM2 = 2
  INTEGER, PARAMETER :: num_flags = 4

  INTEGER, DIMENSION(1:3) :: dim_qf_data =(/DIM0,DIM1,num_flags/) ! Dimensions of qf_data
  INTEGER(C_INT), DIMENSION(DIM0,DIM1,num_flags) :: qf_data  ! READ buffer
  INTEGER, DIMENSION(1:4) :: offset= (/1,3,5,7/)  ! Starting bits to be extracted from element 
  INTEGER, DIMENSION(1:4) :: length= (/2,2,2,2/)  ! Number of bits to be extracted for each value 
  INTEGER(hid_t) :: file, space_id, dset_id ! Handles
  INTEGER(hid_t) :: qf_dset
  INTEGER, PARAMETER ::  rank = 2
  INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/DIM0,DIM1/), maxdims
  INTEGER(hid_t) :: file_id, sid, did
  CHARACTER(LEN=1), DIMENSION(1:DIM0,1:DIM1) :: wdata ! WRITE buffer
  INTEGER :: i, j, k, l
  INTEGER :: hdferr
  INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(1)
  INTEGER(int_kind_1) :: x
! scalar
  CHARACTER(LEN=1) :: wdata0
  INTEGER(hsize_t), DIMENSION(1:1) :: dims0 = (/1/), maxdims0
  INTEGER, DIMENSION(1:1) :: dim_qf_data0 =(/num_flags/) ! Dimensions of qf_data
  INTEGER(C_INT), DIMENSION(1:num_flags) :: qf_data0  ! READ buffer
! 1D packed
  CHARACTER(LEN=1), DIMENSION(1:DIM0) :: wdata1
  INTEGER(hsize_t), DIMENSION(1:1) :: dims1 = (/dim0/), maxdims1
  INTEGER, DIMENSION(1:2) :: dim_qf_data1 =(/dim0,num_flags/) ! Dimensions of qf_data
  INTEGER(C_INT), DIMENSION(1:dim0,1:num_flags) :: qf_data1  ! READ buffer
! 3D packed
  CHARACTER(LEN=1), DIMENSION(1:DIM0,1:DIM1,1:DIM2) :: wdata3
  INTEGER(hsize_t), DIMENSION(1:3) :: dims3 = (/dim0, dim1, dim2/), maxdims3
  INTEGER, DIMENSION(1:4) :: dim_qf_data3 =(/dim0,dim1,dim2,num_flags/) ! Dimensions of qf_data
  INTEGER(C_INT), DIMENSION(1:dim0,1:dim1,1:dim2,1:num_flags) :: qf_data3  ! READ buffer


  INTEGER, DIMENSION(1:DIM0,1:DIM1,1:num_flags) :: &
       correct = RESHAPE( (/0,3,2,0,0,0,0,0,0,1,1,1,0,1,2,0,1,2,0,1,2,1,2,3/), &
                          (/DIM0,DIM1,num_flags/) )

  INTEGER, DIMENSION(1:num_flags) :: correct0 = (/0,1,2,3/)  
  
  INTEGER, DIMENSION(1:DIM0,1:num_flags) :: &
       correct1 = RESHAPE( (/0,0,0,1,1,1,0,1,2,1,2,3/), &
                           (/DIM0,num_flags/) )

  INTEGER, DIMENSION(1:DIM0,1:DIM1,1:DIM2,1:num_flags) :: &
       correct3 = RESHAPE( (/0,3,2,0,0,0,0,3,2,0,0,0,0,0,0,1,1,1,0,0,0,&
       1,1,1,0,1,2,0,1,2,0,1,2,0,1,2,0,1,2,1,2,3,0,1,2,1,2,3/), &
       (/DIM0,DIM1,DIM2,num_flags/) )

  !
  ! Initialize FORTRAN predefined datatypes.
  !
  CALL h5open_f(hdferr)
  !
  ! Initialize data.  We will manually fill four 2-bit integers into
  ! each unsigned char data element.
  !
  DO i = 1, DIM0
     DO j = 1, DIM1
        IF(BIT_SIZE(x) .NE. 8) x = 0
        CALL MVBITS(INT(j*i-2*i-j+2,KIND(wdata)),0,2,x,0)
        CALL MVBITS(INT(j-1,KIND(wdata)),0,2,x,2)
        CALL MVBITS(INT(i-1,KIND(wdata)),0,2,x,4)
        CALL MVBITS(INT(j+i-2,KIND(wdata)),0,2,x,6)
        wdata(i,j) = TRANSFER(x,wdata(i,j))
        IF(i.EQ.DIM0.AND.j.EQ.DIM1) wdata0 = wdata(i,j)
        IF(j.EQ.DIM1) wdata1(i) = wdata(i,j)
        DO k = 1, DIM2
           wdata3(i,j,k) = wdata(i,j)
        ENDDO
     END DO
  END DO
  !
  ! Create file with default file access and file creation properties.
  !
  CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferr)

  ! Create 3D array dataset
  
  CALL H5Screate_simple_f(rank, dims, space_id, hdferr)
  
  CALL h5dcreate_f(file_id, "Granule 2", H5T_STD_U8LE, space_id, dset_id, hdferr)

  !
  ! Write data to the dataset and close.
  !
  CALL h5dwrite_f(dset_id, H5T_STD_U8LE, wdata, dims, hdferr)
  CALL h5dclose_f(dset_id, hdferr)
  CALL h5sclose_f(space_id, hdferr)

  ! Create Scalar 0D dataset

  CALL H5Screate_simple_f(1, dims0, space_id, hdferr)
  
  CALL h5dcreate_f(file_id, "Granule 0", H5T_STD_U8LE, space_id, dset_id, hdferr)

  !
  ! Write data to the dataset and close.
  !
  CALL h5dwrite_f(dset_id, H5T_STD_U8LE, wdata0, dims0, hdferr)
  CALL h5dclose_f(dset_id, hdferr)
  CALL h5sclose_f(space_id, hdferr)

  ! Create Scalar 1D dataset

  CALL H5Screate_simple_f(1, dims1, space_id, hdferr)
  
  CALL h5dcreate_f(file_id, "Granule 1", H5T_STD_U8LE, space_id, dset_id, hdferr)

  !
  ! Write data to the dataset and close.
  !
  CALL h5dwrite_f(dset_id, H5T_STD_U8LE, wdata1, dims1, hdferr)
  CALL h5dclose_f(dset_id, hdferr)
  CALL h5sclose_f(space_id, hdferr)

! 3D packed data
  CALL H5Screate_simple_f(3, dims3, space_id, hdferr)
  
  CALL h5dcreate_f(file_id, "Granule 3", H5T_STD_U8LE, space_id, dset_id, hdferr)
  !
  ! Write data to the dataset and close.
  !
  CALL h5dwrite_f(dset_id, H5T_STD_U8LE, wdata3, dims3, hdferr)
  CALL h5dclose_f(dset_id, hdferr)
  CALL h5sclose_f(space_id, hdferr)


  CALL H5Fclose_f(file_id, hdferr)
  !
  ! Open hl_region product file and a granule dataset.
  !
  CALL H5Fopen_f(filename, H5F_ACC_RDONLY_F, file, hdferr)
  CALL H5Dopen_f(file,"Granule 2", qf_dset, hdferr)
  !
  ! Get dataspace and allocate memory for read buffer. Quality flags dataset
  ! has the same dimensionality as corresponding product dataset;
  ! we are using its dimensions for illustration purposes only.
  !
  CALL H5Dget_space_f(qf_dset, space_id, hdferr)
  CALL H5Sselect_all_f(space_id, hdferr)

  CALL TESTING("H5LTread_bitfield_value, 2D packed")
  !
  ! For each element read the IST quality flag that takes first two bits and 
  ! store it in a char buffer. This selects all the elements (H5S_ALL)
  !
  CALL H5LTread_bitfield_value_f(qf_dset, num_flags, offset, length, space_id, qf_data, dim_qf_data, hdferr)
  CALL H5Sclose_f(space_id, hdferr)
  CALL H5Dclose_f(qf_dset, hdferr)
  DO i = 1, DIM0
     DO j = 1, DIM1
        DO k = 1, num_flags
           IF(qf_data(i,j,k).NE.correct(i,j,k)) GOTO 7
        ENDDO
     ENDDO
  ENDDO

  CALL PASSED()

  CALL TESTING("H5LTread_bitfield_value, Scalar packed ")

  CALL H5Dopen_f(file,"Granule 0", qf_dset, hdferr)
  !
  ! Get dataspace and allocate memory for read buffer. Quality flags dataset
  ! has the same dimensionality as corresponding product dataset;
  ! we are using its dimensions for illustration purposes only.
  !
  CALL H5Dget_space_f(qf_dset, space_id, hdferr)
  CALL H5Sselect_all_f(space_id, hdferr)
  !
  ! For each element read the IST quality flag that takes first two bits and 
  ! store it in a char buffer. This selects all the elements (H5S_ALL)
  !
  CALL H5LTread_bitfield_value_f(qf_dset, num_flags, offset, length, space_id, qf_data0, dim_qf_data0, hdferr)

  CALL H5Sclose_f(space_id, hdferr)
  DO k = 1, num_flags
     IF(qf_data0(k).NE.correct0(k)) GOTO 7
  ENDDO

  CALL PASSED()

  CALL TESTING("H5LTread_bitfield_value, 1D packed ")

  CALL H5Dopen_f(file,"Granule 1", qf_dset, hdferr)
  !
  ! Get dataspace and allocate memory for read buffer. Quality flags dataset
  ! has the same dimensionality as corresponding product dataset;
  ! we are using its dimensions for illustration purposes only.
  !
  CALL H5Dget_space_f(qf_dset, space_id, hdferr)
  CALL H5Sselect_all_f(space_id, hdferr)
  !
  ! For each element read the IST quality flag that takes first two bits and 
  ! store it in a char buffer. This selects all the elements (H5S_ALL)
  !
  CALL H5LTread_bitfield_value_f(qf_dset, num_flags, offset, length, space_id, qf_data1, dim_qf_data1, hdferr)
  CALL H5Sclose_f(space_id, hdferr)
  CALL H5Dclose_f(qf_dset, hdferr)
  DO i = 1, dim0
     DO j = 1, num_flags
        IF(qf_data1(i,j).NE.correct1(i,j)) GOTO 7
     ENDDO
  ENDDO
  
  CALL PASSED()

  CALL TESTING("H5LTread_bitfield_value, 3D packed ")

  CALL H5Dopen_f(file,"Granule 3", qf_dset, hdferr)
  !
  ! Get dataspace and allocate memory for read buffer. Quality flags dataset
  ! has the same dimensionality as corresponding product dataset;
  ! we are using its dimensions for illustration purposes only.
  !
  CALL H5Dget_space_f(qf_dset, space_id, hdferr)
  !
  ! For each element read the IST quality flag that takes first two bits and 
  ! store it in a char buffer. This selects all the elements (H5S_ALL)
  !
  CALL H5LTread_bitfield_value_f(qf_dset, num_flags, offset, length, space_id, qf_data3, dim_qf_data3, hdferr)
  CALL H5Sclose_f(space_id, hdferr)
  CALL H5Dclose_f(qf_dset, hdferr)

  DO l = 1, num_flags
     DO k = 1, dim2
        DO j = 1, dim1
           DO i = 1, dim0
              IF(qf_data3(i,j,k,l).NE.correct3(i,j,k,l)) GOTO 7
           ENDDO
        ENDDO
     ENDDO
  ENDDO
  CALL PASSED()

  RETURN

7 CALL FAILED()
  RETURN
END SUBROUTINE test_read_bitfield