LCOV - code coverage report
Current view: | top level - physics/clubb/src/CLUBB_core - calendar.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 35 | 0.0 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 0 | 5 | 0.0 %

              Line data    Source code
           1             : !-----------------------------------------------------------------------
           2             : !$Id$
           3             : !===============================================================================
           4             : module calendar
           5             :
           6             :   implicit none
           7             :
           8             :   public :: gregorian2julian_date, julian2gregorian_date,  &
           9             :             leap_year, compute_current_date, &
          10             :             gregorian2julian_day
          11             :
          12             :   private ! Default Scope
          13             :
          14             :   ! Constant Parameters
          15             :
          16             :   ! 3 Letter Month Abbreviations
          17             :   character(len=3), dimension(12), public, parameter :: &
          18             :     month_names = (/'JAN','FEB','MAR','APR','MAY','JUN', &
          19             :                     'JUL','AUG','SEP','OCT','NOV','DEC'/)
          20             :
          21             :   ! Number of days per month (Jan..Dec) for a non leap year
          22             :   integer, public, dimension(12), parameter :: &
          23             :     days_per_month = (/31, 28, 31, 30, 31, 30, &
          24             :                        31, 31, 30, 31, 30, 31/)
          25             :
          26             :   contains
          27             : !-----------------------------------------------------------------------
          28           0 :   integer function gregorian2julian_date( day, month, year )
          29             : !
          30             : ! Description:
          31             : !   Computes the Julian Date (gregorian2julian), or the number of days since
          32             : !   1 January 4713 BC, given a Gregorian Calender date (day, month, year).
          33             : !
          34             : ! Reference:
          35             : !   Fliegel, H. F. and van Flandern, T. C.,
          36             : !   Communications of the ACM, Vol. 11, No. 10 (October, 1968)
          37             : !----------------------------------------------------------------------
          38             :
          39             :     implicit none
          40             :
          41             :     ! Input Variables
          42             :     integer, intent(in) ::  &
          43             :       day,        & ! Gregorian Calendar Day for given Month        [dd]
          44             :       month,      & ! Gregorian Calendar Month for given Year       [mm]
          45             :       year          ! Gregorian Calendar Year                       [yyyy]
          46             :
          47             :     ! Local Variables
          48             :     integer :: I,J,K
          49             :
          50           0 :     I = year
          51           0 :     J = month
          52           0 :     K = day
          53             :
          54             :     gregorian2julian_date = K-32075+1461*(I+4800+(J-14)/12)/4+367* &
          55           0 :            (J-2-(J-14)/12*12)/12-3*((I+4900+(J-14)/12)/100)/4
          56             :
          57             :     return
          58             :   end function gregorian2julian_date
          59             :
          60             : !------------------------------------------------------------------
          61           0 :   subroutine julian2gregorian_date &
          62             :                ( julian_date, &
          63             :                  day, month, year )
          64             : !
          65             : ! Description:
          66             : !   Computes the Gregorina Calendar date (day, month, year)
          67             : !   given the Julian date (julian_date).
          68             : !
          69             : ! Reference:
          70             : !   Fliegel, H. F. and van Flandern, T. C.,
          71             : !   Communications of the ACM, Vol. 11, No. 10 (October, 1968)
          72             : !   http://portal.acm.org/citation.cfm?id=364097
          73             : !------------------------------------------------------------------
          74             :     implicit none
          75             :
          76             :     ! Input Variable(s)
          77             :     integer, intent(in) :: julian_date ! Julian date being converted from
          78             :
          79             :     ! Output Variable(s)
          80             :     integer, intent(out)::  &
          81             :       day,     & ! Gregorian calender day for given Month       [dd]
          82             :       month,   & ! Gregorian calender month for given Year      [mm]
          83             :       year       ! Gregorian calender year                      [yyyy]
          84             :
          85             :     ! Local Variables
          86             :     integer :: i, j, k, n, l
          87             :
          88             :     ! ---- Begin Code ----
          89             :
          90           0 :     L = julian_date+68569 ! Known magic number
          91           0 :     N = 4*L/146097 ! Known magic number
          92           0 :     L = L-(146097*N+3)/4 ! Known magic number
          93           0 :     I = 4000*(L+1)/1461001 ! Known magic number
          94           0 :     L = L-1461*I/4+31 ! Known magic number
          95           0 :     J = 80*L/2447 ! Known magic number
          96           0 :     K = L-2447*J/80 ! Known magic number
          97           0 :     L = J/11 ! Known magic number
          98           0 :     J = J+2-12*L ! Known magic number
          99           0 :     I = 100*(N-49)+I+L ! Known magic number
         100             :
         101           0 :     year = I
         102           0 :     month = J
         103           0 :     day = K
         104             :
         105           0 :     return
         106             :
         107             :   end subroutine julian2gregorian_date
         108             :
         109             : !-----------------------------------------------------------------------------
         110           0 :   logical function leap_year( year )
         111             : !
         112             : ! Description:
         113             : !   Determines if the given year is a leap year.
         114             : !
         115             : ! References:
         116             : !   None
         117             : !-----------------------------------------------------------------------------
         118             :     implicit none
         119             :
         120             :     ! External
         121             :     intrinsic :: mod
         122             :
         123             :     ! Input Variable(s)
         124             :     integer, intent(in) :: year ! Gregorian Calendar Year [yyyy]
         125             :
         126             :     ! ---- Begin Code ----
         127             :
         128             :     leap_year = ( (mod( year, 4 ) == 0) .and. &
         129           0 :          (.not.(  mod( year, 100 ) == 0 .and. mod( year, 400 ) /= 0 ) ) )
         130             :
         131             :     return
         132             :   end function leap_year
         133             :
         134             : !----------------------------------------------------------------------------
         135           0 :   subroutine compute_current_date( previous_day, previous_month, &
         136             :                                    previous_year,  &
         137             :                                    seconds_since_previous_date, &
         138             :                                    current_day, current_month, &
         139             :                                    current_year, &
         140             :                                    seconds_since_current_date )
         141             : !
         142             : ! Description:
         143             : !   Computes the current Gregorian date from a previous date and
         144             : !   the seconds that have transpired since that date.
         145             : !
         146             : ! References:
         147             : !   None
         148             : !----------------------------------------------------------------------------
         149             :     use clubb_precision, only: &
         150             :         time_precision  ! Variable(s)
         151             :
         152             :     use constants_clubb, only: &
         153             :         sec_per_day     ! Variable(s)
         154             :
         155             :     implicit none
         156             :
         157             :     ! Input Variable(s)
         158             :
         159             :     ! Previous date
         160             :     integer, intent(in) :: &
         161             :       previous_day,    & ! Day of the month      [dd]
         162             :       previous_month,  & ! Month of the year     [mm]
         163             :       previous_year      ! Year                  [yyyy]
         164             :
         165             :     real(kind=time_precision), intent(in) :: &
         166             :       seconds_since_previous_date ! [s]
         167             :
         168             :     ! Output Variable(s)
         169             :
         170             :     ! Current date
         171             :     integer, intent(out) :: &
         172             :       current_day,     & ! Day of the month      [dd]
         173             :       current_month,   & ! Month of the year     [mm]
         174             :       current_year       ! Year                  [yyyy]
         175             :
         176             :     real(kind=time_precision), intent(out) :: &
         177             :       seconds_since_current_date
         178             :
         179             :     integer :: &
         180             :       days_since_1jan4713bc, &
         181             :       days_since_start
         182             :
         183             :     ! ---- Begin Code ----
         184             :
         185             :     ! Using Julian dates we are able to add the days that the model
         186             :     ! has been running
         187             :
         188             :     ! Determine the Julian Date of the starting date,
         189             :     !    written in Gregorian (day, month, year) form
         190             :     days_since_1jan4713bc = gregorian2julian_date( previous_day,  &
         191           0 :                                      previous_month, previous_year )
         192             :
         193             :     ! Determine the amount of days that have passed since start date
         194             :     days_since_start =  &
         195           0 :           floor( seconds_since_previous_date / real(sec_per_day,kind=time_precision) )
         196             :
         197             :     ! Set days_since_1jan4713 to the present Julian date
         198           0 :     days_since_1jan4713bc = days_since_1jan4713bc + days_since_start
         199             :
         200             :     ! Set Present time to be seconds since the Julian date
         201             :     seconds_since_current_date = seconds_since_previous_date &
         202           0 :       - ( real( days_since_start, kind=time_precision ) * real(sec_per_day,kind=time_precision) )
         203             :
         204             :     call julian2gregorian_date &
         205             :            ( days_since_1jan4713bc, & ! intent(in)
         206           0 :              current_day, current_month, current_year ) ! intent(out)
         207             :
         208           0 :     return
         209             :   end subroutine compute_current_date
         210             :
         211             : !-------------------------------------------------------------------------------------
         212           0 :   integer function gregorian2julian_day( day, month, year )
         213             : !
         214             : ! Description:
         215             : !   This subroutine determines the Julian day (1-366)
         216             : !   for a given Gregorian calendar date(e.g. July 1, 2008).
         217             : !
         218             : ! References:
         219             : !   None
         220             : !-------------------------------------------------------------------------------------
         221             :
         222             :     implicit none
         223             :
         224             :     ! External
         225             :     intrinsic :: sum
         226             :
         227             :     ! Input Variable(s)
         228             :     integer, intent(in) :: &
         229             :      day,             & ! Day of the Month      [dd]
         230             :      month,           & ! Month of the Year     [mm]
         231             :      year               ! Year                  [yyyy]
         232             :
         233             :     ! ---- Begin Code ----
         234             :
         235             :     ! Add the days from the previous months
         236           0 :     gregorian2julian_day = day + sum( days_per_month(1:month-1) )
         237             :
         238             :     ! Kluge for a leap year
         239             :     ! If the date were 29 Feb 2000 this would not increment julian_day
         240             :     ! However 01 March 2000 would need the 1 day bump
         241           0 :     if ( leap_year( year ) .and. month > 2 ) then
         242           0 :       gregorian2julian_day = gregorian2julian_day + 1
         243             :     end if
         244             :
         245           0 :     if ( ( leap_year( year ) .and. gregorian2julian_day > 366 ) .or. &
         246             :          ( .not. leap_year( year ) .and. gregorian2julian_day > 365 ) ) then
         247           0 :       error stop "Problem with Julian day conversion in gregorian2julian_day."
         248             :     end if
         249             :
         250             :     return
         251             :   end function gregorian2julian_day
         252             :
         253             : end module calendar

Generated by: LCOV version 1.14