Context Navigation

← Previous Revision
Next Revision →
Normal
Revision Log

sbcwave.F90

Last change on this file was 15199, checked in by amoulin, 3 years ago
read wave number field if ln_zdfswm activated - ticket #2685
Property svn:keywords set to `Id`
File size: 27.8 KB

Rev	Line
[2990]	1	MODULE sbcwave
	2	!!======================================================================
	3	!! * MODULE sbcwave *
[14072]	4	!! Wave module
[2990]	5	!!======================================================================
[14072]	6	!! History : 3.3 ! 2011-09 (M. Adani) Original code: Drag Coefficient
	7	!! : 3.4 ! 2012-10 (M. Adani) Stokes Drift
[7646]	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
[14072]	11	!! 4.2 ! 2020-12 (G. Madec, E. Clementi) updates, new Stoke drift computation
[14007]	12	!! according to Couvelard et al.,2019
[2990]	13	!!----------------------------------------------------------------------
	14
	15	!!----------------------------------------------------------------------
[7646]	16	!! sbc_stokes : calculate 3D Stokes-drift velocities
[14007]	17	!! sbc_wave : wave data from wave model: forced (netcdf files) or coupled mode
[14072]	18	!! sbc_wave_init : initialisation fo surface waves
[2990]	19	!!----------------------------------------------------------------------
[14007]	20	USE phycst ! physical constants
[7646]	21	USE oce ! ocean variables
[14007]	22	USE dom_oce ! ocean domain variables
	23	USE sbc_oce ! Surface boundary condition: ocean fields
[7646]	24	USE bdy_oce ! open boundary condition variables
	25	USE domvvl ! domain: variable volume layers
[14961]	26	USE zdf_oce, ONLY : ln_zdfswm ! Qiao wave enhanced mixing
[5836]	27	!
	28	USE iom ! I/O manager library
	29	USE in_out_manager ! I/O manager
	30	USE lib_mpp ! distribued memory computing library
[14007]	31	USE fldread ! read input fields
[2990]	32
	33	IMPLICIT NONE
	34	PRIVATE
	35
[7646]	36	PUBLIC sbc_stokes ! routine called in sbccpl
	37	PUBLIC sbc_wave ! routine called in sbcmod
	38	PUBLIC sbc_wave_init ! routine called in sbcmod
[14072]	39
[7646]	40	! Variables checking if the wave parameters are coupled (if not, they are read from file)
[14007]	41	LOGICAL, PUBLIC :: cpl_hsig = .FALSE.
	42	LOGICAL, PUBLIC :: cpl_phioc = .FALSE.
	43	LOGICAL, PUBLIC :: cpl_sdrftx = .FALSE.
	44	LOGICAL, PUBLIC :: cpl_sdrfty = .FALSE.
	45	LOGICAL, PUBLIC :: cpl_wper = .FALSE.
	46	LOGICAL, PUBLIC :: cpl_wnum = .FALSE.
	47	LOGICAL, PUBLIC :: cpl_wstrf = .FALSE.
	48	LOGICAL, PUBLIC :: cpl_wdrag = .FALSE.
	49	LOGICAL, PUBLIC :: cpl_charn = .FALSE.
	50	LOGICAL, PUBLIC :: cpl_taw = .FALSE.
	51	LOGICAL, PUBLIC :: cpl_bhd = .FALSE.
	52	LOGICAL, PUBLIC :: cpl_tusd = .FALSE.
	53	LOGICAL, PUBLIC :: cpl_tvsd = .FALSE.
[5836]	54
[7646]	55	INTEGER :: jpfld ! number of files to read for stokes drift
	56	INTEGER :: jp_usd ! index of stokes drift (i-component) (m/s) at T-point
	57	INTEGER :: jp_vsd ! index of stokes drift (j-component) (m/s) at T-point
	58	INTEGER :: jp_hsw ! index of significant wave hight (m) at T-point
	59	INTEGER :: jp_wmp ! index of mean wave period (s) at T-point
[2990]	60
[7646]	61	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_cd ! structure of input fields (file informations, fields read) Drag Coefficient
	62	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sd ! structure of input fields (file informations, fields read) Stokes Drift
	63	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_wn ! structure of input fields (file informations, fields read) wave number for Qiao
