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 DMUMPS_ELT_ASM_S_2_S_INIT( 14 & NELT, FRT_PTR, FRT_ELT, 15 & N, INODE, IW, LIW, A, LA, 16 & NBROWS, NBCOLS, 17 & OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC, 18 & RHS_MUMPS, 19 & FILS, PTRARW, PTRAIW, INTARR, DBLARR, 20 & ICNTL, KEEP, KEEP8, MYID) 21 IMPLICIT NONE 22 INTEGER NELT, N,LIW 23 INTEGER(8) :: LA 24 INTEGER KEEP(500), ICNTL(40) 25 INTEGER(8) KEEP8(150) 26 INTEGER INODE, MYID 27 INTEGER NBROWS, NBCOLS 28 INTEGER(8) :: PTRAST(KEEP(28)) 29 INTEGER IW(LIW), ITLOC(N + KEEP(253)), STEP(N), 30 & PTRIST(KEEP(28)), 31 & FILS(N) 32 INTEGER(8), INTENT(IN) :: PTRARW(NELT+1), PTRAIW(NELT+1) 33 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255)) 34 INTEGER INTARR(KEEP8(27)) 35 INTEGER FRT_PTR(N+1), FRT_ELT(NELT) 36 DOUBLE PRECISION :: A(LA) 37 DOUBLE PRECISION :: DBLARR(KEEP8(26)) 38 DOUBLE PRECISION OPASSW, OPELIW 39 INTEGER(8) :: POSELT 40 INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF, 41 & K1,K2,K,J,JPOS,NASS 42 DOUBLE PRECISION ZERO 43 PARAMETER( ZERO = 0.0D0 ) 44 INCLUDE 'mumps_headers.h' 45 IOLDPS = PTRIST(STEP(INODE)) 46 POSELT = PTRAST(STEP(INODE)) 47 NBCOLF = IW(IOLDPS+KEEP(IXSZ)) 48 NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) 49 NASS = IW(IOLDPS+1+KEEP(IXSZ)) 50 NSLAVES = IW(IOLDPS+5+KEEP(IXSZ)) 51 HF = 6 + NSLAVES+KEEP(IXSZ) 52 IF (NASS.LT.0) THEN 53 NASS = -NASS 54 IW(IOLDPS+1+KEEP(IXSZ)) = NASS 55 CALL DMUMPS_ASM_SLAVE_ELEMENTS( INODE, N, NELT, IW, LIW, 56 & IOLDPS, A, LA, POSELT, KEEP, KEEP8, ITLOC, FILS, 57 & PTRAIW, PTRARW, 58 & INTARR, DBLARR, KEEP8(27), KEEP8(26), FRT_PTR, FRT_ELT, 59 & RHS_MUMPS) 60 END IF 61 IF (NBROWS.GT.0) THEN 62 K1 = IOLDPS + HF + NBROWF 63 K2 = K1 + NBCOLF - 1 64 JPOS = 1 65 DO K = K1, K2 66 J = IW(K) 67 ITLOC(J) = JPOS 68 JPOS = JPOS + 1 69 END DO 70 END IF 71 RETURN 72 END SUBROUTINE DMUMPS_ELT_ASM_S_2_S_INIT 73 SUBROUTINE DMUMPS_ASM_SLAVE_ELEMENTS( INODE, N, NELT, IW, LIW, 74 &IOLDPS, A, LA, POSELT, KEEP, KEEP8, ITLOC, FILS, PTRAIW, PTRARW, 75 &INTARR, DBLARR, LINTARR, LDBLARR, FRT_PTR, FRT_ELT, RHS_MUMPS) 76 IMPLICIT NONE 77 INTEGER, intent(in) :: N, NELT, LIW, IOLDPS, INODE 78 INTEGER(8), intent(in) :: LA, POSELT, LINTARR, LDBLARR 79 INTEGER, intent(in) :: IW(LIW) 80 INTEGER, intent(in) :: KEEP(500) 81 INTEGER(8), intent(in) :: KEEP8(150) 82 INTEGER, intent(inout) :: ITLOC(N+KEEP(253)) 83 DOUBLE PRECISION, intent(inout) :: A(LA) 84 DOUBLE PRECISION, intent(in) :: RHS_MUMPS(KEEP(255)) 85 INTEGER, intent(in) :: INTARR(LINTARR) 86 DOUBLE PRECISION, intent(in) :: DBLARR(LDBLARR) 87 INTEGER, intent(in) :: FRT_PTR(N+1), FRT_ELT(NELT) 88 INTEGER, intent(in) :: FILS(N) 89 INTEGER(8), intent(in) :: PTRAIW(NELT+1), PTRARW(NELT+1) 90 INCLUDE 'mumps_headers.h' 91 INTEGER :: HF, NBROWF, NBCOLF, NASS, NSLAVES 92 INTEGER :: ILOC, IELL, ELTI, ELBEG, NUMELT 93 INTEGER(8) :: SIZE_ELTI8 94 INTEGER :: I, J, K, K1, K2 95 INTEGER :: IPOS, IPOS1, IPOS2, JPOS, IJROW 96 INTEGER :: IN 97 INTEGER(8) :: II8, JJ8, J18, J28 98 INTEGER(8) :: AINPUT8 99 INTEGER(8) :: AII8 100 INTEGER(8) :: APOS, APOS2, ICT12 101 INTEGER :: K1RHS, K2RHS, JFirstRHS 102 DOUBLE PRECISION ZERO 103 PARAMETER( ZERO = 0.0D0 ) 104 NBCOLF = IW(IOLDPS+KEEP(IXSZ)) 105 NBROWF = IW(IOLDPS+2+KEEP(IXSZ)) 106 NASS = IW(IOLDPS+1+KEEP(IXSZ)) 107 A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) = ZERO 108 NSLAVES= IW(IOLDPS+5 + KEEP(IXSZ)) 109 HF = 6 + NSLAVES + KEEP(IXSZ) 110 K1 = IOLDPS + HF + NBROWF 111 K2 = K1 + NBCOLF - 1 112 JPOS = 1 113 DO K = K1, K2 114 J = IW(K) 115 ITLOC(J) = -JPOS 116 JPOS = JPOS + 1 117 END DO 118 K1 = IOLDPS + HF 119 K2 = K1 + NBROWF - 1 120 JPOS = 1 121 IF ((KEEP(253).GT.0).AND.(KEEP(50).NE.0)) THEN 122 K1RHS = 0 123 K2RHS = -1 124 DO K = K1, K2 125 J = IW(K) 126 ITLOC(J) = -ITLOC(J)*NBCOLF + JPOS 127 IF ((K1RHS.EQ.0).AND.(J.GT.N)) THEN 128 K1RHS = K 129 JFirstRHS=J-N 130 ENDIF 131 JPOS = JPOS + 1 132 ENDDO 133 IF (K1RHS.GT.0) K2RHS=K2 134 IF ( K2RHS.GE.K1RHS ) THEN 135 IN = INODE 136 DO WHILE (IN.GT.0) 137 IJROW = -ITLOC(IN) 138 DO K = K1RHS, K2RHS 139 J = IW(K) 140 I = ITLOC(J) 141 ILOC = mod(I,NBCOLF) 142 APOS = POSELT+int(ILOC-1,8)*int(NBCOLF,8) + 143 & int(IJROW-1,8) 144 A(APOS) = A(APOS) + RHS_MUMPS( 145 & (JFirstRHS+(K-K1RHS)-1)*KEEP(254)+ IN) 146 ENDDO 147 IN = FILS(IN) 148 ENDDO 149 ENDIF 150 ELSE 151 DO K = K1, K2 152 J = IW(K) 153 ITLOC(J) = -ITLOC(J)*NBCOLF + JPOS 154 JPOS = JPOS + 1 155 END DO 156 ENDIF 157 ELBEG = FRT_PTR(INODE) 158 NUMELT = FRT_PTR(INODE+1) - ELBEG 159 DO IELL=ELBEG,ELBEG+NUMELT-1 160 ELTI = FRT_ELT(IELL) 161 J18= PTRAIW(ELTI) 162 J28= PTRAIW(ELTI+1)-1_8 163 AII8 = PTRARW(ELTI) 164 SIZE_ELTI8 = J28 - J18 + 1_8 165 DO II8=J18,J28 166 I = ITLOC(INTARR(II8)) 167 IF (KEEP(50).EQ.0) THEN 168 IF (I.LE.0) CYCLE 169 AINPUT8 = AII8 + II8 - J18 170 IPOS = mod(I,NBCOLF) 171 ICT12 = POSELT + int(IPOS-1,8) * int(NBCOLF,8) 172 DO JJ8 = J18, J28 173 JPOS = ITLOC(INTARR(JJ8)) 174 IF (JPOS.LE.0) THEN 175 JPOS = -JPOS 176 ELSE 177 JPOS = JPOS/NBCOLF 178 END IF 179 APOS2 = ICT12 + int(JPOS - 1,8) 180 A(APOS2) = A(APOS2) + DBLARR(AINPUT8) 181 AINPUT8 = AINPUT8 + SIZE_ELTI8 182 END DO 183 ELSE 184 IF ( I .EQ. 0 ) THEN 185 AII8 = AII8 + J28 - II8 + 1_8 186 CYCLE 187 ENDIF 188 IF ( I .LE. 0 ) THEN 189 IPOS1 = -I 190 IPOS2 = 0 191 ELSE 192 IPOS1 = I/NBCOLF 193 IPOS2 = mod(I,NBCOLF) 194 END IF 195 ICT12 = POSELT + int(IPOS2-1,8)*int(NBCOLF,8) 196 DO JJ8=II8,J28 197 AII8 = AII8 + 1_8 198 J = ITLOC(INTARR(JJ8)) 199 IF ( J .EQ. 0 ) CYCLE 200 IF ( IPOS2.EQ.0 .AND. J.LE.0) CYCLE 201 IF ( J .LE. 0 ) THEN 202 JPOS = -J 203 ELSE 204 JPOS = J/NBCOLF 205 END IF 206 IF ( (IPOS1.GE.JPOS) .AND. (IPOS2.GT.0) ) THEN 207 APOS2 = ICT12 + int(JPOS - 1,8) 208 A(APOS2) = A(APOS2) + DBLARR(AII8-1_8) 209 END IF 210 IF ( (IPOS1.LT.JPOS) .AND. (J.GT.0) ) THEN 211 IPOS = mod(J,NBCOLF) 212 JPOS = IPOS1 213 APOS2 = POSELT + int(IPOS-1,8)*int(NBCOLF,8) 214 & + int(JPOS - 1,8) 215 A(APOS2) = A(APOS2) + DBLARR(AII8-1_8) 216 END IF 217 END DO 218 END IF 219 END DO 220 END DO 221 K1 = IOLDPS + HF + NBROWF 222 K2 = K1 + NBCOLF - 1 223 DO K = K1, K2 224 J = IW(K) 225 ITLOC(J) = 0 226 END DO 227 END SUBROUTINE DMUMPS_ASM_SLAVE_ELEMENTS 228