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

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

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