zfac_mem_free_block_cb.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
      SUBROUTINE zmumps_free_block_cb_static(
     &       SSARBR, MYID, N, IPOSBLOCK,
     &       IW, LIW,
     &       LRLU, LRLUS, IPTRLU,
     &       IWPOSCB, LA, KEEP, KEEP8, IN_PLACE_STATS
     &     )
!$    USE OMP_LIB
      USE zmumps_load
      IMPLICIT NONE
      INTEGER IPOSBLOCK,
     &         LIW, IWPOSCB, N
      INTEGER(8) :: LA, LRLU, LRLUS, IPTRLU
      LOGICAL IN_PLACE_STATS
      INTEGER IW( LIW ), KEEP(500)
      INTEGER(8) KEEP8(150)
      INTEGER MYID
      LOGICAL SSARBR
      INTEGER SIZFI_BLOCK, SIZFI
      INTEGER IPOSSHIFT
      INTEGER(8) :: SIZFR, SIZFR_BLOCK, SIZFR_BLOCK_EFF,
     &              sizehole, mem_inc, dynsize_block
      include 'mumps_headers.h'
      iposshift = iposblock + keep(ixsz)
      sizfi_block=iw(iposblock+xxi)
      CALL mumps_geti8( sizfr_block, iw(iposblock+xxr) )
      CALL mumps_geti8( dynsize_block,iw(iposblock+xxd) )
      IF (dynsize_block .GT. 0_8) THEN
        sizfr_block_eff = 0_8
      ELSE IF (keep(216).eq.3 
     &    ) THEN
        sizfr_block_eff = sizfr_block
      ELSE
        CALL zmumps_sizefreeinrec( iw(iposblock),
     &                     liw-iposblock+1,
     &                     sizehole, keep(ixsz))
        sizfr_block_eff = sizfr_block - sizehole
      ENDIF
      IF (.NOT. in_place_stats) THEN
         lrlus   = lrlus + sizfr_block_eff
         IF (keep(405) .EQ. 0) THEN
           keep8(69) = keep8(69) - sizfr_block_eff
         ELSE
!$OMP      ATOMIC UPDATE
           keep8(69) = keep8(69) - sizfr_block_eff
!$OMP      END ATOMIC
         ENDIF
      ENDIF
      IF ( iposblock .eq. iwposcb + 1 ) THEN
         iptrlu  = iptrlu  + sizfr_block
         iwposcb = iwposcb + sizfi_block
         lrlu    = lrlu  + sizfr_block
         mem_inc = -sizfr_block_eff
         IF (in_place_stats) THEN
           mem_inc= 0_8
         ENDIF
         CALL zmumps_load_mem_update(ssarbr,.false.,
     &         la-lrlus,0_8,mem_inc,keep,keep8,lrlus)
 90      IF ( iwposcb .eq. liw ) GO TO 100
         iposshift = iwposcb + keep(ixsz)
         sizfi = iw( iwposcb+1+xxi )
         CALL mumps_geti8( sizfr, iw(iwposcb+1+xxr) )
         IF ( iw( iwposcb+1+xxs ) .EQ. s_free ) THEN
              iptrlu  = iptrlu + sizfr
              lrlu    = lrlu + sizfr
              iwposcb = iwposcb + sizfi
              GO TO 90
         ENDIF
 100     CONTINUE
         iw( iwposcb+1+xxp)=top_of_stack
      ELSE
         iw( iposblock +xxs)=s_free
         CALL zmumps_load_mem_update(ssarbr,.false.,
     &                la-lrlus,0_8,-sizfr_block_eff,keep,keep8,lrlus)
      END IF
      RETURN
      END SUBROUTINE zmumps_free_block_cb_static