Initial commit

dataassim/math/optimization/shortestdist.f

@@ -0,0 +1,51 @@
+      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
+!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$