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 12116 – NEMO

Changeset 12116


Ignore:
Timestamp:
2019-12-09T08:53:27+01:00 (4 years ago)
Author:
smasson
Message:

dev_r12114_ticket_2263: new version of fldread calendar, see #2263

Location:
NEMO/branches/2019/dev_r12114_ticket_2263/src
Files:
1 deleted
5 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r12114_ticket_2263/src/OCE/BDY/bdydta.F90

    r12049 r12116  
    442442            IF( nn_ice_dta(jbdy) == 1 ) THEN   ! if we get ice bdy data from netcdf file 
    443443               CALL fld_fill(  bf(jp_bdya_i,jbdy:jbdy), bn_a_i, cn_dir, 'bdy_dta', 'a_i'//' '//ctmp1, ctmp2 )   ! use namelist info 
    444                CALL fld_clopn( bf(jp_bdya_i,jbdy), nyear, nmonth, nday )   ! not a problem when we call it again after 
     444               CALL fld_def( bf(jp_bdya_i,jbdy) ) 
     445               CALL iom_open( bf(jp_bdya_i,jbdy)%clname, bf(jp_bdya_i,jbdy)%num ) 
    445446               idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld ) 
    446447               IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN   ;   ipl = i4dimsz(3)   ! xylt or xyl 
    447448               ELSE                                                            ;   ipl = 1            ! xy or xyt 
    448449               ENDIF 
     450               CALL iom_close( bf(jp_bdya_i,jbdy)%num ) 
    449451               bf(jp_bdya_i,jbdy)%clrootname = 'NOT USED'   ! reset to default value as this subdomain may not need to read this bdy 
    450452            ENDIF 
  • NEMO/branches/2019/dev_r12114_ticket_2263/src/OCE/DOM/daymod.F90

    r10068 r12116  
    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( nn_time0*NINT(rhhmm*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(ln_ctl) 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 
  • NEMO/branches/2019/dev_r12114_ticket_2263/src/OCE/DOM/dom_oce.F90

    r10068 r12116  
    190190   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format 
    191191   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year 
    192    INTEGER , PUBLIC ::   nsec_year     !: current time step counted in second since 00h jan 1st of the current year 
    193    INTEGER , PUBLIC ::   nsec_month    !: current time step counted in second since 00h 1st day of the current month 
    194    INTEGER , PUBLIC ::   nsec_week     !: current time step counted in second since 00h of last monday 
    195    INTEGER , PUBLIC ::   nsec_day      !: current time step counted in second since 00h of the current day 
     192   INTEGER , PUBLIC ::   nsec_year     !: seconds between 00h jan 1st of the current  year and half of the current time step 
     193   INTEGER , PUBLIC ::   nsec_month    !: seconds between 00h 1st day of the current month and half of the current time step 
     194   INTEGER , PUBLIC ::   nsec_monday   !: seconds between 00h         of the last Monday   and half of the current time step 
     195   INTEGER , PUBLIC ::   nsec_day      !: seconds between 00h         of the current   day and half of the current time step 
    196196   REAL(wp), PUBLIC ::   fjulday       !: current julian day  
    197197   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days 
    198198   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation 
    199199   !                                   !: (cumulative duration of previous runs that may have used different time-step size) 
    200    INTEGER , PUBLIC, DIMENSION(0: 2) ::   nyear_len     !: length in days of the previous/current/next year 
    201    INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year 
    202    INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_half   !: second since Jan 1st 0h of the current year and the half of the months 
    203    INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_end    !: second since Jan 1st 0h of the current year and the end of the months 
    204    INTEGER , PUBLIC                  ::   nsec1jan000   !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year 
     200   INTEGER , PUBLIC, DIMENSION(  0: 2) ::   nyear_len     !: length in days of the previous/current/next year 
     201   INTEGER , PUBLIC, DIMENSION(-11:25) ::   nmonth_len    !: length in days of the months of the current year 
     202   INTEGER , PUBLIC, DIMENSION(-11:25) ::   nmonth_beg    !: second since Jan 1st 0h of the current year and the half of the months 
     203   INTEGER , PUBLIC                  ::   nsec1jan000     !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year 
     204   INTEGER , PUBLIC                  ::   nsec000_1jan000   !: second since Jan 1st 0h of nit000 year and nit000 
     205   INTEGER , PUBLIC                  ::   nsecend_1jan000   !: second since Jan 1st 0h of nit000 year and nitend 
    205206 
    206207   !!---------------------------------------------------------------------- 
  • NEMO/branches/2019/dev_r12114_ticket_2263/src/OCE/SBC/fldread.F90

    r11536 r12116  
    1313   !!   fld_read      : read input fields used for the computation of the surface boundary condition 
    1414   !!   fld_init      : initialization of field read 
    15    !!   fld_rec       : determined the record(s) to be read 
     15   !!   fld_def       : define the record(s) of the file and its name 
    1616   !!   fld_get       : read the data 
    1717   !!   fld_map       : read global data from file and map onto local data using a general mapping (use for open boundaries) 
    1818   !!   fld_rot       : rotate the vector fields onto the local grid direction 
    19    !!   fld_clopn     : update the data file name and close/open the files 
     19   !!   fld_clopn     : close/open the files 
    2020   !!   fld_fill      : fill the data structure with the associated information read in namelist 
    2121   !!   wgt_list      : manage the weights used for interpolation 
     
    2525   !!   seaoverland   : create shifted matrices for seaoverland application 
    2626   !!   fld_interp    : apply weights to input gridded data to create data on model grid 
    27    !!   ksec_week     : function returning the first 3 letters of the first day of the weekly file 
     27   !!   fld_filename  : define the filename according to a given date 
     28   !!   ksec_week     : function returning seconds between 00h of the beginning of the week and half of the current time step 
    2829   !!---------------------------------------------------------------------- 
    2930   USE oce            ! ocean dynamics and tracers 
     
    4445   PUBLIC   fld_map    ! routine called by tides_init 
    4546   PUBLIC   fld_read, fld_fill   ! called by sbc... modules 
    46    PUBLIC   fld_clopn 
     47   PUBLIC   fld_def 
    4748 
    4849   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations 
     
    7273      INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    7374      INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    74       REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow   ! input fields interpolated to now time step 
    75       REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta   ! 2 consecutive record of input fields 
     75      INTEGER , ALLOCATABLE, DIMENSION(:      ) ::   nrecsec   !  
     76      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow   ! input fields interpolated to now time step 
     77      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta   ! 2 consecutive record of input fields 
    7678      CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key 
    7779      !                                                 ! into the WGTLIST structure 
     
    118120   TYPE( WGT ), DIMENSION(tot_wgts)   ::   ref_wgts     ! array of wgts 
    119121   INTEGER                            ::   nxt_wgt = 1  ! point to next available space in ref_wgts array 
     122   INTEGER                            ::   nflag = 0 
    120123   REAL(wp), PARAMETER                ::   undeff_lsm = -999.00_wp 
    121124 
     
    150153      !                                                     !   etc. 
    151154      !! 
    152       INTEGER  ::   itmp         ! local variable 
    153155      INTEGER  ::   imf          ! size of the structure sd 
    154156      INTEGER  ::   jf           ! dummy indices 
    155       INTEGER  ::   isecend      ! number of second since Jan. 1st 00h of nit000 year at nitend 
    156157      INTEGER  ::   isecsbc      ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 
    157       INTEGER  ::   it_offset    ! local time offset variable 
    158       LOGICAL  ::   llnxtyr      ! open next year  file? 
    159       LOGICAL  ::   llnxtmth     ! open next month file? 
    160       LOGICAL  ::   llstop       ! stop is the file does not exist 
    161158      LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields 
     159      REAL(wp) ::   zt_offset    ! local time offset variable 
    162160      REAL(wp) ::   ztinta       ! ratio applied to after  records when doing time interpolation 
    163161      REAL(wp) ::   ztintb       ! ratio applied to before records when doing time interpolation 
     
    167165      IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1 
    168166 
    169       IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
    170       ELSE                                      ;   it_offset = 0 
    171       ENDIF 
    172       IF( PRESENT(kt_offset) )   it_offset = kt_offset 
    173  
    174       ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
    175       IF( present(kit) ) THEN   ! ignore kn_fsbc in this case 
    176          isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) ) 
     167      IF ( nn_components == jp_iam_sas ) THEN   ;   zt_offset = REAL( nn_fsbc, wp ) 
     168      ELSE                                      ;   zt_offset = 0. 
     169      ENDIF 
     170      IF( PRESENT(kt_offset) )   zt_offset = REAL( kt_offset, wp ) 
     171 
     172      ! Note that all varibles starting by nsec_* are shifted time by +1/2 time step to be centrered 
     173      IF( PRESENT(kit) ) THEN   ! ignore kn_fsbc in this case 
     174         isecsbc = nsec_year + nsec1jan000 + NINT( (     REAL(      kit,wp) + zt_offset ) * rdt / REAL(nn_baro,wp) ) 
    177175      ELSE                      ! middle of sbc time step 
    178          isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdt) + it_offset * NINT(rdt) 
     176         ! note: we use kn_fsbc-1 because nsec_year is defined at the middle of the current time step 
     177         isecsbc = nsec_year + nsec1jan000 + NINT( ( 0.5*REAL(kn_fsbc-1,wp) + zt_offset ) * rdt ) 
    179178      ENDIF 
    180179      imf = SIZE( sd ) 
     
    183182         DO jf = 1, imf  
    184183            IF( TRIM(sd(jf)%clrootname) == 'NOT USED' )   CYCLE 
    185             CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped) 
     184            CALL fld_init( isecsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped) 
    186185         END DO 
    187186         IF( lwp ) CALL wgt_print()                ! control print 
     
    192191         ! 
    193192         DO jf = 1, imf                            ! ---   loop over field   --- ! 
    194  
     193            ! 
    195194            IF( TRIM(sd(jf)%clrootname) == 'NOT USED' )   CYCLE 
    196                        
    197             IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN    ! read/update the after data? 
    198  
    199                sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:)                                  ! swap before record informations 
    200                sd(jf)%rotn(1) = sd(jf)%rotn(2)                                      ! swap before rotate informations 
    201                IF( sd(jf)%ln_tint )   sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! swap before record field 
    202  
    203                CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit )    ! update after record informations 
    204  
    205                ! if kn_fsbc*rdt is larger than freqh (which is kind of odd), 
    206                ! it is possible that the before value is no more the good one... we have to re-read it 
    207                ! if before is not the last record of the file currently opened and after is the first record to be read 
    208                ! in a new file which means after = 1 (the file to be opened corresponds to the current time) 
    209                ! or after = nreclast + 1 (the file to be opened corresponds to a future time step) 
    210                IF( .NOT. ll_firstcall .AND. sd(jf)%ln_tint .AND. sd(jf)%nrec_b(1) /= sd(jf)%nreclast & 
    211                   &                   .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) == 1 ) THEN 
    212                   itmp = sd(jf)%nrec_a(1)                       ! temporary storage 
    213                   sd(jf)%nrec_a(1) = sd(jf)%nreclast            ! read the last record of the file currently opened 
    214                   CALL fld_get( sd(jf) )                        ! read after data 
    215                   sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field 
    216                   sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations 
    217                   sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%freqh * 3600. )  ! assume freq to be in hours in this case 
    218                   sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations 
    219                   sd(jf)%nrec_a(1) = itmp                       ! move back to after record  
    220                ENDIF 
    221  
    222                CALL fld_clopn( sd(jf) )   ! Do we need to open a new year/month/week/day file? 
    223                 
    224                IF( sd(jf)%ln_tint ) THEN 
    225                    
    226                   ! if kn_fsbc*rdt is larger than freqh (which is kind of odd), 
    227                   ! it is possible that the before value is no more the good one... we have to re-read it 
    228                   ! if before record is not just just before the after record... 
    229                   IF( .NOT. ll_firstcall .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) /= 1 & 
    230                      &                   .AND. sd(jf)%nrec_b(1) /= sd(jf)%nrec_a(1) - 1 ) THEN    
    231                      sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - 1       ! move back to before record 
    232                      CALL fld_get( sd(jf) )                        ! read after data 
    233                      sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field 
    234                      sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations 
    235                      sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%freqh * 3600. )  ! assume freq to be in hours in this case 
    236                      sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations 
    237                      sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) + 1       ! move back to after record 
    238                   ENDIF 
    239                ENDIF ! temporal interpolation? 
    240  
    241                ! do we have to change the year/month/week/day of the forcing field??  
    242                ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current 
    243                ! one. If so, we are still before the end of the year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1) 
    244                ! will be larger than the record number that should be read for current year/month/week/day 
    245                ! do we need next file data? 
    246                ! This applies to both cases with or without time interpolation 
    247                IF( sd(jf)%nrec_a(1) > sd(jf)%nreclast ) THEN 
    248                    
    249                   sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - sd(jf)%nreclast   !  
    250                    
    251                   IF( .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) ) THEN   ! close/open the current/new file 
    252                       
    253                      llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file? 
    254                      llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file? 
    255  
    256                      ! if the run finishes at the end of the current year/month/week/day, we will allow next 
    257                      ! year/month/week/day file to be not present. If the run continue further than the current 
    258                      ! year/month/week/day, next year/month/week/day file must exist 
    259                      isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdt)   ! second at the end of the run 
    260                      llstop = isecend > sd(jf)%nrec_a(2)                             ! read more than 1 record of next year 
    261                      ! we suppose that the date of next file is next day (should be ok even for weekly files...) 
    262                      CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         & 
    263                         &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         & 
    264                         &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop ) 
    265  
    266                      IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist 
    267                         CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)//     & 
    268                            &     ' not present -> back to current year/month/day') 
    269                         CALL fld_clopn( sd(jf) )               ! back to the current year/month/day 
    270                         sd(jf)%nrec_a(1) = sd(jf)%nreclast     ! force to read the last record in the current year file 
    271                      ENDIF 
    272                       
    273                   ENDIF 
    274                ENDIF   ! open need next file? 
    275                    
    276                ! read after data 
    277                CALL fld_get( sd(jf) ) 
    278                 
    279             ENDIF   ! read new data? 
     195            CALL fld_update( isecsbc, sd(jf) ) 
     196            ! 
    280197         END DO                                    ! --- end loop over field --- ! 
    281198 
     
    292209                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &             
    293210                     & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 
    294                   WRITE(numout, *) '      it_offset is : ',it_offset 
     211                  WRITE(numout, *) '      zt_offset is : ',zt_offset 
    295212               ENDIF 
    296213               ! temporal interpolation weights 
     
    316233 
    317234 
    318    SUBROUTINE fld_init( kn_fsbc, sdjf ) 
     235   SUBROUTINE fld_init( ksecsbc, sdjf ) 
    319236      !!--------------------------------------------------------------------- 
    320237      !!                    ***  ROUTINE fld_init  *** 
    321238      !! 
    322       !! ** Purpose :  - first call to fld_rec to define before values 
    323       !!               - if time interpolation, read before data  
    324       !!---------------------------------------------------------------------- 
    325       INTEGER  , INTENT(in   ) ::   kn_fsbc      ! sbc computation period (in time step)  
     239      !! ** Purpose :  - first call(s) to fld_def to define before values 
     240      !!               - open file 
     241      !!---------------------------------------------------------------------- 
     242      INTEGER  , INTENT(in   ) ::   ksecsbc   !  
    326243      TYPE(FLD), INTENT(inout) ::   sdjf         ! input field related variables 
    327       !! 
    328       LOGICAL :: llprevyr              ! are we reading previous year  file? 
    329       LOGICAL :: llprevmth             ! are we reading previous month file? 
    330       LOGICAL :: llprevweek            ! are we reading previous week  file? 
    331       LOGICAL :: llprevday             ! are we reading previous day   file? 
    332       LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 
    333       INTEGER :: idvar                 ! variable id  
    334       INTEGER :: inrec                 ! number of record existing for this variable 
    335       INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd 
    336       INTEGER :: isec_week             ! number of seconds since start of the weekly file 
    337       CHARACTER(LEN=1000) ::   clfmt   ! write format 
    338       !!--------------------------------------------------------------------- 
    339       ! 
    340       llprevyr   = .FALSE. 
    341       llprevmth  = .FALSE. 
    342       llprevweek = .FALSE. 
    343       llprevday  = .FALSE. 
    344       isec_week  = 0 
    345       ! 
    346       ! define record informations 
    347       CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later) 
    348       ! 
    349       ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
    350       ! 
    351       IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure 
    352          ! 
    353          IF( sdjf%nrec_a(1) == 0  ) THEN   ! we redefine record sdjf%nrec_a(1) with the last record of previous year file 
    354             IF    ( NINT(sdjf%freqh) == -12 ) THEN   ! yearly mean 
    355                IF( sdjf%cltype == 'yearly' ) THEN             ! yearly file 
    356                   sdjf%nrec_a(1) = 1                                                       ! force to read the unique record 
    357                   llprevyr  = .NOT. sdjf%ln_clim                                           ! use previous year  file? 
    358                ELSE 
    359                   CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clrootname) ) 
    360                ENDIF 
    361             ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN   ! monthly mean 
    362                IF( sdjf%cltype == 'monthly' ) THEN            ! monthly file 
    363                   sdjf%nrec_a(1) = 1                                                       ! force to read the unique record 
    364                   llprevmth = .TRUE.                                                       ! use previous month file? 
    365                   llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    366                ELSE                                           ! yearly file 
    367                   sdjf%nrec_a(1) = 12                                                      ! force to read december mean 
    368                   llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file? 
    369                ENDIF 
    370             ELSE                                     ! higher frequency mean (in hours)  
    371                IF    ( sdjf%cltype      == 'monthly' ) THEN   ! monthly file 
    372                   sdjf%nrec_a(1) = NINT( 24. * REAL(nmonth_len(nmonth-1),wp) / sdjf%freqh )! last record of previous month 
    373                   llprevmth = .TRUE.                                                       ! use previous month file? 
    374                   llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    375                ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ! weekly file 
    376                   llprevweek = .TRUE.                                                      ! use previous week  file? 
    377                   sdjf%nrec_a(1) = NINT( 24. * 7. / sdjf%freqh )                           ! last record of previous week 
    378                   isec_week = NINT(rday) * 7                                               ! add a shift toward previous week 
    379                ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ! daily file 
    380                   sdjf%nrec_a(1) = NINT( 24. / sdjf%freqh )                                ! last record of previous day 
    381                   llprevday = .TRUE.                                                       ! use previous day   file? 
    382                   llprevmth = llprevday .AND. nday   == 1                                  ! use previous month file? 
    383                   llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    384                ELSE                                           ! yearly file 
    385                   sdjf%nrec_a(1) = NINT( 24. * REAL(nyear_len(0),wp) / sdjf%freqh )        ! last record of previous year  
    386                   llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file? 
    387                ENDIF 
    388             ENDIF 
    389          ENDIF 
    390          ! 
    391          IF ( sdjf%cltype(1:4) == 'week' ) THEN 
    392             isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week 
    393             llprevmth = isec_week > nsec_month                      ! longer time since the beginning of the week than the month 
    394             llprevyr  = llprevmth .AND. nmonth == 1 
    395          ENDIF 
    396          llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 
    397          ! 
    398          iyear  = nyear  - COUNT((/llprevyr /)) 
    399          imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 
    400          iday   = nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 
    401          ! 
    402          CALL fld_clopn( sdjf, iyear, imonth, iday, .NOT. llprev ) 
    403          ! 
    404          ! if previous year/month/day file does not exist, we switch to the current year/month/day 
    405          IF( llprev .AND. sdjf%num <= 0 ) THEN 
    406             CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clrootname)//   & 
    407                &           ' not present -> back to current year/month/week/day' ) 
    408             ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day 
    409             llprev = .FALSE. 
    410             sdjf%nrec_a(1) = 1 
    411             CALL fld_clopn( sdjf ) 
    412          ENDIF 
    413          ! 
    414          IF( llprev ) THEN   ! check if the record sdjf%nrec_a(1) exists in the file 
    415             idvar = iom_varid( sdjf%num, sdjf%clvar )                                        ! id of the variable sdjf%clvar 
    416             IF( idvar <= 0 )   RETURN 
    417             inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar )   ! size of the last dim of idvar 
    418             sdjf%nrec_a(1) = MIN( sdjf%nrec_a(1), inrec )   ! make sure we select an existing record 
    419          ENDIF 
    420          ! 
    421          ! read before data in after arrays(as we will swap it later) 
    422          CALL fld_get( sdjf ) 
    423          ! 
    424          clfmt = "('   fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')" 
    425          IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday 
    426          ! 
    427       ENDIF 
     244      !!--------------------------------------------------------------------- 
     245      ! 
     246      IF( nflag == 0 )   nflag = -( HUGE(0) - 10 ) 
     247      ! 
     248      CALL fld_def( sdjf ) 
     249      IF( sdjf%ln_tint .AND. ksecsbc < sdjf%nrecsec(1) )   CALL fld_def( sdjf, ldprev = .TRUE. ) 
     250      ! 
     251      CALL fld_clopn( sdjf ) 
     252      sdjf%nrec_a(:) = (/ 1, nflag /)  ! default definition to force flp_update to read the file. 
    428253      ! 
    429254   END SUBROUTINE fld_init 
    430255 
    431256 
    432    SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, kit, kt_offset ) 
    433       !!--------------------------------------------------------------------- 
    434       !!                    ***  ROUTINE fld_rec  *** 
     257   SUBROUTINE fld_update( ksecsbc, sdjf ) 
     258      !!--------------------------------------------------------------------- 
     259      !!                    ***  ROUTINE fld_update  *** 
    435260      !! 
    436261      !! ** Purpose : Compute 
     
    441266      !!                  nrec_b(2) and nrec_a(2): time of the beginning and end of the record 
    442267      !!---------------------------------------------------------------------- 
    443       INTEGER  , INTENT(in   )           ::   kn_fsbc   ! sbc computation period (in time step)  
     268      INTEGER  , INTENT(in   )           ::   ksecsbc   !  
    444269      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables 
    445       LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.) 
    446       INTEGER  , INTENT(in   ), OPTIONAL ::   kit       ! index of barotropic subcycle 
    447       !                                                 ! used only if sdjf%ln_tint = .TRUE. 
    448       INTEGER  , INTENT(in   ), OPTIONAL ::   kt_offset ! Offset of required time level compared to "now" 
    449       !                                                 !   time level in units of time steps. 
    450       ! 
    451       LOGICAL  ::   llbefore    ! local definition of ldbefore 
    452       INTEGER  ::   iendrec     ! end of this record (in seconds) 
    453       INTEGER  ::   imth        ! month number 
    454       INTEGER  ::   ifreq_sec   ! frequency mean (in seconds) 
    455       INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file 
    456       INTEGER  ::   it_offset   ! local time offset variable 
    457       REAL(wp) ::   ztmp        ! temporary variable 
    458       !!---------------------------------------------------------------------- 
    459       ! 
    460       ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
    461       ! 
    462       IF( PRESENT(ldbefore) ) THEN   ;   llbefore = ldbefore .AND. sdjf%ln_tint   ! needed only if sdjf%ln_tint = .TRUE. 
    463       ELSE                           ;   llbefore = .FALSE. 
    464       ENDIF 
    465       ! 
    466       IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
    467       ELSE                                      ;   it_offset = 0 
    468       ENDIF 
    469       IF( PRESENT(kt_offset) )      it_offset = kt_offset 
    470       IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) 
    471       ELSE                      ;   it_offset =         it_offset   * NINT(       rdt            ) 
    472       ENDIF 
    473       ! 
    474       !                                           ! =========== ! 
    475       IF    ( NINT(sdjf%freqh) == -12 ) THEN      ! yearly mean 
    476          !                                        ! =========== ! 
    477          ! 
    478          IF( sdjf%ln_tint ) THEN                  ! time interpolation, shift by 1/2 record 
    479             ! 
    480             !                  INT( ztmp ) 
    481             !                     /|\ 
    482             !                    1 |    *---- 
    483             !                    0 |----(               
    484             !                      |----+----|--> time 
    485             !                      0   /|\   1   (nday/nyear_len(1)) 
    486             !                           |    
    487             !                           |    
    488             !       forcing record :    1  
    489             !                             
    490             ztmp =  REAL( nsec_year, wp ) / ( REAL( nyear_len(1), wp ) * rday ) + 0.5 & 
    491                &  + REAL( it_offset, wp ) / ( REAL( nyear_len(1), wp ) * rday ) 
    492             sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    493             ! swap at the middle of the year 
    494             IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(0) + & 
    495                                     & INT(ztmp) * NINT( 0.5 * rday) * nyear_len(1)  
    496             ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(1) + & 
    497                                     & INT(ztmp) * INT(rday) * nyear_len(1) + INT(ztmp) * NINT( 0.5 * rday) * nyear_len(2)  
     270      ! 
     271      INTEGER  ::   ja     ! end of this record (in seconds) 
     272      !!---------------------------------------------------------------------- 
     273      ! 
     274      IF( ksecsbc > sdjf%nrec_a(2) ) THEN     ! --> we need to update after data 
     275         
     276         ! find where is the new after record... (it is not necessary sdjf%nrec_a(1)+1 ) 
     277         ja = sdjf%nrec_a(1) 
     278         DO WHILE ( ksecsbc >= sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast )   ! Warning: make sure ja <= sdjf%nreclast in this test 
     279            ja = ja + 1 
     280         END DO 
     281         IF( ksecsbc > sdjf%nrecsec(ja) )   ja = ja + 1   ! in case ksecsbc > sdjf%nrecsec(sdjf%nreclast) 
     282 
     283         ! if ln_tint and if the new after is not ja+1, we need also to update after data before the swap 
     284         ! so, after the swap, sdjf%nrec_b(2) will still be the closest value located just before ksecsbc 
     285         IF( sdjf%ln_tint .AND. ( ja > sdjf%nrec_a(1) + 1 .OR. sdjf%nrec_a(2) == nflag ) ) THEN 
     286            sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)   ! update nrec_a with before information 
     287            CALL fld_get( sdjf )                              ! read after data that will be used as before data 
     288         ENDIF 
     289             
     290         ! if after is in the next file... 
     291         IF( ja > sdjf%nreclast ) THEN 
     292             
     293            CALL fld_def( sdjf ) 
     294            IF( ksecsbc > sdjf%nrecsec(sdjf%nreclast) )   CALL fld_def( sdjf, ldnext = .TRUE. ) 
     295            CALL fld_clopn( sdjf )           ! open next file 
     296             
     297            ! find where is after in this new file 
     298            ja = 1 
     299            DO WHILE ( ksecsbc > sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast ) 
     300               ja = ja + 1 
     301            END DO 
     302            IF( ksecsbc > sdjf%nrecsec(ja) )   ja = ja + 1   ! in case ksecsbc > sdjf%nrecsec(sdjf%nreclast) 
     303             
     304            IF( ja > sdjf%nreclast ) THEN 
     305               CALL ctl_stop( "STOP", "fld_def: need next-next file? we should not be there... file: "//TRIM(sdjf%clrootname) ) 
    498306            ENDIF 
    499          ELSE                                     ! no time interpolation 
    500             sdjf%nrec_a(1) = 1 
    501             sdjf%nrec_a(2) = NINT(rday) * nyear_len(1) + nsec1jan000   ! swap at the end    of the year 
    502             sdjf%nrec_b(2) = nsec1jan000                               ! beginning of the year (only for print) 
    503          ENDIF 
    504          ! 
    505          !                                        ! ============ ! 
    506       ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN      ! monthly mean ! 
    507          !                                        ! ============ ! 
    508          ! 
    509          IF( sdjf%ln_tint ) THEN                  ! time interpolation, shift by 1/2 record 
    510             ! 
    511             !                  INT( ztmp ) 
    512             !                     /|\ 
    513             !                    1 |    *---- 
    514             !                    0 |----(               
    515             !                      |----+----|--> time 
    516             !                      0   /|\   1   (nday/nmonth_len(nmonth)) 
    517             !                           |    
    518             !                           |    
    519             !       forcing record :  nmonth  
    520             !                             
    521             ztmp =  REAL( nsec_month, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) + 0.5 & 
    522            &      + REAL(  it_offset, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) 
    523             imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 
    524             IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    525             ELSE                                  ;   sdjf%nrec_a(1) = imth 
     307             
     308            ! if ln_tint and if after is not the first record, we must (potentially again) update after data before the swap 
     309            IF( sdjf%ln_tint .AND. ja > 1 ) THEN 
     310               IF( sdjf%nrecsec(0) /= nflag ) THEN               ! no trick used: after file is not the current file 
     311                  sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)   ! update nrec_a with before information 
     312                  CALL fld_get( sdjf )                         ! read after data that will be used as before data 
     313               ENDIF 
    526314            ENDIF 
    527             sdjf%nrec_a(2) = nmonth_half(   imth ) + nsec1jan000   ! swap at the middle of the month 
    528          ELSE                                    ! no time interpolation 
    529             IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 
    530             ELSE                                  ;   sdjf%nrec_a(1) = nmonth 
    531             ENDIF 
    532             sdjf%nrec_a(2) =  nmonth_end(nmonth  ) + nsec1jan000   ! swap at the end    of the month 
    533             sdjf%nrec_b(2) =  nmonth_end(nmonth-1) + nsec1jan000   ! beginning of the month (only for print) 
    534          ENDIF 
    535          ! 
    536          !                                        ! ================================ ! 
    537       ELSE                                        ! higher frequency mean (in hours) 
    538          !                                        ! ================================ ! 
    539          ! 
    540          ifreq_sec = NINT( sdjf%freqh * 3600. )                                         ! frequency mean (in seconds) 
    541          IF( sdjf%cltype(1:4) == 'week' )   isec_week = ksec_week( sdjf%cltype(6:8) )   ! since the first day of the current week 
    542          ! number of second since the beginning of the file 
    543          IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)  ! since the first day of the current month 
    544          ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week ,wp)  ! since the first day of the current week 
    545          ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)  ! since 00h of the current day 
    546          ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year 
    547          ENDIF 
    548          ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdt + REAL( it_offset, wp )        ! centrered in the middle of sbc time step 
    549          ztmp = ztmp + 0.01 * rdt                                                       ! avoid truncation error  
    550          IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record 
    551             ! 
    552             !          INT( ztmp/ifreq_sec + 0.5 ) 
    553             !                     /|\ 
    554             !                    2 |        *-----( 
    555             !                    1 |  *-----( 
    556             !                    0 |--(               
    557             !                      |--+--|--+--|--+--|--> time 
    558             !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec) 
    559             !                         |     |     | 
    560             !                         |     |     | 
    561             !       forcing record :  1     2     3 
    562             !                    
    563             ztmp= ztmp / REAL(ifreq_sec, wp) + 0.5 
    564          ELSE                                    ! no time interpolation 
    565             ! 
    566             !           INT( ztmp/ifreq_sec ) 
    567             !                     /|\ 
    568             !                    2 |           *-----( 
    569             !                    1 |     *-----( 
    570             !                    0 |-----(               
    571             !                      |--+--|--+--|--+--|--> time 
    572             !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec) 
    573             !                         |     |     | 
    574             !                         |     |     | 
    575             !       forcing record :  1     2     3 
    576             !                             
    577             ztmp= ztmp / REAL(ifreq_sec, wp) 
    578          ENDIF 
    579          sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record number to be read 
    580  
    581          iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000       ! end of this record (in second) 
    582          ! add the number of seconds between 00h Jan 1 and the end of previous month/week/day (ok if nmonth=1) 
    583          IF( sdjf%cltype      == 'monthly' )   iendrec = iendrec + NINT(rday) * SUM(nmonth_len(1:nmonth -1)) 
    584          IF( sdjf%cltype(1:4) == 'week'    )   iendrec = iendrec + ( nsec_year - isec_week ) 
    585          IF( sdjf%cltype      == 'daily'   )   iendrec = iendrec + NINT(rday) * ( nday_year - 1 ) 
    586          IF( sdjf%ln_tint ) THEN 
    587              sdjf%nrec_a(2) = iendrec - ifreq_sec / 2        ! swap at the middle of the record 
     315             
     316         ENDIF 
     317 
     318         IF( sdjf%ln_tint ) THEN  
     319            ! Swap data 
     320            sdjf%nrec_b(:)     = sdjf%nrec_a(:)                      ! swap before record informations 
     321            sdjf%rotn(1)       = sdjf%rotn(2)                        ! swap before rotate informations 
     322            sdjf%fdta(:,:,:,1) = sdjf%fdta(:,:,:,2)                  ! swap before record field 
    588323         ELSE 
    589              sdjf%nrec_a(2) = iendrec                        ! swap at the end    of the record 
    590              sdjf%nrec_b(2) = iendrec - ifreq_sec            ! beginning of the record (only for print) 
    591          ENDIF 
    592          ! 
    593       ENDIF 
    594       ! 
    595       IF( .NOT. sdjf%ln_tint ) sdjf%nrec_a(2) = sdjf%nrec_a(2) - 1   ! last second belongs to bext record : *----( 
    596       ! 
    597    END SUBROUTINE fld_rec 
     324            sdjf%nrec_b(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)   ! only for print  
     325         ENDIF 
     326             
     327         ! read new after data 
     328         sdjf%nrec_a(:) = (/ ja, sdjf%nrecsec(ja) /)   ! update nrec_a as it is used by fld_get 
     329         CALL fld_get( sdjf )                            ! read after data (with nrec_a informations) 
     330         
     331      ENDIF 
     332      ! 
     333   END SUBROUTINE fld_update 
    598334 
    599335 
     
    1030766                           sd(ju)%fdta(:,:,jk,jn) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,jn) = vtmp(:,:) 
    1031767                        ELSE  
    1032                            CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->i', utmp(:,:) ) 
    1033                            CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->j', vtmp(:,:) ) 
     768                           CALL rot_rep( sd(ju)%fnow(:,:,jk   ), sd(iv)%fnow(:,:,jk   ), 'T', 'en->i', utmp(:,:) ) 
     769                           CALL rot_rep( sd(ju)%fnow(:,:,jk   ), sd(iv)%fnow(:,:,jk   ), 'T', 'en->j', vtmp(:,:) ) 
    1034770                           sd(ju)%fnow(:,:,jk   ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk   ) = vtmp(:,:) 
    1035771                        ENDIF 
     
    1047783 
    1048784 
    1049    SUBROUTINE fld_clopn( sdjf, kyear, kmonth, kday, ldstop ) 
     785   SUBROUTINE fld_def( sdjf, ldprev, ldnext ) 
     786      !!--------------------------------------------------------------------- 
     787      !!                    ***  ROUTINE fld_def  *** 
     788      !! 
     789      !! ** Purpose :   define the record(s) of the file and its name 
     790      !!---------------------------------------------------------------------- 
     791      TYPE(FLD)        , INTENT(inout) ::   sdjf       ! input field related variables 
     792      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldprev     !  
     793      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldnext     !  
     794      ! 
     795      INTEGER  :: jt 
     796      INTEGER  :: idaysec               ! number of seconds in 1 day = NINT(rday) 
     797      INTEGER  :: iyr, imt, idy, isecwk 
     798      INTEGER  :: indexyr, indexmt 
     799      INTEGER  :: ireclast 
     800      INTEGER  :: ishift, istart 
     801      INTEGER, DIMENSION(2)  :: isave 
     802      REAL(wp) :: zfreqs 
     803      LOGICAL  :: llprev, llnext, llstop 
     804      LOGICAL  :: llprevmt, llprevyr 
     805      LOGICAL  :: llnextmt, llnextyr 
     806      !!---------------------------------------------------------------------- 
     807      idaysec = NINT(rday) 
     808      ! 
     809      IF( PRESENT(ldprev) ) THEN   ;   llprev = ldprev 
     810      ELSE                         ;   llprev = .FALSE. 
     811      ENDIF 
     812      IF( PRESENT(ldnext) ) THEN   ;   llnext = ldnext 
     813      ELSE                         ;   llnext = .FALSE. 
     814      ENDIF 
     815 
     816      ! current file parameters 
     817      IF ( sdjf%cltype(1:4) == 'week' ) THEN          ! find the day of the beginning of the current week 
     818         isecwk = ksec_week( sdjf%cltype(6:8) )     ! seconds between the beginning of the week and half of current time step 
     819         llprevmt = isecwk > nsec_month               ! longer time since beginning of the current week than the current month 
     820         llprevyr = llprevmt .AND. nmonth == 1 
     821         iyr = nyear  - COUNT((/llprevyr/)) 
     822         imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 
     823         idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 
     824         isecwk = nsec_year - isecwk              ! seconds between 00h jan 1st of current year and current week beginning 
     825      ELSE 
     826         iyr = nyear 
     827         imt = nmonth 
     828         idy = nday 
     829         isecwk  = 0 
     830      ENDIF 
     831 
     832      ! previous file parameters 
     833      IF( llprev ) THEN 
     834         IF( sdjf%cltype(1:4) == 'week'    ) THEN     ! find the day of the beginning of previous week 
     835            isecwk = isecwk + 7 * idaysec         ! seconds between the beginning of previous week and half of the time step 
     836            llprevmt = isecwk > nsec_month            ! longer time since beginning of the previous week than the current month 
     837            llprevyr = llprevmt .AND. nmonth == 1 
     838            iyr = nyear  - COUNT((/llprevyr/)) 
     839            imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 
     840            idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 
     841            isecwk = nsec_year - isecwk           ! seconds between 00h jan 1st of current year and previous week beginning 
     842         ELSE 
     843            idy = nday   - COUNT((/ sdjf%cltype == 'daily'                 /)) 
     844            imt = nmonth - COUNT((/ sdjf%cltype == 'monthly' .OR. idy == 0 /)) 
     845            iyr = nyear  - COUNT((/ sdjf%cltype == 'yearly'  .OR. imt == 0 /)) 
     846            IF( idy == 0 ) idy = nmonth_len(imt) 
     847            IF( imt == 0 ) imt = 12 
     848            isecwk = 0 
     849         ENDIF 
     850      ENDIF 
     851 
     852      ! next file parameters 
     853      IF( llnext ) THEN 
     854         IF( sdjf%cltype(1:4) == 'week'    ) THEN     ! find the day of the beginning of next week 
     855            isecwk = 7 * idaysec - isecwk         ! seconds between half of the time step and the beginning of next week 
     856            llnextmt = isecwk > ( nmonth_len(nmonth)*idaysec - nsec_month )   ! larger than the seconds to the end of the month 
     857            llnextyr = llnextmt .AND. nmonth == 12 
     858            iyr = nyear  + COUNT((/llnextyr/)) 
     859            imt = nmonth + COUNT((/llnextmt/)) - 12 * COUNT((/llnextyr/)) 
     860            idy = nday - nmonth_len(nmonth) * COUNT((/llnextmt/)) + isecwk / idaysec + 1 
     861            isecwk = nsec_year + isecwk           ! seconds between 00h jan 1st of current year and next week beginning 
     862         ELSE 
     863            idy = nday   + COUNT((/ sdjf%cltype == 'daily'                                 /)) 
     864            imt = nmonth + COUNT((/ sdjf%cltype == 'monthly' .OR. idy > nmonth_len(nmonth) /)) 
     865            iyr = nyear  + COUNT((/ sdjf%cltype == 'yearly'  .OR. imt == 13                /)) 
     866            IF( idy > nmonth_len(nmonth) )   idy = 1 
     867            IF( imt == 13                )   imt = 1 
     868            isecwk = 0 
     869         ENDIF 
     870      ENDIF 
     871      ! 
     872      ! find the last record to be read -> update sdjf%nreclast 
     873      indexyr = iyr - nyear + 1                 ! which  year are we looking for? previous(0), current(1) or next(2)? 
     874      indexmt = imt + 12 * ( indexyr - 1 )      ! which month are we looking for (relatively to current year)?  
     875      ! 
     876      ! Last record to be read in the current file 
     877      ! Predefine the number of record in the file according of its type. 
     878      ! We could compare this number with the number of records in the file and make a stop if the 2 numbers do not match... 
     879      ! However this would be much less fexible (e.g. for tests) and will force to rewite input files according to nleapy... 
     880      IF    ( NINT(sdjf%freqh) == -12 ) THEN            ;   ireclast = 1    ! yearly mean: consider only 1 record 
     881      ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN                                ! monthly mean: 
     882         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ireclast = 1    !  consider that the file has  1 record 
     883         ELSE                                           ;   ireclast = 12   !  consider that the file has 12 record 
     884         ENDIF 
     885      ELSE                                                                  ! higher frequency mean (in hours) 
     886         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ireclast = NINT( 24. * REAL(nmonth_len(indexmt), wp) / sdjf%freqh ) 
     887         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ireclast = NINT( 24. * 7.                            / sdjf%freqh ) 
     888         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ireclast = NINT( 24.                                 / sdjf%freqh ) 
     889         ELSE                                           ;   ireclast = NINT( 24. * REAL( nyear_len(indexyr), wp) / sdjf%freqh ) 
     890         ENDIF 
     891      ENDIF 
     892 
     893      sdjf%nreclast = ireclast 
     894      ! Allocate arrays for beginning/middle/end of each record (seconds since Jan. 1st 00h of nit000 year) 
     895      IF( ALLOCATED(sdjf%nrecsec) )   DEALLOCATE( sdjf%nrecsec ) 
     896      ALLOCATE( sdjf%nrecsec( 0:ireclast ) ) 
     897      ! 
     898      IF    ( NINT(sdjf%freqh) == -12 ) THEN                                     ! yearly mean and yearly file 
     899         SELECT CASE( indexyr ) 
     900         CASE(0)   ;   sdjf%nrecsec(0) = nsec1jan000 - nyear_len( 0 ) * idaysec 
     901         CASE(1)   ;   sdjf%nrecsec(0) = nsec1jan000 
     902         CASE(2)   ;   sdjf%nrecsec(0) = nsec1jan000 + nyear_len( 1 ) * idaysec 
     903         ENDSELECT 
     904         sdjf%nrecsec(1) = sdjf%nrecsec(0) + nyear_len( indexyr ) * idaysec 
     905      ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN                                     ! monthly mean: 
     906         IF(     sdjf%cltype      == 'monthly' ) THEN                            !    monthly file 
     907            sdjf%nrecsec(0   ) = nsec1jan000 + nmonth_beg(indexmt  ) 
     908            sdjf%nrecsec(1   ) = nsec1jan000 + nmonth_beg(indexmt+1) 
     909         ELSE                                                                    !    yearly  file 
     910            ishift = 12 * ( indexyr - 1 ) 
     911            sdjf%nrecsec(0:12) = nsec1jan000 + nmonth_beg(1+ishift:13+ishift) 
     912         ENDIF 
     913      ELSE                                                                       ! higher frequency mean (in hours) 
     914         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   istart = nsec1jan000 + nmonth_beg(indexmt) 
     915         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   istart = nsec1jan000 + isecwk 
     916         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   istart = nsec1jan000 + nmonth_beg(indexmt) + ( idy - 1 ) * idaysec 
     917         ELSEIF( indexyr          == 0         ) THEN   ;   istart = nsec1jan000 - nyear_len( 0 ) * idaysec 
     918         ELSEIF( indexyr          == 2         ) THEN   ;   istart = nsec1jan000 + nyear_len( 1 ) * idaysec 
     919         ELSE                                           ;   istart = nsec1jan000 
     920         ENDIF 
     921         zfreqs = sdjf%freqh * rhhmm * rmmss 
     922         DO jt = 0, sdjf%nreclast 
     923            sdjf%nrecsec(jt) = istart + NINT( zfreqs * REAL(jt,wp) ) 
     924         END DO 
     925      ENDIF 
     926      ! 
     927      IF( sdjf%ln_tint ) THEN   ! record time defined in the middle of the record 
     928         sdjf%nrecsec(1:sdjf%nreclast) = 0.5 * ( sdjf%nrecsec(0:sdjf%nreclast-1) + sdjf%nrecsec(1:sdjf%nreclast) ) 
     929      END IF 
     930      ! 
     931      sdjf%clname = fld_filename( sdjf, idy, imt, iyr ) 
     932      ! 
     933   END SUBROUTINE fld_def 
     934 
     935    
     936   SUBROUTINE fld_clopn( sdjf ) 
    1050937      !!--------------------------------------------------------------------- 
    1051938      !!                    ***  ROUTINE fld_clopn  *** 
    1052939      !! 
    1053       !! ** Purpose :   update the file name and close/open the files 
    1054       !!---------------------------------------------------------------------- 
    1055       TYPE(FLD)        , INTENT(inout) ::   sdjf     ! input field related variables 
    1056       INTEGER, OPTIONAL, INTENT(in   ) ::   kyear    ! year value 
    1057       INTEGER, OPTIONAL, INTENT(in   ) ::   kmonth   ! month value 
    1058       INTEGER, OPTIONAL, INTENT(in   ) ::   kday     ! day value 
    1059       LOGICAL, OPTIONAL, INTENT(in   ) ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
    1060       ! 
    1061       LOGICAL  :: llprevyr              ! are we reading previous year  file? 
    1062       LOGICAL  :: llprevmth             ! are we reading previous month file? 
    1063       INTEGER  :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd 
    1064       INTEGER  :: isec_week             ! number of seconds since start of the weekly file 
    1065       INTEGER  :: indexyr               ! year undex (O/1/2: previous/current/next) 
    1066       REAL(wp) :: zyear_len, zmonth_len ! length (days) of iyear and imonth             !  
    1067       CHARACTER(len = 256) ::   clname  ! temporary file name 
    1068       !!---------------------------------------------------------------------- 
    1069       IF( PRESENT(kyear) ) THEN                             ! use given values  
    1070          iyear = kyear 
    1071          imonth = kmonth 
    1072          iday = kday 
    1073          IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
    1074             isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 )   
    1075             llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
    1076             llprevyr   = llprevmth .AND. nmonth == 1 
    1077             iyear  = nyear  - COUNT((/llprevyr /)) 
    1078             imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 
    1079             iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 
    1080          ENDIF 
    1081       ELSE                                                  ! use current day values 
    1082          IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
    1083             isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week 
    1084             llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
    1085             llprevyr   = llprevmth .AND. nmonth == 1 
    1086          ELSE 
    1087             isec_week  = 0 
    1088             llprevmth  = .FALSE. 
    1089             llprevyr   = .FALSE. 
    1090          ENDIF 
    1091          iyear  = nyear  - COUNT((/llprevyr /)) 
    1092          imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 
    1093          iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 
    1094       ENDIF 
    1095  
    1096       ! build the new filename if not climatological data 
    1097       clname=TRIM(sdjf%clrootname) 
    1098       ! 
    1099       ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name 
    1100       IF( .NOT. sdjf%ln_clim ) THEN    
    1101                                          WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), iyear    ! add year 
    1102          IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname          ), imonth   ! add month 
    1103       ELSE 
    1104          ! build the new filename if climatological data 
    1105          IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), imonth   ! add month 
    1106       ENDIF 
    1107       IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 
    1108             &                            WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname          ), iday     ! add day 
    1109       ! 
    1110       IF( TRIM(clname) /= TRIM(sdjf%clname) .OR. sdjf%num == 0 ) THEN   ! new file to be open  
    1111          ! 
    1112          sdjf%clname = TRIM(clname) 
    1113          IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open 
    1114          CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
    1115          ! 
    1116          ! find the last record to be read -> update sdjf%nreclast 
    1117          indexyr = iyear - nyear + 1 
    1118          zyear_len = REAL(nyear_len( indexyr ), wp) 
    1119          SELECT CASE ( indexyr ) 
    1120          CASE ( 0 )   ;   zmonth_len = 31.   ! previous year -> imonth = 12 
    1121          CASE ( 1 )   ;   zmonth_len = REAL(nmonth_len(imonth), wp) 
    1122          CASE ( 2 )   ;   zmonth_len = 31.   ! next     year -> imonth = 1 
    1123          END SELECT 
    1124          ! 
    1125          ! last record to be read in the current file 
    1126          IF    ( sdjf%freqh == -12. ) THEN                 ;   sdjf%nreclast = 1    !  yearly mean 
    1127          ELSEIF( sdjf%freqh ==  -1. ) THEN                                          ! monthly mean 
    1128             IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = 1 
    1129             ELSE                                           ;   sdjf%nreclast = 12 
    1130             ENDIF 
    1131          ELSE                                                                       ! higher frequency mean (in hours) 
    1132             IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = NINT( 24. * zmonth_len / sdjf%freqh ) 
    1133             ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   sdjf%nreclast = NINT( 24. * 7.         / sdjf%freqh ) 
    1134             ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   sdjf%nreclast = NINT( 24.              / sdjf%freqh ) 
    1135             ELSE                                           ;   sdjf%nreclast = NINT( 24. * zyear_len  / sdjf%freqh ) 
    1136             ENDIF 
    1137          ENDIF 
     940      !! ** Purpose :   close/open the files 
     941      !!---------------------------------------------------------------------- 
     942      TYPE(FLD)        , INTENT(inout) ::   sdjf       ! input field related variables 
     943      ! 
     944      INTEGER, DIMENSION(2)  :: isave 
     945      LOGICAL  :: llprev, llnext, llstop 
     946      !!---------------------------------------------------------------------- 
     947      ! 
     948      llprev = sdjf%nrecsec(sdjf%nreclast) < nsec000_1jan000   ! file ends before the beginning of the job -> file may not exist 
     949      llnext = sdjf%nrecsec(       0     ) > nsecend_1jan000   ! file begins after the end of the job -> file may not exist  
     950 
     951      llstop = sdjf%ln_clim .OR. .NOT. ( llprev .OR. llnext ) 
     952 
     953      IF( sdjf%num <= 0 .OR. .NOT. sdjf%ln_clim  ) THEN 
     954         IF( sdjf%num > 0 )   CALL iom_close( sdjf%num )   ! close file if already open 
     955         CALL iom_open( sdjf%clname, sdjf%num, ldstop = llstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 
     956      ENDIF 
     957      ! 
     958      IF( sdjf%num <= 0 .AND. .NOT. llstop ) THEN   ! file not found but we do accept this... 
     959         ! 
     960         IF( llprev ) THEN   ! previous file does not exist : go back to current and accept to read only the first record 
     961            CALL ctl_warn('previous file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file') 
     962            isave(1:2) = sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast)   ! save previous file info 
     963            CALL fld_def( sdjf )   ! go back to current file 
     964            sdjf%nreclast = 1   ! force to use only the first record (do as if other were not existing...) 
     965            sdjf%nrecsec(0:1) = isave(1:2) 
     966         ENDIF 
     967         ! 
     968         IF( llnext ) THEN   ! next     file does not exist : go back to current and accept to read only the last  record  
     969            CALL ctl_warn('next file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file') 
     970            isave(1:2) = sdjf%nrecsec(0:1)    ! save next file info 
     971            CALL fld_def( sdjf )   ! go back to current file 
     972            ! -> read last record but keep record info from the first record of next file 
     973            sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast) = isave(1:2) 
     974            sdjf%nrecsec(0:sdjf%nreclast-2) = nflag 
     975         ENDIF 
     976         ! 
     977         CALL iom_open( sdjf%clname, sdjf%num, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 )    
    1138978         ! 
    1139979      ENDIF 
     
    17511591 
    17521592 
     1593   FUNCTION fld_filename( sdjf, kday, kmonth, kyear ) 
     1594      !!--------------------------------------------------------------------- 
     1595      !!                    ***  FUNCTION fld_filename ***  
     1596      !! 
     1597      !! ** Purpose :   define the filename according to a given date 
     1598      !!--------------------------------------------------------------------- 
     1599      TYPE(FLD), INTENT(in) ::   sdjf         ! input field related variables 
     1600      INTEGER  , INTENT(in) ::   kday, kmonth, kyear 
     1601      ! 
     1602      CHARACTER(len = 256) ::   clname, fld_filename 
     1603      !!--------------------------------------------------------------------- 
     1604 
     1605       
     1606      ! build the new filename if not climatological data 
     1607      clname=TRIM(sdjf%clrootname) 
     1608      ! 
     1609      ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name 
     1610      IF( .NOT. sdjf%ln_clim ) THEN    
     1611                                         WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year 
     1612         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a, "m",i2.2)' ) TRIM( clname          ), kmonth   ! add month 
     1613      ELSE 
     1614         ! build the new filename if climatological data 
     1615         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
     1616      ENDIF 
     1617      IF(    sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 
     1618         &                               WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname          ), kday     ! add day 
     1619 
     1620      fld_filename = clname 
     1621       
     1622   END FUNCTION fld_filename 
     1623 
     1624 
    17531625   FUNCTION ksec_week( cdday ) 
    17541626      !!--------------------------------------------------------------------- 
    1755       !!                    ***  FUNCTION kshift_week ***  
    1756       !! 
    1757       !! ** Purpose :   return the first 3 letters of the first day of the weekly file 
     1627      !!                    ***  FUNCTION ksec_week ***  
     1628      !! 
     1629      !! ** Purpose :   seconds between 00h of the beginning of the week and half of the current time step 
    17581630      !!--------------------------------------------------------------------- 
    17591631      CHARACTER(len=*), INTENT(in)   ::   cdday   ! first 3 letters of the first day of the weekly file 
     
    17711643      ishift = ijul * NINT(rday) 
    17721644      !  
    1773       ksec_week = nsec_week + ishift 
     1645      ksec_week = nsec_monday + ishift 
    17741646      ksec_week = MOD( ksec_week, 7*NINT(rday) ) 
    17751647      !  
  • NEMO/branches/2019/dev_r12114_ticket_2263/src/OFF/dtadyn.F90

    r11536 r12116  
    281281      ! Open file for each variable to get his number of dimension 
    282282      DO ifpr = 1, jfld 
    283          CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday ) 
     283         CALL fld_def( sf_dyn(ifpr) ) 
     284         CALL iom_open( sf_dyn(ifpr)%clname, sf_dyn(ifpr)%num ) 
    284285         idv   = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar )        ! id of the variable sdjf%clvar 
    285286         idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv)                 ! number of dimension for variable sdjf%clvar 
    286          IF( sf_dyn(ifpr)%num /= 0 )   CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open 
     287         CALL iom_close( sf_dyn(ifpr)%num )                              ! close file if already open 
    287288         ierr1=0 
    288289         IF( idimv == 3 ) THEN    ! 2D variable 
     
    508509      ! Open file for each variable to get his number of dimension 
    509510      DO ifpr = 1, jfld 
    510          CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday ) 
     511         CALL fld_def( sf_dyn(ifpr) ) 
     512         CALL iom_open( sf_dyn(ifpr)%clname, sf_dyn(ifpr)%num ) 
    511513         idv   = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar )        ! id of the variable sdjf%clvar 
    512514         idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv)                 ! number of dimension for variable sdjf%clvar 
    513          IF( sf_dyn(ifpr)%num /= 0 )   CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open 
     515         CALL iom_close( sf_dyn(ifpr)%num )                              ! close file if already open 
    514516         ierr1=0 
    515517         IF( idimv == 3 ) THEN    ! 2D variable 
Note: See TracChangeset for help on using the changeset viewer.