OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
monv_imp0.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "units_c.inc"
#include "impl1_c.inc"
#include "tabsiz_c.inc"
#include "com08_c.inc"

Go to the source code of this file.

Functions/Subroutines

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 dim_kinmv (npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, lns, lns2, irbe3, lns3, irbe2, lrbe2, lns4)
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 monv_fvl (ibfv, lj, iskew, icodt)
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)
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 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_kedi (n1, n2, n3, n4, xx, yy, zz, x13, y13, z13, x24, y24, z24, n, vol, gamav2, dvd1, dvd2, k_diag)
subroutine monv_kedj (n1, n2, n3, n4, m1, m2, m3, m4, n, nj, 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_diag (diag_k, ndof, ipari, intbuf_tab, irbe3, lrbe3, irbe2, iflag)
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 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 imp_pvga (ivolu, rvolu, vol, dpres)
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 recu_kdis (ndof, d)

Function/Subroutine Documentation

◆ dim_kinmv()

subroutine dim_kinmv ( integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer nrbyac,
integer, dimension(*) irbyac,
integer nint2,
integer, dimension(*) iint2,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) inloc,
integer lns,
integer lns2,
integer, dimension(nrbe3l,*) irbe3,
integer lns3,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer lns4 )

Definition at line 197 of file monv_imp0.F.

202C-----------------------------------------------
203C M o d u l e s
204C-----------------------------------------------
205 USE intbufdef_mod
206C----6------------------------------------------
207C I m p l i c i t T y p e s
208C-----------------------------------------------
209#include "implicit_f.inc"
210C-----------------------------------------------
211C C o m m o n B l o c k s
212C-----------------------------------------------
213#include "com04_c.inc"
214#include "param_c.inc"
215C-----------------------------------------------
216C D u m m y A r g u m e n t s
217C-----------------------------------------------
218 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
219 . NINT2,IINT2(*),IPARI(NPARI,*)
220 integer
221 . inloc(*),lns ,lns2,irbe3(nrbe3l,*) ,lns3,
222 . irbe2(nrbe2l,*),lrbe2(*),lns4
223C REAL
224 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
225C-----------------------------------------------
226C L o c a l V a r i a b l e s
227C-----------------------------------------------
228 integer
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
231C----------------------------
232 lns2=0
233 DO j=1,nint2
234 n=iint2(j)
235 nsn = ipari(5,n)
236 ji=ipari(1,n)
237 k10=ji-1
238 k11=k10+4*ipari(3,n)
239C------IRECT(4,NSN)-----
240 k12=k11+4*ipari(4,n)
241C------NSV(NSN)--node number---
242 k13=k12+nsn
243C------MSR(NMN)-----
244 k14=k13+ipari(6,n)
245C------IRTL(NSN)--main el number---
246 kfi=k14+nsn
247 DO i=1,nsn
248 ni=intbuf_tab(n)%NSV(i)
249 IF (inloc(ni)>0) THEN
250 lns2=lns2+1
251 ENDIF
252 ENDDO
253 ENDDO
254C-----RBE2------
255 lns4=0
256 DO n=1,nrbe2
257 k =irbe2(1,n)
258 m =irbe2(3,n)
259 nsn =irbe2(5,n)
260 DO i=1,nsn
261 id = i+k
262 ni=lrbe2(id)
263 IF (inloc(ni)>0) THEN
264 lns4=lns4+1
265 IF (inloc(m)==0) inloc(m) = 2
266 ENDIF
267 ENDDO
268 ENDDO
269C--------RBE3--------------------
270 lns3=0
271 DO n=1,nrbe3
272 ni = irbe3(3,n)
273 IF (ni==0) cycle
274 IF (inloc(ni)>0) THEN
275 lns3=lns3+1
276 ENDIF
277 ENDDO
278C-----active rigid body main nodes------
279 lns=0
280 DO j=1,nrbyac
281 n=irbyac(j)
282 k=irbyac(j+nrbykin)
283 m =npby(1,n)
284 nsn =npby(2,n)
285 DO i=1,nsn
286 id = i+k
287 ni=lpby(id)
288 IF (inloc(ni)>0) THEN
289 lns=lns+1
290 IF (inloc(m)==0) inloc(m) = 1
291 ENDIF
292 ENDDO
293 ENDDO
294C----6---------------------------------------------------------------7---------8
295 RETURN
id
initmumps id
Definition multiplerhs_example.m:4
nl
character *2 function nl()
Definition message.F:2354

◆ id_mvini()

subroutine id_mvini ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
integer, dimension(*) inloc,
x,
skew,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
frbe3,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 778 of file monv_imp0.F.

781C-----------------------------------------------
782C M o d u l e s
783C-----------------------------------------------
784 USE imp_monv
785 USE intbufdef_mod
786C-----------------------------------------------
787C I m p l i c i t T y p e s
788C-----------------------------------------------
789#include "implicit_f.inc"
790C-----------------------------------------------
791C C o m m o n B l o c k s
792C-----------------------------------------------
793#include "com04_c.inc"
794#include "param_c.inc"
795#include "tabsiz_c.inc"
796C-----------------------------------------------
797C D u m m y A r g u m e n t s
798C-----------------------------------------------
799 INTEGER IPARI(NPARI,*), NDOF(*),IDDL(*),IKC(*),
800 . INLOC(*),IRBE3(NRBE3L,*),LRBE3(*),
801 . IRBE2(NRBE2L,*),LRBE2(*)
802C REAL
803 my_real
804 . x(3,*),skew(*) ,frbe3(*)
805
806 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
807C-----------------------------------------------
808C L o c a l V a r i a b l e s
809C-----------------------------------------------
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
812C-----initialise iddl_mv-----------
813 nkc = 0
814 DO n =1,numnod
815 i=inloc(n)
816 iddlm(i)=iddl(i)-nkc
817 DO j=1,ndof(i)
818 nd = iddl(i)+j
819 IF (ikc(nd)/=0) nkc = nkc + 1
820 ENDDO
821 ENDDO
822C
823 DO i = 1, numn_mv
824 n = in_mv(i)
825 IF (ndof(n)==0) THEN
826 DO j = 1 , 3
827 id_mv(j,i) = -7
828 ENDDO
829 ELSE
830 nd = 0
831 DO j = 1 , min(3,ndof(n))
832 id = iddl(n) + j
833 IF (ikc(id)<1) THEN
834 nd = nd + 1
835 id_mv(j,i) = iddlm(n) + nd
836 ELSE
837 id_mv(j,i) = -ikc(id)
838 ENDIF
839 ENDDO
840 ENDIF
841 ENDDO
842C
843 DO i = 1, nrb_mv
844 n = irb_mv(1,i)
845 nd = 0
846 DO j = 1 , ndof(n)
847 id = iddl(n) + j
848 IF (ikc(id)<1) THEN
849 nd = nd + 1
850 id_mvm(j,i) = iddlm(n) + nd
851 ELSE
852 id_mvm(j,i) = -ikc(id)
853 ENDIF
854 ENDDO
855 ENDDO
856C
857 DO i=1,ni2_mv
858 n=ii2_mv(1,i)
859 ni=ii2_mv(2,i)
860 ji=ipari(1,n)
861 nsn=ipari(5,n)
862 k10=ji-1
863 k11=k10+4*ipari(3,n)
864C------IRECT(4,NSN)-----
865 k12=k11+4*ipari(4,n)
866C------NSV(NSN)--node number---
867 k13=k12+nsn
868C------MSR(NMN)-----
869 k14=k13+ipari(6,n)
870 l=intbuf_tab(n)%IRTLM(ni)
871 nl=4*(l-1)
872 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
873 nnod=3
874 ELSE
875 nnod=4
876 ENDIF
877C-------si noeud main est dependant aussi-----
878 DO m=1,nnod
879 nj=intbuf_tab(n)%IRECTM(nl+m)
880 nd = 0
881 DO j = 1 , ndof(nj)
882 id = iddl(nj) + j
883 IF (ikc(id)<1) THEN
884 nd = nd + 1
885 id_mvm2(j,m,i) = iddlm(nj) + nd
886 ELSE
887 id_mvm2(j,m,i) = -ikc(id)
888 ENDIF
889 ENDDO
890 ENDDO
891 ENDDO
892C-------RBE3-----------
893 IF (nrbe3_mv>0) THEN
894 DO i=1,nrbe3_mv
895 n=irbe3_mv(i)
896 nnod=irbe3(5,n)
897 iad=irbe3(1,n)
898C-------
899 DO m=1,nnod
900 nj=lrbe3(iad+m)
901 nd = 0
902 DO j = 1 , ndof(nj)
903 id = iddl(nj) + j
904 IF (ikc(id)<1) THEN
905 nd = nd + 1
906 id_mvm3(j,m,i) = iddlm(nj) + nd
907 ELSE
908 id_mvm3(j,m,i) = -ikc(id)
909 ENDIF
910 ENDDO
911 ENDDO
912 ENDDO
913C------- init FCDI_MV,MCDI_MV
914 nmt = slrbe3/2
915 iads =1
916 DO i=1,nrbe3_mv
917 n=irbe3_mv(i)
918 ni=irbe3(3,n)
919 nnod=irbe3(5,n)
920 iad=irbe3(1,n)
921 irot=irbe3(6,n)
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) )
925C-------
926 iads = iads + nnod
927 ENDDO
928 ENDIF
929C---------RBE2------------
930 DO i = 1, nrbe2_mv
931 n = irbe2_mv(1,i)
932 m = irbe2(3,n)
933 nd = 0
934 DO j = 1 , ndof(m)
935 id = iddl(m) + j
936 IF (ikc(id)<1) THEN
937 nd = nd + 1
938 id_mvm4(j,i) = iddlm(m) + nd
939 ELSE
940 id_mvm4(j,i) = -ikc(id)
941 ENDIF
942 ENDDO
943 ENDDO
944C
945 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
rbe3cl
subroutine rbe3cl(inrbe3, ilrbe3, ns, xyz, frbe3, skew, ng, irot, fdstnb, mdstnb)
Definition kinchk.F:1586
min
#define min(a, b)
Definition macros.h:20
imp_monv
Definition impbufdef_mod.F:341
imp_monv::ni2_mv
integer ni2_mv
Definition impbufdef_mod.F:343
imp_monv::numn_mv
integer numn_mv
Definition impbufdef_mod.F:343
imp_monv::irbe3_mv
integer, dimension(:), allocatable irbe3_mv
Definition impbufdef_mod.F:352
imp_monv::id_mvm4
integer, dimension(:,:), allocatable id_mvm4
Definition impbufdef_mod.F:348
imp_monv::irbe2_mv
integer, dimension(:,:), allocatable irbe2_mv
Definition impbufdef_mod.F:351
imp_monv::ii2_mv
integer, dimension(:,:), allocatable ii2_mv
Definition impbufdef_mod.F:351
imp_monv::in_mv
integer, dimension(:), allocatable in_mv
Definition impbufdef_mod.F:346
imp_monv::nrb_mv
integer nrb_mv
Definition impbufdef_mod.F:343
imp_monv::id_mvm2
integer, dimension(:,:,:), allocatable id_mvm2
Definition impbufdef_mod.F:349
imp_monv::nrbe2_mv
integer nrbe2_mv
Definition impbufdef_mod.F:343
imp_monv::id_mvm3
integer, dimension(:,:,:), allocatable id_mvm3
Definition impbufdef_mod.F:349
imp_monv::id_mv
integer, dimension(:,:), allocatable id_mv
Definition impbufdef_mod.F:348
imp_monv::nrbe3_mv
integer nrbe3_mv
Definition impbufdef_mod.F:343
imp_monv::irb_mv
integer, dimension(:,:), allocatable irb_mv
Definition impbufdef_mod.F:351
imp_monv::id_mvm
integer, dimension(:,:), allocatable id_mvm
Definition impbufdef_mod.F:348

◆ imp3_a2b()

subroutine imp3_a2b ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) ndof,
x_imp,
a,
ar,
integer numn,
integer, dimension(*) inl,
integer, dimension(3,*) iddl,
integer nrb,
integer, dimension(2,*) irb,
integer, dimension(6,*) iddlm,
integer ni2,
integer, dimension(2,*) ii2,
integer, dimension(6,4,*) iddlm2,
integer nfx,
integer, dimension(2,*) ifx,
integer nbc,
integer, dimension(3,*) ibc,
integer nrw,
integer, dimension(*) irw,
integer, dimension(*) ibfv,
skew,
xframe,
lb,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
integer nr3,
integer, dimension(*) ir3,
integer, dimension(6,r3_max,*) iddlm3,
integer r3_max,
fcdi,
mcdi,
integer nspc,
integer, dimension(*) ispc,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer nr2,
integer, dimension(2,*) ir2,
integer, dimension(6,*) iddlm4 )

