New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
bdydta.F90 in NEMO/trunk/src/OCE/BDY – NEMO

source: NEMO/trunk/src/OCE/BDY/bdydta.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 2 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 39.8 KB
Line 
1MODULE bdydta
2   !!======================================================================
3   !!                       ***  MODULE bdydta  ***
4   !! Open boundary data : read the data for the unstructured open boundaries.
5   !!======================================================================
6   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
7   !!             -   !  2007-01  (D. Storkey) Update to use IOM module
8   !!             -   !  2007-07  (D. Storkey) add bdy_dta_fla
9   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
10   !!            3.3  !  2010-09  (E.O'Dea) modifications for Shelf configurations
11   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
12   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
13   !!            3.6  !  2012-01  (C. Rousset) add ice boundary conditions for sea ice
14   !!            4.0  !  2018     (C. Rousset) SI3 compatibility
15   !!----------------------------------------------------------------------
16
17   !!----------------------------------------------------------------------
18   !!    bdy_dta      : read external data along open boundaries from file
19   !!    bdy_dta_init : initialise arrays etc for reading of external data
20   !!----------------------------------------------------------------------
21   USE oce            ! ocean dynamics and tracers
22   USE dom_oce        ! ocean space and time domain
23   USE phycst         ! physical constants
24   USE sbcapr         ! atmospheric pressure forcing
25   USE tide_mod, ONLY: ln_tide ! tidal forcing
26   USE bdy_oce        ! ocean open boundary conditions 
27   USE bdytides       ! tidal forcing at boundaries
28#if defined key_si3
29   USE ice            ! sea-ice variables
30   USE icevar         ! redistribute ice input into categories
31#endif
32   !
33   USE lib_mpp, ONLY: ctl_stop, ctl_nam
34   USE fldread        ! read input fields
35   USE iom            ! IOM library
36   USE in_out_manager ! I/O logical units
37   USE timing         ! Timing
38
39   IMPLICIT NONE
40   PRIVATE
41
42   PUBLIC   bdy_dta          ! routine called by step.F90 and dynspg_ts.F90
43   PUBLIC   bdy_dta_init     ! routine called by nemogcm.F90
44
45   INTEGER , PARAMETER ::   jpbdyfld  = 16    ! maximum number of files to read
46   INTEGER , PARAMETER ::   jp_bdyssh = 1     !
47   INTEGER , PARAMETER ::   jp_bdyu2d = 2     !
48   INTEGER , PARAMETER ::   jp_bdyv2d = 3     !
49   INTEGER , PARAMETER ::   jp_bdyu3d = 4     !
50   INTEGER , PARAMETER ::   jp_bdyv3d = 5     !
51   INTEGER , PARAMETER ::   jp_bdytem = 6     !
52   INTEGER , PARAMETER ::   jp_bdysal = 7     !
53   INTEGER , PARAMETER ::   jp_bdya_i = 8     !
54   INTEGER , PARAMETER ::   jp_bdyh_i = 9     !
55   INTEGER , PARAMETER ::   jp_bdyh_s = 10    !
56   INTEGER , PARAMETER ::   jp_bdyt_i = 11    !
57   INTEGER , PARAMETER ::   jp_bdyt_s = 12    !
58   INTEGER , PARAMETER ::   jp_bdytsu = 13    !
59   INTEGER , PARAMETER ::   jp_bdys_i = 14    !
60   INTEGER , PARAMETER ::   jp_bdyaip = 15    !
61   INTEGER , PARAMETER ::   jp_bdyhip = 16    !
62#if ! defined key_si3
63   INTEGER , PARAMETER ::   jpl = 1
64#endif
65
66!$AGRIF_DO_NOT_TREAT
67   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::   bf   ! structure of input fields (file informations, fields read)
68!$AGRIF_END_DO_NOT_TREAT
69
70   !! * Substitutions
71#  include "do_loop_substitute.h90"
72   !!----------------------------------------------------------------------
73   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
74   !! $Id$
75   !! Software governed by the CeCILL license (see ./LICENSE)
76   !!----------------------------------------------------------------------
77CONTAINS
78
79   SUBROUTINE bdy_dta( kt, Kmm )
80      !!----------------------------------------------------------------------
81      !!                   ***  SUBROUTINE bdy_dta  ***
82      !!                   
83      !! ** Purpose :   Update external data for open boundary conditions
84      !!
85      !! ** Method  :   Use fldread.F90
86      !!               
87      !!----------------------------------------------------------------------
88      INTEGER, INTENT(in)           ::   kt           ! ocean time-step index
89      INTEGER, INTENT(in)           ::   Kmm          ! ocean time level index
90      !
91      INTEGER ::  jbdy, jfld, jstart, jend, ib, jl    ! dummy loop indices
92      INTEGER ::  ii, ij, ik, igrd, ipl               ! local integers
93      INTEGER,   DIMENSION(jpbgrd)     ::   ilen1 
94      INTEGER,   DIMENSION(:), POINTER ::   nblen, nblenrim  ! short cuts
95      TYPE(OBC_DATA)         , POINTER ::   dta_alias        ! short cut
96      TYPE(FLD), DIMENSION(:), POINTER ::   bf_alias
97      !!---------------------------------------------------------------------------
98      !
99      IF( ln_timing )   CALL timing_start('bdy_dta')
100      !
101      ! Initialise data arrays once for all from initial conditions where required
102      !---------------------------------------------------------------------------
103      IF( kt == nit000 ) THEN
104
105         ! Calculate depth-mean currents
106         !-----------------------------
107
108         DO jbdy = 1, nb_bdy
109            !
110            nblen    => idx_bdy(jbdy)%nblen
111            nblenrim => idx_bdy(jbdy)%nblenrim
112            !
113            IF( nn_dyn2d_dta(jbdy) == 0 ) THEN
114               ilen1(:) = nblen(:)
115               IF( dta_bdy(jbdy)%lneed_ssh ) THEN
116                  igrd = 1
117                  DO ib = 1, ilen1(igrd)
118                     ii = idx_bdy(jbdy)%nbi(ib,igrd)
119                     ij = idx_bdy(jbdy)%nbj(ib,igrd)
120                     dta_bdy(jbdy)%ssh(ib) = ssh(ii,ij,Kmm) * tmask(ii,ij,1)         
121                  END DO
122               ENDIF
123               IF( dta_bdy(jbdy)%lneed_dyn2d) THEN
124                  igrd = 2
125                  DO ib = 1, ilen1(igrd)
126                     ii = idx_bdy(jbdy)%nbi(ib,igrd)
127                     ij = idx_bdy(jbdy)%nbj(ib,igrd)
128                     dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1)         
129                  END DO
130                  igrd = 3
131                  DO ib = 1, ilen1(igrd)
132                     ii = idx_bdy(jbdy)%nbi(ib,igrd)
133                     ij = idx_bdy(jbdy)%nbj(ib,igrd)
134                     dta_bdy(jbdy)%v2d(ib) = vv_b(ii,ij,Kmm) * vmask(ii,ij,1)         
135                  END DO
136               ENDIF
137            ENDIF
138            !
139            IF( nn_dyn3d_dta(jbdy) == 0 ) THEN
140               ilen1(:) = nblen(:)
141               IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN
142                  igrd = 2 
143                  DO ib = 1, ilen1(igrd)
144                     DO ik = 1, jpkm1
145                        ii = idx_bdy(jbdy)%nbi(ib,igrd)
146                        ij = idx_bdy(jbdy)%nbj(ib,igrd)
147                        dta_bdy(jbdy)%u3d(ib,ik) =  ( uu(ii,ij,ik,Kmm) - uu_b(ii,ij,Kmm) ) * umask(ii,ij,ik)         
148                     END DO
149                  END DO
150                  igrd = 3 
151                  DO ib = 1, ilen1(igrd)
152                     DO ik = 1, jpkm1
153                        ii = idx_bdy(jbdy)%nbi(ib,igrd)
154                        ij = idx_bdy(jbdy)%nbj(ib,igrd)
155                        dta_bdy(jbdy)%v3d(ib,ik) =  ( vv(ii,ij,ik,Kmm) - vv_b(ii,ij,Kmm) ) * vmask(ii,ij,ik)         
156                     END DO
157                  END DO
158               ENDIF
159            ENDIF
160
161            IF( nn_tra_dta(jbdy) == 0 ) THEN
162               ilen1(:) = nblen(:)
163               IF( dta_bdy(jbdy)%lneed_tra ) THEN
164                  igrd = 1 
165                  DO ib = 1, ilen1(igrd)
166                     DO ik = 1, jpkm1
167                        ii = idx_bdy(jbdy)%nbi(ib,igrd)
168                        ij = idx_bdy(jbdy)%nbj(ib,igrd)
169                        dta_bdy(jbdy)%tem(ib,ik) = ts(ii,ij,ik,jp_tem,Kmm) * tmask(ii,ij,ik)         
170                        dta_bdy(jbdy)%sal(ib,ik) = ts(ii,ij,ik,jp_sal,Kmm) * tmask(ii,ij,ik)         
171                     END DO
172                  END DO
173               ENDIF
174            ENDIF
175
176#if defined key_si3
177            IF( nn_ice_dta(jbdy) == 0 ) THEN    ! set ice to initial values
178               ilen1(:) = nblen(:)
179               IF( dta_bdy(jbdy)%lneed_ice ) THEN
180                  igrd = 1   
181                  DO jl = 1, jpl
182                     DO ib = 1, ilen1(igrd)
183                        ii = idx_bdy(jbdy)%nbi(ib,igrd)
184                        ij = idx_bdy(jbdy)%nbj(ib,igrd)
185                        dta_bdy(jbdy)%a_i(ib,jl) =  a_i (ii,ij,jl) * tmask(ii,ij,1) 
186                        dta_bdy(jbdy)%h_i(ib,jl) =  h_i (ii,ij,jl) * tmask(ii,ij,1) 
187                        dta_bdy(jbdy)%h_s(ib,jl) =  h_s (ii,ij,jl) * tmask(ii,ij,1) 
188                        dta_bdy(jbdy)%t_i(ib,jl) =  SUM(t_i (ii,ij,:,jl)) * r1_nlay_i * tmask(ii,ij,1) 
189                        dta_bdy(jbdy)%t_s(ib,jl) =  SUM(t_s (ii,ij,:,jl)) * r1_nlay_s * tmask(ii,ij,1)
190                        dta_bdy(jbdy)%tsu(ib,jl) =  t_su(ii,ij,jl) * tmask(ii,ij,1) 
191                        dta_bdy(jbdy)%s_i(ib,jl) =  s_i (ii,ij,jl) * tmask(ii,ij,1)
192                        ! melt ponds
193                        dta_bdy(jbdy)%aip(ib,jl) =  a_ip(ii,ij,jl) * tmask(ii,ij,1) 
194                        dta_bdy(jbdy)%hip(ib,jl) =  h_ip(ii,ij,jl) * tmask(ii,ij,1) 
195                     END DO
196                  END DO
197               ENDIF
198            ENDIF
199#endif
200         END DO ! jbdy
201         !
202      ENDIF ! kt == nit000
203
204      ! update external data from files
205      !--------------------------------
206
207      DO jbdy = 1, nb_bdy
208
209         dta_alias => dta_bdy(jbdy)
210         bf_alias  => bf(:,jbdy)
211
212         ! read/update all bdy data
213         ! ------------------------
214         ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step
215         CALL fld_read( kt, 1, bf_alias, pt_offset = 0.5_wp, Kmm = Kmm )
216         ! apply some corrections in some specific cases...
217         ! --------------------------------------------------
218         !
219         ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s)
220         IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN   ! runoff and we read u/v2d
221            !
222            igrd = 2                      ! zonal flow (m3/s) to barotropic zonal velocity (m/s)
223            DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
224               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
225               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
226               dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )
227            END DO
228            igrd = 3                      ! meridional flow (m3/s) to barotropic meridional velocity (m/s)
229            DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
230               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
231               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
232               dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )
233            END DO
234         ENDIF
235
236         ! tidal harmonic forcing ONLY: initialise arrays
237         IF( nn_dyn2d_dta(jbdy) == 2 ) THEN   ! we did not read ssh, u/v2d
238            IF( dta_alias%lneed_ssh   ) dta_alias%ssh(:) = 0._wp
239            IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp
240            IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp
241         ENDIF
242
243         ! If full velocities in boundary data, then split it into barotropic and baroclinic component
244         IF( bf_alias(jp_bdyu3d)%ltotvel ) THEN     ! if we read 3D total velocity (can be true only if u3d was read)
245            !
246            igrd = 2                       ! zonal velocity
247            dta_alias%u2d(:) = 0._wp       ! compute barotrope zonal velocity and put it in u2d
248            DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
249               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
250               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
251               DO ik = 1, jpkm1
252                  dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik)
253               END DO
254               dta_alias%u2d(ib) =  dta_alias%u2d(ib) * r1_hu(ii,ij,Kmm)
255               DO ik = 1, jpkm1            ! compute barocline zonal velocity and put it in u3d
256                  dta_alias%u3d(ib,ik) = dta_alias%u3d(ib,ik) - dta_alias%u2d(ib)
257               END DO
258            END DO
259            igrd = 3                       ! meridional velocity
260            dta_alias%v2d(:) = 0._wp       ! compute barotrope meridional velocity and put it in v2d
261            DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
262               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
263               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
264               DO ik = 1, jpkm1
265                  dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik)
266               END DO
267               dta_alias%v2d(ib) =  dta_alias%v2d(ib) * r1_hv(ii,ij,Kmm)
268               DO ik = 1, jpkm1            ! compute barocline meridional velocity and put it in v3d
269                  dta_alias%v3d(ib,ik) = dta_alias%v3d(ib,ik) - dta_alias%v2d(ib)
270               END DO
271            END DO
272         ENDIF   ! ltotvel
273
274         !  atm surface pressure : add inverted barometer effect to ssh if it was read
275         IF ( ln_apr_obc .AND. TRIM(bf_alias(jp_bdyssh)%clrootname) /= 'NOT USED' ) THEN
276            igrd = 1
277            DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd)   ! ssh is used only on the rim
278               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
279               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
280               dta_alias%ssh(ib) = dta_alias%ssh(ib) + ssh_ib(ii,ij)
281            END DO
282         ENDIF
283
284#if defined key_si3
285         IF( dta_alias%lneed_ice ) THEN
286            ! fill temperature and salinity arrays
287            IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy)
288            IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyt_s)%fnow(:,1,:) = rice_tem (jbdy)
289            IF( TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' )   bf_alias(jp_bdytsu)%fnow(:,1,:) = rice_tem (jbdy)
290            IF( TRIM(bf_alias(jp_bdys_i)%clrootname) == 'NOT USED' )   bf_alias(jp_bdys_i)%fnow(:,1,:) = rice_sal (jbdy)
291            IF( TRIM(bf_alias(jp_bdyaip)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyaip)%fnow(:,1,:) = rice_apnd(jbdy) * & ! rice_apnd is the pond fraction
292               &                                                                         bf_alias(jp_bdya_i)%fnow(:,1,:)     !   ( a_ip = rice_apnd * a_i )
293            IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy)
294            ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2
295            IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) &
296               &   bf_alias(jp_bdyt_i)%fnow(:,1,:) = 0.5_wp * ( bf_alias(jp_bdytsu)%fnow(:,1,:) + 271.15 )
297            ! if T_su is read and not T_s, set T_s = T_su
298            IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) &
299               &   bf_alias(jp_bdyt_s)%fnow(:,1,:) = bf_alias(jp_bdytsu)%fnow(:,1,:)
300            ! if T_s is read and not T_su, set T_su = T_s
301            IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) &
302               &   bf_alias(jp_bdytsu)%fnow(:,1,:) = bf_alias(jp_bdyt_s)%fnow(:,1,:)
303            ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2
304            IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) &
305               &   bf_alias(jp_bdyt_i)%fnow(:,1,:) = 0.5_wp * ( bf_alias(jp_bdyt_s)%fnow(:,1,:) + 271.15 )
306
307            ! make sure ponds = 0 if no ponds scheme
308            IF ( .NOT.ln_pnd ) THEN
309               bf_alias(jp_bdyaip)%fnow(:,1,:) = 0._wp
310               bf_alias(jp_bdyhip)%fnow(:,1,:) = 0._wp
311            ENDIF
312           
313            ! convert N-cat fields (input) into jpl-cat (output)
314            ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3)           
315            IF( ipl /= jpl ) THEN      ! ice: convert N-cat fields (input) into jpl-cat (output)
316               CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), &
317                  &              dta_alias%h_i                  , dta_alias%h_s                  , dta_alias%a_i                  , &
318                  &              bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), &
319                  &              bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), &
320                  &              bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), &
321                  &              dta_alias%t_i                  , dta_alias%t_s                  , &
322                  &              dta_alias%tsu                  , dta_alias%s_i                  , &
323                  &              dta_alias%aip                  , dta_alias%hip )
324            ENDIF
325         ENDIF
326#endif
327      END DO  ! jbdy
328
329      IF ( ln_tide ) THEN
330         IF (ln_dynspg_ts) THEN      ! Fill temporary arrays with slow-varying bdy data                           
331            DO jbdy = 1, nb_bdy      ! Tidal component added in ts loop
332               IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN
333                  nblen => idx_bdy(jbdy)%nblen
334                  nblenrim => idx_bdy(jbdy)%nblenrim
335                  IF( cn_dyn2d(jbdy) == 'frs' ) THEN   ;   ilen1(:)=nblen(:)
336                  ELSE                                 ;   ilen1(:)=nblenrim(:)
337                  ENDIF
338                  IF ( dta_bdy(jbdy)%lneed_ssh   ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1))
339                  IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2))
340                  IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3))
341               ENDIF
342            END DO
343         ELSE ! Add tides if not split-explicit free surface else this is done in ts loop
344            !
345            ! BDY: use pt_offset=1.0 as applied at the end of the step and bdy_dta_tides is referenced at the middle of the step
346            CALL bdy_dta_tides( kt=kt, pt_offset = 1._wp )
347         ENDIF
348      ENDIF
349      !
350      IF( ln_timing )   CALL timing_stop('bdy_dta')
351      !
352   END SUBROUTINE bdy_dta
353
354
355   SUBROUTINE bdy_dta_init
356      !!----------------------------------------------------------------------
357      !!                   ***  SUBROUTINE bdy_dta_init  ***
358      !!                   
359      !! ** Purpose :   Initialise arrays for reading of external data
360      !!                for open boundary conditions
361      !!
362      !! ** Method  :   
363      !!               
364      !!----------------------------------------------------------------------
365      INTEGER ::   jbdy, jfld    ! Local integers
366      INTEGER ::   ierror, ios     !
367      !
368      INTEGER ::   nbdy_rdstart, nbdy_loc
369      CHARACTER(LEN=50)                      ::   cerrmsg       ! error string
370      CHARACTER(len=3)                       ::   cl3           !
371      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files
372      LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data
373      !                                                         ! =F => baroclinic velocities in 3D boundary data
374      LOGICAL                                ::   ln_zinterp    ! =T => requires a vertical interpolation of the bdydta
375      REAL(wp)                               ::   rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 
376      INTEGER                                ::   ipk,ipl       !
377      INTEGER                                ::   idvar         ! variable ID
378      INTEGER                                ::   indims        ! number of dimensions of the variable
379      INTEGER                                ::   iszdim        ! number of dimensions of the variable
380      INTEGER, DIMENSION(4)                  ::   i4dimsz       ! size of variable dimensions
381      INTEGER                                ::   igrd          ! index for grid type (1,2,3 = T,U,V)
382      LOGICAL                                ::   lluld         ! is the variable using the unlimited dimension
383      LOGICAL                                ::   llneed        !
384      LOGICAL                                ::   llread        !
385      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! must be an array to be used with fld_fill
386      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read
387      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip       
388      TYPE(FLD_N), DIMENSION(:), POINTER ::   bn_alias                        ! must be an array to be used with fld_fill
389      TYPE(FLD  ), DIMENSION(:), POINTER ::   bf_alias
390      !
391      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 
392      NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip
393      NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd
394      NAMELIST/nambdy_dta/ ln_full_vel, ln_zinterp
395      !!---------------------------------------------------------------------------
396      !
397      IF(lwp) WRITE(numout,*)
398      IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries'
399      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
400      IF(lwp) WRITE(numout,*) ''
401
402      ALLOCATE( bf(jpbdyfld,nb_bdy), STAT=ierror )
403      IF( ierror > 0 ) THEN   
404         CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' )   ;   RETURN 
405      ENDIF
406      bf(:,:)%clrootname = 'NOT USED'   ! default definition used as a flag in fld_read to do nothing.
407      bf(:,:)%lzint      = .FALSE.      ! default definition
408      bf(:,:)%ltotvel    = .FALSE.      ! default definition
409 
410      ! Read namelists
411      ! --------------
412      nbdy_rdstart = 1
413      DO jbdy = 1, nb_bdy
414
415         WRITE(ctmp1, '(a,i2)') 'BDY number ', jbdy
416         WRITE(ctmp2, '(a,i2)') 'block nambdy_dta number ', jbdy
417
418         ! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we read from the beginning
419         READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901)
420901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist' )
421
422         !   by-pass nambdy_dta reading if no input data used in this bdy   
423         IF(       ( dta_bdy(jbdy)%lneed_dyn2d .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 )   &
424            & .OR. ( dta_bdy(jbdy)%lneed_dyn3d .AND.     nn_dyn3d_dta(jbdy)    == 1 )   &
425            & .OR. ( dta_bdy(jbdy)%lneed_tra   .AND.       nn_tra_dta(jbdy)    == 1 )   &
426            & .OR. ( dta_bdy(jbdy)%lneed_ice   .AND.       nn_ice_dta(jbdy)    == 1 )   )   THEN
427            !
428            ! Need to support possibility of reading more than one
429            ! nambdy_dta from the namelist_cfg internal file.
430            ! Do this by finding the jbdy'th occurence of nambdy_dta in the
431            ! character buffer as the starting point.
432            !
433            nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_dta' )
434            IF( nbdy_loc .GT. 0 ) THEN
435               nbdy_rdstart = nbdy_rdstart + nbdy_loc
436            ELSE
437               WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',jbdy,' of nambdy_dta not found'
438               ios = -1
439               CALL ctl_nam ( ios , cerrmsg )
440            ENDIF
441            READ  ( numnam_cfg( MAX( 1, nbdy_rdstart - 2 ): ), nambdy_dta, IOSTAT = ios, ERR = 902)
442902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist' )
443            IF(lwm) WRITE( numond, nambdy_dta )           
444         ENDIF
445
446         ! get the number of ice categories in bdy data file (use a_i information to do this)
447         ipl = jpl   ! default definition
448         IF( dta_bdy(jbdy)%lneed_ice ) THEN    ! if we need ice bdy data
449            IF( nn_ice_dta(jbdy) == 1 ) THEN   ! if we get ice bdy data from netcdf file
450               CALL fld_fill(  bf(jp_bdya_i,jbdy:jbdy), bn_a_i, cn_dir, 'bdy_dta', 'a_i'//' '//ctmp1, ctmp2 )   ! use namelist info
451               CALL fld_def( bf(jp_bdya_i,jbdy) )
452               CALL iom_open( bf(jp_bdya_i,jbdy)%clname, bf(jp_bdya_i,jbdy)%num )
453               idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld )
454               IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN   ;   ipl = i4dimsz(3)   ! xylt or xyl
455               ELSE                                                            ;   ipl = 1            ! xy or xyt
456               ENDIF
457               CALL iom_close( bf(jp_bdya_i,jbdy)%num )
458               bf(jp_bdya_i,jbdy)%clrootname = 'NOT USED'   ! reset to default value as this subdomain may not need to read this bdy
459            ENDIF
460         ENDIF
461
462#if defined key_si3
463         IF( .NOT.ln_pnd ) THEN
464            rn_ice_apnd = 0. ; rn_ice_hpnd = 0.
465            CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 when no ponds' )
466         ENDIF
467#endif
468
469         ! temp, salt, age and ponds of incoming ice
470         rice_tem (jbdy) = rn_ice_tem
471         rice_sal (jbdy) = rn_ice_sal
472         rice_age (jbdy) = rn_ice_age
473         rice_apnd(jbdy) = rn_ice_apnd
474         rice_hpnd(jbdy) = rn_ice_hpnd
475         
476         
477         DO jfld = 1, jpbdyfld
478
479            ! =====================
480            !          ssh
481            ! =====================
482            IF( jfld == jp_bdyssh ) THEN
483               cl3 = 'ssh'
484               igrd = 1                                                    ! T point
485               ipk = 1                                                     ! surface data
486               llneed = dta_bdy(jbdy)%lneed_ssh                            ! dta_bdy(jbdy)%ssh will be needed
487               llread = MOD(nn_dyn2d_dta(jbdy),2) == 1                     ! get data from NetCDF file
488               bf_alias => bf(jp_bdyssh,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy
489               bn_alias => bn_ssh                                          ! alias for ssh structure of nambdy_dta
490               iszdim = idx_bdy(jbdy)%nblenrim(igrd)                       ! length of this bdy on this MPI processus : used only on the rim
491            ENDIF
492            ! =====================
493            !         dyn2d
494            ! =====================
495            IF( jfld == jp_bdyu2d ) THEN
496               cl3 = 'u2d'
497               igrd = 2                                                    ! U point
498               ipk = 1                                                     ! surface data
499               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed
500               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get u2d from u3d and read NetCDF file
501               bf_alias => bf(jp_bdyu2d,jbdy:jbdy)                         ! alias for u2d structure of bdy number jbdy
502               bn_alias => bn_u2d                                          ! alias for u2d structure of nambdy_dta
503               IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from u3d -> need on the full bdy
504               ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim
505               ENDIF
506            ENDIF
507            IF( jfld == jp_bdyv2d ) THEN
508               cl3 = 'v2d'
509               igrd = 3                                                    ! V point
510               ipk = 1                                                     ! surface data
511               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed
512               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get v2d from v3d and read NetCDF file
513               bf_alias => bf(jp_bdyv2d,jbdy:jbdy)                         ! alias for v2d structure of bdy number jbdy
514               bn_alias => bn_v2d                                          ! alias for v2d structure of nambdy_dta
515               IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from v3d -> need on the full bdy
516               ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim
517               ENDIF
518            ENDIF
519            ! =====================
520            !         dyn3d
521            ! =====================
522            IF( jfld == jp_bdyu3d ) THEN
523               cl3 = 'u3d'
524               igrd = 2                                                    ! U point
525               ipk = jpk                                                   ! 3d data
526               llneed = dta_bdy(jbdy)%lneed_dyn3d .OR.               &     ! dta_bdy(jbdy)%u3d will be needed
527                  &   ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel )      !   u3d needed to compute u2d
528               llread = nn_dyn3d_dta(jbdy) == 1                            ! get data from NetCDF file
529               bf_alias => bf(jp_bdyu3d,jbdy:jbdy)                         ! alias for u3d structure of bdy number jbdy
530               bn_alias => bn_u3d                                          ! alias for u3d structure of nambdy_dta
531               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
532           ENDIF
533            IF( jfld == jp_bdyv3d ) THEN
534               cl3 = 'v3d'
535               igrd = 3                                                    ! V point
536               ipk = jpk                                                   ! 3d data
537               llneed = dta_bdy(jbdy)%lneed_dyn3d .OR.               &     ! dta_bdy(jbdy)%v3d will be needed
538                  &   ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel )      !   v3d needed to compute v2d
539               llread = nn_dyn3d_dta(jbdy) == 1                            ! get data from NetCDF file
540               bf_alias => bf(jp_bdyv3d,jbdy:jbdy)                         ! alias for v3d structure of bdy number jbdy
541               bn_alias => bn_v3d                                          ! alias for v3d structure of nambdy_dta
542               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
543           ENDIF
544
545            ! =====================
546            !          tra
547            ! =====================
548            IF( jfld == jp_bdytem ) THEN
549               cl3 = 'tem'
550               igrd = 1                                                    ! T point
551               ipk = jpk                                                   ! 3d data
552               llneed = dta_bdy(jbdy)%lneed_tra                            ! dta_bdy(jbdy)%tem will be needed
553               llread = nn_tra_dta(jbdy) == 1                              ! get data from NetCDF file
554               bf_alias => bf(jp_bdytem,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy
555               bn_alias => bn_tem                                          ! alias for ssh structure of nambdy_dta
556               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
557            ENDIF
558            IF( jfld == jp_bdysal ) THEN
559               cl3 = 'sal'
560               igrd = 1                                                    ! T point
561               ipk = jpk                                                   ! 3d data
562               llneed = dta_bdy(jbdy)%lneed_tra                            ! dta_bdy(jbdy)%sal will be needed
563               llread = nn_tra_dta(jbdy) == 1                              ! get data from NetCDF file
564               bf_alias => bf(jp_bdysal,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy
565               bn_alias => bn_sal                                          ! alias for ssh structure of nambdy_dta
566               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
567            ENDIF
568
569            ! =====================
570            !          ice
571            ! =====================
572            IF(  jfld == jp_bdya_i .OR. jfld == jp_bdyh_i .OR. jfld == jp_bdyh_s .OR. &
573               & jfld == jp_bdyt_i .OR. jfld == jp_bdyt_s .OR. jfld == jp_bdytsu .OR. &
574               & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip      ) THEN
575               igrd = 1                                                    ! T point
576               ipk = ipl                                                   ! jpl-cat data
577               llneed = dta_bdy(jbdy)%lneed_ice                            ! ice will be needed
578               llread = nn_ice_dta(jbdy) == 1                              ! get data from NetCDF file
579               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
580            ENDIF
581            IF( jfld == jp_bdya_i ) THEN
582               cl3 = 'a_i'
583               bf_alias => bf(jp_bdya_i,jbdy:jbdy)                         ! alias for a_i structure of bdy number jbdy
584               bn_alias => bn_a_i                                          ! alias for a_i structure of nambdy_dta
585            ENDIF
586            IF( jfld == jp_bdyh_i ) THEN
587               cl3 = 'h_i'
588               bf_alias => bf(jp_bdyh_i,jbdy:jbdy)                         ! alias for h_i structure of bdy number jbdy
589               bn_alias => bn_h_i                                          ! alias for h_i structure of nambdy_dta
590            ENDIF
591            IF( jfld == jp_bdyh_s ) THEN
592               cl3 = 'h_s'
593               bf_alias => bf(jp_bdyh_s,jbdy:jbdy)                         ! alias for h_s structure of bdy number jbdy
594               bn_alias => bn_h_s                                          ! alias for h_s structure of nambdy_dta
595            ENDIF
596            IF( jfld == jp_bdyt_i ) THEN
597               cl3 = 't_i'
598               bf_alias => bf(jp_bdyt_i,jbdy:jbdy)                         ! alias for t_i structure of bdy number jbdy
599               bn_alias => bn_t_i                                          ! alias for t_i structure of nambdy_dta
600            ENDIF
601            IF( jfld == jp_bdyt_s ) THEN
602               cl3 = 't_s'
603               bf_alias => bf(jp_bdyt_s,jbdy:jbdy)                         ! alias for t_s structure of bdy number jbdy
604               bn_alias => bn_t_s                                          ! alias for t_s structure of nambdy_dta
605            ENDIF
606            IF( jfld == jp_bdytsu ) THEN
607               cl3 = 'tsu'
608               bf_alias => bf(jp_bdytsu,jbdy:jbdy)                         ! alias for tsu structure of bdy number jbdy
609               bn_alias => bn_tsu                                          ! alias for tsu structure of nambdy_dta
610            ENDIF
611            IF( jfld == jp_bdys_i ) THEN
612               cl3 = 's_i'
613               bf_alias => bf(jp_bdys_i,jbdy:jbdy)                         ! alias for s_i structure of bdy number jbdy
614               bn_alias => bn_s_i                                          ! alias for s_i structure of nambdy_dta
615            ENDIF
616            IF( jfld == jp_bdyaip ) THEN
617               cl3 = 'aip'
618               bf_alias => bf(jp_bdyaip,jbdy:jbdy)                         ! alias for aip structure of bdy number jbdy
619               bn_alias => bn_aip                                          ! alias for aip structure of nambdy_dta
620            ENDIF
621            IF( jfld == jp_bdyhip ) THEN
622               cl3 = 'hip'
623               bf_alias => bf(jp_bdyhip,jbdy:jbdy)                         ! alias for hip structure of bdy number jbdy
624               bn_alias => bn_hip                                          ! alias for hip structure of nambdy_dta
625            ENDIF
626
627            IF( llneed .AND. iszdim > 0 ) THEN                             ! dta_bdy(jbdy)%xxx will be needed
628               !                                                           !   -> must be associated with an allocated target
629               ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) )              ! allocate the target
630               !
631               IF( llread ) THEN                                           ! get data from NetCDF file
632                  CALL fld_fill( bf_alias, bn_alias, cn_dir, 'bdy_dta', cl3//' '//ctmp1, ctmp2 )   ! use namelist info
633                  IF( bf_alias(1)%ln_tint ) ALLOCATE( bf_alias(1)%fdta( iszdim, 1, ipk, 2 ) )
634                  bf_alias(1)%imap    => idx_bdy(jbdy)%nbmap(1:iszdim,igrd)   ! associate the mapping used for this bdy
635                  bf_alias(1)%igrd    = igrd                                  ! used only for vertical integration of 3D arrays
636                  bf_alias(1)%ibdy    = jbdy                                  !  "    "    "     "          "      "  "    "   
637                  bf_alias(1)%ltotvel = ln_full_vel                           ! T if u3d is full velocity
638                  bf_alias(1)%lzint   = ln_zinterp                            ! T if it requires a vertical interpolation
639               ENDIF
640
641               ! associate the pointer and get rid of the dimensions with a size equal to 1
642               IF( jfld == jp_bdyssh )        dta_bdy(jbdy)%ssh => bf_alias(1)%fnow(:,1,1)
643               IF( jfld == jp_bdyu2d )        dta_bdy(jbdy)%u2d => bf_alias(1)%fnow(:,1,1)
644               IF( jfld == jp_bdyv2d )        dta_bdy(jbdy)%v2d => bf_alias(1)%fnow(:,1,1)
645               IF( jfld == jp_bdyu3d )        dta_bdy(jbdy)%u3d => bf_alias(1)%fnow(:,1,:)
646               IF( jfld == jp_bdyv3d )        dta_bdy(jbdy)%v3d => bf_alias(1)%fnow(:,1,:)
647               IF( jfld == jp_bdytem )        dta_bdy(jbdy)%tem => bf_alias(1)%fnow(:,1,:)
648               IF( jfld == jp_bdysal )        dta_bdy(jbdy)%sal => bf_alias(1)%fnow(:,1,:)
649               IF( jfld == jp_bdya_i ) THEN
650                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%a_i => bf_alias(1)%fnow(:,1,:)
651                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%a_i(iszdim,jpl) )
652                  ENDIF
653               ENDIF
654               IF( jfld == jp_bdyh_i ) THEN
655                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%h_i => bf_alias(1)%fnow(:,1,:)
656                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%h_i(iszdim,jpl) )
657                  ENDIF
658               ENDIF
659               IF( jfld == jp_bdyh_s ) THEN
660                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%h_s => bf_alias(1)%fnow(:,1,:)
661                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%h_s(iszdim,jpl) )
662                  ENDIF
663               ENDIF
664               IF( jfld == jp_bdyt_i ) THEN
665                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%t_i => bf_alias(1)%fnow(:,1,:)
666                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%t_i(iszdim,jpl) )
667                  ENDIF
668               ENDIF
669               IF( jfld == jp_bdyt_s ) THEN
670                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%t_s => bf_alias(1)%fnow(:,1,:)
671                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%t_s(iszdim,jpl) )
672                  ENDIF
673               ENDIF
674               IF( jfld == jp_bdytsu ) THEN
675                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%tsu => bf_alias(1)%fnow(:,1,:)
676                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%tsu(iszdim,jpl) )
677                  ENDIF
678               ENDIF
679               IF( jfld == jp_bdys_i ) THEN
680                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%s_i => bf_alias(1)%fnow(:,1,:)
681                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%s_i(iszdim,jpl) )
682                  ENDIF
683               ENDIF
684               IF( jfld == jp_bdyaip ) THEN
685                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%aip => bf_alias(1)%fnow(:,1,:)
686                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%aip(iszdim,jpl) )
687                  ENDIF
688               ENDIF
689               IF( jfld == jp_bdyhip ) THEN
690                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%hip => bf_alias(1)%fnow(:,1,:)
691                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%hip(iszdim,jpl) )
692                  ENDIF
693               ENDIF
694            ENDIF
695
696         END DO   ! jpbdyfld
697         !
698      END DO ! jbdy
699      !
700   END SUBROUTINE bdy_dta_init
701   
702   !!==============================================================================
703END MODULE bdydta
Note: See TracBrowser for help on using the repository browser.