gcc/testsuite/gfortran.dg/pr101264.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-Ofast" }
   3   SUBROUTINE foo (a,b,c,d,trigs,inc1,inc2,inc3,inc4,lot,n,la)
   4     IMPLICIT NONE (type, external)
   5     INTEGER, PARAMETER ::   wp = 8
   6     INTEGER, PARAMETER ::  iwp = 4
   7     INTEGER(iwp) ::  inc1
   8     INTEGER(iwp) ::  inc2
   9     INTEGER(iwp) ::  inc3
  10     INTEGER(iwp) ::  inc4
  11     INTEGER(iwp) ::  la
  12     INTEGER(iwp) ::  lot
  13     INTEGER(iwp) ::  n
  14
  15     REAL(wp) ::  a(*)
  16     REAL(wp) ::  b(*)
  17     REAL(wp) ::  c(*)
  18     REAL(wp) ::  d(*)
  19     REAL(wp) ::  trigs(*)
  20
  21     REAL(wp) ::  c1
  22     REAL(wp) ::  c2
  23     REAL(wp) ::  s1
  24     REAL(wp) ::  s2
  25     REAL(wp) ::  sin60
  26
  27     INTEGER(iwp) ::  i
  28     INTEGER(iwp) ::  ia
  29     INTEGER(iwp) ::  ib
  30     INTEGER(iwp) ::  ibase
  31     INTEGER(iwp) ::  ic
  32     INTEGER(iwp) ::  iink
  33     INTEGER(iwp) ::  ijk
  34     INTEGER(iwp) ::  j
  35     INTEGER(iwp) ::  ja
  36     INTEGER(iwp) ::  jb
  37     INTEGER(iwp) ::  jbase
  38     INTEGER(iwp) ::  jc
  39     INTEGER(iwp) ::  jink
  40     INTEGER(iwp) ::  jump
  41     INTEGER(iwp) ::  k
  42     INTEGER(iwp) ::  kb
  43     INTEGER(iwp) ::  kc
  44     INTEGER(iwp) ::  kstop
  45     INTEGER(iwp) ::  l
  46     INTEGER(iwp) ::  m
  47
  48     sin60=0.866025403784437_wp
  49
  50     ia = 1
  51     ib = ia + (2*m-la)*inc1
  52     ic = ib
  53     ja = 1
  54     jb = ja + jink
  55     jc = jb + jink
  56
  57     DO k = la, kstop, la
  58        kb = k + k
  59        kc = kb + kb
  60        c1 = trigs(kb+1)
  61        s1 = trigs(kb+2)
  62        c2 = trigs(kc+1)
  63        s2 = trigs(kc+2)
  64        ibase = 0
  65        DO l = 1, la
  66           i = ibase
  67           j = jbase
  68           DO ijk = 1, lot
  69              c(ja+j) = a(ia+i) + (a(ib+i)+a(ic+i))
  70              d(ja+j) = b(ia+i) + (b(ib+i)-b(ic+i))
  71              c(jb+j) = c1*((a(ia+i)-0.5_wp*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)+ &
  72                   &            b(ic+i))))                                      &
  73                   &    - s1*((b(ia+i)-0.5_wp*(b(ib+i)-b(ic+i)))+(sin60*(a(ib+i)- &
  74                   &            a(ic+i))))
  75              d(jb+j) = s1*((a(ia+i)-0.5_wp*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)+ &
  76                   &            b(ic+i))))                                      &
  77                   &    + c1*((b(ia+i)-0.5_wp*(b(ib+i)-b(ic+i)))+(sin60*(a(ib+i)- &
  78                   &            a(ic+i))))
  79              c(jc+j) = c2*((a(ia+i)-0.5_wp*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)+ &
  80                   &            b(ic+i))))                                      &
  81                   &    - s2*((b(ia+i)-0.5_wp*(b(ib+i)-b(ic+i)))-(sin60*(a(ib+i)- &
  82                   &            a(ic+i))))
  83              i = i + inc3
  84              j = j + inc4
  85           END DO
  86           ibase = ibase + inc1
  87           jbase = jbase + inc2
  88        END DO
  89        ia = ia + iink
  90        ib = ib + iink
  91        ic = ic - iink
  92        jbase = jbase + jump
  93     END DO
  94   END