Télécharger cqtgr1.eso

Retour à la liste

Numérotation des lignes :

  1. C CQTGR1 SOURCE CHAT 05/01/12 22:27:34 5004
  2. SUBROUTINE CQTGR1(IGAU,MELE,NBNN,LRE,IFOU,NGRA,XE,SHPTOT,
  3. 1 XDDL,SHP,BGR,DJAC,GRADI)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *****************************************************************
  7. * SOUS-PROGRAMME DE L'OPERATEUR GRADIENT
  8. *
  9. * CALCUL DES GRADIENTS DE TEMPERATURE POUR LES ELEMENTS COQ2,COQ3
  10. *
  11. *
  12. * ENTREES :
  13. *
  14. * IGAU NUMERO DU POINT DE GAUSS
  15. * MELE NUMERO DE L'ELEMENT DANS NOMTP
  16. * NBNN NOMBRE DE NOEUDS
  17. * LRE NOMBRE DE COLONNES DE LA MATRICE BGR
  18. * IFOU IFOUR DE CCOPTIO
  19. * NGRA NOMBRE DE COMPOSANTES DE GRADIENTS
  20. * XE COORDONNEES DE L'ELEMENT
  21. * SHPTOT FONCTIONS DE FORMES ET DERIVEES
  22. * SHP TABLEAU DE TRAVAIL
  23. * BGR TABLEAU DE TRAVAIL
  24. *
  25. * SORTIES :
  26. *
  27. * GRADI TABLEAU CONTENANT LES COMPOSANTES DU GRADIENT
  28. * DJAC JACOBIEN
  29. *
  30. * AUTEUR : P.DOWLATYARI 27/05/91
  31. ************************************************************************
  32. -INC CCOPTIO
  33. DIMENSION XE(3,*),BGR(NGRA,*),SHP(6,*),SHPTOT(6,NBNN,*)
  34. DIMENSION XDDL(*),GRADI(*)
  35. DIMENSION COSD1(3),COSD2(3),COSD3(3),XE1(3,3)
  36. *
  37. CALL ZERO(BGR,NGRA,LRE)
  38. *
  39. IF(MELE.EQ.44)THEN
  40. *
  41. * COQ2
  42. *
  43. IF(IFOU.EQ.0)THEN
  44. *
  45. * LA LONGUEUR DE L'ELEMENT
  46. *
  47. D=SQRT((XE(1,2)-XE(1,1))**2.D0 +(XE(2,2)-XE(2,1))**2.D0)
  48. DJAC=D
  49. IF (D.EQ.0.D0) RETURN
  50. BGR(1,1)=-1.D0/D
  51. BGR(1,2)= 1.D0/D
  52. ELSE
  53. *
  54. * ELEMENT AXISYM. DE FOURIER OU AUTRE
  55. * OPTION NON DISPONIBLE ACTUELLEMENT
  56. *
  57. CALL ERREUR(19)
  58. RETURN
  59. ENDIF
  60. ELSE
  61. *
  62. * COQ3
  63. *
  64. *
  65. * CALCUL DES COORDONNEES DES NOEUDS DANS LE REPERE LOCAL DE L'
  66. * ELEMENT COQUE
  67. *
  68. CALL ZERO(XE1,3,3)
  69. DO 10 I=1,3
  70. COSD1(I)=XE(I,2)-XE(I,1)
  71. COSD2(I)=XE(I,3)-XE(I,1)
  72. 10 CONTINUE
  73. *
  74. COSD3(1)=COSD1(2)*COSD2(3)-COSD1(3)*COSD2(2)
  75. COSD3(2)=COSD1(3)*COSD2(1)-COSD1(1)*COSD2(3)
  76. COSD3(3)=COSD1(1)*COSD2(2)-COSD1(2)*COSD2(1)
  77. *
  78. COSD1L=SQRT(COSD1(1)*COSD1(1)+COSD1(2)*COSD1(2)+
  79. . COSD1(3)*COSD1(3))
  80. COSD3L=SQRT(COSD3(1)*COSD3(1)+COSD3(2)*COSD3(2)+
  81. . COSD3(3)*COSD3(3))
  82. *
  83. DO 20 I=1,3
  84. COSD1(I)=COSD1(I)/COSD1L
  85. COSD3(I)=COSD3(I)/COSD3L
  86. 20 CONTINUE
  87. *
  88. COSD2(1)=COSD3(2)*COSD1(3)-COSD3(3)*COSD1(2)
  89. COSD2(2)=COSD3(3)*COSD1(1)-COSD3(1)*COSD1(3)
  90. COSD2(3)=COSD3(1)*COSD1(2)-COSD3(2)*COSD1(1)
  91. *
  92. DO 30 NOE=1,NBNN
  93. DO 30 I=1,3
  94. XE1(1,NOE)=XE1(1,NOE)+XE(I,NOE)*COSD1(I)
  95. XE1(2,NOE)=XE1(2,NOE)+XE(I,NOE)*COSD2(I)
  96. 30 CONTINUE
  97. *
  98. DO 40 NP=1,NBNN
  99. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  100. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  101. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  102. 40 CONTINUE
  103. *
  104. CALL JACOBI(XE1,SHP,2,NBNN,DJAC)
  105. K=1
  106. DO 50 NP=1,NBNN
  107. BGR(1,K)=SHP(2,NP)
  108. BGR(2,K)=SHP(3,NP)
  109. K=K+1
  110. 50 CONTINUE
  111. *
  112. ENDIF
  113. *
  114. * CALCUL DES COMPOSANTES DU GRADIENT
  115. *
  116. LRE1=LRE/3
  117. DO 60 IA=1,NGRA
  118. CC=0.D0
  119. DO 70 IB=1,LRE1
  120. IBB=(IB-1)*3+2
  121. CC=CC+XDDL(IBB)*BGR(IA,IB)
  122. 70 CONTINUE
  123. GRADI(IA)=CC
  124. 60 CONTINUE
  125. *
  126. RETURN
  127. END
  128.  
  129.  
  130.  

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