1C
2C  This file is part of MUMPS 5.1.2, released
3C  on Mon Oct  2 07:37:01 UTC 2017
4C
5C
6C  Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C  University of Bordeaux.
8C
9C  This version of MUMPS is provided to you free of charge. It is
10C  released under the CeCILL-C license:
11C  http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html
12C
13      SUBROUTINE CMUMPS_END_DRIVER( id )
14      USE CMUMPS_OOC
15      USE CMUMPS_STRUC_DEF
16      USE CMUMPS_BUF
17      IMPLICIT NONE
18      include 'mpif.h'
19      TYPE( CMUMPS_STRUC ) :: id
20      LOGICAL I_AM_SLAVE
21      INTEGER IERR
22      INTEGER MASTER
23      PARAMETER ( MASTER = 0 )
24C
25      I_AM_SLAVE = ( id%MYID .ne. MASTER .OR. id%KEEP(46) .NE. 0 )
26C     ----------------------------------
27C     Special stuff for implementations
28C     where MPI_CANCEL does not exist or
29C     is not correctly implemented.
30C     At the moment, this is only
31C     required for the slaves.
32C     ----------------------------------
33      IF (id%KEEP(201).GT.0 .AND. I_AM_SLAVE) THEN
34        CALL CMUMPS_CLEAN_OOC_DATA(id,IERR)
35        IF (IERR < 0) THEN
36          id%INFO(1) = -90
37          id%INFO(2) = 0
38        ENDIF
39      END IF
40      CALL MUMPS_PROPINFO(id%ICNTL(1), id%INFO(1),
41     &     id%COMM, id%MYID)
42      IF (id%root%gridinit_done) THEN
43        IF ( id%KEEP(38).NE.0 .and. id%root%yes ) THEN
44          CALL blacs_gridexit( id%root%CNTXT_BLACS )
45          id%root%gridinit_done = .FALSE.
46        END IF
47      END IF
48      IF ( id%MYID .NE. MASTER .OR. id%KEEP(46) .ne. 0 ) THEN
49C       Note that on some old platforms, COMM_NODES would have been
50C       freed inside BLACS_GRIDEXIT, which may cause problems
51C       in the call to MPI_COMM_FREE. (This was the case on the
52C       old SP2 in Bonn.)
53        CALL MPI_COMM_FREE( id%COMM_NODES, IERR )
54C       Free communicator related to load messages.
55        CALL MPI_COMM_FREE( id%COMM_LOAD, IERR )
56      END IF
57C     -----------------------------------
58C     Right-hand-side is always user data
59C     We do not free it.
60C     -----------------------------------
61      IF (associated(id%MEM_DIST))  THEN
62         DEALLOCATE(id%MEM_DIST)
63         NULLIFY(id%MEM_DIST)
64      ENDIF
65C
66C
67C
68C  ---------------------------------
69C  Allocated by CMUMPS, Used by user.
70C  CMUMPS deallocates. User should
71C  use them before CMUMPS_END_DRIVER or
72C  copy.
73C  ---------------------------------
74      IF (associated(id%MAPPING)) THEN
75        DEALLOCATE(id%MAPPING)
76        NULLIFY(id%MAPPING)
77      END IF
78      NULLIFY(id%SCHUR_CINTERFACE)
79C
80C     -------------------------------------
81C     Always deallocate scaling arrays
82C     if they are associated, except
83C     when provided by the user (on master)
84C     -------------------------------------
85      IF ( id%KEEP(52) .NE. -1 .or. id%MYID .ne. MASTER ) THEN
86        IF (associated(id%COLSCA)) THEN
87          DEALLOCATE(id%COLSCA)
88          NULLIFY(id%COLSCA)
89        ENDIF
90        IF (associated(id%ROWSCA)) THEN
91          DEALLOCATE(id%ROWSCA)
92          NULLIFY(id%ROWSCA)
93        ENDIF
94      END IF
95      IF (associated(id%PTLUST_S)) THEN
96        DEALLOCATE(id%PTLUST_S)
97        NULLIFY(id%PTLUST_S)
98      END IF
99      IF (associated(id%PTRFAC)) THEN
100        DEALLOCATE(id%PTRFAC)
101        NULLIFY(id%PTRFAC)
102      END IF
103      IF (associated(id%IS)) THEN
104        DEALLOCATE(id%IS)
105        NULLIFY(id%IS)
106      ENDIF
107      IF (associated(id%IS1)) THEN
108        DEALLOCATE(id%IS1)
109        NULLIFY(id%IS1)
110      ENDIF
111      IF (associated(id%STEP))      THEN
112        DEALLOCATE(id%STEP)
113        NULLIFY(id%STEP)
114      ENDIF
115C     Begin PRUN_NODES
116C     Info for pruning tree
117      IF (associated(id%Step2node))      THEN
118        DEALLOCATE(id%Step2node)
119        NULLIFY(id%Step2node)
120      ENDIF
121C     END PRUN_NODES
122c     ---------------------
123      IF (associated(id%NE_STEPS))  THEN
124        DEALLOCATE(id%NE_STEPS)
125        NULLIFY(id%NE_STEPS)
126      ENDIF
127      IF (associated(id%ND_STEPS))  THEN
128        DEALLOCATE(id%ND_STEPS)
129        NULLIFY(id%ND_STEPS)
130      ENDIF
131      IF (associated(id%FRERE_STEPS))  THEN
132        DEALLOCATE(id%FRERE_STEPS)
133        NULLIFY(id%FRERE_STEPS)
134      ENDIF
135      IF (associated(id%DAD_STEPS))  THEN
136        DEALLOCATE(id%DAD_STEPS)
137        NULLIFY(id%DAD_STEPS)
138      ENDIF
139      IF (associated(id%SYM_PERM))  THEN
140        DEALLOCATE(id%SYM_PERM)
141        NULLIFY(id%SYM_PERM)
142      ENDIF
143      IF (associated(id%UNS_PERM))  THEN
144        DEALLOCATE(id%UNS_PERM)
145        NULLIFY(id%UNS_PERM)
146      ENDIF
147      IF (associated(id%PIVNUL_LIST))  THEN
148        DEALLOCATE(id%PIVNUL_LIST)
149        NULLIFY(id%PIVNUL_LIST)
150      ENDIF
151      IF (associated(id%FILS))      THEN
152        DEALLOCATE(id%FILS)
153        NULLIFY(id%FILS)
154      ENDIF
155      IF (associated(id%PTRAR))     THEN
156        DEALLOCATE(id%PTRAR)
157        NULLIFY(id%PTRAR)
158      ENDIF
159      IF (associated(id%FRTPTR))    THEN
160        DEALLOCATE(id%FRTPTR)
161        NULLIFY(id%FRTPTR)
162      ENDIF
163      IF (associated(id%FRTELT))    THEN
164        DEALLOCATE(id%FRTELT)
165        NULLIFY(id%FRTELT)
166      ENDIF
167      IF (associated(id%NA))        THEN
168        DEALLOCATE(id%NA)
169        NULLIFY(id%NA)
170      ENDIF
171      IF (associated(id%PROCNODE_STEPS)) THEN
172        DEALLOCATE(id%PROCNODE_STEPS)
173        NULLIFY(id%PROCNODE_STEPS)
174      ENDIF
175      IF (associated(id%PROCNODE)) THEN
176        DEALLOCATE(id%PROCNODE)
177        NULLIFY(id%PROCNODE)
178      ENDIF
179      IF (associated(id%RHSCOMP)) THEN
180        DEALLOCATE(id%RHSCOMP)
181        NULLIFY(id%RHSCOMP)
182        id%KEEP8(25)=0_8
183      ENDIF
184      IF (associated(id%POSINRHSCOMP_ROW)) THEN
185        DEALLOCATE(id%POSINRHSCOMP_ROW)
186        NULLIFY(id%POSINRHSCOMP_ROW)
187      ENDIF
188      IF (id%POSINRHSCOMP_COL_ALLOC) THEN
189        DEALLOCATE(id%POSINRHSCOMP_COL)
190        NULLIFY(id%POSINRHSCOMP_COL)
191        id%POSINRHSCOMP_COL_ALLOC = .FALSE.
192      ENDIF
193C     ------------------------------------------------
194C     For hybrid host and element entry,
195C     and DBLARR have not been allocated
196C     on the master except if there was scaing.
197C     ------------------------------------------------
198      IF (id%KEEP(46).eq.1 .and.
199     &    id%KEEP(55).ne.0 .and.
200     &    id%MYID .eq. MASTER .and.
201     &    id%KEEP(52) .eq. 0 ) THEN
202        NULLIFY(id%DBLARR)
203      ELSE
204        IF (associated(id%DBLARR)) THEN
205          DEALLOCATE(id%DBLARR)
206          NULLIFY(id%DBLARR)
207        ENDIF
208      END IF
209      IF (associated(id%INTARR))       THEN
210        DEALLOCATE(id%INTARR)
211        NULLIFY(id%INTARR)
212      ENDIF
213      IF (associated(id%root%RG2L_ROW))THEN
214        DEALLOCATE(id%root%RG2L_ROW)
215        NULLIFY(id%root%RG2L_ROW)
216      ENDIF
217      IF (associated(id%root%RG2L_COL))THEN
218        DEALLOCATE(id%root%RG2L_COL)
219        NULLIFY(id%root%RG2L_COL)
220      ENDIF
221C     IPIV is used both for ScaLAPACK and RR
222C     Keep it outside CMUMPS_RR_FREE_POINTERS
223      IF (associated(id%root%IPIV))    THEN
224        DEALLOCATE(id%root%IPIV)
225        NULLIFY(id%root%IPIV)
226      ENDIF
227      IF (associated(id%root%RHS_CNTR_MASTER_ROOT)) THEN
228        DEALLOCATE(id%root%RHS_CNTR_MASTER_ROOT)
229        NULLIFY(id%root%RHS_CNTR_MASTER_ROOT)
230      ENDIF
231      IF (associated(id%root%RHS_ROOT))THEN
232        DEALLOCATE(id%root%RHS_ROOT)
233        NULLIFY(id%root%RHS_ROOT)
234      ENDIF
235      CALL CMUMPS_RR_FREE_POINTERS(id)
236      IF (associated(id%ELTPROC))     THEN
237        DEALLOCATE(id%ELTPROC)
238        NULLIFY(id%ELTPROC)
239      ENDIF
240C     id%CANDIDATES,id%I_AM_CAND and id%ISTEP_TO_INIV2
241C     can be allocated on non-working master
242C     in the case of arrowheads distribution
243      IF (associated(id%CANDIDATES)) THEN
244        DEALLOCATE(id%CANDIDATES)
245        NULLIFY(id%CANDIDATES)
246      ENDIF
247      IF (associated(id%I_AM_CAND)) THEN
248        DEALLOCATE(id%I_AM_CAND)
249        NULLIFY(id%I_AM_CAND)
250      ENDIF
251      IF (associated(id%ISTEP_TO_INIV2)) THEN
252        DEALLOCATE(id%ISTEP_TO_INIV2)
253        NULLIFY(id%ISTEP_TO_INIV2)
254      ENDIF
255C     Node partitionning (only allocated on slaves)
256      IF (I_AM_SLAVE) THEN
257       IF (associated(id%TAB_POS_IN_PERE)) THEN
258        DEALLOCATE(id%TAB_POS_IN_PERE)
259        NULLIFY(id%TAB_POS_IN_PERE)
260       ENDIF
261       IF (associated(id%FUTURE_NIV2)) THEN
262        DEALLOCATE(id%FUTURE_NIV2)
263        NULLIFY(id%FUTURE_NIV2)
264       ENDIF
265      ENDIF
266      IF(associated(id%DEPTH_FIRST))THEN
267        DEALLOCATE(id%DEPTH_FIRST)
268        NULLIFY(id%DEPTH_FIRST)
269      ENDIF
270      IF(associated(id%DEPTH_FIRST_SEQ))THEN
271        DEALLOCATE(id%DEPTH_FIRST_SEQ)
272        NULLIFY(id%DEPTH_FIRST_SEQ)
273      ENDIF
274      IF(associated(id%SBTR_ID))THEN
275        DEALLOCATE(id%SBTR_ID)
276        NULLIFY(id%SBTR_ID)
277      ENDIF
278      IF(associated(id%SCHED_DEP))THEN
279        DEALLOCATE(id%SCHED_DEP)
280        NULLIFY(id%SCHED_DEP)
281      ENDIF
282      IF(associated(id%SCHED_SBTR))THEN
283        DEALLOCATE(id%SCHED_SBTR)
284        NULLIFY(id%SCHED_SBTR)
285      ENDIF
286      IF(associated(id%SCHED_GRP))THEN
287        DEALLOCATE(id%SCHED_GRP)
288        NULLIFY(id%SCHED_GRP)
289      ENDIF
290      IF(associated(id%CROIX_MANU))THEN
291        DEALLOCATE(id%CROIX_MANU)
292        NULLIFY(id%CROIX_MANU)
293      ENDIF
294      IF (associated(id%MEM_SUBTREE)) THEN
295        DEALLOCATE(id%MEM_SUBTREE)
296        NULLIFY(id%MEM_SUBTREE)
297      ENDIF
298      IF (associated(id%MY_ROOT_SBTR)) THEN
299        DEALLOCATE(id%MY_ROOT_SBTR)
300        NULLIFY(id%MY_ROOT_SBTR)
301      ENDIF
302      IF (associated(id%MY_FIRST_LEAF)) THEN
303        DEALLOCATE(id%MY_FIRST_LEAF)
304        NULLIFY(id%MY_FIRST_LEAF)
305      ENDIF
306      IF (associated(id%MY_NB_LEAF)) THEN
307        DEALLOCATE(id%MY_NB_LEAF)
308        NULLIFY(id%MY_NB_LEAF)
309      ENDIF
310      IF (associated(id%COST_TRAV)) THEN
311        DEALLOCATE(id%COST_TRAV)
312        NULLIFY(id%COST_TRAV)
313      ENDIF
314      IF (associated(id%CB_SON_SIZE)) THEN
315        DEALLOCATE(id%CB_SON_SIZE)
316        NULLIFY(id%CB_SON_SIZE)
317      ENDIF
318      IF (associated(id%SUP_PROC)) THEN
319         DEALLOCATE(id%SUP_PROC)
320         NULLIFY(id%SUP_PROC)
321      ENDIF
322c     IF (id%KEEP(201).GT.0) THEN
323      IF(associated (id%OOC_INODE_SEQUENCE))THEN
324         DEALLOCATE(id%OOC_INODE_SEQUENCE)
325         NULLIFY(id%OOC_INODE_SEQUENCE)
326      ENDIF
327      IF(associated (id%OOC_TOTAL_NB_NODES))THEN
328         DEALLOCATE(id%OOC_TOTAL_NB_NODES)
329         NULLIFY(id%OOC_TOTAL_NB_NODES)
330      ENDIF
331      IF(associated (id%OOC_SIZE_OF_BLOCK))THEN
332         DEALLOCATE(id%OOC_SIZE_OF_BLOCK)
333         NULLIFY(id%OOC_SIZE_OF_BLOCK)
334      ENDIF
335      IF(associated (id%OOC_VADDR))THEN
336         DEALLOCATE(id%OOC_VADDR)
337         NULLIFY(id%OOC_VADDR)
338      ENDIF
339      IF(associated (id%OOC_NB_FILES))THEN
340         DEALLOCATE(id%OOC_NB_FILES)
341         NULLIFY(id%OOC_NB_FILES)
342      ENDIF
343c     ENDIF
344!     IF(id%KEEP(486).NE.0) THEN
345        IF (associated(id%LRGROUPS)) THEN
346           DEALLOCATE(id%LRGROUPS)
347           NULLIFY(id%LRGROUPS)
348        ENDIF
349!     ENDIF
350        IF (associated(id%SINGULAR_VALUES)) THEN
351           DEALLOCATE(id%SINGULAR_VALUES)
352           NULLIFY(id%SINGULAR_VALUES)
353        ENDIF
354C     ----------------------------------------------
355C     Deallocate S only after finishing the receives
356C     (S is normally the largest memory available)
357C     ----------------------------------------------
358      IF (id%KEEP8(24).EQ.0_8) THEN
359C       -- deallocate only when not provided/allocated by the user
360        IF (associated(id%S))        DEALLOCATE(id%S)
361      ENDIF
362      NULLIFY(id%S)
363      IF (I_AM_SLAVE) THEN
364C       ------------------------
365C       Deallocate buffer for
366C       contrib-blocks (facto/
367C       solve). Note that this
368C       will cancel all possible
369C       pending requests.
370C       ------------------------
371        CALL CMUMPS_BUF_DEALL_CB( IERR )
372C       Deallocate buffer for integers (facto/solve)
373        CALL CMUMPS_BUF_DEALL_SMALL_BUF( IERR )
374      END IF
375C     --------------
376C     Receive buffer
377C     --------------
378      IF ( associated( id%BUFR ) ) DEALLOCATE( id%BUFR )
379      NULLIFY( id%BUFR )
380C Mapping information used during solve
381      IF (associated(id%IPTR_WORKING)) THEN
382        DEALLOCATE(id%IPTR_WORKING)
383        NULLIFY(id%IPTR_WORKING)
384      END IF
385      IF (associated(id%WORKING)) THEN
386        DEALLOCATE(id%WORKING)
387        NULLIFY(id%WORKING)
388      END IF
389      IF (associated(id%IPOOL_AFTER_L0_OMP)) THEN
390        DEALLOCATE(id%IPOOL_AFTER_L0_OMP)
391        NULLIFY(id%IPOOL_AFTER_L0_OMP)
392      END IF
393      IF (associated(id%IPOOL_BEFORE_L0_OMP)) THEN
394        DEALLOCATE(id%IPOOL_BEFORE_L0_OMP)
395        NULLIFY(id%IPOOL_BEFORE_L0_OMP)
396      END IF
397      IF (associated(id%PHYS_L0_OMP)) THEN
398        DEALLOCATE(id%PHYS_L0_OMP)
399        NULLIFY(id%PHYS_L0_OMP)
400      END IF
401      IF (associated(id%VIRT_L0_OMP)) THEN
402        DEALLOCATE(id%VIRT_L0_OMP)
403        NULLIFY(id%VIRT_L0_OMP)
404      END IF
405      IF (associated(id%PERM_L0_OMP)) THEN
406        DEALLOCATE(id%PERM_L0_OMP)
407        NULLIFY(id%PERM_L0_OMP)
408      END IF
409      IF (associated(id%PTR_LEAFS_L0_OMP)) THEN
410        DEALLOCATE(id%PTR_LEAFS_L0_OMP)
411        NULLIFY(id%PTR_LEAFS_L0_OMP)
412      END IF
413      IF (associated(id%L0_OMP_MAPPING)) THEN
414        DEALLOCATE(id%L0_OMP_MAPPING)
415        NULLIFY(id%L0_OMP_MAPPING)
416      END IF
417      RETURN
418      END SUBROUTINE CMUMPS_END_DRIVER
419