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 SUBROUTINE DMUMPS_FREE_BLOCK_CB(SSARBR, MYID, N, IPOSBLOCK, 14 & RPOSBLOCK, 15 & IW, LIW, 16 & LRLU, LRLUS, IPTRLU, 17 & IWPOSCB, LA, KEEP, KEEP8, IN_PLACE_STATS 18 & ) 19 USE DMUMPS_LOAD 20 IMPLICIT NONE 21 INTEGER(8) :: RPOSBLOCK 22 INTEGER IPOSBLOCK, 23 & LIW, IWPOSCB, N 24 INTEGER(8) :: LA, LRLU, LRLUS, IPTRLU 25 LOGICAL IN_PLACE_STATS 26 INTEGER IW( LIW ), KEEP(500) 27 INTEGER(8) KEEP8(150) 28 INTEGER MYID 29 LOGICAL SSARBR 30 INTEGER SIZFI_BLOCK, SIZFI 31 INTEGER IPOSSHIFT 32 INTEGER(8) :: SIZFR, SIZFR_BLOCK, SIZFR_BLOCK_EFF, 33 & SIZEHOLE, MEM_INC 34 INCLUDE 'mumps_headers.h' 35 IPOSSHIFT = IPOSBLOCK + KEEP(IXSZ) 36 SIZFI_BLOCK=IW(IPOSBLOCK+XXI) 37 CALL MUMPS_GETI8( SIZFR_BLOCK,IW(IPOSBLOCK+XXR) ) 38 IF (KEEP(216).eq.3) THEN 39 SIZFR_BLOCK_EFF=SIZFR_BLOCK 40 ELSE 41 CALL DMUMPS_SIZEFREEINREC( IW(IPOSBLOCK), 42 & LIW-IPOSBLOCK+1, 43 & SIZEHOLE, KEEP(IXSZ)) 44 SIZFR_BLOCK_EFF=SIZFR_BLOCK-SIZEHOLE 45 ENDIF 46 IF ( IPOSBLOCK .eq. IWPOSCB + 1 ) THEN 47 IPTRLU = IPTRLU + SIZFR_BLOCK 48 IWPOSCB = IWPOSCB + SIZFI_BLOCK 49 LRLU = LRLU + SIZFR_BLOCK 50 IF (.NOT. IN_PLACE_STATS) THEN 51 LRLUS = LRLUS + SIZFR_BLOCK_EFF 52 KEEP8(70) = KEEP8(70) + SIZFR_BLOCK_EFF 53 KEEP8(71) = KEEP8(71) + SIZFR_BLOCK_EFF 54 ENDIF 55 MEM_INC = -SIZFR_BLOCK_EFF 56 IF (IN_PLACE_STATS) THEN 57 MEM_INC= 0_8 58 ENDIF 59 CALL DMUMPS_LOAD_MEM_UPDATE(SSARBR,.FALSE., 60 & LA-LRLUS,0_8,MEM_INC,KEEP,KEEP8,LRLUS) 61 90 IF ( IWPOSCB .eq. LIW ) GO TO 100 62 IPOSSHIFT = IWPOSCB + KEEP(IXSZ) 63 SIZFI = IW( IWPOSCB+1+XXI ) 64 CALL MUMPS_GETI8( SIZFR,IW(IWPOSCB+1+XXR) ) 65 IF ( IW( IWPOSCB+1+XXS ) .EQ. S_FREE ) THEN 66 IPTRLU = IPTRLU + SIZFR 67 LRLU = LRLU + SIZFR 68 IWPOSCB = IWPOSCB + SIZFI 69 GO TO 90 70 ENDIF 71 100 CONTINUE 72 IW( IWPOSCB+1+XXP)=TOP_OF_STACK 73 ELSE 74 IW( IPOSBLOCK +XXS)=S_FREE 75 IF (.NOT. IN_PLACE_STATS) THEN 76 LRLUS = LRLUS + SIZFR_BLOCK_EFF 77 KEEP8(70) = KEEP8(70) + SIZFR_BLOCK_EFF 78 KEEP8(71) = KEEP8(71) + SIZFR_BLOCK_EFF 79 ENDIF 80 CALL DMUMPS_LOAD_MEM_UPDATE(SSARBR,.FALSE., 81 & LA-LRLUS,0_8,-SIZFR_BLOCK_EFF,KEEP,KEEP8,LRLUS) 82 END IF 83 RETURN 84 END SUBROUTINE DMUMPS_FREE_BLOCK_CB 85