Télécharger rglob.eso

Retour à la liste

Numérotation des lignes :

  1. C RGLOB SOURCE BP208322 17/03/01 21:18:03 9325
  2. SUBROUTINE RGLOB(VALVEC,IDIM,TXR,XLOC,XGLOB,IFOUR)
  3. C
  4. C CALCUL DES COS.DIR. DES AXES D'ORTHO./AXES GLOBAUXC ENTREES
  5. C
  6. C ENTREES :
  7. C
  8. C VALCEC = TABLEAU CONTENANT LES COS.DIR. DES AXES D'ORTHO./AXES LOCA
  9. C IDIM = DEFINIT SI ON EST EN 2D OU 3D
  10. C TXR = COS-DIRECTEURS DES AXES LOCAUX /REPERE GLOBAL
  11. C XLOC = TABLEAU DE TRAVAIL
  12. C
  13. C SORITES
  14. C
  15. C XGLOB = TEBLEAU CONTENANT DES COS.DIR. DES AXES D'ORTHO./AXES GLOBAU
  16. C
  17. C=======================================================================
  18. C
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8(A-H,O-Z)
  21. C
  22. DIMENSION XLOC(3,3),XGLOB(3,3)
  23. DIMENSION TXR(IDIM,*),VALVEC(*)
  24. C
  25. CALL ZERO(XGLOB,3,3)
  26. C
  27. cbp IF(IDIM.EQ.2) THEN
  28. IF(IDIM.EQ.2.AND.IFOUR.NE.1) THEN
  29. write(*,*) 'RGLOB: cas 2D Fourier'
  30. IDIM2=2
  31. XLOC(1,1)=VALVEC(1)
  32. XLOC(2,1)=VALVEC(2)
  33. XLOC(1,2)=-XLOC(2,1)
  34. XLOC(2,2)=XLOC(1,1)
  35. XN=XLOC(1,1)*XLOC(1,1)+XLOC(2,1)*XLOC(2,1)
  36. IF(XN.EQ.0.D0)THEN
  37. CALL ERREUR(277)
  38. RETURN
  39. ENDIF
  40. cbp ELSEIF(IDIM.EQ.3)THEN
  41. ELSE
  42. IDIM2=3
  43. XLOC(1,1)=VALVEC(1)
  44. XLOC(2,1)=VALVEC(2)
  45. XLOC(3,1)=VALVEC(3)
  46. XLOC(1,2)=VALVEC(4)
  47. XLOC(2,2)=VALVEC(5)
  48. XLOC(3,2)=VALVEC(6)
  49. CALL CROSS2(XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR)
  50. IF(IRR.EQ.0)THEN
  51. CALL ERREUR(277)
  52. RETURN
  53. ENDIF
  54. ENDIF
  55. C
  56. C DEFINITION DES AXES ORTHO./AXES GLOBAUX
  57. C
  58. DO 10 K=1,IDIM2
  59. DO 10 J=1,IDIM
  60. DO 10 I=1,IDIM
  61. XGLOB(J,K)=TXR(J,I)*XLOC(I,K)+XGLOB(J,K)
  62. 10 CONTINUE
  63. IF (IFOUR.EQ.1) THEN
  64. XGLOB(3,1)=XLOC(3,1)
  65. XGLOB(3,2)=XLOC(3,2)
  66. XGLOB(3,3)=XLOC(3,3)
  67. ENDIF
  68.  
  69. RETURN
  70. END
  71.  
  72.  
  73.  

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