Definition at line 2322 of file monv_imp0.F.

2331C-----------------------------------------------
2332C M o d u l e s
2333C-----------------------------------------------
2334 USE imp_rwl
2335 USE imp_aspc
2336 USE intbufdef_mod
2337C-----------------------------------------------
2338C I m p l i c i t T y p e s
2339C-----------------------------------------------
2340#include "implicit_f.inc"
2341C-----------------------------------------------
2342C C o m m o n B l o c k s
2343C-----------------------------------------------
2344#include "param_c.inc"
2345C-----------------------------------------------
2346C D u m m y A r g u m e n t s
2347C-----------------------------------------------
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(*)
2354 my_real
2355 . a(3,*),ar(3,*),x_imp(3,*),lb(*),skew(lskew,*),xframe(*),
2356 . fcdi(*) ,mcdi(*)
2357
2358 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2359C----------------------------------------------
2360C L o c a l V a r i a b l e s
2361C-----------------------------------------------
2362 INTEGER I,J,K,ID,ND,M,N,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,IROT,ISK,IRAD,NN,IC
2365 my_real
2366 . ej(3)
2367C------noeuds independants------
2368 DO i = 1,numn
2369 n=inl(i)
2370 DO j=1,min(3,ndof(n))
2371 nd = iddl(j,i)
2372 IF (nd>0) lb(nd)=lb(nd)+a(j,n)
2373 ENDDO
2374 ENDDO
2375C------int2-------
2376 DO i=1,ni2
2377 n=ii2(1,i)
2378 ni=ii2(2,i)
2379 ji=ipari(1,n)
2380 nsn=ipari(5,n)
2381 k10=ji
2382 k11=k10+4*ipari(3,n)
2383C------IRECT(4,NSN)-----
2384 k12=k11+4*ipari(4,n)
2385C------NSV(NSN)--node number---
2386 k13=k12+nsn
2387C------MSR(NMN)-----
2388 k14=k13+ipari(6,n)
2389 l=intbuf_tab(n)%IRTLM(ni)
2390 nl=4*(l-1)
2391C------IRTL(NSN)--main el number---
2392 j10=ipari(2,n)
2393 j11=j10+1
2394 j12=j11+nparir
2395 j21=j12+2*nsn
2396 ilev =ipari(20,n)
2397 IF (ilev==1) THEN
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 )
2401 ELSE
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 )
2405 ENDIF
2406 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2407 nnod=3
2408 ELSE
2409 nnod=4
2410 ENDIF
2411C-------si noeud main est dependant aussi-----
2412 DO m=1,nnod
2413 nj=intbuf_tab(n)%IRECTM(nl+m)
2414 DO j=1,ndof(nj)
2415 nd = iddlm2(j,m,i)
2416 IF (j<=3.AND.nd>0) THEN
2417 lb(nd) = lb(nd)+a(j,nj)
2418 a(j,nj)=zero
2419 ELSEIF(nd>0) THEN
2420 lb(nd) = lb(nd)+ar(j-3,nj)
2421 ar(j-3,nj)=zero
2422 ENDIF
2423 ENDDO
2424 ENDDO
2425 ENDDO
2426C---------RBE2 -------------
2427 DO i=1,nr2
2428 n=ir2(1,i)
2429 m=irbe2(3,n)
2430 ns = ir2(2,i)
2431 isk = irbe2(7,n)
2432 irad =irbe2(11,n)
2433 ic = irbe2(4,n)
2434 ic =(ic/512)*512
2435 CALL prerbe2fr(ic ,jt ,jr )
2436 CALL rbe2frf(ns ,m ,a ,ar ,jt ,
2437 1 jr ,x_imp ,isk ,skew(1,isk),irad )
2438 DO j = 1 , ndof(m)
2439 nd = iddlm(j,i)
2440 IF (j<=3.AND.nd>0) THEN
2441 lb(nd)=lb(nd)+a(j,m)
2442 a(j,m)=zero
2443 ELSEIF (nd>0) THEN
2444 lb(nd)=lb(nd)+ar(j-3,m)
2445 ar(j-3,m)=zero
2446 ENDIF
2447 ENDDO
2448 ENDDO
2449C--------RBE3-----
2450 iads=1
2451 DO i=1,nr3
2452 n=ir3(i)
2453 iad=irbe3(1,n)
2454 ns=irbe3(3,n)
2455 nnod=irbe3(5,n)
2456 irot=irbe3(6,n)
2457 CALL prerbe3fr(irbe3 ,n ,jt ,jr )
2458 CALL rbe3frf(nnod ,lrbe3(iad+1),ns ,a ,ar ,
2459 1 fcdi(iads),mcdi(iads),jt ,jr ,irot )
2460 iads=iads+nnod
2461 DO m=1,nnod
2462 nj=lrbe3(iad+m)
2463 DO j=1,ndof(nj)
2464 nd = iddlm3(j,m,i)
2465 IF (j<=3.AND.nd>0) THEN
2466 lb(nd) = lb(nd)+a(j,nj)
2467 a(j,nj)=zero
2468 ELSEIF(nd>0.AND.irot>0) THEN
2469 lb(nd) = lb(nd)+ar(j-3,nj)
2470 ar(j-3,nj)=zero
2471 ENDIF
2472 ENDDO
2473 ENDDO
2474 ENDDO
2475C------Rigid bodies-------
2476 DO i=1,nrb
2477 m=irb(1,i)
2478 ns=irb(2,i)
2479 CALL rby_impf(x_imp ,m ,ns ,ndof ,a ,
2480 . ar )
2481 DO j = 1 , ndof(m)
2482 nd = iddlm(j,i)
2483 IF (j<=3.AND.nd>0) THEN
2484 lb(nd)=lb(nd)+a(j,m)
2485 a(j,m)=zero
2486 ELSEIF (nd>0) THEN
2487 lb(nd)=lb(nd)+ar(j-3,m)
2488 ar(j-3,m)=zero
2489 ENDIF
2490 ENDDO
2491 ENDDO
2492 IF (nbc>0) THEN
2493 CALL bc_updf(nbc ,ibc ,skew ,a )
2494 ENDIF
2495 DO l=1,nspc
2496 n = ispc(l)
2497 i = in_spc(n)
2498 IF (ndof(i)==0) cycle
2499 irot = 0
2500 iad = 6*(n-1)+1
2501 nn = ic_spc(n)
2502 IF (nn>3) THEN
2503 nn= nn-3
2504 irot = 1
2505 ENDIF
2506 IF (nn==1) THEN
2507 ej(1)=skew_spc(iad)
2508 ej(2)=skew_spc(iad+1)
2509 ej(3)=skew_spc(iad+2)
2510 CALL l_dir(ej,j)
2511 ENDIF
2512 IF (irot==0) THEN
2513 IF (nn==1) THEN
2514 CALL bc_fi(i ,ej ,j ,a )
2515 ELSE
2516 CALL bc_fi2(i ,skew_spc(iad),skew_spc(iad+3),a )
2517 END IF
2518 ELSE
2519 IF (nn==1) THEN
2520 CALL bc_fi(i ,ej ,j ,ar )
2521 ELSE
2522 CALL bc_fi2(i ,skew_spc(iad),skew_spc(iad+3),ar )
2523 END IF
2524 ENDIF
2525 ENDDO
2526C
2527 IF (nfx>0) THEN
2528 CALL fv_updf(nfx ,ifx ,ibfv ,skew ,xframe,
2529 1 a )
2530 ENDIF
2531 DO l = 1,nrw
2532 i = irw(l)
2533 n = in_rwl(i)
2534 ej(1)=nor_rwl(1,i)
2535 ej(2)=nor_rwl(2,i)
2536 ej(3)=nor_rwl(3,i)
2537 CALL l_dir(ej,j)
2538 CALL kin_updf(n ,ej ,j ,a )
2539 ENDDO
2540C
2541 RETURN
l_dir
subroutine l_dir(ej, j)
Definition bc_imp0.F:405
bc_fi
subroutine bc_fi(n, ej, j1, a)
Definition bc_imp0.F:1036
bc_updf
subroutine bc_updf(nbc, ibc, skew, a)
Definition bc_imp0.F:974
bc_fi2
subroutine bc_fi2(n, skew, skew1, a)
Definition bc_imp0.F:2562
fv_updf
subroutine fv_updf(nfx, ifx, ibfv, skew, xframe, a)
Definition fv_imp0.F:1427
kin_updf
subroutine kin_updf(n, ej, j1, a)
Definition fv_imp0.F:1487
prerbe3fr
subroutine prerbe3fr(irbe3, n, jt, jr)
Definition hm_read_rbe3.F:1499
i2_frfm0
subroutine i2_frfm0(x, irect, crst, nsv, irtl, a, ar, ii, ndof)
Definition i2_imp1.F:1600
i2_frfm1
subroutine i2_frfm1(x, irect, dpara, nsv, irtl, a, ii)
Definition i2_imp1.F:1508
imp_aspc
Definition impbufdef_mod.F:526
imp_aspc::in_spc
integer, dimension(:), allocatable in_spc
Definition impbufdef_mod.F:529
imp_aspc::ic_spc
integer, dimension(:), allocatable ic_spc
Definition impbufdef_mod.F:529
imp_rwl
Definition impbufdef_mod.F:387
imp_rwl::in_rwl
integer, dimension(:), allocatable in_rwl
Definition impbufdef_mod.F:391
prerbe2fr
subroutine prerbe2fr(ic, jt, jr)
Definition rbe2f.F:1059
rbe2frf
subroutine rbe2frf(ns, m, a, ar, jt, jr, x, isk, skew0, irad)
Definition rbe2f.F:706
rbe3frf
subroutine rbe3frf(nml, iml, ns, a, ar, fdstnb, mdstnb, jt, jr, irot)
Definition rbe3f.F:1908
rby_impf
subroutine rby_impf(x, m, n, ndof, a, ar)
Definition rby_imp0.F:612

◆ imp3_u2x()

subroutine imp3_u2x ( x,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) ndof,
lx,
a,
ar,
x_imp,
integer numn,
integer, dimension(*) inl,
integer, dimension(3,*) iddl,
integer nrb,
integer, dimension(2,*) irb,
integer, dimension(6,*) iddlm,
integer ni2,
integer, dimension(2,*) ii2,
integer, dimension(6,4,*) iddlm2,
integer nfx,
integer, dimension(2,*) ifx,
integer nbc,
integer, dimension(3,*) ibc,
integer nrw,
integer, dimension(*) irw,
integer, dimension(nifv,*) ibfv,
skew,
xframe,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
integer nr3,
integer, dimension(*) ir3,
integer, dimension(6,r3_max,*) iddlm3,
integer r3_max,
fcdi,
mcdi,
integer nspc,
integer, dimension(*) ispc,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer nr2,
integer, dimension(2,*) ir2,
integer, dimension(6,*) iddlm4 )

Definition at line 1925 of file monv_imp0.F.

1934C-----------------------------------------------
1935C M o d u l e s
1936C-----------------------------------------------
1937 USE imp_rwl
1938 USE imp_aspc
1939 USE intbufdef_mod
1940C-----------------------------------------------
1941C I m p l i c i t T y p e s
1942C-----------------------------------------------
1943#include "implicit_f.inc"
1944C-----------------------------------------------
1945C C o m m o n B l o c k s
1946C-----------------------------------------------
1947#include "com04_c.inc"
1948#include "param_c.inc"
1949C-----------------------------------------------
1950C D u m m y A r g u m e n t s
1951C-----------------------------------------------
1952 INTEGER R3_MAX
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(*),
1959 . NSPC ,ISPC(*)
1960 my_real
1961 . x(3,*) ,lx(*),a(3,*),ar(3,*),x_imp(3,*),
1962 . skew(lskew,*) ,xframe(*),fcdi(*) ,mcdi(*)
1963
1964 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1965C-----------------------------------------------
1966C L o c a l V a r i a b l e s
1967C-----------------------------------------------
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
1970 my_real
1971 . xs,ys,zs,ej(3)
1972C------utilise A,AR pour actualise U------
1973 DO i = 1, numn
1974 n = inl(i)
1975 DO j = 1, 3
1976 nd = iddl(j,i)
1977 IF (nd>0) THEN
1978 a(j,n) = lx(nd)
1979 ELSE
1980 a(j,n) = zero
1981 ENDIF
1982 ENDDO
1983 ENDDO
1984C------si il y a rb hierachic
1985C------BCS-----------
1986 DO l=nbc,1,-1
1987 i = ibc(1,l)
1988 isk =ibc(2,l)
1989 ifm =ibc(3,l)
1990 CALL bcl_impd(ifm ,isk ,skew ,i ,a )
1991 ENDDO
1992C
1993 IF (nfx>0) THEN
1994 DO n=1,nfxvel
1995 ljfr(n)=0
1996 ENDDO
1997 DO l=1,nfx
1998 i = ifx(1,l)
1999 ljfr(i) = ifx(2,l)
2000 ENDDO
2001 CALL fv_impd(ibfv ,ljfr ,skew ,xframe,a ,
2002 1 ar )
2003 ENDIF
2004 DO l=nspc,1,-1
2005 n = ispc(l)
2006 i = in_spc(n)
2007 irot = 0
2008 iad = 6*(n-1)+1
2009 nn = ic_spc(n)
2010 IF (nn>3) THEN
2011 nn= nn-3
2012 irot = 1
2013 ENDIF
2014 IF (nn==1) THEN
2015 ej(1)=skew_spc(iad)
2016 ej(2)=skew_spc(iad+1)
2017 ej(3)=skew_spc(iad+2)
2018 CALL l_dir(ej,j)
2019 END IF
2020 IF (irot==0) THEN
2021 IF (nn==1) THEN
2022 a(j,i) = zero
2023 CALL bc_updd(i ,ej ,j ,a )
2024 ELSEIF (nn==2) THEN
2025 CALL bc_upd2d(i ,skew_spc(iad),skew_spc(iad+3),a )
2026 END IF
2027 ELSE
2028 IF (nn==1) THEN
2029 ar(j,i) = zero
2030 CALL bc_updd(i ,ej ,j ,a )
2031 ELSEIF (nn==2) THEN
2032 CALL bc_upd2d(i ,skew_spc(iad),skew_spc(iad+3),ar )
2033 END IF
2034 ENDIF
2035 ENDDO
2036 DO l = 1,nrw
2037 i = irw(l)
2038 n=in_rwl(i)
2039 ej(1)=nor_rwl(1,i)
2040 ej(2)=nor_rwl(2,i)
2041 ej(3)=nor_rwl(3,i)
2042 CALL l_dir(ej,j)
2043 CALL bc_updd(n ,ej ,j ,a )
2044 ENDDO
2045C------Rigid bodies-------
2046 DO i=1,nrb
2047 m=irb(1,i)
2048 DO j = 1 , ndof(m)
2049 nd = iddlm(j,i)
2050 IF (nd<=0) THEN
2051 IF (j<=3) THEN
2052 a(j,m)=zero
2053 ELSE
2054 ar(j-3,m)=zero
2055 ENDIF
2056 ENDIF
2057 ENDDO
2058 ENDDO
2059C------esperons le hierachic est dans l'ordre
2060 DO i=nrb,1,-1
2061 m=irb(1,i)
2062 DO j = 1 , min(3,ndof(m))
2063 nd = iddlm(j,i)
2064 IF (nd>0) a(j,m)=lx(nd)
2065 ENDDO
2066 DO j = 4 , ndof(m)
2067 nd = iddlm(j,i)
2068 IF (nd>0) ar(j-3,m)=lx(nd)
2069 ENDDO
2070 ns=irb(2,i)
2071 xs=x(1,ns)-x(1,m)
2072 ys=x(2,ns)-x(2,m)
2073 zs=x(3,ns)-x(3,m)
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
2077 ENDDO
2078C--------RBE3-----
2079 DO i=1,nr3
2080 n=ir3(i)
2081 iad=irbe3(1,n)
2082 nnod=irbe3(5,n)
2083 irot=irbe3(6,n)
2084 DO m=1,nnod
2085 nj=lrbe3(iad+m)
2086 DO j=1,ndof(nj)
2087 nd = iddlm3(j,m,i)
2088 IF (j<=3.AND.nd>0) THEN
2089 a(j,nj)=zero
2090 ELSEIF(nd>0) THEN
2091 ar(j-3,nj)=zero
2092 ENDIF
2093 ENDDO
2094 ENDDO
2095 ENDDO
2096 iads=1
2097 DO i=nr3,1,-1
2098 n=ir3(i)
2099 iad=irbe3(1,n)
2100 ns=irbe3(3,n)
2101 nnod=irbe3(5,n)
2102 irot=irbe3(6,n)
2103 DO m=1,nnod
2104 nj=lrbe3(iad+m)
2105 DO j=1,ndof(nj)
2106 nd = iddlm3(j,m,i)
2107 IF (j<=3.AND.nd>0) THEN
2108 a(j,nj)=lx(nd)
2109 ELSEIF(nd>0) THEN
2110 ar(j-3,nj)=lx(nd)
2111 ENDIF
2112 ENDDO
2113 ENDDO
2114 CALL prerbe3fr(irbe3 ,n ,jt ,jr )
2115 CALL rbe3_frd(nnod ,lrbe3(iad+1),ns ,a ,ar ,
2116 1 fcdi(iads),mcdi(iads) ,jt ,jr ,
2117 2 irot )
2118 iads=iads+nnod
2119 ENDDO
2120C------RBE2---add jt&skew
2121 DO i=1,nr2
2122 n=ir2(1,i)
2123 m=irbe2(3,n)
2124 DO j = 1 , ndof(m)
2125 nd = iddlm4(j,i)
2126 IF (nd<=0) THEN
2127 IF (j<=3) THEN
2128 a(j,m)=zero
2129 ELSE
2130 ar(j-3,m)=zero
2131 ENDIF
2132 ENDIF
2133 ENDDO
2134 ENDDO
2135 DO i=nr2,1,-1
2136 n=ir2(1,i)
2137 m=irbe2(3,n)
2138 ns = ir2(2,i)
2139 isk = irbe2(7,n)
2140 irad =irbe2(11,n)
2141 ic = irbe2(4,n)
2142 ic =(ic/512)*512
2143 DO j = 1 , min(3,ndof(m))
2144 nd = iddlm4(j,i)
2145 IF (nd>0) a(j,m)=lx(nd)
2146 ENDDO
2147 DO j = 4 , ndof(m)
2148 nd = iddlm4(j,i)
2149 IF (nd>0) ar(j-3,m)=lx(nd)
2150 ENDDO
2151 CALL prerbe2fr(ic ,jt ,jr )
2152 CALL rbe2_frd(ns ,m ,x ,a ,ar ,
2153 1 jt ,jr ,skew(1,isk),isk ,irad )
2154 ENDDO
2155C------int2-------
2156 DO i=1,ni2
2157 n=ii2(1,i)
2158 ni=ii2(2,i)
2159 nsn=ipari(5,n)
2160 l=intbuf_tab(n)%IRTLM(ni)
2161 nl=4*(l-1)
2162 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2163 nnod=3
2164 ELSE
2165 nnod=4
2166 ENDIF
2167C-------si noeud main est dependant aussi-----
2168 DO m=1,nnod
2169 nj=intbuf_tab(n)%IRECTM(nl+m)
2170 DO j=1,ndof(nj)
2171 nd = iddlm2(j,m,i)
2172 IF (nd<=0) THEN
2173 IF (j<=3) THEN
2174 a(j,nj)=zero
2175 ELSE
2176 ar(j-3,nj)=zero
2177 ENDIF
2178 ENDIF
2179 ENDDO
2180 ENDDO
2181 ENDDO
2182C
2183 DO i=ni2,1,-1
2184 n=ii2(1,i)
2185 ni=ii2(2,i)
2186 nsn=ipari(5,n)
2187 l=intbuf_tab(n)%IRTLM(ni)
2188 nl=4*(l-1)
2189 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2190 nnod=3
2191 ELSE
2192 nnod=4
2193 ENDIF
2194C-------si noeud main est dependant aussi-----
2195 DO m=1,nnod
2196 nj=intbuf_tab(n)%IRECTM(nl+m)
2197 DO j=1,ndof(nj)
2198 nd = iddlm2(j,m,i)
2199 IF (j<=3.AND.nd>0) THEN
2200 a(j,nj)=lx(nd)
2201 ELSEIF(nd>0) THEN
2202 ar(j-3,nj)=lx(nd)
2203 ENDIF
2204 ENDDO
2205 ENDDO
2206
2207 ilev =ipari(20,n)
2208 IF (ilev==1) 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 )
2212 ELSE
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 )
2216 ENDIF
2217 ENDDO
2218C
2219C------Actuallise-X(*) dans X_IMP-----
2220 DO i = 1, numn
2221 n = inl(i)
2222 DO j = 1, 3
2223 x_imp(j,n) = a(j,n) + x(j,n)
2224 ENDDO
2225 ENDDO
2226C
2227 RETURN
bcl_impd
subroutine bcl_impd(ict, isk, skew, i, d)
Definition bc_imp0.F:721
bc_updd
subroutine bc_updd(n, ej, j, d)
Definition bc_imp0.F:843
bc_upd2d
subroutine bc_upd2d(n, skew, skew1, d)
Definition bc_imp0.F:2469
fv_impd
subroutine fv_impd(ibfv, lj, skew, xframe, ud, rd)
Definition fv_imp0.F:932
i2_frrd0
subroutine i2_frrd0(x, irect, crst, nsv, irtl, d, dr, ii, ndof)
Definition i2_imp2.F:478
i2_frrd1
subroutine i2_frrd1(x, irect, dpara, nsv, irtl, d, ii)
Definition i2_imp2.F:384
rbe2_frd
subroutine rbe2_frd(ns, m, x, v, vr, jt, jr, skew0, isk, irad)
Definition rbe2v.F:1025
rbe3_frd
subroutine rbe3_frd(nml, iml, ns, d, dr, fdstnb, mdstnb, jt, jr, irot)
Definition rbe3v.F:231

◆ imp_pvga()

subroutine imp_pvga ( integer, dimension(*) ivolu,
rvolu,
vol,
dpres )

Definition at line 2234 of file monv_imp0.F.

2235C-----------------------------------------------
2236C I m p l i c i t T y p e s
2237C-----------------------------------------------
2238#include "implicit_f.inc"
2239C-----------------------------------------------
2240C C o m m o n B l o c k s
2241C-----------------------------------------------
2242#include "com08_c.inc"
2243C-----------------------------------------------
2244C D u m m y A r g u m e n t s
2245C-----------------------------------------------
2246 INTEGER IVOLU(*)
2247C REAL
2248 my_real
2249 . rvolu(*),dpres
2250C-----------------------------------------------
2251C L o c a l V a r i a b l e s
2252C-----------------------------------------------
2253 INTEGER IDEF,IV
2254C REAL
2255 my_real
2256 . vol,vinc,gama,pres,pmax,veps,pold,vold,pext,
2257 . dv,energy,energ_old,deout,fac
2258C-----------------------------------------------
2259 pext =rvolu(3)
2260 pold =rvolu(12)
2261C------------------------
2262 idef =ivolu(14)
2263 gama =rvolu(1)
2264C P0V0G =RVOLU(4)
2265 vinc =rvolu(5)
2266 pmax =rvolu(6)
2267 energ_old=rvolu(13)
2268 vold =rvolu(16)
2269 veps =rvolu(17)
2270 vol =vol + veps
2271 deout =rvolu(22)
2272 dv = vol-vold
2273C
2274 IF(idef==1)THEN
2275 pres = pext
2276 ELSE
2277C CALCUL DE L ENERGIE PUIS DE LA PRESSION
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)
2282C
2283 pres=(gama-one)*energy/(vol-vinc)
2284C
2285 IF(pres>pmax)THEN
2286 idef=1
2287 pres = pext
2288 ENDIF
2289 ENDIF
2290C
2291 dpres=pres-pold
2292C
2293C
2294 RETURN
max
#define max(a, b)
Definition macros.h:21

◆ ini_kinmv()

subroutine ini_kinmv ( integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer nrbyac,
integer, dimension(*) irbyac,
integer nint2,
integer, dimension(*) iint2,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) inloc,
integer nrb_mv,
integer, dimension(2,*) irb_mv,
integer ni2_mv,
integer, dimension(2,*) ii2_mv,
integer, dimension(nrbe3l,*) irbe3,
integer nrbe3_mv,
integer, dimension(*) irbe3_mv,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer nrbe2_mv,
integer, dimension(2,*) irbe2_mv )

