cfac_determinant.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	cmumps_updatedeter (piv, deter, nexp)
subroutine	cmumps_updatedeter_scaling (piv, deter, nexp)
subroutine	cmumps_getdeter2d (block_size, ipiv, myrow, mycol, nprow, npcol, a, local_m, local_n, n, myid, deter, nexp, sym)
subroutine	cmumps_deter_reduction (comm, deter_in, nexp_in, deter_out, nexp_out, nprocs)
subroutine	cmumps_deterreduce_func (inv, inoutv, nel, datatype)
subroutine	cmumps_deter_square (deter, nexp)
subroutine	cmumps_deter_scaling_inverse (deter, nexp)
subroutine	cmumps_deter_sign_perm (deter, n, visited, perm)
subroutine	cmumps_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

cmumps_deter_reduction()

subroutine cmumps_deter_reduction	(	integer, intent(in)	comm,
		complex, intent(in)	deter_in,
		integer, intent(in)	nexp_in,
		complex, intent(out)	deter_out,
		integer, intent(out)	nexp_out,
		integer, intent(in)	nprocs )

Definition at line 87 of file cfac_determinant.F.

      IMPLICIT NONE
      INTEGER, intent(in) :: COMM, NPROCS
      COMPLEX, intent(in) :: DETER_IN
      INTEGER,intent(in) :: NEXP_IN
      COMPLEX,intent(out):: DETER_OUT
      INTEGER,intent(out):: NEXP_OUT
      INTEGER            :: IERR_MPI
      EXTERNAL cmumps_deterreduce_func
      INTEGER TWO_SCALARS_TYPE, DETERREDUCE_OP
      COMPLEX :: INV(2)
      COMPLEX :: 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_complex,
     &                         two_scalars_type,
     &                         ierr_mpi)
      CALL mpi_type_commit(two_scalars_type, ierr_mpi)
      CALL mpi_op_create(cmumps_deterreduce_func,  
     &                   .true.,             
     &                   deterreduce_op,     
     &                   ierr_mpi)
      inv(1)=deter_in
      inv(2)=cmplx(nexp_in,kind=kind(inv))
      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

cmumps_deter_scaling_inverse()

subroutine cmumps_deter_scaling_inverse	(	real, intent(inout)	deter,
		integer, intent(inout)	nexp )

Definition at line 154 of file cfac_determinant.F.

      IMPLICIT NONE
      INTEGER, intent (inout) :: NEXP
      REAL, intent (inout) :: DETER
      deter=1.0e0/deter
      nexp=-nexp
      RETURN

cmumps_deter_sign_perm()

subroutine cmumps_deter_sign_perm	(	complex, intent(inout)	deter,
		integer, intent(in)	n,
		integer, dimension(n), intent(inout)	visited,
		integer, dimension(n), intent(in)	perm )

Definition at line 162 of file cfac_determinant.F.

      IMPLICIT NONE
      COMPLEX, 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

cmumps_deter_square()

subroutine cmumps_deter_square	(	complex, intent(inout)	deter,
		integer, intent(inout)	nexp )

Definition at line 146 of file cfac_determinant.F.

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

cmumps_deterreduce_func()

subroutine cmumps_deterreduce_func	(	complex, dimension ( 2 * nel ), intent(in)	inv,
		complex, dimension ( 2 * nel ), intent(inout)	inoutv,
		integer, intent(in)	nel,
		integer, intent(in)	datatype )

Definition at line 125 of file cfac_determinant.F.

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

cmumps_getdeter2d()

subroutine cmumps_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,
		complex, dimension(*), intent(in)	a,
		integer, intent(in)	local_m,
		integer, intent(in)	local_n,
		integer, intent(in)	n,
		integer, intent(in)	myid,
		complex, intent(inout)	deter,
		integer, intent(inout)	nexp,
		integer, intent(in)	sym )

Definition at line 41 of file cfac_determinant.F.

      IMPLICIT NONE
      INTEGER, intent (in)    :: SYM
      INTEGER, intent (inout) :: NEXP
      COMPLEX, intent (inout) :: DETER
      INTEGER, intent (in)    :: BLOCK_SIZE, NPROW, NPCOL,
     &                           LOCAL_M, LOCAL_N, N
      INTEGER, intent (in)    :: MYROW, MYCOL, MYID, IPIV(LOCAL_M)
      COMPLEX, 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 cmumps_updatedeter(a(i),deter,nexp)
              IF (sym.EQ.1) THEN
               CALL cmumps_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

cmumps_par_root_minmax_piv_upd()

subroutine cmumps_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,
		complex, dimension(*), intent(in)	a,
		integer, intent(in)	local_m,
		integer, intent(in)	local_n,
		integer, intent(in)	n,
		integer, intent(in)	myid,
		real, dimension(230), intent(inout)	dkeep,
		integer, dimension(500), intent(in)	keep,
		integer, intent(in)	sym )

Definition at line 187 of file cfac_determinant.F.

       USE cmumps_fac_front_aux_m, 
     &      only : cmumps_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)
      COMPLEX, intent(in) :: A(*)
      REAL, INTENT(INOUT) :: DKEEP(230)
      INTEGER, INTENT(IN) :: KEEP(500)
      INTEGER  I,IMX,DI,NBLOCK,IBLOCK,ILOC,JLOC,
     &         ROW_PROC,COL_PROC, K
      REAL :: 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 cmumps_update_minmax_pivot 
     &           ( abspivot,
     &             dkeep, keep, .false.)
              k = k + 1
              i = i + di
            END DO
          END IF
        END IF
      END DO
      RETURN

cmumps_updatedeter()

subroutine cmumps_updatedeter	(	complex, intent(in)	piv,
		complex, intent(inout)	deter,
		integer, intent(inout)	nexp )

Definition at line 14 of file cfac_determinant.F.

      IMPLICIT NONE
      COMPLEX, intent(in) :: PIV
      COMPLEX, intent(inout) :: DETER
      INTEGER, intent(inout) :: NEXP
      REAL R_PART, C_PART
      INTEGER NEXP_LOC
      deter=deter*piv
      r_part=real(deter)
      c_part=aimag(deter)
      nexp_loc = exponent(abs(r_part)+abs(c_part))
      nexp = nexp + nexp_loc
      r_part=scale(r_part, -nexp_loc)
      c_part=scale(c_part, -nexp_loc)
      deter=cmplx(r_part,c_part,kind=kind(deter))
      RETURN

cmumps_updatedeter_scaling()

subroutine cmumps_updatedeter_scaling	(	real, intent(in)	piv,
		real, intent(inout)	deter,
		integer, intent(inout)	nexp )

Definition at line 31 of file cfac_determinant.F.

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