OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11remlin.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i11remline (x, nrtm, irectm, nrts, irects, numnod, gap_s, gap_m, gapmin, igap, kremnode, remnode, gap, drad, nremnode, i_start, i_mem_rem, inod2lin, tagsecnd, nod2lin, dgapload, gap_s_l, gap_m_l)
program __i11remlin_f__

Function/Subroutine Documentation

◆ __i11remlin_f__()

program __i11remlin_f__

Definition at line 356 of file i11remlin.F.

◆ i11remline()

subroutine i11remline ( x,
integer nrtm,
integer, dimension(2,*) irectm,
integer nrts,
integer, dimension(2,*) irects,
integer numnod,
gap_s,
gap_m,
gapmin,
integer igap,
integer, dimension(*) kremnode,
integer, dimension(*) remnode,
gap,
drad,
integer nremnode,
integer i_start,
integer i_mem_rem,
integer, dimension(numnod+1) inod2lin,
integer, dimension(numnod) tagsecnd,
integer, dimension(2*nrtm) nod2lin,
intent(in) dgapload,
dimension(nrts), intent(in) gap_s_l,
dimension(nrtm), intent(in) gap_m_l )

Definition at line 31 of file i11remlin.F.

37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C D u m m y A r g u m e n t s
43C-----------------------------------------------
44 INTEGER NRTM,NRTS, NUMNOD,IGAP, NREMNODE
45 INTEGER IRECTM(2,*),IRECTS(2,*),KREMNODE(*),REMNODE(*),I_START,I_MEM_REM
46 INTEGER INOD2LIN(NUMNOD+1),TAGSECND(NUMNOD),NOD2LIN(2*NRTM)
47 my_real
48 . x(3,*),gap_s(*),gap_m(*),gap,drad,gapmin
49 my_real , INTENT(IN) :: dgapload
50 my_real , INTENT(IN) :: gap_s_l(nrts), gap_m_l(nrtm)
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER I,J,K,LIN,ILIN,LEVEL,CPT,NBLIN,LIN1,L,CPT1,N,NBLIN_MAX,CPT_TOTAL
55 INTEGER, dimension(:),ALLOCATABLE :: ITAG,LISTLIN,LISTLINTMP,LISTLINTOTAL
56 INTEGER :: IM1,IM2
57 INTEGER, DIMENSION(:),ALLOCATABLE ::
58 . KNOD2LIN,TAGNOD,ORIGIN
59 my_real
60 . dmax,new_dist,pene,i11pene_lin,xl,gapv
61 my_real, DIMENSION(:),ALLOCATABLE ::
62 . dist1
63C-----------------------------------------------
64c Build inverse connectivity for segments - only at first pass (I_START=1)
65C-----------------------------------------------
66 ALLOCATE(itag(nrtm))
67 ALLOCATE(listlin(nrtm))
68 ALLOCATE(listlintmp(nrtm))
69 ALLOCATE(listlintotal(nrtm))
70C
71 cpt = 0
72 IF (i_start ==1) THEN
73C
74 ALLOCATE(knod2lin(numnod+1))
75C
76 kremnode(1) = 1
77 nod2lin(1:2*nrtm) = 0
78 knod2lin(1:numnod+1) = 0
79 inod2lin(1:numnod+1) = 0
80 tagsecnd(1:numnod) = 0
81C
82 DO i=1,nrts
83 tagsecnd(irects(1,i)) = 1
84 tagsecnd(irects(2,i)) = 1
85 ENDDO
86C
87 DO i=1,nrtm
88 DO j=1,2
89 IF( tagsecnd(irectm(j,i)) == 1 ) cpt = cpt + 1
90 ENDDO
91 ENDDO
92C
93 IF (cpt == 0) THEN
94C--
95 DO i=1,nrtm
96 kremnode(i+1) = 0
97 ENDDO
98C
99 ELSE
100C-----------------------------------------------
101C Definition of node to segment connections
102C-----------------------------------------------
103C
104 DO i=1,nrtm
105 cpt = 0
106 DO k=1,2
107 IF(tagsecnd(irectm(k,i)) == 1) cpt = cpt + 1
108 END DO
109 IF (cpt /= 0 ) THEN
110 DO k=1,2
111 n = irectm(k,i)
112 knod2lin(n) = knod2lin(n) + 1
113 END DO
114 ENDIF
115 END DO
116C
117 inod2lin(1) = 1
118 DO i=1,numnod
119 inod2lin(i+1) = inod2lin(i) + knod2lin(i)
120 END DO
121 knod2lin(1:numnod+1) = inod2lin(1:numnod+1)
122C
123 DO i=1,nrtm
124 cpt = 0
125 DO k=1,2
126 IF(tagsecnd(irectm(k,i)) == 1) cpt = cpt + 1
127 END DO
128 IF (cpt /= 0) THEN
129 DO k=1,2
130 n = irectm(k,i)
131 nod2lin(knod2lin(n)) = i
132 knod2lin(n) = knod2lin(n) + 1
133 END DO
134 ENDIF
135 END DO
136C
137 DEALLOCATE(knod2lin)
138C
139 ENDIF
140C
141 ENDIF
142C
143 IF (((i_start==1).AND.(cpt > 0)).OR.(i_start>1)) THEN
144C
145C-----------------------------------------------
146C Searching Algorithm Connected nodes : D < SQRT(2.) * GAP
147C-----------------------------------------------
148C
149 ALLOCATE(tagnod(numnod),origin(numnod),dist1(numnod))
150 tagnod(1:numnod) = 0
151 origin(1:numnod) = 0
152 dist1(1:numnod) = ep30
153 itag(1:nrtm) = 0
154 listlin(1:nrtm) = 0
155 listlintmp(1:nrtm)=0
156 listlintotal(1:nrtm) = 0
157 cpt_total = 0
158C
159 dmax = sqrt(two) * max(gap+dgapload,drad)
160C
161 DO i=i_start,nrtm
162
163 level = 1
164 lin = i
165C IF ((ITAB(IRECTM(1,LIN))/=30151).OR.(ITAB(IRECTM(2,LIN))/=30197)) CYCLE
166 itag(lin) = level
167 listlin(1)=lin
168 nblin=1
169 nblin_max=1
170 cpt = 0
171 cpt_total = 0
172 xl = (x(1,irectm(1,i))-x(1,irectm(2,i)))**2+(x(2,irectm(1,i))-x(2,irectm(2,i)))**2+(x(3,irectm(1,i))-x(3,irectm(2,i)))**2
173 xl = sqrt(xl)
174C
175 DO j=1,2
176 tagnod(irectm(j,lin)) = 1
177 dist1(irectm(j,lin)) = zero
178 ENDDO
179C
180 DO WHILE (nblin/=0)
181C
182 level = level+1
183 cpt = 0
184 DO ilin=1,nblin
185 lin=listlin(ilin)
186 tagnod(irectm(1:2,lin))=2
187C
188C ESTA = (DIST1(IRECTM(2,LIN))*DIST1(IRECTM(2,LIN))-DIST1(IRECTM(1,LIN))*DIST1(IRECTM(1,LIN))-XL*XL)
189C . /(TWO*XL*DIST1(IRECTM(1,LIN)))
190C DIST_AXIS = DIST1(IRECTM(1,LIN))*SQRT(ONE-ESTA*ESTA)
191C
192 pene = zero
193 IF ((dist1(irectm(1,lin)) > dmax).AND.(dist1(irectm(2,lin)) > dmax).AND.(level>2)) THEN
194 pene = i11pene_lin(x,irectm(1,lin),irectm(2,lin),irectm(1,i),irectm(2,i),dmax)
195 ENDIF
196C
197 IF ((level <= 2).OR.(dist1(irectm(1,lin)) <= dmax).OR.(dist1(irectm(2,lin)) <= dmax).OR.(pene > zero)) THEN
198 DO j=1,2
199 DO k=inod2lin(irectm(j,lin)),inod2lin(irectm(j,lin)+1)-1
200 lin1 = nod2lin(k)
201 IF( (itag(lin1) == 0 .OR. itag(lin1) == level)) THEN
202 IF(itag(lin1) == 0)THEN
203 cpt = cpt + 1
204 listlintmp(cpt)=lin1
205 ENDIF
206 itag(lin1)=level
207 DO l=1,2
208
209 IF ((tagsecnd(irectm(l,lin1))== 1).AND.(origin(irectm(l,lin1)) /= irectm(j,lin))
210 . .AND.((irectm(l,lin1)) /= irectm(j,lin)).AND.(tagnod(irectm(l,lin1)) /= 2)) THEN
211C
212 new_dist=dist1(irectm(j,lin))+
213 . sqrt((x(1,irectm(l,lin1))-x(1,irectm(j,lin)))**2 +
214 . (x(2,irectm(l,lin1)) - x(2,irectm(j,lin)))**2 +
215 . (x(3,irectm(l,lin1)) - x(3,irectm(j,lin)))**2 )
216C
217 IF (new_dist < dist1(irectm(l,lin1))) THEN
218 dist1(irectm(l,lin1)) = new_dist
219 ENDIF
220C
221 IF(tagnod(irectm(l,lin1))==0) THEN
222 tagnod(irectm(l,lin1)) = 1
223 ENDIF
224C
225 ENDIF
226 ENDDO
227 ENDIF
228 ENDDO
229 ENDDO
230 ENDIF
231C
232 tagnod(irectm(1:2,lin))=1
233 ENDDO
234C
235 nblin = cpt
236C
237 nblin_max = max(nblin_max,nblin)
238 IF(nblin ==0)EXIT
239 DO j=1,cpt
240 listlin(j)=listlintmp(j)
241 listlintmp(j) = 0
242 listlintotal(j+cpt_total) = listlin(j)
243 ENDDO
244 cpt_total = cpt_total + cpt
245C
246C----------------
247 ENDDO
248C
249CC END DO WHILE
250C
251C-- Check memory for data storage
252C
253 i_start = i
254 IF (kremnode(i)+cpt_total > nremnode) THEN
255C-- Not enough memory - upgrade_remnode
256 i_mem_rem = 1
257 EXIT
258 ENDIF
259C
260 cpt1 = 0
261 im1 = irectm(1,i)
262 im2 = irectm(2,i)
263C
264 IF (igap == 0) THEN
265 DO l=1,cpt_total
266 lin = listlintotal(l)
267 IF ((im1 /= irectm(1,lin)).AND.(im1 /= irectm(2,lin))
268 . .AND.(im2 /= irectm(1,lin)).AND.(im2 /= irectm(2,lin))) THEN
269C--- lines with common nodes with main lines are already removed - no need to store them in remnode
270 IF ((dist1(irectm(1,lin)) <= dmax).OR.(dist1(irectm(2,lin)) <= dmax)) THEN
271 remnode(kremnode(i)+cpt1) = lin
272 cpt1 = cpt1 + 1
273 ELSE
274 pene = i11pene_lin(x,irectm(1,lin),irectm(2,lin),irectm(1,i),irectm(2,i),sqrt(two)*max(gap+dgapload,drad))
275 IF (pene > 0) THEN
276 remnode(kremnode(i)+cpt1) = lin
277 cpt1 = cpt1 + 1
278 ENDIF
279 ENDIF
280 ENDIF
281 ENDDO
282 kremnode(i+1) = kremnode(i) + cpt1
283 ELSE
284 DO l=1,cpt_total
285 lin = listlintotal(l)
286 IF ((im1 /= irectm(1,lin)).AND.(im1 /= irectm(2,lin))
287 . .AND.(im2 /= irectm(1,lin)).AND.(im2 /= irectm(2,lin))) THEN
288C--- lines with common nodes with main lines are already removed - no need to store them in remnode
289 gapv = gap_s(lin)+gap_m(i)
290 IF(igap == 3) gapv=min(gap_s_l(lin)+gap_m_l(i),gapv)
291 gapv = sqrt(two)*max(drad,gapmin,gapv+dgapload)
292 IF ((dist1(irectm(1,lin)) <= gapv).OR.(dist1(irectm(2,lin)) <= gapv)) THEN
293 remnode(kremnode(i)+cpt1) = lin
294 cpt1 = cpt1 + 1
295 ELSE
296 pene = i11pene_lin(x,irectm(1,lin),irectm(2,lin),irectm(1,i),irectm(2,i),gapv)
297 IF (pene > 0) THEN
298 remnode(kremnode(i)+cpt1) = lin
299 cpt1 = cpt1 + 1
300 ENDIF
301 ENDIF
302 ENDIF
303 ENDDO
304 kremnode(i+1) = kremnode(i) + cpt1
305 ENDIF
306C
307C-----------------------------------------------
308C Clean of used arrays
309C-----------------------------------------------
310C
311 dist1(irectm(1,i)) = ep30
312 dist1(irectm(2,i)) = ep30
313 origin(irectm(1,i)) = 0
314 origin(irectm(2,i)) = 0
315 tagnod(irectm(1,i)) = 0
316 tagnod(irectm(2,i)) = 0
317 itag(i) = 0
318C
319 DO l=1,cpt_total
320 lin = listlintotal(l)
321 itag(lin) = 0
322 listlintotal(l) = 0
323 tagnod(irectm(1,lin)) = 0
324 tagnod(irectm(2,lin)) = 0
325 dist1(irectm(1,lin)) = ep30
326 dist1(irectm(2,lin)) = ep30
327 origin(irectm(1,lin)) = 0
328 origin(irectm(2,lin)) = 0
329 ENDDO
330 listlintmp(1:nblin_max)=0
331 listlin(1:nblin_max)=0
332C
333 ENDDO
334CC END DO NRTM
335 DEALLOCATE(dist1,tagnod,origin)
336C
337 ELSE
338 i_start = nrtm ! avoid infinite loop later
339 ENDIF
340
341 DEALLOCATE(itag)
342 DEALLOCATE(listlin)
343 DEALLOCATE(listlintmp)
344 DEALLOCATE(listlintotal)
345C
346 RETURN
origin
integer function origin(nn, ixc, ipartc, ipart)
Definition build_admesh.F:70
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
tagnod
subroutine tagnod(ix, nix, nix1, nix2, numel, iparte, tagbuf, npart)
Definition tagnod.F:29