Télécharger rlxce1.eso

Retour à la liste

Numérotation des lignes :

  1. C RLXCE1 SOURCE KK2000 14/04/10 21:15:38 8032
  2. SUBROUTINE RLXCE1(MELEME,MLECOE,MCHELM)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : RLXCE1
  8. C
  9. C DESCRIPTION : Appelle par GRADGE
  10. C
  11. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  12. C
  13. C AUTEUR : A. BECCANTINI
  14. C
  15. C************************************************************************
  16. C
  17. C Input
  18. C
  19. C MELEME : SPG of MCHELM (CNETRE + neighbors)
  20. C
  21. C MLECOE : pointers of the list of coeff
  22. C
  23. C Output
  24. C
  25. C MCHELM : MCHAML which contains the coeff. to compute gradients
  26. C
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8(A-H,O-Z)
  29.  
  30. C
  31. INTEGER NSOU, JG, N3, L1, NBNN, NBELEM, ICEN, ISOUS
  32. & , N1PTEL, N1EL, N2PTEL, N2EL, IELEM, IVOI
  33. C
  34. INTEGER N1,N2
  35. SEGMENT MATRIX
  36. REAL*8 MAT(N1,N2)
  37. ENDSEGMENT
  38. C
  39. -INC CCOPTIO
  40. -INC SMCHAML
  41. -INC SMLENTI
  42. -INC SMELEME
  43. POINTEUR MLESOU.MLENTI, MLECOE.MLENTI
  44. C
  45. C**** We recover the elemenary mesh of MELEME
  46. C
  47. SEGACT MELEME
  48. SEGACT MLECOE
  49. NSOU=MAX(MELEME.LISOUS(/1),1)
  50. JG=NSOU
  51. SEGINI MLESOU
  52. IF (NSOU.EQ.1)THEN
  53. MLESOU.LECT(1)=MELEME
  54. ELSE
  55. DO ISOUS=1,NSOU,1
  56. IPT1=MELEME.LISOUS(ISOUS)
  57. MLESOU.LECT(ISOUS)=IPT1
  58. ENDDO
  59. ENDIF
  60. C
  61. C**** Initialisation du MCHELM
  62. C
  63. N1=NSOU
  64. N2=IDIM
  65. N3=6
  66. L1=8
  67. SEGINI MCHELM
  68. MCHELM.TITCHE='Gradient'
  69. MCHELM.IFOCHE=IFOUR
  70. C
  71. ICEN=0
  72. DO ISOUS = 1, NSOU, 1
  73. IPT1=MLESOU.LECT(ISOUS)
  74. MCHELM.IMACHE(ISOUS)=IPT1
  75. SEGINI MCHAML
  76. MCHELM.ICHAML(ISOUS)=MCHAML
  77. MCHAML.NOMCHE(1)='alphax '
  78. MCHAML.NOMCHE(2)='alphay '
  79. MCHAML.TYPCHE(1)='REAL*8 '
  80. MCHAML.TYPCHE(2)='REAL*8 '
  81. SEGACT IPT1
  82. NBNN=IPT1.NUM(/1)
  83. NBELEM=IPT1.NUM(/2)
  84. SEGDES IPT1
  85. N1PTEL=NBNN
  86. N1EL=NBELEM
  87. N2PTEL=0
  88. N2EL=0
  89. SEGINI MELVA1
  90. SEGINI MELVA2
  91. MCHAML.IELVAL(1)=MELVA1
  92. MCHAML.IELVAL(2)=MELVA2
  93. IF(IDIM.EQ.3)THEN
  94. MCHAML.NOMCHE(3)='alphaz '
  95. MCHAML.TYPCHE(3)='REAL*8 '
  96. SEGINI MELVA3
  97. MCHAML.IELVAL(3)=MELVA3
  98. ENDIF
  99. DO IELEM=1,NBELEM,1
  100. ICEN=ICEN+1
  101. MATRIX=MLECOE.LECT(ICEN)
  102. SEGACT MATRIX
  103. DO IVOI=1,NBNN,1
  104. MELVA1.VELCHE(IVOI,IELEM)=MATRIX.MAT(2,IVOI)
  105. MELVA2.VELCHE(IVOI,IELEM)=MATRIX.MAT(3,IVOI)
  106. IF(IDIM.EQ.3) MELVA3.VELCHE(IVOI,IELEM)=
  107. $ MATRIX.MAT(4,IVOI)
  108. ENDDO
  109. SEGSUP MATRIX
  110. ENDDO
  111. SEGDES MCHAML
  112. SEGDES MELEME
  113. SEGDES MELVA1
  114. SEGDES MELVA2
  115. IF(IDIM.EQ.3) SEGDES MELVA3
  116. ENDDO
  117. C
  118. SEGDES MCHELM
  119. C
  120. SEGSUP MLECOE
  121. SEGSUP MLESOU
  122. IF(NSOU .GT. 1) SEGSUP MELEME
  123. C
  124. RETURN
  125. END
  126.  
  127.  
  128.  
  129.  
  130. C
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  

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