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 NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/BDY – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/BDY/bdytides.F90 @ 13159

Last change on this file since 13159 was 13159, checked in by gsamson, 4 years ago
merge trunk@r13136 into ASINTER-06 branch; pass all SETTE tests; results identical to trunk@r13136; ticket #2419
Property svn:keywords set to `Id`
File size: 23.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
[4292]	11	!! 3.5 ! 2013-07 (J. Chanut) Compliant with time splitting changes
[1125]	12	!!----------------------------------------------------------------------
[6140]	13	!! bdytide_init : read of namelist and initialisation of tidal harmonics data
	14	!! tide_update : calculation of tidal forcing at each timestep
[1125]	15	!!----------------------------------------------------------------------
[6140]	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
[12377]	20	USE tide_mod !
[6140]	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)
[1125]	27
[911]	28	IMPLICIT NONE
	29	PRIVATE
	30
[3651]	31	PUBLIC bdytide_init ! routine called in bdy_init
[4292]	32	PUBLIC bdy_dta_tides ! routine called in dyn_spg_ts
[911]	33
[3294]	34	TYPE, PUBLIC :: TIDES_DATA !: Storage for external tidal harmonics data
[6140]	35	REAL(wp), POINTER, DIMENSION(:,:,:) :: ssh0 !: Tidal constituents : SSH0 (read in file)
	36	REAL(wp), POINTER, DIMENSION(:,:,:) :: u0, v0 !: Tidal constituents : U0, V0 (read in file)
	37	REAL(wp), POINTER, DIMENSION(:,:,:) :: ssh !: Tidal constituents : SSH (after nodal cor.)
	38	REAL(wp), POINTER, DIMENSION(:,:,:) :: u , v !: Tidal constituents : U , V (after nodal cor.)
[3294]	39	END TYPE TIDES_DATA
[911]	40
[4354]	41	!$AGRIF_DO_NOT_TREAT
[3651]	42	TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides !: External tidal harmonics data
[4354]	43	!$AGRIF_END_DO_NOT_TREAT
[5930]	44	TYPE(OBC_DATA) , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s !: bdy external data (slow component)
[911]	45
[12377]	46	INTEGER :: kt_tide
	47
	48	!! * Substitutions
	49	# include "do_loop_substitute.h90"
[1125]	50	!!----------------------------------------------------------------------
[9598]	51	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[6140]	52	!! $Id$
[10068]	53	!! Software governed by the CeCILL license (see ./LICENSE)
[1125]	54	!!----------------------------------------------------------------------
[911]	55	CONTAINS
	56
[3651]	57	SUBROUTINE bdytide_init
[1125]	58	!!----------------------------------------------------------------------
[3651]	59	!! * SUBROUTINE bdytide_init *
[1125]	60	!!
[3294]	61	!! ** Purpose : - Read in namelist for tides and initialise external
	62	!! tidal harmonics data
[911]	63	!!
	64	!!----------------------------------------------------------------------
[3294]	65	!! namelist variables
	66	!!-------------------
[13159]	67	CHARACTER(len=80) :: filtide ! Filename root for tidal input files
	68	LOGICAL :: ln_bdytide_2ddta ! If true, read 2d harmonic data
[1125]	69	!!
[13159]	70	INTEGER :: ib_bdy, itide, ib ! dummy loop indices
	71	INTEGER :: ii, ij ! dummy loop indices
[3294]	72	INTEGER :: inum, igrd
[13159]	73	INTEGER :: isz ! bdy data size
[4147]	74	INTEGER :: ios ! Local integer output status for namelist read
[12377]	75	INTEGER :: nbdy_rdstart, nbdy_loc
[13159]	76	CHARACTER(LEN=50) :: cerrmsg ! error string
	77	CHARACTER(len=80) :: clfile ! full file name for tidal input file
	78	REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read ! work space to read in tidal harmonics data
	79	REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: ztr, zti ! " " " " " " " "
[3294]	80	!!
[13159]	81	TYPE(TIDES_DATA), POINTER :: td ! local short cut
	82	TYPE( OBC_DATA), POINTER :: dta ! local short cut
[3294]	83	!!
[12377]	84	NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta
[1125]	85	!!----------------------------------------------------------------------
[6140]	86	!
[11536]	87	IF(lwp) WRITE(numout,*)
	88	IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries'
	89	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
