OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20lagm.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "task_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "comlock.inc"
#include "lockon.inc"
#include "lockoff.inc"
#include "constant.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i20lagm (x, v, lll, jll, sll, xll, candn, cande, i_stok, ixs, ixs20, iadll, eminx, nsv, nelem, n_mul_mx, itask, a, itied, nint, nkmax, comntag)
subroutine i20lll (llt, lll, jll, sll, xll, v, xx, yy, zz, iii, iadll, n_mul_mx, a, x, itied, nint, nkmax, comntag)
subroutine i20rst (llt, r, s, t, ni, nsx, nsy, nsz, nx, ny, nz, xx, yy, zz)
subroutine i20ni (llt, rr, ss, tt, ni)
subroutine i20rstn (llt, rr, ss, tt, ni, conv, drdx, drdy, drdz, dsdx, dsdy, dsdz, dtdx, dtdy, dtdz, xx, yy, zz, r, s, t)
subroutine i20deri (llt, rr, ss, tt, ni, drdx, drdy, drdz, dsdx, dsdy, dsdz, dtdx, dtdy, dtdz, dxdr, dydr, dzdr, dxds, dyds, dzds, dxdt, dydt, dzdt, xx, yy, zz)

Function/Subroutine Documentation

◆ i20deri()

subroutine i20deri ( integer llt,
rr,
ss,
tt,
ni,
drdx,
drdy,
drdz,
dsdx,
dsdy,
dsdz,
dtdx,
dtdy,
dtdz,
dxdr,
dydr,
dzdr,
dxds,
dyds,
dzds,
dxdt,
dydt,
dzdt,
xx,
yy,
zz )

Definition at line 1039 of file i20lagm.F.

