36 1 JLT ,LEDGE ,IRECT ,X ,V ,
37 2 CAND_S ,CAND_M ,STFM ,MS ,EX ,
38 3 EY ,EZ ,FX ,FY ,FZ ,
39 4 STIF ,XXS1 ,XXS2 ,XYS1 ,XYS2 ,
40 5 XZS1 ,XZS2 ,XXM1 ,XXM2 ,XYM1 ,
41 6 XYM2 ,XZM1 ,XZM2 ,VXS1 ,VXS2 ,
42 7 VYS1 ,VYS2 ,VZS1 ,VZS2 ,VXM1 ,
43 8 VXM2 ,VYM1 ,VYM2 ,VZM1 ,VZM2 ,
44 9 MS1 ,MS2 ,MM1 ,MM2 ,N1 ,
45 A N2 ,M1 ,M2 ,NEDGE ,NIN ,
46 C STFAC ,NODNX_SMS,NSMS ,GAPE ,GAPVE ,
47 D IEDGE ,ADMSR ,LBOUND ,EDG_BISECTOR ,
48 E VTX_BISECTOR,TYPEDGS,IAS ,JAS ,IBS ,
49 F JBS ,IAM ,STFE , EDGE_ID, ITAB ,
50 G INTFRIC,IPARTFRIC_E,IPARTFRIC_ES,IPARTFRIC_EM,
51 H IGSTI ,KMIN ,KMAX ,E2S_NOD_NORMAL,NADMSR,
52 I NORMALN1,NORMALN2,NORMALM1,NORMALM2,ISTIF_MSDT,
53 J DTSTIF,STIFMSDT_EDG,STIFMSDT_M,NRTM,PARAMETERS)
66#include "implicit_f.inc"
75#include "i25edge_c.inc"
83 INTEGER :: EDGE_ID(2,4*MVSIZ)
84 INTEGER :: INTFRIC ,IPARTFRIC_E(*),IPARTFRIC_ES(4,MVSIZ),IPARTFRIC_EM(4,MVSIZ)
85 INTEGER LEDGE(NLEDGE,*), IRECT(4,*), CAND_M(*), CAND_S(*), ADMSR(4,*),
86 . LBOUND(*), JLT, NEDGE, NIN, IEDGE,
87 . N1(4,MVSIZ), N2(4,MVSIZ),
88 . M1(4,MVSIZ), M2(4,MVSIZ),
89 . NODNX_SMS(*), NSMS(4,MVSIZ),
90 . TYPEDGS(MVSIZ),IAS(MVSIZ),JAS(MVSIZ),IBS(MVSIZ),JBS(MVSIZ),IAM(MVSIZ)
91 INTEGER ,
INTENT(IN) :: IGSTI, NADMSR
92 INTEGER ,
INTENT(IN) :: ISTIF_MSDT
93 INTEGER ,
INTENT(IN) :: NRTM
96 . X(3,*), STFM(*), STFE(*), MS(*), V(3,*),
97 . XXS1(4,MVSIZ), XXS2(4,MVSIZ), XYS1(4,MVSIZ), XYS2(4,MVSIZ),
98 . XZS1(4,MVSIZ), XZS2(4,MVSIZ), XXM1(4,MVSIZ), XXM2(4,MVSIZ),
99 . XYM1(4,MVSIZ), XYM2(4,MVSIZ), XZM1(4,MVSIZ), XZM2(4,MVSIZ),
100 . vxs1(4,mvsiz), vxs2(4,mvsiz), vys1(4,mvsiz), vys2(4,mvsiz),
101 . vzs1(4,mvsiz), vzs2(4,mvsiz), vxm1(4,mvsiz), vxm2(4,mvsiz),
102 . vym1(4,mvsiz), vym2(4,mvsiz), vzm1(4,mvsiz), vzm2(4,mvsiz),
103 . ms1(4,mvsiz), ms2(4,mvsiz), mm1(4,mvsiz), mm2(4,mvsiz),
104 . stif(4,mvsiz),stfac,sts,stm,
105 . gape(*) ,gapve(4,mvsiz),
106 . ex(4,mvsiz), ey(4,mvsiz), ez(4,mvsiz), fx(mvsiz), fy(mvsiz), fz(mvsiz)
107 real*4 edg_bisector(3,4,*), vtx_bisector(3,2,*)
108 my_real ,
INTENT(IN) :: kmin, kmax
109 real*4 ,
INTENT(IN) :: e2s_nod_normal(3,nadmsr)
110 my_real ,
INTENT(INOUT) :: normaln1(3,mvsiz),normaln2(3,mvsiz),
111 . normalm1(3,4,mvsiz),normalm2(3,4,mvsiz)
112 my_real ,
INTENT(IN) :: dtstif
113 my_real ,
INTENT(IN) :: stifmsdt_edg(nedge) , stifmsdt_m(nrtm)
114 TYPE (PARAMETERS_) ,
INTENT(IN):: PARAMETERS
118 INTEGER I ,NN, J, JRM, K, KRM, I1, J1, I2, J2, EJ,
119 . IE, JE, SOL_EDGE, SH_EDGE, ES, IS(MVSIZ)
124 . AAA, DX, DY, DZ, DD, NNI, NI2, INVCOS, DTS
126 . gape_m(mvsiz), gape_s(mvsiz), stif_msdt(mvsiz)
130 edge_id(1:2,1:4*mvsiz) = -666
142 ids(1) = itab(irect(1,iam(i)))
143 ids(2) = itab(irect(2,iam(i)))
144 ids(3) = itab(irect(3,iam(i)))
145 ids(4) = itab(irect(4,iam(i)))
153 m1(ej,i)=irect(ej,iam(i))
154 m2(ej,i)=irect(mod(ej,4)+1,iam(i))
156 xxm1(ej,i) = x(1,m1(ej,i))
157 xym1(ej,i) = x(2,m1(ej,i))
158 xzm1(ej,i) = x(3,m1(ej,i))
159 xxm2(ej,i) = x(1,m2(ej,i))
160 xym2(ej,i) = x(2,m2(ej,i))
161 xzm2(ej,i) = x(3,m2(ej,i))
162 vxm1(ej,i) = v(1,m1(ej,i))
163 vym1(ej,i) = v(2,m1(ej,i))
164 vzm1(ej,i) = v(3,m1(ej,i))
165 vxm2(ej,i) = v(1,m2(ej,i))
166 vym2(ej,i) = v(2,m2(ej,i))
167 vzm2(ej,i) = v(3,m2(ej,i))
168 mm1(ej,i) = ms(m1(ej,i))
169 mm2(ej,i) = ms(m2(ej,i))
171 IF(cand_s(i)<=nedge)
THEN
174 ias(i)=abs(ledge(1,es))
183 edge_id(2,i) = ledge(8,es)
195 stif(ej,i)=sts*stm /
max(em20,sts+stm)
198 xxs1(ej,i) = x(1,n1(ej,i))
199 xys1(ej,i) = x(2,n1(ej,i))
200 xzs1(ej,i) = x(3,n1(ej,i))
201 xxs2(ej,i) = x(1,n2(ej,i))
202 xys2(ej,i) = x(2,n2(ej,i))
203 xzs2(ej,i) = x(3,n2(ej,i))
204 vxs1(ej,i) = v(1,n1(ej,i))
205 vys1(ej,i) = v(2,n1(ej,i))
206 vzs1(ej,i) = v(3,n1(ej,i))
207 vxs2(ej,i) = v(1,n2(ej,i))
208 vys2(ej,i) = v(2,n2(ej,i))
209 vzs2(ej,i) = v(3,n2(ej,i))
210 ms1(ej,i) = ms(n1(ej,i))
211 ms2(ej,i) = ms(n2(ej,i))
213 typedgs(i)=ledge(7,es)
216 nn = cand_s(i) - nedge
222 edge_id(2,i) =
ledge_fie(nin)%P(e_global_id,nn)
232 stif(ej,i)=sts*stm /
max(em20,sts+stm)
238 ias(i)=abs(
ledge_fie(nin)%P(e_left_seg ,nn))
244 xxs1(ej,i) =
xfie(nin)%P(1,n1(ej,i))
245 xys1(ej,i) =
xfie(nin)%P(2,n1(ej,i))
246 xzs1(ej,i) =
xfie(nin)%P(3,n1(ej,i))
247 xxs2(ej,i) =
xfie(nin)%P(1,n2(ej,i))
248 xys2(ej,i) =
xfie(nin)%P(2,n2(ej,i))
249 xzs2(ej,i) =
xfie(nin)%P(3,n2(ej,i))
250 vxs1(ej,i) =
vfie(nin)%P(1,n1(ej,i))
251 vys1(ej,i) =
vfie(nin)%P(2,n1(ej,i))
252 vzs1(ej,i) =
vfie(nin)%P(3,n1(ej,i))
253 vxs2(ej,i) =
vfie(nin)%P(1,n2(ej,i))
254 vys2(ej,i) =
vfie(nin)%P(2,n2(ej,i))
255 vzs2(ej,i) =
vfie(nin)%P(3,n2(ej,i))
256 ms1(ej,i) =
msfie(nin)%P(n1(ej,i))
257 ms2(ej,i) =
msfie(nin)%P(n2(ej,i))
266 IF(istif_msdt > 0)
THEN
267 IF(dtstif > zero)
THEN
270 dts = parameters%DT_STIFINT
274 IF(cand_s(i)<=nedge)
THEN
276 stif_msdt(i) = stifmsdt_edg(es)
278 nn = cand_s(i) - nedge
281 stif_msdt(i) = stifmsdt_m(iam(i))*stif_msdt(i)/(stifmsdt_m(iam(i))+stif_msdt(i))
283 stif_msdt(i) = stif_msdt(i)/(dts*dts)
285 stif(ej,i)=
max(stif(ej,i),stif_msdt(i))
292 stif(ej,i)=
max(kmin,
min(stif(ej,i),kmax))
302 gape_s(i)=gape(cand_s(i))
304 gape_s(i)=
gapfie(nin)%P(cand_s(i) - nedge)
310 sh_edge =iedge-10*sol_edge
313 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es, stfm(iam(i)))
315 IF ( stfm(iam(i)) > zero)
THEN
318 ex(ej,i)=edg_bisector(1,ej,iam(i))
319 ey(ej,i)=edg_bisector(2,ej,iam(i))
320 ez(ej,i)=edg_bisector(3,ej,iam(i))
321 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es,ex(ej,i))
322 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es,ey(ej,i))
323 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es,ez(ej,i))
329 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es,zero)
335 IF(cand_s(i)<=nedge)
THEN
336 fx(i) = edg_bisector(1,jas(i),ias(i))
337 fy(i) = edg_bisector(2,jas(i),ias(i))
338 fz(i) = edg_bisector(3,jas(i),ias(i))
347 nsms(1:4,1:mvsiz) = -666
350 IF(cand_s(i)<=nedge)
THEN
352 nsms(ej,i)=nodnx_sms(n1(ej,i))+nodnx_sms(n2(ej,i))+
353 . nodnx_sms(m1(ej,i))+nodnx_sms(m2(ej,i))
354 debug_e2e(nsms(ej,i) < 0,nodnx_sms(n1(ej,i)))
355 debug_e2e(nsms(ej,i) < 0,nodnx_sms(n2(ej,i)))
361 . nodnx_sms(m1(ej,i))+nodnx_sms(m2(ej,i))
362 debug_e2e(nsms(ej,i) < 0,
nodnxfie(nin)%P(n1(ej,i)))
363 debug_e2e(nsms(ej,i) < 0,
nodnxfie(nin)%P(n2(ej,i)))
368 IF(idtmins_int/=0)
THEN
371 IF(nsms(ej,i)==0)nsms(ej,i)=-1
375 ELSEIF(idtmins_int/=0)
THEN
387 IF(cand_s(i)<=nedge)
THEN
388 ipartfric_es(1:4,i) = ipartfric_e(cand_s(i))
390 nn = cand_s(i) - nedge
394 ipartfric_em(1:4,i) = ipartfric_e(cand_m(i))
400 IF(typedgs(i)/=1)cycle
402 normalm1(1:3,ej,i)=e2s_nod_normal(1:3,admsr(ej,iam(i)))
403 normalm2(1:3,ej,i)=e2s_nod_normal(1:3,admsr(mod(ej,4)+1,iam(i)))
407 normaln1(1:3,i)=e2s_nod_normal(1:3,admsr(jas(i),ias(i)))
408 normaln2(1:3,i)=e2s_nod_normal(1:3,admsr(mod(jas(i),4)+1,ias(i)))
410 normaln2(1:3,i)=e2s_nod_normal(1:3,admsr(jas(i),ias(i)))
411 normaln1(1:3,i)=e2s_nod_normal(1:3,admsr(mod(jas(i),4)+1,ias(i)))
subroutine i25cor3_e2s(jlt, ledge, irect, x, v, cand_s, cand_m, stfm, ms, ex, ey, ez, fx, fy, fz, stif, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, vxs1, vxs2, vys1, vys2, vzs1, vzs2, vxm1, vxm2, vym1, vym2, vzm1, vzm2, ms1, ms2, mm1, mm2, n1, n2, m1, m2, nedge, nin, stfac, nodnx_sms, nsms, gape, gapve, iedge, admsr, lbound, edg_bisector, vtx_bisector, typedgs, ias, jas, ibs, jbs, iam, stfe, edge_id, itab, intfric, ipartfric_e, ipartfric_es, ipartfric_em, igsti, kmin, kmax, e2s_nod_normal, nadmsr, normaln1, normaln2, normalm1, normalm2, istif_msdt, dtstif, stifmsdt_edg, stifmsdt_m, nrtm, parameters)