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/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY – NEMO

source: NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydta.F90 @ 11325

Last change on this file since 11325 was 11325, checked in by smasson, 5 years ago

dev_r10984_HPC-13 : bugfixes for sette with debug options
  • Property svn:keywords set to Id
File size: 32.0 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 sbctide        ! Tidal forcing or not
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  = 10    ! 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#if ! defined key_si3
57   INTEGER , PARAMETER ::   jpl = 1
58#endif
59                                                             ! =F => baroclinic velocities in 3D boundary conditions
60!$AGRIF_DO_NOT_TREAT
61   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::   bf   ! structure of input fields (file informations, fields read)
62!$AGRIF_END_DO_NOT_TREAT
63
64   !!----------------------------------------------------------------------
65   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
66   !! $Id$
67   !! Software governed by the CeCILL license (see ./LICENSE)
68   !!----------------------------------------------------------------------
69CONTAINS
70
71   SUBROUTINE bdy_dta( kt, kit, kt_offset )
72      !!----------------------------------------------------------------------
73      !!                   ***  SUBROUTINE bdy_dta  ***
74      !!                   
75      !! ** Purpose :   Update external data for open boundary conditions
76      !!
77      !! ** Method  :   Use fldread.F90
78      !!               
79      !!----------------------------------------------------------------------
80      INTEGER, INTENT(in)           ::   kt           ! ocean time-step index
81      INTEGER, INTENT(in), OPTIONAL ::   kit          ! subcycle time-step index (for timesplitting option)
82      INTEGER, INTENT(in), OPTIONAL ::   kt_offset    ! time offset in units of timesteps. NB. if kit
83      !                                               ! is present then units = subcycle timesteps.
84      !                                               ! kt_offset = 0 => get data at "now" time level
85      !                                               ! kt_offset = -1 => get data at "before" time level
86      !                                               ! kt_offset = +1 => get data at "after" time level
87      !                                               ! etc.
88      !
89      INTEGER ::  jbdy, jfld, jstart, jend, ib, jl    ! dummy loop indices
90      INTEGER ::  ii, ij, ik, igrd, ipl               ! local integers
91      INTEGER,   DIMENSION(jpbgrd)     ::   ilen1 
92      INTEGER,   DIMENSION(:), POINTER ::   nblen, nblenrim  ! short cuts
93      TYPE(OBC_DATA)         , POINTER ::   dta_alias        ! short cut
94      TYPE(FLD), DIMENSION(:), POINTER ::   bf_alias
95      !!---------------------------------------------------------------------------
96      !
97      IF( ln_timing )   CALL timing_start('bdy_dta')
98      !
99      ! Initialise data arrays once for all from initial conditions where required
100      !---------------------------------------------------------------------------
101      IF( kt == nit000 .AND. .NOT.PRESENT(kit) ) THEN
102
103         ! Calculate depth-mean currents
104         !-----------------------------
105
106         DO jbdy = 1, nb_bdy
107            !
108            nblen    => idx_bdy(jbdy)%nblen
109            nblenrim => idx_bdy(jbdy)%nblenrim
110            !
111            IF( nn_dyn2d_dta(jbdy) == 0 ) THEN
112               ilen1(:) = nblen(:)
113               IF( dta_bdy(jbdy)%lneed_ssh ) THEN
114                  igrd = 1
115                  DO ib = 1, ilen1(igrd)
116                     ii = idx_bdy(jbdy)%nbi(ib,igrd)
117                     ij = idx_bdy(jbdy)%nbj(ib,igrd)
118                     dta_bdy(jbdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)         
119                  END DO
120               ENDIF
121               IF( dta_bdy(jbdy)%lneed_dyn2d) THEN
122                  igrd = 2
123                  DO ib = 1, ilen1(igrd)
124                     ii = idx_bdy(jbdy)%nbi(ib,igrd)
125                     ij = idx_bdy(jbdy)%nbj(ib,igrd)
126                     dta_bdy(jbdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1)         
127                  END DO
128                  igrd = 3
129                  DO ib = 1, ilen1(igrd)
130                     ii = idx_bdy(jbdy)%nbi(ib,igrd)
131                     ij = idx_bdy(jbdy)%nbj(ib,igrd)
132                     dta_bdy(jbdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1)         
133                  END DO
134               ENDIF
135            ENDIF
136            !
137            IF( nn_dyn3d_dta(jbdy) == 0 ) THEN
138               ilen1(:) = nblen(:)
139               IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN
140                  igrd = 2 
141                  DO ib = 1, ilen1(igrd)
142                     DO ik = 1, jpkm1
143                        ii = idx_bdy(jbdy)%nbi(ib,igrd)
144                        ij = idx_bdy(jbdy)%nbj(ib,igrd)
145                        dta_bdy(jbdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - un_b(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_bdy(jbdy)%nbi(ib,igrd)
152                        ij = idx_bdy(jbdy)%nbj(ib,igrd)
153                        dta_bdy(jbdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)         
154                     END DO
155                  END DO
156               ENDIF
157            ENDIF
158
159            IF( nn_tra_dta(jbdy) == 0 ) THEN
160               ilen1(:) = nblen(:)
161               IF( dta_bdy(jbdy)%lneed_tra ) THEN
162                  igrd = 1 
163                  DO ib = 1, ilen1(igrd)
164                     DO ik = 1, jpkm1
165                        ii = idx_bdy(jbdy)%nbi(ib,igrd)
166                        ij = idx_bdy(jbdy)%nbj(ib,igrd)
167                        dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_bdytem) * tmask(ii,ij,ik)         
168                        dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_bdysal) * tmask(ii,ij,ik)         
169                     END DO
170                  END DO
171               ENDIF
172            ENDIF
173
174#if defined key_si3
175            IF( nn_ice_dta(jbdy) == 0 ) THEN    ! set ice to initial values
176               ilen1(:) = nblen(:)
177               IF( dta_bdy(jbdy)%lneed_ice ) THEN
178                  igrd = 1   
179                  DO jl = 1, jpl
180                     DO ib = 1, ilen1(igrd)
181                        ii = idx_bdy(jbdy)%nbi(ib,igrd)
182                        ij = idx_bdy(jbdy)%nbj(ib,igrd)
183                        dta_bdy(jbdy)%a_i (ib,jl) =  a_i(ii,ij,jl) * tmask(ii,ij,1) 
184                        dta_bdy(jbdy)%h_i (ib,jl) =  h_i(ii,ij,jl) * tmask(ii,ij,1) 
185                        dta_bdy(jbdy)%h_s (ib,jl) =  h_s(ii,ij,jl) * tmask(ii,ij,1) 
186                     END DO
187                  END DO
188               ENDIF
189            ENDIF
190#endif
191         END DO ! jbdy
192         !
193      ENDIF ! kt == nit000
194
195      ! update external data from files
196      !--------------------------------
197
198      DO jbdy = 1, nb_bdy
199
200         dta_alias => dta_bdy(jbdy)
201         bf_alias  => bf(:,jbdy)
202
203         ! read/update all bdy data
204         ! ------------------------
205         CALL fld_read( kt, 1, bf_alias, kit = kit, kt_offset = kt_offset )
206
207         ! apply some corrections in some specific cases...
208         ! --------------------------------------------------
209         !
210         ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s)
211         IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN   ! runoff and we read u/v2d
212            !
213            igrd = 2                      ! zonal flow (m3/s) to barotropic zonal velocity (m/s)
214            DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
215               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
216               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
217               dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )
218            END DO
219            igrd = 3                      ! meridional flow (m3/s) to barotropic meridional velocity (m/s)
220            DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
221               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
222               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
223               dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )
224            END DO
225         ENDIF
226
227         ! tidal harmonic forcing ONLY: initialise arrays
228         IF( nn_dyn2d_dta(jbdy) == 2 ) THEN   ! we did not read ssh, u/v2d
229            IF( dta_alias%lneed_ssh   ) dta_alias%ssh(:) = 0._wp
230            IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp
231            IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp
232         ENDIF
233
234         ! If full velocities in boundary data, then split it into barotropic and baroclinic component
235         IF( bf_alias(jp_bdyu3d)%ltotvel ) THEN     ! if we read 3D total velocity (can be true only if u3d was read)
236            !
237            igrd = 2                       ! zonal velocity
238            dta_alias%u2d(:) = 0._wp       ! compute barotrope zonal velocity and put it in u2d
239            DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
240               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
241               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
242               DO ik = 1, jpkm1
243                  dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik)
244               END DO
245               dta_alias%u2d(ib) =  dta_alias%u2d(ib) * r1_hu_n(ii,ij)
246               DO ik = 1, jpkm1            ! compute barocline zonal velocity and put it in u3d
247                  dta_alias%u3d(ib,ik) = dta_alias%u3d(ib,ik) - dta_alias%u2d(ib)
248               END DO
249            END DO
250            igrd = 3                       ! meridional velocity
251            dta_alias%v2d(:) = 0._wp       ! compute barotrope meridional velocity and put it in v2d
252            DO ib = 1, idx_bdy(jbdy)%nblen(igrd)
253               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
254               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
255               DO ik = 1, jpkm1
256                  dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik)
257               END DO
258               dta_alias%v2d(ib) =  dta_alias%v2d(ib) * r1_hv_n(ii,ij)
259               DO ik = 1, jpkm1            ! compute barocline meridional velocity and put it in v3d
260                  dta_alias%v3d(ib,ik) = dta_alias%v3d(ib,ik) - dta_alias%v2d(ib)
261               END DO
262            END DO
263         ENDIF   ! ltotvel
264
265         ! update tidal harmonic forcing
266         IF( PRESENT(kit) .AND. nn_dyn2d_dta(jbdy) .GE. 2 ) THEN
267            CALL bdytide_update( kt = kt, idx = idx_bdy(jbdy), dta = dta_alias, td = tides(jbdy),   & 
268               &                 kit = kit, kt_offset = kt_offset )
269         ENDIF
270
271         !  atm surface pressure : add inverted barometer effect to ssh if it was read
272         IF ( ln_apr_obc .AND. TRIM(bf_alias(jp_bdyssh)%clrootname) /= 'NOT USED' ) THEN
273            igrd = 1
274            DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd)   ! ssh is used only on the rim
275               ii   = idx_bdy(jbdy)%nbi(ib,igrd)
276               ij   = idx_bdy(jbdy)%nbj(ib,igrd)
277               dta_alias%ssh(ib) = dta_alias%ssh(ib) + ssh_ib(ii,ij)
278            END DO
279         ENDIF
280
281#if defined key_si3
282         ! ice: convert N-cat fields (input) into jpl-cat (output)
283         IF( dta_alias%lneed_ice ) THEN
284            ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3)
285            IF( ipl /= jpl ) THEN      ! ice: convert N-cat fields (input) into jpl-cat (output)
286               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,:), &
287                  &              dta_alias%h_i               , dta_alias%h_s               , dta_alias%a_i                 )
288            ENDIF
289         ENDIF
290#endif
291      END DO  ! jbdy
292
293      IF ( ln_tide ) THEN
294         IF (ln_dynspg_ts) THEN      ! Fill temporary arrays with slow-varying bdy data                           
295            DO jbdy = 1, nb_bdy      ! Tidal component added in ts loop
296               IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN
297                  nblen => idx_bdy(jbdy)%nblen
298                  nblenrim => idx_bdy(jbdy)%nblenrim
299                  IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF
300                     IF ( dta_bdy(jbdy)%lneed_ssh   ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1))
301                     IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2))
302                     IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3))
303                  ENDIF
304               END DO
305            ELSE ! Add tides if not split-explicit free surface else this is done in ts loop
306               !
307               CALL bdy_dta_tides( kt=kt, kt_offset=kt_offset )
308            ENDIF
309         ENDIF
310         !
311         IF( ln_timing )   CALL timing_stop('bdy_dta')
312         !
313      END SUBROUTINE bdy_dta
314
315
316   SUBROUTINE bdy_dta_init
317      !!----------------------------------------------------------------------
318      !!                   ***  SUBROUTINE bdy_dta_init  ***
319      !!                   
320      !! ** Purpose :   Initialise arrays for reading of external data
321      !!                for open boundary conditions
322      !!
323      !! ** Method  :   
324      !!               
325      !!----------------------------------------------------------------------
326      INTEGER ::   jbdy, jfld    ! Local integers
327      INTEGER ::   ierror, ios     !
328      !
329      CHARACTER(len=3)                       ::   cl3           !
330      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files
331      LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data
332      !                                                         ! =F => baroclinic velocities in 3D boundary data
333      LOGICAL                                ::   ln_zinterp    ! =T => requires a vertical interpolation of the bdydta
334      INTEGER                                ::   ipk,ipl       !
335      INTEGER                                ::   idvar         ! variable ID
336      INTEGER                                ::   indims        ! number of dimensions of the variable
337      INTEGER                                ::   iszdim        ! number of dimensions of the variable
338      INTEGER, DIMENSION(4)                  ::   i4dimsz       ! size of variable dimensions
339      INTEGER                                ::   igrd          ! index for grid type (1,2,3 = T,U,V)
340      LOGICAL                                ::   lluld         ! is the variable using the unlimited dimension
341      LOGICAL                                ::   llneed        !
342      LOGICAL                                ::   llread        !
343      TYPE(FLD_N), DIMENSION(1), TARGET ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! must be an array to be used with fld_fill
344      TYPE(FLD_N), DIMENSION(1), TARGET ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read
345      TYPE(FLD_N), DIMENSION(1), TARGET ::   bn_a_i, bn_h_i, bn_h_s     
346      TYPE(FLD_N), DIMENSION(:), POINTER ::   bn_alias                        ! must be an array to be used with fld_fill
347      TYPE(FLD  ), DIMENSION(:), POINTER ::   bf_alias
348      !
349      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 
350      NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s
351      NAMELIST/nambdy_dta/ ln_full_vel, ln_zinterp
352      !!---------------------------------------------------------------------------
353      !
354      IF(lwp) WRITE(numout,*)
355      IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries'
356      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
357      IF(lwp) WRITE(numout,*) ''
358
359      ALLOCATE( bf(jpbdyfld,nb_bdy), STAT=ierror )
360      IF( ierror > 0 ) THEN   
361         CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' )   ;   RETURN 
362      ENDIF
363      bf(:,:)%clrootname = 'NOT USED'   ! default definition used as a flag in fld_read to do nothing.
364      bf(:,:)%lzint      = .FALSE.      ! default definition
365      bf(:,:)%ltotvel    = .FALSE.      ! default definition
366 
367      ! Read namelists
368      ! --------------
369      REWIND(numnam_cfg)
370      DO jbdy = 1, nb_bdy
371
372         WRITE(ctmp1, '(a,i2)') 'BDY number ', jbdy
373         WRITE(ctmp2, '(a,i2)') 'block nambdy_dta number ', jbdy
374
375         ! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we do a rewind
376         REWIND(numnam_ref)
377         READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901)
378901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist' )
379
380         !   by-pass nambdy_dta reading if no input data used in this bdy   
381         IF(       ( dta_bdy(jbdy)%lneed_dyn2d .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 )   &
382            & .OR. ( dta_bdy(jbdy)%lneed_dyn3d .AND.     nn_dyn3d_dta(jbdy)    == 1 )   &
383            & .OR. ( dta_bdy(jbdy)%lneed_tra   .AND.       nn_tra_dta(jbdy)    == 1 )   &
384            & .OR. ( dta_bdy(jbdy)%lneed_ice   .AND.       nn_ice_dta(jbdy)    == 1 )   )   THEN
385            ! WARNING: we don't do a rewind here, each bdy reads its own nambdy_dta block one after another
386            READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 )
387902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist' )
388            IF(lwm) WRITE( numond, nambdy_dta )           
389         ENDIF
390
391         ! get the number of ice categories in bdy data file (use a_i information to do this)
392         ipl = jpl   ! default definition
393         IF( dta_bdy(jbdy)%lneed_ice ) THEN    ! if we need ice bdy data
394            IF( nn_ice_dta(jbdy) == 1 ) THEN   ! if we get ice bdy data from netcdf file
395               CALL fld_fill(  bf(jp_bdya_i,jbdy:jbdy), bn_a_i, cn_dir, 'bdy_dta', 'a_i'//' '//ctmp1, ctmp2 )   ! use namelist info
396               CALL fld_clopn( bf(jp_bdya_i,jbdy), nyear, nmonth, nday )   ! not a problem when we call it again after
397               idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld )
398               IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN   ;   ipl = i4dimsz(3)   ! xylt or xyl
399               ELSE                                                            ;   ipl = 1            ! xy or xyt
400               ENDIF
401            ENDIF
402         ENDIF
403
404         DO jfld = 1, jpbdyfld
405
406            ! =====================
407            !          ssh
408            ! =====================
409            IF( jfld == jp_bdyssh ) THEN
410               cl3 = 'ssh'
411               igrd = 1                                                    ! T point
412               ipk = 1                                                     ! surface data
413               llneed = dta_bdy(jbdy)%lneed_ssh                            ! dta_bdy(jbdy)%ssh will be needed
414               llread = MOD(nn_dyn2d_dta(jbdy),2) == 1                     ! get data from NetCDF file
415               bf_alias => bf(jp_bdyssh,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy
416               bn_alias => bn_ssh                                          ! alias for ssh structure of nambdy_dta
417               iszdim = idx_bdy(jbdy)%nblenrim(igrd)                       ! length of this bdy on this MPI processus : only rim
418            ENDIF
419            ! =====================
420            !         dyn2d
421            ! =====================
422            IF( jfld == jp_bdyu2d ) THEN
423               cl3 = 'u2d'
424               igrd = 2                                                    ! U point
425               ipk = 1                                                     ! surface data
426               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed
427               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get u2d from u3d and read NetCDF file
428               bf_alias => bf(jp_bdyu2d,jbdy:jbdy)                         ! alias for u2d structure of bdy number jbdy
429               bn_alias => bn_u2d                                          ! alias for u2d structure of nambdy_dta
430               iszdim = idx_bdy(jbdy)%nblenrim(igrd)                       ! length of this bdy on this MPI processus : only rim
431            ENDIF
432            IF( jfld == jp_bdyv2d ) THEN
433               cl3 = 'v2d'
434               igrd = 3                                                    ! V point
435               ipk = 1                                                     ! surface data
436               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed
437               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get v2d from v3d and read NetCDF file
438               bf_alias => bf(jp_bdyv2d,jbdy:jbdy)                         ! alias for v2d structure of bdy number jbdy
439               bn_alias => bn_v2d                                          ! alias for v2d structure of nambdy_dta
440               iszdim = idx_bdy(jbdy)%nblenrim(igrd)                       ! length of this bdy on this MPI processus : only rim
441            ENDIF
442            ! =====================
443            !         dyn3d
444            ! =====================
445            IF( jfld == jp_bdyu3d ) THEN
446               cl3 = 'u3d'
447               igrd = 2                                                    ! U point
448               ipk = jpk                                                   ! 3d data
449               llneed = dta_bdy(jbdy)%lneed_dyn3d .OR.               &     ! dta_bdy(jbdy)%u3d will be needed
450                  &   ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel )      !   u3d needed to compute u2d
451               llread = nn_dyn3d_dta(jbdy) == 1                            ! get data from NetCDF file
452               bf_alias => bf(jp_bdyu3d,jbdy:jbdy)                         ! alias for u3d structure of bdy number jbdy
453               bn_alias => bn_u3d                                          ! alias for u3d structure of nambdy_dta
454               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
455           ENDIF
456            IF( jfld == jp_bdyv3d ) THEN
457               cl3 = 'v3d'
458               igrd = 3                                                    ! V point
459               ipk = jpk                                                   ! 3d data
460               llneed = dta_bdy(jbdy)%lneed_dyn3d .OR.               &     ! dta_bdy(jbdy)%v3d will be needed
461                  &   ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel )      !   v3d needed to compute v2d
462               llread = nn_dyn3d_dta(jbdy) == 1                            ! get data from NetCDF file
463               bf_alias => bf(jp_bdyv3d,jbdy:jbdy)                         ! alias for v3d structure of bdy number jbdy
464               bn_alias => bn_v3d                                          ! alias for v3d structure of nambdy_dta
465               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
466           ENDIF
467
468            ! =====================
469            !          tra
470            ! =====================
471            IF( jfld == jp_bdytem ) THEN
472               cl3 = 'tem'
473               igrd = 1                                                    ! T point
474               ipk = jpk                                                   ! 3d data
475               llneed = dta_bdy(jbdy)%lneed_tra                            ! dta_bdy(jbdy)%tem will be needed
476               llread = nn_tra_dta(jbdy) == 1                              ! get data from NetCDF file
477               bf_alias => bf(jp_bdytem,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy
478               bn_alias => bn_tem                                          ! alias for ssh structure of nambdy_dta
479               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
480            ENDIF
481            IF( jfld == jp_bdysal ) THEN
482               cl3 = 'sal'
483               igrd = 1                                                    ! T point
484               ipk = jpk                                                   ! 3d data
485               llneed = dta_bdy(jbdy)%lneed_tra                            ! dta_bdy(jbdy)%sal will be needed
486               llread = nn_tra_dta(jbdy) == 1                              ! get data from NetCDF file
487               bf_alias => bf(jp_bdysal,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy
488               bn_alias => bn_sal                                          ! alias for ssh structure of nambdy_dta
489               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
490            ENDIF
491
492            ! =====================
493            !          ice
494            ! =====================
495            IF( jfld == jp_bdya_i ) THEN
496               cl3 = 'a_i'
497               igrd = 1                                                    ! T point
498               ipk = ipl                                                   !
499               llneed = dta_bdy(jbdy)%lneed_ice                            ! dta_bdy(jbdy)%a_i will be needed
500               llread = nn_ice_dta(jbdy) == 1                              ! get data from NetCDF file
501               bf_alias => bf(jp_bdya_i,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy
502               bn_alias => bn_a_i                                          ! alias for ssh structure of nambdy_dta
503               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
504           ENDIF
505            IF( jfld == jp_bdyh_i ) THEN
506               cl3 = 'h_i'
507               igrd = 1                                                    ! T point
508               ipk = ipl                                                   !
509               llneed = dta_bdy(jbdy)%lneed_ice                            ! dta_bdy(jbdy)%h_i will be needed
510               llread = nn_ice_dta(jbdy) == 1                              ! get data from NetCDF file
511               bf_alias => bf(jp_bdyh_i,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy
512               bn_alias => bn_h_i                                          ! alias for ssh structure of nambdy_dta
513               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
514            ENDIF
515            IF( jfld == jp_bdyh_s ) THEN
516               cl3 = 'h_s'
517               igrd = 1                                                    ! T point
518               ipk = ipl                                                   !
519               llneed = dta_bdy(jbdy)%lneed_ice                            ! dta_bdy(jbdy)%h_s will be needed
520               llread = nn_ice_dta(jbdy) == 1                              ! get data from NetCDF file
521               bf_alias => bf(jp_bdyh_s,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy
522               bn_alias => bn_h_s                                          ! alias for ssh structure of nambdy_dta
523               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus
524            ENDIF
525
526            IF( llneed ) THEN                                              ! dta_bdy(jbdy)%xxx will be needed
527               !                                                           !   -> must be associated with an allocated target
528               ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) )              ! allocate the target
529               !
530               IF( llread ) THEN                                           ! get data from NetCDF file
531                  CALL fld_fill( bf_alias, bn_alias, cn_dir, 'bdy_dta', cl3//' '//ctmp1, ctmp2 )   ! use namelist info
532                  IF( bf_alias(1)%ln_tint ) ALLOCATE( bf_alias(1)%fdta( iszdim, 1, ipk, 2 ) )
533                  bf_alias(1)%imap    => idx_bdy(jbdy)%nbmap(1:iszdim,igrd)   ! associate the mapping used for this bdy
534                  bf_alias(1)%igrd    = igrd                                  ! used only for vertical integration of 3D arrays
535                  bf_alias(1)%ltotvel = ln_full_vel                           ! T if u3d is full velocity
536                  bf_alias(1)%lzint   = ln_zinterp                            ! T if it requires a vertical interpolation
537               ENDIF
538
539               ! associate the pointer and get rid of the dimensions with a size equal to 1
540               IF( jfld == jp_bdyssh           ) dta_bdy(jbdy)%ssh => bf_alias(1)%fnow(:,1,1)
541               IF( jfld == jp_bdyu2d           ) dta_bdy(jbdy)%u2d => bf_alias(1)%fnow(:,1,1)
542               IF( jfld == jp_bdyv2d           ) dta_bdy(jbdy)%v2d => bf_alias(1)%fnow(:,1,1)
543               IF( jfld == jp_bdyu3d           ) dta_bdy(jbdy)%u3d => bf_alias(1)%fnow(:,1,:)
544               IF( jfld == jp_bdyv3d           ) dta_bdy(jbdy)%v3d => bf_alias(1)%fnow(:,1,:)
545               IF( jfld == jp_bdytem           ) dta_bdy(jbdy)%tem => bf_alias(1)%fnow(:,1,:)
546               IF( jfld == jp_bdysal           ) dta_bdy(jbdy)%sal => bf_alias(1)%fnow(:,1,:)
547               IF( jfld == jp_bdya_i ) THEN
548                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%a_i => bf_alias(1)%fnow(:,1,:)
549                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%a_i(iszdim,jpl) )
550                  ENDIF
551               ENDIF
552               IF( jfld == jp_bdyh_i ) THEN
553                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%h_i => bf_alias(1)%fnow(:,1,:)
554                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%h_i(iszdim,jpl) )
555                  ENDIF
556               ENDIF
557               IF( jfld == jp_bdyh_s ) THEN
558                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%h_s => bf_alias(1)%fnow(:,1,:)
559                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%h_s(iszdim,jpl) )
560                  ENDIF
561               ENDIF
562            ENDIF
563
564         END DO   ! jpbdyfld
565         !
566      END DO ! jbdy
567      !
568   END SUBROUTINE bdy_dta_init
569   
570   !!==============================================================================
571END MODULE bdydta
Note: See TracBrowser for help on using the repository browser.