67 lines
1.8 KiB
FortranFixed
67 lines
1.8 KiB
FortranFixed
subroutine bookkeeping(nunknowns,xvar,fequ,
|
|
& icall,iflargest)
|
|
implicit none
|
|
include 'nslasystem.h'
|
|
integer nunknowns,icall,iflargest
|
|
double precision xvar(nunknowns),fequ(nunknowns)
|
|
integer iGuCall,i,j,k
|
|
parameter(iGuCall=49)
|
|
!--------------------------------------------------------------------------
|
|
iflargest=1
|
|
do j=2,nunknowns
|
|
if(dabs(fequ(j)).gt.dabs(fequ(iflargest)))
|
|
& iflargest=j
|
|
enddo
|
|
if(numeval.eq.maxeval)goto 100
|
|
if(numeval.eq.0.or.icall.eq.iGuCall)then
|
|
numeval=numeval+1
|
|
flargest(numeval)=dabs(fequ(iflargest))
|
|
do i=1,nunknowns
|
|
xevaluated(numeval,i)=xvar(i)
|
|
fevaluated(numeval,i)=fequ(i)
|
|
enddo
|
|
return
|
|
endif
|
|
100 do i=1,numeval
|
|
k=0
|
|
do j=1,nunknowns
|
|
if(dabs(xvar(j)-xevaluated(i,j)).gt.
|
|
& 1.0d-5*dabs(xvar(j)))k=1
|
|
enddo
|
|
if(k.eq.0)goto 500
|
|
enddo
|
|
if(numeval.lt.maxeval)then
|
|
numeval=numeval+1
|
|
flargest(numeval)=dabs(fequ(iflargest))
|
|
do i=1,nunknowns
|
|
xevaluated(numeval,i)=xvar(i)
|
|
fevaluated(numeval,i)=fequ(i)
|
|
enddo
|
|
return
|
|
endif
|
|
! replace a point
|
|
j=1
|
|
do i=2,numeval
|
|
if(flargest(j).lt.flargest(i))then
|
|
j=i
|
|
endif
|
|
enddo
|
|
if(dabs(fequ(iflargest)).lt.flargest(j))then
|
|
flargest(j)=dabs(fequ(iflargest))
|
|
do i=1,nunknowns
|
|
xevaluated(j,i)=xvar(i)
|
|
fevaluated(j,i)=fequ(i)
|
|
enddo
|
|
endif
|
|
return
|
|
! too close to the existing point i
|
|
500 if(dabs(fequ(iflargest)).lt.flargest(i))then
|
|
flargest(i)=dabs(fequ(iflargest))
|
|
do j=1,nunknowns
|
|
xevaluated(i,j)=xvar(j)
|
|
fevaluated(i,j)=fequ(j)
|
|
enddo
|
|
endif
|
|
return
|
|
end
|