source: branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90 @ 3826

Last change on this file since 3826 was 3826, checked in by cbricaud, 9 years ago

suppress stop below to accomodate with AMM12 boundary data forcing files; see ticket 1065

  • Property svn:keywords set to Id
File size: 68.2 KB
Line 
1MODULE fldread
2   !!======================================================================
3   !!                       ***  MODULE  fldread  ***
4   !! Ocean forcing:  read input field for surface boundary condition
5   !!=====================================================================
6   !! History :  2.0  !  06-2006  (S. Masson, G. Madec) Original code
7   !!                 !  05-2008  (S. Alderson) Modified for Interpolation in memory
8   !!                 !                         from input grid to model grid
9   !!----------------------------------------------------------------------
10
11   !!----------------------------------------------------------------------
12   !!   fld_read      : read input fields used for the computation of the
13   !!                   surface boundary condition
14   !!----------------------------------------------------------------------
15   USE oce             ! ocean dynamics and tracers
16   USE dom_oce         ! ocean space and time domain
17   USE phycst          ! ???
18   USE in_out_manager  ! I/O manager
19   USE iom             ! I/O manager library
20   USE geo2ocean       ! for vector rotation on to model grid
21   USE lib_mpp         ! MPP library
22   USE wrk_nemo        ! work arrays
23   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar
24
25   IMPLICIT NONE
26   PRIVATE   
27 
28   PUBLIC   fld_map    ! routine called by tides_init
29
30   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations
31      CHARACTER(len = 256) ::   clname      ! generic name of the NetCDF flux file
32      INTEGER              ::   nfreqh      ! frequency of each flux file
33      CHARACTER(len = 34)  ::   clvar       ! generic name of the variable in the NetCDF flux file
34      LOGICAL              ::   ln_tint     ! time interpolation or not (T/F)
35      LOGICAL              ::   ln_clim     ! climatology or not (T/F)
36      CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly'
37      CHARACTER(len = 34)  ::   wname       ! generic name of a NetCDF weights file to be used, blank if not
38      CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation
39      !                                     ! a string starting with "U" or "V" for each component   
40      !                                     ! chars 2 onwards identify which components go together 
41   END TYPE FLD_N
42
43   TYPE, PUBLIC ::   FLD        !: Input field related variables
44      CHARACTER(len = 256)            ::   clrootname   ! generic name of the NetCDF file
45      CHARACTER(len = 256)            ::   clname       ! current name of the NetCDF file
46      INTEGER                         ::   nfreqh       ! frequency of each flux file
47      CHARACTER(len = 34)             ::   clvar        ! generic name of the variable in the NetCDF flux file
48      LOGICAL                         ::   ln_tint      ! time interpolation or not (T/F)
49      LOGICAL                         ::   ln_clim      ! climatology or not (T/F)
50      CHARACTER(len = 8)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly'
51      INTEGER                         ::   num          ! iom id of the jpfld files to be read
52      INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year)
53      INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year)
54      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow       ! input fields interpolated to now time step
55      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta       ! 2 consecutive record of input fields
56      CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key
57      !                                                 ! into the WGTLIST structure
58      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   END TYPE FLD
61
62   TYPE, PUBLIC ::   MAP_POINTER      !: Array of integer pointers to 1D arrays
63      INTEGER, POINTER   ::  ptr(:)
64   END TYPE MAP_POINTER
65
66!$AGRIF_DO_NOT_TREAT
67
68   !! keep list of all weights variables so they're only read in once
69   !! need to add AGRIF directives not to process this structure
70   !! also need to force wgtname to include AGRIF nest number
71   TYPE         ::   WGT        !: Input weights related variables
72      CHARACTER(len = 256)                    ::   wgtname      ! current name of the NetCDF weight file
73      INTEGER , DIMENSION(2)                  ::   ddims        ! shape of input grid
74      INTEGER , DIMENSION(2)                  ::   botleft      ! top left corner of box in input grid containing
75      !                                                         ! current processor grid
76      INTEGER , DIMENSION(2)                  ::   topright     ! top right corner of box
77      INTEGER                                 ::   jpiwgt       ! width of box on input grid
78      INTEGER                                 ::   jpjwgt       ! height of box on input grid
79      INTEGER                                 ::   numwgt       ! number of weights (4=bilinear, 16=bicubic)
80      INTEGER                                 ::   nestid       ! for agrif, keep track of nest we're in
81      INTEGER                                 ::   overlap      ! =0 when cyclic grid has no overlapping EW columns
82      !                                                         ! =>1 when they have one or more overlapping columns     
83      !                                                         ! =-1 not cyclic
84      LOGICAL                                 ::   cyclic       ! east-west cyclic or not
85      INTEGER,  DIMENSION(:,:,:), POINTER     ::   data_jpi     ! array of source integers
86      INTEGER,  DIMENSION(:,:,:), POINTER     ::   data_jpj     ! array of source integers
87      REAL(wp), DIMENSION(:,:,:), POINTER     ::   data_wgt     ! array of weights on model grid
88      REAL(wp), DIMENSION(:,:,:), POINTER     ::   fly_dta      ! array of values on input grid
89      REAL(wp), DIMENSION(:,:,:), POINTER     ::   col          ! temporary array for reading in columns
90   END TYPE WGT
91
92   INTEGER,     PARAMETER             ::   tot_wgts = 10
93   TYPE( WGT ), DIMENSION(tot_wgts)   ::   ref_wgts     ! array of wgts
94   INTEGER                            ::   nxt_wgt = 1  ! point to next available space in ref_wgts array
95
96!$AGRIF_END_DO_NOT_TREAT
97
98   PUBLIC   fld_read, fld_fill   ! called by sbc... modules
99
100   !!----------------------------------------------------------------------
101   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
102   !! $Id$
103   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
104   !!----------------------------------------------------------------------
105CONTAINS
106
107   SUBROUTINE fld_read( kt, kn_fsbc, sd, map, jit, time_offset )
108      !!---------------------------------------------------------------------
109      !!                    ***  ROUTINE fld_read  ***
110      !!                   
111      !! ** Purpose :   provide at each time step the surface ocean fluxes
112      !!                (momentum, heat, freshwater and runoff)
113      !!
114      !! ** Method  :   READ each input fields in NetCDF files using IOM
115      !!      and intepolate it to the model time-step.
116      !!         Several assumptions are made on the input file:
117      !!      blahblahblah....
118      !!----------------------------------------------------------------------
119      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step
120      INTEGER  , INTENT(in   )               ::   kn_fsbc   ! sbc computation period (in time step)
121      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      !!
129      INTEGER  ::   imf        ! size of the structure sd
130      INTEGER  ::   jf         ! dummy indices
131      INTEGER  ::   ireclast   ! last record to be read in the current year file
132      INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend
133      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
135      LOGICAL  ::   llnxtyr    ! open next year  file?
136      LOGICAL  ::   llnxtmth   ! open next month file?
137      LOGICAL  ::   llstop     ! stop is the file does not exist
138      LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields
139      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation
140      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation
141      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         
153      ! 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
159      ENDIF
160      imf = SIZE( sd )
161      !
162      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
172         IF( lwp ) CALL wgt_print()                ! control print
173         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed
174      ENDIF
175      !                                            ! ====================================== !
176      IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! update field at each kn_fsbc time-step !
177         !                                         ! ====================================== !
178         !
179         DO jf = 1, imf                            ! ---   loop over field   --- !
180           
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)
187               ENDIF
188
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??
196               IF( sd(jf)%ln_tint ) THEN
197                  ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current
198                  ! 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)
199                  ! 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
215                  ! 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
222                        llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file?
223                        llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file?
224
225                        ! if the run finishes at the end of the current year/month/week/day, we will allow next
226                        ! year/month/week/day file to be not present. If the run continue further than the current
227                        ! year/month/week/day, next year/month/week/day file must exist
228                        isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run
229                        llstop = isecend > sd(jf)%nrec_a(2)                                   ! read more than 1 record of next year
230
231                        CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         &
232                           &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         &
233                           &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop )
234
235                        IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist
236                           CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)//     &
237                              &     ' 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
240                        ENDIF
241
242                     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
252
253               ! 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
261         END DO                                    ! --- end loop over field --- !
262
263         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed
264
265         DO jf = 1, imf                            ! ---   loop over field   --- !
266            !
267            IF( sd(jf)%ln_tint ) THEN              ! temporal interpolation
268               IF(lwp .AND. kt - nit000 <= 100 ) THEN
269                  clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
270                     &    "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')"
271                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &           
272                     & 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
274               ENDIF
275               ! temporal interpolation weights
276               ztinta =  REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp )
277               ztintb =  1. - ztinta
278!CDIR COLLAPSE
279               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2)
280            ELSE   ! nothing to do...
281               IF(lwp .AND. kt - nit000 <= 100 ) THEN
282                  clfmt = "('fld_read: var ', a, ' kt = ', i8,' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
283                     &    "', record: ', i4.4, ' (days ', f7.2, ' <-> ', f7.2, ')')"
284                  WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,    &
285                     &                 sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday
286               ENDIF
287            ENDIF
288            !
289            IF( kt == nitend - kn_fsbc + 1 )   CALL iom_close( sd(jf)%num )   ! Close the input files
290
291         END DO                                    ! --- end loop over field --- !
292         !
293         !                                         ! ====================================== !
294      ENDIF                                        ! update field at each kn_fsbc time-step !
295      !                                            ! ====================================== !
296      !
297   END SUBROUTINE fld_read
298
299
300   SUBROUTINE fld_init( kn_fsbc, sdjf, map )
301      !!---------------------------------------------------------------------
302      !!                    ***  ROUTINE fld_init  ***
303      !!
304      !! ** Purpose :  - if time interpolation, read before data
305      !!               - open current year file
306      !!----------------------------------------------------------------------
307      INTEGER  , INTENT(in   ) ::   kn_fsbc   ! sbc computation period (in time step)
308      TYPE(FLD), INTENT(inout) ::   sdjf      ! input field related variables
309      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices
310      !!
311      LOGICAL :: llprevyr              ! are we reading previous year  file?
312      LOGICAL :: llprevmth             ! are we reading previous month file?
313      LOGICAL :: llprevweek            ! are we reading previous week  file?
314      LOGICAL :: llprevday             ! are we reading previous day   file?
315      LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
316      INTEGER :: idvar                 ! variable id
317      INTEGER :: inrec                 ! number of record existing for this variable
318      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd
319      INTEGER :: isec_week             ! number of seconds since start of the weekly file
320      CHARACTER(LEN=1000) ::   clfmt   ! write format
321      !!---------------------------------------------------------------------
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
326      llprevyr   = .FALSE.
327      llprevmth  = .FALSE.
328      llprevweek = .FALSE.
329      llprevday  = .FALSE.
330      isec_week  = 0
331           
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
337      ! define record informations
338      CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later)
339
340      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar
341
342      IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure
343
344         IF( sdjf%nrec_a(1) == 0  ) THEN   ! we redefine record sdjf%nrec_a(1) with the last record of previous year file
345            IF    ( sdjf%nfreqh == -12 ) THEN   ! yearly mean
346               IF( sdjf%cltype == 'yearly' ) THEN             ! yearly file
347                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record
348                  llprevyr  = .NOT. sdjf%ln_clim                                           ! use previous year  file?
349               ELSE
350                  CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clname) )
351               ENDIF
352            ELSEIF( sdjf%nfreqh ==  -1 ) THEN   ! monthly mean
353               IF( sdjf%cltype == 'monthly' ) THEN            ! monthly file
354                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record
355                  llprevmth = .TRUE.                                                       ! use previous month file?
356                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
357               ELSE                                           ! yearly file
358                  sdjf%nrec_a(1) = 12                                                      ! force to read december mean
359                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
360               ENDIF
361            ELSE                                ! higher frequency mean (in hours)
362               IF    ( sdjf%cltype      == 'monthly' ) THEN   ! monthly file
363                  sdjf%nrec_a(1) = 24 * nmonth_len(nmonth-1) / sdjf%nfreqh                 ! last record of previous month
364                  llprevmth = .TRUE.                                                       ! use previous month file?
365                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
366               ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ! weekly file
367                  llprevweek = .TRUE.                                                      ! use previous week  file?
368                  sdjf%nrec_a(1) = 24 * 7 / sdjf%nfreqh                                    ! last record of previous week
369                  isec_week = NINT(rday) * 7                                               ! add a shift toward previous week
370               ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ! daily file
371                  sdjf%nrec_a(1) = 24 / sdjf%nfreqh                                        ! last record of previous day
372                  llprevday = .TRUE.                                                       ! use previous day   file?
373                  llprevmth = llprevday .AND. nday   == 1                                  ! use previous month file?
374                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
375               ELSE                                           ! yearly file
376                  sdjf%nrec_a(1) = 24 * nyear_len(0) / sdjf%nfreqh                         ! last record of previous year
377                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
378               ENDIF
379            ENDIF
380         ENDIF
381         IF ( sdjf%cltype(1:4) == 'week' ) THEN
382            isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week
383            llprevmth = isec_week > nsec_month                      ! longer time since the beginning of the week than the month
384            llprevyr  = llprevmth .AND. nmonth == 1
385         ENDIF
386         llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
387         !
388         iyear  = nyear  - COUNT((/llprevyr /))
389         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
390         iday   = nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
391         !
392         CALL fld_clopn( sdjf, iyear, imonth, iday, .NOT. llprev )
393
394         ! if previous year/month/day file does not exist, we switch to the current year/month/day
395         IF( llprev .AND. sdjf%num <= 0 ) THEN
396            CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clname)//   &
397               &           ' not present -> back to current year/month/week/day' )
398            ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day
399            llprev = .FALSE.
400            sdjf%nrec_a(1) = 1
401            CALL fld_clopn( sdjf, nyear, nmonth, nday )
402         ENDIF
403         
404         IF( llprev ) THEN   ! check if the last record sdjf%nrec_n(1) exists in the file
405            idvar = iom_varid( sdjf%num, sdjf%clvar )                                        ! id of the variable sdjf%clvar
406            IF( idvar <= 0 )   RETURN
407            inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar )   ! size of the last dim of idvar
408            sdjf%nrec_a(1) = MIN( sdjf%nrec_a(1), inrec )   ! make sure we select an existing record
409         ENDIF
410
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
417
418         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')"
419         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday
420
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 
444      !
445   END SUBROUTINE fld_init
446
447
448   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit, time_offset )
449      !!---------------------------------------------------------------------
450      !!                    ***  ROUTINE fld_rec  ***
451      !!
452      !! ** Purpose : Compute
453      !!              if sdjf%ln_tint = .TRUE.
454      !!                  nrec_a: record number and its time (nrec_b is obtained from nrec_a when swapping)
455      !!              if sdjf%ln_tint = .FALSE.
456      !!                  nrec_a(1): record number
457      !!                  nrec_b(2) and nrec_a(2): time of the beginning and end of the record (for print only)
458      !!----------------------------------------------------------------------
459      INTEGER  , INTENT(in   )           ::   kn_fsbc   ! sbc computation period (in time step)
460      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables
461      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.)
462      INTEGER  , INTENT(in   ), OPTIONAL ::   jit       ! index of barotropic subcycle
463                                                        ! 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.
466      !!
467      LOGICAL  ::   llbefore    ! local definition of ldbefore
468      INTEGER  ::   iendrec     ! end of this record (in seconds)
469      INTEGER  ::   imth        ! month number
470      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds)
471      INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file
472      INTEGER  ::   itime_add   ! local time offset variable
473      REAL(wp) ::   ztmp        ! temporary variable
474      !!----------------------------------------------------------------------
475      !
476      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar
477      !
478      IF( PRESENT(ldbefore) ) THEN   ;   llbefore = ldbefore .AND. sdjf%ln_tint   ! needed only if sdjf%ln_tint = .TRUE.
479      ELSE                           ;   llbefore = .FALSE.
480      ENDIF
481      !
482      itime_add = 0
483      IF( PRESENT(time_offset) ) itime_add = time_offset
484      !
485      !                                      ! =========== !
486      IF    ( sdjf%nfreqh == -12 ) THEN      ! yearly mean
487         !                                   ! =========== !
488         !
489         IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record
490            !
491            !                  INT( ztmp )
492            !                     /|\
493            !                    1 |    *----
494            !                    0 |----(             
495            !                      |----+----|--> time
496            !                      0   /|\   1   (nday/nyear_len(1))
497            !                           |   
498            !                           |   
499            !       forcing record :    1
500            !                           
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
507            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
508            ! swap at the middle of the year
509            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0)
510            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1)   
511            ENDIF
512         ELSE                                    ! no time interpolation
513            sdjf%nrec_a(1) = 1
514            sdjf%nrec_a(2) = NINT(rday) * nyear_len(1) + nsec1jan000   ! swap at the end    of the year
515            sdjf%nrec_b(2) = nsec1jan000                               ! beginning of the year (only for print)
516         ENDIF
517         !
518         !                                   ! ============ !
519      ELSEIF( sdjf%nfreqh ==  -1 ) THEN      ! monthly mean !
520         !                                   ! ============ !
521         !
522         IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record
523            !
524            !                  INT( ztmp )
525            !                     /|\
526            !                    1 |    *----
527            !                    0 |----(             
528            !                      |----+----|--> time
529            !                      0   /|\   1   (nday/nmonth_len(nmonth))
530            !                           |   
531            !                           |   
532            !       forcing record :  nmonth
533            !                           
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
540            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/))
541            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
542            ELSE                                  ;   sdjf%nrec_a(1) = imth
543            ENDIF
544            sdjf%nrec_a(2) = nmonth_half(   imth ) + nsec1jan000   ! swap at the middle of the month
545         ELSE                                    ! no time interpolation
546            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1
547            ELSE                                  ;   sdjf%nrec_a(1) = nmonth
548            ENDIF
549            sdjf%nrec_a(2) =  nmonth_end(nmonth  ) + nsec1jan000   ! swap at the end    of the month
550            sdjf%nrec_b(2) =  nmonth_end(nmonth-1) + nsec1jan000   ! beginning of the month (only for print)
551         ENDIF
552         !
553         !                                   ! ================================ !
554      ELSE                                   ! higher frequency mean (in hours)
555         !                                   ! ================================ !
556         !
557         ifreq_sec = sdjf%nfreqh * 3600                                                 ! frequency mean (in seconds)
558         IF( sdjf%cltype(1:4) == 'week' )   isec_week = ksec_week( sdjf%cltype(6:8) )   ! since the first day of the current week
559         ! number of second since the beginning of the file
560         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)  ! since the first day of the current month
561         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week ,wp)  ! since the first day of the current week
562         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)  ! since 00h of the current day
563         ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year
564         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
572         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record
573            !
574            !                  INT( ztmp )
575            !                     /|\
576            !                    2 |        *-----(
577            !                    1 |  *-----(
578            !                    0 |--(             
579            !                      |--+--|--+--|--+--|--> time
580            !                      0 /|\ 1 /|\ 2 /|\ 3 (nsec_year/ifreq_sec) or (nsec_month/ifreq_sec)
581            !                         |     |     |
582            !                         |     |     |
583            !       forcing record :  1     2     3
584            !                   
585            ztmp= ztmp / REAL(ifreq_sec, wp) + 0.5
586         ELSE                                   ! no time interpolation
587            !
588            !                  INT( ztmp )
589            !                     /|\
590            !                    2 |           *-----(
591            !                    1 |     *-----(
592            !                    0 |-----(             
593            !                      |--+--|--+--|--+--|--> time
594            !                      0 /|\ 1 /|\ 2 /|\ 3 (nsec_year/ifreq_sec) or (nsec_month/ifreq_sec)
595            !                         |     |     |
596            !                         |     |     |
597            !       forcing record :  1     2     3
598            !                           
599            ztmp= ztmp / REAL(ifreq_sec, wp)
600         ENDIF
601         sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record nomber to be read
602
603         iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000       ! end of this record (in second)
604         ! add the number of seconds between 00h Jan 1 and the end of previous month/week/day (ok if nmonth=1)
605         IF( sdjf%cltype      == 'monthly' )   iendrec = iendrec + NINT(rday) * SUM(nmonth_len(1:nmonth -1))
606         IF( sdjf%cltype(1:4) == 'week'    )   iendrec = iendrec + ( nsec_year - isec_week )
607         IF( sdjf%cltype      == 'daily'   )   iendrec = iendrec + NINT(rday) * ( nday_year - 1 )
608         IF( sdjf%ln_tint ) THEN
609             sdjf%nrec_a(2) = iendrec - ifreq_sec / 2        ! swap at the middle of the record
610         ELSE
611             sdjf%nrec_a(2) = iendrec                        ! swap at the end    of the record
612             sdjf%nrec_b(2) = iendrec - ifreq_sec            ! beginning of the record (only for print)
613         ENDIF
614         !
615      ENDIF
616      !
617   END SUBROUTINE fld_rec
618
619
620   SUBROUTINE fld_get( sdjf, map )
621      !!---------------------------------------------------------------------
622      !!                    ***  ROUTINE fld_get  ***
623      !!
624      !! ** Purpose :   read the data
625      !!----------------------------------------------------------------------
626      TYPE(FLD), INTENT(inout) ::   sdjf   ! input field related variables
627      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices
628      !!
629      INTEGER                  ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
630      INTEGER                  ::   iw     ! index into wgts array
631      INTEGER                  ::   ipdom  ! index of the domain
632      !!---------------------------------------------------------------------
633      !     
634      ipk = SIZE( sdjf%fnow, 3 )
635      !
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 )
639         ENDIF
640      ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
641         CALL wgt_list( sdjf, iw )
642         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
643         ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) )
644         ENDIF
645      ELSE
646         IF( SIZE(sdjf%fnow, 1) == jpi ) THEN  ;  ipdom = jpdom_data
647         ELSE                                  ;  ipdom = jpdom_unknown
648         ENDIF
649         SELECT CASE( ipk )
650         CASE(1)
651            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) )
652            ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) )
653            ENDIF
654         CASE DEFAULT
655            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
656            ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) )
657            ENDIF
658         END SELECT
659      ENDIF
660      !
661      sdjf%rotn = .false.   ! vector not yet rotated
662
663   END SUBROUTINE fld_get
664
665   SUBROUTINE fld_map( num, clvar, dta, nrec, map )
666      !!---------------------------------------------------------------------
667      !!                    ***  ROUTINE fld_get  ***
668      !!
669      !! ** Purpose :   read global data from file and map onto local data
670      !!                using a general mapping (for open boundaries)
671      !!----------------------------------------------------------------------
672#if defined key_bdy
673      USE bdy_oce, ONLY:  dta_global, dta_global2         ! workspace to read in global data arrays
674#endif
675
676      INTEGER                   , INTENT(in ) ::   num     ! stream number
677      CHARACTER(LEN=*)          , INTENT(in ) ::   clvar   ! variable name
678      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta   ! output field on model grid (2 dimensional)
679      INTEGER                   , INTENT(in ) ::   nrec    ! record number to read (ie time slice)
680      INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map     ! global-to-local mapping indices
681      !!
682      INTEGER                                 ::   ipi      ! length of boundary data on local process
683      INTEGER                                 ::   ipj      ! length of dummy dimension ( = 1 )
684      INTEGER                                 ::   ipk      ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk )
685      INTEGER                                 ::   ilendta  ! length of data in file
686      INTEGER                                 ::   idvar    ! variable ID
687      INTEGER                                 ::   ib, ik, ji, jj   ! loop counters
688      INTEGER                                 ::   ierr
689      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read  ! work space for global data
690      !!---------------------------------------------------------------------
691           
692      ipi = SIZE( dta, 1 )
693      ipj = 1
694      ipk = SIZE( dta, 3 )
695
696      idvar   = iom_varid( num, clvar )
697      ilendta = iom_file(num)%dimsz(1,idvar)
698
699#if defined key_bdy
700      ipj = iom_file(num)%dimsz(2,idvar)
701      IF (ipj == 1) THEN ! we assume that this is a structured open boundary file
702         dta_read => dta_global
703      ELSE
704         dta_read => dta_global2
705      ENDIF
706#endif
707
708
709      IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta
710      IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk
711
712
713      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 )
718      END SELECT
719      !
720      IF (ipj==1) THEN
721         DO ib = 1, ipi
722            DO ik = 1, ipk
723               dta(ib,1,ik) =  dta_read(map(ib),1,ik)
724            END DO
725         END DO
726      ELSE ! we assume that this is a structured open boundary file
727         DO ib = 1, ipi
728            jj=1+floor(REAL(map(ib)-1)/REAL(ilendta))
729            ji=map(ib)-(jj-1)*ilendta
730            DO ik = 1, ipk
731               dta(ib,1,ik) =  dta_read(ji,jj,ik)
732            END DO
733         END DO
734      ENDIF
735
736   END SUBROUTINE fld_map
737
738
739   SUBROUTINE fld_rot( kt, sd )
740      !!---------------------------------------------------------------------
741      !!                    ***  ROUTINE fld_rot  ***
742      !!
743      !! ** Purpose :   Vector fields may need to be rotated onto the local grid direction
744      !!----------------------------------------------------------------------
745      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step
746      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
747      !!
748      INTEGER                           ::   ju, jv, jk   ! loop indices
749      INTEGER                           ::   imf          ! size of the structure sd
750      INTEGER                           ::   ill          ! character length
751      INTEGER                           ::   iv           ! indice of V component
752      REAL(wp), POINTER, DIMENSION(:,:) ::   utmp, vtmp   ! temporary arrays for vector rotation
753      CHARACTER (LEN=100)               ::   clcomp       ! dummy weight name
754      !!---------------------------------------------------------------------
755
756      CALL wrk_alloc( jpi,jpj, utmp, vtmp )
757
758      !! (sga: following code should be modified so that pairs arent searched for each time
759      !
760      imf = SIZE( sd )
761      DO ju = 1, imf
762         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
789       END DO
790      !
791      CALL wrk_dealloc( jpi,jpj, utmp, vtmp )
792      !
793   END SUBROUTINE fld_rot
794
795
796   SUBROUTINE fld_clopn( sdjf, kyear, kmonth, kday, ldstop )
797      !!---------------------------------------------------------------------
798      !!                    ***  ROUTINE fld_clopn  ***
799      !!
800      !! ** Purpose :   update the file name and open the file
801      !!----------------------------------------------------------------------
802      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
806      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
810      ! 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
814      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
817      ELSE
818         ! 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
820      ENDIF
821      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     !
826   END SUBROUTINE fld_clopn
827
828
829   SUBROUTINE fld_fill( sdf, sdf_n, cdir, cdcaller, cdtitle, cdnam )
830      !!---------------------------------------------------------------------
831      !!                    ***  ROUTINE fld_fill  ***
832      !!
833      !! ** Purpose :   fill sdf with sdf_n and control print
834      !!----------------------------------------------------------------------
835      TYPE(FLD)  , DIMENSION(:), INTENT(inout) ::   sdf        ! structure of input fields (file informations, fields read)
836      TYPE(FLD_N), DIMENSION(:), INTENT(in   ) ::   sdf_n      ! array of namelist information structures
837      CHARACTER(len=*)         , INTENT(in   ) ::   cdir       ! Root directory for location of flx files
838      CHARACTER(len=*)         , INTENT(in   ) ::   cdcaller   !
839      CHARACTER(len=*)         , INTENT(in   ) ::   cdtitle    !
840      CHARACTER(len=*)         , INTENT(in   ) ::   cdnam      !
841      !
842      INTEGER  ::   jf       ! dummy indices
843      !!---------------------------------------------------------------------
844
845      DO jf = 1, SIZE(sdf)
846         sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname )
847         sdf(jf)%nfreqh     = sdf_n(jf)%nfreqh
848         sdf(jf)%clvar      = sdf_n(jf)%clvar
849         sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint
850         sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim
851         sdf(jf)%cltype     = sdf_n(jf)%cltype
852         sdf(jf)%wgtname = " "
853         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.
856      END DO
857
858      IF(lwp) THEN      ! control print
859         WRITE(numout,*)
860         WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle )
861         WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /)
862         WRITE(numout,*) '          '//TRIM( cdnam )//' Namelist'
863         WRITE(numout,*) '          list of files and frequency (>0: in hours ; <0 in months)'
864         DO jf = 1, SIZE(sdf)
865            WRITE(numout,*) '               root filename: '  , TRIM( sdf(jf)%clrootname ),   &
866               &                          ' variable name: '  , TRIM( sdf(jf)%clvar      )
867            WRITE(numout,*) '               frequency: '      ,       sdf(jf)%nfreqh      ,   &
868               &                          ' time interp: '    ,       sdf(jf)%ln_tint     ,   &
869               &                          ' climatology: '    ,       sdf(jf)%ln_clim     ,   &
870               &                          ' weights    : '    , TRIM( sdf(jf)%wgtname    ),   &
871               &                          ' pairing    : '    , TRIM( sdf(jf)%vcomp      ),   &
872               &                          ' data type: '      ,       sdf(jf)%cltype
873            call flush(numout)
874         END DO
875      ENDIF
876     
877   END SUBROUTINE fld_fill
878
879
880   SUBROUTINE wgt_list( sd, kwgt )
881      !!---------------------------------------------------------------------
882      !!                    ***  ROUTINE wgt_list  ***
883      !!
884      !! ** Purpose :   search array of WGTs and find a weights file
885      !!                entry, or return a new one adding it to the end
886      !!                if it is a new entry, the weights data is read in and
887      !!                restructured (fld_weight)
888      !!----------------------------------------------------------------------
889      TYPE( FLD ), INTENT(in   ) ::   sd        ! field with name of weights file
890      INTEGER    , INTENT(inout) ::   kwgt      ! index of weights
891      !!
892      INTEGER ::   kw, nestid   ! local integer
893      LOGICAL ::   found        ! local logical
894      !!----------------------------------------------------------------------
895      !
896      !! search down linked list
897      !! weights filename is either present or we hit the end of the list
898      found = .FALSE.
899
900      !! because agrif nest part of filenames are now added in iom_open
901      !! to distinguish between weights files on the different grids, need to track
902      !! nest number explicitly
903      nestid = 0
904#if defined key_agrif
905      nestid = Agrif_Fixed()
906#endif
907      DO kw = 1, nxt_wgt-1
908         IF( TRIM(ref_wgts(kw)%wgtname) == TRIM(sd%wgtname) .AND. &
909             ref_wgts(kw)%nestid == nestid) THEN
910            kwgt = kw
911            found = .TRUE.
912            EXIT
913         ENDIF
914      END DO
915      IF( .NOT.found ) THEN
916         kwgt = nxt_wgt
917         CALL fld_weight( sd )
918      ENDIF
919      !
920   END SUBROUTINE wgt_list
921
922
923   SUBROUTINE wgt_print( )
924      !!---------------------------------------------------------------------
925      !!                    ***  ROUTINE wgt_print  ***
926      !!
927      !! ** Purpose :   print the list of known weights
928      !!----------------------------------------------------------------------
929      INTEGER ::   kw   !
930      !!----------------------------------------------------------------------
931      !
932      DO kw = 1, nxt_wgt-1
933         WRITE(numout,*) 'weight file:  ',TRIM(ref_wgts(kw)%wgtname)
934         WRITE(numout,*) '      ddims:  ',ref_wgts(kw)%ddims(1),ref_wgts(kw)%ddims(2)
935         WRITE(numout,*) '     numwgt:  ',ref_wgts(kw)%numwgt
936         WRITE(numout,*) '     jpiwgt:  ',ref_wgts(kw)%jpiwgt
937         WRITE(numout,*) '     jpjwgt:  ',ref_wgts(kw)%jpjwgt
938         WRITE(numout,*) '    botleft:  ',ref_wgts(kw)%botleft
939         WRITE(numout,*) '   topright:  ',ref_wgts(kw)%topright
940         IF( ref_wgts(kw)%cyclic ) THEN
941            WRITE(numout,*) '       cyclical'
942            IF( ref_wgts(kw)%overlap > 0 ) WRITE(numout,*) '              with overlap of ', ref_wgts(kw)%overlap
943         ELSE
944            WRITE(numout,*) '       not cyclical'
945         ENDIF
946         IF( ASSOCIATED(ref_wgts(kw)%data_wgt) )  WRITE(numout,*) '       allocated'
947      END DO
948      !
949   END SUBROUTINE wgt_print
950
951
952   SUBROUTINE fld_weight( sd )
953      !!---------------------------------------------------------------------
954      !!                    ***  ROUTINE fld_weight  ***
955      !!
956      !! ** Purpose :   create a new WGT structure and fill in data from 
957      !!                file, restructuring as required
958      !!----------------------------------------------------------------------
959      TYPE( FLD ), INTENT(in) ::   sd   ! field with name of weights file
960      !!
961      INTEGER                           ::   jn            ! dummy loop indices
962      INTEGER                           ::   inum          ! temporary logical unit
963      INTEGER                           ::   id            ! temporary variable id
964      INTEGER                           ::   ipk           ! temporary vertical dimension
965      CHARACTER (len=5)                 ::   aname
966      INTEGER , DIMENSION(3)            ::   ddims
967      INTEGER , POINTER, DIMENSION(:,:) ::   data_src
968      REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp
969      LOGICAL                           ::   cyclical
970      INTEGER                           ::   zwrap      ! local integer
971      !!----------------------------------------------------------------------
972      !
973      CALL wrk_alloc( jpi,jpj, data_src )   ! integer
974      CALL wrk_alloc( jpi,jpj, data_tmp )
975      !
976      IF( nxt_wgt > tot_wgts ) THEN
977        CALL ctl_stop("fld_weight: weights array size exceeded, increase tot_wgts")
978      ENDIF
979      !
980      !! new weights file entry, add in extra information
981      !! a weights file represents a 2D grid of a certain shape, so we assume that the current
982      !! input data file is representative of all other files to be opened and processed with the
983      !! current weights file
984
985      !! open input data file (non-model grid)
986      CALL iom_open( sd%clname, inum, ldiof =  LEN(TRIM(sd%wgtname)) > 0 )
987
988      !! get dimensions
989      id = iom_varid( inum, sd%clvar, ddims )
990
991      !! close it
992      CALL iom_close( inum )
993
994      !! now open the weights file
995
996      CALL iom_open ( sd%wgtname, inum )   ! interpolation weights
997      IF ( inum > 0 ) THEN
998
999         !! determine whether we have an east-west cyclic grid
1000         !! from global attribute called "ew_wrap" in the weights file
1001         !! note that if not found, iom_getatt returns -999 and cyclic with no overlap is assumed
1002         !! since this is the most common forcing configuration
1003
1004         CALL iom_getatt(inum, 'ew_wrap', zwrap)
1005         IF( zwrap >= 0 ) THEN
1006            cyclical = .TRUE.
1007         ELSE IF( zwrap == -999 ) THEN
1008            cyclical = .TRUE.
1009            zwrap = 0
1010         ELSE
1011            cyclical = .FALSE.
1012         ENDIF
1013
1014         ref_wgts(nxt_wgt)%ddims(1) = ddims(1)
1015         ref_wgts(nxt_wgt)%ddims(2) = ddims(2)
1016         ref_wgts(nxt_wgt)%wgtname = sd%wgtname
1017         ref_wgts(nxt_wgt)%overlap = zwrap
1018         ref_wgts(nxt_wgt)%cyclic = cyclical
1019         ref_wgts(nxt_wgt)%nestid = 0
1020#if defined key_agrif
1021         ref_wgts(nxt_wgt)%nestid = Agrif_Fixed()
1022#endif
1023         !! weights file is stored as a set of weights (wgt01->wgt04 or wgt01->wgt16)
1024         !! for each weight wgtNN there is an integer array srcNN which gives the point in
1025         !! the input data grid which is to be multiplied by the weight
1026         !! they are both arrays on the model grid so the result of the multiplication is
1027         !! added into an output array on the model grid as a running sum
1028
1029         !! two possible cases: bilinear (4 weights) or bicubic (16 weights)
1030         id = iom_varid(inum, 'src05', ldstop=.FALSE.)
1031         IF( id <= 0) THEN
1032            ref_wgts(nxt_wgt)%numwgt = 4
1033         ELSE
1034            ref_wgts(nxt_wgt)%numwgt = 16
1035         ENDIF
1036
1037         ALLOCATE( ref_wgts(nxt_wgt)%data_jpi(jpi,jpj,4) )
1038         ALLOCATE( ref_wgts(nxt_wgt)%data_jpj(jpi,jpj,4) )
1039         ALLOCATE( ref_wgts(nxt_wgt)%data_wgt(jpi,jpj,ref_wgts(nxt_wgt)%numwgt) )
1040
1041         DO jn = 1,4
1042            aname = ' '
1043            WRITE(aname,'(a3,i2.2)') 'src',jn
1044            data_tmp(:,:) = 0
1045            CALL iom_get ( inum, jpdom_data, aname, data_tmp(:,:) )
1046            data_src(:,:) = INT(data_tmp(:,:))
1047            ref_wgts(nxt_wgt)%data_jpj(:,:,jn) = 1 + (data_src(:,:)-1) / ref_wgts(nxt_wgt)%ddims(1)
1048            ref_wgts(nxt_wgt)%data_jpi(:,:,jn) = data_src(:,:) - ref_wgts(nxt_wgt)%ddims(1)*(ref_wgts(nxt_wgt)%data_jpj(:,:,jn)-1)
1049         END DO
1050
1051         DO jn = 1, ref_wgts(nxt_wgt)%numwgt
1052            aname = ' '
1053            WRITE(aname,'(a3,i2.2)') 'wgt',jn
1054            ref_wgts(nxt_wgt)%data_wgt(:,:,jn) = 0.0
1055            CALL iom_get ( inum, jpdom_data, aname, ref_wgts(nxt_wgt)%data_wgt(:,:,jn) )
1056         END DO
1057         CALL iom_close (inum)
1058 
1059         ! find min and max indices in grid
1060         ref_wgts(nxt_wgt)%botleft(1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:))
1061         ref_wgts(nxt_wgt)%botleft(2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:))
1062         ref_wgts(nxt_wgt)%topright(1) = MAXVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:))
1063         ref_wgts(nxt_wgt)%topright(2) = MAXVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:))
1064
1065         ! and therefore dimensions of the input box
1066         ref_wgts(nxt_wgt)%jpiwgt = ref_wgts(nxt_wgt)%topright(1) - ref_wgts(nxt_wgt)%botleft(1) + 1
1067         ref_wgts(nxt_wgt)%jpjwgt = ref_wgts(nxt_wgt)%topright(2) - ref_wgts(nxt_wgt)%botleft(2) + 1
1068
1069         ! shift indexing of source grid
1070         ref_wgts(nxt_wgt)%data_jpi(:,:,:) = ref_wgts(nxt_wgt)%data_jpi(:,:,:) - ref_wgts(nxt_wgt)%botleft(1) + 1
1071         ref_wgts(nxt_wgt)%data_jpj(:,:,:) = ref_wgts(nxt_wgt)%data_jpj(:,:,:) - ref_wgts(nxt_wgt)%botleft(2) + 1
1072
1073         ! create input grid, give it a halo to allow gradient calculations
1074         ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration.
1075         ! a more robust solution will be given in next release
1076         ipk =  SIZE(sd%fnow, 3)
1077         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) )
1078         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col(1,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) )
1079
1080         nxt_wgt = nxt_wgt + 1
1081
1082      ELSE
1083         CALL ctl_stop( '    fld_weight : unable to read the file ' )
1084      ENDIF
1085
1086      CALL wrk_dealloc( jpi,jpj, data_src )   ! integer
1087      CALL wrk_dealloc( jpi,jpj, data_tmp )
1088      !
1089   END SUBROUTINE fld_weight
1090
1091
1092   SUBROUTINE fld_interp( num, clvar, kw, kk, dta, nrec )
1093      !!---------------------------------------------------------------------
1094      !!                    ***  ROUTINE fld_interp  ***
1095      !!
1096      !! ** Purpose :   apply weights to input gridded data to create data
1097      !!                on model grid
1098      !!----------------------------------------------------------------------
1099      INTEGER                   , INTENT(in   ) ::   num     ! stream number
1100      CHARACTER(LEN=*)          , INTENT(in   ) ::   clvar   ! variable name
1101      INTEGER                   , INTENT(in   ) ::   kw      ! weights number
1102      INTEGER                   , INTENT(in   ) ::   kk      ! vertical dimension of kk
1103      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   dta     ! output field on model grid
1104      INTEGER                   , INTENT(in   ) ::   nrec    ! record number to read (ie time slice)
1105      !!
1106      INTEGER, DIMENSION(3) ::   rec1,recn   ! temporary arrays for start and length
1107      INTEGER ::  jk, jn, jm           ! loop counters
1108      INTEGER ::  ni, nj               ! lengths
1109      INTEGER ::  jpimin,jpiwid        ! temporary indices
1110      INTEGER ::  jpjmin,jpjwid        ! temporary indices
1111      INTEGER ::  jpi1,jpi2,jpj1,jpj2  ! temporary indices
1112      !!----------------------------------------------------------------------
1113      !
1114      !! for weighted interpolation we have weights at four corners of a box surrounding
1115      !! a model grid point, each weight is multiplied by a grid value (bilinear case)
1116      !! or by a grid value and gradients at the corner point (bicubic case)
1117      !! so we need to have a 4 by 4 subgrid surrounding each model point to cover both cases
1118
1119      !! sub grid from non-model input grid which encloses all grid points in this nemo process
1120      jpimin = ref_wgts(kw)%botleft(1)
1121      jpjmin = ref_wgts(kw)%botleft(2)
1122      jpiwid = ref_wgts(kw)%jpiwgt
1123      jpjwid = ref_wgts(kw)%jpjwgt
1124
1125      !! when reading in, expand this sub-grid by one halo point all the way round for calculating gradients
1126      rec1(1) = MAX( jpimin-1, 1 )
1127      rec1(2) = MAX( jpjmin-1, 1 )
1128      rec1(3) = 1
1129      recn(1) = MIN( jpiwid+2, ref_wgts(kw)%ddims(1)-rec1(1)+1 )
1130      recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 )
1131      recn(3) = kk
1132
1133      !! where we need to put it in the non-nemo grid fly_dta
1134      !! note that jpi1 and jpj1 only differ from 1 when jpimin and jpjmin are 1
1135      !! (ie at the extreme west or south of the whole input grid) and similarly for jpi2 and jpj2
1136      jpi1 = 2 + rec1(1) - jpimin
1137      jpj1 = 2 + rec1(2) - jpjmin
1138      jpi2 = jpi1 + recn(1) - 1
1139      jpj2 = jpj1 + recn(2) - 1
1140
1141      ref_wgts(kw)%fly_dta(:,:,:) = 0.0
1142      SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) )
1143      CASE(1)
1144           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn)
1145      CASE DEFAULT
1146           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn)
1147      END SELECT 
1148
1149      !! first four weights common to both bilinear and bicubic
1150      !! data_jpi, data_jpj have already been shifted to (1,1) corresponding to botleft
1151      !! note that we have to offset by 1 into fly_dta array because of halo
1152      dta(:,:,:) = 0.0
1153      DO jk = 1,4
1154        DO jn = 1, jpj
1155          DO jm = 1,jpi
1156            ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
1157            nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
1158            dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,:)
1159          END DO
1160        END DO
1161      END DO
1162
1163      IF (ref_wgts(kw)%numwgt .EQ. 16) THEN
1164
1165        !! fix up halo points that we couldnt read from file
1166        IF( jpi1 == 2 ) THEN
1167           ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:)
1168        ENDIF
1169        IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN
1170           ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:)
1171        ENDIF
1172        IF( jpj1 == 2 ) THEN
1173           ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:)
1174        ENDIF
1175        IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN
1176           ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:)
1177        ENDIF
1178
1179        !! if data grid is cyclic we can do better on east-west edges
1180        !! but have to allow for whether first and last columns are coincident
1181        IF( ref_wgts(kw)%cyclic ) THEN
1182           rec1(2) = MAX( jpjmin-1, 1 )
1183           recn(1) = 1
1184           recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 )
1185           jpj1 = 2 + rec1(2) - jpjmin
1186           jpj2 = jpj1 + recn(2) - 1
1187           IF( jpi1 == 2 ) THEN
1188              rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap
1189              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
1190              CASE(1)
1191                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
1192              CASE DEFAULT
1193                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
1194              END SELECT     
1195              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
1196           ENDIF
1197           IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN
1198              rec1(1) = 1 + ref_wgts(kw)%overlap
1199              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
1200              CASE(1)
1201                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
1202              CASE DEFAULT
1203                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
1204              END SELECT
1205              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
1206           ENDIF
1207        ENDIF
1208
1209        ! gradient in the i direction
1210        DO jk = 1,4
1211          DO jn = 1, jpj
1212            DO jm = 1,jpi
1213              ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
1214              nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
1215              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         &
1216                               (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:))
1217            END DO
1218          END DO
1219        END DO
1220
1221        ! gradient in the j direction
1222        DO jk = 1,4
1223          DO jn = 1, jpj
1224            DO jm = 1,jpi
1225              ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
1226              nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
1227              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         &
1228                               (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:))
1229            END DO
1230          END DO
1231        END DO
1232
1233         ! gradient in the ij direction
1234         DO jk = 1,4
1235            DO jn = 1, jpj
1236               DO jm = 1,jpi
1237                  ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
1238                  nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
1239                  dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( &
1240                               (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni  ,nj+2,:)) -   &
1241                               (ref_wgts(kw)%fly_dta(ni+2,nj  ,:) - ref_wgts(kw)%fly_dta(ni  ,nj  ,:)))
1242               END DO
1243            END DO
1244         END DO
1245         !
1246      END IF
1247      !
1248   END SUBROUTINE fld_interp
1249
1250
1251   FUNCTION ksec_week( cdday )
1252      !!---------------------------------------------------------------------
1253      !!                    ***  FUNCTION kshift_week ***
1254      !!
1255      !! ** Purpose : 
1256      !!---------------------------------------------------------------------
1257      CHARACTER(len=*), INTENT(in)   ::   cdday   !3 first letters of the first day of the weekly file
1258      !!
1259      INTEGER                        ::   ksec_week  ! output variable
1260      INTEGER                        ::   ijul       !temp variable
1261      INTEGER                        ::   ishift     !temp variable
1262      CHARACTER(len=3),DIMENSION(7)  ::   cl_week 
1263      !!----------------------------------------------------------------------
1264      cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/)
1265      DO ijul = 1, 7
1266         IF( cl_week(ijul) == TRIM(cdday) ) EXIT
1267      END DO
1268      IF( ijul .GT. 7 )   CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): '//TRIM(cdday) )
1269      !
1270      ishift = ijul * NINT(rday)
1271      !
1272      ksec_week = nsec_week + ishift
1273      ksec_week = MOD( ksec_week, 7*NINT(rday) )
1274      !
1275   END FUNCTION ksec_week
1276
1277   !!======================================================================
1278END MODULE fldread
Note: See TracBrowser for help on using the repository browser.