| 1 | ce107 | 1.2 | C       $Id$ | 
| 2 | ce107 | 1.1 | 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 | ce107 | 1.2 | #include "MPI_INFO.h" | 
| 16 | ce107 | 1.1 | #endif | 
| 17 |  |  |  | 
| 18 |  |  | C     == Local variables == | 
| 19 | ce107 | 1.2 | #ifdef USE_JAM_INIT | 
| 20 | ce107 | 1.1 | Real*8  dummyVal | 
| 21 | ce107 | 1.2 | INTEGER myTwoProcRank | 
| 22 |  |  | #endif | 
| 23 | ce107 | 1.1 | INTEGER rc | 
| 24 |  |  | CHARACTER*(MAX_LEN_FNAM) fnam | 
| 25 | ce107 | 1.2 | #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 | ce107 | 1.1 |  | 
| 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 | ce107 | 1.2 | 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 | ce107 | 1.1 | 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 | ce107 | 1.2 | #endif | 
| 90 | ce107 | 1.1 |  | 
| 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 | ce107 | 1.2 | dummyVal    = 0. _d 0 | 
| 111 | ce107 | 1.1 | 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 | ce107 | 1.2 | #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 | ce107 | 1.1 | myYGlobalLo   = myProcId*sNy+1 | 
| 135 |  |  | Ny            = numberOfProcs*sNy | 
| 136 | ce107 | 1.2 | #endif | 
| 137 | ce107 | 1.1 | 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 |