36 1 NMONV ,IMONV ,MONVOL ,IGRSURF ,
37 2 FR_MV ,ITAG ,NPBY ,LPBY ,NRBYAC ,
38 3 IRBYAC ,NINT2 ,IINT2 ,IPARI ,INTBUF_TAB,
39 4 NDOF ,IPREC0 ,IRBE3 ,IRBE2 ,LRBE2 )
49#include "implicit_f.inc"
62 INTEGER NMONV,IMONV(*),MONVOL(*),
63 . FR_MV(NSPMD+2,NVOLU),(*),NDOF(*),IPREC0
64 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
65 . ,IINT2(*),IPARI(NPARI,*),IRBE3(NRBE3L,*),
66 . irbe2(nrbe2l,*),lrbe2(*)
69 TYPE(intbuf_struct_) INTBUF_TAB(*)
70 TYPE (SURF_) ,
DIMENSION(NSURF) :: IGRSURF
74 INTEGER , NTYP,NN,K1,IAD,IS,J,N,NOD,NUMN,ID,NMT,IROT,
75 . IERR1,IERR2,IERR3,IERR4,IERR5,IERR6
78 IF(nvolu>0.AND.impmv>0)
THEN
89 IF(fr_mv(ispmd+1,i)==0)
GO TO 100
96 nod = igrsurf(is)%NODES(j,n)
97 IF (itag(nod)==0)
THEN
106 IF (imonv(i)>0) nmonv = nmonv+1
107 ELSEIF (neig==zero)
THEN
110 WRITE(istdo,1001)ntyp
118 IF (nmonv == 0)
RETURN
123 IF (j>0)
in_mv(j) = i
126 1 npby ,lpby ,nrbyac ,irbyac ,nint2 ,
127 2 iint2 ,ipari ,intbuf_tab,itag ,
nrb_mv ,
144 1 npby ,lpby ,nrbyac ,irbyac ,nint2 ,
145 2 iint2 ,ipari ,intbuf_tab,itag ,
nrb_mv ,
158 irot=
max(irot,irbe3(6,n))
163 ALLOCATE(fcdi_mv(18*nmt),stat=ierr5)
166 ALLOCATE(mcdi_mv(18*nmt),stat=ierr5)
171 ALLOCATE(diag_mv(3,
numn_mv),stat=ierr2)
173 IF (
ni2_mv>0)
ALLOCATE(diag_mvm2(6,4,
ni2_mv),stat=ierr5)
180 ALLOCATE(diag_mvm4(6,
nrbe2_mv),stat=ierr5)
185 1001
FORMAT(5x,
'*****WARNING : IMPLICIT OPTION IS NOT AVAILABLE',
186 .
' WITH MONITORED VOLUME TYPE:',i3/,5x,
187 .
'****** IT WILL BE IGNORED *****')
198 1 NPBY ,LPBY ,NRBYAC ,IRBYAC ,NINT2 ,
199 2 IINT2 ,IPARI ,INTBUF_TAB,INLOC ,LNS ,
200 3 LNS2 ,IRBE3 ,LNS3 ,IRBE2 ,LRBE2 ,
209#include "implicit_f.inc"
213#include "com04_c.inc"
214#include "param_c.inc"
218 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
219 . NINT2,IINT2(*),IPARI(NPARI,*)
221 . INLOC(*),LNS ,LNS2,IRBE3(NRBE3L,*) ,LNS3,
222 . IRBE2(NRBE2L,*),LRBE2(*),LNS4
224 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
229 . i,j,k,n,l,
nl,nj,ni,j1,m,nsn,n1,n2,nk,
id,
230 . ji,k10,k11,k12,k13,k14,kfi,ns
248 ni=intbuf_tab(n)%NSV(i)
249 IF (inloc(ni)>0)
THEN
263 IF (inloc(ni)>0)
THEN
265 IF (inloc(m)==0) inloc(m) = 2
274 IF (inloc(ni)>0)
THEN
288 IF (inloc(ni)>0)
THEN
290 IF (inloc(m)==0) inloc(m) = 1
300!||
monv_prem ../engine/source/airbag/monv_imp0.f
302!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.f90
305 1 NPBY ,LPBY ,NRBYAC ,IRBYAC ,NINT2 ,
306 2 IINT2 ,IPARI ,INTBUF_TAB,INLOC ,NRB_MV ,
307 3 IRB_MV ,NI2_MV ,II2_MV ,IRBE3 ,NRBE3_MV ,
308 4 IRBE3_MV ,IRBE2 ,LRBE2 ,NRBE2_MV ,IRBE2_MV )
316#include "implicit_f.inc"
320#include "com04_c.inc"
321#include "param_c.inc"
325 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
326 . NINT2,IINT2(*),IPARI(NPARI,*)
328 . INLOC(*),NRB_MV,NI2_MV,IRB_MV(2,*),II2_MV(2,*),
329 . IRBE3(NRBE3L,*),NRBE3_MV ,IRBE3_MV(*),
330 . IRBE2(NRBE2L,*),LRBE2(*),NRBE2_MV ,IRBE2_MV(2,*)
333 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
338 . i,j,k,n,l,
nl,nj,ni,j1,m,nsn,n1,n2,nk,
id,
339 . ji,k10,k11,k12,k13,k14,kfi,ni2,nrb,nr3,nr2
358 ni=intbuf_tab(n)%NSV(i)
359 IF (inloc(ni)>0)
THEN
366 IF (ni2/=ni2_mv)
WRITE(*,*)
'pb cal NI2_MV'
379 IF (inloc(ni)>0)
THEN
387 IF (nr2/=nrbe2_mv)
WRITE(*,*)
'pb cal NRBE2_MV'
395 IF (inloc(ni)>0)
THEN
400 IF (nr3/=nrbe3_mv)
WRITE(*,*)
'pb cal NRBE3_MV'
414 IF (inloc(ni)>0)
THEN
422 IF (nrb/=nrb_mv)
WRITE(*,*)
'pb cal NRB_MV'
446#include "implicit_f.inc"
450#include "com04_c.inc"
451#include "param_c.inc"
455 INTEGER IBFV(NIFV,*),LJ(*),ISKEW(*) ,ICODT(*)
459 INTEGER I,J,K,N,L,IERR1,IERR2,IERR3,ITAG(NUMNOD)
470 IF (iskew(n)>1.AND.icodt(n)/=7)
THEN
479 IF (iskew(n)>1.AND.icodt(n)/=7)
THEN
508 IF (lj(j)>0.AND.lj(j)<=3)
THEN
518 IF (lj(j)>0.AND.lj(j)<=3)
THEN
560 1 NMONV ,IMONV ,IPARI ,INTBUF_TAB ,
561 2 A_MV ,AR_MV ,NDOF ,IDDL ,IKC ,
562 3 INLOC ,IPREC ,IBFV ,SKEW ,XFRAME ,
563 4 LJ ,ISKEW ,ICODT ,IRBE3 ,LRBE3 ,
564 5 FRBE3 ,IRBE2 ,LRBE2 ,NSURF )
573 INTEGER NMONV,IMONV(*),MONVOL(*),
574 . IPARI(*), NDOF(*),IDDL(*),IKC(*),
575 . INLOC(*),IPREC,IBFV(*),LJ(*),(*),ICODT(*),
576 . irbe3(*),lrbe3(*),irbe2(*),lrbe2(*),nsurf
579 . x(3,*),a_mv(3,*),ar_mv(3,*), volmon(*) ,
580 . skew(*) ,xframe(*),frbe3(*)
581 TYPE(intbuf_struct_) INTBUF_TAB(*)
582 TYPE(SURF_) ,
DIMENSION(NSURF) :: IGRSURF
588 CALL MONV_FVL(IBFV ,LJ ,ISKEW ,ICODT )
589 CALL MONV_M3(MONVOL ,VOLMON ,X ,IGRSURF ,
590 1 nmonv ,imonv ,ipari ,intbuf_tab,
591 2 a_mv ,ar_mv ,ndof ,iddl ,ikc ,
592 3 inloc ,iprec ,ibfv ,skew ,xframe ,
593 4 irbe3 ,lrbe3 ,frbe3 ,irbe2 ,lrbe2 )
600!||
monv_imp ../engine/source/airbag/monv_imp0.f
611 SUBROUTINE monv_m3(MONVOL ,VOLMON ,X ,IGRSURF ,
612 1 NMONV ,IMONV ,IPARI ,INTBUF_TAB,
613 2 A_MV ,AR_MV ,NDOF ,IDDL ,IKC ,
614 3 INLOC ,IPREC ,IBFV ,SKEW ,XFRAME ,
615 4 IRBE3 ,LRBE3 ,FRBE3 ,IRBE2 ,LRBE2 )
625#include "implicit_f.inc"
629#include "com04_c.inc"
630#include "param_c.inc"
634 INTEGER NMONV,(*),MONVOL(*),
635 . IPARI(NPARI,*), NDOF(*),(*),IKC(*),
636 . INLOC(*),IPREC,IBFV(*),IRBE3(NRBE3L,*),LRBE3(*),
637 . IRBE2(NRBE2L,*),LRBE2(
640 . x(3,*),a_mv(3,*),ar_mv(3,*), volmon(*) ,
641 . skew(*) ,xframe(*),frbe3(*)
643 TYPE(intbuf_struct_) INTBUF_TAB(*)
644 TYPE(SURF_) ,
DIMENSION(NSURF) :: IGRSURF
648 INTEGER I,J,IDDLM(NUMNOD),NKC,N,ND,ID,NKIN,IAD
649 INTEGER M,NSN,JI,K10,K11,,K13,K14,L,NNOD,NJ,NL,NI
651 CALL ID_MVINI(IPARI ,INTBUF_TAB,NDOF ,IDDL ,IKC ,
655CALL zeror(a_mv,numnod)
656 CALL monv_kd(monvol ,volmon ,x ,igrsurf ,
662 .
CALL zeror(ar_mv,numnod)
666 . skew ,xframe ,x ,a_mv ,ar_mv ,
675 DO j = 1,
min(3,ndof(n))
677 IF (id>0) diag_mv(j,i)=a_mv(j,n)
687 diag_mvm(j,i)=a_mv(j,n)
689 diag_mvm(j,i)=ar_mv(j-3,n)
708 l=intbuf_tab(n)%IRTLM(ni)
710 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4))
THEN
717 nj=intbuf_tab(n)%IRECTM(nl+m)
722 diag_mvm2(j,m,i)=a_mv(j,nj)
724 diag_mvm2(j,m,i)=ar_mv(j-3,nj)
742 diag_mvm3(j,m,i)=a_mv(j,nj)
744 diag_mvm3(j,m,i)=ar_mv(j-3,nj)
758 diag_mvm4(j,i)=a_mv(j,m)
760 diag_mvm4(j,i)=ar_mv(j-3,m)
776!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.f90
778 SUBROUTINE id_mvini(IPARI ,INTBUF_TAB,NDOF ,IDDL ,IKC ,
779 1 INLOC ,X ,SKEW ,IRBE3 ,LRBE3 ,
780 2 FRBE3 ,IRBE2 ,LRBE2 )
789#include "implicit_f.inc"
793#include "com04_c.inc"
794#include "param_c.inc"
795#include "tabsiz_c.inc"
799 INTEGER IPARI(NPARI,*), (*),IDDL(*),IKC(*),
800 . INLOC(*),IRBE3(NRBE3L,*),LRBE3(*),
801 . irbe2(nrbe2l,*),lrbe2(*)
804 . x(3,*),skew(*) ,frbe3(*)
810 INTEGER I,J,IDDLM(NUMNOD),NKC,N,ND,ID,NND,IROT,NMT,IAD,IADS
811 INTEGER M,NSN,JI,K10,K11,K12,K13,K14,L,NNOD,NJ,NL,NI
819 IF (ikc(nd)/=0) nkc = nkc + 1
831 DO j = 1 ,
min(3,ndof(n))
835 id_mv(j,i) = iddlm(n) + nd
837 id_mv(j,i) = -ikc(id)
850 id_mvm(j,i) = iddlm(n) + nd
870 l=intbuf_tab(n)%IRTLM(ni)
872 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4))
THEN
879 nj=intbuf_tab(n)%IRECTM(nl+m)
885 id_mvm2(j,m,i) = iddlm(nj) + nd
906 id_mvm3(j,m,i) = iddlm(nj) + nd
922 CALL rbe3cl(lrbe3(iad+1),lrbe3(nmt+iad+1),ni ,x ,
923 . frbe3(iad+1),skew ,nnod ,irot ,
924 . fcdi_mv(iads),mcdi_mv(iads) ,irbe3(2,n) )
953!||
monv_kedj ../engine/source/airbag/monv_imp0.f
957 SUBROUTINE monv_kd(MONVOL ,VOLMON ,X ,IGRSURF ,
958 1 NMONV ,IMONV ,K_DIAG ,NNMAX_MV)
966#include "implicit_f.inc"
970#include "com04_c.inc"
971#include "param_c.inc"
975 INTEGER NMONV,IMONV(*),MONVOL(*),
979 . X(3,*), VOLMON(*) ,K_DIAG(3,*)
980 TYPE(SURF_) ,
DIMENSION(NSURF) :: IGRSURF
984 INTEGER I, NTYP,NN,K1,IAD,IS,J,N,NMV,
985 . N1,N2,N3,N4,KK1,J1,ID,ID1,M1,M2,M3,M4
987 . vol(nmonv),nor(3,nnmax_mv),dvd1(3),dvd2(3),gamav(nmonv)
989 . xx,yy,zz,x12,y12,z12,x13,y13,z13,x24,y24,z24,v,
1000 vol(nmv) = volmon(kk1+16)- volmon(kk1+5)
1001 gamav(nmv) = (volmon(kk1+1)-one)*volmon(kk1+13) /vol(nmv)
1012 nn = igrsurf(is)%NSEG
1015 n1 = igrsurf(is)%NODES(j,1)
1016 n2 = igrsurf(is)%NODES(j,2)
1017 n3 = igrsurf(is)%NODES(j,3)
1018 n4 = igrsurf(is)%NODES(j,4)
1025 nor(1,j)=half*(y13*z24-y24*z13)
1026 nor(2,j)=half*(z13*x24-z24*x13)
1027 nor(3,j)=half*(x13*y24-x24*y13)
1030 n1 = igrsurf(is)%NODES(j,1)
1031 n2 = igrsurf(is)%NODES(j,2)
1032 n3 = igrsurf(is)%NODES(j,3)
1033 n4 = igrsurf(is)%NODES(j,4)
1034 xx=half*(x(1,n1)+x(1,n2))
1035 yy=half*(x(2,n1)+x(2,n2))
1036 zz=half*(x(3,n1)+x(3,n2))
1043 gamav2=gamav(nmv)/vol(nmv)
1046 1 yy ,zz ,x13 ,y13 ,z13 ,
1047 2 x24 ,y24 ,z24 ,nor(1,j),vol(nmv),
1048 3 gamav2 ,dvd1 ,dvd2 ,k_diag)
1052 m1 = igrsurf(is)%NODES(j1,1)
1053 m2 = igrsurf(is)%NODES(j1,2)
1054 m3 = igrsurf(is)%NODES(j1,3)
1055 m4 = igrsurf(is)%NODES(j1,4)
1056 IF (m1==n1.OR.m1==n2.OR.m1==n3.OR.m1==n4
1057 1 .OR.m2==n1.OR.m2==n2.OR.m2==n3.OR.m2==n4
1058 2 .OR.m3==n1.OR.m3==n2.OR.m3==n3.OR.m3==n4
1059 3 .OR.m4==n1.OR.m4==n2.OR.m4==n3.OR.m4==n4)
THEN
1061 1 m2 ,m3 ,m4 ,nor(1,j),nor(1,j1),
1062 2 vol(nmv),gamav2 ,dvd1 ,dvd2 ,k_diag )
1079 1 YY ,ZZ ,X13 ,Y13 ,Z13 ,
1080 2 X24 ,Y24 ,Z24 ,N ,VOL ,
1081 3 GAMAV2 ,DVD1 ,DVD2 ,K_DIAG )
1085#include "implicit_f.inc"
1092 . xx,yy,zz,x12,y12,z12,x13,y13,z13,x24,y24,z24,vol,
1093 . dvd1(*),dvd2(*),n(3),gamav2,k_diag(3,*)
1097 INTEGER I, J,NNOD,ND,ID
1099 . dndx1(3),dndy1(3),dndz1(3),dndx2(3),dndy2(3),dndz2(3),
1100 . kev1(3),kev2(3),kevs(3),fac,facv(3)
1128 dvd1(1) = dndx1(1)*xx+dndx1(2)*yy+dndx1(3)*zz
1129 dvd1(2) = dndy1(1)*xx+dndy1(2)*yy+dndy1(3)*zz
1130 dvd1(3) = dndz1(1)*xx+dndz1(2)*yy+dndz1(3)*zz
1131 dvd2(1) = dndx2(1)*xx+dndx2(2)*yy+dndx2(3)*zz
1132 dvd2(2) = dndy2(1)*xx+dndy2(2)*yy+dndy2(3)*zz
1133 dvd2(3) = dndz2(1)*xx+dndz2(2)*yy+dndz2(3)*zz
1142 kev1(i) = facv(i)*dvd1(i)
1144 kev2(i) = facv(i)*dvd2(i)
1146 kevs(i) = facv(i)*n(i)
1150 k_diag(i,n1) = k_diag(i,n1)-kev1(i)-kevs(i)
1154 k_diag(i,n3) = k_diag(i,n3)+kev1(i)
1158 k_diag(i,n2) = k_diag(i,n2)-kev2(i)-kevs(i)
1163 k_diag(i,n4) = k_diag(i,n4)+kev2(i)
1175 1 M2 ,M3 ,M4 ,N ,NJ ,
1176 2 VOL ,GAMAV2 ,DVD1 ,DVD2 ,K_DIAG )
1180#include "implicit_f.inc"
1184 INTEGER N1,N2,N3,N4,M1,M2,M3,M4
1187 . vol,dvd1(*),dvd2(*),n(3),nj(3),gamav2,k_diag(3,*)
1191 INTEGER I, J,NNOD,NNOD1,ND,NM(4)
1193 . kev1(3),kev2(3),kevs(3),fac,facv(3)
1215 kev1(i) = facv(i)*dvd1(i)
1216 kev2(i) = facv(i)*dvd2(i)
1217 kevs(i) = facv(i)*n(i)
1223 k_diag(j,n1) = k_diag(j,n1)-kev1(j)-kevs(j)
1225 ELSEIF (n2==nm(i))
THEN
1229 ELSEIF (n3==nm(i))
THEN
1231 k_diag(j,n3) = k_diag(j,n3)+kev1(j)
1233 ELSEIF (nnod==4.AND.n4==nm(i))
THEN
1235 k_diag(j,n4) = k_diag(j,n4)+kev2(j)
1262 SUBROUTINE updk_mv(NDOF ,IPARI ,INTBUF_TAB,NI2_MV ,
1263 . II2_MV ,NRB_MV ,IRB_MV ,NFX_MV,IFX_MV ,
1264 . NBC_MV ,IBC_MV ,NRW_MV ,IRW_MV,IBFV ,
1265 . SKEW ,XFRAME ,X ,A ,AR ,
1266 . NRBE3_MV,IRBE3_MV,IRBE3 ,LRBE3 ,FCDI_MV,
1267 . MCDI_MV ,DIAG_M3 ,MAXR3 ,NSPC_MV,ISPC_MV,
1268 . NRBE2_MV,IRBE2_MV,IRBE2 ,LRBE2 )
1278#include "implicit_f.inc"
1282#include "param_c.inc"
1286 INTEGER NRB_MV , NI2_MV ,NDOF(*),II2_MV(2,*),IRB_MV(2,*),
1287 . IPARI(NPARI,*),NFX_MV,IFX_MV(2,*),
1288 . NBC_MV,IBC_MV(3,*),IBFV(NIFV,*),NRW_MV,IRW_MV(*),
1289 . NRBE3_MV,IRBE3_MV(*),IRBE3(NRBE3L,*),LRBE3(*),MAXR3,
1290 . NSPC_MV,ISPC_MV(*),NRBE2_MV,IRBE2_MV(2,*),
1291 . IRBE2(NRBE2L,*),LRBE2(*)
1293 . (3,*),AR(3,*),X(3,*),SKEW(LSKEW,*),XFRAME(NXFRAME,*),
1294 . FCDI_MV(*),MCDI_MV(*),DIAG_M3(6,MAXR3,*)
1296 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1300 INTEGER I,ID,N,J,NDD,IS,NS,,J10,J11,J12,J21
1301 INTEGER M,NSN,JI,,NNOD,NJ,NL,NI,
1302 . I1,J1,ISK,IFM,K1,K2,K3,ICT,NN,IROT,IAD,IADS,
1303 . JT(3),JR(3),IR,IRAD,K,IC
1305 . XS,YS,ZS,XS2,YS2,ZS2,KSS(6),KJJ(6,4),KII(3,3),EJ(3),S,
1316 l=intbuf_tab(n)%IRTLM(ni)
1318 ns=intbuf_tab(n)%NSV(ni)
1334 CALL i2_frup1(x ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA,
1335 . intbuf_tab(n)%NSV ,
1336 1 intbuf_tab(n)%IRTLM ,ns ,kss,kjj )
1338 CALL i2_frup0(x ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS ,
1340 1 intbuf_tab(n)%IRTLM,ns,ndof,kss ,kjj )
1343 nj=intbuf_tab(n)%IRECTM(nl+m)
1345 a(j,nj) = a(j,nj) + kjj(j,m)
1347 IF (ndof(nj)>3)
THEN
1349 ar(j,nj) = ar(j,nj) + kjj(j+3,m)
1374 IF (ndof(ns)>3)
THEN
1376 kdd(j+3,j+3) = ar(j,ns)
1380 2 jr ,ndof ,skew(1,isk),kdd ,kmm ,
1384 a(j,m) = a(j,m) + kmm(j)
1385 a(j,ns) = a(j,ns) + kss(j)
1389 ar(j,m) = ar(j,m) + kmm(j+3)
1392 IF (ndof(ns)>3)
THEN
1394 ar(j,ns) = ar(j,ns) + kss(j+3)
1412 CALL rbe3_frupd(nnod ,lrbe3(iad+1) ,fcdi_mv(iads),
1413 1 mcdi_mv(iads),ndof ,jt ,irot ,
1414 2 kss ,diag_m3(1,1,i))
1419 a(j,nj) = a(j,nj) + diag_m3(j,m,i)
1421 IF (irot>0.AND.ndof(nj)>3)
THEN
1423 ar(j,nj) = ar(j,nj) + diag_m3(j+3,m,i)
1436 a(j,m) = a(j,m)+a(j,n)
1441 ar(1,m) = ar(1,m)+a(2,n)*zs2+a(3,n)*ys2
1442 ar(2,m) = ar(2,m)+a(1,n)*zs2+a(3,n)*xs2
1443 ar(3,m) = ar(3,m)+a(1,n)*ys2+a(2,n)*xs2
1458 CALL bcl_impkd(ict ,isk ,skew ,kii ,a(1,n) )
1482 ej(2)=skew_spc(iad+1)
1483 ej(3)=skew_spc(iad+2)
1487 CALL fv_updkd2(skew_spc(iad),skew_spc(iad+3),kii ,a(1,i))
1501 ej(2)=skew_spc(iad+1)
1502 ej(3)=skew_spc(iad+2)
1506 CALL fv_updkd2(skew_spc(iad),skew_spc(iad+3),kii ,ar(1,i))
1518 IF (ifm<=1) j=j-10*isk
1527 ej(1)=xframe(k1,ifm)
1528 ej(2)=xframe(k2,ifm)
1529 ej(3)=xframe(k3,ifm)
1568!||
monv_diag ../engine/source/airbag/monv_imp0.f
1576 SUBROUTINE monv_diag(DIAG_K,NDOF,IPARI,INTBUF_TAB,IRBE3,LRBE3,
1586#include "implicit_f.inc"
1590#include "param_c.inc"
1594 INTEGER IPARI(NPARI,*), NDOF(*),IFLAG,
1595 . irbe3(nrbe3l,*),lrbe3(*),irbe2(nrbe2l,*)
1600 TYPE(intbuf_struct_) INTBUF_TAB(*)
1604 INTEGER I,J,NKC,N,ND,ID,IAD
1605 INTEGER M,NSN,JI,K10,K11,K12,K13,K14,L,NNOD,NJ,NL,NI
1610 DO j = 1,
min(3,ndof(n))
1612 IF (id>0) diag_k(id)=diag_k(id)+diag_mv(j,i)
1620 IF (id>0) diag_k(id)=diag_k(id)+diag_mvm(j,i)
1630 k11=k10+4*ipari(3,n)
1632 k12=k11+4*ipari(4,n)
1637 l=intbuf_tab(n)%IRTLM(ni)
1639 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4))
THEN
1646 nj=intbuf_tab(n)%IRECTM(nl+m)
1649 IF (id>0) diag_k(id)=diag_k(id)+diag_mvm2(j,m,i)
1663 IF (id>0) diag_k(id)=diag_k(id)+diag_mvm3(j,m,i)
1673 IF (id>0) diag_k(id)=diag_k(id)+diag_mvm4(j,i)
1680 DO j = 1,
min(3,ndof(n))
1682 IF (id>0) diag_k(id)=diag_k(id)-diag_mv(j,i)
1690 IF (id>0) diag_k(id)=diag_k(id)-diag_mvm(j,i)
1700 k11=k10+4*ipari(3,n)
1702 k12=k11+4*ipari(4,n)
1707 l=intbuf_tab(n)%IRTLM(ni)
1709IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+
THEN
1716 nj=intbuf_tab(n)%IRECTM(nl+m)
1719 IF (id>0) diag_k(id)=diag_k(id)-diag_mvm2(j,m,i)
1733 IF (id>0) diag_k(id)=diag_k(id)-diag_mvm3(j,m,i)
1743 IF (id>0) diag_k(id)=diag_k(id)-diag_mvm4(j,i)
1769 1 FR_MV ,NMONV ,IMONV ,U ,F ,
1770 2 NDOF ,IPARI ,INTBUF_TAB,A ,
1771 3 AR ,X_IMP ,IBFV ,SKEW ,XFRAME ,
1772 4 IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
1782#include "implicit_f.inc"
1786#include "com01_c.inc"
1787#include "com04_c.inc"
1788#include "param_c.inc"
1792 INTEGER ,IMONV(*),MONVOL(*),
1793 . IPARI(*) ,NDOF(*),FR_MV(NSPMD+2,*),
1794 . IBFV(*),IRBE3(*) ,LRBE3(*),IRBE2(*) ,LRBE2(*)
1796 . X(3,*),A(3,*),AR(3,*), VOLMON(*) ,F(*), U(*),
1797 . X_IMP(3,*),SKEW(*) ,XFRAME(*)
1799 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1800 TYPE (SURF_) ,
DIMENSION(NSURF) :: IGRSURF
1804 INTEGER I, J,N,K,K1,KK1,N1,N2,N3,N4,ID,,IS,NN,NTY
1806 . TEMP,VOL ,NOR(3,NNMAX_MV),
1807 . XX,YY,ZZ,X12,Y12,Z12,X13,Y13,Z13,X24,Y24,Z24,
1810 CALL imp3_u2x(x ,ipari ,intbuf_tab,ndof
1815 . skew ,xframe ,irbe3 ,lrbe3 ,
nrbe3_mv,
1819 CALL zeror(a,numnod)
1821 .
CALL zeror(ar,numnod)
1828 nn = igrsurf(is)%NSEG
1831 n1 = igrsurf(is)%NODES(j,1)
1832 n2 = igrsurf(is)%NODES(j,2)
1833 n3 = igrsurf(is)%NODES(j,3)
1834 n4 = igrsurf(is)%NODES(j,4)
1835 xx=half*(x_imp(1,n1)+x_imp(1,n2))
1836 yy=half*(x_imp(2,n1)+x_imp(2,n2))
1837 zz=half*(x_imp(3,n1)+x_imp(3,n2))
1838 x13=x_imp(1,n3)-x_imp(1,n1)
1839 y13=x_imp(2,n3)-x_imp(2,n1)
1840 z13=x_imp(3,n3)-x_imp(3,n1)
1841 x24=x_imp(1,n4)-x_imp(1,n2)
1842 y24=x_imp(2,n4)-x_imp(2,n2)
1843 z24=x_imp(3,n4)-x_imp(3,n2)
1844 nor(1,j)=half*(y13*z24-y24*z13)
1845 nor(2,j)=half*(z13*x24-z24*x13)
1846 nor(3,j)=half*(x13*y24-x24*y13)
1847 vol= vol+third*(nor(1,j)*xx+nor(2,j)*yy+nor(3,j)*zz)
1854 CALL imp_pvga(monvol(k1),volmon(kk1),vol ,dpres)
1856 IF (dpres/=zero)
THEN
1858 n1 = igrsurf(is)%NODES(j,1)
1859 n2 = igrsurf(is)%NODES(j,2)
1860 n3 = igrsurf(is)%NODES(j,3)
1861 n4 = igrsurf(is)%NODES(j,4)
1862 nty = igrsurf(is)%ELTYP(j)
1869 a(k,n1) = a(k,n1)+fni(k)
1870 a(k,n2) = a(k,n2)+fni(k)
1871 a(k,n3) = a(k,n3)+fni(k)
1879 a(k,n1) = a(k,n1)+fni(k)
1880 a(k,n2) = a(k,n2)+fni(k)
1881 a(k,n3) = a(k,n3)+fni(k)
1882 a(k,n4) = a(k,n4)+fni(k)
1891 CALL imp3_a2b(ipari ,intbuf_tab,ndof ,x_imp ,
1926 . LX ,A ,AR ,X_IMP ,NUMN ,
1927 . INL ,IDDL ,NRB ,IRB ,IDDLM ,
1928 . NI2 ,II2 ,IDDLM2 ,NFX ,IFX ,
1929 . NBC ,IBC ,NRW ,IRW ,IBFV ,
1930 . SKEW ,XFRAME ,IRBE3 ,LRBE3 ,NR3 ,
1931 . IR3 ,IDDLM3 ,R3_MAX ,FCDI ,MCDI ,
1932 . NSPC ,ISPC ,IRBE2 ,LRBE2 ,NR2 ,
1943#include "implicit_f.inc"
1947#include "com04_c.inc"
1948#include "param_c.inc"
1953 INTEGER NUMN,INL(*),NRB,IRB(2,*) ,NI2,II2(2,*),
1954 . IDDL(3,*),IDDLM(6,*),IDDLM2(6,4,*),
1955 . IPARI(NPARI,*), NDOF(*),NFX ,IFX(2,*),
1956 . NBC ,IBC(3,*),NRW ,IRW(*),IBFV(NIFV,*),
1957 . NR3,IR3(*),IDDLM3(6,R3_MAX,*),IRBE3(NRBE3L,*),LRBE3(*),
1958 . NR2,IR2(2,*),IDDLM4(6,*),IRBE2(NRBE2L,*),LRBE2(*),
1961 . X(3,*) ,LX(*),A(3,*),AR(3,*),X_IMP(3,*),
1962 . SKEW(LSKEW,*) ,XFRAME(*),FCDI(*) ,MCDI(*)
1964 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1968 INTEGER I,J,N,M,NS,NI,NSN,ILEV,JT(3),JR(3),IADS,IAD,
1969 . NN,L,NNOD,NJ,ND,NL,ISK,IFM,LJFR(NFXVEL),IROT,IRAD,IC
1990 CALL bcl_impd(ifm ,isk ,skew ,i ,a )
2001 CALL fv_impd(ibfv ,ljfr ,skew ,xframe,a ,
2016 ej(2)=skew_spc(iad+1)
2017 ej(3)=skew_spc(iad+2)
2025 CALL bc_upd2d(i ,skew_spc(iad),skew_spc(iad+3),a )
2032 CALL bc_upd2d(i ,skew_spc(iad),skew_spc(iad+3),ar )
2062 DO j = 1 ,
min(3,ndof(m))
2064 IF (nd>0) a(j,m)=lx(nd)
2068 IF (nd>0) ar(j-3,m)=lx(nd)
2074 a(1,ns)=a(1,m)+ar(2,m)*zs-ar(3,m)*ys
2075 a(2,ns)=a(2,m)-ar(1,m)*zs+ar(3,m)*xs
2076 a(3,ns)=a(3,m)+ar(1,m)*ys-ar(2,m)*xs
2088 IF (j<=3.AND.nd>0)
THEN
2107 IF (j<=3.AND.nd>0)
THEN
2115 CALL rbe3_frd(nnod ,lrbe3(iad+1),ns ,a ,ar ,
2143 DO j = 1 ,
min(3,ndof(m))
2145 IF (nd>0) a(j,m)=lx(nd)
2149 IF (nd>0) ar(j-3,m)=lx(nd)
2153 1 jt ,jr ,skew(1,isk),isk ,irad )
2160 l=intbuf_tab(n)%IRTLM(ni)
2162 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4))
THEN
2169 nj=intbuf_tab(n)%IRECTM(nl+m)
2187 l=intbuf_tab(n)%IRTLM(ni)
2189 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4))
THEN
2196 nj=intbuf_tab(n)%IRECTM(nl+m)
2199 IF (j<=3.AND.nd>0)
THEN
2209 CALL i2_frrd1(x ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA ,
2210 . intbuf_tab(n)%NSV ,
2211 1 intbuf_tab(n)%IRTLM ,a ,ni )
2213 CALL i2_frrd0(x ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS ,
2214 . intbuf_tab(n)%NSV ,
2215 1 intbuf_tab(n)%IRTLM,a ,ar ,ni ,ndof )
2223 x_imp(j,n) = a(j,n) + x(j,n)
2231!||--- called by ------------------------------------------------------
2238#include "implicit_f.inc"
2242#include "com08_c.inc"
2256 . vol,vinc,gama,pres,pmax,veps,pold,vold,pext,
2257 . dv,energy,energ_old,deout,fac
2278 fac = half*(gama-one)*dv
2279 energy= ((one-fac/(vold-vinc))*energ_old-deout*dt1 ) /
2280 . (one+fac/(vol-vinc))
2281 energy =
max(energy,zero)
2283 pres=(gama-one)*energy/(vol-vinc)
2298!||
imp3_a2b ../engine/source/airbag/monv_imp0.f
2314!||
rbe2frf ../engine/source/constraints/general/rbe2/
rbe2f.f
2323 . A ,AR ,NUMN ,INL ,IDDL ,
2324 . NRB ,IRB ,IDDLM ,NI2 ,II2 ,
2325 . IDDLM2 ,NFX ,IFX ,NBC ,IBC ,
2326 . NRW ,IRW ,IBFV ,SKEW ,XFRAME ,
2327 . LB ,IRBE3 ,LRBE3 ,NR3 ,IR3 ,
2328 . IDDLM3 ,R3_MAX ,FCDI ,MCDI ,NSPC ,
2329 . ISPC ,IRBE2 ,LRBE2 ,NR2 ,IR2 ,
2340#include "implicit_f.inc"
2344#include "param_c.inc"
2348 INTEGER NUMN,INL(*),NRB,IRB(2,*) ,NI2,II2(2,*),
2349 . IDDL(3,*),IDDLM(6,*),IDDLM2(6,4,*),IBFV(*),
2350 . ipari(npari,*), ndof(*),nfx,ifx(2,*),
2351 . nbc,ibc(3,*),nrw,irw(*),r3_max,nspc,ispc(*)
2352 INTEGER NR3,IR3(*),IDDLM3(6,R3_MAX,*),IRBE3(NRBE3L,*),LRBE3(*),
2353 . NR2,IR2(2,*),IDDLM4(6,*),IRBE2(NRBE2L,*),LRBE2(*)
2355 . A(3,*),AR(3,*),X_IMP(3,*),LB(*),SKEW(LSKEW,*),XFRAME(*),
2358 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2362 INTEGER I,J,K,ID,ND,M,N,NS,NI,NSN,,JT(3),JR(3),
2363 . JI,K10,K11,K12,K13,K14,J10,J11,J12,J21,
2364 . L,NNOD,NJ,NL,IAD,IADS,IROT,ISK,IRAD,NN,IC
2370 DO j=1,
min(3,ndof(n))
2372 IF (nd>0) lb(nd)=lb(nd)+a(j,n)
2382 k11=k10+4*ipari(3,n)
2384 k12=k11+4*ipari(4,n)
2389 l=intbuf_tab(n)%IRTLM(ni)
2398 CALL i2_frfm1(x_imp ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%DPARA ,
2399 . intbuf_tab(n)%NSV ,
2400 1 intbuf_tab(n)%IRTLM ,a ,ni )
2402 CALL i2_frfm0(x_imp ,intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS ,
2403 . intbuf_tab(n)%NSV ,
2404 1 intbuf_tab(n)%IRTLM ,a ,ar ,ni ,ndof )
2406 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4))
THEN
2413 nj=intbuf_tab(n)%IRECTM(nl+m)
2416 IF (j<=3.AND.nd>0)
THEN
2420 lb(nd) = lb(nd)+ar(j-3,nj)
2436 CALL rbe2frf(ns ,m ,a ,ar ,jt ,
2437 1 jr ,x_imp ,isk ,skew(1,isk),irad )
2440 IF (j<=3.AND.nd>0)
THEN
2441 lb(nd)=lb(nd)+a(j,m)
2444 lb(nd)=lb(nd)+ar(j-3,m)
2458 CALL rbe3frf(nnod ,lrbe3(iad+1),ns ,a ,ar ,
2465 IF (j<=3.AND.nd>0)
THEN
2466 lb(nd) = lb(nd)+a(j,nj)
2468 ELSEIF(nd>0.AND.irot>0)
THEN
2469 lb(nd) = lb(nd)+ar(j-3,nj)
2479 CALL rby_impf(x_imp ,m ,ns ,ndof ,a ,
2483 IF (j<=3.AND.nd>0)
THEN
2484 lb(nd)=lb(nd)+a(j,m)
2487 lb(nd)=lb(nd)+ar(j-3,m)
2493 CALL bc_updf(nbc ,ibc ,skew ,a )
2498 IF (ndof(i)==0) cycle
2508 ej(2)=skew_spc(iad+1)
2509 ej(3)=skew_spc(iad+2)
2514 CALL bc_fi(i ,ej ,j ,a )
2516 CALL bc_fi2(i ,skew_spc(iad),skew_spc(iad+3),a )
2520 CALL bc_fi(i ,ej ,j ,ar )
2522 CALL bc_fi2(i ,skew_spc(iad),skew_spc(iad+3),ar )
2528 CALL fv_updf(nfx ,ifx ,ibfv ,skew ,xframe,
2558#include "implicit_f.inc"
subroutine bc_fi(n, ej, j1, a)
subroutine fv_updkd2(skew, skew1, kdd, diag_k)
subroutine bcl_impd(ict, isk, skew, i, d)
subroutine bc_updd(n, ej, j, d)
subroutine bc_updf(nbc, ibc, skew, a)
subroutine bc_upd2d(n, skew, skew1, d)
subroutine bc_fi2(n, skew, skew1, a)
subroutine bcl_impkd(ict, isk, skew, kdd, diag_k)
subroutine fv_imp0(iddl, ifix, ndof, iadk, jdik, diag_k, lt_k, ud, nbk, iab, bk, nddl, rd)
subroutine fv_updf(nfx, ifx, ibfv, skew, xframe, a)
subroutine fv_updkd(ej, j, kdd, diag_k)
subroutine fv_impd(ibfv, lj, skew, xframe, ud, rd)
subroutine kin_updf(n, ej, j1, a)
subroutine prerbe3fr(irbe3, n, jt, jr)
subroutine i2_frfm0(x, irect, crst, nsv, irtl, a, ar, ii, ndof)
subroutine i2_frfm1(x, irect, dpara, nsv, irtl, a, ii)
subroutine i2_frup1(x, irect, dpara, nsv, irtl, ii, kii, kjj)
subroutine i2_frup0(x, irect, crst, nsv, irtl, ii, ndof, kss, k)
subroutine i2_imp1(ipari, intbuf_tab, itab, nsc2, isij2, nss2, iss2, x, ms, in, weight, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, b)
subroutine i2_frrd0(x, irect, crst, nsv, irtl, d, dr, ii, ndof)
subroutine i2_frrd1(x, irect, dpara, nsv, irtl, d, ii)
subroutine rbe3cl(inrbe3, ilrbe3, ns, xyz, frbe3, skew, ng, irot, fdstnb, mdstnb)
subroutine mv_matv(monvol, volmon, x, igrsurf, fr_mv, nmonv, imonv, u, f, ndof, ipari, intbuf_tab, a, ar, x_imp, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2)
subroutine recu_kdis(ndof, d)
subroutine monv_diag(diag_k, ndof, ipari, intbuf_tab, irbe3, lrbe3, irbe2, iflag)
subroutine monv_kedj(n1, n2, n3, n4, m1, m2, m3, m4, n, nj, vol, gamav2, dvd1, dvd2, k_diag)
subroutine dim_kinmv(npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, lns, lns2, irbe3, lns3, irbe2, lrbe2, lns4)
subroutine monv_prem(nmonv, imonv, monvol, igrsurf, fr_mv, itag, npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndof, iprec0, irbe3, irbe2, lrbe2)
subroutine monv_m3(monvol, volmon, x, igrsurf, nmonv, imonv, ipari, intbuf_tab, a_mv, ar_mv, ndof, iddl, ikc, inloc, iprec, ibfv, skew, xframe, irbe3, lrbe3, frbe3, irbe2, lrbe2)
subroutine imp3_a2b(ipari, intbuf_tab, ndof, x_imp, a, ar, numn, inl, iddl, nrb, irb, iddlm, ni2, ii2, iddlm2, nfx, ifx, nbc, ibc, nrw, irw, ibfv, skew, xframe, lb, irbe3, lrbe3, nr3, ir3, iddlm3, r3_max, fcdi, mcdi, nspc, ispc, irbe2, lrbe2, nr2, ir2, iddlm4)
subroutine ini_kinmv(npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, nrb_mv, irb_mv, ni2_mv, ii2_mv, irbe3, nrbe3_mv, irbe3_mv, irbe2, lrbe2, nrbe2_mv, irbe2_mv)
subroutine imp_pvga(ivolu, rvolu, vol, dpres)
subroutine imp3_u2x(x, ipari, intbuf_tab, ndof, lx, a, ar, x_imp, numn, inl, iddl, nrb, irb, iddlm, ni2, ii2, iddlm2, nfx, ifx, nbc, ibc, nrw, irw, ibfv, skew, xframe, irbe3, lrbe3, nr3, ir3, iddlm3, r3_max, fcdi, mcdi, nspc, ispc, irbe2, lrbe2, nr2, ir2, iddlm4)
subroutine id_mvini(ipari, intbuf_tab, ndof, iddl, ikc, inloc, x, skew, irbe3, lrbe3, frbe3, irbe2, lrbe2)
subroutine monv_kd(monvol, volmon, x, igrsurf, nmonv, imonv, k_diag, nnmax_mv)
subroutine monv_fvl(ibfv, lj, iskew, icodt)
subroutine monv_kedi(n1, n2, n3, n4, xx, yy, zz, x13, y13, z13, x24, y24, z24, n, vol, gamav2, dvd1, dvd2, k_diag)
subroutine updk_mv(ndof, ipari, intbuf_tab, ni2_mv, ii2_mv, nrb_mv, irb_mv, nfx_mv, ifx_mv, nbc_mv, ibc_mv, nrw_mv, irw_mv, ibfv, skew, xframe, x, a, ar, nrbe3_mv, irbe3_mv, irbe3, lrbe3, fcdi_mv, mcdi_mv, diag_m3, maxr3, nspc_mv, ispc_mv, nrbe2_mv, irbe2_mv, irbe2, lrbe2)
subroutine monv_imp(monvol, volmon, x, igrsurf, nmonv, imonv, ipari, intbuf_tab, a_mv, ar_mv, ndof, iddl, ikc, inloc, iprec, ibfv, skew, xframe, lj, iskew, icodt, irbe3, lrbe3, frbe3, irbe2, lrbe2, nsurf)
integer, dimension(:), allocatable in_spc
integer, dimension(:), allocatable ic_spc
integer, dimension(:), allocatable irw_mv
integer, dimension(:), allocatable irbe3_mv
integer, dimension(:,:), allocatable id_mvm4
integer, dimension(:,:), allocatable irbe2_mv
integer, dimension(:,:), allocatable ii2_mv
integer, dimension(:), allocatable in_mv
integer, dimension(:,:), allocatable ifx_mv
integer, dimension(:,:,:), allocatable id_mvm2
integer, dimension(:,:,:), allocatable id_mvm3
integer, dimension(:), allocatable ispc_mv
integer, dimension(:,:), allocatable id_mv
integer, dimension(:,:), allocatable irb_mv
integer, dimension(:,:), allocatable ibc_mv
integer, dimension(:,:), allocatable id_mvm
integer, dimension(:), allocatable in_rwl
subroutine rbe2_impkd(m, ns, x, isk, jt, jr, ndof, skew0, kdd, diag_km, diag_kn, irad)
subroutine prerbe2fr(ic, jt, jr)
subroutine rbe2frf(ns, m, a, ar, jt, jr, x, isk, skew0, irad)
subroutine rbe2f(nsl, isl, x, a, ar, ms, in, weight, jt, jr, f6, m6, stifn, stifr, stif6, stir6, m, irad)
subroutine rbe2_frd(ns, m, x, v, vr, jt, jr, skew0, isk, irad)
subroutine rbe3_frupd(nir, iml, fdstnb, mdstnb, ndof, jt, irot, kss, diag_m3)
subroutine rbe3frf(nml, iml, ns, a, ar, fdstnb, mdstnb, jt, jr, irot)
subroutine rbe3_frd(nml, iml, ns, d, dr, fdstnb, mdstnb, jt, jr, irot)
subroutine rby_impf(x, m, n, ndof, a, ar)
subroutine spmd_fr_poff(fr_wall, fs, len)
character *2 function nl()