OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dim_tshedg.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine dim_tshedg (elbuf_str, nedg, ixs, iparg)

Function/Subroutine Documentation

◆ dim_tshedg()

subroutine dim_tshedg ( type(elbuf_struct_), dimension(ngroup), target elbuf_str,
integer nedg,
integer, dimension(nixs,*) ixs,
integer, dimension(nparg,ngroup) iparg )

Definition at line 30 of file dim_tshedg.F.

31C=======================================================================
32 USE elbufdef_mod
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C A n a l y s e M o d u l e
39C-----------------------------------------------
40#include "mvsiz_p.inc"
41C-----------------------------------------------
42C D u m m y A r g u m e n t s
43C-----------------------------------------------
44 INTEGER NEDG
45 INTEGER IXS(NIXS,*),IPARG(NPARG,NGROUP)
46 TYPE(ELBUF_STRUCT_),DIMENSION(NGROUP), TARGET :: ELBUF_STR
47C REAL
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "param_c.inc"
52#include "com01_c.inc"
53#include "com04_c.inc"
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER I,J,NG, NEL, NFT,N, ITY,JHBE,IGTYP,ICSTR,ISOLNOD
58 INTEGER ITAG(NUMNOD),N1,N2,NC(8,MVSIZ)
59 TYPE(G_BUFEL_) ,POINTER :: GBUF
60C REAL
61C-------
62 itag(1:numnod)=0
63 nedg = 0
64 DO ng=1,ngroup
65 nel=iparg(2,ng)
66 nft=iparg(3,ng)
67 ity=iparg(5,ng)
68 icstr= iparg(17,ng)
69 jhbe = iparg(23,ng)
70 igtyp = iparg(38,ng)
71 isolnod= iparg(28,ng)
72 IF (iparg(8,ng)==1) cycle
73 IF (ity /= 1) cycle
74 IF (igtyp == 20.OR.igtyp == 21.OR.igtyp == 22)THEN
75 gbuf => elbuf_str(ng)%GBUF
76C--------only linear for the moment
77 IF(isolnod==6)THEN
78 DO i=1,nel
79 n = nft+i
80 nc(1:3,i)=ixs(2:4,n)
81 nc(4:6,i)=ixs(6:8,n)
82 ENDDO
83 DO i=1,nel
84 IF (gbuf%IDT_TSH(i)<=0) cycle
85 n1 = nc(1,i)
86 n2 = nc(4,i)
87 IF (itag(n1)==0.AND.itag(n2)==0) THEN
88 nedg = nedg + 1
89 itag(n1)=nedg
90 itag(n2)=nedg
91 END IF
92 n1 = nc(2,i)
93 n2 = nc(5,i)
94 IF (itag(n1)==0.AND.itag(n2)==0) THEN
95 nedg = nedg + 1
96 itag(n1)=nedg
97 itag(n2)=nedg
98 END IF
99 n1 = nc(3,i)
100 n2 = nc(6,i)
101 IF (itag(n1)==0.AND.itag(n2)==0) THEN
102 nedg = nedg + 1
103 itag(n1)=nedg
104 itag(n2)=nedg
105 END IF
106 ENDDO
107 ELSEIF(isolnod==8)THEN
108 DO i=1,nel
109 n = nft+i
110 nc(1:8,i)=ixs(2:9,n)
111 ENDDO
112 IF (jhbe==14) THEN
113 SELECT CASE (icstr)
114 CASE(100)
115 DO i=1,nel
116 IF (gbuf%IDT_TSH(i)<=0) cycle
117 n1 = nc(1,i)
118 n2 = nc(4,i)
119 IF (itag(n1)==0.AND.itag(n2)==0) THEN
120 nedg = nedg + 1
121 itag(n1)=nedg
122 itag(n2)=nedg
123 END IF
124 n1 = nc(2,i)
125 n2 = nc(3,i)
126 IF (itag(n1)==0.AND.itag(n2)==0) THEN
127 nedg = nedg + 1
128 itag(n1)=nedg
129 itag(n2)=nedg
130 END IF
131 n1 = nc(5,i)
132 n2 = nc(8,i)
133 IF (itag(n1)==0.AND.itag(n2)==0) THEN
134 nedg = nedg + 1
135 itag(n1)=nedg
136 itag(n2)=nedg
137 END IF
138 n1 = nc(6,i)
139 n2 = nc(7,i)
140 IF (itag(n1)==0.AND.itag(n2)==0) THEN
141 nedg = nedg + 1
142 itag(n1)=nedg
143 itag(n2)=nedg
144 END IF
145 ENDDO
146 CASE(10)
147 DO i=1,nel
148 IF (gbuf%IDT_TSH(i)<=0) cycle
149 n1 = nc(1,i)
150 n2 = nc(5,i)
151 IF (itag(n1)==0.AND.itag(n2)==0) THEN
152 nedg = nedg + 1
153 itag(n1)=nedg
154 itag(n2)=nedg
155 END IF
156 n1 = nc(2,i)
157 n2 = nc(6,i)
158 IF (itag(n1)==0.AND.itag(n2)==0) THEN
159 nedg = nedg + 1
160 itag(n1)=nedg
161 itag(n2)=nedg
162 END IF
163 n1 = nc(3,i)
164 n2 = nc(7,i)
165 IF (itag(n1)==0.AND.itag(n2)==0) THEN
166 nedg = nedg + 1
167 itag(n1)=nedg
168 itag(n2)=nedg
169 END IF
170 n1 = nc(4,i)
171 n2 = nc(8,i)
172 IF (itag(n1)==0.AND.itag(n2)==0) THEN
173 nedg = nedg + 1
174 itag(n1)=nedg
175 itag(n2)=nedg
176 END IF
177 ENDDO
178 CASE(1)
179 DO i=1,nel
180 IF (gbuf%IDT_TSH(i)<=0) cycle
181 n1 = nc(1,i)
182 n2 = nc(2,i)
183 IF (itag(n1)==0.AND.itag(n2)==0) THEN
184 nedg = nedg + 1
185 itag(n1)=nedg
186 itag(n2)=nedg
187 END IF
188 n1 = nc(4,i)
189 n2 = nc(3,i)
190 IF (itag(n1)==0.AND.itag(n2)==0) THEN
191 nedg = nedg + 1
192 itag(n1)=nedg
193 itag(n2)=nedg
194 END IF
195 n1 = nc(5,i)
196 n2 = nc(6,i)
197 IF (itag(n1)==0.AND.itag(n2)==0) THEN
198 nedg = nedg + 1
199 itag(n1)=nedg
200 itag(n2)=nedg
201 END IF
202 n1 = nc(8,i)
203 n2 = nc(7,i)
204 IF (itag(n1)==0.AND.itag(n2)==0) THEN
205 nedg = nedg + 1
206 itag(n1)=nedg
207 itag(n2)=nedg
208 END IF
209 ENDDO
210 END SELECT
211 ELSEIF (jhbe==15) THEN
212 DO i=1,nel
213 IF (gbuf%IDT_TSH(i)<=0) cycle
214 n1 = nc(1,i)
215 n2 = nc(5,i)
216 IF (itag(n1)==0.AND.itag(n2)==0) THEN
217 nedg = nedg + 1
218 itag(n1)=nedg
219 itag(n2)=nedg
220 END IF
221 n1 = nc(2,i)
222 n2 = nc(6,i)
223 IF (itag(n1)==0.AND.itag(n2)==0) THEN
224 nedg = nedg + 1
225 itag(n1)=nedg
226 itag(n2)=nedg
227 END IF
228 n1 = nc(3,i)
229 n2 = nc(7,i)
230 IF (itag(n1)==0.AND.itag(n2)==0) THEN
231 nedg = nedg + 1
232 itag(n1)=nedg
233 itag(n2)=nedg
234 END IF
235 n1 = nc(4,i)
236 n2 = nc(8,i)
237 IF (itag(n1)==0.AND.itag(n2)==0) THEN
238 nedg = nedg + 1
239 itag(n1)=nedg
240 itag(n2)=nedg
241 END IF
242 ENDDO
243 END IF
244 END IF
245 END IF
246 ENDDO
247C
248 RETURN