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

Last change on this file since 3679 was 3636, checked in by raasch, 6 years ago

nopointer option removed

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