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/2012/dev_NOC_MERCATOR_2012/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

Context Navigation

source: branches/2012/dev_NOC_MERCATOR_2012/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90 @ 3821

Last change on this file since 3821 was 3651, checked in by cbricaud, 12 years ago
merge dev_MERCATOR_2012_rev3555 into dev_NOC_MERCATOR_2012 ; see ticket 1020
Property svn:keywords set to `Id`
File size: 21.3 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
	78	CHARACTER(len=80) :: clfile !: full file name for tidal input file
	79	REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read !: work space to read in tidal harmonics data
	80	REAL(wp), POINTER, DIMENSION(:,:) :: ztr, zti !: " " " " " " " "
[3294]	81	!!
[3651]	82	TYPE(TIDES_DATA), POINTER :: td !: local short cut
[3294]	83	!!
[3651]	84	NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
[1125]	85	!!----------------------------------------------------------------------
[911]	86
[3651]	87	IF( nn_timing == 1 ) CALL timing_start('bdytide_init')
[3294]	88
[3651]	89	IF (nb_bdy>0) THEN
	90	IF(lwp) WRITE(numout,*)
	91	IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries'
	92	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
	93	ENDIF
[911]	94
[3651]	95	ln_bdytide_2ddta = .FALSE.
	96	ln_bdytide_conj = .FALSE.
	97
[3294]	98	REWIND(numnam)
	99	DO ib_bdy = 1, nb_bdy
	100	IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN
[2528]	101
[3294]	102	td => tides(ib_bdy)
[3651]	103	nblen => idx_bdy(ib_bdy)%nblen
	104	nblenrim => idx_bdy(ib_bdy)%nblenrim
[911]	105
[3294]	106	! Namelist nambdy_tide : tidal harmonic forcing at open boundaries
	107	filtide(:) = ''
[911]	108
[3294]	109	! Don't REWIND here - may need to read more than one of these namelists.
	110	READ ( numnam, nambdy_tide )
[3651]	111	! ! Parameter control and print
	112	IF(lwp) WRITE(numout,*) ' '
	113	IF(lwp) WRITE(numout,*) ' Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
	114	IF(lwp) WRITE(numout,*) ' read tidal data in 2d files: ', ln_bdytide_2ddta
	115	IF(lwp) WRITE(numout,*) ' assume complex conjugate : ', ln_bdytide_conj
	116	IF(lwp) WRITE(numout,*) ' Number of tidal components to read: ', nb_harmo
	117	IF(lwp) THEN
	118	WRITE(numout,*) ' Tidal cpt name - Phase speed (deg/hr)'
	119	DO itide = 1, nb_harmo
	120	WRITE(numout,*) ' ', Wave(ntide(itide))%cname_tide, omega_tide(itide)
	121	END DO
	122	ENDIF
	123	IF(lwp) WRITE(numout,*) ' '
[1125]	124
[3651]	125	! Allocate space for tidal harmonics data - get size from OBC data arrays
	126	! -----------------------------------------------------------------------
[911]	127
[3651]	128	! JC: If FRS scheme is used, we assume that tidal is needed over the whole
	129	! relaxation area
	130	IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
	131	ilen0(:)=nblen(:)
[3294]	132	ELSE
[3651]	133	ilen0(:)=nblenrim(:)
[3294]	134	ENDIF
[911]	135
[3651]	136	ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) )
	137	ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) )
[911]	138
[3651]	139	ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) )
	140	ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) )
[911]	141
[3651]	142	ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) )
	143	ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) )
[911]	144
[3651]	145	td%ssh0(:,:,:) = 0.e0
	146	td%ssh(:,:,:) = 0.e0
	147	td%u0(:,:,:) = 0.e0
	148	td%u(:,:,:) = 0.e0
	149	td%v0(:,:,:) = 0.e0
	150	td%v(:,:,:) = 0.e0
[3294]	151
[3651]	152	IF (ln_bdytide_2ddta) THEN
	153	! It is assumed that each data file contains all complex harmonic amplitudes
	154	! given on the data domain (ie global, jpidta x jpjdta)
	155	!
	156	CALL wrk_alloc( jpi, jpj, zti, ztr )
	157	!
	158	! SSH fields
	159	clfile = TRIM(filtide)//'_grid_T.nc'
	160	CALL iom_open (clfile , inum )
	161	igrd = 1 ! Everything is at T-points here
	162	DO itide = 1, nb_harmo
	163	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )
	164	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )
	165	DO ib = 1, ilen0(igrd)
	166	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
	167	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
	168	td%ssh0(ib,itide,1) = ztr(ii,ij)
	169	td%ssh0(ib,itide,2) = zti(ii,ij)
	170	END DO
	171	END DO
[3294]	172	CALL iom_close( inum )
[3651]	173	!
	174	! U fields
	175	clfile = TRIM(filtide)//'_grid_U.nc'
	176	CALL iom_open (clfile , inum )
	177	igrd = 2 ! Everything is at U-points here
	178	DO itide = 1, nb_harmo
	179	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) )
	180	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) )
	181	DO ib = 1, ilen0(igrd)
	182	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
	183	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
	184	td%u0(ib,itide,1) = ztr(ii,ij)
	185	td%u0(ib,itide,2) = zti(ii,ij)
	186	END DO
	187	END DO
[3294]	188	CALL iom_close( inum )
[3651]	189	!
	190	! V fields
	191	clfile = TRIM(filtide)//'_grid_V.nc'
	192	CALL iom_open (clfile , inum )
	193	igrd = 3 ! Everything is at V-points here
	194	DO itide = 1, nb_harmo
	195	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) )
	196	CALL iom_get ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) )
	197	DO ib = 1, ilen0(igrd)
	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 DO
[3294]	204	CALL iom_close( inum )
	205	!
[3651]	206	CALL wrk_dealloc( jpi, jpj, ztr, zti )
	207	!
	208	ELSE
	209	!
	210	! Read tidal data only on bdy segments
	211	!
	212	ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) )
[3294]	213
[3651]	214	! Open files and read in tidal forcing data
	215	! -----------------------------------------
[3294]	216
[3651]	217	DO itide = 1, nb_harmo
	218	! ! SSH fields
	219	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc'
	220	CALL iom_open( clfile, inum )
	221	CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
	222	td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1)
	223	CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
	224	td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1)
	225	CALL iom_close( inum )
	226	! ! U fields
	227	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc'
	228	CALL iom_open( clfile, inum )
	229	CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
	230	td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1)
	231	CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
	232	td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1)
	233	CALL iom_close( inum )
	234	! ! V fields
	235	clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc'
	236	CALL iom_open( clfile, inum )
	237	CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
	238	td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1)
	239	CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
	240	td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1)
	241	CALL iom_close( inum )
[3294]	242	!
[3651]	243	END DO ! end loop on tidal components
[3294]	244	!
[3651]	245	DEALLOCATE( dta_read )
	246	ENDIF ! ln_bdytide_2ddta=.true.
[1125]	247	!
[3651]	248	IF ( ln_bdytide_conj ) THEN ! assume complex conjugate in data files
	249	td%ssh0(:,:,2) = - td%ssh0(:,:,2)
	250	td%u0 (:,:,2) = - td%u0 (:,:,2)
	251	td%v0 (:,:,2) = - td%v0 (:,:,2)
	252	ENDIF
	253	!
[3294]	254	ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2
[1125]	255	!
[3294]	256	END DO ! loop on ib_bdy
[911]	257
[3651]	258	IF( nn_timing == 1 ) CALL timing_stop('bdytide_init')
[1125]	259
[3651]	260	END SUBROUTINE bdytide_init
[3294]	261
[3651]	262	SUBROUTINE bdytide_update ( kt, idx, dta, td, jit, time_offset )
[1125]	263	!!----------------------------------------------------------------------
[3651]	264	!! * SUBROUTINE bdytide_update *
[1125]	265	!!
[3294]	266	!! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
[911]	267	!!
[1125]	268	!!----------------------------------------------------------------------
[3651]	269	INTEGER, INTENT( in ) :: kt ! Main timestep counter
	270	TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices
	271	TYPE(OBC_DATA), INTENT(inout) :: dta ! OBC external data
	272	TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data
	273	INTEGER,INTENT(in),OPTIONAL :: jit ! Barotropic timestep counter (for timesplitting option)
	274	INTEGER,INTENT( in ), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit
	275	! is present then units = subcycle timesteps.
	276	! time_offset = 0 => get data at "now" time level
	277	! time_offset = -1 => get data at "before" time level
	278	! time_offset = +1 => get data at "after" time level
	279	! etc.
[1125]	280	!!
[3651]	281	INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays)
	282	INTEGER :: itide, igrd, ib ! dummy loop indices
	283	INTEGER :: time_add ! time offset in units of timesteps
	284	REAL(wp) :: z_arg, z_sarg, zflag, zramp
	285	REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost
[1125]	286	!!----------------------------------------------------------------------
[911]	287
[3651]	288	IF( nn_timing == 1 ) CALL timing_start('bdytide_update')
[3294]	289
[3651]	290	ilen0(1) = SIZE(td%ssh(:,1,1))
	291	ilen0(2) = SIZE(td%u(:,1,1))
	292	ilen0(3) = SIZE(td%v(:,1,1))
	293
	294	zflag=1
	295	IF ( PRESENT(jit) ) THEN
	296	IF ( jit /= 1 ) zflag=0
	297	ENDIF
	298
	299	IF ( nsec_day == NINT(0.5 * rdttra(1)) .AND. zflag==1 ) THEN
	300	!
	301	kt_tide = kt
	302	!
	303	IF(lwp) THEN
	304	WRITE(numout,*)
	305	WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=',kt
	306	WRITE(numout,*) '~~~~~~~~~~~~~~ '
	307	ENDIF
	308	!
	309	CALL tide_init_elevation ( idx, td )
	310	CALL tide_init_velocities( idx, td )
	311	!
	312	ENDIF
	313
[3294]	314	time_add = 0
	315	IF( PRESENT(time_offset) ) THEN
	316	time_add = time_offset
	317	ENDIF
	318
	319	IF( PRESENT(jit) ) THEN
[3651]	320	z_arg = ( ((kt-kt_tide)-1) * rdt + (jit+time_add) * rdt / REAL(nn_baro,wp) )
[3294]	321	ELSE
[3651]	322	z_arg = ((kt-kt_tide)+time_add) * rdt
[1125]	323	ENDIF
[911]	324
[3651]	325	! Linear ramp on tidal component at open boundaries
	326	zramp = 1.
	327	IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)rdt)/(rdttideramprday),0.),1.)
	328
	329	DO itide = 1, nb_harmo
	330	z_sarg = z_arg * omega_tide(itide)
[1125]	331	z_cost(itide) = COS( z_sarg )
	332	z_sist(itide) = SIN( z_sarg )
	333	END DO
[911]	334
[3651]	335	DO itide = 1, nb_harmo
	336	igrd=1 ! SSH on tracer grid
	337	DO ib = 1, ilen0(igrd)
	338	dta%ssh(ib) = dta%ssh(ib) + zramp(td%ssh(ib,itide,1)z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide))
[1125]	339	END DO
[3294]	340	igrd=2 ! U grid
[3651]	341	DO ib = 1, ilen0(igrd)
	342	dta%u2d(ib) = dta%u2d(ib) + zramp(td%u (ib,itide,1)z_cost(itide) + td%u (ib,itide,2)*z_sist(itide))
[1125]	343	END DO
[3294]	344	igrd=3 ! V grid
[3651]	345	DO ib = 1, ilen0(igrd)
	346	dta%v2d(ib) = dta%v2d(ib) + zramp(td%v (ib,itide,1)z_cost(itide) + td%v (ib,itide,2)*z_sist(itide))
[1125]	347	END DO
	348	END DO
	349	!
[3651]	350	IF( nn_timing == 1 ) CALL timing_stop('bdytide_update')
[3294]	351	!
[3651]	352	END SUBROUTINE bdytide_update
[911]	353
[3651]	354	SUBROUTINE tide_init_elevation( idx, td )
[1125]	355	!!----------------------------------------------------------------------
[3651]	356	!! * ROUTINE tide_init_elevation *
[1125]	357	!!----------------------------------------------------------------------
[3651]	358	TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices
	359	TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data
	360	!! * Local declarations
	361	INTEGER, DIMENSION(1) :: ilen0 !: length of boundary data (from OBC arrays)
	362	REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide
	363	INTEGER :: itide, igrd, ib ! dummy loop indices
[1125]	364
[3651]	365	igrd=1
	366	! SSH on tracer grid.
	367
	368	ilen0(1) = SIZE(td%ssh0(:,1,1))
	369
	370	ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
	371
	372	DO itide = 1, nb_harmo
	373	DO ib = 1, ilen0(igrd)
	374	mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)2.+td%ssh0(ib,itide,2)2.)
	375	phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
[1125]	376	END DO
[3651]	377	DO ib = 1 , ilen0(igrd)
	378	mod_tide(ib)=mod_tide(ib)*ftide(itide)
	379	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
	380	ENDDO
	381	DO ib = 1 , ilen0(igrd)
	382	td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
	383	td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
	384	ENDDO
	385	END DO
[911]	386
[3651]	387	DEALLOCATE(mod_tide,phi_tide)
[911]	388
[3651]	389	END SUBROUTINE tide_init_elevation
	390
	391	SUBROUTINE tide_init_velocities( idx, td )
[1125]	392	!!----------------------------------------------------------------------
[3651]	393	!! * ROUTINE tide_init_elevation *
[1125]	394	!!----------------------------------------------------------------------
[3651]	395	TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices
	396	TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data
	397	!! * Local declarations
	398	INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays)
	399	REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide
	400	INTEGER :: itide, igrd, ib ! dummy loop indices
[911]	401
[3651]	402	ilen0(2) = SIZE(td%u0(:,1,1))
	403	ilen0(3) = SIZE(td%v0(:,1,1))
[1125]	404
[3651]	405	igrd=2 ! U grid.
[911]	406
[3651]	407	ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
[911]	408
[3651]	409	DO itide = 1, nb_harmo
	410	DO ib = 1, ilen0(igrd)
	411	mod_tide(ib)=SQRT(td%u0(ib,itide,1)2.+td%u0(ib,itide,2)2.)
	412	phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
	413	END DO
	414	DO ib = 1, ilen0(igrd)
	415	mod_tide(ib)=mod_tide(ib)*ftide(itide)
	416	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
	417	ENDDO
	418	DO ib = 1, ilen0(igrd)
	419	td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
	420	td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
	421	ENDDO
	422	END DO
[911]	423
[3651]	424	DEALLOCATE(mod_tide,phi_tide)
[911]	425
[3651]	426	igrd=3 ! V grid.
[911]	427
[3651]	428	ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))
[911]	429
[3651]	430	DO itide = 1, nb_harmo
	431	DO ib = 1, ilen0(igrd)
	432	mod_tide(ib)=SQRT(td%v0(ib,itide,1)2.+td%v0(ib,itide,2)2.)
	433	phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
	434	END DO
	435	DO ib = 1, ilen0(igrd)
	436	mod_tide(ib)=mod_tide(ib)*ftide(itide)
	437	phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
	438	ENDDO
	439	DO ib = 1, ilen0(igrd)
	440	td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
	441	td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
	442	ENDDO
	443	END DO
[1125]	444
[3651]	445	DEALLOCATE(mod_tide,phi_tide)
[911]	446
[3651]	447	END SUBROUTINE tide_init_velocities
[911]	448	#else
[1125]	449	!!----------------------------------------------------------------------
	450	!! Dummy module NO Unstruct Open Boundary Conditions for tides
	451	!!----------------------------------------------------------------------
[911]	452	CONTAINS
[3651]	453	SUBROUTINE bdytide_init ! Empty routine
	454	WRITE(,) 'bdytide_init: You should not have seen this print! error?'
	455	END SUBROUTINE bdytide_init
	456	SUBROUTINE bdytide_update( kt, jit ) ! Empty routine
	457	WRITE(,) 'bdytide_update: You should not have seen this print! error?', kt, jit
	458	END SUBROUTINE bdytide_update
[911]	459	#endif
	460
[1125]	461	!!======================================================================
[911]	462	END MODULE bdytides

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

Download in other formats: