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.
bdytides.F90 in branches/UKMO/test_moci_test_suite_namelist_read/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

source: branches/UKMO/test_moci_test_suite_namelist_read/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90 @ 9366

Last change on this file since 9366 was 9366, checked in by andmirek, 6 years ago

#2050 first version. Compiled OK in moci test suite

File size: 30.5 KB
Line 
1MODULE bdytides
2   !!======================================================================
3   !!                       ***  MODULE  bdytides  ***
4   !! Ocean dynamics:   Tidal forcing at open boundaries
5   !!======================================================================
6   !! History :  2.0  !  2007-01  (D.Storkey)  Original code
7   !!            2.3  !  2008-01  (J.Holt)  Add date correction. Origins POLCOMS v6.3 2007
8   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
9   !!            3.3  !  2010-09  (D.Storkey and E.O'Dea)  bug fixes
10   !!            3.4  !  2012-09  (G. Reffray and J. Chanut) New inputs + mods
11   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes
12   !!----------------------------------------------------------------------
13#if defined key_bdy
14   !!----------------------------------------------------------------------
15   !!   'key_bdy'     Open Boundary Condition
16   !!----------------------------------------------------------------------
17   !!   PUBLIC
18   !!      bdytide_init     : read of namelist and initialisation of tidal harmonics data
19   !!      tide_update   : calculation of tidal forcing at each timestep
20   !!----------------------------------------------------------------------
21   USE timing          ! Timing
22   USE oce             ! ocean dynamics and tracers
23   USE dom_oce         ! ocean space and time domain
24   USE iom
25   USE in_out_manager  ! I/O units
26   USE phycst          ! physical constants
27   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
28   USE bdy_par         ! Unstructured boundary parameters
29   USE bdy_oce         ! ocean open boundary conditions
30   USE daymod          ! calendar
31   USE wrk_nemo        ! Memory allocation
32   USE tideini
33!   USE tide_mod       ! Useless ??
34   USE fldread
35   USE dynspg_oce, ONLY: lk_dynspg_ts
36
37   IMPLICIT NONE
38   PRIVATE
39
40   PUBLIC   bdytide_init     ! routine called in bdy_init
41   PUBLIC   bdytide_update   ! routine called in bdy_dta
42   PUBLIC   bdy_dta_tides    ! routine called in dyn_spg_ts
43   PRIVATE  tide_namelist
44
45   TYPE, PUBLIC ::   TIDES_DATA     !: Storage for external tidal harmonics data
46      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh0       !: Tidal constituents : SSH0 (read in file)
47      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u0         !: Tidal constituents : U0   (read in file)
48      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v0         !: Tidal constituents : V0   (read in file)
49      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh        !: Tidal constituents : SSH  (after nodal cor.)
50      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u          !: Tidal constituents : U    (after nodal cor.)
51      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v          !: Tidal constituents : V    (after nodal cor.)
52   END TYPE TIDES_DATA
53
54!$AGRIF_DO_NOT_TREAT
55   TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides  !: External tidal harmonics data
56!$AGRIF_END_DO_NOT_TREAT
57   TYPE(OBC_DATA)  , PRIVATE, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component)
58
59   !!----------------------------------------------------------------------
60   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
61   !! $Id$
62   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
63   !!----------------------------------------------------------------------
64CONTAINS
65
66   SUBROUTINE bdytide_init
67      !!----------------------------------------------------------------------
68      !!                    ***  SUBROUTINE bdytide_init  ***
69      !!                     
70      !! ** Purpose : - Read in namelist for tides and initialise external
71      !!                tidal harmonics data
72      !!
73      !!----------------------------------------------------------------------
74      !! namelist variables
75      !!-------------------
76      CHARACTER(len=80)                         ::   filtide             !: Filename root for tidal input files
77      LOGICAL                                   ::   ln_bdytide_2ddta    !: If true, read 2d harmonic data
78      LOGICAL                                   ::   ln_bdytide_conj     !: If true, assume complex conjugate tidal data
79      !!
80      INTEGER                                   ::   ib_bdy, itide, ib   !: dummy loop indices
81      INTEGER                                   ::   ii, ij              !: dummy loop indices
82      INTEGER                                   ::   inum, igrd
83      INTEGER, DIMENSION(3)                     ::   ilen0       !: length of boundary data (from OBC arrays)
84      INTEGER, POINTER, DIMENSION(:)            ::   nblen, nblenrim     ! short cuts
85      INTEGER                                   ::   ios                 ! Local integer output status for namelist read
86      CHARACTER(len=80)                         ::   clfile              !: full file name for tidal input file
87      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            !: work space to read in tidal harmonics data
88      REAL(wp), POINTER, DIMENSION(:,:)         ::   ztr, zti            !:  "     "    "   "   "   "        "      "
89      !!
90      TYPE(TIDES_DATA),  POINTER                ::   td                  !: local short cut   
91      TYPE(MAP_POINTER), DIMENSION(jpbgrd)      ::   ibmap_ptr           !: array of pointers to nbmap
92      !!
93      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
94      !!----------------------------------------------------------------------
95
96      IF( nn_timing == 1 ) CALL timing_start('bdytide_init')
97
98      IF (nb_bdy>0) THEN
99         IF(lwp) WRITE(numout,*)
100         IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries'
101         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
102      ENDIF
103
104      IF(lwm) REWIND(numnam_cfg)
105
106      DO ib_bdy = 1, nb_bdy
107         IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN
108
109            td => tides(ib_bdy)
110            nblen => idx_bdy(ib_bdy)%nblen
111            nblenrim => idx_bdy(ib_bdy)%nblenrim
112
113            ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries
114            filtide(:) = ''
115
116            ! Don't REWIND here - may need to read more than one of these namelists.
117            IF(lwm) THEN
118               READ  ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901)
119901            IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in reference namelist', lwm )
120               READ  ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 )
121902            IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist', lwm )
122            ENDIF
123
124            IF(lwm) WRITE ( numond, nambdy_tide )
125
126            CALL tide_namelist(filtide)
127
128            !                                               ! Parameter control and print
129            IF(lwp) WRITE(numout,*) '  '
130            IF(lwp) WRITE(numout,*) '          Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
131            IF(lwp) WRITE(numout,*) '             read tidal data in 2d files: ', ln_bdytide_2ddta
132            IF(lwp) WRITE(numout,*) '             assume complex conjugate   : ', ln_bdytide_conj
133            IF(lwp) WRITE(numout,*) '             Number of tidal components to read: ', nb_harmo
134            IF(lwp) THEN
135                    WRITE(numout,*) '             Tidal components: ' 
136               DO itide = 1, nb_harmo
137                  WRITE(numout,*)  '                 ', Wave(ntide(itide))%cname_tide 
138               END DO
139            ENDIF
140            IF(lwp) WRITE(numout,*) ' '
141
142            ! Allocate space for tidal harmonics data - get size from OBC data arrays
143            ! -----------------------------------------------------------------------
144
145            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole
146            ! relaxation area     
147            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN
148               ilen0(:)=nblen(:)
149            ELSE
150               ilen0(:)=nblenrim(:)
151            ENDIF
152
153            ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) )
154            ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) )
155
156            ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) )
157            ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) )
158
159            ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) )
160            ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) )
161
162            td%ssh0(:,:,:) = 0._wp
163            td%ssh (:,:,:) = 0._wp
164            td%u0  (:,:,:) = 0._wp
165            td%u   (:,:,:) = 0._wp
166            td%v0  (:,:,:) = 0._wp
167            td%v   (:,:,:) = 0._wp
168
169            IF (ln_bdytide_2ddta) THEN
170               ! It is assumed that each data file contains all complex harmonic amplitudes
171               ! given on the data domain (ie global, jpidta x jpjdta)
172               !
173               CALL wrk_alloc( jpi, jpj, zti, ztr )
174               !
175               ! SSH fields
176               clfile = TRIM(filtide)//'_grid_T.nc'
177               CALL iom_open (clfile , inum ) 
178               igrd = 1                       ! Everything is at T-points here
179               DO itide = 1, nb_harmo
180                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )
181                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) ) 
182                  DO ib = 1, ilen0(igrd)
183                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
184                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
185                     td%ssh0(ib,itide,1) = ztr(ii,ij)
186                     td%ssh0(ib,itide,2) = zti(ii,ij)
187                  END DO
188               END DO
189               CALL iom_close( inum )
190               !
191               ! U fields
192               clfile = TRIM(filtide)//'_grid_U.nc'
193               CALL iom_open (clfile , inum ) 
194               igrd = 2                       ! Everything is at U-points here
195               DO itide = 1, nb_harmo
196                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) )
197                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) )
198                  DO ib = 1, ilen0(igrd)
199                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
200                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
201                     td%u0(ib,itide,1) = ztr(ii,ij)
202                     td%u0(ib,itide,2) = zti(ii,ij)
203                  END DO
204               END DO
205               CALL iom_close( inum )
206               !
207               ! V fields
208               clfile = TRIM(filtide)//'_grid_V.nc'
209               CALL iom_open (clfile , inum ) 
210               igrd = 3                       ! Everything is at V-points here
211               DO itide = 1, nb_harmo
212                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) )
213                  CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) )
214                  DO ib = 1, ilen0(igrd)
215                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
216                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
217                     td%v0(ib,itide,1) = ztr(ii,ij)
218                     td%v0(ib,itide,2) = zti(ii,ij)
219                  END DO
220               END DO 
221               CALL iom_close( inum )
222               !
223               CALL wrk_dealloc( jpi, jpj, ztr, zti ) 
224               !
225            ELSE           
226               !
227               ! Read tidal data only on bdy segments
228               !
229               ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) )
230               !
231               ! Set map structure
232               ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1)
233               ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy)
234               ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2)
235               ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy)
236               ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3)
237               ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy)
238
239               ! Open files and read in tidal forcing data
240               ! -----------------------------------------
241
242               DO itide = 1, nb_harmo
243                  !                                                              ! SSH fields
244                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc'
245                  CALL iom_open( clfile, inum )
246                  CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1,  ibmap_ptr(1) )
247                  td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1)
248                  CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1,  ibmap_ptr(1) )
249                  td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1)
250                  CALL iom_close( inum )
251                  !                                                              ! U fields
252                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc'
253                  CALL iom_open( clfile, inum )
254                  CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) )
255                  td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1)
256                  CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) )
257                  td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1)
258                  CALL iom_close( inum )
259                  !                                                              ! V fields
260                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc'
261                  CALL iom_open( clfile, inum )
262                  CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) )
263                  td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1)
264                  CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) )
265                  td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1)
266                  CALL iom_close( inum )
267                  !
268               END DO ! end loop on tidal components
269               !
270               DEALLOCATE( dta_read )
271            ENDIF ! ln_bdytide_2ddta=.true.
272            !
273            IF ( ln_bdytide_conj ) THEN ! assume complex conjugate in data files
274               td%ssh0(:,:,2) = - td%ssh0(:,:,2)
275               td%u0  (:,:,2) = - td%u0  (:,:,2)
276               td%v0  (:,:,2) = - td%v0  (:,:,2)
277            ENDIF
278            !
279            IF ( lk_dynspg_ts ) THEN ! Allocate arrays to save slowly varying boundary data during
280                                     ! time splitting integration
281               ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) )
282               ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) )
283               ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) )
284               dta_bdy_s(ib_bdy)%ssh(:) = 0.e0
285               dta_bdy_s(ib_bdy)%u2d(:) = 0.e0
286               dta_bdy_s(ib_bdy)%v2d(:) = 0.e0
287            ENDIF
288            !
289         ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2
290         !
291      END DO ! loop on ib_bdy
292
293      IF( nn_timing == 1 ) CALL timing_stop('bdytide_init')
294
295   END SUBROUTINE bdytide_init
296
297   SUBROUTINE bdytide_update ( kt, idx, dta, td, jit, time_offset )
298      !!----------------------------------------------------------------------
299      !!                 ***  SUBROUTINE bdytide_update  ***
300      !!               
301      !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
302      !!               
303      !!----------------------------------------------------------------------
304      INTEGER, INTENT( in )            ::   kt          ! Main timestep counter
305      TYPE(OBC_INDEX), INTENT( in )    ::   idx         ! OBC indices
306      TYPE(OBC_DATA),  INTENT(inout)   ::   dta         ! OBC external data
307      TYPE(TIDES_DATA),INTENT( inout ) ::   td          ! tidal harmonics data
308      INTEGER,INTENT(in),OPTIONAL      ::   jit         ! Barotropic timestep counter (for timesplitting option)
309      INTEGER,INTENT( in ), OPTIONAL   ::   time_offset ! time offset in units of timesteps. NB. if jit
310                                                        ! is present then units = subcycle timesteps.
311                                                        ! time_offset = 0  => get data at "now"    time level
312                                                        ! time_offset = -1 => get data at "before" time level
313                                                        ! time_offset = +1 => get data at "after"  time level
314                                                        ! etc.
315      !!
316      INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays)
317      INTEGER                          :: itide, igrd, ib   ! dummy loop indices
318      INTEGER                          :: time_add          ! time offset in units of timesteps
319      REAL(wp)                         :: z_arg, z_sarg, zflag, zramp     
320      REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost
321      !!----------------------------------------------------------------------
322
323      IF( nn_timing == 1 ) CALL timing_start('bdytide_update')
324
325      ilen0(1) =  SIZE(td%ssh(:,1,1))
326      ilen0(2) =  SIZE(td%u(:,1,1))
327      ilen0(3) =  SIZE(td%v(:,1,1))
328
329      zflag=1
330      IF ( PRESENT(jit) ) THEN
331        IF ( jit /= 1 ) zflag=0
332      ENDIF
333
334      IF ( nsec_day == NINT(0.5_wp * rdttra(1)) .AND. zflag==1 ) THEN
335        !
336        kt_tide = kt
337        !
338        IF(lwp) THEN
339           WRITE(numout,*)
340           WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=',kt
341           WRITE(numout,*) '~~~~~~~~~~~~~~ '
342        ENDIF
343        !
344        CALL tide_init_elevation ( idx, td )
345        CALL tide_init_velocities( idx, td )
346        !
347      ENDIF
348
349      time_add = 0
350      IF( PRESENT(time_offset) ) THEN
351         time_add = time_offset
352      ENDIF
353         
354      IF( PRESENT(jit) ) THEN 
355         z_arg = ((kt-kt_tide) * rdt + (jit+0.5_wp*(time_add-1)) * rdt / REAL(nn_baro,wp) )
356      ELSE                             
357         z_arg = ((kt-kt_tide)+time_add) * rdt
358      ENDIF
359
360      ! Linear ramp on tidal component at open boundaries
361      zramp = 1._wp
362      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*rdt)/(rdttideramp*rday),0._wp),1._wp)
363
364      DO itide = 1, nb_harmo
365         z_sarg = z_arg * omega_tide(itide)
366         z_cost(itide) = COS( z_sarg )
367         z_sist(itide) = SIN( z_sarg )
368      END DO
369
370      DO itide = 1, nb_harmo
371         igrd=1                              ! SSH on tracer grid
372         DO ib = 1, ilen0(igrd)
373            dta%ssh(ib) = dta%ssh(ib) + zramp*(td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide))
374         END DO
375         igrd=2                              ! U grid
376         DO ib = 1, ilen0(igrd)
377            dta%u2d(ib) = dta%u2d(ib) + zramp*(td%u  (ib,itide,1)*z_cost(itide) + td%u  (ib,itide,2)*z_sist(itide))
378         END DO
379         igrd=3                              ! V grid
380         DO ib = 1, ilen0(igrd) 
381            dta%v2d(ib) = dta%v2d(ib) + zramp*(td%v  (ib,itide,1)*z_cost(itide) + td%v  (ib,itide,2)*z_sist(itide))
382         END DO
383      END DO
384      !
385      IF( nn_timing == 1 ) CALL timing_stop('bdytide_update')
386      !
387   END SUBROUTINE bdytide_update
388
389   SUBROUTINE bdy_dta_tides( kt, kit, time_offset )
390      !!----------------------------------------------------------------------
391      !!                 ***  SUBROUTINE bdy_dta_tides  ***
392      !!               
393      !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
394      !!               
395      !!----------------------------------------------------------------------
396      INTEGER, INTENT( in )            ::   kt          ! Main timestep counter
397      INTEGER, INTENT( in ),OPTIONAL   ::   kit         ! Barotropic timestep counter (for timesplitting option)
398      INTEGER, INTENT( in ),OPTIONAL   ::   time_offset ! time offset in units of timesteps. NB. if kit
399                                                        ! is present then units = subcycle timesteps.
400                                                        ! time_offset = 0  => get data at "now"    time level
401                                                        ! time_offset = -1 => get data at "before" time level
402                                                        ! time_offset = +1 => get data at "after"  time level
403                                                        ! etc.
404      !!
405      LOGICAL  :: lk_first_btstp  ! =.TRUE. if time splitting and first barotropic step
406      INTEGER,          DIMENSION(jpbgrd) :: ilen0 
407      INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim  ! short cuts
408      INTEGER  :: itide, ib_bdy, ib, igrd                     ! loop indices
409      INTEGER  :: time_add                                    ! time offset in units of timesteps
410      REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist     
411      !!----------------------------------------------------------------------
412
413      IF( nn_timing == 1 ) CALL timing_start('bdy_dta_tides')
414
415      lk_first_btstp=.TRUE.
416      IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF
417
418      time_add = 0
419      IF( PRESENT(time_offset) ) THEN
420         time_add = time_offset
421      ENDIF
422     
423      ! Absolute time from model initialization:   
424      IF( PRESENT(kit) ) THEN 
425         z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt
426      ELSE                             
427         z_arg = ( kt + time_add ) * rdt
428      ENDIF
429
430      ! Linear ramp on tidal component at open boundaries
431      zramp = 1.
432      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - nit000*rdt)/(rdttideramp*rday),0.),1.)
433
434      DO ib_bdy = 1,nb_bdy
435
436         IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN
437
438            nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd)
439            nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd)
440
441            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN
442               ilen0(:)=nblen(:)
443            ELSE
444               ilen0(:)=nblenrim(:)
445            ENDIF     
446
447            ! We refresh nodal factors every day below
448            ! This should be done somewhere else
449            IF ( nsec_day == NINT(0.5_wp * rdttra(1)) .AND. lk_first_btstp ) THEN
450               !
451               kt_tide = kt               
452               !
453               IF(lwp) THEN
454               WRITE(numout,*)
455               WRITE(numout,*) 'bdy_tide_dta : Refresh nodal factors for tidal open bdy data at kt=',kt
456               WRITE(numout,*) '~~~~~~~~~~~~~~ '
457               ENDIF
458               !
459               CALL tide_init_elevation ( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
460               CALL tide_init_velocities( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
461               !
462            ENDIF
463            zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time
464            !
465            ! If time splitting, save data at first barotropic iteration
466            IF ( PRESENT(kit) ) THEN
467               IF ( lk_first_btstp ) THEN ! Save slow varying open boundary data:
468                  IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy(ib_bdy)%ssh(1:ilen0(1))
469                  IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy(ib_bdy)%u2d(1:ilen0(2))
470                  IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy(ib_bdy)%v2d(1:ilen0(3))
471
472               ELSE ! Initialize arrays from slow varying open boundary data:           
473                  IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1))
474                  IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2))
475                  IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3))
476               ENDIF
477            ENDIF
478            !
479            ! Update open boundary data arrays:
480            DO itide = 1, nb_harmo
481               !
482               z_sarg = (z_arg + zoff) * omega_tide(itide)
483               z_cost = zramp * COS( z_sarg )
484               z_sist = zramp * SIN( z_sarg )
485               !
486               IF ( dta_bdy(ib_bdy)%ll_ssh ) THEN
487                  igrd=1                              ! SSH on tracer grid
488                  DO ib = 1, ilen0(igrd)
489                     dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + &
490                        &                      ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + &
491                        &                        tides(ib_bdy)%ssh(ib,itide,2)*z_sist )
492                  END DO
493               ENDIF
494               !
495               IF ( dta_bdy(ib_bdy)%ll_u2d ) THEN
496                  igrd=2                              ! U grid
497                  DO ib = 1, ilen0(igrd)
498                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + &
499                        &                      ( tides(ib_bdy)%u(ib,itide,1)*z_cost + &
500                        &                        tides(ib_bdy)%u(ib,itide,2)*z_sist )
501                  END DO
502               ENDIF
503               !
504               IF ( dta_bdy(ib_bdy)%ll_v2d ) THEN
505                  igrd=3                              ! V grid
506                  DO ib = 1, ilen0(igrd) 
507                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + &
508                        &                      ( tides(ib_bdy)%v(ib,itide,1)*z_cost + &
509                        &                        tides(ib_bdy)%v(ib,itide,2)*z_sist )
510                  END DO
511               ENDIF
512            END DO             
513         END IF
514      END DO
515      !
516      IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_tides')
517      !
518   END SUBROUTINE bdy_dta_tides
519
520   SUBROUTINE tide_init_elevation( idx, td )
521      !!----------------------------------------------------------------------
522      !!                 ***  ROUTINE tide_init_elevation  ***
523      !!----------------------------------------------------------------------
524      TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices
525      TYPE(TIDES_DATA),INTENT( inout )   ::   td      ! tidal harmonics data
526      !! * Local declarations
527      INTEGER, DIMENSION(1)            ::   ilen0       !: length of boundary data (from OBC arrays)
528      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
529      INTEGER                            ::   itide, igrd, ib      ! dummy loop indices
530
531      igrd=1   
532                              ! SSH on tracer grid.
533   
534      ilen0(1) =  SIZE(td%ssh0(:,1,1))
535
536      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
537
538      DO itide = 1, nb_harmo
539         DO ib = 1, ilen0(igrd)
540            mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.)
541            phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
542         END DO
543         DO ib = 1 , ilen0(igrd)
544            mod_tide(ib)=mod_tide(ib)*ftide(itide)
545            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
546         ENDDO
547         DO ib = 1 , ilen0(igrd)
548            td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
549            td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
550         ENDDO
551      END DO
552
553      DEALLOCATE(mod_tide,phi_tide)
554
555   END SUBROUTINE tide_init_elevation
556
557   SUBROUTINE tide_init_velocities( idx, td )
558      !!----------------------------------------------------------------------
559      !!                 ***  ROUTINE tide_init_elevation  ***
560      !!----------------------------------------------------------------------
561      TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices
562      TYPE(TIDES_DATA),INTENT( inout )      ::   td      ! tidal harmonics data
563      !! * Local declarations
564      INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays)
565      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
566      INTEGER                            ::   itide, igrd, ib      ! dummy loop indices
567
568      ilen0(2) =  SIZE(td%u0(:,1,1))
569      ilen0(3) =  SIZE(td%v0(:,1,1))
570
571      igrd=2                                 ! U grid.
572
573      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
574
575      DO itide = 1, nb_harmo
576         DO ib = 1, ilen0(igrd)
577            mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.)
578            phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
579         END DO
580         DO ib = 1, ilen0(igrd)
581            mod_tide(ib)=mod_tide(ib)*ftide(itide)
582            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
583         ENDDO
584         DO ib = 1, ilen0(igrd)
585            td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
586            td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
587         ENDDO
588      END DO
589
590      DEALLOCATE(mod_tide,phi_tide)
591
592      igrd=3                                 ! V grid.
593
594      ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
595
596      DO itide = 1, nb_harmo
597         DO ib = 1, ilen0(igrd)
598            mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.)
599            phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
600         END DO
601         DO ib = 1, ilen0(igrd)
602            mod_tide(ib)=mod_tide(ib)*ftide(itide)
603            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
604         ENDDO
605         DO ib = 1, ilen0(igrd)
606            td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
607            td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
608         ENDDO
609      END DO
610
611      DEALLOCATE(mod_tide,phi_tide)
612
613  END SUBROUTINE tide_init_velocities
614
615  SUBROUTINE tide_namelist(cd_filtide)
616     !!---------------------------------------------------------------------
617     !!                   ***  ROUTINE tide_namelist  ***
618     !!                     
619     !! ** Purpose :   Broadcast namelist variables read by procesor lwm
620     !!
621     !! ** Method  :   use lib_mpp
622     !!----------------------------------------------------------------------
623     CHARACTER(len=80)                         ::   cd_filtide
624#if defined key_mpp_mpi
625      CALL mpp_bcast(cd_filtide, 80)
626      CALL mpp_bcast(ln_bdytide_2ddta)
627      CALL mpp_bcast(ln_bdytide_conj
628#endif
629  END SUBROUTINE tide_namelist
630
631#else
632   !!----------------------------------------------------------------------
633   !!   Dummy module         NO Unstruct Open Boundary Conditions for tides
634   !!----------------------------------------------------------------------
635CONTAINS
636   SUBROUTINE bdytide_init             ! Empty routine
637      WRITE(*,*) 'bdytide_init: You should not have seen this print! error?'
638   END SUBROUTINE bdytide_init
639   SUBROUTINE bdytide_update( kt, jit )   ! Empty routine
640      WRITE(*,*) 'bdytide_update: You should not have seen this print! error?', kt, jit
641   END SUBROUTINE bdytide_update
642   SUBROUTINE bdy_dta_tides( kt, kit, time_offset )     ! Empty routine
643      INTEGER, INTENT( in )            ::   kt          ! Dummy argument empty routine     
644      INTEGER, INTENT( in ),OPTIONAL   ::   kit         ! Dummy argument empty routine
645      INTEGER, INTENT( in ),OPTIONAL   ::   time_offset ! Dummy argument empty routine
646      WRITE(*,*) 'bdy_dta_tides: You should not have seen this print! error?', kt, jit
647   END SUBROUTINE bdy_dta_tides
648#endif
649
650   !!======================================================================
651END MODULE bdytides
652
Note: See TracBrowser for help on using the repository browser.