1 : C ELFLI1 SOURCE CHAT 05/01/12 23:32:09 5004 2 : SUBROUTINE ELFLI1(C1,C2,C3,C4,N,B,IS,ISING,EPS,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 ELFLIA 8 : C CALCUL DES MATRICES C3 ET C4 DE DIMENSION N 9 : C 10 : C EN ENTREE : 11 : C 12 : C C1 MATRICE BANDE A1 13 : C -1 14 : C C2 MATRICE BANDE A2 15 : C C3 MATRICE A3 16 : C C4 MATRICE A4 17 : C B,IS TABLEAU DE TRAVAIL POUR L'INVERSION 18 : C ISING = 1 SI MATRICE SINGULIERE 0 SINON 19 : C EPS PRECISION 20 : C NLBLI TABLEAU POUR L'UTILISATION DES MATRICES BANDES 21 : C 22 : C EN SORTIE : 23 : C -1 -1 24 : C C3 MATRICE (A3-A4*A2 *A1) 25 : C -1 -1 -1 26 : C C4 MATRICE (A3-A4*A2 *A1) *A4*A2 27 : C 28 : C CREATION : 04/08/87 29 : C PROGRAMMEUR : GUILBAUD 30 : C ===================================================================== 31 : C 32 : -INC CCOPTIO 33 : DIMENSION C1(*),C2(*),C3(N,1),C4(N,1),B(*),IS(1),NLBLI(2,1) 34 : C -1 35 : C 1 - A4 = A4 * A2 36 : C 37 : C WRITE(IOIMP,*) ' A4 * A2-1 ' 38 : DO 20 I=1,N 39 : NB=0 40 : DO 10 NBL=1,NBLI 41 : NX1=NLBLI(1,NBL) 42 : NX2=NLBLI(2,NBL) 43 : IF(NX1.EQ.NX2) THEN 44 : C4(I,NX1+1)=C2(NB+1)*C4(I,NX1+1) 45 : C4(I,NX1+2)=C2(NB+2)*C4(I,NX1+2) 46 : C4(I,NX1+3)=C2(NB+3)*C4(I,NX1+3) 47 : C4(I,NX1+4)=C2(NB+4)*C4(I,NX1+4) 48 : C4(I,NX1+5)=C2(NB+5)*C4(I,NX1+5) 49 : C4(I,NX1+6)=C2(NB+6)*C4(I,NX1+6) 50 : NB=NB+6 51 : ELSE 52 : B( 1)=C2(NB+ 1)*C4(I,NX1+1)+C2(NB+21)*C4(I,NX2+1) 53 : B( 2)=C2(NB+ 2)*C4(I,NX1+2)+C2(NB+ 9)*C4(I,NX1+6) 54 : * +C2(NB+22)*C4(I,NX2+2)+C2(NB+29)*C4(I,NX2+6) 55 : B( 3)=C2(NB+ 4)*C4(I,NX1+3)+C2(NB+ 7)*C4(I,NX1+5) 56 : * +C2(NB+24)*C4(I,NX2+3)+C2(NB+27)*C4(I,NX2+5) 57 : B( 4)=C2(NB+ 6)*C4(I,NX1+4)+C2(NB+26)*C4(I,NX2+4) 58 : B( 5)=C2(NB+ 5)*C4(I,NX1+3)+C2(NB+ 8)*C4(I,NX1+5) 59 : * +C2(NB+25)*C4(I,NX2+3)+C2(NB+28)*C4(I,NX2+5) 60 : B( 6)=C2(NB+ 3)*C4(I,NX1+2)+C2(NB+10)*C4(I,NX1+6) 61 : * +C2(NB+23)*C4(I,NX2+2)+C2(NB+30)*C4(I,NX2+6) 62 : B( 7)=C2(NB+11)*C4(I,NX1+1)+C2(NB+31)*C4(I,NX2+1) 63 : B( 8)=C2(NB+12)*C4(I,NX1+2)+C2(NB+19)*C4(I,NX1+6) 64 : * +C2(NB+32)*C4(I,NX2+2)+C2(NB+39)*C4(I,NX2+6) 65 : B( 9)=C2(NB+14)*C4(I,NX1+3)+C2(NB+17)*C4(I,NX1+5) 66 : * +C2(NB+34)*C4(I,NX2+3)+C2(NB+37)*C4(I,NX2+5) 67 : B(10)=C2(NB+16)*C4(I,NX1+4)+C2(NB+36)*C4(I,NX2+4) 68 : B(11)=C2(NB+15)*C4(I,NX1+3)+C2(NB+18)*C4(I,NX1+5) 69 : * +C2(NB+35)*C4(I,NX2+3)+C2(NB+38)*C4(I,NX2+5) 70 : B(12)=C2(NB+13)*C4(I,NX1+2)+C2(NB+20)*C4(I,NX1+6) 71 : * +C2(NB+33)*C4(I,NX2+2)+C2(NB+40)*C4(I,NX2+6) 72 : C 73 : C4(I,NX1+1)=B( 1) 74 : C4(I,NX1+2)=B( 2) 75 : C4(I,NX1+3)=B( 3) 76 : C4(I,NX1+4)=B( 4) 77 : C4(I,NX1+5)=B( 5) 78 : C4(I,NX1+6)=B( 6) 79 : C4(I,NX2+1)=B( 7) 80 : C4(I,NX2+2)=B( 8) 81 : C4(I,NX2+3)=B( 9) 82 : C4(I,NX2+4)=B(10) 83 : C4(I,NX2+5)=B(11) 84 : C4(I,NX2+6)=B(12) 85 : C WRITE(IOIMP,*) I 86 : C WRITE(IOIMP,1000) (C4(I,NX1+K),K=1,6),(C4(I,NX2+K),K=1,6) 87 : C1000 FORMAT(12(1X,1PE10.3)) 88 : NB=NB+40 89 : ENDIF 90 : 10 CONTINUE 91 : 20 CONTINUE 92 : C -1 93 : C 2 - A3 = A3 - A4 * A2 * A1 94 : C 95 : C WRITE(IOIMP,*) ' A3-A4 * A2-1 *A1 ' 96 : DO 40 I=1,N 97 : NA=0 98 : DO 30 NBL=1,NBLI 99 : NX1=NLBLI(1,NBL) 100 : NX2=NLBLI(2,NBL) 101 : NX=NX1 102 : IF(NX1.EQ.NX2) THEN 103 : C3(I,NX+1)=C3(I,NX+1)-C1(NA+1)*C4(I,NX+1) 104 : C3(I,NX+2)=C3(I,NX+2)-C1(NA+2)*C4(I,NX+2)-C1(NA+9)*C4(I,NX+6) 105 : C3(I,NX+3)=C3(I,NX+3)-C1(NA+4)*C4(I,NX+3)-C1(NA+7)*C4(I,NX+5) 106 : C3(I,NX+4)=C3(I,NX+4)-C1(NA+6)*C4(I,NX+4) 107 : C3(I,NX+5)=C3(I,NX+5)-C1(NA+5)*C4(I,NX+3)-C1(NA+8)*C4(I,NX+5) 108 : C3(I,NX+6)=C3(I,NX+6)-C1(NA+3)*C4(I,NX+2)-C1(NA+10)*C4(I,NX+6) 109 : NA=NA+10 110 : ELSE 111 : C3(I,NX+1)=C3(I,NX+1)-C1(NA+ 1)*C4(I,NX+1)-C1(NA+21)*C4(I,NX2+1) 112 : C3(I,NX+2)=C3(I,NX+2)-C1(NA+ 2)*C4(I,NX+2)-C1(NA+ 9)*C4(I,NX+6) 113 : * -C1(NA+22)*C4(I,NX2+2)-C1(NA+29)*C4(I,NX2+6) 114 : C3(I,NX+3)=C3(I,NX+3)-C1(NA+ 4)*C4(I,NX+3)-C1(NA+ 7)*C4(I,NX+5) 115 : * -C1(NA+24)*C4(I,NX2+3)-C1(NA+27)*C4(I,NX2+5) 116 : C3(I,NX+4)=C3(I,NX+4)-C1(NA+ 6)*C4(I,NX+4)-C1(NA+26)*C4(I,NX2+4) 117 : C3(I,NX+5)=C3(I,NX+5)-C1(NA+ 5)*C4(I,NX+3)-C1(NA+ 8)*C4(I,NX+5) 118 : * -C1(NA+25)*C4(I,NX2+3)-C1(NA+28)*C4(I,NX2+5) 119 : C3(I,NX+6)=C3(I,NX+6)-C1(NA+ 3)*C4(I,NX+2)-C1(NA+10)*C4(I,NX+6) 120 : * -C1(NA+23)*C4(I,NX2+2)-C1(NA+30)*C4(I,NX2+6) 121 : C3(I,NX2+1)=C3(I,NX2+1)-C1(NA+11)*C4(I,NX+1)-C1(NA+31)*C4(I,NX2+1) 122 : C3(I,NX2+2)=C3(I,NX2+2)-C1(NA+12)*C4(I,NX+2)-C1(NA+19)*C4(I,NX+6) 123 : * -C1(NA+32)*C4(I,NX2+2)-C1(NA+39)*C4(I,NX2+6) 124 : C3(I,NX2+3)=C3(I,NX2+3)-C1(NA+14)*C4(I,NX+3)-C1(NA+17)*C4(I,NX+5) 125 : * -C1(NA+34)*C4(I,NX2+3)-C1(NA+37)*C4(I,NX2+5) 126 : C3(I,NX2+4)=C3(I,NX2+4)-C1(NA+16)*C4(I,NX+4)-C1(NA+36)*C4(I,NX2+4) 127 : C3(I,NX2+5)=C3(I,NX2+5)-C1(NA+15)*C4(I,NX+3)-C1(NA+18)*C4(I,NX+5) 128 : * -C1(NA+35)*C4(I,NX2+3)-C1(NA+38)*C4(I,NX2+5) 129 : C3(I,NX2+6)=C3(I,NX2+6)-C1(NA+13)*C4(I,NX+2)-C1(NA+20)*C4(I,NX+6) 130 : * -C1(NA+33)*C4(I,NX2+2)-C1(NA+40)*C4(I,NX2+6) 131 : C WRITE(IOIMP,*) I 132 : C WRITE(IOIMP,1000) (C3(I,NX1+K),K=1,6),(C3(I,NX2+K),K=1,6) 133 : NA=NA+40 134 : ENDIF 135 : 30 CONTINUE 136 : 40 CONTINUE 137 : C DO 35 I=1,N 138 : C WRITE(6,1002) (C3(I,J),J=1,N) 139 : C1002 FORMAT(12(1X,1PE10.3)) 140 : C 35 CONTINUE 141 : C 142 : C -1 143 : C 3 - C3 = A3 144 : C 144 : CALL INVER(C3,N,ISING,B,IS,EPS) 145 : IF(ISING.EQ.1) RETURN 146 : C -1 -1 147 : C 2 - C4 = A3 * A4 * A2 148 : C 149 : DO 80 J=1,N 150 : DO 60 I=1,N 151 : AA=0.D0 152 : DO 50 K=1,N 153 : AA=AA+C3(I,K)*C4(K,J) 154 : 50 CONTINUE 155 : B(I)=AA 156 : 60 CONTINUE 157 : DO 70 I=1,N 158 : C4(I,J)=B(I) 159 : 70 CONTINUE 160 : 80 CONTINUE 161 : C 162 : RETURN 163 : END 164 :
© Cast3M 2003 - All rights reserved.
Disclaimer