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

Go to the source code of this file.

Functions/Subroutines

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 imp_intdt (ipari, intbuf_tab, x, v, vr, isendto, irecvfrom, newfront, itask, dtk, itab, intlist, nbintc, dt_min, ms, nsensor, sensor_tab, maxdgap)
subroutine imp_icomcrit (intbuf_tab, ipari, newfront, isendto, ircvfrom, dt2t, itab, xslv_l, xmsr_l, vslv_l, vmsr_l, size_t, n, sensor_tab, intlist, nbintc, maxdgap, nsensor)
subroutine imp_inttd0 (output, timers, ipari, intbuf_tab, x, d, ms, itab, in, d_imp, dr_imp, imsch, i2msch, isizxv, ilenxv, igrbric, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, iad_elem, fr_elem, nbintc, intlist, itask, kinet, newfront, num_imp, ns_imp, ne_imp, ind_imp, isendto, irecvfrom, weight, ixs, temp, dt2prev, wa, num_imp1, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, ikine, diag_sms, count_remslv, count_remslve, nsensor, sensor_tab, xdp, h3d_data, multi_fvm, forneqs, maxdgap, interfaces, glob_therm)
subroutine imp_i11xv (x, nsv, msr, nsn, nmn, x_tmp, d, dr, v, vr, facd, facv)
subroutine imp_i7xv (x, nsv, msr, nsn, nmn, stfn, x_tmp, d, dr, v, vr, facd, facv)
subroutine imp_tripi (output, timers, ipari, intbuf_tab, x, d, v, ms, itab, vr, in, imsch, i2msch, isizxv, ilenxv, igrbric, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, iad_elem, fr_elem, nbintc, intlist, itask, kinet, newfront, num_imp, ns_imp, ne_imp, ind_imp, iad, isendto, irecvfrom, retri, weight, ixs, temp, dt2prev, wag, n, nty, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, ikine, diag_sms, count_remslv, count_remslve, sensor_tab, xdp, h3d_data, multi_fvm, forneqs, interfaces, nsensor, glob_therm)
subroutine cp_inttd (nt_imp1, numimp, ns_imp, ne_imp, ind_imp, numimp1)
subroutine sav_inttd (nt_imp, numimp, ns_imp, ne_imp, ind_imp, numimp1)
subroutine imp_rnumcd (cand_n, nin, nsn, num_imp, index)
subroutine imp_dtkin (ipari, intbuf_tab, x, v, vr, itab, d_imp, dr_imp, nbintc, intlist, itask, newfront, isendto, irecvfrom, iddl, ndof, ikc, scal, ms, nsensor, sensor_tab, maxdgap)
subroutine kin_knl (ipari, intbuf_tab, num_imp, ns_imp, ne_imp, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ibfv, lj, iskew, icodt, ndofi, iddl, ikc, ndof, inloc, irbe3, lrbe3, frbe3, x, skew, irbe2, lrbe2)
subroutine dim_kinkn (npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, ibfv, lj, iskew, icodt, lns, lns2, lbcl, lfxl, lrw, irbe3, lns3, lspcl, irbe2, lrbe2, lns4)
subroutine ini_kinkn (npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, ibfv, lj, iskew, icodt, nrb_mv, irb_mv, ni2_mv, ii2_mv, nbc_mv, ibc_mv, nfx_mv, ifx_mv, nrw_mv, irw_mv, irbe3, nrbe3_mv, irbe3_mv, nspc_mv, ispc_mv, irbe2, lrbe2, nrbe2_mv, irbe2_mv)
subroutine iddl_mint (nml, iml, iddl, ikc, ndof, iddlm, ipari, intbuf_tab, iddml, nrb_fr, ifrsr, iddmr, ni2_fr, ifrs2, iddmi2, irbe3, lrbe3, nrbe3_fr, ifrs3, iddmi3, m_max, irbe2, nrbe2_fr, ifrs4, iddmi4)
subroutine rbe3_mint (irbe3, lrbe3, frbe3, x, skew, nrbe3_kn, irbe3_kn, frcdi, mrcdi)
subroutine int_matv (ipari, intbuf_tab, ndof, num_imp, ns_imp, ne_imp, index2, a, ar, v, x, ms, x_imp, ibfv, skew, xframe, u, f, iupd, irbe3, lrbe3, irbe2, lrbe2)
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 int_fku3 (a, v, ms, d, ipari, intbuf_tab, x, num_imp, ns_imp, ne_imp, index2, iupd)
subroutine pr_kint (nddli, imconv, iadi, jdii, itok, diag_i, lt_i)

Function/Subroutine Documentation

◆ cp_inttd()

subroutine cp_inttd ( integer nt_imp1,
integer, dimension(*) numimp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) ind_imp,
integer, dimension(*) numimp1 )

Definition at line 1386 of file imp_int_k.F.

1387C-----------------------------------------------
1388C M o d u l e s
1389C-----------------------------------------------
1390 USE imp_inttd
1391C-----------------------------------------------
1392C I m p l i c i t T y p e s
1393C-----------------------------------------------
1394#include "implicit_f.inc"
1395C-----------------------------------------------
1396C C o m m o n B l o c k s
1397C-----------------------------------------------
1398#include "com04_c.inc"
1399C-----------------------------------------------
1400C D u m m y A r g u m e n t s
1401C-----------------------------------------------
1402 INTEGER NUMIMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
1403 . NUMIMP1(*),NT_IMP1
1404C-----------------------------------------------
1405C L o c a l V a r i a b l e s
1406C-----------------------------------------------
1407 INTEGER I,J,K,L,N,IAD,IAD1,IADT
1408 INTEGER IERROR1,IERROR2,IERROR3,IERROR4
1409C-----------------------------------------------
1410C S o u r c e L i n e s
1411C-----------------------------------------------
1412 IF(nt_imp1==0) RETURN
1413 IF(ALLOCATED(ns_imp1)) DEALLOCATE(ns_imp1)
1414 ALLOCATE(ns_imp1(nt_imp1),stat=ierror1)
1415 IF(ALLOCATED(ne_imp1)) DEALLOCATE(ne_imp1)
1416 ALLOCATE(ne_imp1(nt_imp1),stat=ierror2)
1417 IF(ALLOCATED(ind_imp1)) DEALLOCATE(ind_imp1)
1418 ALLOCATE(ind_imp1(nt_imp1),stat=ierror3)
1419 IF(ALLOCATED(iad1_nin)) DEALLOCATE(iad1_nin)
1420 ALLOCATE(iad1_nin(ninter),stat=ierror4)
1421C
1422 CALL cp_int(ninter,numimp,numimp1)
1423 CALL cp_int(nt_imp1,ns_imp,ns_imp1)
1424 CALL cp_int(nt_imp1,ne_imp,ne_imp1)
1425 CALL cp_int(nt_imp1,ind_imp,ind_imp1)
1426 iad1 = 0
1427 DO n = 1,ninter
1428 iad1_nin(n) =iad1
1429 iad1 =iad1 + numimp1(n)
1430 END DO
1431C
1432 RETURN
subroutine cp_int(n, x, xc)
Definition produt_v.F:916

◆ dim_kinkn()

subroutine dim_kinkn ( 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, dimension(nifv,*) ibfv,
integer, dimension(*) lj,
integer, dimension(*) iskew,
integer, dimension(*) icodt,
integer lns,
integer lns2,
integer lbcl,
integer lfxl,
integer lrw,
integer, dimension(nrbe3l,*) irbe3,
integer lns3,
integer lspcl,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer lns4 )

Definition at line 1860 of file imp_int_k.F.

1866C-----------------------------------------------
1867C M o d u l e s
1868C-----------------------------------------------
1869 USE imp_rwl
1870 USE imp_aspc
1871 USE intbufdef_mod
1872C-----------------------------------------------
1873C I m p l i c i t T y p e s
1874C-----------------------------------------------
1875#include "implicit_f.inc"
1876C-----------------------------------------------
1877C C o m m o n B l o c k s
1878C-----------------------------------------------
1879#include "com04_c.inc"
1880#include "param_c.inc"
1881C-----------------------------------------------
1882C D u m m y A r g u m e n t s
1883C-----------------------------------------------
1884 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
1885 . NINT2,IINT2(*),IPARI(NPARI,*)
1886 INTEGER IBFV(NIFV,*),LJ(*),ISKEW(*) ,ICODT(*),LSPCL
1887 INTEGER INLOC(*),LNS ,LNS2,LBCL ,LFXL ,LRW,IRBE3(NRBE3L,*),LNS3,
1888 . IRBE2(NRBE2L,*),LRBE2(*),LNS4
1889C REAL
1890
1891 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1892C-----------------------------------------------
1893C L o c a l V a r i a b l e s
1894C-----------------------------------------------
1895 INTEGER
1896 . I,J,K,N,L,NL,NJ,NI,J1,M,NSN,N1,N2,NK,ID,
1897 . JI,K10,K11,K12,K13,K14,KFI,NS
1898C----------------------------
1899 lns2=0
1900 DO j=1,nint2
1901 n=iint2(j)
1902 nsn = ipari(5,n)
1903 ji=ipari(1,n)
1904 k10=ji-1
1905 k11=k10+4*ipari(3,n)
1906C------IRECT(4,NSN)-----
1907 k12=k11+4*ipari(4,n)
1908C------NSV(NSN)--node number---
1909 k13=k12+nsn
1910C------MSR(NMN)-----
1911 k14=k13+ipari(6,n)
1912C------IRTL(NSN)--main el number---
1913 kfi=k14+nsn
1914 DO i=1,nsn
1915 ni=intbuf_tab(n)%NSV(i)
1916 IF (inloc(ni)>0) THEN
1917 lns2=lns2+1
1918 ENDIF
1919 ENDDO
1920 ENDDO
1921C--------RBE3--------------------
1922 lns3=0
1923 DO n=1,nrbe3
1924 ni = irbe3(3,n)
1925 IF (ni==0) cycle
1926 IF (inloc(ni)>0) THEN
1927 lns3=lns3+1
1928 ENDIF
1929 ENDDO
1930C-----active rigid body main nodes------
1931 lns=0
1932 DO j=1,nrbyac
1933 n=irbyac(j)
1934 k=irbyac(j+nrbykin)
1935 m =npby(1,n)
1936 nsn =npby(2,n)
1937 DO i=1,nsn
1938 id = i+k
1939 ni=lpby(id)
1940 IF (inloc(ni)>0) THEN
1941 lns=lns+1
1942 IF (inloc(m)==0) inloc(m) = 1
1943 ENDIF
1944 ENDDO
1945 ENDDO
1946C
1947 lbcl = 0
1948 DO n=1,numnod
1949 IF (iskew(n)>1.AND.icodt(n)/=7) THEN
1950 IF (inloc(n)>0)lbcl = lbcl + 1
1951 ENDIF
1952 ENDDO
1953 lspcl = 0
1954 DO n=1,nspcl
1955 IF (inloc(n)>0.AND.ic_spc(n)<=3)lspcl = lspcl + 1
1956 ENDDO
1957C ---
1958 lfxl = 0
1959 DO j=1,nfxvel
1960 IF (lj(j)>0.AND.lj(j)<=3) THEN
1961 n=iabs(ibfv(1,j))
1962 IF (inloc(n)>0)lfxl = lfxl + 1
1963 ENDIF
1964 ENDDO
1965C
1966 lrw = 0
1967 DO j=1,n_rwl
1968 n=in_rwl(j)
1969 IF (inloc(n)>0) lrw = lrw + 1
1970 ENDDO
1971C-----Rbe2------
1972 lns4=0
1973 DO n=1,nrbe2
1974 k=irbe2(1,n)
1975 m =irbe2(3,n)
1976 nsn =irbe2(5,n)
1977 DO i=1,nsn
1978 id = i+k
1979 ni=lrbe2(id)
1980 IF (inloc(ni)>0) THEN
1981 lns4=lns4+1
1982 IF (inloc(m)==0) inloc(m) = 2
1983 ENDIF
1984 ENDDO
1985 ENDDO
1986C----6---------------------------------------------------------------7---------8
1987 RETURN
initmumps id
integer, dimension(:), allocatable ic_spc
integer nspcl
integer, dimension(:), allocatable in_rwl
integer n_rwl

◆ iddl_mint()

subroutine iddl_mint ( integer nml,
integer, dimension(*) iml,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer, dimension(*) iddlm,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(3,*) iddml,
integer nrb_fr,
integer, dimension(2,*) ifrsr,
integer, dimension(6,*) iddmr,
integer ni2_fr,
integer, dimension(2,*) ifrs2,
integer, dimension(6,4,*) iddmi2,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
integer nrbe3_fr,
integer, dimension(*) ifrs3,
integer, dimension(6,m_max,*) iddmi3,
integer m_max,
integer, dimension(nrbe2l,*) irbe2,
integer nrbe2_fr,
integer, dimension(*) ifrs4,
integer, dimension(6,*) iddmi4 )

Definition at line 2189 of file imp_int_k.F.

2194C-----------------------------------------------
2195C M o d u l e s
2196C-----------------------------------------------
2197 USE intbufdef_mod
2198C-----------------------------------------------
2199C I m p l i c i t T y p e s
2200C-----------------------------------------------
2201#include "implicit_f.inc"
2202C-----------------------------------------------
2203C C o m m o n B l o c k s
2204C-----------------------------------------------
2205#include "param_c.inc"
2206C-----------------------------------------------
2207C D u m m y A r g u m e n t s
2208C-----------------------------------------------
2209 INTEGER NML,IML(*),IDDL(*) ,IKC(*) ,NDOF(*) ,IDDLM(*),M_MAX
2210 INTEGER IPARI(NPARI,*),IDDML(3,*),NRB_FR ,
2211 . IDDMR(6,*) ,NI2_FR ,IDDMI2(6,4,*) ,IFRSR(2,*),
2212 . IFRS2(2,*),IRBE3(NRBE3L,*),LRBE3(*),NRBE3_FR,IFRS3(*),
2213 . IDDMI3(6,M_MAX,*),IRBE2(NRBE2L,*),NRBE2_FR,IFRS4(*),
2214 . IDDMI4(6,*)
2215
2216 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2217C-----------------------------------------------
2218C L o c a l V a r i a b l e s
2219C-----------------------------------------------
2220 INTEGER I,ID,N,J,NDD,I1
2221 INTEGER M,NSN,JI,K10,K11,K12,K13,K14,L,NNOD,NJ,NL,NI,IAD
2222 INTEGER IERROR1,IERROR2,IERROR3,IERROR4,IERROR5,IERROR6
2223C-----------------------------------------------
2224C S o u r c e L i n e s
2225C-----------------------------------------------
2226C
2227 IF (nml>0) THEN
2228C--------initialization for ndof=0---
2229 DO i = 1, nml
2230 n = iml(i)
2231 ndd = 0
2232 DO j = 1 , min(3,ndof(n))
2233 id = iddl(n) + j
2234 IF (ikc(id)<1) THEN
2235 ndd = ndd + 1
2236 iddml(j,i) = iddlm(n) + ndd
2237 ELSE
2238 iddml(j,i) = -ikc(id)
2239 ENDIF
2240 ENDDO
2241 ENDDO
2242 ENDIF
2243C
2244 IF (nrb_fr>0) THEN
2245 DO i = 1, nrb_fr
2246 n = ifrsr(1,i)
2247 ndd = 0
2248 DO j = 1 , ndof(n)
2249 id = iddl(n) + j
2250 IF (ikc(id)<1) THEN
2251 ndd = ndd + 1
2252 iddmr(j,i) = iddlm(n) + ndd
2253 ELSE
2254 iddmr(j,i) = -ikc(id)
2255 ENDIF
2256 ENDDO
2257 ENDDO
2258 ENDIF
2259C
2260 IF (ni2_fr>0) THEN
2261 DO i=1,ni2_fr
2262 n=ifrs2(1,i)
2263 ni=ifrs2(2,i)
2264 ji=ipari(1,n)
2265 nsn=ipari(5,n)
2266 k10=ji-1
2267 k11=k10+4*ipari(3,n)
2268C------IRECT(4,NSN)-----
2269 k12=k11+4*ipari(4,n)
2270C------NSV(NSN)--node number---
2271 k13=k12+nsn
2272C------MSR(NMN)-----
2273 k14=k13+ipari(6,n)
2274 l=intbuf_tab(n)%IRTLM(ni)
2275 nl=4*(l-1)
2276 IF (intbuf_tab(n)%IRECTM(nl+3)==intbuf_tab(n)%IRECTM(nl+4)) THEN
2277 nnod=3
2278 ELSE
2279 nnod=4
2280 ENDIF
2281C------ SI Main node is also dependent -----
2282 DO m=1,nnod
2283 nj=intbuf_tab(n)%IRECTM(nl+m)
2284 ndd = 0
2285 DO j = 1 , ndof(nj)
2286 id = iddl(nj) + j
2287 IF (ikc(id)<1) THEN
2288 ndd = ndd + 1
2289 iddmi2(j,m,i) = iddlm(nj) + ndd
2290 ELSE
2291 iddmi2(j,m,i) = -ikc(id)
2292 ENDIF
2293 ENDDO
2294 ENDDO
2295 ENDDO
2296 ENDIF
2297C-------RBE3-----------
2298 IF (nrbe3_fr>0) THEN
2299 DO i=1,nrbe3_fr
2300 n=ifrs3(i)
2301 ni=irbe3(3,n)
2302 nnod=irbe3(5,n)
2303 iad=irbe3(1,n)
2304C-------
2305 DO m=1,nnod
2306 nj=lrbe3(iad+m)
2307 ndd = 0
2308 DO j = 1 , ndof(nj)
2309 id = iddl(nj) + j
2310 IF (ikc(id)<1) THEN
2311 ndd = ndd + 1
2312 iddmi3(j,m,i) = iddlm(nj) + ndd
2313 ELSE
2314 iddmi3(j,m,i) = -ikc(id)
2315 ENDIF
2316 ENDDO
2317 ENDDO
2318 ENDDO
2319 ENDIF
2320C------RBE2
2321 IF (nrbe2_fr>0) THEN
2322 DO i = 1, nrbe2_fr
2323 n = ifrsr(1,i)
2324 m = irbe2(3,n)
2325 ndd = 0
2326 DO j = 1 , ndof(m)
2327 id = iddl(m) + j
2328 IF (ikc(id)<1) THEN
2329 ndd = ndd + 1
2330 iddmi4(j,i) = iddlm(m) + ndd
2331 ELSE
2332 iddmi4(j,i) = -ikc(id)
2333 ENDIF
2334 ENDDO
2335 ENDDO
2336 ENDIF
2337C
2338 RETURN
#define min(a, b)
Definition macros.h:20
character *2 function nl()
Definition message.F:2360

◆ imp_dtkin()

subroutine imp_dtkin ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
x,
v,
vr,
integer, dimension(*) itab,
d_imp,
dr_imp,
integer nbintc,
integer, dimension(*) intlist,
integer itask,
integer, dimension(*) newfront,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) irecvfrom,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
scal,
ms,
integer, intent(in) nsensor,
type (sensor_str_), dimension(nsensor) sensor_tab,
maxdgap )

Definition at line 1590 of file imp_int_k.F.

1596C-----------------------------------------------
1597C M o d u l e s
1598C-----------------------------------------------
1599 USE intbufdef_mod
1600 USE sensor_mod
1601C-----------------------------------------------
1602C I m p l i c i t T y p e s
1603C-----------------------------------------------
1604#include "implicit_f.inc"
1605C-----------------------------------------------
1606C C o m m o n B l o c k s
1607C-----------------------------------------------
1608#include "com01_c.inc"
1609#include "com04_c.inc"
1610#include "com08_c.inc"
1611#include "param_c.inc"
1612#include "impl1_c.inc"
1613#include "task_c.inc"
1614C-----------------------------------------------
1615C D u m m y A r g u m e n t s
1616C-----------------------------------------------
1617 INTEGER ,INTENT(IN) :: NSENSOR
1618 INTEGER IPARI(NPARI,*), ITAB(*),
1619 . NEWFRONT(*),NBINTC,INTLIST(*),
1620 . ISENDTO(NINTER+1,*),IRECVFROM(NINTER+1,*),
1621 . ITASK
1622 INTEGER IDDL(*) ,NDOF(*),IKC(*)
1623 my_real
1624 . x(3,*), v(3,*),vr(3,*),
1625 . d_imp(3,*),dr_imp(3,*),scal,ms(*),
1626 . maxdgap(ninter)
1627
1628 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1629 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
1630C-----------------------------------------------
1631C L o c a l V a r i a b l e s
1632C-----------------------------------------------
1633 INTEGER N,I,J,ID,NTHR_CP
1634C REAL
1635 my_real
1636 . dtk(ninter),dti,dt_min
1637C-------------before inttri------
1638 scal = one
1639 IF (ittoff>0.OR.imconv==1.OR.imconv<=-2) RETURN
1640 nthr_cp = nthread
1641 IF (nthread>1) nthread = 1
1642 dti = one/dt2
1643 DO i=1,numnod
1644 v(1,i)=d_imp(1,i)*dti
1645 v(2,i)=d_imp(2,i)*dti
1646 v(3,i)=d_imp(3,i)*dti
1647 ENDDO
1648 IF (iroddl/=0) THEN
1649 DO i=1,numnod
1650 vr(1,i)=dr_imp(1,i)*dti
1651 vr(2,i)=dr_imp(2,i)*dti
1652 vr(3,i)=dr_imp(3,i)*dti
1653 ENDDO
1654 ENDIF
1655 CALL imp_intdt(
1656 1 ipari ,intbuf_tab ,x ,
1657 2 v ,vr ,isendto ,irecvfrom,
1658 4 newfront ,itask ,dtk ,itab ,
1659 5 intlist ,nbintc ,dt_min ,ms ,
1660 6 nsensor ,sensor_tab,maxdgap)
1661C
1662 scal = dt_min*dti
1663 IF (scal<one) THEN
1664 DO i=1,numnod
1665 d_imp(1,i)=d_imp(1,i)*scal
1666 d_imp(2,i)=d_imp(2,i)*scal
1667 d_imp(3,i)=d_imp(3,i)*scal
1668 ENDDO
1669 IF (iroddl/=0) THEN
1670 DO i=1,numnod
1671 dr_imp(1,i)=dr_imp(1,i)*scal
1672 dr_imp(2,i)=dr_imp(2,i)*scal
1673 dr_imp(3,i)=dr_imp(3,i)*scal
1674 ENDDO
1675 ENDIF
1676 ENDIF
1677C
1678 IF (nthr_cp>1) nthread = nthr_cp
1679C
1680 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine imp_intdt(ipari, intbuf_tab, x, v, vr, isendto, irecvfrom, newfront, itask, dtk, itab, intlist, nbintc, dt_min, ms, nsensor, sensor_tab, maxdgap)
Definition imp_int_k.F:391

◆ imp_i11xv()

subroutine imp_i11xv ( x,
integer, dimension(*) nsv,
integer, dimension(*) msr,
integer nsn,
integer nmn,
x_tmp,
d,
dr,
v,
vr,
facd,
facv )

Definition at line 910 of file imp_int_k.F.

914C-----------------------------------------------
915C I m p l i c i t T y p e s
916C-----------------------------------------------
917#include "implicit_f.inc"
918C-----------------------------------------------
919C C o m m o n B l o c k s
920C-----------------------------------------------
921#include "com01_c.inc"
922C-----------------------------------------------
923C D u m m y A r g u m e n t s
924C-----------------------------------------------
925 INTEGER NSN,NMN,NSV(*),MSR(*)
926 my_real
927 . x(3,*),v(3,*),vr(3,*),d(3,*),dr(3,*),
928 . x_tmp(3,*),facd,facv
929C-----------------------------------------------
930C L o c a l V a r i a b l e s
931C-----------------------------------------------
932 INTEGER I,J
933C REAL
934 my_real
935 . dx,dy,dz
936C------------------------------------
937 DO j=1,nsn
938 i=nsv(j)
939 IF (i>0) THEN
940 dx = d(1,i)*facd
941 dy = d(2,i)*facd
942 dz = d(3,i)*facd
943 x_tmp(1,i)=x(1,i) + dx
944 x_tmp(2,i)=x(2,i) + dy
945 x_tmp(3,i)=x(3,i) + dz
946 v(1,i)=d(1,i)*facv
947 v(2,i)=d(2,i)*facv
948 v(3,i)=d(3,i)*facv
949 END IF
950 END DO
951 DO j=1,nmn
952 i=msr(j)
953 IF (i>0) THEN
954 dx = d(1,i)*facd
955 dy = d(2,i)*facd
956 dz = d(3,i)*facd
957 x_tmp(1,i)=x(1,i) + dx
958 x_tmp(2,i)=x(2,i) + dy
959 x_tmp(3,i)=x(3,i) + dz
960 v(1,i)=d(1,i)*facv
961 v(2,i)=d(2,i)*facv
962 v(3,i)=d(3,i)*facv
963 END IF
964 END DO
965C
966 IF (iroddl/=0) THEN
967 DO j=1,nsn
968 i=nsv(j)
969 IF (i>0) THEN
970 vr(1,i)=dr(1,i)*facv
971 vr(2,i)=dr(2,i)*facv
972 vr(3,i)=dr(3,i)*facv
973 END IF
974 END DO
975 DO j=1,nmn
976 i=msr(j)
977 IF (i>0) THEN
978 vr(1,i)=dr(1,i)*facv
979 vr(2,i)=dr(2,i)*facv
980 vr(3,i)=dr(3,i)*facv
981 END IF
982 END DO
983 END IF
984C
985 RETURN

◆ imp_i7xv()

subroutine imp_i7xv ( x,
integer, dimension(*) nsv,
integer, dimension(*) msr,
integer nsn,
integer nmn,
stfn,
x_tmp,
d,
dr,
v,
vr,
facd,
facv )

Definition at line 992 of file imp_int_k.F.

996C-----------------------------------------------
997C I m p l i c i t T y p e s
998C-----------------------------------------------
999#include "implicit_f.inc"
1000C-----------------------------------------------
1001C C o m m o n B l o c k s
1002C-----------------------------------------------
1003#include "com01_c.inc"
1004C-----------------------------------------------
1005C D u m m y A r g u m e n t s
1006C-----------------------------------------------
1007 INTEGER NSN,NMN,NSV(*),MSR(*)
1008 my_real
1009 . x(3,*),v(3,*),vr(3,*),d(3,*),dr(3,*),
1010 . x_tmp(3,*),facd,facv,stfn(*)
1011C-----------------------------------------------
1012C L o c a l V a r i a b l e s
1013C-----------------------------------------------
1014 INTEGER I,J
1015C REAL
1016 my_real
1017 . dx,dy,dz
1018C------------------------------------
1019 DO j=1,nsn
1020 IF (stfn(j)/=zero) THEN
1021 i=nsv(j)
1022 dx = d(1,i)*facd
1023 dy = d(2,i)*facd
1024 dz = d(3,i)*facd
1025 x_tmp(1,i)=x(1,i) + dx
1026 x_tmp(2,i)=x(2,i) + dy
1027 x_tmp(3,i)=x(3,i) + dz
1028 v(1,i)=d(1,i)*facv
1029 v(2,i)=d(2,i)*facv
1030 v(3,i)=d(3,i)*facv
1031 END IF
1032 END DO
1033 DO j=1,nmn
1034 i=msr(j)
1035 IF (i>0) THEN
1036 dx = d(1,i)*facd
1037 dy = d(2,i)*facd
1038 dz = d(3,i)*facd
1039 x_tmp(1,i) = x(1,i) + dx
1040 x_tmp(2,i) = x(2,i) + dy
1041 x_tmp(3,i) = x(3,i) + dz
1042 v(1,i) = d(1,i)*facv
1043 v(2,i) = d(2,i)*facv
1044 v(3,i) = d(3,i)*facv
1045 END IF
1046 END DO
1047C
1048 IF (iroddl/=0) THEN
1049 DO j=1,nsn
1050 IF (stfn(j)/=zero) THEN
1051 i=nsv(j)
1052 vr(1,i)=dr(1,i)*facv
1053 vr(2,i)=dr(2,i)*facv
1054 vr(3,i)=dr(3,i)*facv
1055 END IF
1056 END DO
1057 DO j=1,nmn
1058 i=msr(j)
1059 IF (i>0) THEN
1060 vr(1,i)=dr(1,i)*facv
1061 vr(2,i)=dr(2,i)*facv
1062 vr(3,i)=dr(3,i)*facv
1063 END IF
1064 END DO
1065 END IF
1066C
1067 RETURN

◆ imp_icomcrit()

subroutine imp_icomcrit ( type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(npari,*) ipari,
integer, dimension(*) newfront,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
dt2t,
integer, dimension(*) itab,
xslv_l,
xmsr_l,
vslv_l,
vmsr_l,
size_t,
integer n,
type (sensor_str_), dimension(nsensor) sensor_tab,
integer, dimension(*) intlist,
integer nbintc,
maxdgap,
integer, intent(in) nsensor )

Definition at line 555 of file imp_int_k.F.

