35 IMPLICIT NONE
36 include 'mpif.h'
37 TYPE (SMUMPS_ROOT_STRUC) :: root
38 INTEGER IROOT
39 INTEGER ICNTL( 60 ), KEEP( 500 )
40 INTEGER(8) KEEP8(150)
41 REAL DKEEP(230)
42 INTEGER COMM_LOAD, ASS_IRECV
43 INTEGER LBUFR, LBUFR_BYTES
44 INTEGER BUFR( LBUFR )
45 INTEGER(8) :: POSFAC,IPTRLU, LRLU, LRLUS
46 INTEGER IWPOS, IWPOSCB
47 INTEGER(8) :: LA
48 INTEGER N, LIW
49 INTEGER IW( LIW )
50 REAL A( LA )
51 INTEGER, intent(in) :: LRGROUPS(N)
52 INTEGER(8) :: PTRAST(KEEP(28))
53 INTEGER(8) :: PTRFAC(KEEP(28))
54 INTEGER(8) :: PAMASTER(KEEP(28))
55 INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28))
56 INTEGER STEP(N), PIMASTER(KEEP(28))
57 INTEGER COMP
58 INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) )
59 INTEGER PERM(N)
60 INTEGER , IERROR, COMM
61 INTEGER LPTRAR, NELT
62 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
63 INTEGER LPOOL, LEAF
64 INTEGER IPOOL( LPOOL )
65 INTEGER MYID, SLAVEF, NBFIN
66 INTEGER ISTEP_TO_INIV2(KEEP(71)),
67 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
68 DOUBLE PRECISION OPASSW, OPELIW
69 INTEGER ITLOC( N+KEEP(253) ), FILS( N ), DAD( KEEP(28) )
70 REAL :: RHS_MUMPS(KEEP(255))
71 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
72 INTEGER ND(KEEP(28)), FRERE(KEEP(28))
73 REAL DBLARR( KEEP8(26) )
74 INTEGER INTARR( KEEP8(27) )
75 INTEGER I, NELIM, NB_CONTRI_GLOBAL, NUMORG,
76 & NFRONT, IROW, JCOL, PDEST, HF, IOLDPS,
77 & IN, DEB_ROW, ILOC_ROW, IFSON, ILOC_COL,
78 & IPOS_SON, NELIM_SON, NSLAVES_SON, HS,
79 & IROW_SON, ICOL_SON, ISLAVE, IERR,
80 & NELIM_SENT, IPOS_STATREC, TYPE_SON
81 INTEGER MUMPS_PROCNODE
83 include 'mumps_headers.h'
84 include 'mumps_tags.h'
85 nb_contri_global = keep(41)
86 numorg = root%ROOT_SIZE
87 nelim = keep(42)
88 nfront = numorg + keep(42)
89 DO irow = 0, root%NPROW - 1
90 DO jcol = 0, root%NPCOL - 1
91 pdest = irow * root%NPCOL + jcol
92 IF ( pdest .NE. myid ) THEN
94 & nb_contri_global, pdest, comm, keep, ierr)
95 if (ierr.lt.0) then
96 write(6,*) ' error detected by ',
97 & 'SMUMPS_BUF_SEND_ROOT2SLAVE'
99 endif
100 ENDIF
101 END DO
102 END DO
104 & nb_contri_global, root,
105 & bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
106 & iwpos, iwposcb, iptrlu,
107 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
108 & ptlust_s, ptrfac,
109 & ptrast, step, pimaster, pamaster, nstk_s,
comp,
110 & iflag, ierror, comm, comm_load,
111 & ipool, lpool, leaf,
112 & nbfin, myid, slavef,
113 &
114 & opassw, opeliw, itloc, rhs_mumps, fils, dad,
115 & lptrar, nelt, frtptr, frtelt,
116 & ptrarw, ptraiw,
117 & intarr,dblarr,icntl,keep,keep8,dkeep,nd )
118 IF (iflag < 0 ) RETURN
119 hf = 6 + keep(ixsz)
120 ioldps = ptlust_s(step(iroot))
121 in = iroot
122 deb_row = ioldps + hf
123 iloc_row = deb_row
124 DO WHILE (in.GT.0)
125 iw(iloc_row) = in
126 iw(iloc_row+nfront) = in
127 iloc_row = iloc_row + 1
128 in = fils(in)
129 END DO
130 ifson = -in
131 iloc_row = ioldps + hf + numorg
132 iloc_col = iloc_row + nfront
133 IF ( nelim.GT.0 ) THEN
134 in = ifson
135 DO WHILE (in.GT.0)
136 ipos_son = pimaster(step(in))
137 IF (ipos_son .EQ. 0) GOTO 100
138 nelim_son = iw(ipos_son+1+keep(ixsz))
139 if (nelim_son.eq.0) then
140 write(6,*) ' error 1 in process_last_rtnelind'
142 endif
143 nslaves_son = iw(ipos_son+5+keep(ixsz))
144 hs = 6 + nslaves_son + keep(ixsz)
145 irow_son = ipos_son + hs
146 icol_son = irow_son + nelim_son
147 DO i = 1, nelim_son
148 iw( iloc_row+i-1 ) = iw( irow_son+i-1 )
149 ENDDO
150 DO i = 1, nelim_son
151 iw( iloc_col+i-1 ) = iw( icol_son+i-1 )
152 ENDDO
153 nelim_sent = iloc_row - ioldps - hf + 1
154 DO islave = 0,nslaves_son
155 IF (islave.EQ.0) THEN
157 ELSE
158 pdest = iw(ipos_son + 5 + islave+keep(ixsz))
159 ENDIF
160 IF (pdest.NE.myid) THEN
162 & pdest, comm, keep, ierr )
163 if (ierr.lt.0) then
164 write(6,*) ' error detected by ',
165 & 'SMUMPS_BUF_SEND_ROOT2SLAVE'
167 endif
168 ELSE
170 & in, nelim_sent, root,
171 &
172 & bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
173 & iwpos, iwposcb, iptrlu,
174 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
175 & ptlust_s, ptrfac,
176 & ptrast, step, pimaster, pamaster, nstk_s,
comp,
177 & iflag, ierror, comm,
178 & perm,
179 & ipool, lpool, leaf,
180 & nbfin, myid, slavef,
181 &
182 & opassw, opeliw, itloc, rhs_mumps,
183 & fils, dad, ptrarw, ptraiw,
184 & intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere,
185 & lptrar, nelt, frtptr, frtelt,
186 & istep_to_iniv2, tab_pos_in_pere
187 & , lrgroups
188 & )
189 IF ( islave .NE. 0 ) THEN
190 IF (keep(50) .EQ. 0) THEN
191 ipos_statrec = ptrist(step(in))+6+keep(ixsz)
192 ELSE
193 ipos_statrec = ptrist(step(in))+8+keep(ixsz)
194 ENDIF
195 IF (iw(ipos_statrec).EQ. s_rec_contstatic) THEN
196 iw(ipos_statrec) = s_root2son_called
197 ELSE
198 IF (nslaves_son .EQ. 0) THEN
199 type_son = 1
200 ELSE
201 type_son = 2
202 ENDIF
204 & iw, liw, a, la, lrlu, lrlus, iwposcb,
205 & iptrlu, step, myid, keep, keep8, type_son
206 & )
207 ENDIF
208 ENDIF
209 ipos_son = pimaster(step(in))
210 ENDIF
211 END DO
213 & .false., myid, n, ipos_son,
214 & iw, liw,
215 & lrlu, lrlus, iptrlu,
216 & iwposcb, la, keep,keep8, .false.
217 & )
218 iloc_row = iloc_row + nelim_son
219 iloc_col = iloc_col + nelim_son
220 100 CONTINUE
221 in = frere(step(in))
222 ENDDO
223 ENDIF
224 RETURN
subroutine, public smumps_buf_send_root2slave(tot_root_size, tot_cont2recv, dest, comm, keep, ierr)
subroutine, public smumps_buf_send_root2son(ison, nelim_root, dest, comm, keep, ierr)
subroutine smumps_free_block_cb_static(ssarbr, myid, n, iposblock, iw, liw, lrlu, lrlus, iptrlu, iwposcb, la, keep, keep8, in_place_stats)
subroutine smumps_process_root2slave(tot_root_size, tot_cont_to_recv, root, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, comm_load, ipool, lpool, leaf, nbfin, myid, slavef opassw, opeliw, itloc, rhs_mumps, fils, dad, lptrar, nelt, frtptr, frtelt, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd)
recursive subroutine smumps_process_root2son(comm_load, ass_irecv, inode, nelim_root, root, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust_s, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)