source: CPL/oasis3/trunk/src/lib/psmile/src/mod_prism_get_comm.F90 @ 1677

Last change on this file since 1677 was 1677, checked in by aclsce, 12 years ago

Imported oasis3 (tag ipslcm5a) from cvs server to svn server (igcmg project).
File size: 4.3 KB
Line 
1MODULE mod_prism_get_comm
2
3  IMPLICIT NONE
4
5  INTERFACE prism_get_intercomm
6   
7    MODULE PROCEDURE prism_get_intercomm_1mod
8       
9  END INTERFACE
10
11  INTERFACE prism_get_intracomm
12
13    MODULE PROCEDURE prism_get_intracomm_1mod
14       
15  END INTERFACE
16!
17!-----Type model to store information about models
18!
19  TYPE :: model
20    character(len=6) :: name
21    integer          :: master_proc   !! rank of master proc in global communicator
22  END TYPE model
23
24  TYPE(model), ALLOCATABLE, DIMENSION(:), PRIVATE :: coupling_models
25
26CONTAINS
27
28  SUBROUTINE prism_get_intercomm_1mod(il_local_comm, cd_name, kinfo)
29!
30!*    *** Get_intercomm ***   PRISM 1.0
31!
32!     purpose:
33!     --------
34!        Get an intercommunicator.
35!
36!     interface:
37!     ----------
38!        il_local_comm : intercommunicator
39!        cd_name : name of the model to be linked with thanks to the intercommunicator
40!        kinfo  : exit status
41!
42!     lib mp:
43!     -------
44!        mpi-1
45!
46!     author:
47!     -------
48!        Arnaud Caubel
49!
50!     ----------------------------------------------------------------
51!
52    USE mod_kinds_model
53    USE mod_comprism_proto
54
55    include 'mpif.h'
56
57!     ----------------------------------------------------------------
58    INTEGER (kind=ip_intwp_p)   :: il, il_local_comm, kinfo, il_local_intercomm
59    INTEGER (kind=ip_intwp_p)   :: tag
60    CHARACTER (len=6) :: cd_name
61    LOGICAL :: ll_found
62!     ----------------------------------------------------------------
63
64    ll_found= .false.
65
66    ALLOCATE(coupling_models(knmods))
67    coupling_models(1)%master_proc=1
68    coupling_models(1)%name=trim(cunames(2))
69    DO il=2,knmods
70      coupling_models(il)%master_proc= &
71         coupling_models(il-1)%master_proc+ kbtotproc(il-1)
72      coupling_models(il)%name= &
73         TRIM(cunames(coupling_models(il)%master_proc+1))
74    ENDDO
75     
76    DO il=1,knmods
77      IF (cd_name .EQ. coupling_models(il)%name .AND. .NOT. ll_found) THEN
78          tag=ICHAR(TRIM(cmynam))+ICHAR(TRIM(cd_name))
79      CALL mpi_intercomm_create(ig_local_comm, 0, MPI_COMM_WORLD, coupling_models(il)%master_proc, &
80             tag, il_local_intercomm, kinfo)
81          ll_found= .true.
82      ENDIF
83    ENDDO
84   
85    il_local_comm = il_local_intercomm
86
87    IF (ll_found) THEN
88        kinfo = CLIM_Ok
89    ELSE
90        kinfo = CLIM_BadName
91    ENDIF
92
93    deallocate (coupling_models)
94
95  END SUBROUTINE prism_get_intercomm_1mod
96
97  SUBROUTINE prism_get_intracomm_1mod(il_local_comm, cd_name, kinfo)
98!
99!*    *** Get_intracomm ***   PRISM 1.0
100!
101!     purpose:
102!     --------
103!        Get an intracommunicator.
104!
105!     interface:
106!     ----------
107!        il_local_comm : intracommunicator
108!        cd_name : name of the model to share the communicator with
109!        kinfo  : exit status
110!
111!     lib mp:
112!     -------
113!        mpi-1
114!
115!     author:
116!     -------
117!        Arnaud Caubel
118!
119!     ----------------------------------------------------------------
120!
121    USE mod_kinds_model
122    USE mod_comprism_proto
123
124    include 'mpif.h'
125
126!     ----------------------------------------------------------------
127    INTEGER (kind=ip_intwp_p)   :: il, il_local_comm, kinfo, il_local_intercomm
128    INTEGER (kind=ip_intwp_p)   :: il_new_local_comm, tag
129    CHARACTER (len=6) :: cd_name
130    LOGICAL :: ll_found
131!     ----------------------------------------------------------------
132
133    ll_found= .false.
134
135    ALLOCATE(coupling_models(knmods))
136    coupling_models(1)%master_proc=1
137    coupling_models(1)%name=trim(cunames(2))
138    DO il=2,knmods
139      coupling_models(il)%master_proc= &
140         coupling_models(il-1)%master_proc+ kbtotproc(il-1)
141      coupling_models(il)%name= &
142         TRIM(cunames(coupling_models(il)%master_proc+1))
143    ENDDO
144     
145    DO il=1,knmods
146      IF (cd_name .EQ. coupling_models(il)%name .AND. .NOT. ll_found) THEN
147          tag=ICHAR(TRIM(cmynam))+ICHAR(TRIM(cd_name))
148      CALL mpi_intercomm_create(ig_local_comm, 0, MPI_COMM_WORLD, coupling_models(il)%master_proc, &
149             tag, il_local_intercomm, kinfo)
150          CALL mpi_intercomm_merge(il_local_intercomm,.FALSE., il_new_local_comm, kinfo)
151          ll_found= .true.
152      ENDIF
153    ENDDO
154   
155    il_local_comm = il_new_local_comm
156
157    IF (ll_found) THEN
158        kinfo = CLIM_Ok
159    ELSE
160        kinfo = CLIM_BadName
161    ENDIF
162
163    deallocate (coupling_models)
164
165  END SUBROUTINE prism_get_intracomm_1mod
166
167END MODULE mod_prism_get_comm
Note: See TracBrowser for help on using the repository browser.