OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lslocal.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!|| lslocal ../starter/source/elements/xfem/lslocal.F
25!||--- called by ------------------------------------------------------
26!|| inicrkfill ../starter/source/elements/xfem/inicrkfill.f
27!||--- calls -----------------------------------------------------
28!|| activ_xfem ../starter/source/elements/xfem/lslocal.F
29!|| ancmsg ../starter/source/output/message/message.F
30!|| c3coori ../starter/source/elements/sh3n/coque3n/c3coori.F
31!|| ccoori ../starter/source/elements/shell/coque/ccoori.F
32!|| edgetip3n ../starter/source/elements/xfem/lslocal.F
33!|| edgetip4n ../starter/source/elements/xfem/lslocal.F
34!|| elcut3n ../starter/source/elements/xfem/lslocal.F
35!|| elcut4n ../starter/source/elements/xfem/lslocal.F
36!|| preinicrk3n ../starter/source/elements/xfem/preinicrk3N.F
37!|| preinicrk4n ../starter/source/elements/xfem/preinicrk4N.F
38!|| xyzloc3n ../starter/source/elements/xfem/lslocal.F
39!|| xyzloc4n ../starter/source/elements/xfem/lslocal.F
40!||--- uses -----------------------------------------------------
41!|| message_mod ../starter/share/message_module/message_mod.F
42!||====================================================================
43 SUBROUTINE lslocal(ELBUF_TAB,XFEM_TAB,
44 . IPARG ,IXC ,IXTG ,XREFC ,XREFTG ,
45 . X ,ICRK ,INOD_CRK,NXSEG ,NODLS ,
46 . RATIOLS ,NTAG ,IELCRKC ,IELCRKTG,IEDGESH4,
47 . IEDGESH3,NODEDGE ,TAGSKYC ,TAGSKYTG,KNOD2ELC,
48 . TAGEDGE ,CRKLVSET,CRKSHELL,CRKEDGE ,XFEM_PHANTOM,
49 . ITAB ,ID ,TITR )
50C-----------------------------------------------
51C M o d u l e s
52C-----------------------------------------------
53 USE xfem2def_mod
54 USE elbufdef_mod
55 USE message_mod
56 USE names_and_titles_mod , ONLY : nchartitle
57 use element_mod , only : nixc,nixtg
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C G l o b a l P a r a m e t e r s
64C-----------------------------------------------
65#include "mvsiz_p.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "param_c.inc"
70#include "com01_c.inc"
71#include "com04_c.inc"
72#include "vect01_c.inc"
73#include "com_xfem1.inc"
74C-----------------------------------------------
75C D u m m y A r g u m e n t s
76C-----------------------------------------------
77 INTEGER IPARG(NPARG,*),IXC(NIXC,*),IXTG(NIXTG,*),
78 . ICRK,INOD_CRK(*),NXSEG,NODLS(2,*),IELCRKC(*),IELCRKTG(*),
79 . NTAG(*),IEDGESH4(4,*),IEDGESH3(3,*),NODEDGE(2,*),
80 . TAGSKYC(4,*),TAGSKYTG(3,*),KNOD2ELC(*),TAGEDGE(*),ITAB(*),ID
81 my_real
82 . X(3,*),XREFC(4,3,*),XREFTG(3,3,*),RATIOLS(*)
83C
84 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
85 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP,NXEL) :: XFEM_TAB
86 TYPE (XFEM_LVSET_) , DIMENSION(NLEVMAX) :: CRKLVSET
87 TYPE (XFEM_SHELL_) , DIMENSION(NLEVMAX) :: CRKSHELL
88 TYPE (XFEM_EDGE_) , DIMENSION(NXLAYMAX) :: CRKEDGE
89 TYPE (XFEM_PHANTOM_), DIMENSION(NXLAYMAX) :: XFEM_PHANTOM
90 CHARACTER(LEN=NCHARTITLE)::TITR
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94 INTEGER XNOD(2,2),TAGXNOD(NXSEG+1),
95 . ngl(mvsiz),ix1(mvsiz),ix2(mvsiz),ix3(mvsiz),ix4(mvsiz)
96 INTEGER I,K,IED,NG,NEL,LS,FAC,IHBE,ISH3N,IXFEM,ITG,NELCUT,ILAY,NXLAY
97 my_real, DIMENSION(MVSIZ) :: X1,X2,X3,X4,Y1,Y2,Y3,Y4,Z1,Z2,Z3,Z4,
98 . X1L,Y1L,X2L,Y2L,X3L,Y3L,X4L,Y4L
99 my_real BETA0(2)
100 my_real ratio
101C
102 INTEGER,DIMENSION(:) ,ALLOCATABLE :: ELCUT
103 INTEGER,DIMENSION(:,:),ALLOCATABLE :: EDGEC,EDGETG
104 my_real,DIMENSION(:,:),ALLOCATABLE :: BETA
105C=======================================================================
106 itg = 1+numelc
107 ALLOCATE (elcut(numelc+numeltg))
108 ALLOCATE (beta(2,numelc+numeltg))
109 ALLOCATE (edgec(4,numelc))
110 ALLOCATE (edgetg(3,numeltg))
111 elcut = 0
112 beta = 0
113 edgec = 0
114 edgetg = 0
115C
116 tagxnod = 0
117c-----------------------
118 DO ls=1,nxseg
119C
120c Xnod2
121c (4)- - -x- - -(3)
122c | | |
123c | | |
124c | (NXSEG) |
125c | | |
126c | | |
127c | | |
128c (1)- - -x- - -(2)
129c Xnod1
130c
131 nelcut = 0
132 elcut = 0
133C - first intersection node - (Xnod1)
134 xnod(1,1) = nodls(1,ls) ! node (1)
135 xnod(1,2) = nodls(2,ls) ! node (2)
136C - second intersection node - (Xnod2)
137 xnod(2,1) = nodls(1,ls+1) ! node (3)
138 xnod(2,2) = nodls(2,ls+1) ! node (4)
139C
140 beta0(1) = ratiols(ls)
141 beta0(2) = ratiols(ls+1)
142C
143 DO i=1,2
144 ratio = beta0(i)
145 IF(ratio == zero)THEN
146 beta0(i) = em05
147 ELSEIF(ratio == one)THEN
148 beta0(i) = one-em05
149 ENDIF
150 ENDDO
151C-----------------------------------------------
152C TAG CUT ELEMENTS :
153C-----------------------------------------------
154 DO 200 ng=1,ngroup
155 ixfem = iparg(54,ng)
156 IF (ixfem == 0) cycle
157c
158 nxlay = elbuf_tab(ng)%NLAY
159 nel = iparg(2,ng)
160 nft = iparg(3,ng)
161 ity = iparg(5,ng)
162 ihbe = iparg(23,ng)
163 lft = 1
164 llt = min(nvsiz,nel)
165c
166 IF (ity == 7) ihbe = 0
167c
168c-------------------------
169 IF (ity==3) THEN
170C SHELL - 4N -
171c
172 DO i=lft,llt
173 fac = 0
174C
175C - First check - (coincident nodes not accepted)
176C
177 IF(xnod(1,1) == xnod(1,2)) fac = 1
178C
179 IF(fac == 1)THEN
180 CALL ancmsg(msgid=1618,
181 . msgtype=msgerror,
182 . anmode=aninfo,
183 . i1=id,
184 . i2=1,
185 . c1=titr )
186 ENDIF
187C
188 IF(xnod(2,1) == xnod(2,2)) fac = 2
189C
190 IF(fac == 2)THEN
191 CALL ancmsg(msgid=1618,
192 . msgtype=msgerror,
193 . anmode=aninfo,
194 . i1=id,
195 . i2=2,
196 . c1=titr )
197 ENDIF
198C---
199 fac = 0
200c find edge corresponding to Xnod1 => EDGEC(IED) = 1
201 ied = 1
202 CALL elcut4n(i, ixc(1,nft+1), xnod, edgec(1,nft+1),fac,ied)
203 IF (fac == 1) tagxnod(ls) = 1
204C
205C add warning message if FAC /= 1 ! XNOD1 must fit an element edge's
206C
207c find edge corresponding to Xnod2 => EDGEC(IED) = 2
208 ied = 2
209 CALL elcut4n(i, ixc(1,nft+1), xnod, edgec(1,nft+1),fac,ied)
210 IF (fac == 2) tagxnod(ls+1) = 1
211C
212C add warning message if FAC /= 2
213C
214 IF(fac == 2)THEN
215 elcut(i+nft) = 1
216 nelcut = 1
217 numelcrk = numelcrk + 1
218 ENDIF
219 ENDDO
220C---
221 IF(nelcut == 0)GOTO 200
222C---
223 CALL ccoori(x,xrefc(1,1,nft+1),ixc(1,nft+1),
224 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
225 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
226 . ix1 ,ix2 ,ix3 ,ix4 ,ngl )
227C local coordinates
228 CALL xyzloc4n(x1l,y1l,x2l,y2l,x3l,y3l,x4l,y4l,
229 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
230 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 )
231C
232c---
233 CALL preinicrk4n(elbuf_tab(ng),xfem_tab(ng,1:nxel) ,
234 . x1l ,y1l ,x2l ,y2l ,x3l ,
235 . y3l , x4l ,y4l ,lft ,llt ,
236 . nft ,nxlay ,ielcrkc ,edgec ,beta0 ,
237 . iedgesh4,elcut ,xnod ,ixc ,nodedge ,
238 . tagskyc ,knod2elc,tagedge,crklvset,crkshell,
239 . crkedge ,xfem_phantom)
240c
241c-------------------------
242 ELSE IF (ity==7) THEN
243c SHELL 3N
244c-------------------------
245 ish3n = iparg(23,ng)
246c
247 DO i=lft,llt
248 fac = 0
249C
250c - First check - (coincident nodes not accepted)
251C
252 IF(xnod(1,1) == xnod(1,2)) fac = 1
253C
254 IF(fac == 1)THEN
255 CALL ancmsg(msgid=1618,
256 . msgtype=msgerror,
257 . anmode=aninfo,
258 . i1=id,
259 . i2=1,
260 . c1=titr )
261 ENDIF
262C
263 IF(xnod(2,1) == xnod(2,2)) fac = 2
264C
265 IF(fac == 2)THEN
266 CALL ancmsg(msgid=1618,
267 . msgtype=msgerror,
268 . anmode=aninfo,
269 . i1=id,
270 . i2=2,
271 . c1=titr )
272 ENDIF
273C---
274 fac = 0
275 CALL elcut3n(i,ixtg(1,nft+1),xnod,edgetg(1,nft+1),fac,1)
276 IF (fac == 1) tagxnod(ls) = 1
277C
278c add warning message if FAC /= 1 ! XNOD1 must fit an element edge's
279C
280 CALL elcut3n(i,ixtg(1,nft+1),xnod,edgetg(1,nft+1),fac,2)
281 IF (fac == 2) tagxnod(ls+1) = 1
282C
283c add warning message if FAC /= 2
284C
285 IF (fac == 2) THEN
286 elcut(i+nft+numelc) = 1
287 nelcut = 1
288 numelcrk = numelcrk + 1
289 ENDIF
290 ENDDO ! I=LFT,LLT
291c----------------------------------
292 IF (nelcut == 0) GOTO 200
293C---
294 CALL c3coori(x,xreftg(1,1,nft+1),ixtg(1,nft+1),ngl,
295 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
296 . z1 ,z2 ,z3 ,ix1 ,ix2 ,ix3 )
297C local coordinates
298 CALL xyzloc3n(x1l ,y1l ,x2l ,y2l ,x3l ,y3l ,
299 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
300 . z1 ,z2 ,z3 )
301c---
302 CALL preinicrk3n(elbuf_tab(ng),xfem_tab(ng,1:nxel) ,
303 . x1l ,y1l ,x2l ,y2l ,x3l ,
304 . y3l ,lft ,llt ,nft ,nxlay ,
305 . ielcrktg,edgetg ,beta0 ,iedgesh3,elcut(itg),
306 . xnod ,ixtg ,nodedge,tagskytg,knod2elc ,
307 . tagedge ,crklvset,crkshell,crkedge,xfem_phantom)
308 ENDIF
309C---
310 IF (nelcut == 1) EXIT ! cracked element already tag
311C---
312 200 CONTINUE
313c------------------------------------------------------------------------
314C to update warning message
315 IF(nelcut == 0)THEN
316 IF(tagxnod(ls) == 0)THEN
317 CALL ancmsg(msgid=1617,
318 . msgtype=msgerror,
319 . anmode=aninfo,
320 . i1=id,
321 . i2=itab(xnod(1,1)),
322 . i3=itab(xnod(1,2)),
323 . c1=titr )
324
325 ELSEIF(tagxnod(ls+1) == 0)THEN
326 CALL ancmsg(msgid=1617,
327 . msgtype=msgerror,
328 . anmode=aninfo,
329 . i1=id,
330 . i2=itab(xnod(2,1)),
331 . i3=itab(xnod(2,2)),
332 . c1=titr )
333
334 ENDIF
335 ENDIF
336c-----
337 ENDDO ! LS=1,NXSEG
338c------------------------------------------------------------------------
339c Tag tip edges and activate xfem groups
340c------------------------------------------------------------------------
341 DO ng=1,ngroup
342 ixfem = iparg(54,ng)
343 IF (ixfem == 0) cycle
344c
345 nxlay = elbuf_tab(ng)%NLAY
346 nel = iparg(2,ng)
347 nft = iparg(3,ng)
348 ity = iparg(5,ng)
349 lft = 1
350 llt = min(nvsiz,nel)
351C---
352 IF (ity == 3) THEN
353 CALL edgetip4n(lft ,llt ,nft ,ielcrkc ,iedgesh4,
354 . nxlay ,edgec ,tagedge,crklvset,crkedge)
355C
356C activation of new group if initial cracks
357 CALL activ_xfem(iparg ,nft ,lft ,llt ,nxlay,
358 . ng ,ielcrkc,ity ,crkedge)
359 ELSEIF (ity == 7) THEN
360 CALL edgetip3n(lft ,llt ,nft ,ielcrktg,iedgesh3,
361 . nxlay ,edgetg ,tagedge,crklvset,crkedge)
362C
363C activation of new group if initial cracks
364 CALL activ_xfem(iparg ,nft ,lft ,llt ,nxlay,
365 . ng ,ielcrktg,ity ,crkedge)
366 ENDIF
367 ENDDO
368c Tag ICUTEDGE=2 for tip edges
369 DO ilay=1,nxlay
370 DO i=1,numedges
371 IF (crkedge(ilay)%EDGETIP(1,i) == 1 .or.
372 . crkedge(ilay)%EDGETIP(2,i) == 1) THEN
373 DO k=1,nxel
374 crklvset(nxel*(ilay-1)+k)%ICUTEDGE(i) = 2
375 ENDDO
376 ENDIF
377 ENDDO
378 ENDDO
379c------------------------------------------------------------------------
380 IF(ALLOCATED(elcut)) DEALLOCATE(elcut)
381 IF(ALLOCATED(beta)) DEALLOCATE(beta)
382 IF(ALLOCATED(edgec)) DEALLOCATE(edgec)
383 IF(ALLOCATED(edgetg))DEALLOCATE(edgetg)
384C-----------
385 RETURN
386 END
387c
388!||====================================================================
389!|| xyzloc4n ../starter/source/elements/xfem/lslocal.F
390!||--- called by ------------------------------------------------------
391!|| lslocal ../starter/source/elements/xfem/lslocal.F
392!||====================================================================
393 SUBROUTINE xyzloc4n(X1L,Y1L,X2L,Y2L,X3L,Y3L,X4L,Y4L,
394 . X1,X2,X3,X4,Y1,Y2,
395 . Y3,Y4,Z1,Z2,Z3,Z4)
396C-----------------------------------------------
397C I m p l i c i t T y p e s
398C-----------------------------------------------
399#include "implicit_f.inc"
400C-----------------------------------------------
401C G l o b a l P a r a m e t e r s
402C-----------------------------------------------
403#include "mvsiz_p.inc"
404C-----------------------------------------------
405C C o m m o n B l o c k s
406C-----------------------------------------------
407#include "vect01_c.inc"
408C-----------------------------------------------
409C D u m m y A r g u m e n t s
410C-----------------------------------------------
411 my_real, DIMENSION(MVSIZ), INTENT(OUT) :: x1l,y1l,x2l,y2l,x3l,y3l,x4l,y4l
412 my_real, DIMENSION(MVSIZ), INTENT(IN) :: x1,x2,x3,x4,y1,y2,
413 . y3,y4,z1,z2,z3,z4
414C-----------------------------------------------
415C L o c a l V a r i a b l e s
416C-----------------------------------------------
417 INTEGER I
418 my_real S1,S2,SUMA
419 my_real, DIMENSION(MVSIZ) :: x21,y21,z21,x31,y31,z31,x41,y41,z41,
420 . x42,y42,z42,e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z
421C=======================================================================
422 DO i=lft,llt
423 x21(i) = x2(i)-x1(i)
424 y21(i) = y2(i)-y1(i)
425 z21(i) = z2(i)-z1(i)
426 x31(i) = x3(i)-x1(i)
427 y31(i) = y3(i)-y1(i)
428 z31(i) = z3(i)-z1(i)
429 x41(i) = x4(i)-x1(i)
430 y41(i) = y4(i)-y1(i)
431 z41(i) = z4(i)-z1(i)
432 x42(i) = x4(i)-x2(i)
433 y42(i) = y4(i)-y2(i)
434 z42(i) = z4(i)-z2(i)
435 ENDDO
436c
437C--- repere orthogonalise vers 5.0
438 DO i=lft,llt
439 e1x(i) = x2(i)+x3(i)-x1(i)-x4(i)
440 e1y(i) = y2(i)+y3(i)-y1(i)-y4(i)
441 e1z(i) = z2(i)+z3(i)-z1(i)-z4(i)
442C
443 e2x(i) = x3(i)+x4(i)-x1(i)-x2(i)
444 e2y(i) = y3(i)+y4(i)-y1(i)-y2(i)
445 e2z(i) = z3(i)+z4(i)-z1(i)-z2(i)
446C
447 e3x(i) = e1y(i)*e2z(i)-e1z(i)*e2y(i)
448 e3y(i) = e1z(i)*e2x(i)-e1x(i)*e2z(i)
449 e3z(i) = e1x(i)*e2y(i)-e1y(i)*e2x(i)
450 ENDDO
451C---
452 DO i=lft,llt
453 suma = e3x(i)*e3x(i)+e3y(i)*e3y(i)+e3z(i)*e3z(i)
454 suma = one/max(sqrt(suma),em20)
455 e3x(i) = e3x(i)*suma
456 e3y(i) = e3y(i)*suma
457 e3z(i) = e3z(i)*suma
458C
459 s1 = e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i)
460 s2 = e2x(i)*e2x(i)+e2y(i)*e2y(i)+e2z(i)*e2z(i)
461 suma = sqrt(s1/s2)
462 e1x(i) = e1x(i) + (e2y(i)*e3z(i)-e2z(i)*e3y(i))*suma
463 e1y(i) = e1y(i) + (e2z(i)*e3x(i)-e2x(i)*e3z(i))*suma
464 e1z(i) = e1z(i) + (e2x(i)*e3y(i)-e2y(i)*e3x(i))*suma
465C
466 suma = e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i)
467 suma = one/max(sqrt(suma),em20)
468 e1x(i) = e1x(i)*suma
469 e1y(i) = e1y(i)*suma
470 e1z(i) = e1z(i)*suma
471C
472 e2x(i) = e3y(i) * e1z(i) - e3z(i) * e1y(i)
473 e2y(i) = e3z(i) * e1x(i) - e3x(i) * e1z(i)
474 e2z(i) = e3x(i) * e1y(i) - e3y(i) * e1x(i)
475 ENDDO
476C
477 DO i=lft,llt
478 x1l(i) = zero
479 y1l(i) = zero
480 x2l(i) = e1x(i)*x21(i)+e1y(i)*y21(i)+e1z(i)*z21(i)
481 y2l(i) = e2x(i)*x21(i)+e2y(i)*y21(i)+e2z(i)*z21(i)
482 x3l(i) = e1x(i)*x31(i)+e1y(i)*y31(i)+e1z(i)*z31(i)
483 y3l(i) = e2x(i)*x31(i)+e2y(i)*y31(i)+e2z(i)*z31(i)
484 x4l(i) = e1x(i)*x41(i)+e1y(i)*y41(i)+e1z(i)*z41(i)
485 y4l(i) = e2x(i)*x41(i)+e2y(i)*y41(i)+e2z(i)*z41(i)
486 ENDDO
487c-----------
488 RETURN
489 END
490c
491!||====================================================================
492!|| xyzloc3n ../starter/source/elements/xfem/lslocal.F
493!||--- called by ------------------------------------------------------
494!|| lslocal ../starter/source/elements/xfem/lslocal.F
495!||--- calls -----------------------------------------------------
496!|| clskew3 ../starter/source/elements/shell/coque/clskew.f
497!||====================================================================
498 SUBROUTINE xyzloc3n(X1L,Y1L,X2L,Y2L,X3L,Y3L,
499 . X1G,X2G,X3G,Y1G,Y2G,Y3G,
500 . Z1G,Z2G,Z3G)
501C-----------------------------------------------
502C I m p l i c i t T y p e s
503C-----------------------------------------------
504#include "implicit_f.inc"
505C-----------------------------------------------
506C G l o b a l P a r a m e t e r s
507C-----------------------------------------------
508#include "mvsiz_p.inc"
509C-----------------------------------------------
510C C o m m o n B l o c k s
511C-----------------------------------------------
512#include "vect01_c.inc"
513C-----------------------------------------------
514C D u m m y A r g u m e n t s
515C-----------------------------------------------
516 my_real, DIMENSION(MVSIZ), INTENT(OUT) :: x1l,y1l,x2l,y2l,x3l,y3l
517 my_real, DIMENSION(MVSIZ), INTENT(IN) :: x1g,x2g,x3g,y1g,y2g,y3g,
518 . z1g,z2g,z3g
519C-----------------------------------------------
520C L o c a l V a r i a b l e s
521C-----------------------------------------------
522 INTEGER I,I1
523 my_real, DIMENSION(MVSIZ) :: SUM, RX, RY, RZ, SX, SY, SZ,
524 . E1X, E1Y, E1Z, E2X, E2Y, E2Z, E3X, E3Y, E3Z
525C=======================================================================
526 DO i=lft,llt
527 rx(i) = x2g(i) - x1g(i)
528 ry(i) = y2g(i) - y1g(i)
529 rz(i) = z2g(i) - z1g(i)
530 sx(i) = x3g(i) - x1g(i)
531 sy(i) = y3g(i) - y1g(i)
532 sz(i) = z3g(i) - z1g(i)
533 ENDDO
534C----------------------------
535 i1 = 0
536 CALL clskew3(lft,llt,i1,
537 . rx, ry, rz, sx, sy, sz,
538 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,sum)
539c DO I=JFT,JLT
540c AREA(I) = HALF*SUM(I)
541c ENDDO
542C----------------------------
543C
544 DO i=lft,llt
545 x1l(i) = zero
546 y1l(i) = zero
547 x2l(i) = e1x(i)*rx(i) + e1y(i)*ry(i) + e1z(i)*rz(i)
548 y2l(i) = e2x(i)*rx(i) + e2y(i)*ry(i) + e2z(i)*rz(i)
549 y3l(i) = e2x(i)*sx(i) + e2y(i)*sy(i) + e2z(i)*sz(i)
550 x3l(i) = e1x(i)*sx(i) + e1y(i)*sy(i) + e1z(i)*sz(i)
551 ENDDO
552C---------------------------------------------------------
553 RETURN
554 END
555c
556!||====================================================================
557!|| activ_xfem ../starter/source/elements/xfem/lslocal.F
558!||--- called by ------------------------------------------------------
559!|| lslocal ../starter/source/elements/xfem/lslocal.F
560!||--- uses -----------------------------------------------------
561!||====================================================================
562 SUBROUTINE activ_xfem(IPARG ,NFT ,LFT ,LLT ,NXLAY,
563 . NG ,IEL_CRK,ITY ,CRKEDGE)
564C-----------------------------------------------
565 USE xfem2def_mod
566C-----------------------------------------------
567C I m p l i c i t T y p e s
568C-----------------------------------------------
569#include "implicit_f.inc"
570C-----------------------------------------------
571C C o m m o n B l o c k s
572C-----------------------------------------------
573#include "param_c.inc"
574C-----------------------------------------------
575C D u m m y A r g u m e n t s
576C-----------------------------------------------
577 INTEGER NFT,LFT,LLT,NXLAY,NG,ITY
578 INTEGER IPARG(NPARG,*),IEL_CRK(*)
579 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
580C-----------------------------------------------
581C L o c a l V a r i a b l e s
582C-----------------------------------------------
583 INTEGER I,ELCRK,ILAYCUT,ILAY,IGON,ISHEON
584C=======================================================================
585C TEST FOR NEW GROUP ACTIVATION
586C----------------------------------------
587 IGON = 0
588 DO i=lft,llt
589 isheon = 0
590 elcrk = iel_crk(i+nft)
591c IF (ITY == 7) ELCRK = ELCRK + ECRKXFEC
592 IF (elcrk > 0) THEN
593 DO ilay = 1,nxlay
594 ilaycut = crkedge(ilay)%LAYCUT(elcrk)
595 isheon = max(isheon, ilaycut)
596 ENDDO
597 IF (isheon > 0) THEN
598 igon = 1
599 EXIT
600 ENDIF
601 ENDIF
602 ENDDO
603 iparg(70,ng) = igon
604C-----------
605 RETURN
606 END
607c
608!||====================================================================
609!|| elcut4n ../starter/source/elements/xfem/lslocal.F
610!||--- called by ------------------------------------------------------
611!|| lslocal ../starter/source/elements/xfem/lslocal.F
612!||--- uses -----------------------------------------------------
613!||====================================================================
614 SUBROUTINE elcut4n(IEL ,IXC ,XNOD, EDGEC, FAC , IED)
615 use element_mod , only : nixc
616C-----------------------------------------------
617C I m p l i c i t T y p e s
618C-----------------------------------------------
619#include "implicit_f.inc"
620C-----------------------------------------------
621C D u m m y A r g u m e n t s
622C-----------------------------------------------
623 INTEGER IEL,IXC(NIXC,*),XNOD(2,2),EDGEC(4,*),FAC,IED
624C-----------------------------------------------
625C L o c a l V a r i a b l e s
626C-----------------------------------------------
627 INTEGER K,N1,N2,d1(4),d2(4)
628 DATA d1/2,3,4,5/
629 DATA d2/3,4,5,2/
630C=======================================================================
631 DO K=1,4 ! edges
632 n1 = ixc(d1(k),iel) ! 1st Node
633 n2 = ixc(d2(k),iel) ! 2nd Node
634 IF ((n1 == xnod(ied,1) .AND. n2 == xnod(ied,2)) .OR.
635 . (n2 == xnod(ied,1) .AND. n1 == xnod(ied,2))) THEN
636 fac = fac + 1
637 edgec(k,iel) = fac
638 EXIT
639 ENDIF
640 ENDDO
641C---
642 RETURN
643 END
644!||====================================================================
645!|| elcut3n ../starter/source/elements/xfem/lslocal.F
646!||--- called by ------------------------------------------------------
647!|| lslocal ../starter/source/elements/xfem/lslocal.F
648!||--- uses -----------------------------------------------------
649!||====================================================================
650 SUBROUTINE elcut3n(IEL ,IXTG ,XNOD, EDGETG, FAC , IED)
651 use element_mod , only : nixtg
652C-----------------------------------------------
653C I m p l i c i t T y p e s
654C-----------------------------------------------
655#include "implicit_f.inc"
656C-----------------------------------------------
657C D u m m y A r g u m e n t s
658C-----------------------------------------------
659 INTEGER IEL,IXTG(NIXTG,*),XNOD(2,2),EDGETG(3,*),FAC,IED
660C-----------------------------------------------
661C L o c a l V a r i a b l e s
662C-----------------------------------------------
663 INTEGER K,N1,N2,d1(3),d2(3)
664 DATA d1/2,3,4/
665 DATA d2/3,4,2/
666C=======================================================================
667 DO K=1,3
668 n1 = ixtg(d1(k),iel)
669 n2 = ixtg(d2(k),iel)
670 IF ((n1 == xnod(ied,1) .AND. n2 == xnod(ied,2)) .OR.
671 . (n2 == xnod(ied,1) .AND. n1 == xnod(ied,2))) THEN
672 fac = fac + 1
673 edgetg(k,iel) = fac
674 EXIT
675 ENDIF
676 ENDDO
677C-----------
678 RETURN
679 END
680!||====================================================================
681!|| edgetip4n ../starter/source/elements/xfem/lslocal.F
682!||--- called by ------------------------------------------------------
683!|| lslocal ../starter/source/elements/xfem/lslocal.F
684!||--- uses -----------------------------------------------------
685!||====================================================================
686 SUBROUTINE edgetip4n(LFT ,LLT ,NFT ,IELCRKC ,IEDGESH4,
687 . NXLAY ,EDGEC ,TAGEDGE,CRKLVSET,CRKEDGE)
688C-----------------------------------------------
689C M o d u l e s
690C-----------------------------------------------
691 USE xfem2def_mod
692C-----------------------------------------------
693C I m p l i c i t T y p e s
694C-----------------------------------------------
695#include "implicit_f.inc"
696C-----------------------------------------------
697C C o m m o n B l o c K s
698C-----------------------------------------------
699#include "com_xfem1.inc"
700C-----------------------------------------------
701C D u m m y A r g u m e n t s
702C-----------------------------------------------
703 INTEGER LFT,LLT,NFT,IELCRKC(*),EDGEC(4,*),
704 . IEDGESH4(4,*),NXLAY,TAGEDGE(*)
705 TYPE (XFEM_LVSET_) , DIMENSION(NLEVMAX) :: CRKLVSET
706 TYPE (XFEM_EDGE_) , DIMENSION(NXLAYMAX):: CRKEDGE
707C-----------------------------------------------
708C L o c a l V a r i a b l e s
709C-----------------------------------------------
710 INTEGER I,K,ELCRK,IED,IEDGE,IXEL,ILEV,ILAY,ELCUT
711C=======================================================================
712C set tip edges:
713C--------------------
714 DO ILAY=1,nxlay
715 DO i=lft,llt
716 elcrk = ielcrkc(i+nft)
717 elcut = crkedge(ilay)%LAYCUT(elcrk)
718 IF (elcut /= 0) THEN
719 DO k=1,4
720 ied = edgec(k,i+nft)
721 iedge = iedgesh4(k,elcrk)
722 IF (ied > 0)THEN
723 IF (tagedge(iedge) == 1) THEN
724 DO ixel=1,nxel
725 ilev = nxel*(ilay-1) + ixel
726 crklvset(ilev)%ICUTEDGE(iedge) = 2
727 ENDDO
728 ENDIF
729 ENDIF
730 ENDDO
731 ENDIF
732 ENDDO
733 ENDDO
734C-----------
735 RETURN
736 END
737!||====================================================================
738!|| edgetip3n ../starter/source/elements/xfem/lslocal.F
739!||--- called by ------------------------------------------------------
740!|| lslocal ../starter/source/elements/xfem/lslocal.F
741!||--- uses -----------------------------------------------------
742!||====================================================================
743 SUBROUTINE edgetip3n(LFT ,LLT ,NFT ,IELCRKTG,IEDGESH3,
744 . NXLAY ,EDGETG ,TAGEDGE,CRKLVSET,CRKEDGE)
745C-----------------------------------------------
746C M o d u l e s
747C-----------------------------------------------
748 USE xfem2def_mod
749C-----------------------------------------------
750C I m p l i c i t T y p e s
751C-----------------------------------------------
752#include "implicit_f.inc"
753C-----------------------------------------------
754C C o m m o n B l o c K s
755C-----------------------------------------------
756#include "com_xfem1.inc"
757C-----------------------------------------------
758C D u m m y A r g u m e n t s
759C-----------------------------------------------
760 INTEGER LFT,LLT,NFT,IELCRKTG(*),EDGETG(3,*),
761 . iedgesh3(3,*),nxlay,tagedge(*)
762 TYPE (XFEM_LVSET_) , DIMENSION(NLEVMAX) :: CRKLVSET
763 TYPE (XFEM_EDGE_) , DIMENSION(NXLAYMAX):: CRKEDGE
764C-----------------------------------------------
765C L o c a l V a r i a b l e s
766C-----------------------------------------------
767 INTEGER I,K,ELCRK,IED,IEDGE,IXEL,ILEV,ILAY,ELCUT
768C=======================================================================
769C set tip edges:
770C--------------------
771 DO ILAY=1,nxlay
772 DO i=lft,llt
773 elcrk = ielcrktg(i+nft) - ecrkxfec
774 elcut = crkedge(ilay)%LAYCUT(elcrk)
775 IF (elcut /= 0) THEN
776 DO k=1,3
777 ied = edgetg(k,i+nft)
778 iedge = iedgesh3(k,elcrk)
779 IF (ied > 0) THEN
780 IF (tagedge(iedge) == 1) THEN
781 DO ixel=1,nxel
782 ilev = nxel*(ilay-1) + ixel
783 crklvset(ilev)%ICUTEDGE(iedge) = 2
784 ENDDO
785 ENDIF
786 ENDIF
787 ENDDO
788 ENDIF
789 ENDDO
790 ENDDO
791C-----------
792 RETURN
793 END
c3coori
subroutine c3coori(x, xreftg, ixp, ngl, x1, x2, x3, y1, y2, y3, z1, z2, z3, ix1, ix2, ix3)
Definition c3coori.F:39
ccoori
subroutine ccoori(x, xrefc, ixc, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, ix1, ix2, ix3, ix4, ngl)
Definition ccoori.F:40
clskew3
subroutine clskew3(jft, jlt, irep, rx, ry, rz, sx, sy, sz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, det)
Definition clskew.F:34
my_real
#define my_real
Definition cppsort.cpp:32
inicrkfill
subroutine inicrkfill(elbuf_tab, xfem_tab, ixc, ixtg, iparg, inicrack, x, iel_crk, inod_crk, xrefc, xreftg, iedgesh4, iedgesh3, nodedge, crklvset, crkshell, crkedge, xfem_phantom, itab)
Definition inicrkfill.F:36
xyzloc4n
subroutine xyzloc4n(x1l, y1l, x2l, y2l, x3l, y3l, x4l, y4l, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4)
Definition lslocal.F:396
activ_xfem
subroutine activ_xfem(iparg, nft, lft, llt, nxlay, ng, iel_crk, ity, crkedge)
Definition lslocal.F:564
edgetip4n
subroutine edgetip4n(lft, llt, nft, ielcrkc, iedgesh4, nxlay, edgec, tagedge, crklvset, crkedge)
Definition lslocal.F:688
elcut4n
subroutine elcut4n(iel, ixc, xnod, edgec, fac, ied)
Definition lslocal.F:615
elcut3n
subroutine elcut3n(iel, ixtg, xnod, edgetg, fac, ied)
Definition lslocal.F:651
xyzloc3n
subroutine xyzloc3n(x1l, y1l, x2l, y2l, x3l, y3l, x1g, x2g, x3g, y1g, y2g, y3g, z1g, z2g, z3g)
Definition lslocal.F:501
edgetip3n
subroutine edgetip3n(lft, llt, nft, ielcrktg, iedgesh3, nxlay, edgetg, tagedge, crklvset, crkedge)
Definition lslocal.F:745
lslocal
subroutine lslocal(elbuf_tab, xfem_tab, iparg, ixc, ixtg, xrefc, xreftg, x, icrk, inod_crk, nxseg, nodls, ratiols, ntag, ielcrkc, ielcrktg, iedgesh4, iedgesh3, nodedge, tagskyc, tagskytg, knod2elc, tagedge, crklvset, crkshell, crkedge, xfem_phantom, itab, id, titr)
Definition lslocal.F:50
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
xfem2def_mod
Definition xfem2def_mod.F:40
preinicrk3n
subroutine preinicrk3n(elbuf_str, xfem_str, x1l, y1l, x2l, y2l, x3l, y3l, lft, llt, nft, nxlay, ielcrktg, edgetg, beta0, iedgesh3, elcut, xnod, ixtg, nodedge, tagskytg, knod2elc, tagedge, crklvset, crkshell, crkedge, xfem_phantom)
Definition preinicrk3N.F:37
preinicrk4n
subroutine preinicrk4n(elbuf_str, xfem_str, x1l, y1l, x2l, y2l, x3l, y3l, x4l, y4l, lft, llt, nft, nxlay, ielcrkc, edgec, beta0, iedgesh4, elcut, xnod, ixc, nodedge, tagskyc, knod2elc, tagedge, crklvset, crkshell, crkedge, xfem_phantom)
Definition preinicrk4N.F:38
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
starter
program starter
Definition starter.F:39