!****p* Program/H5test_kind
!
! NAME
!  Executable: H5test_kind
!
! FILE
!  fortran/src/H5test_kind.f90
!
! PURPOSE
!  This stand alone program is used at build time to generate the program
!  H5fortran_detect.f90. It cycles through all the available KIND parameters for
!  integers and reals. The appropriate program and subroutines are then generated
!  depending on which of the KIND values are found.
!
! NOTES
!  This program uses the Fortran 2008 intrinsic function STORAGE_SIZE or SIZEOF 
!  depending on availablity.It generates code that makes use of 
!  STORAGE_SIZE/SIZEOF in H5fortran_detect.f90. STORAGE_SIZE is standard
!  compliant and should always be chosen over SIZEOF.
!
!  The availability of STORAGE_SIZE/SIZEOF is checked at configure time and the TRUE/FALSE
!  condition is set in the configure variable "FORTRAN_HAVE_STORAGE_SIZE" or
!  "FORTRAN_HAVE_SIZEOF".
!
!  The use of C_SIZOF(X) is not used since the argument X must be an interoperable
!  data entity.
!
! COPYRIGHT
!  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!  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.       *
!  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
! AUTHOR
!  M. Scot Breitenfeld
!
!*****

#include "H5config_f.inc"

PROGRAM test_kind
  USE, INTRINSIC :: ISO_C_BINDING
  IMPLICIT NONE
  INTEGER :: i, j, ii, ir, last, ikind_numbers(10), rkind_numbers(10)
  INTEGER :: ji, jr, jd
#ifdef H5_FORTRAN_HAVE_C_LONG_DOUBLE
  REAL(KIND=C_LONG_DOUBLE) :: c_longdble
#endif
  REAL(KIND=C_DOUBLE) :: c_dble
  REAL(KIND=C_FLOAT) :: c_flt
  INTEGER :: sizeof_var

  last = -1
  ii = 0

  ikind_numbers = 0
  rkind_numbers = 0

  DO i = 1,100
     j = SELECTED_INT_KIND(i)
     IF(j .NE. last) THEN
        IF(last .NE. -1) THEN
           ii = ii + 1
           ikind_numbers(ii) = last
        ENDIF
        last = j
        IF(j .EQ. -1) EXIT
     ENDIF
  ENDDO

  last = -1
  ir = 0
  DO i = 1,100
     j = SELECTED_REAL_KIND(i)
     IF(j .NE. last) THEN
        IF(last .NE. -1) THEN
           ir = ir + 1
           rkind_numbers(ir) = last
        ENDIF
        last = j
        IF(j .EQ. -1) EXIT
     ENDIF
  ENDDO

!  Generate program information:

WRITE(*,'(40(A,/))') &
'!****h* ROBODoc/H5fortran_detect.f90',&
'!',&
'! NAME',&
'!  H5fortran_detect',&
'! ',&
'! PURPOSE',&
'!  This stand alone program is used at build time to generate the header file',&
'!  H5fort_type_defines.h. The source code itself was automatically generated by',&
'!  the program H5test_kind.f90',&
'!',&
'! COPYRIGHT',&
'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
'!   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.     *',&
'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
'!',&
'! AUTHOR',&
'!  H5test_kind.f90',&
'!',&
'!*****'

! GENERATE A PROGRAM
!
! (a) Generate the module

  WRITE(*,*) "MODULE H5test_kind_mod"
  WRITE(*,*) "USE ISO_C_BINDING"
  WRITE(*,*) "IMPLICIT NONE"
  WRITE(*,*) "CONTAINS"
  j = 0
  ji = KIND(1)
  WRITE(*, "("" SUBROUTINE i"", i2.2,""()"")") j
  WRITE(*,*)"   IMPLICIT NONE"
  WRITE(*,*)"   INTEGER :: a"
  WRITE(*,*)"   INTEGER(C_SIZE_T) :: a_size"
  WRITE(*,*)"   CHARACTER(LEN=2) :: ichr2, jchr2"
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
  WRITE(*,*)"   a_size = STORAGE_SIZE(a, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)"
