OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admlist.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "units_c.inc"
#include "remesh_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine admlcnt (nix, ix, numel, ipartel, ipart, keltree, eltree, ksontree, nsontree, klevtree, nlist, mess, ix1, ix2, index, kk, nel, type, id, titr)
subroutine admlist (nix, ix, numel, ipartel, ipart, keltree, eltree, ksontree, nsontree, klevtree, nlist, mess, ix1, ix2, index, kk, nel, nelt, type, id, titr)

Function/Subroutine Documentation

◆ admlcnt()

subroutine admlcnt ( integer nix,
integer, dimension(nix,*) ix,
integer numel,
integer, dimension(*) ipartel,
integer, dimension(lipart1,*) ipart,
integer keltree,
integer, dimension(keltree,*) eltree,
integer ksontree,
integer nsontree,
integer klevtree,
integer nlist,
character mess,
integer, dimension(*) ix1,
integer, dimension(*) ix2,
integer, dimension(*) index,
integer kk,
integer nel,
character(len=nchartitle) type,
integer id,
character(len=nchartitle) titr )

Definition at line 33 of file admlist.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE message_mod
41 USE format_mod , ONLY : fmt_10i
42 USE names_and_titles_mod , ONLY : nchartitle
43 USE reader_old_mod , ONLY : line, irec
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "scr17_c.inc"
52#include "units_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER NIX, IX(NIX,*), NUMEL, IPARTEL(*), IPART(LIPART1,*),
57 . KELTREE, ELTREE(KELTREE,*), KSONTREE, NSONTREE, KLEVTREE,
58 . NLIST,IX1(*), IX2(*), INDEX(*), KK, NEL, LEVEL
59 CHARACTER MESS*40
60 INTEGER ID
61 CHARACTER(LEN=NCHARTITLE) :: TITR,TYPE
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER LIST(NLIST), IL, JREC, J10(10)
66 INTEGER I, J, NOLD, K, IWORK(70000)
67 INTEGER LELT, NE, IP, NLEV
68C-----------------------------------------------
69C CONSTITUTION DE LIST
70C-----------------------------------------------
71 il =0
72C
73 jrec=irec
74 jrec=jrec+1
75 READ(iin,rec=jrec,err=999,fmt='(A)')line
76 DO WHILE(line(1:1)/='/')
77 READ(line,err=999,fmt=fmt_10i) j10
78 DO i=1,10
79 IF(j10(i)/=0)THEN
80 il=il+1
81 list(il)=j10(i)
82 END IF
83 ENDDO
84 jrec=jrec+1
85 READ(iin,rec=jrec,err=999,fmt='(A)')line
86 ENDDO
87C-----------------------
88C TRI DE LIST EN ORDRE CROISSANT
89C AVEC SUPPRESSION DES No DOUBLES
90C-----------------------
91 CALL my_orders(0,iwork,list,index,nlist,1)
92 DO i=1,nlist
93 index(nlist+i) = list(index(i))
94 ENDDO
95 k=1
96 nold = index(nlist+1)
97 DO i=1,nlist
98 IF(nold/=index(nlist+i))k=k+1
99 list(k) = index(nlist+i)
100 nold = index(nlist+i)
101 ENDDO
102 nel=k
103C-----------------------
104C TRI DE IX EN ORDRE CROISSANT si KK = 0
105C-----------------------
106 IF(kk==0)THEN
107 DO i=1,numel
108 ix2(i) = ix(nix,i)
109 ENDDO
110 CALL my_orders(0,iwork,ix2,index,numel,1)
111 DO i=1,numel
112 ix1(i) = ix2(index(i))
113 ENDDO
114 DO i=1,numel
115 ix2(i) = index(i)
116 ENDDO
117 ENDIF
118C-----------------------
119C RECHERCHE DES ELEMENTS DE LIST() DANS IX()
120C ALGO < NLIST+NUMEL
121C-----------------------
122 i=1
123 j=1
124 DO i=1,nel
125 DO WHILE(list(i)>ix1(j).AND.j<numel)
126 j=j+1
127 ENDDO
128 IF(list(i)==ix1(j))THEN
129 list(i)=ix2(j)
130 ELSE
131 CALL ancmsg(msgid=70,
132 . msgtype=msgerror,
133 . anmode=aninfo,
134 . c1=TYPE,
135 . I1=id,
136 . c2=titr,
137 . i2=list(i))
138 RETURN
139 ENDIF
140 ENDDO
141C-----------------------
142C
143C-----------------------
144 lelt = 0
145C
146 DO i=1,nel
147
148 ne=list(i)
149
150 ip=ipartel(ne)
151 nlev =ipart(10,ip)
152
153 level =eltree(klevtree,ne)
154 IF(level < 0) level=-(level+1)
155
156 lelt=lelt+nsontree**(nlev-level)
157
158 END DO
159C
160 nel=lelt
161C-----------------------
162 RETURN
163 999 CALL freerr(1)
164 CALL my_exit(2)
165
166
167 RETURN
my_exit
void my_exit(int *i)
Definition analyse.c:1038
id
initmumps id
Definition multiplerhs_example.m:4
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
message_mod
Definition message_mod.F:1249
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
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
freerr
subroutine freerr(it)
Definition freform.F:506

◆ admlist()

subroutine admlist ( integer nix,
integer, dimension(nix,*) ix,
integer numel,
integer, dimension(*) ipartel,
integer, dimension(lipart1,*) ipart,
integer keltree,
integer, dimension(keltree,*) eltree,
integer ksontree,
integer nsontree,
integer klevtree,
integer nlist,
character mess,
integer, dimension(*) ix1,
integer, dimension(*) ix2,
integer, dimension(*) index,
integer kk,
integer nel,
integer, dimension(*) nelt,
character(len=nchartitle) type,
integer id,
character(len=nchartitle) titr )

Definition at line 179 of file admlist.F.

184C-----------------------------------------------
185C M o d u l e s
186C-----------------------------------------------
187 USE message_mod
188 USE names_and_titles_mod , ONLY : nchartitle
189 USE format_mod , ONLY : fmt_10i
190 USE reader_old_mod , ONLY : line, irec
191C-----------------------------------------------
192C I m p l i c i t T y p e s
193C-----------------------------------------------
194#include "implicit_f.inc"
195C-----------------------------------------------
196C G l o b a l P a r a m e t e r s
197C-----------------------------------------------
198#include "remesh_c.inc"
199#include "scr17_c.inc"
200#include "units_c.inc"
201C-----------------------------------------------
202C D u m m y A r g u m e n t s
203C-----------------------------------------------
204 INTEGER NIX, IX(NIX,*), NUMEL, IPARTEL(*), IPART(LIPART1,*),
205 . KELTREE, ELTREE(KELTREE,*), KSONTREE, NSONTREE, KLEVTREE,
206 . NLIST, IX1(*), IX2(*), INDEX(*), KK, NEL, NELT(*)
207 CHARACTER MESS*40
208 INTEGER ID
209 CHARACTER(LEN=NCHARTITLE) :: TITR,TYPE
210C-----------------------------------------------
211C L o c a l V a r i a b l e s
212C-----------------------------------------------
213 INTEGER LIST(NLIST), IL, JREC, J10(10)
214 INTEGER I, J, NOLD, K, IWORK(70000)
215 INTEGER LELT, LELT1, LELT2, NE, KE, IP, LEVEL, NLEV,
216 . LELTMP, NELTMP(NSONTREE**(LEVELMAX+1))
217C-----------------------------------------------
218C CONSTITUTION DE LIST
219C-----------------------------------------------
220 il =0
221C
222 jrec=irec
223 jrec=jrec+1
224 READ(iin,rec=jrec,err=999,fmt='(A)')line
225 DO WHILE(line(1:1)/='/')
226 READ(line,err=999,fmt=fmt_10i) j10
227 DO i=1,10
228 IF(j10(i)/=0)THEN
229 il=il+1
230 list(il)=j10(i)
231 END IF
232 ENDDO
233 jrec=jrec+1
234 READ(iin,rec=jrec,err=999,fmt='(A)')line
235 ENDDO
236C-----------------------
237C TRI DE LIST EN ORDRE CROISSANT
238C AVEC SUPPRESSION DES No DOUBLES
239C-----------------------
240 CALL my_orders(0,iwork,list,index,nlist,1)
241 DO i=1,nlist
242 index(nlist+i) = list(index(i))
243 ENDDO
244 k=1
245 nold = index(nlist+1)
246 DO i=1,nlist
247 IF(nold/=index(nlist+i))k=k+1
248 list(k) = index(nlist+i)
249 nold = index(nlist+i)
250 ENDDO
251 nel=k
252C-----------------------
253C TRI DE IX EN ORDRE CROISSANT si KK = 0
254C-----------------------
255 IF(kk==0)THEN
256 DO i=1,numel
257 ix2(i) = ix(nix,i)
258 ENDDO
259 CALL my_orders(0,iwork,ix2,index,numel,1)
260 DO i=1,numel
261 ix1(i) = ix2(index(i))
262 ENDDO
263 DO i=1,numel
264 ix2(i) = index(i)
265 ENDDO
266 ENDIF
267C-----------------------
268C RECHERCHE DES ELEMENTS DE LIST() DANS IX()
269C ALGO < NLIST+NUMEL
270C-----------------------
271 i=1
272 j=1
273 DO i=1,nel
274 DO WHILE(list(i)>ix1(j).AND.j<numel)
275 j=j+1
276 ENDDO
277 IF(list(i)==ix1(j))THEN
278 list(i)=ix2(j)
279 ELSE
280 CALL ancmsg(msgid=70, msgtype=msgerror, anmode=aninfo, c1=TYPE, I1=id, c2=titr, i2=list(i))
281 RETURN
282 ENDIF
283 ENDDO
284C-----------------------
285C
286C-----------------------
287 lelt = 0
288C
289 DO i=1,nel
290 ne=list(i)
291
292 ip=ipartel(ne)
293 nlev =ipart(10,ip)
294
295 IF(nlev==0)THEN
296 lelt=lelt+1
297 nelt(lelt)=ne
298 ELSE
299
300 leltmp =1
301 neltmp(1)=ne
302
303 level =eltree(klevtree,ne)
304 IF(level < 0) level=-(level+1)
305
306 lelt1=0
307 lelt2=leltmp
308
309 DO WHILE(level < nlev)
310 DO ke=lelt1+1,lelt2
311 DO k=0,nsontree-1
312 leltmp=leltmp+1
313 neltmp(leltmp)=eltree(ksontree,neltmp(ke))+k
314 END DO
315 END DO
316
317 lelt1=lelt2
318 lelt2=leltmp
319
320 level=level+1
321 END DO
322
323 DO ke=lelt1+1,lelt2
324 lelt=lelt+1
325 nelt(lelt)=neltmp(ke)
326 END DO
327
328 END IF
329 END DO
330C
331 nel=lelt
332C-----------------------
333 RETURN
334 999 CALL freerr(1)
335 CALL my_exit(2)
336
337
338 RETURN