Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,119 @@
+      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
+!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@