| 1 | ! ================================================================================================================================ |
|---|
| 2 | ! MODULE : time |
|---|
| 3 | ! |
|---|
| 4 | ! CONTACT : orchidee-help _at_ ipsl.jussieu.fr |
|---|
| 5 | ! |
|---|
| 6 | ! LICENCE : IPSL (2006) |
|---|
| 7 | ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC |
|---|
| 8 | ! |
|---|
| 9 | !>\BRIEF This module contians the time information for ORCHIDEE |
|---|
| 10 | !! |
|---|
| 11 | !!\n DESCRIPTION: This module contains the time information for ORCHIDEE. |
|---|
| 12 | !! Time variables are calculated and updated at each time step. The variables are public and can be used from other modules. |
|---|
| 13 | !! The time variables must not be modified outside this module. |
|---|
| 14 | !! |
|---|
| 15 | !! Time variables in this module are given for the interval corresponding to current time-step. |
|---|
| 16 | !! The variables xxx_start and xxx_end are given to describe the time interval, either on julian(julian_start, julian_end) or |
|---|
| 17 | !! yymmddsec format (year_start/end, month_start/end, day_start/end, sec_start/end). The variables can be used in all other modules. |
|---|
| 18 | !! Logical variables telling if it's the last or first time-step of the day, of the month or of the year are also available. |
|---|
| 19 | !! |
|---|
| 20 | !! Subroutines in module time : |
|---|
| 21 | !! time_initialize : To initialize time variables. |
|---|
| 22 | !! Public subroutine called from intersurf_initialize_2d, intersurf_initialize_gathered or orchideedriver. |
|---|
| 23 | !! This subroutine is called before the first call to sechiba. |
|---|
| 24 | !! time_nextstep : Update time variables in the beginning at each new time step. |
|---|
| 25 | !! Public subroutine called from intersurf_main_2d, intersurf_main_gathered or orchideedriver. |
|---|
| 26 | !! time_interval : Calculate the interval for a given time step. Local subroutine, called from time_nextstep. |
|---|
| 27 | !! |
|---|
| 28 | !! REFERENCE(S) : None |
|---|
| 29 | !! |
|---|
| 30 | !! SVN : |
|---|
| 31 | !! $HeadURL: $ |
|---|
| 32 | !! $Date: $ |
|---|
| 33 | !! $Revision: $ |
|---|
| 34 | !! \n |
|---|
| 35 | !_ ================================================================================================================================ |
|---|
| 36 | MODULE time |
|---|
| 37 | |
|---|
| 38 | USE defprec |
|---|
| 39 | USE constantes_var |
|---|
| 40 | USE mod_orchidee_para_var, ONLY : numout |
|---|
| 41 | ! USE ioipsl |
|---|
| 42 | USE ioipsl_para |
|---|
| 43 | |
|---|
| 44 | IMPLICIT NONE |
|---|
| 45 | PRIVATE |
|---|
| 46 | |
|---|
| 47 | PUBLIC :: time_initialize, time_nextstep, time_get_day_of_year |
|---|
| 48 | ! time_is_gregorian_leap_year, time_days_in_gregorian_month, time_get_day_of_year |
|---|
| 49 | |
|---|
| 50 | REAL(r_std), PUBLIC :: dt_sechiba !! Lenght of time step in sechiba (s) |
|---|
| 51 | !$OMP THREADPRIVATE(dt_sechiba) |
|---|
| 52 | REAL(r_std), PUBLIC :: dt_stomate !! Length of time step in slow processes in stomate (s) |
|---|
| 53 | !$OMP THREADPRIVATE(dt_stomate) |
|---|
| 54 | CHARACTER(LEN=20), PUBLIC :: calendar_str !! The calendar type |
|---|
| 55 | !$OMP THREADPRIVATE(calendar_str) |
|---|
| 56 | INTEGER(i_std), SAVE, PUBLIC :: year_start !! Year at beginng of current time step |
|---|
| 57 | !$OMP THREADPRIVATE(year_start) |
|---|
| 58 | INTEGER(i_std), SAVE, PUBLIC :: month_start !! Month at beginng of current time step |
|---|
| 59 | !$OMP THREADPRIVATE(month_start) |
|---|
| 60 | INTEGER(i_std), SAVE, PUBLIC :: day_start !! Day in month at beginng of current time step |
|---|
| 61 | !$OMP THREADPRIVATE(day_start) |
|---|
| 62 | REAL(r_std), SAVE, PUBLIC :: sec_start !! Seconds in the day at beginng of current time step |
|---|
| 63 | !$OMP THREADPRIVATE(sec_start) |
|---|
| 64 | INTEGER(i_std), SAVE, PUBLIC :: year_end !! Year at end of current time step |
|---|
| 65 | !$OMP THREADPRIVATE(year_end) |
|---|
| 66 | INTEGER(i_std), SAVE, PUBLIC :: month_end !! Month at end of current time step |
|---|
| 67 | !$OMP THREADPRIVATE(month_end) |
|---|
| 68 | INTEGER(i_std), SAVE, PUBLIC :: day_end !! Day in month at end of current time step |
|---|
| 69 | !$OMP THREADPRIVATE(day_end) |
|---|
| 70 | REAL(r_std), SAVE, PUBLIC :: sec_end !! Seconds in the day at end of current time step |
|---|
| 71 | !$OMP THREADPRIVATE(sec_end) |
|---|
| 72 | CHARACTER(LEN=6), SAVE, PUBLIC :: tstepint_type !! Position of time step in the time interval |
|---|
| 73 | !$OMP THREADPRIVATE(tstepint_type) |
|---|
| 74 | INTEGER(i_std), PUBLIC :: month_len !! Lenght of current month (d) |
|---|
| 75 | !$OMP THREADPRIVATE(month_len) |
|---|
| 76 | INTEGER(i_std), PRIVATE :: year_length !! Lenght of current year in time step (tstp) |
|---|
| 77 | !$OMP THREADPRIVATE(year_length) |
|---|
| 78 | INTEGER(i_std), PUBLIC :: year_length_in_days!! Length of current year in days |
|---|
| 79 | !$OMP THREADPRIVATE(year_length_in_days) |
|---|
| 80 | REAL(r_std), PUBLIC :: one_day !! Lenght of one day in seconds (s) |
|---|
| 81 | !$OMP THREADPRIVATE(one_day) |
|---|
| 82 | REAL(r_std), PUBLIC :: one_year !! Length of current year in days (d) |
|---|
| 83 | !$OMP THREADPRIVATE(one_year) |
|---|
| 84 | REAL(r_std), PARAMETER, PUBLIC :: one_hour = 3600.0 !! Lenght of hour in seconds (s) |
|---|
| 85 | |
|---|
| 86 | LOGICAL, PUBLIC :: FirstTsYear !! Flag is true for the first sechiba time step on the year. |
|---|
| 87 | !$OMP THREADPRIVATE(FirstTsYear) |
|---|
| 88 | LOGICAL, PUBLIC :: LastTsYear !! Flag is true for the last sechiba time step of the year, previously named EndOfYear |
|---|
| 89 | !$OMP THREADPRIVATE(LastTsYear) |
|---|
| 90 | LOGICAL, PUBLIC :: FirstTsMonth !! Flag is true for the first sechiba time step of the month. |
|---|
| 91 | !$OMP THREADPRIVATE(FirstTsMonth) |
|---|
| 92 | LOGICAL, PUBLIC :: LastTsMonth !! Flag is true for the last sechiba time step of the month. |
|---|
| 93 | !$OMP THREADPRIVATE(LastTsMonth) |
|---|
| 94 | LOGICAL, PUBLIC :: FirstTsDay !! Flag is true for the first sechiba time step of the day. |
|---|
| 95 | !$OMP THREADPRIVATE(FirstTsDay) |
|---|
| 96 | LOGICAL, PUBLIC :: LastTsDay !! Flag is true for the last sechiba time step of the day. |
|---|
| 97 | !$OMP THREADPRIVATE(LastTsDay) |
|---|
| 98 | REAL(r_std), SAVE, PUBLIC :: date0_save !! Start date of simulation, in juilan calendar |
|---|
| 99 | !$OMP THREADPRIVATE(date0_save) |
|---|
| 100 | REAL(r_std), PUBLIC :: julian_diff !! Days since the beginning of current year |
|---|
| 101 | !$OMP THREADPRIVATE(julian_diff) |
|---|
| 102 | REAL(r_std), PUBLIC :: julian_start !! Beginning of the interval for current time step, in juilan calendar |
|---|
| 103 | !$OMP THREADPRIVATE(julian_start) |
|---|
| 104 | REAL(r_std), PUBLIC :: julian_end !! End of the interval for current time step, in juilan calendar |
|---|
| 105 | !$OMP THREADPRIVATE(julian_end) |
|---|
| 106 | REAL(r_std), SAVE, PUBLIC :: julian0 !! First day of this year in julian caledrier |
|---|
| 107 | !$OMP THREADPRIVATE(julian0) |
|---|
| 108 | INTEGER(i_std), SAVE, PRIVATE :: printlev_loc !! Local level of text output for current module |
|---|
| 109 | !$OMP THREADPRIVATE(printlev_loc) |
|---|
| 110 | |
|---|
| 111 | INTEGER(i_std), SAVE, PUBLIC :: day_of_year !! Current day of the year |
|---|
| 112 | !$OMP THREADPRIVATE(day_of_year) |
|---|
| 113 | INTEGER(i_std), SAVE, PUBLIC :: year0 !! First year of the simulation |
|---|
| 114 | !$OMP THREADPRIVATE(year0) |
|---|
| 115 | INTEGER(i_std), SAVE, PUBLIC :: month0 !! First month of the simulation |
|---|
| 116 | !$OMP THREADPRIVATE(month0) |
|---|
| 117 | INTEGER(i_std), SAVE, PUBLIC :: day0 !! First day of the simulation |
|---|
| 118 | !$OMP THREADPRIVATE(day0) |
|---|
| 119 | REAL(r_std), SAVE, PUBLIC :: sec0 !! First sec of the simulation |
|---|
| 120 | !$OMP THREADPRIVATE(sec0) |
|---|
| 121 | |
|---|
| 122 | CONTAINS |
|---|
| 123 | |
|---|
| 124 | !! ============================================================================================================================= |
|---|
| 125 | !! SUBROUTINE: time_initialize() |
|---|
| 126 | !! |
|---|
| 127 | !>\BRIEF Initalize time information |
|---|
| 128 | !! |
|---|
| 129 | !! DESCRIPTION: Initialize time information. This subroutine is called only in the intialization phase of the model and gives |
|---|
| 130 | !! the basic information on the calendar and time interval. |
|---|
| 131 | !! |
|---|
| 132 | !! \n |
|---|
| 133 | !_ ============================================================================================================================== |
|---|
| 134 | |
|---|
| 135 | SUBROUTINE time_initialize(kjit, date0_loc, dt_sechiba_loc, tstepint) |
|---|
| 136 | |
|---|
| 137 | !! 0.1 Input arguments |
|---|
| 138 | INTEGER(i_std), INTENT(in) :: kjit !! Time step of the restart file |
|---|
| 139 | REAL(r_std), INTENT(in) :: date0_loc !! The date at which kjit=0 |
|---|
| 140 | REAL(r_std), INTENT(in) :: dt_sechiba_loc !! Time step of sechiba component |
|---|
| 141 | CHARACTER(LEN=*), INTENT(in) :: tstepint !! Position of the time stamp: beginning, centre or end of time step |
|---|
| 142 | !! Possible values for tstepint : START, CENTER, END |
|---|
| 143 | REAL(r_std) :: julian0_start |
|---|
| 144 | |
|---|
| 145 | !! Initialize local printlev variable |
|---|
| 146 | !! It is not possible here to use the function get_printlev for problems with circular dependecies between modules |
|---|
| 147 | printlev_loc=printlev |
|---|
| 148 | CALL getin_p('PRINTLEV_time', printlev_loc) |
|---|
| 149 | |
|---|
| 150 | !! Save length of sechiba time step in module variable |
|---|
| 151 | !! Time step for sechiba comes from the atmospheric model or from the |
|---|
| 152 | !! offline driver which reads it from parameter DT_SECHIBA |
|---|
| 153 | dt_sechiba = dt_sechiba_loc |
|---|
| 154 | |
|---|
| 155 | !! Save tstepint in global variable |
|---|
| 156 | tstepint_type = tstepint |
|---|
| 157 | IF (tstepint_type /= "START" .AND. tstepint_type /= "END") THEN |
|---|
| 158 | WRITE(numout,*) 'Unknown option for time interval, tstepint_type=', tstepint_type |
|---|
| 159 | CALL ipslerr_p(3,'time_initialize', 'Unknown time iterval type.',& |
|---|
| 160 | 'The time stamp given can have 2 position on the interval :',' START or END') |
|---|
| 161 | END IF |
|---|
| 162 | |
|---|
| 163 | !! Save the start date in the module |
|---|
| 164 | date0_save = date0_loc |
|---|
| 165 | |
|---|
| 166 | !! Get the calendar from IOIPSL, it is already initialized |
|---|
| 167 | CALL ioget_calendar(calendar_str) |
|---|
| 168 | |
|---|
| 169 | !! Get year lenght in days and day lenght in seconds |
|---|
| 170 | CALL ioget_calendar(one_year, one_day) |
|---|
| 171 | |
|---|
| 172 | !! Get the number of sechiba time steps for 1 year (for the current year) |
|---|
| 173 | CALL tlen2itau('1Y', dt_sechiba, date0_save, year_length) |
|---|
| 174 | |
|---|
| 175 | !Config Key = DT_STOMATE |
|---|
| 176 | !Config Desc = Time step of STOMATE and other slow processes |
|---|
| 177 | !Config If = OK_STOMATE |
|---|
| 178 | !Config Def = one_day |
|---|
| 179 | !Config Help = Time step (s) of regular update of vegetation |
|---|
| 180 | !Config cover, LAI etc. This is also the time step of STOMATE. |
|---|
| 181 | !Config Units = [seconds] |
|---|
| 182 | dt_stomate = one_day |
|---|
| 183 | CALL getin_p('DT_STOMATE', dt_stomate) |
|---|
| 184 | |
|---|
| 185 | !! Find starting year of the simulation |
|---|
| 186 | julian0_start = itau2date(kjit, date0_save, dt_sechiba) |
|---|
| 187 | CALL ju2ymds (julian0_start, year0, month0, day0, sec0) |
|---|
| 188 | |
|---|
| 189 | IF (printlev_loc >=1) THEN |
|---|
| 190 | WRITE(numout,*) "time_initialize : calendar_str= ",calendar_str |
|---|
| 191 | WRITE(numout,*) "time_initialize : dt_sechiba(s)= ",dt_sechiba," dt_stomate(s)= ", dt_stomate |
|---|
| 192 | WRITE(numout,*) "time_initialize : date0_save= ",date0_save," kjit= ",kjit |
|---|
| 193 | WRITE(numout,*) "time_initialize : year0, month0, day0, sec0 =", & |
|---|
| 194 | year0, month0, day0, sec0 |
|---|
| 195 | ENDIF |
|---|
| 196 | |
|---|
| 197 | CALL time_nextstep(kjit) |
|---|
| 198 | |
|---|
| 199 | END SUBROUTINE time_initialize |
|---|
| 200 | |
|---|
| 201 | !! ============================================================================================================================= |
|---|
| 202 | !! SUBROUTINE: time_nextstep() |
|---|
| 203 | !! |
|---|
| 204 | !>\BRIEF Update the time information for the next time step. |
|---|
| 205 | !! |
|---|
| 206 | !! DESCRIPTION: This subroutine will place in the public variables of the module all the time information |
|---|
| 207 | !! needed by ORCHIDEE for this new time step. |
|---|
| 208 | !! |
|---|
| 209 | !! \n |
|---|
| 210 | !_ ============================================================================================================================== |
|---|
| 211 | SUBROUTINE time_nextstep(kjit) |
|---|
| 212 | |
|---|
| 213 | !! 0.1 Input variables |
|---|
| 214 | INTEGER(i_std), INTENT(in) :: kjit !! Current time step |
|---|
| 215 | |
|---|
| 216 | |
|---|
| 217 | !! Calculate the new time interval for current time step |
|---|
| 218 | CALL time_interval(kjit, year_start, month_start, day_start, sec_start, & |
|---|
| 219 | year_end, month_end, day_end, sec_end) |
|---|
| 220 | |
|---|
| 221 | !! Calculate julian0: the julian date for the 1st of January in current year |
|---|
| 222 | CALL ymds2ju(year_start,1,1,zero, julian0) |
|---|
| 223 | |
|---|
| 224 | !! Caluclate julian_diff: The diffrence of the end of current time-step and the beginning of the year in julian days |
|---|
| 225 | julian_diff = julian_end - julian0 |
|---|
| 226 | |
|---|
| 227 | !! Update variables for year length |
|---|
| 228 | CALL ioget_calendar(one_year, one_day) |
|---|
| 229 | CALL tlen2itau('1Y', dt_sechiba, date0_save, year_length) |
|---|
| 230 | |
|---|
| 231 | !! Calculate number of days in the current month, using the start of the time-interval for current time-step |
|---|
| 232 | month_len = ioget_mon_len(year_start,month_start) |
|---|
| 233 | |
|---|
| 234 | !! Calculate current day of the year |
|---|
| 235 | day_of_year = time_get_day_of_year(year_start, month_start, day_start) |
|---|
| 236 | |
|---|
| 237 | !! Calculate the length of the current year in days |
|---|
| 238 | year_length_in_days = ioget_year_len(year_start) |
|---|
| 239 | |
|---|
| 240 | !! Calculate logical variables true if the current time-step corresponds to the end or beggining of a day, month or year |
|---|
| 241 | FirstTsDay = .FALSE. |
|---|
| 242 | FirstTsMonth = .FALSE. |
|---|
| 243 | FirstTsYear = .FALSE. |
|---|
| 244 | LastTsDay = .FALSE. |
|---|
| 245 | LastTsMonth = .FALSE. |
|---|
| 246 | LastTsYear = .FALSE. |
|---|
| 247 | |
|---|
| 248 | IF (sec_start >= -1 .AND. sec_start < dt_sechiba-1 ) THEN |
|---|
| 249 | FirstTsDay = .TRUE. |
|---|
| 250 | IF ( day_start == 1 ) THEN |
|---|
| 251 | FirstTsMonth = .TRUE. |
|---|
| 252 | IF ( month_start == 1) THEN |
|---|
| 253 | FirstTsYear = .TRUE. |
|---|
| 254 | END IF |
|---|
| 255 | END IF |
|---|
| 256 | ELSE IF (sec_start >= one_day-dt_sechiba-1 .AND. sec_start < one_day-1 ) THEN |
|---|
| 257 | LastTsDay = .TRUE. |
|---|
| 258 | IF ( day_start == month_len ) THEN |
|---|
| 259 | LastTsMonth = .TRUE. |
|---|
| 260 | IF ( month_start == 12) THEN |
|---|
| 261 | LastTsYear = .TRUE. |
|---|
| 262 | END IF |
|---|
| 263 | END IF |
|---|
| 264 | END IF |
|---|
| 265 | |
|---|
| 266 | !! Write debug information depending on printlev_loc. |
|---|
| 267 | IF ( ((printlev_loc >= 4) .OR. (printlev_loc >=2 .AND. FirstTsMonth)) .OR. (printlev_loc>=1 .AND. FirstTsYear)) THEN |
|---|
| 268 | WRITE(numout,*) "time_nextstep: Time interval for time step :", kjit |
|---|
| 269 | WRITE(numout,"(' time_nextstep: Start of interval ', I4.4,'-',I2.2,'-',I2.2,' ',F12.4)") & |
|---|
| 270 | year_start, month_start, day_start, sec_start |
|---|
| 271 | WRITE(numout,"(' time_nextstep: End of interval ', I4.4,'-',I2.2,'-',I2.2,' ',F12.4)") & |
|---|
| 272 | year_end, month_end, day_end, sec_end |
|---|
| 273 | WRITE(numout,*) "time_nextstep: month_len=",month_len, " one_year=",one_year |
|---|
| 274 | WRITE(numout,*) "" |
|---|
| 275 | END IF |
|---|
| 276 | IF (printlev_loc >= 4) THEN |
|---|
| 277 | WRITE(numout,*) "time_nextstep: FirstTsDay=", FirstTsDay," FirstTsMonth=",FirstTsMonth," FirstTsYear=", FirstTsYear |
|---|
| 278 | WRITE(numout,*) "time_nextstep: LastTsDay=", LastTsDay," LastTsMonth=",LastTsMonth," LastTsYear=", LastTsYear |
|---|
| 279 | WRITE(numout,*) "time_nextstep: julian0=",julian0, " julian_diff=",julian_diff |
|---|
| 280 | WRITE(numout,*) "time_nextstep: day_of_year=", day_of_year |
|---|
| 281 | WRITE(numout,*) "" |
|---|
| 282 | END IF |
|---|
| 283 | IF ((printlev_loc >= 2) .AND. FirstTsDay) THEN |
|---|
| 284 | WRITE(numout,"(' Date: ', I4.4,'-',I2.2,'-',I2.2,' ',F8.4,'sec at timestep ',I12.4)") & |
|---|
| 285 | year_start, month_start, day_start, sec_start, kjit |
|---|
| 286 | END IF |
|---|
| 287 | |
|---|
| 288 | END SUBROUTINE time_nextstep |
|---|
| 289 | |
|---|
| 290 | !! ============================================================================================================================= |
|---|
| 291 | !! SUBROUTINE: time_interval() |
|---|
| 292 | !! |
|---|
| 293 | !>\BRIEF Computes the interval corresponging to the given time step. |
|---|
| 294 | !! |
|---|
| 295 | !! DESCRIPTION: This subroutine will compute the interval of time for the given time step. |
|---|
| 296 | !! It will use the tstepint_type variable which was set at initilisation. |
|---|
| 297 | !! |
|---|
| 298 | !! \n |
|---|
| 299 | !_ ============================================================================================================================== |
|---|
| 300 | |
|---|
| 301 | SUBROUTINE time_interval(kjit, year_s, month_s, day_s, sec_s, & |
|---|
| 302 | year_e, month_e, day_e, sec_e) |
|---|
| 303 | |
|---|
| 304 | !! 0.1 Input variables |
|---|
| 305 | INTEGER(i_std), INTENT(in) :: kjit !! Current time step |
|---|
| 306 | |
|---|
| 307 | !! 0.2 Output variables |
|---|
| 308 | INTEGER(i_std), INTENT(out) :: year_s, month_s, day_s |
|---|
| 309 | INTEGER(i_std), INTENT(out) :: year_e, month_e, day_e |
|---|
| 310 | REAL(r_std), INTENT(out) :: sec_s |
|---|
| 311 | REAL(r_std), INTENT(out) :: sec_e |
|---|
| 312 | |
|---|
| 313 | |
|---|
| 314 | !! Calculate the interval for current time step |
|---|
| 315 | !! tstepint_type is used to know how the interval is defined around the time-stamp of the time-step |
|---|
| 316 | SELECT CASE (TRIM(tstepint_type)) |
|---|
| 317 | CASE ("START ") |
|---|
| 318 | !! Calculate the start date of the interval |
|---|
| 319 | julian_start = itau2date(kjit, date0_save, dt_sechiba) |
|---|
| 320 | !! Calculate the end date of the interval using kjti+1 |
|---|
| 321 | julian_end = itau2date(kjit+1, date0_save, dt_sechiba) |
|---|
| 322 | CASE("END") |
|---|
| 323 | !! Calculate the start date of the interval |
|---|
| 324 | julian_start = itau2date(kjit-1, date0_save, dt_sechiba) |
|---|
| 325 | !! Calculate the end date of the interval |
|---|
| 326 | julian_end = itau2date(kjit, date0_save, dt_sechiba) |
|---|
| 327 | CASE DEFAULT |
|---|
| 328 | WRITE(numout,*) "time_interval: tstepint_type = ", tstepint_type |
|---|
| 329 | CALL ipslerr_p(3,'time_interval', 'Unknown time iterval type.', & |
|---|
| 330 | 'The time stamp given can have 3 position on the interval :',' START, CENTER or END') |
|---|
| 331 | END SELECT |
|---|
| 332 | |
|---|
| 333 | !! Calculate year, month, day and sec for julian_start date |
|---|
| 334 | CALL ju2ymds (julian_start, year_s, month_s, day_s, sec_s) |
|---|
| 335 | |
|---|
| 336 | !! Calculate year, month, day and sec for julian_end date |
|---|
| 337 | CALL ju2ymds (julian_end, year_e, month_e, day_e, sec_e) |
|---|
| 338 | |
|---|
| 339 | |
|---|
| 340 | END SUBROUTINE time_interval |
|---|
| 341 | |
|---|
| 342 | !! ============================================================================================================================= |
|---|
| 343 | !! SUBROUTINE: time_get_day_of_year |
|---|
| 344 | !! |
|---|
| 345 | !>\BRIEF Calculates day of the year |
|---|
| 346 | !! |
|---|
| 347 | !! DESCRIPTION: Calculates day of the year for a given date |
|---|
| 348 | !! Algorithm: |
|---|
| 349 | !! http://www.herongyang.com/year/Program-Gregorian-Calendar-Algorithm.html |
|---|
| 350 | !! |
|---|
| 351 | !! |
|---|
| 352 | !! \n |
|---|
| 353 | !_ ============================================================================================================================== |
|---|
| 354 | INTEGER FUNCTION time_get_day_of_year(year, month, day) |
|---|
| 355 | ! 0.1 Input variables |
|---|
| 356 | INTEGER(i_std), INTENT(in) :: year, month, day |
|---|
| 357 | |
|---|
| 358 | ! 0.4 Local variables |
|---|
| 359 | INTEGER(i_std) :: calc_days, item |
|---|
| 360 | INTEGER(i_std) :: days_in_month |
|---|
| 361 | |
|---|
| 362 | ! WRITE(*,*) "time_get_day_of_year:: input, year, month, day==", year, month, day |
|---|
| 363 | |
|---|
| 364 | ! ! Check for consistency |
|---|
| 365 | ! IF (day .GT. days_in_month) |
|---|
| 366 | ! CALL ipslerr_p(3, 'time_get_day_of_year','Incorrent date', & |
|---|
| 367 | ! 'Max number of days expected:'//days_in_month , & |
|---|
| 368 | ! 'But found:'//day ) |
|---|
| 369 | ! ENDIF |
|---|
| 370 | |
|---|
| 371 | |
|---|
| 372 | calc_days = 0 |
|---|
| 373 | DO item = 1, month-1 |
|---|
| 374 | calc_days=calc_days + ioget_mon_len(year, item) |
|---|
| 375 | ENDDO |
|---|
| 376 | |
|---|
| 377 | time_get_day_of_year = calc_days + day |
|---|
| 378 | |
|---|
| 379 | END FUNCTION time_get_day_of_year |
|---|
| 380 | |
|---|
| 381 | END MODULE time |
|---|
