Source Code for Project IAC

Functions in Class Base.Neuron    [Go To Top]

! Base_Neuron.f
! - DLL routines for class <Component>Base.Neuron
! DATE: Tuesday, April 2, 2002 TIME: 5:48:50 PM
! The skeleton of this file is generated by SansGUI(tm)

! Attribute indices in class version [1.0.beta.1]
! 1: iHidden - Hidden Unit

! 2: fExtInput - External Input
! 3: fActivation - Activation Level
! 4: fNetInput - Net Input
! 5: fExcitation - Excitation
! 6: fInhibition - Inhibition
! 7: fMaxActiv - Maximum Activation
! 8: fMinActiv - Minimum Activation
! 9: fRest - Resting Activation Level
! 10: fDecay - Decay Rate
! 11: fEstr - Scale Factor for External Input
! 12: fAlpha - Scale Factor for Excitatory Input
! 13: fGamma - Scale Factor for Inhibitory Input
! 14: fDTR - Decay Times Rest
! 15: fOMD - 1 minus Decay

! ======================================================================
! SG_xInit - Initialization
! ----------------------------------------------------------------------
      integer function SG_xInit_Base_Neuron(self,                       &
     &                        simCtrl, chgChild,                        &
     &                        pRefObjs, iRefObjs,                       &
     &                        pAdjObjs, iAdjObjs,                       &
     &                        pLnkObjs, iLnkObjs,                       &
     &                        cMessage, cCommand, pOutFile )
!DEC$ IF DEFINED (_DLL)
!DEC$ ATTRIBUTES DLLEXPORT :: SG_xInit_Base_Neuron
!DEC$ END IF
      include "SGdllf.h"

      ! TODO: declare your local variables here

      real*4, dimension(*) :: fRest, fDecay, fDTR, fOMD
      POINTER(PTR_fREST, fRest)
      POINTER(PTR_fDECAY, fDecay)
      POINTER(PTR_fDTR, fDTR)
      POINTER(PTR_fOMD, fOMD)
      integer, parameter :: SG_NDX_FREST = 9
      integer, parameter :: SG_NDX_FDECAY = 10
      integer, parameter :: SG_NDX_FDTR = 14
      integer, parameter :: SG_NDX_FOMD = 15

      if (self%nSGobjSchema .ne. SG_OBJ_SCHEMA) then
          SG_xInit_Base_Neuron = SG_R_SCHM
          return
      end if

      ! TODO: put your simulator code here

      ! Version update is required because we've made the following

      ! changes since 1.0.alpha:
      ! 1. The scope of External Input attribute is changed from In/Out to

      !    Input only.
      ! 2. The External Input attribute is moved to the second position.
      ! These changes demonstrate version control/evoluation features in SansGUI.
      if (self%iVerMajor .lt. 1 .or. self%iVerMinor .lt. 0 .or.
     &    self%iVerPatch .lt. -1 .or. self%iVerBuild .lt. 0 ) then
          cMessage = 'Use File>Update Version to upgrade your' //
     &               ' Project Model to IAC 1.0.beta or later.'C
          SG_xInit_Base_Neuron = SG_R_STOP
          return
      end if

      PTR_zValues = self%pzValues
      PTR_fREST = zValues(SG_NDX_FREST)%vData
      PTR_fDECAY = zValues(SG_NDX_FDECAY)%vData
      PTR_fDTR = zValues(SG_NDX_FDTR)%vData
      PTR_fOMD = zValues(SG_NDX_FOMD)%vData

      ! calculate decay times rest for efficiency
      fDTR(1) = fDecay(1) * fRest(1)

      ! calculate 1 minus decay for efficiency
      fOMD(1) = 1.0 - fDecay(1)

      SG_xInit_Base_Neuron = SG_R_OK
      return
      end

! ======================================================================
! SG_xPreEval - Pre-Evaluation
! ----------------------------------------------------------------------
      integer function SG_xPreEval_Base_Neuron(self,                    &
     &                        simCtrl, chgChild,                        &
     &                        pRefObjs, iRefObjs,                       &
     &                        pAdjObjs, iAdjObjs,                       &
     &                        pLnkObjs, iLnkObjs,                       &
     &                        cMessage, cCommand, pOutFile )
