Home

Context Navigation

source: palm/trunk/SOURCE/ocean_mod.f90 @ 4477

Last change on this file since 4477 was 4370, checked in by raasch, 5 years ago
bugfixes for previous commit: unused variables removed, Temperton-fft usage on GPU, openacc porting of vector version of Obukhov length calculation, collective read switched off on NEC to avoid hanging; some vector directives added in prognostic equations to force vectorization on Intel19 compiler, configuration files for NEC Aurora added
Property svn:keywords set to `Id`
File size: 89.0 KB

Line
1	!> @file ocean_mod.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 2017-2018 Leibniz Universitaet Hannover
18	!--------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: ocean_mod.f90 4370 2020-01-10 14:00:44Z maronga $
27	! vector directives added to force vectorization on Intel19 compiler
28	!
29	! 4346 2019-12-18 11:55:56Z motisi
30	! Introduction of wall_flags_total_0, which currently sets bits based on static
31	! topography information used in wall_flags_static_0
32	!
33	! 4329 2019-12-10 15:46:36Z motisi
34	! Renamed wall_flags_0 to wall_flags_static_0
35	!
36	! 4272 2019-10-23 15:18:57Z schwenkel
37	! Further modularization of boundary conditions: moved boundary conditions to
38	! respective modules
39	!
40	! 4196 2019-08-29 11:02:06Z gronemeier
41	! Consider rotation of model domain for calculating the Stokes drift
42	!
43	! 4182 2019-08-22 15:20:23Z scharf
44	! Corrected "Former revisions" section
45	!
46	! 4110 2019-07-22 17:05:21Z suehring
47	! Pass integer flag array as well as boundary flags to WS scalar advection
48	! routine
49	!
50	! 4109 2019-07-22 17:00:34Z suehring
51	! implemented ocean_actions
52	!
53	! 3767 2019-02-27 08:18:02Z raasch
54	! unused variable for file index and tmp_2d removed from rrd-subroutine parameter
55	! list
56	!
57	! 3719 2019-02-06 13:10:18Z kanani
58	! Changed log_point to log_point_s, otherwise this overlaps with
59	! 'all progn.equations' cpu measurement.
60	!
61	! 3684 2019-01-20 20:20:58Z knoop
62	! nopointer option removed
63	! 3294 2018-10-01 02:37:10Z raasch
64	! initial revision
65	!
66	!
67	! Authors:
68	! --------
69	! @author Siegfried Raasch
70	!
71	! Description:
72	! ------------
73	!> This module contains relevant code for PALM's ocean mode, e.g. the
74	!> prognostic equation for salinity, the equation of state for seawater,
75	!> the Craik Leibovich force (Stokes force), and wave breaking effects
76	!------------------------------------------------------------------------------!
77	MODULE ocean_mod
78
79
80	USE arrays_3d, &
81	ONLY: prho, prho_1, rho_ocean, rho_1, sa, sa_init, sa_1, sa_2, sa_3, &
82	sa_p, tsa_m, flux_l_sa, flux_s_sa, diss_l_sa, diss_s_sa
83
84	USE control_parameters, &
85	ONLY: atmos_ocean_sign, bottom_salinityflux, &
86	constant_top_salinityflux, ocean_mode, top_salinityflux, &
87	wall_salinityflux, loop_optimization, ws_scheme_sca
88
89	USE kinds
90
91	USE pegrid, &
92	ONLY: threads_per_task
93
94	USE statistics, &
95	ONLY: sums_wssas_ws_l
96
97	USE indices, &
98	ONLY: advc_flags_s, nxl, nxr, nyn, nys, nzb, nzt, wall_flags_total_0
99
100	USE surface_mod, &
101	ONLY: bc_h, surf_def_v, surf_def_h, surf_lsm_h, surf_lsm_v, &
102	surf_usm_h, surf_usm_v
103
104	IMPLICIT NONE
105
106	CHARACTER (LEN=20) :: bc_sa_t = 'neumann' !< namelist parameter
107
108	INTEGER(iwp) :: ibc_sa_t !< integer flag for bc_sa_t
109	INTEGER(iwp) :: iran_ocean = -1234567 !< random number used for wave breaking effects
110
111	INTEGER(iwp) :: sa_vertical_gradient_level_ind(10) = -9999 !< grid index values of sa_vertical_gradient_level(s)
112
113	LOGICAL :: salinity = .TRUE. !< switch for using salinity
114	LOGICAL :: stokes_force = .FALSE. !< switch to switch on the Stokes force
115	LOGICAL :: wave_breaking = .FALSE. !< switch to switch on wave breaking effects
116	LOGICAL :: surface_cooling_switched_off = .FALSE. !< variable to check if surface heat flux has been switched off
117
118	REAL(wp) :: alpha_wave_breaking = 3.0_wp !< coefficient for wave breaking generated turbulence from Noh et al. (2004), JPO
119	REAL(wp) :: prho_reference !< reference state of potential density at ocean surface
120	REAL(wp) :: sa_surface = 35.0_wp !< surface salinity, namelist parameter
121	REAL(wp) :: sa_vertical_gradient(10) = 0.0_wp !< namelist parameter
122	REAL(wp) :: sa_vertical_gradient_level(10) = -999999.9_wp !< namelist parameter
123	REAL(wp) :: stokes_waveheight = 0.0_wp !< wave height assumed for Stokes drift velocity
124	REAL(wp) :: stokes_wavelength = 0.0_wp !< wavelength assumed for Stokes drift velocity
125	REAL(wp) :: surface_cooling_spinup_time = 999999.9_wp !< time after which surface heat flux is switched off
126	REAL(wp) :: timescale_wave_breaking !< time scale of random forcing
127	REAL(wp) :: u_star_wave_breaking !< to store the absolute value of friction velocity at the ocean surface
128
129	REAL(wp), DIMENSION(12), PARAMETER :: nom = &
130	(/ 9.9984085444849347D2, 7.3471625860981584D0, &
131	-5.3211231792841769D-2, 3.6492439109814549D-4, &
132	2.5880571023991390D0, -6.7168282786692354D-3, &
133	1.9203202055760151D-3, 1.1798263740430364D-2, &
134	9.8920219266399117D-8, 4.6996642771754730D-6, &
135	-2.5862187075154352D-8, -3.2921414007960662D-12 /)
136	!< constants used in equation of state for seawater
137
138	REAL(wp), DIMENSION(13), PARAMETER :: den = &
139	(/ 1.0D0, 7.2815210113327091D-3, &
140	-4.4787265461983921D-5, 3.3851002965802430D-7, &
141	1.3651202389758572D-10, 1.7632126669040377D-3, &
142	-8.8066583251206474D-6, -1.8832689434804897D-10, &
143	5.7463776745432097D-6, 1.4716275472242334D-9, &
144	6.7103246285651894D-6, -2.4461698007024582D-17, &
145	-9.1534417604289062D-18 /)
146	!< constants used in equation of state for seawater
147
148	SAVE
149
150	PUBLIC :: bc_sa_t, ibc_sa_t, prho_reference, sa_surface, &
151	sa_vertical_gradient, sa_vertical_gradient_level, &
152	sa_vertical_gradient_level_ind, stokes_force, wave_breaking
153
154
155	INTERFACE eqn_state_seawater
156	MODULE PROCEDURE eqn_state_seawater
157	MODULE PROCEDURE eqn_state_seawater_ij
158	END INTERFACE eqn_state_seawater
159
160	INTERFACE eqn_state_seawater_func
161	MODULE PROCEDURE eqn_state_seawater_func
162	END INTERFACE eqn_state_seawater_func
163
164	INTERFACE ocean_check_parameters
165	MODULE PROCEDURE ocean_check_parameters
166	END INTERFACE ocean_check_parameters
167
168	INTERFACE ocean_check_data_output
169	MODULE PROCEDURE ocean_check_data_output
170	END INTERFACE ocean_check_data_output
171
172	INTERFACE ocean_check_data_output_pr
173	MODULE PROCEDURE ocean_check_data_output_pr
174	END INTERFACE ocean_check_data_output_pr
175
176	INTERFACE ocean_define_netcdf_grid
177	MODULE PROCEDURE ocean_define_netcdf_grid
178	END INTERFACE ocean_define_netcdf_grid
179
180	INTERFACE ocean_data_output_2d
181	MODULE PROCEDURE ocean_data_output_2d
182	END INTERFACE ocean_data_output_2d
183
184	INTERFACE ocean_data_output_3d
185	MODULE PROCEDURE ocean_data_output_3d
186	END INTERFACE ocean_data_output_3d
187
188	INTERFACE ocean_header
189	MODULE PROCEDURE ocean_header
190	END INTERFACE ocean_header
191
192	INTERFACE ocean_init
193	MODULE PROCEDURE ocean_init
194	END INTERFACE ocean_init
195
196	INTERFACE ocean_init_arrays
197	MODULE PROCEDURE ocean_init_arrays
198	END INTERFACE ocean_init_arrays
199
200	INTERFACE ocean_parin
201	MODULE PROCEDURE ocean_parin
202	END INTERFACE ocean_parin
203
204	INTERFACE ocean_actions
205	MODULE PROCEDURE ocean_actions
206	MODULE PROCEDURE ocean_actions_ij
207	END INTERFACE ocean_actions
208
209	INTERFACE ocean_prognostic_equations
210	MODULE PROCEDURE ocean_prognostic_equations
211	MODULE PROCEDURE ocean_prognostic_equations_ij
212	END INTERFACE ocean_prognostic_equations
213
214	INTERFACE ocean_boundary_conditions
215	MODULE PROCEDURE ocean_boundary_conditions
216	END INTERFACE ocean_boundary_conditions
217
218	INTERFACE ocean_swap_timelevel
219	MODULE PROCEDURE ocean_swap_timelevel
220	END INTERFACE ocean_swap_timelevel
221
222	INTERFACE ocean_rrd_global
223	MODULE PROCEDURE ocean_rrd_global
224	END INTERFACE ocean_rrd_global
225
226	INTERFACE ocean_rrd_local
227	MODULE PROCEDURE ocean_rrd_local
228	END INTERFACE ocean_rrd_local
229
230	INTERFACE ocean_wrd_global
231	MODULE PROCEDURE ocean_wrd_global
232	END INTERFACE ocean_wrd_global
233
234	INTERFACE ocean_wrd_local
235	MODULE PROCEDURE ocean_wrd_local
236	END INTERFACE ocean_wrd_local
237
238	INTERFACE ocean_3d_data_averaging
239	MODULE PROCEDURE ocean_3d_data_averaging
240	END INTERFACE ocean_3d_data_averaging
241
242	INTERFACE stokes_drift_terms
243	MODULE PROCEDURE stokes_drift_terms
244	MODULE PROCEDURE stokes_drift_terms_ij
245	END INTERFACE stokes_drift_terms
246
247	INTERFACE wave_breaking_term
248	MODULE PROCEDURE wave_breaking_term
249	MODULE PROCEDURE wave_breaking_term_ij
250	END INTERFACE wave_breaking_term
251
252	PRIVATE
253	!
254	!-- Add INTERFACES that must be available to other modules (alphabetical order)
255	PUBLIC eqn_state_seawater, ocean_actions, ocean_check_data_output, &
256	ocean_check_data_output_pr, ocean_check_parameters, &
257	ocean_data_output_2d, ocean_data_output_3d, &
258	ocean_define_netcdf_grid, ocean_header, ocean_init, &
259	ocean_init_arrays, ocean_parin, ocean_prognostic_equations, &
260	ocean_swap_timelevel, ocean_rrd_global, ocean_rrd_local, &
261	ocean_wrd_global, ocean_wrd_local, ocean_3d_data_averaging, &
262	ocean_boundary_conditions, stokes_drift_terms, wave_breaking_term
263
264
265	CONTAINS
266
267	!------------------------------------------------------------------------------!
268	! Description:
269	! ------------
270	!> Equation of state for seawater as a function of potential temperature,
271	!> salinity, and pressure.
272	!> For coefficients see Jackett et al., 2006: J. Atm. Ocean Tech.
273	!> eqn_state_seawater calculates the potential density referred at hyp(0).
274	!> eqn_state_seawater_func calculates density.
275	!> TODO: so far, routine is not adjusted to use topography
276	!------------------------------------------------------------------------------!
277	SUBROUTINE eqn_state_seawater
278
279	USE arrays_3d, &
280	ONLY: hyp, prho, pt_p, rho_ocean, sa_p
281	USE indices, &
282	ONLY: nxl, nxr, nyn, nys, nzb, nzt
283
284	IMPLICIT NONE
285
286	INTEGER(iwp) :: i !< running index x direction
287	INTEGER(iwp) :: j !< running index y direction
288	INTEGER(iwp) :: k !< running index z direction
289	INTEGER(iwp) :: m !< running index surface elements
290
291	REAL(wp) :: pden !< temporary scalar user for calculating density
292	REAL(wp) :: pnom !< temporary scalar user for calculating density
293	REAL(wp) :: p1 !< temporary scalar user for calculating density
294	REAL(wp) :: p2 !< temporary scalar user for calculating density
295	REAL(wp) :: p3 !< temporary scalar user for calculating density
296	REAL(wp) :: pt1 !< temporary scalar user for calculating density
297	REAL(wp) :: pt2 !< temporary scalar user for calculating density
298	REAL(wp) :: pt3 !< temporary scalar user for calculating density
299	REAL(wp) :: pt4 !< temporary scalar user for calculating density
300	REAL(wp) :: sa1 !< temporary scalar user for calculating density
301	REAL(wp) :: sa15 !< temporary scalar user for calculating density
302	REAL(wp) :: sa2 !< temporary scalar user for calculating density
303
304
305	DO i = nxl, nxr
306	DO j = nys, nyn
307	DO k = nzb+1, nzt
308	!
309	!-- Pressure is needed in dbar
310	p1 = hyp(k) * 1E-4_wp
311	p2 = p1 * p1
312	p3 = p2 * p1
313
314	!
315	!-- Temperature needed in degree Celsius
316	pt1 = pt_p(k,j,i) - 273.15_wp
317	pt2 = pt1 * pt1
318	pt3 = pt1 * pt2
319	pt4 = pt2 * pt2
320
321	sa1 = sa_p(k,j,i)
322	sa15 = sa1 * SQRT( sa1 )
323	sa2 = sa1 * sa1
324
325	pnom = nom(1) + nom(2)pt1 + nom(3)pt2 + &
326	nom(4)pt3 + nom(5)sa1 + nom(6)sa1pt1 + &
327	nom(7)*sa2
328
329	pden = den(1) + den(2)pt1 + den(3)pt2 + &
330	den(4)pt3 + den(5)pt4 + den(6)*sa1 + &
331	den(7)sa1pt1 + den(8)sa1pt3 + den(9)*sa15 + &
332	den(10)sa15pt2
333	!
334	!-- Potential density (without pressure terms)
335	prho(k,j,i) = pnom / pden
336
337	pnom = pnom + nom(8)p1 + nom(9)p1*pt2 + &
338	nom(10)p1sa1 + nom(11)p2 + nom(12)p2*pt2
339
340	pden = pden + den(11)p1 + den(12)p2*pt3 + &
341	den(13)p3pt1
342
343	!
344	!-- In-situ density
345	rho_ocean(k,j,i) = pnom / pden
346
347	ENDDO
348
349	!
350	!-- Neumann conditions are assumed at top boundary and currently also at
351	!-- bottom boundary (see comment lines below)
352	prho(nzt+1,j,i) = prho(nzt,j,i)
353	rho_ocean(nzt+1,j,i) = rho_ocean(nzt,j,i)
354
355	ENDDO
356	ENDDO
357	!
358	!-- Neumann conditions at up/downward-facing surfaces
359	!$OMP PARALLEL DO PRIVATE( i, j, k )
360	DO m = 1, bc_h(0)%ns
361	i = bc_h(0)%i(m)
362	j = bc_h(0)%j(m)
363	k = bc_h(0)%k(m)
364	prho(k-1,j,i) = prho(k,j,i)
365	rho_ocean(k-1,j,i) = rho_ocean(k,j,i)
366	ENDDO
367	!
368	!-- Downward facing surfaces
369	!$OMP PARALLEL DO PRIVATE( i, j, k )
370	DO m = 1, bc_h(1)%ns
371	i = bc_h(1)%i(m)
372	j = bc_h(1)%j(m)
373	k = bc_h(1)%k(m)
374	prho(k+1,j,i) = prho(k,j,i)
375	rho_ocean(k+1,j,i) = rho_ocean(k,j,i)
376	ENDDO
377
378	END SUBROUTINE eqn_state_seawater
379
380
381	!------------------------------------------------------------------------------!
382	! Description:
383	! ------------
384	!> Same as above, but for grid point i,j
385	!------------------------------------------------------------------------------!
386	SUBROUTINE eqn_state_seawater_ij( i, j )
387
388	USE arrays_3d, &
389	ONLY: hyp, prho, pt_p, rho_ocean, sa_p
390
391	USE indices, &
392	ONLY: nzb, nzt
393
394	IMPLICIT NONE
395
396	INTEGER(iwp) :: i !< running index x direction
397	INTEGER(iwp) :: j !< running index y direction
398	INTEGER(iwp) :: k !< running index z direction
399	INTEGER(iwp) :: m !< running index surface elements
400	INTEGER(iwp) :: surf_e !< end index of surface elements at (j,i)-gridpoint
401	INTEGER(iwp) :: surf_s !< start index of surface elements at (j,i)-gridpoint
402
403	REAL(wp) :: pden !< temporary scalar user for calculating density
404	REAL(wp) :: pnom !< temporary scalar user for calculating density
405	REAL(wp) :: p1 !< temporary scalar user for calculating density
406	REAL(wp) :: p2 !< temporary scalar user for calculating density
407	REAL(wp) :: p3 !< temporary scalar user for calculating density
408	REAL(wp) :: pt1 !< temporary scalar user for calculating density
409	REAL(wp) :: pt2 !< temporary scalar user for calculating density
410	REAL(wp) :: pt3 !< temporary scalar user for calculating density
411	REAL(wp) :: pt4 !< temporary scalar user for calculating density
412	REAL(wp) :: sa1 !< temporary scalar user for calculating density
413	REAL(wp) :: sa15 !< temporary scalar user for calculating density
414	REAL(wp) :: sa2 !< temporary scalar user for calculating density
415
416	DO k = nzb+1, nzt
417	!
418	!-- Pressure is needed in dbar
419	p1 = hyp(k) * 1E-4_wp
420	p2 = p1 * p1
421	p3 = p2 * p1
422	!
423	!-- Temperature needed in degree Celsius
424	pt1 = pt_p(k,j,i) - 273.15_wp
425	pt2 = pt1 * pt1
426	pt3 = pt1 * pt2
427	pt4 = pt2 * pt2
428
429	sa1 = sa_p(k,j,i)
430	sa15 = sa1 * SQRT( sa1 )
431	sa2 = sa1 * sa1
432
433	pnom = nom(1) + nom(2)pt1 + nom(3)pt2 + &
434	nom(4)pt3 + nom(5)sa1 + nom(6)sa1pt1 + nom(7)*sa2
435
436	pden = den(1) + den(2)pt1 + den(3)pt2 + &
437	den(4)pt3 + den(5)pt4 + den(6)*sa1 + &
438	den(7)sa1pt1 + den(8)sa1pt3 + den(9)*sa15 + &
439	den(10)sa15pt2
440	!
441	!-- Potential density (without pressure terms)
442	prho(k,j,i) = pnom / pden
443
444	pnom = pnom + nom(8)p1 + nom(9)p1*pt2 + &
445	nom(10)p1sa1 + nom(11)p2 + nom(12)p2*pt2
446	pden = pden + den(11)p1 + den(12)p2*pt3 + &
447	den(13)p3pt1
448
449	!
450	!-- In-situ density
451	rho_ocean(k,j,i) = pnom / pden
452
453	ENDDO
454	!
455	!-- Neumann conditions at up/downward-facing walls
456	surf_s = bc_h(0)%start_index(j,i)
457	surf_e = bc_h(0)%end_index(j,i)
458	DO m = surf_s, surf_e
459	k = bc_h(0)%k(m)
460	prho(k-1,j,i) = prho(k,j,i)
461	rho_ocean(k-1,j,i) = rho_ocean(k,j,i)
462	ENDDO
463	!
464	!-- Downward facing surfaces
465	surf_s = bc_h(1)%start_index(j,i)
466	surf_e = bc_h(1)%end_index(j,i)
467	DO m = surf_s, surf_e
468	k = bc_h(1)%k(m)
469	prho(k+1,j,i) = prho(k,j,i)
470	rho_ocean(k+1,j,i) = rho_ocean(k,j,i)
471	ENDDO
472	!
473	!-- Neumann condition are assumed at top boundary
474	prho(nzt+1,j,i) = prho(nzt,j,i)
475	rho_ocean(nzt+1,j,i) = rho_ocean(nzt,j,i)
476
477	END SUBROUTINE eqn_state_seawater_ij
478
479
480	!------------------------------------------------------------------------------!
481	! Description:
482	! ------------
483	!> Equation of state for seawater as a function
484	!------------------------------------------------------------------------------!
485	REAL(wp) FUNCTION eqn_state_seawater_func( p, pt, sa )
486
487	IMPLICIT NONE
488
489	REAL(wp) :: p !< temporary scalar user for calculating density
490	REAL(wp) :: p1 !< temporary scalar user for calculating density
491	REAL(wp) :: p2 !< temporary scalar user for calculating density
492	REAL(wp) :: p3 !< temporary scalar user for calculating density
493	REAL(wp) :: pt !< temporary scalar user for calculating density
494	REAL(wp) :: pt1 !< temporary scalar user for calculating density
495	REAL(wp) :: pt2 !< temporary scalar user for calculating density
496	REAL(wp) :: pt3 !< temporary scalar user for calculating density
497	REAL(wp) :: pt4 !< temporary scalar user for calculating density
498	REAL(wp) :: sa !< temporary scalar user for calculating density
499	REAL(wp) :: sa15 !< temporary scalar user for calculating density
500	REAL(wp) :: sa2 !< temporary scalar user for calculating density
501
502	!
503	!-- Pressure is needed in dbar
504	p1 = p * 1.0E-4_wp
505	p2 = p1 * p1
506	p3 = p2 * p1
507
508	!
509	!-- Temperature needed in degree Celsius
510	pt1 = pt - 273.15_wp
511	pt2 = pt1 * pt1
512	pt3 = pt1 * pt2
513	pt4 = pt2 * pt2
514
515	sa15 = sa * SQRT( sa )
516	sa2 = sa * sa
517
518
519	eqn_state_seawater_func = &
520	( nom(1) + nom(2)pt1 + nom(3)pt2 + nom(4)*pt3 + &
521	nom(5)sa + nom(6)sapt1 + nom(7)sa2 + nom(8)*p1 + &
522	nom(9)p1pt2 + nom(10)p1sa + nom(11)p2 + nom(12)p2*pt2 &
523	) / &
524	( den(1) + den(2)pt1 + den(3)pt2 + den(4)*pt3 + &
525	den(5)pt4 + den(6)sa + den(7)sapt1 + den(8)sapt3 + &
526	den(9)sa15 + den(10)sa15pt2 + den(11)p1 + den(12)p2pt3 + &
527	den(13)p3pt1 &
528	)
529
530
531	END FUNCTION eqn_state_seawater_func
532
533
534	!------------------------------------------------------------------------------!
535	! Description:
536	! ------------
537	!> Reads the ocean parameters namelist
538	!------------------------------------------------------------------------------!
539	SUBROUTINE ocean_parin
540
541	IMPLICIT NONE
542
543	CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file
544
545
546	NAMELIST /ocean_parameters/ bc_sa_t, bottom_salinityflux, salinity, &
547	sa_surface, sa_vertical_gradient, sa_vertical_gradient_level, &
548	stokes_waveheight, stokes_wavelength, surface_cooling_spinup_time,&
549	top_salinityflux, wall_salinityflux, wave_breaking
550
551	!
552	!-- Try to find the namelist
553	REWIND ( 11 )
554	line = ' '
555	DO WHILE ( INDEX( line, '&ocean_parameters' ) == 0 )
556	READ ( 11, '(A)', END=12 ) line
557	ENDDO
558	BACKSPACE ( 11 )
559
560	!
561	!-- Read namelist
562	READ ( 11, ocean_parameters, ERR = 10 )
563	!
564	!-- Set switch that enables PALM's ocean mode
565	ocean_mode = .TRUE.
566
567	GOTO 12
568
569	10 BACKSPACE( 11 )
570	READ( 11 , '(A)') line
571	CALL parin_fail_message( 'ocean_parameters', line )
572
573	12 CONTINUE
574
575	END SUBROUTINE ocean_parin
576
577	!------------------------------------------------------------------------------!
578	! Description:
579	! ------------
580	!> Check parameters routine for the ocean mode
581	!------------------------------------------------------------------------------!
582	SUBROUTINE ocean_check_parameters
583
584	USE control_parameters, &
585	ONLY: coupling_char, coupling_mode, initializing_actions, &
586	message_string, use_top_fluxes
587
588	USE pmc_interface, &
589	ONLY: nested_run
590
591	IMPLICIT NONE
592
593
594	!
595	!-- Check for invalid combinations
596	IF ( nested_run ) THEN
597	message_string = 'ocean mode not allowed for nesting'
598	CALL message( 'ocean_check_parameters', 'PA0510', 1, 2, 0, 6, 0 )
599	ENDIF
600
601	IF ( TRIM( initializing_actions ) == 'cyclic_fill' ) THEN
602	message_string = 'ocean mode does not allow cyclic-fill initialization'
603	CALL message( 'ocean_check_parameters', 'PA0511', 1, 2, 0, 6, 0 )
604	ENDIF
605
606	!
607	!-- Check ocean setting
608	IF ( TRIM( coupling_mode ) == 'uncoupled' .AND. &
609	TRIM( coupling_char ) == '_O' .AND. &
610	.NOT. ocean_mode ) THEN
611
612	!
613	!-- Check whether an (uncoupled) atmospheric run has been declared as an
614	!-- ocean run (this setting is done via palmrun-option -y)
615	message_string = 'ocean mode does not allow coupling_char = "' // &
616	TRIM( coupling_char ) // '" set by palmrun-option "-y"'
617	CALL message( 'ocean_check_parameters', 'PA0317', 1, 2, 0, 6, 0 )
618
619	ENDIF
620
621	!
622	!-- Ocean version must use flux boundary conditions at the top
623	IF ( .NOT. use_top_fluxes ) THEN
624	message_string = 'use_top_fluxes must be .TRUE. in ocean mode'
625	CALL message( 'ocean_check_parameters', 'PA0042', 1, 2, 0, 6, 0 )
626	ENDIF
627
628	!
629	!-- Boundary conditions for salinity
630	IF ( bc_sa_t == 'dirichlet' ) THEN
631	ibc_sa_t = 0
632	ELSEIF ( bc_sa_t == 'neumann' ) THEN
633	ibc_sa_t = 1
634	ELSE
635	message_string = 'unknown boundary condition: bc_sa_t = "' // &
636	TRIM( bc_sa_t ) // '"'
637	CALL message( 'ocean_check_parameters', 'PA0068', 1, 2, 0, 6, 0 )
638	ENDIF
639
640	IF ( top_salinityflux == 9999999.9_wp ) constant_top_salinityflux = .FALSE.
641
642	IF ( .NOT. salinity ) THEN
643	IF ( ( bottom_salinityflux /= 0.0_wp .AND. &
644	bottom_salinityflux /= 9999999.9_wp ) .OR. &
645	( top_salinityflux /= 0.0_wp .AND. &
646	top_salinityflux /= 9999999.9_wp ) ) &
647	THEN
648	message_string = 'salinityflux must not be set for ocean run ' // &
649	'without salinity'
650	CALL message( 'ocean_check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
651	ENDIF
652	ENDIF
653
654	IF ( ibc_sa_t == 1 .AND. top_salinityflux == 9999999.9_wp ) THEN
655	message_string = 'boundary condition: bc_sa_t = "' // &
656	TRIM( bc_sa_t ) // '" requires to set top_salinityflux'
657	CALL message( 'ocean_check_parameters', 'PA0069', 1, 2, 0, 6, 0 )
658	ENDIF
659
660	!
661	!-- A fixed salinity at the top implies Dirichlet boundary condition for
662	!-- salinity. In this case specification of a constant salinity flux is
663	!-- forbidden.
664	IF ( ibc_sa_t == 0 .AND. constant_top_salinityflux .AND. &
665	top_salinityflux /= 0.0_wp ) THEN
666	message_string = 'boundary condition: bc_sa_t = "' // &
667	TRIM( bc_sa_t ) // '" is not allowed with ' // &
668	'top_salinityflux /= 0.0'
669	CALL message( 'ocean_check_parameters', 'PA0070', 1, 2, 0, 6, 0 )
670	ENDIF
671
672	!
673	!-- Check if Stokes force is to be used
674	IF ( stokes_waveheight /= 0.0_wp .AND. stokes_wavelength /= 0.0_wp ) THEN
675	stokes_force = .TRUE.
676	ELSE
677	IF ( ( stokes_waveheight <= 0.0_wp .AND. stokes_wavelength > 0.0_wp ) &
678	.OR. &
679	( stokes_waveheight > 0.0_wp .AND. stokes_wavelength <= 0.0_wp ) &
680	.OR. &
681	( stokes_waveheight < 0.0_wp .AND. stokes_wavelength < 0.0_wp ) ) &
682	THEN
683	message_string = 'wrong settings for stokes_wavelength and/or ' // &
684	'stokes_waveheight'
685	CALL message( 'ocean_check_parameters', 'PA0460', 1, 2, 0, 6, 0 )
686	ENDIF
687	ENDIF
688
689	END SUBROUTINE ocean_check_parameters
690
691
692	!------------------------------------------------------------------------------!
693	! Description:
694	! ------------
695	!> Check data output.
696	!------------------------------------------------------------------------------!
697	SUBROUTINE ocean_check_data_output( var, unit )
698
699	IMPLICIT NONE
700
701	CHARACTER (LEN=*) :: unit !< unit of output variable
702	CHARACTER (LEN=*) :: var !< name of output variable
703
704
705	SELECT CASE ( TRIM( var ) )
706
707	CASE ( 'rho_sea_water' )
708	unit = 'kg/m3'
709
710	CASE ( 'sa' )
711	unit = 'psu'
712
713	CASE DEFAULT
714	unit = 'illegal'
715
716	END SELECT
717
718	END SUBROUTINE ocean_check_data_output
719
720
721	!------------------------------------------------------------------------------!
722	! Description:
723	! ------------
724	!> Check data output of profiles
725	!------------------------------------------------------------------------------!
726	SUBROUTINE ocean_check_data_output_pr( variable, var_count, unit, dopr_unit )
727
728	USE arrays_3d, &
729	ONLY: zu, zw
730
731	USE control_parameters, &
732	ONLY: data_output_pr
733
734	USE indices
735
736	USE profil_parameter
737
738	USE statistics
739
740	IMPLICIT NONE
741
742	CHARACTER (LEN=*) :: unit !<
743	CHARACTER (LEN=*) :: variable !<
744	CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit
745
746	INTEGER(iwp) :: var_count !<
747
748	SELECT CASE ( TRIM( variable ) )
749
750	CASE ( 'prho' )
751	dopr_index(var_count) = 71
752	dopr_unit = 'kg/m3'
753	hom(:,2,71,:) = SPREAD( zu, 2, statistic_regions+1 )
754	unit = dopr_unit
755
756	CASE ( 'rho_sea_water' )
757	dopr_index(var_count) = 64
758	dopr_unit = 'kg/m3'
759	hom(:,2,64,:) = SPREAD( zu, 2, statistic_regions+1 )
760	IF ( data_output_pr(var_count)(1:1) == '#' ) THEN
761	dopr_initial_index(var_count) = 77
762	hom(:,2,77,:) = SPREAD( zu, 2, statistic_regions+1 )
763	hom(nzb,2,77,:) = 0.0_wp ! because zu(nzb) is negative
764	data_output_pr(var_count) = data_output_pr(var_count)(2:)
765	ENDIF
766	unit = dopr_unit
767
768	CASE ( 'sa', '#sa' )
769	dopr_index(var_count) = 23
770	dopr_unit = 'psu'
771	hom(:,2,23,:) = SPREAD( zu, 2, statistic_regions+1 )
772	IF ( data_output_pr(var_count)(1:1) == '#' ) THEN
773	dopr_initial_index(var_count) = 26
774	hom(:,2,26,:) = SPREAD( zu, 2, statistic_regions+1 )
775	hom(nzb,2,26,:) = 0.0_wp ! because zu(nzb) is negative
776	data_output_pr(var_count) = data_output_pr(var_count)(2:)
777	ENDIF
778	unit = dopr_unit
779
780	CASE ( 'w"sa"' )
781	dopr_index(var_count) = 65
782	dopr_unit = 'psu m/s'
783	hom(:,2,65,:) = SPREAD( zw, 2, statistic_regions+1 )
784	unit = dopr_unit
785
786	CASE ( 'wsa' )
787	dopr_index(var_count) = 66
788	dopr_unit = 'psu m/s'
789	hom(:,2,66,:) = SPREAD( zw, 2, statistic_regions+1 )
790	unit = dopr_unit
791
792	CASE ( 'wsa' )
793	dopr_index(var_count) = 67
794	dopr_unit = 'psu m/s'
795	hom(:,2,67,:) = SPREAD( zw, 2, statistic_regions+1 )
796	unit = dopr_unit
797
798	CASE DEFAULT
799	unit = 'illegal'
800
801	END SELECT
802
803
804	END SUBROUTINE ocean_check_data_output_pr
805
806
807	!------------------------------------------------------------------------------!
808	! Description:
809	! ------------
810	!> Define appropriate grid for netcdf variables.
811	!> It is called out from subroutine netcdf.
812	!------------------------------------------------------------------------------!
813	SUBROUTINE ocean_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
814
815	IMPLICIT NONE
816
817	CHARACTER (LEN=*), INTENT(OUT) :: grid_x !< x grid of output variable
818	CHARACTER (LEN=*), INTENT(OUT) :: grid_y !< y grid of output variable
819	CHARACTER (LEN=*), INTENT(OUT) :: grid_z !< z grid of output variable
820	CHARACTER (LEN=*), INTENT(IN) :: var !< name of output variable
821
822	LOGICAL, INTENT(OUT) :: found !< flag if output variable is found
823
824	found = .TRUE.
825
826	!
827	!-- Check for the grid
828	SELECT CASE ( TRIM( var ) )
829
830	CASE ( 'rho_sea_water', 'rho_sea_water_xy', 'rho_sea_water_xz', &
831	'rho_sea_water_yz', 'sa', 'sa_xy', 'sa_xz', 'sa_yz' )
832	grid_x = 'x'
833	grid_y = 'y'
834	grid_z = 'zu'
835
836	CASE DEFAULT
837	found = .FALSE.
838	grid_x = 'none'
839	grid_y = 'none'
840	grid_z = 'none'
841
842	END SELECT
843
844	END SUBROUTINE ocean_define_netcdf_grid
845
846
847	!------------------------------------------------------------------------------!
848	! Description:
849	! ------------
850	!> Average 3D data.
851	!------------------------------------------------------------------------------!
852	SUBROUTINE ocean_3d_data_averaging( mode, variable )
853
854
855	USE arrays_3d, &
856	ONLY: rho_ocean, sa
857
858	USE averaging, &
859	ONLY: rho_ocean_av, sa_av
860
861	USE control_parameters, &
862	ONLY: average_count_3d
863
864	USE indices, &
865	ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt
866
867	IMPLICIT NONE
868
869	CHARACTER (LEN=*) :: mode !< flag defining mode 'allocate', 'sum' or 'average'
870	CHARACTER (LEN=*) :: variable !< name of variable
871
872	INTEGER(iwp) :: i !< loop index
873	INTEGER(iwp) :: j !< loop index
874	INTEGER(iwp) :: k !< loop index
875
876	IF ( mode == 'allocate' ) THEN
877
878	SELECT CASE ( TRIM( variable ) )
879
880	CASE ( 'rho_sea_water' )
881	IF ( .NOT. ALLOCATED( rho_ocean_av ) ) THEN
882	ALLOCATE( rho_ocean_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
883	ENDIF
884	rho_ocean_av = 0.0_wp
885
886	CASE ( 'sa' )
887	IF ( .NOT. ALLOCATED( sa_av ) ) THEN
888	ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
889	ENDIF
890	sa_av = 0.0_wp
891
892	CASE DEFAULT
893	CONTINUE
894
895	END SELECT
896
897	ELSEIF ( mode == 'sum' ) THEN
898
899	SELECT CASE ( TRIM( variable ) )
900
901	CASE ( 'rho_sea_water' )
902	IF ( ALLOCATED( rho_ocean_av ) ) THEN
903	DO i = nxlg, nxrg
904	DO j = nysg, nyng
905	DO k = nzb, nzt+1
906	rho_ocean_av(k,j,i) = rho_ocean_av(k,j,i) + &
907	rho_ocean(k,j,i)
908	ENDDO
909	ENDDO
910	ENDDO
911	ENDIF
912
913	CASE ( 'sa' )
914	IF ( ALLOCATED( sa_av ) ) THEN
915	DO i = nxlg, nxrg
916	DO j = nysg, nyng
917	DO k = nzb, nzt+1
918	sa_av(k,j,i) = sa_av(k,j,i) + sa(k,j,i)
919	ENDDO
920	ENDDO
921	ENDDO
922	ENDIF
923
924	CASE DEFAULT
925	CONTINUE
926
927	END SELECT
928
929	ELSEIF ( mode == 'average' ) THEN
930
931	SELECT CASE ( TRIM( variable ) )
932
933	CASE ( 'rho_sea_water' )
934	IF ( ALLOCATED( rho_ocean_av ) ) THEN
935	DO i = nxlg, nxrg
936	DO j = nysg, nyng
937	DO k = nzb, nzt+1
938	rho_ocean_av(k,j,i) = rho_ocean_av(k,j,i) / &
939	REAL( average_count_3d, KIND=wp )
940	ENDDO
941	ENDDO
942	ENDDO
943	ENDIF
944
945	CASE ( 'sa' )
946	IF ( ALLOCATED( sa_av ) ) THEN
947	DO i = nxlg, nxrg
948	DO j = nysg, nyng
949	DO k = nzb, nzt+1
950	sa_av(k,j,i) = sa_av(k,j,i) / &
951	REAL( average_count_3d, KIND=wp )
952	ENDDO
953	ENDDO
954	ENDDO
955	ENDIF
956
957	END SELECT
958
959	ENDIF
960
961	END SUBROUTINE ocean_3d_data_averaging
962
963
964	!------------------------------------------------------------------------------!
965	! Description:
966	! ------------
967	!> Define 2D output variables.
968	!------------------------------------------------------------------------------!
969	SUBROUTINE ocean_data_output_2d( av, variable, found, grid, mode, local_pf, &
970	nzb_do, nzt_do )
971
972	USE arrays_3d, &
973	ONLY: rho_ocean, sa
974
975	USE averaging, &
976	ONLY: rho_ocean_av, sa_av
977
978	USE indices, &
979	ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, &
980	wall_flags_total_0
981
982	IMPLICIT NONE
983
984	CHARACTER (LEN=*) :: grid !< name of vertical grid
985	CHARACTER (LEN=*) :: mode !< either 'xy', 'xz' or 'yz'
986	CHARACTER (LEN=*) :: variable !< name of variable
987
988	INTEGER(iwp) :: av !< flag for (non-)average output
989	INTEGER(iwp) :: flag_nr !< number of masking flag
990	INTEGER(iwp) :: i !< loop index
991	INTEGER(iwp) :: j !< loop index
992	INTEGER(iwp) :: k !< loop index
993	INTEGER(iwp) :: nzb_do !< vertical output index (bottom)
994	INTEGER(iwp) :: nzt_do !< vertical output index (top)
995
996	LOGICAL :: found !< flag if output variable is found
997	LOGICAL :: resorted !< flag if output is already resorted
998
999	REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute
1000
1001	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< local
1002	!< array to which output data is resorted to
1003
1004	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to selected output variable
1005
1006	found = .TRUE.
1007	resorted = .FALSE.
1008	!
1009	!-- Set masking flag for topography for not resorted arrays
1010	flag_nr = 0
1011
1012	SELECT CASE ( TRIM( variable ) )
1013
1014	CASE ( 'rho_sea_water_xy', 'rho_sea_water_xz', 'rho_sea_water_yz' )
1015	IF ( av == 0 ) THEN
1016	to_be_resorted => rho_ocean
1017	ELSE
1018	IF ( .NOT. ALLOCATED( rho_ocean_av ) ) THEN
1019	ALLOCATE( rho_ocean_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1020	rho_ocean_av = REAL( fill_value, KIND = wp )
1021	ENDIF
1022	to_be_resorted => rho_ocean_av
1023	ENDIF
1024
1025	CASE ( 'sa_xy', 'sa_xz', 'sa_yz' )
1026	IF ( av == 0 ) THEN
1027	to_be_resorted => sa
1028	ELSE
1029	IF ( .NOT. ALLOCATED( sa_av ) ) THEN
1030	ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1031	sa_av = REAL( fill_value, KIND = wp )
1032	ENDIF
1033	to_be_resorted => sa_av
1034	ENDIF
1035	IF ( mode == 'xy' ) grid = 'zu'
1036
1037	CASE DEFAULT
1038	found = .FALSE.
1039	grid = 'none'
1040
1041	END SELECT
1042
1043	IF ( found .AND. .NOT. resorted ) THEN
1044	DO i = nxl, nxr
1045	DO j = nys, nyn
1046	DO k = nzb_do, nzt_do
1047	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
1048	REAL( fill_value, KIND = wp ), &
1049	BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
1050	ENDDO
1051	ENDDO
1052	ENDDO
1053	resorted = .TRUE.
1054	ENDIF
1055
1056	END SUBROUTINE ocean_data_output_2d
1057
1058
1059	!------------------------------------------------------------------------------!
1060	! Description:
1061	! ------------
1062	!> Define 3D output variables.
1063	!------------------------------------------------------------------------------!
1064	SUBROUTINE ocean_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1065
1066
1067	USE arrays_3d, &
1068	ONLY: rho_ocean, sa
1069
1070	USE averaging, &
1071	ONLY: rho_ocean_av, sa_av
1072
1073	USE indices, &
1074	ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, &
1075	wall_flags_total_0
1076
1077	IMPLICIT NONE
1078
1079	CHARACTER (LEN=*) :: variable !< name of variable
1080
1081	INTEGER(iwp) :: av !< flag for (non-)average output
1082	INTEGER(iwp) :: flag_nr !< number of masking flag
1083	INTEGER(iwp) :: i !< loop index
1084	INTEGER(iwp) :: j !< loop index
1085	INTEGER(iwp) :: k !< loop index
1086	INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0)
1087	INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d)
1088
1089	LOGICAL :: found !< flag if output variable is found
1090	LOGICAL :: resorted !< flag if output is already resorted
1091
1092	REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute
1093
1094	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< local
1095	!< array to which output data is resorted to
1096
1097	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to selected output variable
1098
1099	found = .TRUE.
1100	resorted = .FALSE.
1101	!
1102	!-- Set masking flag for topography for not resorted arrays
1103	flag_nr = 0
1104
1105	SELECT CASE ( TRIM( variable ) )
1106
1107	CASE ( 'rho_sea_water' )
1108	IF ( av == 0 ) THEN
1109	to_be_resorted => rho_ocean
1110	ELSE
1111	IF ( .NOT. ALLOCATED( rho_ocean_av ) ) THEN
1112	ALLOCATE( rho_ocean_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1113	rho_ocean_av = REAL( fill_value, KIND = wp )
1114	ENDIF
1115	to_be_resorted => rho_ocean_av
1116	ENDIF
1117
1118	CASE ( 'sa' )
1119	IF ( av == 0 ) THEN
1120	to_be_resorted => sa
1121	ELSE
1122	IF ( .NOT. ALLOCATED( sa_av ) ) THEN
1123	ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1124	sa_av = REAL( fill_value, KIND = wp )
1125	ENDIF
1126	to_be_resorted => sa_av
1127	ENDIF
1128
1129	CASE DEFAULT
1130	found = .FALSE.
1131
1132	END SELECT
1133
1134
1135	IF ( found .AND. .NOT. resorted ) THEN
1136	DO i = nxl, nxr
1137	DO j = nys, nyn
1138	DO k = nzb_do, nzt_do
1139	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
1140	REAL( fill_value, KIND = wp ), &
1141	BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
1142	ENDDO
1143	ENDDO
1144	ENDDO
1145	resorted = .TRUE.
1146	ENDIF
1147
1148	END SUBROUTINE ocean_data_output_3d
1149
1150
1151	!------------------------------------------------------------------------------!
1152	! Description:
1153	! ------------
1154	!> Header output for ocean parameters
1155	!------------------------------------------------------------------------------!
1156	SUBROUTINE ocean_header( io )
1157
1158
1159	IMPLICIT NONE
1160
1161	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
1162
1163	!
1164	!-- Write ocean header
1165	WRITE( io, 1 )
1166	IF ( stokes_force ) WRITE( io, 2 ) stokes_waveheight, stokes_wavelength
1167	IF ( wave_breaking ) THEN
1168	WRITE( io, 3 ) alpha_wave_breaking, timescale_wave_breaking
1169	ENDIF
1170	IF ( .NOT. salinity ) WRITE( io, 4 )
1171	IF ( surface_cooling_spinup_time /= 999999.9_wp ) THEN
1172	WRITE( io, 5 ) surface_cooling_spinup_time
1173	ENDIF
1174
1175	1 FORMAT (//' Ocean settings:'/ &
1176	' ------------------------------------------'/)
1177	2 FORMAT (' --> Craik-Leibovich vortex force and Stokes drift switched', &
1178	' on'/ &
1179	' waveheight: ',F4.1,' m wavelength: ',F6.1,' m')
1180	3 FORMAT (' --> wave breaking generated turbulence switched on'/ &
1181	' alpha: ',F4.1/ &
1182	' timescale:',F5.1,' s')
1183	4 FORMAT (' --> prognostic salinity equation is switched off' )
1184	5 FORMAT (' --> surface heat flux is switched off after ',F8.1,' s')
1185
1186	END SUBROUTINE ocean_header
1187
1188
1189	!------------------------------------------------------------------------------!
1190	! Description:
1191	! ------------
1192	!> Allocate arrays and assign pointers.
1193	!------------------------------------------------------------------------------!
1194	SUBROUTINE ocean_init_arrays
1195
1196	USE indices, &
1197	ONLY: nxlg, nxrg, nyn, nyng, nys, nysg, nzb, nzt
1198
1199	IMPLICIT NONE
1200
1201	ALLOCATE( prho_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
1202	rho_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
1203	sa_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
1204	sa_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1205
1206	IF ( salinity ) THEN
1207	ALLOCATE( sa_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1208	ENDIF
1209
1210	IF ( ws_scheme_sca ) THEN
1211	ALLOCATE( sums_wssas_ws_l(nzb:nzt+1,0:threads_per_task-1) )
1212	sums_wssas_ws_l = 0.0_wp
1213	ENDIF
1214
1215	IF ( loop_optimization /= 'vector' ) THEN
1216
1217	IF ( ws_scheme_sca ) THEN
1218	ALLOCATE( flux_s_sa(nzb+1:nzt,0:threads_per_task-1) )
1219	ALLOCATE( diss_s_sa(nzb+1:nzt,0:threads_per_task-1) )
1220	ALLOCATE( flux_l_sa(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
1221	ALLOCATE( diss_l_sa(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
1222	ENDIF
1223
1224	ENDIF
1225
1226	prho => prho_1
1227	rho_ocean => rho_1 ! routines calc_mean_profile and diffusion_e require
1228	! density to be a pointer
1229
1230	!
1231	!-- Initial assignment of pointers
1232	IF ( salinity ) THEN
1233	sa => sa_1; sa_p => sa_2; tsa_m => sa_3
1234	ELSE
1235	sa => sa_1; sa_p => sa_1; tsa_m => sa_3
1236	ENDIF
1237
1238	END SUBROUTINE ocean_init_arrays
1239
1240
1241	!------------------------------------------------------------------------------!
1242	! Description:
1243	! ------------
1244	!> Initialization of quantities needed for the ocean mode
1245	!------------------------------------------------------------------------------!
1246	SUBROUTINE ocean_init
1247
1248
1249	USE arrays_3d, &
1250	ONLY: dzu, dzw, hyp, pt_init, ref_state, u_stokes_zu, u_stokes_zw, &
1251	v_stokes_zu, v_stokes_zw, zu, zw
1252
1253	USE basic_constants_and_equations_mod, &
1254	ONLY: g
1255
1256	USE basic_constants_and_equations_mod, &
1257	ONLY: pi
1258
1259	USE control_parameters, &
1260	ONLY: initializing_actions, molecular_viscosity, rho_surface, &
1261	rho_reference, surface_pressure, top_momentumflux_u, &
1262	top_momentumflux_v, use_single_reference_value
1263
1264	USE indices, &
1265	ONLY: nxl, nxlg, nxrg, nyng, nys, nysg, nzb, nzt
1266
1267	USE kinds
1268
1269	USE pegrid, &
1270	ONLY: myid
1271
1272	USE statistics, &
1273	ONLY: hom, statistic_regions
1274
1275	IMPLICIT NONE
1276
1277	INTEGER(iwp) :: i !< loop index
1278	INTEGER(iwp) :: j !< loop index
1279	INTEGER(iwp) :: k !< loop index
1280	INTEGER(iwp) :: n !< loop index
1281
1282	REAL(wp) :: alpha !< angle of surface stress
1283	REAL(wp) :: dum !< dummy argument
1284	REAL(wp) :: pt_l !< local scalar for pt used in equation of state function
1285	REAL(wp) :: sa_l !< local scalar for sa used in equation of state function
1286	REAL(wp) :: velocity_amplitude !< local scalar for amplitude of Stokes drift velocity
1287	REAL(wp) :: x !< temporary variable to store surface stress along x
1288	REAL(wp) :: y !< temporary variable to store surface stress along y
1289
1290	REAL(wp), DIMENSION(nzb:nzt+1) :: rho_ocean_init !< local array for initial density
1291
1292	ALLOCATE( hyp(nzb:nzt+1) )
1293
1294
1295	!
1296	!-- In case of no restart run, calculate the inital salinity profilevcusing the
1297	!-- given salinity gradients
1298	IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
1299
1300	sa_init = sa_surface
1301	!
1302	!-- Last arguments gives back the gradient at top level to be used as
1303	!-- possible Neumann boundary condition. This is not realized for the ocean
1304	!-- mode, therefore a dummy argument is used.
1305	IF ( salinity ) THEN
1306	CALL init_vertical_profiles( sa_vertical_gradient_level_ind, &
1307	sa_vertical_gradient_level, &
1308	sa_vertical_gradient, sa_init, &
1309	sa_surface, dum )
1310	ENDIF
1311	ENDIF
1312
1313	!
1314	!-- Initialize required 3d-arrays
1315	IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. &
1316	TRIM( initializing_actions ) /= 'cyclic_fill' ) THEN
1317	!
1318	!-- Initialization via computed 1D-model profiles
1319	IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 ) THEN
1320
1321	DO i = nxlg, nxrg
1322	DO j = nysg, nyng
1323	sa(:,j,i) = sa_init
1324	ENDDO
1325	ENDDO
1326
1327	ENDIF
1328	!
1329	!-- Store initial profiles for output purposes etc.
1330	!-- Store initial salinity profile
1331	hom(:,1,26,:) = SPREAD( sa(:,nys,nxl), 2, statistic_regions+1 )
1332	!
1333	!-- Initialize old and new time levels.
1334	tsa_m = 0.0_wp
1335	sa_p = sa
1336
1337	ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data' ) THEN
1338
1339	!
1340	!-- Initialize new time levels (only done in order to set boundary values
1341	!-- including ghost points)
1342	sa_p = sa
1343	!
1344	!-- Allthough tendency arrays are set in prognostic_equations, they have
1345	!-- have to be predefined here because they are used (but multiplied with 0)
1346	!-- there before they are set.
1347	tsa_m = 0.0_wp
1348
1349	ENDIF
1350
1351	!
1352	!-- Set water density near the ocean surface
1353	rho_surface = 1027.62_wp
1354
1355	!
1356	!-- Set kinematic viscosity to sea water at 20C.
1357	!-- This changes the default value that is given for air!
1358	molecular_viscosity = 1.05E-6_wp
1359
1360	!
1361	!-- Change sign of buoyancy/stability terms because density gradient is used
1362	!-- instead of the potential temperature gradient to calculate the buoyancy
1363	atmos_ocean_sign = -1.0_wp
1364
1365	!
1366	!-- Calculate initial vertical profile of hydrostatic pressure (in Pa)
1367	!-- and the reference density (used later in buoyancy term)
1368	!-- First step: Calculate pressure using reference density
1369	hyp(nzt+1) = surface_pressure * 100.0_wp
1370	hyp(nzt) = hyp(nzt+1) + rho_surface * g * 0.5_wp * dzu(nzt+1)
1371	rho_ocean_init(nzt) = rho_surface
1372	rho_ocean_init(nzt+1) = rho_surface ! only required for output
1373
1374	DO k = nzt-1, 1, -1
1375	hyp(k) = hyp(k+1) + rho_surface * g * dzu(k)
1376	ENDDO
1377	hyp(0) = hyp(1) + rho_surface * g * dzu(1)
1378
1379	!
1380	!-- Second step: Iteratively calculate in situ density (based on presssure)
1381	!-- and pressure (based on in situ density)
1382	DO n = 1, 5
1383
1384	rho_reference = rho_surface * 0.5_wp * dzu(nzt+1)
1385
1386	DO k = nzt, 0, -1
1387
1388	sa_l = 0.5_wp * ( sa_init(k) + sa_init(k+1) )
1389	pt_l = 0.5_wp * ( pt_init(k) + pt_init(k+1) )
1390
1391	rho_ocean_init(k) = eqn_state_seawater_func( hyp(k), pt_l, sa_l )
1392
1393	rho_reference = rho_reference + rho_ocean_init(k) * dzu(k+1)
1394
1395	ENDDO
1396
1397	rho_reference = rho_reference / ( zw(nzt) - zu(nzb) )
1398
1399	hyp(nzt) = hyp(nzt+1) + rho_surface * g * 0.5_wp * dzu(nzt+1)
1400	DO k = nzt-1, 0, -1
1401	hyp(k) = hyp(k+1) + g * 0.5_wp * ( rho_ocean_init(k) &
1402	+ rho_ocean_init(k+1) ) * dzu(k+1)
1403	ENDDO
1404
1405	ENDDO
1406
1407	!
1408	!-- Calculate the reference potential density
1409	prho_reference = 0.0_wp
1410	DO k = 0, nzt
1411
1412	sa_l = 0.5_wp * ( sa_init(k) + sa_init(k+1) )
1413	pt_l = 0.5_wp * ( pt_init(k) + pt_init(k+1) )
1414
1415	prho_reference = prho_reference + dzu(k+1) * &
1416	eqn_state_seawater_func( 0.0_wp, pt_l, sa_l )
1417
1418	ENDDO
1419
1420	prho_reference = prho_reference / ( zu(nzt) - zu(nzb) )
1421
1422	!
1423	!-- Calculate the 3d array of initial in situ and potential density,
1424	!-- based on the initial temperature and salinity profile
1425	CALL eqn_state_seawater
1426
1427	!
1428	!-- Store initial density profile
1429	hom(:,1,77,:) = SPREAD( rho_ocean_init(:), 2, statistic_regions+1 )
1430
1431	!
1432	!-- Set the reference state to be used in the buoyancy terms
1433	IF ( use_single_reference_value ) THEN
1434	ref_state(:) = rho_reference
1435	ELSE
1436	ref_state(:) = rho_ocean_init(:)
1437	ENDIF
1438
1439	!
1440	!-- Calculate the Stokes drift velocity profile
1441	IF ( stokes_force ) THEN
1442
1443	!
1444	!-- First, calculate angle of surface stress
1445	x = -top_momentumflux_u
1446	y = -top_momentumflux_v
1447	IF ( x == 0.0_wp ) THEN
1448	IF ( y > 0.0_wp ) THEN
1449	alpha = pi / 2.0_wp
1450	ELSEIF ( y < 0.0_wp ) THEN
1451	alpha = 3.0_wp * pi / 2.0_wp
1452	ENDIF
1453	ELSE
1454	IF ( x < 0.0_wp ) THEN
1455	alpha = ATAN( y / x ) + pi
1456	ELSE
1457	IF ( y < 0.0_wp ) THEN
1458	alpha = ATAN( y / x ) + 2.0_wp * pi
1459	ELSE
1460	alpha = ATAN( y / x )
1461	ENDIF
1462	ENDIF
1463	ENDIF
1464
1465	velocity_amplitude = ( pi * stokes_waveheight / stokes_wavelength )*2 &
1466	SQRT( g * stokes_wavelength / ( 2.0_wp * pi ) )
1467
1468	DO k = nzb, nzt
1469	u_stokes_zu(k) = velocity_amplitude * COS( alpha ) * &
1470	EXP( 4.0_wp * pi * zu(k) / stokes_wavelength )
1471	u_stokes_zw(k) = velocity_amplitude * COS( alpha ) * &
1472	EXP( 4.0_wp * pi * zw(k) / stokes_wavelength )
1473	v_stokes_zu(k) = velocity_amplitude * SIN( alpha ) * &
1474	EXP( 4.0_wp * pi * zu(k) / stokes_wavelength )
1475	v_stokes_zw(k) = velocity_amplitude * SIN( alpha ) * &
1476	EXP( 4.0_wp * pi * zw(k) / stokes_wavelength )
1477	ENDDO
1478	u_stokes_zu(nzt+1) = u_stokes_zw(nzt) ! because zu(nzt+1) changes the sign
1479	u_stokes_zw(nzt+1) = u_stokes_zw(nzt) ! because zw(nzt+1) changes the sign
1480	v_stokes_zu(nzt+1) = v_stokes_zw(nzt) ! because zu(nzt+1) changes the sign
1481	v_stokes_zw(nzt+1) = v_stokes_zw(nzt) ! because zw(nzt+1) changes the sign
1482
1483	ENDIF
1484
1485	!
1486	!-- Wave breaking effects
1487	IF ( wave_breaking ) THEN
1488	!
1489	!-- Calculate friction velocity at ocean surface
1490	u_star_wave_breaking = SQRT( SQRT( top_momentumflux_u**2 + &
1491	top_momentumflux_v**2 ) )
1492	!
1493	!-- Set the time scale of random forcing. The vertical grid spacing at the
1494	!-- ocean surface is assumed as the length scale of turbulence.
1495	!-- Formula follows Noh et al. (2004), JPO
1496	timescale_wave_breaking = 0.1_wp * dzw(nzt) / alpha_wave_breaking / &
1497	u_star_wave_breaking
1498	!
1499	!-- Set random number seeds differently on the processor cores in order to
1500	!-- create different random number sequences
1501	iran_ocean = iran_ocean + myid
1502	ENDIF
1503
1504	END SUBROUTINE ocean_init
1505
1506
1507	!------------------------------------------------------------------------------!
1508	! Description:
1509	! ------------
1510	!> Call for all grid points
1511	!------------------------------------------------------------------------------!
1512	SUBROUTINE ocean_actions( location )
1513
1514
1515	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
1516
1517	SELECT CASE ( location )
1518
1519	CASE ( 'before_timestep' )
1520
1521	IF ( ws_scheme_sca ) THEN
1522	sums_wssas_ws_l = 0.0_wp
1523	ENDIF
1524
1525	CASE DEFAULT
1526	CONTINUE
1527
1528	END SELECT
1529
1530	END SUBROUTINE ocean_actions
1531
1532
1533	!------------------------------------------------------------------------------!
1534	! Description:
1535	! ------------
1536	!> Call for grid points i,j
1537	!------------------------------------------------------------------------------!
1538	SUBROUTINE ocean_actions_ij( i, j, location )
1539
1540
1541	INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction
1542	INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction
1543	CHARACTER (LEN=*), INTENT(IN) :: location !< call location string
1544	INTEGER(iwp) :: dummy !< call location string
1545
1546	IF ( ocean_mode ) dummy = i + j
1547
1548	SELECT CASE ( location )
1549
1550	CASE ( 'before_timestep' )
1551
1552	IF ( ws_scheme_sca ) THEN
1553	sums_wssas_ws_l = 0.0_wp
1554	ENDIF
1555
1556	CASE DEFAULT
1557	CONTINUE
1558
1559	END SELECT
1560
1561	END SUBROUTINE ocean_actions_ij
1562
1563
1564	!------------------------------------------------------------------------------!
1565	! Description:
1566	! ------------
1567	!> Prognostic equation for salinity.
1568	!> Vector-optimized version
1569	!------------------------------------------------------------------------------!
1570	SUBROUTINE ocean_prognostic_equations
1571
1572	USE advec_s_bc_mod, &
1573	ONLY: advec_s_bc
1574
1575	USE advec_s_pw_mod, &
1576	ONLY: advec_s_pw
1577
1578	USE advec_s_up_mod, &
1579	ONLY: advec_s_up
1580
1581	USE advec_ws, &
1582	ONLY: advec_s_ws
1583
1584	USE arrays_3d, &
1585	ONLY: rdf_sc, tend, tsa_m
1586
1587	USE control_parameters, &
1588	ONLY: bc_dirichlet_l, &
1589	bc_dirichlet_n, &
1590	bc_dirichlet_r, &
1591	bc_dirichlet_s, &
1592	bc_radiation_l, &
1593	bc_radiation_n, &
1594	bc_radiation_r, &
1595	bc_radiation_s, &
1596	dt_3d, intermediate_timestep_count, &
1597	intermediate_timestep_count_max, scalar_advec, simulated_time, &
1598	timestep_scheme, tsc, ws_scheme_sca
1599
1600	USE cpulog, &
1601	ONLY: cpu_log, log_point_s
1602
1603	USE diffusion_s_mod, &
1604	ONLY: diffusion_s
1605
1606	IMPLICIT NONE
1607
1608	INTEGER(iwp) :: i !< loop index
1609	INTEGER(iwp) :: j !< loop index
1610	INTEGER(iwp) :: k !< loop index
1611
1612	REAL(wp) :: sbt !< weighting factor for sub-time step
1613
1614	!
1615	!-- Switch of the surface heat flux, if requested
1616	IF ( surface_cooling_spinup_time /= 999999.9_wp ) THEN
1617	IF ( .NOT. surface_cooling_switched_off .AND. &
1618	simulated_time >= surface_cooling_spinup_time ) THEN
1619
1620	surf_def_h(2)%shf = 0.0_wp
1621	surface_cooling_switched_off = .TRUE.
1622
1623	ENDIF
1624	ENDIF
1625
1626	!
1627	!-- Compute prognostic equations for the ocean mode
1628	!-- First, start with salinity
1629	IF ( salinity ) THEN
1630
1631	CALL cpu_log( log_point_s(20), 'sa-equation', 'start' )
1632
1633	!
1634	!-- sa-tendency terms with communication
1635	sbt = tsc(2)
1636	IF ( scalar_advec == 'bc-scheme' ) THEN
1637
1638	IF ( timestep_scheme(1:5) /= 'runge' ) THEN
1639	!
1640	!-- Bott-Chlond scheme always uses Euler time step. Thus:
1641	sbt = 1.0_wp
1642	ENDIF
1643	tend = 0.0_wp
1644	CALL advec_s_bc( sa, 'sa' )
1645
1646	ENDIF
1647
1648	!
1649	!-- sa-tendency terms with no communication
1650	IF ( scalar_advec /= 'bc-scheme' ) THEN
1651	tend = 0.0_wp
1652	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1653	IF ( ws_scheme_sca ) THEN
1654	CALL advec_s_ws( advc_flags_s, sa, 'sa', &
1655	bc_dirichlet_l .OR. bc_radiation_l, &
1656	bc_dirichlet_n .OR. bc_radiation_n, &
1657	bc_dirichlet_r .OR. bc_radiation_r, &
1658	bc_dirichlet_s .OR. bc_radiation_s )
1659	ELSE
1660	CALL advec_s_pw( sa )
1661	ENDIF
1662	ELSE
1663	CALL advec_s_up( sa )
1664	ENDIF
1665	ENDIF
1666
1667	CALL diffusion_s( sa, &
1668	surf_def_h(0)%sasws, surf_def_h(1)%sasws, &
1669	surf_def_h(2)%sasws, &
1670	surf_lsm_h%sasws, surf_usm_h%sasws, &
1671	surf_def_v(0)%sasws, surf_def_v(1)%sasws, &
1672	surf_def_v(2)%sasws, surf_def_v(3)%sasws, &
1673	surf_lsm_v(0)%sasws, surf_lsm_v(1)%sasws, &
1674	surf_lsm_v(2)%sasws, surf_lsm_v(3)%sasws, &
1675	surf_usm_v(0)%sasws, surf_usm_v(1)%sasws, &
1676	surf_usm_v(2)%sasws, surf_usm_v(3)%sasws )
1677
1678	! CALL user_actions( 'sa-tendency' ) ToDo: find general solution for dependency between modules
1679
1680	!
1681	!-- Prognostic equation for salinity
1682	DO i = nxl, nxr
1683	DO j = nys, nyn
1684	!following directive is required to vectorize on Intel19
1685	!DIR$ IVDEP
1686	DO k = nzb+1, nzt
1687	sa_p(k,j,i) = sa(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &
1688	tsc(3) * tsa_m(k,j,i) ) &
1689	- tsc(5) * rdf_sc(k) * &
1690	( sa(k,j,i) - sa_init(k) ) &
1691	) &
1692	* MERGE( 1.0_wp, 0.0_wp, &
1693	BTEST( wall_flags_total_0(k,j,i), 0 ) &
1694	)
1695	IF ( sa_p(k,j,i) < 0.0_wp ) sa_p(k,j,i) = 0.1_wp * sa(k,j,i)
1696	ENDDO
1697	ENDDO
1698	ENDDO
1699
1700	!
1701	!-- Calculate tendencies for the next Runge-Kutta step
1702	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1703	IF ( intermediate_timestep_count == 1 ) THEN
1704	DO i = nxl, nxr
1705	DO j = nys, nyn
1706	DO k = nzb+1, nzt
1707	tsa_m(k,j,i) = tend(k,j,i)
1708	ENDDO
1709	ENDDO
1710	ENDDO
1711	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) &
1712	THEN
1713	DO i = nxl, nxr
1714	DO j = nys, nyn
1715	DO k = nzb+1, nzt
1716	tsa_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
1717	5.3125_wp * tsa_m(k,j,i)
1718	ENDDO
1719	ENDDO
1720	ENDDO
1721	ENDIF
1722	ENDIF
1723
1724	CALL cpu_log( log_point_s(20), 'sa-equation', 'stop' )
1725
1726	ENDIF
1727
1728	!
1729	!-- Calculate density by the equation of state for seawater
1730	CALL cpu_log( log_point_s(21), 'eqns-seawater', 'start' )
1731	CALL eqn_state_seawater
1732	CALL cpu_log( log_point_s(21), 'eqns-seawater', 'stop' )
1733
1734	END SUBROUTINE ocean_prognostic_equations
1735
1736
1737	!------------------------------------------------------------------------------!
1738	! Description:
1739	! ------------
1740	!> Prognostic equations for ocean mode (so far, salinity only)
1741	!> Cache-optimized version
1742	!------------------------------------------------------------------------------!
1743	SUBROUTINE ocean_prognostic_equations_ij( i, j, i_omp_start, tn )
1744
1745	USE advec_s_pw_mod, &
1746	ONLY: advec_s_pw
1747
1748	USE advec_s_up_mod, &
1749	ONLY: advec_s_up
1750
1751	USE advec_ws, &
1752	ONLY: advec_s_ws
1753
1754	USE arrays_3d, &
1755	ONLY: diss_l_sa, diss_s_sa, flux_l_sa, flux_s_sa, rdf_sc, tend, tsa_m
1756
1757	USE control_parameters, &
1758	ONLY: bc_dirichlet_l, &
1759	bc_dirichlet_n, &
1760	bc_dirichlet_r, &
1761	bc_dirichlet_s, &
1762	bc_radiation_l, &
1763	bc_radiation_n, &
1764	bc_radiation_r, &
1765	bc_radiation_s, &
1766	dt_3d, intermediate_timestep_count, &
1767	intermediate_timestep_count_max, simulated_time, &
1768	timestep_scheme, tsc, ws_scheme_sca
1769
1770	USE diffusion_s_mod, &
1771	ONLY: diffusion_s
1772
1773	IMPLICIT NONE
1774
1775	INTEGER(iwp) :: i !< loop index x direction
1776	INTEGER(iwp) :: i_omp_start !< first loop index of i-loop in calling &
1777	!< routine prognostic_equations
1778	INTEGER(iwp) :: j !< loop index y direction
1779	INTEGER(iwp) :: k !< loop index z direction
1780	INTEGER(iwp) :: tn !< task number of openmp task
1781
1782
1783	!
1784	!-- Switch of the surface heat flux, if requested
1785	IF ( surface_cooling_spinup_time /= 999999.9_wp ) THEN
1786	IF ( .NOT. surface_cooling_switched_off .AND. &
1787	simulated_time >= surface_cooling_spinup_time ) THEN
1788
1789	surf_def_h(2)%shf = 0.0_wp
1790	surface_cooling_switched_off = .TRUE.
1791
1792	ENDIF
1793	ENDIF
1794
1795	!
1796	!-- Compute prognostic equations for the ocean mode
1797	!-- First, start with tendency-terms for salinity
1798	IF ( salinity ) THEN
1799
1800	tend(:,j,i) = 0.0_wp
1801	IF ( timestep_scheme(1:5) == 'runge' ) &
1802	THEN
1803	IF ( ws_scheme_sca ) THEN
1804	CALL advec_s_ws( advc_flags_s, &
1805	i, j, sa, 'sa', flux_s_sa, diss_s_sa, flux_l_sa,&
1806	diss_l_sa, i_omp_start, tn, &
1807	bc_dirichlet_l .OR. bc_radiation_l, &
1808	bc_dirichlet_n .OR. bc_radiation_n, &
1809	bc_dirichlet_r .OR. bc_radiation_r, &
1810	bc_dirichlet_s .OR. bc_radiation_s )
1811	ELSE
1812	CALL advec_s_pw( i, j, sa )
1813	ENDIF
1814	ELSE
1815	CALL advec_s_up( i, j, sa )
1816	ENDIF
1817	CALL diffusion_s( i, j, sa, &
1818	surf_def_h(0)%sasws, surf_def_h(1)%sasws, &
1819	surf_def_h(2)%sasws, &
1820	surf_lsm_h%sasws, surf_usm_h%sasws, &
1821	surf_def_v(0)%sasws, surf_def_v(1)%sasws, &
1822	surf_def_v(2)%sasws, surf_def_v(3)%sasws, &
1823	surf_lsm_v(0)%sasws, surf_lsm_v(1)%sasws, &
1824	surf_lsm_v(2)%sasws, surf_lsm_v(3)%sasws, &
1825	surf_usm_v(0)%sasws, surf_usm_v(1)%sasws, &
1826	surf_usm_v(2)%sasws, surf_usm_v(3)%sasws )
1827
1828	! CALL user_actions( i, j, 'sa-tendency' ) ToDo: find general solution for dependency between modules
1829
1830	!
1831	!-- Prognostic equation for salinity
1832	DO k = nzb+1, nzt
1833
1834	sa_p(k,j,i) = sa(k,j,i) + ( dt_3d * &
1835	( tsc(2) * tend(k,j,i) + &
1836	tsc(3) * tsa_m(k,j,i) ) &
1837	- tsc(5) * rdf_sc(k) &
1838	* ( sa(k,j,i) - sa_init(k) ) &
1839	) * MERGE( 1.0_wp, 0.0_wp, &
1840	BTEST( wall_flags_total_0(k,j,i), 0 ) )
1841
1842	IF ( sa_p(k,j,i) < 0.0_wp ) sa_p(k,j,i) = 0.1_wp * sa(k,j,i)
1843
1844	ENDDO
1845
1846	!
1847	!-- Calculate tendencies for the next Runge-Kutta step
1848	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1849	IF ( intermediate_timestep_count == 1 ) THEN
1850	DO k = nzb+1, nzt
1851	tsa_m(k,j,i) = tend(k,j,i)
1852	ENDDO
1853	ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) &
1854	THEN
1855	DO k = nzb+1, nzt
1856	tsa_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
1857	5.3125_wp * tsa_m(k,j,i)
1858	ENDDO
1859	ENDIF
1860	ENDIF
1861
1862	ENDIF
1863
1864	!
1865	!-- Calculate density by the equation of state for seawater
1866	CALL eqn_state_seawater( i, j )
1867
1868	END SUBROUTINE ocean_prognostic_equations_ij
1869
1870	!------------------------------------------------------------------------------!
1871	! Description:
1872	! ------------
1873	!> Boundary conditions for ocean model
1874	!------------------------------------------------------------------------------!
1875	SUBROUTINE ocean_boundary_conditions
1876
1877	IMPLICIT NONE
1878
1879	INTEGER(iwp) :: i !< grid index x direction.
1880	INTEGER(iwp) :: j !< grid index y direction.
1881	INTEGER(iwp) :: k !< grid index z direction.
1882	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls.
1883	INTEGER(iwp) :: m !< running index surface elements.
1884
1885	!
1886	!-- Boundary conditions for salinity
1887	!-- Bottom boundary: Neumann condition because salinity flux is always
1888	!-- given.
1889	DO l = 0, 1
1890	!$OMP PARALLEL DO PRIVATE( i, j, k )
1891	DO m = 1, bc_h(l)%ns
1892	i = bc_h(l)%i(m)
1893	j = bc_h(l)%j(m)
1894	k = bc_h(l)%k(m)
1895	sa_p(k+bc_h(l)%koff,j,i) = sa_p(k,j,i)
1896	ENDDO
1897	ENDDO
1898	!
1899	!-- Top boundary: Dirichlet or Neumann
1900	IF ( ibc_sa_t == 0 ) THEN
1901	sa_p(nzt+1,:,:) = sa(nzt+1,:,:)
1902	ELSEIF ( ibc_sa_t == 1 ) THEN
1903	sa_p(nzt+1,:,:) = sa_p(nzt,:,:)
1904	ENDIF
1905
1906	END SUBROUTINE ocean_boundary_conditions
1907
1908	!------------------------------------------------------------------------------!
1909	! Description:
1910	! ------------
1911	!> Swapping of timelevels.
1912	!------------------------------------------------------------------------------!
1913	SUBROUTINE ocean_swap_timelevel( mod_count )
1914
1915	IMPLICIT NONE
1916
1917	INTEGER, INTENT(IN) :: mod_count !< flag defining where pointers point to
1918
1919
1920	SELECT CASE ( mod_count )
1921
1922	CASE ( 0 )
1923	IF ( salinity ) THEN
1924	sa => sa_1; sa_p => sa_2
1925	ENDIF
1926
1927	CASE ( 1 )
1928	IF ( salinity ) THEN
1929	sa => sa_2; sa_p => sa_1
1930	ENDIF
1931
1932	END SELECT
1933
1934	END SUBROUTINE ocean_swap_timelevel
1935
1936
1937	!------------------------------------------------------------------------------!
1938	! Description:
1939	! ------------
1940	!> This routine reads the respective restart data for the ocean module.
1941	!------------------------------------------------------------------------------!
1942	SUBROUTINE ocean_rrd_global( found )
1943
1944
1945	USE control_parameters, &
1946	ONLY: length, restart_string
1947
1948
1949	IMPLICIT NONE
1950
1951	LOGICAL, INTENT(OUT) :: found
1952
1953
1954	found = .TRUE.
1955
1956	SELECT CASE ( restart_string(1:length) )
1957
1958	CASE ( 'bc_sa_t' )
1959	READ ( 13 ) bc_sa_t
1960
1961	CASE ( 'bottom_salinityflux' )
1962	READ ( 13 ) bottom_salinityflux
1963
1964	CASE ( 'salinity' )
1965	READ ( 13 ) salinity
1966
1967	CASE ( 'sa_init' )
1968	READ ( 13 ) sa_init
1969
1970	CASE ( 'sa_surface' )
1971	READ ( 13 ) sa_surface
1972
1973	CASE ( 'sa_vertical_gradient' )
1974	READ ( 13 ) sa_vertical_gradient
1975
1976	CASE ( 'sa_vertical_gradient_level' )
1977	READ ( 13 ) sa_vertical_gradient_level
1978
1979	CASE ( 'stokes_waveheight' )
1980	READ ( 13 ) stokes_waveheight
1981
1982	CASE ( 'stokes_wavelength' )
1983	READ ( 13 ) stokes_wavelength
1984
1985	CASE ( 'surface_cooling_spinup_time' )
1986	READ ( 13 ) surface_cooling_spinup_time
1987
1988	CASE ( 'top_salinityflux' )
1989	READ ( 13 ) top_salinityflux
1990
1991	CASE ( 'wall_salinityflux' )
1992	READ ( 13 ) wall_salinityflux
1993
1994	CASE ( 'wave_breaking' )
1995	READ ( 13 ) wave_breaking
1996
1997	CASE DEFAULT
1998
1999	found = .FALSE.
2000
2001	END SELECT
2002
2003	END SUBROUTINE ocean_rrd_global
2004
2005
2006	!------------------------------------------------------------------------------!
2007	! Description:
2008	! ------------
2009	!> This routine reads the respective restart data for the ocean module.
2010	!------------------------------------------------------------------------------!
2011	SUBROUTINE ocean_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, &
2012	nxr_on_file, nynf, nync, nyn_on_file, nysf, &
2013	nysc, nys_on_file, tmp_3d, found )
2014
2015	USE averaging, &
2016	ONLY: rho_ocean_av, sa_av
2017
2018	USE control_parameters, &
2019	ONLY: length, restart_string
2020
2021	USE indices, &
2022	ONLY: nbgp, nxlg, nxrg, nyng, nysg, nzb, nzt
2023
2024	USE pegrid
2025
2026
2027	IMPLICIT NONE
2028
2029	INTEGER(iwp) :: k !<
2030	INTEGER(iwp) :: nxlc !<
2031	INTEGER(iwp) :: nxlf !<
2032	INTEGER(iwp) :: nxl_on_file !<
2033	INTEGER(iwp) :: nxrc !<
2034	INTEGER(iwp) :: nxrf !<
2035	INTEGER(iwp) :: nxr_on_file !<
2036	INTEGER(iwp) :: nync !<
2037	INTEGER(iwp) :: nynf !<
2038	INTEGER(iwp) :: nyn_on_file !<
2039	INTEGER(iwp) :: nysc !<
2040	INTEGER(iwp) :: nysf !<
2041	INTEGER(iwp) :: nys_on_file !<
2042
2043	LOGICAL, INTENT(OUT) :: found
2044
2045	REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
2046
2047
2048	found = .TRUE.
2049
2050	SELECT CASE ( restart_string(1:length) )
2051
2052	CASE ( 'rho_ocean_av' )
2053	IF ( .NOT. ALLOCATED( rho_ocean_av ) ) THEN
2054	ALLOCATE( rho_ocean_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2055	ENDIF
2056	IF ( k == 1 ) READ ( 13 ) tmp_3d
2057	rho_ocean_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2058	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2059
2060	CASE ( 'sa' )
2061	IF ( k == 1 ) READ ( 13 ) tmp_3d
2062	sa(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2063	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2064
2065	CASE ( 'sa_av' )
2066	IF ( .NOT. ALLOCATED( sa_av ) ) THEN
2067	ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2068	ENDIF
2069	IF ( k == 1 ) READ ( 13 ) tmp_3d
2070	sa_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2071	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2072
2073	CASE DEFAULT
2074	found = .FALSE.
2075
2076	END SELECT
2077
2078	END SUBROUTINE ocean_rrd_local
2079
2080
2081	!------------------------------------------------------------------------------!
2082	! Description:
2083	! ------------
2084	!> This routine writes the respective restart data for the ocean module.
2085	!------------------------------------------------------------------------------!
2086	SUBROUTINE ocean_wrd_global
2087
2088
2089	IMPLICIT NONE
2090
2091	CALL wrd_write_string( 'bc_sa_t' )
2092	WRITE ( 14 ) bc_sa_t
2093
2094	CALL wrd_write_string( 'bottom_salinityflux' )
2095	WRITE ( 14 ) bottom_salinityflux
2096
2097	CALL wrd_write_string( 'salinity' )
2098	WRITE ( 14 ) salinity
2099
2100	CALL wrd_write_string( 'sa_init' )
2101	WRITE ( 14 ) sa_init
2102
2103	CALL wrd_write_string( 'sa_surface' )
2104	WRITE ( 14 ) sa_surface
2105
2106	CALL wrd_write_string( 'sa_vertical_gradient' )
2107	WRITE ( 14 ) sa_vertical_gradient
2108
2109	CALL wrd_write_string( 'sa_vertical_gradient_level' )
2110	WRITE ( 14 ) sa_vertical_gradient_level
2111
2112	CALL wrd_write_string( 'stokes_waveheight' )
2113	WRITE ( 14 ) stokes_waveheight
2114
2115	CALL wrd_write_string( 'stokes_wavelength' )
2116	WRITE ( 14 ) stokes_wavelength
2117
2118	CALL wrd_write_string( 'surface_cooling_spinup_time' )
2119	WRITE ( 14 ) surface_cooling_spinup_time
2120
2121	CALL wrd_write_string( 'top_salinityflux' )
2122	WRITE ( 14 ) top_salinityflux
2123
2124	CALL wrd_write_string( 'wall_salinityflux' )
2125	WRITE ( 14 ) wall_salinityflux
2126
2127	CALL wrd_write_string( 'wave_breaking' )
2128	WRITE ( 14 ) wave_breaking
2129
2130	END SUBROUTINE ocean_wrd_global
2131
2132
2133	!------------------------------------------------------------------------------!
2134	! Description:
2135	! ------------
2136	!> This routine writes the respective restart data for the ocean module.
2137	!------------------------------------------------------------------------------!
2138	SUBROUTINE ocean_wrd_local
2139
2140	USE averaging, &
2141	ONLY: rho_ocean_av, sa_av
2142
2143	IMPLICIT NONE
2144
2145	IF ( ALLOCATED( rho_ocean_av ) ) THEN
2146	CALL wrd_write_string( 'rho_ocean_av' )
2147	WRITE ( 14 ) rho_ocean_av
2148	ENDIF
2149
2150	CALL wrd_write_string( 'sa' )
2151	WRITE ( 14 ) sa
2152
2153	IF ( ALLOCATED( sa_av ) ) THEN
2154	CALL wrd_write_string( 'sa_av' )
2155	WRITE ( 14 ) sa_av
2156	ENDIF
2157
2158	END SUBROUTINE ocean_wrd_local
2159
2160
2161	!------------------------------------------------------------------------------!
2162	! Description:
2163	! ------------
2164	!> This routine calculates the Craik Leibovich vortex force and the additional
2165	!> effect of the Stokes drift on the Coriolis force
2166	!> Call for all gridpoints.
2167	!------------------------------------------------------------------------------!
2168	SUBROUTINE stokes_drift_terms( component )
2169
2170	USE arrays_3d, &
2171	ONLY: ddzu, u, u_stokes_zu, u_stokes_zw, v, v_stokes_zu, &
2172	v_stokes_zw, w, tend
2173
2174	USE basic_constants_and_equations_mod, &
2175	ONLY: pi
2176
2177	USE control_parameters, &
2178	ONLY: f, fs, message_string, rotation_angle
2179
2180	USE grid_variables, &
2181	ONLY: ddx, ddy
2182
2183	USE indices, &
2184	ONLY: nxl, nxr, nys, nysv, nyn, nzb, nzt
2185
2186	IMPLICIT NONE
2187
2188	INTEGER(iwp) :: component !< component of momentum equation
2189	INTEGER(iwp) :: i !< loop index along x
2190	INTEGER(iwp) :: j !< loop index along y
2191	INTEGER(iwp) :: k !< loop index along z
2192
2193	REAL(wp) :: cos_rot_angle !< cosine of model rotation angle
2194	REAL(wp) :: sin_rot_angle !< sine of model rotation angle
2195
2196	!
2197	!-- Compute Stokes terms for the respective velocity components
2198	SELECT CASE ( component )
2199
2200	!
2201	!-- u-component
2202	CASE ( 1 )
2203	DO i = nxl, nxr
2204	DO j = nysv, nyn
2205	DO k = nzb+1, nzt
2206	tend(k,j,i) = tend(k,j,i) + v_stokes_zu(k) * ( &
2207	0.5 * ( v(k,j+1,i) - v(k,j+1,i-1) &
2208	+ v(k,j,i) - v(k,j,i-1) ) * ddx &
2209	- 0.5 * ( u(k,j+1,i) - u(k,j-1,i) ) * ddy &
2210	) &
2211	+ f * v_stokes_zu(k)
2212	ENDDO
2213	ENDDO
2214	ENDDO
2215
2216	!
2217	!-- v-component
2218	CASE ( 2 )
2219	DO i = nxl, nxr
2220	DO j = nysv, nyn
2221	DO k = nzb+1, nzt
2222	tend(k,j,i) = tend(k,j,i) - u_stokes_zu(k) * ( &
2223	0.5 * ( v(k,j,i+1) - v(k,j,i-1) ) * ddx &
2224	- 0.5 * ( u(k,j,i) - u(k,j-1,i) &
2225	+ u(k,j,i+1) - u(k,j-1,i+1) ) * ddy &
2226	) &
2227	- f * u_stokes_zu(k)
2228	ENDDO
2229	ENDDO
2230	ENDDO
2231
2232	!
2233	!-- w-component
2234	CASE ( 3 )
2235
2236	!
2237	!-- Precalculate cosine and sine of rotation angle
2238	cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
2239	sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
2240
2241	DO i = nxl, nxr
2242	DO j = nys, nyn
2243	DO k = nzb+1, nzt
2244	tend(k,j,i) = tend(k,j,i) + u_stokes_zw(k) * ( &
2245	0.5 * ( u(k+1,j,i) - u(k,j,i) &
2246	+ u(k+1,j,i+1) - u(k,j,i+1) &
2247	) * ddzu(k+1) &
2248	- 0.5 * ( w(k,j,i+1) - w(k,j,i-1) &
2249	) * ddx ) &
2250	- v_stokes_zw(k) * ( &
2251	0.5 * ( w(k,j+1,i) - w(k,j-1,i) &
2252	) * ddy &
2253	- 0.5 * ( v(k+1,j,i) - v(k,j,i) &
2254	+ v(k+1,j+1,i) - v(k,j+1,i) &
2255	) * ddzu(k) ) &
2256	+ fs * ( &
2257	sin_rot_angle * v_stokes_zw(k) &
2258	+ cos_rot_angle * u_stokes_zw(k) &
2259	)
2260	ENDDO
2261	ENDDO
2262	ENDDO
2263
2264	CASE DEFAULT
2265	WRITE( message_string, * ) 'wrong component of Stokes force: ', &
2266	component
2267	CALL message( 'stokes_drift_terms', 'PA0091', 1, 2, 0, 6, 0 )
2268
2269	END SELECT
2270
2271	END SUBROUTINE stokes_drift_terms
2272
2273
2274	!------------------------------------------------------------------------------!
2275	! Description:
2276	! ------------
2277	!> This routine calculates the Craik Leibovich vortex force and the additional
2278	!> effect of the Stokes drift on the Coriolis force
2279	!> Call for gridpoints i,j.
2280	!------------------------------------------------------------------------------!
2281
2282	SUBROUTINE stokes_drift_terms_ij( i, j, component )
2283
2284	USE arrays_3d, &
2285	ONLY: ddzu, u, u_stokes_zu, u_stokes_zw, v, v_stokes_zu, &
2286	v_stokes_zw, w, tend
2287
2288	USE basic_constants_and_equations_mod, &
2289	ONLY: pi
2290
2291	USE control_parameters, &
2292	ONLY: f, fs, message_string, rotation_angle
2293
2294	USE grid_variables, &
2295	ONLY: ddx, ddy
2296
2297	USE indices, &
2298	ONLY: nzb, nzt
2299
2300	IMPLICIT NONE
2301
2302	INTEGER(iwp) :: component !< component of momentum equation
2303	INTEGER(iwp) :: i !< loop index along x
2304	INTEGER(iwp) :: j !< loop index along y
2305	INTEGER(iwp) :: k !< loop incex along z
2306
2307	REAL(wp) :: cos_rot_angle !< cosine of model rotation angle
2308	REAL(wp) :: sin_rot_angle !< sine of model rotation angle
2309
2310	!
2311	!-- Compute Stokes terms for the respective velocity components
2312	SELECT CASE ( component )
2313
2314	!
2315	!-- u-component
2316	CASE ( 1 )
2317	DO k = nzb+1, nzt
2318	tend(k,j,i) = tend(k,j,i) + v_stokes_zu(k) * ( &
2319	0.5 * ( v(k,j+1,i) - v(k,j+1,i-1) &
2320	+ v(k,j,i) - v(k,j,i-1) ) * ddx &
2321	- 0.5 * ( u(k,j+1,i) - u(k,j-1,i) ) * ddy &
2322	) &
2323	+ f * v_stokes_zu(k)
2324	ENDDO
2325	!
2326	!-- v-component
2327	CASE ( 2 )
2328	DO k = nzb+1, nzt
2329	tend(k,j,i) = tend(k,j,i) - u_stokes_zu(k) * ( &
2330	0.5 * ( v(k,j,i+1) - v(k,j,i-1) ) * ddx &
2331	- 0.5 * ( u(k,j,i) - u(k,j-1,i) &
2332	+ u(k,j,i+1) - u(k,j-1,i+1) ) * ddy &
2333	) &
2334	- f * u_stokes_zu(k)
2335	ENDDO
2336
2337	!
2338	!-- w-component
2339	CASE ( 3 )
2340
2341	!
2342	!-- Precalculate cosine and sine of rotation angle
2343	cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
2344	sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
2345
2346	DO k = nzb+1, nzt
2347	tend(k,j,i) = tend(k,j,i) + u_stokes_zw(k) * ( &
2348	0.5 * ( u(k+1,j,i) - u(k,j,i) &
2349	+ u(k+1,j,i+1) - u(k,j,i+1) &
2350	) * ddzu(k+1) &
2351	- 0.5 * ( w(k,j,i+1) - w(k,j,i-1) &
2352	) * ddx ) &
2353	- v_stokes_zw(k) * ( &
2354	0.5 * ( w(k,j+1,i) - w(k,j-1,i) &
2355	) * ddy &
2356	- 0.5 * ( v(k+1,j,i) - v(k,j,i) &
2357	+ v(k+1,j+1,i) - v(k,j+1,i) &
2358	) * ddzu(k) ) &
2359	+ fs * ( sin_rot_angle * v_stokes_zw(k) &
2360	+ cos_rot_angle * u_stokes_zw(k) &
2361	)
2362	ENDDO
2363
2364	CASE DEFAULT
2365	WRITE( message_string, * ) ' wrong component: ', component
2366	CALL message( 'stokes_drift_terms', 'PA0091', 1, 2, 0, 6, 0 )
2367
2368	END SELECT
2369
2370	END SUBROUTINE stokes_drift_terms_ij
2371
2372
2373	!------------------------------------------------------------------------------!
2374	! Description:
2375	! ------------
2376	!> This routine calculates turbulence generated by wave breaking near the ocean
2377	!> surface, following a parameterization given in Noh et al. (2004), JPO
2378	!> Call for all gridpoints.
2379	!> TODO: so far, this routine only works if the model time step has about the
2380	!> same value as the time scale of wave breaking!
2381	!------------------------------------------------------------------------------!
2382	SUBROUTINE wave_breaking_term( component )
2383
2384	USE arrays_3d, &
2385	ONLY: u_p, v_p
2386
2387	USE control_parameters, &
2388	ONLY: dt_3d, message_string
2389
2390	USE indices, &
2391	ONLY: nxl, nxlu, nxr, nys, nysv, nyn, nzt
2392
2393	IMPLICIT NONE
2394
2395	INTEGER(iwp) :: component !< component of momentum equation
2396	INTEGER(iwp) :: i !< loop index along x
2397	INTEGER(iwp) :: j !< loop index along y
2398
2399	REAL(wp) :: random_gauss !< function that creates a random number with a
2400	!< Gaussian distribution
2401
2402
2403	!
2404	!-- Compute wave breaking terms for the respective velocity components.
2405	!-- Velocities are directly manipulated, since this is not a real force
2406	SELECT CASE ( component )
2407
2408	!
2409	!-- u-component
2410	CASE ( 1 )
2411	DO i = nxlu, nxr
2412	DO j = nys, nyn
2413	u_p(nzt,j,i) = u_p(nzt,j,i) + &
2414	( random_gauss( iran_ocean, 1.0_wp ) - 1.0_wp ) &
2415	* alpha_wave_breaking * u_star_wave_breaking &
2416	/ timescale_wave_breaking * dt_3d
2417	ENDDO
2418	ENDDO
2419	!
2420	!-- v-component
2421	CASE ( 2 )
2422	DO i = nxl, nxr
2423	DO j = nysv, nyn
2424	v_p(nzt,j,i) = v_p(nzt,j,i) + &
2425	( random_gauss( iran_ocean, 1.0_wp ) - 1.0_wp ) &
2426	* alpha_wave_breaking * u_star_wave_breaking &
2427	/ timescale_wave_breaking * dt_3d
2428	ENDDO
2429	ENDDO
2430
2431	CASE DEFAULT
2432	WRITE( message_string, * ) 'wrong component of wave breaking: ', &
2433	component
2434	CALL message( 'stokes_drift_terms', 'PA0466', 1, 2, 0, 6, 0 )
2435
2436	END SELECT
2437
2438	END SUBROUTINE wave_breaking_term
2439
2440
2441	!------------------------------------------------------------------------------!
2442	! Description:
2443	! ------------
2444	!> This routine calculates turbulence generated by wave breaking near the ocean
2445	!> surface, following a parameterization given in Noh et al. (2004), JPO
2446	!> Call for gridpoint i,j.
2447	!> TODO: so far, this routine only works if the model time step has about the
2448	!> same value as the time scale of wave breaking!
2449	!------------------------------------------------------------------------------!
2450	SUBROUTINE wave_breaking_term_ij( i, j, component )
2451
2452	USE arrays_3d, &
2453	ONLY: u_p, v_p
2454
2455	USE control_parameters, &
2456	ONLY: dt_3d, message_string
2457
2458	USE indices, &
2459	ONLY: nzt
2460
2461	IMPLICIT NONE
2462
2463	INTEGER(iwp) :: component !< component of momentum equation
2464	INTEGER(iwp) :: i !< loop index along x
2465	INTEGER(iwp) :: j !< loop index along y
2466
2467	REAL(wp) :: random_gauss !< function that creates a random number with a
2468	!< Gaussian distribution
2469
2470	!
2471	!-- Compute wave breaking terms for the respective velocity components
2472	SELECT CASE ( component )
2473
2474	!
2475	!-- u-/v-component
2476	CASE ( 1 )
2477	u_p(nzt,j,i) = u_p(nzt,j,i) + &
2478	( random_gauss( iran_ocean, 1.0_wp ) - 1.0_wp ) &
2479	* alpha_wave_breaking * u_star_wave_breaking &
2480	/ timescale_wave_breaking * dt_3d
2481
2482	CASE ( 2 )
2483	v_p(nzt,j,i) = v_p(nzt,j,i) + &
2484	( random_gauss( iran_ocean, 1.0_wp ) - 1.0_wp ) &
2485	* alpha_wave_breaking * u_star_wave_breaking &
2486	/ timescale_wave_breaking * dt_3d
2487
2488	CASE DEFAULT
2489	WRITE( message_string, * ) 'wrong component of wave breaking: ', &
2490	component
2491	CALL message( 'stokes_drift_terms', 'PA0466', 1, 2, 0, 6, 0 )
2492
2493	END SELECT
2494
2495	END SUBROUTINE wave_breaking_term_ij
2496
2497
2498	END MODULE ocean_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |