OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admlist.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!|| admlcnt ../starter/source/model/remesh/admlist.f
25!||--- calls -----------------------------------------------------
26!|| ancmsg ../starter/source/output/message/message.F
27!|| my_exit ../starter/source/output/analyse/analyse.c
28!||--- uses -----------------------------------------------------
29!|| format_mod ../starter/share/modules1/format_mod.F90
30!|| message_mod ../starter/share/message_module/message_mod.F
31!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
32!||====================================================================
33 SUBROUTINE admlcnt(NIX ,IX ,NUMEL ,IPARTEL ,IPART ,
34 . KELTREE ,ELTREE ,KSONTREE ,NSONTREE,KLEVTREE,
35 . NLIST ,MESS ,IX1 ,IX2 ,INDEX ,
36 . KK ,NEL ,TYPE ,ID ,TITR)
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
168 END
169!||====================================================================
170!|| admlist ../starter/source/model/remesh/admlist.F
171!||--- calls -----------------------------------------------------
172!|| ancmsg ../starter/source/output/message/message.F
173!|| my_exit ../starter/source/output/analyse/analyse.c
174!||--- uses -----------------------------------------------------
175!|| format_mod ../starter/share/modules1/format_mod.f90
176!|| message_mod ../starter/share/message_module/message_mod.F
177!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
178!||====================================================================
179 SUBROUTINE admlist(NIX ,IX ,NUMEL ,IPARTEL ,IPART ,
180 . KELTREE ,ELTREE ,KSONTREE,NSONTREE ,KLEVTREE,
181 . NLIST ,MESS ,IX1 ,IX2 ,INDEX ,
182 . KK ,NEL ,NELT ,TYPE ,ID ,
183 . TITR)
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
339 END
admlcnt
subroutine admlcnt(nix, ix, numel, ipartel, ipart, keltree, eltree, ksontree, nsontree, klevtree, nlist, mess, ix1, ix2, index, kk, nel, type, id, titr)
Definition admlist.F:37
admlist
subroutine admlist(nix, ix, numel, ipartel, ipart, keltree, eltree, ksontree, nsontree, klevtree, nlist, mess, ix1, ix2, index, kk, nel, nelt, type, id, titr)
Definition admlist.F:184
my_exit
void my_exit(int *i)
Definition analyse.c:1038
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
starter
program starter
Definition starter.F:39