gcc/testsuite/gfortran.dg/g77/20000511-2.f

   1 c { dg-do compile }
   2       subroutine sgbcon(norm,n,kl,ku,ab,ldab,ipiv,anorm,rcond,work,iwork
   3      &,info)
   4 C
   5 C  -- LAPACK routine (version 3.0) --
   6 C     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
   7 C     Courant Institute, Argonne National Lab, and Rice University
   8 C     September 30, 1994
   9 C
  10 C     .. Scalar Arguments ..
  11       character norm
  12       integer info,kl,ku,ldab,n
  13       real anorm,rcond
  14 C     ..
  15 C     .. Array Arguments ..
  16       integer ipiv(n),iwork(n)
  17       real ab(ldab,n),work(n)
  18 C     ..
  19 C
  20 C  Purpose
  21 C  =======
  22 C demonstrate g77 bug at -O -funroll-loops
  23 C  =====================================================================
  24 C
  25 C     .. Parameters ..
  26       real one,zero
  27       parameter(one= 1.0e+0,zero= 0.0e+0)
  28 C     ..
  29 C     .. Local Scalars ..
  30       logical lnoti,onenrm
  31       character normin
  32       integer ix,j,jp,kase,kase1,kd,lm
  33       real ainvnm,scale,smlnum,t
  34 C     ..
  35 C     .. External Functions ..
  36       logical lsame
  37       integer isamax
  38       real sdot,slamch
  39       externallsame,isamax,sdot,slamch
  40 C     ..
  41 C     .. External Subroutines ..
  42       externalsaxpy,slacon,slatbs,srscl,xerbla
  43 C     ..
  44 C     .. Executable Statements ..
  45 C
  46 C           Multiply by inv(L).
  47 C
  48       do j= 1,n-1
  49 C the following min() intrinsic provokes this bug
  50          lm= min(kl,n-j)
  51          jp= ipiv(j)
  52          t= work(jp)
  53          if(jp.ne.j)then
  54 C but only when combined with this if block
  55             work(jp)= work(j)
  56             work(j)= t
  57          endif
  58 C and this subroutine call
  59          call saxpy(lm,-t,ab(kd+1,j),1,work(j+1),1)
  60       enddo
  61       return
  62       end