OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
findele.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!|| findele ../starter/source/boundary_conditions/ebcs/findele.F
25!||--- called by ------------------------------------------------------
26!|| iniebcs ../starter/source/boundary_conditions/ebcs/iniebcs.F
27!||--- calls -----------------------------------------------------
28!|| iface ../starter/source/ale/ale3d/iface.F
29!|| iface2 ../starter/source/ale/ale3d/iface.F
30!|| iface2t ../starter/source/ale/ale3d/iface.F
31!|| norma1 ../starter/source/interfaces/inter3d1/norma1.F
32!||--- uses -----------------------------------------------------
33!|| format_mod ../starter/share/modules1/format_mod.F90
34!|| message_mod ../starter/share/message_module/message_mod.F
35!||====================================================================
36 SUBROUTINE findele(ALE_CONNECTIVITY, NNODE, NIX, IDSU,ID,NSEG,NUMEL,IX,
37 . ISEG,IELE,ITYPE,IFAC,SURF_NODES,IADD,INVC,PM,X,TYPE,IGEO,ITAB)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE message_mod
42 USE ale_connectivity_mod
43 USE format_mod , ONLY : fmw_10i
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "param_c.inc"
52#include "units_c.inc"
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "scr03_c.inc"
56#include "tabsiz_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
61 INTEGER NNODE, NIX, IDSU,ID,NSEG,ISEG(*),IELE(*),ITYPE(*),
62 . iadd(*),invc(*),ifac(*),TYPE,surf_nodes(nseg,4)
63 INTEGER,INTENT(IN) :: NUMEL
64 INTEGER,INTENT(IN) :: IX(NIX,NUMEL)
65 INTEGER,INTENT(IN) :: ITAB(NUMNOD)
66 INTEGER,INTENT(IN) :: IGEO(NPROPGI,NUMGEO)
67 my_real pm(npropm,nummat),x(3,sx/3)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER II,JJ,J,K,M,PP,NN,KK,NEL,IRECT(4),IAD,N,ALE,NF,IP(NNODE),TURBU,NEIGH,CON(8),IS
72 INTEGER IFACE, IFACE2, IFACE2T, JALE_FROM_MAT, JALE_FROM_PROP,MINUS
73 my_real :: n1, n2, n3, dds,area
74 my_real :: xx1(4), xx2(4),xx3(4),xs1,ys1,zs1,xc,yc,zc
75 EXTERNAL iface, iface2, iface2t
76 DATA con/1,2,3,4,5,6,7,8/
77C-----------------------------------------------
78C S o u r c e L i n e s
79C-----------------------------------------------
80 turbu=0
81 neigh=0
82 IF(ipri>=1)WRITE(iout,1000)id,idsu
83
84 DO j=1,nseg
85 DO k=1,4
86 irect(k)=surf_nodes(j,k)
87 ENDDO
88 IF (irect(3) == 0) irect(3) = irect(2)
89 IF(irect(4)==0) irect(4)=irect(3)
90
91 nel=0
92 DO 230 iad=iadd(irect(1)),iadd(irect(1)+1)-1
93 DO k=1,nnode
94 ip(k)=0
95 ENDDO
96 n = invc(iad)
97 DO 220 jj=1,4
98 ii=irect(jj)
99 DO k=1,nnode
100 IF(ix(k+1,n)==ii)THEN
101 ip(k)=1
102 GOTO 220
103 ENDIF
104 ENDDO
105 GOTO 230
106 220 CONTINUE
107
108 IF (n2d == 0) THEN
109 ! 3D case (8 nodes)
110 nf=iface(ip,con)
111 IF (ip(1) * ip(3) * ip(6) /= 0) THEN
112 nf = 5
113 ELSEIF (ip(1) * ip(3) * ip(5) /= 0) THEN
114 nf = 6
115 ELSEIF (ip(3) * ip(6) * ip(5) /= 0) THEN
116 nf = 2
117 ELSEIF (ip(6) * ip(5) * ip(1) /= 0) THEN
118 nf = 4
119 ENDIF
120 ELSEIF (nnode == 4) THEN
121 ! 2D case (4 nodes : QUADS)
122 nf = iface2(ip, con)
123 ELSEIF (nnode == 3) THEN
124 ! 2D case (3 nodes : TRIANGLES)
125 nf = iface2t(ip, con)
126 ENDIF
127 nel = n
128
129 230 CONTINUE
130
131 IF (nel == 0) THEN
132 ierr=ierr+1
133 neigh=neigh+1
134 IF(n2d == 0)THEN
135 WRITE(istdo,*)' ** ERROR EBCS ',id,' FACE IS NOT FACING A SOLID ELEMENT, FACE :', itab(irect(1:4))
136 ELSE
137 WRITE(istdo,*)' ** ERROR EBCS ',id,' SEGMENTS IS NOT FACING A SOLID ELEMENT, SEG :', itab(irect(1:2))
138 ENDIF
139 GOTO 500
140 ENDIF
141
142 xs1=zero
143 ys1=zero
144 zs1=zero
145 IF(n2d == 0)THEN
146 DO jj=1,4
147 nn=irect(jj)
148 IF(nn==0)nn=irect(3) ! case N4=0 => N4=N3 (same result)
149 xx1(jj)=x(1,nn)
150 xx2(jj)=x(2,nn)
151 xx3(jj)=x(3,nn)
152 xs1=xs1+fourth*x(1,nn)
153 ys1=ys1+fourth*x(2,nn)
154 zs1=zs1+fourth*x(3,nn)
155 ENDDO
156 ELSE
157 xx2(1)=x(2,irect(1))
158 xx3(1)=x(3,irect(1))
159 xx2(2)=x(2,irect(2))
160 xx3(2)=x(3,irect(2))
161 ys1=half*(x(2,irect(1)) + x(2,irect(2)))
162 zs1=half*(x(3,irect(1)) + x(3,irect(2)))
163 ENDIF
164
165 IF (n2d == 0) THEN
166 CALL norma1(n1,n2,n3,area,xx1,xx2,xx3)
167 ELSE
168 n1 = zero
169 n2 = xx3(2) - xx3(1)
170 n3 = -(xx2(2) - xx2(1))
171 area = sqrt(n2 * n2 + n3 * n3)
172 n2 = n2 / area
173 n3 = n3 / area
174 ENDIF
175
176 xc=zero
177 yc=zero
178 zc=zero
179 DO k=1,nnode
180 kk=ix(k+1,nel)
181 xc=xc+x(1,kk)
182 yc=yc+x(2,kk)
183 zc=zc+x(3,kk)
184 ENDDO
185 xc=xc/nnode
186 yc=yc/nnode
187 zc=zc/nnode
188
189 dds=n1*(xc-xs1)+n2*(yc-ys1)+n3*(zc-zs1)
190 IF(dds>0)THEN
191 is=-1
192 ELSE
193 is=1
194 ENDIF
195
196 iele(j)=nel
197 itype(j)=nnode
198 IF (TYPE == 8 .OR. type == 9 .OR. TYPE == 10 .OR. type == 11 .OR. TYPE == 12) then
199 ifac(j) = nf
200 ENDIF
201 m=ix(1,nel)
202 pp=ix(nix-1,nel)
203 jale_from_mat = int(pm(72,m))
204 jale_from_prop = igeo(62,pp)
205 ale = jale_from_mat + jale_from_prop
206 IF(ale/=0)THEN
207 segindx = segindx+1
208 iseg(j) = is*segindx
209 iad = ale_connectivity%ee_connect%iad_connect(nel)
210 minus = -1
211! IF(TYPE==10) MINUS = 1
212 ale_connectivity%ee_connect%connected(iad + nf - 1) = -segindx !NEGATIVE VALUE => STORAGE OF SEGMENT ID
213 IF(ipri>=1)WRITE(iout,fmt=fmw_10i)j,ix(nix,nel),nf,iseg(j)
214 ELSE
215 IF(ipri>=1)WRITE(iout,fmt=fmw_10i)j,ix(nix,nel),0,0
216 ENDIF
217 turbu=max(turbu,int(pm(70,m)))
218 500 CONTINUE
219 ENDDO
220
221 IF(turbu/=0)THEN
222 ierr=ierr+1
223 WRITE(istdo,*)' ** ERROR EBCS ',id,' TURBULENCE NOT YET SUPPORTED'
224 WRITE(iout,*)' ** ERROR EBCS ',id,' TURBULENCE NOT YET SUPPORTED'
225 ENDIF
226 IF(neigh /= 0)THEN
227 IF(n2d == 0)THEN
228 WRITE(istdo,*)' ** ERROR EBCS ',id,neigh,' FACE IS NOT FACING A SOLID ELEMENT, FACE :', itab(irect(1:4))
229 ELSE
230 WRITE(istdo,*)' ** error ebcs ',ID,NEIGH,' segments is not facing a solid element, seg :', ITAB(IRECT(1:2))
231 ENDIF
232 ENDIF
233
234 RETURN
235C-----------------------------------------------
236 1000 FORMAT(//,'elementary bcs',I10,' surface ',I10,/,
237 . '-----------------------------------------',/,
238 . ' segment elt face segindx ')
239 END
my_real
#define my_real
Definition cppsort.cpp:32
findele
subroutine findele(ale_connectivity, nnode, nix, idsu, id, nseg, numel, ix, iseg, iele, itype, ifac, surf_nodes, iadd, invc, pm, x, type, igeo, itab)
Definition findele.F:38
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
message_mod
Definition message_mod.F:1257
norma1
subroutine norma1(n1, n2, n3, area, xx1, xx2, xx3)
Definition norma1.F:38
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:256