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 CheckLocationValidity
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN June 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is checks to see whether the user specified location
! or the weather file location (if one exists) is valid. The standard
! time meridian is also calculated and compared to the user supplied
! or weather file time zone number.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Legacy subroutine CKBLDE.
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
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:
LOGICAL :: LocationError ! Set to true if there is a problem detected
REAL(r64) :: StdTimeMerid ! Standard time meridian
REAL(r64) :: Diffcalc ! Difference between Standard Time Meridian and TimeZone
! FLOW:
LocationError = .FALSE.
IF ( (Latitude .EQ. -999.d0) .AND. (Longitude .EQ. -999.d0) &
.AND. (TimeZoneNumber .NE. -999.d0) ) THEN
CALL ShowSevereError('No location specified')
LocationError=.TRUE.
END IF
IF ( (Latitude .LT. -90.d0) .OR. (Latitude .GT. 90.d0) ) THEN
CALL ShowSevereError('Latitude must be between -90 and 90; Entered='//TRIM(RoundSigDigits(Latitude,2)))
LocationError=.TRUE.
END IF
IF ( (Longitude .LT. -180.d0) .OR. (Longitude .GT. 180.d0) ) THEN
CALL ShowSevereError('Longitude must be between -180 and 180; Entered='//TRIM(RoundSigDigits(Longitude,2)))
LocationError=.TRUE.
END IF
IF ( (TimeZoneNumber < -12.00d0) .OR. (TimeZoneNumber > 14.00d0) ) THEN
CALL ShowSevereError('Time Zone must be between -12 and +14; Entered='//TRIM(RoundSigDigits(TimeZoneNumber,2)))
LocationError=.TRUE.
END IF
StdTimeMerid=GetSTM(Longitude) ! Obtain the standard time meridian.
! Bias at +/- 12 for StdTimeMerid
! IF (StdTimeMerid == -12.0 .and. TimeZoneNumber > 0) THEN
! StdTimeMerid=12.0
! ELSEIF (StdTimeMerid == 12.0 .and. TimeZoneNumber < 0) THEN
! StdTimeMerid=-12.0
! ENDIF
! Compare the standard time meridian with the time zone number. If
! different, notify the user. If StdTimeMerid couldn't be calculated,
! produce an error message.
IF (StdTimeMerid >= -12.0d0 .and. StdTimeMerid <= 12.0d0) THEN
IF (TimeZoneNumber .NE. StdTimeMerid) THEN
DiffCalc=ABS(TimeZoneNumber-StdTimeMerid)
IF (DiffCalc > 1.d0 .and. DiffCalc < 24.d0) THEN
IF (DiffCalc < 3.d0) THEN
CALL ShowWarningError('Standard Time Meridian and Time Zone differ by more than 1, '// &
'Difference="'//TRIM(RoundSigDigits(DiffCalc,1))//'"')
CALL ShowContinueError('Solar Positions may be incorrect')
ELSE
CALL ShowSevereError('Standard Time Meridian and Time Zone differ by more than 2, '// &
'Difference="'//TRIM(RoundSigDigits(DiffCalc,1))//'"')
CALL ShowContinueError('Solar Positions will be incorrect')
! LocationError=.true.
ENDIF
ENDIF
ENDIF
ELSE
CALL ShowSevereError('Unable to calculate the standard time meridian')
LocationError=.TRUE.
ENDIF
! Error handling: if there are any errors in the location information
! the simulation must be terminated
IF (LocationError) THEN
CALL ShowFatalError('Due to previous error condition, simulation terminated')
ENDIF
IF (TimeZoneNumber <= 12.00d0) THEN
TimeZoneMeridian=TimeZoneNumber*15.d0
ELSE
TimeZoneMeridian=TimeZoneNumber*15.d0-360.d0
ENDIF
SinLatitude=SIN(DegToRadians*Latitude)
CosLatitude=COS(DegToRadians*Latitude)
IF (Latitude == 0.0d0 .and. Longitude == 0.0d0 .and. TimeZoneNumber == 0.0d0) THEN
CALL ShowWarningError('Did you realize that you have Latitude=0.0, Longitude=0.0 and TimeZone=0.0?'// &
' Your building site is in the middle of the Atlantic Ocean.')
ENDIF
RETURN
END SUBROUTINE CheckLocationValidity