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

Go to the source code of this file.

Functions/Subroutines

subroutine qsurftag (ixq, ipartq, nseg0, igrsurf, tagbuf, nseg, knod2elq, nod2elq, iext, flag, x)
subroutine qsurf (n1, n2, jq, nseg0, iseg, surf_eltyp, surf_elem, surf_nodes)

Function/Subroutine Documentation

◆ qsurf()

subroutine qsurf ( integer n1,
integer n2,
integer jq,
integer nseg0,
integer iseg,
integer, dimension(nseg0) surf_eltyp,
integer, dimension(nseg0) surf_elem,
integer, dimension(nseg0,4) surf_nodes )

Definition at line 165 of file qsurftag.F.

167C-----------------------------------------------
168C I m p l i c i t T y p e s
169C-----------------------------------------------
170#include "implicit_f.inc"
171C-----------------------------------------------
172C D u m m y A r g u m e n t s
173C-----------------------------------------------
174 INTEGER N1,N2,JQ,NSEG0,ISEG
175 INTEGER SURF_ELTYP(NSEG0),SURF_ELEM(NSEG0),SURF_NODES(NSEG0,4)
176C-----------------------------------------------
177 surf_nodes(iseg,1) = n1
178 surf_nodes(iseg,2) = n2
179 surf_nodes(iseg,3) = 0
180 surf_nodes(iseg,4) = 0
181 surf_eltyp(iseg) = 2
182 surf_elem(iseg) = jq
183!---
184 RETURN

◆ qsurftag()

subroutine qsurftag ( integer, dimension(nixq,*) ixq,
integer, dimension(*) ipartq,
integer nseg0,
type (surf_) igrsurf,
integer, dimension(*) tagbuf,
integer, intent(inout) nseg,
integer, dimension(*) knod2elq,
integer, dimension(*) nod2elq,
integer iext,
integer flag,
x )

Definition at line 31 of file qsurftag.F.

34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE groupdef_mod
38 use element_mod , only : nixq
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43#include "com04_c.inc"
44#include "com01_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER IXQ(NIXQ,*),IPARTQ(*),TAGBUF(*),
49 . KNOD2ELQ(*),NOD2ELQ(*)
50 INTEGER IEXT,FLAG,NSEG0
51 INTEGER, INTENT(INOUT) :: NSEG
52 my_real
53 . x(3,*)
54 TYPE (SURF_) :: IGRSURF
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER JQ, K, N1, N2, ISEG, KK, KQ, L1, L2, L, TRUEAXE, NQQ1, NQQ2
59 INTEGER NODTAG(4),LINES(2,4),NQ(4)
60 DATA lines/1,2,
61 . 2,3,
62 . 3,4,
63 . 4,1/
64 my_real
65 . y1,z1,y2,z2,y3,z3,y4,z4,
66 . yg,zg,pvect,psca,dy,dz,ny,nz
67C=======================================================================
68C
69 IF(iext==1)THEN
70C
71C External surface only.
72 DO jq=1,numelq
73 IF (tagbuf(ipartq(jq))==0) cycle !case of tagged parts
74 nodtag(1:4)=1
75c NQ(N) = IXQ(JJ-1,JQ)
76 DO l=1,4
77 nq(l) = ixq(l+1,jq)
78 l1 = lines(1,l)
79 l2 = lines(2,l)
80 nqq1 = ixq(l1+1,jq)
81 nqq2 = ixq(l2+1,jq)
82 DO k=knod2elq(nqq1)+1,knod2elq(nqq1+1)
83 kq=nod2elq(k)
84 IF(kq==jq .OR. kq > numelq)cycle
85 IF (tagbuf(ipartq(kq))==0)cycle
86 DO kk=1,4
87 IF(ixq(lines(1,kk)+1,kq)==nqq1.AND.ixq(lines(2,kk)+1,kq)==nqq2) THEN
88 nodtag(l)=0
89 ELSEIF(ixq(lines(1,kk)+1,kq)==nqq2.AND.ixq(lines(2,kk)+1,kq)==nqq1) THEN
90 nodtag(l)=0
91 ENDIF
92 ENDDO
93 ENDDO
94 ENDDO
95C looks for the center of elements to check normal ext
96 y1 = x(2,nq(1))
97 z1 = x(3,nq(1))
98c
99 y2 = x(2,nq(2))
100 z2 = x(3,nq(2))
101c
102 y3 = x(2,nq(3))
103 z3 = x(3,nq(3))
104c
105 y4 = x(2,nq(4))
106 z4 = x(3,nq(4))
107c
108 yg = (y1+y2+y3+y4)/four
109 zg = (z1+z2+z3+z4)/four
110
111 DO l=1,4
112 l1 = lines(1,l)
113 l2 = lines(2,l)
114 trueaxe= 1
115 n1 = nq(l1)
116 n2 = nq(l2)
117 IF(n2d==1.AND.x(2,n1)<=em10.AND.x(2,n2)<=em10) THEN ! Case Axi omit nodes of revolution axe z ( y=0)
118 trueaxe= 0
119 ENDIF
120
121 IF(trueaxe==1)THEN
122 IF(nodtag(l)==1) THEN ! nodes of external lines
123 nseg=nseg+1
124 IF (flag == 1) THEN
125C normal computation
126 dy = x(2,n2)-x(2,n1)
127 dz = x(3,n2)-x(3,n1)
128 ny = -dz
129 nz = dy
130 pvect = dy*dz
131 IF(pvect<zero) THEN
132 ny = dz
133 nz = -dy
134 ENDIF
135C check external normal
136 psca = ny*(y1-yg)+nz*(z1-zg)
137 iseg = nseg
138 IF(psca<=zero) THEN
139 CALL qsurf(n1 ,n2 ,jq ,nseg0 ,iseg,
140 . igrsurf%ELTYP,igrsurf%ELEM,igrsurf%NODES)
141 ELSE
142 CALL qsurf(n2 ,n1 ,jq ,nseg0 ,iseg,
143 . igrsurf%ELTYP,igrsurf%ELEM,igrsurf%NODES)
144 ENDIF
145
146 ENDIF
147
148 ENDIF
149
150 ENDIF
151
152 ENDDO
153
154
155 ENDDO
156 ENDIF
157C-----------
158 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
groupdef_mod
Definition groupdef_mod.F:668
qsurf
subroutine qsurf(n1, n2, jq, nseg0, iseg, surf_eltyp, surf_elem, surf_nodes)
Definition qsurftag.F:167