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

Go to the source code of this file.

Functions/Subroutines

subroutine produt_v (nddl, x, y, r)
subroutine produt_v_loc (nddl, x, y, r)
subroutine produt_w (nddl, x, y, w, r)
subroutine d_to_u (nddl0, nddl, iddl, ndof, ikc, d, dr, u)
subroutine produt_vm (nddl0, nddl, iddl, ndof, ikc, dd, ddr, y, r, w_imp)
subroutine produt_u (nddl0, nddl, iddl, ndof, ikc, dd, ddr, norm2, w_imp)
subroutine produt_u2 (nddl0, nddl, iddl, ndof, ikc, d1, d1r, d2, d2r, norm2, w_imp)
subroutine zero_ud (num, iddl, ndof, ikc, d, dr, ir)
subroutine mav_lt (nddl, nnz, iadl, jdil, diag_k, lt_k, v, w)
subroutine mav_lt1 (nddl, nnz, iadl, jdil, diag_k, lt_k, v, w)
subroutine mav_lt2 (nddl, nddli, iadl, jdil, diag_k, lt_k, iadi, jdii, itok, lt_i, v, w, monvol, volmon, x, igrsurf, nmonv, imonv, ndof, ipari, intbuf_tab, a, ar, d, ibfv, skew, xframe, ve, ms, num_imp, ns_imp, ne_imp, index2, xi_c, iupd, irbe3, lrbe3)
subroutine mav_ltp (nddl, nddli, iadl, jdil, diag_k, lt_k, iadi, jdii, itok, lt_i, v, w, a, ar, ve, ms, x, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, ibfv, skew, xframe, monvol, volmon, igrsurf, fr_mv, nmonv, imonv, index2, xi_c, iupd, irbe3, lrbe3, irbe2, lrbe2)
subroutine mav_zi (ii, nddl, nnz, iadl, jdil, diag_k, lt_k, nnzz, iadm, jdim, lt_m, w)
subroutine mav_z (ii, nddl, nnz, iadl, jdil, diag_k, lt_k, nnzm, iadm, jdim, lt_m, w)
subroutine buf_dim (l1, l2, l3, l4)
subroutine cp_real (n, x, xc)
subroutine cp_int (n, x, xc)
subroutine produt_v0 (nddl, x, y, r)
subroutine buf_dim1 (l1, lt)
subroutine cp_impbuf (iflag, elbuf, elbuf_c, bufmat, bufmat_c, fsav, volmon, partsav, intbuf_tab, intbuf_tab_c, ipari, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, newfront, elbuf_tab, elbuf_imp, iparg)
subroutine mav_lt_h (nddl, f_ddl, l_ddl, iadl, jdil, diag_k, lt_k, v, w)
subroutine mav_lth0 (nddl, nddli, iadl, jdil, diag_k, lt_k, iadi, jdii, itok, lt_i, v, w, a, ar, ve, ms, x, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, ibfv, skew, xframe, monvol, volmon, igrsurf, fr_mv, nmonv, imonv, index2, xi_c, iupd, irbe3, lrbe3, irbe2, lrbe2, f_ddl, l_ddl, itask)
subroutine mav_lth (nddl, nddli, iadl, jdil, diag_k, lt_k, iadi, jdii, itok, lt_i, v, w, a, ar, ve, ms, x, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, ibfv, skew, xframe, monvol, volmon, igrsurf, fr_mv, nmonv, imonv, index2, xi_c, iupd, irbe3, lrbe3, irbe2, lrbe2, f_ddl, l_ddl, itask)
subroutine produt_h (f_ddl, l_ddl, x, y, w, r, itask)
subroutine produt_vmh (nddl0, nddl, iddl, ndof, ikc, dd, ddr, y, r, w_imp, f_ddl, l_ddl, itask)
subroutine produt_uh (nddl0, nddl, iddl, ndof, ikc, dd, ddr, norm2, w_imp, f_ddl, l_ddl, itask)
subroutine produt_uh2 (nddl0, nddl, iddl, ndof, ikc, d1, d1r, d2, d2r, norm2, w_imp, f_ddl, l_ddl, itask)
subroutine mav_lu_h (nddl, f_ddl, l_ddl, iadl, jdil, diag_k, lt_k, v, w)
subroutine cp_ifront (iflag, ipari, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, newfront)
subroutine produt_u0 (dd, ddr, norm2, weight)
subroutine mav_ltgh (nddl, iadl, jdil, diag_k, lt_k, v, w, f_ddl, l_ddl, itask, nddli)
subroutine mav_lui_h (f_ddl, l_ddl, v, w)
subroutine cp_dm (numgeo, geo, igeo, dmcp, iflag)
subroutine vscal_h (f_ddl, l_ddl, v, s, itask)
subroutine vaxpy_h (f_ddl, l_ddl, a, b, s, itask)
subroutine mortho_gs (f_ddl, l_ddl, nddl, md_f, md_l, a, wddl, itask)
subroutine mav_nm (f_nd, l_nd, nd, md, a, b, c, wddl, itask)
subroutine mav_mn (nd, md, a, b, c, itask)
subroutine mam_nm (f_nd, l_nd, nd, md, a, b, c, wddl, itask)
subroutine mav_mm (nd, md, a, b, itask)
subroutine mmav_lth (nddl, nddli, iadk, jdik, diag_k, lt_k, iadi, jdii, itok, lt_i, v, w, a, ar, ve, ms, x, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, ibfv, skew, xframe, monvol, volmon, igrsurf, fr_mv, nmonv, imonv, ind_imp, xi_c, iupd, irbe3, lrbe3, irbe2, lrbe2, iadm, jdim, diag_m, lt_m, f_ddl, l_ddl, itask, v_w)
subroutine mmv_lth (nddl, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl, itask)
subroutine mmv_lh (nddl, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl, itask)
subroutine mav_liuh (f_ddl, l_ddl, iadi, jdii, itok, lt_i, work_ii, v, w, itask)
subroutine produt_hp (nddl, x, y, w, r)
subroutine produt_vmhp (nddl0, nddl, iddl, ndof, ikc, dd, ddr, y, r, w_imp)
subroutine produt_uhp (nddl0, nddl, iddl, ndof, ikc, dd, ddr, norm2, w_imp)
subroutine produt_uhp2 (nddl0, nddl, iddl, ndof, ikc, d1, d1r, d2, d2r, norm2, w_imp)
subroutine produt_uhp0 (dd, ddr, norm2, weight)
subroutine vscal_hp (n, v, s)
subroutine vscaly_hp (n, v, y, s)
subroutine vaxpy_hp (n, v, y, s)
subroutine cp_real_hp (n, x, xc)
subroutine cp_int_hp (n, x, xc)
subroutine zeror_hp (x, n)

Function/Subroutine Documentation

◆ buf_dim()

subroutine buf_dim ( integer l1,
integer l2,
integer l3,
integer l4 )

Definition at line 817 of file produt_v.F.

818C-----------------------------------------------
819C I m p l i c i t T y p e s
820C-----------------------------------------------
821#include "implicit_f.inc"
822C-----------------------------------------------
823C C o m m o n B l o c k s
824C-----------------------------------------------
825#include "tabsiz_c.inc"
826C-----------------------------------------------
827C D u m m y A r g u m e n t s
828C-----------------------------------------------
829 INTEGER L1,L2,L3 ,L4
830C REAL
831C-----------------------------------------------
832C L o c a l V a r i a b l e s
833C-----------------------------------------------
834C----longueur de ELBUF,BUFMAT--------
835 l1=selbuf
836 l2=sbufmat
837 l3=sfsav
838 l4=svolmon
839C--------------------------------------------
840 RETURN

◆ buf_dim1()

subroutine buf_dim1 ( integer l1,
integer lt )

Definition at line 972 of file produt_v.F.

973C-----------------------------------------------
974C I m p l i c i t T y p e s
975C-----------------------------------------------
976#include "implicit_f.inc"
977C-----------------------------------------------
978C C o m m o n B l o c k s
979C-----------------------------------------------
980#include "com04_c.inc"
981#include "param_c.inc"
982#include "tabsiz_c.inc"
983C-----------------------------------------------
984C D u m m y A r g u m e n t s
985C-----------------------------------------------
986 INTEGER L1,LT
987C REAL
988C-----------------------------------------------
989C L o c a l V a r i a b l e s
990C-----------------------------------------------
991 INTEGER L2,L3,L4,L5,L6
992C----longueur de ELBUF,BUFMAT--------
993 l1=selbuf
994 l2=sbufmat
995 l3=sfsav
996 l4=svolmon
997 l5=npsav*npart
998 lt = l2+l3+l4+l5
999C--------------------------------------------
1000 RETURN

◆ cp_dm()

subroutine cp_dm ( integer numgeo,
geo,
integer, dimension(npropgi,*) igeo,
dmcp,
integer iflag )

Definition at line 2562 of file produt_v.F.

2563C-----------------------------------------------
2564C I m p l i c i t T y p e s
2565C-----------------------------------------------
2566#include "implicit_f.inc"
2567C-----------------------------------------------
2568C C o m m o n B l o c k s
2569C-----------------------------------------------
2570#include "param_c.inc"
2571C-----------------------------------------------
2572C D u m m y A r g u m e n t s
2573C-----------------------------------------------
2574 INTEGER NUMGEO,IGEO(NPROPGI,*),IFLAG
2575C REAL
2576 my_real
2577 . geo(npropg,*),dmcp(*)
2578C-----------------------------------------------
2579C L o c a l V a r i a b l e s
2580C-----------------------------------------------
2581 INTEGER I,IGTYP
2582C-----remove membraine material damping w/ implicit static-----
2583C-----IFLAG=1 > store dm to DMCP and put dm=zero ; IFLAG=2 reput dm
2584 IF (iflag == 1) THEN
2585 DO i=1,numgeo
2586 igtyp = igeo(11,i)
2587 IF(igtyp==1.OR.(igtyp>=9 .AND. igtyp<=11).OR.igtyp==16) THEN
2588 dmcp(i) = geo(16,i)
2589 geo(16,i) = em30
2590 ENDIF
2591 END DO
2592 ELSE
2593 DO i=1,numgeo
2594 igtyp = igeo(11,i)
2595 IF(igtyp==1.OR.(igtyp>=9 .AND. igtyp<=11).OR.igtyp==16) THEN
2596 geo(16,i) = dmcp(i)
2597 ENDIF
2598 END DO
2599 END IF
2600 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ cp_ifront()

subroutine cp_ifront ( integer iflag,
integer, dimension(npari,*) ipari,
integer islen7,
integer irlen7,
integer islen11,
integer irlen11,
integer islen17,
integer irlen17,
integer irlen7t,
integer islen7t,
integer irlen20,
integer islen20,
integer irlen20t,
integer islen20t,
integer irlen20e,
integer islen20e,
integer, dimension(*) newfront )

Definition at line 1850 of file produt_v.F.

