Télécharger la plaquette Cast3M


fr en

Télécharger trj803.eso

Retour à la liste

Numérotation des lignes : 

trj803

  1. C TRJ803    SOURCE    CHAT      05/01/13    03:48:25     5004
  2.       SUBROUTINE TRJ803(XNOEU,X,G,IER)
  3. C
  4. C
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C     CALCUL DES COORDONNEES DE REFERENCE DANS UN CUB8
  8. C     XNOEU COORDONNEES DES SOMMETS
  9. C     X                 REELLES
  10. C     G                 DE REFERENCE
  11. C     IER INDICE D'ERREUR
  12. C
  13. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  14. C
  15. C
  16. C
  17.       IMPLICIT INTEGER(I-N)
  18.       IMPLICIT REAL*8 (A-H,O-Z)
  19. C
  20.       DIMENSION XNOEU(3,8),X(3),XN(8),G(3),DX(3),DG(3)
  21.       DIMENSION Y(3),D1XN(8),D2XN(8),D3XN(8),A(3,3),B(3,3)
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. C
  26. C
  27.       NOEL=8
  28. C     IDIM=3
  29. C
  30. C
  31.       G(1)=0.D0
  32.       G(2)=0.D0
  33.       G(3)=0.D0
  34. C
  35.       N1=15
  36.       DO 10 K=1,N1
  37. C
  38.       XN(1)=0.125D0*(1.D0-G(1))*(1.D0-G(2))*(1.D0-G(3))
  39.       XN(2)=0.125D0*(1.D0+G(1))*(1.D0-G(2))*(1.D0-G(3))
  40.       XN(3)=0.125D0*(1.D0+G(1))*(1.D0+G(2))*(1.D0-G(3))
  41.       XN(4)=0.125D0*(1.D0-G(1))*(1.D0+G(2))*(1.D0-G(3))
  42.       XN(5)=0.125D0*(1.D0-G(1))*(1.D0-G(2))*(1.D0+G(3))
  43.       XN(6)=0.125D0*(1.D0+G(1))*(1.D0-G(2))*(1.D0+G(3))
  44.       XN(7)=0.125D0*(1.D0+G(1))*(1.D0+G(2))*(1.D0+G(3))
  45.       XN(8)=0.125D0*(1.D0-G(1))*(1.D0+G(2))*(1.D0+G(3))
  46. C
  47.       Y(1)=0.D0
  48.       Y(2)=0.D0
  49.       Y(3)=0.D0
  50.       DO 1 I =1,NOEL
  51.       Y(1)=Y(1)+XN(I)*XNOEU(1,I)
  52.       Y(2)=Y(2)+XN(I)*XNOEU(2,I)
  53.       Y(3)=Y(3)+XN(I)*XNOEU(3,I)
  54.    1  CONTINUE
  55. C
  56.       DX(1)=X(1)-Y(1)
  57.       DX(2)=X(2)-Y(2)
  58.       DX(3)=X(3)-Y(3)
  59. C
  60.       D1XN(1)=-0.125D0*(1.D0-G(2))*(1.D0-G(3))
  61.       D1XN(2)= 0.125D0*(1.D0-G(2))*(1.D0-G(3))
  62.       D1XN(3)= 0.125D0*(1.D0+G(2))*(1.D0-G(3))
  63.       D1XN(4)=-0.125D0*(1.D0+G(2))*(1.D0-G(3))
  64.       D1XN(5)=-0.125D0*(1.D0-G(2))*(1.D0+G(3))
  65.       D1XN(6)= 0.125D0*(1.D0-G(2))*(1.D0+G(3))
  66.       D1XN(7)= 0.125D0*(1.D0+G(2))*(1.D0+G(3))
  67.       D1XN(8)=-0.125D0*(1.D0+G(2))*(1.D0+G(3))
  68. C
  69.       D2XN(1)=-0.125D0*(1.D0-G(1))*(1.D0-G(3))
  70.       D2XN(2)=-0.125D0*(1.D0+G(1))*(1.D0-G(3))
  71.       D2XN(3)= 0.125D0*(1.D0+G(1))*(1.D0-G(3))
  72.       D2XN(4)= 0.125D0*(1.D0-G(1))*(1.D0-G(3))
  73.       D2XN(5)=-0.125D0*(1.D0-G(1))*(1.D0+G(3))
  74.       D2XN(6)=-0.125D0*(1.D0+G(1))*(1.D0+G(3))
  75.       D2XN(7)= 0.125D0*(1.D0+G(1))*(1.D0+G(3))
  76.       D2XN(8)= 0.125D0*(1.D0-G(1))*(1.D0+G(3))
  77. C
  78.       D3XN(1)=-0.125D0*(1.D0-G(1))*(1.D0-G(2))
  79.       D3XN(2)=-0.125D0*(1.D0+G(1))*(1.D0-G(2))
  80.       D3XN(3)=-0.125D0*(1.D0+G(1))*(1.D0+G(2))
  81.       D3XN(4)=-0.125D0*(1.D0-G(1))*(1.D0+G(2))
  82.       D3XN(5)= 0.125D0*(1.D0-G(1))*(1.D0-G(2))
  83.       D3XN(6)= 0.125D0*(1.D0+G(1))*(1.D0-G(2))
  84.       D3XN(7)= 0.125D0*(1.D0+G(1))*(1.D0+G(2))
  85.       D3XN(8)= 0.125D0*(1.D0-G(1))*(1.D0+G(2))
  86. C
  87.       A(1,1)=0.D0
  88.       A(1,2)=0.D0
  89.       A(1,3)=0.D0
  90.       A(2,1)=0.D0
  91.       A(2,2)=0.D0
  92.       A(2,3)=0.D0
  93.       A(3,1)=0.D0
  94.       A(3,2)=0.D0
  95.       A(3,3)=0.D0
  96.       DO 75 I=1,NOEL
  97.       A(1,1)=A(1,1)+D1XN(I)*XNOEU(1,I)
  98.       A(1,2)=A(1,2)+D2XN(I)*XNOEU(1,I)
  99.       A(1,3)=A(1,3)+D3XN(I)*XNOEU(1,I)
  100.       A(2,1)=A(2,1)+D1XN(I)*XNOEU(2,I)
  101.       A(2,2)=A(2,2)+D2XN(I)*XNOEU(2,I)
  102.       A(2,3)=A(2,3)+D3XN(I)*XNOEU(2,I)
  103.       A(3,1)=A(3,1)+D1XN(I)*XNOEU(3,I)
  104.       A(3,2)=A(3,2)+D2XN(I)*XNOEU(3,I)
  105.       A(3,3)=A(3,3)+D3XN(I)*XNOEU(3,I)
  106.   75  CONTINUE
  107.       DET=A(1,1)*(A(2,2)*A(3,3)-A(3,2)*A(2,3))
  108.      *   +A(1,2)*(A(3,1)*A(2,3)-A(2,1)*A(3,3))
  109.      *   +A(1,3)*(A(2,1)*A(3,2)-A(2,2)*A(3,1))
  110.       B(1,1)=(A(2,2)*A(3,3)-A(3,2)*A(2,3))/DET
  111.       B(1,2)=(A(1,3)*A(3,2)-A(1,2)*A(3,3))/DET
  112.       B(1,3)=(A(1,2)*A(2,3)-A(1,3)*A(2,2))/DET
  113.       B(2,1)=(A(3,1)*A(2,3)-A(3,3)*A(2,1))/DET
  114.       B(2,2)=(A(1,1)*A(3,3)-A(1,3)*A(3,1))/DET
  115.       B(2,3)=(A(1,3)*A(2,1)-A(1,1)*A(2,3))/DET
  116.       B(3,1)=(A(2,1)*A(3,2)-A(2,2)*A(3,1))/DET
  117.       B(3,2)=(A(1,2)*A(3,1)-A(1,1)*A(3,2))/DET
  118.       B(3,3)=(A(1,1)*A(2,2)-A(1,2)*A(2,1))/DET
  119. C
  120.       DG(1)=B(1,1)*DX(1)+B(1,2)*DX(2)+B(1,3)*DX(3)
  121.       DG(2)=B(2,1)*DX(1)+B(2,2)*DX(2)+B(2,3)*DX(3)
  122.       DG(3)=B(3,1)*DX(1)+B(3,2)*DX(2)+B(3,3)*DX(3)
  123. C
  124.       G(1)=G(1)+DG(1)
  125.       G(2)=G(2)+DG(2)
  126.       G(3)=G(3)+DG(3)
  127. C
  128.       DA1=ABS(DG(1))
  129.       DA2=ABS(DG(2))
  130.       DA3=ABS(DG(3))
  131.       IF(DA1.LE.1.D-04.AND.DA2.LE.1.D-04.AND.DA3.LE.1.D-04)GO TO 51
  132. C
  133.   10  CONTINUE
  134. C
  135. C     IF(K.GE.N1)WRITE(6,101)X(1),X(2),X(3),DA1,DA2,DA3
  136.       MOTERR(1:8)='TRJ803  '
  137.       REAERR(1)=X(1)
  138.       REAERR(2)=X(2)
  139.       REAERR(3)=X(3)
  140. C     CALL ERREUR(-300)
  141.       IER=-300
  142.   51  CONTINUE
  143. C
  144. C     G(1)=XG1
  145. C     G(2)=YG1
  146. C     G(3)=ZG1
  147. C
  148.       RETURN
  149.  101  FORMAT(//,3X,'PB DE CONVERGENCE TRJ803 AU POINT SITUE EN '
  150.      *,3(1PE12.5),/,3X,'CONVERGENCE RELATIVE ',3(1PE12.5))
  151. C
  152.       END
  153.  
  154.  
  155.  

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