Télécharger la plaquette Cast3M


fr en

Télécharger trj402.eso

Retour à la liste

Numérotation des lignes : 

trj402

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

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