hdf5/m4/aclocal_fc.f90

! 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 COPYING file, which can be found at the root of the source code       *
!   distribution tree, or in https://www.hdfgroup.org/licenses.               *
!   If you do not have access to either file, you may request a copy from     *
!   help@hdfgroup.org.                                                        *
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
! This file contains all the configure test programs
! used by autotools and cmake. This avoids having to
! duplicate code for both cmake and autotool tests.
! For autotools, a program below is chosen via a
! sed command in aclocal_fc.m4. For cmake, a program
! below is chosen via the macro READ_SOURCE in
! HDF5UseFortran.cmake
!

PROGRAM PROG_FC_ISO_FORTRAN_ENV
  USE, INTRINSIC :: ISO_FORTRAN_ENV
END PROGRAM PROG_FC_ISO_FORTRAN_ENV

PROGRAM PROG_FC_SIZEOF
  i = sizeof(x)
END PROGRAM PROG_FC_SIZEOF

PROGRAM PROG_FC_C_SIZEOF
  USE ISO_C_BINDING
  INTEGER(C_INT) :: a
  INTEGER(C_SIZE_T) :: RESULT
  RESULT = C_SIZEOF(a)
END PROGRAM PROG_FC_C_SIZEOF

PROGRAM PROG_FC_STORAGE_SIZE
  INTEGER :: a
  INTEGER :: RESULT
  RESULT = STORAGE_SIZE(a)
END PROGRAM PROG_FC_STORAGE_SIZE

PROGRAM PROG_FC_HAVE_C_LONG_DOUBLE
  USE ISO_C_BINDING
  REAL(KIND=C_LONG_DOUBLE) :: d
END PROGRAM PROG_FC_HAVE_C_LONG_DOUBLE

PROGRAM PROG_FC_HAVE_F2003_REQUIREMENTS
  USE iso_c_binding
  IMPLICIT NONE
  TYPE(C_PTR) :: ptr
  TYPE(C_FUNPTR) :: funptr
  CHARACTER(LEN=80, KIND=c_char), TARGET :: ichr
  ptr = C_LOC(ichr(1:1))
END PROGRAM PROG_FC_HAVE_F2003_REQUIREMENTS

!---- START ----- Check to see C_LONG_DOUBLE is different from C_DOUBLE
MODULE type_mod
  USE ISO_C_BINDING
  INTERFACE h5t
     MODULE PROCEDURE h5t_c_double
     MODULE PROCEDURE h5t_c_long_double
  END INTERFACE
CONTAINS
  SUBROUTINE h5t_c_double(r)
    REAL(KIND=C_DOUBLE) :: r
  END SUBROUTINE h5t_c_double
  SUBROUTINE h5t_c_long_double(d)
    REAL(KIND=C_LONG_DOUBLE) :: d
  END SUBROUTINE h5t_c_long_double
END MODULE type_mod
PROGRAM PROG_FC_C_LONG_DOUBLE_EQ_C_DOUBLE
  USE ISO_C_BINDING
  USE type_mod
  REAL(KIND=C_DOUBLE)      :: r
  REAL(KIND=C_LONG_DOUBLE) :: d
  CALL h5t(r)
  CALL h5t(d)
END PROGRAM PROG_FC_C_LONG_DOUBLE_EQ_C_DOUBLE
!---- END ------- Check to see C_LONG_DOUBLE is different from C_DOUBLE

!---- START ----- Determine the available KINDs for REALs and INTEGERs
PROGRAM FC_AVAIL_KINDS
      USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : stdout=>OUTPUT_UNIT
      IMPLICIT NONE
      INTEGER :: ik, jk, k, kk, max_decimal_prec
      INTEGER :: prev_rkind, num_rkinds = 1, num_ikinds = 1
      INTEGER, DIMENSION(1:10) :: list_ikinds = -1
      INTEGER, DIMENSION(1:10) :: list_rkinds = -1
      LOGICAL :: new_kind

      ! Find integer KINDs
      list_ikinds(num_ikinds)=SELECTED_INT_KIND(1)
      DO ik = 2, 36
         k = SELECTED_INT_KIND(ik)
         IF(k.LT.0) EXIT
         IF(k.GT.list_ikinds(num_ikinds))THEN
            num_ikinds = num_ikinds + 1
            list_ikinds(num_ikinds) = k
         ENDIF
      ENDDO

      DO k = 1, num_ikinds
         WRITE(stdout,'(I0)', ADVANCE='NO') list_ikinds(k)
         IF(k.NE.num_ikinds)THEN
            WRITE(stdout,'(A)',ADVANCE='NO') ','
         ELSE
            WRITE(stdout,'()')
         ENDIF
      ENDDO

      ! Find real KINDs
      list_rkinds(num_rkinds)=SELECTED_REAL_KIND(1)
      max_decimal_prec = 1
      prev_rkind=list_rkinds(num_rkinds)

      prec: DO ik = 2, 36
         exp: DO jk = 1, 700
            k = SELECTED_REAL_KIND(ik,jk)
            IF(k.LT.0) EXIT exp
            IF(k.NE.prev_rkind)THEN
               ! Check if we already have that kind
               new_kind = .TRUE.
               DO kk = 1, num_rkinds
                  IF(k.EQ.list_rkinds(kk))THEN
                     new_kind=.FALSE.
                     EXIT
                  ENDIF
               ENDDO
               IF(new_kind)THEN
                  num_rkinds = num_rkinds + 1
                  list_rkinds(num_rkinds) = k
                  prev_rkind=list_rkinds(num_rkinds)
               ENDIF
            ENDIF
            max_decimal_prec = ik
         ENDDO exp
      ENDDO prec

      DO k = 1, num_rkinds
         WRITE(stdout,'(I0)', ADVANCE='NO') list_rkinds(k)
         IF(k.NE.num_rkinds)THEN
            WRITE(stdout,'(A)',ADVANCE='NO') ','
         ELSE
            WRITE(stdout,'()')
         ENDIF
      ENDDO

     WRITE(stdout,'(I0)') max_decimal_prec
     WRITE(stdout,'(I0)') num_ikinds
     WRITE(stdout,'(I0)') num_rkinds
END PROGRAM FC_AVAIL_KINDS
!---- END ----- Determine the available KINDs for REALs and INTEGERs

PROGRAM FC_MPI_CHECK
  USE mpi
  INTEGER :: comm, amode, info, fh, ierror
  CHARACTER(LEN=1) :: filename
  CALL MPI_File_open( comm, filename, amode, info, fh, ierror)
END PROGRAM FC_MPI_CHECK