Context Navigation

bdytides.F90 @ 15688

Last change on this file since 15688 was 15688, checked in by hadjt, 2 years ago

Bug Fix Juan Castillo's tide fix had an additional change (which I also implemented), which seemed to cause a crash.

This removed the additional change

File size: 28.0 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	!! bdytide_init : read of namelist and initialisation of tidal harmonics data
14	!! tide_update : calculation of tidal forcing at each timestep
15	!!----------------------------------------------------------------------
16	USE oce ! ocean dynamics and tracers
17	USE dom_oce ! ocean space and time domain
18	USE phycst ! physical constants
19	USE bdy_oce ! ocean open boundary conditions
20	USE tideini !
21	USE daymod ! calendar
22	!
23	USE in_out_manager ! I/O units
24	USE iom ! xIO server
25	USE fldread !
26	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
27
28	IMPLICIT NONE
29	PRIVATE
30
31	PUBLIC bdytide_init ! routine called in bdy_init
32	PUBLIC bdytide_update ! routine called in bdy_dta
33	PUBLIC bdy_dta_tides ! routine called in dyn_spg_ts
34
35	TYPE, PUBLIC :: TIDES_DATA !: Storage for external tidal harmonics data
36	REAL(wp), POINTER, DIMENSION(:,:,:) :: ssh0 !: Tidal constituents : SSH0 (read in file)
37	REAL(wp), POINTER, DIMENSION(:,:,:) :: u0, v0 !: Tidal constituents : U0, V0 (read in file)
38	REAL(wp), POINTER, DIMENSION(:,:,:) :: ssh !: Tidal constituents : SSH (after nodal cor.)
39	REAL(wp), POINTER, DIMENSION(:,:,:) :: u , v !: Tidal constituents : U , V (after nodal cor.)
40	END TYPE TIDES_DATA
41
42	!$AGRIF_DO_NOT_TREAT
43	TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides !: External tidal harmonics data
44	!$AGRIF_END_DO_NOT_TREAT
45	TYPE(OBC_DATA) , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s !: bdy external data (slow component)
46
47	!!----------------------------------------------------------------------
48	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
49	!! $Id$
50	!! Software governed by the CeCILL license (see ./LICENSE)
51	!!----------------------------------------------------------------------
52	CONTAINS
53
54	SUBROUTINE bdytide_init
55	!!----------------------------------------------------------------------
56	!! * SUBROUTINE bdytide_init *
57	!!
58	!! ** Purpose : - Read in namelist for tides and initialise external
59	!! tidal harmonics data
60	!!
61	!!----------------------------------------------------------------------
62	!! namelist variables
63	!!-------------------
64	CHARACTER(len=80) :: filtide ! Filename root for tidal input files
65	LOGICAL :: ln_bdytide_2ddta ! If true, read 2d harmonic data
66	LOGICAL :: ln_bdytide_conj ! If true, assume complex conjugate tidal data
67	!!
68	INTEGER :: ib_bdy, itide, ib ! dummy loop indices
69	INTEGER :: ii, ij ! dummy loop indices
70	INTEGER :: inum, igrd
71	INTEGER, DIMENSION(3) :: ilen0 ! length of boundary data (from OBC arrays)
72	INTEGER :: ios ! Local integer output status for namelist read
73	CHARACTER(len=80) :: clfile ! full file name for tidal input file
74	REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read ! work space to read in tidal harmonics data
75	REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: ztr, zti ! " " " " " " " "
76	!!
77	TYPE(TIDES_DATA), POINTER :: td ! local short cut
78	TYPE( OBC_DATA), POINTER :: dta ! local short cut
79	!!
80	NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
81	!!----------------------------------------------------------------------
82	!
83	IF(lwp) WRITE(numout,*)
84	IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries'
85	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
86
87	REWIND(numnam_cfg)
88
89	DO ib_bdy = 1, nb_bdy
90	IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN
91	!
92	td => tides(ib_bdy)
93	dta => dta_bdy(ib_bdy)
94
95	! Namelist nambdy_tide : tidal harmonic forcing at open boundaries
96	filtide(:) = ''
97
98	REWIND( numnam_ref )
99	READ ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901)
100	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in reference namelist' )
101	! Don't REWIND here - may need to read more than one of these namelists.
102	READ ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 )
103	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist' )
104	IF(lwm) WRITE ( numond, nambdy_tide )
105	! ! Parameter control and print
106	IF(lwp) WRITE(numout,*) ' '
107	IF(lwp) WRITE(numout,*) ' Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
108	IF(lwp) WRITE(numout,*) ' read tidal data in 2d files: ', ln_bdytide_2ddta
109	IF(lwp) WRITE(numout,*) ' assume complex conjugate : ', ln_bdytide_conj
110	IF(lwp) WRITE(numout,*) ' Number of tidal components to read: ', nb_harmo
111	IF(lwp) THEN
112	WRITE(numout,*) ' Tidal components: '
113	DO itide = 1, nb_harmo
114	WRITE(numout,*) ' ', Wave(ntide(itide))%cname_tide
115	END DO
116	ENDIF
117	IF(lwp) WRITE(numout,*) ' '
118
119	! If FRS scheme is used, we assume that tidal is needed over the whole relaxation area
120	IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN ; ilen0(:) = idx_bdy(ib_bdy)%nblen (:)
121	ELSE ; ilen0(:) = idx_bdy(ib_bdy)%nblenrim(:)
122	ENDIF
123
124	! Allocate space for tidal harmonics data - get size from BDY data arrays
125	! Allocate also slow varying data in the case of time splitting:
126	! Do it anyway because at this stage knowledge of free surface scheme is unknown
127	! -----------------------------------------------------------------------
128	IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain
129	!IF(lwp) WRITE(numout,*) ' nambdy_tide bdytides.F90 JCastillo Tide Update SSH: ', ilen0(1), SIZE(dta%ssh)
130	ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ), td%ssh( ilen0(1), nb_harmo, 2 ), dta_bdy_s(ib_bdy)%ssh( ilen0(1) ) )
131	dta_bdy_s(ib_bdy)%ssh(:) = 0._wp ! needed?
132	ENDIF
133	IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain
134	!IF(lwp) WRITE(numout,*) ' nambdy_tide bdytides.F90 JCastillo Tide Update U: ', ilen0(2), SIZE(dta%u2d)
135	ALLOCATE( td%u0 ( ilen0(2), nb_harmo, 2 ), td%u ( ilen0(2), nb_harmo, 2 ), dta_bdy_s(ib_bdy)%u2d( ilen0(2) ) )
136	dta_bdy_s(ib_bdy)%u2d(:) = 0._wp ! needed?
137	ENDIF
138	IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain
139	!IF(lwp) WRITE(numout,*) ' nambdy_tide bdytides.F90 JCastillo Tide Update V: ', ilen0(3), SIZE(dta%v2d)
140	ALLOCATE( td%v0 ( ilen0(3), nb_harmo, 2 ), td%v ( ilen0(3), nb_harmo, 2 ), dta_bdy_s(ib_bdy)%v2d( ilen0(3) ) )
141	dta_bdy_s(ib_bdy)%v2d(:) = 0._wp ! needed?
142	ENDIF
143
144	! fill td%ssh0, td%u0, td%v0
145	! -----------------------------------------------------------------------
146	IF( ln_bdytide_2ddta ) THEN
147	!
148	! It is assumed that each data file contains all complex harmonic amplitudes
149	! given on the global domain (ie global, jpiglo x jpjglo)
150	!
151	ALLOCATE( zti(jpi,jpj), ztr(jpi,jpj) )
152	!
153	! SSH fields
154	clfile = TRIM(filtide)//'_grid_T.nc'
155	CALL iom_open( clfile , inum )
156	igrd = 1 ! Everything is at T-points here
157	DO itide = 1, nb_harmo
158	CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )
159	CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )
160	IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain
161	DO ib = 1, SIZE(dta%ssh)
162	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
163	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
164	td%ssh0(ib,itide,1) = ztr(ii,ij)
165	td%ssh0(ib,itide,2) = zti(ii,ij)
166	END DO
167	ENDIF
168	END DO
169	CALL iom_close( inum )
170	!
171	! U fields
172	clfile = TRIM(filtide)//'_grid_U.nc'
173	CALL iom_open( clfile , inum )
174	igrd = 2 ! Everything is at U-points here
175	DO itide = 1, nb_harmo
176	CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) )
177	CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) )
178	IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain
179	DO ib = 1, SIZE(dta%u2d)
180	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
181	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
182	td%u0(ib,itide,1) = ztr(ii,ij)
183	td%u0(ib,itide,2) = zti(ii,ij)
184	END DO
185	END IF
186	END DO
187	CALL iom_close( inum )
188	!
189	! V fields
190	clfile = TRIM(filtide)//'_grid_V.nc'
191	CALL iom_open( clfile , inum )
192	igrd = 3 ! Everything is at V-points here
193	DO itide = 1, nb_harmo
194	CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) )
195	CALL iom_get ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) )
196	IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain
197	DO ib = 1, SIZE(dta%v2d)
198	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
199	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
200	td%v0(ib,itide,1) = ztr(ii,ij)
201	td%v0(ib,itide,2) = zti(ii,ij)
202	END DO
203	END IF
204	END DO
205	CALL iom_close( inum )
206	!
207	DEALLOCATE( ztr, zti )
208	!
209	ELSE
210	!
211	! Read tidal data only on bdy segments
212	!
213	ALLOCATE( dta_read( MAXVAL( idx_bdy(ib_bdy)%nblen(:) ), 1, 1 ) )
214	!
215	! Open files and read in tidal forcing data
216	! -----------------------------------------
217
218	DO itide = 1, nb_harmo
219	! ! SSH fields
220	IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain
221	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc'
222	CALL iom_open( clfile, inum )
223	CALL fld_map( inum, 'z1', dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
224	td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1)
225	CALL fld_map( inum, 'z2', dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
226	td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1)
227	CALL iom_close( inum )
228	ENDIF
229	! ! U fields
230	IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain
231	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc'
232	CALL iom_open( clfile, inum )
233	CALL fld_map( inum, 'u1', dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
234	td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1)
235	CALL fld_map( inum, 'u2', dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
236	td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1)
237	CALL iom_close( inum )
238	ENDIF
239	! ! V fields
240	IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain
241	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc'
242	CALL iom_open( clfile, inum )
243	CALL fld_map( inum, 'v1', dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
244	td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1)
245	CALL fld_map( inum, 'v2', dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
246	td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1)
247	CALL iom_close( inum )
248	ENDIF
249	!
250	END DO ! end loop on tidal components
251	!
252	DEALLOCATE( dta_read )
253	!
254	ENDIF ! ln_bdytide_2ddta=.true.
255	!
256	IF( ln_bdytide_conj ) THEN ! assume complex conjugate in data files
257	IF( ASSOCIATED(dta%ssh) ) td%ssh0(:,:,2) = - td%ssh0(:,:,2)
258	IF( ASSOCIATED(dta%u2d) ) td%u0 (:,:,2) = - td%u0 (:,:,2)
259	IF( ASSOCIATED(dta%v2d) ) td%v0 (:,:,2) = - td%v0 (:,:,2)
260	ENDIF
261	!
262	ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2
263	!
264	END DO ! loop on ib_bdy
265	!
266	END SUBROUTINE bdytide_init
267
268
269	SUBROUTINE bdytide_update( kt, idx, dta, td, kit, kt_offset )
270	!!----------------------------------------------------------------------
271	!! * SUBROUTINE bdytide_update *
272	!!
273	!! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
274	!!
275	!!----------------------------------------------------------------------
276	INTEGER , INTENT(in ) :: kt ! Main timestep counter
277	TYPE(OBC_INDEX) , INTENT(in ) :: idx ! OBC indices
278	TYPE(OBC_DATA) , INTENT(inout) :: dta ! OBC external data
279	TYPE(TIDES_DATA) , INTENT(inout) :: td ! tidal harmonics data
280	INTEGER, OPTIONAL, INTENT(in ) :: kit ! Barotropic timestep counter (for timesplitting option)
281	INTEGER, OPTIONAL, INTENT(in ) :: kt_offset ! time offset in units of timesteps. NB. if kit
282	! ! is present then units = subcycle timesteps.
283	! ! kt_offset = 0 => get data at "now" time level
284	! ! kt_offset = -1 => get data at "before" time level
285	! ! kt_offset = +1 => get data at "after" time level
286	! ! etc.
287	!
288	INTEGER :: itide, ib ! dummy loop indices
289	INTEGER :: time_add ! time offset in units of timesteps
290	INTEGER :: isz ! bdy data size
291	REAL(wp) :: z_arg, z_sarg, zflag, zramp ! local scalars
292	REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost
293	!!----------------------------------------------------------------------
294	!
295	zflag=1
296	IF ( PRESENT(kit) ) THEN
297	IF ( kit /= 1 ) zflag=0
298	ENDIF
299	!
300	IF ( (nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000) .AND. zflag==1 ) THEN
301	!
302	kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
303	!
304	IF(lwp) THEN
305	WRITE(numout,*)
306	WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=',kt
307	WRITE(numout,*) '~~~~~~~~~~~~~~ '
308	ENDIF
309	!
310	CALL tide_init_elevation ( idx, td )
311	CALL tide_init_velocities( idx, td )
312	!
313	ENDIF
314
315	time_add = 0
316	IF( PRESENT(kt_offset) ) THEN
317	time_add = kt_offset
318	ENDIF
319
320	IF( PRESENT(kit) ) THEN
321	z_arg = ((kt-kt_tide) * rdt + (kit+0.5_wp(time_add-1)) rdt / REAL(nn_baro,wp) )
322	ELSE
323	z_arg = ((kt-kt_tide)+time_add) * rdt
324	ENDIF
325
326	! Linear ramp on tidal component at open boundaries
327	zramp = 1._wp
328	IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)rdt)/(rdttideramprday),0._wp),1._wp)
329
330	DO itide = 1, nb_harmo
331	z_sarg = z_arg * omega_tide(itide)
332	z_cost(itide) = COS( z_sarg )
333	z_sist(itide) = SIN( z_sarg )
334	END DO
335
336	DO itide = 1, nb_harmo
337	! SSH on tracer grid
338	IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain
339	DO ib = 1, SIZE(dta%ssh)
340	dta%ssh(ib) = dta%ssh(ib) + zramp(td%ssh(ib,itide,1)z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide))
341	END DO
342	ENDIF
343	! U grid
344	IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain
345	DO ib = 1, SIZE(dta%u2d)
346	dta%u2d(ib) = dta%u2d(ib) + zramp(td%u (ib,itide,1)z_cost(itide) + td%u (ib,itide,2)*z_sist(itide))
347	END DO
348	ENDIF
349	! V grid
350	IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain
351	DO ib = 1, SIZE(dta%v2d)
352	dta%v2d(ib) = dta%v2d(ib) + zramp(td%v (ib,itide,1)z_cost(itide) + td%v (ib,itide,2)*z_sist(itide))
353	END DO
354	ENDIF
355	END DO
356	!
357	END SUBROUTINE bdytide_update
358
359
360	SUBROUTINE bdy_dta_tides( kt, kit, kt_offset )
361	!!----------------------------------------------------------------------
362	!! * SUBROUTINE bdy_dta_tides *
363	!!
364	!! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
365	!!
366	!!----------------------------------------------------------------------
367	INTEGER, INTENT(in) :: kt ! Main timestep counter
368	INTEGER, OPTIONAL, INTENT(in) :: kit ! Barotropic timestep counter (for timesplitting option)
369	INTEGER, OPTIONAL, INTENT(in) :: kt_offset ! time offset in units of timesteps. NB. if kit
370	! ! is present then units = subcycle timesteps.
371	! ! kt_offset = 0 => get data at "now" time level
372	! ! kt_offset = -1 => get data at "before" time level
373	! ! kt_offset = +1 => get data at "after" time level
374	! ! etc.
375	!
376	LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step
377	INTEGER :: itide, ib_bdy, ib ! loop indices
378	INTEGER :: time_add ! time offset in units of timesteps
379	REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist
380	!!----------------------------------------------------------------------
381	!
382	lk_first_btstp=.TRUE.
383	IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF
384
385	time_add = 0
386	IF( PRESENT(kt_offset) ) THEN
387	time_add = kt_offset
388	ENDIF
389
390	! Absolute time from model initialization:
391	IF( PRESENT(kit) ) THEN
392	z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt
393	ELSE
394	z_arg = ( kt + time_add ) * rdt
395	ENDIF
396
397	! Linear ramp on tidal component at open boundaries
398	zramp = 1.
399	IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - nit000rdt)/(rdttideramprday),0.),1.)
400
401	DO ib_bdy = 1,nb_bdy
402	!
403	IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN
404	!
405	! We refresh nodal factors every day below
406	! This should be done somewhere else
407	IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN
408	!
409	kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
410	!
411	IF(lwp) THEN
412	WRITE(numout,*)
413	WRITE(numout,*) 'bdy_tide_dta : Refresh nodal factors for tidal open bdy data at kt=',kt
414	WRITE(numout,*) '~~~~~~~~~~~~~~ '
415	ENDIF
416	!
417	CALL tide_init_elevation ( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
418	CALL tide_init_velocities( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
419	!
420	ENDIF
421	zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time
422	!
423	! If time splitting, initialize arrays from slow varying open boundary data:
424	IF ( PRESENT(kit) ) THEN
425	IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) dta_bdy(ib_bdy)%ssh(:) = dta_bdy_s(ib_bdy)%ssh(:)
426	IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) dta_bdy(ib_bdy)%u2d(:) = dta_bdy_s(ib_bdy)%u2d(:)
427	IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) dta_bdy(ib_bdy)%v2d(:) = dta_bdy_s(ib_bdy)%v2d(:)
428	ENDIF
429	!
430	! Update open boundary data arrays:
431	DO itide = 1, nb_harmo
432	!
433	z_sarg = (z_arg + zoff) * omega_tide(itide)
434	z_cost = zramp * COS( z_sarg )
435	z_sist = zramp * SIN( z_sarg )
436	!
437	IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) THEN ! SSH on tracer grid
438	DO ib = 1, SIZE(dta_bdy(ib_bdy)%ssh)
439	dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + &
440	& ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + &
441	& tides(ib_bdy)%ssh(ib,itide,2)*z_sist )
442	END DO
443	ENDIF
444	!
445	IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) THEN ! U grid
446	DO ib = 1, SIZE(dta_bdy(ib_bdy)%u2d)
447	dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + &
448	& ( tides(ib_bdy)%u(ib,itide,1)*z_cost + &
449	& tides(ib_bdy)%u(ib,itide,2)*z_sist )
450	END DO
451	ENDIF
452	!
453	IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) THEN ! V grid
454	DO ib = 1, SIZE(dta_bdy(ib_bdy)%v2d)
455	dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + &
456	& ( tides(ib_bdy)%v(ib,itide,1)*z_cost + &
457	& tides(ib_bdy)%v(ib,itide,2)*z_sist )
458	END DO
459	ENDIF
460	!
461	END DO
462	END IF
463	END DO
464	!
465	END SUBROUTINE bdy_dta_tides
466
467
468	SUBROUTINE tide_init_elevation( idx, td )
469	!!----------------------------------------------------------------------
470	!! * ROUTINE tide_init_elevation *
471	!!----------------------------------------------------------------------
472	TYPE(OBC_INDEX) , INTENT(in ) :: idx ! OBC indices
473	TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data
474	!
475	INTEGER :: itide, isz, ib ! dummy loop indices
476	REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide
477	!!----------------------------------------------------------------------
478	!
479	IF( ASSOCIATED(td%ssh0) ) THEN ! SSH on tracer grid.
480	!
481	isz = SIZE( td%ssh0, dim = 1 )
482	ALLOCATE( mod_tide(isz), phi_tide(isz) )
483	!
484	DO itide = 1, nb_harmo
485	DO ib = 1, isz
486	mod_tide(ib)=SQRT( td%ssh0(ib,itide,1)td%ssh0(ib,itide,1) + td%ssh0(ib,itide,2)td%ssh0(ib,itide,2) )
487	phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
488	END DO
489	DO ib = 1, isz
490	mod_tide(ib)=mod_tide(ib)*ftide(itide)
491	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
492	END DO
493	DO ib = 1, isz
494	td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
495	td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
496	END DO
497	END DO
498	!
499	DEALLOCATE( mod_tide, phi_tide )
500	!
501	ENDIF
502	!
503	END SUBROUTINE tide_init_elevation
504
505
506	SUBROUTINE tide_init_velocities( idx, td )
507	!!----------------------------------------------------------------------
508	!! * ROUTINE tide_init_elevation *
509	!!----------------------------------------------------------------------
510	TYPE(OBC_INDEX) , INTENT(in ) :: idx ! OBC indices
511	TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data
512	!
513	INTEGER :: itide, isz, ib ! dummy loop indices
514	REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide
515	!!----------------------------------------------------------------------
516	!
517	IF( ASSOCIATED(td%u0) ) THEN ! U grid. we use bdy u2d on this mpi subdomain
518	!
519	isz = SIZE( td%u0, dim = 1 )
520	ALLOCATE( mod_tide(isz), phi_tide(isz) )
521	!
522	DO itide = 1, nb_harmo
523	DO ib = 1, isz
524	mod_tide(ib)=SQRT( td%u0(ib,itide,1)td%u0(ib,itide,1) + td%u0(ib,itide,2)td%u0(ib,itide,2) )
525	phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
526	END DO
527	DO ib = 1, isz
528	mod_tide(ib)=mod_tide(ib)*ftide(itide)
529	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
530	END DO
531	DO ib = 1, isz
532	td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
533	td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
534	END DO
535	END DO
536	!
537	DEALLOCATE( mod_tide, phi_tide )
538	!
539	ENDIF
540	!
541	IF( ASSOCIATED(td%v0) ) THEN ! V grid. we use bdy u2d on this mpi subdomain
542	!
543	isz = SIZE( td%v0, dim = 1 )
544	ALLOCATE( mod_tide(isz), phi_tide(isz) )
545	!
546	DO itide = 1, nb_harmo
547	DO ib = 1, isz
548	mod_tide(ib)=SQRT( td%v0(ib,itide,1)td%v0(ib,itide,1) + td%v0(ib,itide,2)td%v0(ib,itide,2) )
549	phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
550	END DO
551	DO ib = 1, isz
552	mod_tide(ib)=mod_tide(ib)*ftide(itide)
553	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
554	END DO
555	DO ib = 1, isz
556	td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
557	td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
558	END DO
559	END DO
560	!
561	DEALLOCATE( mod_tide, phi_tide )
562	!
563	ENDIF
564	!
565	END SUBROUTINE tide_init_velocities
566
567	!!======================================================================
568	END MODULE bdytides
569

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

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

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/BDY/bdytides.F90 @ 15688

Download in other formats: