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

Changeset 3851


Ignore:
Timestamp:
2013-03-27T11:03:54+01:00 (11 years ago)
Author:
smasson
Message:

trunk: bugfix in fldread when nn_fsbc * rn_rdt > frcing file period, see #958

Location:
trunk/NEMOGCM/NEMO
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r3703 r3851  
    207207                        IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend - 2 
    208208                        CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  & 
    209                                      & jit=jit, time_offset=time_offset ) 
     209                                     & kit=jit, kt_offset=time_offset ) 
    210210                        IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend + 2 
    211211 
     
    255255                  jend = nb_bdy_fld(ib_bdy) 
    256256                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend),  & 
    257                                & map=nbmap_ptr(jstart:jend), time_offset=time_offset ) 
     257                               & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 
    258258                  ! 
    259259                  igrd = 2                      ! zonal velocity 
     
    279279                     jend = nb_bdy_fld(ib_bdy) 
    280280                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 
    281                                   & map=nbmap_ptr(jstart:jend), time_offset=time_offset ) 
     281                                  & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 
    282282                  ENDIF 
    283283                  ! If full velocities in boundary data then split into barotropic and baroclinic data 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r3764 r3851  
    153153         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years 
    154154            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN 
    155                nyear_len(0) = 366 
    156             ENDIF 
    157             IF ( MOD(nyear, 4) == 0 .AND. ( MOD(nyear, 400) == 0 .OR. MOD(nyear, 100) /= 0 ) ) THEN 
     155               nyear_len(0)  = 366 
     156            ENDIF 
     157            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN 
    158158               nmonth_len(2) = 29 
    159                nyear_len(1) = 366 
     159               nyear_len(1)  = 366 
     160            ENDIF 
     161            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN 
     162               nyear_len(2)  = 366 
    160163            ENDIF 
    161164         ENDIF 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r3680 r3851  
    218218   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation 
    219219   !                                   !: (cumulative duration of previous runs that may have used different time-step size) 
    220    INTEGER , PUBLIC, DIMENSION(0: 1) ::   nyear_len     !: length in days of the previous/current year 
     220   INTEGER , PUBLIC, DIMENSION(0: 2) ::   nyear_len     !: length in days of the previous/current/next year 
    221221   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year 
    222222   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_half   !: second since Jan 1st 0h of the current year and the half of the months 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r3826 r3851  
    2727  
    2828   PUBLIC   fld_map    ! routine called by tides_init 
     29   PUBLIC   fld_read, fld_fill   ! called by sbc... modules 
    2930 
    3031   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations 
     
    5758      !                                                 ! into the WGTLIST structure 
    5859      CHARACTER(len = 34)             ::   vcomp        ! symbolic name for a vector component that needs rotation 
    59       LOGICAL                         ::   rotn         ! flag to indicate whether field has been rotated 
     60      LOGICAL, DIMENSION(2)           ::   rotn         ! flag to indicate whether before/after field has been rotated 
     61      INTEGER                         ::   nreclast     ! last record to be read in the current file 
    6062   END TYPE FLD 
    6163 
     
    9698!$AGRIF_END_DO_NOT_TREAT 
    9799 
    98    PUBLIC   fld_read, fld_fill   ! called by sbc... modules 
    99  
    100100   !!---------------------------------------------------------------------- 
    101101   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    105105CONTAINS 
    106106 
    107    SUBROUTINE fld_read( kt, kn_fsbc, sd, map, jit, time_offset ) 
     107   SUBROUTINE fld_read( kt, kn_fsbc, sd, map, kit, kt_offset ) 
    108108      !!--------------------------------------------------------------------- 
    109109      !!                    ***  ROUTINE fld_read  *** 
     
    120120      INTEGER  , INTENT(in   )               ::   kn_fsbc   ! sbc computation period (in time step)  
    121121      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
    122       TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) ::   map   ! global-to-local mapping index 
    123       INTEGER  , INTENT(in   ), OPTIONAL     ::   jit       ! subcycle timestep for timesplitting option 
    124       INTEGER  , INTENT(in   ), OPTIONAL     ::   time_offset ! provide fields at time other than "now" 
    125                                                               ! time_offset = -1 => fields at "before" time level 
    126                                                               ! time_offset = +1 => fields at "after" time levels 
    127                                                               ! etc. 
    128       !! 
     122      TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) ::   map   ! global-to-local mapping indices 
     123      INTEGER  , INTENT(in   ), OPTIONAL     ::   kit       ! subcycle timestep for timesplitting option 
     124      INTEGER  , INTENT(in   ), OPTIONAL     ::   kt_offset ! provide fields at time other than "now" 
     125                                                            !   kt_offset = -1 => fields at "before" time level 
     126                                                            !   kt_offset = +1 => fields at "after"  time level 
     127                                                            !   etc. 
     128      !! 
     129      INTEGER  ::   itmp       ! temporary variable 
    129130      INTEGER  ::   imf        ! size of the structure sd 
    130131      INTEGER  ::   jf         ! dummy indices 
    131       INTEGER  ::   ireclast   ! last record to be read in the current year file 
    132132      INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend 
    133133      INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 
    134       INTEGER  ::   itime_add  ! local time offset variable 
     134      INTEGER  ::   it_offset  ! local time offset variable 
    135135      LOGICAL  ::   llnxtyr    ! open next year  file? 
    136136      LOGICAL  ::   llnxtmth   ! open next month file? 
     
    140140      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
    141141      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    142       !!--------------------------------------------------------------------- 
    143       ll_firstcall = .false. 
    144       IF( PRESENT(jit) ) THEN 
    145          IF(kt == nit000 .and. jit == 1) ll_firstcall = .true. 
    146       ELSE 
    147          IF(kt == nit000) ll_firstcall = .true. 
    148       ENDIF 
    149  
    150       itime_add = 0 
    151       IF( PRESENT(time_offset) ) itime_add = time_offset 
    152           
     142      TYPE(MAP_POINTER) ::   imap   ! global-to-local mapping indices 
     143      !!--------------------------------------------------------------------- 
     144      ll_firstcall = kt == nit000 
     145      IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1 
     146 
     147      it_offset = 0 
     148      IF( PRESENT(kt_offset) )   it_offset = kt_offset 
     149 
     150      imap%ptr => NULL() 
     151 
    153152      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
    154       IF( present(jit) ) THEN  
    155          ! ignore kn_fsbc in this case 
    156          isecsbc = nsec_year + nsec1jan000 + (jit+itime_add)*rdt/REAL(nn_baro,wp)  
    157       ELSE 
    158          isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + itime_add * rdttra(1)  ! middle of sbc time step 
     153      IF( present(kit) ) THEN   ! ignore kn_fsbc in this case 
     154         isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) ) 
     155      ELSE                      ! middle of sbc time step 
     156         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + it_offset * NINT(rdttra(1)) 
    159157      ENDIF 
    160158      imf = SIZE( sd ) 
    161159      ! 
    162160      IF( ll_firstcall ) THEN                      ! initialization 
    163          IF( PRESENT(map) ) THEN 
    164             DO jf = 1, imf  
    165                CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr )  ! read each before field (put them in after as they will be swapped) 
    166             END DO 
    167          ELSE 
    168             DO jf = 1, imf  
    169                CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped) 
    170             END DO 
    171          ENDIF 
     161         DO jf = 1, imf  
     162            IF( PRESENT(map) ) imap = map(jf) 
     163            CALL fld_init( kn_fsbc, sd(jf), imap )  ! read each before field (put them in after as they will be swapped) 
     164         END DO 
    172165         IF( lwp ) CALL wgt_print()                ! control print 
    173          CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed 
    174166      ENDIF 
    175167      !                                            ! ====================================== ! 
     
    179171         DO jf = 1, imf                            ! ---   loop over field   --- ! 
    180172             
    181             IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN  ! read/update the after data? 
    182  
    183                IF( sd(jf)%ln_tint ) THEN                             ! swap before record field and informations 
    184                   sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:) 
    185 !CDIR COLLAPSE 
    186                   sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 
     173            IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN    ! read/update the after data? 
     174 
     175               IF( PRESENT(map) )   imap = map(jf)   ! temporary definition of map 
     176 
     177               sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:)                                  ! swap before record informations 
     178               sd(jf)%rotn(1) = sd(jf)%rotn(2)                                      ! swap before rotate informations 
     179               IF( sd(jf)%ln_tint )   sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! swap before record field 
     180 
     181               CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit )    ! update after record informations 
     182 
     183               ! if kn_fsbc*rdttra is larger than nfreqh (which is kind of odd), 
     184               ! it is possible that the before value is no more the good one... we have to re-read it 
     185               ! if before is not the last record of the file currently opened and after is the first record to be read 
     186               ! in a new file which means after = 1 (the file to be opened corresponds to the current time) 
     187               ! or after = nreclast + 1 (the file to be opened corresponds to a future time step) 
     188               IF( .NOT. ll_firstcall .AND. sd(jf)%ln_tint .AND. sd(jf)%nrec_b(1) /= sd(jf)%nreclast & 
     189                  &                   .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) == 1 ) THEN 
     190                  itmp = sd(jf)%nrec_a(1)                       ! temporary storage 
     191                  sd(jf)%nrec_a(1) = sd(jf)%nreclast            ! read the last record of the file currently opened 
     192                  CALL fld_get( sd(jf), imap )                  ! read after data 
     193                  sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field 
     194                  sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations 
     195                  sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - sd(jf)%nfreqh * 3600  ! assume freq to be in hours in this case 
     196                  sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations 
     197                  sd(jf)%nrec_a(1) = itmp                       ! move back to after record  
    187198               ENDIF 
    188199 
    189                IF( PRESENT(jit) ) THEN 
    190                   CALL fld_rec( kn_fsbc, sd(jf), time_offset=itime_add, jit=jit )              ! update record informations 
    191                ELSE 
    192                   CALL fld_rec( kn_fsbc, sd(jf), time_offset=itime_add )                       ! update record informations 
    193                ENDIF 
    194  
    195                ! do we have to change the year/month/week/day of the forcing field??  
     200               CALL fld_clopn( sd(jf) )   ! Do we need to open a new year/month/week/day file? 
     201                
    196202               IF( sd(jf)%ln_tint ) THEN 
     203                   
     204                  ! if kn_fsbc*rdttra is larger than nfreqh (which is kind of odd), 
     205                  ! it is possible that the before value is no more the good one... we have to re-read it 
     206                  ! if before record is not just just before the after record... 
     207                  IF( .NOT. ll_firstcall .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) /= 1 & 
     208                     &                   .AND. sd(jf)%nrec_b(1) /= sd(jf)%nrec_a(1) - 1 ) THEN    
     209                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - 1       ! move back to before record 
     210                     CALL fld_get( sd(jf), imap )                  ! read after data 
     211                     sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field 
     212                     sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations 
     213                     sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - sd(jf)%nfreqh * 3600  ! assume freq to be in hours in this case 
     214                     sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations 
     215                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) + 1       ! move back to after record 
     216                  ENDIF 
     217 
     218                  ! do we have to change the year/month/week/day of the forcing field??  
    197219                  ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current 
    198220                  ! 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) 
    199221                  ! will be larger than the record number that should be read for current year/month/week/day 
    200  
    201                   ! last record to be read in the current file 
    202                   IF    ( sd(jf)%nfreqh == -12 ) THEN                 ;   ireclast = 1    !  yearly mean 
    203                   ELSEIF( sd(jf)%nfreqh ==  -1 ) THEN                                     ! monthly mean 
    204                      IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 1 
    205                      ELSE                                             ;   ireclast = 12 
    206                      ENDIF 
    207                   ELSE                                                                    ! higher frequency mean (in hours) 
    208                      IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh  
    209                      ELSEIF( sd(jf)%cltype(1:4) == 'week'    ) THEN   ;   ireclast = 24 * 7                  / sd(jf)%nfreqh 
    210                      ELSEIF( sd(jf)%cltype      == 'daily'   ) THEN   ;   ireclast = 24                      / sd(jf)%nfreqh 
    211                      ELSE                                             ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh  
    212                      ENDIF 
    213                   ENDIF 
    214  
    215222                  ! do we need next file data? 
    216                   IF( sd(jf)%nrec_a(1) > ireclast ) THEN 
    217  
    218                      sd(jf)%nrec_a(1) = 1              ! force to read the first record of the next file 
    219  
    220                      IF( .NOT. sd(jf)%ln_clim ) THEN   ! close the current file and open a new one. 
    221  
     223                  IF( sd(jf)%nrec_a(1) > sd(jf)%nreclast ) THEN 
     224                      
     225                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - sd(jf)%nreclast   !  
     226                      
     227                     IF( .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) ) THEN   ! close/open the current/new file 
     228                         
    222229                        llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file? 
    223230                        llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file? 
     
    228235                        isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run  
    229236                        llstop = isecend > sd(jf)%nrec_a(2)                                   ! read more than 1 record of next year 
    230  
     237                        ! we suppose that the date of next file is next day (should be ok even for weekly files...) 
    231238                        CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         & 
    232239                           &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         & 
     
    236243                           CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)//     & 
    237244                              &     ' not present -> back to current year/month/day') 
    238                            CALL fld_clopn( sd(jf), nyear, nmonth, nday )       ! back to the current year/month/day 
    239                            sd(jf)%nrec_a(1) = ireclast     ! force to read the last record to be read in the current year file 
     245                           CALL fld_clopn( sd(jf) )       ! back to the current year/month/day 
     246                           sd(jf)%nrec_a(1) = sd(jf)%nreclast     ! force to read the last record in the current year file 
    240247                        ENDIF 
    241  
     248                         
    242249                     ENDIF 
    243                   ENDIF 
    244  
    245                ELSE 
    246                   ! if we are not doing time interpolation, we must change the year/month/week/day of the file just after 
    247                   ! switching to the NEW year/month/week/day. If it is the case, we are at the beginning of the 
    248                   ! year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1) = 1 
    249                   IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) )   & 
    250                      &   CALL fld_clopn( sd(jf), nyear, nmonth, nday ) 
    251                ENDIF 
     250                  ENDIF   ! open need next file? 
     251                   
     252               ENDIF   ! temporal interpolation? 
    252253 
    253254               ! read after data 
    254                IF( PRESENT(map) ) THEN 
    255                   CALL fld_get( sd(jf), map(jf)%ptr ) 
    256                ELSE 
    257                   CALL fld_get( sd(jf) ) 
    258                ENDIF 
    259  
    260             ENDIF 
     255               CALL fld_get( sd(jf), imap ) 
     256 
     257            ENDIF   ! read new data? 
    261258         END DO                                    ! --- end loop over field --- ! 
    262259 
    263          CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed 
     260         CALL fld_rot( kt, sd )                    ! rotate vector before/now/after fields if needed 
    264261 
    265262         DO jf = 1, imf                            ! ---   loop over field   --- ! 
     
    271268                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &             
    272269                     & 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 
    273                   WRITE(numout, *) 'itime_add is : ',itime_add 
     270                  WRITE(numout, *) 'it_offset is : ',it_offset 
    274271               ENDIF 
    275272               ! temporal interpolation weights 
     
    307304      INTEGER  , INTENT(in   ) ::   kn_fsbc   ! sbc computation period (in time step)  
    308305      TYPE(FLD), INTENT(inout) ::   sdjf      ! input field related variables 
    309       INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 
     306      TYPE(MAP_POINTER),INTENT(in) ::   map  ! global-to-local mapping indices 
    310307      !! 
    311308      LOGICAL :: llprevyr              ! are we reading previous year  file? 
     
    320317      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    321318      !!--------------------------------------------------------------------- 
    322        
    323       ! some default definitions... 
    324       sdjf%num = 0   ! default definition for non-opened file 
    325       IF( sdjf%ln_clim )   sdjf%clname = TRIM( sdjf%clrootname )   ! file name defaut definition, never change in this case 
    326319      llprevyr   = .FALSE. 
    327320      llprevmth  = .FALSE. 
     
    330323      isec_week  = 0 
    331324             
    332       IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy == 0 )   & 
    333          &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs nn_leapy = 1') 
    334       IF( sdjf%cltype(1:4) == 'week' .AND. sdjf%ln_clim  )   & 
    335          &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs ln_clim = .FALSE.') 
    336  
    337325      ! define record informations 
    338326      CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later) 
     
    348336                  llprevyr  = .NOT. sdjf%ln_clim                                           ! use previous year  file? 
    349337               ELSE 
    350                   CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clname) ) 
     338                  CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clrootname) ) 
    351339               ENDIF 
    352340            ELSEIF( sdjf%nfreqh ==  -1 ) THEN   ! monthly mean 
     
    379367            ENDIF 
    380368         ENDIF 
     369         ! 
    381370         IF ( sdjf%cltype(1:4) == 'week' ) THEN 
    382371            isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week 
     
    394383         ! if previous year/month/day file does not exist, we switch to the current year/month/day 
    395384         IF( llprev .AND. sdjf%num <= 0 ) THEN 
    396             CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clname)//   & 
     385            CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clrootname)//   & 
    397386               &           ' not present -> back to current year/month/week/day' ) 
    398387            ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day 
    399388            llprev = .FALSE. 
    400389            sdjf%nrec_a(1) = 1 
    401             CALL fld_clopn( sdjf, nyear, nmonth, nday ) 
     390            CALL fld_clopn( sdjf ) 
    402391         ENDIF 
    403392          
    404          IF( llprev ) THEN   ! check if the last record sdjf%nrec_n(1) exists in the file 
     393         IF( llprev ) THEN   ! check if the record sdjf%nrec_a(1) exists in the file 
    405394            idvar = iom_varid( sdjf%num, sdjf%clvar )                                        ! id of the variable sdjf%clvar 
    406395            IF( idvar <= 0 )   RETURN 
     
    409398         ENDIF 
    410399 
    411          ! read before data  
    412          IF( PRESENT(map) ) THEN 
    413             CALL fld_get( sdjf, map )  ! read before values in after arrays(as we will swap it later) 
    414          ELSE 
    415             CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later) 
    416          ENDIF 
     400         ! read before data in after arrays(as we will swap it later) 
     401         CALL fld_get( sdjf, map ) 
    417402 
    418403         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" 
    419404         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday 
    420405 
    421          IF( llprev )   CALL iom_close( sdjf%num )          ! force to close previous year file (-> redefine sdjf%num to 0) 
    422  
    423       ENDIF 
    424  
    425       ! make sure current year/month/day file is opened 
    426       IF( sdjf%num <= 0 ) THEN 
    427          ! 
    428          IF ( sdjf%cltype(1:4) == 'week' ) THEN 
    429             isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week 
    430             llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
    431             llprevyr   = llprevmth .AND. nmonth == 1 
    432          ELSE 
    433             isec_week  = 0 
    434             llprevmth  = .FALSE. 
    435             llprevyr   = .FALSE. 
    436          ENDIF 
    437          ! 
    438          iyear  = nyear  - COUNT((/llprevyr /)) 
    439          imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 
    440          iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 
    441          ! 
    442          CALL fld_clopn( sdjf, iyear, imonth, iday ) 
    443       ENDIF  
     406      ENDIF 
    444407      ! 
    445408   END SUBROUTINE fld_init 
    446409 
    447410 
    448    SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit, time_offset ) 
     411   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, kit, kt_offset ) 
    449412      !!--------------------------------------------------------------------- 
    450413      !!                    ***  ROUTINE fld_rec  *** 
     
    460423      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables 
    461424      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.) 
    462       INTEGER  , INTENT(in   ), OPTIONAL ::   jit       ! index of barotropic subcycle 
     425      INTEGER  , INTENT(in   ), OPTIONAL ::   kit       ! index of barotropic subcycle 
    463426                                                        ! used only if sdjf%ln_tint = .TRUE. 
    464       INTEGER  , INTENT(in   ), OPTIONAL ::   time_offset ! Offset of required time level compared to "now" 
    465                                                            ! time level in units of time steps. 
     427      INTEGER  , INTENT(in   ), OPTIONAL ::   kt_offset ! Offset of required time level compared to "now" 
     428                                                        time level in units of time steps. 
    466429      !! 
    467430      LOGICAL  ::   llbefore    ! local definition of ldbefore 
     
    470433      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds) 
    471434      INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file 
    472       INTEGER  ::   itime_add   ! local time offset variable 
     435      INTEGER  ::   it_offset   ! local time offset variable 
    473436      REAL(wp) ::   ztmp        ! temporary variable 
    474437      !!---------------------------------------------------------------------- 
     
    480443      ENDIF 
    481444      ! 
    482       itime_add = 0 
    483       IF( PRESENT(time_offset) ) itime_add = time_offset 
     445      it_offset = 0 
     446      IF( PRESENT(kt_offset) )   it_offset = kt_offset 
     447      IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) 
     448      ELSE                      ;   it_offset =         it_offset   * NINT(       rdttra(1)      ) 
     449      ENDIF 
    484450      ! 
    485451      !                                      ! =========== ! 
     
    499465            !       forcing record :    1  
    500466            !                             
    501             ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 
    502             IF( PRESENT(jit) ) THEN  
    503                ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp) 
    504             ELSE 
    505                ztmp = ztmp + itime_add*rdttra(1) 
    506             ENDIF 
     467            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 + REAL( it_offset, wp ) 
    507468            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    508469            ! swap at the middle of the year 
     
    532493            !       forcing record :  nmonth  
    533494            !                             
    534             ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
    535             IF( PRESENT(jit) ) THEN  
    536                ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp) 
    537             ELSE 
    538                ztmp = ztmp + itime_add*rdttra(1) 
    539             ENDIF 
     495            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 + REAL( it_offset, wp ) 
    540496            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 
    541497            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
     
    563519         ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year 
    564520         ENDIF 
    565          ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1)   ! shift time to be centrered in the middle of sbc time step 
    566          ztmp = ztmp + 0.01 * rdttra(1)                          ! add 0.01 time step to avoid truncation error  
    567          IF( PRESENT(jit) ) THEN  
    568             ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp) 
    569          ELSE 
    570             ztmp = ztmp + itime_add*rdttra(1) 
    571          ENDIF 
     521         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1) + REAL( it_offset, wp )  ! centrered in the middle of sbc time step 
     522         ztmp = ztmp + 0.01 * rdttra(1)                                                 ! avoid truncation error  
    572523         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record 
    573524            ! 
    574             !                  INT( ztmp ) 
     525            !          INT( ztmp/ifreq_sec + 0.5 ) 
    575526            !                     /|\ 
    576527            !                    2 |        *-----( 
     
    578529            !                    0 |--(               
    579530            !                      |--+--|--+--|--+--|--> time 
    580             !                      0 /|\ 1 /|\ 2 /|\ 3 (nsec_year/ifreq_sec) or (nsec_month/ifreq_sec) 
     531            !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec) 
    581532            !                         |     |     | 
    582533            !                         |     |     | 
     
    586537         ELSE                                   ! no time interpolation 
    587538            ! 
    588             !                  INT( ztmp ) 
     539            !           INT( ztmp/ifreq_sec ) 
    589540            !                     /|\ 
    590541            !                    2 |           *-----( 
     
    592543            !                    0 |-----(               
    593544            !                      |--+--|--+--|--+--|--> time 
    594             !                      0 /|\ 1 /|\ 2 /|\ 3 (nsec_year/ifreq_sec) or (nsec_month/ifreq_sec) 
     545            !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec) 
    595546            !                         |     |     | 
    596547            !                         |     |     | 
     
    599550            ztmp= ztmp / REAL(ifreq_sec, wp) 
    600551         ENDIF 
    601          sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record nomber to be read 
     552         sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record number to be read 
    602553 
    603554         iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000       ! end of this record (in second) 
     
    625576      !!---------------------------------------------------------------------- 
    626577      TYPE(FLD), INTENT(inout) ::   sdjf   ! input field related variables 
    627       INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 
     578      TYPE(MAP_POINTER),INTENT(in) ::   map  ! global-to-local mapping indices 
    628579      !! 
    629580      INTEGER                  ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
     
    631582      INTEGER                  ::   ipdom  ! index of the domain 
    632583      !!--------------------------------------------------------------------- 
    633       !       
     584      ! 
    634585      ipk = SIZE( sdjf%fnow, 3 ) 
    635586      ! 
    636       IF( PRESENT(map) ) THEN 
    637          IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 
    638          ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map ) 
     587      IF( ASSOCIATED(map%ptr) ) THEN 
     588         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map%ptr ) 
     589         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map%ptr ) 
    639590         ENDIF 
    640591      ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
     
    659610      ENDIF 
    660611      ! 
    661       sdjf%rotn = .false.   ! vector not yet rotated 
     612      sdjf%rotn(2) = .false.   ! vector not yet rotated 
    662613 
    663614   END SUBROUTINE fld_get 
     
    665616   SUBROUTINE fld_map( num, clvar, dta, nrec, map ) 
    666617      !!--------------------------------------------------------------------- 
    667       !!                    ***  ROUTINE fld_get  *** 
     618      !!                    ***  ROUTINE fld_map  *** 
    668619      !! 
    669620      !! ** Purpose :   read global data from file and map onto local data 
     
    673624      USE bdy_oce, ONLY:  dta_global, dta_global2         ! workspace to read in global data arrays 
    674625#endif  
    675  
    676626      INTEGER                   , INTENT(in ) ::   num     ! stream number 
    677627      CHARACTER(LEN=*)          , INTENT(in ) ::   clvar   ! variable name 
     
    706656#endif 
    707657 
    708  
    709658      IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta 
    710659      IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk 
    711660 
    712  
    713661      SELECT CASE( ipk ) 
    714       CASE(1)    
    715          CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1    ), nrec ) 
    716       CASE DEFAULT 
    717          CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec ) 
     662      CASE(1)        ;   CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1    ), nrec ) 
     663      CASE DEFAULT   ;   CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec ) 
    718664      END SELECT 
    719665      ! 
     
    746692      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
    747693      !! 
    748       INTEGER                           ::   ju, jv, jk   ! loop indices 
     694      INTEGER                           ::   ju,jv,jk,jn  ! loop indices 
    749695      INTEGER                           ::   imf          ! size of the structure sd 
    750696      INTEGER                           ::   ill          ! character length 
     
    761707      DO ju = 1, imf 
    762708         ill = LEN_TRIM( sd(ju)%vcomp ) 
    763          IF( ill > 0 .AND. .NOT. sd(ju)%rotn ) THEN   ! find vector rotations required              
    764              IF( sd(ju)%vcomp(1:1) == 'U' ) THEN      ! east-west component has symbolic name starting with 'U' 
    765                 ! look for the north-south component which has same symbolic name but with 'U' replaced with 'V' 
    766                 clcomp = 'V' // sd(ju)%vcomp(2:ill)   ! works even if ill == 1 
    767                 iv = -1 
    768                 DO jv = 1, imf 
    769                   IF( TRIM(sd(jv)%vcomp) == TRIM(clcomp) )   iv = jv 
    770                 END DO 
    771                 IF( iv > 0 ) THEN   ! fields ju and iv are two components which need to be rotated together 
    772                    DO jk = 1, SIZE( sd(ju)%fnow, 3 ) 
    773                       IF( sd(ju)%ln_tint )THEN 
    774                          CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->i', utmp(:,:) ) 
    775                          CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->j', vtmp(:,:) ) 
    776                          sd(ju)%fdta(:,:,jk,2) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,2) = vtmp(:,:) 
    777                       ELSE  
    778                          CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->i', utmp(:,:) ) 
    779                          CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->j', vtmp(:,:) ) 
    780                          sd(ju)%fnow(:,:,jk  ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk  ) = vtmp(:,:) 
    781                       ENDIF 
    782                    END DO 
    783                    sd(ju)%rotn = .TRUE.               ! vector was rotated  
    784                    IF( lwp .AND. kt == nit000 )   WRITE(numout,*)   & 
    785                       &   'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid' 
    786                 ENDIF 
    787              ENDIF 
    788           ENDIF 
     709         DO jn = 2-COUNT((/sd(ju)%ln_tint/)), 2 
     710            IF( ill > 0 .AND. .NOT. sd(ju)%rotn(jn) ) THEN   ! find vector rotations required              
     711               IF( sd(ju)%vcomp(1:1) == 'U' ) THEN      ! east-west component has symbolic name starting with 'U' 
     712                  ! look for the north-south component which has same symbolic name but with 'U' replaced with 'V' 
     713                  clcomp = 'V' // sd(ju)%vcomp(2:ill)   ! works even if ill == 1 
     714                  iv = -1 
     715                  DO jv = 1, imf 
     716                     IF( TRIM(sd(jv)%vcomp) == TRIM(clcomp) )   iv = jv 
     717                  END DO 
     718                  IF( iv > 0 ) THEN   ! fields ju and iv are two components which need to be rotated together 
     719                     DO jk = 1, SIZE( sd(ju)%fnow, 3 ) 
     720                        IF( sd(ju)%ln_tint )THEN 
     721                           CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->i', utmp(:,:) ) 
     722                           CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->j', vtmp(:,:) ) 
     723                           sd(ju)%fdta(:,:,jk,jn) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,jn) = vtmp(:,:) 
     724                        ELSE  
     725                           CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->i', utmp(:,:) ) 
     726                           CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->j', vtmp(:,:) ) 
     727                           sd(ju)%fnow(:,:,jk   ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk   ) = vtmp(:,:) 
     728                        ENDIF 
     729                     END DO 
     730                     sd(ju)%rotn(jn) = .TRUE.               ! vector was rotated  
     731                     IF( lwp .AND. kt == nit000 )   WRITE(numout,*)   & 
     732                        &   'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid' 
     733                  ENDIF 
     734               ENDIF 
     735            ENDIF 
     736         END DO 
    789737       END DO 
    790738      ! 
     
    801749      !!---------------------------------------------------------------------- 
    802750      TYPE(FLD)        , INTENT(inout) ::   sdjf     ! input field related variables 
    803       INTEGER          , INTENT(in   ) ::   kyear    ! year value 
    804       INTEGER          , INTENT(in   ) ::   kmonth   ! month value 
    805       INTEGER          , INTENT(in   ) ::   kday     ! day value 
     751      INTEGER, OPTIONAL, INTENT(in   ) ::   kyear    ! year value 
     752      INTEGER, OPTIONAL, INTENT(in   ) ::   kmonth   ! month value 
     753      INTEGER, OPTIONAL, INTENT(in   ) ::   kday     ! day value 
    806754      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
    807       !!---------------------------------------------------------------------- 
    808  
    809       IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open 
     755      !! 
     756      LOGICAL :: llprevyr              ! are we reading previous year  file? 
     757      LOGICAL :: llprevmth             ! are we reading previous month file? 
     758      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd 
     759      INTEGER :: isec_week             ! number of seconds since start of the weekly file 
     760      INTEGER :: indexyr               ! year undex (O/1/2: previous/current/next) 
     761      INTEGER :: iyear_len, imonth_len ! length (days) of iyear and imonth             !  
     762      CHARACTER(len = 256)::   clname  ! temporary file name 
     763      !!---------------------------------------------------------------------- 
     764      IF( PRESENT(kyear) ) THEN                             ! use given values  
     765         iyear = kyear 
     766         imonth = kmonth 
     767         iday = kday 
     768      ELSE                                                  ! use current day values 
     769         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
     770            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week 
     771            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
     772            llprevyr   = llprevmth .AND. nmonth == 1 
     773         ELSE 
     774            isec_week  = 0 
     775            llprevmth  = .FALSE. 
     776            llprevyr   = .FALSE. 
     777         ENDIF 
     778         iyear  = nyear  - COUNT((/llprevyr /)) 
     779         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 
     780         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 
     781      ENDIF 
     782 
    810783      ! build the new filename if not climatological data 
    811       sdjf%clname=TRIM(sdjf%clrootname) 
    812       ! 
    813       ! note that sdjf%ln_clim is is only acting on presence of the year in the file 
     784      clname=TRIM(sdjf%clrootname) 
     785      ! 
     786      ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name 
    814787      IF( .NOT. sdjf%ln_clim ) THEN    
    815                                          WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year 
    816          IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month 
     788                                         WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), iyear    ! add year 
     789         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname          ), imonth   ! add month 
    817790      ELSE 
    818791         ! build the new filename if climatological data 
    819          IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
     792         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), imonth   ! add month 
    820793      ENDIF 
    821794      IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 
    822             &                            WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day 
    823       ! 
    824       CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
    825      ! 
     795            &                            WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname          ), iday     ! add day 
     796      ! 
     797      IF( TRIM(clname) /= TRIM(sdjf%clname) .OR. sdjf%num == 0 ) THEN   ! new file to be open  
     798 
     799         sdjf%clname = TRIM(clname) 
     800         IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open 
     801         CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
     802 
     803         ! find the last record to be read -> update sdjf%nreclast 
     804         indexyr = iyear - nyear + 1 
     805         iyear_len = nyear_len( indexyr ) 
     806         SELECT CASE ( indexyr ) 
     807         CASE ( 0 )   ;   imonth_len = 31   ! previous year -> imonth = 12 
     808         CASE ( 1 )   ;   imonth_len = nmonth_len(imonth)  
     809         CASE ( 2 )   ;   imonth_len = 31   ! next     year -> imonth = 1 
     810         END SELECT 
     811          
     812         ! last record to be read in the current file 
     813         IF    ( sdjf%nfreqh == -12 ) THEN                 ;   sdjf%nreclast = 1    !  yearly mean 
     814         ELSEIF( sdjf%nfreqh ==  -1 ) THEN                                          ! monthly mean 
     815            IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = 1 
     816            ELSE                                           ;   sdjf%nreclast = 12 
     817            ENDIF 
     818         ELSE                                                                       ! higher frequency mean (in hours) 
     819            IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = 24 * imonth_len / sdjf%nfreqh  
     820            ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   sdjf%nreclast = 24 * 7          / sdjf%nfreqh 
     821            ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   sdjf%nreclast = 24              / sdjf%nfreqh 
     822            ELSE                                           ;   sdjf%nreclast = 24 * iyear_len  / sdjf%nfreqh  
     823            ENDIF 
     824         ENDIF 
     825          
     826      ENDIF 
     827      ! 
    826828   END SUBROUTINE fld_clopn 
    827829 
     
    845847      DO jf = 1, SIZE(sdf) 
    846848         sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname ) 
     849         sdf(jf)%clname     = "not yet defined" 
    847850         sdf(jf)%nfreqh     = sdf_n(jf)%nfreqh 
    848851         sdf(jf)%clvar      = sdf_n(jf)%clvar 
     
    850853         sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim 
    851854         sdf(jf)%cltype     = sdf_n(jf)%cltype 
    852          sdf(jf)%wgtname = " " 
     855         sdf(jf)%num        = -1 
     856         sdf(jf)%wgtname    = " " 
    853857         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 
    854          sdf(jf)%vcomp   = sdf_n(jf)%vcomp 
    855          sdf(jf)%rotn    = .TRUE. 
     858         sdf(jf)%vcomp      = sdf_n(jf)%vcomp 
     859         sdf(jf)%rotn(:)    = .TRUE.   ! pretend to be rotated -> won't try to rotate data before the first call to fld_get 
     860         IF( sdf(jf)%cltype(1:4) == 'week' .AND. nn_leapy == 0  )   & 
     861            &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs nn_leapy = 1') 
     862         IF( sdf(jf)%cltype(1:4) == 'week' .AND. sdf(jf)%ln_clim )   & 
     863            &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs ln_clim = .FALSE.') 
    856864      END DO 
    857865 
  • trunk/NEMOGCM/NEMO/SAS_SRC/daymod.F90

    r3334 r3851  
    161161         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years 
    162162            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN 
    163                nyear_len(0) = 366 
    164             ENDIF 
    165             IF ( MOD(nyear, 4) == 0 .AND. ( MOD(nyear, 400) == 0 .OR. MOD(nyear, 100) /= 0 ) ) THEN 
     163               nyear_len(0)  = 366 
     164            ENDIF 
     165            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN 
    166166               nmonth_len(2) = 29 
    167                nyear_len(1) = 366 
     167               nyear_len(1)  = 366 
     168            ENDIF 
     169            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN 
     170               nyear_len(2)  = 366 
    168171            ENDIF 
    169172         ENDIF 
Note: See TracChangeset for help on using the changeset viewer.