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

Last change on this file since 108 was 108, checked in by letzel, 14 years ago
  • Improved coupler: evaporation - salinity-flux coupling for humidity = .T.,

avoid MPI hangs when coupled runs terminate, add DOC/app/chapter_3.8;

  • Optional calculation of km and kh from initial TKE e_init;
  • Default initialization of km,kh = 0.00001 for ocean = .T.;
  • Allow data_output_pr= q, wq, w"q", w*q* for humidity = .T.;
  • Bugfix: Rayleigh damping for ocean fixed.
  • Property svn:keywords set to Id
File size: 6.7 KB
Line 
1 SUBROUTINE surface_coupler
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! include latent heatflux and salinity flux for atmosphere runs with moisture
7! modifications to terminate coupled runs
8!
9!
10! Former revisions:
11! ------------------
12! $Id: surface_coupler.f90 108 2007-08-24 15:10:38Z letzel $
13!
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 )  &&  defined( __mpi2 )
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, myid,  0, &
47                       terminate_coupled_remote, 1, MPI_INTEGER, myid,  0, &
48                       comm_inter, status, ierr )
49    IF ( terminate_coupled_remote > 0 )  THEN
50       IF ( myid == 0 )  THEN
51          PRINT*, '+++ surface_coupler:'
52          PRINT*, '    remote model "', TRIM( coupling_mode_remote ), &
53               '" terminated'
54          PRINT*, '    with terminate_coupled_remote = ', &
55               terminate_coupled_remote
56          PRINT*, '    local model  "', TRIM( coupling_mode ), &
57               '" has'
58          PRINT*, '    terminate_coupled = ', &
59               terminate_coupled
60       ENDIF
61       CALL local_stop
62       RETURN
63    ENDIF
64!
65!-- Exchange the current simulated time between the models,
66!-- currently just for testing
67    CALL MPI_SEND( simulated_time, 1, MPI_REAL, myid, 11, comm_inter, ierr )
68    CALL MPI_RECV( simulated_time_remote, 1, MPI_REAL, myid, 11, &
69                   comm_inter, status, ierr )
70    WRITE ( 9, * )  simulated_time, ' remote: ', simulated_time_remote
71    CALL local_flush( 9 )
72
73!
74!-- Exchange the interface data
75    IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
76
77!
78!--    Send heat flux at bottom surface to the ocean model
79       WRITE ( 9, * )  '*** send shf to ocean'
80       CALL local_flush( 9 )
81       CALL MPI_SEND( shf(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, &
82                      comm_inter, ierr )
83       WRITE ( 9, * )  '    ready'
84       CALL local_flush( 9 )
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, myid, 13, &
92               comm_inter, ierr )
93          WRITE ( 9, * )  '    ready'
94          CALL local_flush( 9 )
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, myid, 14, comm_inter, &
102                      status, ierr )
103       WRITE ( 9, * )  '    ready'
104       CALL local_flush( 9 )
105
106!
107!--    Send the momentum flux (u) at bottom surface to the ocean model
108       WRITE ( 9, * )  '*** send usws to ocean'
109       CALL local_flush( 9 )
110       CALL MPI_SEND( usws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, &
111                      comm_inter, ierr )
112       WRITE ( 9, * )  '    ready'
113       CALL local_flush( 9 )
114
115!
116!--    Send the momentum flux (v) at bottom surface to the ocean model
117       WRITE ( 9, * )  '*** send vsws to ocean'
118       CALL local_flush( 9 )
119       CALL MPI_SEND( vsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 16, &
120                      comm_inter, ierr )
121       WRITE ( 9, * )  '    ready'
122       CALL local_flush( 9 )
123
124    ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
125
126!
127!--    Receive heat flux at the sea surface (top) from the atmosphere model
128       WRITE ( 9, * )  '*** receive tswst from atmosphere'
129       CALL local_flush( 9 )
130       CALL MPI_RECV( tswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, &
131                      comm_inter, status, ierr )
132       WRITE ( 9, * )  '    ready'
133       CALL local_flush( 9 )
134
135!
136!--    Receive humidity flux from the atmosphere model (bottom)
137!--    and add it to the heat flux at the sea surface (top)...
138       IF ( humidity_remote )  THEN
139          WRITE ( 9, * )  '*** receive qswst_remote from atmosphere'
140          CALL local_flush( 9 )
141          CALL MPI_RECV( qswst_remote(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, &
142               13, comm_inter, status, ierr )
143          WRITE ( 9, * )  '    ready'
144          CALL local_flush( 9 )
145
146          tswst = tswst + qswst_remote * 2.2626108e6
147          !latent heat of vaporization in m2/s2, or 540 cal/g, or 40.65 kJ/mol
148!
149!--    ...and convert it to a salinity flux at the sea surface (top)
150!--       following Steinhorn (1991), JPO 21, pp. 1681-1683:
151!--       S'w' = -S * evaporation / ( rho_water * ( 1 - S ) )
152          saswst = -1.0 * sa(nzt,:,:) * qswst_remote /  &
153               ( rho(nzt,:,:) * ( 1.0 - sa(nzt,:,:) ) )
154       ENDIF
155
156!
157!--    Adjust the kinematic heat flux with respect to ocean density
158!--    (constants are the specific heat capacities for air and water)
159       tswst = tswst / rho(nzt,:,:) * 1005.0 / 4218.0
160
161!
162!--    Send sea surface temperature to the atmosphere model
163       WRITE ( 9, * )  '*** send pt to atmosphere'
164       CALL local_flush( 9 )
165       CALL MPI_SEND( pt(nzt,nys-1,nxl-1), 1, type_xy, myid, 14, comm_inter, &
166                      ierr )
167       WRITE ( 9, * )  '    ready'
168       CALL local_flush( 9 )
169
170!
171!--    Receive momentum flux (u) at the sea surface (top) from the atmosphere
172!--    model
173       WRITE ( 9, * )  '*** receive uswst from atmosphere'
174       CALL local_flush( 9 )
175       CALL MPI_RECV( uswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, &
176                      comm_inter, status, ierr )
177       WRITE ( 9, * )  '    ready'
178       CALL local_flush( 9 )
179
180!
181!--    Receive momentum flux (v) at the sea surface (top) from the atmosphere
182!--    model
183       WRITE ( 9, * )  '*** receive vswst from atmosphere'
184       CALL local_flush( 9 )
185       CALL MPI_RECV( vswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 16, &
186                      comm_inter, status, ierr )
187       WRITE ( 9, * )  '    ready'
188       CALL local_flush( 9 )
189
190!
191!--    Adjust the momentum fluxes with respect to ocean density
192       uswst = uswst / rho(nzt,:,:)
193       vswst = vswst / rho(nzt,:,:)
194
195    ENDIF
196
197    CALL cpu_log( log_point(39), 'surface_coupler', 'stop' )
198
199#endif
200
201 END SUBROUTINE surface_coupler
Note: See TracBrowser for help on using the repository browser.