OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zmumps_buf Module Reference

Data Types

type  zmumps_comm_buffer_type

Functions/Subroutines

subroutine, public zmumps_buf_try_free_cb ()
subroutine zmumps_buf_try_free (b)
subroutine, public zmumps_buf_ini_myid (myid)
subroutine, public zmumps_buf_init (intsize, realsize)
subroutine, public zmumps_buf_alloc_cb (size, ierr)
subroutine, public zmumps_buf_alloc_small_buf (size, ierr)
subroutine, public zmumps_buf_alloc_load_buffer (size, ierr)
subroutine, public zmumps_buf_deall_load_buffer (ierr)
subroutine, public zmumps_buf_deall_max_array ()
subroutine, public zmumps_buf_max_array_minsize (nfs4father, ierr)
subroutine, public zmumps_buf_deall_cb (ierr)
subroutine, public zmumps_buf_deall_small_buf (ierr)
subroutine buf_alloc (buf, size, ierr)
subroutine buf_deall (buf, ierr)
subroutine, public zmumps_buf_send_cb (nbrows_already_sent, inode, fpere, nfront, lcont, nass, npiv, iwrow, iwcol, a, packed_cb, dest, tag, comm, keep, ierr)
subroutine, public zmumps_buf_send_master2slave (nrhs, inode, ifath, eff_cb_size, ld_cb, ld_piv, npiv, jbdeb, jbfin, cb, sol, dest, comm, keep, ierr)
subroutine, public zmumps_buf_send_vcb (nrhs_b, node1, node2, ncb, ldw, long, iw, w, jbdeb, jbfin, rhscomp, nrhs, lrhscomp, iposinrhscomp, npiv, keep, dest, tag, comm, ierr)
subroutine, public zmumps_buf_send_1int (i, dest, tag, comm, keep, ierr)
subroutine, public zmumps_buf_all_empty (check_comm_nodes, check_comm_load, flag)
subroutine zmumps_buf_empty (b, flag)
subroutine zmumps_buf_size_available (b, size_av)
subroutine, public zmumps_buf_test ()
subroutine buf_look (b, ipos, ireq, msg_size, ierr, ndest, pdest, test_only)
subroutine buf_adjust (buf, size)
subroutine, public zmumps_buf_send_desc_bande (inode, nbprocfils, nlig, ilig, ncol, icol, nass, nslaves_hdr, list_slaves, nslaves, estim_nfs4father_atson, dest, ibc_source, nfront, comm, keep, ierr, lrstatus)
subroutine, public zmumps_buf_send_maitre2 (nbrows_already_sent, ipere, ison, nrow, irow, ncol, icol, val, lda, nelim, type_son, nslaves, slaves, dest, comm, ierr, slavef, keep, keep8, iniv2, tab_pos_in_pere)
subroutine, public zmumps_buf_send_contrib_type2 (nbrows_already_sent, desc_in_lu, ipere, nfront_pere, nass_pere, nfs4father, nslaves_pere, ison, nbrow, lmap, maprow, perm, iw_cbson, a_cbson, la_cbson, islave, pdest, pdest_master, comm, ierr, keep, keep8, step, n, slavef, istep_to_iniv2, tab_pos_in_pere, packed_cb, keep253_loc, nvschur, son_niv, myid, npiv_check)
subroutine mumps_blr_get_sizereals_cb_lrb (size_out, cb_lrb, nb_row_shift, nb_col_shift, nb_blr_cols, panel2send)
subroutine, public zmumps_blr_pack_cb_lrb (cb_lrb, nb_row_shift, nb_col_shift, nb_blr_cols, panel2send, panel_beg_offset, buf, lbuf, position, comm, ierr)
subroutine, public zmumps_buf_send_maplig (inode, nfront, nass1, nfs4father, ison, myid, nslaves, slaves_pere, trow, ncbson, comm, ierr, dest, ndest, slavef, keep, keep8, step, n, istep_to_iniv2, tab_pos_in_per)
subroutine, public zmumps_buf_send_blocfacto (inode, nfront, ncol, npiv, fpere, lastbl, ipiv, val, pdest, ndest, keep, nb_bloc_fac, nslaves_tot, width, comm, nelim, npartsass, current_blr_panel, lr_activated, blr_loru ierr)
subroutine, public zmumps_buf_send_blfac_slave (inode, npiv, fpere, iposk, jposk, uip21k, ncolu, ndest, pdest, comm, keep, lr_activated, blr_ls, ipanel, a, la, posblocfacto, ld_blocfacto, ipiv, maxi_cluster, ierr)
subroutine, public zmumps_buf_send_contrib_type3 (n, ison, nbcol_son, nbrow_son, indcol_son, indrow_son, ld_son, val_son, tag, subset_row, subset_col, nsubset_row, nsubset_col, nsuprow, nsupcol, nprow, npcol, mblock, rg2l_row, rg2l_col, nblock, pdest, comm, ierr, tab, tabsize, transp, size_pack, n_already_sent, keep, bbpcbp)
subroutine, public zmumps_buf_send_rtnelind (ison, nelim, nelim_row, nelim_col, nslaves, slaves, dest, comm, keep, ierr)
subroutine, public zmumps_buf_send_root2son (ison, nelim_root, dest, comm, keep, ierr)
subroutine, public zmumps_buf_send_root2slave (tot_root_size, tot_cont2recv, dest, comm, keep, ierr)
subroutine, public zmumps_buf_send_backvec (nrhs, inode, w, lw, ld_w, dest, msgtag, jbdeb, jbfin, keep, comm, ierr)
subroutine, public zmumps_buf_send_update_load (bdc_sbtr, bdc_mem, bdc_md, comm, nprocs, load, mem, sbtr_cur, lu_usage, future_niv2, myid, keep, ierr)
subroutine, public zmumps_buf_broadcast (what, comm, nprocs, future_niv2, load, upd_load, myid, keep, ierr)
subroutine, public zmumps_buf_send_fils (what, comm, nprocs, father_node, inode, ncb, keep, myid, remote, ierr)
subroutine, public zmumps_buf_send_not_mstr (comm, myid, nprocs, max_surf_master, keep, ierr)
subroutine, public zmumps_buf_bcast_array (bdc_mem, comm, myid, nprocs, future_niv2, nslaves, list_slaves, inode, mem_increment, flops_increment, cb_band, what, keep, ierr)
subroutine, public zmumps_buf_dist_irecv_size (zmumps_lbufr_bytes)
subroutine mumps_mpi_pack_size_lr (blr_loru, size_out, comm, ierr)
subroutine mumps_mpi_pack_size_lrb (lrb, size_out, comm, ierr)
subroutine zmumps_mpi_pack_lr (blr_loru, buf, lbuf, position, comm, ierr)
subroutine, public zmumps_mpi_pack_lrb (lrb, buf, lbuf, position, comm, ierr)
subroutine, public zmumps_mpi_unpack_lrb (bufr, lbufr, lbufr_bytes, position, lrb, keep8, comm, iflag, ierror)
subroutine mumps_mpi_pack_scale_lr (blr, buf, lbuf, position, comm, a, la, poseltd, ld_diag, ipiv, npiv, maxi_cluster, ierr)

Variables

integer next
integer req
integer content
integer ovhsize
integer, save sizeofint
integer, save sizeofreal
integer, save buf_myid
type(zmumps_comm_buffer_type), save buf_cb
type(zmumps_comm_buffer_type), save buf_small
type(zmumps_comm_buffer_type), save buf_load
integer, save size_rbuf_bytes
integer, save, public buf_lmax_array
double precision, dimension(:), allocatable, target, save, public buf_max_array

Function/Subroutine Documentation

◆ buf_adjust()

subroutine zmumps_buf::buf_adjust ( type ( zmumps_comm_buffer_type ) buf,
integer size )
private

Definition at line 767 of file zmumps_comm_buffer.F.

768 IMPLICIT NONE
769 TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: BUF
770 INTEGER SIZE
771 INTEGER SIZE_INT
772 size_int = ( SIZE + sizeofint - 1 ) / sizeofint
773 size_int = size_int + ovhsize
774 buf%TAIL = buf%ILASTMSG + size_int
775 RETURN

◆ buf_alloc()

subroutine zmumps_buf::buf_alloc ( type ( zmumps_comm_buffer_type ) buf,
integer size,
integer ierr )
private

Definition at line 171 of file zmumps_comm_buffer.F.

172 IMPLICIT NONE
173 TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: BUF
174 INTEGER SIZE, IERR
175 ierr = 0
176 buf%LBUF = SIZE
177 buf%LBUF_INT = ( SIZE + sizeofint - 1 ) / sizeofint
178 IF ( associated ( buf%CONTENT ) ) DEALLOCATE( buf%CONTENT )
179 ALLOCATE( buf%CONTENT( buf%LBUF_INT ), stat = ierr )
180 IF (ierr .NE. 0) THEN
181 NULLIFY( buf%CONTENT )
182 ierr = -1
183 buf%LBUF = 0
184 buf%LBUF_INT = 0
185 END IF
186 buf%HEAD = 1
187 buf%TAIL = 1
188 buf%ILASTMSG = 1
189 RETURN

◆ buf_deall()

subroutine zmumps_buf::buf_deall ( type ( zmumps_comm_buffer_type ) buf,
integer ierr )
private

Definition at line 191 of file zmumps_comm_buffer.F.

192 IMPLICIT NONE
193 TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: BUF
194 INTEGER :: IERR
195 include 'mpif.h'
196 INTEGER :: IERR_MPI
197 INTEGER :: STATUS(MPI_STATUS_SIZE)
198 LOGICAL :: FLAG
199 IF ( .NOT. associated ( buf%CONTENT ) ) THEN
200 buf%HEAD = 1
201 buf%LBUF = 0
202 buf%LBUF_INT = 0
203 buf%TAIL = 1
204 buf%ILASTMSG = 1
205 RETURN
206 END IF
207 DO WHILE ( buf%HEAD.NE.0 .AND. buf%HEAD .NE. buf%TAIL )
208 CALL mpi_test(buf%CONTENT( buf%HEAD + req ), flag,
209 & status, ierr_mpi)
210 IF ( .not. flag ) THEN
211 WRITE(*,*) '** Warning: trying to cancel a request.'
212 WRITE(*,*) '** This might be problematic'
213 CALL mpi_cancel( buf%CONTENT( buf%HEAD + req ), ierr_mpi )
214 CALL mpi_request_free( buf%CONTENT( buf%HEAD + req ),
215 & ierr_mpi )
216 END IF
217 buf%HEAD = buf%CONTENT( buf%HEAD + next )
218 END DO
219 DEALLOCATE( buf%CONTENT )
220 NULLIFY( buf%CONTENT )
221 buf%LBUF = 0
222 buf%LBUF_INT = 0
223 buf%HEAD = 1
224 buf%TAIL = 1
225 buf%ILASTMSG = 1
226 RETURN
mpi_test
subroutine mpi_test(ireq, flag, status, ierr)
Definition mpi.f:502
mpi_request_free
subroutine mpi_request_free(ireq, ierr)
Definition mpi.f:472
mpi_cancel
subroutine mpi_cancel(ireq, ierr)
Definition mpi.f:214

◆ buf_look()

subroutine zmumps_buf::buf_look ( type ( zmumps_comm_buffer_type ) b,
integer, intent(out) ipos,
integer, intent(out) ireq,
integer, intent(in) msg_size,
integer, intent(out) ierr,
integer ndest,
integer, dimension(max(1,ndest)), intent(in) pdest,
logical, intent(in), optional test_only )
private

Definition at line 699 of file zmumps_comm_buffer.F.

701 IMPLICIT NONE
702 TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: B
703 INTEGER, INTENT(IN) :: MSG_SIZE
704 INTEGER, INTENT(OUT) :: IPOS, IREQ, IERR
705 LOGICAL, INTENT(IN), OPTIONAL :: TEST_ONLY
706 INTEGER NDEST
707 INTEGER, INTENT(IN) :: PDEST(max(1,NDEST))
708 include 'mpif.h'
709 INTEGER :: IERR_MPI
710 INTEGER :: MSG_SIZE_INT
711 INTEGER :: IBUF
712 LOGICAL :: FLAG
713 INTEGER :: STATUS(MPI_STATUS_SIZE)
714 ierr = 0
715 IF ( b%HEAD .NE. b%TAIL ) THEN
716 10 CONTINUE
717 CALL mpi_test( b%CONTENT( b%HEAD + req ), flag, status,
718 & ierr_mpi )
719 IF ( flag ) THEN
720 b%HEAD = b%CONTENT( b%HEAD + next )
721 IF ( b%HEAD .EQ. 0 ) b%HEAD = b%TAIL
722 IF ( b%HEAD .NE. b%TAIL ) GOTO 10
723 END IF
724 END IF
725 IF ( b%HEAD .EQ. b%TAIL ) THEN
726 b%HEAD = 1
727 b%TAIL = 1
728 b%ILASTMSG = 1
729 END iF
730 msg_size_int = ( msg_size + ( sizeofint - 1 ) ) / sizeofint
731 msg_size_int = msg_size_int + ovhsize
732 IF (present(test_only)) RETURN
733 flag = ( ( b%HEAD .LE. b%TAIL )
734 & .AND. (
735 & ( msg_size_int .LE. b%LBUF_INT - b%TAIL )
736 & .OR. ( msg_size_int .LE. b%HEAD - 2 ) ) )
737 & .OR.
738 & ( ( b%HEAD .GT. b%TAIL )
739 & .AND. ( msg_size_int .LE. b%HEAD - b%TAIL - 1 ) )
740 IF ( .NOT. flag
741 & ) THEN
742 ierr = -1
743 IF ( msg_size_int .GT. b%LBUF_INT - 1 ) THEN
744 ierr = -2
745 ENDIF
746 ipos = -1
747 ireq = -1
748 RETURN
749 END IF
750 IF ( b%HEAD .LE. b%TAIL ) THEN
751 IF ( msg_size_int .LE. b%LBUF_INT - b%TAIL + 1 ) THEN
752 ibuf = b%TAIL
753 ELSE IF ( msg_size_int .LE. b%HEAD - 1 ) THEN
754 ibuf = 1
755 END IF
756 ELSE
757 ibuf = b%TAIL
758 END IF
759 b%CONTENT( b%ILASTMSG + next ) = ibuf
760 b%ILASTMSG = ibuf
761 b%TAIL = ibuf + msg_size_int
762 b%CONTENT( ibuf + next ) = 0
763 ipos = ibuf + content
764 ireq = ibuf + req
765 RETURN

◆ mumps_blr_get_sizereals_cb_lrb()

subroutine zmumps_buf::mumps_blr_get_sizereals_cb_lrb ( integer, intent(out) size_out,
type(lrb_type), dimension(:,:), pointer cb_lrb,
integer, intent(in) nb_row_shift,
integer, intent(in) nb_col_shift,
integer, intent(in) nb_blr_cols,
integer, intent(in) panel2send )
private

Definition at line 1585 of file zmumps_comm_buffer.F.

1589 USE zmumps_lr_type
1590 IMPLICIT NONE
1591 TYPE(LRB_TYPE), POINTER :: CB_LRB(:,:)
1592 INTEGER, INTENT(IN) :: NB_ROW_SHIFT, NB_COL_SHIFT, NB_BLR_COLS,
1593 & PANEL2SEND
1594 INTEGER, intent(out) :: SIZE_OUT
1595 INTEGER :: J
1596 TYPE(LRB_TYPE), POINTER :: LRB
1597 size_out = 0
1598 DO j=1,nb_blr_cols-nb_col_shift
1599 lrb => cb_lrb(panel2send-nb_row_shift,j)
1600 IF (lrb%ISLR) THEN
1601 IF (lrb%K.GT.0) THEN
1602 size_out = size_out + lrb%K*(lrb%M+lrb%N)
1603 ENDIF
1604 ELSE
1605 size_out = size_out + lrb%M*lrb%N
1606 ENDIF
1607 ENDDO
1608 RETURN
zmumps_lr_type
Definition zlr_type.F:14

◆ mumps_mpi_pack_scale_lr()

subroutine zmumps_buf::mumps_mpi_pack_scale_lr ( type (lrb_type), dimension(:), intent(in) blr,
integer, dimension(:), intent(inout) buf,
integer, intent(in) lbuf,
integer, intent(inout) position,
integer, intent(in) comm,
complex(kind=8), dimension(la), intent(inout) a,
integer(8), intent(in) la,
integer(8), intent(in) poseltd,
integer, intent(in) ld_diag,
integer, dimension(npiv), intent(in) ipiv,
integer, intent(in) npiv,
integer, intent(in) maxi_cluster,
integer, intent(out) ierr )
private

Definition at line 3320 of file zmumps_comm_buffer.F.

3326 USE zmumps_lr_type
3327 INTEGER, intent(out) :: IERR
3328 INTEGER, intent(in) :: COMM, LBUF
3329 INTEGER, intent(inout) :: POSITION
3330 INTEGER, intent(inout) :: BUF(:)
3331 TYPE (LRB_TYPE), DIMENSION(:), intent(in) :: BLR
3332 INTEGER(8), intent(in) :: LA, POSELTD
3333 INTEGER, intent(in) :: LD_DIAG, NPIV
3334 INTEGER, intent(in) :: IPIV(NPIV), MAXI_CLUSTER
3335 COMPLEX(kind=8), intent(inout) :: A(LA)
3336 INTEGER :: IERR_MPI
3337 INTEGER I, ISLR_INT, J, ALLOCOK
3338 COMPLEX(kind=8), ALLOCATABLE,DIMENSION(:,:) :: SCALED
3339 COMPLEX(kind=8), ALLOCATABLE,DIMENSION(:) :: BLOCK
3340 COMPLEX(kind=8) :: PIV1, PIV2, OFFDIAG
3341 include 'mpif.h'
3342 ierr = 0
3343 CALL mpi_pack( size(blr), 1, mpi_integer,
3344 & buf(1), lbuf, position, comm, ierr_mpi )
3345 allocate(block(maxi_cluster), stat=allocok )
3346 IF ( allocok .GT. 0 ) THEN
3347 WRITE(*,*) 'pb allocation in mumps_mpi_pack_scale_lr'
3348 ierr = -1
3349 GOTO 500
3350 END IF
3351 allocate(scaled(maxi_cluster,2), stat=allocok )
3352 IF ( allocok .GT. 0 ) THEN
3353 WRITE(*,*) 'pb allocation in mumps_mpi_pack_scale_lr'
3354 ierr = -1
3355 GOTO 500
3356 END IF
3357 DO i = 1, size(blr)
3358 IF (blr(i)%ISLR) THEN
3359 islr_int = 1
3360 ELSE
3361 islr_int = 0
3362 ENDIF
3363 CALL mpi_pack( islr_int, 1, mpi_integer,
3364 & buf(1), lbuf, position, comm, ierr_mpi )
3365 CALL mpi_pack( blr(i)%K,
3366 & 1, mpi_integer,
3367 & buf(1), lbuf, position, comm, ierr_mpi )
3368 CALL mpi_pack( blr(i)%M,
3369 & 1, mpi_integer,
3370 & buf(1), lbuf, position, comm, ierr_mpi )
3371 CALL mpi_pack( blr(i)%N,
3372 & 1, mpi_integer,
3373 & buf(1), lbuf, position, comm, ierr_mpi )
3374 IF (blr(i)%ISLR) THEN
3375 IF (blr(i)%K .GT. 0) THEN
3376 CALL mpi_pack( blr(i)%Q(1,1), blr(i)%M*blr(i)%K,
3377 & mpi_double_complex,
3378 & buf(1), lbuf, position, comm, ierr_mpi )
3379 j =1
3380 DO WHILE (j <= blr(i)%N)
3381 IF (ipiv(j) > 0) THEN
3382 scaled(1:blr(i)%K,1) = a(poseltd+ld_diag*(j-1)+j-1)
3383 & * blr(i)%R(1:blr(i)%K,j)
3384 j = j+1
3385 CALL mpi_pack( scaled(1,1), blr(i)%K,
3386 & mpi_double_complex,
3387 & buf(1), lbuf, position, comm, ierr_mpi )
3388 ELSE
3389 piv1 = a(poseltd+ld_diag*(j-1)+j-1)
3390 piv2 = a(poseltd+ld_diag*j+j)
3391 offdiag = a(poseltd+ld_diag*(j-1)+j)
3392 block(1:blr(i)%K) = blr(i)%R(1:blr(i)%K,j)
3393 scaled(1:blr(i)%K,1) = piv1 * blr(i)%R(1:blr(i)%K,j)
3394 & + offdiag * blr(i)%R(1:blr(i)%K,j+1)
3395 CALL mpi_pack( scaled(1,1), blr(i)%K,
3396 & mpi_double_complex,
3397 & buf(1), lbuf, position, comm, ierr_mpi )
3398 scaled(1:blr(i)%K,2) = offdiag * block(1:blr(i)%K)
3399 & + piv2 * blr(i)%R(1:blr(i)%K,j+1)
3400 j =j+2
3401 CALL mpi_pack( scaled(1,2), blr(i)%K,
3402 & mpi_double_complex,
3403 & buf(1), lbuf, position, comm, ierr_mpi )
3404 ENDIF
3405 END DO
3406 ENDIF
3407 ELSE
3408 j = 1
3409 DO WHILE (j <= blr(i)%N)
3410 IF (ipiv(j) > 0) THEN
3411 scaled(1:blr(i)%M,1) = a(poseltd+ld_diag*(j-1)+j-1)
3412 & * blr(i)%Q(1:blr(i)%M,j)
3413 CALL mpi_pack( scaled(1,1), blr(i)%M,
3414 & mpi_double_complex,
3415 & buf(1), lbuf, position, comm, ierr_mpi )
3416 j = j+1
3417 ELSE
3418 piv1 = a(poseltd+ld_diag*(j-1)+j-1)
3419 piv2 = a(poseltd+ld_diag*j+j)
3420 offdiag = a(poseltd+ld_diag*(j-1)+j)
3421 block(1:blr(i)%M) = blr(i)%Q(1:blr(i)%M,j)
3422 scaled(1:blr(i)%M,1) = piv1 * blr(i)%Q(1:blr(i)%M,j)
3423 & + offdiag * blr(i)%Q(1:blr(i)%M,j+1)
3424 CALL mpi_pack( scaled(1,1), blr(i)%M,
3425 & mpi_double_complex,
3426 & buf(1), lbuf, position, comm, ierr_mpi )
3427 scaled(1:blr(i)%M,2) = offdiag * block(1:blr(i)%M)
3428 & + piv2 * blr(i)%Q(1:blr(i)%M,j+1)
3429 CALL mpi_pack( scaled(1,2), blr(i)%M,
3430 & mpi_double_complex,
3431 & buf(1), lbuf, position, comm, ierr_mpi )
3432 j=j+2
3433 ENDIF
3434 END DO
3435 ENDIF
3436 ENDDO
3437 500 CONTINUE
3438 IF (allocated(block)) deallocate(block)
3439 IF (allocated(scaled)) deallocate(scaled)
3440 RETURN
mpi_pack
subroutine mpi_pack(inbuf, incnt, datatype, outbuf, outcnt, position, comm, ierr)
Definition mpi.f:428

◆ mumps_mpi_pack_size_lr()

subroutine zmumps_buf::mumps_mpi_pack_size_lr ( type (lrb_type), dimension(:), intent(in) blr_loru,
integer, intent(out) size_out,
integer, intent(in) comm,
integer, intent(out) ierr )
private

Definition at line 3150 of file zmumps_comm_buffer.F.

3152 USE zmumps_lr_type
3153 INTEGER, intent(out) :: SIZE_OUT, IERR
3154 INTEGER, intent(in) :: COMM
3155 TYPE (LRB_TYPE), DIMENSION(:), intent(in) :: BLR_LorU
3156 INTEGER :: I, SIZE_LOC, IERR_MPI
3157 include 'mpif.h'
3158 ierr = 0
3159 size_out = 0
3160 CALL mpi_pack_size( 1, mpi_integer, comm, size_loc, ierr_mpi )
3161 size_out = size_out + size_loc
3162 DO i = 1, size(blr_loru)
3163 CALL mumps_mpi_pack_size_lrb(blr_loru(i), size_loc, comm,
3164 & ierr )
3165 size_out = size_out + size_loc
3166 ENDDO
3167 RETURN
mpi_pack_size
subroutine mpi_pack_size(incnt, datatype, comm, size, ierr)
Definition mpi.f:439

◆ mumps_mpi_pack_size_lrb()

subroutine zmumps_buf::mumps_mpi_pack_size_lrb ( type (lrb_type), intent(in) lrb,
integer, intent(out) size_out,
integer, intent(in) comm,
integer, intent(out) ierr )
private

Definition at line 3169 of file zmumps_comm_buffer.F.

3170 USE zmumps_lr_type
3171 INTEGER, intent(out) :: SIZE_OUT, IERR
3172 INTEGER, intent(in) :: COMM
3173 TYPE (LRB_TYPE), intent(in) :: LRB
3174 INTEGER :: SIZE_LOC, IERR_MPI
3175 include 'mpif.h'
3176 ierr = 0
3177 size_out = 0
3178 CALL mpi_pack_size( 4,
3179 & mpi_integer, comm, size_loc, ierr_mpi )
3180 size_out = size_out + size_loc
3181 IF ( lrb%ISLR ) THEN
3182 IF (lrb%K .GT. 0) THEN
3183 CALL mpi_pack_size( lrb%M * lrb%K,
3184 & mpi_double_complex, comm, size_loc, ierr_mpi )
3185 size_out = size_out + size_loc
3186 CALL mpi_pack_size( lrb%K * lrb%N,
3187 & mpi_double_complex, comm, size_loc, ierr_mpi )
3188 size_out = size_out + size_loc
3189 ENDIF
3190 ELSE
3191 CALL mpi_pack_size( lrb%M * lrb%N,
3192 & mpi_double_complex, comm, size_loc, ierr_mpi )
3193 size_out = size_out + size_loc
3194 ENDIF
3195 RETURN

◆ zmumps_blr_pack_cb_lrb()

subroutine, public zmumps_buf::zmumps_blr_pack_cb_lrb ( type(lrb_type), dimension(:,:), pointer cb_lrb,
integer, intent(in) nb_row_shift,
integer, intent(in) nb_col_shift,
integer, intent(in) nb_blr_cols,
integer, intent(in) panel2send,
integer, intent(in) panel_beg_offset,
integer, dimension(:), intent(inout) buf,
integer, intent(in) lbuf,
integer, intent(inout) position,
integer, intent(in) comm,
integer, intent(out) ierr )

Definition at line 1610 of file zmumps_comm_buffer.F.

1615 USE zmumps_lr_type
1616 IMPLICIT NONE
1617 TYPE(LRB_TYPE), POINTER :: CB_LRB(:,:)
1618 INTEGER, INTENT(IN) :: NB_ROW_SHIFT, NB_COL_SHIFT, NB_BLR_COLS,
1619 & PANEL2SEND, PANEL_BEG_OFFSET
1620 INTEGER, intent(out) :: IERR
1621 INTEGER, intent(in) :: COMM, LBUF
1622 INTEGER, intent(inout) :: POSITION
1623 INTEGER, intent(inout) :: BUF(:)
1624 INTEGER :: J, IERR_MPI
1625 include 'mpif.h'
1626 ierr = 0
1627 CALL mpi_pack( nb_blr_cols-nb_col_shift, 1, mpi_integer,
1628 & buf(1), lbuf, position, comm, ierr_mpi )
1629 CALL mpi_pack( panel_beg_offset, 1, mpi_integer,
1630 & buf(1), lbuf, position, comm, ierr_mpi )
1631 DO j=1,nb_blr_cols-nb_col_shift
1632 CALL zmumps_mpi_pack_lrb(
1633 & cb_lrb(panel2send-nb_row_shift,j),
1634 & buf, lbuf, position, comm, ierr
1635 & )
1636 ENDDO

◆ zmumps_buf_all_empty()

subroutine, public zmumps_buf::zmumps_buf_all_empty ( logical, intent(in) check_comm_nodes,
logical, intent(in) check_comm_load,
logical, intent(out) flag )

Definition at line 631 of file zmumps_comm_buffer.F.

633 LOGICAL, INTENT(IN) :: CHECK_COMM_NODES, CHECK_COMM_LOAD
634 LOGICAL, INTENT(OUT) :: FLAG
635 LOGICAL FLAG1, FLAG2, FLAG3
636 flag = .true.
637 IF (check_comm_nodes) THEN
638 CALL zmumps_buf_empty( buf_small, flag1 )
639 CALL zmumps_buf_empty( buf_cb, flag2 )
640 flag = flag .AND. flag1 .AND. flag2
641 ENDIF
642 IF ( check_comm_load ) THEN
643 CALL zmumps_buf_empty( buf_load, flag3 )
644 flag = flag .AND. flag3
645 ENDIF
646 RETURN

◆ zmumps_buf_alloc_cb()

subroutine, public zmumps_buf::zmumps_buf_alloc_cb ( integer size,
integer ierr )

Definition at line 114 of file zmumps_comm_buffer.F.

115 IMPLICIT NONE
116 INTEGER SIZE, IERR
117 CALL buf_alloc( buf_cb, SIZE, ierr )
118 RETURN

◆ zmumps_buf_alloc_load_buffer()

subroutine, public zmumps_buf::zmumps_buf_alloc_load_buffer ( integer size,
integer ierr )

Definition at line 126 of file zmumps_comm_buffer.F.

127 IMPLICIT NONE
128 INTEGER SIZE, IERR
129 CALL buf_alloc( buf_load, SIZE, ierr )
130 RETURN

◆ zmumps_buf_alloc_small_buf()

subroutine, public zmumps_buf::zmumps_buf_alloc_small_buf ( integer size,
integer ierr )

Definition at line 120 of file zmumps_comm_buffer.F.

121 IMPLICIT NONE
122 INTEGER SIZE, IERR
123 CALL buf_alloc( buf_small, SIZE, ierr )
124 RETURN

◆ zmumps_buf_bcast_array()

subroutine, public zmumps_buf::zmumps_buf_bcast_array ( logical bdc_mem,
integer comm,
integer myid,
integer nprocs,
integer, dimension(nprocs) future_niv2,
integer nslaves,
integer, dimension(nslaves) list_slaves,
integer inode,
double precision, dimension(nslaves) mem_increment,
double precision, dimension(nslaves) flops_increment,
double precision, dimension(nslaves) cb_band,
integer what,
integer, dimension(500), intent(inout) keep,
integer ierr )

Definition at line 3030 of file zmumps_comm_buffer.F.

3038 IMPLICIT NONE
3039 include 'mpif.h'
3040 include 'mumps_tags.h'
3041 LOGICAL BDC_MEM
3042 INTEGER COMM, MYID, NPROCS, NSLAVES, IERR
3043 INTEGER FUTURE_NIV2(NPROCS)
3044 INTEGER LIST_SLAVES(NSLAVES),INODE
3045 DOUBLE PRECISION MEM_INCREMENT(NSLAVES)
3046 DOUBLE PRECISION FLOPS_INCREMENT(NSLAVES)
3047 DOUBLE PRECISION CB_BAND(NSLAVES)
3048 INTEGER, INTENT(INOUT) :: KEEP(500)
3049 INTEGER :: IERR_MPI
3050 INTEGER NDEST, NINTS, NREALS, SIZE1, SIZE2, SIZE
3051 INTEGER IPOS, IPOSMSG, IREQ, POSITION
3052 INTEGER I, IDEST, WHAT
3053 INTEGER IZERO
3054 INTEGER MYID2(1)
3055 parameter( izero=0 )
3056 myid2(1)=myid
3057 ierr = 0
3058 ndest = 0
3059 DO i = 1, nprocs
3060 IF ( i .NE. myid + 1 .AND. future_niv2(i).NE.0) THEN
3061 ndest = ndest + 1
3062 ENDIF
3063 ENDDO
3064 IF ( ndest == 0 ) THEN
3065 RETURN
3066 ENDIF
3067 nints = 2 + nslaves + ( ndest - 1 ) * ovhsize + 1
3068 nreals = nslaves
3069 IF (bdc_mem) nreals = nreals + nslaves
3070 IF(what.EQ.19) THEN
3071 nreals = nreals + nslaves
3072 ENDIF
3073 CALL mpi_pack_size( nints,
3074 & mpi_integer, comm,
3075 & size1, ierr_mpi )
3076 CALL mpi_pack_size( nreals, mpi_double_precision,
3077 & comm, size2, ierr_mpi )
3078 SIZE = size1+size2
3079 CALL buf_look( buf_load, ipos, ireq, SIZE, ierr,
3080 & izero, myid2 )
3081 IF ( ierr .LT. 0 ) THEN
3082 RETURN
3083 ENDIF
3084 buf_load%ILASTMSG = buf_load%ILASTMSG + ( ndest - 1 ) * ovhsize
3085 ipos = ipos - ovhsize
3086 DO idest = 1, ndest - 1
3087 buf_load%CONTENT( ipos + ( idest - 1 ) * ovhsize ) =
3088 & ipos + idest * ovhsize
3089 END DO
3090 buf_load%CONTENT( ipos + ( ndest - 1 ) * ovhsize ) = 0
3091 iposmsg = ipos + ovhsize * ndest
3092 position = 0
3093 CALL mpi_pack( what, 1, mpi_integer,
3094 & buf_load%CONTENT( iposmsg ), SIZE,
3095 & position, comm, ierr_mpi )
3096 CALL mpi_pack( nslaves, 1, mpi_integer,
3097 & buf_load%CONTENT( iposmsg ), SIZE,
3098 & position, comm, ierr_mpi )
3099 CALL mpi_pack( inode, 1, mpi_integer,
3100 & buf_load%CONTENT( iposmsg ), SIZE,
3101 & position, comm, ierr_mpi )
3102 CALL mpi_pack( list_slaves, nslaves, mpi_integer,
3103 & buf_load%CONTENT( iposmsg ), SIZE,
3104 & position, comm, ierr_mpi )
3105 CALL mpi_pack( flops_increment, nslaves,
3106 & mpi_double_precision,
3107 & buf_load%CONTENT( iposmsg ), SIZE,
3108 & position, comm, ierr_mpi )
3109 IF (bdc_mem) THEN
3110 CALL mpi_pack( mem_increment, nslaves,
3111 & mpi_double_precision,
3112 & buf_load%CONTENT( iposmsg ), SIZE,
3113 & position, comm, ierr_mpi )
3114 END IF
3115 IF(what.EQ.19)THEN
3116 CALL mpi_pack( cb_band, nslaves,
3117 & mpi_double_precision,
3118 & buf_load%CONTENT( iposmsg ), SIZE,
3119 & position, comm, ierr_mpi )
3120 ENDIF
3121 idest = 0
3122 DO i = 0, nprocs - 1
3123 IF ( i .NE. myid .AND. future_niv2(i+1) .NE. 0) THEN
3124 idest = idest + 1
3125 keep(267)=keep(267)+1
3126 CALL mpi_isend( buf_load%CONTENT( iposmsg ),
3127 & position, mpi_packed, i,
3128 & update_load, comm,
3129 & buf_load%CONTENT( ireq+(idest-1)*ovhsize ),
3130 & ierr_mpi )
3131 END IF
3132 END DO
3133 SIZE = SIZE - ( ndest - 1 ) * ovhsize * sizeofint
3134 IF ( SIZE .LT. position ) THEN
3135 WRITE(*,*) ' Error in ZMUMPS_BUF_BCAST_ARRAY'
3136 WRITE(*,*) ' Size,position=',SIZE,position
3137 CALL mumps_abort()
3138 END IF
3139 IF ( SIZE .NE. position )
3140 & CALL buf_adjust( buf_load, position )
3141 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382

◆ zmumps_buf_broadcast()

subroutine, public zmumps_buf::zmumps_buf_broadcast ( integer what,
integer comm,
integer nprocs,
integer, dimension(nprocs) future_niv2,
double precision load,
double precision upd_load,
integer myid,
integer, dimension(500), intent(inout) keep,
integer ierr )

Definition at line 2790 of file zmumps_comm_buffer.F.

2795 IMPLICIT NONE
2796 INTEGER COMM, NPROCS, MYID, IERR, WHAT
2797 DOUBLE PRECISION LOAD,UPD_LOAD
2798 INTEGER, INTENT(INOUT) :: KEEP(500)
2799 include 'mpif.h'
2800 include 'mumps_tags.h'
2801 INTEGER :: IERR_MPI
2802 INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE
2803 INTEGER I, NDEST, IDEST, IPOSMSG, NREALS
2804 INTEGER IZERO
2805 INTEGER MYID2(1)
2806 INTEGER FUTURE_NIV2(NPROCS)
2807 parameter( izero=0 )
2808 ierr = 0
2809 IF (what .NE. 2 .AND. what .NE. 3 .AND.
2810 & what.NE.6.AND. what.NE.8 .AND.what.NE.9.AND.
2811 & what.NE.17) THEN
2812 WRITE(*,*)
2813 & "Internal error 1 in ZMUMPS_BUF_BROADCAST",what
2814 END IF
2815 myid2(1) = myid
2816 ndest = nprocs - 1
2817 ndest = 0
2818 DO i = 1, nprocs
2819 IF ( i .NE. myid + 1 .AND. future_niv2(i).NE.0) THEN
2820 ndest = ndest + 1
2821 ENDIF
2822 ENDDO
2823 IF ( ndest .eq. 0 ) THEN
2824 RETURN
2825 ENDIF
2826 CALL mpi_pack_size( 1 + (ndest-1) * ovhsize,
2827 & mpi_integer, comm,
2828 & size1, ierr_mpi )
2829 IF((what.NE.17).AND.(what.NE.10))THEN
2830 nreals = 1
2831 ELSE
2832 nreals = 2
2833 ENDIF
2834 CALL mpi_pack_size( nreals, mpi_double_precision,
2835 & comm, size2, ierr_mpi )
2836 SIZE = size1 + size2
2837 CALL buf_look( buf_load, ipos, ireq, SIZE, ierr,
2838 & izero, myid2
2839 & )
2840 IF ( ierr .LT. 0 ) THEN
2841 RETURN
2842 ENDIF
2843 buf_load%ILASTMSG = buf_load%ILASTMSG + ( ndest - 1 ) * ovhsize
2844 ipos = ipos - ovhsize
2845 DO idest = 1, ndest - 1
2846 buf_load%CONTENT( ipos + ( idest - 1 ) * ovhsize ) =
2847 & ipos + idest * ovhsize
2848 END DO
2849 buf_load%CONTENT( ipos + ( ndest - 1 ) * ovhsize ) = 0
2850 iposmsg = ipos + ovhsize * ndest
2851 position = 0
2852 CALL mpi_pack( what, 1, mpi_integer,
2853 & buf_load%CONTENT( iposmsg ), SIZE,
2854 & position, comm, ierr_mpi )
2855 CALL mpi_pack( load, 1, mpi_double_precision,
2856 & buf_load%CONTENT( iposmsg ), SIZE,
2857 & position, comm, ierr_mpi )
2858 IF((what.EQ.17).OR.(what.EQ.10))THEN
2859 CALL mpi_pack( upd_load, 1, mpi_double_precision,
2860 & buf_load%CONTENT( iposmsg ), SIZE,
2861 & position, comm, ierr_mpi )
2862 ENDIF
2863 idest = 0
2864 DO i = 0, nprocs - 1
2865 IF ( i .NE. myid .AND. future_niv2(i+1) .NE. 0) THEN
2866 idest = idest + 1
2867 keep(267)=keep(267)+1
2868 CALL mpi_isend( buf_load%CONTENT( iposmsg ),
2869 & position, mpi_packed, i,
2870 & update_load, comm,
2871 & buf_load%CONTENT( ireq+(idest-1)*ovhsize ),
2872 & ierr_mpi )
2873 END IF
2874 END DO
2875 SIZE = SIZE - ( ndest - 1 ) * ovhsize * sizeofint
2876 IF ( SIZE .LT. position ) THEN
2877 WRITE(*,*) ' Error in ZMUMPS_BUF_BROADCAST'
2878 WRITE(*,*) ' Size,position=',SIZE,position
2879 CALL mumps_abort()
2880 END IF
2881 IF ( SIZE .NE. position )
2882 & CALL buf_adjust( buf_load, position )
2883 RETURN

◆ zmumps_buf_deall_cb()

subroutine, public zmumps_buf::zmumps_buf_deall_cb ( integer ierr)

Definition at line 159 of file zmumps_comm_buffer.F.

160 IMPLICIT NONE
161 INTEGER IERR
162 CALL buf_deall( buf_cb, ierr )
163 RETURN

◆ zmumps_buf_deall_load_buffer()

subroutine, public zmumps_buf::zmumps_buf_deall_load_buffer ( integer ierr)

Definition at line 132 of file zmumps_comm_buffer.F.

133 IMPLICIT NONE
134 INTEGER IERR
135 CALL buf_deall( buf_load, ierr )
136 RETURN

◆ zmumps_buf_deall_max_array()

subroutine, public zmumps_buf::zmumps_buf_deall_max_array

Definition at line 138 of file zmumps_comm_buffer.F.

139 IMPLICIT NONE
140 IF (allocated( buf_max_array)) DEALLOCATE( buf_max_array )
141 RETURN

◆ zmumps_buf_deall_small_buf()

subroutine, public zmumps_buf::zmumps_buf_deall_small_buf ( integer ierr)

Definition at line 165 of file zmumps_comm_buffer.F.

166 IMPLICIT NONE
167 INTEGER IERR
168 CALL buf_deall( buf_small, ierr )
169 RETURN

◆ zmumps_buf_dist_irecv_size()

subroutine, public zmumps_buf::zmumps_buf_dist_irecv_size ( integer zmumps_lbufr_bytes)

Definition at line 3143 of file zmumps_comm_buffer.F.

3145 IMPLICIT NONE
3146 INTEGER ZMUMPS_LBUFR_BYTES
3147 size_rbuf_bytes = zmumps_lbufr_bytes
3148 RETURN

◆ zmumps_buf_empty()

subroutine zmumps_buf::zmumps_buf_empty ( type ( zmumps_comm_buffer_type ) b,
logical flag )
private

Definition at line 648 of file zmumps_comm_buffer.F.

649 TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: B
650 LOGICAL :: FLAG
651 INTEGER SIZE_AVAIL
652 CALL zmumps_buf_size_available(b, size_avail)
653 flag = ( b%HEAD == b%TAIL )
654 RETURN

◆ zmumps_buf_ini_myid()

subroutine, public zmumps_buf::zmumps_buf_ini_myid ( integer myid)

Definition at line 83 of file zmumps_comm_buffer.F.

84 IMPLICIT NONE
85 INTEGER MYID
86 buf_myid = myid
87 RETURN

◆ zmumps_buf_init()

subroutine, public zmumps_buf::zmumps_buf_init ( integer intsize,
integer realsize )

Definition at line 89 of file zmumps_comm_buffer.F.

90 IMPLICIT NONE
91 INTEGER IntSize, RealSize
92 sizeofint = intsize
93 sizeofreal = realsize
94 NULLIFY(buf_cb %CONTENT)
95 NULLIFY(buf_small%CONTENT)
96 NULLIFY(buf_load%CONTENT)
97 buf_cb%LBUF = 0
98 buf_cb%LBUF_INT = 0
99 buf_cb%HEAD = 1
100 buf_cb%TAIL = 1
101 buf_cb%ILASTMSG = 1
102 buf_small%LBUF = 0
103 buf_small%LBUF_INT = 0
104 buf_small%HEAD = 1
105 buf_small%TAIL = 1
106 buf_small%ILASTMSG = 1
107 buf_load%LBUF = 0
108 buf_load%LBUF_INT = 0
109 buf_load%HEAD = 1
110 buf_load%TAIL = 1
111 buf_load%ILASTMSG = 1
112 RETURN

◆ zmumps_buf_max_array_minsize()

subroutine, public zmumps_buf::zmumps_buf_max_array_minsize ( integer nfs4father,
integer ierr )

Definition at line 143 of file zmumps_comm_buffer.F.

144 IMPLICIT NONE
145 INTEGER IERR, NFS4FATHER
146 ierr = 0
147 IF (allocated( buf_max_array)) THEN
148 IF (buf_lmax_array .GE. nfs4father) RETURN
149 DEALLOCATE( buf_max_array )
150 ENDIF
151 ALLOCATE(buf_max_array(nfs4father),stat=ierr)
152 IF ( ierr .GT. 0 ) THEN
153 ierr = -1
154 RETURN
155 END IF
156 buf_lmax_array=nfs4father
157 RETURN

◆ zmumps_buf_send_1int()

subroutine, public zmumps_buf::zmumps_buf_send_1int ( integer i,
integer dest,
integer tag,
integer comm,
integer, dimension(500), intent(inout) keep,
integer ierr )

Definition at line 596 of file zmumps_comm_buffer.F.

598 IMPLICIT NONE
599 INTEGER I
600 INTEGER DEST, TAG, COMM, IERR
601 INTEGER, INTENT(INOUT) :: KEEP(500)
602 include 'mpif.h'
603 INTEGER :: IERR_MPI
604 INTEGER IPOS, IREQ, MSG_SIZE, POSITION
605 INTEGER IONE
606 INTEGER DEST2(1)
607 parameter( ione=1 )
608 dest2(1)=dest
609 ierr = 0
610 CALL mpi_pack_size( 1, mpi_integer,
611 & comm, msg_size, ierr_mpi )
612 CALL buf_look( buf_small, ipos, ireq, msg_size, ierr,
613 & ione , dest2
614 & )
615 IF ( ierr .LT. 0 ) THEN
616 write(6,*) ' Internal error in ZMUMPS_BUF_SEND_1INT',
617 & ' Buf size (bytes)= ',buf_small%LBUF
618 RETURN
619 ENDIF
620 position=0
621 CALL mpi_pack( i, 1,
622 & mpi_integer, buf_small%CONTENT( ipos ),
623 & msg_size,
624 & position, comm, ierr_mpi )
625 keep(266)=keep(266)+1
626 CALL mpi_isend( buf_small%CONTENT(ipos), msg_size,
627 & mpi_packed, dest, tag, comm,
628 & buf_small%CONTENT( ireq ), ierr_mpi )
629 RETURN

◆ zmumps_buf_send_backvec()

subroutine, public zmumps_buf::zmumps_buf_send_backvec ( integer nrhs,
integer inode,
complex(kind=8), dimension(ld_w, *) w,
integer lw,
integer ld_w,
integer dest,
integer msgtag,
integer, intent(in) jbdeb,
integer, intent(in) jbfin,
integer, dimension(500), intent(inout) keep,
integer comm,
integer ierr )

Definition at line 2624 of file zmumps_comm_buffer.F.

2627 IMPLICIT NONE
2628 INTEGER NRHS, INODE,LW,COMM,IERR,DEST,MSGTAG, LD_W
2629 INTEGER, intent(in) :: JBDEB, JBFIN
2630 COMPLEX(kind=8) :: W(LD_W, *)
2631 INTEGER, INTENT(INOUT) :: KEEP(500)
2632 include 'mpif.h'
2633 INTEGER :: IERR_MPI
2634 INTEGER SIZE, SIZE1, SIZE2
2635 INTEGER POSITION, IREQ, IPOS
2636 INTEGER IONE, K
2637 INTEGER DEST2(1)
2638 parameter( ione=1 )
2639 ierr = 0
2640 dest2(1) = dest
2641 CALL mpi_pack_size( 4 , mpi_integer, comm, size1, ierr_mpi )
2642 CALL mpi_pack_size( lw*nrhs, mpi_double_complex, comm,
2643 & size2, ierr_mpi )
2644 SIZE = size1 + size2
2645 CALL buf_look( buf_cb, ipos, ireq, SIZE, ierr,
2646 & ione, dest2
2647 & )
2648 IF ( ierr .LT. 0 ) THEN
2649 RETURN
2650 ENDIF
2651 position = 0
2652 CALL mpi_pack( inode, 1, mpi_integer,
2653 & buf_cb%CONTENT( ipos ), SIZE,
2654 & position, comm, ierr_mpi )
2655 CALL mpi_pack( lw , 1, mpi_integer,
2656 & buf_cb%CONTENT( ipos ), SIZE,
2657 & position, comm, ierr_mpi )
2658 CALL mpi_pack( jbdeb , 1, mpi_integer,
2659 & buf_cb%CONTENT( ipos ), SIZE,
2660 & position, comm, ierr_mpi )
2661 CALL mpi_pack( jbfin , 1, mpi_integer,
2662 & buf_cb%CONTENT( ipos ), SIZE,
2663 & position, comm, ierr_mpi )
2664 DO k=1, nrhs
2665 CALL mpi_pack( w(1,k), lw, mpi_double_complex,
2666 & buf_cb%CONTENT( ipos ), SIZE,
2667 & position, comm, ierr_mpi )
2668 END DO
2669 keep(266)=keep(266)+1
2670 CALL mpi_isend( buf_cb%CONTENT( ipos ), position, mpi_packed,
2671 & dest, msgtag, comm,
2672 & buf_cb%CONTENT( ireq ), ierr_mpi )
2673 IF ( SIZE .LT. position ) THEN
2674 WRITE(*,*) 'Try_update: SIZE, POSITION = ',
2675 & SIZE, position
2676 CALL mumps_abort()
2677 END IF
2678 IF ( SIZE .NE. position ) CALL buf_adjust( buf_cb, position )
2679 RETURN

◆ zmumps_buf_send_blfac_slave()

subroutine, public zmumps_buf::zmumps_buf_send_blfac_slave ( integer inode,
integer npiv,
integer fpere,
integer iposk,
integer jposk,
complex(kind=8), dimension( npiv, * ) uip21k,
integer ncolu,
integer ndest,
integer, dimension( ndest ) pdest,
integer comm,
integer, dimension(500), intent(inout) keep,
logical, intent(in) lr_activated,
type (lrb_type), dimension(:), pointer blr_ls,
integer, intent(in) ipanel,
complex(kind=8), dimension(la), intent(inout) a,
integer(8), intent(in) la,
integer(8), intent(in) posblocfacto,
integer, intent(in) ld_blocfacto,
integer, dimension(npiv), intent(in) ipiv,
integer, intent(in) maxi_cluster,
integer ierr )

Definition at line 2038 of file zmumps_comm_buffer.F.

2044 USE zmumps_lr_type
2045 IMPLICIT NONE
2046 INTEGER INODE, NCOLU, IPOSK, JPOSK, NPIV, NDEST, FPERE
2047 COMPLEX(kind=8) UIP21K( NPIV, * )
2048 INTEGER PDEST( NDEST )
2049 INTEGER COMM, IERR
2050 INTEGER, INTENT(INOUT) :: KEEP(500)
2051 LOGICAL, intent(in) :: LR_ACTIVATED
2052 TYPE (LRB_TYPE), DIMENSION(:), POINTER :: BLR_LS
2053 INTEGER(8), intent(in) :: LA, POSBLOCFACTO
2054 INTEGER, intent(in) :: LD_BLOCFACTO, IPIV(NPIV),
2055 & MAXI_CLUSTER, IPANEL
2056 COMPLEX(kind=8), intent(inout) :: A(LA)
2057 include 'mpif.h'
2058 include 'mumps_tags.h'
2059 INTEGER :: IERR_MPI
2060 INTEGER LR_ACTIVATED_INT
2061 INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZET,
2062 & IDEST, IPOSMSG, SSS, SSLR
2063 ierr = 0
2064 CALL mpi_pack_size( 6 + ( ndest - 1 ) * ovhsize,
2065 & mpi_integer, comm, size1, ierr_mpi )
2066 size2 = 0
2067 CALL mpi_pack_size(2, mpi_integer, comm, sslr, ierr_mpi )
2068 size2=size2+sslr
2069 IF (.NOT. lr_activated) THEN
2070 CALL mpi_pack_size( abs(npiv)*ncolu, mpi_double_complex,
2071 & comm, sslr, ierr_mpi )
2072 size2=size2+sslr
2073 ELSE
2074 CALL mumps_mpi_pack_size_lr( blr_ls, sslr, comm, ierr )
2075 size2=size2+sslr
2076 ENDIF
2077 sizet = size1 + size2
2078 IF (sizet.GT.size_rbuf_bytes) THEN
2079 CALL mpi_pack_size( 6 ,
2080 & mpi_integer, comm, sss, ierr_mpi )
2081 sss = sss+size2
2082 IF (sss.GT.size_rbuf_bytes) THEN
2083 ierr = -2
2084 RETURN
2085 ENDIF
2086 END IF
2087 CALL buf_look( buf_cb, ipos, ireq, sizet, ierr,
2088 & ndest, pdest)
2089 IF ( ierr .LT. 0 ) THEN
2090 RETURN
2091 ENDIF
2092 buf_cb%ILASTMSG = buf_cb%ILASTMSG + ( ndest - 1 ) * ovhsize
2093 ipos = ipos - ovhsize
2094 DO idest = 1, ndest - 1
2095 buf_cb%CONTENT( ipos + ( idest - 1 ) * ovhsize ) =
2096 & ipos + idest * ovhsize
2097 END DO
2098 buf_cb%CONTENT( ipos + ( ndest - 1 ) * ovhsize ) = 0
2099 iposmsg = ipos + ovhsize * ndest
2100 position = 0
2101 CALL mpi_pack( inode, 1, mpi_integer,
2102 & buf_cb%CONTENT( iposmsg ), sizet,
2103 & position, comm, ierr_mpi )
2104 CALL mpi_pack( iposk, 1, mpi_integer,
2105 & buf_cb%CONTENT( iposmsg ), sizet,
2106 & position, comm, ierr_mpi )
2107 CALL mpi_pack( jposk, 1, mpi_integer,
2108 & buf_cb%CONTENT( iposmsg ), sizet,
2109 & position, comm, ierr_mpi )
2110 CALL mpi_pack( npiv, 1, mpi_integer,
2111 & buf_cb%CONTENT( iposmsg ), sizet,
2112 & position, comm, ierr_mpi )
2113 CALL mpi_pack( fpere, 1, mpi_integer,
2114 & buf_cb%CONTENT( iposmsg ), sizet,
2115 & position, comm, ierr_mpi )
2116 CALL mpi_pack( ncolu, 1, mpi_integer,
2117 & buf_cb%CONTENT( iposmsg ), sizet,
2118 & position, comm, ierr_mpi )
2119 IF (lr_activated) THEN
2120 lr_activated_int = 1
2121 ELSE
2122 lr_activated_int = 0
2123 ENDIF
2124 CALL mpi_pack( lr_activated_int, 1, mpi_integer,
2125 & buf_cb%CONTENT( iposmsg ), sizet,
2126 & position, comm, ierr_mpi )
2127 CALL mpi_pack( ipanel, 1, mpi_integer,
2128 & buf_cb%CONTENT( iposmsg ), sizet,
2129 & position, comm, ierr_mpi )
2130 IF (lr_activated) THEN
2131 CALL mumps_mpi_pack_scale_lr( blr_ls,
2132 & buf_cb%CONTENT( iposmsg:
2133 & iposmsg+(sizet+keep(34)-1)/keep(34)-1 ),
2134 & sizet, position, comm,
2135 & a, la, posblocfacto, ld_blocfacto,
2136 & ipiv, npiv, maxi_cluster, ierr )
2137 ELSE
2138 CALL mpi_pack( uip21k, abs(npiv) * ncolu,
2139 & mpi_double_complex,
2140 & buf_cb%CONTENT( iposmsg ), sizet,
2141 & position, comm, ierr_mpi )
2142 ENDIF
2143 DO idest = 1, ndest
2144 keep(266)=keep(266)+1
2145 CALL mpi_isend( buf_cb%CONTENT( iposmsg ), position, mpi_packed,
2146 & pdest(idest), bloc_facto_sym_slave, comm,
2147 & buf_cb%CONTENT( ireq + ( idest-1 ) * ovhsize ),
2148 & ierr_mpi )
2149 END DO
2150 sizet = sizet - ( ndest - 1 ) * ovhsize * sizeofint
2151 IF ( sizet .LT. position ) THEN
2152 WRITE(*,*) ' Error sending blfac slave : size < position'
2153 WRITE(*,*) ' Size,position=',sizet,position
2154 CALL mumps_abort()
2155 END IF
2156 IF ( sizet .NE. position ) CALL buf_adjust( buf_cb, position )
2157 RETURN

◆ zmumps_buf_send_blocfacto()

subroutine, public zmumps_buf::zmumps_buf_send_blocfacto ( integer, intent(in) inode,
integer, intent(in) nfront,
integer, intent(in) ncol,
integer, intent(in) npiv,
integer, intent(in) fpere,
logical, intent(in) lastbl,
integer, dimension( npiv ), intent(in) ipiv,
complex(kind=8), dimension( nfront, * ), intent(in) val,
integer, dimension( ndest ), intent(in) pdest,
integer, intent(in) ndest,
integer, dimension(500), intent(inout) keep,
integer, intent(in) nb_bloc_fac,
integer, intent(in) nslaves_tot,
integer, intent(in) width,
integer, intent(in) comm,
integer, intent(in) nelim,
integer, intent(in) npartsass,
integer, intent(in) current_blr_panel,
logical, intent(in) lr_activated,
type (lrb_type), dimension(:), intent(in) blr_loru,
integer, intent(inout) ierr )

Definition at line 1815 of file zmumps_comm_buffer.F.

1824 USE zmumps_lr_type
1825 IMPLICIT NONE
1826 INTEGER, intent(in) :: INODE, NCOL, NPIV,
1827 & FPERE, NFRONT, NDEST
1828 INTEGER, intent(in) :: IPIV( NPIV )
1829 COMPLEX(kind=8), intent(in) :: VAL( NFRONT, * )
1830 INTEGER, intent(in) :: PDEST( NDEST )
1831 INTEGER, intent(inout) :: KEEP(500)
1832 INTEGER, intent(in) :: NB_BLOC_FAC,
1833 & NSLAVES_TOT, COMM, WIDTH
1834 LOGICAL, intent(in) :: LASTBL
1835 LOGICAL, intent(in) :: LR_ACTIVATED
1836 INTEGER, intent(in) :: NELIM, NPARTSASS, CURRENT_BLR_PANEL
1837 TYPE (LRB_TYPE), DIMENSION(:), intent(in) :: BLR_LorU
1838 INTEGER, intent(inout) :: IERR
1839 include 'mpif.h'
1840 include 'mumps_tags.h'
1841 INTEGER :: IERR_MPI
1842 INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE3, SIZET,
1843 & IDEST, IPOSMSG, I
1844 INTEGER NPIVSENT
1845 INTEGER SSS
1846 INTEGER :: NBMSGS
1847 INTEGER :: LRELAY_INFO, DEST_BLOCFACTO, TAG_BLOCFACTO
1848 INTEGER :: LR_ACTIVATED_INT
1849 ierr = 0
1850 lrelay_info = 0
1851 nbmsgs = ndest
1852 IF ( lastbl ) THEN
1853 IF ( keep(50) .eq. 0 ) THEN
1854 CALL mpi_pack_size( 4 + npiv + ( nbmsgs - 1 ) * ovhsize +
1855 & 1+lrelay_info,
1856 & mpi_integer, comm, size1, ierr_mpi )
1857 ELSE
1858 CALL mpi_pack_size( 6 + npiv + ( nbmsgs - 1 ) * ovhsize +
1859 & 1+lrelay_info,
1860 & mpi_integer, comm, size1, ierr_mpi )
1861 END IF
1862 ELSE
1863 IF ( keep(50) .eq. 0 ) THEN
1864 CALL mpi_pack_size( 3 + npiv + ( nbmsgs - 1 ) * ovhsize +
1865 & 1+lrelay_info,
1866 & mpi_integer, comm, size1, ierr_mpi )
1867 ELSE
1868 CALL mpi_pack_size( 4 + npiv + ( nbmsgs - 1 ) * ovhsize +
1869 & 1+lrelay_info,
1870 & mpi_integer, comm, size1, ierr_mpi )
1871 END IF
1872 END IF
1873 size2 = 0
1874 CALL mpi_pack_size( 4, mpi_integer, comm, size3, ierr_mpi )
1875 size2=size2+size3
1876 IF ( keep(50).NE.0 ) THEN
1877 CALL mpi_pack_size( 1, mpi_integer, comm, size3, ierr_mpi )
1878 size2=size2+size3
1879 ENDIF
1880 IF ((npiv.GT.0)
1881 & ) THEN
1882 IF (.NOT. lr_activated) THEN
1883 CALL mpi_pack_size( npiv*ncol, mpi_double_complex,
1884 & comm, size3, ierr_mpi )
1885 size2 = size2+size3
1886 ELSE
1887 CALL mpi_pack_size( npiv*(npiv+nelim), mpi_double_complex,
1888 & comm, size3, ierr_mpi )
1889 size2 = size2+size3
1890 CALL mumps_mpi_pack_size_lr( blr_loru, size3, comm, ierr )
1891 size2 = size2+size3
1892 ENDIF
1893 ENDIF
1894 sizet = size1 + size2
1895 IF (sizet.GT.size_rbuf_bytes) THEN
1896 sss = 0
1897 IF ( lastbl ) THEN
1898 IF ( keep(50) .eq. 0 ) THEN
1899 CALL mpi_pack_size( 4 + npiv + 1+lrelay_info,
1900 & mpi_integer, comm, sss, ierr_mpi )
1901 ELSE
1902 CALL mpi_pack_size( 6 + npiv + 1+lrelay_info,
1903 & mpi_integer, comm, sss, ierr_mpi )
1904 END IF
1905 ELSE
1906 IF ( keep(50) .eq. 0 ) THEN
1907 CALL mpi_pack_size( 3 + npiv + 1+lrelay_info,
1908 & mpi_integer, comm, sss, ierr_mpi )
1909 ELSE
1910 CALL mpi_pack_size( 4 + npiv + 1+lrelay_info,
1911 & mpi_integer, comm, sss, ierr_mpi )
1912 END IF
1913 END IF
1914 sss = sss + size2
1915 IF (sss.GT.size_rbuf_bytes) THEN
1916 ierr = -3
1917 RETURN
1918 ENDIF
1919 ENDIF
1920 CALL buf_look( buf_cb, ipos, ireq, sizet, ierr,
1921 & nbmsgs , pdest)
1922 IF ( ierr .LT. 0 ) THEN
1923 RETURN
1924 ENDIF
1925 buf_cb%ILASTMSG = buf_cb%ILASTMSG + ( nbmsgs - 1 ) * ovhsize
1926 ipos = ipos - ovhsize
1927 DO idest = 1, nbmsgs - 1
1928 buf_cb%CONTENT( ipos + ( idest - 1 ) * ovhsize ) =
1929 & ipos + idest * ovhsize
1930 END DO
1931 buf_cb%CONTENT( ipos + ( nbmsgs - 1 ) * ovhsize ) = 0
1932 iposmsg = ipos + ovhsize * nbmsgs
1933 position = 0
1934 CALL mpi_pack( inode, 1, mpi_integer,
1935 & buf_cb%CONTENT( iposmsg ), sizet,
1936 & position, comm, ierr_mpi )
1937 npivsent = npiv
1938 IF (lastbl) npivsent = -npiv
1939 CALL mpi_pack( npivsent, 1, mpi_integer,
1940 & buf_cb%CONTENT( iposmsg ), sizet,
1941 & position, comm, ierr_mpi )
1942 IF ( lastbl .or. keep(50).ne.0 ) THEN
1943 CALL mpi_pack( fpere, 1, mpi_integer,
1944 & buf_cb%CONTENT( iposmsg ), sizet,
1945 & position, comm, ierr_mpi )
1946 END IF
1947 IF ( lastbl .AND. keep(50) .NE. 0 ) THEN
1948 CALL mpi_pack( nslaves_tot, 1, mpi_integer,
1949 & buf_cb%CONTENT( iposmsg ), sizet,
1950 & position, comm, ierr_mpi )
1951 CALL mpi_pack( nb_bloc_fac, 1, mpi_integer,
1952 & buf_cb%CONTENT( iposmsg ), sizet,
1953 & position, comm, ierr_mpi )
1954 END IF
1955 CALL mpi_pack( ncol, 1, mpi_integer,
1956 & buf_cb%CONTENT( iposmsg ), sizet,
1957 & position, comm, ierr_mpi )
1958 CALL mpi_pack( nelim, 1, mpi_integer,
1959 & buf_cb%CONTENT( iposmsg ), sizet,
1960 & position, comm, ierr_mpi )
1961 CALL mpi_pack( npartsass, 1, mpi_integer,
1962 & buf_cb%CONTENT( iposmsg ), sizet,
1963 & position, comm, ierr_mpi )
1964 CALL mpi_pack( current_blr_panel, 1, mpi_integer,
1965 & buf_cb%CONTENT( iposmsg ), sizet,
1966 & position, comm, ierr_mpi )
1967 IF (lr_activated) THEN
1968 lr_activated_int = 1
1969 ELSE
1970 lr_activated_int = 0
1971 ENDIF
1972 CALL mpi_pack( lr_activated_int, 1, mpi_integer,
1973 & buf_cb%CONTENT( iposmsg ), sizet,
1974 & position, comm, ierr_mpi )
1975 IF ( keep(50) .ne. 0 ) THEN
1976 CALL mpi_pack( nslaves_tot, 1, mpi_integer,
1977 & buf_cb%CONTENT( iposmsg ), sizet,
1978 & position, comm, ierr_mpi )
1979 ENDIF
1980 IF ( (npiv.GT.0)
1981 & ) THEN
1982 IF (npiv.GT.0) THEN
1983 CALL mpi_pack( ipiv, npiv, mpi_integer,
1984 & buf_cb%CONTENT( iposmsg ), sizet,
1985 & position, comm, ierr_mpi )
1986 ENDIF
1987 IF (lr_activated) THEN
1988 DO i = 1, npiv
1989 CALL mpi_pack( val(1,i), npiv+nelim,
1990 & mpi_double_complex,
1991 & buf_cb%CONTENT( iposmsg ), sizet,
1992 & position, comm, ierr_mpi )
1993 END DO
1994 CALL zmumps_mpi_pack_lr( blr_loru,
1995 & buf_cb%CONTENT(iposmsg:
1996 & iposmsg+(sizet+keep(34)-1)/keep(34)-1),
1997 & sizet, position, comm, ierr)
1998 ELSE
1999 DO i = 1, npiv
2000 CALL mpi_pack( val(1,i), ncol,
2001 & mpi_double_complex,
2002 & buf_cb%CONTENT( iposmsg ), sizet,
2003 & position, comm, ierr_mpi )
2004 END DO
2005 ENDIF
2006 ENDIF
2007 CALL mpi_pack( lrelay_info, 1, mpi_integer,
2008 & buf_cb%CONTENT( iposmsg ), sizet,
2009 & position, comm, ierr_mpi )
2010 DO idest = 1, nbmsgs
2011 dest_blocfacto = pdest(idest)
2012 IF ( keep(50) .EQ. 0) THEN
2013 tag_blocfacto = bloc_facto
2014 keep(266)=keep(266)+1
2015 CALL mpi_isend( buf_cb%CONTENT( iposmsg ), position,
2016 & mpi_packed,
2017 & dest_blocfacto, tag_blocfacto, comm,
2018 & buf_cb%CONTENT( ireq + ( idest-1 ) * ovhsize ),
2019 & ierr_mpi )
2020 ELSE
2021 keep(266)=keep(266)+1
2022 CALL mpi_isend( buf_cb%CONTENT( iposmsg ), position,
2023 & mpi_packed,
2024 & dest_blocfacto, bloc_facto_sym, comm,
2025 & buf_cb%CONTENT( ireq + ( idest-1 ) * ovhsize ),
2026 & ierr_mpi )
2027 END IF
2028 END DO
2029 sizet = sizet - ( nbmsgs - 1 ) * ovhsize * sizeofint
2030 IF ( sizet .LT. position ) THEN
2031 WRITE(*,*) ' Error sending blocfacto : size < position'
2032 WRITE(*,*) ' Size,position=',sizet,position
2033 CALL mumps_abort()
2034 END IF
2035 IF ( sizet .NE. position ) CALL buf_adjust( buf_cb, position )
2036 RETURN

◆ zmumps_buf_send_cb()

subroutine, public zmumps_buf::zmumps_buf_send_cb ( integer nbrows_already_sent,
integer inode,
integer fpere,
integer nfront,
integer lcont,
integer nass,
integer npiv,
integer, dimension( lcont ) iwrow,
integer, dimension( lcont ) iwcol,
complex(kind=8), dimension( * ) a,
logical packed_cb,
integer dest,
integer tag,
integer comm,
integer, dimension(500), intent(inout) keep,
integer ierr )

Definition at line 228 of file zmumps_comm_buffer.F.

233 IMPLICIT NONE
234 INTEGER DEST, TAG, COMM, IERR
235 INTEGER NBROWS_ALREADY_SENT
236 INTEGER, INTENT(INOUT) :: KEEP(500)
237 INTEGER INODE, FPERE, NFRONT, LCONT, NASS, NPIV
238 INTEGER IWROW( LCONT ), IWCOL( LCONT )
239 COMPLEX(kind=8) A( * )
240 LOGICAL PACKED_CB
241 include 'mpif.h'
242 INTEGER :: IERR_MPI
243 INTEGER NBROWS_PACKET
244 INTEGER POSITION, IREQ, IPOS, I, J1
245 INTEGER SIZE1, SIZE2, SIZE_PACK, SIZE_AV, SIZE_AV_REALS
246 INTEGER IZERO, IONE
247 INTEGER SIZECB
248 INTEGER LCONT_SENT
249 INTEGER DEST2(1)
250 parameter( izero = 0, ione = 1 )
251 LOGICAL RECV_BUF_SMALLER_THAN_SEND
252 DOUBLE PRECISION TMP
253 dest2(1) = dest
254 ierr = 0
255 IF (nbrows_already_sent .EQ. 0) THEN
256 CALL mpi_pack_size( 11 + lcont + lcont, mpi_integer,
257 & comm, size1, ierr_mpi)
258 ELSE
259 CALL mpi_pack_size( 5, mpi_integer, comm, size1, ierr_mpi)
260 ENDIF
261 CALL zmumps_buf_size_available( buf_cb, size_av )
262 IF ( size_av .LT. size_rbuf_bytes ) THEN
263 recv_buf_smaller_than_send = .false.
264 ELSE
265 size_av = size_rbuf_bytes
266 recv_buf_smaller_than_send = .true.
267 ENDIF
268 size_av_reals = ( size_av - size1 ) / sizeofreal
269 IF (size_av_reals < 0 ) THEN
270 nbrows_packet = 0
271 ELSE
272 IF (packed_cb) THEN
273 tmp=2.0d0*dble(nbrows_already_sent)+1.0d0
274 nbrows_packet = int(
275 & ( sqrt( tmp * tmp
276 & + 8.0d0 * dble(size_av_reals)) - tmp )
277 & / 2.0d0 )
278 ELSE
279 IF (lcont.EQ.0) THEN
280 nbrows_packet = 0
281 ELSE
282 nbrows_packet = size_av_reals / lcont
283 ENDIF
284 ENDIF
285 ENDIF
286 10 CONTINUE
287 nbrows_packet = max(0,
288 & min(nbrows_packet, lcont - nbrows_already_sent))
289 IF (nbrows_packet .EQ. 0 .AND. lcont .NE. 0) THEN
290 IF (recv_buf_smaller_than_send) THEN
291 ierr = -3
292 GOTO 100
293 ELSE
294 ierr = -1
295 GOTO 100
296 ENDIF
297 ENDIF
298 IF (packed_cb) THEN
299 sizecb = (nbrows_already_sent*nbrows_packet)+(nbrows_packet
300 & *(nbrows_packet+1))/2
301 ELSE
302 sizecb = nbrows_packet * lcont
303 ENDIF
304 CALL mpi_pack_size( sizecb, mpi_double_complex,
305 & comm, size2, ierr_mpi )
306 size_pack = size1 + size2
307 IF (size_pack .GT. size_av ) THEN
308 nbrows_packet = nbrows_packet - 1
309 IF (nbrows_packet > 0) THEN
310 GOTO 10
311 ELSE
312 IF (recv_buf_smaller_than_send) THEN
313 ierr=-3
314 GOTO 100
315 ELSE
316 ierr = -1
317 GOTO 100
318 ENDIF
319 ENDIF
320 ENDIF
321 IF (nbrows_packet + nbrows_already_sent.NE.lcont .AND.
322 & size_pack .LT. size_rbuf_bytes / 4
323 & .AND.
324 & .NOT. recv_buf_smaller_than_send)
325 & THEN
326 ierr = -1
327 GOTO 100
328 ENDIF
329 CALL buf_look( buf_cb, ipos, ireq, size_pack, ierr,
330 & ione , dest2)
331 IF (ierr .EQ. -1 .OR. ierr .EQ. -2) THEN
332 nbrows_packet = nbrows_packet - 1
333 IF ( nbrows_packet > 0 ) GOTO 10
334 ENDIF
335 IF ( ierr .LT. 0 ) GOTO 100
336 position = 0
337 CALL mpi_pack( inode, 1, mpi_integer,
338 & buf_cb%CONTENT( ipos ), size_pack,
339 & position, comm, ierr_mpi )
340 CALL mpi_pack( fpere, 1, mpi_integer,
341 & buf_cb%CONTENT( ipos ), size_pack,
342 & position, comm, ierr_mpi )
343 IF (packed_cb) THEN
344 lcont_sent=-lcont
345 ELSE
346 lcont_sent=lcont
347 ENDIF
348 CALL mpi_pack( lcont_sent, 1, mpi_integer,
349 & buf_cb%CONTENT( ipos ), size_pack,
350 & position, comm, ierr_mpi )
351 CALL mpi_pack( nbrows_already_sent, 1, mpi_integer,
352 & buf_cb%CONTENT( ipos ), size_pack,
353 & position, comm, ierr_mpi )
354 CALL mpi_pack( nbrows_packet, 1, mpi_integer,
355 & buf_cb%CONTENT( ipos ), size_pack,
356 & position, comm, ierr_mpi )
357 IF (nbrows_already_sent == 0) THEN
358 CALL mpi_pack( lcont, 1, mpi_integer,
359 & buf_cb%CONTENT( ipos ), size_pack,
360 & position, comm, ierr_mpi )
361 CALL mpi_pack( nass-npiv, 1, mpi_integer,
362 & buf_cb%CONTENT( ipos ), size_pack,
363 & position, comm, ierr_mpi )
364 CALL mpi_pack( lcont , 1, mpi_integer,
365 & buf_cb%CONTENT( ipos ), size_pack,
366 & position, comm, ierr_mpi )
367 CALL mpi_pack( izero, 1, mpi_integer,
368 & buf_cb%CONTENT( ipos ), size_pack,
369 & position, comm, ierr_mpi )
370 CALL mpi_pack( ione, 1, mpi_integer,
371 & buf_cb%CONTENT( ipos ), size_pack,
372 & position, comm, ierr_mpi )
373 CALL mpi_pack( izero, 1, mpi_integer,
374 & buf_cb%CONTENT( ipos ), size_pack,
375 & position, comm, ierr_mpi )
376 CALL mpi_pack( iwrow, lcont, mpi_integer,
377 & buf_cb%CONTENT( ipos ), size_pack,
378 & position, comm, ierr_mpi )
379 CALL mpi_pack( iwcol, lcont, mpi_integer,
380 & buf_cb%CONTENT( ipos ), size_pack,
381 & position, comm, ierr_mpi )
382 ENDIF
383 IF ( lcont .NE. 0 ) THEN
384 j1 = 1 + nbrows_already_sent * nfront
385 IF (packed_cb) THEN
386 DO i = nbrows_already_sent+1,
387 & nbrows_already_sent+nbrows_packet
388 CALL mpi_pack( a( j1 ), i, mpi_double_complex,
389 & buf_cb%CONTENT( ipos ), size_pack,
390 & position, comm, ierr_mpi )
391 j1 = j1 + nfront
392 END DO
393 ELSE
394 DO i = nbrows_already_sent+1,
395 & nbrows_already_sent+nbrows_packet
396 CALL mpi_pack( a( j1 ), lcont, mpi_double_complex,
397 & buf_cb%CONTENT( ipos ), size_pack,
398 & position, comm, ierr_mpi )
399 j1 = j1 + nfront
400 END DO
401 ENDIF
402 END IF
403 keep(266)=keep(266)+1
404 CALL mpi_isend( buf_cb%CONTENT( ipos ), position, mpi_packed,
405 & dest, tag, comm, buf_cb%CONTENT( ireq ),
406 & ierr_mpi )
407 IF ( size_pack .LT. position ) THEN
408 WRITE(*,*) 'Error Try_send_cb: SIZE, POSITION=',size_pack,
409 & position
410 CALL mumps_abort()
411 END IF
412 IF ( size_pack .NE. position )
413 & CALL buf_adjust( buf_cb, position )
414 nbrows_already_sent = nbrows_already_sent + nbrows_packet
415 IF (nbrows_already_sent .NE. lcont ) THEN
416 ierr = -1
417 RETURN
418 ENDIF
419 100 CONTINUE
420 RETURN
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ zmumps_buf_send_contrib_type2()

subroutine, public zmumps_buf::zmumps_buf_send_contrib_type2 ( integer nbrows_already_sent,
logical desc_in_lu,
integer ipere,
integer nfront_pere,
integer nass_pere,
integer nfs4father,
integer nslaves_pere,
integer ison,
integer nbrow,
integer lmap,
integer, dimension( lmap ) maprow,
integer, dimension( max(1, nbrow )) perm,
integer, dimension( * ) iw_cbson,
complex(kind=8), dimension( : ) a_cbson,
integer(8) la_cbson,
integer islave,
integer pdest,
integer pdest_master,
integer comm,
integer ierr,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer, dimension(n) step,
integer n,
integer slavef,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
logical packed_cb,
integer, intent(in) keep253_loc,
integer, intent(in) nvschur,
integer, intent(in) son_niv,
integer myid,
integer, intent(in), optional npiv_check )

Definition at line 1039 of file zmumps_comm_buffer.F.

1050 USE zmumps_lr_type
1051 USE zmumps_lr_data_m
1052 IMPLICIT NONE
1053 INTEGER NBROWS_ALREADY_SENT
1054 INTEGER, INTENT (in) :: KEEP253_LOC, NVSCHUR
1055 INTEGER, INTENT (in) :: SON_NIV
1056 INTEGER, INTENT (in), OPTIONAL :: NPIV_CHECK
1057 INTEGER IPERE, ISON, NBROW, MYID
1058 INTEGER PDEST, ISLAVE, COMM, IERR
1059 INTEGER PDEST_MASTER, NASS_PERE, NSLAVES_PERE,
1060 & NFRONT_PERE, LMAP
1061 INTEGER MAPROW( LMAP ), PERM( max(1, NBROW ))
1062 INTEGER IW_CBSON( * )
1063 COMPLEX(kind=8) A_CBSON( : )
1064 INTEGER(8) :: LA_CBSON
1065 LOGICAL DESC_IN_LU, PACKED_CB
1066 INTEGER KEEP(500), N , SLAVEF
1067 INTEGER(8) KEEP8(150)
1068 INTEGER STEP(N),
1069 & ISTEP_TO_INIV2(KEEP(71)),
1070 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
1071 include 'mpif.h'
1072 include 'mumps_tags.h'
1073 INTEGER :: IERR_MPI
1074 INTEGER NFS4FATHER,SIZE3,PS1,NCA,LROW1
1075 INTEGER(8) :: ASIZE
1076 LOGICAL COMPUTE_MAX
1077 DOUBLE PRECISION, POINTER, DIMENSION(:) :: M_ARRAY
1078 INTEGER NBROWS_PACKET
1079 INTEGER MAX_ROW_LENGTH
1080 INTEGER LROW, NELIM
1081 INTEGER(8) :: ITMP8
1082 INTEGER NPIV, NFRONT, HS
1083 INTEGER SIZE_PACK, SIZE0, SIZE1, SIZE2, POSITION,I
1084 INTEGER SIZE_INTEGERS, B, SIZE_REALS, TMPSIZE, ONEorTWO, SIZE_AV
1085 INTEGER NBINT, L
1086 INTEGER(8) :: APOS, SHIFTCB_SON, LDA_SON8
1087 INTEGER IPOS_IN_SLAVE
1088 INTEGER STATE_SON
1089 INTEGER INDICE_PERE, NROW, IPOS, IREQ, NOSLA
1090 INTEGER IONE, J, THIS_ROW_LENGTH
1091 INTEGER SIZE_DESC_BANDE, DESC_BANDE_BYTES
1092 LOGICAL RECV_BUF_SMALLER_THAN_SEND
1093 LOGICAL NOT_ENOUGH_SPACE
1094 INTEGER PDEST2(1)
1095 LOGICAL CB_IS_LR
1096 TYPE(LRB_TYPE), POINTER :: CB_LRB(:,:)
1097 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_ROW, BEGS_BLR_COL,
1098 & BEGS_BLR_STA
1099 INTEGER :: NB_ROW_SHIFT, NB_COL_SHIFT, NASS_SHIFT, PANEL2SEND,
1100 & CURRENT_PANEL_SIZE, NB_BLR_ROWS, NB_BLR_COLS,
1101 & CB_IS_LR_INT, NCOL_SHIFT, NROW_SHIFT,
1102 & NBROWS_PACKET_2PACK,
1103 & PANEL_BEG_OFFSET
1104 INTEGER :: NPIV_LR
1105 parameter( ione=1 )
1106 include 'mumps_headers.h'
1107 DOUBLE PRECISION ZERO
1108 parameter(zero = 0.0d0)
1109 cb_is_lr = (iw_cbson(1+xxlr).EQ.1
1110 & .OR. iw_cbson(1+xxlr).EQ.3)
1111 IF (cb_is_lr) THEN
1112 cb_is_lr_int = 1
1113 ELSE
1114 cb_is_lr_int = 0
1115 ENDIF
1116 compute_max = (keep(219) .NE. 0) .AND.
1117 & (keep(50) .EQ. 2) .AND.
1118 & (pdest.EQ.pdest_master)
1119 IF (nbrows_already_sent == 0) THEN
1120 IF (compute_max) THEN
1121 CALL zmumps_buf_max_array_minsize(nfs4father,ierr)
1122 IF (ierr .NE. 0) THEN
1123 ierr = -4
1124 RETURN
1125 ENDIF
1126 ENDIF
1127 ENDIF
1128 pdest2(1) = pdest
1129 ierr = 0
1130 lrow = iw_cbson( 1 + keep(ixsz))
1131 nelim = iw_cbson( 2 + keep(ixsz))
1132 npiv = iw_cbson( 4 + keep(ixsz))
1133 IF ( npiv .LT. 0 ) THEN
1134 npiv = 0
1135 END IF
1136 nrow = iw_cbson( 3 + keep(ixsz))
1137 nfront = lrow + npiv
1138 hs = 6 + iw_cbson( 6 + keep(ixsz)) + keep(ixsz)
1139 IF (cb_is_lr) THEN
1140 CALL zmumps_blr_retrieve_cb_lrb(iw_cbson(1+xxf), cb_lrb)
1141 IF (son_niv.EQ.1) THEN
1142 CALL zmumps_blr_retrieve_begsblr_sta(iw_cbson(1+xxf),
1143 & begs_blr_row)
1144 CALL zmumps_blr_retrieve_begsblr_dyn(iw_cbson(1+xxf),
1145 & begs_blr_col)
1146 nb_blr_rows = size(begs_blr_row) - 1
1147 CALL zmumps_blr_retrieve_nb_panels(iw_cbson(1+xxf),
1148 & nb_col_shift)
1149 nb_row_shift = nb_col_shift
1150 nass_shift = begs_blr_row(nb_row_shift+1)-1
1151 npiv_lr = begs_blr_col(nb_col_shift+1)-1
1152 ELSE
1153 npiv_lr=npiv
1154 CALL zmumps_blr_retrieve_begsblr_sta(iw_cbson(1+xxf),
1155 & begs_blr_sta)
1156 nb_blr_rows = size(begs_blr_sta) - 2
1157 begs_blr_row => begs_blr_sta(2:nb_blr_rows+2)
1158 CALL zmumps_blr_retrieve_begs_blr_c(iw_cbson(1+xxf),
1159 & begs_blr_col, nb_col_shift)
1160 nass_shift = 0
1161 nb_row_shift = 0
1162 ENDIF
1163 panel2send = -1
1164 DO i=nb_row_shift+1,nb_blr_rows
1165 IF (begs_blr_row(i+1)-1-nass_shift
1166 & .GT.nbrows_already_sent+perm(1)-1) THEN
1167 panel2send = i
1168 EXIT
1169 ENDIF
1170 ENDDO
1171 IF (panel2send.EQ.-1) THEN
1172 write(*,*) 'Internal error: PANEL2SEND not found'
1173 CALL mumps_abort()
1174 ENDIF
1175 IF (keep(50).EQ.0) THEN
1176 nb_blr_cols = size(begs_blr_col) - 1
1177 ELSEIF (son_niv.EQ.1) THEN
1178 nb_blr_cols = panel2send
1179 ELSE
1180 nb_blr_cols = -1
1181 ncol_shift = npiv_lr
1182 nrow_shift = lrow - nrow
1183 DO i=nb_col_shift+1,size(begs_blr_col)-1
1184 IF (begs_blr_col(i+1)-ncol_shift.GT.
1185 & begs_blr_row(panel2send+1)-1+nrow_shift) THEN
1186 nb_blr_cols = i
1187 EXIT
1188 ENDIF
1189 ENDDO
1190 IF (nb_blr_cols.EQ.-1) THEN
1191 write(*,*) 'Internal error: NB_BLR_COLS not found'
1192 CALL mumps_abort()
1193 ENDIF
1194 max_row_length = begs_blr_row(panel2send+1)-1+nrow_shift
1195 ENDIF
1196 current_panel_size = begs_blr_row(panel2send+1)
1197 & - begs_blr_row(panel2send)
1198 panel_beg_offset = perm(1) + nbrows_already_sent -
1199 & begs_blr_row(panel2send) + nass_shift
1200 ENDIF
1201 state_son = iw_cbson(1+xxs)
1202 IF (state_son .EQ. s_nolcbcontig) THEN
1203 lda_son8 = int(lrow,8)
1204 shiftcb_son = int(npiv,8)*int(nrow,8)
1205 ELSE IF (state_son .EQ. s_nolcleaned) THEN
1206 lda_son8 = int(lrow,8)
1207 shiftcb_son = 0_8
1208 ELSE
1209 lda_son8 = int(nfront,8)
1210 shiftcb_son = int(npiv,8)
1211 ENDIF
1212 CALL zmumps_buf_size_available( buf_cb, size_av )
1213 IF (pdest .EQ. pdest_master) THEN
1214 size_desc_bande=0
1215 ELSE
1216 size_desc_bande=(7+slavef+keep(127)*2)
1217 size_desc_bande=size_desc_bande+int(dble(keep(12))*
1218 & dble(size_desc_bande)/100.0d0)
1219 size_desc_bande=max(size_desc_bande,
1220 & 7+nslaves_pere+nfront_pere+nfront_pere-nass_pere)
1221 ENDIF
1222 desc_bande_bytes=size_desc_bande*sizeofint
1223 IF ( size_av .LT. size_rbuf_bytes-desc_bande_bytes ) THEN
1224 recv_buf_smaller_than_send = .false.
1225 ELSE
1226 recv_buf_smaller_than_send = .true.
1227 size_av = size_rbuf_bytes-desc_bande_bytes
1228 ENDIF
1229 size1=0
1230 IF (nbrows_already_sent==0) THEN
1231 IF(compute_max) THEN
1232 CALL mpi_pack_size(1, mpi_integer,
1233 & comm, size0, ierr_mpi )
1234 IF(nfs4father .GT. 0) THEN
1235 CALL mpi_pack_size( nfs4father, mpi_double_precision,
1236 & comm, size1, ierr_mpi )
1237 ENDIF
1238 size1 = size1+size0
1239 ENDIF
1240 ENDIF
1241 IF (keep(50) .EQ. 0) THEN
1242 oneortwo = 1
1243 ELSE
1244 oneortwo = 2
1245 ENDIF
1246 IF (pdest .EQ.pdest_master) THEN
1247 l = 0
1248 ELSE IF (keep(50) .EQ. 0) THEN
1249 l = lrow
1250 ELSE
1251 l = lrow + perm(1) - lmap + nbrows_already_sent - 1
1252 oneortwo=oneortwo+1
1253 ENDIF
1254 nbint = 6 + l + 1
1255 IF (cb_is_lr) THEN
1256 nbint = nbint + 4*(nb_blr_cols-nb_col_shift) + 2
1257 ENDIF
1258 CALL mpi_pack_size( nbint, mpi_integer,
1259 & comm, tmpsize, ierr_mpi )
1260 size1 = size1 + tmpsize
1261 size_av = size_av - size1
1262 not_enough_space=.false.
1263 IF (size_av .LT.0 ) THEN
1264 nbrows_packet = 0
1265 not_enough_space=.true.
1266 ELSE
1267 IF ( keep(50) .EQ. 0 ) THEN
1268 nbrows_packet =
1269 & size_av / ( oneortwo*sizeofint+lrow*sizeofreal)
1270 ELSE
1271 b = 2 * oneortwo +
1272 & ( 1 + 2 * lrow + 2 * perm(1) + 2 * nbrows_already_sent )
1273 & * sizeofreal / sizeofint
1274 nbrows_packet=int((dble(-b)+sqrt((dble(b)*dble(b))+
1275 & dble(4)*dble(2)*dble(size_av)/dble(sizeofint) *
1276 & dble(sizeofreal/sizeofint)))*
1277 & dble(sizeofint) / dble(2) / dble(sizeofreal))
1278 ENDIF
1279 ENDIF
1280 10 CONTINUE
1281 nbrows_packet = max( 0, nbrows_packet)
1282 nbrows_packet = min(nbrow-nbrows_already_sent, nbrows_packet)
1283 not_enough_space = not_enough_space .OR.
1284 & (nbrows_packet .EQ.0.AND. nbrow.NE.0)
1285 nbrows_packet_2pack = nbrows_packet
1286 IF (cb_is_lr) THEN
1287 nbrows_packet_2pack = current_panel_size
1288 CALL mumps_blr_get_sizereals_cb_lrb(size_reals, cb_lrb,
1289 & nb_row_shift,
1290 & nb_col_shift, nb_blr_cols, panel2send
1291 & )
1292 not_enough_space = (size_av.LT.size_reals)
1293 IF (.NOT.not_enough_space) THEN
1294 nbrows_packet = min(nbrows_packet,
1295 & current_panel_size-panel_beg_offset)
1296 ENDIF
1297 ENDIF
1298 IF (not_enough_space) THEN
1299 IF (recv_buf_smaller_than_send) THEN
1300 ierr = -3
1301 GOTO 100
1302 ELSE
1303 ierr = -1
1304 GOTO 100
1305 ENDIF
1306 ENDIF
1307 IF (cb_is_lr) THEN
1308 IF (keep(50).EQ.0) THEN
1309 max_row_length = -99999
1310 ELSEIF (son_niv.EQ.1) THEN
1311 max_row_length = lrow+perm(1)-lmap+nbrows_already_sent
1312 & + nbrows_packet_2pack-1
1313 ENDIF
1314 ELSE
1315 IF (keep(50).EQ.0) THEN
1316 max_row_length = -99999
1317 size_reals = nbrows_packet_2pack * lrow
1318 ELSE
1319 size_reals = ( lrow + perm(1) + nbrows_already_sent ) *
1320 & nbrows_packet_2pack + ( nbrows_packet_2pack *
1321 & ( nbrows_packet_2pack + 1) ) / 2
1322 max_row_length = lrow+perm(1)-lmap+nbrows_already_sent
1323 & + nbrows_packet_2pack-1
1324 ENDIF
1325 ENDIF
1326 size_integers = oneortwo* nbrows_packet_2pack
1327 CALL mpi_pack_size( size_reals, mpi_double_complex,
1328 & comm, size2, ierr_mpi )
1329 CALL mpi_pack_size( size_integers, mpi_integer,
1330 & comm, size3, ierr_mpi )
1331 IF (size2 + size3 .GT. size_av ) THEN
1332 nbrows_packet = nbrows_packet -1
1333 IF (nbrows_packet .GT. 0 .AND..NOT.cb_is_lr) THEN
1334 GOTO 10
1335 ELSE
1336 IF (recv_buf_smaller_than_send) THEN
1337 ierr = -3
1338 GOTO 100
1339 ELSE
1340 ierr = -1
1341 GOTO 100
1342 ENDIF
1343 ENDIF
1344 ENDIF
1345 size_pack = size1 + size2 + size3
1346 IF (nbrows_packet + nbrows_already_sent.NE.nbrow .AND.
1347 & size_pack .LT. size_rbuf_bytes / 4 .AND.
1348 & .NOT. recv_buf_smaller_than_send .AND.
1349 & .NOT. cb_is_lr)
1350 & THEN
1351 ierr = -1
1352 GOTO 100
1353 ENDIF
1354 IF (size_pack.GT.size_rbuf_bytes ) THEN
1355 ierr = -3
1356 GOTO 100
1357 ENDIF
1358 CALL buf_look( buf_cb, ipos, ireq, size_pack, ierr,
1359 & ione , pdest2)
1360 IF (ierr .EQ. -1 .OR. ierr.EQ. -2) THEN
1361 nbrows_packet = nbrows_packet - 1
1362 IF (nbrows_packet > 0 ) GOTO 10
1363 ENDIF
1364 IF ( ierr .LT. 0 ) GOTO 100
1365 position = 0
1366 CALL mpi_pack( ipere, 1, mpi_integer,
1367 & buf_cb%CONTENT( ipos ), size_pack,
1368 & position, comm, ierr_mpi )
1369 CALL mpi_pack( ison, 1, mpi_integer,
1370 & buf_cb%CONTENT( ipos ), size_pack,
1371 & position, comm, ierr_mpi )
1372 CALL mpi_pack( nbrow, 1, mpi_integer,
1373 & buf_cb%CONTENT( ipos ), size_pack,
1374 & position, comm, ierr_mpi )
1375 IF (keep(50)==0) THEN
1376 CALL mpi_pack( lrow, 1, mpi_integer,
1377 & buf_cb%CONTENT( ipos ), size_pack,
1378 & position, comm, ierr_mpi )
1379 ELSE
1380 CALL mpi_pack( max_row_length, 1, mpi_integer,
1381 & buf_cb%CONTENT( ipos ), size_pack,
1382 & position, comm, ierr_mpi )
1383 ENDIF
1384 CALL mpi_pack( nbrows_already_sent, 1, mpi_integer,
1385 & buf_cb%CONTENT( ipos ), size_pack,
1386 & position, comm, ierr_mpi )
1387 CALL mpi_pack( nbrows_packet, 1, mpi_integer,
1388 & buf_cb%CONTENT( ipos ), size_pack,
1389 & position, comm, ierr_mpi )
1390 CALL mpi_pack( cb_is_lr_int, 1, mpi_integer,
1391 & buf_cb%CONTENT( ipos ), size_pack,
1392 & position, comm, ierr_mpi )
1393 IF ( pdest .NE. pdest_master ) THEN
1394 IF (keep(50)==0) THEN
1395 CALL mpi_pack( iw_cbson( hs + nrow + npiv + 1 ), lrow,
1396 & mpi_integer,
1397 & buf_cb%CONTENT( ipos ), size_pack,
1398 & position, comm, ierr_mpi )
1399 ELSE
1400 IF (max_row_length > 0) THEN
1401 CALL mpi_pack( iw_cbson( hs + nrow + npiv + 1 ),
1402 & max_row_length,
1403 & mpi_integer,
1404 & buf_cb%CONTENT( ipos ), size_pack,
1405 & position, comm, ierr_mpi )
1406 ENDIF
1407 ENDIF
1408 END IF
1409 DO j=nbrows_already_sent+1,nbrows_already_sent+nbrows_packet
1410 i = perm(j)
1411 indice_pere=maprow(i)
1412 CALL mumps_bloc2_get_islave(
1413 & keep,keep8, ipere, step, n, slavef,
1414 & istep_to_iniv2, tab_pos_in_pere,
1415 &
1416 & nass_pere,
1417 & nfront_pere - nass_pere,
1418 & nslaves_pere,
1419 & indice_pere,
1420 & nosla,
1421 & ipos_in_slave )
1422 indice_pere = ipos_in_slave
1423 CALL mpi_pack( indice_pere, 1, mpi_integer,
1424 & buf_cb%CONTENT( ipos ), size_pack,
1425 & position, comm, ierr_mpi )
1426 ENDDO
1427 IF (cb_is_lr) THEN
1428 CALL zmumps_blr_pack_cb_lrb(cb_lrb, nb_row_shift,
1429 & nb_col_shift, nb_blr_cols, panel2send,
1430 & panel_beg_offset,
1431 & buf_cb%CONTENT(ipos:),
1432 & size_pack, position, comm, ierr
1433 & )
1434 IF (keep(50).ne.0) THEN
1435 DO j=nbrows_already_sent+1,nbrows_already_sent+nbrows_packet
1436 i = perm(j)
1437 this_row_length = lrow + i - lmap
1438 CALL mpi_pack( this_row_length, 1, mpi_integer,
1439 & buf_cb%CONTENT( ipos ), size_pack,
1440 & position, comm, ierr_mpi )
1441 ENDDO
1442 ENDIF
1443 GOTO 200
1444 ENDIF
1445 DO j=nbrows_already_sent+1,nbrows_already_sent+nbrows_packet
1446 i = perm(j)
1447 indice_pere=maprow(i)
1448 CALL mumps_bloc2_get_islave(
1449 & keep,keep8, ipere, step, n, slavef,
1450 & istep_to_iniv2, tab_pos_in_pere,
1451 &
1452 & nass_pere,
1453 & nfront_pere - nass_pere,
1454 & nslaves_pere,
1455 & indice_pere,
1456 & nosla,
1457 & ipos_in_slave )
1458 IF (keep(50).ne.0) THEN
1459 this_row_length = lrow + i - lmap
1460 CALL mpi_pack( this_row_length, 1, mpi_integer,
1461 & buf_cb%CONTENT( ipos ), size_pack,
1462 & position, comm, ierr_mpi )
1463 ELSE
1464 this_row_length = lrow
1465 ENDIF
1466 IF (desc_in_lu) THEN
1467 IF ( packed_cb ) THEN
1468 IF (nelim.EQ.0) THEN
1469 itmp8 = int(i,8)
1470 ELSE
1471 itmp8 = int(nelim+i,8)
1472 ENDIF
1473 apos = itmp8 * (itmp8-1_8) / 2_8 + 1_8
1474 ELSE
1475 apos = int(i+nelim-1, 8) * int(lrow,8) + 1_8
1476 ENDIF
1477 ELSE
1478 IF ( packed_cb ) THEN
1479 IF ( lrow .EQ. nrow ) THEN
1480 itmp8 = int(i,8)
1481 apos = itmp8 * (itmp8-1_8)/2_8 + 1_8
1482 ELSE
1483 itmp8 = int(i + lrow - nrow,8)
1484 apos = itmp8 * (itmp8-1_8)/2_8 + 1_8 -
1485 & int(lrow - nrow, 8) * int(lrow-nrow+1,8) / 2_8
1486 ENDIF
1487 ELSE
1488 apos = int( i - 1, 8 ) * lda_son8 + shiftcb_son + 1_8
1489 ENDIF
1490 ENDIF
1491 CALL mpi_pack( a_cbson( apos ), this_row_length,
1492 & mpi_double_complex,
1493 & buf_cb%CONTENT( ipos ), size_pack,
1494 & position, comm, ierr_mpi )
1495 ENDDO
1496 200 CONTINUE
1497 IF (nbrows_already_sent == 0) THEN
1498 IF (compute_max) THEN
1499 CALL mpi_pack(nfs4father,1,
1500 & mpi_integer,
1501 & buf_cb%CONTENT( ipos ), size_pack,
1502 & position, comm, ierr_mpi )
1503 IF (nfs4father .GT. 0) THEN
1504 IF (cb_is_lr) THEN
1505 CALL zmumps_blr_retrieve_m_array (
1506 & iw_cbson(1+xxf), m_array)
1507 CALL mpi_pack(m_array(1), nfs4father,
1508 & mpi_double_precision,
1509 & buf_cb%CONTENT( ipos ), size_pack,
1510 & position, comm, ierr_mpi )
1511 CALL zmumps_blr_free_m_array ( iw_cbson(1+xxf) )
1512 ELSE
1513 buf_max_array(1:nfs4father) = zero
1514 IF(maprow(nrow) .GT. nass_pere) THEN
1515 DO ps1=1,nrow
1516 IF(maprow(ps1).GT.nass_pere) EXIT
1517 ENDDO
1518 IF (desc_in_lu) THEN
1519 IF (packed_cb) THEN
1520 apos = int(nelim+ps1,8) * int(nelim+ps1-1,8) /
1521 & 2_8 + 1_8
1522 nca = -44444
1523 asize = int(nrow,8) * int(nrow+1,8)/2_8 -
1524 & int(nelim+ps1,8) * int(nelim+ps1-1,8)/2_8
1525 lrow1 = ps1 + nelim
1526 ELSE
1527 apos = int(ps1+nelim-1,8) * int(lrow,8) + 1_8
1528 nca = lrow
1529 asize = int(nca,8) * int(nrow-ps1+1,8)
1530 lrow1 = lrow
1531 ENDIF
1532 ELSE
1533 IF (packed_cb) THEN
1534 IF (npiv.NE.0) THEN
1535 WRITE(*,*) "Error in PARPIV/ZMUMPS_BUF_SEND_CONTRIB_TYPE2"
1536 CALL mumps_abort()
1537 ENDIF
1538 lrow1=lrow-nrow+ps1
1539 itmp8 = int(ps1 + lrow - nrow,8)
1540 apos = itmp8 * (itmp8 - 1_8) / 2_8 + 1_8 -
1541 & int(lrow-nrow,8)*int(lrow-nrow+1,8)/2_8
1542 asize = int(lrow,8)*int(lrow+1,8)/2_8 -
1543 & itmp8*(itmp8-1_8)/2_8
1544 nca = -555555
1545 ELSE
1546 apos = int(ps1-1,8) * lda_son8 + 1_8 + shiftcb_son
1547 nca = int(lda_son8)
1548 asize = la_cbson - apos + 1_8
1549 lrow1=-666666
1550 ENDIF
1551 ENDIF
1552 IF ( nrow-ps1+1-keep253_loc-nvschur .GT. 0 ) THEN
1553 CALL zmumps_compute_maxpercol(
1554 & a_cbson(apos),asize,nca,
1555 & nrow-ps1+1-keep253_loc-nvschur,
1556 & buf_max_array,nfs4father,packed_cb,lrow1)
1557 ENDIF
1558 ENDIF
1559 CALL mpi_pack(buf_max_array, nfs4father,
1560 & mpi_double_precision,
1561 & buf_cb%CONTENT( ipos ), size_pack,
1562 & position, comm, ierr_mpi )
1563 ENDIF
1564 ENDIF
1565 ENDIF
1566 ENDIF
1567 keep(266)=keep(266)+1
1568 CALL mpi_isend( buf_cb%CONTENT( ipos ), position, mpi_packed,
1569 & pdest, contrib_type2, comm,
1570 & buf_cb%CONTENT( ireq ), ierr_mpi )
1571 IF ( size_pack.LT. position ) THEN
1572 WRITE(*,*) ' contniv2: SIZE, POSITION =',size_pack, position
1573 WRITE(*,*) ' NBROW, LROW = ', nbrow, lrow
1574 CALL mumps_abort()
1575 END IF
1576 IF ( size_pack .NE. position )
1577 & CALL buf_adjust( buf_cb, position )
1578 nbrows_already_sent=nbrows_already_sent + nbrows_packet
1579 IF (nbrows_already_sent .NE. nbrow ) THEN
1580 ierr = -1
1581 ENDIF
1582 100 CONTINUE
1583 RETURN
mumps_bloc2_get_islave
subroutine mumps_bloc2_get_islave(keep, keep8, inode, step, n, slavef, istep_to_iniv2, tab_pos_in_pere nass, ncb, nslaves, position, islave, iposslave)
Definition mumps_type2_blocking.F:479
zmumps_lr_data_m
Definition zmumps_lr_data_m.F:14
zmumps_lr_data_m::zmumps_blr_retrieve_m_array
subroutine, public zmumps_blr_retrieve_m_array(iwhandler, m_array)
Definition zmumps_lr_data_m.F:902
zmumps_lr_data_m::zmumps_blr_retrieve_begsblr_sta
subroutine, public zmumps_blr_retrieve_begsblr_sta(iwhandler, begs_blr_static)
Definition zmumps_lr_data_m.F:622
zmumps_lr_data_m::zmumps_blr_free_m_array
subroutine, public zmumps_blr_free_m_array(iwhandler)
Definition zmumps_lr_data_m.F:917
zmumps_lr_data_m::zmumps_blr_retrieve_cb_lrb
subroutine, public zmumps_blr_retrieve_cb_lrb(iwhandler, thecb)
Definition zmumps_lr_data_m.F:837
zmumps_lr_data_m::zmumps_blr_retrieve_nb_panels
subroutine, public zmumps_blr_retrieve_nb_panels(iwhandler, nb_panels)
Definition zmumps_lr_data_m.F:672
zmumps_lr_data_m::zmumps_blr_retrieve_begsblr_dyn
subroutine, public zmumps_blr_retrieve_begsblr_dyn(iwhandler, begs_blr_dynamic)
Definition zmumps_lr_data_m.F:638
zmumps_lr_data_m::zmumps_blr_retrieve_begs_blr_c
subroutine, public zmumps_blr_retrieve_begs_blr_c(iwhandler, begs_blr_col, nb_panels)
Definition zmumps_lr_data_m.F:654
zmumps_compute_maxpercol
subroutine zmumps_compute_maxpercol(a, asize, ncol, nrow, m_array, nmax, packed_cb, lrow1)
Definition ztools.F:1643

◆ zmumps_buf_send_contrib_type3()

subroutine, public zmumps_buf::zmumps_buf_send_contrib_type3 ( integer n,
integer ison,
integer nbcol_son,
integer nbrow_son,
integer, dimension( nbcol_son ) indcol_son,
integer, dimension( nbrow_son ) indrow_son,
integer ld_son,
complex(kind=8), dimension( ld_son, * ) val_son,
integer tag,
integer, dimension( nsubset_row ) subset_row,
integer, dimension( nsubset_col ) subset_col,
integer nsubset_row,
integer nsubset_col,
integer nsuprow,
integer nsupcol,
integer nprow,
integer npcol,
integer mblock,
integer, dimension(n) rg2l_row,
integer, dimension(n) rg2l_col,
integer nblock,
integer pdest,
integer comm,
integer ierr,
complex(kind=8), dimension(*) tab,
integer(8), intent(in) tabsize,
logical transp,
integer size_pack,
integer n_already_sent,
integer, dimension(500) keep,
integer bbpcbp )

Definition at line 2159 of file zmumps_comm_buffer.F.

2168 IMPLICIT NONE
2169 INTEGER N, ISON, NBCOL_SON, NBROW_SON, NSUBSET_ROW, NSUBSET_COL
2170 INTEGER NPROW, NPCOL, MBLOCK, NBLOCK, LD_SON
2171 INTEGER BBPCBP
2172 INTEGER PDEST, TAG, COMM, IERR
2173 INTEGER INDCOL_SON( NBCOL_SON ), INDROW_SON( NBROW_SON )
2174 INTEGER SUBSET_ROW( NSUBSET_ROW ), SUBSET_COL( NSUBSET_COL )
2175 INTEGER :: RG2L_ROW(N)
2176 INTEGER :: RG2L_COL(N)
2177 INTEGER NSUPROW, NSUPCOL
2178 INTEGER(8), INTENT(IN) :: TABSIZE
2179 INTEGER SIZE_PACK
2180 INTEGER KEEP(500)
2181 COMPLEX(kind=8) VAL_SON( LD_SON, * ), TAB(*)
2182 LOGICAL TRANSP
2183 INTEGER N_ALREADY_SENT
2184 include 'mpif.h'
2185 INTEGER :: IERR_MPI
2186 INTEGER SIZE1, SIZE2, SIZE_AV, POSITION
2187 INTEGER SIZE_CBP, SIZE_TMP
2188 INTEGER IREQ, IPOS, ITAB
2189 INTEGER ISUB, JSUB, I, J
2190 INTEGER ILOC_ROOT, JLOC_ROOT
2191 INTEGER IPOS_ROOT, JPOS_ROOT
2192 INTEGER IONE
2193 LOGICAL RECV_BUF_SMALLER_THAN_SEND
2194 INTEGER PDEST2(1)
2195 parameter( ione=1 )
2196 INTEGER N_PACKET
2197 INTEGER NSUBSET_ROW_EFF, NSUBSET_COL_EFF, NSUPCOL_EFF
2198 pdest2(1) = pdest
2199 ierr = 0
2200 IF ( nsubset_row * nsubset_col .NE. 0 ) THEN
2201 CALL zmumps_buf_size_available( buf_cb, size_av )
2202 IF (size_av .LT. size_rbuf_bytes) THEN
2203 recv_buf_smaller_than_send = .false.
2204 ELSE
2205 recv_buf_smaller_than_send = .true.
2206 size_av = size_rbuf_bytes
2207 ENDIF
2208 size_av = min(size_av, size_rbuf_bytes)
2209 CALL mpi_pack_size(8 + nsubset_col,
2210 & mpi_integer, comm, size1, ierr_mpi )
2211 size_cbp = 0
2212 IF (n_already_sent .EQ. 0 .AND.
2213 & min(nsuprow,nsupcol) .GT.0) THEN
2214 CALL mpi_pack_size(nsuprow, mpi_integer, comm,
2215 & size_cbp, ierr_mpi )
2216 CALL mpi_pack_size(nsupcol, mpi_integer, comm,
2217 & size_tmp, ierr_mpi )
2218 size_cbp = size_cbp + size_tmp
2219 CALL mpi_pack_size(nsuprow*nsupcol,
2220 & mpi_double_complex, comm,
2221 & size_tmp, ierr_mpi )
2222 size_cbp = size_cbp + size_tmp
2223 size1 = size1 + size_cbp
2224 ENDIF
2225 IF (bbpcbp.EQ.1) THEN
2226 nsubset_col_eff = nsubset_col - nsupcol
2227 nsupcol_eff = 0
2228 ELSE
2229 nsubset_col_eff = nsubset_col
2230 nsupcol_eff = nsupcol
2231 ENDIF
2232 nsubset_row_eff = nsubset_row - nsuprow
2233 n_packet =
2234 & (size_av - size1) / (sizeofint + nsubset_col_eff * sizeofreal)
2235 10 CONTINUE
2236 n_packet = min( n_packet,
2237 & nsubset_row_eff-n_already_sent )
2238 IF (n_packet .LE. 0 .AND.
2239 & nsubset_row_eff-n_already_sent.GT.0) THEN
2240 IF (recv_buf_smaller_than_send) THEN
2241 ierr=-3
2242 GOTO 100
2243 ELSE
2244 ierr = -1
2245 GOTO 100
2246 ENDIF
2247 ENDIF
2248 CALL mpi_pack_size( 8 + nsubset_col_eff + n_packet,
2249 & mpi_integer, comm, size1, ierr_mpi )
2250 size1 = size1 + size_cbp
2251 CALL mpi_pack_size( n_packet * nsubset_col_eff,
2252 & mpi_double_complex,
2253 & comm, size2, ierr_mpi )
2254 size_pack = size1 + size2
2255 IF (size_pack .GT. size_av) THEN
2256 n_packet = n_packet - 1
2257 IF ( n_packet > 0 ) THEN
2258 GOTO 10
2259 ELSE
2260 IF (recv_buf_smaller_than_send) THEN
2261 ierr = -3
2262 GOTO 100
2263 ELSE
2264 ierr = -1
2265 GOTO 100
2266 ENDIF
2267 ENDIF
2268 ENDIF
2269 IF (n_packet + n_already_sent .NE. nsubset_row - nsuprow
2270 & .AND.
2271 & size_pack .LT. size_rbuf_bytes / 4
2272 & .AND. .NOT. recv_buf_smaller_than_send)
2273 & THEN
2274 ierr = -1
2275 GOTO 100
2276 ENDIF
2277 ELSE
2278 n_packet = 0
2279 CALL mpi_pack_size(8,mpi_integer, comm, size_pack, ierr_mpi )
2280 END IF
2281 IF ( size_pack.GT.size_rbuf_bytes ) THEN
2282 ierr = -3
2283 GOTO 100
2284 ENDIF
2285 CALL buf_look( buf_cb, ipos, ireq, size_pack, ierr,
2286 & ione, pdest2
2287 & )
2288 IF ( ierr .LT. 0 ) GOTO 100
2289 position = 0
2290 CALL mpi_pack( ison, 1, mpi_integer,
2291 & buf_cb%CONTENT( ipos ),
2292 & size_pack, position, comm, ierr_mpi )
2293 CALL mpi_pack( nsubset_row, 1, mpi_integer,
2294 & buf_cb%CONTENT( ipos ),
2295 & size_pack, position, comm, ierr_mpi )
2296 CALL mpi_pack( nsuprow, 1, mpi_integer,
2297 & buf_cb%CONTENT( ipos ),
2298 & size_pack, position, comm, ierr_mpi )
2299 CALL mpi_pack( nsubset_col, 1, mpi_integer,
2300 & buf_cb%CONTENT( ipos ),
2301 & size_pack, position, comm, ierr_mpi )
2302 CALL mpi_pack( nsupcol, 1, mpi_integer,
2303 & buf_cb%CONTENT( ipos ),
2304 & size_pack, position, comm, ierr_mpi )
2305 CALL mpi_pack( n_already_sent, 1, mpi_integer,
2306 & buf_cb%CONTENT( ipos ),
2307 & size_pack, position, comm, ierr_mpi )
2308 CALL mpi_pack( n_packet, 1, mpi_integer,
2309 & buf_cb%CONTENT( ipos ),
2310 & size_pack, position, comm, ierr_mpi )
2311 CALL mpi_pack( bbpcbp, 1, mpi_integer,
2312 & buf_cb%CONTENT( ipos ),
2313 & size_pack, position, comm, ierr_mpi )
2314 IF ( nsubset_row * nsubset_col .NE. 0 ) THEN
2315 IF (n_already_sent .EQ. 0 .AND.
2316 & min(nsuprow, nsupcol) .GT. 0) THEN
2317 DO isub = nsubset_row-nsuprow+1, nsubset_row
2318 i = subset_row( isub )
2319 ipos_root = rg2l_row(indcol_son( i ))
2320 iloc_root = mblock
2321 & * ( ( ipos_root - 1 ) / ( mblock * nprow ) )
2322 & + mod( ipos_root - 1, mblock ) + 1
2323 CALL mpi_pack( iloc_root, 1, mpi_integer,
2324 & buf_cb%CONTENT( ipos ),
2325 & size_pack, position, comm, ierr_mpi )
2326 ENDDO
2327 DO isub = nsubset_col-nsupcol+1, nsubset_col
2328 j = subset_col( isub )
2329 jpos_root = indrow_son( j ) - n
2330 jloc_root = nblock
2331 & * ( ( jpos_root - 1 ) / ( nblock * npcol ) )
2332 & + mod( jpos_root - 1, nblock ) + 1
2333 CALL mpi_pack( jloc_root, 1, mpi_integer,
2334 & buf_cb%CONTENT( ipos ),
2335 & size_pack, position, comm, ierr_mpi )
2336 ENDDO
2337 IF ( tabsize.GE.int(nsuprow,8)*int(nsupcol,8) ) THEN
2338 itab = 1
2339 DO jsub = nsubset_row - nsuprow+1, nsubset_row
2340 j = subset_row(jsub)
2341 DO isub = nsubset_col - nsupcol+1, nsubset_col
2342 i = subset_col(isub)
2343 tab(itab) = val_son(j, i)
2344 itab = itab + 1
2345 ENDDO
2346 ENDDO
2347 CALL mpi_pack(tab(1), nsuprow*nsupcol,
2348 & mpi_double_complex,
2349 & buf_cb%CONTENT( ipos ),
2350 & size_pack, position, comm, ierr_mpi )
2351 ELSE
2352 DO jsub = nsubset_row - nsuprow+1, nsubset_row
2353 j = subset_row(jsub)
2354 DO isub = nsubset_col - nsupcol+1, nsubset_col
2355 i = subset_col(isub)
2356 CALL mpi_pack(val_son(j,i), 1,
2357 & mpi_double_complex,
2358 & buf_cb%CONTENT( ipos ),
2359 & size_pack, position, comm, ierr_mpi )
2360 ENDDO
2361 ENDDO
2362 ENDIF
2363 ENDIF
2364 IF ( .NOT. transp ) THEN
2365 DO isub = n_already_sent+1, n_already_sent+n_packet
2366 i = subset_row( isub )
2367 ipos_root = rg2l_row( indrow_son( i ) )
2368 iloc_root = mblock
2369 & * ( ( ipos_root - 1 ) / ( mblock * nprow ) )
2370 & + mod( ipos_root - 1, mblock ) + 1
2371 CALL mpi_pack( iloc_root, 1, mpi_integer,
2372 & buf_cb%CONTENT( ipos ),
2373 & size_pack, position, comm, ierr_mpi )
2374 END DO
2375 DO jsub = 1, nsubset_col_eff - nsupcol_eff
2376 j = subset_col( jsub )
2377 jpos_root = rg2l_col( indcol_son( j ) )
2378 jloc_root = nblock
2379 & * ( ( jpos_root - 1 ) / ( nblock * npcol ) )
2380 & + mod( jpos_root - 1, nblock ) + 1
2381 CALL mpi_pack( jloc_root, 1, mpi_integer,
2382 & buf_cb%CONTENT( ipos ),
2383 & size_pack, position, comm, ierr_mpi )
2384 END DO
2385 DO jsub = nsubset_col_eff-nsupcol_eff+1, nsubset_col_eff
2386 j = subset_col( jsub )
2387 jpos_root = indcol_son( j ) - n
2388 jloc_root = nblock
2389 & * ( ( jpos_root - 1 ) / ( nblock * npcol ) )
2390 & + mod( jpos_root - 1, nblock ) + 1
2391 CALL mpi_pack( jloc_root, 1, mpi_integer,
2392 & buf_cb%CONTENT( ipos ),
2393 & size_pack, position, comm, ierr_mpi )
2394 ENDDO
2395 ELSE
2396 DO jsub = n_already_sent+1, n_already_sent+n_packet
2397 j = subset_row( jsub )
2398 ipos_root = rg2l_row( indcol_son( j ) )
2399 iloc_root = mblock
2400 & * ( ( ipos_root - 1 ) / ( mblock * nprow ) )
2401 & + mod( ipos_root - 1, mblock ) + 1
2402 CALL mpi_pack( iloc_root, 1, mpi_integer,
2403 & buf_cb%CONTENT( ipos ),
2404 & size_pack, position, comm, ierr_mpi )
2405 END DO
2406 DO isub = 1, nsubset_col_eff - nsupcol_eff
2407 i = subset_col( isub )
2408 jpos_root = rg2l_col( indrow_son( i ) )
2409 jloc_root = nblock
2410 & * ( ( jpos_root - 1 ) / ( nblock * npcol ) )
2411 & + mod( jpos_root - 1, nblock ) + 1
2412 CALL mpi_pack( jloc_root, 1, mpi_integer,
2413 & buf_cb%CONTENT( ipos ),
2414 & size_pack, position, comm, ierr_mpi )
2415 END DO
2416 DO isub = nsubset_col_eff - nsupcol_eff + 1, nsubset_col_eff
2417 i = subset_col( isub )
2418 jpos_root = indrow_son(i) - n
2419 jloc_root = nblock
2420 & * ( ( jpos_root - 1 ) / ( nblock * npcol ) )
2421 & + mod( jpos_root - 1, nblock ) + 1
2422 CALL mpi_pack( jloc_root, 1, mpi_integer,
2423 & buf_cb%CONTENT( ipos ),
2424 & size_pack, position, comm, ierr_mpi )
2425 ENDDO
2426 END IF
2427 IF ( tabsize.GE.int(n_packet,8)*int(nsubset_col_eff,8) ) THEN
2428 IF ( .NOT. transp ) THEN
2429 itab = 1
2430 DO isub = n_already_sent+1,
2431 & n_already_sent+n_packet
2432 i = subset_row( isub )
2433 DO jsub = 1, nsubset_col_eff
2434 j = subset_col( jsub )
2435 tab( itab ) = val_son(j,i)
2436 itab = itab + 1
2437 END DO
2438 END DO
2439 CALL mpi_pack(tab(1), nsubset_col_eff*n_packet,
2440 & mpi_double_complex,
2441 & buf_cb%CONTENT( ipos ),
2442 & size_pack, position, comm, ierr_mpi )
2443 ELSE
2444 itab = 1
2445 DO jsub = n_already_sent+1, n_already_sent+n_packet
2446 j = subset_row( jsub )
2447 DO isub = 1, nsubset_col_eff
2448 i = subset_col( isub )
2449 tab( itab ) = val_son( j, i )
2450 itab = itab + 1
2451 END DO
2452 END DO
2453 CALL mpi_pack(tab(1), nsubset_col_eff*n_packet,
2454 & mpi_double_complex,
2455 & buf_cb%CONTENT( ipos ),
2456 & size_pack, position, comm, ierr_mpi )
2457 END IF
2458 ELSE
2459 IF ( .NOT. transp ) THEN
2460 DO isub = n_already_sent+1, n_already_sent+n_packet
2461 i = subset_row( isub )
2462 DO jsub = 1, nsubset_col_eff
2463 j = subset_col( jsub )
2464 CALL mpi_pack( val_son( j, i ), 1,
2465 & mpi_double_complex,
2466 & buf_cb%CONTENT( ipos ),
2467 & size_pack, position, comm, ierr_mpi )
2468 END DO
2469 END DO
2470 ELSE
2471 DO jsub = n_already_sent+1, n_already_sent+n_packet
2472 j = subset_row( jsub )
2473 DO isub = 1, nsubset_col_eff
2474 i = subset_col( isub )
2475 CALL mpi_pack( val_son( j, i ), 1,
2476 & mpi_double_complex,
2477 & buf_cb%CONTENT( ipos ),
2478 & size_pack, position, comm, ierr_mpi )
2479 END DO
2480 END DO
2481 END IF
2482 ENDIF
2483 END IF
2484 keep(266)=keep(266)+1
2485 CALL mpi_isend( buf_cb%CONTENT( ipos ), position, mpi_packed,
2486 & pdest, tag, comm, buf_cb%CONTENT( ireq ),
2487 & ierr_mpi )
2488 IF ( size_pack .LT. position ) THEN
2489 WRITE(*,*) ' Error sending contribution to root:Size<positn'
2490 WRITE(*,*) ' Size,position=',size_pack,position
2491 CALL mumps_abort()
2492 END IF
2493 IF ( size_pack .NE. position )
2494 & CALL buf_adjust( buf_cb, position )
2495 n_already_sent = n_already_sent + n_packet
2496 IF (nsubset_row * nsubset_col .NE. 0) THEN
2497 IF ( n_already_sent.NE.nsubset_row_eff ) ierr = -1
2498 ENDIF
2499 100 CONTINUE
2500 RETURN

◆ zmumps_buf_send_desc_bande()

subroutine, public zmumps_buf::zmumps_buf_send_desc_bande ( integer, intent(in) inode,
integer nbprocfils,
integer, intent(in) nlig,
integer, dimension( nlig ) ilig,
integer, intent(in) ncol,
integer, dimension( ncol ) icol,
integer, intent(in) nass,
integer, intent(in) nslaves_hdr,
integer, dimension( max(nslaves_hdr,1) ) list_slaves,
integer, intent(in) nslaves,
integer, intent(in) estim_nfs4father_atson,
integer dest,
integer, intent(in) ibc_source,
integer nfront,
integer comm,
integer, dimension(500), intent(inout) keep,
integer ierr,
integer, intent(in) lrstatus )

Definition at line 777 of file zmumps_comm_buffer.F.

785 IMPLICIT NONE
786 INTEGER COMM, IERR, NFRONT
787 INTEGER, intent(in) :: INODE
788 INTEGER, intent(in) :: NLIG, NCOL, NASS, NSLAVES_HDR, NSLAVES
789 INTEGER, intent(in) :: ESTIM_NFS4FATHER_ATSON
790 INTEGER NBPROCFILS, DEST
791 INTEGER ILIG( NLIG )
792 INTEGER ICOL( NCOL )
793 INTEGER, INTENT(IN) :: IBC_SOURCE
794 INTEGER LIST_SLAVES( max(NSLAVES_HDR,1) )
795 INTEGER, INTENT(INOUT) :: KEEP(500)
796 INTEGER, INTENT(IN) :: LRSTATUS
797 include 'mpif.h'
798 include 'mumps_tags.h'
799 INTEGER :: IERR_MPI
800 INTEGER SIZE_INT, SIZE_BYTES, POSITION, IPOS, IREQ
801 INTEGER IONE
802 INTEGER DEST2(1)
803 parameter( ione=1 )
804 dest2(1) = dest
805 ierr = 0
806 size_int = ( 11 + nlig + ncol + nslaves_hdr )
807 size_bytes = size_int * sizeofint
808 IF (size_int.GT.size_rbuf_bytes ) THEN
809 ierr = -3
810 RETURN
811 END IF
812 CALL buf_look( buf_cb, ipos, ireq, size_bytes, ierr,
813 & ione , dest2
814 & )
815 IF ( ierr .LT. 0 ) THEN
816 RETURN
817 ENDIF
818 position = ipos
819 buf_cb%CONTENT( position ) = size_int
820 position = position + 1
821 buf_cb%CONTENT( position ) = inode
822 position = position + 1
823 buf_cb%CONTENT( position ) = nbprocfils
824 position = position + 1
825 buf_cb%CONTENT( position ) = nlig
826 position = position + 1
827 buf_cb%CONTENT( position ) = ncol
828 position = position + 1
829 buf_cb%CONTENT( position ) = nass
830 position = position + 1
831 buf_cb%CONTENT( position ) = nfront
832 position = position + 1
833 buf_cb%CONTENT( position ) = nslaves_hdr
834 position = position + 1
835 buf_cb%CONTENT( position ) = nslaves
836 position = position + 1
837 buf_cb%CONTENT( position ) = lrstatus
838 position = position + 1
839 buf_cb%CONTENT( position ) = estim_nfs4father_atson
840 position = position + 1
841 IF (nslaves_hdr.GT.0) THEN
842 buf_cb%CONTENT( position: position + nslaves_hdr - 1 ) =
843 & list_slaves( 1: nslaves_hdr )
844 position = position + nslaves_hdr
845 ENDIF
846 buf_cb%CONTENT( position:position + nlig - 1 ) = ilig
847 position = position + nlig
848 buf_cb%CONTENT( position:position + ncol - 1 ) = icol
849 position = position + ncol
850 position = position - ipos
851 IF ( position * sizeofint .NE. size_bytes ) THEN
852 WRITE(*,*) 'Error in ZMUMPS_BUF_SEND_DESC_BANDE :',
853 & ' wrong estimated size'
854 CALL mumps_abort()
855 END IF
856 keep(266)=keep(266)+1
857 CALL mpi_isend( buf_cb%CONTENT( ipos ), size_bytes,
858 & mpi_packed,
859 & dest, maitre_desc_bande, comm,
860 & buf_cb%CONTENT( ireq ), ierr_mpi )
861 RETURN

◆ zmumps_buf_send_fils()

subroutine, public zmumps_buf::zmumps_buf_send_fils ( integer what,
integer comm,
integer nprocs,
integer father_node,
integer inode,
integer ncb,
integer, dimension(500) keep,
integer myid,
integer remote,
integer ierr )

Definition at line 2885 of file zmumps_comm_buffer.F.

2889 IMPLICIT NONE
2890 INTEGER COMM, NPROCS, MYID, IERR, WHAT,REMOTE
2891 INTEGER FATHER_NODE,INODE
2892 include 'mpif.h'
2893 include 'mumps_tags.h'
2894 INTEGER :: IERR_MPI
2895 INTEGER POSITION, IREQ, IPOS, SIZE
2896 INTEGER NDEST, IDEST, IPOSMSG
2897 INTEGER IZERO,NCB,KEEP(500)
2898 INTEGER MYID2(1)
2899 parameter( izero=0 )
2900 myid2(1) = myid
2901 ndest = 1
2902 IF ( ndest .eq. 0 ) THEN
2903 RETURN
2904 ENDIF
2905 IF((keep(81).EQ.2).OR.(keep(81).EQ.3))THEN
2906 CALL mpi_pack_size( 4 + ovhsize,
2907 & mpi_integer, comm,
2908 & SIZE, ierr_mpi )
2909 ELSE
2910 CALL mpi_pack_size( 2 + ovhsize,
2911 & mpi_integer, comm,
2912 & SIZE, ierr_mpi )
2913 ENDIF
2914 CALL buf_look( buf_load, ipos, ireq, SIZE, ierr,
2915 & izero, myid2
2916 & )
2917 IF ( ierr .LT. 0 ) THEN
2918 RETURN
2919 ENDIF
2920 buf_load%ILASTMSG = buf_load%ILASTMSG + ( ndest - 1 ) * ovhsize
2921 ipos = ipos - ovhsize
2922 DO idest = 1, ndest - 1
2923 buf_load%CONTENT( ipos + ( idest - 1 ) * ovhsize ) =
2924 & ipos + idest * ovhsize
2925 END DO
2926 buf_load%CONTENT( ipos + ( ndest - 1 ) * ovhsize ) = 0
2927 iposmsg = ipos + ovhsize * ndest
2928 position = 0
2929 CALL mpi_pack( what, 1, mpi_integer,
2930 & buf_load%CONTENT( iposmsg ), SIZE,
2931 & position, comm, ierr_mpi )
2932 CALL mpi_pack( father_node, 1, mpi_integer,
2933 & buf_load%CONTENT( iposmsg ), SIZE,
2934 & position, comm, ierr_mpi )
2935 IF((keep(81).EQ.2).OR.(keep(81).EQ.3))THEN
2936 CALL mpi_pack( inode, 1, mpi_integer,
2937 & buf_load%CONTENT( iposmsg ), SIZE,
2938 & position, comm, ierr_mpi )
2939 CALL mpi_pack( ncb, 1, mpi_integer,
2940 & buf_load%CONTENT( iposmsg ), SIZE,
2941 & position, comm, ierr_mpi )
2942 ENDIF
2943 idest = 1
2944 keep(267)=keep(267)+1
2945 CALL mpi_isend( buf_load%CONTENT( iposmsg ),
2946 & position, mpi_packed, remote,
2947 & update_load, comm,
2948 & buf_load%CONTENT( ireq+(idest-1)*ovhsize ),
2949 & ierr_mpi )
2950 SIZE = SIZE - ( ndest - 1 ) * ovhsize * sizeofint
2951 IF ( SIZE .LT. position ) THEN
2952 WRITE(*,*) ' Error in ZMUMPS_BUF_SEND_FILS'
2953 WRITE(*,*) ' Size,position=',SIZE,position
2954 CALL mumps_abort()
2955 END IF
2956 IF ( SIZE .NE. position )
2957 & CALL buf_adjust( buf_load, position )
2958 RETURN

◆ zmumps_buf_send_maitre2()

subroutine, public zmumps_buf::zmumps_buf_send_maitre2 ( integer nbrows_already_sent,
integer ipere,
integer ison,
integer nrow,
integer, dimension( nrow ) irow,
integer ncol,
integer, dimension( ncol ) icol,
complex(kind=8), dimension(lda, *) val,
integer lda,
integer nelim,
integer type_son,
integer nslaves,
integer, dimension( nslaves ) slaves,
integer dest,
integer comm,
integer ierr,
integer slavef,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere )

Definition at line 863 of file zmumps_comm_buffer.F.

869 IMPLICIT NONE
870 INTEGER NBROWS_ALREADY_SENT
871 INTEGER LDA, NELIM, TYPE_SON
872 INTEGER IPERE, ISON, NROW, NCOL, NSLAVES
873 INTEGER IROW( NROW )
874 INTEGER ICOL( NCOL )
875 INTEGER SLAVES( NSLAVES )
876 COMPLEX(kind=8) VAL(LDA, *)
877 INTEGER IPOS, IREQ, DEST, COMM, IERR
878 INTEGER SLAVEF, KEEP(500), INIV2
879 INTEGER(8) KEEP8(150)
880 INTEGER TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
881 include 'mpif.h'
882 include 'mumps_tags.h'
883 INTEGER :: IERR_MPI
884 INTEGER SIZE1, SIZE2, SIZE3, SIZE_PACK, POSITION, I
885 INTEGER NBROWS_PACKET, NCOL_SEND
886 INTEGER SIZE_AV
887 LOGICAL RECV_BUF_SMALLER_THAN_SEND
888 INTEGER IONE
889 INTEGER DEST2(1)
890 parameter( ione=1 )
891 dest2(1) = dest
892 ierr = 0
893 IF ( nelim .NE. nrow ) THEN
894 WRITE(*,*) 'Error in TRY_SEND_MAITRE2:',nelim, nrow
895 CALL mumps_abort()
896 END IF
897 IF (nbrows_already_sent .EQ. 0) THEN
898 CALL mpi_pack_size( nrow+ncol+7+nslaves, mpi_integer,
899 & comm, size1, ierr_mpi )
900 IF ( type_son .eq. 2 ) THEN
901 CALL mpi_pack_size( nslaves+1, mpi_integer,
902 & comm, size3, ierr_mpi )
903 ELSE
904 size3 = 0
905 ENDIF
906 size1=size1+size3
907 ELSE
908 CALL mpi_pack_size(7, mpi_integer,comm,size1,ierr_mpi)
909 ENDIF
910 IF ( keep(50).ne.0 .AND. type_son .eq. 2 ) THEN
911 ncol_send = nrow
912 ELSE
913 ncol_send = ncol
914 ENDIF
915 CALL zmumps_buf_size_available( buf_cb, size_av )
916 IF (size_av .LT. size_rbuf_bytes) THEN
917 recv_buf_smaller_than_send = .false.
918 ELSE
919 recv_buf_smaller_than_send = .true.
920 size_av = size_rbuf_bytes
921 ENDIF
922 IF (nrow .GT. 0 ) THEN
923 nbrows_packet = (size_av - size1) / ncol_send / sizeofreal
924 nbrows_packet = min(nbrows_packet, nrow - nbrows_already_sent)
925 nbrows_packet = max(nbrows_packet, 0)
926 ELSE
927 nbrows_packet =0
928 ENDIF
929 IF (nbrows_packet .EQ. 0 .AND. nrow .NE. 0) THEN
930 IF (recv_buf_smaller_than_send) THEN
931 ierr=-3
932 GOTO 100
933 ELSE
934 ierr=-1
935 GOTO 100
936 ENDIF
937 ENDIF
938 10 CONTINUE
939 CALL mpi_pack_size( nbrows_packet * ncol_send,
940 & mpi_double_complex,
941 & comm, size2, ierr_mpi )
942 size_pack = size1 + size2
943 IF (size_pack .GT. size_av) THEN
944 nbrows_packet = nbrows_packet - 1
945 IF ( nbrows_packet .GT. 0 ) THEN
946 GOTO 10
947 ELSE
948 IF (recv_buf_smaller_than_send) THEN
949 ierr = -3
950 GOTO 100
951 ELSE
952 ierr = -1
953 GOTO 100
954 ENDIF
955 ENDIF
956 ENDIF
957 IF (nbrows_packet + nbrows_already_sent.NE.nrow .AND.
958 & size_pack - size1 .LT. ( size_rbuf_bytes - size1 ) / 2
959 & .AND.
960 & .NOT. recv_buf_smaller_than_send)
961 & THEN
962 ierr = -1
963 GOTO 100
964 ENDIF
965 CALL buf_look( buf_cb, ipos, ireq, size_pack, ierr,
966 & ione , dest2
967 & )
968 IF ( ierr .LT. 0 ) THEN
969 GOTO 100
970 ENDIF
971 position = 0
972 CALL mpi_pack( ipere, 1, mpi_integer,
973 & buf_cb%CONTENT( ipos ), size_pack,
974 & position, comm, ierr_mpi )
975 CALL mpi_pack( ison, 1, mpi_integer,
976 & buf_cb%CONTENT( ipos ), size_pack,
977 & position, comm, ierr_mpi )
978 CALL mpi_pack( nslaves, 1, mpi_integer,
979 & buf_cb%CONTENT( ipos ), size_pack,
980 & position, comm, ierr_mpi )
981 CALL mpi_pack( nrow, 1, mpi_integer,
982 & buf_cb%CONTENT( ipos ), size_pack,
983 & position, comm, ierr_mpi )
984 CALL mpi_pack( ncol, 1, mpi_integer,
985 & buf_cb%CONTENT( ipos ), size_pack,
986 & position, comm, ierr_mpi )
987 CALL mpi_pack( nbrows_already_sent, 1, mpi_integer,
988 & buf_cb%CONTENT( ipos ), size_pack,
989 & position, comm, ierr_mpi )
990 CALL mpi_pack( nbrows_packet, 1, mpi_integer,
991 & buf_cb%CONTENT( ipos ), size_pack,
992 & position, comm, ierr_mpi )
993 IF (nbrows_already_sent .EQ. 0) THEN
994 IF (nslaves.GT.0) THEN
995 CALL mpi_pack( slaves, nslaves, mpi_integer,
996 & buf_cb%CONTENT( ipos ), size_pack,
997 & position, comm, ierr_mpi )
998 ENDIF
999 CALL mpi_pack( irow, nrow, mpi_integer,
1000 & buf_cb%CONTENT( ipos ), size_pack,
1001 & position, comm, ierr_mpi )
1002 CALL mpi_pack( icol, ncol, mpi_integer,
1003 & buf_cb%CONTENT( ipos ), size_pack,
1004 & position, comm, ierr_mpi )
1005 IF ( type_son .eq. 2 ) THEN
1006 CALL mpi_pack( tab_pos_in_pere(1,iniv2), nslaves+1,
1007 & mpi_integer,
1008 & buf_cb%CONTENT( ipos ), size_pack,
1009 & position, comm, ierr_mpi )
1010 ENDIF
1011 ENDIF
1012 IF (nbrows_packet.GE.1) THEN
1013 DO i=nbrows_already_sent+1,
1014 & nbrows_already_sent+nbrows_packet
1015 CALL mpi_pack( val(1,i), ncol_send,
1016 & mpi_double_complex,
1017 & buf_cb%CONTENT( ipos ), size_pack,
1018 & position, comm, ierr_mpi )
1019 ENDDO
1020 ENDIF
1021 keep(266)=keep(266)+1
1022 CALL mpi_isend( buf_cb%CONTENT( ipos ), position, mpi_packed,
1023 & dest, maitre2, comm,
1024 & buf_cb%CONTENT( ireq ), ierr_mpi )
1025 IF ( size_pack .LT. position ) THEN
1026 write(*,*) 'Try_send_maitre2, SIZE,POSITION=',
1027 & size_pack,position
1028 CALL mumps_abort()
1029 END IF
1030 IF ( size_pack .NE. position )
1031 & CALL buf_adjust( buf_cb, position )
1032 nbrows_already_sent = nbrows_already_sent + nbrows_packet
1033 IF ( nbrows_already_sent .NE. nrow ) THEN
1034 ierr = -1
1035 ENDIF
1036 100 CONTINUE
1037 RETURN

◆ zmumps_buf_send_maplig()

subroutine, public zmumps_buf::zmumps_buf_send_maplig ( integer inode,
integer nfront,
integer nass1,
integer nfs4father,
integer ison,
integer myid,
integer nslaves,
integer, dimension( nslaves ) slaves_pere,
integer, dimension( ncbson ) trow,
integer ncbson,
integer comm,
integer ierr,
integer, dimension( ndest ) dest,
integer ndest,
integer slavef,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
integer, dimension(n) step,
integer n,
integer, dimension(keep(71)) istep_to_iniv2,
tab_pos_in_per )

Definition at line 1638 of file zmumps_comm_buffer.F.

1649 IMPLICIT NONE
1650 INTEGER INODE, NFRONT, NASS1, NCBSON, NSLAVES,
1651 & NDEST
1652 INTEGER SLAVEF, MYID, ISON
1653 INTEGER TROW( NCBSON )
1654 INTEGER DEST( NDEST )
1655 INTEGER SLAVES_PERE( NSLAVES )
1656 INTEGER COMM, IERR
1657 INTEGER KEEP(500), N
1658 INTEGER(8) KEEP8(150)
1659 INTEGER STEP(N),
1660 & ISTEP_TO_INIV2(KEEP(71)),
1661 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
1662 include 'mpif.h'
1663 include 'mumps_tags.h'
1664 INTEGER :: IERR_MPI
1665 INTEGER SIZE_AV, IDEST, NSEND, SIZE, NFS4FATHER
1666 INTEGER TROW_SIZE, POSITION, INDX, INIV2
1667 INTEGER IPOS, IREQ
1668 INTEGER IONE
1669 parameter( ione=1 )
1670 INTEGER NASS_SON
1671 nass_son = -99998
1672 ierr = 0
1673 IF ( ndest .eq. 1 ) THEN
1674 IF ( dest(1).EQ.myid ) GOTO 500
1675 SIZE = sizeofint * ( 7 + nslaves + ncbson )
1676 IF ( nslaves.GT.0 ) THEN
1677 SIZE = SIZE + sizeofint * ( nslaves + 1 )
1678 ENDIF
1679 IF (size.GT.size_rbuf_bytes ) THEN
1680 ierr = -3
1681 RETURN
1682 END IF
1683 CALL buf_look( buf_cb, ipos, ireq, SIZE, ierr,
1684 & ione, dest
1685 & )
1686 IF (ierr .LT. 0 ) THEN
1687 RETURN
1688 ENDIF
1689 position = ipos
1690 buf_cb%CONTENT( position ) = inode
1691 position = position + 1
1692 buf_cb%CONTENT( position ) = ison
1693 position = position + 1
1694 buf_cb%CONTENT( position ) = nslaves
1695 position = position + 1
1696 buf_cb%CONTENT( position ) = nfront
1697 position = position + 1
1698 buf_cb%CONTENT( position ) = nass1
1699 position = position + 1
1700 buf_cb%CONTENT( position ) = ncbson
1701 position = position + 1
1702 buf_cb%CONTENT( position ) = nfs4father
1703 position = position + 1
1704 IF ( nslaves.GT.0 ) THEN
1705 iniv2 = istep_to_iniv2( step(inode) )
1706 buf_cb%CONTENT( position: position + nslaves )
1707 & = tab_pos_in_pere(1:nslaves+1,iniv2)
1708 position = position + nslaves + 1
1709 ENDIF
1710 IF ( nslaves .NE. 0 ) THEN
1711 buf_cb%CONTENT( position: position + nslaves - 1 )
1712 & = slaves_pere( 1: nslaves )
1713 position = position + nslaves
1714 END IF
1715 buf_cb%CONTENT( position:position+ncbson-1 ) =
1716 & trow( 1: ncbson )
1717 position = position + ncbson
1718 position = position - ipos
1719 IF ( position * sizeofint .NE. SIZE ) THEN
1720 WRITE(*,*) 'Error in ZMUMPS_BUF_SEND_MAPLIG :',
1721 & ' wrong estimated size'
1722 CALL mumps_abort()
1723 END IF
1724 keep(266)=keep(266)+1
1725 CALL mpi_isend( buf_cb%CONTENT( ipos ), SIZE,
1726 & mpi_packed,
1727 & dest( ndest ), maplig, comm,
1728 & buf_cb%CONTENT( ireq ),
1729 & ierr_mpi )
1730 ELSE
1731 nsend = 0
1732 DO idest = 1, ndest
1733 IF ( dest( idest ) .ne. myid ) nsend = nsend + 1
1734 END DO
1735 SIZE = sizeofint *
1736 & ( ( ovhsize + 7 + nslaves )* nsend + ncbson )
1737 IF ( nslaves.GT.0 ) THEN
1738 SIZE = SIZE + sizeofint * nsend*( nslaves + 1 )
1739 ENDIF
1740 CALL zmumps_buf_size_available( buf_cb, size_av )
1741 IF ( size_av .LT. SIZE ) THEN
1742 ierr = -1
1743 RETURN
1744 END IF
1745 DO idest= 1, ndest
1746 CALL mumps_bloc2_get_slave_info(
1747 & keep,keep8, ison, step, n, slavef,
1748 & istep_to_iniv2, tab_pos_in_pere,
1749 & idest, ncbson,
1750 & ndest,
1751 & trow_size, indx )
1752 SIZE = sizeofint * ( nslaves + trow_size + 7 )
1753 IF ( nslaves.GT.0 ) THEN
1754 SIZE = SIZE + sizeofint * ( nslaves + 1 )
1755 ENDIF
1756 IF ( myid .NE. dest( idest ) ) THEN
1757 IF (size.GT.size_rbuf_bytes) THEN
1758 ierr = -3
1759 RETURN
1760 ENDIF
1761 CALL buf_look( buf_cb, ipos, ireq, SIZE, ierr,
1762 & ione, dest(idest) )
1763 IF ( ierr .LT. 0 ) THEN
1764 WRITE(*,*) 'Internal error ZMUMPS_BUF_SEND_MAPLIG',
1765 & 'IERR after BUF_LOOK=',ierr
1766 CALL mumps_abort()
1767 END IF
1768 position = ipos
1769 buf_cb%CONTENT( position ) = inode
1770 position = position + 1
1771 buf_cb%CONTENT( position ) = ison
1772 position = position + 1
1773 buf_cb%CONTENT( position ) = nslaves
1774 position = position + 1
1775 buf_cb%CONTENT( position ) = nfront
1776 position = position + 1
1777 buf_cb%CONTENT( position ) = nass1
1778 position = position + 1
1779 buf_cb%CONTENT( position ) = trow_size
1780 position = position + 1
1781 buf_cb%CONTENT( position ) = nfs4father
1782 position = position + 1
1783 IF ( nslaves.GT.0 ) THEN
1784 iniv2 = istep_to_iniv2( step(inode) )
1785 buf_cb%CONTENT( position: position + nslaves )
1786 & = tab_pos_in_pere(1:nslaves+1,iniv2)
1787 position = position + nslaves + 1
1788 ENDIF
1789 IF ( nslaves .NE. 0 ) THEN
1790 buf_cb%CONTENT( position: position + nslaves - 1 )
1791 & = slaves_pere( 1: nslaves )
1792 position = position + nslaves
1793 END IF
1794 buf_cb%CONTENT( position:position+trow_size-1 ) =
1795 & trow( indx: indx + trow_size - 1 )
1796 position = position + trow_size
1797 position = position - ipos
1798 IF ( position * sizeofint .NE. SIZE ) THEN
1799 WRITE(*,*) ' ERROR 1 in TRY_SEND_MAPLIG:',
1800 & 'Wrong estimated size'
1801 CALL mumps_abort()
1802 END IF
1803 keep(266)=keep(266)+1
1804 CALL mpi_isend( buf_cb%CONTENT( ipos ), SIZE,
1805 & mpi_packed,
1806 & dest( idest ), maplig, comm,
1807 & buf_cb%CONTENT( ireq ),
1808 & ierr_mpi )
1809 END IF
1810 END DO
1811 END IF
1812 500 CONTINUE
1813 RETURN
mumps_bloc2_get_slave_info
subroutine mumps_bloc2_get_slave_info(keep, keep8, inode, step, n, slavef, istep_to_iniv2, tab_pos_in_pere islave, ncb, nslaves, size, first_index)
Definition mumps_type2_blocking.F:367

◆ zmumps_buf_send_master2slave()

subroutine, public zmumps_buf::zmumps_buf_send_master2slave ( integer nrhs,
integer inode,
integer ifath,
integer eff_cb_size,
integer ld_cb,
integer ld_piv,
integer npiv,
integer jbdeb,
integer jbfin,
complex(kind=8), dimension( ld_cb*(nrhs-1)+eff_cb_size ) cb,
complex(kind=8), dimension( max(1, ld_piv*(nrhs-1)+npiv) ) sol,
integer dest,
integer comm,
integer, dimension(500), intent(inout) keep,
integer ierr )

Definition at line 422 of file zmumps_comm_buffer.F.

427 IMPLICIT NONE
428 INTEGER NRHS, INODE, IFATH, EFF_CB_SIZE, LD_CB, LD_PIV, NPIV
429 INTEGER DEST, COMM, IERR, JBDEB, JBFIN
430 COMPLEX(kind=8) CB( LD_CB*(NRHS-1)+EFF_CB_SIZE )
431 COMPLEX(kind=8) SOL( max(1, LD_PIV*(NRHS-1)+NPIV) )
432 INTEGER, INTENT(INOUT) :: KEEP(500)
433 include 'mpif.h'
434 include 'mumps_tags.h'
435 INTEGER :: IERR_MPI
436 INTEGER SIZE, SIZE1, SIZE2, K
437 INTEGER POSITION, IREQ, IPOS
438 INTEGER IONE
439 INTEGER DEST2(1)
440 parameter( ione=1 )
441 dest2(1) = dest
442 ierr = 0
443 CALL mpi_pack_size( 6, mpi_integer, comm, size1, ierr )
444 CALL mpi_pack_size( nrhs * (eff_cb_size + npiv),
445 & mpi_double_complex, comm,
446 & size2, ierr_mpi )
447 SIZE = size1 + size2
448 CALL buf_look( buf_cb, ipos, ireq, SIZE, ierr,
449 & ione , dest2
450 & )
451 IF ( ierr .LT. 0 ) THEN
452 RETURN
453 ENDIF
454 position = 0
455 CALL mpi_pack( inode, 1, mpi_integer,
456 & buf_cb%CONTENT( ipos ), SIZE,
457 & position, comm, ierr_mpi )
458 CALL mpi_pack( ifath, 1, mpi_integer,
459 & buf_cb%CONTENT( ipos ), SIZE,
460 & position, comm, ierr_mpi )
461 CALL mpi_pack( eff_cb_size , 1, mpi_integer,
462 & buf_cb%CONTENT( ipos ), SIZE,
463 & position, comm, ierr_mpi )
464 CALL mpi_pack( npiv , 1, mpi_integer,
465 & buf_cb%CONTENT( ipos ), SIZE,
466 & position, comm, ierr_mpi )
467 CALL mpi_pack( jbdeb , 1, mpi_integer,
468 & buf_cb%CONTENT( ipos ), SIZE,
469 & position, comm, ierr_mpi )
470 CALL mpi_pack( jbfin , 1, mpi_integer,
471 & buf_cb%CONTENT( ipos ), SIZE,
472 & position, comm, ierr_mpi )
473 DO k = 1, nrhs
474 CALL mpi_pack( cb( 1 + ld_cb * (k-1) ),
475 & eff_cb_size, mpi_double_complex,
476 & buf_cb%CONTENT( ipos ), SIZE,
477 & position, comm, ierr_mpi )
478 END DO
479 IF ( npiv .GT. 0 ) THEN
480 DO k=1, nrhs
481 CALL mpi_pack( sol(1+ld_piv*(k-1)),
482 & npiv, mpi_double_complex,
483 & buf_cb%CONTENT( ipos ), SIZE,
484 & position, comm, ierr_mpi )
485 ENDDO
486 END IF
487 keep(266)=keep(266)+1
488 CALL mpi_isend( buf_cb%CONTENT( ipos ), position, mpi_packed,
489 & dest, master2slave, comm,
490 & buf_cb%CONTENT( ireq ), ierr_mpi )
491 IF ( SIZE .LT. position ) THEN
492 WRITE(*,*) 'Try_send_master2slave: SIZE, POSITION = ',
493 & SIZE, position
494 CALL mumps_abort()
495 END IF
496 IF ( SIZE .NE. position ) CALL buf_adjust( buf_cb, position )
497 RETURN

◆ zmumps_buf_send_not_mstr()

subroutine, public zmumps_buf::zmumps_buf_send_not_mstr ( integer comm,
integer myid,
integer nprocs,
double precision max_surf_master,
integer, dimension(500), intent(inout) keep,
integer ierr )

Definition at line 2960 of file zmumps_comm_buffer.F.

2962 IMPLICIT NONE
2963 include 'mpif.h'
2964 include 'mumps_tags.h'
2965 INTEGER COMM, MYID, IERR, NPROCS
2966 DOUBLE PRECISION MAX_SURF_MASTER
2967 INTEGER, INTENT(INOUT) :: KEEP(500)
2968 INTEGER :: IERR_MPI
2969 INTEGER IPOS, IREQ, IDEST, IPOSMSG, POSITION, I
2970 INTEGER IZERO
2971 INTEGER MYID2(1)
2972 parameter( izero=0 )
2973 INTEGER NDEST, NINTS, NREALS, SIZE, SIZE1, SIZE2
2974 INTEGER WHAT
2975 ierr = 0
2976 myid2(1) = myid
2977 ndest = nprocs - 1
2978 nints = 1 + ( ndest-1 ) * ovhsize
2979 nreals = 1
2980 CALL mpi_pack_size( nints,
2981 & mpi_integer, comm,
2982 & size1, ierr_mpi )
2983 CALL mpi_pack_size( nreals,
2984 & mpi_double_precision, comm,
2985 & size2, ierr_mpi )
2986 size=size1+size2
2987 CALL buf_look( buf_load, ipos, ireq, SIZE, ierr,
2988 & izero, myid2 )
2989 IF ( ierr .LT. 0 ) THEN
2990 RETURN
2991 ENDIF
2992 buf_load%ILASTMSG = buf_load%ILASTMSG + ( ndest - 1 ) * ovhsize
2993 ipos = ipos - ovhsize
2994 DO idest = 1, ndest - 1
2995 buf_load%CONTENT( ipos + ( idest - 1 ) * ovhsize ) =
2996 & ipos + idest * ovhsize
2997 END DO
2998 buf_load%CONTENT( ipos + ( ndest - 1 ) * ovhsize ) = 0
2999 iposmsg = ipos + ovhsize * ndest
3000 position = 0
3001 what = 4
3002 CALL mpi_pack( what, 1, mpi_integer,
3003 & buf_load%CONTENT( iposmsg ), SIZE,
3004 & position, comm, ierr_mpi )
3005 CALL mpi_pack( max_surf_master, 1, mpi_double_precision,
3006 & buf_load%CONTENT( iposmsg ), SIZE,
3007 & position, comm, ierr_mpi )
3008 idest = 0
3009 DO i = 0, nprocs - 1
3010 IF ( i .ne. myid ) THEN
3011 idest = idest + 1
3012 keep(267)=keep(267)+1
3013 CALL mpi_isend( buf_load%CONTENT( iposmsg ),
3014 & position, mpi_packed, i,
3015 & update_load, comm,
3016 & buf_load%CONTENT( ireq+(idest-1)*ovhsize ),
3017 & ierr_mpi )
3018 END IF
3019 END DO
3020 SIZE = SIZE - ( ndest - 1 ) * ovhsize * sizeofint
3021 IF ( SIZE .LT. position ) THEN
3022 WRITE(*,*) ' Error in ZMUMPS_BUF_BCAST_ARRAY'
3023 WRITE(*,*) ' Size,position=',SIZE,position
3024 CALL mumps_abort()
3025 END IF
3026 IF ( SIZE .NE. position )
3027 & CALL buf_adjust( buf_load, position )
3028 RETURN

◆ zmumps_buf_send_root2slave()

subroutine, public zmumps_buf::zmumps_buf_send_root2slave ( integer tot_root_size,
integer tot_cont2recv,
integer dest,
integer comm,
integer, dimension(500), intent(inout) keep,
integer ierr )

Definition at line 2590 of file zmumps_comm_buffer.F.

2592 IMPLICIT NONE
2593 INTEGER TOT_ROOT_SIZE, TOT_CONT2RECV, DEST, COMM, IERR
2594 INTEGER, INTENT(INOUT) :: KEEP(500)
2595 include 'mpif.h'
2596 include 'mumps_tags.h'
2597 INTEGER :: IERR_MPI
2598 INTEGER SIZE, IPOS, IREQ
2599 INTEGER IONE
2600 INTEGER DEST2(1)
2601 parameter( ione=1 )
2602 ierr = 0
2603 dest2(1) = dest
2604 SIZE = 2 * sizeofint
2605 CALL buf_look( buf_small, ipos, ireq, SIZE, ierr,
2606 & ione, dest2
2607 & )
2608 IF ( ierr .LT. 0 ) THEN
2609 WRITE(*,*) 'Internal error 2 with small buffers '
2610 CALL mumps_abort()
2611 END IF
2612 IF ( ierr .LT. 0 ) THEN
2613 RETURN
2614 ENDIF
2615 buf_small%CONTENT( ipos ) = tot_root_size
2616 buf_small%CONTENT( ipos + 1 ) = tot_cont2recv
2617 keep(266)=keep(266)+1
2618 CALL mpi_isend( buf_small%CONTENT( ipos ), SIZE,
2619 & mpi_packed,
2620 & dest, root_2slave, comm,
2621 & buf_small%CONTENT( ireq ), ierr_mpi )
2622 RETURN

◆ zmumps_buf_send_root2son()

subroutine, public zmumps_buf::zmumps_buf_send_root2son ( integer ison,
integer nelim_root,
integer dest,
integer comm,
integer, dimension(500), intent(inout) keep,
integer ierr )

Definition at line 2556 of file zmumps_comm_buffer.F.

2558 IMPLICIT NONE
2559 INTEGER ISON, NELIM_ROOT, DEST, COMM, IERR
2560 INTEGER, INTENT(INOUT) :: KEEP(500)
2561 include 'mpif.h'
2562 include 'mumps_tags.h'
2563 INTEGER :: IERR_MPI
2564 INTEGER IPOS, IREQ, SIZE
2565 INTEGER IONE
2566 INTEGER DEST2(1)
2567 parameter( ione=1 )
2568 dest2(1)=dest
2569 ierr = 0
2570 SIZE = 2 * sizeofint
2571 CALL buf_look( buf_small, ipos, ireq, SIZE, ierr,
2572 & ione, dest2
2573 & )
2574 IF ( ierr .LT. 0 ) THEN
2575 WRITE(*,*) 'Internal error 1 with small buffers '
2576 CALL mumps_abort()
2577 END IF
2578 IF ( ierr .LT. 0 ) THEN
2579 RETURN
2580 ENDIF
2581 buf_small%CONTENT( ipos ) = ison
2582 buf_small%CONTENT( ipos + 1 ) = nelim_root
2583 keep(266)=keep(266)+1
2584 CALL mpi_isend( buf_small%CONTENT( ipos ), SIZE,
2585 & mpi_packed,
2586 & dest, root_2son, comm,
2587 & buf_small%CONTENT( ireq ), ierr_mpi )
2588 RETURN

◆ zmumps_buf_send_rtnelind()

subroutine, public zmumps_buf::zmumps_buf_send_rtnelind ( integer ison,
integer nelim,
integer, dimension( nelim ) nelim_row,
integer, dimension( nelim ) nelim_col,
integer nslaves,
integer, dimension( nslaves ) slaves,
integer dest,
integer comm,
integer, dimension(500), intent(inout) keep,
integer ierr )

Definition at line 2502 of file zmumps_comm_buffer.F.

2505 INTEGER ISON, NELIM
2506 INTEGER NSLAVES, DEST, COMM, IERR
2507 INTEGER NELIM_ROW( NELIM ), NELIM_COL( NELIM )
2508 INTEGER SLAVES( NSLAVES )
2509 INTEGER, INTENT(INOUT) :: KEEP(500)
2510 include 'mpif.h'
2511 include 'mumps_tags.h'
2512 INTEGER :: IERR_MPI
2513 INTEGER SIZE, POSITION, IPOS, IREQ
2514 INTEGER IONE
2515 INTEGER DEST2(1)
2516 parameter( ione=1 )
2517 dest2(1) = dest
2518 ierr = 0
2519 SIZE = ( 3 + nslaves + 2 * nelim ) * sizeofint
2520 IF (size.GT.size_rbuf_bytes) THEN
2521 ierr = -3
2522 RETURN
2523 ENDIF
2524 CALL buf_look( buf_cb, ipos, ireq, SIZE, ierr,
2525 & ione, dest2
2526 & )
2527 IF ( ierr .LT. 0 ) THEN
2528 RETURN
2529 ENDIF
2530 position = ipos
2531 buf_cb%CONTENT( position ) = ison
2532 position = position + 1
2533 buf_cb%CONTENT( position ) = nelim
2534 position = position + 1
2535 buf_cb%CONTENT( position ) = nslaves
2536 position = position + 1
2537 buf_cb%CONTENT( position: position + nelim - 1 ) = nelim_row
2538 position = position + nelim
2539 buf_cb%CONTENT( position: position + nelim - 1 ) = nelim_col
2540 position = position + nelim
2541 buf_cb%CONTENT( position: position + nslaves - 1 ) = slaves
2542 position = position + nslaves
2543 position = position - ipos
2544 IF ( position * sizeofint .NE. SIZE ) THEN
2545 WRITE(*,*) 'Error in ZMUMPS_BUF_SEND_ROOT_NELIM_INDICES:',
2546 & 'wrong estimated size'
2547 CALL mumps_abort()
2548 END IF
2549 keep(266)=keep(266)+1
2550 CALL mpi_isend( buf_cb%CONTENT( ipos ), SIZE,
2551 & mpi_packed,
2552 & dest, root_nelim_indices, comm,
2553 & buf_cb%CONTENT( ireq ), ierr_mpi )
2554 RETURN

◆ zmumps_buf_send_update_load()

subroutine, public zmumps_buf::zmumps_buf_send_update_load ( logical bdc_sbtr,
logical bdc_mem,
logical bdc_md,
integer comm,
integer nprocs,
double precision load,
double precision mem,
double precision sbtr_cur,
double precision lu_usage,
integer, dimension(nprocs) future_niv2,
integer myid,
integer, dimension(500), intent(inout) keep,
integer ierr )

Definition at line 2681 of file zmumps_comm_buffer.F.

2687 IMPLICIT NONE
2688 INTEGER COMM, NPROCS, MYID, IERR
2689 INTEGER, INTENT(INOUT) :: KEEP(500)
2690 INTEGER FUTURE_NIV2(NPROCS)
2691 DOUBLE PRECISION LU_USAGE
2692 DOUBLE PRECISION LOAD
2693 DOUBLE PRECISION MEM,SBTR_CUR
2694 LOGICAL BDC_MEM,BDC_SBTR,BDC_MD
2695 include 'mpif.h'
2696 include 'mumps_tags.h'
2697 INTEGER :: IERR_MPI
2698 INTEGER POSITION, IREQ, IPOS, SIZE1, SIZE2, SIZE
2699 INTEGER I, NDEST, IDEST, IPOSMSG, WHAT, NREALS
2700 INTEGER IZERO
2701 INTEGER MYID2(1)
2702 parameter( izero=0 )
2703 ierr = 0
2704 myid2(1) = myid
2705 ndest = nprocs - 1
2706 ndest = 0
2707 DO i = 1, nprocs
2708 IF ( i .NE. myid + 1 .AND. future_niv2(i).NE.0) THEN
2709 ndest = ndest + 1
2710 ENDIF
2711 ENDDO
2712 IF ( ndest .eq. 0 ) THEN
2713 RETURN
2714 ENDIF
2715 CALL mpi_pack_size( 1 + (ndest-1) * ovhsize,
2716 & mpi_integer, comm,
2717 & size1, ierr_mpi )
2718 nreals = 1
2719 IF (bdc_mem) THEN
2720 nreals = 2
2721 ENDIf
2722 IF (bdc_sbtr)THEN
2723 nreals = 3
2724 ENDIF
2725 IF(bdc_md)THEN
2726 nreals=nreals+1
2727 ENDIF
2728 CALL mpi_pack_size( nreals, mpi_double_precision,
2729 & comm, size2, ierr_mpi )
2730 SIZE = size1 + size2
2731 CALL buf_look( buf_load, ipos, ireq, SIZE, ierr,
2732 & izero, myid2
2733 & )
2734 IF ( ierr .LT. 0 ) THEN
2735 RETURN
2736 ENDIF
2737 buf_load%ILASTMSG = buf_load%ILASTMSG + ( ndest - 1 ) * ovhsize
2738 ipos = ipos - ovhsize
2739 DO idest = 1, ndest - 1
2740 buf_load%CONTENT( ipos + ( idest - 1 ) * ovhsize ) =
2741 & ipos + idest * ovhsize
2742 END DO
2743 buf_load%CONTENT( ipos + ( ndest - 1 ) * ovhsize ) = 0
2744 iposmsg = ipos + ovhsize * ndest
2745 what = 0
2746 position = 0
2747 CALL mpi_pack( what, 1, mpi_integer,
2748 & buf_load%CONTENT( iposmsg ), SIZE,
2749 & position, comm, ierr_mpi )
2750 CALL mpi_pack( load, 1, mpi_double_precision,
2751 & buf_load%CONTENT( iposmsg ), SIZE,
2752 & position, comm, ierr_mpi )
2753 IF (bdc_mem) THEN
2754 CALL mpi_pack( mem, 1, mpi_double_precision,
2755 & buf_load%CONTENT( iposmsg ), SIZE,
2756 & position, comm, ierr_mpi )
2757 END IF
2758 IF (bdc_sbtr) THEN
2759 CALL mpi_pack( sbtr_cur, 1, mpi_double_precision,
2760 & buf_load%CONTENT( iposmsg ), SIZE,
2761 & position, comm, ierr_mpi )
2762 END IF
2763 IF(bdc_md)THEN
2764 CALL mpi_pack( lu_usage, 1, mpi_double_precision,
2765 & buf_load%CONTENT( iposmsg ), SIZE,
2766 & position, comm, ierr_mpi )
2767 ENDIF
2768 idest = 0
2769 DO i = 0, nprocs - 1
2770 IF ( i .NE. myid .AND. future_niv2(i+1) .NE. 0) THEN
2771 idest = idest + 1
2772 keep(267)=keep(267)+1
2773 CALL mpi_isend( buf_load%CONTENT( iposmsg ),
2774 & position, mpi_packed, i,
2775 & update_load, comm,
2776 & buf_load%CONTENT( ireq+(idest-1)*ovhsize ),
2777 & ierr_mpi )
2778 END IF
2779 END DO
2780 SIZE = SIZE - ( ndest - 1 ) * ovhsize * sizeofint
2781 IF ( SIZE .LT. position ) THEN
2782 WRITE(*,*) ' Error in ZMUMPS_BUF_SEND_UPDATE_LOAD'
2783 WRITE(*,*) ' Size,position=',SIZE,position
2784 CALL mumps_abort()
2785 END IF
2786 IF ( SIZE .NE. position )
2787 & CALL buf_adjust( buf_load, position )
2788 RETURN

◆ zmumps_buf_send_vcb()

subroutine, public zmumps_buf::zmumps_buf_send_vcb ( integer nrhs_b,
integer node1,
integer node2,
integer ncb,
integer ldw,
integer long,
integer, dimension( max( 1, long ) ) iw,
complex(kind=8), dimension( max( 1, ldw * nrhs_b ) ) w,
integer jbdeb,
integer jbfin,
complex(kind=8), dimension(lrhscomp,nrhs) rhscomp,
integer, intent(in) nrhs,
integer, intent(in) lrhscomp,
integer, intent(in) iposinrhscomp,
integer, intent(in) npiv,
integer, dimension(500), intent(inout) keep,
integer dest,
integer tag,
integer comm,
integer ierr )

Definition at line 499 of file zmumps_comm_buffer.F.

505 IMPLICIT NONE
506 INTEGER LDW, DEST, TAG, COMM, IERR
507 INTEGER NRHS_B, NODE1, NODE2, NCB, LONG, JBDEB, JBFIN
508 INTEGER IW( max( 1, LONG ) )
509 INTEGER, INTENT(IN) :: LRHSCOMP, NRHS, IPOSINRHSCOMP, NPIV
510 COMPLEX(kind=8) W( max( 1, LDW * NRHS_B ) )
511 COMPLEX(kind=8) RHSCOMP(LRHSCOMP,NRHS)
512 INTEGER, INTENT(INOUT) :: KEEP(500)
513 include 'mpif.h'
514 INTEGER :: IERR_MPI
515 INTEGER POSITION, IREQ, IPOS
516 INTEGER SIZE1, SIZE2, SIZE, K
517 INTEGER IONE
518 INTEGER DEST2(1)
519 parameter( ione=1 )
520 dest2(1)=dest
521 ierr = 0
522 IF ( node2 .EQ. 0 ) THEN
523 CALL mpi_pack_size( 4+long, mpi_integer, comm, size1,
524 & ierr_mpi )
525 ELSE
526 CALL mpi_pack_size( 6+long, mpi_integer, comm, size1,
527 & ierr_mpi )
528 END IF
529 size2 = 0
530 IF ( long .GT. 0 ) THEN
531 CALL mpi_pack_size( nrhs_b*long, mpi_double_complex,
532 & comm, size2, ierr_mpi )
533 END IF
534 SIZE = size1 + size2
535 CALL buf_look( buf_cb, ipos, ireq, SIZE, ierr,
536 & ione , dest2
537 & )
538 IF ( ierr .LT. 0 ) THEN
539 RETURN
540 ENDIF
541 position = 0
542 CALL mpi_pack( node1, 1, mpi_integer,
543 & buf_cb%CONTENT( ipos ), SIZE,
544 & position, comm, ierr_mpi )
545 IF ( node2 .NE. 0 ) THEN
546 CALL mpi_pack( node2, 1, mpi_integer,
547 & buf_cb%CONTENT( ipos ), SIZE,
548 & position, comm, ierr_mpi )
549 CALL mpi_pack( ncb, 1, mpi_integer,
550 & buf_cb%CONTENT( ipos ), SIZE,
551 & position, comm, ierr_mpi )
552 ENDIF
553 CALL mpi_pack( jbdeb, 1, mpi_integer,
554 & buf_cb%CONTENT( ipos ), SIZE,
555 & position, comm, ierr_mpi )
556 CALL mpi_pack( jbfin, 1, mpi_integer,
557 & buf_cb%CONTENT( ipos ), SIZE,
558 & position, comm, ierr_mpi )
559 CALL mpi_pack( long, 1, mpi_integer,
560 & buf_cb%CONTENT( ipos ), SIZE,
561 & position, comm, ierr_mpi )
562 IF ( long .GT. 0 ) THEN
563 CALL mpi_pack( iw, long, mpi_integer,
564 & buf_cb%CONTENT( ipos ), SIZE,
565 & position, comm, ierr_mpi )
566 IF (node2.EQ.0) THEN
567 DO k=1, nrhs_b
568 IF (npiv.GT.0) THEN
569 CALL mpi_pack( rhscomp(iposinrhscomp,jbdeb+k-1), npiv,
570 & mpi_double_complex,
571 & buf_cb%CONTENT( ipos ), SIZE,
572 & position, comm, ierr_mpi )
573 ENDIF
574 IF (long-npiv .NE.0) THEN
575 CALL mpi_pack( w(npiv+1+(k-1)*ldw), long-npiv,
576 & mpi_double_complex,
577 & buf_cb%CONTENT( ipos ), SIZE,
578 & position, comm, ierr_mpi )
579 ENDIF
580 END DO
581 ELSE
582 DO k=1, nrhs_b
583 CALL mpi_pack( w(1+(k-1)*ldw), long, mpi_double_complex,
584 & buf_cb%CONTENT( ipos ), SIZE,
585 & position, comm, ierr_mpi )
586 END DO
587 ENDIF
588 END IF
589 keep(266)=keep(266)+1
590 CALL mpi_isend( buf_cb%CONTENT( ipos ), position, mpi_packed,
591 & dest, tag, comm, buf_cb%CONTENT( ireq ),
592 & ierr_mpi )
593 IF ( SIZE .NE. position ) CALL buf_adjust( buf_cb, position )
594 RETURN

◆ zmumps_buf_size_available()

subroutine zmumps_buf::zmumps_buf_size_available ( type ( zmumps_comm_buffer_type ) b,
integer size_av )
private

Definition at line 656 of file zmumps_comm_buffer.F.

657 IMPLICIT NONE
658 TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: B
659 INTEGER SIZE_AV
660 include 'mpif.h'
661 INTEGER :: IERR_MPI
662 INTEGER :: STATUS(MPI_STATUS_SIZE)
663 LOGICAL :: FLAG
664 IF ( b%HEAD .NE. b%TAIL ) THEN
665 10 CONTINUE
666 CALL mpi_test( b%CONTENT( b%HEAD + req ), flag, status,
667 & ierr_mpi )
668 IF ( flag ) THEN
669 b%HEAD = b%CONTENT( b%HEAD + next )
670 IF ( b%HEAD .EQ. 0 ) b%HEAD = b%TAIL
671 IF ( b%HEAD .NE. b%TAIL ) GOTO 10
672 END IF
673 END IF
674 IF ( b%HEAD .EQ. b%TAIL ) THEN
675 b%HEAD = 1
676 b%TAIL = 1
677 b%ILASTMSG = 1
678 END IF
679 IF ( b%HEAD .LE. b%TAIL ) THEN
680 size_av = max( b%LBUF_INT - b%TAIL, b%HEAD - 2 )
681 ELSE
682 size_av = b%HEAD - b%TAIL - 1
683 END IF
684 size_av = min(size_av - ovhsize, size_av)
685 size_av = size_av * sizeofint
686 RETURN

◆ zmumps_buf_test()

subroutine, public zmumps_buf::zmumps_buf_test

Definition at line 688 of file zmumps_comm_buffer.F.

689 INTEGER :: IPOS, IREQ, IERR
690 INTEGER, PARAMETER :: IONE=1
691 INTEGER :: MSG_SIZE
692 INTEGER :: DEST2(1)
693 dest2=-10
694 msg_size=1
695 CALL buf_look( buf_cb, ipos, ireq, msg_size, ierr,
696 & ione , dest2,.true.)
697 RETURN

◆ zmumps_buf_try_free()

subroutine zmumps_buf::zmumps_buf_try_free ( type ( zmumps_comm_buffer_type ) b)
private

Definition at line 59 of file zmumps_comm_buffer.F.

60 IMPLICIT NONE
61 TYPE ( ZMUMPS_COMM_BUFFER_TYPE ) :: B
62 include 'mpif.h'
63 LOGICAL :: FLAG
64 INTEGER :: IERR_MPI
65 INTEGER :: STATUS(MPI_STATUS_SIZE)
66 IF ( b%HEAD .NE. b%TAIL ) THEN
67 10 CONTINUE
68 CALL mpi_test( b%CONTENT( b%HEAD + req ), flag,
69 & status, ierr_mpi )
70 IF ( flag ) THEN
71 b%HEAD = b%CONTENT( b%HEAD + next )
72 IF ( b%HEAD .EQ. 0 ) b%HEAD = b%TAIL
73 IF ( b%HEAD .NE. b%TAIL ) GOTO 10
74 END IF
75 END IF
76 IF ( b%HEAD .EQ. b%TAIL ) THEN
77 b%HEAD = 1
78 b%TAIL = 1
79 b%ILASTMSG = 1
80 END iF
81 RETURN

◆ zmumps_buf_try_free_cb()

subroutine, public zmumps_buf::zmumps_buf_try_free_cb

Definition at line 55 of file zmumps_comm_buffer.F.

56 CALL zmumps_buf_try_free(buf_cb)
57 RETURN

◆ zmumps_mpi_pack_lr()

subroutine zmumps_buf::zmumps_mpi_pack_lr ( type (lrb_type), dimension(:), intent(in) blr_loru,
integer, dimension(:), intent(inout) buf,
integer, intent(in) lbuf,
integer, intent(inout) position,
integer, intent(in) comm,
integer, intent(out) ierr )
private

Definition at line 3197 of file zmumps_comm_buffer.F.

3199 USE zmumps_lr_type
3200 INTEGER, intent(out) :: IERR
3201 INTEGER, intent(in) :: COMM, LBUF
3202 INTEGER, intent(inout) :: POSITION
3203 INTEGER, intent(inout) :: BUF(:)
3204 TYPE (LRB_TYPE), DIMENSION(:), intent(in) :: BLR_LorU
3205 INTEGER I
3206 INTEGER :: IERR_MPI
3207 include 'mpif.h'
3208 ierr = 0
3209 CALL mpi_pack( size(blr_loru), 1, mpi_integer,
3210 & buf(1), lbuf, position, comm, ierr_mpi )
3211 DO i = 1, size(blr_loru)
3212 CALL zmumps_mpi_pack_lrb(blr_loru(i), buf, lbuf, position,
3213 & comm, ierr
3214 & )
3215 ENDDO
3216 RETURN

◆ zmumps_mpi_pack_lrb()

subroutine, public zmumps_buf::zmumps_mpi_pack_lrb ( type (lrb_type), intent(in) lrb,
integer, dimension(:), intent(inout) buf,
integer, intent(in) lbuf,
integer, intent(inout) position,
integer, intent(in) comm,
integer, intent(out) ierr )

Definition at line 3218 of file zmumps_comm_buffer.F.

3221 USE zmumps_lr_type
3222 INTEGER, intent(out) :: IERR
3223 INTEGER, intent(in) :: COMM, LBUF
3224 INTEGER, intent(inout) :: POSITION
3225 INTEGER, intent(inout) :: BUF(:)
3226 TYPE (LRB_TYPE), intent(in) :: LRB
3227 INTEGER ISLR_INT
3228 INTEGER :: IERR_MPI
3229 include 'mpif.h'
3230 ierr = 0
3231 IF (lrb%ISLR) THEN
3232 islr_int = 1
3233 ELSE
3234 islr_int = 0
3235 ENDIF
3236 CALL mpi_pack( islr_int, 1, mpi_integer,
3237 & buf(1), lbuf, position, comm, ierr_mpi )
3238 CALL mpi_pack( lrb%K,
3239 & 1, mpi_integer,
3240 & buf(1), lbuf, position, comm, ierr_mpi )
3241 CALL mpi_pack( lrb%M,
3242 & 1, mpi_integer,
3243 & buf(1), lbuf, position, comm, ierr_mpi )
3244 CALL mpi_pack( lrb%N,
3245 & 1, mpi_integer,
3246 & buf(1), lbuf, position, comm, ierr_mpi )
3247 IF (lrb%ISLR) THEN
3248 IF (lrb%K .GT. 0) THEN
3249 CALL mpi_pack( lrb%Q(1,1),
3250 & lrb%M*lrb%K, mpi_double_complex,
3251 & buf(1), lbuf, position, comm, ierr_mpi )
3252 CALL mpi_pack( lrb%R(1,1),
3253 & lrb%N*lrb%K, mpi_double_complex,
3254 & buf(1), lbuf, position, comm, ierr_mpi )
3255 ENDIF
3256 ELSE
3257 CALL mpi_pack( lrb%Q(1,1), lrb%M*lrb%N
3258 & ,mpi_double_complex,
3259 & buf(1), lbuf, position, comm, ierr_mpi )
3260 ENDIF
3261 RETURN

◆ zmumps_mpi_unpack_lrb()

subroutine, public zmumps_buf::zmumps_mpi_unpack_lrb ( integer, dimension(lbufr), intent(in) bufr,
integer, intent(in) lbufr,
integer, intent(in) lbufr_bytes,
integer, intent(inout) position,
type (lrb_type), intent(out) lrb,
integer(8), dimension(150) keep8,
integer, intent(in) comm,
integer, intent(inout) iflag,
integer, intent(inout) ierror )

Definition at line 3263 of file zmumps_comm_buffer.F.

3268 USE zmumps_lr_core, ONLY : alloc_lrb
3269 USE zmumps_lr_type
3270 IMPLICIT NONE
3271 INTEGER, INTENT(IN) :: LBUFR
3272 INTEGER, INTENT(IN) :: LBUFR_BYTES
3273 INTEGER, INTENT(IN) :: BUFR(LBUFR)
3274 INTEGER, INTENT(INOUT) :: POSITION
3275 INTEGER, INTENT(IN) :: COMM
3276 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
3277 TYPE (LRB_TYPE), INTENT(OUT) :: LRB
3278 INTEGER(8) :: KEEP8(150)
3279 LOGICAL :: ISLR
3280 INTEGER :: ISLR_INT
3281 INTEGER :: K, M, N
3282 INTEGER :: IERR_MPI
3283 include 'mpif.h'
3284 include 'mumps_tags.h'
3285 CALL mpi_unpack( bufr, lbufr_bytes, position,
3286 & islr_int, 1, mpi_integer, comm, ierr_mpi )
3287 CALL mpi_unpack( bufr, lbufr_bytes, position,
3288 & k, 1,
3289 & mpi_integer, comm, ierr_mpi )
3290 CALL mpi_unpack( bufr, lbufr_bytes, position,
3291 & m, 1,
3292 & mpi_integer, comm, ierr_mpi )
3293 CALL mpi_unpack( bufr, lbufr_bytes, position,
3294 & n, 1,
3295 & mpi_integer, comm, ierr_mpi )
3296 IF (islr_int .eq. 1) THEN
3297 islr = .true.
3298 ELSE
3299 islr = .false.
3300 ENDIF
3301 CALL alloc_lrb( lrb, k, m, n, islr,
3302 & iflag, ierror, keep8 )
3303 IF (iflag.LT.0) RETURN
3304 IF (islr) THEN
3305 IF (k .GT. 0) THEN
3306 CALL mpi_unpack( bufr, lbufr_bytes, position,
3307 & lrb%Q(1,1), m*k, mpi_double_complex,
3308 & comm, ierr_mpi )
3309 CALL mpi_unpack( bufr, lbufr_bytes, position,
3310 & lrb%R(1,1), n*k, mpi_double_complex,
3311 & comm, ierr_mpi )
3312 ENDIF
3313 ELSE
3314 CALL mpi_unpack( bufr, lbufr_bytes, position,
3315 & lrb%Q(1,1), m*n, mpi_double_complex,
3316 & comm, ierr_mpi )
3317 ENDIF
3318 RETURN
mpi_unpack
subroutine mpi_unpack(inbuf, insize, position, outbuf, outcnt, datatype, comm, ierr)
Definition mpi.f:514
zmumps_lr_core
Definition zlr_core.F:18
zmumps_lr_core::alloc_lrb
subroutine alloc_lrb(lrb_out, k, m, n, islr, iflag, ierror, keep8)
Definition zlr_core.F:111

Variable Documentation

◆ buf_cb

type ( zmumps_comm_buffer_type ), save zmumps_buf::buf_cb

Definition at line 46 of file zmumps_comm_buffer.F.

46 TYPE ( ZMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_CB

◆ buf_lmax_array

integer, save, public zmumps_buf::buf_lmax_array

Definition at line 50 of file zmumps_comm_buffer.F.

50 INTEGER, SAVE :: BUF_LMAX_ARRAY

◆ buf_load

type ( zmumps_comm_buffer_type ), save zmumps_buf::buf_load
private

Definition at line 48 of file zmumps_comm_buffer.F.

48 TYPE ( ZMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_LOAD

◆ buf_max_array

double precision, dimension(:), allocatable, target, save, public zmumps_buf::buf_max_array

Definition at line 51 of file zmumps_comm_buffer.F.

51 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE
52 & , SAVE, TARGET :: BUF_MAX_ARRAY

◆ buf_myid

integer, save zmumps_buf::buf_myid
private

Definition at line 41 of file zmumps_comm_buffer.F.

◆ buf_small

type ( zmumps_comm_buffer_type ), save zmumps_buf::buf_small
private

Definition at line 47 of file zmumps_comm_buffer.F.

47 TYPE ( ZMUMPS_COMM_BUFFER_TYPE ), SAVE :: BUF_SMALL

◆ content

integer zmumps_buf::content
private

Definition at line 39 of file zmumps_comm_buffer.F.

◆ next

integer zmumps_buf::next
private

Definition at line 39 of file zmumps_comm_buffer.F.

39 INTEGER NEXT, REQ, CONTENT, OVHSIZE

◆ ovhsize

integer zmumps_buf::ovhsize
private

Definition at line 39 of file zmumps_comm_buffer.F.

◆ req

integer zmumps_buf::req
private

Definition at line 39 of file zmumps_comm_buffer.F.

◆ size_rbuf_bytes

integer, save zmumps_buf::size_rbuf_bytes
private

Definition at line 49 of file zmumps_comm_buffer.F.

49 INTEGER, SAVE :: SIZE_RBUF_BYTES

◆ sizeofint

integer, save zmumps_buf::sizeofint
private

Definition at line 41 of file zmumps_comm_buffer.F.

41 INTEGER, SAVE :: SIZEofINT, SIZEofREAL, BUF_MYID

◆ sizeofreal

integer, save zmumps_buf::sizeofreal
private

Definition at line 41 of file zmumps_comm_buffer.F.