sfac_mem_stack_aux.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	smumps_compact_factors (a, lda, npiv, nbrow, keep, sizea, iw)
subroutine	smumps_compact_factors_unsym (a, lda, npiv, ncontig, sizea)
subroutine	smumps_copy_cb_right_to_left (a, la, lda, poselt, iptrlu, npiv, nbcol_stack, nbrow_stack, nbrow_send, sizecb, keep, packed_cb, last_allowed, nbrow_already_stacked)
subroutine	smumps_copy_cb_left_to_right (a, la, lda, poselt, iptrlu, npiv, nbcol_stack, nbrow_stack, nbrow_send, sizecb, keep, packed_cb)

Function/Subroutine Documentation

smumps_compact_factors()

subroutine smumps_compact_factors	(	real, dimension(sizea)	a,
		integer, intent(in)	lda,
		integer, intent(in)	npiv,
		integer, intent(in)	nbrow,
		integer, dimension(500)	keep,
		integer(8), intent(in)	sizea,
		integer, dimension( npiv ), intent(in)	iw )

Definition at line 14 of file sfac_mem_stack_aux.F.

      IMPLICIT NONE
      INTEGER,    INTENT(IN) :: LDA, NPIV, NBROW
      INTEGER(8), INTENT(IN) :: SIZEA
      INTEGER, INTENT(IN) :: IW( NPIV )
      INTEGER :: KEEP(500)
      REAL :: A(SIZEA)
      INTEGER(8) :: IOLD, INEW, J8
      INTEGER I , ILAST
      INTEGER NBROW_L_RECTANGLE_TO_MOVE
      INTEGER :: ICOL_BEG, ICOL_END, NBPANELS, NB_TARGET
      INTEGER :: NBCOLS_PANEL, NBROWS_PANEL
      IF ( npiv .EQ. 0 ) GOTO 500
      nb_target = npiv
      IF ( keep(459) .GT. 1 .AND. keep(50) .NE. 0 ) THEN
        CALL mumps_ldltpanel_nbtarget( npiv, nb_target, keep )
      ENDIF
      IF ( keep(50) .EQ.0 .OR. nb_target .EQ. npiv ) THEN
        IF (lda.EQ.npiv) GOTO 500
        IF ( keep(50) .NE. 0 ) THEN
          iold = int(lda  + 1,8)
          inew = int(npiv + 1,8)
          IF (iold .EQ. inew ) THEN
            WRITE(*,*) " Internal error in SMUMPS_COMPACT_FACTORS",
     &      iold, inew, npiv
            CALL mumps_abort()
          ENDIF
          DO i = 1, npiv - 1
            IF ( i .LE. npiv-2 ) THEN
              ilast = i+1
            ELSE
              ilast = i
            ENDIF
            DO j8 = 0_8, int(ilast,8)
              a( inew + j8 ) = a( iold + j8 )
            END DO
            inew = inew + int(npiv,8)
            iold = iold + int(lda,8)
          END DO
          nbrow_l_rectangle_to_move = nbrow
        ELSE 
          inew = 1_8 + int(npiv,8) * int(lda + 1,8)
          iold = 1_8 + int(lda,8) * int(npiv +1,8)
          nbrow_l_rectangle_to_move = nbrow - 1
        ENDIF
      ELSE
        icol_beg = 1               
        nbpanels  = 0
        inew = 1_8
        nbrows_panel = npiv
        DO WHILE ( icol_beg .LE. npiv )
          nbpanels=nbpanels + 1
          icol_end = min(nb_target * nbpanels, npiv)
          IF ( iw( icol_end ) < 0 ) THEN 
            icol_end = icol_end + 1
          ENDIF
          nbcols_panel = icol_end - icol_beg + 1
          iold = int(icol_beg-1,8) * int(lda,8) + int(icol_beg,8)
          DO i =1, nbrows_panel
            IF (iold .NE. inew) THEN
              DO j8=0, min(i+1, nbcols_panel)-1 
              a(inew+j8) = a(iold+j8)
              ENDDO
            ENDIF
            inew = inew + int(nbcols_panel,8)
            iold = iold + int(lda,8)
          ENDDO
          nbrows_panel = nbrows_panel - nbcols_panel
          icol_beg = icol_end + 1
        ENDDO
        iold = 1_8 + int(lda,8)*int(npiv,8)
        nbrow_l_rectangle_to_move = nbrow
      ENDIF
      DO i = 1, nbrow_l_rectangle_to_move
         DO j8 = 0_8, int(npiv - 1,8)
           a( inew + j8 ) = a( iold + j8 )
         END DO
         inew = inew + int(npiv,8)
         iold = iold + int(lda,8)
      ENDDO
 500  RETURN

smumps_compact_factors_unsym()

subroutine smumps_compact_factors_unsym	(	real, dimension(sizea), intent(inout)	a,
		integer, intent(in)	lda,
		integer, intent(in)	npiv,
		integer, intent(in)	ncontig,
		integer(8), intent(in)	sizea )

Definition at line 97 of file sfac_mem_stack_aux.F.

      IMPLICIT NONE
      INTEGER,    INTENT(IN)     :: NCONTIG, NPIV, LDA
      INTEGER(8), INTENT(IN)     :: SIZEA
      REAL,    INTENT(INOUT)  :: A(SIZEA)
      INTEGER I, J
      INTEGER(8) :: INEW, IOLD
      inew = int(npiv+1,8)
      iold = int(lda+1,8)
      DO i = 2, ncontig
        DO j = 1, npiv
          a(inew)=a(iold)
          inew = inew + 1_8
          iold = iold + 1_8
        ENDDO
        iold = iold + int(lda - npiv,8)
      ENDDO
      RETURN

smumps_copy_cb_left_to_right()

subroutine smumps_copy_cb_left_to_right	(	real, dimension(la)	a,
		integer(8), intent(in)	la,
		integer, intent(in)	lda,
		integer(8), intent(in)	poselt,
		integer(8), intent(in)	iptrlu,
		integer, intent(in)	npiv,
		integer, intent(in)	nbcol_stack,
		integer, intent(in)	nbrow_stack,
		integer, intent(in)	nbrow_send,
		integer(8), intent(in)	sizecb,
		integer, dimension(500)	keep,
		logical, intent(in)	packed_cb )

Definition at line 193 of file sfac_mem_stack_aux.F.

      IMPLICIT NONE
      INTEGER(8), intent (in) :: POSELT, IPTRLU, LA, SIZECB
      LOGICAL, intent (in) :: PACKED_CB
      REAL A(LA)
      INTEGER, intent(in):: LDA, NPIV, NBCOL_STACK, NBROW_STACK,
     &                      NBROW_SEND
      INTEGER(8) :: APOS, NPOS, APOS_ini, NPOS_ini
      INTEGER I, KEEP(500)
      INTEGER(8) :: J, LDA8
#if defined(ZERO_TRIANGLE)
      REAL ZERO
        parameter( zero = 0.0e0 )
#endif
      lda8 = int(lda,8)
      npos_ini = iptrlu + 1_8
      apos_ini = poselt + int(npiv+nbrow_send,8)* lda8 + int(npiv,8)
!$OMP PARALLEL DO PRIVATE(J, NPOS, APOS) IF (NBROW_STACK > KEEP(360))
      DO i = 1, nbrow_stack
        IF (packed_cb) THEN
            npos = npos_ini + int(i-1,8) * int(i,8)/2_8 +
     &             int(i-1,8) * int(nbrow_send,8)
        ELSE
            npos = npos_ini + int(i-1,8) * int(nbcol_stack,8)
        ENDIF
        apos  =  apos_ini + int(i-1,8) * lda8
        IF (keep(50).EQ.0) THEN
          DO j = 1_8, int(nbcol_stack,8)
            a(npos+j-1_8) = a(apos+j-1_8)
          ENDDO
        ELSE
          DO j  = 1_8, int(i + nbrow_send,8)
            a(npos+j-1_8)=a(apos+j-1_8)
          ENDDO
#if defined(ZERO_TRIANGLE)
          IF (.NOT. packed_cb) THEN
            a(npos+int(i+nbrow_send,8):
     &        npos+int(nbcol_stack-1,8))=zero
          ENDIF
#endif
        ENDIF
      ENDDO
!$OMP END PARALLEL DO
      RETURN

smumps_copy_cb_right_to_left()

subroutine smumps_copy_cb_right_to_left	(	real, dimension(la)	a,
		integer(8), intent(in)	la,
		integer, intent(in)	lda,
		integer(8), intent(in)	poselt,
		integer(8), intent(in)	iptrlu,
		integer, intent(in)	npiv,
		integer, intent(in)	nbcol_stack,
		integer, intent(in)	nbrow_stack,
		integer, intent(in)	nbrow_send,
		integer(8), intent(in)	sizecb,
		integer, dimension(500)	keep,
		logical, intent(in)	packed_cb,
		integer(8), intent(in)	last_allowed,
		integer, intent(inout)	nbrow_already_stacked )

Definition at line 117 of file sfac_mem_stack_aux.F.

      IMPLICIT NONE
      INTEGER(8), intent (in) :: POSELT, IPTRLU, LA, SIZECB
      LOGICAL, intent (in) :: PACKED_CB
      REAL A(LA)
      INTEGER, intent(in):: LDA, NPIV, NBCOL_STACK, NBROW_STACK,
     &                      NBROW_SEND
      INTEGER, intent(inout) :: NBROW_ALREADY_STACKED
      INTEGER(8), intent(in)    :: LAST_ALLOWED
      INTEGER(8) :: APOS, NPOS
      INTEGER NBROW
      INTEGER(8) :: J
      INTEGER I, KEEP(500)
#if defined(ZERO_TRIANGLE)
      REAL ZERO
        parameter( zero = 0.0e0 )
#endif
      nbrow = nbrow_stack + nbrow_send
      IF (nbrow_stack .NE. 0 ) THEN
        npos = iptrlu + sizecb         
        apos = poselt + int(npiv+nbrow,8) 
     &       * int(lda,8) - 1_8 
        IF ( keep(50) .EQ. 0 .OR. .NOT. packed_cb ) THEN
          apos = apos - int(lda,8) * int(nbrow_already_stacked,8)
          npos = npos
     &         - int(nbcol_stack,8) * int(nbrow_already_stacked,8)
        ELSE
          apos = apos - int(lda - 1,8) * int(nbrow_already_stacked,8)
          npos = npos - ( int(nbrow_already_stacked,8) *
     &                    int(nbrow_already_stacked+1,8) ) / 2_8
        ENDIF
        DO i = nbrow - nbrow_already_stacked, nbrow_send+1, -1
          IF (keep(50).EQ.0) THEN
            IF ( npos - int(nbcol_stack,8) + 1_8 .LT.
     &                                  last_allowed ) THEN
              EXIT
            ENDIF
            DO j= 1_8,int(nbcol_stack,8)
              a(npos-j+1_8) = a(apos-j+1_8)
            ENDDO
            npos = npos - int(nbcol_stack,8)
          ELSE
            IF (.NOT. packed_cb) THEN
              IF ( npos - int(nbcol_stack,8) + 1_8 .LT.
     &                                  last_allowed ) THEN
                EXIT
              ENDIF
#if defined(ZERO_TRIANGLE)
              DO j = 1_8, int(nbcol_stack - i,8)
                a(npos - j + 1_8) = zero
              END DO
#endif
              npos = npos + int(- nbcol_stack + i,8)
            ENDIF
            IF ( npos - int(i,8) + 1_8 .LT. last_allowed ) THEN
              EXIT
            ENDIF
            DO j =1_8, int(i,8)
              a(npos-j+1_8) = a(apos-j+1_8)
            ENDDO
            npos = npos - int(i,8)
          ENDIF
          IF (keep(50).EQ.0) THEN
            apos = apos - int(lda,8)
          ELSE
            apos = apos - int(lda + 1,8)
          ENDIF
          nbrow_already_stacked = nbrow_already_stacked + 1
        ENDDO
      END IF
      RETURN