OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_sph.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "task_c.inc"
#include "sphcom.inc"
#include "com08_c.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_exch_a_sol2sph (a6, itag, iad_elem, fr_elem, size, lenr)
subroutine spmd_sphgetdk (tab_dk, act, req_recv)
subroutine spmd_sphgetisph ()
subroutine spmd_sphgetx (kxsp, spbuf, x, ipartsp)
subroutine spmd_sphgetw (spbuf, wacomp, wa, war, sph_iord1)
subroutine spmd_sphgetstb (stab, stabr)
subroutine spmd_sphgeta (kxsp, spbuf, a, asphr)
subroutine spmd_sphgetf (kxsp, spbuf, a, ms, asphr)
subroutine spmd_sphgeth (kxsp, spbuf)
subroutine spmd_all_dmax (v, len)
subroutine spmd_sphgett (wt, wtr, lambda, lambdr)
subroutine spmd_sphgetg (wgradt, wacomp, wgr, sph_iord1)
subroutine spmd_sphgetwa (wa, war2, kxsp)
subroutine spmd_sphgetvois_off (off_sph, tag_sph, kxsp, ixsp)
subroutine spmd_sphgetimp (kxsp)
subroutine spmd_sphgetd (kxsp, ixsp, isphio, x, waspact, nod2sp, spbuf, v, a, asphr, dsphr)
subroutine spmd_sphvox0 (kxsp, spbuf, wsp2sort, bminmal, x, nsp2sortf, nsp2sortl)

Function/Subroutine Documentation

◆ spmd_all_dmax()

subroutine spmd_all_dmax ( v,
integer len )

Definition at line 1145 of file spmd_sph.F.

1146C max tableau V de taille LEN de type my_real
1147 USE spmd_mod
1148C-----------------------------------------------
1149C I m p l i c i t T y p e s
1150C-----------------------------------------------
1151#include "implicit_f.inc"
1152C-----------------------------------------------------------------
1153C M e s s a g e P a s s i n g
1154C-----------------------------------------------
1155#include "spmd.inc"
1156C-----------------------------------------------
1157C C o m m o n B l o c k s
1158C-----------------------------------------------
1159#include "task_c.inc"
1160C-----------------------------------------------
1161C D u m m y A r g u m e n t s
1162C-----------------------------------------------
1163 INTEGER LEN
1164 my_real
1165 . v(len)
1166C-----------------------------------------------
1167C L o c a l V a r i a b l e s
1168C-----------------------------------------------
1169#ifdef MPI
1170 INTEGER I, IERROR
1171 my_real
1172 . vtmp(len)
1173C-----------------------------------------------
1174C S o u r c e L i n e s
1175C-----------------------------------------------
1176 IF (len > 0) THEN
1177 CALL spmd_allreduce(v,vtmp,len,spmd_max)
1178 DO i = 1, len
1179 v(i) = vtmp(i)
1180 END DO
1181 ENDIF
1182C
1183#endif
1184 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ spmd_exch_a_sol2sph()

subroutine spmd_exch_a_sol2sph ( double precision, dimension(6,3,*) a6,
integer, dimension(*) itag,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer size,
integer lenr )

Definition at line 32 of file spmd_sph.F.

35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE spmd_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------------------------
44C M e s s a g e P a s s i n g
45C-----------------------------------------------
46#include "spmd.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "task_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER ITAG(*), IAD_ELEM(2,*),FR_ELEM(*), SIZE, LENR
56 DOUBLE PRECISION A6(6,3,*)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60#ifdef MPI
61 INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR,MSGOFF,
62 . SIZ,J,K,L,NB_NOD,
63 . STATUS(MPI_STATUS_SIZE),
64 . IAD_SEND(NSPMD+1),IAD_RECV(NSPMD+1),
65 . REQ_R(NSPMD),REQ_S(NSPMD)
66 DATA msgoff/2000/
67
68 double precision
69 . rbuf(size*lenr ),
70 . sbuf(size*lenr )
71C-----------------------------------------------
72C S o u r c e L i n e s
73C-----------------------------------------------
74C SIZE=19
75C
76 loc_proc = ispmd + 1
77 l = 1
78 iad_recv(1) = 1
79 DO i=1,nspmd
80 siz = size*(iad_elem(1,i+1)-iad_elem(1,i))
81 IF(siz/=0)THEN
82 msgtyp = msgoff
83 CALL spmd_irecv(
84 s rbuf(l),siz,it_spmd(i),msgtyp,
85 g req_r(i))
86 l = l + siz
87 ENDIF
88 iad_recv(i+1) = l
89 END DO
90 l = 1
91 iad_send(1) = 1
92 DO i=1,nspmd
93C preparation envoi partie fixe (elem) a proc I
94#include "vectorize.inc"
95 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
96 nod = fr_elem(j)
97 IF(itag(nod)/=0)THEN
98 sbuf(l ) = j-iad_elem(1,i)+1
99 sbuf(l+1) = a6(1,1,nod)
100 sbuf(l+2) = a6(1,2,nod)
101 sbuf(l+3) = a6(1,3,nod)
102 sbuf(l+4) = a6(2,1,nod)
103 sbuf(l+5) = a6(2,2,nod)
104 sbuf(l+6) = a6(2,3,nod)
105 sbuf(l+7) = a6(3,1,nod)
106 sbuf(l+8) = a6(3,2,nod)
107 sbuf(l+9) = a6(3,3,nod)
108 sbuf(l+10) = a6(4,1,nod)
109 sbuf(l+11) = a6(4,2,nod)
110 sbuf(l+12) = a6(4,3,nod)
111 sbuf(l+13) = a6(5,1,nod)
112 sbuf(l+14) = a6(5,2,nod)
113 sbuf(l+15) = a6(5,3,nod)
114 sbuf(l+16) = a6(6,1,nod)
115 sbuf(l+17) = a6(6,2,nod)
116 sbuf(l+18) = a6(6,3,nod)
117 l = l + SIZE
118 END IF
119 END DO
120 iad_send(i+1) = l
121 ENDDO
122C
123C echange messages
124C
125 DO i=1,nspmd
126C--------------------------------------------------------------------
127C envoi a N+I mod P
128C test si msg necessaire a envoyer a completer par test interface
129 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
130 msgtyp = msgoff
131 siz = iad_send(i+1)-iad_send(i)
132 l = iad_send(i)
133 CALL spmd_isend(
134 s sbuf(l),siz,it_spmd(i),msgtyp,
135 g req_s(i))
136 ENDIF
137C--------------------------------------------------------------------
138 ENDDO
139C
140C decompactage
141C
142 DO i = 1, nspmd
143C test si msg necessaire a envoyer a completer par test interface
144 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
145 IF(nb_nod>0)THEN
146 CALL spmd_wait(req_r(i),status)
147 l = iad_recv(i)
148 CALL mpi_get_count(status,mpi_double_precision,siz,ierror)
149 siz = siz/SIZE
150#include "vectorize.inc"
151C DO J=IAD_ELEM(1,I),IAD_ELEM(1,I+1)-1
152 DO k=1,siz
153 j = nint(rbuf(l)) + iad_elem(1,i)-1
154 nod = fr_elem(j)
155
156 itag(nod)=1
157 a6(1,1,nod)=a6(1,1,nod)+ rbuf(l+1)
158 a6(1,2,nod)=a6(1,2,nod)+ rbuf(l+2)
159 a6(1,3,nod)=a6(1,3,nod)+ rbuf(l+3)
160 a6(2,1,nod)=a6(2,1,nod)+ rbuf(l+4)
161 a6(2,2,nod)=a6(2,2,nod)+ rbuf(l+5)
162 a6(2,3,nod)=a6(2,3,nod)+ rbuf(l+6)
163 a6(3,1,nod)=a6(3,1,nod)+ rbuf(l+7)
164 a6(3,2,nod)=a6(3,2,nod)+ rbuf(l+8)
165 a6(3,3,nod)=a6(3,3,nod)+ rbuf(l+9)
166 a6(4,1,nod)=a6(4,1,nod)+ rbuf(l+10)
167 a6(4,2,nod)=a6(4,2,nod)+ rbuf(l+11)
168 a6(4,3,nod)=a6(4,3,nod)+ rbuf(l+12)
169 a6(5,1,nod)=a6(5,1,nod)+ rbuf(l+13)
170 a6(5,2,nod)=a6(5,2,nod)+ rbuf(l+14)
171 a6(5,3,nod)=a6(5,3,nod)+ rbuf(l+15)
172 a6(6,1,nod)=a6(6,1,nod)+ rbuf(l+16)
173 a6(6,2,nod)=a6(6,2,nod)+ rbuf(l+17)
174 a6(6,3,nod)=a6(6,3,nod)+ rbuf(l+18)
175
176 l = l + SIZE
177 END DO
178 END IF
179 END DO
180C
181C wait terminaison isend
182C
183 DO i = 1, nspmd
184 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
185 CALL spmd_wait(req_s(i))
186 ENDIF
187 ENDDO
188C
189#endif
190 RETURN
mpi_get_count
subroutine mpi_get_count(status, datatype, cnt, ierr)
Definition mpi.f:296

◆ spmd_sphgeta()

subroutine spmd_sphgeta ( integer, dimension(nisp,*) kxsp,
spbuf,
a,
asphr )

Definition at line 821 of file spmd_sph.F.

822C-----------------------------------------------
823C M o d u l e s
824C-----------------------------------------------
825 USE sphbox
826 USE spmd_mod
827C-----------------------------------------------
828C I m p l i c i t T y p e s
829C-----------------------------------------------
830#include "implicit_f.inc"
831C-----------------------------------------------
832C M e s s a g e P a s s i n g
833C-----------------------------------------------
834#include "spmd.inc"
835C-----------------------------------------------
836C C o m m o n B l o c k s
837C-----------------------------------------------
838#include "com01_c.inc"
839#include "task_c.inc"
840#include "sphcom.inc"
841C-----------------------------------------------
842C D u m m y A r g u m e n t s
843C-----------------------------------------------
844 INTEGER KXSP(NISP,*)
845 my_real
846 . spbuf(nspbuf,*), a(3,*), asphr(3,*)
847C-----------------------------------------------
848C L o c a l V a r i a b l e s
849C-----------------------------------------------
850#ifdef MPI
851 INTEGER P, I, NN, N, IDEB, MSGTYP, LOC_PROC,
852 . IERROR, ICELL, INOD,MSGOFF,
853 . REQ_SD(NSPMD)
854 my_real
855 . bufs(4,nsphs), bufr(4,nsphr)
856 DATA msgoff/2012/
857C-----------------------------------------------
858C S o u r c e L i n e s
859C-----------------------------------------------
860 loc_proc = ispmd+1
861C
862C Envoi A, H sur cellules actives
863C
864 ideb = 0
865 DO p = 1, nspmd
866ctmp+1
867 IF(psphs(p)/=0)THEN
868 nn = 0
869 DO n = 1, psphs(p)
870 IF(isphs(ideb+n)==1) THEN
871 nn = nn + 1
872 icell = lsphs(ideb+n)
873 inod = kxsp(3,icell)
874 bufs(1,nn+ideb) = spbuf(1,icell)
875 bufs(2,nn+ideb) = a(1,inod)
876 bufs(3,nn+ideb) = a(2,inod)
877 bufs(4,nn+ideb) = a(3,inod)
878 END IF
879 END DO
880 msgtyp = msgoff
881 CALL spmd_isend(
882 s bufs(1,ideb+1),nn*4,it_spmd(p),msgtyp,
883 g req_sd(p))
884 ideb = ideb + psphs(p)
885ctmp+1
886 END IF
887 END DO
888C
889C Reception A, H
890C
891 ideb = 0
892 DO p = 1, nspmd
893 IF(psphr(p)/=0)THEN
894 msgtyp = msgoff
895 CALL spmd_recv(bufr,4*psphr(p),it_spmd(p),
896 . msgtyp)
897 nn = 0
898 DO n = 1, psphr(p)
899 IF(isphr(ideb+n)==1) THEN
900 nn = nn + 1
901 xsphr(2,ideb+n) = bufr(1,nn)
902 asphr(1,ideb+n) = bufr(2,nn)
903 asphr(2,ideb+n) = bufr(3,nn)
904 asphr(3,ideb+n) = bufr(4,nn)
905 END IF
906 END DO
907 ideb = ideb + psphr(p)
908 END IF
909 END DO
910C
911C Wait terminaison
912C
913 DO p = 1, nspmd
914ctmp+1 IF(PSPHR(P)/=0)THEN
915 IF(psphs(p)/=0)THEN
916 CALL spmd_wait(req_sd(p))
917 END IF
918 END DO
919C
920#endif
921 RETURN
sphbox::isphs
integer, dimension(:), allocatable isphs
Definition sphbox.F:87
sphbox::lsphs
integer, dimension(:), allocatable lsphs
Definition sphbox.F:91
sphbox::isphr
integer, dimension(:), allocatable isphr
Definition sphbox.F:87
sphbox::psphr
integer, dimension(:), allocatable psphr
Definition sphbox.F:89
sphbox::psphs
integer, dimension(:), allocatable psphs
Definition sphbox.F:89
sphbox::nsphr
integer nsphr
Definition sphbox.F:83
sphbox::nsphs
integer nsphs
Definition sphbox.F:83

◆ spmd_sphgetd()

subroutine spmd_sphgetd ( integer, dimension(nisp,*) kxsp,
integer, dimension(kvoisph,*) ixsp,
integer, dimension(nisphio,*) isphio,
x,
integer, dimension(*) waspact,
integer, dimension(*) nod2sp,
spbuf,
v,
a,
asphr,
dsphr )

Definition at line 1927 of file spmd_sph.F.

1929C-----------------------------------------------
1930C M o d u l e s
1931C-----------------------------------------------
1932 USE sphbox
1933 USE spmd_mod
1934C-----------------------------------------------
1935C I m p l i c i t T y p e s
1936C-----------------------------------------------
1937#include "implicit_f.inc"
1938C-----------------------------------------------
1939C M e s s a g e P a s s i n g
1940C-----------------------------------------------
1941#include "spmd.inc"
1942C-----------------------------------------------
1943C C o m m o n B l o c k s
1944C-----------------------------------------------
1945#include "com01_c.inc"
1946#include "com08_c.inc"
1947#include "task_c.inc"
1948#include "sphcom.inc"
1949C-----------------------------------------------
1950C D u m m y A r g u m e n t s
1951C-----------------------------------------------
1952 INTEGER
1953 . KXSP(NISP,*),
1954 . ISPHIO(NISPHIO,*),
1955 . IXSP(KVOISPH,*),NOD2SP(*),
1956 . WASPACT(*)
1957 my_real
1958 . x(3,*),spbuf(nspbuf,*),v(3,*) ,a(3,*),
1959 . asphr(3,*),dsphr(12,*)
1960C-----------------------------------------------
1961C L o c a l V a r i a b l e s
1962C-----------------------------------------------
1963#ifdef MPI
1964 INTEGER P, I, NN, N, IDEB, MSGTYP, LOC_PROC,
1965 . IERROR, ICELL, INOD,
1966 . REQ_SD(NSPMD), REQ_SD2(NSPMD),
1967 . REQ_SD3(NSPMD)
1968
1969 INTEGER,
1970 . DIMENSION(:,:), ALLOCATABLE :: TMP_IPPV
1971 INTEGER,
1972 . DIMENSION(:), ALLOCATABLE :: CPT_TMP,
1973 . MYPSPHS,MYPSPHS2,MYPSPHR,
1974 . REC_IPPV,SEND_IPPV,SEND_IPPV2
1975
1976 INTEGER
1977 . II,IPT,JJ,NPF,IFVITS,
1978 . NS,IACTIVE,
1979 . IPPV,J,M,JNOD,IMPOSE,JMPOSE,
1980 . NVOIS,IJ,NP,K,JMPOSE2,IPPVR,INDICE
1981 . IDEB2, C, INDICE, IDEB2,N1, SIZ,INDICE1,
1982 . NBIS,MSGOFF,MSGOFF2,MSGOFF3
1983
1984 my_real
1985 . bufs(12,nsphs), bufr(12,nsphr)
1986 my_real
1987 . vx,vy,vz,vn,vt,ux,uy,uz,un1,nx,ny,nz,
1988 . ps,
1989 . xi,yi,zi,xj,yj,zj,dmin,dd,
1990 . di,rhoi,dj,rhoj,dij,
1991 . vxi,vyi,vzi,vxj,vyj,vzj,
1992 . vj,vjx,vjy,vjz,
1993 . wght,wgrad(3),wgrdx,wgrdy,wgrdz,
1994 . dxx,dxy,dxz,dyx,dyy,dyz,dzx,dzy,dzz,
1995 . exx,exy,exz,eyx,eyy,eyz,ezx,ezy,ezz,
1996 . alphai,alphaxi,alphayi,alphazi,alphai2,xp,yp,zp
1997 LOGICAL :: CONDITION
1998 DATA msgoff /2020/
1999 DATA msgoff2/2021/
2000 DATA msgoff3/2022/
2001C-----------------------------------------------
2002C S o u r c e L i n e s
2003C-----------------------------------------------
2004c get DX* and V* values, store in DSPHR
2005c use in sponfv
2006
2007 ALLOCATE(tmp_ippv(3,nsphr),cpt_tmp(nspmd))
2008 ALLOCATE(mypsphs(nspmd+1),mypsphs2(nspmd+1),mypsphr(nspmd+1))
2009 ALLOCATE(send_ippv(nsphr),send_ippv2(nsphr),rec_ippv(nsphs))
2010
2011 tmp_ippv(1:3,1:nsphr) = 0
2012 mypsphs(1:nspmd+1)=0
2013 mypsphs2(1:nspmd+1)=0
2014 mypsphr(1:nspmd+1)=0
2015 cpt_tmp(1:nspmd)=0
2016 send_ippv(1:nsphr)=0
2017 send_ippv2(1:nsphr)=0
2018 rec_ippv(1:nsphs)=0
2019
2020 loc_proc = ispmd+1
2021
2022c construction liste IPPV remotes
2023 ippvr=0
2024 DO ns=1,nsphact
2025 n=waspact(ns)
2026 impose=kxsp(2,n)/(ngroup+1)
2027 IF(impose/=0) THEN
2028 IF ( isphio(1,impose)==2.OR.isphio(1,impose)==3 )THEN
2029 inod=kxsp(3,n)
2030 xi=x(1,inod)
2031 yi=x(2,inod)
2032 zi=x(3,inod)
2033C-------
2034C plus proche voisin en amont de l'outlet => IPPV.
2035 ippv=0
2036 dmin=1.e+20
2037 DO k=1,kxsp(4,n)
2038 jnod=ixsp(k,n)
2039
2040 IF(jnod>0)THEN
2041 m =nod2sp(jnod)
2042 jmpose=kxsp(2,m)/(ngroup+1)
2043 condition = .false.
2044 condition = jmpose==0
2045 IF(jmpose/=0) condition = isphio(1,jmpose)==1
2046 IF(condition)THEN
2047 xj =x(1,jnod)
2048 yj =x(2,jnod)
2049 zj =x(3,jnod)
2050 dd =(xi-xj)*(xi-xj)+(yi-yj)*(yi-yj)+(zi-zj)*(zi-zj)
2051 IF(dd<dmin)THEN
2052 ippv=jnod
2053 dmin=dd
2054 ENDIF
2055 ENDIF
2056 ELSE
2057 nn = -jnod
2058 jmpose = nint(xsphr(12,nn))
2059 IF(jmpose>0)THEN
2060 jmpose2=isphio(1,jmpose)
2061 ELSE
2062 jmpose2=0
2063 ENDIF
2064 IF(jmpose2==0.OR.jmpose2==1)THEN
2065 xj =xsphr(3,nn)
2066 yj =xsphr(4,nn)
2067 zj =xsphr(5,nn)
2068 dd =(xi-xj)*(xi-xj)+(yi-yj)*(yi-yj)+(zi-zj)*(zi-zj)
2069 IF(dd<dmin)THEN
2070 ippv=jnod
2071 dmin=dd
2072 ENDIF
2073 ENDIF
2074 ENDIF
2075 ENDDO !enddo boucle voisin
2076
2077 IF(ippv<0)THEN
2078 !Indice IPPV negatif (global)
2079 ippvr=ippvr+1
2080 tmp_ippv(1,ippvr) = -ippv
2081 ! recherche sur quel proc il est
2082 nbis = 0
2083 DO p=1,nspmd
2084 IF(p/=loc_proc) THEN
2085 n1 = nbis
2086 nbis = nbis+psphr(p)
2087 IF((-ippv)<=nbis)THEN
2088 tmp_ippv(2,ippvr)=p !proc sur lequel il se situe
2089 tmp_ippv(3,ippvr)=(-ippv)-n1 !Indice IPPV (local)
2090 mypsphs(p)=mypsphs(p)+1
2091 GOTO 160
2092 ELSEIF(p==nspmd)THEN
2093 tmp_ippv(2,ippvr)=p !proc sur lequel il se situe
2094 tmp_ippv(3,ippvr)=(-ippv)-n1 !Indice IPPV (local)
2095 mypsphs(p)=mypsphs(p)+1
2096 ENDIF
2097 ENDIF
2098 ENDDO ! ENDDO P=1,NSPMD
2099 160 CONTINUE
2100 ENDIF
2101 ENDIF
2102 ENDIF
2103 ENDDO !ENDDO NS=1,NSPHACT
2104
2105 mypsphs2(1)=1
2106 DO p=1,nspmd
2107 mypsphs2(p+1)=mypsphs2(p)+mypsphs(p)
2108 ENDDO
2109
2110 DO i=1,ippvr
2111 p=tmp_ippv(2,i)
2112 IF(p/=loc_proc)THEN
2113 cpt_tmp(p)=cpt_tmp(p)+1
2114 indice=mypsphs2(p)+cpt_tmp(p)-1
2115 send_ippv(indice)= tmp_ippv(3,i)
2116 send_ippv2(indice)=tmp_ippv(1,i)
2117 ENDIF
2118 ENDDO
2119
2120C
2121C Envoi liste IPPV < 0
2122C
2123c IF(IPPVR>0)THEN
2124 DO p = 1, nspmd
2125 IF(psphr(p)/=0)THEN
2126 msgtyp = msgoff
2127 CALL spmd_isend(
2128 s mypsphs(p),1,it_spmd(p),msgtyp,
2129 g req_sd(p))
2130 END IF
2131 END DO
2132C
2133C Reception flag cellules off
2134C
2135 DO p = 1, nspmd
2136 IF(psphs(p)/=0)THEN
2137 msgtyp = msgoff
2138 CALL spmd_recv(mypsphr(p),1,it_spmd(p),
2139 . msgtyp)
2140 END IF
2141 END DO
2142
2143 DO p = 1, nspmd
2144 IF(mypsphs(p)/=0)THEN
2145 msgtyp = msgoff2
2146 ideb = mypsphs2(p)
2147 CALL spmd_isend(
2148 s send_ippv(ideb),mypsphs(p),
2149 . it_spmd(p),msgtyp,req_sd2(p))
2150 END IF
2151 END DO
2152C Reception flag cellules off
2153C
2154 ideb = 1
2155 DO p = 1, nspmd
2156 IF(mypsphr(p)/=0)THEN
2157 msgtyp = msgoff2
2158 CALL spmd_recv(
2159 . rec_ippv(ideb),mypsphr(p),
2160 . it_spmd(p),msgtyp)
2161 ideb = ideb + mypsphr(p)
2162 END IF
2163 END DO
2164
2165C Wait terminaison
2166C
2167 DO p = 1, nspmd
2168 IF(psphr(p)/=0)THEN
2169 CALL spmd_wait(req_sd(p))
2170 END IF
2171 IF(mypsphs(p)/=0)THEN
2172 CALL spmd_wait(req_sd2(p))
2173 END IF
2174 END DO
2175C
2176C Envoi sur cellules
2177C
2178 ideb = 0
2179 ideb2 = 0
2180
2181 DO p = 1, nspmd
2182c traitement
2183 IF(mypsphr(p)/=0)THEN
2184 DO n = 1, mypsphr(p)
2185 c = rec_ippv(ideb2+n)
2186 icell = lsphs(c+ideb)
2187 inod = kxsp(3,icell)
2188 np=icell
2189 xp=x(1,inod)
2190 yp=x(2,inod)
2191 zp=x(3,inod)
2192 di =spbuf(1,np)
2193 rhoi=spbuf(2,np)
2194 CALL weight0(xp,yp,zp,xp,yp,zp,di,wght)
2195 vj=spbuf(12,np)/max(em20,rhoi)
2196 alphai=vj*wght
2197 alphaxi=zero
2198 alphayi=zero
2199 alphazi=zero
2200
2201 DO j=1,kxsp(4,np)
2202 jnod=ixsp(j,np)
2203 IF(jnod>0)THEN ! particule locale
2204 m=nod2sp(jnod)
2205 jmpose=kxsp(2,m)/(ngroup+1)
2206 condition = .false.
2207 condition = jmpose==0
2208 IF(jmpose/=0) condition = isphio(1,jmpose)==1
2209 IF(condition)THEN
2210 dj =spbuf(1,m)
2211 xj =x(1,jnod)
2212 yj =x(2,jnod)
2213 zj =x(3,jnod)
2214 dij =(dj+di)*half
2215 rhoj=spbuf(2,m)
2216 CALL weight1(xp,yp,zp,xj,yj,zj,dij,wght,wgrad)
2217 vj=spbuf(12,m)/max(em20,rhoj)
2218 alphai =alphai +vj*wght
2219 alphaxi=alphaxi+vj*wgrad(1)
2220 alphayi=alphayi+vj*wgrad(2)
2221 alphazi=alphazi+vj*wgrad(3)
2222 ENDIF
2223 ELSE ! particule remote
2224 nn = -jnod
2225 jmpose = nint(xsphr(12,nn))
2226 IF(jmpose>0)THEN
2227 jmpose2=isphio(1,jmpose)
2228 ELSE
2229 jmpose2=0
2230 ENDIF
2231 IF(jmpose2==0.OR.jmpose2==1)THEN
2232 dj =xsphr(2,nn)
2233 xj =xsphr(3,nn)
2234 yj =xsphr(4,nn)
2235 zj =xsphr(5,nn)
2236 dij =(dj+di)*half
2237 rhoj=xsphr(7,nn)
2238 CALL weight1(xp,yp,zp,xj,yj,zj,dij,wght,wgrad)
2239 vj=xsphr(8,nn)/max(em20,rhoj)
2240 alphai =alphai +vj*wght
2241 alphaxi=alphaxi+vj*wgrad(1)
2242 alphayi=alphayi+vj*wgrad(2)
2243 alphazi=alphazi+vj*wgrad(3)
2244 ENDIF
2245 ENDIF
2246 ENDDO ! J=1,KXSP(4,NP)
2247C------
2248 alphai =one/max(em20,alphai)
2249 alphai2=alphai*alphai
2250 alphaxi=-alphaxi*alphai2
2251 alphayi=-alphayi*alphai2
2252 alphazi=-alphazi*alphai2
2253C------
2254 vx =v(1,inod)+dt12*a(1,inod)
2255 vy =v(2,inod)+dt12*a(2,inod)
2256 vz =v(3,inod)+dt12*a(3,inod)
2257
2258 dxx=zero
2259 dxy=zero
2260 dxz=zero
2261 dyx=zero
2262 dyy=zero
2263 dyz=zero
2264 dzx=zero
2265 dzy=zero
2266 dzz=zero
2267
2268 DO j=1,kxsp(4,np)
2269 jnod=ixsp(j,np)
2270 IF(jnod>0)THEN
2271 m=nod2sp(jnod)
2272 jmpose=kxsp(2,m)/(ngroup+1)
2273 condition = .false.
2274 condition = jmpose==0
2275 IF(jmpose/=0) condition = isphio(1,jmpose)==1
2276 IF(condition)THEN
2277 dj =spbuf(1,m)
2278 xj =x(1,jnod)
2279 yj =x(2,jnod)
2280 zj =x(3,jnod)
2281 dij =(dj+di)*half
2282 rhoj=spbuf(2,m)
2283 CALL weight1(xp,yp,zp,xj,yj,zj,dij,wght,wgrad)
2284 wgrdx=wgrad(1)*alphai+wght*alphaxi
2285 wgrdy=wgrad(2)*alphai+wght*alphayi
2286 wgrdz=wgrad(3)*alphai+wght*alphazi
2287 vj=spbuf(12,m)/max(em20,rhoj)
2288 vxj =v(1,jnod)+dt12*a(1,jnod)
2289 vyj =v(2,jnod)+dt12*a(2,jnod)
2290 vzj =v(3,jnod)+dt12*a(3,jnod)
2291 vjx=vj*(vxj-vx)
2292 vjy=vj*(vyj-vy)
2293 vjz=vj*(vzj-vz)
2294 dxx=dxx+vjx*wgrdx
2295 dxy=dxy+vjx*wgrdy
2296 dxz=dxz+vjx*wgrdz
2297 dyx=dyx+vjy*wgrdx
2298 dyy=dyy+vjy*wgrdy
2299 dyz=dyz+vjy*wgrdz
2300 dzx=dzx+vjz*wgrdx
2301 dzy=dzy+vjz*wgrdy
2302 dzz=dzz+vjz*wgrdz
2303 ENDIF
2304 ELSE
2305 nn=-jnod
2306 jmpose = nint(xsphr(12,nn))
2307 IF(jmpose>0)THEN
2308 jmpose2=isphio(1,jmpose)
2309 ELSE
2310 jmpose2=0
2311 ENDIF
2312 IF(jmpose2==0.OR.jmpose2==1)THEN
2313 dj =xsphr(2,nn)
2314 xj =xsphr(3,nn)
2315 yj =xsphr(4,nn)
2316 zj =xsphr(5,nn)
2317 dij =(dj+di)*half
2318 rhoj=xsphr(7,nn)
2319 CALL weight1(xp,yp,zp,xj,yj,zj,dij,wght,wgrad)
2320 wgrdx=wgrad(1)*alphai+wght*alphaxi
2321 wgrdy=wgrad(2)*alphai+wght*alphayi
2322 wgrdz=wgrad(3)*alphai+wght*alphazi
2323 vj=xsphr(8,nn)/max(em20,rhoj)
2324 vxj =xsphr(9,nn)+dt12*asphr(1,nn)
2325 vyj =xsphr(10,nn)+dt12*asphr(2,nn)
2326 vzj =xsphr(11,nn)+dt12*asphr(3,nn)
2327 vjx=vj*(vxj-vx)
2328 vjy=vj*(vyj-vy)
2329 vjz=vj*(vzj-vz)
2330 dxx=dxx+vjx*wgrdx
2331 dxy=dxy+vjx*wgrdy
2332 dxz=dxz+vjx*wgrdz
2333 dyx=dyx+vjy*wgrdx
2334 dyy=dyy+vjy*wgrdy
2335 dyz=dyz+vjy*wgrdz
2336 dzx=dzx+vjz*wgrdx
2337 dzy=dzy+vjz*wgrdy
2338 dzz=dzz+vjz*wgrdz
2339 ENDIF
2340 ENDIF
2341 ENDDO ! ENDDO J=1,KXSP(4,NP)
2342 bufs(1,n+ideb2) = dxx
2343 bufs(2,n+ideb2) = dxy
2344 bufs(3,n+ideb2) = dxz
2345 bufs(4,n+ideb2) = dyx
2346 bufs(5,n+ideb2) = dyy
2347 bufs(6,n+ideb2) = dyz
2348 bufs(7,n+ideb2) = dzx
2349 bufs(8,n+ideb2) = dzy
2350 bufs(9,n+ideb2) = dzz
2351 bufs(10,n+ideb2) = vx
2352 bufs(11,n+ideb2) = vy
2353 bufs(12,n+ideb2) = vz
2354 END DO !ENDDO N = 1, MYPSPHR(P)
2355
2356c envoi
2357 msgtyp = msgoff3
2358 siz = mypsphr(p)*12
2359 CALL spmd_isend(
2360 s bufs(1,ideb2+1),siz,it_spmd(p),msgtyp,
2361 g req_sd3(p))
2362 ideb2= ideb2+mypsphr(p)
2363 ENDIF
2364 ideb = ideb + psphs(p)
2365 END DO !ENDDO P = 1, NSPMD
2366C
2367C Reception
2368C
2369 ideb = 0
2370
2371 DO p = 1, nspmd
2372 IF(mypsphs(p)/=0)THEN
2373 msgtyp = msgoff3
2374 siz = 12*mypsphs(p)
2375 CALL spmd_recv(bufr,siz,it_spmd(p),
2376 . msgtyp)
2377 DO n = 1, mypsphs(p)
2378 indice1 = send_ippv2(ideb+n)
2379 dsphr(1,indice1) = bufr(1,n)
2380 dsphr(2,indice1) = bufr(2,n)
2381 dsphr(3,indice1) = bufr(3,n)
2382 dsphr(4,indice1) = bufr(4,n)
2383 dsphr(5,indice1) = bufr(5,n)
2384 dsphr(6,indice1) = bufr(6,n)
2385 dsphr(7,indice1) = bufr(7,n)
2386 dsphr(8,indice1) = bufr(8,n)
2387 dsphr(9,indice1) = bufr(9,n)
2388 dsphr(10,indice1) = bufr(10,n)
2389 dsphr(11,indice1) = bufr(11,n)
2390 dsphr(12,indice1) = bufr(12,n)
2391 ENDDO
2392 ideb = ideb + mypsphs(p)
2393 END IF
2394 END DO
2395C
2396C Wait terminaison
2397C
2398 DO p = 1, nspmd
2399 IF(mypsphr(p)/=0)THEN
2400 CALL spmd_wait(req_sd3(p))
2401 END IF
2402 END DO
2403C
2404c ENDIF !ENDIF IPPVR > 0
2405
2406 DEALLOCATE(tmp_ippv,mypsphs,mypsphs2,mypsphr)
2407 DEALLOCATE(send_ippv,send_ippv2,rec_ippv,cpt_tmp)
2408
2409#endif
2410 RETURN
max
#define max(a, b)
Definition macros.h:21
weight1
subroutine weight1(xi, yi, zi, xj, yj, zj, h, w, wgrad)
Definition weight.F:79
weight0
subroutine weight0(xi, yi, zi, xj, yj, zj, h, w)
Definition weight.F:34

◆ spmd_sphgetdk()

subroutine spmd_sphgetdk ( tab_dk,
integer act,
integer, dimension(nspmd) req_recv )

Definition at line 204 of file spmd_sph.F.

205C Send the maximum distance of particules kept after a reduction
206C to the remote versions of these particles.
207C ACT = 1 : prepare reeception (IRECV)
208C ACT = 2 : isend and Wait
209C-----------------------------------------------
210C M o d u l e s
211C-----------------------------------------------
212 USE sphbox
213 USE message_mod
214 USE spmd_mod
215C-----------------------------------------------
216C I m p l i c i t T y p e s
217C-----------------------------------------------
218#include "implicit_f.inc"
219C-----------------------------------------------
220C M e s s a g e P a s s i n g
221C-----------------------------------------------
222#include "spmd.inc"
223C-----------------------------------------------
224C C o m m o n B l o c k s
225C-----------------------------------------------
226#include "com01_c.inc"
227#include "task_c.inc"
228C-----------------------------------------------
229C D u m m y A r g u m e n t s
230C-----------------------------------------------
231 INTEGER ACT,REQ_RECV(NSPMD)
232 my_real tab_dk(*)
233C-----------------------------------------------
234C L o c a l V a r i a b l e s
235C-----------------------------------------------
236#ifdef MPI
237 INTEGER MSGTYP, LOC_PROC, P,
238 . IERROR,N,IDEB,
239 . REQ_SD(NSPMD), MSGOFF
240
241 DATA msgoff/2028/
242C-----------------------------------------------
243C S o u r c e L i n e s
244C-----------------------------------------------
245
246 loc_proc = ispmd+1
247
248 IF(nspmd > 1 .AND. act == 1) THEN
249 ideb = 0
250 DO p = 1, nspmd
251 IF(psphr(p)/=0) THEN
252 msgtyp = msgoff
253 CALL spmd_irecv(dkr(ideb+1),psphr(p),it_spmd(p),
254 . msgtyp,req_recv(p))
255 ideb = ideb + psphr(p)
256 END IF
257 ENDDO
258 ELSEIF (nspmd > 1 .AND. act == 2) THEN
259 ideb = 0
260 DO p = 1, nspmd
261 IF(psphs(p)/=0 ) THEN
262 DO n = 1, psphs(p)
263 dks(ideb+n) = tab_dk(lsphs(ideb+n))
264 ENDDO
265 msgtyp = msgoff
266 CALL spmd_isend(
267 . dks(ideb+1),psphs(p),it_spmd(p),msgtyp,
268 . req_sd(p))
269 ideb = ideb + psphs(p)
270 ENDIF
271 ENDDO
272
273 DO p = 1, nspmd
274 IF(psphr(p)/=0) THEN
275 CALL spmd_wait(req_recv(p))
276 END IF
277 ENDDO
278
279 DO p = 1, nspmd
280 IF(psphs(p)/=0) THEN
281 CALL spmd_wait(req_sd(p))
282 END IF
283 ENDDO
284
285 ENDIF
286
287#endif
288 RETURN
message_mod
Definition message_mod.F:1249

◆ spmd_sphgetf()

subroutine spmd_sphgetf ( integer, dimension(nisp,*) kxsp,
spbuf,
a,
ms,
asphr )

Definition at line 934 of file spmd_sph.F.

935C-----------------------------------------------
936C M o d u l e s
937C-----------------------------------------------
938 USE sphbox
939 USE spmd_mod
940C-----------------------------------------------
941C I m p l i c i t T y p e s
942C-----------------------------------------------
943#include "implicit_f.inc"
944C-----------------------------------------------
945C M e s s a g e P a s s i n g
946C-----------------------------------------------
947#include "spmd.inc"
948C-----------------------------------------------
949C C o m m o n B l o c k s
950C-----------------------------------------------
951#include "com01_c.inc"
952#include "task_c.inc"
953#include "sphcom.inc"
954C-----------------------------------------------
955C D u m m y A r g u m e n t s
956C-----------------------------------------------
957 INTEGER KXSP(NISP,*)
958 my_real
959 . spbuf(nspbuf,*), a(3,*), asphr(4,*), ms(*)
960C-----------------------------------------------
961C L o c a l V a r i a b l e s
962C-----------------------------------------------
963#ifdef MPI
964 INTEGER P, I, NN, N, IDEB, MSGTYP, LOC_PROC,
965 . IERROR, ICELL, INOD,
966 . REQ_SD(NSPMD), MSGOFF
967 my_real
968 . bufs(5,nsphs), bufr(5,nsphr)
969 DATA msgoff/2013/
970C-----------------------------------------------
971C S o u r c e L i n e s
972C-----------------------------------------------
973 loc_proc = ispmd+1
974C
975C Envoi A, H sur cellules actives
976C
977 ideb = 0
978 DO p = 1, nspmd
979ctmp+1
980 IF(psphs(p)/=0)THEN
981 nn = 0
982 DO n = 1, psphs(p)
983 IF(isphs(ideb+n)==1) THEN
984 nn = nn + 1
985 icell = lsphs(ideb+n)
986 inod = kxsp(3,icell)
987 bufs(1,nn+ideb) = spbuf(1,icell)
988 bufs(2,nn+ideb) = a(1,inod)
989 bufs(3,nn+ideb) = a(2,inod)
990 bufs(4,nn+ideb) = a(3,inod)
991 bufs(5,nn+ideb) = ms(inod)
992 END IF
993 END DO
994 msgtyp = msgoff
995 CALL spmd_isend(
996 s bufs(1,ideb+1),nn*5,it_spmd(p),msgtyp,
997 g req_sd(p))
998 ideb = ideb + psphs(p)
999ctmp+1
1000 END IF
1001 END DO
1002C
1003C Reception A, H
1004C
1005 ideb = 0
1006 DO p = 1, nspmd
1007 IF(psphr(p)/=0)THEN
1008 msgtyp = msgoff
1009 ! spmd_recv_reals(buf, count, source, tag, comm)
1010
1011 CALL spmd_recv(bufr,5*psphr(p),it_spmd(p), msgtyp)
1012 nn = 0
1013 DO n = 1, psphr(p)
1014 IF(isphr(ideb+n)==1) THEN
1015 nn = nn + 1
1016 xsphr(2,ideb+n) = bufr(1,nn)
1017 asphr(1,ideb+n) = bufr(2,nn)
1018 asphr(2,ideb+n) = bufr(3,nn)
1019 asphr(3,ideb+n) = bufr(4,nn)
1020 asphr(4,ideb+n) = bufr(5,nn)
1021 END IF
1022 END DO
1023 ideb = ideb + psphr(p)
1024 END IF
1025 END DO
1026C
1027C Wait terminaison
1028C
1029 DO p = 1, nspmd
1030ctmp+1 IF(PSPHR(P)/=0)THEN
1031 IF(psphs(p)/=0)THEN
1032 CALL spmd_wait(req_sd(p))
1033 END IF
1034 END DO
1035C
1036#endif
1037 RETURN

◆ spmd_sphgetg()

subroutine spmd_sphgetg ( wgradt,
wacomp,
wgr,
integer, intent(in) sph_iord1 )

Definition at line 1300 of file spmd_sph.F.

1301C-----------------------------------------------
1302C M o d u l e s
1303C-----------------------------------------------
1304 USE sphbox
1305 USE spmd_mod
1306C-----------------------------------------------
1307C I m p l i c i t T y p e s
1308C-----------------------------------------------
1309#include "implicit_f.inc"
1310C-----------------------------------------------
1311C M e s s a g e P a s s i n g
1312C-----------------------------------------------
1313#include "spmd.inc"
1314C-----------------------------------------------
1315C C o m m o n B l o c k s
1316C-----------------------------------------------
1317#include "com01_c.inc"
1318#include "task_c.inc"
1319C-----------------------------------------------
1320C D u m m y A r g u m e n t s
1321C-----------------------------------------------
1322 INTEGER, INTENT(IN) :: SPH_IORD1
1323 my_real
1324 . wgradt(3,*), wacomp(16,*), wgr(3,*)
1325C-----------------------------------------------
1326C L o c a l V a r i a b l e s
1327C-----------------------------------------------
1328#ifdef MPI
1329 INTEGER P, I, NN, N, IDEB, MSGTYP, LOC_PROC,
1330 . IERROR, ICELL,
1331 . REQ_SD(NSPMD), MSGOFF
1332 my_real
1333 . bufs(7+6*sph_iord1,nsphs), bufr(7+6*sph_iord1,nsphr)
1334 DATA msgoff/2016/
1335C-----------------------------------------------
1336C S o u r c e L i n e s
1337C-----------------------------------------------
1338 loc_proc = ispmd+1
1339C
1340C Envoi WACOMP, WA, RHO sur cellules actives
1341C
1342 IF (sph_iord1==0) THEN
1343 ideb = 0
1344 DO p = 1, nspmd
1345 IF(psphs(p)>0)THEN
1346 nn = 0
1347 DO n = 1, psphs(p)
1348 IF(isphs(ideb+n)==1) THEN
1349 nn = nn + 1
1350 icell = lsphs(ideb+n)
1351C INOD = KXSP(3,ICELL)
1352 bufs(1,nn+ideb) = wgradt(1,icell)
1353 bufs(2,nn+ideb) = wgradt(2,icell)
1354 bufs(3,nn+ideb) = wgradt(3,icell)
1355 bufs(4,nn+ideb) = wacomp(1,icell)
1356 bufs(5,nn+ideb) = wacomp(5,icell)
1357 bufs(6,nn+ideb) = wacomp(6,icell)
1358 bufs(7,nn+ideb) = wacomp(7,icell)
1359 END IF
1360 END DO
1361 msgtyp = msgoff
1362 CALL spmd_isend(
1363 s bufs(1,ideb+1),nn*7,it_spmd(p),msgtyp,
1364 g req_sd(p))
1365 ideb = ideb + psphs(p)
1366 END IF
1367 END DO
1368 ELSE
1369 ideb = 0
1370 DO p = 1, nspmd
1371 IF(psphs(p)>0)THEN
1372 nn = 0
1373 DO n = 1, psphs(p)
1374 IF(isphs(ideb+n)==1) THEN
1375 nn = nn + 1
1376 icell = lsphs(ideb+n)
1377C INOD = KXSP(3,ICELL)
1378 bufs(1,nn+ideb) = wgradt(1,icell)
1379 bufs(2,nn+ideb) = wgradt(2,icell)
1380 bufs(3,nn+ideb) = wgradt(3,icell)
1381 bufs(4,nn+ideb) = wacomp(1,icell)
1382 bufs(5,nn+ideb) = wacomp(8,icell)
1383 bufs(6,nn+ideb) = wacomp(9,icell)
1384 bufs(7,nn+ideb) = wacomp(10,icell)
1385 bufs(8,nn+ideb) = wacomp(11,icell)
1386 bufs(9,nn+ideb) = wacomp(12,icell)
1387 bufs(10,nn+ideb) = wacomp(13,icell)
1388 bufs(11,nn+ideb) = wacomp(14,icell)
1389 bufs(12,nn+ideb) = wacomp(15,icell)
1390 bufs(13,nn+ideb) = wacomp(16,icell)
1391 END IF
1392 END DO
1393 msgtyp = msgoff
1394 CALL spmd_isend(
1395 s bufs(1,ideb+1),nn*13,it_spmd(p),msgtyp,
1396 g req_sd(p))
1397 ideb = ideb + psphs(p)
1398 END IF
1399 END DO
1400 ENDIF
1401C
1402C Reception WACOMP, WA, RHO
1403C
1404 IF (sph_iord1==0) THEN
1405 ideb = 0
1406 DO p = 1, nspmd
1407 IF(psphr(p)/=0)THEN
1408 msgtyp = msgoff
1409 CALL spmd_recv(bufr,7*psphr(p),it_spmd(p),
1410 . msgtyp)
1411 nn = 0
1412 DO n = 1, psphr(p)
1413 IF(isphr(ideb+n)==1) THEN
1414 nn = nn + 1
1415 wgr(1,ideb+n)= bufr(1,nn)
1416 wgr(2,ideb+n)= bufr(2,nn)
1417 wgr(3,ideb+n)= bufr(3,nn)
1418 wacompr(1,ideb+n)= bufr(4,nn)
1419 wacompr(2,ideb+n)= zero
1420 wacompr(3,ideb+n)= zero
1421 wacompr(4,ideb+n)= zero
1422 wacompr(5,ideb+n)= bufr(5,nn)
1423 wacompr(6,ideb+n)= bufr(6,nn)
1424 wacompr(7,ideb+n)= bufr(7,nn)
1425 wacompr(8,ideb+n)= zero
1426 wacompr(9,ideb+n)= zero
1427 wacompr(10,ideb+n)=zero
1428 wacompr(11,ideb+n)=zero
1429 wacompr(12,ideb+n)=zero
1430 wacompr(13,ideb+n)=zero
1431 wacompr(14,ideb+n)=zero
1432 wacompr(15,ideb+n)=zero
1433 wacompr(16,ideb+n)=zero
1434 END IF
1435 END DO
1436 ideb = ideb + psphr(p)
1437 END IF
1438 END DO
1439 ELSE
1440 ideb = 0
1441 DO p = 1, nspmd
1442 IF(psphr(p)/=0)THEN
1443 msgtyp = msgoff
1444 CALL spmd_recv(bufr,13*psphr(p),it_spmd(p),
1445 . msgtyp)
1446 nn = 0
1447 DO n = 1, psphr(p)
1448 IF(isphr(ideb+n)==1) THEN
1449 nn = nn + 1
1450 wgr(1,ideb+n)= bufr(1,nn)
1451 wgr(2,ideb+n)= bufr(2,nn)
1452 wgr(3,ideb+n)= bufr(3,nn)
1453 wacompr(1,ideb+n)= bufr(4,nn)
1454 wacompr(2,ideb+n)= zero
1455 wacompr(3,ideb+n)= zero
1456 wacompr(4,ideb+n)= zero
1457 wacompr(5,ideb+n)= zero
1458 wacompr(6,ideb+n)= zero
1459 wacompr(7,ideb+n)= zero
1460 wacompr(8,ideb+n)= bufr(5,nn)
1461 wacompr(9,ideb+n)= bufr(6,nn)
1462 wacompr(10,ideb+n)=bufr(7,nn)
1463 wacompr(11,ideb+n)=bufr(8,nn)
1464 wacompr(12,ideb+n)=bufr(9,nn)
1465 wacompr(13,ideb+n)=bufr(10,nn)
1466 wacompr(14,ideb+n)=bufr(11,nn)
1467 wacompr(15,ideb+n)=bufr(12,nn)
1468 wacompr(16,ideb+n)=bufr(13,nn)
1469 END IF
1470 END DO
1471 ideb = ideb + psphr(p)
1472 END IF
1473 END DO
1474 ENDIF
1475C
1476C Wait terminaison
1477C
1478 DO p = 1, nspmd
1479 IF(psphs(p)/=0)THEN
1480 CALL spmd_wait(req_sd(p))
1481 END IF
1482 END DO
1483C
1484#endif
1485 RETURN

◆ spmd_sphgeth()

subroutine spmd_sphgeth ( integer, dimension(nisp,*) kxsp,
spbuf )

Definition at line 1050 of file spmd_sph.F.

1051C-----------------------------------------------
1052C M o d u l e s
1053C-----------------------------------------------
1054 USE sphbox
1055 USE spmd_mod
1056C-----------------------------------------------
1057C I m p l i c i t T y p e s
1058C-----------------------------------------------
1059#include "implicit_f.inc"
1060C-----------------------------------------------
1061C M e s s a g e P a s s i n g
1062C-----------------------------------------------
1063#include "spmd.inc"
1064C-----------------------------------------------
1065C C o m m o n B l o c k s
1066C-----------------------------------------------
1067#include "com01_c.inc"
1068#include "task_c.inc"
1069#include "sphcom.inc"
1070C-----------------------------------------------
1071C D u m m y A r g u m e n t s
1072C-----------------------------------------------
1073 INTEGER KXSP(NISP,*)
1074 my_real
1075 . spbuf(nspbuf,*)
1076C-----------------------------------------------
1077C L o c a l V a r i a b l e s
1078C-----------------------------------------------
1079#ifdef MPI
1080 INTEGER P, I, N, IDEB, MSGTYP, LOC_PROC,
1081 . IERROR, ICELL, INOD,
1082 . REQ_SD(NSPMD), MSGOFF
1083 my_real
1084 . bufs(nsphs), bufr(nsphr)
1085 DATA msgoff/2014/
1086C-----------------------------------------------
1087C S o u r c e L i n e s
1088C-----------------------------------------------
1089 loc_proc = ispmd+1
1090C
1091C Envoi H sur cellules actives
1092C
1093 ideb = 0
1094 DO p = 1, nspmd
1095 IF(psphs(p)/=0)THEN
1096 DO n = 1, psphs(p)
1097 icell = lsphs(ideb+n)
1098 inod = kxsp(3,icell)
1099 bufs(n+ideb) = spbuf(1,icell)
1100 END DO
1101 msgtyp = msgoff
1102 CALL spmd_isend(
1103 s bufs(ideb+1),psphs(p),it_spmd(p),msgtyp,
1104 g req_sd(p))
1105 ideb = ideb + psphs(p)
1106 ENDIF
1107 END DO
1108C
1109C Reception H
1110C
1111 ideb = 0
1112 DO p = 1, nspmd
1113 IF(psphr(p)/=0)THEN
1114 msgtyp = msgoff
1115 CALL spmd_recv(bufr,psphr(p),it_spmd(p),
1116 . msgtyp)
1117 DO n = 1, psphr(p)
1118 xsphr(2,ideb+n) = bufr(n)
1119 END DO
1120 ideb = ideb + psphr(p)
1121 END IF
1122 END DO
1123C
1124C Wait terminaison
1125C
1126 DO p = 1, nspmd
1127 IF(psphs(p)/=0)THEN
1128 CALL spmd_wait(req_sd(p))
1129 END IF
1130 END DO
1131C
1132#endif
1133 RETURN

◆ spmd_sphgetimp()

subroutine spmd_sphgetimp ( integer, dimension(nisp,*) kxsp)

Definition at line 1831 of file spmd_sph.F.

1832C-----------------------------------------------
1833C M o d u l e s
1834C-----------------------------------------------
1835 USE sphbox
1836 USE spmd_mod
1837C-----------------------------------------------
1838C I m p l i c i t T y p e s
1839C-----------------------------------------------
1840#include "implicit_f.inc"
1841C-----------------------------------------------
1842C M e s s a g e P a s s i n g
1843C-----------------------------------------------
1844#include "spmd.inc"
1845C-----------------------------------------------
1846C C o m m o n B l o c k s
1847C-----------------------------------------------
1848#include "com01_c.inc"
1849#include "task_c.inc"
1850#include "sphcom.inc"
1851C-----------------------------------------------
1852C D u m m y A r g u m e n t s
1853C-----------------------------------------------
1854 INTEGER KXSP(NISP,*)
1855
1856C-----------------------------------------------
1857C L o c a l V a r i a b l e s
1858C-----------------------------------------------
1859#ifdef MPI
1860 INTEGER P, I, N, IDEB, MSGTYP, LOC_PROC,
1861 . IERROR, ICELL, INOD,
1862 . REQ_SD(NSPMD), MSGOFF
1863 integer
1864 . bufs(nsphs), bufr(nsphr)
1865 DATA msgoff/2020/
1866C-----------------------------------------------
1867C S o u r c e L i n e s
1868C-----------------------------------------------
1869c Get IMPOSE value KXSP(2,ICELL)/(NGROUP+1)
1870
1871 loc_proc = ispmd+1
1872
1873 ideb = 0
1874 DO p = 1, nspmd
1875 IF(psphs(p)/=0)THEN
1876 DO n = 1, psphs(p)
1877 icell = lsphs(ideb+n)
1878 bufs(n+ideb) = kxsp(2,icell)/(ngroup+1)
1879 END DO
1880 msgtyp = msgoff
1881 CALL spmd_isend(
1882 s bufs(ideb+1),psphs(p)*1,it_spmd(p),msgtyp,
1883 g req_sd(p))
1884 ideb = ideb + psphs(p)
1885 ENDIF
1886 END DO
1887C
1888C Reception
1889C
1890 ideb = 0
1891 DO p = 1, nspmd
1892 IF(psphr(p)/=0)THEN
1893 msgtyp = msgoff
1894 CALL spmd_recv(bufr,1*psphr(p),it_spmd(p),
1895 . msgtyp)
1896 DO n = 1, psphr(p)
1897 xsphr(12,ideb+n) = bufr(n)
1898 END DO
1899 ideb = ideb + psphr(p)
1900 END IF
1901 END DO
1902C
1903C Wait terminaison
1904C
1905 DO p = 1, nspmd
1906 IF(psphs(p)/=0)THEN
1907 CALL spmd_wait(req_sd(p))
1908 END IF
1909 END DO
1910C
1911#endif
1912 RETURN

◆ spmd_sphgetisph()

subroutine spmd_sphgetisph

Definition at line 301 of file spmd_sph.F.

302C-----------------------------------------------
303C M o d u l e s
304C-----------------------------------------------
305 USE sphbox
306 USE spmd_mod
307C-----------------------------------------------
308C I m p l i c i t T y p e s
309C-----------------------------------------------
310#include "implicit_f.inc"
311C-----------------------------------------------
312C M e s s a g e P a s s i n g
313C-----------------------------------------------
314#include "spmd.inc"
315C-----------------------------------------------
316C C o m m o n B l o c k s
317C-----------------------------------------------
318#include "com01_c.inc"
319#include "task_c.inc"
320C-----------------------------------------------
321C L o c a l V a r i a b l e s
322C-----------------------------------------------
323#ifdef MPI
324 INTEGER P, I, MSGTYP, LOC_PROC, IERROR,
325 . IDEB,REQ_SD(NSPMD),MSGOFF,MSGOFF2
326 DATA msgoff/2006/
327C-----------------------------------------------
328C S o u r c e L i n e s
329C-----------------------------------------------
330 loc_proc = ispmd+1
331C
332C Envoi flag cellules actives
333C
334 ideb = 1
335 DO p = 1, nspmd
336 IF(psphr(p)/=0)THEN
337 msgtyp = msgoff
338 CALL spmd_isend(
339 s isphr(ideb),psphr(p),it_spmd(p),msgtyp,
340 g req_sd(p))
341 ideb = ideb + psphr(p)
342 END IF
343 END DO
344C
345C Reception flag cellules actives
346C
347 ideb = 1
348 DO p = 1, nspmd
349 IF(psphs(p)/=0)THEN
350 msgtyp = msgoff
351 CALL spmd_recv(isphs(ideb),psphs(p),it_spmd(p),
352 . msgtyp)
353 ideb = ideb + psphs(p)
354 END IF
355 END DO
356C
357
358 DO p = 1, nspmd
359 IF(psphr(p)/=0)THEN
360 CALL spmd_wait(req_sd(p))
361 END IF
362 END DO
363C
364#endif
365 RETURN

◆ spmd_sphgetstb()

subroutine spmd_sphgetstb ( stab,
stabr )

Definition at line 718 of file spmd_sph.F.

719C-----------------------------------------------
720C M o d u l e s
721C-----------------------------------------------
722 USE sphbox
723 USE spmd_mod
724C-----------------------------------------------
725C I m p l i c i t T y p e s
726C-----------------------------------------------
727#include "implicit_f.inc"
728C-----------------------------------------------
729C M e s s a g e P a s s i n g
730C-----------------------------------------------
731#include "spmd.inc"
732C-----------------------------------------------
733C C o m m o n B l o c k s
734C-----------------------------------------------
735#include "com01_c.inc"
736#include "task_c.inc"
737C-----------------------------------------------
738C D u m m y A r g u m e n t s
739C-----------------------------------------------
740 my_real
741 . stab(7,*), stabr(7,*)
742C-----------------------------------------------
743C L o c a l V a r i a b l e s
744C-----------------------------------------------
745#ifdef MPI
746 INTEGER P, I, NN, N, IDEB, MSGTYP, LOC_PROC,
747 . IERROR, ICELL,
748 . REQ_SD(NSPMD), MSGOFF
749 my_real
750 . bufs(nsphs), bufr(nsphr)
751 DATA msgoff/2011/
752C-----------------------------------------------
753C S o u r c e L i n e s
754C-----------------------------------------------
755 loc_proc = ispmd+1
756C
757C Envoi STAB sur cellules actives
758C
759 ideb = 0
760 DO p = 1, nspmd
761 IF(psphs(p)>0)THEN
762 nn = 0
763 DO n = 1, psphs(p)
764 IF(isphs(ideb+n)==1) THEN
765 nn = nn + 1
766 icell = lsphs(ideb+n)
767C INOD = KXSP(3,ICELL)
768 bufs(nn+ideb) = stab(7,icell)
769 END IF
770 END DO
771 msgtyp = msgoff
772 CALL spmd_isend(
773 s bufs(ideb+1),nn,it_spmd(p),msgtyp,
774 g req_sd(p))
775 ideb = ideb + psphs(p)
776 END IF
777 END DO
778C
779C Reception STAB
780C
781 ideb = 0
782 DO p = 1, nspmd
783 IF(psphr(p)/=0)THEN
784 msgtyp = msgoff
785 CALL spmd_recv(bufr,psphr(p),it_spmd(p),
786 . msgtyp)
787 nn = 0
788 DO n = 1, psphr(p)
789 IF(isphr(ideb+n)==1) THEN
790 nn = nn + 1
791 stabr(7,ideb+n) = bufr(nn)
792 END IF
793 END DO
794 ideb = ideb + psphr(p)
795 END IF
796
797 END DO
798C
799C Wait terminaison
800C
801 DO p = 1, nspmd
802 IF(psphs(p)/=0)THEN
803 CALL spmd_wait(req_sd(p))
804 END IF
805 END DO
806C
807#endif
808 RETURN

◆ spmd_sphgett()

subroutine spmd_sphgett ( wt,
wtr,
lambda,
lambdr )

Definition at line 1197 of file spmd_sph.F.

1198C-----------------------------------------------
1199C M o d u l e s
1200C-----------------------------------------------
1201 USE sphbox
1202 USE spmd_mod
1203C-----------------------------------------------
1204C I m p l i c i t T y p e s
1205C-----------------------------------------------
1206#include "implicit_f.inc"
1207C-----------------------------------------------
1208C M e s s a g e P a s s i n g
1209C-----------------------------------------------
1210#include "spmd.inc"
1211C-----------------------------------------------
1212C C o m m o n B l o c k s
1213C-----------------------------------------------
1214#include "com01_c.inc"
1215#include "task_c.inc"
1216C-----------------------------------------------
1217C D u m m y A r g u m e n t s
1218C-----------------------------------------------
1219 my_real
1220 . wt(*), wtr(*), lambda(*), lambdr(*)
1221C-----------------------------------------------
1222C L o c a l V a r i a b l e s
1223C-----------------------------------------------
1224#ifdef MPI
1225 INTEGER P, I, NN, N, IDEB, MSGTYP, LOC_PROC,
1226 . IERROR, ICELL,
1227 . REQ_SD(NSPMD), MSGOFF
1228 my_real
1229 . bufs(2,nsphs), bufr(2,nsphr)
1230 DATA msgoff/2015/
1231C-----------------------------------------------
1232C S o u r c e L i n e s
1233C-----------------------------------------------
1234 loc_proc = ispmd+1
1235C
1236C Envoi WACOMP, WA, RHO sur cellules actives
1237C
1238 ideb = 0
1239 DO p = 1, nspmd
1240 IF(psphs(p)>0)THEN
1241 nn = 0
1242 DO n = 1, psphs(p)
1243 IF(isphs(ideb+n)==1) THEN
1244 nn = nn + 1
1245 icell = lsphs(ideb+n)
1246 bufs(1,nn+ideb) = wt(icell)
1247 bufs(2,nn+ideb) = lambda(icell)
1248 END IF
1249 END DO
1250 msgtyp = msgoff
1251 CALL spmd_isend(
1252 s bufs(1,ideb+1),2*nn,it_spmd(p),msgtyp,
1253 g req_sd(p))
1254 ideb = ideb + psphs(p)
1255 END IF
1256 END DO
1257C
1258C Reception WT
1259C
1260 ideb = 0
1261 DO p = 1, nspmd
1262 IF(psphr(p)/=0)THEN
1263 msgtyp = msgoff
1264 CALL spmd_recv(bufr,psphr(p)*2,it_spmd(p),
1265 . msgtyp)
1266 nn = 0
1267 DO n = 1, psphr(p)
1268 IF(isphr(ideb+n)==1) THEN
1269 nn = nn + 1
1270 wtr(ideb+n) = bufr(1,nn)
1271 lambdr(ideb+n)= bufr(2,nn)
1272 END IF
1273 END DO
1274 ideb = ideb + psphr(p)
1275 END IF
1276 END DO
1277C
1278C Wait terminaison
1279C
1280 DO p = 1, nspmd
1281 IF(psphs(p)/=0)THEN
1282 CALL spmd_wait(req_sd(p))
1283 END IF
1284 END DO
1285C
1286#endif
1287 RETURN

◆ spmd_sphgetvois_off()

subroutine spmd_sphgetvois_off ( integer, dimension(numsph) off_sph,
integer, dimension(nsphr) tag_sph,
integer, dimension(nisp,*) kxsp,
integer, dimension(kvoisph,*) ixsp )

Definition at line 1625 of file spmd_sph.F.

1627C-----------------------------------------------
1628C M o d u l e s
1629C-----------------------------------------------
1630 USE sphbox
1631 USE spmd_mod
1632C-----------------------------------------------
1633C I m p l i c i t T y p e s
1634C-----------------------------------------------
1635#include "implicit_f.inc"
1636C-----------------------------------------------
1637C M e s s a g e P a s s i n g
1638C-----------------------------------------------
1639#include "spmd.inc"
1640C-----------------------------------------------
1641C C o m m o n B l o c k s
1642C-----------------------------------------------
1643#include "com01_c.inc"
1644#include "task_c.inc"
1645#include "sphcom.inc"
1646C-----------------------------------------------
1647C D u m m y A r g u m e n t s
1648C-----------------------------------------------
1649 INTEGER
1650 . OFF_SPH(NUMSPH), TAG_SPH(NSPHR),
1651 . TAG_SPHR(NSPHS), KXSP(NISP,*),
1652 . IXSP(KVOISPH,*)
1653C-----------------------------------------------
1654C L o c a l V a r i a b l e s
1655C-----------------------------------------------
1656#ifdef MPI
1657 INTEGER P, I, NN, N, IDEB, MSGTYP, LOC_PROC,
1658 . IERROR, ICELL, INOD,
1659 . REQ_SD(NSPMD), REQ_SD2(NSPMD),
1660 . J,
1661 . NVOISS1, NVOISS2,KNOD,K, JK,
1662 . NVOIS1, NVOIS2, SM,MSGOFF,MSGOFF2
1663 integer
1664 . bufs(nsphs), bufr(nsphr)
1665 DATA msgoff/2018/
1666 DATA msgoff2/2019/
1667C-----------------------------------------------
1668C S o u r c e L i n e s
1669C-----------------------------------------------
1670c tratment of remote neighbours (locals done in sponof2)
1671
1672 loc_proc = ispmd+1
1673c
1674C TAG_SPH set to 1 in sponof2 if remote neighbour
1675C send TAG_SPH
1676 ideb = 1
1677 DO p = 1, nspmd
1678 IF(psphr(p)/=0)THEN
1679 msgtyp = msgoff
1680 CALL spmd_isend(
1681 s tag_sph(ideb),psphr(p),it_spmd(p),msgtyp,
1682 g req_sd(p))
1683 ideb = ideb + psphr(p)
1684 END IF
1685 END DO
1686C
1687C Reception TAG_SPH
1688C
1689 ideb = 1
1690 DO p = 1, nspmd
1691 IF(psphs(p)/=0)THEN
1692 msgtyp = msgoff
1693 CALL spmd_recv(tag_sphr(ideb),psphs(p),
1694 . it_spmd(p),msgtyp)
1695 ideb = ideb + psphs(p)
1696 END IF
1697 END DO
1698C
1699C send OFF_SPH
1700c OFF_SPH set to 1 in sponof2 if cell is deleted
1701 ideb = 0
1702 DO p = 1, nspmd
1703 IF(psphs(p)/=0)THEN
1704 nn = 0
1705 DO n = 1, psphs(p)
1706 nn = nn + 1
1707 icell = lsphs(ideb+n)
1708 bufs(nn+ideb)=off_sph(icell)
1709 END DO
1710
1711 msgtyp = msgoff2
1712 CALL spmd_isend(
1713 s bufs(ideb+1),nn,it_spmd(p),msgtyp,
1714 g req_sd2(p))
1715 ideb = ideb + psphs(p)
1716 END IF
1717 END DO
1718C
1719C Reception OFF_SPH
1720C
1721 ideb = 0
1722 DO p = 1, nspmd
1723 IF(psphr(p)/=0)THEN
1724 msgtyp = msgoff2
1725 CALL spmd_recv(bufr(ideb+1),psphr(p),it_spmd(p),
1726 . msgtyp)
1727 ideb = ideb + psphr(p)
1728 END IF
1729 END DO
1730
1731 ideb = 0
1732 DO p = 1, nspmd
1733 DO n = 1, psphs(p)
1734 icell = lsphs(ideb+n)
1735! remote neighbour to treat
1736 IF(tag_sphr(ideb+n)==1) THEN
1737
1738 nvois1=0
1739 DO j=1,kxsp(4,icell)
1740 knod=ixsp(j,icell)
1741 IF(knod<0)THEN
1742! remote cell, add only if non deleted cell
1743 IF(bufr(-knod)/=1)THEN
1744 nvois1=nvois1+1
1745 ixsp(nvois1,icell)=knod
1746 ENDIF
1747 ELSE
1748! non remote case, add neighbour
1749 nvois1=nvois1+1
1750 ixsp(nvois1,icell)=knod
1751 ENDIF
1752 ENDDO
1753
1754 nvois2=nvois1
1755 DO k=kxsp(4,icell)+1,kxsp(5,icell)
1756 knod=ixsp(k,icell)
1757 IF(knod<0)THEN
1758 IF(bufr(-knod)/=1)THEN
1759 nvois2=nvois2+1
1760 ixsp(nvois2,icell)=knod
1761 ENDIF
1762 ELSE
1763 nvois2=nvois2+1
1764 ixsp(nvois2,icell)=knod
1765 ENDIF
1766 ENDDO
1767
1768 nvoiss1=0
1769 DO k=kxsp(5,icell)+1,kxsp(5,icell)+kxsp(6,icell)
1770 jk =ixsp(k,icell)
1771 IF(jk<0)THEN
1772 sm=-jk/(nspcond+1)
1773 IF(bufr(sm)/=1)THEN
1774 nvoiss1=nvoiss1+1
1775 ixsp(nvois2+nvoiss1,icell)=jk
1776 ENDIF
1777 ELSE
1778 nvoiss1=nvoiss1+1
1779 ixsp(nvois2+nvoiss1,icell)=jk
1780 ENDIF
1781 ENDDO
1782 nvoiss2=nvoiss1
1783 DO k=kxsp(5,icell)+kxsp(6,icell)+1,
1784 . kxsp(5,icell)+kxsp(7,icell)
1785 jk =ixsp(k,icell)
1786 IF(jk<0)THEN
1787 sm=-jk/(nspcond+1)
1788 IF(bufr(sm)/=1)THEN
1789 nvoiss2=nvoiss2+1
1790 ixsp(nvois2+nvoiss2,icell)=jk
1791 ENDIF
1792 ELSE
1793 nvoiss2=nvoiss2+1
1794 ixsp(nvois2+nvoiss2,icell)=jk
1795 ENDIF
1796 ENDDO
1797 kxsp(4,icell)= nvois1
1798 kxsp(5,icell)= nvois2
1799 kxsp(6,icell)=nvoiss1
1800 kxsp(7,icell)=nvoiss2
1801 ENDIF
1802 END DO
1803 ideb = ideb + psphs(p)
1804 END DO
1805
1806C Wait terminaison
1807C
1808 DO p = 1, nspmd
1809 IF(psphr(p)/=0)THEN
1810 CALL spmd_wait(req_sd(p))
1811 END IF
1812 IF(psphs(p)/=0)THEN
1813 CALL spmd_wait(req_sd2(p))
1814 END IF
1815 END DO
1816
1817#endif
1818 RETURN

◆ spmd_sphgetw()

subroutine spmd_sphgetw ( spbuf,
wacomp,
wa,
war,
integer, intent(in) sph_iord1 )

Definition at line 486 of file spmd_sph.F.

487C-----------------------------------------------
488C M o d u l e s
489C-----------------------------------------------
490 USE sphbox
491 USE spmd_mod
492C-----------------------------------------------
493C I m p l i c i t T y p e s
494C-----------------------------------------------
495#include "implicit_f.inc"
496C-----------------------------------------------
497C M e s s a g e P a s s i n g
498C-----------------------------------------------
499#include "spmd.inc"
500C-----------------------------------------------
501C C o m m o n B l o c k s
502C-----------------------------------------------
503#include "com01_c.inc"
504#include "task_c.inc"
505#include "sphcom.inc"
506C-----------------------------------------------
507C D u m m y A r g u m e n t s
508C-----------------------------------------------
509 INTEGER, INTENT(IN) :: SPH_IORD1
510 my_real
511 . spbuf(nspbuf,*), wacomp(16,*), wa(kwasph,*),
512 . war(10,*)
513C-----------------------------------------------
514C L o c a l V a r i a b l e s
515C-----------------------------------------------
516#ifdef MPI
517 INTEGER P, I, NN, N, IDEB, MSGTYP, LOC_PROC,
518 . IERROR, ICELL,
519 . REQ_SD(NSPMD), MSGOFF
520 my_real
521 . bufs(15+6*sph_iord1,nsphs),bufr(15+6*sph_iord1,nsphr)
522 DATA msgoff/2010/
523C-----------------------------------------------
524C S o u r c e L i n e s
525C-----------------------------------------------
526 loc_proc = ispmd+1
527C
528C Envoi WACOMP, WA, RHO sur cellules actives
529C
530 IF (sph_iord1 == 0) THEN
531 ideb = 0
532 DO p = 1, nspmd
533 IF(psphs(p)>0)THEN
534 nn = 0
535 DO n = 1, psphs(p)
536 IF(isphs(ideb+n)==1) THEN
537 nn = nn + 1
538 icell = lsphs(ideb+n)
539C INOD = KXSP(3,ICELL)
540 bufs(1,nn+ideb) = spbuf(2,icell)
541 bufs(2,nn+ideb) = wa(1,icell)
542 bufs(3,nn+ideb) = wa(2,icell)
543 bufs(4,nn+ideb) = wa(3,icell)
544 bufs(5,nn+ideb) = wa(4,icell)
545 bufs(6,nn+ideb) = wa(5,icell)
546 bufs(7,nn+ideb) = wa(6,icell)
547 bufs(8,nn+ideb) = wa(8,icell)
548 bufs(9,nn+ideb) = wa(9,icell)
549 bufs(10,nn+ideb) = wa(13,icell)
550 bufs(11,nn+ideb) = wa(14,icell)
551 bufs(12,nn+ideb) = wacomp(1,icell)
552 bufs(13,nn+ideb) = wacomp(5,icell)
553 bufs(14,nn+ideb) = wacomp(6,icell)
554 bufs(15,nn+ideb) = wacomp(7,icell)
555 END IF
556 END DO
557 msgtyp = msgoff
558 CALL spmd_isend(
559 s bufs(1,ideb+1),nn*15,it_spmd(p),msgtyp,
560 g req_sd(p))
561 ideb = ideb + psphs(p)
562 END IF
563 END DO
564 ELSE
565 ideb = 0
566 DO p = 1, nspmd
567 IF(psphs(p)>0)THEN
568 nn = 0
569 DO n = 1, psphs(p)
570 IF(isphs(ideb+n)==1) THEN
571 nn = nn + 1
572 icell = lsphs(ideb+n)
573C INOD = KXSP(3,ICELL)
574 bufs(1,nn+ideb) = spbuf(2,icell)
575 bufs(2,nn+ideb) = wa(1,icell)
576 bufs(3,nn+ideb) = wa(2,icell)
577 bufs(4,nn+ideb) = wa(3,icell)
578 bufs(5,nn+ideb) = wa(4,icell)
579 bufs(6,nn+ideb) = wa(5,icell)
580 bufs(7,nn+ideb) = wa(6,icell)
581 bufs(8,nn+ideb) = wa(8,icell)
582 bufs(9,nn+ideb) = wa(9,icell)
583 bufs(10,nn+ideb) = wa(13,icell)
584 bufs(11,nn+ideb) = wa(14,icell)
585 bufs(12,nn+ideb) = wacomp(1,icell)
586 bufs(13,nn+ideb) = wacomp(8,icell)
587 bufs(14,nn+ideb) = wacomp(9,icell)
588 bufs(15,nn+ideb) = wacomp(10,icell)
589 bufs(16,nn+ideb) = wacomp(11,icell)
590 bufs(17,nn+ideb) = wacomp(12,icell)
591 bufs(18,nn+ideb) = wacomp(13,icell)
592 bufs(19,nn+ideb) = wacomp(14,icell)
593 bufs(20,nn+ideb) = wacomp(15,icell)
594 bufs(21,nn+ideb) = wacomp(16,icell)
595 END IF
596 END DO
597 msgtyp = msgoff
598 CALL spmd_isend(
599 s bufs(1,ideb+1),nn*21,it_spmd(p),msgtyp,
600 g req_sd(p))
601 ideb = ideb + psphs(p)
602 END IF
603 END DO
604 ENDIF
605C
606C Reception WACOMP, WA, RHO
607C
608 IF (sph_iord1 == 0) THEN
609 ideb = 0
610 DO p = 1, nspmd
611 IF(psphr(p)/=0)THEN
612 msgtyp = msgoff
613 CALL spmd_recv(bufr,15*psphr(p),it_spmd(p),
614 . msgtyp)
615 nn = 0
616 DO n = 1, psphr(p)
617 IF(isphr(ideb+n)==1) THEN
618 nn = nn + 1
619 xsphr(7,ideb+n) = bufr(1,nn)
620 war(1,ideb+n)= bufr(2,nn)
621 war(2,ideb+n)= bufr(3,nn)
622 war(3,ideb+n)= bufr(4,nn)
623 war(4,ideb+n)= bufr(5,nn)
624 war(5,ideb+n)= bufr(6,nn)
625 war(6,ideb+n)= bufr(7,nn)
626 war(7,ideb+n)= bufr(8,nn)
627 war(8,ideb+n)= bufr(9,nn)
628 war(9,ideb+n)= bufr(10,nn)
629 war(10,ideb+n)=bufr(11,nn)
630 wacompr(1,ideb+n)= bufr(12,nn)
631 wacompr(2,ideb+n)= zero
632 wacompr(3,ideb+n)= zero
633 wacompr(4,ideb+n)= zero
634 wacompr(5,ideb+n)= bufr(13,nn)
635 wacompr(6,ideb+n)= bufr(14,nn)
636 wacompr(7,ideb+n)= bufr(15,nn)
637 wacompr(8,ideb+n)= zero
638 wacompr(9,ideb+n)= zero
639 wacompr(10,ideb+n)=zero
640 wacompr(11,ideb+n)=zero
641 wacompr(12,ideb+n)=zero
642 wacompr(13,ideb+n)=zero
643 wacompr(14,ideb+n)=zero
644 wacompr(15,ideb+n)=zero
645 wacompr(16,ideb+n)=zero
646 END IF
647 END DO
648 ideb = ideb + psphr(p)
649 END IF
650 END DO
651 ELSE
652 ideb = 0
653 DO p = 1, nspmd
654 IF(psphr(p)/=0)THEN
655 msgtyp = msgoff
656 CALL spmd_recv(bufr,21*psphr(p),it_spmd(p),
657 . msgtyp)
658 nn = 0
659 DO n = 1, psphr(p)
660 IF(isphr(ideb+n)==1) THEN
661 nn = nn + 1
662 xsphr(7,ideb+n) = bufr(1,nn)
663 war(1,ideb+n)= bufr(2,nn)
664 war(2,ideb+n)= bufr(3,nn)
665 war(3,ideb+n)= bufr(4,nn)
666 war(4,ideb+n)= bufr(5,nn)
667 war(5,ideb+n)= bufr(6,nn)
668 war(6,ideb+n)= bufr(7,nn)
669 war(7,ideb+n)= bufr(8,nn)
670 war(8,ideb+n)= bufr(9,nn)
671 war(9,ideb+n)= bufr(10,nn)
672 war(10,ideb+n)=bufr(11,nn)
673 wacompr(1,ideb+n)= bufr(12,nn)
674 wacompr(2,ideb+n)= zero
675 wacompr(3,ideb+n)= zero
676 wacompr(4,ideb+n)= zero
677 wacompr(5,ideb+n)= zero
678 wacompr(6,ideb+n)= zero
679 wacompr(7,ideb+n)= zero
680 wacompr(8,ideb+n)= bufr(13,nn)
681 wacompr(9,ideb+n)= bufr(14,nn)
682 wacompr(10,ideb+n)=bufr(15,nn)
683 wacompr(11,ideb+n)=bufr(16,nn)
684 wacompr(12,ideb+n)=bufr(17,nn)
685 wacompr(13,ideb+n)=bufr(18,nn)
686 wacompr(14,ideb+n)=bufr(19,nn)
687 wacompr(15,ideb+n)=bufr(20,nn)
688 wacompr(16,ideb+n)=bufr(21,nn)
689 END IF
690 END DO
691 ideb = ideb + psphr(p)
692 END IF
693 END DO
694 ENDIF
695C
696C Wait terminaison
697C
698 DO p = 1, nspmd
699 IF(psphs(p)/=0)THEN
700 CALL spmd_wait(req_sd(p))
701 END IF
702 END DO
703C
704#endif
705 RETURN

◆ spmd_sphgetwa()

subroutine spmd_sphgetwa ( wa,
war2,
integer, dimension(nisp,*) kxsp )

Definition at line 1498 of file spmd_sph.F.

1499C-----------------------------------------------
1500C M o d u l e s
1501C-----------------------------------------------
1502 USE sphbox
1503 USE spmd_mod
1504C-----------------------------------------------
1505C I m p l i c i t T y p e s
1506C-----------------------------------------------
1507#include "implicit_f.inc"
1508C-----------------------------------------------
1509C M e s s a g e P a s s i n g
1510C-----------------------------------------------
1511#include "spmd.inc"
1512C-----------------------------------------------
1513C C o m m o n B l o c k s
1514C-----------------------------------------------
1515#include "com01_c.inc"
1516#include "task_c.inc"
1517#include "sphcom.inc"
1518C-----------------------------------------------
1519C D u m m y A r g u m e n t s
1520C-----------------------------------------------
1521 my_real
1522 . war2(9,*), wa(kwasph,*)
1523
1524 INTEGER KXSP(NISP,*)
1525C-----------------------------------------------
1526C L o c a l V a r i a b l e s
1527C-----------------------------------------------
1528#ifdef MPI
1529 INTEGER P, I, NN, N, IDEB, MSGTYP, LOC_PROC,
1530 . IERROR, ICELL,
1531 . REQ_SD(NSPMD), MSGOFF
1532 my_real
1533 . bufs(10,nsphs), bufr(10,nsphr)
1534 DATA msgoff/2017/
1535C-----------------------------------------------
1536C S o u r c e L i n e s
1537C-----------------------------------------------
1538 loc_proc = ispmd+1
1539C
1540c need to get all remote values of WA and "IMPOSE" value
1541
1542C Envoi WA sur cellules actives
1543C
1544 ideb = 0
1545 DO p = 1, nspmd
1546 IF(psphs(p)>0)THEN
1547 nn = 0
1548 DO n = 1, psphs(p)
1549 IF(isphs(ideb+n)==1) THEN
1550 nn = nn + 1
1551 icell = lsphs(ideb+n)
1552 bufs(1,nn+ideb) = wa(1,icell)
1553 bufs(2,nn+ideb) = wa(2,icell)
1554 bufs(3,nn+ideb) = wa(3,icell)
1555 bufs(4,nn+ideb) = wa(4,icell)
1556 bufs(5,nn+ideb) = wa(5,icell)
1557 bufs(6,nn+ideb) = wa(6,icell)
1558 bufs(7,nn+ideb) = wa(7,icell)
1559 bufs(8,nn+ideb) = wa(8,icell)
1560 bufs(9,nn+ideb) = wa(9,icell)
1561c IMPOSE value
1562 bufs(10,nn+ideb) = kxsp(2,icell)/(ngroup+1)
1563 END IF
1564 END DO
1565 msgtyp = msgoff
1566 CALL spmd_isend(
1567 s bufs(1,ideb+1),nn*10,it_spmd(p),msgtyp,
1568 g req_sd(p))
1569 ideb = ideb + psphs(p)
1570 END IF
1571 END DO
1572C
1573C Reception
1574C
1575 ideb = 0
1576 DO p = 1, nspmd
1577 IF(psphr(p)/=0)THEN
1578 msgtyp = msgoff
1579 CALL spmd_recv(bufr,10*psphr(p),it_spmd(p),
1580 . msgtyp)
1581 nn = 0
1582 DO n = 1, psphr(p)
1583 IF(isphr(ideb+n)==1) THEN
1584 nn = nn + 1
1585 war2(1,ideb+n)= bufr(1,nn)
1586 war2(2,ideb+n)= bufr(2,nn)
1587 war2(3,ideb+n)= bufr(3,nn)
1588 war2(4,ideb+n)= bufr(4,nn)
1589 war2(5,ideb+n)= bufr(5,nn)
1590 war2(6,ideb+n)= bufr(6,nn)
1591 war2(7,ideb+n)= bufr(7,nn)
1592 war2(8,ideb+n)= bufr(8,nn)
1593 war2(9,ideb+n)= bufr(9,nn)
1594 xsphr(12,ideb+n) = bufr(10,nn)
1595 END IF
1596 END DO
1597 ideb = ideb + psphr(p)
1598 END IF
1599 END DO
1600
1601
1602C
1603C Wait terminaison
1604C
1605 DO p = 1, nspmd
1606 IF(psphs(p)/=0)THEN
1607 CALL spmd_wait(req_sd(p))
1608 END IF
1609 END DO
1610C
1611#endif
1612 RETURN

◆ spmd_sphgetx()

subroutine spmd_sphgetx ( integer, dimension(nisp,*) kxsp,
spbuf,
x,
integer, dimension(*) ipartsp )

Definition at line 378 of file spmd_sph.F.

379C-----------------------------------------------
380C M o d u l e s
381C-----------------------------------------------
382 USE sphbox
383 USE spmd_mod
384C-----------------------------------------------
385C I m p l i c i t T y p e s
386C-----------------------------------------------
387#include "implicit_f.inc"
388C-----------------------------------------------
389C M e s s a g e P a s s i n g
390C-----------------------------------------------
391#include "spmd.inc"
392C-----------------------------------------------
393C C o m m o n B l o c k s
394C-----------------------------------------------
395#include "com01_c.inc"
396#include "task_c.inc"
397#include "sphcom.inc"
398C-----------------------------------------------
399C D u m m y A r g u m e n t s
400C-----------------------------------------------
401 INTEGER KXSP(NISP,*), IPARTSP(*)
402 my_real
403 . spbuf(nspbuf,*), x(3,*)
404C-----------------------------------------------
405C L o c a l V a r i a b l e s
406C-----------------------------------------------
407#ifdef MPI
408 INTEGER P, I, N, IDEB, MSGTYP, LOC_PROC,
409 . IERROR, ICELL, INOD,
410 . REQ_SD(NSPMD), MSGOFF
411 my_real
412 . bufs(6,nsphs), bufr(6,nsphr)
413 DATA msgoff/2008/
414C-----------------------------------------------
415C S o u r c e L i n e s
416C-----------------------------------------------
417 loc_proc = ispmd+1
418C
419C Envoi X, H sur cellules actives
420C
421 ideb = 0
422 DO p = 1, nspmd
423ctmp+1
424 IF(psphs(p)/=0)THEN
425 DO n = 1, psphs(p)
426 icell = lsphs(ideb+n)
427 inod = kxsp(3,icell)
428 bufs(1,n+ideb) = spbuf(1,icell)
429 bufs(2,n+ideb) = x(1,inod)
430 bufs(3,n+ideb) = x(2,inod)
431 bufs(4,n+ideb) = x(3,inod)
432 bufs(5,n+ideb) = kxsp(2,icell)
433 bufs(6,n+ideb) = ipartsp(icell)
434 END DO
435 msgtyp = msgoff
436 CALL spmd_isend(
437 s bufs(1,ideb+1),psphs(p)*6,it_spmd(p),msgtyp,
438 g req_sd(p))
439 ideb = ideb + psphs(p)
440ctmp+1
441 ENDIF
442 END DO
443C
444C Reception X, H
445C
446 ideb = 0
447 DO p = 1, nspmd
448 IF(psphr(p)/=0)THEN
449 msgtyp = msgoff
450 CALL spmd_recv(bufr,6*psphr(p),it_spmd(p), msgtyp)
451 DO n = 1, psphr(p)
452 xsphr(2,ideb+n) = bufr(1,n)
453 xsphr(3,ideb+n) = bufr(2,n)
454 xsphr(4,ideb+n) = bufr(3,n)
455 xsphr(5,ideb+n) = bufr(4,n)
456 xsphr(13,ideb+n)= bufr(5,n)
457 xsphr(14,ideb+n)= bufr(6,n)
458 END DO
459 ideb = ideb + psphr(p)
460 END IF
461 END DO
462C
463C Wait terminaison
464C
465 DO p = 1, nspmd
466ctmp+1 IF(PSPHR(P)/=0)THEN
467 IF(psphs(p)/=0)THEN
468 CALL spmd_wait(req_sd(p))
469 END IF
470 END DO
471C
472#endif
473 RETURN

◆ spmd_sphvox0()

subroutine spmd_sphvox0 ( integer, dimension(nisp,*) kxsp,
spbuf,
integer, dimension(*) wsp2sort,
bminmal,
x,
integer nsp2sortf,
integer nsp2sortl )

Definition at line 2421 of file spmd_sph.F.

2423C-----------------------------------------------
2424C M o d u l e s
2425C-----------------------------------------------
2426 USE tri7box
2427 USE spmd_mod
2428C-----------------------------------------------
2429C I m p l i c i t T y p e s
2430C-----------------------------------------------
2431#include "implicit_f.inc"
2432#include "comlock.inc"
2433C-----------------------------------------------
2434C C o m m o n B l o c k s
2435C-----------------------------------------------
2436#include "task_c.inc"
2437#include "sphcom.inc"
2438C-----------------------------------------------
2439C D u m m y A r g u m e n t s
2440C-----------------------------------------------
2441 INTEGER KXSP(NISP,*), WSP2SORT(*),
2442 2 NSP2SORTF,NSP2SORTL
2443 my_real
2444 . x(3,*),bminmal(*), spbuf(nspbuf,*)
2445C-----------------------------------------------
2446C L o c a l V a r i a b l e s
2447C-----------------------------------------------
2448#ifdef MPI
2449 INTEGER LOC_PROC,
2450 . NBX,NBY,NBZ,NE,
2451 . IX1,IY1,IZ1,IX2,IY2,IZ2,IX,IY,IZ,J,NN
2452 my_real
2453 . ratio, aaa,alpha_marge,
2454 . xmaxb,ymaxb,zmaxb,xminb,yminb,zminb
2455C-----------------------------------------------
2456C S o u r c e L i n e s
2457C-----------------------------------------------
2458C
2459C=======================================================================
2460C tag des boites contenant des facettes
2461C et creation des candidats
2462C=======================================================================
2463
2464 alpha_marge = sqrt(one +spasort)
2465 loc_proc = ispmd + 1
2466c MARGE = TZINF-GAP
2467
2468 nbx = lrvoxel
2469 nby = lrvoxel
2470 nbz = lrvoxel
2471
2472 xmaxb = bminmal(1)
2473 ymaxb = bminmal(2)
2474 zmaxb = bminmal(3)
2475 xminb = bminmal(4)
2476 yminb = bminmal(5)
2477 zminb = bminmal(6)
2478
2479 DO ne=nsp2sortf,nsp2sortl
2480
2481 j=wsp2sort(ne)
2482 nn=kxsp(3,j)
2483
2484c a revoir !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2485 aaa = spbuf(1,j)* alpha_marge
2486
2487c indice des voxels occupes par la facette
2488
2489 ix1=int(nbx*(x(1,nn)-aaa-xminb)/(xmaxb-xminb))
2490 iy1=int(nby*(x(2,nn)-aaa-yminb)/(ymaxb-yminb))
2491 iz1=int(nbz*(x(3,nn)-aaa-zminb)/(zmaxb-zminb))
2492
2493 ix2=int(nbx*(x(1,nn)+aaa-xminb)/(xmaxb-xminb))
2494 iy2=int(nby*(x(2,nn)+aaa-yminb)/(ymaxb-yminb))
2495 iz2=int(nbz*(x(3,nn)+aaa-zminb)/(zmaxb-zminb))
2496
2497#include "lockon.inc"
2498 DO iz = iz1, iz2
2499 DO iy = iy1, iy2
2500 DO ix = ix1, ix2
2501 crvoxel(iy,iz,loc_proc)=ibset(crvoxel(iy,iz,loc_proc),ix)
2502 END DO
2503 END DO
2504 END DO
2505#include "lockoff.inc"
2506
2507 ENDDO
2508
2509C
2510#endif
2511 RETURN
tri7box::crvoxel
integer, dimension(0:lrvoxel, 0:lrvoxel) crvoxel
Definition tri7box.F:56
tri7box::lrvoxel
integer lrvoxel
Definition tri7box.F:54