mod_time.f90

Go to the documentation of this file.

!/===========================================================================/
! Copyright (c) 2007, The University of Massachusetts Dartmouth 
! Produced at the School of Marine Science & Technology 
! Marine Ecosystem Dynamics Modeling group
! All rights reserved.
!
! FVCOM has been developed by the joint UMASSD-WHOI research team. For 
! details of authorship and attribution of credit please see the FVCOM
! technical manual or contact the MEDM group.
!
! 
! This file is part of FVCOM. For details, see http://fvcom.smast.umassd.edu 
! The full copyright notice is contained in the file COPYRIGHT located in the 
! root directory of the FVCOM code. This original header must be maintained
! in all distributed versions.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
! AND ANY EXPRESS OR  IMPLIED WARRANTIES, INCLUDING,  BUT NOT  LIMITED TO,
! THE IMPLIED WARRANTIES OF MERCHANTABILITY AND  FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED.  
!
!/---------------------------------------------------------------------------/
! CVS VERSION INFORMATION
! $Id$
! $Name$
! $Revision$
!/===========================================================================/

MODULE mod_time
  USE mod_prec
  IMPLICIT NONE
   
  PUBLIC


! !PUBLIC DATA MEMBERS:
   INTEGER, PARAMETER :: itime = selected_int_kind(18)

   INTEGER :: mpi_time

!  ! INTEL 9.1.X does not like initialized types
!   TYPE :: TIME
!      INTEGER(itime)  :: MJD     !! MODIFIED JULIAN DAY
!      INTEGER(itime)  :: MuSOD   !! MicroSECOND OF DAY
!   END TYPE TIME

   ! USE THIS FOR INTEL 10.1+ 
   TYPE :: time
      INTEGER(itime)  :: mjd   = 0   !! MODIFIED JULIAN DAY
      INTEGER(itime)  :: musod = 0    !! MicroSECOND OF DAY
   END TYPE time

   INTERFACE abs
      MODULE PROCEDURE abs_time
   END INTERFACE


   INTERFACE mod
      MODULE PROCEDURE modulo_time
   END INTERFACE

   INTERFACE ASSIGNMENT(=)
      MODULE PROCEDURE assign_time
   END INTERFACE

   INTERFACE OPERATOR(*)
      MODULE PROCEDURE time_x_int
      MODULE PROCEDURE time_x_long
      MODULE PROCEDURE time_x_flt
      MODULE PROCEDURE time_x_dbl
      MODULE PROCEDURE int_x_time
      MODULE PROCEDURE long_x_time
      MODULE PROCEDURE flt_x_time
      MODULE PROCEDURE dbl_x_time
   END INTERFACE

   INTERFACE OPERATOR(/)
      MODULE PROCEDURE time_div_int
      MODULE PROCEDURE time_div_long
      MODULE PROCEDURE time_div_flt
      MODULE PROCEDURE time_div_dbl

   END INTERFACE

   INTERFACE OPERATOR(+)
      MODULE PROCEDURE add_time
      MODULE PROCEDURE add_time_1
      MODULE PROCEDURE add_time_1a
      MODULE PROCEDURE add_time_a1
      MODULE PROCEDURE add_time_2
      MODULE PROCEDURE add_time_2a
      MODULE PROCEDURE add_time_a2
!      MODULE PROCEDURE ADD_TIME_STEP     
   END INTERFACE

   INTERFACE OPERATOR(-)
      MODULE PROCEDURE subtract_time
      MODULE PROCEDURE subtract_time_1
      MODULE PROCEDURE subtract_time_1a
      MODULE PROCEDURE subtract_time_a1
      MODULE PROCEDURE subtract_time_2
      MODULE PROCEDURE subtract_time_2a
      MODULE PROCEDURE subtract_time_a2
!      MODULE PROCEDURE SUBTRACT_TIME_STEP
   END INTERFACE


   INTERFACE OPERATOR(<=)
      MODULE PROCEDURE le_time
   END INTERFACE

   INTERFACE OPERATOR(>=)
      MODULE PROCEDURE ge_time
   END INTERFACE

   INTERFACE OPERATOR(==)
      MODULE PROCEDURE eq_time
   END INTERFACE

   INTERFACE OPERATOR(/=)
      MODULE PROCEDURE ne_time
   END INTERFACE

   INTERFACE OPERATOR(>)
      MODULE PROCEDURE gt_time
   END INTERFACE

   INTERFACE OPERATOR(<)
      MODULE PROCEDURE lt_time
   END INTERFACE

   INTERFACE days2time
      MODULE PROCEDURE days2time_dbl
      MODULE PROCEDURE days2time_flt
      MODULE PROCEDURE days2time_int
      MODULE PROCEDURE days2time_lint
   END INTERFACE
   INTERFACE seconds2time
      MODULE PROCEDURE seconds2time_dbl
      MODULE PROCEDURE seconds2time_flt
      MODULE PROCEDURE seconds2time_int
      MODULE PROCEDURE seconds2time_lint
   END INTERFACE

   ! Seconds per day
   integer(itime), parameter :: spd         = 86400   
   integer(itime), parameter :: mspd        = spd * 1000
   integer(itime), parameter :: muspd       = mspd * 1000
   Integer(itime), parameter :: million     = 10**6
 CONTAINS
!======================================================
!======================================================
!======================================================   
   TYPE(time) function abs_time(a)
     IMPLICIT NONE
     TYPE(time), INTENT(IN) ::a

     CALL adjust(a)
     
     abs_time%mjd = abs(a%mjd)
     abs_time%musod = abs(a%musod)

   END FUNCTION abs_time
!======================================================
   TYPE(time) function modulo_time(a,b)
