OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_split_comm_inter.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| spmd_split_comm_inter ../engine/source/mpi/interfaces/spmd_split_comm_inter.F
25!||--- called by ------------------------------------------------------
26!|| mpp_init ../engine/source/mpi/interfaces/spmd_i7tool.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| comm_tri7vox_mod ../engine/share/modules/comm_tri7vox_mod.F
30!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
31!|| inter_sorting_mod ../engine/share/modules/inter_sorting_mod.F
32!|| inter_struct_mod ../engine/share/modules/inter_struct_mod.F
33!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
34!||====================================================================
35 SUBROUTINE spmd_split_comm_inter(INTBUF_TAB, NBINTC,INTLIST,IPARI,ISENDTO,IRCVFROM,SORT_COMM ,
36 . NEED_COMM_INT25_SOLID_EROSION,COMM_INT25_SOLID_EROSION )
37!$COMMENT
38! SPMD_SPLIT_COMM_INTER :
39! SPMD_SPLIT_COMM_INTER creates new communicators
40! for interface TYPE07
41! SPMD_SPLIT_COMM_INTER organization :
42! - loop over the interfaces in order to
43! tag all the processors of a interface
44! - then create a communicator for a given
45! interface
46!$ENDCOMMENT
47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE comm_tri7vox_mod
51 USE intbufdef_mod
52 USE inter_struct_mod
53 USE inter_sorting_mod
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57 USE spmd_comm_world_mod, ONLY : spmd_comm_world
58#include "implicit_f.inc"
59C-----------------------------------------------
60C M e s s a g e P a s s i n g
61C-----------------------------------------------
62#include "spmd.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "com01_c.inc"
67#include "com04_c.inc"
68#include "task_c.inc"
69#include "param_c.inc"
70#include "impl1_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 TYPE(intbuf_struct_) INTBUF_TAB(NINTER)
75 integer, intent(in) :: NBINTC
76 integer, dimension(NINTER), intent(in) :: INTLIST
77 integer, dimension(NPARI,NINTER), intent(in) :: IPARI
78 integer,dimension(NINTER+1,NSPMD+1), intent(in) :: ISENDTO,IRCVFROM
79 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
80
81 LOGICAL, DIMENSION(NSPMD), INTENT(inout) :: NEED_COMM_INT25_SOLID_EROSION !< boolean, true if the proc needs to comm some values related to interface type 25 with solid erosion
82 INTEGER, INTENT(inout) :: COMM_INT25_SOLID_EROSION !< integer, sub-communicator related to interface type 25 with solid erosion
83
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87#ifdef MPI
88
89 INTEGER :: KEY,CODE,I,P
90 INTEGER :: NIN,KK,NTY
91 INTEGER :: COLOR_INACTI,COLOR_INT25_SOLID_EROSION
92 INTEGER :: INACTI,IFQ,ITIED
93 INTEGER :: IDEL,IDELKEEP,SOLID_EROSION
94 INTEGER :: COLOR_CRIT
95C-----------------------------------------------
96C S o u r c e L i n e s
97C-----------------------------------------------
98 ALLOCATE( comm_tri7vox(ninter) )
99 comm_tri7vox(1:ninter)%INIT=.true.
100
101 need_comm_inacti = .false.
102 nb_inter_7_inacti = 0
103 ALLOCATE( list_inter_7_inacti(ninter) )
104 list_inter_7_inacti(1:ninter) = 0
105 need_comm_int25_solid_erosion(1:nspmd) = .false.
106 ! -----------------------------
107! loop over the interface
108 DO kk=1,nbintc
109 nin = intlist(kk)
110 nty =ipari(7,nin)
111 IF(ircvfrom(nin,ispmd+1)==0.or.isendto(nin,ispmd+1)==0) THEN
112 color_crit = mpi_undefined
113 intbuf_tab(nin)%belongs_to_comm_crit = .false.
114 key = 0
115 ELSE
116 color_crit = 1
117 intbuf_tab(nin)%belongs_to_comm_crit = .true.
118 key = ispmd
119 ENDIF
120 CALL mpi_comm_split(spmd_comm_world,color_crit,key,intbuf_tab(nin)%MPI_COMM_CRIT,code)
121! -----------------------------
122! only tag the TYPE07 interface
123 IF(nty==7) THEN
124 IF(comm_tri7vox(nin)%INIT) THEN
125 i=0
126 ALLOCATE(comm_tri7vox(nin)%PROC_LIST(nspmd))
127 ALLOCATE(sort_comm(nin)%PROC_LIST(nspmd))
128 comm_tri7vox(nin)%PROC_LIST(1:nspmd) = 0
129 comm_tri7vox(nin)%RANK = -1
130 ! list of processor for a given interface
131 DO p=1,nspmd
132 IF(ircvfrom(nin,p)/=0.or.isendto(nin,p)/=0) THEN
133 i=i+1
134 comm_tri7vox(nin)%PROC_LIST(i) = p
135 ENDIF
136 ENDDO
137 sort_comm(nin)%PROC_LIST(1:nspmd) = comm_tri7vox(nin)%PROC_LIST(1:nspmd)
138 comm_tri7vox(nin)%PROC_NUMBER = i
139 sort_comm(nin)%PROC_NUMBER = i
140 comm_tri7vox(nin)%PROC_MIN = -1
141 comm_tri7vox(nin)%RANK=-1
142 comm_tri7vox(nin)%COMM=-1
143 ! compute the main proc for a given interface
144 DO i = 1,comm_tri7vox(nin)%PROC_NUMBER
145 comm_tri7vox(nin)%PROC_MIN = min(comm_tri7vox(nin)%PROC_MIN,comm_tri7vox(nin)%PROC_LIST(i))
146 ENDDO
147 ! color the processor
148 IF(ircvfrom(nin,ispmd+1)==0.and.isendto(nin,ispmd+1)==0) THEN
149 comm_tri7vox(nin)%COLOR=0
150 key = 0
151 ELSE
152 comm_tri7vox(nin)%COLOR=1
153 key = 1
154 ENDIF
155 ! create the communicator
156 CALL mpi_comm_split(spmd_comm_world,comm_tri7vox(nin)%COLOR,key,comm_tri7vox(nin)%COMM,code)
157 CALL mpi_comm_split(spmd_comm_world,comm_tri7vox(nin)%COLOR,key,sort_comm(nin)%COMM,code)
158 IF(comm_tri7vox(nin)%COLOR==1) THEN
159 CALL mpi_comm_rank(comm_tri7vox(nin)%comm,comm_tri7vox(nin)%RANK,code)
160 ENDIF
161 comm_tri7vox(nin)%INIT = .false.
162 ENDIF
163 ! ------------------------------
164 inacti = ipari(22,nin)
165 ifq = ipari(31,nin)
166 itied = ipari(85,nin)
167 IF(impl_s==0.OR.neig==0) THEN
168 IF( inacti==5.OR.inacti==6.OR.ifq>0.OR.itied/=0)THEN
169 need_comm_inacti = .true.
170 nb_inter_7_inacti = nb_inter_7_inacti + 1
171 list_inter_7_inacti(nin) = nb_inter_7_inacti
172 ENDIF
173 ENDIF
174 ! ------------------------------
175 ENDIF
176
177 ! ------------------------------
178 ! communicator for interface type 25 with solid erosion
179 solid_erosion = ipari(100,nin)
180 idel = ipari(17,nin)! idel option
181 idelkeep = ipari(61,nin)
182 IF(nty==25.AND.ipari(100,nin)>0.AND.idelkeep/=1) THEN
183 ! ---------------
184 ! check if the proc has S or M node
185 DO p=1,nspmd
186 IF(isendto(nin,p)>0.OR.ircvfrom(nin,p)>0) THEN
187 need_comm_int25_solid_erosion(p) = .true.
188 ENDIF
189 ENDDO
190 ! ---------------
191 ENDIF
192 ENDDO
193 ! -----------------------------
194
195 ! -----------------------------
196 ! color the processor for inacti option
197 IF(.NOT.need_comm_inacti) THEN
198 color_inacti = 0
199 key = 0
200 ELSE
201 color_inacti = 1
202 key = 1
203 ENDIF
204 ! create the communicator for the spmd_get_inacti communication
205 CALL mpi_comm_split(spmd_comm_world,color_inacti,key,comm_inacti,code)
206 ! -----------------------------
207
208 ! -----------------------------
209 ! color the processor for interface type 25 + solid erosion option
210 IF(.NOT.need_comm_int25_solid_erosion(ispmd+1)) THEN
211 color_int25_solid_erosion = 0
212 key = 0
213 ELSE
214 color_int25_solid_erosion = 1
215 key = 1
216 ENDIF
217 ! create the communicator for the type25+solid erosion communication
218 CALL mpi_comm_split(spmd_comm_world,color_int25_solid_erosion,key,comm_int25_solid_erosion,code)
219 ! -----------------------------
220#endif
221 RETURN
222 END SUBROUTINE spmd_split_comm_inter
223C
224
min
#define min(a, b)
Definition macros.h:20
mpi_comm_split
subroutine mpi_comm_split(comm, color, key, comm2, ierr)
Definition mpi.f:272
mpi_comm_rank
subroutine mpi_comm_rank(comm, rank, ierr)
Definition mpi.f:254
comm_tri7vox_mod
Definition comm_tri7vox_mod.F:29
comm_tri7vox_mod::comm_tri7vox
type(comm_tri7vox_type), dimension(:), allocatable comm_tri7vox
Definition comm_tri7vox_mod.F:60
inter_sorting_mod
Definition inter_sorting_mod.F:57
inter_sorting_mod::nb_inter_7_inacti
integer nb_inter_7_inacti
Definition inter_sorting_mod.F:63
inter_sorting_mod::list_inter_7_inacti
integer, dimension(:), allocatable list_inter_7_inacti
Definition inter_sorting_mod.F:64
inter_sorting_mod::need_comm_inacti
logical need_comm_inacti
Definition inter_sorting_mod.F:60
inter_sorting_mod::comm_inacti
integer comm_inacti
Definition inter_sorting_mod.F:66
inter_struct_mod
Definition inter_struct_mod.F:49
spmd_split_comm_inter
subroutine spmd_split_comm_inter(intbuf_tab, nbintc, intlist, ipari, isendto, ircvfrom, sort_comm, need_comm_int25_solid_erosion, comm_int25_solid_erosion)
Definition spmd_split_comm_inter.F:37
inter_sorting_mod::sorting_comm_type
Definition inter_sorting_mod.F:91