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

Last change on this file since 274 was 274, checked in by heinze, 15 years ago

Indentation of the message calls corrected

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