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.

sbcwave.F90 in NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/SBC/sbcwave.F90 @ 13658

Last change on this file since 13658 was 11822, checked in by acc, 5 years ago
Branch 2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps. Sette tested updates to branch to align with trunk changes between 10721 and 11740. Sette tests are passing but results differ from branch before these changes (except for GYRE_PISCES and VORTEX) and branch results already differed from trunk because of algorithmic fixes. Will need more checks to confirm correctness.
Property svn:keywords set to `Id`
File size: 25.7 KB

Rev	Line
[2990]	1	MODULE sbcwave
	2	!!======================================================================
	3	!! * MODULE sbcwave *
	4	!! Wave module
	5	!!======================================================================
[7646]	6	!! History : 3.3 ! 2011-09 (M. Adani) Original code: Drag Coefficient
	7	!! : 3.4 ! 2012-10 (M. Adani) Stokes Drift
	8	!! 3.6 ! 2014-09 (E. Clementi,P. Oddo) New Stokes Drift Computation
	9	!! - ! 2016-12 (G. Madec, E. Clementi) update Stoke drift computation
	10	!! + add sbc_wave_ini routine
[2990]	11	!!----------------------------------------------------------------------
	12
	13	!!----------------------------------------------------------------------
[7646]	14	!! sbc_stokes : calculate 3D Stokes-drift velocities
	15	!! sbc_wave : wave data from wave model in netcdf files
	16	!! sbc_wave_init : initialisation fo surface waves
[2990]	17	!!----------------------------------------------------------------------
[7646]	18	USE phycst ! physical constants
	19	USE oce ! ocean variables
[5836]	20	USE sbc_oce ! Surface boundary condition: ocean fields
[9019]	21	USE zdf_oce, ONLY : ln_zdfswm
[7646]	22	USE bdy_oce ! open boundary condition variables
	23	USE domvvl ! domain: variable volume layers
[5836]	24	!
	25	USE iom ! I/O manager library
	26	USE in_out_manager ! I/O manager
	27	USE lib_mpp ! distribued memory computing library
	28	USE fldread ! read input fields
[2990]	29
	30	IMPLICIT NONE
	31	PRIVATE
	32
[7646]	33	PUBLIC sbc_stokes ! routine called in sbccpl
[9023]	34	PUBLIC sbc_wstress ! routine called in sbcmod
[7646]	35	PUBLIC sbc_wave ! routine called in sbcmod
	36	PUBLIC sbc_wave_init ! routine called in sbcmod
[2990]	37
[7646]	38	! Variables checking if the wave parameters are coupled (if not, they are read from file)
	39	LOGICAL, PUBLIC :: cpl_hsig = .FALSE.
	40	LOGICAL, PUBLIC :: cpl_phioc = .FALSE.
	41	LOGICAL, PUBLIC :: cpl_sdrftx = .FALSE.
	42	LOGICAL, PUBLIC :: cpl_sdrfty = .FALSE.
	43	LOGICAL, PUBLIC :: cpl_wper = .FALSE.
[9023]	44	LOGICAL, PUBLIC :: cpl_wfreq = .FALSE.
[7646]	45	LOGICAL, PUBLIC :: cpl_wnum = .FALSE.
[9115]	46	LOGICAL, PUBLIC :: cpl_tauwoc = .FALSE.
[9023]	47	LOGICAL, PUBLIC :: cpl_tauw = .FALSE.
[7646]	48	LOGICAL, PUBLIC :: cpl_wdrag = .FALSE.
[5836]	49
[7646]	50	INTEGER :: jpfld ! number of files to read for stokes drift
	51	INTEGER :: jp_usd ! index of stokes drift (i-component) (m/s) at T-point
	52	INTEGER :: jp_vsd ! index of stokes drift (j-component) (m/s) at T-point
	53	INTEGER :: jp_hsw ! index of significant wave hight (m) at T-point
	54	INTEGER :: jp_wmp ! index of mean wave period (s) at T-point
[9023]	55	INTEGER :: jp_wfr ! index of wave peak frequency (1/s) at T-point
[2990]	56
[7646]	57	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_cd ! structure of input fields (file informations, fields read) Drag Coefficient
	58	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sd ! structure of input fields (file informations, fields read) Stokes Drift
	59	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_wn ! structure of input fields (file informations, fields read) wave number for Qiao
[9115]	60	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tauwoc ! structure of input fields (file informations, fields read) normalized wave stress into the ocean
[9023]	61	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tauw ! structure of input fields (file informations, fields read) ocean stress components from wave model
	62
[7646]	63	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: cdn_wave !:
	64	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hsw, wmp, wnum !:
[9023]	65	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: wfreq !:
[7646]	66	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauoc_wave !:
[9023]	67	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauw_x, tauw_y !:
[7646]	68	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tsd2d !:
	69	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: div_sd !: barotropic stokes drift divergence
	70	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ut0sd, vt0sd !: surface Stokes drift velocities at t-point
	71	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: usd , vsd , wsd !: Stokes drift velocities at u-, v- & w-points, resp.
[5836]	72
[3680]	73	!! * Substitutions
[5836]	74	# include "vectopt_loop_substitute.h90"
[2990]	75	!!----------------------------------------------------------------------
[10068]	76	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5215]	77	!! $Id$
[10068]	78	!! Software governed by the CeCILL license (see ./LICENSE)
[2990]	79	!!----------------------------------------------------------------------
	80	CONTAINS
	81
[10922]	82	SUBROUTINE sbc_stokes( Kmm )
[7646]	83	!!---------------------------------------------------------------------
	84	!! * ROUTINE sbc_stokes *
	85	!!
	86	!! ** Purpose : compute the 3d Stokes Drift according to Breivik et al.,
	87	!! 2014 (DOI: 10.1175/JPO-D-14-0020.1)
	88	!!
	89	!! ** Method : - Calculate Stokes transport speed
	90	!! - Calculate horizontal divergence
	91	!! - Integrate the horizontal divergenze from the bottom
	92	!! ** action
	93	!!---------------------------------------------------------------------
[10922]	94	INTEGER, INTENT(in) :: Kmm ! ocean time level index
[7646]	95	INTEGER :: jj, ji, jk ! dummy loop argument
	96	INTEGER :: ik ! local integer
[9019]	97	REAL(wp) :: ztransp, zfac, zsp0
	98	REAL(wp) :: zdepth, zsqrt_depth, zexp_depth, z_two_thirds, zsqrtpi !sqrt of pi
	99	REAL(wp) :: zbot_u, zbot_v, zkb_u, zkb_v, zke3_u, zke3_v, zda_u, zda_v
	100	REAL(wp) :: zstokes_psi_u_bot, zstokes_psi_v_bot
[9029]	101	REAL(wp) :: zdep_u, zdep_v, zkh_u, zkh_v
[9115]	102	REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zk_t, zk_u, zk_v, zu0_sd, zv0_sd ! 2D workspace
	103	REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zstokes_psi_u_top, zstokes_psi_v_top ! 2D workspace
	104	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ze3divh ! 3D workspace
[7646]	105	!!---------------------------------------------------------------------
	106	!
[9115]	107	ALLOCATE( ze3divh(jpi,jpj,jpk) )
	108	ALLOCATE( zk_t(jpi,jpj), zk_u(jpi,jpj), zk_v(jpi,jpj), zu0_sd(jpi,jpj), zv0_sd(jpi,jpj) )
[7646]	109	!
[9023]	110	! select parameterization for the calculation of vertical Stokes drift
	111	! exp. wave number at t-point
[9115]	112	IF( ll_st_bv_li ) THEN ! (Eq. (19) in Breivik et al. (2014) )
[9023]	113	zfac = 2.0_wp * rpi / 16.0_wp
	114	DO jj = 1, jpj
	115	DO ji = 1, jpi
