Télécharger la plaquette Cast3M


fr en

Télécharger ella23.eso

Retour à la liste

Numérotation des lignes : 

ella23

  1. C ELLA23    SOURCE    PV        22/04/19    16:18:03     11344          
  2.       SUBROUTINE ELLA23(CARACT,COOR,GAMA,ZXX,XCOR,VALDE1,VALDE2,
  3.      &                  VALDE3,VALDE4,ZS,NP,NBELEM,XXPI)
  4. C
  5.       IMPLICIT INTEGER(I-N)
  6.       COMPLEX*16 ZXX,ZD,ZE,ZI,ZIMOIN,ZS,ZU,ZU1,ZU2,ZCE,ZCP,ZCMU,ZCR,
  7.      &           ZALFA2,ZALFAX,ZALFAR,ZALFA4,ZALFAF,ZZ3,ZALFAA,
  8.      &           ZA56,ZB56,ZA89,ZB89,ZA1112,ZB1112,
  9.      &           ZUX1,ZUY1,ZUZ1,ZUP1,ZX1,ZY1,ZZ1,ZP1,
  10.      &           ZUX2,ZUY2,ZUZ2,ZUP2,ZX2,ZY2,ZZ2,ZP2,
  11.      &           Z1,Z2,
  12.      &         Z10X, Z11X, Z30X, Z31X, Z32X, Z33X, Z34X, Z40X, Z41X,
  13.      &         Z10XL,Z11XL,Z30XL,Z31XL,Z32XL,Z33XL,Z34XL,Z40XL,Z41XL
  14. C
  15.       REAL*8           CARACT,COOR,GAMA,XCOR,VALDE1,VALDE2,VALDE3,
  16.      &                 VALDE4,XXPI,R1,R2,XXA,XYA,XZA,XXB,XYB,XZB,XL,
  17.      &                 XI1,XI2,XI3,GX,GY,GZ,GG,DELTA,DET,XJ1,XJ2,XJ3,
  18.      &                 XK1,XK2,XK3,XX1,XY1,XZ1,XX2,XY2,XZ2,
  19.      &                 XXD1,XXD2,XXL1,XXL2,EPSILO
  20.       REAL*8           CE,CNU,CRO,CRIN,CREX,CKC,CAM,CETA,CROF,CSON,
  21.      &                 CSE,CSEF,CC,CI,CIP,COEF,
  22.      &                PRZX1,PIZX1,PRZY1,PIZY1,PRZZ1,PIZZ1,PRZP1,PIZP1,
  23.      &                PRZX2,PIZX2,PRZY2,PIZY2,PRZZ2,PIZZ2,PRZP2,PIZP2,
  24.      &                 PPX1,PPY1,PPZ1,PPX2,PPY2,PPZ2,PPP1,PPP2
  25. C
  26. -INC CCREEL
  27.       INTEGER NP,NBELEM,N1,N2,I,IN,IOUI,J,L
  28. C
  29. C   OPERATEUR ELFE LAPLACE ACOU
  30. C
  31. C   CALCUL POUR LA POUTRE Num INP LES VALEURS DE Ua ET DE Ub EN LOCAL
  32. C
  33. C   PARAMETRES :
  34. C
  35. C   CARACT : TABLEAU DES CARACTERISTIQUE DES POUTRES (10,NP)
  36. C   COOR   : TABLEAU DES COORDONNEES DES NOEUDS (3,2*NP)
  37. C   GAMA   : TABLEAU DES VECTEUR DEFINISSANT LE PLAN LOCALE OXY (3,2*NP)
  38. C   ZXX    : VECTEUR (28*NP) DONNANT LE VECTEUR SOLUTION DU TREILLIS
  39. C            DANS LE REPERE GLOBAL
  40. C   XCOR   : TABLEAU DONNANT LES COORD. DES NOEUDS DE L'OBJET MAILLAGE
  41. C            DANS LE REPERE GLOBAL
  42. C   ZS     : VALEUR DE S = S0 + I W
  43. C   NP     : NOMBRE DE POUTRES DU TREILLIS
  44. C   NBELEM : NOMBRE D'ELEMENTS DU SOUS-MAILLAGE
  45. C   XXPI    : VALEUR PRECISE DE PI
  46. C
  47. C
  48. C   SORTIES :
  49. C
  50. C   VALDE1 : MODULE DE UX, UY, UZ POUR LES 2 POINTS DE CHAQUE ELEMENT
  51. C            DU SOUS-MAILLAGE
  52. C   VALDE2 : PHASE DE UX, UY, UZ POUR LES 2 POINTS DE CHAQUE ELEMENT
  53. C            DU SOUS-MAILLAGE
  54. C   VALDE3 : MODULE DE P POUR LES 2 POINTS DE CHAQUE ELEMENT
  55. C            DU SOUS-MAILLAGE
  56. C   VALDE4 : PHASE DE P POUR LES 2 POINTS DE CHAQUE ELEMENT
  57. C            DU SOUS-MAILLAGE
  58. C
  59. C
  60. C   AUTEURS : SAINT-DIZIER ET GORCY
  61. C   DATE    : 24 JANVIER 1991
  62. C
  63. C
  64.       DIMENSION CARACT(10,*),COOR(3,*),GAMA(3,*)
  65.       DIMENSION ZXX(*),XCOR(2,3,NBELEM)
  66.       DIMENSION VALDE1(2,NBELEM,3),VALDE2(2,NBELEM,3)
  67.       DIMENSION VALDE3(2,NBELEM,1),VALDE4(2,NBELEM,1)
  68. C
  69.       DIMENSION ZU(28),ZU1(28),ZU2(28)
  70.       DIMENSION R1(3,3),R2(3,3),ZD(14),ZE(14,14)
  71. C
  72.       ZIMOIN=CMPLX(0.D0,-1.D0,kind(1.D0))
  73. *      EPSILO=1.0D-38
  74.       EPSILO=xpetit
  75. C
  76.       DO 100 INP = 1 , NP
  77. C
  78.       DO 101 II = 1 , 28
  79.             ZU(II) = ZXX(28*(INP-1)+II)
  80.   101 CONTINUE
  81. C
  82. C -------------- ACQUISITION DES CARACTERISTIQUES DE LA POUTRE
  83. C                ---------------------------------------------
  84. C
  85.       CE    = CARACT( 1,INP)
  86.       CNU   = CARACT( 2,INP)
  87.       CRO   = CARACT( 3,INP)
  88.       CRIN  = CARACT( 4,INP)
  89.       CREX  = CARACT( 5,INP)
  90.       CKC   = CARACT( 6,INP)
  91.       CAM   = CARACT( 7,INP)
  92.       CETA  = CARACT( 8,INP)
  93.       CROF  = CARACT( 9,INP)
  94.       CSON  = CARACT(10,INP)
  95. C
  96.       ZI = CMPLX(0.D0 , 1.D0,kind(1.D0))
  97. C
  98.       CSE = XXPI * ((CREX*CREX)-(CRIN*CRIN))
  99.       CSEF = XXPI * (CRIN*CRIN)
  100.       CC = XXPI * ((CREX*CREX*CREX*CREX)-(CRIN*CRIN*CRIN*CRIN)) / 2.D0
  101.       CI = XXPI * ((CREX*CREX*CREX*CREX)-(CRIN*CRIN*CRIN*CRIN)) / 4.D0
  102.       CIP = 2.D0 * CI
  103. C
  104.       COEF = 1.D0 +((2.*CROF*CSON*CSON*CRIN) / (CE*(CREX-CRIN)))
  105.       CSON = CSON / SQRT(COEF)
  106. C
  107.       ZCE = CE*(CMPLX(1.D0,0.D0,KIND(1.D0))+CETA*ZI)
  108.       ZCP   = SQRT(ZCE/CRO)
  109.       ZCMU  = ZCE/(CMPLX(2.D0,0.D0,KIND(1.D0))*
  110.      >      (CMPLX(1.D0,0.D0,KIND(1.D0))+CNU))
  111.       ZCR   = SQRT(ZCMU/CRO)
  112. C
  113.       ZALFA2= ZS*ZS*CRO*CSE + CAM*ZS
  114.       ZALFA2= ZALFA2 / (ZCE*CSE)
  115.       ZALFAX= SQRT(ZALFA2)
  116. C
  117.       ZALFA2= ZS*ZS*CRO*CIP + CAM*ZS
  118.       ZALFA2= ZALFA2 / (ZCMU*CC)
  119.       ZALFAR= SQRT(ZALFA2)
  120. C
  121.       ZALFA4= CRO*CRO*CI*ZS*ZS*ZS*ZS/ZCMU/CKC
  122.      *        + CAM*CRO*CI*ZS*ZS*ZS/ZCMU/CKC/CSE
  123.      *        + ((CRO*CSE)+(CROF*CSEF))*ZS*ZS
  124.      *        + CAM*ZS
  125.       ZALFA4= ZALFA4/(ZCE*CI)
  126.       ZALFA2= SQRT(ZALFA4)
  127.       ZALFAF= SQRT(ZALFA2)
  128. C
  129.       ZZ3   = CRO*CI*(CMPLX(1.D0,0.D0,KIND(1.D0))+ZCE/(ZCMU*CKC))*ZS*ZS
  130.      *        + CAM*ZCE*CI*ZS/(ZCMU*CKC*CSE)
  131.       ZZ3   = ZZ3 / (ZCE*CI*ZALFA2)
  132. C
  133.       ZALFAA = ZS / CSON
  134. C
  135.       N1  = 2*INP-1
  136.       N2  = 2*INP
  137.       XXA  = COOR (1,N1)
  138.       XYA  = COOR (2,N1)
  139.       XZA  = COOR (3,N1)
  140.       XXB  = COOR (1,N2)
  141.       XYB  = COOR (2,N2)
  142.       XZB  = COOR (3,N2)
  143. C
  144.       XL = SQRT((XXB-XXA)**2 + (XYB-XYA)**2 + (XZB-XZA)**2)
  145. C
  146. C ------------------------------ VECTEUR UNITAIRE OX REPERE LOCALE
  147. C                                ---------------------------------
  148.       XI1 = (XXB-XXA)/XL
  149.       XI2 = (XYB-XYA)/XL
  150.       XI3 = (XZB-XZA)/XL
  151. C
  152. C ------------------------- VECTEUR UNITAIRE OY REPERE LOCALE
  153. C                           ---------------------------------
  154.       GX = GAMA(1,INP)
  155.       GY = GAMA(2,INP)
  156.       GZ = GAMA(3,INP)
  157.       GG = SQRT(GX*GX + GY*GY + GZ*GZ)
  158.       GX = GX/GG
  159.       GY = GY/GG
  160.       GZ = GZ/GG
  161. C
  162.       DELTA = SQRT (1.D0 - (XI1*GX + XI2*GY + XI3*GZ)**2)
  163. C
  164.       DET=-(GX*XI3-GZ*XI1)**2-(GY*XI1-GX*XI2)**2-(GY*XI3-GZ*XI2)**2
  165. C
  166.       IF (ABS(DET).LT.1D-12) THEN
  167.            XJ1 = -XI2
  168.            XJ2 = 0.D0
  169.            XJ3 = 0.D0
  170.       ELSE
  171.            XJ1 = (XI2*(GY*XI1-GX*XI2)-XI3*(GX*XI3-GZ*XI1))*DELTA/DET
  172.            XJ2 = (XI3*(GZ*XI2-GY*XI3)-XI1*(GY*XI1-GX*XI2))*DELTA/DET
  173.            XJ3 = (XI1*(GX*XI3-GZ*XI1)-XI2*(GZ*XI2-GY*XI3))*DELTA/DET
  174.       END IF
  175. C
  176. C ---------------------------- VECTEUR UNITAIRE OZ REPERE LOCALE
  177. C                              ---------------------------------
  178.       XK1 = XI2*XJ3 - XI3*XJ2
  179.       XK2 = XI3*XJ1 - XI1*XJ3
  180.       XK3 = XI1*XJ2 - XI2*XJ1
  181. C
  182.       R1(1,1) = XI1
  183.       R1(1,2) = XJ1
  184.       R1(1,3) = XK1
  185.       R1(2,1) = XI2
  186.       R1(2,2) = XJ2
  187.       R1(2,3) = XK2
  188.       R1(3,1) = XI3
  189.       R1(3,2) = XJ3
  190.       R1(3,3) = XK3
  191. C
  192.       R2(1,1) = XJ2*XK3 - XJ3*XK2
  193.       R2(1,2) = XJ3*XK1 - XJ1*XK3
  194.       R2(1,3) = XJ1*XK2 - XJ2*XK1
  195.       R2(2,1) = XI3*XK2 - XI2*XK3
  196.       R2(2,2) = XI1*XK3 - XI3*XK1
  197.       R2(2,3) = XI2*XK1 - XI1*XK2
  198.       R2(3,1) = XI2*XJ3 - XI3*XJ2
  199.       R2(3,2) = XI3*XJ1 - XI1*XJ3
  200.       R2(3,3) = XI1*XJ2 - XI2*XJ1
  201. C
  202. C -----------------------------  MATRICE DIMENSIONNEMENT ZD
  203. C                                --------------------------
  204.       ZD( 1) = XL**2/ZCP
  205.       ZD( 2) = XL**2/ZCP
  206.       ZD( 3) = XL**2/ZCP
  207.       ZD( 4) = XL/ZCR
  208.       ZD( 5) = XL**2/ZCP*ZALFAF
  209.       ZD( 6) = XL**2/ZCP*ZALFAF
  210.       ZD( 7) = XL**2/ZCP*ZALFAX
  211.       ZD( 8) = XL**2/ZCP*(ZALFAF**3)
  212.       ZD( 9) = XL**2/ZCP*(ZALFAF**3)
  213.       ZD(10) = XL/ZCR*ZALFAR
  214.       ZD(11) = XL**2/ZCP*(ZALFAF**2)
  215.       ZD(12) = XL**2/ZCP*(ZALFAF**2)
  216.       ZD(13) = CMPLX(XL*CROF*CSON,0.D0,KIND(1.D0))
  217.       ZD(14) = XL*CROF*CSON*ZALFAA
  218. C
  219. C ------------------------------- MATRICE DES EFFORTS ZE
  220. C                                 ----------------------
  221.       DO 20 I = 1 , 14
  222.           DO 21 J = 1 , 14
  223.                 ZE(I,J) = (0.D0,0.D0)
  224.    21     CONTINUE
  225.    20 CONTINUE
  226. C
  227.       ZA56 = (1.D0,0.D0)
  228.       ZB56 = CMPLX(1.D0,0.D0,KIND(1.D0)) / (ZCMU*CKC*CSE)
  229. C
  230.       ZA89 = (CRO*CSE*ZS*ZS+CAM*ZS)/(ZCMU*ZCMU*CKC*CKC*CSE*CSE)
  231.      *      -  CMPLX(1.D0,0.D0,KIND(1.D0))/(ZCE*CI)
  232.       ZB89 = CRO*ZS*ZS*(CMPLX(1.D0,0.D0,KIND(1.D0))/(ZCMU*CKC)+
  233.      >      CMPLX(1.D0,0.D0,KIND(1.D0))/ZCE)
  234.      *      + CAM*ZS/(ZCMU*CKC*CSE)
  235. C
  236.       ZA1112 = CMPLX(1.D0,0.D0,KIND(1.D0))/(ZCE*CI)
  237.       ZB1112 = (CRO*CSE*ZS*ZS+CAM*ZS)/(ZCMU*CKC*CSE)
  238. C
  239.       ZE( 1, 1) = CMPLX(1.D0,0.D0,KIND(1.D0))
  240.       ZE( 2, 2) = CMPLX(1.D0,0.D0,KIND(1.D0))
  241.       ZE( 3, 3) = CMPLX(1.D0,0.D0,KIND(1.D0))
  242.       ZE( 4, 4) = CMPLX(1.D0,0.D0,KIND(1.D0))
  243.       ZE( 5, 5) = -ZA56
  244.       ZE( 5, 9) = ZB56
  245.       ZE( 6, 6) = ZA56
  246.       ZE( 6, 8) = ZB56
  247.       ZE( 7, 7) = CMPLX(1.D0,0.D0,KIND(1.D0))/(ZCE*CSE)
  248.       ZE( 8, 6) = ZB89
  249.       ZE( 8, 8) = ZA89
  250.       ZE( 9, 5) = -ZB89
  251.       ZE( 9, 9) = ZA89
  252.       ZE(10,10) = CMPLX(1.D0,0.D0,KIND(1.D0))/(ZCMU*CC)
  253.       ZE(11, 3) = ZB1112
  254.       ZE(11,11) = -ZA1112
  255.       ZE(12, 2) = ZB1112
  256.       ZE(12,12) = ZA1112
  257.       ZE(13,13) = CMPLX(1.D0,0.D0,KIND(1.D0))
  258.       ZE(14,14) = -ZS/CSEF
  259. C
  260. C -- CALCUL DE ZU1 = ZR * ZU
  261. C
  262.       DO 27 I = 1 , 28
  263.           ZU1(I) = (0.D0,0.D0)
  264.           ZU2(I) = (0.D0,0.D0)
  265.    27 CONTINUE
  266. C
  267.       DO 26 I = 1 , 4
  268.            DO 25 J = 1 , 3
  269.                DO 24 K = 1 , 3
  270.                   L = (I-1)*3
  271.                   ZU1(L+J)=ZU1(L+J)+R2(J,K)*ZU(L+K)
  272.                   ZU1(L+14+J)=ZU1(L+14+J)+R2(J,K)*ZU(L+14+K)
  273.    24          CONTINUE
  274.    25      CONTINUE
  275.    26 CONTINUE
  276. C
  277.       ZU1(13) = ZU(13)
  278.       ZU1(14) = ZU(14)
  279.       ZU1(27) = ZU(27)
  280.       ZU1(28) = ZU(28)
  281. C
  282. C -- CALCUL DE ZU2 = ZE * ZU1
  283. C
  284.       DO 30 I = 1,12
  285.          DO 31 J = 1,12
  286.             ZU2(I) = ZU2(I) + ZE(I,J)*ZU1(J)
  287.    31    CONTINUE
  288.    30 CONTINUE
  289. C
  290.       ZU2(13) = ZE(13,13)*ZU1(13)
  291.       ZU2(14) = -ZE(14,14)*ZU1(14)
  292. C
  293.       DO 32 I = 1,12
  294.          DO 33 J = 1,6
  295.            ZU2(I+14) = ZU2(I+14) + ZE(I,J  )*ZU1(J+14)
  296.            ZU2(I+14) = ZU2(I+14) - ZE(I,J+6)*ZU1(J+20)
  297.    33    CONTINUE
  298.    32 CONTINUE
  299. C
  300.       ZU2(27) = ZE(13,13)*ZU1(27)
  301.       ZU2(28) = ZE(14,14)*ZU1(28)
  302. C
  303. C -- CALCUL DE ZU2 = ZD * ZU2
  304. C
  305.       DO 34 I = 1,14
  306.           ZU2(I   ) = ZU2(I   )/ZD(I)
  307.           ZU2(I+14) = ZU2(I+14)/ZD(I)
  308.    34 CONTINUE
  309. C
  310. C ---------------  NBELEM : NOMBRE D'ELEMENTS DANS LE SOUS MAILLAGE
  311. C
  312.       DO 110 IN = 1 , NBELEM
  313. C
  314.       XX1 = XCOR ( 1,1,IN)
  315.       XY1 = XCOR ( 1,2,IN)
  316.       XZ1 = XCOR ( 1,3,IN)
  317. C
  318.       XX2 = XCOR ( 2,1,IN)
  319.       XY2 = XCOR ( 2,2,IN)
  320.       XZ2 = XCOR ( 2,3,IN)
  321. C
  322.       CALL ELLA07(XXA,XYA,XZA,XXB,XYB,XZB,XX1,XY1,XZ1,XX2,XY2,XZ2,
  323.      *            IOUI)
  324. C
  325.          IF (IOUI.EQ.1) THEN
  326. C
  327.           XXD1 = SQRT((XXA-XX1)**2+(XYA-XY1)**2+(XZA-XZ1)**2)
  328.           XXD2 = SQRT((XXA-XX2)**2+(XYA-XY2)**2+(XZA-XZ2)**2)
  329.           XXL1= XL -XXD1
  330.           XXL2= XL -XXD2
  331. C
  332. C           XXDI  :  DISTANCE DE A AU PT M DE CALCUL DU DEPLACEMENT
  333. C
  334.           CALL ELLA31(XXD1,ZALFAX,ZALFAR,ZALFAF,ZALFAA,Z10X,
  335.      *    Z11X,Z1,Z2,Z30X,Z31X,Z32X,Z33X,Z34X,ZZ3,Z40X,Z41X)
  336. C
  337.           CALL ELLA31(XXL1,ZALFAX,ZALFAR,ZALFAF,ZALFAA,Z10XL,
  338.      *    Z11XL,Z1,Z2,Z30XL,Z31XL,Z32XL,Z33XL,Z34XL,ZZ3,Z40XL,Z41XL)
  339. C
  340.           ZUX1 = ZU2(21)*Z10XL-ZU2(15)*Z11XL-ZU2(7)*Z10X-ZU2(1)*Z11X
  341. C
  342.           ZUY1 =-(ZZ3*Z31X -Z33X )*ZU2(2) - (ZZ3*Z30X -Z32X )*ZU2(6)
  343.      *          + Z31X *ZU2(12) + Z30X *ZU2(8)
  344.      *          -(ZZ3*Z31XL-Z33XL)*ZU2(16)+(ZZ3*Z30XL-Z32XL)*ZU2(20)
  345.      *          + Z31XL*ZU2(26) - Z30XL*ZU2(22)
  346. C
  347.           ZUZ1 =-(ZZ3*Z31X -Z33X )*ZU2(3) - (ZZ3*Z30X -Z32X )*ZU2(5)
  348.      *          + Z31X *ZU2(11) + Z30X *ZU2(9)
  349.      *          -(ZZ3*Z31XL-Z33XL)*ZU2(17)+(ZZ3*Z30XL-Z32XL)*ZU2(19)
  350.      *          + Z31XL*ZU2(25) - Z30XL*ZU2(23)
  351. C
  352.           ZUP1 = ZU2(28)*Z40XL-ZU2(27)*Z41XL-ZU2(14)*Z40X-ZU2(13)*Z41X
  353. C
  354.           ZUX1 = ZUX1 * ZD(1)
  355.           ZUY1 = ZUY1 * ZD(2)
  356.           ZUZ1 = ZUZ1 * ZD(3)
  357.           ZUP1 = ZUP1 * ZD(13)
  358. C
  359.           ZX1 = R1(1,1)*ZUX1 + R1(1,2)*ZUY1 + R1(1,3)*ZUZ1
  360.           ZY1 = R1(2,1)*ZUX1 + R1(2,2)*ZUY1 + R1(2,3)*ZUZ1
  361.           ZZ1 = R1(3,1)*ZUX1 + R1(3,2)*ZUY1 + R1(3,3)*ZUZ1
  362.           ZP1 = ZUP1
  363. C
  364.           CALL ELLA31(XXD2,ZALFAX,ZALFAR,ZALFAF,ZALFAA,Z10X,
  365.      *    Z11X,Z1,Z2,Z30X,Z31X,Z32X,Z33X,Z34X,ZZ3,Z40X,Z41X)
  366. C
  367.           CALL ELLA31(XXL2,ZALFAX,ZALFAR,ZALFAF,ZALFAA,Z10XL,
  368.      *    Z11XL,Z1,Z2,Z30XL,Z31XL,Z32XL,Z33XL,Z34XL,ZZ3,Z40XL,Z41XL)
  369. C
  370. C
  371.           ZUX2 = ZU2(21)*Z10XL-ZU2(15)*Z11XL-ZU2(7)*Z10X-ZU2(1)*Z11X
  372. C
  373.           ZUY2 =-(ZZ3*Z31X -Z33X )*ZU2(2) - (ZZ3*Z30X -Z32X )*ZU2(6)
  374.      *         + Z31X *ZU2(12) + Z30X *ZU2(8)
  375.      *         -(ZZ3*Z31XL-Z33XL)*ZU2(16)+(ZZ3*Z30XL-Z32XL)*ZU2(20)
  376.      *         + Z31XL*ZU2(26) - Z30XL*ZU2(22)
  377. C
  378.           ZUZ2 =-(ZZ3*Z31X -Z33X )*ZU2(3) - (ZZ3*Z30X -Z32X )*ZU2(5)
  379.      *         + Z31X *ZU2(11) + Z30X *ZU2(9)
  380.      *         -(ZZ3*Z31XL-Z33XL)*ZU2(17)+(ZZ3*Z30XL-Z32XL)*ZU2(19)
  381.      *         + Z31XL*ZU2(25) - Z30XL*ZU2(23)
  382. C
  383.           ZUP2 = ZU2(28)*Z40XL-ZU2(27)*Z41XL-ZU2(14)*Z40X-ZU2(13)*Z41X
  384. C
  385.           ZUX2 = ZUX2 * ZD(1)
  386.           ZUY2 = ZUY2 * ZD(2)
  387.           ZUZ2 = ZUZ2 * ZD(3)
  388.           ZUP2 = ZUP2 * ZD(13)
  389. C
  390.           ZX2 = R1(1,1)*ZUX2 + R1(1,2)*ZUY2 + R1(1,3)*ZUZ2
  391.           ZY2 = R1(2,1)*ZUX2 + R1(2,2)*ZUY2 + R1(2,3)*ZUZ2
  392.           ZZ2 = R1(3,1)*ZUX2 + R1(3,2)*ZUY2 + R1(3,3)*ZUZ2
  393.           ZP2 = ZUP2
  394. C
  395.           PRZX1 = ZX1
  396.           PIZX1 = ZX1*ZIMOIN
  397.           PRZY1 = ZY1
  398.           PIZY1 = ZY1*ZIMOIN
  399.           PRZZ1 = ZZ1
  400.           PIZZ1 = ZZ1*ZIMOIN
  401.           PRZP1 = ZP1
  402.           PIZP1 = ZP1*ZIMOIN
  403.           PRZX2 = ZX2
  404.           PIZX2 = ZX2*ZIMOIN
  405.           PRZY2 = ZY2
  406.           PIZY2 = ZY2*ZIMOIN
  407.           PRZZ2 = ZZ2
  408.           PIZZ2 = ZZ2*ZIMOIN
  409.           PRZP2 = ZP2
  410.           PIZP2 = ZP2*ZIMOIN
  411. C
  412.           IF (ABS(PRZX1).LT.EPSILO.AND.ABS(PIZX1).LT.EPSILO) THEN
  413.             PPX1 = 0.D0
  414.           ELSE
  415.             PPX1 = ATAN2(PIZX1,PRZX1)*180.D0/XXPI
  416.           END IF
  417. C
  418.           IF (ABS(PRZY1).LT.EPSILO.AND.ABS(PIZY1).LT.EPSILO) THEN
  419.             PPY1 = 0.D0
  420.           ELSE
  421.             PPY1 = ATAN2(PIZY1,PRZY1)*180.D0/XXPI
  422.           END IF
  423. C
  424.           IF (ABS(PRZZ1).LT.EPSILO.AND.ABS(PIZZ1).LT.EPSILO) THEN
  425.             PPZ1 = 0.D0
  426.           ELSE
  427.             PPZ1 = ATAN2(PIZZ1,PRZZ1)*180.D0/XXPI
  428.           END IF
  429. C
  430.           IF (ABS(PRZX2).LT.EPSILO.AND.ABS(PIZX2).LT.EPSILO) THEN
  431.             PPX2 = 0.D0
  432.           ELSE
  433.             PPX2 = ATAN2(PIZX2,PRZX2)*180.D0/XXPI
  434.           END IF
  435. C
  436.           IF (ABS(PRZY2).LT.EPSILO.AND.ABS(PIZY2).LT.EPSILO) THEN
  437.             PPY2 = 0.D0
  438.           ELSE
  439.             PPY2 = ATAN2(PIZY2,PRZY2)*180.D0/XXPI
  440.           END IF
  441. C
  442.           IF (ABS(PRZZ2).LT.EPSILO.AND.ABS(PIZZ2).LT.EPSILO) THEN
  443.             PPZ2 = 0.D0
  444.           ELSE
  445.             PPZ2 = ATAN2(PIZZ2,PRZZ2)*180.D0/XXPI
  446.           END IF
  447. C
  448.           IF (ABS(PRZP1).LT.EPSILO.AND.ABS(PIZP1).LT.EPSILO) THEN
  449.             PPP1 = 0.D0
  450.           ELSE
  451.             PPP1 = ATAN2(PIZP1,PRZP1)*180.D0/XXPI
  452.           END IF
  453. C
  454.           IF (ABS(PRZP2).LT.EPSILO.AND.ABS(PIZP2).LT.EPSILO) THEN
  455.             PPP2 = 0.D0
  456.           ELSE
  457.             PPP2 = ATAN2(PIZP2,PRZP2)*180.D0/XXPI
  458.           END IF
  459. C
  460.           VALDE1(1,IN,1) = ABS(ZX1)
  461.           VALDE1(1,IN,2) = ABS(ZY1)
  462.           VALDE1(1,IN,3) = ABS(ZZ1)
  463.           VALDE1(2,IN,1) = ABS(ZX2)
  464.           VALDE1(2,IN,2) = ABS(ZY2)
  465.           VALDE1(2,IN,3) = ABS(ZZ2)
  466. C
  467.           VALDE2(1,IN,1) = PPX1
  468.           VALDE2(1,IN,2) = PPY1
  469.           VALDE2(1,IN,3) = PPZ1
  470.           VALDE2(2,IN,1) = PPX2
  471.           VALDE2(2,IN,2) = PPY2
  472.           VALDE2(2,IN,3) = PPZ2
  473. C
  474.           VALDE3(1,IN,1) = ABS(ZP1)
  475.           VALDE3(2,IN,1) = ABS(ZP2)
  476. C
  477.           VALDE4(1,IN,1) = PPP1
  478.           VALDE4(2,IN,1) = PPP2
  479. C
  480.       END IF
  481. C
  482.   110 CONTINUE
  483. C
  484.   100 CONTINUE
  485. C
  486.       END
  487.  
  488.  
  489.  
  490.  
  491.  
  492.  
  493.  
  494.  

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