Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | Object | |||
integer, | intent(in) | :: | Number | |||
character(len=*), | intent(out), | DIMENSION(:) | :: | Alphas | ||
integer, | intent(out) | :: | NumAlphas | |||
real(kind=r64), | intent(out), | DIMENSION(:) | :: | Numbers | ||
integer, | intent(out) | :: | NumNumbers | |||
integer, | intent(out) | :: | Status | |||
logical, | intent(out), | optional | DIMENSION(:) | :: | NumBlank | |
logical, | intent(out), | optional | DIMENSION(:) | :: | AlphaBlank | |
character(len=*), | optional | DIMENSION(:) | :: | AlphaFieldNames | ||
character(len=*), | optional | DIMENSION(:) | :: | NumericFieldNames |
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 GetObjectItem(Object,Number,Alphas,NumAlphas,Numbers,NumNumbers,Status,NumBlank,AlphaBlank, &
AlphaFieldNames,NumericFieldNames)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN September 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the 'number' 'object' from the IDFRecord data structure.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: Object
INTEGER, INTENT(IN) :: Number
CHARACTER(len=*), INTENT(OUT), DIMENSION(:) :: Alphas
INTEGER, INTENT(OUT) :: NumAlphas
REAL(r64), INTENT(OUT), DIMENSION(:) :: Numbers
INTEGER, INTENT(OUT) :: NumNumbers
INTEGER, INTENT(OUT) :: Status
LOGICAL, INTENT(OUT), DIMENSION(:), OPTIONAL :: AlphaBlank
LOGICAL, INTENT(OUT), DIMENSION(:), OPTIONAL :: NumBlank
CHARACTER(len=*), DIMENSION(:), OPTIONAL :: AlphaFieldNames
CHARACTER(len=*), DIMENSION(:), OPTIONAL :: NumericFieldNames
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Count
INTEGER LoopIndex
CHARACTER(len=MaxObjectNameLength) ObjectWord
CHARACTER(len=MaxObjectNameLength) UCObject
CHARACTER(len=MaxObjectNameLength), SAVE, ALLOCATABLE, DIMENSION(:) :: AlphaArgs
REAL(r64), SAVE, ALLOCATABLE, DIMENSION(:) :: NumberArgs
LOGICAL, SAVE, ALLOCATABLE, DIMENSION(:) :: AlphaArgsBlank
LOGICAL, SAVE, ALLOCATABLE, DIMENSION(:) :: NumberArgsBlank
INTEGER MaxAlphas,MaxNumbers
INTEGER Found
INTEGER StartRecord
CHARACTER(len=32) :: cfld1
CHARACTER(len=32) :: cfld2
LOGICAL :: GoodItem
INTEGER :: NAfld
INTEGER :: NNfld
!Objexx:Uninit Assure initialization: Lines added
NumAlphas = 0
NumNumbers = 0
MaxAlphas=SIZE(Alphas,1)
MaxNumbers=SIZE(Numbers,1)
GoodItem=.false.
IF (.not. ALLOCATED(AlphaArgs)) THEN
IF (NumObjectDefs == 0) THEN
CALL ProcessInput
ENDIF
ALLOCATE(AlphaArgs(MaxAlphaArgsFound))
ALLOCATE(NumberArgs(MaxNumericArgsFound))
ALLOCATE(NumberArgsBlank(MaxNumericArgsFound))
ALLOCATE(AlphaArgsBlank(MaxAlphaArgsFound))
ENDIF
Count=0
Status=-1
UCOBject=MakeUPPERCase(Object)
IF (SortedIDD) THEN
Found=FindIteminSortedList(UCOBject,ListofObjects,NumObjectDefs)
IF (Found /= 0) Found=iListofObjects(Found)
ELSE
Found=FindIteminList(UCOBject,ListofObjects,NumObjectDefs)
ENDIF
IF (Found == 0) THEN ! This is more of a developer problem
CALL ShowFatalError('IP: GetObjectItem: Requested object='//TRIM(UCObject)// &
', not found in Object Definitions -- incorrect IDD attached.')
ENDIF
IF (ObjectDef(Found)%NumAlpha > 0) THEN
IF (ObjectDef(Found)%NumAlpha > MaxAlphas) THEN
cfld1=IPTrimSigDigits(ObjectDef(Found)%NumAlpha)
cfld2=IPTrimSigDigits(MaxAlphas)
CALL ShowFatalError('IP: GetObjectItem: '//TRIM(Object)//', Number of ObjectDef Alpha Args ['//TRIM(cfld1)// &
'] > Size of AlphaArg array ['//TRIM(cfld2)//'].')
ENDIF
Alphas(1:ObjectDef(Found)%NumAlpha)=Blank
ENDIF
IF (ObjectDef(Found)%NumNumeric > 0) THEN
IF (ObjectDef(Found)%NumNumeric > MaxNumbers) THEN
cfld1=IPTrimSigDigits(ObjectDef(Found)%NumNumeric)
cfld2=IPTrimSigDigits(MaxNumbers)
CALL ShowFatalError('IP: GetObjectItem: '//TRIM(Object)//', Number of ObjectDef Numeric Args ['//TRIM(cfld1)// &
'] > Size of NumericArg array ['//TRIM(cfld2)//'].')
ENDIF
Numbers(1:ObjectDef(Found)%NumNumeric)=0.0d0
ENDIF
StartRecord=ObjectStartRecord(Found)
IF (StartRecord == 0) THEN
CALL ShowWarningError('IP: GetObjectItem: Requested object='//TRIM(UCObject)//', not found in IDF.')
Status=-1
StartRecord=NumIDFRecords+1
ENDIF
IF (ObjectGotCount(Found) == 0) THEN
WRITE(EchoInputFile,*) 'Getting object=',TRIM(UCObject)
ENDIF
ObjectGotCount(Found)=ObjectGotCount(Found)+1
DO LoopIndex=StartRecord,NumIDFRecords
IF (IDFRecords(LoopIndex)%Name == UCObject) THEN
Count=Count+1
IF (Count == Number) THEN
IDFRecordsGotten(LoopIndex)=.true. ! only object level "gets" recorded
! Read this one
CALL GetObjectItemfromFile(LoopIndex,ObjectWord,AlphaArgs,NumAlphas,NumberArgs,NumNumbers,AlphaArgsBlank,NumberArgsBlank)
IF (NumAlphas > MaxAlphas .or. NumNumbers > MaxNumbers) THEN
CALL ShowFatalError('IP: GetObjectItem: Too many actual arguments for those expected on Object: ' &
//TRIM(ObjectWord),EchoInputFile)
ENDIF
NumAlphas=MIN(MaxAlphas,NumAlphas)
NumNumbers=MIN(MaxNumbers,NumNumbers)
GoodItem=.true.
IF (NumAlphas > 0) THEN
Alphas(1:NumAlphas)=AlphaArgs(1:NumAlphas)
ENDIF
IF (NumNumbers > 0) THEN
Numbers(1:NumNumbers)=NumberArgs(1:NumNumbers)
ENDIF
IF (PRESENT(NumBlank)) THEN
NumBlank=.true.
IF (NumNumbers > 0) &
NumBlank(1:NumNumbers)=NumberArgsBlank(1:NumNumbers)
ENDIF
IF (PRESENT(AlphaBlank)) THEN
AlphaBlank=.true.
IF (NumAlphas > 0) &
AlphaBlank(1:NumAlphas)=AlphaArgsBlank(1:NumAlphas)
ENDIF
IF (PRESENT(AlphaFieldNames)) THEN
AlphaFieldNames(1:ObjectDef(Found)%NumAlpha)=ObjectDef(Found)%AlphFieldChks(1:ObjectDef(Found)%NumAlpha)
ENDIF
IF (PRESENT(NumericFieldNames)) THEN
NumericFieldNames(1:ObjectDef(Found)%NumNumeric)=ObjectDef(Found)%NumRangeChks(1:ObjectDef(Found)%NumNumeric)%FieldName
ENDIF
Status=1
EXIT
ENDIF
ENDIF
END DO
#ifdef IDDTEST
! This checks various principles of the IDD (e.g. required fields, defaults) to see what happens in the GetInput
! This can only work for "good" objects. (Found=object def)
! exempt certain objects
IF (SameString(ObjectDef(Found)%Name,'Schedule:Compact')) RETURN
IF (SameString(ObjectDef(Found)%Name(1:8),'Schedule')) RETURN
IF (SameString(ObjectDef(Found)%Name,'Construction')) RETURN
IF (SameString(ObjectDef(Found)%Name,'Construction:InternalSource')) RETURN
IF (SameString(ObjectDef(Found)%Name,'BuildingSurface:Detailed')) RETURN
IF (SameString(ObjectDef(Found)%Name,'Wall:Detailed')) RETURN
IF (SameString(ObjectDef(Found)%Name,'RoofCeiling:Detailed')) RETURN
IF (SameString(ObjectDef(Found)%Name,'Floor:Detailed')) RETURN
IF (SameString(ObjectDef(Found)%Name,'FenestrationSurface:Detailed')) RETURN
IF (SameString(ObjectDef(Found)%Name,'SizingPeriod:DesignDay')) RETURN
IF (SameString(ObjectDef(Found)%Name,'Branch')) RETURN
IF (GoodItem) THEN
NAfld=0
NNfld=0
DO LoopIndex=1,NumAlphas+NumNumbers
IF (LoopIndex > ObjectDef(Found)%MinNumFields) EXIT
IF (ObjectDef(Found)%AlphaorNumeric(LoopIndex)) THEN
NAfld=NAfld+1
IF (.not. ObjectDef(Found)%ReqField(LoopIndex)) THEN
IF (AlphaArgsBlank(NAfld)) Alphas(NAfld)=ObjectDef(Found)%AlphFieldDefs(NAfld)
IF (PRESENT(AlphaBlank)) THEN
IF (Alphas(NAfld) == Blank) THEN
AlphaBlank(NAfld)=.true.
ELSE
AlphaBlank(NAfld)=.false.
ENDIF
ENDIF
ENDIF
ELSE
NNfld=NNfld+1
IF (.not. ObjectDef(Found)%ReqField(LoopIndex)) THEN
Numbers(NNfld)=ObjectDef(Found)%NumRangeChks(NNfld)%Default
IF (ObjectDef(Found)%NumRangeChks(NNfld)%DefAutoSize) &
Numbers(NNfld)=ObjectDef(Found)%NumRangeChks(NNfld)%AutoSizeValue
IF (ObjectDef(Found)%NumRangeChks(NNfld)%AutoCalculatable) &
Numbers(NNfld)=ObjectDef(Found)%NumRangeChks(NNfld)%AutoCalculateValue
IF (PRESENT(NumBlank)) THEN
IF (Numbers(NNfld) == ObjectDef(Found)%NumRangeChks(NNfld)%Default) THEN
NumBlank(NNfld)=.true.
ELSE
NumBlank(NNfld)=.false.
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO
ENDIF
#endif
RETURN
END SUBROUTINE GetObjectItem