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/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

source: branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90 @ 2888

Last change on this file since 2888 was 2888, checked in by davestorkey, 13 years ago

Move changes into updated BDY module and restore old OBC code.
(Full merge to take place next year).
File size: 30.3 KB
Line 
1MODULE bdydta
2   !!======================================================================
3   !!                       ***  MODULE bdydta  ***
4   !! Open boundary data : read the data for the unstructured open boundaries.
5   !!======================================================================
6   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
7   !!             -   !  2007-01  (D. Storkey) Update to use IOM module
8   !!             -   !  2007-07  (D. Storkey) add bdy_dta_fla
9   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
10   !!            3.3  !  2010-09  (E.O'Dea) modifications for Shelf configurations
11   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
12   !!            3.4  ????????????????
13   !!----------------------------------------------------------------------
14#if defined key_bdy
15   !!----------------------------------------------------------------------
16   !!   'key_bdy'                     Open Boundary Conditions
17   !!----------------------------------------------------------------------
18   !!    bdy_dta        : read external data along open boundaries from file
19   !!    bdy_dta_init   : initialise arrays etc for reading of external data
20   !!----------------------------------------------------------------------
21   USE oce             ! ocean dynamics and tracers
22   USE dom_oce         ! ocean space and time domain
23   USE phycst          ! physical constants
24   USE bdy_oce         ! ocean open boundary conditions 
25   USE bdytides        ! tidal forcing at boundaries
26   USE fldread         ! read input fields
27   USE iom             ! IOM library
28   USE in_out_manager  ! I/O logical units
29#if defined key_lim2
30   USE ice_2
31#endif
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   bdy_dta          ! routine called by step.F90 and dynspg_ts.F90
37   PUBLIC   bdy_dta_init     ! routine called by nemogcm.F90
38
39   INTEGER, ALLOCATABLE, DIMENSION(:)   ::   nb_bdy_fld        ! Number of fields to update for each boundary set.
40   INTEGER                              ::   nb_bdy_fld_sum    ! Total number of fields to update for all boundary sets.
41
42   LOGICAL,           DIMENSION(jp_bdy) ::   ln_full_vel_array ! =T => full velocities in 3D boundary conditions
43                                                               ! =F => baroclinic velocities in 3D boundary conditions
44
45   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET ::   bf        ! structure of input fields (file informations, fields read)
46
47   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap
48
49#  include "domzgr_substitute.h90"
50   !!----------------------------------------------------------------------
51   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
52   !! $Id: bdydta.F90 2715 2011-03-30 15:58:35Z rblod $
53   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
54   !!----------------------------------------------------------------------
55CONTAINS
56
57      SUBROUTINE bdy_dta( kt, jit, time_offset )
58      !!----------------------------------------------------------------------
59      !!                   ***  SUBROUTINE bdy_dta  ***
60      !!                   
61      !! ** Purpose :   Update external data for open boundary conditions
62      !!
63      !! ** Method  :   Use fldread.F90
64      !!               
65      !!----------------------------------------------------------------------
66      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
67      USE wrk_nemo, ONLY: wrk_2d_22, wrk_2d_23   ! 2D workspace
68      !!
69      INTEGER, INTENT( in )           ::   kt    ! ocean time-step index
70      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option)
71      INTEGER, INTENT( in ), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit
72                                                        ! is present then units = subcycle timesteps.
73                                                        ! time_offset = 0 => get data at "now" time level
74                                                        ! time_offset = -1 => get data at "before" time level
75                                                        ! time_offset = +1 => get data at "after" time level
76                                                        ! etc.
77      !!
78      INTEGER     ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd  ! local indices
79      INTEGER,          DIMENSION(jpbgrd) ::   ilen1 
80      INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts
81      !!
82      !!---------------------------------------------------------------------------
83
84      IF(wrk_in_use(2, 22,23) ) THEN
85         CALL ctl_stop('bdy_dta: ERROR: requested workspace arrays are unavailable.')   ;   RETURN
86      END IF
87
88      ! Initialise data arrays once for all from initial conditions where required
89      !---------------------------------------------------------------------------
90      IF( kt .eq. nit000 .and. .not. PRESENT(jit) ) THEN
91
92         ! Calculate depth-mean currents
93         !-----------------------------
94         pu2d => wrk_2d_22
95         pu2d => wrk_2d_23
96
97         pu2d(:,:) = 0.e0
98         pv2d(:,:) = 0.e0
99
100         DO ik = 1, jpkm1   !! Vertically integrated momentum trends
101             pu2d(:,:) = pu2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik)
102             pv2d(:,:) = pv2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik)
103         END DO
104         pu2d(:,:) = pu2d(:,:) * hur(:,:)
105         pv2d(:,:) = pv2d(:,:) * hvr(:,:)
106         
107         DO ib_bdy = 1, nb_bdy
108
109            nblen => idx_bdy(ib_bdy)%nblen
110            nblenrim => idx_bdy(ib_bdy)%nblenrim
111
112            IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN
113               IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
114                  ilen1(:) = nblen(:)
115               ELSE
116                  ilen1(:) = nblenrim(:)
117               ENDIF
118               igrd = 1
119               DO ib = 1, ilen1(igrd)
120                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
121                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
122                  dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)         
123               END DO
124               igrd = 2
125               DO ib = 1, ilen1(igrd)
126                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
127                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
128                  dta_bdy(ib_bdy)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1)         
129               END DO
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)
134                  dta_bdy(ib_bdy)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1)         
135               END DO
136            ENDIF
137
138            IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN
139               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
140                  ilen1(:) = nblen(:)
141               ELSE
142                  ilen1(:) = nblenrim(:)
143               ENDIF
144               igrd = 2 
145               DO ib = 1, ilen1(igrd)
146                  DO ik = 1, jpkm1
147                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
148                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
149                     dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - pu2d(ii,ij) ) * umask(ii,ij,ik)         
150                  END DO
151               END DO
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)
157                     dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - pv2d(ii,ij) ) * vmask(ii,ij,ik)         
158                     END DO
159               END DO
160            ENDIF
161
162            IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 0 ) THEN
163               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
164                  ilen1(:) = nblen(:)
165               ELSE
166                  ilen1(:) = nblenrim(:)
167               ENDIF
168               igrd = 1                       ! Everything is at T-points here
169               DO ib = 1, ilen1(igrd)
170                  DO ik = 1, jpkm1
171                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
172                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
173                     dta_bdy(ib_bdy)%tem(ib,ik) = tn(ii,ij,ik) * tmask(ii,ij,ik)         
174                     dta_bdy(ib_bdy)%sal(ib,ik) = sn(ii,ij,ik) * tmask(ii,ij,ik)         
175                  END DO
176               END DO
177            ENDIF
178
179#if defined key_lim2
180            IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN
181               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
182                  ilen1(:) = nblen(:)
183               ELSE
184                  ilen1(:) = nblenrim(:)
185               ENDIF
186               igrd = 1                       ! Everything is at T-points here
187               DO ib = 1, ilen1(igrd)
188                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
189                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
190                  dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)         
191                  dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)         
192                  dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)         
193               END DO
194            ENDIF
195#endif
196
197         ENDDO ! ib_bdy
198
199      ENDIF ! kt .eq. nit000
200
201      ! update external data from files
202      !--------------------------------
203     
204      jstart = 1
205      DO ib_bdy = 1, nb_bdy   
206         IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required
207     
208            IF( PRESENT(jit) ) THEN
209               ! Update barotropic boundary conditions only
210               ! jit is optional argument for fld_read and tide_update
211               IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN
212                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
213                     dta_bdy(ib_bdy)%ssh(:) = 0.0
214                     dta_bdy(ib_bdy)%u2d(:) = 0.0
215                     dta_bdy(ib_bdy)%v2d(:) = 0.0
216                  ENDIF
217                  IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN ! update external data
218                     jend = jstart + 2
219                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), jit=jit, time_offset=time_offset )
220                  ENDIF
221                  IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
222                     CALL tide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy), jit=jit, time_offset=time_offset )
223                  ENDIF
224               ENDIF
225            ELSE
226               IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
227                  dta_bdy(ib_bdy)%ssh(:) = 0.0
228                  dta_bdy(ib_bdy)%u2d(:) = 0.0
229                  dta_bdy(ib_bdy)%v2d(:) = 0.0
230               ENDIF
231               IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data
232                  jend = jstart + nb_bdy_fld(ib_bdy) - 1
233                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), time_offset=time_offset )
234               ENDIF
235               IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
236                  CALL tide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy), time_offset=time_offset )
237               ENDIF
238            ENDIF
239            jstart = jend+1
240
241            ! If full velocities in boundary data then split into barotropic and baroclinic data
242            ! (Note that we have already made sure that you can't use ln_full_vel = .true. at the same
243            ! time as the dynspg_ts option).
244
245            IF( ln_full_vel_array(ib_bdy) .and.                                             & 
246           &    ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 .or. nn_dyn3d_dta(ib_bdy) .eq. 1 ) ) THEN
247
248               igrd = 2                      ! zonal velocity
249               dta_bdy(ib_bdy)%u2d(:) = 0.0
250               DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
251                  ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
252                  ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
253                  DO ik = 1, jpkm1
254                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) &
255              &                                + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik)
256                  END DO
257                  dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij)
258                  DO ik = 1, jpkm1
259                     dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib) 
260                  END DO
261               END DO
262
263               igrd = 3                      ! meridional velocity
264               dta_bdy(ib_bdy)%v2d(:) = 0.0
265               DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
266                  ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
267                  ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
268                  DO ik = 1, jpkm1
269                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) &
270              &                                + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik)
271                  END DO
272                  dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij)
273                  DO ik = 1, jpkm1
274                     dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib) 
275                  END DO
276               END DO
277   
278            ENDIF
279
280         END IF ! nn_dta(ib_bdy) = 1
281      END DO  ! ib_bdy
282
283      IF(wrk_not_released(2, 22,23) )    CALL ctl_stop('bdy_dta: ERROR: failed to release workspace arrays.')
284
285      END SUBROUTINE bdy_dta
286
287
288      SUBROUTINE bdy_dta_init
289      !!----------------------------------------------------------------------
290      !!                   ***  SUBROUTINE bdy_dta_init  ***
291      !!                   
292      !! ** Purpose :   Initialise arrays for reading of external data
293      !!                for open boundary conditions
294      !!
295      !! ** Method  :   Use fldread.F90
296      !!               
297      !!----------------------------------------------------------------------
298      USE dynspg_oce, ONLY: lk_dynspg_ts
299      !!
300      INTEGER     ::  ib_bdy, jfld, jstart, jend, ierror  ! local indices
301      !!
302      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files
303      CHARACTER(len=100), DIMENSION(nb_bdy)  ::   cn_dir_array  ! Root directory for location of data files
304      LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data
305                                                                ! =F => baroclinic velocities in 3D boundary data
306      INTEGER                                ::   ilen_global   ! Max length required for global bdy dta arrays
307      INTEGER,              DIMENSION(jpbgrd) ::  ilen0         ! size of local arrays
308      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ilen1, ilen3  ! size of 1st and 3rd dimensions of local arrays
309      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ibdy           ! bdy set for a particular jfld
310      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   igrid         ! index for grid type (1,2,3 = T,U,V)
311      INTEGER, POINTER, DIMENSION(:)         ::   nblen, nblenrim  ! short cuts
312      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   blf_i         !  array of namelist information structures
313      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !
314      TYPE(FLD_N) ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read
315#if defined key_lim2
316      TYPE(FLD_N) ::   bn_frld, bn_hicif, bn_hsnif      !
317#endif
318      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 
319#if defined key_lim2
320      NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif
321#endif
322      NAMELIST/nambdy_dta/ ln_full_vel
323      !!---------------------------------------------------------------------------
324
325      ! Set nn_dta
326      DO ib_bdy = 1, nb_bdy
327         nn_dta(ib_bdy) = MAX(  nn_dyn2d_dta(ib_bdy)       &
328                               ,nn_dyn3d_dta(ib_bdy)       &
329                               ,nn_tra_dta(ib_bdy)         &
330#if defined key_ice_lim2
331                               ,nn_ice_lim2_dta(ib_bdy)    &
332#endif
333                              )
334         IF(nn_dta(ib_bdy) .gt. 1) nn_dta(ib_bdy) = 1
335      END DO
336
337      ! Work out upper bound of how many fields there are to read in and allocate arrays
338      ! ---------------------------------------------------------------------------
339      ALLOCATE( nb_bdy_fld(nb_bdy) )
340      nb_bdy_fld(:) = 0
341      DO ib_bdy = 1, nb_bdy         
342         IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN
343            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
344         ENDIF
345         IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN
346            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
347         ENDIF
348         IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN
349            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
350         ENDIF
351#if defined key_lim2
352         IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1  ) THEN
353            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
354         ENDIF
355#endif               
356      ENDDO           
357
358      nb_bdy_fld_sum = SUM( nb_bdy_fld )
359
360      ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror )
361      IF( ierror > 0 ) THEN   
362         CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' )   ;   RETURN 
363      ENDIF
364      ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror )
365      IF( ierror > 0 ) THEN   
366         CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' )   ;   RETURN 
367      ENDIF
368      ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror )
369      IF( ierror > 0 ) THEN   
370         CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' )   ;   RETURN 
371      ENDIF
372      ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) ) 
373      ALLOCATE( ibdy(nb_bdy_fld_sum) ) 
374      ALLOCATE( igrid(nb_bdy_fld_sum) ) 
375
376      ! Read namelists
377      ! --------------
378      REWIND(numnam)
379      jfld = 0 
380      DO ib_bdy = 1, nb_bdy         
381         IF( nn_dta(ib_bdy) .eq. 1 ) THEN
382            ! set file information
383            cn_dir = './'        ! directory in which the model is executed
384            ln_full_vel = .false.
385            ! ... default values (NB: frequency positive => hours, negative => months)
386            !                    !  file       ! frequency !  variable        ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  !
387            !                    !  name       !  (hours)  !   name           !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     !
388            bn_ssh     = FLD_N(  'bdy_ssh'     ,    24     ,  'sossheig'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
389            bn_u2d     = FLD_N(  'bdy_vel2d_u' ,    24     ,  'vobtcrtx'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
390            bn_v2d     = FLD_N(  'bdy_vel2d_v' ,    24     ,  'vobtcrty'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
391            bn_u3d     = FLD_N(  'bdy_vel3d_u' ,    24     ,  'vozocrtx'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
392            bn_v3d     = FLD_N(  'bdy_vel3d_v' ,    24     ,  'vomecrty'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
393            bn_tem     = FLD_N(  'bdy_tem'     ,    24     ,  'votemper'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
394            bn_sal     = FLD_N(  'bdy_sal'     ,    24     ,  'vosaline'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
395#if defined key_lim2
396            bn_frld    = FLD_N(  'bdy_frld'    ,    24     ,  'ildsconc'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
397            bn_hicif   = FLD_N(  'bdy_hicif'   ,    24     ,  'iicethic'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
398            bn_hsnif   = FLD_N(  'bdy_hsnif'   ,    24     ,  'isnothic'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
399#endif
400
401            ! Important NOT to rewind here.
402            READ( numnam, nambdy_dta )
403
404            cn_dir_array(ib_bdy) = cn_dir
405            ln_full_vel_array(ib_bdy) = ln_full_vel
406
407            IF( ln_full_vel_array(ib_bdy) .and. lk_dynspg_ts )  THEN
408               CALL ctl_stop( 'bdy_dta_init: ERROR, cannot specify full velocities in boundary data',&
409            &                  'with dynspg_ts option' )   ;   RETURN 
410            ENDIF             
411
412            nblen => idx_bdy(ib_bdy)%nblen
413            nblenrim => idx_bdy(ib_bdy)%nblenrim
414
415            ! Only read in necessary fields for this set.
416            ! Important that barotropic variables come first.
417            IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN
418
419               IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN
420                  jfld = jfld + 1
421                  blf_i(jfld) = bn_ssh
422                  ibdy(jfld) = ib_bdy
423                  igrid(jfld) = 1
424                  ilen1(jfld) = nblenrim(igrid(jfld))
425                  ilen3(jfld) = 1
426               ENDIF
427
428               IF( .not. ln_full_vel_array(ib_bdy) ) THEN
429
430                  jfld = jfld + 1
431                  blf_i(jfld) = bn_u2d
432                  ibdy(jfld) = ib_bdy
433                  igrid(jfld) = 2
434                  IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
435                     ilen1(jfld) = nblen(igrid(jfld))
436                  ELSE
437                     ilen1(jfld) = nblenrim(igrid(jfld))
438                  ENDIF
439                  ilen3(jfld) = 1
440
441                  jfld = jfld + 1
442                  blf_i(jfld) = bn_v2d
443                  ibdy(jfld) = ib_bdy
444                  igrid(jfld) = 3
445                  IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
446                     ilen1(jfld) = nblen(igrid(jfld))
447                  ELSE
448                     ilen1(jfld) = nblenrim(igrid(jfld))
449                  ENDIF
450                  ilen3(jfld) = 1
451
452               ENDIF
453
454            ENDIF
455
456            ! baroclinic velocities
457            IF( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) .or. &
458           &      ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.  &
459           &        ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN
460
461               jfld = jfld + 1
462               blf_i(jfld) = bn_u3d
463               ibdy(jfld) = ib_bdy
464               igrid(jfld) = 2
465               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
466                  ilen1(jfld) = nblen(igrid(jfld))
467               ELSE
468                  ilen1(jfld) = nblenrim(igrid(jfld))
469               ENDIF
470               ilen3(jfld) = jpk
471
472               jfld = jfld + 1
473               blf_i(jfld) = bn_v3d
474               ibdy(jfld) = ib_bdy
475               igrid(jfld) = 3
476               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
477                  ilen1(jfld) = nblen(igrid(jfld))
478               ELSE
479                  ilen1(jfld) = nblenrim(igrid(jfld))
480               ENDIF
481               ilen3(jfld) = jpk
482
483            ENDIF
484
485            ! temperature and salinity
486            IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN
487
488               jfld = jfld + 1
489               blf_i(jfld) = bn_tem
490               ibdy(jfld) = ib_bdy
491               igrid(jfld) = 1
492               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
493                  ilen1(jfld) = nblen(igrid(jfld))
494               ELSE
495                  ilen1(jfld) = nblenrim(igrid(jfld))
496               ENDIF
497               ilen3(jfld) = jpk
498
499               jfld = jfld + 1
500               blf_i(jfld) = bn_sal
501               ibdy(jfld) = ib_bdy
502               igrid(jfld) = 1
503               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
504                  ilen1(jfld) = nblen(igrid(jfld))
505               ELSE
506                  ilen1(jfld) = nblenrim(igrid(jfld))
507               ENDIF
508               ilen3(jfld) = jpk
509
510            ENDIF
511
512#if defined key_lim2
513            ! sea ice
514            IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN
515
516               jfld = jfld + 1
517               blf_i(jfld) = bn_frld
518               ibdy(jfld) = ib_bdy
519               igrid(jfld) = 1
520               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
521                  ilen1(jfld) = nblen(igrid(jfld))
522               ELSE
523                  ilen1(jfld) = nblenrim(igrid(jfld))
524               ENDIF
525               ilen3(jfld) = 1
526
527               jfld = jfld + 1
528               blf_i(jfld) = bn_hicif
529               ibdy(jfld) = ib_bdy
530               igrid(jfld) = 1
531               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
532                  ilen1(jfld) = nblen(igrid(jfld))
533               ELSE
534                  ilen1(jfld) = nblenrim(igrid(jfld))
535               ENDIF
536               ilen3(jfld) = 1
537
538               jfld = jfld + 1
539               blf_i(jfld) = bn_hsnif
540               ibdy(jfld) = ib_bdy
541               igrid(jfld) = 1
542               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
543                  ilen1(jfld) = nblen(igrid(jfld))
544               ELSE
545                  ilen1(jfld) = nblenrim(igrid(jfld))
546               ENDIF
547               ilen3(jfld) = 1
548
549            ENDIF
550#endif
551            ! Recalculate field counts
552            !-------------------------
553            nb_bdy_fld_sum = 0
554            IF( ib_bdy .eq. 1 ) THEN
555               nb_bdy_fld(ib_bdy) = jfld
556               nb_bdy_fld_sum     = jfld             
557            ELSE
558               nb_bdy_fld(ib_bdy) = jfld - nb_bdy_fld_sum
559               nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(ib_bdy)
560            ENDIF
561
562         ENDIF ! nn_dta .eq. 1
563      ENDDO ! ib_bdy
564
565
566      DO jfld = 1, nb_bdy_fld_sum
567         ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) )
568         IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) )
569         nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld))
570      ENDDO
571
572      ! fill bf with blf_i and control print
573      !-------------------------------------
574      jstart = 1
575      DO ib_bdy = 1, nb_bdy
576         jend = jstart + nb_bdy_fld(ib_bdy) - 1
577         CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_bdy), 'bdy_dta', 'open boundary conditions', 'nambdy_dta' )
578         jstart = jend + 1
579      ENDDO
580
581      ! Initialise local boundary data arrays
582      ! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later
583      ! nn_xxx_dta=1 : point to "fnow" arrays
584      !-------------------------------------
585
586      jfld = 0
587      DO ib_bdy=1, nb_bdy
588
589         nblen => idx_bdy(ib_bdy)%nblen
590         nblenrim => idx_bdy(ib_bdy)%nblenrim
591
592         IF (nn_dyn2d(ib_bdy) .gt. 0) THEN
593            IF( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 .or. ln_full_vel_array(ib_bdy) ) THEN
594               IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
595                  ilen0(1:3) = nblen(1:3)
596               ELSE
597                  ilen0(1:3) = nblenrim(1:3)
598               ENDIF
599               ALLOCATE( dta_bdy(ib_bdy)%ssh(ilen0(1)) )
600               ALLOCATE( dta_bdy(ib_bdy)%u2d(ilen0(2)) )
601               ALLOCATE( dta_bdy(ib_bdy)%v2d(ilen0(3)) )
602            ELSE
603               IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN
604                  jfld = jfld + 1
605                  dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1)
606               ENDIF
607               jfld = jfld + 1
608               dta_bdy(ib_bdy)%u2d => bf(jfld)%fnow(:,1,1)
609               jfld = jfld + 1
610               dta_bdy(ib_bdy)%v2d => bf(jfld)%fnow(:,1,1)
611            ENDIF
612         ENDIF
613
614         IF ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN
615            IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
616               ilen0(1:3) = nblen(1:3)
617            ELSE
618               ilen0(1:3) = nblenrim(1:3)
619            ENDIF
620            ALLOCATE( dta_bdy(ib_bdy)%u3d(ilen0(2),jpk) )
621            ALLOCATE( dta_bdy(ib_bdy)%v3d(ilen0(3),jpk) )
622         ENDIF
623         IF ( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ).or. &
624           &  ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.   &
625           &    ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN
626            jfld = jfld + 1
627            dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:)
628            jfld = jfld + 1
629            dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:)
630         ENDIF
631
632         IF (nn_tra(ib_bdy) .gt. 0) THEN
633            IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN
634               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
635                  ilen0(1:3) = nblen(1:3)
636               ELSE
637                  ilen0(1:3) = nblenrim(1:3)
638               ENDIF
639               ALLOCATE( dta_bdy(ib_bdy)%tem(ilen0(1),jpk) )
640               ALLOCATE( dta_bdy(ib_bdy)%sal(ilen0(1),jpk) )
641            ELSE
642               jfld = jfld + 1
643               dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:)
644               jfld = jfld + 1
645               dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:)
646            ENDIF
647         ENDIF
648
649#if defined key_lim2
650         IF (nn_ice_lim2(ib_bdy) .gt. 0) THEN
651            IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN
652               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
653                  ilen0(1:3) = nblen(1:3)
654               ELSE
655                  ilen0(1:3) = nblenrim(1:3)
656               ENDIF
657               ALLOCATE( dta_bdy(ib_bdy)%frld(ilen0(1)) )
658               ALLOCATE( dta_bdy(ib_bdy)%hicif(ilen0(1)) )
659               ALLOCATE( dta_bdy(ib_bdy)%hsnif(ilen0(1)) )
660            ELSE
661               jfld = jfld + 1
662               dta_bdy(ib_bdy)%frld  => bf(jfld)%fnow(:,1,1)
663               jfld = jfld + 1
664               dta_bdy(ib_bdy)%hicif => bf(jfld)%fnow(:,1,1)
665               jfld = jfld + 1
666               dta_bdy(ib_bdy)%hsnif => bf(jfld)%fnow(:,1,1)
667            ENDIF
668         ENDIF
669#endif
670
671      ENDDO ! ib_bdy
672
673      END SUBROUTINE bdy_dta_init
674
675#else
676   !!----------------------------------------------------------------------
677   !!   Dummy module                   NO Open Boundary Conditions
678   !!----------------------------------------------------------------------
679CONTAINS
680   SUBROUTINE bdy_dta( kt, jit )              ! Empty routine
681      INTEGER, INTENT( in )           ::   kt   
682      INTEGER, INTENT( in ), OPTIONAL ::   jit   
683      WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt
684   END SUBROUTINE bdy_dta
685   SUBROUTINE bdy_dta_init()                  ! Empty routine
686      WRITE(*,*) 'bdy_dta_init: You should not have seen this print! error?'
687   END SUBROUTINE bdy_dta_init
688#endif
689
690   !!==============================================================================
691END MODULE bdydta
Note: See TracBrowser for help on using the repository browser.