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

Computational changes in surffunc.f

Browse Source
This commit is contained in:
James Kolpack
2022-08-15 12:49:13 +00:00
parent d40505e161
commit 2d39dd5b6a
1 changed files with 32 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files
leafres/testarea/surffunc.f
+32 -7
View File
@@ -113,7 +113,7 @@
double precision beta(5),root,der_root,fmax,yinter,der_yinter, double precision beta(5),root,der_root,fmax,yinter,der_yinter,
&agivenx,der_agivenx,funcval_agivenx,xmin,xmax,curvatmax,xcurvatmax &agivenx,der_agivenx,funcval_agivenx,xmin,xmax,curvatmax,xcurvatmax
double precision a,b,c,x0,y0,term,term1,term2,term3,step, double precision a,b,c,x0,y0,term,term1,term2,term3,step,
&deratx,der2atx &deratx,der2atx,yvector(5),xvector(5),zvector(5)
a=beta(1) a=beta(1)
b=beta(2) b=beta(2)
@@ -178,16 +178,39 @@
der_root=-9999.0d0 der_root=-9999.0d0
endif endif
fmax=a+y0 fmax=a+y0
call surffunc(1,yinter,1,0.0d0,ndim,beta,term,0) xvector(1)=0.0d0
call surffunc(1,term,1,0.0d0,ndim,beta,der_yinter,1) call surffunc(1,yvector(1),1,xvector(1),ndim,beta,zvector(1),0)
call surffunc(1,term,1,agivenx,ndim,beta,der_agivenx,1) yinter=yvector(1)
call surffunc(1,funcval_agivenx,1,agivenx,ndim,beta,term,0) call surffunc(1,yvector(1),1,xvector(1),ndim,beta,zvector(1),1)
der_yinter=zvector(1)
xvector(1)=agivenx
call surffunc(1,yvector(1),1,xvector(1),ndim,beta,zvector(1),1)
der_agivenx=zvector(1)
call surffunc(1,yvector(1),1,xvector(1),ndim,beta,zvector(1),0)
funcval_agivenx=yvector(1)
curvatmax=-9999.0d0 curvatmax=-9999.0d0
xcurvatmax=-9999.0d0 xcurvatmax=-9999.0d0
step=(xmax-xmin)/1000.0d0 step=(xmax-xmin)/1000.0d0
do term=xmin,xmax,step if(step.le.0.0d0)return
call surffunc(1,term1,1,term,ndim,beta,deratx,1) ! do term=xmin,xmax,step
! call surffunc(1,term1,1,term,ndim,beta,deratx,1)
! term2=dexp(-(term-x0)/b)
! der2atx=-deratx/b+
! &(1.0d0+c)*deratx*deratx*((1.0d0+term2)**c)/(a*c)
! term3=dabs(der2atx/((1.0d0+deratx*deratx)**1.5d0))
! if(term3.gt.curvatmax)then
! curvatmax=term3
! xcurvatmax=term
! endif
! enddo
term=xmin
do while (term.le.xmax)
xvector(1)=term
call surffunc(1,yvector(1),1,xvector(1),ndim,beta,zvector(1),1)
term1=yvector(1)
deratx=zvector(1)
term2=dexp(-(term-x0)/b) term2=dexp(-(term-x0)/b)
der2atx=-deratx/b+ der2atx=-deratx/b+
&(1.0d0+c)*deratx*deratx*((1.0d0+term2)**c)/(a*c) &(1.0d0+c)*deratx*deratx*((1.0d0+term2)**c)/(a*c)
@@ -196,7 +219,9 @@
curvatmax=term3 curvatmax=term3
xcurvatmax=term xcurvatmax=term
endif endif
term=term+step
enddo enddo
if(dabs(xcurvatmax-xmin).le.step.or. if(dabs(xcurvatmax-xmin).le.step.or.
&dabs(xcurvatmax-xmax).le.step)then &dabs(xcurvatmax-xmax).le.step)then
curvatmax=-9999.0d0 curvatmax=-9999.0d0