1C
2C  This file is part of MUMPS 5.1.2, released
3C  on Mon Oct  2 07:37:01 UTC 2017
4C
5C
6C  Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C  University of Bordeaux.
8C
9C  This version of MUMPS is provided to you free of charge. It is
10C  released under the CeCILL-C license:
11C  http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html
12C
13      MODULE SMUMPS_LR_TYPE
14      IMPLICIT NONE
15      TYPE LRB_TYPE
16        REAL,POINTER,DIMENSION(:,:) :: Q,R
17        INTEGER :: LRFORM,K,M,N,KSVD
18        LOGICAL :: ISLR
19      END TYPE LRB_TYPE
20      CONTAINS
21      SUBROUTINE DEALLOC_LRB(LRB_OUT,KEEP8,IS_FACTOR)
22        TYPE(LRB_TYPE), INTENT(INOUT) :: LRB_OUT
23        LOGICAL, INTENT(IN) :: IS_FACTOR
24        INTEGER(8) :: KEEP8(150)
25        INTEGER :: MEM
26        MEM = 0
27        IF (LRB_OUT%ISLR) THEN
28           IF(associated(LRB_OUT%Q)) MEM = MEM + size(LRB_OUT%Q)
29           IF(associated(LRB_OUT%R)) MEM = MEM + size(LRB_OUT%R)
30        ELSE
31           IF(associated(LRB_OUT%Q)) MEM = MEM + size(LRB_OUT%Q)
32        ENDIF
33        KEEP8(70) = KEEP8(70) + int(MEM,8)
34        IF (.NOT.IS_FACTOR) THEN
35          KEEP8(71) = KEEP8(71) + int(MEM,8)
36        ENDIF
37        IF (LRB_OUT%ISLR) THEN
38          IF (associated(LRB_OUT%Q)) THEN
39            DEALLOCATE (LRB_OUT%Q)
40            NULLIFY(LRB_OUT%Q)
41          ENDIF
42          IF (associated(LRB_OUT%R)) THEN
43            DEALLOCATE (LRB_OUT%R)
44            NULLIFY(LRB_OUT%R)
45          ENDIF
46        ELSE
47          IF (associated(LRB_OUT%Q)) THEN
48            DEALLOCATE (LRB_OUT%Q)
49            NULLIFY(LRB_OUT%Q)
50          ENDIF
51        ENDIF
52      END SUBROUTINE DEALLOC_LRB
53      SUBROUTINE DEALLOC_BLR_PANEL(BLR_PANEL, NB_BLR, KEEP8, IS_FACTOR)
54        INTEGER, INTENT(IN)           :: NB_BLR
55        TYPE(LRB_TYPE), INTENT(INOUT) :: BLR_PANEL(:)
56        INTEGER(8) :: KEEP8(150)
57        LOGICAL, INTENT(IN) :: IS_FACTOR
58        INTEGER :: I
59        IF (NB_BLR.GT.0) THEN
60          IF (BLR_PANEL(1)%M.NE.0) THEN
61            DO I=1, NB_BLR
62              CALL DEALLOC_LRB(BLR_PANEL(I), KEEP8, IS_FACTOR)
63            ENDDO
64          ENDIF
65        ENDIF
66      END SUBROUTINE DEALLOC_BLR_PANEL
67      END MODULE SMUMPS_LR_TYPE
68