Source Code for Visual Calculator


The following source files, led by gray banners, contain all the class functions needed for Visual Calculator for SansGUI.  The sections highlighted by a yellow background Color are manually entered.  Code sections with white background color are generated by the SansGUI Source Code Framework.  The source files are compiled into a dynamic linked library to be invoked by SansGUI during simulation runs.

For more details about the complete package, please read the Visual Calculator for SansGUI Manual on-line.

Implementation in Fortran (CVF)

Function in Class Base.Add     [Go To Top]

! Base_Add.f
! - DLL routines for class <Component>Base.Add
! DATE: Sunday, April 21, 2002 TIME: 11:47:44 AM
! The skeleton of this file is generated by SansGUI(tm)

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

      ! TODO: declare your local variables here

      integer :: i
      real*4 :: fSum
      integer, dimension(*) :: iInfo
      real*4, dimension(*) :: fValue
      type (SG_VALU), dimension(*) :: lnkValues
      POINTER(PTR_iInfo, iInfo)
      POINTER(PTR_fValue, fValue)
      POINTER(PTR_lnkValues, lnkValues)
      integer, parameter :: LINK_NDX_IINFO = 1
      integer, parameter :: LINK_NDX_FVALUE = 2

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

      ! TODO: put your simulator code here

      ! sum up all the values from input links
      fSum = 0.0
      do i = 1, iLnkObjs

          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_IN) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              fSum = fSum + fValue(1)
          end if
      end do

      ! Deposit the constant value to all the output links
      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_OUT) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              fValue(1) = fSum
          end if
      end do

      SG_xEval_Base_Add = SG_R_OK
      return
      end

Function in Class Base.Subtract     [Go To Top]

! Base_Subtract.f
! - DLL routines for class <Component>Base.Subtract
! DATE: Sunday, April 21, 2002 TIME: 11:47:44 AM
! The skeleton of this file is generated by SansGUI(tm)

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

      ! TODO: declare your local variables here

      integer :: i
      real*4 :: fResult
      logical :: bFoundPort0
      integer, dimension(*) :: iInfo
      real*4, dimension(*) :: fValue
      type (SG_VALU), dimension(*) :: lnkValues
      POINTER(PTR_iInfo, iInfo)
      POINTER(PTR_fValue, fValue)
      POINTER(PTR_lnkValues, lnkValues)
      integer, parameter :: LINK_NDX_IINFO = 1
      integer, parameter :: LINK_NDX_FVALUE = 2

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

      ! TODO: put your simulator code here

      fResult = 0.0
      bFoundPort0 = .FALSE.

      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_IN) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              if (iInfo(2) .eq. 0) then
                  ! port 0 for the subtraction operator
                  bFoundPort0 = .TRUE.
                  fResult = fResult + fValue(1)
              else
                  ! other input port, just subtract
                  fResult = fResult - fValue(1)
              end if
          end if
      end do

      ! Deposit the constant value to all the output links
      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_OUT) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              fValue(1) = fResult
          end if
      end do

      ! if port 0 is not found, only give warning
      if (.not. bFoundPort0) then
          cMessage = 'Warning: Port 0 is not connected, 0.0 is used.'C
          SG_xEval_Base_Subtract = SG_R_PAUS
          return
      end if

      SG_xEval_Base_Subtract = SG_R_OK
      return
      end

Function in Class Base.Multiply     [Go To Top]

! Base_Multiply.f
! - DLL routines for class <Component>Base.Multiply
! DATE: Sunday, April 21, 2002 TIME: 11:47:44 AM
! The skeleton of this file is generated by SansGUI(tm)

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

      ! TODO: declare your local variables here

      integer :: i
      real*4 :: fProduct
      logical :: bReassigned
      integer, dimension(*) :: iInfo
      real*4, dimension(*) :: fValue
      type (SG_VALU), dimension(*) :: lnkValues
      POINTER(PTR_iInfo, iInfo)
      POINTER(PTR_fValue, fValue)
      POINTER(PTR_lnkValues, lnkValues)
      integer, parameter :: LINK_NDX_IINFO = 1
      integer, parameter :: LINK_NDX_FVALUE = 2

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

      ! TODO: put your simulator code here

      ! sum up all the values from input links
      fProduct = 1.0
      bReassigned = .FALSE.
      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_IN) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              fProduct = fProduct * fValue(1)
              bReassigned = .TRUE.
          end if
      end do

      ! Deposit the constant value to all the output links
      if (bReassigned) then
          do i = 1, iLnkObjs
              PTR_lnkObject = pLnkObjs(i)
              PTR_lnkValues = lnkObject%pzValues
              PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
              if (iInfo(1) .eq. SG_LINK_OUT) then
                  PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
                  fValue(1) = fProduct
              end if
          end do
      end if

      SG_xEval_Base_Multiply = SG_R_OK
      return
      end

