zooc_panel_piv.F

Go to the documentation of this file.

C
C  This file is part of MUMPS 5.5.1, released
C  on Tue Jul 12 13:17:24 UTC 2022
C
C
C  Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  Mumps Technologies, University of Bordeaux.
C
C  This version of MUMPS is provided to you free of charge. It is
C  released under the CeCILL-C license 
C  (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
C  https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
C
C     This file contains routines related to OOC,
C     panels, and pivoting. They are used to store
C     permutation information of what is already on
C     disk to be able to permute things back at the
C     solve stage.
C     They do not need to be in the MUMPS_OOC
C     module (most of them do not use any variable
C     from the module, or are called from routines
C     where we do not necessarily want to do a
C     USE ZMUMPS_OOC).
      INTEGER FUNCTION zmumps_ooc_get_panel_size
     &     ( hbuf_size, nnmax, k227, k50 )
      IMPLICIT NONE
C
C     Arguments:
C     =========
C
      INTEGER, INTENT(IN) :: nnmax, k227, k50
      INTEGER(8), INTENT(IN) :: hbuf_size
C
C     Purpose:
C     =======
C
C     - Compute the effective size (maximum number of pivots in a panel)
C     for a front with NNMAX entries in its row (for U) /
C     column (for L).
C     - Be able to adapt the fixed number of columns in panel
C     depending on NNMAX, and size of IO buffer HBUF_SIZE
C
C     Local variables
C     ===============
C
      INTEGER k227_loc
      INTEGER nbcol_max
      INTEGER effective_size
      nbcol_max=int(hbuf_size / int(nnmax,8))
C     KEEP(227): Maximum size (nb of col/row) of a panel
      k227_loc = abs(k227)
      IF (k50.EQ.2) THEN
C        for 2x2 pivots we may end-up having the first part
C        of a 2x2 pivot in the last col of the panel; the
C        adopted solution consists in adding the next column
C        to the panel; therefore we need be able to
C        dynamically increase the panel size by one.
C        note that we also maintain property:
C        KEEP(227): Maximum size (nb of col/row) of a panel
         k227_loc=max(k227_loc,2)
         effective_size =  min(nbcol_max-1, k227_loc-1)
cN       - during bwd the effective size is useless
      ELSE
C        complete buffer space can be used for a panel
         effective_size =  min(nbcol_max, k227_loc)
      ENDIF
      IF (effective_size.LE.0) THEN
         write(6,*) 'Internal buffers too small to store ',
     &        ' ONE col/row of size', nnmax
         CALL mumps_abort()
      ENDIF
      zmumps_ooc_get_panel_size = effective_size
      RETURN
      END FUNCTION zmumps_ooc_get_panel_size
C
      SUBROUTINE zmumps_permute_panel( IPIV, LPIV, ISHIFT,
     &     THE_PANEL, NBROW, NBCOL, KbeforePanel )
      IMPLICIT NONE
C
C     Purpose:
C     =======
C
C     Permute rows of a panel, stored by columns, according
C     to permutation array IPIV.
C     IPIV is such that, for I = 1 to LPIV, row ISHIFT + I
C     in the front must be permuted with row IPIV( I )
C
C     Since the panel is not necessary at the beginning of
C     the front, let KbeforePanel be the number of pivots in the
C     front before the first pivot of the panel.
C
C     In the panel, row ISHIFT+I-KbeforePanel is permuted with
C     row IPIV(I)-KbeforePanel
C
C     Note:
C     ====
C
C     This routine can also be used to permute the columns of
C     a matrix (U) stored by rows. In that case, the argument
C     NBROW represents the number of columns, and NBCOL represents
C     the number of rows.
C
C
C     Arguments:
C     =========
C
      INTEGER LPIV, ISHIFT, NBROW, NBCOL, KbeforePanel
      INTEGER IPIV(LPIV)
      COMPLEX(kind=8) THE_PANEL(NBROW, NBCOL)
C
C     Local variables:
C     ===============
C
      INTEGER I, IPERM
C
C     Executable statements
C     =====================
C
      DO i = 1, lpiv
C        Swap rows ISHIFT + I and PIV(I)
         iperm=ipiv(i)
         IF ( i+ishift.NE.iperm) THEN
            CALL zswap(nbcol,
     &           the_panel(i+ishift-kbeforepanel,1), nbrow,
     &           the_panel(iperm-kbeforepanel,1), nbrow)
         ENDIF
      END DO
      RETURN
      END SUBROUTINE zmumps_permute_panel
      SUBROUTINE zmumps_get_ooc_perm_ptr(TYPEF,
     &     NBPANELS,
     &     I_PIVPTR, I_PIV, IPOS, IW, LIW)
      USE mumps_ooc_common ! To access TYPEF_L and TYPEF_U
      IMPLICIT NONE
      include 'mumps_headers.h'
C
C     Purpose:
C     =======
C
C     Get the pointers in IW on pivoting information to be stored
C     during factorization and used during the solve phase. This
C     routine is both for the symmetric (TYPEF=TYPEF_L) and unsymmetric
C     cases (TYPEF=TYPEF_L or TYPEF_U).
C     The total size of this space is estimated during
C     fac_ass.F / fac_ass_ELT.F and must be:
C     * Symmetric case: 1 for NASS + 1 for NBPANELS_L + NBPANELS_L + NASS
C     * Unsymmetric case: 1 + (1+NBPANELS_L+NASS) + (1+NBPANELS_U+NASS)
C     Size computation is in routine ZMUMPS_OOC_GET_PP_SIZES.
C
C     At the end of the standard description of the structure of a node
C     (header, nb slaves, <slaves_list>, row indices, col indices), we
C     add, when panel version with pivoting is used:
C
C     NASS (nb of fully summed variables)
C     NBPANELS_L
C     PIVRPTR(1:NBPANELS_L)
C     PIV_L     (1:NASS)             NASS (=IW(IPOS)(or NASS-PIVRPTR(1) in
C     the future, after compression)
C     NBPANELS_U
C     PIVRPTR(1:NBPANELS_U)
C     PIV_U     (1:NASS)             NASS (=IW(IPOS)(or NASS-PIVRPTR(1) in
C     the future, after compression)
C
C
C     Output parameters:
C     =================
C     NBPANELS : nb of panels as estimated during assembly
C     I_PIVPTR : position in  IW of the starting of the pointer list
C     (of size NBPANELS) of the pointers to the list of pivots
C     I_PIV    : position in  IW of the starting of the pivot permutation list
C
      INTEGER, intent(out) :: NBPANELS, I_PIVPTR, I_PIV
      INTEGER, intent(in) :: TYPEF ! TYPEF_L or TYPEF_U
      INTEGER, intent(in) :: LIW, IPOS
      INTEGER IW(LIW)
C     Locals
      INTEGER I_NBPANELS, I_NASS
C
      i_nass       = ipos
      i_nbpanels   = i_nass + 1 ! L
      nbpanels     = iw(i_nbpanels) ! L
      i_pivptr     = i_nbpanels + 1 ! L
      i_piv        = i_pivptr + nbpanels ! L
C     ... of size NASS = IW(I_NASS)
      IF (typef==typef_u) THEN
         i_nbpanels   = i_piv+iw(i_nass) ! U
         nbpanels     = iw(i_nbpanels) ! U
         i_pivptr     = i_nbpanels + 1 ! U
         i_piv        = i_pivptr + nbpanels ! U
      ENDIF
      RETURN
      END SUBROUTINE zmumps_get_ooc_perm_ptr
      SUBROUTINE zmumps_ooc_pp_set_ptr(K50,NBPANELS_L,NBPANELS_U,
     &     NASS, IPOS, IW, LIW )
      IMPLICIT NONE
C
C     Purpose:
C     =======
C
C     Initialize the contents of PIV/PIVPTR/etc. that will store
C     pivoting information during the factorization.
C     NASS and NBPANELS are recorded. PIVPTR(1:NBPANELS)
C     is initialized to NASS+1. This will be modified during
C     the factorization in cases where permutations have to
C     be performed during the solve phase.
C
C     Arguments:
C     =========
C
      INTEGER K50
      INTEGER IPOS, NASS, NBPANELS_L, NBPANELS_U, LIW
      INTEGER IW(LIW)
C
C     Local variables:
C     ===============
C
      INTEGER IPOS_U
C     Executable statements
      IF (K50.EQ.1) THEN
         WRITE(*,*) "Internal error: ZMUMPS_OOC_PP_SET_PTR called"
      ENDIF
      iw(ipos)=nass
      iw(ipos+1)=nbpanels_l
      iw(ipos+2:ipos+1+nbpanels_l)=nass+1
      IF (k50 == 0) THEN
         ipos_u=ipos+2+nass+nbpanels_l
         iw(ipos_u)=nbpanels_u
         iw(ipos_u+1:ipos_u+nbpanels_u)=nass+1
      ENDIF
      RETURN
      END SUBROUTINE zmumps_ooc_pp_set_ptr
      SUBROUTINE zmumps_ooc_pp_tryrelease_space (
     &     IWPOS, IOLDPS, IW, LIW, MonBloc, NFRONT, KEEP
     &     )
      USE zmumps_ooc
      IMPLICIT NONE
      include 'mumps_headers.h'
C
C     Purpose:
C     =======
C     If space used was at the top of the stack then
C     try to free space by detecting that
C     no permutation needs to be applied during
C     solve on panels.
C     One position is left (I_NASS) and set to -1
C     to indicate that permutation not needed at solve.
C
C     Arguments:
C     =========
C
      INTEGER, INTENT(IN)    :: IOLDPS, LIW, NFRONT,
     &     KEEP(500)
      INTEGER, INTENT(INOUT) :: IWPOS, IW(LIW)
      TYPE(IO_BLOCK), INTENT(IN):: MonBloc
C
C     Local variables:
C     ===============
C
      INTEGER :: NBPANELS_L,I_PIVRPTR_L, I_PIVR_L, NBPANELS_U,
     &     i_pivrptr_u, i_pivr_u, xsize, ibegooc
      LOGICAL FREESPACE    ! set to true when permutation not needed
C     Executable statements
      IF (KEEP(50).EQ.1) RETURN ! no pivoting
C     --------------------------------
C     quick return if record is not at
C     the top of stack of L factors
      IF ((ioldps+iw(ioldps+xxi)).NE.iwpos) RETURN
C     ---------------------------------------------
C     Panel+pivoting: get pointers on each subarray
C     ---------------------------------------------
      xsize   = keep(ixsz)
      ibegooc = ioldps+2*nfront+6+iw(ioldps+5+xsize)+xsize
C     -- get L related data
      CALL zmumps_get_ooc_perm_ptr(typef_l, nbpanels_l,
     &     i_pivrptr_l, i_pivr_l,
     &     ibegooc, iw, liw)
      freespace =
     &     (monbloc%LastPiv.EQ.(iw(i_pivrptr_l)-1))
      IF (keep(50).EQ.0) THEN
C     -- get U related dataA
         CALL zmumps_get_ooc_perm_ptr(typef_u, nbpanels_u,
     &        i_pivrptr_u, i_pivr_u,
     &        ibegooc, iw, liw)
         freespace =  freespace .AND.
     &        (monbloc%LastPiv.EQ.(iw(i_pivrptr_u)-1))
      ENDIF
C     ---------------------------------
C     Check if permutations eed be
C     performed on panels during solve
C     --------------------------------
      IF (freespace) THEN
C     -- compress memory for that node: keep one entry set to -7777
         iw(ibegooc) = -7777    ! will be tested during solve
         iw(ioldps+xxi) = ibegooc
     &        - ioldps + 1      ! new size of inode's record
         iwpos = ibegooc+1      ! move back to top of stack
      ENDIF
      RETURN
      END SUBROUTINE zmumps_ooc_pp_tryrelease_space
C
      SUBROUTINE zmumps_ooc_get_pp_sizes(K50, NBROW_L, NBCOL_U, NASS,
     &     NBPANELS_L, NBPANELS_U, LREQ)
      USE zmumps_ooc       ! To call ZMUMPS_OOC_PANEL_SIZE
      IMPLICIT NONE
C
C     Purpose
C     =======
C
C     Compute the size of the workspace required to store the permutation
C     information during factorization, so that solve can permute back
C     what has to be permuted (this could not be done during factorization
C     because it was already on disk).
C
C     Arguments
C     =========
C
      INTEGER, intent(IN)  :: K50, NBROW_L, NBCOL_U, NASS
      INTEGER, intent(OUT) :: NBPANELS_L, NBPANELS_U, LREQ
      NBPANELS_L=-99999
      nbpanels_u=-99999
C
C     Quick return in SPD case (no pivoting)
C
      IF (k50.EQ.1) THEN
         lreq = 0
         RETURN
      ENDIF
C
C     L information is always computed
C
      nbpanels_l = (nass / zmumps_ooc_panel_size(nbrow_l))+1
      lreq =    1               ! Store NASS
     &     + 1                  ! Store NBPANELS_L
     &     + nass               ! Store permutations
     &     + nbpanels_l         ! Store pointers on permutations
      IF (k50.eq.0) THEN
C
C     Also take U information into account
C
         nbpanels_u = (nass / zmumps_ooc_panel_size(nbcol_u) ) +1
         lreq = lreq + 1        ! Store NBPANELS_U
     &        + nass            ! Store permutations
     &        + nbpanels_u      ! Store pointers on permutations
      ENDIF
      RETURN
      END SUBROUTINE zmumps_ooc_get_pp_sizes
      SUBROUTINE zmumps_ooc_pp_check_perm_freed
     &           (iw_location, must_be_permuted)
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: IW_LOCATION
      LOGICAL, INTENT(INOUT) :: MUST_BE_PERMUTED
C
C     Purpose
C     =======
C
C     Reset MUST_BE_PERMUTED to .FALSE. when we detect
C     that the ZMUMPS_OOC_PP_TRY_RELEASE_SPACE has freed
C     the permutation information (see that routine).
C
      IF (iw_location .EQ. -7777) THEN
        must_be_permuted = .false.
      ENDIF
      RETURN
      END SUBROUTINE zmumps_ooc_pp_check_perm_freed