[14007]	64	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tauoc ! structure of input fields (file informations, fields read) normalized wave stress into the ocean
[9023]	65
[14007]	66	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: cdn_wave !: Neutral drag coefficient at t-point
	67	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hsw !: Significant Wave Height at t-point
	68	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: wmp !: Wave Mean Period at t-point
	69	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: wnum !: Wave Number at t-point
	70	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauoc_wave !: stress reduction factor at t-point
	71	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tsd2d !: Surface Stokes Drift module at t-point
	72	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: div_sd !: barotropic stokes drift divergence
	73	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ut0sd, vt0sd !: surface Stokes drift velocities at t-point
	74	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: usd, vsd, wsd !: Stokes drift velocities at u-, v- & w-points, resp.u
	75	!
	76	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: charn !: charnock coefficient at t-point
	77	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tawx !: Net wave-supported stress, u
	78	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tawy !: Net wave-supported stress, v
	79	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: twox !: wave-ocean momentum flux, u
	80	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: twoy !: wave-ocean momentum flux, v
	81	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauoc_wavex !: stress reduction factor at, u component
	82	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauoc_wavey !: stress reduction factor at, v component
	83	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: phioc !: tke flux from wave model
	84	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: KZN2 !: Kz*N2
	85	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: bhd_wave !: Bernoulli head. wave induce pression
	86	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tusd, tvsd !: Stokes drift transport
	87	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: ZMX !: Kz*N2
[3680]	88	!! * Substitutions
[12377]	89	# include "do_loop_substitute.h90"
[13237]	90	# include "domzgr_substitute.h90"
[2990]	91	!!----------------------------------------------------------------------
[10068]	92	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5215]	93	!! $Id$
[10068]	94	!! Software governed by the CeCILL license (see ./LICENSE)
[2990]	95	!!----------------------------------------------------------------------
	96	CONTAINS
	97
[12377]	98	SUBROUTINE sbc_stokes( Kmm )
[7646]	99	!!---------------------------------------------------------------------
	100	!! * ROUTINE sbc_stokes *
	101	!!
	102	!! ** Purpose : compute the 3d Stokes Drift according to Breivik et al.,
	103	!! 2014 (DOI: 10.1175/JPO-D-14-0020.1)
	104	!!
[14007]	105	!! ** Method : - Calculate the horizontal Stokes drift velocity (Breivik et al. 2014)
	106	!! - Calculate its horizontal divergence
	107	!! - Calculate the vertical Stokes drift velocity
	108	!! - Calculate the barotropic Stokes drift divergence
	109	!!
	110	!! ** action : - tsd2d : module of the surface Stokes drift velocity
	111	!! - usd, vsd, wsd : 3 components of the Stokes drift velocity
	112	!! - div_sd : barotropic Stokes drift divergence
[7646]	113	!!---------------------------------------------------------------------
[12377]	114	INTEGER, INTENT(in) :: Kmm ! ocean time level index
[7646]	115	INTEGER :: jj, ji, jk ! dummy loop argument
[14072]	116	INTEGER :: ik ! local integer
[14007]	117	REAL(wp) :: ztransp, zfac, ztemp, zsp0, zsqrt, zbreiv16_w
	118	REAL(wp) :: zdep_u, zdep_v, zkh_u, zkh_v, zda_u, zda_v, sdtrp
	119	REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zk_t, zk_u, zk_v, zu0_sd, zv0_sd ! 2D workspace
	120	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ze3divh, zInt_w ! 3D workspace
[7646]	121	!!---------------------------------------------------------------------
	122	!
[14007]	123	ALLOCATE( ze3divh(jpi,jpj,jpkm1) ) ! jpkm1 -> avoid lbc_lnk on jpk that is not defined
	124	ALLOCATE( zInt_w(jpi,jpj,jpk) )
[9115]	125	ALLOCATE( zk_t(jpi,jpj), zk_u(jpi,jpj), zk_v(jpi,jpj), zu0_sd(jpi,jpj), zv0_sd(jpi,jpj) )
[14007]	126	zk_t (:,:) = 0._wp
	127	zk_u (:,:) = 0._wp
	128	zk_v (:,:) = 0._wp
	129	zu0_sd (:,:) = 0._wp
	130	zv0_sd (:,:) = 0._wp
	131	ze3divh (:,:,:) = 0._wp
	132
