A very ugly set of tests of some complex value features might be useful as a starting point for anyone that wants to make a test program … gfortran 15 passes it, and it hits some dusty corners. Not sure how obvious some of the answers should be, so it definitely needs more assert-like tests and beautified, etc.
complex value tests
program testit
use, intrinsic :: iso_fortran_env, only : real32, real64, real128
implicit none
character(len=*),parameter :: it='(*(1x,g0))'
character(len=*),parameter :: break='(/,80("-"),t4,a)'
integer,parameter :: dp = kind(1.0d0)
complex(dp),parameter :: x = (1d0,2d0)/3d0
real(dp),parameter :: re = x%re
real(dp),parameter :: ri = x%im
complex :: z4
complex :: zr = (1.0, 2.0)
complex :: zthree(3)
complex(kind=dp) :: z8
complex(kind=dp) :: zd=cmplx(4.0e0_dp,5.0e0_dp,kind=dp)
doubleprecision :: xd=huge(0.0d0)
integer :: i
real(kind=dp) :: precise =1.2345678901234567d0
! basic
z4%re = -3 ! ze%im will not be properly defined
print *,z4
z4 = cmplx(-3) ! ok even with an integer value, result of cmplx with no kind always default complex kind
print *,z4
! treat a complex as two real values when using a format
print '(1x,g0,1x,g0,1x,g0)','z4=',z4
! components defined as components of a complex value
print "(2f18.15)",re,ri
z4 = cmplx(1.e0, 2.e0)
z8 = cmplx(3.e0_real64, 4.e0_real64,kind=real64)
print it, 'value=',z4
print it, 'imaginary part=',aimag(z4),'or', z4%im
print it, 'kinds other than the default may be supported'
print it, 'value=',z8
print it, 'imaginary part=',aimag(z8),'or', z8%im
print break, 'an elemental function can be passed an array'
zthree=[z4,z4/2.0,z4+z4]
print it, 'given a complex array:'
print it, (zthree(i),new_line('a'),i=1,size(zthree))
print it, 'the imaginary component is:'
print it, aimag( zthree )
print break, ' working with higher precision values'
! using kind=dp makes it keep doubleprecision precision
! otherwise the result would be of default kind
z8 = cmplx(precise, -precise )
print *, 'lost precision z8=',z8
z8 = cmplx(precise, -precise ,kind=dp)
print *, 'kept precision z8=',z8
print break, 'assignment of constant values does not require cmplx(3)'
! the following is intuitive and works without calling cmplx(3)
! but does not work for variables just constants
z8 = (1.1111111111111111d0, 2.2222222222222222d0 )
print *, 'z8 defined with constants=',z8
print break, 'what happens when you assign a complex to a real?'
precise=z8
print *, 'lhs=',precise,'rhs=',z8
! descriptors are an alternative
print *, real(zr), aimag(zr)
print *, dble(zd), aimag(zd)
write(*,*)xd,real(xd,kind=kind(0.0d0)),dble(xd)
print break, ' elemental '
zthree=cmplx([10,20,30],-1)
print *, all(zthree .eq. [(10,-1),(20,-1),(30,-1)] ),'zthree=',zthree
zthree(1:2)%re=[100,200]
print *, all(zthree.eq.[(100,-1),(200,-1),(30,-1)]),'Array subsection on LHS zthree=',zthree
print break, ' subroutine parameter '
! should be able to get changed return value and use %re and %im on LHS
z8=(3,4)
call doubleup(z8%re)
call doubleup(z8%im)
write(*,*)z8==(6,8),'subroutine z8=',z8
print break, ' LHS and passed to function '
z8=(5,-4)
z8%re=du(z8%re)
z8%im=du(z8%im)
write(*,*)z8==(10,-8),'function and LHS z8=',z8
contains
subroutine doubleup(x)
real(kind=dp),intent(inout) :: x
x=2*x
end subroutine doubleup
function du(x) result(answer)
real(kind=dp),intent(in) :: x
real(kind=dp) :: answer
answer=2*x
end function du
end program testit