1044C-----------------------------------------------
1045C I m p l i c i t T y p e s
1046C-----------------------------------------------
1047#include "implicit_f.inc"
1048C-----------------------------------------------
1049C G l o b a l P a r a m e t e r s
1050C-----------------------------------------------
1051#include "mvsiz_p.inc"
1052C-----------------------------------------------
1053C D u m m y A r g u m e n t s
1054C-----------------------------------------------
1055 INTEGER LLT
1056C REAL
1057 my_real
1058 . dxdr(mvsiz), dydr(mvsiz), dzdr(mvsiz),
1059 . dxds(mvsiz), dyds(mvsiz), dzds(mvsiz),
1060 . dxdt(mvsiz), dydt(mvsiz), dzdt(mvsiz),
1061 . drdx(mvsiz), dsdx(mvsiz), dtdx(mvsiz),
1062 . drdy(mvsiz), dsdy(mvsiz), dtdy(mvsiz),
1063 . drdz(mvsiz), dsdz(mvsiz), dtdz(mvsiz),
1064 . xx(mvsiz,21) ,yy(mvsiz,21),zz(mvsiz,21),
1065 . ni(mvsiz,21) ,rr(mvsiz) ,ss(mvsiz) ,tt(mvsiz)
1066C-----------------------------------------------
1067C L o c a l V a r i a b l e s
1068C-----------------------------------------------
1069 INTEGER I
1070 my_real
1071 . dnidr(20),dnids(20),dnidt(20),
1072 . d, det(mvsiz)
1073 my_real
1074 . u_m_r,u_p_r,u_m_s,u_p_s,u_m_t,u_p_t,
1075 . ums_umt,ums_upt,ups_umt,ups_upt,
1076 . umr_ums,umr_ups,upr_ums,upr_ups,
1077 . umt_umr,umt_upr,upt_umr,upt_upr,
1078 . a,r05,s05,t05
1079C-----------------------------------------------
1080C
1081C
1082C ^ S _ T
1083C | /|
1084C | /
1085C | /
1086C ( 7)==========|===(18)===============( 6)
1087C //| | / //|
1088C // | | / //||
1089C // | | // ||
1090C // | | / // ||
1091C // | | / // ||
1092C (19) | *- - - + - * - - - - -* (17) ||
1093C // | /| | /| / /| // ||
1094C // | / // ||
1095C // (15)/ | |/ | + / // (14)
1096C // |#- - - - - # - -/- - -# // ||
1097C // | * - - /|- -*- - -/ -//* ||
1098C ( 8)===============(20)==============( 5) ||
1099C || / || / | / | / | / ||| | ||
1100C || @- | - - - @ - - - - -@ || ||
1101C R <-----||- - -+ -|- -# - - -| - # - - -|- -#|| - -+ ||
1102C || | * - - /| - *- - -/-|| * ||
1103C || | || / | / | |||/ ||
1104C || ( 3)-------/--|---(10)----||---------( 2)
1105C || @ /- / - - @ - -/ - - @ || //
1106C || |/ #- - -/| - # - - -|- -#|| //
1107C (16) / / + /| /(13) //
1108C || /| | | || //
1109C || / / / | / || //
1110C || (11) @- - - - - @ - + - - -@ || ( 9)
1111C || / || //
1112C || / || //
1113C || / || //
1114C || / ||//
1115C ||/ ||/
1116C ( 4)===============(12)==============( 1)
1117C
1118C
1119C
1120C
1121C
1122C*/
1123C-----------------------------------------------
1124C _
1125C \
1126C x(r,s,t) = /_ (xi * Ni(r,s,t))
1127C _
1128C \
1129C y(r,s,t) = /_ (yi * Ni(r,s,t))
1130C _
1131C \
1132C z(r,s,t) = /_ zi * Ni(r,s,t))
1133C
1134C _
1135C \
1136C dx/dr = /_ (xi * dNi/dr)
1137C ...
1138C
1139C [dx/dr dy/dr dz/dr]
1140C [J] = |dx/ds dy/ds dz/ds|
1141C [dx/dt dy/dt dz/dt]
1142C
1143C |r| |r| -1 |xs-x|
1144C {s} = {s} + [J] {ys-y}
1145C |t| |t| |zs-z|
1146C
1147C-----------------------------------------------------------------------
1148C Ni; dNi/dr; dNi/ds; dNi/dt
1149C-----------------------------------------------------------------------
1150 DO i=1,llt
1151 r05 = half*rr(i)
1152 s05 = half*ss(i)
1153 t05 = half*tt(i)
1154C
1155 u_m_r = half - r05
1156 u_p_r = half + r05
1157C
1158 u_m_s = half - s05
1159 u_p_s = half + s05
1160C
1161 u_m_t = half - t05
1162 u_p_t = half + t05
1163C
1164 ums_umt = u_m_s * u_m_t
1165 ums_upt = u_m_s * u_p_t
1166 ups_umt = u_p_s * u_m_t
1167 ups_upt = u_p_s * u_p_t
1168C
1169 umr_ums = u_m_r * u_m_s
1170 umr_ups = u_m_r * u_p_s
1171 upr_ums = u_p_r * u_m_s
1172 upr_ups = u_p_r * u_p_s
1173C
1174 umt_umr = u_m_t * u_m_r
1175 umt_upr = u_m_t * u_p_r
1176 upt_umr = u_p_t * u_m_r
1177 upt_upr = u_p_t * u_p_r
1178C
1179C
1180C
1181C
1182 ni(i,1) = u_m_r * ums_umt * (-rr(i)-ss(i)-tt(i)-two)
1183 ni(i,2) = u_m_r * ums_upt * (-rr(i)-ss(i)+tt(i)-two)
1184 ni(i,3) = u_p_r * ums_upt * ( rr(i)-ss(i)+tt(i)-two)
1185 ni(i,4) = u_p_r * ums_umt * ( rr(i)-ss(i)-tt(i)-two)
1186 ni(i,5) = u_m_r * ups_umt * (-rr(i)+ss(i)-tt(i)-two)
1187 ni(i,6) = u_m_r * ups_upt * (-rr(i)+ss(i)+tt(i)-two)
1188 ni(i,7) = u_p_r * ups_upt * ( rr(i)+ss(i)+tt(i)-two)
1189 ni(i,8) = u_p_r * ups_umt * ( rr(i)+ss(i)-tt(i)-two)
1190C
1191 dnidr(1) = -ums_umt * (u_m_s + u_m_t - rr(i) -three_half)
1192 dnidr(2) = -ums_upt * (u_m_s + u_p_t - rr(i) -three_half)
1193 dnidr(3) = ums_upt * (u_m_s + u_p_t + rr(i) -three_half)
1194 dnidr(4) = ums_umt * (u_m_s + u_m_t + rr(i) -three_half)
1195 dnidr(5) = -ups_umt * (u_p_s + u_m_t - rr(i) -three_half)
1196 dnidr(6) = -ups_upt * (u_p_s + u_p_t - rr(i) -three_half)
1197 dnidr(7) = ups_upt * (u_p_s + u_p_t + rr(i) -three_half)
1198 dnidr(8) = ups_umt * (u_p_s + u_m_t + rr(i) -three_half)
1199C
1200 dnids(1) = -umt_umr * (u_m_r + u_m_t - ss(i) -three_half)
1201 dnids(2) = -upt_umr * (u_m_r + u_p_t - ss(i) -three_half)
1202 dnids(3) = -upt_upr * (u_p_r + u_p_t - ss(i) -three_half)
1203 dnids(4) = -umt_upr * (u_p_r + u_m_t - ss(i) -three_half)
1204 dnids(5) = umt_umr * (u_m_r + u_m_t + ss(i) -three_half)
1205 dnids(6) = upt_umr * (u_m_r + u_p_t + ss(i) -three_half)
1206 dnids(7) = upt_upr * (u_p_r + u_p_t + ss(i) -three_half)
1207 dnids(8) = umt_upr * (u_p_r + u_m_t + ss(i) -three_half)
1208C
1209 dnidt(1) = -umr_ums * (u_m_r + u_m_s - tt(i) -three_half)
1210 dnidt(2) = umr_ums * (u_m_r + u_m_s + tt(i) -three_half)
1211 dnidt(3) = upr_ums * (u_p_r + u_m_s + tt(i) -three_half)
1212 dnidt(4) = -upr_ums * (u_p_r + u_m_s - tt(i) -three_half)
1213 dnidt(5) = -umr_ups * (u_m_r + u_p_s - tt(i) -three_half)
1214 dnidt(6) = umr_ups * (u_m_r + u_p_s + tt(i) -three_half)
1215 dnidt(7) = upr_ups * (u_p_r + u_p_s + tt(i) -three_half)
1216 dnidt(8) = -upr_ups * (u_p_r + u_p_s - tt(i) -three_half)
1217C------------------------------------
1218 a = (one-rr(i)*rr(i))
1219 ni(i,10) = a * ums_upt
1220 ni(i,12) = a * ums_umt
1221 ni(i,18) = a * ups_upt
1222 ni(i,20) = a * ups_umt
1223C
1224 a = half*a
1225 dnidt(10) = a * u_m_s
1226 dnidt(18) = a * u_p_s
1227 dnidt(12) = -dnidt(10)
1228 dnidt(20) = -dnidt(18)
1229C
1230 dnids(18) = a * u_p_t
1231 dnids(20) = a * u_m_t
1232 dnids(10) = -dnids(18)
1233 dnids(12) = -dnids(20)
1234C
1235 a = -two*rr(i)
1236 dnidr(10) = a * ums_upt
1237 dnidr(12) = a * ums_umt
1238 dnidr(18) = a * ups_upt
1239 dnidr(20) = a * ups_umt
1240C------------------------------------
1241 a = (one-ss(i)*ss(i))
1242 ni(i,13) = a * umt_umr
1243 ni(i,14) = a * upt_umr
1244 ni(i,15) = a * upt_upr
1245 ni(i,16) = a * umt_upr
1246C
1247 a = half*a
1248 dnidr(15) = a * u_p_t
1249 dnidr(16) = a * u_m_t
1250 dnidr(13) = -dnidr(16)
1251 dnidr(14) = -dnidr(15)
1252C
1253 dnidt(14) = a * u_m_r
1254 dnidt(15) = a * u_p_r
1255 dnidt(13) = -dnidt(14)
1256 dnidt(16) = -dnidt(15)
1257C
1258 a = -two*ss(i)
1259 dnids(13) = a * umt_umr
1260 dnids(14) = a * upt_umr
1261 dnids(15) = a * upt_upr
1262 dnids(16) = a * umt_upr
1263C------------------------------------
1264 a = (one-tt(i)*tt(i))
1265 ni(i,9) = a * umr_ums
1266 ni(i,11) = a * upr_ums
1267 ni(i,17) = a * umr_ups
1268 ni(i,19) = a * upr_ups
1269C
1270 ni(i,21) = -one
1271C
1272 a = half*a
1273 dnidr(11) = a * u_m_s
1274 dnidr(19) = a * u_p_s
1275 dnidr(9) = -dnidr(11)
1276 dnidr(17) = -dnidr(19)
1277C
1278 dnids(17) = a * u_m_r
1279 dnids(19) = a * u_p_r
1280 dnids(9) = -dnids(17)
1281 dnids(11) = -dnids(19)
1282C
1283 a = -two*tt(i)
1284 dnidt(9) = a * umr_ums
1285 dnidt(11) = a * upr_ums
1286 dnidt(17) = a * umr_ups
1287 dnidt(19) = a * upr_ups
1288C
1289c
1290c print *, "DNIDr(1),DNIDr(9)",DNIDr(1),DNIDr(9)
1291c print *, "DNIDs(1),DNIDs(9)",DNIDs(1),DNIDs(9)
1292c print *, "DNIDT(1),DNIDT(9)",DNIDT(1),DNIDT(9)
1293c print *, "XX(I,1),XX(I,9)",XX(I,1),XX(I,9)
1294c
1295C-----------------------------------------------------------------------
1296C dx/dr; dx/ds; dx/dt
1297C-----------------------------------------------------------------------
1298 dxdr(i) = dnidr(1)*xx(i,1) + dnidr(2)*xx(i,2) + dnidr(3)*xx(i,3)
1299 + + dnidr(4)*xx(i,4) + dnidr(5)*xx(i,5) + dnidr(6)*xx(i,6)
1300 + + dnidr(7)*xx(i,7) + dnidr(8)*xx(i,8)
1301 + + dnidr(9)*xx(i,9) + dnidr(10)*xx(i,10) + dnidr(11)*xx(i,11)
1302 + + dnidr(12)*xx(i,12) + dnidr(13)*xx(i,13) + dnidr(14)*xx(i,14)
1303 + + dnidr(15)*xx(i,15) + dnidr(16)*xx(i,16) + dnidr(17)*xx(i,17)
1304 + + dnidr(18)*xx(i,18) + dnidr(19)*xx(i,19) + dnidr(20)*xx(i,20)
1305C
1306 dxds(i) = dnids(1)*xx(i,1) + dnids(2)*xx(i,2) + dnids(3)*xx(i,3)
1307 + + dnids(4)*xx(i,4) + dnids(5)*xx(i,5) + dnids(6)*xx(i,6)
1308 + + dnids(7)*xx(i,7) + dnids(8)*xx(i,8)
1309 + + dnids(9)*xx(i,9) + dnids(10)*xx(i,10) + dnids(11)*xx(i,11)
1310 + + dnids(12)*xx(i,12) + dnids(13)*xx(i,13) + dnids(14)*xx(i,14)
1311 + + dnids(15)*xx(i,15) + dnids(16)*xx(i,16) + dnids(17)*xx(i,17)
1312 + + dnids(18)*xx(i,18) + dnids(19)*xx(i,19) + dnids(20)*xx(i,20)
1313C
1314 dxdt(i) = dnidt(1)*xx(i,1) + dnidt(2)*xx(i,2) + dnidt(3)*xx(i,3)
1315 + + dnidt(4)*xx(i,4) + dnidt(5)*xx(i,5) + dnidt(6)*xx(i,6)
1316 + + dnidt(7)*xx(i,7) + dnidt(8)*xx(i,8)
1317 + + dnidt(9)*xx(i,9) + dnidt(10)*xx(i,10) + dnidt(11)*xx(i,11)
1318 + + dnidt(12)*xx(i,12) + dnidt(13)*xx(i,13) + dnidt(14)*xx(i,14)
1319 + + dnidt(15)*xx(i,15) + dnidt(16)*xx(i,16) + dnidt(17)*xx(i,17)
1320 + + dnidt(18)*xx(i,18) + dnidt(19)*xx(i,19) + dnidt(20)*xx(i,20)
1321C-----------------------------------------------------------------------
1322C dy/dr; dy/ds; dy/dt
1323C-----------------------------------------------------------------------
1324 dydr(i) = dnidr(1)*yy(i,1) + dnidr(2)*yy(i,2) + dnidr(3)*yy(i,3)
1325 + + dnidr(4)*yy(i,4) + dnidr(5)*yy(i,5) + dnidr(6)*yy(i,6)
1326 + + dnidr(7)*yy(i,7) + dnidr(8)*yy(i,8)
1327 + + dnidr(9)*yy(i,9) + dnidr(10)*yy(i,10) + dnidr(11)*yy(i,11)
1328 + + dnidr(12)*yy(i,12) + dnidr(13)*yy(i,13) + dnidr(14)*yy(i,14)
1329 + + dnidr(15)*yy(i,15) + dnidr(16)*yy(i,16) + dnidr(17)*yy(i,17)
1330 + + dnidr(18)*yy(i,18) + dnidr(19)*yy(i,19) + dnidr(20)*yy(i,20)
1331C
1332 dyds(i) = dnids(1)*yy(i,1) + dnids(2)*yy(i,2) + dnids(3)*yy(i,3)
1333 + + dnids(4)*yy(i,4) + dnids(5)*yy(i,5) + dnids(6)*yy(i,6)
1334 + + dnids(7)*yy(i,7) + dnids(8)*yy(i,8)
1335 + + dnids(9)*yy(i,9) + dnids(10)*yy(i,10) + dnids(11)*yy(i,11)
1336 + + dnids(12)*yy(i,12) + dnids(13)*yy(i,13) + dnids(14)*yy(i,14)
1337 + + dnids(15)*yy(i,15) + dnids(16)*yy(i,16) + dnids(17)*yy(i,17)
1338 + + dnids(18)*yy(i,18) + dnids(19)*yy(i,19) + dnids(20)*yy(i,20)
1339C
1340 dydt(i) = dnidt(1)*yy(i,1) + dnidt(2)*yy(i,2) + dnidt(3)*yy(i,3)
1341 + + dnidt(4)*yy(i,4) + dnidt(5)*yy(i,5) + dnidt(6)*yy(i,6)
1342 + + dnidt(7)*yy(i,7) + dnidt(8)*yy(i,8)
1343 + + dnidt(9)*yy(i,9) + dnidt(10)*yy(i,10) + dnidt(11)*yy(i,11)
1344 + + dnidt(12)*yy(i,12) + dnidt(13)*yy(i,13) + dnidt(14)*yy(i,14)
1345 + + dnidt(15)*yy(i,15) + dnidt(16)*yy(i,16) + dnidt(17)*yy(i,17)
1346 + + dnidt(18)*yy(i,18) + dnidt(19)*yy(i,19) + dnidt(20)*yy(i,20)
1347C-----------------------------------------------------------------------
1348C dz/dr; dz/ds; dz/dt
1349C-----------------------------------------------------------------------
1350 dzdr(i) = dnidr(1)*zz(i,1) + dnidr(2)*zz(i,2) + dnidr(3)*zz(i,3)
1351 + + dnidr(4)*zz(i,4) + dnidr(5)*zz(i,5) + dnidr(6)*zz(i,6)
1352 + + dnidr(7)*zz(i,7) + dnidr(8)*zz(i,8)
1353 + + dnidr(9)*zz(i,9) + dnidr(10)*zz(i,10) + dnidr(11)*zz(i,11)
1354 + + dnidr(12)*zz(i,12) + dnidr(13)*zz(i,13) + dnidr(14)*zz(i,14)
1355 + + dnidr(15)*zz(i,15) + dnidr(16)*zz(i,16) + dnidr(17)*zz(i,17)
1356 + + dnidr(18)*zz(i,18) + dnidr(19)*zz(i,19) + dnidr(20)*zz(i,20)
1357C
1358 dzds(i) = dnids(1)*zz(i,1) + dnids(2)*zz(i,2) + dnids(3)*zz(i,3)
1359 + + dnids(4)*zz(i,4) + dnids(5)*zz(i,5) + dnids(6)*zz(i,6)
1360 + + dnids(7)*zz(i,7) + dnids(8)*zz(i,8)
1361 + + dnids(9)*zz(i,9) + dnids(10)*zz(i,10) + dnids(11)*zz(i,11)
1362 + + dnids(12)*zz(i,12) + dnids(13)*zz(i,13) + dnids(14)*zz(i,14)
1363 + + dnids(15)*zz(i,15) + dnids(16)*zz(i,16) + dnids(17)*zz(i,17)
1364 + + dnids(18)*zz(i,18) + dnids(19)*zz(i,19) + dnids(20)*zz(i,20)
1365C
1366 dzdt(i) = dnidt(1)*zz(i,1) + dnidt(2)*zz(i,2) + dnidt(3)*zz(i,3)
1367 + + dnidt(4)*zz(i,4) + dnidt(5)*zz(i,5) + dnidt(6)*zz(i,6)
1368 + + dnidt(7)*zz(i,7) + dnidt(8)*zz(i,8)
1369 + + dnidt(9)*zz(i,9) + dnidt(10)*zz(i,10) + dnidt(11)*zz(i,11)
1370 + + dnidt(12)*zz(i,12) + dnidt(13)*zz(i,13) + dnidt(14)*zz(i,14)
1371 + + dnidt(15)*zz(i,15) + dnidt(16)*zz(i,16) + dnidt(17)*zz(i,17)
1372 + + dnidt(18)*zz(i,18) + dnidt(19)*zz(i,19) + dnidt(20)*zz(i,20)
1373C-----------------------------------------------------------------------
1374C -1
1375C [j] jacobian inversion
1376C-----------------------------------------------------------------------
1377 drdx(i)=dyds(i)*dzdt(i)-dzds(i)*dydt(i)
1378 drdy(i)=dzds(i)*dxdt(i)-dxds(i)*dzdt(i)
1379 drdz(i)=dxds(i)*dydt(i)-dyds(i)*dxdt(i)
1380C
1381 dsdz(i)=dxdt(i)*dydr(i)-dydt(i)*dxdr(i)
1382 dsdy(i)=dzdt(i)*dxdr(i)-dxdt(i)*dzdr(i)
1383 dsdx(i)=dydt(i)*dzdr(i)-dzdt(i)*dydr(i)
1384C
1385 dtdx(i)=dydr(i)*dzds(i)-dzdr(i)*dyds(i)
1386 dtdy(i)=dzdr(i)*dxds(i)-dxdr(i)*dzds(i)
1387 dtdz(i)=dxdr(i)*dyds(i)-dydr(i)*dxds(i)
1388C
1389 det(i) = dxdr(i) * drdx(i)
1390 . + dydr(i) * drdy(i)
1391 . + dzdr(i) * drdz(i)
1392C
1393c
1394c print *, "Det",DET(I)
1395c print *, "DXDR(I),DYDR(I),DZDR(I)",DXDR(I),DYDR(I),DZDR(I)
1396c print *, "DXDs(I),DYDs(I),DZDs(I)",DXDs(I),DYDs(I),DZDs(I)
1397c print *, "DXDt(I),DYDt(I),DZDt(I)",DXDt(I),DYDt(I),DZDt(I)
1398c
1399 ENDDO
1400C
1401 DO i=1,llt
1402C-----------------------------------------------------------------------
1403C -1
1404C [J] Inversion of the Jacobian Suite
1405C-----------------------------------------------------------------------
1406 d = one/det(i)
1407 drdx(i)=d*drdx(i)
1408 dsdx(i)=d*dsdx(i)
1409 dtdx(i)=d*dtdx(i)
1410C
1411 drdy(i)=d*drdy(i)
1412 dsdy(i)=d*dsdy(i)
1413 dtdy(i)=d*dtdy(i)
1414C
1415 drdz(i)=d*drdz(i)
1416 dsdz(i)=d*dsdz(i)
1417 dtdz(i)=d*dtdz(i)
1418C
1419c
1420c print *, "DRDX(I),DRDY(I),DRDZ(I)",DRDX(I),DRDY(I),DRDZ(I)
1421c print *, "DSDX(I),DSDY(I),DSDZ(I)",DSDX(I),DSDY(I),DSDZ(I)
1422c print *, "DTDX(I),DTDY(I),DTDZ(I)",DTDX(I),DTDY(I),DTDZ(I)
1423c
1424 ENDDO
1425C-----------------------------------------------------------------------
1426 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ i20lagm()

