50 |
|
|
51 |
implicit none |
implicit none |
52 |
|
|
53 |
#include <blas1.h> |
ccc#include <blas1.h> |
54 |
|
|
55 |
c----------------------------------------- |
c----------------------------------------- |
56 |
c declare arguments |
c declare arguments |
82 |
double precision fold, ys |
double precision fold, ys |
83 |
double precision dotdg |
double precision dotdg |
84 |
|
|
85 |
external SDOT, SNRM2, SSCAL |
external DDOT, DNRM2, DSCAL |
86 |
double precision SDOT, SNRM2 |
double precision DDOT, DNRM2 |
87 |
|
|
88 |
c----------------------------------------- |
c----------------------------------------- |
89 |
c parameters |
c parameters |
125 |
mm = nn |
mm = nn |
126 |
mupd = nupdate |
mupd = nupdate |
127 |
|
|
128 |
REAL_BYTE = 8 |
REAL_BYTE = 4 |
129 |
isize = REAL_BYTE |
isize = REAL_BYTE |
130 |
|
|
131 |
c----------------------------------------- |
c----------------------------------------- |
255 |
c--- start if cold start --- |
c--- start if cold start --- |
256 |
if (lphprint) then |
if (lphprint) then |
257 |
print '(a)', 'pathei-lsopt: cold start' |
print '(a)', 'pathei-lsopt: cold start' |
|
print * |
|
258 |
end if |
end if |
259 |
|
|
260 |
|
print *, 'pathei-lsopt vor simul', nn |
261 |
|
print *, 'pathei-lsopt xx(1), gg(1) ', xx(1), gg(1) |
262 |
|
|
263 |
call simul( indic, nn, xx, ff, gg ) |
call simul( indic, nn, xx, ff, gg ) |
264 |
cph( |
|
265 |
print *, 'pathei: nach simul: nn, ff = ', nn, ff |
print *, 'pathei: nach simul: nn, ff = ', nn, ff |
266 |
print *, 'pathei: nach simul: xx, gg = ', xx(1), gg(1) |
print *, 'pathei: nach simul: xx(1), gg(1) = ', xx(1), gg(1) |
|
cph) |
|
267 |
|
|
268 |
do i = 1, nn |
do i = 1, nn |
269 |
xdiff(i) = 1. |
xdiff(i) = 1. |
279 |
cph( |
cph( |
280 |
print *, 'pathei: vor lswri ' |
print *, 'pathei: vor lswri ' |
281 |
cph) |
cph) |
282 |
call lswri( iiter, nn, xx, gg, lphprint ) |
call lswri( isize, iiter, nn, xx, gg, lphprint ) |
283 |
|
|
284 |
cph( |
cph( |
285 |
print *, 'pathei: vor gnorm0 ' |
print *, 'pathei: vor gnorm0 ' |
286 |
cph) |
cph) |
287 |
gnorm0 = SNRM2( nn, gg, 1 ) |
gnorm0 = DNRM2( nn, gg, 1 ) |
288 |
cph( |
cph( |
289 |
print *, 'pathei: gnorm0 = ', gnorm0 |
print *, 'pathei: gnorm0 = ', gnorm0 |
290 |
cph) |
cph) |
375 |
c----------------------------------------- |
c----------------------------------------- |
376 |
if (cold) then |
if (cold) then |
377 |
print iform, iiter, tact, ifunc, ff, gnorm0 |
print iform, iiter, tact, ifunc, ff, gnorm0 |
378 |
$ , SNRM2( nn, xx, 1 ), 0. |
$ , DNRM2( nn, xx, 1 ), 0. |
379 |
|
|
380 |
write(94,'(i5,2x,1pe11.4,4(2x,1pe8.1))') |
write(94,'(i5,2x,1pe11.4,4(2x,1pe8.1))') |
381 |
& iiter, ff, gnorm0, tact, |
& iiter, ff, gnorm0, tact, |
382 |
& SNRM2( nn, xx, 1 ), 0. |
& DNRM2( nn, xx, 1 ), 0. |
383 |
|
|
384 |
if ( itmax .EQ. 0 ) then |
if ( itmax .EQ. 0 ) then |
385 |
ifail = 10 |
ifail = 10 |
450 |
call dostore( nn, xx, .true., 1 ) |
call dostore( nn, xx, .true., 1 ) |
451 |
call dostore( nn, gg, .true., 2 ) |
call dostore( nn, gg, .true., 2 ) |
452 |
cph( |
cph( |
453 |
call lswri( iiter, nn, xx, gg, lphprint ) |
call lswri( isize, iiter, nn, xx, gg, lphprint ) |
454 |
cph) |
cph) |
455 |
|
|
456 |
gnorm = SNRM2( nn, gg, 1 ) |
gnorm = DNRM2( nn, gg, 1 ) |
457 |
|
|
458 |
c----------------------------------------- |
c----------------------------------------- |
459 |
c print information line |
c print information line |
460 |
c----------------------------------------- |
c----------------------------------------- |
461 |
print iform, iiter, tact, ifunc, ff, gnorm |
print iform, iiter, tact, ifunc, ff, gnorm |
462 |
$ , SNRM2( nn, xx, 1 ), tact*SNRM2( nn, dd, 1 ) |
$ , DNRM2( nn, xx, 1 ), tact*DNRM2( nn, dd, 1 ) |
463 |
|
|
464 |
write(94,'(i5,2x,1pe11.4,4(2x,1pe8.1))') |
write(94,'(i5,2x,1pe11.4,4(2x,1pe8.1))') |
465 |
& iiter, ff, gnorm, tact, |
& iiter, ff, gnorm, tact, |
466 |
& SNRM2( nn, xx, 1 ), tact*SNRM2( nn, dd, 1 ) |
& DNRM2( nn, xx, 1 ), tact*DNRM2( nn, dd, 1 ) |
467 |
|
|
468 |
c----------------------------------------- |
c----------------------------------------- |
469 |
c check output mode of ifail |
c check output mode of ifail |
498 |
gold(i) = gg(i)-gold(i) |
gold(i) = gg(i)-gold(i) |
499 |
end do |
end do |
500 |
|
|
501 |
ys = SDOT( nn, gold, 1, xdiff, 1 ) |
ys = DDOT( nn, gold, 1, xdiff, 1 ) |
502 |
if (ys .le. 0.) then |
if (ys .le. 0.) then |
503 |
ifail = 4 |
ifail = 4 |
504 |
print *, 'pathei-lsopt: ys < 0; ifail = ', ifail |
print *, 'pathei-lsopt: ys < 0; ifail = ', ifail |
540 |
c compute sbar, ybar store rec = min 4,5 |
c compute sbar, ybar store rec = min 4,5 |
541 |
c----------------------------------------- |
c----------------------------------------- |
542 |
r1 = sqrt(1./ys) |
r1 = sqrt(1./ys) |
543 |
call SSCAL( nn, r1, xdiff, 1 ) |
call DSCAL( nn, r1, xdiff, 1 ) |
544 |
call SSCAL( nn, r1, gold, 1 ) |
call DSCAL( nn, r1, gold, 1 ) |
545 |
|
|
546 |
if (lphprint) |
if (lphprint) |
547 |
& print *, 'pathei-lsopt: dostore at iiter, jmin, jmax ', |
& print *, 'pathei-lsopt: dostore at iiter, jmin, jmax ', |
629 |
print '(a,e15.8)' |
print '(a,e15.8)' |
630 |
$ , ' cost function...............', ff |
$ , ' cost function...............', ff |
631 |
print '(a,e15.8)' |
print '(a,e15.8)' |
632 |
$ , ' norm of x...................', SNRM2( nn, xx, 1 ) |
$ , ' norm of x...................', DNRM2( nn, xx, 1 ) |
633 |
print '(a,e15.8)' |
print '(a,e15.8)' |
634 |
$ , ' norm of g...................', SNRM2( nn, gg, 1 ) |
$ , ' norm of g...................', DNRM2( nn, gg, 1 ) |
635 |
end if |
end if |
636 |
|
|
637 |
c----------------------------------------- |
c----------------------------------------- |