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 @ 2865

Last change on this file since 2865 was 2865, checked in by davestorkey, 13 years ago
  1. Updates for dynspg_exp option.
  2. Implement time_offset functionality in obc_dta.
  3. Add option to specify boundaries in the namelist.
  4. Re-activate obc_vol option.
  5. Update to namelist control of tidal harmonics.
  • Property svn:keywords set to Id
File size: 30.2 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, time_offset )
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      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_obc, 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('obc_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_obc = 1, nb_obc
108
109            nblen => idx_obc(ib_obc)%nblen
110            nblenrim => idx_obc(ib_obc)%nblenrim
111
112            IF( nn_dyn2d(ib_obc) .gt. 0 .and. nn_dyn2d_dta(ib_obc) .eq. 0 ) THEN
113               IF( nn_dyn2d(ib_obc) .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_obc(ib_obc)%nbi(ib,igrd)
121                  ij = idx_obc(ib_obc)%nbj(ib,igrd)
122                  dta_obc(ib_obc)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)         
123               END DO
124               igrd = 2
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)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1)         
129               END DO
130               igrd = 3
131               DO ib = 1, ilen1(igrd)
132                  ii = idx_obc(ib_obc)%nbi(ib,igrd)
133                  ij = idx_obc(ib_obc)%nbj(ib,igrd)
134                  dta_obc(ib_obc)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1)         
135               END DO
136            ENDIF
137
138            IF( nn_dyn3d(ib_obc) .gt. 0 .and. nn_dyn3d_dta(ib_obc) .eq. 0 ) THEN
139               IF( nn_dyn3d(ib_obc) .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_obc(ib_obc)%nbi(ib,igrd)
148                     ij = idx_obc(ib_obc)%nbj(ib,igrd)
149                     dta_obc(ib_obc)%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_obc(ib_obc)%nbi(ib,igrd)
156                     ij = idx_obc(ib_obc)%nbj(ib,igrd)
157                     dta_obc(ib_obc)%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_obc) .gt. 0 .and. nn_tra_dta(ib_obc) .eq. 0 ) THEN
163               IF( nn_tra(ib_obc) .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_obc(ib_obc)%nbi(ib,igrd)
172                     ij = idx_obc(ib_obc)%nbj(ib,igrd)
173                     dta_obc(ib_obc)%tem(ib,ik) = tn(ii,ij,ik) * tmask(ii,ij,ik)         
174                     dta_obc(ib_obc)%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_obc) .gt. 0 .and. nn_ice_lim2_dta(ib_obc) .eq. 0 ) THEN
181               IF( nn_ice_lim2(ib_obc) .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_obc(ib_obc)%nbi(ib,igrd)
189                  ij = idx_obc(ib_obc)%nbj(ib,igrd)
190                  dta_obc(ib_obc)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)         
191                  dta_obc(ib_obc)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)         
192                  dta_obc(ib_obc)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)         
193               END DO
194            ENDIF
195#endif
196
197         ENDDO ! ib_obc
198
199      ENDIF ! kt .eq. nit000
200
201      ! update external data from files
202      !--------------------------------
203     
204      jstart = 1
205      DO ib_obc = 1, nb_obc   
206         IF( nn_dta(ib_obc) .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_obc) .gt. 0 ) THEN
212                  IF( nn_dyn2d_dta(ib_obc) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
213                     dta_obc(ib_obc)%ssh(:) = 0.0
214                     dta_obc(ib_obc)%u2d(:) = 0.0
215                     dta_obc(ib_obc)%v2d(:) = 0.0
216                  ENDIF
217                  IF( nn_dyn2d_dta(ib_obc) .eq. 1 .or. nn_dyn2d_dta(ib_obc) .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_obc) .ge. 2 ) THEN ! update tidal harmonic forcing
222                     CALL tide_update( kt=kt, idx=idx_obc(ib_obc), dta=dta_obc(ib_obc), td=tides(ib_obc), jit=jit, time_offset=time_offset )
223                  ENDIF
224               ENDIF
225            ELSE
226               IF( nn_dyn2d(ib_obc) .gt. 0 .and. nn_dyn2d_dta(ib_obc) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
227                  dta_obc(ib_obc)%ssh(:) = 0.0
228                  dta_obc(ib_obc)%u2d(:) = 0.0
229                  dta_obc(ib_obc)%v2d(:) = 0.0
230               ENDIF
231               IF( nb_obc_fld(ib_obc) .gt. 0 ) THEN ! update external data
232                  jend = jstart + nb_obc_fld(ib_obc) - 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_obc) .gt. 0 .and. nn_dyn2d_dta(ib_obc) .ge. 2 ) THEN ! update tidal harmonic forcing
236                  CALL tide_update( kt=kt, idx=idx_obc(ib_obc), dta=dta_obc(ib_obc), td=tides(ib_obc), 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_obc) .and.                                             & 
246           &    ( nn_dyn2d_dta(ib_obc) .eq. 1 .or. nn_dyn2d_dta(ib_obc) .eq. 3 .or. nn_dyn3d_dta(ib_obc) .eq. 1 ) ) THEN
247
248               igrd = 2                      ! zonal velocity
249               dta_obc(ib_obc)%u2d(:) = 0.0
250               DO ib = 1, idx_obc(ib_obc)%nblen(igrd)
251                  ii   = idx_obc(ib_obc)%nbi(ib,igrd)
252                  ij   = idx_obc(ib_obc)%nbj(ib,igrd)
253                  DO ik = 1, jpkm1
254                     dta_obc(ib_obc)%u2d(ib) = dta_obc(ib_obc)%u2d(ib) &
255              &                                + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_obc(ib_obc)%u3d(ib,ik)
256                  END DO
257                  dta_obc(ib_obc)%u2d(ib) =  dta_obc(ib_obc)%u2d(ib) * hur(ii,ij)
258                  DO ik = 1, jpkm1
259                     dta_obc(ib_obc)%u3d(ib,ik) = dta_obc(ib_obc)%u3d(ib,ik) - dta_obc(ib_obc)%u2d(ib) 
260                  END DO
261               END DO
262
263               igrd = 3                      ! meridional velocity
264               dta_obc(ib_obc)%v2d(:) = 0.0
265               DO ib = 1, idx_obc(ib_obc)%nblen(igrd)
266                  ii   = idx_obc(ib_obc)%nbi(ib,igrd)
267                  ij   = idx_obc(ib_obc)%nbj(ib,igrd)
268                  DO ik = 1, jpkm1
269                     dta_obc(ib_obc)%v2d(ib) = dta_obc(ib_obc)%v2d(ib) &
270              &                                + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_obc(ib_obc)%v3d(ib,ik)
271                  END DO
272                  dta_obc(ib_obc)%v2d(ib) =  dta_obc(ib_obc)%v2d(ib) * hvr(ii,ij)
273                  DO ik = 1, jpkm1
274                     dta_obc(ib_obc)%v3d(ib,ik) = dta_obc(ib_obc)%v3d(ib,ik) - dta_obc(ib_obc)%v2d(ib) 
275                  END DO
276               END DO
277   
278            ENDIF
279
280         END IF ! nn_dta(ib_obc) = 1
281      END DO  ! ib_obc
282
283      IF(wrk_not_released(2, 22,23) )    CALL ctl_stop('obc_dta: ERROR: failed to release workspace arrays.')
284
285      END SUBROUTINE obc_dta
286
287
288      SUBROUTINE obc_dta_init
289      !!----------------------------------------------------------------------
290      !!                   ***  SUBROUTINE obc_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_obc, 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_obc)  ::   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 obc 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(:)     ::   iobc           ! obc 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/namobc_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 
319#if defined key_lim2
320      NAMELIST/namobc_dta/ bn_frld, bn_hicif, bn_hsnif
321#endif
322      NAMELIST/namobc_dta/ ln_full_vel
323      !!---------------------------------------------------------------------------
324
325      ! Set nn_dta
326      DO ib_obc = 1, nb_obc
327         nn_dta(ib_obc) = MAX(  nn_dyn2d_dta(ib_obc)       &
328                               ,nn_dyn3d_dta(ib_obc)       &
329                               ,nn_tra_dta(ib_obc)         &
330#if defined key_ice_lim2
331                               ,nn_ice_lim2_dta(ib_obc)    &
332#endif
333                              )
334         IF(nn_dta(ib_obc) .gt. 1) nn_dta(ib_obc) = 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_obc_fld(nb_obc) )
340      nb_obc_fld(:) = 0
341      DO ib_obc = 1, nb_obc         
342         IF( nn_dyn2d(ib_obc) .gt. 0 .and. ( nn_dyn2d_dta(ib_obc) .eq. 1 .or. nn_dyn2d_dta(ib_obc) .eq. 3 ) ) THEN
343            nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3
344         ENDIF
345         IF( nn_dyn3d(ib_obc) .gt. 0 .and. nn_dyn3d_dta(ib_obc) .eq. 1 ) THEN
346            nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2
347         ENDIF
348         IF( nn_tra(ib_obc) .gt. 0 .and. nn_tra_dta(ib_obc) .eq. 1  ) THEN
349            nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2
350         ENDIF
351#if defined key_lim2
352         IF( nn_ice_lim2(ib_obc) .gt. 0 .and. nn_ice_lim2_dta(ib_obc) .eq. 1  ) THEN
353            nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3
354         ENDIF
355#endif               
356      ENDDO           
357
358      nb_obc_fld_sum = SUM( nb_obc_fld )
359
360      ALLOCATE( bf(nb_obc_fld_sum), STAT=ierror )
361      IF( ierror > 0 ) THEN   
362         CALL ctl_stop( 'obc_dta: unable to allocate bf structure' )   ;   RETURN 
363      ENDIF
364      ALLOCATE( blf_i(nb_obc_fld_sum), STAT=ierror )
365      IF( ierror > 0 ) THEN   
366         CALL ctl_stop( 'obc_dta: unable to allocate blf_i structure' )   ;   RETURN 
367      ENDIF
368      ALLOCATE( nbmap_ptr(nb_obc_fld_sum), STAT=ierror )
369      IF( ierror > 0 ) THEN   
370         CALL ctl_stop( 'obc_dta: unable to allocate nbmap_ptr structure' )   ;   RETURN 
371      ENDIF
372      ALLOCATE( ilen1(nb_obc_fld_sum), ilen3(nb_obc_fld_sum) ) 
373      ALLOCATE( iobc(nb_obc_fld_sum) ) 
374      ALLOCATE( igrid(nb_obc_fld_sum) ) 
375
376      ! Read namelists
377      ! --------------
378      REWIND(numnam)
379      jfld = 0 
380      DO ib_obc = 1, nb_obc         
381         IF( nn_dta(ib_obc) .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(  'obc_ssh'     ,    24     ,  'sossheig'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
389            bn_u2d     = FLD_N(  'obc_vel2d_u' ,    24     ,  'vobtcrtx'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
390            bn_v2d     = FLD_N(  'obc_vel2d_v' ,    24     ,  'vobtcrty'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
391            bn_u3d     = FLD_N(  'obc_vel3d_u' ,    24     ,  'vozocrtx'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
392            bn_v3d     = FLD_N(  'obc_vel3d_v' ,    24     ,  'vomecrty'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
393            bn_tem     = FLD_N(  'obc_tem'     ,    24     ,  'votemper'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
394            bn_sal     = FLD_N(  'obc_sal'     ,    24     ,  'vosaline'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
395#if defined key_lim2
396            bn_frld    = FLD_N(  'obc_frld'    ,    24     ,  'ildsconc'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
397            bn_hicif   = FLD_N(  'obc_hicif'   ,    24     ,  'iicethic'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
398            bn_hsnif   = FLD_N(  'obc_hsnif'   ,    24     ,  'isnothic'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
399#endif
400
401            ! Important NOT to rewind here.
402            READ( numnam, namobc_dta )
403
404            cn_dir_array(ib_obc) = cn_dir
405            ln_full_vel_array(ib_obc) = ln_full_vel
406
407            IF( ln_full_vel_array(ib_obc) .and. lk_dynspg_ts )  THEN
408               CALL ctl_stop( 'obc_dta_init: ERROR, cannot specify full velocities in boundary data',&
409            &                  'with dynspg_ts option' )   ;   RETURN 
410            ENDIF             
411
412            nblen => idx_obc(ib_obc)%nblen
413            nblenrim => idx_obc(ib_obc)%nblenrim
414
415            ! Only read in necessary fields for this set.
416            ! Important that barotropic variables come first.
417            IF( nn_dyn2d(ib_obc) .gt. 0 .and. ( nn_dyn2d_dta(ib_obc) .eq. 1 .or. nn_dyn2d_dta(ib_obc) .eq. 3 ) ) THEN
418
419               IF( nn_dyn2d(ib_obc) .ne. jp_frs ) THEN
420                  jfld = jfld + 1
421                  blf_i(jfld) = bn_ssh
422                  iobc(jfld) = ib_obc
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_obc) ) THEN
429
430                  jfld = jfld + 1
431                  blf_i(jfld) = bn_u2d
432                  iobc(jfld) = ib_obc
433                  igrid(jfld) = 2
434                  IF( nn_dyn2d(ib_obc) .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                  iobc(jfld) = ib_obc
444                  igrid(jfld) = 3
445                  IF( nn_dyn2d(ib_obc) .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_obc) .gt. 0 .and. nn_dyn3d_dta(ib_obc) .eq. 1 ) .or. &
458           &      ( ln_full_vel_array(ib_obc) .and. nn_dyn2d(ib_obc) .gt. 0 .and.  &
459           &        ( nn_dyn2d_dta(ib_obc) .eq. 1 .or. nn_dyn2d_dta(ib_obc) .eq. 3 ) ) ) THEN
460
461               jfld = jfld + 1
462               blf_i(jfld) = bn_u3d
463               iobc(jfld) = ib_obc
464               igrid(jfld) = 2
465               IF( nn_dyn3d(ib_obc) .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               iobc(jfld) = ib_obc
475               igrid(jfld) = 3
476               IF( nn_dyn3d(ib_obc) .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_obc) .gt. 0 .and. nn_tra_dta(ib_obc) .eq. 1 ) THEN
487
488               jfld = jfld + 1
489               blf_i(jfld) = bn_tem
490               iobc(jfld) = ib_obc
491               igrid(jfld) = 1
492               IF( nn_tra(ib_obc) .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               iobc(jfld) = ib_obc
502               igrid(jfld) = 1
503               IF( nn_tra(ib_obc) .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_obc) .gt. 0 .and. nn_ice_lim2_dta(ib_obc) .eq. 1 ) THEN
515
516               jfld = jfld + 1
517               blf_i(jfld) = bn_frld
518               iobc(jfld) = ib_obc
519               igrid(jfld) = 1
520               IF( nn_ice_lim2(ib_obc) .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               iobc(jfld) = ib_obc
530               igrid(jfld) = 1
531               IF( nn_ice_lim2(ib_obc) .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               iobc(jfld) = ib_obc
541               igrid(jfld) = 1
542               IF( nn_ice_lim2(ib_obc) .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_obc_fld_sum = 0
554            IF( ib_obc .eq. 1 ) THEN
555               nb_obc_fld(ib_obc) = jfld
556               nb_obc_fld_sum     = jfld             
557            ELSE
558               nb_obc_fld(ib_obc) = jfld - nb_obc_fld_sum
559               nb_obc_fld_sum = nb_obc_fld_sum + nb_obc_fld(ib_obc)
560            ENDIF
561
562         ENDIF ! nn_dta .eq. 1
563      ENDDO ! ib_obc
564
565
566      DO jfld = 1, nb_obc_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_obc(iobc(jfld))%nbmap(:,igrid(jfld))
570      ENDDO
571
572      ! fill bf with blf_i and control print
573      !-------------------------------------
574      jstart = 1
575      DO ib_obc = 1, nb_obc
576         jend = jstart + nb_obc_fld(ib_obc) - 1
577         CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_obc), 'obc_dta', 'open boundary conditions', 'namobc_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_obc=1, nb_obc
588
589         nblen => idx_obc(ib_obc)%nblen
590         nblenrim => idx_obc(ib_obc)%nblenrim
591
592         IF (nn_dyn2d(ib_obc) .gt. 0) THEN
593            IF( nn_dyn2d_dta(ib_obc) .eq. 0 .or. nn_dyn2d_dta(ib_obc) .eq. 2 .or. ln_full_vel_array(ib_obc) ) THEN
594               IF( nn_dyn2d(ib_obc) .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_obc(ib_obc)%ssh(ilen0(1)) )
600               ALLOCATE( dta_obc(ib_obc)%u2d(ilen0(2)) )
601               ALLOCATE( dta_obc(ib_obc)%v2d(ilen0(3)) )
602            ELSE
603               IF( nn_dyn2d(ib_obc) .ne. jp_frs ) THEN
604                  jfld = jfld + 1
605                  dta_obc(ib_obc)%ssh => bf(jfld)%fnow(:,1,1)
606               ENDIF
607               jfld = jfld + 1
608               dta_obc(ib_obc)%u2d => bf(jfld)%fnow(:,1,1)
609               jfld = jfld + 1
610               dta_obc(ib_obc)%v2d => bf(jfld)%fnow(:,1,1)
611            ENDIF
612         ENDIF
613
614         IF ( nn_dyn3d(ib_obc) .gt. 0 .and. nn_dyn3d_dta(ib_obc) .eq. 0 ) THEN
615            IF( nn_dyn3d(ib_obc) .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_obc(ib_obc)%u3d(ilen0(2),jpk) )
621            ALLOCATE( dta_obc(ib_obc)%v3d(ilen0(3),jpk) )
622         ENDIF
623         IF ( ( nn_dyn3d(ib_obc) .gt. 0 .and. nn_dyn3d_dta(ib_obc) .eq. 1 ).or. &
624           &  ( ln_full_vel_array(ib_obc) .and. nn_dyn2d(ib_obc) .gt. 0 .and.   &
625           &    ( nn_dyn2d_dta(ib_obc) .eq. 1 .or. nn_dyn2d_dta(ib_obc) .eq. 3 ) ) ) THEN
626            jfld = jfld + 1
627            dta_obc(ib_obc)%u3d => bf(jfld)%fnow(:,1,:)
628            jfld = jfld + 1
629            dta_obc(ib_obc)%v3d => bf(jfld)%fnow(:,1,:)
630         ENDIF
631
632         IF (nn_tra(ib_obc) .gt. 0) THEN
633            IF( nn_tra_dta(ib_obc) .eq. 0 ) THEN
634               IF( nn_tra(ib_obc) .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_obc(ib_obc)%tem(ilen0(1),jpk) )
640               ALLOCATE( dta_obc(ib_obc)%sal(ilen0(1),jpk) )
641            ELSE
642               jfld = jfld + 1
643               dta_obc(ib_obc)%tem => bf(jfld)%fnow(:,1,:)
644               jfld = jfld + 1
645               dta_obc(ib_obc)%sal => bf(jfld)%fnow(:,1,:)
646            ENDIF
647         ENDIF
648
649#if defined key_lim2
650         IF (nn_ice_lim2(ib_obc) .gt. 0) THEN
651            IF( nn_ice_lim2_dta(ib_obc) .eq. 0 ) THEN
652               IF( nn_ice_lim2(ib_obc) .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_obc(ib_obc)%frld(ilen0(1)) )
658               ALLOCATE( dta_obc(ib_obc)%hicif(ilen0(1)) )
659               ALLOCATE( dta_obc(ib_obc)%hsnif(ilen0(1)) )
660            ELSE
661               jfld = jfld + 1
662               dta_obc(ib_obc)%frld  => bf(jfld)%fnow(:,1,1)
663               jfld = jfld + 1
664               dta_obc(ib_obc)%hicif => bf(jfld)%fnow(:,1,1)
665               jfld = jfld + 1
666               dta_obc(ib_obc)%hsnif => bf(jfld)%fnow(:,1,1)
667            ENDIF
668         ENDIF
669#endif
670
671      ENDDO ! ib_obc
672
673      END SUBROUTINE obc_dta_init
674
675#else
676   !!----------------------------------------------------------------------
677   !!   Dummy module                   NO Open Boundary Conditions
678   !!----------------------------------------------------------------------
679CONTAINS
680   SUBROUTINE obc_dta( kt, jit )              ! Empty routine
681      INTEGER, INTENT( in )           ::   kt   
682      INTEGER, INTENT( in ), OPTIONAL ::   jit   
683      WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt
684   END SUBROUTINE obc_dta
685   SUBROUTINE obc_dta_init()                  ! Empty routine
686      WRITE(*,*) 'obc_dta_init: You should not have seen this print! error?'
687   END SUBROUTINE obc_dta_init
688#endif
689
690   !!==============================================================================
691END MODULE obcdta
Note: See TracBrowser for help on using the repository browser.