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 SMUMPS_ASM_SLAVE_MASTER(N, INODE, IW, LIW, A, LA, 14 & ISON, NBROWS, NBCOLS, ROWLIST, 15 & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER, 16 & OPASSW, IWPOSCB, MYID, KEEP,KEEP8, IS_ofType5or6, 17 & LDA_VALSON ) 18 USE SMUMPS_LOAD 19 IMPLICIT NONE 20 INTEGER KEEP(500) 21 INTEGER(8) KEEP8(150) 22 INTEGER(8) :: LA 23 INTEGER N,LIW,MYID 24 INTEGER INODE,ISON, IWPOSCB 25 INTEGER NBROWS, NBCOLS, LDA_VALSON 26 INTEGER(8) :: PTRAST(KEEP(28)) 27 INTEGER IW(LIW), STEP(N), PIMASTER(KEEP(28)), 28 & PTLUST_S(KEEP(28)), ROWLIST(NBROWS) 29 REAL A(LA), VALSON(LDA_VALSON,NBROWS) 30 DOUBLE PRECISION OPASSW 31 LOGICAL, INTENT(IN) :: IS_ofType5or6 32 INTEGER(8) :: POSELT, POSEL1, APOS, JJ2 33 INTEGER HF,HS, NSLAVES, NFRONT, NASS1, 34 & IOLDPS, ISTCHK, LSTK, NSLSON,NELIM, 35 & NPIVS,NCOLS,J1,JJ,JJ1,NROWS, 36 & LDAFS_PERE, IBEG, DIAG 37 INCLUDE 'mumps_headers.h' 38 LOGICAL SAME_PROC 39 INTRINSIC real 40 IOLDPS = PTLUST_S(STEP(INODE)) 41 POSELT = PTRAST(STEP(INODE)) 42 NFRONT = IW(IOLDPS+KEEP(IXSZ)) 43 NASS1 = iabs(IW(IOLDPS + 2+KEEP(IXSZ))) 44 NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) 45 IF (KEEP(50).EQ.0) THEN 46 LDAFS_PERE = NFRONT 47 ELSE 48 IF ( NSLAVES .eq. 0 ) THEN 49 LDAFS_PERE = NFRONT 50 ELSE 51 LDAFS_PERE = NASS1 52 ENDIF 53 ENDIF 54 HF = 6 + NSLAVES + KEEP(IXSZ) 55 POSEL1 = POSELT - int(LDAFS_PERE,8) 56 ISTCHK = PIMASTER(STEP(ISON)) 57 LSTK = IW(ISTCHK+KEEP(IXSZ)) 58 NSLSON = IW(ISTCHK + 5+KEEP(IXSZ)) 59 HS = 6 + NSLSON + KEEP(IXSZ) 60 OPASSW = OPASSW + dble(NBROWS*NBCOLS) 61 NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) 62 NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) 63 IF (NPIVS.LT.0) NPIVS = 0 64 NCOLS = NPIVS + LSTK 65 SAME_PROC = (ISTCHK.LT.IWPOSCB) 66 IF (SAME_PROC) THEN 67 NROWS = NCOLS 68 ELSE 69 NROWS = IW(ISTCHK+2+KEEP(IXSZ)) 70 ENDIF 71 J1 = ISTCHK + NROWS + HS + NPIVS 72 IF (KEEP(50).EQ.0) THEN 73 IF (IS_ofType5or6) THEN 74 APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8) 75 DO JJ = 1, NBROWS 76 DO JJ1 = 1, NBCOLS 77 JJ2 = APOS + int(JJ1-1,8) 78 A(JJ2)=A(JJ2)+VALSON(JJ1,JJ) 79 ENDDO 80 APOS = APOS + int(LDAFS_PERE,8) 81 ENDDO 82 ELSE 83 DO 170 JJ = 1, NBROWS 84 APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8) 85 DO 160 JJ1 = 1, NBCOLS 86 JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) 87 A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) 88 160 CONTINUE 89 170 CONTINUE 90 ENDIF 91 ELSE 92 IF (IS_ofType5or6) THEN 93 APOS = POSEL1 + int(ROWLIST(1),8) * int(LDAFS_PERE,8) 94 DIAG = ROWLIST(1) 95 DO JJ = 1, NBROWS 96 DO JJ1 = 1, DIAG 97 JJ2 = APOS+int(JJ1-1,8) 98 A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) 99 ENDDO 100 DIAG = DIAG+1 101 APOS = APOS + int(LDAFS_PERE,8) 102 ENDDO 103 ELSE 104 DO JJ = 1, NBROWS 105 IF (ROWLIST(JJ).LE.NASS1.and..NOT.IS_ofType5or6) THEN 106 APOS = POSEL1 + int(ROWLIST(JJ) - 1,8) 107 DO JJ1 = 1, NELIM 108 JJ2 = APOS + int(IW(J1+JJ1-1),8)*int(LDAFS_PERE,8) 109 A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) 110 ENDDO 111 IBEG = NELIM+1 112 ELSE 113 IBEG = 1 114 ENDIF 115 APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8) 116 DO JJ1 = IBEG, NBCOLS 117 IF (ROWLIST(JJ).LT.IW(J1 + JJ1 - 1)) EXIT 118 JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8) 119 A(JJ2) = A(JJ2) + VALSON(JJ1,JJ) 120 ENDDO 121 ENDDO 122 ENDIF 123 ENDIF 124 RETURN 125 END SUBROUTINE SMUMPS_ASM_SLAVE_MASTER 126 SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE_INIT 127 & (N, INODE, IW, LIW, A, LA, 128 & NBROWS, NBCOLS, 129 & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, 130 & RHS_MUMPS, FILS, PTRARW, PTRAIW, INTARR, DBLARR, 131 & ICNTL, KEEP,KEEP8, MYID) 132 IMPLICIT NONE 133 INTEGER N,LIW 134 INTEGER(8) :: LA 135 INTEGER KEEP(500), ICNTL(40) 136 INTEGER(8) KEEP8(150) 137 INTEGER INODE, MYID 138 INTEGER NBROWS, NBCOLS 139 INTEGER(8) :: PTRAST(KEEP(28)) 140 INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), 141 & PTRIST(KEEP(28)), FILS(N) 142 INTEGER(8), INTENT(IN) :: PTRARW(N), PTRAIW(N) 143 REAL :: RHS_MUMPS(KEEP(255)) 144 REAL :: A(LA) 145 INTEGER :: INTARR(KEEP8(27)) 146 REAL :: DBLARR(KEEP8(26)) 147 DOUBLE PRECISION OPASSW, OPELIW 148 INTEGER(8) :: POSELT 149 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, 150 & K1,K2,K,J,JPOS,NASS 151 REAL ZERO 152 PARAMETER( ZERO = 0.0E0 ) 153 INCLUDE 'mumps_headers.h' 154 IOLDPS = PTRIST(STEP(INODE)) 155 POSELT = PTRAST(STEP(INODE)) 156 NBCOLF = IW(IOLDPS+KEEP(IXSZ)) 157 NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) 158 NASS = IW(IOLDPS+1+KEEP(IXSZ)) 159 NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) 160 HF = 6 + NSLAVES + KEEP(IXSZ) 161 IF (NASS.LT.0) THEN 162 NASS = -NASS 163 IW(IOLDPS+1+KEEP(IXSZ)) = NASS 164 CALL SMUMPS_ASM_SLAVE_ARROWHEADS(INODE, N, IW, LIW, 165 & IOLDPS, A, LA, POSELT, KEEP, KEEP8, 166 & ITLOC, FILS, PTRAIW, PTRARW, INTARR, DBLARR, 167 & KEEP8(27), KEEP8(26), 168 & RHS_MUMPS) 169 ENDIF 170 IF (NBROWS.GT.0) THEN 171 K1 = IOLDPS + HF + NBROWF 172 K2 = K1 + NBCOLF - 1 173 JPOS = 1 174 DO K = K1, K2 175 J = IW(K) 176 ITLOC(J) = JPOS 177 JPOS = JPOS + 1 178 ENDDO 179 ENDIF 180 RETURN 181 END SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE_INIT 182 SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE_END 183 & (N, INODE, IW, LIW, NBROWS, STEP, PTRIST, 184 & ITLOC, RHS_MUMPS, KEEP,KEEP8) 185 IMPLICIT NONE 186 INTEGER N, LIW 187 INTEGER KEEP(500) 188 INTEGER(8) KEEP8(150) 189 INTEGER INODE 190 INTEGER NBROWS 191 INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), 192 & PTRIST(KEEP(28)) 193 REAL :: RHS_MUMPS(KEEP(255)) 194 INCLUDE 'mumps_headers.h' 195 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, 196 & K1,K2,K,J 197 IOLDPS = PTRIST(STEP(INODE)) 198 NBCOLF = IW(IOLDPS+KEEP(IXSZ)) 199 NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) 200 NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) 201 HF = 6 + NSLAVES+KEEP(IXSZ) 202 IF (NBROWS.GT.0) THEN 203 K1 = IOLDPS + HF + NBROWF 204 K2 = K1 + NBCOLF - 1 205 DO K = K1, K2 206 J = IW(K) 207 ITLOC(J) = 0 208 ENDDO 209 ENDIF 210 RETURN 211 END SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE_END 212 SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE(N, INODE, IW, LIW, A, LA, 213 & NBROWS, NBCOLS, ROWLIST, COLLIST, VALSON, 214 & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, 215 & RHS_MUMPS, FILS, 216 & ICNTL, KEEP,KEEP8, MYID, IS_ofType5or6, LDA_VALSON) 217 IMPLICIT NONE 218 INTEGER N,LIW 219 INTEGER(8) :: LA 220 INTEGER KEEP(500), ICNTL(40) 221 INTEGER(8) KEEP8(150) 222 INTEGER INODE, MYID 223 LOGICAL, intent(in) :: IS_ofType5or6 224 INTEGER NBROWS, NBCOLS, LDA_VALSON 225 INTEGER ROWLIST(NBROWS), COLLIST(NBCOLS) 226 INTEGER IW(LIW), ITLOC(N+KEEP(253)), STEP(N), 227 & PTRIST(KEEP(28)), FILS(N) 228 REAL :: RHS_MUMPS(KEEP(255)) 229 INTEGER(8) :: PTRAST(KEEP(28)) 230 REAL A(LA), VALSON(LDA_VALSON,NBROWS) 231 DOUBLE PRECISION OPASSW, OPELIW 232 INTEGER(8) :: POSEL1, POSELT, APOS, K8 233 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, 234 & I,J,NASS,IDIAG 235 INCLUDE 'mumps_headers.h' 236 INTRINSIC real 237 IOLDPS = PTRIST(STEP(INODE)) 238 POSELT = PTRAST(STEP(INODE)) 239 NBCOLF = IW(IOLDPS+KEEP(IXSZ)) 240 NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) 241 NASS = IW(IOLDPS+1+KEEP(IXSZ)) 242 IF ( NBROWS .GT. NBROWF ) THEN 243 WRITE(*,*) ' ERR: ERROR : NBROWS > NBROWF' 244 WRITE(*,*) ' ERR: INODE =', INODE 245 WRITE(*,*) ' ERR: NBROW=',NBROWS,'NBROWF=',NBROWF 246 WRITE(*,*) ' ERR: ROW_LIST=', ROWLIST 247 WRITE(*,*) ' ERR: NBCOLF/NASS=', NBCOLF, NASS 248 CALL MUMPS_ABORT() 249 END IF 250 NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) 251 HF = 6 + NSLAVES+KEEP(IXSZ) 252 IF (NBROWS.GT.0) THEN 253 POSEL1 = POSELT - int(NBCOLF,8) 254 IF (KEEP(50).EQ.0) THEN 255 IF (IS_ofType5or6) THEN 256 APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8) 257 DO I=1, NBROWS 258 DO J = 1, NBCOLS 259 A(APOS+int(J-1,8)) = A( APOS+int(J-1,8)) + VALSON(J,I) 260 ENDDO 261 APOS = APOS + int(NBCOLF,8) 262 END DO 263 ELSE 264 DO I=1,NBROWS 265 APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8) 266 DO J=1,NBCOLS 267 K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8 268 A(K8) = A(K8) + VALSON(J,I) 269 ENDDO 270 ENDDO 271 ENDIF 272 ELSE 273 IF (IS_ofType5or6) THEN 274 APOS = POSEL1 + int(ROWLIST(1),8) * int(NBCOLF,8) 275 & + int((NBROWS-1),8)*int(NBCOLF,8) 276 IDIAG = 0 277 DO I=NBROWS,1,-1 278 A(APOS:APOS+int(NBCOLS-IDIAG-1,8))= 279 & A(APOS:APOS+int(NBCOLS-IDIAG-1,8)) + 280 & VALSON(1:NBCOLS-IDIAG,I) 281 APOS = APOS - int(NBCOLF,8) 282 IDIAG = IDIAG + 1 283 ENDDO 284 ELSE 285 DO I=1,NBROWS 286 APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8) 287 DO J=1,NBCOLS 288 IF (ITLOC(COLLIST(J)) .EQ. 0) THEN 289 EXIT 290 ENDIF 291 K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8 292 A(K8) = A(K8) + VALSON(J,I) 293 ENDDO 294 ENDDO 295 ENDIF 296 ENDIF 297 OPASSW = OPASSW + dble(NBROWS*NBCOLS) 298 ENDIF 299 RETURN 300 END SUBROUTINE SMUMPS_ASM_SLAVE_TO_SLAVE 301 SUBROUTINE SMUMPS_LDLT_ASM_NIV12_IP( A, LA, 302 & IAFATH, NFRONT, NASS1, 303 & IACB, NCOLS, LCB, 304 & IW, NROWS, NELIM, ETATASS, 305 & CB_IS_COMPRESSED ) 306 IMPLICIT NONE 307 INTEGER NFRONT, NASS1 308 INTEGER(8) :: LA 309 INTEGER NCOLS, NROWS, NELIM 310 INTEGER(8) :: LCB 311 REAL A( LA ) 312 INTEGER(8) :: IAFATH, IACB 313 INTEGER IW( NCOLS ) 314 INTEGER ETATASS 315 LOGICAL CB_IS_COMPRESSED 316 REAL ZERO 317 PARAMETER( ZERO = 0.0E0 ) 318 INTEGER I, J 319 INTEGER(8) :: APOS, POSELT 320 INTEGER(8) :: IPOSCB, IBEGCBROW, IENDFRONT 321 LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS, 322 & RISK_OF_SAME_POS_THIS_LINE 323 IENDFRONT = IAFATH+int(NFRONT,8)*int(NFRONT,8)-1_8 324 IPOSCB=1_8 325 RESET_TO_ZERO = IACB .LT. IENDFRONT + 1_8 326 RISK_OF_SAME_POS = IACB + LCB .EQ. IENDFRONT + 1_8 327 RISK_OF_SAME_POS_THIS_LINE = .FALSE. 328 DO I=1, NROWS 329 POSELT = int(IW(I)-1,8) * int(NFRONT,8) 330 IF (.NOT. CB_IS_COMPRESSED ) THEN 331 IPOSCB = 1_8 + int(I - 1,8) * int(NCOLS,8) 332 IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN 333 RESET_TO_ZERO = .FALSE. 334 ENDIF 335 ENDIF 336 IF ( RISK_OF_SAME_POS ) THEN 337 IF (I.EQ.NROWS .OR. .NOT. CB_IS_COMPRESSED) THEN 338 IF ( IAFATH + POSELT + int(IW(I)-1,8) .EQ. 339 & IACB+IPOSCB+int(I-1-1,8)) THEN 340 RISK_OF_SAME_POS_THIS_LINE = .TRUE. 341 ENDIF 342 ENDIF 343 ENDIF 344 IF (RESET_TO_ZERO) THEN 345 IF ( RISK_OF_SAME_POS_THIS_LINE ) THEN 346 DO J=1, I 347 APOS = POSELT + int(IW( J ),8) 348 IF (IAFATH + APOS - 1_8.NE. IACB+IPOSCB-1_8) THEN 349 A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) 350 A(IACB+IPOSCB-1_8) = ZERO 351 ENDIF 352 IPOSCB = IPOSCB + 1_8 353 ENDDO 354 ELSE 355 DO J=1, I 356 APOS = POSELT + int(IW( J ),8) 357 A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) 358 A(IACB+IPOSCB-1_8) = ZERO 359 IPOSCB = IPOSCB + 1_8 360 ENDDO 361 ENDIF 362 ELSE 363 DO J=1, I 364 APOS = POSELT + int(IW( J ),8) 365 A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8) 366 IPOSCB = IPOSCB + 1_8 367 ENDDO 368 ENDIF 369 IF (.NOT. CB_IS_COMPRESSED ) THEN 370 IBEGCBROW = IACB+IPOSCB-1_8 371 IF ( IBEGCBROW .LE. IENDFRONT ) THEN 372 A(IBEGCBROW:IBEGCBROW+int(NCOLS-I,8)-1_8)=ZERO 373 ENDIF 374 ENDIF 375 IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN 376 RESET_TO_ZERO = .FALSE. 377 ENDIF 378 ENDDO 379 RETURN 380 END SUBROUTINE SMUMPS_LDLT_ASM_NIV12_IP 381 SUBROUTINE SMUMPS_LDLT_ASM_NIV12( A, LA, SON_A, 382 & IAFATH, NFRONT, NASS1, 383 & NCOLS, LCB, 384 & IW, NROWS, NELIM, ETATASS, 385 & CB_IS_COMPRESSED 386 & ) 387 IMPLICIT NONE 388 INTEGER NFRONT, NASS1 389 INTEGER(8) :: LA 390 INTEGER NCOLS, NROWS, NELIM 391 INTEGER(8) :: LCB 392 REAL A( LA ) 393 REAL SON_A( LCB ) 394 INTEGER(8) :: IAFATH 395 INTEGER IW( NCOLS ) 396 INTEGER ETATASS 397 LOGICAL CB_IS_COMPRESSED 398 REAL ZERO 399 PARAMETER( ZERO = 0.0E0 ) 400 INTEGER I, J 401 INTEGER(8) :: APOS, POSELT 402 INTEGER(8) :: IPOSCB 403 LOGICAL :: OMP_FLAG 404 IF ((ETATASS.EQ.0) .OR. (ETATASS.EQ.1)) THEN 405 IPOSCB = 1_8 406 DO I = 1, NELIM 407 POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) 408 IF (.NOT. CB_IS_COMPRESSED) THEN 409 IPOSCB = 1_8 + int( I - 1, 8 ) * int(NCOLS,8) 410 ENDIF 411 DO J = 1, I 412 APOS = POSELT + int(IW( J ),8) 413 A(IAFATH+ APOS -1_8) = A(IAFATH+ APOS -1_8) 414 & + SON_A(IPOSCB) 415 IPOSCB = IPOSCB + 1_8 416 END DO 417 END DO 418 ENDIF 419 IF ((ETATASS.EQ.0).OR.(ETATASS.EQ.1)) THEN 420 OMP_FLAG = (NROWS-NELIM).GE.300 421!$OMP PARALLEL DO PRIVATE(IPOSCB, POSELT, J, APOS) IF (OMP_FLAG) 422 DO I = NELIM + 1, NROWS 423 IF (CB_IS_COMPRESSED) THEN 424 IPOSCB = (int(I,8) * int(I-1,8)) / 2_8 + 1_8 425 ELSE 426 IPOSCB = int(I-1,8) * int(NCOLS,8) + 1_8 427 ENDIF 428 POSELT = int(IW( I ),8) 429 IF (POSELT.LE. int(NASS1,8)) THEN 430 DO J = 1, NELIM 431 APOS = POSELT + int( IW( J ) - 1, 8 ) * int(NFRONT,8) 432 A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) + 433 & SON_A(IPOSCB) 434 IPOSCB = IPOSCB + 1_8 435 END DO 436 ELSE 437 POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) 438 DO J = 1, NELIM 439 APOS = POSELT + int(IW( J ), 8) 440 A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) 441 & + SON_A(IPOSCB) 442 IPOSCB = IPOSCB + 1_8 443 END DO 444 ENDIF 445 IF (ETATASS.EQ.1) THEN 446 POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) 447 DO J = NELIM + 1, I 448 IF (IW(J).GT.NASS1) EXIT 449 APOS = POSELT + int(IW( J ), 8) 450 A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) 451 & + SON_A(IPOSCB) 452 IPOSCB = IPOSCB +1_8 453 END DO 454 ELSE 455 POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) 456 DO J = NELIM + 1, I 457 APOS = POSELT + int(IW( J ), 8) 458 A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) 459 & + SON_A(IPOSCB) 460 IPOSCB = IPOSCB + 1_8 461 END DO 462 ENDIF 463 END DO 464!$OMP END PARALLEL DO 465 ELSE 466 DO I= NROWS, NELIM+1, -1 467 IF (CB_IS_COMPRESSED) THEN 468 IPOSCB = (int(I,8)*int(I+1,8))/2_8 469 ELSE 470 IPOSCB = int(I-1,8) * int(NCOLS,8) + int(I,8) 471 ENDIF 472 POSELT = int(IW( I ),8) 473 IF (POSELT.LE.int(NASS1,8)) EXIT 474 POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8) 475 DO J=I,NELIM+1, -1 476 IF (IW(J).LE.NASS1) EXIT 477 APOS = POSELT + int(IW( J ), 8) 478 A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) 479 & + SON_A(IPOSCB) 480 IPOSCB = IPOSCB - 1_8 481 ENDDO 482 ENDDO 483 ENDIF 484 RETURN 485 END SUBROUTINE SMUMPS_LDLT_ASM_NIV12 486 SUBROUTINE SMUMPS_RESTORE_INDICES(N, ISON, INODE, IWPOSCB, 487 & PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8) 488 IMPLICIT NONE 489 INTEGER N, ISON, INODE, IWPOSCB 490 INTEGER KEEP(500), STEP(N) 491 INTEGER(8) KEEP8(150) 492 INTEGER PIMASTER(KEEP(28)), PTLUST_S(KEEP(28)) 493 INTEGER LIW 494 INTEGER IW(LIW) 495 INTEGER ISTCHK, LSTK, NSLSON, HS, NROWS, NCOLS, NPIVS, NELIM 496 INTEGER IOLDPS, NFRONT, NSLAVES, ICT11, HF 497 INTEGER J1, J2, J3, JJ, JPOS 498 LOGICAL SAME_PROC 499 INCLUDE 'mumps_headers.h' 500 ISTCHK = PIMASTER(STEP(ISON)) 501 LSTK = IW(ISTCHK+KEEP(IXSZ)) 502 NSLSON = IW(ISTCHK+5+KEEP(IXSZ)) 503 HS = 6 + NSLSON + KEEP(IXSZ) 504 NELIM = IW(ISTCHK + 1+KEEP(IXSZ)) 505 NPIVS = IW(ISTCHK + 3+KEEP(IXSZ)) 506 NCOLS = NPIVS + LSTK 507 IF ( NPIVS < 0 ) NPIVS = 0 508 SAME_PROC = ISTCHK < IWPOSCB 509 IF (SAME_PROC) THEN 510 NROWS = NCOLS 511 ELSE 512 NROWS = IW(ISTCHK+2+KEEP(IXSZ)) 513 ENDIF 514 J1 = ISTCHK + NROWS + HS + NPIVS 515 IF (KEEP(50).NE.0) THEN 516 J2 = J1 + LSTK - 1 517 DO JJ = J1, J2 518 IW(JJ) = IW(JJ - NROWS) 519 ENDDO 520 ELSE 521 J2 = J1 + LSTK - 1 522 J3 = J1 + NELIM 523 DO JJ = J3, J2 524 IW(JJ) = IW(JJ - NROWS) 525 ENDDO 526 IF (NELIM .NE. 0) THEN 527 IOLDPS = PTLUST_S(STEP(INODE)) 528 NFRONT = IW(IOLDPS+KEEP(IXSZ)) 529 NSLAVES= IW(IOLDPS+5+KEEP(IXSZ)) 530 HF = 6 + NSLAVES+KEEP(IXSZ) 531 ICT11 = IOLDPS + HF - 1 + NFRONT 532 J3 = J3 - 1 533 DO 190 JJ = J1, J3 534 JPOS = IW(JJ) + ICT11 535 IW(JJ) = IW(JPOS) 536 190 CONTINUE 537 ENDIF 538 ENDIF 539 RETURN 540 END SUBROUTINE SMUMPS_RESTORE_INDICES 541 SUBROUTINE SMUMPS_ASM_MAX( 542 & N, INODE, IW, LIW, A, LA, 543 & ISON, NBCOLS, 544 & VALSON, PTLUST_S, PTRAST, STEP, PIMASTER, 545 & OPASSW, IWPOSCB,MYID, KEEP,KEEP8 ) 546 USE SMUMPS_LOAD 547 IMPLICIT NONE 548 INTEGER KEEP(500) 549 INTEGER(8) KEEP8(150) 550 INTEGER(8) :: LA 551 INTEGER N,LIW,MYID 552 INTEGER INODE,ISON,IWPOSCB 553 INTEGER NBCOLS 554 INTEGER IW(LIW), STEP(N), 555 & PIMASTER(KEEP(28)), 556 & PTLUST_S(KEEP(28)) 557 INTEGER(8) PTRAST(KEEP(28)) 558 REAL A(LA) 559 REAL VALSON(NBCOLS) 560 DOUBLE PRECISION OPASSW 561 INTEGER HF,HS, NSLAVES, NASS1, 562 & IOLDPS, ISTCHK, 563 & LSTK, NSLSON,NELIM,NPIVS,NCOLS, J1, 564 & JJ1,NROWS 565 INTEGER(8) POSELT, APOS, JJ2 566 INCLUDE 'mumps_headers.h' 567 LOGICAL SAME_PROC 568 INTRINSIC real 569 IOLDPS = PTLUST_S(STEP(INODE)) 570 POSELT = PTRAST(STEP(INODE)) 571 NASS1 = iabs(IW(IOLDPS + 2 + KEEP(IXSZ))) 572 NSLAVES= IW(IOLDPS+5 + KEEP(IXSZ)) 573 HF = 6 + NSLAVES + KEEP(IXSZ) 574 ISTCHK = PIMASTER(STEP(ISON)) 575 LSTK = IW(ISTCHK + KEEP(IXSZ)) 576 NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ)) 577 HS = 6 + NSLSON + KEEP(IXSZ) 578 NELIM = IW(ISTCHK + 1 + KEEP(IXSZ)) 579 NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ)) 580 IF (NPIVS.LT.0) NPIVS = 0 581 NCOLS = NPIVS + LSTK 582 SAME_PROC = (ISTCHK.LT.IWPOSCB) 583 IF (SAME_PROC) THEN 584 NROWS = NCOLS 585 ELSE 586 NROWS = IW(ISTCHK+2 + KEEP(IXSZ)) 587 ENDIF 588 J1 = ISTCHK + NROWS + HS + NPIVS 589 APOS = POSELT + int(NASS1,8)*int(NASS1,8) - 1_8 590 DO JJ1 = 1, NBCOLS 591 JJ2 = APOS+int(IW(J1 + JJ1 - 1),8) 592 IF(real(A(JJ2)) .LT. VALSON(JJ1)) 593 & A(JJ2) = VALSON(JJ1) 594 ENDDO 595 RETURN 596 END SUBROUTINE SMUMPS_ASM_MAX 597 SUBROUTINE SMUMPS_ASM_SLAVE_ARROWHEADS(INODE, N, IW, LIW, IOLDPS, 598 & A, LA, POSELT, KEEP, KEEP8, 599 & ITLOC, FILS, PTRAIW, PTRARW, INTARR, DBLARR, 600 & LINTARR, LDBLARR, RHS_MUMPS) 601 IMPLICIT NONE 602 INTEGER, intent(in) :: N, LIW, IOLDPS, INODE 603 INTEGER(8), intent(in) :: LA, POSELT 604 INTEGER(8), intent(in) :: LINTARR, LDBLARR 605 INTEGER, intent(in) :: IW(LIW) 606 INTEGER, intent(in) :: KEEP(500) 607 INTEGER(8), intent(in) :: KEEP8(150) 608 INTEGER, intent(inout) :: ITLOC(N+KEEP(253)) 609 REAL, intent(inout) :: A(LA) 610 REAL, intent(in) :: RHS_MUMPS(KEEP(255)) 611 REAL, intent(in) :: DBLARR(LDBLARR) 612 INTEGER, intent(in) :: INTARR(LINTARR) 613 INTEGER, intent(in) :: FILS(N) 614 INTEGER(8), intent(in) :: PTRAIW(N), PTRARW(N) 615 INCLUDE 'mumps_headers.h' 616 INTEGER :: HF, NBROWF, NBCOLF, NASS, NSLAVES 617 INTEGER :: ILOC, J, K, K1, K2, JPOS, IJROW 618 INTEGER :: IN 619 INTEGER(8) :: J18, J28, JJ8, JK8 620 INTEGER(8) :: APOS, ICT12 621 INTEGER(8) :: AINPUT8 622 INTEGER :: K1RHS, K2RHS, JFirstRHS 623 REAL ZERO 624 PARAMETER( ZERO = 0.0E0 ) 625 NBCOLF = IW(IOLDPS+KEEP(IXSZ)) 626 NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) 627 NASS = IW(IOLDPS+1+KEEP(IXSZ)) 628 A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) = ZERO 629 NSLAVES= IW(IOLDPS+5 + KEEP(IXSZ)) 630 HF = 6 + NSLAVES + KEEP(IXSZ) 631 K1 = IOLDPS + HF + NBROWF 632 K2 = K1 + NASS - 1 633 JPOS = 1 634 DO K = K1, K2 635 J = IW(K) 636 ITLOC(J) = -JPOS 637 JPOS = JPOS + 1 638 ENDDO 639 K1 = IOLDPS + HF 640 K2 = K1 + NBROWF - 1 641 JPOS = 1 642 IF ((KEEP(253).GT.0).AND.(KEEP(50).NE.0)) THEN 643 K1RHS = 0 644 K2RHS = -1 645 DO K = K1, K2 646 J = IW(K) 647 ITLOC(J) = JPOS 648 IF ((K1RHS.EQ.0).AND.(J.GT.N)) THEN 649 K1RHS = K 650 JFirstRHS=J-N 651 ENDIF 652 JPOS = JPOS + 1 653 ENDDO 654 IF (K1RHS.GT.0) K2RHS=K2 655 IF ( K2RHS.GE.K1RHS ) THEN 656 IN = INODE 657 DO WHILE (IN.GT.0) 658 IJROW = -ITLOC(IN) 659 DO K = K1RHS, K2RHS 660 J = IW(K) 661 ILOC = ITLOC(J) 662 APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) + 663 & int(IJROW-1,8) 664 A(APOS) = A(APOS) + RHS_MUMPS( 665 & (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+IN) 666 ENDDO 667 IN = FILS(IN) 668 ENDDO 669 ENDIF 670 ELSE 671 DO K = K1, K2 672 J = IW(K) 673 ITLOC(J) = JPOS 674 JPOS = JPOS + 1 675 ENDDO 676 ENDIF 677 IN = INODE 678 DO WHILE (IN.GT.0) 679 AINPUT8 = PTRARW(IN) 680 JK8 = PTRAIW(IN) 681 JJ8 = JK8 + 1_8 682 J18 = JJ8 + 1_8 683 J28 = J18 + INTARR(JK8) 684 IJROW = -ITLOC(INTARR(J18)) 685 ICT12 = POSELT +int(- NBCOLF + IJROW - 1,8) 686 DO JJ8= J18,J28 687 ILOC = ITLOC(INTARR(JJ8)) 688 IF (ILOC.GT.0) THEN 689 APOS = ICT12 + int(ILOC,8)*int(NBCOLF,8) 690 A(APOS) = A(APOS) + DBLARR(AINPUT8) 691 ENDIF 692 AINPUT8 = AINPUT8 + 1_8 693 ENDDO 694 IN = FILS(IN) 695 ENDDO 696 K1 = IOLDPS + HF 697 K2 = K1 + NBROWF + NASS - 1 698 DO K = K1, K2 699 J = IW(K) 700 ITLOC(J) = 0 701 ENDDO 702 RETURN 703 END SUBROUTINE SMUMPS_ASM_SLAVE_ARROWHEADS 704