15 &MYID,N,IOLDPS,TYPE,IW, LIW, A, LA,
16 &POSFAC, LRLU, LRLUS, IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8,
26 INTEGER IOLDPS,
TYPE, LIW, N, KEEP(500)
27 INTEGER(8) :: SIZE_INPLACE, LA, POSFAC, LRLU, LRLUS
28 INTEGER(8) :: PTRAST(KEEP(28))
31 COMPLEX(kind=8) A( LA )
34 INTEGER (8) :: PTRFAC((28))
36 INTEGER IOLDSHIFT, IPSSHIFT
37 INTEGER LRGROUPS(N), NASS
38 include
'mumps_headers.h'
39 INTEGER LCONT, NELIM, NROW, NPIV, INTSIZ
40 INTEGER NFRONT, NSLAVES
42 INTEGER(8) :: SIZELU, SIZECB, IAPOS, I, SIZESHIFT,
45 LOGICAL LRCOMPRESS_PANEL
49 ioldshift = ioldps + keep(ixsz)
50 IF ( iw( ioldshift ) < 0 )
THEN
51 write(*,*)
' ERROR 1 compressLU:Should not point to a band.'
53 ELSE IF ( iw( ioldshift + 2 ) < 0 )
THEN
54 write(*,*)
' ERROR 2 compressLU:Stack not performed yet',
58 lcont = iw( ioldshift )
59 nelim = iw( ioldshift + 1 )
60 nrow = iw( ioldshift + 2 )
61 npiv = iw( ioldshift + 3 )
62 iapos = ptrfac(iw( ioldshift + 4 ))
63 nslaves= iw( ioldshift + 5 )
65 intsiz = iw(ioldps+xxi)
66 lrcompress_panel = (iw(ioldps+xxlr).GE.2)
67 IF ( (nslaves > 0 .AND.
TYPE .NE. 2) .OR.
68 & (nslaves .eq. 0 .AND.
TYPE .EQ. 2 ) ) then
69 WRITE(*,*)
' ERROR 3 compressLU: problem with level of inode'
72 IF ( keep(50) .EQ. 0 )
THEN
73 sizelu = int(lcont + nrow, 8) * int(npiv,8)
75 IF ( keep(459) .GT. 1 )
THEN
77 & iw(ioldshift+6+nslaves+nfront), sizelu)
78 sizelu = sizelu + int( nrow - npiv, 8 ) * int( npiv, 8 )
80 sizelu = int(nrow,8) * int(npiv,8)
84 sizecb = sizexxr - sizelu
87 & .OR.(lrcompress_panel.AND.keep(486).EQ.2)
92 IF (sizecb.EQ.0_8)
THEN
96 IF (keep(201).EQ.2)
THEN
97 IF (keep(405) .EQ. 0)
THEN
98 keep8(31)=keep8(31)+sizelu
103 keep8(31)=keep8(31)+sizelu
109 WRITE(*,*)myid,
': Internal error in ZMUMPS_NEW_FACTOR'
113 IF ( ioldps + intsiz .NE. iwpos )
THEN
114 ips = ioldps + intsiz
116 DO WHILE ( ips .NE. iwpos )
118 ipsshift = ips + keep(ixsz)
119 IF ( ipsize .LE. 0 .OR. ips .GT. iwpos )
THEN
120 WRITE(*,*)
" Internal error 1 ZMUMPS_COMPRESS_LU"
121 WRITE(*,*) " ioldps, intsiz, iwpos, liw=
",
122 & IOLDPS, INTSIZ, IWPOS, LIW
123 WRITE(*,*) " iwpos, ips, ipsize =
", IWPOS, IPS, IPSIZE
124 WRITE(*,*) " header at ioldps =
",
125 & IW(IOLDPS:IOLDPS+KEEP(IXSZ)+5)
126 WRITE(*,*) " header at ips =
",
127 & IW(IPS:IPS+KEEP(IXSZ)+5)
130.GT.
IF (IPS+IPSIZE IWPOS) THEN
132 WRITE(*,*) " ioldps, intsiz, iwpos, liw=
",
133 & IOLDPS, INTSIZ, IWPOS, LIW
134 WRITE(*,*) " iwpos, ips, ipsize =
", IWPOS, IPS, IPSIZE
135 WRITE(*,*) " header at ioldps =
",
136 & IW(IOLDPS:IOLDPS+KEEP(IXSZ)+5)
137 WRITE(*,*) " header at ioldps+intsiz =
",
138 & IW(IOLDPS+INTSIZ:IOLDPS+INTSIZ+KEEP(IXSZ)+5)
139 WRITE(*,*) " header at ips =
",
140 & IW(IPS:IPS+KEEP(IXSZ)+5)
141 WRITE(*,*) " ==========================
"
142 WRITE(*,*) " headers starting at ioldps:
"
144.LE.
DO WHILE (IPS IWPOS)
145 WRITE(*,*) " -> new iw
header at position
" , IPS, ":
",
146 & IW(IPS:IPS+KEEP(IXSZ)+5)
147 IPS = IPS + IW(IPS+XXI)
151 IF ( IW( IPSSHIFT + 2 ) < 0 ) THEN
152 NFRONT = IW( IPSSHIFT )
153.LT.
IF (IW(IPSSHIFT+4) 0) THEN
155 WRITE(*,*) " ips,ipsshift,iwpos=
" ,IPS,IPSSHIFT,IWPOS
156 WRITE(*,*) " header at ips =
", IW(IPS:IPS+KEEP(IXSZ)+5)
158 PTRFAC(IW(IPSSHIFT+4))=PTRFAC(IW(IPSSHIFT+4)) -
161 PTRAST(IW(IPSSHIFT+4))=PTRAST(IW(IPSSHIFT+4))-SIZECB
163 ELSE IF ( IW( IPSSHIFT ) < 0 ) THEN
164.LT.
IF (IW(IPSSHIFT+3) 0) THEN
166 WRITE(*,*) " ips,ipsshift,iwpos=
" ,IPS,IPSSHIFT,IWPOS
167 WRITE(*,*) " header at ips =
", IW(IPS:IPS+KEEP(IXSZ)+5)
169 PTRFAC(IW(IPSSHIFT+3)) = PTRFAC(IW(IPSSHIFT+3))
172 NFRONT = IW( IPSSHIFT ) + IW( IPSSHIFT + 3 )
173.LT.
IF (IW(IPSSHIFT+4) 0) THEN
175 WRITE(*,*) " ips,ipsshift,iwpos=
" ,IPS,IPSSHIFT,IWPOS
176 WRITE(*,*) " header at ips =
", IW(IPS:IPS+KEEP(IXSZ)+5)
178 PTRFAC(IW( IPSSHIFT + 4 )) =
179 & PTRFAC(IW( IPSSHIFT + 4 )) - SIZECB - SIZESHIFT
183.NE.
IF (SIZECB+SIZESHIFT 0_8) THEN
184 DO I=IAPOS+SIZELU-SIZESHIFT, POSFAC-SIZECB-SIZESHIFT-1_8
185 A( I ) = A( I + SIZECB + SIZESHIFT)
189 POSFAC = POSFAC - (SIZECB+SIZESHIFT)
190 LRLU = LRLU + (SIZECB+SIZESHIFT)
191 ITMP8 = (SIZECB+SIZESHIFT) - SIZE_INPLACE
192 LRLUS = LRLUS + ITMP8
193.EQ.
IF (KEEP(405) 0) THEN
194 KEEP8(69) = KEEP8(69) - ITMP8
197 KEEP8(69) = KEEP8(69) - ITMP8
201.AND..EQ.
IF (LRCOMPRESS_PANELKEEP(486)2) THEN
202 CALL ZMUMPS_LOAD_MEM_UPDATE(SSARBR,.FALSE.,
203 & LA-LRLUS,SIZELU-SIZESHIFT,-(SIZECB+SIZESHIFT)+SIZE_INPLACE,
206 CALL ZMUMPS_LOAD_MEM_UPDATE(SSARBR,.FALSE.,
207 & LA-LRLUS,SIZELU,-SIZECB+SIZE_INPLACE,