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
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
158 END
159!||====================================================================
160!|| qsurf ../starter/source/groups/qsurftag.F
161!||--- called by ------------------------------------------------------
162!|| qsurftag ../starter/source/groups/qsurftag.F
163!||====================================================================
164 SUBROUTINE qsurf(N1 ,N2 ,JQ ,NSEG0 ,ISEG,
165 . SURF_ELTYP,SURF_ELEM,SURF_NODES)
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
184 END
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
qsurftag
subroutine qsurftag(ixq, ipartq, nseg0, igrsurf, tagbuf, nseg, knod2elq, nod2elq, iext, flag, x)
Definition qsurftag.F:34