|
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
|