path: root/fortran/src/H5_buildiface.F90

!****p* Program/H5_buildiface
!
! NAME
!  Executable: H5_buildiface
!
! FILE
!  fortran/src/H5_buildiface.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

! These values are valid REAL KINDs (with corresponding C float) found during configure
  H5_H5CONFIG_F_NUM_RKIND
  H5_H5CONFIG_F_RKIND
! These values are valid INTEGER KINDs (with corresponding C float) found during configure
  H5_H5CONFIG_F_NUM_IKIND
  H5_H5CONFIG_F_IKIND

  INTEGER :: i, j, k
  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
  CHARACTER(LEN=2) :: chr2
! subroutine rank of array being passed in
  CHARACTER(LEN=2), DIMENSION(1:8), PARAMETER :: chr_rank=(/"_0","_1","_2","_3","_4","_5","_6","_7"/)
! rank definitions
  CHARACTER(LEN=70), DIMENSION(1:8), PARAMETER :: rank_dim_line=(/ &
       '                                                                    ', &
       ', DIMENSION(dims(1))                                                ', &
       ', DIMENSION(dims(1),dims(2))                                        ', &
       ', DIMENSION(dims(1),dims(2),dims(3))                                ', &
       ', DIMENSION(dims(1),dims(2),dims(3),dims(4))                        ', &
       ', DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5))                ', &
       ', DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6))        ', &
       ', DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7))' &
            /)
! pointer to the buffer
  CHARACTER(LEN=37), DIMENSION(1:8), PARAMETER :: f_ptr_line=(/ &
       '    f_ptr = C_LOC(buf)               ', &
       '    f_ptr = C_LOC(buf(1))            ', &
       '    f_ptr = C_LOC(buf(1,1))          ', &
       '    f_ptr = C_LOC(buf(1,1,1))        ', &
       '    f_ptr = C_LOC(buf(1,1,1,1))      ', &
       '    f_ptr = C_LOC(buf(1,1,1,1,1))    ', &
       '    f_ptr = C_LOC(buf(1,1,1,1,1,1))  ', &
       '    f_ptr = C_LOC(buf(1,1,1,1,1,1,1))' &
            /)

! (a) Generate Fortran H5* interfaces having multiple KIND interfaces.
!
! DEVELOPER'S NOTES:
!
! Only interfaces with arrays of rank 7 and less are provided. Even-though, the F2008 
! standard extended the maximum rank to 15, it was decided that they should use the
! new APIs to handle those use cases. Handling rank 7 and less is for backward compatibility
! with the Fortran 90/95 APIs codes which could never handle rank 15 array sizes.

  OPEN(11,FILE='H5_KINDff.F90')
  WRITE(11,'(40(A,/))') &
'!****h* ROBODoc/H5_KINDff.F90',&
'!',&
'! NAME',&
'!  H5_KIND',&
'! ',&
'! PURPOSE',&
'!  This module is generated at build by H5_buildiface.F90 to handle all the',&
'!  detected REAL KINDs for APIs being passed REAL KINDs. Currently these ',&
'!  are H5A, H5D and H5P APIs',&
'!',&
'! COPYRIGHT',&
'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
'!   Copyright by The HDF Group.                                               *',&
'!   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',&
'!  H5_buildiface.F90',&
'!',&
'!*****'

  WRITE(11,'(a)') "MODULE H5_KIND"

  WRITE(11,'(A)') '  USE, INTRINSIC :: ISO_C_BINDING'
  WRITE(11,'(A)') '  USE H5GLOBAL'

  WRITE(11,'(A)') '  USE H5A'
  WRITE(11,'(A)') '  USE H5D'
  WRITE(11,'(A)') '  USE H5P'
  WRITE(11,'(A)') '  IMPLICIT NONE'
!***************
! H5A INTERFACES
!***************
!
! H5Awrite_f
!
  WRITE(11,'(A)') "  INTERFACE h5awrite_f"
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     DO k = 1, 8
        WRITE(11,'(A)') "     MODULE PROCEDURE h5awrite_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k)
     ENDDO
  END DO
  WRITE(11,'(A)') "  END INTERFACE"

