DayOfYear Function

public function DayOfYear(time, leap) result(day)

Gets the day of the year represented by this instance. Returns 366 for leap years

Arguments

Type IntentOptional Attributes Name
type(DateTime), intent(in) :: time
character(len=*), intent(in), optional :: leap

Return Value integer(kind=short)


Variables

Type Visibility Attributes Name Initial
type(DateTime), public :: february29
integer(kind=short), public :: i

Source Code

FUNCTION DayOfYear &
!
(time, leap) &
!
RESULT (day)

IMPLICIT NONE

! Arguments with intent(in):
TYPE (DateTime), INTENT(IN) :: time
CHARACTER (LEN = *), OPTIONAL, INTENT(IN) :: leap ! 'noleap' ignores 29th february of leap years

! Local variables:
INTEGER (KIND = short) :: day, i
TYPE (DateTime) :: february29
!------------end of declaration------------------------------------------------

day = 0
DO i = 1, time % month - 1
    day = day + DaysInMonth (i, time % year)
END DO
day = day + time % day

IF ( PRESENT (leap) ) THEN
  IF ( leap == 'noleap' ) THEN
    IF ( IsLeapYear (time % year) ) THEN
      !string = time
      !february29 = string
      february29 = time
      february29 % month = 2
      february29 % day = 29
      IF ( time >= february29 ) THEN
        day = day - 1
      END IF
    END IF
  ELSE
    CALL Catch ('warning', 'Chronos', 'unknown option in DayOfYear: ', &
               code = unknownOption, argument = leap )
  END IF
ELSE
  
END IF

END FUNCTION DayOfYear