Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,122 @@
+!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+      double precision function 
+     &annfunc(nparams,params,nh,q,w,bph,bend,c)
+      implicit none
+      integer nparams,nh
+!nh is the number of hidden nodes in one hiden layer
+!params is the inputs
+!w is the weighting coefficients for the inputs
+      double precision params(nparams),q(nh),
+     &       w(nparams,nh),bph(nh),bend,c(nh)
+      integer i,v
+      double precision term,activatefunc1,activatefunc2
+      annfunc=bend
+      do i=1,nh
+        term=bph(i)
+        do v=1,nparams
+          term=term+w(v,i)*params(v)
+        enddo
+        annfunc=annfunc+q(i)*activatefunc1(term)+
+     &c(i)*activatefunc2(term)
+      enddo
+      end
+
+      subroutine derannfunc(nparams,params,nh,q,w,bph,
+     &  bend,c,derq,derw,derbph,derbend,derc)
+      implicit none
+      integer nparams,nh
+!nh is the number of hidden nodes in one hiden layer
+!params is the inputs
+!w is the weighting coefficients for the inputs
+      double precision params(nparams),q(nh),
+     &  w(nparams,nh),bph(nh),bend,c(nh),derq(nh),
+     &  derw(nparams,nh),derbph(nh),derbend,derc(nh)
+      integer i,v
+      double precision term,activatefunc1,gradactivatefunc1,
+     &activatefunc2,gradactivatefunc2
+
+      derbend=1.0d0
+      do i=1,nh
+        term=bph(i)
+        do v=1,nparams
+          term=term+w(v,i)*params(v)
+        enddo
+        derq(i)=activatefunc1(term)
+        derc(i)=activatefunc2(term)
+        derbph(i)=q(i)*gradactivatefunc1(term)+
+     &            c(i)*gradactivatefunc2(term)
+        do v=1,nparams
+          derw(v,i)=derbph(i)*params(v)
+        enddo
+      enddo
+      end
+
+      subroutine gradannfunc(nparams,params,nh,q,w,bph,
+     &  c,der_params)
+      implicit none
+      integer nparams,nh
+      double precision params(nparams),der_params(nparams),
+     &  q(nh),w(nparams,nh),bph(nh),c(nh)
+      integer i,v
+      double precision term,gradactivatefunc1,gradactivatefunc2
+      do i=1,nparams
+        der_params(i)=0.0d0
+      enddo
+      do i=1,nh
+        term=bph(i)
+        do v=1,nparams
+          term=term+w(v,i)*params(v)
+        enddo
+        do v=1,nparams
+          der_params(v)=der_params(v)+(q(i)*gradactivatefunc1(term)
+     &+c(i)*gradactivatefunc2(term))*w(v,i)
+        enddo
+      enddo
+      return
+      end
+
+      double precision function activatefunc1(x)
+      implicit none
+      double precision x,crit
+      parameter(crit=300)
+      if(x.gt.-crit)then
+        activatefunc1=1.0d0/(1.0d0+dexp(-x))
+      else
+        activatefunc1=dexp(x)/(1.0d0+dexp(x))
+      endif
+      return
+      end
+
+      double precision function gradactivatefunc1(x)
+      implicit none
+      double precision x,crit
+      parameter(crit=600)
+      if(x.gt.-crit.and.x.lt.crit)then
+        gradactivatefunc1=
+     &     (1.0d0/(dexp(x/2.0d0)+dexp(-x/2.0d0)))**2
+      else
+        gradactivatefunc1=0.0d0
+      endif
+      return
+      end
+ 
+      double precision function activatefunc2(x)
+      implicit none
+      double precision x
+      
+!      activatefunc2=2.0d0*datan(x)/3.14159265d0
+!      activatefunc2=1.001d0+dsin(x)
+      activatefunc2=x+x*x
+      return
+      end
+
+      double precision function gradactivatefunc2(x)
+      implicit none
+      double precision x,crit
+      parameter(crit=600)
+      
+!      gradactivatefunc2=2.0d0/(3.14159265d0*(1.0d0+x*x))
+!      gradactivatefunc2=dcos(x)
+      gradactivatefunc2=1.0d0+2.0d0*x
+      return
+      end