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 SMUMPS_COMPRESS_LU(SIZE_INPLACE, 14 &MYID,N,IOLDPS,TYPE,IW, LIW, A, LA, 15 &POSFAC, LRLU, LRLUS, IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8, 16 &SSARBR,INODE,IERR 17 & , LRGROUPS, NASS 18 &) 19 USE SMUMPS_LOAD 20 USE SMUMPS_OOC 21 USE SMUMPS_LR_CORE 22 IMPLICIT NONE 23 INTEGER MYID 24 INTEGER IOLDPS, TYPE, LIW, N, KEEP(500) 25 INTEGER(8) :: SIZE_INPLACE, LA, POSFAC, LRLU, LRLUS 26 INTEGER(8) :: PTRAST(KEEP(28)) 27 INTEGER(8) KEEP8(150) 28 INTEGER IW( LIW ) 29 REAL A( LA ) 30 INTEGER IWPOS, LDLT 31 INTEGER STEP( N ) 32 INTEGER (8) :: PTRFAC(KEEP(28)) 33 LOGICAL SSARBR 34 INTEGER IOLDSHIFT, IPSSHIFT 35 INTEGER LRGROUPS(N), NASS 36 INCLUDE 'mumps_headers.h' 37 INTEGER LCONT, NELIM, NROW, NPIV, INTSIZ 38 INTEGER NFRONT, NSLAVES 39 INTEGER IPS, IPSIZE 40 INTEGER(8) :: SIZELU, SIZECB, IAPOS, I 41 LOGICAL MOVEPTRAST 42 LOGICAL LRCOMPRESS_PANEL 43 INTEGER INODE 44 INTEGER IERR 45 IERR=0 46 LDLT = KEEP(50) 47 IOLDSHIFT = IOLDPS + KEEP(IXSZ) 48 IF ( IW( IOLDSHIFT ) < 0 ) THEN 49 write(*,*) ' ERROR 1 compressLU:Should not point to a band.' 50 CALL MUMPS_ABORT() 51 ELSE IF ( IW( IOLDSHIFT + 2 ) < 0 ) THEN 52 write(*,*) ' ERROR 2 compressLU:Stack not performed yet', 53 & IW(IOLDSHIFT + 2) 54 CALL MUMPS_ABORT() 55 ENDIF 56 LCONT = IW( IOLDSHIFT ) 57 NELIM = IW( IOLDSHIFT + 1 ) 58 NROW = IW( IOLDSHIFT + 2 ) 59 NPIV = IW( IOLDSHIFT + 3 ) 60 IAPOS = PTRFAC(IW( IOLDSHIFT + 4 )) 61 NSLAVES= IW( IOLDSHIFT + 5 ) 62 NFRONT = LCONT + NPIV 63 INTSIZ = IW(IOLDPS+XXI) 64 LRCOMPRESS_PANEL = (IW(IOLDPS+XXLR).GE.2) 65 IF ( (NSLAVES > 0 .AND. TYPE .NE. 2) .OR. 66 & (NSLAVES .eq. 0 .AND. TYPE .EQ. 2 ) ) THEN 67 WRITE(*,*) ' ERROR 3 compressLU: problem with level of inode' 68 CALL MUMPS_ABORT() 69 END IF 70 IF (LDLT.EQ.0) THEN 71 SIZELU = int(LCONT + NROW, 8) * int(NPIV,8) 72 ELSE 73 SIZELU = int(NROW,8) * int(NPIV,8) 74 ENDIF 75 IF ( TYPE .EQ. 2 ) THEN 76 IF (LDLT.EQ.0) THEN 77 SIZECB = int(NELIM,8) * int(LCONT,8) 78 ELSE 79 IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN 80 SIZECB = int(NELIM+1,8) * int(NELIM + NPIV,8) 81 ELSE 82 SIZECB = int(NELIM,8) * int(NELIM + NPIV,8) 83 ENDIF 84 ENDIF 85 ELSE 86 IF (LDLT.EQ.0) THEN 87 SIZECB = int(LCONT,8) * int(LCONT,8) 88 ELSE 89 SIZECB = int(NROW,8) * int(LCONT,8) 90 ENDIF 91 END IF 92 CALL MUMPS_SUBTRI8TOARRAY( IW(IOLDPS+XXR), SIZECB ) 93 IF ((SIZECB.EQ.0_8).AND.(KEEP(201).EQ.0)) THEN 94 GOTO 500 95 ENDIF 96 IF (KEEP(201).EQ.2) THEN 97 KEEP8(31)=KEEP8(31)+SIZELU 98 CALL SMUMPS_NEW_FACTOR(INODE,PTRFAC,KEEP,KEEP8, 99 & A,LA,SIZELU, IERR) 100 IF(IERR.LT.0)THEN 101 WRITE(*,*)MYID,': Internal error in SMUMPS_NEW_FACTOR' 102 CALL MUMPS_ABORT() 103 ENDIF 104 ENDIF 105 IF ( IOLDPS + INTSIZ .NE. IWPOS ) THEN 106 IPS = IOLDPS + INTSIZ 107 MOVEPTRAST = .FALSE. 108 DO WHILE ( IPS .NE. IWPOS ) 109 IPSIZE = IW(IPS+XXI) 110 IPSSHIFT = IPS + KEEP(IXSZ) 111 IF ( IW( IPSSHIFT + 2 ) < 0 ) THEN 112 NFRONT = IW( IPSSHIFT ) 113 IF(KEEP(201).EQ.0)THEN 114 PTRFAC(IW( IPSSHIFT + 4 )) = 115 & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB 116 ELSE 117 PTRFAC(IW(IPSSHIFT+4))=PTRFAC(IW(IPSSHIFT+4)) - 118 & SIZECB - SIZELU 119 ENDIF 120 MOVEPTRAST = .TRUE. 121 IF(KEEP(201).EQ.0)THEN 122 PTRAST(IW(IPSSHIFT+4))=PTRAST(IW(IPSSHIFT+4))-SIZECB 123 ELSE 124 PTRAST(IW(IPSSHIFT+4))=PTRAST(IW(IPSSHIFT+4))-SIZECB 125 & - SIZELU 126 ENDIF 127 ELSE IF ( IW( IPSSHIFT ) < 0 ) THEN 128 IF(KEEP(201).EQ.0)THEN 129 PTRFAC(IW(IPSSHIFT+3)) = PTRFAC(IW(IPSSHIFT+3))-SIZECB 130 ELSE 131 PTRFAC(IW(IPSSHIFT+3)) = PTRFAC(IW(IPSSHIFT+3)) 132 & -SIZECB-SIZELU 133 ENDIF 134 ELSE 135 NFRONT = IW( IPSSHIFT ) + IW( IPSSHIFT + 3 ) 136 IF(KEEP(201).EQ.0)THEN 137 PTRFAC(IW( IPSSHIFT + 4 )) = 138 & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB 139 ELSE 140 PTRFAC(IW( IPSSHIFT + 4 )) = 141 & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB 142 & - SIZELU 143 ENDIF 144 END IF 145 IPS = IPS + IPSIZE 146 END DO 147 IF ((SIZECB .NE. 0_8).OR.(KEEP(201).NE.0)) THEN 148 IF (KEEP(201).NE.0) THEN 149 DO I=IAPOS, POSFAC - SIZECB - SIZELU - 1_8 150 A( I ) = A( I + SIZECB + SIZELU) 151 END DO 152 ELSE 153 DO I=IAPOS + SIZELU, POSFAC - SIZECB - 1_8 154 A( I ) = A( I + SIZECB ) 155 END DO 156 ENDIF 157 END IF 158 ENDIF 159 IF (KEEP(201).NE.0) THEN 160 POSFAC = POSFAC - (SIZECB+SIZELU) 161 LRLU = LRLU + (SIZECB+SIZELU) 162 LRLUS = LRLUS + (SIZECB+SIZELU) - SIZE_INPLACE 163 KEEP8(70) = KEEP8(70) + (SIZECB+SIZELU) - SIZE_INPLACE 164 KEEP8(71) = KEEP8(71) + (SIZECB+SIZELU) - SIZE_INPLACE 165 ELSE 166 POSFAC = POSFAC - SIZECB 167 LRLU = LRLU + SIZECB 168 LRLUS = LRLUS + SIZECB - SIZE_INPLACE 169 KEEP8(70) = KEEP8(70) + SIZECB - SIZE_INPLACE 170 KEEP8(71) = KEEP8(71) + SIZECB - SIZE_INPLACE 171 IF (LRCOMPRESS_PANEL) THEN 172 KEEP8(71) = KEEP8(71) + SIZELU 173 ENDIF 174 ENDIF 175 500 CONTINUE 176 CALL SMUMPS_LOAD_MEM_UPDATE(SSARBR,.FALSE., 177 & LA-LRLUS,SIZELU,-SIZECB+SIZE_INPLACE,KEEP,KEEP8,LRLUS) 178 RETURN 179 END SUBROUTINE SMUMPS_COMPRESS_LU 180 SUBROUTINE SMUMPS_STACK_BAND( N, ISON, 181 & PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA, 182 & LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, 183 & IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, 184 & IFLAG, IERROR, SLAVEF, MYID, COMM, 185 & KEEP, KEEP8, DKEEP, TYPE_SON 186 & ) 187 USE SMUMPS_OOC 188 USE SMUMPS_LOAD 189 IMPLICIT NONE 190 INTEGER(8) :: LA, LRLU, LRLUS, POSFAC, IPTRLU 191 INTEGER N, ISON, LIW, IWPOS, IWPOSCB, 192 & COMP, IFLAG, IERROR, SLAVEF, MYID, COMM, 193 & TYPE_SON 194 INTEGER KEEP(500) 195 INTEGER(8) KEEP8(150) 196 REAL DKEEP(230) 197 INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28)) 198 INTEGER PTRIST(KEEP(28)), STEP(N), 199 & PIMASTER(KEEP(28)), IW(LIW) 200 INTEGER PTLUST_S(KEEP(28)) 201 INTEGER(8) :: PTRFAC(KEEP(28)) 202 DOUBLE PRECISION OPELIW 203 DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE 204 REAL A( LA ) 205 INTEGER(8) :: LREQA, POSA, POSALOC, OLDPOS, JJ 206 INTEGER NFRONT, NCOL_L, NROW_L, LREQI, NSLAVES_L, 207 & POSI, I, IROW_L, ICOL_L, LDA_BAND, NASS 208 LOGICAL NONEED_TO_COPY_FACTORS 209 INTEGER(8) :: LAFAC, LREQA_HEADER 210 INTEGER LIWFAC, STRAT, TYPEFile, NextPivDummy, 211 & IOLDPS_CB 212 LOGICAL LAST_CALL 213 TYPE(IO_BLOCK) :: MonBloc 214 INTEGER LRSTATUS 215 INCLUDE 'mumps_headers.h' 216 DOUBLE PRECISION ZERO 217 PARAMETER (ZERO=0.0d0) 218 FLOP1 = ZERO 219 NCOL_L = IW( PTRIST(STEP( ISON )) + 3 + KEEP(IXSZ) ) 220 NROW_L = IW( PTRIST(STEP( ISON )) + 2 + KEEP(IXSZ) ) 221 NSLAVES_L = IW( PTRIST(STEP( ISON )) + 5 + KEEP(IXSZ) ) 222 LRSTATUS = IW( PTRIST(STEP( ISON )) + XXLR) 223 LDA_BAND = NCOL_L + IW( PTRIST(STEP( ISON )) + KEEP(IXSZ) ) 224 IF ( KEEP(50) .eq. 0 ) THEN 225 NFRONT = LDA_BAND 226 ELSE 227 NFRONT = IW( PTRIST(STEP( ISON )) + 7 + KEEP(IXSZ) ) 228 END IF 229 IF (KEEP(201).EQ.1) THEN 230 IOLDPS_CB = PTRIST(STEP( ISON )) 231 CALL MUMPS_GETI8(LAFAC, IW(IOLDPS_CB+XXR)) 232 LIWFAC = IW(IOLDPS_CB+XXI) 233 TYPEFile = TYPEF_L 234 NextPivDummy = -8888 235 MonBloc%INODE = ISON 236 MonBloc%MASTER = .FALSE. 237 MonBloc%Typenode = 2 238 MonBloc%NROW = NROW_L 239 MonBloc%NCOL = LDA_BAND 240 MonBloc%NFS = IW(IOLDPS_CB+1+KEEP(IXSZ)) 241 MonBloc%LastPiv = NCOL_L 242 MonBloc%LastPanelWritten_L=-9999 243 MonBloc%LastPanelWritten_U=-9999 244 NULLIFY(MonBloc%INDICES) 245 STRAT = STRAT_WRITE_MAX 246 LAST_CALL = .TRUE. 247 MonBloc%Last = .TRUE. 248 CALL SMUMPS_OOC_IO_LU_PANEL 249 & ( STRAT, TYPEFile, 250 & A(PTRAST(STEP(ISON))), LAFAC, MonBloc, 251 & NextPivDummy, NextPivDummy, 252 & IW(IOLDPS_CB), LIWFAC, 253 & MYID, KEEP8(31), IFLAG,LAST_CALL ) 254 IF ((NCOL_L.EQ.0).OR.(NROW_L.EQ.0)) THEN 255 ENDIF 256 ENDIF 257 NONEED_TO_COPY_FACTORS = (KEEP(201).EQ.1) .OR. (KEEP(201).EQ.-1) 258 IF ((NCOL_L.EQ.0).OR.(NROW_L.EQ.0)) THEN 259 GOTO 80 260 ENDIF 261 LREQI = 4 + NCOL_L + NROW_L + KEEP(IXSZ) 262 LREQA_HEADER = int(NCOL_L,8) * int(NROW_L,8) 263 IF (NONEED_TO_COPY_FACTORS) THEN 264 LREQA = 0_8 265 ELSE 266 LREQA = LREQA_HEADER 267 ENDIF 268 IF ( LRLU .LT. LREQA .OR. 269 & IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN 270 IF ( LRLUS .LT. LREQA ) THEN 271 IFLAG = -9 272 CALL MUMPS_SET_IERROR(LREQA - LRLUS, IERROR) 273 GO TO 700 274 END IF 275 CALL SMUMPS_COMPRE_NEW( N,KEEP(28), IW, LIW, A, LA, 276 & LRLU, IPTRLU, 277 & IWPOS,IWPOSCB, PTRIST, PTRAST, 278 & STEP, PIMASTER, PAMASTER, KEEP(216),LRLUS, 279 & KEEP(IXSZ), COMP, DKEEP(97), MYID ) 280 IF ( LRLU .NE. LRLUS ) THEN 281 WRITE(*,*) 'PB compress SMUMPS_STACK_BAND:LRLU,LRLUS=', 282 & LRLU, LRLUS 283 IFLAG = -9 284 CALL MUMPS_SET_IERROR(LREQA - LRLUS, IERROR) 285 GOTO 700 286 END IF 287 IF ( IWPOS + LREQI - 1 .GT. IWPOSCB ) THEN 288 IFLAG = -8 289 IERROR = IWPOS + LREQI - 1 - IWPOSCB 290 GOTO 700 291 END IF 292 END IF 293 IF (.NOT. NONEED_TO_COPY_FACTORS) THEN 294 POSA = POSFAC 295 POSFAC = POSFAC + LREQA 296 LRLU = LRLU - LREQA 297 LRLUS = LRLUS - LREQA 298 KEEP8(67) = min(LRLUS, KEEP8(67)) 299 KEEP8(70) = KEEP8(70) - LREQA 300 KEEP8(68) = min(KEEP8(70), KEEP8(68)) 301 IF(KEEP(201).NE.2)THEN 302 CALL SMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE., 303 & LA-LRLUS,LREQA,LREQA,KEEP,KEEP8,LRLUS) 304 ELSE 305 CALL SMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE., 306 & LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLUS) 307 ENDIF 308 ENDIF 309 POSI = IWPOS 310 IWPOS = IWPOS + LREQI 311 PTLUST_S(STEP( ISON )) = POSI 312 IW(POSI+XXI)=LREQI 313 CALL MUMPS_STOREI8(LREQA, IW(POSI+XXR)) 314 CALL MUMPS_STOREI8(LREQA_HEADER, IW(POSI+XXR)) 315 IW(POSI+XXS)=-9999 316 IW(POSI+XXS+1:POSI+KEEP(IXSZ)-1)=-99999 317 IW(POSI+XXLR) = LRSTATUS 318 POSI=POSI+KEEP(IXSZ) 319 IW( POSI ) = - NCOL_L 320 IW( POSI + 1 ) = NROW_L 321 IW( POSI + 2 ) = NFRONT - NCOL_L 322 IW( POSI + 3 ) = STEP(ISON) 323 IF (.NOT. NONEED_TO_COPY_FACTORS) THEN 324 PTRFAC(STEP(ISON)) = POSA 325 ELSE 326 PTRFAC(STEP(ISON)) = -77777_8 327 ENDIF 328 IROW_L = PTRIST(STEP(ISON)) + 6 + NSLAVES_L + KEEP(IXSZ) 329 ICOL_L = PTRIST(STEP(ISON)) + 6 + NROW_L + NSLAVES_L + KEEP(IXSZ) 330 DO I = 1, NROW_L 331 IW( POSI+3+I ) = IW( IROW_L+I-1 ) 332 ENDDO 333 DO I = 1, NCOL_L 334 IW( POSI+NROW_L+3+I) = IW( ICOL_L+I-1 ) 335 ENDDO 336 IF (.NOT.NONEED_TO_COPY_FACTORS) THEN 337 POSALOC = POSA 338 DO I = 1, NROW_L 339 OLDPOS = PTRAST( STEP(ISON)) + int(I-1,8)*int(LDA_BAND,8) 340 DO JJ = 0_8, int(NCOL_L-1,8) 341 A( POSALOC+JJ ) = A( OLDPOS+JJ ) 342 ENDDO 343 POSALOC = POSALOC + int(NCOL_L,8) 344 END DO 345 ENDIF 346 IF (KEEP(201).EQ.2) THEN 347 KEEP8(31)=KEEP8(31)+LREQA 348 ENDIF 349 KEEP8(10) = KEEP8(10) + int(NCOL_L,8) * int(NROW_L,8) 350 IF (KEEP(201).EQ.2) THEN 351 CALL SMUMPS_NEW_FACTOR(ISON,PTRFAC,KEEP,KEEP8,A,LA,LREQA,IFLAG) 352 IF(IFLAG.LT.0)THEN 353 WRITE(*,*)MYID,': Internal error in SMUMPS_NEW_FACTOR' 354 IERROR=0 355 GOTO 700 356 ENDIF 357 POSFAC = POSFAC - LREQA 358 LRLU = LRLU + LREQA 359 LRLUS = LRLUS + LREQA 360 KEEP8(70) = KEEP8(70) + LREQA 361 KEEP8(71) = KEEP8(71) + LREQA 362 CALL SMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE., 363 & LA-LRLUS,LREQA,0_8,KEEP,KEEP8,LRLUS) 364 ENDIF 365 80 CONTINUE 366 IF (TYPE_SON == 1) THEN 367 GOTO 90 368 ENDIF 369 IF ( KEEP(50) .eq. 0 ) THEN 370 FLOP1 = dble( NCOL_L * NROW_L) + 371 & dble(NROW_L*NCOL_L)*dble(2*NFRONT-NCOL_L-1) 372 ELSE 373 FLOP1 = dble( NCOL_L ) * dble( NROW_L ) 374 & * dble( 2 * LDA_BAND - NROW_L - NCOL_L + 1) 375 END IF 376 OPELIW = OPELIW + FLOP1 377 FLOP1_EFFECTIVE = FLOP1 378 NASS = IW( PTRIST(STEP( ISON )) + 4 + KEEP(IXSZ) ) 379 IF ( NCOL_L .NE. NASS ) THEN 380 IF ( KEEP(50).eq.0 ) THEN 381 FLOP1 = dble( NASS * NROW_L) + 382 & dble(NROW_L*NASS)*dble(2*NFRONT-NASS-1) 383 ELSE 384 FLOP1 = dble( NASS ) * dble( NROW_L ) * 385 & dble( 2 * LDA_BAND - NROW_L - NASS + 1) 386 END IF 387 END IF 388 CALL SMUMPS_LOAD_UPDATE(1,.FALSE.,FLOP1_EFFECTIVE-FLOP1, 389 & KEEP,KEEP8) 390 CALL SMUMPS_LOAD_UPDATE(2,.FALSE.,-FLOP1,KEEP,KEEP8) 391 90 CONTINUE 392 RETURN 393 700 CONTINUE 394 CALL SMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP ) 395 RETURN 396 END SUBROUTINE SMUMPS_STACK_BAND 397 SUBROUTINE SMUMPS_FREE_BAND( N, ISON, 398 & PTRIST, PTRAST, IW, LIW, A, LA, 399 & LRLU, LRLUS, IWPOSCB, 400 & IPTRLU, STEP, MYID, KEEP, KEEP8, TYPE_SON 401 & ) 402 IMPLICIT NONE 403 include 'mumps_headers.h' 404 INTEGER(8) :: LRLU, LRLUS, IPTRLU, LA 405 INTEGER ISON, MYID, N, IWPOSCB, TYPE_SON 406 INTEGER KEEP(500), STEP(N) 407 INTEGER(8) KEEP8(150) 408 INTEGER(8) :: PTRAST(KEEP(28)) 409 INTEGER PTRIST(KEEP(28)) 410 INTEGER LIW 411 INTEGER IW(LIW) 412 REAL A(LA) 413 INTEGER ISTCHK 414 ISTCHK = PTRIST(STEP(ISON)) 415 CALL SMUMPS_FREE_BLOCK_CB(.FALSE.,MYID, N, ISTCHK, 416 & PTRAST(STEP(ISON)), 417 & IW, LIW, LRLU, LRLUS, IPTRLU, 418 & IWPOSCB, LA, KEEP,KEEP8, .FALSE. 419 & ) 420 PTRIST(STEP( ISON )) = -9999888 421 PTRAST(STEP( ISON )) = -9999888_8 422 RETURN 423 END SUBROUTINE SMUMPS_FREE_BAND 424 SUBROUTINE SMUMPS_MAX_MEM( KEEP,KEEP8, 425 & MYID, N, NELT, NA, LNA, NNZ8, NA_ELT8, NSLAVES, 426 & MEMORY_MBYTES, EFF, OOC_STRAT, PERLU_ON, 427 & MEMORY_BYTES ) 428 IMPLICIT NONE 429 LOGICAL, INTENT(IN) :: EFF, PERLU_ON 430 INTEGER, INTENT(IN) :: OOC_STRAT 431 INTEGER KEEP(500) 432 INTEGER(8) KEEP8(150) 433 INTEGER MYID, N, NELT, NSLAVES, LNA 434 INTEGER(8) :: NA_ELT8, NNZ8 435 INTEGER(8), INTENT(IN) :: NA(LNA) 436 INTEGER(8), INTENT(OUT) :: MEMORY_BYTES 437 INTEGER, INTENT(OUT) :: MEMORY_MBYTES 438 INTEGER :: MUMPS_GET_POOL_LENGTH 439 EXTERNAL :: MUMPS_GET_POOL_LENGTH 440 LOGICAL :: I_AM_SLAVE, I_AM_MASTER 441 INTEGER :: PERLU, NBRECORDS 442 INTEGER(8) :: NB_REAL, MAXS_MIN 443 INTEGER(8) :: TEMP, NB_BYTES, NB_INT 444 INTEGER :: SMUMPS_LBUF_INT 445 INTEGER(8) :: SMUMPS_LBUFR_BYTES8, SMUMPS_LBUF8 446 INTEGER :: NBUFS 447 INTEGER(8) :: TEMPI 448 INTEGER(8) :: TEMPR 449 INTEGER :: MIN_PERLU 450 INTEGER(8) :: BUF_OOC, BUF_OOC_PANEL, BUF_OOC_NOPANEL 451 INTEGER(8) :: OOC_NB_FILE_TYPE 452 INTEGER(8) :: NSTEPS8, N8, NELT8 453 INTEGER(8) :: I8OVERI 454 I8OVERI = int(KEEP(10),8) 455 PERLU = KEEP(12) 456 NSTEPS8 = int(KEEP(28),8) 457 N8 = int(N,8) 458 NELT8 = int(NELT,8) 459 IF (.NOT.PERLU_ON) PERLU = 0 460 I_AM_MASTER = ( MYID .eq. 0 ) 461 I_AM_SLAVE = ( KEEP(46).eq. 1 .or. MYID .ne. 0 ) 462 TEMP = 0_8 463 NB_REAL = 0_8 464 NB_BYTES = 0_8 465 NB_INT = 0_8 466 IF (KEEP(235) .NE. 0 .OR. KEEP(237) .NE. 0) THEN 467 NB_INT = NB_INT + NSTEPS8 468 ENDIF 469 NB_INT = NB_INT + 5_8 * NSTEPS8 470 NB_INT = NB_INT + NSTEPS8 + int(KEEP(56),8)*int(NSLAVES+2,8) 471 NB_INT = NB_INT + 3_8 * N8 472 IF (KEEP(23).ne.0 .and. I_AM_MASTER) NB_INT=NB_INT + N8 473 IF (KEEP(55).eq.0) THEN 474 NB_INT = NB_INT + 2_8 * N8 475 ELSE 476 NB_INT = NB_INT + 2_8 * ( NELT8 + 1_8 ) 477 ENDIF 478 IF (KEEP(55) .ne. 0 ) THEN 479 NB_INT = NB_INT + N8 + 1_8 + NELT8 480 END IF 481 NB_INT = NB_INT + int(LNA,8) 482 IF ( OOC_STRAT .GT. 0 .OR. OOC_STRAT .EQ. -1 ) THEN 483 MAXS_MIN = KEEP8(14) 484 ELSE 485 MAXS_MIN = KEEP8(12) 486 ENDIF 487 IF ( .NOT. EFF ) THEN 488 IF ( KEEP8(24).EQ.0_8 ) THEN 489 NB_REAL = NB_REAL + MAXS_MIN + 490 & int(PERLU,8)*(MAXS_MIN / 100_8 + 1_8 ) 491 ENDIF 492 ELSE 493 NB_REAL = NB_REAL + KEEP8(67) 494 ENDIF 495 IF ( OOC_STRAT .GT. 0 .AND. I_AM_SLAVE ) THEN 496 BUF_OOC_NOPANEL = 2_8 * KEEP8(119) 497 IF (KEEP(50).EQ.0)THEN 498 BUF_OOC_PANEL = 8_8 * int(KEEP(226),8) 499 ELSE 500 BUF_OOC_PANEL = 4_8 * int(KEEP(226),8) 501 ENDIF 502 IF (OOC_STRAT .EQ. 2) THEN 503 BUF_OOC = BUF_OOC_NOPANEL 504 ELSE 505 BUF_OOC = BUF_OOC_PANEL 506 ENDIF 507 NB_REAL = NB_REAL + min(BUF_OOC + int(max(PERLU,0),8) * 508 & (BUF_OOC/100_8+1_8),12000000_8) 509 IF (OOC_STRAT .EQ. 2) THEN 510 OOC_NB_FILE_TYPE = 1_8 511 ELSE 512 IF (KEEP(50).EQ.0) THEN 513 OOC_NB_FILE_TYPE = 2_8 514 ELSE 515 OOC_NB_FILE_TYPE = 1_8 516 ENDIF 517 ENDIF 518 NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI 519 NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 * I8OVERI 520 NB_INT = NB_INT + OOC_NB_FILE_TYPE * NSTEPS8 521 ENDIF 522 NB_REAL = NB_REAL + KEEP8(26) 523 IF (KEEP(252).EQ.1 .AND. .NOT. I_AM_MASTER) THEN 524 NB_REAL = NB_REAL + N8 525 ENDIF 526 IF ( .not. ( I_AM_SLAVE .and. I_AM_MASTER .and. KEEP(52) .eq. 0 527 & .and. KEEP(55) .ne. 0 ) ) THEN 528 NB_INT = NB_INT + KEEP8(27) 529 END IF 530 IF ( I_AM_SLAVE .and. KEEP(38) .ne. 0 ) THEN 531 NB_INT = NB_INT + 2_8 * N8 532 END IF 533 TEMPI= 0_8 534 TEMPR = 0_8 535 NBRECORDS = KEEP(39) 536 IF (KEEP(55).eq.0) THEN 537 IF (NNZ8 < int(NBRECORDS,8)) THEN 538 NBRECORDS=int(NNZ8) 539 ENDIF 540 ELSE 541 IF (NA_ELT8 < int(NBRECORDS,8)) THEN 542 NBRECORDS=int(NA_ELT8) 543 ENDIF 544 ENDIF 545 IF ( KEEP(54) .eq. 0 ) THEN 546 IF ( I_AM_MASTER ) THEN 547 IF ( KEEP(46) .eq. 0 ) THEN 548 NBUFS = NSLAVES 549 ELSE 550 NBUFS = NSLAVES - 1 551 IF (KEEP(55) .eq. 0 ) 552 & TEMPI = TEMPI + 2_8 * N8 553 END IF 554 TEMPI = TEMPI + 2_8 * int(NBRECORDS,8) * int(NBUFS,8) 555 TEMPR = TEMPR + int(NBRECORDS,8) * int(NBUFS,8) 556 ELSE 557 IF ( KEEP(55) .eq. 0 )THEN 558 TEMPI = TEMPI + 2_8 * int(NBRECORDS,8) 559 TEMPR = TEMPR + int(NBRECORDS,8) 560 END IF 561 END IF 562 ELSE 563 IF ( I_AM_SLAVE ) THEN 564 TEMPI = TEMPI + int(1+4*NSLAVES,8) * int(NBRECORDS,8) 565 TEMPR = TEMPR + int(1+2*NSLAVES,8) * int(NBRECORDS,8) 566 END IF 567 END IF 568 TEMP = max( NB_BYTES + (NB_INT + TEMPI) * int(KEEP(34),8) 569 & + (NB_REAL+TEMPR) * int(KEEP(35),8) 570 & , TEMP ) 571 IF ( I_AM_SLAVE ) THEN 572 SMUMPS_LBUFR_BYTES8 = int(KEEP(44),8) * int(KEEP(35),8) 573 SMUMPS_LBUFR_BYTES8 = max( SMUMPS_LBUFR_BYTES8, 574 & 100000_8 ) 575 IF (KEEP(48).EQ.5) THEN 576 MIN_PERLU=2 577 ELSE 578 MIN_PERLU=0 579 ENDIF 580 SMUMPS_LBUFR_BYTES8 = SMUMPS_LBUFR_BYTES8 581 & + int( 2.0E0 * real(max(PERLU,MIN_PERLU))* 582 & real(SMUMPS_LBUFR_BYTES8)/100E0,8) 583 SMUMPS_LBUFR_BYTES8 = min(SMUMPS_LBUFR_BYTES8, 584 & int(huge (KEEP(43))-100,8)) 585 NB_BYTES = NB_BYTES + SMUMPS_LBUFR_BYTES8 586 SMUMPS_LBUF8 = int( real(KEEP(213)) / 100.0E0 587 & * real(KEEP( 43 ) * KEEP( 35 )), 8 ) 588 SMUMPS_LBUF8 = max( SMUMPS_LBUF8, 100000_8 ) 589 SMUMPS_LBUF8 = SMUMPS_LBUF8 590 & + int( 2.0E0 * real(max(PERLU,MIN_PERLU))* 591 & real(SMUMPS_LBUF8)/100E0, 8) 592 SMUMPS_LBUF8 = min(SMUMPS_LBUF8, int(huge (KEEP(43)-100),8)) 593 SMUMPS_LBUF8 = max(SMUMPS_LBUF8, SMUMPS_LBUFR_BYTES8+ 594 & 3_8*int(KEEP(34),8)) 595 NB_BYTES = NB_BYTES + SMUMPS_LBUF8 596 SMUMPS_LBUF_INT = ( KEEP(56) + 597 & NSLAVES * NSLAVES ) * 5 598 & * KEEP(34) 599 NB_BYTES = NB_BYTES + int(SMUMPS_LBUF_INT,8) 600 IF ( EFF ) THEN 601 IF (OOC_STRAT .GT. 0) THEN 602 NB_INT = NB_INT + int(KEEP(225),8) 603 ELSE 604 NB_INT = NB_INT + int(KEEP(15),8) 605 ENDIF 606 ELSE 607 IF (OOC_STRAT .GT. 0) THEN 608 NB_INT = NB_INT + int( 609 & KEEP(225) + 2 * max(PERLU,10) * 610 & ( KEEP(225) / 100 + 1 ) 611 & ,8) 612 ELSE 613 NB_INT = NB_INT + int( 614 & KEEP(15) + 2 * max(PERLU,10) * 615 & ( KEEP(15) / 100 + 1 ) 616 & ,8) 617 ENDIF 618 ENDIF 619 NB_INT = NB_INT + NSTEPS8 620 NB_INT = NB_INT + NSTEPS8 * I8OVERI 621 NB_INT = NB_INT + N8 + 4_8 * NSTEPS8 + 622 & int(MUMPS_GET_POOL_LENGTH(NA(1), KEEP, KEEP8),8) 623 NB_INT = NB_INT + 2_8 * NSTEPS8 * I8OVERI 624 IF (KEEP(486).NE.0) THEN 625 NB_INT = NB_INT + N8 626 NB_REAL = NB_REAL + 627 & int(KEEP(127),8)*int(KEEP(488),8) 628 ENDIF 629 END IF 630 MEMORY_BYTES = NB_BYTES + NB_INT * int(KEEP(34),8) + 631 & NB_REAL * int(KEEP(35),8) 632 MEMORY_BYTES = max( MEMORY_BYTES, TEMP ) 633 MEMORY_MBYTES = int( MEMORY_BYTES / 1000000_8 ) + 1 634 RETURN 635 END SUBROUTINE SMUMPS_MAX_MEM 636 SUBROUTINE SMUMPS_SETMAXTOZERO(M_ARRAY, M_SIZE) 637 IMPLICIT NONE 638 INTEGER M_SIZE 639 REAL M_ARRAY(M_SIZE) 640 REAL ZERO 641 PARAMETER (ZERO=0.0E0) 642 M_ARRAY=ZERO 643 RETURN 644 END SUBROUTINE SMUMPS_SETMAXTOZERO 645 SUBROUTINE SMUMPS_COMPUTE_MAXPERCOL( 646 & A,ASIZE,NCOL,NROW, 647 & M_ARRAY,NMAX,COMPRESSCB,LROW1) 648 IMPLICIT NONE 649 INTEGER(8) :: ASIZE 650 INTEGER NROW,NCOL,NMAX,LROW1 651 LOGICAL COMPRESSCB 652 REAL A(ASIZE) 653 REAL M_ARRAY(NMAX) 654 INTEGER I 655 INTEGER(8):: APOS, J, LROW 656 REAL ZERO,TMP 657 PARAMETER (ZERO=0.0E0) 658 M_ARRAY(1:NMAX) = ZERO 659 APOS = 0_8 660 IF (COMPRESSCB) THEN 661 LROW=int(LROW1,8) 662 ELSE 663 LROW=int(NCOL,8) 664 ENDIF 665 DO I=1,NROW 666 DO J=1_8,int(NMAX,8) 667 TMP = abs(A(APOS+J)) 668 IF(TMP.GT.M_ARRAY(J)) M_ARRAY(J) = TMP 669 ENDDO 670 APOS = APOS + LROW 671 IF (COMPRESSCB) LROW=LROW+1_8 672 ENDDO 673 RETURN 674 END SUBROUTINE SMUMPS_COMPUTE_MAXPERCOL 675 SUBROUTINE SMUMPS_SIZE_IN_STRUCT (id, NB_INT,NB_CMPLX,NB_CHAR ) 676 USE SMUMPS_STRUC_DEF 677 IMPLICIT NONE 678 TYPE(SMUMPS_STRUC) :: id 679 INTEGER(8) NB_INT, NB_CMPLX 680 INTEGER(8) NB_REAL,NB_CHAR 681 NB_INT = 0_8 682 NB_CMPLX = 0_8 683 NB_REAL = 0_8 684 NB_CHAR = 0_8 685 IF (associated(id%IS)) NB_INT=NB_INT+size(id%IS) 686 IF (associated(id%IS1)) NB_INT=NB_INT+size(id%IS1) 687 NB_INT=NB_INT+size(id%KEEP) 688 NB_INT=NB_INT+size(id%ICNTL) 689 NB_INT=NB_INT+size(id%INFO) 690 NB_INT=NB_INT+size(id%INFOG) 691 IF (associated(id%MAPPING)) NB_INT=NB_INT+size(id%MAPPING) 692 IF (associated(id%BUFR)) NB_INT=NB_INT+size(id%BUFR) 693 IF (associated(id%STEP)) NB_INT=NB_INT+size(id%STEP) 694 IF (associated(id%NE_STEPS )) NB_INT=NB_INT+size(id%NE_STEPS ) 695 IF (associated(id%ND_STEPS)) NB_INT=NB_INT+size(id%ND_STEPS) 696 IF (associated(id%Step2node)) NB_INT=NB_INT+size(id%Step2node) 697 IF (associated(id%FRERE_STEPS)) NB_INT=NB_INT+size(id%FRERE_STEPS) 698 IF (associated(id%DAD_STEPS)) NB_INT=NB_INT+size(id%DAD_STEPS) 699 IF (associated(id%FILS)) NB_INT=NB_INT+size(id%FILS) 700 IF (associated(id%PTRAR)) 701 & NB_INT=NB_INT+size(id%PTRAR)* id%KEEP(10) 702 IF (associated(id%FRTPTR)) NB_INT=NB_INT+size(id%FRTPTR) 703 NB_INT=NB_INT+size(id%KEEP8) * id%KEEP(10) 704 IF (associated(id%PTRFAC)) NB_INT=NB_INT+size(id%PTRFAC) * 705 & id%KEEP(10) 706 IF (associated(id%FRTELT)) NB_INT=NB_INT+size(id%FRTELT) 707 IF (associated(id%NA)) NB_INT=NB_INT+size(id%NA) 708 IF (associated(id%PROCNODE_STEPS)) 709 & NB_INT=NB_INT+size(id%PROCNODE_STEPS) 710 IF (associated(id%PTLUST_S)) NB_INT=NB_INT+size(id%PTLUST_S) 711 IF (associated(id%PROCNODE)) NB_INT=NB_INT+size(id%PROCNODE) 712 IF (associated(id%INTARR)) NB_INT=NB_INT+size(id%INTARR) 713 IF (associated(id%ELTPROC)) NB_INT=NB_INT+size(id%ELTPROC) 714 IF (associated(id%CANDIDATES)) 715 & NB_INT=NB_INT+size(id%CANDIDATES) 716 IF (associated(id%SYM_PERM)) 717 & NB_INT=NB_INT+size(id%SYM_PERM) 718 IF (associated(id%UNS_PERM)) 719 & NB_INT=NB_INT+size(id%UNS_PERM) 720 IF (associated(id%ISTEP_TO_INIV2)) 721 & NB_INT=NB_INT+size(id%ISTEP_TO_INIV2) 722 IF (associated(id%FUTURE_NIV2)) 723 & NB_INT=NB_INT+size(id%FUTURE_NIV2) 724 IF (associated(id%TAB_POS_IN_PERE)) 725 & NB_INT=NB_INT+size(id%TAB_POS_IN_PERE) 726 IF (associated(id%I_AM_CAND)) 727 & NB_INT=NB_INT+size(id%I_AM_CAND) 728 IF (associated(id%MEM_DIST)) 729 & NB_INT=NB_INT+size(id%MEM_DIST) 730 IF (associated(id%POSINRHSCOMP_ROW)) 731 & NB_INT=NB_INT+size(id%POSINRHSCOMP_ROW) 732 IF(id%POSINRHSCOMP_COL_ALLOC.AND.associated(id%POSINRHSCOMP_COL)) 733 & NB_INT=NB_INT+size(id%POSINRHSCOMP_COL) 734 IF (associated(id%MEM_SUBTREE)) 735 & NB_REAL=NB_REAL+size(id%MEM_SUBTREE)*(id%KEEP(35)/id%KEEP(16)) 736 IF (associated(id%MY_ROOT_SBTR)) 737 & NB_INT=NB_INT+size(id%MY_ROOT_SBTR) 738 IF (associated(id%MY_FIRST_LEAF)) 739 & NB_INT=NB_INT+size(id%MY_FIRST_LEAF) 740 IF (associated(id%MY_NB_LEAF)) NB_INT=NB_INT+size(id%MY_NB_LEAF) 741 IF (associated(id%DEPTH_FIRST)) NB_INT=NB_INT+size(id%DEPTH_FIRST) 742 IF (associated(id%DEPTH_FIRST_SEQ)) 743 & NB_INT=NB_INT+size(id%DEPTH_FIRST_SEQ) 744 IF (associated(id%SBTR_ID)) NB_INT=NB_INT+size(id%SBTR_ID) 745 IF (associated(id%SCHED_DEP)) NB_INT=NB_INT+size(id%SCHED_DEP) 746 IF (associated(id%SCHED_GRP)) NB_INT=NB_INT+size(id%SCHED_GRP) 747 IF (associated(id%SCHED_SBTR)) NB_INT=NB_INT+size(id%SCHED_SBTR) 748 IF (associated(id%CROIX_MANU)) NB_INT=NB_INT+size(id%CROIX_MANU) 749 IF (associated(id%COST_TRAV)) 750 & NB_REAL=NB_REAL+size(id%COST_TRAV)*(id%KEEP(35)/id%KEEP(16)) 751 IF (associated(id%CB_SON_SIZE)) NB_INT=NB_INT+size(id%CB_SON_SIZE) 752 IF (associated(id%OOC_INODE_SEQUENCE)) 753 & NB_INT=NB_INT+size(id%OOC_INODE_SEQUENCE) 754 IF (associated(id%OOC_SIZE_OF_BLOCK)) 755 & NB_INT=NB_INT+size(id%OOC_SIZE_OF_BLOCK)*id%KEEP(10) 756 IF (associated(id%OOC_VADDR)) 757 & NB_INT=NB_INT+size(id%OOC_VADDR)*id%KEEP(10) 758 IF (associated(id%OOC_TOTAL_NB_NODES)) 759 & NB_INT=NB_INT+size(id%OOC_TOTAL_NB_NODES) 760 IF (associated(id%OOC_NB_FILES)) 761 & NB_INT=NB_INT+size(id%OOC_NB_FILES) 762 IF (associated(id%OOC_FILE_NAME_LENGTH)) 763 & NB_INT=NB_INT+size(id%OOC_FILE_NAME_LENGTH) 764 IF (associated(id%PIVNUL_LIST)) NB_INT=NB_INT+size(id%PIVNUL_LIST) 765 IF (associated(id%SUP_PROC)) NB_INT=NB_INT+size(id%SUP_PROC) 766 IF (associated(id%IPTR_WORKING)) 767 & NB_INT=NB_INT+size(id%IPTR_WORKING) 768 IF (associated(id%WORKING)) NB_INT=NB_INT+size(id%WORKING) 769 IF (associated(id%LRGROUPS)) 770 & NB_INT=NB_INT+size(id%LRGROUPS) 771 IF (associated(id%IPOOL_BEFORE_L0_OMP)) 772 & NB_INT=NB_INT+size(id%IPOOL_BEFORE_L0_OMP) 773 IF (associated(id%IPOOL_AFTER_L0_OMP)) 774 & NB_INT=NB_INT+size(id%IPOOL_AFTER_L0_OMP) 775 IF (associated(id%PHYS_L0_OMP)) 776 & NB_INT=NB_INT+size(id%PHYS_L0_OMP) 777 IF (associated(id%VIRT_L0_OMP)) 778 & NB_INT=NB_INT+size(id%VIRT_L0_OMP) 779 IF (associated(id%PERM_L0_OMP)) 780 & NB_INT=NB_INT+size(id%PERM_L0_OMP) 781 IF (associated(id%PTR_LEAFS_L0_OMP)) 782 & NB_INT=NB_INT+size(id%PTR_LEAFS_L0_OMP) 783 IF (associated(id%L0_OMP_MAPPING)) 784 & NB_INT=NB_INT+size(id%L0_OMP_MAPPING) 785 IF (associated(id%SINGULAR_VALUES)) 786 & NB_REAL=NB_REAL+size(id%SINGULAR_VALUES) 787 IF (associated(id%root%RG2L_COL)) 788 & NB_INT=NB_INT+size(id%root%RG2L_COL) 789 IF (associated(id%root%RG2L_ROW)) 790 & NB_INT=NB_INT+size(id%root%RG2L_ROW) 791 IF (associated(id%root%IPIV)) 792 & NB_INT=NB_INT+size(id%root%IPIV) 793 IF (associated(id%root%RHS_CNTR_MASTER_ROOT)) 794 & NB_CMPLX=NB_CMPLX+size(id%root%RHS_CNTR_MASTER_ROOT) 795 IF (associated(id%root%SCHUR_POINTER)) 796 & NB_CMPLX=NB_CMPLX+size(id%root%SCHUR_POINTER) 797 IF (associated(id%root%QR_TAU)) 798 & NB_CMPLX=NB_CMPLX+size(id%root%QR_TAU) 799 IF (associated(id%root%RHS_ROOT)) 800 & NB_CMPLX=NB_CMPLX+size(id%root%RHS_ROOT) 801 IF (associated(id%root%SVD_U)) 802 & NB_CMPLX=NB_CMPLX+size(id%root%SVD_U) 803 IF (associated(id%root%SVD_VT)) 804 & NB_CMPLX=NB_CMPLX+size(id%root%SVD_VT) 805 IF (associated(id%root%SINGULAR_VALUES)) 806 & NB_REAL=NB_REAL+size(id%root%SINGULAR_VALUES) 807 IF (associated(id%DBLARR)) NB_CMPLX=NB_CMPLX+size(id%DBLARR) 808 IF (associated(id%RHSCOMP)) NB_CMPLX=NB_CMPLX+size(id%RHSCOMP) 809 IF (associated(id%S)) NB_CMPLX=NB_CMPLX+id%KEEP8(23) 810 IF (associated(id%COLSCA).AND.(id%KEEP(52).NE.-1)) 811 & NB_REAL=NB_REAL+size(id%COLSCA) 812 IF (associated(id%ROWSCA).AND.(id%KEEP(52).NE.-1)) 813 & NB_REAL=NB_REAL+size(id%ROWSCA) 814 NB_REAL=NB_REAL+size(id%CNTL) 815 NB_REAL=NB_REAL+size(id%RINFO) 816 NB_REAL=NB_REAL+size(id%RINFOG) 817 NB_REAL=NB_REAL+size(id%DKEEP) 818 NB_CHAR=NB_CHAR+len(id%VERSION_NUMBER) 819 NB_CHAR=NB_CHAR+len(id%OOC_TMPDIR) 820 NB_CHAR=NB_CHAR+len(id%OOC_PREFIX) 821 NB_CHAR=NB_CHAR+len(id%WRITE_PROBLEM) 822 NB_CHAR=NB_CHAR+len(id%SAVE_DIR) 823 NB_CHAR=NB_CHAR+len(id%SAVE_PREFIX) 824 NB_CMPLX = NB_CMPLX + NB_REAL 825 RETURN 826 END SUBROUTINE SMUMPS_SIZE_IN_STRUCT 827 SUBROUTINE SMUMPS_COPYI8SIZE(N8,SRC,DEST) 828 IMPLICIT NONE 829 INTEGER(8) :: N8 830 REAL, intent(in) :: SRC(N8) 831 REAL, intent(out) :: DEST(N8) 832 INTEGER(8) :: SHIFT8, HUG8 833 INTEGER :: I, I4SIZE 834 IF(int(huge(I4SIZE),8) .EQ. int(huge(HUG8),8)) THEN 835 CALL scopy(N8, SRC(1), 1, DEST(1), 1) 836 ELSE 837 HUG8=int(huge(I4SIZE),8) 838 DO I = 1, int(( N8 + HUG8 - 1_8 ) / HUG8) 839 SHIFT8 = 1_8 + int(I-1,8) * HUG8 840 I4SIZE = int(min(HUG8, N8-SHIFT8+1_8)) 841 CALL scopy(I4SIZE, SRC(SHIFT8), 1, DEST(SHIFT8), 1) 842 ENDDO 843 END IF 844 RETURN 845 END SUBROUTINE SMUMPS_COPYI8SIZE 846 SUBROUTINE SMUMPS_SET_TMP_PTR( THE_ADDRESS, THE_SIZE ) 847 USE SMUMPS_STATIC_PTR_M 848 INTEGER, INTENT(IN) :: THE_SIZE 849 REAL, INTENT(IN) :: THE_ADDRESS(THE_SIZE) 850 CALL SMUMPS_SET_STATIC_PTR(THE_ADDRESS(1:THE_SIZE)) 851 RETURN 852 END SUBROUTINE SMUMPS_SET_TMP_PTR 853