Hello again.
The following relates to my previous two postings to this mailing list.
The code below compiles to give different results on different compilers:
----------------------------------------------------
Sun Fortran 95 7.1 EA2 (Early Access Compiler) on a SUN Fire 6800 gives what I
expected and wanted. With all possible debug and standards checking options
turned on, I get no warnings or errors etc, and the results:
DO-IF: nonpointer version
logical_array: T T F F T T
integer_array: 1 -1 2 -2 0 0 0 0 5 -5 6 -6
DO-WHERE: nonpointer version
logical_array: T T F F T T
integer_array: 1 -1 2 -2 0 0 0 0 5 -5 6 -6
FORALL-WHERE: non_pointer version
logical_array: T T F F T T
integer_array: 1 -1 2 -2 0 0 0 0 5 -5 6 -6
DO-IF: pointer version
logical_array: T T F F T T
integer_array: 1 -1 2 -2 0 0 0 0 5 -5 6 -6
DO-WHERE: pointer version
logical_array: T T F F T T
integer_array: 1 -1 2 -2 0 0 0 0 5 -5 6 -6
FORALL-WHERE: pointer version
logical_array: T T F F T T
integer_array: 1 -1 2 -2 0 0 0 0 5 -5 6 -6
----------------------------------------------------
Compaq Visual Fortran 6.6B, on a PC running Windows ME. With all possible debug
and standards checking options turned on I get the following warning:
Compiling Fortran...
C:\PhD\Fem\fortran\test_where_project\test_where_prog.f90
C:\PhD\Fem\fortran\test_where_project\test_where_prog.f90(212) : Warning: In the
call to ELEMENTAL_POINTER_FUN, actual argument #1 does not match the type and
kind of the corresponding dummy argument.
FORALL (i=1_I4:3_I4:1_I4)
---^
Linking...
test_where_project.exe - 0 error(s), 1 warning(s)
This warning corresponds to the FORALL in the FORALL-WHERE pointer version
below. The kind and type match in the DO-WHERE pointer version, so I don't
understand why the compiler thinks they don't in the FORALL-WHERE pointer
version. The results I get are...
DO-IF: nonpointer version
logical_array: T T F F T T
integer_array: 1 -1 2 -2 0 0 0 0 5 -5 6 -6
DO-WHERE: nonpointer version
logical_array: T T F F T T
integer_array: 1 -1 2 -2 0 0 0 0 5 -5 6 -6
FORALL-WHERE: non_pointer version
logical_array: T T F F T T
integer_array: 1 -1 2 -2 0 0 0 0 0 0 0 0
DO-IF: pointer version
logical_array: T T F F T T
integer_array: 1 -1 2 -2 0 0 0 0 5 -5 6 -6
DO-WHERE: pointer version
logical_array: T T F F T T
integer_array: 1 -1 2 -2 0 0 0 0 5 -5 6 -6
FORALL-WHERE: pointer version
logical_array: T T F F T T
integer_array: ****** 0 0****** 0 0****** 0 0
forrtl: error (63): output conversion error, unit -1, file CONOUT$
----------------------------------------------------
The results given by the two compilers are different for both the pointer and
non-pointer FORALL-WHERE versions. I realise that just because the SUN compiler
is doing what I expected and wanted, doesn't mean that the Compaq compiler is
wrong. It could be that my code doesn't adhere to the standard, but neither of
the compilers pick this up properly.
If anyone has the time and strength to take a look at my code, tell me whether
they think it is standard conforming, or what they think the correct results
should be, or to just try the code on a different compiler, I'd be grateful.
Thanks alot,
Paul
!==============================================================================
MODULE kind_mod
IMPLICIT NONE
PRIVATE
INTEGER, PUBLIC, PARAMETER :: I4=SELECTED_INT_KIND(9)
INTEGER, PUBLIC, PARAMETER :: TF=KIND(.TRUE._I4)
END MODULE kind_mod
!==============================================================================
MODULE pointer_mod
USE kind_mod, ONLY : I4
IMPLICIT NONE
PRIVATE
TYPE, PUBLIC :: pointer_vector_I4
INTEGER(I4), POINTER, DIMENSION(:) :: vect
END TYPE pointer_vector_I4
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE p_vect_I4_equals_p_vect_I4_sub
END INTERFACE
PUBLIC :: ASSIGNMENT(=)
CONTAINS
!---------------------------------------------------------------------------
PURE ELEMENTAL SUBROUTINE p_vect_I4_equals_p_vect_I4_sub(a1, a2)
! Redefines the default assignment of pointer_vector_I4 types,
! a1%vect=>a2%vect
! so that instead
! a1%vect=a2%vect
IMPLICIT NONE
TYPE(pointer_vector_I4), INTENT(OUT) :: a1
TYPE(pointer_vector_I4), INTENT(IN) :: a2
a1%vect = a2%vect
END SUBROUTINE p_vect_I4_equals_p_vect_I4_sub
!---------------------------------------------------------------------------
END MODULE pointer_mod
!==============================================================================
PROGRAM test_prog
USE pointer_mod, ONLY : pointer_vector_I4, ASSIGNMENT(=)
USE kind_mod, ONLY : I4, TF
IMPLICIT NONE
INTEGER(I4), DIMENSION(12_I4), TARGET :: integer_array
LOGICAL(TF), DIMENSION(2_I4,3_I4) :: logical_array
TYPE(pointer_vector_I4), DIMENSION(6_I4) :: p_vect
INTEGER(I4) :: i
! Initialisation...
logical_array(:,1_I4:3_I4:2_I4)=.TRUE._TF
logical_array(:,2_I4)=.FALSE._TF
DO i=1_I4,6_I4
p_vect(i)%vect => integer_array((2_I4*i-1_I4):(2_I4*i))
END DO
! **************************************************************************
! Version 1: DO-IF nonpointer version
! **************************************************************************
integer_array=0_I4
PRINT *,''
PRINT *,'DO-IF: nonpointer version'
DO i=1_I4,3_I4,1_I4
IF (logical_array(1_I4,i)) THEN
integer_array(4_I4*i-3_I4)=&
& elemental_nonpointer_fun(2_I4*i-1_I4)
integer_array(4_I4*i-2_I4)=&
& -elemental_nonpointer_fun(2_I4*i-1_I4)
ELSE
integer_array(4_I4*i-3_I4)=&
& elemental_nonpointer_fun(0_I4)
integer_array(4_I4*i-2_I4)=&
& -elemental_nonpointer_fun(0_I4)
END IF
IF (logical_array(2_I4,i)) THEN
integer_array(4_I4*i-1_I4)=&
& elemental_nonpointer_fun(2_I4*i)
integer_array(4_I4*i)=&
& -elemental_nonpointer_fun(2_I4*i)
ELSE
integer_array(4_I4*i-1_I4)=&
& elemental_nonpointer_fun(0_I4)
integer_array(4_I4*i)=&
& -elemental_nonpointer_fun(0_I4)
END IF
END DO
PRINT '(A,6L6)', 'logical_array: ',logical_array
PRINT '(A,12I3)', 'integer_array: ',integer_array
! **************************************************************************
! Version 2: DO-WHERE nonpointer version
! **************************************************************************
integer_array=0_I4
PRINT *,''
PRINT *,'DO-WHERE: nonpointer version'
DO i=1_I4,3_I4,1_I4
WHERE(logical_array((/1_I4,2_I4/),i))
integer_array((4_I4*i-3_I4):(4_I4*i-1_I4):2_I4)=&
& elemental_nonpointer_fun((/(2_I4*i-1_I4),(2_I4*i)/))
integer_array((4_I4*i-2_I4):(4_I4*i):2_I4)=&
& -elemental_nonpointer_fun((/(2_I4*i-1_I4),(2_I4*i)/))
ELSEWHERE
integer_array((4_I4*i-3_I4):(4_I4*i-1_I4):2_I4)=&
& elemental_nonpointer_fun((/0_I4,0_I4/))
integer_array((4_I4*i-2_I4):(4_I4*i):2_I4)=&
& -elemental_nonpointer_fun((/0_I4,0_I4/))
END WHERE
END DO
PRINT '(A,6L6)', 'logical_array: ',logical_array
PRINT '(A,12I3)', 'integer_array: ',integer_array
! **************************************************************************
! Version 3: FORALL-WHERE nonpointer_version
! **************************************************************************
integer_array=0_I4
PRINT *,''
PRINT *,'FORALL-WHERE: non_pointer version'
FORALL (i=1_I4:3_I4:1_I4)
WHERE(logical_array((/1_I4,2_I4/),i))
integer_array((4_I4*i-3_I4):(4_I4*i-1_I4):2_I4)=&
& elemental_nonpointer_fun((/(2_I4*i-1_I4),(2_I4*i)/))
integer_array((4_I4*i-2_I4):(4_I4*i):2_I4)=&
& -elemental_nonpointer_fun((/(2_I4*i-1_I4),(2_I4*i)/))
ELSEWHERE
integer_array((4_I4*i-3_I4):(4_I4*i-1_I4):2_I4)=&
& elemental_nonpointer_fun((/0_I4,0_I4/))
integer_array((4_I4*i-2_I4):(4_I4*i):2_I4)=&
& -elemental_nonpointer_fun((/0_I4,0_I4/))
END WHERE
END FORALL
PRINT '(A,6L6)', 'logical_array: ',logical_array
PRINT '(A,12I3)', 'integer_array: ',integer_array
! **************************************************************************
! Version 4: DO-IF pointer version
! **************************************************************************
integer_array=0_I4
PRINT *,''
PRINT *,'DO-IF: pointer version'
DO i=1_I4,3_I4
IF (logical_array(1_I4,i)) THEN
p_vect(2_I4*i-1_I4)=elemental_pointer_fun(2_I4*i-1_I4)
ELSE
p_vect(2_I4*i-1_I4)=elemental_pointer_fun(0_I4)
END IF
IF (logical_array(2_I4,i)) THEN
p_vect(2_I4*i)=elemental_pointer_fun(2_I4*i)
ELSE
p_vect(2_I4*i)=elemental_pointer_fun(0_I4)
END IF
END DO
PRINT '(A,6L6)', 'logical_array: ',logical_array
PRINT '(A,12I3)', 'integer_array: ',integer_array
! **************************************************************************
! Version 5: DO-WHERE pointer version
! **************************************************************************
integer_array=0_I4
PRINT *,''
PRINT *,'DO-WHERE: pointer version'
DO i=1_I4,3_I4
WHERE(logical_array((/1_I4,2_I4/),i))
p_vect((2_I4*i-1_I4):(2_I4*i))=&
& elemental_pointer_fun((/(2_I4*i-1_I4),(2_I4*i)/))
ELSEWHERE
p_vect((2_I4*i-1_I4):(2_I4*i))=&
& elemental_pointer_fun((/0_I4,0_I4/))
END WHERE
END DO
PRINT '(A,6L6)', 'logical_array: ',logical_array
PRINT '(A,12I3)', 'integer_array: ',integer_array
! **************************************************************************
! Version 6: FORALL-WHERE pointer version
! **************************************************************************
integer_array=0_I4
PRINT *,''
PRINT *,'FORALL-WHERE: pointer version'
FORALL (i=1_I4:3_I4:1_I4)
WHERE(logical_array((/1_I4,2_I4/),i))
p_vect((2_I4*i-1_I4):(2_I4*i))=&
& elemental_pointer_fun((/(2_I4*i-1_I4),(2_I4*i)/))
ELSEWHERE
p_vect((2_I4*i-1_I4):(2_I4*i))=&
& elemental_pointer_fun((/0_I4,0_I4/))
END WHERE
END FORALL
PRINT '(A,6L6)', 'logical_array: ',logical_array
PRINT '(A,12I3)', 'integer_array: ',integer_array
CONTAINS
!---------------------------------------------------------------------------
PURE TYPE(pointer_vector_I4) ELEMENTAL FUNCTION &
& elemental_pointer_fun(index) RESULT(ans)
USE kind_mod, ONLY : I4
USE pointer_mod, ONLY : pointer_vector_I4, ASSIGNMENT(=)
IMPLICIT NONE
INTEGER(I4), INTENT(IN) :: index
ALLOCATE(ans%vect(2_I4))
ans%vect=(/index,-index/)
END FUNCTION elemental_pointer_fun
!---------------------------------------------------------------------------
PURE INTEGER(I4) ELEMENTAL FUNCTION &
& elemental_nonpointer_fun(index) RESULT(ans)
USE kind_mod, ONLY : I4
IMPLICIT NONE
INTEGER(I4), INTENT(IN) :: index
ans=index
END FUNCTION elemental_nonpointer_fun
!---------------------------------------------------------------------------
END PROGRAM test_prog
!==============================================================================
|