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,IX,
37 . ISEG,IELE,ITYPE,IFAC,SURF_NODES,IADD,INVC,PM,X,TYPE,IGEO)
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,IX(NIX,*),ISEG(*),IELE(*),ITYPE(*),
62 . iadd(*),invc(*),ifac(*),TYPE,surf_nodes(nseg,4)
63 INTEGER,INTENT(IN) :: IGEO(NPROPGI,NUMGEO)
64 my_real pm(npropm,nummat),x(3,sx/3)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER II,JJ,J,K,M,PP,NN,KK,NEL,IRECT(4),IAD,N,ALE,NF,IP(NNODE),TURBU,NEIGH,CON(8),IS
69 INTEGER IFACE, IFACE2, IFACE2T, JALE_FROM_MAT, JALE_FROM_PROP,MINUS
70 my_real :: n1, n2, n3, dds,area
71 my_real :: xx1(4), xx2(4),xx3(4),xs1,ys1,zs1,xc,yc,zc
72 EXTERNAL iface, iface2, iface2t
73 DATA con/1,2,3,4,5,6,7,8/
74C-----------------------------------------------
75C S o u r c e L i n e s
76C-----------------------------------------------
77 turbu=0
78 neigh=0
79 IF(ipri>=1)WRITE(iout,1000)id,idsu
80
81 DO j=1,nseg
82 DO k=1,4
83 irect(k)=surf_nodes(j,k)
84 ENDDO
85 IF (irect(3) == 0) irect(3) = irect(2)
86 IF(irect(4)==0) irect(4)=irect(3)
87
88 nel=0
89 DO 230 iad=iadd(irect(1)),iadd(irect(1)+1)-1
90 DO k=1,nnode
91 ip(k)=0
92 ENDDO
93 n = invc(iad)
94 DO 220 jj=1,4
95 ii=irect(jj)
96 DO k=1,nnode
97 IF(ix(k+1,n)==ii)THEN
98 ip(k)=1
99 GOTO 220
100 ENDIF
101 ENDDO
102 GOTO 230
103 220 CONTINUE
104
105 IF (n2d == 0) THEN
106 ! 3D case (8 nodes)
107 nf=iface(ip,con)
108 IF (ip(1) * ip(3) * ip(6) /= 0) THEN
109 nf = 5
110 ELSEIF (ip(1) * ip(3) * ip(5) /= 0) THEN
111 nf = 6
112 ELSEIF (ip(3) * ip(6) * ip(5) /= 0) THEN
113 nf = 2
114 ELSEIF (ip(6) * ip(5) * ip(1) /= 0) THEN
115 nf = 4
116 ENDIF
117 ELSEIF (nnode == 4) THEN
118 ! 2D case (4 nodes : QUADS)
119 nf = iface2(ip, con)
120 ELSEIF (nnode == 3) THEN
121 ! 2D case (3 nodes : TRIANGLES)
122 nf = iface2t(ip, con)
123 ENDIF
124 nel = n
125
126 230 CONTINUE
127
128 IF (nel==0) THEN
129 ierr=ierr+1
130 neigh=neigh+1
131 WRITE(iout,*)' ** ERROR EBCS ',id,' CANNOT FIND NEIGHBORING BRICK FOR SEGMENT',j,' OF SURFACE',idsu
132 GOTO 500
133 ENDIF
134
135 xs1=zero
136 ys1=zero
137 zs1=zero
138 DO jj=1,4
139 nn=irect(jj)
140 xx1(jj)=x(1,nn)
141 xx2(jj)=x(2,nn)
142 xx3(jj)=x(3,nn)
143 xs1=xs1+fourth*x(1,nn)
144 ys1=ys1+fourth*x(2,nn)
145 zs1=zs1+fourth*x(3,nn)
146 ENDDO
147
148 IF (n2d == 0) THEN
149 CALL norma1(n1,n2,n3,area,xx1,xx2,xx3)
150 ELSE
151 n1 = zero
152 n2 = xx3(2) - xx3(1)
153 n3 = -(xx2(2) - xx2(1))
154 area = sqrt(n2 * n2 + n3 * n3)
155 n2 = n2 / area
156 n3 = n3 / area
157 ENDIF
158
159 xc=zero
160 yc=zero
161 zc=zero
162 DO k=1,nnode
163 kk=ix(k+1,nel)
164 xc=xc+x(1,kk)
165 yc=yc+x(2,kk)
166 zc=zc+x(3,kk)
167 ENDDO
168 xc=xc/nnode
169 yc=yc/nnode
170 zc=zc/nnode
171
172 dds=n1*(xc-xs1)+n2*(yc-ys1)+n3*(zc-zs1)
173 IF(dds>0)THEN
174 is=-1
175 ELSE
176 is=1
177 ENDIF
178
179 iele(j)=nel
180 itype(j)=nnode
181 IF (TYPE == 8 .OR. type == 9 .OR. TYPE == 10 .OR. type == 11) THEN
182 ifac(j) = nf
183 ENDIF
184 m=ix(1,nel)
185 pp=ix(nix-1,nel)
186 jale_from_mat = int(pm(72,m))
187 jale_from_prop = igeo(62,pp)
188 ale = jale_from_mat + jale_from_prop
189 IF(ale/=0)THEN
190 segindx = segindx+1
191 iseg(j) = is*segindx
192 iad = ale_connectivity%ee_connect%iad_connect(nel)
193 minus = -1
194! IF(TYPE==10) MINUS = 1
195 ale_connectivity%ee_connect%connected(iad + nf - 1) = -segindx !NEGATIVE VALUE => STORAGE OF SEGMENT ID
196 IF(ipri>=1)WRITE(iout,fmt=fmw_10i)j,ix(nix,nel),nf,iseg(j)
197 ELSE
198 IF(ipri>=1)WRITE(iout,fmt=fmw_10i)j,ix(nix,nel),0,0
199 ENDIF
200 turbu=max(turbu,int(pm(70,m)))
201 500 CONTINUE
202 ENDDO
203
204 IF(turbu/=0)THEN
205 ierr=ierr+1
206 WRITE(istdo,*)' ** ERROR EBCS ',id,' TURBULENCE NOT YET SUPPORTED'
207 WRITE(iout,*)' ** ERROR EBCS ',id,' TURBULENCE NOT YET SUPPORTED'
208 ENDIF
209 IF(neigh/=0)THEN
210 WRITE(istdo,*)' ** ERROR EBCS ',id,neigh,' SEGMENTS NOT FACING A BRICK '
211 ENDIF
212
213 RETURN
214C-----------------------------------------------
215 1000 FORMAT(//,'ELEMENTARY BCS',i10,' SURFACE ',i10,/,
216 . '-----------------------------------------',/,
217 . ' SEGMENT ELT FACE SEGINDX ')
218 END
my_real
#define my_real
Definition cppsort.cpp:32
findele
subroutine findele(ale_connectivity, nnode, nix, idsu, id, nseg, ix, iseg, iele, itype, ifac, surf_nodes, iadd, invc, pm, x, type, igeo)
Definition findele.F:38
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
iniebcs
subroutine iniebcs(ale_connectivity, iflag, igrsurf, ixs, ixq, ixtg, pm, igeo, x, sensors, ivolu, multi_fvm_is_used, ebcs_tab, ebcs_tag_cell_spmd)
Definition iniebcs.F:37
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
message_mod
Definition message_mod.F:1249
norma1
subroutine norma1(n1, n2, n3, area, xx1, xx2, xx3)
Definition norma1.F:38
starter
program starter
Definition starter.F:39
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:254