source: palm/tags/release-3.4/SOURCE/coriolis.f90 @ 3979

Last change on this file since 3979 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: 5.1 KB
Line 
1 MODULE coriolis_mod
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: coriolis.f90 110 2007-10-05 05:13:14Z hellstea $
11!
12! 106 2007-08-16 14:30:26Z raasch
13! loops for u and v are starting from index nxlu, nysv, respectively (needed
14! for non-cyclic boundary conditions)
15!
16! 75 2007-03-22 09:54:05Z raasch
17! uxrp, vynp eliminated
18!
19! RCS Log replace by Id keyword, revision history cleaned up
20!
21! Revision 1.12  2006/02/23 10:08:57  raasch
22! nzb_2d replaced by nzb_u/v/w_inner
23!
24! Revision 1.1  1997/08/29 08:57:38  raasch
25! Initial revision
26!
27!
28! Description:
29! ------------
30! Computation of all Coriolis terms in the equations of motion.
31!------------------------------------------------------------------------------!
32
33    PRIVATE
34    PUBLIC coriolis
35
36    INTERFACE coriolis
37       MODULE PROCEDURE coriolis
38       MODULE PROCEDURE coriolis_ij
39    END INTERFACE coriolis
40
41 CONTAINS
42
43
44!------------------------------------------------------------------------------!
45! Call for all grid points
46!------------------------------------------------------------------------------!
47    SUBROUTINE coriolis( component )
48
49       USE arrays_3d
50       USE control_parameters
51       USE indices
52       USE pegrid
53
54       IMPLICIT NONE
55
56       INTEGER ::  component, i, j, k
57
58
59!
60!--    Compute Coriolis terms for the three velocity components
61       SELECT CASE ( component )
62
63!
64!--       u-component
65          CASE ( 1 )
66             DO  i = nxlu, nxr
67                DO  j = nys, nyn
68                   DO  k = nzb_u_inner(j,i)+1, nzt
69                      tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *            &
70                                   ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +   &
71                                     v(k,j+1,i) ) - vg(k) )                   &
72                                             - fs *    ( 0.25 *               &
73                                   ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
74                                     w(k,j,i)   ) &
75                                                          )
76                   ENDDO
77                ENDDO
78             ENDDO
79
80!
81!--       v-component
82          CASE ( 2 )
83             DO  i = nxl, nxr
84                DO  j = nysv, nyn
85                   DO  k = nzb_v_inner(j,i)+1, nzt
86                      tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *          &
87                                   ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
88                                     u(k,j,i+1) ) - ug(k) )
89                   ENDDO
90                ENDDO
91             ENDDO
92
93!
94!--       w-component
95          CASE ( 3 )
96             DO  i = nxl, nxr
97                DO  j = nys, nyn
98                   DO  k = nzb_w_inner(j,i)+1, nzt
99                      tend(k,j,i) = tend(k,j,i) + fs * 0.25 *             &
100                                   ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
101                                     u(k+1,j,i+1) )
102                   ENDDO
103                ENDDO
104             ENDDO
105
106          CASE DEFAULT
107
108             IF ( myid == 0 )  PRINT*,'+++ coriolis:  wrong component: ', &
109                                      component
110             CALL local_stop
111
112       END SELECT
113
114    END SUBROUTINE coriolis
115
116
117!------------------------------------------------------------------------------!
118! Call for grid point i,j
119!------------------------------------------------------------------------------!
120    SUBROUTINE coriolis_ij( i, j, component )
121
122       USE arrays_3d
123       USE control_parameters
124       USE indices
125       USE pegrid
126
127       IMPLICIT NONE
128
129       INTEGER ::  component, i, j, k
130
131!
132!--    Compute Coriolis terms for the three velocity components
133       SELECT CASE ( component )
134
135!
136!--       u-component
137          CASE ( 1 )
138             DO  k = nzb_u_inner(j,i)+1, nzt
139                tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *               &
140                                ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +   &
141                                  v(k,j+1,i) ) - vg(k) )                   &
142                                          - fs *    ( 0.25 *               &
143                                ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
144                                  w(k,j,i)   ) &
145                                                    )
146             ENDDO
147
148!
149!--       v-component
150          CASE ( 2 )
151             DO  k = nzb_v_inner(j,i)+1, nzt
152                tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *             &
153                                ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
154                                  u(k,j,i+1) ) - ug(k) )
155             ENDDO
156
157!
158!--       w-component
159          CASE ( 3 )
160             DO  k = nzb_w_inner(j,i)+1, nzt
161                tend(k,j,i) = tend(k,j,i) + fs * 0.25 * &
162                                ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
163                                  u(k+1,j,i+1) )
164             ENDDO
165
166          CASE DEFAULT
167
168             IF ( myid == 0 )  PRINT*,'+++ coriolis:  wrong component: ', &
169                                      component
170             CALL local_stop
171
172       END SELECT
173
174    END SUBROUTINE coriolis_ij
175
176 END MODULE coriolis_mod
Note: See TracBrowser for help on using the repository browser.