source: palm/trunk/SOURCE/surface_coupler.f90 @ 231

Last change on this file since 231 was 226, checked in by raasch, 16 years ago

preparations for the next release

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