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, ix, iseg, iele, itype, ifac, surf_nodes, iadd, invc, pm, x, type, igeo)

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, dimension(nix,*) 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 )

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,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 ')
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:35
iface2
integer function iface2(ip, n)
Definition iface.F:84
iface2t
integer function iface2t(ip, n)
Definition iface.F:119
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:223
message_mod
Definition message_mod.F:1249
norma1
subroutine norma1(n1, n2, n3, area, xx1, xx2, xx3)
Definition norma1.F:38