cray_pointers_2.f90

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

        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