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 164 of file qsurftag.F.

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