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