New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12250 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/daymod.F90 – NEMO

Ignore:
Timestamp:
2019-12-14T09:41:16+01:00 (4 years ago)
Author:
smasson
Message:

rev12240_dev_r11943_MERGE_2019: same as [12246], add modifications from dev_r12114_ticket_2263, results unchanged except SPITZ12 as explained in #2263

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/daymod.F90

    r12236 r12250  
    5858      !! 
    5959      !! ** 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 
    7071      REAL(wp) ::   zjul             ! local scalar 
    7172      !!---------------------------------------------------------------------- 
     
    7677            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 
    7778      ENDIF 
    78       nsecd   = NINT( rday      ) 
     79      nsecd   = NINT(       rday ) 
    7980      nsecd05 = NINT( 0.5 * rday ) 
    8081      ndt     = NINT(       rdt  ) 
     
    9091      nhour   =   nn_time0 / 100 
    9192      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 )   
    9496      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( nhour*NINT(rhhmm*rmmss) + nminute*NINT(rmmss) - ndt05 .LT. 0 ) fjulday = fjulday+1.       ! move back to the day at nit000 (and not at nit000 - 1) 
    9698 
    9799      nsec1jan000 = 0 
     
    112114      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) ) 
    113115 
    114       !compute number of days between last monday and today 
    115       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 day 
    117       idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day 
    118       IF (idweek .lt. 0) idweek=idweek+7       ! Avoid negative values for dates before 01.01.1900 
     116      !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 
    119121 
    120122      ! 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) THEN 
     123      IF( isecrst - ndt05 .GT. 0 ) THEN 
    122124         ! 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 - ndt05  
    124          nsec_month = (nday-1)      * nsecd + nhour*3600+nminute*60 - ndt05     
     125         nsec_year  = (nday_year-1) * nsecd + isecrst - ndt05  
     126         nsec_month = (nday-1)      * nsecd + isecrst - ndt05     
    125127      ELSE 
    126128         ! 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 - ndt05  
    128          nsec_month = nday      * nsecd + nhour*3600+nminute*60 - ndt05    
    129       ENDIF 
    130       nsec_week  = idweek    * nsecd + nhour*3600+nminute*60 - ndt05 
    131       nsec_day   =             nhour*3600+nminute*60 - ndt05  
    132       IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd 
    133       IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7 
     129         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 
    134136 
    135137      ! control print 
    136138      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)')   & 
    137139           &                   ' =======>> 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, '  & 
    139141           &                   nsec_month:', nsec_month , '  nsec_year:' , nsec_year 
    140142 
     143      nsec000_1jan000 = nsec1jan000 + nsec_year + ndt05 
     144      nsecend_1jan000 = nsec000_1jan000 + ndt * ( nitend - nit000 + 1 ) 
     145       
    141146      ! Up to now, calendar parameters are related to the end of previous run (nit000-1) 
    142147      ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init 
     
    160165      !! ** Purpose :   calendar values related to the months 
    161166      !! 
    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 
    168174      !!---------------------------------------------------------------------- 
    169175 
    170176      ! length of the month of the current year (from nleapy, read in namelist) 
    171177      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) /) 
    173181         nyear_len(:) = 365 
     182         ! 
    174183         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 
    185190         ENDIF 
    186191      ELSE 
     
    189194      ENDIF 
    190195 
    191       ! half month in second since the begining of the year: 
    192196      ! time since Jan 1st   0     1     2    ...    11    12    13 
    193197      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|-------------------------------------- 
    194198      !                 <---> <---> <--->  ...  <---> <---> <---> 
    195199      ! 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) 
    201203      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) 
    206206      END DO 
    207207      ! 
     
    235235      zprec = 0.1 / rday 
    236236      !                                                 ! New time-step 
    237       nsec_year  = nsec_year  + ndt 
    238       nsec_month = nsec_month + ndt 
    239       nsec_week  = nsec_week  + ndt 
     237      nsec_year    = nsec_year    + ndt 
     238      nsec_month   = nsec_month  + ndt 
     239      nsec_monday  = nsec_monday  + ndt 
    240240      nsec_day   = nsec_day   + ndt 
    241241      adatrj  = adatrj  + rdt / rday 
     
    272272              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year 
    273273         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_week 
    275       ENDIF 
    276  
    277       IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week 
     274              &   '   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 
    278278 
    279279      IF(sn_cfctl%l_prtctl) THEN 
     
    319319      ! 
    320320      REAL(wp) ::   zkt, zndastp, zdayfrac, ksecs, ktime 
    321       INTEGER  ::   ihour, iminute 
     321      INTEGER  ::   ihour, iminute, isecond 
    322322      !!---------------------------------------------------------------------- 
    323323 
     
    349349               CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios ) 
    350350          CALL iom_get( numror, 'ntime' , ktime  , ldxios = lrxios ) 
    351           nn_time0=INT(ktime) 
     351               nn_time0 = NINT(ktime) 
    352352               ! calculate start time in hours and minutes 
    353           zdayfrac=adatrj-INT(adatrj) 
    354           ksecs = NINT(zdayfrac*86400)        ! Nearest second to catch rounding errors in adatrj          
    355           ihour = INT(ksecs/3600) 
    356           iminute = ksecs/60-ihour*60 
     353               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) 
    357357            
    358358               ! Add to nn_time0 
    359359               nhour   =   nn_time0 / 100 
    360360               nminute = ( nn_time0 - nhour * 100 ) 
    361           nminute=nminute+iminute 
     361          nminute = nminute + iminute 
    362362           
    363           IF( nminute >= 60 ) THEN 
    364              nminute=nminute-60 
    365         nhour=nhour+1 
     363               IF( nminute >= NINT(rhhmm) ) THEN 
     364             nminute = nminute - NINT(rhhmm) 
     365        nhour = nhour+1 
    366366          ENDIF 
    367367          nhour=nhour+ihour 
    368           IF( nhour >= 24 ) THEN 
    369         nhour=nhour-24 
    370              adatrj=adatrj+1 
     368          IF( nhour >= NINT(rjjhh) ) THEN 
     369        nhour = nhour - NINT(rjjhh) 
     370             adatrj = adatrj + 1. 
    371371          ENDIF           
    372372          nn_time0 = nhour * 100 + nminute 
    373           adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated           
     373               adatrj = REAL(INT(adatrj), wp)                    ! adatrj set to integer as nn_time0 updated           
    374374            ELSE 
    375375               ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) 
     
    377377               nhour   =   nn_time0 / 100 
    378378               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) 
    380381               adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 
    381382               ! note this is wrong if time step has changed during run 
     
    386387            nhour   =   nn_time0 / 100 
    387388       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) 
    389391            adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 
    390392         ENDIF 
Note: See TracChangeset for help on using the changeset viewer.