@@ -7,7 +7,7 @@
Loading
7 7
8 8
typedef void (*S2_fp) (int *, int *, double *, double *, double *, int *, float *, double *);
9 9
extern "C" void n1qn1_ (S2_fp simul, int n[], double x[], double f[], double g[], double var[], double eps[],
10 -
                        int mode[], int niter[], int nsim[], int imp[], int lp[], double zm[], int izs[], float rzs[], double dzs[]);
10 +
                        int mode[], int niter[], int nsim[], int imp[], double zm[], int izs[], float rzs[], double dzs[]);
11 11
12 12
unsigned int n1qn1_calls = 0, n1qn1_grads = 0;
13 13
int n1qn1_fprint = 0;
@@ -87,7 +87,7 @@
Loading
87 87
  std::fill(&var[0], &var[0]+n, 0.1);
88 88
  
89 89
  n1qn1_(fwrap,&n,x,&f,g,var,&eps,
90 -
         &mode,&niter,&nsim,&imp,&lp,zm,izs,rzs,dzs);
90 +
         &mode,&niter,&nsim,&imp,zm,izs,rzs,dzs);
91 91
        
92 92
  Rcpp::NumericVector par(n);
93 93
  std::copy(&x[0],&x[0]+n,&par[0]);

@@ -11,7 +11,7 @@
Loading
11 11
c along with this program.
12 12
c
13 13
      subroutine rlbd(indrl,n,simul,x,binf,bsup,f,hp,t,tmax,d,gn,
14 -
     &     tproj,amd,amf,iprint,zero,nap,napmax,xn,izs,rzs,dzs)
14 +
     &     tproj,amd,amf,zero,nap,napmax,xn,izs,rzs,dzs)
15 15
c
16 16
c!but
17 17
c     subroutine de recherche lineaire pour des problemes avec
@@ -124,7 +124,6 @@
Loading
124 124
      character var2*3
125 125
      dimension x(n),xn(n),gn(n),d(n),binf(n),bsup(n),izs(*)
126 126
      double precision dzs(*)
127 -
      character bufstr*(4096)
128 127
      real rzs(*)
129 128
c
130 129
      indrl=1

