LCOV - code coverage report
Current view: | top level - hemco/HEMCO/src/Shared/GeosUtil - hco_julday_mod.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 53 | 0.0 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 0 | 3 | 0.0 %

              Line data    Source code
           1             : !------------------------------------------------------------------------------
           2             : !                   Harmonized Emissions Component (HEMCO)                    !
           3             : !------------------------------------------------------------------------------
           4             : !BOP
           5             : !
           6             : ! !MODULE: julday_mod.F90
           7             : !
           8             : ! !DESCRIPTION: Module HCO\_JULDAY\_MOD contains routines used to convert from
           9             : !  month/day/year to Astronomical Julian Date and back again.
          10             : !\\
          11             : !\\
          12             : ! !INTERFACE:
          13             : !
          14             : MODULE HCO_JULDAY_MOD
          15             : !
          16             : ! !USES:
          17             : !
          18             :   USE HCO_PRECISION_MOD    ! For GEOS-Chem Precision (fp)
          19             :
          20             :   IMPLICIT NONE
          21             :   PRIVATE
          22             : !
          23             : ! !PUBLIC MEMBER FUNCTIONS:
          24             : !
          25             :   PUBLIC  :: JULDAY
          26             :   PUBLIC  :: CALDATE
          27             : !
          28             : ! !PRIVATE MEMBER FUNCTIONS:
          29             : !
          30             :   PRIVATE :: MINT
          31             : !
          32             : ! !REVISION HISTORY:
          33             : !  See https://github.com/geoschem/hemco for complete history
          34             : !EOP
          35             : !------------------------------------------------------------------------------
          36             : !BOC
          37             : CONTAINS
          38             : !EOC
          39             : !------------------------------------------------------------------------------
          40             : !                   Harmonized Emissions Component (HEMCO)                    !
          41             : !------------------------------------------------------------------------------
          42             : !BOP
          43             : !
          44             : ! !IROUTINE: JulDay
          45             : !
          46             : ! !DESCRIPTION: Function JULDAY returns the astronomical Julian day.
          47             : !\\
          48             : !\\
          49             : ! !INTERFACE:
          50             : !
          51           0 :   FUNCTION JULDAY( YYYY, MM, DD ) RESULT( JULIANDAY )
          52             : !
          53             : ! !INPUT PARAMETERS:
          54             : !
          55             :     INTEGER, INTENT(IN) :: YYYY        ! Year (must be in 4-digit format!)
          56             :     INTEGER, INTENT(IN) :: MM          ! Month (1-12)
          57             :     REAL*8,  INTENT(IN) :: DD          ! Day of month (may be fractional!)
          58             : !
          59             : ! !RETURN VALUE:
          60             : !
          61             :     REAL*8              :: JULIANDAY   ! Astronomical Julian Date
          62             : !
          63             : ! !REMARKS:
          64             : !  (1) Algorithm taken from "Practical Astronomy With Your Calculator",
          65             : !       Third Edition, by Peter Duffett-Smith, Cambridge UP, 1992.
          66             : !  (2) Requires the external function MINT.F.
          67             : !  (3) JulDay will compute the correct Julian day for any BC or AD date.
          68             : !  (4) For BC dates, subtract 1 from the year and append a minus sign.
          69             : !       For example, 1 BC is 0, 2 BC is -1, etc.  This is necessary for
          70             : !       the algorithm.
          71             : !
          72             : ! !REVISION HISTORY:
          73             : !  26 Nov 2001 - R. Yantosca - Initial version
          74             : !  See https://github.com/geoschem/hemco for complete history
          75             : !EOP
          76             : !------------------------------------------------------------------------------
          77             : !BOC
          78             : !
          79             : ! !LOCAL VARIABLES:
          80             : !
          81             :     INTEGER             :: YEAR1, MONTH1
          82             :     REAL*8              :: X1, A, B, C, D
          83             :     LOGICAL             :: ISGREGORIAN
          84             :
          85             :     !==================================================================
          86             :     ! JULDAY begins here!
          87             :     !
          88             :     ! Follow algorithm from Peter Duffett-Smith (1992)
          89             :     !==================================================================
          90             :
          91             :     ! Compute YEAR and MONTH1
          92           0 :     IF ( ( MM == 1 ) .OR. ( MM == 2 ) ) THEN
          93           0 :        YEAR1  = YYYY  - 1
          94           0 :        MONTH1 = MM    + 12
          95             :     ELSE
          96           0 :        YEAR1  = YYYY
          97           0 :        MONTH1 = MM
          98             :     ENDIF
          99             :
         100             :     ! Compute the "A" term.
         101           0 :     X1 = DBLE( YEAR1 ) / 100.0d0
         102           0 :     A  = MINT( X1 )
         103             :
         104             :     ! The Gregorian calendar begins on 10 October 1582
         105             :     ! Any dates prior to this will be in the Julian calendar
         106           0 :     IF ( YYYY > 1582 ) THEN
         107             :        ISGREGORIAN = .TRUE.
         108             :     ELSE
         109             :        IF ( ( YYYY   == 1582 )  .AND. &
         110           0 :             ( MONTH1 >= 10   )  .AND. &
         111             :             ( DD     >= 15.0 ) ) THEN
         112             :           ISGREGORIAN = .TRUE.
         113             :        ELSE
         114             :           ISGREGORIAN = .FALSE.
         115             :        ENDIF
         116             :     ENDIF
         117             :
         118             :     ! Compute the "B" term according to Gregorian or Julian calendar
         119             :     IF ( ISGREGORIAN ) THEN
         120           0 :        B = 2.0d0 - A + MINT( A / 4.0d0 )
         121             :     ELSE
         122             :        B = 0.0d0
         123             :     ENDIF
         124             :
         125             :     ! Compute the "C" term for BC dates (YEAR1 <= 0 )
         126             :     ! or AD dates (YEAR1 > 0)
         127           0 :     IF ( YEAR1 < 0 ) THEN
         128           0 :        X1 = ( 365.25d0 * YEAR1 ) - 0.75d0
         129           0 :        C  = MINT( X1 )
         130             :     ELSE
         131           0 :        X1 = 365.25d0 * YEAR1
         132           0 :        C  = MINT( X1 )
         133             :     ENDIF
         134             :
         135             :     ! Compute the "D" term
         136           0 :     X1 = 30.6001d0 * DBLE( MONTH1 + 1 )
         137           0 :     D  = MINT( X1 )
         138             :
         139             :     ! Add the terms to get the Julian Day number
         140           0 :     JULIANDAY = B + C + D + DD + 1720994.5d0
         141             :
         142           0 :   END FUNCTION JULDAY
         143             : !EOC
         144             : !------------------------------------------------------------------------------
         145             : !                   Harmonized Emissions Component (HEMCO)                    !
         146             : !------------------------------------------------------------------------------
         147             : !BOP
         148             : !
         149             : ! !IROUTINE: Mint
         150             : !
         151             : ! !DESCRIPTION: Function MINT is the modified integer function.
         152             : !\\
         153             : !\\
         154             : ! !INTERFACE:
         155             : !
         156           0 :   FUNCTION MINT( X ) RESULT ( VALUE )
         157             : !
         158             : ! !INPUT PARAMETERS:
         159             : !
         160             :     REAL*8, INTENT(IN) :: X
         161             : !
         162             : ! !RETURN VALUE:
         163             : !
         164             :     REAL*8             :: VALUE
         165             : !
         166             : ! !REMARKS:
         167             : !  The modified integer function is defined as follows:
         168             : !
         169             : !            { -INT( ABS( X ) )   for X < 0
         170             : !     MINT = {
         171             : !            {  INT( ABS( X ) )   for X >= 0
         172             : !
         173             : ! !REVISION HISTORY:
         174             : !  20 Nov 2001 - R. Yantosca - Initial version
         175             : !  See https://github.com/geoschem/hemco for complete history
         176             : !EOP
         177             : !------------------------------------------------------------------------------
         178             : !BOC
         179           0 :     IF ( X < 0d0 ) THEN
         180           0 :        VALUE = -INT( ABS( X ) )
         181             :     ELSE
         182           0 :        VALUE =  INT( ABS( X ) )
         183             :     ENDIF
         184             :
         185           0 :   END FUNCTION MINT
         186             : !EOC
         187             : !------------------------------------------------------------------------------
         188             : !                   Harmonized Emissions Component (HEMCO)                    !
         189             : !------------------------------------------------------------------------------
         190             : !BOP
         191             : !
         192             : ! !IROUTINE: CalDate
         193             : !
         194             : ! !DESCRIPTION: Subroutine CALDATE converts an astronomical Julian day to
         195             : !  the YYYYMMDD and HHMMSS format.
         196             : !\\
         197             : !\\
         198             : ! !INTERFACE:
         199             : !
         200           0 :   SUBROUTINE CALDATE( JULIANDAY, YYYYMMDD, HHMMSS )
         201             : !
         202             : ! !INPUT PARAMETERS:
         203             : !
         204             :     REAL*8,  INTENT(IN)  :: JULIANDAY  ! Astronomical Julian Date
         205             : !
         206             : ! !OUTPUT PARAMETERS:
         207             : !
         208             :     INTEGER, INTENT(OUT) :: YYYYMMDD   ! Date in YYYY/MM/DD format
         209             :     INTEGER, INTENT(OUT) :: HHMMSS     ! Time in hh:mm:ss format
         210             : !
         211             : ! !REMARKS:
         212             : !   Algorithm taken from "Practical Astronomy With Your Calculator",
         213             : !   Third Edition, by Peter Duffett-Smith, Cambridge UP, 1992.
         214             : !
         215             : ! !REVISION HISTORY:
         216             : !  See https://github.com/geoschem/hemco for complete history
         217             : !EOP
         218             : !------------------------------------------------------------------------------
         219             : !BOC
         220             : !
         221             : ! !LOCAL VARIABLES:
         222             : !
         223             :     REAL*4               :: HH, MM, SS
         224             :     REAL*8               :: A, B, C, D, DAY, E, F
         225             :     REAL*8               :: FDAY, G, I, J, JD, M, Y
         226             :
         227             :     !=================================================================
         228             :     ! CALDATE begins here!
         229             :     ! See "Practical astronomy with your calculator", Peter Duffett-
         230             :     ! Smith 1992, for an explanation of the following algorithm.
         231             :     !=================================================================
         232           0 :     JD = JULIANDAY + 0.5d0
         233           0 :     I  = INT( JD )
         234           0 :     F  = JD - INT( I )
         235             :
         236           0 :     IF ( I > 2299160d0 ) THEN
         237           0 :        A = INT( ( I - 1867216.25d0 ) / 36524.25d0 )
         238           0 :        B = I + 1 + A - INT( A / 4 )
         239             :     ELSE
         240             :        B = I
         241             :     ENDIF
         242             :
         243           0 :     C = B + 1524d0
         244             :
         245           0 :     D = INT( ( C - 122.1d0 ) / 365.25d0 )
         246             :
         247           0 :     E = INT( 365.25d0 * D )
         248             :
         249           0 :     G = INT( ( C - E ) / 30.6001d0 )
         250             :
         251             :     ! DAY is the day number
         252           0 :     DAY  = C - E + F - INT( 30.6001d0 * G )
         253             :
         254             :     ! FDAY is the fractional day number
         255           0 :     FDAY = DAY - INT( DAY )
         256             :
         257             :     ! M is the month number
         258           0 :     IF ( G < 13.5d0 ) THEN
         259           0 :        M = G - 1d0
         260             :     ELSE
         261           0 :        M = G - 13d0
         262             :     ENDIF
         263             :
         264             :     ! Y is the year number
         265           0 :     IF ( M > 2.5d0 ) THEN
         266           0 :        Y = D - 4716d0
         267             :     ELSE
         268           0 :        Y = D - 4715d0
         269             :     ENDIF
         270             :
         271             :     ! Year-month-day value
         272           0 :     YYYYMMDD = ( INT( Y ) * 10000 ) + ( INT( M ) * 100 ) + INT( DAY )
         273             :
         274             :     ! Hour-minute-second value
         275             :     ! NOTE: HH, MM, SS are REAL*4 to avoid numerical roundoff errors
         276           0 :     HH     = FDAY * 24d0
         277           0 :     MM     = ( HH - INT( HH ) ) * 60d0
         278           0 :     SS     = ( MM - INT( MM ) ) * 60d0
         279             :     !------------------------------------------------------------------
         280             :     ! NOTE: Some times (like 40min = 0.6666 hrs) will cause a roundoff
         281             :     ! error that will make the minutes eg. 39.9999 instead of 40.
         282             :     ! For now put in a kludge to rectify this situation.
         283           0 :     IF ( INT(SS) == 59 ) THEN
         284           0 :        SS = 0.0e0
         285           0 :        MM = NINT( MM )
         286             :     ENDIF
         287             :     !---------------------------------------------------------------
         288           0 :     HHMMSS = ( INT( HH ) * 10000 ) + ( INT( MM ) * 100 ) + INT( SS )
         289             :
         290           0 :   END SUBROUTINE CALDATE
         291             : !EOC
         292             : END MODULE HCO_JULDAY_MOD

Generated by: LCOV version 1.14