sfac_type3_symmetrize.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	smumps_symmetrize (buf, block_size, myrow, mycol, nprow, npcol, a, local_m, local_n, n, myid, comm)
subroutine	smumps_send_block (buf, a, lda, m, n, comm, dest)
subroutine	smumps_recv_block (buf, a, lda, m, n, comm, source)
subroutine	smumps_trans_diag (a, n, lda)
subroutine	smumps_transpo (a1, a2, m, n, ld)

Function/Subroutine Documentation

smumps_recv_block()

subroutine smumps_recv_block	(	real, dimension(*)	buf,
		real, dimension( lda, *)	a,
		integer	lda,
		integer	m,
		integer	n,
		integer	comm,
		integer	source )

Definition at line 122 of file sfac_type3_symmetrize.F.

      IMPLICIT NONE
      INTEGER LDA, M, N, COMM, SOURCE
      REAL BUF(*), A( LDA, *)
      INTEGER I, IBUF, IERR
      include 'mpif.h'
      include 'mumps_tags.h'
      INTEGER :: STATUS(MPI_STATUS_SIZE)
      CALL mpi_recv( buf(1), m * n, mpi_real, source,
     &               symmetrize, comm, status, ierr )
      ibuf = 1
      DO i = 1, m
        CALL scopy( n, buf(ibuf), 1, a(i,1), lda )
        ibuf = ibuf + n
      END DO
      RETURN

smumps_send_block()

subroutine smumps_send_block	(	real, dimension(*)	buf,
		real, dimension(lda,*)	a,
		integer	lda,
		integer	m,
		integer	n,
		integer	comm,
		integer	dest )

Definition at line 103 of file sfac_type3_symmetrize.F.

      IMPLICIT NONE
      INTEGER M, N, LDA, DEST, COMM
      REAL BUF(*), A(LDA,*)
      INTEGER I, IBUF, IERR
      INTEGER J
      include 'mpif.h'
      include 'mumps_tags.h'
      ibuf = 1
      DO j = 1, n
        buf( ibuf: ibuf + m - 1 ) = a( 1 : m, j )
        DO i = 1, m
        END DO
        ibuf = ibuf + m
      END DO
      CALL mpi_send( buf, m * n, mpi_real,
     &     dest, symmetrize, comm, ierr )
      RETURN

smumps_symmetrize()

subroutine smumps_symmetrize	(	real, dimension( block_size * block_size )	buf,
		integer	block_size,
		integer	myrow,
		integer	mycol,
		integer	nprow,
		integer	npcol,
		real, dimension( local_m, local_n )	a,
		integer	local_m,
		integer	local_n,
		integer	n,
		integer	myid,
		integer	comm )

Definition at line 14 of file sfac_type3_symmetrize.F.

      IMPLICIT NONE
      INTEGER BLOCK_SIZE, NPROW, NPCOL, LOCAL_M, LOCAL_N, N, COMM
      INTEGER MYROW, MYCOL, MYID
      REAL BUF( BLOCK_SIZE * BLOCK_SIZE )
      REAL A( LOCAL_M, LOCAL_N )
      INTEGER NBLOCK, IBLOCK, JBLOCK, IBLOCK_SIZE, JBLOCK_SIZE
      INTEGER ROW_SOURCE, ROW_DEST, COL_SOURCE, COL_DEST
      INTEGER IGLOB, JGLOB
      INTEGER IROW_LOC_SOURCE, JCOL_LOC_SOURCE
      INTEGER IROW_LOC_DEST, JCOL_LOC_DEST
      INTEGER PROC_SOURCE, PROC_DEST
      nblock = ( n - 1 ) / block_size + 1
      DO iblock = 1, nblock
        IF ( iblock .NE. nblock
     &    ) THEN
          iblock_size = block_size
        ELSE
          iblock_size = n - ( nblock - 1 ) * block_size
        END IF
        row_source = mod( iblock - 1, nprow ) 
        col_dest   = mod( iblock - 1, npcol )
        iglob = ( iblock - 1 ) * block_size + 1
        irow_loc_source = block_size *
     &                    ( ( iglob - 1 ) / (block_size*nprow) )
     &                  + mod( iglob - 1, block_size ) + 1
        jcol_loc_dest   = block_size *
     &                    ( ( iglob - 1 ) / (block_size*npcol) )
     &                  + mod( iglob - 1, block_size ) + 1
        DO jblock = 1, iblock
          IF ( jblock .NE. nblock
     &      ) THEN
            jblock_size = block_size
          ELSE
            jblock_size = n - ( nblock - 1 ) * block_size
          END IF
          col_source = mod( jblock - 1, npcol )
          row_dest   = mod( jblock - 1, nprow )
          proc_source = row_source * npcol + col_source
          proc_dest   = row_dest   * npcol + col_dest
          IF ( proc_source .eq. proc_dest ) THEN
           IF ( myid .eq. proc_dest ) THEN
            jglob = ( jblock - 1 ) * block_size + 1
            jcol_loc_source = block_size *
     &                  ( ( jglob - 1 ) / (block_size*npcol) )
     &                  + mod( jglob - 1, block_size ) + 1
            irow_loc_dest   = block_size *
     &                    ( ( jglob - 1 ) / (block_size*nprow) )
     &                  + mod( jglob - 1, block_size ) + 1
            IF ( iblock .eq. jblock ) THEN
               IF ( iblock_size .ne. jblock_size ) THEN
                WRITE(*,*) myid,': Error in calling transdiag:unsym'
                CALL mumps_abort()
              END IF
              CALL smumps_trans_diag( a( irow_loc_source,
     &                 jcol_loc_source),
     &                 iblock_size, local_m )
            ELSE
              CALL smumps_transpo(
     &           a( irow_loc_source, jcol_loc_source ),
     &           a( irow_loc_dest, jcol_loc_dest ),
     &           iblock_size, jblock_size, local_m )
            END IF
           END IF
          ELSE IF (  myrow .eq. row_source 
     &    .AND. mycol .eq. col_source ) THEN
            jglob = ( jblock - 1 ) * block_size + 1
            jcol_loc_source = block_size *
     &                    ( ( jglob - 1 ) / (block_size*npcol) )
     &                  + mod( jglob - 1, block_size ) + 1
            CALL smumps_send_block( buf,
     &           a( irow_loc_source, jcol_loc_source ), local_m,
     &           iblock_size, jblock_size, comm, proc_dest )
          ELSE IF ( myrow .eq. row_dest 
     &    .AND.     mycol .eq. col_dest ) THEN
            jglob = ( jblock - 1 ) * block_size + 1
            irow_loc_dest   = block_size *
     &                    ( ( jglob - 1 ) / (block_size*nprow) )
     &                  + mod( jglob - 1, block_size ) + 1
            CALL smumps_recv_block( buf,
     &           a( irow_loc_dest, jcol_loc_dest ), local_m,
     &           jblock_size, iblock_size, comm, proc_source )
          END IF
        END DO
      END DO
      RETURN

smumps_trans_diag()

subroutine smumps_trans_diag	(	real, dimension( lda, * )	a,
		integer	n,
		integer	lda )

Definition at line 139 of file sfac_type3_symmetrize.F.

      IMPLICIT NONE
      INTEGER N,LDA
      REAL A( LDA, * )
      INTEGER I, J
      DO i = 2, n
        DO j = 1, i - 1
          a( j, i ) = a( i, j )
        END DO
      END DO
      RETURN

smumps_transpo()

subroutine smumps_transpo	(	real, dimension( ld,* )	a1,
		real, dimension( ld, * )	a2,
		integer	m,
		integer	n,
		integer	ld )

Definition at line 151 of file sfac_type3_symmetrize.F.

      IMPLICIT NONE
      INTEGER M,N,LD
      REAL A1( LD,* ), A2( LD, * )
      INTEGER I, J
      DO j = 1, n
        DO i = 1, m
          a2( j, i ) = a1( i, j )
        END DO
      END DO
      RETURN