! COMMENTS: THIS PROGRAM IS ROBUST BUT SLOW.....
     IMPLICIT NONE
     TYPE(time), INTENT(IN) ::a,b
     real(dp)               :: dpa,dpb,div,cnt
     TYPE(time) ::t, zt

     zt%mjd=0
     zt%MuSOD=0

     dpa = days(a)
     dpb = days(b)
     div = dpa/dpb

     cnt = 1.0_dp

     IF(abs(div) .GT. 1e5_dp) cnt = log10(abs(div))

     IF( abs(div) .GT. 1e16_dp) THEN
        ! THE DIVISOR EXCEEDS THE NUMERICAL ACCURACY - RETURN A BAD RESULT!
        modulo_time%MJD = -huge(zt%mjd)
        modulo_time%MUSOD = -huge(zt%musod)
        RETURN
     END IF

     

     IF (b .EQ. zt) THEN
     ! SECOND ARGUMENT IS ZERO - ESCAPE
        modulo_time%MJD = huge(zt%mjd)
        modulo_time%MUSOD = huge(zt%musod)

     ELSE IF(abs(a) .LT. abs(b))THEN
     ! THE FIRST IS SMALLER THAN THE SECOND
        modulo_time = a

     ELSE IF(abs(a) .EQ. abs(b))THEN
    ! THE FIRST IS SMALLER THAN THE SECOND
        modulo_time = zt
        
     ELSE IF (a .GT. zt .and. b .GT. zt) THEN
        ! BOTH ARE POSITIVE

        t = b * int((div-cnt),itime)
        DO WHILE (a .GE. t+b)
           t = t +b
        END DO
        
        modulo_time = a - t
     ELSE IF(a .LT. zt .and. b .LT. zt) THEN
        ! BOTH ARE NEGATIVE

        t = b * int((div-cnt),itime)
        DO WHILE(a .LE. t+b)
           t = t +b
        END DO
        modulo_time = a - t
     ELSE IF (a .LT. zt .and. b .GT. zt) THEN
        ! A IS NEGATIVE AND B IS POSITIVE

        t = b *  int((div+cnt),itime)
        DO WHILE(a .LE. t-b)
           t = t -b
        END DO
        modulo_time = a - t

     ELSE IF (a .GT. zt .and. b .LT. zt) THEN
        ! A IS POSITIVE AND B IS NEGATIVE

        t = b *  int((div+cnt),itime)
        DO WHILE(a .GE. t-b)
           t = t-b
        END DO
        modulo_time = a - t
     ELSE

        ! THIS SHOULD NEVER HAPPEN!
        modulo_time%MJD = -huge(zt%mjd)
        modulo_time%MUSOD = -huge(zt%musod)

     END IF

   END FUNCTION modulo_time
!======================================================
   TYPE(time) function days2time_dbl(days)
     implicit none
     TYPE(time) :: mjd
     real(dp), INTENT(IN)    :: days
     real(dp)                :: temp

     mjd%mjd   = anint(days,itime)
     temp = days - anint(days,itime)
     mjd%MuSOD = anint(temp*real(muspd,dp),itime)
     CALL adjust(mjd)
     days2time_dbl = mjd
   END FUNCTION days2time_dbl
!======================================================
   TYPE(time) function days2time_int(days)
     implicit none
     TYPE(time) :: mjd
     INTEGER, INTENT(IN)    :: days

     mjd%mjd   = days
     mjd%MuSOD = 0
     days2time_int = mjd
   END FUNCTION days2time_int
!======================================================
   TYPE(time) function days2time_lint(days)
     implicit none
     TYPE(time) :: mjd
     INTEGER(ITIME), INTENT(IN)    :: days

     mjd%mjd   = days
     mjd%MuSOD = 0
     days2time_lint = mjd
   END FUNCTION days2time_lint
!======================================================
   TYPE(time) function days2time_flt(days)
     implicit none
     real(spa), INTENT(IN)    :: days
     real(dp)                :: temp
     temp = dble(days)
     days2time_flt = days2time_dbl(temp)
   END FUNCTION days2time_flt
!======================================================
   TYPE(time) function seconds2time_dbl(secs)
     implicit none
     TYPE(time) :: mjd
     real(dp), INTENT(IN)    :: secs
     real(dp)                :: temp

     mjd%mjd   = int(secs/dble(spd),itime)
     temp = mod(secs,dble(spd))
     mjd%MuSOD = anint(temp*real(million,dp),itime)
     CALL adjust(mjd)
     seconds2time_dbl = mjd
   END FUNCTION seconds2time_dbl
!======================================================
   TYPE(time) function seconds2time_int(secs)
     implicit none
     TYPE(time) :: mjd
     INTEGER, INTENT(IN)    :: secs

     mjd%mjd   = 0
     mjd%MuSOD = secs
     CALL adjust(mjd)
     seconds2time_int = mjd
   END FUNCTION seconds2time_int
!======================================================
   TYPE(time) function seconds2time_lint(secs)
     implicit none
     TYPE(time) :: mjd
     INTEGER(ITIME), INTENT(IN)    :: secs

     mjd%mjd   = 0
     mjd%MuSOD = secs
     CALL adjust(mjd)
     seconds2time_lint = mjd
   END FUNCTION seconds2time_lint
!======================================================
   TYPE(time) function seconds2time_flt(secs)
     implicit none
     real(spa), INTENT(IN)    :: secs
     
     seconds2time_flt = seconds2time_dbl(dble(secs))

   END FUNCTION seconds2time_flt