subroutine i20lagm ( x,
v,
integer, dimension(*) lll,
integer, dimension(*) jll,
integer, dimension(*) sll,
xll,
integer, dimension(*) candn,
integer, dimension(*) cande,
integer i_stok,
integer, dimension(nixs,*) ixs,
integer, dimension(12,*) ixs20,
integer, dimension(*) iadll,
eminx,
integer, dimension(*) nsv,
integer, dimension(*) nelem,
integer n_mul_mx,
integer itask,
a,
integer itied,
integer nint,
integer nkmax,
integer, dimension(*) comntag )

Definition at line 32 of file i20lagm.F.

37 use element_mod , only : nixs
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C G l o b a l P a r a m e t e r s
44C-----------------------------------------------
45#include "mvsiz_p.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "task_c.inc"
50#include "com04_c.inc"
51#include "com08_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER I_STOK,N_MUL_MX,ITASK,ITIED,NINT,NKMAX ,
56 . LLL(*),JLL(*),SLL(*),CANDN(*),CANDE(*),COMNTAG(*),
57 . IXS(NIXS,*),IXS20(12,*),IADLL(*),NSV(*) ,NELEM(*)
58C REAL
59 my_real
60 . x(3,*),v(3,*),xll(*),
61 . eminx(6,*),a(3,*)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I, K, IE, IS, IC, III(MVSIZ, 21), LLT, NFT, LE, FIRST, LAST,
66 . I20
67 my_real
68 . xx(mvsiz,21),yy(mvsiz,21),zz(mvsiz,21),
69 . dist
70C-----------------------------------------------
71C
72C
73C | M | Lt| | a | M ao
74C |---+---| | = |
75C | l | 0 | | la | bo
76C
77C [M] a + [L]t la = [M] ao
78C [L] a = bo
79C
80C a = -[M]-1[L]t la + ao
81C [L][M]-1[L]t la = [L] ao - bo
82C
83C on pose:
84C [H] = [L][M]-1[L]t
85C b = [L] ao - bo
86C
87C [h] la = b
88C
89C a = ao - [M]-1[L]t la
90C-----------------------------------------------
91C
92C la : lambda(nc)
93C ao : A(NUMNOD)
94C L : XLL(NK,NC)
95C M : MAS(NUMNOD)
96C [L][M]-1[L]t la : HLA(NC)
97C [L] ao - b : B(NC)
98C [M]-1[L]t la : LTLA(NUMNOD)
99C
100C nc: number of contacts
101C NK: Number of node for contact (8+1.16+1.8+8.16+16)
102C
103C IC : contact number (1,NC)
104C IK : local node number for a contact (1,NK)
105C I : global node number (1,NUMNOD)
106C
107C IADLL(NC) : IAD = IADLL(IC)
108C LLL(NC*(21,63)) : I = LLL(IAD+1,2...IADNEXT-1)
109C-----------------------------------------------
110C evaluation of b:
111C
112C Vs = Somme(Ni Vi)
113C Vs_ + dt As = Somme(Ni Vi_) + Somme(dt Ni Ai)
114C Somme(dt Ni Ai) - dt As = Vs_ -Somme(Ni Vi_)
115C [L] = dt {N1,N2,..,N15,-1}
116C bo = [L] a = -[L]/dt v_
117C b = [L] ao - bo
118C b = [L] ao + [L]/dt v_ = [L] (v_ + ao dt)/dt
119C-----------------------------------------------
120C b = [L] vo+/dt + vout
121C-----------------------------------------------
122C-----------------------------------------------------------------------
123C loop over contact candidates
124C-----------------------------------------------------------------------
125 first = 1 + i_stok * itask / nthread
126 last = i_stok*(itask+1) / nthread
127 llt = 0
128 nft=llt+1
129 DO ic=first,last
130 le = cande(ic)
131 ie = nelem(le)
132 i20 = ie - numels8 - numels10
133C-----------------------------------------------------------------------
134C Test Si Brick 20
135C-----------------------------------------------------------------------
136 IF(i20.ge .1.AND.i20.le .numels20)THEN
137 is = nsv(candn(ic))
138 dist = -ep30
139 dist = max(eminx(1,le)-x(1,is)-dt2*(v(1,is)+dt12*a(1,is)),
140 . x(1,is)+dt2*(v(1,is)+dt12*a(1,is))-eminx(4,le),dist)
141 dist = max(eminx(2,le)-x(2,is)-dt2*(v(2,is)+dt12*a(2,is)),
142 . x(2,is)+dt2*(v(2,is)+dt12*a(2,is))-eminx(5,le),dist)
143 dist = max(eminx(3,le)-x(3,is)-dt2*(v(3,is)+dt12*a(3,is)),
144 . x(3,is)+dt2*(v(3,is)+dt12*a(3,is))-eminx(6,le),dist)
145c IF (DIST<0.) CANDN(I) = -CANDN(I)
146C-----------------------------------------------------------------------
147C test if inside the box
148C-----------------------------------------------------------------------
149 IF(dist.le .zero)THEN
150c
151c print *, "in la boite",XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX
152c
153 llt = llt+1
154 iii(llt,21)=is
155 xx(llt,21)=x(1,is)
156 yy(llt,21)=x(2,is)
157 zz(llt,21)=x(3,is)
158 DO k=1,8
159 iii(llt,k)=ixs(k+1,ie)
160 ENDDO
161 DO k=1,12
162 iii(llt,k+8)=ixs20(k,i20)
163 ENDDO
164 DO k=1,20
165 i = iii(llt,k)
166 IF(i/=0)THEN
167 xx(llt,k)=x(1,i)
168 yy(llt,k)=x(2,i)
169 zz(llt,k)=x(3,i)
170 ELSE
171 IF(k==9)THEN
172 xx(llt,k)=0.500*(x(1,iii(llt,1))+x(1,iii(llt,2)))
173 yy(llt,k)=0.500*(x(2,iii(llt,1))+x(2,iii(llt,2)))
174 zz(llt,k)=0.500*(x(3,iii(llt,1))+x(3,iii(llt,2)))
175 ENDIF
176 IF(k==10)THEN
177 xx(llt,k)=0.500*(x(1,iii(llt,2))+x(1,iii(llt,3)))
178 yy(llt,k)=0.500*(x(2,iii(llt,2))+x(2,iii(llt,3)))
179 zz(llt,k)=0.500*(x(3,iii(llt,2))+x(3,iii(llt,3)))
180 ENDIF
181 IF(k==11)THEN
182 xx(llt,k)=0.500*(x(1,iii(llt,3))+x(1,iii(llt,4)))
183 yy(llt,k)=0.500*(x(2,iii(llt,3))+x(2,iii(llt,4)))
184 zz(llt,k)=0.500*(x(3,iii(llt,3))+x(3,iii(llt,4)))
185 ENDIF
186 IF(k==12)THEN
187 xx(llt,k)=0.500*(x(1,iii(llt,4))+x(1,iii(llt,1)))
188 yy(llt,k)=0.500*(x(2,iii(llt,4))+x(2,iii(llt,1)))
189 zz(llt,k)=0.500*(x(3,iii(llt,4))+x(3,iii(llt,1)))
190 ENDIF
191 IF(k==13)THEN
192 xx(llt,k)=0.500*(x(1,iii(llt,1))+x(1,iii(llt,5)))
193 yy(llt,k)=0.500*(x(2,iii(llt,1))+x(2,iii(llt,5)))
194 zz(llt,k)=0.500*(x(3,iii(llt,1))+x(3,iii(llt,5)))
195 ENDIF
196 IF(k==14)THEN
197 xx(llt,k)=0.500*(x(1,iii(llt,2))+x(1,iii(llt,6)))
198 yy(llt,k)=0.500*(x(2,iii(llt,2))+x(2,iii(llt,6)))
199 zz(llt,k)=0.500*(x(3,iii(llt,2))+x(3,iii(llt,6)))
200 ENDIF
201 IF(k==15)THEN
202 xx(llt,k)=0.500*(x(1,iii(llt,3))+x(1,iii(llt,7)))
203 yy(llt,k)=0.500*(x(2,iii(llt,3))+x(2,iii(llt,7)))
204 zz(llt,k)=0.500*(x(3,iii(llt,3))+x(3,iii(llt,7)))
205 ENDIF
206 IF(k==16)THEN
207 xx(llt,k)=0.500*(x(1,iii(llt,4))+x(1,iii(llt,8)))
208 yy(llt,k)=0.500*(x(2,iii(llt,4))+x(2,iii(llt,8)))
209 zz(llt,k)=0.500*(x(3,iii(llt,4))+x(3,iii(llt,8)))
210 ENDIF
211 IF(k==17)THEN
212 xx(llt,k)=0.500*(x(1,iii(llt,5))+x(1,iii(llt,6)))
213 yy(llt,k)=0.500*(x(2,iii(llt,5))+x(2,iii(llt,6)))
214 zz(llt,k)=0.500*(x(3,iii(llt,5))+x(3,iii(llt,6)))
215 ENDIF
216 IF(k==18)THEN
217 xx(llt,k)=0.500*(x(1,iii(llt,6))+x(1,iii(llt,7)))
218 yy(llt,k)=0.500*(x(2,iii(llt,6))+x(2,iii(llt,7)))
219 zz(llt,k)=0.500*(x(3,iii(llt,6))+x(3,iii(llt,7)))
220 ENDIF
221 IF(k==19)THEN
222 xx(llt,k)=0.500*(x(1,iii(llt,7))+x(1,iii(llt,8)))
223 yy(llt,k)=0.500*(x(2,iii(llt,7))+x(2,iii(llt,8)))
224 zz(llt,k)=0.500*(x(3,iii(llt,7))+x(3,iii(llt,8)))
225 ENDIF
226 IF(k==20)THEN
227 xx(llt,k)=0.500*(x(1,iii(llt,5))+x(1,iii(llt,8)))
228 yy(llt,k)=0.500*(x(2,iii(llt,5))+x(2,iii(llt,8)))
229 zz(llt,k)=0.500*(x(3,iii(llt,5))+x(3,iii(llt,8)))
230 ENDIF
231 ENDIF
232 ENDDO
233C-----------------------------------------------------------------------
234C calculation of [l] by mvsiz packet
235C-----------------------------------------------------------------------
236 IF(llt==mvsiz-1)THEN
237 CALL i20lll(
238 1 llt ,lll ,jll ,sll ,xll ,v ,
239 2 xx ,yy ,zz ,iii ,iadll ,
240 3 n_mul_mx ,a ,x ,itied ,nint ,nkmax ,
241 4 comntag )
242 nft=llt+1
243 llt = 0
244 ENDIF
245 ELSE
246c debug
247 k=0
248 ENDIF
249 ENDIF
250 ENDDO
251C-----------------------------------------------------------------------
252C calculation of [l] for the last packet
253C-----------------------------------------------------------------------
254 IF(llt/=0) CALL i20lll(
255 1 llt ,lll ,jll ,sll ,xll ,v ,
256 2 xx ,yy ,zz ,iii ,iadll ,
257 3 n_mul_mx ,a ,x ,itied ,nint ,nkmax ,
258 4 comntag )
259C
260C-----------------------------------------------
261 RETURN
i20lll
subroutine i20lll(llt, lll, jll, sll, xll, v, xx, yy, zz, iii, iadll, n_mul_mx, a, x, itied, nint, nkmax, comntag)
Definition i20lagm.F:278
max
#define max(a, b)
Definition macros.h:21

◆ i20lll()

subroutine i20lll ( integer llt,
integer, dimension(*) lll,
integer, dimension(*) jll,
integer, dimension(*) sll,
xll,
v,
xx,
yy,
zz,
integer, dimension(mvsiz,21) iii,
integer, dimension(*) iadll,
integer n_mul_mx,
a,
x,
integer itied,
integer nint,
integer nkmax,
integer, dimension(*) comntag )

Definition at line 274 of file i20lagm.F.

278C-----------------------------------------------
279C M o d u l e s
280C-----------------------------------------------
281 USE message_mod
282C-----------------------------------------------
283C I m p l i c i t T y p e s
284C-----------------------------------------------
285#include "implicit_f.inc"
286#include "comlock.inc"
287C-----------------------------------------------
288C G l o b a l P a r a m e t e r s
289C-----------------------------------------------
290#include "mvsiz_p.inc"
291C-----------------------------------------------
292C C o m m o n B l o c k s
293C-----------------------------------------------
294#include "com08_c.inc"
295 COMMON /lagglob/n_mult
296 INTEGER N_MULT
297C-----------------------------------------------
298C D u m m y A r g u m e n t s
299C-----------------------------------------------
300 INTEGER LLT,N_MUL_MX,ITIED,NINT ,NKMAX
301 INTEGER LLL(*),JLL(*),SLL(*),COMNTAG(*),
302 . III(MVSIZ,21),IADLL(*)
303C REAL
304 my_real
305 . xll(*),v(3,*),a(3,*)
306 my_real
307 . xx(mvsiz,21),yy(mvsiz,21),zz(mvsiz,21),x(3,*)
308C-----------------------------------------------
309C L o c a l V a r i a b l e s
310C-----------------------------------------------
311 INTEGER I, IK, NK, IAD, NN, J1, J2, IIK,
312 . IPERM1(20),IPERM2(20),COMPTIK
313 my_real
314 . vx,vy,vz,vn,aa
315 my_real
316 . r(mvsiz),s(mvsiz),t(mvsiz),
317 . nsx(mvsiz), nsy(mvsiz), nsz(mvsiz),
318 . nx(mvsiz), ny(mvsiz), nz(mvsiz),
319 . ni(mvsiz,21)
320 DATA iperm1 /0,0,0,0,0,0,0,0,1,2,3,4,5,6,7,8,
321 . 5,6,7,8/
322 DATA iperm2 /0,0,0,0,0,0,0,0,2,3,4,1,1,2,3,4,
323 . 6,7,8,5/
324C-----------------------------------------------
325C calculation de r,s,t
326C-----------------------------------------------
327c
328c print *, "XX(1,1),XX(1,9)",XX(1,1),XX(1,9)
329c
330 CALL i20rst(llt ,r ,s ,t ,ni ,
331 2 nsx ,nsy ,nsz ,nx ,ny ,nz ,
332 3 xx ,yy ,zz )
333C-----------------------------------------------
334C calculation of [l]
335C-----------------------------------------------
336 IF(itied==0)THEN
337 DO i=1,llt
338C-----------------------------------------------
339C Test if contact
340C-----------------------------------------------
341 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
342 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
343C
344 nk = 21
345 vx = zero
346 vy = zero
347 vz = zero
348 DO ik=1,8
349 vx = vx - (v(1,iii(i,ik))+dt12*a(1,iii(i,ik)))*ni(i,ik)
350 vy = vy - (v(2,iii(i,ik))+dt12*a(2,iii(i,ik)))*ni(i,ik)
351 vz = vz - (v(3,iii(i,ik))+dt12*a(3,iii(i,ik)))*ni(i,ik)
352 ENDDO
353 DO ik=9,21
354 IF(iii(i,ik)/=0)THEN
355 vx = vx - (v(1,iii(i,ik))+dt12*a(1,iii(i,ik)))*ni(i,ik)
356 vy = vy - (v(2,iii(i,ik))+dt12*a(2,iii(i,ik)))*ni(i,ik)
357 vz = vz - (v(3,iii(i,ik))+dt12*a(3,iii(i,ik)))*ni(i,ik)
358 ELSE
359 vx=vx
360 vy=vy
361 vz=vz
362 ENDIF
363 ENDDO
364c
365c print *, "vx,vy,vz s-m",vx,vy,vz
366c print *, "nx,ny,nz ", NX(I),NY(I),NZ(I)
367c
368 vn = nsx(i)*vx + nsy(i)*vy + nsz(i)*vz
369C-----------------------------------------------
370C Test if incoming velocity in S
371C-----------------------------------------------
372 IF(s(i)*vn<=0.0)THEN
373c
374c print *, "velocity entrante",vn
375c
376c AA = DT12/SQRT(NX(I)*NX(I)+NY(I)*NY(I)+NZ(I)*NZ(I))
377 aa = one/sqrt(nsx(i)*nsx(i)+nsy(i)*nsy(i)+nsz(i)*nsz(i))
378 nsx(i) = nsx(i)*aa
379 nsy(i) = nsy(i)*aa
380 nsz(i) = nsz(i)*aa
381#include "lockon.inc"
382 n_mult=n_mult+1
383 IF(n_mult>n_mul_mx)THEN
384#include "lockoff.inc"
385 CALL ancmsg(msgid=84,anmode=aninfo)
386 CALL arret(2)
387 ENDIF
388 iad = iadll(n_mult) - 1
389 iik=0
390 comptik=0
391 DO ik=1,21
392 IF(iii(i,ik)/=0)THEN
393 comptik=comptik+1
394 ENDIF
395 ENDDO
396 DO ik=1,21
397 IF(iii(i,ik)/=0)THEN
398 iik=iik+1
399 lll(iad+iik) = iii(i,ik)
400 jll(iad+iik) = 1
401 sll(iad+iik) = 0
402 xll(iad+iik) = nsx(i)*ni(i,ik)
403 lll(iad+comptik+iik) = iii(i,ik)
404 jll(iad+comptik+iik) = 2
405 sll(iad+comptik+iik) = 0
406 xll(iad+comptik+iik) = nsy(i)*ni(i,ik)
407 lll(iad+(2*comptik)+iik) = iii(i,ik)
408 jll(iad+(2*comptik)+iik) = 3
409 sll(iad+(2*comptik)+iik) = 0
410 xll(iad+(2*comptik)+iik) = nsz(i)*ni(i,ik)
411 nn = lll(iad+iik)
412 comntag(nn) = comntag(nn) + 1
413 ELSE
414 j1=iperm1(ik)
415 j2=iperm2(ik)
416 xll(iad+j1)=xll(iad+j1)+0.5*(nsx(i)*ni(i,ik))
417 xll(iad+j2)=xll(iad+j2)+0.5*(nsx(i)*ni(i,ik))
418 xll(iad+comptik+j1)=xll(iad+comptik+j1)+
419 . 0.5*(nsy(i)*ni(i,ik))
420 xll(iad+comptik+j2)=xll(iad+comptik+j2)+
421 . 0.5*(nsy(i)*ni(i,ik))
422 xll(iad+(2*comptik)+j1)=xll(iad+(2*comptik)+j1)+
423 . 0.5*(nsz(i)*ni(i,ik))
424 xll(iad+(2*comptik)+j2)=xll(iad+(2*comptik)+j2)+
425 . 0.5*(nsz(i)*ni(i,ik))
426 ENDIF
427 ENDDO
428 iadll(n_mult+1)=iadll(n_mult)+(3*comptik)
429 IF(iadll(n_mult+1)-1>nkmax)THEN
430#include "lockoff.inc"
431 CALL ancmsg(msgid=84,anmode=aninfo)
432 CALL arret(2)
433 ENDIF
434 sll(iad+comptik) = nint
435 sll(iad+(2*comptik)) = nint
436 sll(iad+(3*comptik)) = nint
437#include "lockoff.inc"
438 ENDIF
439 ENDIF
440 ENDDO
441 ELSEIF(itied==1)THEN
442C-----------------------------------------------
443C ITIED = 1
444C-----------------------------------------------
445 DO i=1,llt
446C-----------------------------------------------
447C Test if contact
448C-----------------------------------------------
449 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
450 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
451C
452 nk = 21
453 vx = zero
454 vy = zero
455 vz = zero
456 DO ik=1,8
457 vx = vx - (v(1,iii(i,ik))+dt12*a(1,iii(i,ik)))*ni(i,ik)
458 vy = vy - (v(2,iii(i,ik))+dt12*a(2,iii(i,ik)))*ni(i,ik)
459 vz = vz - (v(3,iii(i,ik))+dt12*a(3,iii(i,ik)))*ni(i,ik)
460 ENDDO
461 DO ik=9,21
462 IF(iii(i,ik)/=0)THEN
463 vx = vx - (v(1,iii(i,ik))+dt12*a(1,iii(i,ik)))*ni(i,ik)
464 vy = vy - (v(2,iii(i,ik))+dt12*a(2,iii(i,ik)))*ni(i,ik)
465 vz = vz - (v(3,iii(i,ik))+dt12*a(3,iii(i,ik)))*ni(i,ik)
466 ELSE
467 vx=vx
468 vy=vy
469 vz=vz
470 ENDIF
471 ENDDO
472c
473c print *, "vx,vy,vz s-m",vx,vy,vz
474c print *, "nx,ny,nz ", NX(I),NY(I),NZ(I)
475c
476 vn = nx(i)*vx + ny(i)*vy + nz(i)*vz
477C-----------------------------------------------
478C test if incoming velocity in r,
479C-----------------------------------------------
480 IF(vn<=zero)THEN
481c
482c print *, "velocity entrante",vn
483c
484#include "lockon.inc"
485 IF(n_mult+3>n_mul_mx)THEN
486#include "lockoff.inc"
487 CALL ancmsg(msgid=84,anmode=aninfo)
488 CALL arret(2)
489 ENDIF
490 IF(iadll(n_mult+1)-1+21*3>nkmax)THEN
491#include "lockoff.inc"
492 CALL ancmsg(msgid=84,anmode=aninfo)
493 CALL arret(2)
494 ENDIF
495C
496 n_mult=n_mult+1
497 iad = iadll(n_mult) - 1
498 iik=0
499 DO ik=1,21
500 IF(iii(i,ik)/=0)THEN
501 iik=iik+1
502 lll(iad+iik) = iii(i,ik)
503 jll(iad+iik) = 1
504 sll(iad+iik) = 0
505 xll(iad+iik) = ni(i,ik)
506 nn = lll(iad+iik)
507 comntag(nn) = comntag(nn) + 1
508 ELSE
509 j1=iperm1(ik)
510 j2=iperm2(ik)
511 xll(iad+j1)=xll(iad+j1)+0.5*ni(i,ik)
512 xll(iad+j2)=xll(iad+j2)+0.5*ni(i,ik)
513 ENDIF
514 ENDDO
515 sll(iad+iik) = nint
516 iadll(n_mult+1)=iadll(n_mult) + iik
517C
518 n_mult=n_mult+1
519 iad = iadll(n_mult) - 1
520 iik=0
521 DO ik=1,21
522 IF(iii(i,ik)/=0)THEN
523 iik=iik+1
524 lll(iad+iik) = iii(i,ik)
525 jll(iad+iik) = 2
526 sll(iad+iik) = 0
527 xll(iad+iik) = ni(i,ik)
528 nn = lll(iad+iik)
529 comntag(nn) = comntag(nn) + 1
530 ELSE
531 j1=iperm1(ik)
532 j2=iperm2(ik)
533 xll(iad+j1)=xll(iad+j1)+0.5*ni(i,ik)
534 xll(iad+j2)=xll(iad+j2)+0.5*ni(i,ik)
535 ENDIF
536 ENDDO
537 iadll(n_mult+1)=iadll(n_mult) + iik
538 sll(iad+iik) = nint
539C
540 n_mult=n_mult+1
541 iad = iadll(n_mult) - 1
542 iik=0
543 DO ik=1,21
544 IF(iii(i,ik)/=0)THEN
545 iik=iik+1
546 lll(iad+iik) = iii(i,ik)
547 jll(iad+iik) = 3
548 sll(iad+iik) = 0
549 xll(iad+iik) = ni(i,ik)
550 nn = lll(iad+iik)
551 comntag(nn) = comntag(nn) + 1
552 ELSE
553 j1=iperm1(ik)
554 j2=iperm2(ik)
555 xll(iad+j1)=xll(iad+j1)+0.5*ni(i,ik)
556 xll(iad+j2)=xll(iad+j2)+0.5*ni(i,ik)
557 ENDIF
558 ENDDO
559 iadll(n_mult+1)=iadll(n_mult) + iik
560 sll(iad+iik) = nint
561#include "lockoff.inc"
562 ENDIF
563 ENDIF
564 ENDDO
565 ELSE
566C-----------------------------------------------
567C ITIED = 2
568C-----------------------------------------------
569 DO i=1,llt
570C-----------------------------------------------
571C Test if contact
572C-----------------------------------------------
573 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
574 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
575C
576 nk = 21
577C-----------------------------------------------
578c
579#include "lockon.inc"
580 IF(n_mult+3>n_mul_mx)THEN
581#include "lockoff.inc"
582 CALL ancmsg(msgid=84,anmode=aninfo)
583 CALL arret(2)
584 ENDIF
585 IF(iadll(n_mult+1)-1+21*3>nkmax)THEN
586#include "lockoff.inc"
587 CALL ancmsg(msgid=84,anmode=aninfo)
588 CALL arret(2)
589 ENDIF
590 n_mult=n_mult+1
591 iad = iadll(n_mult) - 1
592 iik=0
593 DO ik=1,21
594 IF(iii(i,ik)/=0)THEN
595 iik=iik+1
596 lll(iad+iik) = iii(i,ik)
597 jll(iad+iik) = 1
598 sll(iad+iik) = 0
599 xll(iad+iik) = ni(i,ik)
600 nn = lll(iad+iik)
601 comntag(nn) = comntag(nn) + 1
602 ELSE
603 j1=iperm1(ik)
604 j2=iperm2(ik)
605 xll(iad+j1)=xll(iad+j1)+0.5*ni(i,ik)
606 xll(iad+j2)=xll(iad+j2)+0.5*ni(i,ik)
607 ENDIF
608 ENDDO
609 iadll(n_mult+1)=iadll(n_mult) + iik
610 sll(iad+iik) = nint
611C
612 n_mult=n_mult+1
613 iad = iadll(n_mult) - 1
614 iik=0
615 DO ik=1,21
616 IF(iii(i,ik)/=0)THEN
617 iik=iik+1
618 lll(iad+iik) = iii(i,ik)
619 jll(iad+iik) = 2
620 sll(iad+iik) = 0
621 xll(iad+iik) = ni(i,ik)
622 nn = lll(iad+iik)
623 comntag(nn) = comntag(nn) + 1
624 ELSE
625 j1=iperm1(ik)
626 j2=iperm2(ik)
627 xll(iad+j1)=xll(iad+j1)+0.5*ni(i,ik)
628 xll(iad+j2)=xll(iad+j2)+0.5*ni(i,ik)
629 ENDIF
630 ENDDO
631 iadll(n_mult+1)=iadll(n_mult) + iik
632 sll(iad+iik) = nint
633C
634 n_mult=n_mult+1
635 iad = iadll(n_mult) - 1
636 iik=0
637 DO ik=1,21
638 IF(iii(i,ik)/=0)THEN
639 iik=iik+1
640 lll(iad+iik) = iii(i,ik)
641 jll(iad+iik) = 3
642 sll(iad+iik) = 0
643 xll(iad+iik) = ni(i,ik)
644 nn = lll(iad+iik)
645 comntag(nn) = comntag(nn) + 1
646 ELSE
647 j1=iperm1(ik)
648 j2=iperm2(ik)
649 xll(iad+j1)=xll(iad+j1)+0.5*ni(i,ik)
650 xll(iad+j2)=xll(iad+j2)+0.5*ni(i,ik)
651 ENDIF
652 ENDDO
653 iadll(n_mult+1)=iadll(n_mult) + iik
654 sll(iad+iik) = nint
655C
656#include "lockoff.inc"
657 ENDIF
658 ENDDO
659 ENDIF
660c
661c print *, "r,s,t",r(1),s(1),t(1)
662C
663 RETURN
i20rst
subroutine i20rst(llt, r, s, t, ni, nsx, nsy, nsz, nx, ny, nz, xx, yy, zz)
Definition i20lagm.F:679
message_mod
Definition message_mod.F:1257
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86

