cray_pointers_2.f90

来自「用于进行gcc测试」· F90 代码 · 共 2,707 行 · 第 1/5 页

        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'