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.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. DIMENSION XE(3,*),BGR(NGRA,*),SHP(6,*),SHPTOT(6,NBNN,*)
  36. DIMENSION XDDL(*),GRADI(*)
  37. DIMENSION COSD1(3),COSD2(3),COSD3(3),XE1(3,3)
  38. *
  39. CALL ZERO(BGR,NGRA,LRE)
  40. *
  41. IF(MELE.EQ.44)THEN
  42. *
  43. * COQ2
  44. *
  45. IF(IFOU.EQ.0)THEN
  46. *
  47. * LA LONGUEUR DE L'ELEMENT
  48. *
  49. D=SQRT((XE(1,2)-XE(1,1))**2.D0 +(XE(2,2)-XE(2,1))**2.D0)
  50. DJAC=D
  51. IF (D.EQ.0.D0) RETURN
  52. BGR(1,1)=-1.D0/D
  53. BGR(1,2)= 1.D0/D
  54. ELSE
  55. *
  56. * ELEMENT AXISYM. DE FOURIER OU AUTRE
  57. * OPTION NON DISPONIBLE ACTUELLEMENT
  58. *
  59. CALL ERREUR(19)
  60. RETURN
  61. ENDIF
  62. ELSE
  63. *
  64. * COQ3
  65. *
  66. *
  67. * CALCUL DES COORDONNEES DES NOEUDS DANS LE REPERE LOCAL DE L'
  68. * ELEMENT COQUE
  69. *
  70. CALL ZERO(XE1,3,3)
  71. DO 10 I=1,3
  72. COSD1(I)=XE(I,2)-XE(I,1)
  73. COSD2(I)=XE(I,3)-XE(I,1)
  74. 10 CONTINUE
  75. *
  76. COSD3(1)=COSD1(2)*COSD2(3)-COSD1(3)*COSD2(2)
  77. COSD3(2)=COSD1(3)*COSD2(1)-COSD1(1)*COSD2(3)
  78. COSD3(3)=COSD1(1)*COSD2(2)-COSD1(2)*COSD2(1)
  79. *
  80. COSD1L=SQRT(COSD1(1)*COSD1(1)+COSD1(2)*COSD1(2)+
  81. . COSD1(3)*COSD1(3))
  82. COSD3L=SQRT(COSD3(1)*COSD3(1)+COSD3(2)*COSD3(2)+
  83. . COSD3(3)*COSD3(3))
  84. *
  85. DO 20 I=1,3
  86. COSD1(I)=COSD1(I)/COSD1L
  87. COSD3(I)=COSD3(I)/COSD3L
  88. 20 CONTINUE
  89. *
  90. COSD2(1)=COSD3(2)*COSD1(3)-COSD3(3)*COSD1(2)
  91. COSD2(2)=COSD3(3)*COSD1(1)-COSD3(1)*COSD1(3)
  92. COSD2(3)=COSD3(1)*COSD1(2)-COSD3(2)*COSD1(1)
  93. *
  94. DO 30 NOE=1,NBNN
  95. DO 30 I=1,3
  96. XE1(1,NOE)=XE1(1,NOE)+XE(I,NOE)*COSD1(I)
  97. XE1(2,NOE)=XE1(2,NOE)+XE(I,NOE)*COSD2(I)
  98. 30 CONTINUE
  99. *
  100. DO 40 NP=1,NBNN
  101. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  102. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  103. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  104. 40 CONTINUE
  105. *
  106. CALL JACOBI(XE1,SHP,2,NBNN,DJAC)
  107. K=1
  108. DO 50 NP=1,NBNN
  109. BGR(1,K)=SHP(2,NP)
  110. BGR(2,K)=SHP(3,NP)
  111. K=K+1
  112. 50 CONTINUE
  113. *
  114. ENDIF
  115. *
  116. * CALCUL DES COMPOSANTES DU GRADIENT
  117. *
  118. LRE1=LRE/3
  119. DO 60 IA=1,NGRA
  120. CC=0.D0
  121. DO 70 IB=1,LRE1
  122. IBB=(IB-1)*3+2
  123. CC=CC+XDDL(IBB)*BGR(IA,IB)
  124. 70 CONTINUE
  125. GRADI(IA)=CC
  126. 60 CONTINUE
  127. *
  128. RETURN
  129. END
  130.  
  131.  
  132.  

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