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