sbcast_int.F

Go to the documentation of this file.

C
C  This file is part of MUMPS 5.5.1, released
C  on Tue Jul 12 13:17:24 UTC 2022
C
C
C  Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  Mumps Technologies, University of Bordeaux.
C
C  This version of MUMPS is provided to you free of charge. It is
C  released under the CeCILL-C license 
C  (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
C  https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
C
      SUBROUTINE smumps_mcast2(DATA, LDATA, MPITYPE, ROOT, COMMW, TAG,
     &SLAVEF, KEEP)
      USE smumps_buf
      IMPLICIT NONE
      include 'mpif.h'
      INTEGER IERR
      INTEGER LDATA, ROOT, COMMW, TAG, MPITYPE, SLAVEF
      INTEGER DEST
      INTEGER, INTENT(INOUT) :: KEEP(500)
      INTEGER DATA(LDATA)
      DO 10 dest = 0, slavef - 1
        IF (dest .NE. root) THEN
          IF ( ldata .EQ. 1 .and. mpitype .EQ. mpi_integer ) THEN
            CALL smumps_buf_send_1int( DATA(1), dest, tag, 
     &                                commw, keep, ierr )
          ELSE
            WRITE(*,*) 'Error : bad argument to SMUMPS_MCAST2'
            CALL mumps_abort()
          END IF
        ENDIF
   10 CONTINUE
      RETURN
      END SUBROUTINE smumps_mcast2
      SUBROUTINE smumps_bdc_error( MYID, SLAVEF, COMM, KEEP )
      INTEGER MYID, SLAVEF, COMM
      INTEGER, INTENT(INOUT) :: KEEP(500)
      include 'mpif.h'
      include 'mumps_tags.h'
      INTEGER DUMMY (1)
      dummy(1) = -98765
      CALL smumps_mcast2( dummy, 1, mpi_integer, myid,
     &                 comm, terreur, slavef, keep )
      RETURN
      END SUBROUTINE smumps_bdc_error