!DEC$ IF DEFINED (_DLL)
!DEC$ ATTRIBUTES DLLEXPORT :: SG_xPreEval_Base_Neuron
!DEC$ END IF
      include "SGdllf.h"

      ! TODO: declare your local variables here

      integer :: i
      integer, dimension(*) :: iHidden
      real*4, dimension(*) :: fNetInput, fExtInput
      real*4, dimension(*) :: fExcitation, fInhibition
      real*4, dimension(*) :: fAlpha, fGamma, fEstr
      type (SG_VALU), dimension(*) :: adjValues
      type (SG_VALU), dimension(*) :: lnkValues
      real*4, dimension(*) :: fActivation
      real*4, dimension(*) :: fWeight
      POINTER(PTR_iHidden, iHidden)
      POINTER(PTR_fNetInput, fNetInput)
      POINTER(PTR_fExtInput, fExtInput)
      POINTER(PTR_fExcitation, fExcitation)
      POINTER(PTR_fInhibition, fInhibition)
      POINTER(PTR_fAlpha, fAlpha)
      POINTER(PTR_fGamma, fGamma)
      POINTER(PTR_fEstr, fEstr)
      POINTER(PTR_adjValues, adjValues)
      POINTER(PTR_lnkValues, lnkValues)
      POINTER(PTR_fActivation, fActivation)
      POINTER(PTR_fWeight, fWeight)
      integer, parameter :: SG_NDX_IHIDDEN = 1
      integer, parameter :: SG_NDX_FEXTINPUT = 2
      integer, parameter :: SG_NDX_FACTIVATION = 3
      integer, parameter :: SG_NDX_FNETINPUT = 4
      integer, parameter :: SG_NDX_FEXCITATION = 5
      integer, parameter :: SG_NDX_FINHIBITION = 6
      integer, parameter :: SG_NDX_FESTR = 11
      integer, parameter :: SG_NDX_FALPHA = 12
      integer, parameter :: SG_NDX_FGAMMA = 13
      integer, parameter :: LINK_NDX_FWOUTH = 2
      integer, parameter :: LINK_NDX_FWINH = 3

      if (self%nSGobjSchema .ne. SG_OBJ_SCHEMA) then
          SG_xPreEval_Base_Neuron = SG_R_SCHM
          return
      end if

      ! TODO: put your simulator code here

      ! This routine implements get net input from each of the adjacent unit
      PTR_zValues = self%pzValues
      PTR_iHidden = zValues(SG_NDX_IHIDDEN)%vData
      PTR_fNetInput = zValues(SG_NDX_FNETINPUT)%vData
      PTR_fExtInput = zValues(SG_NDX_FEXTINPUT)%vData
      PTR_fExcitation = zValues(SG_NDX_FEXCITATION)%vData
      PTR_fInhibition = zValues(SG_NDX_FINHIBITION)%vData
      PTR_fEstr = zValues(SG_NDX_FESTR)%vData
      PTR_fAlpha = zValues(SG_NDX_FALPHA)%vData
      PTR_fGamma = zValues(SG_NDX_FGAMMA)%vData

      ! zero out local excitation and inhibition level for accumulation
      fExcitation(1) = 0.0
      fInhibition(1) = 0.0

      ! calculate excitation and inhibition level from adjacent units
      do i = 1, iAdjObjs
          PTR_adjObject = pAdjObjs(i)
          PTR_adjValues = adjObject%pzValues
          PTR_fActivation = adjValues(SG_NDX_FACTIVATION)%vData

          if (fActivation(1) .gt. 0.0) then
              PTR_lnkObject = pLnkObjs(i)
              PTR_lnkValues = lnkObject%pzValues

              if (iHidden(1) .ne. 0) then
                  PTR_fWeight = lnkValues(LINK_NDX_FWINH)%vData
              else
                  PTR_fWeight = lnkValues(LINK_NDX_FWOUTH)%vData
              end if

              if (fWeight(1) .gt. 0.0) then
                  fExcitation(1) = fActivation(1) * fWeight(1) +        &
     &                             fExcitation(1)
              else if (fWeight(1) .lt. 0.0) then
                  fInhibition(1) = fActivation(1) * fWeight(1) +        &
     &                             fInhibition(1)
              end if
          end if
      end do

      ! scale excitation and inhibition
      fExcitation(1) = fExcitation(1) * fAlpha(1)
      fInhibition(1) = fInhibition(1) * fGamma(1)

      ! calculate net input from total excitation and inhibition

      ! from adjacent units and external inputs
      fNetInput(1) = fExcitation(1) + fInhibition(1) +                  &
     &               fEstr(1) * fExtInput(1)

      SG_xPreEval_Base_Neuron = SG_R_OK
      return
      end

