File: lr_common.F

package info (click to toggle)
mumps 5.1.2-5
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 15,704 kB
  • sloc: fortran: 310,672; ansic: 12,364; xml: 521; makefile: 469
file content (82 lines) | stat: -rw-r--r-- 2,689 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
C
C  This file is part of MUMPS 5.1.2, released
C  on Mon Oct  2 07:37:01 UTC 2017
C
C
C  Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  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  http://www.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),
     &     NE_STEPS(NSTEPS)
      INTEGER, INTENT(INOUT) :: FILS(N), FRERE_STEPS(NSTEPS),
     &     DAD_STEPS(NSTEPS), STEP(N), PVS(NSTEPS), NA(LNA), 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