560C-----------------------------------------------
561C M o d u l e s
562C-----------------------------------------------
563 USE intbufdef_mod
564 USE sensor_mod
565C----6---------------------------------------------------------------7---------8
566C I m p l i c i t T y p e s
567C-----------------------------------------------
568#include "implicit_f.inc"
569C-----------------------------------------------
570C C o m m o n B l o c k s
571C-----------------------------------------------
572#include "param_c.inc"
573#include "com01_c.inc"
574#include "com04_c.inc"
575#include "com08_c.inc"
576C-----------------------------------------------------------------
577C D u m m y A r g u m e n t s
578C-----------------------------------------------
579 INTEGER ,INTENT(IN) :: NSENSOR
580 INTEGER IPARI(NPARI,*), NEWFRONT(*), ITAB(*),
581 . ISENDTO(NINTER+1,*) ,IRCVFROM(NINTER+1,*),N,
582 . NBINTC,INTLIST(*)
583C REAL
584 my_real
585 . dt2t,xslv_l(6,*), xmsr_l(6,*), vslv_l(6,*),
586 .vmsr_l(6,*), size_t(*),maxdgap(ninter)
587
588 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
589 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
590C-----------------------------------------------
591C L o c a l V a r i a b l e s
592C-----------------------------------------------
593 INTEGER I,J,IAD,K,IADD, NBNEW, LISTNEW(1),
594 . INTERACT,ISENS
595 my_real
596 . xx,xy,xz,dist0,vx,vy,vz,gapinf,vv,dti,
597 . minbox,
598 . startt, stopt, tzinf(1), ts,pmax(ninter)
599 INTEGER :: NTY
600C-----------------------------------------------
601C External function
602C-----------------------------------------------
603 LOGICAL INTAB
604 EXTERNAL intab
605C
606C
607C Pre-calculation of useful interfaces
608C
609 DO j=1,ninter
610 pmax=zero
611 END DO
612 nbnew = 0
613 i = n
614 nty= ipari(7,i)
615 IF(nty/=17.AND. intab(nbintc,intlist,n))THEN
616C
617 interact = 0
618 isens = 0
619 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 21.OR.
620 . nty == 5.OR.nty == 19 ) isens = ipari(64,i)
621 IF(isens/=0) THEN
622 ts = sensor_tab(isens)%TSTART
623 IF (tt>=ts) interact = 1
624 ELSE
625 startt = intbuf_tab(i)%VARIABLES(3)
626 stopt = intbuf_tab(i)%VARIABLES(11)
627 IF (startt<=tt.AND.tt<=stopt) interact = 1
628 ENDIF
629C
630 IF(interact/=0) THEN
631 nbnew = nbnew + 1
632 listnew(nbnew) = n
633 tzinf(nbnew) = intbuf_tab(i)%VARIABLES(8)
634 ENDIF
635 END IF
636C
637 IF(nspmd>1)THEN
638 CALL spmd_sync_mmx(
639 1 isendto,ircvfrom,newfront,xslv_l,xmsr_l,
640 2 vslv_l ,vmsr_l ,listnew ,nbnew ,tzinf ,
641 3 size_t ,ipari ,pmax ,maxdgap)
642 END IF
643C
644 IF (nbnew==0) RETURN
645C
646 nty =ipari(7,i)
647 IF(nty/=17)THEN
648 intbuf_tab(i)%VARIABLES(8)=tzinf(1)
649 IF(nspmd>1) THEN
650 IF (newfront(i)<0)THEN
651 IF(nty==7.OR.nty==10) THEN
652 CALL spmd_get_stif(
653 1 newfront(i) ,intbuf_tab(i)%I_STOK(1),
654 2 intbuf_tab(i)%CAND_N,intbuf_tab(i)%CAND_E,
655 3 ipari(5,i),i,isendto,ircvfrom,intbuf_tab(i)%NSV,
656 4 itab)
657 ELSEIF(nty==11) THEN
658 CALL spmd_get_stif11(
659 1 newfront(i) ,intbuf_tab(i)%I_STOK(1) ,
660 2 intbuf_tab(i)%CAND_N , intbuf_tab(i)%GAP_S,
661 3 ipari(3,i),i,isendto,ircvfrom, intbuf_tab(i)%IRECTS,
662 4 itab)
663 ENDIF
664 ENDIF
665 END IF !(NSPMD>1) THEN
666C Maj Dist = Tzinf - Gap ***: Only to be coherent with SMP
667 intbuf_tab(i)%VARIABLES(5) = intbuf_tab(i)%VARIABLES(8)-
668 - intbuf_tab(i)%VARIABLES(2)
669C calculation of the sorting criterion DIST0
670 xx=max(xslv_l(1,i)-xmsr_l(4,i),xmsr_l(1,i)-xslv_l(4,i),zero)
671 xy=max(xslv_l(2,i)-xmsr_l(5,i),xmsr_l(2,i)-xslv_l(5,i),zero)
672 xz=max(xslv_l(3,i)-xmsr_l(6,i),xmsr_l(3,i)-xslv_l(6,i),zero)
673 dist0 = intbuf_tab(i)%VARIABLES(5) - sqrt(xx**2+xy**2+xz**2)
674C
675C Vmax treatment
676C
677 vx=max(vslv_l(1,i)-vmsr_l(4,i),vmsr_l(1,i)-vslv_l(4,i),zero)
678 vy=max(vslv_l(2,i)-vmsr_l(5,i),vmsr_l(2,i)-vslv_l(5,i),zero)
679 vz=max(vslv_l(3,i)-vmsr_l(6,i),vmsr_l(3,i)-vslv_l(6,i),zero)
680 vv=sqrt(vx**2+vy**2+vz**2)
681 IF (vv/=zero) THEN
682 gapinf = intbuf_tab(i)%VARIABLES(6)
683 IF (gapinf==zero) gapinf = intbuf_tab(i)%VARIABLES(2)
684C-------assumed s is still far from M ------
685 gapinf =gapinf+max(zero,dist0)
686 dti = onep8*gapinf/vv
687Ctmp DTI = ZEP9*GAPINF/VV
688 IF(dti<dt2t) dt2t = dti
689 ENDIF
690 IF(dist0<=zero) THEN
691 intbuf_tab(i)%VARIABLES(5) = -one
692 ENDIF
693 ENDIF
694C
695 RETURN
logical function intab(nic, ic, n)
Definition i24tools.F:95
#define max(a, b)
Definition macros.h:21
subroutine spmd_get_stif11(newfront, i_stok, cand_s, stfs, nrts, nin, isendto, ircvfrom, irects, itab)
Definition send_cand.F:566
subroutine spmd_get_stif(newfront, i_stok, cand_n, stfn, nsn, nin, isendto, ircvfrom, nsv, itab)
Definition send_cand.F:156
subroutine spmd_sync_mmx(isendto, ircvfrom, newfront, xslv_l, xmsr_l, vslv_l, vmsr_l, intlist, nintc, tzinf, size_t, ipari, delta_pmax_gap, maxdgap)

◆ imp_int_k()

subroutine imp_int_k ( a,
v,
integer, dimension(*) icodt,
integer, dimension(*) icodr,
integer, dimension(*) iskew,
integer, dimension(nifv,*) ibfv,
integer, dimension(*) npc,
tf,
vel,
integer, intent(in) nsensor,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab,
xframe,
rby,
x,
skew,
integer, dimension(*) lpby,
integer, dimension(nnpby,*) npby,
integer, dimension(*) itab,
integer, dimension(*) weight,
ms,
in,
integer nrbyac,
integer, dimension(*) irbyac,
integer, dimension(*) nss,
integer, dimension(*) iss,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer nint2,
integer, dimension(*) iint2,
integer, dimension(*) iaint2,
integer, dimension(*) nss2,
integer, dimension(*) iss2,
integer nddli,
integer nnzi,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
diag_i,
lt_i,
integer, dimension(*) iddli,
integer nddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
integer, dimension(*) ikc,
diag_k,
lt_k,
integer, dimension(*) iddl,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) index2,
integer, dimension(*) ndofi,
integer, dimension(*) itok,
ud,
lb,
gapmin,
integer, dimension(*) dirul,
integer nt_rw,
integer, dimension(*) num_imp1,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
frbe3,
integer, dimension(*) nss3,
integer, dimension(*) iss3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2,
integer, dimension(*) nsb2,
integer, dimension(*) isb2 )

Definition at line 41 of file imp_int_k.F.

56C-----------------------------------------------
57C M o d u l e s
58C-----------------------------------------------
59 USE imp_inttd
60 USE intbufdef_mod
61 USE imp_intbuf
62 USE sensor_mod
63C-----------------------------------------------
64C I m p l i c i t T y p e s
65C-----------------------------------------------
66#include "implicit_f.inc"
67C-----------------------------------------------
68C C o m m o n B l o c k s
69C-----------------------------------------------
70#include "com04_c.inc"
71#include "param_c.inc"
72#include "impl1_c.inc"
73#include "com08_c.inc"
74C-----------------------------------------------
75C D u m m y A r g u m e n t s
76C-----------------------------------------------
77 INTEGER ,INTENT(IN) :: NSENSOR
78 INTEGER NPC(*),IBFV(NIFV,*),DIRUL(*),
79 . ICODT(*),ICODR(*),ISKEW(*),ITOK(*),NDDL,NT_RW
80 INTEGER WEIGHT(*),LPBY(*),NPBY(NNPBY,*),ITAB(*),
81 . IPARI(NPARI,*), NRBYAC,IRBYAC(*),
82 . IDDL(*),IKC(*),NSS(*),ISS(*),NSS2(*),ISS2(*),
83 . IADK(*),JDIK(*),NDDLI,NNZI,IADI(*),JDII(*),
84 . IDDLI(*),NDOFI(*),NINT2 ,IINT2(*),IAINT2(*)
85 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),INDEX2(*),NUM_IMP1(*)
86 INTEGER IRBE3(NRBE3L,*),LRBE3(*),NSS3(*),ISS3(*),
87 . IRBE2(*),LRBE2(*),NSB2(*),ISB2(*)
89 . a(3,*),v(3,*),rby(nrby,*),x(3,*) ,skew(*),in(*),ms(*)
91 . tf(*), vel(lfxvelr,*),diag_k(*),lt_k(*),
92 . diag_i(*),lt_i(*),lb(*),ud(3,*),gapmin,xframe(nxframe,*),
93 . frbe3(*)
94 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
95 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
96C-----------------------------------------------
97C L o c a l V a r i a b l e s
98C-----------------------------------------------
99 INTEGER I,J,N, IAD,NTY,I_INT7,NUM_IMP0,
100 . LREM(NINTER), ISENS
101 my_real ts
102C REAL
103C
104 IF (nt_imp1>0) THEN
105 iad=1
106 gapmin=ep20
107 i_int7 = imp_int7
108 imp_int7 = 3
109C-----------int5 first-------------
110 DO n=1,ninter
111 nty =ipari(7,n)
112 IF (num_imp(n)==0) cycle
113 IF(nty==5) THEN
114C
115 isens = ipari(64,n)
116 IF(isens/=0) THEN ! SENSOR
117 ts = sensor_tab(isens)%TSTART
118 ELSE
119 ts = tt
120 ENDIF
121C
122 IF(tt>=ts) THEN ! If interface is activated
123 CALL i5ke3( a,v ,ms ,
124 1 ipari(1,n),intbuf_tab(n) ,x ,
125 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,
126 3 iddli ,diag_i ,lt_i , iadi ,jdii )
127 ENDIF
128 iad=iad+num_imp(n)
129 ENDIF
130 END DO
131C
132 DO n=1,ninter
133 nty =ipari(7,n)
134 lrem(n) = 0
135 IF(nty==7) THEN
136C
137 isens = ipari(64,n)
138 IF(isens/=0) THEN ! SENSOR
139 ts = sensor_tab(isens)%TSTART
140 ELSE
141 ts = tt
142 ENDIF
143C
144 IF(tt>=ts) THEN ! If interface is activated
145 CALL i7ke3( a,v ,ms ,
146 1 ipari ,intbuf_tab(n) ,x ,n ,
147 2 num_imp1(n),ns_imp1(iad),ne_imp1(iad) ,ind_imp1(iad),
148 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
149 4 lrem(n) )
150 ENDIF
151 iad=iad+num_imp1(n)
152 ELSEIF(nty==10)THEN
153 CALL i10ke3( a,v ,ms ,
154 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
155 2 num_imp1(n),ns_imp1(iad),ne_imp1(iad) ,ind_imp1(iad),
156 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
157 4 lrem(n) )
158 iad=iad+num_imp1(n)
159 ELSEIF(nty==11)THEN
160C
161 isens = ipari(64,n)
162 IF(isens/=0) THEN ! SENSOR
163 ts = sensor_tab(isens)%TSTART
164 ELSE
165 ts = tt
166 ENDIF
167C
168 IF(tt>=ts) THEN ! If interface is activated
169 CALL i11ke3( a, v ,ms ,
170 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
171 2 num_imp1(n),ns_imp1(iad),ne_imp1(iad) ,
172 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
173 4 lrem(n) ,itab )
174 ENDIF
175 iad=iad+num_imp1(n)
176 ELSEIF(nty==24) THEN
177C
178 isens = ipari(64,n)
179 IF(isens/=0) THEN ! SENSOR
180 ts = sensor_tab(isens)%TSTART
181 ELSE
182 ts = tt
183 ENDIF
184C
185 IF(tt>=ts) THEN ! If interface is activated
186c CALL I24KE3( A,V ,MS ,
187c 1 IPARI ,INTBUF_TAB(N) ,X ,N ,
188c 2 NUM_IMP1(N),NS_IMP1(IAD),NE_IMP1(IAD) ,IND_IMP1(IAD),
189c 3 IDDLI ,DIAG_I ,LT_I , IADI ,JDII ,GAPMIN ,
190c 4 LREM(N) )
191 CALL i24ke3( a,v ,ms ,
192 1 ipari ,intbuf_tab(n) ,x ,n ,
193c 2 NUM_IMP1(N),NS_IMP1(IAD),NE_IMP1(IAD) ,IND_IMP1(IAD),
194 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
195 4 lrem(n) ,intbuf_tab_imp(n))
196 ENDIF
197 iad=iad+num_imp1(n)
198 ELSE
199 ENDIF
200 ENDDO
201 imp_int7 = i_int7
202 DO n=1,ninter
203 nty =ipari(7,n)
204 num_imp0 = num_imp(n)-num_imp1(n)
205 IF(nty==7) THEN
206C
207 isens = ipari(64,n)
208 IF(isens/=0) THEN ! SENSOR
209 ts = sensor_tab(isens)%TSTART
210 ELSE
211 ts = tt
212 ENDIF
213C
214 IF(tt>=ts) THEN ! If interface is activated
215 CALL i7ke3( a,v ,ms ,
216 1 ipari ,intbuf_tab(n) ,x ,n ,
217 2 num_imp0 ,ns_imp1(iad),ne_imp1(iad) ,ind_imp1(iad),
218 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
219 4 lrem(n) )
220 ENDIF
221 iad=iad+num_imp0
222 ELSEIF(nty==10)THEN
223 CALL i10ke3( a,v ,ms ,
224 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
225 2 num_imp0 ,ns_imp1(iad),ne_imp1(iad) ,ind_imp1(iad),
226 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
227 4 lrem(n) )
228 iad=iad+num_imp0
229 ELSEIF(nty==11)THEN
230C
231 isens = ipari(64,n)
232 IF(isens/=0) THEN ! SENSOR
233 ts = sensor_tab(isens)%TSTART
234 ELSE
235 ts = tt
236 ENDIF
237C
238 IF(tt>=ts) THEN ! If interface is activated
239 CALL i11ke3( a, v ,ms ,
240 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
241 2 num_imp0 ,ns_imp1(iad),ne_imp1(iad) ,
242 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
243 4 lrem(n) ,itab )
244 ENDIF
245 iad=iad+num_imp0
246 ELSEIF(nty==24) THEN
247C
248 isens = ipari(64,n)
249 IF(isens/=0) THEN ! SENSOR
250 ts = sensor_tab(isens)%TSTART
251 ELSE
252 ts = tt
253 ENDIF
254C
255 IF(tt>=ts) THEN ! If interface is activated
256 CALL i24ke3( a,v ,ms ,
257 1 ipari ,intbuf_tab(n) ,x ,n ,
258c 2 NUM_IMP1(N),NS_IMP1(IAD),NE_IMP1(IAD) ,IND_IMP1(IAD),
259 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
260 4 lrem(n) ,intbuf_tab_imp(n))
261 ENDIF
262 iad=iad+num_imp0
263 ELSE
264 ENDIF
265 ENDDO
266 ELSE
267C----- normal branche------------
268 iad=1
269 gapmin=ep20
270 DO n=1,ninter
271 nty =ipari(7,n)
272 IF (num_imp(n)==0) cycle
273 IF(nty==5) THEN
274C
275 isens = ipari(64,n)
276 IF(isens/=0) THEN ! sensor
277 ts = sensor_tab(isens)%TSTART
278 ELSE
279 ts = tt
280 ENDIF
281C
282 IF(tt>=ts) THEN ! If interface is activated
283 CALL i5ke3( a,v ,ms ,
284 1 ipari(1,n),intbuf_tab(n) ,x ,
285 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,
286 3 iddli ,diag_i ,lt_i , iadi ,jdii )
287 ENDIF
288 iad=iad+num_imp(n)
289 ENDIF
290 END DO
291 DO n=1,ninter
292 nty =ipari(7,n)
293 lrem(n) = 0
294 IF(nty==7) THEN
295C
296 isens = ipari(64,n)
297 IF(isens/=0) THEN ! SENSOR
298 ts = sensor_tab(isens)%TSTART
299 ELSE
300 ts = tt
301 ENDIF
302C
303 IF(tt>=ts) THEN ! If interface is activated
304 CALL i7ke3( a,v ,ms ,
305 1 ipari ,intbuf_tab(n) ,x ,n ,
306 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,index2(iad),
307 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
308 4 lrem(n) )
309 ENDIF
310 iad=iad+num_imp(n)
311 ELSEIF(nty==10)THEN
312 CALL i10ke3( a,v ,ms ,
313 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
314 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,index2(iad),
315 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
316 4 lrem(n) )
317 iad=iad+num_imp(n)
318 ELSEIF(nty==11)THEN
319C
320 isens = ipari(64,n)
321 IF(isens/=0) THEN ! SENSOR
322 ts = sensor_tab(isens)%TSTART
323 ELSE
324 ts = tt
325 ENDIF
326C
327 IF(tt>=ts) THEN ! If interface is activated
328 CALL i11ke3( a, v ,ms ,
329 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
330 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,
331 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
332 4 lrem(n) ,itab )
333 ENDIF
334 iad=iad+num_imp(n)
335 ELSEIF(nty==24) THEN
336C
337 isens = ipari(64,n)
338 IF(isens/=0) THEN ! SENSOR
339 ts = sensor_tab(isens)%TSTART
340 ELSE
341 ts = tt
342 ENDIF
343C
344 IF(tt>=ts) THEN ! If interface is activated
345 CALL i24ke3( a,v ,ms ,
346 1 ipari ,intbuf_tab(n) ,x ,n ,
347 3 iddli ,diag_i ,lt_i , iadi ,jdii ,gapmin ,
348 4 lrem(n) ,intbuf_tab_imp(n))
349 ENDIF
350 iad=iad+num_imp(n)
351 ENDIF
352 ENDDO
353 END IF !(NT_IMP1>0)
354C
355 IF(gapmin<zero)RETURN
356 CALL upd_int_k(icodt ,icodr ,iskew ,ibfv ,npc ,
357 1 tf ,vel ,xframe ,
358 2 rby ,x ,skew ,lpby ,npby ,
359 3 itab ,weight,ms ,in ,nrbyac,
360 4 irbyac,nss ,iss ,ipari ,intbuf_tab,
361 5 nint2 ,iint2 ,iaint2 ,nss2 ,
362 5 iss2 ,nddli ,nnzi ,iadi ,jdii ,
363 6 diag_i ,lt_i ,iddli ,nddl ,iadk ,
364 7 jdik ,ikc ,diag_k,lt_k ,iddl ,
365 8 ndofi ,itok ,ud ,lb ,dirul ,
366 9 nt_rw ,irbe3 ,lrbe3 ,frbe3 ,nss3 ,
367 a iss3 ,irbe2 ,lrbe2 ,nsb2 ,isb2 )
368C
369 RETURN
subroutine i10ke3(a, v, ms, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, index2, iddl, k_diag, k_lt, iadk, jdik, gap_imp, lrem)
Definition i10ke3.F:41
subroutine i11ke3(a, v, ms, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, iddl, k_diag, k_lt, iadk, jdik, gap_imp, lrem, itab)
Definition i11ke3.F:41
subroutine i24ke3(a, v, ms, ipari, intbuf_tab, x, nin, iddl, k_diag, k_lt, iadk, jdik, gap_imp, lrem, intbuf_tab_imp)
Definition i24ke3.F:42
subroutine i5ke3(a, v, ms, ipari, intbuf_tab, x, num_imp, cand_n, cand_e, iddl, k_diag, k_lt, iadk, jdik)
Definition i5ke3.F:42
subroutine i7ke3(a, v, ms, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, index2, iddl, k_diag, k_lt, iadk, jdik, gap_imp, lrem)
Definition i7ke3.F:42
subroutine upd_int_k(icodt, icodr, iskew, ibfv, npc, tf, vel, 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, ndofi, itok, ud, lb, luj, nt_rw, irbe3, lrbe3, frbe3, nss3, iss3, irbe2, lrbe2, nsb2, isb2)
Definition upd_glob_k.F:465

◆ imp_intdt()

subroutine imp_intdt ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
x,
v,
vr,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) irecvfrom,
integer, dimension(*) newfront,
integer itask,
dtk,
integer, dimension(*) itab,
integer, dimension(*) intlist,
integer nbintc,
dt_min,
ms,
integer, intent(in) nsensor,
type (sensor_str_), dimension(nsensor) sensor_tab,
maxdgap )

Definition at line 385 of file imp_int_k.F.

391C-----------------------------------------------
392C M o d u l e s
393C-----------------------------------------------
394 USE intbufdef_mod
395 USE sensor_mod
396C-----------------------------------------------
397C I m p l i c i t T y p e s
398C-----------------------------------------------
399#include "implicit_f.inc"
400C-----------------------------------------------
401C C o m m o n B l o c k s
402C-----------------------------------------------
403#include "com01_c.inc"
404#include "com04_c.inc"
405#include "com08_c.inc"
406#include "param_c.inc"
407#include "task_c.inc"
408C-----------------------------------------------
409C D u m m y A r g u m e n t s
410C-----------------------------------------------
411 INTEGER ,INTENT(IN) :: NSENSOR
412 INTEGER IPARI(NPARI,*), ITAB(*),
413 . NEWFRONT(*),NBINTC,INTLIST(*),
414 . ISENDTO(NINTER+1,*),IRECVFROM(NINTER+1,*),
415 . ITASK
416 my_real
417 . x(3,*), v(3,*),vr(3,*),dtk(*),dt_min,ms(*),
418 . maxdgap(ninter)
419
420 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
421 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
422C-----------------------------------------------
423C L o c a l V a r i a b l e s
424C-----------------------------------------------
425 INTEGER N, KK,LL, RETRI, NBLIST, IFQ,
426 . INACTI, NSNROLD, IAD17, IGN, IGE, NME, NMES,
427 . NELTST ,ITYPTST ,I,NTY, ISENS, INTERACT
428C REAL
429 my_real
430 . xslv_l(18,ninter),xmsr_l(12,ninter),
431 . vslv_l(6,ninter),vmsr_l(6,ninter),
432 . size_t(ninter),dti,fac, ts
433C-------------DT kin by interface--------
434C Init variable globale interface
435C DO KK=1,NBINTC
436C N = INTLIST(KK)
437 DO n=1,ninter
438 xslv_l(1,n)= -ep30
439 xslv_l(2,n)= -ep30
440 xslv_l(3,n)= -ep30
441 xslv_l(4,n)= ep30
442 xslv_l(5,n)= ep30
443 xslv_l(6,n)= ep30
444 xslv_l( 7,n)= -ep30
445 xslv_l( 8,n)= -ep30
446 xslv_l( 9,n)= -ep30
447 xslv_l(10,n)= ep30
448 xslv_l(11,n)= ep30
449 xslv_l(12,n)= ep30
450 xslv_l(13,n)= -ep30
451 xslv_l(14,n)= -ep30
452 xslv_l(15,n)= -ep30
453 xslv_l(16,n)= ep30
454 xslv_l(17,n)= ep30
455 xslv_l(18,n)= ep30
456
457 xmsr_l(1,n)= -ep30
458 xmsr_l(2,n)= -ep30
459 xmsr_l(3,n)= -ep30
460 xmsr_l(4,n)= ep30
461 xmsr_l(5,n)= ep30
462 xmsr_l(6,n)= ep30
463 xmsr_l( 7,n)= -ep30
464 xmsr_l( 8,n)= -ep30
465 xmsr_l( 9,n)= -ep30
466 xmsr_l(10,n)= ep30
467 xmsr_l(11,n)= ep30
468 xmsr_l(12,n)= ep30
469
470 vslv_l(1,n)= -ep30
471 vslv_l(2,n)= -ep30
472 vslv_l(3,n)= -ep30
473 vslv_l(4,n)= ep30
474 vslv_l(5,n)= ep30
475 vslv_l(6,n)= ep30
476 vmsr_l(1,n)= -ep30
477 vmsr_l(2,n)= -ep30
478 vmsr_l(3,n)= -ep30
479 vmsr_l(4,n)= ep30
480 vmsr_l(5,n)= ep30
481 vmsr_l(6,n)= ep30
482 size_t(n)=zero
483 END DO
484 dt_min = ep30
485C DO KK=1,NBINTC
486C
487C N = INTLIST(KK)
488 DO n=1,ninter
489 dtk(n) = ep30
490C----------ICONT-----
491 ipari(29,n) = 0
492C
493 nty =ipari(7,n)
494 IF(nty==7.OR.nty==10.OR.nty==18)THEN
495 i7kglo = 1
496C IPARI(4,N) = NRTM ; IPARI(5,N)=NSN
497C
498 isens = 0
499 IF(nty == 7) isens = ipari(64,n)
500 IF(isens/=0) THEN
501 ts = sensor_tab(isens)%TSTART
502 ELSE
503 ts = tt
504 ENDIF
505C
506 IF(tt>=ts) THEN
507 CALL i7main_crit_tri(
508 1 ipari ,x ,n ,
509 2 itask ,v ,xslv_l ,xmsr_l,vslv_l,
510 3 vmsr_l,intbuf_tab(n) )
511 ENDIF
512 ELSEIF(nty==11)THEN
513 i7kglo = 1
514C
515 isens = ipari(64,n)
516 IF(isens/=0) THEN
517 ts = sensor_tab(isens)%TSTART
518 ELSE
519 ts = tt
520 ENDIF
521C
522 IF(tt>=ts) THEN
523 CALL i11main_crit_tri(
524 1 ipari ,x ,n ,
525 2 itask ,v ,xslv_l ,xmsr_l , vslv_l,
526 4 vmsr_l ,intbuf_tab(n) )
527 ENDIF
528 ENDIF
529C
530 CALL imp_icomcrit(
531 1 intbuf_tab ,ipari ,newfront ,isendto ,
532 2 irecvfrom,dtk(n) ,itab ,xslv_l ,xmsr_l ,
533 3 vslv_l ,vmsr_l ,size_t ,n ,sensor_tab,
534 4 intlist ,nbintc ,maxdgap ,nsensor )
535C
536 IF (nspmd>1)CALL spmd_min_s(dtk(n))
537 dt_min = min(dt_min,dtk(n))
538 ENDDO
539C
540 RETURN
subroutine i11main_crit_tri(ipari, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intbuf_tab)
subroutine i7main_crit_tri(ipari, x, nin, itask, v, xslv_l, xmsr_l, vslv_l, vmsr_l, intbuf_tab)
subroutine imp_icomcrit(intbuf_tab, ipari, newfront, isendto, ircvfrom, dt2t, itab, xslv_l, xmsr_l, vslv_l, vmsr_l, size_t, n, sensor_tab, intlist, nbintc, maxdgap, nsensor)
Definition imp_int_k.F:560
subroutine spmd_min_s(s)
Definition imp_spmd.F:1273

◆ imp_inttd0()

subroutine imp_inttd0 ( type(output_) output,
type(timer_) timers,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
x,
d,
ms,
integer, dimension(*) itab,
in,
d_imp,
dr_imp,
integer imsch,
integer i2msch,
integer isizxv,
integer ilenxv,
type (group_), dimension(ngrbric) igrbric,
integer islen7,
integer irlen7,
integer islen11,
integer irlen11,
integer islen17,
integer irlen17,
integer irlen7t,
integer islen7t,
integer, dimension(*) iad_elem,
integer, dimension(*) fr_elem,
integer nbintc,
integer, dimension(*) intlist,
integer itask,
integer, dimension(*) kinet,
integer, dimension(*) newfront,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) ind_imp,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) irecvfrom,
integer, dimension(*) weight,
integer, dimension(*) ixs,
temp,
dt2prev,
wa,
integer, dimension(*) num_imp1,
integer irlen20,
integer islen20,
integer irlen20t,
integer islen20t,
integer irlen20e,
integer islen20e,
integer, dimension(*) ikine,
diag_sms,
integer, dimension(*) count_remslv,
integer, dimension(*) count_remslve,
integer, intent(in) nsensor,
type (sensor_str_), dimension(nsensor) sensor_tab,
double precision, dimension(3,*) xdp,
type(h3d_database) h3d_data,
type(multi_fvm_struct), intent(inout) multi_fvm,
forneqs,
maxdgap,
type (interfaces_), intent(in) interfaces,
type (glob_therm_), intent(in) glob_therm )

Definition at line 718 of file imp_int_k.F.

732C-----------------------------------------------
733C M o d u l e s
734C-----------------------------------------------
735 use output_mod
736 USE timer_mod
737 USE intbufdef_mod
738 USE h3d_mod
739 USE multi_fvm_mod
740 USE groupdef_mod
741 USE sensor_mod
742 USE interfaces_mod
743 use glob_therm_mod
744C-----------------------------------------------
745C I m p l i c i t T y p e s
746C-----------------------------------------------
747#include "implicit_f.inc"
748C-----------------------------------------------
749C C o m m o n B l o c k s
750C-----------------------------------------------
751#include "com01_c.inc"
752#include "com04_c.inc"
753#include "com08_c.inc"
754#include "param_c.inc"
755#include "task_c.inc"
756#include "impl1_c.inc"
757C-----------------------------------------------
758C D u m m y A r g u m e n t s
759C-----------------------------------------------
760 type(output_) :: output
761 TYPE(TIMER_) :: TIMERS
762 INTEGER ,INTENT(IN) :: NSENSOR
763 INTEGER IPARI(NPARI,*), ITAB(*),
764 . NEWFRONT(*),NBINTC,INTLIST(*),
765 . ISENDTO(NINTER+1,*),IRECVFROM(NINTER+1,*),
766 . ITASK,IMSCH ,I2MSCH ,ISIZXV,ILENXV,IRLEN20,ISLEN20,
767 . IRLEN20T,ISLEN20T,IRLEN20E,ISLEN20E
768 INTEGER ISLEN7,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17,
769 . IRLEN17,IRLEN7T,ISLEN7T,IAD_ELEM(*),FR_ELEM(*) ,
770 . WEIGHT(*),IXS(*) ,NUM_IMP1(*),
771 . NUM_IMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
772 . KINET(*),IKINE(*),COUNT_REMSLV(*),
773 . COUNT_REMSLVE(*)
774
775 DOUBLE PRECISION XDP(3,*)
776
777 my_real
778 . x(3,*), d(3,*),ms(*),wa(*),
779 . dt2prev, temp(*),d_imp(3,*),dr_imp(3,*),in(*),diag_sms(*),
780 . forneqs(3,*),maxdgap(ninter)
781
782 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
783 TYPE(H3D_DATABASE) :: H3D_DATA
784 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
785!
786 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
787 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
788 TYPE (INTERFACES_) ,INTENT(IN) :: INTERFACES
789 type (glob_therm_) , INTENT(IN) :: GLOB_THERM
790C-----------------------------------------------
791C L o c a l V a r i a b l e s
792C-----------------------------------------------
793 INTEGER N, KK,LL, RETRI, NBLIST, IFQ,
794 . INACTI, NSNROLD, IAD17, IGN, IGE, NME, NMES,
795 . NB ,ILIST(1) ,I,NTY,KD(50), KFI,IAD,NSN,NMN,
796 . JFI,JD(50),IDNS,IDNM,IDSTIF,NTHR_CP,ISENS ,
797 . INTERACT
798C REAL
799 my_real
800 . dtk(ninter),v(3,numnod),vr(3,numnod),
801 . x_tmp(3,numnod),dti,fac,fac1,dt_min,dx,dy,dz,
802 . startt,stopt, ts
803C-------------before inttri------
804 nt_imp1 = 0
805 DO n = 1,ninter
806 num_imp1(n)=0
807 ENDDO
808C----deactivate this function.
809 IF (ittoff>0) RETURN
810 nthr_cp = nthread
811 IF (nthread>1) nthread = 1
812 dti = one/dt2
813 DO i=1,numnod
814 v(1,i)=d_imp(1,i)*dti
815 v(2,i)=d_imp(2,i)*dti
816 v(3,i)=d_imp(3,i)*dti
817 ENDDO
818 IF (iroddl/=0) THEN
819 DO i=1,numnod
820 vr(1,i)=dr_imp(1,i)*dti
821 vr(2,i)=dr_imp(2,i)*dti
822 vr(3,i)=dr_imp(3,i)*dti
823 ENDDO
824 ENDIF
825 CALL imp_intdt(
826 1 ipari ,intbuf_tab ,x ,
827 2 v ,vr ,isendto ,irecvfrom,
828 4 newfront ,itask ,dtk ,itab ,
829 5 intlist ,nbintc ,dt_min ,ms ,
830 6 nsensor ,sensor_tab,maxdgap)
831 IF (dt_min >= dt2) GOTO 1000
832 DO n = 1,ninter
833 num_imp(n) = 0
834 END DO
835C-------------in inttri------
836c NI18 = 0
837c LI18 = 1
838c IAD17 = 1
839C
840 iad=1
841 nb = 1
842C
843C DO KK=1,NBINTC
844C N = INTLIST(KK)
845 DO n=1,ninter
846 nty = ipari(7,n)
847 IF (nty/=7.AND.nty/=10.AND.nty/=11) GOTO 999
848 IF (dtk(n)>=dt2) GOTO 999
849 nsn =ipari(5,n)
850 nmn =ipari(6,n)
851C
852 interact = 0
853 isens = 0
854 IF(nty == 7.OR.nty == 11) isens = ipari(64,n)
855 IF(isens/=0) THEN !CMAAAAA
856 ts = sensor_tab(isens)%TSTART
857 IF (tt>=ts) interact = 1
858 ELSE
859 startt = intbuf_tab(n)%VARIABLES(3)
860 stopt = intbuf_tab(n)%VARIABLES(11)
861 IF (startt<=tt.AND.tt<=stopt) interact = 1
862 ENDIF
863 IF(interact/=0) GOTO 999
864C
865 retri = 0
866 ilist(1) = n
867 fac = dtk(n)/dt2
868 fac1 = dti*fac
869 IF(nty==11)THEN
870 CALL imp_i11xv(
871 1 x ,intbuf_tab(n)%NSV,intbuf_tab(n)%MSR,nsn ,nmn ,
872 2 x_tmp ,d_imp ,dr_imp ,v ,vr ,
873 3 fac ,fac1 )
874 ELSE
875 CALL imp_i7xv(
876 1 x ,intbuf_tab(n)%NSV ,intbuf_tab(n)%MSR,nsn ,nmn ,
877 2 intbuf_tab(n)%STFNS,x_tmp ,d_imp ,dr_imp ,v ,
878 3 vr ,fac ,fac1 )
879 ENDIF
880 CALL imp_tripi(output, timers,
881 1 ipari ,intbuf_tab,x_tmp ,d ,
882 2 v ,ms ,itab ,vr ,in ,
883 3 imsch ,i2msch ,isizxv,ilenxv ,igrbric ,
884 4 islen7,irlen7 ,islen11,irlen11,islen17,
885 5 irlen17,irlen7t,islen7t,iad_elem,fr_elem ,
886 6 nb ,ilist ,itask ,kinet,newfront,
887 7 num_imp,ns_imp,ne_imp,ind_imp,iad ,
888 8 isendto ,irecvfrom ,retri,weight,
889 9 ixs ,temp ,dt2prev,wa ,n ,nty,
890 a irlen20,islen20,irlen20t,islen20t,irlen20e,
891 b islen20e,ikine,diag_sms,count_remslv,count_remslve,
892 c sensor_tab,xdp ,h3d_data, multi_fvm ,forneqs,
893 d interfaces,nsensor,glob_therm)
894 999 CONTINUE
895 ENDDO
896C
897 nt_imp1=iad-1
898C---------necessary for spmd-----
899 CALL cp_inttd(nt_imp1,num_imp ,ns_imp,ne_imp,ind_imp,num_imp1)
900 1000 CONTINUE
901 IF (nthr_cp>1) nthread = nthr_cp
902C
903 RETURN
subroutine cp_inttd(nt_imp1, numimp, ns_imp, ne_imp, ind_imp, numimp1)
Definition imp_int_k.F:1387
subroutine imp_i7xv(x, nsv, msr, nsn, nmn, stfn, x_tmp, d, dr, v, vr, facd, facv)
Definition imp_int_k.F:996
subroutine imp_tripi(output, timers, ipari, intbuf_tab, x, d, v, ms, itab, vr, in, imsch, i2msch, isizxv, ilenxv, igrbric, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, iad_elem, fr_elem, nbintc, intlist, itask, kinet, newfront, num_imp, ns_imp, ne_imp, ind_imp, iad, isendto, irecvfrom, retri, weight, ixs, temp, dt2prev, wag, n, nty, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, ikine, diag_sms, count_remslv, count_remslve, sensor_tab, xdp, h3d_data, multi_fvm, forneqs, interfaces, nsensor, glob_therm)
Definition imp_int_k.F:1114
subroutine imp_i11xv(x, nsv, msr, nsn, nmn, x_tmp, d, dr, v, vr, facd, facv)
Definition imp_int_k.F:914

◆ imp_rnumcd()

subroutine imp_rnumcd ( integer, dimension(*) cand_n,
integer nin,
integer nsn,
integer num_imp,
integer, dimension(*) index )

Definition at line 1549 of file imp_int_k.F.

1550C-----------------------------------------------
1551C M o d u l e s
1552C-----------------------------------------------
1553 USE imp_inttd
1554C-----------------------------------------------
1555C I m p l i c i t T y p e s
1556C-----------------------------------------------
1557#include "implicit_f.inc"
1558C-----------------------------------------------
1559C D u m m y A r g u m e n t s
1560C-----------------------------------------------
1561 INTEGER CAND_N(*) ,NIN,NSN,NUM_IMP,INDEX(*)
1562C-----------------------------------------------
1563C L o c a l V a r i a b l e s
1564C-----------------------------------------------
1565 INTEGER I, NI,IAD
1566C-----------------------------------------------
1567C S o u r c e L i n e s
1568C-----------------------------------------------
1569 iad = iad1_nin(nin)
1570 DO i = 1, num_imp
1571 ni = ns_imp1(iad+i)
1572 IF(ni>nsn) THEN
1573 ni = ni - nsn
1574 ns_imp1(iad+i) = cand_n(index(i))
1575 END IF
1576 END DO
1577C
1578 RETURN

◆ imp_tripi()

subroutine imp_tripi ( type(output_) output,
type(timer_) timers,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
x,
d,
v,
ms,
integer, dimension(*) itab,
vr,
in,
integer imsch,
integer i2msch,
integer isizxv,
integer ilenxv,
type (group_), dimension(ngrbric) igrbric,
integer islen7,
integer irlen7,
integer islen11,
integer irlen11,
integer islen17,
integer irlen17,
integer irlen7t,
integer islen7t,
integer, dimension(*) iad_elem,
integer, dimension(*) fr_elem,
integer nbintc,
integer, dimension(*) intlist,
integer itask,
integer, dimension(*) kinet,
integer, dimension(*) newfront,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) ind_imp,
integer iad,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) irecvfrom,
integer retri,
integer, dimension(*) weight,
integer, dimension(*) ixs,
temp,
dt2prev,
wag,
integer n,
integer nty,
integer irlen20,
integer islen20,
integer irlen20t,
integer islen20t,
integer irlen20e,
integer islen20e,
integer, dimension(*) ikine,
diag_sms,
integer, dimension(*) count_remslv,
integer, dimension(*) count_remslve,
type (sensor_str_), dimension(nsensor) sensor_tab,
double precision, dimension(3,*) xdp,
type(h3d_database) h3d_data,
type(multi_fvm_struct), intent(inout) multi_fvm,
forneqs,
type (interfaces_), intent(in) interfaces,
integer, intent(in) nsensor,
type (glob_therm_), intent(in) glob_therm )

Definition at line 1100 of file imp_int_k.F.

