Télécharger ella24.eso

Retour à la liste

Numérotation des lignes :

  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.  
  154.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales