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/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

Context Navigation

source: branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90 @ 4291

Last change on this file since 4291 was 4147, checked in by cetlod, 10 years ago
merge in dev_LOCEAN_2013, the 1st development branch dev_r3853_CNRS9_Confsetting, from its starting point ( r3853 ) on the trunk: see ticket #1169
Property svn:keywords set to `Id`
File size: 21.7 KB

Rev	Line
[911]	1	MODULE bdytides
[1125]	2	!!======================================================================
[911]	3	!! * MODULE bdytides *
	4	!! Ocean dynamics: Tidal forcing at open boundaries
[1125]	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
[2528]	9	!! 3.3 ! 2010-09 (D.Storkey and E.O'Dea) bug fixes
[3651]	10	!! 3.4 ! 2012-09 (G. Reffray and J. Chanut) New inputs + mods
[1125]	11	!!----------------------------------------------------------------------
	12	#if defined key_bdy
	13	!!----------------------------------------------------------------------
[3294]	14	!! 'key_bdy' Open Boundary Condition
[1125]	15	!!----------------------------------------------------------------------
[911]	16	!! PUBLIC
[3651]	17	!! bdytide_init : read of namelist and initialisation of tidal harmonics data
[1125]	18	!! tide_update : calculation of tidal forcing at each timestep
	19	!!----------------------------------------------------------------------
[3294]	20	USE timing ! Timing
[911]	21	USE oce ! ocean dynamics and tracers
	22	USE dom_oce ! ocean space and time domain
	23	USE iom
	24	USE in_out_manager ! I/O units
	25	USE phycst ! physical constants
	26	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	27	USE bdy_par ! Unstructured boundary parameters
	28	USE bdy_oce ! ocean open boundary conditions
[2528]	29	USE daymod ! calendar
[3651]	30	USE wrk_nemo ! Memory allocation
	31	USE tideini
	32	! USE tide_mod ! Useless ??
[3294]	33	USE fldread, ONLY: fld_map
[1125]	34
[911]	35	IMPLICIT NONE
	36	PRIVATE
	37
[3651]	38	PUBLIC bdytide_init ! routine called in bdy_init
	39	PUBLIC bdytide_update ! routine called in bdy_dta
[911]	40
[3294]	41	TYPE, PUBLIC :: TIDES_DATA !: Storage for external tidal harmonics data
[3651]	42	REAL(wp), POINTER, DIMENSION(:,:,:) :: ssh0 !: Tidal constituents : SSH0 (read in file)
	43	REAL(wp), POINTER, DIMENSION(:,:,:) :: u0 !: Tidal constituents : U0 (read in file)
	44	REAL(wp), POINTER, DIMENSION(:,:,:) :: v0 !: Tidal constituents : V0 (read in file)
	45	REAL(wp), POINTER, DIMENSION(:,:,:) :: ssh !: Tidal constituents : SSH (after nodal cor.)
	46	REAL(wp), POINTER, DIMENSION(:,:,:) :: u !: Tidal constituents : U (after nodal cor.)
	47	REAL(wp), POINTER, DIMENSION(:,:,:) :: v !: Tidal constituents : V (after nodal cor.)
[3294]	48	END TYPE TIDES_DATA
[911]	49
[3651]	50	TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides !: External tidal harmonics data
[911]	51
[1125]	52	!!----------------------------------------------------------------------
[2528]	53	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1146]	54	!! $Id$
[2528]	55	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1125]	56	!!----------------------------------------------------------------------
[911]	57	CONTAINS
	58
[3651]	59	SUBROUTINE bdytide_init
[1125]	60	!!----------------------------------------------------------------------
[3651]	61	!! * SUBROUTINE bdytide_init *
[1125]	62	!!
[3294]	63	!! ** Purpose : - Read in namelist for tides and initialise external
	64	!! tidal harmonics data
[911]	65	!!
	66	!!----------------------------------------------------------------------
[3294]	67	!! namelist variables
	68	!!-------------------
[3651]	69	CHARACTER(len=80) :: filtide !: Filename root for tidal input files
	70	LOGICAL :: ln_bdytide_2ddta !: If true, read 2d harmonic data
	71	LOGICAL :: ln_bdytide_conj !: If true, assume complex conjugate tidal data
[1125]	72	!!
[3651]	73	INTEGER :: ib_bdy, itide, ib !: dummy loop indices
	74	INTEGER :: ii, ij !: dummy loop indices
[3294]	75	INTEGER :: inum, igrd
[3651]	76	INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays)
	77	INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts
[4147]	78	INTEGER :: ios ! Local integer output status for namelist read
[3651]	79	CHARACTER(len=80) :: clfile !: full file name for tidal input file
	80	REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read !: work space to read in tidal harmonics data
	81	REAL(wp), POINTER, DIMENSION(:,:) :: ztr, zti !: " " " " " " " "
[3294]	82	!!
[3651]	83	TYPE(TIDES_DATA), POINTER :: td !: local short cut
[3294]	84	!!
[3651]	85	NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
[1125]	86	!!----------------------------------------------------------------------
[911]	87
[3651]	88	IF( nn_timing == 1 ) CALL timing_start('bdytide_init')
[3294]	89
[3651]	90	IF (nb_bdy>0) THEN
	91	IF(lwp) WRITE(numout,*)
	92	IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries'
	93	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
	94	ENDIF
[911]	95
[4147]	96	REWIND(numnam_cfg)
[3651]	97
[3294]	98	DO ib_bdy = 1, nb_bdy
	99	IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN
[2528]	100
[3294]	101	td => tides(ib_bdy)
[3651]	102	nblen => idx_bdy(ib_bdy)%nblen
	103	nblenrim => idx_bdy(ib_bdy)%nblenrim
[911]	104
[3294]	105	! Namelist nambdy_tide : tidal harmonic forcing at open boundaries
	106	filtide(:) = ''
[911]	107
[4147]	108	! Don't REWIND here - may need to read more than one of these namelists.
	109	READ ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901)
	110	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in reference namelist', lwp )
	111	READ ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 )
	112	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist', lwp )
	113	WRITE ( numond, nambdy_tide )
[3651]	114	! ! Parameter control and print
	115	IF(lwp) WRITE(numout,*) ' '
	116	IF(lwp) WRITE(numout,*) ' Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
	117	IF(lwp) WRITE(numout,*) ' read tidal data in 2d files: ', ln_bdytide_2ddta
	118	IF(lwp) WRITE(numout,*) ' assume complex conjugate : ', ln_bdytide_conj
	119	IF(lwp) WRITE(numout,*) ' Number of tidal components to read: ', nb_harmo
	120	IF(lwp) THEN
	121	WRITE(numout,*) ' Tidal cpt name - Phase speed (deg/hr)'
	122	DO itide = 1, nb_harmo
	123	WRITE(numout,*) ' ', Wave(ntide(itide))%cname_tide, omega_tide(itide)
	124	END DO
	125	ENDIF
	126	IF(lwp) WRITE(numout,*) ' '
[1125]	127
[3651]	128	! Allocate space for tidal harmonics data - get size from OBC data arrays
	129	! -----------------------------------------------------------------------
[911]	130
[3651]	131	! JC: If FRS scheme is used, we assume that tidal is needed over the whole
	132	! relaxation area
	133	IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
	134	ilen0(:)=nblen(:)
[3294]	135	ELSE
[3651]	136	ilen0(:)=nblenrim(:)
[3294]	137	ENDIF
[911]	138
[3651]	139	ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) )
	140	ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) )
[911]	141
[3651]	142	ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) )
	143	ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) )
[911]	144
[3651]	145	ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) )
	146	ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) )
[911]	147
[3651]	148	td%ssh0(:,:,:) = 0.e0
	149	td%ssh(:,:,:) = 0.e0
	150	td%u0(:,:,:) = 0.e0
	151	td%u(:,:,:) = 0.e0
	152	td%v0(:,:,:) = 0.e0
	153	td%v(:,:,:) = 0.e0
