1 : C SUPDE1 SOURCE CHAT 05/01/13 03:26:41 5004 2 : SUBROUTINE SUPDE1(IPPVV,IVPO,VAL,VECTBB,VECTAA, 3 : > na,inumli,inbine,iprel,ifib) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : DIMENSION IPPVV(1),IVPO(1),VAL(1),VECTBB(1),VECTAA(1) 7 : c procedure complémentaire de SUPDEP 8 : c 9 : IMOI1 = IVPO(2*IPPVV(NA+1)-1) 10 : DO 50 ILM=NA,1,-1 11 : II=IPREL-1+ILM 12 : IDEB2=IPPVV(ILM)*2 13 : IMOI2= IVPO(IDEB2-1) 14 : LLOM=IMOI1-IMOI2-1 15 : IF (LLOM.GT.0) THEN 16 : IPOSM=IMOI2-1 17 : VKON=VECTAA(II) 18 : IPLAC=IVPO(IDEB2)-1 19 : IDEBZ=1 20 : IPLAC2=II-LLOM-1 21 : DO 2 IDEB3=IDEB2,IFIB,2 22 : IMOI = IVPO ( IDEB3 +2) 23 : ILONZ=IMOI -IPLAC-IDEBZ 24 : IPLAC=IPLAC-IPLAC2 25 : IDEBZC=IDEBZ+IPLAC2 26 : ifu = MIN(IDEBZC+ILONZ,II)-1 27 : ifu = min( ifu,inbine) 28 : DO 1 L=IDEBZC,ifu 29 : VECTBB(L)=VECTBB(L)-VKON*VAL(IPLAC+L) 30 : 1 CONTINUE 31 : IF (IDEBZ.GE.LLOM) GOTO 3 32 : IDEBZ=IVPO(IDEB3+1)-IPOSM 33 : IPLAC=IMOI-IDEBZ 34 : 2 CONTINUE 35 : 3 CONTINUE 36 : ENDIF 37 : IMOI1=IMOI2 38 : if ((inumli.le.(inbine+1)) .and. (inumli .ne. 1)) 39 : & VECTAA(inumli-1) = VECTBB(inumli-1) 40 : inumli = inumli - 1 41 : 50 CONTINUE 42 : 43 : 44 : 45 : return 46 : end 47 : 48 : 49 : 50 :
© Cast3M 2003 - All rights reserved.
Disclaimer