OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zsol_c.F File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine zmumps_sol_c (root, n, a, la, iw, liw, w, lwc, iwcb, liww, nrhs, na, lna, ne_steps, w2, mtype, icntl, from_pp, step, frere, dad, fils, ptrist, ptrfac, iw1, liw1, ptracb, liwk_ptracb, procnode_steps, slavef, info, keep, keep8, dkeep, comm_nodes, myid, myid_nodes, bufr, lbufr, lbufr_bytes, istep_to_iniv2, tab_pos_in_pere, ibeg_root_def, iend_root_def, iroot_def_rhs_col1, rhs_root, lrhs_root, size_root, master_root, rhscomp, lrhscomp, posinrhscomp_fwd, posinrhscomp_bwd, nz_rhs, nbcol_inbloc, nrhs_orig, jbeg_rhs, step2node, lstep2node, irhs_sparse, irhs_ptr, size_perm_rhs, perm_rhs, size_uns_perm_inv, uns_perm_inv, nb_fs_in_rhscomp_f, nb_fs_in_rhscomp_tot, do_nbsparse, rhs_bounds, lrhs_bounds, ipool_b_l0_omp, lpool_b_l0_omp, ipool_a_l0_omp, lpool_a_l0_omp, l_virt_l0_omp, virt_l0_omp, l_phys_l0_omp, phys_l0_omp, perm_l0_omp, ptr_leafs_l0_omp, l0_omp_mapping, ll0_omp_mapping, l0_omp_factors, ll0_omp_factors)
subroutine zmumps_gather_solution (nslaves, n, myid, comm, nrhs, mtype, rhs, lrhs, ncol_rhs, jbeg_rhs, ptrist, keep, keep8, procnode_steps, iw, liw, step, buffer, size_buf, size_buf_bytes, cwork, lcwork, lscal, scaling, lscaling, rhscomp, lrhscomp, ncol_rhscomp, posinrhscomp, lpos_n, perm_rhs, size_perm_rhs)
subroutine zmumps_npiv_block_add (on_master)
subroutine zmumps_npiv_block_send ()
subroutine zmumps_gather_solution_am1 (nslaves, n, myid, comm, nrhs, rhscomp, lrhscomp, nrhscomp_col, keep, buffer, size_buf, size_buf_bytes, lscal, scaling, lscaling, irhs_ptr_copy, lirhs_ptr_copy, irhs_sparse_copy, lirhs_sparse_copy, rhs_sparse_copy, lrhs_sparse_copy, uns_perm_inv, luns_perm_inv, posinrhscomp, lpos_row, nb_fs_in_rhscomp)
subroutine zmumps_am1_block_add (scale_only)
subroutine zmumps_am1_block_send ()
subroutine zmumps_distsol_indices (mtype, isol_loc, ptrist, keep, keep8, iw, liw_passed, myid_nodes, n, step, procnode, nslaves, scaling_data, lscal, irhs_loc_meaningful, irhs_loc, nloc_rhs)
subroutine zmumps_distributed_solution (slavef, n, myid_nodes, mtype, rhscomp, lrhscomp, nbrhs_eff, posinrhscomp, isol_loc, sol_loc, nrhs, beg_rhs, lsol_loc, ptrist, procnode_steps, keep, keep8, iw, liw, step, scaling_data, lscal, nb_rhsskipped, perm_rhs, size_perm_rhs)
subroutine zmumps_scatter_rhs (nslaves, n, myid, comm, mtype, rhs, lrhs, ncol_rhs, nrhs, rhscomp, lrhscomp, ncol_rhscomp, posinrhscomp_fwd, nb_fs_in_rhscomp_f, ptrist, keep, keep8, procnode_steps, iw, liw, step, icntl, info)
subroutine zmumps_get_buf_indx_rhs ()
subroutine zmumps_build_posinrhscomp (nslaves, n, myid_nodes, ptrist, keep, keep8, procnode_steps, iw, liw, step, posinrhscomp_row, posinrhscomp_col, posinrhscomp_col_alloc, mtype, nbent_rhscomp, nb_fs_in_rhscomp)
subroutine zmumps_build_posinrhscomp_am1 (nslaves, n, myid_nodes, ptrist, dad, keep, keep8, procnode_steps, iw, liw, step, posinrhscomp_row, posinrhscomp_col, posinrhscomp_col_alloc, mtype, irhs_ptr, nbcol_inbloc, irhs_sparse, nz_rhs, perm_rhs, size_perm_rhs, jbeg_rhs, nbent_rhscomp, nb_fs_in_rhscomp_fwd, nb_fs_in_rhscomp_tot, uns_perm_inv, size_uns_perm_inv)

Function/Subroutine Documentation

◆ zmumps_am1_block_add()

subroutine zmumps_gather_solution_am1::zmumps_am1_block_add ( logical, intent(in) scale_only)
private

Definition at line 1602 of file zsol_c.F.

1603 LOGICAL, intent(in) :: SCALE_ONLY
1604 INTEGER III
1605 IF (scale_only) THEN
1606 iii = i
1607 IF (keep(23).NE.0) iii = uns_perm_inv(i)
1608 IF (lscal) THEN
1609 rhs_sparse_copy(iz)=rhs_sparse_copy(iz)*scaling(iii)
1610 ENDIF
1611 RETURN
1612 ENDIF
1613 CALL mpi_pack(j, 1, mpi_integer, buffer,
1614 & size_buf_bytes, pos_buf, comm, ierr )
1615 CALL mpi_pack(i, 1, mpi_integer, buffer,
1616 & size_buf_bytes, pos_buf, comm, ierr )
1617 CALL mpi_pack(rhs_sparse_copy(iz), 1, mpi_double_complex,
1618 & buffer, size_buf_bytes, pos_buf, comm,
1619 & ierr)
1620 n2send=n2send+1
1621 IF ( pos_buf + record_size_p_1 > size_buf_bytes ) THEN
1622 CALL zmumps_am1_block_send()
1623 END IF
1624 RETURN
mpi_pack
subroutine mpi_pack(inbuf, incnt, datatype, outbuf, outcnt, position, comm, ierr)
Definition mpi.f:428
zmumps_am1_block_send
subroutine zmumps_am1_block_send()
Definition zsol_c.F:1627

◆ zmumps_am1_block_send()

subroutine zmumps_gather_solution_am1::zmumps_am1_block_send
private

Definition at line 1626 of file zsol_c.F.

1627 IF (n2send .NE. 0) THEN
1628 CALL mpi_pack(fin, 1, mpi_integer, buffer,
1629 & size_buf_bytes, pos_buf, comm, ierr )
1630 CALL mpi_send(buffer, pos_buf, mpi_packed, master,
1631 & gathersol, comm, ierr)
1632 ENDIF
1633 pos_buf=0
1634 n2send=0
1635 RETURN
mpi_send
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480

◆ zmumps_build_posinrhscomp()

subroutine zmumps_build_posinrhscomp ( integer, intent(in) nslaves,
integer, intent(in) n,
integer, intent(in) myid_nodes,
integer, dimension(keep(28)), intent(in) ptrist,
integer, dimension(500), intent(in) keep,
integer(8), dimension(150), intent(in) keep8,
integer, dimension(keep(28)), intent(in) procnode_steps,
integer, dimension(liw), intent(in) iw,
integer, intent(in) liw,
integer, dimension(n), intent(in) step,
integer, dimension(n), intent(out) posinrhscomp_row,
integer, dimension(n), intent(out) posinrhscomp_col,
logical, intent(in) posinrhscomp_col_alloc,
integer, intent(in) mtype,
integer, intent(out) nbent_rhscomp,
integer, intent(out) nb_fs_in_rhscomp )

Definition at line 2059 of file zsol_c.F.

2067 IMPLICIT NONE
2068 include 'mpif.h'
2069 include 'mumps_tags.h'
2070 INTEGER, intent(in) :: NSLAVES, N, MYID_NODES, LIW
2071 INTEGER, intent(in) :: KEEP(500)
2072 INTEGER(8), intent(in) :: KEEP8(150)
2073 INTEGER, intent(in) :: PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28))
2074 INTEGER, intent(in) :: IW(LIW), STEP(N)
2075 INTEGER, intent(in) :: MTYPE
2076 LOGICAL, intent(in) :: POSINRHSCOMP_COL_ALLOC
2077 INTEGER, intent(out):: POSINRHSCOMP_ROW(N),POSINRHSCOMP_COL(N)
2078 INTEGER, intent(out):: NBENT_RHSCOMP, NB_FS_IN_RHSCOMP
2079 INTEGER ISTEP
2080 INTEGER NPIV
2081 INTEGER IPOS, LIELL
2082 INTEGER JJ, J1, JCOL
2083 INTEGER IPOSINRHSCOMP, IPOSINRHSCOMP_COL
2084 include 'mumps_headers.h'
2085 INTEGER MUMPS_PROCNODE
2086 EXTERNAL mumps_procnode
2087 posinrhscomp_row = 0
2088 IF (posinrhscomp_col_alloc) posinrhscomp_col = 0
2089 iposinrhscomp = 1
2090 DO istep = 1, keep(28)
2091 IF (myid_nodes == mumps_procnode(procnode_steps(istep),
2092 & keep(199))) THEN
2093 CALL mumps_sol_get_npiv_liell_ipos( istep, keep, npiv, liell,
2094 & ipos, iw, liw, ptrist, step, n )
2095 IF (mtype.eq.1 .OR. keep(50).NE.0) THEN
2096 j1=ipos+1
2097 ELSE
2098 j1=ipos+1+liell
2099 END IF
2100 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
2101 jcol = ipos+1+liell
2102 ELSE
2103 jcol = ipos+1
2104 ENDIF
2105 DO jj = j1, j1+npiv-1
2106 posinrhscomp_row(iw(jj)) = iposinrhscomp+jj-j1
2107 ENDDO
2108 IF (posinrhscomp_col_alloc) THEN
2109 DO jj = jcol, jcol+npiv-1
2110 posinrhscomp_col(iw(jj)) = iposinrhscomp+jj-jcol
2111 ENDDO
2112 ENDIF
2113 iposinrhscomp = iposinrhscomp + npiv
2114 ENDIF
2115 ENDDO
2116 nb_fs_in_rhscomp = iposinrhscomp -1
2117 IF (posinrhscomp_col_alloc) iposinrhscomp_col=iposinrhscomp
2118 IF (iposinrhscomp.GT.n) GOTO 500
2119 DO istep = 1, keep(28)
2120 IF (myid_nodes == mumps_procnode(procnode_steps(istep),
2121 & keep(199))) THEN
2122 CALL mumps_sol_get_npiv_liell_ipos( istep, keep,
2123 & npiv, liell, ipos, iw, liw, ptrist, step, n )
2124 IF (mtype.eq.1 .OR. keep(50).NE.0) THEN
2125 j1=ipos+1
2126 ELSE
2127 j1=ipos+1+liell
2128 END IF
2129 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
2130 jcol = ipos+1+liell
2131 ELSE
2132 jcol = ipos+1
2133 ENDIF
2134 IF (posinrhscomp_col_alloc) THEN
2135 DO jj = npiv, liell-1-keep(253)
2136 IF (posinrhscomp_row(iw(j1+jj)).EQ.0) THEN
2137 posinrhscomp_row(iw(j1+jj)) = - iposinrhscomp
2138 iposinrhscomp = iposinrhscomp + 1
2139 ENDIF
2140 IF (posinrhscomp_col(iw(jcol+jj)).EQ.0) THEN
2141 posinrhscomp_col(iw(jcol+jj)) = - iposinrhscomp_col
2142 iposinrhscomp_col = iposinrhscomp_col + 1
2143 ENDIF
2144 ENDDO
2145 ELSE
2146 DO jj = j1+npiv, j1+liell-1-keep(253)
2147 IF (posinrhscomp_row(iw(jj)).EQ.0) THEN
2148 posinrhscomp_row(iw(jj)) = - iposinrhscomp
2149 iposinrhscomp = iposinrhscomp + 1
2150 ENDIF
2151 ENDDO
2152 ENDIF
2153 ENDIF
2154 ENDDO
2155 500 nbent_rhscomp = iposinrhscomp - 1
2156 IF (posinrhscomp_col_alloc)
2157 & nbent_rhscomp = max(nbent_rhscomp, iposinrhscomp_col-1)
2158 RETURN
max
#define max(a, b)
Definition macros.h:21
mumps_sol_get_npiv_liell_ipos
subroutine mumps_sol_get_npiv_liell_ipos(istep, keep, npiv, liell, ipos, iw, liw, ptrist, step, n)
Definition sol_common.F:16
mumps_procnode
integer function mumps_procnode(procinfo_inode, k199)
Definition tools_common.F:151

◆ zmumps_build_posinrhscomp_am1()

subroutine zmumps_build_posinrhscomp_am1 ( integer, intent(in) nslaves,
integer, intent(in) n,
integer, intent(in) myid_nodes,
integer, dimension(keep(28)), intent(in) ptrist,
integer, dimension(keep(28)), intent(inout) dad,
integer, dimension(500), intent(in) keep,
integer(8), dimension(150), intent(in) keep8,
integer, dimension(keep(28)), intent(in) procnode_steps,
integer, dimension(liw), intent(in) iw,
integer, intent(in) liw,
integer, dimension(n), intent(in) step,
integer, dimension(n), intent(out) posinrhscomp_row,
integer, dimension(n), intent(out) posinrhscomp_col,
logical, intent(in) posinrhscomp_col_alloc,
integer, intent(in) mtype,
integer, dimension(nbcol_inbloc+1), intent(in) irhs_ptr,
integer, intent(in) nbcol_inbloc,
integer, dimension(nz_rhs), intent(in) irhs_sparse,
integer, intent(in) nz_rhs,
integer, dimension(size_perm_rhs), intent(in) perm_rhs,
integer, intent(in) size_perm_rhs,
integer, intent(in) jbeg_rhs,
integer, intent(out) nbent_rhscomp,
integer, intent(out) nb_fs_in_rhscomp_fwd,
integer, intent(out) nb_fs_in_rhscomp_tot,
integer, dimension(size_uns_perm_inv), intent(in) uns_perm_inv,
integer, intent(in) size_uns_perm_inv )

Definition at line 2160 of file zsol_c.F.

2173 IMPLICIT NONE
2174 include 'mpif.h'
2175 include 'mumps_tags.h'
2176 INTEGER, intent(in) :: NSLAVES, N, MYID_NODES, LIW,
2177 & SIZE_UNS_PERM_INV
2178 INTEGER, intent(in) :: KEEP(500)
2179 INTEGER(8), intent(in) :: KEEP8(150)
2180 INTEGER, intent(in) :: PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28))
2181 INTEGER, intent(inout) :: DAD(KEEP(28))
2182 INTEGER, intent(in) :: IW(LIW), STEP(N)
2183 INTEGER, intent(in) :: NBCOL_INBLOC, IRHS_PTR(NBCOL_INBLOC+1)
2184 INTEGER, intent(in) :: NZ_RHS, IRHS_SPARSE(NZ_RHS)
2185 INTEGER, intent(in) :: SIZE_PERM_RHS, PERM_RHS(SIZE_PERM_RHS)
2186 INTEGER, intent(in) :: JBEG_RHS
2187 INTEGER, intent(in) :: MTYPE
2188 LOGICAL, intent(in) :: POSINRHSCOMP_COL_ALLOC
2189 INTEGER, intent(out):: POSINRHSCOMP_ROW(N),POSINRHSCOMP_COL(N)
2190 INTEGER, intent(out):: NBENT_RHSCOMP
2191 INTEGER, intent(out):: NB_FS_IN_RHSCOMP_FWD, NB_FS_IN_RHSCOMP_TOT
2192 INTEGER, intent(in) :: UNS_PERM_INV(SIZE_UNS_PERM_INV)
2193 INTEGER I, JAM1
2194 INTEGER ISTEP, OLDISTEP
2195 INTEGER NPIV
2196 INTEGER IPOS, LIELL
2197 INTEGER JJ, J1, JCOL, ABSJCOL
2198 INTEGER IPOSINRHSCOMP_ROW, IPOSINRHSCOMP_COL
2199 INTEGER NBENT_RHSCOMP_ROW, NBENT_RHSCOMP_COL
2200 LOGICAL GO_UP
2201 include 'mumps_headers.h'
2202 INTEGER MUMPS_PROCNODE
2203 EXTERNAL mumps_procnode
2204 IF(keep(237).EQ.0) THEN
2205 WRITE(*,*)'BUILD_POSINRHSCOMP_SPARSE available for A-1 only !'
2206 CALL mumps_abort()
2207 END IF
2208 posinrhscomp_row = 0
2209 IF (posinrhscomp_col_alloc) posinrhscomp_col = 0
2210 iposinrhscomp_row = 0
2211 iposinrhscomp_col = 0
2212 DO i = 1, nbcol_inbloc
2213 IF ((irhs_ptr(i+1)-irhs_ptr(i)).EQ.0) cycle
2214 IF (keep(242).NE.0) THEN
2215 jam1 = perm_rhs(jbeg_rhs+i-1)
2216 ELSE
2217 jam1 = jbeg_rhs+i-1
2218 END IF
2219 istep = abs(step(jam1))
2220 go_up = .true.
2221 DO WHILE(go_up)
2222 IF(myid_nodes.EQ.
2223 & mumps_procnode(procnode_steps(istep),keep(199))) THEN
2224 CALL mumps_sol_get_npiv_liell_ipos( istep, keep,
2225 & npiv, liell, ipos, iw, liw, ptrist, step, n )
2226 IF (mtype.eq.1 .OR. keep(50).NE.0) THEN
2227 j1=ipos+1
2228 ELSE
2229 j1=ipos+1+liell
2230 END IF
2231 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
2232 jcol = ipos+1+liell
2233 ELSE
2234 jcol = ipos+1
2235 ENDIF
2236 IF(npiv.GT.0) THEN
2237 IF(posinrhscomp_row(iw(j1)).EQ.0) THEN
2238 DO jj = j1, j1+npiv-1
2239 posinrhscomp_row(iw(jj))
2240 & = iposinrhscomp_row + jj - j1 + 1
2241 ENDDO
2242 iposinrhscomp_row = iposinrhscomp_row + npiv
2243 IF (posinrhscomp_col_alloc) THEN
2244 DO jj = jcol, jcol+npiv-1
2245 posinrhscomp_col(iw(jj))
2246 & = - n - (iposinrhscomp_col + jj - jcol + 1)
2247 ENDDO
2248 iposinrhscomp_col = iposinrhscomp_col + npiv
2249 ENDIF
2250 ELSE
2251 go_up = .false.
2252 END IF
2253 END IF
2254 END IF
2255 IF(dad(istep).NE.0) THEN
2256 istep = step(dad(istep))
2257 ELSE
2258 go_up = .false.
2259 END IF
2260 END DO
2261 END DO
2262 nb_fs_in_rhscomp_fwd = iposinrhscomp_row
2263 IF(posinrhscomp_col_alloc) THEN
2264 DO i =1, nz_rhs
2265 jam1 = irhs_sparse(i)
2266 IF (keep(23).NE.0) jam1 = uns_perm_inv(jam1)
2267 istep = abs(step(jam1))
2268 go_up = .true.
2269 DO WHILE(go_up)
2270 IF(myid_nodes.EQ.
2271 & mumps_procnode(procnode_steps(istep),keep(199))) THEN
2272 CALL mumps_sol_get_npiv_liell_ipos( istep, keep,
2273 & npiv, liell, ipos, iw, liw, ptrist, step, n )
2274 IF (mtype.eq.1 .OR. keep(50).NE.0) THEN
2275 j1=ipos+1
2276 ELSE
2277 j1=ipos+1+liell
2278 END IF
2279 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
2280 jcol = ipos+1+liell
2281 ELSE
2282 jcol = ipos+1
2283 ENDIF
2284 absjcol = abs(iw(jcol))
2285 IF(npiv.GT.0) THEN
2286 IF(posinrhscomp_col(absjcol).EQ.0) THEN
2287 DO jj = jcol, jcol+npiv-1
2288 posinrhscomp_col(abs(iw(jj))) =
2289 & iposinrhscomp_col+jj-jcol+1
2290 END DO
2291 iposinrhscomp_col = iposinrhscomp_col + npiv
2292 ELSE IF (posinrhscomp_col(absjcol).LT.-n) THEN
2293 DO jj = jcol, jcol+npiv-1
2294 posinrhscomp_col(abs(iw(jj)))=
2295 & -(n+posinrhscomp_col(abs(iw(jj))))
2296 END DO
2297 ELSE IF ((posinrhscomp_col(absjcol).LT.0).AND.
2298 & (posinrhscomp_col(absjcol).GE.-n))THEN
2299 WRITE(*,*)'Internal error 7 in BUILD...SPARSE'
2300 CALL mumps_abort()
2301 ELSE
2302 go_up = .false.
2303 END IF
2304 END IF
2305 END IF
2306 IF(dad(istep).NE.0) THEN
2307 istep = step(dad(istep))
2308 ELSE
2309 go_up = .false.
2310 END IF
2311 END DO
2312 END DO
2313 END IF
2314 nb_fs_in_rhscomp_tot = iposinrhscomp_col
2315 IF (nslaves.NE.1) THEN
2316 DO i = 1, nbcol_inbloc
2317 IF ((irhs_ptr(i+1)-irhs_ptr(i)).EQ.0) cycle
2318 IF (keep(242).NE.0) THEN
2319 jam1 = perm_rhs(jbeg_rhs+i-1)
2320 ELSE
2321 jam1 = jbeg_rhs+i-1
2322 END IF
2323 istep = abs(step(jam1))
2324 go_up = .true.
2325 DO WHILE(go_up)
2326 IF(myid_nodes.EQ.
2327 & mumps_procnode(procnode_steps(istep),keep(199))) THEN
2328 CALL mumps_sol_get_npiv_liell_ipos( istep, keep,
2329 & npiv, liell, ipos, iw, liw, ptrist, step, n )
2330 IF (mtype.eq.1 .OR. keep(50).NE.0) THEN
2331 j1=ipos+1
2332 ELSE
2333 j1=ipos+1+liell
2334 END IF
2335 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
2336 jcol = ipos+1+liell
2337 ELSE
2338 jcol = ipos+1
2339 ENDIF
2340 DO jj = npiv, liell-1-keep(253)
2341 IF(posinrhscomp_row(iw(j1+jj)).EQ.0) THEN
2342 iposinrhscomp_row = iposinrhscomp_row + 1
2343 posinrhscomp_row(iw(jj+j1))
2344 & = -iposinrhscomp_row
2345 END IF
2346 END DO
2347 END IF
2348 IF(dad(istep).GT.0) THEN
2349 oldistep=istep
2350 istep = step(dad(istep))
2351 dad(oldistep)=-dad(oldistep)
2352 ELSE
2353 go_up = .false.
2354 END IF
2355 END DO
2356 END DO
2357 dad=abs(dad)
2358 IF(posinrhscomp_col_alloc) THEN
2359 DO i =1, nz_rhs
2360 jam1 = irhs_sparse(i)
2361 IF (keep(23).NE.0) jam1 = uns_perm_inv(jam1)
2362 istep = abs(step(jam1))
2363 go_up = .true.
2364 DO WHILE(go_up)
2365 IF(myid_nodes.EQ.
2366 & mumps_procnode(procnode_steps(istep),keep(199))) THEN
2367 CALL mumps_sol_get_npiv_liell_ipos( istep, keep,
2368 & npiv, liell, ipos, iw, liw, ptrist, step, n )
2369 IF (mtype.eq.1 .OR. keep(50).NE.0) THEN
2370 j1=ipos+1
2371 ELSE
2372 j1=ipos+1+liell
2373 END IF
2374 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
2375 jcol = ipos+1+liell
2376 ELSE
2377 jcol = ipos+1
2378 ENDIF
2379 IF (keep(23).NE.0) jam1 = uns_perm_inv(jam1)
2380 DO jj = npiv, liell-1-keep(253)
2381 IF(posinrhscomp_col(iw(jcol+jj)).EQ.0) THEN
2382 iposinrhscomp_col = iposinrhscomp_col + 1
2383 posinrhscomp_col(iw(jcol+jj))
2384 & = -iposinrhscomp_col
2385 ELSE IF (posinrhscomp_col(iw(jcol+jj)).LT.-n) THEN
2386 iposinrhscomp_col = iposinrhscomp_col + 1
2387 posinrhscomp_col(iw(jcol+jj))
2388 & = posinrhscomp_col(iw(jcol+jj)) + n
2389 END IF
2390 END DO
2391 END IF
2392 IF(dad(istep).GT.0) THEN
2393 oldistep=istep
2394 istep = step(dad(istep))
2395 dad(oldistep)=-dad(oldistep)
2396 ELSE
2397 go_up = .false.
2398 END IF
2399 END DO
2400 END DO
2401 dad=abs(dad)
2402 END IF
2403 ENDIF
2404 nbent_rhscomp_row = iposinrhscomp_row
2405 nbent_rhscomp_col = iposinrhscomp_col
2406 nbent_rhscomp = max(nbent_rhscomp_row,nbent_rhscomp_col)
2407 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25

◆ zmumps_distributed_solution()

subroutine zmumps_distributed_solution ( integer slavef,
integer n,
integer myid_nodes,
integer mtype,
complex(kind=8), dimension( lrhscomp, nbrhs_eff ) rhscomp,
integer lrhscomp,
integer nbrhs_eff,
integer, dimension(n) posinrhscomp,
integer, dimension(lsol_loc) isol_loc,
complex(kind=8), dimension( lsol_loc, nrhs ) sol_loc,
integer, intent(in) nrhs,
integer beg_rhs,
integer lsol_loc,
integer, dimension(keep(28)) ptrist,
integer, dimension(keep(28)) procnode_steps,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer, dimension(liw) iw,
integer liw,
integer, dimension(n) step,
type (scaling_data_t) scaling_data,
logical lscal,
integer nb_rhsskipped,
integer, dimension( size_perm_rhs ), intent(in) perm_rhs,
integer, intent(in) size_perm_rhs )

Definition at line 1709 of file zsol_c.F.

1719 IMPLICIT NONE
1720 include 'mpif.h'
1721 include 'mumps_tags.h'
1722 type scaling_data_t
1723 sequence
1724 DOUBLE PRECISION, dimension(:), pointer :: SCALING
1725 DOUBLE PRECISION, dimension(:), pointer :: SCALING_LOC
1726 end type scaling_data_t
1727 TYPE (scaling_data_t) :: scaling_data
1728 LOGICAL LSCAL
1729 INTEGER SLAVEF, N, MYID_NODES, LIW, MTYPE, NBRHS_EFF, LRHSCOMP
1730 INTEGER POSINRHSCOMP(N), NB_RHSSKIPPED
1731 INTEGER LSOL_LOC, BEG_RHS
1732 INTEGER ISOL_LOC(LSOL_LOC)
1733 INTEGER, INTENT(in) :: NRHS
1734 COMPLEX(kind=8) SOL_LOC( LSOL_LOC, NRHS )
1735 COMPLEX(kind=8) RHSCOMP( LRHSCOMP, NBRHS_EFF )
1736 INTEGER KEEP(500)
1737 INTEGER(8) KEEP8(150)
1738 INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28))
1739 INTEGER IW(LIW), STEP(N)
1740 INTEGER, INTENT(in) :: SIZE_PERM_RHS
1741 INTEGER, INTENT(in) :: PERM_RHS( SIZE_PERM_RHS )
1742 INTEGER :: JJ, J1, ISTEP, K, KLOC, IPOSINRHSCOMP, JEMPTY
1743 INTEGER :: JCOL, JCOL_PERM
1744 INTEGER :: IPOS, LIELL, NPIV, JEND
1745 LOGICAL :: ROOT
1746!$ LOGICAL :: OMP_FLAG
1747 COMPLEX(kind=8), PARAMETER :: ZERO = (0.0d0,0.0d0)
1748 include 'mumps_headers.h'
1749 INTEGER MUMPS_PROCNODE
1750 EXTERNAL mumps_procnode
1751 k=0
1752 jempty = beg_rhs+nb_rhsskipped-1
1753 jend = beg_rhs+nb_rhsskipped+nbrhs_eff-1
1754 DO istep = 1, keep(28)
1755 IF (myid_nodes == mumps_procnode(procnode_steps(istep),
1756 & keep(199))) THEN
1757 root=.false.
1758 IF (keep(38).ne.0) root = step(keep(38))==istep
1759 IF (keep(20).ne.0) root = step(keep(20))==istep
1760 IF ( root ) THEN
1761 ipos = ptrist(istep) + keep(ixsz)
1762 liell = iw(ipos+3)
1763 npiv = liell
1764 ipos= ptrist(istep)+5+keep(ixsz)
1765 ELSE
1766 ipos = ptrist(istep) + 2 +keep(ixsz)
1767 liell = iw(ipos-2)+iw(ipos+1)
1768 ipos= ipos+1
1769 npiv = iw(ipos)
1770 ipos= ipos+1
1771 ipos= ipos+1+iw( ptrist(istep) + 5 +keep(ixsz))
1772 END IF
1773 IF (mtype.eq.1 .AND. keep(50).EQ.0) THEN
1774 j1=ipos+1+liell
1775 ELSE
1776 j1=ipos+1
1777 END IF
1778 IF (nb_rhsskipped.GT.0) THEN
1779 DO jcol = beg_rhs, jempty
1780 IF (keep(242) .NE. 0) THEN
1781 jcol_perm = perm_rhs(jcol)
1782 ELSE
1783 jcol_perm = jcol
1784 ENDIF
1785 kloc=k
1786 DO jj=j1,j1+npiv-1
1787 kloc=kloc+1
1788 sol_loc(kloc, jcol_perm) = zero
1789 ENDDO
1790 ENDDO
1791 ENDIF
1792!$ OMP_FLAG = ( JEND-JEMPTY.GE.KEEP(362) .AND.
1793!$ & (NPIV*(JEND-JEMPTY) .GE. KEEP(363)/2 ) )
1794!$OMP PARALLEL DO PRIVATE(JCOL,JCOL_PERM,KLOC,JJ,IPOSINRHSCOMP)
1795!$OMP& IF(OMP_FLAG)
1796 DO jcol = jempty+1, jend
1797 IF (keep(242) .NE. 0) THEN
1798 jcol_perm = perm_rhs(jcol)
1799 ELSE
1800 jcol_perm = jcol
1801 ENDIF
1802 DO jj=j1,j1+npiv-1
1803 kloc=k + jj-j1 + 1
1804 iposinrhscomp = posinrhscomp(iw(jj))
1805 IF (lscal) THEN
1806 sol_loc(kloc,jcol_perm) =
1807 & scaling_data%SCALING_LOC(kloc)*
1808 & rhscomp(iposinrhscomp,jcol-jempty)
1809 ELSE
1810 sol_loc(kloc,jcol_perm) =
1811 & rhscomp(iposinrhscomp,jcol-jempty)
1812 ENDIF
1813 ENDDO
1814 ENDDO
1815!$OMP END PARALLEL DO
1816 k=k+npiv
1817 ENDIF
1818 ENDDO
1819 RETURN

◆ zmumps_distsol_indices()

subroutine zmumps_distsol_indices ( integer mtype,
integer, dimension(keep(89)) isol_loc,
integer, dimension(keep(28)) ptrist,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer, dimension(liw_passed) iw,
integer liw_passed,
integer myid_nodes,
integer n,
integer, dimension(n) step,
integer, dimension(keep(28)) procnode,
integer nslaves,
type (scaling_data_t) scaling_data,
logical lscal,
logical irhs_loc_meaningful,
integer, dimension(nloc_rhs) irhs_loc,
integer nloc_rhs )

Definition at line 1638 of file zsol_c.F.

1644 IMPLICIT NONE
1645 INTEGER MTYPE, MYID_NODES, N, NSLAVES
1646 INTEGER KEEP(500)
1647 INTEGER(8) KEEP8(150)
1648 INTEGER PTRIST(KEEP(28)), PROCNODE(KEEP(28))
1649 INTEGER ISOL_LOC(KEEP(89))
1650 INTEGER LIW_PASSED
1651 INTEGER IW(LIW_PASSED)
1652 INTEGER STEP(N)
1653 LOGICAL LSCAL
1654 LOGICAL :: IRHS_loc_MEANINGFUL
1655 INTEGER :: Nloc_RHS
1656 INTEGER :: IRHS_loc(Nloc_RHS)
1657 type scaling_data_t
1658 sequence
1659 DOUBLE PRECISION, dimension(:), pointer :: SCALING
1660 DOUBLE PRECISION, dimension(:), pointer :: SCALING_LOC
1661 end type scaling_data_t
1662 type (scaling_data_t) :: scaling_data
1663 INTEGER MUMPS_PROCNODE
1664 EXTERNAL mumps_procnode
1665 INTEGER ISTEP, K
1666 INTEGER J1, IPOS, LIELL, NPIV, JJ
1667 LOGICAL :: CHECK_IRHS_loc
1668 INTEGER(8) :: DIFF_ADDR
1669 include 'mumps_headers.h'
1670 check_irhs_loc=.false.
1671 IF ( irhs_loc_meaningful ) THEN
1672 IF (nloc_rhs .GT. 0) THEN
1673 CALL mumps_size_c( irhs_loc(1), isol_loc(1),
1674 & diff_addr )
1675 IF (diff_addr .EQ. 0_8) THEN
1676 check_irhs_loc=.true.
1677 ENDIF
1678 ENDIF
1679 ENDIF
1680 k=0
1681 DO istep=1, keep(28)
1682 IF ( myid_nodes == mumps_procnode( procnode(istep),
1683 & keep(199))) THEN
1684 CALL mumps_sol_get_npiv_liell_ipos( istep, keep,
1685 & npiv, liell, ipos, iw, liw_passed, ptrist, step, n)
1686 IF (mtype.eq.1 .AND. keep(50).EQ.0) THEN
1687 j1=ipos+1+liell
1688 ELSE
1689 j1=ipos+1
1690 END IF
1691 DO jj=j1,j1+npiv-1
1692 k=k+1
1693 IF (check_irhs_loc) THEN
1694 IF (k.LE.nloc_rhs) THEN
1695 IF ( iw(jj) .NE.irhs_loc(k) ) THEN
1696 ENDIF
1697 ENDIF
1698 ENDIF
1699 isol_loc(k)=iw(jj)
1700 IF (lscal) THEN
1701 scaling_data%SCALING_LOC(k)=
1702 & scaling_data%SCALING(iw(jj))
1703 ENDIF
1704 ENDDO
1705 ENDIF
1706 ENDDO
1707 RETURN

◆ zmumps_gather_solution()

subroutine zmumps_gather_solution ( integer nslaves,
integer n,
integer myid,
integer comm,
integer nrhs,
integer mtype,
complex(kind=8), dimension (lrhs, ncol_rhs) rhs,
integer lrhs,
integer ncol_rhs,
integer, intent(in) jbeg_rhs,
integer, dimension(keep(28)) ptrist,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer, dimension(keep(28)) procnode_steps,
integer, dimension(liw) iw,
integer liw,
integer, dimension(n) step,
integer, dimension(size_buf) buffer,
integer size_buf,
integer size_buf_bytes,
complex(kind=8), dimension(lcwork) cwork,
integer lcwork,
logical, intent(in) lscal,
double precision, dimension(lscaling), intent(in) scaling,
integer, intent(in) lscaling,
complex(kind=8), dimension(lrhscomp, ncol_rhscomp), intent(in) rhscomp,
integer lrhscomp,
integer ncol_rhscomp,
integer, dimension(lpos_n) posinrhscomp,
integer lpos_n,
integer, dimension(size_perm_rhs), intent(in) perm_rhs,
integer, intent(in) size_perm_rhs )

Definition at line 1075 of file zsol_c.F.

1083!$ USE OMP_LIB
1084 IMPLICIT NONE
1085 include 'mpif.h'
1086 include 'mumps_tags.h'
1087 INTEGER NSLAVES, N, MYID, COMM, LIW, MTYPE, NCOL_RHS
1088 INTEGER NRHS, LRHS, LCWORK, LPOS_N, NCOL_RHSCOMP
1089 COMPLEX(kind=8) RHS (LRHS, NCOL_RHS)
1090 INTEGER, INTENT(in) :: JBEG_RHS
1091 INTEGER KEEP(500)
1092 INTEGER(8) KEEP8(150)
1093 COMPLEX(kind=8) :: CWORK(LCWORK)
1094 INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28))
1095 INTEGER IW(LIW), STEP(N)
1096 INTEGER SIZE_BUF, SIZE_BUF_BYTES
1097 INTEGER BUFFER(SIZE_BUF)
1098 INTEGER LRHSCOMP, POSINRHSCOMP(LPOS_N)
1099 COMPLEX(kind=8), intent(in) :: RHSCOMP(LRHSCOMP, NCOL_RHSCOMP)
1100 LOGICAL, intent(in) :: LSCAL
1101 INTEGER, intent(in) :: LSCALING
1102 DOUBLE PRECISION, intent(in) :: SCALING(LSCALING)
1103 INTEGER, INTENT(in) :: SIZE_PERM_RHS
1104 INTEGER, INTENT(in) :: PERM_RHS(SIZE_PERM_RHS)
1105 INTEGER I, II, J, J1, ISTEP, MASTER,
1106 & MYID_NODES, TYPE_PARAL, N2RECV
1107 INTEGER LIELL, IPOS, NPIV, MAXNPIV_estim, MAXSurf
1108 INTEGER :: STATUS(MPI_STATUS_SIZE)
1109 INTEGER :: IERR, allocok
1110 parameter(master=0)
1111 LOGICAL I_AM_SLAVE
1112 INTEGER RECORD_SIZE_P_1, SIZE1, SIZE2
1113 INTEGER POS_BUF, N2SEND, IPOSINRHSCOMP
1114 INTEGER :: JCOL_RHS
1115 INTEGER :: K242
1116 LOGICAL :: OMP_FLAG
1117!$ INTEGER :: CHUNK, NOMP
1118 INTEGER, PARAMETER :: FIN = -1
1119 COMPLEX(kind=8) ZERO
1120 parameter( zero = (0.0d0,0.0d0) )
1121 INTEGER, ALLOCATABLE, DIMENSION(:) :: IROWlist
1122 include 'mumps_headers.h'
1123 INTEGER, EXTERNAL :: MUMPS_PROCNODE
1124 type_paral = keep(46)
1125 i_am_slave = myid .ne. master .OR. type_paral .eq. 1
1126 IF ( type_paral == 1 ) THEN
1127 myid_nodes = myid
1128 ELSE
1129 myid_nodes = myid-1
1130 ENDIF
1131 IF (nslaves.EQ.1 .AND. type_paral.EQ.1) THEN
1132 IF (lscal) THEN
1133 omp_flag = .false.
1134 IF (keep(350).EQ.2) THEN
1135 k242 = keep(242)
1136!$ NOMP = OMP_GET_MAX_THREADS()
1137!$ CHUNK = max(N/2,1)
1138!$ IF (int(nrhs,8) * int(n,8) .GE. int(keep(363),8)) THEN
1139!$ OMP_FLAG = .TRUE.
1140!$ CHUNK=int((int(N,8)*int(NRHS,8)+int(NOMP-1,8))/int(NOMP,8))
1141!$ CHUNK = min(CHUNK,(N+KEEP(362)-1)/KEEP(362))
1142!$ CHUNK = max(KEEP(363)/2,CHUNK)
1143!$ ENDIF
1144 ENDIF
1145 IF (omp_flag) THEN
1146!$OMP PARALLEL FIRSTPRIVATE(JBEG_RHS,N,K242)
1147!$OMP& PRIVATE(J,IPOSINRHSCOMP,I,JCOL_RHS)
1148 DO j=1, nrhs
1149 IF (k242.EQ.0) THEN
1150 jcol_rhs = j+jbeg_rhs-1
1151 ELSE
1152 jcol_rhs = perm_rhs(j+jbeg_rhs-1)
1153 ENDIF
1154!$OMP DO SCHEDULE(DYNAMIC,CHUNK)
1155 DO i=1, n
1156 iposinrhscomp = posinrhscomp(i)
1157 IF (iposinrhscomp.GT.0) THEN
1158 rhs(i,jcol_rhs) =
1159 & rhscomp(iposinrhscomp,j)*scaling(i)
1160 ELSE
1161 rhs(i,jcol_rhs) = zero
1162 ENDIF
1163 ENDDO
1164!$OMP END DO NOWAIT
1165 ENDDO
1166!$OMP END PARALLEL
1167 ELSE
1168 DO j=1, nrhs
1169 IF (keep(242).EQ.0) THEN
1170 jcol_rhs = j+jbeg_rhs-1
1171 ELSE
1172 jcol_rhs = perm_rhs(j+jbeg_rhs-1)
1173 ENDIF
1174 DO i=1, n
1175 iposinrhscomp = posinrhscomp(i)
1176 IF (iposinrhscomp.GT.0) THEN
1177 rhs(i,jcol_rhs) =
1178 & rhscomp(iposinrhscomp,j)*scaling(i)
1179 ELSE
1180 rhs(i,jcol_rhs) = zero
1181 ENDIF
1182 ENDDO
1183 ENDDO
1184 ENDIF
1185 ELSE
1186 omp_flag = .false.
1187 IF (keep(350).EQ.2) THEN
1188 k242 = keep(242)
1189!$ NOMP = OMP_GET_MAX_THREADS()
1190!$ OMP_FLAG = .FALSE.
1191!$ chunk = max(n/2,1)
1192!$ IF (NRHS * N .GE. KEEP(363)) THEN
1193!$ omp_flag = .true.
1194!$ CHUNK=int((int(N,8)*int(NRHS,8)+int(NOMP-1,8))/int(NOMP,8))
1195!$ CHUNK = min(CHUNK,(N+KEEP(362)-1)/KEEP(362))
1196!$ CHUNK = max(KEEP(363)/2,CHUNK)
1197!$ ENDIF
1198 ENDIF
1199 IF (omp_flag) THEN
1200!$OMP PARALLEL FIRSTPRIVATE(JBEG_RHS,N,K242)
1201!$OMP& PRIVATE(IPOSINRHSCOMP,I,JCOL_RHS) IF (OMP_FLAG)
1202 DO j=1, nrhs
1203 IF (k242.EQ.0) THEN
1204 jcol_rhs = j+jbeg_rhs-1
1205 ELSE
1206 jcol_rhs = perm_rhs(j+jbeg_rhs-1)
1207 ENDIF
1208!$OMP DO SCHEDULE(DYNAMIC,CHUNK)
1209 DO i=1, n
1210 iposinrhscomp = posinrhscomp(i)
1211 IF (iposinrhscomp.GT.0) THEN
1212 rhs(i,jcol_rhs) = rhscomp(iposinrhscomp,j)
1213 ELSE
1214 rhs(i,jcol_rhs) = zero
1215 ENDIF
1216 ENDDO
1217!$OMP END DO NOWAIT
1218 ENDDO
1219!$OMP END PARALLEL
1220 ELSE
1221 DO j=1, nrhs
1222 IF (keep(242).EQ.0) THEN
1223 jcol_rhs = j+jbeg_rhs-1
1224 ELSE
1225 jcol_rhs = perm_rhs(j+jbeg_rhs-1)
1226 ENDIF
1227 DO i=1, n
1228 iposinrhscomp = posinrhscomp(i)
1229 IF (iposinrhscomp.GT.0) THEN
1230 rhs(i,jcol_rhs) = rhscomp(iposinrhscomp,j)
1231 ELSE
1232 rhs(i,jcol_rhs) = zero
1233 ENDIF
1234 ENDDO
1235 ENDDO
1236 ENDIF
1237 ENDIF
1238 RETURN
1239 ENDIF
1240 maxnpiv_estim = max(keep(246), keep(247))
1241 maxsurf = maxnpiv_estim*nrhs
1242 IF (lcwork .LT. maxnpiv_estim) THEN
1243 WRITE(*,*) myid,
1244 & ": Internal error 2 in ZMUMPS_GATHER_SOLUTION:",
1245 & type_paral, lcwork, keep(247), nrhs
1246 CALL mumps_abort()
1247 ENDIF
1248 IF (myid.EQ.master) THEN
1249 ALLOCATE(irowlist(keep(247)),stat=allocok)
1250 IF(allocok.GT.0) THEN
1251 WRITE(*,*)'Problem with allocation of IROWlist'
1252 CALL mumps_abort()
1253 ENDIF
1254 ENDIF
1255 IF (nslaves .EQ. 1 .AND. type_paral .EQ. 1) THEN
1256 CALL mumps_abort()
1257 ENDIF
1258 size1=0
1259 CALL mpi_pack_size(maxnpiv_estim+2,mpi_integer, comm,
1260 & size1, ierr)
1261 size2=0
1262 CALL mpi_pack_size(maxsurf,mpi_double_complex, comm,
1263 & size2, ierr)
1264 record_size_p_1= size1+size2
1265 IF (record_size_p_1.GT.size_buf_bytes) THEN
1266 write(6,*) myid,
1267 & ' internal error 3 in zmumps_gather_solution '
1268 write(6,*) MYID, ' record_size_p_1, size_buf_bytes=',
1269 & RECORD_SIZE_P_1, SIZE_BUF_BYTES
1270 CALL MUMPS_ABORT()
1271 ENDIF
1272 N2SEND =0
1273 N2RECV =N
1274 POS_BUF =0
1275 IF (I_AM_SLAVE) THEN
1276 POS_BUF = 0
1277 DO ISTEP = 1, KEEP(28)
1278 IF (MYID_NODES == MUMPS_PROCNODE(PROCNODE_STEPS(ISTEP),
1279 & KEEP(199))) THEN
1280 CALL MUMPS_SOL_GET_NPIV_LIELL_IPOS( ISTEP, KEEP,
1281 & NPIV, LIELL, IPOS, IW, LIW, PTRIST, STEP, N)
1282.eq..AND..EQ. IF (MTYPE1 KEEP(50)0) THEN
1283 J1=IPOS+1+LIELL
1284 ELSE
1285 J1=IPOS+1
1286 END IF
1287.EQ. IF (MYID MASTER) THEN
1288 N2RECV=N2RECV-NPIV
1289.GT. IF (NPIV0)
1290 & CALL ZMUMPS_NPIV_BLOCK_ADD ( .TRUE. )
1291 ELSE
1292.GT. IF (NPIV0)
1293 & CALL ZMUMPS_NPIV_BLOCK_ADD ( .FALSE.)
1294 ENDIF
1295 ENDIF
1296 ENDDO
1297 CALL ZMUMPS_NPIV_BLOCK_SEND()
1298 ENDIF
1299.EQ. IF ( MYID MASTER ) THEN
1300.NE. DO WHILE (N2RECV 0)
1301 CALL MPI_RECV( BUFFER, SIZE_BUF_BYTES, MPI_PACKED,
1302 & MPI_ANY_SOURCE,
1303 & GatherSol, COMM, STATUS, IERR )
1304 POS_BUF = 0
1305 CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF,
1306 & NPIV, 1, MPI_INTEGER, COMM, IERR)
1307.NE. DO WHILE (NPIVFIN)
1308 CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF,
1309 & IROWlist, NPIV, MPI_INTEGER, COMM, IERR)
1310 DO J=1, NRHS
1311.EQ. IF (KEEP(242)0) THEN
1312 JCOL_RHS=J+JBEG_RHS-1
1313 ELSE
1314 JCOL_RHS=PERM_RHS(J+JBEG_RHS-1)
1315 ENDIF
1316 CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF,
1317 & CWORK, NPIV, MPI_DOUBLE_COMPLEX,
1318 & COMM, IERR)
1319 IF (LSCAL) THEN
1320 DO I=1,NPIV
1321 RHS(IROWlist(I),JCOL_RHS)=CWORK(I)*SCALING(IROWlist(I))
1322 ENDDO
1323 ELSE
1324 DO I=1,NPIV
1325 RHS(IROWlist(I),JCOL_RHS)=CWORK(I)
1326 ENDDO
1327 ENDIF
1328 ENDDO
1329 N2RECV=N2RECV-NPIV
1330 CALL MPI_UNPACK( BUFFER, SIZE_BUF_BYTES, POS_BUF,
1331 & NPIV, 1, MPI_INTEGER, COMM, IERR)
1332 ENDDO
1333 ENDDO
1334 DEALLOCATE(IROWlist)
1335 ENDIF
1336 RETURN
1337 CONTAINS
1338 SUBROUTINE ZMUMPS_NPIV_BLOCK_ADD ( ON_MASTER )
1339 LOGICAL, intent(in) :: ON_MASTER
1340 INTEGER :: JPOS, K242
1341 LOGICAL :: LOCAL_LSCAL
1342 IF (ON_MASTER) THEN
1343.EQ. IF (KEEP(350)2
1344.AND..EQ..OR..GE. & (NRHS1((NPIV*NRHS*2*KEEP(16))KEEP(364)))) THEN
1345 LOCAL_LSCAL = LSCAL
1346 K242 = KEEP(242)
1347 DO J=1, NRHS
1348.EQ. IF (K2420) THEN
1349 JPOS = J+JBEG_RHS-1
1350 ELSE
1351 JPOS = PERM_RHS(J+JBEG_RHS-1)
1352 ENDIF
1353 DO II=1,NPIV
1354 I=IW(J1+II-1)
1355 IPOSINRHSCOMP= POSINRHSCOMP(I)
1356 IF (LOCAL_LSCAL) THEN
1357 RHS(I,JPOS) = RHSCOMP(IPOSINRHSCOMP,J)*SCALING(I)
1358 ELSE
1359 RHS(I,JPOS) = RHSCOMP(IPOSINRHSCOMP,J)
1360 ENDIF
1361 ENDDO
1362 ENDDO
1363 ELSE
1364.EQ. IF (KEEP(242)0) THEN
1365 IF (LSCAL) THEN
1366 DO II=1,NPIV
1367 I=IW(J1+II-1)
1368 IPOSINRHSCOMP= POSINRHSCOMP(I)
1369 DO J=1, NRHS
1370 RHS(I,J+JBEG_RHS-1) =
1371 & RHSCOMP(IPOSINRHSCOMP,J)*SCALING(I)
1372 ENDDO
1373 ENDDO
1374 ELSE
1375 DO II=1,NPIV
1376 I=IW(J1+II-1)
1377 IPOSINRHSCOMP= POSINRHSCOMP(I)
1378 DO J=1, NRHS
1379 RHS(I,J+JBEG_RHS-1) = RHSCOMP(IPOSINRHSCOMP,J)
1380 ENDDO
1381 ENDDO
1382 ENDIF
1383 ELSE
1384 IF (LSCAL) THEN
1385 DO II=1,NPIV
1386 I=IW(J1+II-1)
1387 IPOSINRHSCOMP= POSINRHSCOMP(I)
1388!DIR$ NOVECTOR
1389 DO J=1, NRHS
1390 RHS(I,PERM_RHS(J+JBEG_RHS-1)) =
1391 & RHSCOMP(IPOSINRHSCOMP,J)*SCALING(I)
1392 ENDDO
1393 ENDDO
1394 ELSE
1395 DO II=1,NPIV
1396 I=IW(J1+II-1)
1397 IPOSINRHSCOMP= POSINRHSCOMP(I)
1398!DIR$ NOVECTOR
1399 DO J=1, NRHS
1400 RHS(I,PERM_RHS(J+JBEG_RHS-1)) =
1401 & RHSCOMP(IPOSINRHSCOMP,J)
1402 ENDDO
1403 ENDDO
1404 ENDIF
1405 ENDIF
1406 ENDIF
1407 RETURN
1408 ENDIF
1409 CALL MPI_PACK(NPIV, 1, MPI_INTEGER, BUFFER,
1410 & SIZE_BUF_BYTES, POS_BUF, COMM, IERR )
1411 CALL MPI_PACK(IW(J1), NPIV, MPI_INTEGER, BUFFER,
1412 & SIZE_BUF_BYTES, POS_BUF, COMM, IERR )
1413 IPOSINRHSCOMP= POSINRHSCOMP(IW(J1))
1414 DO J=1,NRHS
1415 CALL MPI_PACK(RHSCOMP(IPOSINRHSCOMP,J), NPIV,
1416 & MPI_DOUBLE_COMPLEX,
1417 & BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM,
1418 & IERR)
1419 ENDDO
1420 N2SEND=N2SEND+NPIV
1421 IF ( POS_BUF + RECORD_SIZE_P_1 > SIZE_BUF_BYTES ) THEN
1422 CALL ZMUMPS_NPIV_BLOCK_SEND()
1423 END IF
1424 RETURN
1425 END SUBROUTINE ZMUMPS_NPIV_BLOCK_ADD
1426 SUBROUTINE ZMUMPS_NPIV_BLOCK_SEND()
1427.NE. IF (N2SEND 0) THEN
1428 CALL MPI_PACK(FIN, 1, MPI_INTEGER, BUFFER,
1429 & SIZE_BUF_BYTES, POS_BUF, COMM, IERR )
1430 CALL MPI_SEND(BUFFER, POS_BUF, MPI_PACKED, MASTER,
1431 & GatherSol, COMM, IERR)
1432 ENDIF
1433 POS_BUF=0
1434 N2SEND=0
1435 RETURN
1436 END SUBROUTINE ZMUMPS_NPIV_BLOCK_SEND
mpi_pack_size
subroutine mpi_pack_size(incnt, datatype, comm, size, ierr)
Definition mpi.f:439
zmumps_gather_solution
subroutine zmumps_gather_solution(nslaves, n, myid, comm, nrhs, mtype, rhs, lrhs, ncol_rhs, jbeg_rhs, ptrist, keep, keep8, procnode_steps, iw, liw, step, buffer, size_buf, size_buf_bytes, cwork, lcwork, lscal, scaling, lscaling, rhscomp, lrhscomp, ncol_rhscomp, posinrhscomp, lpos_n, perm_rhs, size_perm_rhs)
Definition zsol_c.F:1083

◆ zmumps_gather_solution_am1()

subroutine zmumps_gather_solution_am1 ( integer nslaves,
integer n,
integer myid,
integer comm,
integer nrhs,
complex(kind=8), dimension (lrhscomp, nrhscomp_col), intent(in) rhscomp,
integer lrhscomp,
integer nrhscomp_col,
integer, dimension(500) keep,
integer, dimension(size_buf) buffer,
integer size_buf,
integer size_buf_bytes,
logical, intent(in) lscal,
double precision, dimension(lscaling), intent(in) scaling,
integer, intent(in) lscaling,
integer, dimension(lirhs_ptr_copy) irhs_ptr_copy,
integer, intent(in) lirhs_ptr_copy,
integer, dimension(lirhs_sparse_copy) irhs_sparse_copy,
integer, intent(in) lirhs_sparse_copy,
complex(kind=8), dimension(lrhs_sparse_copy) rhs_sparse_copy,
integer, intent(in) lrhs_sparse_copy,
integer, dimension(luns_perm_inv) uns_perm_inv,
integer, intent(in) luns_perm_inv,
integer, dimension(lpos_row) posinrhscomp,
integer lpos_row,
integer, intent(in) nb_fs_in_rhscomp )

Definition at line 1438 of file zsol_c.F.

1448 IMPLICIT NONE
1449 include 'mpif.h'
1450 include 'mumps_tags.h'
1451 INTEGER NSLAVES, N, MYID, COMM
1452 INTEGER NRHS, LRHSCOMP, NRHSCOMP_COL
1453 COMPLEX(kind=8), intent(in) :: RHSCOMP (LRHSCOMP, NRHSCOMP_COL)
1454 INTEGER KEEP(500)
1455 INTEGER SIZE_BUF, SIZE_BUF_BYTES, LPOS_ROW
1456 INTEGER BUFFER(SIZE_BUF)
1457 INTEGER, intent(in) :: LIRHS_PTR_COPY, LIRHS_SPARSE_COPY,
1458 & LRHS_SPARSE_COPY, LUNS_PERM_INV,
1459 & NB_FS_IN_RHSCOMP
1460 INTEGER :: IRHS_SPARSE_COPY(LIRHS_SPARSE_COPY),
1461 & IRHS_PTR_COPY(LIRHS_PTR_COPY),
1462 & UNS_PERM_INV(LUNS_PERM_INV),
1463 & POSINRHSCOMP(LPOS_ROW)
1464 COMPLEX(kind=8) :: RHS_SPARSE_COPY(LRHS_SPARSE_COPY)
1465 LOGICAL, intent(in) :: LSCAL
1466 INTEGER, intent(in) :: LSCALING
1467 DOUBLE PRECISION, intent(in) :: SCALING(LSCALING)
1468 INTEGER COLSIZE, K, IZ, IPREV, NBCOL_INBLOC
1469 INTEGER I, II, J, MASTER,
1470 & TYPE_PARAL, N2RECV, IPOSINRHSCOMP
1471 INTEGER :: STATUS(MPI_STATUS_SIZE)
1472 INTEGER :: IERR
1473 parameter(master=0)
1474 LOGICAL I_AM_SLAVE
1475 INTEGER RECORD_SIZE_P_1, SIZE1, SIZE2
1476 INTEGER POS_BUF, N2SEND
1477 INTEGER, PARAMETER :: FIN = -1
1478 include 'mumps_headers.h'
1479 type_paral = keep(46)
1480 i_am_slave = myid .ne. master .OR. type_paral .eq. 1
1481 nbcol_inbloc = size(irhs_ptr_copy)-1
1482 IF (nslaves.EQ.1 .AND. type_paral.EQ.1) THEN
1483 k=1
1484 DO j = 1, nbcol_inbloc
1485 colsize = irhs_ptr_copy(j+1) - irhs_ptr_copy(j)
1486 IF (colsize.EQ.0) cycle
1487 DO iz=irhs_ptr_copy(j), irhs_ptr_copy(j+1)-1
1488 i = irhs_sparse_copy(iz)
1489 IF (keep(23).NE.0) i = uns_perm_inv(i)
1490 iposinrhscomp = posinrhscomp(i)
1491 IF (iposinrhscomp.GT.0) THEN
1492 IF (lscal) THEN
1493 rhs_sparse_copy(iz)=
1494 & rhscomp(iposinrhscomp,k)*scaling(i)
1495 ELSE
1496 rhs_sparse_copy(iz)=rhscomp(iposinrhscomp,k)
1497 ENDIF
1498 ENDIF
1499 ENDDO
1500 k = k + 1
1501 ENDDO
1502 RETURN
1503 ENDIF
1504 IF (i_am_slave) THEN
1505 k=1
1506 DO j = 1, nbcol_inbloc
1507 colsize = irhs_ptr_copy(j+1) - irhs_ptr_copy(j)
1508 IF (colsize.EQ.0) cycle
1509 DO iz=irhs_ptr_copy(j), irhs_ptr_copy(j+1)-1
1510 i = irhs_sparse_copy(iz)
1511 IF (keep(23).NE.0) i = uns_perm_inv(i)
1512 iposinrhscomp = posinrhscomp(i)
1513 IF (iposinrhscomp.GT.0) THEN
1514 rhs_sparse_copy(iz)=rhscomp(iposinrhscomp,k)
1515 ENDIF
1516 ENDDO
1517 k = k + 1
1518 ENDDO
1519 ENDIF
1520 size1=0
1521 CALL mpi_pack_size(3,mpi_integer, comm,
1522 & size1, ierr)
1523 size2=0
1524 CALL mpi_pack_size(1,mpi_double_complex, comm,
1525 & size2, ierr)
1526 record_size_p_1= size1+size2
1527 IF (record_size_p_1.GT.size_buf_bytes) THEN
1528 write(6,*) myid,
1529 & ' Internal error 3 in ZMUMPS_GATHER_SOLUTION_AM1 '
1530 write(6,*) myid, ' RECORD_SIZE_P_1, SIZE_BUF_BYTES=',
1531 & record_size_p_1, size_buf_bytes
1532 CALL mumps_abort()
1533 ENDIF
1534 n2send =0
1535 n2recv =size(irhs_sparse_copy)
1536 pos_buf =0
1537 IF (i_am_slave) THEN
1538 DO j = 1, nbcol_inbloc
1539 colsize = irhs_ptr_copy(j+1) - irhs_ptr_copy(j)
1540 IF (colsize.LE.0) cycle
1541 k = 0
1542 DO iz=irhs_ptr_copy(j), irhs_ptr_copy(j+1)-1
1543 i = irhs_sparse_copy(iz)
1544 ii = i
1545 IF (keep(23).NE.0) ii = uns_perm_inv(i)
1546 iposinrhscomp = posinrhscomp(ii)
1547 IF (iposinrhscomp.GT.0) THEN
1548 IF (myid .EQ. master) THEN
1549 n2recv=n2recv-1
1550 IF (lscal)
1551 & CALL zmumps_am1_block_add ( .true. )
1552 irhs_sparse_copy( irhs_ptr_copy(j) + k) =
1553 & i
1554 rhs_sparse_copy( irhs_ptr_copy(j) + k) =
1555 & rhs_sparse_copy(iz)
1556 k = k+1
1557 ELSE
1558 CALL zmumps_am1_block_add ( .false. )
1559 ENDIF
1560 ENDIF
1561 ENDDO
1562 IF (myid.EQ.master)
1563 & irhs_ptr_copy(j) = irhs_ptr_copy(j) + k
1564 ENDDO
1565 CALL zmumps_am1_block_send()
1566 ENDIF
1567 IF ( myid .EQ. master ) THEN
1568 DO WHILE (n2recv .NE. 0)
1569 CALL mpi_recv( buffer, size_buf_bytes, mpi_packed,
1570 & mpi_any_source,
1571 & gathersol, comm, status, ierr )
1572 pos_buf = 0
1573 CALL mpi_unpack( buffer,size_buf_bytes, pos_buf,
1574 & j, 1, mpi_integer, comm, ierr)
1575 DO WHILE (j.NE.fin)
1576 iz = irhs_ptr_copy(j)
1577 CALL mpi_unpack( buffer,size_buf_bytes, pos_buf,
1578 & i, 1, mpi_integer, comm, ierr)
1579 irhs_sparse_copy(iz) = i
1580 CALL mpi_unpack(buffer, size_buf_bytes, pos_buf,
1581 & rhs_sparse_copy(iz), 1, mpi_double_complex,
1582 & comm, ierr)
1583 IF (lscal) THEN
1584 IF (keep(23).NE.0) i = uns_perm_inv(i)
1585 rhs_sparse_copy(iz) = rhs_sparse_copy(iz)*scaling(i)
1586 ENDIF
1587 n2recv=n2recv-1
1588 irhs_ptr_copy(j) = irhs_ptr_copy(j) + 1
1589 CALL mpi_unpack( buffer, size_buf_bytes, pos_buf,
1590 & j, 1, mpi_integer, comm, ierr)
1591 ENDDO
1592 ENDDO
1593 iprev = 1
1594 DO j=1, size(irhs_ptr_copy)-1
1595 i= irhs_ptr_copy(j)
1596 irhs_ptr_copy(j) = iprev
1597 iprev = i
1598 ENDDO
1599 ENDIF
1600 RETURN
1601 CONTAINS
1602 SUBROUTINE zmumps_am1_block_add ( SCALE_ONLY )
1603 LOGICAL, intent(in) :: SCALE_ONLY
1604 INTEGER III
1605 IF (scale_only) THEN
1606 iii = i
1607 IF (keep(23).NE.0) iii = uns_perm_inv(i)
1608 IF (lscal) THEN
1609 rhs_sparse_copy(iz)=rhs_sparse_copy(iz)*scaling(iii)
1610 ENDIF
1611 RETURN
1612 ENDIF
1613 CALL mpi_pack(j, 1, mpi_integer, buffer,
1614 & size_buf_bytes, pos_buf, comm, ierr )
1615 CALL mpi_pack(i, 1, mpi_integer, buffer,
1616 & size_buf_bytes, pos_buf, comm, ierr )
1617 CALL mpi_pack(rhs_sparse_copy(iz), 1, mpi_double_complex,
1618 & buffer, size_buf_bytes, pos_buf, comm,
1619 & ierr)
1620 n2send=n2send+1
1621 IF ( pos_buf + record_size_p_1 > size_buf_bytes ) THEN
1622 CALL zmumps_am1_block_send()
1623 END IF
1624 RETURN
1625 END SUBROUTINE zmumps_am1_block_add
1626 SUBROUTINE zmumps_am1_block_send()
1627 IF (n2send .NE. 0) THEN
1628 CALL mpi_pack(fin, 1, mpi_integer, buffer,
1629 & size_buf_bytes, pos_buf, comm, ierr )
1630 CALL mpi_send(buffer, pos_buf, mpi_packed, master,
1631 & gathersol, comm, ierr)
1632 ENDIF
1633 pos_buf=0
1634 n2send=0
1635 RETURN
1636 END SUBROUTINE zmumps_am1_block_send
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
mpi_unpack
subroutine mpi_unpack(inbuf, insize, position, outbuf, outcnt, datatype, comm, ierr)
Definition mpi.f:514
zmumps_am1_block_add
subroutine zmumps_am1_block_add(scale_only)
Definition zsol_c.F:1603

◆ zmumps_get_buf_indx_rhs()

subroutine zmumps_scatter_rhs::zmumps_get_buf_indx_rhs
private

Definition at line 2019 of file zsol_c.F.

2020 CALL mpi_send(buf_indx, buf_effsize, mpi_integer,
2021 & master, scatterrhsi, comm, ierr )
2022 IF (keep(350).EQ.2) THEN
2023 CALL mpi_recv(buf_rhs_2, buf_effsize*nrhs,
2024 & mpi_double_complex,
2025 & master,
2026 & scatterrhsr, comm, status, ierr )
2027!$ OMP_FLAG = .FALSE.
2028!$ CHUNK = NRHS
2029!$ IF (BUF_EFFSIZE*NRHS .GE. KEEP(363)) THEN
2030!$ OMP_FLAG = .TRUE.
2031!$ CHUNK = max((BUF_EFFSIZE*NRHS+NOMP-1)/NOMP,KEEP(363)/2)
2032!$ ENDIF
2033!$OMP PARALLEL DO COLLAPSE(2) SCHEDULE(STATIC,CHUNK) PRIVATE(INDX)
2034!$OMP& IF (OMP_FLAG)
2035 DO k = 1, nrhs
2036 DO i = 1, buf_effsize
2037 indx = posinrhscomp_fwd(buf_indx(i))
2038 rhscomp( indx, k ) =
2039 & buf_rhs_2( i+(k-1)*buf_effsize)
2040 ENDDO
2041 ENDDO
2042!$OMP END PARALLEL DO
2043 ELSE
2044 CALL mpi_recv(buf_rhs, buf_effsize*nrhs,
2045 & mpi_double_complex,
2046 & master,
2047 & scatterrhsr, comm, status, ierr )
2048 DO i = 1, buf_effsize
2049 indx = posinrhscomp_fwd(buf_indx(i))
2050 DO k = 1, nrhs
2051 rhscomp( indx, k ) = buf_rhs( k, i )
2052 ENDDO
2053 ENDDO
2054 END IF
2055 buf_effsize = 0
2056 RETURN

◆ zmumps_npiv_block_add()

subroutine zmumps_gather_solution::zmumps_npiv_block_add ( logical, intent(in) on_master)
private

Definition at line 1338 of file zsol_c.F.

1339 LOGICAL, intent(in) :: ON_MASTER
1340 INTEGER :: JPOS, K242
1341 LOGICAL :: LOCAL_LSCAL
1342 IF (on_master) THEN
1343 IF (keep(350).EQ.2
1344 & .AND. (nrhs.EQ.1.OR.((npiv*nrhs*2*keep(16)).GE.keep(364)))) THEN
1345 local_lscal = lscal
1346 k242 = keep(242)
1347 DO j=1, nrhs
1348 IF (k242.EQ.0) THEN
1349 jpos = j+jbeg_rhs-1
1350 ELSE
1351 jpos = perm_rhs(j+jbeg_rhs-1)
1352 ENDIF
1353 DO ii=1,npiv
1354 i=iw(j1+ii-1)
1355 iposinrhscomp= posinrhscomp(i)
1356 IF (local_lscal) THEN
1357 rhs(i,jpos) = rhscomp(iposinrhscomp,j)*scaling(i)
1358 ELSE
1359 rhs(i,jpos) = rhscomp(iposinrhscomp,j)
1360 ENDIF
1361 ENDDO
1362 ENDDO
1363 ELSE
1364 IF (keep(242).EQ.0) THEN
1365 IF (lscal) THEN
1366 DO ii=1,npiv
1367 i=iw(j1+ii-1)
1368 iposinrhscomp= posinrhscomp(i)
1369 DO j=1, nrhs
1370 rhs(i,j+jbeg_rhs-1) =
1371 & rhscomp(iposinrhscomp,j)*scaling(i)
1372 ENDDO
1373 ENDDO
1374 ELSE
1375 DO ii=1,npiv
1376 i=iw(j1+ii-1)
1377 iposinrhscomp= posinrhscomp(i)
1378 DO j=1, nrhs
1379 rhs(i,j+jbeg_rhs-1) = rhscomp(iposinrhscomp,j)
1380 ENDDO
1381 ENDDO
1382 ENDIF
1383 ELSE
1384 IF (lscal) THEN
1385 DO ii=1,npiv
1386 i=iw(j1+ii-1)
1387 iposinrhscomp= posinrhscomp(i)
1388!DIR$ NOVECTOR
1389 DO j=1, nrhs
1390 rhs(i,perm_rhs(j+jbeg_rhs-1)) =
1391 & rhscomp(iposinrhscomp,j)*scaling(i)
1392 ENDDO
1393 ENDDO
1394 ELSE
1395 DO ii=1,npiv
1396 i=iw(j1+ii-1)
1397 iposinrhscomp= posinrhscomp(i)
1398!DIR$ NOVECTOR
1399 DO j=1, nrhs
1400 rhs(i,perm_rhs(j+jbeg_rhs-1)) =
1401 & rhscomp(iposinrhscomp,j)
1402 ENDDO
1403 ENDDO
1404 ENDIF
1405 ENDIF
1406 ENDIF
1407 RETURN
1408 ENDIF
1409 CALL mpi_pack(npiv, 1, mpi_integer, buffer,
1410 & size_buf_bytes, pos_buf, comm, ierr )
1411 CALL mpi_pack(iw(j1), npiv, mpi_integer, buffer,
1412 & size_buf_bytes, pos_buf, comm, ierr )
1413 iposinrhscomp= posinrhscomp(iw(j1))
1414 DO j=1,nrhs
1415 CALL mpi_pack(rhscomp(iposinrhscomp,j), npiv,
1416 & mpi_double_complex,
1417 & buffer, size_buf_bytes, pos_buf, comm,
1418 & ierr)
1419 ENDDO
1420 n2send=n2send+npiv
1421 IF ( pos_buf + record_size_p_1 > size_buf_bytes ) THEN
1422 CALL zmumps_npiv_block_send()
1423 END IF
1424 RETURN
zmumps_npiv_block_send
subroutine zmumps_npiv_block_send()
Definition zsol_c.F:1427

◆ zmumps_npiv_block_send()

subroutine zmumps_gather_solution::zmumps_npiv_block_send
private

Definition at line 1426 of file zsol_c.F.

1427 IF (n2send .NE. 0) THEN
1428 CALL mpi_pack(fin, 1, mpi_integer, buffer,
1429 & size_buf_bytes, pos_buf, comm, ierr )
1430 CALL mpi_send(buffer, pos_buf, mpi_packed, master,
1431 & gathersol, comm, ierr)
1432 ENDIF
1433 pos_buf=0
1434 n2send=0
1435 RETURN

◆ zmumps_scatter_rhs()

subroutine zmumps_scatter_rhs ( integer nslaves,
integer n,
integer myid,
integer comm,
integer mtype,
complex(kind=8), dimension (lrhs, ncol_rhs), intent(in) rhs,
integer lrhs,
integer ncol_rhs,
integer nrhs,
complex(kind=8), dimension(lrhscomp, ncol_rhscomp), intent(out) rhscomp,
integer lrhscomp,
integer ncol_rhscomp,
integer, dimension(n), intent(in) posinrhscomp_fwd,
integer, intent(in) nb_fs_in_rhscomp_f,
integer, dimension(keep(28)) ptrist,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer, dimension(keep(28)) procnode_steps,
integer, dimension(liw) iw,
integer liw,
integer, dimension(n) step,
integer, dimension(60) icntl,
integer, dimension(80) info )

Definition at line 1821 of file zsol_c.F.

1829!$ USE OMP_LIB
1830 IMPLICIT NONE
1831 include 'mpif.h'
1832 include 'mumps_tags.h'
1833 INTEGER NSLAVES, N, MYID, COMM, LIW, MTYPE
1834 INTEGER NRHS, LRHS, NCOL_RHS, LRHSCOMP, NCOL_RHSCOMP
1835 INTEGER ICNTL(60), INFO(80)
1836 COMPLEX(kind=8), intent(in) :: RHS (LRHS, NCOL_RHS)
1837 COMPLEX(kind=8), intent(out) :: RHSCOMP(LRHSCOMP, NCOL_RHSCOMP)
1838 INTEGER, intent(in) :: POSINRHSCOMP_FWD(N), NB_FS_IN_RHSCOMP_F
1839 INTEGER KEEP(500)
1840 INTEGER(8) KEEP8(150)
1841 INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28))
1842 INTEGER IW(LIW), STEP(N)
1843 INTEGER BUF_MAXSIZE, BUF_MAXREF
1844 parameter(buf_maxref=200000)
1845 INTEGER, ALLOCATABLE, DIMENSION(:) :: BUF_INDX
1846 COMPLEX(kind=8), ALLOCATABLE, DIMENSION(:,:) :: BUF_RHS
1847 COMPLEX(kind=8), ALLOCATABLE, DIMENSION(:) :: BUF_RHS_2
1848 INTEGER ENTRIES_2_PROCESS, PROC_WHO_ASKS, BUF_EFFSIZE
1849 INTEGER INDX
1850 INTEGER allocok
1851 COMPLEX(kind=8) ZERO
1852 parameter( zero = (0.0d0,0.0d0) )
1853 INTEGER I, J, K, JJ, J1, ISTEP, MASTER,
1854 & MYID_NODES, TYPE_PARAL
1855 INTEGER LIELL, IPOS, NPIV
1856 INTEGER :: STATUS(MPI_STATUS_SIZE)
1857 INTEGER :: IERR
1858 parameter(master=0)
1859 LOGICAL I_AM_SLAVE
1860!$ INTEGER :: CHUNK, NOMP
1861!$ LOGICAL :: OMP_FLAG
1862 include 'mumps_headers.h'
1863 INTEGER MUMPS_PROCNODE
1864 EXTERNAL mumps_procnode
1865 type_paral = keep(46)
1866 i_am_slave = myid .ne. 0 .OR. type_paral .eq. 1
1867 IF ( type_paral == 1 ) THEN
1868 myid_nodes = myid
1869 ELSE
1870 myid_nodes = myid-1
1871 ENDIF
1872 buf_effsize = 0
1873 buf_maxsize = max(min(buf_maxref,int(2000000/nrhs)),2000)
1874 IF ( keep(350).EQ.2 ) THEN
1875!$ NOMP = OMP_GET_MAX_THREADS()
1876 ALLOCATE (buf_indx(buf_maxsize),
1877 & buf_rhs_2(buf_maxsize*nrhs),
1878 & stat=allocok)
1879 ELSE
1880 ALLOCATE (buf_indx(buf_maxsize),
1881 & buf_rhs(nrhs,buf_maxsize),
1882 & stat=allocok)
1883 END IF
1884 IF (allocok .GT. 0) THEN
1885 info(1)=-13
1886 info(2)=buf_maxsize*(nrhs+1)
1887 ENDIF
1888 CALL mumps_propinfo(icntl, info, comm, myid )
1889 IF (info(1).LT.0) RETURN
1890 IF (myid.EQ.master) THEN
1891 entries_2_process = n - keep(89)
1892 IF (type_paral.EQ.1.AND.entries_2_process.NE.0) THEN
1893 IF (nb_fs_in_rhscomp_f.LT.lrhscomp) THEN
1894 DO k=1, ncol_rhscomp
1895 DO i = nb_fs_in_rhscomp_f +1, lrhscomp
1896 rhscomp(i, k) = zero
1897 ENDDO
1898 ENDDO
1899 ENDIF
1900 ENDIF
1901 IF ( keep(350).EQ.2 ) THEN
1902 DO WHILE ( entries_2_process .NE. 0)
1903 CALL mpi_recv( buf_indx, buf_maxsize, mpi_integer,
1904 & mpi_any_source,
1905 & scatterrhsi, comm, status, ierr )
1906 CALL mpi_get_count(status,mpi_integer,buf_effsize,ierr)
1907 proc_who_asks = status(mpi_source)
1908!$ OMP_FLAG = .FALSE.
1909!$ chunk = nrhs
1910!$ IF (BUF_EFFSIZE*NRHS .GE. KEEP(363)) THEN
1911!$ OMP_FLAG = .TRUE.
1912!$ CHUNK = max((BUF_EFFSIZE*NRHS+NOMP-1)/NOMP,KEEP(363)/2)
1913!$ ENDIF
1914!$OMP PARALLEL DO COLLAPSE(2) SCHEDULE(STATIC,CHUNK) PRIVATE(INDX)
1915!$OMP& IF (OMP_FLAG)
1916 DO k = 1, nrhs
1917 DO i = 1, buf_effsize
1918 indx = buf_indx( i )
1919 buf_rhs_2( i+(k-1)*buf_effsize) = rhs( indx, k )
1920 ENDDO
1921 ENDDO
1922!$OMP END PARALLEL DO
1923 CALL mpi_send( buf_rhs_2,
1924 & nrhs*buf_effsize,
1925 & mpi_double_complex, proc_who_asks,
1926 & scatterrhsr, comm, ierr)
1927 entries_2_process = entries_2_process - buf_effsize
1928 ENDDO
1929 buf_effsize= 0
1930 ELSE
1931 DO WHILE ( entries_2_process .NE. 0)
1932 CALL mpi_recv( buf_indx, buf_maxsize, mpi_integer,
1933 & mpi_any_source,
1934 & scatterrhsi, comm, status, ierr )
1935 CALL mpi_get_count( status, mpi_integer,buf_effsize,ierr)
1936 proc_who_asks = status(mpi_source)
1937 DO i = 1, buf_effsize
1938 indx = buf_indx( i )
1939 DO k = 1, nrhs
1940 buf_rhs( k, i ) = rhs( indx, k )
1941 ENDDO
1942 ENDDO
1943 CALL mpi_send( buf_rhs, nrhs*buf_effsize,
1944 & mpi_double_complex, proc_who_asks,
1945 & scatterrhsr, comm, ierr)
1946 entries_2_process = entries_2_process - buf_effsize
1947 ENDDO
1948 buf_effsize= 0
1949 ENDIF
1950 ENDIF
1951 IF (i_am_slave) THEN
1952 IF (myid.NE.master) THEN
1953 IF (nb_fs_in_rhscomp_f.LT.lrhscomp) THEN
1954 DO k=1, ncol_rhscomp
1955 DO i = nb_fs_in_rhscomp_f +1, lrhscomp
1956 rhscomp(i, k) = zero
1957 ENDDO
1958 ENDDO
1959 ENDIF
1960 ENDIF
1961 DO istep = 1, keep(28)
1962 IF (myid_nodes == mumps_procnode(procnode_steps(istep),
1963 & keep(199))) THEN
1964 CALL mumps_sol_get_npiv_liell_ipos( istep, keep,
1965 & npiv, liell, ipos, iw, liw, ptrist, step, n )
1966 IF (mtype.eq.1 .OR. keep(50).NE.0) THEN
1967 j1=ipos+1
1968 ELSE
1969 j1=ipos+1+liell
1970 END IF
1971 IF (myid.EQ.master) THEN
1972 indx = posinrhscomp_fwd(iw(j1))
1973 IF (keep(350).EQ.2 .AND.
1974 & (nrhs.EQ.1.OR.((npiv*nrhs*2*keep(16)).GE.keep(364)))) THEN
1975!$ OMP_FLAG = .FALSE.
1976!$ CHUNK = NRHS
1977!$ IF (NPIV*NRHS .GE. KEEP(363)) THEN
1978!$ OMP_FLAG = .TRUE.
1979!$ CHUNK = max((NPIV*NRHS+NOMP-1)/NOMP,KEEP(363)/2)
1980!$ ENDIF
1981!$OMP PARALLEL DO COLLAPSE(2) SCHEDULE(STATIC,CHUNK) PRIVATE(J,JJ)
1982!$OMP& FIRSTPRIVATE(INDX) IF (OMP_FLAG)
1983 DO k = 1, nrhs
1984 DO jj=j1,j1+npiv-1
1985 j=iw(jj)
1986 rhscomp( indx+jj-j1, k ) = rhs( j, k )
1987 ENDDO
1988 ENDDO
1989!$OMP END PARALLEL DO
1990 ELSE
1991 DO jj=j1,j1+npiv-1
1992 j=iw(jj)
1993 DO k = 1, nrhs
1994 rhscomp( indx+jj-j1, k ) = rhs( j, k )
1995 ENDDO
1996 ENDDO
1997 END IF
1998 ELSE
1999 DO jj=j1,j1+npiv-1
2000 buf_effsize = buf_effsize + 1
2001 buf_indx(buf_effsize) = iw(jj)
2002 IF (buf_effsize + 1 .GT. buf_maxsize) THEN
2003 CALL zmumps_get_buf_indx_rhs()
2004 ENDIF
2005 ENDDO
2006 ENDIF
2007 ENDIF
2008 ENDDO
2009 IF ( buf_effsize .NE. 0 .AND. myid.NE.master )
2010 & CALL zmumps_get_buf_indx_rhs()
2011 ENDIF
2012 IF (keep(350).EQ.2) THEN
2013 DEALLOCATE (buf_indx, buf_rhs_2)
2014 ELSE
2015 DEALLOCATE (buf_indx, buf_rhs)
2016 ENDIF
2017 RETURN
2018 CONTAINS
2019 SUBROUTINE zmumps_get_buf_indx_rhs()
2020 CALL mpi_send(buf_indx, buf_effsize, mpi_integer,
2021 & master, scatterrhsi, comm, ierr )
2022 IF (keep(350).EQ.2) THEN
2023 CALL mpi_recv(buf_rhs_2, buf_effsize*nrhs,
2024 & mpi_double_complex,
2025 & master,
2026 & scatterrhsr, comm, status, ierr )
2027!$ OMP_FLAG = .FALSE.
2028!$ CHUNK = NRHS
2029!$ IF (BUF_EFFSIZE*NRHS .GE. KEEP(363)) THEN
2030!$ OMP_FLAG = .TRUE.
2031!$ CHUNK = max((BUF_EFFSIZE*NRHS+NOMP-1)/NOMP,KEEP(363)/2)
2032!$ ENDIF
2033!$OMP PARALLEL DO COLLAPSE(2) SCHEDULE(STATIC,CHUNK) PRIVATE(INDX)
2034!$OMP& IF (OMP_FLAG)
2035 DO k = 1, nrhs
2036 DO i = 1, buf_effsize
2037 indx = posinrhscomp_fwd(buf_indx(i))
2038 rhscomp( indx, k ) =
2039 & buf_rhs_2( i+(k-1)*buf_effsize)
2040 ENDDO
2041 ENDDO
2042!$OMP END PARALLEL DO
2043 ELSE
2044 CALL mpi_recv(buf_rhs, buf_effsize*nrhs,
2045 & mpi_double_complex,
2046 & master,
2047 & scatterrhsr, comm, status, ierr )
2048 DO i = 1, buf_effsize
2049 indx = posinrhscomp_fwd(buf_indx(i))
2050 DO k = 1, nrhs
2051 rhscomp( indx, k ) = buf_rhs( k, i )
2052 ENDDO
2053 ENDDO
2054 END IF
2055 buf_effsize = 0
2056 RETURN
2057 END SUBROUTINE zmumps_get_buf_indx_rhs
mumps_propinfo
subroutine mumps_propinfo(icntl, info, comm, id)
Definition bcast_errors.F:15
min
#define min(a, b)
Definition macros.h:20
mpi_get_count
subroutine mpi_get_count(status, datatype, cnt, ierr)
Definition mpi.f:296
zmumps_get_buf_indx_rhs
subroutine zmumps_get_buf_indx_rhs()
Definition zsol_c.F:2020

◆ zmumps_sol_c()

subroutine zmumps_sol_c ( type ( zmumps_root_struc ) root,
integer n,
complex(kind=8), dimension(la) a,
integer(8) la,
integer, dimension(liw) iw,
integer liw,
complex(kind=8), dimension(lwc) w,
integer(8) lwc,
integer, dimension(liww) iwcb,
integer liww,
integer nrhs,
integer, dimension(lna) na,
integer lna,
integer, dimension(keep(28)) ne_steps,
complex(kind=8), dimension(keep(133)) w2,
integer mtype,
integer, dimension(60) icntl,
logical, intent(in) from_pp,
integer, dimension(n) step,
integer, dimension(keep(28)) frere,
integer, dimension(keep(28)) dad,
integer, dimension(n) fils,
integer, dimension(keep(28)) ptrist,
integer(8), dimension(keep(28)) ptrfac,
integer, dimension(liw1) iw1,
integer liw1,
integer(8), dimension(liwk_ptracb) ptracb,
integer liwk_ptracb,
integer, dimension(keep(28)) procnode_steps,
integer slavef,
integer, dimension(80) info,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
double precision, dimension(230), intent(inout) dkeep,
integer comm_nodes,
integer myid,
integer myid_nodes,
integer, dimension(lbufr) bufr,
integer lbufr,
integer lbufr_bytes,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
integer ibeg_root_def,
integer iend_root_def,
integer iroot_def_rhs_col1,
complex(kind=8), dimension(lrhs_root) rhs_root,
integer(8) lrhs_root,
integer size_root,
integer master_root,
complex(kind=8), dimension(lrhscomp,nrhs) rhscomp,
integer lrhscomp,
integer, dimension(n) posinrhscomp_fwd,
integer, dimension(n) posinrhscomp_bwd,
integer, intent(in) nz_rhs,
integer, intent(in) nbcol_inbloc,
integer, intent(in) nrhs_orig,
integer, intent(in) jbeg_rhs,
integer, dimension(lstep2node), intent(in) step2node,
integer, intent(in) lstep2node,
integer, dimension(nz_rhs), intent(in) irhs_sparse,
integer, dimension(nbcol_inbloc+1), intent(in) irhs_ptr,
integer, intent(in) size_perm_rhs,
integer, dimension(size_perm_rhs), intent(in) perm_rhs,
integer, intent(in) size_uns_perm_inv,
integer, dimension(size_uns_perm_inv), intent(in) uns_perm_inv,
integer nb_fs_in_rhscomp_f,
integer nb_fs_in_rhscomp_tot,
logical, intent(in) do_nbsparse,
integer, dimension (lrhs_bounds), intent(inout) rhs_bounds,
integer, intent(in) lrhs_bounds,
integer, dimension( lpool_b_l0_omp ), intent(in) ipool_b_l0_omp,
integer, intent(in) lpool_b_l0_omp,
integer, dimension( lpool_a_l0_omp ), intent(in) ipool_a_l0_omp,
integer, intent(in) lpool_a_l0_omp,
integer, intent(in) l_virt_l0_omp,
integer, dimension( l_virt_l0_omp ), intent(in) virt_l0_omp,
integer, intent(in) l_phys_l0_omp,
integer, dimension( l_phys_l0_omp ), intent(inout) phys_l0_omp,
integer, dimension( l_phys_l0_omp ), intent(in) perm_l0_omp,
integer, dimension( l_phys_l0_omp + 1), intent(in) ptr_leafs_l0_omp,
integer, dimension( ll0_omp_mapping ), intent(in) l0_omp_mapping,
integer, intent(in) ll0_omp_mapping,
type (zmumps_l0ompfac_t), dimension(ll0_omp_factors), intent(in) l0_omp_factors,
integer, intent(in) ll0_omp_factors )

Definition at line 14 of file zsol_c.F.

31 USE zmumps_ooc
32 USE zmumps_sol_es
33 USE zmumps_sol_l0omp_m, ONLY : zmumps_sol_l0omp_r,
34 & zmumps_sol_l0omp_s
35 USE zmumps_struc_def, ONLY : zmumps_root_struc
36 & , zmumps_l0ompfac_t
37 IMPLICIT NONE
38#if defined(V_T)
39 include 'VT.inc'
40#endif
41 TYPE ( ZMUMPS_ROOT_STRUC ) :: root
42 INTEGER(8) :: LA
43 INTEGER(8) :: LWC
44 INTEGER :: N,LIW,MTYPE,LIW1,LIWW,LNA
45 INTEGER ICNTL(60),INFO(80), KEEP(500)
46 DOUBLE PRECISION, intent(inout) :: DKEEP(230)
47 INTEGER(8) KEEP8(150)
48 INTEGER IW(LIW),IW1(LIW1),NA(LNA),NE_STEPS(KEEP(28)),IWCB(LIWW)
49 INTEGER STEP(N), FRERE(KEEP(28)), FILS(N), PTRIST(KEEP(28)),
50 & DAD(KEEP(28))
51 INTEGER(8) :: PTRFAC(KEEP(28))
52 INTEGER :: LIWK_PTRACB
53 INTEGER(8) :: PTRACB(LIWK_PTRACB)
54 INTEGER NRHS, LRHSCOMP, NB_FS_IN_RHSCOMP_F, NB_FS_IN_RHSCOMP_TOT
55 COMPLEX(kind=8) A(LA), W(LWC),
56 & W2(KEEP(133))
57 COMPLEX(kind=8) :: RHSCOMP(LRHSCOMP,NRHS)
58 INTEGER SLAVEF, COMM_NODES, MYID, MYID_NODES
59 INTEGER PROCNODE_STEPS(KEEP(28)), POSINRHSCOMP_FWD(N),
60 & POSINRHSCOMP_BWD(N)
61 INTEGER LBUFR, LBUFR_BYTES
62 INTEGER BUFR(LBUFR)
63 INTEGER ISTEP_TO_INIV2(KEEP(71)),
64 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
65 INTEGER IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1
66 INTEGER SIZE_ROOT, MASTER_ROOT
67 INTEGER(8) :: LRHS_ROOT
68 COMPLEX(kind=8) RHS_ROOT(LRHS_ROOT)
69 LOGICAL, intent(in) :: FROM_PP
70 INTEGER, intent(in) :: NZ_RHS, NBCOL_INBLOC, NRHS_ORIG
71 INTEGER, intent(in) :: SIZE_UNS_PERM_INV
72 INTEGER, intent(in) :: SIZE_PERM_RHS
73 INTEGER, intent(in) :: JBEG_RHS
74 INTEGER, intent(in) :: IRHS_SPARSE(NZ_RHS)
75 INTEGER, intent(in) :: IRHS_PTR(NBCOL_INBLOC+1)
76 INTEGER, intent(in) :: PERM_RHS(SIZE_PERM_RHS)
77 INTEGER, intent(in) :: UNS_PERM_INV(SIZE_UNS_PERM_INV)
78 INTEGER, intent(in) :: LStep2node
79 INTEGER, intent(in) :: Step2node(LStep2node)
80 LOGICAL, intent(in) :: DO_NBSPARSE
81 INTEGER, intent(in) :: LRHS_BOUNDS
82 INTEGER, intent(inout) :: RHS_BOUNDS (LRHS_BOUNDS)
83 INTEGER, INTENT (IN) :: LPOOL_B_L0_OMP
84 INTEGER, INTENT (IN) :: IPOOL_B_L0_OMP( LPOOL_B_L0_OMP )
85 INTEGER, INTENT (IN) :: LPOOL_A_L0_OMP
86 INTEGER, INTENT (IN) :: IPOOL_A_L0_OMP( LPOOL_A_L0_OMP )
87 INTEGER, INTENT (IN) :: L_PHYS_L0_OMP
88 INTEGER, INTENT (INOUT) :: PHYS_L0_OMP( L_PHYS_L0_OMP )
89 INTEGER, INTENT (IN) :: L_VIRT_L0_OMP
90 INTEGER, INTENT (IN) :: VIRT_L0_OMP( L_VIRT_L0_OMP )
91 INTEGER, INTENT (IN) :: PERM_L0_OMP( L_PHYS_L0_OMP )
92 INTEGER, INTENT (IN) :: PTR_LEAFS_L0_OMP( L_PHYS_L0_OMP + 1)
93 INTEGER, INTENT (IN) :: LL0_OMP_MAPPING
94 INTEGER, INTENT (IN) :: L0_OMP_MAPPING( LL0_OMP_MAPPING )
95 INTEGER, INTENT (IN) :: LL0_OMP_FACTORS
96 TYPE (ZMUMPS_L0OMPFAC_T), INTENT(IN) ::
97 & L0_OMP_FACTORS(LL0_OMP_FACTORS)
98 INTEGER MP, LP, LDIAG
99 INTEGER K,I,II
100 INTEGER allocok
101 INTEGER LPOOL,MYLEAF,MYROOT,NBROOT,LPANEL_POS
102 INTEGER MYLEAF_NOT_PRUNED
103 INTEGER NSTK_S,IPOOL,IPANEL_POS,PTRICB
104 INTEGER MTYPE_LOC
105 INTEGER MODE_RHS_BOUNDS
106 INTEGER IERR
107 INTEGER(8) :: IAPOS
108 INTEGER IOLDPS,
109 & LOCAL_M,
110 & LOCAL_N
111#if defined(V_T)
112 INTEGER soln_c_class, forw_soln, back_soln, root_soln
113#endif
114 LOGICAL DOFORWARD, DOROOT, DOBACKWARD
115 LOGICAL :: DO_L0OMP_FWD, DO_L0OMP_BWD
116 LOGICAL I_WORKED_ON_ROOT, SPECIAL_ROOT_REACHED
117 INTEGER IROOT
118 LOGICAL DOROOT_FWD_OOC, DOROOT_BWD_PANEL
119 LOGICAL SWITCH_OFF_ES
120 LOGICAL DUMMY_BOOL
121 INTEGER :: IDUMMY
122 INTEGER :: NBROOT_UNDER_L0
123 COMPLEX(kind=8), PARAMETER :: ZERO = (0.0d0,0.0d0)
124 include 'mumps_headers.h'
125 INTEGER, DIMENSION(:), ALLOCATABLE :: nodes_RHS
126 INTEGER nb_nodes_RHS
127 INTEGER nb_prun_leaves
128 INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_Leaves
129 INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_List
130 INTEGER nb_prun_nodes
131 INTEGER nb_prun_roots, JAM1
132 INTEGER, DIMENSION(:), ALLOCATABLE :: Pruned_SONS, Pruned_Roots
133 INTEGER :: SIZE_TO_PROCESS
134 LOGICAL, DIMENSION(:), ALLOCATABLE :: TO_PROCESS
135 INTEGER ISTEP, INODE_PRINC
136 INTEGER :: INODE, ICHILD
137 LOGICAL AM1, DO_PRUN
138 LOGICAL Exploit_Sparsity
139 LOGICAL DO_NBSPARSE_BWD, PRUN_BELOW_BWD
140 INTEGER :: OOC_FCT_TYPE_TMP
141 INTEGER :: MUMPS_OOC_GET_FCT_TYPE
142 EXTERNAL :: mumps_ooc_get_fct_type
143 DOUBLE PRECISION TIME_FWD,TIME_BWD,TIME_SpecialRoot
144 INTEGER :: nb_sparse
145 INTEGER, EXTERNAL :: MUMPS_PROCNODE
146 LOGICAL, EXTERNAL :: MUMPS_IN_OR_ROOT_SSARBR
147 myleaf = -1
148 lp = icntl(1)
149 mp = icntl(2)
150 ldiag = icntl(4)
151#if defined(V_T)
152 CALL vtclassdef( 'Soln_c',soln_c_class,ierr)
153 CALL vtfuncdef( 'forw_soln',soln_c_class,forw_soln,ierr)
154 CALL vtfuncdef( 'back_soln',soln_c_class,back_soln,ierr)
155 CALL vtfuncdef( 'root_soln',soln_c_class,root_soln,ierr)
156#endif
157 IF (.NOT. from_pp) THEN
158 CALL mumps_secdeb(time_fwd)
159 ENDIF
160 nstk_s = 1
161 ptricb = nstk_s + keep(28)
162 ipool = ptricb + keep(28)
163 lpool = na(1) + 1
164 ipanel_pos = ipool + lpool
165 IF (keep(201).EQ.1) THEN
166 lpanel_pos = keep(228)+1
167 ELSE
168 lpanel_pos = 1
169 ENDIF
170 IF (ipanel_pos + lpanel_pos -1 .ne. liw1 ) THEN
171 WRITE(*,*) myid, ": Internal Error 1 in ZMUMPS_SOL_C",
172 & ipanel_pos, lpanel_pos, liw1
173 CALL mumps_abort()
174 ENDIF
175 doforward = .true.
176 dobackward= .true.
177 special_root_reached = .true.
178 switch_off_es = .false.
179 IF ( keep(111).NE.0 .OR. keep(252).NE.0 ) THEN
180 doforward = .false.
181 ENDIF
182 IF (keep(221).eq.1) dobackward = .false.
183 IF (keep(221).eq.2) doforward = .false.
184 IF ( keep(60).EQ.0 .AND.
185 & (
186 & (keep(38).NE.0 .AND. root%yes)
187 & .OR.
188 & (keep(20).NE.0 .AND. myid_nodes.EQ.master_root)
189 & )
190 & .AND. keep(252).EQ.0
191 & )
192 &THEN
193 doroot = .true.
194 ELSE
195 doroot = .false.
196 ENDIF
197 doroot_bwd_panel = doroot .AND. mtype.NE.1 .AND. keep(50).EQ.0
198 & .AND. keep(201).EQ.1
199 doroot_fwd_ooc = doroot .AND. .NOT.doroot_bwd_panel
200 am1 = (keep(237) .NE. 0)
201 exploit_sparsity = (keep(235) .NE. 0) .AND. (.NOT. am1)
202 do_prun = (exploit_sparsity.OR.am1)
203 IF (from_pp) THEN
204 exploit_sparsity = .false.
205 do_prun = .false.
206 IF ( am1 ) THEN
207 WRITE(*,*) "Internal error 2 in ZMUMPS_SOL_C"
208 CALL mumps_abort()
209 ENDIF
210 ENDIF
211 do_l0omp_fwd= ( (keep(401).GT.0).AND.(keep(400).GT.0)
212 & .AND.doforward )
213 do_l0omp_fwd = do_l0omp_fwd .AND. keep(201).EQ.0
214 do_l0omp_bwd = ( (keep(401).GT.0).AND.(keep(400).GT.0)
215 & .AND.dobackward )
216 do_l0omp_bwd = do_l0omp_bwd .AND. keep(201).EQ.0
217 IF ( do_prun ) THEN
218 ALLOCATE (pruned_sons(keep(28)), stat=i)
219 IF(i.GT.0) THEN
220 info(1)=-13
221 info(2)=keep(28)
222 END IF
223 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
224 IF(info(1).LT.0) GOTO 500
225 ENDIF
226 IF ( do_prun
227 & .OR. do_l0omp_bwd
228 & ) THEN
229 size_to_process = keep(28)
230 ELSE
231 size_to_process = 1
232 ENDIF
233 ALLOCATE (to_process(size_to_process), stat=i)
234 IF(i.GT.0) THEN
235 info(1)=-13
236 info(2)=keep(28)
237 END IF
238 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
239 IF(info(1).LT.0) GOTO 500
240 IF ( doforward .AND. do_prun ) THEN
241 nb_prun_nodes = 0
242 nb_prun_roots = 0
243 pruned_sons(:) = -1
244 IF ( exploit_sparsity ) THEN
245 nb_nodes_rhs = 0
246 DO i = 1, nz_rhs
247 istep = abs( step(irhs_sparse(i)) )
248 inode_princ = step2node( istep )
249 IF ( pruned_sons(istep) .eq. -1) THEN
250 nb_nodes_rhs = nb_nodes_rhs +1
251 pruned_sons(istep) = 0
252 ENDIF
253 ENDDO
254 ALLOCATE(nodes_rhs(nb_nodes_rhs), stat = allocok)
255 IF(allocok.GT.0) THEN
256 info(1)=-13
257 info(2)=nb_nodes_rhs
258 END IF
259 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
260 IF(info(1).LT.0) GOTO 500
261 nb_nodes_rhs = 0
262 pruned_sons = -1
263 DO i = 1, nz_rhs
264 istep = abs( step(irhs_sparse(i)) )
265 inode_princ = step2node( istep )
266 IF ( pruned_sons(istep) .eq. -1) THEN
267 nb_nodes_rhs = nb_nodes_rhs +1
268 nodes_rhs(nb_nodes_rhs) = inode_princ
269 pruned_sons(istep) = 0
270 ENDIF
271 ENDDO
272 ELSE IF ( am1 ) THEN
273 nb_nodes_rhs = 0
274 DO i = 1, nbcol_inbloc
275 IF ( (irhs_ptr(i+1)-irhs_ptr(i)).EQ.0) cycle
276 IF ( (keep(242) .NE. 0 ).OR. (keep(243).NE.0) ) THEN
277 jam1 = perm_rhs(jbeg_rhs+i-1)
278 ELSE
279 jam1 = jbeg_rhs+i-1
280 ENDIF
281 istep = abs(step(jam1))
282 inode_princ = step2node(istep)
283 IF ( pruned_sons(istep) .eq. -1) THEN
284 nb_nodes_rhs = nb_nodes_rhs +1
285 pruned_sons(istep) = 0
286 ENDIF
287 ENDDO
288 ALLOCATE(nodes_rhs(nb_nodes_rhs), stat = allocok)
289 IF(allocok.GT.0) THEN
290 info(1)=-13
291 info(2)=nb_nodes_rhs
292 END IF
293 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
294 IF(info(1).LT.0) GOTO 500
295 nb_nodes_rhs = 0
296 pruned_sons = -1
297 DO i = 1, nbcol_inbloc
298 IF ( (irhs_ptr(i+1)-irhs_ptr(i)).EQ.0) cycle
299 IF ( (keep(242) .NE. 0 ).OR. (keep(243).NE.0) ) THEN
300 jam1 = perm_rhs(jbeg_rhs+i-1)
301 ELSE
302 jam1 = jbeg_rhs+i-1
303 ENDIF
304 istep = abs(step(jam1))
305 inode_princ = step2node(istep)
306 IF ( pruned_sons(istep) .eq. -1) THEN
307 nb_nodes_rhs = nb_nodes_rhs +1
308 nodes_rhs(nb_nodes_rhs) = inode_princ
309 pruned_sons(istep) = 0
310 ENDIF
311 ENDDO
312 ENDIF
313 CALL zmumps_chain_prun_nodes(
314 & .false.,
315 & dad, keep(28),
316 & step, n,
317 & nodes_rhs, nb_nodes_rhs,
318 & pruned_sons, to_process,
319 & nb_prun_nodes, nb_prun_roots,
320 & nb_prun_leaves )
321 ALLOCATE(pruned_list(nb_prun_nodes), stat=allocok)
322 IF(allocok.GT.0) THEN
323 info(1)=-13
324 info(2)=nb_prun_nodes
325 END IF
326 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
327 IF(info(1).LT.0) GOTO 500
328 ALLOCATE(pruned_roots(nb_prun_roots), stat=allocok)
329 IF(allocok.GT.0) THEN
330 info(1)=-13
331 info(2)=nb_prun_roots
332 END IF
333 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
334 IF(info(1).LT.0) GOTO 500
335 ALLOCATE(pruned_leaves(nb_prun_leaves), stat=allocok)
336 IF(allocok.GT.0) THEN
337 info(1)=-13
338 info(2)=nb_prun_leaves
339 END IF
340 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
341 IF(info(1).LT.0) GOTO 500
342 CALL zmumps_chain_prun_nodes(
343 & .true.,
344 & dad, keep(28),
345 & step, n,
346 & nodes_rhs, nb_nodes_rhs,
347 & pruned_sons, to_process,
348 & nb_prun_nodes, nb_prun_roots, nb_prun_leaves,
349 & pruned_list, pruned_roots, pruned_leaves )
350 IF(allocated(nodes_rhs)) DEALLOCATE(nodes_rhs)
351 CALL zmumps_ooc_set_states_es(n,
352 & keep(201), pruned_list, nb_prun_nodes,
353 & step)
354 IF ( keep(201) .GT. 0) THEN
355 ooc_fct_type_tmp=mumps_ooc_get_fct_type
356 & ('F',mtype,keep(201),keep(50))
357 ELSE
358 ooc_fct_type_tmp = -5959
359 ENDIF
360 CALL zmumps_chain_prun_nodes_stats(
361 & myid_nodes, n, keep(28), keep(201), keep(485),
362 & keep8(31)+keep8(64),
363 & step, pruned_list, nb_prun_nodes, ooc_fct_type_tmp
364 & )
365 IF (do_nbsparse) THEN
366 nb_sparse = max(1,keep(497))
367 mode_rhs_bounds = 0
368 IF (exploit_sparsity) mode_rhs_bounds = 2
369 CALL zmumps_initialize_rhs_bounds(
370 & step, n,
371 & irhs_ptr, nbcol_inbloc, irhs_sparse, nz_rhs,
372 & jbeg_rhs, perm_rhs, size_perm_rhs, keep(242), keep(243),
373 & uns_perm_inv, size_uns_perm_inv, keep(23),
374 & rhs_bounds, keep(28),
375 & nb_sparse, myid_nodes,
376 & mode_rhs_bounds)
377 CALL zmumps_propagate_rhs_bounds(
378 & pruned_leaves, nb_prun_leaves,
379 & step, n, pruned_sons,
380 & dad, rhs_bounds, keep(28),
381 & myid_nodes, comm_nodes, keep(485),
382 & iw, liw, ptrist,keep(ixsz),ooc_fct_type_tmp,0,
383 & keep(50), keep(38))
384 END IF
385 special_root_reached = .false.
386 DO i= 1, nb_prun_roots
387 IF ( (pruned_roots(i).EQ.keep(38)).OR.
388 & (pruned_roots(i).EQ.keep(20)) ) THEN
389 special_root_reached = .true.
390 EXIT
391 ENDIF
392 ENDDO
393 DEALLOCATE(pruned_list)
394 ENDIF
395 IF (keep(201).GT.0) THEN
396 IF (doforward .OR. doroot_fwd_ooc) THEN
397 CALL zmumps_solve_init_ooc_fwd(ptrfac,keep(28),mtype,
398 & a,la,doforward,ierr)
399 IF(ierr.LT.0)THEN
400 info(1)=ierr
401 info(2)=0
402 CALL mumps_abort()
403 ENDIF
404 ENDIF
405 ENDIF
406 IF (doforward) THEN
407 IF ( keep( 50 ) .eq. 0 ) THEN
408 mtype_loc = mtype
409 ELSE
410 mtype_loc = 1
411 ENDIF
412#if defined(v_t)
413 CALL vtbegin(forw_soln,ierr)
414#endif
415 IF ( .NOT. do_prun ) THEN
416 CALL mumps_init_nroot_dist(n, nbroot, myroot, myid_nodes,
417 & slavef, na, lna, keep, step, procnode_steps)
418 DO istep =1, keep(28)
419 iw1(nstk_s+istep-1) = ne_steps(istep)
420 ENDDO
421 ELSE
422 CALL mumps_nblocal_roots_or_leaves( n,
423 & nb_prun_roots, pruned_roots,
424 & myroot, myid_nodes, slavef, keep, step,
425 & procnode_steps )
426 IF (am1) THEN
427 DEALLOCATE(pruned_roots)
428 END IF
429 IF ((exploit_sparsity).AND.(nb_prun_roots.EQ.na(2))) THEN
430 DEALLOCATE(pruned_roots)
431 switch_off_es = .true.
432 ENDIF
433 DO istep = 1, keep(28)
434 iw1(nstk_s+istep-1) = pruned_sons(istep)
435 ENDDO
436 ENDIF
437 IF ( do_l0omp_fwd ) THEN
438 CALL zmumps_sol_l0omp_r( n, mtype_loc, nrhs, liw, iw,
439 & iw1(ptricb), rhscomp, lrhscomp, posinrhscomp_fwd,
440 & step, frere, dad, fils, iw1(nstk_s),
441 & ptrist, ptrfac, info,
442 & keep, keep8, dkeep, procnode_steps, slavef,
443 & comm_nodes, myid_nodes,
444 & bufr, lbufr, lbufr_bytes,
445 & rhs_root, lrhs_root,
446 & istep_to_iniv2, tab_pos_in_pere,
447 & rhs_bounds, lrhs_bounds, do_nbsparse,
448 & from_pp,
449 & nbroot_under_l0,
450 & lpool_b_l0_omp, ipool_b_l0_omp,
451 & l_virt_l0_omp, virt_l0_omp,
452 & l_phys_l0_omp, phys_l0_omp,
453 & perm_l0_omp, ptr_leafs_l0_omp,
454 & l0_omp_mapping, ll0_omp_mapping,
455 & l0_omp_factors, ll0_omp_factors,
456 & do_prun, to_process
457 & )
458 myroot = myroot - nbroot_under_l0
459 IF ( do_prun ) THEN
460 myleaf_not_pruned = ipool_a_l0_omp(lpool_a_l0_omp)
461 DO i=1, myleaf_not_pruned
462 IF ( to_process( step( ipool_a_l0_omp(i) ))) THEN
463 iw1(ipool+myleaf-1) = ipool_a_l0_omp(i)
464 iw1(nstk_s+step(ipool_a_l0_omp(i))-1) = -99
465 ENDIF
466 ENDDO
467 DO i = 1, nb_prun_leaves
468 inode = pruned_leaves(i)
469 IF ( mumps_procnode(procnode_steps(step(inode)),keep(199))
470 & .EQ. myid_nodes ) THEN
471 IF (l0_omp_mapping( step(inode) ) .EQ. 0) THEN
472 iw1(nstk_s+step(inode)-1) = -99
473 ENDIF
474 ENDIF
475 ENDDO
476 DO i = 1, l_phys_l0_omp
477 inode = dad(step(phys_l0_omp(i)))
478 IF (inode .NE. 0) THEN
479 IF ( to_process( step( inode ))) THEN
480 IF ( iw1(nstk_s+step(inode)-1) .EQ. 0 ) THEN
481 iw1(nstk_s+step(inode)-1) = -99
482 ENDIF
483 ENDIF
484 ENDIF
485 ENDDO
486 myleaf = 0
487 DO istep = keep(28), 1, -1
488 inode=step2node(istep)
489 IF (iw1(nstk_s+step(inode)-1).EQ.-99) THEN
490 myleaf = myleaf + 1
491 iw1(ipool+myleaf-1) = inode
492 iw1(nstk_s+step(inode)-1) = 0
493 ENDIF
494 ENDDO
495 DEALLOCATE(pruned_leaves)
496 ELSE
497 myleaf = ipool_a_l0_omp(lpool_a_l0_omp)
498 DO i=1, myleaf
499 iw1(ipool+i-1) = ipool_a_l0_omp(i)
500 ENDDO
501 ENDIF
502 ELSE
503 IF ( do_prun ) THEN
504 CALL mumps_init_pool_dist_nona( n, myleaf, myid_nodes,
505 & nb_prun_leaves, pruned_leaves, keep, keep8,
506 & step, procnode_steps, iw1(ipool), lpool )
507 myleaf = myleaf - 1
508 DEALLOCATE(pruned_leaves)
509 ELSE
510 CALL mumps_init_pool_dist( n, myleaf, myid_nodes,
511 & slavef, na, lna, keep, keep8, step,
512 & procnode_steps, iw1(ipool), lpool )
513 myleaf = myleaf - 1
514 ENDIF
515 ENDIF
516 CALL zmumps_sol_r(n, a(1), la, iw(1), liw, w(1),
517 & lwc, nrhs,
518 & iw1(ptricb), iwcb, liww,
519 & rhscomp,lrhscomp,posinrhscomp_fwd,
520 & step, frere,dad,fils,
521 & iw1(nstk_s),iw1(ipool),lpool,ptrist,ptrfac,
522 & myleaf, myroot, info,
523 & keep, keep8, dkeep,
524 & procnode_steps, slavef, comm_nodes, myid_nodes,
525 & bufr, lbufr, lbufr_bytes,
526 & rhs_root, lrhs_root, mtype_loc,
527 &
528 & istep_to_iniv2, tab_pos_in_pere
529 & , rhs_bounds, lrhs_bounds, do_nbsparse, from_pp
530 & , l0_omp_mapping, ll0_omp_mapping,
531 & l0_omp_factors, ll0_omp_factors
532 & )
533 IF (do_prun) THEN
534 myleaf = -1
535 ENDIF
536#if defined(V_T)
537 CALL vtend(forw_soln,ierr)
538#endif
539 ENDIF
540 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
541 IF ( info(1) .LT. 0 ) THEN
542 IF ( lp .GT. 0 ) THEN
543 WRITE(lp,*) myid,
544 & ': ** ERROR RETURN FROM ZMUMPS_SOL_R,INFO(1:2)=',
545 & info(1:2)
546 END IF
547 GOTO 500
548 END IF
549 CALL mpi_barrier( comm_nodes, ierr )
550 IF (.NOT.from_pp) THEN
551 CALL mumps_secfin(time_fwd)
552 dkeep(117)=time_fwd + dkeep(117)
553 ENDIF
554 IF (do_prun.AND.switch_off_es) THEN
555 do_prun = .false.
556 exploit_sparsity = .false.
557 IF (.NOT. do_l0omp_bwd ) THEN
558 IF ( allocated(to_process) .AND. size_to_process.NE.1 ) THEN
559 DEALLOCATE (to_process)
560 size_to_process = 1
561 ALLOCATE(to_process(size_to_process),stat=i)
562 ENDIF
563 ENDIF
564 ENDIF
565 IF ( dobackward .AND. do_prun ) THEN
566 nb_prun_leaves = 0
567 IF ( exploit_sparsity .AND. (keep(111).EQ.0) ) THEN
568 nb_nodes_rhs = nb_prun_roots
569 ALLOCATE(nodes_rhs(nb_nodes_rhs), stat = allocok)
570 IF(allocok.GT.0) THEN
571 WRITE(*,*)'Problem with allocation of nodes_RHS'
572 info(1) = -13
573 info(2) = nb_nodes_rhs
574 CALL mumps_abort()
575 END IF
576 nodes_rhs(1:nb_prun_roots)=pruned_roots(1:nb_prun_roots)
577 DEALLOCATE(pruned_roots)
578 ELSE
579 nb_nodes_rhs = 0
580 pruned_sons(:) = -1
581 DO ii = 1, nz_rhs
582 i = irhs_sparse(ii)
583 IF (keep(23).NE.0) i = uns_perm_inv(i)
584 istep = abs(step(i))
585 IF ( pruned_sons(istep) .eq. -1) THEN
586 nb_nodes_rhs = nb_nodes_rhs +1
587 pruned_sons(istep) = 0
588 ENDIF
589 ENDDO
590 ALLOCATE(nodes_rhs(nb_nodes_rhs), stat = allocok)
591 IF(allocok.GT.0) THEN
592 WRITE(*,*)'Problem with allocation of nodes_RHS'
593 info(1) = -13
594 info(2) = nb_nodes_rhs
595 CALL mumps_abort()
596 END IF
597 nb_nodes_rhs = 0
598 pruned_sons(:) = -1
599 DO ii = 1, nz_rhs
600 i = irhs_sparse(ii)
601 IF (keep(23).NE.0) i = uns_perm_inv(i)
602 istep = abs(step(i))
603 inode_princ = step2node(istep)
604 IF ( pruned_sons(istep) .eq. -1) THEN
605 nb_nodes_rhs = nb_nodes_rhs +1
606 nodes_rhs(nb_nodes_rhs) = inode_princ
607 pruned_sons(istep) = 0
608 ENDIF
609 ENDDO
610 ENDIF
611 IF ( exploit_sparsity ) THEN
612 CALL zmumps_tree_prun_nodes(
613 & .false.,
614 & dad, ne_steps, frere, keep(28),
615 & fils, step, n,
616 & nodes_rhs, nb_nodes_rhs,
617 & to_process,
618 & nb_prun_nodes, nb_prun_roots, nb_prun_leaves
619 & )
620 ALLOCATE(pruned_list(nb_prun_nodes), stat=allocok)
621 IF(allocok.GT.0) THEN
622 info(1)=-13
623 info(2)=nb_prun_nodes
624 END IF
625 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
626 IF(info(1).LT.0) GOTO 500
627 ALLOCATE(pruned_roots(nb_prun_roots), stat=allocok)
628 IF(allocok.GT.0) THEN
629 info(1)=-13
630 info(2)=nb_prun_roots
631 END IF
632 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
633 IF(info(1).LT.0) GOTO 500
634 ALLOCATE(pruned_leaves(nb_prun_leaves), stat=allocok)
635 IF(allocok.GT.0) THEN
636 info(1)=-13
637 info(2)=nb_prun_leaves
638 END IF
639 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
640 IF(info(1).LT.0) GOTO 500
641 CALL zmumps_tree_prun_nodes(
642 & .true.,
643 & dad, ne_steps, frere, keep(28),
644 & fils, step, n,
645 & nodes_rhs, nb_nodes_rhs,
646 & to_process,
647 & nb_prun_nodes, nb_prun_roots, nb_prun_leaves,
648 & pruned_list, pruned_roots, pruned_leaves
649 & )
650 CALL zmumps_ooc_set_states_es(n,
651 & keep(201), pruned_list, nb_prun_nodes,
652 & step)
653 IF(allocated(nodes_rhs)) DEALLOCATE(nodes_rhs)
654 IF (keep(201).GT.0) THEN
655 ooc_fct_type_tmp=mumps_ooc_get_fct_type
656 & ('B',mtype,keep(201),keep(50))
657 ELSE
658 ooc_fct_type_tmp = -5959
659 ENDIF
660 CALL zmumps_tree_prun_nodes_stats(
661 & myid_nodes, n, keep(28), keep(201),
662 & keep8(31)+keep8(64),
663 & step,
664 & pruned_list,
665 & nb_prun_nodes, ooc_fct_type_tmp)
666 ENDIF
667 ENDIF
668 IF(keep(201).EQ.1.AND.doroot_bwd_panel) THEN
669 i_worked_on_root = .false.
670 CALL zmumps_solve_init_ooc_bwd(ptrfac,keep(28),mtype,
671 & i_worked_on_root, iroot, a, la, ierr)
672 IF (ierr .LT. 0) THEN
673 info(1) = -90
674 info(2) = ierr
675 ENDIF
676 ENDIF
677 IF (keep(201).EQ.1) THEN
678 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
679 IF ( info(1) .LT. 0 ) GOTO 500
680 ENDIF
681 IF (keep(60).NE.0 .AND. keep(221).EQ.0
682 & .AND. myid_nodes .EQ. master_root) THEN
683 rhs_root(1:nrhs*size_root) = zero
684 ENDIF
685 IF (.NOT. from_pp) THEN
686 CALL mumps_secdeb(time_specialroot)
687 ENDIF
688 IF ( ( keep( 38 ) .NE. 0 ).AND. special_root_reached ) THEN
689 IF ( keep(60) .EQ. 0 .AND. keep(252) .EQ. 0 ) THEN
690 IF ( root%yes ) THEN
691 IF (keep(201).GT.0) THEN
692 IF ( (exploit_sparsity.AND.(keep(111).NE.0)) .and.
693 & (ooc_state_node(step(keep(38))).eq.-6) ) THEN
694 GOTO 1010
695 ENDIF
696 ENDIF
697 ioldps = ptrist(step(keep(38)))
698 local_m = iw( ioldps + 2 + keep(ixsz))
699 local_n = iw( ioldps + 1 + keep(ixsz))
700 IF (keep(201).GT.0) THEN
701 CALL zmumps_solve_get_ooc_node(
702 & keep(38),ptrfac,keep,a,la,
703 & step,keep8,n,dummy_bool,ierr)
704 IF(ierr.LT.0)THEN
705 info(1)=ierr
706 info(2)=0
707 WRITE(*,*) '** ERROR after ZMUMPS_SOLVE_GET_OOC_NODE',
708 & info(1)
709 call mumps_abort()
710 ENDIF
711 ENDIF
712 iapos = ptrfac(iw( ioldps + 4 + keep(ixsz)))
713 IF (local_m * local_n .EQ. 0) THEN
714 iapos = min(iapos, la)
715 ENDIF
716#if defined(V_T)
717 CALL vtbegin(root_soln,ierr)
718#endif
719 CALL zmumps_root_solve( nrhs, root%DESCRIPTOR(1),
720 & root%CNTXT_BLACS, local_m, local_n,
721 & root%MBLOCK, root%NBLOCK,
722 & root%IPIV(1), root%LPIV, master_root, myid_nodes,
723 & comm_nodes,
724 & rhs_root(1),
725 & root%TOT_ROOT_SIZE, a( iapos ),
726 & info(1), mtype, keep(50), from_pp)
727 IF(keep(201).GT.0)THEN
728 CALL zmumps_free_factors_for_solve(keep(38),
729 & ptrfac,keep(28),a,la,.false.,ierr)
730 IF(ierr.LT.0)THEN
731 info(1)=ierr
732 info(2)=0
733 WRITE(*,*)
734 & '** ERROR after ZMUMPS_FREE_FACTORS_FOR_SOLVE ',
735 & info(1)
736 call mumps_abort()
737 ENDIF
738 ENDIF
739 ENDIF
740 ENDIF
741 ELSE IF ( ( keep(20) .NE. 0) .AND. special_root_reached ) THEN
742 IF ( myid_nodes .eq. master_root ) THEN
743 END IF
744 END IF
745 IF (.NOT.from_pp) THEN
746 CALL mumps_secfin(time_specialroot)
747 dkeep(119)=time_specialroot + dkeep(119)
748 ENDIF
749#if defined(V_T)
750 CALL vtend(root_soln,ierr)
751#endif
752 1010 CONTINUE
753 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
754 IF ( info(1) .LT. 0 ) RETURN
755 IF (dobackward) THEN
756 IF ( keep(201).GT.0 .AND. .NOT. doroot_bwd_panel )
757 & THEN
758 i_worked_on_root = doroot
759 IF (keep(38).gt.0 ) THEN
760 IF ( ( exploit_sparsity.AND.(keep(111).EQ.0) )
761 & .OR. am1 ) THEN
762 IF (ooc_state_node(step(keep(38))).eq.-6) THEN
763 ooc_state_node(step(keep(38)))=-4
764 ENDIF
765 ENDIF
766 IF (exploit_sparsity.AND.(keep(111).NE.0)) THEN
767 IF (ooc_state_node(step(keep(38))).eq.-6) THEN
768 i_worked_on_root = .false.
769 ENDIF
770 ENDIF
771 ENDIF
772 ENDIF
773 IF (.NOT.am1) THEN
774 do_nbsparse_bwd = .false.
775 ELSE
776 do_nbsparse_bwd = do_nbsparse
777 ENDIF
778 prun_below_bwd = am1
779 prun_below_bwd = prun_below_bwd .OR. do_l0omp_bwd
780 IF ( am1 ) THEN
781 CALL zmumps_chain_prun_nodes(
782 & .false.,
783 & dad, keep(28),
784 & step, n,
785 & nodes_rhs, nb_nodes_rhs,
786 & pruned_sons, to_process,
787 & nb_prun_nodes, nb_prun_roots,
788 & nb_prun_leaves)
789 ALLOCATE(pruned_list(nb_prun_nodes), stat=allocok)
790 IF(allocok.GT.0) THEN
791 info(1)=-13
792 info(2)=nb_prun_nodes
793 END IF
794 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
795 IF(info(1).LT.0) GOTO 500
796 ALLOCATE(pruned_roots(nb_prun_roots), stat=allocok)
797 IF(allocok.GT.0) THEN
798 info(1)=-13
799 info(2)=nb_prun_roots
800 END IF
801 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
802 IF(info(1).LT.0) GOTO 500
803 ALLOCATE(pruned_leaves(nb_prun_leaves), stat=allocok)
804 IF(allocok.GT.0) THEN
805 info(1)=-13
806 info(2)=nb_prun_leaves
807 END IF
808 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
809 IF(info(1).LT.0) GOTO 500
810 CALL zmumps_chain_prun_nodes(
811 & .true.,
812 & dad, keep(28),
813 & step, n,
814 & nodes_rhs, nb_nodes_rhs,
815 & pruned_sons, to_process,
816 & nb_prun_nodes, nb_prun_roots, nb_prun_leaves,
817 & pruned_list, pruned_roots, pruned_leaves )
818 CALL zmumps_ooc_set_states_es(n,
819 & keep(201), pruned_list, nb_prun_nodes,
820 & step)
821 IF (keep(201).GT.0) THEN
822 ooc_fct_type_tmp=mumps_ooc_get_fct_type
823 & ('B',mtype,keep(201),keep(50))
824 ELSE
825 ooc_fct_type_tmp = -5959
826 ENDIF
827 CALL zmumps_chain_prun_nodes_stats(
828 & myid_nodes, n, keep(28), keep(201), keep(485), keep8(31),
829 & step, pruned_list, nb_prun_nodes, ooc_fct_type_tmp
830 & )
831 IF (do_nbsparse_bwd) THEN
832 nb_sparse = max(1,keep(497))
833 CALL zmumps_initialize_rhs_bounds(
834 & step, n,
835 & irhs_ptr, nbcol_inbloc, irhs_sparse, nz_rhs,
836 & jbeg_rhs, perm_rhs, size_perm_rhs, keep(242), keep(243),
837 & uns_perm_inv, size_uns_perm_inv, keep(23),
838 & rhs_bounds, keep(28),
839 & nb_sparse, myid_nodes,
840 & 1)
841 CALL zmumps_propagate_rhs_bounds(
842 & pruned_leaves, nb_prun_leaves,
843 & step, n, pruned_sons,
844 & dad, rhs_bounds, keep(28),
845 & myid_nodes, comm_nodes, keep(485),
846 & iw, liw, ptrist,keep(ixsz),ooc_fct_type_tmp,1,
847 & keep(50), keep(38))
848 END IF
849 ENDIF
850 IF ( keep(201).GT.0 ) THEN
851 iroot = max(keep(20),keep(38))
852 CALL zmumps_solve_init_ooc_bwd(ptrfac,keep(28),mtype,
853 & i_worked_on_root, iroot, a, la, ierr)
854 ENDIF
855 IF ( keep( 50 ) .eq. 0 ) THEN
856 mtype_loc = mtype
857 ELSE
858 mtype_loc = 0
859 ENDIF
860#if defined(V_T)
861 CALL vtbegin(back_soln,ierr)
862#endif
863 IF (.NOT.from_pp) THEN
864 CALL mumps_secdeb(time_bwd)
865 ENDIF
866 IF ( .NOT.special_root_reached ) THEN
867 rhs_root(1:nrhs*size_root) = zero
868 ENDIF
869 IF (am1.AND.(nb_fs_in_rhscomp_f.NE.nb_fs_in_rhscomp_tot)) THEN
870 DO i =1, n
871 ii = posinrhscomp_bwd(i)
872 IF ((ii.GT.0).AND.(ii.GT.nb_fs_in_rhscomp_f)) THEN
873 DO k=1,nrhs
874 rhscomp(ii, k) = zero
875 ENDDO
876 ENDIF
877 ENDDO
878 ENDIF
879 IF ( .NOT. do_prun ) THEN
880 IF ( .NOT. do_l0omp_bwd ) THEN
881 IF (do_l0omp_fwd) THEN
882 myleaf = -1
883 ENDIF
884 ENDIF
885 IF ( do_l0omp_bwd ) THEN
886 to_process(:) = .true.
887 DO i=1, l_phys_l0_omp
888 to_process( step(phys_l0_omp( i )))
889 & = .false.
890 ENDDO
891 IF (myleaf .EQ. -1) THEN
892 myleaf = ipool_a_l0_omp(lpool_a_l0_omp)
893 ENDIF
894 CALL mumps_init_pool_dist_na_bwd_l0( n, myroot, myid_nodes,
895 & na, lna, keep, keep8, step, procnode_steps,
896 & iw1(ipool), lpool, l0_omp_mapping )
897 ELSE
898 CALL mumps_init_pool_dist_na_bwd( n, myroot, myid_nodes,
899 & na, lna, keep, keep8, step, procnode_steps,
900 & iw1(ipool), lpool )
901 IF (myleaf .EQ. -1) THEN
902 CALL mumps_nblocal_roots_or_leaves( n,
903 & na(1),
904 & na(3),
905 & myleaf, myid_nodes, slavef, keep, step,
906 & procnode_steps )
907 ENDIF
908 ENDIF
909 ELSE
910 IF ( do_l0omp_bwd ) THEN
911 DO i=1, l_phys_l0_omp
912 IF ( to_process( step(phys_l0_omp( i ))) ) THEN
913 to_process( step(phys_l0_omp( i ))) = .false.
914 phys_l0_omp( i ) = -phys_l0_omp( i )
915 ENDIF
916 ENDDO
917 myleaf=0
918 DO istep = 1, keep(28)
919 IF ( mumps_procnode(procnode_steps(istep),keep(199))
920 & .NE. myid_nodes ) THEN
921 cycle
922 ENDIF
923 IF ( l0_omp_mapping( istep ) .NE. 0 ) THEN
924 cycle
925 ENDIF
926 IF ( .NOT. to_process( istep ) ) THEN
927 cycle
928 ENDIF
929 i = step2node( istep )
930 ichild = fils( i )
931 DO WHILE ( ichild .GT. 0 )
932 ichild = fils( ichild )
933 END DO
934 IF ( ichild .LT. 0 ) THEN
935 ichild = -ichild
936 DO WHILE ( ichild .GT. 0 )
937 IF ( l0_omp_mapping( step( ichild ) ) .EQ. 0 .AND.
938 & to_process(step( ichild )) ) THEN
939 GOTO 10
940 ENDIF
941 ichild = frere( step( ichild ) )
942 ENDDO
943 ENDIF
944 myleaf = myleaf + 1
945 10 CONTINUE
946 ENDDO
947 CALL mumps_init_pool_dist_na_bwdl0es( n, myroot,
948 & myid_nodes,
949 & na, lna, keep, keep8, step, procnode_steps,
950 & iw1(ipool), lpool, l0_omp_mapping, to_process )
951 ELSE
952 CALL mumps_init_pool_dist_bwd(n, nb_prun_roots,
953 & pruned_roots,
954 & myroot, myid_nodes, keep, keep8, step, procnode_steps,
955 & iw1(ipool), lpool)
956 CALL mumps_nblocal_roots_or_leaves( n,
957 & nb_prun_leaves, pruned_leaves,
958 & myleaf, myid_nodes, slavef, keep, step,
959 & procnode_steps )
960 ENDIF
961 ENDIF
962 IF ( do_l0omp_bwd
963 & ) THEN
964 keep(31) = 1
965 ELSE
966 keep(31) = 0
967 ENDIF
968 IF (keep(31) .EQ. 1) THEN
969 DO i = 1, keep(28)
970 IF (mumps_procnode(procnode_steps(i),keep(199)) .EQ.
971 & myid_nodes) THEN
972 IF ( .NOT. mumps_in_or_root_ssarbr(procnode_steps(i),
973 & keep(199)) ) THEN
974 IF ( l0_omp_mapping(i) .EQ. 0 ) THEN
975 IF ( do_prun
976 & .OR. do_l0omp_bwd
977 & ) THEN
978 IF ( to_process(i) ) THEN
979 keep(31) = keep(31) + 1
980 ENDIF
981 ELSE
982 keep(31) = keep(31) + 1
983 ENDIF
984 ENDIF
985 ENDIF
986 ENDIF
987 ENDDO
988 ENDIF
989 CALL zmumps_sol_s( n, a, la, iw, liw, w(1), lwc,
990 & nrhs,
991 & rhscomp, lrhscomp, posinrhscomp_bwd,
992 & iw1(ptricb),ptracb,iwcb,liww, w2,
993 & ne_steps,
994 & step, frere,dad,fils,
995 & iw1(ipool),lpool,ptrist,ptrfac,myleaf,myroot,icntl,info,
996 & procnode_steps, slavef, comm_nodes, myid_nodes,
997 & bufr, lbufr, lbufr_bytes, keep, keep8, dkeep,
998 & rhs_root, lrhs_root,
999 & mtype_loc,
1000 & istep_to_iniv2, tab_pos_in_pere, iw1(ipanel_pos),
1001 & lpanel_pos, prun_below_bwd, to_process, size_to_process
1002 & , rhs_bounds, lrhs_bounds, do_nbsparse_bwd
1003 & , from_pp
1004 & , l0_omp_mapping, ll0_omp_mapping,
1005 & l0_omp_factors, ll0_omp_factors
1006 & )
1007 IF ( do_l0omp_bwd .AND. do_prun ) THEN
1008 DO i = 1, l_phys_l0_omp
1009 IF ( phys_l0_omp( i ) .LT. 0 ) THEN
1010 phys_l0_omp( i ) = -phys_l0_omp( i )
1011 to_process(step(phys_l0_omp( i ) )) = .true.
1012 ENDIF
1013 ENDDO
1014 ENDIF
1015 IF (do_l0omp_bwd .AND. info(1) .GE. 0) THEN
1016 keep(31) = 0
1017 prun_below_bwd = am1
1018 CALL zmumps_sol_l0omp_s(n, mtype_loc, nrhs, liw, iw,
1019 & iw1(ptricb), ptracb, rhscomp, lrhscomp, posinrhscomp_bwd,
1020 & step, frere, fils, ne_steps, ptrist, ptrfac, info,
1021 & keep, keep8, dkeep, procnode_steps, slavef,
1022 & comm_nodes, myid_nodes, bufr, lbufr, lbufr_bytes,
1023 & rhs_root, lrhs_root, istep_to_iniv2, tab_pos_in_pere,
1024 & iw1(ipanel_pos), lpanel_pos,
1025 & prun_below_bwd, to_process, size_to_process,
1026 & rhs_bounds, lrhs_bounds, do_nbsparse_bwd,
1027 & from_pp,
1028 & lpool_b_l0_omp,
1029 & l_virt_l0_omp, virt_l0_omp,
1030 & l_phys_l0_omp, phys_l0_omp,
1031 & perm_l0_omp, ptr_leafs_l0_omp,
1032 & l0_omp_mapping, ll0_omp_mapping,
1033 & l0_omp_factors, ll0_omp_factors )
1034 ENDIF
1035 CALL zmumps_clean_pending( info(1), keep,
1036 & bufr, lbufr,lbufr_bytes,
1037 & comm_nodes, idummy,
1038 & slavef, .true., .false. )
1039 CALL mumps_propinfo(icntl, info, comm_nodes, myid )
1040#if defined(V_T)
1041 CALL vtend(back_soln,ierr)
1042#endif
1043 IF (.NOT.from_pp) THEN
1044 CALL mumps_secfin(time_bwd)
1045 dkeep(118)=time_bwd+dkeep(118)
1046 ENDIF
1047 ENDIF
1048 IF (ldiag.GT.2 .AND. mp.GT.0) THEN
1049 IF (doforward) THEN
1050 k = min0(10,size(rhscomp,1))
1051 IF (ldiag.EQ.4) k = size(rhscomp,1)
1052 IF ( .NOT. from_pp) THEN
1053 WRITE (mp,99992)
1054 IF (size(rhscomp,1).GT.0)
1055 & WRITE (mp,99993) (rhscomp(i,1),i=1,k)
1056 IF (size(rhscomp,1).GT.0.and.nrhs>1)
1057 & WRITE (mp,99994) (rhscomp(i,2),i=1,k)
1058 ENDIF
1059 ENDIF
1060 ENDIF
1061500 CONTINUE
1062 IF ( allocated(to_process)) DEALLOCATE (to_process)
1063 IF (exploit_sparsity.OR.am1.OR.switch_off_es) THEN
1064 IF ( allocated(nodes_rhs)) DEALLOCATE (nodes_rhs)
1065 IF ( allocated(pruned_sons)) DEALLOCATE (pruned_sons)
1066 IF ( allocated(pruned_roots)) DEALLOCATE (pruned_roots)
1067 IF ( allocated(pruned_list)) DEALLOCATE (pruned_list)
1068 IF ( allocated(pruned_leaves)) DEALLOCATE (pruned_leaves)
1069 ENDIF
1070 RETURN
107199993 FORMAT (' RHS (internal, first column)'/(1x,1p,5d14.6))
107299994 FORMAT (' RHS (internal, 2 nd column)'/(1x,1p,5d14.6))
107399992 FORMAT (//' LEAVING SOLVE (ZMUMPS_SOL_C) WITH')
mpi_barrier
subroutine mpi_barrier(comm, ierr)
Definition mpi.f:188
mumps_ooc_get_fct_type
integer function mumps_ooc_get_fct_type(fwdorbwd, mtype, k201, k50)
Definition mumps_ooc_common.F:97
zmumps_ooc
Definition zmumps_ooc.F:14
zmumps_ooc::ooc_state_node
integer, dimension(:), allocatable ooc_state_node
Definition zmumps_ooc.F:49
zmumps_ooc::zmumps_free_factors_for_solve
subroutine zmumps_free_factors_for_solve(inode, ptrfac, nsteps, a, la, flag, ierr)
Definition zmumps_ooc.F:1204
zmumps_ooc::zmumps_ooc_set_states_es
subroutine zmumps_ooc_set_states_es(n, keep201, pruned_list, nb_prun_nodes, step)
Definition zmumps_ooc.F:3451
zmumps_ooc::zmumps_solve_init_ooc_fwd
subroutine, public zmumps_solve_init_ooc_fwd(ptrfac, nsteps, mtype, a, la, doprefetch, ierr)
Definition zmumps_ooc.F:2707
zmumps_ooc::zmumps_solve_init_ooc_bwd
subroutine, public zmumps_solve_init_ooc_bwd(ptrfac, nsteps, mtype, i_worked_on_root, iroot, a, la, ierr)
Definition zmumps_ooc.F:2744
zmumps_sol_es
Definition zmumps_sol_es.F:14
zmumps_sol_es::zmumps_chain_prun_nodes
subroutine, public zmumps_chain_prun_nodes(fill, dad, keep28, step, n, nodes_rhs, nb_nodes_rhs, pruned_sons, to_process, nb_prun_nodes, nb_prun_roots, nb_prun_leaves, pruned_list, pruned_roots, pruned_leaves)
Definition zmumps_sol_es.F:139
zmumps_sol_es::zmumps_chain_prun_nodes_stats
subroutine, public zmumps_chain_prun_nodes_stats(myid, n, keep28, keep201, keep485, fr_fact, step, pruned_list, nb_prun_nodes, ooc_fct_type_loc)
Definition zmumps_sol_es.F:439
zmumps_sol_es::zmumps_propagate_rhs_bounds
subroutine, public zmumps_propagate_rhs_bounds(pruned_leaves, nb_pruned_leaves, step, n, pruned_sons, dad, rhs_bounds, nsteps, myid, comm, keep485, iw, liw, ptrist, kixsz, ooc_fct_loc, phase, ldlt, k38)
Definition zmumps_sol_es.F:269
zmumps_sol_es::zmumps_tree_prun_nodes
subroutine, public zmumps_tree_prun_nodes(fill, dad, ne_steps, frere, keep28, fils, step, n, nodes_rhs, nb_nodes_rhs, to_process, nb_prun_nodes, nb_prun_roots, nb_prun_leaves, pruned_list, pruned_roots, pruned_leaves)
Definition zmumps_sol_es.F:48
zmumps_sol_es::zmumps_initialize_rhs_bounds
subroutine, public zmumps_initialize_rhs_bounds(step, n, irhs_ptr, nbcol, irhs_sparse, nz_rhs, jbeg_rhs, perm_rhs, size_perm_rhs, k242, k243, uns_perm_inv, size_uns_perm_inv, k23, rhs_bounds, nsteps, nb_sparse, myid, mode)
Definition zmumps_sol_es.F:215
zmumps_sol_es::zmumps_tree_prun_nodes_stats
subroutine, public zmumps_tree_prun_nodes_stats(myid, n, keep28, keep201, fr_fact, step, pruned_list, nb_prun_nodes, ooc_fct_type_loc)
Definition zmumps_sol_es.F:417
zmumps_sol_l0omp_m
Definition zsol_omp_m.F:14
zmumps_sol_l0omp_m::zmumps_sol_l0omp_s
subroutine zmumps_sol_l0omp_s(n, mtype, nrhs, liw, iw, ptricb, ptracb, rhscomp, lrhscomp, posinrhscomp_bwd, step, frere, fils, ne_steps, ptrist, ptrfac, info, keep, keep8, dkeep, procnode_steps, slavef, comm, myid, bufr, lbufr, lbufr_bytes, rhs_root, lrhs_root, istep_to_iniv2, tab_pos_in_pere, panel_pos, lpanel_pos, prun_below_bwd, to_process, size_to_process, rhs_bounds, lrhs_bounds, do_nbsparse, from_pp, lpool_b_l0_omp, l_virt_l0_omp, virt_l0_omp, l_phys_l0_omp, phys_l0_omp, perm_l0_omp, ptr_leafs_l0_omp, l0_omp_mapping, ll0_omp_mapping, l0_omp_factors, ll0_omp_factors)
Definition zsol_omp_m.F:299
zmumps_sol_l0omp_m::zmumps_sol_l0omp_r
subroutine zmumps_sol_l0omp_r(n, mtype, nrhs, liw, iw, ptricb, rhscomp, lrhscomp, posinrhscomp_fwd, step, frere, dad, fils, nstk, ptrist, ptrfac, info, keep, keep8, dkeep, procnode_steps, slavef, comm, myid, bufr, lbufr, lbufr_bytes, rhs_root, lrhs_root, istep_to_iniv2, tab_pos_in_pere, rhs_bounds, lrhs_bounds, do_nbsparse, from_pp, nbroot_under_l0, lpool_b_l0_omp, ipool_b_l0_omp, l_virt_l0_omp, virt_l0_omp, l_phys_l0_omp, phys_l0_omp, perm_l0_omp, ptr_leafs_l0_omp, l0_omp_mapping, ll0_omp_mapping, l0_omp_factors, ll0_omp_factors, do_prun, to_process)
Definition zsol_omp_m.F:62
zmumps_struc_def
Definition zmumps_struc_def.F:14
mumps_nblocal_roots_or_leaves
subroutine mumps_nblocal_roots_or_leaves(n, nbrorl, rorl_list, nrorl_loc, myid_nodes, slavef, keep, step, procnode_steps)
Definition tools_common.F:669
mumps_secfin
subroutine mumps_secfin(t)
Definition tools_common.F:277
mumps_init_pool_dist_na_bwd_l0
subroutine mumps_init_pool_dist_na_bwd_l0(n, myroot, myid_nodes, na, lna, keep, keep8, step, procnode_steps, ipool, lpool, l0_omp_mapping)
Definition tools_common.F:524
mumps_in_or_root_ssarbr
logical function mumps_in_or_root_ssarbr(procinfo_inode, k199)
Definition tools_common.F:214
mumps_init_pool_dist
subroutine mumps_init_pool_dist(n, leaf, myid_nodes, k199, na, lna, keep, keep8, step, procnode_steps, ipool, lpool)
Definition tools_common.F:587
mumps_init_pool_dist_bwd
subroutine mumps_init_pool_dist_bwd(n, nb_prun_roots, pruned_roots, myroot, myid_nodes, keep, keep8, step, procnode_steps, ipool, lpool)
Definition tools_common.F:443
mumps_init_pool_dist_na_bwdl0es
subroutine mumps_init_pool_dist_na_bwdl0es(n, myroot, myid_nodes, na, lna, keep, keep8, step, procnode_steps, ipool, lpool, l0_omp_mapping, to_process)
Definition tools_common.F:554
mumps_init_pool_dist_nona
subroutine mumps_init_pool_dist_nona(n, leaf, myid_nodes, lleaves, leaves, keep, keep8, step, procnode_steps, ipool, lpool)
Definition tools_common.F:614
mumps_init_pool_dist_na_bwd
subroutine mumps_init_pool_dist_na_bwd(n, myroot, myid_nodes, na, lna, keep, keep8, step, procnode_steps, ipool, lpool)
Definition tools_common.F:498
mumps_secdeb
subroutine mumps_secdeb(t)
Definition tools_common.F:270
mumps_init_nroot_dist
subroutine mumps_init_nroot_dist(n, nbroot, nroot_loc, myid_nodes, slavef, na, lna, keep, step, procnode_steps)
Definition tools_common.F:639
zmumps_clean_pending
subroutine zmumps_clean_pending(info1, keep, bufr, lbufr, lbufr_bytes, comm_nodes, comm_load, slavef, clean_comm_nodes, clean_comm_load)
Definition zfac_process_message.F:819
zmumps_solve_get_ooc_node
subroutine zmumps_solve_get_ooc_node(inode, ptrfac, keep, a, la, step, keep8, n, must_be_permuted, ierr)
Definition zsol_aux.F:733
zmumps_sol_s
subroutine zmumps_sol_s(n, a, la, iw, liw, w, lwc, nrhs, rhscomp, lrhscomp, posinrhscomp_bwd, ptricb, ptracb, iwcb, liww, w2, ne_steps, step, frere, dad, fils, ipool, lpool, ptrist, ptrfac, myleaf, myroot, icntl, info, procnode_steps, slavef, comm, myid, bufr, lbufr, lbufr_bytes, keep, keep8, dkeep, rhs_root, lrhs_root, mtype, istep_to_iniv2, tab_pos_in_pere, panel_pos, lpanel_pos, prun_below, to_process, size_to_process, rhs_bounds, lrhs_bounds, do_nbsparse, from_pp, l0_omp_mapping, ll0_omp_mapping, l0_omp_factors, ll0_omp_factors)
Definition zsol_bwd.F:31
zmumps_sol_r
subroutine zmumps_sol_r(n, a, la, iw, liw, wcb, lwcb, nrhs, ptricb, iwcb, liwcb, rhscomp, lrhscomp, posinrhscomp_fwd, step, frere, dad, fils, nstk, ipool, lpool, ptrist, ptrfac, myleaf, myroot, info, keep, keep8, dkeep, procnode_steps, slavef, comm, myid, bufr, lbufr, lbufr_bytes, rhs_root, lrhs_root, mtype, istep_to_iniv2, tab_pos_in_pere, rhs_bounds, lrhs_bounds, do_nbsparse, from_pp, l0_omp_mapping, ll0_omp_mapping, l0_omp_factors, ll0_omp_factors)
Definition zsol_fwd.F:32
zmumps_root_solve
subroutine zmumps_root_solve(nrhs, desca_par, cntxt_par, local_m, local_n, mblock, nblock, ipiv, lpiv, master_root, myid, comm, rhs_seq, size_root, a, info, mtype, ldlt)
Definition zsol_root_parallel.F:18