zfac_mem_free_block_cb.F File Reference

Go to the source code of this file.

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

Function/Subroutine Documentation

zmumps_free_block_cb_static()

subroutine zmumps_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 zfac_mem_free_block_cb.F.

!$    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) )
.GT.      IF (DYNSIZE_BLOCK  0_8) THEN
        SIZFR_BLOCK_EFF = 0_8
.eq.      ELSE IF (KEEP(216)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
.NOT.      IF ( IN_PLACE_STATS) THEN
         LRLUS   = LRLUS + SIZFR_BLOCK_EFF
.EQ.         IF (KEEP(405)  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
.eq.      IF ( IPOSBLOCK  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)
.eq. 90      IF ( IWPOSCB  LIW ) GO TO 100
         IPOSSHIFT = IWPOSCB + KEEP(IXSZ)
         SIZFI = IW( IWPOSCB+1+XXI )
         CALL MUMPS_GETI8( SIZFR, IW(IWPOSCB+1+XXR) )
.EQ.         IF ( IW( IWPOSCB+1+XXS )  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