From 00c84d224faaff7be1469832151281fb4ae310a3 Mon Sep 17 00:00:00 2001 From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr> Date: Tue, 27 Mar 2018 17:36:56 +0200 Subject: [PATCH] Philippe 27/03/2018: new module MODE_DATETIME to manipulate DATE_TIME derived datatype --- src/MNH/mode_datetime.f90 | 228 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 228 insertions(+) create mode 100644 src/MNH/mode_datetime.f90 diff --git a/src/MNH/mode_datetime.f90 b/src/MNH/mode_datetime.f90 new file mode 100644 index 000000000..f4db85092 --- /dev/null +++ b/src/MNH/mode_datetime.f90 @@ -0,0 +1,228 @@ +!MNH_LIC Copyright 2018 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +MODULE MODE_DATETIME +! +USE MODD_TYPE_DATE +! +USE MODE_MSG +! +IMPLICIT NONE +! +PRIVATE +! +!Reference date (do not change it) +!To work with DATETIME_TIME2REFERENCE, we assume the year is a multiple of 400 + 1 and the date is January 1st (and time=0.) +TYPE(DATE_TIME),PARAMETER :: TPREFERENCE_DATE = DATE_TIME( TDATE=DATE(1601,1,1), TIME=0. ) +! +PUBLIC DATETIME_DISTANCE, DATETIME_CORRECTDATE +! +CONTAINS +! +SUBROUTINE DATETIME_TIME2REFERENCE(TPDATE,PDIST) +! +!Compute number of seconds since reference date (and time) +! +TYPE(DATE_TIME), INTENT(IN) :: TPDATE +REAL, INTENT(OUT) :: PDIST +! +INTEGER(KIND=8) :: ILEAPS !Number of leap days +INTEGER(KIND=8) :: IDAYS !Number of days since reference date +INTEGER(KIND=8) :: IYEARS !Number of years since reference date +INTEGER(KIND=8) :: IDAY_CUR, IMONTH_CUR, IYEAR_CUR !Currrent day, month and year +REAL :: ZSEC !Current time of the day (in seconds) +TYPE(DATE_TIME) :: TZDATE +! +ILEAPS = 0 +IDAYS = 0 +! +TZDATE = TPDATE +CALL DATETIME_CORRECTDATE(TZDATE) +! +IYEAR_CUR = TZDATE%TDATE%YEAR +IMONTH_CUR = TZDATE%TDATE%MONTH +IDAY_CUR = TZDATE%TDATE%DAY +ZSEC = TZDATE%TIME +! +!Compute number of days since beginning of the year +IF ( ((MOD(IYEAR_CUR,4)==0).AND.(MOD(IYEAR_CUR,100)/=0)) .OR. (MOD(IYEAR_CUR,400)==0)) ILEAPS=1 +SELECT CASE(IMONTH_CUR) + CASE(1) + IDAYS = IDAY_CUR-1 + CASE(2) + IDAYS = IDAY_CUR-1+31 + CASE(3) + IDAYS = IDAY_CUR-1+31+28+ILEAPS + CASE(4) + IDAYS = IDAY_CUR-1+31+28+ILEAPS+31 + CASE(5) + IDAYS = IDAY_CUR-1+31+28+ILEAPS+31+30 + CASE(6) + IDAYS = IDAY_CUR-1+31+28+ILEAPS+31+30+31 + CASE(7) + IDAYS = IDAY_CUR-1+31+28+ILEAPS+31+30+31+30 + CASE(8) + IDAYS = IDAY_CUR-1+31+28+ILEAPS+31+30+31+30+31 + CASE(9) + IDAYS = IDAY_CUR-1+31+28+ILEAPS+31+30+31+30+31+31 + CASE(10) + IDAYS = IDAY_CUR-1+31+28+ILEAPS+31+30+31+30+31+31+30 + CASE(11) + IDAYS = IDAY_CUR-1+31+28+ILEAPS+31+30+31+30+31+31+30+31 + CASE(12) + IDAYS = IDAY_CUR-1+31+28+ILEAPS+31+30+31+30+31+31+30+31+30 +END SELECT +! +IYEARS = IYEAR_CUR-TPREFERENCE_DATE%TDATE%YEAR +IF (IYEARS<0) THEN + CALL PRINT_MSG(NVERB_WARNING,'GEN','DATETIME_TIME2REFERENCE', & + 'input year is smaller than reference year => result could be invalid') +END IF +! +!Compute number of years + number of leap days from reference date +ILEAPS = IYEARS/4 ! 1 leap year every 4 years +ILEAPS = ILEAPS-(IYEARS/100) ! multiple of 100 are not leap years +ILEAPS = ILEAPS+(IYEARS/400) ! multiple of 400 are leap years +! +!Compute number of days since reference date +IDAYS = IDAYS + 365*IYEARS + ILEAPS +! +PDIST = REAL(IDAYS*(60*60*24))+ZSEC +! +END SUBROUTINE DATETIME_TIME2REFERENCE +! +! +SUBROUTINE DATETIME_DISTANCE(TPDATEBEG,TPDATEEND,PDIST) +! +!Compute distance (in seconds) between 2 dates +! +TYPE(DATE_TIME), INTENT(IN) :: TPDATEBEG +TYPE(DATE_TIME), INTENT(IN) :: TPDATEEND +REAL, INTENT(OUT) :: PDIST +! +REAL :: ZDISTBEG, ZDISTEND +! +CALL DATETIME_TIME2REFERENCE(TPDATEBEG,ZDISTBEG) +CALL DATETIME_TIME2REFERENCE(TPDATEEND,ZDISTEND) +! +PDIST = ZDISTEND-ZDISTBEG +! +END SUBROUTINE DATETIME_DISTANCE +! +SUBROUTINE DATETIME_CORRECTDATE(TPDATE) +! +! Correct the date if not in the correct interval +! Change the date if time is <0 or >=86400 s +! or if day is not a valid day for the current month +! or if month<1 or >12 +! +TYPE(DATE_TIME), INTENT(INOUT) :: TPDATE +! +INTEGER :: IDAYS !Number of days to add +INTEGER :: IDAY_CUR, IMONTH_CUR, IYEAR_CUR !Currrent day, month and year +INTEGER :: IMONTH_LGT !Number of days in a month +LOGICAL :: GKO +REAL :: ZSEC !Current time of the day (in seconds) +! +IYEAR_CUR = TPDATE%TDATE%YEAR +IMONTH_CUR = TPDATE%TDATE%MONTH +IDAY_CUR = TPDATE%TDATE%DAY +ZSEC = TPDATE%TIME +! print *,'DATETIME_CORRECTDATE in: ',IYEAR_CUR,IMONTH_CUR,IDAY_CUR,ZSEC +! +CALL DATETIME_GETMONTHLGT(IYEAR_CUR,IMONTH_CUR,IMONTH_LGT) +IF (TPDATE%TIME<0. .OR. TPDATE%TIME>=86400. .OR. & + IDAY_CUR<1 .OR. IDAY_CUR>IMONTH_LGT .OR. & + IMONTH_CUR<1 .OR. IMONTH_CUR>12 ) THEN + GKO = .TRUE. +ELSE + GKO = .FALSE. +END IF +! +IF (TPDATE%TIME<0.) THEN + !Number of days to remove + IDAYS = INT(TPDATE%TIME/86400.)-1 +ELSE IF (TPDATE%TIME>=86400.) THEN + !Number of days to add + IDAYS = INT(TPDATE%TIME/86400.) +ELSE + IDAYS = 0 +END IF +! +!Correct time +ZSEC = ZSEC - IDAYS * 86400. +! +!Correct date +DO WHILE (GKO) + IDAY_CUR = IDAY_CUR + IDAYS + ! + !Check if year changed + IF (IMONTH_CUR>12) THEN + IYEAR_CUR = IYEAR_CUR + (IMONTH_CUR-1)/12 + IMONTH_CUR = MOD(IMONTH_CUR-1,12)+1 + ELSE IF (IMONTH_CUR<1) THEN + IYEAR_CUR = IYEAR_CUR + IMONTH_CUR/12 - 1 + IMONTH_CUR = 12+MOD(IMONTH_CUR,12) + END IF + ! + CALL DATETIME_GETMONTHLGT(IYEAR_CUR,IMONTH_CUR,IMONTH_LGT) + ! + !Check if month changed + IF (IDAY_CUR<=IMONTH_LGT .AND. IDAY_CUR>=1) THEN + IDAYS = 0 + ELSE IF (IDAY_CUR>IMONTH_LGT) THEN + IMONTH_CUR = IMONTH_CUR + 1 + IDAYS = IDAY_CUR-IMONTH_LGT + IDAY_CUR = 0 + ELSE !IDAY_CUR<1 + IMONTH_CUR = IMONTH_CUR - 1 + !Check if year changed + IF (IMONTH_CUR<1) THEN + IMONTH_CUR = 12 + IYEAR_CUR = IYEAR_CUR - 1 + END IF + CALL DATETIME_GETMONTHLGT(IYEAR_CUR,IMONTH_CUR,IMONTH_LGT) + IDAYS = IDAY_CUR + IDAY_CUR = IMONTH_LGT + END IF + ! +! print *,'DATETIME_CORRECTDATE du2:',IYEAR_CUR,IMONTH_CUR,IDAY_CUR,ZSEC,IDAYS + IF (IDAYS==0 .AND. & + IDAY_CUR>=1 .AND. IDAY_CUR<=IMONTH_LGT .AND. & + IMONTH_CUR>=1 .AND. IMONTH_CUR<=12 ) GKO=.FALSE. +END DO +! print *,'DATETIME_CORRECTDATE out:',IYEAR_CUR,IMONTH_CUR,IDAY_CUR,ZSEC +! +TPDATE%TDATE%YEAR = IYEAR_CUR +TPDATE%TDATE%MONTH = IMONTH_CUR +TPDATE%TDATE%DAY = IDAY_CUR +TPDATE%TIME = ZSEC +! +END SUBROUTINE DATETIME_CORRECTDATE +! +! +SUBROUTINE DATETIME_GETMONTHLGT(KYEAR,KMONTH,KLGT) +! +INTEGER, INTENT(IN) :: KYEAR +INTEGER, INTENT(IN) :: KMONTH +INTEGER, INTENT(OUT) :: KLGT +! +SELECT CASE(KMONTH) + CASE(1,3,5,7,8,10,12) + KLGT = 31 + CASE(2) + IF ( ((MOD(KYEAR,4)==0).AND.(MOD(KYEAR,100)/=0)) .OR. (MOD(KYEAR,400)==0)) THEN + KLGT = 29 + ELSE + KLGT = 28 + END IF + CASE(4,6,9,11) + KLGT = 30 + CASE DEFAULT !Not an error (useful for DATETIME_CORRECTDATE) + KLGT = 0 +END SELECT +! +END SUBROUTINE DATETIME_GETMONTHLGT +! +END MODULE MODE_DATETIME -- GitLab