source: palm/tags/release-3.6/SOURCE/init_coupling.f90 @ 3999

Last change on this file since 3999 was 226, checked in by raasch, 15 years ago

preparations for the next release

  • Property svn:keywords set to Id
File size: 3.3 KB
Line 
1  SUBROUTINE init_coupling
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! ------------------
10! $Id: init_coupling.f90 226 2009-02-02 07:39:34Z suehring $
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:2) = 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
51#if defined( __mpi2 )
52       IF ( TRIM( coupling_mode ) == 'atmosphere_to_ocean' )  THEN
53          i = 1
54       ELSEIF ( TRIM( coupling_mode ) == 'ocean_to_atmosphere' )  THEN
55          i = 2
56       ELSE
57          i = 0
58       ENDIF
59#else
60       IF ( TRIM( coupling_mode ) == 'coupled_run' )  THEN
61          i = 1
62       ELSE
63          i = 0
64       ENDIF
65#endif
66    bc_data(0) = i
67    ENDIF
68
69    CALL MPI_BCAST( bc_data(0), 3, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr )
70    i = bc_data(0)
71
72#if defined ( __mpi2 )
73    IF ( i == 0 )  THEN
74       coupling_mode = 'uncoupled'
75    ELSEIF ( i == 1 )  THEN
76       coupling_mode = 'atmosphere_to_ocean'
77    ELSEIF ( i == 2 )  THEN
78       coupling_mode = 'ocean_to_atmosphere'
79    ENDIF
80    target_id = myid
81#else
82    IF ( i == 0 ) THEN
83       coupling_mode = 'uncoupled'
84    ELSE
85       comm_inter = MPI_COMM_WORLD
86
87       IF ( myid < bc_data(1) ) THEN
88          inter_color = 0
89          numprocs = bc_data(1)
90       ELSE
91          inter_color = 1
92          numprocs = bc_data(2)
93       ENDIF
94!
95!--    Calculate the target PE for coupling and set up the new communicators.
96!--    Currently only 1:1 topologies are supported.
97       target_id = myid - ISIGN( numprocs, inter_color - 1 )
98       IF ( inter_color == 0 ) THEN
99          coupling_mode = 'atmosphere_to_ocean'
100       ELSE
101          coupling_mode = 'ocean_to_atmosphere'
102       ENDIF
103       CALL MPI_COMM_SPLIT( MPI_COMM_WORLD, inter_color, 0, comm_palm, ierr )
104       comm2d = comm_palm
105
106!
107!--    Write a flag file for the ocean model and the other atmosphere
108!--    processes.
109       OPEN( 90, FILE='COUPLING_PORT_OPENED', FORM='FORMATTED' )
110       WRITE ( 90, '(''TRUE'')' )
111       CLOSE ( 90 )
112    ENDIF
113#endif
114#endif
115
116    IF ( coupling_mode == 'ocean_to_atmosphere' )  coupling_char = '_O'
117
118 END SUBROUTINE init_coupling
Note: See TracBrowser for help on using the repository browser.