Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |