subroutine setup2
      implicit none
      integer nmax,i,n,case,iterma
      parameter(nmax=300)
      real*8 pi,epsx,epsg,epsf,epsmach,tolmach,deldif,xst
      common/const/pi
      logical test1,test2,test3,analyt
      common/gradinf/analyt
      common/param/epsx,epsg,epsf,iterma,test1,test2,test3
      common/mach/epsmach,tolmach,deldif
      common/dim/n
      common/fdat/xst(nmax),case
      character*30 xifile,xofile
      character*80 ident 
      common/ident/ident,xifile,xofile
      integer maxit
      parameter (maxit=4000)
      integer niter,qnterm
      double precision eta,accinf(maxit,19)
      common/qnpar/niter,qnterm,eta,accinf

c******
      integer nn(5)
      integer j,k,ired1,ired2,iseed
      double precision u(nmax),lam(nmax),a(nmax),d(nmax),t(nmax)
      common/fudat/u,lam,a,d,t
      double precision cond(4),kappa
      real ran
      double precision r,vecnor,unorm,factor
      external vecnor
      data nn/10,30,50,70,100/
      data cond/1.d1,1.d2,1.d3,1.d4/
      iterma=2000
      test1=.false.
      test2=.false.
      test3=.false.
      iseed=425001
      if ( case .lt. 1 .or. case .gt. 60 )
     f   stop 'not implemented'
      i=case
      k=(i-1)/12
      n=nn(k+1)
      ired1=i-k*12
      j=(ired1-1)/4
      ired2=ired1-j*4
      kappa=cond(ired2)
      do i=1,n
        r=ran(iseed)
        u(i)=(0.5d0-r)
      enddo
      unorm=vecnor(1,n,u)
      factor=sqrt(2.d0)/unorm
      do i=1,n
        u(i)=u(i)*factor
      enddo
      do i=1,n
        r=ran(iseed)
c***** r is in [0,1]
        if ( j .eq. 0 ) then
          lam(i)=1.d0+(kappa-1.d0)*r
        elseif ( j .eq. 1 ) then
          lam(i)=1.d0+(kappa-1.d0)*r**4
        else
          lam(i)=kappa-(kappa-1.d0)*r**4
        endif
      enddo
      lam(1)=1.d0
      lam(n)=kappa
c******* condition number is exactly kappa
      do i=1,n
        r=ran(iseed)
        a(i)=r
        r=ran(iseed)
        d(i)=r*0.02d0
        r=ran(iseed)
        t(i)=r
      enddo      
      do i=1,n
        r=ran(iseed)
        xst(i)=(r-0.5d0)*2.d1
      enddo
      write(ident,fmt='(i3.3,i2.2,i1.1)') n,ired2,j+1      
      return
      end
      subroutine f(x,fx,err)
      implicit none
      integer nmax,cf,cg,cu,csu,cre,cm
      parameter (nmax=300)
      real*8 x(nmax),fx
      logical err
      integer n
      common/dim/n
      integer case
      real*8 xst
      common/fdat/xst(nmax),case
      character*80 ident 
      character*30 xifile,xofile
      common/ident/ident,xifile,xofile
      common/count/cf,cg,cu,csu,cre,cm
      double precision u(nmax),lam(nmax),a(nmax),d(nmax),t(nmax)
      common/fudat/u,lam,a,d,t
      integer i
      double precision utx,sum,uty,y(nmax),z(nmax),skal1
      external skal1
      err=.false.
      cf=cf+1
      utx=skal1(1,n,u,x)
      do i=1,n
        y(i)=(x(i)-utx*u(i))*lam(i)
      enddo
      uty=skal1(1,n,u,y)
      do i=1,n
        z(i)=y(i)-uty*u(i)
      enddo
      sum=0.5d0*skal1(1,n,x,z)
      do i=1,n
        sum=sum+a(i)*exp(d(i)*x(i)**2)+t(i)*x(i)**4
      enddo
      fx=sum
      return
      end    
c***************************************************************
      block data
      implicit none
      integer nmax
      parameter (nmax=300)
      logical test1,test2,test3,analyt
      common/gradinf/analyt
      integer iterma
      double precision epsx,epsg,epsf
      common/param/epsx,epsg,epsf,iterma,test1,test2,test3
      double precision epsmach,tolmach,deldif
      common/mach/epsmach,tolmach,deldif
      integer n
      common/dim/n
      character*30 xifile,xofile
      character*80 ident
      common/ident/ident,xifile,xofile
      integer icase
      double precision xst
      common/fdat/xst(nmax),icase
      data ident/'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'/
      data n/0/,xst/300*0.d0/,test1,test2,test3/3*.false./
      data analyt/.false./
      end
c****************************************************************
c     computes gradient by high precision numerical differentiation
c*******************************************************************
c copyright = spellucci 
      subroutine gradf(x,gradx,err)
      implicit none
      integer nx
      parameter (nx=300)
      logical err
      integer icf,icgf,iup,inoup,ires,imod
      common/count/icf,icgf,iup,inoup,ires,imod
      double precision x(nx),gradx(nx),fx(6)
      logical test1,test2,test3,test4
      double precision epsx,epsg,epsf
      common/param/epsx,epsg,epsf,test1,test2,test3,test4
      double precision epsmach,tolmach,deldif
      common/mach/epsmach,tolmach,deldif
      integer n
      common/dim/n
      integer i
      double precision z,xincr,d1,d2,d3,sd1,sd2,sd3
c****************************************************
c     high precision numerical differentiation
c     by sixth order extrapolation
c****************************************************
      err=.false.
      do   i=1,n
        z=x(i)
        xincr=deldif*(dabs(x(i))+1.d0)
        x(i)=z-xincr
        call f(x,fx(1),err)
        if ( err ) return
        x(i)=z+xincr
        call f(x,fx(2),err)
        if ( err ) return
      	xincr=xincr+xincr
        d1=xincr
        x(i)=z-xincr
        call f(x,fx(3),err)
        if ( err ) return
        x(i)=z+xincr
        call f(x,fx(4),err)
        if ( err ) return
        xincr=xincr+xincr
        d2=xincr
        x(i)=z-xincr
        call f(x,fx(5),err)
        if ( err ) return
        x(i)=z+xincr
        call f(x,fx(6),err)
        if ( err ) return
        x(i)=z
        d3=xincr+xincr
        sd1=(fx(2)-fx(1))/d1
        sd2=(fx(4)-fx(3))/d2
        sd3=(fx(6)-fx(5))/d3
        sd3=sd2-sd3
        sd2=sd1-sd2
        sd3=sd2-sd3
        gradx(i)=sd1+.4d0*sd2+sd3/45.d0
      enddo
      icgf=icgf+1
      return
      end