! H5Aread_f
  WRITE(11,'(A)') "  INTERFACE h5aread_f"
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     DO k = 1, 8
        WRITE(11,'(A)') "     MODULE PROCEDURE h5aread_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k)
     ENDDO
  END DO
  WRITE(11,'(A)') "  END INTERFACE"
!***************
! H5D INTERFACES
!***************
!
! H5Dwrite_f
  WRITE(11,'(A)') "  INTERFACE h5dwrite_f"
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     DO k = 1, 8
        WRITE(11,'(A)') "     MODULE PROCEDURE h5dwrite_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k)
     ENDDO
  END DO
  WRITE(11,'(A)') "  END INTERFACE"

! H5Dread_f
  WRITE(11,'(A)') "  INTERFACE h5dread_f"
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     DO k = 1, 8
        WRITE(11,'(A)') "     MODULE PROCEDURE h5dread_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k)
     ENDDO
  END DO
  WRITE(11,'(A)') "  END INTERFACE"

!***************
! H5P INTERFACES
!***************
!
! H5Pset_fill_value_f
  WRITE(11,'(A)') "  INTERFACE h5pset_fill_value_f"
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     WRITE(11,'(A)') "     MODULE PROCEDURE h5pset_fill_value_kind_"//TRIM(ADJUSTL(chr2))
  END DO
  WRITE(11,'(A)') "  END INTERFACE"

! H5Pget_fill_value_f
  WRITE(11,'(A)') "  INTERFACE h5pget_fill_value_f"
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     WRITE(11,'(A)') "     MODULE PROCEDURE h5pget_fill_value_kind_"//TRIM(ADJUSTL(chr2))
  END DO
  WRITE(11,'(A)') "  END INTERFACE"

! H5Pset_f
  WRITE(11,'(A)') "  INTERFACE h5pset_f"
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     WRITE(11,'(A)') "     MODULE PROCEDURE h5pset_kind_"//TRIM(ADJUSTL(chr2))
  END DO
  WRITE(11,'(A)') "  END INTERFACE"

! H5Pget_f
  WRITE(11,'(A)') "  INTERFACE h5pget_f"
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     WRITE(11,'(A)') "     MODULE PROCEDURE h5pget_kind_"//TRIM(ADJUSTL(chr2))
  END DO
  WRITE(11,'(A)') "  END INTERFACE"

! H5Pregister_f
  WRITE(11,'(A)') "  INTERFACE h5pregister_f"
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     WRITE(11,'(A)') "     MODULE PROCEDURE h5pregister_kind_"//TRIM(ADJUSTL(chr2))
  END DO
  WRITE(11,'(A)') "  END INTERFACE"

! H5Pinsert_f
  WRITE(11,'(A)') "  INTERFACE h5pinsert_f"
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     WRITE(11,'(A)') "     MODULE PROCEDURE h5pinsert_kind_"//TRIM(ADJUSTL(chr2))
  END DO
  WRITE(11,'(A)') "  END INTERFACE"

  WRITE(11,'(A)') 'CONTAINS'

!**********************
! H5A APIs
!**********************
!
! H5Awrite_f
  DO i = 1, num_rkinds
     k = rkind(i)
     WRITE(chr2,'(I2)') k
     DO j = 1, 8

! DLL definitions for windows
        WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)'
        WRITE(11,'(A)') '!DEC$attributes dllexport :: h5awrite_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
        WRITE(11,'(A)') '!DEC$endif'

! Subroutine API
        WRITE(11,'(A)') '  SUBROUTINE h5awrite_kind_'//TRIM(ADJUSTL(chr2))&
             &//'_rank'//chr_rank(j)//'(attr_id, memtype_id, buf, dims, hdferr)'
        WRITE(11,'(A)') '    IMPLICIT NONE'
        WRITE(11,'(A)') '    INTEGER(HID_T)    , INTENT(IN) :: attr_id'
        WRITE(11,'(A)') '    INTEGER(HID_T)    , INTENT(IN) :: memtype_id'
        WRITE(11,'(A)') '    INTEGER(HSIZE_T)  , INTENT(IN), DIMENSION(*) :: dims'
        WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf'
        WRITE(11,'(A)') '    INTEGER           , INTENT(OUT) :: hdferr'
        WRITE(11,'(A)') '    TYPE(C_PTR) :: f_ptr'
        
        WRITE(11,'(A)') f_ptr_line(j)
        WRITE(11,'(A)') '    hdferr = H5Awrite_f_c(attr_id, memtype_id, f_ptr)'
        WRITE(11,'(A)') '  END SUBROUTINE h5awrite_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
     ENDDO
  ENDDO
