      subroutine distancesys(nunknowns,scldxp,
     &  scldfequ,scldfsqsum,idowhat)
      implicit none
!
!--------------------- Variables through arguments -------------------------
!(in) nunknowns:          the number of unknowns and non-linear equations
!(in) scldxp(1:nunknowns):  the scaled unknowns in the nonlinear system
!(out) scldfequ(1:nunknowns): the scaled function values evaluated at imported unknowns
!(out) scldfsqsum: half of the sum of the squared scaled function values.
      integer nunknowns,idowhat
      double precision scldxp(1:nunknowns),
     &  scldfequ(1:nunknowns),scldfsqsum
!--------------------------- Local variables-----------------------------------
      integer i,j,numys
      parameter
      double precision xvar(nunknowns),xscalingfact(nunknowns),
     &  xtarget(nunknowns),yvar(numys),yscalingfact(numys),
     &  ytarget(numys),diffy(numys)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
      do i=1,nunknowns
        scalingfact(i)=1.0d0
        xvar(i)=scldxp(i)/xscalingfact(i)
      enddo
      call surface(numys,yvar,nunknowns,xvar)
      do i=1,numys
        diff(i)=yvar(i)-ytarget(i)
      endif
      if(idowhat.eq.1)then
        scldfsqsum=0.0d0
        do i=1,nunknowns
          scldfequ(i)=scldfequ(i)*scalingfact(i)
          scldfsqsum=scldfsqsum+scldfequ(i)*scldfequ(i)        
        enddo  
        scldfsqsum=0.5d0*scldfsqsum
      endif
      if(idowhat.eq.2)then
        
      return
      end subroutine leafsys
      
      subroutine surface(numys,ysurface,nunknowns,xvar)
      implicit none
      integer numys,nunknowns
      double precision ysurface(numys),xvar(nunknowns)
      ysurface(1)=xvar(1)
      return
      end

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
      subroutine sqsum_fequ(nunknowns,xp,fequsqsum)
!This subroutine returns half of the sum of the squared equation residues 
      implicit none
      integer nunknowns
      double precision xp(nunknowns),fequsqsum,
     &  fequ(nunknowns)
      integer idowhat
      parameter(idowhat=1)
      call distancesys(nunknowns,xp,fequ,fequsqsum,idowhat)
      return
      end

      double precision function cpf1dim_fequ(x)
!this function subroutine returns half of the sum of the squared equation residues for line search
      INTEGER NMAX
      double precision x
      PARAMETER (NMAX=1000)
      INTEGER j,ncom,idowhat
      parameter(idowhat=1)
      double precision pcom(NMAX),xicom(NMAX),
     &  xt(NMAX),fequ(NMAX)
      COMMON /cpf1com/ pcom,xicom,ncom
      save /cpf1com/
      do 11 j=1,ncom
        xt(j)=pcom(j)+x*xicom(j)
11    continue
      call distancesys(ncom,xt,fequ,cpf1dim_fequ,idowhat)
      return
      END
      
      subroutine getequationvalues((nunknowns,xp,
     &  fequ,fequsqsum)
!this subroutine is for solving a nonlinear system
      implicit none
      integer nunknowns,idowhat
      double precision xp(nunknowns),fequ(nunknowns),fequsqsum
      parameter(idowhat=1)
      call distancesys(nunknowns,xp,fequ,fequsqsum,idowhat)
      return
      end

      subroutine getsqdistance(nunknowns,xp,sqdistance)
!This subroutine returns the distance between a point on a curve (surface) and another point 
!that is specified in distancesys 
      implicit none
      integer nunknowns,idowhat
      double precision xp(nunknowns),sqdistance,fequ(nunknowns)
      parameter(idowhat=2)
      call distancesys(nunknowns,xp,fequ,sqdistance,idowhat)
      return
      end

      double precision function cpf1dim_distance(x)
!this function subroutine returns the distance for line search
      INTEGER NMAX
      double precision x
      PARAMETER (NMAX=1000)
      INTEGER j,ncom,idowhat
      parameter(idowhat=2)
      double precision pcom(NMAX),xicom(NMAX),
     &  xt(NMAX),fequ(NMAX)
      COMMON /cpf1com/ pcom,xicom,ncom
      save /cpf1com/
      do 11 j=1,ncom
        xt(j)=pcom(j)+x*xicom(j)
11    continue
      call distancesys(ncom,xt,fequ,cpf1dim_distance,idowhat)
      return
      END
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
