Kolpack-Software-Consulting/piscal
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

New changes from l2g

Browse Source 
w
This commit is contained in:
poprhythm
2022-09-12 16:40:28 +00:00
parent 78eb7147d0
commit d713d4f61a
110 changed files with 87672 additions and 1098 deletions
Download Patch File Download Diff File Expand all files Collapse all files
dataassim/math/nonlinsystems/nonsyssolver.f
+47 -24
View File
@@ -1,6 +1,6 @@
subroutine nonsyssolver(funcnleq1,fmin_funcnleq1,
& f1dim_funcnleq1,x0min,x0ori,xp,x0max,fp,
& nunknowns,iwhichsolver)
&f1dim_funcnleq1,DNQFJ_funcnleq1,x0min,x0ori,xp,x0max,fp,
&nunknowns,iwhichsolver)
implicit none
integer nunknowns,iwhichsolver
double precision x0min(nunknowns),x0ori(nunknowns),
@@ -27,30 +27,48 @@
! =4 solved by fixed point method 4
! =6 solved by broydn
! =7 Solved by multiobjective minimization.
! =8 Solved by DNQSOL
! =-9999 Best approximation returned. Solution may not be accurate.
! --------- Local variables ---------------------------------------
double precision x0(nunknowns),TOLF,stpmax,scldstpmax,
& sum,tb,tp,xb(nunknowns),fb(nunknowns),fsqsum,
& f1dim_funcnleq1
integer i,irepeat,maxrepeats,IERR,notfound
double precision x0(nunknowns),TOLF,stpmax,scldstpmax,ran2,
&sum,tb,tp,xb(nunknowns),fb(nunknowns),fsqsum,f1dim_funcnleq1,
&D1MACH,Warray(3+(15*nunknowns+3*nunknowns*nunknowns)/2+1)
integer i,irepeat,maxrepeats,IERR,notfound,IOPT(5),IDIMW
intrinsic dble
parameter(maxrepeats=100,notfound=-9999,TOLF=1.0d-7)
external funcnleq1,fmin_funcnleq1,f1dim_funcnleq1
parameter(maxrepeats=100,notfound=-9999)
external funcnleq1,fmin_funcnleq1,f1dim_funcnleq1,
&DNQFJ_funcnleq1
!-------------------------------------------------------------------
stpmax=0.0d0
sum=0.0d0
do i=1, nunknowns
x0(i)=x0ori(i)
sum=sum+x0ori(i)*x0ori(i)
stpmax=stpmax+
& (x0min(i)-x0max(i))*(x0min(i)-x0max(i))
xp(i)=x0ori(i)
enddo
stpmax=dsqrt(stpmax)/4.0d0
scldstpmax=stpmax/dmax1(dsqrt(sum),dble(nunknowns))
! In Numerical Recipes, scldstpmax (STPMX) is 100
scldstpmax=dmax1(100.0d0,scldstpmax)
iwhichsolver=notfound
TOLF=dsqrt(D1MACH(4))
do irepeat=1,maxrepeats
IDIMW=3+(15*nunknowns+3*nunknowns*nunknowns)/2+1
do i=1,5
IOPT(i)=0
enddo
IOPT(4)=1
call DNQSOL(DNQFJ_funcnleq1,nunknowns,xp,fp,TOLF,
&IOPT,Warray,IDIMW)
if(IOPT(1).eq.0)then
iwhichsolver=8
return
endif
do i=1,nunknowns
x0(i)=x0min(i)+ran2()*(x0max(i)-x0min(i))
enddo
stpmax=0.0d0
sum=0.0d0
do i=1, nunknowns
sum=sum+x0(i)*x0(i)
stpmax=stpmax+(x0min(i)-x0max(i))*(x0min(i)-x0max(i))
enddo
stpmax=dsqrt(stpmax)/4.0d0
scldstpmax=stpmax/dmax1(dsqrt(sum),dble(nunknowns))
! In Numerical Recipes, scldstpmax (STPMX) is 100
scldstpmax=dmax1(100.0d0,scldstpmax)
call fixedpoint(funcnleq1,x0min,x0,xp,
& x0max,fp,nunknowns,TOLF,stpmax,iwhichsolver)
if(iwhichsolver.ne.notfound)return
@@ -82,6 +100,11 @@
return
endif
endif
do i=1,nunknowns
xp(i)=x0min(i)+ran2()*(x0max(i)-x0min(i))
enddo
call funcnleq1(nunknowns,xp,fp,fsqsum)
fsqsum=0.0d0
do i=1,nunknowns
fsqsum=fsqsum+fp(i)*fp(i)
@@ -89,11 +112,11 @@
tp=fsqsum
call nongradopt(nunknowns,fmin_funcnleq1,
& f1dim_funcnleq1,xp,x0min,x0max,TOLF,fsqsum)
! if(dabs(tp-fsqsum).gt.TOLF)then
! call RepeatCompassSearch(nunknowns,xp,fsqsum,
! & x0min,x0max,fmin_funcnleq1,f1dim_funcnleq1,
! & TOLF)
! endif
if(dabs(tp-fsqsum).gt.TOLF)then
call RepeatCompassSearch(nunknowns,xp,fsqsum,
& x0min,x0max,fmin_funcnleq1,f1dim_funcnleq1,
& TOLF)
endif
call funcnleq1(nunknowns,xp,fp,fsqsum)
tp=dabs(fp(1))
do i=2,nunknowns
@@ -109,7 +132,7 @@
enddo
if(IERR.eq.0)return
do i=1,nunknowns
x0(i)=xp(i)
xp(i)=x0min(i)+ran2()*(x0max(i)-x0min(i))
enddo
enddo
end subroutine nonsyssolver