C MULMAV SOURCE CHAT 05/01/13 01:55:26 5004 SUBROUTINE MULMAV(C1,C2,C3,C4,V,X,N,ICHLI,NLBLI,NBLI) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C C ===================================================================== C SOUS-PROGRAMME FORTRAN APPELE PAR ELFRES C CALCUL DE X ET F EN FONCTION DE V1 ET V2 EN RESOLVANT: C C ( A1 A2 ) (X1) (V1) C ( ) ( ) = ( ) C ( A3 A4 ) (X2) (V2) C C AVEC C1 MATRICE BANDE A1 C C -1 C C2 MATRICE BANDE A2 C -1 -1 -1 C C4 MATRICE (A3-A4*A2 *A1) *A4*A2 C -1 -1 C C3 MATRICE (A3-A4*A2 *A1) C C NLBLI : TABLEAU POUR L' UTILISATION DES MATRICES BANDES C C ICHLI : SI NUL V2 EST NUL (PAS DE CHARGEMENT SUR LA LIAISON) C C CREATION : 04/08/87 C PROGRAMMEUR : GUILBAUD C ===================================================================== C -INC PPARAM -INC CCOPTIO DIMENSION C1(*),C2(*),C3(N,1),C4(N,1),V(*),X(*),NLBLI(2,1),A(6), *B(6) C -1 -1 -1 C 1 - X1=-(A3-A4*A2 *A1) *A4*A2 V1 C DO 20 I=1,N BB=0.D0 DO 10 J=1,N BB=BB+C4(I,J)*V(J) 10 CONTINUE X(I)=-BB 20 CONTINUE C WRITE(IOIMP,*)' X1 ',X1 C WRITE(IOIMP,1000)(X(I),I=1,N) C -1 -1 C 2 - X1=X1-(A3-A4*A2 *A1) *V2 C IF(ICHLI.NE.0) THEN C WRITE(IOIMP,*)' CHARGEMENT ' DO 40 I=1,N BB=X(I) DO 30 J=1,N BB=BB+C3(I,J)*V(J+N) 30 CONTINUE X(I)=BB 40 CONTINUE C WRITE(IOIMP,1000)(X(I),I=1,N) ENDIF C -1 C 3 - X2=A2 *(V1-A1*X1) C NA=0 NB=0 DO 50 NBL =1,NBLI ND1=NLBLI(1,NBL) ND2=NLBLI(2,NBL) C WRITE(IOIMP,*) ' NBL ND1 ND2 ',NBL,ND1,ND2 IF(ND1.EQ.ND2) THEN ND = ND1 NX = ND+N X(NX+1)=C2(NB+1)*(V(ND+1)-C1(NA+1)*X(ND+1)) X(NX+2)=C2(NB+2)*(V(ND+2)-C1(NA+2)*X(ND+2)-C1(NA+3)*X(ND+6)) X(NX+3)=C2(NB+3)*(V(ND+3)-C1(NA+4)*X(ND+3)-C1(NA+5)*X(ND+5)) X(NX+4)=C2(NB+4)*(V(ND+4)-C1(NA+6)*X(ND+4)) X(NX+5)=C2(NB+5)*(V(ND+5)-C1(NA+7)*X(ND+3)-C1(NA+8)*X(ND+5)) X(NX+6)=C2(NB+6)*(V(ND+6)-C1(NA+9)*X(ND+2)-C1(NA+10)*X(ND+6)) C WRITE(IOIMP,*) 'C2 NB ',NB C WRITE(IOIMP,1000)(C2(NB+I),I=1,6) C1000 FORMAT(12(1X,1PE10.3)) C WRITE(IOIMP,*) 'C1 NA ',NA C WRITE(IOIMP,1000)(C1(NA+I),I=1,10) C WRITE(IOIMP,*) 'V ND ',ND C WRITE(IOIMP,1000)(V(ND+I),I=1,6) C WRITE(IOIMP,*) 'X NX ',NX C WRITE(IOIMP,1000)(X(NX+I),I=1,6) NA =NA+10 NB = NB+6 ELSE NX1 = ND1+N NX2 = ND2+N X(NX1+1)=V(ND1+1)-C1(NA+ 1)*X(ND1+1)-C1(NA+11)*X(ND2+1) X(NX1+2)=V(ND1+2)-C1(NA+ 2)*X(ND1+2)-C1(NA+ 3)*X(ND1+6) * -C1(NA+12)*X(ND2+2)-C1(NA+13)*X(ND2+6) X(NX1+3)=V(ND1+3)-C1(NA+ 4)*X(ND1+3)-C1(NA+ 5)*X(ND1+5) * -C1(NA+14)*X(ND2+3)-C1(NA+15)*X(ND2+5) X(NX1+4)=V(ND1+4)-C1(NA+ 6)*X(ND1+4)-C1(NA+16)*X(ND2+4) X(NX1+5)=V(ND1+5)-C1(NA+ 7)*X(ND1+3)-C1(NA+ 8)*X(ND1+5) * -C1(NA+17)*X(ND2+3)-C1(NA+18)*X(ND2+5) X(NX1+6)=V(ND1+6)-C1(NA+ 9)*X(ND1+2)-C1(NA+10)*X(ND1+6) * -C1(NA+19)*X(ND2+2)-C1(NA+20)*X(ND2+6) X(NX2+1)=V(ND2+1)-C1(NA+21)*X(ND1+1)-C1(NA+31)*X(ND2+1) X(NX2+2)=V(ND2+2)-C1(NA+22)*X(ND1+2)-C1(NA+23)*X(ND1+6) * -C1(NA+32)*X(ND2+2)-C1(NA+33)*X(ND2+6) X(NX2+3)=V(ND2+3)-C1(NA+24)*X(ND1+3)-C1(NA+25)*X(ND1+5) * -C1(NA+34)*X(ND2+3)-C1(NA+35)*X(ND2+5) X(NX2+4)=V(ND2+4)-C1(NA+26)*X(ND1+4)-C1(NA+36)*X(ND2+4) X(NX2+5)=V(ND2+5)-C1(NA+27)*X(ND1+3)-C1(NA+28)*X(ND1+5) * -C1(NA+37)*X(ND2+3)-C1(NA+38)*X(ND2+5) X(NX2+6)=V(ND2+6)-C1(NA+29)*X(ND1+2)-C1(NA+30)*X(ND1+6) * -C1(NA+39)*X(ND2+2)-C1(NA+40)*X(ND2+6) C C WRITE(IOIMP,*) ' NBL ',NBL C WRITE(IOIMP,1000) (X(NX1+I),I=1,6),(X(NX2+I),I=1,6) A(1)=C2(NB+ 1)*X(NX1+1)+C2(NB+11)*X(NX2+1) A(2)=C2(NB+ 2)*X(NX1+2)+C2(NB+ 3)*X(NX1+6) * +C2(NB+12)*X(NX2+2)+C2(NB+13)*X(NX2+6) A(3)=C2(NB+ 4)*X(NX1+3)+C2(NB+ 5)*X(NX1+5) * +C2(NB+14)*X(NX2+3)+C2(NB+15)*X(NX2+5) A(4)=C2(NB+ 6)*X(NX1+4)+C2(NB+16)*X(NX2+4) A(5)=C2(NB+ 7)*X(NX1+3)+C2(NB+ 8)*X(NX1+5) * +C2(NB+17)*X(NX2+3)+C2(NB+18)*X(NX2+5) A(6)=C2(NB+ 9)*X(NX1+2)+C2(NB+10)*X(NX1+6) * +C2(NB+19)*X(NX2+2)+C2(NB+20)*X(NX2+6) B(1)=C2(NB+21)*X(NX1+1)+C2(NB+31)*X(NX2+1) B(2)=C2(NB+22)*X(NX1+2)+C2(NB+23)*X(NX1+6) * +C2(NB+32)*X(NX2+2)+C2(NB+33)*X(NX2+6) B(3)=C2(NB+24)*X(NX1+3)+C2(NB+25)*X(NX1+5) * +C2(NB+34)*X(NX2+3)+C2(NB+35)*X(NX2+5) B(4)=C2(NB+26)*X(NX1+4)+C2(NB+36)*X(NX2+4) B(5)=C2(NB+27)*X(NX1+3)+C2(NB+28)*X(NX1+5) * +C2(NB+37)*X(NX2+3)+C2(NB+38)*X(NX2+5) B(6)=C2(NB+29)*X(NX1+2)+C2(NB+30)*X(NX1+6) * +C2(NB+39)*X(NX2+2)+C2(NB+40)*X(NX2+6) DO 45 I=1,6 X(NX1+I)=A(I) X(NX2+I)=B(I) 45 CONTINUE C WRITE(IOIMP,1000)(X(NX1+I),I=1,6),(X(NX2+I),I=1,6) NA=NA+40 NB=NB+40 ENDIF 50 CONTINUE RETURN END