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.
obcdta.F90 in branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC – NEMO

source: branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90 @ 2831

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

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