TNO Intern

Commit eb8476fc authored by Arjo Segers's avatar Arjo Segers
Browse files

Added `CompressTime` routine.

parent a2f39ed4

oper/src/cso_datetime.F90

+92 −18
Original line number Diff line number Diff line
@@ -232,7 +232,7 @@ 
!     %M    : 2 digit minute

!     %S    : 2 digit second

!

!     t = TDate( year=2021, month=9, day=6, hour=0, min=0 )

!     t = T_CSO_DateTime( year=2021, month=9, day=6, hour=0, min=0 )

!     line = 'file_%Y%m%d_%H%M.txt'

!     call CSO_Format( line, t, status )

!
@@ -245,20 +245,27 @@ 
!     call CSO_DateTimeDefaults( [calendar='gregorian'] )

!

!

! HISTORY

!##############################################################################

!

! CHANGES

!

! 2022-09, Arjo Segers

!   Initialize some variables to avoid compiler warnings.

!

! 2023-09, Arjo Segers

!   Changed "mili" to the more correct "milli".

!   Changed `mili` to the more correct `milli`.

!

! 2023-10-31, Jacob van Peet

!   Added date_Get to public module members to get compilation with nvfortran working.

!

! 2022-09, Arjo Segers

!   Added `CSO_Format` routine.

!

! 2025-02, Arjo Segers

!   Support labels 'hours', 'minutes', 'seconds', etc.

!   Support labels `hours`, `minutes`, `seconds`, etc.

!

! 2026-07, Arjo Segers

!   Added `CompressTime` routine.

!

!### macro's ##################################################################

!
@@ -294,6 +301,10 @@ module CSO_DateTimes 
  public      ::  Check

  public      ::  Normalize



  ! JvP 20231031: Added date_Get (which is already a member of "Get" interface)

  !  to get compilation with nvfortran working.

  public      ::  date_Get



  public      ::  LeapYear

  public      ::  LeapDay

  public      ::  days_in_month, calc_days_in_month
@@ -325,6 +336,7 @@ module CSO_DateTimes 


  public      ::  CSO_ReadFromLine

  public      ::  ExpandTime

  public      ::  CompressTime

  public      ::  Compare_Date_Num



  public      ::  Pretty
@@ -3370,6 +3382,68 @@ contains 
  end subroutine ExpandTime





  ! *





  !

  ! Compress time to real value using units:

  !

  !   hours since 1900-01-01 00:00:0.0

  !



  subroutine CompressTime( t, units, value, status )



    use CSO_String, only : CSO_ReadFromLine



    ! --- in/out ---------------------------------



    type(T_CSO_DateTime), intent(in)    ::  t

    real, intent(out)                   ::  value

    character(len=*), intent(in)        ::  units

    integer, intent(out)                ::  status



    ! --- const ----------------------------------



    character(len=*), parameter  ::  rname = mname//'/CompressTime'



    ! --- local ----------------------------------



    character(len=512)    ::  line

    character(len=32)     ::  steps

    character(len=32)     ::  dummy

    type(T_CSO_DateTime)  ::  tref



    ! --- begin ----------------------------------



    ! copy:

    line = trim(units)



    ! extract step units:

    call CSO_ReadFromLine( line, steps, status, sep=' ' )

    IF_NOT_OK_RETURN(status=1)



    ! extract 'since'

    call CSO_ReadFromLine( line, dummy, status, sep=' ' )

    IF_NOT_OK_RETURN(status=1)

    ! check ...

    if ( trim(dummy) /= 'since' ) then

      write (csol,'("second field should be `since`, not `",a,"`")') trim(dummy); call csoPr

      TRACEBACK; status=1; return

    end if



    ! extract ref time values:

    call CSO_ReadFromLine( line, tref, status )

    IF_NOT_OK_RETURN(status=1)



    ! compute difference:

    value = rTotal( t - tref, steps )



    ! ok

    status = 0



  end subroutine CompressTime





  ! ***