slr_type.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 smumps_lr_type
      IMPLICIT NONE
      TYPE lrb_type
        REAL,POINTER,DIMENSION(:,:) :: q => null()
        REAL,POINTER,DIMENSION(:,:) :: r => null()
        INTEGER :: k,m,n
        LOGICAL :: islr
      END TYPE lrb_type
      CONTAINS
      SUBROUTINE dealloc_lrb(LRB_OUT, KEEP8, K34
     &                       )
        TYPE(lrb_type), INTENT(INOUT) :: LRB_OUT
        INTEGER(8) :: KEEP8(150)
        INTEGER :: K34
        INTEGER :: MEM, IDUMMY, JDUMMY
        IF (lrb_out%M.EQ.0) RETURN
        IF (lrb_out%N.EQ.0) RETURN
        mem = 0
          IF (lrb_out%ISLR) THEN
            IF (associated(lrb_out%Q)) THEN
              mem = mem + size(lrb_out%Q)
              DEALLOCATE (lrb_out%Q)
              NULLIFY(lrb_out%Q)
            ENDIF
            IF (associated(lrb_out%R)) THEN
              mem = mem + size(lrb_out%R)
              DEALLOCATE (lrb_out%R)
              NULLIFY(lrb_out%R)
            ENDIF
          ELSE
            IF (associated(lrb_out%Q)) THEN
              mem = mem + size(lrb_out%Q)
              DEALLOCATE (lrb_out%Q)
              NULLIFY(lrb_out%Q)
            ENDIF
          ENDIF
        CALL mumps_dm_fac_upd_dyn_memcnts(-int(mem,8),
     &        .true., keep8, 
     &        idummy, jdummy,    
     &        .true., .true.)
      END SUBROUTINE dealloc_lrb
      SUBROUTINE dealloc_blr_panel(BLR_PANEL, IEND, KEEP8, K34, IBEG_IN)
        INTEGER, INTENT(IN)           :: IEND
        TYPE(lrb_type), INTENT(INOUT) :: BLR_PANEL(:)
        INTEGER(8) :: KEEP8(150)
        INTEGER, INTENT(IN) :: K34
        INTEGER, INTENT(IN), OPTIONAL :: IBEG_IN
        INTEGER :: I, IBEG
        IF (present(ibeg_in)) THEN
          ibeg = ibeg_in
        ELSE
          ibeg = 1
        ENDIF
        IF (iend.GE.ibeg) THEN
          IF (blr_panel(1)%M.NE.0) THEN
            DO i=ibeg, iend
              CALL dealloc_lrb(blr_panel(i), keep8, k34)
            ENDDO
          ENDIF
        ENDIF
      END SUBROUTINE dealloc_blr_panel
      END MODULE smumps_lr_type