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 30 of file ani_fasolfr.F.

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

◆ ani_fasolfr2()

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

Definition at line 337 of file ani_fasolfr.F.

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