Definition at line 304 of file monv_imp0.F.

309C-----------------------------------------------
310C M o d u l e s
311C-----------------------------------------------
312 USE intbufdef_mod
313C----6------------------------------------------
314C I m p l i c i t T y p e s
315C-----------------------------------------------
316#include "implicit_f.inc"
317C-----------------------------------------------
318C C o m m o n B l o c k s
319C-----------------------------------------------
320#include "com04_c.inc"
321#include "param_c.inc"
322C-----------------------------------------------
323C D u m m y A r g u m e n t s
324C-----------------------------------------------
325 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
326 . NINT2,IINT2(*),IPARI(NPARI,*)
327 integer
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,*)
331C REAL
332
333 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
334C-----------------------------------------------
335C L o c a l V a r i a b l e s
336C-----------------------------------------------
337 integer
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
340c----------------------
341 ni2=0
342 IF (ni2_mv>0) THEN
343 DO j=1,nint2
344 n=iint2(j)
345 nsn = ipari(5,n)
346 ji=ipari(1,n)
347 k10=ji-1
348 k11=k10+4*ipari(3,n)
349C------IRECT(4,NSN)-----
350 k12=k11+4*ipari(4,n)
351C------NSV(NSN)--node number---
352 k13=k12+nsn
353C------MSR(NMN)-----
354 k14=k13+ipari(6,n)
355C------IRTL(NSN)--main el number---
356 kfi=k14+nsn
357 DO i=1,nsn
358 ni=intbuf_tab(n)%NSV(i)
359 IF (inloc(ni)>0) THEN
360 ni2=ni2+1
361 ii2_mv(1,ni2)=n
362 ii2_mv(2,ni2)=i
363 ENDIF
364 ENDDO
365 ENDDO
366 IF (ni2/=ni2_mv) WRITE(*,*)'pb cal NI2_MV'
367 ENDIF
368C-----RBE2-----
369 nr2=0
370 IF (nrbe2_mv>0) THEN
371 DO n=1,nrbe2
372 k =irbe2(1,n)
373 m =irbe2(3,n)
374 IF (inloc(m)>0) THEN
375 nsn =irbe2(5,n)
376 DO i=1,nsn
377 id = i+k
378 ni=lrbe2(id)
379 IF (inloc(ni)>0) THEN
380 nr2=nr2+1
381 irbe2_mv(1,nr2)=n
382 irbe2_mv(2,nr2)=ni
383 ENDIF
384 ENDDO
385 ENDIF
386 ENDDO
387 IF (nr2/=nrbe2_mv) WRITE(*,*)'pb cal NRBE2_MV'
388 ENDIF
389C--------RBE3--------------------
390 IF (nrbe3_mv>0) THEN
391 nr3=0
392 DO n=1,nrbe3
393 ni = irbe3(3,n)
394 IF (ni==0) cycle
395 IF (inloc(ni)>0) THEN
396 nr3=nr3+1
397 irbe3_mv(nr3)=n
398 ENDIF
399 ENDDO
400 IF (nr3/=nrbe3_mv) WRITE(*,*)'pb cal NRBE3_MV'
401 ENDIF
402C-----active rigid body main nodes------
403 nrb=0
404 IF (nrb_mv>0) THEN
405 DO j=1,nrbyac
406 n=irbyac(j)
407 k=irbyac(j+nrbykin)
408 m =npby(1,n)
409 IF (inloc(m)>0) THEN
410 nsn =npby(2,n)
411 DO i=1,nsn
412 id = i+k
413 ni=lpby(id)
414 IF (inloc(ni)>0) THEN
415 nrb=nrb+1
416 irb_mv(1,nrb)=m
417 irb_mv(2,nrb)=ni
418 ENDIF
419 ENDDO
420 ENDIF
421 ENDDO
422 IF (nrb/=nrb_mv) WRITE(*,*)'pb cal NRB_MV'
423 ENDIF
424C----6---------------------------------------------------------------7---------8
425 RETURN

◆ monv_diag()

subroutine monv_diag ( diag_k,
integer, dimension(*) ndof,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(nrbe2l,*) irbe2,
integer iflag )

Definition at line 1576 of file monv_imp0.F.

1578C-----------------------------------------------
1579C M o d u l e s
1580C-----------------------------------------------
1581 USE imp_monv
1582 USE intbufdef_mod
1583C-----------------------------------------------
1584C I m p l i c i t T y p e s
1585C-----------------------------------------------
1586#include "implicit_f.inc"
1587C-----------------------------------------------
1588C C o m m o n B l o c k s
1589C-----------------------------------------------
1590#include "param_c.inc"
1591C-----------------------------------------------
1592C D u m m y A r g u m e n t s
1593C-----------------------------------------------
1594 INTEGER IPARI(NPARI,*), NDOF(*),IFLAG,
1595 . IRBE3(NRBE3L,*),LRBE3(*),IRBE2(NRBE2L,*)
1596C REAL
1597 my_real
1598 . diag_k(*)
1599
1600 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1601C-----------------------------------------------
1602C L o c a l V a r i a b l e s
1603C-----------------------------------------------
1604 INTEGER I,J,NKC,N,ND,ID,IAD
1605 INTEGER M,NSN,JI,K10,K11,K12,K13,K14,L,NNOD,NJ,NL,NI
1606C---------IFLAG=0: add; IFLAG=1:remove-------
1607 IF (iflag==0) THEN
1608 DO i = 1, numn_mv
1609 n = in_mv(i)
1610 DO j = 1, min(3,ndof(n))
1611 id = id_mv(j,i)
1612 IF (id>0) diag_k(id)=diag_k(id)+diag_mv(j,i)
1613 ENDDO
1614 ENDDO
1615C
1616 DO i = 1, nrb_mv
1617 n = irb_mv(1,i)
1618 DO j = 1, ndof(n)
1619 id = id_mvm(j,i)
1620 IF (id>0) diag_k(id)=diag_k(id)+diag_mvm(j,i)
1621 ENDDO
1622 ENDDO
1623C
1624 DO i=1,ni2_mv
1625 n=ii2_mv(1,i)
1626 ni=ii2_mv(2,i)
1627 ji=ipari(1,n)
1628 nsn=ipari(5,n)
1629 k10=ji-1
1630 k11=k10+4*ipari(3,n)
1631C------IRECT(4,NSN)-----
1632 k12=k11+4*ipari(4,n)
1633C------NSV(NSN)--node number---
1634 k13=k12+nsn
1635C------MSR(NMN)-----
1636 k14=k13+ipari(6,n)
1637 l=intbuf_tab(n)%IRTLM(ni)
1638 nl=4*(l-1)
1639 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
1640 nnod=3
1641 ELSE
1642 nnod=4
1643 ENDIF
1644C-------si noeud main est dependant aussi-----
1645 DO m=1,nnod
1646 nj=intbuf_tab(n)%IRECTM(nl+m)
1647 DO j = 1, ndof(nj)
1648 id = id_mvm2(j,m,i)
1649 IF (id>0) diag_k(id)=diag_k(id)+diag_mvm2(j,m,i)
1650 ENDDO
1651 ENDDO
1652 ENDDO
1653C---------RBE3--------------
1654 DO i=1,nrbe3_mv
1655 n=irbe3_mv(i)
1656 nnod=irbe3(5,n)
1657 iad=irbe3(1,n)
1658C--------
1659 DO m=1,nnod
1660 nj=lrbe3(iad+m)
1661 DO j = 1, ndof(nj)
1662 id = id_mvm3(j,m,i)
1663 IF (id>0) diag_k(id)=diag_k(id)+diag_mvm3(j,m,i)
1664 ENDDO
1665 ENDDO
1666 ENDDO
1667C----------RBE2---maybe the order is important---------
1668 DO i = 1, nrbe2_mv
1669 n = irbe2_mv(1,i)
1670 m = irbe2(3,n)
1671 DO j = 1, ndof(m)
1672 id = id_mvm(j,i)
1673 IF (id>0) diag_k(id)=diag_k(id)+diag_mvm4(j,i)
1674 ENDDO
1675 ENDDO
1676C---------on enleve-----
1677 ELSE
1678 DO i = 1, numn_mv
1679 n = in_mv(i)
1680 DO j = 1, min(3,ndof(n))
1681 id = id_mv(j,i)
1682 IF (id>0) diag_k(id)=diag_k(id)-diag_mv(j,i)
1683 ENDDO
1684 ENDDO
1685C
1686 DO i = 1, nrb_mv
1687 n = irb_mv(1,i)
1688 DO j = 1, ndof(n)
1689 id = id_mvm(j,i)
1690 IF (id>0) diag_k(id)=diag_k(id)-diag_mvm(j,i)
1691 ENDDO
1692 ENDDO
1693C
1694 DO i=1,ni2_mv
1695 n=ii2_mv(1,i)
1696 ni=ii2_mv(2,i)
1697 ji=ipari(1,n)
1698 nsn=ipari(5,n)
1699 k10=ji-1
1700 k11=k10+4*ipari(3,n)
1701C------IRECT(4,NSN)-----
1702 k12=k11+4*ipari(4,n)
1703C------NSV(NSN)--node number---
1704 k13=k12+nsn
1705C------MSR(NMN)-----
1706 k14=k13+ipari(6,n)
1707 l=intbuf_tab(n)%IRTLM(ni)
1708 nl=4*(l-1)
1709 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
1710 nnod=3
1711 ELSE
1712 nnod=4
1713 ENDIF
1714C-------si noeud main est dependant aussi-----
1715 DO m=1,nnod
1716 nj=intbuf_tab(n)%IRECTM(nl+m)
1717 DO j = 1, ndof(nj)
1718 id = id_mvm2(j,m,i)
1719 IF (id>0) diag_k(id)=diag_k(id)-diag_mvm2(j,m,i)
1720 ENDDO
1721 ENDDO
1722 ENDDO
1723C---------RBE3--------------
1724 DO i=1,nrbe3_mv
1725 n=irbe3_mv(i)
1726 nnod=irbe3(5,n)
1727 iad=irbe3(1,n)
1728C--------
1729 DO m=1,nnod
1730 nj=lrbe3(iad+m)
1731 DO j = 1, ndof(nj)
1732 id = id_mvm3(j,m,i)
1733 IF (id>0) diag_k(id)=diag_k(id)-diag_mvm3(j,m,i)
1734 ENDDO
1735 ENDDO
1736 ENDDO
1737C----------RBE2------------
1738 DO i = 1, nrbe2_mv
1739 n = irbe2_mv(1,i)
1740 m = irbe2(3,n)
1741 DO j = 1, ndof(m)
1742 id = id_mvm(j,i)
1743 IF (id>0) diag_k(id)=diag_k(id)-diag_mvm4(j,i)
1744 ENDDO
1745 ENDDO
1746 ENDIF
1747C
1748 RETURN

◆ monv_fvl()

subroutine monv_fvl ( integer, dimension(nifv,*) ibfv,
integer, dimension(*) lj,
integer, dimension(*) iskew,
integer, dimension(*) icodt )

Definition at line 436 of file monv_imp0.F.

437C-----------------------------------------------
438C M o d u l e s
439C-----------------------------------------------
440 USE imp_monv
441 USE imp_rwl
442 USE imp_aspc
443C-----------------------------------------------
444C I m p l i c i t T y p e s
445C-----------------------------------------------
446#include "implicit_f.inc"
447C-----------------------------------------------
448C C o m m o n B l o c k s
449C-----------------------------------------------
450#include "com04_c.inc"
451#include "param_c.inc"
452C-----------------------------------------------
453C D u m m y A r g u m e n t s
454C-----------------------------------------------
455 INTEGER IBFV(NIFV,*),LJ(*),ISKEW(*) ,ICODT(*)
456C-----------------------------------------------
457C L o c a l V a r i a b l e s
458C-----------------------------------------------
459 INTEGER I,J,K,N,L,IERR1,IERR2,IERR3,ITAG(NUMNOD)
460C-----------------------------------------------
461 DO n=1,numnod
462 itag(n) = 0
463 ENDDO
464 DO i=1,numn_mv
465 n = in_mv(i)
466 itag(n) = i
467 ENDDO
468 nbc_mv = 0
469 DO n=1,numnod
470 IF (iskew(n)>1.AND.icodt(n)/=7) THEN
471 IF (itag(n)>0)nbc_mv = nbc_mv + 1
472 ENDIF
473 ENDDO
474 IF (nbc_mv>0) THEN
475 IF(ALLOCATED(ibc_mv)) DEALLOCATE(ibc_mv)
476 ALLOCATE(ibc_mv(3,nbc_mv),stat=ierr1)
477 nbc_mv = 0
478 DO n=1,numnod
479 IF (iskew(n)>1.AND.icodt(n)/=7) THEN
480 IF (itag(n)>0) THEN
481 nbc_mv = nbc_mv + 1
482 ibc_mv(1,nbc_mv) = n
483 ibc_mv(2,nbc_mv) = iskew(n)
484 ibc_mv(3,nbc_mv) = icodt(n)
485 ENDIF
486 ENDIF
487 ENDDO
488 ENDIF
489C-----AUTOSPC----
490 nspc_mv = 0
491 DO n = 1, nspcl
492 IF (itag(n)>0)nspc_mv = nspc_mv + 1
493 ENDDO
494 IF (nspc_mv>0) THEN
495 IF(ALLOCATED(ispc_mv)) DEALLOCATE(ispc_mv)
496 ALLOCATE(ispc_mv(nspc_mv),stat=ierr1)
497 nspc_mv = 0
498 DO n=1,nspcl
499 IF (itag(n)>0) THEN
500 nspc_mv = nspc_mv + 1
501 ispc_mv(nspc_mv) = n
502 ENDIF
503 ENDDO
504 ENDIF
505C
506 nfx_mv = 0
507 DO j=1,nfxvel
508 IF (lj(j)>0.AND.lj(j)<=3) THEN
509 n=iabs(ibfv(1,j))
510 IF (itag(n)>0)nfx_mv = nfx_mv + 1
511 ENDIF
512 ENDDO
513 IF (nfx_mv>0) THEN
514 IF(ALLOCATED(ifx_mv)) DEALLOCATE(ifx_mv)
515 ALLOCATE(ifx_mv(2,nfx_mv),stat=ierr2)
516 nfx_mv = 0
517 DO j=1,nfxvel
518 IF (lj(j)>0.AND.lj(j)<=3) THEN
519 n=iabs(ibfv(1,j))
520 IF (itag(n)>0) THEN
521 nfx_mv = nfx_mv + 1
522 ifx_mv(1,nfx_mv) = j
523 ifx_mv(2,nfx_mv) = lj(j)
524 ENDIF
525 ENDIF
526 ENDDO
527 ENDIF
528 nrw_mv = 0
529 DO j=1,n_rwl
530 n=in_rwl(j)
531 IF (itag(n)>0) nrw_mv = nrw_mv + 1
532 ENDDO
533 IF (nrw_mv>0) THEN
534 IF(ALLOCATED(irw_mv)) DEALLOCATE(irw_mv)
535 ALLOCATE(irw_mv(nrw_mv),stat=ierr3)
536 nrw_mv = 0
537 DO j=1,n_rwl
538 n=in_rwl(j)
539 IF (itag(n)>0) THEN
540 nrw_mv = nrw_mv + 1
541 irw_mv(nrw_mv) = j
542 ENDIF
543 ENDDO
544 ENDIF
545C
546 RETURN
imp_aspc::nspcl
integer nspcl
Definition impbufdef_mod.F:527
imp_monv::irw_mv
integer, dimension(:), allocatable irw_mv
Definition impbufdef_mod.F:362
imp_monv::nspc_mv
integer nspc_mv
Definition impbufdef_mod.F:343
imp_monv::nrw_mv
integer nrw_mv
Definition impbufdef_mod.F:343
imp_monv::nfx_mv
integer nfx_mv
Definition impbufdef_mod.F:343
imp_monv::ifx_mv
integer, dimension(:,:), allocatable ifx_mv
Definition impbufdef_mod.F:361
imp_monv::nbc_mv
integer nbc_mv
Definition impbufdef_mod.F:343
imp_monv::ispc_mv
integer, dimension(:), allocatable ispc_mv
Definition impbufdef_mod.F:362
imp_monv::ibc_mv
integer, dimension(:,:), allocatable ibc_mv
Definition impbufdef_mod.F:361
imp_rwl::n_rwl
integer n_rwl
Definition impbufdef_mod.F:389

◆ monv_imp()

subroutine monv_imp ( integer, dimension(*) monvol,
volmon,
x,
type(surf_), dimension(nsurf) igrsurf,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
a_mv,
ar_mv,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
integer, dimension(*) inloc,
integer iprec,
integer, dimension(*) ibfv,
skew,
xframe,
integer, dimension(*) lj,
integer, dimension(*) iskew,
integer, dimension(*) icodt,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
frbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2,
integer nsurf )

Definition at line 559 of file monv_imp0.F.

565C-----------------------------------------------
566C M o d u l e s
567C-----------------------------------------------
568 USE intbufdef_mod
569 USE groupdef_mod
570C-----------------------------------------------
571C D u m m y A r g u m e n t s
572C-----------------------------------------------
573 INTEGER NMONV,IMONV(*),MONVOL(*),
574 . IPARI(*), NDOF(*),IDDL(*),IKC(*),
575 . INLOC(*),IPREC,IBFV(*),LJ(*),ISKEW(*),ICODT(*),
576 . IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*),NSURF
577C REAL
578 my_real
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
583C-----------------------------------------------
584C L o c a l V a r i a b l e s
585C-----------------------------------------------
586 INTEGER I,J
587C-----------------------------------------------
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 )
594C
595 RETURN
monv_m3
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)
Definition monv_imp0.F:616
monv_fvl
subroutine monv_fvl(ibfv, lj, iskew, icodt)
Definition monv_imp0.F:437
groupdef_mod
Definition groupdef_mod.F:662

◆ monv_kd()

subroutine monv_kd ( integer, dimension(*) monvol,
volmon,
x,
type(surf_), dimension(nsurf) igrsurf,
integer nmonv,
integer, dimension(*) imonv,
k_diag,
integer nnmax_mv )

Definition at line 957 of file monv_imp0.F.

959C-----------------------------------------------
960C M o d u l e s
961C-----------------------------------------------
962 USE groupdef_mod
963C-----------------------------------------------
964C I m p l i c i t T y p e s
965C-----------------------------------------------
966#include "implicit_f.inc"
967C-----------------------------------------------
968C C o m m o n B l o c k s
969C-----------------------------------------------
970#include "com04_c.inc"
971#include "param_c.inc"
972C-----------------------------------------------
973C D u m m y A r g u m e n t s
974C-----------------------------------------------
975 INTEGER NMONV,IMONV(*),MONVOL(*),
976 . NNMAX_MV
977C REAL
978 my_real
979 . x(3,*), volmon(*) ,k_diag(3,*)
980 TYPE(SURF_) ,DIMENSION(NSURF) :: IGRSURF
981C-----------------------------------------------
982C L o c a l V a r i a b l e s
983C-----------------------------------------------
984 INTEGER I, NTYP,NN,K1,IAD,IS,J,N,NMV,
985 . N1,N2,N3,N4,KK1,J1,ID,ID1,M1,M2,M3,M4
986 my_real
987 . vol(nmonv),nor(3,nnmax_mv),dvd1(3),dvd2(3),gamav(nmonv)
988 my_real
989 . xx,yy,zz,x12,y12,z12,x13,y13,z13,x24,y24,z24,v,
990 . gamav2
991C-----IDDL(3,*) est apres upd_k-,si dependant-:comme interface remote---------
992C-----------reprend vol,gama------
993 nmv = 0
994 k1 = 1
995 kk1 = 0
996 DO i=1,nvolu
997 IF(imonv(i)>0) THEN
998 nmv = nmv+1
999C-----------VOL-VINC---------
1000 vol(nmv) = volmon(kk1+16)- volmon(kk1+5)
1001 gamav(nmv) = (volmon(kk1+1)-one)*volmon(kk1+13) /vol(nmv)
1002 ENDIF
1003 k1 = k1 + nimv
1004 kk1 = kk1 + nrvolu
1005 ENDDO
1006C-----------DIAG_K------
1007 nmv = 0
1008 k1 = 1
1009 DO i=1,nvolu
1010 IF(imonv(i)>0) THEN
1011 is = monvol(k1+3)
1012 nn = igrsurf(is)%NSEG
1013 nmv = nmv+1
1014 DO j=1,nn
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)
1019 x13=x(1,n3)-x(1,n1)
1020 y13=x(2,n3)-x(2,n1)
1021 z13=x(3,n3)-x(3,n1)
1022 x24=x(1,n4)-x(1,n2)
1023 y24=x(2,n4)-x(2,n2)
1024 z24=x(3,n4)-x(3,n2)
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)
1028 ENDDO
1029 DO j=1,nn
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))
1037 x13=x(1,n3)-x(1,n1)
1038 y13=x(2,n3)-x(2,n1)
1039 z13=x(3,n3)-x(3,n1)
1040 x24=x(1,n4)-x(1,n2)
1041 y24=x(2,n4)-x(2,n2)
1042 z24=x(3,n4)-x(3,n2)
1043 gamav2=gamav(nmv)/vol(nmv)
1044C-----------K-elememtaire J1--Kij(i dans ele J;j dans ele J1 ---)
1045 CALL monv_kedi(n1 ,n2 ,n3 ,n4 ,xx ,
1046 1 yy ,zz ,x13 ,y13 ,z13 ,
1047 2 x24 ,y24 ,z24 ,nor(1,j),vol(nmv),
1048 3 gamav2 ,dvd1 ,dvd2 ,k_diag)
1049C-----------K-elememtaire J1--Kij(i dans ele J;j dans ele J1 ---)
1050 DO j1=1,nn
1051 IF (j1/=j) THEN
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
1060 CALL monv_kedj(n1 ,n2 ,n3 ,n4 ,m1 ,
1061 1 m2 ,m3 ,m4 ,nor(1,j),nor(1,j1),
1062 2 vol(nmv),gamav2 ,dvd1 ,dvd2 ,k_diag )
1063 ENDIF
1064 ENDIF
1065 ENDDO
1066 ENDDO
1067 ENDIF
1068 k1 = k1 + nimv
1069 ENDDO
1070C
1071 RETURN
monv_kedj
subroutine monv_kedj(n1, n2, n3, n4, m1, m2, m3, m4, n, nj, vol, gamav2, dvd1, dvd2, k_diag)
Definition monv_imp0.F:1177
monv_kedi
subroutine monv_kedi(n1, n2, n3, n4, xx, yy, zz, x13, y13, z13, x24, y24, z24, n, vol, gamav2, dvd1, dvd2, k_diag)
Definition monv_imp0.F:1082

◆ monv_kedi()

subroutine monv_kedi ( integer n1,
integer n2,
integer n3,
integer n4,
xx,
yy,
zz,
x13,
y13,
z13,
x24,
y24,
z24,
n,
vol,
gamav2,
dvd1,
dvd2,
k_diag )

Definition at line 1078 of file monv_imp0.F.

1082C-----------------------------------------------
1083C I m p l i c i t T y p e s
1084C-----------------------------------------------
1085#include "implicit_f.inc"
1086C-----------------------------------------------
1087C D u m m y A r g u m e n t s
1088C-----------------------------------------------
1089 INTEGER N1,N2,N3,N4
1090C REAL
1091 my_real
1092 . xx,yy,zz,x12,y12,z12,x13,y13,z13,x24,y24,z24,vol,
1093 . dvd1(*),dvd2(*),n(3),gamav2,k_diag(3,*)
1094C-----------------------------------------------
1095C L o c a l V a r i a b l e s
1096C-----------------------------------------------
1097 INTEGER I, J,NNOD,ND,ID
1098 my_real
1099 . dndx1(3),dndy1(3),dndz1(3),dndx2(3),dndy2(3),dndz2(3),
1100 . kev1(3),kev2(3),kevs(3),fac,facv(3)
1101C---------DNDX:NX,x,NY,x,NZ,x,------------------------------------
1102 nd = 3
1103 IF (n3==n4) THEN
1104 nnod = 3
1105 ELSE
1106 nnod = 4
1107 ENDIF
1108 dndx1(1)=zero
1109 dndx1(2)=z24
1110 dndx1(3)=-y24
1111 dndy1(1)=-z24
1112 dndy1(2)=zero
1113 dndy1(3)=x24
1114 dndz1(1)=y24
1115 dndz1(2)=-x24
1116 dndz1(3)=zero
1117C
1118 dndx2(1)=zero
1119 dndx2(2)=-z13
1120 dndx2(3)=y13
1121 dndy2(1)=z13
1122 dndy2(2)=zero
1123 dndy2(3)=-x13
1124 dndz2(1)=-y13
1125 dndz2(2)=x13
1126 dndz2(3)=zero
1127C
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
1134C---------terme n---zero----------------
1135 fac = gamav2/nnod
1136C---------terme v-------------------
1137 DO j=1,nd
1138 facv(j) = fac*n(j)
1139 ENDDO
1140 DO i=1,nd
1141C---------K11,K13=-K11-------------------
1142 kev1(i) = facv(i)*dvd1(i)
1143C---------K12,K22-------------------
1144 kev2(i) = facv(i)*dvd2(i)
1145C---------terme sup pour (xx,xj j=1,2)-------------------
1146 kevs(i) = facv(i)*n(i)
1147 ENDDO
1148C---------KE11-------------------
1149 DO i=1,nd
1150 k_diag(i,n1) = k_diag(i,n1)-kev1(i)-kevs(i)
1151 ENDDO
1152C---------KE33-------------------
1153 DO i=1,nd
1154 k_diag(i,n3) = k_diag(i,n3)+kev1(i)
1155 ENDDO
1156C---------K22-------------------
1157 DO i=1,nd
1158 k_diag(i,n2) = k_diag(i,n2)-kev2(i)-kevs(i)
1159 ENDDO
1160C---------K44-------------------
1161 IF (nnod==4) THEN
1162 DO i=1,nd
1163 k_diag(i,n4) = k_diag(i,n4)+kev2(i)
1164 ENDDO
1165 ENDIF
1166C
1167 RETURN

