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

Last change on this file since 224 was 206, checked in by raasch, 16 years ago

ocean-atmosphere coupling realized with MPI-1, adjustments in mrun, mbuild, subjob for lcxt4

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