1 : C MONDE2 SOURCE PV 09/11/05 21:15:23 6535 2 : SUBROUTINE MONDE2(ITTRV,IPPVV,VECTBB,VAL,IVPO, 3 : > NA,IPREL,MULRE,INC,IVS,LLOM,IFIB) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : DIMENSION ITTRV(*),IPPVV(*),VECTBB(*),VAL(*),IVPO(*) 7 : IDEB2=IPPVV(1)*2 8 : IMOI2= IVPO(IDEB2-1) 9 : DO 50 ILM=1,NA 10 : II=IPREL+ILM-1 11 : IDEB22=2*IPPVV(ILM+1) 12 : IMOI1= IVPO(IDEB22-1) 13 : LLOM=IMOI1-IMOI2-1 14 : IF (LLOM.GT.0) THEN 15 : IPOSM=IMOI2-1 16 : DO 20 K=1,MULRE 17 : IPLAC=IVPO(IDEB2)-1 18 : IDEBZ=1 19 : J=II+(K-1)*INC 20 : IPLAC2=J-LLOM-1 21 : IF (ITTRV(K).LE.IVS) THEN 22 : P=0.D0 23 : DO 2 IDEB3=IDEB2,IFIB,2 24 : IMOI=IVPO(IDEB3+2) 25 : ILONZ=IMOI-IPLAC-IDEBZ 26 : IDEBZC=IDEBZ+IPLAC2 27 : IPLAC=IPLAC-IPLAC2 28 : ** DO 1 ISD=IDEBZC,MIN(IDEBZC+ILONZ,J)-1 29 : ** P = P + VECTBB(ISD) * VAL(IPLAC+ISD) 30 : ** 1 CONTINUE 31 : P=P+DDOTPV(MIN(IDEBZC+ILONZ,J)-IDEBZC, 32 : # VECTBB(IDEBZC),VAL(IPLAC+IDEBZC)) 33 : IF (IDEBZ.GE.LLOM) GOTO 3 34 : IDEBZ=IVPO(IDEB3+1)-IPOSM 35 : IPLAC=IMOI-IDEBZ 36 : 2 CONTINUE 37 : 3 CONTINUE 38 : VECTBB(J)=VECTBB(J)-P 39 : ENDIF 40 : 20 CONTINUE 41 : ENDIF 42 : IMOI2=IMOI1 43 : IDEB2=IDEB22 44 : 50 CONTINUE 45 : RETURN 46 : END 47 : 48 : 49 :
© Cast3M 2003 - All rights reserved.
Disclaimer