[3294]	154
[3651]	155	IF (ln_bdytide_2ddta) THEN
	156	! It is assumed that each data file contains all complex harmonic amplitudes
	157	! given on the data domain (ie global, jpidta x jpjdta)
	158	!
	159	CALL wrk_alloc( jpi, jpj, zti, ztr )
	160	!
	161	! SSH fields
	162	clfile = TRIM(filtide)//'_grid_T.nc'
	163	CALL iom_open (clfile , inum )
	164	igrd = 1 ! Everything is at T-points here
	165	DO itide = 1, nb_harmo
	166	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )
	167	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )
	168	DO ib = 1, ilen0(igrd)
	169	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
	170	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
	171	td%ssh0(ib,itide,1) = ztr(ii,ij)
	172	td%ssh0(ib,itide,2) = zti(ii,ij)
	173	END DO
	174	END DO
[3294]	175	CALL iom_close( inum )
[3651]	176	!
	177	! U fields
	178	clfile = TRIM(filtide)//'_grid_U.nc'
	179	CALL iom_open (clfile , inum )
	180	igrd = 2 ! Everything is at U-points here
	181	DO itide = 1, nb_harmo
	182	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) )
	183	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) )
	184	DO ib = 1, ilen0(igrd)
	185	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
	186	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
	187	td%u0(ib,itide,1) = ztr(ii,ij)
	188	td%u0(ib,itide,2) = zti(ii,ij)
	189	END DO
	190	END DO
[3294]	191	CALL iom_close( inum )
[3651]	192	!
	193	! V fields
	194	clfile = TRIM(filtide)//'_grid_V.nc'
	195	CALL iom_open (clfile , inum )
	196	igrd = 3 ! Everything is at V-points here
	197	DO itide = 1, nb_harmo
	198	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) )
	199	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) )
	200	DO ib = 1, ilen0(igrd)
	201	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
	202	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
	203	td%v0(ib,itide,1) = ztr(ii,ij)
	204	td%v0(ib,itide,2) = zti(ii,ij)
	205	END DO
	206	END DO
[3294]	207	CALL iom_close( inum )
	208	!
[3651]	209	CALL wrk_dealloc( jpi, jpj, ztr, zti )
	210	!
	211	ELSE
	212	!
	213	! Read tidal data only on bdy segments
	214	!
	215	ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) )
[3294]	216
[3651]	217	! Open files and read in tidal forcing data
	218	! -----------------------------------------
[3294]	219
[3651]	220	DO itide = 1, nb_harmo
	221	! ! SSH fields
	222	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc'
	223	CALL iom_open( clfile, inum )
	224	CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
	225	td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1)
	226	CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
	227	td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1)
	228	CALL iom_close( inum )
	229	! ! U fields
	230	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc'
	231	CALL iom_open( clfile, inum )
	232	CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
	233	td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1)
	234	CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
	235	td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1)
	236	CALL iom_close( inum )
	237	! ! V fields
	238	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc'
	239	CALL iom_open( clfile, inum )
	240	CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
	241	td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1)
	242	CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
	243	td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1)
	244	CALL iom_close( inum )
[3294]	245	!
[3651]	246	END DO ! end loop on tidal components
[3294]	247	!
[3651]	248	DEALLOCATE( dta_read )
	249	ENDIF ! ln_bdytide_2ddta=.true.
[1125]	250	!
[3651]	251	IF ( ln_bdytide_conj ) THEN ! assume complex conjugate in data files
	252	td%ssh0(:,:,2) = - td%ssh0(:,:,2)
	253	td%u0 (:,:,2) = - td%u0 (:,:,2)
	254	td%v0 (:,:,2) = - td%v0 (:,:,2)
	255	ENDIF
	256	!
[3294]	257	ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2
[1125]	258	!
[3294]	259	END DO ! loop on ib_bdy
[911]	260
[3651]	261	IF( nn_timing == 1 ) CALL timing_stop('bdytide_init')
[1125]	262
[3651]	263	END SUBROUTINE bdytide_init
[3294]	264
[3651]	265	SUBROUTINE bdytide_update ( kt, idx, dta, td, jit, time_offset )
[1125]	266	!!----------------------------------------------------------------------
[3651]	267	!! * SUBROUTINE bdytide_update *
[1125]	268	!!
[3294]	269	!! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
[911]	270	!!
[1125]	271	!!----------------------------------------------------------------------
[3651]	272	INTEGER, INTENT( in ) :: kt ! Main timestep counter
	273	TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices
	274	TYPE(OBC_DATA), INTENT(inout) :: dta ! OBC external data
	275	TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data
	276	INTEGER,INTENT(in),OPTIONAL :: jit ! Barotropic timestep counter (for timesplitting option)
	277	INTEGER,INTENT( in ), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit
	278	! is present then units = subcycle timesteps.
	279	! time_offset = 0 => get data at "now" time level
	280	! time_offset = -1 => get data at "before" time level
	281	! time_offset = +1 => get data at "after" time level
	282	! etc.
