1 c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
4 c This file must be used under the terms of the CeCILL.
5 c This source file is licensed as described in the file COPYING, which
6 c you should have received as part of this distribution. The terms
7 c are also available at
8 c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 subroutine n1fc1o(unit,job,i1,i2,i3,i4,i5,d1,d2,d3,d4)
12 c impression des traces
14 implicit double precision (a-h,o-z)
15 integer unit,lunit,job,i1,i2,i3,i4,i5(*)
23 goto(11,12,13,14,15,16,17,18,19,20,
24 & 21,22,23,24,25,26,27,28,29,30,
25 & 31,32,33,34,35,36,37,38,39,40,
26 & 41,42,43,44,45,46,47,48,49,50,
27 & 51,52,53,54,55,56,57,58,59,60) job
30 call basout(io,lunit,'n1fc1 incorrect call')
38 write (buf,'(''entry in n1fc1 . n='',i4,'' memax='',i3)') n,memax
39 call basout(io,lunit,buf(1:35))
40 write (buf,"(a24,i6,a6,i6,a6,i6,a1)")
41 & "minimal array sizes: iz(", niz,
45 call basout(io,lunit,buf(1:55))
48 call basout(io,lunit,'n1fc1 initial gradient norm is zero')
51 1000 format (19h n1fc1 iter nsim,6x,2hfn,11x,3heps,7x,2hs2,
56 write(buf,'(''n1fc1 end with iter ='',i1)') i1
57 call basout(io,lunit,buf(1:30))
60 call basout(io,lunit,'n1fc1 Incorrect end of fprf2')
64 write(buf,'(''n1fc1 eta2 assigned to '',d10.3)') eta2
65 call basout(io,lunit,buf(1:35))
73 write (buf,1018) iter,nsim,fn,epsm,s2
74 1018 format(6h n1fc1,i7,i5,d16.7,16h convergence a,d10.3,5h pres,
76 call basout(io,lunit,buf(1:lnblnk(buf)))
79 call basout(io,lunit,'n1fc1 normal end')
82 call basout(io,lunit,' ')
92 write (buf,'(''n1fc1 '',1i4,i5,2x,d14.7,3d10.2,i3)') iter,
94 call basout(io,lunit,buf(1:lnblnk(buf)))
98 call basout(io,lunit,'n1fc1 ponderation table')
100 if(7*nn.lt.ntot) nn=nn+1
104 write (buf,'(7x,7d10.3)') (d4(l+j),j=1,ln)
105 call basout(io,lunit,buf(1:lnblnk(buf)))
109 call basout(io,lunit,'n1fc1 la direction ne pivote plus')
112 call basout(io,lunit,'n1fc1 end (dxmin reached)')
115 call basout(io,lunit,'n1fc1 end (nsim reached)')
118 call basout(io,lunit,'n1fc1 end (indic=0)')
121 call basout(io,lunit,'n1fc1 warning txmax reached, reduce scale')
127 write (buf,2801) diam1,eta2,ap
128 2801 format (6h n1fc1,12x,6hdiam1=,d10.3,4x,5heta2=,d10.3,4x,
130 call basout(io,lunit,buf(1:lnblnk(buf)))
137 write (buf,2901) iter,nsim,fn,ntot
138 2901 format(6h n1fc1,i7,i5,d16.7,20h faisceau reduit a,
140 call basout(io,lunit,buf(1:lnblnk(buf)))
147 write (buf,3001) logic,ro,tps,tnc
148 3001 format (6h n1fc1,10x,6hlogic=,i2,4x,3hro=,d10.3,
149 1 4x,4htps=,d10.3,4x,4htnc=,d10.3)
150 call basout(io,lunit,buf(1:lnblnk(buf)))
159 call basout(io,lunit,'a = ')
161 if(10*nn.lt.nt1) nn=nn+1
165 write (buf,'(6x,10d10.3)') (d3(l+j),j=1,ln)
166 call basout(io,lunit,buf(1:lnblnk(buf)))
169 write(buf,'('' epsilon ='',d10.3)') deps
170 call basout(io,lunit,buf(1:lnblnk(buf)))
172 call basout(io,lunit,'(g,g) = ')
176 if(10*nn.lt.j) nn=nn+1
180 write (buf,'(6x,10d10.3)') (d4(mej+l+jj),jj=1,ln)
181 call basout(io,lunit,buf(1:lnblnk(buf)))
188 call basout(io,lunit,' initial corral')
189 write(buf,'(20i6)') (i5(k),k=1,nv)
190 call basout(io,lunit,buf(1:lnblnk(buf)))
193 call basout(io,lunit,
194 $ ' error from fprf2. old solution already optimal')
197 call basout(io,lunit,' epsilon smaller than a')
201 write(buf,'('' start with variables 1 and,'',i4)') j
202 call basout(io,lunit,buf(1:lnblnk(buf)))
206 call basout(io,lunit,'x = ')
208 if(10*nn.lt.nv) nn=nn+1
212 write (buf,'(3x,10d10.3)') (d4(l+j),j=1,ln)
213 call basout(io,lunit,buf(1:lnblnk(buf)))
218 call basout(io,lunit,' fprf2 is apparently looping')
224 write(buf,3801) s2,j0,sp
225 3801 format(7h (s,s)=,d12.4,10h variable,i4,
226 &2h (,d12.4,12h) coming in.)
227 call basout(io,lunit,buf(1:lnblnk(buf)))
232 write(buf,3901) s2,u1
233 3901 format(7h (s,s)=,d12.4,5h u1=,d12.3,23h variable 1 coming in.)
234 call basout(io,lunit,buf(1:lnblnk(buf)))
237 write(buf,'('' duplicate variable '',i3)') j0
238 call basout(io,lunit,buf(1:lnblnk(buf)))
244 write(buf,'(''cholesky '',d11.3)') d3(1)
245 call basout(io,lunit,buf(1:lnblnk(buf)))
250 if(10*nn.lt.k1) nn=nn+1
255 write (buf,'(3x,10d10.3)') (d4((l+kk-1)*mm1+ll),kk=1,nn)
256 call basout(io,lunit,buf(1:lnblnk(buf)))
260 write(buf,'(3x,10d10.3)') (d4((l+kk-1)*mm1+ll),kk=1,nn),
262 call basout(io,lunit,buf(1:lnblnk(buf)))
272 write(buf,4201) k0,l,yk0,ps1,ps2
273 4201 format(9h variable,i4,2h (,i4,3h) =,d11.3,11h going out.,
274 & 17h feasible (s,s)=,d11.4,12h unfeasible=,d11.4)
275 call basout(io,lunit,buf(1:lnblnk(buf)))
286 write(buf,4401) nc,nv,s2,sp,u1
287 4401 format(14h finished with,i3,10h gradients,i3,
289 & 7h (s,s)=,d11.4,6h test=,d11.4/
290 & 32h cost of the extra constraint u=,d12.5)
292 if(10*nn.lt.nv) nn=nn+1
296 write (buf,'(20i6)') (i5(l+k),k=1,ln)
297 call basout(io,lunit,buf(1:lnblnk(buf)))
306 4501 format (/4x,6h nlis2,10x,17htmin force a tmax)
307 call basout(io,lunit,buf(1:lnblnk(buf)))
313 call basout(io,lunit,' ')
314 write (buf,4601) fpn,d2,tmin,tmax
315 4601 format (4x,9h nlis2 ,4x,4hfpn=,d10.3,4h d2=,d9.2,
316 1 7h tmin=,d9.2,6h tmax=,d9.2)
317 call basout(io,lunit,buf(1:lnblnk(buf)))
320 call basout(io,lunit,' ')
322 4701 format (4x,6h nlis2,3x,i5,22h simulations atteintes)
323 call basout(io,lunit,buf(1:lnblnk(buf)))
326 call basout(io,lunit,'Stop required by user')
331 write(buf,4901) t,indic
332 4901 format (4x,6h nlis2,36x,1hi,d10.3,7h indic=,i3)
333 call basout(io,lunit,buf(1:lnblnk(buf)))
339 write(buf,5001) t,ffn,fp
340 5001 format (4x,6h nlis2,36x,1hi,d10.3,2d11.3)
341 call basout(io,lunit,buf(1:lnblnk(buf)))
345 write(buf,5101) t,ffn,fp
346 5101 format (4x,6h nlis2,d13.3,2d11.3,2h i)
347 call basout(io,lunit,buf(1:lnblnk(buf)))
351 write(buf,5201) logic
352 5201 format (4x,6h nlis2,3x,20hcontrainte implicite,i4,7h active)
353 call basout(io,lunit,buf(1:lnblnk(buf)))
357 call basout(io,lunit,'nlis2 end (tmin reached)')