dfac_mem_free_block_cb.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	dmumps_free_block_cb_static (ssarbr, myid, n, iposblock, iw, liw, lrlu, lrlus, iptrlu, iwposcb, la, keep, keep8, in_place_stats)

Function/Subroutine Documentation

dmumps_free_block_cb_static()

subroutine dmumps_free_block_cb_static	(	logical	ssarbr,
		integer	myid,
		integer	n,
		integer	iposblock,
		integer, dimension( liw )	iw,
		integer	liw,
		integer(8)	lrlu,
		integer(8)	lrlus,
		integer(8)	iptrlu,
		integer	iwposcb,
		integer(8)	la,
		integer, dimension(500)	keep,
		integer(8), dimension(150)	keep8,
		logical	in_place_stats )

Definition at line 14 of file dfac_mem_free_block_cb.F.

!$    USE OMP_LIB
      USE dmumps_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 dmumps_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 dmumps_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 dmumps_load_mem_update(ssarbr,.false.,
     &                la-lrlus,0_8,-sizfr_block_eff,keep,keep8,lrlus)
      END IF
      RETURN