From ce2bd9405410894bb33870d1976bfbc746ff7cc6 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 27 Oct 2022 10:56:19 +0200
Subject: [PATCH] Philippe 27/10/2022: datetime: add <= and > operators and
 improve older comparison subroutines (more robust but slower)

---
 src/MNH/mode_datetime.f90 | 117 +++++++++++++++++++++++++++++++++-----
 1 file changed, 104 insertions(+), 13 deletions(-)

diff --git a/src/MNH/mode_datetime.f90 b/src/MNH/mode_datetime.f90
index 2d999f564..2ccc4700b 100644
--- a/src/MNH/mode_datetime.f90
+++ b/src/MNH/mode_datetime.f90
@@ -7,7 +7,7 @@
 !  P. Wautelet 22/02/2019: use MOD intrinsics with same kind for all arguments (to respect Fortran standard)
 !  P. Wautelet 19/04/2019: use modd_precision kinds
 !  P. Wautelet 20/07/2021: modify DATETIME_TIME2REFERENCE and DATETIME_DISTANCE to allow correct computation with 32-bit floats
-!  P. Wautelet 27/10/2022: add + operator via DATETIME_TIME_ADD subroutine
+!  P. Wautelet 27/10/2022: add +, <= and > operators and improve older comparison subroutines (more robust but slower)
 !-----------------------------------------------------------------
 MODULE MODE_DATETIME
 !
@@ -21,6 +21,8 @@ PRIVATE
 !
 PUBLIC :: DATETIME_DISTANCE, DATETIME_CORRECTDATE
 PUBLIC :: OPERATOR(<)
+PUBLIC :: OPERATOR(<=)
+PUBLIC :: OPERATOR(>)
 PUBLIC :: OPERATOR(>=)
 PUBLIC :: OPERATOR(+)
 !
@@ -32,6 +34,14 @@ INTERFACE OPERATOR(<)
   MODULE PROCEDURE DATETIME_LT
 END INTERFACE
 !
+INTERFACE OPERATOR(<=)
+  MODULE PROCEDURE DATETIME_LE
+END INTERFACE
+!
+INTERFACE OPERATOR(>)
+  MODULE PROCEDURE DATETIME_GT
+END INTERFACE
+!
 INTERFACE OPERATOR(>=)
   MODULE PROCEDURE DATETIME_GE
 END INTERFACE
@@ -260,16 +270,23 @@ SELECT CASE(KMONTH)
 END SELECT
 !
 END SUBROUTINE DATETIME_GETMONTHLGT
+
+
+FUNCTION DATETIME_LT(TPT1, TPT2) RESULT (OLT)
 !
+! TRUE if TPT1 .LT. TPT2
 !
-ELEMENTAL FUNCTION DATETIME_LT(TPT1, TPT2) RESULT (OLT)
 IMPLICIT NONE
-LOGICAL :: OLT
+
 TYPE(DATE_TIME), INTENT(IN) :: TPT1, TPT2
-!
-! TRUE if TPT1 .LT. TPT2
-!
-!
+
+LOGICAL :: OLT
+
+INTEGER :: IDAYS1, IDAYS2
+REAL    :: ZSEC1, ZSEC2
+
+#if 0
+!Simpler but works only for correct dates (see DATETIME_CORRECTDATE)
 IF ( TPT1%nyear .EQ. TPT2%nyear ) THEN
   IF ( TPT1%nmonth .EQ. TPT2%nmonth ) THEN
     IF ( TPT1%nday .EQ. TPT2%nday ) THEN
@@ -283,23 +300,97 @@ IF ( TPT1%nyear .EQ. TPT2%nyear ) THEN
 ELSE
   OLT = TPT1%nyear .LT. TPT2%nyear
 ENDIF
-!
+#else
+CALL DATETIME_TIME2REFERENCE( TPT1, IDAYS1, ZSEC1 )
+CALL DATETIME_TIME2REFERENCE( TPT2, IDAYS2, ZSEC2 )
+
+OLT = .FALSE.
+
+IF ( IDAYS1 < IDAYS2 ) THEN
+  OLT = .TRUE.
+ELSE IF ( IDAYS1 == IDAYS2 ) THEN
+  IF ( ZSEC1 < ZSEC2 ) OLT = .TRUE.
+END IF
+#endif
+
 END FUNCTION DATETIME_LT
+
+
+FUNCTION DATETIME_LE(TPT1, TPT2) RESULT (OLE)
 !
+! TRUE if TPT1 <= TPT2
 !
-ELEMENTAL FUNCTION DATETIME_GE(TPT1, TPT2) RESULT (OLT)
 IMPLICIT NONE
-LOGICAL :: OLT
+
 TYPE(DATE_TIME), INTENT(IN) :: TPT1, TPT2
+
+LOGICAL :: OLE
+
+INTEGER :: IDAYS1, IDAYS2
+REAL    :: ZSEC1, ZSEC2
+
+#if 0
+!Simpler but works only for correct dates (see DATETIME_CORRECTDATE)
+IF ( TPT1%nyear == TPT2%nyear ) THEN
+  IF ( TPT1%nmonth == TPT2%nmonth ) THEN
+    IF ( TPT1%nday == TPT2%nday ) THEN
+      OLE = TPT1%xtime <= TPT2%xtime
+    ELSE
+      OLE = TPT1%nday <= TPT2%nday
+    END IF
+  ELSE
+   OLE = TPT1%nmonth <= TPT2%nmonth
+  END IF
+ELSE
+  OLE = TPT1%nyear <= TPT2%nyear
+ENDIF
+#else
+CALL DATETIME_TIME2REFERENCE( TPT1, IDAYS1, ZSEC1 )
+CALL DATETIME_TIME2REFERENCE( TPT2, IDAYS2, ZSEC2 )
+
+OLE = .FALSE.
+
+IF ( IDAYS1 < IDAYS2 ) THEN
+  OLE = .TRUE.
+ELSE IF ( IDAYS1 == IDAYS2 ) THEN
+  IF ( ZSEC1 <= ZSEC2 ) OLE = .TRUE.
+END IF
+#endif
 !
-! TRUE if TPT1 .GE. TPT2
+END FUNCTION DATETIME_LE
+
+
+FUNCTION DATETIME_GE(TPT1, TPT2) RESULT (OGE)
 !
-OLT = .NOT.DATETIME_LT(TPT1,TPT2)
+! TRUE if TPT1 >=. TPT2
 !
+IMPLICIT NONE
+
+TYPE(DATE_TIME), INTENT(IN) :: TPT1, TPT2
+
+LOGICAL :: OGE
+
+OGE = .NOT. DATETIME_LT( TPT1, TPT2 )
+
 END FUNCTION DATETIME_GE
 
 
-ELEMENTAL FUNCTION DATETIME_TIME_ADD( TPIN, PTIME ) RESULT ( TPOUT )
+FUNCTION DATETIME_GT(TPT1, TPT2) RESULT (OGT)
+!
+! TRUE if TPT1 > TPT2
+!
+IMPLICIT NONE
+
+TYPE(DATE_TIME), INTENT(IN) :: TPT1, TPT2
+
+LOGICAL :: OGT
+
+OGT = .NOT. DATETIME_LE( TPT1, TPT2 )
+
+END FUNCTION DATETIME_GT
+
+
+FUNCTION DATETIME_TIME_ADD( TPIN, PTIME ) RESULT ( TPOUT )
 
 IMPLICIT NONE
 
-- 
GitLab