!
! H5Aread_f
  DO i = 1, num_rkinds
     k = rkind(i)
     WRITE(chr2,'(I2)') k
     DO j = 1, 8
! DLL definitions for windows
        WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)'
        WRITE(11,'(A)') '!DEC$attributes dllexport :: h5aread_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
        WRITE(11,'(A)') '!DEC$endif'
! Subroutine API
        WRITE(11,'(A)') '  SUBROUTINE h5aread_kind_'//TRIM(ADJUSTL(chr2))&
             &//'_rank'//chr_rank(j)//'(attr_id, memtype_id, buf, dims, hdferr)'
        WRITE(11,'(A)') '    IMPLICIT NONE'
        WRITE(11,'(A)') '    INTEGER(HID_T)    , INTENT(IN) :: attr_id'
        WRITE(11,'(A)') '    INTEGER(HID_T)    , INTENT(IN) :: memtype_id'
        WRITE(11,'(A)') '    INTEGER(HSIZE_T)  , INTENT(IN), DIMENSION(*) :: dims'
        WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(INOUT)'//TRIM(rank_dim_line(j))//', TARGET :: buf'
        WRITE(11,'(A)') '    INTEGER           , INTENT(OUT) :: hdferr'
        WRITE(11,'(A)') '    TYPE(C_PTR) :: f_ptr'
        
        WRITE(11,'(A)') f_ptr_line(j)
        WRITE(11,'(A)') '    hdferr = H5Aread_f_c(attr_id, memtype_id, f_ptr)'
        WRITE(11,'(A)') '  END SUBROUTINE h5aread_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
     ENDDO
  ENDDO

!**********************
! H5D APIs
!**********************
!
! h5dread_f
  DO i = 1, num_rkinds
     k = rkind(i)
     WRITE(chr2,'(I2)') k
     DO j = 1, 8
! DLL definitions for windows
        WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)'
        WRITE(11,'(A)') '!DEC$attributes dllexport :: h5dread_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
        WRITE(11,'(A)') '!DEC$endif'
! Subroutine API
        WRITE(11,'(A)') '  SUBROUTINE h5dread_kind_'//TRIM(ADJUSTL(chr2))&
             &//'_rank'//chr_rank(j)//'(dset_id, mem_type_id, buf, dims, hdferr, &'
        WRITE(11,'(A)') '       mem_space_id, file_space_id, xfer_prp)'
        WRITE(11,'(A)') '    USE, INTRINSIC :: ISO_C_BINDING'
        WRITE(11,'(A)') '    IMPLICIT NONE'
        WRITE(11,'(A)') '    INTEGER(HID_T), INTENT(IN) :: dset_id'
        WRITE(11,'(A)') '    INTEGER(HID_T), INTENT(IN) :: mem_type_id'
        WRITE(11,'(A)') '    INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims'
        WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(INOUT)'//TRIM(rank_dim_line(j))//', TARGET :: buf'
        WRITE(11,'(A)') '    INTEGER, INTENT(OUT) :: hdferr'
        WRITE(11,'(A)') '    INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id'
        WRITE(11,'(A)') '    INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id'
        WRITE(11,'(A)') '    INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp'
        WRITE(11,'(A)') '    INTEGER(HID_T) :: xfer_prp_default'
        WRITE(11,'(A)') '    INTEGER(HID_T) :: mem_space_id_default'
        WRITE(11,'(A)') '    INTEGER(HID_T) :: file_space_id_default'
        WRITE(11,'(A)') '    TYPE(C_PTR) :: f_ptr'
        WRITE(11,'(A)') '    xfer_prp_default = H5P_DEFAULT_F'
        WRITE(11,'(A)') '    mem_space_id_default = H5S_ALL_F'
        WRITE(11,'(A)') '    file_space_id_default = H5S_ALL_F'
        WRITE(11,'(A)') '    IF(PRESENT(xfer_prp)) xfer_prp_default = xfer_prp'
        WRITE(11,'(A)') '    IF(PRESENT(mem_space_id))  mem_space_id_default = mem_space_id'
        WRITE(11,'(A)') '    IF(PRESENT(file_space_id)) file_space_id_default = file_space_id'
        WRITE(11,'(A)') f_ptr_line(j)
        WRITE(11,'(A)') '    hdferr = h5dread_f_c(dset_id, mem_type_id, mem_space_id_default, &'
        WRITE(11,'(A)') '         file_space_id_default, xfer_prp_default, f_ptr)'
        WRITE(11,'(A)') '  END SUBROUTINE h5dread_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)

     ENDDO
  ENDDO
!
! h5dwrite_f
  DO i = 1, num_rkinds
     k = rkind(i)
     WRITE(chr2,'(I2)') k
     DO j = 1, 8
! DLL definitions for windows
        WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)'
        WRITE(11,'(A)') '!DEC$attributes dllexport :: h5dwrite_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
        WRITE(11,'(A)') '!DEC$endif'
! Subroutine API
        WRITE(11,'(A)') '  SUBROUTINE h5dwrite_kind_'//TRIM(ADJUSTL(chr2))&
             &//'_rank'//chr_rank(j)//'(dset_id, mem_type_id, buf, dims, hdferr, &'
        WRITE(11,'(A)') '       mem_space_id, file_space_id, xfer_prp)'
        WRITE(11,'(A)') '    USE, INTRINSIC :: ISO_C_BINDING'
        WRITE(11,'(A)') '    IMPLICIT NONE'
        WRITE(11,'(A)') '    INTEGER(HID_T), INTENT(IN) :: dset_id'
        WRITE(11,'(A)') '    INTEGER(HID_T), INTENT(IN) :: mem_type_id'
        WRITE(11,'(A)') '    INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims'
        WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf'
        WRITE(11,'(A)') '    INTEGER, INTENT(OUT) :: hdferr'
        WRITE(11,'(A)') '    INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id'
        WRITE(11,'(A)') '    INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id'
        WRITE(11,'(A)') '    INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp'
        WRITE(11,'(A)') '    INTEGER(HID_T) :: xfer_prp_default'
        WRITE(11,'(A)') '    INTEGER(HID_T) :: mem_space_id_default'
        WRITE(11,'(A)') '    INTEGER(HID_T) :: file_space_id_default'
        WRITE(11,'(A)') '    TYPE(C_PTR) :: f_ptr'
        WRITE(11,'(A)') '    xfer_prp_default  = H5P_DEFAULT_F'
        WRITE(11,'(A)') '    mem_space_id_default = H5S_ALL_F'
        WRITE(11,'(A)') '    file_space_id_default = H5S_ALL_F'
        WRITE(11,'(A)') '    IF(PRESENT(xfer_prp)) xfer_prp_default = xfer_prp'
        WRITE(11,'(A)') '    IF(PRESENT(mem_space_id))  mem_space_id_default = mem_space_id'
        WRITE(11,'(A)') '    IF(PRESENT(file_space_id)) file_space_id_default = file_space_id'
        WRITE(11,'(A)') f_ptr_line(j)
        WRITE(11,'(A)') '    hdferr = h5dwrite_f_c(dset_id, mem_type_id, mem_space_id_default, &'
        WRITE(11,'(A)') '         file_space_id_default, xfer_prp_default, f_ptr)'
        WRITE(11,'(A)') '  END SUBROUTINE h5dwrite_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
     ENDDO
  ENDDO

!**********************
! H5P APIs
!**********************
!
! H5Pset_fill_value_f
  DO i = 1, num_rkinds
     k = rkind(i)
     WRITE(chr2,'(I2)') k
! DLL definitions for windows
     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)'
     WRITE(11,'(A)') '!DEC$attributes dllexport :: h5pset_fill_value_kind_'//TRIM(ADJUSTL(chr2))
     WRITE(11,'(A)') '!DEC$endif'