◆ i20ni()

subroutine i20ni ( integer llt,
rr,
ss,
tt,
ni )

Definition at line 836 of file i20lagm.F.

837C-----------------------------------------------
838C I m p l i c i t T y p e s
839C-----------------------------------------------
840#include "implicit_f.inc"
841C-----------------------------------------------
842C G l o b a l P a r a m e t e r s
843C-----------------------------------------------
844#include "mvsiz_p.inc"
845C-----------------------------------------------
846C D u m m y A r g u m e n t s
847C-----------------------------------------------
848 INTEGER LLT
849 my_real
850 . rr(mvsiz),ss(mvsiz),tt(mvsiz),ni(mvsiz,21)
851C-----------------------------------------------
852C L o c a l V a r i a b l e s
853C-----------------------------------------------
854 INTEGER I
855 my_real
856 . u_m_r,u_p_r,u_m_s,u_p_s,u_m_t,u_p_t,
857 . ums_umt,ums_upt,ups_umt,ups_upt,
858 . umr_ums,umr_ups,upr_ums,upr_ups,
859 . umt_umr,umt_upr,upt_umr,upt_upr,
860 . a,r05,s05,t05
861C-----------------------------------------------------------------------
862C calculation of ni
863C-----------------------------------------------------------------------
864 DO i=1,llt
865C
866 r05 = half*rr(i)
867 s05 = half*ss(i)
868 t05 = half*tt(i)
869C
870 u_m_r = half - r05
871 u_p_r = half + r05
872C
873 u_m_s = half - s05
874 u_p_s = half + s05
875C
876 u_m_t = half - t05
877 u_p_t = half + t05
878C
879 ums_umt = u_m_s * u_m_t
880 ums_upt = u_m_s * u_p_t
881 ups_umt = u_p_s * u_m_t
882 ups_upt = u_p_s * u_p_t
883C
884 umr_ums = u_m_r * u_m_s
885 umr_ups = u_m_r * u_p_s
886 upr_ums = u_p_r * u_m_s
887 upr_ups = u_p_r * u_p_s
888C
889 umt_umr = u_m_t * u_m_r
890 umt_upr = u_m_t * u_p_r
891 upt_umr = u_p_t * u_m_r
892 upt_upr = u_p_t * u_p_r
893C
894 ni(i,1) = u_m_r * ums_umt * (-rr(i)-ss(i)-tt(i)-two)
895 ni(i,2) = u_m_r * ums_upt * (-rr(i)-ss(i)+tt(i)-two)
896 ni(i,3) = u_p_r * ums_upt * ( rr(i)-ss(i)+tt(i)-two)
897 ni(i,4) = u_p_r * ums_umt * ( rr(i)-ss(i)-tt(i)-two)
898 ni(i,5) = u_m_r * ups_umt * (-rr(i)+ss(i)-tt(i)-two)
899 ni(i,6) = u_m_r * ups_upt * (-rr(i)+ss(i)+tt(i)-two)
900 ni(i,7) = u_p_r * ups_upt * ( rr(i)+ss(i)+tt(i)-two)
901 ni(i,8) = u_p_r * ups_umt * ( rr(i)+ss(i)-tt(i)-two)
902C------------------------------------
903 a = (one-rr(i)*rr(i))
904 ni(i,10) = a * ums_upt
905 ni(i,12) = a * ums_umt
906 ni(i,18) = a * ups_upt
907 ni(i,20) = a * ups_umt
908C------------------------------------
909 a = (one-ss(i)*ss(i))
910 ni(i,13) = a * umt_umr
911 ni(i,14) = a * upt_umr
912 ni(i,15) = a * upt_upr
913 ni(i,16) = a * umt_upr
914C------------------------------------
915 a = (one-tt(i)*tt(i))
916 ni(i,9) = a * umr_ums
917 ni(i,11) = a * upr_ums
918 ni(i,17) = a * umr_ups
919 ni(i,19) = a * upr_ups
920C------------------------------------
921 ni(i,21) = -one
922C------------------------------------
923 ENDDO
924C-----------------------------------------------
925 RETURN

◆ i20rst()

subroutine i20rst ( integer llt,
r,
s,
t,
ni,
nsx,
nsy,
nsz,
nx,
ny,
nz,
xx,
yy,
zz )

Definition at line 676 of file i20lagm.F.

679C-----------------------------------------------
680C I m p l i c i t T y p e s
681C-----------------------------------------------
682#include "implicit_f.inc"
683C-----------------------------------------------
684C G l o b a l P a r a m e t e r s
685C-----------------------------------------------
686#include "mvsiz_p.inc"
687C-----------------------------------------------
688C D u m m y A r g u m e n t s
689C-----------------------------------------------
690 INTEGER LLT
691C REAL
692 my_real
693 . xx(mvsiz,21),yy(mvsiz,21),zz(mvsiz,21)
694 my_real
695 . r(mvsiz),s(mvsiz),t(mvsiz),ni(mvsiz,21) ,
696 . nsx(mvsiz),nsy(mvsiz),nsz(mvsiz),
697 . nx(mvsiz),ny(mvsiz),nz(mvsiz)
698C-----------------------------------------------
699C L o c a l V a r i a b l e s
700C-----------------------------------------------
701 INTEGER I, ITER, NITERMAX, JTER, NJTERMAX, CONV
702 my_real
703 . sn, rn, tn,
704 . drdx(mvsiz),drdy(mvsiz),drdz(mvsiz),
705 . dsdx(mvsiz),dsdy(mvsiz),dsdz(mvsiz),
706 . dtdx(mvsiz),dtdy(mvsiz),dtdz(mvsiz),
707 . dxdr(mvsiz),dydr(mvsiz),dzdr(mvsiz),
708 . dxds(mvsiz),dyds(mvsiz),dzds(mvsiz),
709 . dxdt(mvsiz),dydt(mvsiz),dzdt(mvsiz),
710 . rr(mvsiz),ss(mvsiz),tt(mvsiz)
711C-----------------------------------------------
712C
713C r=s=t=0
714C
715C +---> iter
716C |
717C | Ni(r,s,t) =
718C | dNi/dr =
719C | ... _
720C | \
721C | dx/dr = /_ (xi * dNi/dr)
722C | ...
723C |
724C | [dx/dr dy/dr dz/dr]
725C | [J] = |dx/ds dy/ds dz/ds|
726C | [dx/dt dy/dt dz/dt]
727C |
728C | +--> jter
729C | | _
730C | | \
731C | | x(r,s,t) = /_ (xi * Ni(r,s,t))
732C | | ...
733C | |
734C | | |r| |r| -1 |xs-x(r,s,t)|
735C | | {s} = {s} + [J] {ys-y(r,s,t)}
736C | | |t| |t| |zs-z(r,s,t)|
737C | |
738C | | Ni(r,s,t) =
739C +-+---
740C-----------------------------------------------
741 nitermax = 3
742 njtermax = 3
743 conv = 0
744C
745 DO i=1,llt
746 rr(i) = zero
747 ss(i) = zero
748 tt(i) = zero
749 ENDDO
750C-----------------------------------------------
751C calculation de r,s,t et Ni(r,s,t)
752C-----------------------------------------------
753 DO iter=1,nitermax
754c
755c print *, "iter",iter
756c
757C-----------------------------------------------
758C calculation de Ni(r,s,t); [J]; [J]-1
759C-----------------------------------------------
760 CALL i20deri(llt,rr ,ss ,tt ,ni ,
761 2 drdx ,drdy ,drdz ,dsdx ,dsdy ,dsdz ,
762 3 dtdx ,dtdy ,dtdz ,dxdr ,dydr ,dzdr ,
763 4 dxds ,dyds ,dzds ,dxdt ,dydt ,dzdt ,
764 5 xx ,yy ,zz )
765C
766 DO jter=1,njtermax
767c
768c print *, "jter",jter
769c
770C-----------------------------------------------
771C calculation de r,s,t new
772C-----------------------------------------------
773 CALL i20rstn(llt,rr,ss ,tt ,ni ,conv ,
774 2 drdx ,drdy ,drdz ,dsdx ,dsdy ,dsdz ,
775 3 dtdx ,dtdy ,dtdz ,xx ,yy ,zz ,
776 4 r ,s ,t )
777c
778c print *, "r,s,t",r(1),s(1),t(1)
779c print *, "rr,ss,tt",rr(1),ss(1),tt(1)
780c
781C-----------------------------------------------
782C calculation de Ni(-1<r<1 , -1<s<1 , -1<t<1)
783C-----------------------------------------------
784 CALL i20ni(llt,rr ,ss ,tt ,ni )
785C parith on problem if conv function of mvsiz !!!!!!
786C IF(CONV/=0)RETURN
787C
788 ENDDO
789 ENDDO
790C
791 DO i=1,llt
792 nsx(i) = dydt(i)*dzdr(i) - dzdt(i)*dydr(i)
793 nsy(i) = dzdt(i)*dxdr(i) - dxdt(i)*dzdr(i)
794 nsz(i) = dxdt(i)*dydr(i) - dydt(i)*dxdr(i)
795C
796 sn = ss(i) * ss(i)
797 sn = sn * sn
798 sn = sn * sn
799 sn = sn * sn
800 sn = sn * sn
801 sn = sn * ss(i)
802 nx(i) = sn * nsx(i)
803 ny(i) = sn * nsy(i)
804 nz(i) = sn * nsz(i)
805C
806 rn = rr(i) * rr(i)
807 rn = rn * rn
808 rn = rn * rn
809 rn = rn * rn
810 rn = rn * rn
811 rn = rn * rr(i)
812 nx(i) = nx(i) + rn * (dyds(i)*dzdt(i) - dzds(i)*dydt(i))
813 ny(i) = ny(i) + rn * (dzds(i)*dxdt(i) - dxds(i)*dzdt(i))
814 nz(i) = nz(i) + rn * (dxds(i)*dydt(i) - dyds(i)*dxdt(i))
815C
816 tn = tt(i) * tt(i)
817 tn = tn * tn
818 tn = tn * tn
819 tn = tn * tn
820 tn = tn * tn
821 tn = tn * tt(i)
822 nx(i) = nx(i) + tn * (dydr(i)*dzds(i) - dzdr(i)*dyds(i))
823 ny(i) = ny(i) + tn * (dzdr(i)*dxds(i) - dxdr(i)*dzds(i))
824 nz(i) = nz(i) + tn * (dxdr(i)*dyds(i) - dydr(i)*dxds(i))
825C
826 ENDDO
827C
828 RETURN
i20deri
subroutine i20deri(llt, rr, ss, tt, ni, drdx, drdy, drdz, dsdx, dsdy, dsdz, dtdx, dtdy, dtdz, dxdr, dydr, dzdr, dxds, dyds, dzds, dxdt, dydt, dzdt, xx, yy, zz)
Definition i20lagm.F:1044
i20rstn
subroutine i20rstn(llt, rr, ss, tt, ni, conv, drdx, drdy, drdz, dsdx, dsdy, dsdz, dtdx, dtdy, dtdz, xx, yy, zz, r, s, t)
Definition i20lagm.F:936
i20ni
subroutine i20ni(llt, rr, ss, tt, ni)
Definition i20lagm.F:837

◆ i20rstn()

subroutine i20rstn ( integer llt,
rr,
ss,
tt,
ni,
integer conv,
drdx,
drdy,
drdz,
dsdx,
dsdy,
dsdz,
dtdx,
dtdy,
dtdz,
xx,
yy,
zz,
r,
s,
t )

Definition at line 932 of file i20lagm.F.

936C-----------------------------------------------
937C I m p l i c i t T y p e s
938C-----------------------------------------------
939c#include "implicit_f.inc"
940 implicit none
941C-----------------------------------------------
942C G l o b a l P a r a m e t e r s
943C-----------------------------------------------
944#include "mvsiz_p.inc"
945#include "constant.inc"
946C-----------------------------------------------
947C D u m m y A r g u m e n t s
948C-----------------------------------------------
949 INTEGER LLT,CONV
950 my_real
951 . r(mvsiz),s(mvsiz),t(mvsiz),ni(mvsiz,21) ,
952 . rr(mvsiz),ss(mvsiz),tt(mvsiz),
953 . xx(mvsiz,21) ,yy(mvsiz,21) ,zz(mvsiz,21) ,
954 . drdx(mvsiz),drdy(mvsiz),drdz(mvsiz),
955 . dsdx(mvsiz),dsdy(mvsiz),dsdz(mvsiz),
956 . dtdx(mvsiz),dtdy(mvsiz),dtdz(mvsiz)
957C-----------------------------------------------
958C L o c a l V a r i a b l e s
959C-----------------------------------------------
960 INTEGER I
961 my_real
962 . dx ,dy,dz,dr ,ds,dt,err
963C
964 err=zero
965C-----------------------------------------------
966 DO i=1,llt
967C
968 dx = xx(i,21)
969 + - ni(i, 1)*xx(i, 1) - ni(i, 2)*xx(i, 2) - ni(i, 3)*xx(i, 3)
970 + - ni(i, 4)*xx(i, 4) - ni(i, 5)*xx(i, 5) - ni(i, 6)*xx(i, 6)
971 + - ni(i, 7)*xx(i, 7) - ni(i, 8)*xx(i, 8) - ni(i, 9)*xx(i, 9)
972 + - ni(i,10)*xx(i,10) - ni(i,11)*xx(i,11) - ni(i,12)*xx(i,12)
973 + - ni(i,13)*xx(i,13) - ni(i,14)*xx(i,14) - ni(i,15)*xx(i,15)
974 + - ni(i,16)*xx(i,16) - ni(i,17)*xx(i,17) - ni(i,18)*xx(i,18)
975 + - ni(i,19)*xx(i,19) - ni(i,20)*xx(i,20)
976 dy = yy(i,21)
977 + - ni(i, 1)*yy(i, 1) - ni(i, 2)*yy(i, 2) - ni(i, 3)*yy(i, 3)
978 + - ni(i, 4)*yy(i, 4) - ni(i, 5)*yy(i, 5) - ni(i, 6)*yy(i, 6)
979 + - ni(i, 7)*yy(i, 7) - ni(i, 8)*yy(i, 8) - ni(i, 9)*yy(i, 9)
980 + - ni(i,10)*yy(i,10) - ni(i,11)*yy(i,11) - ni(i,12)*yy(i,12)
981 + - ni(i,13)*yy(i,13) - ni(i,14)*yy(i,14) - ni(i,15)*yy(i,15)
982 + - ni(i,16)*yy(i,16) - ni(i,17)*yy(i,17) - ni(i,18)*yy(i,18)
983 + - ni(i,19)*yy(i,19) - ni(i,20)*yy(i,20)
984 dz = zz(i,21)
985 + - ni(i, 1)*zz(i, 1) - ni(i, 2)*zz(i, 2) - ni(i, 3)*zz(i, 3)
986 + - ni(i, 4)*zz(i, 4) - ni(i, 5)*zz(i, 5) - ni(i, 6)*zz(i, 6)
987 + - ni(i, 7)*zz(i, 7) - ni(i, 8)*zz(i, 8) - ni(i, 9)*zz(i, 9)
988 + - ni(i,10)*zz(i,10) - ni(i,11)*zz(i,11) - ni(i,12)*zz(i,12)
989 + - ni(i,13)*zz(i,13) - ni(i,14)*zz(i,14) - ni(i,15)*zz(i,15)
990 + - ni(i,16)*zz(i,16) - ni(i,17)*zz(i,17) - ni(i,18)*zz(i,18)
991 + - ni(i,19)*zz(i,19) - ni(i,20)*zz(i,20)
992C
993 dr = drdx(i)*dx + drdy(i)*dy + drdz(i)*dz
994 ds = dsdx(i)*dx + dsdy(i)*dy + dsdz(i)*dz
995 dt = dtdx(i)*dx + dtdy(i)*dy + dtdz(i)*dz
996C
997c
998c print *, "DRDX(I),DRDY(I),DRDZ(I)",DRDX(I),DRDY(I),DRDZ(I)
999c print *, "DSDX(I),DSDY(I),DSDZ(I)",DSDX(I),DSDY(I),DSDZ(I)
1000c print *, "DTDX(I),DTDY(I),DTDZ(I)",DTDX(I),DTDY(I),DTDZ(I)
1001c print *, "Ni",ni(1,1),ni(1,2),ni(1,3),ni(1,4),ni(1,5),ni(1,9)
1002c print *, "dx,dy,dz",dx ,dy ,dz
1003c
1004 rr(i) = rr(i) + dr
1005 ss(i) = ss(i) + ds
1006 tt(i) = tt(i) + dt
1007C
1008 r(i) = rr(i)
1009 s(i) = ss(i)
1010 t(i) = tt(i)
1011C
1012 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
1013 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
1014 err = max(err,abs(dr),abs(ds),abs(dt))
1015 ELSE
1016 rr(i) = max(min(rr(i),one),-one)
1017 ss(i) = max(min(ss(i),one),-one)
1018 tt(i) = max(min(tt(i),one),-one)
1019 ENDIF
1020c
1021c print *, "3r,s,t",r(1),s(1),t(1)
1022c print *, "3rr,ss,tt",rr(1),ss(1),tt(1)
1023c print *, "dr,ds,dt",dr ,ds ,dt
1024c print *, "r,s,t",r(1),s(1),t(1)
1025c print *, "ERR",ERR
1026c
1027C
1028 ENDDO
1029C
1030 IF(err<em4) conv = 1
1031C-----------------------------------------------
1032 RETURN
min
#define min(a, b)
Definition macros.h:20