source: palm/tags/release-3.7/SOURCE/advec_v_pw.f90 @ 3806

Last change on this file since 3806 was 110, checked in by raasch, 16 years ago

New:
---
Allows runs for a coupled atmosphere-ocean LES,
coupling frequency is controlled by new d3par-parameter dt_coupling,
the coupling mode (atmosphere_to_ocean or ocean_to_atmosphere) for the
respective processes is read from environment variable coupling_mode,
which is set by the mpiexec-command,
communication between the two models is done using the intercommunicator
comm_inter,
local files opened by the ocean model get the additional suffic "_O".
Assume saturation at k=nzb_s_inner(j,i) for atmosphere coupled to ocean.

A momentum flux can be set as top boundary condition using the new
inipar parameter top_momentumflux_u|v.

Non-cyclic boundary conditions can be used along all horizontal directions.

Quantities w*p* and w"e can be output as vertical profiles.

Initial profiles are reset to constant profiles in case that initializing_actions /= 'set_constant_profiles'. (init_rankine)

Optionally calculate km and kh from initial TKE e_init.

Changed:


Remaining variables iran changed to iran_part (advec_particles, init_particles).

In case that the presure solver is not called for every Runge-Kutta substep
(call_psolver_at_all_substeps = .F.), it is called after the first substep
instead of the last. In that case, random perturbations are also added to the
velocity field after the first substep.

Initialization of km,kh = 0.00001 for ocean = .T. (for ocean = .F. it remains 0.01).

Allow data_output_pr= q, wq, w"q", w*q* for humidity = .T. (instead of cloud_physics = .T.).

Errors:


Bugs from code parts for non-cyclic boundary conditions are removed: loops for
u and v are starting from index nxlu, nysv, respectively. The radiation boundary
condition is used for every Runge-Kutta substep. Velocity phase speeds for
the radiation boundary conditions are calculated for the first Runge-Kutta
substep only and reused for the further substeps. New arrays c_u, c_v, and c_w
are defined for this purpose. Several index errors are removed from the
radiation boundary condition code parts. Upper bounds for calculating
u_0 and v_0 (in production_e) are nxr+1 and nyn+1 because otherwise these
values are not available in case of non-cyclic boundary conditions.

+dots_num_palm in module user, +module netcdf_control in user_init (both in user_interface)

Bugfix: wrong sign removed from the buoyancy production term in the case use_reference = .T. (production_e)

Bugfix: Error message concerning output of particle concentration (pc) modified (check_parameters).

Bugfix: Rayleigh damping for ocean fixed.

  • Property svn:keywords set to Id
File size: 3.6 KB
Line 
1 MODULE advec_v_pw_mod
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: advec_v_pw.f90 110 2007-10-05 05:13:14Z raasch $
11!
12! 106 2007-08-16 14:30:26Z raasch
13! j loop is starting from nysv (needed for non-cyclic boundary conditions)
14!
15! 75 2007-03-22 09:54:05Z raasch
16! vynp eliminated
17!
18! RCS Log replace by Id keyword, revision history cleaned up
19!
20! Revision 1.15  2006/02/23 09:46:08  raasch
21! nzb_2d replaced by nzb_v_inner
22!
23! Revision 1.1  1997/08/11 06:09:57  raasch
24! Initial revision
25!
26!
27! Description:
28! ------------
29! Advection term for v velocity-component using Piacsek and Williams.
30! Vertical advection at the first grid point above the surface is done with
31! normal centred differences, because otherwise no information from the surface
32! would be communicated upwards due to w=0 at K=nzb.
33!------------------------------------------------------------------------------!
34
35    PRIVATE
36    PUBLIC advec_v_pw
37
38    INTERFACE advec_v_pw
39       MODULE PROCEDURE advec_v_pw
40       MODULE PROCEDURE advec_v_pw_ij
41    END INTERFACE advec_v_pw
42 
43 CONTAINS
44
45
46!------------------------------------------------------------------------------!
47! Call for all grid points
48!------------------------------------------------------------------------------!
49    SUBROUTINE advec_v_pw
50
51       USE arrays_3d
52       USE control_parameters
53       USE grid_variables
54       USE indices
55
56       IMPLICIT NONE
57
58       INTEGER ::  i, j, k
59       REAL    ::  gu, gv
60 
61
62       gu = 2.0 * u_gtrans
63       gv = 2.0 * v_gtrans
64       DO  i = nxl, nxr
65          DO  j = nysv, nyn
66             DO  k = nzb_v_inner(j,i)+1, nzt
67                tend(k,j,i) = tend(k,j,i) - 0.25 * (                           &
68                         ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu )     &
69                         - v(k,j,i-1) * ( u(k,j-1,i) + u(k,j,i) - gu ) ) * ddx &
70                       + ( v(k,j+1,i) * ( v(k,j+1,i) + v(k,j,i) - gv )         &
71                         - v(k,j-1,i) * ( v(k,j,i) + v(k,j-1,i) - gv ) ) * ddy &
72                       + ( v(k+1,j,i) * ( w(k,j-1,i) + w(k,j,i) )              &
73                         - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) )        &
74                                                                  * ddzw(k)    &
75                                                   )
76             ENDDO
77          ENDDO
78       ENDDO
79
80    END SUBROUTINE advec_v_pw
81
82
83!------------------------------------------------------------------------------!
84! Call for grid point i,j
85!------------------------------------------------------------------------------!
86    SUBROUTINE advec_v_pw_ij( i, j )
87
88       USE arrays_3d
89       USE control_parameters
90       USE grid_variables
91       USE indices
92
93       IMPLICIT NONE
94
95       INTEGER ::  i, j, k
96       REAL    ::  gu, gv
97
98
99       gu = 2.0 * u_gtrans
100       gv = 2.0 * v_gtrans
101       DO  k = nzb_v_inner(j,i)+1, nzt
102          tend(k,j,i) = tend(k,j,i) - 0.25 * (                              &
103                         ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu )     &
104                         - v(k,j,i-1) * ( u(k,j-1,i) + u(k,j,i) - gu ) ) * ddx &
105                       + ( v(k,j+1,i) * ( v(k,j+1,i) + v(k,j,i) - gv )         &
106                         - v(k,j-1,i) * ( v(k,j,i) + v(k,j-1,i) - gv ) ) * ddy &
107                       + ( v(k+1,j,i) * ( w(k,j-1,i) + w(k,j,i) )              &
108                         - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) )        &
109                                                                  * ddzw(k)    &
110                                             )
111       ENDDO
112 
113    END SUBROUTINE advec_v_pw_ij
114
115 END MODULE advec_v_pw_mod
116 
Note: See TracBrowser for help on using the repository browser.