Télécharger caljq.eso

Retour à la liste

Numérotation des lignes :

caljq
  1. C CALJQ SOURCE CHAT 05/01/12 21:46:56 5004
  2. SUBROUTINE CALJQ(XYZ,XY,IES,ND,NP)
  3. C***********************************************************************
  4. C CE SP CALCULE
  5. C 1/ LES COORDONNEES D UN ELEMENT COQUE DANS LE PLAN ASSOCIE A CET
  6. C ELEMENT A PARTIR DE SES COORDONNEES 3D
  7. C 2/ LES COORDONNEES D UN ELEMENT 1D A PARTIR DE SES COORDONNEES
  8. C 2D OU 3D
  9. C |||| CES ELEMENTS SONT SUPPOSES DROITS
  10. C***********************************************************************
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8 (A-H,O-Z)
  13. REAL*8 XYZ(IES,NP),XY(ND,NP)
  14. IF(ND.NE.2)GOTO 10
  15. TX=XYZ(1,2)-XYZ(1,1)
  16. TY=XYZ(2,2)-XYZ(2,1)
  17. TZ=XYZ(3,2)-XYZ(3,1)
  18. TT=TX*TX+TY*TY+TZ*TZ
  19. TT=SQRT(TT)
  20. TX=TX/TT
  21. TY=TY/TT
  22. TZ=TZ/TT
  23. C WRITE(6,*)TX,TY,TZ,TT
  24. UX=(XYZ(2,NP)-XYZ(2,1))*TZ-(XYZ(3,NP)-XYZ(3,1))*TY
  25. UY=(XYZ(3,NP)-XYZ(3,1))*TX-(XYZ(1,NP)-XYZ(1,1))*TZ
  26. UZ=(XYZ(1,NP)-XYZ(1,1))*TY-(XYZ(2,NP)-XYZ(2,1))*TX
  27. UU=UX*UX+UY*UY+UZ*UZ
  28. UU=SQRT(UU)
  29. UX=-UX/UU
  30. UY=-UY/UU
  31. UZ=-UZ/UU
  32. C WRITE(6,*)'UX,UY,UZ,UU',UX,UY,UZ,UU
  33. VX=+UY*TZ-UZ*TY
  34. VY=+UZ*TX-UX*TZ
  35. VZ=+UX*TY-UY*TX
  36. C WRITE(6,*)VX,VY,VZ
  37. C
  38. DO 1 I=1,NP
  39. XY(1,I)=(XYZ(1,I)-XYZ(1,1))*TX+(XYZ(2,I)-XYZ(2,1))*TY
  40. *+(XYZ(3,I)-XYZ(3,1))*TZ
  41. XY(2,I)=(XYZ(1,I)-XYZ(1,1))*VX+(XYZ(2,I)-XYZ(2,1))*VY
  42. *+(XYZ(3,I)-XYZ(3,1))*VZ
  43. 1 CONTINUE
  44. RETURN
  45. C
  46. 10 CONTINUE
  47. IF(IES.NE.3)GOTO 20
  48. DO 11 I=1,NP
  49. TX=XYZ(1,I)-XYZ(1,1)
  50. TY=XYZ(2,I)-XYZ(2,1)
  51. TZ=XYZ(3,I)-XYZ(3,1)
  52. TT=TX*TX+TY*TY+TZ*TZ
  53. TT=SQRT(TT)
  54. XY(1,I)=TT
  55. 11 CONTINUE
  56. RETURN
  57. 20 CONTINUE
  58. DO 12 I=1,NP
  59. TX=XYZ(1,I)-XYZ(1,1)
  60. TY=XYZ(2,I)-XYZ(2,1)
  61. TT=TX*TX+TY*TY
  62. TT=SQRT(TT)
  63. XY(1,I)=TT
  64. C WRITE(6,3000) XYZ(1,I),XYZ(2,I),TT
  65. C3000 FORMAT(2X,' X Y TT ',3E12.5)
  66. 12 CONTINUE
  67. C
  68. RETURN
  69. END
  70.  
  71.  

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