! ======================================================================
! SG_xEval - Evaluation
! ----------------------------------------------------------------------
      integer function SG_xEval_Base_Neuron(self,                       &
     &                        simCtrl, chgChild,                        &
     &                        pRefObjs, iRefObjs,                       &
     &                        pAdjObjs, iAdjObjs,                       &
     &                        pLnkObjs, iLnkObjs,                       &
     &                        cMessage, cCommand, pOutFile )
!DEC$ IF DEFINED (_DLL)
!DEC$ ATTRIBUTES DLLEXPORT :: SG_xEval_Base_Neuron
!DEC$ END IF
      include "SGdllf.h"

      ! TODO: declare your local variables here

      real*4, dimension(*) :: fActivation
      real*4, dimension(*) :: fNetInput, fExtInput
      real*4, dimension(*) :: fExcitation, fInhibition
      real*4, dimension(*) :: fMaxActiv, fMinActiv
      real*4, dimension(*) :: fDTR, fOMD
      POINTER(PTR_fActivation, fActivation)
      POINTER(PTR_fNetInput, fNetInput)
      POINTER(PTR_fExtInput, fExtInput)
      POINTER(PTR_fExcitation, fExcitation)
      POINTER(PTR_fInhibition, fInhibition)
      POINTER(PTR_fMaxActiv, fMaxActiv)
      POINTER(PTR_fMinActiv, fMinActiv)
      POINTER(PTR_fDTR, fDTR)
      POINTER(PTR_fOMD, fOMD)
      integer, parameter :: SG_NDX_FEXTINPUT = 2   ! moved since 1.0.b
      integer, parameter :: SG_NDX_FACTIVATION = 3 ! moved since 1.0.b
      integer, parameter :: SG_NDX_FNETINPUT = 4   ! moved since 1.0.b
      integer, parameter :: SG_NDX_FEXCITATION = 5
      integer, parameter :: SG_NDX_FINHIBITION = 6
      integer, parameter :: SG_NDX_FMAXACTIV = 7
      integer, parameter :: SG_NDX_FMINACTIV = 8
      integer, parameter :: SG_NDX_FDTR = 14
      integer, parameter :: SG_NDX_FOMD = 15

      if (self%nSGobjSchema .ne. SG_OBJ_SCHEMA) then
          SG_xEval_Base_Neuron = SG_R_SCHM
          return
      end if

      ! TODO: put your simulator code here

      PTR_zValues = self%pzValues
      PTR_fActivation = zValues(SG_NDX_FACTIVATION)%vData
      PTR_fNetInput = zValues(SG_NDX_FNETINPUT)%vData
      PTR_fExtInput = zValues(SG_NDX_FEXTINPUT)%vData
      PTR_fExcitation = zValues(SG_NDX_FEXCITATION)%vData
      PTR_fInhibition = zValues(SG_NDX_FINHIBITION)%vData
      PTR_fMaxActiv = zValues(SG_NDX_FMAXACTIV)%vData
      PTR_fMinActiv = zValues(SG_NDX_FMINACTIV)%vData
      PTR_fDTR = zValues(SG_NDX_FDTR)%vData
      PTR_fOMD = zValues(SG_NDX_FOMD)%vData

      if (fNetInput(1) .gt. 0.0) then
          fActivation(1) = fNetInput(1)*(fMaxActiv(1)-fActivation(1)) + &
     &                     fOMD(1) * fActivation(1) + fDTR(1)
          if (fActivation(1) .gt. fMaxActiv(1)) then
              fActivation(1) = fMaxActiv(1)
          end if
      else
          fActivation(1) = fNetInput(1)*(fActivation(1)-fMinActiv(1)) + &
     &                     fOMD(1) * fActivation(1) + fDTR(1)
          if (fActivation(1) .lt. fMinActiv(1)) then
              fActivation(1) = fMinActiv(1)
          end if
      end if

      ! cMessage = 'Fortran evaluation routine is called.'C
      ! SG_xEval_Base_Neuron = SG_R_LMSG

      SG_xEval_Base_Neuron = SG_R_OK
      return
      end