1854C-----------------------------------------------
1855C M o d u l e s
1856C-----------------------------------------------
1857 USE tri7box
1858 USE imp_i7cp
1859 USE message_mod
1860C-----------------------------------------------
1861C I m p l i c i t T y p e s
1862C-----------------------------------------------
1863#include "implicit_f.inc"
1864C-----------------------------------------------
1865C C o m m o n B l o c k s
1866C-----------------------------------------------
1867#include "com01_c.inc"
1868#include "com04_c.inc"
1869#include "task_c.inc"
1870#include "param_c.inc"
1871#include "tabsiz_c.inc"
1872#include "impl1_c.inc"
1873#include "scr18_c.inc"
1874#include "parit_c.inc"
1875C-----------------------------------------------
1876C D u m m y A r g u m e n t s
1877C-----------------------------------------------
1878 INTEGER IFLAG ,IPARI(NPARI,*),ISLEN7 ,IRLEN7 ,
1879 . ISLEN11,IRLEN11,ISLEN17 ,IRLEN17,IRLEN7T ,
1880 . ISLEN7T,IRLEN20,ISLEN20 ,IRLEN20T,ISLEN20T,
1881 . IRLEN20E,ISLEN20E,NEWFRONT(*)
1882C REAL
1883C-----------------------------------------------
1884C L o c a l V a r i a b l e s
1885C-----------------------------------------------
1886 INTEGER N, LENS,LENR,INACTI,NSN,NMN,IERR,IID,RID,I,P,
1887 . IGAP,ITYP,LENS0,LENR0,INTTH,J,JFI,JD(50),ITY,IGSTI,
1888 . NREBOU
1889C--------------------------------------------
1890 IF(iflag==1) THEN
1891 IF(ALLOCATED(iparicp)) DEALLOCATE(iparicp)
1892 IF(ALLOCATED(iad_stifold)) DEALLOCATE(iad_stifold)
1893 ALLOCATE(iparicp(npari,ninter),iad_stifold(ninter),stat=ierr)
1894 DO i =1, ninter
1895 ity =ipari(7,i)
1896 igsti =ipari(34,i)
1897 iad_stifold(i)=1
1898C IF (ITY == 24.AND.IGSTI==6) THEN
1899C IAD_STIFOLD(I)=JD(32)
1900C END IF
1901 DO j =1, npari
1902 iparicp(j,i) = ipari(j,i)
1903 END DO
1904 END DO
1905 ELSE
1906 DO i =1, ninter
1907 ity =ipari(7,i)
1908 igsti =ipari(34,i)
1909 IF (ity == 24.AND.igsti==6) THEN
1910 iparicp(26,i) = ipari(26,i)
1911 iparicp(27,i) = ipari(27,i)
1912 iparicp(53,i) = ipari(53,i)
1913 END IF
1914 DO j =1, npari
1915 ipari(j,i) = iparicp(j,i)
1916 END DO
1917 END DO
1918 ENDIF !IF(IFLAG==1) THEN
1919C
1920 IF (nspmd<=1) RETURN
1921C
1922 IF(iflag==1) THEN
1923 lii7cp=0
1924 lri7cp=0
1925 IF(ninter/=0) THEN
1926C dim compute---
1927 DO i =1, ninter
1928 ityp = ipari(7,i)
1929 igap = ipari(21,i)
1930 inacti = ipari(22,i)
1931 intth = ipari(47,i)
1932 IF(ityp==7.OR.ityp==10.OR.ityp==11.OR.ityp==24)THEN
1933 lens = 0
1934 lenr = 0
1935 DO p = 1, nspmd
1936 lens = lens + nsnsi(i)%P(p)
1937 lenr = lenr + nsnfi(i)%P(p)
1938 END DO
1939 lii7cp=lii7cp+2*nspmd+2
1940 lii7cp=lii7cp+lens
1941C
1942 IF (lenr>0) THEN
1943 lii7cp=lii7cp+lenr
1944 IF(ityp==7.OR.ityp==10.OR.ityp==24) THEN
1945C-------------------ITAFI,KINFI
1946 lii7cp=lii7cp+2*lenr
1947 IF (intth > 0 ) lii7cp=lii7cp+lenr
1948C-------------------MSFI,STIFI
1949 lri7cp=lri7cp+2*lenr
1950 IF(igap/=0) lri7cp=lri7cp+lenr
1951C-------------------XFI,VFI
1952 lri7cp=lri7cp+6*lenr
1953 IF(iparit==0) THEN
1954C-------------------AFI,STNFI,VSCFI
1955 lri7cp=lri7cp+4*lenr*nthread
1956 IF(kdtint/=0)lri7cp=lri7cp+lenr*nthread
1957 IF(intth > 0 )lri7cp=lri7cp+2*lenr+2*lenr*nthread
1958 ELSE
1959C-----------------PARITON not yet with implicit----
1960 ENDIF
1961C----- IRTLM_FI,TIME_SFI,SECND_FRFI,PENE_OLDFI,STIF_OLDFI
1962 IF(ityp==24) THEN
1963 lii7cp=lii7cp+2*lenr
1964 lri7cp=lri7cp+lenr
1965 lri7cp=lri7cp+6*lenr
1966 lri7cp=lri7cp+5*lenr
1967 lri7cp=lri7cp+2*lenr
1968 END IF
1969 ELSEIF(ityp==11) THEN
1970C-------------------ITAFI
1971 lii7cp=lii7cp+2*lenr
1972C-------------------MASFI,STIFI
1973 lri7cp=lri7cp+3*lenr
1974 IF(igap/=0) lri7cp=lri7cp+lenr
1975 IF (intth > 0 ) lii7cp=lii7cp+lenr
1976C-------------------XFI,VFI
1977 lri7cp=lri7cp+12*lenr
1978 IF(inacti==5.OR.inacti==6)lri7cp=lri7cp+2*lenr
1979 IF(iparit==0) THEN
1980C-------------------AFI,STNFI,VSCFI,AREASFI,TEMPFI
1981 lri7cp=lri7cp+8*lenr*nthread
1982 IF(kdtint/=0)lri7cp=lri7cp+2*lenr*nthread
1983 IF(intth > 0 )lri7cp=lri7cp+3*lenr
1984 ELSE
1985C-----------------PARITON not yet with implicit----
1986 ENDIF
1987 ELSEIF(ityp==17)THEN
1988 END IF
1989 END IF
1990 ENDIF
1991 ENDDO
1992 END IF
1993 IF((lii7cp+lri7cp)==0) RETURN
1994 IF(ninter/=0) THEN
1995 IF(ALLOCATED(ii7cp)) DEALLOCATE(ii7cp)
1996 IF(ALLOCATED(ri7cp)) DEALLOCATE(ri7cp)
1997 IF(ALLOCATED(newfrcp)) DEALLOCATE(newfrcp)
1998 ALLOCATE(ii7cp(lii7cp),newfrcp(snewfront),stat=ierr)
1999 IF(lri7cp>0)ALLOCATE(ri7cp(lri7cp),stat=ierr)
2000C ----copy-to II7CP,RI7CP ---------------
2001 iid=1
2002 rid=1
2003 DO i =1, ninter
2004 ityp = ipari(7,i)
2005 igap = ipari(21,i)
2006 inacti = ipari(22,i)
2007 intth = ipari(47,i)
2008 IF(ityp==7.OR.ityp==10.OR.ityp==11.OR.ityp==24)THEN
2009 ii7cp(iid) = ipari(24,i)
2010 ii7cp(iid+1) = ipari(57,i)
2011 iid=iid+2
2012 CALL cp_int(nspmd,nsnsi(i)%P(1),ii7cp(iid))
2013 iid=iid+nspmd
2014 CALL cp_int(nspmd,nsnfi(i)%P(1),ii7cp(iid))
2015 iid=iid+nspmd
2016 lens = 0
2017 lenr = 0
2018 DO p = 1, nspmd
2019 lens = lens + nsnsi(i)%P(p)
2020 lenr = lenr + nsnfi(i)%P(p)
2021 END DO
2022 IF (lens>0)
2023 . CALL cp_int(lens,nsvsi(i)%P(1),ii7cp(iid))
2024 iid=iid+lens
2025C
2026 IF (lenr>0) THEN
2027 CALL cp_int(lenr,nsvfi(i)%P(1),ii7cp(iid))
2028 iid=iid+lenr
2029 IF(ityp==7.OR.ityp==10.OR.ityp==24) THEN
2030C-------------------ITAFI,KINFI
2031 CALL cp_int(lenr,itafi(i)%P(1),ii7cp(iid))
2032 iid=iid+lenr
2033 CALL cp_int(lenr,kinfi(i)%P(1),ii7cp(iid))
2034 iid=iid+lenr
2035 IF (intth > 0 ) THEN
2036 CALL cp_int(lenr,matsfi(i)%P(1),ii7cp(iid))
2037 iid=iid+lenr
2038 END IF
2039C-------------------MSFI,STIFI
2040 CALL cp_real(lenr,msfi(i)%P(1),ri7cp(rid))
2041 rid=rid+lenr
2042 CALL cp_real(lenr,stifi(i)%P(1),ri7cp(rid))
2043 rid=rid+lenr
2044 IF(igap/=0) THEN
2045 CALL cp_real(lenr,gapfi(i)%P(1),ri7cp(rid))
2046 rid=rid+lenr
2047 ENDIF
2048C-------------------XFI,VFI
2049 CALL cp_real(3*lenr,xfi(i)%P(1,1),ri7cp(rid))
2050 rid=rid+3*lenr
2051 CALL cp_real(3*lenr,vfi(i)%P(1,1),ri7cp(rid))
2052 rid=rid+3*lenr
2053 IF(iparit==0) THEN
2054C-------------------AFI,STNFI,VSCFI
2055 CALL cp_real(3*lenr*nthread,afi(i)%P(1,1),ri7cp(rid))
2056 rid=rid+3*lenr*nthread
2057 CALL cp_real(lenr*nthread,stnfi(i)%P(1),ri7cp(rid))
2058 rid=rid+lenr*nthread
2059 IF(kdtint/=0) THEN
2060 CALL cp_real(lenr*nthread,vscfi(i)%P(1),ri7cp(rid))
2061 rid=rid+lenr*nthread
2062 ENDIF
2063 IF(intth/=0) THEN
2064 CALL cp_real(lenr*nthread,fthefi(i)%P(1),ri7cp(rid))
2065 rid=rid+lenr*nthread
2066 CALL cp_real(lenr*nthread,condnfi(i)%P(1),ri7cp(rid))
2067 rid=rid+lenr*nthread
2068 CALL cp_real(lenr,tempfi(i)%P(1),ri7cp(rid))
2069 rid=rid+lenr
2070 CALL cp_real(lenr,areasfi(i)%P(1),ri7cp(rid))
2071 rid=rid+lenr
2072 ENDIF
2073 ELSE
2074C-----------------PARITON not yet with implicit----
2075 ENDIF
2076 IF(ityp==24) THEN
2077 CALL cp_int(2*lenr,irtlm_fi(i)%P(1,1),ii7cp(iid))
2078 iid=iid+2*lenr
2079 CALL cp_real(lenr,time_sfi(i)%P(1),ri7cp(rid))
2080 rid=rid+lenr
2081 CALL cp_real(6*lenr,secnd_frfi(i)%P(1,1),ri7cp(rid))
2082 rid=rid+6*lenr
2083 CALL cp_real(5*lenr,pene_oldfi(i)%P(1,1),ri7cp(rid))
2084 rid=rid+5*lenr
2085 CALL cp_real(2*lenr,stif_oldfi(i)%P(1,1),ri7cp(rid))
2086 rid=rid+2*lenr
2087 END IF
2088 ELSEIF(ityp==11) THEN
2089C-------------------ITAFI
2090 CALL cp_int(2*lenr,itafi(i)%P(1),ii7cp(iid))
2091 iid=iid+2*lenr
2092 IF (intth > 0 ) THEN
2093 CALL cp_int(lenr,matsfi(i)%P(1),ii7cp(iid))
2094 iid=iid+lenr
2095 END IF
2096C-------------------MSFI,STIFI
2097 CALL cp_real(2*lenr,msfi(i)%P(1),ri7cp(rid))
2098 rid=rid+2*lenr
2099 CALL cp_real(lenr,stifi(i)%P(1),ri7cp(rid))
2100 rid=rid+lenr
2101 IF(igap/=0) THEN
2102 CALL cp_real(lenr,gapfi(i)%P(1),ri7cp(rid))
2103 rid=rid+lenr
2104 ENDIF
2105C-------------------XFI,VFI
2106 CALL cp_real(6*lenr,xfi(i)%P(1,1),ri7cp(rid))
2107 rid=rid+6*lenr
2108 CALL cp_real(6*lenr,vfi(i)%P(1,1),ri7cp(rid))
2109 rid=rid+6*lenr
2110 IF(inacti==5.OR.inacti==6) THEN
2111 CALL cp_real(2*lenr,penfi(i)%P(1,1),ri7cp(rid))
2112 rid=rid+2*lenr
2113 ENDIF
2114 IF(iparit==0) THEN
2115C-------------------AFI,STNFI,VSCFI
2116 CALL cp_real(6*lenr*nthread,afi(i)%P(1,1),ri7cp(rid))
2117 rid=rid+6*lenr*nthread
2118 CALL cp_real(2*lenr*nthread,stnfi(i)%P(1),ri7cp(rid))
2119 rid=rid+2*lenr*nthread
2120 IF(kdtint/=0) THEN
2121 CALL cp_real(2*lenr*nthread,vscfi(i)%P(1),ri7cp(rid))
2122 rid=rid+2*lenr*nthread
2123 ENDIF
2124 IF(intth/=0) THEN
2125 CALL cp_real(lenr,fthefi(i)%P(1),ri7cp(rid))
2126 rid=rid+lenr
2127 CALL cp_real(lenr,tempfi(i)%P(1),ri7cp(rid))
2128 rid=rid+lenr
2129 CALL cp_real(lenr,areasfi(i)%P(1),ri7cp(rid))
2130 rid=rid+lenr
2131 ENDIF
2132 ELSE
2133C-----------------PARITON not yet with implicit----
2134 ENDIF
2135 ELSEIF(ityp==17)THEN
2136 END IF
2137 END IF !IF (LENR>0)
2138 ENDIF !IF(ITYP==7.OR.ITYP==10.OR.IT
2139 ENDDO
2140 lenscp(1)=islen7
2141 lenscp(2)=irlen7
2142 lenscp(3)=islen11
2143 lenscp(4)=irlen11
2144 lenscp(5)=islen17
2145 lenscp(6)=irlen17
2146 lenscp(7)=irlen7t
2147 lenscp(8)=islen7t
2148 lenscp(9)=irlen20
2149 lenscp(10)=islen20
2150 lenscp(11)=irlen20t
2151 lenscp(12)=islen20t
2152 lenscp(13)=irlen20e
2153 lenscp(14)=islen20e
2154 CALL cp_int(snewfront,newfront,newfrcp)
2155 IF (iid>(lii7cp+1).OR.rid>(lri7cp+1)) then
2156 CALL ancmsg(msgid=82,anmode=aninfo,
2157 . i1=iid,i2=lii7cp,i3=rid,i4=lri7cp)
2158 CALL arret(2)
2159 ENDIF
2160 END IF
2161 ELSE
2162 IF((lii7cp+lri7cp)==0) RETURN
2163 IF(ninter/=0) THEN
2164C ----copy- from II7CP,RI7CP -------------
2165 iid=1
2166 rid=1
2167 DO i =1, ninter
2168 ityp = ipari(7,i)
2169 igap = ipari(21,i)
2170 inacti = ipari(22,i)
2171 intth = ipari(47,i)
2172 nrebou=ipari(53,i)
2173 IF(ityp==7.OR.ityp==10.OR.ityp==11.OR.ityp==24)THEN
2174 ipari(24,i) = ii7cp(iid)
2175 ipari(57,i) = ii7cp(iid+1)
2176 iid=iid+2
2177 lenr0 = 0
2178 DO p = 1, nspmd
2179 lenr0 = lenr0 + nsnfi(i)%P(p)
2180 END DO
2181 CALL cp_int(nspmd,ii7cp(iid),nsnsi(i)%P(1))
2182 iid=iid+nspmd
2183 CALL cp_int(nspmd,ii7cp(iid),nsnfi(i)%P(1))
2184 iid=iid+nspmd
2185 lens = 0
2186 lenr = 0
2187 DO p = 1, nspmd
2188 lens = lens + nsnsi(i)%P(p)
2189 lenr = lenr + nsnfi(i)%P(p)
2190 END DO
2191 IF (lens>0) THEN
2192 IF(ASSOCIATED(nsvsi(i)%P)) DEALLOCATE(nsvsi(i)%P)
2193 ALLOCATE(nsvsi(i)%P(lens),stat=ierr)
2194 CALL cp_int(lens,ii7cp(iid),nsvsi(i)%P(1))
2195 iid=iid+lens
2196 ENDIF
2197C-----------------ALLOCATION cp from II7CP,RI7CP----------
2198 IF (lenr>0) THEN
2199 IF(ASSOCIATED(nsvfi(i)%P)) DEALLOCATE(nsvfi(i)%P)
2200 ALLOCATE(nsvfi(i)%P(lenr),stat=ierr)
2201 CALL cp_int(lenr,ii7cp(iid),nsvfi(i)%P(1))
2202 iid=iid+lenr
2203 IF(ityp==7.OR.ityp==10.OR.ityp==24) THEN
2204 IF(ASSOCIATED(itafi(i)%P)) DEALLOCATE(itafi(i)%P)
2205 ALLOCATE(itafi(i)%P(lenr),stat=ierr)
2206 CALL cp_int(lenr,ii7cp(iid),itafi(i)%P(1))
2207 iid=iid+lenr
2208 IF(ASSOCIATED(kinfi(i)%P)) DEALLOCATE(kinfi(i)%P)
2209 ALLOCATE(kinfi(i)%P(lenr),stat=ierr)
2210 CALL cp_int(lenr,ii7cp(iid),kinfi(i)%P(1))
2211 iid=iid+lenr
2212 IF(intth > 0 ) THEN
2213 IF(ASSOCIATED(matsfi(i)%P)) DEALLOCATE(matsfi(i)%P)
2214 ALLOCATE(matsfi(i)%P(lenr),stat=ierr)
2215 CALL cp_int(lenr,ii7cp(iid),matsfi(i)%P(1))
2216 iid=iid+lenr
2217 ENDIF
2218 IF(ASSOCIATED(msfi(i)%P)) DEALLOCATE(msfi(i)%P)
2219 ALLOCATE(msfi(i)%P(lenr),stat=ierr)
2220 CALL cp_real(lenr,ri7cp(rid),msfi(i)%P(1))
2221 rid=rid+lenr
2222 IF(ASSOCIATED(stifi(i)%P)) DEALLOCATE(stifi(i)%P)
2223 ALLOCATE(stifi(i)%P(lenr),stat=ierr)
2224 CALL cp_real(lenr,ri7cp(rid),stifi(i)%P(1))
2225 rid=rid+lenr
2226 IF(igap/=0) THEN
2227 IF(ASSOCIATED(gapfi(i)%P)) DEALLOCATE(gapfi(i)%P)
2228 ALLOCATE(gapfi(i)%P(lenr),stat=ierr)
2229 CALL cp_real(lenr,ri7cp(rid),gapfi(i)%P(1))
2230 rid=rid+lenr
2231 ENDIF
2232 IF(ASSOCIATED(xfi(i)%P)) DEALLOCATE(xfi(i)%P)
2233 ALLOCATE(xfi(i)%P(3,lenr),stat=ierr)
2234 CALL cp_real(3*lenr,ri7cp(rid),xfi(i)%P(1,1))
2235 rid=rid+3*lenr
2236 IF(ASSOCIATED(vfi(i)%P)) DEALLOCATE(vfi(i)%P)
2237 ALLOCATE(vfi(i)%P(3,lenr),stat=ierr)
2238 CALL cp_real(3*lenr,ri7cp(rid),vfi(i)%P(1,1))
2239 rid=rid+3*lenr
2240 IF(iparit==0) THEN
2241 IF(ASSOCIATED(afi(i)%P)) DEALLOCATE(afi(i)%P)
2242 ALLOCATE(afi(i)%P(3,lenr*nthread),stat=ierr)
2243 CALL cp_real(3*lenr*nthread,ri7cp(rid),afi(i)%P(1,1))
2244 rid=rid+3*lenr*nthread
2245 IF(ASSOCIATED(stnfi(i)%P)) DEALLOCATE(stnfi(i)%P)
2246 ALLOCATE(stnfi(i)%P(lenr*nthread),stat=ierr)
2247 CALL cp_real(lenr*nthread,ri7cp(rid),stnfi(i)%P(1))
2248 rid=rid+lenr*nthread
2249 nlskyfi(i)=lenr
2250 IF(kdtint/=0)THEN
2251 IF(ASSOCIATED(vscfi(i)%P)) DEALLOCATE(vscfi(i)%P)
2252 ALLOCATE(vscfi(i)%P(lenr),stat=ierr)
2253 CALL cp_real(lenr*nthread,ri7cp(rid),vscfi(i)%P(1))
2254 rid=rid+lenr*nthread
2255 ENDIF
2256 IF(intth > 0 )THEN
2257C
2258 IF(ASSOCIATED(fthefi(i)%P)) DEALLOCATE(fthefi(i)%P)
2259 ALLOCATE(fthefi(i)%P(lenr*nthread),stat=ierr)
2260 CALL cp_real(lenr*nthread,ri7cp(rid),fthefi(i)%P(1))
2261 rid=rid+lenr*nthread
2262C
2263 IF(ASSOCIATED(condnfi(i)%P)) DEALLOCATE(condnfi(i)%P)
2264 ALLOCATE(condnfi(i)%P(lenr*nthread),stat=ierr)
2265 CALL cp_real(lenr*nthread,ri7cp(rid),condnfi(i)%P(1))
2266 rid=rid+lenr*nthread
2267C
2268 IF(ASSOCIATED(tempfi(i)%P)) DEALLOCATE(tempfi(i)%P)
2269 ALLOCATE(tempfi(i)%P(lenr),stat=ierr)
2270 CALL cp_real(lenr,ri7cp(rid),tempfi(i)%P(1))
2271 rid=rid+lenr
2272C
2273 IF(ASSOCIATED(areasfi(i)%P))DEALLOCATE(areasfi(i)%P)
2274 ALLOCATE(areasfi(i)%P(lenr),stat=ierr)
2275 CALL cp_real(lenr,ri7cp(rid),areasfi(i)%P(1))
2276 rid=rid+lenr
2277 ENDIF
2278 ELSE
2279C-----------------PARITON not yet with implicit----
2280 ENDIF
2281 IF(ityp==24) THEN
2282 IF(ASSOCIATED(irtlm_fi(i)%P))DEALLOCATE(irtlm_fi(i)%P)
2283 ALLOCATE(irtlm_fi(i)%P(2,lenr),stat=ierr)
2284 CALL cp_int(2*lenr,ii7cp(iid),irtlm_fi(i)%P(1,1))
2285 iid=iid+2*lenr
2286 IF(ASSOCIATED(time_sfi(i)%P))DEALLOCATE(time_sfi(i)%P)
2287 ALLOCATE(time_sfi(i)%P(lenr),stat=ierr)
2288 CALL cp_real(lenr,ri7cp(rid),time_sfi(i)%P(1))
2289 rid=rid+lenr
2290 IF(ASSOCIATED(secnd_frfi(i)%P))
2291 + DEALLOCATE(secnd_frfi(i)%P)
2292 ALLOCATE(secnd_frfi(i)%P(6,lenr),stat=ierr)
2293 CALL cp_real(6*lenr,ri7cp(rid),secnd_frfi(i)%P(1,1))
2294 rid=rid+6*lenr
2295 IF(ASSOCIATED(pene_oldfi(i)%P))
2296 + DEALLOCATE(pene_oldfi(i)%P)
2297 ALLOCATE(pene_oldfi(i)%P(5,lenr),stat=ierr)
2298 CALL cp_real(5*lenr,ri7cp(rid),pene_oldfi(i)%P(1,1))
2299 rid=rid+5*lenr
2300 IF (nrebou <0.AND.imconv>=0) THEN
2301 CALL cp_real(2*lenr,stif_oldfi(i)%P(1,1),ri7cp(rid))
2302 ELSE
2303 IF(ASSOCIATED(stif_oldfi(i)%P))
2304 + DEALLOCATE(stif_oldfi(i)%P)
2305 ALLOCATE(stif_oldfi(i)%P(2,lenr),stat=ierr)
2306 CALL cp_real(2*lenr,ri7cp(rid),stif_oldfi(i)%P(1,1))
2307 END IF !(NREBOU <0.AND.IMCONV>=0) THEN
2308 rid=rid+2*lenr
2309 END IF
2310 ELSEIF(ityp==11) THEN
2311C
2312 IF(ASSOCIATED(itafi(i)%P)) DEALLOCATE(itafi(i)%P)
2313 ALLOCATE(itafi(i)%P(2*lenr),stat=ierr)
2314 CALL cp_int(2*lenr,ii7cp(iid),itafi(i)%P(1))
2315 iid=iid+2*lenr
2316 IF(intth > 0 ) THEN
2317 IF(ASSOCIATED(matsfi(i)%P)) DEALLOCATE(matsfi(i)%P)
2318 ALLOCATE(matsfi(i)%P(lenr),stat=ierr)
2319 CALL cp_int(lenr,ii7cp(iid),matsfi(i)%P(1))
2320 iid=iid+lenr
2321 ENDIF
2322 IF(ASSOCIATED(msfi(i)%P)) DEALLOCATE(msfi(i)%P)
2323 ALLOCATE(msfi(i)%P(2*lenr),stat=ierr)
2324 CALL cp_real(2*lenr,ri7cp(rid),msfi(i)%P(1))
2325 rid=rid+2*lenr
2326 IF(ASSOCIATED(stifi(i)%P)) DEALLOCATE(stifi(i)%P)
2327 ALLOCATE(stifi(i)%P(lenr),stat=ierr)
2328 CALL cp_real(lenr,ri7cp(rid),stifi(i)%P(1))
2329 rid=rid+lenr
2330 IF(igap/=0) THEN
2331 IF(ASSOCIATED(gapfi(i)%P)) DEALLOCATE(gapfi(i)%P)
2332 ALLOCATE(gapfi(i)%P(lenr),stat=ierr)
2333 CALL cp_real(lenr,ri7cp(rid),gapfi(i)%P(1))
2334 rid=rid+lenr
2335 ENDIF
2336 IF(ASSOCIATED(xfi(i)%P)) DEALLOCATE(xfi(i)%P)
2337 ALLOCATE(xfi(i)%P(3,2*lenr),stat=ierr)
2338 CALL cp_real(6*lenr,ri7cp(rid),xfi(i)%P(1,1))
2339 rid=rid+6*lenr
2340 IF(ASSOCIATED(vfi(i)%P)) DEALLOCATE(vfi(i)%P)
2341 ALLOCATE(vfi(i)%P(3,2*lenr),stat=ierr)
2342 CALL cp_real(6*lenr,ri7cp(rid),vfi(i)%P(1,1))
2343 rid=rid+6*lenr
2344 IF(inacti==5.OR.inacti==6) THEN
2345 IF(ASSOCIATED(penfi(i)%P)) DEALLOCATE(penfi(i)%P)
2346 ALLOCATE(penfi(i)%P(2,lenr),stat=ierr)
2347 CALL cp_real(2*lenr,ri7cp(rid),penfi(i)%P(1,1))
2348 rid=rid+2*lenr
2349 END IF
2350 IF(iparit==0) THEN
2351
2352 IF(ASSOCIATED(afi(i)%P)) DEALLOCATE(afi(i)%P)
2353 ALLOCATE(afi(i)%P(3,2*lenr*nthread),stat=ierr)
2354 CALL cp_real(6*lenr*nthread,ri7cp(rid),afi(i)%P(1,1))
2355 rid=rid+6*lenr*nthread
2356
2357 IF(ASSOCIATED(stnfi(i)%P)) DEALLOCATE(stnfi(i)%P)
2358 ALLOCATE(stnfi(i)%P(2*lenr*nthread),stat=ierr)
2359 CALL cp_real(2*lenr*nthread,ri7cp(rid),stnfi(i)%P(1))
2360 rid=rid+2*lenr
2361
2362 IF(kdtint/=0)THEN
2363 IF(ASSOCIATED(vscfi(i)%P)) DEALLOCATE(vscfi(i)%P)
2364 ALLOCATE(vscfi(i)%P(2*lenr),stat=ierr)
2365 CALL cp_real(2*lenr*nthread,ri7cp(rid),vscfi(i)%P(1))
2366 rid=rid+2*lenr*nthread
2367 ENDIF
2368 IF(intth > 0 )THEN
2369 IF(ASSOCIATED(fthefi(i)%P)) DEALLOCATE(fthefi(i)%P)
2370 ALLOCATE(fthefi(i)%P(lenr),stat=ierr)
2371 CALL cp_real(lenr,ri7cp(rid),fthefi(i)%P(1))
2372 rid=rid+lenr
2373 IF(ASSOCIATED(tempfi(i)%P)) DEALLOCATE(tempfi(i)%P)
2374 ALLOCATE(tempfi(i)%P(lenr),stat=ierr)
2375 CALL cp_real(lenr,ri7cp(rid),tempfi(i)%P(1))
2376 rid=rid+lenr
2377 IF(ASSOCIATED(areasfi(i)%P))DEALLOCATE(areasfi(i)%P)
2378 ALLOCATE(areasfi(i)%P(lenr),stat=ierr)
2379 CALL cp_real(lenr,ri7cp(rid),areasfi(i)%P(1))
2380 rid=rid+lenr
2381 ENDIF
2382 nlskyfi(i)=lenr*2
2383 ELSE
2384C-----------------PARITON not yet with implicit----
2385 ENDIF
2386 ELSEIF(ityp==17)THEN
2387 ENDIF !IF(ITYP==7.OR.ITYP==10)
2388 ENDIF !IF (LENR.GT0)
2389 ENDIF
2390 ENDDO
2391 islen7 = lenscp(1)
2392 irlen7 = lenscp(2)
2393 islen11= lenscp(3)
2394 irlen11= lenscp(4)
2395 islen17= lenscp(5)
2396 irlen17= lenscp(6)
2397 irlen7t= lenscp(7)
2398 islen7t= lenscp(8)
2399 irlen20= lenscp(9)
2400 islen20= lenscp(10)
2401 irlen20t=lenscp(11)
2402 islen20t=lenscp(12)
2403 irlen20e=lenscp(13)
2404 islen20e=lenscp(14)
2405 CALL cp_int(snewfront,newfrcp,newfront)
2406 IF (iid>(lii7cp+1).OR.rid>(lri7cp+1)) then
2407 CALL ancmsg(msgid=82,anmode=aninfo,
2408 . i1=iid,i2=lii7cp,i3=rid,i4=lri7cp)
2409 CALL arret(2)
2410 ENDIF
2411 END IF !IF(NINTER/=0) THEN
2412 ENDIF !IF(IFLAG==1) THEN
2413C-----------------------------------------------------------------------
2414 RETURN
imp_i7cp
Definition imp_intm.F:192
imp_i7cp::lri7cp
integer lri7cp
Definition imp_intm.F:193
imp_i7cp::lii7cp
integer lii7cp
Definition imp_intm.F:193
imp_i7cp::newfrcp
integer, dimension(:), allocatable newfrcp
Definition imp_intm.F:195
imp_i7cp::iad_stifold
integer, dimension(:), allocatable iad_stifold
Definition imp_intm.F:196
imp_i7cp::iparicp
integer, dimension(:,:), allocatable iparicp
Definition imp_intm.F:197
imp_i7cp::ii7cp
integer, dimension(:), allocatable ii7cp
Definition imp_intm.F:195
imp_i7cp::lenscp
integer, dimension(20) lenscp
Definition imp_intm.F:193
message_mod
Definition message_mod.F:1249
tri7box::stif_oldfi
type(real_pointer2), dimension(:), allocatable stif_oldfi
Definition tri7box.F:545
tri7box::secnd_frfi
type(real_pointer2), dimension(:), allocatable secnd_frfi
Definition tri7box.F:543
tri7box::condnfi
type(real_pointer), dimension(:), allocatable condnfi
Definition tri7box.F:449
tri7box::time_sfi
type(real_pointer), dimension(:), allocatable time_sfi
Definition tri7box.F:542
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
tri7box::matsfi
type(int_pointer), dimension(:), allocatable matsfi
Definition tri7box.F:440
tri7box::tempfi
type(real_pointer), dimension(:), allocatable tempfi
Definition tri7box.F:449
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::penfi
type(real_pointer2), dimension(:), allocatable penfi
Definition tri7box.F:459
tri7box::stnfi
type(real_pointer), dimension(:), allocatable stnfi
Definition tri7box.F:449
tri7box::afi
type(real_pointer2), dimension(:), allocatable afi
Definition tri7box.F:459
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::gapfi
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
tri7box::nsvfi
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
tri7box::areasfi
type(real_pointer), dimension(:), allocatable areasfi
Definition tri7box.F:449
tri7box::msfi
type(real_pointer), dimension(:), allocatable msfi
Definition tri7box.F:449
tri7box::vscfi
type(real_pointer), dimension(:), allocatable vscfi
Definition tri7box.F:449
tri7box::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459
tri7box::kinfi
type(int_pointer), dimension(:), allocatable kinfi
Definition tri7box.F:440
tri7box::nlskyfi
integer, dimension(:), allocatable nlskyfi
Definition tri7box.F:512
tri7box::fthefi
type(real_pointer), dimension(:), allocatable fthefi
Definition tri7box.F:449
tri7box::pene_oldfi
type(real_pointer2), dimension(:), allocatable pene_oldfi
Definition tri7box.F:544
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
tri7box::itafi
type(int_pointer), dimension(:), allocatable itafi
Definition tri7box.F:440
cp_real
subroutine cp_real(n, x, xc)
Definition produt_v.F:871
cp_int
subroutine cp_int(n, x, xc)
Definition produt_v.F:916
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87

◆ cp_impbuf()

subroutine cp_impbuf ( integer iflag,
elbuf,
elbuf_c,
bufmat,
bufmat_c,
fsav,
volmon,
partsav,
type(intbuf_struct_), dimension(*) intbuf_tab,
type(intbuf_struct_), dimension(*) intbuf_tab_c,
integer, dimension(npari,*) ipari,
integer islen7,
integer irlen7,
integer islen11,
integer irlen11,
integer islen17,
integer irlen17,
integer irlen7t,
integer islen7t,
integer irlen20,
integer islen20,
integer irlen20t,
integer islen20t,
integer irlen20e,
integer islen20e,
integer, dimension(*) newfront,
type (elbuf_struct_), dimension(ngroup) elbuf_tab,
type (elbuf_struct_), dimension(ngroup) elbuf_imp,
integer, dimension(nparg,ngroup) iparg )

Definition at line 1017 of file produt_v.F.

1025C-----------------------------------------------
1026C M o d u l e s
1027C-----------------------------------------------
1028 USE elbufdef_mod
1029 USE imp_intbuf
1030 USE imp_i7cp
1031 USE intbufdef_mod
1032C-----------------------------------------------
1033C I m p l i c i t T y p e s
1034C-----------------------------------------------
1035#include "implicit_f.inc"
1036C-----------------------------------------------
1037C C o m m o n B l o c k s
1038C-----------------------------------------------
1039#include "com01_c.inc"
1040#include "com04_c.inc"
1041#include "param_c.inc"
1042#include "tabsiz_c.inc"
1043#include "impl1_c.inc"
1044C-----------------------------------------------
1045C D u m m y A r g u m e n t s
1046C-----------------------------------------------
1047 INTEGER IFLAG, IPARI(NPARI,*),ISLEN7 ,IRLEN7 ,
1048 . ISLEN11,IRLEN11,ISLEN17 ,IRLEN17,IRLEN7T ,
1049 . ISLEN7T,IRLEN20,ISLEN20 ,IRLEN20T,ISLEN20T,
1050 . IRLEN20E,ISLEN20E,NEWFRONT(*),IPARG(NPARG,NGROUP)
1051C REAL
1052 my_real
1053 . elbuf(*) ,elbuf_c(*) ,bufmat(*) ,bufmat_c(*) ,
1054 . fsav(*) ,volmon(*) ,partsav(*)
1055 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB, ELBUF_IMP
1056
1057 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*), INTBUF_TAB_C(*)
1058C-----------------------------------------------
1059C L o c a l V a r i a b l e s
1060C-----------------------------------------------
1061 INTEGER LI1,LI2,LI3,LI4,LI5,LI6,LL,N,IAD,JD(50),JFI,
1062 . ITY,IGSTI,NREBOU
1063C--------------Iflag= 1->copy; 2 ->restore---------------
1064 li1=selbuf
1065 li2=sbufmat
1066 li3=sfsav
1067 li4=svolmon
1068 li5=npsav*npart
1069c LI6=SBUFIN
1070C------------BUF->BUF_C--------------------------------
1071 IF (iflag==1) THEN
1072 CALL copy_elbuf(elbuf_tab,elbuf_imp,iparg,ngroup)
1073 CALL cp_real(li1,elbuf,elbuf_c)
1074 CALL cp_real(li2,bufmat,bufmat_c)
1075 ll=li2+1
1076 CALL cp_real(li3,fsav,bufmat_c(ll))
1077 ll=ll+li3
1078 CALL cp_real(li4,volmon,bufmat_c(ll))
1079 ll=ll+li4
1080 CALL cp_real(li5,partsav,bufmat_c(ll))
1081 IF (ninter/=0.AND.iline/=1) THEN
1082C------for int24 + Istif=6
1083 DO n = 1,ninter
1084 ity =ipari(7,n)
1085 IF (ity==0) cycle
1086 igsti =ipari(34,n)
1087 IF (ity == 24.AND.igsti==6) THEN
1088 IF (ipari(53,n)<0) ipari(53,n)= iabs(ipari(53,n))
1089 END IF
1090 !integral copy of interface buffer structure
1091 !INTBUF_TAB -> INTBUF_TAB_C
1092 CALL copy_intbuf_tab(intbuf_tab(n), intbuf_tab_c(n) )
1093 END DO !N = 1,NINTER
1094
1095 CALL cp_ifront(iflag ,ipari ,islen7 ,irlen7 ,
1096 . islen11,irlen11,islen17 ,irlen17,irlen7t ,
1097 . islen7t,irlen20,islen20 ,irlen20t,islen20t,
1098 . irlen20e,islen20e,newfront)
1099 END IF
1100C------------BUF_C->BUF--------------------------------
1101 ELSEIF (iflag==2) THEN
1102 CALL copy_elbuf(elbuf_imp,elbuf_tab,iparg,ngroup)
1103 CALL cp_real(li1,elbuf_c,elbuf)
1104 CALL cp_real(li2,bufmat_c,bufmat)
1105 ll=li2+1
1106 CALL cp_real(li3,bufmat_c(ll),fsav)
1107 ll=ll+li3
1108 CALL cp_real(li4,bufmat_c(ll),volmon)
1109 ll=ll+li4
1110 CALL cp_real(li5,bufmat_c(ll),partsav)
1111 IF (ninter/=0.AND.iline/=1) THEN
1112C------for int24 + Istif=6
1113 DO n = 1,ninter
1114 ity =ipari(7,n)
1115 IF (ity==0) cycle
1116 igsti =ipari(34,n)
1117 nrebou=ipari(53,n)
1118 IF (ity==24.AND.igsti==6.AND.nrebou<0) THEN
1119C---------divergence removes the treatment , line-search doesn't change stif
1120 IF (imconv<-1) THEN
1121 ipari(53,n) = -nrebou
1122 ELSEIF (imconv>=0) THEN
1123 ll =2*ipari(5,n)
1124 CALL cp_real(ll,intbuf_tab(n)%STIF_OLD,intbuf_tab_cp(n)%STIF_OLD)
1125 END IF
1126 END IF
1127 !integral copy of interface buffer structure
1128 !INTBUF_TAB_C -> INTBUF_TAB
1129 CALL copy_intbuf_tab(intbuf_tab_c(n), intbuf_tab(n) )
1130 END DO !N = 1,NINTER
1131
1132C------for int24 + Istif=6 remote part is inside CP_IFRONT
1133 CALL cp_ifront(iflag ,ipari ,islen7 ,irlen7 ,
1134 . islen11,irlen11,islen17 ,irlen17,irlen7t ,
1135 . islen7t,irlen20,islen20 ,irlen20t,islen20t,
1136 . irlen20e,islen20e,newfront)
1137c CALL CP_INTBUF(BUFIN_C,INBUF_C ,BUFIN,INBUF ,IPARI )
1138 END IF
1139 ENDIF
1140C--------------------------------------------
1141 RETURN
copy_elbuf
subroutine copy_elbuf(elbuf_src, elbuf_tgt, iparg, ngroup)
Definition copy_elbuf.F:33
copy_intbuf_tab
subroutine copy_intbuf_tab(intbuf_tab, intbuf_tab_c)
Definition copy_intbuf_tab.F:31
cp_ifront
subroutine cp_ifront(iflag, ipari, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, newfront)
Definition produt_v.F:1854

◆ cp_int()

subroutine cp_int ( integer n,
integer, dimension(*) x,
integer, dimension(*) xc )

Definition at line 915 of file produt_v.F.

916C-----------------------------------------------
917C I m p l i c i t T y p e s
918C-----------------------------------------------
919#include "implicit_f.inc"
920C-----------------------------------------------
921C D u m m y A r g u m e n t s
922C-----------------------------------------------
923 INTEGER N ,X(*), XC(*)
924C REAL
925C-----------------------------------------------
926C L o c a l V a r i a b l e s
927C-----------------------------------------------
928 INTEGER I
929C-----------------------------
930 DO i=1,n
931 xc(i) = x(i)
932 ENDDO
933C--------------------------------------------
934 RETURN

◆ cp_int_hp()

subroutine cp_int_hp ( integer n,
integer, dimension(*) x,
integer, dimension(*) xc )

Definition at line 3656 of file produt_v.F.

3657C-----------------------------------------------
3658C I m p l i c i t T y p e s
3659C-----------------------------------------------
3660#include "implicit_f.inc"
3661C-----------------------------------------------
3662C D u m m y A r g u m e n t s
3663C-----------------------------------------------
3664 INTEGER N ,X(*), XC(*)
3665C REAL
3666C-----------------------------------------------
3667C L o c a l V a r i a b l e s
3668C-----------------------------------------------
3669 INTEGER I,ITSK,NFT,NLT
3670C-----------------------------
3671!$OMP PARALLEL PRIVATE(ITSK,NFT,NLT,I)
3672 CALL imp_smpini(itsk ,nft ,nlt ,n )
3673 DO i = nft ,nlt
3674 xc(i) = x(i)
3675 ENDDO
3676!$omp END parallel
3677C--------------------------------------------
3678 RETURN
imp_smpini
subroutine imp_smpini(itsk, n1ftsk, n1ltsk, n1)
Definition imp_solv.F:6895

◆ cp_real()

subroutine cp_real ( integer n,
x,
xc )

Definition at line 870 of file produt_v.F.

871C-----------------------------------------------
872C I m p l i c i t T y p e s
873C-----------------------------------------------
874#include "implicit_f.inc"
875C-----------------------------------------------
876C D u m m y A r g u m e n t s
877C-----------------------------------------------
878 INTEGER N
879C REAL
880 my_real
881 . x(*), xc(*)
882C-----------------------------------------------
883C L o c a l V a r i a b l e s
884C-----------------------------------------------
885 INTEGER I
886C-----------------------------
887 DO i=1,n
888 xc(i) = x(i)
889 ENDDO
890C--------------------------------------------
891 RETURN

◆ cp_real_hp()

subroutine cp_real_hp ( integer n,
x,
xc )

Definition at line 3623 of file produt_v.F.

3624C-----------------------------------------------
3625C I m p l i c i t T y p e s
3626C-----------------------------------------------
3627#include "implicit_f.inc"
3628C-----------------------------------------------
3629C D u m m y A r g u m e n t s
3630C-----------------------------------------------
3631 INTEGER N
3632C REAL
3633 my_real
3634 . x(*), xc(*)
3635C-----------------------------------------------
3636C L o c a l V a r i a b l e s
3637C-----------------------------------------------
3638 INTEGER I,ITSK,NFT,NLT
3639C-----------------------------
3640!$OMP PARALLEL PRIVATE(ITSK,NFT,NLT,I)
3641 CALL imp_smpini(itsk ,nft ,nlt ,n )
3642 DO i = nft ,nlt
3643 xc(i) = x(i)
3644 ENDDO
3645!$OMP END PARALLEL
3646C--------------------------------------------
3647 RETURN

◆ d_to_u()

subroutine d_to_u ( integer nddl0,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
d,
dr,
u )

Definition at line 152 of file produt_v.F.

154C-----------------------------------------------
155C I m p l i c i t T y p e s
156C-----------------------------------------------
157#include "implicit_f.inc"
158C-----------------------------------------------
159C D u m m y A r g u m e n t s
160C-----------------------------------------------
161 INTEGER NDDL,NDDL0,IDDL(*) ,NDOF(*) ,IKC(*)
162C REAL
163 my_real
164 . d(*),dr(*), u(*)
165C-----------------------------------------------
166C L o c a l V a r i a b l e s
167C-----------------------------------------------
168 INTEGER I
169 my_real
170 . x(nddl0)
171C-----------------------------
172 CALL imp_setb(d ,dr ,iddl ,ndof ,x )
173 CALL condens_b(nddl0 ,ikc ,x )
174 CALL cp_real(nddl,x,u)
175C--------------------------------------------
176 RETURN
imp_setb
subroutine imp_setb(f, m, iddl, ndof, b)
Definition imp_setb.F:40
condens_b
subroutine condens_b(nddl, ikc, b)
Definition upd_glob_k.F:400

◆ mam_nm()

subroutine mam_nm ( integer f_nd,
integer l_nd,
integer nd,
integer md,
a,
b,
c,
integer, dimension(*) wddl,
integer itask )

Definition at line 2839 of file produt_v.F.

2840C-----------------------------------------------
2841C I m p l i c i t T y p e s
2842C-----------------------------------------------
2843#include "implicit_f.inc"
2844C-----------------------------------------------
2845C D u m m y A r g u m e n t s
2846C-----------------------------------------------
2847 INTEGER F_ND ,L_ND ,ND ,MD ,ITASK,WDDL(*)
2848C REAL
2849 my_real
2850 . a(nd,*), b(nd,*), c(md,*)
2851C-----------------------------------------------
2852c FUNCTION: product {C}=[A]^t[B]
2853c
2854c Note:
2855c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
2856c
2857c TYPE NAME FUNCTION
2858c I ND,MD - Matrix dimension 2D
2859c I WDDL(*) - itag for each id of subdomains
2860c I F_ND,L_ND,ITASK - id in each ITASK:thread id (//)
2861c I B(ND,MD) - right-hand Matrix
2862c O C(NM,MD) - left-hand vector
2863C-----------------------------------------------
2864C L o c a l V a r i a b l e s
2865C-----------------------------------------------
2866 INTEGER I,J,K
2867C-----------------------------
2868 DO i=1,md
2869 DO j=1,md
2870 CALL produt_h( f_nd ,l_nd ,a(1,i) ,b(1,j) ,wddl,c(i,j),itask)
2871 ENDDO
2872 ENDDO
2873C--------------------------------------------
2874 RETURN
produt_h
subroutine produt_h(f_ddl, l_ddl, x, y, w, r, itask)
Definition produt_v.F:1533

◆ mav_liuh()

subroutine mav_liuh ( integer f_ddl,
integer l_ddl,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
integer, dimension(*) itok,
lt_i,
work_ii,
v,
w,
integer itask )

Definition at line 3184 of file produt_v.F.

3186C-----------------------------------------------
3187C M o d u l e s
3188C-----------------------------------------------
3189 USE imp_workh
3190C-----------------------------------------------
3191C I m p l i c i t T y p e s
3192C-----------------------------------------------
3193#include "implicit_f.inc"
3194C-----------------------------------------------
3195C D u m m y A r g u m e n t s
3196C-----------------------------------------------
3197 INTEGER F_DDL ,L_DDL ,IADI(*) ,JDII(*),ITOK(*),ITASK
3198C REAL
3199 my_real
3200 . w(*), lt_i(*) ,v(*) ,work_ii(*)
3201C-----------------------------------------------
3202C L o c a l V a r i a b l e s
3203C-----------------------------------------------
3204 INTEGER I,J,K,N,II,KK
3205 my_real
3206 . l_k
3207C----------------------------
3208 DO i=f_ddl,l_ddl
3209 work_ii(i) = zero
3210 ENDDO
3211C
3212 DO i=f_ddl,l_ddl
3213 DO j =iadi(i),iadi(i+1)-1
3214 k =jdii(j)
3215 kk = itok(k)
3216 l_k = lt_i(j)
3217 work_ii(i) = work_ii(i) + l_k*v(kk)
3218 ENDDO
3219 ENDDO
3220C
3221 DO i=f_ddl,l_ddl
3222 DO j =iadi0(i),iadi0(i+1)-1
3223 k =jdii0(j)
3224 kk = itok(k)
3225 l_k = lt_i0(j)
3226 work_ii(i) = work_ii(i) + l_k*v(kk)
3227 ENDDO
3228 ENDDO
3229C---------------------
3230 DO i=f_ddl,l_ddl
3231 ii = itok(i)
3232 w(ii) = w(ii) + work_ii(i)
3233 ENDDO
3234C--------------------------------------------
3235 RETURN
imp_workh
Definition impbufdef_mod.F:571
imp_workh::iadi0
integer, dimension(:), allocatable iadi0
Definition impbufdef_mod.F:588
imp_workh::jdii0
integer, dimension(:), allocatable jdii0
Definition impbufdef_mod.F:588

◆ mav_lt()

subroutine mav_lt ( integer nddl,
integer nnz,
integer, dimension(*) iadl,
integer, dimension(*) jdil,
diag_k,
lt_k,
v,
w )

Definition at line 337 of file produt_v.F.

340C-----------------------------------------------
341C I m p l i c i t T y p e s
342C-----------------------------------------------
343#include "implicit_f.inc"
344C-----------------------------------------------
345C D u m m y A r g u m e n t s
346C-----------------------------------------------
347 INTEGER NDDL ,NNZ ,IADL(*) ,JDIL(*)
348C REAL
349 my_real
350 . diag_k(*), w(*), lt_k(*) ,v(*)
351C-----------------------------------------------
352C L o c a l V a r i a b l e s
353C-----------------------------------------------
354 INTEGER I,J,K
355 my_real
356 . l_k
357C-----------------------------
358 DO i=1,nddl
359 w(i)=diag_k(i)*v(i)
360 ENDDO
361C
362 DO i=1,nddl
363 DO j =iadl(i),iadl(i+1)-1
364 k =jdil(j)
365 l_k = lt_k(j)
366 w(i) = w(i) + l_k*v(k)
367 w(k) = w(k) + l_k*v(i)
368 ENDDO
369 ENDDO
370C--------------------------------------------
371 RETURN

◆ mav_lt1()

subroutine mav_lt1 ( integer nddl,
integer nnz,
integer, dimension(*) iadl,
integer, dimension(*) jdil,
diag_k,
lt_k,
v,
w )

Definition at line 396 of file produt_v.F.

399C-----------------------------------------------
400C I m p l i c i t T y p e s
401C-----------------------------------------------
402#include "implicit_f.inc"
403C-----------------------------------------------
404C D u m m y A r g u m e n t s
405C-----------------------------------------------
406 INTEGER NDDL ,NNZ ,IADL(*) ,JDIL(*)
407C REAL
408 my_real
409 . diag_k(*), w(*), lt_k(*) ,v(*)
410C-----------------------------------------------
411C L o c a l V a r i a b l e s
412C-----------------------------------------------
413 INTEGER I,J,K
414 my_real
415 . l_k
416C-----------------------------
417 DO i=1,nddl
418 w(i)=diag_k(i)*v(i)
419 ENDDO
420C
421 DO i=1,nddl
422 DO j =iadl(i),iadl(i+1)-1
423 k =jdil(j)
424 l_k = lt_k(j)
425 w(i) = w(i) + l_k*v(k)
426 ENDDO
427 ENDDO
428C--------------------------------------------
429 RETURN

◆ mav_lt2()

subroutine mav_lt2 ( integer nddl,
integer nddli,
integer, dimension(*) iadl,
integer, dimension(*) jdil,
diag_k,
lt_k,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
integer, dimension(*) itok,
lt_i,
v,
w,
integer, dimension(*) monvol,
volmon,
x,
type (surf_), dimension(nsurf) igrsurf,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) ndof,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
a,
ar,
d,
integer, dimension(*) ibfv,
skew,
xframe,
ve,
ms,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) index2,
xi_c,
integer iupd,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3 )

Definition at line 442 of file produt_v.F.

451C-----------------------------------------------
452C M o d u l e s
453C-----------------------------------------------
454 USE intbufdef_mod
455 USE groupdef_mod
456C-----------------------------------------------
457C I m p l i c i t T y p e s
458C-----------------------------------------------
459#include "implicit_f.inc"
460C-----------------------------------------------
461C C o m m o n B l o c k s
462C-----------------------------------------------
463#include "com04_c.inc"
464#include "impl1_c.inc"
465C-----------------------------------------------
466C D u m m y A r g u m e n t s
467C-----------------------------------------------
468 INTEGER NDDL ,NDDLI,IUPD,
469 . IADL(*),JDIL(*),IADI(*),JDII(*),ITOK(*)
470 INTEGER NMONV,IMONV(*),MONVOL(*),
471 . IPARI(*) ,NDOF(*),IBFV(*),
472 . NUM_IMP(*),NS_IMP(*) ,NE_IMP(*),INDEX2(*),
473 . IRBE3(*) ,LRBE3(*)
474C REAL
475 my_real
476 . diag_k(*), w(*), lt_k(*) ,lt_i(*) ,v(*)
477 my_real
478 . x(3,*),a(3,*),ar(3,*), volmon(*) ,d(3,*),
479 . skew(*) ,xframe(*),ve(3,*),ms(*),xi_c(*)
480
481 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
482 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
483C-----------------------------------------------
484C L o c a l V a r i a b l e s
485C-----------------------------------------------
486 INTEGER I,J,K,II,KK,IBID
487 my_real
488 . l_k
489C-----------------------------
490 DO i=1,nddl
491 w(i)=diag_k(i)*v(i)
492 ENDDO
493C
494 DO i=1,nddl
495 DO j =iadl(i),iadl(i+1)-1
496 k =jdil(j)
497 l_k = lt_k(j)
498 w(i) = w(i) + l_k*v(k)
499 w(k) = w(k) + l_k*v(i)
500 ENDDO
501 ENDDO
502C ------[K]{V}
503 IF (nddli>0.AND.intp_c<0 ) THEN
504 IF (ilintf>0) THEN
505 CALL int_matv(ipari ,intbuf_tab ,ndof ,num_imp,
506 1 ns_imp ,ne_imp ,index2 ,a ,ar ,
507 2 ve ,xi_c ,ms ,d ,ibfv ,
508 3 skew ,xframe ,v ,w ,iupd ,
509 4 irbe3 ,lrbe3 ,ibid ,ibid )
510 ELSE
511 CALL int_matv(ipari ,intbuf_tab ,ndof ,num_imp,
512 1 ns_imp ,ne_imp ,index2 ,a ,ar ,
513 2 ve ,x ,ms ,d ,ibfv ,
514 3 skew ,xframe ,v ,w ,iupd ,
515 4 irbe3 ,lrbe3 ,ibid ,ibid )
516 ENDIF
517 ELSE
518C ------LT_I
519 DO i=1,nddli
520 ii = itok(i)
521 DO j =iadi(i),iadi(i+1)-1
522 k =jdii(j)
523 kk = itok(k)
524 l_k = lt_i(j)
525 w(ii) = w(ii) + l_k*v(kk)
526 w(kk) = w(kk) + l_k*v(ii)
527 ENDDO
528 ENDDO
529 ENDIF
530 CALL matv_kif(v,w)
531 IF (nmonv>0) THEN
532 CALL mv_matv(monvol ,volmon ,x ,igrsurf,
533 1 ibid ,nmonv ,imonv ,v ,w ,
534 2 ndof ,ipari ,intbuf_tab ,a ,
535 3 ar ,d ,ibfv ,skew ,xframe ,
536 4 irbe3 ,lrbe3 ,ibid ,ibid )
537 ENDIF
538C--------------------------------------------
539 RETURN
int_matv
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)
Definition imp_int_k.F:2402
matv_kif
subroutine matv_kif(v, w)
Definition imp_solv.F:2657
mv_matv
subroutine mv_matv(monvol, volmon, x, igrsurf, fr_mv, nmonv, imonv, u, f, ndof, ipari, intbuf_tab, a, ar, x_imp, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2)
Definition monv_imp0.F:1773
groupdef_mod
Definition groupdef_mod.F:662

◆ mav_lt_h()

subroutine mav_lt_h ( integer nddl,
integer f_ddl,
integer l_ddl,
integer, dimension(*) iadl,
integer, dimension(*) jdil,
diag_k,
lt_k,
v,
w )

Definition at line 1151 of file produt_v.F.

1154C-----------------------------------------------
1155C I m p l i c i t T y p e s
1156C-----------------------------------------------
1157#include "implicit_f.inc"
1158#include "comlock.inc"
1159C-----------------------------------------------
1160C D u m m y A r g u m e n t s
1161C-----------------------------------------------
1162 INTEGER F_DDL ,L_DDL ,IADL(*) ,JDIL(*),NDDL
1163C REAL
1164 my_real
1165 . diag_k(*), w(*), lt_k(*) ,v(*)
1166C-----------------------------------------------
1167C L o c a l V a r i a b l e s
1168C-----------------------------------------------
1169 INTEGER I,J,K,N
1170 my_real
1171 . l_k,w_tmp(nddl)
1172C----------------------------
1173 DO i=1,nddl
1174 w_tmp(i)=zero
1175 ENDDO
1176 DO i=f_ddl,l_ddl
1177 w(i)=diag_k(i)*v(i)
1178 ENDDO
1179C
1180 DO i=f_ddl,l_ddl
1181 DO j =iadl(i),iadl(i+1)-1
1182 k =jdil(j)
1183 l_k = lt_k(j)
1184 w(i) = w(i) + l_k*v(k)
1185 w_tmp(k) = w_tmp(k) + l_k*v(i)
1186 ENDDO
1187 ENDDO
1188C----------------------
1189 CALL my_barrier
1190C---------------------
1191#include "lockon.inc"
1192 DO i=1,nddl
1193 w(i) = w(i) + w_tmp(i)
1194 ENDDO
1195#include "lockoff.inc"
1196C--------------------------------------------
1197 RETURN
my_barrier
subroutine my_barrier
Definition machine.F:31

◆ mav_ltgh()

subroutine mav_ltgh ( integer nddl,
integer, dimension(*) iadl,
integer, dimension(*) jdil,
diag_k,
lt_k,
v,
w,
integer f_ddl,
integer l_ddl,
integer itask,
integer nddli )

Definition at line 2478 of file produt_v.F.

2482C-----------------------------------------------
2483C I m p l i c i t T y p e s
2484C-----------------------------------------------
2485#include "implicit_f.inc"
2486C-----------------------------------------------
2487C C o m m o n B l o c k s
2488C-----------------------------------------------
2489#include "com01_c.inc"
2490C-----------------------------------------------
2491C D u m m y A r g u m e n t s
2492C-----------------------------------------------
2493 INTEGER NDDL ,IADL(*),JDIL(*),F_DDL ,L_DDL ,ITASK,
2494 . NDDLI
2495C REAL
2496 my_real
2497 . diag_k(*), w(*), lt_k(*) ,v(*)
2498C-----------------------------------------------
2499C L o c a l V a r i a b l e s
2500C-----------------------------------------------
2501 INTEGER I,J
2502C-----------------------------
2503 CALL mav_lu_h(nddl ,
2504 1 f_ddl ,l_ddl ,iadl ,jdil ,diag_k ,
2505 2 lt_k ,v ,w )
2506 IF (nddli>0) CALL mav_lui_h(f_ddl ,l_ddl ,v ,w )
2507C----------------------
2508 CALL my_barrier
2509C---------------------
2510 IF (itask==0.AND.nspmd>1) CALL spmd_sumf_v(w )
2511C--------------------------------------------
2512 RETURN
spmd_sumf_v
subroutine spmd_sumf_v(v)
Definition imp_spmd.F:1650
mav_lui_h
subroutine mav_lui_h(f_ddl, l_ddl, v, w)
Definition produt_v.F:2523
mav_lu_h
subroutine mav_lu_h(nddl, f_ddl, l_ddl, iadl, jdil, diag_k, lt_k, v, w)
Definition produt_v.F:1792

◆ mav_lth()

subroutine mav_lth ( integer nddl,
integer nddli,
integer, dimension(*) iadl,
integer, dimension(*) jdil,
diag_k,
lt_k,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
integer, dimension(*) itok,
lt_i,
v,
w,
a,
ar,
ve,
ms,
x,
d,
dr,
integer, dimension(*) ndof,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer nsrem,
integer nsl,
integer, dimension(*) ibfv,
skew,
xframe,
integer, dimension(*) monvol,
volmon,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) fr_mv,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) index2,
xi_c,
integer iupd,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2,
integer f_ddl,
integer l_ddl,
integer itask )

Definition at line 1369 of file produt_v.F.

1380C-----------------------------------------------
1381C M o d u l e s
1382C-----------------------------------------------
1383 USE intbufdef_mod
1384 USE groupdef_mod
1385C-----------------------------------------------
1386C I m p l i c i t T y p e s
1387C-----------------------------------------------
1388#include "implicit_f.inc"
1389#include "comlock.inc"
1390C-----------------------------------------------
1391C C o m m o n B l o c k s
1392C-----------------------------------------------
1393#include "com01_c.inc"
1394#include "com04_c.inc"
1395#include "impl1_c.inc"
1396#include "task_c.inc"
1397#include "timeri_c.inc"
1398C-----------------------------------------------
1399C D u m m y A r g u m e n t s
1400C-----------------------------------------------
1401 INTEGER NDDL ,NDDLI,NDOF(*),IUPD,
1402 . IADL(*),JDIL(*),IADI(*),JDII(*),ITOK(*),
1403 . IPARI(*) ,NUM_IMP(*),NS_IMP(*) ,
1404 . NE_IMP(*),NSREM ,NSL,IBFV(*),INDEX2(*),
1405 . IRBE3(*),LRBE3(*),F_DDL ,L_DDL ,ITASK,
1406 . IRBE2(*),LRBE2(*)
1407 INTEGER NMONV,IMONV(*),MONVOL(*),FR_MV(*)
1408C REAL
1409 my_real
1410 . diag_k(*), w(*), lt_k(*) ,lt_i(*) ,v(*) ,
1411 . a(3,*),ar(3,*),ve(3,*),d(3,*),dr(3,*),x(3,*),
1412 . ms(*),volmon(*),skew(*),xframe(*),xi_c(*)
1413
1414 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1415 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
1416C-----------------------------------------------
1417C L o c a l V a r i a b l e s
1418C-----------------------------------------------
1419 INTEGER I,J,K,II,KK,F_DDLI,L_DDLI
1420 my_real
1421 . l_k,work_ii(nddli)
1422C-----------PCG_GP-----------
1423 CALL mav_lu_h(nddl ,
1424 1 f_ddl ,l_ddl ,iadl ,jdil ,diag_k ,
1425 2 lt_k ,v ,w )
1426C----------------------
1427 CALL my_barrier
1428C---------------------
1429 IF ((nddli+nsrem+nsl)>0.AND.intp_c<0 ) THEN
1430C--------spmd only for the moment-------
1431 IF (itask==0) THEN
1432 IF (ilintf>0) THEN
1433 CALL int_matvp(ipari,intbuf_tab ,ndof ,num_imp,
1434 1 ns_imp ,ne_imp ,index2 ,a ,ar ,
1435 2 ve ,xi_c ,ms ,d ,ibfv ,
1436 3 skew ,xframe ,v ,w ,dr ,
1437 4 nsrem ,nsl ,iupd ,irbe3 ,lrbe3 ,
1438 5 irbe2 ,lrbe2 )
1439 ELSE
1440 CALL int_matvp(ipari,intbuf_tab ,ndof ,num_imp,
1441 1 ns_imp ,ne_imp ,index2 ,a ,ar ,
1442 2 ve ,x ,ms ,d ,ibfv ,
1443 3 skew ,xframe ,v ,w ,dr ,
1444 4 nsrem ,nsl ,iupd ,irbe3 ,lrbe3 ,
1445 5 irbe2 ,lrbe2 )
1446 ENDIF
1447 END IF !(ITASK==0) THEN
1448 ELSEIF(nddli>0) THEN
1449 f_ddli=1+itask*nddli/nthread
1450 l_ddli=(itask+1)*nddli/nthread
1451C
1452 IF (isolv > 7) THEN
1453 CALL mav_liuh(f_ddli ,l_ddli ,iadi ,jdii ,itok ,
1454 1 lt_i ,work_ii ,v ,w ,itask )
1455C CALL MAV_LUI_H(F_DDL ,L_DDL ,V ,W )
1456 ELSE
1457C ------LT_I //
1458 DO i=1,nddli
1459 work_ii(i) = zero
1460 ENDDO
1461C
1462 DO i=f_ddli,l_ddli
1463 ii = itok(i)
1464 DO j =iadi(i),iadi(i+1)-1
1465 k =jdii(j)
1466 kk = itok(k)
1467 l_k = lt_i(j)
1468 work_ii(i) = work_ii(i) + l_k*v(kk)
1469 work_ii(k) = work_ii(k) + l_k*v(ii)
1470 ENDDO
1471 ENDDO
1472C
1473#include "lockon.inc"
1474 DO i=1,nddli
1475 ii = itok(i)
1476 w(ii) = w(ii) + work_ii(i)
1477 ENDDO
1478#include "lockoff.inc"
1479 END IF !(ISOLV > 7) THEN
1480C
1481 END IF !((NDDLI+NSREM+NSL)>0.AND.INTP_C<0 ) THEN
1482C----------------------
1483 CALL my_barrier
1484C---------------------
1485C
1486 IF (itask==0) THEN
1487 CALL matv_kif(v,w)
1488 IF (nmonv>0) THEN
1489 CALL mv_matv(monvol ,volmon ,x ,igrsurf,
1490 1 fr_mv ,nmonv ,imonv ,v ,w ,
1491 2 ndof ,ipari ,intbuf_tab,a ,
1492 3 ar ,d ,ibfv ,skew ,xframe ,
1493 4 irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
1494 ENDIF
1495C
1496 IF (nspmd>1) THEN
1497 IF ((nsrem+nsl)>0.AND.intp_c>=0)
1498 . CALL fr_matv( a ,ve ,d ,ms ,x ,
1499 1 dr ,ar ,ipari ,intbuf_tab ,
1500 2 ndof ,num_imp,ns_imp,ne_imp,v ,
1501 3 nsrem ,nsl ,ibfv ,skew ,xframe ,
1502 4 w ,irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
1503! IF(IMONM > 0) CALL STARTIME(TIMERS,66)
1504 CALL spmd_sumf_v(w )
1505! IF(IMONM > 0) CALL STOPTIME(TIMERS,66)
1506 ENDIF
1507 END IF !(ITASK==0) THEN
1508C--------------------------------------------
1509 RETURN
fr_matv
subroutine fr_matv(a, v, d, ms, x, dr, ar, ipari, intbuf_tab, ndof, num_imp, ns_imp, ne_imp, lx, nsrem, nsl, ibfv, skew, xframe, f, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:2418
int_matvp
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)
Definition imp_int_k.F:2499
mav_liuh
subroutine mav_liuh(f_ddl, l_ddl, iadi, jdii, itok, lt_i, work_ii, v, w, itask)
Definition produt_v.F:3186

◆ mav_lth0()

subroutine mav_lth0 ( integer nddl,
integer nddli,
integer, dimension(*) iadl,
integer, dimension(*) jdil,
diag_k,
lt_k,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
integer, dimension(*) itok,
lt_i,
v,
w,
a,
ar,
ve,
ms,
x,
d,
dr,
integer, dimension(*) ndof,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer nsrem,
integer nsl,
integer, dimension(*) ibfv,
skew,
xframe,
integer, dimension(*) monvol,
volmon,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) fr_mv,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) index2,
xi_c,
integer iupd,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2,
integer f_ddl,
integer l_ddl,
integer itask )

Definition at line 1216 of file produt_v.F.

1227C-----------------------------------------------
1228C M o d u l e s
1229C-----------------------------------------------
1230 USE intbufdef_mod
1231 USE groupdef_mod
1232C-----------------------------------------------
1233C I m p l i c i t T y p e s
1234C-----------------------------------------------
1235#include "implicit_f.inc"
1236#include "comlock.inc"
1237C-----------------------------------------------
1238C C o m m o n B l o c k s
1239C-----------------------------------------------
1240#include "com01_c.inc"
1241#include "com04_c.inc"
1242#include "impl1_c.inc"
1243#include "task_c.inc"
1244C-----------------------------------------------
1245C D u m m y A r g u m e n t s
1246C-----------------------------------------------
1247 INTEGER NDDL ,NDDLI,NDOF(*),IUPD,
1248 . IADL(*),JDIL(*),IADI(*),JDII(*),ITOK(*),
1249 . IPARI(*) ,NUM_IMP(*),NS_IMP(*) ,
1250 . NE_IMP(*),NSREM ,NSL,IBFV(*),INDEX2(*),
1251 . IRBE3(*),LRBE3(*),F_DDL ,L_DDL ,ITASK,
1252 . IRBE2(*),LRBE2(*)
1253 INTEGER NMONV,IMONV(*),MONVOL(*),FR_MV(*)
1254C REAL
1255 my_real
1256 . diag_k(*), w(*), lt_k(*) ,lt_i(*) ,v(*) ,
1257 . a(3,*),ar(3,*),ve(3,*),d(3,*),dr(3,*),x(3,*),
1258 . ms(*),volmon(*),skew(*),xframe(*),xi_c(*)
1259
1260 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
1261 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
1262C-----------------------------------------------
1263C L o c a l V a r i a b l e s
1264C-----------------------------------------------
1265 INTEGER I,J,K,II,KK,F_DDLI,L_DDLI
1266 my_real
1267 . l_k,work_ii(nddli)
1268C-----------------------------
1269 CALL mav_lt_h(nddl ,
1270 1 f_ddl ,l_ddl ,iadl ,jdil ,diag_k ,
1271 2 lt_k ,v ,w )
1272C----------------------
1273 CALL my_barrier
1274C---------------------
1275C ------[K]{V}
1276 IF ((nddli+nsrem+nsl)>0.AND.intp_c<0 ) THEN
1277C--------spmd only for the moment-------
1278 IF (itask==0) THEN
1279 IF (ilintf>0) THEN
1280 CALL int_matvp(ipari ,intbuf_tab ,ndof ,num_imp,
1281 1 ns_imp ,ne_imp ,index2 ,a ,ar ,
1282 2 ve ,xi_c ,ms ,d ,ibfv ,
1283 3 skew ,xframe ,v ,w ,dr ,
1284 4 nsrem ,nsl ,iupd ,irbe3 ,lrbe3 ,
1285 5 irbe2 ,lrbe2 )
1286 ELSE
1287 CALL int_matvp(ipari ,intbuf_tab ,ndof ,num_imp,
1288 1 ns_imp ,ne_imp ,index2 ,a ,ar ,
1289 2 ve ,x ,ms ,d ,ibfv ,
1290 3 skew ,xframe ,v ,w ,dr ,
1291 4 nsrem ,nsl ,iupd ,irbe3 ,lrbe3 ,
1292 5 irbe2 ,lrbe2 )
1293 ENDIF
1294 END IF !(ITASK==0) THEN
1295 ELSEIF(nddli>0) THEN
1296C ------LT_I //
1297 f_ddli=1+itask*nddli/nthread
1298 l_ddli=(itask+1)*nddli/nthread
1299C
1300 DO i=1,nddli
1301 work_ii(i) = zero
1302 ENDDO
1303C
1304 DO i=f_ddli,l_ddli
1305 ii = itok(i)
1306 DO j =iadi(i),iadi(i+1)-1
1307 k =jdii(j)
1308 kk = itok(k)
1309 l_k = lt_i(j)
1310 work_ii(i) = work_ii(i) + l_k*v(kk)
1311 work_ii(k) = work_ii(k) + l_k*v(ii)
1312 ENDDO
1313 ENDDO
1314C
1315#include "lockon.inc"
1316 DO i=1,nddli
1317 ii = itok(i)
1318 w(ii) = w(ii) + work_ii(i)
1319 ENDDO
1320#include "lockoff.inc"
1321C
1322 END IF !((NDDLI+NSREM+NSL)>0.AND.INTP_C<0 ) THEN
1323C----------------------
1324 CALL my_barrier
1325C---------------------
1326C
1327 IF (itask==0) THEN
1328 CALL matv_kif(v,w)
1329 IF (nmonv>0) THEN
1330 CALL mv_matv(monvol ,volmon ,x ,igrsurf,
1331 1 fr_mv ,nmonv ,imonv ,v ,w ,
1332 2 ndof ,ipari ,intbuf_tab ,a ,
1333 3 ar ,d ,ibfv ,skew ,xframe ,
1334 4 irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
1335 ENDIF
1336C
1337 IF (nspmd>1) THEN
1338 IF ((nsrem+nsl)>0.AND.intp_c>=0)
1339 . CALL fr_matv( a ,ve ,d ,ms ,x ,
1340 1 dr ,ar ,ipari ,intbuf_tab ,
1341 2 ndof ,num_imp,ns_imp,ne_imp,v ,
1342 3 nsrem ,nsl ,ibfv ,skew ,xframe ,
1343 4 w ,irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
1344 CALL spmd_sumf_v(w )
1345 ENDIF
1346 END IF !(ITASK==0) THEN
1347C--------------------------------------------
1348 RETURN
mav_lt_h
subroutine mav_lt_h(nddl, f_ddl, l_ddl, iadl, jdil, diag_k, lt_k, v, w)
Definition produt_v.F:1154

◆ mav_ltp()

subroutine mav_ltp ( integer nddl,
integer nddli,
integer, dimension(*) iadl,
integer, dimension(*) jdil,
diag_k,
lt_k,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
integer, dimension(*) itok,
lt_i,
v,
w,
a,
ar,
ve,
ms,
x,
d,
dr,
integer, dimension(*) ndof,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer nsrem,
integer nsl,
integer, dimension(*) ibfv,
skew,
xframe,
integer, dimension(*) monvol,
volmon,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) fr_mv,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) index2,
xi_c,
integer iupd,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2 )

Definition at line 556 of file produt_v.F.

566C-----------------------------------------------
567C M o d u l e s
568C-----------------------------------------------
569 USE intbufdef_mod
570 USE groupdef_mod
571C-----------------------------------------------
572C I m p l i c i t T y p e s
573C-----------------------------------------------
574#include "implicit_f.inc"
575C-----------------------------------------------
576C C o m m o n B l o c k s
577C-----------------------------------------------
578#include "com01_c.inc"
579#include "com04_c.inc"
580#include "impl1_c.inc"
581C-----------------------------------------------
582C D u m m y A r g u m e n t s
583C-----------------------------------------------
584 INTEGER NDDL ,NDDLI,NDOF(*),IUPD,
585 . IADL(*),JDIL(*),IADI(*),JDII(*),ITOK(*),
586 . IPARI(*) ,NUM_IMP(*),NS_IMP(*) ,
587 . NE_IMP(*),NSREM ,NSL,IBFV(*),INDEX2(*),
588 . IRBE3(*) ,LRBE3(*),IRBE2(*) ,LRBE2(*)
589 INTEGER NMONV,IMONV(*),MONVOL(*),FR_MV(*)
590C REAL
591 my_real
592 . diag_k(*), w(*), lt_k(*) ,lt_i(*) ,v(*) ,
593 . a(3,*),ar(3,*),ve(3,*),d(3,*),dr(3,*),x(3,*),
594 . ms(*),volmon(*),skew(*),xframe(*),xi_c(*)
595
596 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
597 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
598C-----------------------------------------------
599C L o c a l V a r i a b l e s
600C-----------------------------------------------
601 INTEGER I,J,K,II,KK,IBID
602 my_real
603 . l_k
604C-----------------------------
605 DO i=1,nddl
606 w(i)=diag_k(i)*v(i)
607 ENDDO
608C
609 DO i=1,nddl
610#include "vectorize.inc"
611 DO j =iadl(i),iadl(i+1)-1
612 k =jdil(j)
613 l_k = lt_k(j)
614 w(i) = w(i) + l_k*v(k)
615 w(k) = w(k) + l_k*v(i)
616 ENDDO
617 ENDDO
618C ------[K]{V}
619 IF ((nddli+nsrem+nsl)>0.AND.intp_c<0 ) THEN
620 IF (ilintf>0) THEN
621 CALL int_matvp(ipari ,intbuf_tab ,ndof ,num_imp,
622 1 ns_imp ,ne_imp ,index2 ,a ,ar ,
623 2 ve ,xi_c ,ms ,d ,ibfv ,
624 3 skew ,xframe ,v ,w ,dr ,
625 4 nsrem ,nsl ,iupd ,irbe3 ,lrbe3 ,
626 5 irbe2 ,lrbe2 )
627 ELSE
628 CALL int_matvp(ipari ,intbuf_tab ,ndof ,num_imp,
629 1 ns_imp ,ne_imp ,index2 ,a ,ar ,
630 2 ve ,x ,ms ,d ,ibfv ,
631 3 skew ,xframe ,v ,w ,dr ,
632 4 nsrem ,nsl ,iupd ,irbe3 ,lrbe3 ,
633 5 irbe2 ,lrbe2 )
634 ENDIF
635 ELSE
636C ------LT_I
637 DO i=1,nddli
638 ii = itok(i)
639#include "vectorize.inc"
640 DO j =iadi(i),iadi(i+1)-1
641 k =jdii(j)
642 kk = itok(k)
643 l_k = lt_i(j)
644 w(ii) = w(ii) + l_k*v(kk)
645 w(kk) = w(kk) + l_k*v(ii)
646 ENDDO
647 ENDDO
648 ENDIF
649 CALL matv_kif(v,w)
650 IF (nmonv>0) THEN
651 CALL mv_matv(monvol ,volmon ,x ,igrsurf,
652 1 fr_mv ,nmonv ,imonv ,v ,w ,
653 2 ndof ,ipari ,intbuf_tab ,a ,
654 3 ar ,d ,ibfv ,skew ,xframe ,
655 4 irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
656 ENDIF
657C
658 IF (nspmd>1) THEN
659 IF ((nsrem+nsl)>0.AND.intp_c>=0)
660 . CALL fr_matv( a ,ve ,d ,ms ,x ,
661 1 dr ,ar ,ipari ,intbuf_tab ,
662 2 ndof ,num_imp,ns_imp,ne_imp,v ,
663 3 nsrem ,nsl ,ibfv ,skew ,xframe ,
664 4 w ,irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
665 CALL spmd_sumf_v(w )
666 ENDIF
667C--------------------------------------------
668 RETURN

◆ mav_lu_h()

subroutine mav_lu_h ( integer nddl,
integer f_ddl,
integer l_ddl,
integer, dimension(*) iadl,
integer, dimension(*) jdil,
diag_k,
lt_k,
v,
w )

Definition at line 1789 of file produt_v.F.

1792C-----------------------------------------------
1793C M o d u l e s
1794C-----------------------------------------------
1795 USE imp_workh
1796C-----------------------------------------------
1797C I m p l i c i t T y p e s
1798C-----------------------------------------------
1799#include "implicit_f.inc"
1800C-----------------------------------------------
1801C D u m m y A r g u m e n t s
1802C-----------------------------------------------
1803 INTEGER F_DDL ,L_DDL ,IADL(*) ,JDIL(*),NDDL
1804C REAL
1805 my_real
1806 . diag_k(*), w(*), lt_k(*) ,v(*)
1807C-----------------------------------------------
1808C L o c a l V a r i a b l e s
1809C-----------------------------------------------
1810 INTEGER I,J,K,N
1811 my_real
1812 . l_k
1813C----------------------------
1814 DO i=f_ddl,l_ddl
1815 w(i)=diag_k(i)*v(i)
1816 ENDDO
1817C
1818 DO i=f_ddl,l_ddl
1819 DO j =iadl(i),iadl(i+1)-1
1820 k =jdil(j)
1821 l_k = lt_k(j)
1822 w(i) = w(i) + l_k*v(k)
1823 ENDDO
1824 ENDDO
1825C
1826 DO i=f_ddl,l_ddl
1827 DO j =iadk0(i),iadk0(i+1)-1
1828 k =jdik0(j)
1829 l_k = lt_k0(j)
1830 w(i) = w(i) + l_k*v(k)
1831 ENDDO
1832 ENDDO
1833C--------------------------------------------
1834 RETURN
imp_workh::jdik0
integer, dimension(:), allocatable jdik0
Definition impbufdef_mod.F:584
imp_workh::iadk0
integer, dimension(:), allocatable iadk0
Definition impbufdef_mod.F:584

◆ mav_lui_h()

subroutine mav_lui_h ( integer f_ddl,
integer l_ddl,
v,
w )

Definition at line 2522 of file produt_v.F.

2523C-----------------------------------------------
2524C M o d u l e s
2525C-----------------------------------------------
2526 USE imp_workh
2527C-----------------------------------------------
2528C I m p l i c i t T y p e s
2529C-----------------------------------------------
2530#include "implicit_f.inc"
2531C-----------------------------------------------
2532C D u m m y A r g u m e n t s
2533C-----------------------------------------------
2534 INTEGER F_DDL ,L_DDL
2535C REAL
2536 my_real
2537 . w(*), v(*)
2538C-----------------------------------------------
2539C L o c a l V a r i a b l e s
2540C-----------------------------------------------
2541 INTEGER I,J,K
2542 my_real
2543 . l_k
2544C
2545 DO i=f_ddl,l_ddl
2546 DO j =iadi0(i),iadi0(i+1)-1
2547 k =jdii0(j)
2548 l_k = lt_i0(j)
2549 w(i) = w(i) + l_k*v(k)
2550 ENDDO
2551 ENDDO
2552C--------------------------------------------
2553 RETURN

◆ mav_mm()

subroutine mav_mm ( integer nd,
integer md,
a,
b,
integer itask )

Definition at line 2882 of file produt_v.F.

2883C-----------------------------------------------
2884C I m p l i c i t T y p e s
2885C-----------------------------------------------
2886#include "implicit_f.inc"
2887C-----------------------------------------------
2888C D u m m y A r g u m e n t s
2889C-----------------------------------------------
2890 INTEGER ND ,MD ,ITASK
2891C REAL
2892 my_real
2893 . a(nd,*), b(md,*)
2894C-----------------------------------------------
2895c FUNCTION: product [A]<-[A][B]
2896c
2897c Note:
2898c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
2899c
2900c TYPE NAME FUNCTION
2901c I ND,MN - Matrix dimension 2D
2902c I ITASK - thread id (//)
2903c IO A(ND,MD) - Matrix A
2904c O B(MD,MD) - Matrix B
2905C-----------------------------------------------
2906C L o c a l V a r i a b l e s
2907C-----------------------------------------------
2908 INTEGER I,J,K
2909 my_real
2910 . c(nd,md)
2911C-----------------------------
2912 IF (itask /= 0) RETURN
2913C------------may add dynamic smp on ND after--
2914 DO i=1,nd
2915 DO j=1,md
2916 c(i,j)=zero
2917 DO k=1,md
2918 c(i,j) = c(i,j)+a(i,k)*b(k,j)
2919 END DO
2920 ENDDO
2921 ENDDO
2922C
2923 DO i=1,nd
2924 DO j=1,md
2925 a(i,j) = c(i,j)
2926 ENDDO
2927 ENDDO
2928C--------------------------------------------
2929 RETURN

◆ mav_mn()

subroutine mav_mn ( integer nd,
integer md,
a,
b,
c,
integer itask )

Definition at line 2791 of file produt_v.F.

2792C-----------------------------------------------
2793C I m p l i c i t T y p e s
2794C-----------------------------------------------
2795#include "implicit_f.inc"
2796C-----------------------------------------------
2797C D u m m y A r g u m e n t s
2798C-----------------------------------------------
2799 INTEGER ND ,MD ,ITASK
2800C REAL
2801 my_real
2802 . a(nd,*), b(*), c(*)
2803C-----------------------------------------------
2804c FUNCTION: product {C}=[A]{B}
2805c
2806c Note:
2807c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
2808c
2809c TYPE NAME FUNCTION
2810c I ND,MN - Matrix dimension 2D
2811c I ITASK - thread id (//)
2812c I B(NM) - right-hand vector
2813c O C(ND) - left-hand vector
2814C-----------------------------------------------
2815C L o c a l V a r i a b l e s
2816C-----------------------------------------------
2817 INTEGER I,J,K
2818 my_real
2819 . w(md)
2820C-----------------------------
2821 IF (itask /= 0) RETURN
2822C------------may add dynamic smp on ND after--
2823 DO i=1,nd
2824 DO j= 1,md
2825 w(j)= a(i,j)
2826 END DO
2827 CALL produt_v_loc( md ,w ,b ,c(i))
2828 ENDDO
2829C--------------------------------------------
2830 RETURN
produt_v_loc
subroutine produt_v_loc(nddl, x, y, r)
Definition produt_v.F:67

◆ mav_nm()

subroutine mav_nm ( integer f_nd,
integer l_nd,
integer nd,
integer md,
a,
b,
c,
integer, dimension(*) wddl,
integer itask )

Definition at line 2748 of file produt_v.F.

2749C-----------------------------------------------
2750C I m p l i c i t T y p e s
2751C-----------------------------------------------
2752#include "implicit_f.inc"
2753C-----------------------------------------------
2754C D u m m y A r g u m e n t s
2755C-----------------------------------------------
2756 INTEGER F_ND ,L_ND ,ND ,MD ,ITASK,WDDL(*)
2757C REAL
2758 my_real
2759 . a(nd,*), b(*), c(*)
2760C-----------------------------------------------
2761c FUNCTION: product {C}=[A]^t{B}
2762c
2763c Note:
2764c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
2765c
2766c TYPE NAME FUNCTION
2767c I ND,MD - Matrix dimension 2D
2768c I WDDL(*) - itag for each id of subdomains
2769c I F_ND,L_ND,ITASK - id in each ITASK:thread id (//)
2770c I A(ND,MN),B(ND) - right-hand vector
2771c O C(NM) - left-hand vector
2772C-----------------------------------------------
2773C L o c a l V a r i a b l e s
2774C-----------------------------------------------
2775 INTEGER I,J,K
2776C-----------------------------
2777 DO i=1,md
2778 CALL produt_h( f_nd ,l_nd ,a(1,i) ,b ,wddl ,c(i),itask)
2779 ENDDO
2780C--------------------------------------------
2781 RETURN

◆ mav_z()

subroutine mav_z ( integer ii,
integer nddl,
integer nnz,
integer, dimension(*) iadl,
integer, dimension(*) jdil,
diag_k,
lt_k,
integer nnzm,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
lt_m,
w )

Definition at line 747 of file produt_v.F.

749C-----------------------------------------------
750C I m p l i c i t T y p e s
751C-----------------------------------------------
752#include "implicit_f.inc"
753C-----------------------------------------------
754C D u m m y A r g u m e n t s
755C-----------------------------------------------
756 INTEGER NDDL ,NNZ ,IADL(*) ,JDIL(*),
757 1 II,NNZM ,IADM(*) ,JDIM(*)
758C REAL
759 my_real
760 . diag_k(*), w(*), lt_k(*) ,lt_m(*)
761C-----------------------------------------------
762C L o c a l V a r i a b l e s
763C-----------------------------------------------
764C-------implicitement LT_M(II,II)=1----
765 INTEGER I,J,K,IM,IZ
766 my_real
767 . l_k
768C-----------------------------
769 DO i=1,nddl
770 w(i)=zero
771 ENDDO
772 DO i = 1,ii-1
773 DO j =iadl(i),iadl(i+1)-1
774 k =jdil(j)
775 IF (k==ii) THEN
776 w(i) = lt_k(j)
777 ENDIF
778 ENDDO
779 ENDDO
780 w(ii)=diag_k(ii)
781 DO j =iadl(ii),iadl(ii+1)-1
782 k =jdil(j)
783 w(k) = lt_k(j)
784 ENDDO
785C-------Kij Vj (j>i)---
786 DO im=iadm(ii),iadm(ii+1)-1
787 i =jdim(im)
788 w(i)=w(i)+diag_k(i)*lt_m(im)
789 DO j =iadl(i),iadl(i+1)-1
790 k =jdil(j)
791 l_k = lt_k(j)*lt_m(im)
792 w(k) = w(k) + l_k
793 ENDDO
794 ENDDO
795C-------Kij Vj (j<i)---
796 DO i = 1,ii-1
797 DO 100 im=iadm(ii),iadm(ii+1)-1
798 iz =jdim(im)
799 DO j =iadl(i),iadl(i+1)-1
800 k =jdil(j)
801 IF (k>iz) THEN
802 GOTO 100
803 ELSEIF (k==iz) THEN
804 w(i)=w(i)+lt_k(j)*lt_m(im)
805 ENDIF
806 ENDDO
807 100 CONTINUE
808 ENDDO
809C--------------------------------------------
810 RETURN

◆ mav_zi()

subroutine mav_zi ( integer ii,
integer nddl,
integer nnz,
integer, dimension(*) iadl,
integer, dimension(*) jdil,
diag_k,
lt_k,
integer nnzz,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
lt_m,
w )

Definition at line 674 of file produt_v.F.

676C-----------------------------------------------
677C I m p l i c i t T y p e s
678C-----------------------------------------------
679#include "implicit_f.inc"
680C-----------------------------------------------
681C D u m m y A r g u m e n t s
682C-----------------------------------------------
683 INTEGER NDDL ,NNZ ,IADL(*) ,JDIL(*),
684 1 II,NNZZ ,IADM(*) ,JDIM(*)
685C REAL
686 my_real
687 . diag_k(*), w(*), lt_k(*) ,lt_m(*)
688C-----------------------------------------------
689C L o c a l V a r i a b l e s
690C-----------------------------------------------
691C--- LT_M(NNZM) IADM(NNZZ) position in LT_M,JDIM(NNZZ) line in LT_M
692C-------implicitement v(nnzz+1)=1,jdim(nnzz+1)=ii----
693 INTEGER I,J,K,IZ,IM,JJ
694 my_real
695 . l_k
696C-----------------------------
697 DO i=1,nddl
698 w(i)=zero
699 ENDDO
700 DO i = 1,ii-1
701 DO j =iadl(i),iadl(i+1)-1
702 k =jdil(j)
703 IF (k==ii) THEN
704 w(i) = lt_k(j)
705 ENDIF
706 ENDDO
707 ENDDO
708 w(ii)=diag_k(ii)
709 DO j =iadl(ii),iadl(ii+1)-1
710 k =jdil(j)
711 w(k) = lt_k(j)
712 ENDDO
713C-------Kij Vj (j>i)---
714 DO iz=1,nnzz
715 i =jdim(iz)
716 im=iadm(iz)
717 w(i)=w(i)+diag_k(i)*lt_m(im)
718 DO j =iadl(i),iadl(i+1)-1
719 k =jdil(j)
720 l_k = lt_k(j)*lt_m(im)
721 w(k) = w(k) + l_k
722 ENDDO
723 ENDDO
724C-------Kij Vj (j<i)---
725 DO i = 1,ii-1
726 DO 100 iz=1,nnzz
727 jj =jdim(iz)
728 DO j =iadl(i),iadl(i+1)-1
729 k =jdil(j)
730 IF (k>jj) THEN
731 GOTO 100
732 ELSEIF (k==jj) THEN
733 im=iadm(iz)
734 w(i)=w(i)+lt_k(j)*lt_m(im)
735 ENDIF
736 ENDDO
737 100 CONTINUE
738 ENDDO
739C
740C--------------------------------------------
741 RETURN

◆ mmav_lth()

subroutine mmav_lth ( integer nddl,
integer nddli,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer, dimension(*) iadi,
integer, dimension(*) jdii,
integer, dimension(*) itok,
lt_i,
v,
w,
a,
ar,
ve,
ms,
x,
d,
dr,
integer, dimension(*) ndof,
integer, dimension(*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(*) num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer nsrem,
integer nsl,
integer, dimension(*) ibfv,
skew,
xframe,
integer, dimension(*) monvol,
volmon,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) fr_mv,
integer nmonv,
integer, dimension(*) imonv,
integer, dimension(*) ind_imp,
xi_c,
integer iupd,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
integer f_ddl,
integer l_ddl,
integer itask,
v_w )

Definition at line 2948 of file produt_v.F.

2960C-----------------------------------------------
2961C M o d u l e s
2962C-----------------------------------------------
2963 USE imp_workh
2964 USE intbufdef_mod
2965 USE groupdef_mod
2966C-----------------------------------------------
2967C I m p l i c i t T y p e s
2968C-----------------------------------------------
2969#include "implicit_f.inc"
2970#include "comlock.inc"
2971C-----------------------------------------------
2972C C o m m o n B l o c k s
2973C-----------------------------------------------
2974#include "com04_c.inc"
2975C-----------------------------------------------
2976C D u m m y A r g u m e n t s
2977C-----------------------------------------------
2978 INTEGER NDDL ,NDDLI,NDOF(*),IUPD,
2979 . IADK(*),JDIK(*),IADI(*),JDII(*),ITOK(*),
2980 . IPARI(*) ,NUM_IMP(*),NS_IMP(*) ,
2981 . NE_IMP(*),NSREM ,NSL,IBFV(*),IND_IMP(*),
2982 . IRBE3(*),LRBE3(*),F_DDL ,L_DDL ,ITASK,
2983 . IRBE2(*),LRBE2(*),IADM(*) ,JDIM(*)
2984 INTEGER NMONV,IMONV(*),MONVOL(*),FR_MV(*)
2985C REAL
2986 my_real
2987 . diag_k(*), w(*), lt_k(*) ,lt_i(*) ,v(*) ,
2988 . a(3,*),ar(3,*),ve(3,*),d(3,*),dr(3,*),x(3,*),
2989 . ms(*),volmon(*),skew(*),xframe(*),xi_c(*) ,
2990 . diag_m(*),lt_m(*),v_w(*)
2991
2992 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2993 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
2994C-----------------------------------------------
2995C L o c a l V a r i a b l e s
2996C-----------------------------------------------
2997C------Hybrid----produit {w}=[K']{v}=Lm[K]Lm^t{v} (Lm=L_M*sqrt(Diag_M))--DIAG_M->sqrt()--
2998C--------------if M=Lm*D*Lm^t, should be -> [K']=sqrt(D)*Lm^t[K]Lm*sqrt(D)
2999 INTEGER I,J,K
3000 my_real
3001 . zw1(nddl)
3002C--------------------------------------------
3003C------------------{zw1}=Lm^t{v}--------------------------
3004 CALL mmv_lh(
3005 1 nddl ,iadm0 ,jdim0 ,diag_m ,lt_m0 ,
3006 2 v ,v_w ,f_ddl ,l_ddl ,itask )
3007C----------------------
3008 CALL my_barrier
3009C---------------------
3010 DO i=1 ,nddl
3011 zw1(i) = v_w(i)
3012 ENDDO
3013C----------------------
3014 CALL my_barrier
3015C-----------------{zw2}=[K]{zw1}----
3016 CALL mav_lth(
3017 1 nddl ,nddli ,iadk ,jdik ,diag_k,
3018 2 lt_k ,iadi ,jdii ,itok ,lt_i ,
3019 3 zw1 ,v_w ,a ,ar ,
3020 5 ve ,ms ,x ,d ,dr ,
3021 6 ndof ,ipari ,intbuf_tab ,num_imp,
3022 7 ns_imp,ne_imp,nsrem ,nsl ,ibfv ,
3023 8 skew ,xframe,monvol,volmon,igrsurf ,
3024 9 fr_mv,nmonv ,imonv ,ind_imp,
3025 a xi_c ,iupd ,irbe3 ,lrbe3 ,irbe2 ,
3026 b lrbe2 ,f_ddl ,l_ddl ,itask )
3027C----------------------
3028 CALL my_barrier
3029C-----------------{w}=[Lm]{zw2}----
3030 CALL mmv_lth(
3031 1 nddl ,iadm ,jdim ,diag_m ,lt_m ,
3032 2 v_w ,w ,f_ddl ,l_ddl ,itask )
3033C
3034 RETURN
imp_workh::jdim0
integer, dimension(:), allocatable jdim0
Definition impbufdef_mod.F:584
imp_workh::iadm0
integer, dimension(:), allocatable iadm0
Definition impbufdef_mod.F:584
mmv_lth
subroutine mmv_lth(nddl, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl, itask)
Definition produt_v.F:3048
mav_lth
subroutine mav_lth(nddl, nddli, iadl, jdil, diag_k, lt_k, iadi, jdii, itok, lt_i, v, w, a, ar, ve, ms, x, d, dr, ndof, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, ibfv, skew, xframe, monvol, volmon, igrsurf, fr_mv, nmonv, imonv, index2, xi_c, iupd, irbe3, lrbe3, irbe2, lrbe2, f_ddl, l_ddl, itask)
Definition produt_v.F:1380
mmv_lh
subroutine mmv_lh(nddl, iadm, jdim, diag_m, lt_m, v, z, f_ddl, l_ddl, itask)
Definition produt_v.F:3113

◆ mmv_lh()

subroutine mmv_lh ( integer nddl,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
v,
z,
integer f_ddl,
integer l_ddl,
integer itask )

Definition at line 3110 of file produt_v.F.

3113C-----------------------------------------------
3114C I m p l i c i t T y p e s
3115C-----------------------------------------------
3116#include "implicit_f.inc"
3117C-----------------------------------------------
3118C C o m m o n B l o c k s
3119C-----------------------------------------------
3120#include "impl1_c.inc"
3121#include "com01_c.inc"
3122C-----------------------------------------------
3123C D u m m y A r g u m e n t s
3124C-----------------------------------------------
3125 INTEGER NDDL ,IADM(*) ,JDIM(*),F_DDL ,L_DDL,ITASK
3126C REAL
3127 my_real
3128 . diag_m(*), z(*), lt_m(*) ,v(*)
3129C-----------------------------------------------
3130C L o c a l V a r i a b l e s
3131C-----------------------------------------------
3132C-------hybrid version-solves {z}=[Z][D]^-1/2{v}----[Z] en colonne-
3133 INTEGER I,J,K
3134 my_real
3135 . tmp(nddl)
3136C-----------------------------
3137 DO i=f_ddl ,l_ddl
3138 z(i) = v(i)
3139 ENDDO
3140C
3141 IF (iprec==2) THEN
3142 DO i=f_ddl ,l_ddl
3143 z(i) = v(i)*diag_m(i)
3144 ENDDO
3145 ELSEIF (iprec==5) THEN
3146C--------{z}=[D]^-1/2{v}-------------
3147 DO i=f_ddl ,l_ddl
3148 z(i) = v(i)*diag_m(i)
3149 ENDDO
3150C----------------------
3151 CALL my_barrier
3152C---------------------
3153 DO i=1 ,nddl
3154 tmp(i) = z(i)
3155 ENDDO
3156C----------------------
3157 CALL my_barrier
3158C---------------------
3159C --------{z}=[Z]{z}-------
3160 DO i=f_ddl ,l_ddl
3161 DO j =iadm(i),iadm(i+1)-1
3162 k = jdim(j)
3163 z(i) = z(i)+lt_m(j)*tmp(k)
3164 ENDDO
3165 ENDDO
3166 END IF !(IPREC==2) THEN
3167C
3168 IF (iprec>1) THEN
3169C----------------------
3170 CALL my_barrier
3171C---------------------
3172 IF (itask==0.AND.nspmd>1) CALL spmd_sumf_v(z)
3173 ENDIF
3174C--------------------------------------------
3175 RETURN

◆ mmv_lth()

subroutine mmv_lth ( integer nddl,
integer, dimension(*) iadm,
integer, dimension(*) jdim,
diag_m,
lt_m,
v,
z,
integer f_ddl,
integer l_ddl,
integer itask )

Definition at line 3045 of file produt_v.F.

3048C-----------------------------------------------
3049C I m p l i c i t T y p e s
3050C-----------------------------------------------
3051#include "implicit_f.inc"
3052C-----------------------------------------------
3053C C o m m o n B l o c k s
3054C-----------------------------------------------
3055#include "impl1_c.inc"
3056#include "com01_c.inc"
3057C-----------------------------------------------
3058C D u m m y A r g u m e n t s
3059C-----------------------------------------------
3060 INTEGER NDDL ,IADM(*) ,JDIM(*),F_DDL ,L_DDL,ITASK
3061C REAL
3062 my_real
3063 . diag_m(*), z(*), lt_m(*) ,v(*)
3064C-----------------------------------------------
3065C L o c a l V a r i a b l e s
3066C-----------------------------------------------
3067C------hybrid version-solves {z}=[D]^-1/2[Z]^t{v}-----
3068 INTEGER I,J,K
3069C-----------------------------
3070 DO i=f_ddl ,l_ddl
3071 z(i) = v(i)
3072 ENDDO
3073C
3074 IF (iprec==2) THEN
3075 DO i=f_ddl ,l_ddl
3076 z(i) = v(i)*diag_m(i)
3077 ENDDO
3078 ELSEIF (iprec==5) THEN
3079C--------{z}=[Z]^t{v}-------------
3080 DO i=f_ddl ,l_ddl
3081 DO j =iadm(i),iadm(i+1)-1
3082 k = jdim(j)
3083 z(i) = z(i)+lt_m(j)*v(k)
3084 ENDDO
3085 ENDDO
3086C--------{z}=[D]^-1/2{z}-------------
3087 DO i=f_ddl ,l_ddl
3088 z(i) = z(i)*diag_m(i)
3089 ENDDO
3090 END IF !(IPREC==2) THEN
3091C
3092 IF (iprec>1) THEN
3093C----------------------
3094 CALL my_barrier
3095C---------------------
3096 IF (itask==0.AND.nspmd>1) CALL spmd_sumf_v(z)
3097 ENDIF
3098C--------------------------------------------
3099 RETURN

◆ mortho_gs()

subroutine mortho_gs ( integer f_ddl,
integer l_ddl,
integer nddl,
integer md_f,
integer md_l,
a,
integer, dimension(*) wddl,
integer itask )

Definition at line 2690 of file produt_v.F.

2692C-----------------------------------------------
2693C I m p l i c i t T y p e s
2694C-----------------------------------------------
2695#include "implicit_f.inc"
2696C-----------------------------------------------
2697C D u m m y A r g u m e n t s
2698C-----------------------------------------------
2699 INTEGER NDDL,MD_F,MD_L,F_DDL,L_DDL ,WDDL(*), ITASK
2700C REAL
2701 my_real
2702 . a(nddl,*)
2703C-----------------------------------------------
2704c FUNCTION: stabilized Gram-Schmidt orthonormalization (from MD_F to MD_L)
2705c
2706c Note:
2707c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
2708c
2709c TYPE NAME FUNCTION
2710c I MD_F to MD_L - vectors to be orthonormalized dim. of A(*,MD) should be MD_L
2711c I F_DDL,L_DDL,ITASK - dim. of A(F_DDL:L_DDL,MD), of Itask (Thread id)
2712c I WDDL(*) - itag for each id(F_DDL,L_DDL) with subdomains
2713c IO A(NDDL,MD) - A(NDDL,MD) orthonormalized for output
2714C-----------------------------------------------
2715C L o c a l V a r i a b l e s
2716C-----------------------------------------------
2717 INTEGER I,J
2718 my_real
2719 . sii,sij,s,sjj
2720C-----------------------------
2721 DO j= md_f ,md_l
2722 DO i=1,j-1
2723 CALL produt_h(f_ddl ,l_ddl ,a(1,i) ,a(1,j) ,wddl, sij ,itask)
2724 s = -sij
2725 CALL vaxpy_h(f_ddl ,l_ddl ,a(1,i) ,a(1,j) ,s ,itask )
2726C----------------------
2727 CALL my_barrier
2728C---------------------
2729 END DO
2730 CALL produt_h(f_ddl ,l_ddl ,a(1,j) ,a(1,j) ,wddl, sjj ,itask)
2731 s= one/max(em20,sqrt(sjj))
2732 CALL vscal_h(f_ddl ,l_ddl ,a(1,j) ,s ,itask )
2733C----------------------
2734 CALL my_barrier
2735C---------------------
2736 END DO
2737C--------------------------------------------
2738 RETURN
max
#define max(a, b)
Definition macros.h:21
vscal_h
subroutine vscal_h(f_ddl, l_ddl, v, s, itask)
Definition produt_v.F:2609
vaxpy_h
subroutine vaxpy_h(f_ddl, l_ddl, a, b, s, itask)
Definition produt_v.F:2647

◆ produt_h()

subroutine produt_h ( integer f_ddl,
integer l_ddl,
x,
y,
integer, dimension(*) w,
r,
integer itask )

Definition at line 1532 of file produt_v.F.

1533C-----------------------------------------------
1534C I m p l i c i t T y p e s
1535C-----------------------------------------------
1536#include "implicit_f.inc"
1537#include "comlock.inc"
1538C-----------------------------------------------
1539C G l o b a l P a r a m e t e r s
1540C-----------------------------------------------
1541#include "mvsiz_p.inc"
1542C-----------------------------------------------
1543C C o m m o n B l o c k s
1544C-----------------------------------------------
1545#include "param_c.inc"
1546#include "com01_c.inc"
1547#include "impl2_c.inc"
1548#include "timeri_c.inc"
1549C-----------------------------------------------
1550C D u m m y A r g u m e n t s
1551C-----------------------------------------------
1552 INTEGER F_DDL ,L_DDL ,W(*) ,ITASK
1553C REAL
1554 my_real
1555 . x(*), y(*) ,r
1556C-----------------------------------------------
1557C L o c a l V a r i a b l e s
1558C-----------------------------------------------
1559 INTEGER I ,N,J,NE
1560 my_real
1561 . rtmp(mvsiz),rl
1562C-----------------------------
1563 IF (itask==0) r_n2 = zero
1564C----------------------
1565 CALL my_barrier
1566C---------------------
1567 IF (nspmd == 1) THEN
1568 rl = zero
1569 DO n=f_ddl,l_ddl,nvsiz
1570 ne =min(l_ddl-n+1,nvsiz)
1571C
1572 DO i=1,ne
1573 j=n+i-1
1574 rtmp(i) = x(j)*y(j)
1575 ENDDO
1576 DO i=1,ne
1577 rl = rl + rtmp(i)
1578 ENDDO
1579 END DO
1580#include "lockon.inc"
1581 r_n2 = r_n2 + rl
1582#include "lockoff.inc"
1583C------------
1584 ELSE
1585C------------NSPMD>1--------
1586 rl = zero
1587 DO n=f_ddl,l_ddl,mvsiz
1588 ne =min(l_ddl-n+1,mvsiz)
1589C
1590 DO i=1,ne
1591 j=n+i-1
1592 rtmp(i) = x(j)*y(j)*w(j)
1593 ENDDO
1594 DO i=1,ne
1595 rl = rl + rtmp(i)
1596 ENDDO
1597 END DO
1598#include "lockon.inc"
1599 r_n2 = r_n2 + rl
1600#include "lockoff.inc"
1601C----------------------
1602 CALL my_barrier
1603C---------------------
1604 IF (itask==0) THEN
1605! IF(IMONM > 0) CALL STARTIME(TIMERS,67)
1606 CALL spmd_sum_s(r_n2)
1607! IF(IMONM > 0) CALL STARTIME(TIMERS,67)
1608 END IF
1609C
1610 END IF !(NSPMD == 1) THEN
1611C----------------------
1612 CALL my_barrier
1613C---------------------
1614 r = r_n2
1615C----------------------
1616 CALL my_barrier
1617C---------------------
1618 RETURN
spmd_sum_s
subroutine spmd_sum_s(s)
Definition imp_spmd.F:1037
min
#define min(a, b)
Definition macros.h:20

◆ produt_hp()

subroutine produt_hp ( integer nddl,
x,
y,
integer, dimension(*) w,
r )

Definition at line 3251 of file produt_v.F.

3252C-----------------------------------------------
3253C I m p l i c i t T y p e s
3254C-----------------------------------------------
3255#include "implicit_f.inc"
3256#include "comlock.inc"
3257C-----------------------------------------------
3258C C o m m o n B l o c k s
3259C-----------------------------------------------
3260#include "com01_c.inc"
3261#include "timeri_c.inc"
3262C-----------------------------------------------
3263C D u m m y A r g u m e n t s
3264C-----------------------------------------------
3265 INTEGER NDDL,W(*)
3266C REAL
3267 my_real
3268 . x(*), y(*) ,r
3269C-----------------------------------------------
3270C L o c a l V a r i a b l e s
3271C-----------------------------------------------
3272 INTEGER F_DDL ,L_DDL ,ITSK
3273 INTEGER I ,N,J
3274 my_real
3275 . rl
3276C-----------------------------
3277 r = zero
3278C---------------------
3279 IF (nspmd > 1) THEN
3280!$OMP PARALLEL PRIVATE(ITSK,F_DDL ,L_DDL,RL,J)
3281 CALL imp_smpini(itsk ,f_ddl ,l_ddl ,nddl )
3282 rl = zero
3283 DO j=f_ddl,l_ddl
3284 rl = rl + x(j)*y(j)*w(j)
3285 END DO
3286#include "lockon.inc"
3287 r = r + rl
3288#include "lockoff.inc"
3289!$OMP END PARALLEL
3290! IF(IMONM > 0) CALL STARTIME(TIMERS,67)
3291 CALL spmd_sum_s(r)
3292! IF(IMONM > 0) CALL STARTIME(TIMERS,67)
3293C------mono domain
3294 ELSE
3295!$OMP PARALLEL PRIVATE(ITSK,F_DDL ,L_DDL,RL,J )
3296 CALL imp_smpini(itsk ,f_ddl ,l_ddl ,nddl )
3297 rl = zero
3298 DO j=f_ddl,l_ddl
3299 rl = rl + x(j)*y(j)
3300 END DO
3301#include "lockon.inc"
3302 r = r + rl
3303#include "lockoff.inc"
3304!$OMP END PARALLEL
3305 END IF !(NSPMD > 1) THEN
3306C---------------------
3307 RETURN

◆ produt_u()

subroutine produt_u ( integer nddl0,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
dd,
ddr,
norm2,
integer, dimension(*) w_imp )

Definition at line 222 of file produt_v.F.

224C-----------------------------------------------
225C I m p l i c i t T y p e s
226C-----------------------------------------------
227#include "implicit_f.inc"
228C-----------------------------------------------
229C D u m m y A r g u m e n t s
230C-----------------------------------------------
231 INTEGER NDDL,NDDL0,IDDL(*) ,NDOF(*) ,IKC(*),W_IMP(*)
232C REAL
233 my_real
234 . dd(*),ddr(*), norm2
235C-----------------------------------------------
236C L o c a l V a r i a b l e s
237C-----------------------------------------------
238 INTEGER I
239 my_real
240 . x(nddl0)
241C-----------------------------
242 CALL imp_setb(dd ,ddr ,iddl ,ndof ,x )
243 CALL condens_b(nddl0 ,ikc ,x )
244 CALL produt_w(nddl,x,x,w_imp,norm2)
245C--------------------------------------------
246 RETURN
produt_w
subroutine produt_w(nddl, x, y, w, r)
Definition produt_v.F:106

◆ produt_u0()

subroutine produt_u0 ( dd,
ddr,
norm2,
integer, dimension(*) weight )

Definition at line 2422 of file produt_v.F.

2423C-----------------------------------------------
2424C I m p l i c i t T y p e s
2425C-----------------------------------------------
2426#include "implicit_f.inc"
2427C-----------------------------------------------
2428C C o m m o n B l o c k s
2429C-----------------------------------------------
2430#include "com01_c.inc"
2431#include "com04_c.inc"
2432C-----------------------------------------------
2433C D u m m y A r g u m e n t s
2434C-----------------------------------------------
2435 INTEGER WEIGHT(*)
2436C REAL
2437 my_real
2438 . dd(3,*),ddr(3,*), norm2
2439C-----------------------------------------------
2440C L o c a l V a r i a b l e s
2441C-----------------------------------------------
2442 INTEGER I
2443C-----------------------------
2444 norm2=zero
2445 DO i=1,numnod
2446 IF (weight(i)==1) THEN
2447 norm2 = norm2 + dd(1,i)*dd(1,i)
2448 norm2 = norm2 + dd(2,i)*dd(2,i)
2449 norm2 = norm2 + dd(3,i)*dd(3,i)
2450 END IF
2451 END DO
2452 IF (iroddl>0) THEN
2453 DO i=1,numnod
2454 IF (weight(i)==1) THEN
2455 norm2 = norm2 + ddr(1,i)*ddr(1,i)
2456 norm2 = norm2 + ddr(2,i)*ddr(2,i)
2457 norm2 = norm2 + ddr(3,i)*ddr(3,i)
2458 END IF
2459 END DO
2460 END IF
2461C
2462 IF (nspmd>1) THEN
2463 CALL spmd_sum_s(norm2)
2464 END IF
2465C--------------------------------------------
2466 RETURN

◆ produt_u2()

subroutine produt_u2 ( integer nddl0,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
d1,
d1r,
d2,
d2r,
norm2,
integer, dimension(*) w_imp )

Definition at line 259 of file produt_v.F.

262C-----------------------------------------------
263C I m p l i c i t T y p e s
264C-----------------------------------------------
265#include "implicit_f.inc"
266C-----------------------------------------------
267C D u m m y A r g u m e n t s
268C-----------------------------------------------
269 INTEGER NDDL,NDDL0,IDDL(*) ,NDOF(*) ,IKC(*),W_IMP(*)
270C REAL
271 my_real
272 . d1(*),d1r(*), d2(*),d2r(*), norm2
273C-----------------------------------------------
274C L o c a l V a r i a b l e s
275C-----------------------------------------------
276 INTEGER I
277 my_real
278 . x(nddl0),y(nddl0)
279C-----------------------------
280 CALL imp_setb(d1 ,d1r ,iddl ,ndof ,x )
281 CALL imp_setb(d2 ,d2r ,iddl ,ndof ,y )
282 CALL condens_b(nddl0 ,ikc ,x )
283 CALL condens_b(nddl0 ,ikc ,y )
284 CALL produt_w(nddl,x,y,w_imp,norm2)
285C--------------------------------------------
286 RETURN

◆ produt_uh()

subroutine produt_uh ( integer nddl0,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
dd,
ddr,
norm2,
integer, dimension(*) w_imp,
integer f_ddl,
integer l_ddl,
integer itask )

Definition at line 1684 of file produt_v.F.

1687C-----------------------------------------------
1688C M o d u l e s
1689C-----------------------------------------------
1690 USE imp_workh
1691C-----------------------------------------------
1692C I m p l i c i t T y p e s
1693C-----------------------------------------------
1694#include "implicit_f.inc"
1695C-----------------------------------------------
1696C D u m m y A r g u m e n t s
1697C-----------------------------------------------
1698 INTEGER NDDL,NDDL0,IDDL(*) ,NDOF(*) ,IKC(*),W_IMP(*) ,
1699 . F_DDL ,L_DDL ,ITASK
1700C REAL
1701 my_real
1702 . dd(*),ddr(*), norm2
1703C-----------------------------------------------
1704C L o c a l V a r i a b l e s
1705C-----------------------------------------------
1706 INTEGER I
1707C-----------------------------
1708 IF (itask == 0 ) THEN
1709 ALLOCATE(tmp_w1(nddl0))
1710 CALL imp_setb(dd ,ddr ,iddl ,ndof ,tmp_w1)
1711 CALL condens_b(nddl0 ,ikc ,tmp_w1)
1712 END IF
1713C----------------------
1714 CALL my_barrier
1715C---------------------
1716 CALL produt_h(f_ddl,l_ddl,tmp_w1,tmp_w1,w_imp,norm2,itask)
1717C----------------------
1718 CALL my_barrier
1719C---------------------
1720 IF (itask == 0 ) DEALLOCATE(tmp_w1)
1721C--------------------------------------------
1722 RETURN

◆ produt_uh2()

subroutine produt_uh2 ( integer nddl0,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
d1,
d1r,
d2,
d2r,
norm2,
integer, dimension(*) w_imp,
integer f_ddl,
integer l_ddl,
integer itask )

Definition at line 1738 of file produt_v.F.

1741C-----------------------------------------------
1742C M o d u l e s
1743C-----------------------------------------------
1744 USE imp_workh
1745C-----------------------------------------------
1746C I m p l i c i t T y p e s
1747C-----------------------------------------------
1748#include "implicit_f.inc"
1749C-----------------------------------------------
1750C D u m m y A r g u m e n t s
1751C-----------------------------------------------
1752 INTEGER NDDL,NDDL0,IDDL(*) ,NDOF(*) ,IKC(*),W_IMP(*),
1753 . F_DDL ,L_DDL ,ITASK
1754C REAL
1755 my_real
1756 . d1(*),d1r(*), d2(*),d2r(*), norm2
1757C-----------------------------------------------
1758C L o c a l V a r i a b l e s
1759C-----------------------------------------------
1760 INTEGER I
1761C-----------------------------
1762 IF (itask == 0 ) THEN
1763 ALLOCATE(tmp_w1(nddl0),tmp_w2(nddl0))
1764 CALL imp_setb(d1 ,d1r ,iddl ,ndof ,tmp_w1)
1765 CALL imp_setb(d2 ,d2r ,iddl ,ndof ,tmp_w2)
1766 CALL condens_b(nddl0 ,ikc ,tmp_w1)
1767 CALL condens_b(nddl0 ,ikc ,tmp_w2)
1768 END IF
1769C----------------------
1770 CALL my_barrier
1771C----------------------
1772 CALL produt_h(f_ddl,l_ddl,tmp_w1,tmp_w2,w_imp,norm2,itask)
1773C----------------------
1774 CALL my_barrier
1775C---------------------
1776 IF (itask == 0 ) DEALLOCATE(tmp_w1,tmp_w2)
1777C--------------------------------------------
1778 RETURN

◆ produt_uhp()

subroutine produt_uhp ( integer nddl0,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
dd,
ddr,
norm2,
integer, dimension(*) w_imp )

Definition at line 3357 of file produt_v.F.

3359C-----------------------------------------------
3360C I m p l i c i t T y p e s
3361C-----------------------------------------------
3362#include "implicit_f.inc"
3363C-----------------------------------------------
3364C D u m m y A r g u m e n t s
3365C-----------------------------------------------
3366 INTEGER NDDL,NDDL0,IDDL(*) ,NDOF(*) ,IKC(*),W_IMP(*) ,
3367 . F_DDL ,L_DDL ,ITASK
3368C REAL
3369 my_real
3370 . dd(*),ddr(*), norm2
3371C-----------------------------------------------
3372C L o c a l V a r i a b l e s
3373C-----------------------------------------------
3374 INTEGER I
3375 my_real
3376 . tmp_w1(nddl0)
3377C----------to // IMP_SETB,CONDENS_B-------------------
3378 CALL imp_setb(dd ,ddr ,iddl ,ndof ,tmp_w1)
3379 CALL condens_b(nddl0 ,ikc ,tmp_w1)
3380 CALL produt_hp(nddl,tmp_w1,tmp_w1,w_imp,norm2)
3381 RETURN
produt_hp
subroutine produt_hp(nddl, x, y, w, r)
Definition produt_v.F:3252

◆ produt_uhp0()

subroutine produt_uhp0 ( dd,
ddr,
norm2,
integer, dimension(*) weight )

Definition at line 3434 of file produt_v.F.

3435C-----------------------------------------------
3436C I m p l i c i t T y p e s
3437C-----------------------------------------------
3438#include "implicit_f.inc"
3439C-----------------------------------------------
3440C C o m m o n B l o c k s
3441C-----------------------------------------------
3442#include "com01_c.inc"
3443#include "com04_c.inc"
3444#include "comlock.inc"
3445C-----------------------------------------------
3446C D u m m y A r g u m e n t s
3447C-----------------------------------------------
3448 INTEGER WEIGHT(*)
3449C REAL
3450 my_real
3451 . dd(3,*),ddr(3,*), norm2
3452C-----------------------------------------------
3453C L o c a l V a r i a b l e s
3454C-----------------------------------------------
3455 INTEGER ITSK,NODFT ,NODLT,I
3456C-----------------------------
3457 norm2=zero
3458!$OMP PARALLEL PRIVATE(ITSK,NODFT ,NODLT,I)
3459 CALL imp_smpini(itsk ,nodft ,nodlt ,numnod )
3460 DO i=nodft ,nodlt
3461 IF (weight(i)==1) THEN
3462#include "lockon.inc"
3463 norm2 = norm2 + dd(1,i)*dd(1,i)
3464 norm2 = norm2 + dd(2,i)*dd(2,i)
3465 norm2 = norm2 + dd(3,i)*dd(3,i)
3466#include "lockoff.inc"
3467 END IF
3468 END DO
3469 IF (iroddl>0) THEN
3470 DO i=nodft ,nodlt
3471 IF (weight(i)==1) THEN
3472#include "lockon.inc"
3473 norm2 = norm2 + ddr(1,i)*ddr(1,i)
3474 norm2 = norm2 + ddr(2,i)*ddr(2,i)
3475 norm2 = norm2 + ddr(3,i)*ddr(3,i)
3476#include "lockoff.inc"
3477 END IF
3478 END DO
3479 END IF
3480!$OMP END PARALLEL
3481C
3482 IF (nspmd>1) THEN
3483 CALL spmd_sum_s(norm2)
3484 END IF
3485C--------------------------------------------
3486 RETURN

◆ produt_uhp2()

subroutine produt_uhp2 ( integer nddl0,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
d1,
d1r,
d2,
d2r,
norm2,
integer, dimension(*) w_imp )

Definition at line 3395 of file produt_v.F.

3398C-----------------------------------------------
3399C I m p l i c i t T y p e s
3400C-----------------------------------------------
3401#include "implicit_f.inc"
3402C-----------------------------------------------
3403C D u m m y A r g u m e n t s
3404C-----------------------------------------------
3405 INTEGER NDDL,NDDL0,IDDL(*) ,NDOF(*) ,IKC(*),W_IMP(*)
3406C REAL
3407 my_real
3408 . d1(*),d1r(*), d2(*),d2r(*), norm2
3409C-----------------------------------------------
3410C L o c a l V a r i a b l e s
3411C-----------------------------------------------
3412 INTEGER I
3413 my_real
3414 . tmp_w1(nddl0),tmp_w2(nddl0)
3415C-----------------------------
3416 CALL imp_setb(d1 ,d1r ,iddl ,ndof ,tmp_w1)
3417 CALL imp_setb(d2 ,d2r ,iddl ,ndof ,tmp_w2)
3418 CALL condens_b(nddl0 ,ikc ,tmp_w1)
3419 CALL condens_b(nddl0 ,ikc ,tmp_w2)
3420C----------------------
3421 CALL produt_hp(nddl,tmp_w1,tmp_w2,w_imp,norm2)
3422C--------------------------------------------
3423 RETURN

◆ produt_v()

subroutine produt_v ( integer nddl,
x,
y,
r )

Definition at line 32 of file produt_v.F.

33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40#include "com01_c.inc"
41C-----------------------------------------------
42C D u m m y A r g u m e n t s
43C-----------------------------------------------
44 INTEGER NDDL
45 my_real
46 . x(*), y(*) ,r
47C-----------------------------------------------
48C L o c a l V a r i a b l e s
49C-----------------------------------------------
50 INTEGER I
51C-----------------------------
52 r = zero
53 DO i=1,nddl
54 r = r + x(i)*y(i)
55 ENDDO
56 IF (nspmd>1) CALL spmd_sum_s(r)
57C--------------------------------------------
58 RETURN

◆ produt_v0()

subroutine produt_v0 ( integer nddl,
x,
y,
r )

Definition at line 943 of file produt_v.F.

944C-----------------------------------------------
945C I m p l i c i t T y p e s
946C-----------------------------------------------
947#include "implicit_f.inc"
948C-----------------------------------------------
949C D u m m y A r g u m e n t s
950C-----------------------------------------------
951 INTEGER NDDL
952C REAL
953 my_real
954 . x(*), y(*) ,r
955C-----------------------------------------------
956C L o c a l V a r i a b l e s
957C-----------------------------------------------
958 INTEGER I
959C-----------------------------
960 r = zero
961 DO i=1,nddl
962 r = r + x(i)*y(i)
963 ENDDO
964C--------------------------------------------
965 RETURN

◆ produt_v_loc()

subroutine produt_v_loc ( integer nddl,
x,
y,
r )

Definition at line 66 of file produt_v.F.

67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER NDDL
74 my_real
75 . x(*), y(*) ,r
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER I
80C-----------------------------
81 r = zero
82 DO i=1,nddl
83 r = r + x(i)*y(i)
84 ENDDO
85C--------------------------------------------
86 RETURN

◆ produt_vm()

subroutine produt_vm ( integer nddl0,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
dd,
ddr,
y,
r,
integer, dimension(*) w_imp )

Definition at line 185 of file produt_v.F.

187C-----------------------------------------------
188C I m p l i c i t T y p e s
189C-----------------------------------------------
190#include "implicit_f.inc"
191C-----------------------------------------------
192C D u m m y A r g u m e n t s
193C-----------------------------------------------
194 INTEGER NDDL,NDDL0,IDDL(*) ,NDOF(*) ,IKC(*) ,W_IMP(*)
195C REAL
196 my_real
197 . dd(*),ddr(*), y(*) ,r
198C-----------------------------------------------
199C L o c a l V a r i a b l e s
200C-----------------------------------------------
201 INTEGER I
202 my_real
203 . x(nddl)
204C-----------------------------
205 CALL d_to_u(nddl0 ,nddl ,iddl ,ndof ,ikc ,
206 . dd ,ddr ,x )
207 CALL produt_w(nddl,x,y,w_imp,r)
208C--------------------------------------------
209 RETURN
d_to_u
subroutine d_to_u(nddl0, nddl, iddl, ndof, ikc, d, dr, u)
Definition produt_v.F:154

◆ produt_vmh()

subroutine produt_vmh ( integer nddl0,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
dd,
ddr,
y,
r,
integer, dimension(*) w_imp,
integer f_ddl,
integer l_ddl,
integer itask )

Definition at line 1630 of file produt_v.F.

1633C-----------------------------------------------
1634C M o d u l e s
1635C-----------------------------------------------
1636 USE imp_workh
1637C-----------------------------------------------
1638C I m p l i c i t T y p e s
1639C-----------------------------------------------
1640#include "implicit_f.inc"
1641C-----------------------------------------------
1642C D u m m y A r g u m e n t s
1643C-----------------------------------------------
1644 INTEGER NDDL,NDDL0,IDDL(*) ,NDOF(*) ,IKC(*) ,W_IMP(*) ,
1645 . F_DDL ,L_DDL ,ITASK
1646C REAL
1647 my_real
1648 . dd(*),ddr(*), y(*) ,r
1649C-----------------------------------------------
1650C L o c a l V a r i a b l e s
1651C-----------------------------------------------
1652 INTEGER I
1653C-----------------------------
1654 IF (itask == 0 ) THEN
1655 ALLOCATE(tmp_w1(nddl))
1656 CALL d_to_u(nddl0 ,nddl ,iddl ,ndof ,ikc ,
1657 . dd ,ddr ,tmp_w1 )
1658 END IF
1659C----------------------
1660 CALL my_barrier
1661C---------------------
1662 CALL produt_h(f_ddl,l_ddl,tmp_w1,y,w_imp,r,itask)
1663C----------------------
1664 CALL my_barrier
1665C---------------------
1666 IF (itask == 0 ) DEALLOCATE(tmp_w1)
1667C--------------------------------------------
1668 RETURN

◆ produt_vmhp()

subroutine produt_vmhp ( integer nddl0,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
dd,
ddr,
y,
r,
integer, dimension(*) w_imp )

Definition at line 3319 of file produt_v.F.

3321C-----------------------------------------------
3322C I m p l i c i t T y p e s
3323C-----------------------------------------------
3324#include "implicit_f.inc"
3325C-----------------------------------------------
3326C D u m m y A r g u m e n t s
3327C-----------------------------------------------
3328 INTEGER NDDL,NDDL0,IDDL(*) ,NDOF(*) ,IKC(*) ,W_IMP(*)
3329 my_real
3330 . dd(*),ddr(*), y(*) ,r
3331C-----------------------------------------------
3332C L o c a l V a r i a b l e s
3333C-----------------------------------------------
3334C REAL
3335 my_real
3336 . tmp_w1(nddl)
3337C-------------to // D_TO_U----------------
3338 CALL d_to_u(nddl0 ,nddl ,iddl ,ndof ,ikc ,
3339 . dd ,ddr ,tmp_w1 )
3340C---------------------
3341 CALL produt_hp(nddl,tmp_w1,y,w_imp,r)
3342C--------------------------------------------
3343 RETURN

◆ produt_w()

subroutine produt_w ( integer nddl,
x,
y,
integer, dimension(*) w,
r )

Definition at line 105 of file produt_v.F.

106C-----------------------------------------------
107C I m p l i c i t T y p e s
108C-----------------------------------------------
109#include "implicit_f.inc"
110C-----------------------------------------------
111C C o m m o n B l o c k s
112C-----------------------------------------------
113#include "com01_c.inc"
114C-----------------------------------------------
115C D u m m y A r g u m e n t s
116C-----------------------------------------------
117 INTEGER NDDL ,W(*)
118C REAL
119 my_real
120 . x(*), y(*) ,r
121C-----------------------------------------------
122C L o c a l V a r i a b l e s
123C-----------------------------------------------
124 INTEGER I
125C-----------------------------
126 r = zero
127 IF (nspmd>1) THEN
128 DO i=1,nddl
129 IF (w(i)/=0) r = r + x(i)*y(i)
130 ENDDO
131 CALL spmd_sum_s(r)
132 ELSE
133 DO i=1,nddl
134 r = r + x(i)*y(i)
135 ENDDO
136 ENDIF
137C--------------------------------------------
138 RETURN

◆ vaxpy_h()

subroutine vaxpy_h ( integer f_ddl,
integer l_ddl,
a,
b,
s,
integer itask )

Definition at line 2646 of file produt_v.F.

2647C-----------------------------------------------
2648C I m p l i c i t T y p e s
2649C-----------------------------------------------
2650#include "implicit_f.inc"
2651C-----------------------------------------------
2652C D u m m y A r g u m e n t s
2653C-----------------------------------------------
2654 INTEGER F_DDL,L_DDL ,ITASK
2655C REAL
2656 my_real
2657 . s, a(*),b(*)
2658C-----------------------------------------------
2659c PURPOSE: B(*)<- B(*)+S*A(*)
2660c
2661c Note:
2662c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
2663c
2664c TYPE NAME FUNCTION
2665c I F_DDL,L_DDL,ITASK - dim. of V(F_DDL:L_DDL), of Itask (Thread id)
2666c I A(*) - input vector
2667c IO B(*) - axpy for output
2668C-----------------------------------------------
2669C L o c a l V a r i a b l e s
2670C-----------------------------------------------
2671 INTEGER I
2672C-----------------------------
2673 DO i= f_ddl,l_ddl
2674 b(i) = b(i) + s*a(i)
2675 END DO
2676C--------------------------------------------
2677 RETURN

◆ vaxpy_hp()

subroutine vaxpy_hp ( integer n,
v,
y,
s )

Definition at line 3579 of file produt_v.F.

3580C-----------------------------------------------
3581C I m p l i c i t T y p e s
3582C-----------------------------------------------
3583#include "implicit_f.inc"
3584C-----------------------------------------------
3585C D u m m y A r g u m e n t s
3586C-----------------------------------------------
3587 INTEGER N
3588C REAL
3589 my_real
3590 . s, v(*),y(*)
3591C-----------------------------------------------
3592c PURPOSE: V(*) <- V(*)+S*Y(*)
3593c
3594c Note:
3595c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
3596c
3597c TYPE NAME FUNCTION
3598c I N - dim. of V()
3599c I Y(*) - Y(*)
3600c O V(*) - V(*) scaled for output
3601C-----------------------------------------------
3602C L o c a l V a r i a b l e s
3603C-----------------------------------------------
3604 INTEGER I,ITSK,NFT,NLT
3605C-----------------------------
3606!$OMP PARALLEL PRIVATE(ITSK,NFT,NLT,I)
3607 CALL imp_smpini(itsk ,nft ,nlt ,n )
3608 DO i = nft ,nlt
3609 v(i) = v(i) + s*y(i)
3610 END DO !I=NFT ,NLT
3611!$OMP END PARALLEL
3612C--------------------------------------------
3613 RETURN

◆ vscal_h()

subroutine vscal_h ( integer f_ddl,
integer l_ddl,
v,
s,
integer itask )

Definition at line 2608 of file produt_v.F.

2609C-----------------------------------------------
2610C I m p l i c i t T y p e s
2611C-----------------------------------------------
2612#include "implicit_f.inc"
2613C-----------------------------------------------
2614C D u m m y A r g u m e n t s
2615C-----------------------------------------------
2616 INTEGER F_DDL,L_DDL ,ITASK
2617C REAL
2618 my_real
2619 . s, v(*)
2620C-----------------------------------------------
2621c PURPOSE: V(*)<-S*V(*)
2622c
2623c Note:
2624c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
2625c
2626c TYPE NAME FUNCTION
2627c I F_DDL,L_DDL,ITASK - dim. of V(F_DDL:L_DDL), of Itask (Thread id)
2628c IO V(*) - V(*) scaled for output
2629C-----------------------------------------------
2630C L o c a l V a r i a b l e s
2631C-----------------------------------------------
2632 INTEGER I
2633C-----------------------------
2634 DO i= f_ddl,l_ddl
2635 v(i) = s*v(i)
2636 END DO
2637C--------------------------------------------
2638 RETURN

◆ vscal_hp()

subroutine vscal_hp ( integer n,
v,
s )

Definition at line 3493 of file produt_v.F.

3494C-----------------------------------------------
3495C I m p l i c i t T y p e s
3496C-----------------------------------------------
3497#include "implicit_f.inc"
3498C-----------------------------------------------
3499C D u m m y A r g u m e n t s
3500C-----------------------------------------------
3501 INTEGER N
3502C REAL
3503 my_real
3504 . s, v(*)
3505C-----------------------------------------------
3506c PURPOSE: V(*) <- S*V(*)
3507c
3508c Note:
3509c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
3510c
3511c TYPE NAME FUNCTION
3512c I N - dim. of V()
3513c IO V(*) - V(*) scaled for output
3514C-----------------------------------------------
3515C L o c a l V a r i a b l e s
3516C-----------------------------------------------
3517 INTEGER I,ITSK,NFT,NLT
3518C-----------------------------
3519!$OMP PARALLEL PRIVATE(ITSK,NFT,NLT,I)
3520 CALL imp_smpini(itsk ,nft ,nlt ,n )
3521 DO i = nft ,nlt
3522 v(i) = s*v(i)
3523 END DO !I=NFT ,NLT
3524!$OMP END PARALLEL
3525C--------------------------------------------
3526 RETURN

◆ vscaly_hp()

subroutine vscaly_hp ( integer n,
v,
y,
s )

Definition at line 3535 of file produt_v.F.

3536C-----------------------------------------------
3537C I m p l i c i t T y p e s
3538C-----------------------------------------------
3539#include "implicit_f.inc"
3540C-----------------------------------------------
3541C D u m m y A r g u m e n t s
3542C-----------------------------------------------
3543 INTEGER N
3544C REAL
3545 my_real
3546 . s, v(*),y(*)
3547C-----------------------------------------------
3548c PURPOSE: V(*) <- S*Y(*)
3549c
3550c Note:
3551c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
3552c
3553c TYPE NAME FUNCTION
3554c I N - dim. of V()
3555c I Y(*) - Y(*)
3556c O V(*) - V(*) scaled for output
3557C-----------------------------------------------
3558C L o c a l V a r i a b l e s
3559C-----------------------------------------------
3560 INTEGER I,ITSK,NFT,NLT
3561C-----------------------------
3562!$OMP PARALLEL PRIVATE(ITSK,NFT,NLT,I)
3563 CALL imp_smpini(itsk ,nft ,nlt ,n )
3564 DO i = nft ,nlt
3565 v(i) = s*y(i)
3566 END DO !I=NFT ,NLT
3567!$OMP END PARALLEL
3568C--------------------------------------------
3569 RETURN

◆ zero_ud()

subroutine zero_ud ( integer num,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
integer, dimension(*) ikc,
d,
dr,
integer ir )

Definition at line 292 of file produt_v.F.

293C-----------------------------------------------
294C I m p l i c i t T y p e s
295C-----------------------------------------------
296#include "implicit_f.inc"
297C-----------------------------------------------
298C D u m m y A r g u m e n t s
299C-----------------------------------------------
300 INTEGER NUM,IDDL(*),IKC(*) ,NDOF(*) ,IR
301C REAL
302 my_real
303 . d(3,*), dr(3,*)
304C-----------------------------------------------
305C L o c a l V a r i a b l e s
306C-----------------------------------------------
307 INTEGER I,J,ID
308C-----------------------------
309 DO i=1,num
310 DO j=1,3
311 id = iddl(i)+j
312 IF (ikc(id)==2) d(j,i)=zero
313 ENDDO
314 ENDDO
315 IF (ir/=0) THEN
316 DO i=1,num
317 IF (ndof(i)>3) THEN
318 DO j=1,3
319 id = iddl(i)+j+3
320 IF (ikc(id)==2) dr(j,i)=zero
321 ENDDO
322 ENDIF
323 ENDDO
324 ENDIF
325C--------------------------------------------
326 RETURN
id
initmumps id
Definition multiplerhs_example.m:4

◆ zeror_hp()

subroutine zeror_hp ( x,
integer n )

Definition at line 3687 of file produt_v.F.

3688C-----------------------------------------------
3689C I m p l i c i t T y p e s
3690C-----------------------------------------------
3691#include "implicit_f.inc"
3692C-----------------------------------------------
3693C D u m m y A r g u m e n t s
3694C-----------------------------------------------
3695 INTEGER N
3696C REAL
3697 my_real
3698 . x(*)
3699C-----------------------------------------------
3700C L o c a l V a r i a b l e s
3701C-----------------------------------------------
3702 INTEGER I,ITSK,NFT,NLT,N3
3703C-----------------------------
3704 n3=3*n
3705!$OMP PARALLEL PRIVATE(ITSK,NFT,NLT,I)
3706 CALL imp_smpini(itsk ,nft ,nlt ,n3 )
3707 DO i = nft ,nlt
3708 x(i) = zero
3709 ENDDO
3710!$OMP END PARALLEL
3711C--------------------------------------------
3712 RETURN