[911]	90
[3651]	91
[12377]	92	nbdy_rdstart = 1
[3294]	93	DO ib_bdy = 1, nb_bdy
[7646]	94	IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN
	95	!
[13159]	96	td => tides(ib_bdy)
	97	dta => dta_bdy(ib_bdy)
	98
[3294]	99	! Namelist nambdy_tide : tidal harmonic forcing at open boundaries
	100	filtide(:) = ''
[911]	101
[11536]	102	READ ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901)
	103	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in reference namelist' )
[12377]	104	!
	105	! Need to support possibility of reading more than one
	106	! nambdy_tide from the namelist_cfg internal file.
	107	! Do this by finding the ib_bdy'th occurence of nambdy_tide in the
	108	! character buffer as the starting point.
	109	!
	110	nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_tide' )
	111	IF( nbdy_loc .GT. 0 ) THEN
	112	nbdy_rdstart = nbdy_rdstart + nbdy_loc
	113	ELSE
	114	WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',ib_bdy,' of nambdy_tide not found'
	115	ios = -1
	116	CALL ctl_nam ( ios , cerrmsg )
	117	ENDIF
	118	READ ( numnam_cfg( MAX( 1, nbdy_rdstart - 2 ): ), nambdy_tide, IOSTAT = ios, ERR = 902)
[11536]	119	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist' )
[4624]	120	IF(lwm) WRITE ( numond, nambdy_tide )
[3651]	121	! ! Parameter control and print
	122	IF(lwp) WRITE(numout,*) ' '
	123	IF(lwp) WRITE(numout,*) ' Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
	124	IF(lwp) WRITE(numout,*) ' read tidal data in 2d files: ', ln_bdytide_2ddta
	125	IF(lwp) WRITE(numout,*) ' Number of tidal components to read: ', nb_harmo
	126	IF(lwp) THEN
[5084]	127	WRITE(numout,*) ' Tidal components: '
[3651]	128	DO itide = 1, nb_harmo
[12377]	129	WRITE(numout,*) ' ', tide_harmonics(itide)%cname_tide
[3651]	130	END DO
	131	ENDIF
	132	IF(lwp) WRITE(numout,*) ' '
[1125]	133
[13159]	134	! Allocate space for tidal harmonics data - get size from BDY data arrays
	135	! Allocate also slow varying data in the case of time splitting:
	136	! Do it anyway because at this stage knowledge of free surface scheme is unknown
[3651]	137	! -----------------------------------------------------------------------
[13159]	138	IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain
	139	isz = SIZE(dta%ssh)
	140	ALLOCATE( td%ssh0( isz, nb_harmo, 2 ), td%ssh( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%ssh( isz ) )
	141	dta_bdy_s(ib_bdy)%ssh(:) = 0._wp ! needed?
[3294]	142	ENDIF
[13159]	143	IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain
	144	isz = SIZE(dta%u2d)
	145	ALLOCATE( td%u0 ( isz, nb_harmo, 2 ), td%u ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%u2d( isz ) )
	146	dta_bdy_s(ib_bdy)%u2d(:) = 0._wp ! needed?
	147	ENDIF
	148	IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain
	149	isz = SIZE(dta%v2d)
	150	ALLOCATE( td%v0 ( isz, nb_harmo, 2 ), td%v ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%v2d( isz ) )
	151	dta_bdy_s(ib_bdy)%v2d(:) = 0._wp ! needed?
	152	ENDIF
[911]	153
[13159]	154	! fill td%ssh0, td%u0, td%v0
	155	! -----------------------------------------------------------------------
[7646]	156	IF( ln_bdytide_2ddta ) THEN
[13159]	157	!
[3651]	158	! It is assumed that each data file contains all complex harmonic amplitudes
[7646]	159	! given on the global domain (ie global, jpiglo x jpjglo)
[3651]	160	!
[9125]	161	ALLOCATE( zti(jpi,jpj), ztr(jpi,jpj) )
[3651]	162	!
	163	! SSH fields
[13159]	164	IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain
	165	clfile = TRIM(filtide)//'_grid_T.nc'
	166	CALL iom_open( clfile , inum )
	167	igrd = 1 ! Everything is at T-points here
	168	DO itide = 1, nb_harmo
	169	CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) )
	170	CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )
	171	DO ib = 1, SIZE(dta%ssh)
	172	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
	173	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
	174	td%ssh0(ib,itide,1) = ztr(ii,ij)
	175	td%ssh0(ib,itide,2) = zti(ii,ij)
	176	END DO
