OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
qsurftag.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!|| qsurftag ../starter/source/groups/qsurftag.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_surf ../starter/source/groups/hm_read_surf.F
27!||--- calls -----------------------------------------------------
28!|| qsurf ../starter/source/groups/qsurftag.F
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE qsurftag(IXQ ,IPARTQ ,NSEG0 ,IGRSURF ,TAGBUF,
32 . NSEG ,KNOD2ELQ ,NOD2ELQ ,IEXT ,FLAG ,
33 . X )
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
159 END
160!||====================================================================
161!|| qsurf ../starter/source/groups/qsurftag.F
162!||--- called by ------------------------------------------------------
163!|| qsurftag ../starter/source/groups/qsurftag.F
164!||====================================================================
165 SUBROUTINE qsurf(N1 ,N2 ,JQ ,NSEG0 ,ISEG,
166 . SURF_ELTYP,SURF_ELEM,SURF_NODES)
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
185 END
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
qsurftag
subroutine qsurftag(ixq, ipartq, nseg0, igrsurf, tagbuf, nseg, knod2elq, nod2elq, iext, flag, x)
Definition qsurftag.F:34