~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to routines/optim/n2qn1.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
ImportĀ upstreamĀ versionĀ 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
      subroutine n2qn1 (simul,n,x,f,g,dxmin,df1,epsabs,
 
2
c     Copyright INRIA
 
3
      & imp,io,mode,iter,nsim,binf,bsup,iz,rz,izs,rzs,dzs)
 
4
      implicit double precision (a-h,o-z)
 
5
      dimension x(n),g(n),dxmin(n),bsup(n),binf(n)
 
6
      dimension iz(*),rz(*),izs(*),dzs(*)
 
7
      real rzs(*)
 
8
      external simul
 
9
 1000 format (41h entree dans n2qn1. dimension du probleme,i4/
 
10
     & 6h mode=,i2,9h   niter=,i4,6h nsim=,i5,5h imp=,i3/
 
11
     & 5h df1=,d9.2,9h  epsabs=,d9.2/
 
12
     & 22h  dimensions minimales,2x,3hiz(,i4,8h)    rz(,i6,1h)/)
 
13
 1001 format (25h n2qn1   appel incoherent)
 
14
 1002 format(43h sortie de n2qn1. norme du gradient projete,d10.3/
 
15
     & 6h mode=,i2,9h   niter=,i4,7h  nsim=,i5)
 
16
      if (imp.eq.0) go to 10
 
17
      nw=n*(9+n)/2
 
18
      ni=2*n+1
 
19
      write (io,1000) n,mode,iter,nsim,imp,df1,epsabs,ni,nw
 
20
   10 if (n.gt.0 .and. (df1.gt.0.d0 .or. mode.ne.1)
 
21
     & .and. epsabs.ge.0.d0
 
22
     & .and. mode.ge.1 .and. mode.le.4
 
23
     & .and. iter.gt.0 .and. nsim.gt.0) go to 100
 
24
      write (io,1001)
 
25
      mode=2
 
26
      go to 999
 
27
  100 continue
 
28
      nd=1+(n*(n+1))/2
 
29
      nww=nd+n
 
30
      nww1=nww+n
 
31
      nga=nww1+n
 
32
      nindi=1
 
33
      nibloc=nindi+n
 
34
      ni=nibloc+n
 
35
c
 
36
c      calcul du test d arret
 
37
c
 
38
      s=0.d0
 
39
      do 110 i=1,n
 
40
  110 s=s+dxmin(i)*dxmin(i)
 
41
      epsabs=epsabs*dsqrt(s/dble(float(n)))
 
42
      call n2qn1a (simul,n,x,f,g,dxmin,epsabs,df1,mode,
 
43
     & iter,nsim,imp,io,rz,rz(nd),rz(nww),rz(nww1),
 
44
     & rz(nga),binf,bsup,iz(nindi),iz(nibloc),iz(ni),
 
45
     & izs,rzs,dzs)
 
46
      if(imp.gt.0) write(io,1002) epsabs,mode,iter,nsim
 
47
  999 return
 
48
      end