source: palm/trunk/SOURCE/init_coupling.f90 @ 335

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

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

  • Property svn:keywords set to Id
File size: 3.8 KB
Line 
1  SUBROUTINE init_coupling
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! Coupling with independent precursor runs.
7!
8! Former revisions:
9! ------------------
10! $Id: init_coupling.f90 291 2009-04-16 12:07:26Z heinze $
11!
12! 222 2009-01-12 16:04:16Z letzel
13! Initial revision
14!
15! Description:
16! ------------
17! Initializing coupling via MPI-1 or MPI-2 if the coupled version of PALM is
18! called.
19!------------------------------------------------------------------------------!
20
21    USE pegrid
22    USE control_parameters
23
24    IMPLICIT NONE
25
26!
27!-- Local variables
28    INTEGER               ::  i, inter_color
29    INTEGER, DIMENSION(:) ::  bc_data(0:3) = 0
30
31!
32!-- Get information about the coupling mode from the environment variable
33!-- which has been set by the mpiexec command.
34!-- This method is currently not used because the mpiexec command is not
35!-- available on some machines
36!    CALL local_getenv( 'coupling_mode', 13, coupling_mode, i )
37!    IF ( i == 0 )  coupling_mode = 'uncoupled'
38!    IF ( coupling_mode == 'ocean_to_atmosphere' )  coupling_char = '_O'
39
40!
41!-- Get information about the coupling mode from standard input (PE0 only) and
42!-- distribute it to the other PEs. If __mpi2 was defined, suggest a
43!-- coupling via MPI-2. Otherwise initate a coupling using MPI-1 only.
44!-- In this case, distribute PEs to 2 new communicators.
45!-- ATTENTION: numprocs will be reset according to the new communicators
46#if defined ( __parallel )
47    IF ( myid == 0 )  THEN
48       READ (*,*,ERR=10,END=10)  coupling_mode, bc_data(1), bc_data(2)
4910     CONTINUE
50#if defined( __mpi2 )
51       IF ( TRIM( coupling_mode ) == 'atmosphere_to_ocean' )  THEN
52          i = 1
53       ELSEIF ( TRIM( coupling_mode ) == 'ocean_to_atmosphere' )  THEN
54          i = 2
55       ELSE
56          i = 0
57       ENDIF
58#else
59       IF ( TRIM( coupling_mode ) == 'coupled_run' )  THEN
60          i = 1
61       ELSE
62          i = 0
63       ENDIF
64#endif
65       bc_data(0) = i
66
67!
68!--    Check if '_O' has to be used as file extension in an uncoupled ocean
69!--    run. This is required, if this run shall be continued as a coupled run.
70       IF ( TRIM( coupling_mode ) == 'precursor_ocean' )  bc_data(3) = 1
71
72    ENDIF
73
74    CALL MPI_BCAST( bc_data(0), 4, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr )
75    i = bc_data(0)
76
77#if defined ( __mpi2 )
78    IF ( i == 0 )  THEN
79       coupling_mode = 'uncoupled'
80    ELSEIF ( i == 1 )  THEN
81       coupling_mode = 'atmosphere_to_ocean'
82    ELSEIF ( i == 2 )  THEN
83       coupling_mode = 'ocean_to_atmosphere'
84    ENDIF
85    target_id = myid
86#else
87    IF ( i == 0 ) THEN
88       coupling_mode = 'uncoupled'
89    ELSE
90       comm_inter = MPI_COMM_WORLD
91
92       IF ( myid < bc_data(1) ) THEN
93          inter_color = 0
94          numprocs = bc_data(1)
95       ELSE
96          inter_color = 1
97          numprocs = bc_data(2)
98       ENDIF
99!
100!--    Calculate the target PE for coupling and set up the new communicators.
101!--    Currently only 1:1 topologies are supported.
102       target_id = myid - ISIGN( numprocs, inter_color - 1 )
103       IF ( inter_color == 0 ) THEN
104          coupling_mode = 'atmosphere_to_ocean'
105       ELSE
106          coupling_mode = 'ocean_to_atmosphere'
107       ENDIF
108       CALL MPI_COMM_SPLIT( MPI_COMM_WORLD, inter_color, 0, comm_palm, ierr )
109       comm2d = comm_palm
110
111!
112!--    Write a flag file for the ocean model and the other atmosphere
113!--    processes.
114       OPEN( 90, FILE='COUPLING_PORT_OPENED', FORM='FORMATTED' )
115       WRITE ( 90, '(''TRUE'')' )
116       CLOSE ( 90 )
117    ENDIF
118#endif
119#endif
120
121!
122!-- In case of a precursor ocean run (followed by a coupled run), or a
123!-- coupled atmosphere-ocean run, set the file extension for the ocean files
124    IF ( TRIM( coupling_mode ) == 'ocean_to_atmosphere' .OR. bc_data(3) == 1 ) &
125    THEN
126       coupling_char = '_O'
127    ENDIF
128
129 END SUBROUTINE init_coupling
Note: See TracBrowser for help on using the repository browser.