Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE EchoOutActuatorKeyChoices
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith
! DATE WRITTEN April 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! echo out actuators registered with SetupEMSActuator for user access
! METHODOLOGY EMPLOYED:
! mine structure and write to edd file
! note this executes after final processing and sizing-related calling points may already execute Erl programs
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ActuatorLoop
CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: TempTypeName
CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: TempCntrlType
LOGICAL, DIMENSION(:), ALLOCATABLE :: NonUniqueARRflag
INTEGER :: FoundTypeName
INTEGER :: FoundControlType
IF (OutputEMSActuatorAvailFull) THEN
WRITE(OutputEMSFileUnitNum, '(A)') '! <EnergyManagementSystem:Actuator Available>, Component Unique Name,' &
//' Component Type, Control Type, Units'
Do ActuatorLoop =1, numEMSActuatorsAvailable
WRITE(OutputEMSFileUnitNum, '(A)') 'EnergyManagementSystem:Actuator Available,' &
//Trim(EMSActuatorAvailable(ActuatorLoop)%UniqueIDName) &
//','//Trim(EMSActuatorAvailable(ActuatorLoop)%ComponentTypeName) &
//','//Trim(EMSActuatorAvailable(ActuatorLoop)%ControlTypeName) &
//','//Trim(EMSActuatorAvailable(ActuatorLoop)%Units)
ENDDO
ELSE IF (OutputEMSActuatorAvailSmall) THEN
WRITE(OutputEMSFileUnitNum, '(A)') '! <EnergyManagementSystem:Actuator Available>, *, Component Type, '// &
'Control Type, Units'
ALLOCATE(TempTypeName(numEMSActuatorsAvailable))
TempTypeName = EMSActuatorAvailable%ComponentTypeName
ALLOCATE(TempCntrlType(numEMSActuatorsAvailable))
TempCntrlType = EMSActuatorAvailable%ControlTypeName
ALLOCATE(NonUniqueARRflag(numEMSActuatorsAvailable))
NonUniqueARRflag = .FALSE.
DO ActuatorLoop =1, numEMSActuatorsAvailable
IF (ActuatorLoop+1 <= numEMSActuatorsAvailable) THEN
FoundTypeName = FindItemInList(TempTypeName(ActuatorLoop), TempTypeName(ActuatorLoop+1:numEMSActuatorsAvailable), &
(numEMSActuatorsAvailable - (ActuatorLoop+1)) )
FoundControlType = FindItemInList(TempCntrlType(ActuatorLoop), TempCntrlType(ActuatorLoop+1:numEMSActuatorsAvailable), &
(numEMSActuatorsAvailable - (ActuatorLoop+1)) )
ELSE
FoundTypeName = 1
FoundControlType = 1
ENDIF
IF ((FoundTypeName /= 0) .AND. (FoundControlType /= 0)) THEN
NonUniqueARRflag(ActuatorLoop) = .TRUE.
ENDIF
ENDDO
DO ActuatorLoop =1, numEMSActuatorsAvailable
IF (.NOT. NonUniqueARRflag(ActuatorLoop)) Then
WRITE(OutputEMSFileUnitNum, '(A)') 'EnergyManagementSystem:Actuator Available,' &
//' *' &
//','//Trim(EMSActuatorAvailable(ActuatorLoop)%ComponentTypeName) &
//','//Trim(EMSActuatorAvailable(ActuatorLoop)%ControlTypeName) &
//','//Trim(EMSActuatorAvailable(ActuatorLoop)%Units)
ENDIF
ENDDO
DEALLOCATE(TempTypeName)
DEALLOCATE(TempCntrlType)
DEALLOCATE(NonUniqueARRflag)
ENDIF
RETURN
END SUBROUTINE EchoOutActuatorKeyChoices