dfac_determinant.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	dmumps_updatedeter (piv, deter, nexp)
subroutine	dmumps_updatedeter_scaling (piv, deter, nexp)
subroutine	dmumps_getdeter2d (block_size, ipiv, myrow, mycol, nprow, npcol, a, local_m, local_n, n, myid, deter, nexp, sym)
subroutine	dmumps_deter_reduction (comm, deter_in, nexp_in, deter_out, nexp_out, nprocs)
subroutine	dmumps_deterreduce_func (inv, inoutv, nel, datatype)
subroutine	dmumps_deter_square (deter, nexp)
subroutine	dmumps_deter_scaling_inverse (deter, nexp)
subroutine	dmumps_deter_sign_perm (deter, n, visited, perm)
subroutine	dmumps_par_root_minmax_piv_upd (block_size, ipiv, myrow, mycol, nprow, npcol, a, local_m, local_n, n, myid, dkeep, keep, sym)

Function/Subroutine Documentation

dmumps_deter_reduction()

subroutine dmumps_deter_reduction	(	integer, intent(in)	comm,
		double precision, intent(in)	deter_in,
		integer, intent(in)	nexp_in,
		double precision, intent(out)	deter_out,
		integer, intent(out)	nexp_out,
		integer, intent(in)	nprocs )

Definition at line 80 of file dfac_determinant.F.

      IMPLICIT NONE
      INTEGER, intent(in) :: COMM, NPROCS
      DOUBLE PRECISION, intent(in) :: DETER_IN
      INTEGER,intent(in) :: NEXP_IN
      DOUBLE PRECISION,intent(out):: DETER_OUT
      INTEGER,intent(out):: NEXP_OUT
      INTEGER            :: IERR_MPI
      EXTERNAL dmumps_deterreduce_func
      INTEGER TWO_SCALARS_TYPE, DETERREDUCE_OP
      DOUBLE PRECISION :: INV(2)
      DOUBLE PRECISION :: OUTV(2)
      include 'mpif.h'
      IF (nprocs .EQ. 1) THEN
        deter_out = deter_in
        nexp_out  = nexp_in
        RETURN
      ENDIF
      CALL mpi_type_contiguous(2, mpi_double_precision,
     &                         two_scalars_type,
     &                         ierr_mpi)
      CALL mpi_type_commit(two_scalars_type, ierr_mpi)
      CALL mpi_op_create(dmumps_deterreduce_func,  
     &                   .true.,             
     &                   deterreduce_op,     
     &                   ierr_mpi)
      inv(1)=deter_in
      inv(2)=dble(nexp_in)
      CALL mpi_allreduce( inv, outv, 1, two_scalars_type,
     &                    deterreduce_op, comm, ierr_mpi)
      CALL mpi_op_free(deterreduce_op, ierr_mpi)
      CALL mpi_type_free(two_scalars_type, ierr_mpi)
      deter_out = outv(1)
      nexp_out  = int(outv(2))
      RETURN

dmumps_deter_scaling_inverse()

subroutine dmumps_deter_scaling_inverse	(	double precision, intent(inout)	deter,
		integer, intent(inout)	nexp )

Definition at line 147 of file dfac_determinant.F.

      IMPLICIT NONE
      INTEGER, intent (inout) :: NEXP
      DOUBLE PRECISION, intent (inout) :: DETER
      deter=1.0d0/deter
      nexp=-nexp
      RETURN

dmumps_deter_sign_perm()

subroutine dmumps_deter_sign_perm	(	double precision, intent(inout)	deter,
		integer, intent(in)	n,
		integer, dimension(n), intent(inout)	visited,
		integer, dimension(n), intent(in)	perm )

Definition at line 155 of file dfac_determinant.F.

      IMPLICIT NONE
      DOUBLE PRECISION, intent(inout) :: DETER
      INTEGER, intent(in)    :: N
      INTEGER, intent(inout) :: VISITED(N)
      INTEGER, intent(in)    :: PERM(N)
      INTEGER I, J, K
      k = 0
      DO i = 1, n
        IF (visited(i) .GT. n) THEN
          visited(i)=visited(i)-n-n-1
          cycle
        ENDIF
        j = perm(i)
        DO WHILE (j.NE.i)
          visited(j) = visited(j) + n + n + 1
          k = k + 1
          j = perm(j)
        ENDDO
      ENDDO
      IF (mod(k,2).EQ.1) THEN
        deter = -deter
      ENDIF
      RETURN

dmumps_deter_square()

subroutine dmumps_deter_square	(	double precision, intent(inout)	deter,
		integer, intent(inout)	nexp )

Definition at line 139 of file dfac_determinant.F.

      IMPLICIT NONE
      INTEGER, intent (inout) :: NEXP
      DOUBLE PRECISION, intent (inout) :: DETER
      deter=deter*deter
      nexp=nexp+nexp
      RETURN

dmumps_deterreduce_func()

subroutine dmumps_deterreduce_func	(	double precision, dimension ( 2 * nel ), intent(in)	inv,
		double precision, dimension ( 2 * nel ), intent(inout)	inoutv,
		integer, intent(in)	nel,
		integer, intent(in)	datatype )

Definition at line 118 of file dfac_determinant.F.

      IMPLICIT NONE
#if defined(WORKAROUNDINTELILP64MPI2INTEGER) || defined(WORKAROUNDILP64MPICUSTOMREDUCE)
      INTEGER(4), INTENT(IN)    :: NEL, DATATYPE
#else
      INTEGER, INTENT(IN)    :: NEL, DATATYPE
#endif
      DOUBLE PRECISION, INTENT(IN)    :: INV    ( 2 * NEL )
      DOUBLE PRECISION, INTENT(INOUT) :: INOUTV ( 2 * NEL )
      INTEGER I, TMPEXPIN, TMPEXPINOUT
      DO i = 1, nel
        tmpexpin    = int(inv(i*2))
        tmpexpinout = int(inoutv(i*2))
        CALL dmumps_updatedeter(inv(i*2-1), 
     &                          inoutv(i*2-1), 
     &                          tmpexpinout)   
        tmpexpinout = tmpexpinout + tmpexpin
        inoutv(i*2) = dble(tmpexpinout)
      ENDDO
      RETURN

dmumps_getdeter2d()

subroutine dmumps_getdeter2d	(	integer, intent(in)	block_size,
		integer, dimension(local_m), intent(in)	ipiv,
		integer, intent(in)	myrow,
		integer, intent(in)	mycol,
		integer, intent(in)	nprow,
		integer, intent(in)	npcol,
		double precision, dimension(*), intent(in)	a,
		integer, intent(in)	local_m,
		integer, intent(in)	local_n,
		integer, intent(in)	n,
		integer, intent(in)	myid,
		double precision, intent(inout)	deter,
		integer, intent(inout)	nexp,
		integer, intent(in)	sym )

Definition at line 34 of file dfac_determinant.F.

      IMPLICIT NONE
      INTEGER, intent (in)    :: SYM
      INTEGER, intent (inout) :: NEXP
      DOUBLE PRECISION, intent (inout) :: DETER
      INTEGER, intent (in)    :: BLOCK_SIZE, NPROW, NPCOL,
     &                           LOCAL_M, LOCAL_N, N
      INTEGER, intent (in)    :: MYROW, MYCOL, MYID, IPIV(LOCAL_M)
      DOUBLE PRECISION, intent(in) :: A(*)
      INTEGER  I,IMX,DI,NBLOCK,IBLOCK,ILOC,JLOC,
     &         ROW_PROC,COL_PROC, K
      di = local_m + 1 
      nblock = ( n - 1 ) / block_size
      DO iblock = 0, nblock
        row_proc = mod( iblock, nprow ) 
        IF ( myrow.EQ.row_proc ) THEN
          col_proc = mod( iblock, npcol )
          IF ( mycol.EQ.col_proc ) THEN
            iloc = ( iblock / nprow ) * block_size
            jloc = ( iblock / npcol ) * block_size
            i   =   iloc + jloc *  local_m + 1
            imx = min(iloc+block_size,local_m)
     &            + (min(jloc+block_size,local_n)-1)*local_m
     &            + 1
            k=1
            DO WHILE ( i .LT. imx )
              CALL dmumps_updatedeter(a(i),deter,nexp)
              IF (sym.EQ.1) THEN
               CALL dmumps_updatedeter(a(i),deter,nexp)
              ENDIF
              IF (sym.NE.1) THEN 
                IF (ipiv(iloc+k) .NE. iblock*block_size+k) THEN
                  deter = -deter
                ENDIF
              ENDIF
              k = k + 1
              i = i + di
            END DO
          END IF
        END IF
      END DO
      RETURN

dmumps_par_root_minmax_piv_upd()

subroutine dmumps_par_root_minmax_piv_upd	(	integer, intent(in)	block_size,
		integer, dimension(local_m), intent(in)	ipiv,
		integer, intent(in)	myrow,
		integer, intent(in)	mycol,
		integer, intent(in)	nprow,
		integer, intent(in)	npcol,
		double precision, dimension(*), intent(in)	a,
		integer, intent(in)	local_m,
		integer, intent(in)	local_n,
		integer, intent(in)	n,
		integer, intent(in)	myid,
		double precision, dimension(230), intent(inout)	dkeep,
		integer, dimension(500), intent(in)	keep,
		integer, intent(in)	sym )

Definition at line 180 of file dfac_determinant.F.

       USE dmumps_fac_front_aux_m, 
     &      only : dmumps_update_minmax_pivot 
      IMPLICIT NONE
      INTEGER, intent (in)    :: BLOCK_SIZE, NPROW, NPCOL,
     &                           LOCAL_M, LOCAL_N, N, SYM
      INTEGER, intent (in)    :: MYROW, MYCOL, MYID, IPIV(LOCAL_M)
      DOUBLE PRECISION, intent(in) :: A(*)
      DOUBLE PRECISION, INTENT(INOUT) :: DKEEP(230)
      INTEGER, INTENT(IN) :: KEEP(500)
      INTEGER  I,IMX,DI,NBLOCK,IBLOCK,ILOC,JLOC,
     &         ROW_PROC,COL_PROC, K
      DOUBLE PRECISION :: ABSPIVOT
      di = local_m + 1 
      nblock = ( n - 1 ) / block_size
      DO iblock = 0, nblock
        row_proc = mod( iblock, nprow ) 
        IF ( myrow.EQ.row_proc ) THEN
          col_proc = mod( iblock, npcol )
          IF ( mycol.EQ.col_proc ) THEN
            iloc = ( iblock / nprow ) * block_size
            jloc = ( iblock / npcol ) * block_size
            i   =   iloc + jloc *  local_m + 1
            imx = min(iloc+block_size,local_m)
     &            + (min(jloc+block_size,local_n)-1)*local_m
     &            + 1
            k=1
            DO WHILE ( i .LT. imx )
             IF (sym.NE.1) THEN
              abspivot =  abs(a(i))
             ELSE
              abspivot =  abs(a(i)*a(i))
             ENDIF
             CALL dmumps_update_minmax_pivot 
     &           ( abspivot,
     &             dkeep, keep, .false.)
              k = k + 1
              i = i + di
            END DO
          END IF
        END IF
      END DO
      RETURN

dmumps_updatedeter()

subroutine dmumps_updatedeter	(	double precision, intent(in)	piv,
		double precision, intent(inout)	deter,
		integer, intent(inout)	nexp )

Definition at line 14 of file dfac_determinant.F.

      IMPLICIT NONE
      DOUBLE PRECISION, intent(in) :: PIV
      DOUBLE PRECISION, intent(inout) :: DETER
      INTEGER, intent(inout) :: NEXP
      deter=deter*fraction(piv)
      nexp=nexp+exponent(piv)+exponent(deter)
      deter=fraction(deter)
      RETURN

dmumps_updatedeter_scaling()

subroutine dmumps_updatedeter_scaling	(	double precision, intent(in)	piv,
		double precision, intent(inout)	deter,
		integer, intent(inout)	nexp )

Definition at line 24 of file dfac_determinant.F.

      IMPLICIT NONE
      DOUBLE PRECISION, intent(in) :: PIV
      DOUBLE PRECISION, intent(inout) :: DETER
      INTEGER, intent(inout) :: NEXP
      deter=deter*fraction(piv)
      nexp=nexp+exponent(piv)+exponent(deter)
      deter=fraction(deter)
      RETURN