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 IDLL 14 IMPLICIT NONE 15 TYPE IDLL_NODE_T 16 TYPE ( IDLL_NODE_T ), POINTER :: NEXT, PREV 17 INTEGER ELMT 18 END TYPE IDLL_NODE_T 19 TYPE IDLL_T 20 TYPE ( IDLL_NODE_T ), POINTER :: FRONT, BACK 21 END TYPE IDLL_T 22 CONTAINS 23 FUNCTION IDLL_CREATE(DLL) 24 INTEGER :: IDLL_CREATE 25#if defined(MUMPS_F2003) 26 TYPE ( IDLL_T ), POINTER, INTENT ( OUT ) :: DLL 27#else 28 TYPE ( IDLL_T ), POINTER :: DLL 29#endif 30 INTEGER IERR 31 ALLOCATE ( DLL, STAT=IERR ) 32 IF ( IERR .NE. 0 ) THEN 33 IDLL_CREATE = -2 34 RETURN 35 END IF 36 NULLIFY ( DLL%FRONT ) 37 NULLIFY ( DLL%BACK ) 38 IDLL_CREATE = 0 39 RETURN 40 END FUNCTION IDLL_CREATE 41 FUNCTION IDLL_DESTROY(DLL) 42 INTEGER :: IDLL_DESTROY 43#if defined(MUMPS_F2003) 44 TYPE ( IDLL_T ), POINTER, INTENT ( OUT ) :: DLL 45#else 46 TYPE ( IDLL_T ), POINTER :: DLL 47#endif 48 TYPE ( IDLL_NODE_T ), POINTER :: AUX 49 IF ( .NOT. associated ( DLL ) ) THEN 50 IDLL_DESTROY = -1 51 RETURN 52 END IF 53 DO WHILE ( associated ( DLL%FRONT ) ) 54 AUX => DLL%FRONT 55 DLL%FRONT => DLL%FRONT%NEXT 56 DEALLOCATE( AUX ) 57 END DO 58 DEALLOCATE( DLL ) 59 IDLL_DESTROY = 0 60 END FUNCTION IDLL_DESTROY 61 FUNCTION IDLL_PUSH_FRONT(DLL, ELMT) 62 INTEGER :: IDLL_PUSH_FRONT 63#if defined(MUMPS_F2003) 64 TYPE ( IDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 65#else 66 TYPE ( IDLL_T ), POINTER :: DLL 67#endif 68 INTEGER, INTENT ( IN ) :: ELMT 69 TYPE ( IDLL_NODE_T ), POINTER :: NODE 70 INTEGER IERR 71 IF ( .NOT. associated ( DLL ) ) THEN 72 IDLL_PUSH_FRONT = -1 73 RETURN 74 END IF 75 ALLOCATE( NODE, STAT=IERR ) 76 IF ( IERR .NE. 0 ) THEN 77 IDLL_PUSH_FRONT = -2 78 RETURN 79 END IF 80 NODE%ELMT = ELMT 81 NODE%NEXT => DLL%FRONT 82 NULLIFY ( NODE%PREV ) 83 IF ( associated ( DLL%FRONT ) ) THEN 84 DLL%FRONT%PREV => NODE 85 END IF 86 DLL%FRONT => NODE 87 IF ( .NOT. associated ( DLL%BACK ) ) THEN 88 DLL%BACK => NODE 89 END IF 90 IDLL_PUSH_FRONT = 0 91 END FUNCTION IDLL_PUSH_FRONT 92 FUNCTION IDLL_POP_FRONT(DLL, ELMT) 93 INTEGER :: IDLL_POP_FRONT 94#if defined(MUMPS_F2003) 95 TYPE ( IDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 96#else 97 TYPE ( IDLL_T ), POINTER :: DLL 98#endif 99 INTEGER, INTENT ( OUT ) :: ELMT 100 TYPE ( IDLL_NODE_T ), POINTER :: AUX 101 IF ( .NOT. associated ( DLL ) ) THEN 102 IDLL_POP_FRONT = -1 103 RETURN 104 END IF 105 IF ( .NOT. associated ( DLL%FRONT ) ) THEN 106 IDLL_POP_FRONT = -3 107 RETURN 108 END IF 109 ELMT = DLL%FRONT%ELMT 110 AUX => DLL%FRONT 111 DLL%FRONT => DLL%FRONT%NEXT 112 IF ( associated ( DLL%FRONT ) ) THEN 113 NULLIFY ( DLL%FRONT%PREV ) 114 END IF 115 IF ( associated ( DLL%BACK, AUX ) ) THEN 116 NULLIFY ( DLL%BACK ) 117 END IF 118 DEALLOCATE ( AUX ) 119 IDLL_POP_FRONT = 0 120 END FUNCTION IDLL_POP_FRONT 121 FUNCTION IDLL_PUSH_BACK(DLL, ELMT) 122 INTEGER :: IDLL_PUSH_BACK 123#if defined(MUMPS_F2003) 124 TYPE ( IDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 125#else 126 TYPE ( IDLL_T ), POINTER :: DLL 127#endif 128 INTEGER, INTENT ( IN ) :: ELMT 129 TYPE ( IDLL_NODE_T ), POINTER :: NODE 130 INTEGER IERR 131 IF ( .NOT. associated ( DLL ) ) THEN 132 IDLL_PUSH_BACK = -1 133 RETURN 134 END IF 135 ALLOCATE( NODE, STAT=IERR ) 136 IF ( IERR .NE. 0 ) THEN 137 IDLL_PUSH_BACK = -2 138 RETURN 139 END IF 140 NODE%ELMT = ELMT 141 NULLIFY ( NODE%NEXT ) 142 NODE%PREV => DLL%BACK 143 IF ( associated ( DLL%BACK ) ) THEN 144 DLL%BACK%NEXT => NODE 145 END IF 146 DLL%BACK => NODE 147 IF ( .NOT. associated ( DLL%FRONT ) ) THEN 148 DLL%FRONT => NODE 149 END IF 150 IDLL_PUSH_BACK = 0 151 END FUNCTION IDLL_PUSH_BACK 152 FUNCTION IDLL_POP_BACK(DLL, ELMT) 153 INTEGER :: IDLL_POP_BACK 154#if defined(MUMPS_F2003) 155 TYPE ( IDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 156#else 157 TYPE ( IDLL_T ), POINTER :: DLL 158#endif 159 INTEGER, INTENT ( OUT ) :: ELMT 160 TYPE ( IDLL_NODE_T ), POINTER :: AUX 161 IF ( .NOT. associated ( DLL ) ) THEN 162 IDLL_POP_BACK = -1 163 RETURN 164 END IF 165 IF ( .NOT. associated ( DLL%BACK ) ) THEN 166 IDLL_POP_BACK = -3 167 RETURN 168 END IF 169 ELMT = DLL%BACK%ELMT 170 AUX => DLL%BACK 171 DLL%BACK => DLL%BACK%PREV 172 IF ( associated ( DLL%BACK ) ) THEN 173 NULLIFY ( DLL%BACK%NEXT ) 174 END IF 175 IF ( associated ( DLL%FRONT, AUX ) ) THEN 176 NULLIFY ( DLL%FRONT ) 177 END IF 178 DEALLOCATE ( AUX ) 179 IDLL_POP_BACK = 0 180 END FUNCTION IDLL_POP_BACK 181 FUNCTION IDLL_INSERT(DLL, POS, ELMT) 182 INTEGER :: IDLL_INSERT 183#if defined(MUMPS_F2003) 184 TYPE ( IDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 185#else 186 TYPE ( IDLL_T ), POINTER :: DLL 187#endif 188 INTEGER, INTENT ( IN ) :: POS, ELMT 189 TYPE ( IDLL_NODE_T ), POINTER :: NODE 190 TYPE ( IDLL_NODE_T ), POINTER :: NEW_PTR, OLD_PTR 191 INTEGER :: IERR, CPT 192 IF ( .NOT. associated ( DLL ) ) THEN 193 IDLL_INSERT = -1 194 RETURN 195 END IF 196 IF ( POS .LE. 0 ) THEN 197 IDLL_INSERT = -4 198 RETURN 199 END IF 200 CPT = 1 201 NEW_PTR => DLL%FRONT 202 NULLIFY ( OLD_PTR ) 203 DO WHILE ( ( CPT .LT. POS ) .AND. 204 & ( associated ( NEW_PTR ) ) ) 205 OLD_PTR => NEW_PTR 206 NEW_PTR => NEW_PTR%NEXT 207 CPT = CPT + 1 208 END DO 209 ALLOCATE ( NODE, STAT=IERR ) 210 IF ( IERR .NE. 0 ) THEN 211 IDLL_INSERT = -2 212 RETURN 213 END IF 214 NODE%ELMT = ELMT 215 IF ( .NOT. associated ( OLD_PTR ) ) THEN 216 IF ( .NOT. associated ( NEW_PTR ) ) THEN 217 NULLIFY ( NODE%PREV ) 218 NULLIFY ( NODE%NEXT ) 219 DLL%FRONT => NODE 220 DLL%BACK => NODE 221 ELSE 222 NULLIFY ( NODE%PREV ) 223 NODE%NEXT => NEW_PTR 224 NEW_PTR%PREV => NODE 225 DLL%FRONT => NODE 226 END IF 227 ELSE 228 IF ( .NOT. associated ( NEW_PTR ) ) THEN 229 NODE%PREV => OLD_PTR 230 NULLIFY ( NODE%NEXT ) 231 OLD_PTR%NEXT => NODE 232 DLL%BACK => NODE 233 ELSE 234 NODE%PREV => OLD_PTR 235 NODE%NEXT => NEW_PTR 236 OLD_PTR%NEXT => NODE 237 NEW_PTR%PREV => NODE 238 END IF 239 END IF 240 IDLL_INSERT = 0 241 END FUNCTION IDLL_INSERT 242 FUNCTION IDLL_INSERT_BEFORE(DLL, NODE_AFTER, ELMT) 243 INTEGER :: IDLL_INSERT_BEFORE 244#if defined(MUMPS_F2003) 245 TYPE ( IDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 246 TYPE ( IDLL_NODE_T ), POINTER, INTENT ( IN ) :: NODE_AFTER 247#else 248 TYPE ( IDLL_T ), POINTER :: DLL 249 TYPE ( IDLL_NODE_T ), POINTER :: NODE_AFTER 250#endif 251 INTEGER, INTENT ( IN ) :: ELMT 252 TYPE ( IDLL_NODE_T ), POINTER :: NODE_BEFORE 253 INTEGER :: IERR 254 ALLOCATE ( NODE_BEFORE, STAT=IERR ) 255 IF ( IERR .NE. 0 ) THEN 256 IDLL_INSERT_BEFORE = -2 257 RETURN 258 END IF 259 NODE_BEFORE%ELMT = ELMT 260 IF ( .NOT. associated ( NODE_AFTER%PREV ) ) THEN 261 NODE_AFTER%PREV => NODE_BEFORE 262 NODE_BEFORE%NEXT => NODE_AFTER 263 NULLIFY ( NODE_BEFORE%PREV ) 264 DLL%FRONT => NODE_BEFORE 265 ELSE 266 NODE_BEFORE%NEXT => NODE_AFTER 267 NODE_BEFORE%PREV => NODE_AFTER%PREV 268 NODE_AFTER%PREV => NODE_BEFORE 269 NODE_BEFORE%PREV%NEXT => NODE_BEFORE 270 END IF 271 IDLL_INSERT_BEFORE = 0 272 END FUNCTION IDLL_INSERT_BEFORE 273 FUNCTION IDLL_INSERT_AFTER(DLL, NODE_BEFORE, ELMT) 274 INTEGER :: IDLL_INSERT_AFTER 275#if defined(MUMPS_F2003) 276 TYPE ( IDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 277 TYPE ( IDLL_NODE_T ), POINTER, INTENT ( IN ) :: NODE_BEFORE 278#else 279 TYPE ( IDLL_T ), POINTER :: DLL 280 TYPE ( IDLL_NODE_T ), POINTER :: NODE_BEFORE 281#endif 282 INTEGER, INTENT ( IN ) :: ELMT 283 TYPE ( IDLL_NODE_T ), POINTER :: NODE_AFTER 284 INTEGER :: IERR 285 ALLOCATE ( NODE_AFTER, STAT=IERR ) 286 IF ( IERR .NE. 0 ) THEN 287 IDLL_INSERT_AFTER = -2 288 RETURN 289 END IF 290 NODE_AFTER%ELMT = ELMT 291 IF ( .NOT. associated ( NODE_BEFORE%NEXT ) ) THEN 292 NODE_BEFORE%NEXT => NODE_AFTER 293 NODE_AFTER%PREV => NODE_BEFORE 294 NULLIFY ( NODE_AFTER%NEXT ) 295 DLL%BACK => NODE_AFTER 296 ELSE 297 NODE_AFTER%PREV => NODE_BEFORE 298 NODE_AFTER%NEXT => NODE_BEFORE%NEXT 299 NODE_BEFORE%NEXT => NODE_AFTER 300 NODE_AFTER%NEXT%PREV => NODE_AFTER 301 END IF 302 IDLL_INSERT_AFTER = 0 303 END FUNCTION IDLL_INSERT_AFTER 304 FUNCTION IDLL_LOOKUP (DLL, POS, ELMT) 305 INTEGER :: IDLL_LOOKUP 306#if defined(MUMPS_F2003) 307 TYPE ( IDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 308#else 309 TYPE ( IDLL_T ), POINTER :: DLL 310#endif 311 INTEGER, INTENT ( IN ) :: POS 312 INTEGER, INTENT ( OUT ) :: ELMT 313 TYPE ( IDLL_NODE_T ), POINTER :: AUX 314 INTEGER :: CPT 315 IF ( .NOT. associated ( DLL ) ) THEN 316 IDLL_LOOKUP = -1 317 RETURN 318 END IF 319 IF ( POS .LE. 0 ) THEN 320 IDLL_LOOKUP = -4 321 RETURN 322 END IF 323 CPT = 1 324 AUX => DLL%FRONT 325 DO WHILE ( ( CPT .LT. POS ) .AND. ( associated ( AUX ) ) ) 326 CPT = CPT + 1 327 AUX => AUX%NEXT 328 END DO 329 IF ( .NOT. associated ( AUX ) ) THEN 330 IDLL_LOOKUP = -3 331 RETURN 332 END IF 333 ELMT = AUX%ELMT 334 IDLL_LOOKUP = 0 335 END FUNCTION IDLL_LOOKUP 336 FUNCTION IDLL_REMOVE_POS(DLL, POS, ELMT) 337 INTEGER :: IDLL_REMOVE_POS 338#if defined(MUMPS_F2003) 339 TYPE ( IDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 340#else 341 TYPE ( IDLL_T ), POINTER :: DLL 342#endif 343 INTEGER, INTENT ( IN ) :: POS 344 INTEGER, INTENT ( OUT ) :: ELMT 345 TYPE ( IDLL_NODE_T ), POINTER :: AUX 346 INTEGER :: CPT 347 IF ( .NOT. associated ( DLL ) ) THEN 348 IDLL_REMOVE_POS = -1 349 RETURN 350 END IF 351 CPT = 1 352 AUX => DLL%FRONT 353 DO WHILE ( ( associated ( AUX ) ) .AND. 354 & ( CPT .LT. POS ) ) 355 CPT = CPT + 1 356 AUX => AUX%NEXT 357 END DO 358 IF ( associated ( AUX ) ) THEN 359 IF ( .NOT. associated ( AUX%PREV ) ) THEN 360 IF ( .NOT. associated ( AUX%NEXT ) ) THEN 361 NULLIFY ( DLL%FRONT ) 362 NULLIFY ( DLL%BACK ) 363 ELSE 364 NULLIFY ( AUX%NEXT%PREV ) 365 DLL%FRONT => AUX%NEXT 366 END IF 367 ELSE 368 IF ( .NOT. associated ( AUX%NEXT ) ) THEN 369 NULLIFY ( AUX%PREV%NEXT ) 370 DLL%BACK => AUX%PREV 371 ELSE 372 AUX%PREV%NEXT => AUX%NEXT 373 AUX%NEXT%PREV => AUX%PREV 374 END IF 375 END IF 376 ELMT = AUX%ELMT 377 DEALLOCATE ( AUX ) 378 ELSE 379 IDLL_REMOVE_POS = -3 380 RETURN 381 END IF 382 IDLL_REMOVE_POS = 0 383 END FUNCTION IDLL_REMOVE_POS 384 FUNCTION IDLL_REMOVE_ELMT(DLL, ELMT, POS) 385 INTEGER :: IDLL_REMOVE_ELMT 386#if defined(MUMPS_F2003) 387 TYPE ( IDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 388#else 389 TYPE ( IDLL_T ), POINTER :: DLL 390#endif 391 INTEGER, INTENT ( IN ) :: ELMT 392 INTEGER, INTENT ( OUT ) :: POS 393 TYPE ( IDLL_NODE_T ), POINTER :: AUX 394 INTEGER :: CPT 395 IF ( .NOT. associated ( DLL ) ) THEN 396 IDLL_REMOVE_ELMT = -1 397 RETURN 398 END IF 399 CPT = 1 400 AUX => DLL%FRONT 401 DO WHILE ( ( associated ( AUX ) ) .AND. 402 & ( AUX%ELMT .NE. ELMT ) ) 403 CPT = CPT + 1 404 AUX => AUX%NEXT 405 END DO 406 IF ( associated ( AUX ) ) THEN 407 IF ( .NOT. associated ( AUX%PREV ) ) THEN 408 IF ( .NOT. associated ( AUX%NEXT ) ) THEN 409 NULLIFY ( DLL%FRONT ) 410 NULLIFY ( DLL%BACK ) 411 ELSE 412 NULLIFY ( AUX%NEXT%PREV ) 413 DLL%FRONT => AUX%NEXT 414 END IF 415 ELSE 416 IF ( .NOT. associated ( AUX%NEXT ) ) THEN 417 NULLIFY ( AUX%PREV%NEXT ) 418 DLL%BACK => AUX%PREV 419 ELSE 420 AUX%PREV%NEXT => AUX%NEXT 421 AUX%NEXT%PREV => AUX%PREV 422 END IF 423 END IF 424 POS = CPT 425 DEALLOCATE ( AUX ) 426 ELSE 427 IDLL_REMOVE_ELMT = -3 428 RETURN 429 END IF 430 IDLL_REMOVE_ELMT = 0 431 END FUNCTION IDLL_REMOVE_ELMT 432 FUNCTION IDLL_LENGTH(DLL) 433 INTEGER :: IDLL_LENGTH 434#if defined(MUMPS_F2003) 435 TYPE ( IDLL_T ), POINTER, INTENT ( IN ) :: DLL 436#else 437 TYPE ( IDLL_T ), POINTER :: DLL 438#endif 439 INTEGER :: LENGTH 440 TYPE ( IDLL_NODE_T ), POINTER :: AUX 441 IF ( .NOT. associated ( DLL ) ) THEN 442 IDLL_LENGTH = -1 443 RETURN 444 END IF 445 LENGTH = 0 446 AUX => DLL%FRONT 447 DO WHILE ( associated ( AUX ) ) 448 LENGTH = LENGTH + 1 449 AUX => AUX%NEXT 450 END DO 451 IDLL_LENGTH = LENGTH 452 END FUNCTION IDLL_LENGTH 453 FUNCTION IDLL_ITERATOR_BEGIN(DLL, PTR) 454 INTEGER :: IDLL_ITERATOR_BEGIN 455#if defined(MUMPS_F2003) 456 TYPE ( IDLL_T ), POINTER, INTENT ( IN ) :: DLL 457 TYPE ( IDLL_NODE_T ), POINTER, INTENT ( OUT ) :: PTR 458#else 459 TYPE ( IDLL_T ), POINTER :: DLL 460 TYPE ( IDLL_NODE_T ), POINTER :: PTR 461#endif 462 IF ( .NOT. associated ( DLL ) ) THEN 463 IDLL_ITERATOR_BEGIN = -1 464 RETURN 465 END IF 466 PTR => DLL%FRONT 467 IDLL_ITERATOR_BEGIN = 0 468 END FUNCTION IDLL_ITERATOR_BEGIN 469 FUNCTION IDLL_ITERATOR_END(DLL, PTR) 470 INTEGER :: IDLL_ITERATOR_END 471#if defined(MUMPS_F2003) 472 TYPE ( IDLL_T ), POINTER, INTENT ( IN ) :: DLL 473 TYPE ( IDLL_NODE_T ), POINTER, INTENT ( OUT ) :: PTR 474#else 475 TYPE ( IDLL_T ), POINTER :: DLL 476 TYPE ( IDLL_NODE_T ), POINTER :: PTR 477#endif 478 IF ( .NOT. associated ( DLL ) ) THEN 479 IDLL_ITERATOR_END = -1 480 RETURN 481 END IF 482 PTR => DLL%BACK 483 IDLL_ITERATOR_END = 0 484 END FUNCTION IDLL_ITERATOR_END 485 FUNCTION IDLL_IS_EMPTY(DLL) 486 LOGICAL :: IDLL_IS_EMPTY 487#if defined(MUMPS_F2003) 488 TYPE ( IDLL_T ), POINTER, INTENT ( IN ) :: DLL 489#else 490 TYPE ( IDLL_T ), POINTER :: DLL 491#endif 492 IDLL_IS_EMPTY = ( associated ( DLL%FRONT ) ) 493 END FUNCTION IDLL_IS_EMPTY 494 FUNCTION IDLL_2_ARRAY(DLL, ARRAY, LENGTH) 495 INTEGER :: IDLL_2_ARRAY 496#if defined(MUMPS_F2003) 497 TYPE ( IDLL_T ), POINTER, INTENT ( IN ) :: DLL 498 INTEGER, POINTER, DIMENSION (:), INTENT ( OUT ) :: ARRAY 499#else 500 TYPE ( IDLL_T ), POINTER :: DLL 501 INTEGER, POINTER, DIMENSION (:) :: ARRAY 502#endif 503 INTEGER, INTENT ( OUT ) :: LENGTH 504 TYPE ( IDLL_NODE_T ), POINTER :: AUX 505 INTEGER :: I, IERR 506 IF ( .NOT. associated ( DLL ) ) THEN 507 IDLL_2_ARRAY = -1 508 RETURN 509 END IF 510 LENGTH = IDLL_LENGTH(DLL) 511 ALLOCATE ( ARRAY ( LENGTH ), STAT=IERR ) 512 IF ( IERR .NE. 0 ) THEN 513 IDLL_2_ARRAY = -2 514 RETURN 515 END IF 516 I = 1 517 AUX => DLL%FRONT 518 DO WHILE ( associated ( AUX ) ) 519 ARRAY ( I ) = AUX%ELMT 520 I = I + 1 521 AUX => AUX%NEXT 522 END DO 523 IDLL_2_ARRAY = 0 524 END FUNCTION IDLL_2_ARRAY 525 END MODULE IDLL 526 MODULE DDLL 527 IMPLICIT NONE 528 TYPE DDLL_NODE_T 529 TYPE ( DDLL_NODE_T ), POINTER :: NEXT, PREV 530 DOUBLE PRECISION :: ELMT 531 END TYPE DDLL_NODE_T 532 TYPE DDLL_T 533 TYPE ( DDLL_NODE_T ), POINTER :: FRONT, BACK 534 END TYPE DDLL_T 535 CONTAINS 536 FUNCTION DDLL_CREATE(DLL) 537 INTEGER :: DDLL_CREATE 538#if defined(MUMPS_F2003) 539 TYPE ( DDLL_T ), POINTER, INTENT ( OUT ) :: DLL 540#else 541 TYPE ( DDLL_T ), POINTER :: DLL 542#endif 543 INTEGER IERR 544 ALLOCATE ( DLL, STAT=IERR ) 545 IF ( IERR .NE. 0 ) THEN 546 DDLL_CREATE = -2 547 RETURN 548 END IF 549 NULLIFY ( DLL%FRONT ) 550 NULLIFY ( DLL%BACK ) 551 DDLL_CREATE = 0 552 RETURN 553 END FUNCTION DDLL_CREATE 554 FUNCTION DDLL_DESTROY(DLL) 555 INTEGER :: DDLL_DESTROY 556#if defined(MUMPS_F2003) 557 TYPE ( DDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 558#else 559 TYPE ( DDLL_T ), POINTER :: DLL 560#endif 561 TYPE ( DDLL_NODE_T ), POINTER :: AUX 562 IF ( .NOT. associated ( DLL ) ) THEN 563 DDLL_DESTROY = -1 564 RETURN 565 END IF 566 DO WHILE ( associated ( DLL%FRONT ) ) 567 AUX => DLL%FRONT 568 DLL%FRONT => DLL%FRONT%NEXT 569 DEALLOCATE( AUX ) 570 END DO 571 DEALLOCATE( DLL ) 572 DDLL_DESTROY = 0 573 END FUNCTION DDLL_DESTROY 574 FUNCTION DDLL_PUSH_FRONT(DLL, ELMT) 575 INTEGER :: DDLL_PUSH_FRONT 576#if defined(MUMPS_F2003) 577 TYPE ( DDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 578#else 579 TYPE ( DDLL_T ), POINTER :: DLL 580#endif 581 DOUBLE PRECISION, INTENT ( IN ) :: ELMT 582 TYPE ( DDLL_NODE_T ), POINTER :: NODE 583 INTEGER IERR 584 IF ( .NOT. associated ( DLL ) ) THEN 585 DDLL_PUSH_FRONT = -1 586 RETURN 587 END IF 588 ALLOCATE( NODE, STAT=IERR ) 589 IF ( IERR .NE. 0 ) THEN 590 DDLL_PUSH_FRONT = -2 591 RETURN 592 END IF 593 NODE%ELMT = ELMT 594 NODE%NEXT => DLL%FRONT 595 NULLIFY ( NODE%PREV ) 596 IF ( associated ( DLL%FRONT ) ) THEN 597 DLL%FRONT%PREV => NODE 598 END IF 599 DLL%FRONT => NODE 600 IF ( .NOT. associated ( DLL%BACK ) ) THEN 601 DLL%BACK => NODE 602 END IF 603 DDLL_PUSH_FRONT = 0 604 END FUNCTION DDLL_PUSH_FRONT 605 FUNCTION DDLL_POP_FRONT(DLL, ELMT) 606 INTEGER :: DDLL_POP_FRONT 607#if defined(MUMPS_F2003) 608 TYPE ( DDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 609#else 610 TYPE ( DDLL_T ), POINTER :: DLL 611#endif 612 DOUBLE PRECISION, INTENT ( OUT ) :: ELMT 613 TYPE ( DDLL_NODE_T ), POINTER :: AUX 614 IF ( .NOT. associated ( DLL ) ) THEN 615 DDLL_POP_FRONT = -1 616 RETURN 617 END IF 618 IF ( .NOT. associated ( DLL%FRONT ) ) THEN 619 DDLL_POP_FRONT = -3 620 RETURN 621 END IF 622 ELMT = DLL%FRONT%ELMT 623 AUX => DLL%FRONT 624 DLL%FRONT => DLL%FRONT%NEXT 625 IF ( associated ( DLL%FRONT ) ) THEN 626 NULLIFY ( DLL%FRONT%PREV ) 627 END IF 628 IF ( associated ( DLL%BACK, AUX ) ) THEN 629 NULLIFY ( DLL%BACK ) 630 END IF 631 DEALLOCATE ( AUX ) 632 DDLL_POP_FRONT = 0 633 END FUNCTION DDLL_POP_FRONT 634 FUNCTION DDLL_PUSH_BACK(DLL, ELMT) 635 INTEGER :: DDLL_PUSH_BACK 636#if defined(MUMPS_F2003) 637 TYPE ( DDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 638#else 639 TYPE ( DDLL_T ), POINTER :: DLL 640#endif 641 DOUBLE PRECISION, INTENT ( IN ) :: ELMT 642 TYPE ( DDLL_NODE_T ), POINTER :: NODE 643 INTEGER IERR 644 IF ( .NOT. associated ( DLL ) ) THEN 645 DDLL_PUSH_BACK = -1 646 RETURN 647 END IF 648 ALLOCATE( NODE, STAT=IERR ) 649 IF ( IERR .NE. 0 ) THEN 650 DDLL_PUSH_BACK = -2 651 RETURN 652 END IF 653 NODE%ELMT = ELMT 654 NULLIFY ( NODE%NEXT ) 655 NODE%PREV => DLL%BACK 656 IF ( associated ( DLL%BACK ) ) THEN 657 DLL%BACK%NEXT => NODE 658 END IF 659 DLL%BACK => NODE 660 IF ( .NOT. associated ( DLL%FRONT ) ) THEN 661 DLL%FRONT => NODE 662 END IF 663 DDLL_PUSH_BACK = 0 664 END FUNCTION DDLL_PUSH_BACK 665 FUNCTION DDLL_POP_BACK(DLL, ELMT) 666 INTEGER :: DDLL_POP_BACK 667#if defined(MUMPS_F2003) 668 TYPE ( DDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 669#else 670 TYPE ( DDLL_T ), POINTER :: DLL 671#endif 672 DOUBLE PRECISION, INTENT ( OUT ) :: ELMT 673 TYPE ( DDLL_NODE_T ), POINTER :: AUX 674 IF ( .NOT. associated ( DLL ) ) THEN 675 DDLL_POP_BACK = -1 676 RETURN 677 END IF 678 IF ( .NOT. associated ( DLL%BACK ) ) THEN 679 DDLL_POP_BACK = -3 680 RETURN 681 END IF 682 ELMT = DLL%BACK%ELMT 683 AUX => DLL%BACK 684 DLL%BACK => DLL%BACK%PREV 685 IF ( associated ( DLL%BACK ) ) THEN 686 NULLIFY ( DLL%BACK%NEXT ) 687 END IF 688 IF ( associated ( DLL%FRONT, AUX ) ) THEN 689 NULLIFY ( DLL%FRONT ) 690 END IF 691 DEALLOCATE ( AUX ) 692 DDLL_POP_BACK = 0 693 END FUNCTION DDLL_POP_BACK 694 FUNCTION DDLL_INSERT(DLL, POS, ELMT) 695 INTEGER :: DDLL_INSERT 696#if defined(MUMPS_F2003) 697 TYPE ( DDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 698#else 699 TYPE ( DDLL_T ), POINTER :: DLL 700#endif 701 INTEGER, INTENT ( IN ) :: POS 702 DOUBLE PRECISION , INTENT ( IN ) :: ELMT 703 TYPE ( DDLL_NODE_T ), POINTER :: NODE 704 TYPE ( DDLL_NODE_T ), POINTER :: NEW_PTR, OLD_PTR 705 INTEGER :: IERR, CPT 706 IF ( .NOT. associated ( DLL ) ) THEN 707 DDLL_INSERT = -1 708 RETURN 709 END IF 710 IF ( POS .LE. 0 ) THEN 711 DDLL_INSERT = -4 712 RETURN 713 END IF 714 CPT = 1 715 NEW_PTR => DLL%FRONT 716 NULLIFY ( OLD_PTR ) 717 DO WHILE ( ( CPT .LT. POS ) .AND. 718 & ( associated ( NEW_PTR ) ) ) 719 OLD_PTR => NEW_PTR 720 NEW_PTR => NEW_PTR%NEXT 721 CPT = CPT + 1 722 END DO 723 ALLOCATE ( NODE, STAT=IERR ) 724 IF ( IERR .NE. 0 ) THEN 725 DDLL_INSERT = -2 726 RETURN 727 END IF 728 NODE%ELMT = ELMT 729 IF ( .NOT. associated ( OLD_PTR ) ) THEN 730 IF ( .NOT. associated ( NEW_PTR ) ) THEN 731 NULLIFY ( NODE%PREV ) 732 NULLIFY ( NODE%NEXT ) 733 DLL%FRONT => NODE 734 DLL%BACK => NODE 735 ELSE 736 NULLIFY ( NODE%PREV ) 737 NODE%NEXT => NEW_PTR 738 NEW_PTR%PREV => NODE 739 DLL%FRONT => NODE 740 END IF 741 ELSE 742 IF ( .NOT. associated ( NEW_PTR ) ) THEN 743 NODE%PREV => OLD_PTR 744 NULLIFY ( NODE%NEXT ) 745 OLD_PTR%NEXT => NODE 746 DLL%BACK => NODE 747 ELSE 748 NODE%PREV => OLD_PTR 749 NODE%NEXT => NEW_PTR 750 OLD_PTR%NEXT => NODE 751 NEW_PTR%PREV => NODE 752 END IF 753 END IF 754 DDLL_INSERT = 0 755 END FUNCTION DDLL_INSERT 756 FUNCTION DDLL_INSERT_BEFORE(DLL, NODE_AFTER, ELMT) 757 INTEGER :: DDLL_INSERT_BEFORE 758#if defined(MUMPS_F2003) 759 TYPE ( DDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 760 TYPE ( DDLL_NODE_T ), POINTER, INTENT ( IN ) :: NODE_AFTER 761#else 762 TYPE ( DDLL_T ), POINTER :: DLL 763 TYPE ( DDLL_NODE_T ), POINTER :: NODE_AFTER 764#endif 765 DOUBLE PRECISION, INTENT ( IN ) :: ELMT 766 TYPE ( DDLL_NODE_T ), POINTER :: NODE_BEFORE 767 INTEGER :: IERR 768 ALLOCATE ( NODE_BEFORE, STAT=IERR ) 769 IF ( IERR .NE. 0 ) THEN 770 DDLL_INSERT_BEFORE = -2 771 RETURN 772 END IF 773 NODE_BEFORE%ELMT = ELMT 774 IF ( .NOT. associated ( NODE_AFTER%PREV ) ) THEN 775 NODE_AFTER%PREV => NODE_BEFORE 776 NODE_BEFORE%NEXT => NODE_AFTER 777 NULLIFY ( NODE_BEFORE%PREV ) 778 DLL%FRONT => NODE_BEFORE 779 ELSE 780 NODE_BEFORE%NEXT => NODE_AFTER 781 NODE_BEFORE%PREV => NODE_AFTER%PREV 782 NODE_AFTER%PREV => NODE_BEFORE 783 NODE_BEFORE%PREV%NEXT => NODE_BEFORE 784 END IF 785 DDLL_INSERT_BEFORE = 0 786 END FUNCTION DDLL_INSERT_BEFORE 787 FUNCTION DDLL_INSERT_AFTER(DLL, NODE_BEFORE, ELMT) 788 INTEGER :: DDLL_INSERT_AFTER 789#if defined(MUMPS_F2003) 790 TYPE ( DDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 791 TYPE ( DDLL_NODE_T ), POINTER, INTENT ( IN ) :: NODE_BEFORE 792#else 793 TYPE ( DDLL_T ), POINTER :: DLL 794 TYPE ( DDLL_NODE_T ), POINTER :: NODE_BEFORE 795#endif 796 DOUBLE PRECISION, INTENT ( IN ) :: ELMT 797 TYPE ( DDLL_NODE_T ), POINTER :: NODE_AFTER 798 INTEGER :: IERR 799 ALLOCATE ( NODE_AFTER, STAT=IERR ) 800 IF ( IERR .NE. 0 ) THEN 801 DDLL_INSERT_AFTER = -2 802 RETURN 803 END IF 804 NODE_AFTER%ELMT = ELMT 805 IF ( .NOT. associated ( NODE_BEFORE%NEXT ) ) THEN 806 NODE_BEFORE%NEXT => NODE_AFTER 807 NODE_AFTER%PREV => NODE_BEFORE 808 NULLIFY ( NODE_AFTER%NEXT ) 809 DLL%BACK => NODE_AFTER 810 ELSE 811 NODE_AFTER%PREV => NODE_BEFORE 812 NODE_AFTER%NEXT => NODE_BEFORE%NEXT 813 NODE_BEFORE%NEXT => NODE_AFTER 814 NODE_AFTER%NEXT%PREV => NODE_AFTER 815 END IF 816 DDLL_INSERT_AFTER = 0 817 END FUNCTION DDLL_INSERT_AFTER 818 FUNCTION DDLL_LOOKUP (DLL, POS, ELMT) 819 INTEGER :: DDLL_LOOKUP 820#if defined(MUMPS_F2003) 821 TYPE ( DDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 822#else 823 TYPE ( DDLL_T ), POINTER :: DLL 824#endif 825 INTEGER, INTENT ( IN ) :: POS 826 DOUBLE PRECISION, INTENT ( OUT ) :: ELMT 827 TYPE ( DDLL_NODE_T ), POINTER :: AUX 828 INTEGER :: CPT 829 IF ( .NOT. associated ( DLL ) ) THEN 830 DDLL_LOOKUP = -1 831 RETURN 832 END IF 833 IF ( POS .LE. 0 ) THEN 834 DDLL_LOOKUP = -4 835 RETURN 836 END IF 837 CPT = 1 838 AUX => DLL%FRONT 839 DO WHILE ( ( CPT .LT. POS ) .AND. ( associated ( AUX ) ) ) 840 CPT = CPT + 1 841 AUX => AUX%NEXT 842 END DO 843 IF ( .NOT. associated ( AUX ) ) THEN 844 DDLL_LOOKUP = -3 845 RETURN 846 END IF 847 ELMT = AUX%ELMT 848 DDLL_LOOKUP = 0 849 END FUNCTION DDLL_LOOKUP 850 FUNCTION DDLL_REMOVE_POS(DLL, POS, ELMT) 851 INTEGER :: DDLL_REMOVE_POS 852#if defined(MUMPS_F2003) 853 TYPE ( DDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 854#else 855 TYPE ( DDLL_T ), POINTER :: DLL 856#endif 857 INTEGER, INTENT ( IN ) :: POS 858 DOUBLE PRECISION, INTENT ( OUT ) :: ELMT 859 TYPE ( DDLL_NODE_T ), POINTER :: AUX 860 INTEGER :: CPT 861 IF ( .NOT. associated ( DLL ) ) THEN 862 DDLL_REMOVE_POS = -1 863 RETURN 864 END IF 865 CPT = 1 866 AUX => DLL%FRONT 867 DO WHILE ( ( associated ( AUX ) ) .AND. 868 & ( CPT .LT. POS ) ) 869 CPT = CPT + 1 870 AUX => AUX%NEXT 871 END DO 872 IF ( associated ( AUX ) ) THEN 873 IF ( .NOT. associated ( AUX%PREV ) ) THEN 874 IF ( .NOT. associated ( AUX%NEXT ) ) THEN 875 NULLIFY ( DLL%FRONT ) 876 NULLIFY ( DLL%BACK ) 877 ELSE 878 NULLIFY ( AUX%NEXT%PREV ) 879 DLL%FRONT => AUX%NEXT 880 END IF 881 ELSE 882 IF ( .NOT. associated ( AUX%NEXT ) ) THEN 883 NULLIFY ( AUX%PREV%NEXT ) 884 DLL%BACK => AUX%PREV 885 ELSE 886 AUX%PREV%NEXT => AUX%NEXT 887 AUX%NEXT%PREV => AUX%PREV 888 END IF 889 END IF 890 ELMT = AUX%ELMT 891 DEALLOCATE ( AUX ) 892 ELSE 893 DDLL_REMOVE_POS = -3 894 RETURN 895 END IF 896 DDLL_REMOVE_POS = 0 897 END FUNCTION DDLL_REMOVE_POS 898 FUNCTION DDLL_REMOVE_ELMT(DLL, ELMT, POS) 899 INTEGER :: DDLL_REMOVE_ELMT 900#if defined(MUMPS_F2003) 901 TYPE ( DDLL_T ), POINTER, INTENT ( INOUT ) :: DLL 902#else 903 TYPE ( DDLL_T ), POINTER :: DLL 904#endif 905 DOUBLE PRECISION, INTENT ( IN ) :: ELMT 906 INTEGER, INTENT ( OUT ) :: POS 907 TYPE ( DDLL_NODE_T ), POINTER :: AUX 908 INTEGER :: CPT 909 IF ( .NOT. associated ( DLL ) ) THEN 910 DDLL_REMOVE_ELMT = -1 911 RETURN 912 END IF 913 CPT = 1 914 AUX => DLL%FRONT 915 DO WHILE ( ( associated ( AUX ) ) .AND. 916 & ( AUX%ELMT .NE. ELMT ) ) 917 CPT = CPT + 1 918 AUX => AUX%NEXT 919 END DO 920 IF ( associated ( AUX ) ) THEN 921 IF ( .NOT. associated ( AUX%PREV ) ) THEN 922 IF ( .NOT. associated ( AUX%NEXT ) ) THEN 923 NULLIFY ( DLL%FRONT ) 924 NULLIFY ( DLL%BACK ) 925 ELSE 926 NULLIFY ( AUX%NEXT%PREV ) 927 DLL%FRONT => AUX%NEXT 928 END IF 929 ELSE 930 IF ( .NOT. associated ( AUX%NEXT ) ) THEN 931 NULLIFY ( AUX%PREV%NEXT ) 932 DLL%BACK => AUX%PREV 933 ELSE 934 AUX%PREV%NEXT => AUX%NEXT 935 AUX%NEXT%PREV => AUX%PREV 936 END IF 937 END IF 938 POS = CPT 939 DEALLOCATE ( AUX ) 940 ELSE 941 DDLL_REMOVE_ELMT = -3 942 RETURN 943 END IF 944 DDLL_REMOVE_ELMT = 0 945 END FUNCTION DDLL_REMOVE_ELMT 946 FUNCTION DDLL_LENGTH(DLL) 947 INTEGER :: DDLL_LENGTH 948#if defined(MUMPS_F2003) 949 TYPE ( DDLL_T ), POINTER, INTENT ( IN ) :: DLL 950#else 951 TYPE ( DDLL_T ), POINTER :: DLL 952#endif 953 INTEGER :: LENGTH 954 TYPE ( DDLL_NODE_T ), POINTER :: AUX 955 IF ( .NOT. associated ( DLL ) ) THEN 956 DDLL_LENGTH = -1 957 RETURN 958 END IF 959 LENGTH = 0 960 AUX => DLL%FRONT 961 DO WHILE ( associated ( AUX ) ) 962 LENGTH = LENGTH + 1 963 AUX => AUX%NEXT 964 END DO 965 DDLL_LENGTH = LENGTH 966 END FUNCTION DDLL_LENGTH 967 FUNCTION DDLL_ITERATOR_BEGIN(DLL, PTR) 968 INTEGER :: DDLL_ITERATOR_BEGIN 969#if defined(MUMPS_F2003) 970 TYPE ( DDLL_T ), POINTER, INTENT ( IN ) :: DLL 971 TYPE ( DDLL_NODE_T ), POINTER, INTENT ( OUT ) :: PTR 972#else 973 TYPE ( DDLL_T ), POINTER :: DLL 974 TYPE ( DDLL_NODE_T ), POINTER :: PTR 975#endif 976 IF ( .NOT. associated ( DLL ) ) THEN 977 DDLL_ITERATOR_BEGIN = -1 978 RETURN 979 END IF 980 PTR => DLL%FRONT 981 DDLL_ITERATOR_BEGIN = 0 982 END FUNCTION DDLL_ITERATOR_BEGIN 983 FUNCTION DDLL_ITERATOR_END(DLL, PTR) 984 INTEGER :: DDLL_ITERATOR_END 985#if defined(MUMPS_F2003) 986 TYPE ( DDLL_T ), POINTER, INTENT ( IN ) :: DLL 987 TYPE ( DDLL_NODE_T ), POINTER, INTENT ( OUT ) :: PTR 988#else 989 TYPE ( DDLL_T ), POINTER :: DLL 990 TYPE ( DDLL_NODE_T ), POINTER :: PTR 991#endif 992 IF ( .NOT. associated ( DLL ) ) THEN 993 DDLL_ITERATOR_END = -1 994 RETURN 995 END IF 996 PTR => DLL%BACK 997 DDLL_ITERATOR_END = 0 998 END FUNCTION DDLL_ITERATOR_END 999 FUNCTION DDLL_IS_EMPTY(DLL) 1000 LOGICAL :: DDLL_IS_EMPTY 1001#if defined(MUMPS_F2003) 1002 TYPE ( DDLL_T ), POINTER, INTENT ( IN ) :: DLL 1003#else 1004 TYPE ( DDLL_T ), POINTER :: DLL 1005#endif 1006 DDLL_IS_EMPTY = ( associated ( DLL%FRONT ) ) 1007 END FUNCTION DDLL_IS_EMPTY 1008 FUNCTION DDLL_2_ARRAY(DLL, ARRAY, LENGTH) 1009 INTEGER :: DDLL_2_ARRAY 1010#if defined(MUMPS_F2003) 1011 TYPE ( DDLL_T ), POINTER, INTENT ( IN ) :: DLL 1012 DOUBLE PRECISION, POINTER, DIMENSION(:), INTENT(OUT) :: ARRAY 1013#else 1014 TYPE ( DDLL_T ), POINTER :: DLL 1015 DOUBLE PRECISION, POINTER, DIMENSION(:) :: ARRAY 1016#endif 1017 INTEGER, INTENT ( OUT ) :: LENGTH 1018 TYPE ( DDLL_NODE_T ), POINTER :: AUX 1019 INTEGER :: I, IERR 1020 IF ( .NOT. associated ( DLL ) ) THEN 1021 DDLL_2_ARRAY = -1 1022 RETURN 1023 END IF 1024 LENGTH = DDLL_LENGTH(DLL) 1025 I = DDLL_LENGTH(DLL) 1026 ALLOCATE ( ARRAY ( I ), STAT=IERR ) 1027 IF ( IERR .NE. 0 ) THEN 1028 DDLL_2_ARRAY = -2 1029 RETURN 1030 END IF 1031 I = 1 1032 AUX => DLL%FRONT 1033 DO WHILE ( associated ( AUX ) ) 1034 ARRAY ( I ) = AUX%ELMT 1035 I = I + 1 1036 AUX => AUX%NEXT 1037 END DO 1038 DDLL_2_ARRAY = 0 1039 END FUNCTION DDLL_2_ARRAY 1040 END MODULE DDLL 1041