File: zlr_type.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 (67 lines) | stat: -rw-r--r-- 2,194 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
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 ZMUMPS_LR_TYPE
      IMPLICIT NONE
      TYPE LRB_TYPE
        COMPLEX(kind=8),POINTER,DIMENSION(:,:) :: Q,R
        INTEGER :: LRFORM,K,M,N,KSVD
        LOGICAL :: ISLR
      END TYPE LRB_TYPE
      CONTAINS
      SUBROUTINE DEALLOC_LRB(LRB_OUT,KEEP8,IS_FACTOR)
        TYPE(LRB_TYPE), INTENT(INOUT) :: LRB_OUT
        LOGICAL, INTENT(IN) :: IS_FACTOR
        INTEGER(8) :: KEEP8(150)
        INTEGER :: MEM
        MEM = 0
        IF (LRB_OUT%ISLR) THEN
           IF(associated(LRB_OUT%Q)) MEM = MEM + size(LRB_OUT%Q)
           IF(associated(LRB_OUT%R)) MEM = MEM + size(LRB_OUT%R)
        ELSE
           IF(associated(LRB_OUT%Q)) MEM = MEM + size(LRB_OUT%Q)
        ENDIF
        KEEP8(70) = KEEP8(70) + int(MEM,8)
        IF (.NOT.IS_FACTOR) THEN
          KEEP8(71) = KEEP8(71) + int(MEM,8)
        ENDIF
        IF (LRB_OUT%ISLR) THEN
          IF (associated(LRB_OUT%Q)) THEN
            DEALLOCATE (LRB_OUT%Q)
            NULLIFY(LRB_OUT%Q)
          ENDIF
          IF (associated(LRB_OUT%R)) THEN
            DEALLOCATE (LRB_OUT%R)
            NULLIFY(LRB_OUT%R)
          ENDIF
        ELSE
          IF (associated(LRB_OUT%Q)) THEN
            DEALLOCATE (LRB_OUT%Q)
            NULLIFY(LRB_OUT%Q)
          ENDIF
        ENDIF
      END SUBROUTINE DEALLOC_LRB
      SUBROUTINE DEALLOC_BLR_PANEL(BLR_PANEL, NB_BLR, KEEP8, IS_FACTOR)
        INTEGER, INTENT(IN)           :: NB_BLR
        TYPE(LRB_TYPE), INTENT(INOUT) :: BLR_PANEL(:) 
        INTEGER(8) :: KEEP8(150)
        LOGICAL, INTENT(IN) :: IS_FACTOR
        INTEGER :: I
        IF (NB_BLR.GT.0) THEN
          IF (BLR_PANEL(1)%M.NE.0) THEN
            DO I=1, NB_BLR
              CALL DEALLOC_LRB(BLR_PANEL(I), KEEP8, IS_FACTOR)
            ENDDO
          ENDIF
        ENDIF
      END SUBROUTINE DEALLOC_BLR_PANEL
      END MODULE ZMUMPS_LR_TYPE