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