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