OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_gr_entity.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine w_gr_entity_e (igr, ngr, len_ia, lenigr, cep, cel, proc, eshift)
subroutine w_gr_entity_p (igr, ngr, len_ia, lenigr, cep, cel, proc)
subroutine w_gr_entity_n (igr, ngr, len_ia, lenigr, nodlocal, proc, frontb_r2r, numnod_l)

Function/Subroutine Documentation

◆ w_gr_entity_e()

subroutine w_gr_entity_e ( type (group_), dimension(ngr) igr,
integer ngr,
integer len_ia,
integer lenigr,
integer, dimension(*) cep,
integer, dimension(*) cel,
integer proc,
integer eshift )

Definition at line 31 of file w_gr_entity.F.

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
id
initmumps id
Definition multiplerhs_example.m:4
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
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645

◆ w_gr_entity_n()

subroutine w_gr_entity_n ( type (group_), dimension(ngr) igr,
integer ngr,
integer len_ia,
integer lenigr,
integer, dimension(*), intent(in) nodlocal,
integer proc,
integer, dimension(sfrontb_r2r,*) frontb_r2r,
integer numnod_l )

Definition at line 247 of file w_gr_entity.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
the
end diagonal values have been computed in the(sparse) matrix id.SOL
groupdef_mod::group_
Definition groupdef_mod.F:700

◆ w_gr_entity_p()

subroutine w_gr_entity_p ( type (group_), dimension(ngr) igr,
integer ngr,
integer len_ia,
integer lenigr,
integer, dimension(*) cep,
integer, dimension(*) cel,
integer proc )

Definition at line 145 of file w_gr_entity.F.

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