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

Go to the source code of this file.

Functions/Subroutines

subroutine upenric_last (ixc, nft, jft, jlt, iadc_crk, iel_crk, elcutc, nxlay, crkedge)

Function/Subroutine Documentation

◆ upenric_last()

subroutine upenric_last ( integer, dimension(nixc,*) ixc,
integer nft,
integer jft,
integer jlt,
integer, dimension(4,*) iadc_crk,
integer, dimension(*) iel_crk,
integer, dimension(2,*) elcutc,
integer nxlay,
type (xfem_edge_), dimension(*) crkedge )

Definition at line 31 of file upenric_last.F.

34C-----------------------------------------------
36 use element_mod , only : nixc
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com_xfem1.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER NFT,JFT,JLT,NXLAY
49 INTEGER IXC(NIXC,*),IADC_CRK(4,*),IEL_CRK(*),ELCUTC(2,*)
50 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER I,II,NS,ILEV,ILAY,IXEL,ICUT,LAYCUT,ELCRK,IADC1,IADC2,IADC3,IADC4
55C=======================================================================
56 DO i=jft,jlt
57 ns = i+nft
58 icut = elcutc(1,ns)
59 IF (icut == 0) cycle
60 elcutc(2,ns) = icut
61 elcrk = iel_crk(ns)
62 iadc1 = iadc_crk(1,elcrk)
63 iadc2 = iadc_crk(2,elcrk)
64 iadc3 = iadc_crk(3,elcrk)
65 iadc4 = iadc_crk(4,elcrk)
66 DO ilay = 1,nxlay
67 laycut = crkedge(ilay)%LAYCUT(elcrk)
68 IF (laycut == 0) cycle
69 ii = nxel*(ilay-1)
70 DO ixel=1,nxel
71 ilev = ii + ixel
72 crklvset(ilev)%ENR0(2,iadc1) = crklvset(ilev)%ENR0(1,iadc1)
73 crklvset(ilev)%ENR0(2,iadc2) = crklvset(ilev)%ENR0(1,iadc2)
74 crklvset(ilev)%ENR0(2,iadc3) = crklvset(ilev)%ENR0(1,iadc3)
75 crklvset(ilev)%ENR0(2,iadc4) = crklvset(ilev)%ENR0(1,iadc4)
76 ENDDO
77 ENDDO
78 ENDDO
79C-------------
80 RETURN
type(xfem_lvset_), dimension(:), allocatable crklvset