@@ -12,7 +12,7 @@
Loading
12 12
c For more information, see the COPYING file which you should have received
13 13
c along with this program.
14 14
c
15 -
      subroutine qnbd(indqn,simul,n,x,f,g,iprint,zero,
15 +
      subroutine qnbd(indqn,simul,n,x,f,g,zero,
16 16
     &     napmax,itmax,epsf,epsg,epsx,df0,binf,bsup,nfac,
17 17
     & trav,ntrav,itrav,nitrav,izs,rzs,dzs)
18 18
c!but
@@ -106,7 +106,6 @@
Loading
106 106
      implicit double precision (a-h,o-z)
107 107
      real rzs(*)
108 108
      double precision dzs(*)
109 -
      character bufstr*(4096)
110 109
      dimension binf(n),bsup(n),x(n),g(n),epsx(n)
111 110
      dimension trav(ntrav),itrav(nitrav),izs(*)
112 111
      external simul
@@ -176,7 +175,7 @@
Loading
176 175
         return
177 176
      endif
178 177
      call zqnbd(indqn,simul,trav(1),n,binf,bsup,x,f,g,zero,napmax,
179 -
     &itmax,itrav,itrav(ni1),nfac,iprint,epsx,epsf,epsg,trav(n1),
178 +
     &itmax,itrav,itrav(ni1),nfac,epsx,epsf,epsg,trav(n1),
180 179
     &trav(n2),trav(n3),trav(n4),df0,ig,in,irel,izag,iact,
181 180
     &epsrel,ieps1,izs,rzs,dzs)
182 181
      return

@@ -5,8 +5,19 @@
Loading
5 5
6 6
typedef void (*S2_fp) (int *, int *, double *, double *, double *, int *, float *, double *);
7 7
extern void n1qn1_(S2_fp simul, int n[], double x[], double f[], double g[], double var[], double eps[],
8 -
		   int mode[], int niter[], int nsim[], int imp[], int lp[], double zm[], int izs[], 
8 +
		   int mode[], int niter[], int nsim[], int imp[], double zm[], int izs[], 
9 9
		   float rzs[], double dzs[]);
10 +
void n1qn1F(S2_fp simul, int n[], double x[], double f[], double g[], double var[], double eps[],
11 +
		   int mode[], int niter[], int nsim[], int imp[], int lp[], double zm[], int izs[], 
12 +
		   float rzs[], double dzs[]) {
13 +
  n1qn1_(simul, n, x, f, g, var, eps, mode, niter, nsim, imp, zm, izs, rzs, dzs);
14 +
}
15 +
16 +
void n1qn1F2(S2_fp simul, int n[], double x[], double f[], double g[], double var[], double eps[],
17 +
		   int mode[], int niter[], int nsim[], int imp[], double zm[], int izs[], 
18 +
		   float rzs[], double dzs[]) {
19 +
  n1qn1_(simul, n, x, f, g, var, eps, mode, niter, nsim, imp, zm, izs, rzs, dzs);
20 +
}
10 21
/* .C calls */
11 22
extern SEXP n1qn1_wrap(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
12 23
extern SEXP qnbd_wrap(SEXP, SEXP, SEXP, SEXP, SEXP, 
@@ -27,7 +38,8 @@
Loading
27 38
28 39
void R_init_n1qn1(DllInfo *dll)
29 40
{
30 -
  R_RegisterCCallable("n1qn1","n1qn1F", (DL_FUNC) n1qn1_);
41 +
  R_RegisterCCallable("n1qn1","n1qn1F", (DL_FUNC) n1qn1F);
42 +
  R_RegisterCCallable("n1qn1","n1qn1F2", (DL_FUNC) n1qn1F2);
31 43
  R_RegisterCCallable("n1qn1","qnbdF", (DL_FUNC) qnbd_);
32 44
  R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
33 45
  R_useDynamicSymbols(dll, TRUE);

@@ -30,7 +30,6 @@
Loading
30 30
            dh(k)=dh(k)+g1(i)*w(j)
31 31
         end do
32 32
      end do
33 -
20    continue
34 33
25    k=n2fac+nfac*nnfac
35 34
      do j=nfac1,n
36 35
         do i=j,n
@@ -38,7 +37,6 @@
Loading
38 37
            dh(k)=dh(k) + g1(i)*w(j)
39 38
         end do
40 39
      end do
41 -
30    continue
42 40
50    ir=nfac
43 41
      if(nfac.eq.0)return
44 42
      call majour(dh,g1,w,nfac,sig,ir,mk,epsmc)

@@ -11,13 +11,12 @@
Loading
11 11
c along with this program.
12 12
c
13 13
      subroutine zqnbd(indqn,simul,dh,n,binf,bsup,x,f,g,zero,napmax,
14 -
     &     itmax,indic,izig,nfac,iprint,epsx,epsf,epsg,x1,x2,g1,dir,df0,
14 +
     &     itmax,indic,izig,nfac,epsx,epsf,epsg,x1,x2,g1,dir,df0,
15 15
     &ig,in,irel,izag,iact,epsrel,ieps1,izs,rzs,dzs)
16 16
c
17 17
      implicit double precision (a-h,o-z)
18 18
      real rzs(*)
19 19
      double precision dzs(*)
20 -
      character bufstr*(4096)
21 20
      dimension x1(n),x2(n),g1(n),dir(n),epsx(n)
22 21
      dimension binf(n),bsup(n),x(n),g(n),dh(*),indic(n),izig(n),
23 22
     &izs(*)
@@ -279,7 +278,6 @@
Loading
279 278
            dir(i)=dir(i) + dh(k)*x2(j)
280 279
         end do
281 280
      end do
282 -
264   continue
283 281
265   continue
284 282
      k=n2fac+nfac*nnfac
285 283
      do j=nfac1,n
@@ -357,7 +355,7 @@
Loading
357 355
      scal1=scal
358 356
      if(ieps1.eq.1)scal1=0.0d+0
359 357
      if(ieps1.eq.2)scal1=scal*cscal1
360 -
 305  do i=1,n
358 +
      do i=1,n
361 359
         x1(i)=x(i)-scal1*abs(g(i))*g(i)
362 360
      end do
363 361
      call proj(n,binf,bsup,x1)
@@ -438,7 +436,6 @@
Loading
438 436
         i1=indic(i)
439 437
         x2(i1)=g(i)
440 438
      end do
441 -
641   continue
442 439
      if(ir.lt.nfac) go to 412
443 440
      if(nfac.gt.1) go to 400
444 441
      x2(1)=x2(1)/dh(1)
@@ -488,7 +485,6 @@
Loading
488 485
         if(izig(i).gt.0)dir(i)=0.
489 486
         if(indic(i).gt.nfac)dir(i)=0.0d+0
490 487
      end do
491 -
670   continue
492 488
675   continue
493 489
c
494 490
c     recherche lineaire
@@ -547,7 +543,7 @@
Loading
547 543
      napm1=nap + napm
548 544
      if(napm1.gt.napmax)napm1=napmax
549 545
      call rlbd(indrl,n,simul,x,binf,bsup,fn,fpn,t,tmax,dir,g,
550 -
     &     tproj,amd,amf,iprint,zero,nap,napm1,x2,izs,rzs,dzs)
546 +
     &     tproj,amd,amf,zero,nap,napm1,x2,izs,rzs,dzs)
551 547
      if(indrl.ge.10)then
552 548
         indsim=4
553 549
         nap=nap + 1
@@ -575,7 +571,6 @@
Loading
575 571
         return
576 572
      endif
577 573
c
578 -
778   continue
579 574
      if(nap.lt.napmax)go to 758
580 575
      f=fn
581 576
c$$$      if(iprint.gt.0) then
@@ -595,7 +590,6 @@
Loading
595 590
      do i=1,n
596 591
         if(abs(x(i)-x1(i)).gt.epsx(i))go to 806
597 592
      end do
598 -
805   continue
599 593
      f=fn
600 594
c$$$      if(iprint.gt.0) then
601 595
c$$$        write(bufstr,1805)

@@ -55,7 +55,7 @@
Loading
55 55
 35      w(nw)=h(nh)
56 56
         nw=nw-1
57 57
         nh=nh-1
58 -
 40      nsaut=nsaut+1
58 +
         nsaut=nsaut+1
59 59
      end do
60 60
      do j=1,inc-nr1
61 61
         h(nh+nsaut)=h(nh)
@@ -136,7 +136,6 @@
Loading
136 136
            h(nh+nsaut)=h(nh)
137 137
            nh=nh-1
138 138
         end do
139 -
 210     continue
140 139
      end do
141 140
  220 h(nr1)=w(1)
142 141
      if(n.eq.nr1) go to 233
@@ -207,11 +206,9 @@
Loading
207 206
            nh=nh+1
208 207
            nh1=nh1+1
209 208
         end do
210 -
 300     continue
211 209
         nh=nh+1
212 210
         di=di*di1/c
213 211
      end do
214 -
  310 continue
215 212
c          condensation de la matrice l
216 213
  315 nh=inc+1
217 214
      nsaut=1
@@ -244,7 +241,6 @@
Loading
244 241
            h(nh+j)=h(nh+nsaut+j)
245 242
         end do
246 243
 455     nh=nh+nrr+1
247 -
 460     continue
248 244
      end do
249 245
  470 nw=nw+1
250 246
      if(nr.eq.n) go to 485
@@ -263,7 +259,6 @@
Loading
263 259
         end do
264 260
 495     nh=nh+nrr+1
265 261
      end do
266 -
  500 continue
267 262
  510 h(nh)=w(inc)
268 263
      if(nr.eq.n) go to 540
269 264
      do i=1,nrr

@@ -24,7 +24,7 @@
Loading
24 24
c http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
25 25
c
26 26
      subroutine n1qn1 (simul,n,x,f,g,var,eps,
27 -
     1     mode,niter,nsim,imp,lp,zm,izs,rzs,dzs)
27 +
     1     mode,niter,nsim,imp,zm,izs,rzs,dzs)
28 28
c
29 29
c!but
30 30
c     minimisation d une fonction reguliere sans contraintes
@@ -89,7 +89,7 @@
Loading
89 89
      nxb=nga+n
90 90
      ngb=nxb+n
91 91
      call n1qn1a (simul,n,x,f,g,var,eps,mode,
92 -
     1 niter,nsim,imp,lp,zm,zm(nd),zm(nw),zm(nxa),zm(nga),
92 +
     1 niter,nsim,imp,zm,zm(nd),zm(nw),zm(nxa),zm(nga),
93 93
     2 zm(nxb),zm(ngb),izs,rzs,dzs)
94 94
      end
95 95
c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
@@ -102,7 +102,7 @@
Loading
102 102
c http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
103 103
c
104 104
      subroutine n1qn1a (simul,n,x,f,g,scale,acc,mode,
105 -
     1     niter,nsim,iprint,lp,h,d,w,xa,ga,xb,gb,izs,rzs,dzs)
105 +
     1     niter,nsim,iprint,h,d,w,xa,ga,xb,gb,izs,rzs,dzs)
106 106
c
107 107
108 108
*     A (very) few modifs by Bruno (14 March 2005): I have translated some output
@@ -117,15 +117,9 @@
Loading
117 117
     1 xa(n),ga(n),xb(n),gb(n),izs(*),dzs(*)
118 118
      real rzs(*)
119 119
      external simul
120 -
      double precision dnrm2 ! (blas routine) added by Bruno to get
121 -
                             ! a better information concerning directionnal derivative
120 +
      ! (blas routine) added by Bruno to get
121 +
      ! a better information concerning directionnal derivative
122 122
      integer vff
123 -
      real f1(1)
124 -
 1000 format (46h n1qn1 ne peut demarrer (contrainte implicite))
125 -
 1001 format (40h n1qn1 termine par voeu de l'utilisateur)
126 -
 1010 format (45h n1qn1 remplace le hessien initial (qui n'est,
127 -
     1 20h pas defini positif)/27h par une diagonale positive)
128 -
 1023 format (40h n1qn1 bute sur une contrainte implicite)
129 123
c
130 124
c              calcul initial de fonction-gradient
131 125
c
@@ -422,8 +416,7 @@
Loading
422 416
      do i=1,n
423 417
         dd(i)=hd(i)
424 418
      end do
425 -
 4    continue
426 -
      do 5 i=1,n
419 +
      do i=1,n
427 420
         iplus=i+1
428 421
         del=dd(i)
429 422
         if(hm(ll).gt.0.0d+0) go to 6
@@ -438,6 +431,7 @@
Loading
438 431
            dd(j)=dd(j)-del*hm(ll)
439 432
         end do
440 433
 7       ll=ll+1
434 +
      end do
441 435
 5    continue
442 436
c
443 437
 3    continue
Files Coverage
src 22.98%
R/n1qn1.R 54.84%
Project Totals (12 files) 23.66%
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading