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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
bdydta.F90 in branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

source: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90 @ 4694

Last change on this file since 4694 was 4694, checked in by jamesharle, 10 years ago

Update of fldread to handle depth information in BDY files and addition of an interpolation routine. Updated BDY code to handle T/S BDY interpolation on the fly. Conservative remapping of U/V still to be coded. Not compiled or test yet.

  • Property svn:keywords set to Id
File size: 39.9 KB
RevLine 
[911]1MODULE bdydta
[1125]2   !!======================================================================
3   !!                       ***  MODULE bdydta  ***
[911]4   !! Open boundary data : read the data for the unstructured open boundaries.
[1125]5   !!======================================================================
6   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
7   !!             -   !  2007-01  (D. Storkey) Update to use IOM module
[2528]8   !!             -   !  2007-07  (D. Storkey) add bdy_dta_fla
[1125]9   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
[2528]10   !!            3.3  !  2010-09  (E.O'Dea) modifications for Shelf configurations
11   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
[3294]12   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
[4292]13   !!            3.6  !  2012-01  (C. Rousset) add ice boundary conditions for lim3
[1125]14   !!----------------------------------------------------------------------
15#if defined key_bdy
16   !!----------------------------------------------------------------------
[3294]17   !!   'key_bdy'                     Open Boundary Conditions
[1125]18   !!----------------------------------------------------------------------
[3294]19   !!    bdy_dta        : read external data along open boundaries from file
20   !!    bdy_dta_init   : initialise arrays etc for reading of external data
[1125]21   !!----------------------------------------------------------------------
[3294]22   USE timing          ! Timing
[911]23   USE oce             ! ocean dynamics and tracers
24   USE dom_oce         ! ocean space and time domain
25   USE phycst          ! physical constants
[3294]26   USE bdy_oce         ! ocean open boundary conditions 
[911]27   USE bdytides        ! tidal forcing at boundaries
[3294]28   USE fldread         ! read input fields
29   USE iom             ! IOM library
[911]30   USE in_out_manager  ! I/O logical units
[4292]31   USE dynspg_oce, ONLY: lk_dynspg_ts ! Split-explicit free surface flag
[2528]32#if defined key_lim2
33   USE ice_2
[4292]34#elif defined key_lim3
35   USE par_ice
36   USE ice
37   USE limcat_1D          ! redistribute ice input into categories
[2528]38#endif
[3651]39   USE sbcapr
[911]40
41   IMPLICIT NONE
42   PRIVATE
43
[3294]44   PUBLIC   bdy_dta          ! routine called by step.F90 and dynspg_ts.F90
45   PUBLIC   bdy_dta_init     ! routine called by nemogcm.F90
[911]46
[3294]47   INTEGER, ALLOCATABLE, DIMENSION(:)   ::   nb_bdy_fld        ! Number of fields to update for each boundary set.
48   INTEGER                              ::   nb_bdy_fld_sum    ! Total number of fields to update for all boundary sets.
[911]49
[3294]50   LOGICAL,           DIMENSION(jp_bdy) ::   ln_full_vel_array ! =T => full velocities in 3D boundary conditions
51                                                               ! =F => baroclinic velocities in 3D boundary conditions
[4354]52!$AGRIF_DO_NOT_TREAT
[3294]53   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET ::   bf        ! structure of input fields (file informations, fields read)
[4354]54!$AGRIF_END_DO_NOT_TREAT
[3294]55   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap
[911]56
[4292]57#if defined key_lim3
58   LOGICAL :: ll_bdylim3                  ! determine whether ice input is lim2 (F) or lim3 (T) type
59   INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure
60#endif
61
[3294]62#  include "domzgr_substitute.h90"
[1125]63   !!----------------------------------------------------------------------
[2528]64   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1146]65   !! $Id$
[2528]66   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1125]67   !!----------------------------------------------------------------------
[911]68CONTAINS
69
[3294]70      SUBROUTINE bdy_dta( kt, jit, time_offset )
[1125]71      !!----------------------------------------------------------------------
[3294]72      !!                   ***  SUBROUTINE bdy_dta  ***
[911]73      !!                   
[3294]74      !! ** Purpose :   Update external data for open boundary conditions
[911]75      !!
[3294]76      !! ** Method  :   Use fldread.F90
77      !!               
[1125]78      !!----------------------------------------------------------------------
[911]79      !!
[3294]80      INTEGER, INTENT( in )           ::   kt    ! ocean time-step index
81      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option)
82      INTEGER, INTENT( in ), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit
83                                                        ! is present then units = subcycle timesteps.
84                                                        ! time_offset = 0 => get data at "now" time level
85                                                        ! time_offset = -1 => get data at "before" time level
86                                                        ! time_offset = +1 => get data at "after" time level
87                                                        ! etc.
88      !!
[4292]89      INTEGER     ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl  ! local indices
[3294]90      INTEGER,          DIMENSION(jpbgrd) ::   ilen1 
91      INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts
[4292]92      TYPE(OBC_DATA), POINTER             ::   dta              ! short cut
[3294]93      !!
[911]94      !!---------------------------------------------------------------------------
[3294]95      !!
96      IF( nn_timing == 1 ) CALL timing_start('bdy_dta')
[911]97
[3294]98      ! Initialise data arrays once for all from initial conditions where required
99      !---------------------------------------------------------------------------
100      IF( kt .eq. nit000 .and. .not. PRESENT(jit) ) THEN
[1125]101
[3294]102         ! Calculate depth-mean currents
103         !-----------------------------
104         
105         DO ib_bdy = 1, nb_bdy
[911]106
[3294]107            nblen => idx_bdy(ib_bdy)%nblen
108            nblenrim => idx_bdy(ib_bdy)%nblenrim
[4292]109            dta => dta_bdy(ib_bdy)
[2528]110
[4292]111            IF( nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN
[3651]112               ilen1(:) = nblen(:)
[4292]113               IF( dta%ll_ssh ) THEN
114                  igrd = 1
115                  DO ib = 1, ilen1(igrd)
[3294]116                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
117                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
[4292]118                     dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)         
119                  END DO
120               END IF
121               IF( dta%ll_u2d ) THEN
122                  igrd = 2
123                  DO ib = 1, ilen1(igrd)
[3294]124                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
125                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
[4354]126                     dta_bdy(ib_bdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1)         
[4292]127                  END DO
128               END IF
129               IF( dta%ll_v2d ) THEN
130                  igrd = 3
131                  DO ib = 1, ilen1(igrd)
132                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
133                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
[4354]134                     dta_bdy(ib_bdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1)         
[4292]135                  END DO
136               END IF
137            ENDIF
138
139            IF( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN
140               ilen1(:) = nblen(:)
141               IF( dta%ll_u3d ) THEN
142                  igrd = 2 
143                  DO ib = 1, ilen1(igrd)
144                     DO ik = 1, jpkm1
145                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
146                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
[4354]147                        dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)         
[3294]148                     END DO
[4292]149                  END DO
150               END IF
151               IF( dta%ll_v3d ) THEN
152                  igrd = 3 
153                  DO ib = 1, ilen1(igrd)
154                     DO ik = 1, jpkm1
155                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
156                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
[4354]157                        dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)         
[4292]158                        END DO
159                  END DO
160               END IF
[3294]161            ENDIF
[911]162
[4292]163            IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN
[3651]164               ilen1(:) = nblen(:)
[4292]165               IF( dta%ll_tem ) THEN
166                  igrd = 1 
167                  DO ib = 1, ilen1(igrd)
168                     DO ik = 1, jpkm1
169                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
170                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
171                        dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)         
172                     END DO
173                  END DO
174               END IF
175               IF( dta%ll_sal ) THEN
176                  igrd = 1 
177                  DO ib = 1, ilen1(igrd)
178                     DO ik = 1, jpkm1
179                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
180                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
181                        dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)         
182                     END DO
183                  END DO
184               END IF
[3294]185            ENDIF
[911]186
[3294]187#if defined key_lim2
[4333]188            IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN
[3651]189               ilen1(:) = nblen(:)
[4292]190               IF( dta%ll_frld ) THEN
191                  igrd = 1 
192                  DO ib = 1, ilen1(igrd)
193                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
194                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
195                     dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)         
196                  END DO
197               END IF
198               IF( dta%ll_hicif ) THEN
199                  igrd = 1 
200                  DO ib = 1, ilen1(igrd)
201                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
202                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
203                     dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)         
204                  END DO
205               END IF
206               IF( dta%ll_hsnif ) THEN
207                  igrd = 1 
208                  DO ib = 1, ilen1(igrd)
209                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
210                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
211                     dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)         
212                  END DO
213               END IF
[1125]214            ENDIF
[4292]215#elif defined key_lim3
216            IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN
217               ilen1(:) = nblen(:)
218               IF( dta%ll_a_i ) THEN
219                  igrd = 1   
220                  DO jl = 1, jpl
221                     DO ib = 1, ilen1(igrd)
222                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
223                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
224                        dta_bdy(ib_bdy)%a_i (ib,jl) =  a_i(ii,ij,jl) * tmask(ii,ij,1) 
225                     END DO
226                  END DO
227               ENDIF
228               IF( dta%ll_ht_i ) THEN
229                  igrd = 1   
230                  DO jl = 1, jpl
231                     DO ib = 1, ilen1(igrd)
232                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
233                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
234                        dta_bdy(ib_bdy)%ht_i (ib,jl) =  ht_i(ii,ij,jl) * tmask(ii,ij,1) 
235                     END DO
236                  END DO
237               ENDIF
238               IF( dta%ll_ht_s ) THEN
239                  igrd = 1   
240                  DO jl = 1, jpl
241                     DO ib = 1, ilen1(igrd)
242                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
243                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
244                        dta_bdy(ib_bdy)%ht_s (ib,jl) =  ht_s(ii,ij,jl) * tmask(ii,ij,1) 
245                     END DO
246                  END DO
247               ENDIF
248            ENDIF
[3294]249#endif
[911]250
[3294]251         ENDDO ! ib_bdy
[911]252
253
[3294]254      ENDIF ! kt .eq. nit000
[911]255
[3294]256      ! update external data from files
257      !--------------------------------
258     
259      jstart = 1
260      DO ib_bdy = 1, nb_bdy   
[4292]261         dta => dta_bdy(ib_bdy)
[3294]262         IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required
263     
264            IF( PRESENT(jit) ) THEN
265               ! Update barotropic boundary conditions only
[3651]266               ! jit is optional argument for fld_read and bdytide_update
[4292]267               IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN
[3294]268                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
[4292]269                     IF( dta%ll_ssh ) dta%ssh(:) = 0.0
270                     IF( dta%ll_u2d ) dta%u2d(:) = 0.0
271                     IF( dta%ll_u3d ) dta%v2d(:) = 0.0
[3294]272                  ENDIF
[4292]273                  IF (cn_tra(ib_bdy) /= 'runoff') THEN
274                     IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 ) THEN
[3703]275
[4292]276                        jend = jstart + dta%nread(2) - 1
[3703]277                        CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  &
[3851]278                                     & kit=jit, kt_offset=time_offset )
[3703]279
[4292]280                        ! If full velocities in boundary data then extract barotropic velocities from 3D fields
[3703]281                        IF( ln_full_vel_array(ib_bdy) .AND.                                             &
282                          &    ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  &
283                          &      nn_dyn3d_dta(ib_bdy) .EQ. 1 ) )THEN
284
[3651]285                           igrd = 2                      ! zonal velocity
[4292]286                           dta%u2d(:) = 0.0
[3651]287                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
288                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
289                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
290                              DO ik = 1, jpkm1
[4292]291                                 dta%u2d(ib) = dta%u2d(ib) &
292                       &                          + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
[3651]293                              END DO
[4292]294                              dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij)
[3651]295                           END DO
296                           igrd = 3                      ! meridional velocity
[4292]297                           dta%v2d(:) = 0.0
[3651]298                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
299                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
300                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
301                              DO ik = 1, jpkm1
[4292]302                                 dta%v2d(ib) = dta%v2d(ib) &
303                       &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
[3651]304                              END DO
[4292]305                              dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij)
[3651]306                           END DO
307                        ENDIF                   
308                     ENDIF
309                     IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
[4292]310                        CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta, td=tides(ib_bdy),   & 
[3651]311                          &                 jit=jit, time_offset=time_offset )
312                     ENDIF
[3294]313                  ENDIF
[1125]314               ENDIF
[3294]315            ELSE
[4292]316               IF (cn_tra(ib_bdy) == 'runoff') then      ! runoff condition
[3651]317                  jend = nb_bdy_fld(ib_bdy)
[3703]318                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend),  &
[3851]319                               & map=nbmap_ptr(jstart:jend), kt_offset=time_offset )
[3651]320                  !
321                  igrd = 2                      ! zonal velocity
322                  DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
323                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
324                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
[4292]325                     dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )
[3651]326                  END DO
327                  !
328                  igrd = 3                      ! meridional velocity
329                  DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
330                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
331                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
[4292]332                     dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )
[3651]333                  END DO
334               ELSE
[4292]335                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
336                     IF( dta%ll_ssh ) dta%ssh(:) = 0.0
337                     IF( dta%ll_u2d ) dta%u2d(:) = 0.0
338                     IF( dta%ll_v2d ) dta%v2d(:) = 0.0
[3651]339                  ENDIF
[4292]340                  IF( dta%nread(1) .gt. 0 ) THEN ! update external data
341                     jend = jstart + dta%nread(1) - 1
[3703]342                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), &
[4694]343                                  & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy )
[3651]344                  ENDIF
345                  ! If full velocities in boundary data then split into barotropic and baroclinic data
346                  IF( ln_full_vel_array(ib_bdy) .and.                                             &
[3703]347                    & ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. &
348                    &   nn_dyn3d_dta(ib_bdy) .EQ. 1 ) ) THEN
[3651]349                     igrd = 2                      ! zonal velocity
[4292]350                     dta%u2d(:) = 0.0
[3651]351                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
352                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
353                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
354                        DO ik = 1, jpkm1
[4292]355                           dta%u2d(ib) = dta%u2d(ib) &
356                 &                       + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
[3651]357                        END DO
[4292]358                        dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij)
[3651]359                        DO ik = 1, jpkm1
[4292]360                           dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib)
[3651]361                        END DO
362                     END DO
363                     igrd = 3                      ! meridional velocity
[4292]364                     dta%v2d(:) = 0.0
[3651]365                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
366                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
367                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
368                        DO ik = 1, jpkm1
[4292]369                           dta%v2d(ib) = dta%v2d(ib) &
370                 &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
[3651]371                        END DO
[4292]372                        dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij)
[3651]373                        DO ik = 1, jpkm1
[4292]374                           dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib)
[3651]375                        END DO
376                     END DO
377                  ENDIF
[4292]378
[1125]379               ENDIF
[4292]380#if defined key_lim3
[4608]381               IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is lim2 type)
[4292]382                CALL lim_cat_1D ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
383                                  & dta_bdy(ib_bdy)%ht_i,     dta_bdy(ib_bdy)%ht_s,     dta_bdy(ib_bdy)%a_i     )
384               ENDIF
385#endif
[1125]386            ENDIF
[4292]387            jstart = jstart + dta%nread(1)
[3651]388         END IF ! nn_dta(ib_bdy) = 1
389      END DO  ! ib_bdy
[911]390
[4292]391      ! bg jchanut tschanges
392#if defined key_tide
393      ! Add tides if not split-explicit free surface else this is done in ts loop
394      IF (.NOT.lk_dynspg_ts) CALL bdy_dta_tides( kt=kt, time_offset=time_offset )
395#endif
396      ! end jchanut tschanges
397
[3651]398      IF ( ln_apr_obc ) THEN
399         DO ib_bdy = 1, nb_bdy
[4292]400            IF (cn_tra(ib_bdy) /= 'runoff')THEN
[3651]401               igrd = 1                      ! meridional velocity
402               DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
[3294]403                  ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
404                  ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
[3651]405                  dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + ssh_ib(ii,ij)
406               ENDDO
[1125]407            ENDIF
[3651]408         ENDDO
409      ENDIF
[911]410
[3294]411      IF( nn_timing == 1 ) CALL timing_stop('bdy_dta')
[911]412
[3294]413      END SUBROUTINE bdy_dta
[911]414
415
[3294]416      SUBROUTINE bdy_dta_init
417      !!----------------------------------------------------------------------
418      !!                   ***  SUBROUTINE bdy_dta_init  ***
419      !!                   
420      !! ** Purpose :   Initialise arrays for reading of external data
421      !!                for open boundary conditions
422      !!
[4292]423      !! ** Method  :   
[3294]424      !!               
425      !!----------------------------------------------------------------------
426      USE dynspg_oce, ONLY: lk_dynspg_ts
427      !!
428      INTEGER     ::  ib_bdy, jfld, jstart, jend, ierror  ! local indices
[4147]429      INTEGER      ::   ios                               ! Local integer output status for namelist read
[3294]430      !!
431      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files
432      CHARACTER(len=100), DIMENSION(nb_bdy)  ::   cn_dir_array  ! Root directory for location of data files
433      LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data
434                                                                ! =F => baroclinic velocities in 3D boundary data
435      INTEGER                                ::   ilen_global   ! Max length required for global bdy dta arrays
436      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ilen1, ilen3  ! size of 1st and 3rd dimensions of local arrays
437      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ibdy           ! bdy set for a particular jfld
438      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   igrid         ! index for grid type (1,2,3 = T,U,V)
439      INTEGER, POINTER, DIMENSION(:)         ::   nblen, nblenrim  ! short cuts
[4292]440      TYPE(OBC_DATA), POINTER                ::   dta           ! short cut
441#if defined key_lim3
442      INTEGER, DIMENSION(3) ::   zdimsz   ! number of elements in each of the 4 dimensions (i.e. i,j,t,ice-cat) for an array
443      INTEGER               ::   zndims   ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat)
444      INTEGER               ::   inum,id1 ! local integer
445#endif
[3294]446      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   blf_i         !  array of namelist information structures
447      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !
448      TYPE(FLD_N) ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read
[2528]449#if defined key_lim2
[3294]450      TYPE(FLD_N) ::   bn_frld, bn_hicif, bn_hsnif      !
[4292]451#elif defined key_lim3
452      TYPE(FLD_N) ::   bn_a_i, bn_ht_i, bn_ht_s     
[2528]453#endif
[3294]454      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 
[2528]455#if defined key_lim2
[3294]456      NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif
[4292]457#elif defined key_lim3
458      NAMELIST/nambdy_dta/ bn_a_i, bn_ht_i, bn_ht_s
[3294]459#endif
460      NAMELIST/nambdy_dta/ ln_full_vel
461      !!---------------------------------------------------------------------------
[911]462
[3294]463      IF( nn_timing == 1 ) CALL timing_start('bdy_dta_init')
[911]464
[3651]465      IF(lwp) WRITE(numout,*)
466      IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries'
467      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
468      IF(lwp) WRITE(numout,*) ''
469
[3294]470      ! Set nn_dta
471      DO ib_bdy = 1, nb_bdy
472         nn_dta(ib_bdy) = MAX(  nn_dyn2d_dta(ib_bdy)       &
473                               ,nn_dyn3d_dta(ib_bdy)       &
474                               ,nn_tra_dta(ib_bdy)         &
[4292]475#if ( defined key_lim2 || defined key_lim3 )
476                              ,nn_ice_lim_dta(ib_bdy)    &
[2528]477#endif
[3294]478                              )
479         IF(nn_dta(ib_bdy) .gt. 1) nn_dta(ib_bdy) = 1
480      END DO
[911]481
[3294]482      ! Work out upper bound of how many fields there are to read in and allocate arrays
483      ! ---------------------------------------------------------------------------
484      ALLOCATE( nb_bdy_fld(nb_bdy) )
485      nb_bdy_fld(:) = 0
486      DO ib_bdy = 1, nb_bdy         
[4292]487         IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN
[3294]488            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
489         ENDIF
[4292]490         IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN
[3294]491            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
492         ENDIF
[4292]493         IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN
[3294]494            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
495         ENDIF
[4292]496#if ( defined key_lim2 || defined key_lim3 )
497         IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) .eq. 1  ) THEN
[3294]498            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
499         ENDIF
500#endif               
[3651]501         IF(lwp) WRITE(numout,*) 'Maximum number of files to open =',nb_bdy_fld(ib_bdy)
[3294]502      ENDDO           
[2528]503
[3294]504      nb_bdy_fld_sum = SUM( nb_bdy_fld )
[911]505
[3294]506      ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror )
507      IF( ierror > 0 ) THEN   
508         CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' )   ;   RETURN 
[911]509      ENDIF
[3294]510      ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror )
511      IF( ierror > 0 ) THEN   
512         CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' )   ;   RETURN 
[1125]513      ENDIF
[3294]514      ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror )
515      IF( ierror > 0 ) THEN   
516         CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' )   ;   RETURN 
517      ENDIF
518      ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) ) 
519      ALLOCATE( ibdy(nb_bdy_fld_sum) ) 
520      ALLOCATE( igrid(nb_bdy_fld_sum) ) 
[911]521
[3294]522      ! Read namelists
523      ! --------------
[4147]524      REWIND(numnam_ref)
525      REWIND(numnam_cfg)
[3294]526      jfld = 0 
527      DO ib_bdy = 1, nb_bdy         
528         IF( nn_dta(ib_bdy) .eq. 1 ) THEN
[4147]529            READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901)
530901         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp )
[911]531
[4147]532            READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 )
533902         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp )
534            WRITE ( numond, nambdy_dta )
535
[3294]536            cn_dir_array(ib_bdy) = cn_dir
537            ln_full_vel_array(ib_bdy) = ln_full_vel
[911]538
[3294]539            nblen => idx_bdy(ib_bdy)%nblen
540            nblenrim => idx_bdy(ib_bdy)%nblenrim
[4292]541            dta => dta_bdy(ib_bdy)
542            dta%nread(2) = 0
[911]543
[3294]544            ! Only read in necessary fields for this set.
545            ! Important that barotropic variables come first.
[4292]546            IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN
[911]547
[4292]548               IF( dta%ll_ssh ) THEN
549                  if(lwp) write(numout,*) '++++++ reading in ssh field'
[3294]550                  jfld = jfld + 1
551                  blf_i(jfld) = bn_ssh
552                  ibdy(jfld) = ib_bdy
553                  igrid(jfld) = 1
[3651]554                  ilen1(jfld) = nblen(igrid(jfld))
[3294]555                  ilen3(jfld) = 1
[4292]556                  dta%nread(2) = dta%nread(2) + 1
[3294]557               ENDIF
[911]558
[4292]559               IF( dta%ll_u2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN
560                  if(lwp) write(numout,*) '++++++ reading in u2d field'
[3294]561                  jfld = jfld + 1
562                  blf_i(jfld) = bn_u2d
563                  ibdy(jfld) = ib_bdy
564                  igrid(jfld) = 2
[3651]565                  ilen1(jfld) = nblen(igrid(jfld))
[3294]566                  ilen3(jfld) = 1
[4292]567                  dta%nread(2) = dta%nread(2) + 1
568               ENDIF
[911]569
[4292]570               IF( dta%ll_v2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN
571                  if(lwp) write(numout,*) '++++++ reading in v2d field'
[3294]572                  jfld = jfld + 1
573                  blf_i(jfld) = bn_v2d
574                  ibdy(jfld) = ib_bdy
575                  igrid(jfld) = 3
[3651]576                  ilen1(jfld) = nblen(igrid(jfld))
[3294]577                  ilen3(jfld) = 1
[4292]578                  dta%nread(2) = dta%nread(2) + 1
[3294]579               ENDIF
[911]580
[3294]581            ENDIF
[1125]582
[4292]583            ! read 3D velocities if baroclinic velocities require OR if
584            ! barotropic velocities required and ln_full_vel set to .true.
585            IF( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. &
586           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN
[911]587
[4292]588               IF( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN
589                  if(lwp) write(numout,*) '++++++ reading in u3d field'
590                  jfld = jfld + 1
591                  blf_i(jfld) = bn_u3d
592                  ibdy(jfld) = ib_bdy
593                  igrid(jfld) = 2
594                  ilen1(jfld) = nblen(igrid(jfld))
595                  ilen3(jfld) = jpk
596                  IF( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1
597               ENDIF
[911]598
[4292]599               IF( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN
600                  if(lwp) write(numout,*) '++++++ reading in v3d field'
601                  jfld = jfld + 1
602                  blf_i(jfld) = bn_v3d
603                  ibdy(jfld) = ib_bdy
604                  igrid(jfld) = 3
605                  ilen1(jfld) = nblen(igrid(jfld))
606                  ilen3(jfld) = jpk
607                  IF( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1
608               ENDIF
[911]609
[3294]610            ENDIF
[911]611
[3294]612            ! temperature and salinity
[4292]613            IF( nn_tra_dta(ib_bdy) .eq. 1 ) THEN
[911]614
[4292]615               IF( dta%ll_tem ) THEN
616                  if(lwp) write(numout,*) '++++++ reading in tem field'
617                  jfld = jfld + 1
618                  blf_i(jfld) = bn_tem
619                  ibdy(jfld) = ib_bdy
620                  igrid(jfld) = 1
621                  ilen1(jfld) = nblen(igrid(jfld))
622                  ilen3(jfld) = jpk
623               ENDIF
[911]624
[4292]625               IF( dta%ll_sal ) THEN
626                  if(lwp) write(numout,*) '++++++ reading in sal field'
627                  jfld = jfld + 1
628                  blf_i(jfld) = bn_sal
629                  ibdy(jfld) = ib_bdy
630                  igrid(jfld) = 1
631                  ilen1(jfld) = nblen(igrid(jfld))
632                  ilen3(jfld) = jpk
633               ENDIF
[911]634
635            ENDIF
636
[3294]637#if defined key_lim2
638            ! sea ice
[4333]639            IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN
[911]640
[4292]641               IF( dta%ll_frld ) THEN
642                  jfld = jfld + 1
643                  blf_i(jfld) = bn_frld
644                  ibdy(jfld) = ib_bdy
645                  igrid(jfld) = 1
646                  ilen1(jfld) = nblen(igrid(jfld))
647                  ilen3(jfld) = 1
648               ENDIF
[911]649
[4292]650               IF( dta%ll_hicif ) THEN
651                  jfld = jfld + 1
652                  blf_i(jfld) = bn_hicif
653                  ibdy(jfld) = ib_bdy
654                  igrid(jfld) = 1
655                  ilen1(jfld) = nblen(igrid(jfld))
656                  ilen3(jfld) = 1
657               ENDIF
[911]658
[4292]659               IF( dta%ll_hsnif ) THEN
660                  jfld = jfld + 1
661                  blf_i(jfld) = bn_hsnif
662                  ibdy(jfld) = ib_bdy
663                  igrid(jfld) = 1
664                  ilen1(jfld) = nblen(igrid(jfld))
665                  ilen3(jfld) = 1
666               ENDIF
[911]667
[3294]668            ENDIF
[4292]669#elif defined key_lim3
670            ! sea ice
671            IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN
672
673               ! Test for types of ice input (lim2 or lim3)
674               CALL iom_open ( bn_a_i%clname, inum )
675               id1 = iom_varid ( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. )
676               CALL iom_close ( inum )
677               !CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. )
678               !CALL iom_open ( bn_a_i %clname, inum )
679               !id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. )
680                IF ( zndims == 4 ) THEN
681                 ll_bdylim3 = .TRUE.   ! lim3 input
682               ELSE
683                 ll_bdylim3 = .FALSE.  ! lim2 input     
684               ENDIF
685               ! End test
686
687               IF( dta%ll_a_i ) THEN
688                  jfld = jfld + 1
689                  blf_i(jfld) = bn_a_i
690                  ibdy(jfld) = ib_bdy
691                  igrid(jfld) = 1
692                  ilen1(jfld) = nblen(igrid(jfld))
693                  IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF
694               ENDIF
695
696               IF( dta%ll_ht_i ) THEN
697                  jfld = jfld + 1
698                  blf_i(jfld) = bn_ht_i
699                  ibdy(jfld) = ib_bdy
700                  igrid(jfld) = 1
701                  ilen1(jfld) = nblen(igrid(jfld))
702                  IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF
703               ENDIF
704
705               IF( dta%ll_ht_s ) THEN
706                  jfld = jfld + 1
707                   blf_i(jfld) = bn_ht_s
708                  ibdy(jfld) = ib_bdy
709                  igrid(jfld) = 1
710                  ilen1(jfld) = nblen(igrid(jfld))
711                  IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF
712               ENDIF
713
[4333]714            ENDIF
[3294]715#endif
716            ! Recalculate field counts
717            !-------------------------
718            IF( ib_bdy .eq. 1 ) THEN
[4148]719               nb_bdy_fld_sum = 0
[3294]720               nb_bdy_fld(ib_bdy) = jfld
721               nb_bdy_fld_sum     = jfld             
722            ELSE
723               nb_bdy_fld(ib_bdy) = jfld - nb_bdy_fld_sum
724               nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(ib_bdy)
725            ENDIF
[911]726
[4292]727            dta%nread(1) = nb_bdy_fld(ib_bdy)
728
[3294]729         ENDIF ! nn_dta .eq. 1
730      ENDDO ! ib_bdy
[911]731
[3294]732      DO jfld = 1, nb_bdy_fld_sum
733         ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) )
734         IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) )
735         nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld))
736      ENDDO
[911]737
[3294]738      ! fill bf with blf_i and control print
739      !-------------------------------------
740      jstart = 1
741      DO ib_bdy = 1, nb_bdy
[3651]742         jend = nb_bdy_fld(ib_bdy) 
[3294]743         CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_bdy), 'bdy_dta',   &
744         &              'open boundary conditions', 'nambdy_dta' )
745         jstart = jend + 1
746      ENDDO
[911]747
[4694]748      DO jfld = 1, nb_bdy_fld_sum
749               bf(jfld)%igrd = igrid(jfld) 
750               bf(jfld)%ibdy = ibdy(jfld) 
751      ENDDO
752
[3294]753      ! Initialise local boundary data arrays
754      ! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later
755      ! nn_xxx_dta=1 : point to "fnow" arrays
756      !-------------------------------------
[911]757
[3294]758      jfld = 0
759      DO ib_bdy=1, nb_bdy
[911]760
[3294]761         nblen => idx_bdy(ib_bdy)%nblen
[4292]762         dta => dta_bdy(ib_bdy)
[911]763
[4292]764         if(lwp) then
765            write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh
766            write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d
767            write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d
768            write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d
769            write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d
770            write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem
771            write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal
772         endif
773
774         IF ( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN
775            if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space'
776            IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) )
777            IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) )
778            IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) )
779         ENDIF
780         IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN
781            IF( dta%ll_ssh ) THEN
782               if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow'
783               jfld = jfld + 1
784               dta%ssh => bf(jfld)%fnow(:,1,1)
785            ENDIF
786            IF ( dta%ll_u2d ) THEN
787               IF ( ln_full_vel_array(ib_bdy) ) THEN
788                  if(lwp) write(numout,*) '++++++ dta%u2d allocated space'
789                  ALLOCATE( dta%u2d(nblen(2)) )
790               ELSE
791                  if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow'
[3651]792                  jfld = jfld + 1
[4292]793                  dta%u2d => bf(jfld)%fnow(:,1,1)
794               ENDIF
795            ENDIF
796            IF ( dta%ll_v2d ) THEN
797               IF ( ln_full_vel_array(ib_bdy) ) THEN
798                  if(lwp) write(numout,*) '++++++ dta%v2d allocated space'
799                  ALLOCATE( dta%v2d(nblen(3)) )
[3294]800               ELSE
[4292]801                  if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow'
[3294]802                  jfld = jfld + 1
[4292]803                  dta%v2d => bf(jfld)%fnow(:,1,1)
[3294]804               ENDIF
805            ENDIF
806         ENDIF
[911]807
[4292]808         IF ( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN
809            if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space'
810            IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) )
811            IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) )
[3294]812         ENDIF
[4292]813         IF ( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. &
814           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN
815            IF ( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN
816               if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow'
817               jfld = jfld + 1
818               dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:)
819            ENDIF
820            IF ( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN
821               if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow'
822               jfld = jfld + 1
823               dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:)
824            ENDIF
[3294]825         ENDIF
[911]826
[4292]827         IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN
828            if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space'
829            IF( dta%ll_tem ) ALLOCATE( dta_bdy(ib_bdy)%tem(nblen(1),jpk) )
830            IF( dta%ll_sal ) ALLOCATE( dta_bdy(ib_bdy)%sal(nblen(1),jpk) )
831         ELSE
832            IF( dta%ll_tem ) THEN
833               if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow'
[3294]834               jfld = jfld + 1
835               dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:)
[4292]836            ENDIF
837            IF( dta%ll_sal ) THEN
838               if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow'
[3294]839               jfld = jfld + 1
840               dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:)
841            ENDIF
842         ENDIF
[911]843
[3294]844#if defined key_lim2
[4608]845         IF (cn_ice_lim(ib_bdy) /= 'none') THEN
[4333]846            IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN
[4292]847               ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) )
848               ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) )
849               ALLOCATE( dta_bdy(ib_bdy)%hsnif(nblen(1)) )
[3294]850            ELSE
851               jfld = jfld + 1
852               dta_bdy(ib_bdy)%frld  => bf(jfld)%fnow(:,1,1)
853               jfld = jfld + 1
854               dta_bdy(ib_bdy)%hicif => bf(jfld)%fnow(:,1,1)
855               jfld = jfld + 1
856               dta_bdy(ib_bdy)%hsnif => bf(jfld)%fnow(:,1,1)
857            ENDIF
[911]858         ENDIF
[4292]859#elif defined key_lim3
[4608]860         IF (cn_ice_lim(ib_bdy) /= 'none') THEN
[4292]861            IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN
862               ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) )
863               ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) )
864               ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) )
865            ELSE
866               IF ( ll_bdylim3 ) THEN ! case input is lim3 type
867                  jfld = jfld + 1
868                  dta_bdy(ib_bdy)%a_i  => bf(jfld)%fnow(:,1,:)
869                  jfld = jfld + 1
870                  dta_bdy(ib_bdy)%ht_i => bf(jfld)%fnow(:,1,:)
871                  jfld = jfld + 1
872                  dta_bdy(ib_bdy)%ht_s => bf(jfld)%fnow(:,1,:)
873               ELSE ! case input is lim2 type
874                  jfld_ai  = jfld + 1
875                  jfld_hti = jfld + 2
876                  jfld_hts = jfld + 3
877                  jfld     = jfld + 3
878                  ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) )
879                  ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) )
880                  ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) )
881                  dta_bdy(ib_bdy)%a_i (:,:) = 0.0
882                  dta_bdy(ib_bdy)%ht_i(:,:) = 0.0
883                  dta_bdy(ib_bdy)%ht_s(:,:) = 0.0
884               ENDIF
885
886            ENDIF
887         ENDIF
[3294]888#endif
[911]889
[3294]890      ENDDO ! ib_bdy
[911]891
[3294]892      IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_init')
[911]893
[3294]894      END SUBROUTINE bdy_dta_init
[911]895
896#else
[1125]897   !!----------------------------------------------------------------------
[3294]898   !!   Dummy module                   NO Open Boundary Conditions
[1125]899   !!----------------------------------------------------------------------
[911]900CONTAINS
[3294]901   SUBROUTINE bdy_dta( kt, jit, time_offset ) ! Empty routine
902      INTEGER, INTENT( in )           ::   kt   
903      INTEGER, INTENT( in ), OPTIONAL ::   jit   
904      INTEGER, INTENT( in ), OPTIONAL ::   time_offset
905      WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt
906   END SUBROUTINE bdy_dta
907   SUBROUTINE bdy_dta_init()                  ! Empty routine
908      WRITE(*,*) 'bdy_dta_init: You should not have seen this print! error?'
909   END SUBROUTINE bdy_dta_init
[911]910#endif
911
912   !!==============================================================================
913END MODULE bdydta
[4354]914
915
Note: See TracBrowser for help on using the repository browser.