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.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| logical, | intent(inout) | :: | ErrorsFound |
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 GetGeometryParameters(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN May 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine reads in the "Surface Geometry" parameters, verifies them,
! and sets "global" variables that will tell other routines how the surface
! vertices are expected in input.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! GlobalGeometryRules Definition
!GlobalGeometryRules,
! \required-object
! \unique-object
! A1, \field Starting Vertex Position
! \required-field
! \note Specified as entry for a 4 sided surface/rectangle
! \note Surfaces are specified as viewed from outside the surface
! \note Shading surfaces as viewed from behind. (towards what they are shading)
! \type choice
! \key UpperLeftCorner
! \key LowerLeftCorner
! \key UpperRightCorner
! \key LowerRightCorner
! A2, \field Vertex Entry Direction
! \required-field
! \type choice
! \key Counterclockwise
! \key Clockwise
! A3, \field Coordinate System
! \required-field
! \note relative -- coordinates are entered relative to zone origin
! \note world -- all coordinates entered are "absolute" for this facility
! \note absolute -- same as world
! \type choice
! \key Relative
! \key World
! \key Absolute
! A4, \field Daylighting Reference Point Coordinate System
! \type choice
! \key Relative
! \default Relative
! \note Relative -- coordinates are entered relative to zone origin
! \key World
! \note World -- all coordinates entered are "absolute" for this facility
! \key Absolute
! \note absolute -- same as world
! A5; \field Rectangular Surface Coordinate System
! \type choice
! \key Relative
! \default Relative
! \note Relative -- Starting corner is entered relative to zone origin
! \key World
! \note World -- Starting corner is entered in "absolute"
! \key Absolute
! \note absolute -- same as world
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItem, SameString, VerifyName
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! set to true if errors found during input
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=3), PARAMETER, DIMENSION(4) :: AbCorners=(/'ULC','LLC','LRC','URC'/)
CHARACTER(len=16), PARAMETER, DIMENSION(4) :: FlCorners=(/'UpperLeftCorner ','LowerLeftCorner ', &
'LowerRightCorner','UpperRightCorner'/)
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER NumStmt
CHARACTER(len=MaxNameLength), DIMENSION(5) :: GAlphas
INTEGER NAlphas
REAL(r64), DIMENSION(1) :: GNum
INTEGER NNum
INTEGER IOSTAT
LOGICAL OK
INTEGER Found
CHARACTER(len=150) :: OutMsg
cCurrentModuleObject='GlobalGeometryRules'
NumStmt=GetNumObjectsFound(cCurrentModuleObject)
OutMsg=' Surface Geometry,'
SELECT CASE(NumStmt)
CASE (1)
! This is the valid case
CALL GetObjectItem(cCurrentModuleObject,1,GAlphas,NAlphas,GNum,NNum,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! Even though these will be validated, set defaults in case error here -- wont
! cause aborts in later surface gets (hopefully)
Corner=UpperLeftCorner
WorldCoordSystem=.true.
CCW=.true.
OK=.false.
Found=FindItem(GAlphas(1),AbCorners,4)
IF (Found == 0) THEN
Found=FindItem(GAlphas(1),FlCorners,4)
IF (Found == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Invalid '//TRIM(cAlphaFieldNames(1))//'='//TRIM(GAlphas(1)))
ErrorsFound=.true.
ELSE
Corner=Found
OK=.true.
OutMsg=TRIM(OutMsg)//TRIM(FLCorners(Corner))//','
ENDIF
ELSE
Corner=Found
OutMsg=TRIM(OutMsg)//TRIM(FLCorners(Corner))//','
OK=.true.
ENDIF
OK=.false.
IF (SameString(GAlphas(2),'CCW') .or. SameString(GAlphas(2),'Counterclockwise')) THEN
CCW=.true.
OutMsg=TRIM(OutMsg)//'Counterclockwise'//','
OK=.true.
ENDIF
IF (SameString(GAlphas(2),'CW') .or. SameString(GAlphas(2),'Clockwise')) THEN
CCW=.false.
OutMsg=TRIM(OutMsg)//'Clockwise'//','
OK=.true.
ENDIF
IF (.not. OK) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(GAlphas(2)))
ErrorsFound=.true.
ENDIF
OK=.false.
IF (SameString(GAlphas(3),'WCS') .or. SameString(GAlphas(3),'WorldCoordinateSystem') .or. &
SameString(GAlphas(3),'World') .or. SameString(GAlphas(3),'Absolute')) THEN
WorldCoordSystem=.true.
OutMsg=TRIM(OutMsg)//'WorldCoordinateSystem'//','
OK=.true.
ENDIF
IF (SameString(GAlphas(3)(1:3),'Rel') .or. SameString(GAlphas(3)(1:8),'Relative') .or. SameString(GAlphas(3),'Local')) THEN
WorldCoordSystem=.false.
OutMsg=TRIM(OutMsg)//'RelativeCoordinateSystem'//','
OK=.true.
ENDIF
IF (.not. OK) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(GAlphas(3)))
CALL ShowContinueError(TRIM(cAlphaFieldNames(3))//' defaults to "WorldCoordinateSystem"')
WorldCoordSystem=.true.
OutMsg=TRIM(OutMsg)//'WorldCoordinateSystem'//','
ENDIF
OK=.false.
IF (SameString(GAlphas(4),'WCS') .or. SameString(GAlphas(4),'WorldCoordinateSystem') .or. &
SameString(GAlphas(4),'World') .or. SameString(GAlphas(4),'Absolute')) THEN
DaylRefWorldCoordSystem=.true.
OutMsg=TRIM(OutMsg)//'WorldCoordinateSystem'//','
OK=.true.
ENDIF
IF (SameString(GAlphas(4)(1:3),'Rel') .or. SameString(GAlphas(4)(1:8),'Relative') .or. &
SameString(GAlphas(4),'Local') .or. GAlphas(4) == Blank) THEN
DaylRefWorldCoordSystem=.false.
OutMsg=TRIM(OutMsg)//'RelativeCoordinateSystem'//','
OK=.true.
ENDIF
IF (.not. OK) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(GAlphas(4)))
CALL ShowContinueError(TRIM(cAlphaFieldNames(4))//' defaults to "RelativeToZoneOrigin"')
DaylRefWorldCoordSystem=.false.
OutMsg=TRIM(OutMsg)//'RelativeToZoneOrigin'//','
ENDIF
OK=.false.
IF (SameString(GAlphas(5),'WCS') .or. SameString(GAlphas(5),'WorldCoordinateSystem') .or. &
SameString(GAlphas(5),'World') .or. SameString(GAlphas(5),'Absolute')) THEN
RectSurfRefWorldCoordSystem=.true.
OutMsg=TRIM(OutMsg)//'WorldCoordinateSystem'
OK=.true.
ENDIF
IF (SameString(GAlphas(5)(1:3),'Rel') .or. SameString(GAlphas(5)(1:8),'Relative') .or. &
SameString(GAlphas(5),'Local') .or. GAlphas(5) == Blank) THEN
RectSurfRefWorldCoordSystem=.false.
OutMsg=TRIM(OutMsg)//'RelativeToZoneOrigin'
OK=.true.
ENDIF
IF (.not. OK) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': Invalid '//TRIM(cAlphaFieldNames(5))//'='//TRIM(GAlphas(5)))
CALL ShowContinueError(TRIM(cAlphaFieldNames(5))//' defaults to "RelativeToZoneOrigin"')
RectSurfRefWorldCoordSystem=.false.
OutMsg=TRIM(OutMsg)//'RelativeToZoneOrigin'
ENDIF
CASE (0)
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Required object not found.')
OutMsg=TRIM(OutMsg)//'None found in input'
ErrorsFound=.true.
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Too many objects entered. Only one allowed.')
ErrorsFound=.true.
END SELECT
IF (.not. WorldCoordSystem) THEN
IF (DaylRefWorldCoordSystem) THEN
CALL ShowWarningError(trim(cCurrentModuleObject)//': Potential mismatch of coordinate specifications.')
CALL ShowContinueError(trim(cAlphaFieldNames(3))//'="'//trim(GAlphas(3))//'"; while ')
CALL ShowContinueError(trim(cAlphaFieldNames(4))//'="'//trim(GAlphas(4))//'".')
ENDIF
IF (RectSurfRefWorldCoordSystem) THEN
CALL ShowWarningError(trim(cCurrentModuleObject)//': Potential mismatch of coordinate specifications.')
CALL ShowContinueError(trim(cAlphaFieldNames(3))//'="'//trim(GAlphas(3))//'"; while ')
CALL ShowContinueError(trim(cAlphaFieldNames(5))//'="'//trim(GAlphas(5))//'".')
ENDIF
ENDIF
WRITE(OutputFileInits,720) '! <SurfaceGeometry>,Starting Corner,'// &
'Vertex Input Direction,Coordinate System,'// &
'Daylight Reference Point Coordinate System,'//'Rectangular (Simple) Surface Coordinate System'
WRITE(OutputFileInits,720) TRIM(OutMsg)
720 Format(A)
RETURN
END SUBROUTINE GetGeometryParameters