1C 2C This file is part of MUMPS 4.10.0, built on Tue May 10 12:56:32 UTC 2011 3C 4C 5C This version of MUMPS is provided to you free of charge. It is public 6C domain, based on public domain software developed during the Esprit IV 7C European project PARASOL (1996-1999). Since this first public domain 8C version in 1999, research and developments have been supported by the 9C following institutions: CERFACS, CNRS, ENS Lyon, INPT(ENSEEIHT)-IRIT, 10C INRIA, and University of Bordeaux. 11C 12C The MUMPS team at the moment of releasing this version includes 13C Patrick Amestoy, Maurice Bremond, Alfredo Buttari, Abdou Guermouche, 14C Guillaume Joslin, Jean-Yves L'Excellent, Francois-Henry Rouet, Bora 15C Ucar and Clement Weisbecker. 16C 17C We are also grateful to Emmanuel Agullo, Caroline Bousquet, Indranil 18C Chowdhury, Philippe Combes, Christophe Daniel, Iain Duff, Vincent Espirat, 19C Aurelia Fevre, Jacko Koster, Stephane Pralet, Chiara Puglisi, Gregoire 20C Richard, Tzvetomila Slavova, Miroslav Tuma and Christophe Voemel who 21C have been contributing to this project. 22C 23C Up-to-date copies of the MUMPS package can be obtained 24C from the Web pages: 25C http://mumps.enseeiht.fr/ or http://graal.ens-lyon.fr/MUMPS 26C 27C 28C THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY 29C EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK. 30C 31C 32C User documentation of any code that uses this software can 33C include this complete notice. You can acknowledge (using 34C references [1] and [2]) the contribution of this package 35C in any scientific publication dependent upon the use of the 36C package. You shall use reasonable endeavours to notify 37C the authors of the package of this publication. 38C 39C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent, 40C A fully asynchronous multifrontal solver using distributed dynamic 41C scheduling, SIAM Journal of Matrix Analysis and Applications, 42C Vol 23, No 1, pp 15-41 (2001). 43C 44C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and 45C S. Pralet, Hybrid scheduling for the parallel solution of linear 46C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006). 47C 48 MODULE CMUMPS_OOC 49 USE MUMPS_OOC_COMMON 50 IMPLICIT NONE 51 INTEGER NOT_IN_MEM,BEING_READ,NOT_USED,PERMUTED,USED, 52 & USED_NOT_PERMUTED,ALREADY_USED 53 PARAMETER (NOT_IN_MEM=0,BEING_READ=-1,NOT_USED=-2, 54 & PERMUTED=-3,USED=-4,USED_NOT_PERMUTED=-5,ALREADY_USED=-6) 55 INTEGER OOC_NODE_NOT_IN_MEM,OOC_NODE_PERMUTED, 56 & OOC_NODE_NOT_PERMUTED 57 PARAMETER (OOC_NODE_NOT_IN_MEM=-20, 58 & OOC_NODE_PERMUTED=-21,OOC_NODE_NOT_PERMUTED=-22) 59 INTEGER(8), DIMENSION(:,:),POINTER :: SIZE_OF_BLOCK 60 INTEGER, DIMENSION(:),POINTER :: TOTAL_NB_OOC_NODES 61 INTEGER :: OOC_SOLVE_TYPE_FCT 62 INTEGER, DIMENSION(:),ALLOCATABLE :: IO_REQ 63 INTEGER(8), DIMENSION(:), ALLOCATABLE:: LRLUS_SOLVE 64 INTEGER(8), DIMENSION(:), ALLOCATABLE:: SIZE_SOLVE_Z, 65 & LRLU_SOLVE_T, POSFAC_SOLVE, IDEB_SOLVE_Z, LRLU_SOLVE_B 66 INTEGER, DIMENSION(:),ALLOCATABLE :: PDEB_SOLVE_Z 67 INTEGER (8),SAVE :: FACT_AREA_SIZE, 68 & SIZE_ZONE_SOLVE,SIZE_SOLVE_EMM,TMP_SIZE_FACT, 69 & MAX_SIZE_FACTOR_OOC 70 INTEGER(8), SAVE :: MIN_SIZE_READ 71 INTEGER, SAVE :: TMP_NB_NODES, MAX_NB_NODES_FOR_ZONE,MAX_NB_REQ, 72 & CURRENT_SOLVE_READ_ZONE, 73 & CUR_POS_SEQUENCE,NB_Z,SOLVE_STEP, 74 & NB_ZONE_REQ,MTYPE_OOC,NB_ACT 75#if defined (NEW_PREF_SCHEME) 76 INTEGER,SAVE :: MAX_PREF_SIZE 77#endif 78 & ,NB_CALLED,REQ_ACT,NB_CALL 79 INTEGER(8), SAVE :: OOC_VADDR_PTR 80 INTEGER(8), SAVE :: SIZE_ZONE_REQ 81 DOUBLE PRECISION,SAVE :: MAX_OOC_FILE_SIZE 82 INTEGER(8), DIMENSION(:), ALLOCATABLE :: SIZE_OF_READ, READ_DEST 83 INTEGER,DIMENSION(:),ALLOCATABLE :: FIRST_POS_IN_READ, 84 & READ_MNG,REQ_TO_ZONE,POS_HOLE_T, 85 & POS_HOLE_B,REQ_ID,OOC_STATE_NODE 86 INTEGER CMUMPS_ELEMENTARY_DATA_SIZE,N_OOC 87 INTEGER, DIMENSION(:), ALLOCATABLE :: POS_IN_MEM, INODE_TO_POS 88 INTEGER, DIMENSION(:), ALLOCATABLE :: CURRENT_POS_T,CURRENT_POS_B 89 LOGICAL IS_ROOT_SPECIAL 90 INTEGER SPECIAL_ROOT_NODE 91 PUBLIC :: CMUMPS_575,CMUMPS_576, 92 & CMUMPS_577, 93 & CMUMPS_578, 94 & CMUMPS_579, 95 & CMUMPS_582, 96 & CMUMPS_583,CMUMPS_584, 97 & CMUMPS_585,CMUMPS_586 98 INTEGER, PARAMETER, PUBLIC :: TYPEF_BOTH_LU = -99976 99 PUBLIC CMUMPS_688, 100 & CMUMPS_690 101 PRIVATE CMUMPS_695, 102 & CMUMPS_697 103 CONTAINS 104 SUBROUTINE CMUMPS_711( STRAT_IO_ARG, 105 & STRAT_IO_ASYNC_ARG, WITH_BUF_ARG, LOW_LEVEL_STRAT_IO_ARG ) 106 IMPLICIT NONE 107 INTEGER, intent(out) :: LOW_LEVEL_STRAT_IO_ARG 108 LOGICAL, intent(out) :: STRAT_IO_ASYNC_ARG, WITH_BUF_ARG 109 INTEGER, intent(in) :: STRAT_IO_ARG 110 INTEGER TMP 111 CALL MUMPS_OOC_IS_ASYNC_AVAIL(TMP) 112 STRAT_IO_ASYNC_ARG=.FALSE. 113 WITH_BUF_ARG=.FALSE. 114 IF(TMP.EQ.1)THEN 115 IF((STRAT_IO_ARG.EQ.1).OR.(STRAT_IO_ARG.EQ.2))THEN 116 STRAT_IO_ASYNC=.TRUE. 117 WITH_BUF=.FALSE. 118 ELSEIF((STRAT_IO_ARG.EQ.4).OR.(STRAT_IO_ARG.EQ.5))THEN 119 STRAT_IO_ASYNC_ARG=.TRUE. 120 WITH_BUF_ARG=.TRUE. 121 ELSEIF(STRAT_IO_ARG.EQ.3)THEN 122 STRAT_IO_ASYNC_ARG=.FALSE. 123 WITH_BUF_ARG=.TRUE. 124 ENDIF 125 LOW_LEVEL_STRAT_IO_ARG=mod(STRAT_IO_ARG,3) 126 ELSE 127 LOW_LEVEL_STRAT_IO_ARG=0 128 IF(STRAT_IO_ARG.GE.3)THEN 129 WITH_BUF_ARG=.TRUE. 130 ENDIF 131 ENDIF 132 RETURN 133 END SUBROUTINE CMUMPS_711 134 FUNCTION CMUMPS_579(INODE,ZONE) 135 IMPLICIT NONE 136 INTEGER INODE,ZONE 137 LOGICAL CMUMPS_579 138 CMUMPS_579=(LRLUS_SOLVE(ZONE).GE. 139 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) 140 RETURN 141 END FUNCTION CMUMPS_579 142 SUBROUTINE CMUMPS_590(LA) 143 IMPLICIT NONE 144 INTEGER(8) :: LA 145 FACT_AREA_SIZE=LA 146 END SUBROUTINE CMUMPS_590 147 SUBROUTINE CMUMPS_575(id, MAXS) 148 USE CMUMPS_STRUC_DEF 149 USE CMUMPS_OOC_BUFFER 150 IMPLICIT NONE 151 INTEGER TMPDIR_MAX_LENGTH, PREFIX_MAX_LENGTH 152 PARAMETER (TMPDIR_MAX_LENGTH=255, PREFIX_MAX_LENGTH=63) 153 INTEGER(8), intent(in) :: MAXS 154 TYPE(CMUMPS_STRUC), TARGET :: id 155 INTEGER IERR 156 INTEGER allocok 157 INTEGER ASYNC 158 CHARACTER*1 TMP_DIR(TMPDIR_MAX_LENGTH), 159 & TMP_PREFIX(PREFIX_MAX_LENGTH) 160 INTEGER DIM_DIR,DIM_PREFIX 161 INTEGER, DIMENSION(:), ALLOCATABLE :: FILE_FLAG_TAB 162 INTEGER TMP 163 INTEGER K211_LOC 164 ICNTL1=id%ICNTL(1) 165 MAX_SIZE_FACTOR_OOC=0_8 166 N_OOC=id%N 167 ASYNC=0 168 SOLVE=.FALSE. 169 IERR=0 170 IF(allocated(IO_REQ))THEN 171 DEALLOCATE(IO_REQ) 172 ENDIF 173 IF(associated(KEEP_OOC))THEN 174 NULLIFY(KEEP_OOC) 175 ENDIF 176 IF(associated(STEP_OOC))THEN 177 NULLIFY(STEP_OOC) 178 ENDIF 179 IF(associated(PROCNODE_OOC))THEN 180 NULLIFY(PROCNODE_OOC) 181 ENDIF 182 IF(associated(OOC_INODE_SEQUENCE))THEN 183 NULLIFY(OOC_INODE_SEQUENCE) 184 ENDIF 185 IF(associated(TOTAL_NB_OOC_NODES))THEN 186 NULLIFY(TOTAL_NB_OOC_NODES) 187 ENDIF 188 IF(associated(SIZE_OF_BLOCK))THEN 189 NULLIFY(SIZE_OF_BLOCK) 190 ENDIF 191 IF(associated(OOC_VADDR))THEN 192 NULLIFY(OOC_VADDR) 193 ENDIF 194 IF(allocated(I_CUR_HBUF_NEXTPOS))THEN 195 DEALLOCATE(I_CUR_HBUF_NEXTPOS) 196 ENDIF 197 CALL CMUMPS_588(id,IERR) 198 IF(IERR.LT.0)THEN 199 IF (ICNTL1 > 0) 200 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 201 id%INFO(1) = IERR 202 id%INFO(2) = 0 203 RETURN 204 ENDIF 205 CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB, 206 & id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID ) 207 IF (id%KEEP(201).EQ.2) THEN 208 OOC_FCT_TYPE=1 209 ENDIF 210 STEP_OOC=>id%STEP 211 PROCNODE_OOC=>id%PROCNODE_STEPS 212 MYID_OOC=id%MYID 213 SLAVEF_OOC=id%NSLAVES 214 KEEP_OOC => id%KEEP 215 SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK 216 OOC_VADDR=>id%OOC_VADDR 217 IF(id%KEEP(107).GT.0)THEN 218 SIZE_SOLVE_EMM=max(id%KEEP8(19),int(dble(MAXS)* 219 & 0.9d0*0.2d0,8)) 220 SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM, 221 & int((dble(MAXS)*0.9d0- 222 & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)) 223 IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN 224 SIZE_SOLVE_EMM=id%KEEP8(19) 225 SIZE_ZONE_SOLVE=int((dble(MAXS)*0.9d0- 226 & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8) 227 ENDIF 228 ELSE 229 SIZE_ZONE_SOLVE=int(dble(MAXS)*0.9d0,8) 230 SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE 231 ENDIF 232 CMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35) 233 SIZE_OF_BLOCK=0_8 234 ALLOCATE(id%OOC_NB_FILES(OOC_NB_FILE_TYPE), stat=allocok) 235 IF (allocok .GT. 0) THEN 236 IF (ICNTL1.GT.0) 237 & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' 238 id%INFO(1) = -13 239 id%INFO(2) = OOC_NB_FILE_TYPE 240 RETURN 241 ENDIF 242 id%OOC_NB_FILES=0 243 OOC_VADDR_PTR=0_8 244 CALL CMUMPS_711( id%KEEP(99), STRAT_IO_ASYNC, 245 & WITH_BUF, LOW_LEVEL_STRAT_IO ) 246 TMP_SIZE_FACT=0_8 247 TMP_NB_NODES=0 248 MAX_NB_NODES_FOR_ZONE=0 249 OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE 250 ALLOCATE(I_CUR_HBUF_NEXTPOS(OOC_NB_FILE_TYPE), 251 & stat=allocok) 252 IF (allocok .GT. 0) THEN 253 IF (ICNTL1.GT.0) 254 & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' 255 id%INFO(1) = -13 256 id%INFO(2) = OOC_NB_FILE_TYPE 257 RETURN 258 ENDIF 259 I_CUR_HBUF_NEXTPOS = 1 260 IF(WITH_BUF)THEN 261 CALL CMUMPS_669(id%INFO(1),id%INFO(2),IERR) 262 IF(IERR.LT.0)THEN 263 RETURN 264 ENDIF 265 ENDIF 266 IF(STRAT_IO_ASYNC)THEN 267 ASYNC=1 268 ENDIF 269 DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN 270 CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC) 271 DIM_DIR=len(trim(id%OOC_TMPDIR)) 272 DIM_PREFIX=len(trim(id%OOC_PREFIX)) 273 CALL CMUMPS_589(TMP_DIR(1), 274 & id%OOC_TMPDIR, TMPDIR_MAX_LENGTH, DIM_DIR ) 275 CALL CMUMPS_589(TMP_PREFIX(1), 276 & id%OOC_PREFIX, PREFIX_MAX_LENGTH, DIM_PREFIX) 277 CALL MUMPS_LOW_LEVEL_INIT_PREFIX(DIM_PREFIX, TMP_PREFIX) 278 CALL MUMPS_LOW_LEVEL_INIT_TMPDIR(DIM_DIR, TMP_DIR) 279 ALLOCATE(FILE_FLAG_TAB(OOC_NB_FILE_TYPE), 280 & stat=allocok) 281 IF (allocok .GT. 0) THEN 282 IF (ICNTL1 .GT. 0) 283 & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_INIT_OOC' 284 id%INFO(1) = -13 285 id%INFO(2) = OOC_NB_FILE_TYPE 286 RETURN 287 ENDIF 288 FILE_FLAG_TAB(1:OOC_NB_FILE_TYPE)=0 289 IERR=0 290 TMP=int(id%KEEP8(11)/1000000_8,kind=4)+1 291 IF((id%KEEP(201).EQ.1).AND.(id%KEEP(50).EQ.0) 292 & ) THEN 293 TMP=max(1,TMP/2) 294 ENDIF 295 CALL MUMPS_LOW_LEVEL_INIT_OOC_C(MYID_OOC,TMP, 296 & id%KEEP(35),LOW_LEVEL_STRAT_IO,K211_LOC,OOC_NB_FILE_TYPE, 297 & FILE_FLAG_TAB,IERR) 298 IF(IERR.LT.0)THEN 299 IF (ICNTL1 .GT. 0 ) THEN 300 WRITE(ICNTL1,*)MYID_OOC,': PB in MUMPS_LOW_LEVEL_INIT_OOC_C' 301 WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 302 ENDIF 303 id%INFO(1) = IERR 304 id%INFO(2) = 0 305 RETURN 306 ENDIF 307 CALL MUMPS_GET_MAX_FILE_SIZE_C(MAX_OOC_FILE_SIZE) 308 DEALLOCATE(FILE_FLAG_TAB) 309 RETURN 310 END SUBROUTINE CMUMPS_575 311 SUBROUTINE CMUMPS_576(INODE,PTRFAC,KEEP,KEEP8, 312 & A,LA,SIZE,IERR) 313 USE CMUMPS_OOC_BUFFER 314 IMPLICIT NONE 315 INTEGER INODE,KEEP(500) 316 INTEGER(8) :: LA 317 INTEGER(8) KEEP8(150) 318 INTEGER(8) :: PTRFAC(KEEP(28)), SIZE 319 COMPLEX A(LA) 320 INTEGER IERR,NODE,ASYNC,REQUEST 321 LOGICAL IO_C 322 INTEGER ADDR_INT1,ADDR_INT2 323 INTEGER TYPE 324 INTEGER SIZE_INT1,SIZE_INT2 325 TYPE=FCT 326 IF(STRAT_IO_ASYNC)THEN 327 ASYNC=1 328 ELSE 329 ASYNC=0 330 ENDIF 331 IERR=0 332 IO_C=.TRUE. 333 SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)=SIZE 334 MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,SIZE) 335 OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)=OOC_VADDR_PTR 336 OOC_VADDR_PTR=OOC_VADDR_PTR+SIZE 337 TMP_SIZE_FACT=TMP_SIZE_FACT+SIZE 338 TMP_NB_NODES=TMP_NB_NODES+1 339 IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN 340 MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE,TMP_NB_NODES) 341 TMP_SIZE_FACT=0_8 342 TMP_NB_NODES=0 343 ENDIF 344 IF (.NOT. WITH_BUF) THEN 345 CALL MUMPS_677(ADDR_INT1,ADDR_INT2, 346 & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) 347 CALL MUMPS_677(SIZE_INT1,SIZE_INT2, 348 & SIZE) 349 CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, 350 & A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2, 351 & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) 352 IF(IERR.LT.0)THEN 353 IF (ICNTL1.GT.0) 354 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 355 RETURN 356 ENDIF 357 IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN 358 WRITE(*,*)MYID_OOC,': Internal error (37) in OOC ' 359 CALL MUMPS_ABORT() 360 ENDIF 361 OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), 362 & OOC_FCT_TYPE)=INODE 363 I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)= 364 & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1 365 ELSE 366 IF(SIZE.LE.HBUF_SIZE)THEN 367 CALL CMUMPS_678 368 & (A(PTRFAC(STEP_OOC(INODE))),SIZE,IERR) 369 OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), 370 & OOC_FCT_TYPE) = INODE 371 I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) = 372 & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE) + 1 373#if ! defined (OOC_DEBUG) 374 PTRFAC(STEP_OOC(INODE))=-777777_8 375#endif 376 RETURN 377 ELSE 378 CALL CMUMPS_707(OOC_FCT_TYPE,IERR) 379 IF(IERR.LT.0)THEN 380 RETURN 381 ENDIF 382 CALL CMUMPS_707(OOC_FCT_TYPE,IERR) 383 IF(IERR.LT.0)THEN 384 RETURN 385 ENDIF 386 CALL MUMPS_677(ADDR_INT1,ADDR_INT2, 387 & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) 388 CALL MUMPS_677(SIZE_INT1,SIZE_INT2, 389 & SIZE) 390 CALL MUMPS_LOW_LEVEL_WRITE_OOC_C(LOW_LEVEL_STRAT_IO, 391 & A(PTRFAC(STEP_OOC(INODE))),SIZE_INT1,SIZE_INT2, 392 & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) 393 IF(IERR.LT.0)THEN 394 IF (ICNTL1.GT.0) 395 & WRITE(*,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 396 RETURN 397 ENDIF 398 IF(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE).GT.KEEP_OOC(28))THEN 399 WRITE(*,*)MYID_OOC,': Internal error (38) in OOC ' 400 CALL MUMPS_ABORT() 401 ENDIF 402 OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE), 403 & OOC_FCT_TYPE)=INODE 404 I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)= 405 & I_CUR_HBUF_NEXTPOS(OOC_FCT_TYPE)+1 406 CALL CMUMPS_689(OOC_FCT_TYPE) 407 ENDIF 408 END IF 409 NODE=-9999 410#if ! defined (OOC_DEBUG) 411 PTRFAC(STEP_OOC(INODE))=-777777_8 412#endif 413 IF(STRAT_IO_ASYNC)THEN 414 IERR=0 415 CALL MUMPS_WAIT_REQUEST(REQUEST,IERR) 416 IF(IERR.LT.0)THEN 417 IF (ICNTL1 .GT. 0) 418 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 419 RETURN 420 ENDIF 421 ENDIF 422 RETURN 423 END SUBROUTINE CMUMPS_576 424 SUBROUTINE CMUMPS_577(DEST,INODE,IERR 425 & ) 426 IMPLICIT NONE 427 INCLUDE 'mpif.h' 428 INTEGER IERR,INODE 429 COMPLEX DEST 430 INTEGER ASYNC 431 LOGICAL IO_C 432#if defined(OLD_READ) 433 INTEGER REQUEST 434#endif 435 INTEGER ADDR_INT1,ADDR_INT2 436 INTEGER TYPE 437 INTEGER SIZE_INT1,SIZE_INT2 438 TYPE=OOC_SOLVE_TYPE_FCT 439 IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) 440 & .EQ.0_8)THEN 441 GOTO 555 442 ENDIF 443 IF(STRAT_IO_ASYNC)THEN 444 ASYNC=1 445 ELSE 446 ASYNC=0 447 ENDIF 448 IERR=0 449 IO_C=.TRUE. 450#if ! defined(OLD_READ) 451 OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED 452 CALL MUMPS_677(ADDR_INT1,ADDR_INT2, 453 & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) 454 CALL MUMPS_677(SIZE_INT1,SIZE_INT2, 455 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) 456 CALL MUMPS_LOW_LEVEL_DIRECT_READ(DEST, 457 & SIZE_INT1,SIZE_INT2, 458 & TYPE,ADDR_INT1,ADDR_INT2,IERR) 459 IF(IERR.LT.0)THEN 460 IF (ICNTL1.GT.0) THEN 461 WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 462 WRITE(ICNTL1,*)MYID_OOC, 463 & ': Problem in MUMPS_LOW_LEVEL_DIRECT_READ' 464 ENDIF 465 RETURN 466 ENDIF 467#else 468 OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED 469 CALL MUMPS_677(ADDR_INT1,ADDR_INT2, 470 & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) 471 CALL MUMPS_677(SIZE_INT1,SIZE_INT2, 472 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE)) 473 CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO, 474 & DEST,SIZE_INT1,SIZE_INT2, 475 & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) 476 IF(IERR.LT.0)THEN 477 IF (ICNTL1 .GT. 0 ) THEN 478 WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 479 WRITE(ICNTL1,*)MYID_OOC, 480 & ': Problem in MUMPS_LOW_LEVEL_READ_OOC' 481 ENDIF 482 RETURN 483 ENDIF 484 IF(STRAT_IO_ASYNC)THEN 485 IERR=0 486 CALL MUMPS_WAIT_REQUEST(REQUEST,IERR) 487 IF(IERR.LT.0)THEN 488 IF (ICNTL1 .GT. 0 ) 489 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 490 RETURN 491 ENDIF 492 ENDIF 493#endif 494 555 CONTINUE 495 IF(.NOT.CMUMPS_727())THEN 496 IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ. 497 & INODE)THEN 498 IF(SOLVE_STEP.EQ.0)THEN 499 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 500 ELSEIF(SOLVE_STEP.EQ.1)THEN 501 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 502 ENDIF 503 CALL CMUMPS_728() 504 ENDIF 505 ENDIF 506 RETURN 507 END SUBROUTINE CMUMPS_577 508 SUBROUTINE CMUMPS_591(IERR) 509 USE CMUMPS_OOC_BUFFER 510 IMPLICIT NONE 511 INTEGER, intent(out):: IERR 512 IERR=0 513 IF (WITH_BUF) THEN 514 CALL CMUMPS_675(IERR) 515 IF(IERR.LT.0)THEN 516 RETURN 517 ENDIF 518 END IF 519 RETURN 520 END SUBROUTINE CMUMPS_591 521 SUBROUTINE CMUMPS_592(id,IERR) 522 USE CMUMPS_OOC_BUFFER 523 USE CMUMPS_STRUC_DEF 524 IMPLICIT NONE 525 TYPE(CMUMPS_STRUC), TARGET :: id 526 INTEGER, intent(out) :: IERR 527 INTEGER I,SOLVE_OR_FACTO 528 IERR=0 529 IF(WITH_BUF)THEN 530 CALL CMUMPS_659() 531 ENDIF 532 IF(associated(KEEP_OOC))THEN 533 NULLIFY(KEEP_OOC) 534 ENDIF 535 IF(associated(STEP_OOC))THEN 536 NULLIFY(STEP_OOC) 537 ENDIF 538 IF(associated(PROCNODE_OOC))THEN 539 NULLIFY(PROCNODE_OOC) 540 ENDIF 541 IF(associated(OOC_INODE_SEQUENCE))THEN 542 NULLIFY(OOC_INODE_SEQUENCE) 543 ENDIF 544 IF(associated(TOTAL_NB_OOC_NODES))THEN 545 NULLIFY(TOTAL_NB_OOC_NODES) 546 ENDIF 547 IF(associated(SIZE_OF_BLOCK))THEN 548 NULLIFY(SIZE_OF_BLOCK) 549 ENDIF 550 IF(associated(OOC_VADDR))THEN 551 NULLIFY(OOC_VADDR) 552 ENDIF 553 CALL MUMPS_OOC_END_WRITE_C(IERR) 554 IF(IERR.LT.0)THEN 555 IF (ICNTL1 .GT. 0) 556 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 557 GOTO 500 558 ENDIF 559 id%OOC_MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE, 560 & TMP_NB_NODES) 561 IF(allocated(I_CUR_HBUF_NEXTPOS))THEN 562 DO I=1,OOC_NB_FILE_TYPE 563 id%OOC_TOTAL_NB_NODES(I)=I_CUR_HBUF_NEXTPOS(I)-1 564 ENDDO 565 DEALLOCATE(I_CUR_HBUF_NEXTPOS) 566 ENDIF 567 id%KEEP8(20)=MAX_SIZE_FACTOR_OOC 568 CALL CMUMPS_613(id,IERR) 569 IF(IERR.LT.0)THEN 570 GOTO 500 571 ENDIF 572 500 CONTINUE 573 SOLVE_OR_FACTO=0 574 CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR) 575 IF(IERR.LT.0)THEN 576 IF (ICNTL1.GT.0) 577 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 578 RETURN 579 ENDIF 580 RETURN 581 END SUBROUTINE CMUMPS_592 582 SUBROUTINE CMUMPS_588(id,IERR) 583 USE CMUMPS_STRUC_DEF 584 IMPLICIT NONE 585 EXTERNAL MUMPS_OOC_REMOVE_FILE_C 586 TYPE(CMUMPS_STRUC), TARGET :: id 587 INTEGER IERR 588 INTEGER I,J,I1,K 589 CHARACTER*1 TMP_NAME(350) 590 IERR=0 591 K=1 592 IF(associated(id%OOC_FILE_NAMES).AND. 593 & associated(id%OOC_FILE_NAME_LENGTH))THEN 594 DO I1=1,OOC_NB_FILE_TYPE 595 DO I=1,id%OOC_NB_FILES(I1) 596 DO J=1,id%OOC_FILE_NAME_LENGTH(K) 597 TMP_NAME(J)=id%OOC_FILE_NAMES(K,J) 598 ENDDO 599 CALL MUMPS_OOC_REMOVE_FILE_C(IERR, TMP_NAME(1)) 600 IF(IERR.LT.0)THEN 601 IF (ICNTL1.GT.0)THEN 602 WRITE(ICNTL1,*)MYID_OOC,': ', 603 & ERR_STR_OOC(1:DIM_ERR_STR_OOC) 604 RETURN 605 ENDIF 606 ENDIF 607 K=K+1 608 ENDDO 609 ENDDO 610 ENDIF 611 IF(associated(id%OOC_FILE_NAMES))THEN 612 DEALLOCATE(id%OOC_FILE_NAMES) 613 NULLIFY(id%OOC_FILE_NAMES) 614 ENDIF 615 IF(associated(id%OOC_FILE_NAME_LENGTH))THEN 616 DEALLOCATE(id%OOC_FILE_NAME_LENGTH) 617 NULLIFY(id%OOC_FILE_NAME_LENGTH) 618 ENDIF 619 IF(associated(id%OOC_NB_FILES))THEN 620 DEALLOCATE(id%OOC_NB_FILES) 621 NULLIFY(id%OOC_NB_FILES) 622 ENDIF 623 RETURN 624 END SUBROUTINE CMUMPS_588 625 SUBROUTINE CMUMPS_587(id,IERR) 626 USE CMUMPS_STRUC_DEF 627 IMPLICIT NONE 628 TYPE(CMUMPS_STRUC), TARGET :: id 629 INTEGER IERR 630 IERR=0 631 CALL CMUMPS_588(id,IERR) 632 IF(associated(id%OOC_TOTAL_NB_NODES))THEN 633 DEALLOCATE(id%OOC_TOTAL_NB_NODES) 634 NULLIFY(id%OOC_TOTAL_NB_NODES) 635 ENDIF 636 IF(associated(id%OOC_INODE_SEQUENCE))THEN 637 DEALLOCATE(id%OOC_INODE_SEQUENCE) 638 NULLIFY(id%OOC_INODE_SEQUENCE) 639 ENDIF 640 IF(associated(id%OOC_SIZE_OF_BLOCK))THEN 641 DEALLOCATE(id%OOC_SIZE_OF_BLOCK) 642 NULLIFY(id%OOC_SIZE_OF_BLOCK) 643 ENDIF 644 IF(associated(id%OOC_VADDR))THEN 645 DEALLOCATE(id%OOC_VADDR) 646 NULLIFY(id%OOC_VADDR) 647 ENDIF 648 RETURN 649 END SUBROUTINE CMUMPS_587 650 SUBROUTINE CMUMPS_586(id) 651 USE CMUMPS_STRUC_DEF 652 IMPLICIT NONE 653 INCLUDE 'mpif.h' 654 TYPE(CMUMPS_STRUC), TARGET :: id 655 INTEGER TMP,I,J 656 INTEGER(8) :: TMP_SIZE8 657 INTEGER allocok,IERR 658 EXTERNAL MUMPS_275 659 INTEGER MUMPS_275 660 INTEGER MASTER_ROOT 661 IERR=0 662 ICNTL1=id%ICNTL(1) 663 SOLVE=.TRUE. 664 N_OOC=id%N 665 IF(allocated(LRLUS_SOLVE))THEN 666 DEALLOCATE(LRLUS_SOLVE) 667 ENDIF 668 IF(allocated(LRLU_SOLVE_T))THEN 669 DEALLOCATE(LRLU_SOLVE_T) 670 ENDIF 671 IF(allocated(LRLU_SOLVE_B))THEN 672 DEALLOCATE(LRLU_SOLVE_B) 673 ENDIF 674 IF(allocated(POSFAC_SOLVE))THEN 675 DEALLOCATE(POSFAC_SOLVE) 676 ENDIF 677 IF(allocated(IDEB_SOLVE_Z))THEN 678 DEALLOCATE(IDEB_SOLVE_Z) 679 ENDIF 680 IF(allocated(PDEB_SOLVE_Z))THEN 681 DEALLOCATE(PDEB_SOLVE_Z) 682 ENDIF 683 IF(allocated(SIZE_SOLVE_Z))THEN 684 DEALLOCATE(SIZE_SOLVE_Z) 685 ENDIF 686 IF(allocated(CURRENT_POS_T))THEN 687 DEALLOCATE(CURRENT_POS_T) 688 ENDIF 689 IF(allocated(CURRENT_POS_B))THEN 690 DEALLOCATE(CURRENT_POS_B) 691 ENDIF 692 IF(allocated(POS_HOLE_T))THEN 693 DEALLOCATE(POS_HOLE_T) 694 ENDIF 695 IF(allocated(POS_HOLE_B))THEN 696 DEALLOCATE(POS_HOLE_B) 697 ENDIF 698 IF(allocated(OOC_STATE_NODE))THEN 699 DEALLOCATE(OOC_STATE_NODE) 700 ENDIF 701 IF(allocated(POS_IN_MEM))THEN 702 DEALLOCATE(POS_IN_MEM) 703 ENDIF 704 IF(allocated(INODE_TO_POS))THEN 705 DEALLOCATE(INODE_TO_POS) 706 ENDIF 707 IF(allocated(SIZE_OF_READ))THEN 708 DEALLOCATE(SIZE_OF_READ) 709 ENDIF 710 IF(allocated(FIRST_POS_IN_READ))THEN 711 DEALLOCATE(FIRST_POS_IN_READ) 712 ENDIF 713 IF(allocated(READ_DEST))THEN 714 DEALLOCATE(READ_DEST) 715 ENDIF 716 IF(allocated(READ_MNG))THEN 717 DEALLOCATE(READ_MNG) 718 ENDIF 719 IF(allocated(REQ_TO_ZONE))THEN 720 DEALLOCATE(REQ_TO_ZONE) 721 ENDIF 722 IF(allocated(REQ_ID))THEN 723 DEALLOCATE(REQ_ID) 724 ENDIF 725 IF(allocated(IO_REQ))THEN 726 DEALLOCATE(IO_REQ) 727 ENDIF 728 IF(associated(KEEP_OOC))THEN 729 NULLIFY(KEEP_OOC) 730 ENDIF 731 IF(associated(STEP_OOC))THEN 732 NULLIFY(STEP_OOC) 733 ENDIF 734 IF(associated(PROCNODE_OOC))THEN 735 NULLIFY(PROCNODE_OOC) 736 ENDIF 737 IF(associated(TOTAL_NB_OOC_NODES))THEN 738 NULLIFY(TOTAL_NB_OOC_NODES) 739 ENDIF 740 IF(associated(SIZE_OF_BLOCK))THEN 741 NULLIFY(SIZE_OF_BLOCK) 742 ENDIF 743 IF(associated(OOC_INODE_SEQUENCE))THEN 744 NULLIFY(OOC_VADDR) 745 ENDIF 746 CALL MUMPS_796(TYPEF_L, TYPEF_U, TYPEF_CB, 747 & id%KEEP(201), id%KEEP(251), id%KEEP(50), TYPEF_INVALID ) 748 DIM_ERR_STR_OOC = ERR_STR_OOC_MAX_LEN 749 CALL MUMPS_LOW_LEVEL_INIT_ERR_STR(DIM_ERR_STR_OOC,ERR_STR_OOC) 750 CALL CMUMPS_614(id) 751 IF(id%INFO(1).LT.0)THEN 752 RETURN 753 ENDIF 754 STEP_OOC=>id%STEP 755 PROCNODE_OOC=>id%PROCNODE_STEPS 756 SLAVEF_OOC=id%NSLAVES 757 MYID_OOC=id%MYID 758 KEEP_OOC => id%KEEP 759 SIZE_OF_BLOCK=>id%OOC_SIZE_OF_BLOCK 760 OOC_INODE_SEQUENCE=>id%OOC_INODE_SEQUENCE 761 OOC_VADDR=>id%OOC_VADDR 762 ALLOCATE(IO_REQ(id%KEEP(28)), 763 & stat=allocok) 764 IF (allocok .GT. 0) THEN 765 IF (ICNTL1.GT.0) 766 & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_586' 767 id%INFO(1) = -13 768 id%INFO(2) = id%KEEP(28) 769 RETURN 770 ENDIF 771 CMUMPS_ELEMENTARY_DATA_SIZE = id%KEEP(35) 772 MAX_NB_NODES_FOR_ZONE=id%OOC_MAX_NB_NODES_FOR_ZONE 773 TOTAL_NB_OOC_NODES=>id%OOC_TOTAL_NB_NODES 774 CALL CMUMPS_711( id%KEEP(204), STRAT_IO_ASYNC, 775 & WITH_BUF, LOW_LEVEL_STRAT_IO) 776 IF(id%KEEP(107).GT.0)THEN 777 SIZE_SOLVE_EMM=max(id%KEEP8(20), 778 & FACT_AREA_SIZE / 5_8) 779 SIZE_ZONE_SOLVE=max(SIZE_SOLVE_EMM, 780 & int((dble(FACT_AREA_SIZE)- 781 & dble(SIZE_SOLVE_EMM))/dble(id%KEEP(107)),8)) 782 SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8) 783 IF(SIZE_ZONE_SOLVE.EQ.SIZE_SOLVE_EMM)THEN 784 SIZE_SOLVE_EMM=id%KEEP8(20) 785 SIZE_ZONE_SOLVE=int((real(FACT_AREA_SIZE)- 786 & real(SIZE_SOLVE_EMM))/real(id%KEEP(107)),8) 787 SIZE_ZONE_SOLVE=max(SIZE_ZONE_SOLVE,0_8) 788 ENDIF 789 ELSE 790 SIZE_ZONE_SOLVE=FACT_AREA_SIZE 791 SIZE_SOLVE_EMM=SIZE_ZONE_SOLVE 792 ENDIF 793 IF(SIZE_SOLVE_EMM.LT.id%KEEP8(20))THEN 794 IF (ICNTL1.GT.0) 795 & WRITE(ICNTL1,*)MYID_OOC,': More space needed for 796 & solution step in CMUMPS_586' 797 id%INFO(1) = -11 798 CALL MUMPS_731(id%KEEP8(20), id%INFO(2)) 799 ENDIF 800 TMP=MAX_NB_NODES_FOR_ZONE 801 CALL MPI_ALLREDUCE(TMP,MAX_NB_NODES_FOR_ZONE,1, 802 & MPI_INTEGER,MPI_MAX,id%COMM_NODES, IERR) 803 NB_Z=KEEP_OOC(107)+1 804 ALLOCATE(POS_IN_MEM(MAX_NB_NODES_FOR_ZONE*NB_Z), 805 & INODE_TO_POS(KEEP_OOC(28)), 806 & stat=allocok) 807 IF (allocok .GT. 0) THEN 808 IF (ICNTL1.GT.0) 809 & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_586' 810 id%INFO(1) = -13 811 id%INFO(2) = id%KEEP(28)+(MAX_NB_NODES_FOR_ZONE*NB_Z) 812 RETURN 813 ENDIF 814 ALLOCATE(OOC_STATE_NODE(KEEP_OOC(28)),stat=allocok) 815 IF (allocok .GT. 0) THEN 816 IF (ICNTL1.GT.0) 817 & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_586' 818 id%INFO(1) = -13 819 id%INFO(2) = id%KEEP(28) 820 RETURN 821 ENDIF 822 OOC_STATE_NODE(1:KEEP_OOC(28))=0 823 INODE_TO_POS=0 824 POS_IN_MEM=0 825 ALLOCATE(LRLUS_SOLVE(NB_Z), LRLU_SOLVE_T(NB_Z),LRLU_SOLVE_B(NB_Z), 826 & POSFAC_SOLVE(NB_Z),IDEB_SOLVE_Z(NB_Z), 827 & PDEB_SOLVE_Z(NB_Z),SIZE_SOLVE_Z(NB_Z), 828 & CURRENT_POS_T(NB_Z),CURRENT_POS_B(NB_Z), 829 & POS_HOLE_T(NB_Z),POS_HOLE_B(NB_Z), 830 & stat=allocok) 831 IF (allocok .GT. 0) THEN 832 IF (ICNTL1.GT.0) 833 & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_586' 834 id%INFO(1) = -13 835 id%INFO(2) = 9*(NB_Z+1) 836 RETURN 837 ENDIF 838 IERR=0 839 CALL MUMPS_GET_MAX_NB_REQ_C(MAX_NB_REQ,IERR) 840 ALLOCATE(SIZE_OF_READ(MAX_NB_REQ),FIRST_POS_IN_READ(MAX_NB_REQ), 841 & READ_DEST(MAX_NB_REQ),READ_MNG(MAX_NB_REQ), 842 & REQ_TO_ZONE(MAX_NB_REQ),REQ_ID(MAX_NB_REQ),stat=allocok) 843 SIZE_OF_READ=-9999_8 844 FIRST_POS_IN_READ=-9999 845 READ_DEST=-9999_8 846 READ_MNG=-9999 847 REQ_TO_ZONE=-9999 848 REQ_ID=-9999 849 IF (allocok .GT. 0) THEN 850 IF (ICNTL1.GT.0) 851 & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_586' 852 id%INFO(1) = -13 853 id%INFO(2) = 6*(NB_Z+1) 854 RETURN 855 ENDIF 856 MIN_SIZE_READ=min(max((1024_8*1024_8)/int(id%KEEP(35),8), 857 & SIZE_ZONE_SOLVE/3_8), 858 & SIZE_ZONE_SOLVE) 859 TMP_SIZE8=1_8 860 J=1 861 DO I=1,NB_Z-1 862 IDEB_SOLVE_Z(I)=TMP_SIZE8 863 POSFAC_SOLVE(I)=TMP_SIZE8 864 LRLUS_SOLVE(I)=SIZE_ZONE_SOLVE 865 LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE 866 LRLU_SOLVE_B(I)=0_8 867 SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE 868 CURRENT_POS_T(I)=J 869 CURRENT_POS_B(I)=J 870 PDEB_SOLVE_Z(I)=J 871 POS_HOLE_T(I)=J 872 POS_HOLE_B(I)=J 873 J=J+MAX_NB_NODES_FOR_ZONE 874 TMP_SIZE8=TMP_SIZE8+SIZE_ZONE_SOLVE 875 ENDDO 876 IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8 877 PDEB_SOLVE_Z(NB_Z)=J 878 POSFAC_SOLVE(NB_Z)=TMP_SIZE8 879 LRLUS_SOLVE(NB_Z)=SIZE_SOLVE_EMM 880 LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM 881 LRLU_SOLVE_B(NB_Z)=0_8 882 SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM 883 CURRENT_POS_T(NB_Z)=J 884 CURRENT_POS_B(NB_Z)=J 885 POS_HOLE_T(NB_Z)=J 886 POS_HOLE_B(NB_Z)=J 887 IO_REQ=-77777 888 REQ_ACT=0 889 OOC_STATE_NODE(1:KEEP_OOC(28))=NOT_IN_MEM 890 IF(KEEP_OOC(38).NE.0)THEN 891 MASTER_ROOT=MUMPS_275( 892 & PROCNODE_OOC(STEP_OOC( KEEP_OOC(38))), 893 & SLAVEF_OOC ) 894 SPECIAL_ROOT_NODE=KEEP_OOC(38) 895 ELSEIF(KEEP_OOC(20).NE.0)THEN 896 MASTER_ROOT=MUMPS_275( 897 & PROCNODE_OOC(STEP_OOC( KEEP_OOC(20))), 898 & SLAVEF_OOC ) 899 SPECIAL_ROOT_NODE=KEEP_OOC(20) 900 ELSE 901 MASTER_ROOT=-111111 902 SPECIAL_ROOT_NODE=-2222222 903 ENDIF 904 IF ( KEEP_OOC(60).EQ.0 .AND. 905 & ( 906 & (KEEP_OOC(38).NE.0 .AND. id%root%yes) 907 & .OR. 908 & (KEEP_OOC(20).NE.0 .AND. MYID_OOC.EQ.MASTER_ROOT)) 909 & ) 910 & THEN 911 IS_ROOT_SPECIAL = .TRUE. 912 ELSE 913 IS_ROOT_SPECIAL = .FALSE. 914 ENDIF 915 NB_ZONE_REQ=0 916 SIZE_ZONE_REQ=0_8 917 CURRENT_SOLVE_READ_ZONE=0 918 NB_CALLED=0 919 NB_CALL=0 920 SOLVE_STEP=-9999 921#if defined (NEW_PREF_SCHEME) 922 MAX_PREF_SIZE=(1024*1024*2)/8 923#endif 924 RETURN 925 END SUBROUTINE CMUMPS_586 926 SUBROUTINE CMUMPS_585(A,LA,PTRFAC,NSTEPS,IERR) 927 IMPLICIT NONE 928 INTEGER NSTEPS,IERR 929 INTEGER(8) :: LA 930 COMPLEX A(LA) 931 INTEGER(8) :: PTRFAC(NSTEPS) 932 INTEGER I 933 IERR=0 934 IF(NB_Z.GT.1)THEN 935 IF(STRAT_IO_ASYNC)THEN 936 DO I=1,NB_Z-1 937 CALL CMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) 938 IF(IERR.LT.0)THEN 939 RETURN 940 ENDIF 941 ENDDO 942 ELSE 943 CALL CMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) 944 IF(IERR.LT.0)THEN 945 RETURN 946 ENDIF 947 ENDIF 948 ENDIF 949 RETURN 950 END SUBROUTINE CMUMPS_585 951 SUBROUTINE CMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) 952 IMPLICIT NONE 953 INTEGER NSTEPS,IERR 954 INTEGER(8) :: LA 955 COMPLEX A(LA) 956 INTEGER(8) :: PTRFAC(NSTEPS) 957 INTEGER ZONE 958 CALL CMUMPS_603(ZONE) 959 IERR=0 960 CALL CMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR) 961 RETURN 962 END SUBROUTINE CMUMPS_594 963 SUBROUTINE CMUMPS_595(DEST,INDICE,SIZE, 964 & ZONE,PTRFAC,NSTEPS,POS_SEQ,NB_NODES,FLAG,IERR) 965 IMPLICIT NONE 966 INCLUDE 'mpif.h' 967 INTEGER ZONE,NSTEPS,FLAG,POS_SEQ,NB_NODES 968 COMPLEX DEST 969 INTEGER (8) :: INDICE, SIZE, PTRFAC(NSTEPS) 970 INTEGER REQUEST,INODE,IERR 971 INTEGER ADDR_INT1,ADDR_INT2 972 INTEGER TYPE 973 INTEGER SIZE_INT1,SIZE_INT2 974 TYPE=OOC_SOLVE_TYPE_FCT 975 IERR=0 976 INODE=OOC_INODE_SEQUENCE(POS_SEQ,OOC_FCT_TYPE) 977 CALL MUMPS_677(ADDR_INT1,ADDR_INT2, 978 & OOC_VADDR(STEP_OOC(INODE),OOC_FCT_TYPE)) 979 CALL MUMPS_677(SIZE_INT1,SIZE_INT2, 980 & SIZE) 981 CALL MUMPS_LOW_LEVEL_READ_OOC_C(LOW_LEVEL_STRAT_IO, 982 & DEST,SIZE_INT1,SIZE_INT2, 983 & INODE,REQUEST,TYPE,ADDR_INT1,ADDR_INT2,IERR) 984 IF(IERR.LT.0)THEN 985 IF (ICNTL1.GT.0) 986 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 987 RETURN 988 ENDIF 989 IF(STRAT_IO_ASYNC)THEN 990 CALL CMUMPS_597(INODE,SIZE,INDICE,ZONE, 991 & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) 992 IF(IERR.LT.0)THEN 993 RETURN 994 ENDIF 995 ELSE 996 CALL CMUMPS_597(INODE,SIZE,INDICE,ZONE, 997 & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) 998 IF(IERR.LT.0)THEN 999 RETURN 1000 ENDIF 1001 CALL CMUMPS_596(IO_REQ(STEP_OOC(INODE)), 1002 & PTRFAC,NSTEPS) 1003 REQ_ACT=REQ_ACT-1 1004 ENDIF 1005 END SUBROUTINE CMUMPS_595 1006 SUBROUTINE CMUMPS_596(REQUEST,PTRFAC, 1007 & NSTEPS) 1008 IMPLICIT NONE 1009 INTEGER NSTEPS,REQUEST 1010 INTEGER (8) :: PTRFAC(NSTEPS) 1011 INTEGER (8) :: LAST, POS_IN_S, J 1012 INTEGER ZONE 1013 INTEGER POS_REQ,I,TMP_NODE,POS_IN_MANAGE 1014 INTEGER (8) SIZE 1015 LOGICAL DONT_USE 1016 EXTERNAL MUMPS_330,MUMPS_275 1017 INTEGER MUMPS_330,MUMPS_275 1018 POS_REQ=mod(REQUEST,MAX_NB_REQ)+1 1019 SIZE=SIZE_OF_READ(POS_REQ) 1020 I=FIRST_POS_IN_READ(POS_REQ) 1021 POS_IN_S=READ_DEST(POS_REQ) 1022 POS_IN_MANAGE=READ_MNG(POS_REQ) 1023 ZONE=REQ_TO_ZONE(POS_REQ) 1024 DONT_USE=.FALSE. 1025 J=0_8 1026 DO WHILE((J.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))) 1027 TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) 1028 LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) 1029 IF(LAST.EQ.0_8)THEN 1030 I=I+1 1031 CYCLE 1032 ENDIF 1033 IF((INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0).AND. 1034 & (INODE_TO_POS(STEP_OOC(TMP_NODE)).LT. 1035 & -((N_OOC+1)*NB_Z)))THEN 1036 DONT_USE= 1037 & (((MTYPE_OOC.EQ.1).AND.(KEEP_OOC(50).EQ.0).AND. 1038 & (SOLVE_STEP.EQ.1).AND. 1039 & ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)), 1040 & SLAVEF_OOC).EQ.2).AND.(MUMPS_275( 1041 & PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE. 1042 & MYID_OOC))) 1043 & .OR. 1044 & ((MTYPE_OOC.NE.1).AND.(KEEP_OOC(50).EQ.0).AND. 1045 & (SOLVE_STEP.EQ.0).AND. 1046 & ((MUMPS_330(PROCNODE_OOC(STEP_OOC(TMP_NODE)), 1047 & SLAVEF_OOC).EQ.2).AND.(MUMPS_275( 1048 & PROCNODE_OOC(STEP_OOC(TMP_NODE)),SLAVEF_OOC).NE. 1049 & MYID_OOC)))).OR. 1050 & (OOC_STATE_NODE(STEP_OOC(TMP_NODE)).EQ.ALREADY_USED) 1051 IF(DONT_USE)THEN 1052 PTRFAC(STEP_OOC(TMP_NODE))=-POS_IN_S 1053 ELSE 1054 PTRFAC(STEP_OOC(TMP_NODE))=POS_IN_S 1055 ENDIF 1056 IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).LT. 1057 & IDEB_SOLVE_Z(ZONE))THEN 1058 WRITE(*,*)MYID_OOC,': Inernal error (42) in OOC ', 1059 & PTRFAC(STEP_OOC(TMP_NODE)),IDEB_SOLVE_Z(ZONE) 1060 CALL MUMPS_ABORT() 1061 ENDIF 1062 IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).GT. 1063 & (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN 1064 WRITE(*,*)MYID_OOC,': Inernal error (43) in OOC ' 1065 CALL MUMPS_ABORT() 1066 ENDIF 1067 IF(DONT_USE)THEN 1068 POS_IN_MEM(POS_IN_MANAGE)=-TMP_NODE 1069 INODE_TO_POS(STEP_OOC(TMP_NODE))=-POS_IN_MANAGE 1070 IF(OOC_STATE_NODE(STEP_OOC(TMP_NODE)).NE. 1071 & ALREADY_USED)THEN 1072 OOC_STATE_NODE(STEP_OOC(TMP_NODE))=USED_NOT_PERMUTED 1073 ENDIF 1074 LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+LAST 1075 ELSE 1076 POS_IN_MEM(POS_IN_MANAGE)=TMP_NODE 1077 INODE_TO_POS(STEP_OOC(TMP_NODE))=POS_IN_MANAGE 1078 OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED 1079 ENDIF 1080 IO_REQ(STEP_OOC(TMP_NODE))=-7777 1081 ELSE 1082 POS_IN_MEM(POS_IN_MANAGE)=0 1083 ENDIF 1084 POS_IN_S=POS_IN_S+LAST 1085 POS_IN_MANAGE=POS_IN_MANAGE+1 1086 J=J+LAST 1087 I=I+1 1088 ENDDO 1089 SIZE_OF_READ(POS_REQ)=-9999_8 1090 FIRST_POS_IN_READ(POS_REQ)=-9999 1091 READ_DEST(POS_REQ)=-9999_8 1092 READ_MNG(POS_REQ)=-9999 1093 REQ_TO_ZONE(POS_REQ)=-9999 1094 REQ_ID(POS_REQ)=-9999 1095 RETURN 1096 END SUBROUTINE CMUMPS_596 1097 SUBROUTINE CMUMPS_597(INODE,SIZE,DEST,ZONE, 1098 & REQUEST,POS_SEQ,NB_NODES,FLAG,PTRFAC,NSTEPS,IERR) 1099 IMPLICIT NONE 1100 INTEGER INODE,ZONE,REQUEST,FLAG,POS_SEQ,NB_NODES,NSTEPS 1101 INTEGER(8) :: SIZE 1102 INTEGER(8) :: PTRFAC(NSTEPS) 1103 INTEGER(8) :: DEST, LOCAL_DEST, J8 1104 INTEGER I,TMP_NODE,LOC_I,POS_REQ,NB 1105 INTEGER(8)::LAST 1106 INTEGER, intent(out) :: IERR 1107 IERR=0 1108 IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN 1109 RETURN 1110 ENDIF 1111 NB=0 1112 LOCAL_DEST=DEST 1113 I=POS_SEQ 1114 POS_REQ=mod(REQUEST,MAX_NB_REQ)+1 1115 IF(REQ_ID(POS_REQ).NE.-9999)THEN 1116 CALL MUMPS_WAIT_REQUEST(REQ_ID(POS_REQ),IERR) 1117 IF(IERR.LT.0)THEN 1118 IF (ICNTL1.GT.0) 1119 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 1120 RETURN 1121 ENDIF 1122 CALL CMUMPS_596(REQUEST,PTRFAC,NSTEPS) 1123 REQ_ACT=REQ_ACT-1 1124 ENDIF 1125 SIZE_OF_READ(POS_REQ)=SIZE 1126 FIRST_POS_IN_READ(POS_REQ)=I 1127 READ_DEST(POS_REQ)=DEST 1128 IF(FLAG.EQ.0)THEN 1129 READ_MNG(POS_REQ)=CURRENT_POS_B(ZONE)-NB_NODES+1 1130 ELSEIF(FLAG.EQ.1)THEN 1131 READ_MNG(POS_REQ)=CURRENT_POS_T(ZONE) 1132 ENDIF 1133 REQ_TO_ZONE(POS_REQ)=ZONE 1134 REQ_ID(POS_REQ)=REQUEST 1135 J8=0_8 1136 IF(FLAG.EQ.0)THEN 1137 LOC_I=CURRENT_POS_B(ZONE)-NB_NODES+1 1138 ENDIF 1139 DO WHILE((J8.LT.SIZE).AND.(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))) 1140 TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) 1141 LAST=SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) 1142 IF(LAST.EQ.0_8)THEN 1143 INODE_TO_POS(STEP_OOC(TMP_NODE))=1 1144 OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED 1145 I=I+1 1146 CYCLE 1147 ENDIF 1148 IF((IO_REQ(STEP_OOC(TMP_NODE)).GE.0).OR. 1149 & (INODE_TO_POS(STEP_OOC(TMP_NODE)).NE.0))THEN 1150 IF(FLAG.EQ.1)THEN 1151 POS_IN_MEM(CURRENT_POS_T(ZONE))=0 1152 ELSEIF(FLAG.EQ.0)THEN 1153 POS_IN_MEM(CURRENT_POS_B(ZONE))=0 1154 ENDIF 1155 ELSE 1156 IO_REQ(STEP_OOC(TMP_NODE))=REQUEST 1157 LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)-LAST 1158 IF(FLAG.EQ.1)THEN 1159 IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN 1160 POS_HOLE_B(ZONE)=-9999 1161 CURRENT_POS_B(ZONE)=-9999 1162 LRLU_SOLVE_B(ZONE)=0_8 1163 ENDIF 1164 POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+LAST 1165 LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)-LAST 1166 POS_IN_MEM(CURRENT_POS_T(ZONE))=-TMP_NODE- 1167 & ((N_OOC+1)*NB_Z) 1168 INODE_TO_POS(STEP_OOC(TMP_NODE))=-CURRENT_POS_T(ZONE)- 1169 & ((N_OOC+1)*NB_Z) 1170 OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ 1171 PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST 1172 LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), 1173 & OOC_FCT_TYPE) 1174 ELSEIF(FLAG.EQ.0)THEN 1175 LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)-LAST 1176 POS_IN_MEM(LOC_I)=-TMP_NODE-((N_OOC+1)*NB_Z) 1177 IF(LOC_I.EQ.POS_HOLE_T(ZONE))THEN 1178 IF(POS_HOLE_T(ZONE).LT.CURRENT_POS_T(ZONE))THEN 1179 POS_HOLE_T(ZONE)=POS_HOLE_T(ZONE)+1 1180 ENDIF 1181 ENDIF 1182 INODE_TO_POS(STEP_OOC(TMP_NODE))=-LOC_I-((N_OOC+1)*NB_Z) 1183 OOC_STATE_NODE(STEP_OOC(TMP_NODE))=BEING_READ 1184 PTRFAC(STEP_OOC(TMP_NODE))=-LOCAL_DEST 1185 LOCAL_DEST=LOCAL_DEST+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), 1186 & OOC_FCT_TYPE) 1187 ELSE 1188 WRITE(*,*)MYID_OOC,': Internal error (39) in OOC ', 1189 & ' Invalid Flag Value in ', 1190 & ' CMUMPS_597',FLAG 1191 CALL MUMPS_ABORT() 1192 ENDIF 1193 ENDIF 1194 IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).NE.0)THEN 1195 IF(POS_IN_MEM(CURRENT_POS_T(ZONE)).EQ. 1196 & POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))THEN 1197 IF(CURRENT_POS_T(ZONE).NE.PDEB_SOLVE_Z(ZONE))THEN 1198 WRITE(*,*)MYID_OOC,': Internal error (40) in OOC ', 1199 & CURRENT_POS_T(ZONE), 1200 & PDEB_SOLVE_Z(ZONE), 1201 & POS_IN_MEM(CURRENT_POS_T(ZONE)), 1202 & POS_IN_MEM(PDEB_SOLVE_Z(ZONE)) 1203 CALL MUMPS_ABORT() 1204 ENDIF 1205 ENDIF 1206 ENDIF 1207 J8=J8+LAST 1208 IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN 1209 WRITE(*,*)MYID_OOC,': Internal error (41) in OOC ', 1210 & ' LRLUS_SOLVE must be (1) > 0', 1211 & LRLUS_SOLVE(ZONE) 1212 CALL MUMPS_ABORT() 1213 ENDIF 1214 I=I+1 1215 IF(FLAG.EQ.1)THEN 1216 CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1 1217 IF(CURRENT_POS_T(ZONE).GT. 1218 & MAX_NB_NODES_FOR_ZONE+PDEB_SOLVE_Z(ZONE))THEN 1219 WRITE(*,*)MYID_OOC,': Internal error (1) in OOC ' 1220 CALL MUMPS_ABORT() 1221 ENDIF 1222 POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) 1223 ELSEIF(FLAG.EQ.0)THEN 1224 IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN 1225 WRITE(*,*)MYID_OOC,': Internal error (2) in OOC ', 1226 & POS_HOLE_B(ZONE),LOC_I 1227 CALL MUMPS_ABORT() 1228 ENDIF 1229 CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1 1230 POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE) 1231 IF(POS_HOLE_B(ZONE).LT.PDEB_SOLVE_Z(ZONE))THEN 1232 POS_HOLE_B(ZONE)=-9999 1233 LRLU_SOLVE_B(ZONE)=0_8 1234 ENDIF 1235 ELSE 1236 WRITE(*,*)MYID_OOC,': Internal error (3) in OOC ', 1237 & ' Invalid Flag Value in ', 1238 & ' CMUMPS_597',FLAG 1239 CALL MUMPS_ABORT() 1240 ENDIF 1241 IF(FLAG.EQ.0)THEN 1242 LOC_I=LOC_I+1 1243 ENDIF 1244 NB=NB+1 1245 ENDDO 1246 IF(NB.NE.NB_NODES)THEN 1247 WRITE(*,*)MYID_OOC,': Internal error (4) in OOC ', 1248 & ' CMUMPS_597 ',NB,NB_NODES 1249 ENDIF 1250 IF(SOLVE_STEP.EQ.0)THEN 1251 CUR_POS_SEQUENCE=I 1252 ELSE 1253 CUR_POS_SEQUENCE=POS_SEQ-1 1254 ENDIF 1255 RETURN 1256 END SUBROUTINE CMUMPS_597 1257 SUBROUTINE CMUMPS_598(INODE,PTRFAC,NSTEPS,A, 1258 & LA,FLAG,IERR) 1259 IMPLICIT NONE 1260 INTEGER(8) :: LA 1261 INTEGER, intent(out):: IERR 1262 COMPLEX A(LA) 1263 INTEGER INODE,NSTEPS 1264 INTEGER(8) :: PTRFAC(NSTEPS) 1265 LOGICAL FLAG 1266 INTEGER(8) FREE_SIZE 1267 INTEGER TMP,TMP_NODE,I,ZONE,J, FREE_HOLE_FLAG 1268 INTEGER WHICH 1269 INTEGER(8) :: DUMMY_SIZE 1270 DUMMY_SIZE=1_8 1271 IERR = 0 1272 WHICH=-1 1273 IF(INODE_TO_POS(STEP_OOC(INODE)).LE.0)THEN 1274 WRITE(*,*)MYID_OOC,': Internal error (5) in OOC ', 1275 & ' Problem in CMUMPS_598', 1276 & INODE, STEP_OOC(INODE), INODE_TO_POS(STEP_OOC(INODE)) 1277 CALL MUMPS_ABORT() 1278 ENDIF 1279 IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE).EQ.0_8)THEN 1280 INODE_TO_POS(STEP_OOC(INODE))=0 1281 OOC_STATE_NODE(STEP_OOC(INODE))=ALREADY_USED 1282 RETURN 1283 ENDIF 1284 CALL CMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS) 1285 TMP=INODE_TO_POS(STEP_OOC(INODE)) 1286 INODE_TO_POS(STEP_OOC(INODE))=-TMP 1287 POS_IN_MEM(TMP)=-INODE 1288 PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE)) 1289 IF (KEEP_OOC(237).eq.0) THEN 1290 IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.PERMUTED)THEN 1291 WRITE(*,*)MYID_OOC,': INTERNAL ERROR (53) in OOC',INODE, 1292 & OOC_STATE_NODE(STEP_OOC(INODE)) 1293 CALL MUMPS_ABORT() 1294 ENDIF 1295 ENDIF 1296 OOC_STATE_NODE(STEP_OOC(INODE))=USED 1297 LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+ 1298 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) 1299 IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN 1300 WRITE(*,*)MYID_OOC,': Internal error (6) in OOC ', 1301 & ': LRLUS_SOLVE must be (2) > 0' 1302 CALL MUMPS_ABORT() 1303 ENDIF 1304 IF(ZONE.EQ.NB_Z)THEN 1305 IF(INODE.NE.SPECIAL_ROOT_NODE)THEN 1306 CALL CMUMPS_608(A,FACT_AREA_SIZE, 1307 & DUMMY_SIZE,PTRFAC,KEEP_OOC(28),ZONE,IERR) 1308 ENDIF 1309 ELSE 1310 FREE_HOLE_FLAG=0 1311 IF(SOLVE_STEP.EQ.0)THEN 1312 IF(TMP.GT.POS_HOLE_B(ZONE))THEN 1313 WHICH=0 1314 ELSEIF(TMP.LT.POS_HOLE_T(ZONE))THEN 1315 WHICH=1 1316 ENDIF 1317 ELSEIF(SOLVE_STEP.EQ.1)THEN 1318 IF(TMP.LT.POS_HOLE_T(ZONE))THEN 1319 WHICH=1 1320 ELSEIF(TMP.GT.POS_HOLE_B(ZONE))THEN 1321 WHICH=0 1322 ENDIF 1323 ENDIF 1324 IF(WHICH.EQ.1)THEN 1325 J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE)) 1326 J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) 1327 FREE_SIZE=0_8 1328 DO I=J,TMP,-1 1329 IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. 1330 & -(N_OOC+1)*NB_Z))THEN 1331 TMP_NODE=-POS_IN_MEM(I) 1332 FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), 1333 & OOC_FCT_TYPE) 1334 ELSEIF(POS_IN_MEM(I).NE.0)THEN 1335 GOTO 666 1336 ENDIF 1337 ENDDO 1338 POS_HOLE_T(ZONE)=TMP 1339 666 CONTINUE 1340 ELSEIF(WHICH.EQ.0)THEN 1341 J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE)) 1342 J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) 1343 FREE_SIZE=0_8 1344 DO I=J,TMP 1345 IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. 1346 & -(N_OOC+1)*NB_Z))THEN 1347 TMP_NODE=-POS_IN_MEM(I) 1348 FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), 1349 & OOC_FCT_TYPE) 1350 ELSEIF(POS_IN_MEM(I).NE.0)THEN 1351 IF(J.EQ.PDEB_SOLVE_Z(ZONE))THEN 1352 POS_HOLE_B(ZONE)=-9999 1353 LRLU_SOLVE_B(ZONE)=0_8 1354 CURRENT_POS_B(ZONE)=-9999 1355 ENDIF 1356 GOTO 777 1357 ENDIF 1358 ENDDO 1359 POS_HOLE_B(ZONE)=TMP 1360 777 CONTINUE 1361 ENDIF 1362 IERR=0 1363 ENDIF 1364 IF((NB_Z.GT.1).AND.FLAG)THEN 1365 CALL CMUMPS_601(ZONE) 1366 IF((LRLUS_SOLVE(ZONE).GE.MIN_SIZE_READ).OR. 1367 & (LRLUS_SOLVE(ZONE).GE. 1368 & int(0.3E0*real(SIZE_SOLVE_Z(ZONE)),8)))THEN 1369 CALL CMUMPS_594(A,LA,PTRFAC,NSTEPS,IERR) 1370 IF(IERR.LT.0)THEN 1371 RETURN 1372 ENDIF 1373 ELSE 1374 CALL CMUMPS_603(ZONE) 1375 ENDIF 1376 ENDIF 1377 RETURN 1378 END SUBROUTINE CMUMPS_598 1379 FUNCTION CMUMPS_726(INODE,PTRFAC,NSTEPS,A,LA, 1380 & IERR) 1381 IMPLICIT NONE 1382 INTEGER INODE,NSTEPS 1383 INTEGER(8) :: LA 1384 INTEGER, INTENT(out)::IERR 1385 COMPLEX A(LA) 1386 INTEGER (8) :: PTRFAC(NSTEPS) 1387 INTEGER CMUMPS_726 1388 IERR=0 1389 IF(INODE_TO_POS(STEP_OOC(INODE)).GT.0)THEN 1390 IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN 1391 CMUMPS_726=OOC_NODE_PERMUTED 1392 ELSE 1393 CMUMPS_726=OOC_NODE_NOT_PERMUTED 1394 ENDIF 1395 IF(.NOT.CMUMPS_727())THEN 1396 IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE) 1397 & .EQ.INODE)THEN 1398 IF(SOLVE_STEP.EQ.0)THEN 1399 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 1400 ELSEIF(SOLVE_STEP.EQ.1)THEN 1401 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 1402 ENDIF 1403 CALL CMUMPS_728() 1404 ENDIF 1405 ENDIF 1406 ELSEIF(INODE_TO_POS(STEP_OOC(INODE)).LT.0)THEN 1407 IF(INODE_TO_POS(STEP_OOC(INODE)).LT.-((N_OOC+1)*NB_Z))THEN 1408 CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(INODE)),IERR) 1409 IF(IERR.LT.0)THEN 1410 IF (ICNTL1.GT.0) 1411 & WRITE(ICNTL1,*)MYID_OOC,': Internal error (7) in OOC ', 1412 & ERR_STR_OOC(1:DIM_ERR_STR_OOC) 1413 RETURN 1414 ENDIF 1415 CALL CMUMPS_596(IO_REQ(STEP_OOC(INODE)), 1416 & PTRFAC,NSTEPS) 1417 REQ_ACT=REQ_ACT-1 1418 ELSE 1419 CALL CMUMPS_599(INODE,PTRFAC,NSTEPS) 1420 IF(.NOT.CMUMPS_727())THEN 1421 IF(OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE,OOC_FCT_TYPE).EQ. 1422 & INODE)THEN 1423 IF(SOLVE_STEP.EQ.0)THEN 1424 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 1425 ELSEIF(SOLVE_STEP.EQ.1)THEN 1426 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 1427 ENDIF 1428 CALL CMUMPS_728() 1429 ENDIF 1430 ENDIF 1431 ENDIF 1432 IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.PERMUTED)THEN 1433 CMUMPS_726=OOC_NODE_PERMUTED 1434 ELSE 1435 CMUMPS_726=OOC_NODE_NOT_PERMUTED 1436 ENDIF 1437 ELSE 1438 CMUMPS_726=OOC_NODE_NOT_IN_MEM 1439 ENDIF 1440 RETURN 1441 END FUNCTION CMUMPS_726 1442 SUBROUTINE CMUMPS_682(INODE) 1443 IMPLICIT NONE 1444 INTEGER INODE 1445 IF ( (KEEP_OOC(237).EQ.0) 1446 & .AND. (KEEP_OOC(235).EQ.0) ) THEN 1447 IF(OOC_STATE_NODE(STEP_OOC(INODE)).NE.NOT_USED)THEN 1448 WRITE(*,*)MYID_OOC,': INTERNAL ERROR (51) in OOC',INODE, 1449 & OOC_STATE_NODE(STEP_OOC(INODE)) 1450 CALL MUMPS_ABORT() 1451 ENDIF 1452 ENDIF 1453 OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED 1454 END SUBROUTINE CMUMPS_682 1455 SUBROUTINE CMUMPS_599(INODE,PTRFAC,NSTEPS) 1456 IMPLICIT NONE 1457 INTEGER INODE,NSTEPS 1458 INTEGER (8) :: PTRFAC(NSTEPS) 1459 INTEGER ZONE 1460 INODE_TO_POS(STEP_OOC(INODE))=-INODE_TO_POS(STEP_OOC(INODE)) 1461 POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE)))= 1462 & -POS_IN_MEM(INODE_TO_POS(STEP_OOC(INODE))) 1463 PTRFAC(STEP_OOC(INODE))=-PTRFAC(STEP_OOC(INODE)) 1464 IF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED_NOT_PERMUTED)THEN 1465 OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED 1466 ELSEIF(OOC_STATE_NODE(STEP_OOC(INODE)).EQ.USED)THEN 1467 OOC_STATE_NODE(STEP_OOC(INODE))=PERMUTED 1468 ELSE 1469 WRITE(*,*)MYID_OOC,': Internal error (52) in OOC',INODE, 1470 & OOC_STATE_NODE(STEP_OOC(INODE)), 1471 & INODE_TO_POS(STEP_OOC(INODE)) 1472 CALL MUMPS_ABORT() 1473 ENDIF 1474 CALL CMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE) 1475 IF(INODE_TO_POS(STEP_OOC(INODE)).LE.POS_HOLE_B(ZONE))THEN 1476 IF(INODE_TO_POS(STEP_OOC(INODE)).GT. 1477 & PDEB_SOLVE_Z(ZONE))THEN 1478 POS_HOLE_B(ZONE)= 1479 & INODE_TO_POS(STEP_OOC(INODE))-1 1480 ELSE 1481 CURRENT_POS_B(ZONE)=-9999 1482 POS_HOLE_B(ZONE)=-9999 1483 LRLU_SOLVE_B(ZONE)=0_8 1484 ENDIF 1485 ENDIF 1486 IF(INODE_TO_POS(STEP_OOC(INODE)).GE.POS_HOLE_T(ZONE))THEN 1487 IF(INODE_TO_POS(STEP_OOC(INODE)).LT. 1488 & CURRENT_POS_T(ZONE)-1)THEN 1489 POS_HOLE_T(ZONE)=INODE_TO_POS(STEP_OOC(INODE))+1 1490 ELSE 1491 POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) 1492 ENDIF 1493 ENDIF 1494 CALL CMUMPS_609(INODE,PTRFAC,NSTEPS,1) 1495 END SUBROUTINE CMUMPS_599 1496 SUBROUTINE CMUMPS_600(INODE,ZONE,PTRFAC,NSTEPS) 1497 IMPLICIT NONE 1498 INTEGER INODE,ZONE,NSTEPS 1499 INTEGER (8) :: PTRFAC(NSTEPS) 1500 ZONE=1 1501 DO WHILE (ZONE.LE.NB_Z) 1502 IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN 1503 ZONE=ZONE-1 1504 EXIT 1505 ENDIF 1506 ZONE=ZONE+1 1507 ENDDO 1508 IF(ZONE.EQ.NB_Z+1)THEN 1509 ZONE=ZONE-1 1510 ENDIF 1511 END SUBROUTINE CMUMPS_600 1512 SUBROUTINE CMUMPS_601(ZONE) 1513 IMPLICIT NONE 1514 INTEGER ZONE 1515 ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1)+1 1516 END SUBROUTINE CMUMPS_601 1517 SUBROUTINE CMUMPS_603(ZONE) 1518 IMPLICIT NONE 1519 INTEGER ZONE 1520 IF(NB_Z.GT.1)THEN 1521 CURRENT_SOLVE_READ_ZONE=mod((CURRENT_SOLVE_READ_ZONE+1),NB_Z-1) 1522 ZONE=CURRENT_SOLVE_READ_ZONE+1 1523 ELSE 1524 ZONE=NB_Z 1525 ENDIF 1526 END SUBROUTINE CMUMPS_603 1527 SUBROUTINE CMUMPS_578(INODE,PTRFAC, 1528 & KEEP,KEEP8, 1529 & A,IERR) 1530 IMPLICIT NONE 1531 INTEGER INODE,KEEP(500) 1532 INTEGER, intent(out)::IERR 1533 INTEGER(8) KEEP8(150) 1534 INTEGER(8) :: PTRFAC(KEEP(28)) 1535 COMPLEX A(FACT_AREA_SIZE) 1536 INTEGER(8) :: REQUESTED_SIZE 1537 INTEGER ZONE,IFLAG 1538 IERR=0 1539 IFLAG=0 1540 IF(SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) 1541 & .EQ.0_8)THEN 1542 INODE_TO_POS(STEP_OOC(INODE))=1 1543 OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED 1544 PTRFAC(STEP_OOC(INODE))=1_8 1545 RETURN 1546 ENDIF 1547 REQUESTED_SIZE=SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) 1548 ZONE=NB_Z 1549 IF(CURRENT_POS_T(ZONE).GT. 1550 & (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1))THEN 1551 CALL CMUMPS_608(A,FACT_AREA_SIZE, 1552 & REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR) 1553 IF(IERR.LT.0)THEN 1554 RETURN 1555 ENDIF 1556 ENDIF 1557 IF((LRLU_SOLVE_T(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE), 1558 & OOC_FCT_TYPE)).AND. 1559 & (CURRENT_POS_T(ZONE).LE. 1560 & (PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN 1561 CALL CMUMPS_606(INODE,PTRFAC, 1562 & KEEP,KEEP8,A,ZONE) 1563 ELSEIF(LRLU_SOLVE_B(ZONE).GT.SIZE_OF_BLOCK(STEP_OOC(INODE), 1564 & OOC_FCT_TYPE).AND. 1565 & (CURRENT_POS_B(ZONE).GT.0))THEN 1566 CALL CMUMPS_607(INODE,PTRFAC, 1567 & KEEP,KEEP8,A,ZONE) 1568 ELSE 1569 IF(CMUMPS_579(INODE,ZONE))THEN 1570 IF(SOLVE_STEP.EQ.0)THEN 1571 CALL CMUMPS_604(A,FACT_AREA_SIZE, 1572 & REQUESTED_SIZE,PTRFAC, 1573 & KEEP(28),ZONE,IFLAG,IERR) 1574 IF(IERR.LT.0)THEN 1575 RETURN 1576 ENDIF 1577 IF(IFLAG.EQ.1)THEN 1578 CALL CMUMPS_606(INODE,PTRFAC, 1579 & KEEP,KEEP8,A,ZONE) 1580 ELSEIF(IFLAG.EQ.0)THEN 1581 CALL CMUMPS_605(A,FACT_AREA_SIZE, 1582 & REQUESTED_SIZE,PTRFAC, 1583 & KEEP(28),ZONE,IFLAG,IERR) 1584 IF(IERR.LT.0)THEN 1585 RETURN 1586 ENDIF 1587 IF(IFLAG.EQ.1)THEN 1588 CALL CMUMPS_607(INODE,PTRFAC, 1589 & KEEP,KEEP8,A,ZONE) 1590 ENDIF 1591 ENDIF 1592 ELSE 1593 CALL CMUMPS_605(A,FACT_AREA_SIZE, 1594 & REQUESTED_SIZE,PTRFAC, 1595 & KEEP(28),ZONE,IFLAG,IERR) 1596 IF(IERR.LT.0)THEN 1597 RETURN 1598 ENDIF 1599 IF(IFLAG.EQ.1)THEN 1600 CALL CMUMPS_607(INODE,PTRFAC, 1601 & KEEP,KEEP8,A,ZONE) 1602 ELSEIF(IFLAG.EQ.0)THEN 1603 CALL CMUMPS_604(A,FACT_AREA_SIZE, 1604 & REQUESTED_SIZE,PTRFAC, 1605 & KEEP(28),ZONE,IFLAG,IERR) 1606 IF(IERR.LT.0)THEN 1607 RETURN 1608 ENDIF 1609 IF(IFLAG.EQ.1)THEN 1610 CALL CMUMPS_606(INODE,PTRFAC, 1611 & KEEP,KEEP8,A,ZONE) 1612 ENDIF 1613 ENDIF 1614 ENDIF 1615 IF(IFLAG.EQ.0)THEN 1616 CALL CMUMPS_608(A,FACT_AREA_SIZE, 1617 & REQUESTED_SIZE,PTRFAC,KEEP(28),ZONE,IERR) 1618 IF(IERR.LT.0)THEN 1619 RETURN 1620 ENDIF 1621 CALL CMUMPS_606(INODE,PTRFAC, 1622 & KEEP,KEEP8,A,ZONE) 1623 ENDIF 1624 ELSE 1625 WRITE(*,*)MYID_OOC,': Internal error (8) in OOC ', 1626 & ' Not enough space for Solve',INODE, 1627 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE), 1628 & LRLUS_SOLVE(ZONE) 1629 CALL MUMPS_ABORT() 1630 ENDIF 1631 ENDIF 1632 IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN 1633 WRITE(*,*)MYID_OOC,': Internal error (9) in OOC ', 1634 & ' LRLUS_SOLVE must be (3) > 0' 1635 CALL MUMPS_ABORT() 1636 ENDIF 1637 RETURN 1638 END SUBROUTINE CMUMPS_578 1639 SUBROUTINE CMUMPS_604(A,LA,REQUESTED_SIZE,PTRFAC, 1640 & NSTEPS,ZONE,FLAG,IERR) 1641 IMPLICIT NONE 1642 INTEGER NSTEPS,ZONE,FLAG 1643 INTEGER(8) :: REQUESTED_SIZE, LA 1644 INTEGER(8) :: PTRFAC(NSTEPS) 1645 INTEGER(8) :: FREE_SIZE, FREE_HOLE, FREE_HOLE_POS 1646 COMPLEX A(LA) 1647 INTEGER I,TMP_NODE,FREE_HOLE_FLAG, J 1648 INTEGER, intent(out)::IERR 1649 IERR=0 1650 FLAG=0 1651 IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE).AND. 1652 & (.NOT.(CURRENT_POS_T(ZONE) 1653 & .GT.PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1)))THEN 1654 GOTO 50 1655 ENDIF 1656 J=max(POS_HOLE_B(ZONE),PDEB_SOLVE_Z(ZONE)) 1657 J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) 1658 DO I=POS_HOLE_T(ZONE)-1,J,-1 1659 IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. 1660 & -(N_OOC+1)*NB_Z))THEN 1661 TMP_NODE=-POS_IN_MEM(I) 1662 ELSEIF(POS_IN_MEM(I).NE.0)THEN 1663 EXIT 1664 ENDIF 1665 ENDDO 1666 POS_HOLE_T(ZONE)=I+1 1667 IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR. 1668 & (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR. 1669 & (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN 1670 CURRENT_POS_B(ZONE)=-9999 1671 POS_HOLE_B(ZONE)=-9999 1672 LRLU_SOLVE_B(ZONE)=0_8 1673 POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE) 1674 ENDIF 1675 FREE_HOLE=0_8 1676 FREE_SIZE=0_8 1677 FREE_HOLE_FLAG=0 1678 FREE_HOLE_POS=POSFAC_SOLVE(ZONE) 1679 DO I=CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),-1 1680 IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. 1681 & -(N_OOC+1)*NB_Z))THEN 1682 TMP_NODE=-POS_IN_MEM(I) 1683 IF(FREE_HOLE_FLAG.EQ.1)THEN 1684 FREE_HOLE=FREE_HOLE_POS- 1685 & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ 1686 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) 1687 FREE_HOLE_FLAG=0 1688 FREE_SIZE=FREE_SIZE+FREE_HOLE 1689 ENDIF 1690 FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE))) 1691 PTRFAC(STEP_OOC(TMP_NODE))=-777777_8 1692 INODE_TO_POS(STEP_OOC(TMP_NODE))=0 1693 OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED 1694 POS_IN_MEM(I)=0 1695 FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), 1696 & OOC_FCT_TYPE) 1697 ELSEIF(POS_IN_MEM(I).EQ.0)THEN 1698 FREE_HOLE_FLAG=1 1699 ELSEIF(POS_IN_MEM(I).NE.0)THEN 1700 WRITE(*,*)MYID_OOC,': Internal error (10) in OOC ', 1701 & ' CMUMPS_604', 1702 & CURRENT_POS_T(ZONE)-1,POS_HOLE_T(ZONE),I 1703 CALL MUMPS_ABORT() 1704 ENDIF 1705 ENDDO 1706 IF(POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE))THEN 1707 IF(FREE_HOLE_FLAG.EQ.0)THEN 1708 FREE_HOLE_FLAG=1 1709 ENDIF 1710 ENDIF 1711 IF(FREE_HOLE_FLAG.EQ.1)THEN 1712 IF(POS_HOLE_T(ZONE)-1.GT.PDEB_SOLVE_Z(ZONE))THEN 1713 I=POS_HOLE_T(ZONE)-1 1714 TMP_NODE=abs(POS_IN_MEM(I)) 1715 IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN 1716 TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z 1717 CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) 1718 IF(IERR.LT.0)THEN 1719 WRITE(*,*)MYID_OOC,': Internal error (11) in OOC ', 1720 & ERR_STR_OOC(1:DIM_ERR_STR_OOC) 1721 CALL MUMPS_ABORT() 1722 RETURN 1723 ENDIF 1724 REQ_ACT=REQ_ACT-1 1725 CALL CMUMPS_596( 1726 & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) 1727 FREE_HOLE=FREE_HOLE_POS- 1728 & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ 1729 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) 1730 ELSEIF(TMP_NODE.EQ.0)THEN 1731 DO J=I,PDEB_SOLVE_Z(ZONE),-1 1732 IF(POS_IN_MEM(J).NE.0) EXIT 1733 ENDDO 1734 IF(POS_IN_MEM(J).LT.0)THEN 1735 WRITE(*,*)MYID_OOC,': Internal error (12) in OOC ', 1736 & ' CMUMPS_604' 1737 CALL MUMPS_ABORT() 1738 ENDIF 1739 IF(J.GE.PDEB_SOLVE_Z(ZONE))THEN 1740 TMP_NODE=POS_IN_MEM(J) 1741 FREE_HOLE=FREE_HOLE_POS- 1742 & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ 1743 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) 1744 ELSE 1745 FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE) 1746 ENDIF 1747 ELSEIF(TMP_NODE.LT.0)THEN 1748 WRITE(*,*)MYID_OOC,': Internal error (13) in OOC', 1749 & ' CMUMPS_604' 1750 CALL MUMPS_ABORT() 1751 ELSE 1752 FREE_HOLE=FREE_HOLE_POS- 1753 & (abs(PTRFAC(STEP_OOC(TMP_NODE)))+ 1754 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) 1755 ENDIF 1756 ELSE 1757 FREE_HOLE=FREE_HOLE_POS-IDEB_SOLVE_Z(ZONE) 1758 ENDIF 1759 FREE_SIZE=FREE_SIZE+FREE_HOLE 1760 ENDIF 1761 CURRENT_POS_T(ZONE)=POS_HOLE_T(ZONE) 1762 LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+FREE_SIZE 1763 POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-FREE_SIZE 1764 50 CONTINUE 1765 IF(REQUESTED_SIZE.LE.LRLU_SOLVE_T(ZONE))THEN 1766 FLAG=1 1767 ELSE 1768 FLAG=0 1769 ENDIF 1770 RETURN 1771 END SUBROUTINE CMUMPS_604 1772 SUBROUTINE CMUMPS_605(A,LA,REQUESTED_SIZE, 1773 & PTRFAC,NSTEPS,ZONE,FLAG,IERR) 1774 IMPLICIT NONE 1775 INTEGER NSTEPS,ZONE,FLAG 1776 INTEGER (8) :: REQUESTED_SIZE 1777 INTEGER (8) :: LA 1778 INTEGER (8) :: PTRFAC(NSTEPS) 1779 COMPLEX A(LA) 1780 INTEGER(8) :: FREE_SIZE, FREE_HOLE_POS, FREE_HOLE 1781 INTEGER I,J,TMP_NODE,FREE_HOLE_FLAG 1782 INTEGER, intent(out) :: IERR 1783 IERR=0 1784 FLAG=0 1785 IF(LRLU_SOLVE_B(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN 1786 GOTO 50 1787 ENDIF 1788 IF(POS_HOLE_B(ZONE).EQ.-9999)THEN 1789 GOTO 50 1790 ENDIF 1791 J=max(PDEB_SOLVE_Z(ZONE),POS_HOLE_T(ZONE)) 1792 J=min(J,PDEB_SOLVE_Z(ZONE)+MAX_NB_NODES_FOR_ZONE-1) 1793 DO I=POS_HOLE_B(ZONE)+1,J 1794 IF((POS_IN_MEM(I).LT.0).AND.(POS_IN_MEM(I).GT. 1795 & -(N_OOC+1)*NB_Z))THEN 1796 TMP_NODE=-POS_IN_MEM(I) 1797 FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), 1798 & OOC_FCT_TYPE) 1799 ELSEIF(POS_IN_MEM(I).NE.0)THEN 1800 EXIT 1801 ENDIF 1802 ENDDO 1803 POS_HOLE_B(ZONE)=I-1 1804 IF((POS_HOLE_T(ZONE).EQ.PDEB_SOLVE_Z(ZONE)).OR. 1805 & (POS_HOLE_T(ZONE).LE.POS_HOLE_B(ZONE)).OR. 1806 & (POS_HOLE_T(ZONE).EQ.POS_HOLE_B(ZONE)+1))THEN 1807 CURRENT_POS_B(ZONE)=-9999 1808 POS_HOLE_B(ZONE)=-9999 1809 LRLU_SOLVE_B(ZONE)=0_8 1810 POS_HOLE_T(ZONE)=PDEB_SOLVE_Z(ZONE) 1811 ENDIF 1812 FREE_HOLE=0_8 1813 FREE_SIZE=0_8 1814 FREE_HOLE_FLAG=0 1815 FREE_HOLE_POS=IDEB_SOLVE_Z(ZONE) 1816 IF(POS_HOLE_B(ZONE).EQ.-9999)THEN 1817 GOTO 50 1818 ENDIF 1819 DO I=PDEB_SOLVE_Z(ZONE),POS_HOLE_B(ZONE) 1820 IF((POS_IN_MEM(I).LE.0).AND.(POS_IN_MEM(I).GT. 1821 & -(N_OOC+1)*NB_Z))THEN 1822 TMP_NODE=-POS_IN_MEM(I) 1823 IF(TMP_NODE.NE.0)THEN 1824 IF(I.EQ.PDEB_SOLVE_Z(ZONE))THEN 1825 IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE. 1826 & IDEB_SOLVE_Z(ZONE))THEN 1827 FREE_SIZE=FREE_SIZE+abs(PTRFAC(STEP_OOC(TMP_NODE))) 1828 & -IDEB_SOLVE_Z(ZONE) 1829 ENDIF 1830 ENDIF 1831 IF(FREE_HOLE_FLAG.EQ.1)THEN 1832 FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- 1833 & FREE_HOLE_POS 1834 FREE_HOLE_FLAG=0 1835 FREE_SIZE=FREE_SIZE+FREE_HOLE 1836 ENDIF 1837 FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ 1838 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) 1839 PTRFAC(STEP_OOC(TMP_NODE))=-777777_8 1840 INODE_TO_POS(STEP_OOC(TMP_NODE))=0 1841 OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED 1842 FREE_SIZE=FREE_SIZE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), 1843 & OOC_FCT_TYPE) 1844 ELSE 1845 FREE_HOLE_FLAG=1 1846 ENDIF 1847 POS_IN_MEM(I)=0 1848 ELSEIF(POS_IN_MEM(I).NE.0)THEN 1849 WRITE(*,*)MYID_OOC,': Internal error (14) in OOC ', 1850 & ' CMUMPS_605', 1851 & CURRENT_POS_T(ZONE)-1,POS_HOLE_B(ZONE),I,POS_IN_MEM(I) 1852 CALL MUMPS_ABORT() 1853 ENDIF 1854 ENDDO 1855 IF(FREE_HOLE_FLAG.EQ.1)THEN 1856 IF(POS_HOLE_B(ZONE)+1.LT.CURRENT_POS_T(ZONE)-1)THEN 1857 I=POS_HOLE_B(ZONE)+1 1858 TMP_NODE=abs(POS_IN_MEM(I)) 1859 IF(TMP_NODE.GT.(N_OOC+1)*NB_Z)THEN 1860 TMP_NODE=TMP_NODE-(N_OOC+1)*NB_Z 1861 CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) 1862 IF(IERR.LT.0)THEN 1863 WRITE(*,*)MYID_OOC,': Internal error (15) in OOC ', 1864 & ERR_STR_OOC(1:DIM_ERR_STR_OOC) 1865 CALL MUMPS_ABORT() 1866 RETURN 1867 ENDIF 1868 REQ_ACT=REQ_ACT-1 1869 CALL CMUMPS_596( 1870 & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) 1871 FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))-FREE_HOLE_POS 1872 ELSEIF(TMP_NODE.EQ.0)THEN 1873 DO J=I,CURRENT_POS_T(ZONE)-1 1874 IF(POS_IN_MEM(J).NE.0) EXIT 1875 ENDDO 1876 IF(POS_IN_MEM(J).LT.0)THEN 1877 WRITE(*,*)MYID_OOC,': Internal error (16) in OOC ', 1878 & ' CMUMPS_605' 1879 CALL MUMPS_ABORT() 1880 ENDIF 1881 IF(J.LE.CURRENT_POS_T(ZONE)-1)THEN 1882 TMP_NODE=POS_IN_MEM(J) 1883 FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- 1884 & FREE_HOLE_POS 1885 ELSE 1886 FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS 1887 ENDIF 1888 ELSEIF(TMP_NODE.LT.0)THEN 1889 WRITE(*,*)MYID_OOC,': Internal error (17) in OOC ', 1890 & ' CMUMPS_605' 1891 CALL MUMPS_ABORT() 1892 ELSE 1893 FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- 1894 & FREE_HOLE_POS 1895 ENDIF 1896 ELSE 1897 FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS 1898 ENDIF 1899 FREE_SIZE=FREE_SIZE+FREE_HOLE 1900 ENDIF 1901 LRLU_SOLVE_B(ZONE)=FREE_SIZE 1902 IF(POS_HOLE_B(ZONE).LT.CURRENT_POS_T(ZONE)-1)THEN 1903 TMP_NODE=POS_IN_MEM(POS_HOLE_B(ZONE)+1) 1904 IF(TMP_NODE.LT.-(N_OOC+1)*NB_Z)THEN 1905 TMP_NODE=abs(TMP_NODE)-(N_OOC+1)*NB_Z 1906 CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) 1907 IF(IERR.LT.0)THEN 1908 WRITE(*,*)MYID_OOC,': Internal error (18) in OOC ', 1909 & ERR_STR_OOC(1:DIM_ERR_STR_OOC) 1910 CALL MUMPS_ABORT() 1911 RETURN 1912 ENDIF 1913 REQ_ACT=REQ_ACT-1 1914 CALL CMUMPS_596( 1915 & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) 1916 ENDIF 1917 LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)+ 1918 & (abs(PTRFAC(STEP_OOC(abs(TMP_NODE))))-IDEB_SOLVE_Z(ZONE)- 1919 & LRLU_SOLVE_B(ZONE)) 1920 ENDIF 1921 CURRENT_POS_B(ZONE)=POS_HOLE_B(ZONE) 1922 50 CONTINUE 1923 IF((POS_HOLE_B(ZONE).EQ.-9999).AND. 1924 & (LRLU_SOLVE_B(ZONE).NE.0_8))THEN 1925 WRITE(*,*)MYID_OOC,': Internal error (19) in OOC ', 1926 & 'CMUMPS_605' 1927 CALL MUMPS_ABORT() 1928 ENDIF 1929 IF((REQUESTED_SIZE.LE.LRLU_SOLVE_B(ZONE)).AND. 1930 & (POS_HOLE_B(ZONE).NE.-9999))THEN 1931 FLAG=1 1932 ELSE 1933 FLAG=0 1934 ENDIF 1935 END SUBROUTINE CMUMPS_605 1936 SUBROUTINE CMUMPS_606(INODE,PTRFAC, 1937 & KEEP,KEEP8, A,ZONE) 1938 IMPLICIT NONE 1939 INTEGER INODE,KEEP(500) 1940 INTEGER(8) KEEP8(150) 1941 INTEGER(8) :: PTRFAC(KEEP(28)) 1942 COMPLEX A(FACT_AREA_SIZE) 1943 INTEGER ZONE 1944 LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)- 1945 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) 1946 LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- 1947 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) 1948 PTRFAC(STEP_OOC(INODE))=POSFAC_SOLVE(ZONE) 1949 OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED 1950 IF(POSFAC_SOLVE(ZONE).EQ.IDEB_SOLVE_Z(ZONE))THEN 1951 POS_HOLE_B(ZONE)=-9999 1952 CURRENT_POS_B(ZONE)=-9999 1953 LRLU_SOLVE_B(ZONE)=0_8 1954 ENDIF 1955 IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN 1956 WRITE(*,*)MYID_OOC,': Internal error (20) in OOC ', 1957 & ' Problem avec debut (2)',INODE, 1958 & PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE),ZONE 1959 CALL MUMPS_ABORT() 1960 ENDIF 1961 INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_T(ZONE) 1962 POS_IN_MEM(CURRENT_POS_T(ZONE))=INODE 1963 IF(CURRENT_POS_T(ZONE).GT.(PDEB_SOLVE_Z(ZONE)+ 1964 & MAX_NB_NODES_FOR_ZONE-1))THEN 1965 WRITE(*,*)MYID_OOC,': Internal error (21) in OOC ', 1966 & ' Problem with CURRENT_POS_T', 1967 & CURRENT_POS_T(ZONE),ZONE 1968 CALL MUMPS_ABORT() 1969 ENDIF 1970 CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)+1 1971 POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) 1972 POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) 1973 POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)+ 1974 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) 1975 END SUBROUTINE CMUMPS_606 1976 SUBROUTINE CMUMPS_607(INODE,PTRFAC, 1977 & KEEP,KEEP8, 1978 & A,ZONE) 1979 IMPLICIT NONE 1980 INTEGER INODE,KEEP(500) 1981 INTEGER(8) KEEP8(150) 1982 INTEGER(8) :: PTRFAC(KEEP(28)) 1983 COMPLEX A(FACT_AREA_SIZE) 1984 INTEGER ZONE 1985 IF(POS_HOLE_B(ZONE).EQ.-9999)THEN 1986 WRITE(*,*)MYID_OOC,': Internal error (22) in OOC ', 1987 & ' CMUMPS_607' 1988 CALL MUMPS_ABORT() 1989 ENDIF 1990 LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- 1991 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) 1992 LRLU_SOLVE_B(ZONE)=LRLU_SOLVE_B(ZONE)- 1993 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) 1994 PTRFAC(STEP_OOC(INODE))=IDEB_SOLVE_Z(ZONE)+ 1995 & LRLU_SOLVE_B(ZONE) 1996 OOC_STATE_NODE(STEP_OOC(INODE))=NOT_USED 1997 IF(PTRFAC(STEP_OOC(INODE)).LT.IDEB_SOLVE_Z(ZONE))THEN 1998 WRITE(*,*)MYID_OOC,': Internal error (23) in OOC ', 1999 & PTRFAC(STEP_OOC(INODE)),IDEB_SOLVE_Z(ZONE) 2000 CALL MUMPS_ABORT() 2001 ENDIF 2002 INODE_TO_POS(STEP_OOC(INODE))=CURRENT_POS_B(ZONE) 2003 IF(CURRENT_POS_B(ZONE).EQ.0)THEN 2004 WRITE(*,*)MYID_OOC,': Internal error (23b) in OOC ' 2005 CALL MUMPS_ABORT() 2006 ENDIF 2007 POS_IN_MEM(CURRENT_POS_B(ZONE))=INODE 2008 CURRENT_POS_B(ZONE)=CURRENT_POS_B(ZONE)-1 2009 POS_HOLE_B(ZONE)=CURRENT_POS_B(ZONE) 2010 END SUBROUTINE CMUMPS_607 2011 SUBROUTINE CMUMPS_608(A,LA,REQUESTED_SIZE,PTRFAC, 2012 & NSTEPS,ZONE,IERR) 2013 IMPLICIT NONE 2014 INTEGER(8) :: LA, REQUESTED_SIZE 2015 INTEGER NSTEPS,ZONE 2016 INTEGER, intent(out) :: IERR 2017 INTEGER(8) :: PTRFAC(NSTEPS) 2018 COMPLEX A(LA) 2019 INTEGER (8) :: APOS_FIRST_FREE, 2020 & SIZE_HOLE, 2021 & FREE_HOLE, 2022 & FREE_HOLE_POS 2023 INTEGER J,I,TMP_NODE, NB_FREE, IPOS_FIRST_FREE 2024 INTEGER(8) :: K8, AREA_POINTER 2025 INTEGER FREE_HOLE_FLAG 2026 IERR=0 2027 IF(LRLU_SOLVE_T(ZONE).EQ.SIZE_SOLVE_Z(ZONE))THEN 2028 RETURN 2029 ENDIF 2030 AREA_POINTER=IDEB_SOLVE_Z(ZONE) 2031 SIZE_HOLE=0_8 2032 DO I=PDEB_SOLVE_Z(ZONE),CURRENT_POS_T(ZONE)-1 2033 IF((POS_IN_MEM(I).LE.0).AND. 2034 & (POS_IN_MEM(I).GT.-((N_OOC+1)*NB_Z))) GOTO 666 2035 TMP_NODE=abs(POS_IN_MEM(I)) 2036 IF(TMP_NODE.GT.((N_OOC+1)*NB_Z))THEN 2037 TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z) 2038 ENDIF 2039 AREA_POINTER=AREA_POINTER+ 2040 & abs(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) 2041 ENDDO 2042 666 CONTINUE 2043 IF((I.EQ.CURRENT_POS_T(ZONE)-1).AND. 2044 & (PDEB_SOLVE_Z(ZONE).NE.CURRENT_POS_T(ZONE)-1))THEN 2045 IF((POS_IN_MEM(I).GT.0).OR. 2046 & (POS_IN_MEM(I).LT.-((N_OOC+1)*NB_Z)))THEN 2047 WRITE(*,*)MYID_OOC,': Internal error (25) in OOC ', 2048 & ': There are no free blocks ', 2049 & 'in CMUMPS_608',PDEB_SOLVE_Z(ZONE), 2050 & CURRENT_POS_T(ZONE) 2051 CALL MUMPS_ABORT() 2052 ENDIF 2053 ENDIF 2054 IF(POS_IN_MEM(I).EQ.0)THEN 2055 APOS_FIRST_FREE=AREA_POINTER 2056 FREE_HOLE_POS=AREA_POINTER 2057 ELSE 2058 TMP_NODE=abs(POS_IN_MEM(I)) 2059 APOS_FIRST_FREE=abs(PTRFAC(STEP_OOC(TMP_NODE))) 2060 ENDIF 2061 IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).NE.0)THEN 2062 IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).LT.-((N_OOC+1)*NB_Z))THEN 2063 TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)))- 2064 & ((N_OOC+1)*NB_Z) 2065 CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) 2066 IF(IERR.LT.0)THEN 2067 RETURN 2068 ENDIF 2069 REQ_ACT=REQ_ACT-1 2070 CALL CMUMPS_596( 2071 & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) 2072 ELSE 2073 TMP_NODE=abs(POS_IN_MEM(PDEB_SOLVE_Z(ZONE))) 2074 ENDIF 2075 IF(abs(PTRFAC(STEP_OOC(TMP_NODE))).NE.IDEB_SOLVE_Z(ZONE))THEN 2076 IF((POS_IN_MEM(I).NE.0).OR.(I.EQ.CURRENT_POS_T(ZONE)))THEN 2077 SIZE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- 2078 & IDEB_SOLVE_Z(ZONE) 2079 ENDIF 2080 APOS_FIRST_FREE=IDEB_SOLVE_Z(ZONE) 2081 IF(POS_IN_MEM(PDEB_SOLVE_Z(ZONE)).GT.0)THEN 2082 DO J=PDEB_SOLVE_Z(ZONE),I-1 2083 TMP_NODE=POS_IN_MEM(J) 2084 IF(TMP_NODE.LE.0)THEN 2085 IF(TMP_NODE.LT.-((N_OOC+1)*NB_Z))THEN 2086 TMP_NODE=abs(POS_IN_MEM(J))-((N_OOC+1)*NB_Z) 2087 CALL MUMPS_WAIT_REQUEST( 2088 & IO_REQ(STEP_OOC(TMP_NODE)),IERR) 2089 IF(IERR.LT.0)THEN 2090 RETURN 2091 ENDIF 2092 REQ_ACT=REQ_ACT-1 2093 CALL CMUMPS_596( 2094 & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) 2095 TMP_NODE=POS_IN_MEM(J) 2096 ELSE 2097 WRITE(*,*)MYID_OOC,': Internal error (26) in OOC ', 2098 & ' CMUMPS_608',TMP_NODE, 2099 & J,I-1,(N_OOC+1)*NB_Z 2100 CALL MUMPS_ABORT() 2101 ENDIF 2102 ENDIF 2103 DO K8=1_8, 2104 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) 2105 A(APOS_FIRST_FREE+K8-1_8)= 2106 & A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8) 2107 ENDDO 2108 PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE 2109 APOS_FIRST_FREE=APOS_FIRST_FREE+ 2110 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) 2111 ENDDO 2112 ENDIF 2113 ENDIF 2114 ENDIF 2115 NB_FREE=0 2116 FREE_HOLE=0_8 2117 FREE_HOLE_FLAG=0 2118 DO J=I,CURRENT_POS_T(ZONE)-1 2119 TMP_NODE=abs(POS_IN_MEM(J)) 2120 IF(POS_IN_MEM(J).LT.-((N_OOC+1)*NB_Z))THEN 2121 TMP_NODE=TMP_NODE-((N_OOC+1)*NB_Z) 2122 CALL MUMPS_WAIT_REQUEST(IO_REQ(STEP_OOC(TMP_NODE)),IERR) 2123 IF(IERR.LT.0)THEN 2124 RETURN 2125 ENDIF 2126 REQ_ACT=REQ_ACT-1 2127 CALL CMUMPS_596( 2128 & IO_REQ(STEP_OOC(TMP_NODE)),PTRFAC,NSTEPS) 2129 TMP_NODE=abs(POS_IN_MEM(J)) 2130 ENDIF 2131 IF(POS_IN_MEM(J).GT.0)THEN 2132 DO K8=1_8,SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) 2133 A(APOS_FIRST_FREE+K8-1_8)= 2134 & A(PTRFAC(STEP_OOC(TMP_NODE))+K8-1_8) 2135 ENDDO 2136 IF(FREE_HOLE_FLAG.EQ.1)THEN 2137 FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- 2138 & FREE_HOLE_POS 2139 FREE_HOLE_FLAG=0 2140 SIZE_HOLE=SIZE_HOLE+FREE_HOLE 2141 ENDIF 2142 FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ 2143 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) 2144 PTRFAC(STEP_OOC(TMP_NODE))=APOS_FIRST_FREE 2145 APOS_FIRST_FREE=APOS_FIRST_FREE+ 2146 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) 2147 ELSEIF(POS_IN_MEM(J).EQ.0)THEN 2148 FREE_HOLE_FLAG=1 2149 NB_FREE=NB_FREE+1 2150 ELSE 2151 NB_FREE=NB_FREE+1 2152 IF(FREE_HOLE_FLAG.EQ.1)THEN 2153 FREE_HOLE=abs(PTRFAC(STEP_OOC(TMP_NODE)))- 2154 & FREE_HOLE_POS 2155 FREE_HOLE_FLAG=0 2156 SIZE_HOLE=SIZE_HOLE+FREE_HOLE 2157 ENDIF 2158 FREE_HOLE_POS=abs(PTRFAC(STEP_OOC(TMP_NODE)))+ 2159 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) 2160 SIZE_HOLE=SIZE_HOLE+SIZE_OF_BLOCK(STEP_OOC(TMP_NODE), 2161 & OOC_FCT_TYPE) 2162 PTRFAC(STEP_OOC(abs(POS_IN_MEM(J))))=-77777_8 2163 ENDIF 2164 ENDDO 2165 IF(FREE_HOLE_FLAG.EQ.1)THEN 2166 FREE_HOLE=POSFAC_SOLVE(ZONE)-FREE_HOLE_POS 2167 FREE_HOLE_FLAG=0 2168 SIZE_HOLE=SIZE_HOLE+FREE_HOLE 2169 ENDIF 2170 IPOS_FIRST_FREE=I 2171 DO J=I,CURRENT_POS_T(ZONE)-1 2172 IF(POS_IN_MEM(J).LT.0)THEN 2173 TMP_NODE=abs(POS_IN_MEM(J)) 2174 INODE_TO_POS(STEP_OOC(TMP_NODE))=0 2175 POS_IN_MEM(J)=0 2176 OOC_STATE_NODE(STEP_OOC(TMP_NODE))=ALREADY_USED 2177 ELSEIF(POS_IN_MEM(J).GT.0)THEN 2178 TMP_NODE=abs(POS_IN_MEM(J)) 2179 POS_IN_MEM(IPOS_FIRST_FREE)=POS_IN_MEM(J) 2180 INODE_TO_POS(STEP_OOC(TMP_NODE))=IPOS_FIRST_FREE 2181 IPOS_FIRST_FREE=IPOS_FIRST_FREE+1 2182 ENDIF 2183 ENDDO 2184 LRLU_SOLVE_T(ZONE)=LRLU_SOLVE_T(ZONE)+SIZE_HOLE 2185 POSFAC_SOLVE(ZONE)=POSFAC_SOLVE(ZONE)-SIZE_HOLE 2186 CURRENT_POS_T(ZONE)=CURRENT_POS_T(ZONE)-NB_FREE 2187 POS_HOLE_T(ZONE)=CURRENT_POS_T(ZONE) 2188 LRLU_SOLVE_B(ZONE)=0_8 2189 POS_HOLE_B(ZONE)=-9999 2190 CURRENT_POS_B(ZONE)=-9999 2191 LRLU_SOLVE_B(ZONE)=0_8 2192 IF(LRLU_SOLVE_T(ZONE).NE.LRLUS_SOLVE(ZONE))THEN 2193 WRITE(*,*)MYID_OOC,': Internal error (27) in OOC ', 2194 & LRLU_SOLVE_T(ZONE), 2195 & LRLUS_SOLVE(ZONE) 2196 CALL MUMPS_ABORT() 2197 ENDIF 2198 LRLU_SOLVE_T(ZONE)=LRLUS_SOLVE(ZONE) 2199 IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN 2200 WRITE(*,*)MYID_OOC,': Internal error (28) in OOC ', 2201 & ' LRLUS_SOLVE must be (4) > 0' 2202 CALL MUMPS_ABORT() 2203 ENDIF 2204 IF(POSFAC_SOLVE(ZONE).LT.IDEB_SOLVE_Z(ZONE))THEN 2205 WRITE(*,*)MYID_OOC,': Internal error (29) in OOC ', 2206 & POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE) 2207 CALL MUMPS_ABORT() 2208 ENDIF 2209 IF(POSFAC_SOLVE(ZONE).NE.(IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)- 2210 & LRLUS_SOLVE(ZONE)))THEN 2211 WRITE(*,*)MYID_OOC,': Internal error (30) in OOC ', 2212 & ' Problem avec debut POSFAC_SOLVE', 2213 & POSFAC_SOLVE(ZONE),(SIZE_SOLVE_Z(ZONE)- 2214 & LRLUS_SOLVE(ZONE))+IDEB_SOLVE_Z(ZONE),LRLUS_SOLVE(ZONE) 2215 CALL MUMPS_ABORT() 2216 ENDIF 2217 IF(POSFAC_SOLVE(ZONE).GT. 2218 & (IDEB_SOLVE_Z(ZONE)+SIZE_SOLVE_Z(ZONE)-1_8))THEN 2219 WRITE(*,*)MYID_OOC,': Internal error (31) in OOC ', 2220 & POSFAC_SOLVE(ZONE),IDEB_SOLVE_Z(ZONE)+ 2221 & SIZE_SOLVE_Z(ZONE)-1_8 2222 CALL MUMPS_ABORT() 2223 ENDIF 2224 RETURN 2225 END SUBROUTINE CMUMPS_608 2226 SUBROUTINE CMUMPS_609(INODE,PTRFAC,NSTEPS,FLAG) 2227 IMPLICIT NONE 2228 INTEGER INODE,NSTEPS,FLAG 2229 INTEGER (8) :: PTRFAC(NSTEPS) 2230 INTEGER ZONE 2231 IF((FLAG.LT.0).OR.(FLAG.GT.1))THEN 2232 WRITE(*,*)MYID_OOC,': Internal error (32) in OOC ', 2233 & ' CMUMPS_609' 2234 CALL MUMPS_ABORT() 2235 ENDIF 2236 CALL CMUMPS_610(PTRFAC(STEP_OOC(INODE)),ZONE) 2237 IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN 2238 WRITE(*,*)MYID_OOC,': Internal error (33) in OOC ', 2239 & ' LRLUS_SOLVE must be (5) ++ > 0' 2240 CALL MUMPS_ABORT() 2241 ENDIF 2242 IF(FLAG.EQ.0)THEN 2243 LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)+ 2244 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) 2245 ELSE 2246 LRLUS_SOLVE(ZONE)=LRLUS_SOLVE(ZONE)- 2247 & SIZE_OF_BLOCK(STEP_OOC(INODE),OOC_FCT_TYPE) 2248 ENDIF 2249 IF(LRLUS_SOLVE(ZONE).LT.0_8)THEN 2250 WRITE(*,*)MYID_OOC,': Internal error (34) in OOC ', 2251 & ' LRLUS_SOLVE must be (5) > 0' 2252 CALL MUMPS_ABORT() 2253 ENDIF 2254 END SUBROUTINE CMUMPS_609 2255 SUBROUTINE CMUMPS_610(ADDR,ZONE) 2256 IMPLICIT NONE 2257 INTEGER (8) :: ADDR 2258 INTEGER ZONE 2259 INTEGER I 2260 I=1 2261 DO WHILE (I.LE.NB_Z) 2262 IF(ADDR.LT.IDEB_SOLVE_Z(I))THEN 2263 EXIT 2264 ENDIF 2265 I=I+1 2266 ENDDO 2267 ZONE=I-1 2268 END SUBROUTINE CMUMPS_610 2269 FUNCTION CMUMPS_727() 2270 IMPLICIT NONE 2271 LOGICAL CMUMPS_727 2272 CMUMPS_727=.FALSE. 2273 IF(SOLVE_STEP.EQ.0)THEN 2274 IF(CUR_POS_SEQUENCE.GT.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN 2275 CMUMPS_727=.TRUE. 2276 ENDIF 2277 ELSEIF(SOLVE_STEP.EQ.1)THEN 2278 IF(CUR_POS_SEQUENCE.LT.1)THEN 2279 CMUMPS_727=.TRUE. 2280 ENDIF 2281 ENDIF 2282 RETURN 2283 END FUNCTION CMUMPS_727 2284 SUBROUTINE CMUMPS_611(ZONE,A,LA,PTRFAC,NSTEPS,IERR) 2285 IMPLICIT NONE 2286 INTEGER NSTEPS,ZONE 2287 INTEGER(8), INTENT(IN) :: LA 2288 INTEGER, intent(out) :: IERR 2289 COMPLEX A(LA) 2290 INTEGER(8) :: PTRFAC(NSTEPS) 2291 INTEGER(8) :: SIZE, DEST 2292 INTEGER(8) :: NEEDED_SIZE 2293 INTEGER FLAG,TMP_FLAG,POS_SEQ,TMP_NODE, 2294 & NB_NODES 2295 IERR=0 2296 TMP_FLAG=0 2297 FLAG=0 2298 IF(CMUMPS_727())THEN 2299 RETURN 2300 ENDIF 2301 IF(SOLVE_STEP.EQ.0)THEN 2302 IF(CUR_POS_SEQUENCE.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN 2303 TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, 2304 & OOC_FCT_TYPE) 2305 DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT. 2306 & SIZE_SOLVE_Z(ZONE)) 2307 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 2308 IF(CMUMPS_727())THEN 2309 RETURN 2310 ENDIF 2311 TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, 2312 & OOC_FCT_TYPE) 2313 ENDDO 2314 CALL CMUMPS_728() 2315 NEEDED_SIZE=max(MIN_SIZE_READ, 2316 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) 2317 ELSE 2318 NEEDED_SIZE=MIN_SIZE_READ 2319 ENDIF 2320 ELSEIF(SOLVE_STEP.EQ.1)THEN 2321 IF(CUR_POS_SEQUENCE.GE.1)THEN 2322 TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, 2323 & OOC_FCT_TYPE) 2324 DO WHILE(SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE).GT. 2325 & SIZE_SOLVE_Z(ZONE)) 2326 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 2327 IF(CMUMPS_727())THEN 2328 RETURN 2329 ENDIF 2330 TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, 2331 & OOC_FCT_TYPE) 2332 ENDDO 2333 CALL CMUMPS_728() 2334 NEEDED_SIZE=max(MIN_SIZE_READ, 2335 & SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE)) 2336 ELSE 2337 NEEDED_SIZE=MIN_SIZE_READ 2338 ENDIF 2339 ENDIF 2340 IF(LRLUS_SOLVE(ZONE).LT.NEEDED_SIZE)THEN 2341 RETURN 2342 ELSEIF((LRLU_SOLVE_T(ZONE).LT.NEEDED_SIZE).AND. 2343 & (LRLU_SOLVE_B(ZONE).LT.NEEDED_SIZE).AND. 2344 & (dble(LRLUS_SOLVE(ZONE)).LT.0.3d0* 2345 & dble(SIZE_SOLVE_Z(ZONE)))) THEN 2346 RETURN 2347 ENDIF 2348 IF((LRLU_SOLVE_T(ZONE).GT.NEEDED_SIZE).AND.(SOLVE_STEP.EQ.0).AND. 2349 & ((CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1).LT. 2350 & MAX_NB_NODES_FOR_ZONE))THEN 2351 FLAG=1 2352 ELSE 2353 IF(SOLVE_STEP.EQ.0)THEN 2354 CALL CMUMPS_604(A,FACT_AREA_SIZE, 2355 & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) 2356 IF(IERR.LT.0)THEN 2357 RETURN 2358 ENDIF 2359 FLAG=1 2360 IF(TMP_FLAG.EQ.0)THEN 2361 CALL CMUMPS_605(A,FACT_AREA_SIZE, 2362 & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) 2363 IF(IERR.LT.0)THEN 2364 RETURN 2365 ENDIF 2366 FLAG=0 2367 ENDIF 2368 ELSE 2369 CALL CMUMPS_605(A,FACT_AREA_SIZE, 2370 & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) 2371 IF(IERR.LT.0)THEN 2372 RETURN 2373 ENDIF 2374 FLAG=0 2375 IF(TMP_FLAG.EQ.0)THEN 2376 CALL CMUMPS_604(A,FACT_AREA_SIZE, 2377 & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,TMP_FLAG,IERR) 2378 IF(IERR.LT.0)THEN 2379 RETURN 2380 ENDIF 2381 FLAG=1 2382 ENDIF 2383 ENDIF 2384 IF(TMP_FLAG.EQ.0)THEN 2385 CALL CMUMPS_608(A,FACT_AREA_SIZE, 2386 & NEEDED_SIZE,PTRFAC,NSTEPS,ZONE,IERR) 2387 IF(IERR.LT.0)THEN 2388 RETURN 2389 ENDIF 2390 FLAG=1 2391 ENDIF 2392 ENDIF 2393 CALL CMUMPS_602(ZONE,SIZE,DEST,POS_SEQ, 2394 & NB_NODES,FLAG,PTRFAC,NSTEPS) 2395 IF(SIZE.EQ.0_8)THEN 2396 RETURN 2397 ENDIF 2398 NB_ZONE_REQ=NB_ZONE_REQ+1 2399 SIZE_ZONE_REQ=SIZE_ZONE_REQ+SIZE 2400 REQ_ACT=REQ_ACT+1 2401 CALL CMUMPS_595(A(DEST),DEST,SIZE,ZONE,PTRFAC,NSTEPS, 2402 & POS_SEQ,NB_NODES,FLAG,IERR) 2403 IF(IERR.LT.0)THEN 2404 RETURN 2405 ENDIF 2406 END SUBROUTINE CMUMPS_611 2407 SUBROUTINE CMUMPS_602(ZONE,SIZE,DEST,POS_SEQ, 2408 & NB_NODES,FLAG,PTRFAC,NSTEPS) 2409 IMPLICIT NONE 2410 INTEGER(8) :: SIZE, DEST 2411 INTEGER ZONE,FLAG,POS_SEQ,NSTEPS 2412 INTEGER(8) :: PTRFAC(NSTEPS), MAX_SIZE, LAST, J8 2413 INTEGER I,START_NODE,K,MAX_NB, 2414 & NB_NODES 2415 INTEGER NB_NODES_LOC 2416 LOGICAL ALREADY 2417 IF(CMUMPS_727())THEN 2418 SIZE=0_8 2419 RETURN 2420 ENDIF 2421 IF(FLAG.EQ.0)THEN 2422 MAX_SIZE=LRLU_SOLVE_B(ZONE) 2423 MAX_NB=max(0,CURRENT_POS_B(ZONE)-PDEB_SOLVE_Z(ZONE)+1) 2424 ELSEIF(FLAG.EQ.1)THEN 2425 MAX_SIZE=LRLU_SOLVE_T(ZONE) 2426 MAX_NB=MAX_NB_NODES_FOR_ZONE 2427 ELSE 2428 WRITE(*,*)MYID_OOC,': Internal error (35) in OOC ', 2429 & ' Unknown Flag value in ', 2430 & ' CMUMPS_602',FLAG 2431 CALL MUMPS_ABORT() 2432 ENDIF 2433 CALL CMUMPS_728() 2434 I=CUR_POS_SEQUENCE 2435 START_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) 2436 ALREADY=.FALSE. 2437 NB_NODES=0 2438 NB_NODES_LOC=0 2439#if defined (NEW_PREF_SCHEME) 2440 IF(MAX_SIZE.GT.MAX_PREF_SIZE)THEN 2441 MAX_SIZE=MIN(MAX(MAX_PREF_SIZE, 2442 & SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE)), 2443 & MAX_SIZE) 2444 ENDIF 2445#endif 2446 IF(ZONE.EQ.NB_Z)THEN 2447 SIZE=SIZE_OF_BLOCK(STEP_OOC(START_NODE),OOC_FCT_TYPE) 2448 ELSE 2449 J8=0_8 2450 IF(FLAG.EQ.0)THEN 2451 K=0 2452 ELSEIF(FLAG.EQ.1)THEN 2453 K=CURRENT_POS_T(ZONE)-PDEB_SOLVE_Z(ZONE)+1 2454 ENDIF 2455 IF(SOLVE_STEP.EQ.0)THEN 2456 I=CUR_POS_SEQUENCE 2457 DO WHILE(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) 2458 IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, 2459 & OOC_FCT_TYPE)), 2460 & OOC_FCT_TYPE) 2461 & .NE.0_8)THEN 2462 EXIT 2463 ENDIF 2464 I=I+1 2465 ENDDO 2466 CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) 2467 I=CUR_POS_SEQUENCE 2468 DO WHILE((J8.LE.MAX_SIZE).AND. 2469 & (I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND. 2470 & (K.LT.MAX_NB) ) 2471 LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, 2472 & OOC_FCT_TYPE)), 2473 & OOC_FCT_TYPE) 2474 IF(LAST.EQ.0_8)THEN 2475 IF(.NOT.ALREADY)THEN 2476 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 2477 ENDIF 2478 I=I+1 2479 NB_NODES_LOC=NB_NODES_LOC+1 2480 CYCLE 2481 ENDIF 2482 IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I, 2483 & OOC_FCT_TYPE))) 2484 & .NE.0).OR. 2485 & (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I, 2486 & OOC_FCT_TYPE))).GE. 2487 & 0))THEN 2488 IF(.NOT.ALREADY)THEN 2489 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE+1 2490 I=I+1 2491 CYCLE 2492 ELSE 2493 EXIT 2494 ENDIF 2495 ENDIF 2496 ALREADY=.TRUE. 2497 J8=J8+LAST 2498 I=I+1 2499 K=K+1 2500 NB_NODES_LOC=NB_NODES_LOC+1 2501 NB_NODES=NB_NODES+1 2502 ENDDO 2503 IF(J8.GT.MAX_SIZE)THEN 2504 SIZE=J8-LAST 2505 NB_NODES=NB_NODES-1 2506 NB_NODES_LOC=NB_NODES_LOC-1 2507 ELSE 2508 SIZE=J8 2509 ENDIF 2510 DO WHILE (CUR_POS_SEQUENCE+NB_NODES_LOC-1.GE. 2511 & CUR_POS_SEQUENCE) 2512 IF(SIZE_OF_BLOCK(STEP_OOC( 2513 & OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE+NB_NODES-1, 2514 & OOC_FCT_TYPE)), 2515 & OOC_FCT_TYPE) 2516 & .NE.0_8)THEN 2517 EXIT 2518 ENDIF 2519 NB_NODES_LOC=NB_NODES_LOC-1 2520 ENDDO 2521 POS_SEQ=CUR_POS_SEQUENCE 2522 ELSEIF(SOLVE_STEP.EQ.1)THEN 2523 DO WHILE(I.GE.1) 2524 IF(SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, 2525 & OOC_FCT_TYPE)), 2526 & OOC_FCT_TYPE) 2527 & .NE.0_8)THEN 2528 EXIT 2529 ENDIF 2530 I=I-1 2531 ENDDO 2532 CUR_POS_SEQUENCE=max(I,1) 2533 I=CUR_POS_SEQUENCE 2534 DO WHILE((J8.LE.MAX_SIZE).AND.(I.GE.1).AND. 2535 & (K.LT.MAX_NB)) 2536 LAST=SIZE_OF_BLOCK(STEP_OOC(OOC_INODE_SEQUENCE(I, 2537 & OOC_FCT_TYPE)), 2538 & OOC_FCT_TYPE) 2539 IF(LAST.EQ.0_8)THEN 2540 IF(.NOT.ALREADY)THEN 2541 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 2542 ENDIF 2543 NB_NODES_LOC=NB_NODES_LOC+1 2544 I=I-1 2545 CYCLE 2546 ENDIF 2547 IF((INODE_TO_POS(STEP_OOC(OOC_INODE_SEQUENCE(I, 2548 & OOC_FCT_TYPE))) 2549 & .NE.0).OR. 2550 & (IO_REQ(STEP_OOC(OOC_INODE_SEQUENCE(I, 2551 & OOC_FCT_TYPE))).GE. 2552 & 0))THEN 2553 IF(.NOT.ALREADY)THEN 2554 I=I-1 2555 CUR_POS_SEQUENCE=CUR_POS_SEQUENCE-1 2556 CYCLE 2557 ELSE 2558 EXIT 2559 ENDIF 2560 ENDIF 2561 ALREADY=.TRUE. 2562 J8=J8+LAST 2563 I=I-1 2564 K=K+1 2565 NB_NODES=NB_NODES+1 2566 NB_NODES_LOC=NB_NODES_LOC+1 2567 ENDDO 2568 IF(J8.GT.MAX_SIZE)THEN 2569 SIZE=J8-LAST 2570 NB_NODES=NB_NODES-1 2571 NB_NODES_LOC=NB_NODES_LOC-1 2572 ELSE 2573 SIZE=J8 2574 ENDIF 2575 I=CUR_POS_SEQUENCE-NB_NODES_LOC+1 2576 DO WHILE (I.LE.CUR_POS_SEQUENCE) 2577 IF(SIZE_OF_BLOCK(STEP_OOC( 2578 & OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE)), 2579 & OOC_FCT_TYPE).NE.0_8)THEN 2580 EXIT 2581 ENDIF 2582 I=I+1 2583 NB_NODES_LOC=NB_NODES_LOC-1 2584 ENDDO 2585 POS_SEQ=CUR_POS_SEQUENCE-NB_NODES_LOC+1 2586 ENDIF 2587 ENDIF 2588 IF(FLAG.EQ.0)THEN 2589 DEST=IDEB_SOLVE_Z(ZONE)+LRLU_SOLVE_B(ZONE)-SIZE 2590 ELSE 2591 DEST=POSFAC_SOLVE(ZONE) 2592 ENDIF 2593 END SUBROUTINE CMUMPS_602 2594 SUBROUTINE CMUMPS_582(IERR) 2595 IMPLICIT NONE 2596 INTEGER SOLVE_OR_FACTO 2597 INTEGER, intent(out) :: IERR 2598 IERR=0 2599 IF(allocated(LRLUS_SOLVE))THEN 2600 DEALLOCATE(LRLUS_SOLVE) 2601 ENDIF 2602 IF(allocated(LRLU_SOLVE_T))THEN 2603 DEALLOCATE(LRLU_SOLVE_T) 2604 ENDIF 2605 IF(allocated(LRLU_SOLVE_B))THEN 2606 DEALLOCATE(LRLU_SOLVE_B) 2607 ENDIF 2608 IF(allocated(POSFAC_SOLVE))THEN 2609 DEALLOCATE(POSFAC_SOLVE) 2610 ENDIF 2611 IF(allocated(IDEB_SOLVE_Z))THEN 2612 DEALLOCATE(IDEB_SOLVE_Z) 2613 ENDIF 2614 IF(allocated(PDEB_SOLVE_Z))THEN 2615 DEALLOCATE(PDEB_SOLVE_Z) 2616 ENDIF 2617 IF(allocated(SIZE_SOLVE_Z))THEN 2618 DEALLOCATE(SIZE_SOLVE_Z) 2619 ENDIF 2620 IF(allocated(CURRENT_POS_T))THEN 2621 DEALLOCATE(CURRENT_POS_T) 2622 ENDIF 2623 IF(allocated(CURRENT_POS_B))THEN 2624 DEALLOCATE(CURRENT_POS_B) 2625 ENDIF 2626 IF(allocated(POS_HOLE_T))THEN 2627 DEALLOCATE(POS_HOLE_T) 2628 ENDIF 2629 IF(allocated(POS_HOLE_B))THEN 2630 DEALLOCATE(POS_HOLE_B) 2631 ENDIF 2632 IF(allocated(OOC_STATE_NODE))THEN 2633 DEALLOCATE(OOC_STATE_NODE) 2634 ENDIF 2635 IF(allocated(POS_IN_MEM))THEN 2636 DEALLOCATE(POS_IN_MEM) 2637 ENDIF 2638 IF(allocated(INODE_TO_POS))THEN 2639 DEALLOCATE(INODE_TO_POS) 2640 ENDIF 2641 IF(allocated(IO_REQ))THEN 2642 DEALLOCATE(IO_REQ) 2643 ENDIF 2644 IF(allocated(SIZE_OF_READ))THEN 2645 DEALLOCATE(SIZE_OF_READ) 2646 ENDIF 2647 IF(allocated(FIRST_POS_IN_READ))THEN 2648 DEALLOCATE(FIRST_POS_IN_READ) 2649 ENDIF 2650 IF(allocated(READ_DEST))THEN 2651 DEALLOCATE(READ_DEST) 2652 ENDIF 2653 IF(allocated(READ_MNG))THEN 2654 DEALLOCATE(READ_MNG) 2655 ENDIF 2656 IF(allocated(REQ_TO_ZONE))THEN 2657 DEALLOCATE(REQ_TO_ZONE) 2658 ENDIF 2659 IF(allocated(REQ_ID))THEN 2660 DEALLOCATE(REQ_ID) 2661 ENDIF 2662 SOLVE_OR_FACTO=1 2663 CALL MUMPS_CLEAN_IO_DATA_C(MYID_OOC,SOLVE_OR_FACTO,IERR) 2664 IF(IERR.LT.0)THEN 2665 IF (ICNTL1.GT.0) 2666 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 2667 RETURN 2668 ENDIF 2669 END SUBROUTINE CMUMPS_582 2670 SUBROUTINE CMUMPS_612(PTRFAC,NSTEPS, 2671 & A,LA) 2672 IMPLICIT NONE 2673 INTEGER, INTENT(in) :: NSTEPS 2674 INTEGER(8), INTENT(INOUT) :: PTRFAC(NSTEPS) 2675 INTEGER(8), INTENT(IN) :: LA 2676 COMPLEX :: A(LA) 2677 INTEGER :: I, TMP, ZONE, IPAS, IBEG, IEND 2678 INTEGER(8) :: SAVE_PTR 2679 LOGICAL :: COMPRESS_TO_BE_DONE, SET_POS_SEQUENCE 2680 INTEGER :: J, IERR 2681 INTEGER(8) :: DUMMY_SIZE 2682 COMPRESS_TO_BE_DONE = .FALSE. 2683 DUMMY_SIZE = 1_8 2684 IERR = 0 2685 SET_POS_SEQUENCE = .TRUE. 2686 IF(SOLVE_STEP.EQ.0)THEN 2687 IBEG = 1 2688 IEND = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) 2689 IPAS = 1 2690 ELSE 2691 IBEG = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) 2692 IEND = 1 2693 IPAS = -1 2694 ENDIF 2695 DO I=IBEG,IEND,IPAS 2696 J = OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) 2697 TMP=INODE_TO_POS(STEP_OOC(J)) 2698 IF(TMP.EQ.0)THEN 2699 IF (SET_POS_SEQUENCE) THEN 2700 SET_POS_SEQUENCE = .FALSE. 2701 CUR_POS_SEQUENCE = I 2702 ENDIF 2703 IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN 2704 OOC_STATE_NODE(STEP_OOC(J)) = NOT_IN_MEM 2705 ENDIF 2706 CYCLE 2707 ELSE IF(TMP.LT.0)THEN 2708 IF(TMP.GT.-(N_OOC+1)*NB_Z)THEN 2709 SAVE_PTR=PTRFAC(STEP_OOC(J)) 2710 PTRFAC(STEP_OOC(J)) = abs(SAVE_PTR) 2711 CALL CMUMPS_600(J, 2712 & ZONE,PTRFAC,NSTEPS) 2713 PTRFAC(STEP_OOC(J)) = SAVE_PTR 2714 IF(ZONE.EQ.NB_Z)THEN 2715 IF(J.NE.SPECIAL_ROOT_NODE)THEN 2716 WRITE(*,*)MYID_OOC,': Internal error 6 ', 2717 & ' Node ', J, 2718 & ' is in status USED in the 2719 & emmergency buffer ' 2720 CALL MUMPS_ABORT() 2721 ENDIF 2722 ENDIF 2723 IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) 2724 & THEN 2725 IF (OOC_STATE_NODE(STEP_OOC(J)).EQ.NOT_IN_MEM) THEN 2726 OOC_STATE_NODE(STEP_OOC(J)) = USED 2727 IF((SOLVE_STEP.NE.0).OR.(J.NE.SPECIAL_ROOT_NODE) 2728 & .OR.(ZONE.NE.NB_Z))THEN 2729 CALL CMUMPS_599(J,PTRFAC,NSTEPS) 2730 ENDIF 2731 CYCLE 2732 ELSEIF(OOC_STATE_NODE(STEP_OOC(J)).EQ.ALREADY_USED) 2733 & THEN 2734 COMPRESS_TO_BE_DONE = .TRUE. 2735 ELSE 2736 WRITE(*,*)MYID_OOC,': Internal error Mila 4 ', 2737 & ' wrong node status :', OOC_STATE_NODE(STEP_OOC(J)), 2738 & ' on node ', J 2739 CALL MUMPS_ABORT() 2740 ENDIF 2741 ENDIF 2742 IF (KEEP_OOC(237).EQ.0 .AND. KEEP_OOC(235).EQ.0) THEN 2743 CALL CMUMPS_599(J,PTRFAC,NSTEPS) 2744 ENDIF 2745 ENDIF 2746 ENDIF 2747 ENDDO 2748 IF (KEEP_OOC(237).NE.0 .OR. KEEP_OOC(235).NE.0) 2749 & THEN 2750 IF (COMPRESS_TO_BE_DONE) THEN 2751 DO ZONE=1,NB_Z-1 2752 CALL CMUMPS_608(A,LA, 2753 & DUMMY_SIZE,PTRFAC, 2754 & NSTEPS,ZONE,IERR) 2755 IF (IERR .LT. 0) THEN 2756 WRITE(*,*)MYID_OOC,': Internal error Mila 5 ', 2757 & ' IERR on return to CMUMPS_608 =', 2758 & IERR 2759 CALL MUMPS_ABORT() 2760 ENDIF 2761 ENDDO 2762 ENDIF 2763 ENDIF 2764 RETURN 2765 END SUBROUTINE CMUMPS_612 2766 SUBROUTINE CMUMPS_583(PTRFAC,NSTEPS,MTYPE, 2767 & A,LA,DOPREFETCH,IERR) 2768 IMPLICIT NONE 2769 INTEGER NSTEPS,MTYPE 2770 INTEGER, intent(out)::IERR 2771 INTEGER(8) :: LA 2772 COMPLEX A(LA) 2773 INTEGER(8) :: PTRFAC(NSTEPS) 2774 LOGICAL DOPREFETCH 2775 INTEGER MUMPS_808 2776 EXTERNAL MUMPS_808 2777 IERR = 0 2778 OOC_FCT_TYPE=MUMPS_808("F",MTYPE,KEEP_OOC(201), 2779 & KEEP_OOC(50)) 2780 OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1 2781 IF (KEEP_OOC(201).NE.1) THEN 2782 OOC_SOLVE_TYPE_FCT = FCT 2783 ENDIF 2784 SOLVE_STEP=0 2785 CUR_POS_SEQUENCE=1 2786 MTYPE_OOC=MTYPE 2787 IF ( KEEP_OOC(201).NE.1 2788#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT) 2789 & .OR. KEEP_OOC(50).NE.0 2790#endif 2791 & ) THEN 2792 CALL CMUMPS_612(PTRFAC,NSTEPS,A,LA) 2793 ELSE 2794 CALL CMUMPS_683(KEEP_OOC(28), 2795 & KEEP_OOC(38), KEEP_OOC(20) ) 2796 ENDIF 2797 IF (DOPREFETCH) THEN 2798 CALL CMUMPS_585(A,LA,PTRFAC, 2799 & KEEP_OOC(28),IERR) 2800 ELSE 2801 CUR_POS_SEQUENCE = TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) 2802 ENDIF 2803 RETURN 2804 END SUBROUTINE CMUMPS_583 2805 SUBROUTINE CMUMPS_584(PTRFAC,NSTEPS,MTYPE, 2806 & I_WORKED_ON_ROOT,IROOT,A,LA,IERR) 2807 IMPLICIT NONE 2808 INTEGER NSTEPS 2809 INTEGER(8) :: LA 2810 INTEGER(8) :: PTRFAC(NSTEPS) 2811 INTEGER MTYPE 2812 INTEGER IROOT 2813 LOGICAL I_WORKED_ON_ROOT 2814 INTEGER, intent(out):: IERR 2815 COMPLEX A(LA) 2816 INTEGER(8) :: DUMMY_SIZE 2817 INTEGER ZONE 2818 INTEGER MUMPS_808 2819 EXTERNAL MUMPS_808 2820 IERR=0 2821 OOC_FCT_TYPE=MUMPS_808("B",MTYPE,KEEP_OOC(201), 2822 & KEEP_OOC(50)) 2823 OOC_SOLVE_TYPE_FCT = OOC_FCT_TYPE - 1 2824 IF (KEEP_OOC(201).NE.1) OOC_SOLVE_TYPE_FCT=FCT 2825 SOLVE_STEP=1 2826 CUR_POS_SEQUENCE=TOTAL_NB_OOC_NODES(OOC_FCT_TYPE) 2827 MTYPE_OOC=MTYPE 2828 IF ( KEEP_OOC(201).NE.1 2829#if ! defined(TEMP_VERSION_TO_FORCE_DATA_REINIT) 2830 & .OR. KEEP_OOC(50).NE.0 2831#endif 2832 & ) THEN 2833 CALL CMUMPS_612(PTRFAC,NSTEPS,A,LA) 2834 IF (I_WORKED_ON_ROOT) THEN 2835 CALL CMUMPS_598 ( IROOT, 2836 & PTRFAC, KEEP_OOC(28), A, LA,.FALSE.,IERR) 2837 IF (IERR .LT. 0) RETURN 2838 CALL CMUMPS_600(IROOT, 2839 & ZONE,PTRFAC,NSTEPS) 2840 IF(IROOT.EQ.NB_Z)THEN 2841 DUMMY_SIZE=1_8 2842 CALL CMUMPS_608(A,LA, 2843 & DUMMY_SIZE,PTRFAC, 2844 & NSTEPS,NB_Z,IERR) 2845 IF (IERR .LT. 0) THEN 2846 WRITE(*,*)MYID_OOC,': Internal error in 2847 & CMUMPS_608', 2848 & IERR 2849 CALL MUMPS_ABORT() 2850 ENDIF 2851 ENDIF 2852 ENDIF 2853 IF (NB_Z.GT.1) THEN 2854 CALL CMUMPS_594(A,LA,PTRFAC, 2855 & KEEP_OOC(28),IERR) 2856 IF (IERR .LT. 0) RETURN 2857 ENDIF 2858 ELSE 2859 CALL CMUMPS_683(KEEP_OOC(28), 2860 & KEEP_OOC(38), KEEP_OOC(20) ) 2861 CALL CMUMPS_585(A,LA,PTRFAC,KEEP_OOC(28),IERR) 2862 IF (IERR .LT. 0 ) RETURN 2863 ENDIF 2864 RETURN 2865 END SUBROUTINE CMUMPS_584 2866 SUBROUTINE CMUMPS_613(id,IERR) 2867 USE CMUMPS_STRUC_DEF 2868 IMPLICIT NONE 2869 TYPE(CMUMPS_STRUC), TARGET :: id 2870 INTEGER, intent(out) :: IERR 2871 INTEGER I,DIM,J,TMP,SIZE,K,I1 2872 CHARACTER*1 TMP_NAME(350) 2873 EXTERNAL MUMPS_OOC_GET_NB_FILES_C, MUMPS_OOC_GET_FILE_NAME_C 2874 IERR=0 2875 SIZE=0 2876 DO J=1,OOC_NB_FILE_TYPE 2877 TMP=J-1 2878 CALL MUMPS_OOC_GET_NB_FILES_C(TMP,I) 2879 id%OOC_NB_FILES(J)=I 2880 SIZE=SIZE+I 2881 ENDDO 2882 IF(associated(id%OOC_FILE_NAMES))THEN 2883 DEALLOCATE(id%OOC_FILE_NAMES) 2884 NULLIFY(id%OOC_FILE_NAMES) 2885 ENDIF 2886 ALLOCATE(id%OOC_FILE_NAMES(SIZE,350),stat=IERR) 2887 IF (IERR .GT. 0) THEN 2888 IF (ICNTL1.GT.0) 2889 & WRITE(ICNTL1,*) 'PB allocation in CMUMPS_613' 2890 IERR=-1 2891 IF(id%INFO(1).GE.0)THEN 2892 id%INFO(1) = -13 2893 id%INFO(2) = SIZE*350 2894 RETURN 2895 ENDIF 2896 ENDIF 2897 IF(associated(id%OOC_FILE_NAME_LENGTH))THEN 2898 DEALLOCATE(id%OOC_FILE_NAME_LENGTH) 2899 NULLIFY(id%OOC_FILE_NAME_LENGTH) 2900 ENDIF 2901 ALLOCATE(id%OOC_FILE_NAME_LENGTH(SIZE),stat=IERR) 2902 IF (IERR .GT. 0) THEN 2903 IERR=-1 2904 IF(id%INFO(1).GE.0)THEN 2905 IF (ICNTL1.GT.0) 2906 & WRITE(ICNTL1,*) 2907 & 'PB allocation in CMUMPS_613' 2908 id%INFO(1) = -13 2909 id%INFO(2) = SIZE 2910 RETURN 2911 ENDIF 2912 ENDIF 2913 K=1 2914 DO I1=1,OOC_NB_FILE_TYPE 2915 TMP=I1-1 2916 DO I=1,id%OOC_NB_FILES(I1) 2917 CALL MUMPS_OOC_GET_FILE_NAME_C(TMP,I,DIM,TMP_NAME(1)) 2918 DO J=1,DIM+1 2919 id%OOC_FILE_NAMES(K,J)=TMP_NAME(J) 2920 ENDDO 2921 id%OOC_FILE_NAME_LENGTH(K)=DIM+1 2922 K=K+1 2923 ENDDO 2924 ENDDO 2925 END SUBROUTINE CMUMPS_613 2926 SUBROUTINE CMUMPS_614(id) 2927 USE CMUMPS_STRUC_DEF 2928 IMPLICIT NONE 2929 TYPE(CMUMPS_STRUC), TARGET :: id 2930 CHARACTER*1 TMP_NAME(350) 2931 INTEGER I,I1,TMP,J,K,L,DIM,IERR 2932 INTEGER, DIMENSION(:),ALLOCATABLE :: NB_FILES 2933 INTEGER K211 2934 ALLOCATE(NB_FILES(OOC_NB_FILE_TYPE),stat=IERR) 2935 IF (IERR .GT. 0) THEN 2936 IERR=-1 2937 IF(id%INFO(1).GE.0)THEN 2938 IF (ICNTL1.GT.0) 2939 & WRITE(ICNTL1,*) 2940 & 'PB allocation in CMUMPS_614' 2941 id%INFO(1) = -13 2942 id%INFO(2) = OOC_NB_FILE_TYPE 2943 RETURN 2944 ENDIF 2945 ENDIF 2946 IERR=0 2947 NB_FILES=id%OOC_NB_FILES 2948 I=id%MYID 2949 K=id%KEEP(35) 2950 L=mod(id%KEEP(204),3) 2951 K211=id%KEEP(211) 2952 CALL MUMPS_OOC_ALLOC_POINTERS_C(OOC_NB_FILE_TYPE,NB_FILES,IERR) 2953 IF(IERR.LT.0)THEN 2954 IF (ICNTL1.GT.0) 2955 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 2956 id%INFO(1)=IERR 2957 RETURN 2958 ENDIF 2959 CALL MUMPS_OOC_INIT_VARS_C(I,K,L,K211,IERR) 2960 IF(IERR.LT.0)THEN 2961 IF (ICNTL1.GT.0) 2962 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 2963 id%INFO(1)=IERR 2964 RETURN 2965 ENDIF 2966 K=1 2967 DO I1=1,OOC_NB_FILE_TYPE 2968 DO I=1,NB_FILES(I1) 2969 DIM=id%OOC_FILE_NAME_LENGTH(K) 2970 DO J=1,DIM 2971 TMP_NAME(J)=id%OOC_FILE_NAMES(K,J) 2972 ENDDO 2973 TMP=I1-1 2974 CALL MUMPS_OOC_SET_FILE_NAME_C(TMP,I,DIM,IERR,TMP_NAME(1)) 2975 IF(IERR.LT.0)THEN 2976 IF (ICNTL1.GT.0) 2977 & WRITE(ICNTL1,*)MYID_OOC,': ', 2978 & ERR_STR_OOC(1:DIM_ERR_STR_OOC) 2979 id%INFO(1)=IERR 2980 RETURN 2981 ENDIF 2982 K=K+1 2983 ENDDO 2984 ENDDO 2985 CALL MUMPS_OOC_START_LOW_LEVEL(IERR) 2986 IF(IERR.LT.0)THEN 2987 IF (ICNTL1.GT.0) 2988 & WRITE(ICNTL1,*)MYID_OOC,': ',ERR_STR_OOC(1:DIM_ERR_STR_OOC) 2989 id%INFO(1)=IERR 2990 RETURN 2991 ENDIF 2992 DEALLOCATE(NB_FILES) 2993 RETURN 2994 END SUBROUTINE CMUMPS_614 2995 SUBROUTINE CMUMPS_589(DEST,SRC,NB,NB_EFF) 2996 IMPLICIT NONE 2997 INTEGER NB, NB_EFF 2998 CHARACTER(LEN=NB) SRC 2999 CHARACTER*1 DEST(NB) 3000 INTEGER I 3001 DO I=1,NB_EFF 3002 DEST(I)=SRC(I:I) 3003 ENDDO 3004 END SUBROUTINE CMUMPS_589 3005 SUBROUTINE CMUMPS_580(IERR) 3006 USE CMUMPS_OOC_BUFFER 3007 IMPLICIT NONE 3008 INTEGER, intent(out) :: IERR 3009 IERR=0 3010 IF(.NOT.WITH_BUF)THEN 3011 RETURN 3012 ENDIF 3013 CALL CMUMPS_707(OOC_FCT_TYPE,IERR) 3014 IF (IERR < 0) THEN 3015 RETURN 3016 ENDIF 3017 RETURN 3018 END SUBROUTINE CMUMPS_580 3019 SUBROUTINE CMUMPS_681(IERR) 3020 USE CMUMPS_OOC_BUFFER 3021 IMPLICIT NONE 3022 INTEGER, intent(out) :: IERR 3023 INTEGER I 3024 IERR=0 3025 IF(.NOT.WITH_BUF)THEN 3026 RETURN 3027 ENDIF 3028 DO I=1,OOC_NB_FILE_TYPE 3029 CALL CMUMPS_707(I,IERR) 3030 IF (IERR < 0) RETURN 3031 ENDDO 3032 RETURN 3033 END SUBROUTINE CMUMPS_681 3034 SUBROUTINE CMUMPS_683(NSTEPS, 3035 & KEEP38, KEEP20) 3036 IMPLICIT NONE 3037 INTEGER NSTEPS 3038 INTEGER I, J 3039 INTEGER(8) :: TMP_SIZE8 3040 INTEGER KEEP38, KEEP20 3041 INODE_TO_POS = 0 3042 POS_IN_MEM = 0 3043 OOC_STATE_NODE(1:NSTEPS)=0 3044 TMP_SIZE8=1_8 3045 J=1 3046 DO I=1,NB_Z-1 3047 IDEB_SOLVE_Z(I)=TMP_SIZE8 3048 PDEB_SOLVE_Z(I)=J 3049 POSFAC_SOLVE(I)=TMP_SIZE8 3050 LRLUS_SOLVE(I) =SIZE_ZONE_SOLVE 3051 LRLU_SOLVE_T(I)=SIZE_ZONE_SOLVE 3052 LRLU_SOLVE_B(I)=0_8 3053 SIZE_SOLVE_Z(I)=SIZE_ZONE_SOLVE 3054 CURRENT_POS_T(I)=J 3055 CURRENT_POS_B(I)=J 3056 POS_HOLE_T(I) =J 3057 POS_HOLE_B(I) =J 3058 J = J + MAX_NB_NODES_FOR_ZONE 3059 TMP_SIZE8 = TMP_SIZE8 + SIZE_ZONE_SOLVE 3060 ENDDO 3061 IDEB_SOLVE_Z(NB_Z)=TMP_SIZE8 3062 PDEB_SOLVE_Z(NB_Z)=J 3063 POSFAC_SOLVE(NB_Z)=TMP_SIZE8 3064 LRLUS_SOLVE(NB_Z) =SIZE_SOLVE_EMM 3065 LRLU_SOLVE_T(NB_Z)=SIZE_SOLVE_EMM 3066 LRLU_SOLVE_B(NB_Z)=0_8 3067 SIZE_SOLVE_Z(NB_Z)=SIZE_SOLVE_EMM 3068 CURRENT_POS_T(NB_Z)=J 3069 CURRENT_POS_B(NB_Z)=J 3070 POS_HOLE_T(NB_Z) =J 3071 POS_HOLE_B(NB_Z) =J 3072 IO_REQ=-77777 3073 SIZE_OF_READ=-9999_8 3074 FIRST_POS_IN_READ=-9999 3075 READ_DEST=-9999_8 3076 READ_MNG=-9999 3077 REQ_TO_ZONE=-9999 3078 REQ_ID=-9999 3079 RETURN 3080 END SUBROUTINE CMUMPS_683 3081 SUBROUTINE CMUMPS_688 3082 & ( STRAT, TYPEFile, 3083 & AFAC, LAFAC, MonBloc, 3084 & LNextPiv2beWritten, UNextPiv2beWritten, 3085 & IW, LIWFAC, 3086 & MYID, FILESIZE, IERR , LAST_CALL) 3087 IMPLICIT NONE 3088 TYPE(IO_BLOCK), INTENT(INOUT):: MonBloc 3089 INTEGER(8) :: LAFAC 3090 INTEGER, INTENT(IN) :: STRAT, LIWFAC, 3091 & MYID, TYPEFile 3092 INTEGER, INTENT(INOUT) :: IW(0:LIWFAC-1) 3093 COMPLEX, INTENT(IN) :: AFAC(LAFAC) 3094 INTEGER, INTENT(INOUT) :: LNextPiv2beWritten, 3095 & UNextPiv2beWritten 3096 INTEGER(8), INTENT(INOUT) :: FILESIZE 3097 INTEGER, INTENT(OUT) :: IERR 3098 LOGICAL, INTENT(IN) :: LAST_CALL 3099 INTEGER(8) :: TMPSIZE_OF_BLOCK 3100 INTEGER :: TempFTYPE 3101 LOGICAL WRITE_L, WRITE_U 3102 LOGICAL DO_U_FIRST 3103 INCLUDE 'mumps_headers.h' 3104 IERR = 0 3105 IF (KEEP_OOC(50).EQ.0 3106 & .AND.KEEP_OOC(251).EQ.2) THEN 3107 WRITE_L = .FALSE. 3108 ELSE 3109 WRITE_L = (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_L) 3110 ENDIF 3111 WRITE_U = (TYPEFile.EQ.TYPEF_BOTH_LU .OR. TYPEFile.EQ.TYPEF_U) 3112 DO_U_FIRST = .FALSE. 3113 IF ( TYPEFile.EQ.TYPEF_BOTH_LU ) THEN 3114 IF ( LNextPiv2beWritten .GT. UNextPiv2beWritten ) THEN 3115 DO_U_FIRST = .TRUE. 3116 END IF 3117 END IF 3118 IF (DO_U_FIRST) GOTO 200 3119 100 IF (WRITE_L .AND. TYPEF_L > 0 ) THEN 3120 TempFTYPE = TYPEF_L 3121 IF ((MonBloc%Typenode.EQ.2).AND.(.NOT.MonBloc%MASTER)) 3122 & THEN 3123 TMPSIZE_OF_BLOCK = SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE), 3124 & TempFTYPE) 3125 IF (TMPSIZE_OF_BLOCK .LT. 0_8) THEN 3126 TMPSIZE_OF_BLOCK = -TMPSIZE_OF_BLOCK - 1_8 3127 ENDIF 3128 LNextPiv2beWritten = 3129 & int( 3130 & TMPSIZE_OF_BLOCK 3131 & / int(MonBloc%NROW,8) 3132 & ) 3133 & + 1 3134 ENDIF 3135 CALL CMUMPS_695( STRAT, 3136 & TempFTYPE, AFAC, LAFAC, MonBloc, 3137 & IERR, 3138 & LNextPiv2beWritten, 3139 & OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE), 3140 & SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE), 3141 & FILESIZE, LAST_CALL ) 3142 IF (IERR .LT. 0) RETURN 3143 IF (DO_U_FIRST) GOTO 300 3144 ENDIF 3145 200 IF (WRITE_U) THEN 3146 TempFTYPE = TYPEF_U 3147 CALL CMUMPS_695( STRAT, 3148 & TempFTYPE, AFAC, LAFAC, MonBloc, 3149 & IERR, 3150 & UNextPiv2beWritten, 3151 & OOC_VADDR(STEP_OOC(MonBloc%INODE),TempFTYPE), 3152 & SIZE_OF_BLOCK(STEP_OOC(MonBloc%INODE),TempFTYPE), 3153 & FILESIZE, LAST_CALL) 3154 IF (IERR .LT. 0) RETURN 3155 IF (DO_U_FIRST) GOTO 100 3156 ENDIF 3157 300 CONTINUE 3158 RETURN 3159 END SUBROUTINE CMUMPS_688 3160 SUBROUTINE CMUMPS_695( STRAT, TYPEF, 3161 & AFAC, LAFAC, MonBloc, 3162 & IERR, 3163 & LorU_NextPiv2beWritten, 3164 & LorU_AddVirtNodeI8, LorUSIZE_OF_BLOCK, 3165 & FILESIZE, LAST_CALL 3166 & ) 3167 USE CMUMPS_OOC_BUFFER 3168 IMPLICIT NONE 3169 INTEGER, INTENT(IN) :: STRAT 3170 INTEGER, INTENT(IN) :: TYPEF 3171 INTEGER(8), INTENT(INOUT) :: FILESIZE 3172 INTEGER(8), INTENT(IN) :: LAFAC 3173 COMPLEX, INTENT(IN) :: AFAC(LAFAC) 3174 INTEGER, INTENT(INOUT) :: LorU_NextPiv2beWritten 3175 INTEGER(8), INTENT(INOUT) :: LorU_AddVirtNodeI8 3176 INTEGER(8), INTENT(INOUT) :: LorUSIZE_OF_BLOCK 3177 TYPE(IO_BLOCK), INTENT(INOUT) :: MonBloc 3178 INTEGER, INTENT(OUT) :: IERR 3179 LOGICAL, INTENT(IN) :: LAST_CALL 3180 INTEGER NNMAX 3181 INTEGER(8) :: TOTSIZE, EFFSIZE 3182 INTEGER(8) :: TailleEcrite 3183 INTEGER SIZE_PANEL 3184 INTEGER(8) :: AddVirtCour 3185 LOGICAL VIRT_ADD_RESERVED_BEF_CALL 3186 LOGICAL VIRTUAL_ADDRESS_JUST_RESERVED 3187 LOGICAL HOLE_PROCESSED_BEFORE_CALL 3188 LOGICAL TMP_ESTIM 3189 INTEGER ICUR, INODE_CUR, ILAST 3190 INTEGER(8) :: ADDR_LAST 3191 IERR = 0 3192 IF (TYPEF == TYPEF_L ) THEN 3193 NNMAX = MonBloc%NROW 3194 ELSE 3195 NNMAX = MonBloc%NCOL 3196 ENDIF 3197 SIZE_PANEL = CMUMPS_690(NNMAX) 3198 IF ( (.NOT.MonBloc%Last) .AND. 3199 & (MonBloc%LastPiv-LorU_NextPiv2beWritten+1.LT.SIZE_PANEL)) 3200 & THEN 3201 RETURN 3202 ENDIF 3203 TMP_ESTIM = .TRUE. 3204 TOTSIZE = CMUMPS_725 3205 & (MonBloc%NFS, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM) 3206 IF (MonBloc%Last) THEN 3207 TMP_ESTIM=.FALSE. 3208 EFFSIZE = CMUMPS_725 3209 & (MonBloc%LastPiv, NNMAX, SIZE_PANEL, MonBloc, TMP_ESTIM) 3210 ELSE 3211 EFFSIZE = -1034039740327_8 3212 ENDIF 3213 IF (MonBloc%Typenode.EQ.3.AND. MonBloc%NFS.NE.MonBloc%NCOL) THEN 3214 WRITE(*,*) 'Internal error in CMUMPS_695 for type3', 3215 & MonBloc%NFS,MonBloc%NCOL 3216 CALL MUMPS_ABORT() 3217 ENDIF 3218 IF (MonBloc%Typenode.EQ.3.AND. TYPEF.NE.TYPEF_L) THEN 3219 WRITE(*,*) 'Internal error in CMUMPS_695,TYPEF=', 3220 & TYPEF, 'for typenode=3' 3221 CALL MUMPS_ABORT() 3222 ENDIF 3223 IF (MonBloc%Typenode.EQ.2.AND. 3224 & TYPEF.EQ.TYPEF_U.AND. 3225 & .NOT. MonBloc%MASTER ) THEN 3226 WRITE(*,*) 'Internal error in CMUMPS_695', 3227 & MonBloc%MASTER,MonBloc%Typenode, TYPEF 3228 CALL MUMPS_ABORT() 3229 ENDIF 3230 HOLE_PROCESSED_BEFORE_CALL = (LorUSIZE_OF_BLOCK .LT. 0_8) 3231 IF (HOLE_PROCESSED_BEFORE_CALL.AND.(.NOT.MonBloc%Last)) THEN 3232 WRITE(6,*) ' Internal error in CMUMPS_695 ', 3233 & ' last is false after earlier calls with last=true' 3234 CALL MUMPS_ABORT() 3235 ENDIF 3236 IF (HOLE_PROCESSED_BEFORE_CALL) THEN 3237 LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 3238 TOTSIZE = -99999999_8 3239 ENDIF 3240 VIRTUAL_ADDRESS_JUST_RESERVED = .FALSE. 3241 VIRT_ADD_RESERVED_BEF_CALL = 3242 & ( LorUSIZE_OF_BLOCK .NE. 0_8 .OR. 3243 & HOLE_PROCESSED_BEFORE_CALL ) 3244 IF (MonBloc%Last .AND. .NOT. HOLE_PROCESSED_BEFORE_CALL) THEN 3245 KEEP_OOC(228) = max(KEEP_OOC(228), 3246 & (MonBloc%LastPiv+SIZE_PANEL-1) / SIZE_PANEL) 3247 IF (VIRT_ADD_RESERVED_BEF_CALL) THEN 3248 IF (AddVirtLibre(TYPEF).EQ. 3249 & (LorU_AddVirtNodeI8+TOTSIZE) ) THEN 3250 AddVirtLibre(TYPEF) = LorU_AddVirtNodeI8 + EFFSIZE 3251 ENDIF 3252 ELSE 3253 VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE. 3254 IF (EFFSIZE .EQ. 0_8) THEN 3255 LorU_AddVirtNodeI8 = -9999_8 3256 ELSE 3257 LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF) 3258 ENDIF 3259 AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + EFFSIZE 3260 ENDIF 3261 ELSE 3262 IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL 3263 & ) THEN 3264 LorU_AddVirtNodeI8 = AddVirtLibre(TYPEF) 3265 AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) + TOTSIZE 3266 ENDIF 3267 ENDIF 3268 AddVirtCour = LorU_AddVirtNodeI8 + LorUSIZE_OF_BLOCK 3269 CALL CMUMPS_697( STRAT, TYPEF, MonBloc, 3270 & SIZE_PANEL, 3271 & AFAC, LAFAC, 3272 & LorU_NextPiv2beWritten, AddVirtCour, 3273 & TailleEcrite, 3274 & IERR ) 3275 IF ( IERR .LT. 0 ) RETURN 3276 LorUSIZE_OF_BLOCK = LorUSIZE_OF_BLOCK + TailleEcrite 3277 IF (LorUSIZE_OF_BLOCK.EQ.0_8 ) THEN 3278 IF ( .NOT. VIRT_ADD_RESERVED_BEF_CALL 3279 & .AND. .NOT. VIRTUAL_ADDRESS_JUST_RESERVED ) 3280 & THEN 3281 AddVirtLibre(TYPEF) = AddVirtLibre(TYPEF) - TOTSIZE 3282 LorU_AddVirtNodeI8 = 0_8 3283 ENDIF 3284 ELSE IF (.NOT. VIRT_ADD_RESERVED_BEF_CALL ) THEN 3285 VIRTUAL_ADDRESS_JUST_RESERVED = .TRUE. 3286 ENDIF 3287 IF ( VIRTUAL_ADDRESS_JUST_RESERVED) THEN 3288 OOC_INODE_SEQUENCE(I_CUR_HBUF_NEXTPOS(TYPEF), 3289 & TYPEF) = MonBloc%INODE 3290 I_CUR_HBUF_NEXTPOS(TYPEF) = I_CUR_HBUF_NEXTPOS(TYPEF) + 1 3291 IF (MonBloc%Last) THEN 3292 MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,EFFSIZE) 3293 TMP_SIZE_FACT=TMP_SIZE_FACT+EFFSIZE 3294 ELSE 3295 MAX_SIZE_FACTOR_OOC=max(MAX_SIZE_FACTOR_OOC,TOTSIZE) 3296 TMP_SIZE_FACT=TMP_SIZE_FACT+TOTSIZE 3297 ENDIF 3298 TMP_NB_NODES=TMP_NB_NODES+1 3299 IF(TMP_SIZE_FACT.GT.SIZE_ZONE_SOLVE)THEN 3300 MAX_NB_NODES_FOR_ZONE=max(MAX_NB_NODES_FOR_ZONE, 3301 & TMP_NB_NODES) 3302 TMP_SIZE_FACT=0_8 3303 TMP_NB_NODES=0 3304 ENDIF 3305 ENDIF 3306 IF (MonBloc%Last) THEN 3307 LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 3308 ENDIF 3309 IF (LAST_CALL) THEN 3310 IF (.NOT.MonBloc%Last) THEN 3311 WRITE(6,*) ' Internal error in CMUMPS_695 ', 3312 & ' LAST and LAST_CALL are incompatible ' 3313 CALL MUMPS_ABORT() 3314 ENDIF 3315 LorUSIZE_OF_BLOCK = - LorUSIZE_OF_BLOCK - 1_8 3316 ICUR = I_CUR_HBUF_NEXTPOS(TYPEF) - 1 3317 INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF) 3318 ADDR_LAST = AddVirtLibre(TYPEF) 3319 IF (INODE_CUR .NE. MonBloc%INODE) THEN 3320 10 CONTINUE 3321 ILAST = ICUR 3322 IF ( OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) .NE. -9999_8) THEN 3323 ADDR_LAST = OOC_VADDR(STEP_OOC(INODE_CUR), TYPEF) 3324 ENDIF 3325 ICUR = ICUR - 1 3326 INODE_CUR = OOC_INODE_SEQUENCE(ICUR,TYPEF) 3327 IF (INODE_CUR .EQ. MonBloc%INODE) THEN 3328 LorUSIZE_OF_BLOCK = ADDR_LAST - 3329 & OOC_VADDR(STEP_OOC(INODE_CUR),TYPEF) 3330 ELSE 3331 IF (ICUR .LE. 1) THEN 3332 WRITE(*,*) "Internal error in CMUMPS_695" 3333 WRITE(*,*) "Did not find current node in sequence" 3334 CALL MUMPS_ABORT() 3335 ENDIF 3336 GOTO 10 3337 ENDIF 3338 ENDIF 3339 FILESIZE = FILESIZE + LorUSIZE_OF_BLOCK 3340 ENDIF 3341 RETURN 3342 END SUBROUTINE CMUMPS_695 3343 SUBROUTINE CMUMPS_697( 3344 & STRAT, TYPEF, MonBloc, 3345 & SIZE_PANEL, 3346 & AFAC, LAFAC, 3347 & NextPiv2beWritten, AddVirtCour, 3348 & TailleEcrite, IERR ) 3349 USE CMUMPS_OOC_BUFFER 3350 IMPLICIT NONE 3351 INTEGER, INTENT(IN) :: STRAT, TYPEF, SIZE_PANEL 3352 INTEGER(8) :: LAFAC 3353 INTEGER(8), INTENT(IN) :: AddVirtCour 3354 COMPLEX, INTENT(IN) :: AFAC(LAFAC) 3355 INTEGER, INTENT(INOUT) :: NextPiv2beWritten 3356 TYPE(IO_BLOCK),INTENT(INOUT) :: MonBloc 3357 INTEGER(8), INTENT(OUT) :: TailleEcrite 3358 INTEGER, INTENT(OUT) :: IERR 3359 INTEGER :: I, NBeff, LPANELeff, IEND 3360 INTEGER(8) :: AddVirtDeb 3361 IERR = 0 3362 TailleEcrite = 0_8 3363 AddVirtDeb = AddVirtCour 3364 I = NextPiv2beWritten 3365 IF ( NextPiv2beWritten .GT. MonBloc%LastPiv ) THEN 3366 RETURN 3367 ENDIF 3368 10 CONTINUE 3369 NBeff = min(SIZE_PANEL,MonBloc%LastPiv-I+1 ) 3370 IF ((NBeff.NE.SIZE_PANEL) .AND. (.NOT.MonBloc%Last)) THEN 3371 GOTO 20 3372 ENDIF 3373 IF (TYPEF.EQ.TYPEF_L.AND.MonBloc%MASTER.AND. 3374 & KEEP_OOC(50).EQ.2 .AND. MonBloc%Typenode.NE.3) THEN 3375 IF (MonBloc%INDICES(NBeff+I-1) < 0) 3376 & THEN 3377 NBeff=NBeff+1 3378 ENDIF 3379 ENDIF 3380 IEND = I + NBeff -1 3381 CALL CMUMPS_653( STRAT, TYPEF, MonBloc, 3382 & AFAC, LAFAC, 3383 & AddVirtDeb, I, IEND, LPANELeff, 3384 & IERR) 3385 IF ( IERR .LT. 0 ) THEN 3386 RETURN 3387 ENDIF 3388 IF ( IERR .EQ. 1 ) THEN 3389 IERR=0 3390 GOTO 20 3391 ENDIF 3392 IF (TYPEF .EQ. TYPEF_L) THEN 3393 MonBloc%LastPanelWritten_L = MonBloc%LastPanelWritten_L+1 3394 ELSE 3395 MonBloc%LastPanelWritten_U = MonBloc%LastPanelWritten_U+1 3396 ENDIF 3397 AddVirtDeb = AddVirtDeb + int(LPANELeff,8) 3398 TailleEcrite = TailleEcrite + int(LPANELeff,8) 3399 I=I+NBeff 3400 IF ( I .LE. MonBloc%LastPiv ) GOTO 10 3401 20 CONTINUE 3402 NextPiv2beWritten = I 3403 RETURN 3404 END SUBROUTINE CMUMPS_697 3405 INTEGER(8) FUNCTION CMUMPS_725 3406 & (NFSorNPIV, NNMAX, SIZE_PANEL, MonBloc, ESTIM) 3407 IMPLICIT NONE 3408 TYPE(IO_BLOCK), INTENT(IN):: MonBloc 3409 INTEGER, INTENT(IN) :: NFSorNPIV, NNMAX, SIZE_PANEL 3410 LOGICAL, INTENT(IN) :: ESTIM 3411 INTEGER :: I, NBeff 3412 INTEGER(8) :: TOTSIZE 3413 TOTSIZE = 0_8 3414 IF (NFSorNPIV.EQ.0) GOTO 100 3415 IF (.NOT. MonBloc%MASTER .OR. MonBloc%Typenode.EQ.3) THEN 3416 TOTSIZE = int(NFSorNPIV,8) * int(NNMAX,8) 3417 ELSE 3418 I = 1 3419 10 CONTINUE 3420 NBeff = min(SIZE_PANEL, NFSorNPIV-I+1) 3421 IF (KEEP_OOC(50).EQ.2) THEN 3422 IF (ESTIM) THEN 3423 NBeff = NBeff + 1 3424 ELSE 3425 IF (MonBloc%INDICES(I+NBeff-1) < 0) THEN 3426 NBeff = NBeff + 1 3427 ENDIF 3428 ENDIF 3429 ENDIF 3430 TOTSIZE = TOTSIZE + 3431 & int(NNMAX-I+1,8) * int(NBeff,8) 3432 I = I + NBeff 3433 IF ( I .LE. NFSorNPIV ) GOTO 10 3434 ENDIF 3435 100 CONTINUE 3436 CMUMPS_725 = TOTSIZE 3437 RETURN 3438 END FUNCTION CMUMPS_725 3439 INTEGER FUNCTION CMUMPS_690( NNMAX ) 3440 IMPLICIT NONE 3441 INTEGER, INTENT(IN) :: NNMAX 3442 INTEGER CMUMPS_748 3443 CMUMPS_690=CMUMPS_748( 3444 & HBUF_SIZE, NNMAX, KEEP_OOC(227),KEEP_OOC(50)) 3445 RETURN 3446 END FUNCTION CMUMPS_690 3447 SUBROUTINE CMUMPS_728() 3448 IMPLICIT NONE 3449 INTEGER I,TMP_NODE 3450 IF(.NOT.CMUMPS_727())THEN 3451 IF(SOLVE_STEP.EQ.0)THEN 3452 I=CUR_POS_SEQUENCE 3453 TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, 3454 & OOC_FCT_TYPE) 3455 DO WHILE ((I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)).AND. 3456 & (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) 3457 & .EQ.0_8)) 3458 INODE_TO_POS(STEP_OOC(TMP_NODE))=1 3459 OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED 3460 I=I+1 3461 IF(I.LE.TOTAL_NB_OOC_NODES(OOC_FCT_TYPE))THEN 3462 TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) 3463 ENDIF 3464 ENDDO 3465 CUR_POS_SEQUENCE=min(I,TOTAL_NB_OOC_NODES(OOC_FCT_TYPE)) 3466 ELSE 3467 I=CUR_POS_SEQUENCE 3468 TMP_NODE=OOC_INODE_SEQUENCE(CUR_POS_SEQUENCE, 3469 & OOC_FCT_TYPE) 3470 DO WHILE ((I.GE.1).AND. 3471 & (SIZE_OF_BLOCK(STEP_OOC(TMP_NODE),OOC_FCT_TYPE) 3472 & .EQ.0_8)) 3473 INODE_TO_POS(STEP_OOC(TMP_NODE))=1 3474 OOC_STATE_NODE(STEP_OOC(TMP_NODE))=NOT_USED 3475 I=I-1 3476 IF(I.GE.1)THEN 3477 TMP_NODE=OOC_INODE_SEQUENCE(I,OOC_FCT_TYPE) 3478 ENDIF 3479 ENDDO 3480 CUR_POS_SEQUENCE=max(I,1) 3481 ENDIF 3482 ENDIF 3483 RETURN 3484 END SUBROUTINE CMUMPS_728 3485 SUBROUTINE CMUMPS_809(N,KEEP201, 3486 & Pruned_List,nb_prun_nodes,STEP) 3487 IMPLICIT NONE 3488 INTEGER, INTENT(IN) :: N, KEEP201, nb_prun_nodes 3489 INTEGER, INTENT(IN) :: STEP(N), 3490 & Pruned_List(nb_prun_nodes) 3491 INTEGER I, ISTEP 3492 IF (KEEP201 .GT. 0) THEN 3493 OOC_STATE_NODE(:) = ALREADY_USED 3494 DO I = 1, nb_prun_nodes 3495 ISTEP = STEP(Pruned_List(I)) 3496 OOC_STATE_NODE(ISTEP) = NOT_IN_MEM 3497 ENDDO 3498 ENDIF 3499 RETURN 3500 END SUBROUTINE CMUMPS_809 3501 END MODULE CMUMPS_OOC 3502