! Subroutine API
     WRITE(11,'(A)') '  SUBROUTINE h5pset_fill_value_kind_'//TRIM(ADJUSTL(chr2))&
          &//'(prp_id, type_id, fillvalue, hdferr)'
     WRITE(11,'(A)') '    IMPLICIT NONE'
     WRITE(11,'(A)') '    INTEGER(HID_T), INTENT(IN) :: prp_id'
     WRITE(11,'(A)') '    INTEGER(HID_T), INTENT(IN) :: type_id'
     WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'), INTENT(IN), TARGET :: fillvalue' 
     WRITE(11,'(A)') '    INTEGER, INTENT(OUT) :: hdferr '
     WRITE(11,'(A)') '    TYPE(C_PTR) :: f_ptr '
     WRITE(11,'(A)') '    f_ptr = C_LOC(fillvalue)'
     WRITE(11,'(A)') '    hdferr = h5pset_fill_value_c(prp_id, type_id, f_ptr)'
     WRITE(11,'(A)') '  END SUBROUTINE h5pset_fill_value_kind_'//TRIM(ADJUSTL(chr2))
  ENDDO

! H5Pget_fill_value_f
  DO i = 1, num_rkinds
     k = rkind(i)
     WRITE(chr2,'(I2)') k
! DLL definitions for windows
     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)'
     WRITE(11,'(A)') '!DEC$attributes dllexport :: h5pget_fill_value_kind_'//TRIM(ADJUSTL(chr2))
     WRITE(11,'(A)') '!DEC$endif'
! Subroutine API
     WRITE(11,'(A)') '  SUBROUTINE h5pget_fill_value_kind_'//TRIM(ADJUSTL(chr2))&
          &//'(prp_id, type_id, fillvalue, hdferr)'
     WRITE(11,'(A)') '    IMPLICIT NONE'
     WRITE(11,'(A)') '    INTEGER(HID_T), INTENT(IN) :: prp_id'
     WRITE(11,'(A)') '    INTEGER(HID_T), INTENT(IN) :: type_id'
     WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'), INTENT(OUT), TARGET :: fillvalue'
     WRITE(11,'(A)') '    INTEGER, INTENT(OUT) :: hdferr'
     WRITE(11,'(A)') '    TYPE(C_PTR) :: f_ptr'
     WRITE(11,'(A)') '    f_ptr = C_LOC(fillvalue)'
     WRITE(11,'(A)') '    hdferr = h5pget_fill_value_c(prp_id, type_id, f_ptr)'
     WRITE(11,'(A)') '  END SUBROUTINE h5pget_fill_value_kind_'//TRIM(ADJUSTL(chr2))
  ENDDO

! H5Pset_f
  DO i = 1, num_rkinds
     k = rkind(i)
     WRITE(chr2,'(I2)') k
! DLL definitions for windows
     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)'
     WRITE(11,'(A)') '!DEC$attributes dllexport :: h5pset_kind_'//TRIM(ADJUSTL(chr2))
     WRITE(11,'(A)') '!DEC$endif'
! Subroutine API
     WRITE(11,'(A)') '  SUBROUTINE h5pset_kind_'//TRIM(ADJUSTL(chr2))&
          &//'(prp_id, name, value, hdferr)'
     WRITE(11,'(A)') '    IMPLICIT NONE'
     WRITE(11,'(A)') '    INTEGER(HID_T), INTENT(IN) :: prp_id'
     WRITE(11,'(A)') '    CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name'
     WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'), INTENT(IN), TARGET :: value'
     WRITE(11,'(A)') '    INTEGER, INTENT(OUT) :: hdferr'
     WRITE(11,'(A)') '    INTEGER :: name_len'
     WRITE(11,'(A)') '    TYPE(C_PTR) :: f_ptr'
     WRITE(11,'(A)') '    f_ptr = C_LOC(value)'
     WRITE(11,'(A)') '    name_len = LEN(name)'
     WRITE(11,'(A)') '    hdferr = h5pget_c(prp_id, name, name_len, f_ptr)'
     
     WRITE(11,'(A)') '  END SUBROUTINE h5pset_kind_'//TRIM(ADJUSTL(chr2))
  ENDDO

