OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_gr_entity.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!|| w_gr_entity_e ../starter/source/restart/ddsplit/w_gr_entity.F
25!||--- called by ------------------------------------------------------
26!|| w_group_str ../starter/source/restart/ddsplit/w_group_str.F
27!||--- calls -----------------------------------------------------
28!|| fretitl ../starter/source/starter/freform.F
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE w_gr_entity_e(IGR ,NGR ,LEN_IA ,LENIGR ,CEP,
32 . CEL ,PROC ,ESHIFT )
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE groupdef_mod
37 USE names_and_titles_mod , ONLY : nchartitle
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "scr17_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER NGR,LEN_IA,LENIGR,CEP(*),CEL(*),PROC,ESHIFT
50!
51 TYPE (GROUP_) , DIMENSION(NGR) :: IGR
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER I,J,ID,IGU,NENTITY,GRTYPE,TRI,GRPGRP,LEVEL,R2R_ALL,
56 . r2r_share,l_group,err,ititle1(ltitr),entity,
57 . nentity_l(ngr)
58 CHARACTER(LEN=NCHARTITLE) :: TITR
59 INTEGER, ALLOCATABLE, DIMENSION (:) :: IGROUP_L
60C-----------------------------------------------
61 DO igu=1,ngr
62 titr = igr(igu)%TITLE
63 CALL fretitl(titr,ititle1,ltitr)
64 CALL write_i_c(ititle1,ltitr)
65 ENDDO ! DO IGU=1,NGR
66 len_ia = len_ia + ngr
67!
68 err = 0
69 ALLOCATE (igroup_l(lenigr), stat=err)
70 igroup_l(1:lenigr) = 0
71!
72 DO igu=1,ngr
73 nentity = igr(igu)%NENTITY
74 nentity_l(igu) = 0
75 DO j=1,nentity
76 entity = igr(igu)%ENTITY(j)
77 IF (entity > 0) THEN
78 entity = entity + eshift
79 IF (cep(entity) == proc) nentity_l(igu) = nentity_l(igu) + 1
80 ENDIF
81 ENDDO
82 ENDDO ! DO IGU=1,NGR
83!
84 l_group = 0
85!
86 DO igu=1,ngr
87 id = igr(igu)%ID
88 nentity = igr(igu)%NENTITY
89 grtype = igr(igu)%GRTYPE
90 tri = igr(igu)%SORTED
91 grpgrp = igr(igu)%GRPGRP
92 level = igr(igu)%LEVEL
93 titr = igr(igu)%TITLE
94 r2r_all = igr(igu)%R2R_ALL
95 r2r_share= igr(igu)%R2R_SHARE
96 igroup_l(l_group+1) = id
97 l_group = l_group+1
98 igroup_l(l_group+1) = nentity_l(igu)
99 l_group = l_group+1
100 igroup_l(l_group+1) = grtype
101 l_group = l_group+1
102 igroup_l(l_group+1) = tri
103 l_group = l_group+1
104 igroup_l(l_group+1) = grpgrp
105 l_group = l_group+1
106 igroup_l(l_group+1) = level
107 l_group = l_group+1
108! IGROUP_L(L_GROUP+1) = TITR !!! written above for all groups
109! L_GROUP = L_GROUP+1
110 igroup_l(l_group+1) = r2r_all
111 l_group = l_group+1
112 igroup_l(l_group+1) = r2r_share
113 l_group = l_group+1
114!
115! GROUP ENTITIES
116!
117 DO j=1,nentity
118 entity = igr(igu)%ENTITY(j)
119 IF (entity > 0) THEN
120 entity = entity + eshift
121 IF (cep(entity) == proc) THEN
122 igroup_l(l_group+1) = cel(entity)
123 l_group = l_group+1
124 ENDIF
125 ENDIF
126 ENDDO
127 ENDDO ! DO IGU=1,NGR
128!---------
129 CALL write_i_c(igroup_l,l_group)
130!---------
131 DEALLOCATE (igroup_l)
132!---------
133 len_ia = len_ia + l_group
134!---------
135 RETURN
136 END
137!||====================================================================
138!|| w_gr_entity_p ../starter/source/restart/ddsplit/w_gr_entity.F
139!||--- called by ------------------------------------------------------
140!|| w_group_str ../starter/source/restart/ddsplit/w_group_str.F
141!||--- calls -----------------------------------------------------
142!|| fretitl ../starter/source/starter/freform.F
143!||--- uses -----------------------------------------------------
144!||====================================================================
145 SUBROUTINE w_gr_entity_p(IGR ,NGR ,LEN_IA ,LENIGR ,CEP,
146 . CEL ,PROC )
147C-----------------------------------------------
148C M o d u l e s
149C-----------------------------------------------
150 USE groupdef_mod
151C-----------------------------------------------
152C I m p l i c i t T y p e s
153C-----------------------------------------------
154#include "implicit_f.inc"
155C-----------------------------------------------
156C C o m m o n B l o c k s
157C-----------------------------------------------
158#include "scr17_c.inc"
159C-----------------------------------------------
160C D u m m y A r g u m e n t s
161C-----------------------------------------------
162 INTEGER NGR,LEN_IA,LENIGR,CEP(*),CEL(*),PROC
163!
164 TYPE (GROUP_) , DIMENSION(NGR) :: IGR
165C-----------------------------------------------
166C L o c a l V a r i a b l e s
167C-----------------------------------------------
168 INTEGER I,J,ID,IGU,NENTITY,GRTYPE,TRI,GRPGRP,LEVEL,R2R_ALL,
169 . R2R_SHARE,L_GROUP,ERR,ITITLE2(LTITR),ENTITY,NENTITY_L
170 CHARACTER(LEN=nchartitle) :: TITR
171! CHARACTER(LEN=NCHARTITLE)::TITR
172 INTEGER, ALLOCATABLE, DIMENSION (:) :: IGROUP_L
173C-----------------------------------------------
174 DO igu=1,ngr
175 titr = igr(igu)%TITLE
176 CALL fretitl(titr,ititle2,ltitr)
177 CALL write_i_c(ititle2,ltitr)
178 ENDDO ! DO IGU=1,NGR
179 len_ia = len_ia + ngr
180!
181 err = 0
182 ALLOCATE (igroup_l(lenigr), stat=err)
183 igroup_l(1:lenigr) = 0
184!
185 l_group = 0
186!
187 DO igu=1,ngr
188 id = igr(igu)%ID
189 nentity = igr(igu)%NENTITY
190 grtype = igr(igu)%GRTYPE
191 tri = igr(igu)%SORTED
192 grpgrp = igr(igu)%GRPGRP
193 level = igr(igu)%LEVEL
194 titr = igr(igu)%TITLE
195 r2r_all = igr(igu)%R2R_ALL
196 r2r_share= igr(igu)%R2R_SHARE
197!
198! GROUP ENTITIES
199!
200!
201 igroup_l(l_group+1) = id
202 l_group = l_group+1
203 igroup_l(l_group+1) = nentity
204 l_group = l_group+1
205 igroup_l(l_group+1) = grtype
206 l_group = l_group+1
207 igroup_l(l_group+1) = tri
208 l_group = l_group+1
209 igroup_l(l_group+1) = grpgrp
210 l_group = l_group+1
211 igroup_l(l_group+1) = level
212 l_group = l_group+1
213! IGROUP_L(L_GROUP+1) = TITR !!! written above for all groups
214! L_GROUP = L_GROUP+1
215 igroup_l(l_group+1) = r2r_all
216 l_group = l_group+1
217 igroup_l(l_group+1) = r2r_share
218 l_group = l_group+1
219!
220! GROUP ENTITIES
221!
222 DO j=1,nentity
223 entity = igr(igu)%ENTITY(j)
224 IF (entity > 0) THEN
225 igroup_l(l_group+1) = entity
226 l_group = l_group+1
227 ENDIF
228 ENDDO
229 ENDDO ! DO IGU=1,NGR
230!---------
231 CALL write_i_c(igroup_l,l_group)
232!---------
233 DEALLOCATE (igroup_l)
234!---------
235 len_ia = len_ia + l_group
236!---------
237 RETURN
238 END
239!||====================================================================
240!|| w_gr_entity_n ../starter/source/restart/ddsplit/w_gr_entity.F
241!||--- called by ------------------------------------------------------
242!|| w_group_str ../starter/source/restart/ddsplit/w_group_str.F
243!||--- calls -----------------------------------------------------
244!|| fretitl ../starter/source/starter/freform.F
245!||--- uses -----------------------------------------------------
246!||====================================================================
247 SUBROUTINE w_gr_entity_n(IGR ,NGR ,LEN_IA ,LENIGR ,NODLOCAL,
248 . PROC ,FRONTB_R2R,NUMNOD_L)
249C-----------------------------------------------
250C M o d u l e s
251C-----------------------------------------------
252 USE names_and_titles_mod , ONLY : nchartitle
253 USE groupdef_mod , ONLY : group_
254C-----------------------------------------------
255C I m p l i c i t T y p e s
256C-----------------------------------------------
257#include "implicit_f.inc"
258C-----------------------------------------------
259C C o m m o n B l o c k s
260C-----------------------------------------------
261#include "scr17_c.inc"
262#include "com04_c.inc"
263#include "r2r_c.inc"
264C-----------------------------------------------
265C D u m m y A r g u m e n t s
266C-----------------------------------------------
267 INTEGER NGR,LEN_IA,LENIGR,PROC,
268 . FRONTB_R2R(SFRONTB_R2R,*),NUMNOD_L
269 INTEGER, DIMENSION(*), INTENT(IN) :: NODLOCAL
270!
271 TYPE (GROUP_) , DIMENSION(NGR) :: IGR
272! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
273! NODLOCAL : integer, dimension=NUMNOD
274! gives the local ID of a global element
275! --> used here to avoid NLOCAL call (the NLOCAL perf is bad)
276! NODLOCAL /= 0 if the element is on the current domain/processor
277! and =0 if the element is not on the current domain
278! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
279C-----------------------------------------------
280C F u n c t i o n
281C-----------------------------------------------
282! INTEGER NLOCAL
283! EXTERNAL NLOCAL
284C-----------------------------------------------
285C L o c a l V a r i a b l e s
286C-----------------------------------------------
287 INTEGER I,J,ID,IGU,NOD,NNOD,GRTYPE,TRI,GRPGRP,LEVEL,R2R_ALL,
288 . R2R_SHARE,L_GROUP,ERR,ITITLE3(LTITR),NNOD_LOC(NGR),
289 . IGU1,IGU2
290 my_real code
291 CHARACTER(LEN=NCHARTITLE) :: TITR
292 INTEGER, ALLOCATABLE, DIMENSION (:) :: IGROUP_L
293C-----------------------------------------------
294 DO igu=1,ngr
295 titr = igr(igu)%TITLE
296 CALL fretitl(titr,ititle3,ltitr)
297 CALL write_i_c(ititle3,ltitr)
298 ENDDO ! DO IGU=1,NGR
299 len_ia = len_ia + ngr
300!
301 err = 0
302 ALLOCATE (igroup_l(lenigr), stat=err)
303 igroup_l(1:lenigr) = 0
304!
305 DO igu=1,ngr
306 nnod = igr(igu)%NENTITY
307 nnod_loc(igu) = 0
308 DO j=1,nnod
309 nod = igr(igu)%ENTITY(j)
310 IF (nod > 0) THEN
311!---------multidomaines -> modif domdec
312 IF ((nsubdom>0).AND.(iddom==0)) THEN
313 IF (frontb_r2r(nod,proc+1)==igu) THEN
314 cycle
315 ELSEIF (frontb_r2r(nod,proc+1) > ngrnod) THEN
316 code = frontb_r2r(nod,proc+1)/ngrnod
317 igu1 = nint(code)
318 igu2 = frontb_r2r(nod,proc+1) - igu1*ngrnod
319 IF ((igu==igu1).OR.(igu==igu2)) cycle
320 ENDIF
321 ENDIF
322!---------
323 IF( nodlocal(nod)/=0.AND.nodlocal(nod)<=numnod_l ) nnod_loc(igu) = nnod_loc(igu) + 1
324 ENDIF
325 ENDDO
326 ENDDO ! DO IGU=1,NGR
327!
328 l_group = 0
329!
330 DO igu=1,ngr
331 id = igr(igu)%ID
332 nnod = igr(igu)%NENTITY
333 grtype = igr(igu)%GRTYPE
334 tri = igr(igu)%SORTED
335 grpgrp = igr(igu)%GRPGRP
336 level = igr(igu)%LEVEL
337 titr = igr(igu)%TITLE
338 r2r_all = igr(igu)%R2R_ALL
339 r2r_share= igr(igu)%R2R_SHARE
340 igroup_l(l_group+1) = id
341 l_group = l_group+1
342 igroup_l(l_group+1) = nnod_loc(igu)
343 l_group = l_group+1
344 igroup_l(l_group+1) = grtype
345 l_group = l_group+1
346 igroup_l(l_group+1) = tri
347 l_group = l_group+1
348 igroup_l(l_group+1) = grpgrp
349 l_group = l_group+1
350 igroup_l(l_group+1) = level
351 l_group = l_group+1
352! IGROUP_L(L_GROUP+1) = TITR !!! written above for all groups
353! L_GROUP = L_GROUP+1
354 igroup_l(l_group+1) = r2r_all
355 l_group = l_group+1
356 igroup_l(l_group+1) = r2r_share
357 l_group = l_group+1
358!
359! GROUP ENTITIES (--- NODES ---)
360!
361 DO j=1,nnod
362 nod = igr(igu)%ENTITY(j)
363 IF (nod > 0) THEN
364!---------multidomaines -> modif domdec
365 IF ((nsubdom>0).AND.(iddom==0)) THEN
366 IF (frontb_r2r(nod,proc+1)==igu) THEN
367 cycle
368 ELSEIF (frontb_r2r(nod,proc+1) > ngrnod) THEN
369 code = frontb_r2r(nod,proc+1)/ngrnod
370 igu1 = nint(code)
371 igu2 = frontb_r2r(nod,proc+1) - igu1*ngrnod
372 IF ((igu==igu1).OR.(igu==igu2)) cycle
373 ENDIF
374 ENDIF
375!---------
376 IF( nodlocal(nod)/=0.AND.nodlocal(nod)<=numnod_l ) THEN
377 igroup_l(l_group+1) = nodlocal(nod)
378 l_group = l_group+1
379 ENDIF
380 ENDIF
381 ENDDO ! DO J=1,NNOD
382 ENDDO ! DO IGU=1,NGR
383!---------
384 CALL write_i_c(igroup_l,l_group)
385!---------
386 DEALLOCATE (igroup_l)
387!---------
388 len_ia = len_ia + l_group
389!---------
390 RETURN
391 END
my_real
#define my_real
Definition cppsort.cpp:32
groupdef_mod
Definition groupdef_mod.F:662
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
w_gr_entity_e
subroutine w_gr_entity_e(igr, ngr, len_ia, lenigr, cep, cel, proc, eshift)
Definition w_gr_entity.F:33
w_gr_entity_p
subroutine w_gr_entity_p(igr, ngr, len_ia, lenigr, cep, cel, proc)
Definition w_gr_entity.F:147
w_gr_entity_n
subroutine w_gr_entity_n(igr, ngr, len_ia, lenigr, nodlocal, proc, frontb_r2r, numnod_l)
Definition w_gr_entity.F:249
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
groupdef_mod::group_
Definition groupdef_mod.F:700
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645