23!||====================================================================
27!||--- calls -----------------------------------------------------
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),ITAG(*),NDOF(*),IPREC0
64 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
65 . NINT2,IINT2(*),IPARI(NPARI,*),IRBE3(NRBE3L,*),
66 . irbe2(nrbe2l,*),lrbe2(*)
69 TYPE(intbuf_struct_) INTBUF_TAB(*)
70 TYPE (SURF_) ,
DIMENSION(NSURF) :: IGRSURF
74 INTEGER I, 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
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(*) ,(*)
459 INTEGER I,J,K,N,L,IERR1,,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(*),ISKEW(*),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 )
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,IMONV(*),MONVOL(*),
635 . IPARI(NPARI,*), NDOF(*),IDDL(*),IKC(*),
636 . INLOC(*),IPREC,IBFV(*),IRBE3(NRBE3L,*),LRBE3(*),
637 . IRBE2(NRBE2L,*),LRBE2(*)
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,K12,K13,K14,L,NNOD,NJ,NL,NI
651 CALL ID_MVINI(IPARI ,INTBUF_TAB,NDOF ,IDDL ,IKC ,
652 1 INLOC ,X ,SKEW ,IRBE3 ,LRBE3 ,
653 2 FRBE3 ,IRBE2 ,LRBE2 )
655 CALL 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)
777!||====================================================================
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,*), NDOF(*),IDDL(*),IKC(*),
800 . INLOC(*),IRBE3(NRBE3L,*),LRBE3(*),
801 . irbe2(nrbe2l,*),lrbe2(*)
804 . x(3,*),skew(*) ,frbe3(*)
806 TYPE(intbuf_struct_) INTBUF_TAB(*)
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) )
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)
1170!||
monv_kedj ../engine/source/airbag/monv_imp0.f
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)
1212 facv(j) = gamav2*nj(j)
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
1227 k_diag(j,n2) = k_diag(j,n2)-kev2(j)-kevs(j)
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 . ,IRBE3_MV(*),IRBE3(NRBE3L,*),LRBE3(*),MAXR3,
1290 . NSPC_MV,ISPC_MV(*),NRBE2_MV,IRBE2_MV(2,*),
1291 . IRBE2(NRBE2L,*),LRBE2(*)
1293 . A(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,ILEV,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 ,
1339 . intbuf_tab(n)%NSV ,
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)
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)
1709 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4))
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 NMONV,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,,K,K1,KK1,N1,N2,N3,N4,ID,IAD,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 ,
1914!||
i2_frrd1 ../engine/source/interfaces/interf/i2_imp2.f
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 ,
2116 1 fcdi(iads),mcdi(iads) ,jt ,jr ,
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)
2233!||====================================================================
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)
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,,NS,NI,NSN,ILEV,JT(3),JR(3),
2363 . JI,K10,K11,K12,K13,K14,J10,J11,J12,J21,
2364 . L,NNOD,NJ,NL,IAD,IADS,,ISK,IRAD,NN,
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
2416 IF (j<=3.AND.nd>0)
THEN
2417 lb(nd) = lb(nd)+a(j,nj)
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 ,
2459 1 fcdi(iads),mcdi(iads),jt ,jr ,irot )
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,
2545!||--- called by ------------------------------------------------------
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_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_frrd0(x, irect, crst, nsv, irtl, d, dr, ii, ndof)
subroutine i2_frrd1(x, irect, dpara, nsv, irtl, d, ii)
subroutine int_matvp(ipari, intbuf_tab, ndof, num_imp, ns_imp, ne_imp, index2, a, ar, v, x, ms, x_imp, ibfv, skew, xframe, u, f, dr, nsrem, nsl, iupd, irbe3, lrbe3, irbe2, lrbe2)
subroutine imp_int_k(a, v, icodt, icodr, iskew, ibfv, npc, tf, vel, nsensor, sensor_tab, xframe, rby, x, skew, lpby, npby, itab, weight, ms, in, nrbyac, irbyac, nss, iss, ipari, intbuf_tab, nint2, iint2, iaint2, nss2, iss2, nddli, nnzi, iadi, jdii, diag_i, lt_i, iddli, nddl, iadk, jdik, ikc, diag_k, lt_k, iddl, num_imp, ns_imp, ne_imp, index2, ndofi, itok, ud, lb, gapmin, dirul, nt_rw, num_imp1, irbe3, lrbe3, frbe3, nss3, iss3, irbe2, lrbe2, nsb2, isb2)
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 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()