Changeset 2353


Ignore:
Timestamp:
2010-11-04T12:18:58+01:00 (10 years ago)
Author:
smasson
Message:

nemo_v3_3_beta: cleaning/debug fldread, see Ticket #751

Location:
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r2288 r2353  
    6767      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 
    6868      !!---------------------------------------------------------------------- 
    69       INTEGER :: inbday, irest 
     69      INTEGER :: inbday, idweek 
    7070      REAL(wp) :: zjul 
    7171      !!---------------------------------------------------------------------- 
     
    110110 
    111111      !compute number of days between last monday and today       
    112       IF( nn_leapy==1 )THEN 
    113          CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (monday) 
    114          inbday = INT(fjulday) - NINT(zjul)       ! compute nb day between  01.01.1900 and current day fjulday  
    115          irest = MOD(inbday,7)                    ! compute nb day between last monday and current day fjulday  
    116          IF(irest==0 )irest = 7  
    117       ENDIF 
    118  
    119       ! number of seconds since the beginning of current year/month at the middle of the time-step 
     112      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday) 
     113      inbday = NINT(fjulday - zjul)            ! compute nb day between  01.01.1900 and current day   
     114      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day   
     115 
     116      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step 
    120117      nsec_year  = nday_year * nsecd - ndt05   ! 1 time step before the middle of the first time step 
    121118      nsec_month = nday      * nsecd - ndt05   ! because day will be called at the beginning of step 
     119      nsec_week  = idweek    * nsecd - ndt05 
    122120      nsec_day   =             nsecd - ndt05 
    123       nsec_week  = 0 
    124       IF( nn_leapy==1 ) nsec_week  = irest     * nsecd - ndt05 
    125121 
    126122      ! control print 
     
    213209      nsec_year  = nsec_year  + ndt  
    214210      nsec_month = nsec_month + ndt                  
    215       IF( nn_leapy==1 ) nsec_week  = nsec_week  + ndt 
     211      nsec_week  = nsec_week  + ndt 
    216212      nsec_day   = nsec_day   + ndt                 
    217213      adatrj  = adatrj  + rdttra(1) / rday 
     
    220216      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error 
    221217       
    222       IF( nsec_day > nsecd ) THEN                        ! NEW day 
     218      IF( nsec_day > nsecd ) THEN                       ! New day 
    223219         ! 
    224220         nday      = nday + 1 
     
    226222         nsec_day  = ndt05 
    227223         ! 
    228          IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! NEW month 
     224         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month 
    229225            nday   = 1 
    230226            nmonth = nmonth + 1 
    231227            nsec_month = ndt05 
    232             IF( nmonth == 13 ) THEN                     ! NEW year 
     228            IF( nmonth == 13 ) THEN                     ! New year 
    233229               nyear     = nyear + 1 
    234230               nmonth    = 1 
     
    240236         ENDIF 
    241237         ! 
    242          ndastp = nyear * 10000 + nmonth * 100 + nday   ! NEW date 
     238         ndastp = nyear * 10000 + nmonth * 100 + nday   ! New date 
    243239         ! 
    244240         !compute first day of the year in julian days 
     
    251247      ENDIF 
    252248 
    253       IF( nsec_week .GT. 7*86400 ) nsec_week = ndt05 
     249      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week 
    254250       
    255251      IF(ln_ctl) THEN 
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r2351 r2353  
    3333      CHARACTER(len = 34)  ::   wname       ! generic name of a NetCDF weights file to be used, blank if not 
    3434      CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation 
    35                                            ! a string starting with "U" or "V" for each component    
    36                                            ! chars 2 onwards identify which components go together   
     35                                            ! a string starting with "U" or "V" for each component    
     36                                            ! chars 2 onwards identify which components go together   
    3737   END TYPE FLD_N 
    3838 
     
    4646      CHARACTER(len = 8)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly' 
    4747      INTEGER                         ::   num          ! iom id of the jpfld files to be read 
    48       INTEGER                         ::   nswap_sec    ! swapping time in second since Jan. 1st 00h of nit000 year 
    4948      INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    5049      INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
     
    5453                                                        ! into the WGTLIST structure 
    5554      CHARACTER(len = 34)             ::   vcomp        ! symbolic name for a vector component that needs rotation 
    56       LOGICAL ,  DIMENSION(2)         ::   rotn         ! flag to indicate whether field has been rotated 
     55      LOGICAL                         ::   rotn         ! flag to indicate whether field has been rotated 
    5756   END TYPE FLD 
    5857 
     
    7675                                                                ! =-1 not cyclic 
    7776      LOGICAL                                 ::   cyclic       ! east-west cyclic or not 
    78       INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpi     ! array of source integers 
    79       INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpj     ! array of source integers 
     77      INTEGER,  DIMENSION(:,:,:), POINTER     ::   data_jpi     ! array of source integers 
     78      INTEGER,  DIMENSION(:,:,:), POINTER     ::   data_jpj     ! array of source integers 
    8079      REAL(wp), DIMENSION(:,:,:), POINTER     ::   data_wgt     ! array of weights on model grid 
    8180      REAL(wp), DIMENSION(:,:,:), POINTER     ::   fly_dta      ! array of values on input grid 
     
    115114      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
    116115      !! 
    117       CHARACTER (LEN=34)                     ::   acomp     ! dummy weight name 
    118       INTEGER                                ::   kf, nf    ! dummy indices 
    119       INTEGER                                ::   imf       ! size of the structure sd 
    120       REAL(wp), DIMENSION(jpi,jpj)           ::   utmp, vtmp! temporary arrays for vector rotation 
    121  
     116      INTEGER  ::   imf        ! size of the structure sd 
    122117      INTEGER  ::   jf         ! dummy indices 
    123       INTEGER  ::   jk         ! dummy indices 
    124       INTEGER  ::   ipk        ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    125       INTEGER  ::   kw         ! index into wgts array 
    126118      INTEGER  ::   ireclast   ! last record to be read in the current year file 
    127119      INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend 
     120      INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 
    128121      LOGICAL  ::   llnxtyr    ! open next year  file? 
    129122      LOGICAL  ::   llnxtmth   ! open next month file? 
     
    133126      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    134127      !!--------------------------------------------------------------------- 
    135       ! 
     128      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
     129      isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1))   ! middle of sbc time step 
    136130      imf = SIZE( sd ) 
    137       !                                         ! ===================== ! 
    138       DO jf = 1, imf                            !    LOOP OVER FIELD    ! 
    139          !                                      ! ===================== ! 
    140          ! 
    141          IF( kt == nit000 )   CALL fld_init( sd(jf) ) 
    142          ! 
    143          ! read/update the after data? 
    144          IF( nsec_year + nsec1jan000 > sd(jf)%nswap_sec ) THEN  
    145  
    146             IF( sd(jf)%ln_tint ) THEN         ! time interpolation: swap before record field 
     131      ! 
     132      IF( kt == nit000 ) THEN                      ! initialization 
     133         DO jf = 1, imf  
     134            CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped) 
     135         END DO 
     136         IF( lwp ) CALL wgt_print()                ! control print 
     137         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed 
     138      ENDIF 
     139      !                                            ! ====================================== ! 
     140      IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! update field at each kn_fsbc time-step ! 
     141         !                                         ! ====================================== ! 
     142         ! 
     143         DO jf = 1, imf                            ! ---   loop over field   --- ! 
     144             
     145            IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000 ) THEN  ! read/update the after data? 
     146 
     147               IF( sd(jf)%ln_tint ) THEN                             ! swap before record field and informations 
     148                  sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:) 
    147149!CDIR COLLAPSE 
    148                sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 
    149                sd(jf)%rotn(1)       = sd(jf)%rotn(2) 
     150                  sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 
     151               ENDIF 
     152 
     153               CALL fld_rec( kn_fsbc, sd(jf) )                       ! update record informations 
     154 
     155               ! do we have to change the year/month/week/day of the forcing field??  
     156               IF( sd(jf)%ln_tint ) THEN 
     157                  ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current 
     158                  ! 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) 
     159                  ! will be larger than the record number that should be read for current year/month/week/day 
     160 
     161                  ! last record to be read in the current file 
     162                  IF    ( sd(jf)%nfreqh == -12 ) THEN                 ;   ireclast = 1    !  yearly mean 
     163                  ELSEIF( sd(jf)%nfreqh ==  -1 ) THEN                                     ! monthly mean 
     164                     IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 1 
     165                     ELSE                                             ;   ireclast = 12 
     166                     ENDIF 
     167                  ELSE                                                                    ! higher frequency mean (in hours) 
     168                     IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh  
     169                     ELSEIF( sd(jf)%cltype(1:4) == 'week'    ) THEN   ;   ireclast = 24 * 7                  / sd(jf)%nfreqh 
     170                     ELSEIF( sd(jf)%cltype      == 'daily'   ) THEN   ;   ireclast = 24                      / sd(jf)%nfreqh 
     171                     ELSE                                             ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh  
     172                     ENDIF 
     173                  ENDIF 
     174 
     175                  ! do we need next file data? 
     176                  IF( sd(jf)%nrec_a(1) > ireclast ) THEN 
     177 
     178                     sd(jf)%nrec_a(1) = 1              ! force to read the first record of the next file 
     179 
     180                     IF( .NOT. sd(jf)%ln_clim ) THEN   ! close the current file and open a new one. 
     181 
     182                        llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file? 
     183                        llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file? 
     184 
     185                        ! if the run finishes at the end of the current year/month/week/day, we will allow next 
     186                        ! year/month/week/day file to be not present. If the run continue further than the current 
     187                        ! year/month/week/day, next year/month/week/day file must exist 
     188                        isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run  
     189                        llstop = isecend > sd(jf)%nrec_a(2)                                   ! read more than 1 record of next year 
     190 
     191                        CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         & 
     192                           &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         & 
     193                           &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop ) 
     194 
     195                        IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist 
     196                           CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)//     & 
     197                              &     ' not present -> back to current year/month/day') 
     198                           CALL fld_clopn( sd(jf), nyear, nmonth, nday )       ! back to the current year/month/day 
     199                           sd(jf)%nrec_a(1) = ireclast     ! force to read the last record to be read in the current year file 
     200                        ENDIF 
     201 
     202                     ENDIF 
     203                  ENDIF 
     204 
     205               ELSE 
     206                  ! if we are not doing time interpolation, we must change the year/month/week/day of the file just after 
     207                  ! switching to the NEW year/month/week/day. If it is the case, we are at the beginning of the 
     208                  ! year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1) = 1 
     209                  IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) )   & 
     210                     &   CALL fld_clopn( sd(jf), nyear, nmonth, nday ) 
     211               ENDIF 
     212 
     213               ! read after data 
     214               CALL fld_get( sd(jf) ) 
     215 
    150216            ENDIF 
    151  
    152             ! update record informations 
    153             CALL fld_rec( sd(jf) ) 
    154  
    155             ! do we have to change the year/month/day of the forcing field??  
    156             IF( sd(jf)%ln_tint ) THEN 
    157                ! if we do time interpolation we will need to open next year/month/day file before the end of the current one 
    158                ! if so, we are still before the end of the year/month/day when calling fld_rec so sd(jf)%nrec_a(1) will be 
    159                ! larger than the record number that should be read for current year/month/day (for ex. 13 for monthly mean file) 
    160  
    161                ! last record to be read in the current file 
    162                IF( sd(jf)%nfreqh == -1 ) THEN 
    163                   IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 1 
    164                   ELSE                                         ;   ireclast = 12 
    165                   ENDIF 
    166                ELSE                              
    167                   IF(     sd(jf)%cltype      == 'monthly' ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh  
    168                   ELSEIF( sd(jf)%cltype(1:4) == 'week'    ) THEN  ;   ireclast = 24.* 7                  / sd(jf)%nfreqh 
    169                   ELSEIF( sd(jf)%cltype      == 'daily'   ) THEN  ;   ireclast = 24                      / sd(jf)%nfreqh 
    170                   ELSE                                            ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh  
    171                   ENDIF 
    172                ENDIF 
    173                
    174                ! do we need next file data? 
    175                IF( sd(jf)%nrec_a(1) > ireclast ) THEN 
    176  
    177                   sd(jf)%nrec_a(1) = 1              ! force to read the first record of the next file 
    178  
    179                   IF( .NOT. sd(jf)%ln_clim ) THEN   ! close the current file and open a new one. 
    180  
    181                      llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file? 
    182                      llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file? 
    183  
    184                      ! if the run finishes at the end of the current year/month/day, we will allow next year/month/day file to be 
    185                      ! not present. If the run continue further than the current year/month/day, next year/month/day file must exist 
    186                      isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run  
    187                      llstop = isecend > sd(jf)%nswap_sec                                   ! read more than 1 record of next year 
    188  
    189                      CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         & 
    190                         &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         & 
    191                         &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop ) 
    192  
    193                      IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist 
    194                         CALL ctl_warn('next year/month/day file: '//TRIM(sd(jf)%clname)//     & 
    195                                 &     ' not present -> back to current year/month/day') 
    196                         CALL fld_clopn( sd(jf), nyear, nmonth, nday )       ! back to the current year/month/day 
    197                         sd(jf)%nrec_a(1) = ireclast     ! force to read the last record to be read in the current year file 
    198                      ENDIF 
    199  
    200                   ENDIF  
    201                ENDIF 
    202          
    203             ELSE 
    204                ! if we are not doing time interpolation, we must change the year/month/day of the file just after switching 
    205                ! to the NEW year/month/day. If it is the case, we are at the beginning of the year/month/day when calling  
    206                ! fld_rec so sd(jf)%nrec_a(1) = 1 
    207                IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. sd(jf)%ln_clim )   CALL fld_clopn( sd(jf), nyear, nmonth, nday ) 
    208             ENDIF 
    209  
    210             ! read after data 
    211             ipk = SIZE( sd(jf)%fnow, 3 ) 
    212             IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 
    213                CALL wgt_list( sd(jf), kw ) 
    214                ipk = SIZE(sd(jf)%fnow,3) 
    215                IF( sd(jf)%ln_tint ) THEN 
    216                   CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fdta(:,:,:,2) , sd(jf)%nrec_a(1) ) 
    217                ELSE 
    218                   CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fnow(:,:,:)   , sd(jf)%nrec_a(1) ) 
    219                ENDIF 
    220             ELSE 
    221                SELECT CASE( SIZE(sd(jf)%fnow,3) ) 
    222                CASE(1)    
    223                   IF( sd(jf)%ln_tint ) THEN 
    224                      CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 
    225                   ELSE 
    226                      CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,1)  , sd(jf)%nrec_a(1) ) 
    227                   ENDIF  
    228                CASE(jpk) 
    229                   IF( sd(jf)%ln_tint ) THEN 
    230                      CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 
    231                   ELSE 
    232                      CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,:)  , sd(jf)%nrec_a(1) ) 
    233                   ENDIF  
    234                END SELECT 
    235             ENDIF 
    236             sd(jf)%rotn(2) = .FALSE. 
    237  
    238          ENDIF 
    239          !                                      ! ===================== ! 
    240       END DO                                    !  END LOOP OVER FIELD  ! 
    241       !                                         ! ===================== ! 
    242  
    243       IF( kt == nit000 .AND. lwp ) CALL wgt_print() 
    244  
    245       !! Vector fields may need to be rotated onto the local grid direction 
    246       !! This has to happen before the time interpolations 
    247       !! (sga: following code should be modified so that pairs arent searched for each time 
    248  
    249       DO jf = 1, imf 
    250          !! find vector rotations required  
    251          IF( LEN(TRIM(sd(jf)%vcomp)) > 0 ) THEN 
    252              !! east-west component has symbolic name starting with 'U' 
    253              IF( sd(jf)%vcomp(1:1) == 'U' ) THEN 
    254                 !! found an east-west component, look for the north-south component 
    255                 !! which has same symbolic name but with 'U' replaced with 'V' 
    256                 nf = LEN_TRIM( sd(jf)%vcomp ) 
    257                 IF( nf == 1) THEN 
    258                    acomp = 'V' 
    259                 ELSE 
    260                    acomp = 'V' // sd(jf)%vcomp(2:nf) 
    261                 ENDIF 
    262                 kf = -1 
    263                 DO nf = 1, imf 
    264                   IF( TRIM(sd(nf)%vcomp) == TRIM(acomp) ) kf = nf 
    265                 END DO 
    266                 IF( kf > 0 ) THEN 
    267                    !! fields jf,kf are two components which need to be rotated together 
    268                    IF( sd(jf)%ln_tint )THEN 
    269                       DO nf = 1,2 
    270                          !! check each time level of this pair 
    271                          IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN 
    272                             utmp(:,:) = 0.0 
    273                             vtmp(:,:) = 0.0 
    274                             ! 
    275                             ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 ) 
    276                             DO jk = 1,ipk 
    277                                CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 
    278                                CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 
    279                                sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 
    280                                sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 
    281                             ENDDO 
    282                             ! 
    283                             sd(jf)%rotn(nf) = .TRUE. 
    284                             sd(kf)%rotn(nf) = .TRUE. 
    285                             IF( lwp .AND. kt == nit000 ) & 
    286                                       WRITE(numout,*) 'fld_read: vector pair (',  & 
    287                                                       TRIM(sd(jf)%clvar),',',TRIM(sd(kf)%clvar), & 
    288                                                       ') rotated on to model grid' 
    289                          ENDIF 
    290                       END DO 
    291                    ELSE  
    292                       !! check each time level of this pair 
    293                       IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN 
    294                          utmp(:,:) = 0.0 
    295                          vtmp(:,:) = 0.0 
    296                          ! 
    297                          ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 ) 
    298                          DO jk = 1,ipk 
    299                             CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->i', utmp(:,:) ) 
    300                             CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->j', vtmp(:,:) ) 
    301                             sd(jf)%fnow(:,:,jk) = utmp(:,:) 
    302                             sd(kf)%fnow(:,:,jk) = vtmp(:,:) 
    303                          ENDDO 
    304                          ! 
    305                          sd(jf)%rotn(nf) = .TRUE. 
    306                          sd(kf)%rotn(nf) = .TRUE. 
    307                          IF( lwp .AND. kt == nit000 ) & 
    308                                    WRITE(numout,*) 'fld_read: vector pair (',  & 
    309                                                    TRIM(sd(jf)%clvar),',',TRIM(sd(kf)%clvar), & 
    310                                                    ') rotated on to model grid' 
    311                       ENDIF 
    312                    ENDIF 
    313                 ENDIF 
    314              ENDIF 
    315          ENDIF 
    316       END DO 
    317  
    318       !                                         ! ===================== ! 
    319       DO jf = 1, imf                            !    LOOP OVER FIELD    ! 
    320          !                                      ! ===================== ! 
    321          ! 
    322          ! update field at each kn_fsbc time-step 
    323          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN    
     217         END DO                                    ! --- end loop over field --- ! 
     218 
     219         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed 
     220 
     221         DO jf = 1, imf                            ! ---   loop over field   --- ! 
    324222            ! 
    325             IF( sd(jf)%ln_tint ) THEN 
     223            IF( sd(jf)%ln_tint ) THEN              ! temporal interpolation 
    326224               IF(lwp .AND. kt - nit000 <= 100 ) THEN  
    327                   clfmt = "('fld_read: var ', a, ' kt = ', i8,' Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
    328                      &    "' records b/a: ', i4.4, '/', i4.4, ' (', f7.2,'/', f7.2, ' days)')" 
    329                   WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, nyear, nmonth, nday,   & 
     225                  clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
     226                     &    "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')" 
     227                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   & 
    330228                     & 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 
    331229               ENDIF 
    332                ! 
    333                ztinta =  REAL( nsec_year + nsec1jan000 - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp ) 
     230               ! temporal interpolation weights 
     231               ztinta =  REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp ) 
    334232               ztintb =  1. - ztinta 
    335233!CDIR COLLAPSE 
    336234               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 
    337             ELSE 
     235            ELSE   ! nothing to do... 
    338236               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
    339                   clfmt = "('fld_read: var ', a, ' kt = ', i8,' Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
    340                      &    "' record: ', i4.4, ' at ', f7.2, ' day')" 
    341                   WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, nyear, nmonth, nday, sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_a(2),wp)/rday 
     237                  clfmt = "('fld_read: var ', a, ' kt = ', i8,' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
     238                     &    "', record: ', i4.4, ' (days ', f7.2, ' <-> ', f7.2, ')')" 
     239                  WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,    & 
     240                     &                 sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 
    342241               ENDIF 
    343 !CDIR COLLAPSE 
    344242            ENDIF 
    345243            ! 
    346          ENDIF 
    347  
    348          IF( kt == nitend )   CALL iom_close( sd(jf)%num )   ! Close the input files 
    349  
    350          !                                      ! ===================== ! 
    351       END DO                                    !  END LOOP OVER FIELD  ! 
    352       !                                         ! ===================== ! 
     244            IF( kt == nitend - kn_fsbc + 1 )   CALL iom_close( sd(jf)%num )   ! Close the input files 
     245 
     246         END DO                                    ! --- end loop over field --- ! 
     247         ! 
     248         !                                         ! ====================================== ! 
     249      ENDIF                                        ! update field at each kn_fsbc time-step ! 
     250      !                                            ! ====================================== ! 
     251      ! 
    353252   END SUBROUTINE fld_read 
    354253 
    355254 
    356    SUBROUTINE fld_init( sdjf ) 
     255   SUBROUTINE fld_init( kn_fsbc, sdjf ) 
    357256      !!--------------------------------------------------------------------- 
    358257      !!                    ***  ROUTINE fld_init  *** 
     
    363262      !! ** Method  :    
    364263      !!---------------------------------------------------------------------- 
    365       TYPE(FLD), INTENT(inout) ::   sdjf        ! input field related variables 
     264      INTEGER  , INTENT(in   ) ::   kn_fsbc   ! sbc computation period (in time step)  
     265      TYPE(FLD), INTENT(inout) ::   sdjf      ! input field related variables 
    366266      !! 
    367267      LOGICAL :: llprevyr              ! are we reading previous year  file? 
    368268      LOGICAL :: llprevmth             ! are we reading previous month file? 
    369       LOGICAL :: llprevweek            ! are we reading previous week file? 
     269      LOGICAL :: llprevweek            ! are we reading previous week  file? 
    370270      LOGICAL :: llprevday             ! are we reading previous day   file? 
    371       LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevday 
     271      LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 
    372272      INTEGER :: idvar                 ! variable id  
    373273      INTEGER :: inrec                 ! number of record existing for this variable 
    374       INTEGER :: kwgt 
    375       INTEGER :: jk             !vertical loop variable 
    376       INTEGER :: ipk            !number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    377274      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd 
    378275      INTEGER :: isec_week             ! number of seconds since start of the weekly file 
     
    389286      isec_week  = 0 
    390287             
     288      IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy == 0 )   & 
     289         &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs nn_leapy = 1') 
     290      IF( sdjf%cltype(1:4) == 'week' .AND. sdjf%ln_clim  )   & 
     291         &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs ln_clim = .FALSE.') 
     292 
    391293      ! define record informations 
    392       CALL fld_rec( sdjf ) 
     294      CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later) 
     295 
     296      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
    393297 
    394298      IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure 
    395           
    396          IF( sdjf%nrec_b(1) == 0  ) THEN   ! we redefine record sdjf%nrec_b(1) with the last record of previous year file 
    397             IF( sdjf%nfreqh == -1 ) THEN   ! monthly mean 
    398                IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file 
    399                   sdjf%nrec_b(1) = 1                                                       ! force to read the unique record 
     299 
     300         IF( sdjf%nrec_a(1) == 0  ) THEN   ! we redefine record sdjf%nrec_a(1) with the last record of previous year file 
     301            IF    ( sdjf%nfreqh == -12 ) THEN   ! yearly mean 
     302               IF( sdjf%cltype == 'yearly' ) THEN             ! yearly file 
     303                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record 
     304                  llprevyr  = .NOT. sdjf%ln_clim                                           ! use previous year  file? 
     305               ELSE 
     306                  CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clname) ) 
     307               ENDIF 
     308            ELSEIF( sdjf%nfreqh ==  -1 ) THEN   ! monthly mean 
     309               IF( sdjf%cltype == 'monthly' ) THEN            ! monthly file 
     310                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record 
    400311                  llprevmth = .TRUE.                                                       ! use previous month file? 
    401312                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    402                ELSE                                  ! yearly file 
    403                   sdjf%nrec_b(1) = 12                                                      ! force to read december mean 
     313               ELSE                                           ! yearly file 
     314                  sdjf%nrec_a(1) = 12                                                      ! force to read december mean 
    404315                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file? 
    405316               ENDIF 
    406             ELSE    
    407                IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file 
    408                   sdjf%nrec_b(1) = 24 * nmonth_len(nmonth-1) / sdjf%nfreqh                 ! last record of previous month 
    409                   llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file? 
     317            ELSE                                ! higher frequency mean (in hours)  
     318               IF    ( sdjf%cltype      == 'monthly' ) THEN   ! monthly file 
     319                  sdjf%nrec_a(1) = 24 * nmonth_len(nmonth-1) / sdjf%nfreqh                 ! last record of previous month 
     320                  llprevmth = .TRUE.                                                       ! use previous month file? 
    410321                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    411                ELSE IF ( sdjf%cltype(1:4) == 'week' ) THEN !weekly file 
    412                   isec_week = 86400 * 7 
    413                   sdjf%nrec_b(1) = 24. / sdjf%nfreqh * 7                                   ! last record of previous weekly file 
    414                ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file 
    415                   sdjf%nrec_b(1) = 24 / sdjf%nfreqh                                        ! last record of previous day 
    416                   llprevday = .NOT. sdjf%ln_clim                                           ! use previous day   file? 
     322               ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ! weekly file 
     323                  llprevweek = .TRUE.                                                      ! use previous week  file? 
     324                  sdjf%nrec_a(1) = 24 * 7 / sdjf%nfreqh                                    ! last record of previous week 
     325                  isec_week = NINT(rday) * 7                                               ! add a shift toward previous week 
     326               ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ! daily file 
     327                  sdjf%nrec_a(1) = 24 / sdjf%nfreqh                                        ! last record of previous day 
     328                  llprevday = .TRUE.                                                       ! use previous day   file? 
    417329                  llprevmth = llprevday .AND. nday   == 1                                  ! use previous month file? 
    418330                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    419                ELSE                                  ! yearly file 
    420                   sdjf%nrec_b(1) = 24 * nyear_len(0) / sdjf%nfreqh                         ! last record of year month 
     331               ELSE                                           ! yearly file 
     332                  sdjf%nrec_a(1) = 24 * nyear_len(0) / sdjf%nfreqh                         ! last record of previous year  
    421333                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file? 
    422334               ENDIF 
    423335            ENDIF 
    424336         ENDIF 
     337         IF ( sdjf%cltype(1:4) == 'week' ) THEN 
     338            isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week 
     339            llprevmth = isec_week > nsec_month                      ! longer time since the beginning of the week than the month 
     340            llprevyr  = llprevmth .AND. nmonth == 1 
     341         ENDIF 
    425342         llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 
    426  
    427          CALL fld_clopn( sdjf, nyear  - COUNT((/llprevyr /))                                              ,               & 
    428             &                  nmonth - COUNT((/llprevmth/)) + 12                   * COUNT((/llprevyr /)),               & 
    429             &                  nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev ) 
    430  
    431          IF ( sdjf%cltype(1:4) == 'week' ) THEN 
    432             isec_week  = ksec_week( sdjf%cltype(6:8) ) 
    433             if(lwp)write(numout,*)'cbr test2 isec_week = ',isec_week 
    434             llprevmth  = ( isec_week .GT. nsec_month ) 
    435             llprevyr   = llprevmth  .AND. nmonth==1 
    436          ENDIF 
    437343         ! 
    438344         iyear  = nyear  - COUNT((/llprevyr /)) 
    439          imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 
    440          iday   = nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - INT( isec_week )/86400 
    441          ! 
    442          CALL fld_clopn( sdjf , iyear , imonth , iday , .NOT. llprev ) 
     345         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 
     346         iday   = nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 
     347         ! 
     348         CALL fld_clopn( sdjf, iyear, imonth, iday, .NOT. llprev ) 
    443349 
    444350         ! if previous year/month/day file does not exist, we switch to the current year/month/day 
    445351         IF( llprev .AND. sdjf%num <= 0 ) THEN 
    446             CALL ctl_warn( 'previous year/month/day file: '//TRIM(sdjf%clname)//' not present -> back to current year/month/day') 
     352            CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clname)//   & 
     353               &           ' not present -> back to current year/month/week/day' ) 
    447354            ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day 
    448             llprev = .false. 
    449             sdjf%nrec_b(1) = 1 
     355            llprev = .FALSE. 
     356            sdjf%nrec_a(1) = 1 
    450357            CALL fld_clopn( sdjf, nyear, nmonth, nday ) 
    451358         ENDIF 
     
    455362            IF( idvar <= 0 )   RETURN 
    456363            inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar )   ! size of the last dim of idvar 
    457             sdjf%nrec_b(1) = MIN( sdjf%nrec_b(1), inrec )   ! make sure we select an existing record 
    458          ENDIF 
    459  
    460          ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 
    461          IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    462             CALL wgt_list( sdjf, kwgt ) 
    463             ipk = SIZE(sdjf%fnow,3) 
    464             IF( sdjf%ln_tint ) THEN 
    465                CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
    466             ELSE 
    467                CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fnow(:,:,:)  , sdjf%nrec_a(1) ) 
    468             ENDIF 
     364            sdjf%nrec_a(1) = MIN( sdjf%nrec_a(1), inrec )   ! make sure we select an existing record 
     365         ENDIF 
     366 
     367         ! read before data  
     368         CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later) 
     369 
     370         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" 
     371         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday 
     372 
     373         IF( llprev )   CALL iom_close( sdjf%num )          ! force to close previous year file (-> redefine sdjf%num to 0) 
     374 
     375      ENDIF 
     376 
     377      ! make sure current year/month/day file is opened 
     378      IF( sdjf%num <= 0 ) THEN 
     379         ! 
     380         IF ( sdjf%cltype(1:4) == 'week' ) THEN 
     381            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week 
     382            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
     383            llprevyr   = llprevmth .AND. nmonth == 1 
    469384         ELSE 
    470             SELECT CASE( SIZE(sdjf%fnow,3) ) 
    471             CASE(1) 
    472                IF( sdjf%ln_tint ) THEN 
    473                   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 
    474                ELSE 
    475                   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1)  , sdjf%nrec_b(1) ) 
    476                ENDIF 
    477             CASE(jpk) 
    478                IF( sdjf%ln_tint ) THEN 
    479                   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 
    480                ELSE 
    481                   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:)  , sdjf%nrec_b(1) ) 
    482                ENDIF 
    483             END SELECT 
    484          ENDIF 
    485          sdjf%rotn(2) = .FALSE. 
    486  
    487          clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" 
    488          IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_b(1), REAL(sdjf%nrec_b(2),wp)/rday 
    489  
    490          IF( llprev )   CALL iom_close( sdjf%num )   ! close previous year file (-> redefine sdjf%num to 0) 
    491  
    492       ENDIF 
    493  
    494       IF( sdjf%num <= 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened 
    495       ! make sure current year/month/day file is opened 
    496       IF( sdjf%num == 0 ) THEN 
    497          isec_week   = 0 
    498          llprevyr    = .FALSE. 
    499          llprevmth   = .FALSE. 
    500          llprevweek  = .FALSE. 
    501          ! 
    502          IF ( sdjf%cltype(1:4) == 'week' ) THEN 
    503             isec_week  = ksec_week( sdjf%cltype(6:8) ) 
    504             llprevmth  = ( isec_week .GT. nsec_month ) 
    505             llprevyr   = llprevmth  .AND. nmonth==1 
     385            isec_week  = 0 
     386            llprevmth  = .FALSE. 
     387            llprevyr   = .FALSE. 
    506388         ENDIF 
    507389         ! 
    508390         iyear  = nyear  - COUNT((/llprevyr /)) 
    509          imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 
    510          iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week/86400 
     391         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 
     392         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 
    511393         ! 
    512394         CALL fld_clopn( sdjf, iyear, imonth, iday ) 
    513395      ENDIF  
    514396 
    515       sdjf%nswap_sec = nsec_year + nsec1jan000 - 1   ! force read/update the after data in the following part of fld_read  
    516       
    517  
    518397   END SUBROUTINE fld_init 
    519398 
    520399 
    521    SUBROUTINE fld_rec( sdjf ) 
     400   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore ) 
    522401      !!--------------------------------------------------------------------- 
    523402      !!                    ***  ROUTINE fld_rec  *** 
    524403      !! 
    525       !! ** Purpose :   compute nrec_a, nrec_b and nswap_sec 
     404      !! ** Purpose : Compute 
     405      !!              if sdjf%ln_tint = .TRUE. 
     406      !!                  nrec_a: record number and its time (nrec_b is obtained from nrec_a when swapping) 
     407      !!              if sdjf%ln_tint = .FALSE. 
     408      !!                  nrec_a(1): record number 
     409      !!                  nrec_b(2) and nrec_a(2): time of the beginning and end of the record (for print only) 
    526410      !! 
    527411      !! ** Method  :    
    528412      !!---------------------------------------------------------------------- 
    529       TYPE(FLD), INTENT(inout) ::   sdjf        ! input field related variables 
    530       !! 
    531       INTEGER  ::   irec        ! record number 
    532       INTEGER  ::   isecd       ! rday 
    533       REAL(wp) ::   ztmp        ! temporary variable 
     413      INTEGER  , INTENT(in   )           ::   kn_fsbc   ! sbc computation period (in time step)  
     414      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables 
     415      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.) 
     416                                                        ! used only if sdjf%ln_tint = .TRUE. 
     417      !! 
     418      LOGICAL  ::   llbefore    ! local definition of ldbefore 
     419      INTEGER  ::   iendrec     ! end of this record (in seconds) 
     420      INTEGER  ::   imth        ! month number 
    534421      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds) 
    535422      INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file 
    536       !!---------------------------------------------------------------------- 
    537       ! 
    538       IF( sdjf%nfreqh == -1 ) THEN      ! monthly mean 
     423      REAL(wp) ::   ztmp        ! temporary variable 
     424      !!---------------------------------------------------------------------- 
     425      ! 
     426      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
     427      ! 
     428      IF( PRESENT(ldbefore) ) THEN   ;   llbefore = ldbefore .AND. sdjf%ln_tint   ! needed only if sdjf%ln_tint = .TRUE. 
     429      ELSE                           ;   llbefore = .FALSE. 
     430      ENDIF 
     431      ! 
     432      !                                      ! =========== ! 
     433      IF    ( sdjf%nfreqh == -12 ) THEN      ! yearly mean 
     434         !                                   ! =========== ! 
     435         ! 
     436         IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record 
     437            ! 
     438            !                  INT( ztmp ) 
     439            !                     /|\ 
     440            !                    1 |    *---- 
     441            !                    0 |----(               
     442            !                      |----+----|--> time 
     443            !                      0   /|\   1   (nday/nyear_len(1)) 
     444            !                           |    
     445            !                           |    
     446            !       forcing record :    1  
     447            !                             
     448            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 
     449            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
     450            ! swap at the middle of the year 
     451            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0) 
     452            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1)    
     453            ENDIF 
     454         ELSE                                    ! no time interpolation 
     455            sdjf%nrec_a(1) = 1 
     456            sdjf%nrec_a(2) = NINT(rday) * nyear_len(1) + nsec1jan000   ! swap at the end    of the year 
     457            sdjf%nrec_b(2) = nsec1jan000                               ! beginning of the year (only for print) 
     458         ENDIF 
     459         ! 
     460         !                                   ! ============ ! 
     461      ELSEIF( sdjf%nfreqh ==  -1 ) THEN      ! monthly mean ! 
     462         !                                   ! ============ ! 
    539463         ! 
    540464         IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record 
     
    550474            !       forcing record :  nmonth  
    551475            !                             
    552             ztmp  = 0.e0 
    553             ztmp  = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
    554          ELSE 
    555             ztmp  = 0.e0 
    556          ENDIF 
    557          irec = nmonth + INT( ztmp ) 
    558  
    559          IF( sdjf%ln_tint ) THEN   ;   sdjf%nswap_sec = nmonth_half(irec) + nsec1jan000   ! swap at the middle of the month 
    560          ELSE                      ;   sdjf%nswap_sec = nmonth_end (irec) + nsec1jan000   ! swap at the end    of the month 
    561          ENDIF 
    562  
    563          IF( sdjf%cltype == 'monthly' ) THEN 
    564  
    565             sdjf%nrec_b(:) = (/ 0, nmonth_half(irec - 1 ) + nsec1jan000 /) 
    566             sdjf%nrec_a(:) = (/ 1, nmonth_half(irec     ) + nsec1jan000 /) 
    567  
    568             IF( ztmp  == 1. ) THEN 
    569               sdjf%nrec_b(1) = 1 
    570               sdjf%nrec_a(1) = 2 
     476            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
     477            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 
     478            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
     479            ELSE                                  ;   sdjf%nrec_a(1) = imth 
    571480            ENDIF 
    572  
    573          ELSE 
    574  
    575             sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time 
    576             irec = irec - 1                                                ! move back to previous record 
    577             sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time 
    578  
    579          ENDIF 
    580          ! 
    581       ELSE                              ! higher frequency mean (in hours) 
    582          ! 
    583          ifreq_sec = sdjf%nfreqh * 3600   ! frequency mean (in seconds) 
    584          IF( sdjf%cltype(1:4) == 'week'    ) isec_week = ksec_week( sdjf%cltype(6:8)) !since the first day of the current week 
     481            sdjf%nrec_a(2) = nmonth_half(   imth ) + nsec1jan000   ! swap at the middle of the month 
     482         ELSE                                    ! no time interpolation 
     483            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 
     484            ELSE                                  ;   sdjf%nrec_a(1) = nmonth 
     485            ENDIF 
     486            sdjf%nrec_a(2) =  nmonth_end(nmonth  ) + nsec1jan000   ! swap at the end    of the month 
     487            sdjf%nrec_b(2) =  nmonth_end(nmonth-1) + nsec1jan000   ! beginning of the month (only for print) 
     488         ENDIF 
     489         ! 
     490         !                                   ! ================================ ! 
     491      ELSE                                   ! higher frequency mean (in hours) 
     492         !                                   ! ================================ ! 
     493         ! 
     494         ifreq_sec = sdjf%nfreqh * 3600                                                 ! frequency mean (in seconds) 
     495         IF( sdjf%cltype(1:4) == 'week' )   isec_week = ksec_week( sdjf%cltype(6:8) )   ! since the first day of the current week 
    585496         ! number of second since the beginning of the file 
    586          IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month ,wp)  ! since 00h on the 1st day of the current month 
    587          ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week  ,wp)  ! since the first day of the current week 
    588          ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day   ,wp)  ! since 00h of the current day 
    589          ELSE                                           ;   ztmp = REAL(nsec_year  ,wp)  ! since 00h on Jan 1 of the current year 
    590          ENDIF 
     497         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)  ! since the first day of the current month 
     498         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week ,wp)  ! since the first day of the current week 
     499         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)  ! since 00h of the current day 
     500         ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year 
     501         ENDIF 
     502         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1)   ! shift time to be centrered in the middle of sbc time step 
     503         ztmp = ztmp + 0.01 * rdttra(1)                          ! add 0.01 time step to avoid truncation error  
    591504         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record 
    592505            ! 
     
    602515            !       forcing record :  1     2     3 
    603516            !                    
    604             ztmp= ztmp / ifreq_sec + 0.5 
    605          ELSE                  
     517            ztmp= ztmp / REAL(ifreq_sec, wp) + 0.5 
     518         ELSE                                   ! no time interpolation 
    606519            ! 
    607520            !                  INT( ztmp ) 
     
    616529            !       forcing record :  1     2     3 
    617530            !                             
    618             ztmp= ztmp / ifreq_sec 
    619          ENDIF 
    620          irec = 1 + INT( ztmp ) 
    621  
    622          isecd = NINT(rday) 
    623          ! after record index and second since Jan. 1st 00h of nit000 year 
    624          sdjf%nrec_a(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 
    625          IF( sdjf%cltype == 'monthly' )       &   ! add the number of seconds between 00h Jan 1 and the end of previous month 
    626             sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1 
    627          IF( sdjf%cltype(1:4) == 'week'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous week  
    628             sdjf%nrec_a(2) = sdjf%nrec_a(2) + ( nsec_year - isec_week ) 
    629          IF( sdjf%cltype == 'daily'   )       &   ! add the number of seconds between 00h Jan 1 and the end of previous day 
    630             sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * ( nday_year - 1 ) 
    631  
    632          ! before record index and second since Jan. 1st 00h of nit000 year 
    633          irec = irec - 1.                           ! move back to previous record 
    634          sdjf%nrec_b(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 
    635          IF( sdjf%cltype == 'monthly' )       &   ! add the number of seconds between 00h Jan 1 and the end of previous month 
    636             sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1 
    637          IF( sdjf%cltype(1:4) == 'week'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous week 
    638             sdjf%nrec_b(2) = sdjf%nrec_b(2) + ( nsec_year - isec_week ) 
    639          IF( sdjf%cltype == 'daily'   )       &   ! add the number of seconds between 00h Jan 1 and the end of previous day 
    640             sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * ( nday_year - 1 ) 
    641  
    642          ! swapping time in second since Jan. 1st 00h of nit000 year 
    643          IF( sdjf%ln_tint ) THEN   ;   sdjf%nswap_sec =  sdjf%nrec_a(2)                     ! swap at the middle of the record 
    644          ELSE                      ;   sdjf%nswap_sec =  sdjf%nrec_a(2) + ifreq_sec / 2     ! swap at the end    of the record 
    645          ENDIF        
     531            ztmp= ztmp / REAL(ifreq_sec, wp) 
     532         ENDIF 
     533         sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record nomber to be read 
     534 
     535         iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000       ! end of this record (in second) 
     536         ! add the number of seconds between 00h Jan 1 and the end of previous month/week/day (ok if nmonth=1) 
     537         IF( sdjf%cltype      == 'monthly' )   iendrec = iendrec + NINT(rday) * SUM(nmonth_len(1:nmonth -1)) 
     538         IF( sdjf%cltype(1:4) == 'week'    )   iendrec = iendrec + ( nsec_year - isec_week ) 
     539         IF( sdjf%cltype      == 'daily'   )   iendrec = iendrec + NINT(rday) * ( nday_year - 1 ) 
     540         IF( sdjf%ln_tint ) THEN 
     541             sdjf%nrec_a(2) = iendrec - ifreq_sec / 2        ! swap at the middle of the record 
     542         ELSE 
     543             sdjf%nrec_a(2) = iendrec                        ! swap at the end    of the record 
     544             sdjf%nrec_b(2) = iendrec - ifreq_sec            ! beginning of the record (only for print) 
     545         ENDIF 
    646546         ! 
    647547      ENDIF 
     
    650550 
    651551 
     552   SUBROUTINE fld_get( sdjf ) 
     553      !!--------------------------------------------------------------------- 
     554      !!                    ***  ROUTINE fld_clopn  *** 
     555      !! 
     556      !! ** Purpose :   read the data 
     557      !! 
     558      !! ** Method  :    
     559      !!---------------------------------------------------------------------- 
     560      TYPE(FLD), INTENT(inout)   ::   sdjf   ! input field related variables 
     561      !! 
     562      INTEGER                    ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
     563      INTEGER                    ::   iw     ! index into wgts array 
     564      !!--------------------------------------------------------------------- 
     565             
     566      ipk = SIZE( sdjf%fnow, 3 ) 
     567      IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
     568         CALL wgt_list( sdjf, iw ) 
     569         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
     570         ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) ) 
     571         ENDIF 
     572      ELSE 
     573         SELECT CASE( ipk ) 
     574         CASE(1)    
     575            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 
     576            ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) ) 
     577            ENDIF 
     578         CASE(jpk) 
     579            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
     580            ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) ) 
     581            ENDIF 
     582         END SELECT 
     583      ENDIF 
     584      ! 
     585      sdjf%rotn = .false.   ! vector not yet rotated 
     586 
     587   END SUBROUTINE fld_get 
     588 
     589 
     590   SUBROUTINE fld_rot( kt, sd ) 
     591      !!--------------------------------------------------------------------- 
     592      !!                    ***  ROUTINE fld_clopn  *** 
     593      !! 
     594      !! ** Purpose :   Vector fields may need to be rotated onto the local grid direction 
     595      !! 
     596      !! ** Method  :    
     597      !!---------------------------------------------------------------------- 
     598      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step 
     599      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
     600      !! 
     601      INTEGER                      ::   ju, jv, jk   ! loop indices 
     602      INTEGER                      ::   imf          ! size of the structure sd 
     603      INTEGER                      ::   ill          ! character length 
     604      INTEGER                      ::   iv           ! indice of V component 
     605      REAL(wp), DIMENSION(jpi,jpj) ::   utmp, vtmp   ! temporary arrays for vector rotation 
     606      CHARACTER (LEN=100)          ::   clcomp       ! dummy weight name 
     607      !!--------------------------------------------------------------------- 
     608      !! (sga: following code should be modified so that pairs arent searched for each time 
     609      ! 
     610      imf = SIZE( sd ) 
     611      DO ju = 1, imf 
     612         ill = LEN_TRIM( sd(ju)%vcomp ) 
     613         IF( ill > 0 .AND. .NOT. sd(ju)%rotn ) THEN   ! find vector rotations required              
     614             IF( sd(ju)%vcomp(1:1) == 'U' ) THEN      ! east-west component has symbolic name starting with 'U' 
     615                ! look for the north-south component which has same symbolic name but with 'U' replaced with 'V' 
     616                clcomp = 'V' // sd(ju)%vcomp(2:ill)   ! works even if ill == 1 
     617                iv = -1 
     618                DO jv = 1, imf 
     619                  IF( TRIM(sd(jv)%vcomp) == TRIM(clcomp) )   iv = jv 
     620                END DO 
     621                IF( iv > 0 ) THEN   ! fields ju and iv are two components which need to be rotated together 
     622                   DO jk = 1, SIZE( sd(ju)%fnow, 3 ) 
     623                      IF( sd(ju)%ln_tint )THEN 
     624                         CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->i', utmp(:,:) ) 
     625                         CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->j', vtmp(:,:) ) 
     626                         sd(ju)%fdta(:,:,jk,2) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,2) = vtmp(:,:) 
     627                      ELSE  
     628                         CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->i', utmp(:,:) ) 
     629                         CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->j', vtmp(:,:) ) 
     630                         sd(ju)%fnow(:,:,jk  ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk  ) = vtmp(:,:) 
     631                      ENDIF 
     632                   END DO 
     633                   sd(ju)%rotn = .TRUE.               ! vector was rotated  
     634                   IF( lwp .AND. kt == nit000 )   WRITE(numout,*)   & 
     635                      &   'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid' 
     636                ENDIF 
     637             ENDIF 
     638          ENDIF 
     639       END DO 
     640   END SUBROUTINE fld_rot 
     641 
     642 
    652643   SUBROUTINE fld_clopn( sdjf, kyear, kmonth, kday, ldstop ) 
    653644      !!--------------------------------------------------------------------- 
     
    658649      !! ** Method  :    
    659650      !!---------------------------------------------------------------------- 
    660       TYPE(FLD), INTENT(inout)           ::   sdjf                      ! input field related variables 
    661       INTEGER  , INTENT(in   )           ::   kyear                     ! year value 
    662       INTEGER  , INTENT(in   )           ::   kmonth                    ! month value 
    663       INTEGER  , INTENT(in   )           ::   kday                      ! day value 
    664       LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop                    ! stop if open to read a non-existing file (default = .TRUE.) 
    665       INTEGER                            ::   iyear, imonth, iday       ! firt day of the current week in yyyy mm dd 
    666       REAL(wp)                           ::   zsec, zjul                !temp variable 
     651      TYPE(FLD), INTENT(inout)           ::   sdjf                  ! input field related variables 
     652      INTEGER  , INTENT(in   )           ::   kyear                 ! year value 
     653      INTEGER  , INTENT(in   )           ::   kmonth                ! month value 
     654      INTEGER  , INTENT(in   )           ::   kday                  ! day value 
     655      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop                ! stop if open to read a non-existing file (default = .TRUE.) 
    667656 
    668657      IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open 
     
    670659      sdjf%clname=TRIM(sdjf%clrootname) 
    671660      ! 
    672       IF(  sdjf%cltype(1:4) == 'week' .AND. nn_leapy==0 )CALL ctl_stop( 'fld_clopn: weekly file and nn_leapy=0 are not compatible' ) 
    673       ! 
     661      ! note that sdjf%ln_clim is is only acting on presence of the year in the file 
    674662      IF( .NOT. sdjf%ln_clim ) THEN    
    675          WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year 
    676          IF( sdjf%cltype /= 'yearly'        )   &  
    677             &     WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth   ! add month 
    678          IF( sdjf%cltype == 'daily'  .OR. sdjf%cltype(1:4) == 'week' ) & 
    679             &     WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday     ! add day 
     663                                         WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year 
     664         IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month 
    680665      ELSE 
    681666         ! build the new filename if climatological data 
    682          IF( sdjf%cltype == 'monthly' )   WRITE(sdjf%clname, '(a,"_m" ,i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
     667         IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
    683668      ENDIF 
     669      IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 
     670            &                            WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day 
     671      ! 
    684672      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
    685673      ! 
     
    837825      LOGICAL                                 ::   cyclical 
    838826      INTEGER                                 ::   zwrap         ! temporary integer 
    839       INTEGER                                 ::   overlap        ! temporary integer 
    840827      !!---------------------------------------------------------------------- 
    841828      ! 
     
    940927         ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration.  
    941928         ! a more robust solution will be given in next release 
    942          ipk =  SIZE(sd%fnow,3) 
     929         ipk =  SIZE(sd%fnow, 3) 
    943930         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) ) 
    944931         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col(1,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) ) 
     
    11131100   END SUBROUTINE fld_interp 
    11141101 
     1102 
    11151103   FUNCTION ksec_week( cdday ) 
    11161104      !!--------------------------------------------------------------------- 
     
    11291117      !!---------------------------------------------------------------------- 
    11301118      cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/) 
    1131       DO ijul=1,7 
    1132          IF(  cl_week(ijul)==TRIM(cdday) ) EXIT 
     1119      DO ijul = 1, 7 
     1120         IF( cl_week(ijul) == TRIM(cdday) ) EXIT 
    11331121      ENDDO 
    1134       IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): ',TRIM(cdday) ) 
    1135       ! 
    1136       ishift = ( ijul  ) * 86400 
     1122      IF( ijul .GT. 7 )   CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): '//TRIM(cdday) ) 
     1123      ! 
     1124      ishift = ijul * NINT(rday) 
    11371125      !  
    11381126      ksec_week = nsec_week + ishift 
    1139       ksec_week = MOD( ksec_week , 86400*7 ) 
    1140       if(lwp)write(numout,*)'cbr ijul ksec_week ',ijul,ksec_week 
     1127      ksec_week = MOD( ksec_week, 7*NINT(rday) ) 
    11411128      !  
    11421129   END FUNCTION ksec_week 
    11431130 
     1131 
    11441132END MODULE fldread 
Note: See TracChangeset for help on using the changeset viewer.