1 : C ELLA24 SOURCE CHAT 05/01/12 23:34:26 5004 2 : SUBROUTINE ELLA24(INP,IFRQ,NP,COOR,GAMA,ALPHAI,ZC1) 3 : C 4 : C REMPLISSAGE DU TABLEAU ZC1 5 : C CONVERSION REPERE LOCAL -> REPERE GLOBAL 6 : C 7 : C ENTREE 8 : C - INP : NUMERO DE LA POUTRE 1 < INP < NP 9 : C - IFRQ : NUMERO DU PAS EN FREQENCE 10 : C - NP : NOMBRE DE TUYAUX 11 : C - COOR : TABLEAU DES COORDONNEES 12 : C - GAMA : TABLEAU DES COMPOSANTES DU VECTEUR Oy LOCAL 13 : C - ALPHAI : TABLEAU CONTENANT LES COEFFICIENTS EXPERIMENTAUX 14 : C EN LOCAL 15 : C 16 : C SORTIE : 17 : C - ZC1 : MATRICE CONTENANT LES COEFFICIENTS DANS LE REPERE 18 : C GLOBAL 19 : C 20 : C TABLEAUX LOCAUX DE TRAVAIL 21 : C - ZROTA : MATRICE DE ROTATION POUR L'ELEMENT EXPERIMENTAL 22 : C 23 : IMPLICIT INTEGER(I-N) 24 : COMPLEX*16 ALPHAI,ZC1,ZROTA,ZR,CZERO,CPLXUN 25 : REAL*8 X1,Y1,Z1,X2,Y2,Z2,XL, 26 : & XI1,XI2,XI3, 27 : & XJ1,XJ2,XJ3, 28 : & XK1,XK2,XK3, 29 : & GX,GY,GZ,GG,DELTA,DET, 30 : & COOR,GAMA 31 : C 32 : INTEGER INP,N1,N2,IFRQ 33 : C 34 : DIMENSION ALPHAI(14,28,NP,*),ZC1(14,28),ZROTA(28,28),ZR(3,3) 35 : DIMENSION COOR(3,*),GAMA(3,*) 36 : C 37 : CZERO=CMPLX(0.D0,0.D0) 38 : CPLXUN=CMPLX(1.D0,0.D0) 39 : C 40 : N1 = 2*INP-1 41 : N2 = 2*INP 42 : X1 = COOR (1,N1) 43 : Y1 = COOR (2,N1) 44 : Z1 = COOR (3,N1) 45 : X2 = COOR (1,N2) 46 : Y2 = COOR (2,N2) 47 : Z2 = COOR (3,N2) 48 : C 49 : XL = SQRT((X2-X1)**2 + (Y2-Y1)**2 + (Z2-Z1)**2) 50 : C 51 : C ------------------------------ VECTEUR UNITAIRE OX REPERE LOCALE 52 : C --------------------------------- 53 : XI1 = (X2-X1)/XL 54 : XI2 = (Y2-Y1)/XL 55 : XI3 = (Z2-Z1)/XL 56 : C 57 : C ------------------------- VECTEUR UNITAIRE OY REPERE LOCALE 58 : C --------------------------------- 59 : GX = GAMA(1,INP) 60 : GY = GAMA(2,INP) 61 : GZ = GAMA(3,INP) 62 : GG = SQRT(GX*GX + GY*GY + GZ*GZ) 63 : GX = GX/GG 64 : GY = GY/GG 65 : GZ = GZ/GG 66 : C 67 : DELTA = SQRT (1.D0 - (XI1*GX + XI2*GY + XI3*GZ)**2) 68 : C 69 : DET=-(GX*XI3-GZ*XI1)**2-(GY*XI1-GX*XI2)**2-(GY*XI3-GZ*XI2)**2 70 : C 71 : IF (ABS(DET).LT.1.D-12) THEN 72 : XJ1 = -XI2 73 : XJ2 = 0.D0 74 : XJ3 = 0.D0 75 : ELSE 76 : XJ1 = (XI2*(GY*XI1-GX*XI2)-XI3*(GX*XI3-GZ*XI1))*DELTA/DET 77 : XJ2 = (XI3*(GZ*XI2-GY*XI3)-XI1*(GY*XI1-GX*XI2))*DELTA/DET 78 : XJ3 = (XI1*(GX*XI3-GZ*XI1)-XI2*(GZ*XI2-GY*XI3))*DELTA/DET 79 : END IF 80 : C 81 : C ---------------------------- VECTEUR UNITAIRE OZ REPERE LOCALE 82 : C --------------------------------- 83 : XK1 = XI2*XJ3 - XI3*XJ2 84 : XK2 = XI3*XJ1 - XI1*XJ3 85 : XK3 = XI1*XJ2 - XI2*XJ1 86 : C 87 : ZR(1,1) = CMPLX(XJ2*XK3 - XJ3*XK2) 88 : ZR(1,2) = CMPLX(XJ3*XK1 - XJ1*XK3) 89 : ZR(1,3) = CMPLX(XJ1*XK2 - XJ2*XK1) 90 : ZR(2,1) = CMPLX(XI3*XK2 - XI2*XK3) 91 : ZR(2,2) = CMPLX(XI1*XK3 - XI3*XK1) 92 : ZR(2,3) = CMPLX(XI2*XK1 - XI1*XK2) 93 : ZR(3,1) = CMPLX(XI2*XJ3 - XI3*XJ2) 94 : ZR(3,2) = CMPLX(XI3*XJ1 - XI1*XJ3) 95 : ZR(3,3) = CMPLX(XI1*XJ2 - XI2*XJ1) 96 : C 97 : C INITIALISATION DE LA MATRICE ZROTA A ZERO 98 : C 99 : DO 20 I=1,28 100 : DO 10 J=1,28 101 : ZROTA(I,J)=CZERO 102 : 10 CONTINUE 103 : 20 CONTINUE 104 : C 105 : C REMPLISSAGE DE LA PARTIE SUPERIEURE GAUCHE 106 : C 107 : DO 50 IBLOC=1,4 108 : DO 40 I=1,3 109 : I1=(IBLOC-1)*3+I 110 : DO 30 J=1,3 111 : J1=(IBLOC-1)*3+J 112 : ZROTA(I1,J1)=ZR(I,J) 113 : 30 CONTINUE 114 : 40 CONTINUE 115 : 50 CONTINUE 116 : ZROTA(13,13)=CPLXUN 117 : ZROTA(14,14)=CPLXUN 118 : C 119 : C REMPLISSAGE DE LA PARTIE INFERIEURE DROITE 120 : C 121 : DO 80 IBLOC=5,8 122 : DO 70 I=1,3 123 : I1=(IBLOC-1)*3+I+2 124 : DO 60 J=1,3 125 : J1=(IBLOC-1)*3+J+2 126 : ZROTA(I1,J1)=ZR(I,J) 127 : 60 CONTINUE 128 : 70 CONTINUE 129 : 80 CONTINUE 130 : C 131 : ZROTA(27,27)=CPLXUN 132 : ZROTA(28,28)=CPLXUN 133 : C 134 : C INITIALISATION DE LA MATRICE ZC1 A ZERO 135 : C 136 : DO 100 I=1,14 137 : DO 90 J=1,28 138 : ZC1(I,J)=CZERO 139 : 90 CONTINUE 140 : 100 CONTINUE 141 : C 142 : DO 130 I=1,14 143 : DO 120 J=1,28 144 : DO 110 K=1,28 145 : ZC1(I,J)=ZC1(I,J)+ALPHAI(I,K,INP,IFRQ)*ZROTA(K,J) 146 : 110 CONTINUE 147 : 120 CONTINUE 148 : 130 CONTINUE 149 : C 150 : RETURN 151 : END 152 : 153 :
© Cast3M 2003 - All rights reserved.
Disclaimer