Télécharger gradge.eso

Retour à la liste

Numérotation des lignes :

  1. C GRADGE SOURCE KK2000 14/04/10 21:15:07 8032
  2. SUBROUTINE GRADGE(ICEN,IELTFA,IFAC,IFACEL,INORM,ICHCL,ICHAM)
  3. C------------------------------------------------------------------
  4. C PROJET : CASTEM 2000
  5. C
  6. C NOM : GRADGE
  7. C
  8. C DESCRIPTION : Cette subroutine est appellee par
  9. C PENT15 et calcule les coefficients a appliquer
  10. C sur la fonction dont on veut calculer le gradient
  11. C pour chacune des coordonnees. Ces coefficients
  12. C sont stockes dans ICHAM
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000
  15. C
  16. C AUTEUR : A. BECCANTINI, SFME/LTMF
  17. C
  18. C-----------------------------------------------------------------
  19. C
  20. C APPELES (E/S) :
  21. C
  22. C APPELES (Calcul): CONSDU, RSETXI, ELKONF
  23. C
  24. C-----------------------------------------------------------------
  25. C
  26. C INPUT : ICEN : 'CENTRE' points
  27. C
  28. C IELTFA : Element-faces
  29. C
  30. C IFAC : 'FACE' points
  31. C
  32. C IFACEL : Left center - face center -right center
  33. C Same order as IFAC
  34. C
  35. C INORM : Face normals CHAMPOINT
  36. C
  37. C ICHCL : BC CHAMPOINT
  38. C
  39. C
  40. C OUTPUT : ICHAM : MCHEML which contains the coefficients to
  41. C compute gradients.
  42. C
  43. C-----------------------------------------------------------------
  44. C
  45. C HISTORIQUE (Anomalies et modifications eventuelles)
  46. C
  47. C HISTORIQUE : 14.10.98, Creation
  48. C
  49. C-----------------------------------------------------------------
  50. C
  51. C
  52. C
  53. IMPLICIT INTEGER(I-N)
  54. IMPLICIT REAL*8(A-H,O-Z)
  55. C
  56. INTEGER ICEN, IELTFA, IFACEL, INORM, ICHCL, ICHAM, IFAC
  57. & ,MLECOE
  58. C
  59. -INC CCOPTIO
  60. -INC SMLENTI
  61. -INC SMELEME
  62. C
  63. C**** The FACE and CENTRE neighbors of each 'CENTRE' points
  64. C Two cases:
  65. C - If the 'FACE' point belongs to just one element, it belongs to
  66. C the neighbors of the element 'CENTRE'
  67. C - If the 'FACE' point belongs to two elements, the elements CENTREs
  68. C are neighbors
  69. C
  70. CALL RLENCE(ICEN,IELTFA,IFAC,IFACEL,MELEME)
  71. IF(IERR.NE.0) GOTO 9999
  72. C
  73. C RLENCE creates MELEME,
  74. C the mesh which contains the neighbors of the CENTRE and
  75. C the CENTRE itself
  76. CC
  77. CC**** Test RLENCE
  78. CC
  79. C SEGACT MELEME
  80. C NBSOUS=MELEME.LISOUS(/1)
  81. C JG=MAX(NBSOUS,1)
  82. C SEGINI MLENTI
  83. C IF (JG.EQ.1)THEN
  84. C MLENTI.LECT(1)=MELEME
  85. C ELSE
  86. C DO ISOUS=1,JG,1
  87. C MLENTI.LECT(ISOUS)=MELEME.LISOUS(ISOUS)
  88. C ENDDO
  89. C ENDIF
  90. C
  91. C DO ISOUS=1,JG,1
  92. C WRITE(IOIMP,*) 'SGP :', ISOUS, MLENTI.LECT(ISOUS)
  93. C IPT1=MLENTI.LECT(ISOUS)
  94. C SEGACT IPT1
  95. C NBNN=IPT1.NUM(/1)
  96. C NBELEM=IPT1.NUM(/2)
  97. C DO IELEM=1,NBELEM,1
  98. C WRITE(IOIMP,*) 'Center =', IPT1.NUM(NBNN,IELEM)
  99. C WRITE(IOIMP,*) 'Neighbors =',
  100. C & (IPT1.NUM(IVOI,IELEM),IVOI=1,(NBNN-1))
  101. C ENDDO
  102. C ENDDO
  103. CC
  104. CC**** Fin test RLENCE
  105. CC
  106. C
  107. CALL RLEXCE(MELEME,ICEN,IFAC,INORM,ICHCL,MLECOE)
  108. IF(IERR.NE.0) GOTO 9999
  109. C
  110. C MLECOE : list of integers.
  111. C MLECOE.LECT(I) is the pointer of the matrix of real
  112. C which contains the coefficient of the i-th centre
  113. C to compute its gradient as function of the values on
  114. C its neighbors.
  115. C
  116. CALL RLXCE1(MELEME,MLECOE,ICHAM)
  117. IF(IERR.NE.0) GOTO 9999
  118. C
  119. 9999 RETURN
  120. END
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  

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