Context Navigation

bdytides.F90 @ 9383

Last change on this file since 9383 was 9383, checked in by andmirek, 6 years ago
#2050 fixes and changes
File size: 30.6 KB

Line
1	MODULE 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	!!----------------------------------------------------------------------
64	CONTAINS
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)
119	901 CONTINUE
120	ENDIF
121	call mpp_bcast(ios)
122	IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in reference namelist', lwp )
123	IF(lwm) THEN
124	READ ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 )
125	902 CONTINUE
126	ENDIF
127	call mpp_bcast(ios)
128	IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist', lwp )
129
130	IF(lwm) WRITE ( numond, nambdy_tide )
131
132	CALL tide_namelist(filtide)
133
134	! ! Parameter control and print
135	IF(lwp) WRITE(numout,*) ' '
136	IF(lwp) WRITE(numout,*) ' Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
137	IF(lwp) WRITE(numout,*) ' read tidal data in 2d files: ', ln_bdytide_2ddta
138	IF(lwp) WRITE(numout,*) ' assume complex conjugate : ', ln_bdytide_conj
139	IF(lwp) WRITE(numout,*) ' Number of tidal components to read: ', nb_harmo
140	IF(lwp) THEN
141	WRITE(numout,*) ' Tidal components: '
142	DO itide = 1, nb_harmo
143	WRITE(numout,*) ' ', Wave(ntide(itide))%cname_tide
144	END DO
145	ENDIF
146	IF(lwp) WRITE(numout,*) ' '
147
148	! Allocate space for tidal harmonics data - get size from OBC data arrays
149	! -----------------------------------------------------------------------
150
151	! JC: If FRS scheme is used, we assume that tidal is needed over the whole
152	! relaxation area
153	IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN
154	ilen0(:)=nblen(:)
155	ELSE
156	ilen0(:)=nblenrim(:)
157	ENDIF
158
159	ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) )
160	ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) )
161
162	ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) )
163	ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) )
164
165	ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) )
166	ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) )
167
168	td%ssh0(:,:,:) = 0._wp
169	td%ssh (:,:,:) = 0._wp
170	td%u0 (:,:,:) = 0._wp
171	td%u (:,:,:) = 0._wp
172	td%v0 (:,:,:) = 0._wp
173	td%v (:,:,:) = 0._wp
174
175	IF (ln_bdytide_2ddta) THEN
176	! It is assumed that each data file contains all complex harmonic amplitudes
177	! given on the data domain (ie global, jpidta x jpjdta)
178	!
179	CALL wrk_alloc( jpi, jpj, zti, ztr )
180	!
181	! SSH fields
182	clfile = TRIM(filtide)//'_grid_T.nc'
183	CALL iom_open (clfile , inum )
184	igrd = 1 ! Everything is at T-points here
185	DO itide = 1, nb_harmo
186	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )
187	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )
188	DO ib = 1, ilen0(igrd)
189	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
190	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
191	td%ssh0(ib,itide,1) = ztr(ii,ij)
192	td%ssh0(ib,itide,2) = zti(ii,ij)
193	END DO
194	END DO
195	CALL iom_close( inum )
196	!
197	! U fields
198	clfile = TRIM(filtide)//'_grid_U.nc'
199	CALL iom_open (clfile , inum )
200	igrd = 2 ! Everything is at U-points here
201	DO itide = 1, nb_harmo
202	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) )
203	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) )
204	DO ib = 1, ilen0(igrd)
205	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
206	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
207	td%u0(ib,itide,1) = ztr(ii,ij)
208	td%u0(ib,itide,2) = zti(ii,ij)
209	END DO
210	END DO
211	CALL iom_close( inum )
212	!
213	! V fields
214	clfile = TRIM(filtide)//'_grid_V.nc'
215	CALL iom_open (clfile , inum )
216	igrd = 3 ! Everything is at V-points here
217	DO itide = 1, nb_harmo
218	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) )
219	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) )
220	DO ib = 1, ilen0(igrd)
221	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
222	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
223	td%v0(ib,itide,1) = ztr(ii,ij)
224	td%v0(ib,itide,2) = zti(ii,ij)
225	END DO
226	END DO
227	CALL iom_close( inum )
228	!
229	CALL wrk_dealloc( jpi, jpj, ztr, zti )
230	!
231	ELSE
232	!
233	! Read tidal data only on bdy segments
234	!
235	ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) )
236	!
237	! Set map structure
238	ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1)
239	ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy)
240	ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2)
241	ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy)
242	ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3)
243	ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy)
244
245	! Open files and read in tidal forcing data
246	! -----------------------------------------
247
248	DO itide = 1, nb_harmo
249	! ! SSH fields
250	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc'
251	CALL iom_open( clfile, inum )
252	CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, ibmap_ptr(1) )
253	td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1)
254	CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, ibmap_ptr(1) )
255	td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1)
256	CALL iom_close( inum )
257	! ! U fields
258	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc'
259	CALL iom_open( clfile, inum )
260	CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) )
261	td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1)
262	CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) )
263	td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1)
264	CALL iom_close( inum )
265	! ! V fields
266	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc'
267	CALL iom_open( clfile, inum )
268	CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) )
269	td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1)
270	CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) )
271	td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1)
272	CALL iom_close( inum )
273	!
274	END DO ! end loop on tidal components
275	!
276	DEALLOCATE( dta_read )
277	ENDIF ! ln_bdytide_2ddta=.true.
278	!
279	IF ( ln_bdytide_conj ) THEN ! assume complex conjugate in data files
280	td%ssh0(:,:,2) = - td%ssh0(:,:,2)
281	td%u0 (:,:,2) = - td%u0 (:,:,2)
282	td%v0 (:,:,2) = - td%v0 (:,:,2)
283	ENDIF
284	!
285	IF ( lk_dynspg_ts ) THEN ! Allocate arrays to save slowly varying boundary data during
286	! time splitting integration
287	ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) )
288	ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) )
289	ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) )
290	dta_bdy_s(ib_bdy)%ssh(:) = 0.e0
291	dta_bdy_s(ib_bdy)%u2d(:) = 0.e0
292	dta_bdy_s(ib_bdy)%v2d(:) = 0.e0
293	ENDIF
294	!
295	ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2
296	!
297	END DO ! loop on ib_bdy
298
299	IF( nn_timing == 1 ) CALL timing_stop('bdytide_init')
300
301	END SUBROUTINE bdytide_init
302
303	SUBROUTINE bdytide_update ( kt, idx, dta, td, jit, time_offset )
304	!!----------------------------------------------------------------------
305	!! * SUBROUTINE bdytide_update *
306	!!
307	!! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
308	!!
309	!!----------------------------------------------------------------------
310	INTEGER, INTENT( in ) :: kt ! Main timestep counter
311	TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices
312	TYPE(OBC_DATA), INTENT(inout) :: dta ! OBC external data
313	TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data
314	INTEGER,INTENT(in),OPTIONAL :: jit ! Barotropic timestep counter (for timesplitting option)
315	INTEGER,INTENT( in ), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit
316	! is present then units = subcycle timesteps.
317	! time_offset = 0 => get data at "now" time level
318	! time_offset = -1 => get data at "before" time level
319	! time_offset = +1 => get data at "after" time level
320	! etc.
321	!!
322	INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays)
323	INTEGER :: itide, igrd, ib ! dummy loop indices
324	INTEGER :: time_add ! time offset in units of timesteps
325	REAL(wp) :: z_arg, z_sarg, zflag, zramp
326	REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost
327	!!----------------------------------------------------------------------
328
329	IF( nn_timing == 1 ) CALL timing_start('bdytide_update')
330
331	ilen0(1) = SIZE(td%ssh(:,1,1))
332	ilen0(2) = SIZE(td%u(:,1,1))
333	ilen0(3) = SIZE(td%v(:,1,1))
334
335	zflag=1
336	IF ( PRESENT(jit) ) THEN
337	IF ( jit /= 1 ) zflag=0
338	ENDIF
339
340	IF ( nsec_day == NINT(0.5_wp * rdttra(1)) .AND. zflag==1 ) THEN
341	!
342	kt_tide = kt
343	!
344	IF(lwp) THEN
345	WRITE(numout,*)
346	WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=',kt
347	WRITE(numout,*) '~~~~~~~~~~~~~~ '
348	ENDIF
349	!
350	CALL tide_init_elevation ( idx, td )
351	CALL tide_init_velocities( idx, td )
352	!
353	ENDIF
354
355	time_add = 0
356	IF( PRESENT(time_offset) ) THEN
357	time_add = time_offset
358	ENDIF
359
360	IF( PRESENT(jit) ) THEN
361	z_arg = ((kt-kt_tide) * rdt + (jit+0.5_wp(time_add-1)) rdt / REAL(nn_baro,wp) )
362	ELSE
363	z_arg = ((kt-kt_tide)+time_add) * rdt
364	ENDIF
365
366	! Linear ramp on tidal component at open boundaries
367	zramp = 1._wp
368	IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)rdt)/(rdttideramprday),0._wp),1._wp)
369
370	DO itide = 1, nb_harmo
371	z_sarg = z_arg * omega_tide(itide)
372	z_cost(itide) = COS( z_sarg )
373	z_sist(itide) = SIN( z_sarg )
374	END DO
375
376	DO itide = 1, nb_harmo
377	igrd=1 ! SSH on tracer grid
378	DO ib = 1, ilen0(igrd)
379	dta%ssh(ib) = dta%ssh(ib) + zramp(td%ssh(ib,itide,1)z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide))
380	END DO
381	igrd=2 ! U grid
382	DO ib = 1, ilen0(igrd)
383	dta%u2d(ib) = dta%u2d(ib) + zramp(td%u (ib,itide,1)z_cost(itide) + td%u (ib,itide,2)*z_sist(itide))
384	END DO
385	igrd=3 ! V grid
386	DO ib = 1, ilen0(igrd)
387	dta%v2d(ib) = dta%v2d(ib) + zramp(td%v (ib,itide,1)z_cost(itide) + td%v (ib,itide,2)*z_sist(itide))
388	END DO
389	END DO
390	!
391	IF( nn_timing == 1 ) CALL timing_stop('bdytide_update')
392	!
393	END SUBROUTINE bdytide_update
394
395	SUBROUTINE bdy_dta_tides( kt, kit, time_offset )
396	!!----------------------------------------------------------------------
397	!! * SUBROUTINE bdy_dta_tides *
398	!!
399	!! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
400	!!
401	!!----------------------------------------------------------------------
402	INTEGER, INTENT( in ) :: kt ! Main timestep counter
403	INTEGER, INTENT( in ),OPTIONAL :: kit ! Barotropic timestep counter (for timesplitting option)
404	INTEGER, INTENT( in ),OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if kit
405	! is present then units = subcycle timesteps.
406	! time_offset = 0 => get data at "now" time level
407	! time_offset = -1 => get data at "before" time level
408	! time_offset = +1 => get data at "after" time level
409	! etc.
410	!!
411	LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step
412	INTEGER, DIMENSION(jpbgrd) :: ilen0
413	INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim ! short cuts
414	INTEGER :: itide, ib_bdy, ib, igrd ! loop indices
415	INTEGER :: time_add ! time offset in units of timesteps
416	REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist
417	!!----------------------------------------------------------------------
418
419	IF( nn_timing == 1 ) CALL timing_start('bdy_dta_tides')
420
421	lk_first_btstp=.TRUE.
422	IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF
423
424	time_add = 0
425	IF( PRESENT(time_offset) ) THEN
426	time_add = time_offset
427	ENDIF
428
429	! Absolute time from model initialization:
430	IF( PRESENT(kit) ) THEN
431	z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt
432	ELSE
433	z_arg = ( kt + time_add ) * rdt
434	ENDIF
435
436	! Linear ramp on tidal component at open boundaries
437	zramp = 1.
438	IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - nit000rdt)/(rdttideramprday),0.),1.)
439
440	DO ib_bdy = 1,nb_bdy
441
442	IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN
443
444	nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd)
445	nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd)
446
447	IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN
448	ilen0(:)=nblen(:)
449	ELSE
450	ilen0(:)=nblenrim(:)
451	ENDIF
452
453	! We refresh nodal factors every day below
454	! This should be done somewhere else
455	IF ( nsec_day == NINT(0.5_wp * rdttra(1)) .AND. lk_first_btstp ) THEN
456	!
457	kt_tide = kt
458	!
459	IF(lwp) THEN
460	WRITE(numout,*)
461	WRITE(numout,*) 'bdy_tide_dta : Refresh nodal factors for tidal open bdy data at kt=',kt
462	WRITE(numout,*) '~~~~~~~~~~~~~~ '
463	ENDIF
464	!
465	CALL tide_init_elevation ( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
466	CALL tide_init_velocities( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
467	!
468	ENDIF
469	zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time
470	!
471	! If time splitting, save data at first barotropic iteration
472	IF ( PRESENT(kit) ) THEN
473	IF ( lk_first_btstp ) THEN ! Save slow varying open boundary data:
474	IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy(ib_bdy)%ssh(1:ilen0(1))
475	IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy(ib_bdy)%u2d(1:ilen0(2))
476	IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy(ib_bdy)%v2d(1:ilen0(3))
477
478	ELSE ! Initialize arrays from slow varying open boundary data:
479	IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1))
480	IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2))
481	IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3))
482	ENDIF
483	ENDIF
484	!
485	! Update open boundary data arrays:
486	DO itide = 1, nb_harmo
487	!
488	z_sarg = (z_arg + zoff) * omega_tide(itide)
489	z_cost = zramp * COS( z_sarg )
490	z_sist = zramp * SIN( z_sarg )
491	!
492	IF ( dta_bdy(ib_bdy)%ll_ssh ) THEN
493	igrd=1 ! SSH on tracer grid
494	DO ib = 1, ilen0(igrd)
495	dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + &
496	& ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + &
497	& tides(ib_bdy)%ssh(ib,itide,2)*z_sist )
498	END DO
499	ENDIF
500	!
501	IF ( dta_bdy(ib_bdy)%ll_u2d ) THEN
502	igrd=2 ! U grid
503	DO ib = 1, ilen0(igrd)
504	dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + &
505	& ( tides(ib_bdy)%u(ib,itide,1)*z_cost + &
506	& tides(ib_bdy)%u(ib,itide,2)*z_sist )
507	END DO
508	ENDIF
509	!
510	IF ( dta_bdy(ib_bdy)%ll_v2d ) THEN
511	igrd=3 ! V grid
512	DO ib = 1, ilen0(igrd)
513	dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + &
514	& ( tides(ib_bdy)%v(ib,itide,1)*z_cost + &
515	& tides(ib_bdy)%v(ib,itide,2)*z_sist )
516	END DO
517	ENDIF
518	END DO
519	END IF
520	END DO
521	!
522	IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_tides')
523	!
524	END SUBROUTINE bdy_dta_tides
525
526	SUBROUTINE tide_init_elevation( idx, td )
527	!!----------------------------------------------------------------------
528	!! * ROUTINE tide_init_elevation *
529	!!----------------------------------------------------------------------
530	TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices
531	TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data
532	!! * Local declarations
533	INTEGER, DIMENSION(1) :: ilen0 !: length of boundary data (from OBC arrays)
534	REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide
535	INTEGER :: itide, igrd, ib ! dummy loop indices
536
537	igrd=1
538	! SSH on tracer grid.
539
540	ilen0(1) = SIZE(td%ssh0(:,1,1))
541
542	ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
543
544	DO itide = 1, nb_harmo
545	DO ib = 1, ilen0(igrd)
546	mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)2.+td%ssh0(ib,itide,2)2.)
547	phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
548	END DO
549	DO ib = 1 , ilen0(igrd)
550	mod_tide(ib)=mod_tide(ib)*ftide(itide)
551	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
552	ENDDO
553	DO ib = 1 , ilen0(igrd)
554	td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
555	td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
556	ENDDO
557	END DO
558
559	DEALLOCATE(mod_tide,phi_tide)
560
561	END SUBROUTINE tide_init_elevation
562
563	SUBROUTINE tide_init_velocities( idx, td )
564	!!----------------------------------------------------------------------
565	!! * ROUTINE tide_init_elevation *
566	!!----------------------------------------------------------------------
567	TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices
568	TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data
569	!! * Local declarations
570	INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays)
571	REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide
572	INTEGER :: itide, igrd, ib ! dummy loop indices
573
574	ilen0(2) = SIZE(td%u0(:,1,1))
575	ilen0(3) = SIZE(td%v0(:,1,1))
576
577	igrd=2 ! U grid.
578
579	ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
580
581	DO itide = 1, nb_harmo
582	DO ib = 1, ilen0(igrd)
583	mod_tide(ib)=SQRT(td%u0(ib,itide,1)2.+td%u0(ib,itide,2)2.)
584	phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
585	END DO
586	DO ib = 1, ilen0(igrd)
587	mod_tide(ib)=mod_tide(ib)*ftide(itide)
588	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
589	ENDDO
590	DO ib = 1, ilen0(igrd)
591	td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
592	td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
593	ENDDO
594	END DO
595
596	DEALLOCATE(mod_tide,phi_tide)
597
598	igrd=3 ! V grid.
599
600	ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
601
602	DO itide = 1, nb_harmo
603	DO ib = 1, ilen0(igrd)
604	mod_tide(ib)=SQRT(td%v0(ib,itide,1)2.+td%v0(ib,itide,2)2.)
605	phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
606	END DO
607	DO ib = 1, ilen0(igrd)
608	mod_tide(ib)=mod_tide(ib)*ftide(itide)
609	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
610	ENDDO
611	DO ib = 1, ilen0(igrd)
612	td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
613	td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
614	ENDDO
615	END DO
616
617	DEALLOCATE(mod_tide,phi_tide)
618
619	END SUBROUTINE tide_init_velocities
620
621	SUBROUTINE tide_namelist(cd_filtide)
622	!!---------------------------------------------------------------------
623	!! * ROUTINE tide_namelist *
624	!!
625	!! ** Purpose : Broadcast namelist variables read by procesor lwm
626	!!
627	!! ** Method : use lib_mpp
628	!!----------------------------------------------------------------------
629	CHARACTER(len=80) :: cd_filtide
630	#if defined key_mpp_mpi
631	CALL mpp_bcast(cd_filtide, 80)
632	CALL mpp_bcast(ln_bdytide_2ddta)
633	CALL mpp_bcast(ln_bdytide_conj
634	#endif
635	END SUBROUTINE tide_namelist
636
637	#else
638	!!----------------------------------------------------------------------
639	!! Dummy module NO Unstruct Open Boundary Conditions for tides
640	!!----------------------------------------------------------------------
641	CONTAINS
642	SUBROUTINE bdytide_init ! Empty routine
643	WRITE(,) 'bdytide_init: You should not have seen this print! error?'
644	END SUBROUTINE bdytide_init
645	SUBROUTINE bdytide_update( kt, jit ) ! Empty routine
646	WRITE(,) 'bdytide_update: You should not have seen this print! error?', kt, jit
647	END SUBROUTINE bdytide_update
648	SUBROUTINE bdy_dta_tides( kt, kit, time_offset ) ! Empty routine
649	INTEGER, INTENT( in ) :: kt ! Dummy argument empty routine
650	INTEGER, INTENT( in ),OPTIONAL :: kit ! Dummy argument empty routine
651	INTEGER, INTENT( in ),OPTIONAL :: time_offset ! Dummy argument empty routine
652	WRITE(,) 'bdy_dta_tides: You should not have seen this print! error?', kt, jit
653	END SUBROUTINE bdy_dta_tides
654	#endif
655
656	!!======================================================================
657	END MODULE bdytides
658

Note: See TracBrowser for help on using the repository browser.

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

Context Navigation

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

Download in other formats: