File: /nfs/home/0/users/jenkins/mfix.git/model/dmp_modules/parallel_mpi_mod.f

1             module parallel_mpi
2     
3     !       A module to carry out init, finalize and check for any parallel errors
4     
5             use geometry
6             use compar
7             implicit none
8     
9             contains
10     
11             subroutine parallel_init()
12     
13             integer :: ierr
14     
15     
16             call MPI_Init(ierr)
17             call MPI_Check( 'parallel_init:MPI_Init ', ierr)
18     
19             call MPI_COMM_SIZE( MPI_COMM_WORLD, numPEs, ierr )
20             call MPI_Check( 'parallel_init:MPI_Comm_size ', ierr )
21     
22             call MPI_COMM_RANK( MPI_COMM_WORLD, myPE, ierr )
23             call MPI_Check( 'parallel_init:MPI_Comm_size ', ierr )
24     
25             return
26             end subroutine parallel_init
27     
28             subroutine parallel_fin()
29     
30             integer :: ierr
31     
32             call MPI_Finalize(ierr)
33             call MPI_Check( 'parallel_init:MPI_Finalize ', ierr)
34     
35             return
36             end subroutine parallel_fin
37     
38             subroutine MPI_Check( msg, ierr )
39             character(len=*),intent(in) :: msg
40             integer, intent(in) :: ierr
41     
42             character(len=512) :: errmsg
43             integer :: resultlen, ierror
44     
45             if (ierr .ne. MPI_SUCCESS ) then
46                     call MPI_Error_string( ierr, errmsg, resultlen, ierror )
47                     print*, 'Error: ', msg
48                     print*, errmsg(1:resultlen)
49                     stop '** ERROR ** '
50             endif
51     
52             return
53             end subroutine MPI_Check
54     
55     
56             end module parallel_mpi
57     
58