!
!  Julian date conversion module
!
!  Copyright © 1996 - 2012 F.Hroch (hroch@physics.muni.cz)
!
!  This file is part of Munipack.
!
!  Munipack is free software: you can redistribute it and/or modify
!  it under the terms of the GNU General Public License as published by
!  the Free Software Foundation, either version 3 of the License, or
!  (at your option) any later version.
!
!  Munipack is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!  GNU General Public License for more details.
!
!  You should have received a copy of the GNU General Public License
!  along with Munipack.  If not, see <http://www.gnu.org/licenses/>.

!
! 1996-12-23 F.Hroch
! 1996 to f90
! 2000 some change according to Numerical Recipes
!
! --------------------------------------------------------------------

module trajd

  integer, parameter, private :: dbl = selected_real_kind(15)

contains

  !----------------------------------------------------------------------

  function datjd (year,month,day)

    ! Compute Julian date from input citizen year, month and day.
    ! Tested for all year

    real(dbl), parameter :: break = 15 + 31*(10 + 12*1582)

    real(dbl), intent(in) :: year,month,day
    real(dbl) ::  datjd,y,m,d,a

    if( abs(year) < epsilon(year) ) stop "datjd: There is no Year Zero."

    y = year
    if( y < 0.0_dbl ) y = y + 1.0_dbl

    if( month > 2.0_dbl )then
       m = month + 1.0_dbl
       d = day
    else
       y = y - 1.0_dbl
       m = month + 13.0_dbl
       d = day
    endif
    datjd = int(365.25_dbl*y) + int(30.6001_dbl*m) + d + 1720994.5_dbl
    if( d + 31.0_dbl*(m + 12.0_dbl*y) >= break )then
       a = int(y/100.0_dbl)
       datjd = datjd + 2.0_dbl - a + int(a/4.0_dbl)
    endif

  end function datjd

  !----------------------------------------------------------------------

  function yearjd (year)

    ! Compute Julian date from input year with fraction

    real(dbl), parameter :: break = 15 + 31*(10 + 12*1582)

    real(dbl), intent(in) :: year
    real(dbl) ::  yearjd,month,day,y

    y = year - aint(year)
    month = aint(12.0_dbl*y)
    day = 365.25_dbl*(y - month/12.0_dbl) + 1.0_dbl
    month = month + 1.0

    yearjd = datjd(aint(year),month,day)

  end function yearjd


  !----------------------------------------------------------------------

  function mjd (jd)

    real(dbl), intent(in) ::  jd
    real(dbl) :: mjd

    mjd = jd - 2400000.5_dbl

  end function mjd

  !----------------------------------------------------------------------

  function hjd (jd,helcor)

    real(dbl), intent(in) ::  jd,helcor
    real(dbl) :: hjd

    hjd = jd + helcor

  end function hjd

  !----------------------------------------------------------------------

  subroutine jdat(jd,year,month,day)

    ! compute citizen date: year, month and day from input julian date.
    ! only for jd>0! tested for all year except 1582-10-07..15.
    !
    ! WARNING! possibly work incorrectly for a negative year

    real(dbl), parameter :: break = 2299163.0_dbl

    real(dbl), intent( in ) ::  jd
    real(dbl), intent( out ) ::  year,month,day
    real(dbl) :: alpha,a,b,c,d,e

    if( jd >= break ) then
       alpha = int( ((jd - 1867216.0_dbl) - 0.25_dbl) / 36524.25_dbl)
       a = jd + 1.0_dbl + alpha - int( alpha / 4.0_dbl )
    else
       a = jd
    endif
    b = a + 1524.0_dbl
    c = int(6680.0_dbl+((b - 2439870.0_dbl) - 122.1_dbl)/365.25_dbl)
    d = 365.0_dbl*c + int(c/4.0_dbl)
    e = int((b - d)/30.6001_dbl)

    day = b - d - int(30.6001_dbl*e)
    month = e - 1.0_dbl
    if( month > 12.0_dbl ) month = month - 12.0_dbl
    year = c - 4715.0_dbl
    if( month > 2.0_dbl ) year = year - 1.0_dbl
    if( year <= 0.0_dbl ) year = year - 1.0_dbl
    if( year < 0.0_dbl )then
       day = day - 0.5_dbl
    else
       day = day + 0.5_dbl
    endif

  end subroutine jdat


  subroutine jdatetime(jd,year,month,day,hour,min,sec,ms)

    real(dbl), intent(in) ::  jd
    integer, intent(out) ::  year,month,day,hour,min,sec
    real(dbl), intent(out) ::  ms

    real(dbl) ::  y,m,d

    call jdat(jd,y,m,d)
    year = nint(y)
    month = nint(m)
    day = int(d)
    hour = int(24*(d - day))
    min = int(1440*(d - (day + hour / 24.0_dbl)))
    sec = int(86400*(d - (day + (hour + min/60.0_dbl)/24.0_dbl)))
    ms = nint(1000*86400*(d - (day + (hour + (min + sec/60.0_dbl)/60.0_dbl)/24.0_dbl)))
    if( ms > 999 ) then
       sec = sec + 1
       ms = ms - 1000
    end if
    if( sec > 59 ) then
       min = min + 1
       sec = sec - 60
    end if
    if( min > 59 ) then
       hour = hour + 1
       min = min - 60
    end if
    if( hour > 23 ) then
       day = day + 1
       hour = hour - 24
    end if

  end subroutine jdatetime



  ! computes the epoch

  function epoch(y,m,d)

    real(dbl), intent(in) :: y,m,d
    real(dbl) :: jd0,jd,x,epoch

    jd0 = datjd(y,1.0_dbl,1.0_dbl)
    jd  = datjd(y,m,d)

    x = (jd - jd0)/365.25_dbl
    epoch = y + x

  end function epoch

end module trajd