!======================================================
   FUNCTION time2ncitime(MJD,RJD,D,MS) RESULT(res)
     implicit none
     INTEGER :: res
     TYPE(time), INTENT(IN) :: mjd,rjd
     INTEGER, INTENT(OUT) :: d, ms
     REAL(dp) :: msec

     res = -1
     msec = dble(mjd%MuSod) / 1000.0_dp
     ms = anint(msec)

     ! CHECK TO MAKE SURE IT IS NOT TOO LARGE
     IF (abs(mjd%MJD) .GT. huge(d)) THEN
        res =0 
        return
     END IF
     
     d = mjd%MJD - rjd%MJD

   END FUNCTION time2ncitime
!======================================================
   FUNCTION ncitime(D,MS) RESULT(MJD)
     implicit none
     TYPE(time) :: mjd
     INTEGER, INTENT(IN) :: d, ms
     
     mjd%MJD = d

     mjd%MuSod= int(ms,itime)* int(1000,itime)

   END FUNCTION ncitime
!======================================================
   SUBROUTINE adjust(MJD)
     implicit none
     TYPE(time)     :: MJD
     integer(itime) :: musec
     integer(itime) :: idays
!     print*,"+++++++++++++begin adjust+++++++++++++++++"
!     write(*,*) "MJD in= ",MJD%MJD
!     write(*,*) "MUSOD in= ",MJD%MuSOD

     musec = mod(mjd%MuSOD, muspd)
!     print *,"musec= ", musec

     idays = (mjd%MuSOD - musec)/ muspd      
!     print *, "idays= ",idays
     mjd%mjd = mjd%mjd + idays
     mjd%MuSOD = musec 


!     call print_time(mjd,6,"intermediate")

     if (mjd%MuSOD .GT. 0 .AND. mjd%mjd .LT. 0) then
        mjd%mjd=mjd%mjd+1
        mjd%MuSOD=mjd%MuSOD-muspd
!        call print_time(mjd,6,"if... out")
        return
     else if (mjd%MuSOD .LT. 0 .AND.mjd%mjd .GT. 0  ) then
        mjd%MuSOD = muspd + mjd%MuSOD
        mjd%mjd = mjd%mjd -1
!        call print_time(mjd,6,"else if... out")
        return
     else
!        call print_time(mjd,6,"else... out")
        return
     end if
!     print*,"+++++++++++++END adjust+++++++++++++++++"
     
   END SUBROUTINE adjust
!======================================================
 TYPE(time) FUNCTION READ_TIME(timestr,status,TZONE)
   implicit none
   include 'fjulian.inc' 
   character(Len=*) :: timestr ! DO NOT USE INTENT ATTRIBUTE
   CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: tzone
   integer status
   logical statl
   real(dp) :: secs
   TYPE(time) :: dzone

   
   if(timestr(1:1)=="-") then
      statl = fjul_parsetime(timestr(2:),.false.,secs)
      secs = -secs
   else if(timestr(1:1)=="+") then
      statl = fjul_parsetime(timestr(2:),.false.,secs)
   else
      statl = fjul_parsetime(timestr,.false.,secs)
   end if
   read_time = seconds2time(secs)
   status = 0
   if(statl) status = 1

   IF (PRESENT(tzone)) THEN
      read_time = read_time - time_zone(tzone,status)
   END IF

 END FUNCTION read_time
