OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ani_fasolfr.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine ani_fasolfr1 (ixs, ixc, ixtg, fastag, isolnod)
subroutine ani_fasolfr2 (fastag, fasolfr, isolnod)

Function/Subroutine Documentation

◆ ani_fasolfr1()

subroutine ani_fasolfr1 ( integer, dimension(nixs,*) ixs,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) fastag,
integer, dimension(*) isolnod )

Definition at line 31 of file ani_fasolfr.F.

32 use element_mod , only : nixs,nixc,nixtg
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40#include "com01_c.inc"
41#include "com04_c.inc"
42#include "units_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46C REAL
47 INTEGER
48 . IXS(NIXS,*),IXC(NIXC,*),IXTG(NIXTG,*),
49 . FASTAG(*),ISOLNOD(*)
50C-----------------------------------------------
51C L o c a l V a r i a b l e s
52C-----------------------------------------------
53 INTEGER, DIMENSION(:,:), ALLOCATABLE :: NELENOD
54 INTEGER, DIMENSION(:), ALLOCATABLE :: ELSNOD,ELCNOD,ELTGNOD,
55 . NODTAG,NODTAG_1
56 INTEGER N,NI,I,J,K,II,JJ,KK,LL,NN,JS,KS,
57 . IERROR
58 INTEGER FACES(4,6),PWR(7)
59 DATA faces/1,2,3,4,
60 . 2,1,5,6,
61 . 1,5,8,4,
62 . 5,6,7,8,
63 . 3,4,8,7,
64 . 2,6,7,3/
65 DATA pwr/1,2,4,8,16,32,64/
66C REAL
67C-----------------------------------------------
68C
69 ALLOCATE(nodtag(numnod), stat=ierror)
70 IF (ierror/=0) THEN
71 WRITE(istdo,'(A)') ' ANIM ...'
72 WRITE(istdo,'(A)')
73 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY'
74 WRITE(iout,'(A)') ' ANIM ...'
75 WRITE(iout,'(A)')
76 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY NODTAG'
77 CALL arret(2)
78 END IF
79 ALLOCATE(nodtag_1(numnod), stat=ierror)
80 IF (ierror/=0) THEN
81 WRITE(istdo,'(A)') ' ANIM ...'
82 WRITE(istdo,'(A)')
83 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY'
84 WRITE(iout,'(A)') ' ANIM ...'
85 WRITE(iout,'(A)')
86 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY NODTAG_1'
87 CALL arret(2)
88 END IF
89 ALLOCATE(nelenod(3,numnod+1), stat=ierror)
90 IF (ierror/=0) THEN
91 WRITE(istdo,'(A)') ' ANIM ...'
92 WRITE(istdo,'(A)')
93 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY'
94 WRITE(iout,'(A)') ' ANIM ...'
95 WRITE(iout,'(A)')
96 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY NELENOD'
97 CALL arret(2)
98 END IF
99 ALLOCATE(elsnod(8*numels), stat=ierror)
100 IF (ierror/=0) THEN
101 WRITE(istdo,'(A)') ' ANIM ...'
102 WRITE(istdo,'(A)')
103 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY'
104 WRITE(iout,'(A)') ' ANIM ...'
105 WRITE(iout,'(A)')
106 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY ELSNOD'
107 CALL arret(2)
108 END IF
109 ALLOCATE(elcnod(4*numelc), stat=ierror)
110 IF (ierror/=0) THEN
111 WRITE(istdo,'(A)') ' ANIM ...'
112 WRITE(istdo,'(A)')
113 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY'
114 WRITE(iout,'(A)') ' ANIM ...'
115 WRITE(iout,'(A)')
116 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY ELCNOD'
117 CALL arret(2)
118 END IF
119 ALLOCATE(eltgnod(3*numeltg), stat=ierror)
120 IF (ierror/=0) THEN
121 WRITE(istdo,'(A)') ' ANIM ...'
122 WRITE(istdo,'(A)')
123 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY'
124 WRITE(iout,'(A)') ' ANIM ...'
125 WRITE(iout,'(A)')
126 . ' UNABLE TO ALLOCATE MEMORY FOR WORK ARRAY ELTGNOD'
127 CALL arret(2)
128 END IF
129C
130 DO n=1,numels
131 fastag(n)=0
132 END DO
133C
134 DO n=1,numnod+1
135 nelenod(1,n)=0
136 nelenod(2,n)=0
137 nelenod(3,n)=0
138 END DO
139C
140C node -> solid
141 DO n=1,numels
142 DO i=1,8
143 ni=ixs(i+1,n)
144 nodtag_1(ni) = 0
145 ENDDO
146 DO i=1,8
147 ni=ixs(i+1,n)
148 IF (nodtag_1(ni) == 0) nelenod(1,ni+1)=nelenod(1,ni+1)+1
149 nodtag_1(ni) = 1
150 END DO
151 END DO
152C
153 DO n=1,numnod
154 nelenod(1,n+1)=nelenod(1,n+1)+nelenod(1,n)
155 END DO
156C
157 DO n=1,numels
158 DO i=1,8
159 ni=ixs(i+1,n)
160 nodtag_1(ni) = 0
161 ENDDO
162 DO i=1,8
163 ni=ixs(i+1,n)
164 IF (nodtag_1(ni) == 0) THEN
165 nelenod(1,ni)=nelenod(1,ni)+1
166 elsnod(nelenod(1,ni))=n
167 nodtag_1(ni) = 1
168 ENDIF
169 END DO
170 END DO
171C
172 DO n=numnod,1,-1
173 nelenod(1,n+1)=nelenod(1,n)
174 END DO
175 nelenod(1,1)=0
176C
177C node -> 4node shell
178 DO n=1,numelc
179 DO i=1,4
180 ni=ixc(i+1,n)
181 nelenod(2,ni+1)=nelenod(2,ni+1)+1
182 END DO
183 END DO
184C
185 DO n=1,numnod
186 nelenod(2,n+1)=nelenod(2,n+1)+nelenod(2,n)
187 END DO
188C
189 DO n=1,numelc
190 DO i=1,4
191 ni=ixc(i+1,n)
192 nelenod(2,ni)=nelenod(2,ni)+1
193 elcnod(nelenod(2,ni))=n
194 END DO
195 END DO
196C
197 DO n=numnod,1,-1
198 nelenod(2,n+1)=nelenod(2,n)
199 END DO
200 nelenod(2,1)=0
201C
202C node -> 3node shell
203 DO n=1,numeltg
204 DO i=1,3
205 ni=ixtg(i+1,n)
206 nelenod(3,ni+1)=nelenod(3,ni+1)+1
207 END DO
208 END DO
209C
210 DO n=1,numnod
211 nelenod(3,n+1)=nelenod(3,n+1)+nelenod(3,n)
212 END DO
213C
214 DO n=1,numeltg
215 DO i=1,3
216 ni=ixtg(i+1,n)
217 nelenod(3,ni)=nelenod(3,ni)+1
218 eltgnod(nelenod(3,ni))=n
219 END DO
220 END DO
221C
222 DO n=numnod,1,-1
223 nelenod(3,n+1)=nelenod(3,n)
224 END DO
225 nelenod(3,1)=0
226C
227 DO n=1,numnod
228 DO j=nelenod(1,n)+1,nelenod(1,n+1)
229 js=elsnod(j)
230 DO k=nelenod(1,n)+1,nelenod(1,n+1)
231 IF(k/=j)THEN
232 DO ii=1,8
233 IF(ixs(ii+1,js)/=0) nodtag(ixs(ii+1,js))=0
234 END DO
235 ks=elsnod(k)
236 DO ii=1,8
237 ni=ixs(ii+1,ks)
238 nodtag_1(ni) = 0
239 ENDDO
240 DO ii=1,8
241 ni=ixs(ii+1,ks)
242 IF (nodtag_1(ni) == 0) THEN
243 nodtag(ixs(ii+1,ks))=nodtag(ixs(ii+1,ks))+1
244 nodtag_1(ni) = 1
245 ENDIF
246 END DO
247 nn=0
248 DO jj=1,6
249 ll=fastag(js)
250 IF(mod(ll,pwr(jj+1))/pwr(jj)==0)THEN
251 nn=0
252 DO kk=1,4
253 IF(ixs(faces(kk,jj)+1,js)/=0)
254 . nn=nn+nodtag(ixs(faces(kk,jj)+1,js))
255 END DO
256 IF(nn == 4)THEN
257C Factag (JS) Less Face JJ
258 fastag(js)=fastag(js)+pwr(jj)
259 END IF
260 END IF
261 END DO
262 END IF
263 END DO
264C
265 DO k=nelenod(2,n)+1,nelenod(2,n+1)
266 DO ii=1,8
267 IF(ixs(ii+1,js)/=0) nodtag(ixs(ii+1,js))=0
268 END DO
269 ks=elcnod(k)
270 DO ii=1,4
271 IF(ixc(ii+1,ks)/=0)
272 . nodtag(ixc(ii+1,ks))=nodtag(ixc(ii+1,ks))+1
273 END DO
274 nn=0
275 DO jj=1,6
276 ll=fastag(js)
277 IF(mod(ll,pwr(jj+1))/pwr(jj)==0)THEN
278 nn=0
279 DO kk=1,4
280 IF(ixs(faces(kk,jj)+1,js)/=0)
281 . nn=nn+nodtag(ixs(faces(kk,jj)+1,js))
282 END DO
283 IF(nn==4)THEN
284C Factag (JS) Less Face JJ
285 fastag(js)=fastag(js)+pwr(jj)
286 END IF
287 END IF
288 END DO
289 END DO
290C
291 DO k=nelenod(3,n)+1,nelenod(3,n+1)
292 DO ii=1,8
293 IF(ixs(ii+1,js)/=0) nodtag(ixs(ii+1,js))=0
294 END DO
295 ks=eltgnod(k)
296 DO ii=1,4
297 IF(ixtg(ii+1,ks)/=0)
298 . nodtag(ixtg(ii+1,ks))=nodtag(ixtg(ii+1,ks))+1
299 END DO
300 nn=0
301 DO jj=1,6
302 ll=fastag(js)
303 IF(mod(ll,pwr(jj+1))/pwr(jj)==0)THEN
304 nn=0
305 DO kk=1,4
306 IF(ixs(faces(kk,jj)+1,js)/=0)
307 . nn=nn+nodtag(ixs(faces(kk,jj)+1,js))
308 END DO
309 IF(nn==4)THEN
310C Factag (JS) Less Face JJ
311 fastag(js)=fastag(js)+pwr(jj)
312 END IF
313 END IF
314 END DO
315 END DO
316 END DO
317 END DO
318C
319 nfasolfr=0
320 DO n=1,numels
321 ll=fastag(n)
322 DO jj=1,6
323 IF(mod(ll,pwr(jj+1))/pwr(jj)==0)THEN
324 nfasolfr=nfasolfr+1
325C FASOLFR(1,NFASOLFR)=N
326C FASOLFR(2,NFASOLFR)=JJ
327 END IF
328 END DO
329 END DO
330 DEALLOCATE(eltgnod, elcnod, elsnod, nelenod,nodtag,nodtag_1)
331C
332 RETURN
arret
subroutine arret(nn)
Definition arret.F:86

◆ ani_fasolfr2()

subroutine ani_fasolfr2 ( integer, dimension(*) fastag,
integer, dimension(2,*) fasolfr,
integer, dimension(*) isolnod )

Definition at line 339 of file ani_fasolfr.F.

340C-----------------------------------------------
341C I m p l i c i t T y p e s
342C-----------------------------------------------
343#include "implicit_f.inc"
344C-----------------------------------------------
345C C o m m o n B l o c k s
346C-----------------------------------------------
347#include "com01_c.inc"
348#include "com04_c.inc"
349C-----------------------------------------------
350C D u m m y A r g u m e n t s
351C-----------------------------------------------
352C REAL
353 INTEGER
354 . FASTAG(*), FASOLFR(2,*), ISOLNOD(*)
355C-----------------------------------------------
356C L o c a l V a r i a b l e s
357C-----------------------------------------------
358 INTEGER N,JJ,LL
359 INTEGER PWR(7)
360 DATA pwr/1,2,4,8,16,32,64/
361C REAL
362C-----------------------------------------------
363C
364 nfasolfr=0
365 DO n=1,numels
366 ll=fastag(n)
367 DO jj=1,6
368 IF(mod(ll,pwr(jj+1))/pwr(jj)==0)THEN
369 nfasolfr=nfasolfr+1
370 fasolfr(1,nfasolfr)=n
371 fasolfr(2,nfasolfr)=jj
372 END IF
373 END DO
374 END DO
375 RETURN