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

Last change on this file since 2814 was 2814, checked in by davestorkey, 13 years ago
  1. Implement tidal harmonics forcing (UKMO version) in new structure.
  2. Other bug fixes and updates.
  • Property svn:keywords set to Id
File size: 28.9 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 .and. nn_tides(ib_obc) .ne. 1 ) THEN
209                  jend = jstart + 2
210                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), jit=jit )
211               ENDIF
212               IF( nn_tides(ib_obc) .gt. 0 ) THEN
213                  CALL tide_update( kt=kt, jit=jit, idx=idx_obc(ib_obc), dta=dta_obc(ib_obc), td=tides(ib_obc) )
214               ENDIF
215            ELSE
216               IF( nb_obc_fld(ib_obc) .gt. 0 ) THEN
217                  jend = jstart + nb_obc_fld(ib_obc) - 1
218                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), timeshift=1 )
219               ENDIF
220               IF( nn_tides(ib_obc) .gt. 0 ) THEN
221                  !!! THINK ABOUT kt, jit VALUES !!!
222                  CALL tide_update( kt=kt, jit=0, idx=idx_obc(ib_obc), dta=dta_obc(ib_obc), td=tides(ib_obc) )
223               ENDIF
224            ENDIF
225            jstart = jend+1
226
227            ! If full velocities in boundary data then split into barotropic and baroclinic data
228            ! (Note that we have already made sure that you can't use ln_full_vel = .true. at the same
229            ! time as the dynspg_ts option).
230
231            IF( ln_full_vel_array(ib_obc) ) THEN
232
233               igrd = 2                      ! zonal velocity
234               dta_obc(ib_obc)%u2d(:) = 0.0
235               DO ib = 1, idx_obc(ib_obc)%nblen(igrd)
236                  ii   = idx_obc(ib_obc)%nbi(ib,igrd)
237                  ij   = idx_obc(ib_obc)%nbj(ib,igrd)
238                  DO ik = 1, jpkm1
239                     dta_obc(ib_obc)%u2d(ib) = dta_obc(ib_obc)%u2d(ib) &
240              &                                + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_obc(ib_obc)%u3d(ib,ik)
241                  END DO
242                  dta_obc(ib_obc)%u2d(ib) =  dta_obc(ib_obc)%u2d(ib) * hur(ii,ij)
243                  DO ik = 1, jpkm1
244                     dta_obc(ib_obc)%u3d(ib,ik) = dta_obc(ib_obc)%u3d(ib,ik) - dta_obc(ib_obc)%u2d(ib) 
245                  END DO
246               END DO
247
248               igrd = 3                      ! meridional velocity
249               dta_obc(ib_obc)%v2d(:) = 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)%v2d(ib) = dta_obc(ib_obc)%v2d(ib) &
255              &                                + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_obc(ib_obc)%v3d(ib,ik)
256                  END DO
257                  dta_obc(ib_obc)%v2d(ib) =  dta_obc(ib_obc)%v2d(ib) * hvr(ii,ij)
258                  DO ik = 1, jpkm1
259                     dta_obc(ib_obc)%v3d(ib,ik) = dta_obc(ib_obc)%v3d(ib,ik) - dta_obc(ib_obc)%v2d(ib) 
260                  END DO
261               END DO
262   
263            ENDIF
264
265         END IF ! nn_dtactl(ib_obc) = 1
266      END DO  ! ib_obc
267
268      IF(wrk_not_released(2, 22,23) )    CALL ctl_stop('obc_dta: ERROR: failed to release workspace arrays.')
269
270      END SUBROUTINE obc_dta
271
272
273      SUBROUTINE obc_dta_init
274      !!----------------------------------------------------------------------
275      !!                   ***  SUBROUTINE obc_dta_init  ***
276      !!                   
277      !! ** Purpose :   Initialise arrays for reading of external data
278      !!                for open boundary conditions
279      !!
280      !! ** Method  :   Use fldread.F90
281      !!               
282      !!----------------------------------------------------------------------
283      USE dynspg_oce, ONLY: lk_dynspg_ts
284      !!
285      INTEGER     ::  ib_obc, jfld, jstart, jend, ierror  ! local indices
286      !!
287      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files
288      CHARACTER(len=100), DIMENSION(nb_obc)  ::   cn_dir_array  ! Root directory for location of data files
289      LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data
290                                                                ! =F => baroclinic velocities in 3D boundary data
291      INTEGER                                ::   ilen_global   ! Max length required for global obc dta arrays
292      INTEGER,              DIMENSION(jpbgrd) ::  ilen0         ! size of local arrays
293      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ilen1, ilen3  ! size of 1st and 3rd dimensions of local arrays
294      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   iobc           ! obc set for a particular jfld
295      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   igrid         ! index for grid type (1,2,3 = T,U,V)
296      INTEGER, POINTER, DIMENSION(:)         ::   nblen, nblenrim  ! short cuts
297      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   blf_i         !  array of namelist information structures
298      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !
299      TYPE(FLD_N) ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read
300#if defined key_lim2
301      TYPE(FLD_N) ::   bn_frld, bn_hicif, bn_hsnif      !
302#endif
303      NAMELIST/namobc_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 
304#if defined key_lim2
305      NAMELIST/namobc_dta/ bn_frld, bn_hicif, bn_hsnif
306#endif
307      NAMELIST/namobc_dta/ ln_full_vel
308      !!---------------------------------------------------------------------------
309
310      ! Work out upper bound of how many fields there are to read in and allocate arrays
311      ! ---------------------------------------------------------------------------
312      ALLOCATE( nb_obc_fld(nb_obc) )
313      nb_obc_fld(:) = 0
314      DO ib_obc = 1, nb_obc         
315         IF( nn_dtactl(ib_obc) .eq. 1 ) THEN
316            IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN
317               nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3
318            ENDIF
319            IF( nn_dyn3d(ib_obc) .gt. 0 ) THEN
320               nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2
321            ENDIF
322            IF( nn_tra(ib_obc) .gt. 0 ) THEN
323               nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2
324            ENDIF
325#if defined key_lim2
326            IF( nn_ice_lim2(ib_obc) .gt. 0 ) THEN
327               nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3
328            ENDIF
329#endif               
330         ENDIF
331      ENDDO           
332
333      nb_obc_fld_sum = SUM( nb_obc_fld )
334
335      ALLOCATE( bf(nb_obc_fld_sum), STAT=ierror )
336      IF( ierror > 0 ) THEN   
337         CALL ctl_stop( 'obc_dta: unable to allocate bf structure' )   ;   RETURN 
338      ENDIF
339      ALLOCATE( blf_i(nb_obc_fld_sum), STAT=ierror )
340      IF( ierror > 0 ) THEN   
341         CALL ctl_stop( 'obc_dta: unable to allocate blf_i structure' )   ;   RETURN 
342      ENDIF
343      ALLOCATE( nbmap_ptr(nb_obc_fld_sum), STAT=ierror )
344      IF( ierror > 0 ) THEN   
345         CALL ctl_stop( 'obc_dta: unable to allocate nbmap_ptr structure' )   ;   RETURN 
346      ENDIF
347      ALLOCATE( ilen1(nb_obc_fld_sum), ilen3(nb_obc_fld_sum) ) 
348      ALLOCATE( iobc(nb_obc_fld_sum) ) 
349      ALLOCATE( igrid(nb_obc_fld_sum) ) 
350
351      ! Read namelists
352      ! --------------
353      REWIND(numnam)
354      jfld = 0 
355      DO ib_obc = 1, nb_obc         
356         IF( nn_dtactl(ib_obc) .eq. 1 ) THEN
357            ! set file information
358            cn_dir = './'        ! directory in which the model is executed
359            ln_full_vel = .false.
360            ! ... default values (NB: frequency positive => hours, negative => months)
361            !                    !  file       ! frequency !  variable        ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  !
362            !                    !  name       !  (hours)  !   name           !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     !
363            bn_ssh     = FLD_N(  'obc_ssh'     ,    24     ,  'sossheig'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
364            bn_u2d     = FLD_N(  'obc_vel2d_u' ,    24     ,  'vobtcrtx'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
365            bn_v2d     = FLD_N(  'obc_vel2d_v' ,    24     ,  'vobtcrty'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
366            bn_u3d     = FLD_N(  'obc_vel3d_u' ,    24     ,  'vozocrtx'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
367            bn_v3d     = FLD_N(  'obc_vel3d_v' ,    24     ,  'vomecrty'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
368            bn_tem     = FLD_N(  'obc_tem'     ,    24     ,  'votemper'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
369            bn_sal     = FLD_N(  'obc_sal'     ,    24     ,  'vosaline'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
370#if defined key_lim2
371            bn_frld    = FLD_N(  'obc_frld'    ,    24     ,  'ildsconc'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
372            bn_hicif   = FLD_N(  'obc_hicif'   ,    24     ,  'iicethic'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
373            bn_hsnif   = FLD_N(  'obc_hsnif'   ,    24     ,  'isnothic'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
374#endif
375
376            ! Important NOT to rewind here.
377            READ( numnam, namobc_dta )
378
379            cn_dir_array(ib_obc) = cn_dir
380            ln_full_vel_array(ib_obc) = ln_full_vel
381
382            IF( ln_full_vel_array(ib_obc) .and. lk_dynspg_ts )  THEN
383               CALL ctl_stop( 'obc_dta_init: ERROR, cannot specify full velocities in boundary data',&
384            &                  'with dynspg_ts option' )   ;   RETURN 
385            ENDIF             
386
387            nblen => idx_obc(ib_obc)%nblen
388            nblenrim => idx_obc(ib_obc)%nblenrim
389
390            ! Only read in necessary fields for this set.
391            ! Important that barotropic variables come first.
392            IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN
393
394               IF( nn_dyn2d(ib_obc) .ne. jp_frs .and. nn_tides(ib_obc) .ne. 1) THEN
395                  jfld = jfld + 1
396                  blf_i(jfld) = bn_ssh
397                  iobc(jfld) = ib_obc
398                  igrid(jfld) = 1
399                  ilen1(jfld) = nblenrim(igrid(jfld))
400                  ilen3(jfld) = 1
401               ENDIF
402
403               IF( .not. ln_full_vel_array(ib_obc) .and. nn_tides(ib_obc) .ne. 1 ) THEN
404
405                  jfld = jfld + 1
406                  blf_i(jfld) = bn_u2d
407                  iobc(jfld) = ib_obc
408                  igrid(jfld) = 2
409                  IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN
410                     ilen1(jfld) = nblen(igrid(jfld))
411                  ELSE
412                     ilen1(jfld) = nblenrim(igrid(jfld))
413                  ENDIF
414                  ilen3(jfld) = 1
415
416                  jfld = jfld + 1
417                  blf_i(jfld) = bn_v2d
418                  iobc(jfld) = ib_obc
419                  igrid(jfld) = 3
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               ENDIF
428
429            ENDIF
430
431            ! baroclinic velocities
432            IF( nn_dyn3d(ib_obc) .gt. 0 .or. &
433                  ( ln_full_vel_array(ib_obc) .and. nn_dyn2d(ib_obc) .gt. 0 ) ) THEN
434
435               jfld = jfld + 1
436               blf_i(jfld) = bn_u3d
437               iobc(jfld) = ib_obc
438               igrid(jfld) = 2
439               IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN
440                  ilen1(jfld) = nblen(igrid(jfld))
441               ELSE
442                  ilen1(jfld) = nblenrim(igrid(jfld))
443               ENDIF
444               ilen3(jfld) = jpk
445
446               jfld = jfld + 1
447               blf_i(jfld) = bn_v3d
448               iobc(jfld) = ib_obc
449               igrid(jfld) = 3
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            ENDIF
458
459            ! temperature and salinity
460            IF( nn_tra(ib_obc) .gt. 0 ) THEN
461
462               jfld = jfld + 1
463               blf_i(jfld) = bn_tem
464               iobc(jfld) = ib_obc
465               igrid(jfld) = 1
466               IF( nn_tra(ib_obc) .eq. jp_frs ) THEN
467                  ilen1(jfld) = nblen(igrid(jfld))
468               ELSE
469                  ilen1(jfld) = nblenrim(igrid(jfld))
470               ENDIF
471               ilen3(jfld) = jpk
472
473               jfld = jfld + 1
474               blf_i(jfld) = bn_sal
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            ENDIF
485
486#if defined key_lim2
487            ! sea ice
488            IF( nn_tra(ib_obc) .gt. 0 ) THEN
489
490               jfld = jfld + 1
491               blf_i(jfld) = bn_frld
492               iobc(jfld) = ib_obc
493               igrid(jfld) = 1
494               IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN
495                  ilen1(jfld) = nblen(igrid(jfld))
496               ELSE
497                  ilen1(jfld) = nblenrim(igrid(jfld))
498               ENDIF
499               ilen3(jfld) = 1
500
501               jfld = jfld + 1
502               blf_i(jfld) = bn_hicif
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_hsnif
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            ENDIF
524#endif
525            ! Recalculate field counts
526            !-------------------------
527            nb_obc_fld_sum = 0
528            IF( ib_obc .eq. 1 ) THEN
529               nb_obc_fld(ib_obc) = jfld
530               nb_obc_fld_sum     = jfld             
531            ELSE
532               nb_obc_fld(ib_obc) = jfld - nb_obc_fld_sum
533               nb_obc_fld_sum = nb_obc_fld_sum + nb_obc_fld(ib_obc)
534            ENDIF
535
536         ENDIF ! nn_dtactl .eq. 1
537      ENDDO ! ib_obc
538
539
540      DO jfld = 1, nb_obc_fld_sum
541         ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) )
542         IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) )
543         nbmap_ptr(jfld)%ptr => idx_obc(iobc(jfld))%nbmap(:,igrid(jfld))
544      ENDDO
545
546      ! fill bf with blf_i and control print
547      !-------------------------------------
548      jstart = 1
549      DO ib_obc = 1, nb_obc
550         jend = jstart + nb_obc_fld(ib_obc) - 1
551         CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_obc), 'obc_dta', 'open boundary conditions', 'namobc_dta' )
552         jstart = jend + 1
553      ENDDO
554
555      ! Initialise local boundary data arrays
556      ! nn_dtactl=0 : allocate space - will be filled from initial conditions later
557      ! nn_dtactl=1 : point to "fnow" arrays
558      !-------------------------------------
559
560      jfld = 0
561      DO ib_obc=1, nb_obc
562
563         nblen => idx_obc(ib_obc)%nblen
564         nblenrim => idx_obc(ib_obc)%nblenrim
565
566         IF( nn_dtactl(ib_obc) .eq. 0 ) THEN
567               
568            ! nn_dtactl = 0
569            ! Allocate space
570            !---------------
571            IF (nn_dyn2d(ib_obc) .gt. 0) THEN
572               IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN
573                  ilen0(1:3) = nblen(1:3)
574               ELSE
575                  ilen0(1:3) = nblenrim(1:3)
576               ENDIF
577               ALLOCATE( dta_obc(ib_obc)%ssh(ilen0(1)) )
578               ALLOCATE( dta_obc(ib_obc)%u2d(ilen0(2)) )
579               ALLOCATE( dta_obc(ib_obc)%v2d(ilen0(3)) )
580            ENDIF
581            IF (nn_dyn3d(ib_obc) .gt. 0) THEN
582               IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN
583                  ilen0(1:3) = nblen(1:3)
584               ELSE
585                  ilen0(1:3) = nblenrim(1:3)
586               ENDIF
587               ALLOCATE( dta_obc(ib_obc)%u3d(ilen0(2),jpk) )
588               ALLOCATE( dta_obc(ib_obc)%v3d(ilen0(3),jpk) )
589            ENDIF
590            IF (nn_tra(ib_obc) .gt. 0) THEN
591               IF( nn_tra(ib_obc) .eq. jp_frs ) THEN
592                  ilen0(1:3) = nblen(1:3)
593               ELSE
594                  ilen0(1:3) = nblenrim(1:3)
595               ENDIF
596               ALLOCATE( dta_obc(ib_obc)%tem(ilen0(1),jpk) )
597               ALLOCATE( dta_obc(ib_obc)%sal(ilen0(1),jpk) )
598            ENDIF
599#if defined key_lim2
600            IF (nn_ice_lim2(ib_obc) .gt. 0) THEN
601               IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN
602                  ilen0(1:3) = nblen(1:3)
603               ELSE
604                  ilen0(1:3) = nblenrim(1:3)
605               ENDIF
606               ALLOCATE( dta_obc(ib_obc)%ssh(ilen0(1)) )
607               ALLOCATE( dta_obc(ib_obc)%u2d(ilen0(1)) )
608               ALLOCATE( dta_obc(ib_obc)%v2d(ilen0(1)) )
609            ENDIF
610#endif
611
612         ELSE
613
614            ! nn_dtactl = 1
615            ! Set boundary data arrays to point to "fnow" arrays
616            !---------------------------------------------------
617            IF (nn_dyn2d(ib_obc) .gt. 0) THEN
618               IF( nn_dyn2d(ib_obc) .ne. jp_frs .and. nn_tides(ib_obc) .ne. 1 ) THEN
619                  jfld = jfld + 1
620                  dta_obc(ib_obc)%ssh => bf(jfld)%fnow(:,1,1)
621               ENDIF
622               IF( ln_full_vel_array(ib_obc) .or. nn_tides(ib_obc) .eq. 1 ) THEN
623                  ! In this case we need space but we aren't reading it
624                  ! directly from the external file.
625                  IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN
626                     ilen0(:) = nblen(:)
627                  ELSE
628                     ilen0(:) = nblenrim(:)
629                  ENDIF
630                  IF( nn_tides(ib_obc) .eq. 1 ) ALLOCATE( dta_obc(ib_obc)%ssh(ilen0(1)) )
631                  ALLOCATE( dta_obc(ib_obc)%u2d(ilen0(2)) )
632                  ALLOCATE( dta_obc(ib_obc)%v2d(ilen0(3)) )
633               ELSE
634                  jfld = jfld + 1
635                  dta_obc(ib_obc)%u2d => bf(jfld)%fnow(:,1,1)
636                  jfld = jfld + 1
637                  dta_obc(ib_obc)%v2d => bf(jfld)%fnow(:,1,1)
638               ENDIF
639            ENDIF
640            IF (nn_dyn3d(ib_obc) .gt. 0 .or. &
641              &  ( ln_full_vel_array(ib_obc) .and. nn_dyn2d(ib_obc) .gt. 0 ) ) THEN
642               jfld = jfld + 1
643               dta_obc(ib_obc)%u3d => bf(jfld)%fnow(:,1,:)
644               jfld = jfld + 1
645               dta_obc(ib_obc)%v3d => bf(jfld)%fnow(:,1,:)
646            ENDIF
647            IF (nn_tra(ib_obc) .gt. 0) THEN
648               jfld = jfld + 1
649               dta_obc(ib_obc)%tem => bf(jfld)%fnow(:,1,:)
650               jfld = jfld + 1
651               dta_obc(ib_obc)%sal => bf(jfld)%fnow(:,1,:)
652            ENDIF
653#if defined key_lim2
654            IF (nn_ice_lim2(ib_obc) .gt. 0) THEN
655               jfld = jfld + 1
656               dta_obc(ib_obc)%frld  => bf(jfld)%fnow(:,1,1)
657               jfld = jfld + 1
658               dta_obc(ib_obc)%hicif => bf(jfld)%fnow(:,1,1)
659               jfld = jfld + 1
660               dta_obc(ib_obc)%hsnif => bf(jfld)%fnow(:,1,1)
661            ENDIF
662#endif
663
664         ENDIF ! nn_dtactl .eq. 0
665
666      ENDDO ! ib_obc
667
668      END SUBROUTINE obc_dta_init
669
670#else
671   !!----------------------------------------------------------------------
672   !!   Dummy module                   NO Open Boundary Conditions
673   !!----------------------------------------------------------------------
674CONTAINS
675   SUBROUTINE obc_dta( kt, jit )              ! Empty routine
676      INTEGER, INTENT( in )           ::   kt   
677      INTEGER, INTENT( in ), OPTIONAL ::   jit   
678      WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt
679   END SUBROUTINE obc_dta
680   SUBROUTINE obc_dta_init()                  ! Empty routine
681      WRITE(*,*) 'obc_dta_init: You should not have seen this print! error?'
682   END SUBROUTINE obc_dta_init
683#endif
684
685   !!==============================================================================
686END MODULE obcdta
Note: See TracBrowser for help on using the repository browser.