Context Navigation

sbcwave.F90 @ 12350

Last change on this file since 12350 was 12340, checked in by acc, 4 years ago

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

which may need to be considered.

Property svn:keywords set to Id

File size: 24.4 KB

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

Download in other formats: