- Timestamp:
- 2013-01-23T15:33:04+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r3680 r3764 2 2 !!====================================================================== 3 3 !! *** MODULE daymod *** 4 !! Ocean : calendar 4 !! Ocean : calendar 5 5 !!===================================================================== 6 6 !! History : OPA ! 1994-09 (M. Pontaud M. Imbard) Original code 7 7 !! ! 1997-03 (O. Marti) 8 !! ! 1997-05 (G. Madec) 8 !! ! 1997-05 (G. Madec) 9 9 !! ! 1997-08 (M. Imbard) 10 10 !! NEMO 1.0 ! 2003-09 (G. Madec) F90 + nyear, nmonth, nday 11 11 !! ! 2004-01 (A.M. Treguier) new calculation based on adatrj 12 12 !! ! 2006-08 (G. Madec) surface module major update 13 !!---------------------------------------------------------------------- 13 !!---------------------------------------------------------------------- 14 14 15 15 !!---------------------------------------------------------------------- 16 16 !! day : calendar 17 !! 17 !! 18 18 !! ------------------------------- 19 19 !! ----------- WARNING ----------- … … 24 24 !! ----------- WARNING ----------- 25 25 !! ------------------------------- 26 !! 26 !! 27 27 !!---------------------------------------------------------------------- 28 28 USE dom_oce ! ocean space and time domain 29 29 USE phycst ! physical constants 30 30 USE in_out_manager ! I/O manager 31 USE iom ! 31 USE iom ! 32 32 USE ioipsl, ONLY : ymds2ju ! for calendar 33 33 USE prtctl ! Print control … … 41 41 PUBLIC day ! called by step.F90 42 42 PUBLIC day_init ! called by istate.F90 43 44 INTEGER :: nsecd, nsecd05, ndt, ndt05 43 PUBLIC day_mth ! Needed by TAM 44 45 INTEGER, PUBLIC :: nsecd, nsecd05, ndt, ndt05 ! (PUBLIC for TAM) 45 46 46 47 !!---------------------------------------------------------------------- … … 54 55 !!---------------------------------------------------------------------- 55 56 !! *** ROUTINE day_init *** 56 !! 57 !! ** Purpose : Initialization of the calendar values to their values 1 time step before nit000 57 !! 58 !! ** Purpose : Initialization of the calendar values to their values 1 time step before nit000 58 59 !! because day will be called at the beginning of step 59 60 !! … … 81 82 ndt05 = NINT(0.5 * rdttra(1)) 82 83 83 IF( .NOT. lk_offline ) CALL day_rst( nit000, 'READ' ) 84 IF( .NOT. lk_offline ) CALL day_rst( nit000, 'READ' ) 84 85 85 86 ! set the calandar from ndastp (read in restart file and namelist) … … 87 88 nyear = ndastp / 10000 88 89 nmonth = ( ndastp - (nyear * 10000) ) / 100 89 nday = ndastp - (nyear * 10000) - ( nmonth * 100 ) 90 nday = ndastp - (nyear * 10000) - ( nmonth * 100 ) 90 91 91 92 CALL ymds2ju( nyear, nmonth, nday, 0.0, fjulday ) ! we assume that we start run at 00:00 … … 95 96 nsec1jan000 = 0 96 97 CALL day_mth 97 98 98 99 IF ( nday == 0 ) THEN ! for ex if ndastp = ndate0 - 1 99 nmonth = nmonth - 1 100 nmonth = nmonth - 1 100 101 nday = nmonth_len(nmonth) 101 102 ENDIF … … 106 107 IF( nleapy == 1 ) CALL day_mth 107 108 ENDIF 108 109 109 110 ! day since january 1st 110 111 nday_year = nday + SUM( nmonth_len(1:nmonth - 1) ) 111 112 112 !compute number of days between last monday and today 113 !compute number of days between last monday and today 113 114 CALL ymds2ju( 1900, 01, 01, 0.0, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday) 114 inbday = NINT(fjulday - zjul) ! compute nb day between 01.01.1900 and current day 115 idweek = MOD(inbday, 7) ! compute nb day between last monday and current day 115 inbday = NINT(fjulday - zjul) ! compute nb day between 01.01.1900 and current day 116 idweek = MOD(inbday, 7) ! compute nb day between last monday and current day 116 117 117 118 ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step … … 135 136 !!---------------------------------------------------------------------- 136 137 !! *** ROUTINE day_init *** 137 !! 138 !! 138 139 !! ** Purpose : calendar values related to the months 139 140 !! … … 147 148 148 149 ! length of the month of the current year (from nleapy, read in namelist) 149 IF ( nleapy < 2 ) THEN 150 IF ( nleapy < 2 ) THEN 150 151 nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /) 151 152 nyear_len(:) = 365 … … 167 168 ! time since Jan 1st 0 1 2 ... 11 12 13 168 169 ! ---------*--|--*--|--*--| ... |--*--|--*--|--*--|-------------------------------------- 169 ! <---> <---> <---> ... <---> <---> <---> 170 ! <---> <---> <---> ... <---> <---> <---> 170 171 ! month number 0 1 2 ... 11 12 13 171 172 ! … … 180 181 nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm) 181 182 END DO 182 ! 183 END SUBROUTINE 183 ! 184 END SUBROUTINE 184 185 185 186 … … 187 188 !!---------------------------------------------------------------------- 188 189 !! *** ROUTINE day *** 189 !! 190 !! 190 191 !! ** Purpose : Compute the date with a day iteration IF necessary. 191 192 !! … … 199 200 !! - adatrj : date in days since the beginning of the run 200 201 !! - nsec_year : current time of the year (in second since 00h, jan 1st) 201 !!---------------------------------------------------------------------- 202 !!---------------------------------------------------------------------- 202 203 INTEGER, INTENT(in) :: kt ! ocean time-step indices 203 204 ! … … 210 211 zprec = 0.1 / rday 211 212 ! ! New time-step 212 nsec_year = nsec_year + ndt 213 nsec_month = nsec_month + ndt 213 nsec_year = nsec_year + ndt 214 nsec_month = nsec_month + ndt 214 215 nsec_week = nsec_week + ndt 215 nsec_day = nsec_day + ndt 216 nsec_day = nsec_day + ndt 216 217 adatrj = adatrj + rdttra(1) / rday 217 218 fjulday = fjulday + rdttra(1) / rday 218 219 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 219 220 IF( ABS(adatrj - REAL(NINT(adatrj ),wp)) < zprec ) adatrj = REAL(NINT(adatrj ),wp) ! avoid truncation error 220 221 221 222 IF( nsec_day > nsecd ) THEN ! New day 222 223 ! … … 251 252 252 253 IF( nsec_week > 7*nsecd ) nsec_week = ndt05 ! New week 253 254 254 255 IF(ln_ctl) THEN 255 256 WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear … … 268 269 !!--------------------------------------------------------------------- 269 270 !! *** ROUTINE ts_rst *** 270 !! 271 !! 271 272 !! ** Purpose : Read or write calendar in restart file: 272 !! 273 !! 273 274 !! WRITE(READ) mode: 274 !! kt : number of time step since the begining of the experiment at the 275 !! kt : number of time step since the begining of the experiment at the 275 276 !! end of the current(previous) run 276 !! adatrj(0) : number of elapsed days since the begining of the experiment at the 277 !! adatrj(0) : number of elapsed days since the begining of the experiment at the 277 278 !! end of the current(previous) run (REAL -> keep fractions of day) 278 279 !! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer) 279 !! 280 !! 280 281 !! According to namelist parameter nrstdt, 281 282 !! nrstdt = 0 no control on the date (nit000 is arbitrary). … … 295 296 REAL(wp) :: zkt, zndastp 296 297 !!---------------------------------------------------------------------- 297 298 298 299 IF( TRIM(cdrw) == 'READ' ) THEN 299 300 … … 312 313 WRITE(numout,*) 313 314 ENDIF 314 ! Control of date 315 IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 ) & 316 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 315 ! Control of date 316 IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 ) & 317 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 317 318 & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 318 319 ! define ndastp and adatrj 319 IF ( nrstdt == 2 ) THEN 320 IF ( nrstdt == 2 ) THEN 320 321 ! read the parameters correspondting to nit000 - 1 (last time step of previous run) 321 322 CALL iom_get( numror, 'ndastp', zndastp ) 322 323 ndastp = NINT( zndastp ) 323 324 CALL iom_get( numror, 'adatrj', adatrj ) 324 ELSE 325 ELSE 325 326 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 326 327 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 327 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 328 ! note this is wrong if time step has changed during run 328 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 329 ! note this is wrong if time step has changed during run 329 330 ENDIF 330 331 ELSE 331 332 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 332 333 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 333 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 334 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 334 335 ENDIF 335 336 IF( ABS(adatrj - REAL(NINT(adatrj),wp)) < 0.1 / rday ) adatrj = REAL(NINT(adatrj),wp) ! avoid truncation error … … 347 348 IF(lwp) WRITE(numout,*) 348 349 IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file kt =', kt 349 IF(lwp) WRITE(numout,*) '~~~~~~~' 350 IF(lwp) WRITE(numout,*) '~~~~~~~' 350 351 ENDIF 351 352 ! calendar control 352 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step 353 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step 353 354 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) ) ! date 354 355 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj ) ! number of elapsed days since
Note: See TracChangeset
for help on using the changeset viewer.
