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