!
! Copyright (C) 2000 by Fortran Library
!
! http://www.fortranlib.com
!
! This source may be freely copied, modified, or distributed so long as the original
! copyright and distribution statement remains intact.
!
! Suggestions for improvements to the original posted version are welcome.  Send
!   comments to mailto:webmaster@fortranlib.com
!
! Date Format Verification Routine
!
!    Verifies date is in proper format, extracts month, day, year into integer variables,
!    returns the day of the week, and returns an error code
!
!    date:  date in character format "mm/dd/yyyy"
!    imonth:  the returned month value in integer format (range: 1-12)
!    iday:  the returned day of the month value in integer format (range: 1-month total)
!    iyear: the returned year value in integer format (range: 1-9999)
!    idayofweek:  the returned day of the week (range: 1-7, 1=Sunday)
!    idayofyear:  the returned day of the year (range:  1-year total)
!    iret:  0 = successful
!          -1 = too many characters entered
!          -2 = unknown error, invalid format (e.g. no slashes)
!          -3 = non-numeric data for month
!          -4 = non-numeric data for day
!          -5 = non-numeric data for year
!          -6 = month value out of range (1-12)
!          -7 = day value out of range (1-month maximum)
!          -8 = year value out of range (1-9999)
!
subroutine CheckDate(date,imonth,iday,iyear,idayofweek,idayofyear,iret)

   implicit none

   character(*), intent (in) :: date
   character(2)              :: workmonth, workday
   character(4)              :: workyear
   character(20)             :: workdate

   integer, intent(out)      :: imonth, iday, iyear, idayofweek, idayofyear, iret
   integer                   :: iom, iod, ioy, lenstr, i, months(12)
   integer                   :: ia, im, iy

   logical                   :: leapyear, centyear
!
! Clear return code
!
   iret = 0
!
! Extract a chunk to work on (a little more than necessary to allow some error checking)
!
   workdate = adjustl(date)
!
! Remove nulls if present
!
   do i = 1,len_trim(workdate)
      if (workdate(i:i) .eq. char(0)) workdate(i:i) = ' '
   end do

   lenstr = len_trim(workdate)
!
! Check number of characters input
!
   if (lenstr .gt. 10) then
      iret = -1 !Too many characters
      return
   end if
!
! Too few characters entered?
!
   if (lenstr .lt. 10) then
      if (workdate(2:2) .eq. '/') workdate = "0" // workdate
      if (workdate(5:5) .eq. '/') workdate = workdate(1:3) // "0" // workdate(4:)
   end if

   lenstr = len_trim(workdate)

   if (lenstr .lt. 10) then
      iret = -2 !some other error, this should not occur unless no "/" entered
      return
   end if

   workmonth = workdate(1:2)
   workday = workdate(4:5)
   workyear = workdate(7:10)

   read(workmonth,'(i2)',iostat=iom)imonth
   read(workday,'(i2)',iostat=iod)iday
   read(workyear,'(i4)',iostat=ioy)iyear

   if (iom .ne. 0) then !(probably) non-numeric data entered for month
      iret = -3
      return
   end if
   if (iod .ne. 0) then !non-numeric data entered for day
      iret = -4
      return
   end if
   if (ioy .ne. 0) then !non-numeric data entered for year
      iret = -5
      return
   end if

   if (imonth .lt. 1 .or. imonth .gt. 12) then !month out of range
      iret = -6
      return
   end if

   if (iyear .lt. 1 .or. iyear .gt. 9999) then !year out of range
      iret = -8
      return
   end if
!
! Determine if it is a leap year
!
   centyear = .false.
   leapyear = .false.

   if (iyear / 100. - int(iyear / 100.) .eq. 0) centyear = .true. !Century year?

   if (iyear / 4. - int(iyear / 4.) .eq. 0) leapyear = .true.     !Leap year unless...

   if (centyear) then
      if (iyear / 400. - int(iyear / 400.) .gt. 0) leapyear = .false. !Century year not divisible by 400
   end if
!
! Length of each month for use later
!
   months     = 31 !all to 31

   months(02) = 28              !exceptions, Feb
   if (leapyear) months(2) = 29 !Feb in leap year

   months(04) = 30 !Apr
   months(06) = 30 !Jun
   months(09) = 30 !Sep
   months(11) = 30 !Nov

   select case (imonth) !Leap year and other processing for days of month

      case(4, 6, 9, 11) !Apr, Jun, Sep, Nov

         if (iday .lt. 1 .or. iday .gt. 30) then
            iret = -7
            return
         end if

      case(1, 3, 5, 7, 8, 10, 12) !Mar, May, Jul, Aug, Oct, Dec

         if (iday .lt. 1 .or. iday .gt. 31) then
            iret = -7
            return
         end if

      case(2) !Feb

         if (leapyear) then
            if (iday .lt. 1 .or. iday .gt. 29) then
               iret = -7
               return
            end if
         else
            if (iday .lt. 1 .or. iday .gt. 28) then
               iret = -7
               return
            end if
         end if

   end select
!
! Calculate day of the week, adjusted original algorithm from 0-6 to 1-7 for convenience)
!
   ia = (14 - imonth) / 12
   iy = iyear - ia
   im = imonth + (12 * ia) - 2
   idayofweek = mod(idayofyear + iy + (iy/4) - (iy/100) + (iy/400) + (31*im) + 4,7) + 1
!
! Calculate day of the year
!
   do i = 1,imonth-1
     idayofyear = idayofyear + months(i)
   end do

   idayofyear = idayofyear + iday

   return
end subroutine