! H5Pget_f
  DO i = 1, num_rkinds
     k = rkind(i)
     WRITE(chr2,'(I2)') k
! DLL definitions for windows
     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)'
     WRITE(11,'(A)') '!DEC$attributes dllexport :: h5pget_kind_'//TRIM(ADJUSTL(chr2))
     WRITE(11,'(A)') '!DEC$endif'
! Subroutine API
     WRITE(11,'(A)') '  SUBROUTINE h5pget_kind_'//TRIM(ADJUSTL(chr2))&
          &//'(prp_id, name, value, hdferr)'
     WRITE(11,'(A)') '    IMPLICIT NONE'
     WRITE(11,'(A)') '    INTEGER(HID_T), INTENT(IN) :: prp_id'
     WRITE(11,'(A)') '    CHARACTER(LEN=*), INTENT(IN) :: name'
     WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'),   INTENT(OUT), TARGET :: value'
     WRITE(11,'(A)') '    INTEGER, INTENT(OUT) :: hdferr'
     WRITE(11,'(A)') '    INTEGER :: name_len'
     WRITE(11,'(A)') '    TYPE(C_PTR) :: f_ptr'
     WRITE(11,'(A)') '    f_ptr = C_LOC(value)'
     WRITE(11,'(A)') '    name_len = LEN(name)'
     WRITE(11,'(A)') '    hdferr = h5pget_c(prp_id, name, name_len, f_ptr)'
     WRITE(11,'(A)') '  END SUBROUTINE h5pget_kind_'//TRIM(ADJUSTL(chr2))
  ENDDO

! H5Pregister_f
  DO i = 1, num_rkinds
     k = rkind(i)
     WRITE(chr2,'(I2)') k
! DLL definitions for windows
     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)'
     WRITE(11,'(A)') '!DEC$attributes dllexport :: h5pregister_kind_'//TRIM(ADJUSTL(chr2))
     WRITE(11,'(A)') '!DEC$endif'
! Subroutine API
     WRITE(11,'(A)') 'SUBROUTINE h5pregister_kind_'//TRIM(ADJUSTL(chr2))&
          &//'(class, name, size, value, hdferr)'
     WRITE(11,'(A)') '  IMPLICIT NONE'
     WRITE(11,'(A)') '  INTEGER(HID_T), INTENT(IN) :: class'
     WRITE(11,'(A)') '  CHARACTER(LEN=*), INTENT(IN) :: name'
     WRITE(11,'(A)') '  INTEGER(SIZE_T), INTENT(IN) :: size'
     WRITE(11,'(A)') '  REAL(KIND='//TRIM(ADJUSTL(chr2))//'), INTENT(IN), TARGET :: value'
     WRITE(11,'(A)') '  INTEGER, INTENT(OUT) :: hdferr'
     WRITE(11,'(A)') '  INTEGER :: name_len'
     WRITE(11,'(A)') '  TYPE(C_PTR) :: f_ptr'
     WRITE(11,'(A)') '  f_ptr = C_LOC(value)'
     WRITE(11,'(A)') '  name_len = LEN(name)'
     WRITE(11,'(A)') '  hdferr = h5pregister_c(class, name, name_len, size, f_ptr)'
     WRITE(11,'(A)') 'END SUBROUTINE h5pregister_kind_'//TRIM(ADJUSTL(chr2))
  ENDDO

! H5Pinsert_f
  DO i = 1, num_rkinds
     k = rkind(i)
     WRITE(chr2,'(I2)') k
! DLL definitions for windows
     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)'
     WRITE(11,'(A)') '!DEC$attributes dllexport :: h5pinsert_kind_'//TRIM(ADJUSTL(chr2))
     WRITE(11,'(A)') '!DEC$endif'
! Subroutine API
     WRITE(11,'(A)') '  SUBROUTINE h5pinsert_kind_'//TRIM(ADJUSTL(chr2))&
          &//'(plist, name, size, value, hdferr)'
     WRITE(11,'(A)') '    IMPLICIT NONE'
     WRITE(11,'(A)') '    INTEGER(HID_T), INTENT(IN) :: plist'
     WRITE(11,'(A)') '    CHARACTER(LEN=*), INTENT(IN) :: name'
     WRITE(11,'(A)') '    INTEGER(SIZE_T), INTENT(IN) :: size'
     WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'),   INTENT(IN), TARGET :: value'
     WRITE(11,'(A)') '    INTEGER, INTENT(OUT) :: hdferr'
     WRITE(11,'(A)') '    INTEGER :: name_len'
     WRITE(11,'(A)') '    TYPE(c_ptr) :: f_ptr'
     WRITE(11,'(A)') '    f_ptr = c_loc(value)'
     WRITE(11,'(A)') '    name_len = LEN(name)'
     WRITE(11,'(A)') '    hdferr = h5pinsert_c(plist, name , name_len, size, f_ptr)'
     WRITE(11,'(A)') '  END SUBROUTINE h5pinsert_kind_'//TRIM(ADJUSTL(chr2))
  ENDDO

  WRITE(11,'(A)') 'END MODULE H5_KIND'

  CLOSE(11)

! (b) Generate Fortran Check routines for the tests KIND interfaces.

  OPEN(11,FILE='../test/tf_gen.F90')
  WRITE(11,'(40(A,/))') &
'!****h* ROBODoc/TH5_MISC_gen.F90',&
'!',&
'! NAME',&
'!  TH5_MISC_gen',&
'! ',&
'! PURPOSE',&
'!  This module is generated at build by H5_buildiface.F90 to handle checking ',&
'!  in the tests all the detected KINDs.',&
'!',&
'! COPYRIGHT',&
'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
'!   Copyright by The HDF Group.                                               *',&
'!   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',&
'!  H5_buildiface.F90',&
'!',&
'!*****'

  WRITE(11,'(a)') "MODULE TH5_MISC_gen"

  WRITE(11,'(A)') '  USE, INTRINSIC :: ISO_C_BINDING'
  WRITE(11,'(A)') '  USE H5GLOBAL'
  
! Interfaces for validating REALs, INTEGERs, CHARACTERs, LOGICALs

  WRITE(11,'(A)') '  INTERFACE verify'
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     WRITE(11,'(A)') "     MODULE PROCEDURE verify_real_kind_"//TRIM(ADJUSTL(chr2))
  END DO
  DO i = 1, num_ikinds
     j = ikind(i)
     WRITE(chr2,'(I2)') j
     WRITE(11,'(A)') "     MODULE PROCEDURE verify_integer_kind_"//TRIM(ADJUSTL(chr2))
  END DO
  WRITE(11,'(A)') "     MODULE PROCEDURE verify_character"
  WRITE(11,'(A)') "     MODULE PROCEDURE verify_logical"
  WRITE(11,'(A)') "  END INTERFACE"

  WRITE(11,'(A)') '  INTERFACE check_real_eq'
  DO i = 1, num_rkinds
     j = rkind(i)
     WRITE(chr2,'(I2)') j
     WRITE(11,'(A)') "     MODULE PROCEDURE real_eq_kind_"//TRIM(ADJUSTL(chr2))
  END DO
  WRITE(11,'(A)') "  END INTERFACE"

  WRITE(11,'(A)') 'CONTAINS'

! ***************************
! VALIDATE INTEGERS
! ***************************
  DO i = 1, num_ikinds
     k = ikind(i)
     WRITE(chr2,'(I2)') k
! DLL definitions for windows
     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
     WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_integer_kind_'//TRIM(ADJUSTL(chr2))
     WRITE(11,'(A)') '!DEC$endif'

! Subroutine API
     WRITE(11,'(A)') '  SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error)'
     WRITE(11,'(A)') '    IMPLICIT NONE'
     WRITE(11,'(A)') '    CHARACTER(LEN=*) :: string'
     WRITE(11,'(A)') '    INTEGER(KIND='//TRIM(ADJUSTL(chr2))//') :: value, correct_value'
     WRITE(11,'(A)') '    INTEGER :: total_error'
     WRITE(11,'(A)') '    IF (value .NE. correct_value) THEN'
     WRITE(11,'(A)') '       total_error=total_error+1'
     WRITE(11,'(A)') '       WRITE(*,*) "ERROR: INCORRECT INTEGER VALIDATION ", string'
     WRITE(11,'(A)') '    ENDIF'
     WRITE(11,'(A)') '  END SUBROUTINE verify_integer_kind_'//TRIM(ADJUSTL(chr2))
 ENDDO

! ***************************
! VALIDATE REALS
! ***************************
  DO i = 1, num_rkinds
     k = rkind(i)
     WRITE(chr2,'(I2)') k
! DLL definitions for windows
     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
     WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_real_kind_'//TRIM(ADJUSTL(chr2))
     WRITE(11,'(A)') '!DEC$endif'
    
! Subroutine API 
     WRITE(11,'(A)') '  SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error)'
     WRITE(11,'(A)') '    IMPLICIT NONE'
     WRITE(11,'(A)') '    CHARACTER(LEN=*) :: string'
     WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//') :: value, correct_value'
     WRITE(11,'(A)') '    INTEGER :: total_error'
     WRITE(11,'(A)') '    IF (.NOT.real_eq_kind_'//TRIM(ADJUSTL(chr2))//'( value, correct_value) ) THEN'
     WRITE(11,'(A)') '       total_error=total_error+1'
     WRITE(11,'(A)') '       WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string'
     WRITE(11,'(A)') '    ENDIF'
     WRITE(11,'(A)') '  END SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2))


! ***********************************
! TEST IF TWO REAL NUMBERS ARE EQUAL
! ***********************************

     WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
     WRITE(11,'(A)') '!DEC$attributes dllexport :: real_eq_kind_'//TRIM(ADJUSTL(chr2))
     WRITE(11,'(A)') '!DEC$endif'
     WRITE(11,'(A)') '  LOGICAL FUNCTION real_eq_kind_'//TRIM(ADJUSTL(chr2))//'(a,b)'
     WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'), INTENT (in):: a,b'
     WRITE(11,'(A)') '    REAL(KIND='//TRIM(ADJUSTL(chr2))//'), PARAMETER :: eps = 1.e-8'
     WRITE(11,'(A)') '    real_eq_kind_'//TRIM(ADJUSTL(chr2))//' = ABS(a-b) .LT. eps'
     WRITE(11,'(A)') '  END FUNCTION real_eq_kind_'//TRIM(ADJUSTL(chr2))
  ENDDO

! ***************************
! VALIDATE CHARACTER STRINGS
! ***************************

! DLL definitions for windows
  WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
  WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_character'
  WRITE(11,'(A)') '!DEC$endif'

! Subroutine API 
  WRITE(11,'(A)') '  SUBROUTINE verify_character(string,value,correct_value,total_error)'
  WRITE(11,'(A)') '    IMPLICIT NONE'
  WRITE(11,'(A)') '    CHARACTER*(*) :: string'
  WRITE(11,'(A)') '    CHARACTER*(*) :: value, correct_value'
  WRITE(11,'(A)') '    INTEGER :: total_error'
  WRITE(11,'(A)') '    IF (TRIM(value) .NE. TRIM(correct_value)) THEN'
  WRITE(11,'(A)') '       total_error = total_error + 1'
  WRITE(11,'(A)') '       WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string'
  WRITE(11,'(A)') '    ENDIF'
  WRITE(11,'(A)') '  END SUBROUTINE verify_character'

! ***************************
! VALIDATE LOGICAL
! ***************************

! DLL definitions for windows
  WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
  WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_logical'
  WRITE(11,'(A)') '!DEC$endif'
! Subroutine API
  WRITE(11,'(A)') '  SUBROUTINE verify_logical(string,value,correct_value,total_error)'
  WRITE(11,'(A)') '    CHARACTER(LEN=*) :: string'
  WRITE(11,'(A)') '    LOGICAL :: value, correct_value'
  WRITE(11,'(A)') '    INTEGER :: total_error'
  WRITE(11,'(A)') '    IF (value .NEQV. correct_value) THEN'
  WRITE(11,'(A)') '       total_error = total_error + 1'
  WRITE(11,'(A)') '       WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string'
  WRITE(11,'(A)') '    ENDIF'
  
  WRITE(11,'(A)') '  END SUBROUTINE verify_logical'



  WRITE(11,'(A)') "END MODULE TH5_MISC_gen"

  CLOSE(11)

END PROGRAM test_kind