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

Go to the source code of this file.

Functions/Subroutines

subroutine ani_segquadfr1 (ixq, segtag, knod2elq, nod2elq, x, nseg)
subroutine ani_segquadfr2 (segtag, segquadfr)

Function/Subroutine Documentation

◆ ani_segquadfr1()

subroutine ani_segquadfr1 ( integer, dimension(nixq,*) ixq,
integer, dimension(4,*) segtag,
integer, dimension(*) knod2elq,
integer, dimension(*) nod2elq,
x,
integer nseg )

Definition at line 29 of file ani_segquadfr.F.

30 use element_mod , only : nixq
31C-----------------------------------------------
32C I m p l i c i t T y p e s
33C-----------------------------------------------
34#include "implicit_f.inc"
35C-----------------------------------------------
36C C o m m o n B l o c k s
37C-----------------------------------------------
38#include "com01_c.inc"
39#include "com04_c.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43C REAL
44 INTEGER
45 . NSEG,
46 . IXQ(NIXQ,*),SEGTAG(4,*),KNOD2ELQ(*),NOD2ELQ(*)
48 . x(3,*)
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER JQ,K,N1,N2,KK,KQ,L1,L2,L, TRUEAXE, NQQ1,NQQ2
53 INTEGER NODTAG(4),LINES(2,4),NQ(4)
54 DATA lines/1,2,
55 . 2,3,
56 . 3,4,
57 . 4,1/
58C REAL
59C-----------------------------------------------
60C
61 DO jq=1,numelq
62 nodtag(1:4)=1
63 DO l=1,4
64 nq(l) = ixq(l+1,jq)
65 l1 = lines(1,l)
66 l2 = lines(2,l)
67 nqq1 = ixq(l1+1,jq)
68 nqq2 = ixq(l2+1,jq)
69 DO k=knod2elq(nqq1)+1,knod2elq(nqq1+1)
70 kq=nod2elq(k)
71 IF(kq==jq .OR. kq > numelq)cycle
72 DO kk=1,4
73 IF(ixq(lines(1,kk)+1,kq)==nqq1.AND.ixq(lines(2,kk)+1,kq)==nqq2) THEN
74 nodtag(l)=0
75 ELSEIF(ixq(lines(1,kk)+1,kq)==nqq2.AND.ixq(lines(2,kk)+1,kq)==nqq1) THEN
76 nodtag(l)=0
77 ENDIF
78 ENDDO
79 ENDDO
80 ENDDO
81C
82 DO l=1,4
83 l1 = lines(1,l)
84 l2 = lines(2,l)
85 trueaxe= 1
86 n1 = nq(l1)
87 n2 = nq(l2)
88 IF(n2d==1.AND.x(2,n1)<=em10.AND.x(2,n2)<=em10) THEN ! Case Axi omit nodes of revolution axe z ( y=0)
89 trueaxe= 0
90 ENDIF
91
92 IF(trueaxe==1)THEN
93 IF(nodtag(l)==1) THEN ! nodes of external lines
94 nseg=nseg+1
95 segtag(l,jq) = 1
96 ENDIF
97 ENDIF
98 ENDDO
99 ENDDO
100C
101 RETURN
#define my_real
Definition cppsort.cpp:32

◆ ani_segquadfr2()

subroutine ani_segquadfr2 ( integer, dimension(4,*) segtag,
integer, dimension(2,*) segquadfr )

Definition at line 108 of file ani_segquadfr.F.

109C-----------------------------------------------
110C I m p l i c i t T y p e s
111C-----------------------------------------------
112#include "implicit_f.inc"
113C-----------------------------------------------
114C C o m m o n B l o c k s
115C-----------------------------------------------
116#include "com01_c.inc"
117#include "com04_c.inc"
118C-----------------------------------------------
119C D u m m y A r g u m e n t s
120C-----------------------------------------------
121 INTEGER
122 . SEGTAG(4,*), SEGQUADFR(2,*)
123C-----------------------------------------------
124C L o c a l V a r i a b l e s
125C-----------------------------------------------
126 INTEGER N,JJ
127C REAL
128C-----------------------------------------------
129C
130 nsegquadfr=0
131 DO n=1,numelq
132 DO jj=1,4
133 IF(segtag(jj,n)==1)THEN
134 nsegquadfr=nsegquadfr+1
135 segquadfr(1,nsegquadfr)=n
136 segquadfr(2,nsegquadfr)=jj
137 END IF
138 END DO
139 END DO
140 RETURN