3607 lines
85 KiB
Fortran
3607 lines
85 KiB
Fortran
! { dg-do run }
|
|
! { dg-options "-fcray-pointer -fbounds-check" }
|
|
! Series of routines for testing a Cray pointer implementation
|
|
program craytest
|
|
common /errors/errors(400)
|
|
common /foo/foo ! To prevent optimizations
|
|
integer foo
|
|
integer i
|
|
logical errors
|
|
errors = .false.
|
|
foo = 0
|
|
call ptr1
|
|
call ptr2
|
|
call ptr3
|
|
call ptr4
|
|
call ptr5
|
|
call ptr6
|
|
call ptr7
|
|
call ptr8
|
|
call ptr9(9,10,11)
|
|
call ptr10(9,10,11)
|
|
call ptr11(9,10,11)
|
|
call ptr12(9,10,11)
|
|
call ptr13(9,10)
|
|
call parmtest
|
|
! NOTE: Tests 1 through 12 were removed from this file
|
|
! and placed in loc_1.f90, so we start at 13
|
|
do i=13,400
|
|
if (errors(i)) then
|
|
! print *,"Test",i,"failed."
|
|
call abort()
|
|
endif
|
|
end do
|
|
if (foo.eq.0) then
|
|
! print *,"Test did not run correctly."
|
|
call abort()
|
|
endif
|
|
end program craytest
|
|
|
|
! ptr1 through ptr13 that Cray pointees are correctly used with
|
|
! a variety of declaration styles
|
|
subroutine ptr1
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
type(drvd) dpte1(n)
|
|
type(drvd) dpte2(m,n)
|
|
type(drvd) dpte3(o,m,n)
|
|
integer ipte1 (n)
|
|
integer ipte2 (m,n)
|
|
integer ipte3 (o,m,n)
|
|
real rpte1(n)
|
|
real rpte2(m,n)
|
|
real rpte3(o,m,n)
|
|
character chpte1(n)
|
|
character chpte2(m,n)
|
|
character chpte3(o,m,n)
|
|
character*8 ch8pte1(n)
|
|
character*8 ch8pte2(m,n)
|
|
character*8 ch8pte3(o,m,n)
|
|
|
|
pointer(iptr1,dpte1)
|
|
pointer(iptr2,dpte2)
|
|
pointer(iptr3,dpte3)
|
|
pointer(iptr4,ipte1)
|
|
pointer(iptr5,ipte2)
|
|
pointer(iptr6,ipte3)
|
|
pointer(iptr7,rpte1)
|
|
pointer(iptr8,rpte2)
|
|
pointer(iptr9,rpte3)
|
|
pointer(iptr10,chpte1)
|
|
pointer(iptr11,chpte2)
|
|
pointer(iptr12,chpte3)
|
|
pointer(iptr13,ch8pte1)
|
|
pointer(iptr14,ch8pte2)
|
|
pointer(iptr15,ch8pte3)
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #13
|
|
errors(13) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #14
|
|
errors(14) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #15
|
|
errors(15) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #16
|
|
errors(16) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #17
|
|
errors(17) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #18
|
|
errors(18) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #19
|
|
errors(19) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #20
|
|
errors(20) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #21
|
|
errors(21) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #22
|
|
errors(22) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #23
|
|
errors(23) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #24
|
|
errors(24) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #25
|
|
errors(25) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #26
|
|
errors(26) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #27
|
|
errors(27) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #28
|
|
errors(28) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #29
|
|
errors(29) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #30
|
|
errors(30) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #31
|
|
errors(31) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #32
|
|
errors(32) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #33
|
|
errors(33) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #34
|
|
errors(34) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #35
|
|
errors(35) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #36
|
|
errors(36) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #37
|
|
errors(37) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #38
|
|
errors(38) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #39
|
|
errors(39) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #40
|
|
errors(40) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #41
|
|
errors(41) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #42
|
|
errors(42) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
rtarg3 = .5
|
|
! Vector syntax
|
|
do, i=1,n
|
|
ipte3 = i
|
|
rpte3 = rpte3+1
|
|
do, j=1,m
|
|
do k=1,o
|
|
if (intne(itarg3(k,j,i), i)) then
|
|
! Error #43
|
|
errors(43) = .true.
|
|
endif
|
|
|
|
if (realne(rtarg3(k,j,i), i+.5)) then
|
|
! Error #44
|
|
errors(44) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end subroutine ptr1
|
|
|
|
|
|
subroutine ptr2
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
type(drvd) dpte1
|
|
type(drvd) dpte2
|
|
type(drvd) dpte3
|
|
integer ipte1
|
|
integer ipte2
|
|
integer ipte3
|
|
real rpte1
|
|
real rpte2
|
|
real rpte3
|
|
character chpte1
|
|
character chpte2
|
|
character chpte3
|
|
character*8 ch8pte1
|
|
character*8 ch8pte2
|
|
character*8 ch8pte3
|
|
|
|
pointer(iptr1,dpte1(n))
|
|
pointer(iptr2,dpte2(m,n))
|
|
pointer(iptr3,dpte3(o,m,n))
|
|
pointer(iptr4,ipte1(n))
|
|
pointer(iptr5,ipte2 (m,n))
|
|
pointer(iptr6,ipte3(o,m,n))
|
|
pointer(iptr7,rpte1(n))
|
|
pointer(iptr8,rpte2(m,n))
|
|
pointer(iptr9,rpte3(o,m,n))
|
|
pointer(iptr10,chpte1(n))
|
|
pointer(iptr11,chpte2(m,n))
|
|
pointer(iptr12,chpte3(o,m,n))
|
|
pointer(iptr13,ch8pte1(n))
|
|
pointer(iptr14,ch8pte2(m,n))
|
|
pointer(iptr15,ch8pte3(o,m,n))
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #45
|
|
errors(45) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #46
|
|
errors(46) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #47
|
|
errors(47) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #48
|
|
errors(48) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #49
|
|
errors(49) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #50
|
|
errors(50) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #51
|
|
errors(51) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #52
|
|
errors(52) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #53
|
|
errors(53) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #54
|
|
errors(54) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #55
|
|
errors(55) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #56
|
|
errors(56) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #57
|
|
errors(57) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #58
|
|
errors(58) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #59
|
|
errors(59) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #60
|
|
errors(60) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #61
|
|
errors(61) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #62
|
|
errors(62) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #63
|
|
errors(63) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #64
|
|
errors(64) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #65
|
|
errors(65) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #66
|
|
errors(66) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #67
|
|
errors(67) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #68
|
|
errors(68) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #69
|
|
errors(69) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #70
|
|
errors(70) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #71
|
|
errors(71) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #72
|
|
errors(72) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #73
|
|
errors(73) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #74
|
|
errors(74) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
rtarg3 = .5
|
|
! Vector syntax
|
|
do, i=1,n
|
|
ipte3 = i
|
|
rpte3 = rpte3+1
|
|
do, j=1,m
|
|
do k=1,o
|
|
if (intne(itarg3(k,j,i), i)) then
|
|
! Error #75
|
|
errors(75) = .true.
|
|
endif
|
|
|
|
if (realne(rtarg3(k,j,i), i+.5)) then
|
|
! Error #76
|
|
errors(76) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
end subroutine ptr2
|
|
|
|
subroutine ptr3
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
pointer(iptr1,dpte1(n))
|
|
pointer(iptr2,dpte2(m,n))
|
|
pointer(iptr3,dpte3(o,m,n))
|
|
pointer(iptr4,ipte1(n))
|
|
pointer(iptr5,ipte2 (m,n))
|
|
pointer(iptr6,ipte3(o,m,n))
|
|
pointer(iptr7,rpte1(n))
|
|
pointer(iptr8,rpte2(m,n))
|
|
pointer(iptr9,rpte3(o,m,n))
|
|
pointer(iptr10,chpte1(n))
|
|
pointer(iptr11,chpte2(m,n))
|
|
pointer(iptr12,chpte3(o,m,n))
|
|
pointer(iptr13,ch8pte1(n))
|
|
pointer(iptr14,ch8pte2(m,n))
|
|
pointer(iptr15,ch8pte3(o,m,n))
|
|
|
|
type(drvd) dpte1
|
|
type(drvd) dpte2
|
|
type(drvd) dpte3
|
|
integer ipte1
|
|
integer ipte2
|
|
integer ipte3
|
|
real rpte1
|
|
real rpte2
|
|
real rpte3
|
|
character chpte1
|
|
character chpte2
|
|
character chpte3
|
|
character*8 ch8pte1
|
|
character*8 ch8pte2
|
|
character*8 ch8pte3
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #77
|
|
errors(77) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #78
|
|
errors(78) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #79
|
|
errors(79) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #80
|
|
errors(80) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #81
|
|
errors(81) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #82
|
|
errors(82) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #83
|
|
errors(83) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #84
|
|
errors(84) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #85
|
|
errors(85) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #86
|
|
errors(86) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #87
|
|
errors(87) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #88
|
|
errors(88) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #89
|
|
errors(89) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #90
|
|
errors(90) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #91
|
|
errors(91) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #92
|
|
errors(92) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #93
|
|
errors(93) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #94
|
|
errors(94) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #95
|
|
errors(95) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #96
|
|
errors(96) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #97
|
|
errors(97) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #98
|
|
errors(98) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #99
|
|
errors(99) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #100
|
|
errors(100) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #101
|
|
errors(101) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #102
|
|
errors(102) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #103
|
|
errors(103) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #104
|
|
errors(104) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #105
|
|
errors(105) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #106
|
|
errors(106) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
rtarg3 = .5
|
|
! Vector syntax
|
|
do, i=1,n
|
|
ipte3 = i
|
|
rpte3 = rpte3+1
|
|
do, j=1,m
|
|
do k=1,o
|
|
if (intne(itarg3(k,j,i), i)) then
|
|
! Error #107
|
|
errors(107) = .true.
|
|
endif
|
|
|
|
if (realne(rtarg3(k,j,i), i+.5)) then
|
|
! Error #108
|
|
errors(108) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
end subroutine ptr3
|
|
|
|
subroutine ptr4
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
pointer(iptr1,dpte1),(iptr2,dpte2),(iptr3,dpte3)
|
|
pointer (iptr4,ipte1), (iptr5,ipte2) ,(iptr6,ipte3),(iptr7,rpte1)
|
|
pointer(iptr8,rpte2)
|
|
pointer(iptr9,rpte3),(iptr10,chpte1)
|
|
pointer(iptr11,chpte2),(iptr12,chpte3),(iptr13,ch8pte1)
|
|
pointer(iptr14,ch8pte2)
|
|
pointer(iptr15,ch8pte3)
|
|
|
|
type(drvd) dpte1(n)
|
|
type(drvd) dpte2(m,n)
|
|
type(drvd) dpte3(o,m,n)
|
|
integer ipte1 (n)
|
|
integer ipte2 (m,n)
|
|
integer ipte3 (o,m,n)
|
|
real rpte1(n)
|
|
real rpte2(m,n)
|
|
real rpte3(o,m,n)
|
|
character chpte1(n)
|
|
character chpte2(m,n)
|
|
character chpte3(o,m,n)
|
|
character*8 ch8pte1(n)
|
|
character*8 ch8pte2(m,n)
|
|
character*8 ch8pte3(o,m,n)
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #109
|
|
errors(109) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #110
|
|
errors(110) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #111
|
|
errors(111) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #112
|
|
errors(112) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #113
|
|
errors(113) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #114
|
|
errors(114) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #115
|
|
errors(115) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #116
|
|
errors(116) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #117
|
|
errors(117) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #118
|
|
errors(118) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #119
|
|
errors(119) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #120
|
|
errors(120) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #121
|
|
errors(121) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #122
|
|
errors(122) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #123
|
|
errors(123) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #124
|
|
errors(124) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #125
|
|
errors(125) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #126
|
|
errors(126) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #127
|
|
errors(127) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #128
|
|
errors(128) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #129
|
|
errors(129) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #130
|
|
errors(130) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #131
|
|
errors(131) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #132
|
|
errors(132) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #133
|
|
errors(133) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #134
|
|
errors(134) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #135
|
|
errors(135) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #136
|
|
errors(136) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #137
|
|
errors(137) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #138
|
|
errors(138) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
rtarg3 = .5
|
|
! Vector syntax
|
|
do, i=1,n
|
|
ipte3 = i
|
|
rpte3 = rpte3+1
|
|
do, j=1,m
|
|
do k=1,o
|
|
if (intne(itarg3(k,j,i), i)) then
|
|
! Error #139
|
|
errors(139) = .true.
|
|
endif
|
|
|
|
if (realne(rtarg3(k,j,i), i+.5)) then
|
|
! Error #140
|
|
errors(140) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end subroutine ptr4
|
|
|
|
subroutine ptr5
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
type(drvd) dpte1(*)
|
|
type(drvd) dpte2(m,*)
|
|
type(drvd) dpte3(o,m,*)
|
|
integer ipte1 (*)
|
|
integer ipte2 (m,*)
|
|
integer ipte3 (o,m,*)
|
|
real rpte1(*)
|
|
real rpte2(m,*)
|
|
real rpte3(o,m,*)
|
|
character chpte1(*)
|
|
character chpte2(m,*)
|
|
character chpte3(o,m,*)
|
|
character*8 ch8pte1(*)
|
|
character*8 ch8pte2(m,*)
|
|
character*8 ch8pte3(o,m,*)
|
|
|
|
pointer(iptr1,dpte1)
|
|
pointer(iptr2,dpte2)
|
|
pointer(iptr3,dpte3)
|
|
pointer(iptr4,ipte1)
|
|
pointer(iptr5,ipte2)
|
|
pointer(iptr6,ipte3)
|
|
pointer(iptr7,rpte1)
|
|
pointer(iptr8,rpte2)
|
|
pointer(iptr9,rpte3)
|
|
pointer(iptr10,chpte1)
|
|
pointer(iptr11,chpte2)
|
|
pointer(iptr12,chpte3)
|
|
pointer(iptr13,ch8pte1)
|
|
pointer(iptr14,ch8pte2)
|
|
pointer(iptr15,ch8pte3)
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #141
|
|
errors(141) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #142
|
|
errors(142) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #143
|
|
errors(143) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #144
|
|
errors(144) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #145
|
|
errors(145) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #146
|
|
errors(146) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #147
|
|
errors(147) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #148
|
|
errors(148) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #149
|
|
errors(149) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #150
|
|
errors(150) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #151
|
|
errors(151) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #152
|
|
errors(152) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #153
|
|
errors(153) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #154
|
|
errors(154) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #155
|
|
errors(155) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #156
|
|
errors(156) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #157
|
|
errors(157) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #158
|
|
errors(158) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #159
|
|
errors(159) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #160
|
|
errors(160) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #161
|
|
errors(161) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #162
|
|
errors(162) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #163
|
|
errors(163) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #164
|
|
errors(164) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #165
|
|
errors(165) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #166
|
|
errors(166) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #167
|
|
errors(167) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #168
|
|
errors(168) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #169
|
|
errors(169) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #170
|
|
errors(170) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end subroutine ptr5
|
|
|
|
|
|
subroutine ptr6
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
type(drvd) dpte1
|
|
type(drvd) dpte2
|
|
type(drvd) dpte3
|
|
integer ipte1
|
|
integer ipte2
|
|
integer ipte3
|
|
real rpte1
|
|
real rpte2
|
|
real rpte3
|
|
character chpte1
|
|
character chpte2
|
|
character chpte3
|
|
character*8 ch8pte1
|
|
character*8 ch8pte2
|
|
character*8 ch8pte3
|
|
|
|
pointer(iptr1,dpte1(*))
|
|
pointer(iptr2,dpte2(m,*))
|
|
pointer(iptr3,dpte3(o,m,*))
|
|
pointer(iptr4,ipte1(*))
|
|
pointer(iptr5,ipte2 (m,*))
|
|
pointer(iptr6,ipte3(o,m,*))
|
|
pointer(iptr7,rpte1(*))
|
|
pointer(iptr8,rpte2(m,*))
|
|
pointer(iptr9,rpte3(o,m,*))
|
|
pointer(iptr10,chpte1(*))
|
|
pointer(iptr11,chpte2(m,*))
|
|
pointer(iptr12,chpte3(o,m,*))
|
|
pointer(iptr13,ch8pte1(*))
|
|
pointer(iptr14,ch8pte2(m,*))
|
|
pointer(iptr15,ch8pte3(o,m,*))
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #171
|
|
errors(171) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #172
|
|
errors(172) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #173
|
|
errors(173) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #174
|
|
errors(174) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #175
|
|
errors(175) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #176
|
|
errors(176) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #177
|
|
errors(177) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #178
|
|
errors(178) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #179
|
|
errors(179) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #180
|
|
errors(180) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #181
|
|
errors(181) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #182
|
|
errors(182) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #183
|
|
errors(183) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #184
|
|
errors(184) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #185
|
|
errors(185) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #186
|
|
errors(186) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #187
|
|
errors(187) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #188
|
|
errors(188) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #189
|
|
errors(189) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #190
|
|
errors(190) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #191
|
|
errors(191) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #192
|
|
errors(192) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #193
|
|
errors(193) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #194
|
|
errors(194) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #195
|
|
errors(195) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #196
|
|
errors(196) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #197
|
|
errors(197) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #198
|
|
errors(198) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #199
|
|
errors(199) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #200
|
|
errors(200) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end subroutine ptr6
|
|
|
|
subroutine ptr7
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
pointer(iptr1,dpte1(*))
|
|
pointer(iptr2,dpte2(m,*))
|
|
pointer(iptr3,dpte3(o,m,*))
|
|
pointer(iptr4,ipte1(*))
|
|
pointer(iptr5,ipte2 (m,*))
|
|
pointer(iptr6,ipte3(o,m,*))
|
|
pointer(iptr7,rpte1(*))
|
|
pointer(iptr8,rpte2(m,*))
|
|
pointer(iptr9,rpte3(o,m,*))
|
|
pointer(iptr10,chpte1(*))
|
|
pointer(iptr11,chpte2(m,*))
|
|
pointer(iptr12,chpte3(o,m,*))
|
|
pointer(iptr13,ch8pte1(*))
|
|
pointer(iptr14,ch8pte2(m,*))
|
|
pointer(iptr15,ch8pte3(o,m,*))
|
|
|
|
type(drvd) dpte1
|
|
type(drvd) dpte2
|
|
type(drvd) dpte3
|
|
integer ipte1
|
|
integer ipte2
|
|
integer ipte3
|
|
real rpte1
|
|
real rpte2
|
|
real rpte3
|
|
character chpte1
|
|
character chpte2
|
|
character chpte3
|
|
character*8 ch8pte1
|
|
character*8 ch8pte2
|
|
character*8 ch8pte3
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #201
|
|
errors(201) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #202
|
|
errors(202) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #203
|
|
errors(203) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #204
|
|
errors(204) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #205
|
|
errors(205) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #206
|
|
errors(206) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #207
|
|
errors(207) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #208
|
|
errors(208) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #209
|
|
errors(209) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #210
|
|
errors(210) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #211
|
|
errors(211) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #212
|
|
errors(212) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #213
|
|
errors(213) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #214
|
|
errors(214) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #215
|
|
errors(215) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #216
|
|
errors(216) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #217
|
|
errors(217) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #218
|
|
errors(218) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #219
|
|
errors(219) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #220
|
|
errors(220) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #221
|
|
errors(221) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #222
|
|
errors(222) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #223
|
|
errors(223) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #224
|
|
errors(224) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #225
|
|
errors(225) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #226
|
|
errors(226) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #227
|
|
errors(227) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #228
|
|
errors(228) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #229
|
|
errors(229) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #230
|
|
errors(230) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end subroutine ptr7
|
|
|
|
subroutine ptr8
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
pointer(iptr1,dpte1)
|
|
pointer(iptr2,dpte2)
|
|
pointer(iptr3,dpte3)
|
|
pointer(iptr4,ipte1)
|
|
pointer(iptr5,ipte2)
|
|
pointer(iptr6,ipte3)
|
|
pointer(iptr7,rpte1)
|
|
pointer(iptr8,rpte2)
|
|
pointer(iptr9,rpte3)
|
|
pointer(iptr10,chpte1)
|
|
pointer(iptr11,chpte2)
|
|
pointer(iptr12,chpte3)
|
|
pointer(iptr13,ch8pte1)
|
|
pointer(iptr14,ch8pte2)
|
|
pointer(iptr15,ch8pte3)
|
|
|
|
type(drvd) dpte1(*)
|
|
type(drvd) dpte2(m,*)
|
|
type(drvd) dpte3(o,m,*)
|
|
integer ipte1 (*)
|
|
integer ipte2 (m,*)
|
|
integer ipte3 (o,m,*)
|
|
real rpte1(*)
|
|
real rpte2(m,*)
|
|
real rpte3(o,m,*)
|
|
character chpte1(*)
|
|
character chpte2(m,*)
|
|
character chpte3(o,m,*)
|
|
character*8 ch8pte1(*)
|
|
character*8 ch8pte2(m,*)
|
|
character*8 ch8pte3(o,m,*)
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #231
|
|
errors(231) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #232
|
|
errors(232) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #233
|
|
errors(233) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #234
|
|
errors(234) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #235
|
|
errors(235) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #236
|
|
errors(236) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #237
|
|
errors(237) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #238
|
|
errors(238) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #239
|
|
errors(239) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #240
|
|
errors(240) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #241
|
|
errors(241) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #242
|
|
errors(242) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #243
|
|
errors(243) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #244
|
|
errors(244) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #245
|
|
errors(245) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #246
|
|
errors(246) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #247
|
|
errors(247) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #248
|
|
errors(248) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #249
|
|
errors(249) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #250
|
|
errors(250) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #251
|
|
errors(251) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #252
|
|
errors(252) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #253
|
|
errors(253) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #254
|
|
errors(254) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #255
|
|
errors(255) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #256
|
|
errors(256) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #257
|
|
errors(257) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #258
|
|
errors(258) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #259
|
|
errors(259) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #260
|
|
errors(260) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
end subroutine ptr8
|
|
|
|
|
|
subroutine ptr9(nnn,mmm,ooo)
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer :: nnn,mmm,ooo
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
type(drvd) dpte1(nnn)
|
|
type(drvd) dpte2(mmm,nnn)
|
|
type(drvd) dpte3(ooo,mmm,nnn)
|
|
integer ipte1 (nnn)
|
|
integer ipte2 (mmm,nnn)
|
|
integer ipte3 (ooo,mmm,nnn)
|
|
real rpte1(nnn)
|
|
real rpte2(mmm,nnn)
|
|
real rpte3(ooo,mmm,nnn)
|
|
character chpte1(nnn)
|
|
character chpte2(mmm,nnn)
|
|
character chpte3(ooo,mmm,nnn)
|
|
character*8 ch8pte1(nnn)
|
|
character*8 ch8pte2(mmm,nnn)
|
|
character*8 ch8pte3(ooo,mmm,nnn)
|
|
|
|
pointer(iptr1,dpte1)
|
|
pointer(iptr2,dpte2)
|
|
pointer(iptr3,dpte3)
|
|
pointer(iptr4,ipte1)
|
|
pointer(iptr5,ipte2)
|
|
pointer(iptr6,ipte3)
|
|
pointer(iptr7,rpte1)
|
|
pointer(iptr8,rpte2)
|
|
pointer(iptr9,rpte3)
|
|
pointer(iptr10,chpte1)
|
|
pointer(iptr11,chpte2)
|
|
pointer(iptr12,chpte3)
|
|
pointer(iptr13,ch8pte1)
|
|
pointer(iptr14,ch8pte2)
|
|
pointer(iptr15,ch8pte3)
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #261
|
|
errors(261) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #262
|
|
errors(262) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #263
|
|
errors(263) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #264
|
|
errors(264) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #265
|
|
errors(265) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #266
|
|
errors(266) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #267
|
|
errors(267) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #268
|
|
errors(268) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #269
|
|
errors(269) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #270
|
|
errors(270) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #271
|
|
errors(271) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #272
|
|
errors(272) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #273
|
|
errors(273) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #274
|
|
errors(274) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #275
|
|
errors(275) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #276
|
|
errors(276) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #277
|
|
errors(277) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #278
|
|
errors(278) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #279
|
|
errors(279) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #280
|
|
errors(280) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #281
|
|
errors(281) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #282
|
|
errors(282) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #283
|
|
errors(283) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #284
|
|
errors(284) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #285
|
|
errors(285) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #286
|
|
errors(286) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #287
|
|
errors(287) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #288
|
|
errors(288) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #289
|
|
errors(289) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #290
|
|
errors(290) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
rtarg3 = .5
|
|
! Vector syntax
|
|
do, i=1,n
|
|
ipte3 = i
|
|
rpte3 = rpte3+1
|
|
do, j=1,m
|
|
do k=1,o
|
|
if (intne(itarg3(k,j,i), i)) then
|
|
! Error #291
|
|
errors(291) = .true.
|
|
endif
|
|
|
|
if (realne(rtarg3(k,j,i), i+.5)) then
|
|
! Error #292
|
|
errors(292) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end subroutine ptr9
|
|
|
|
subroutine ptr10(nnn,mmm,ooo)
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer :: nnn,mmm,ooo
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
type(drvd) dpte1
|
|
type(drvd) dpte2
|
|
type(drvd) dpte3
|
|
integer ipte1
|
|
integer ipte2
|
|
integer ipte3
|
|
real rpte1
|
|
real rpte2
|
|
real rpte3
|
|
character chpte1
|
|
character chpte2
|
|
character chpte3
|
|
character*8 ch8pte1
|
|
character*8 ch8pte2
|
|
character*8 ch8pte3
|
|
|
|
pointer(iptr1,dpte1(nnn))
|
|
pointer(iptr2,dpte2(mmm,nnn))
|
|
pointer(iptr3,dpte3(ooo,mmm,nnn))
|
|
pointer(iptr4,ipte1(nnn))
|
|
pointer(iptr5,ipte2 (mmm,nnn))
|
|
pointer(iptr6,ipte3(ooo,mmm,nnn))
|
|
pointer(iptr7,rpte1(nnn))
|
|
pointer(iptr8,rpte2(mmm,nnn))
|
|
pointer(iptr9,rpte3(ooo,mmm,nnn))
|
|
pointer(iptr10,chpte1(nnn))
|
|
pointer(iptr11,chpte2(mmm,nnn))
|
|
pointer(iptr12,chpte3(ooo,mmm,nnn))
|
|
pointer(iptr13,ch8pte1(nnn))
|
|
pointer(iptr14,ch8pte2(mmm,nnn))
|
|
pointer(iptr15,ch8pte3(ooo,mmm,nnn))
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #293
|
|
errors(293) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #294
|
|
errors(294) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #295
|
|
errors(295) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #296
|
|
errors(296) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #297
|
|
errors(297) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #298
|
|
errors(298) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #299
|
|
errors(299) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #300
|
|
errors(300) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #301
|
|
errors(301) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #302
|
|
errors(302) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #303
|
|
errors(303) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #304
|
|
errors(304) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #305
|
|
errors(305) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #306
|
|
errors(306) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #307
|
|
errors(307) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #308
|
|
errors(308) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #309
|
|
errors(309) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #310
|
|
errors(310) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #311
|
|
errors(311) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #312
|
|
errors(312) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #313
|
|
errors(313) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #314
|
|
errors(314) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #315
|
|
errors(315) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #316
|
|
errors(316) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #317
|
|
errors(317) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #318
|
|
errors(318) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #319
|
|
errors(319) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #320
|
|
errors(320) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #321
|
|
errors(321) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #322
|
|
errors(322) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
rtarg3 = .5
|
|
! Vector syntax
|
|
do, i=1,n
|
|
ipte3 = i
|
|
rpte3 = rpte3+1
|
|
do, j=1,m
|
|
do k=1,o
|
|
if (intne(itarg3(k,j,i), i)) then
|
|
! Error #323
|
|
errors(323) = .true.
|
|
endif
|
|
|
|
if (realne(rtarg3(k,j,i), i+.5)) then
|
|
! Error #324
|
|
errors(324) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
end subroutine ptr10
|
|
|
|
subroutine ptr11(nnn,mmm,ooo)
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer :: nnn,mmm,ooo
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
pointer(iptr1,dpte1(nnn))
|
|
pointer(iptr2,dpte2(mmm,nnn))
|
|
pointer(iptr3,dpte3(ooo,mmm,nnn))
|
|
pointer(iptr4,ipte1(nnn))
|
|
pointer(iptr5,ipte2 (mmm,nnn))
|
|
pointer(iptr6,ipte3(ooo,mmm,nnn))
|
|
pointer(iptr7,rpte1(nnn))
|
|
pointer(iptr8,rpte2(mmm,nnn))
|
|
pointer(iptr9,rpte3(ooo,mmm,nnn))
|
|
pointer(iptr10,chpte1(nnn))
|
|
pointer(iptr11,chpte2(mmm,nnn))
|
|
pointer(iptr12,chpte3(ooo,mmm,nnn))
|
|
pointer(iptr13,ch8pte1(nnn))
|
|
pointer(iptr14,ch8pte2(mmm,nnn))
|
|
pointer(iptr15,ch8pte3(ooo,mmm,nnn))
|
|
|
|
type(drvd) dpte1
|
|
type(drvd) dpte2
|
|
type(drvd) dpte3
|
|
integer ipte1
|
|
integer ipte2
|
|
integer ipte3
|
|
real rpte1
|
|
real rpte2
|
|
real rpte3
|
|
character chpte1
|
|
character chpte2
|
|
character chpte3
|
|
character*8 ch8pte1
|
|
character*8 ch8pte2
|
|
character*8 ch8pte3
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #325
|
|
errors(325) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #326
|
|
errors(326) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #327
|
|
errors(327) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #328
|
|
errors(328) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #329
|
|
errors(329) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #330
|
|
errors(330) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #331
|
|
errors(331) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #332
|
|
errors(332) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #333
|
|
errors(333) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #334
|
|
errors(334) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #335
|
|
errors(335) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #336
|
|
errors(336) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #337
|
|
errors(337) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #338
|
|
errors(338) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #339
|
|
errors(339) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #340
|
|
errors(340) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #341
|
|
errors(341) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #342
|
|
errors(342) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #343
|
|
errors(343) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #344
|
|
errors(344) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #345
|
|
errors(345) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #346
|
|
errors(346) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #347
|
|
errors(347) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #348
|
|
errors(348) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #349
|
|
errors(349) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #350
|
|
errors(350) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #351
|
|
errors(351) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #352
|
|
errors(352) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #353
|
|
errors(353) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #354
|
|
errors(354) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
rtarg3 = .5
|
|
! Vector syntax
|
|
do, i=1,n
|
|
ipte3 = i
|
|
rpte3 = rpte3+1
|
|
do, j=1,m
|
|
do k=1,o
|
|
if (intne(itarg3(k,j,i), i)) then
|
|
! Error #355
|
|
errors(355) = .true.
|
|
endif
|
|
|
|
if (realne(rtarg3(k,j,i), i+.5)) then
|
|
! Error #356
|
|
errors(356) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
end subroutine ptr11
|
|
|
|
subroutine ptr12(nnn,mmm,ooo)
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: i,j,k
|
|
integer :: nnn,mmm,ooo
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer, parameter :: o = 11
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
integer itarg3 (o,m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
real rtarg3(o,m,n)
|
|
character chtarg1(n)
|
|
character chtarg2(m,n)
|
|
character chtarg3(o,m,n)
|
|
character*8 ch8targ1(n)
|
|
character*8 ch8targ2(m,n)
|
|
character*8 ch8targ3(o,m,n)
|
|
type drvd
|
|
real r1
|
|
integer i1
|
|
integer i2(5)
|
|
end type drvd
|
|
type(drvd) dtarg1(n)
|
|
type(drvd) dtarg2(m,n)
|
|
type(drvd) dtarg3(o,m,n)
|
|
|
|
pointer(iptr1,dpte1)
|
|
pointer(iptr2,dpte2)
|
|
pointer(iptr3,dpte3)
|
|
pointer(iptr4,ipte1)
|
|
pointer(iptr5,ipte2)
|
|
pointer(iptr6,ipte3)
|
|
pointer(iptr7,rpte1)
|
|
pointer(iptr8,rpte2)
|
|
pointer(iptr9,rpte3)
|
|
pointer(iptr10,chpte1)
|
|
pointer(iptr11,chpte2)
|
|
pointer(iptr12,chpte3)
|
|
pointer(iptr13,ch8pte1)
|
|
pointer(iptr14,ch8pte2)
|
|
pointer(iptr15,ch8pte3)
|
|
|
|
type(drvd) dpte1(nnn)
|
|
type(drvd) dpte2(mmm,nnn)
|
|
type(drvd) dpte3(ooo,mmm,nnn)
|
|
integer ipte1 (nnn)
|
|
integer ipte2 (mmm,nnn)
|
|
integer ipte3 (ooo,mmm,nnn)
|
|
real rpte1(nnn)
|
|
real rpte2(mmm,nnn)
|
|
real rpte3(ooo,mmm,nnn)
|
|
character chpte1(nnn)
|
|
character chpte2(mmm,nnn)
|
|
character chpte3(ooo,mmm,nnn)
|
|
character*8 ch8pte1(nnn)
|
|
character*8 ch8pte2(mmm,nnn)
|
|
character*8 ch8pte3(ooo,mmm,nnn)
|
|
|
|
iptr1 = loc(dtarg1)
|
|
iptr2 = loc(dtarg2)
|
|
iptr3 = loc(dtarg3)
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr6 = loc(itarg3)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
iptr9 = loc(rtarg3)
|
|
iptr10= loc(chtarg1)
|
|
iptr11= loc(chtarg2)
|
|
iptr12= loc(chtarg3)
|
|
iptr13= loc(ch8targ1)
|
|
iptr14= loc(ch8targ2)
|
|
iptr15= loc(ch8targ3)
|
|
|
|
|
|
do, i=1,n
|
|
dpte1(i)%i1=i
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #357
|
|
errors(357) = .true.
|
|
endif
|
|
|
|
dtarg1(i)%i1=2*dpte1(i)%i1
|
|
if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
|
|
! Error #358
|
|
errors(358) = .true.
|
|
endif
|
|
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #359
|
|
errors(359) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #360
|
|
errors(360) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #361
|
|
errors(361) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #362
|
|
errors(362) = .true.
|
|
endif
|
|
|
|
chpte1(i) = 'a'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #363
|
|
errors(363) = .true.
|
|
endif
|
|
|
|
chtarg1(i) = 'z'
|
|
if (chne(chpte1(i), chtarg1(i))) then
|
|
! Error #364
|
|
errors(364) = .true.
|
|
endif
|
|
|
|
ch8pte1(i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #365
|
|
errors(365) = .true.
|
|
endif
|
|
|
|
ch8targ1(i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte1(i), ch8targ1(i))) then
|
|
! Error #366
|
|
errors(366) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
dpte2(j,i)%r1=1.0
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #367
|
|
errors(367) = .true.
|
|
endif
|
|
|
|
dtarg2(j,i)%r1=2*dpte2(j,i)%r1
|
|
if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
|
|
! Error #368
|
|
errors(368) = .true.
|
|
endif
|
|
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #369
|
|
errors(369) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #370
|
|
errors(370) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #371
|
|
errors(371) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #372
|
|
errors(372) = .true.
|
|
endif
|
|
|
|
chpte2(j,i) = 'a'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #373
|
|
errors(373) = .true.
|
|
endif
|
|
|
|
chtarg2(j,i) = 'z'
|
|
if (chne(chpte2(j,i), chtarg2(j,i))) then
|
|
! Error #374
|
|
errors(374) = .true.
|
|
endif
|
|
|
|
ch8pte2(j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #375
|
|
errors(375) = .true.
|
|
endif
|
|
|
|
ch8targ2(j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
|
|
! Error #376
|
|
errors(376) = .true.
|
|
endif
|
|
do k=1,o
|
|
dpte3(k,j,i)%i2(1+mod(i,5))=i
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #377
|
|
errors(377) = .true.
|
|
endif
|
|
|
|
dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
|
|
if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
|
|
dtarg3(k,j,i)%i2(1+mod(i,5)))) then
|
|
! Error #378
|
|
errors(378) = .true.
|
|
endif
|
|
|
|
ipte3(k,j,i) = i
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #379
|
|
errors(379) = .true.
|
|
endif
|
|
|
|
itarg3(k,j,i) = -ipte3(k,j,i)
|
|
if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
|
|
! Error #380
|
|
errors(380) = .true.
|
|
endif
|
|
|
|
rpte3(k,j,i) = i * 2.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #381
|
|
errors(381) = .true.
|
|
endif
|
|
|
|
rtarg3(k,j,i) = i * 3.0
|
|
if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
|
|
! Error #382
|
|
errors(382) = .true.
|
|
endif
|
|
|
|
chpte3(k,j,i) = 'a'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #383
|
|
errors(383) = .true.
|
|
endif
|
|
|
|
chtarg3(k,j,i) = 'z'
|
|
if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
|
|
! Error #384
|
|
errors(384) = .true.
|
|
endif
|
|
|
|
ch8pte3(k,j,i) = 'aaaaaaaa'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #385
|
|
errors(385) = .true.
|
|
endif
|
|
|
|
ch8targ3(k,j,i) = 'zzzzzzzz'
|
|
if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
|
|
! Error #386
|
|
errors(386) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
rtarg3 = .5
|
|
! Vector syntax
|
|
do, i=1,n
|
|
ipte3 = i
|
|
rpte3 = rpte3+1
|
|
do, j=1,m
|
|
do k=1,o
|
|
if (intne(itarg3(k,j,i), i)) then
|
|
! Error #387
|
|
errors(387) = .true.
|
|
endif
|
|
|
|
if (realne(rtarg3(k,j,i), i+.5)) then
|
|
! Error #388
|
|
errors(388) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end subroutine ptr12
|
|
|
|
! Misc
|
|
subroutine ptr13(nnn,mmm)
|
|
common /errors/errors(400)
|
|
logical :: errors, intne, realne, chne, ch8ne
|
|
integer :: nnn,mmm
|
|
integer :: i,j
|
|
integer, parameter :: n = 9
|
|
integer, parameter :: m = 10
|
|
integer itarg1 (n)
|
|
integer itarg2 (m,n)
|
|
real rtarg1(n)
|
|
real rtarg2(m,n)
|
|
|
|
integer ipte1
|
|
integer ipte2
|
|
real rpte1
|
|
real rpte2
|
|
|
|
dimension ipte1(n)
|
|
dimension rpte2(mmm,nnn)
|
|
|
|
pointer(iptr4,ipte1)
|
|
pointer(iptr5,ipte2)
|
|
pointer(iptr7,rpte1)
|
|
pointer(iptr8,rpte2)
|
|
|
|
dimension ipte2(mmm,nnn)
|
|
dimension rpte1(n)
|
|
|
|
iptr4 = loc(itarg1)
|
|
iptr5 = loc(itarg2)
|
|
iptr7 = loc(rtarg1)
|
|
iptr8 = loc(rtarg2)
|
|
|
|
do, i=1,n
|
|
ipte1(i) = i
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #389
|
|
errors(389) = .true.
|
|
endif
|
|
|
|
itarg1(i) = -ipte1(i)
|
|
if (intne(ipte1(i), itarg1(i))) then
|
|
! Error #390
|
|
errors(390) = .true.
|
|
endif
|
|
|
|
rpte1(i) = i * 5.0
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #391
|
|
errors(391) = .true.
|
|
endif
|
|
|
|
rtarg1(i) = i * (-5.0)
|
|
if (realne(rpte1(i), rtarg1(i))) then
|
|
! Error #392
|
|
errors(392) = .true.
|
|
endif
|
|
|
|
do, j=1,m
|
|
ipte2(j,i) = i
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #393
|
|
errors(393) = .true.
|
|
endif
|
|
|
|
itarg2(j,i) = -ipte2(j,i)
|
|
if (intne(ipte2(j,i), itarg2(j,i))) then
|
|
! Error #394
|
|
errors(394) = .true.
|
|
endif
|
|
|
|
rpte2(j,i) = i * (-2.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #395
|
|
errors(395) = .true.
|
|
endif
|
|
|
|
rtarg2(j,i) = i * (-3.0)
|
|
if (realne(rpte2(j,i), rtarg2(j,i))) then
|
|
! Error #396
|
|
errors(396) = .true.
|
|
endif
|
|
|
|
end do
|
|
end do
|
|
end subroutine ptr13
|
|
|
|
|
|
! Test the passing of pointers and pointees as parameters
|
|
subroutine parmtest
|
|
integer, parameter :: n = 12
|
|
integer, parameter :: m = 13
|
|
integer iarray(m,n)
|
|
pointer (ipt,iptee)
|
|
integer iptee (m,n)
|
|
|
|
ipt = loc(iarray)
|
|
! write(*,*) "loc(iarray)",loc(iarray)
|
|
call parmptr(ipt,iarray,n,m)
|
|
! write(*,*) "loc(iptee)",loc(iptee)
|
|
call parmpte(iptee,iarray,n,m)
|
|
end subroutine parmtest
|
|
|
|
subroutine parmptr(ipointer,intarr,n,m)
|
|
common /errors/errors(400)
|
|
logical :: errors, intne
|
|
integer :: n,m,i,j
|
|
integer intarr(m,n)
|
|
pointer (ipointer,newpte)
|
|
integer newpte(m,n)
|
|
! write(*,*) "loc(newpte)",loc(newpte)
|
|
! write(*,*) "loc(intarr)",loc(intarr)
|
|
! write(*,*) "loc(newpte(1,1))",loc(newpte(1,1))
|
|
! newpte(1,1) = 101
|
|
! write(*,*) "newpte(1,1)=",newpte(1,1)
|
|
! write(*,*) "intarr(1,1)=",intarr(1,1)
|
|
do, i=1,n
|
|
do, j=1,m
|
|
newpte(j,i) = i
|
|
if (intne(newpte(j,i),intarr(j,i))) then
|
|
! Error #397
|
|
errors(397) = .true.
|
|
endif
|
|
|
|
call donothing(newpte(j,i),intarr(j,i))
|
|
intarr(j,i) = -newpte(j,i)
|
|
if (intne(newpte(j,i),intarr(j,i))) then
|
|
! Error #398
|
|
errors(398) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end subroutine parmptr
|
|
|
|
subroutine parmpte(pointee,intarr,n,m)
|
|
common /errors/errors(400)
|
|
logical :: errors, intne
|
|
integer :: n,m,i,j
|
|
integer pointee (m,n)
|
|
integer intarr (m,n)
|
|
! write(*,*) "loc(pointee)",loc(pointee)
|
|
! write(*,*) "loc(intarr)",loc(intarr)
|
|
! write(*,*) "loc(pointee(1,1))",loc(pointee(1,1))
|
|
! pointee(1,1) = 99
|
|
! write(*,*) "pointee(1,1)=",pointee(1,1)
|
|
! write(*,*) "intarr(1,1)=",intarr(1,1)
|
|
|
|
do, i=1,n
|
|
do, j=1,m
|
|
pointee(j,i) = i
|
|
if (intne(pointee(j,i),intarr(j,i))) then
|
|
! Error #399
|
|
errors(399) = .true.
|
|
endif
|
|
|
|
intarr(j,i) = 2*pointee(j,i)
|
|
call donothing(pointee(j,i),intarr(j,i))
|
|
if (intne(pointee(j,i),intarr(j,i))) then
|
|
! Error #400
|
|
errors(400) = .true.
|
|
endif
|
|
end do
|
|
end do
|
|
end subroutine parmpte
|
|
|
|
! Separate function calls to break Cray pointer-indifferent optimization
|
|
logical function intne(ii,jj)
|
|
integer :: i,j
|
|
common /foo/foo
|
|
integer foo
|
|
foo = foo + 1
|
|
intne = ii.ne.jj
|
|
if (intne) then
|
|
write (*,*) ii," doesn't equal ",jj
|
|
endif
|
|
end function intne
|
|
|
|
logical function realne(r1,r2)
|
|
real :: r1, r2
|
|
common /foo/foo
|
|
integer foo
|
|
foo = foo + 1
|
|
realne = r1.ne.r2
|
|
if (realne) then
|
|
write (*,*) r1," doesn't equal ",r2
|
|
endif
|
|
end function realne
|
|
|
|
logical function chne(ch1,ch2)
|
|
character :: ch1, ch2
|
|
common /foo/foo
|
|
integer foo
|
|
foo = foo + 1
|
|
chne = ch1.ne.ch2
|
|
if (chne) then
|
|
write (*,*) ch1," doesn't equal ",ch2
|
|
endif
|
|
end function chne
|
|
|
|
logical function ch8ne(ch1,ch2)
|
|
character*8 :: ch1, ch2
|
|
common /foo/foo
|
|
integer foo
|
|
foo = foo + 1
|
|
ch8ne = ch1.ne.ch2
|
|
if (ch8ne) then
|
|
write (*,*) ch1," doesn't equal ",ch2
|
|
endif
|
|
end function ch8ne
|
|
|
|
subroutine donothing(ii,jj)
|
|
common/foo/foo
|
|
integer :: ii,jj,foo
|
|
if (foo.le.1) then
|
|
foo = 1
|
|
else
|
|
foo = foo - 1
|
|
endif
|
|
if (foo.eq.0) then
|
|
ii = -1
|
|
jj = 1
|
|
! print *,"Test did not run correctly"
|
|
call abort()
|
|
endif
|
|
end subroutine donothing
|
|
|