#else
  WRITE(*,*)"   a_size = SIZEOF(a)"
#endif
  WRITE(*,*)"   WRITE(ichr2,'(I2)') a_size"
  WRITE(*,'(A,I0)')"    WRITE(jchr2,'(I2)') ",ji
  WRITE(*,'(A)')'    WRITE(*,*) "#define H5_FORTRAN_HAS_NATIVE_"'//  &
       "//TRIM(ADJUSTL(ichr2))//"//'"_KIND "'//"//ADJUSTL(jchr2)"
  WRITE(*,*)"   RETURN"
  WRITE(*,*)"END SUBROUTINE"
  jr = 0
  j = KIND(1.0)
  WRITE(*, "("" SUBROUTINE r"", i2.2,""()"")") jr
  WRITE(*,*)"   IMPLICIT NONE"
  WRITE(*,*)"   REAL :: a"
  WRITE(*,*)"   INTEGER(C_SIZE_T) :: a_size"
  WRITE(*,*)"   CHARACTER(LEN=2) :: ichr2, jchr2"
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
  WRITE(*,*)"   a_size = STORAGE_SIZE(a, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)"
#else
  WRITE(*,*)"   a_size = SIZEOF(a)"
#endif
  WRITE(*,*)"   WRITE(ichr2,'(I2)') a_size"
  WRITE(*,'(A,I0)')"    WRITE(jchr2,'(I2)') ",j
  WRITE(*,'(A)')'    WRITE(*,*) "#define H5_FORTRAN_HAS_REAL_NATIVE_"'//  &
       "//TRIM(ADJUSTL(ichr2))//"//'"_KIND "'//"//ADJUSTL(jchr2)"
  WRITE(*,*)"   RETURN"
  WRITE(*,*)"END SUBROUTINE"
  jd = 0
  j = KIND(1.d0)
  WRITE(*, "("" SUBROUTINE d"", i2.2,""()"")") jd
  WRITE(*,*)"   IMPLICIT NONE"
  WRITE(*,*)"   DOUBLE PRECISION :: a"
  WRITE(*,*)"   INTEGER(C_SIZE_T) :: a_size"
  WRITE(*,*)"   CHARACTER(LEN=2) :: ichr2, jchr2"
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
  WRITE(*,*)"   a_size = STORAGE_SIZE(a, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)"
#else
  WRITE(*,*)"   a_size = SIZEOF(a)"
#endif
  WRITE(*,*)"   WRITE(ichr2,'(I2)') a_size"
  WRITE(*,'(A,I0)')"    WRITE(jchr2,'(I2)') ",j
  WRITE(*,'(A)')'    WRITE(*,*) "#define H5_FORTRAN_HAS_DOUBLE_NATIVE_"'//  &
       "//TRIM(ADJUSTL(ichr2))//"//'"_KIND "'//"//ADJUSTL(jchr2)"
  WRITE(*,*)"   RETURN"
  WRITE(*,*)"END SUBROUTINE"
  DO i = 1, ii
     j = ikind_numbers(i)
     WRITE(*, "("" SUBROUTINE i"", i2.2,""()"")") j
     WRITE(*,*)"   IMPLICIT NONE"
     WRITE(*,'(A,I0,A)')"   INTEGER(KIND=",j,") :: a"
     WRITE(*,*)"   INTEGER(C_SIZE_T) :: a_size"
     WRITE(*,*)"   CHARACTER(LEN=2) :: ichr2, jchr2"
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
     WRITE(*,*)"   a_size = STORAGE_SIZE(a, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)"
#else
     WRITE(*,*)"   a_size = SIZEOF(a)"
