Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | Which |
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 AddRecordFromSection(Which)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN March 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! When an object is entered like a section (i.e., <objectname>;), try to add a record
! of the object using minfields, etc.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: Which ! Which object was matched
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumArg
INTEGER :: NumAlpha
INTEGER :: NumNumeric
INTEGER :: Count
CHARACTER(len=52) :: String
NumArg=0
LineItem%Name=ObjectDef(Which)%Name
LineItem%Alphas=Blank
LineItem%AlphBlank=.false.
LineItem%NumAlphas=0
LineItem%Numbers=0.0d0
LineItem%NumNumbers=0
LineItem%NumBlank=.false.
LineItem%ObjectDefPtr=Which
ObjectDef(Which)%NumFound=ObjectDef(Which)%NumFound+1
! Check out MinimumNumberOfFields
IF (NumArg < ObjectDef(Which)%MinNumFields) THEN
IF (ObjectDef(Which)%NameAlpha1) THEN
CALL ShowAuditErrorMessage(' ** Warning ** ','IP: IDF line~'//TRIM(IPTrimSigDigits(NumLines))// &
' Object='//TRIM(ObjectDef(Which)%Name)// &
', name='//TRIM(LineItem%Alphas(1))// &
', entered with less than minimum number of fields.')
ELSE
CALL ShowAuditErrorMessage(' ** Warning ** ','IP: IDF line~'//TRIM(IPTrimSigDigits(NumLines))// &
' Object='//TRIM(ObjectDef(Which)%Name)// &
', entered with less than minimum number of fields.')
ENDIF
CALL ShowAuditErrorMessage(' ** ~~~ ** ','Attempting fill to minimum.')
NumAlpha=0
NumNumeric=0
IF (ObjectDef(Which)%MinNumFields > ObjectDef(Which)%NumParams) THEN
CALL ShowSevereError('IP: IDF line~'//TRIM(IPTrimSigDigits(NumLines))// &
' Object \min-fields > number of fields specified, Object='//TRIM(ObjectDef(Which)%Name))
CALL ShowContinueError('..\min-fields='//TRIM(IPTrimSigDigits(ObjectDef(Which)%MinNumFields))// &
', total number of fields in object definition='//TRIM(IPTrimSigDigits(ObjectDef(Which)%NumParams)))
! ErrFlag=.true.
ELSE
DO Count=1,ObjectDef(Which)%MinNumFields
IF (ObjectDef(Which)%AlphaOrNumeric(Count)) THEN
NumAlpha=NumAlpha+1
IF (NumAlpha <= LineItem%NumAlphas) CYCLE
LineItem%NumAlphas=LineItem%NumAlphas+1
IF (ObjectDef(Which)%AlphFieldDefs(LineItem%NumAlphas) /= Blank) THEN
LineItem%Alphas(LineItem%NumAlphas)=ObjectDef(Which)%AlphFieldDefs(LineItem%NumAlphas)
CALL ShowAuditErrorMessage(' ** Add ** ',TRIM(ObjectDef(Which)%AlphFieldDefs(LineItem%NumAlphas))// &
' ! field=>'//TRIM(ObjectDef(Which)%AlphFieldChks(NumAlpha)))
ELSEIF (ObjectDef(Which)%ReqField(Count)) THEN
IF (ObjectDef(Which)%NameAlpha1) THEN
CALL ShowSevereError('IP: IDF line~'//TRIM(IPTrimSigDigits(NumLines))// &
' Object='//TRIM(ObjectDef(Which)%Name)// &
', name='//TRIM(LineItem%Alphas(1))// &
', Required Field=['// &
TRIM(ObjectDef(Which)%AlphFieldChks(NumAlpha))// &
'] was blank.',EchoInputFile)
ELSE
CALL ShowSevereError('IP: IDF line~'//TRIM(IPTrimSigDigits(NumLines))// &
' Object='//TRIM(ObjectDef(Which)%Name)// &
', Required Field=['// &
TRIM(ObjectDef(Which)%AlphFieldChks(NumAlpha))// &
'] was blank.',EchoInputFile)
ENDIF
! ErrFlag=.true.
ELSE
LineItem%Alphas(LineItem%NumAlphas)=Blank
LineItem%AlphBlank(LineItem%NumAlphas)=.true.
CALL ShowAuditErrorMessage(' ** Add ** ','<blank field> ! field=>'// &
TRIM(ObjectDef(Which)%AlphFieldChks(NumAlpha)))
ENDIF
ELSE
NumNumeric=NumNumeric+1
IF (NumNumeric <= LineItem%NumNumbers) CYCLE
LineItem%NumNumbers=LineItem%NumNumbers+1
LineItem%NumBlank(NumNumeric)=.true.
IF (ObjectDef(Which)%NumRangeChks(NumNumeric)%Defaultchk) THEN
IF (.not. ObjectDef(Which)%NumRangeChks(NumNumeric)%DefAutoSize .and. &
.not. ObjectDef(Which)%NumRangeChks(NumNumeric)%DefAutoCalculate) THEN
LineItem%Numbers(NumNumeric)=ObjectDef(Which)%NumRangeChks(NumNumeric)%Default
WRITE(String,*) ObjectDef(Which)%NumRangeChks(NumNumeric)%Default
String=ADJUSTL(String)
CALL ShowAuditErrorMessage(' ** Add ** ',TRIM(String)// &
' ! field=>'//TRIM(ObjectDef(Which)%NumRangeChks(NumNumeric)%FieldName))
ELSEIF (ObjectDef(Which)%NumRangeChks(NumNumeric)%DefAutoSize) THEN
LineItem%Numbers(NumNumeric)=ObjectDef(Which)%NumRangeChks(NumNumeric)%AutoSizeValue
CALL ShowAuditErrorMessage(' ** Add ** ','autosize ! field=>'// &
TRIM(ObjectDef(Which)%NumRangeChks(NumNumeric)%FieldName))
ELSEIF (ObjectDef(Which)%NumRangeChks(NumNumeric)%DefAutoCalculate) THEN
LineItem%Numbers(NumNumeric)=ObjectDef(Which)%NumRangeChks(NumNumeric)%AutoCalculateValue
CALL ShowAuditErrorMessage(' ** Add ** ','autocalculate ! field=>'// &
TRIM(ObjectDef(Which)%NumRangeChks(NumNumeric)%FieldName))
ENDIF
ELSEIF (ObjectDef(Which)%ReqField(Count)) THEN
IF (ObjectDef(Which)%NameAlpha1) THEN
CALL ShowSevereError('IP: IDF line~'//TRIM(IPTrimSigDigits(NumLines))// &
' Object='//TRIM(ObjectDef(Which)%Name)// &
', name='//TRIM(LineItem%Alphas(1))// &
', Required Field=['// &
TRIM(ObjectDef(Which)%NumRangeChks(NumNumeric)%FieldName)// &
'] was blank.',EchoInputFile)
ELSE
CALL ShowSevereError('IP: IDF line~'//TRIM(IPTrimSigDigits(NumLines))// &
' Object='//TRIM(ObjectDef(Which)%Name)// &
', Required Field=['// &
TRIM(ObjectDef(Which)%NumRangeChks(NumNumeric)%FieldName)// &
'] was blank.',EchoInputFile)
ENDIF
! ErrFlag=.true.
ELSE
LineItem%Numbers(NumNumeric)=0.0d0
LineItem%NumBlank(NumNumeric)=.true.
CALL ShowAuditErrorMessage(' ** Add ** ','<blank field> ! field=>'// &
TRIM(ObjectDef(Which)%NumRangeChks(NumNumeric)%FieldName))
ENDIF
ENDIF
ENDDO
ENDIF
ENDIF
! IF (TransitionDefer) THEN
! CALL MakeTransition(Which)
! ENDIF
NumIDFRecords=NumIDFRecords+1
IF (ObjectStartRecord(Which) == 0) ObjectStartRecord(Which)=NumIDFRecords
MaxAlphaIDFArgsFound=MAX(MaxAlphaIDFArgsFound,LineItem%NumAlphas)
MaxNumericIDFArgsFound=MAX(MaxNumericIDFArgsFound,LineItem%NumNumbers)
MaxAlphaIDFDefArgsFound=MAX(MaxAlphaIDFDefArgsFound,ObjectDef(Which)%NumAlpha)
MaxNumericIDFDefArgsFound=MAX(MaxNumericIDFDefArgsFound,ObjectDef(Which)%NumNumeric)
IDFRecords(NumIDFRecords)%Name=LineItem%Name
IDFRecords(NumIDFRecords)%NumNumbers=LineItem%NumNumbers
IDFRecords(NumIDFRecords)%NumAlphas=LineItem%NumAlphas
IDFRecords(NumIDFRecords)%ObjectDefPtr=LineItem%ObjectDefPtr
ALLOCATE(IDFRecords(NumIDFRecords)%Alphas(LineItem%NumAlphas))
ALLOCATE(IDFRecords(NumIDFRecords)%AlphBlank(LineItem%NumAlphas))
ALLOCATE(IDFRecords(NumIDFRecords)%Numbers(LineItem%NumNumbers))
ALLOCATE(IDFRecords(NumIDFRecords)%NumBlank(LineItem%NumNumbers))
IDFRecords(NumIDFRecords)%Alphas(1:LineItem%NumAlphas)=LineItem%Alphas(1:LineItem%NumAlphas)
IDFRecords(NumIDFRecords)%AlphBlank(1:LineItem%NumAlphas)=LineItem%AlphBlank(1:LineItem%NumAlphas)
IDFRecords(NumIDFRecords)%Numbers(1:LineItem%NumNumbers)=LineItem%Numbers(1:LineItem%NumNumbers)
IDFRecords(NumIDFRecords)%NumBlank(1:LineItem%NumNumbers)=LineItem%NumBlank(1:LineItem%NumNumbers)
IF (LineItem%NumNumbers > 0) THEN
DO Count=1,LineItem%NumNumbers
IF (ObjectDef(Which)%NumRangeChks(Count)%MinMaxChk .and. .not. LineItem%NumBlank(Count)) THEN
CALL InternalRangeCheck(LineItem%Numbers(Count),Count,Which,LineItem%Alphas(1), &
ObjectDef(Which)%NumRangeChks(Count)%AutoSizable, &
ObjectDef(Which)%NumRangeChks(Count)%AutoCalculatable)
ENDIF
ENDDO
ENDIF
RETURN
END SUBROUTINE AddRecordFromSection