◆ monv_kedj()

subroutine monv_kedj ( integer n1,
integer n2,
integer n3,
integer n4,
integer m1,
integer m2,
integer m3,
integer m4,
n,
nj,
vol,
gamav2,
dvd1,
dvd2,
k_diag )

Definition at line 1174 of file monv_imp0.F.

1177C-----------------------------------------------
1178C I m p l i c i t T y p e s
1179C-----------------------------------------------
1180#include "implicit_f.inc"
1181C-----------------------------------------------
1182C D u m m y A r g u m e n t s
1183C-----------------------------------------------
1184 INTEGER N1,N2,N3,N4,M1,M2,M3,M4
1185C REAL
1186 my_real
1187 . vol,dvd1(*),dvd2(*),n(3),nj(3),gamav2,k_diag(3,*)
1188C-----------------------------------------------
1189C L o c a l V a r i a b l e s
1190C-----------------------------------------------
1191 INTEGER I, J,NNOD,NNOD1,ND,NM(4)
1192 my_real
1193 . kev1(3),kev2(3),kevs(3),fac,facv(3)
1194C---------DNDX:NX,x,NY,x,NZ,x,------------------------------------
1195 nd = 3
1196 nm(1) = m1
1197 nm(2) = m2
1198 nm(3) = m3
1199 IF (n3==n4) THEN
1200 nnod = 3
1201 ELSE
1202 nnod = 4
1203 ENDIF
1204 IF (m3==m4) THEN
1205 nnod1 = 3
1206 ELSE
1207 nnod1 = 4
1208 nm(4) = m4
1209 ENDIF
1210C---------terme v-------------------
1211 DO j=1,nd
1212 facv(j) = gamav2*nj(j)
1213 ENDDO
1214 DO i=1,nd
1215 kev1(i) = facv(i)*dvd1(i)
1216 kev2(i) = facv(i)*dvd2(i)
1217 kevs(i) = facv(i)*n(i)
1218 ENDDO
1219C---------KEIJ---J=N1,I=NM(j)----------------
1220 DO i=1,nnod1
1221 IF (n1==nm(i)) THEN
1222 DO j=1,nd
1223 k_diag(j,n1) = k_diag(j,n1)-kev1(j)-kevs(j)
1224 ENDDO
1225 ELSEIF (n2==nm(i)) THEN
1226 DO j=1,nd
1227 k_diag(j,n2) = k_diag(j,n2)-kev2(j)-kevs(j)
1228 ENDDO
1229 ELSEIF (n3==nm(i)) THEN
1230 DO j=1,nd
1231 k_diag(j,n3) = k_diag(j,n3)+kev1(j)
1232 ENDDO
1233 ELSEIF (nnod==4.AND.n4==nm(i)) THEN
1234 DO j=1,nd
1235 k_diag(j,n4) = k_diag(j,n4)+kev2(j)
1236 ENDDO
1237 ENDIF
1238 ENDDO
1239C
1240 RETURN

◆ monv_m3()

subroutine monv_m3 ( integer, dimension(*) monvol,
volmon,
x,
type(surf_), dimension(nsurf) igrsurf,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
a_mv,
ar_mv,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
integer, dimension(*) inloc,
integer iprec,
integer, dimension(*) ibfv,
skew,
xframe,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
frbe3,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 611 of file monv_imp0.F.

616C-----------------------------------------------
617C M o d u l e s
618C-----------------------------------------------
619 USE imp_monv
620 USE intbufdef_mod
621 USE groupdef_mod
622C-----------------------------------------------
623C I m p l i c i t T y p e s
624C-----------------------------------------------
625#include "implicit_f.inc"
626C-----------------------------------------------
627C C o m m o n B l o c k s
628C-----------------------------------------------
629#include "com04_c.inc"
630#include "param_c.inc"
631C-----------------------------------------------
632C D u m m y A r g u m e n t s
633C-----------------------------------------------
634 INTEGER NMONV,IMONV(*),MONVOL(*),
635 . IPARI(NPARI,*), NDOF(*),IDDL(*),IKC(*),
636 . INLOC(*),IPREC,IBFV(*),IRBE3(NRBE3L,*),LRBE3(*),
637 . IRBE2(NRBE2L,*),LRBE2(*)
638C REAL
639 my_real
640 . x(3,*),a_mv(3,*),ar_mv(3,*), volmon(*) ,
641 . skew(*) ,xframe(*),frbe3(*)
642
643 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
644 TYPE(SURF_) ,DIMENSION(NSURF) :: IGRSURF
645C-----------------------------------------------
646C L o c a l V a r i a b l e s
647C-----------------------------------------------
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
650C----------------
651 CALL id_mvini(ipari ,intbuf_tab,ndof ,iddl ,ikc ,
652 1 inloc ,x ,skew ,irbe3 ,lrbe3 ,
653 2 frbe3 ,irbe2 ,lrbe2 )
654 IF (iprec<2) RETURN
655 CALL zeror(a_mv,numnod)
656 CALL monv_kd(monvol ,volmon ,x ,igrsurf ,
657 1 nmonv ,imonv ,a_mv ,nnmax_mv)
658 nkin = nrb_mv+ni2_mv+nfx_mv+nbc_mv+nrw_mv+nrbe3_mv+nspc_mv
659 . +nrbe2_mv
660 IF (nkin>0) THEN
661 IF ((nrb_mv+ni2_mv+nrbe3_mv+nspc_mv+nrbe2_mv)>0)
662 . CALL zeror(ar_mv,numnod)
663 CALL updk_mv(ndof ,ipari ,intbuf_tab,ni2_mv ,
664 . ii2_mv ,nrb_mv ,irb_mv ,nfx_mv,ifx_mv ,
665 . nbc_mv ,ibc_mv ,nrw_mv ,irw_mv,ibfv ,
666 . skew ,xframe ,x ,a_mv ,ar_mv ,
667 . nrbe3_mv,irbe3_mv,irbe3 ,lrbe3 ,fcdi_mv,
668 . mcdi_mv ,diag_mvm3,r3m_max,nspc_mv,ispc_mv,
669 . nrbe2_mv,irbe2_mv,irbe2 ,lrbe2 )
670 ENDIF
671C-----initialise diag_mv-----------
672 nd = 0
673 DO i = 1, numn_mv
674 n = in_mv(i)
675 DO j = 1, min(3,ndof(n))
676 id = id_mv(j,i)
677 IF (id>0) diag_mv(j,i)=a_mv(j,n)
678 ENDDO
679 ENDDO
680C
681 DO i = 1, nrb_mv
682 n = irb_mv(1,i)
683 DO j = 1, ndof(n)
684 id = id_mvm(j,i)
685 IF (id>0) THEN
686 IF (j<=3) THEN
687 diag_mvm(j,i)=a_mv(j,n)
688 ELSE
689 diag_mvm(j,i)=ar_mv(j-3,n)
690 ENDIF
691 ENDIF
692 ENDDO
693 ENDDO
694C
695 DO i=1,ni2_mv
696 n=ii2_mv(1,i)
697 ni=ii2_mv(2,i)
698 ji=ipari(1,n)
699 nsn=ipari(5,n)
700 k10=ji-1
701 k11=k10+4*ipari(3,n)
702C------IRECT(4,NSN)-----
703 k12=k11+4*ipari(4,n)
704C------NSV(NSN)--node number---
705 k13=k12+nsn
706C------MSR(NMN)-----
707 k14=k13+ipari(6,n)
708 l=intbuf_tab(n)%IRTLM(ni)
709 nl=4*(l-1)
710 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
711 nnod=3
712 ELSE
713 nnod=4
714 ENDIF
715C-------si noeud main est dependant aussi-----
716 DO m=1,nnod
717 nj=intbuf_tab(n)%IRECTM(nl+m)
718 DO j = 1, ndof(nj)
719 id = id_mvm2(j,m,i)
720 IF (id>0) THEN
721 IF (j<=3) THEN
722 diag_mvm2(j,m,i)=a_mv(j,nj)
723 ELSE
724 diag_mvm2(j,m,i)=ar_mv(j-3,nj)
725 ENDIF
726 ENDIF
727 ENDDO
728 ENDDO
729 ENDDO
730C-------RBE3-----------
731 DO i=1,nrbe3_mv
732 n=irbe3_mv(i)
733 nnod=irbe3(5,n)
734 iad=irbe3(1,n)
735C-------
736 DO m=1,nnod
737 nj=lrbe3(iad+m)
738 DO j = 1 , ndof(nj)
739 id = id_mvm3(j,m,i)
740 IF (id>0) THEN
741 IF (j<=3) THEN
742 diag_mvm3(j,m,i)=a_mv(j,nj)
743 ELSE
744 diag_mvm3(j,m,i)=ar_mv(j-3,nj)
745 ENDIF
746 ENDIF
747 ENDDO
748 ENDDO
749 ENDDO
750C--------RBE2----------
751 DO i = 1, nrbe2_mv
752 n = irbe2_mv(1,i)
753 m = irbe2(3,n)
754 DO j = 1, ndof(m)
755 id = id_mvm4(j,i)
756 IF (id>0) THEN
757 IF (j<=3) THEN
758 diag_mvm4(j,i)=a_mv(j,m)
759 ELSE
760 diag_mvm4(j,i)=ar_mv(j-3,m)
761 ENDIF
762 ENDIF
763 ENDDO
764 ENDDO
765C
766 RETURN
id_mvini
subroutine id_mvini(ipari, intbuf_tab, ndof, iddl, ikc, inloc, x, skew, irbe3, lrbe3, frbe3, irbe2, lrbe2)
Definition monv_imp0.F:781
monv_kd
subroutine monv_kd(monvol, volmon, x, igrsurf, nmonv, imonv, k_diag, nnmax_mv)
Definition monv_imp0.F:959
updk_mv
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)
Definition monv_imp0.F:1269
imp_monv::r3m_max
integer r3m_max
Definition impbufdef_mod.F:343
imp_monv::nnmax_mv
integer nnmax_mv
Definition impbufdef_mod.F:343
zeror
subroutine zeror(a, n)
Definition zero.F:39

◆ monv_prem()

subroutine monv_prem ( integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) monvol,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(nspmd+2,nvolu) fr_mv,
integer, dimension(*) itag,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer nrbyac,
integer, dimension(*) irbyac,
integer nint2,
integer, dimension(*) iint2,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) ndof,
integer iprec0,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 35 of file monv_imp0.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE imp_monv
44 USE intbufdef_mod
45 USE groupdef_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "param_c.inc"
56#include "task_c.inc"
57#include "units_c.inc"
58#include "impl1_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
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(*)
67C REAL
68
69 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
70 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I, NTYP,NN,K1,IAD,IS,J,N,NOD,NUMN,ID,NMT,IROT,
75 . IERR1,IERR2,IERR3,IERR4,IERR5,IERR6
76C-------IMONV(NMONV)--nb de noeuds dans chaque mv.----------------------
77 nmonv = 0
78 IF(nvolu>0.AND.impmv>0) THEN
79 DO n=1,numnod
80 itag(n) = 0
81 ENDDO
82 numn_mv = 0
83 nnmax_mv = 0
84 k1 = 1
85 DO i=1,nvolu
86 ntyp=monvol(k1+1)
87 imonv(i)=0
88 IF(ntyp==3) THEN
89 IF(fr_mv(ispmd+1,i)==0) GO TO 100
90 is = monvol(k1+3)
91 nn = igrsurf(is)%NSEG
92 numn = numn_mv
93 IF(nn>0) THEN
94 DO j=1,nn
95 DO n=1,4
96 nod = igrsurf(is)%NODES(j,n)
97 IF (itag(nod)==0) THEN
98 numn_mv = numn_mv + 1
99 itag(nod) = numn_mv
100 ENDIF
101 ENDDO
102 ENDDO
103 nnmax_mv = max(nnmax_mv,nn)
104 ENDIF
105 imonv(i)=numn_mv - numn
106 IF (imonv(i)>0) nmonv = nmonv+1
107 ELSEIF (neig==zero) THEN
108 IF(ispmd==0) THEN
109 WRITE(iout,1001)ntyp
110 WRITE(istdo,1001)ntyp
111 ENDIF
112 ENDIF
113 100 CONTINUE
114 k1 = k1 + nimv
115 ENDDO
116 ENDIF
117C--------allocation------
118 IF (nmonv == 0) RETURN
119C
120 ALLOCATE(in_mv(numn_mv),id_mv(3,numn_mv),stat=ierr1)
121 DO i=1,numnod
122 j = itag(i)
123 IF (j>0) in_mv(j) = i
124 ENDDO
125 CALL dim_kinmv(
126 1 npby ,lpby ,nrbyac ,irbyac ,nint2 ,
127 2 iint2 ,ipari ,intbuf_tab,itag ,nrb_mv ,
128 3 ni2_mv ,irbe3 ,nrbe3_mv ,irbe2 ,lrbe2 ,
129 4 nrbe2_mv )
130 IF (ni2_mv>0) THEN
131 ALLOCATE(ii2_mv(2,ni2_mv),id_mvm2(6,4,ni2_mv),stat=ierr2)
132 ENDIF
133 IF (nrb_mv>0) THEN
134 ALLOCATE(irb_mv(2,nrb_mv),id_mvm(6,nrb_mv),stat=ierr4)
135 ENDIF
136 IF (nrbe3_mv>0) THEN
137 ALLOCATE(irbe3_mv(nrbe3_mv),stat=ierr3)
138 ENDIF
139 IF (nrbe2_mv>0) THEN
140 ALLOCATE(irbe2_mv(2,nrbe2_mv),id_mvm4(6,nrbe2_mv),stat=ierr3)
141 id_mvm4=0
142 ENDIF
143 CALL ini_kinmv(
144 1 npby ,lpby ,nrbyac ,irbyac ,nint2 ,
145 2 iint2 ,ipari ,intbuf_tab,itag ,nrb_mv ,
146 3 irb_mv ,ni2_mv ,ii2_mv ,irbe3 ,nrbe3_mv ,
147 4 irbe3_mv ,irbe2 ,lrbe2 ,nrbe2_mv ,irbe2_mv )
148C-----------ini RBE3
149 IF (nrbe3_mv>0) THEN
150 iad=0
151 nmt = 0
152 irot=0
153 DO i=1,nrbe3_mv
154 n=irbe3_mv(i)
155 numn = irbe3(5,n)
156 iad=max(iad,numn)
157 nmt = nmt + numn
158 irot=max(irot,irbe3(6,n))
159 ENDDO
160 ALLOCATE(id_mvm3(6,iad,nrbe3_mv),stat=ierr3)
161 id_mvm3=0
162 r3m_max=iad
163 ALLOCATE(fcdi_mv(18*nmt),stat=ierr5)
164 fcdi_mv=zero
165 IF (irot>0) THEN
166 ALLOCATE(mcdi_mv(18*nmt),stat=ierr5)
167 mcdi_mv=zero
168 ENDIF
169 ENDIF
170 IF (iprec >= 2) THEN
171 ALLOCATE(diag_mv(3,numn_mv),stat=ierr2)
172 diag_mv=zero
173 IF (ni2_mv>0) ALLOCATE(diag_mvm2(6,4,ni2_mv),stat=ierr5)
174 IF (nrb_mv>0) ALLOCATE(diag_mvm(6,nrb_mv),stat=ierr6)
175 IF (nrbe3_mv>0) THEN
176 ALLOCATE(diag_mvm3(6,r3m_max,nrbe3_mv),stat=ierr5)
177 diag_mvm3=zero
178 ENDIF
179 IF (nrbe2_mv>0) THEN
180 ALLOCATE(diag_mvm4(6,nrbe2_mv),stat=ierr5)
181 diag_mvm4=zero
182 ENDIF
183 ENDIF
184C
185 1001 FORMAT(5x,'*****WARNING : IMPLICIT OPTION IS NOT AVAILABLE',
186 . ' WITH MONITORED VOLUME TYPE:',i3/,5x,
187 . '****** IT WILL BE IGNORED *****')
188 RETURN
dim_kinmv
subroutine dim_kinmv(npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, lns, lns2, irbe3, lns3, irbe2, lrbe2, lns4)
Definition monv_imp0.F:202
ini_kinmv
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)
Definition monv_imp0.F:309

◆ mv_matv()

subroutine mv_matv ( integer, dimension(*) monvol,
volmon,
x,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(nspmd+2,*) fr_mv,
integer nmonv,
integer, dimension(*) imonv,
u,
f,
integer, dimension(*) ndof,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
a,
ar,
x_imp,
integer, dimension(*) ibfv,
skew,
xframe,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 1768 of file monv_imp0.F.

1773C-----------------------------------------------
1774C M o d u l e s
1775C-----------------------------------------------
1776 USE imp_monv
1777 USE intbufdef_mod
1778 USE groupdef_mod
1779C-----------------------------------------------
1780C I m p l i c i t T y p e s
1781C-----------------------------------------------
1782#include "implicit_f.inc"
1783C-----------------------------------------------
1784C C o m m o n B l o c k s
1785C-----------------------------------------------
1786#include "com01_c.inc"
1787#include "com04_c.inc"
1788#include "param_c.inc"
1789C-----------------------------------------------
1790C D u m m y A r g u m e n t s
1791C-----------------------------------------------
1792 INTEGER NMONV,IMONV(*),MONVOL(*),
1793 . IPARI(*) ,NDOF(*),FR_MV(NSPMD+2,*),
1794 . IBFV(*),IRBE3(*) ,LRBE3(*),IRBE2(*) ,LRBE2(*)
1795 my_real
1796 . x(3,*),a(3,*),ar(3,*), volmon(*) ,f(*), u(*),
1797 . x_imp(3,*),skew(*) ,xframe(*)
1798
1799 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1800 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
1801C-----------------------------------------------
1802C L o c a l V a r i a b l e s
1803C-----------------------------------------------
1804 INTEGER I, J,N,K,K1,KK1,N1,N2,N3,N4,ID,IAD,IS,NN,NTY
1805 my_real
1806 . temp,vol ,nor(3,nnmax_mv),
1807 . xx,yy,zz,x12,y12,z12,x13,y13,z13,x24,y24,z24,
1808 . fni(3),dpi,dpres
1809C----------------actualise X---------------------
1810 CALL imp3_u2x(x ,ipari ,intbuf_tab,ndof ,
1811 . u ,a ,ar ,x_imp ,numn_mv,
1812 . in_mv ,id_mv ,nrb_mv ,irb_mv,id_mvm ,
1813 . ni2_mv,ii2_mv ,id_mvm2,nfx_mv,ifx_mv ,
1814 . nbc_mv,ibc_mv ,nrw_mv,irw_mv ,ibfv ,
1815 . skew ,xframe ,irbe3 ,lrbe3 ,nrbe3_mv,
1816 . irbe3_mv,id_mvm3,r3m_max,fcdi_mv,mcdi_mv,
1817 . nspc_mv,ispc_mv,irbe2 ,lrbe2 ,nrbe2_mv,
1818 . irbe2_mv,id_mvm4)
1819 CALL zeror(a,numnod)
1820 IF ((nrb_mv+ni2_mv+nrbe3_mv+nspc_mv+nrbe2_mv)>0)
1821 . CALL zeror(ar,numnod)
1822C-----------calcul VOL,PRESS------
1823 k1 = 1
1824 kk1 = 1
1825 DO i=1,nvolu
1826 IF(imonv(i)>0) THEN
1827 is = monvol(k1+3)
1828 nn = igrsurf(is)%NSEG
1829 vol = 0
1830 DO j=1,nn
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)
1848 ENDDO
1849 IF (nspmd > 1) THEN
1850 temp = vol
1851 CALL spmd_fr_poff(fr_mv(1,i),temp,1)
1852 vol = temp
1853 ENDIF
1854 CALL imp_pvga(monvol(k1),volmon(kk1),vol ,dpres)
1855C-----------noeud independant -> W------
1856 IF (dpres/=zero) THEN
1857 DO j=1,nn
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)
1863 IF (nty==7) THEN
1864 dpi = dpres*third
1865 DO k = 1,3
1866 fni(k)=dpi*nor(k,j)
1867 ENDDO
1868 DO k = 1,3
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)
1872 ENDDO
1873 ELSE
1874 dpi = dpres*fourth
1875 DO k = 1,3
1876 fni(k)=dpi*nor(k,j)
1877 ENDDO
1878 DO k = 1,3
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)
1883 ENDDO
1884 ENDIF
1885 ENDDO
1886 ENDIF
1887 ENDIF
1888 k1 = k1 + nimv
1889 kk1 = kk1 + nrvolu
1890 ENDDO
1891 CALL imp3_a2b(ipari ,intbuf_tab,ndof ,x_imp ,
1892 . a ,ar ,numn_mv,in_mv,id_mv ,
1893 . nrb_mv ,irb_mv ,id_mvm ,ni2_mv,ii2_mv,
1894 . id_mvm2,nfx_mv ,ifx_mv ,nbc_mv,ibc_mv,
1895 . nrw_mv ,irw_mv ,ibfv ,skew ,xframe,
1896 . f ,irbe3 ,lrbe3 ,nrbe3_mv,irbe3_mv,
1897 . id_mvm3,r3m_max,fcdi_mv,mcdi_mv ,nspc_mv,
1898 . ispc_mv,irbe2 ,lrbe2 ,nrbe2_mv,irbe2_mv,
1899 . id_mvm4)
1900 RETURN
imp3_a2b
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)
Definition monv_imp0.F:2331
imp_pvga
subroutine imp_pvga(ivolu, rvolu, vol, dpres)
Definition monv_imp0.F:2235
imp3_u2x
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)
Definition monv_imp0.F:1934
spmd_fr_poff
subroutine spmd_fr_poff(fr_wall, fs, len)
Definition spmd_fr_poff.F:34

◆ recu_kdis()

subroutine recu_kdis ( integer, dimension(*) ndof,
d )

Definition at line 2550 of file monv_imp0.F.

2551C-----------------------------------------------
2552C M o d u l e s
2553C-----------------------------------------------
2554 USE imp_monv
2555C-----------------------------------------------
2556C I m p l i c i t T y p e s
2557C-----------------------------------------------
2558#include "implicit_f.inc"
2559C-----------------------------------------------
2560C D u m m y A r g u m e n t s
2561C-----------------------------------------------
2562 INTEGER NDOF(*)
2563 my_real d(3,*)
2564C-----------------------------------------------
2565C L o c a l V a r i a b l e s
2566C-----------------------------------------------
2567 INTEGER I,J,N,ND
2568C---------------------------------
2569 DO i = 1, numn_mv
2570 n = in_mv(i)
2571 DO j = 1, 3
2572 nd = id_mv(j,i)
2573 IF (nd==-1) THEN
2574 d(j,n) = zero
2575 ENDIF
2576 ENDDO
2577 ENDDO
2578C
2579 RETURN

◆ updk_mv()

subroutine updk_mv ( integer, dimension(*) ndof,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer ni2_mv,
integer, dimension(2,*) ii2_mv,
integer nrb_mv,
integer, dimension(2,*) irb_mv,
integer nfx_mv,
integer, dimension(2,*) ifx_mv,
integer nbc_mv,
integer, dimension(3,*) ibc_mv,
integer nrw_mv,
integer, dimension(*) irw_mv,
integer, dimension(nifv,*) ibfv,
skew,
xframe,
x,
a,
ar,
integer nrbe3_mv,
integer, dimension(*) irbe3_mv,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
fcdi_mv,
mcdi_mv,
diag_m3,
integer maxr3,
integer nspc_mv,
integer, dimension(*) ispc_mv,
integer nrbe2_mv,
integer, dimension(2,*) irbe2_mv,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 1262 of file monv_imp0.F.

1269C-----------------------------------------------
1270C M o d u l e s
1271C-----------------------------------------------
1272 USE imp_rwl
1273 USE imp_aspc
1274 USE intbufdef_mod
1275C-----------------------------------------------
1276C I m p l i c i t T y p e s
1277C-----------------------------------------------
1278#include "implicit_f.inc"
1279C-----------------------------------------------
1280C C o m m o n B l o c k s
1281C-----------------------------------------------
1282#include "param_c.inc"
1283C-----------------------------------------------
1284C D u m m y A r g u m e n t s
1285C-----------------------------------------------
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(*)
1292 my_real
1293 . a(3,*),ar(3,*),x(3,*),skew(lskew,*),xframe(nxframe,*),
1294 . fcdi_mv(*),mcdi_mv(*),diag_m3(6,maxr3,*)
1295
1296 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1297C-----------------------------------------------
1298C L o c a l V a r i a b l e s
1299C-----------------------------------------------
1300 INTEGER I,ID,N,J,NDD,IS,NS,ILEV,J10,J11,J12,J21
1301 INTEGER M,NSN,JI,L,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
1304 my_real
1305 . xs,ys,zs,xs2,ys2,zs2,kss(6),kjj(6,4),kii(3,3),ej(3),s,
1306 . kdd(6,6),kmm(6)
1307C-----------------------------------------------
1308C S o u r c e L i n e s
1309C-----------------------------------------------
1310C--------local secnd node-,d'abord independant----
1311 DO i=1,ni2_mv
1312 n=ii2_mv(1,i)
1313 ni=ii2_mv(2,i)
1314 ji=ipari(1,n)
1315 nsn=ipari(5,n)
1316 l=intbuf_tab(n)%IRTLM(ni)
1317 nl=4*(l-1)
1318 ns=intbuf_tab(n)%NSV(ni)
1319 ilev =ipari(20,n)
1320 j10=ipari(2,n)
1321 j11=j10+1
1322 j12=j11+nparir
1323 j21=j12+2*nsn
1324 DO j=1,3
1325 kss(j) = a(j,ns)
1326 kss(j+3) = zero
1327 ENDDO
1328 DO m=1,4
1329 DO j=1,6
1330 kjj(j,m) = zero
1331 ENDDO
1332 ENDDO
1333 IF (ilev==1) THEN
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 )
1337 ELSE
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 )
1341 ENDIF
1342 DO m=1,4
1343 nj=intbuf_tab(n)%IRECTM(nl+m)
1344 DO j = 1 , 3
1345 a(j,nj) = a(j,nj) + kjj(j,m)
1346 ENDDO
1347 IF (ndof(nj)>3) THEN
1348 DO j = 1 , 3
1349 ar(j,nj) = ar(j,nj) + kjj(j+3,m)
1350 ENDDO
1351 ENDIF
1352 ENDDO
1353 ENDDO
1354C--------RBE2-----------
1355 DO i = 1, nrbe2_mv
1356 n = irbe2_mv(1,i)
1357 m = irbe2(3,n)
1358 ns = irbe2_mv(2,i)
1359 isk = irbe2(7,n)
1360 irad =irbe2(11,n)
1361 ic = irbe2(4,n)
1362 ic =(ic/512)*512
1363 CALL prerbe2fr(ic ,jt ,jr )
1364 DO k=1,6
1365 DO j=1,6
1366 kdd(k,j) = zero
1367 ENDDO
1368 kmm(k)= zero
1369 kss(k)= zero
1370 ENDDO
1371 DO j=1,3
1372 kdd(j,j) = a(j,ns)
1373 ENDDO
1374 IF (ndof(ns)>3) THEN
1375 DO j = 1 , 3
1376 kdd(j+3,j+3) = ar(j,ns)
1377 ENDDO
1378 ENDIF
1379 CALL rbe2_impkd(m ,ns ,x ,isk ,jt ,
1380 2 jr ,ndof ,skew(1,isk),kdd ,kmm ,
1381 3 kss ,irad )
1382C--------for the moment, A(J,NS) will be not transfert
1383 DO j = 1 , 3
1384 a(j,m) = a(j,m) + kmm(j)
1385 a(j,ns) = a(j,ns) + kss(j)
1386 ENDDO
1387 IF (ndof(m)>3) THEN
1388 DO j = 1 , 3
1389 ar(j,m) = ar(j,m) + kmm(j+3)
1390 ENDDO
1391 ENDIF
1392 IF (ndof(ns)>3) THEN
1393 DO j = 1 , 3
1394 ar(j,ns) = ar(j,ns) + kss(j+3)
1395 ENDDO
1396 ENDIF
1397 ENDDO
1398C------RBE3---
1399 iads=1
1400 DO i=1,nrbe3_mv
1401 n=irbe3_mv(i)
1402 ns=irbe3(3,n)
1403 nnod=irbe3(5,n)
1404 irot=irbe3(6,n)
1405 iad=irbe3(1,n)
1406C--------
1407 DO j=1,3
1408 kss(j) = a(j,ns)
1409 kss(j+3) = zero
1410 ENDDO
1411 CALL prerbe3fr(irbe3 ,n ,jt ,jr )
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))
1415 iads=iads+nnod
1416 DO m=1,nnod
1417 nj=lrbe3(iad+m)
1418 DO j = 1 , 3
1419 a(j,nj) = a(j,nj) + diag_m3(j,m,i)
1420 ENDDO
1421 IF (irot>0.AND.ndof(nj)>3) THEN
1422 DO j = 1 , 3
1423 ar(j,nj) = ar(j,nj) + diag_m3(j+3,m,i)
1424 ENDDO
1425 ENDIF
1426 ENDDO
1427 ENDDO
1428C
1429 DO i = 1, nrb_mv
1430 m = irb_mv(1,i)
1431 n = irb_mv(2,i)
1432 xs=x(1,n)-x(1,m)
1433 ys=x(2,n)-x(2,m)
1434 zs=x(3,n)-x(3,m)
1435 DO j=1,3
1436 a(j,m) = a(j,m)+a(j,n)
1437 ENDDO
1438 xs2=xs*xs
1439 ys2=ys*ys
1440 zs2=zs*zs
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
1444 ENDDO
1445 DO i1 = 1,nbc_mv
1446 n = ibc_mv(1,i1)
1447 isk= ibc_mv(2,i1)
1448 ict= ibc_mv(3,i1)
1449 kii(1,1)=a(1,n)
1450 kii(2,2)=a(2,n)
1451 kii(3,3)=a(3,n)
1452 kii(1,2)=zero
1453 kii(1,3)=zero
1454 kii(2,3)=zero
1455 kii(2,1)=kii(1,2)
1456 kii(3,1)=kii(1,3)
1457 kii(3,2)=kii(2,3)
1458 CALL bcl_impkd(ict ,isk ,skew ,kii ,a(1,n) )
1459 ENDDO
1460 DO i1 = 1,nspc_mv
1461 n = ispc_mv(i1)
1462 i = in_spc(n)
1463 ir = 0
1464 iad = 6*(n-1)+1
1465 nn = ic_spc(n)
1466 IF (nn>3) THEN
1467 nn= nn-3
1468 ir = 1
1469 ENDIF
1470 IF (ir==0) THEN
1471 kii(1,1)=a(1,i)
1472 kii(2,2)=a(2,i)
1473 kii(3,3)=a(3,i)
1474 kii(1,2)=zero
1475 kii(1,3)=zero
1476 kii(2,3)=zero
1477 kii(2,1)=kii(1,2)
1478 kii(3,1)=kii(1,3)
1479 kii(3,2)=kii(2,3)
1480 IF (nn==1) THEN
1481 ej(1)=skew_spc(iad)
1482 ej(2)=skew_spc(iad+1)
1483 ej(3)=skew_spc(iad+2)
1484 CALL l_dir(ej,j)
1485 CALL fv_updkd(ej ,j ,kii ,a(1,i))
1486 ELSEIF (nn==2) THEN
1487 CALL fv_updkd2(skew_spc(iad),skew_spc(iad+3),kii ,a(1,i))
1488 END IF
1489 ELSE
1490 kii(1,1)=ar(1,i)
1491 kii(2,2)=ar(2,i)
1492 kii(3,3)=ar(3,i)
1493 kii(1,2)=zero
1494 kii(1,3)=zero
1495 kii(2,3)=zero
1496 kii(2,1)=kii(1,2)
1497 kii(3,1)=kii(1,3)
1498 kii(3,2)=kii(2,3)
1499 IF (nn==1) THEN
1500 ej(1)=skew_spc(iad)
1501 ej(2)=skew_spc(iad+1)
1502 ej(3)=skew_spc(iad+2)
1503 CALL l_dir(ej,j)
1504 CALL fv_updkd(ej ,j ,kii ,ar(1,i))
1505 ELSEIF (nn==2) THEN
1506 CALL fv_updkd2(skew_spc(iad),skew_spc(iad+3),kii ,ar(1,i))
1507 END IF
1508 ENDIF
1509 ENDDO
1510C
1511 DO i1 = 1,nfx_mv
1512 n = ifx_mv(1,i1)
1513 j1= ifx_mv(2,i1)
1514 i=iabs(ibfv(1,n))
1515 isk=ibfv(2,n)/10
1516 ifm = ibfv(9,n)
1517 j=ibfv(2,n)
1518 IF (ifm<=1) j=j-10*isk
1519 k1=3*j-2
1520 k2=3*j-1
1521 k3=3*j
1522 IF (isk>1) THEN
1523 ej(1)=skew(k1,isk)
1524 ej(2)=skew(k2,isk)
1525 ej(3)=skew(k3,isk)
1526 ELSE
1527 ej(1)=xframe(k1,ifm)
1528 ej(2)=xframe(k2,ifm)
1529 ej(3)=xframe(k3,ifm)
1530 ENDIF
1531 s = one/ej(j1)
1532 DO nn =1,3
1533 ej(nn) = ej(nn)*s
1534 ENDDO
1535 kii(1,1)=a(1,i)
1536 kii(2,2)=a(2,i)
1537 kii(3,3)=a(3,i)
1538 kii(1,2)=zero
1539 kii(1,3)=zero
1540 kii(2,3)=zero
1541 kii(2,1)=kii(1,2)
1542 kii(3,1)=kii(1,3)
1543 kii(3,2)=kii(2,3)
1544 CALL fv_updkd(ej ,j1 ,kii ,a(1,i))
1545 ENDDO
1546 DO i1 = 1,nrw_mv
1547 n = irw_mv(i1)
1548 i = in_rwl(n)
1549 kii(1,1)=a(1,i)
1550 kii(2,2)=a(2,i)
1551 kii(3,3)=a(3,i)
1552 kii(1,2)=zero
1553 kii(1,3)=zero
1554 kii(2,3)=zero
1555 kii(2,1)=kii(1,2)
1556 kii(3,1)=kii(1,3)
1557 kii(3,2)=kii(2,3)
1558 ej(1)=nor_rwl(1,n)
1559 ej(2)=nor_rwl(2,n)
1560 ej(3)=nor_rwl(3,n)
1561 CALL l_dir(ej,j1)
1562 CALL fv_updkd(ej ,j1 ,kii ,a(1,i))
1563 ENDDO
1564C
1565 RETURN
fv_updkd2
subroutine fv_updkd2(skew, skew1, kdd, diag_k)
Definition bc_imp0.F:2515
bcl_impkd
subroutine bcl_impkd(ict, isk, skew, kdd, diag_k)
Definition bc_imp0.F:914
fv_updkd
subroutine fv_updkd(ej, j, kdd, diag_k)
Definition fv_imp0.F:1519
i2_frup1
subroutine i2_frup1(x, irect, dpara, nsv, irtl, ii, kii, kjj)
Definition i2_imp1.F:1792
i2_frup0
subroutine i2_frup0(x, irect, crst, nsv, irtl, ii, ndof, kss, k)
Definition i2_imp1.F:1702
rbe2_impkd
subroutine rbe2_impkd(m, ns, x, isk, jt, jr, ndof, skew0, kdd, diag_km, diag_kn, irad)
Definition rbe2_imp0.F:1645
rbe3_frupd
subroutine rbe3_frupd(nir, iml, fdstnb, mdstnb, ndof, jt, irot, kss, diag_m3)
Definition rbe3_imp0.F:1017