Peter
I have had another look at your program. I think for what you are trying to
do it would be better to use the module procedure feature, and build
suitable code for all the dimensions and types which you want to use. I
think that trying to use both scalar and vectors with pure elemental
functions is dangerous! As I understand the pure elemental feature, it is
just a short hand for - invoke this function as many times as you need to -
rather than a feature for dealing with multiple dimensions and ranks. It is
quite a lot more code to write with the module procedure feature, but it
will probably be more reliable!
When I look at line 239 in this way, I am surprised that any of the
compilers compile it!
Hope that this helps.
Alistair
-----Original Message-----
From: Fortran 90 List [mailto:[log in to unmask]] On Behalf Of P
Suckling
Sent: 01 April 2003 18:20
To: [log in to unmask]
Subject: Compiler differences
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
!===========================================================================
===
|