[3651]	177	END DO
[13159]	178	CALL iom_close( inum )
	179	ENDIF
[3651]	180	!
	181	! U fields
[13159]	182	IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain
	183	clfile = TRIM(filtide)//'_grid_U.nc'
	184	CALL iom_open( clfile , inum )
	185	igrd = 2 ! Everything is at U-points here
	186	DO itide = 1, nb_harmo
	187	CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) )
	188	CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) )
	189	DO ib = 1, SIZE(dta%u2d)
	190	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
	191	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
	192	td%u0(ib,itide,1) = ztr(ii,ij)
	193	td%u0(ib,itide,2) = zti(ii,ij)
	194	END DO
[3651]	195	END DO
[13159]	196	CALL iom_close( inum )
	197	ENDIF
[3651]	198	!
	199	! V fields
[13159]	200	IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain
	201	clfile = TRIM(filtide)//'_grid_V.nc'
	202	CALL iom_open( clfile , inum )
	203	igrd = 3 ! Everything is at V-points here
	204	DO itide = 1, nb_harmo
	205	CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) )
	206	CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) )
	207	DO ib = 1, SIZE(dta%v2d)
	208	ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
	209	ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
	210	td%v0(ib,itide,1) = ztr(ii,ij)
	211	td%v0(ib,itide,2) = zti(ii,ij)
	212	END DO
[3651]	213	END DO
[13159]	214	CALL iom_close( inum )
	215	ENDIF
[3294]	216	!
[9125]	217	DEALLOCATE( ztr, zti )
[3651]	218	!
	219	ELSE
	220	!
	221	! Read tidal data only on bdy segments
	222	!
[13159]	223	ALLOCATE( dta_read( MAXVAL( idx_bdy(ib_bdy)%nblen(:) ), 1, 1 ) )
[5132]	224	!
[3651]	225	! Open files and read in tidal forcing data
	226	! -----------------------------------------
[3294]	227
[3651]	228	DO itide = 1, nb_harmo
	229	! ! SSH fields
[13159]	230	IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain
	231	isz = SIZE(dta%ssh)
	232	clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc'
	233	CALL iom_open( clfile, inum )
	234	CALL fld_map( inum, 'z1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
	235	td%ssh0(:,itide,1) = dta_read(1:isz,1,1)
	236	CALL fld_map( inum, 'z2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
	237	td%ssh0(:,itide,2) = dta_read(1:isz,1,1)
	238	CALL iom_close( inum )
	239	ENDIF
[3651]	240	! ! U fields
[13159]	241	IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain
	242	isz = SIZE(dta%u2d)
	243	clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc'
	244	CALL iom_open( clfile, inum )
	245	CALL fld_map( inum, 'u1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
	246	td%u0(:,itide,1) = dta_read(1:isz,1,1)
	247	CALL fld_map( inum, 'u2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
	248	td%u0(:,itide,2) = dta_read(1:isz,1,1)
	249	CALL iom_close( inum )
	250	ENDIF
[3651]	251	! ! V fields
[13159]	252	IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain
	253	isz = SIZE(dta%v2d)
	254	clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc'
	255	CALL iom_open( clfile, inum )
	256	CALL fld_map( inum, 'v1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
	257	td%v0(:,itide,1) = dta_read(1:isz,1,1)
	258	CALL fld_map( inum, 'v2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
	259	td%v0(:,itide,2) = dta_read(1:isz,1,1)
	260	CALL iom_close( inum )
	261	ENDIF
[3294]	262	!
[3651]	263	END DO ! end loop on tidal components
[3294]	264	!
[3651]	265	DEALLOCATE( dta_read )
[7646]	266	!
[3651]	267	ENDIF ! ln_bdytide_2ddta=.true.
[1125]	268	!
[7646]	269	ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2
[1125]	270	!
[3294]	271	END DO ! loop on ib_bdy
[6140]	272	!
	273	END SUBROUTINE bdytide_init
[911]	274
[1125]	275
[12377]	276	SUBROUTINE bdy_dta_tides( kt, kit, pt_offset )
[1125]	277	!!----------------------------------------------------------------------
[4292]	278	!! * SUBROUTINE bdy_dta_tides *
	279	!!
	280	!! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.
	281	!!
	282	!!----------------------------------------------------------------------
[6140]	283	INTEGER, INTENT(in) :: kt ! Main timestep counter
	284	INTEGER, OPTIONAL, INTENT(in) :: kit ! Barotropic timestep counter (for timesplitting option)
[12377]	285	REAL(wp),OPTIONAL, INTENT(in) :: pt_offset ! time offset in units of timesteps
[6140]	286	!
	287	LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step
[13159]	288	INTEGER :: itide, ib_bdy, ib ! loop indices
[12377]	289	REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset
[4292]	290	!!----------------------------------------------------------------------
[6140]	291	!
[4292]	292	lk_first_btstp=.TRUE.
	293	IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF
	294
[12377]	295	zt_offset = 0._wp
	296	IF( PRESENT(pt_offset) ) zt_offset = pt_offset
[4292]	297
	298	! Absolute time from model initialization:
	299	IF( PRESENT(kit) ) THEN
[12489]	300	z_arg = ( REAL(kt, wp) + ( REAL(kit, wp) + zt_offset - 1. ) / REAL(nn_e, wp) ) * rn_Dt
[4292]	301	ELSE
[12489]	302	z_arg = ( REAL(kt, wp) + zt_offset ) * rn_Dt
[4292]	303	ENDIF
	304
	305	! Linear ramp on tidal component at open boundaries
	306	zramp = 1.
[12489]	307	IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - REAL(nit000,wp)rn_Dt)/(rn_tide_ramp_dtrday),0.),1.)
[4292]	308
	309	DO ib_bdy = 1,nb_bdy
[7646]	310	!
	311	IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN
	312	!
[4292]	313	! We refresh nodal factors every day below
	314	! This should be done somewhere else
[12489]	315	IF ( ( nsec_day == NINT(0.5_wp * rn_Dt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN
[4292]	316	!
[12489]	317	kt_tide = kt - NINT((REAL(nsec_day,wp) - 0.5_wp * rn_Dt)/rn_Dt)
[4292]	318	!
	319	IF(lwp) THEN
	320	WRITE(numout,*)
	321	WRITE(numout,*) 'bdy_tide_dta : Refresh nodal factors for tidal open bdy data at kt=',kt
	322	WRITE(numout,*) '~~~~~~~~~~~~~~ '
	323	ENDIF
	324	!
	325	CALL tide_init_elevation ( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
	326	CALL tide_init_velocities( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
	327	!
	328	ENDIF
[12489]	329	zoff = REAL(-kt_tide,wp) * rn_Dt ! time offset relative to nodal factor computation time
[4292]	330	!
[5930]	331	! If time splitting, initialize arrays from slow varying open boundary data:
	332	IF ( PRESENT(kit) ) THEN
[13159]	333	IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) dta_bdy(ib_bdy)%ssh(:) = dta_bdy_s(ib_bdy)%ssh(:)
	334	IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) dta_bdy(ib_bdy)%u2d(:) = dta_bdy_s(ib_bdy)%u2d(:)
	335	IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) dta_bdy(ib_bdy)%v2d(:) = dta_bdy_s(ib_bdy)%v2d(:)
[4292]	336	ENDIF
	337	!
	338	! Update open boundary data arrays:
	339	DO itide = 1, nb_harmo
	340	!
[12377]	341	z_sarg = (z_arg + zoff) * tide_harmonics(itide)%omega
[4292]	342	z_cost = zramp * COS( z_sarg )
	343	z_sist = zramp * SIN( z_sarg )
	344	!
[13159]	345	IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) THEN ! SSH on tracer grid
	346	DO ib = 1, SIZE(dta_bdy(ib_bdy)%ssh)
[4758]	347	dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + &
	348	& ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + &
	349	& tides(ib_bdy)%ssh(ib,itide,2)*z_sist )
	350	END DO
	351	ENDIF
[4292]	352	!
[13159]	353	IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) THEN ! U grid
	354	DO ib = 1, SIZE(dta_bdy(ib_bdy)%u2d)
[4758]	355	dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + &
	356	& ( tides(ib_bdy)%u(ib,itide,1)*z_cost + &
	357	& tides(ib_bdy)%u(ib,itide,2)*z_sist )
	358	END DO
[13159]	359	ENDIF
	360	!
	361	IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) THEN ! V grid
	362	DO ib = 1, SIZE(dta_bdy(ib_bdy)%v2d)
[4758]	363	dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + &
	364	& ( tides(ib_bdy)%v(ib,itide,1)*z_cost + &
	365	& tides(ib_bdy)%v(ib,itide,2)*z_sist )
	366	END DO
	367	ENDIF
[13159]	368	!
[4758]	369	END DO
[13159]	370	ENDIF
[4292]	371	END DO
	372	!
	373	END SUBROUTINE bdy_dta_tides
	374
[6140]	375
[3651]	376	SUBROUTINE tide_init_elevation( idx, td )
[1125]	377	!!----------------------------------------------------------------------
[3651]	378	!! * ROUTINE tide_init_elevation *
[1125]	379	!!----------------------------------------------------------------------
[6140]	380	TYPE(OBC_INDEX) , INTENT(in ) :: idx ! OBC indices
	381	TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data
	382	!
[13159]	383	INTEGER :: itide, isz, ib ! dummy loop indices
[3651]	384	REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide
[6140]	385	!!----------------------------------------------------------------------
	386	!
[13159]	387	IF( ASSOCIATED(td%ssh0) ) THEN ! SSH on tracer grid.
	388	!
	389	isz = SIZE( td%ssh0, dim = 1 )
	390	ALLOCATE( mod_tide(isz), phi_tide(isz) )
	391	!
	392	DO itide = 1, nb_harmo
	393	DO ib = 1, isz
	394	mod_tide(ib)=SQRT( td%ssh0(ib,itide,1)td%ssh0(ib,itide,1) + td%ssh0(ib,itide,2)td%ssh0(ib,itide,2) )
	395	phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
	396	END DO
	397	DO ib = 1, isz
	398	mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f
	399	phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u
	400	END DO
	401	DO ib = 1, isz
	402	td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
	403	td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
	404	END DO
[1125]	405	END DO
[13159]	406	!
	407	DEALLOCATE( mod_tide, phi_tide )
	408	!
	409	ENDIF
[6140]	410	!
	411	END SUBROUTINE tide_init_elevation
[911]	412
	413
[3651]	414	SUBROUTINE tide_init_velocities( idx, td )
[1125]	415	!!----------------------------------------------------------------------
[3651]	416	!! * ROUTINE tide_init_elevation *
[1125]	417	!!----------------------------------------------------------------------
[6140]	418	TYPE(OBC_INDEX) , INTENT(in ) :: idx ! OBC indices
	419	TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data
	420	!
[13159]	421	INTEGER :: itide, isz, ib ! dummy loop indices
[3651]	422	REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide
[6140]	423	!!----------------------------------------------------------------------
	424	!
[13159]	425	IF( ASSOCIATED(td%u0) ) THEN ! U grid. we use bdy u2d on this mpi subdomain
	426	!
	427	isz = SIZE( td%u0, dim = 1 )
	428	ALLOCATE( mod_tide(isz), phi_tide(isz) )
	429	!
	430	DO itide = 1, nb_harmo
	431	DO ib = 1, isz
	432	mod_tide(ib)=SQRT( td%u0(ib,itide,1)td%u0(ib,itide,1) + td%u0(ib,itide,2)td%u0(ib,itide,2) )
	433	phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
	434	END DO
	435	DO ib = 1, isz
	436	mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f
	437	phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u
	438	END DO
	439	DO ib = 1, isz
	440	td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
	441	td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
	442	END DO
[3651]	443	END DO
[13159]	444	!
	445	DEALLOCATE( mod_tide, phi_tide )
	446	!
	447	ENDIF
[6140]	448	!
[13159]	449	IF( ASSOCIATED(td%v0) ) THEN ! V grid. we use bdy u2d on this mpi subdomain
	450	!
	451	isz = SIZE( td%v0, dim = 1 )
	452	ALLOCATE( mod_tide(isz), phi_tide(isz) )
	453	!
	454	DO itide = 1, nb_harmo
	455	DO ib = 1, isz
	456	mod_tide(ib)=SQRT( td%v0(ib,itide,1)td%v0(ib,itide,1) + td%v0(ib,itide,2)td%v0(ib,itide,2) )
	457	phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
	458	END DO
	459	DO ib = 1, isz
	460	mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f
	461	phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u
	462	END DO
	463	DO ib = 1, isz
	464	td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
	465	td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
	466	END DO
[3651]	467	END DO
[13159]	468	!
	469	DEALLOCATE( mod_tide, phi_tide )
	470	!
	471	ENDIF
[6140]	472	!
[13159]	473	END SUBROUTINE tide_init_velocities
[1125]	474
	475	!!======================================================================
[911]	476	END MODULE bdytides
[4292]	477

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

Download in other formats: