81 lines
2.4 KiB
FortranFixed
81 lines
2.4 KiB
FortranFixed
subroutine function_generic(ndim,beta,nxvars,
|
|
& xvars,nyvars,ymod)
|
|
integer ndim,nxvars,nyvars
|
|
double precision beta(ndim),xvars(nxvars),
|
|
& ymod(nyvars)
|
|
double precision y0,a,b,c,x0,x,term,crit
|
|
parameter(crit=300.0d0)
|
|
a=beta(1)
|
|
b=beta(2)
|
|
c=beta(3)
|
|
x0=beta(4)
|
|
y0=beta(5)
|
|
x=xvars(1)
|
|
if((-(x-x0)/b).lt.crit)then
|
|
term=dexp(-(x-x0)/b)
|
|
ymod(1)=y0+a*(1.0d0/(1.0d0+term))**c
|
|
else
|
|
term=dexp((x-x0)/b)
|
|
ymod(1)=y0+a*(term/(1.0d0+term))**c
|
|
endif
|
|
return
|
|
end
|
|
|
|
subroutine der_function_generic(np,beta,m,
|
|
& xvars,nq,der_beta)
|
|
implicit none
|
|
integer np,m,nq
|
|
double precision beta(np),xvars(m),der_beta(np,nq)
|
|
double precision y0,a,b,c,x0,x,term,crit
|
|
parameter(crit=300.0d0)
|
|
a=beta(1)
|
|
b=beta(2)
|
|
c=beta(3)
|
|
x0=beta(4)
|
|
y0=beta(5)
|
|
x=xvars(1)
|
|
der_beta(5,1)=1.0d0
|
|
if((-(x-x0)/b).lt.crit)then
|
|
term=dexp(-(x-x0)/b)
|
|
der_beta(1,1)=(1.0d0/(1.0d0+term))**c
|
|
! der_x=(a*c*term/b)*(1.0d0/(1.0d0+term))**(1.0d0+c)
|
|
der_beta(4,1)=-(a*c*term/b)*
|
|
& (1.0d0/(1.0d0+term))**(1.0d0+c)
|
|
der_beta(2,1)=-(a*c*term*(x-x0)/(b*b))*
|
|
& (1.0d0/(1.0d0+term))**(1.0d0+c)
|
|
der_beta(3,1)=-(a*dlog(1.0d0+term))*
|
|
& (1.0d0/(1.0d0+term))**c
|
|
else
|
|
term=(x-x0)/b
|
|
der_beta(1,1)=(dexp(term)/(1.0d0+dexp(term)))**c
|
|
! der_x=(a*c/b)*(dexp(term*c/(c+1.0d0))/
|
|
! & (1.0d0+dexp(term)))**(c+1.0d0)
|
|
der_beta(4,1)=-(a*c/b)*(dexp(term*c/(c+1))/
|
|
& (1.0d0+dexp(term)))**(c+1.0d0)
|
|
der_beta(2,1)=-(a*c*(x-x0)/(b*b))*(dexp(term*c/
|
|
& (c+1.0d0))/(1.0d0+dexp(term)))**(1.0d0+c)
|
|
der_beta(3,1)=-a*(dlog(1.0d0+dexp(term))-term)*
|
|
& (dexp(term)/(1.0d0+dexp(term)))**c
|
|
endif
|
|
return
|
|
end
|
|
|
|
subroutine indices_function_generic(ndim,beta,root,
|
|
& der_root,fmax)
|
|
implicit none
|
|
integer ndim
|
|
double precision beta(ndim),root,der_root,fmax
|
|
double precision a,b,c,x0,y0,term
|
|
a=beta(1)
|
|
b=beta(2)
|
|
c=beta(3)
|
|
x0=beta(4)
|
|
y0=beta(5)
|
|
term=(-a/y0)**(1.0d0/c)-1.0d0
|
|
root=x0-b*dlog(term)
|
|
term=dexp(-(root-x0)/b)
|
|
der_root=(a*c*term/b)*(1.0d0/(1.0d0+term))**(1.0d0+c)
|
|
fmax=a+y0
|
|
return
|
|
end
|