#endif
     WRITE(*,*)"   WRITE(ichr2,'(I2)') a_size"
     WRITE(*,'(A,I0)')"    WRITE(jchr2,'(I2)') ",j
     WRITE(*,'(A)')'    WRITE(*,*) "#define H5_FORTRAN_HAS_INTEGER_"'//  &
          "//TRIM(ADJUSTL(ichr2))//"//'"_KIND "'//"//ADJUSTL(jchr2)"
     WRITE(*,*)"   RETURN"
     WRITE(*,*)"END SUBROUTINE"
  ENDDO
  DO i = 1, ir
     j = rkind_numbers(i)
     WRITE(*, "("" SUBROUTINE r"", i2.2,""()"")") j
     WRITE(*,*)"   IMPLICIT NONE"
     WRITE(*,'(A,I0,A)')"    REAL(KIND= ",j,") :: a"
     WRITE(*,*)"   INTEGER(C_SIZE_T) :: a_size"
     WRITE(*,*)"   CHARACTER(LEN=2) :: ichr2, jchr2"
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
     WRITE(*,*)"   a_size = STORAGE_SIZE(a, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)"
#else
     WRITE(*,*)"   a_size = SIZEOF(a)"
#endif
     WRITE(*,*)"   WRITE(ichr2,'(I2)') a_size"
     WRITE(*,'(A,I0)')"    WRITE(jchr2,'(I2)') ", j
     WRITE(*,'(A)')'    WRITE(*,*) "#define H5_FORTRAN_HAS_REAL_"'//  &
          "//TRIM(ADJUSTL(ichr2))//"//'"_KIND "'//"//ADJUSTL(jchr2)"
     WRITE(*,*)"   RETURN"
     WRITE(*,*)"END SUBROUTINE"
  ENDDO
  WRITE(*,*) "END MODULE H5test_kind_mod"
  WRITE(*,*) ""

  ! (b) generate the main program

  WRITE(*,*) "PROGRAM H5test_kind"
  WRITE(*,*) "USE H5test_kind_mod"
  WRITE(*,*) "CHARACTER(LEN=2) :: jchr2"
  WRITE(*,*) "WRITE(*,*) "" /*generated header file*/ """
  ji = 0
  WRITE(*, "("" CALL i"", i2.2,""()"")") ji
  jr = 0
  WRITE(*, "("" CALL r"", i2.2,""()"")") jr
  jd = 0
  WRITE(*, "("" CALL d"", i2.2,""()"")") jd
  DO i = 1, ii
     j = ikind_numbers(i)
     WRITE(*, "("" CALL i"", i2.2,""()"")") j
  ENDDO
  DO i = 1, ir
     j = rkind_numbers(i)
     WRITE(*, "("" CALL r"", i2.2,""()"")") j
  ENDDO
#ifdef H5_FORTRAN_HAVE_C_LONG_DOUBLE

# ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
  sizeof_var = STORAGE_SIZE(c_longdble, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
# else
  sizeof_var = SIZEOF(c_longdble)
# endif

  WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_LONG_DOUBLE
  WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_KIND "'//"//ADJUSTL(jchr2)"
  WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var
  WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_SIZEOF "'//"//ADJUSTL(jchr2)"
#else
  WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_KIND -1"'
  WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_SIZEOF -1"'
#endif

#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
  sizeof_var = STORAGE_SIZE(c_dble, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
#else
  sizeof_var = SIZEOF(c_dble)
#endif
  WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_DOUBLE
  WRITE(*,'(A)')' WRITE(*,*) "#define C_DOUBLE_KIND "'//"//ADJUSTL(jchr2)"
  WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var
  WRITE(*,'(A)')' WRITE(*,*) "#define C_DOUBLE_SIZEOF "'//"//ADJUSTL(jchr2)"

#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
  sizeof_var = STORAGE_SIZE(c_flt, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
#else
  sizeof_var = SIZEOF(c_flt)
#endif
  WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_FLOAT
  WRITE(*,'(A)')' WRITE(*,*) "#define C_FLOAT_KIND "'//"//ADJUSTL(jchr2)"
  WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var
  WRITE(*,'(A)')' WRITE(*,*) "#define C_FLOAT_SIZEOF "'//"//ADJUSTL(jchr2)"

  WRITE(*,*) "END PROGRAM H5test_kind"

END PROGRAM test_kind