1 : C MONDE1 SOURCE PV 09/11/05 21:15:21 6535 2 : SUBROUTINE MONDE1 (IPPVV,VECTBB,VAL,IVPO, 3 : > NA,IPREL,MULRE,INC,IFIB) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : DIMENSION VECTBB(1),VAL(1),IVPO(1),IPPVV(1) 7 : IMOI1 = IVPO(2*IPPVV(NA+1)-1) 8 : DO 50 ILM=NA,1,-1 9 : II=IPREL-1+ILM 10 : IDEB2=IPPVV(ILM)*2 11 : IMOI2= IVPO(IDEB2-1) 12 : LLOM=IMOI1-IMOI2-1 13 : IF (LLOM.GT.0) THEN 14 : IPOSM=IMOI2-1 15 : VKON=VECTBB(II) 16 : IPLAC=IVPO(IDEB2)-1 17 : IDEBZ=1 18 : IPLAC2=II-LLOM-1 19 : DO 2 IDEB3=IDEB2,IFIB,2 20 : IMOI = IVPO ( IDEB3 +2) 21 : ILONZ=IMOI -IPLAC-IDEBZ 22 : IPLAC=IPLAC-IPLAC2 23 : IDEBZC=IDEBZ+IPLAC2 24 : DO 1 L=IDEBZC,MIN(IDEBZC+ILONZ,II)-1-3,4 25 : VECTBB(L)=VECTBB(L)-VKON*VAL(IPLAC+L) 26 : VECTBB(L+1)=VECTBB(L+1)-VKON*VAL(IPLAC+L+1) 27 : VECTBB(L+2)=VECTBB(L+2)-VKON*VAL(IPLAC+L+2) 28 : VECTBB(L+3)=VECTBB(L+3)-VKON*VAL(IPLAC+L+3) 29 : 1 CONTINUE 30 : LDEB=L 31 : DO L=LDEB,MIN(IDEBZC+ILONZ,II)-1 32 : VECTBB(L)=VECTBB(L)-VKON*VAL(IPLAC+L) 33 : ENDDO 34 : IF (IDEBZ.GE.LLOM) GOTO 3 35 : IDEBZ=IVPO(IDEB3+1)-IPOSM 36 : IPLAC=IMOI-IDEBZ 37 : 2 CONTINUE 38 : 3 CONTINUE 39 : IF (MULRE.EQ.1) GOTO 60 40 : IPLAC=IVPO(IDEB2)-1 41 : IDEBZ=1 42 : DO 12 IDEB3=IDEB2,IFIB,2 43 : IMOI = IVPO ( IDEB3 +2) 44 : ILONZ=IMOI -IPLAC-IDEBZ 45 : IPLAC=IPLAC-IPLAC2 46 : IDEBZC=IDEBZ+IPLAC2 47 : LHAU=MIN(IDEBZC+ILONZ,II)-1 48 : DO 15 K=INC,(MULRE-1)*INC,INC 49 : VKON=VECTBB(II+K) 50 : DO 11 L=IDEBZC,LHAU-3,4 51 : J=L+K 52 : VECTBB(J)=VECTBB(J)-VKON*VAL(IPLAC+L) 53 : VECTBB(J+1)=VECTBB(J+1)-VKON*VAL(IPLAC+L+1) 54 : VECTBB(J+2)=VECTBB(J+2)-VKON*VAL(IPLAC+L+2) 55 : VECTBB(J+3)=VECTBB(J+3)-VKON*VAL(IPLAC+L+3) 56 : 11 CONTINUE 57 : ldeb=l 58 : DO L=ldeb,LHAU 59 : J=L+K 60 : VECTBB(J)=VECTBB(J)-VKON*VAL(IPLAC+L) 61 : ENDDO 62 : 15 CONTINUE 63 : IF (IDEBZ.GE.LLOM) GOTO 13 64 : IDEBZ=IVPO(IDEB3+1)-IPOSM 65 : IPLAC=IMOI-IDEBZ 66 : 12 CONTINUE 67 : 13 CONTINUE 68 : 60 CONTINUE 69 : ENDIF 70 : IMOI1=IMOI2 71 : 50 CONTINUE 72 : RETURN 73 : END 74 : 75 : 76 :
© Cast3M 2003 - All rights reserved.
Disclaimer