source: palm/tags/release-3.4a/SOURCE/surface_coupler.f90 @ 3988

Last change on this file since 3988 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: 6.8 KB
Line 
1 SUBROUTINE surface_coupler
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! ------------------
10! $Id: surface_coupler.f90 110 2007-10-05 05:13:14Z kanani $
11!
12! 109 2007-08-28 15:26:47Z letzel
13! Initial revision
14!
15! Description:
16! ------------
17! Data exchange at the interface between coupled models
18!------------------------------------------------------------------------------!
19
20    USE arrays_3d
21    USE control_parameters
22    USE cpulog
23    USE grid_variables
24    USE indices
25    USE interfaces
26    USE pegrid
27
28    IMPLICIT NONE
29
30    INTEGER ::  i, j, k
31
32    REAL    ::  simulated_time_remote
33
34#if defined( __parallel )  &&  defined( __mpi2 )
35
36    CALL cpu_log( log_point(39), 'surface_coupler', 'start' )
37
38!
39!-- In case of model termination initiated by the remote model
40!-- (terminate_coupled_remote > 0), initiate termination of the local model.
41!-- The rest of the coupler must then be skipped because it would cause an MPI
42!-- intercomminucation hang.
43!-- If necessary, the coupler will be called at the beginning of the next
44!-- restart run.
45    CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER, myid,  0, &
46                       terminate_coupled_remote, 1, MPI_INTEGER, myid,  0, &
47                       comm_inter, status, ierr )
48    IF ( terminate_coupled_remote > 0 )  THEN
49       IF ( myid == 0 )  THEN
50          PRINT*, '+++ surface_coupler:'
51          PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
52               '" terminated'
53          PRINT*, '    with terminate_coupled_remote = ', &
54               terminate_coupled_remote
55          PRINT*, '    local model  "', TRIM( coupling_mode ), &
56               '" has'
57          PRINT*, '    terminate_coupled = ', &
58               terminate_coupled
59       ENDIF
60       CALL local_stop
61       RETURN
62    ENDIF
63!
64!-- Exchange the current simulated time between the models,
65!-- currently just for testing
66    CALL MPI_SEND( simulated_time, 1, MPI_REAL, myid, 11, comm_inter, ierr )
67    CALL MPI_RECV( simulated_time_remote, 1, MPI_REAL, myid, 11, &
68                   comm_inter, status, ierr )
69    WRITE ( 9, * )  simulated_time, ' remote: ', simulated_time_remote
70    CALL local_flush( 9 )
71
72!
73!-- Exchange the interface data
74    IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
75
76!
77!--    Send heat flux at bottom surface to the ocean model
78       WRITE ( 9, * )  '*** send shf to ocean'
79       CALL local_flush( 9 )
80       CALL MPI_SEND( shf(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, &
81                      comm_inter, ierr )
82       WRITE ( 9, * )  '    ready'
83       CALL local_flush( 9 )
84
85!
86!--    Send humidity flux at bottom surface to the ocean model
87       IF ( humidity )  THEN
88          WRITE ( 9, * )  '*** send qsws to ocean'
89          CALL local_flush( 9 )
90          CALL MPI_SEND( qsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 13, &
91               comm_inter, ierr )
92          WRITE ( 9, * )  '    ready'
93          CALL local_flush( 9 )
94       ENDIF
95
96!
97!--    Receive temperature at the bottom surface from the ocean model
98       WRITE ( 9, * )  '*** receive pt from ocean'
99       CALL local_flush( 9 )
100       CALL MPI_RECV( pt(0,nys-1,nxl-1), 1, type_xy, myid, 14, comm_inter, &
101                      status, ierr )
102       WRITE ( 9, * )  '    ready'
103       CALL local_flush( 9 )
104
105!
106!--    Send the momentum flux (u) at bottom surface to the ocean model
107       WRITE ( 9, * )  '*** send usws to ocean'
108       CALL local_flush( 9 )
109       CALL MPI_SEND( usws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, &
110                      comm_inter, ierr )
111       WRITE ( 9, * )  '    ready'
112       CALL local_flush( 9 )
113
114!
115!--    Send the momentum flux (v) at bottom surface to the ocean model
116       WRITE ( 9, * )  '*** send vsws to ocean'
117       CALL local_flush( 9 )
118       CALL MPI_SEND( vsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 16, &
119                      comm_inter, ierr )
120       WRITE ( 9, * )  '    ready'
121       CALL local_flush( 9 )
122
123    ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
124
125!
126!--    Receive heat flux at the sea surface (top) from the atmosphere model
127       WRITE ( 9, * )  '*** receive tswst from atmosphere'
128       CALL local_flush( 9 )
129       CALL MPI_RECV( tswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, &
130                      comm_inter, status, ierr )
131       WRITE ( 9, * )  '    ready'
132       CALL local_flush( 9 )
133
134!
135!--    Receive humidity flux from the atmosphere model (bottom)
136!--    and add it to the heat flux at the sea surface (top)...
137       IF ( humidity_remote )  THEN
138          WRITE ( 9, * )  '*** receive qswst_remote from atmosphere'
139          CALL local_flush( 9 )
140          CALL MPI_RECV( qswst_remote(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, &
141               13, comm_inter, status, ierr )
142          WRITE ( 9, * )  '    ready'
143          CALL local_flush( 9 )
144
145          !here tswst is still the sum of atmospheric bottom heat fluxes
146          tswst = tswst + qswst_remote * 2.2626108e6 / 1005.0
147          !*latent heat of vaporization in m2/s2, or 540 cal/g, or 40.65 kJ/mol
148          !/(rho_atm(=1.0)*c_p)
149!
150!--    ...and convert it to a salinity flux at the sea surface (top)
151!--       following Steinhorn (1991), JPO 21, pp. 1681-1683:
152!--       S'w' = -S * evaporation / ( rho_water * ( 1 - S ) )
153          saswst = -1.0 * sa(nzt,:,:) * qswst_remote /  &
154               ( rho(nzt,:,:) * ( 1.0 - sa(nzt,:,:) ) )
155       ENDIF
156
157!
158!--    Adjust the kinematic heat flux with respect to ocean density
159!--    (constants are the specific heat capacities for air and water)
160       !now tswst is the ocean top heat flux
161       tswst = tswst / rho(nzt,:,:) * 1005.0 / 4218.0
162
163!
164!--    Send sea surface temperature to the atmosphere model
165       WRITE ( 9, * )  '*** send pt to atmosphere'
166       CALL local_flush( 9 )
167       CALL MPI_SEND( pt(nzt,nys-1,nxl-1), 1, type_xy, myid, 14, comm_inter, &
168                      ierr )
169       WRITE ( 9, * )  '    ready'
170       CALL local_flush( 9 )
171
172!
173!--    Receive momentum flux (u) at the sea surface (top) from the atmosphere
174!--    model
175       WRITE ( 9, * )  '*** receive uswst from atmosphere'
176       CALL local_flush( 9 )
177       CALL MPI_RECV( uswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, &
178                      comm_inter, status, ierr )
179       WRITE ( 9, * )  '    ready'
180       CALL local_flush( 9 )
181
182!
183!--    Receive momentum flux (v) at the sea surface (top) from the atmosphere
184!--    model
185       WRITE ( 9, * )  '*** receive vswst from atmosphere'
186       CALL local_flush( 9 )
187       CALL MPI_RECV( vswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 16, &
188                      comm_inter, status, ierr )
189       WRITE ( 9, * )  '    ready'
190       CALL local_flush( 9 )
191
192!
193!--    Adjust the momentum fluxes with respect to ocean density
194       uswst = uswst / rho(nzt,:,:)
195       vswst = vswst / rho(nzt,:,:)
196
197    ENDIF
198
199    CALL cpu_log( log_point(39), 'surface_coupler', 'stop' )
200
201#endif
202
203 END SUBROUTINE surface_coupler
Note: See TracBrowser for help on using the repository browser.