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( 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 integer, intent(in) :: NBINTC
75 integer, dimension(NINTER), intent(in) :: INTLIST
76 integer, dimension(NPARI,NINTER), intent(in) :: IPARI
77 integer,dimension(NINTER+1,NSPMD+1), intent(in) :: ISENDTO,IRCVFROM
78 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
79
80 LOGICAL, 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
81 INTEGER, INTENT(inout) :: COMM_INT25_SOLID_EROSION !< integer, sub-communicator related to interface type 25 with solid erosion
82
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86#ifdef MPI
87
88 INTEGER :: KEY,CODE,I,P
89 INTEGER :: NIN,KK,NTY
90 INTEGER :: COLOR_INACTI,COLOR_INT25_SOLID_EROSION
91 INTEGER :: INACTI,IFQ,ITIED
92 INTEGER :: IDEL,IDELKEEP,ITY,SOLID_EROSION
93C-----------------------------------------------
94C S o u r c e L i n e s
95C-----------------------------------------------
96 ALLOCATE( comm_tri7vox(ninter) )
97 comm_tri7vox(1:ninter)%INIT=.true.
98
99 need_comm_inacti = .false.
100 nb_inter_7_inacti = 0
101 ALLOCATE( list_inter_7_inacti(ninter) )
102 list_inter_7_inacti(1:ninter) = 0
103 need_comm_int25_solid_erosion = .false.
104! -----------------------------
105! loop over the interface
106 DO kk=1,nbintc
107 nin = intlist(kk)
108 nty =ipari(7,nin)
109! -----------------------------
110! only tag the TYPE07 interface
111 IF(nty==7) THEN
112 IF(comm_tri7vox(nin)%INIT) THEN
113 i=0
114 ALLOCATE(comm_tri7vox(nin)%PROC_LIST(nspmd))
115 ALLOCATE(sort_comm(nin)%PROC_LIST(nspmd))
116 comm_tri7vox(nin)%PROC_LIST(1:nspmd) = 0
117 comm_tri7vox(nin)%RANK = -1
118 ! list of processor for a given interface
119 DO p=1,nspmd
120 IF(ircvfrom(nin,p)/=0.or.isendto(nin,p)/=0) THEN
121 i=i+1
122 comm_tri7vox(nin)%PROC_LIST(i) = p
123 ENDIF
124 ENDDO
125 sort_comm(nin)%PROC_LIST(1:nspmd) = comm_tri7vox(nin)%PROC_LIST(1:nspmd)
126 comm_tri7vox(nin)%PROC_NUMBER = i
127 sort_comm(nin)%PROC_NUMBER = i
128 comm_tri7vox(nin)%PROC_MIN = -1
129 comm_tri7vox(nin)%RANK=-1
130 comm_tri7vox(nin)%COMM=-1
131 ! compute the main proc for a given interface
132 DO i = 1,comm_tri7vox(nin)%PROC_NUMBER
133 comm_tri7vox(nin)%PROC_MIN = min(comm_tri7vox(nin)%PROC_MIN,comm_tri7vox(nin)%PROC_LIST(i))
134 ENDDO
135 ! color the processor
136 IF(ircvfrom(nin,ispmd+1)==0.and.isendto(nin,ispmd+1)==0) THEN
137 comm_tri7vox(nin)%COLOR=0
138 key = 0
139 ELSE
140 comm_tri7vox(nin)%COLOR=1
141 key = 1
142 ENDIF
143 ! create the communicator
144 CALL mpi_comm_split(spmd_comm_world,comm_tri7vox(nin)%COLOR,key,comm_tri7vox(nin)%COMM,code)
145 CALL mpi_comm_split(spmd_comm_world,comm_tri7vox(nin)%COLOR,key,sort_comm(nin)%COMM,code)
146 IF(comm_tri7vox(nin)%COLOR==1) THEN
147 CALL mpi_comm_rank(comm_tri7vox(nin)%comm,comm_tri7vox(nin)%RANK,code)
148 ENDIF
149 comm_tri7vox(nin)%INIT = .false.
150 ENDIF
151 ! ------------------------------
152 inacti = ipari(22,nin)
153 ifq = ipari(31,nin)
154 itied = ipari(85,nin)
155 IF(impl_s==0.OR.neig==0) THEN
156 IF( inacti==5.OR.inacti==6.OR.ifq>0.OR.itied/=0)THEN
157 need_comm_inacti = .true.
158 nb_inter_7_inacti = nb_inter_7_inacti + 1
159 list_inter_7_inacti(nin) = nb_inter_7_inacti
160 ENDIF
161 ENDIF
162 ! ------------------------------
163 ENDIF
164
165 ! ------------------------------
166 ! communicator for interface type 25 with solid erosion
167 solid_erosion = ipari(100,nin)
168 idel = ipari(17,nin)! idel option
169 idelkeep = ipari(61,nin)
170 IF(nty==25.AND.ipari(100,nin)>0.AND.idelkeep/=1) THEN
171 ! ---------------
172 ! check if the proc has S or M node
173 IF(isendto(nin,ispmd+1)>0.OR.ircvfrom(nin,ispmd+1)>0) THEN
174 need_comm_int25_solid_erosion = .true.
175 ENDIF
176 ! ---------------
177 ENDIF
178 ENDDO
179! -----------------------------
180
181! -----------------------------
182 ! color the processor for inacti option
183 IF(.NOT.need_comm_inacti) THEN
184 color_inacti = 0
185 key = 0
186 ELSE
187 color_inacti = 1
188 key = 1
189 ENDIF
190 ! create the communicator for the spmd_get_inacti communication
191 CALL mpi_comm_split(spmd_comm_world,color_inacti,key,comm_inacti,code)
192! -----------------------------
193
194! -----------------------------
195 ! color the processor for interface type 25 + solid erosion option
196 IF(.NOT.need_comm_int25_solid_erosion) THEN
197 color_int25_solid_erosion = 0
198 key = 0
199 ELSE
200 color_int25_solid_erosion = 1
201 key = 1
202 ENDIF
203 ! create the communicator for the type25+solid erosion communication
204 CALL mpi_comm_split(spmd_comm_world,color_int25_solid_erosion,key,comm_int25_solid_erosion,code)
205c write(*,*) 'need comm',ispmd,NEED_COMM_INT25_SOLID_EROSION
206! -----------------------------
207#endif
208 RETURN
209 END SUBROUTINE spmd_split_comm_inter
210C
211
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(nbintc, intlist, ipari, isendto, ircvfrom, sort_comm, need_comm_int25_solid_erosion, comm_int25_solid_erosion)
Definition spmd_split_comm_inter.F:37