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:
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.