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 branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90 @ 7167

Last change on this file since 7167 was 7167, checked in by jcastill, 7 years ago
Changes as in branch 2015/dev_r5936_INGV1_WAVE at r7078
File size: 13.8 KB

Rev	Line
[2990]	1	MODULE sbcwave
	2	!!======================================================================
	3	!! * MODULE sbcwave *
	4	!! Wave module
	5	!!======================================================================
[5836]	6	!! History : 3.3 ! 2011-09 (Adani M) Original code: Drag Coefficient
	7	!! : 3.4 ! 2012-10 (Adani M) Stokes Drift
[7167]	8	!! 3.6 ! 2014-09 (Clementi E, Oddo P)New Stokes Drift Computation
[2990]	9	!!----------------------------------------------------------------------
	10
	11	!!----------------------------------------------------------------------
[7167]	12	!! sbc_wave : wave data from wave model in netcdf files
[2990]	13	!!----------------------------------------------------------------------
[5836]	14	USE oce !
[7167]	15	USE sbc_oce ! Surface boundary condition: ocean fields
[5836]	16	USE bdy_oce !
	17	USE domvvl !
	18	!
	19	USE iom ! I/O manager library
	20	USE in_out_manager ! I/O manager
	21	USE lib_mpp ! distribued memory computing library
[7167]	22	USE fldread ! read input fields
[5836]	23	USE wrk_nemo !
[7167]	24	USE phycst ! physical constants
[2990]	25
	26	IMPLICIT NONE
	27	PRIVATE
	28
[7167]	29	PUBLIC sbc_wave ! routine called in sbcmod
[2990]	30
[7167]	31	INTEGER , PARAMETER :: jpfld = 4 ! number of files to read for stokes drift
	32	INTEGER , PARAMETER :: jp_usd = 1 ! index of stokes drift (i-component) (m/s) at T-point
	33	INTEGER , PARAMETER :: jp_vsd = 2 ! index of stokes drift (j-component) (m/s) at T-point
	34	INTEGER , PARAMETER :: jp_swh = 3 ! index of significant wave hight (m) at T-point
	35	INTEGER , PARAMETER :: jp_wmp = 4 ! index of mean wave period (s) at T-point
[5836]	36
[7167]	37	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_cd ! structure of input fields (file informations, fields read) Drag Coefficient
	38	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sd ! structure of input fields (file informations, fields read) Stokes Drift
	39	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_wn ! structure of input fields (file informations, fields read) wave number for Qiao
	40	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tauoc ! structure of input fields (file informations, fields read) normalized wave stress into the ocean
	41	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: cdn_wave
	42	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: swh,wmp, wnum
	43	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauoc_wave
	44	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tsd2d
	45	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: usd2d, vsd2d
	46	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: usd3d, vsd3d, wsd3d
	47	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: zusd2dt, zvsd2dt
[2990]	48
[3680]	49	!! * Substitutions
	50	# include "domzgr_substitute.h90"
[5836]	51	# include "vectopt_loop_substitute.h90"
[2990]	52	!!----------------------------------------------------------------------
[5836]	53	!! NEMO/OPA 3.7 , NEMO Consortium (2014)
[5215]	54	!! $Id$
[2990]	55	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	56	!!----------------------------------------------------------------------
	57	CONTAINS
	58
	59	SUBROUTINE sbc_wave( kt )
	60	!!---------------------------------------------------------------------
[7167]	61	!! * ROUTINE sbc_wave *
[2990]	62	!!
[7167]	63	!! ** Purpose : read wave parameters from wave model in netcdf files.
[2990]	64	!!
	65	!! ** Method : - Read namelist namsbc_wave
	66	!! - Read Cd_n10 fields in netcdf files
[3680]	67	!! - Read stokes drift 2d in netcdf files
[7167]	68	!! - Read wave number in netcdf files
	69	!! - Compute 3d stokes drift using Breivik et al.,2014
	70	!! formulation
	71	!! ** action
[2990]	72	!!---------------------------------------------------------------------
[7167]	73	USE zdf_oce, ONLY : ln_zdfqiao
	74
[5836]	75	INTEGER, INTENT( in ) :: kt ! ocean time step
	76	!
	77	INTEGER :: ierror ! return error code
	78	INTEGER :: ifpr, jj,ji,jk
[7167]	79	INTEGER :: ios ! Local integer output status for namelist read
	80	!
	81	CHARACTER(len=100) :: cn_dir ! Root directory for location of drag coefficient files
	82	REAL(wp) :: ztransp, zsp0, zk, zus, zvs
	83	REAL(wp), DIMENSION(jpi,jpj) :: zfac
	84	REAL(wp), DIMENSION(:,:,:), POINTER :: ze3hdiv ! 3D workspace
[3680]	85	TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read
[7167]	86	TYPE(FLD_N) :: sn_cdg, sn_usd, sn_vsd, &
	87	& sn_swh, sn_wmp, sn_wnum, sn_tauoc ! informations about the fields to be read
[5836]	88	!!
[7167]	89	NAMELIST/namsbc_wave/ sn_cdg, cn_dir, sn_usd, sn_vsd, sn_swh, sn_wmp, sn_wnum, sn_tauoc
[2990]	90	!!---------------------------------------------------------------------
	91	!
	92	! ! -------------------- !
	93	IF( kt == nit000 ) THEN ! First call kt=nit000 !
	94	! ! -------------------- !
[4147]	95	REWIND( numnam_ref ) ! Namelist namsbc_wave in reference namelist : File for drag coeff. from wave model
	96	READ ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901)
	97	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist', lwp )
[2990]	98
[4147]	99	REWIND( numnam_cfg ) ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model
	100	READ ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 )
	101	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist', lwp )
[4624]	102	IF(lwm) WRITE ( numond, namsbc_wave )
[2990]	103	!
[3680]	104	IF ( ln_cdgw ) THEN
	105	ALLOCATE( sf_cd(1), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg
	106	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
	107	!
	108	ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1) )
	109	IF( sn_cdg%ln_tint ) ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) )
	110	CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' )
	111	ALLOCATE( cdn_wave(jpi,jpj) )
	112	cdn_wave(:,:) = 0.0
[5836]	113	ENDIF
[7167]	114
	115	IF ( ln_tauoc ) THEN
	116	ALLOCATE( sf_tauoc(1), STAT=ierror ) !* allocate and fill sf_wave with sn_tauoc
	117	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
	118	!
	119	ALLOCATE( sf_tauoc(1)%fnow(jpi,jpj,1) )
	120	IF( sn_tauoc%ln_tint ) ALLOCATE( sf_tauoc(1)%fdta(jpi,jpj,1,2) )
	121	CALL fld_fill( sf_tauoc, (/ sn_tauoc /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' )
	122	ALLOCATE( tauoc_wave(jpi,jpj) )
	123	tauoc_wave(:,:) = 0.0
	124	ENDIF
	125
[3680]	126	IF ( ln_sdw ) THEN
[7167]	127	slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd;
	128	slf_i(jp_swh) = sn_swh ; slf_i(jp_wmp) = sn_wmp;
	129	ALLOCATE( sf_sd(jpfld), STAT=ierror ) !* allocate and fill sf_sd with stokes drift
[3680]	130	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
	131	!
	132	DO ifpr= 1, jpfld
	133	ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) )
	134	IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) )
	135	END DO
[7167]	136
[3680]	137	CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' )
[7167]	138	ALLOCATE( usd2d(jpi,jpj),vsd2d(jpi,jpj) )
[3680]	139	ALLOCATE( usd3d(jpi,jpj,jpk),vsd3d(jpi,jpj,jpk),wsd3d(jpi,jpj,jpk) )
[7167]	140	ALLOCATE( swh(jpi,jpj), wmp(jpi,jpj) )
	141	ALLOCATE( zusd2dt(jpi,jpj), zvsd2dt(jpi,jpj) )
	142	usd3d(:,:,:) = 0._wp ; usd2d(:,:) = 0._wp ;
	143	vsd3d(:,:,:) = 0._wp ; vsd2d(:,:) = 0._wp ;
	144	wsd3d(:,:,:) = 0._wp ;
	145	swh (:,:) = 0._wp ; wmp (:,:) = 0._wp ;
	146	IF ( ln_zdfqiao ) THEN !== Vertical mixing enhancement using Qiao,2010 ==!
	147	ALLOCATE( sf_wn(1), STAT=ierror ) !* allocate and fill sf_wave with sn_wnum
	148	IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable toallocate sf_wave structure' )
	149	ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1) )
	150	IF( sn_wnum%ln_tint ) ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) )
	151	CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' )
	152	ALLOCATE( wnum(jpi,jpj),tsd2d(jpi,jpj) )
	153	wnum(:,:) = 0._wp ; tsd2d(:,:) = 0._wp
	154	ENDIF
[3680]	155	ENDIF
[2990]	156	ENDIF
[5836]	157	!
	158	IF ( ln_cdgw ) THEN !== Neutral drag coefficient ==!
	159	CALL fld_read( kt, nn_fsbc, sf_cd ) ! read from external forcing
	160	cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1)
	161	ENDIF
[7167]	162
	163	IF ( ln_tauoc ) THEN !== Wave induced stress ==!
	164	CALL fld_read( kt, nn_fsbc, sf_tauoc ) !* read wave norm stress from external forcing
	165	tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1)
	166	ENDIF
	167
	168	IF ( ln_sdw ) THEN !== Computation of the 3d Stokes Drift ==!
[2990]	169	!
[7167]	170	CALL fld_read( kt, nn_fsbc, sf_sd ) !* read wave parameters from external forcing
	171	swh(:,:) = sf_sd(jp_swh)%fnow(:,:,1) ! significant wave height
	172	wmp(:,:) = sf_sd(jp_wmp)%fnow(:,:,1) ! wave mean period
	173	zusd2dt(:,:) = sf_sd(jp_usd)%fnow(:,:,1) ! 2D zonal Stokes Drift at T point
	174	zvsd2dt(:,:) = sf_sd(jp_vsd)%fnow(:,:,1) ! 2D meridional Stokes Drift at T point
[2990]	175	!
[7167]	176	!== Computation of the 3d Stokes Drift according to Breivik et al.,2014
	177	!(DOI: 10.1175/JPO-D-14-0020.1)==!
[5836]	178	!
[7167]	179	CALL wrk_alloc( jpi,jpj,jpk, ze3hdiv )
	180	DO jk = 1, jpk
	181	DO jj = 1, jpj
	182	DO ji = 1, jpi
	183	! On T grid
	184	! Stokes transport speed estimated from Hs and Tmean
	185	ztransp = 2.0_wprpiswh(ji,jj)*2.0_wp/(16.0_wpMAX(wmp(ji,jj),0.0000001_wp))
	186	! Stokes surface speed
	187	zsp0 = SQRT( sf_sd(jp_usd)%fnow(ji,jj,1)2 + sf_sd(jp_vsd)%fnow(ji,jj,1)2)
	188	! Wavenumber scale
	189	zk = ABS(zsp0)/MAX(ABS(5.97_wp*ztransp),0.0000001_wp)
	190	! Depth attenuation
	191	zfac(ji,jj) = EXP(-2.0_wpzkfsdept(ji,jj,jk))/(1.0_wp+8.0_wpzkfsdept(ji,jj,jk))
	192	END DO
	193	END DO
	194
[5836]	195	DO jj = 1, jpjm1
	196	DO ji = 1, jpim1
[7167]	197	! Into the U and V Grid
	198	zus = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zfac(ji,jj) * tmask(ji,jj,1) &
	199	& + zfac(ji+1,jj) * tmask(ji+1,jj,1) )
	200
	201	zvs = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zfac(ji,jj) * tmask(ji,jj,1) &
	202	& + zfac(ji,jj+1) * tmask(ji,jj+1,1) )
	203
	204	usd2d(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zusd2dt(ji,jj) * tmask(ji,jj,1) &
	205	& + zusd2dt(ji+1,jj) * tmask(ji+1,jj,1) )
	206
	207	vsd2d(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zvsd2dt(ji,jj) * tmask(ji,jj,1) &
	208	& + zvsd2dt(ji,jj+1) * tmask(ji,jj+1,1) )
	209
	210	usd3d(ji,jj,jk) = usd2d(ji,jj) * zus
	211	vsd3d(ji,jj,jk) = vsd2d(ji,jj) * zvs
[5836]	212	END DO
[3680]	213	END DO
	214	END DO
[7167]	215	!
[5836]	216	CALL lbc_lnk( usd3d(:,:,:), 'U', -1. )
	217	CALL lbc_lnk( vsd3d(:,:,:), 'V', -1. )
	218	!
[7167]	219	DO jk = 1, jpkm1 ! e3t * Horizontal divergence
[5836]	220	DO jj = 2, jpjm1
	221	DO ji = fs_2, fs_jpim1 ! vector opt.
	222	ze3hdiv(ji,jj,jk) = ( e2u(ji ,jj) * fse3u_n(ji ,jj,jk) * usd3d(ji ,jj,jk) &
	223	& - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk) &
	224	& + e1v(ji,jj ) * fse3v_n(ji,jj ,jk) * vsd3d(ji,jj ,jk) &
	225	& - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk) ) * r1_e1e2t(ji,jj)
	226	END DO
	227	END DO
	228	IF( .NOT. AGRIF_Root() ) THEN
	229	IF( nbondi == 1 .OR. nbondi == 2 ) ze3hdiv(nlci-1, : ,jk) = 0._wp ! east
	230	IF( nbondi == -1 .OR. nbondi == 2 ) ze3hdiv( 2 , : ,jk) = 0._wp ! west
	231	IF( nbondj == 1 .OR. nbondj == 2 ) ze3hdiv( : ,nlcj-1,jk) = 0._wp ! north
	232	IF( nbondj == -1 .OR. nbondj == 2 ) ze3hdiv( : , 2 ,jk) = 0._wp ! south
	233	ENDIF
	234	END DO
	235	CALL lbc_lnk( ze3hdiv, 'T', 1. )
	236	!
	237	DO jk = jpkm1, 1, -1 !* integrate from the bottom the e3t * hor. divergence
	238	wsd3d(:,:,jk) = wsd3d(:,:,jk+1) - ze3hdiv(:,:,jk)
	239	END DO
[3680]	240	#if defined key_bdy
[5836]	241	IF( lk_bdy ) THEN
	242	DO jk = 1, jpkm1
	243	wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:)
	244	END DO
	245	ENDIF
[3680]	246	#endif
[7167]	247	CALL wrk_dealloc( jpi,jpj,jpk, ze3hdiv )
	248
	249	IF ( ln_zdfqiao ) THEN
	250	wnum(:,:) = sf_wn(1)%fnow(:,:,1)
	251
	252	! Calculate the module of the stokes drift on T grid
	253	!-------------------------------------------------
	254	DO jj = 1, jpj
	255	DO ji = 1, jpi
	256	tsd2d(ji,jj) = ((sf_sd(jp_usd)%fnow(ji,jj,1) * tmask(ji,jj,1))**2.0 + &
	257	& (sf_sd(jp_vsd)%fnow(ji,jj,1) * tmask(ji,jj,1))2.0)0.5
	258	END DO
	259	END DO
	260	ENDIF
	261	!
[3680]	262	ENDIF
[5836]	263	!
[2990]	264	END SUBROUTINE sbc_wave
	265
	266	!!======================================================================
	267	END MODULE sbcwave

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

Download in other formats: