120 lines
4.0 KiB
FortranFixed
120 lines
4.0 KiB
FortranFixed
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
|
|
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
|