!======================================================
 FUNCTION time_zone(TZONE,status) RESULT(DZONE)
   TYPE(time)                   :: dzone
   CHARACTER(LEN=*), INTENT(IN) :: tzone
   integer, intent(out)         :: status
   !! USE STANDARD NAMES FROM www.timeanddate.com
   !! Handle time zones!


   status = 1 
   SELECT CASE (tzone)
   CASE("UTC")
      dzone = seconds2time(0.0_dp)
   CASE("NONE")
      dzone = seconds2time(0.0_dp)
   CASE("none")
      dzone = seconds2time(0.0_dp)
   CASE("None")
      dzone = seconds2time(0.0_dp)
   CASE("A")
      dzone = read_time('01:00:00',status)
   CASE("ACDT")
      dzone = read_time('10:30:00',status)
   CASE("ACST")
      dzone = read_time('09:30:00',status)
   CASE("ADT")
      dzone = read_time('-03:00:00',status)
   CASE("AEDT")
      dzone = read_time('11:00:00',status)
   CASE("AEST")
      dzone = read_time('10:00:00',status)
   CASE("AKDT")
      dzone = read_time('-08:00:00',status)
   CASE("AKST")
      dzone = read_time('-09:00:00',status)
   CASE("AST")
      dzone = read_time('-04:00:00',status)
   CASE("AWDT")
      dzone = read_time('09:00:00',status)
   CASE("AWST")
      dzone = read_time('08:00:00',status)
   CASE("B")
      dzone = read_time('02:00:00',status)
   CASE("BST")
      dzone = read_time('01:00:00',status)
   CASE("CDT")
      dzone = read_time('-05:00:00',status)
   CASE("CEDT")
      dzone = read_time('02:00:00',status)
   CASE("CEST")
      dzone = read_time('02:00:00',status)
   CASE("CET")
      dzone = read_time('01:00:00',status)
      !! SKIPPING MULTIPLE ABREVIATIONS 'CST'
   CASE("CST")
      dzone = read_time('-06:00:00',status)
   CASE("CXT")
      dzone = read_time('07:00:00',status)
   CASE("D")
      dzone = read_time('04:00:00',status)
   CASE("E")
      dzone = read_time('05:00:00',status)
   CASE("EDT")
      dzone = read_time('-04:00:00',status)
   CASE("EEDT")
      dzone = read_time('03:00:00',status)
   CASE("EEST")
      dzone = read_time('03:00:00',status)
   CASE("EET")
      dzone = read_time('02:00:00',status)
      !! AGAIN, SKIPPING MULTIPLE 'EST' defs, sorry australia!
   CASE("EST")
      dzone = read_time('-05:00:00',status)
   CASE("F")
      dzone = read_time('06:00:00',status)
   CASE("G")
      dzone = read_time('07:00:00',status)
   CASE("GMT")
      dzone = seconds2time(0.0_dp)
   CASE("H")
      dzone = read_time('08:00:00',status)
   CASE("HAA")
      dzone = read_time('-03:00:00',status)
   CASE("HAC")
      dzone = read_time('-05:00:00',status)
   CASE("HADT")
      dzone = read_time('-09:00:00',status)
   CASE("HAE")
      dzone = read_time('-04:00:00',status)
   CASE("HAP")
      dzone = read_time('-07:00:00',status)
   CASE("HAR")
      dzone = read_time('-06:00:00',status)
   CASE("HAST")
      dzone = read_time('-10:00:00',status)
   CASE("HAT")
      dzone = read_time('-02:30:00',status)
   CASE("HAY")
      dzone = read_time('-08:00:00',status)
   CASE("HNA")
      dzone = read_time('-04:00:00',status)
   CASE("HNC")
      dzone = read_time('-06:00:00',status)
   CASE("HNE")
      dzone = read_time('-05:00:00',status)
   CASE("HNP")
      dzone = read_time('-08:00:00',status)
   CASE("HNR")
      dzone = read_time('-07:00:00',status)
   CASE("HNT")
      dzone = read_time('-3:30:00',status)
   CASE("HNY")
      dzone = read_time('-09:00:00',status)
   CASE("I")
      dzone = read_time('09:00:00',status)
   CASE("IST")
      dzone = read_time('01:00:00',status)
   CASE("K")
      dzone = read_time('10:00:00',status)
   CASE("L")
      dzone = read_time('11:00:00',status)
   CASE("M")
      dzone = read_time('12:00:00',status)
   CASE("MDT")
      dzone = read_time('-06:00:00',status)
   CASE("MESZ")
      dzone = read_time('02:00:00',status)
   CASE("MEZ")
      dzone = read_time('01:00:00',status)
   CASE("MST")
      dzone = read_time('-07:00:00',status)
   CASE("N")
      dzone = read_time('-01:00:00',status)
   CASE("NDT")
      dzone = read_time('-02:30:00',status)
   CASE("NFT")
      dzone = read_time('11:30:00',status)
   CASE("NST")
      dzone = read_time('-03:30:00',status)
   CASE("O")
      dzone = read_time('-02:00:00',status)
   CASE("P")
      dzone = read_time('-03:00:00',status)
   CASE("PDT")
      dzone = read_time('-07:00:00',status)
   CASE("PST")
      dzone = read_time('-08:00:00',status)
   CASE("Q")
      dzone = read_time('-04:00:00',status)
   CASE("R")
      dzone = read_time('-05:00:00',status)
   CASE("S")
      dzone = read_time('-06:00:00',status)
   CASE("T")
      dzone = read_time('-07:00:00',status)
   CASE("U")
      dzone = read_time('-08:00:00',status)
   CASE("V")
      dzone = read_time('-09:00:00',status)
   CASE("W")
      dzone = read_time('-10:00:00',status)
   CASE("WEDT")
      dzone = read_time('01:00:00',status)
   CASE("WEST")
      dzone = read_time('01:00:00',status)
   CASE("WET")
      dzone = read_time('00:00:00',status)
   CASE("WST")
      write(6,*)"TIMEZONE 'WST' IS AMBIGIOUS! USING WESTERN STANDARD TIME: UTC + 8:00"
      dzone = read_time('08:00:00',status)
   CASE("X")
      dzone = read_time('-11:00:00',status)
   CASE("Y")
      dzone = read_time('-12:00:00',status)
   CASE("Z")
      dzone = read_time('00:00:00',status)

   CASE DEFAULT
      dzone = read_time(tzone,status)
   END SELECT

   if(status==0) write(6,*) "Time_zone failed! :: "//trim(tzone)
   
 END FUNCTION time_zone
!======================================================
 LOGICAL FUNCTION is_valid_timezone(timezone)
   IMPLICIT NONE
   character(Len=*), intent(in):: timezone
   TYPE(time) :: test
   integer    :: status

   is_valid_timezone=.false.
   test = time_zone(timezone,status)
   if (status==1) is_valid_timezone=.true.

 END FUNCTION is_valid_timezone
!======================================================
 TYPE(time)  function read_datetime(timestr,frmt,tzone,status)
     ! RETURN VALUES FOR STATUS:
     !
     !  STATUS = -1 => SUCCESS
     !
     !  STATUS = 0  => FAILURE
     IMPLICIT NONE
     include 'fjulian.inc' 
     character(Len=*)                       :: timestr ! DO NOT USE INTENT ATTRIBUTE
     character(Len=*), intent(in)           :: frmt
     integer, intent(out)                   :: status
!     CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: TZONE
     CHARACTER(LEN=*), INTENT(IN) :: tzone

     TYPE(time) :: mjd
     TYPE(time) :: dzone
     integer    :: dutc, pos
     real(dp)   :: secs, tai,rmjd
     logical    :: statl
     
     statl = fjul_parsedt(timestr, frmt, dutc, secs)
     if (.NOT. statl) then
        ! KNOWN WEEKNESS OF PARSE: CAN'T USE '_' AS A DELIMITER
        pos = index(timestr,'_')
        IF(pos == 0 ) return
        ! IF YOU FOUND '_' replace it with a ' '
        timestr(pos:pos) = ' '
        statl = fjul_parsedt(timestr, frmt, dutc, secs)
        ! IF STILL UNSUCCESSFUL RETURN FAULT
        if(.not. statl) return
     end if
     status = 0 
     if(statl) status = 1
     mjd%MuSOD = anint(secs*million,itime)
     tai = fjul_taiofdutc(dutc)
     mjd%mjd = anint(fjul_mjdoftai(tai, fjul_utc_type),itime)

     read_datetime = mjd - time_zone(tzone,status)

     
   END FUNCTION read_datetime
!======================================================
   character(len=80)  FUNCTION write_datetime(mjdin,prec,TZONE) 
     IMPLICIT NONE
     include 'fjulian.inc' 
     ! PREC is the number of decimal seconds digits
     integer, intent(IN)                 :: prec
     TYPE(time), INTENT(IN)              :: mjdin
     CHARACTER(LEN=*), INTENT(IN) :: tzone

     TYPE(time)  :: mjd
     real(dp)    :: rmjd
     real(dp)    :: tai
     real(dp)    :: secs
     integer :: dutc, status
     real(dp)    :: tmp1,tmp2

     mjd = mjdin + time_zone(tzone,status)


     tmp1 = dble(mjd%MuSOD)
     tmp2 = dble(muspd)

     rmjd = mjd%mjd + tmp1/tmp2
     
     secs = tmp1 / dble(million)
     
     tai  = fjul_taiofmjd(rmjd, fjul_utc_type)
     
     dutc = fjul_dutcoftai(tai,secs)
 

     call fjul_formatpds(dutc, secs, prec, .true., write_datetime)
     
   END FUNCTION write_datetime
!======================================================
   TYPE(time) function get_now()
     IMPLICIT NONE
     include 'fjulian.inc' 
     CHARACTER(LEN=8)  d
     CHARACTER(LEN=10) t
     CHARACTER(LEN=5) z
     CHARACTER(LEN=15) toff
     CHARACTER(LEN=25) ts
     TYPE(time) :: tzone
     integer :: dutc
     real(dp) :: secs
     integer status

     CALL date_and_time ( date=d,time=t, zone=z)

     ! GET TIME ZONE
     toff = z(1:3)//":"//z(4:5)

     ! GET TIME
     ts = d(1:4)//"/"//d(5:6)//"/"//d(7:8)// &
          & " "//t(1:2)//":"//t(3:4)//":"//t(5:8)

     get_now = read_datetime(trim(ts),'ymd',toff,status)

   END FUNCTION get_now
!======================================================
   REAL(dp) function seconds(mjd)
     IMPLICIT NONE
     TYPE(time), INTENT(IN):: mjd

     seconds = dble(mjd%mjd * spd) + dble(mjd%MUSOD)/dble(million)
   END FUNCTION seconds
!======================================================
   REAL(dp) function days(mjd)
     IMPLICIT NONE
     TYPE(time), INTENT(IN):: mjd

     days = dble(mjd%mjd) + dble(mjd%MUSOD)/dble(muspd)
   END FUNCTION days
!======================================================
!--MODULE OPERATORS
!======================================================
   TYPE(time) function int_x_time(int,mjd)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     integer, INTENT(IN) :: int
     
     int_x_time%MuSOD=mjd%MuSOD * int
     int_x_time%mjd=mjd%mjd * int


     call adjust(int_x_time)
   END FUNCTION int_x_time
!======================================================
   TYPE(time) function long_x_time(long,mjd)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     integer(itime), INTENT(IN) :: long
     
     long_x_time%MuSOD=mjd%MuSOD * long
     long_x_time%mjd=mjd%mjd * long


     call adjust(long_x_time)
   END FUNCTION long_x_time
!======================================================
   TYPE(time) function time_x_int(mjd,int)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     integer, INTENT(IN) :: int
     
     time_x_int%MuSOD=mjd%MuSOD * int
     time_x_int%mjd=mjd%mjd * int


     call adjust(time_x_int)
   END FUNCTION time_x_int
!======================================================
   TYPE(time) function time_x_long(mjd,long)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     integer(itime), INTENT(IN) :: long
     
     time_x_long%MuSOD=mjd%MuSOD * long
     time_x_long%mjd=mjd%mjd * long

     call adjust(time_x_long)
   END FUNCTION time_x_long
!======================================================
   TYPE(time) function time_x_flt(mjd,flt)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     real(spa), INTENT(in) :: flt
     real(dp) :: dbl

     dbl = flt
     time_x_flt = mjd * dbl

   END FUNCTION time_x_flt
!======================================================
   TYPE(time) RECURSIVE function time_x_dbl(mjd,dbl)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     real(dp), INTENT(in) :: dbl
     integer(itime) :: int
     real(dp) :: remainder
     real(dp) :: temp

     if (abs(dbl) .gt. 1.0_dp) THEN
        int = anint(dbl,itime)
        remainder = dbl - int
        time_x_dbl = (mjd * int) + (mjd * remainder)
     else
        temp = real(mjd%MuSOD,dp) * real(dbl,dp)
        time_x_dbl%MuSOD= anint(temp,itime)

        temp = real(mjd%mjd,dp) * real(dbl,dp)
        int = anint(temp,itime)
        time_x_dbl%mjd=int
        time_x_dbl%MuSOD = time_x_dbl%MuSOD + (temp-int)*muspd 
     end if
     call adjust(time_x_dbl)

   END FUNCTION time_x_dbl
!======================================================
   TYPE(time) function flt_x_time(flt,mjd)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     real(spa), INTENT(in) :: flt
     real(dp) :: dbl

     dbl = dble(flt)
!   if(DBG_SET(dbg_log))  print*,'dbl=',dbl
     flt_x_time = mjd * dbl

   END FUNCTION flt_x_time
!======================================================
   TYPE(time) function dbl_x_time(dbl,mjd)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     real(dp), INTENT(in) :: dbl

     dbl_x_time = mjd * dbl

   END FUNCTION dbl_x_time
!======================================================
   TYPE(time) function time_div_int(mjd,int)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     integer, INTENT(IN) :: int
     real(dp) :: dbl

     dbl = dble(int)
     dbl = 1.0_dp / dbl
     time_div_int = mjd * dbl

   END FUNCTION time_div_int
!======================================================
   TYPE(time) function time_div_long(mjd,long)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     integer(itime), INTENT(IN) :: long
     real(dp) :: dbl

     dbl = dble(long)
     dbl = 1.0_dp / dbl
     time_div_long = mjd * dbl

   END FUNCTION time_div_long
!======================================================
   TYPE(time) function time_div_flt(mjd,flt)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     real(spa), INTENT(IN) :: flt
     real(dp) :: dbl

     dbl = dble(flt)
     dbl = 1.0_dp / dbl
     time_div_flt = mjd * dbl

   END FUNCTION time_div_flt
!======================================================
   TYPE(time) function time_div_dbl(mjd,dbl)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: mjd
     real(dp), INTENT(IN) :: dbl

     time_div_dbl = mjd * (1.0_dp / dbl)

   END FUNCTION time_div_dbl
!!$!======================================================
!!$   TYPE(TIME) FUNCTION SUBTRACT_TIME_STEP(time1,musec)
!!$     IMPLICIT NONE
!!$     TYPE(TIME), INTENT(IN)  :: time1
!!$     integer(itime), INTENT(IN) :: musec
!!$     
!!$     SUBTRACT_TIME_STEP = ADD_TIME_STEP(time1,-1*musec)
!!$
!!$   END FUNCTION SUBTRACT_TIME_STEP
!======================================================
   TYPE(time) function add_time(time1,time2)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2
     integer(itime) :: musec
     
     add_time%MuSOD = time1%MuSOD + time2%MuSOD
     add_time%mjd = time1%mjd + time2%mjd

     call adjust(add_time)
   END FUNCTION add_time
!======================================================
   FUNCTION add_time_1(time1,time2) RESULT(TSUM)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1(:), time2(:)
     TYPE(time), DIMENSION(SIZE(TIME1)) :: tsum
     INTEGER :: i

     DO i = 1,SIZE(time1)
        tsum(i) = time1(i) + time2(i)
     END DO
   END FUNCTION add_time_1
!======================================================
   FUNCTION add_time_1a(time1,time2) RESULT(TSUM)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1(:), time2
     TYPE(time), DIMENSION(SIZE(TIME1)) :: tsum
     INTEGER :: i

     DO i = 1,SIZE(time1)
        tsum(i) = time1(i) + time2
     END DO
   END FUNCTION add_time_1a
!======================================================
   FUNCTION add_time_a1(time1,time2) RESULT(TSUM)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2(:)
     TYPE(time), DIMENSION(SIZE(TIME2)) :: tsum
     INTEGER :: i

     DO i = 1,SIZE(time2)
        tsum(i) = time1 + time2(i)
     END DO
   END FUNCTION add_time_a1
!======================================================
   FUNCTION add_time_2(time1,time2) RESULT(TSUM)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1(:,:), time2(:,:)
     TYPE(time), DIMENSION(SIZE(TIME1,1),size(time1,2)) :: tsum
     INTEGER :: i,j

     DO i = 1,SIZE(time1,1)
        DO j = 1,SIZE(time1,2)
           tsum(i,j) = time1(i,j) + time2(i,j)
        END DO
     END DO
   END FUNCTION add_time_2
!======================================================
   FUNCTION add_time_2a(time1,time2) RESULT(TSUM)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1(:,:), time2
     TYPE(time), DIMENSION(SIZE(TIME1,1),size(time1,2)) :: tsum
     INTEGER :: i,j

     DO i = 1,SIZE(time1,1)
        DO j = 1,SIZE(time1,2)
           tsum(i,j) = time1(i,j) + time2
        END DO
     END DO
   END FUNCTION add_time_2a
!======================================================
   FUNCTION add_time_a2(time1,time2) RESULT(TSUM)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2(:,:)
     TYPE(time), DIMENSION(SIZE(TIME2,1),size(time2,2)) :: tsum
     INTEGER :: i,j

     DO i = 1,SIZE(time2,1)
        DO j = 1,SIZE(time2,2)
           tsum(i,j) = time1 + time2(i,j)
        END DO
     END DO
   END FUNCTION add_time_a2
!======================================================
   TYPE(time) function subtract_time(time1,time2)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2
     
     subtract_time%MuSOD = time1%MuSOD - time2%MuSOD
     subtract_time%mjd = time1%mjd - time2%mjd

     call adjust(subtract_time)
   END FUNCTION subtract_time
!======================================================
   FUNCTION subtract_time_1(time1,time2) RESULT(TDIFF)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1(:), time2(:)
     TYPE(time), DIMENSION(SIZE(TIME1)) :: tdiff
     INTEGER :: i

     DO i = 1,SIZE(time1)
        tdiff(i) = time1(i) - time2(i)
     END DO
   END FUNCTION subtract_time_1
!======================================================
   FUNCTION subtract_time_1a(time1,time2) RESULT(TDIFF)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2(:)
     TYPE(time), DIMENSION(SIZE(TIME2)) :: tdiff
     INTEGER :: i

     DO i = 1,SIZE(time2)
        tdiff(i) = time1 - time2(i)
     END DO
   END FUNCTION subtract_time_1a
!======================================================
   FUNCTION subtract_time_a1(time1,time2) RESULT(TDIFF)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1(:), time2
     TYPE(time), DIMENSION(SIZE(TIME1)) :: tdiff
     INTEGER :: i

     DO i = 1,SIZE(time1)
        tdiff(i) = time1(i) - time2
     END DO
   END FUNCTION subtract_time_a1
!======================================================
   FUNCTION subtract_time_2(time1,time2) RESULT(TDIFF)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1(:,:), time2(:,:)
     TYPE(time), DIMENSION(SIZE(TIME1,1),SIZE(TIME1,2)) :: tdiff
     INTEGER :: i,j

     DO i = 1,SIZE(time1,1)
        DO j = 1,SIZE(time1,2)
           tdiff(i,j) = time1(i,j) - time2(i,j)
        END DO
     END DO
   END FUNCTION subtract_time_2
!======================================================
   FUNCTION subtract_time_2a(time1,time2) RESULT(TDIFF)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1(:,:), time2
     TYPE(time), DIMENSION(SIZE(TIME1,1),SIZE(TIME1,2)) :: tdiff
     INTEGER :: i,j

     DO i = 1,SIZE(time1,1)
        DO j = 1,SIZE(time1,2)
           tdiff(i,j) = time1(i,j) - time2
        END DO
     END DO
   END FUNCTION subtract_time_2a
!======================================================
   FUNCTION subtract_time_a2(time1,time2) RESULT(TDIFF)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2(:,:)
     TYPE(time), DIMENSION(SIZE(TIME2,1),SIZE(TIME2,2)) :: tdiff
     INTEGER :: i,j

     DO i = 1,SIZE(time2,1)
        DO j = 1,SIZE(time2,2)
           tdiff(i,j) = time1 - time2(i,j)
        END DO
     END DO
   END FUNCTION subtract_time_a2



!!$!======================================================
!!$   TYPE(TIME) FUNCTION  ADD_TIME_STEP(mjd,tstp)
!!$     IMPLICIT NONE
!!$     !INPUT PARAMETERS:
!!$     TYPE(TIME), intent(in)              :: mjd
!!$     integer(itime), intent(in)             :: tstp
!!$     
!!$     ADD_TIME_STEP%MuSOD =  mjd%MuSOD + tstp
!!$     ADD_TIME_STEP%mjd = MJD%mjd
!!$
!!$     call adjust(ADD_TIME_STEP)
!!$   END FUNCTION ADD_TIME_STEP
!======================================================
   SUBROUTINE assign_time(A,B)
     IMPLICIT NONE
     TYPE(time), INTENT(OUT) ::A
     TYPE(time), INTENT(IN)  ::B

     a%MJD = b%MJD
     a%MUSOD = b%MUSOD

   END SUBROUTINE assign_time
!======================================================   
                       ! time1 <= time2
   LOGICAL FUNCTION le_time(time1,time2)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2
     TYPE(time) dtime     
     le_time = .false.
     dtime = time1 - time2
     if (dtime%MJD .lt. 0 .or. &
          & (dtime%MJD .EQ. 0 .and. dtime%MuSOD .LE. 0) ) le_time = .true.
   END FUNCTION le_time
!======================================================
                       ! time1 < time2
   LOGICAL FUNCTION lt_time(time1,time2)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2
     TYPE(time) dtime     
     lt_time = .false.
     dtime = time1 - time2
     if (dtime%MJD .lt. 0 .or. dtime%MuSOD .lt. 0) lt_time = .true.
   END FUNCTION lt_time
!======================================================
                       ! time1 == time2
   LOGICAL FUNCTION eq_time(time1,time2)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2
     eq_time = .false.
     if (time1%MJD .EQ. time2%MJD .and. &
          & time1%MuSOD .EQ. time2%MuSOD ) eq_time = .true.
   END FUNCTION eq_time
!======================================================
                       ! time1 /= time2
   LOGICAL FUNCTION ne_time(time1,time2)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2
     ne_time = .true.
     if (eq_time(time1,time2) ) ne_time = .false.
   END FUNCTION ne_time
!======================================================
                       ! time1 >= time2
   LOGICAL FUNCTION ge_time(time1,time2)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2
     TYPE(time) dtime     
     ge_time = .false.
     dtime = time1 - time2
     if (dtime%MJD .gt. 0 .or. &
          & (dtime%MJD .EQ. 0 .and. dtime%MuSOD .GE. 0) ) ge_time = .true.
   END FUNCTION ge_time
!======================================================
                       ! time1 > time2
   LOGICAL FUNCTION gt_time(time1,time2)
     IMPLICIT NONE
     TYPE(time), INTENT(IN)  :: time1, time2
     TYPE(time) dtime     
     gt_time = .false.
     dtime = time1 - time2
     if (dtime%MJD .gt. 0 .or. dtime%MuSOD .gt. 0 ) gt_time = .true.
   END FUNCTION gt_time
!======================================================

   SUBROUTINE print_time(mjd,IPT,char)
     implicit none
     CHARACTER(Len=*), INTENT(IN) :: char
     INTEGER, INTENT(IN)   :: IPT
     TYPE(time),INTENT(IN) :: mjd
     real(DP)              :: tmp, seconds
     integer :: hours, minutes
     Character(len=3) :: h, m
     Character(Len=10) :: s
     Character(len=8) :: d

     tmp = real(mjd%MuSOD,dp) / real(million,dp)
     
     hours = tmp/3600
     minutes = (tmp-hours*3600)/60
     seconds = mod(tmp,60.0_dp)

     write(d,'(i8.7)') mjd%mjd
     write(h,'(i3.2)') hours
     write(m,'(i3.2)') minutes
     write(s,'(F10.6)') seconds

     d = adjustl(d)
     h = adjustl(h)
     m = adjustl(m)
     s = adjustl(s)

     write(ipt,*)"!========"//trim(char)// "=========="
     write(ipt,*)"!    Day #    :", mjd%mjd
     write(ipt,*)"! MicroSecond #:", mjd%MuSOD
     write(ipt,*)"! (Human Time=d "//trim(d)//"::h"//trim(h)//":m"//trim(m)//":s"//trim(s)//")"
     write(ipt,*)"!=========================="
     
   END SUBROUTINE print_time

   SUBROUTINE print_real_time(mjd,IPT,char,TZONE)
     implicit none
     CHARACTER(Len=*), INTENT(IN) :: char
     INTEGER, INTENT(IN)   :: IPT
     TYPE(time),INTENT(IN) :: mjd
     CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: TZONE
     CHARACTER(LEN=120) :: string_local, string_utc


     IF(PRESENT(tzone)) THEN
        ! IF THIS IS AN IDEAL TIME OR CASE THEN USE PRINT_TIME
        IF(tzone=="none" .or. tzone == "NONE") THEN
           CALL print_time(mjd,ipt,char)
           RETURN
        END IF
        
        string_local =  write_datetime(mjd,6,tzone)
        string_local = "! (Local Time="//trim(string_local)//"); time zone: "//trim(tzone)
     END IF

     string_utc =  write_datetime(mjd,6,"UTC")

     write(ipt,*)"!========"//trim(char)// "=========="
     write(ipt,*)"!    Day #    :", mjd%mjd
     write(ipt,*)"! MicroSecond #:", mjd%MuSOD
     write(ipt,*)"! (Date Time="//trim(string_utc)//")"
     IF(PRESENT(tzone)) write(ipt,*) string_local
     write(ipt,*)"!=========================="
     
   END SUBROUTINE print_real_time
!-----------------------------------------------------------------------
!!  Get the the month and total days of present month
!======================================================
   SUBROUTINE now_2_month_days(TTime,Pyear,Pmonth,Pmdays)
     IMPLICIT NONE
     include 'fjulian.inc'
     TYPE(time), INTENT(IN)  ::TTime
     Integer,    INTENT(OUT) :: Pyear,Pmonth,Pmdays
     Integer :: Iyear,Imonth
!======================================================
     CHARACTER(LEN=8)  D
     CHARACTER(LEN=10) T
     CHARACTER(LEN=5) Z
     CHARACTER(LEN=15) toff
     CHARACTER(LEN=25) TS
     TYPE(time) :: tzone
     integer :: dutc
     real(DP) :: secs
     integer status
     TYPE(time)  ::Time1, Time2
     CHARACTER(LEN=120) :: string_local, string_utc
     CHARACTER(LEN=10) :: string_tt

     !CALL DATE_AND_TIME ( DATE=D,TIME=T, ZONE=Z)

       !string_utc =  WRITE_DATETIME(mjd,6,"UTC")
       string_local =  write_datetime(ttime,6,"UTC")

      string_tt=trim(string_local)
      d(1:4)=string_tt(1:4)
      d(5:6)=string_tt(6:7)
      d(7:8)=string_tt(9:10)

     ! GET TIME ZONE
     !toff = Z(1:3)//":"//Z(4:5)
     toff = '0:00' 

     !!  get the month from D(5:6)
     ! TS1
     read(d(1:4),'(I4)') iyear
     read(d(5:6),'(I2)') pmonth

     pyear = iyear

     d(7:8)='01'
     t(1:8)='00000000'

     ! First day of Present month
     ts = d(1:4)//"/"//d(5:6)//"/"//d(7:8)// &
          & " "//t(1:2)//":"//t(3:4)//":"//t(5:8)

     time1 = read_datetime(trim(ts),'ymd',toff,status)

     ! First day of next month
       imonth=pmonth+1
       if(imonth>12) then  !! to next year
          imonth=1
          iyear =iyear+1
       endif 
       write(d(1:4),'(I4.4)') iyear
       write(d(5:6),'(I2.2)') imonth
       
       
     ts = d(1:4)//"/"//d(5:6)//"/"//d(7:8)// &
          & " "//t(1:2)//":"//t(3:4)//":"//t(5:8)

     time2 = read_datetime(trim(ts),'ymd',toff,status)

     pmdays = time2%mjd -time1%mjd

   END SUBROUTINE now_2_month_days
!!

   SUBROUTINE now_2_days_test
     IMPLICIT NONE
     include 'fjulian.inc'
     Integer :: Iyear,Imonth
     Integer :: Pmonth,Pmdays
!======================================================
     CHARACTER(LEN=8)  D
     CHARACTER(LEN=10) T
     CHARACTER(LEN=5) Z
     CHARACTER(LEN=15) toff
     CHARACTER(LEN=25) TS
     TYPE(time) :: tzone
     integer :: dutc
     real(DP) :: secs
     integer status
     TYPE(time)  ::Time1, Time2
     CHARACTER(LEN=120) :: string_local, string_utc
     CHARACTER(LEN=10) :: string_tt

     !CALL DATE_AND_TIME ( DATE=D,TIME=T, ZONE=Z)

     d='1990-01-01'
     toff = '0:00'

     ! TS1
      iyear=01
      pmonth=01
     write(d(1:4),'(I4.4)') iyear
     write(d(5:6),'(I2.2)') pmonth

     d(7:8)='01'
     t(1:8)='00000000'

     ! First day of Present month
     ts = d(1:4)//"/"//d(5:6)//"/"//d(7:8)// &
          & " "//t(1:2)//":"//t(3:4)//":"//t(5:8)

     time1 = read_datetime(trim(ts),'ymd',toff,status)

     ! TS1
      iyear=01995
      pmonth=01
     write(d(1:4),'(I4.4)') iyear
     write(d(5:6),'(I2.2)') pmonth

     d(7:8)='01'
     t(1:8)='00000000'

     ! First day of Present month
     ts = d(1:4)//"/"//d(5:6)//"/"//d(7:8)// &
          & " "//t(1:2)//":"//t(3:4)//":"//t(5:8)

     time1 = read_datetime(trim(ts),'ymd',toff,status)


     end subroutine now_2_days_test
 
end module mod_time