Implicit statement oddities

Having been wrong earlier today on the IMPLICIT statement in the “Why no punch_unit in iso_fortran_env?” topic, I thought it worth while to clarify the point in case others may also have been confused, and to start a new topic because its main focus is not Humor.

Fortran standards from f90 onwards say that a program unit may have a PARAMETER statement before an IMPLICIT statement other than IMPLICIT NONE. But declaration of a parameter may not precede an IMPLICIT statement in the same program unit. However such parameters are allowed in an IMPLICIT statement if they are accessed by other means. This example uses host association.

program testwp
  integer,parameter:: wp = selected_real_kind(18)
  call usewp
contains
  subroutine usewp
    implicit complex(wp) (i)
    i=(0,1)
    print *,i
  end subroutine usewp
end program testwp

That program compiled and ran with both gfortran and ifort, but with different outputs because ifort treated wp as if it had been selected_real_kind(33).
So did this example which declares wp in a module used in the program.

module WorkingPrecision
  integer,parameter:: wp = selected_real_kind(18)
end module WorkingPrecision

program testwp
  use WorkingPrecision,only:wp
  implicit complex(wp) (i)
  i=(0,1)
  print *,i
end program testwp

The reason for the different results is that gfortran has a real kind between double and quadruple precision and Intel Fortran does not. The working precision turns out to be different for the two compilers, as can be verified by the program below:

program check
    implicit none

    integer, parameter :: wp = selected_real_kind(18)
    integer, parameter :: qp = selected_real_kind(22)

    real(wp)         :: x_wp
    real(qp)         :: x_qp
    double precision :: x_dble

    write(*,*) 'Kind wp (parameter):      ', kind(x_wp), wp
    write(*,*) 'Kind double precision:    ', kind(x_dble)
    write(*,*) 'Kind quadruple precision: ', kind(x_qp), qp
end program check

1 Like

Interesting, what precision is that? On my M1 Mac (homebrew gfortran) it’s not available:

test_precision.f90:7:12:

    7 |     real(wp)         :: x_wp
      |            1
Error: Kind -1 not supported for type REAL at (1)

It would either be a buggy 80 bit, or double-double (which is ~106 bits of significand). If it’s not available on M1, it’s probably 80 bit based on x87 instructions.

18 decimals means either quadruple precision or extended precision. Apparently neither is available for your version of gfortran. You can use the REAL_ARRAYS array in ISO_FORTRAN_ENV to find out which kinds are supported.

You’re right, real_kinds == [4,8] on my machine, so, no quadmath library either apparently.