Function in Class Base.Divide     [Go To Top]

! Base_Divide.f
! - DLL routines for class <Component>Base.Divide
! DATE: Sunday, April 21, 2002 TIME: 11:47:44 AM
! The skeleton of this file is generated by SansGUI(tm)

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

      ! TODO: declare your local variables here

      integer :: i
      real*4 :: fResult
      logical :: bFoundPort0
      integer, dimension(*) :: iInfo
      real*4, dimension(*) :: fValue
      type (SG_VALU), dimension(*) :: lnkValues
      POINTER(PTR_iInfo, iInfo)
      POINTER(PTR_fValue, fValue)
      POINTER(PTR_lnkValues, lnkValues)
      integer, parameter :: LINK_NDX_IINFO = 1
      integer, parameter :: LINK_NDX_FVALUE = 2

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

      ! TODO: put your simulator code here

      fResult = 1.0
      bFoundPort0 = .FALSE.

      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_IN) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              if (iInfo(2) .eq. 0) then
                  ! port 0 for the division operator
                  bFoundPort0 = .TRUE.
                  fResult = fResult * fValue(1)
              else if (fValue(1) .ne. 0.0) then
                  ! other input port, just divide
                  fResult = fResult / fValue(1)
              else
                  cMessage = 'Error: divided by 0.0'C
                  SG_xEval_Base_Divide = SG_R_STOP
                  return
              end if
          end if
      end do

      ! dividend connected at port 0 is required
      if (.not. bFoundPort0) then
          cMessage = 'Error: need a dividend connected at Port 0'C
          SG_xEval_Base_Divide = SG_R_STOP
          return
      end if

      ! Deposit the constant value to all the output links
      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_OUT) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              fValue(1) = fResult
          end if
      end do

      SG_xEval_Base_Divide = SG_R_OK
      return
      end

Function in Class Base.Negate     [Go To Top]

! Base_Negate.f
! - DLL routines for class <Component>Base.Negate
! DATE: Sunday, April 21, 2002 TIME: 11:47:44 AM
! The skeleton of this file is generated by SansGUI(tm)

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

      ! TODO: declare your local variables here

      integer :: i
      real*4 :: fResult
      logical :: bReassigned
      integer, dimension(*) :: iInfo
      real*4, dimension(*) :: fValue
      type (SG_VALU), dimension(*) :: lnkValues
      POINTER(PTR_iInfo, iInfo)
      POINTER(PTR_fValue, fValue)
      POINTER(PTR_lnkValues, lnkValues)
      integer, parameter :: LINK_NDX_IINFO = 1
      integer, parameter :: LINK_NDX_FVALUE = 2

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

      ! TODO: put your simulator code here

      bReassigned = .FALSE.
      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_IN) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              fResult = -fValue(1)
              bReassigned = .TRUE.
              exit    ! Connectivity rule limits to one input link
          end if
      end do

      ! Deposit the constant value to all the output links
      if (bReassigned) then
          do i = 1, iLnkObjs
              PTR_lnkObject = pLnkObjs(i)
              PTR_lnkValues = lnkObject%pzValues
              PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
              if (iInfo(1) .eq. SG_LINK_OUT) then
                  PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
                  fValue(1) = fResult
              end if
          end do
      end if

      SG_xEval_Base_Negate = SG_R_OK
      return
      end

Function in Class Base.SquareRoot     [Go To Top]

! Base_SquareRoot.f
! - DLL routines for class <Component>Base.SquareRoot
! DATE: Sunday, April 21, 2002 TIME: 11:47:44 AM
! The skeleton of this file is generated by SansGUI(tm)

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

      ! TODO: declare your local variables here

      integer :: i
      real*4 :: fResult
      logical :: bReassigned
      integer, dimension(*) :: iInfo
      real*4, dimension(*) :: fValue
      type (SG_VALU), dimension(*) :: lnkValues
      POINTER(PTR_iInfo, iInfo)
      POINTER(PTR_fValue, fValue)
      POINTER(PTR_lnkValues, lnkValues)
      integer, parameter :: LINK_NDX_IINFO = 1
      integer, parameter :: LINK_NDX_FVALUE = 2

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

      ! TODO: put your simulator code here

      bReassigned = .FALSE.
      ! take input value, should have at most one link
      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_IN) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              if (fValue(1) .lt. 0.0) then
                  cMessage =
     &            'Input for square root function cannot be less than 0.'C
                  SG_xEval_Base_SquareRoot = SG_R_STOP
                  return
              end if
              fResult = SQRT(fValue(1))
              bReassigned = .TRUE.
              exit    ! Connectivity rule limits to one input link
          end if
      end do

      ! Deposit the constant value to all the output links
      if (bReassigned) then
          do i = 1, iLnkObjs
              PTR_lnkObject = pLnkObjs(i)
              PTR_lnkValues = lnkObject%pzValues
              PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
              if (iInfo(1) .eq. SG_LINK_OUT) then
                  PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
                  fValue(1) = fResult
              end if
          end do
      end if

      SG_xEval_Base_SquareRoot = SG_R_OK
      return
      end

Function in Class Base.SineGen     [Go To Top]

! Base_SineGen.f
! - DLL routines for class <Component>Base.SineGen
! DATE: Sunday, April 21, 2002 TIME: 11:47:44 AM
! The skeleton of this file is generated by SansGUI(tm)

! Attribute indices in class version [1.0.0.0]
! 1: fAngle - Current Angle
! 2: fDelta - Angle Increment
! 3: fDamp - Damping Factor
! 4: iPeriod - Period Register

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

      ! TODO: declare your local variables here

      integer :: i
      real*4 :: fResult, fCurrAngle, fCurrFac, fNextFac
      integer, dimension(*) :: iInfo, iPeriod
      real*4, dimension(*) :: fValue, fAngle, fDelta, fDamp
      type (SG_VALU), dimension(*) :: lnkValues
      POINTER(PTR_iInfo, iInfo)
      POINTER(PTR_iPeriod, iPeriod)
      POINTER(PTR_fValue, fValue)
      POINTER(PTR_fAngle, fAngle)
      POINTER(PTR_fDelta, fDelta)
      POINTER(PTR_fDamp, fDamp)
      POINTER(PTR_lnkValues, lnkValues)
      integer, parameter :: SG_NDX_FANGLE = 1
      integer, parameter :: SG_NDX_FDELTA = 2
      integer, parameter :: SG_NDX_FDAMP = 3
      integer, parameter :: SG_NDX_IPERIOD = 4
      integer, parameter :: LINK_NDX_IINFO = 1
      integer, parameter :: LINK_NDX_FVALUE = 2
      real*4, parameter :: PI2 = 6.283185

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

      ! TODO: put your simulator code here

      PTR_zValues = self%pzValues
      PTR_fAngle = zValues(SG_NDX_FANGLE)%vData
      PTR_fDelta = zValues(SG_NDX_FDELTA)%vData
      PTR_fDamp = zValues(SG_NDX_FDAMP)%vData
      PTR_iPeriod = zValues(SG_NDX_IPERIOD)%vData

      fAngle(1) = fAngle(1) + fDelta(1)
      iPeriod(1) = INT(fAngle(1) / PI2)
      fCurrAngle = fAngle(1) - (iPeriod(1) * PI2)
      fResult = SIN(fCurrAngle)

      ! calculate damping, if necessary
      if (fDamp(1) .gt. 0.0) then
          fCurrFac = (1.0 - fDamp(1)) ** iPeriod(1)
          fNextFac = fCurrFac * (1.0 - fDamp(1))
          fResult = fResult * ((fCurrFac - fNextFac) *
     &                         (PI2 - fCurrAngle) / PI2 + fNextFac )
      end if

 

      ! place the value in all output links
      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_OUT) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              fValue(1) = fResult
          end if
      end do

      SG_xEval_Base_SineGen = SG_R_OK
      return
      end

Functions in Class Base.Constant     [Go To Top]

! Base_Constant.f
! - DLL routines for class <Component>Base.Constant
! DATE: Sunday, April 21, 2002 TIME: 11:47:44 AM
! The skeleton of this file is generated by SansGUI(tm)

! Attribute indices in class version [1.1.0.0]
! 1: fValue - Value

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

      ! TODO: declare your local variables here

      integer :: i
      real*4 :: fConstant
      integer, dimension(*) :: iInfo
      real*4, dimension(*) :: fValue
      type (SG_VALU), dimension(*) :: lnkValues
      POINTER(PTR_iInfo, iInfo)
      POINTER(PTR_fValue, fValue)
      POINTER(PTR_lnkValues, lnkValues)
      integer, parameter :: SG_NDX_FVALUE = 1
      integer, parameter :: LINK_NDX_IINFO = 1
      integer, parameter :: LINK_NDX_FVALUE = 2

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

      ! TODO: put your simulator code here

      PTR_zValues = self%pzValues
      PTR_fValue = zValues(SG_NDX_FVALUE)%vData
      fConstant = fValue(1) ! fetch the constant value

      ! Deposit the constant value to all the output links
      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_OUT) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              fValue(1) = fConstant
          end if
      end do

      SG_xBgnRun_Base_Constant = SG_R_OK
      return
      end
Functions in Class Base.Variable     [Go To Top]

! Base_Variable.f
! - DLL routines for class <Component>Base.Variable
! DATE: Sunday, April 21, 2002 TIME: 11:47:44 AM
! The skeleton of this file is generated by SansGUI(tm)

! Attribute indices in class version [1.0.0.0]
! 1: fValue - Variable Value

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

      ! TODO: declare your local variables here

      integer :: i
      real*4 :: fInit
      integer, dimension(*) :: iInfo
      real*4, dimension(*) :: fValue
      type (SG_VALU), dimension(*) :: lnkValues
      POINTER(PTR_iInfo, iInfo)
      POINTER(PTR_fValue, fValue)
      POINTER(PTR_lnkValues, lnkValues)
      integer, parameter :: SG_NDX_FVALUE = 1
      integer, parameter :: LINK_NDX_IINFO = 1
      integer, parameter :: LINK_NDX_FVALUE = 2

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

      ! TODO: put your simulator code here

      ! fetch the variable value
      PTR_zValues = self%pzValues
      PTR_fValue = zValues(SG_NDX_FVALUE)%vData
      fInit = fValue(1)
      ! Deposit the current value to all input link, if exists
      ! This is to avoid the initial value from being wiped off
      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_IN) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              fValue(1) = fInit
              exit    ! Connectivity rule limits to one input link
          end if
      end do

      SG_xInit_Base_Variable = SG_R_OK
      return
      end

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

      ! TODO: declare your local variables here

      integer :: i
      real*4 :: fResult
      integer, dimension(*) :: iInfo
      real*4, dimension(*) :: fValue
      type (SG_VALU), dimension(*) :: lnkValues
      POINTER(PTR_iInfo, iInfo)
      POINTER(PTR_fValue, fValue)
      POINTER(PTR_lnkValues, lnkValues)
      integer, parameter :: SG_NDX_FVALUE = 1
      integer, parameter :: LINK_NDX_IINFO = 1
      integer, parameter :: LINK_NDX_FVALUE = 2

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

      ! TODO: put your simulator code here

      PTR_zValues = self%pzValues
      PTR_fValue = zValues(SG_NDX_FVALUE)%vData
      fResult = fValue(1)   ! register the original value

      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_IN) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              fResult = fValue(1)
              ! store the new value in the variable (self) -- reconnect fValue
              PTR_zValues = self%pzValues
              PTR_fValue = zValues(SG_NDX_FVALUE)%vData
              fValue(1) = fResult
              exit    ! Connectivity rule limits to one input link
          end if
      end do

      ! Deposit the constant value to all the output links
      do i = 1, iLnkObjs
          PTR_lnkObject = pLnkObjs(i)
          PTR_lnkValues = lnkObject%pzValues
          PTR_iInfo = lnkValues(LINK_NDX_IINFO)%vData
          if (iInfo(1) .eq. SG_LINK_OUT) then
              PTR_fValue = lnkValues(LINK_NDX_FVALUE)%vData
              fValue(1) = fResult
          end if
      end do

      SG_xEval_Base_Variable = SG_R_OK
      return
      end

 


Visual Calculator for SansGUI version 1.1

Copyright 2000-2002 ProtoDesign, Inc. All rights reserved.

http://protodesign-inc.com