[7646]	133	!
[9023]	134	! select parameterization for the calculation of vertical Stokes drift
	135	! exp. wave number at t-point
[14007]	136	IF( ln_breivikFV_2016 ) THEN
	137	! Assumptions : ut0sd and vt0sd are surface Stokes drift at T-points
	138	! sdtrp is the norm of Stokes transport
	139	!
	140	zfac = 0.166666666667_wp
	141	DO_2D( 1, 1, 1, 1 ) ! In the deep-water limit we have ke = \|\|ust0\|\|/( 6 * \|\|transport\|\| )
	142	zsp0 = SQRT( ut0sd(ji,jj)ut0sd(ji,jj) + vt0sd(ji,jj)vt0sd(ji,jj) ) !<-- norm of Surface Stokes drift
	143	tsd2d(ji,jj) = zsp0
	144	IF( cpl_tusd .AND. cpl_tvsd ) THEN !stokes transport is provided in coupled mode
	145	sdtrp = SQRT( tusd(ji,jj)tusd(ji,jj) + tvsd(ji,jj)tvsd(ji,jj) ) !<-- norm of Surface Stokes drift transport
[14072]	146	ELSE
	147	! Stokes drift transport estimated from Hs and Tmean
[14007]	148	sdtrp = 2.0_wp * rpi / 16.0_wp * &
	149	& hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp )
	150	ENDIF
	151	zk_t (ji,jj) = zfac * zsp0 / MAX ( sdtrp, 0.0000001_wp ) !<-- ke = \|\|ust0\|\|/( 6 * \|\|transport\|\| )
	152	END_2D
	153	!# define zInt_w ze3divh
	154	DO_3D( 1, 1, 1, 1, 1, jpk ) ! Compute the primitive of Breivik 2016 function at W-points
	155	zfac = - 2._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm) !<-- zfac should be negative definite
	156	ztemp = EXP ( zfac )
	157	zsqrt = SQRT( -zfac )
	158	zbreiv16_w = ztemp - SQRT(rpi)zsqrtERFC(zsqrt) !Eq. 16 Breivik 2016
	159	zInt_w(ji,jj,jk) = ztemp - 4._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm) * zbreiv16_w
	160	END_3D
	161	!
	162	DO jk = 1, jpkm1
	163	zfac = 0.166666666667_wp
	164	DO_2D( 1, 1, 1, 1 ) !++ Compute the FV Breivik 2016 function at T-points
	165	zsp0 = zfac / MAX(zk_t (ji,jj),0.0000001_wp)
	166	ztemp = zInt_w(ji,jj,jk) - zInt_w(ji,jj,jk+1)
	167	zu0_sd(ji,jj) = ut0sd(ji,jj) * zsp0 * ztemp * tmask(ji,jj,jk)
	168	zv0_sd(ji,jj) = vt0sd(ji,jj) * zsp0 * ztemp * tmask(ji,jj,jk)
	169	END_2D
	170	DO_2D( 1, 0, 1, 0 ) ! ++ Interpolate at U/V points
	171	zfac = 1.0_wp / e3u(ji ,jj,jk,Kmm)
	172	usd(ji,jj,jk) = 0.5_wp * zfac * ( zu0_sd(ji,jj)+zu0_sd(ji+1,jj) ) * umask(ji,jj,jk)
	173	zfac = 1.0_wp / e3v(ji ,jj,jk,Kmm)
	174	vsd(ji,jj,jk) = 0.5_wp * zfac * ( zv0_sd(ji,jj)+zv0_sd(ji,jj+1) ) * vmask(ji,jj,jk)
	175	END_2D
	176	ENDDO
	177	!# undef zInt_w
	178	!
	179	ELSE
[9023]	180	zfac = 2.0_wp * rpi / 16.0_wp
[13295]	181	DO_2D( 1, 1, 1, 1 )
[12377]	182	! Stokes drift velocity estimated from Hs and Tmean
	183	ztransp = zfac * hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp )
	184	! Stokes surface speed
	185	tsd2d(ji,jj) = SQRT( ut0sd(ji,jj)ut0sd(ji,jj) + vt0sd(ji,jj)vt0sd(ji,jj))
	186	! Wavenumber scale
	187	zk_t(ji,jj) = ABS( tsd2d(ji,jj) ) / MAX( ABS( 5.97_wp*ztransp ), 0.0000001_wp )
	188	END_2D
[13497]	189	DO_2D( 1, 0, 1, 0 ) ! exp. wave number & Stokes drift velocity at u- & v-points
[12377]	190	zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
	191	zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
	192	!
	193	zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
	194	zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
	195	END_2D
[14007]	196
[7646]	197	! !== horizontal Stokes Drift 3D velocity ==!
[14007]	198
[13295]	199	DO_3D( 0, 0, 0, 0, 1, jpkm1 )
[12377]	200	zdep_u = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji+1,jj,jk,Kmm) )
	201	zdep_v = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji,jj+1,jk,Kmm) )
[14007]	202	!
[12377]	203	zkh_u = zk_u(ji,jj) * zdep_u ! k * depth
	204	zkh_v = zk_v(ji,jj) * zdep_v
	205	! ! Depth attenuation
	206	zda_u = EXP( -2.0_wpzkh_u ) / ( 1.0_wp + 8.0_wpzkh_u )
	207	zda_v = EXP( -2.0_wpzkh_v ) / ( 1.0_wp + 8.0_wpzkh_v )
	208	!
	209	usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
	210	vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
	211	END_3D
[9023]	212	ENDIF
	213
[14433]	214	CALL lbc_lnk( 'sbcwave', usd, 'U', -1.0_wp, vsd, 'V', -1.0_wp )
[9019]	215
[7646]	216	!
	217	! !== vertical Stokes Drift 3D velocity ==!
	218	!
[13497]	219	DO_3D( 0, 1, 0, 1, 1, jpkm1 ) ! Horizontal e3*divergence
[12377]	220	ze3divh(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * usd(ji ,jj,jk) &
	221	& - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * usd(ji-1,jj,jk) &
	222	& + e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) * vsd(ji,jj ,jk) &
[13237]	223	& - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vsd(ji,jj-1,jk) ) &
	224	& * r1_e1e2t(ji,jj)
[12377]	225	END_3D
[7646]	226	!
[13226]	227	CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1.0_wp )
[7646]	228	!
	229	IF( ln_linssh ) THEN ; ik = 1 ! none zero velocity through the sea surface
	230	ELSE ; ik = 2 ! w=0 at the surface (set one for all in sbc_wave_init)
	231	ENDIF
	232	DO jk = jpkm1, ik, -1 ! integrate from the bottom the hor. divergence (NB: at k=jpk w is always zero)
	233	wsd(:,:,jk) = wsd(:,:,jk+1) - ze3divh(:,:,jk)
	234	END DO
	235	!
	236	IF( ln_bdy ) THEN
	237	DO jk = 1, jpkm1
	238	wsd(:,:,jk) = wsd(:,:,jk) * bdytmask(:,:)
	239	END DO
	240	ENDIF
	241	! !== Horizontal divergence of barotropic Stokes transport ==!
	242	div_sd(:,:) = 0._wp
[14072]	243	DO jk = 1, jpkm1 !
[7646]	244	div_sd(:,:) = div_sd(:,:) + ze3divh(:,:,jk)
	245	END DO
	246	!
	247	CALL iom_put( "ustokes", usd )
	248	CALL iom_put( "vstokes", vsd )
	249	CALL iom_put( "wstokes", wsd )
[14007]	250	! !
	251	DEALLOCATE( ze3divh, zInt_w )
[9115]	252	DEALLOCATE( zk_t, zk_u, zk_v, zu0_sd, zv0_sd )
[7646]	253	!
	254	END SUBROUTINE sbc_stokes
[14007]	255	!
	256	!
[12377]	257	SUBROUTINE sbc_wave( kt, Kmm )
[2990]	258	!!---------------------------------------------------------------------
[7646]	259	!! * ROUTINE sbc_wave *
[2990]	260	!!
[14007]	261	!! ** Purpose : read wave parameters from wave model in netcdf files
	262	!! or from a coupled wave mdoel
[2990]	263	!!
	264	!!---------------------------------------------------------------------
[7646]	265	INTEGER, INTENT(in ) :: kt ! ocean time step
[12377]	266	INTEGER, INTENT(in ) :: Kmm ! ocean time index
[2990]	267	!!---------------------------------------------------------------------
	268	!
[14007]	269	IF( kt == nit000 .AND. lwp ) THEN
	270	WRITE(numout,*)
	271	WRITE(numout,*) 'sbc_wave : update the read waves fields'
	272	WRITE(numout,*) '~~~~~~~~ '
	273	ENDIF
	274	!
[7646]	275	IF( ln_cdgw .AND. .NOT. cpl_wdrag ) THEN !== Neutral drag coefficient ==!
	276	CALL fld_read( kt, nn_fsbc, sf_cd ) ! read from external forcing
[9821]	277	cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) * tmask(:,:,1)
[7646]	278	ENDIF
	279
[14007]	280	IF( ln_tauoc .AND. .NOT. cpl_wstrf ) THEN !== Wave induced stress ==!
	281	CALL fld_read( kt, nn_fsbc, sf_tauoc ) ! read stress reduction factor due to wave from external forcing
	282	tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1) * tmask(:,:,1)
	283	ELSEIF ( ln_taw .AND. cpl_taw ) THEN
	284	IF (kt < 1) THEN ! The first fields gave by OASIS have very high erroneous values ....
	285	twox(:,:)=0._wp
	286	twoy(:,:)=0._wp
	287	tawx(:,:)=0._wp
	288	tawy(:,:)=0._wp
	289	tauoc_wavex(:,:) = 1._wp
	290	tauoc_wavey(:,:) = 1._wp
	291	ELSE
	292	tauoc_wavex(:,:) = abs(twox(:,:)/tawx(:,:))
	293	tauoc_wavey(:,:) = abs(twoy(:,:)/tawy(:,:))
	294	ENDIF
[7646]	295	ENDIF
	296
[14007]	297	IF ( ln_phioc .and. cpl_phioc .and. kt == nit000 ) THEN
	298	WRITE(numout,*)
	299	WRITE(numout,*) 'sbc_wave : PHIOC from wave model'
	300	WRITE(numout,*) '~~~~~~~~ '
[9023]	301	ENDIF
	302
[14072]	303	IF( ln_sdw .AND. .NOT. cpl_sdrftx) THEN !== Computation of the 3d Stokes Drift ==!
[6140]	304	!
[7646]	305	IF( jpfld > 0 ) THEN ! Read from file only if the field is not coupled
	306	CALL fld_read( kt, nn_fsbc, sf_sd ) ! read wave parameters from external forcing
[14007]	307	! ! NB: test case mode, not read as jpfld=0
[9821]	308	IF( jp_hsw > 0 ) hsw (:,:) = sf_sd(jp_hsw)%fnow(:,:,1) * tmask(:,:,1) ! significant wave height
	309	IF( jp_wmp > 0 ) wmp (:,:) = sf_sd(jp_wmp)%fnow(:,:,1) * tmask(:,:,1) ! wave mean period
	310	IF( jp_usd > 0 ) ut0sd(:,:) = sf_sd(jp_usd)%fnow(:,:,1) * tmask(:,:,1) ! 2D zonal Stokes Drift at T point
	311	IF( jp_vsd > 0 ) vt0sd(:,:) = sf_sd(jp_vsd)%fnow(:,:,1) * tmask(:,:,1) ! 2D meridional Stokes Drift at T point
[7646]	312	ENDIF
[14961]	313
	314	! Read also wave number if needed, so that it is available in
	315	! coupling routines
	316	IF( ln_zdfswm .AND. .NOT. cpl_wnum ) THEN !==wavenumber==!
	317	CALL fld_read( kt, nn_fsbc, sf_wn ) ! read wave parameters from external forcing
	318	wnum(:,:) = sf_wn(1)%fnow(:,:,1) * tmask(:,:,1)
	319	ENDIF
	320
[2990]	321	!
[14007]	322	IF( jpfld == 4 .OR. ln_wave_test ) &
	323	& CALL sbc_stokes( Kmm ) ! Calculate only if all required fields are read
	324	! ! or in wave test case
	325	! ! ! In coupled case the call is done after (in sbc_cpl)
	326	ENDIF
[6140]	327	!
[7646]	328	END SUBROUTINE sbc_wave
	329
	330
	331	SUBROUTINE sbc_wave_init
	332	!!---------------------------------------------------------------------
	333	!! * ROUTINE sbc_wave_init *
	334	!!
[14007]	335	!! ** Purpose : Initialisation fo surface waves
[7646]	336	!!
	337	!! ** Method : - Read namelist namsbc_wave
[14007]	338	!! - create the structure used to read required wave fields
	339	!! (its size depends on namelist options)
[14072]	340	!! ** action
[7646]	341	!!---------------------------------------------------------------------
	342	INTEGER :: ierror, ios ! local integer
	343	INTEGER :: ifpr
	344	!!
[9115]	345	CHARACTER(len=100) :: cn_dir ! Root directory for location of drag coefficient files
[14007]	346	TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read
[7646]	347	TYPE(FLD_N) :: sn_cdg, sn_usd, sn_vsd, &
[14007]	348	& sn_hsw, sn_wmp, sn_wnum, sn_tauoc ! informations about the fields to be read
[7646]	349	!
[14007]	350	NAMELIST/namsbc_wave/ cn_dir, sn_cdg, sn_usd, sn_vsd, sn_hsw, sn_wmp, sn_wnum, sn_tauoc, &
	351	& ln_cdgw, ln_sdw, ln_tauoc, ln_stcor, ln_charn, ln_taw, ln_phioc, &
	352	& ln_wave_test, ln_bern_srfc, ln_breivikFV_2016, ln_vortex_force, ln_stshear
[7646]	353	!!---------------------------------------------------------------------
[14007]	354	IF(lwp) THEN
	355	WRITE(numout,*)
	356	WRITE(numout,*) 'sbc_wave_init : surface waves in the system'
	357	WRITE(numout,*) '~~~~~~~~~~~~~ '
	358	ENDIF
[7646]	359	!
	360	READ ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901)
[14007]	361	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist')
	362
[7646]	363	READ ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 )
[11536]	364	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist' )
[7646]	365	IF(lwm) WRITE ( numond, namsbc_wave )
	366	!
[14007]	367	IF(lwp) THEN
	368	WRITE(numout,*) ' Namelist namsbc_wave'
	369	WRITE(numout,*) ' Stokes drift ln_sdw = ', ln_sdw
	370	WRITE(numout,*) ' Breivik 2016 ln_breivikFV_2016 = ', ln_breivikFV_2016
	371	WRITE(numout,*) ' Stokes Coriolis & tracer advection terms ln_stcor = ', ln_stcor
	372	WRITE(numout,*) ' Vortex Force ln_vortex_force = ', ln_vortex_force
	373	WRITE(numout,*) ' Bernouilli Head Pressure ln_bern_srfc = ', ln_bern_srfc
	374	WRITE(numout,*) ' wave modified ocean stress ln_tauoc = ', ln_tauoc
	375	WRITE(numout,*) ' neutral drag coefficient (CORE bulk only) ln_cdgw = ', ln_cdgw
	376	WRITE(numout,*) ' charnock coefficient ln_charn = ', ln_charn
	377	WRITE(numout,*) ' Stress modificated by wave ln_taw = ', ln_taw
	378	WRITE(numout,*) ' TKE flux from wave ln_phioc = ', ln_phioc
	379	WRITE(numout,*) ' Surface shear with Stokes drift ln_stshear = ', ln_stshear
	380	WRITE(numout,*) ' Test with constant wave fields ln_wave_test = ', ln_wave_test
[7646]	381	ENDIF
	382
