OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dseccnt.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!|| dseccnt ../starter/source/output/anim/dseccnt.F
25!||--- called by ------------------------------------------------------
26!|| genani1 ../starter/source/output/anim/genani1.F
27!||====================================================================
28 SUBROUTINE dseccnt(NESCT,NERWL,NESBW,NSTRF,
29 2 RWBUF,NPRW,NNWL,IXS)
30C-----------------------------------------------
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33#include "implicit_f.inc"
34C-----------------------------------------------
35C C o m m o n B l o c k s
36C-----------------------------------------------
37#include "param_c.inc"
38#include "com04_c.inc"
39C-----------------------------------------------
40C D u m m y A r g u m e n t s
41C-----------------------------------------------
42 my_real
43 . rwbuf(nrwlp,*)
44 INTEGER NESCT,NERWL,NESBW,NNWL,
45 . nstrf(*),nprw(*),ixs(nixs,*)
46C-----------------------------------------------
47C L o c a l V a r i a b l e s
48C-----------------------------------------------
49 INTEGER J, I, K, K1, N, NSEG, N1, N2, N3, N4,NSEGC, NSEGTG,
50 . ityp, kk,itmp, k0, k5, k9
51 my_real
52 . xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3,
53 . xx4, yy4, zz4, d13, xxc, yyc, zzc
54 INTEGER NSEGS, POWER2(8),IPACK,
55 . ii(8), n5, n6, n7, n8, k3
56 DATA power2/1,2,4,8,16,32,64,128/
57C-----------------------------------------------
58 IF (nsect>0) THEN
59 k0 = nstrf(25)
60 DO i=1,nsect
61 k5=k0+30+nstrf(k0+14)+nstrf(k0+6)
62 1 + 2*nstrf(k0+7) +nstrf(k0+8)*2
63 nsegc = nstrf(k0+9)
64 DO j=1,nsegc
65 kk = k5+2*(j-1)+1
66 IF(nstrf(kk)/=0) nesct = nesct + 1
67 ENDDO
68 k9=k5+2*nstrf(k0+9) +2*nstrf(k0+10)
69 1 +2*nstrf(k0+11)+2*nstrf(k0+12)
70 nsegtg = nstrf(k0+13)
71 DO j=1,nsegtg
72 kk = k9+2*(j-1)+1
73 IF(nstrf(kk)/=0) nesct = nesct + 1
74 ENDDO
75 k3=k0+30+nstrf(k0+14)+nstrf(k0+6)
76 nsegs=nstrf(k0+7)
77
78 IF(nsegs/=0) nesct = nesct + 1
79
80 DO j=1,nsegs
81 kk=k3+2*(j-1)
82 ipack=nstrf(kk+1)
83 IF(ipack/=0)THEN
84 n =nstrf(kk)
85 ii(1)=ixs(2,n)
86 ii(2)=ixs(3,n)
87 ii(3)=ixs(4,n)
88 ii(4)=ixs(5,n)
89 ii(5)=ixs(6,n)
90 ii(6)=ixs(7,n)
91 ii(7)=ixs(8,n)
92 ii(8)=ixs(9,n)
93 IF( ii(2)==ii(1).AND.ii(4)==ii(3)
94 . .AND.ii(8)==ii(5).AND.ii(7)==ii(6))THEN
95 n1=mod(ipack/power2(1),2)
96 n2=mod(ipack/power2(3),2)
97 n3=mod(ipack/power2(5),2)
98 n4=mod(ipack/power2(6),2)
99 IF(n1/=0.AND.n2/=0.AND.n3/=0)
100 . nesct = nesct + 1
101 IF(n1/=0.AND.n2/=0.AND.n4/=0)
102 . nesct = nesct + 1
103 IF(n2/=0.AND.n3/=0.AND.n4/=0)
104 . nesct = nesct + 1
105 IF(n3/=0.AND.n1/=0.AND.n4/=0)
106 . nesct = nesct + 1
107 ELSE
108 n1=mod(ipack/power2(1),2)
109 n2=mod(ipack/power2(2),2)
110 n3=mod(ipack/power2(3),2)
111 n4=mod(ipack/power2(4),2)
112 n5=mod(ipack/power2(5),2)
113 n6=mod(ipack/power2(6),2)
114 n7=mod(ipack/power2(7),2)
115 n8=mod(ipack/power2(8),2)
116 IF(n1/=0.AND.n2/=0.AND.n3/=0.AND.n4/=0)
117 . nesct = nesct + 1
118 IF(n5/=0.AND.n6/=0.AND.n7/=0.AND.n8/=0)
119 . nesct = nesct + 1
120 IF(n1/=0.AND.n5/=0.AND.n6/=0.AND.n2/=0)
121 . nesct = nesct + 1
122 IF(n4/=0.AND.n8/=0.AND.n7/=0.AND.n3/=0)
123 . nesct = nesct + 1
124 IF(n1/=0.AND.n4/=0.AND.n8/=0.AND.n5/=0)
125 . nesct = nesct + 1
126 IF(n2/=0.AND.n3/=0.AND.n7/=0.AND.n6/=0)
127 . nesct = nesct + 1
128 END IF
129 END IF
130 END DO
131 k0=nstrf(k0+24)
132 ENDDO
133 ENDIF
134C
135 k=1
136 DO n=1,nrwall
137 n2=n +nrwall
138 n3=n2+nrwall
139 n4=n3+nrwall
140 ityp= nprw(n4)
141
142 IF(iabs(ityp)==1)THEN
143 nerwl = nerwl + 1 + 1
144 nnwl = nnwl + 4
145 ELSEIF(ityp==2)THEN
146 nerwl = nerwl + 24 + 1
147 nnwl = nnwl + 48
148 ELSEIF(ityp==3)THEN
149 nerwl = nerwl + 216 + 1
150 nnwl = nnwl + 294
151 ELSEIF(ityp==4)THEN
152 nerwl = nerwl + 1 + 1
153 nnwl = nnwl + 4
154 ENDIF
155 k=k+nprw(n)
156 IF(nprw(n4)==-1)k=k+nint(rwbuf(8,n))
157 ENDDO
158C
159 nesbw = nesct + nerwl
160C
161 RETURN
162 END
my_real
#define my_real
Definition cppsort.cpp:32
dseccnt
subroutine dseccnt(nesct, nerwl, nesbw, nstrf, rwbuf, nprw, nnwl, ixs)
Definition dseccnt.F:30