Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(inout) | :: | ObjPtr |
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 MakeTransition(ObjPtr)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN March 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! For those who keep Output:Reports in their input files, this will make a
! transition before storing in IDF Records
! METHODOLOGY EMPLOYED:
! Manipulates LineItem structure
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(INOUT) :: ObjPtr ! Pointer to Object Definition
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!
IF (MakeUPPERCase(LineItem%Name) /= 'OUTPUT:REPORTS') &
CALL ShowFatalError('Invalid object for deferred transition='//trim(LineItem%Name))
IF (LineItem%NumAlphas < 1) &
CALL ShowFatalError('Invalid object for deferred transition='//trim(LineItem%Name))
SELECT CASE (MakeUPPERCase(LineItem%Alphas(1)))
CASE ('VARIABLEDICTIONARY')
LineItem%Name='OUTPUT:VARIABLEDICTIONARY'
IF (SameString(LineItem%Alphas(2),'IDF')) THEN
LineItem%Alphas(1)='IDF'
ELSE
LineItem%Alphas(1)='REGULAR'
ENDIF
LineItem%NumAlphas=1
IF (SameString(LineItem%Alphas(3),'Name')) THEN
LineItem%Alphas(2)='NAME'
LineItem%NumAlphas=2
ELSE
LineItem%Alphas(2)='NONE'
LineItem%NumAlphas=2
ENDIF
CASE ('SURFACES')
! Depends on first Alpha
SELECT CASE(MakeUPPERCase(LineItem%Alphas(2)))
CASE ('DXF', 'DXF:WIREFRAME', 'VRML')
LineItem%Name='OUTPUT:SURFACES:DRAWING'
LineItem%Alphas(1)=LineItem%Alphas(2)
LineItem%NumAlphas=1
IF (LineItem%Alphas(3) /= Blank) THEN
LineItem%NumAlphas=LineItem%NumAlphas+1
LineItem%Alphas(2)=LineItem%Alphas(3)
ENDIF
IF (LineItem%Alphas(4) /= Blank) THEN
LineItem%NumAlphas=LineItem%NumAlphas+1
LineItem%Alphas(3)=LineItem%Alphas(4)
ENDIF
CASE ('LINES', 'DETAILS', 'VERTICES', 'DETAILSWITHVERTICES', 'VIEWFACTORINFO', 'COSTINFO')
LineItem%Name='OUTPUT:SURFACES:LIST'
LineItem%Alphas(1)=LineItem%Alphas(2)
LineItem%NumAlphas=1
IF (LineItem%Alphas(3) /= Blank) THEN
LineItem%NumAlphas=LineItem%NumAlphas+1
LineItem%Alphas(2)=LineItem%Alphas(3)
ENDIF
CASE DEFAULT
CALL ShowSevereError('MakeTransition: Cannot transition='//trim(LineItem%Name)// &
', first field='//trim(LineItem%Alphas(1))//', second field='//trim(LineItem%Alphas(2)))
END SELECT
CASE ('CONSTRUCTIONS', 'CONSTRUCTION')
LineItem%Name='OUTPUT:CONSTRUCTIONS'
LineItem%Alphas(1)='CONSTRUCTIONS'
LineItem%NumAlphas=1
CASE ('MATERIALS', 'MATERIAL')
LineItem%Name='OUTPUT:CONSTRUCTIONS'
LineItem%Alphas(1)='MATERIALS'
LineItem%NumAlphas=1
CASE ('SCHEDULES')
LineItem%Name='OUTPUT:SCHEDULES'
LineItem%Alphas(1)=LineItem%Alphas(2)
LineItem%NumAlphas=1
CASE DEFAULT
CALL ShowSevereError('MakeTransition: Cannot transition='//trim(LineItem%Name)// &
', first field='//trim(LineItem%Alphas(1)))
END SELECT
ObjectDef(ObjPtr)%NumFound=ObjectDef(ObjPtr)%NumFound-1
ObjPtr=FindItemInList(LineItem%Name,ListOfObjects,NumObjectDefs)
ObjPtr=iListofObjects(ObjPtr)
IF (ObjPtr == 0) CALL ShowFatalError('No Object Def for '//trim(LineItem%Name))
ObjectDef(ObjPtr)%NumFound=ObjectDef(ObjPtr)%NumFound+1
RETURN
END SUBROUTINE MakeTransition