Sources Esope | Cast3M

ella24
C ELLA24    SOURCE    PV        22/04/19    16:18:04     11344          
      SUBROUTINE ELLA24(INP,IFRQ,NP,COOR,GAMA,ALPHAI,ZC1)
C
C     REMPLISSAGE DU TABLEAU ZC1
C     CONVERSION     REPERE LOCAL -> REPERE GLOBAL
C
C     ENTREE
C           - INP  : NUMERO DE LA POUTRE 1 &lt; INP &lt; NP
C           - IFRQ : NUMERO DU PAS EN FREQENCE
C           - NP   : NOMBRE DE TUYAUX
C           - COOR   : TABLEAU DES COORDONNEES
C           - GAMA   : TABLEAU DES COMPOSANTES DU VECTEUR Oy LOCAL
C           - ALPHAI : TABLEAU CONTENANT LES COEFFICIENTS EXPERIMENTAUX
C                      EN LOCAL
C
C     SORTIE :
C           - ZC1    : MATRICE CONTENANT LES COEFFICIENTS DANS LE REPERE
C                      GLOBAL
C
C     TABLEAUX LOCAUX DE TRAVAIL
C           - ZROTA  : MATRICE DE ROTATION POUR L'ELEMENT EXPERIMENTAL
C
      IMPLICIT INTEGER(I-N)
      COMPLEX*16 ALPHAI,ZC1,ZROTA,ZR(3,3),CZERO,CPLXUN
      REAL*8           X1,Y1,Z1,X2,Y2,Z2,XL,
     &                 XI1,XI2,XI3,
     &                 XJ1,XJ2,XJ3,
     &                 XK1,XK2,XK3,
     &                 GX,GY,GZ,GG,DELTA,DET,
     &                 COOR,GAMA
C
      INTEGER INP,N1,N2,IFRQ
C
      DIMENSION ALPHAI(14,28,NP,*),ZC1(14,28),ZROTA(28,28) 
      DIMENSION COOR(3,*),GAMA(3,*)
C
      CZERO=CMPLX(0.D0,0.D0,kind(1.d0))
      CPLXUN=CMPLX(1.D0,0.D0,kind(1.d0))
C
      N1  = 2*INP-1
      N2  = 2*INP
      X1  = COOR (1,N1)
      Y1  = COOR (2,N1)
      Z1  = COOR (3,N1)
      X2  = COOR (1,N2)
      Y2  = COOR (2,N2)
      Z2  = COOR (3,N2)
C
      XL = SQRT((X2-X1)**2 + (Y2-Y1)**2 + (Z2-Z1)**2)
C
C ------------------------------ VECTEUR UNITAIRE OX REPERE LOCALE
C                                ---------------------------------
      XI1 = (X2-X1)/XL
      XI2 = (Y2-Y1)/XL
      XI3 = (Z2-Z1)/XL
C
C ------------------------- VECTEUR UNITAIRE OY REPERE LOCALE
C                           ---------------------------------
      GX = GAMA(1,INP)
      GY = GAMA(2,INP)
      GZ = GAMA(3,INP)
      GG = SQRT(GX*GX + GY*GY + GZ*GZ)
      GX = GX/GG
      GY = GY/GG
      GZ = GZ/GG
C
      DELTA = SQRT (1.D0 - (XI1*GX + XI2*GY + XI3*GZ)**2)
C
      DET=-(GX*XI3-GZ*XI1)**2-(GY*XI1-GX*XI2)**2-(GY*XI3-GZ*XI2)**2
C
      IF (ABS(DET).LT.1.D-12) THEN
           XJ1 = -XI2
           XJ2 = 0.D0
           XJ3 = 0.D0
      ELSE
           XJ1 = (XI2*(GY*XI1-GX*XI2)-XI3*(GX*XI3-GZ*XI1))*DELTA/DET
           XJ2 = (XI3*(GZ*XI2-GY*XI3)-XI1*(GY*XI1-GX*XI2))*DELTA/DET
           XJ3 = (XI1*(GX*XI3-GZ*XI1)-XI2*(GZ*XI2-GY*XI3))*DELTA/DET
      END IF
C
C ---------------------------- VECTEUR UNITAIRE OZ REPERE LOCALE
C                              ---------------------------------
      XK1 = XI2*XJ3 - XI3*XJ2
      XK2 = XI3*XJ1 - XI1*XJ3
      XK3 = XI1*XJ2 - XI2*XJ1
C
      ZR(1,1) = CMPLX(XJ2*XK3 - XJ3*XK2,0.D0,kind(1.d0))
      ZR(1,2) = CMPLX(XJ3*XK1 - XJ1*XK3,0.D0,kind(1.d0))
      ZR(1,3) = CMPLX(XJ1*XK2 - XJ2*XK1,0.D0,kind(1.d0))
      ZR(2,1) = CMPLX(XI3*XK2 - XI2*XK3,0.D0,kind(1.d0))
      ZR(2,2) = CMPLX(XI1*XK3 - XI3*XK1,0.D0,kind(1.d0))
      ZR(2,3) = CMPLX(XI2*XK1 - XI1*XK2,0.D0,kind(1.d0))
      ZR(3,1) = CMPLX(XI2*XJ3 - XI3*XJ2,0.D0,kind(1.d0))
      ZR(3,2) = CMPLX(XI3*XJ1 - XI1*XJ3,0.D0,kind(1.d0))
      ZR(3,3) = CMPLX(XI1*XJ2 - XI2*XJ1,0.D0,kind(1.d0))
C
C     INITIALISATION DE LA MATRICE ZROTA A ZERO
C
      DO 20 I=1,28
        DO 10 J=1,28
          ZROTA(I,J)=CZERO
   10   CONTINUE
   20 CONTINUE
C
C     REMPLISSAGE DE LA PARTIE SUPERIEURE GAUCHE
C
      DO 50 IBLOC=1,4
         DO 40 I=1,3
            I1=(IBLOC-1)*3+I
            DO 30 J=1,3
               J1=(IBLOC-1)*3+J
               ZROTA(I1,J1)=ZR(I,J)
  30        CONTINUE
  40     CONTINUE
  50  CONTINUE
      ZROTA(13,13)=CPLXUN
      ZROTA(14,14)=CPLXUN
C
C     REMPLISSAGE DE LA PARTIE INFERIEURE DROITE
C
      DO 80 IBLOC=5,8
         DO 70 I=1,3
            I1=(IBLOC-1)*3+I+2
            DO 60 J=1,3
               J1=(IBLOC-1)*3+J+2
               ZROTA(I1,J1)=ZR(I,J)
   60       CONTINUE
   70    CONTINUE
   80 CONTINUE
C
      ZROTA(27,27)=CPLXUN
      ZROTA(28,28)=CPLXUN
C
C     INITIALISATION DE LA MATRICE ZC1 A ZERO
C
      DO 100 I=1,14
        DO 90 J=1,28
          ZC1(I,J)=CZERO
   90   CONTINUE
  100 CONTINUE
C
        DO 130 I=1,14
           DO 120 J=1,28
              DO 110 K=1,28
      ZC1(I,J)=ZC1(I,J)+ALPHAI(I,K,INP,IFRQ)*ZROTA(K,J)
  110         CONTINUE
  120      CONTINUE
  130   CONTINUE
C
      RETURN
      END