OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
findele.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr03_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine findele (ale_connectivity, nnode, nix, idsu, id, nseg, numel, ix, iseg, iele, itype, ifac, surf_nodes, iadd, invc, pm, x, type, igeo, itab)

Function/Subroutine Documentation

◆ findele()

subroutine findele ( type(t_ale_connectivity), intent(inout) ale_connectivity,
integer nnode,
integer nix,
integer idsu,
integer id,
integer nseg,
integer, intent(in) numel,
integer, dimension(nix,numel), intent(in) ix,
integer, dimension(*) iseg,
integer, dimension(*) iele,
integer, dimension(*) itype,
integer, dimension(*) ifac,
integer, dimension(nseg,4) surf_nodes,
integer, dimension(*) iadd,
integer, dimension(*) invc,
pm,
x,
integer type,
integer, dimension(npropgi,numgeo), intent(in) igeo,
integer, dimension(numnod), intent(in) itab )

Definition at line 36 of file findele.F.

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 ')
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
iface
integer function iface(ip, n)
Definition iface.F:36
iface2
integer function iface2(ip, n)
Definition iface.F:85
iface2t
integer function iface2t(ip, n)
Definition iface.F:120
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
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