Initial commit

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