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

source: branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90 @ 3191

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