1114C-----------------------------------------------
1115C M o d u l e s
1116C-----------------------------------------------
1117 USE output_mod
1118 USE timer_mod
1119 USE intbufdef_mod
1120 USE h3d_mod
1121 USE multi_fvm_mod
1122 USE groupdef_mod
1123 USE sensor_mod
1124 USE interfaces_mod
1125 use glob_therm_mod
1126 use element_mod , only : nixs
1127C-----------------------------------------------
1128C I m p l i c i t T y p e s
1129C-----------------------------------------------
1130#include "implicit_f.inc"
1131C-----------------------------------------------
1132C C o m m o n B l o c k s
1133C-----------------------------------------------
1134#include "com01_c.inc"
1135#include "com04_c.inc"
1136#include "com08_c.inc"
1137#include "param_c.inc"
1138C-----------------------------------------------
1139C D u m m y A r g u m e n t s
1140C-----------------------------------------------
1141 TYPE(OUTPUT_) :: output
1142 TYPE(TIMER_) :: TIMERS
1143 INTEGER ,INTENT(IN) :: NSENSOR
1144 INTEGER IPARI(NPARI,*), ITAB(*),
1145 . NEWFRONT(*),NBINTC,INTLIST(*),IKINE(*),
1146 . ISENDTO(NINTER+1,*),IRECVFROM(NINTER+1,*),
1147 . ITASK,IMSCH ,I2MSCH ,ISIZXV,ILENXV,COUNT_REMSLV(*),
1148 . COUNT_REMSLVE(*)
1149 INTEGER ISLEN7,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17,
1150 . IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,IRLEN20E,ISLEN20E,
1151 . IRLEN17,IRLEN7T,ISLEN7T,IAD_ELEM(*),FR_ELEM(*) ,
1152 . WEIGHT(*),IAD,N,IXS(*) ,
1153 . NUM_IMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
1154 . KINET(*),NTY
1155
1156 DOUBLE PRECISION XDP(3,*)
1157
1158 my_real
1159 . x(3,*), d(3,*),v(*),ms(*),wag(*),
1160 . vr(3,*),dt2prev, temp(*),in(*), diag_sms(*),forneqs(3,*)
1161
1162 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1163 TYPE(H3D_DATABASE) :: H3D_DATA
1164 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
1165!
1166 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
1167 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
1168 TYPE (INTERFACES_) ,INTENT(IN) :: INTERFACES
1169 type (glob_therm_), INTENT(IN) :: GLOB_THERM
1170C-----------------------------------------------
1171C L o c a l V a r i a b l e s
1172C-----------------------------------------------
1173 INTEGER KK,LL, RETRI, NBLIST, IFQ,
1174 . INACTI, NSNROLD, IAD17, IGN, IGE, NME, NMES,
1175 . I,L1,L2,L3,JTASK,LINDMAX,IBID ,IBIDLEN,NRTM_T,
1176 . ESHIFT,RENUM(NUMNOD), NSNFIOLD(NSPMD), ISENS
1177 INTEGER INT24E2EUSE
1178 INTEGER LSKYI_SMS_NEW ! AMS Counter for Interface values. Not need in implicit but kept for compatibility
1179C REAL
1180 my_real
1181 . dti, ts
1182 my_real
1183 . rdum(3,1)
1184C------------ In Intri -------
1185 lskyi_sms_new = 0 ! Value is set to zero than ignored.
1186 int24e2euse=0
1187 rdum(1:3,1)=zero
1188 ibid =0
1189 jtask = itask + 1
1190 IF (nspmd>1) THEN
1191 IF(isizxv>0) CALL spmd_sd_xv(output,
1192 1 x ,d ,v ,vr ,ms ,
1193 2 in ,iad_elem,fr_elem,weight,imsch,
1194 3 d ,isizxv ,ilenxv ,xdp)
1195 l1 = 1+nixs*numels
1196 l2 = l1+6*numels10
1197 l3 = l2+12*numels20
1198 CALL spmd_i7xvcom2(
1199 1 ipari ,x ,v ,ms ,
1200 2 imsch ,i2msch ,dt2prev ,intlist ,nbintc ,
1201 3 islen7 ,irlen7 ,islen11 ,irlen11 ,islen17 ,
1202 4 irlen17 ,ixs ,ixs(l3) ,nsensor ,
1203 5 igrbric ,temp ,1 ,irlen7t ,islen7t ,
1204 6 irlen20 ,islen20,irlen20t,islen20t,irlen20e,
1205 7 islen20e,ikine ,diag_sms,sensor_tab,intbuf_tab,int24e2euse,
1206 8 forneqs ,multi_fvm,interfaces,ibid)
1207 CALL spmd_i7xvcom2(
1208 1 ipari ,x ,v ,ms ,
1209 2 imsch ,i2msch ,dt2prev ,intlist ,nbintc ,
1210 3 islen7 ,irlen7 ,islen11 ,irlen11 ,islen17 ,
1211 4 irlen17 ,ixs ,ixs(l3) ,nsensor ,
1212 5 igrbric ,temp ,2 ,irlen7t ,islen7t ,
1213 6 irlen20 ,islen20,irlen20t,islen20t,irlen20e,
1214 7 islen20e,ikine ,diag_sms,sensor_tab,intbuf_tab,int24e2euse,
1215 8 forneqs ,multi_fvm,interfaces,ibid)
1216 ENDIF
1217 nrtm_t = ipari(4,n)
1218 eshift = 0
1219 IF(nty==7.OR.nty==18)THEN
1220C
1221 isens = ipari(64,n)
1222 IF(isens/=0) THEN ! SENSOR
1223 ts = sensor_tab(isens)%TSTART
1224 ELSE
1225 ts = tt
1226 ENDIF
1227C
1228 IF(tt>=ts) THEN ! If interface is activated
1229 CALL i7main_tri(timers,
1230 1 ipari ,x ,v ,
1231 2 ms ,n ,itask ,weight ,
1232 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1233 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1234 5 nsnfiold,eshift ,ibid ,ibid ,ibid ,
1235 6 intbuf_tab,h3d_data,ixs,multi_fvm,glob_therm)
1236 ENDIF
1237 ELSEIF(nty==10)THEN
1238C
1239 CALL i10main_tri(timers,
1240 1 npari ,ipari(1,n),x ,v ,
1241 2 ms ,n ,itask ,wag ,weight ,
1242 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1243 4 nrtm_t ,renum ,nsnfiold ,eshift ,ibid ,
1244 5 ibid ,ibid ,itab ,intbuf_tab ,
1245 6 h3d_data ,glob_therm )
1246 ELSEIF(nty==11)THEN
1247C
1248 isens = ipari(64,n)
1249 IF(isens/=0) THEN ! SENSOR
1250 ts = sensor_tab(isens)%TSTART
1251 ELSE
1252 ts = tt
1253 ENDIF
1254C
1255 IF(tt>=ts) THEN ! If interface is activated
1256 CALL i11main_tri(timers,
1257 1 ipari ,x ,v ,
1258 2 ms ,n ,itask ,weight ,isendto ,
1259 3 irecvfrom ,retri ,iad_elem ,fr_elem ,itab ,
1260 4 nrtm_t ,eshift ,ibid ,renum ,nsnfiold ,
1261 5 intbuf_tab ,ibid ,ibid)
1262 ENDIF
1263
1264 ELSEIF(nty == 20)THEN
1265C
1266 CALL i20main_tri(timers,
1267 1 ipari ,x ,v ,
1268 2 ms ,n ,itask ,wag ,weight ,
1269 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1270 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1271 5 nsnfiold,eshift ,ibid ,ibid ,diag_sms,
1272 5 ibid ,intbuf_tab ,h3d_data ,glob_therm)
1273 ENDIF
1274C
1275 IF (nspmd>1.AND.retri==1) THEN
1276C--------- to be modified by interface---
1277 CALL spmd_ifront(
1278 1 ipari ,newfront,isendto ,irecvfrom,
1279 2 nsensor,nbintc ,intlist ,ibidlen ,ibidlen ,
1280 3 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1281 4 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1282 5 ibidlen,ibidlen,sensor_tab,intbuf_tab, 1)
1283 CALL spmd_ifront(
1284 1 ipari ,newfront,isendto ,irecvfrom,
1285 2 nsensor,nbintc ,intlist ,ibidlen ,ibidlen ,
1286 3 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1287 4 ibidlen,ibidlen,ibidlen ,ibidlen ,ibidlen ,
1288 5 ibidlen,ibidlen,sensor_tab,intbuf_tab, 2)
1289
1290
1291 ENDIF
1292C
1293 IF(nty==7)THEN
1294C
1295 isens = ipari(64,n)
1296 IF(isens/=0) THEN ! SENSOR
1297 ts = sensor_tab(isens)%TSTART
1298 ELSE
1299 ts = tt
1300 ENDIF
1301C
1302 IF(tt>=ts) THEN ! If interface is activated
1303 CALL i7main_opt_tri(
1304 1 ipari ,intbuf_tab(n),x ,v ,
1305 2 n ,itask ,count_remslv, lskyi_sms_new )
1306 ENDIF
1307 ELSEIF(nty==10)THEN
1308 CALL i10main_opt_tri(
1309 1 ipari(1,n),intbuf_tab(n),x ,v ,
1310 2 n ,itask ,count_remslv , lskyi_sms_new )
1311 ELSEIF(nty==11)THEN
1312C
1313 isens = ipari(64,n)
1314 IF(isens/=0) THEN ! SENSOR
1315 ts = sensor_tab(isens)%TSTART
1316 ELSE
1317 ts = tt
1318 ENDIF
1319C
1320 IF(tt>=ts) THEN ! If interface is activated
1321 CALL i11main_opt_tri(
1322 1 ipari ,intbuf_tab(n),x ,v ,
1323 2 n ,itask ,count_remslv , lskyi_sms_new )
1324 ENDIF
1325 ELSEIF(nty == 20)THEN
1326 CALL i20main_opt_tri(
1327 1 ipari ,intbuf_tab(n),x ,v ,
1328 2 n ,itask ,count_remslv ,count_remslve )
1329 ENDIF
1330C-------------in intfop2------
1331 lindmax = ipari(18,n)*ipari(23,n)
1332
1333C
1334 IF(nty==7)THEN
1335C
1336 isens = ipari(64,n)
1337 IF(isens/=0) THEN ! SENSOR
1338 ts = sensor_tab(isens)%TSTART
1339 ELSE
1340 ts = tt
1341 ENDIF
1342C
1343 IF(tt>=ts) THEN ! If interface is activated
1344 CALL imp_i7mainf(
1345 1 ipari ,intbuf_tab(n),x ,v ,
1346 2 ms ,n ,lindmax ,jtask ,
1347 3 num_imp(n),ns_imp(iad) ,ne_imp(iad) ,ind_imp(iad))
1348 iad=iad+num_imp(n)
1349 ENDIF
1350 ELSEIF(nty==10)THEN
1351C
1352 CALL imp_i10mainf(
1353 1 ipari(1,n),intbuf_tab(n),x ,v ,
1354 2 ms ,n ,lindmax ,jtask ,
1355 3 num_imp(n),ns_imp(iad) ,ne_imp(iad) ,ind_imp(iad))
1356 iad=iad+num_imp(n)
1357 ELSEIF(nty==11)THEN
1358C
1359 isens = ipari(64,n)
1360 IF(isens/=0) THEN ! SENSOR
1361 ts = sensor_tab(isens)%TSTART
1362 ELSE
1363 ts = tt
1364 ENDIF
1365C
1366 IF(tt>=ts) THEN ! If interface is activated
1367 CALL imp_i11mainf(
1368 1 ipari(1,n),intbuf_tab(n),x ,v ,
1369 2 ms ,n ,lindmax ,jtask ,
1370 3 num_imp(n),ns_imp(iad) ,ne_imp(iad) ,itab)
1371 iad=iad+num_imp(n)
1372 ENDIF
1373 ENDIF
1374C
1375 RETURN
subroutine imp_i10mainf(ipari, intbuf_tab, x, v, ms, nin, lindmax, jtask, num_imp, ns_imp, ne_imp, ind_imp)
Definition i10ke3.F:435
subroutine i10main_tri(timers, npari, ipari, x, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, itab, intbuf_tab, h3d_data, glob_therm)
Definition i10main_tri.F:59
subroutine i10main_opt_tri(ipari, x, v, nin, itask, count_remslv, intbuf_tab, lskyi_sms_new)
subroutine imp_i11mainf(ipari, intbuf_tab, x, v, ms, nin, lindmax, jtask, num_imp, ns_imp, ne_imp, itab)
Definition i11ke3.F:309
subroutine i11main_opt_tri(ipari, intbuf_tab, x, v, nin, itask, count_remslv, lskyi_sms_new)
subroutine i11main_tri(timers, ipari, x, v, ms, nin, itask, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, nrtm_t, eshift, nodnx_sms, renum, nsnfiold, intbuf_tab, temp, nodadt_therm)
Definition i11main_tri.F:57
subroutine i20main_opt_tri(ipari, x, v, nin, itask, count_remslv, count_remslve, intbuf_tab)
subroutine i20main_tri(timers, ipari, x, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, temp, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, diag_sms, nodnx_sms, intbuf_tab, h3d_data, glob_therm)
Definition i20main_tri.F:62
subroutine imp_i7mainf(ipari, intbuf_tab, x, v, ms, nin, lindmax, jtask, num_imp, ns_imp, ne_imp, ind_imp)
Definition i7ke3.F:403
subroutine i7main_opt_tri(ipari, x, v, nin, itask, count_remslv, intbuf_tab, lskyi_sms_new)
subroutine i7main_tri(timers, ipari, x, v, ms, nin, itask, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, temp, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, intbuf_tab, h3d_data, ixs, multi_fvm, glob_therm)
Definition i7main_tri.F:67
subroutine spmd_i7xvcom2(ipari, x, v, ms, imsch, i2msch, dt2prev, intlist, nbintc, islen7, irlen7, islen11, irlen11, islen17, irlen17, ixs, ixs16, nsensor, igrbric, temp, iflag, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, ikine, diag_sms, sensor_tab, intbuf_tab, int24e2euse, forneqs, multi_fvm, interfaces, ish_offset)
subroutine spmd_ifront(ipari, newfront, isendto, ircvfrom, nsensor, nbintc, intlist, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, sensor_tab, intbuf_tab, mode)
Definition spmd_ifront.F:46
subroutine spmd_sd_xv(output, x, d, v, vr, ms, in, iad_elem, fr_elem, weight, imsch, w, isizxv, ilenxv, xdp)
Definition spmd_sd_xv.F:42

◆ ini_kinkn()

subroutine ini_kinkn ( 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, dimension(nifv,*) ibfv,
integer, dimension(*) lj,
integer, dimension(*) iskew,
integer, dimension(*) icodt,
integer nrb_mv,
integer, dimension(2,*) irb_mv,
integer ni2_mv,
integer, dimension(2,*) ii2_mv,
integer nbc_mv,
integer, dimension(3,*) ibc_mv,
integer nfx_mv,
integer, dimension(2,*) ifx_mv,
integer nrw_mv,
integer, dimension(*) irw_mv,
integer, dimension(nrbe3l,*) irbe3,
integer nrbe3_mv,
integer, dimension(*) irbe3_mv,
integer nspc_mv,
integer, dimension(*) ispc_mv,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer nrbe2_mv,
integer, dimension(*) irbe2_mv )

Definition at line 1998 of file imp_int_k.F.

2006C-----------------------------------------------
2007C M o d u l e s
2008C-----------------------------------------------
2009 USE imp_rwl
2010 USE imp_aspc
2011 USE intbufdef_mod
2012C-----------------------------------------------
2013C I m p l i c i t T y p e s
2014C-----------------------------------------------
2015#include "implicit_f.inc"
2016C-----------------------------------------------
2017C C o m m o n B l o c k s
2018C-----------------------------------------------
2019#include "com04_c.inc"
2020#include "param_c.inc"
2021C-----------------------------------------------
2022C D u m m y A r g u m e n t s
2023C-----------------------------------------------
2024 INTEGER IBFV(NIFV,*),LJ(*),ISKEW(*) ,ICODT(*)
2025 INTEGER NPBY(NNPBY,*),LPBY(*),NRBYAC,IRBYAC(*),
2026 . NINT2,IINT2(*),IPARI(NPARI,*),IRBE3(NRBE3L,*),
2027 . IRBE2(NRBE2L,*),LRBE2(*)
2028 INTEGER
2029 . INLOC(*),NRB_MV,NI2_MV,IRB_MV(2,*),II2_MV(2,*),
2030 . NBC_MV,IBC_MV(3,*) ,NFX_MV,IFX_MV(2,*),NRW_MV,IRW_MV(*),
2031 . NRBE3_MV,IRBE3_MV(*),NSPC_MV,ISPC_MV(*),NRBE2_MV,IRBE2_MV(*)
2032C REAL
2033
2034 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2035C-----------------------------------------------
2036C L o c a l V a r i a b l e s
2037C-----------------------------------------------
2038 INTEGER
2039 . I,J,K,N,L,NL,NJ,NI,J1,M,NSN,N1,N2,NK,ID,NR3,NR4,
2040 . JI,K10,K11,K12,K13,K14,KFI,NI2,NRB,NBC,NFX,NRW,NSPC
2041c----------------------
2042 ni2=0
2043 IF (ni2_mv>0) THEN
2044 DO j=1,nint2
2045 n=iint2(j)
2046 nsn = ipari(5,n)
2047 ji=ipari(1,n)
2048 k10=ji-1
2049 k11=k10+4*ipari(3,n)
2050C------IRECT(4,NSN)-----
2051 k12=k11+4*ipari(4,n)
2052C------NSV(NSN)--node number---
2053 k13=k12+nsn
2054C------MSR(NMN)-----
2055 k14=k13+ipari(6,n)
2056C------IRTL(NSN)--main el number---
2057 kfi=k14+nsn
2058 DO i=1,nsn
2059 ni=intbuf_tab(n)%NSV(i)
2060 IF (inloc(ni)>0) THEN
2061 ni2=ni2+1
2062 ii2_mv(1,ni2)=n
2063 ii2_mv(2,ni2)=i
2064 ENDIF
2065 ENDDO
2066 ENDDO
2067 IF (ni2/=ni2_mv) WRITE(*,*)'pb cal NI2_M'
2068 ENDIF
2069C--------RBE3--------------------
2070 IF (nrbe3_mv>0) THEN
2071 nr3=0
2072 DO n=1,nrbe3
2073 ni = irbe3(3,n)
2074 IF (ni==0) cycle
2075 IF (inloc(ni)>0) THEN
2076 nr3=nr3+1
2077 irbe3_mv(nr3)=n
2078 ENDIF
2079 ENDDO
2080 IF (nr3/=nrbe3_mv) WRITE(*,*)'pb cal NRBE3_M'
2081 ENDIF
2082C-----active rigid body main nodes------
2083 nrb=0
2084 IF (nrb_mv>0) THEN
2085 DO j=1,nrbyac
2086 n=irbyac(j)
2087 k=irbyac(j+nrbykin)
2088 m =npby(1,n)
2089 IF (inloc(m)>0) THEN
2090 nsn =npby(2,n)
2091 DO i=1,nsn
2092 id = i+k
2093 ni=lpby(id)
2094 IF (inloc(ni)>0) THEN
2095 nrb=nrb+1
2096 irb_mv(1,nrb)=m
2097 irb_mv(2,nrb)=ni
2098 ENDIF
2099 ENDDO
2100 ENDIF
2101 ENDDO
2102 IF (nrb/=nrb_mv) WRITE(*,*)'pb cal NRB_M'
2103 ENDIF
2104C +++
2105 IF (nbc_mv>0) THEN
2106 nbc = 0
2107 DO n=1,numnod
2108 IF (iskew(n)>1.AND.icodt(n)/=7) THEN
2109 IF (inloc(n)>0) THEN
2110 nbc = nbc + 1
2111 ibc_mv(1,nbc) = n
2112 ibc_mv(2,nbc) = iskew(n)
2113 ibc_mv(3,nbc) = icodt(n)
2114 ENDIF
2115 ENDIF
2116 ENDDO
2117 IF (nbc/=nbc_mv) WRITE(*,*)'pb cal NBC_M'
2118 ENDIF
2119C-
2120 IF (nspc_mv>0) THEN
2121 nspc = 0
2122 DO n=1,nspcl
2123 IF (inloc(n)>0.AND.ic_spc(n)<=3)THEN
2124 nspc = nspc + 1
2125 ispc_mv(nspc) = n
2126 ENDIF
2127 ENDDO
2128 IF (nspc/=nspc_mv) WRITE(*,*)'pb cal NSPC_M'
2129 ENDIF
2130C---
2131 IF (nfx_mv>0) THEN
2132 nfx = 0
2133 DO j=1,nfxvel
2134 IF (lj(j)>0.AND.lj(j)<=3) THEN
2135 n=iabs(ibfv(1,j))
2136 IF (inloc(n)>0) THEN
2137 nfx = nfx + 1
2138 ifx_mv(1,nfx) = j
2139 ifx_mv(2,nfx) = lj(j)
2140 ENDIF
2141 ENDIF
2142 ENDDO
2143 IF (nfx/=nfx_mv) WRITE(*,*)'pb cal NFX_M'
2144 ENDIF
2145C
2146 IF (nrw_mv>0) THEN
2147 nrw = 0
2148 DO j=1,n_rwl
2149 n=in_rwl(j)
2150 IF (inloc(n)>0) THEN
2151 nrw = nrw + 1
2152 irw_mv(nrw) = j
2153 ENDIF
2154 ENDDO
2155 IF (nrw/=nrw_mv) WRITE(*,*)'pb cal NRW_M'
2156 ENDIF
2157C-----RBE2------
2158 nr4=0
2159 IF (nrbe2_mv>0) THEN
2160 DO n=1,nrbe2
2161 k=irbe2(1,n)
2162 m =irbe2(3,n)
2163 IF (inloc(m)>0) THEN
2164 nsn =irbe2(5,n)
2165 DO i=1,nsn
2166 id = i+k
2167 ni=lrbe2(id)
2168 IF (inloc(ni)>0) THEN
2169 nr4=nr4+1
2170 irb_mv(1,nr4)=n
2171 irb_mv(2,nr4)=ni
2172 ENDIF
2173 ENDDO
2174 ENDIF
2175 ENDDO
2176 IF (nr4/=nrbe2_mv) WRITE(*,*)'pb cal NRBE2'
2177 ENDIF
2178C ---
2179C----6---------------------------------------------------------------7---------8
2180 RETURN

◆ int_fku3()

subroutine int_fku3 ( a,
v,
ms,
d,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
x,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) index2,
integer iupd )

Definition at line 2600 of file imp_int_k.F.

2603C-----------------------------------------------
2604C M o d u l e s
2605C-----------------------------------------------
2606 USE intbufdef_mod
2607C-----------------------------------------------
2608C I m p l i c i t T y p e s
2609C-----------------------------------------------
2610#include "implicit_f.inc"
2611C-----------------------------------------------
2612C C o m m o n B l o c k s
2613C-----------------------------------------------
2614#include "com04_c.inc"
2615#include "param_c.inc"
2616C-----------------------------------------------
2617C D u m m y A r g u m e n t s
2618C-----------------------------------------------
2619 INTEGER IPARI(NPARI,*), INDEX2(*)
2620 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IUPD
2621 my_real
2622 . x(3,*),a(3,*),d(3,*), ms(*),v(3,*)
2623
2624 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2625C-----------------------------------------------
2626C L o c a l V a r i a b l e s
2627C-----------------------------------------------
2628 INTEGER I, J,N,K,K1,ID,IAD,IS,NN,NTY,I_INT7
2629C
2630 iad = 1
2631C-----------int5 first-------------
2632 DO n=1,ninter
2633 nty =ipari(7,n)
2634 IF(nty==7) THEN
2635 CALL i7fku3( a ,v ,ms ,d ,
2636 1 ipari ,intbuf_tab(n),x ,n ,
2637 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,index2(iad),iupd )
2638 iad=iad+num_imp(n)
2639 ELSEIF(nty==10)THEN
2640 CALL i10fku3( a ,v ,ms ,d ,
2641 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
2642 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,index2(iad),iupd )
2643 iad=iad+num_imp(n)
2644 ELSEIF(nty==11)THEN
2645 CALL i11fku3( a ,v ,ms ,d ,
2646 1 ipari(1,n),intbuf_tab(n) ,x ,n ,
2647 2 num_imp(n),ns_imp(iad),ne_imp(iad) ,iupd )
2648 iad=iad+num_imp(n)
2649 ENDIF
2650 ENDDO
2651c IMP_INT7 = I_INT7
2652C
2653 RETURN
subroutine i10fku3(a, v, ms, d, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, index2, iupd)
Definition i10ke3.F:293
subroutine i11fku3(a, v, ms, d, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, iupd)
Definition i11ke3.F:468
subroutine i7fku3(a, v, ms, d, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, index2, iupd)
Definition i7ke3.F:602

◆ int_matv()

subroutine int_matv ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) ndof,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) index2,
a,
ar,
v,
x,
ms,
x_imp,
integer, dimension(*) ibfv,
skew,
xframe,
u,
f,
integer iupd,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 2405 of file imp_int_k.F.

2410C-----------------------------------------------
2411C M o d u l e s
2412C-----------------------------------------------
2413 USE imp_knon
2414 USE intbufdef_mod
2415C-----------------------------------------------
2416C I m p l i c i t T y p e s
2417C-----------------------------------------------
2418#include "implicit_f.inc"
2419C-----------------------------------------------
2420C C o m m o n B l o c k s
2421C-----------------------------------------------
2422#include "com04_c.inc"
2423#include "param_c.inc"
2424C-----------------------------------------------
2425C D u m m y A r g u m e n t s
2426C-----------------------------------------------
2427 INTEGER IPARI(NPARI,*), INDEX2(*),NDOF(*)
2428 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IBFV(*),IUPD,
2429 . IRBE3(*) ,LRBE3(*),IRBE2(*) ,LRBE2(*)
2430 my_real
2431 . x(3,*),a(3,*),ar(3,*), f(*), u(*),
2432 . x_imp(3,*),v(3,*),skew(*) ,xframe(*),ms(*)
2433
2434 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2435C-----------------------------------------------
2436C L o c a l V a r i a b l e s
2437C-----------------------------------------------
2438 INTEGER I, J,N,K,K1,KK1,N1,N2,N3,N4,ID,IAD,IS,NN,NTY
2439 my_real
2440 . d(3,numnod)
2441C----------------actualise D,X_IMP---------------------
2442 CALL imp3_u2x(x ,ipari ,intbuf_tab ,ndof ,
2443 . u ,d ,ar ,x_imp ,numn_kn,
2446 . nbc_kn,ibc_kn ,nrw_kn,irw_kn ,ibfv ,
2447 . skew ,xframe ,irbe3 ,lrbe3 ,nrbe3_kn,
2448 . irbe3_kn,id_knm3,rkn_max,fcdi_kn,mcdi_kn,
2449 . nspc_kn,ispc_kn ,irbe2 ,lrbe2 ,nrbe2_kn,
2450 . irbe2_kn,id_knm4)
2451 CALL zeror(a,numnod)
2452 IF ((nrb_kn+ni2_kn+nrbe3_kn)>0) CALL zeror(ar,numnod)
2453C----------------
2454 IF (iupd>0) THEN
2455 CALL int_fku3(a ,v ,ms ,d ,
2456 1 ipari ,intbuf_tab ,x_imp,num_imp,
2457 2 ns_imp ,ne_imp ,index2,iupd )
2458 CALL imp3_a2b(ipari ,intbuf_tab ,ndof ,x_imp ,
2459 1 a ,ar ,numn_kn,in_kn,id_kn ,
2462 4 nrw_kn ,irw_kn ,ibfv ,skew ,xframe,
2463 5 f ,irbe3 ,lrbe3 ,nrbe3_kn,irbe3_kn,
2464 6 id_knm3,rkn_max,fcdi_kn,mcdi_kn,nspc_kn,
2465 7 ispc_kn,irbe2 ,lrbe2 ,nrbe2_kn,irbe2_kn,
2466 . id_knm4)
2467 ELSE
2468 CALL int_fku3(a ,v ,ms ,d ,
2469 1 ipari ,intbuf_tab ,x ,num_imp,
2470 2 ns_imp ,ne_imp ,index2 ,iupd )
2471 CALL imp3_a2b(ipari ,intbuf_tab ,ndof ,x ,
2472 1 a ,ar ,numn_kn,in_kn,id_kn ,
2475 4 nrw_kn ,irw_kn ,ibfv ,skew ,xframe,
2476 5 f ,irbe3 ,lrbe3 ,nrbe3_kn,irbe3_kn,
2477 6 id_knm3,rkn_max,fcdi_kn,mcdi_kn,nspc_kn,
2478 7 ispc_kn,irbe2 ,lrbe2 ,nrbe2_kn,irbe2_kn,
2479 . id_knm4)
2480 ENDIF
2481 RETURN
subroutine int_fku3(a, v, ms, d, ipari, intbuf_tab, x, num_imp, ns_imp, ne_imp, index2, iupd)
Definition imp_int_k.F:2603
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
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
integer nbc_kn
integer rkn_max
integer numn_kn
integer nrbe3_kn
integer, dimension(:,:), allocatable id_knm4
integer, dimension(:,:), allocatable irb_kn
integer, dimension(:,:,:), allocatable id_knm2
integer, dimension(:), allocatable ispc_kn
integer, dimension(:), allocatable irw_kn
integer, dimension(:,:), allocatable id_kn
integer, dimension(:), allocatable in_kn
integer, dimension(:,:), allocatable ibc_kn
integer, dimension(:,:), allocatable irbe2_kn
integer, dimension(:,:), allocatable ii2_kn
integer, dimension(:,:), allocatable id_knm
integer nspc_kn
integer ni2_kn
integer nrw_kn
integer, dimension(:,:,:), allocatable id_knm3
integer nfx_kn
integer nrbe2_kn
integer, dimension(:,:), allocatable ifx_kn
integer, dimension(:), allocatable irbe3_kn
integer nrb_kn
subroutine zeror(a, n)
Definition zero.F:39

◆ int_matvp()

subroutine int_matvp ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) ndof,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) index2,
a,
ar,
v,
x,
ms,
x_imp,
integer, dimension(*) ibfv,
skew,
xframe,
u,
f,
dr,
integer nsrem,
integer nsl,
integer iupd,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 2501 of file imp_int_k.F.

2507C-----------------------------------------------
2508C M o d u l e s
2509C-----------------------------------------------
2510 USE imp_knon
2511 USE imp_intm
2512 USE intbufdef_mod
2513C-----------------------------------------------
2514C I m p l i c i t T y p e s
2515C-----------------------------------------------
2516#include "implicit_f.inc"
2517C-----------------------------------------------
2518C C o m m o n B l o c k s
2519C-----------------------------------------------
2520#include "com04_c.inc"
2521#include "param_c.inc"
2522C-----------------------------------------------
2523C D u m m y A r g u m e n t s
2524C-----------------------------------------------
2525 INTEGER IPARI(NPARI,*), INDEX2(*),NSREM ,NSL
2526 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IBFV(*),IUPD,NDOF(*),
2527 . IRBE3(*) ,LRBE3(*),IRBE2(*) ,LRBE2(*)
2528 my_real
2529 . x(3,*),a(3,*),ar(3,*), f(*), u(*),
2530 . x_imp(3,*),skew(*) ,xframe(*),dr(3,*),v(3,*),ms(*)
2531
2532 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2533C-----------------------------------------------
2534C L o c a l V a r i a b l e s
2535C-----------------------------------------------
2536 INTEGER I, J,N,K,K1,KK1,N1,N2,N3,N4,ID,IAD,IS,NN,NTY
2537 my_real
2538 . d(3,numnod)
2539C----------------actualise D,X_IMP---------------------
2540 CALL imp3_u2x(x ,ipari ,intbuf_tab ,ndof ,
2541 . u ,d ,ar ,x_imp ,numn_kn,
2544 . nbc_kn,ibc_kn ,nrw_kn,irw_kn ,ibfv ,
2545 . skew ,xframe ,irbe3 ,lrbe3 ,nrbe3_kn,
2546 . irbe3_kn,id_knm3,rkn_max,fcdi_kn,mcdi_kn,
2547 . nspc_kn,ispc_kn ,irbe2 ,lrbe2 ,nrbe2_kn,
2548 . irbe2_kn,id_knm4)
2549 CALL zeror(a,numnod)
2550 IF ((nrb_kn+ni2_kn+nrbe3_kn)>0) CALL zeror(ar,numnod)
2551C----- Return of (nsl) and Receive DFI (nsrem) ------
2552 IF ((nsrem+nsl)>0) THEN
2553 CALL spmd_ifcd(d ,nsl, nsrem)
2554 IF (nsrem>0) CALL zeror(ffi,nsrem)
2555 ENDIF
2556C----------------
2557 IF (iupd>0) THEN
2558 CALL int_fku3(a ,v ,ms ,d ,
2559 1 ipari ,intbuf_tab,x_imp,num_imp,
2560 2 ns_imp ,ne_imp ,index2,iupd )
2561 IF ((nsrem+nsl)>0) CALL spmd_ifcf(a, nsrem ,nsl)
2562 CALL imp3_a2b(ipari ,intbuf_tab ,ndof ,x_imp ,
2563 1 a ,ar ,numn_kn,in_kn,id_kn ,
2566 4 nrw_kn ,irw_kn ,ibfv ,skew ,xframe,
2567 5 f ,irbe3 ,lrbe3 ,nrbe3_kn,irbe3_kn,
2568 6 id_knm3,rkn_max,fcdi_kn,mcdi_kn,nspc_kn,
2569 7 ispc_kn,irbe2 ,lrbe2 ,nrbe2_kn,irbe2_kn,
2570 . id_knm4)
2571 ELSE
2572 CALL int_fku3(a ,v ,ms ,d ,
2573 1 ipari ,intbuf_tab ,x ,num_imp,
2574 2 ns_imp ,ne_imp ,index2 ,iupd )
2575 IF ((nsrem+nsl)>0) CALL spmd_ifcf(a, nsrem ,nsl)
2576 CALL imp3_a2b(ipari ,intbuf_tab ,ndof ,x ,
2577 1 a ,ar ,numn_kn,in_kn,id_kn ,
2580 4 nrw_kn ,irw_kn ,ibfv ,skew ,xframe,
2581 5 f ,irbe3 ,lrbe3 ,nrbe3_kn,irbe3_kn,
2582 6 id_knm3,rkn_max,fcdi_kn,mcdi_kn,nspc_kn,
2583 7 ispc_kn,irbe2 ,lrbe2 ,nrbe2_kn,irbe2_kn,
2584 . id_knm4)
2585 ENDIF
2586 RETURN
subroutine spmd_ifcd(d_imp, ssize, rsize)
Definition imp_spmd.F:2326
subroutine spmd_ifcf(f_imp, ssize, rsize)
Definition imp_spmd.F:2450

◆ kin_knl()

subroutine kin_knl ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) itab,
integer nrbyac,
integer, dimension(*) irbyac,
integer nint2,
integer, dimension(*) iint2,
integer, dimension(*) ibfv,
integer, dimension(*) lj,
integer, dimension(*) iskew,
integer, dimension(*) icodt,
integer, dimension(*) ndofi,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer, dimension(*) inloc,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
frbe3,
x,
skew,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 1696 of file imp_int_k.F.

1703C-----------------------------------------------
1704C M o d u l e s
1705C-----------------------------------------------
1706 USE imp_knon
1707 USE imp_aspc
1708 USE intbufdef_mod
1709C-----------------------------------------------
1710C I m p l i c i t T y p e s
1711C-----------------------------------------------
1712#include "implicit_f.inc"
1713C-----------------------------------------------
1714C C o m m o n B l o c k s
1715C-----------------------------------------------
1716#include "com04_c.inc"
1717#include "param_c.inc"
1718C-----------------------------------------------
1719C D u m m y A r g u m e n t s
1720C-----------------------------------------------
1721 INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
1722 . NE_IMP(*),NDOFI(*)
1723 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
1724 . NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
1725 . IBFV(*),LJ(*),ISKEW(*),ICODT(*),IRBE3(NRBE3L,*),LRBE3(*),
1726 . IRBE2(NRBE2L,*),LRBE2(*)
1727C REAL
1728 my_real
1729 . x(*),skew(*),frbe3(*)
1730 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1731C-----------------------------------------------
1732C L o c a l V a r i a b l e s
1733C-----------------------------------------------
1734 INTEGER I,J,N, IAD,NTY,NDOFII(NUMNOD),NKC,
1735 . IERR1,IERR2,IERR3,IERR4,IERR5,IERR6,ND,NMT,IROT,NUMN
1736C-----------------------------------------------
1737 DO n=1,numnod
1738 ndofii(n) = iabs(ndofi(n))
1739 ENDDO
1740 numn_kn = 0
1741 DO n=1,numnod
1742 IF (ndofii(n)>0) numn_kn = numn_kn + 1
1743 ENDDO
1744C--------allocation------
1745C
1746 ALLOCATE(in_kn(numn_kn),id_kn(3,numn_kn),stat=ierr1)
1747 IF (numn_kn > 0) THEN
1748 id_kn = -7
1749 n = 0
1750C------------negative value for nsl nodes-----
1751 DO i=1,numnod
1752 IF (ndofii(i)>0) THEN
1753 n = n + 1
1754 in_kn(n) = i
1755 ENDIF
1756 ENDDO
1757 END IF
1758 CALL dim_kinkn(
1759 1 npby ,lpby ,nrbyac ,irbyac ,nint2 ,
1760 2 iint2 ,ipari ,intbuf_tab,ndofii ,ibfv ,
1761 3 lj ,iskew ,icodt ,nrb_kn ,ni2_kn ,
1762 4 nbc_kn ,nfx_kn ,nrw_kn ,irbe3 ,nrbe3_kn ,
1763 5 nspc_kn ,irbe2 ,lrbe2 ,nrbe2_kn )
1764 IF (ni2_kn>0) THEN
1765 ALLOCATE(ii2_kn(2,ni2_kn),id_knm2(6,4,ni2_kn),stat=ierr2)
1766 ENDIF
1767 IF (nrb_kn>0) THEN
1768 ALLOCATE(irb_kn(2,nrb_kn),id_knm(6,nrb_kn),stat=ierr3)
1769 ENDIF
1770 IF (nbc_kn>0) THEN
1771 IF(ALLOCATED(ibc_kn)) DEALLOCATE(ibc_kn)
1772 ALLOCATE(ibc_kn(3,nbc_kn),stat=ierr4)
1773 ENDIF
1774 IF (nspc_kn>0) THEN
1775 IF(ALLOCATED(ispc_kn)) DEALLOCATE(ispc_kn)
1776 ALLOCATE(ispc_kn(nspc_kn),stat=ierr4)
1777 ENDIF
1778C--
1779 IF (nfx_kn>0) THEN
1780 IF(ALLOCATED(ifx_kn)) DEALLOCATE(ifx_kn)
1781 ALLOCATE(ifx_kn(2,nfx_kn),stat=ierr5)
1782 ENDIF
1783C
1784 IF (nrw_kn>0) THEN
1785 IF(ALLOCATED(irw_kn)) DEALLOCATE(irw_kn)
1786 ALLOCATE(irw_kn(nrw_kn),stat=ierr6)
1787 ENDIF
1788C
1789 IF (nrbe3_kn>0) THEN
1790 ALLOCATE(irbe3_kn(nrbe3_kn),stat=ierr6)
1791 ENDIF
1792C
1793 IF (nrbe2_kn>0) THEN
1794 ALLOCATE(irbe2_kn(2,nrbe2_kn),id_knm4(6,nrbe2_kn),stat=ierr3)
1795 ENDIF
1796C
1797 CALL ini_kinkn(
1798 1 npby ,lpby ,nrbyac ,irbyac ,nint2 ,
1799 2 iint2 ,ipari ,intbuf_tab,ndofii ,ibfv ,
1800 3 lj ,iskew ,icodt ,nrb_kn ,irb_kn ,
1802 4 ifx_kn ,nrw_kn ,irw_kn ,irbe3 ,nrbe3_kn ,
1803 5 irbe3_kn ,nspc_kn ,ispc_kn ,irbe2 ,lrbe2 ,
1804 6 nrbe2_kn ,irbe2_kn )
1805C ------ini RBE3---
1806 IF (nrbe3_kn>0) THEN
1807 iad=0
1808 nmt = 0
1809 irot=0
1810 DO i=1,nrbe3_kn
1811 n=irbe3_kn(i)
1812 numn = irbe3(5,n)
1813 iad=max(iad,numn)
1814 nmt = nmt + numn
1815 irot=max(irot,irbe3(6,n))
1816 ENDDO
1817 ALLOCATE(id_knm3(6,iad,nrbe3_kn),stat=ierr3)
1818 id_knm3=0
1819 rkn_max=iad
1820 ALLOCATE(fcdi_kn(18*nmt),stat=ierr5)
1821 fcdi_kn=zero
1822 IF (irot>0) THEN
1823 ALLOCATE(mcdi_kn(18*nmt),stat=ierr5)
1824 mcdi_kn=zero
1825 ENDIF
1826 CALL rbe3_mint(irbe3 ,lrbe3 ,frbe3 ,x ,skew ,
1827 . nrbe3_kn,irbe3_kn ,fcdi_kn,mcdi_kn)
1828 ENDIF
1829C--------- use NDOFII(I)--as IDDLM ------------
1830 IF (numn_kn == 0) RETURN
1831 nkc=0
1832 DO n =1,numnod
1833 i=inloc(n)
1834 ndofii(i)=iddl(i)-nkc
1835 DO j=1,ndof(i)
1836 nd = iddl(i)+j
1837 IF (ikc(nd)/=0) nkc = nkc + 1
1838 ENDDO
1839 ENDDO
1840 CALL iddl_mint(numn_kn,in_kn ,iddl ,ikc ,ndof ,
1841 . ndofii ,ipari ,intbuf_tab,id_kn ,nrb_kn ,
1843 . irbe3 ,lrbe3 ,nrbe3_kn,irbe3_kn,id_knm3 ,
1844 . rkn_max ,irbe2 ,nrbe2_kn,irbe2_kn,id_knm4 )
1845C------------return origine NDOFI(I)----
1846 DO i=1,numnod
1847 IF (ndofi(i)<0) ndofi(i) = 0
1848 ENDDO
1849 RETURN
subroutine iddl_mint(nml, iml, iddl, ikc, ndof, iddlm, ipari, intbuf_tab, iddml, nrb_fr, ifrsr, iddmr, ni2_fr, ifrs2, iddmi2, irbe3, lrbe3, nrbe3_fr, ifrs3, iddmi3, m_max, irbe2, nrbe2_fr, ifrs4, iddmi4)
Definition imp_int_k.F:2194
subroutine rbe3_mint(irbe3, lrbe3, frbe3, x, skew, nrbe3_kn, irbe3_kn, frcdi, mrcdi)
Definition imp_int_k.F:2349
subroutine dim_kinkn(npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, ibfv, lj, iskew, icodt, lns, lns2, lbcl, lfxl, lrw, irbe3, lns3, lspcl, irbe2, lrbe2, lns4)
Definition imp_int_k.F:1866
subroutine ini_kinkn(npby, lpby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, inloc, ibfv, lj, iskew, icodt, nrb_mv, irb_mv, ni2_mv, ii2_mv, nbc_mv, ibc_mv, nfx_mv, ifx_mv, nrw_mv, irw_mv, irbe3, nrbe3_mv, irbe3_mv, nspc_mv, ispc_mv, irbe2, lrbe2, nrbe2_mv, irbe2_mv)
Definition imp_int_k.F:2006

◆ pr_kint()

subroutine pr_kint ( integer nddli,
integer imconv,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
integer, dimension(*) itok,
diag_i,
lt_i )

Definition at line 2658 of file imp_int_k.F.

2660C-----------------------------------------------
2661C I m p l i c i t T y p e s
2662C-----------------------------------------------
2663#include "implicit_f.inc"
2664C-----------------------------------------------
2665C C o m m o n B l o c k s
2666C-----------------------------------------------
2667#include "task_c.inc"
2668C-----------------------------------------------
2669C D u m m y A r g u m e n t s
2670C-----------------------------------------------
2671C REAL
2672 INTEGER
2673 . NDDLI,IADI(*),JDII(*),ITOK(*),IMCONV
2674 my_real
2675 . diag_i(*),lt_i(*)
2676C-----------------------------------------------
2677C L o c a l V a r i a b l e s
2678C-----------------------------------------------
2679Ctmp +3
2680 INTEGER i,j,N,ID,ND,NKC,IDF,nnod,nk,iad,iad2,id2
2681 CHARACTER CHIF
2682 CHARACTER*10 FILNAME
2683C------
2684 idf = ispmd+13
2685 WRITE(chif,'(I1)')ispmd
2686 filname='KINT'//chif//'.TMP'
2687 OPEN(unit=idf,file=filname,status='UNKNOWN',form='FORMATTED')
2688 write(idf,*)'NDDLI,=', nddli
2689 if (imconv<0) return
2690 write(idf,*)'[Ki]=',nddli
2691 DO i =1,nddli
2692 write(idf,*)'DIAG_I,itok=',diag_i(i),itok(i)
2693 ENDDO
2694 DO i =1,nddli
2695 write(idf,*)'NR,I=',iadi(i+1)-iadi(i),i
2696 DO j=iadi(i),iadi(i+1)-1
2697 write(idf,*)'LT_I,NJ,J=',lt_i(j),itok(jdii(j)),j
2698 ENDDO
2699 ENDDO
2700C------------------------------------------
2701 RETURN

◆ rbe3_mint()

subroutine rbe3_mint ( integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
frbe3,
x,
skew,
integer nrbe3_kn,
integer, dimension(*) irbe3_kn,
frcdi,
mrcdi )

Definition at line 2347 of file imp_int_k.F.

2349C-----------------------------------------------
2350C I m p l i c i t T y p e s
2351C-----------------------------------------------
2352#include "implicit_f.inc"
2353C-----------------------------------------------
2354C C o m m o n B l o c k s
2355C-----------------------------------------------
2356#include "param_c.inc"
2357#include "tabsiz_c.inc"
2358C-----------------------------------------------
2359C D u m m y A r g u m e n t s
2360C-----------------------------------------------
2361 INTEGER IRBE3(NRBE3L,*),LRBE3(*) ,NRBE3_KN,IRBE3_KN(*)
2362 my_real
2363 . frbe3(*),x(*),skew(*),frcdi(*),mrcdi(*)
2364C-----------------------------------------------
2365C L o c a l V a r i a b l e s
2366C-----------------------------------------------
2367 INTEGER I,ID,N,J,NDD,I1,IAD,NMT,IROTG,IADS
2368 INTEGER M,NNOD,NJ,NL,NI
2369C-----------------------------------------------
2370C S o u r c e L i n e s
2371C-----------------------------------------------
2372 IF (nrbe3_kn>0) THEN
2373C------- init FRCDI,MRCDI
2374 nmt = slrbe3/2
2375 iads =1
2376 DO i=1,nrbe3_kn
2377 n=irbe3_kn(i)
2378 ni=irbe3(3,n)
2379 nnod=irbe3(5,n)
2380 iad=irbe3(1,n)
2381 irotg =irbe3(6,n)
2382 CALL rbe3cl(lrbe3(iad+1),lrbe3(nmt+iad+1),ni ,x ,
2383 . frbe3(iad+1),skew ,nnod ,irotg ,frcdi(iads),
2384 . mrcdi(iads) ,irbe3(2,n))
2385C-------
2386 iads = iads + nnod
2387 ENDDO
2388 ENDIF
2389C
2390 RETURN
subroutine rbe3cl(inrbe3, ilrbe3, ns, xyz, frbe3, skew, ng, irot, fdstnb, mdstnb)
Definition kinchk.F:1592

◆ sav_inttd()

subroutine sav_inttd ( integer nt_imp,
integer, dimension(*) numimp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) ind_imp,
integer, dimension(*) numimp1 )

Definition at line 1441 of file imp_int_k.F.

1443C-----------------------------------------------
1444C M o d u l e s
1445C-----------------------------------------------
1446 USE imp_inttd
1447C-----------------------------------------------
1448C I m p l i c i t T y p e s
1449C-----------------------------------------------
1450#include "implicit_f.inc"
1451C-----------------------------------------------
1452C C o m m o n B l o c k s
1453C-----------------------------------------------
1454#include "com01_c.inc"
1455#include "com04_c.inc"
1456#include "impl1_c.inc"
1457C-----------------------------------------------
1458C D u m m y A r g u m e n t s
1459C-----------------------------------------------
1460 INTEGER NT_IMP,NUMIMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
1461 . NUMIMP1(*)
1462C-----------------------------------------------
1463C L o c a l V a r i a b l e s
1464C-----------------------------------------------
1465 INTEGER I,J,K,L,N,IAD,IAD1,IADT
1466 INTEGER IERROR1,IERROR2,IERROR3,IERROR4
1467C-----------------------------------------------
1468C S o u r c e L i n e s
1469C-----------------------------------------------
1470 IF(nt_imp1==0) RETURN
1471C------in NS_IMP1 input: NT_IMP1 , output:d'abord NT_IMP1, + NT_IMP-NT_IMP1
1472C------in NS_IMP input:d'abord NT_IMP1, + NT_IMP-NT_IMP1, output: NT_IMP
1473 nt_imp = nt_imp + nt_imp1
1474 IF(nspmd>1) THEN
1475 iad1 = 0
1476 DO n = 1,ninter
1477 DO i = 1,numimp1(n)
1478 ns_imp(iad1+i)=ns_imp1(iad1+i)
1479 END DO
1480 iad1 =iad1 + numimp1(n)
1481 END DO
1482 ENDIF
1483C----
1484 IF(ALLOCATED(ns_imp1)) DEALLOCATE(ns_imp1)
1485 ALLOCATE(ns_imp1(nt_imp),stat=ierror1)
1486 IF(ALLOCATED(ne_imp1)) DEALLOCATE(ne_imp1)
1487 ALLOCATE(ne_imp1(nt_imp),stat=ierror2)
1488 IF(ALLOCATED(ind_imp1)) DEALLOCATE(ind_imp1)
1489 ALLOCATE(ind_imp1(nt_imp),stat=ierror3)
1490C
1491 iad1 = 0
1492 DO n = 1,ninter
1493 DO i = 1,numimp1(n)
1494 ns_imp1(iad1+i) = ns_imp(iad1+i)
1495 ne_imp1(iad1+i) = ne_imp(iad1+i)
1496 ind_imp1(iad1+i) = ind_imp(iad1+i)
1497 END DO
1498 iad1 =iad1 + numimp1(n)
1499 END DO
1500 DO n = 1,ninter
1501 DO i = 1,numimp(n)
1502 ns_imp1(iad1+i) = ns_imp(iad1+i)
1503 ne_imp1(iad1+i) = ne_imp(iad1+i)
1504 ind_imp1(iad1+i) = ind_imp(iad1+i)
1505 END DO
1506 iad1 =iad1 + numimp(n)
1507 END DO
1508C--------change ind for NS_IMP,INE_IMP,IND_IMP---
1509 iad = 0
1510 iad1 = 0
1511 DO n = 1,ninter
1512 DO i = 1,numimp1(n)
1513 ns_imp(iad+i) = ns_imp1(iad1+i)
1514 ne_imp(iad+i) = ne_imp1(iad1+i)
1515 ind_imp(iad+i) = ind_imp1(iad1+i)
1516 END DO
1517 iad =iad + numimp1(n) + numimp(n)
1518 iad1 = iad1 + numimp1(n)
1519 END DO
1520 iad = 0
1521 DO n = 1,ninter
1522 iadt =iad + numimp1(n)
1523 DO i = 1,numimp(n)
1524 ns_imp(iadt+i) = ns_imp1(iad1+i)
1525 ne_imp(iadt+i) = ne_imp1(iad1+i)
1526 ind_imp(iadt+i) = ind_imp1(iad1+i)
1527 END DO
1528 iad1 =iad1 + numimp(n)
1529 iad =iad + numimp1(n) + numimp(n)
1530 END DO
1531C--------change ind for NUM_IMP---
1532 DO n = 1,ninter
1533 numimp(n) = numimp1(n) + numimp(n)
1534 END DO
1535C
1536 RETURN