00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021 module ice_calendar
00022
00023
00024
00025 use ice_constants
00026 use ice_domain_size, only: max_nstrm
00027 use ice_exit, only: abort_ice
00028
00029
00030
00031 implicit none
00032 save
00033
00034 integer (kind=int_kind) ::
00035 days_per_year ,
00036 daymo(12) ,
00037 daycal(13)
00038
00039
00040 integer (kind=int_kind) ::
00041 daymo360(12) ,
00042 daycal360(13)
00043 data daymo360 / 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30/
00044 data daycal360/ 0,30, 60, 90,120,150,180,210,240,270,300,330,360/
00045
00046
00047 integer (kind=int_kind) ::
00048 daymo365(12) ,
00049 daycal365(13)
00050 data daymo365 / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/
00051 data daycal365/ 0,31, 59, 90,120,151,181,212,243,273,304,334,365/
00052
00053
00054 integer (kind=int_kind) ::
00055 daymo366(12) ,
00056 daycal366(13)
00057 data daymo366 / 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/
00058 data daycal366/ 0,31, 60, 91,121,152,182,213,244,274,305,335,366/
00059
00060 integer (kind=int_kind) ::
00061 istep ,
00062 istep0 ,
00063 istep1 ,
00064 mday ,
00065 hour ,
00066 month ,
00067 monthp ,
00068 year_init,
00069 nyr ,
00070 idate ,
00071 idate0 ,
00072 sec ,
00073 npt ,
00074 stop_now ,
00075 write_restart,
00076 diagfreq ,
00077 dumpfreq_n ,
00078 nstreams ,
00079 histfreq_n(max_nstrm)
00080
00081 real (kind=dbl_kind) ::
00082 dt ,
00083 dt_thm ,
00084 dt_dyn ,
00085 time ,
00086 time_forc ,
00087 yday ,
00088 nextsw_cday ,
00089 tday ,
00090 xndt_dyn ,
00091 dayyr
00092
00093 logical (kind=log_kind) ::
00094 new_year ,
00095 new_month ,
00096 new_day ,
00097 new_hour ,
00098 write_ic ,
00099 write_history(max_nstrm)
00100
00101 character (len=1) ::
00102 histfreq(max_nstrm) ,
00103 dumpfreq
00104
00105 character (len=char_len) :: calendar_type
00106
00107 integer :: nleaps = 0
00108
00109
00110
00111
00112 contains
00113
00114
00115
00116
00117
00118
00119
00120
00121 subroutine init_calendar
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138 integer (kind=int_kind) ::
00139 k ,
00140
00141 istep = 0
00142 time=istep0*dt
00143 #ifdef CCSMCOUPLED
00144 time_forc = c0
00145 #endif
00146 yday=c0
00147 mday=0
00148 month=0
00149 nyr=0
00150 idate=00000101
00151 sec=0
00152 istep1 = istep0
00153
00154 stop_now = 0
00155 dt_thm = dt
00156 dt_dyn = dt/xndt_dyn
00157
00158 dayyr = real(days_per_year, kind=dbl_kind)
00159
00160
00161
00162 sec = mod(time,secday)
00163
00164 tday = (time-sec)/secday + c1
00165
00166
00167 if (calendar_type == "GREGORIAN") then
00168
00169 nyr = int((tday-c1)*real(400.,kind=dbl_kind)/(400*365 + 97 )) + 1
00170 else
00171 nyr = int((tday-c1)/dayyr) + 1
00172 endif
00173
00174
00175 call get_daycal(year=nyr+year_init-1,days_per_year_in=days_per_year,&
00176 daycal_out=daycal,daymo_out=daymo)
00177
00178
00179 yday = tday-nleaps - (nyr-1)*dayyr
00180
00181 do k = 1, 12
00182 if (yday > real(daycal(k),kind=dbl_kind)) month = k
00183 enddo
00184 mday = int(yday) - daycal(month)
00185
00186 idate0 = (nyr+year_init-1)*10000 + month*100 + mday
00187
00188 end subroutine init_calendar
00189
00190
00191
00192
00193
00194
00195
00196
00197 subroutine calendar(ttime)
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209 use ice_fileunits
00210 use ice_communicate, only: my_task, master_task
00211
00212
00213
00214 real (kind=dbl_kind), intent(in) ::
00215 ttime
00216
00217
00218
00219 integer (kind=int_kind) ::
00220 k, ns ,
00221 nyrp,mdayp,hourp ,
00222 elapsed_days ,
00223 elapsed_months ,
00224 elapsed_hours
00225
00226 nyrp=nyr
00227 monthp=month
00228 mdayp=mday
00229 hourp=hour
00230 new_year=.false.
00231 new_month=.false.
00232 new_day=.false.
00233 new_hour=.false.
00234 write_history(:)=.false.
00235 write_restart=0
00236
00237 sec = mod(ttime,secday)
00238
00239 tday = (ttime-sec)/secday + c1
00240
00241
00242 if (calendar_type == "GREGORIAN") then
00243
00244 nyr = int((tday-c1)*real(400.,kind=dbl_kind)/(400*365 + 97 )) + 1
00245
00246 else
00247 nyr = int((tday-c1)/dayyr) + 1
00248 endif
00249
00250
00251
00252
00253 nleaps = leap_year_count(nyr+year_init-1)
00254
00255
00256 call get_daycal(year=nyr+year_init-1,days_per_year_in=days_per_year,&
00257 daycal_out=daycal)
00258
00259
00260 yday = tday-nleaps - (nyr-1)*dayyr
00261
00262
00263 do k = 1, 12
00264 if (yday > real(daycal(k),kind=dbl_kind)) month = k
00265 enddo
00266 mday = int(yday) - daycal(month)
00267
00268 hour = int((ttime-dt)/c3600) + c1
00269
00270
00271 elapsed_months = (nyr - 1)*12 + month - 1
00272 elapsed_days = int(tday) - 1
00273 elapsed_hours = int(ttime/3600)
00274
00275 idate = (nyr+year_init-1)*10000 + month*100 + mday
00276
00277 #ifndef CCSMCOUPLED
00278 if (istep >= npt+1) stop_now = 1
00279 #endif
00280
00281 if (nyr /= nyrp) new_year = .true.
00282 if (month /= monthp) new_month = .true.
00283 if (mday /= mdayp) new_day = .true.
00284 if (hour /= hourp) new_hour = .true.
00285
00286
00287 do ns = 1, nstreams
00288 if (histfreq(ns)=='1' .and. histfreq_n(ns)/=0) then
00289 if (mod(istep1, histfreq_n(ns))==0) &
00290 write_history(ns)=.true.
00291 endif
00292 enddo
00293
00294 if (istep > 1) then
00295
00296 do ns = 1, nstreams
00297
00298 select case (histfreq(ns))
00299 case ("y", "Y")
00300 if (new_year .and. histfreq_n(ns)/=0) then
00301 if (mod(nyr, histfreq_n(ns))==0) &
00302 write_history(ns) = .true.
00303 endif
00304 case ("m", "M")
00305 if (new_month .and. histfreq_n(ns)/=0) then
00306 if (mod(elapsed_months,histfreq_n(ns))==0) &
00307 write_history(ns) = .true.
00308 endif
00309 case ("d", "D")
00310 if (new_day .and. histfreq_n(ns)/=0) then
00311 if (mod(elapsed_days,histfreq_n(ns))==0) &
00312 write_history(ns) = .true.
00313 endif
00314 case ("h", "H")
00315 if (new_hour .and. histfreq_n(ns)/=0) then
00316 if (mod(elapsed_hours,histfreq_n(ns))==0) &
00317 write_history(ns) = .true.
00318 endif
00319 end select
00320
00321 enddo
00322
00323 select case (dumpfreq)
00324 case ("y", "Y")
00325 if (new_year .and. mod(nyr, dumpfreq_n)==0) &
00326 write_restart = 1
00327 case ("m", "M")
00328 if (new_month .and. mod(elapsed_months,dumpfreq_n)==0) &
00329 write_restart=1
00330 case ("d", "D")
00331 if (new_day .and. mod(elapsed_days, dumpfreq_n)==0) &
00332 write_restart = 1
00333 case default
00334 call abort_ice('ice_calendar: Invalid dumpfreq: '//dumpfreq)
00335 end select
00336 endif
00337
00338 if (my_task == master_task .and. mod(istep,diagfreq) == 0 &
00339 .and. stop_now /= 1) then
00340 write(nu_diag,*) ' '
00341 write(nu_diag,'(a7,i10,4x,a6,i10,4x,a4,i10)') &
00342 'istep1:', istep1, 'idate:', idate, 'sec:', sec
00343 endif
00344
00345 end subroutine calendar
00346
00347
00348 subroutine get_daycal(year,days_per_year_in,daycal_out,daymo_out)
00349
00350
00351 integer, intent(in), optional :: year
00352 integer, intent(in), optional :: days_per_year_in
00353 integer, intent(out), optional :: daycal_out(13)
00354 integer, intent(out), optional :: daymo_out(12)
00355
00356
00357 integer (kind=int_kind) ::
00358 daymo360(12) ,
00359 daycal360(13)
00360 data daymo360 / 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30/
00361 data daycal360/ 0,30, 60, 90,120,150,180,210,240,270,300,330,360/
00362
00363
00364 integer (kind=int_kind) ::
00365 daymo365(12) ,
00366 daycal365(13)
00367 data daymo365 / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/
00368 data daycal365/ 0,31, 59, 90,120,151,181,212,243,273,304,334,365/
00369
00370
00371 integer (kind=int_kind) ::
00372 daycal366(13)
00373 data daycal366/ 0,31, 60, 91,121,152,182,213,244,274,305,335,366/
00374
00375
00376 if ( present(daymo_out) ) then
00377 if ( .not. present(days_per_year_in)) &
00378 call abort_ice('ice: get_daycal needs days_per_year_in to return daymo_out')
00379 if (days_per_year_in.eq.360) then
00380 daymo_out = daymo360
00381 elseif (days_per_year_in.eq.365) then
00382 daymo_out = daymo365
00383 else
00384 call abort_ice('ice: year must have 360 or 365 days')
00385 endif
00386 endif
00387
00388 if ( present(daycal_out) ) then
00389
00390
00391 daycal_out(:) = 0
00392
00393
00394 if ( present(days_per_year_in) ) then
00395 if (days_per_year_in.eq.360) then
00396 daycal_out = daycal360
00397 elseif (days_per_year_in.eq.365) then
00398 daycal_out = daycal365
00399 else
00400 call abort_ice('ice: year must have 360 or 365 days')
00401 endif
00402 endif
00403
00404
00405 if (calendar_type == "GREGORIAN") then
00406 if ( .not. present(year) ) &
00407 call abort_ice('ice: get_daycal needs year to return daycal_out for Gregorian calendar')
00408 if ( is_leap_year(year) ) then
00409 daycal_out = daycal366
00410 else
00411 daycal_out = daycal365
00412 endif
00413 endif
00414
00415 if ( daycal_out(13) .eq. 0 ) call abort_ice('ice: get_daycal failed to set daycal_out')
00416
00417 endif
00418
00419
00420 end subroutine get_daycal
00421
00422
00423
00424 logical function is_leap_year(year)
00425
00426
00427
00428 integer, intent(in) :: year
00429
00430 is_leap_year = .false.
00431 if (mod(year, 4) == 0) is_leap_year = .true.
00432 if (mod(year,100) == 0) is_leap_year = .false.
00433 if (mod(year,400) == 0) is_leap_year = .true.
00434
00435 end function is_leap_year
00436
00437
00438 integer function leap_year_count(Y)
00439
00440
00441
00442 integer, intent(in) :: Y
00443
00444
00445 if (calendar_type == "GREGORIAN") then
00446
00447 if ( Y .lt. 0 ) then
00448 leap_year_count = 0
00449 write(6,*) 'WARNING: leap_year_count for year ',Y,'assumes no leap years before year 0'
00450 else
00451 leap_year_count = ( (Y-1)/4 - (Y-1)/100 + (Y-1)/400 ) + 1
00452 endif
00453 else
00454 leap_year_count = 0
00455 endif
00456
00457
00458 nleaps = leap_year_count
00459
00460 return
00461
00462 end function leap_year_count
00463
00464
00465
00466 end module ice_calendar
00467
00468