source: XMLIO_SERVER/trunk/src/IOSERVER/mod_ioserver_para.F90 @ 31

Last change on this file since 31 was 31, checked in by ymipsl, 13 years ago

renommage .f90 -> .F90

File size: 2.7 KB
Line 
1  MODULE mod_ioserver_para
2    INTEGER,PARAMETER :: color_client=1
3    INTEGER,PARAMETER :: color_server=2 
4
5    INTEGER,SAVE      :: iocomm
6    INTEGER,SAVE      :: iosize
7    INTEGER,SAVE      :: iorank
8   
9    INTEGER,SAVE      :: mpi_rank
10    INTEGER,SAVE      :: mpi_size
11    INTEGER,SAVE      :: mpi_master
12    LOGICAL,SAVE      :: is_mpi_master
13 
14    INTEGER,SAVE      :: nb_client
15    INTEGER,ALLOCATABLE,SAVE      :: client_rank(:)
16    INTEGER,SAVE      :: intracomm 
17  CONTAINS
18 
19 
20  SUBROUTINE Init_parallel
21  USE mpitrace
22  USE mod_ioserver_namelist
23#ifdef USE_OASIS
24  USE mod_prism_get_comm 
25#endif
26  IMPLICIT NONE
27    INCLUDE 'mpif.h'
28    INTEGER :: ierr
29    INTEGER :: global_rank
30    INTEGER :: global_size
31    INTEGER,ALLOCATABLE :: proc_color(:)
32    INTEGER :: i
33    INTEGER :: group_color
34    INTEGER :: Comm_client_server
35    INTEGER :: comp_id
36    CHARACTER(LEN=6) :: oasis_server_id, oasis_client_id
37
38    IF (using_oasis) THEN
39       oasis_server_id=server_id
40       oasis_client_id=client_id
41#ifdef USE_OASIS
42       CALL prism_init_comp_proto (comp_id, oasis_server_id, ierr)
43       CALL prism_get_intracomm(Comm_client_server,oasis_client_id,ierr)
44#endif
45    ELSE
46      CALL MPI_INIT(ierr)
47      Comm_client_server=MPI_COMM_WORLD
48    ENDIF
49       
50    CALL MPI_COMM_RANK(Comm_client_server,global_rank,ierr)
51    CALL MPI_COMM_SIZE(Comm_client_server,global_size,ierr)
52       
53    CALL MPI_COMM_SPLIT(Comm_client_server,color_server,global_rank,intracomm,ierr)
54    CALL MPI_COMM_SIZE(intracomm,mpi_size,ierr)
55    CALL MPI_COMM_RANK(intracomm,mpi_rank,ierr)
56   
57    group_color=mpi_rank
58    PRINT *,'group_color',group_color
59
60    CALL MPI_COMM_SPLIT(Comm_client_server,group_color,global_rank,iocomm,ierr)   
61   
62    CALL MPI_COMM_SIZE(iocomm,iosize,ierr)
63    CALL MPI_COMM_RANK(iocomm,iorank,ierr)
64
65    PRINT *,"io_size-> ",iosize,"iorank-> ",iorank
66   
67    ALLOCATE(proc_color(0:iosize-1))
68    CALL MPI_ALLGATHER(color_server,1,MPI_INTEGER,proc_color,1,MPI_INTEGER,iocomm,ierr)
69    print *,"proc_color -> ",proc_color
70   
71    ALLOCATE(client_rank(iosize-1))
72    nb_client=0
73    DO i=0,iosize-1
74      IF (proc_color(i)==color_client) THEN
75        nb_client=nb_client+1
76        client_rank(nb_client)=i
77      ENDIF
78    ENDDO
79
80    PRINT *,"Proces No",mpi_rank,"--> client ",client_rank
81  END SUBROUTINE Init_parallel
82 
83  SUBROUTINE Finalize_parallel
84  USE mod_ioserver_namelist
85#ifdef USE_OASIS
86  USE mod_prism_proto
87#endif
88  IMPLICIT NONE
89    include 'mpif.h'
90    INTEGER :: ierr
91   
92    IF (using_oasis) THEN
93#ifdef USE_OASIS
94      CALL prism_terminate_proto(ierr)
95#endif
96    ELSE
97      CALL MPI_FINALIZE(ierr)
98    ENDIF
99   
100  END SUBROUTINE Finalize_parallel
101
102END MODULE mod_ioserver_para
Note: See TracBrowser for help on using the repository browser.