C SUPDE2 SOURCE CHAT 05/01/13 03:26:46 5004 SUBROUTINE SUPDE2(IPPVV,IVPO,VAL,VECTBB, > NA,inumli,inbine,ipremf,IPREL) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION IPPVV(1),IVPO(1),VAL(1),VECTBB(1) inumli = IPREL NA1 = max(1,(ipremf-inumli+1)) if (NA1 .ne. 1) inumli = ipremf do 20 ii1=NA1,NA aux = 0.D0 ibldeb = ippvv(ii1) iblfin = ippvv(ii1+1) - 1 iposd = ivpo((2*ibldeb)-1) iposf = ivpo((2*(iblfin+1))-1)-1 ilong = iposf - iposd + 1 ideb0 = inumli - ilong do 30 ii2=ibldeb,iblfin icol = ivpo((2*ii2)-1) + ideb0 - iposd + 1 ifc = ivpo((2*(ii2+1))-1) + ideb0 - iposd if (ifc .lt. ipremf) GOTO 30 ideb1 = ivpo(2*ii2) ifin1 = ivpo(2*(ii2+1))-1 if (icol .lt. ipremf) then ideb1 = ideb1+ipremf-icol icol = ipremf end if if (ifc .eq. inumli) ifin1 = ifin1 - 1 if (ideb1 .gt. ifin1) GOTO 31 do 40 ii3=ideb1,ifin1 aux = aux + VECTBB(icol) * VAL(ii3) icol = icol + 1 40 continue 31 continue 30 continue VECTBB(inumli) = VECTBB(inumli) - aux inumli = inumli + 1 if (inumli .gt. inbine) GOTO 10 20 continue 10 continue return end