gcc/testsuite/g77.f-torture/compile/20000511-2.f

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