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 MUMPS_ANA_ORD_WRAPPERS 14 IMPLICIT NONE 15 CONTAINS 16#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3) 17#if defined(metis4) || defined(parmetis3) 18 SUBROUTINE MUMPS_METIS_NODEWND_MIXEDto32( NCMP, IPE8, IW, FRERE, 19 & NUMFLAG, 20 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO, 21 & LP, LPOK ) 22 IMPLICIT NONE 23 INTEGER :: INFO(2), LOPTIONS_METIS 24 INTEGER :: NCMP, NUMFLAG, IKEEP1(*), IKEEP2(*), FRERE(*) 25 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS), IW(*) 26 INTEGER, INTENT(IN) :: LP 27 LOGICAL, INTENT(IN) :: LPOK 28 INTEGER(8) :: IPE8(*) 29 INTEGER,ALLOCATABLE, DIMENSION(:) :: IPE 30 INTEGER :: allocok 31 IF (IPE8(NCMP+1) .GE. int(huge(IW),8)) THEN 32 INFO(1) = -51 33 CALL MUMPS_SET_IERROR( 34 & IPE8(NCMP+1), INFO(2)) 35 RETURN 36 ENDIF 37 ALLOCATE(IPE(NCMP+1), stat=allocok) 38 IF (allocok > 0) THEN 39 INFO(1)=-7 40 INFO(2)=NCMP+1 41 IF (LPOK) WRITE(LP,'(A)') 42 & "ERROR memory allocation in METIS_NODEWND_MIXEDto32" 43 RETURN 44 ENDIF 45 CALL MUMPS_COPY_INT_64TO32(IPE8, NCMP+1, IPE) 46 CALL METIS_NODEWND(NCMP, IPE, IW,FRERE, 47 & NUMFLAG, OPTIONS_METIS, 48 & IKEEP2, IKEEP1 ) 49 CALL MUMPS_COPY_INT_32TO64(IPE, NCMP+1, IPE8) 50 RETURN 51 END SUBROUTINE MUMPS_METIS_NODEWND_MIXEDto32 52 SUBROUTINE MUMPS_METIS_NODEND_MIXEDto32( NCMP, IPE8, IW, NUMFLAG, 53 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO, 54 & LP, LPOK) 55 IMPLICIT NONE 56 INTEGER :: INFO(2), LOPTIONS_METIS 57 INTEGER :: NCMP, NUMFLAG, IKEEP1(*), IKEEP2(*), IW(*) 58 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS) 59 INTEGER(8) :: IPE8(*) 60 INTEGER, INTENT(IN) :: LP 61 LOGICAL, INTENT(IN) :: LPOK 62 INTEGER,ALLOCATABLE, DIMENSION(:) :: IPE 63 INTEGER :: allocok 64 IF (IPE8(NCMP+1) .GE. int(huge(IW),8)) THEN 65 INFO(1) = -51 66 CALL MUMPS_SET_IERROR( 67 & IPE8(NCMP+1), INFO(2)) 68 RETURN 69 ENDIF 70 ALLOCATE(IPE(NCMP+1), stat=allocok) 71 IF (allocok > 0) THEN 72 INFO(1)=-7 73 INFO(2)=NCMP+1 74 IF (LPOK) WRITE(LP,'(A)') 75 & "ERROR memory allocation in METIS_NODEND_MIXEDto32" 76 RETURN 77 ENDIF 78 CALL MUMPS_COPY_INT_64TO32(IPE8, NCMP+1, IPE) 79 CALL METIS_NODEND(NCMP, IPE, IW, 80 & NUMFLAG, OPTIONS_METIS, 81 & IKEEP2, IKEEP1 ) 82 CALL MUMPS_COPY_INT_32TO64(IPE, NCMP+1, IPE8) 83 DEALLOCATE(IPE) 84 RETURN 85 END SUBROUTINE MUMPS_METIS_NODEND_MIXEDto32 86#else 87 SUBROUTINE MUMPS_METIS_NODEND_MIXEDto32( NCMP, IPE8, IW, FRERE, 88 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO, 89 & LP, LPOK ) 90 IMPLICIT NONE 91 INTEGER :: INFO(2), LOPTIONS_METIS 92 INTEGER :: NCMP, IKEEP1(*), IKEEP2(*), FRERE(*), IW(*) 93 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS) 94 INTEGER(8) :: IPE8(*) 95 INTEGER, INTENT(IN) :: LP 96 LOGICAL, INTENT(IN) :: LPOK 97 INTEGER,ALLOCATABLE, DIMENSION(:) :: IPE 98 INTEGER :: allocok 99 IF (IPE8(NCMP+1) .GE. int(huge(IW),8)) THEN 100 INFO(1) = -51 101 CALL MUMPS_SET_IERROR( 102 & IPE8(NCMP+1), INFO(2)) 103 RETURN 104 ENDIF 105 ALLOCATE(IPE(NCMP+1), stat=allocok) 106 IF (allocok > 0) THEN 107 INFO(1)=-7 108 INFO(2)=NCMP+1 109 IF (LPOK) WRITE(LP,'(A)') 110 & "ERROR memory allocation in METIS_NODEND_MIXEDto32" 111 RETURN 112 ENDIF 113 CALL MUMPS_COPY_INT_64TO32(IPE8, NCMP+1, IPE) 114 CALL METIS_NODEND( NCMP, IPE, IW, FRERE, 115 & OPTIONS_METIS, IKEEP2, IKEEP1) 116 CALL MUMPS_COPY_INT_32TO64(IPE, NCMP+1, IPE8) 117 DEALLOCATE(IPE) 118 RETURN 119 END SUBROUTINE MUMPS_METIS_NODEND_MIXEDto32 120#endif 121#endif 122#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3) 123#if defined(metis4) || defined(parmetis3) 124 SUBROUTINE MUMPS_METIS_NODEWND_MIXEDto64( NCMP, IPE8, IW, FRERE, 125 & NUMFLAG, 126 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO, 127 & LP, LPOK, KEEP10 ) 128 IMPLICIT NONE 129 INTEGER :: INFO(2), LOPTIONS_METIS 130 INTEGER :: NCMP, NUMFLAG, IKEEP1(*), IKEEP2(*), FRERE(*) 131 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS), IW(*) 132 INTEGER(8) :: IPE8(*) 133 INTEGER, INTENT(IN) :: LP, KEEP10 134 LOGICAL, INTENT(IN) :: LPOK 135 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: IW8, FRERE8, 136 & IKEEP18, IKEEP28 137 INTEGER :: allocok 138 IF (KEEP10.EQ.1) THEN 139 CALL METIS_NODEWND(NCMP, IPE8, IW ,FRERE, 140 & NUMFLAG, OPTIONS_METIS, 141 & IKEEP2, IKEEP1 ) 142 ELSE 143 ALLOCATE(IW8(IPE8(NCMP+1)-1_8), FRERE8(NCMP), 144 & IKEEP18(NCMP), IKEEP28(NCMP), stat=allocok) 145 IF (allocok > 0) THEN 146 INFO(1)=-7 147 CALL MUMPS_SET_IERROR( 148 & int(KEEP10,8)* ( 149 & IPE8(NCMP+1)-1_8+3_8*int(NCMP,8) 150 & ) 151 & , INFO(2) 152 & ) 153 IF (LPOK) WRITE(LP,'(A)') 154 & "ERROR memory allocation in METIS_NODEWND_MIXEDto64" 155 RETURN 156 ENDIF 157 CALL MUMPS_COPY_INT_32TO64_64C(IW , IPE8(NCMP+1)-1_8, IW8 ) 158 CALL MUMPS_COPY_INT_32TO64 (FRERE, NCMP , FRERE8) 159 CALL METIS_NODEWND(NCMP, IPE8, IW8,FRERE8, 160 & NUMFLAG, OPTIONS_METIS, 161 & IKEEP2, IKEEP1 ) 162 CALL MUMPS_COPY_INT_64TO32(IKEEP18, NCMP, IKEEP1) 163 CALL MUMPS_COPY_INT_64TO32(IKEEP28, NCMP, IKEEP2) 164 DEALLOCATE(IW8, FRERE8, IKEEP18, IKEEP28) 165 ENDIF 166 RETURN 167 END SUBROUTINE MUMPS_METIS_NODEWND_MIXEDto64 168 SUBROUTINE MUMPS_METIS_NODEND_MIXEDto64( NCMP, IPE8, IW, NUMFLAG, 169 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO, 170 & LP, LPOK, KEEP10 ) 171 IMPLICIT NONE 172 INTEGER :: INFO(2), LOPTIONS_METIS 173 INTEGER :: NCMP, NUMFLAG, IKEEP1(*), IKEEP2(*), IW(*) 174 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS) 175 INTEGER(8) :: IPE8(*) 176 INTEGER, INTENT(IN) :: LP, KEEP10 177 LOGICAL, INTENT(IN) :: LPOK 178 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: IW8, 179 & IKEEP18, IKEEP28 180 INTEGER :: allocok 181 IF (KEEP10.EQ.1) THEN 182 CALL METIS_NODEND(NCMP, IPE8, IW, 183 & NUMFLAG, OPTIONS_METIS, 184 & IKEEP2, IKEEP1 ) 185 ELSE 186 ALLOCATE(IW8(IPE8(NCMP+1)-1_8), 187 & IKEEP18(NCMP), IKEEP28(NCMP), stat=allocok) 188 IF (allocok > 0) THEN 189 INFO(1)=-7 190 CALL MUMPS_SET_IERROR( int(KEEP10,8)* 191 & ( IPE8(NCMP+1)-1_8+2_8*int(NCMP,8) ) 192 & , INFO(2) ) 193 IF (LPOK) WRITE(LP,'(A)') 194 & "ERROR memory allocation in METIS_METIS_NODEND_MIXEDto64" 195 RETURN 196 ENDIF 197 CALL MUMPS_COPY_INT_32TO64_64C(IW , IPE8(NCMP+1)-1_8, IW8 ) 198 CALL METIS_NODEND(NCMP, IPE8, IW8, 199 & NUMFLAG, OPTIONS_METIS, 200 & IKEEP28, IKEEP18 ) 201 CALL MUMPS_COPY_INT_64TO32(IKEEP18, NCMP, IKEEP1) 202 CALL MUMPS_COPY_INT_64TO32(IKEEP28, NCMP, IKEEP2) 203 DEALLOCATE(IW8, IKEEP18, IKEEP28) 204 ENDIF 205 RETURN 206 END SUBROUTINE MUMPS_METIS_NODEND_MIXEDto64 207#else 208 SUBROUTINE MUMPS_METIS_NODEND_MIXEDto64( NCMP, IPE8, IW, FRERE, 209 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO, 210 & LP, LPOK, KEEP10 ) 211 IMPLICIT NONE 212 INTEGER :: INFO(2) 213 INTEGER :: LOPTIONS_METIS 214 INTEGER :: NCMP, IKEEP1(*), IKEEP2(*), FRERE(*), IW(*) 215 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS) 216 INTEGER(8) :: IPE8(*) 217 INTEGER, INTENT(IN) :: LP, KEEP10 218 LOGICAL, INTENT(IN) :: LPOK 219 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: IW8, FRERE8, 220 & IKEEP18, IKEEP28, 221 & OPTIONS_METIS8 222 INTEGER :: allocok 223 IF (KEEP10.EQ.1) THEN 224 CALL METIS_NODEND( NCMP, IPE8, IW, FRERE, 225 & OPTIONS_METIS, IKEEP2, IKEEP1 ) 226 ELSE 227 ALLOCATE(IW8(IPE8(NCMP+1)-1_8), FRERE8(NCMP), 228 & IKEEP18(NCMP), IKEEP28(NCMP), 229 & OPTIONS_METIS8(LOPTIONS_METIS), stat=allocok) 230 IF (allocok > 0) THEN 231 INFO(1)=-7 232 CALL MUMPS_SET_IERROR( 233 & int(KEEP10,8)* ( 234 & IPE8(NCMP+1)-1_8+3_8*int(NCMP,8)+int(LOPTIONS_METIS,8) 235 & ) 236 & , INFO(2)) 237 IF (LPOK) WRITE(LP,'(A)') 238 & "ERROR memory allocation in METIS_NODEND_MIXEDto64" 239 RETURN 240 ENDIF 241 CALL MUMPS_COPY_INT_32TO64_64C(IW , IPE8(NCMP+1)-1_8, IW8 ) 242 CALL MUMPS_COPY_INT_32TO64 (FRERE, NCMP , FRERE8) 243 CALL MUMPS_COPY_INT_32TO64 (OPTIONS_METIS, LOPTIONS_METIS, 244 & OPTIONS_METIS8) 245 CALL METIS_NODEND( int(NCMP,8), IPE8, IW8, FRERE8, 246 & OPTIONS_METIS8, IKEEP28, IKEEP18 ) 247 CALL MUMPS_COPY_INT_64TO32(IKEEP18, NCMP, IKEEP1) 248 CALL MUMPS_COPY_INT_64TO32(IKEEP28, NCMP, IKEEP2) 249 DEALLOCATE(IW8, FRERE8, IKEEP18, IKEEP28) 250 ENDIF 251 RETURN 252 END SUBROUTINE MUMPS_METIS_NODEND_MIXEDto64 253#endif 254#endif 255#if defined(scotch) || defined(ptscotch) 256 SUBROUTINE MUMPS_SCOTCH_MIXEDto32(NCMP, LIW8, IPE8, PARENT, IWFR8, 257 & PTRAR, IW, IWL1, IKEEP1, 258 & IKEEP2, NCMPA, INFO, LP, LPOK) 259 IMPLICIT NONE 260 INTEGER, INTENT(IN) :: NCMP 261 INTEGER(8), INTENT(IN) :: LIW8 262 INTEGER, INTENT(OUT) :: NCMPA 263 INTEGER(8), INTENT(INOUT) :: IPE8(NCMP+1) 264 INTEGER, INTENT(OUT) :: PARENT(NCMP) 265 INTEGER(8), INTENT(IN) :: IWFR8 266 INTEGER :: PTRAR(NCMP) 267 INTEGER :: IW(LIW8) 268 INTEGER :: IWL1(NCMP) 269 INTEGER, INTENT(OUT) :: IKEEP1(NCMP) 270 INTEGER, INTENT(OUT) :: IKEEP2(NCMP) 271 INTEGER, INTENT(INOUT) :: INFO(2) 272 INTEGER, INTENT(IN) :: LP 273 LOGICAL, INTENT(IN) :: LPOK 274 INTEGER, DIMENSION(:), ALLOCATABLE :: IPE 275 INTEGER :: allocok 276 IF (IWFR8 .GE. int(huge(IW),8)) THEN 277 INFO(1) = -51 278 CALL MUMPS_SET_IERROR(IPE8(NCMP+1), INFO(2)) 279 RETURN 280 ENDIF 281 ALLOCATE(IPE(NCMP+1), stat=allocok) 282 IF (allocok > 0) THEN 283 IF (LPOK) WRITE(LP,'(A)') 284 & "ERROR memory allocation in MUMPS_SCOTCH_MIXEDto32" 285 INFO(1) = -7 286 INFO(2) = NCMP+1 287 RETURN 288 ENDIF 289 CALL MUMPS_COPY_INT_64TO32(IPE8,NCMP+1,IPE) 290 CALL MUMPS_SCOTCH( NCMP, int(LIW8), IPE, int(IWFR8), 291 & PTRAR, IW, IWL1, IKEEP1, 292 & IKEEP2, NCMPA ) 293 PARENT(1:NCMP)=IPE(1:NCMP) 294 DEALLOCATE(IPE) 295 RETURN 296 END SUBROUTINE MUMPS_SCOTCH_MIXEDto32 297 SUBROUTINE MUMPS_SCOTCH_MIXEDto64( 298 & NCMP, LIW8, IPE8, PARENT, IWFR8, 299 & PTRAR, IW, IWL1, IKEEP1, 300 & IKEEP2, NCMPA, INFO, LP, LPOK, KEEP10) 301 IMPLICIT NONE 302 INTEGER, INTENT(IN) :: NCMP 303 INTEGER(8), INTENT(IN) :: LIW8 304 INTEGER, INTENT(OUT) :: NCMPA 305 INTEGER(8), INTENT(INOUT) :: IPE8(NCMP+1) 306 INTEGER, INTENT(OUT) :: PARENT(NCMP) 307 INTEGER(8), INTENT(IN) :: IWFR8 308 INTEGER :: PTRAR(NCMP) 309 INTEGER :: IW(LIW8) 310 INTEGER :: IWL1(NCMP) 311 INTEGER, INTENT(OUT) :: IKEEP1(NCMP) 312 INTEGER, INTENT(OUT) :: IKEEP2(NCMP) 313 INTEGER, INTENT(INOUT) :: INFO(2) 314 INTEGER, INTENT(IN) :: LP 315 LOGICAL, INTENT(IN) :: LPOK 316 INTEGER, INTENT(IN) :: KEEP10 317 INTEGER(8), DIMENSION(:), ALLOCATABLE :: 318 & PTRAR8, IW8, IWL18, IKEEP18, 319 & IKEEP28 320 INTEGER :: allocok 321 IF (KEEP10.EQ.1) THEN 322 CALL MUMPS_SCOTCH_64( NCMP, LIW8, 323 & IPE8, 324 & IWFR8, 325 & PTRAR, IW, IWL1, IKEEP1, 326 & IKEEP2, NCMPA ) 327 PARENT(1:NCMP) = int(IPE8(1:NCMP)) 328 ELSE 329 ALLOCATE( IW8(LIW8), 330 & PTRAR8(NCMP), IWL18(NCMP), IKEEP18(NCMP), IKEEP28(NCMP), 331 & stat=allocok ) 332 IF (allocok > 0) THEN 333 IF (LPOK) WRITE(LP,*) 334 & "ERROR memory allocation in MUMPS_SCOTCH_MIXEDto64" 335 INFO(1) = -7 336 CALL MUMPS_SET_IERROR( int(KEEP10,8) * 337 & ( int(NCMP,8)*4_8+LIW8 ) 338 & , INFO(2) ) 339 RETURN 340 ENDIF 341 CALL MUMPS_COPY_INT_32TO64_64C(IW,LIW8,IW8) 342 CALL MUMPS_COPY_INT_32TO64(PTRAR,NCMP,PTRAR8) 343 CALL MUMPS_SCOTCH_64( int(NCMP,8), LIW8, 344 & IPE8, 345 & IWFR8, 346 & PTRAR8, IW8, IWL18, IKEEP1, 347 & IKEEP2, NCMPA ) 348 IF (NCMPA .LT. 0) THEN 349 IF (LPOK) WRITE(LP,*) 350 & ' Error on output from SCOTCH, NCMPA=', NCMPA 351 INFO( 1 ) = -9999 352 INFO( 2 ) = 3 353 GOTO 500 354 ENDIF 355 CALL MUMPS_COPY_INT_64TO32(IWL18,NCMP,IWL1) 356 CALL MUMPS_COPY_INT_64TO32(IKEEP18,NCMP,IKEEP1) 357 CALL MUMPS_COPY_INT_64TO32(IKEEP28,NCMP,IKEEP2) 358 CALL MUMPS_COPY_INT_64TO32(IPE8,NCMP,PARENT) 359 500 CONTINUE 360 DEALLOCATE(IW8, PTRAR8, IWL18, IKEEP18, IKEEP28) 361 ENDIF 362 RETURN 363 END SUBROUTINE MUMPS_SCOTCH_MIXEDto64 364#endif 365#if defined (scotch) || defined (ptscotch) 366 SUBROUTINE MUMPS_SCOTCH_KWAY_MIXEDto32(NHALO, HALOEDGENBR, 367 & IPTRHALO, JCNHALO, 368 & NBGROUPS, PARTS, LP, LPOK, KEEP10, 369 & IFLAG, IERROR) 370 IMPLICIT NONE 371 include 'scotchf.h' 372 INTEGER(8) :: HALOEDGENBR 373 INTEGER :: NHALO, NBGROUPS 374 INTEGER :: JCNHALO(HALOEDGENBR), PARTS(NHALO) 375 INTEGER(8) :: IPTRHALO(NHALO+1) 376 INTEGER, INTENT(IN) :: LP, KEEP10 377 LOGICAL, INTENT(IN) :: LPOK 378 INTEGER, INTENT(INOUT) :: IFLAG, IERROR 379 DOUBLE PRECISION :: GRAFDAT(SCOTCH_GRAPHDIM) 380 DOUBLE PRECISION :: STRADAT(SCOTCH_STRATDIM) 381 INTEGER :: BASEVAL, IERR, EDGENBR 382 INTEGER, ALLOCATABLE :: IPTRHALO_I4(:) 383 INTEGER :: allocok 384 IF (IPTRHALO(size(IPTRHALO)) .GE. int(huge(LP),8)) THEN 385 IFLAG = -51 386 CALL MUMPS_SET_IERROR( IPTRHALO (size(IPTRHALO)), 387 & IERROR ) 388 RETURN 389 ENDIF 390 ALLOCATE(IPTRHALO_I4(size(IPTRHALO)), stat=allocok) 391 IF (allocok > 0) THEN 392 IFLAG = -7 393 IERROR = size(IPTRHALO) 394 IF (LPOK) WRITE(LP,'(A)') 395 & "ERROR memory allocation in MUMPS_SCOTCH_KWAY_MIXEDto32" 396 RETURN 397 END IF 398 CALL MUMPS_COPY_INT_64TO32(IPTRHALO, 399 & size(IPTRHALO), IPTRHALO_I4) 400 BASEVAL = 1 401 EDGENBR = IPTRHALO_I4(NHALO+1) 402 CALL SCOTCHFGRAPHBUILD(GRAFDAT(1), BASEVAL, NHALO, 403 & IPTRHALO_I4(1), IPTRHALO_I4(2), IPTRHALO_I4(1), 404 & IPTRHALO_I4(1), EDGENBR, JCNHALO(1), JCNHALO(1), IERR) 405 CALL SCOTCHFSTRATINIT(STRADAT, IERR) 406 CALL SCOTCHFGRAPHPART(GRAFDAT(1), NBGROUPS, STRADAT(1), 407 & PARTS(1), IERR) 408 CALL SCOTCHFSTRATEXIT(STRADAT) 409 CALL SCOTCHFGRAPHEXIT(GRAFDAT) 410 PARTS(1:NHALO) = PARTS(1:NHALO)+1 411 DEALLOCATE(IPTRHALO_I4) 412 RETURN 413 END SUBROUTINE MUMPS_SCOTCH_KWAY_MIXEDto32 414 SUBROUTINE MUMPS_SCOTCH_KWAY_MIXEDto64(NHALO, HALOEDGENBR, 415 & IPTRHALO, JCNHALO, 416 & NBGROUPS, PARTS, LP, LPOK, KEEP10, 417 & IFLAG, IERROR) 418 IMPLICIT NONE 419 include 'scotchf.h' 420 INTEGER(8) :: HALOEDGENBR 421 INTEGER :: NHALO, NBGROUPS 422 INTEGER :: JCNHALO(HALOEDGENBR), PARTS(NHALO) 423 INTEGER(8) :: IPTRHALO(NHALO+1) 424 INTEGER, INTENT(IN) :: LP, KEEP10 425 LOGICAL, INTENT(IN) :: LPOK 426 INTEGER, INTENT(INOUT) :: IFLAG, IERROR 427 DOUBLE PRECISION :: GRAFDAT(SCOTCH_GRAPHDIM) 428 DOUBLE PRECISION :: STRADAT(SCOTCH_STRATDIM) 429 INTEGER :: IERR 430 INTEGER(8), ALLOCATABLE :: JCNHALO_I8(:), PARTS_I8(:) 431 INTEGER(8) :: NHALO_I8, NBGROUPS_I8, EDGENBR_I8, 432 & BASEVAL_I8 433 INTEGER :: allocok 434 ALLOCATE(JCNHALO_I8(IPTRHALO(NHALO+1)-1_8), 435 & PARTS_I8(size(PARTS)), stat=allocok) 436 IF (allocok > 0) THEN 437 IFLAG =-7 438 CALL MUMPS_SET_IERROR( 439 & int(KEEP10,8)* (IPTRHALO(NHALO+1)-1_8 440 & +int(size(PARTS),8)), 441 & IERROR) 442 IF (LPOK) WRITE(LP,'(A)') 443 & "ERROR memory allocation in MUMPS_SCOTCH_KWAY_MIXEDto64 " 444 ENDIF 445 CALL MUMPS_COPY_INT_32TO64_64C(JCNHALO, 446 & IPTRHALO(NHALO+1)-1, JCNHALO_I8) 447 NHALO_I8 = int(NHALO,8) 448 NBGROUPS_I8 = int(NBGROUPS,8) 449 BASEVAL_I8 = 1_8 450 EDGENBR_I8 = IPTRHALO(NHALO+1) 451 CALL SCOTCHFGRAPHBUILD(GRAFDAT(1), BASEVAL_I8, NHALO_I8, 452 & IPTRHALO(1), IPTRHALO(2), IPTRHALO(1), 453 & IPTRHALO(1), EDGENBR_I8, JCNHALO_I8(1), JCNHALO_I8(1), IERR) 454 CALL SCOTCHFSTRATINIT(STRADAT, IERR) 455 CALL SCOTCHFGRAPHPART(GRAFDAT(1), NBGROUPS_I8, STRADAT(1), 456 & PARTS_I8(1), IERR) 457 CALL SCOTCHFSTRATEXIT(STRADAT) 458 CALL SCOTCHFGRAPHEXIT(GRAFDAT) 459 CALL MUMPS_COPY_INT_64TO32(PARTS_I8, 460 & size(PARTS), PARTS) 461 DEALLOCATE(JCNHALO_I8, PARTS_I8) 462 PARTS(1:NHALO) = PARTS(1:NHALO)+1 463 RETURN 464 END SUBROUTINE MUMPS_SCOTCH_KWAY_MIXEDto64 465#endif 466#if defined (metis) || defined (parmetis) || defined (metis4) || defined (parmetis3) 467 SUBROUTINE MUMPS_METIS_KWAY_MIXEDto32(NHALO, HALOEDGENBR, 468 & IPTRHALO, 469 & JCNHALO, NBGROUPS, PARTS, LP, LPOK, KEEP10, 470 & IFLAG, IERROR) 471 IMPLICIT NONE 472 INTEGER(8) :: HALOEDGENBR 473 INTEGER :: NHALO, NBGROUPS 474 INTEGER :: JCNHALO(HALOEDGENBR), PARTS(NHALO) 475 INTEGER(8) :: IPTRHALO(NHALO+1) 476 INTEGER, INTENT(IN) :: LP, KEEP10 477 LOGICAL, INTENT(IN) :: LPOK 478 INTEGER, INTENT(INOUT) :: IFLAG, IERROR 479 INTEGER, ALLOCATABLE :: IPTRHALO_I4(:) 480 INTEGER :: allocok 481 IF (IPTRHALO(size(IPTRHALO)) .GE. int(huge(LP),8)) THEN 482 IFLAG = -51 483 CALL MUMPS_SET_IERROR( IPTRHALO (size(IPTRHALO)), 484 & IERROR) 485 RETURN 486 ENDIF 487 ALLOCATE(IPTRHALO_I4(size(IPTRHALO)), stat=allocok) 488 IF (allocok > 0) THEN 489 IFLAG = -7 490 IERROR = size(IPTRHALO) 491 IF (LPOK) WRITE(LP,'(A)') 492 & "ERROR memory allocation in MUMPS_METIS_KWAY_MIXEDto32" 493 RETURN 494 END IF 495 CALL MUMPS_COPY_INT_64TO32(IPTRHALO, 496 & size(IPTRHALO), IPTRHALO_I4) 497 CALL MUMPS_METIS_KWAY(NHALO, IPTRHALO_I4(1), 498 & JCNHALO(1), NBGROUPS, PARTS(1)) 499 DEALLOCATE(IPTRHALO_I4) 500 RETURN 501 END SUBROUTINE MUMPS_METIS_KWAY_MIXEDto32 502 SUBROUTINE MUMPS_METIS_KWAY_MIXEDto64(NHALO, HALOEDGENBR, 503 & IPTRHALO, 504 & JCNHALO, NBGROUPS, PARTS, LP, LPOK, KEEP10, 505 & IFLAG, IERROR) 506 IMPLICIT NONE 507 INTEGER(8) :: HALOEDGENBR 508 INTEGER :: NHALO, NBGROUPS 509 INTEGER :: JCNHALO(HALOEDGENBR), PARTS(NHALO) 510 INTEGER(8) :: IPTRHALO(NHALO+1) 511 INTEGER, INTENT(IN) :: LP, KEEP10 512 LOGICAL, INTENT(IN) :: LPOK 513 INTEGER, INTENT(INOUT) :: IFLAG, IERROR 514 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: JCNHALO_I8, PARTS_I8 515 INTEGER(8) :: NHALO_I8, NBGROUPS_I8 516 INTEGER :: allocok 517 ALLOCATE(JCNHALO_I8(IPTRHALO(NHALO+1)-1_8), 518 & PARTS_I8(size(PARTS)), stat=allocok) 519 IF (allocok > 0) THEN 520 IFLAG = -7 521 CALL MUMPS_SET_IERROR( 522 & int(KEEP10,8)* (IPTRHALO(NHALO+1)-1_8+int(size(PARTS),8)), 523 & IERROR) 524 IF (LPOK) WRITE(LP,'(A)') 525 & "ERROR memory allocation in MUMPS_METIS_KWAY_MIXEDto64 " 526 ENDIF 527 CALL MUMPS_COPY_INT_32TO64_64C(JCNHALO, 528 & IPTRHALO(NHALO+1)-1, JCNHALO_I8) 529 NHALO_I8 = int(NHALO,8) 530 NBGROUPS_I8 = int(NBGROUPS,8) 531 CALL MUMPS_METIS_KWAY_64(NHALO_I8, IPTRHALO(1), 532 & JCNHALO_I8(1), NBGROUPS_I8, PARTS_I8(1)) 533 CALL MUMPS_COPY_INT_64TO32(PARTS_I8, 534 & size(PARTS), PARTS) 535 DEALLOCATE(JCNHALO_I8, PARTS_I8) 536 RETURN 537 END SUBROUTINE MUMPS_METIS_KWAY_MIXEDto64 538#endif 539#if defined(pord) 540 SUBROUTINE MUMPS_PORDF_MIXEDto32( NVTX, NEDGES8, XADJ8, IW, 541 & NV, NCMPA, PARENT, 542 & INFO, LP, LPOK, KEEP10 ) 543 IMPLICIT NONE 544 INTEGER, INTENT(IN) :: LP 545 LOGICAL, INTENT(IN) :: LPOK 546 INTEGER, INTENT(INOUT) :: INFO(2) 547 INTEGER, INTENT(IN) :: NVTX 548 INTEGER, INTENT(OUT) :: NCMPA 549 INTEGER(8), INTENT(IN) :: NEDGES8 550 INTEGER(8) :: XADJ8(NVTX+1) 551 INTEGER, INTENT(OUT) :: NV(NVTX) 552 INTEGER :: IW(NEDGES8) 553 INTEGER, INTENT(OUT) :: PARENT(NVTX) 554 INTEGER, INTENT(IN) :: KEEP10 555 INTEGER, DIMENSION(:), ALLOCATABLE :: XADJ 556 INTEGER :: I, allocok 557 IF (NEDGES8.GT. int(huge(IW),8)) THEN 558 INFO(1) = -51 559 CALL MUMPS_SET_IERROR(NEDGES8,INFO(2)) 560 RETURN 561 ENDIF 562 ALLOCATE(XADJ(NVTX+1), stat=allocok) 563 IF (allocok > 0) THEN 564 INFO(1)=-7 565 INFO(2)=NVTX+1 566 IF (LPOK) WRITE(LP,'(A)') 567 & "ERROR memory allocation in MUMPS_PORD_MIXEDto32" 568 RETURN 569 ENDIF 570 CALL MUMPS_COPY_INT_64TO32(XADJ8, NVTX+1, XADJ) 571 CALL MUMPS_PORDF( NVTX, int(NEDGES8), XADJ, IW, 572 & NV, NCMPA ) 573 DO I= 1, NVTX 574 PARENT(I) = XADJ(I) 575 ENDDO 576 DEALLOCATE(XADJ) 577 RETURN 578 END SUBROUTINE MUMPS_PORDF_MIXEDto32 579 SUBROUTINE MUMPS_PORDF_MIXEDto64( NVTX, NEDGES8, XADJ8, IW, 580 & NV, NCMPA, PARENT, 581 & INFO, LP, LPOK, KEEP10 ) 582 IMPLICIT NONE 583 INTEGER, INTENT(IN) :: LP 584 LOGICAL, INTENT(IN) :: LPOK 585 INTEGER, INTENT(INOUT) :: INFO(2) 586 INTEGER, INTENT(IN) :: NVTX 587 INTEGER, INTENT(OUT) :: NCMPA 588 INTEGER(8), INTENT(IN) :: NEDGES8 589 INTEGER(8) :: XADJ8(NVTX+1) 590 INTEGER, INTENT(OUT) :: NV(NVTX) 591 INTEGER, INTENT(IN) :: IW(NEDGES8) 592 INTEGER, INTENT(OUT) :: PARENT(NVTX) 593 INTEGER, INTENT(IN) :: KEEP10 594 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IW8, NV8 595 INTEGER :: I, allocok 596 IF (KEEP10.EQ.1) THEN 597 CALL MUMPS_PORDF( int(NVTX,8), NEDGES8, XADJ8, IW, 598 & NV, NCMPA ) 599 DO I=1, NVTX 600 PARENT(I)=int(XADJ8(I)) 601 ENDDO 602 ELSE 603 ALLOCATE(IW8(NEDGES8), NV8(NVTX), stat=allocok) 604 IF (allocok > 0) THEN 605 INFO(1)=-7 606 CALL MUMPS_SET_IERROR(NEDGES8+int(NVTX,8),INFO(2)) 607 IF (LPOK) WRITE(LP,'(A)') 608 & "ERROR memory allocation in MUMPS_PORD_MIXEDto64" 609 RETURN 610 ENDIF 611 CALL MUMPS_COPY_INT_32TO64_64C(IW, NEDGES8, IW8) 612 CALL MUMPS_PORDF( int(NVTX,8), NEDGES8, XADJ8, IW8, 613 & NV8, NCMPA ) 614 DO I= 1, NVTX 615 PARENT(I) = int(XADJ8(I)) 616 ENDDO 617 DO I= 1, NVTX 618 NV(I) = int(NV8(I)) 619 ENDDO 620 DEALLOCATE(IW8,NV8) 621 ENDIF 622 RETURN 623 END SUBROUTINE MUMPS_PORDF_MIXEDto64 624 SUBROUTINE MUMPS_PORDF_WND_MIXEDto32( NVTX, NEDGES8, 625 & XADJ8, IW, 626 & NV, NCMPA, N, PARENT, 627 & INFO, LP, LPOK, KEEP10 ) 628 IMPLICIT NONE 629 INTEGER, INTENT(IN) :: LP 630 LOGICAL, INTENT(IN) :: LPOK 631 INTEGER, INTENT(INOUT) :: INFO(2) 632 INTEGER, INTENT(IN) :: NVTX, N 633 INTEGER, INTENT(OUT) :: NCMPA 634 INTEGER, INTENT(INOUT) :: NV(N) 635 INTEGER(8) :: XADJ8(N+1) 636 INTEGER(8), INTENT(IN) :: NEDGES8 637 INTEGER :: IW(NEDGES8) 638 INTEGER, INTENT(OUT) :: PARENT(NVTX) 639 INTEGER, INTENT(IN) :: KEEP10 640 INTEGER, DIMENSION(:), ALLOCATABLE :: XADJ 641 INTEGER :: I, allocok 642 IF (NEDGES8.GT. int(huge(IW),8)) THEN 643 INFO(1) = -51 644 CALL MUMPS_SET_IERROR(NEDGES8,INFO(2)) 645 RETURN 646 ENDIF 647 ALLOCATE(XADJ(N+1), stat=allocok) 648 IF (allocok > 0) THEN 649 INFO(1)=-7 650 INFO(2)=NVTX+1 651 IF (LPOK) WRITE(LP,'(A)') 652 & "ERROR memory allocation in MUMPS_PORDF_WND_MIXEDto32" 653 RETURN 654 ENDIF 655 CALL MUMPS_COPY_INT_64TO32(XADJ8,N+1,XADJ) 656 CALL MUMPS_PORDF_WND( NVTX, int(NEDGES8), 657 & XADJ, IW, 658 & NV, NCMPA, N ) 659 DO I= 1, NVTX 660 PARENT(I) = XADJ(I) 661 ENDDO 662 DEALLOCATE(XADJ) 663 RETURN 664 END SUBROUTINE MUMPS_PORDF_WND_MIXEDto32 665 SUBROUTINE MUMPS_PORDF_WND_MIXEDto64( NVTX, NEDGES8, 666 & XADJ8, IW, 667 & NV, NCMPA, N, PARENT, 668 & INFO, LP, LPOK, KEEP10 ) 669 IMPLICIT NONE 670 INTEGER, INTENT(IN) :: LP 671 LOGICAL, INTENT(IN) :: LPOK 672 INTEGER, INTENT(INOUT) :: INFO(2) 673 INTEGER, INTENT(IN) :: NVTX, N 674 INTEGER, INTENT(OUT) :: NCMPA 675 INTEGER, INTENT(INOUT) :: NV(NVTX) 676 INTEGER(8) :: XADJ8(N+1) 677 INTEGER(8), INTENT(IN) :: NEDGES8 678 INTEGER :: IW(NEDGES8) 679 INTEGER, INTENT(OUT) :: PARENT(NVTX) 680 INTEGER, INTENT(IN) :: KEEP10 681 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IW8, NV8 682 INTEGER :: allocok 683 IF (KEEP10.EQ.1) THEN 684 CALL MUMPS_PORDF_WND( int(NVTX,8), NEDGES8, 685 & XADJ8, IW, 686 & NV, NCMPA, int(N,8) ) 687 CALL MUMPS_COPY_INT_64TO32(XADJ8, NVTX, PARENT) 688 ELSE 689 ALLOCATE(IW8(NEDGES8), NV8(N), stat=allocok) 690 IF (allocok > 0) THEN 691 INFO(1)=-7 692 CALL MUMPS_SET_IERROR(NEDGES8+int(NVTX,8),INFO(2)) 693 IF (LPOK) WRITE(LP,'(A)') 694 & "ERROR memory allocation in MUMPS_PORD_MIXEDto64" 695 RETURN 696 ENDIF 697 CALL MUMPS_COPY_INT_32TO64_64C(IW, NEDGES8, IW8) 698 CALL MUMPS_COPY_INT_32TO64(NV, NVTX, NV8) 699 CALL MUMPS_PORDF_WND( int(NVTX,8), NEDGES8, 700 & XADJ8, IW8, 701 & NV8, NCMPA, int(N,8) ) 702 CALL MUMPS_COPY_INT_64TO32(XADJ8, NVTX, PARENT) 703 CALL MUMPS_COPY_INT_64TO32(NV8, NVTX, NV) 704 DEALLOCATE(IW8, NV8) 705 ENDIF 706 RETURN 707 END SUBROUTINE MUMPS_PORDF_WND_MIXEDto64 708#endif 709 SUBROUTINE MUMPS_ANA_WRAP_RETURN() 710 RETURN 711 END SUBROUTINE MUMPS_ANA_WRAP_RETURN 712 END MODULE MUMPS_ANA_ORD_WRAPPERS 713