52 lines
1.8 KiB
FortranFixed
52 lines
1.8 KiB
FortranFixed
subroutine shortestdist(my0,nx,pointy,
|
|
& pointx,xmin,xmax,nparams0,params0,
|
|
& iknowder0,shorty,shortx)
|
|
!find the point on the surface that has the shortest distance from a given point
|
|
implicit none
|
|
include 'leastdistance.h'
|
|
integer my0,nx,nparams0,iknowder0
|
|
double precision pointy(my0),shorty(my0),pointx(nx),
|
|
& shortx(nx),xmin(nx),xmax(nx),params0(nparams0)
|
|
!------------------Locals----------------------------------
|
|
integer i,iwhichsolver,idowhat,notfound
|
|
parameter(notfound=-9999)
|
|
double precision s2,s2cp,
|
|
& f1dimsqsum_distcenter,f1dims2_distcenter,
|
|
& shortf(nx),dydxp(my0,(nx+nparams0)),xtol,ftol
|
|
parameter(xtol=1.0d-10,ftol=1.0d-10)
|
|
external distcentersys,fsqsum_distcenter,
|
|
& f1dimsqsum_distcenter,s2_distcenter,
|
|
& f1dims2_distcenter
|
|
!----------------------------------------------------------
|
|
my=my0
|
|
nparams=nparams0
|
|
iknowder=iknowder0
|
|
do i=1,nx
|
|
targetx(i)=pointx(i)
|
|
enddo
|
|
do i=1,my
|
|
targety(i)=pointy(i)
|
|
enddo
|
|
do i=1,nparams
|
|
params(i)=params0(i)
|
|
enddo
|
|
call cpnonsyssolver(distcentersys,fsqsum_distcenter,
|
|
& f1dimsqsum_distcenter,xmin,pointx,shortx,xmax,
|
|
& shortf,nx,iwhichsolver)
|
|
if(iwhichsolver.eq.notfound)then
|
|
call s2_distcenter(nx,shortx,s2)
|
|
s2cp=s2
|
|
call cpnongradopt(nx,s2_distcenter,
|
|
& f1dims2_distcenter,shortx,xmin,xmax,ftol,s2)
|
|
if(dabs(s2cp-s2).gt.ftol)then
|
|
call cpRepeatCompassSearch(nx,shortx,s2,xmin,
|
|
& xmax,s2_distcenter,f1dims2_distcenter,xtol)
|
|
endif
|
|
endif
|
|
idowhat=0
|
|
call surffunc(my,shorty,nx,shortx,nparams,
|
|
& params,dydxp(1:my,1:(nx+nparams)),idowhat)
|
|
return
|
|
end subroutine shortestdist
|
|
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|