/[MITgcm]/MITgcm_contrib/cg2d_bench/ini_mp.F
ViewVC logotype

Contents of /MITgcm_contrib/cg2d_bench/ini_mp.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.2 - (show annotations) (download)
Fri May 12 22:24:08 2006 UTC (17 years, 10 months ago) by ce107
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +56 -7 lines
Fixed for 2D process decomposition and single/double precision.

1 C $Id$
2 SUBROUTINE INI_MP
3
4 C Initialise multi-processing
5 IMPLICIT NONE
6
7 C == Global data ==
8 #include "SIZE.h"
9 #include "EEPARAMS.h"
10
11 #include "JAM_INFO.h"
12
13 #ifdef ALLOW_MPI
14 #include "mpif.h"
15 #include "MPI_INFO.h"
16 #endif
17
18 C == Local variables ==
19 #ifdef USE_JAM_INIT
20 Real*8 dummyVal
21 INTEGER myTwoProcRank
22 #endif
23 INTEGER rc
24 CHARACTER*(MAX_LEN_FNAM) fnam
25 #ifdef DECOMP2D
26 integer dimens(2), coords(2), comm_cart
27 logical periods(2)
28 periods(1) = .true.
29 periods(2) = .true.
30 #endif
31
32 myXGlobalLo =1
33 myYGlobalLo =1
34 myProcId =0
35 numberOfProcs =1
36 Nx = sNx
37 Ny = sNy
38 standardMessageUnit=6
39
40 #ifdef USE_MPI_INIT
41 C MPI Initialisation
42 CALL MPI_INIT( rc )
43 C Get my proc. number
44 CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpi_pid, rc )
45 C Get total count of procs.
46 CALL MPI_COMM_SIZE( MPI_COMM_WORLD, mpi_np , rc )
47
48 numberOfProcs = mpi_np
49 myProcId = mpi_pid
50 comm_use = MPI_COMM_WORLD
51 #ifdef DECOMP2D
52 c
53 OPEN(UNIT=21,FILE="decomp.touse")
54 read(21,*) dimens(1)
55 read(21,*) dimens(2)
56 if ((dimens(1)*dimens(2)) .ne. mpi_np) then
57 if (mpi_pid .eq. 0) then
58 write(0,*) 'Letting MPI choose a decomposition'
59 endif
60 dimens(1) = 0
61 dimens(2) = 0
62 call mpi_dims_create(mpi_np, 2, dimens, rc)
63 endif
64
65 call mpi_cart_create(MPI_COMM_WORLD, 2, dimens, periods, .true.,
66 $ comm_cart, rc)
67 if (mpi_pid .eq. 0) then
68 write(0,*) 'using a ', dimens(1), ' x ', dimens(2),
69 $ ' decomposition'
70 endif
71 call mpi_comm_rank(comm_cart, mpi_pid, rc)
72 call mpi_cart_coords(comm_cart, mpi_pid, 2, coords, rc)
73 C Set up connectivity
74 call mpi_cart_shift(comm_cart, 0, 1, mpi_southId, mpi_northId, rc)
75 call mpi_cart_shift(comm_cart, 1, 1, mpi_westId, mpi_eastId, rc)
76 c create the derived datatype
77 call mpi_type_vector(sNy,OLx,sNx+OLx*2,_MPI_TYPE_REAL,ewslice, rc)
78 call mpi_type_commit(ewslice, rc)
79 call mpi_type_vector(OLy,sNx,sNx+OLx*2,_MPI_TYPE_REAL,nsslice, rc)
80 call mpi_type_commit(nsslice, rc)
81 c replace the communicator used
82 comm_use = comm_cart
83 #else
84 C Set up connectivity
85 mpi_northId = mpi_pid+1
86 IF ( mpi_northId .EQ. mpi_np ) mpi_northId = 0
87 mpi_southId = mpi_pid-1
88 IF ( mpi_southId .LT. 0 ) mpi_southId = mpi_np-1
89 #endif
90
91 #endif
92
93
94 #ifdef USE_JAM_INIT
95 C JAM initialisation. This should work with or without
96 C MPI. If we don't use MPI we have to start procs. by hand
97 C though!
98
99 myTwoProcRank=MOD(myProcId,2)
100 IF ( myTwoProcRank .EQ. 0 ) THEN
101 myTwoProcRank = 1
102 ELSE
103 myTwoProcRank = 0
104 ENDIF
105 CALL JAM_collective_init( myTwoProcRank )
106
107 CALL GET_JAM_self_address( jam_pid )
108 CALL GET_JAM_partition_size( jam_np )
109 jam_exchKey = 100
110 dummyVal = 0. _d 0
111 CALL JAM_barrier_start( dummyVal )
112 CALL JAM_barrier_done( dummyVal )
113
114 C Set up connectivity
115 jam_northId = jam_pid+1
116 IF ( jam_northId .EQ. jam_np ) jam_northId = 0
117 jam_southId = jam_pid-1
118 IF ( jam_southId .LT. 0 ) jam_southId = jam_np-1
119
120 numberOfProcs = jam_np
121 myProcId = jam_pid
122
123 mpi_northId = jam_northId
124 mpi_southId = jam_southId
125
126 #endif
127
128 #if defined(ALLOW_MPI) && defined(DECOMP2D)
129 myXGlobalLo = coords(1)*sNx+1
130 myYGlobalLo = coords(2)*sNy+1
131 Nx = dimens(1)*sNx
132 Ny = dimens(2)*sNy
133 #else
134 myYGlobalLo = myProcId*sNy+1
135 Ny = numberOfProcs*sNy
136 #endif
137 IF ( numberOfProcs .GT. 1 ) THEN
138 WRITE(fnam,'(A7,I6.6)') 'STDOUT.',myProcId
139 OPEN(UNIT=standardMessageUnit,FILE=fnam)
140 ENDIF
141
142
143 RETURN
144 END

  ViewVC Help
Powered by ViewVC 1.1.22