Functions/Subroutines
subroutine	smumps_createpartvec (myid, numprocs, comm, irn_loc, jcn_loc, nz_loc, ipartvec, isz, osz, iwrk, iwsz)
subroutine	smumps_findnummyrowcol (myid, numprocs, comm, irn_loc, jcn_loc, nz_loc, rowpartvec, colpartvec, m, n, inummyr, inummyc, iwrk, iwsz)
subroutine	smumps_fillmyrowcolindices (myid, numprocs, comm, irn_loc, jcn_loc, nz_loc, rowpartvec, colpartvec, m, n, myrowindices, inummyr, mycolindices, inummyc, iwrk, iwsz)
integer function	smumps_chk1loc (d, dsz, indx, indxsz, eps)
integer function	smumps_chk1conv (d, dsz, eps)
integer function	smumps_chkconvglo (dr, m, indxr, indxrsz, dc, n, indxc, indxcsz, eps, comm)
real function	smumps_errscaloc (d, tmpd, dsz, indx, indxsz)
real function	smumps_errsca1 (d, tmpd, dsz)
subroutine	smumps_updatescale (d, tmpd, dsz, indx, indxsz)
subroutine	smumps_upscale1 (d, tmpd, dsz)
subroutine	smumps_initreallst (d, dsz, indx, indxsz, val)
subroutine	smumps_invlist (d, dsz, indx, indxsz)
subroutine	smumps_initreal (d, dsz, val)
subroutine	smumps_zeroout (tmpd, tmpsz, indx, indxsz)
subroutine	smumps_bureduce (inv, inoutv, len, dtype)
subroutine	smumps_ibuinit (iw, iwsz, ival)
subroutine	smumps_numvolsndrcv (myid, numprocs, isz, ipartvec, nz_loc, indx, osz, oindx, isndrcvnum, isndrcvvol, osndrcvnum, osndrcvvol, iwrk, iwrksz, sndsz, rcvsz, comm)
subroutine	smumps_setupcomms (myid, numprocs, isz, ipartvec, nz_loc, indx, osz, oindx, isndrcvnum, isndvol, inghbprcs, isndrcvia, isndrcvja, osndrcvnum, osndvol, onghbprcs, osndrcvia, osndrcvja, sndsz, rcvsz, iwrk, istatus, requests, itagcomm, comm)
subroutine	smumps_docomminf (myid, numprocs, tmpd, idsz, itagcomm, isndrcvnum, inghbprcs, isndrcvvol, isndrcvia, isndrcvja, isndrcva, osndrcvnum, onghbprcs, osndrcvvol, osndrcvia, osndrcvja, osndrcva, istatus, requests, comm)
subroutine	smumps_docomm1n (myid, numprocs, tmpd, idsz, itagcomm, isndrcvnum, inghbprcs, isndrcvvol, isndrcvia, isndrcvja, isndrcva, osndrcvnum, onghbprcs, osndrcvvol, osndrcvia, osndrcvja, osndrcva, istatus, requests, comm)
subroutine	smumps_createpartvecsym (myid, numprocs, comm, irn_loc, jcn_loc, nz_loc, ipartvec, isz, iwrk, iwsz)
subroutine	smumps_numvolsndrcvsym (myid, numprocs, isz, ipartvec, nz_loc, indx, oindx, isndrcvnum, isndrcvvol, osndrcvnum, osndrcvvol, iwrk, iwrksz, sndsz, rcvsz, comm)
subroutine	smumps_findnummyrowcolsym (myid, numprocs, comm, irn_loc, jcn_loc, nz_loc, partvec, n, inummyr, iwrk, iwsz)
integer function	smumps_chkconvglosym (d, n, indxr, indxrsz, eps, comm)
subroutine	smumps_fillmyrowcolindicessym (myid, numprocs, comm, irn_loc, jcn_loc, nz_loc, partvec, n, myrowindices, inummyr, iwrk, iwsz)
subroutine	smumps_setupcommssym (myid, numprocs, isz, ipartvec, nz_loc, indx, oindx, isndrcvnum, isndvol, inghbprcs, isndrcvia, isndrcvja, osndrcvnum, osndvol, onghbprcs, osndrcvia, osndrcvja, sndsz, rcvsz, iwrk, istatus, requests, itagcomm, comm)

Function/Subroutine Documentation

◆ smumps_bureduce()

subroutine smumps_bureduce	(	integer, dimension(2*len)	inv,
		integer, dimension(2*len)	inoutv,
		integer	len,
		integer	dtype )

Definition at line 460 of file sfac_scalings_simScale_util.F.

C
C    Like MPI_MINLOC operation (with ties broken sometimes with min 
C                               and sometimes with max)
C     The objective is find for each entry row/col
C     the processor with largest number of entries in its row/col
C     When 2 procs have the same number of entries in the row/col
C     then
C         if this number of entries is odd we take the proc with largest id
C         if this number of entries is even we take the proc with smallest id
C     
      IMPLICIT NONE
#if defined(workaroundintelilp64mpi2integer) || defined(workaroundilp64mpicustomreduce)
      INTEGER(4) :: LEN
      INTEGER(4) :: INV(2*LEN) 
      INTEGER(4) :: INOUTV(2*LEN)
      INTEGER(4) :: DTYPE
#else
      INTEGER :: LEN
      INTEGER :: INV(2*LEN) 
      INTEGER :: INOUTV(2*LEN)
      INTEGER :: DTYPE
#endif
      INTEGER I
#if defined(WORKAROUNDINTELILP64MPI2INTEGER) || defined(WORKAROUNDILP64MPICUSTOMREDUCE)
      INTEGER(4) DIN, DINOUT, PIN, PINOUT
#else
      INTEGER DIN, DINOUT, PIN, PINOUT
#endif
      DO i=1,2*len-1,2
         din = inv(i)     ! nb of entries in row/col
         pin = inv(i+1)   ! proc number
C  DINOUT
         dinout = inoutv(i)
         pinout = inoutv(i+1)
         IF (dinout < din) THEN
            inoutv(i) = din
            inoutv(i+1) = pin
         ELSE IF (dinout == din) THEN
C           --INOUTV(I) = DIN
C           --even number I take smallest Process number (pin)
            IF ((mod(dinout,2).EQ.0).AND.(pin<pinout)) THEN
              inoutv(i+1) = pin
            ELSE IF ((mod(dinout,2).EQ.1).AND.(pin>pinout)) THEN
C           --odd number I take largest Process number (pin)
              inoutv(i+1) = pin
            ENDIF
         ENDIF
      ENDDO
      RETURN

◆ smumps_chk1conv()

integer function smumps_chk1conv	(	real, dimension(dsz)	d,
		integer	dsz,
		real	eps )

Definition at line 266 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER DSZ
      REAL D(DSZ)
      REAL EPS
C     LOCAL VARS
      INTEGER I
      REAL RONE
      parameter(rone=1.0e0)
      smumps_chk1conv = 1
      DO i=1, dsz
         IF (.NOT.( (d(i).LE.(rone+eps)).AND.
     &        ((rone-eps).LE.d(i)) )) THEN
            smumps_chk1conv = 0         
         ENDIF
      ENDDO
      RETURN

◆ smumps_chk1loc()

integer function smumps_chk1loc	(	real, dimension(dsz)	d,
		integer	dsz,
		integer, dimension(indxsz)	indx,
		integer	indxsz,
		real	eps )

Definition at line 246 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER DSZ, INDXSZ
      REAL D(DSZ)
      INTEGER INDX(INDXSZ)
      REAL EPS
C     LOCAL VARS
      INTEGER I, IID
      REAL RONE
      parameter(rone=1.0e0)
      smumps_chk1loc = 1
      DO i=1, indxsz
         iid = indx(i)
         IF (.NOT.( (d(iid).LE.(rone+eps)).AND.
     &        ((rone-eps).LE.d(iid)) )) THEN
            smumps_chk1loc = 0         
         ENDIF
      ENDDO
      RETURN

◆ smumps_chkconvglo()

integer function smumps_chkconvglo	(	real, dimension(m)	dr,
		integer	m,
		integer, dimension(indxrsz)	indxr,
		integer	indxrsz,
		real, dimension(n)	dc,
		integer	n,
		integer, dimension(indxcsz)	indxc,
		integer	indxcsz,
		real	eps,
		integer	comm )

Definition at line 287 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      include 'mpif.h'
      INTEGER M, N, INDXRSZ, INDXCSZ
      REAL DR(M), DC(N)
      INTEGER INDXR(INDXRSZ), INDXC(INDXCSZ)
      REAL EPS
      INTEGER COMM
      EXTERNAL smumps_chk1loc
      INTEGER  SMUMPS_CHK1LOC
      INTEGER GLORES, MYRESR, MYRESC, MYRES
      INTEGER IERR
      myresr =  smumps_chk1loc(dr, m, indxr, indxrsz, eps)
      myresc =  smumps_chk1loc(dc, n, indxc, indxcsz, eps)
      myres = myresr + myresc
      CALL mpi_allreduce(myres, glores, 1, mpi_integer,
     &     mpi_sum, comm, ierr)
      smumps_chkconvglo = glores
      RETURN

◆ smumps_chkconvglosym()

integer function smumps_chkconvglosym	(	real, dimension(n)	d,
		integer	n,
		integer, dimension(indxrsz)	indxr,
		integer	indxrsz,
		real	eps,
		integer	comm )

Definition at line 1152 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      include 'mpif.h'
      INTEGER N, INDXRSZ
      REAL D(N)
      INTEGER INDXR(INDXRSZ)
      REAL EPS
      INTEGER COMM
      EXTERNAL smumps_chk1loc
      INTEGER  SMUMPS_CHK1LOC
      INTEGER GLORES, MYRESR, MYRES
      INTEGER IERR
      myresr =  smumps_chk1loc(d, n, indxr, indxrsz, eps)
      myres = 2*myresr 
      CALL mpi_allreduce(myres, glores, 1, mpi_integer,
     &     mpi_sum, comm, ierr)
      smumps_chkconvglosym = glores
      RETURN

◆ smumps_createpartvec()

subroutine smumps_createpartvec	(	integer, intent(in)	myid,
		integer, intent(in)	numprocs,
		integer, intent(in)	comm,
		integer, dimension(nz_loc), intent(in)	irn_loc,
		integer, dimension(nz_loc), intent(in)	jcn_loc,
		integer(8), intent(in)	nz_loc,
		integer, dimension(isz), intent(out)	ipartvec,
		integer, intent(in)	isz,
		integer, intent(in)	osz,
		integer, dimension(iwsz), intent(out)	iwrk,
		integer, intent(in)	iwsz )

Definition at line 14 of file sfac_scalings_simScale_util.F.

C
      IMPLICIT NONE
      EXTERNAL smumps_bureduce
      INTEGER, INTENT(IN)    :: MYID, NUMPROCS, COMM
      INTEGER(8), INTENT(IN) :: NZ_loc 
      INTEGER, INTENT(IN)    :: IWSZ
      INTEGER, INTENT(IN)    :: ISZ, OSZ
      INTEGER, INTENT(IN)    :: IRN_loc(NZ_loc), JCN_loc(NZ_loc)
C  OUTPUT
C     IPARTVEC(I) = proc number with largest number of entries 
C                in row/col I
      INTEGER, INTENT(OUT) :: IPARTVEC(ISZ)
C
C  INTERNAL WORKING ARRAY
C     IWRK (1:2*ISZ) is initialized to couples (MYID, Nb of entries
C     on my proc and in row/col I) for I=1,ISZ
C     (2*ISZ+1: 4*ISZ) is then set to
C     the processor with largest number of entries in its row/col
C     and its value (that is copied back into IPARTVEC(I)
#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
      INTEGER(4), INTENT(OUT) :: IWRK(IWSZ)
#else
      INTEGER, INTENT(OUT) :: IWRK(IWSZ)
#endif
      include 'mpif.h'
C
C     LOCAL VARS
      INTEGER I
      INTEGER(8) :: I8
      INTEGER OP, IERROR
      INTEGER IR, IC
C
      IF(numprocs.NE.1) THEN
C     CHECK done outsize
C     IF(IWSZ < 4*ISZ) THEN
C     CHECK ENDS
         CALL mpi_op_create(smumps_bureduce, .true., op, ierror)
C     PERFORM THE REDUCTION
#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
        CALL smumps_ibuinit(iwrk, 4*isz, int(isz,4))
#else
        CALL smumps_ibuinit(iwrk, 4*isz, isz)
#endif
C     WE FIRST ZERO OUT  
         DO i=1,isz
            iwrk(2*i-1) = 0
            iwrk(2*i) = myid
         ENDDO
         DO i8=1_8,nz_loc
            ir = irn_loc(i8)
            ic = jcn_loc(i8)
            IF((ir.GE.1).AND.(ir.LE.isz).AND.
     &           (ic.GE.1).AND.(ic.LE.osz)) THEN
               iwrk(2*ir-1) = iwrk(2*ir-1) + 1
            ENDIF
         ENDDO
         CALL mpi_allreduce(iwrk(1), iwrk(1+2*isz), isz,
     &        mpi_2integer, op, comm, ierror)      
         DO i=1,isz
            ipartvec(i) = iwrk(2*i+2*isz)
         ENDDO
C     FREE THE OPERATOR
         CALL mpi_op_free(op, ierror)
      ELSE
         DO i=1,isz
            ipartvec(i) = 0
         ENDDO
      ENDIF
      RETURN

◆ smumps_createpartvecsym()

subroutine smumps_createpartvecsym	(	integer, intent(in)	myid,
		integer, intent(in)	numprocs,
		integer, intent(in)	comm,
		integer, dimension(nz_loc), intent(in)	irn_loc,
		integer, dimension(nz_loc), intent(in)	jcn_loc,
		integer(8)	nz_loc,
		integer, dimension(isz), intent(out)	ipartvec,
		integer, intent(in)	isz,
		integer, dimension(iwsz), intent(out)	iwrk,
		integer, intent(in)	iwsz )

Definition at line 930 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      EXTERNAL smumps_bureduce
      INTEGER, INTENT(IN) :: MYID, NUMPROCS, COMM
      INTEGER(8)          :: NZ_loc
      INTEGER, INTENT(IN) :: ISZ, IWSZ
      INTEGER, INTENT(IN) :: IRN_loc(NZ_loc), JCN_loc(NZ_loc)
C
C  OUTPUT
C     IPARTVEC(I) = proc number with largest number of entries 
C                in row/col I
      INTEGER, INTENT(OUT) :: IPARTVEC(ISZ)
C
C  INTERNAL WORKING ARRAY
C     IWRK (1:2*ISZ) is initialized to couples (MYID, Nb of entries
C     on my proc and in row/col I) for I=1,ISZ
C     (2*ISZ+1: 4*ISZ) is then set to
C     the processor with largest number of entries in its row/col
C     and its value (that is copied back into IPARTVEC(I)
#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
      INTEGER(4), INTENT(OUT) :: IWRK(IWSZ)
#else
      INTEGER, INTENT(OUT) :: IWRK(IWSZ)
#endif
      include 'mpif.h'
C
C     LOCAL VARS
      INTEGER I
      INTEGER(8) :: I8
      INTEGER OP, IERROR
      INTEGER IR, IC
C
      IF(numprocs.NE.1) THEN
C     CHECK done outsize
C     IF(IWSZ < 2*ISZ) THEN
C     CHECK ENDS
         CALL mpi_op_create(smumps_bureduce, .true., op, ierror)
C     PERFORM THE REDUCTION
#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
         CALL smumps_ibuinit(iwrk, 4*isz, int(isz,4))
#else
         CALL smumps_ibuinit(iwrk, 4*isz, isz)
#endif
         DO i=1,isz
            iwrk(2*i-1) = 0
            iwrk(2*i) = myid
         ENDDO
         DO i8=1_8,nz_loc
            ir = irn_loc(i8)
            ic = jcn_loc(i8)
            IF((ir.GE.1).AND.(ir.LE.isz).AND.
     &           (ic.GE.1).AND.(ic.LE.isz)) THEN
               iwrk(2*ir-1) = iwrk(2*ir-1) + 1
               iwrk(2*ic-1) = iwrk(2*ic-1) + 1
            ENDIF
         ENDDO
         CALL mpi_allreduce(iwrk(1), iwrk(1+2*isz), isz,
     &        mpi_2integer, op, comm, ierror)      
         DO i=1,isz
            ipartvec(i) = iwrk(2*i+2*isz)
         ENDDO
C     FREE THE OPERATOR
         CALL mpi_op_free(op, ierror)
      ELSE
         DO i=1,isz
            ipartvec(i) = 0
         ENDDO
      ENDIF
      RETURN

◆ smumps_docomm1n()

subroutine smumps_docomm1n	(	integer	myid,
		integer	numprocs,
		real, dimension(idsz)	tmpd,
		integer	idsz,
		integer	itagcomm,
		integer	isndrcvnum,
		integer, dimension(isndrcvnum)	inghbprcs,
		integer	isndrcvvol,
		integer, dimension(numprocs+1)	isndrcvia,
		integer, dimension(isndrcvvol)	isndrcvja,
		real, dimension(isndrcvvol)	isndrcva,
		integer	osndrcvnum,
		integer, dimension(osndrcvnum)	onghbprcs,
		integer	osndrcvvol,
		integer, dimension(numprocs+1)	osndrcvia,
		integer, dimension(osndrcvvol)	osndrcvja,
		real, dimension(osndrcvvol)	osndrcva,
		integer, dimension(mpi_status_size, max(isndrcvnum,osndrcvnum))	istatus,
		integer, dimension(max(isndrcvnum,osndrcvnum))	requests,
		integer	comm )

Definition at line 838 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      include 'mpif.h'
      INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM
      INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL
      REAL TMPD(IDSZ)
      INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM)
      INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL)
      REAL ISNDRCVA(ISNDRCVVOL)
      INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL)
      REAL OSNDRCVA(OSNDRCVVOL)
      INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM))
      INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM))
      INTEGER COMM, IERROR
C     LOCAL VARS
      INTEGER I, PID, OFFS, SZ, J, JS, JE, IID
      DO i=1,isndrcvnum
         pid = inghbprcs(i)
         offs = isndrcvia(pid)
         sz = isndrcvia(pid+1) -  isndrcvia(pid) 
         CALL mpi_irecv(isndrcva(offs), sz, 
     &        mpi_real, pid-1, 
     &        itagcomm,comm,requests(i), ierror)
      ENDDO
      DO i=1,osndrcvnum
         pid = onghbprcs(i)
         offs = osndrcvia(pid)
         sz = osndrcvia(pid+1) - osndrcvia(pid) 
         js = osndrcvia(pid) 
         je =  osndrcvia(pid+1) - 1
         DO j=js, je
            iid = osndrcvja(j)
            osndrcva(j) = tmpd(iid)
         ENDDO
         CALL mpi_send(osndrcva(offs), sz, mpi_real, pid-1,
     &        itagcomm, comm, ierror)
      ENDDO
      IF(isndrcvnum > 0) THEN
         CALL mpi_waitall(isndrcvnum, requests(1),istatus(1,1),ierror)
      ENDIF
C     FOLD INTO MY D
      DO i=1,isndrcvnum
         pid = inghbprcs(i)
         js = isndrcvia(pid)
         je = isndrcvia(pid+1)-1
         DO j=js,je
            iid = isndrcvja(j)
            tmpd(iid)  = tmpd(iid)+ isndrcva(j)
         ENDDO
      ENDDO
C     COMMUNICATE THE UPDATED ONES
      DO i=1,osndrcvnum
         pid = onghbprcs(i)
         offs = osndrcvia(pid)
         sz = osndrcvia(pid+1) -  osndrcvia(pid) 
         CALL mpi_irecv(osndrcva(offs), sz, 
     &        mpi_real, pid-1, 
     &        itagcomm+1,comm,requests(i), ierror)
      ENDDO
      DO i=1,isndrcvnum
         pid = inghbprcs(i)
         offs = isndrcvia(pid)
         sz = isndrcvia(pid+1)-isndrcvia(pid)
         js = isndrcvia(pid)
         je = isndrcvia(pid+1) -1
         DO j=js, je
            iid = isndrcvja(j)
            isndrcva(j) = tmpd(iid)
         ENDDO
         CALL mpi_send(isndrcva(offs), sz, mpi_real, pid-1,
     &        itagcomm+1, comm, ierror)
      ENDDO
      IF(osndrcvnum > 0) THEN
         CALL mpi_waitall(osndrcvnum, requests(1),istatus(1,1),ierror)
      ENDIF
      DO i=1,osndrcvnum
         pid = onghbprcs(i)
         js = osndrcvia(pid) 
         je = osndrcvia(pid+1) - 1
         DO j=js,je
            iid = osndrcvja(j)
            tmpd(iid)=osndrcva(j)
         ENDDO
      ENDDO
      RETURN

◆ smumps_docomminf()

subroutine smumps_docomminf	(	integer	myid,
		integer	numprocs,
		real, dimension(idsz)	tmpd,
		integer	idsz,
		integer	itagcomm,
		integer	isndrcvnum,
		integer, dimension(isndrcvnum)	inghbprcs,
		integer	isndrcvvol,
		integer, dimension(numprocs+1)	isndrcvia,
		integer, dimension(isndrcvvol)	isndrcvja,
		real, dimension(isndrcvvol)	isndrcva,
		integer	osndrcvnum,
		integer, dimension(osndrcvnum)	onghbprcs,
		integer	osndrcvvol,
		integer, dimension(numprocs+1)	osndrcvia,
		integer, dimension(osndrcvvol)	osndrcvja,
		real, dimension(osndrcvvol)	osndrcva,
		integer, dimension(mpi_status_size, max(isndrcvnum,osndrcvnum))	istatus,
		integer, dimension(max(isndrcvnum,osndrcvnum))	requests,
		integer	comm )

Definition at line 743 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      include 'mpif.h'
      INTEGER MYID, NUMPROCS, IDSZ, ITAGCOMM
      INTEGER ISNDRCVNUM,OSNDRCVNUM, ISNDRCVVOL, OSNDRCVVOL
      REAL TMPD(IDSZ)
      INTEGER INGHBPRCS(ISNDRCVNUM), ONGHBPRCS(OSNDRCVNUM)
      INTEGER ISNDRCVIA(NUMPROCS+1), ISNDRCVJA(ISNDRCVVOL)
      REAL ISNDRCVA(ISNDRCVVOL)
      INTEGER OSNDRCVIA(NUMPROCS+1), OSNDRCVJA(OSNDRCVVOL)
      REAL OSNDRCVA(OSNDRCVVOL)
      INTEGER ISTATUS(MPI_STATUS_SIZE, max(ISNDRCVNUM,OSNDRCVNUM))
      INTEGER REQUESTS(max(ISNDRCVNUM,OSNDRCVNUM))
      INTEGER COMM, IERROR
C     LOCAL VARS
      INTEGER I, PID, OFFS, SZ, J, JS, JE, IID
      DO i=1,isndrcvnum
         pid = inghbprcs(i)
         offs = isndrcvia(pid)
         sz = isndrcvia(pid+1) -  isndrcvia(pid) 
         CALL mpi_irecv(isndrcva(offs), sz, 
     &        mpi_real, pid-1, 
     &        itagcomm,comm,requests(i), ierror)
      ENDDO
      DO i=1,osndrcvnum
         pid = onghbprcs(i)
         offs = osndrcvia(pid)
         sz = osndrcvia(pid+1) - osndrcvia(pid) 
         js = osndrcvia(pid) 
         je =  osndrcvia(pid+1) - 1
         DO j=js, je
            iid = osndrcvja(j)
            osndrcva(j) = tmpd(iid)
         ENDDO
         CALL mpi_send(osndrcva(offs), sz, mpi_real, pid-1,
     &        itagcomm, comm, ierror)
      ENDDO
      IF(isndrcvnum > 0) THEN
         CALL mpi_waitall(isndrcvnum, requests(1),istatus(1,1),ierror)
      ENDIF
C     FOLD INTO MY D
      DO i=1,isndrcvnum
         pid = inghbprcs(i)
         js = isndrcvia(pid)
         je = isndrcvia(pid+1)-1
         DO j=js,je
            iid = isndrcvja(j)
            IF(tmpd(iid) < isndrcva(j)) tmpd(iid)= isndrcva(j)
         ENDDO
      ENDDO
C     COMMUNICATE THE UPDATED ONES
      DO i=1,osndrcvnum
         pid = onghbprcs(i)
         offs = osndrcvia(pid)
         sz = osndrcvia(pid+1) -  osndrcvia(pid) 
         CALL mpi_irecv(osndrcva(offs), sz, 
     &        mpi_real, pid-1, 
     &        itagcomm+1,comm,requests(i), ierror)
      ENDDO
      DO i=1,isndrcvnum
         pid = inghbprcs(i)
         offs = isndrcvia(pid)
         sz = isndrcvia(pid+1)-isndrcvia(pid)
         js = isndrcvia(pid)
         je = isndrcvia(pid+1) -1
         DO j=js, je
            iid = isndrcvja(j)
            isndrcva(j) = tmpd(iid)
         ENDDO
         CALL mpi_send(isndrcva(offs), sz, mpi_real, pid-1,
     &        itagcomm+1, comm, ierror)
      ENDDO
      IF(osndrcvnum > 0) THEN
         CALL mpi_waitall(osndrcvnum, requests(1),istatus(1,1),ierror)
      ENDIF
      DO i=1,osndrcvnum
         pid = onghbprcs(i)
         js = osndrcvia(pid) 
         je = osndrcvia(pid+1) - 1
         DO j=js,je
            iid = osndrcvja(j)
            tmpd(iid)=osndrcva(j)
         ENDDO
      ENDDO
      RETURN

◆ smumps_errsca1()

real function smumps_errsca1	(	real, dimension(dsz)	d,
		real, dimension(dsz)	tmpd,
		integer	dsz )

Definition at line 336 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE 
      INTEGER DSZ
      REAL D(DSZ)
      REAL TMPD(DSZ)
C     LOCAL VARS
      REAL RONE
      parameter(rone=1.0e0)
      INTEGER I
      REAL ERRMAX1
      INTRINSIC abs
      errmax1 = -rone
      DO i=1,dsz
         IF(abs(rone-tmpd(i)).GT.errmax1) THEN
            errmax1 = abs(rone-tmpd(i))
         ENDIF
      ENDDO
      smumps_errsca1 = errmax1
      RETURN

◆ smumps_errscaloc()

real function smumps_errscaloc	(	real, dimension(dsz)	d,
		real, dimension(dsz)	tmpd,
		integer	dsz,
		integer, dimension(indxsz)	indx,
		integer	indxsz )

Definition at line 311 of file sfac_scalings_simScale_util.F.

C     THE VAR D IS NOT USED IN COMPUTATIONS.
C     IT IS THERE FOR READIBLITY OF THE *simScaleAbs.F
      IMPLICIT NONE 
      INTEGER DSZ, INDXSZ
      REAL D(DSZ)
      REAL TMPD(DSZ)
      INTEGER INDX(INDXSZ)
C     LOCAL VARS
      REAL RONE
      parameter(rone=1.0e0)
      INTEGER I, IIND
      REAL ERRMAX
      INTRINSIC abs
      errmax = -rone
      DO i=1,indxsz
         iind = indx(i)
         IF(abs(rone-tmpd(iind)).GT.errmax) THEN
            errmax = abs(rone-tmpd(iind))
         ENDIF
      ENDDO           
      smumps_errscaloc = errmax
      RETURN

◆ smumps_fillmyrowcolindices()

subroutine smumps_fillmyrowcolindices	(	integer	myid,
		integer	numprocs,
		integer	comm,
		integer, dimension(nz_loc)	irn_loc,
		integer, dimension(nz_loc)	jcn_loc,
		integer(8)	nz_loc,
		integer, dimension(m)	rowpartvec,
		integer, dimension(n)	colpartvec,
		integer	m,
		integer	n,
		integer, dimension(inummyr)	myrowindices,
		integer	inummyr,
		integer, dimension(inummyc)	mycolindices,
		integer	inummyc,
		integer, dimension(iwsz)	iwrk,
		integer	iwsz )

Definition at line 170 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER(8) :: NZ_loc
      INTEGER MYID, NUMPROCS, M, N
      INTEGER INUMMYR, INUMMYC, IWSZ
      INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc)
      INTEGER ROWPARTVEC(M)
      INTEGER COLPARTVEC(N)
      INTEGER MYROWINDICES(INUMMYR)
      INTEGER MYCOLINDICES(INUMMYC)
      INTEGER IWRK(IWSZ)
      INTEGER COMM
C
      INTEGER I, IR, IC, ITMP, MAXMN
      INTEGER(8) :: I8
C      
      maxmn = m
      IF(n > maxmn) maxmn = n
C check done outsize
C      IF(IWSZ < MAXMN) THEN ERROR
C     MARK MY ROWS. 
      DO i=1,m
         iwrk(i) = 0
         IF(rowpartvec(i).EQ.myid) iwrk(i)=1
      ENDDO
      DO i8=1,nz_loc
         ir = irn_loc(i8)         
         ic = jcn_loc(i8)
         IF((ir.GE.1).AND.(ir.LE.m).AND.
     &      ((ic.GE.1).AND.(ic.LE.n))  ) THEN
            IF(iwrk(ir) .EQ. 0) iwrk(ir)= 1
         ENDIF
      ENDDO
C     PUT MY ROWS INTO MYROWINDICES
      itmp = 1
      DO i=1,m
         IF(iwrk(i).EQ.1) THEN
            myrowindices(itmp) = i
            itmp  = itmp + 1
         ENDIF
      ENDDO
C
C
C     DO THE SMAME THING FOR COLS
      DO i=1,n
         iwrk(i) = 0
         IF(colpartvec(i).EQ.myid) iwrk(i)= 1
      ENDDO
      DO i8=1,nz_loc
         ir = irn_loc(i8)         
         ic = jcn_loc(i8)
         IF((ir.GE.1).AND.(ir.LE.m).AND.
     &      ((ic.GE.1).AND.(ic.LE.n))  ) THEN
            IF(iwrk(ic) .EQ. 0) iwrk(ic)= 1
         ENDIF
      ENDDO
C     PUT MY ROWS INTO MYROWINDICES
      itmp = 1
      DO i=1,n
         IF(iwrk(i).EQ.1) THEN
            mycolindices(itmp) = i
            itmp  = itmp + 1
         ENDIF
      ENDDO
C
      RETURN

◆ smumps_fillmyrowcolindicessym()

subroutine smumps_fillmyrowcolindicessym	(	integer	myid,
		integer	numprocs,
		integer	comm,
		integer, dimension(nz_loc)	irn_loc,
		integer, dimension(nz_loc)	jcn_loc,
		integer(8)	nz_loc,
		integer, dimension(n)	partvec,
		integer	n,
		integer, dimension(inummyr)	myrowindices,
		integer	inummyr,
		integer, dimension(iwsz)	iwrk,
		integer	iwsz )

Definition at line 1172 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER MYID, NUMPROCS, N
      INTEGER(8) :: NZ_loc
      INTEGER INUMMYR, IWSZ
      INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc)
      INTEGER PARTVEC(N)
      INTEGER MYROWINDICES(INUMMYR)
      INTEGER IWRK(IWSZ)
      INTEGER COMM
C
      INTEGER I, IR, IC, ITMP, MAXMN
      INTEGER(8) :: I8
C      
      maxmn = n
C check done outsize
C      IF(IWSZ < MAXMN) THEN ERROR
C     MARK MY ROWS. 
      DO i=1,n
         iwrk(i) = 0
         IF(partvec(i).EQ.myid) iwrk(i)=1
      ENDDO
      DO i8=1_8,nz_loc
         ir = irn_loc(i8)   
         ic = jcn_loc(i8)
         IF((ir.GE.1).AND.(ir.LE.n).AND.
     &        ((ic.GE.1).AND.(ic.LE.n))) THEN
            IF(iwrk(ir) .EQ. 0) iwrk(ir)= 1
         ENDIF
         IF((ir.GE.1).AND.(ir.LE.n).AND.
     &        ((ic.GE.1).AND.(ic.LE.n))) THEN
            IF(iwrk(ic) .EQ.0) iwrk(ic)=1
         ENDIF
      ENDDO
C     PUT MY ROWS INTO MYROWINDICES
      itmp = 1
      DO i=1,n
         IF(iwrk(i).EQ.1) THEN
            myrowindices(itmp) = i
            itmp  = itmp + 1
         ENDIF
      ENDDO
C
C
C     THE SMAME THING APPLY TO COLS 
C
      RETURN

◆ smumps_findnummyrowcol()

subroutine smumps_findnummyrowcol	(	integer, intent(in)	myid,
		integer, intent(in)	numprocs,
		integer, intent(in)	comm,
		integer, dimension(nz_loc), intent(in)	irn_loc,
		integer, dimension(nz_loc), intent(in)	jcn_loc,
		integer(8), intent(in)	nz_loc,
		integer, dimension(m), intent(in)	rowpartvec,
		integer, dimension(n), intent(in)	colpartvec,
		integer, intent(in)	m,
		integer, intent(in)	n,
		integer	inummyr,
		integer	inummyc,
		integer, dimension(iwsz)	iwrk,
		integer, intent(in)	iwsz )

Definition at line 92 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER(8), INTENT(IN) :: NZ_loc
      INTEGER, INTENT(IN) :: MYID, NUMPROCS, M, N, IWSZ
      INTEGER, INTENT(IN) :: IRN_loc(NZ_loc), JCN_loc(NZ_loc)
C     [ROW/COL]PARTVEC(I) holds proc number with largest number of entries 
C                in row/col I
      INTEGER, INTENT(IN) :: ROWPARTVEC(M)
      INTEGER, INTENT(IN) :: COLPARTVEC(N)
      INTEGER, INTENT(IN) :: COMM
C
C  OUTPUT PARAMETERS
C     INUMMYR < M and INUMMYC < N  (CPA or <= ??)
C     INUMMYR holds the number of rows allocated to me 
C             or non empty on my proc
C     INUMMYC idem with columns
      INTEGER INUMMYR, INUMMYC
C
C  INTERNAL working array
      INTEGER IWRK(IWSZ)
C
C   Local variables
      INTEGER I, IR, IC
      INTEGER(8) ::  I8
C check done outsize     
C     IF(IWSZ < M) THEN ERROR
C     IF(IWSZ < N) THEN ERROR
      inummyr = 0
      inummyc = 0
C     MARK MY ROWS. FIRST COUNT,
C          IF DYNAMIC MEMORY ALLOCATIOn WILL USED
C     INUMMYR first counts number of rows affected to me
C             (that will be centralized on MYID)
      DO i=1,m
         iwrk(i) = 0
         IF(rowpartvec(i).EQ.myid) THEN
            iwrk(i)=1
            inummyr = inummyr + 1
         ENDIF
      ENDDO
      DO i8=1_8,nz_loc
         ir = irn_loc(i8)
         ic = jcn_loc(i8)
         IF((ir.GE.1).AND.(ir.LE.m).AND.
     &        ((ic.GE.1).AND.(ic.LE.n)) ) THEN
            IF(iwrk(ir) .EQ. 0) THEN
               iwrk(ir)= 1
               inummyr = inummyr + 1
            ENDIF
         ENDIF
      ENDDO
C     DO THE SMAME THING FOR COLS
      DO i=1,n
         iwrk(i) = 0
         IF(colpartvec(i).EQ.myid) THEN
            iwrk(i)= 1
            inummyc = inummyc + 1
         ENDIF
      ENDDO
      DO i8=1_8,nz_loc
         ic = jcn_loc(i8)
         ir = irn_loc(i8)
         IF((ir.GE.1).AND.(ir.LE.m).AND.
     &        ((ic.GE.1).AND.(ic.LE.n)) ) THEN
            IF(iwrk(ic) .EQ. 0) THEN
               iwrk(ic)= 1
               inummyc = inummyc + 1
            ENDIF
         ENDIF
      ENDDO
C
      RETURN

◆ smumps_findnummyrowcolsym()

subroutine smumps_findnummyrowcolsym	(	integer	myid,
		integer	numprocs,
		integer	comm,
		integer, dimension(nz_loc)	irn_loc,
		integer, dimension(nz_loc)	jcn_loc,
		integer(8)	nz_loc,
		integer, dimension(n)	partvec,
		integer	n,
		integer	inummyr,
		integer, dimension(iwsz)	iwrk,
		integer	iwsz )

Definition at line 1099 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER MYID, NUMPROCS, N
      INTEGER(8) :: NZ_loc
      INTEGER IRN_loc(NZ_loc), JCN_loc(NZ_loc)
      INTEGER PARTVEC(N)
      INTEGER INUMMYR
      INTEGER IWSZ
      INTEGER IWRK(IWSZ)
      INTEGER COMM
C
      INTEGER I, IR, IC
      INTEGER(8) :: I8
C check done outsize     
C     IF(IWSZ < M) THEN ERROR
C     IF(IWSZ < N) THEN ERROR
      inummyr = 0
C     MARK MY ROWS. FIRST COUNT,
C          IF DYNAMIC MEMORY ALLOCATIOn WILL USED
      DO i=1,n
         iwrk(i) = 0
         IF(partvec(i).EQ.myid) THEN
            iwrk(i)=1
            inummyr = inummyr + 1
         ENDIF
      ENDDO
      DO i8=1_8,nz_loc
         ir = irn_loc(i8)
         ic = jcn_loc(i8)
         IF((ir.GE.1).AND.(ir.LE.n).AND.
     &        ((ic.GE.1).AND.(ic.LE.n))) THEN
            IF(iwrk(ir) .EQ. 0) THEN
               iwrk(ir)= 1
               inummyr = inummyr + 1
            ENDIF
         ENDIF
         IF((ir.GE.1).AND.(ir.LE.n).AND.
     &        ((ic.GE.1).AND.(ic.LE.n))) THEN
            IF(iwrk(ic).EQ.0) THEN
               iwrk(ic)= 1
               inummyr = inummyr + 1
            ENDIF
         ENDIF
      ENDDO
C     THE SMAME THING APPLIES FOR COLS
C     No need to do anything
C
      RETURN

◆ smumps_ibuinit()

subroutine smumps_ibuinit	(	integer, dimension(iwsz)	iw,
		integer	iwsz,
		integer	ival )

Definition at line 514 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER IWSZ
#if defined(WORKAROUNDINTELILP64MPI2INTEGER)
      INTEGER(4) IW(IWSZ)
      INTEGER(4) IVAL
#else
      INTEGER IW(IWSZ)
      INTEGER IVAL
#endif
      INTEGER I
      DO i=1,iwsz
         iw(i)=ival
      ENDDO
      RETURN

◆ smumps_initreal()

subroutine smumps_initreal	(	real, dimension(dsz)	d,
		integer	dsz,
		real	val )

Definition at line 428 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER DSZ
      REAL D(DSZ)
      REAL VAL
C     LOCAL VARS
      INTEGER I
      DO i=1,dsz
         d(i) = val
      ENDDO
      RETURN

◆ smumps_initreallst()

subroutine smumps_initreallst	(	real, dimension(dsz)	d,
		integer	dsz,
		integer, dimension(indxsz)	indx,
		integer	indxsz,
		real	val )

Definition at line 395 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER DSZ, INDXSZ
      REAL D(DSZ)
      INTEGER INDX(INDXSZ)
      REAL VAL
C     LOCAL VARS
      INTEGER I, IIND
      DO i=1,indxsz
         iind = indx(i)
         d(iind) = val
      ENDDO
      RETURN

◆ smumps_invlist()

subroutine smumps_invlist	(	real, dimension(dsz)	d,
		integer	dsz,
		integer, dimension(indxsz)	indx,
		integer	indxsz )

Definition at line 412 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER DSZ, INDXSZ
      REAL D(DSZ)
      INTEGER INDX(INDXSZ)
C     LOCALS
      INTEGER I, IIND
      DO i=1,indxsz
         iind  = indx(i)
         d(iind) = 1.0e0/d(iind)
      ENDDO
      RETURN

◆ smumps_numvolsndrcv()

subroutine smumps_numvolsndrcv	(	integer, intent(in)	myid,
		integer, intent(in)	numprocs,
		integer, intent(in)	isz,
		integer, dimension(isz), intent(in)	ipartvec,
		integer(8), intent(in)	nz_loc,
		integer, dimension(nz_loc), intent(in)	indx,
		integer, intent(in)	osz,
		integer, dimension(nz_loc), intent(in)	oindx,
		integer, intent(out)	isndrcvnum,
		integer, intent(out)	isndrcvvol,
		integer, intent(out)	osndrcvnum,
		integer, intent(out)	osndrcvvol,
		integer, dimension(iwrksz)	iwrk,
		integer, intent(in)	iwrksz,
		integer, dimension(numprocs), intent(out)	sndsz,
		integer, dimension(numprocs), intent(out)	rcvsz,
		integer, intent(in)	comm )

Definition at line 536 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER(8), INTENT(IN) :: NZ_loc
      INTEGER, INTENT(IN)    :: IWRKSZ
      INTEGER, INTENT(IN) ::  MYID, NUMPROCS, ISZ, OSZ
      INTEGER, INTENT(IN) ::  COMM
C     When INDX holds row indices O(ther)INDX hold col indices
      INTEGER, INTENT(IN) :: INDX(NZ_loc)
      INTEGER, INTENT(IN) :: OINDX(NZ_loc)
C     On entry IPARTVEC(I) holds proc number with largest number of entries 
C                in row/col I
      INTEGER, INTENT(IN) :: IPARTVEC(ISZ)
C
C  OUTPUT PARAMETERS
C     SNDSZ (IPROC+1) is set to the number of rows (or col) that
C                     MYID will have to send to IPROC
C     RCVSZ(IPROC+1) is set to the nb of row/cols that
C                    MYID will receive from IPROC
      INTEGER, INTENT(OUT) :: SNDSZ(NUMPROCS)
      INTEGER, INTENT(OUT) :: RCVSZ(NUMPROCS)
C     OSNDRCVNUM is set to the total number of procs 
C                destination of messages from MYID (< NUMPROCS)
C     ISNDRCVNUM is set to the total number procs 
C                that will send messages to MYID  (< NUMPROCS)
C     ISNDRCVVOL is set to the total number of row/col that
C                MYID will have to send to other procs
C                (bounded by N)
C     OSNDRCVVOL  is set to the total number of row/col that
C                MYID will have to send to other procs
C                (bounded by N)
C        Knowing that for each row the process with the largest 
C        number of entries  will centralize all indices then
C        ISNDRCVVOL and OSNDRCVVOL are bounded by N
      INTEGER, INTENT(OUT) :: ISNDRCVNUM, OSNDRCVNUM   
      INTEGER, INTENT(OUT) :: ISNDRCVVOL, OSNDRCVVOL
C
C  INTERNAL WORKING ARRAY
      INTEGER IWRK(IWRKSZ)
      include 'mpif.h'
C     LOCAL VARS
      INTEGER I
      INTEGER(8) :: I8
      INTEGER IIND, IIND2, PIND
      INTEGER IERROR
C check done outsize
C      IF(ISZ>IWRKSZ) THEN ERROR
      DO i=1,numprocs
         sndsz(i) = 0
         rcvsz(i) = 0
      ENDDO
      DO i=1,iwrksz
         iwrk(i) = 0
      ENDDO
C
C     set SNDSZ
      DO i8=1,nz_loc
         iind = indx(i8)
         iind2 = oindx(i8)
         IF((iind.GE.1).AND.(iind.LE.isz).AND.
     &        (iind2.GE.1).AND.(iind2.LE.osz))THEN
            pind = ipartvec(iind)
            IF(pind .NE. myid) THEN
C              MYID will send row/col IIND to proc PIND 
C              (PIND has the largest nb of entries in row/con IIND
               IF(iwrk(iind).EQ.0) THEN
                  iwrk(iind) = 1
                  sndsz(pind+1) = sndsz(pind+1)+1
               ENDIF
            ENDIF
         ENDIF
      ENDDO
C
C     use SNDSZ to set RCVSZ
      CALL mpi_alltoall(sndsz, 1, mpi_integer,
     & rcvsz, 1, mpi_integer, comm, ierror)
C
C     compute number of procs destinations of messages from MYID 
C     number of row/col sent by MYID. 
      isndrcvnum = 0
      isndrcvvol = 0
      osndrcvnum = 0
      osndrcvvol = 0
      DO i=1, numprocs
         IF(sndsz(i) > 0) osndrcvnum = osndrcvnum + 1
         osndrcvvol = osndrcvvol + sndsz(i)
         IF(rcvsz(i) > 0) isndrcvnum = isndrcvnum + 1
         isndrcvvol = isndrcvvol + rcvsz(i)
      ENDDO
      RETURN

◆ smumps_numvolsndrcvsym()

subroutine smumps_numvolsndrcvsym	(	integer, intent(in)	myid,
		integer, intent(in)	numprocs,
		integer, intent(in)	isz,
		integer, dimension(isz), intent(in)	ipartvec,
		integer(8), intent(in)	nz_loc,
		integer, dimension(nz_loc), intent(in)	indx,
		integer, dimension(nz_loc), intent(in)	oindx,
		integer, intent(out)	isndrcvnum,
		integer, intent(out)	isndrcvvol,
		integer, intent(out)	osndrcvnum,
		integer, intent(out)	osndrcvvol,
		integer, dimension(iwrksz), intent(out)	iwrk,
		integer, intent(in)	iwrksz,
		integer, dimension(numprocs)	sndsz,
		integer, dimension(numprocs)	rcvsz,
		integer, intent(in)	comm )

Definition at line 1003 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER(8), INTENT(IN) :: NZ_loc 
      INTEGER, INTENT(IN)    :: IWRKSZ
      INTEGER, INTENT(IN)    :: MYID, NUMPROCS, ISZ
      INTEGER, INTENT(IN)    :: INDX(NZ_loc), OINDX(NZ_loc)
      INTEGER, INTENT(IN)    :: IPARTVEC(ISZ)
      INTEGER, INTENT(IN)    :: COMM
C
C  OUTPUT PARAMETERS
C     SNDSZ (IPROC+1) is set to the number of rows (or col) that
C                     MYID will have to send to IPROC
C     RCVSZ(IPROC+1) is set to the nb of row/cols that
C                    MYID will receive from IPROC
      INTEGER :: SNDSZ(NUMPROCS)
      INTEGER :: RCVSZ(NUMPROCS)
C     OSNDRCVNUM is set to the total number of procs 
C                destination of messages from MYID (< NUMPROCS)
C     ISNDRCVNUM is set to the total number procs 
C                that will send messages to MYID  (< NUMPROCS)
C     ISNDRCVVOL is set to the total number of row/col that
C                MYID will have to send to other procs
C                (bounded by N)
C     OSNDRCVVOL  is set to the total number of row/col that
C                MYID will have to send to other procs
C                (bounded by N)
C        Knowing that for each row the process with the largest 
C        number of entries  will centralize all indices then
C        ISNDRCVVOL and OSNDRCVVOL are bounded by N
      INTEGER, INTENT(OUT)   :: ISNDRCVNUM, ISNDRCVVOL
      INTEGER, INTENT(OUT)   :: OSNDRCVNUM, OSNDRCVVOL
C
C  INTERNAL WORKING ARRAY
      INTEGER, INTENT(OUT) :: IWRK(IWRKSZ)
      include 'mpif.h'
C     LOCAL VARS
      INTEGER I
      INTEGER(8) :: I8
      INTEGER IIND, IIND2, PIND
      INTEGER IERROR
C check done outsize
C      IF(ISZ>IWRKSZ) THEN ERROR
      DO i=1,numprocs
         sndsz(i) = 0
         rcvsz(i) = 0
      ENDDO
      DO i=1,iwrksz
         iwrk(i) = 0
      ENDDO
C
C     set SNDSZ
      DO i8=1_8,nz_loc
         iind = indx(i8)
         iind2 = oindx(i8)
         IF((iind.GE.1).AND.(iind.LE.isz).AND.(iind2.GE.1)
     &        .AND.(iind2.LE.isz)) THEN
            pind = ipartvec(iind)
            IF(pind .NE. myid) THEN
C              MYID will send row/col IIND to proc PIND 
C              (PIND has the largest nb of entries in row/con IIND
               IF(iwrk(iind).EQ.0) THEN
                  iwrk(iind) = 1
                  sndsz(pind+1) = sndsz(pind+1)+1
               ENDIF
            ENDIF
            iind = oindx(i8)
            pind = ipartvec(iind)
            IF(pind .NE. myid) THEN
               IF(iwrk(iind).EQ.0) THEN
                  iwrk(iind) = 1
                  sndsz(pind+1) = sndsz(pind+1)+1
               ENDIF
            ENDIF
         ENDIF
      ENDDO
C
C     use SNDSZ to set RCVSZ
      CALL mpi_alltoall(sndsz, 1, mpi_integer,
     &     rcvsz, 1, mpi_integer, comm, ierror)
C
C     compute number of procs destinations of messages from MYID 
C     number of row/col sent by MYID. 
      isndrcvnum = 0
      isndrcvvol = 0
      osndrcvnum = 0
      osndrcvvol = 0
      DO i=1, numprocs
         IF(sndsz(i) > 0) osndrcvnum = osndrcvnum + 1
         osndrcvvol = osndrcvvol + sndsz(i)
         IF(rcvsz(i) > 0) isndrcvnum = isndrcvnum + 1
         isndrcvvol = isndrcvvol + rcvsz(i)
      ENDDO
      RETURN

◆ smumps_setupcomms()

subroutine smumps_setupcomms	(	integer	myid,
		integer	numprocs,
		integer	isz,
		integer, dimension(isz)	ipartvec,
		integer(8)	nz_loc,
		integer, dimension(nz_loc)	indx,
		integer	osz,
		integer, dimension(nz_loc)	oindx,
		integer	isndrcvnum,
		integer	isndvol,
		integer, dimension(isndrcvnum)	inghbprcs,
		integer, dimension(numprocs+1)	isndrcvia,
		integer, dimension(isndvol)	isndrcvja,
		integer	osndrcvnum,
		integer	osndvol,
		integer, dimension(osndrcvnum)	onghbprcs,
		integer, dimension(numprocs+1)	osndrcvia,
		integer, dimension(osndvol)	osndrcvja,
		integer, dimension(numprocs)	sndsz,
		integer, dimension(numprocs)	rcvsz,
		integer, dimension(isz)	iwrk,
		integer, dimension(mpi_status_size, isndrcvnum)	istatus,
		integer, dimension(isndrcvnum)	requests,
		integer	itagcomm,
		integer	comm )

Definition at line 632 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      include 'mpif.h'
      INTEGER(8) :: NZ_loc  
      INTEGER ISNDVOL, OSNDVOL
      INTEGER MYID, NUMPROCS, ISZ, OSZ
C     ISZ is either M or N
      INTEGER INDX(NZ_loc)
      INTEGER OINDX(NZ_loc)
C     INDX is either IRN_loc or JCN_col
      INTEGER IPARTVEC(ISZ)
C     IPARTVEC is either rowpartvec or colpartvec
      INTEGER :: ISNDRCVNUM
      INTEGER INGHBPRCS(ISNDRCVNUM)
      INTEGER ISNDRCVIA(NUMPROCS+1)
      INTEGER ISNDRCVJA(ISNDVOL)
      INTEGER OSNDRCVNUM 
      INTEGER ONGHBPRCS(OSNDRCVNUM)
      INTEGER OSNDRCVIA(NUMPROCS+1)
      INTEGER OSNDRCVJA(OSNDVOL)
      INTEGER SNDSZ(NUMPROCS)
      INTEGER RCVSZ(NUMPROCS)
      INTEGER IWRK(ISZ)
      INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM)
      INTEGER REQUESTS(ISNDRCVNUM)
      INTEGER ITAGCOMM, COMM
C     LOCAL VARS
      INTEGER I, IIND, IIND2, IPID, OFFS 
      INTEGER IWHERETO, POFFS, ITMP, IERROR
      INTEGER(8) :: I8
C     COMPUATIONs START      
      DO i=1,isz
         iwrk(i) = 0
      ENDDO
C     INITIALIZE ONGHBPRCS using SNDSZ
C     INITIALIZE THE OSNDRCVIA using SNDSZ 
      offs = 1
      poffs = 1
      DO i=1,numprocs
         osndrcvia(i) = offs + sndsz(i)
         IF(sndsz(i) > 0) THEN
            onghbprcs(poffs)=i
            poffs = poffs + 1
         ENDIF         
         offs  = offs +  sndsz(i)
      ENDDO
      osndrcvia(numprocs+1) = offs
C     CHECK STARTS
C check done outsize
C      IF(POFFS .NE. OSNDRCVNUM + 1)THEN ERROR
C     INIT DONE. FILL UP THE OSNDRCVJA(OSNDVOL)
      DO i8=1,nz_loc
         iind  = indx(i8)
         iind2 = oindx(i8)
         IF((iind.GE.1).AND.(iind.LE.isz).AND.
     &        (iind2.GE.1).AND.(iind2.LE.osz) ) THEN
            ipid=ipartvec(iind)
            IF(ipid.NE.myid) THEN
               IF(iwrk(iind).EQ.0) THEN
                  iwhereto = osndrcvia(ipid+1)-1
                  osndrcvia(ipid+1) = osndrcvia(ipid+1)-1
                  osndrcvja(iwhereto) = iind
                  iwrk(iind) = 1
               ENDIF
            ENDIF
         ENDIF
      ENDDO
C     FILLED UP, WHAT I WILL RECEIVE (My requests from others)
C     FILL UP ISNDRCVJA. It will be received to fill up
      CALL mpi_barrier(comm,ierror)
      offs = 1
      poffs = 1
      isndrcvia(1) = 1
      DO i=2,numprocs+1
         isndrcvia(i) = offs + rcvsz(i-1)
         IF(rcvsz(i-1) > 0) THEN
            inghbprcs(poffs)=i-1
            poffs = poffs + 1
         ENDIF         
         offs  = offs +  rcvsz(i-1)
      ENDDO
      CALL mpi_barrier(comm,ierror)      
      DO i=1, isndrcvnum
         ipid = inghbprcs(i)
         offs = isndrcvia(ipid)
         itmp = isndrcvia(ipid+1) - isndrcvia(ipid)
         CALL mpi_irecv(isndrcvja(offs), itmp, mpi_integer,ipid-1,
     &     itagcomm, comm, requests(i),ierror)   
      ENDDO
      DO i=1,osndrcvnum
         ipid = onghbprcs(i)
         offs = osndrcvia(ipid)
         itmp = osndrcvia(ipid+1)-osndrcvia(ipid)
         CALL mpi_send(osndrcvja(offs), itmp, mpi_integer, ipid-1,
     &        itagcomm, comm,ierror)
      ENDDO
      IF(isndrcvnum > 0) THEN
         CALL mpi_waitall(isndrcvnum, requests(1),istatus(1,1),ierror)
      ENDIF
      CALL mpi_barrier(comm,ierror)
      RETURN

◆ smumps_setupcommssym()

subroutine smumps_setupcommssym	(	integer	myid,
		integer	numprocs,
		integer	isz,
		integer, dimension(isz)	ipartvec,
		integer(8)	nz_loc,
		integer, dimension(nz_loc)	indx,
		integer, dimension(nz_loc)	oindx,
		integer	isndrcvnum,
		integer	isndvol,
		integer, dimension(isndrcvnum)	inghbprcs,
		integer, dimension(numprocs+1)	isndrcvia,
		integer, dimension(isndvol)	isndrcvja,
		integer	osndrcvnum,
		integer	osndvol,
		integer, dimension(osndrcvnum)	onghbprcs,
		integer, dimension(numprocs+1)	osndrcvia,
		integer, dimension(osndvol)	osndrcvja,
		integer, dimension(numprocs)	sndsz,
		integer, dimension(numprocs)	rcvsz,
		integer, dimension(isz)	iwrk,
		integer, dimension(mpi_status_size, isndrcvnum)	istatus,
		integer, dimension(isndrcvnum)	requests,
		integer	itagcomm,
		integer	comm )

Definition at line 1224 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      include 'mpif.h'
      INTEGER MYID, NUMPROCS, ISZ, ISNDVOL, OSNDVOL
      INTEGER(8) :: NZ_loc
C     ISZ is either M or N
      INTEGER INDX(NZ_loc), OINDX(NZ_loc)
C     INDX is either IRN_loc or JCN_col
      INTEGER IPARTVEC(ISZ)
C     IPARTVEC is either rowpartvec or colpartvec
      INTEGER ISNDRCVNUM, INGHBPRCS(ISNDRCVNUM)
      INTEGER ISNDRCVIA(NUMPROCS+1)
      INTEGER ISNDRCVJA(ISNDVOL)
      INTEGER OSNDRCVNUM, ONGHBPRCS(OSNDRCVNUM)
      INTEGER OSNDRCVIA(NUMPROCS+1)
      INTEGER OSNDRCVJA(OSNDVOL)
      INTEGER SNDSZ(NUMPROCS)
      INTEGER RCVSZ(NUMPROCS)
      INTEGER IWRK(ISZ)
      INTEGER ISTATUS(MPI_STATUS_SIZE, ISNDRCVNUM)
      INTEGER REQUESTS(ISNDRCVNUM)
      INTEGER ITAGCOMM, COMM
C     LOCAL VARS
      INTEGER I, IIND,IIND2,IPID,OFFS,IWHERETO,POFFS, ITMP, IERROR
      INTEGER(8) :: I8
C     COMPUATIONs START      
      DO i=1,isz
         iwrk(i) = 0
      ENDDO
C     INITIALIZE ONGHBPRCS using SNDSZ
C     INITIALIZE THE OSNDRCVIA using SNDSZ 
      offs = 1
      poffs = 1
      DO i=1,numprocs
         osndrcvia(i) = offs + sndsz(i)
         IF(sndsz(i) > 0) THEN
            onghbprcs(poffs)=i
            poffs = poffs + 1
         ENDIF         
         offs  = offs +  sndsz(i)
      ENDDO
      osndrcvia(numprocs+1) = offs
C CHECK STARTS
C check done outsize
C      IF(POFFS .NE. OSNDRCVNUM + 1)THEN ERROR
C     INIT DONE. FILL UP THE OSNDRCVJA(OSNDVOL)
      DO i8=1_8,nz_loc
         iind=indx(i8)
         iind2 = oindx(i8)
         IF((iind.GE.1).AND.(iind.LE.isz).AND.(iind2.GE.1)
     &        .AND.(iind2.LE.isz)) THEN            
            ipid=ipartvec(iind)
            IF(ipid.NE.myid) THEN
               IF(iwrk(iind).EQ.0) THEN
                  iwhereto = osndrcvia(ipid+1)-1
                  osndrcvia(ipid+1) = osndrcvia(ipid+1)-1
                  osndrcvja(iwhereto) = iind
                  iwrk(iind) = 1
               ENDIF
            ENDIF
            iind = oindx(i8)
            ipid=ipartvec(iind)
            IF(ipid.NE.myid) THEN
               IF(iwrk(iind).EQ.0) THEN
                  iwhereto = osndrcvia(ipid+1)-1
                  osndrcvia(ipid+1) = osndrcvia(ipid+1)-1
                  osndrcvja(iwhereto) = iind
                  iwrk(iind) = 1
               ENDIF
            ENDIF
         ENDIF
      ENDDO
C     FILLED UP, WHAT I WILL RECEIVE (My requests from others)
C     FILL UP ISNDRCVJA. It will be received to fill up
      CALL mpi_barrier(comm,ierror)
      offs = 1
      poffs = 1
      isndrcvia(1) = 1
      DO i=2,numprocs+1
         isndrcvia(i) = offs + rcvsz(i-1)
         IF(rcvsz(i-1) > 0) THEN
            inghbprcs(poffs)=i-1
            poffs = poffs + 1
         ENDIF         
         offs  = offs +  rcvsz(i-1)
      ENDDO
      CALL mpi_barrier(comm,ierror)      
      DO i=1, isndrcvnum
         ipid = inghbprcs(i)
         offs = isndrcvia(ipid)
         itmp = isndrcvia(ipid+1) - isndrcvia(ipid)
         CALL mpi_irecv(isndrcvja(offs), itmp, mpi_integer,ipid-1,
     &     itagcomm, comm, requests(i),ierror)   
      ENDDO
      DO i=1,osndrcvnum
         ipid = onghbprcs(i)
         offs = osndrcvia(ipid)
         itmp = osndrcvia(ipid+1)-osndrcvia(ipid)
         CALL mpi_send(osndrcvja(offs), itmp, mpi_integer, ipid-1,
     &        itagcomm, comm,ierror)
      ENDDO
      IF(isndrcvnum > 0) THEN
         CALL mpi_waitall(isndrcvnum, requests(1),istatus(1,1),ierror)
      ENDIF
      CALL mpi_barrier(comm,ierror)
      RETURN

◆ smumps_updatescale()

subroutine smumps_updatescale	(	real, dimension(dsz)	d,
		real, dimension(dsz)	tmpd,
		integer	dsz,
		integer, dimension(indxsz)	indx,
		integer	indxsz )

Definition at line 359 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER DSZ, INDXSZ
      REAL D(DSZ)
      REAL TMPD(DSZ)
      INTEGER INDX(INDXSZ)
      INTRINSIC sqrt
C     LOCAL VARS
      INTEGER I, IIND
      REAL RZERO
      parameter(rzero=0.0e0)
      DO i=1,indxsz
         iind = indx(i)
         IF (tmpd(iind).NE.rzero) d(iind) = d(iind)/sqrt(tmpd(iind))
      ENDDO
      RETURN

◆ smumps_upscale1()

subroutine smumps_upscale1	(	real, dimension(dsz)	d,
		real, dimension(dsz)	tmpd,
		integer	dsz )

Definition at line 377 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER DSZ
      REAL D(DSZ)
      REAL TMPD(DSZ)
      INTRINSIC sqrt
C     LOCAL VARS
      INTEGER I
      REAL RZERO
      parameter(rzero=0.0e0)
      DO i=1,dsz
         IF (tmpd(i) .NE. rzero) d(i) = d(i)/sqrt(tmpd(i))
      ENDDO
      RETURN

◆ smumps_zeroout()

subroutine smumps_zeroout	(	real, dimension(tmpsz)	tmpd,
		integer	tmpsz,
		integer, dimension(indxsz)	indx,
		integer	indxsz )

Definition at line 443 of file sfac_scalings_simScale_util.F.

      IMPLICIT NONE
      INTEGER TMPSZ,INDXSZ 
      REAL TMPD(TMPSZ)
      INTEGER INDX(INDXSZ)
C     LOCAL VAR
      INTEGER I
      REAL DZERO
      parameter(dzero=0.0e0)
      DO i=1,indxsz
         tmpd(indx(i)) = dzero
      ENDDO      
      RETURN

OpenRadioss 2025.1.11 OpenRadioss project

Functions/Subroutines

Function/Subroutine Documentation

◆ smumps_bureduce()

◆ smumps_chk1conv()

◆ smumps_chk1loc()

◆ smumps_chkconvglo()

◆ smumps_chkconvglosym()

◆ smumps_createpartvec()

◆ smumps_createpartvecsym()

◆ smumps_docomm1n()

◆ smumps_docomminf()

◆ smumps_errsca1()

◆ smumps_errscaloc()

◆ smumps_fillmyrowcolindices()

◆ smumps_fillmyrowcolindicessym()

◆ smumps_findnummyrowcol()

◆ smumps_findnummyrowcolsym()

◆ smumps_ibuinit()

◆ smumps_initreal()

◆ smumps_initreallst()

◆ smumps_invlist()

◆ smumps_numvolsndrcv()

◆ smumps_numvolsndrcvsym()

◆ smumps_setupcomms()

◆ smumps_setupcommssym()

◆ smumps_updatescale()

◆ smumps_upscale1()

◆ smumps_zeroout()