The trick of passing an unallocated actual argument only works when the dummy argument does not have the allocatable attribute. The expression present(flex_array) will be false either when the actual argument is not present or when the actual argument is an unallocated array. Here is a modified code that demonstrates this:
module proc_testarrays
integer, parameter :: knd = selected_real_kind(14)
contains
subroutine testarrays (flex, fix)
implicit none
real(kind=knd), optional :: flex(:,:)
real(kind=knd), optional :: fix(:,:)
write(*,*) 'present(flex)=', present(flex)
write(*,*) 'present(fix)=', present(fix)
if (present(flex)) then
!write(*,*) 'allocation status: allocated(flex) = ', allocated(flex)
write(*,*) 'flex = ', flex(:,:)
else if (present(fix)) then
write(*,*) 'fix = ', fix(:,:)
else
write(*,*) 'testarrays: no array was passed!'
end if
return
end subroutine testarrays
end module proc_testarrays
program testcase
use proc_testarrays
implicit none
real(kind=knd), allocatable :: flex_array(:,:)
real(kind=knd) :: fix_array(1,1)
fix_array(:,:) = 1.0_knd
allocate(flex_array(2,2))
flex_array(:,:) = 2.0_knd
write(*,*) 'passing fix_array:'
call testarrays (fix=fix_array)
write(*,*) 'passing allocated flex_array:'
call testarrays (flex=flex_array)
deallocate( flex_array )
write(*,*) 'passing deallocated flex_array:'
call testarrays (flex=flex_array)
write(*,*) 'passing no actual argument:'
call testarrays ()
end program testcase
$ nagfor proc_testarrays.f90 && a.out
NAG Fortran Compiler Release 7.1(Hanzomon) Build 7114
[NAG Fortran Compiler normal termination]
passing fix_array:
present(flex)= F
present(fix)= T
fix = 1.0000000000000000
passing allocated flex_array:
present(flex)= T
present(fix)= F
flex = 2.0000000000000000 2.0000000000000000 2.0000000000000000 2.0000000000000000
passing deallocated flex_array:
present(flex)= F
present(fix)= F
testarrays: no array was passed!
passing no actual argument:
present(flex)= F
present(fix)= F
testarrays: no array was passed!
Notice how the third and fourth calls are treated the same way.
If the dummy argument flex(:,:) has the alocatable attribute, then the program will seg fault in the third call because it will attempt to print an unallocated array.