[1125]	283	!!
[3651]	284	INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays)
	285	INTEGER :: itide, igrd, ib ! dummy loop indices
	286	INTEGER :: time_add ! time offset in units of timesteps
	287	REAL(wp) :: z_arg, z_sarg, zflag, zramp
	288	REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost
[1125]	289	!!----------------------------------------------------------------------
[911]	290
[3651]	291	IF( nn_timing == 1 ) CALL timing_start('bdytide_update')
[3294]	292
[3651]	293	ilen0(1) = SIZE(td%ssh(:,1,1))
	294	ilen0(2) = SIZE(td%u(:,1,1))
	295	ilen0(3) = SIZE(td%v(:,1,1))
	296
	297	zflag=1
	298	IF ( PRESENT(jit) ) THEN
	299	IF ( jit /= 1 ) zflag=0
	300	ENDIF
	301
	302	IF ( nsec_day == NINT(0.5 * rdttra(1)) .AND. zflag==1 ) THEN
	303	!
	304	kt_tide = kt
	305	!
	306	IF(lwp) THEN
	307	WRITE(numout,*)
	308	WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=',kt
	309	WRITE(numout,*) '~~~~~~~~~~~~~~ '
	310	ENDIF
	311	!
	312	CALL tide_init_elevation ( idx, td )
	313	CALL tide_init_velocities( idx, td )
	314	!
	315	ENDIF
	316
[3294]	317	time_add = 0
	318	IF( PRESENT(time_offset) ) THEN
	319	time_add = time_offset
	320	ENDIF
	321
	322	IF( PRESENT(jit) ) THEN
[3651]	323	z_arg = ( ((kt-kt_tide)-1) * rdt + (jit+time_add) * rdt / REAL(nn_baro,wp) )
[3294]	324	ELSE
[3651]	325	z_arg = ((kt-kt_tide)+time_add) * rdt
[1125]	326	ENDIF
[911]	327
[3651]	328	! Linear ramp on tidal component at open boundaries
	329	zramp = 1.
	330	IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)rdt)/(rdttideramprday),0.),1.)
	331
	332	DO itide = 1, nb_harmo
	333	z_sarg = z_arg * omega_tide(itide)
[1125]	334	z_cost(itide) = COS( z_sarg )
	335	z_sist(itide) = SIN( z_sarg )
	336	END DO
[911]	337
[3651]	338	DO itide = 1, nb_harmo
	339	igrd=1 ! SSH on tracer grid
	340	DO ib = 1, ilen0(igrd)
	341	dta%ssh(ib) = dta%ssh(ib) + zramp(td%ssh(ib,itide,1)z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide))
[1125]	342	END DO
[3294]	343	igrd=2 ! U grid
[3651]	344	DO ib = 1, ilen0(igrd)
	345	dta%u2d(ib) = dta%u2d(ib) + zramp(td%u (ib,itide,1)z_cost(itide) + td%u (ib,itide,2)*z_sist(itide))
[1125]	346	END DO
[3294]	347	igrd=3 ! V grid
[3651]	348	DO ib = 1, ilen0(igrd)
	349	dta%v2d(ib) = dta%v2d(ib) + zramp(td%v (ib,itide,1)z_cost(itide) + td%v (ib,itide,2)*z_sist(itide))
[1125]	350	END DO
	351	END DO
	352	!
[3651]	353	IF( nn_timing == 1 ) CALL timing_stop('bdytide_update')
[3294]	354	!
[3651]	355	END SUBROUTINE bdytide_update
[911]	356
[3651]	357	SUBROUTINE tide_init_elevation( idx, td )
[1125]	358	!!----------------------------------------------------------------------
[3651]	359	!! * ROUTINE tide_init_elevation *
[1125]	360	!!----------------------------------------------------------------------
[3651]	361	TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices
	362	TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data
	363	!! * Local declarations
	364	INTEGER, DIMENSION(1) :: ilen0 !: length of boundary data (from OBC arrays)
	365	REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide
	366	INTEGER :: itide, igrd, ib ! dummy loop indices
