1 : C MULMAV SOURCE CHAT 05/01/13 01:55:26 5004 2 : SUBROUTINE MULMAV(C1,C2,C3,C4,V,X,N,ICHLI,NLBLI,NBLI) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C ===================================================================== 7 : C SOUS-PROGRAMME FORTRAN APPELE PAR ELFRES 8 : C CALCUL DE X ET F EN FONCTION DE V1 ET V2 EN RESOLVANT: 9 : C 10 : C ( A1 A2 ) (X1) (V1) 11 : C ( ) ( ) = ( ) 12 : C ( A3 A4 ) (X2) (V2) 13 : C 14 : C AVEC C1 MATRICE BANDE A1 15 : C 16 : C -1 17 : C C2 MATRICE BANDE A2 18 : C -1 -1 -1 19 : C C4 MATRICE (A3-A4*A2 *A1) *A4*A2 20 : C -1 -1 21 : C C3 MATRICE (A3-A4*A2 *A1) 22 : C 23 : C NLBLI : TABLEAU POUR L' UTILISATION DES MATRICES BANDES 24 : C 25 : C ICHLI : SI NUL V2 EST NUL (PAS DE CHARGEMENT SUR LA LIAISON) 26 : C 27 : C CREATION : 04/08/87 28 : C PROGRAMMEUR : GUILBAUD 29 : C ===================================================================== 30 : C 31 : -INC CCOPTIO 32 : DIMENSION C1(*),C2(*),C3(N,1),C4(N,1),V(*),X(*),NLBLI(2,1),A(6), 33 : *B(6) 34 : C -1 -1 -1 35 : C 1 - X1=-(A3-A4*A2 *A1) *A4*A2 V1 36 : C 37 : DO 20 I=1,N 38 : BB=0.D0 39 : DO 10 J=1,N 40 : BB=BB+C4(I,J)*V(J) 41 : 10 CONTINUE 42 : X(I)=-BB 43 : 20 CONTINUE 44 : C WRITE(IOIMP,*)' X1 ',X1 45 : C WRITE(IOIMP,1000)(X(I),I=1,N) 46 : C -1 -1 47 : C 2 - X1=X1-(A3-A4*A2 *A1) *V2 48 : C 49 : IF(ICHLI.NE.0) THEN 50 : C WRITE(IOIMP,*)' CHARGEMENT ' 51 : DO 40 I=1,N 52 : BB=X(I) 53 : DO 30 J=1,N 54 : BB=BB+C3(I,J)*V(J+N) 55 : 30 CONTINUE 56 : X(I)=BB 57 : 40 CONTINUE 58 : C WRITE(IOIMP,1000)(X(I),I=1,N) 59 : ENDIF 60 : C -1 61 : C 3 - X2=A2 *(V1-A1*X1) 62 : C 63 : NA=0 64 : NB=0 65 : DO 50 NBL =1,NBLI 66 : ND1=NLBLI(1,NBL) 67 : ND2=NLBLI(2,NBL) 68 : C WRITE(IOIMP,*) ' NBL ND1 ND2 ',NBL,ND1,ND2 69 : IF(ND1.EQ.ND2) THEN 70 : ND = ND1 71 : NX = ND+N 72 : X(NX+1)=C2(NB+1)*(V(ND+1)-C1(NA+1)*X(ND+1)) 73 : X(NX+2)=C2(NB+2)*(V(ND+2)-C1(NA+2)*X(ND+2)-C1(NA+3)*X(ND+6)) 74 : X(NX+3)=C2(NB+3)*(V(ND+3)-C1(NA+4)*X(ND+3)-C1(NA+5)*X(ND+5)) 75 : X(NX+4)=C2(NB+4)*(V(ND+4)-C1(NA+6)*X(ND+4)) 76 : X(NX+5)=C2(NB+5)*(V(ND+5)-C1(NA+7)*X(ND+3)-C1(NA+8)*X(ND+5)) 77 : X(NX+6)=C2(NB+6)*(V(ND+6)-C1(NA+9)*X(ND+2)-C1(NA+10)*X(ND+6)) 78 : C WRITE(IOIMP,*) 'C2 NB ',NB 79 : C WRITE(IOIMP,1000)(C2(NB+I),I=1,6) 80 : C1000 FORMAT(12(1X,1PE10.3)) 81 : C WRITE(IOIMP,*) 'C1 NA ',NA 82 : C WRITE(IOIMP,1000)(C1(NA+I),I=1,10) 83 : C WRITE(IOIMP,*) 'V ND ',ND 84 : C WRITE(IOIMP,1000)(V(ND+I),I=1,6) 85 : C WRITE(IOIMP,*) 'X NX ',NX 86 : C WRITE(IOIMP,1000)(X(NX+I),I=1,6) 87 : NA =NA+10 88 : NB = NB+6 89 : ELSE 90 : NX1 = ND1+N 91 : NX2 = ND2+N 92 : X(NX1+1)=V(ND1+1)-C1(NA+ 1)*X(ND1+1)-C1(NA+11)*X(ND2+1) 93 : X(NX1+2)=V(ND1+2)-C1(NA+ 2)*X(ND1+2)-C1(NA+ 3)*X(ND1+6) 94 : * -C1(NA+12)*X(ND2+2)-C1(NA+13)*X(ND2+6) 95 : X(NX1+3)=V(ND1+3)-C1(NA+ 4)*X(ND1+3)-C1(NA+ 5)*X(ND1+5) 96 : * -C1(NA+14)*X(ND2+3)-C1(NA+15)*X(ND2+5) 97 : X(NX1+4)=V(ND1+4)-C1(NA+ 6)*X(ND1+4)-C1(NA+16)*X(ND2+4) 98 : X(NX1+5)=V(ND1+5)-C1(NA+ 7)*X(ND1+3)-C1(NA+ 8)*X(ND1+5) 99 : * -C1(NA+17)*X(ND2+3)-C1(NA+18)*X(ND2+5) 100 : X(NX1+6)=V(ND1+6)-C1(NA+ 9)*X(ND1+2)-C1(NA+10)*X(ND1+6) 101 : * -C1(NA+19)*X(ND2+2)-C1(NA+20)*X(ND2+6) 102 : X(NX2+1)=V(ND2+1)-C1(NA+21)*X(ND1+1)-C1(NA+31)*X(ND2+1) 103 : X(NX2+2)=V(ND2+2)-C1(NA+22)*X(ND1+2)-C1(NA+23)*X(ND1+6) 104 : * -C1(NA+32)*X(ND2+2)-C1(NA+33)*X(ND2+6) 105 : X(NX2+3)=V(ND2+3)-C1(NA+24)*X(ND1+3)-C1(NA+25)*X(ND1+5) 106 : * -C1(NA+34)*X(ND2+3)-C1(NA+35)*X(ND2+5) 107 : X(NX2+4)=V(ND2+4)-C1(NA+26)*X(ND1+4)-C1(NA+36)*X(ND2+4) 108 : X(NX2+5)=V(ND2+5)-C1(NA+27)*X(ND1+3)-C1(NA+28)*X(ND1+5) 109 : * -C1(NA+37)*X(ND2+3)-C1(NA+38)*X(ND2+5) 110 : X(NX2+6)=V(ND2+6)-C1(NA+29)*X(ND1+2)-C1(NA+30)*X(ND1+6) 111 : * -C1(NA+39)*X(ND2+2)-C1(NA+40)*X(ND2+6) 112 : C 113 : C WRITE(IOIMP,*) ' NBL ',NBL 114 : C WRITE(IOIMP,1000) (X(NX1+I),I=1,6),(X(NX2+I),I=1,6) 115 : A(1)=C2(NB+ 1)*X(NX1+1)+C2(NB+11)*X(NX2+1) 116 : A(2)=C2(NB+ 2)*X(NX1+2)+C2(NB+ 3)*X(NX1+6) 117 : * +C2(NB+12)*X(NX2+2)+C2(NB+13)*X(NX2+6) 118 : A(3)=C2(NB+ 4)*X(NX1+3)+C2(NB+ 5)*X(NX1+5) 119 : * +C2(NB+14)*X(NX2+3)+C2(NB+15)*X(NX2+5) 120 : A(4)=C2(NB+ 6)*X(NX1+4)+C2(NB+16)*X(NX2+4) 121 : A(5)=C2(NB+ 7)*X(NX1+3)+C2(NB+ 8)*X(NX1+5) 122 : * +C2(NB+17)*X(NX2+3)+C2(NB+18)*X(NX2+5) 123 : A(6)=C2(NB+ 9)*X(NX1+2)+C2(NB+10)*X(NX1+6) 124 : * +C2(NB+19)*X(NX2+2)+C2(NB+20)*X(NX2+6) 125 : B(1)=C2(NB+21)*X(NX1+1)+C2(NB+31)*X(NX2+1) 126 : B(2)=C2(NB+22)*X(NX1+2)+C2(NB+23)*X(NX1+6) 127 : * +C2(NB+32)*X(NX2+2)+C2(NB+33)*X(NX2+6) 128 : B(3)=C2(NB+24)*X(NX1+3)+C2(NB+25)*X(NX1+5) 129 : * +C2(NB+34)*X(NX2+3)+C2(NB+35)*X(NX2+5) 130 : B(4)=C2(NB+26)*X(NX1+4)+C2(NB+36)*X(NX2+4) 131 : B(5)=C2(NB+27)*X(NX1+3)+C2(NB+28)*X(NX1+5) 132 : * +C2(NB+37)*X(NX2+3)+C2(NB+38)*X(NX2+5) 133 : B(6)=C2(NB+29)*X(NX1+2)+C2(NB+30)*X(NX1+6) 134 : * +C2(NB+39)*X(NX2+2)+C2(NB+40)*X(NX2+6) 135 : DO 45 I=1,6 136 : X(NX1+I)=A(I) 137 : X(NX2+I)=B(I) 138 : 45 CONTINUE 139 : C WRITE(IOIMP,1000)(X(NX1+I),I=1,6),(X(NX2+I),I=1,6) 140 : NA=NA+40 141 : NB=NB+40 142 : ENDIF 143 : 50 CONTINUE 144 : RETURN 145 : END 146 :
© Cast3M 2003 - All rights reserved.
Disclaimer