- Timestamp:
- 2019-12-09T08:53:27+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r12114_ticket_2263/src/OCE/DOM/daymod.F90
r10068 r12116 58 58 !! 59 59 !! ** Action : - nyear : current year 60 !! - nmonth : current month of the year nyear 61 !! - nday : current day of the month nmonth 62 !! - nday_year : current day of the year nyear 63 !! - nsec_year : current time step counted in second since 00h jan 1st of the current year 64 !! - nsec_month : current time step counted in second since 00h 1st day of the current month 65 !! - nsec_day : current time step counted in second since 00h of the current day 66 !! - nsec1jan000 : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year 67 !! - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 68 !!---------------------------------------------------------------------- 69 INTEGER :: inbday, idweek ! local integers 60 !! - nmonth : current month of the current nyear 61 !! - nday : current day of the current nmonth 62 !! - nday_year : current day of the current nyear 63 !! - nsec_year : seconds between 00h jan 1st of the current year and half of the current time step 64 !! - nsec_month : seconds between 00h 1st day of the current month and half of the current time step 65 !! - nsec_monday : seconds between 00h of the last Monday and half of the current time step 66 !! - nsec_day : seconds between 00h of the current day and half of the current time step 67 !! - nsec1jan000 : seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year 68 !! - nmonth_len, nyear_len, nmonth_beg through day_mth 69 !!---------------------------------------------------------------------- 70 INTEGER :: inbday, imonday, isecrst ! local integers 70 71 REAL(wp) :: zjul ! local scalar 71 72 !!---------------------------------------------------------------------- … … 76 77 & 'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 77 78 ENDIF 78 nsecd = NINT( rday)79 nsecd = NINT( rday ) 79 80 nsecd05 = NINT( 0.5 * rday ) 80 81 ndt = NINT( rdt ) … … 90 91 nhour = nn_time0 / 100 91 92 nminute = ( nn_time0 - nhour * 100 ) 92 93 CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday ) 93 isecrst = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss) 94 95 CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday ) 94 96 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 95 IF( nn_time0* 3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.! move back to the day at nit000 (and not at nit000 - 1)97 IF( nn_time0*NINT(rhhmm*rmmss) - ndt05 .LT. 0 ) fjulday = fjulday+1. ! move back to the day at nit000 (and not at nit000 - 1) 96 98 97 99 nsec1jan000 = 0 … … 112 114 nday_year = nday + SUM( nmonth_len(1:nmonth - 1) ) 113 115 114 !compute number of days between last monday and today115 CALL ymds2ju( 1900, 01, 01, 0.0, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday)116 inbday = FLOOR(fjulday - zjul) ! compute nb day between 01.01.1900 and start of current day117 i dweek = MOD(inbday, 7)! compute nb day between last monday and current day118 IF (i dweek .lt. 0) idweek=idweek+7! Avoid negative values for dates before 01.01.1900116 !compute number of days between last Monday and today 117 CALL ymds2ju( 1900, 01, 01, 0.0, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday) 118 inbday = FLOOR(fjulday - zjul) ! compute nb day between 01.01.1900 and start of current day 119 imonday = MOD(inbday, 7) ! compute nb day between last monday and current day 120 IF (imonday .LT. 0) imonday = imonday + 7 ! Avoid negative values for dates before 01.01.1900 119 121 120 122 ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step 121 IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN123 IF( isecrst - ndt05 .GT. 0 ) THEN 122 124 ! 1 timestep before current middle of first time step is still the same day 123 nsec_year = (nday_year-1) * nsecd + nhour*3600+nminute*60- ndt05124 nsec_month = (nday-1) * nsecd + nhour*3600+nminute*60- ndt05125 nsec_year = (nday_year-1) * nsecd + isecrst - ndt05 126 nsec_month = (nday-1) * nsecd + isecrst - ndt05 125 127 ELSE 126 128 ! 1 time step before the middle of the first time step is the previous day 127 nsec_year = nday_year * nsecd + nhour*3600+nminute*60- ndt05128 nsec_month = nday * nsecd + nhour*3600+nminute*60- ndt05129 ENDIF 130 nsec_ week = idweek * nsecd + nhour*3600+nminute*60- ndt05131 nsec_day = nhour*3600+nminute*60- ndt05132 IF( nsec_day .lt. 0 ) nsec_day = nsec_day+ nsecd133 IF( nsec_ week .lt. 0 ) nsec_week = nsec_week+ nsecd*7129 nsec_year = nday_year * nsecd + isecrst - ndt05 130 nsec_month = nday * nsecd + isecrst - ndt05 131 ENDIF 132 nsec_monday = imonday * nsecd + isecrst - ndt05 133 nsec_day = isecrst - ndt05 134 IF( nsec_day .LT. 0 ) nsec_day = nsec_day + nsecd 135 IF( nsec_monday .LT. 0 ) nsec_monday = nsec_monday + nsecd*7 134 136 135 137 ! control print 136 138 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)') & 137 139 & ' =======>> 1/2 time step before the start of the run DATE Y/M/D = ', & 138 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day, ' nsec_ week:', nsec_week, ' &140 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day, ' nsec_monday:', nsec_monday, ' & 139 141 & nsec_month:', nsec_month , ' nsec_year:' , nsec_year 140 142 143 nsec000_1jan000 = nsec1jan000 + nsec_year + ndt05 144 nsecend_1jan000 = nsec000_1jan000 + ndt * ( nitend - nit000 + 1 ) 145 141 146 ! Up to now, calendar parameters are related to the end of previous run (nit000-1) 142 147 ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init … … 160 165 !! ** Purpose : calendar values related to the months 161 166 !! 162 !! ** Action : - nmonth_len : length in days of the months of the current year 163 !! - nyear_len : length in days of the previous/current year 164 !! - nmonth_half : second since the beginning of the year and the halft of the months 165 !! - nmonth_end : second since the beginning of the year and the end of the months 166 !!---------------------------------------------------------------------- 167 INTEGER :: jm ! dummy loop indice 167 !! ** Action : - nyear_len : length in days of the previous/current year 168 !! - nmonth_len : length in days of the months of the current year 169 !! - nmonth_half : second since the beginning of the current year and the halft of the months 170 !! - nmonth_end : second since the beginning of the current year and the end of the months 171 !!---------------------------------------------------------------------- 172 INTEGER :: jm ,jy ! dummy loop indice 173 INTEGER, DIMENSION(12) :: idaymt ! length in days of the 12 months for non-leap year 168 174 !!---------------------------------------------------------------------- 169 175 170 176 ! length of the month of the current year (from nleapy, read in namelist) 171 177 IF ( nleapy < 2 ) THEN 172 nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /) 178 ! default values 179 idaymt(1:12) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) 180 nmonth_len(-11: 25) = (/ idaymt(1:12), idaymt(1:12), idaymt(1:12), idaymt(1) /) 173 181 nyear_len(:) = 365 182 ! 174 183 IF ( nleapy == 1 ) THEN ! we are using calandar with leap years 175 IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN 176 nyear_len(0) = 366 177 ENDIF 178 IF ( MOD(nyear , 4) == 0 .AND. ( MOD(nyear , 400) == 0 .OR. MOD(nyear , 100) /= 0 ) ) THEN 179 nmonth_len(2) = 29 180 nyear_len(1) = 366 181 ENDIF 182 IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN 183 nyear_len(2) = 366 184 ENDIF 184 DO jy = -1,1 185 IF ( MOD(nyear+jy, 4) == 0 .AND. ( MOD(nyear+jy, 400) == 0 .OR. MOD(nyear+jy, 100) /= 0 ) ) THEN 186 nmonth_len(2 + 12*jy) = 29 187 nyear_len( 1 + jy) = 366 188 ENDIF 189 ENDDO 185 190 ENDIF 186 191 ELSE … … 189 194 ENDIF 190 195 191 ! half month in second since the begining of the year:192 196 ! time since Jan 1st 0 1 2 ... 11 12 13 193 197 ! ---------*--|--*--|--*--| ... |--*--|--*--|--*--|-------------------------------------- 194 198 ! <---> <---> <---> ... <---> <---> <---> 195 199 ! month number 0 1 2 ... 11 12 13 196 ! 197 ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) ) 198 nmonth_half(0) = - nsecd05 * nmonth_len(0) 199 DO jm = 1, 13 200 nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) ) 200 nmonth_beg(1) = 0 201 DO jm = 2, 25 202 nmonth_beg(jm) = nmonth_beg(jm-1) + nsecd * nmonth_len(jm-1) 201 203 END DO 202 203 nmonth_end(0) = 0 204 DO jm = 1, 13 205 nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm) 204 DO jm = 0,-11,-1 205 nmonth_beg(jm) = nmonth_beg(jm+1) - nsecd * nmonth_len(jm) 206 206 END DO 207 207 ! … … 235 235 zprec = 0.1 / rday 236 236 ! ! New time-step 237 nsec_year = nsec_year+ ndt238 nsec_month = nsec_month+ ndt239 nsec_ week = nsec_week+ ndt237 nsec_year = nsec_year + ndt 238 nsec_month = nsec_month + ndt 239 nsec_monday = nsec_monday + ndt 240 240 nsec_day = nsec_day + ndt 241 241 adatrj = adatrj + rdt / rday … … 272 272 & ' New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, ' nday_year = ', nday_year 273 273 IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') ' nsec_year = ', nsec_year, & 274 & ' nsec_month = ', nsec_month, ' nsec_day = ', nsec_day, ' nsec_ week = ', nsec_week275 ENDIF 276 277 IF( nsec_ week > 7*nsecd ) nsec_week= ndt05 ! New week274 & ' nsec_month = ', nsec_month, ' nsec_day = ', nsec_day, ' nsec_monday = ', nsec_monday 275 ENDIF 276 277 IF( nsec_monday > 7*nsecd ) nsec_monday = ndt05 ! New week 278 278 279 279 IF(ln_ctl) THEN … … 319 319 ! 320 320 REAL(wp) :: zkt, zndastp, zdayfrac, ksecs, ktime 321 INTEGER :: ihour, iminute 321 INTEGER :: ihour, iminute, isecond 322 322 !!---------------------------------------------------------------------- 323 323 … … 349 349 CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios ) 350 350 CALL iom_get( numror, 'ntime' , ktime , ldxios = lrxios ) 351 nn_time0=INT(ktime)351 nn_time0 = NINT(ktime) 352 352 ! calculate start time in hours and minutes 353 zdayfrac=adatrj-INT(adatrj)354 ksecs = NINT(zdayfrac *86400) ! Nearest second to catch rounding errors in adatrj355 ihour = INT(ksecs/3600)356 iminute = ksecs /60-ihour*60353 zdayfrac = adatrj - REAL(INT(adatrj), wp) 354 ksecs = NINT(zdayfrac * rday) ! Nearest second to catch rounding errors in adatrj 355 ihour = ksecs / NINT( rhhmm*rmmss ) 356 iminute = ksecs / NINT(rmmss) - ihour*NINT(rhhmm) 357 357 358 358 ! Add to nn_time0 359 359 nhour = nn_time0 / 100 360 360 nminute = ( nn_time0 - nhour * 100 ) 361 nminute =nminute+iminute361 nminute = nminute + iminute 362 362 363 IF( nminute >= 60) THEN364 nminute =nminute-60365 nhour =nhour+1363 IF( nminute >= NINT(rhhmm) ) THEN 364 nminute = nminute - NINT(rhhmm) 365 nhour = nhour+1 366 366 ENDIF 367 367 nhour=nhour+ihour 368 IF( nhour >= 24) THEN369 nhour =nhour-24370 adatrj =adatrj+1368 IF( nhour >= NINT(rjjhh) ) THEN 369 nhour = nhour - NINT(rjjhh) 370 adatrj = adatrj + 1. 371 371 ENDIF 372 372 nn_time0 = nhour * 100 + nminute 373 adatrj = INT(adatrj) ! adatrj set to integer as nn_time0 updated373 adatrj = REAL(INT(adatrj), wp) ! adatrj set to integer as nn_time0 updated 374 374 ELSE 375 375 ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) … … 377 377 nhour = nn_time0 / 100 378 378 nminute = ( nn_time0 - nhour * 100 ) 379 IF( nhour*3600+nminute*60-ndt05 .lt. 0 ) ndastp=ndastp-1 ! Start hour is specified in the namelist (default 0) 379 isecond = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss) 380 IF( isecond - ndt05 .lt. 0 ) ndastp = ndastp - 1 ! Start hour is specified in the namelist (default 0) 380 381 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 381 382 ! note this is wrong if time step has changed during run … … 386 387 nhour = nn_time0 / 100 387 388 nminute = ( nn_time0 - nhour * 100 ) 388 IF( nhour*3600+nminute*60-ndt05 .lt. 0 ) ndastp=ndastp-1 ! Start hour is specified in the namelist (default 0) 389 isecond = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss) 390 IF( isecond - ndt05 .LT. 0 ) ndastp = ndastp - 1 ! Start hour is specified in the namelist (default 0) 389 391 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 390 392 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.