1 : C SUPDE2 SOURCE CHAT 05/01/13 03:26:46 5004 2 : SUBROUTINE SUPDE2(IPPVV,IVPO,VAL,VECTBB, 3 : > NA,inumli,inbine,ipremf,IPREL) 4 : 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : DIMENSION IPPVV(1),IVPO(1),VAL(1),VECTBB(1) 8 : 9 : inumli = IPREL 10 : NA1 = max(1,(ipremf-inumli+1)) 11 : if (NA1 .ne. 1) inumli = ipremf 12 : do 20 ii1=NA1,NA 13 : aux = 0.D0 14 : ibldeb = ippvv(ii1) 15 : iblfin = ippvv(ii1+1) - 1 16 : iposd = ivpo((2*ibldeb)-1) 17 : iposf = ivpo((2*(iblfin+1))-1)-1 18 : ilong = iposf - iposd + 1 19 : ideb0 = inumli - ilong 20 : do 30 ii2=ibldeb,iblfin 21 : icol = ivpo((2*ii2)-1) + ideb0 - iposd + 1 22 : ifc = ivpo((2*(ii2+1))-1) + ideb0 - iposd 23 : if (ifc .lt. ipremf) GOTO 30 24 : ideb1 = ivpo(2*ii2) 25 : ifin1 = ivpo(2*(ii2+1))-1 26 : if (icol .lt. ipremf) then 27 : ideb1 = ideb1+ipremf-icol 28 : icol = ipremf 29 : end if 30 : if (ifc .eq. inumli) ifin1 = ifin1 - 1 31 : if (ideb1 .gt. ifin1) GOTO 31 32 : do 40 ii3=ideb1,ifin1 33 : aux = aux + VECTBB(icol) * VAL(ii3) 34 : icol = icol + 1 35 : 40 continue 36 : 31 continue 37 : 30 continue 38 : VECTBB(inumli) = VECTBB(inumli) - aux 39 : inumli = inumli + 1 40 : if (inumli .gt. inbine) GOTO 10 41 : 20 continue 42 : 10 continue 43 : return 44 : end 45 : 46 : 47 : 48 :
© Cast3M 2003 - All rights reserved.
Disclaimer