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 CMUMPS_LR_TYPE 14 IMPLICIT NONE 15 TYPE LRB_TYPE 16 COMPLEX,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 CMUMPS_LR_TYPE 68