[1125]	367
[3651]	368	igrd=1
	369	! SSH on tracer grid.
	370
	371	ilen0(1) = SIZE(td%ssh0(:,1,1))
	372
	373	ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
	374
	375	DO itide = 1, nb_harmo
	376	DO ib = 1, ilen0(igrd)
	377	mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)2.+td%ssh0(ib,itide,2)2.)
	378	phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
[1125]	379	END DO
[3651]	380	DO ib = 1 , ilen0(igrd)
	381	mod_tide(ib)=mod_tide(ib)*ftide(itide)
	382	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
	383	ENDDO
	384	DO ib = 1 , ilen0(igrd)
	385	td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
	386	td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
	387	ENDDO
	388	END DO
[911]	389
[3651]	390	DEALLOCATE(mod_tide,phi_tide)
[911]	391
[3651]	392	END SUBROUTINE tide_init_elevation
	393
	394	SUBROUTINE tide_init_velocities( idx, td )
[1125]	395	!!----------------------------------------------------------------------
[3651]	396	!! * ROUTINE tide_init_elevation *
[1125]	397	!!----------------------------------------------------------------------
[3651]	398	TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices
	399	TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data
	400	!! * Local declarations
	401	INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays)
	402	REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide
	403	INTEGER :: itide, igrd, ib ! dummy loop indices
[911]	404
[3651]	405	ilen0(2) = SIZE(td%u0(:,1,1))
	406	ilen0(3) = SIZE(td%v0(:,1,1))
[1125]	407
[3651]	408	igrd=2 ! U grid.
[911]	409
[3651]	410	ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
[911]	411
[3651]	412	DO itide = 1, nb_harmo
	413	DO ib = 1, ilen0(igrd)
	414	mod_tide(ib)=SQRT(td%u0(ib,itide,1)2.+td%u0(ib,itide,2)2.)
	415	phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
	416	END DO
	417	DO ib = 1, ilen0(igrd)
	418	mod_tide(ib)=mod_tide(ib)*ftide(itide)
	419	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
	420	ENDDO
	421	DO ib = 1, ilen0(igrd)
	422	td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
	423	td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
	424	ENDDO
	425	END DO
[911]	426
[3651]	427	DEALLOCATE(mod_tide,phi_tide)
[911]	428
[3651]	429	igrd=3 ! V grid.
[911]	430
[3651]	431	ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
[911]	432
[3651]	433	DO itide = 1, nb_harmo
	434	DO ib = 1, ilen0(igrd)
	435	mod_tide(ib)=SQRT(td%v0(ib,itide,1)2.+td%v0(ib,itide,2)2.)
	436	phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
	437	END DO
	438	DO ib = 1, ilen0(igrd)
	439	mod_tide(ib)=mod_tide(ib)*ftide(itide)
	440	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
	441	ENDDO
	442	DO ib = 1, ilen0(igrd)
	443	td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
	444	td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
	445	ENDDO
	446	END DO
[1125]	447
[3651]	448	DEALLOCATE(mod_tide,phi_tide)
[911]	449
[3651]	450	END SUBROUTINE tide_init_velocities
[911]	451	#else
[1125]	452	!!----------------------------------------------------------------------
	453	!! Dummy module NO Unstruct Open Boundary Conditions for tides
	454	!!----------------------------------------------------------------------
[911]	455	CONTAINS
[3651]	456	SUBROUTINE bdytide_init ! Empty routine
	457	WRITE(,) 'bdytide_init: You should not have seen this print! error?'
	458	END SUBROUTINE bdytide_init
	459	SUBROUTINE bdytide_update( kt, jit ) ! Empty routine
	460	WRITE(,) 'bdytide_update: You should not have seen this print! error?', kt, jit
	461	END SUBROUTINE bdytide_update
[911]	462	#endif
	463
[1125]	464	!!======================================================================
[911]	465	END MODULE bdytides

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

Download in other formats: