MODULE mdates
use mkinds

contains
SUBROUTINE DATE2WNDAY(WDAY, IYR,MON,IDY)
IMPLICIT NONE
INTEGER(i4) :: IYR,MON,IDY
REAL(r4)   ::  WDAY
!**********
!*
!  1) CONVERT DATE INTO 'FLUX DAY'.
!
!  2) THE 'FLUX DAY' IS THE NUMBER OF DAYS SINCE 001/1901 (WHICH IS 
!      FLUX DAY 1.0).
!     FOR EXAMPLE:
!      A) IYR=1901,MON=1,IDY=1, REPRESENTS 0000Z HRS ON 01/01/1901
!         SO WDAY WOULD BE 1.0.
!      A) IYR=1901,MON=1,IDY=2, REPRESENTS 0000Z HRS ON 02/01/1901
!         SO WDAY WOULD BE 2.0.
!     YEAR MUST BE NO LESS THAN 1901.0, AND NO GREATER THAN 2099.0.
!     NOTE THAT YEAR 2000 IS A LEAP YEAR (BUT 1900 AND 2100 ARE NOT).
!
!  3) ALAN J. WALLCRAFT, NAVAL RESEARCH LABORATORY, JULY 2002.
!  4) converted to f90 a. srinivasan, Oct, 2011

INTEGER(i4)         :: NLEAP
REAL(r4)           :: WDAY1
REAL(r4),PARAMETER ::  MONTH(13) = &
(/ 0,  31,  59,  90, 120, 151, 181,212, 243, 273, 304, 334, 365 /)

!FIND THE RIGHT YEAR.

NLEAP = (IYR-1901)/4
WDAY  = 365.0*(IYR-1901) + NLEAP + MONTH(MON) + IDY
IF     (MOD(IYR,4).EQ.0 .AND. MON.GT.2) THEN
        WDAY  = WDAY + 1.0
ENDIF
RETURN
END subroutine date2wnday

SUBROUTINE WNDAY(WDAY, YEAR,DAY)
IMPLICIT NONE
REAL(r4) ::   WDAY
REAL(r4) ::   YEAR
REAL(r4) ::   DAY

!  1) CONVERT 'FLUX DAY' INTO JULIAN DAY AND YEAR.
!
!  2) THE 'FLUX DAY' IS THE NUMBER OF DAYS SINCE 001/1901 (WHICH IS 
!     FLUX DAY 1.0).
!     FOR EXAMPLE:
!      A) YEAR=1901.0 AND DAY=1.0, REPRESENTS 0000Z HRS ON 001/1901
!         SO WDAY WOULD BE 1.0.
!      B) YEAR=1901.0 AND DAY=2.5, REPRESENTS 1200Z HRS ON 002/1901
!         SO WDAY WOULD BE 2.5.
!     YEAR MUST BE NO LESS THAN 1901.0, AND NO GREATER THAN 2099.0.
!     NOTE THAT YEAR 2000 IS A LEAP YEAR (BUT 1900 AND 2100 ARE NOT).
!
!  3) ALAN J. WALLCRAFT, PLANNING SYSTEMS INC., FEBRUARY 1993.

INTEGER(i4) :: IYR
integer(i4) :: NLEAP
REAL(i4)   :: WDAY1

!     FIND THE RIGHT YEAR.

      IYR   = (WDAY-1.0)/365.25
      NLEAP = IYR/4
      WDAY1 = 365.0*IYR + NLEAP + 1.0
      DAY   = WDAY - WDAY1 + 1.0
      IF     (WDAY1.GT.WDAY) THEN
        IYR   = IYR - 1
      ELSEIF (DAY.GE.367.0) THEN
        IYR   = IYR + 1
      ELSEIF (DAY.GE.366.0 .AND. MOD(IYR,4).NE.3) THEN
        IYR   = IYR + 1
      ENDIF
      NLEAP = IYR/4
      WDAY1 = 365.0*IYR + NLEAP + 1.0

!     RETURN YEAR AND JULIAN DAY.

      YEAR = 1901 + IYR
      DAY  = WDAY - WDAY1 + 1.0
      RETURN
      END subroutine wnday
      

SUBROUTINE forday(dtime,iyear,iday,ihour)
implicit none

real(r4)   ::  dtime
integer(i4) ::  iyear
integer(i4) ::  iday
integer(i4) ::  ihour

! --- converts model day to "calendar" date (year,ordinal-day,hour).
real(r4)    ::  dtim1
real(r4)    ::  day
integer(i4)  ::  iyr
integer(i4)  ::  nleap

! ---   model day is calendar days since 01/01/1901
iyr   = (dtime-1.d0)/365.25d0
nleap = iyr/4
dtim1 = 365.d0*iyr + nleap + 1.d0
day   = dtime - dtim1 + 1.d0
if     (dtim1.gt.dtime) then
iyr = iyr - 1
elseif (day.ge.367.d0) then
iyr = iyr + 1
elseif (day.ge.366.d0 .and. mod(iyr,4).ne.3) then
iyr = iyr + 1
endif
nleap = iyr/4
dtim1 = 365.d0*iyr + nleap + 1.d0

iyear =  1901 + iyr
iday  =  dtime - dtim1 + 1.001d0
ihour = (dtime - dtim1 + 1.001d0 - iday)*24.d0

return
end subroutine forday

SUBROUTINE calend(yyyy, ddd, mm, dd)
!=============CALEND WHEN GIVEN A VALID YEAR, YYYY, AND DAY OF THE YEAR, DDD,
!RETURNS THE MONTH, MM, AND DAY OF THE MONTH, DD.
!SEE ACM ALGORITHM 398, TABLELESS DATE CONVERSION, BY
!DICK STONE, CACM 13(10):621.

INTEGER(i4), INTENT(IN)   :: yyyy
INTEGER(i4), INTENT(IN)   :: ddd
INTEGER(i4), INTENT(OUT)  :: mm
INTEGER(i4), INTENT(OUT)  :: dd

INTEGER(i4) :: t

t = 0
IF(MOD(yyyy, 4) == 0) t = 1

!-----------THE FOLLOWING STATEMENT IS NECESSARY IF YYYY IS < 1900 OR > 2100.
IF(MOD(yyyy, 400) /= 0 .AND. MOD(yyyy, 100) == 0) t = 0

dd = ddd
IF(ddd > 59+t) dd = dd + 2 - t
mm = ((dd+91)*100)/3055
dd = (dd+91) - (mm*3055)/100
mm = mm - 2
!----------MM WILL BE CORRECT IFF DDD IS CORRECT FOR YYYY.
IF(mm >= 1 .AND. mm <= 12) RETURN
!             WRITE(*,*) ddd
! 1 FORMAT('0$$$CALEND: DAY OF THE YEAR INPUT =', i11,  ' IS OUT OF RANGE.')

END SUBROUTINE calend

!ARITHMETIC FUNCTIONS 'IZLR' AND 'IDAY' ARE TAKEN FROM REMARK ON
!ALGORITHM 398, BY J. DOUGLAS ROBERTSON, CACM 15(10):918.

FUNCTION iday(yyyy, mm, dd) RESULT(ival)
!------IDAY IS A COMPANION TO CALEND; GIVEN A CALENDAR DATE, YYYY, MM,
!           DD, IDAY IS RETURNED AS THE DAY OF THE YEAR.
!           EXAMPLE: IDAY(1984, 4, 22) = 113

INTEGER(i4), INTENT(IN) :: yyyy, mm, dd
INTEGER(i4)             :: ival

ival = 3055*(mm+2)/100 - (mm+10)/13*2 -91 + (1-(MOD(yyyy, 4)+3)/4 &
+(MOD(yyyy, 100) + 99)/100 - (MOD(yyyy, 400)+399)/400)*(mm+10)/13 + dd

RETURN
END FUNCTION iday

FUNCTION izlr(yyyy, mm, dd) RESULT(ival)

!------IZLR(YYYY, MM, DD) GIVES THE WEEKDAY NUMBER 0 = SUNDAY, 1 = MONDAY,
!      ... 6 = SATURDAY.  EXAMPLE: IZLR(1970, 1, 1) = 4 = THURSDAY

INTEGER(i4), INTENT(IN) :: yyyy, mm, dd
INTEGER(i4)             :: ival

ival = MOD((13*(mm+10-(mm+10)/13*12)-1)/5 + dd + 77 + 5*(yyyy+(mm-14)/12 - &
(yyyy+(mm-14)/12)/100*100)/4 + (yyyy+(mm-14)/12)/400 - (yyyy+(mm-14)/12)/100*2, 7)

RETURN
END FUNCTION izlr

SUBROUTINE cdate(jd, yyyy, mm, dd)
!=======GIVEN A JULIAN DAY NUMBER, NNNNNNNN, YYYY,MM,DD ARE RETURNED AS THE
!       CALENDAR DATE. JD = NNNNNNNN IS THE JULIAN DATE FROM AN EPOCH
!       IN THE VERY DISTANT PAST.  SEE CACM 1968 11(10):657,
!       LETTER TO THE EDITOR BY FLIEGEL AND VAN FLANDERN.
!       EXAMPLE CALL CDATE(2440588, YYYY, MM, DD) RETURNS 1970 1 1 .

INTEGER(i4), INTENT(IN)   :: jd
INTEGER(i4), INTENT(OUT)  :: yyyy
INTEGER(i4), INTENT(OUT)  :: mm
INTEGER(i4), INTENT(OUT)  :: dd

INTEGER(i4) :: l, n

 l = jd + 68569
 n = 4*l/146097
 l = l - (146097*n + 3)/4
 yyyy = 4000*(l+1)/1461001
 l = l - 1461*yyyy/4 + 31
 mm = 80*l/2447
 dd = l - 2447*mm/80
 l = mm/11
mm = mm + 2 - 12*l
 yyyy = 100*(n-49) + yyyy + l
RETURN
END SUBROUTINE cdate

SUBROUTINE daysub(jd, yyyy, mm, dd, wd, ddd)
!======  GIVEN JD, A JULIAN DAY # (SEE ASF JD), THIS ROUTINE CALCULATES DD,
!        THE DAY NUMBER OF THE MONTH; MM, THE MONTH NUMBER; YYYY THE YEAR;
!        WD THE WEEKDAY NUMBER, AND DDD THE DAY NUMBER OF THE YEAR.

!   EXAMPLE: CALL DAYSUB(2440588, YYYY, MM, DD, WD, DDD) YIELDS 1970 1 1 4 1.

INTEGER(i4), INTENT(IN)   :: jd
INTEGER(i4), INTENT(OUT)  :: yyyy
INTEGER(i4), INTENT(OUT)  :: mm
INTEGER(i4), INTENT(OUT)  :: dd
INTEGER(i4), INTENT(OUT)  :: wd
INTEGER(i4), INTENT(OUT)  :: ddd

CALL cdate(jd, yyyy, mm, dd)
wd = izlr(yyyy, mm, dd)
ddd = iday(yyyy, mm, dd)

RETURN
END SUBROUTINE daysub

FUNCTION jd(yyyy, mm, dd) RESULT(ival)

INTEGER(i4), INTENT(IN)  :: yyyy
INTEGER(i4), INTENT(IN)  :: mm
INTEGER(i4), INTENT(IN)  :: dd
INTEGER(i4)              :: ival

!DATE ROUTINE JD(YYYY, MM, DD) CONVERTS CALENDER DATE TO
!JULIAN DATE.  SEE CACM 1968 11(10):657, LETTER TO THE
!EDITOR BY HENRY F. FLIEGEL AND THOMAS C. VAN FLANDERN.
!EXAMPLE JD(1970, 1, 1) = 2440588

ival = dd - 32075 + 1461*(yyyy+4800+(mm-14)/12)/4 + 367*(mm-2-((mm-14)/12)*12)/12 &
- 3*((yyyy+4900+(mm-14)/12)/100)/4

RETURN
END FUNCTION jd

FUNCTION ndays(mm1, dd1, yyyy1, mm2, dd2, yyyy2) RESULT(ival)

INTEGER, INTENT(IN)  :: mm1
INTEGER, INTENT(IN)  :: dd1
INTEGER, INTENT(IN)  :: yyyy1
INTEGER, INTENT(IN)  :: mm2
INTEGER, INTENT(IN)  :: dd2
INTEGER, INTENT(IN)  :: yyyy2
INTEGER              :: ival

!=======NDAYS IS RETURNED AS THE NUMBER OF DAYS BETWEEN TWO
!              DATES; THAT IS  MM1/DD1/YYYY1 MINUS MM2/DD2/YYYY2,
!              WHERE DATEI AND DATEJ HAVE ELEMENTS MM, DD, YYYY.
!-------NDAYS WILL BE POSITIVE IFF DATE1 IS MORE RECENT THAN DATE2.

ival = jd(yyyy1, mm1, dd1) - jd(yyyy2, mm2, dd2)

RETURN
END FUNCTION ndays

subroutine cdtbk(idate,lkbk,odate)

implicit none
integer :: lkbk
character(len=*) :: idate,odate
integer :: iyyyy,imm,idd,ihh
integer :: oyyyy,omm,odd,ohh
integer :: jdbk

read(idate(1:4),'(i4.4)') iyyyy
read(idate(5:6),'(i2.2)')   imm
read(idate(7:8),'(i2.2)')   idd

if(len_trim(idate)>8) then
read(idate(9:10),'(i2.2)')   ihh
endif

jdbk=jd(iyyyy, imm, idd)-lkbk

call cdate(jdbk, oyyyy, omm, odd)

write(odate(1:4),'(i4.4)') oyyyy
write(odate(5:6),'(i2.2)')   omm
write(odate(7:8),'(i2.2)')   odd
if(len_trim(odate)>8) then
odate(9:10)='00'
endif
end subroutine

subroutine wday2cdate(wday,cdate)
character(len=8) :: cdate
real(r4)         :: wday
INTEGER(i4) :: IYR,IDY,mm,dd,hh
call forday(wday,iyr,mon,hh)
call calend(iyr, mon, mm, dd)
write(cdate(1:4),'(i4.4)') iyr
write(cdate(5:6),'(i2.2)') mm
write(cdate(7:8),'(i2.2)') dd
!write(cdate(9:10),'(i2.2)') hh
END SUBROUTINE

subroutine wday2cdtghh(wday,cdate)
        character(len=10) :: cdate
        real(r4)         :: wday
        INTEGER(i4) :: IYR,IDY,mm,dd,hh
        call forday(wday,iyr,mon,hh)
        call calend(iyr, mon, mm, dd)
        write(cdate(1:4),'(i4.4)') iyr
        write(cdate(5:6),'(i2.2)') mm
        write(cdate(7:8),'(i2.2)') dd
        write(cdate(9:10),'(i2.2)') hh
END SUBROUTINE

subroutine CDATE2WNDAY(WDAY,cdate)
character(len=*) :: cdate
real              :: wday

integer :: iyyyy,imm,idd,ihh
read(cdate(1:4),'(i4.4)') iyyyy
read(cdate(5:6),'(i2.2)')   imm
read(cdate(7:8),'(i2.2)')   idd
if(len_trim(cdate)>8) then
read(cdate(9:10),'(i2.2)')   ihh
else
ihh=0
endif
call DATE2WNDAY(WDAY,iyyyy,imm,idd)
wday=wday+ihh/24.0
end subroutine

subroutine c2idate(cdate,iyyyy,imm,idd,ihh)
character(len=*) :: cdate
integer :: iyyyy,imm,idd,ihh

read(cdate(1:4),'(i4.4)') iyyyy
read(cdate(5:6),'(i2.2)')   imm
read(cdate(7:8),'(i2.2)')   idd
if(len_trim(cdate)>8) then
 read(cdate(9:10),'(i2.2)')   ihh
endif

end subroutine

subroutine cdate2gdmm(cdtg,cmm1,cmm2)
implicit none
character(len=*)                      :: cdtg
character(len=2)                      :: cmm1
character(len=2)                      :: cmm2


integer(i4)                :: iyyyy
integer(i4)                :: imm
integer(i4)                :: idd
integer(i4)                :: ihh

call c2idate(cdtg,iyyyy,imm,idd,ihh)

if(idd <= 15) then
  if((imm-1)<1) then
    write(cmm1,"(I2.2)") 12
  else
    write(cmm1,"(I2.2)") (imm-1)

  endif
    write(cmm2,"(I2.2)") (imm)
else
  write(cmm1,"(I2.2)") (imm)

  if((imm+1)>12) then
    write(cmm2,"(I2.2)") 1
  else
    write(cmm2,"(I2.2)") imm+1
  endif
endif

end subroutine

subroutine cdate2cyd(cdate,cyear,cday)
character(len=*) :: cdate
real(r4) :: year, day
integer(i4) :: iyyyy,imm,idd,ihh
character(len=4)                      :: cyear
character(len=3)                      :: cday
call c2idate(cdate,iyyyy,imm,idd,ihh)
call DATE2WNDAY(WDAY,iyyyy,imm,idd)
call WNDAY(WDAY, YEAR,DAY)

write(cyear,"(I4.4)") int(year)
write(cday,"(I3.3)") int(day)

end subroutine cdate2cyd

subroutine day_cmonth_year2wday(date,wday)
character(len=*) :: date
character(:),allocatable ::  cday,cmonth,cyear
real :: wday
integer :: i,imonth,iday,iyear,iyday,ihour
character(3) :: months(12)

months=["Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"]
ihour=0.0

cday=date(1:2)
cmonth=date(4:6)
cyear=date(8:12)

do i=1,12

if(months(i)==cmonth) then
        imonth=i
endif


enddo

read(cday,'(i2.2)') iday
read(cyear,'(i4.4)') iyear

call DATE2WNDAY(wday,iyear,imonth,iday)
end subroutine

subroutine cm2nm(cmon,nmon)

character(*)  :: cmon
character(10) :: nmon

  if(cmon(6:8)=="Jan") then
          nmon=cmon(1:4)//"01"//cmon(10:11)
  else if (cmon(6:8)=="Feb") then
          nmon=cmon(1:4)//"02"//cmon(10:11)
  else if (cmon(6:8)=="Mar") then
          nmon=cmon(1:4)//"03"//cmon(10:11)
  else if (cmon(6:8)=="Apr") then
          nmon=cmon(1:4)//"04"//cmon(10:11)
  else if (cmon(6:8)=="May") then
          nmon=cmon(1:4)//"05"//cmon(10:11)
  else if (cmon(6:8)=="Jun") then
          nmon=cmon(1:4)//"06"//cmon(10:11)
  else if (cmon(6:8)=="Jul") then
          nmon=cmon(1:4)//"07"//cmon(10:11)
  else if (cmon(6:8)=="Aug") then
          nmon=cmon(1:4)//"08"//cmon(10:11)
  else if (cmon(6:8)=="Sep") then
          nmon=cmon(1:4)//"09"//cmon(10:11)
  else if (cmon(6:8)=="Oct") then
          nmon=cmon(1:4)//"10"//cmon(10:11)
  else if (cmon(6:8)=="Nov") then
          nmon=cmon(1:4)//"11"//cmon(10:11)
  else if (cmon(6:8)=="Dec") then
          nmon=cmon(1:4)//"12"//cmon(10:11)
  endif
end subroutine

END MODULE mdates