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

Last change on this file since 291 was 291, checked in by raasch, 12 years ago

changes for coupling with independent precursor runs; z_i calculation with Sullivan criterion

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