OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
donesec.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!|| donesec ../starter/source/output/anim/donesec.F
25!||--- called by ------------------------------------------------------
26!|| genani1 ../starter/source/output/anim/genani1.F
27!||====================================================================
28 SUBROUTINE donesec(ISECT,NESCT,NSTRF,IXS)
29C-----------------------------------------------
30C I m p l i c i t T y p e s
31C-----------------------------------------------
32#include "implicit_f.inc"
33C-----------------------------------------------
34C D u m m y A r g u m e n t s
35C-----------------------------------------------
36 INTEGER ISECT,NESCT,
37 . NSTRF(*),IXS(NIXS,*)
38C-----------------------------------------------
39C L o c a l V a r i a b l e s
40C-----------------------------------------------
41 INTEGER J, I, KK, K0, K1, K5, K9, NSEG, NSEGC, NSEGTG
42 INTEGER NSEGS, POWER2(8),IPACK,
43 . II(8), N1, N2, N3, N4, N5, N6, N7, N8, K3, N
44 DATA power2/1,2,4,8,16,32,64,128/
45 SAVE k1
46 SAVE k0
47C-----------------------------------------------
48 IF (isect==1) k0 = nstrf(25)
49 k5=k0+30+nstrf(k0+14)+nstrf(k0+6)
50 1 +2*nstrf(k0+7) +nstrf(k0+8)*2
51 nsegc = nstrf(k0+9)
52 DO j=1,nsegc
53 kk = k5+2*(j-1)+1
54 IF(nstrf(kk)/=0) nesct = nesct + 1
55 ENDDO
56 k9=k5+2*nstrf(k0+9) +2*nstrf(k0+10)
57 1 +2*nstrf(k0+11)+2*nstrf(k0+12)
58 nsegtg = nstrf(k0+13)
59 DO j=1,nsegtg
60 kk = k9+2*(j-1)+1
61 IF(nstrf(kk)/=0) nesct = nesct + 1
62 ENDDO
63 k3=k0+30+nstrf(k0+14)+nstrf(k0+6)
64 nsegs=nstrf(k0+7)
65
66 IF(nsegs/=0) nesct = nesct + 1
67
68 DO j=1,nsegs
69 kk=k3+2*(j-1)
70 ipack=nstrf(kk+1)
71 IF(ipack/=0)THEN
72 n =nstrf(kk)
73 ii(1)=ixs(2,n)
74 ii(2)=ixs(3,n)
75 ii(3)=ixs(4,n)
76 ii(4)=ixs(5,n)
77 ii(5)=ixs(6,n)
78 ii(6)=ixs(7,n)
79 ii(7)=ixs(8,n)
80 ii(8)=ixs(9,n)
81 IF( ii(2)==ii(1).AND.ii(4)==ii(3)
82 . .AND.ii(8)==ii(5).AND.ii(7)==ii(6))THEN
83C tetra4, tetra10
84 n1=mod(ipack/power2(1),2)
85 n2=mod(ipack/power2(3),2)
86 n3=mod(ipack/power2(5),2)
87 n4=mod(ipack/power2(6),2)
88 IF(n1/=0.AND.n2/=0.AND.n3/=0)
89 . nesct = nesct + 1
90 IF(n1/=0.AND.n2/=0.AND.n4/=0)
91 . nesct = nesct + 1
92 IF(n2/=0.AND.n3/=0.AND.n4/=0)
93 . nesct = nesct + 1
94 IF(n3/=0.AND.n1/=0.AND.n4/=0)
95 . nesct = nesct + 1
96 ELSE
97C brick, shell16, brick20
98 n1=mod(ipack/power2(1),2)
99 n2=mod(ipack/power2(2),2)
100 n3=mod(ipack/power2(3),2)
101 n4=mod(ipack/power2(4),2)
102 n5=mod(ipack/power2(5),2)
103 n6=mod(ipack/power2(6),2)
104 n7=mod(ipack/power2(7),2)
105 n8=mod(ipack/power2(8),2)
106 IF(n1/=0.AND.n2/=0.AND.n3/=0.AND.n4/=0)
107 . nesct = nesct + 1
108 IF(n5/=0.AND.n6/=0.AND.n7/=0.AND.n8/=0)
109 . nesct = nesct + 1
110 IF(n1/=0.AND.n5/=0.AND.n6/=0.AND.n2/=0)
111 . nesct = nesct + 1
112 IF(n4/=0.AND.n8/=0.AND.n7/=0.AND.n3/=0)
113 . nesct = nesct + 1
114 IF(n1/=0.AND.n4/=0.AND.n8/=0.AND.n5/=0)
115 . nesct = nesct + 1
116 IF(n2/=0.AND.n3/=0.AND.n7/=0.AND.n6/=0)
117 . nesct = nesct + 1
118 END IF
119 END IF
120 END DO
121 k0=nstrf(k0+24)
122C
123 RETURN
124 END
donesec
subroutine donesec(isect, nesct, nstrf, ixs)
Definition donesec.F:29