[7646]	116	! Stokes drift velocity estimated from Hs and Tmean
[9023]	117	ztransp = zfac * hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp )
[7646]	118	! Stokes surface speed
[9023]	119	tsd2d(ji,jj) = SQRT( ut0sd(ji,jj)ut0sd(ji,jj) + vt0sd(ji,jj)vt0sd(ji,jj))
[7646]	120	! Wavenumber scale
[9023]	121	zk_t(ji,jj) = ABS( tsd2d(ji,jj) ) / MAX( ABS( 5.97_wp*ztransp ), 0.0000001_wp )
	122	END DO
[7646]	123	END DO
[9023]	124	DO jj = 1, jpjm1 ! exp. wave number & Stokes drift velocity at u- & v-points
	125	DO ji = 1, jpim1
	126	zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
	127	zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
	128	!
	129	zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
	130	zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
	131	END DO
[7646]	132	END DO
[9115]	133	ELSE IF( ll_st_peakfr ) THEN ! peak wave number calculated from the peak frequency received by the wave model
[9966]	134	DO jj = 1, jpj
	135	DO ji = 1, jpi
	136	zk_t(ji,jj) = ( 2.0_wp * rpi * wfreq(ji,jj) ) * ( 2.0_wp * rpi * wfreq(ji,jj) ) / grav
	137	END DO
	138	END DO
[9023]	139	DO jj = 1, jpjm1
	140	DO ji = 1, jpim1
[9966]	141	zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
	142	zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
[9023]	143	!
	144	zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
	145	zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
	146	END DO
	147	END DO
	148	ENDIF
[7646]	149	!
	150	! !== horizontal Stokes Drift 3D velocity ==!
[9115]	151	IF( ll_st_bv2014 ) THEN
[9023]	152	DO jk = 1, jpkm1
	153	DO jj = 2, jpjm1
	154	DO ji = 2, jpim1
[10922]	155	zdep_u = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji+1,jj,jk,Kmm) )
	156	zdep_v = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji,jj+1,jk,Kmm) )
[9023]	157	!
	158	zkh_u = zk_u(ji,jj) * zdep_u ! k * depth
	159	zkh_v = zk_v(ji,jj) * zdep_v
	160	! ! Depth attenuation
	161	zda_u = EXP( -2.0_wpzkh_u ) / ( 1.0_wp + 8.0_wpzkh_u )
	162	zda_v = EXP( -2.0_wpzkh_v ) / ( 1.0_wp + 8.0_wpzkh_v )
	163	!
	164	usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
	165	vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
	166	END DO
	167	END DO
[9019]	168	END DO
[9115]	169	ELSE IF( ll_st_li2017 .OR. ll_st_peakfr ) THEN
	170	ALLOCATE( zstokes_psi_u_top(jpi,jpj), zstokes_psi_v_top(jpi,jpj) )
	171	DO jj = 1, jpjm1 ! exp. wave number & Stokes drift velocity at u- & v-points
	172	DO ji = 1, jpim1
	173	zstokes_psi_u_top(ji,jj) = 0._wp
	174	zstokes_psi_v_top(ji,jj) = 0._wp
	175	END DO
	176	END DO
[9117]	177	zsqrtpi = SQRT(rpi)
	178	z_two_thirds = 2.0_wp / 3.0_wp
[9023]	179	DO jk = 1, jpkm1
	180	DO jj = 2, jpjm1
	181	DO ji = 2, jpim1
[10922]	182	zbot_u = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji+1,jj,jk+1,Kmm) ) ! 2 * bottom depth
	183	zbot_v = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji,jj+1,jk+1,Kmm) ) ! 2 * bottom depth
[9117]	184	zkb_u = zk_u(ji,jj) * zbot_u ! 2 * k * bottom depth
	185	zkb_v = zk_v(ji,jj) * zbot_v ! 2 * k * bottom depth
[9023]	186	!
[10922]	187	zke3_u = MAX(1.e-8_wp, 2.0_wp * zk_u(ji,jj) * e3u(ji,jj,jk,Kmm)) ! 2k * thickness
	188	zke3_v = MAX(1.e-8_wp, 2.0_wp * zk_v(ji,jj) * e3v(ji,jj,jk,Kmm)) ! 2k * thickness
[9115]	189
	190	! Depth attenuation .... do u component first..
	191	zdepth = zkb_u
	192	zsqrt_depth = SQRT(zdepth)
	193	zexp_depth = EXP(-zdepth)
	194	zstokes_psi_u_bot = 1.0_wp - zexp_depth &
	195	& - z_two_thirds * ( zsqrtpizsqrt_depthzdepth*ERFC(zsqrt_depth) &
	196	& + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )
	197	zda_u = ( zstokes_psi_u_bot - zstokes_psi_u_top(ji,jj) ) / zke3_u
	198	zstokes_psi_u_top(ji,jj) = zstokes_psi_u_bot
	199
	200	! ... and then v component
	201	zdepth =zkb_v
	202	zsqrt_depth = SQRT(zdepth)
	203	zexp_depth = EXP(-zdepth)
	204	zstokes_psi_v_bot = 1.0_wp - zexp_depth &
	205	& - z_two_thirds * ( zsqrtpizsqrt_depthzdepth*ERFC(zsqrt_depth) &
	206	& + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )
	207	zda_v = ( zstokes_psi_v_bot - zstokes_psi_v_top(ji,jj) ) / zke3_v
	208	zstokes_psi_v_top(ji,jj) = zstokes_psi_v_bot
	209	!
[9023]	210	usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
	211	vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
	212	END DO
[7646]	213	END DO
	214	END DO
[9115]	215	DEALLOCATE( zstokes_psi_u_top, zstokes_psi_v_top )
[9023]	216	ENDIF
	217
[10425]	218	CALL lbc_lnk_multi( 'sbcwave', usd, 'U', -1., vsd, 'V', -1. )
[9019]	219
[7646]	220	!
	221	! !== vertical Stokes Drift 3D velocity ==!
	222	!
	223	DO jk = 1, jpkm1 ! Horizontal e3*divergence
	224	DO jj = 2, jpj
	225	DO ji = fs_2, jpi
[10922]	226	ze3divh(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * usd(ji ,jj,jk) &
	227	& - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * usd(ji-1,jj,jk) &
	228	& + e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) * vsd(ji,jj ,jk) &
	229	& - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vsd(ji,jj-1,jk) ) * r1_e1e2t(ji,jj)
[7646]	230	END DO
	231	END DO
	232	END DO
	233	!
[9019]	234	#if defined key_agrif
	235	IF( .NOT. Agrif_Root() ) THEN
	236	IF( nbondi == -1 .OR. nbondi == 2 ) ze3divh( 2:nbghostcells+1,: ,:) = 0._wp ! west
	237	IF( nbondi == 1 .OR. nbondi == 2 ) ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp ! east
	238	IF( nbondj == -1 .OR. nbondj == 2 ) ze3divh( :,2:nbghostcells+1 ,:) = 0._wp ! south
	239	IF( nbondj == 1 .OR. nbondj == 2 ) ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp ! north
[7646]	240	ENDIF
[9019]	241	#endif
[7646]	242	!
[10425]	243	CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1. )
[7646]	244	!
	245	IF( ln_linssh ) THEN ; ik = 1 ! none zero velocity through the sea surface
	246	ELSE ; ik = 2 ! w=0 at the surface (set one for all in sbc_wave_init)
	247	ENDIF
	248	DO jk = jpkm1, ik, -1 ! integrate from the bottom the hor. divergence (NB: at k=jpk w is always zero)
	249	wsd(:,:,jk) = wsd(:,:,jk+1) - ze3divh(:,:,jk)
	250	END DO
	251	!
	252	IF( ln_bdy ) THEN
	253	DO jk = 1, jpkm1
	254	wsd(:,:,jk) = wsd(:,:,jk) * bdytmask(:,:)
	255	END DO
	256	ENDIF
	257	! !== Horizontal divergence of barotropic Stokes transport ==!
	258	div_sd(:,:) = 0._wp
	259	DO jk = 1, jpkm1 !
	260	div_sd(:,:) = div_sd(:,:) + ze3divh(:,:,jk)
	261	END DO
	262	!
	263	CALL iom_put( "ustokes", usd )
	264	CALL iom_put( "vstokes", vsd )
	265	CALL iom_put( "wstokes", wsd )
	266	!
[9115]	267	DEALLOCATE( ze3divh )
	268	DEALLOCATE( zk_t, zk_u, zk_v, zu0_sd, zv0_sd )
[7646]	269	!
	270	END SUBROUTINE sbc_stokes
	271
	272
[9023]	273	SUBROUTINE sbc_wstress( )
	274	!!---------------------------------------------------------------------
	275	!! * ROUTINE sbc_wstress *
	276	!!
	277	!! ** Purpose : Updates the ocean momentum modified by waves
	278	!!
	279	!! ** Method : - Calculate u,v components of stress depending on stress
	280	!! model
	281	!! - Calculate the stress module
	282	!! - The wind module is not modified by waves
	283	!! ** action
	284	!!---------------------------------------------------------------------
	285	INTEGER :: jj, ji ! dummy loop argument
	286	!
[9033]	287	IF( ln_tauwoc ) THEN
[9023]	288	utau(:,:) = utau(:,:)*tauoc_wave(:,:)
	289	vtau(:,:) = vtau(:,:)*tauoc_wave(:,:)
	290	taum(:,:) = taum(:,:)*tauoc_wave(:,:)
	291	ENDIF
	292	!
	293	IF( ln_tauw ) THEN
	294	DO jj = 1, jpjm1
	295	DO ji = 1, jpim1
	296	! Stress components at u- & v-points
	297	utau(ji,jj) = 0.5_wp * ( tauw_x(ji,jj) + tauw_x(ji+1,jj) )
	298	vtau(ji,jj) = 0.5_wp * ( tauw_y(ji,jj) + tauw_y(ji,jj+1) )
	299	!
	300	! Stress module at t points
	301	taum(ji,jj) = SQRT( tauw_x(ji,jj)tauw_x(ji,jj) + tauw_y(ji,jj)tauw_y(ji,jj) )
	302	END DO
	303	END DO
[10425]	304	CALL lbc_lnk_multi( 'sbcwave', utau(:,:), 'U', -1. , vtau(:,:), 'V', -1. , taum(:,:) , 'T', -1. )
[9023]	305	ENDIF
	306	!
	307	END SUBROUTINE sbc_wstress
	308
	309
[10922]	310	SUBROUTINE sbc_wave( kt, Kmm )
[2990]	311	!!---------------------------------------------------------------------
[7646]	312	!! * ROUTINE sbc_wave *
[2990]	313	!!
[7646]	314	!! ** Purpose : read wave parameters from wave model in netcdf files.
[2990]	315	!!
	316	!! ** Method : - Read namelist namsbc_wave
	317	!! - Read Cd_n10 fields in netcdf files
[3680]	318	!! - Read stokes drift 2d in netcdf files
[7646]	319	!! - Read wave number in netcdf files
	320	!! - Compute 3d stokes drift using Breivik et al.,2014
	321	!! formulation
	322	!! ** action
[2990]	323	!!---------------------------------------------------------------------
[7646]	324	INTEGER, INTENT(in ) :: kt ! ocean time step
[10922]	325	INTEGER, INTENT(in ) :: Kmm ! ocean time index
[2990]	326	!!---------------------------------------------------------------------
	327	!
[7646]	328	IF( ln_cdgw .AND. .NOT. cpl_wdrag ) THEN !== Neutral drag coefficient ==!
	329	CALL fld_read( kt, nn_fsbc, sf_cd ) ! read from external forcing
[9821]	330	cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) * tmask(:,:,1)
[7646]	331	ENDIF
	332
[9115]	333	IF( ln_tauwoc .AND. .NOT. cpl_tauwoc ) THEN !== Wave induced stress ==!
	334	CALL fld_read( kt, nn_fsbc, sf_tauwoc ) ! read wave norm stress from external forcing
[9821]	335	tauoc_wave(:,:) = sf_tauwoc(1)%fnow(:,:,1) * tmask(:,:,1)
[7646]	336	ENDIF
	337
[9023]	338	IF( ln_tauw .AND. .NOT. cpl_tauw ) THEN !== Wave induced stress ==!
	339	CALL fld_read( kt, nn_fsbc, sf_tauw ) ! read ocean stress components from external forcing (T grid)
[9821]	340	tauw_x(:,:) = sf_tauw(1)%fnow(:,:,1) * tmask(:,:,1)
	341	tauw_y(:,:) = sf_tauw(2)%fnow(:,:,1) * tmask(:,:,1)
[9023]	342	ENDIF
	343
[7646]	344	IF( ln_sdw ) THEN !== Computation of the 3d Stokes Drift ==!
[6140]	345	!
[7646]	346	IF( jpfld > 0 ) THEN ! Read from file only if the field is not coupled
	347	CALL fld_read( kt, nn_fsbc, sf_sd ) ! read wave parameters from external forcing
[9821]	348	IF( jp_hsw > 0 ) hsw (:,:) = sf_sd(jp_hsw)%fnow(:,:,1) * tmask(:,:,1) ! significant wave height
	349	IF( jp_wmp > 0 ) wmp (:,:) = sf_sd(jp_wmp)%fnow(:,:,1) * tmask(:,:,1) ! wave mean period
	350	IF( jp_wfr > 0 ) wfreq(:,:) = sf_sd(jp_wfr)%fnow(:,:,1) * tmask(:,:,1) ! Peak wave frequency
	351	IF( jp_usd > 0 ) ut0sd(:,:) = sf_sd(jp_usd)%fnow(:,:,1) * tmask(:,:,1) ! 2D zonal Stokes Drift at T point
	352	IF( jp_vsd > 0 ) vt0sd(:,:) = sf_sd(jp_vsd)%fnow(:,:,1) * tmask(:,:,1) ! 2D meridional Stokes Drift at T point
[7646]	353	ENDIF
[2990]	354	!
[7646]	355	! Read also wave number if needed, so that it is available in coupling routines
[9019]	356	IF( ln_zdfswm .AND. .NOT.cpl_wnum ) THEN
[7646]	357	CALL fld_read( kt, nn_fsbc, sf_wn ) ! read wave parameters from external forcing
[9821]	358	wnum(:,:) = sf_wn(1)%fnow(:,:,1) * tmask(:,:,1)
[6140]	359	ENDIF
[7646]	360
[9115]	361	! Calculate only if required fields have been read
	362	! In coupled wave model-NEMO case the call is done after coupling
[6140]	363	!
[9115]	364	IF( ( ll_st_bv_li .AND. jp_hsw>0 .AND. jp_wmp>0 .AND. jp_usd>0 .AND. jp_vsd>0 ) .OR. &
[10922]	365	& ( ll_st_peakfr .AND. jp_wfr>0 .AND. jp_usd>0 .AND. jp_vsd>0 ) ) CALL sbc_stokes( Kmm )
[6140]	366	!
[7646]	367	ENDIF
	368	!
	369	END SUBROUTINE sbc_wave
	370
	371
	372	SUBROUTINE sbc_wave_init
	373	!!---------------------------------------------------------------------
	374	!! * ROUTINE sbc_wave_init *
	375	!!
	376	!! ** Purpose : read wave parameters from wave model in netcdf files.
	377	!!
	378	!! ** Method : - Read namelist namsbc_wave
	379	!! - Read Cd_n10 fields in netcdf files
	380	!! - Read stokes drift 2d in netcdf files
	381	!! - Read wave number in netcdf files
	382	!! - Compute 3d stokes drift using Breivik et al.,2014
	383	!! formulation
	384	!! ** action
	385	!!---------------------------------------------------------------------
	386	INTEGER :: ierror, ios ! local integer
	387	INTEGER :: ifpr
	388	!!
[9115]	389	CHARACTER(len=100) :: cn_dir ! Root directory for location of drag coefficient files
[9023]	390	TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i, slf_j ! array of namelist informations on the fields to read
[7646]	391	TYPE(FLD_N) :: sn_cdg, sn_usd, sn_vsd, &
[9023]	392	& sn_hsw, sn_wmp, sn_wfr, sn_wnum, &
[9115]	393	& sn_tauwoc, sn_tauwx, sn_tauwy ! informations about the fields to be read
[7646]	394	!
[9023]	395	NAMELIST/namsbc_wave/ sn_cdg, cn_dir, sn_usd, sn_vsd, sn_hsw, sn_wmp, sn_wfr, &
[9033]	396	sn_wnum, sn_tauwoc, sn_tauwx, sn_tauwy
[7646]	397	!!---------------------------------------------------------------------
	398	!
	399	REWIND( numnam_ref ) ! Namelist namsbc_wave in reference namelist : File for drag coeff. from wave model
	400	READ ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901)
[11822]	401	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist' )
[7646]	402
	403	REWIND( numnam_cfg ) ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model
	404	READ ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 )
[11822]	405	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist' )
[7646]	406	IF(lwm) WRITE ( numond, namsbc_wave )
	407	!
	408	IF( ln_cdgw ) THEN
	409	IF( .NOT. cpl_wdrag ) THEN
[9115]	410	ALLOCATE( sf_cd(1), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg
[7646]	411	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' )
[3680]	412	!
	413	ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1) )
	414	IF( sn_cdg%ln_tint ) ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) )
[7646]	415	CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' )
[5836]	416	ENDIF
[7646]	417	ALLOCATE( cdn_wave(jpi,jpj) )
	418	ENDIF
	419
[9033]	420	IF( ln_tauwoc ) THEN
	421	IF( .NOT. cpl_tauwoc ) THEN
	422	ALLOCATE( sf_tauwoc(1), STAT=ierror ) !* allocate and fill sf_wave with sn_tauwoc
[7646]	423	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' )
[3680]	424	!
[9115]	425	ALLOCATE( sf_tauwoc(1)%fnow(jpi,jpj,1) )
[9033]	426	IF( sn_tauwoc%ln_tint ) ALLOCATE( sf_tauwoc(1)%fdta(jpi,jpj,1,2) )
	427	CALL fld_fill( sf_tauwoc, (/ sn_tauwoc /), cn_dir, 'sbc_wave_init', 'Wave module', 'namsbc_wave' )
[7646]	428	ENDIF
	429	ALLOCATE( tauoc_wave(jpi,jpj) )
	430	ENDIF
	431
[9023]	432	IF( ln_tauw ) THEN
	433	IF( .NOT. cpl_tauw ) THEN
	434	ALLOCATE( sf_tauw(2), STAT=ierror ) !* allocate and fill sf_wave with sn_tauwx/y
	435	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_tauw structure' )
	436	!
	437	ALLOCATE( slf_j(2) )
	438	slf_j(1) = sn_tauwx
	439	slf_j(2) = sn_tauwy
	440	ALLOCATE( sf_tauw(1)%fnow(jpi,jpj,1) )
	441	ALLOCATE( sf_tauw(2)%fnow(jpi,jpj,1) )
	442	IF( slf_j(1)%ln_tint ) ALLOCATE( sf_tauw(1)%fdta(jpi,jpj,1,2) )
	443	IF( slf_j(2)%ln_tint ) ALLOCATE( sf_tauw(2)%fdta(jpi,jpj,1,2) )
	444	CALL fld_fill( sf_tauw, (/ slf_j /), cn_dir, 'sbc_wave_init', 'read wave input', 'namsbc_wave' )
	445	ENDIF
	446	ALLOCATE( tauw_x(jpi,jpj) )
	447	ALLOCATE( tauw_y(jpi,jpj) )
	448	ENDIF
	449
[7646]	450	IF( ln_sdw ) THEN ! Find out how many fields have to be read from file if not coupled
	451	jpfld=0
[9023]	452	jp_usd=0 ; jp_vsd=0 ; jp_hsw=0 ; jp_wmp=0 ; jp_wfr=0
[7646]	453	IF( .NOT. cpl_sdrftx ) THEN
	454	jpfld = jpfld + 1
	455	jp_usd = jpfld
	456	ENDIF
	457	IF( .NOT. cpl_sdrfty ) THEN
	458	jpfld = jpfld + 1
	459	jp_vsd = jpfld
	460	ENDIF
[9115]	461	IF( .NOT. cpl_hsig .AND. ll_st_bv_li ) THEN
[7646]	462	jpfld = jpfld + 1
	463	jp_hsw = jpfld
	464	ENDIF
[9115]	465	IF( .NOT. cpl_wper .AND. ll_st_bv_li ) THEN
[7646]	466	jpfld = jpfld + 1
	467	jp_wmp = jpfld
	468	ENDIF
[9115]	469	IF( .NOT. cpl_wfreq .AND. ll_st_peakfr ) THEN
[9023]	470	jpfld = jpfld + 1
	471	jp_wfr = jpfld
	472	ENDIF
[7646]	473
	474	! Read from file only the non-coupled fields
	475	IF( jpfld > 0 ) THEN
	476	ALLOCATE( slf_i(jpfld) )
	477	IF( jp_usd > 0 ) slf_i(jp_usd) = sn_usd
	478	IF( jp_vsd > 0 ) slf_i(jp_vsd) = sn_vsd
	479	IF( jp_hsw > 0 ) slf_i(jp_hsw) = sn_hsw
	480	IF( jp_wmp > 0 ) slf_i(jp_wmp) = sn_wmp
[9023]	481	IF( jp_wfr > 0 ) slf_i(jp_wfr) = sn_wfr
	482
[7646]	483	ALLOCATE( sf_sd(jpfld), STAT=ierror ) !* allocate and fill sf_sd with stokes drift
	484	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' )
	485	!
[3680]	486	DO ifpr= 1, jpfld
	487	ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) )
	488	IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) )
	489	END DO
[7646]	490	!
	491	CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' )
[3680]	492	ENDIF
[7646]	493	ALLOCATE( usd (jpi,jpj,jpk), vsd (jpi,jpj,jpk), wsd(jpi,jpj,jpk) )
	494	ALLOCATE( hsw (jpi,jpj) , wmp (jpi,jpj) )
[9023]	495	ALLOCATE( wfreq(jpi,jpj) )
[7646]	496	ALLOCATE( ut0sd(jpi,jpj) , vt0sd(jpi,jpj) )
	497	ALLOCATE( div_sd(jpi,jpj) )
	498	ALLOCATE( tsd2d (jpi,jpj) )
[9019]	499
	500	ut0sd(:,:) = 0._wp
	501	vt0sd(:,:) = 0._wp
	502	hsw(:,:) = 0._wp
	503	wmp(:,:) = 0._wp
	504
[7646]	505	usd(:,:,:) = 0._wp
	506	vsd(:,:,:) = 0._wp
	507	wsd(:,:,:) = 0._wp
[9019]	508	! Wave number needed only if ln_zdfswm=T
[7646]	509	IF( .NOT. cpl_wnum ) THEN
	510	ALLOCATE( sf_wn(1), STAT=ierror ) !* allocate and fill sf_wave with sn_wnum
	511	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable toallocate sf_wave structure' )
	512	ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1) )
	513	IF( sn_wnum%ln_tint ) ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) )
	514	CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' )
[5836]	515	ENDIF
[7646]	516	ALLOCATE( wnum(jpi,jpj) )
[3680]	517	ENDIF
[5836]	518	!
[7646]	519	END SUBROUTINE sbc_wave_init
	520
[2990]	521	!!======================================================================
	522	END MODULE sbcwave

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

Download in other formats: