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 OF THE 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 WITH REMOVAL OF DOUBLE Nos
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 SEARCH FOR ELEMENTS OF LIST() IN IX()
120C ALGO < NLIST+NUMEL
121C-----------------------
122 I=1
123 J=1
124 DO I=1,NEL
125.AND. DO WHILE(LIST(I)>IX1(J)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 OF THE 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 WITH REMOVAL OF DOUBLE Nos
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 SEARCH FOR ELEMENTS OF LIST() IN IX()
269C ALGO < NLIST+NUMEL
270C-----------------------
271 I=1
272 J=1
273 DO I=1,NEL
274.AND. DO WHILE(LIST(I)>IX1(J)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
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008