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