source: XMLIO_SERVER/trunk/src/IOSERVER/mod_ioclient_para.F90 @ 37

Last change on this file since 37 was 37, checked in by ymipsl, 12 years ago

Feature : permet d'utiliser XMLIO-SERVER sans MPI, donc en mode édition de lien, sans server.

File size: 2.3 KB
Line 
1  MODULE mod_ioclient_para
2    INTEGER,PARAMETER :: color_client=1
3    INTEGER,PARAMETER :: color_server=2 
4    INTEGER,SAVE      :: iocomm
5    INTEGER,SAVE      :: iosize
6    INTEGER,SAVE      :: iorank
7    INTEGER,SAVE      :: server_rank
8    INTEGER,SAVE      :: intracomm 
9  CONTAINS
10 
11 
12  SUBROUTINE Init_parallel
13  USE mpitrace
14  USE mod_ioserver_namelist
15#ifdef USE_OASIS
16  USE mod_prism_get_comm 
17#endif
18  USE mpi_mod
19  IMPLICIT NONE
20    INTEGER :: NEW_COMM
21    INTEGER :: ierr
22    INTEGER :: global_rank
23    INTEGER :: global_size
24    INTEGER :: mpi_rank
25    INTEGER :: mpi_size
26    INTEGER :: nb_server_io 
27    INTEGER,ALLOCATABLE :: proc_color(:) 
28    INTEGER :: i
29    INTEGER :: div,remain
30    INTEGER :: group_color
31    INTEGER :: Comm_client_server
32    CHARACTER(LEN=6) :: oasis_server_id
33   
34    IF (using_oasis) THEN
35      oasis_server_id=server_id
36      PRINT *,'prism_get_intracomm'
37#ifdef USE_OASIS
38      CALL prism_get_intracomm(Comm_client_server,oasis_server_id,ierr)
39#endif
40    ELSE
41      CALL MPI_INIT(ierr)
42      Comm_client_server=MPI_COMM_WORLD
43    ENDIF
44
45    CALL MPI_COMM_RANK(Comm_client_server,global_rank,ierr)
46    CALL MPI_COMM_SIZE(Comm_client_server,global_size,ierr)
47
48    CALL MPI_COMM_SPLIT(Comm_client_server,color_client,global_rank,intracomm,ierr)
49    CALL MPI_COMM_SIZE(intracomm,mpi_size,ierr)
50    CALL MPI_COMM_RANK(intracomm,mpi_rank,ierr)
51
52    nb_server_io=global_size-mpi_size
53    div=mpi_size/nb_server_io
54    remain=MOD(mpi_size,nb_server_io)
55   
56    IF (mpi_rank<remain*(div+1)) THEN
57      group_color=mpi_rank/(div+1)
58    ELSE
59      group_color=(nb_server_io-1)-(mpi_size-1-mpi_rank)/div
60    ENDIF
61
62    CALL MPI_COMM_SPLIT(Comm_client_server,group_color,global_rank,iocomm,ierr)
63   
64    CALL MPI_COMM_SIZE(iocomm,iosize,ierr)
65    CALL MPI_COMM_RANK(iocomm,iorank,ierr)
66
67    ALLOCATE(proc_color(0:iosize-1))
68    CALL MPI_ALLGATHER(color_client,1,MPI_INTEGER,proc_color,1,MPI_INTEGER,iocomm,ierr)
69   
70    DO i=0,iosize-1
71      IF (proc_color(i)==color_server) THEN
72        server_rank=i
73        EXIT
74      ENDIF
75    ENDDO
76   
77    PRINT *,"Proces No",mpi_rank,"--> server",server_rank
78  END SUBROUTINE Init_parallel
79 
80  SUBROUTINE Finalize_parallel
81  USE mpi_mod
82  IMPLICIT NONE
83    INTEGER :: ierr
84   
85    CALL MPI_FINALIZE(ierr)
86
87  END SUBROUTINE Finalize_parallel
88 
89  END MODULE mod_ioclient_para
Note: See TracBrowser for help on using the repository browser.