[14007]	383	! ! option check
	384	IF( .NOT.( ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor .OR. ln_charn) ) &
	385	& CALL ctl_warn( 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauoc=F, ln_stcor=F')
	386	IF( ln_cdgw .AND. ln_blk ) &
	387	& CALL ctl_stop( 'drag coefficient read from wave model NOT available yet with aerobulk package')
	388	IF( ln_stcor .AND. .NOT.ln_sdw ) &
	389	& CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T')
[7646]	390
[14007]	391	! !== Allocate wave arrays ==!
	392	ALLOCATE( ut0sd (jpi,jpj) , vt0sd (jpi,jpj) )
	393	ALLOCATE( hsw (jpi,jpj) , wmp (jpi,jpj) )
	394	ALLOCATE( wnum (jpi,jpj) )
	395	ALLOCATE( tsd2d (jpi,jpj) , div_sd(jpi,jpj) , bhd_wave(jpi,jpj) )
	396	ALLOCATE( usd (jpi,jpj,jpk), vsd (jpi,jpj,jpk), wsd (jpi,jpj,jpk) )
	397	ALLOCATE( tusd (jpi,jpj) , tvsd (jpi,jpj) , ZMX (jpi,jpj,jpk) )
	398	usd (:,:,:) = 0._wp
	399	vsd (:,:,:) = 0._wp
	400	wsd (:,:,:) = 0._wp
	401	hsw (:,:) = 0._wp
	402	wmp (:,:) = 0._wp
	403	ut0sd (:,:) = 0._wp
	404	vt0sd (:,:) = 0._wp
	405	tusd (:,:) = 0._wp
	406	tvsd (:,:) = 0._wp
	407	bhd_wave(:,:) = 0._wp
	408	ZMX (:,:,:) = 0._wp
	409	!
	410	IF( ln_wave_test ) THEN !== Wave TEST case ==! set uniform waves fields
	411	jpfld = 0 ! No field read
	412	ln_cdgw = .FALSE. ! No neutral wave drag input
	413	ln_tauoc = .FALSE. ! No wave induced drag reduction factor
	414	ut0sd(:,:) = 0.13_wp * tmask(:,:,1) ! m/s
	415	vt0sd(:,:) = 0.00_wp ! m/s
	416	hsw (:,:) = 2.80_wp ! meters
	417	wmp (:,:) = 8.00_wp ! seconds
	418	!
	419	ELSE !== create the structure associated with fields to be read ==!
	420	IF( ln_cdgw ) THEN ! wave drag
	421	IF( .NOT. cpl_wdrag ) THEN
	422	ALLOCATE( sf_cd(1), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg
	423	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' )
	424	!
	425	ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1) )
	426	IF( sn_cdg%ln_tint ) ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) )
	427	CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' )
	428	ENDIF
	429	ALLOCATE( cdn_wave(jpi,jpj) )
	430	cdn_wave(:,:) = 0._wp
[9023]	431	ENDIF
[14007]	432	IF( ln_charn ) THEN ! wave drag
	433	IF( .NOT. cpl_charn ) THEN
	434	CALL ctl_stop( 'STOP', 'Charnock based wind stress can be used in coupled mode only' )
	435	ENDIF
	436	ALLOCATE( charn(jpi,jpj) )
	437	charn(:,:) = 0._wp
[7646]	438	ENDIF
[14007]	439	IF( ln_taw ) THEN ! wind stress
	440	IF( .NOT. cpl_taw ) THEN
	441	CALL ctl_stop( 'STOP', 'wind stress from wave model can be used in coupled mode only, use ln_cdgw instead' )
	442	ENDIF
	443	ALLOCATE( tawx(jpi,jpj) )
	444	ALLOCATE( tawy(jpi,jpj) )
	445	ALLOCATE( twox(jpi,jpj) )
	446	ALLOCATE( twoy(jpi,jpj) )
	447	ALLOCATE( tauoc_wavex(jpi,jpj) )
	448	ALLOCATE( tauoc_wavey(jpi,jpj) )
	449	tawx(:,:) = 0._wp
	450	tawy(:,:) = 0._wp
	451	twox(:,:) = 0._wp
	452	twoy(:,:) = 0._wp
	453	tauoc_wavex(:,:) = 1._wp
	454	tauoc_wavey(:,:) = 1._wp
[7646]	455	ENDIF
[14007]	456
	457	IF( ln_phioc ) THEN ! TKE flux
	458	IF( .NOT. cpl_phioc ) THEN
	459	CALL ctl_stop( 'STOP', 'phioc can be used in coupled mode only' )
	460	ENDIF
	461	ALLOCATE( phioc(jpi,jpj) )
	462	phioc(:,:) = 0._wp
[7646]	463	ENDIF
[14007]	464
	465	IF( ln_tauoc ) THEN ! normalized wave stress into the ocean
	466	IF( .NOT. cpl_wstrf ) THEN
	467	ALLOCATE( sf_tauoc(1), STAT=ierror ) !* allocate and fill sf_wave with sn_tauoc
	468	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_tauoc structure' )
	469	!
	470	ALLOCATE( sf_tauoc(1)%fnow(jpi,jpj,1) )
	471	IF( sn_tauoc%ln_tint ) ALLOCATE( sf_tauoc(1)%fdta(jpi,jpj,1,2) )
	472	CALL fld_fill( sf_tauoc, (/ sn_tauoc /), cn_dir, 'sbc_wave_init', 'Wave module', 'namsbc_wave' )
	473	ENDIF
	474	ALLOCATE( tauoc_wave(jpi,jpj) )
	475	tauoc_wave(:,:) = 0._wp
[7646]	476	ENDIF
	477
[14007]	478	IF( ln_sdw ) THEN ! Stokes drift
	479	! 1. Find out how many fields have to be read from file if not coupled
	480	jpfld=0
	481	jp_usd=0 ; jp_vsd=0 ; jp_hsw=0 ; jp_wmp=0
	482	IF( .NOT. cpl_sdrftx ) THEN
	483	jpfld = jpfld + 1
	484	jp_usd = jpfld
	485	ENDIF
	486	IF( .NOT. cpl_sdrfty ) THEN
	487	jpfld = jpfld + 1
	488	jp_vsd = jpfld
	489	ENDIF
	490	IF( .NOT. cpl_hsig ) THEN
	491	jpfld = jpfld + 1
	492	jp_hsw = jpfld
	493	ENDIF
	494	IF( .NOT. cpl_wper ) THEN
	495	jpfld = jpfld + 1
	496	jp_wmp = jpfld
	497	ENDIF
[14072]	498	! 2. Read from file only the non-coupled fields
[14007]	499	IF( jpfld > 0 ) THEN
	500	ALLOCATE( slf_i(jpfld) )
	501	IF( jp_usd > 0 ) slf_i(jp_usd) = sn_usd
	502	IF( jp_vsd > 0 ) slf_i(jp_vsd) = sn_vsd
	503	IF( jp_hsw > 0 ) slf_i(jp_hsw) = sn_hsw
	504	IF( jp_wmp > 0 ) slf_i(jp_wmp) = sn_wmp
	505	ALLOCATE( sf_sd(jpfld), STAT=ierror ) !* allocate and fill sf_sd with stokes drift
	506	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' )
	507	!
	508	DO ifpr= 1, jpfld
	509	ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) )
	510	IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) )
	511	END DO
	512	!
	513	CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' )
[14398]	514	sf_sd(jp_usd)%zsgn = -1._wp ; sf_sd(jp_vsd)%zsgn = -1._wp ! vector field at T point: overwrite default definition of zsgn
[14007]	515	ENDIF
[7646]	516	!
[14961]	517	! 3. Wave number (only needed for Qiao parametrisation, ln_zdfswm=T)
[15199]	518	IF( .NOT. cpl_wnum ) THEN
[14007]	519	ALLOCATE( sf_wn(1), STAT=ierror ) !* allocate and fill sf_wave with sn_wnum
	520	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wn structure' )
	521	ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1) )
	522	IF( sn_wnum%ln_tint ) ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) )
	523	CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' )
	524	ENDIF
[7646]	525	!
[3680]	526	ENDIF
[14007]	527	!
[3680]	528	ENDIF
[5836]	529	!
[7646]	530	END SUBROUTINE sbc_wave_init
	531
[2990]	532	!!======================================================================
	533	END MODULE sbcwave

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

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

Context Navigation

source: NEMO/trunk/src/OCE/SBC/sbcwave.F90

Download in other formats: