lr_common.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
      MODULE mumps_lr_common
      IMPLICIT NONE
      CONTAINS
      SUBROUTINE compute_blr_vcs(K472, IBCKSZ, MAXSIZE, NASS)
        INTEGER, INTENT(IN) :: MAXSIZE, NASS, K472
        INTEGER, INTENT(OUT) :: IBCKSZ
        IF (k472.EQ.1) THEN
          IF (nass.LE.1000) THEN
            ibcksz = 128
          ELSEIF (nass.GT.1000.AND.nass.LE.5000) THEN
            ibcksz = 256
          ELSEIF (nass.GT.5000.AND.nass.LE.10000) THEN
            ibcksz = 384
          ELSE
            ibcksz = 512
          ENDIF
          ibcksz = min(ibcksz,maxsize)
        ELSE
          ibcksz = maxsize
        ENDIF
      END SUBROUTINE compute_blr_vcs
      SUBROUTINE mumps_upd_tree(NV, NSTEPS, N, FIRST, LPTR, RPTR, F,
     &     VLIST, FILS, FRERE_STEPS, STEP, DAD_STEPS, NE_STEPS, NA, LNA,
     &     PVS, K38, STEP_SCALAPACK_ROOT)
      IMPLICIT NONE
      INTEGER, INTENT(IN)    :: N, NV, NSTEPS, LNA, F, VLIST(NV)
      INTEGER                :: FILS(:), FRERE_STEPS(:),
     &     dad_steps(:), step(:), ne_steps(:), na(:)
      INTEGER, INTENT(INOUT) :: PVS(NSTEPS), LPTR, RPTR
      INTEGER, INTENT(INOUT) :: K38
      INTEGER, INTENT(IN)    :: STEP_SCALAPACK_ROOT
      LOGICAL :: FIRST
      INTEGER :: PV, NODE, I
      pv        = vlist(1)
      node      = abs(step(pv))
      pvs(node) = pv
      IF(first) THEN
         i = dad_steps(node)
         DO WHILE(fils(i).GT.0)
            i = fils(i)
         END DO
         fils(i) = -pv
      END IF
      IF(frere_steps(node) .GT. 0) THEN
         frere_steps(node) = pvs(abs(step(frere_steps(node))))
      ELSE IF(frere_steps(node) .LT. 0) THEN
         frere_steps(node) = -pvs(abs(step(dad_steps(node))))
      END IF
      IF(dad_steps(node) .EQ. 0) THEN
         na(rptr) = pv
         rptr     = rptr -1
      ELSE
         dad_steps(node) = pvs(abs(step(dad_steps(node))))
      END IF
      IF(ne_steps(node) .EQ. 0) THEN
         na(lptr) = pv
         lptr     = lptr -1
      END IF
      step(vlist(1)) = abs(step(vlist(1)))
      IF (step(vlist(1)).EQ.step_scalapack_root) THEN
       k38 = vlist(1)
      ENDIF
      DO i=1, nv-1
         IF(step(vlist(i+1)).GT.0) step(vlist(i+1)) = -step(vlist(i+1))
         fils(vlist(i)) = vlist(i+1)
      END DO
      fils(vlist(nv)) = f
      RETURN
      END SUBROUTINE mumps_upd_tree
      END MODULE mumps_lr_common