mode_dates_netcdf.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
MODULE mode_dates_netcdf

! Module to read correctly time in a netcdf file

! Author : Matthieu Lafaysse
! Creation : 2012-11-12

! Modifications

USE modd_type_date_surf

USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb

IMPLICIT NONE

INTEGER,PARAMETER::JP_GREGOIRE=1582 !Année où le pape Grégoire XIII décida de passer du calendrier julien au calendrier grégorien
!Avant cette date tous les années multiples de 4 sont des années bissextiles
!Au-delà de cette date les années multiples de 100 ne sont pas bissextiles sauf les années multiples de 400 qui le sont
!De plus les journées du 5 au 14 octobre 1582 ont été supprimées pour compenser le retard accumulé


 CONTAINS

!----------------------------------------------------------------------------------------------------------------


SUBROUTINE netcdf2date(PTIME,HUNITS,PDATETIME)
!
! Conversion de la date au format netcdf vers le format année mois jour heure selon dimension de itv_date
REAL,DIMENSION(:),INTENT(IN) :: ptime
 CHARACTER(*),INTENT(IN) :: hunits
TYPE (date_time),DIMENSION(:),INTENT(OUT) :: pdatetime
!
INTEGER,DIMENSION(SIZE(PTIME)) :: itimehours
REAL,DIMENSION(SIZE(PTIME)) :: zrest
INTEGER :: iyearunits,imonthunits,idayunits,ihourunits
!
 CHARACTER(LEN=14) :: yheader
 CHARACTER(LEN=100) :: yfmt 
 CHARACTER :: yc1,yc2,yc3
!
LOGICAL :: gheader
!
INTEGER,DIMENSION(4),PARAMETER :: itv_dateref = (/1900,1,1,0/)
INTEGER,DIMENSION(4),PARAMETER :: itv_daterefbis = (/1850,1,1,0/)
!
INTEGER,DIMENSION(4) :: itv_datetempo
INTEGER :: icaracunits,icarachour,icaracday,icaracmonth,icaracyear
INTEGER :: ierror
INTEGER :: jtime
INTEGER :: iv_diffref
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_DATES_NETCDF:NETCDF2DATE',0,zhook_handle)
!
SELECT CASE (hunits(1:4))
  CASE ("days")
    icaracunits = 11
    itimehours = int(ptime*24.)
    zrest = ptime*24.-itimehours
  CASE ("hour")
    icaracunits = 12
    itimehours = int(ptime)
    zrest = ptime-itimehours
  CASE ("minu")
    icaracunits = 14
    itimehours = int(ptime/60.)
    zrest = (ptime/60.)-itimehours
  CASE ("seco")
    icaracunits = 14
    itimehours = int(ptime/3600.)
    zrest = (ptime/3600.)-itimehours
  CASE default
    print*, "ERROR date_netcdf.F90 : Can't read time units :"
    print*,trim(hunits)
    stop "Error units time"
END SELECT

SELECT CASE (hunits(1:4))
  !CASE ("days")
  !  !Read reference date
  !  boucles_days:DO ICARACDAY=1,2 !Day written by 1 or 2 char
  !    DO ICARACMONTH=1,2 !Month written by 1 or 2 char
  !      DO ICARACYEAR=1,4 !Year written by 1 to 4 char
  !        WRITE(YFMT,FMT='("(A",I2,",",2("I",I1,",A1,"),"I",I1,",X,I",I1,",A1)")')&
  !          ICARACUNITS,ICARACYEAR,ICARACMONTH,ICARACDAY,ICARACHOUR
  !        READ(HUNITS,FMT=YFMT,IOSTAT=IERROR)YHEADER,IYEARUNITS,YC1,IMONTHUNITS,YC2,IDAYUNITS,IHOURUNITS,YC3
  !        IHOURUNITS=0
  !        IF (IERROR==0) THEN
  !          IF ((TRIM(YHEADER)=='days since').AND.(YC1=='-').AND.(YC2=='-').AND.(YC3==':')) THEN
  !            ! PRINT*,"DATE DE REFERENCE LUE :"
  !            ! PRINT*,itv_oldref
  !            EXIT boucles_days
  !          END IF
  !        END IF
  !      END DO
  !    END DO
  !  END DO boucles_days
  CASE ("days","hour","minu","seco")
    !Read reference date
    boucles_hours:DO icarachour=1,2 !Hour written by 1 or 2 char
      DO icaracday=1,2 !Day written by 1 or 2 char
        DO icaracmonth=1,2 !Month written by 1 or 2 char
          DO icaracyear=1,4 !Year written by 1 to 4 char
            WRITE(yfmt,fmt='("(A",I2,",",2("I",I1,",A1,"),"I",I1,",X,I",I1,",A1)")')&
              icaracunits,icaracyear,icaracmonth,icaracday,icarachour
            READ(hunits,fmt=yfmt,iostat=ierror)yheader,iyearunits,&
              yc1,imonthunits,yc2,idayunits,ihourunits,yc3
            IF (ierror==0) THEN
              gheader=(trim(yheader)=='hours since') .OR. (trim(yheader)=='minutes since') .OR. &
                      (trim(yheader)=='seconds since') .OR. (trim(yheader)=='days since')
              IF (gheader.AND.(yc1=='-').AND.(yc2=='-').AND.(yc3==':')) THEN
                ! PRINT*,"DATE DE REFERENCE LUE :"
                ! PRINT*,itv_oldref
                EXIT boucles_hours
              END IF
            END IF
          END DO
        END DO
      END DO
    END DO boucles_hours
  CASE default
    stop "Error units time"
END SELECT



!Check successful reading
IF (ierror>0) THEN
  print*, "ERROR date_netcdf.F90 : Can't read time units :"
  print*,trim(hunits)
  stop "Error units time"
END IF

DO jtime=1,SIZE(ptime)
  !Initialiaze the date to the reference date
  pdatetime(jtime)%TDATE%YEAR = iyearunits
  pdatetime(jtime)%TDATE%MONTH = imonthunits
  pdatetime(jtime)%TDATE%DAY = idayunits
  pdatetime(jtime)%TIME = ihourunits+zrest(jtime)
  CALL addhours(pdatetime(jtime),itimehours(jtime))
END DO

IF (lhook) CALL dr_hook('MODE_DATES_NETCDF:NETCDF2DATE',1,zhook_handle)

END SUBROUTINE netcdf2date
!----------------------------------------------------------------------------------------------------------------

!--------------------------------------------------------------------------------------------------------------
LOGICAL FUNCTION leapyear (PYEAR)
INTEGER, INTENT(IN) :: pyear ! Is the year a leap year ?
REAL(KIND=JPRB) :: zhook_handle

IF (lhook) CALL dr_hook('MODE_DATES_NETCDF:LEAPYEAR',0,zhook_handle)

IF (pyear>jp_gregoire) THEN
  leapyear = (((mod(pyear,4)==0).AND.(mod(pyear,100)/=0)).OR.(mod(pyear,400)==0))
ELSE
  leapyear = (mod(pyear,4)==0)
ENDIF

IF (lhook) CALL dr_hook('MODE_DATES_NETCDF:LEAPYEAR',1,zhook_handle)

END FUNCTION leapyear
!--------------------------------------------------------------------------------------------------------------

!--------------------------------------------------------------------------------------------------------------
SUBROUTINE addhours (TPTIME,KNHOURS)
!Add the number of hours to a date
TYPE(date_time),INTENT(INOUT)::tptime
INTEGER,INTENT(IN)::knhours ! number of hours
INTEGER,DIMENSION(12)::inbdm !Number of days per months
INTEGER::iremainingdays !Number of remaining days to add
REAL(KIND=JPRB) :: zhook_handle

IF (lhook) CALL dr_hook('MODE_DATES_NETCDF:ADDHOURS',0,zhook_handle)

!special case of 1582
IF (tptime%TDATE%YEAR==jp_gregoire) THEN
  inbdm=(/31,28,31,30,31,30,31,31,30,21,30,31/)
ELSE
  IF (leapyear(tptime%TDATE%YEAR)) THEN
    inbdm=(/31,29,31,30,31,30,31,31,30,31,30,31/)
  ELSE
    inbdm=(/31,28,31,30,31,30,31,31,30,31,30,31/)
  ENDIF
ENDIF

IF (knhours>=0) THEN
  !Increase hour
  IF ((int(tptime%TIME)+knhours)<=23) THEN
    tptime%TIME=tptime%TIME+knhours
  ELSE
    iremainingdays=(int(tptime%TIME)+knhours)/24 !Number of remaining days
    tptime%TIME=mod(int(tptime%TIME)+knhours,24)+tptime%TIME-int(tptime%TIME) ! new hour (+minutes)
    !Increase days
    DO
      IF ((tptime%TDATE%DAY+iremainingdays)<=inbdm(tptime%TDATE%MONTH)) THEN
        tptime%TDATE%DAY=tptime%TDATE%DAY+iremainingdays
        EXIT
      ELSE
        iremainingdays=iremainingdays-(inbdm(tptime%TDATE%MONTH)-tptime%TDATE%DAY+1)
        IF (tptime%TDATE%MONTH<12) THEN
          tptime%TDATE%MONTH=tptime%TDATE%MONTH+1 !Month change
          tptime%TDATE%DAY=1
        ELSE
          !Year change
          tptime%TDATE%YEAR=tptime%TDATE%YEAR+1
          tptime%TDATE%MONTH=1
          tptime%TDATE%DAY=1
          !Update february number of days
          IF (leapyear(tptime%TDATE%YEAR)) inbdm(2)=29
          IF (leapyear(tptime%TDATE%YEAR-1)) inbdm(2)=28
          !Update october month for 1582 and 1583
          IF (tptime%TDATE%YEAR==jp_gregoire) inbdm(10)=21
          IF (tptime%TDATE%YEAR==jp_gregoire+1) inbdm(10)=31
        ENDIF
      ENDIF
    ENDDO
  ENDIF
ELSE
  IF ((int(tptime%TIME)+knhours)>=0) THEN
    tptime%TIME=tptime%TIME+knhours
  ELSE
    iremainingdays=(int(tptime%TIME)-knhours)/24+1
    tptime%TIME=mod(int(tptime%TIME)-knhours,24)+tptime%TIME-int(tptime%TIME) ! new hour
    ! decrease days
    DO
      IF  ((tptime%TDATE%DAY-iremainingdays)>=1) THEN
        tptime%TDATE%DAY=tptime%TDATE%DAY-iremainingdays
        EXIT
      ELSE
        iremainingdays=iremainingdays-tptime%TDATE%DAY
        IF (tptime%TDATE%MONTH>=1) THEN
          tptime%TDATE%MONTH=tptime%TDATE%MONTH-1 !Month change
          tptime%TDATE%DAY=inbdm(tptime%TDATE%MONTH)
        ELSE
          !Year change
          tptime%TDATE%YEAR=tptime%TDATE%YEAR-1
          tptime%TDATE%MONTH=12
          tptime%TDATE%DAY=inbdm(tptime%TDATE%MONTH)
          !Update february number of days
          IF (leapyear(tptime%TDATE%YEAR)) inbdm(2)=29
          IF (leapyear(tptime%TDATE%YEAR+1)) inbdm(2)=28
          !Update october month for 1582 and 1583
          IF (tptime%TDATE%YEAR==jp_gregoire) inbdm(10)=21
          IF (tptime%TDATE%YEAR==jp_gregoire-1) inbdm(10)=31
        END IF
      END IF
    END DO
  END IF
END IF

IF (lhook) CALL dr_hook('MODE_DATES_NETCDF:ADDHOURS',1,zhook_handle)

END SUBROUTINE addhours
!--------------------------------------------------------------------------------------------------------------

END MODULE mode_dates_netcdf