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

Last change on this file since 102 was 102, checked in by raasch, 14 years ago

preliminary version for coupled runs

  • Property svn:keywords set to Id
File size: 4.3 KB
Line 
1 SUBROUTINE surface_coupler
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! ------------------
10! $Id: surface_coupler.f90 102 2007-07-27 09:09:17Z raasch $
11!
12! Initial revision
13!
14! Description:
15! ------------
16! Data exchange at the interface between coupled models
17!------------------------------------------------------------------------------!
18
19    USE arrays_3d
20    USE control_parameters
21    USE cpulog
22    USE grid_variables
23    USE indices
24    USE interfaces
25    USE pegrid
26
27    IMPLICIT NONE
28
29    INTEGER ::  k
30
31    REAL    ::  simulated_time_remote
32
33#if defined( __parallel )  &&  defined( __mpi2 )
34
35    CALL cpu_log( log_point(39), 'surface_coupler', 'start' )
36
37!
38!-- First exchange the current simulated time between the models,
39!-- currently just for testing
40    CALL MPI_SEND( simulated_time, 1, MPI_REAL, myid, 11, comm_inter, ierr )
41    CALL MPI_RECV( simulated_time_remote, 1, MPI_REAL, myid, 11, &
42                   comm_inter, status, ierr )
43    WRITE ( 9, * )  simulated_time, ' remote: ', simulated_time_remote
44    CALL local_flush( 9 )
45
46!
47!-- Exchange the interface data
48    IF ( coupling_mode == 'atmosphere_to_ocean' )  THEN
49
50!
51!--    Send heat flux at bottom surface to the ocean model
52       WRITE ( 9, * )  '*** send shf to ocean'
53       CALL local_flush( 9 )
54       CALL MPI_SEND( shf(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, &
55                      comm_inter, ierr )
56       WRITE ( 9, * )  '    ready'
57       CALL local_flush( 9 )
58
59!
60!--    Receive temperature at the bottom surface from the ocean model
61       WRITE ( 9, * )  '*** receive pt from ocean'
62       CALL local_flush( 9 )
63       CALL MPI_RECV( pt(0,nys-1,nxl-1), 1, type_xy, myid, 13, comm_inter, &
64                      status, ierr )
65       WRITE ( 9, * )  '    ready'
66       CALL local_flush( 9 )
67
68!
69!--    Send the momentum flux (u) at bottom surface to the ocean model
70       WRITE ( 9, * )  '*** send usws to ocean'
71       CALL local_flush( 9 )
72       CALL MPI_SEND( usws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 14, &
73                      comm_inter, ierr )
74       WRITE ( 9, * )  '    ready'
75       CALL local_flush( 9 )
76
77!
78!--    Send the momentum flux (v) at bottom surface to the ocean model
79       WRITE ( 9, * )  '*** send vsws to ocean'
80       CALL local_flush( 9 )
81       CALL MPI_SEND( vsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, &
82                      comm_inter, ierr )
83       WRITE ( 9, * )  '    ready'
84       CALL local_flush( 9 )
85
86    ELSEIF ( coupling_mode == 'ocean_to_atmosphere' )  THEN
87
88!
89!--    Receive heat flux at the sea surface (top) from the atmosphere model
90       WRITE ( 9, * )  '*** receive tswst from atmosphere'
91       CALL local_flush( 9 )
92       CALL MPI_RECV( tswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, &
93                      comm_inter, status, ierr )
94       WRITE ( 9, * )  '    ready'
95       CALL local_flush( 9 )
96
97!
98!--    Adjust the kinematic heat flux with respect to ocean density
99!--    (constants are the specific heat capacities for air and water)
100       tswst = tswst / rho_surface * 1005.0 / 4218.0
101
102!
103!--    Send sea surface temperature to the atmosphere model
104       WRITE ( 9, * )  '*** send pt to atmosphere'
105       CALL local_flush( 9 )
106       CALL MPI_SEND( pt(nzt,nys-1,nxl-1), 1, type_xy, myid, 13, comm_inter, &
107                      ierr )
108       WRITE ( 9, * )  '    ready'
109       CALL local_flush( 9 )
110
111!
112!--    Receive momentum flux (u) at the sea surface (top) from the atmosphere
113!--    model
114       WRITE ( 9, * )  '*** receive uswst from atmosphere'
115       CALL local_flush( 9 )
116       CALL MPI_RECV( uswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 14, &
117                      comm_inter, status, ierr )
118       WRITE ( 9, * )  '    ready'
119       CALL local_flush( 9 )
120
121!
122!--    Receive momentum flux (v) at the sea surface (top) from the atmosphere
123!--    model
124       WRITE ( 9, * )  '*** receive vswst from atmosphere'
125       CALL local_flush( 9 )
126       CALL MPI_RECV( vswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, &
127                      comm_inter, status, ierr )
128       WRITE ( 9, * )  '    ready'
129       CALL local_flush( 9 )
130
131!
132!--    Adjust the momentum fluxes with respect to ocean density
133       uswst = uswst / rho_surface
134       vswst = vswst / rho_surface
135
136    ENDIF
137
138    CALL cpu_log( log_point(39), 'surface_coupler', 'stop' )
139
140#endif
141
142 END SUBROUTINE surface_coupler
Note: See TracBrowser for help on using the repository browser.