source: palm/tags/release-3.6/SOURCE/advec_v_up.f90 @ 2977

Last change on this file since 2977 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: 4.7 KB
Line 
1 MODULE advec_v_up_mod
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: advec_v_up.f90 110 2007-10-05 05:13:14Z kanani $
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.12  2006/02/23 09:46:37  raasch
21! nzb_2d replaced by nzb_v_inner
22!
23! Revision 1.1  1997/08/29 08:56:05  raasch
24! Initial revision
25!
26!
27! Description:
28! ------------
29! Advection term for the v velocity-component using upstream scheme.
30! NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
31!       The same problem occurs for all topography boundaries!
32!------------------------------------------------------------------------------!
33
34    PRIVATE
35    PUBLIC advec_v_up
36
37    INTERFACE advec_v_up
38       MODULE PROCEDURE advec_v_up
39       MODULE PROCEDURE advec_v_up_ij
40    END INTERFACE advec_v_up
41
42 CONTAINS
43
44
45!------------------------------------------------------------------------------!
46! Call for all grid points
47!------------------------------------------------------------------------------!
48    SUBROUTINE advec_v_up
49
50       USE arrays_3d
51       USE control_parameters
52       USE grid_variables
53       USE indices
54
55       IMPLICIT NONE
56
57       INTEGER ::  i, j, k
58       REAL    ::  ukomp, vkomp, wkomp
59
60
61       DO  i = nxl, nxr
62          DO  j = nysv, nyn
63             DO  k = nzb_v_inner(j,i)+1, nzt
64!
65!--             x-direction
66                ukomp = 0.25 * ( u(k,j,i)   + u(k,j-1,i) + &
67                                 u(k,j,i+1) + u(k,j-1,i+1) ) - u_gtrans
68                IF ( ukomp > 0.0 )  THEN
69                   tend(k,j,i) = tend(k,j,i) - ukomp * &
70                                         ( v(k,j,i) - v(k,j,i-1) ) * ddx
71                ELSE
72                   tend(k,j,i) = tend(k,j,i) - ukomp * &
73                                         ( v(k,j,i+1) - v(k,j,i) ) * ddx
74                ENDIF
75!
76!--             y-direction
77                vkomp = v(k,j,i) - v_gtrans
78                IF ( vkomp > 0.0 )  THEN
79                   tend(k,j,i) = tend(k,j,i) - vkomp * &
80                                         ( v(k,j,i) - v(k,j-1,i) ) * ddy
81                ELSE
82                   tend(k,j,i) = tend(k,j,i) - vkomp * &
83                                         ( v(k,j+1,i) - v(k,j,i) ) * ddy
84                ENDIF
85!
86!--             z-direction
87                wkomp = 0.25 * ( w(k,j,i)  + w(k-1,j,i) + &
88                                 w(k,j-1,i) + w(k-1,j-1,i) )
89                IF ( wkomp > 0.0 )  THEN
90                   tend(k,j,i) = tend(k,j,i) - wkomp * &
91                                         ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
92                ELSE
93                   tend(k,j,i) = tend(k,j,i) - wkomp * &
94                                         ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
95                ENDIF
96
97             ENDDO
98          ENDDO
99       ENDDO
100
101    END SUBROUTINE advec_v_up
102
103
104!------------------------------------------------------------------------------!
105! Call for grid point i,j
106!------------------------------------------------------------------------------!
107    SUBROUTINE advec_v_up_ij( i, j )
108
109       USE arrays_3d
110       USE control_parameters
111       USE grid_variables
112       USE indices
113
114       IMPLICIT NONE
115
116       INTEGER ::  i, j, k
117
118       REAL ::  ukomp, vkomp, wkomp
119
120
121       DO  k = nzb_v_inner(j,i)+1, nzt
122!
123!--       x-direction
124          ukomp = 0.25 * ( u(k,j,i) + u(k,j-1,i) + u(k,j,i+1) + u(k,j-1,i+1) &
125                         ) - u_gtrans
126          IF ( ukomp > 0.0 )  THEN
127             tend(k,j,i) = tend(k,j,i) - ukomp * &
128                                         ( v(k,j,i) - v(k,j,i-1) ) * ddx
129          ELSE
130             tend(k,j,i) = tend(k,j,i) - ukomp * &
131                                         ( v(k,j,i+1) - v(k,j,i) ) * ddx
132          ENDIF
133!
134!--       y-direction
135          vkomp = v(k,j,i) - v_gtrans
136          IF ( vkomp > 0.0 )  THEN
137             tend(k,j,i) = tend(k,j,i) - vkomp * &
138                                         ( v(k,j,i) - v(k,j-1,i) ) * ddy
139          ELSE
140             tend(k,j,i) = tend(k,j,i) - vkomp * &
141                                         ( v(k,j+1,i) - v(k,j,i) ) * ddy
142          ENDIF
143!
144!--       z-direction
145          wkomp = 0.25 * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) )
146          IF ( wkomp > 0.0 )  THEN
147             tend(k,j,i) = tend(k,j,i) - wkomp * &
148                                         ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
149          ELSE
150             tend(k,j,i) = tend(k,j,i) - wkomp * &
151                                         ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
152          ENDIF
153
154       ENDDO
155
156    END SUBROUTINE advec_v_up_ij
157
158 END MODULE advec_v_up_mod
Note: See TracBrowser for help on using the repository browser.