|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 MODULE MODE_DATES_NETCDF 00002 00003 ! Module to read correctly time in a netcdf file 00004 00005 ! Author : Matthieu Lafaysse 00006 ! Creation : 2012-11-12 00007 00008 ! Modifications 00009 00010 USE MODD_TYPE_DATE_SURF 00011 00012 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00013 USE PARKIND1 ,ONLY : JPRB 00014 00015 IMPLICIT NONE 00016 00017 INTEGER,PARAMETER::JP_GREGOIRE=1582 !Année où le pape Grégoire XIII décida de passer du calendrier julien au calendrier grégorien 00018 !Avant cette date tous les années multiples de 4 sont des années bissextiles 00019 !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 00020 !De plus les journées du 5 au 14 octobre 1582 ont été supprimées pour compenser le retard accumulé 00021 00022 00023 CONTAINS 00024 00025 !---------------------------------------------------------------------------------------------------------------- 00026 00027 00028 SUBROUTINE NETCDF2DATE(PTIME,HUNITS,PDATETIME) 00029 ! 00030 ! Conversion de la date au format netcdf vers le format année mois jour heure selon dimension de itv_date 00031 REAL,DIMENSION(:),INTENT(IN) :: PTIME 00032 CHARACTER(*),INTENT(IN) :: HUNITS 00033 TYPE (DATE_TIME),DIMENSION(:),INTENT(OUT) :: PDATETIME 00034 ! 00035 INTEGER,DIMENSION(SIZE(PTIME)) :: ITIMEHOURS 00036 REAL,DIMENSION(SIZE(PTIME)) :: ZREST 00037 INTEGER :: IYEARUNITS,IMONTHUNITS,IDAYUNITS,IHOURUNITS 00038 ! 00039 CHARACTER(LEN=14) :: YHEADER 00040 CHARACTER(LEN=100) :: YFMT 00041 CHARACTER :: YC1,YC2,YC3 00042 ! 00043 LOGICAL :: GHEADER 00044 ! 00045 INTEGER,DIMENSION(4),PARAMETER :: ITV_DATEREF = (/1900,1,1,0/) 00046 INTEGER,DIMENSION(4),PARAMETER :: ITV_DATEREFBIS = (/1850,1,1,0/) 00047 ! 00048 INTEGER,DIMENSION(4) :: ITV_DATETEMPO 00049 INTEGER :: ICARACUNITS,ICARACHOUR,ICARACDAY,ICARACMONTH,ICARACYEAR 00050 INTEGER :: IERROR 00051 INTEGER :: JTIME 00052 INTEGER :: IV_DIFFREF 00053 ! 00054 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00055 ! 00056 IF (LHOOK) CALL DR_HOOK('MODE_DATES_NETCDF:NETCDF2DATE',0,ZHOOK_HANDLE) 00057 ! 00058 SELECT CASE (HUNITS(1:4)) 00059 CASE ("days") 00060 ICARACUNITS = 11 00061 ITIMEHOURS = INT(PTIME*24.) 00062 ZREST = PTIME*24.-ITIMEHOURS 00063 CASE ("hour") 00064 ICARACUNITS = 12 00065 ITIMEHOURS = INT(PTIME) 00066 ZREST = PTIME-ITIMEHOURS 00067 CASE ("minu") 00068 ICARACUNITS = 14 00069 ITIMEHOURS = INT(PTIME/24.) 00070 ZREST = (PTIME/24.)-ITIMEHOURS 00071 CASE ("seco") 00072 ICARACUNITS = 14 00073 ITIMEHOURS = INT(PTIME/3600.) 00074 ZREST = (PTIME/3600.)-ITIMEHOURS 00075 CASE DEFAULT 00076 PRINT*, "ERROR date_netcdf.F90 : Can't read time units :" 00077 PRINT*,TRIM(HUNITS) 00078 STOP "Error units time" 00079 END SELECT 00080 00081 SELECT CASE (HUNITS(1:4)) 00082 CASE ("days") 00083 !Read reference date 00084 boucles_days:DO ICARACDAY=1,2 !Day written by 1 or 2 char 00085 DO ICARACMONTH=1,2 !Month written by 1 or 2 char 00086 DO ICARACYEAR=1,4 !Year written by 1 to 4 char 00087 WRITE(YFMT,FMT='("(A",I2,",",2("I",I1,",A1,"),"I",I1,")")')& 00088 ICARACUNITS,ICARACYEAR,ICARACMONTH,ICARACDAY 00089 READ(HUNITS,FMT=YFMT,IOSTAT=IERROR)YHEADER,IYEARUNITS,YC1,IMONTHUNITS,YC2,IDAYUNITS 00090 IHOURUNITS=0 00091 IF (IERROR==0) THEN 00092 IF ((TRIM(YHEADER)=='days since').AND.(YC1=='-').AND.(YC2=='-')) THEN 00093 ! PRINT*,"DATE DE REFERENCE LUE :" 00094 ! PRINT*,itv_oldref 00095 EXIT boucles_days 00096 END IF 00097 END IF 00098 END DO 00099 END DO 00100 END DO boucles_days 00101 CASE ("hour","minu","seco") 00102 !Read reference date 00103 boucles_hours:DO ICARACHOUR=1,2 !Hour written by 1 or 2 char 00104 DO ICARACDAY=1,2 !Day written by 1 or 2 char 00105 DO ICARACMONTH=1,2 !Month written by 1 or 2 char 00106 DO ICARACYEAR=1,4 !Year written by 1 to 4 char 00107 WRITE(YFMT,FMT='("(A",I2,",",2("I",I1,",A1,"),"I",I1,",X,I",I1,",A1)")')& 00108 ICARACUNITS,ICARACYEAR,ICARACMONTH,ICARACDAY,ICARACHOUR 00109 READ(HUNITS,FMT=YFMT,IOSTAT=IERROR)YHEADER,IYEARUNITS,& 00110 YC1,IMONTHUNITS,YC2,IDAYUNITS,IHOURUNITS,YC3 00111 IF (IERROR==0) THEN 00112 GHEADER=(TRIM(YHEADER)=='hours since') .OR. (TRIM(YHEADER)=='minutes since') .OR. & 00113 (TRIM(YHEADER)=='seconds since') 00114 IF (GHEADER.AND.(YC1=='-').AND.(YC2=='-').AND.(YC3==':')) THEN 00115 ! PRINT*,"DATE DE REFERENCE LUE :" 00116 ! PRINT*,itv_oldref 00117 EXIT boucles_hours 00118 END IF 00119 END IF 00120 END DO 00121 END DO 00122 END DO 00123 END DO boucles_hours 00124 CASE DEFAULT 00125 STOP "Error units time" 00126 END SELECT 00127 00128 00129 00130 !Check successful reading 00131 IF (IERROR>0) THEN 00132 PRINT*, "ERROR date_netcdf.F90 : Can't read time units :" 00133 PRINT*,TRIM(HUNITS) 00134 STOP "Error units time" 00135 END IF 00136 00137 DO JTIME=1,SIZE(PTIME) 00138 !Initialiaze the date to the reference date 00139 PDATETIME(JTIME)%TDATE%YEAR = IYEARUNITS 00140 PDATETIME(JTIME)%TDATE%MONTH = IMONTHUNITS 00141 PDATETIME(JTIME)%TDATE%DAY = IDAYUNITS 00142 PDATETIME(JTIME)%TIME = IHOURUNITS+ZREST(JTIME) 00143 CALL ADDHOURS(PDATETIME(JTIME),ITIMEHOURS(JTIME)) 00144 END DO 00145 00146 IF (LHOOK) CALL DR_HOOK('MODE_DATES_NETCDF:NETCDF2DATE',1,ZHOOK_HANDLE) 00147 00148 END SUBROUTINE NETCDF2DATE 00149 !---------------------------------------------------------------------------------------------------------------- 00150 00151 !-------------------------------------------------------------------------------------------------------------- 00152 LOGICAL FUNCTION LEAPYEAR (PYEAR) 00153 INTEGER, INTENT(IN) :: PYEAR ! Is the year a leap year ? 00154 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00155 00156 IF (LHOOK) CALL DR_HOOK('MODE_DATES_NETCDF:LEAPYEAR',0,ZHOOK_HANDLE) 00157 00158 IF (PYEAR>JP_GREGOIRE) THEN 00159 LEAPYEAR = (((MOD(PYEAR,4)==0).AND.(MOD(PYEAR,100)/=0)).OR.(MOD(PYEAR,400)==0)) 00160 ELSE 00161 LEAPYEAR = (MOD(PYEAR,4)==0) 00162 ENDIF 00163 00164 IF (LHOOK) CALL DR_HOOK('MODE_DATES_NETCDF:LEAPYEAR',1,ZHOOK_HANDLE) 00165 00166 END FUNCTION LEAPYEAR 00167 !-------------------------------------------------------------------------------------------------------------- 00168 00169 !-------------------------------------------------------------------------------------------------------------- 00170 SUBROUTINE ADDHOURS (TPTIME,KNHOURS) 00171 !Add the number of hours to a date 00172 TYPE(DATE_TIME),INTENT(INOUT)::TPTIME 00173 INTEGER,INTENT(IN)::KNHOURS ! number of hours 00174 INTEGER,DIMENSION(12)::INBDM !Number of days per months 00175 INTEGER::IREMAININGDAYS !Number of remaining days to add 00176 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00177 00178 IF (LHOOK) CALL DR_HOOK('MODE_DATES_NETCDF:ADDHOURS',0,ZHOOK_HANDLE) 00179 00180 !special case of 1582 00181 IF (TPTIME%TDATE%YEAR==JP_GREGOIRE) THEN 00182 INBDM=(/31,28,31,30,31,30,31,31,30,21,30,31/) 00183 ELSE 00184 IF (LEAPYEAR(TPTIME%TDATE%YEAR)) THEN 00185 INBDM=(/31,29,31,30,31,30,31,31,30,31,30,31/) 00186 ELSE 00187 INBDM=(/31,28,31,30,31,30,31,31,30,31,30,31/) 00188 ENDIF 00189 ENDIF 00190 00191 IF (KNHOURS>=0) THEN 00192 !Increase hour 00193 IF ((INT(TPTIME%TIME)+KNHOURS)<=23) THEN 00194 TPTIME%TIME=TPTIME%TIME+KNHOURS 00195 ELSE 00196 IREMAININGDAYS=(INT(TPTIME%TIME)+KNHOURS)/24 !Number of remaining days 00197 TPTIME%TIME=MOD(INT(TPTIME%TIME)+KNHOURS,24)+TPTIME%TIME-INT(TPTIME%TIME) ! new hour (+minutes) 00198 !Increase days 00199 DO 00200 IF ((TPTIME%TDATE%DAY+IREMAININGDAYS)<=INBDM(TPTIME%TDATE%MONTH)) THEN 00201 TPTIME%TDATE%DAY=TPTIME%TDATE%DAY+IREMAININGDAYS 00202 EXIT 00203 ELSE 00204 IREMAININGDAYS=IREMAININGDAYS-(INBDM(TPTIME%TDATE%MONTH)-TPTIME%TDATE%DAY+1) 00205 IF (TPTIME%TDATE%MONTH<12) THEN 00206 TPTIME%TDATE%MONTH=TPTIME%TDATE%MONTH+1 !Month change 00207 TPTIME%TDATE%DAY=1 00208 ELSE 00209 !Year change 00210 TPTIME%TDATE%YEAR=TPTIME%TDATE%YEAR+1 00211 TPTIME%TDATE%MONTH=1 00212 TPTIME%TDATE%DAY=1 00213 !Update february number of days 00214 IF (LEAPYEAR(TPTIME%TDATE%YEAR)) INBDM(2)=29 00215 IF (LEAPYEAR(TPTIME%TDATE%YEAR-1)) INBDM(2)=28 00216 !Update october month for 1582 and 1583 00217 IF (TPTIME%TDATE%YEAR==JP_GREGOIRE) INBDM(10)=21 00218 IF (TPTIME%TDATE%YEAR==JP_GREGOIRE+1) INBDM(10)=31 00219 ENDIF 00220 ENDIF 00221 ENDDO 00222 ENDIF 00223 ELSE 00224 IF ((INT(TPTIME%TIME)+KNHOURS)>=0) THEN 00225 TPTIME%TIME=TPTIME%TIME+KNHOURS 00226 ELSE 00227 IREMAININGDAYS=(INT(TPTIME%TIME)-KNHOURS)/24+1 00228 TPTIME%TIME=MOD(INT(TPTIME%TIME)-KNHOURS,24)+TPTIME%TIME-INT(TPTIME%TIME) ! new hour 00229 ! decrease days 00230 DO 00231 IF ((TPTIME%TDATE%DAY-IREMAININGDAYS)>=1) THEN 00232 TPTIME%TDATE%DAY=TPTIME%TDATE%DAY-IREMAININGDAYS 00233 EXIT 00234 ELSE 00235 IREMAININGDAYS=IREMAININGDAYS-TPTIME%TDATE%DAY 00236 IF (TPTIME%TDATE%MONTH>=1) THEN 00237 TPTIME%TDATE%MONTH=TPTIME%TDATE%MONTH-1 !Month change 00238 TPTIME%TDATE%DAY=INBDM(TPTIME%TDATE%MONTH) 00239 ELSE 00240 !Year change 00241 TPTIME%TDATE%YEAR=TPTIME%TDATE%YEAR-1 00242 TPTIME%TDATE%MONTH=12 00243 TPTIME%TDATE%DAY=INBDM(TPTIME%TDATE%MONTH) 00244 !Update february number of days 00245 IF (LEAPYEAR(TPTIME%TDATE%YEAR)) INBDM(2)=29 00246 IF (LEAPYEAR(TPTIME%TDATE%YEAR+1)) INBDM(2)=28 00247 !Update october month for 1582 and 1583 00248 IF (TPTIME%TDATE%YEAR==JP_GREGOIRE) INBDM(10)=21 00249 IF (TPTIME%TDATE%YEAR==JP_GREGOIRE-1) INBDM(10)=31 00250 END IF 00251 END IF 00252 END DO 00253 END IF 00254 END IF 00255 00256 IF (LHOOK) CALL DR_HOOK('MODE_DATES_NETCDF:ADDHOURS',1,ZHOOK_HANDLE) 00257 00258 END SUBROUTINE ADDHOURS 00259 !-------------------------------------------------------------------------------------------------------------- 00260 00261 END MODULE MODE_DATES_NETCDF
1.8.0
