- Timestamp:
- 2020-06-07T18:26:09+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src/daymod.f90
r13024 r13056 28 28 ! 29 29 USE in_out_manager ! I/O manager 30 USE prtctl ! Print control31 30 USE iom ! 32 USE timing ! Timing33 31 34 32 IMPLICIT NONE … … 36 34 37 35 PUBLIC day ! called by step.F90 38 PUBLIC day_init ! called by istate.F9039 36 PUBLIC day_mth ! Needed by TAM 40 37 … … 47 44 !!---------------------------------------------------------------------- 48 45 CONTAINS 49 50 SUBROUTINE day_init51 !!----------------------------------------------------------------------52 !! *** ROUTINE day_init ***53 !!54 !! ** Purpose : Initialization of the calendar values to their values 1 time step before nit00055 !! because day will be called at the beginning of step56 !!57 !! ** Action : - nyear : current year58 !! - nmonth : current month of the year nyear59 !! - nday : current day of the month nmonth60 !! - nday_year : current day of the year nyear61 !! - nsec_year : current time step counted in second since 00h jan 1st of the current year62 !! - nsec_month : current time step counted in second since 00h 1st day of the current month63 !! - nsec_day : current time step counted in second since 00h of the current day64 !! - nsec1jan000 : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year65 !! - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth66 !!----------------------------------------------------------------------67 INTEGER :: inbday, idweek ! local integers68 REAL(wp) :: zjul ! local scalar69 !!----------------------------------------------------------------------70 !71 ! max number of seconds between each restart72 IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN73 CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ', &74 & 'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )75 ENDIF76 nsecd = NINT( rday )77 nsecd05 = NINT( 0.5 * rday )78 ndt = NINT( rdt )79 ndt05 = NINT( 0.5 * rdt )80 81 82 ! set the calandar from ndastp (read in restart file and namelist)83 nyear = ndastp / 1000084 nmonth = ( ndastp - (nyear * 10000) ) / 10085 nday = ndastp - (nyear * 10000) - ( nmonth * 100 )86 87 nhour = nn_time0 / 10088 nminute = ( nn_time0 - nhour * 100 )89 90 CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday )91 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error92 IF( nn_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1. ! move back to the day at nit000 (and not at nit000 - 1)93 94 nsec1jan000 = 095 CALL day_mth96 97 IF ( nday == 0 ) THEN ! for ex if ndastp = ndate0 - 198 nmonth = nmonth - 199 nday = nmonth_len(nmonth)100 ENDIF101 IF ( nmonth == 0 ) THEN ! go at the end of previous year102 nmonth = 12103 nyear = nyear - 1104 nsec1jan000 = nsec1jan000 - nsecd * nyear_len(0)105 IF( nleapy == 1 ) CALL day_mth106 ENDIF107 108 ! day since january 1st109 nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )110 111 !compute number of days between last monday and today112 CALL ymds2ju( 1900, 01, 01, 0.0, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday)113 inbday = FLOOR(fjulday - zjul) ! compute nb day between 01.01.1900 and start of current day114 idweek = MOD(inbday, 7) ! compute nb day between last monday and current day115 IF (idweek .lt. 0) idweek=idweek+7 ! Avoid negative values for dates before 01.01.1900116 117 ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step118 IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN119 ! 1 timestep before current middle of first time step is still the same day120 nsec_year = (nday_year-1) * nsecd + nhour*3600+nminute*60 - ndt05121 nsec_month = (nday-1) * nsecd + nhour*3600+nminute*60 - ndt05122 ELSE123 ! 1 time step before the middle of the first time step is the previous day124 nsec_year = nday_year * nsecd + nhour*3600+nminute*60 - ndt05125 nsec_month = nday * nsecd + nhour*3600+nminute*60 - ndt05126 ENDIF127 nsec_week = idweek * nsecd + nhour*3600+nminute*60 - ndt05128 nsec_day = nhour*3600+nminute*60 - ndt05129 IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd130 IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7131 132 ! control print133 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)') &134 & ' =======>> 1/2 time step before the start of the run DATE Y/M/D = ', &135 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day, ' nsec_week:', nsec_week, ' &136 & nsec_month:', nsec_month , ' nsec_year:' , nsec_year137 138 ! Up to now, calendar parameters are related to the end of previous run (nit000-1)139 ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init140 CALL day( nit000 )141 !142 IF( lwxios ) THEN143 ! define variables in restart file when writing with XIOS144 CALL iom_set_rstw_var_active('kt')145 CALL iom_set_rstw_var_active('ndastp')146 CALL iom_set_rstw_var_active('adatrj')147 CALL iom_set_rstw_var_active('ntime')148 ENDIF149 150 END SUBROUTINE day_init151 152 46 153 47 SUBROUTINE day_mth … … 228 122 !!---------------------------------------------------------------------- 229 123 ! 230 IF( ln_timing ) CALL timing_start('day')231 !232 124 zprec = 0.1 / rday 233 125 ! ! New time-step … … 273 165 274 166 IF( nsec_week > 7*nsecd ) nsec_week = ndt05 ! New week 275 276 IF(ln_ctl) THEN277 WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear278 CALL prt_ctl_info(charout)279 ENDIF280 281 IF( lrst_oce ) CALL day_rst( kt, 'WRITE' ) ! write day restart information282 !283 IF( ln_timing ) CALL timing_stop('day')284 167 ! 285 168 END SUBROUTINE day 286 169 287 288 SUBROUTINE day_rst( kt, cdrw )289 !!---------------------------------------------------------------------290 !! *** ROUTINE day_rst ***291 !!292 !! ** Purpose : Read or write calendar in restart file:293 !!294 !! WRITE(READ) mode:295 !! kt : number of time step since the begining of the experiment at the296 !! end of the current(previous) run297 !! adatrj(0) : number of elapsed days since the begining of the experiment at the298 !! end of the current(previous) run (REAL -> keep fractions of day)299 !! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer)300 !!301 !! According to namelist parameter nrstdt,302 !! nrstdt = 0 no control on the date (nit000 is arbitrary).303 !! nrstdt = 1 we verify that nit000 is equal to the last304 !! time step of previous run + 1.305 !! In both those options, the exact duration of the experiment306 !! since the beginning (cumulated duration of all previous restart runs)307 !! is not stored in the restart and is assumed to be (nit000-1)*rdt.308 !! This is valid is the time step has remained constant.309 !!310 !! nrstdt = 2 the duration of the experiment in days (adatrj)311 !! has been stored in the restart file.312 !!----------------------------------------------------------------------313 INTEGER , INTENT(in) :: kt ! ocean time-step314 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag315 !316 REAL(wp) :: zkt, zndastp, zdayfrac, ksecs, ktime317 INTEGER :: ihour, iminute318 !!----------------------------------------------------------------------319 320 IF( TRIM(cdrw) == 'READ' ) THEN321 322 IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN323 ! Get Calendar informations324 CALL iom_get( numror, 'kt', zkt, ldxios = lrxios ) ! last time-step of previous run325 IF(lwp) THEN326 WRITE(numout,*) ' *** Info read in restart : '327 WRITE(numout,*) ' previous time-step : ', NINT( zkt )328 WRITE(numout,*) ' *** restart option'329 SELECT CASE ( nrstdt )330 CASE ( 0 ) ; WRITE(numout,*) ' nrstdt = 0 : no control of nit000'331 CASE ( 1 ) ; WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)'332 CASE ( 2 ) ; WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart'333 END SELECT334 WRITE(numout,*)335 ENDIF336 ! Control of date337 IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 ) &338 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', &339 & ' verify the restart file or rerun with nrstdt = 0 (namelist)' )340 ! define ndastp and adatrj341 IF ( nrstdt == 2 ) THEN342 ! read the parameters corresponding to nit000 - 1 (last time step of previous run)343 CALL iom_get( numror, 'ndastp', zndastp, ldxios = lrxios )344 ndastp = NINT( zndastp )345 CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios )346 CALL iom_get( numror, 'ntime' , ktime , ldxios = lrxios )347 nn_time0=INT(ktime)348 ! calculate start time in hours and minutes349 zdayfrac=adatrj-INT(adatrj)350 ksecs = NINT(zdayfrac*86400) ! Nearest second to catch rounding errors in adatrj351 ihour = INT(ksecs/3600)352 iminute = ksecs/60-ihour*60353 354 ! Add to nn_time0355 nhour = nn_time0 / 100356 nminute = ( nn_time0 - nhour * 100 )357 nminute=nminute+iminute358 359 IF( nminute >= 60 ) THEN360 nminute=nminute-60361 nhour=nhour+1362 ENDIF363 nhour=nhour+ihour364 IF( nhour >= 24 ) THEN365 nhour=nhour-24366 adatrj=adatrj+1367 ENDIF368 nn_time0 = nhour * 100 + nminute369 adatrj = INT(adatrj) ! adatrj set to integer as nn_time0 updated370 ELSE371 ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)372 ndastp = ndate0 ! ndate0 read in the namelist in dom_nam373 nhour = nn_time0 / 100374 nminute = ( nn_time0 - nhour * 100 )375 IF( nhour*3600+nminute*60-ndt05 .lt. 0 ) ndastp=ndastp-1 ! Start hour is specified in the namelist (default 0)376 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday377 ! note this is wrong if time step has changed during run378 ENDIF379 ELSE380 ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)381 ndastp = ndate0 ! ndate0 read in the namelist in dom_nam382 nhour = nn_time0 / 100383 nminute = ( nn_time0 - nhour * 100 )384 IF( nhour*3600+nminute*60-ndt05 .lt. 0 ) ndastp=ndastp-1 ! Start hour is specified in the namelist (default 0)385 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday386 ENDIF387 IF( ABS(adatrj - REAL(NINT(adatrj),wp)) < 0.1 / rday ) adatrj = REAL(NINT(adatrj),wp) ! avoid truncation error388 !389 IF(lwp) THEN390 WRITE(numout,*) ' *** Info used values : '391 WRITE(numout,*) ' date ndastp : ', ndastp392 WRITE(numout,*) ' number of elapsed days since the begining of run : ', adatrj393 WRITE(numout,*) ' nn_time0 : ',nn_time0394 WRITE(numout,*)395 ENDIF396 !397 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN398 !399 IF( kt == nitrst ) THEN400 IF(lwp) WRITE(numout,*)401 IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file kt =', kt402 IF(lwp) WRITE(numout,*) '~~~~~~~'403 ENDIF404 ! calendar control405 IF( lwxios ) CALL iom_swap( cwxios_context )406 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) , ldxios = lwxios ) ! time-step407 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) , ldxios = lwxios ) ! date408 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj , ldxios = lwxios ) ! number of elapsed days since409 ! ! the begining of the run [s]410 CALL iom_rstput( kt, nitrst, numrow, 'ntime' , REAL( nn_time0, wp), ldxios = lwxios ) ! time411 IF( lwxios ) CALL iom_swap( cxios_context )412 ENDIF413 !414 END SUBROUTINE day_rst415 416 170 !!====================================================================== 417 171 END MODULE daymod
Note: See TracChangeset
for help on using the changeset viewer.
