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 |
283 |
cph( |
cph( |
284 |
print *, 'pathei: vor gnorm0 ' |
print *, 'pathei: vor gnorm0 ' |
285 |
cph) |
cph) |
286 |
gnorm0 = SNRM2( nn, gg, 1 ) |
gnorm0 = DNRM2( nn, gg, 1 ) |
287 |
cph( |
cph( |
288 |
print *, 'pathei: gnorm0 = ', gnorm0 |
print *, 'pathei: gnorm0 = ', gnorm0 |
289 |
cph) |
cph) |
374 |
c----------------------------------------- |
c----------------------------------------- |
375 |
if (cold) then |
if (cold) then |
376 |
print iform, iiter, tact, ifunc, ff, gnorm0 |
print iform, iiter, tact, ifunc, ff, gnorm0 |
377 |
$ , SNRM2( nn, xx, 1 ), 0. |
$ , DNRM2( nn, xx, 1 ), 0. |
378 |
|
|
379 |
write(94,'(i5,2x,1pe11.4,4(2x,1pe8.1))') |
write(94,'(i5,2x,1pe11.4,4(2x,1pe8.1))') |
380 |
& iiter, ff, gnorm0, tact, |
& iiter, ff, gnorm0, tact, |
381 |
& SNRM2( nn, xx, 1 ), 0. |
& DNRM2( nn, xx, 1 ), 0. |
382 |
|
|
383 |
if ( itmax .EQ. 0 ) then |
if ( itmax .EQ. 0 ) then |
384 |
ifail = 10 |
ifail = 10 |
452 |
call lswri( iiter, nn, xx, gg, lphprint ) |
call lswri( iiter, nn, xx, gg, lphprint ) |
453 |
cph) |
cph) |
454 |
|
|
455 |
gnorm = SNRM2( nn, gg, 1 ) |
gnorm = DNRM2( nn, gg, 1 ) |
456 |
|
|
457 |
c----------------------------------------- |
c----------------------------------------- |
458 |
c print information line |
c print information line |
459 |
c----------------------------------------- |
c----------------------------------------- |
460 |
print iform, iiter, tact, ifunc, ff, gnorm |
print iform, iiter, tact, ifunc, ff, gnorm |
461 |
$ , SNRM2( nn, xx, 1 ), tact*SNRM2( nn, dd, 1 ) |
$ , DNRM2( nn, xx, 1 ), tact*DNRM2( nn, dd, 1 ) |
462 |
|
|
463 |
write(94,'(i5,2x,1pe11.4,4(2x,1pe8.1))') |
write(94,'(i5,2x,1pe11.4,4(2x,1pe8.1))') |
464 |
& iiter, ff, gnorm, tact, |
& iiter, ff, gnorm, tact, |
465 |
& SNRM2( nn, xx, 1 ), tact*SNRM2( nn, dd, 1 ) |
& DNRM2( nn, xx, 1 ), tact*DNRM2( nn, dd, 1 ) |
466 |
|
|
467 |
c----------------------------------------- |
c----------------------------------------- |
468 |
c check output mode of ifail |
c check output mode of ifail |
497 |
gold(i) = gg(i)-gold(i) |
gold(i) = gg(i)-gold(i) |
498 |
end do |
end do |
499 |
|
|
500 |
ys = SDOT( nn, gold, 1, xdiff, 1 ) |
ys = DDOT( nn, gold, 1, xdiff, 1 ) |
501 |
if (ys .le. 0.) then |
if (ys .le. 0.) then |
502 |
ifail = 4 |
ifail = 4 |
503 |
print *, 'pathei-lsopt: ys < 0; ifail = ', ifail |
print *, 'pathei-lsopt: ys < 0; ifail = ', ifail |
539 |
c compute sbar, ybar store rec = min 4,5 |
c compute sbar, ybar store rec = min 4,5 |
540 |
c----------------------------------------- |
c----------------------------------------- |
541 |
r1 = sqrt(1./ys) |
r1 = sqrt(1./ys) |
542 |
call SSCAL( nn, r1, xdiff, 1 ) |
call DSCAL( nn, r1, xdiff, 1 ) |
543 |
call SSCAL( nn, r1, gold, 1 ) |
call DSCAL( nn, r1, gold, 1 ) |
544 |
|
|
545 |
if (lphprint) |
if (lphprint) |
546 |
& print *, 'pathei-lsopt: dostore at iiter, jmin, jmax ', |
& print *, 'pathei-lsopt: dostore at iiter, jmin, jmax ', |
628 |
print '(a,e15.8)' |
print '(a,e15.8)' |
629 |
$ , ' cost function...............', ff |
$ , ' cost function...............', ff |
630 |
print '(a,e15.8)' |
print '(a,e15.8)' |
631 |
$ , ' norm of x...................', SNRM2( nn, xx, 1 ) |
$ , ' norm of x...................', DNRM2( nn, xx, 1 ) |
632 |
print '(a,e15.8)' |
print '(a,e15.8)' |
633 |
$ , ' norm of g...................', SNRM2( nn, gg, 1 ) |
$ , ' norm of g...................', DNRM2( nn, gg, 1 ) |
634 |
end if |
end if |
635 |
|
|
636 |
c----------------------------------------- |
c----------------------------------------- |