OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2cor3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr08_c.inc"
#include "vect07_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i2cor3 (x, irect, nsv, cand_e, cand_n, gapv, igap, gap, first, last, nint, ixc, ixtg, thk_part, ipartc, geo, noint, ixs, ixs10, pm, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, ignore, ixs16, ixs20, iparttg, igeo, dsearch, pm_stack, iworksh, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, gapmin, gapmax)

Function/Subroutine Documentation

◆ i2cor3()

subroutine i2cor3 ( x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
gapv,
integer igap,
gap,
integer, intent(in) first,
integer, intent(in) last,
integer nint,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
thk_part,
integer, dimension(*) ipartc,
geo,
integer noint,
integer, dimension(nixs,*) ixs,
integer, dimension(*) ixs10,
pm,
thk,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2els,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
integer ignore,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
integer, dimension(*) iparttg,
integer, dimension(npropgi,*) igeo,
dsearch,
pm_stack,
integer, dimension(*) iworksh,
integer, dimension(mvsiz), intent(inout) ix1,
integer, dimension(mvsiz), intent(inout) ix2,
integer, dimension(mvsiz), intent(inout) ix3,
integer, dimension(mvsiz), intent(inout) ix4,
integer, dimension(mvsiz), intent(inout) nsvg,
intent(inout) x1,
intent(inout) x2,
intent(inout) x3,
intent(inout) x4,
intent(inout) y1,
intent(inout) y2,
intent(inout) y3,
intent(inout) y4,
intent(inout) z1,
intent(inout) z2,
intent(inout) z3,
intent(inout) z4,
intent(out) xi,
intent(out) yi,
intent(out) zi,
intent(inout) gapmin,
intent(inout) gapmax )
Parameters
[in]firstfirst index of the candidates
[in]lastlast index of the candidates

Definition at line 33 of file i2cor3.F.

45C============================================================================
46 use element_mod , only :nixs,nixc,nixtg
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "mvsiz_p.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER IGAP, IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
59 . IXC(NIXC,*),IXTG(NIXTG,*),IPARTC(*),NOINT,
60 . IXS(NIXS,*), IXS10(*),KNOD2ELS(*),
61 . KNOD2ELC(*),KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*),
62 . NOD2ELTG(*),NINT,IGNORE,
63 . IXS16(*), IXS20(*),IPARTTG(*),IGEO(NPROPGI,*),
64 . IWORKSH(*)
65 integer, intent(in) :: first !< first index of the candidates
66 integer, intent(in) :: last !< last index of the candidates
67C REAL
68 my_real
69 . gap, x(3,*), gapv(*),
70 . geo(npropg,*),thk(*),thk_part(*),pm(*),dsearch,pm_stack(*)
71 my_real, intent(inout) :: gapmin,gapmax
72 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4,NSVG
73 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x1,x2,x3,x4
74 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: y1,y2,y3,y4
75 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
76 my_real, DIMENSION(MVSIZ), INTENT(OUT) :: xi,yi,zi
77C-----------------------------------------------
78C C o m m o n B l o c k s
79C-----------------------------------------------
80#include "com04_c.inc"
81#include "param_c.inc"
82#include "scr08_c.inc"
83#include "vect07_c.inc"
84#include "units_c.inc"
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER I, L, NN, IG,NODE1,NODE2,NODE3,NODE4,II,IAD,JJ,JJJ,
89 . IEL,MG,IP,NELS,NELC,NELTG
90C REAL
91 my_real
92 . thksecnd,thkmain,dd,dx1,dy1,dz1,dx3,dy3,dz3,vol,area
93C-----------------------------------------------
94C
95 DO i=first,last
96 ig = nsv(cand_n(i))
97 nsvg(i) = ig
98 xi(i) = x(1,ig)
99 yi(i) = x(2,ig)
100 zi(i) = x(3,ig)
101 ENDDO
102C
103 IF(igap==0 .AND. ignore <= 1)THEN
104 DO i=first,last
105 gapv(i) = gap
106 ENDDO
107 ELSEIF((ignore == 2 .OR. ignore == 3) .AND. dsearch /= zero)THEN
108 DO i=first,last
109 gapv(i) = gap
110 ENDDO
111 ELSEIF(ignore >= 2)THEN
112 DO i=first,last
113 thksecnd = zero
114 thkmain = zero
115 ii=cand_n(i)
116 DO iad = knod2elc(nsvg(i))+1,knod2elc(nsvg(i)+1)
117 iel = nod2elc(iad)
118 mg=ixc(6,iel)
119 ip = ipartc(iel)
120 IF ( thk_part(ip) /= zero) THEN
121 thksecnd = thk_part(ip)
122 ELSEIF ( thk(iel) /= zero) THEN
123 thksecnd = thk(iel)
124 ELSE
125 thksecnd = geo(1,mg)
126 ENDIF
127 ENDDO
128C- 3N coats
129 DO iad = knod2eltg(nsvg(i))+1,knod2eltg(nsvg(i)+1)
130 iel = nod2eltg(iad)
131 mg=ixtg(5,iel)
132 ip = iparttg(iel)
133 IF ( thk_part(ip) /= zero) THEN
134 thksecnd = thk_part(ip)
135 ELSEIF ( thk(numelc+iel) /= zero) THEN
136 thksecnd = thk(numelc+iel)
137 ELSE
138 thksecnd = geo(1,mg)
139 ENDIF
140 ENDDO
141 nels = 0
142 nelc = 0
143 neltg = 0
144 CALL insol3(x,irect,ixs,nint,nels,cand_e(i),
145 . area,noint,knod2els ,nod2els ,0 ,ixs10,
146 . ixs16,ixs20)
147 CALL incoq3(irect,ixc ,ixtg ,nint ,nelc ,
148 . neltg,cand_e(i),geo ,pm ,knod2elc ,
149 . knod2eltg ,nod2elc ,nod2eltg,thk,2,igeo,
150 . pm_stack , iworksh )
151 IF(neltg/=0) THEN
152 mg=ixtg(5,neltg)
153 ip = iparttg(neltg)
154 IF ( thk_part(ip) /= zero) THEN
155 thkmain = thk_part(ip)
156 ELSEIF ( thk(numelc+neltg) /= zero) THEN
157 thkmain = thk(numelc+neltg)
158 ELSE
159 thkmain = geo(1,mg)
160 ENDIF
161 ELSEIF(nelc/=0) THEN
162 mg=ixc(6,nelc)
163 ip = ipartc(nelc)
164 IF ( thk_part(ip) /= zero) THEN
165 thkmain = thk_part(ip)
166 ELSEIF ( thk(nelc) /= zero) THEN
167 thkmain = thk(nelc)
168 ELSE
169 thkmain = geo(1,mg)
170 ENDIF
171 ELSEIF(nels/=0 .AND. nels <= numels8 .AND. ignore == 2) THEN
172 DO jj=1,8
173 jjj=ixs(jj+1,nels)
174 xc(jj)=x(1,jjj)
175 yc(jj)=x(2,jjj)
176 zc(jj)=x(3,jjj)
177 END DO
178 CALL volint(vol)
179C
180 thkmain = vol/area
181 ENDIF
182 dd = zero
183 node1=irect(1,cand_e(i))
184 node2=irect(2,cand_e(i))
185 node3=irect(3,cand_e(i))
186 node4=irect(4,cand_e(i))
187C LONGUEUR DIAG 1
188 dx1=(x(1,node1)-x(1,node3))
189 dy1=(x(2,node1)-x(2,node3))
190 dz1=(x(3,node1)-x(3,node3))
191 dd=sqrt(dx1**2+dy1**2+dz1**2)
192C LONGUEUR DIAG 2
193 dx3=(x(1,node2)-x(1,node4))
194 dy3=(x(2,node2)-x(2,node4))
195 dz3=(x(3,node2)-x(3,node4))
196 dd=min(dd,sqrt(dx3**2+dy3**2+dz3**2))
197 gapv(i) = max(zep05*dd,zep6*(thksecnd+thkmain))
198 gapmin = min(gapmin,gapv(i))
199 gapmax = max(gapmax,gapv(i))
200 ENDDO
201 ENDIF
202C
203 DO i=first,last
204C
205 l = cand_e(i)
206C
207 ix1(i)=irect(1,l)
208 ix2(i)=irect(2,l)
209 ix3(i)=irect(3,l)
210 ix4(i)=irect(4,l)
211C
212 ENDDO
213C
214 DO i=first,last
215C
216 nn=ix1(i)
217 x1(i)=x(1,nn)
218 y1(i)=x(2,nn)
219 z1(i)=x(3,nn)
220C
221 nn=ix2(i)
222 x2(i)=x(1,nn)
223 y2(i)=x(2,nn)
224 z2(i)=x(3,nn)
225C
226 nn=ix3(i)
227 x3(i)=x(1,nn)
228 y3(i)=x(2,nn)
229 z3(i)=x(3,nn)
230C
231 nn=ix4(i)
232 x4(i)=x(1,nn)
233 y4(i)=x(2,nn)
234 z4(i)=x(3,nn)
235C
236 ENDDO
237C
238 RETURN
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
incoq3
subroutine incoq3(irect, ixc, ixtg, nint, nel, neltg, is, geo, pm, knod2elc, knod2eltg, nod2elc, nod2eltg, thk, nty, igeo, pm_stack, iworksh)
Definition incoq3.F:46
insol3
subroutine insol3(x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ir, ixs10, ixs16, ixs20)
Definition insol3.F:44
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
volint
subroutine volint(vol)
Definition volint.F:38