Télécharger rlexc1.eso

Retour à la liste

Numérotation des lignes :

  1. C RLEXC1 SOURCE PV 09/03/12 21:33:50 6325
  2. SUBROUTINE RLEXC1(MLEPOI,MLECOE,MCHELM)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : RLEXC1
  8. C
  9. C DESCRIPTION : Appelle par GRADI2
  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 Inputs:
  18. C
  19. C MLEPOI : pointers of list of points (FACE + 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. C
  28. C
  29. C**** Variables de COOPTIO
  30. C
  31. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  32. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  33. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  34. C & ,IECHO, IIMPI, IOSPI
  35. C & ,IDIM
  36. C & ,MCOORD
  37. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  38. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  39. C & ,NORINC,NORVAL,NORIND,NORVAD
  40. C & ,NUCROU, IPSAUV, IPREFI, IFICLE
  41. CC
  42. IMPLICIT INTEGER(I-N)
  43.  
  44. INTEGER N1,N2
  45. SEGMENT MATRIX
  46. REAL*8 MAT(N1,N2)
  47. ENDSEGMENT
  48. C
  49. -INC CCOPTIO
  50. INTEGER N3,L1,N1PTEL,N1EL,N2PTEL,N2EL
  51. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  52. INTEGER JG
  53. -INC SMCHAML
  54. -INC SMLREEL
  55. -INC SMLENTI
  56. -INC SMELEME
  57. POINTEUR MLELAS.MLENTI, MLECON.MLENTI, MLEELT.MLENTI
  58. & ,MLEPOI.MLENTI,MLECOE.MLENTI
  59. C
  60. INTEGER NFAC,NMAX,IFAC, NTSOUS, I1, NBNN0, I3, I2, NG, ISOUS
  61. C
  62. SEGACT MLEPOI
  63. SEGACT MLECOE
  64. NFAC=MLEPOI.LECT(/1)
  65. C
  66. C**** NMAX = maximum number of points in the element
  67. C 'FACE'-neighbors
  68. NMAX=0
  69. DO IFAC = 1, NFAC, 1
  70. MLENTI=MLEPOI.LECT(IFAC)
  71. SEGACT MLENTI
  72. NBNN=MLENTI.LECT(/1)
  73. NMAX=MAX(NMAX,NBNN)
  74. ENDDO
  75. C
  76. C**** We create the following MLENTI
  77. C
  78. C MLECON : dimension = NMAX
  79. C MLECON.LECT(I) = number of elements with I points
  80. C
  81. C MLELAS : dimension = NMAX
  82.  
  83. C MLELAS.LECT(I) = 0 -> there are no elements with I
  84. C points
  85. C
  86. C J -> the J-th element has I points
  87. C
  88. C
  89. C The other elements with I points are into the chaining list
  90. C MLEELT.
  91. C
  92. C MLEELT : dimension = NFAC
  93. C MLEELT+MLELAS allows to rapidly recover the elements
  94. C with the same number of points
  95. C For example, the elements with I points are:
  96. C IELEM = MLELAS.LECT(I)
  97. C IELEM2 = MLEELT.LECT(IELEM)
  98. C ...
  99. C IELEM_K+1 = MLEELT.LECT(IELEM_K)
  100. C ...
  101. C until IELEM_K+1 = 0
  102. C
  103. JG=NMAX
  104. SEGINI MLELAS
  105. SEGINI MLECON
  106. JG=NFAC
  107. SEGINI MLEELT
  108. DO IFAC = 1, NFAC, 1
  109. MLENTI=MLEPOI.LECT(IFAC)
  110. NBNN=MLENTI.LECT(/1)
  111. MLECON.LECT(NBNN)=MLECON.LECT(NBNN)+1
  112. MLEELT.LECT(IFAC)= MLELAS.LECT(NBNN)
  113. MLELAS.LECT(NBNN)=IFAC
  114. ENDDO
  115. C
  116. C**** Les supports
  117. C
  118. NTSOUS=0
  119. DO ISOUS=1,NMAX,1
  120. IF(MLECON.LECT(ISOUS).NE.0) NTSOUS=NTSOUS+1
  121. ENDDO
  122. C
  123. C**** Initialisation du MCHELM
  124. C
  125. N1=NTSOUS
  126. N2=IDIM
  127. N3=6
  128. L1=8
  129. SEGINI MCHELM
  130. MCHELM.TITCHE='Gradient'
  131. MCHELM.IFOCHE=IFOUR
  132. C
  133. ISOUS=0
  134. NBSOUS=0
  135. NBREF=0
  136. DO I1 = 1, NMAX, 1
  137. NBELEM=MLECON.LECT(I1)
  138. IF(NBELEM .GT. 0)THEN
  139. ISOUS=ISOUS+1
  140. NBNN=I1
  141. SEGINI MELEME
  142. C ITYPEL=32 -> 'POLY'
  143. ITYPEL=32
  144. MCHELM.IMACHE(ISOUS)=MELEME
  145. SEGINI MCHAML
  146. MCHELM.ICHAML(ISOUS)=MCHAML
  147. MCHAML.NOMCHE(1)='alphax '
  148. MCHAML.NOMCHE(2)='alphay '
  149. MCHAML.TYPCHE(1)='REAL*8 '
  150. MCHAML.TYPCHE(2)='REAL*8 '
  151. N1PTEL=NBNN
  152. N1EL=NBELEM
  153. N2PTEL=0
  154. N2EL=0
  155. SEGINI MELVA1
  156. SEGINI MELVA2
  157. MCHAML.IELVAL(1)=MELVA1
  158. MCHAML.IELVAL(2)=MELVA2
  159. IF(IDIM.EQ.3)THEN
  160. MCHAML.NOMCHE(3)='alphaz '
  161. MCHAML.TYPCHE(3)='REAL*8 '
  162. SEGINI MELVA3
  163. MCHAML.IELVAL(3)=MELVA3
  164. ENDIF
  165. IFAC=MLELAS.LECT(I1)
  166. MLENTI=MLEPOI.LECT(IFAC)
  167. MATRIX=MLECOE.LECT(IFAC)
  168. SEGACT MATRIX
  169. NBNN0=MLENTI.LECT(/1)
  170. IF(NBNN0.NE.NBNN)THEN
  171. WRITE(IOIMP,*) 'subroutine rlexc1.eso'
  172. CALL ERREUR(5)
  173. GOTO 9999
  174. ENDIF
  175. C
  176. C********** The first point of MLENTI is a FACE point
  177. C In the same way, MELEME.NUM(1,*) is the FACE point
  178. C
  179. C N.B. the first element is stored into MLELAS
  180. C the others are stored into MLEELT
  181. C
  182. DO I3=1,NBNN,1
  183. NG=MLENTI.LECT(I3)
  184. MELEME.NUM(I3,1)=NG
  185. MELVA1.VELCHE(I3,1)=MATRIX.MAT(2,I3)
  186. MELVA2.VELCHE(I3,1)=MATRIX.MAT(3,I3)
  187. IF(IDIM.EQ.3) MELVA3.VELCHE(I3,1)=MATRIX.MAT(4,I3)
  188. ENDDO
  189. SEGSUP MLENTI
  190. SEGSUP MATRIX
  191. C
  192. DO I2=2,NBELEM,1
  193. IFAC=MLEELT.LECT(IFAC)
  194. MLENTI=MLEPOI.LECT(IFAC)
  195. MATRIX=MLECOE.LECT(IFAC)
  196. SEGACT MATRIX
  197. NBNN0=MLENTI.LECT(/1)
  198. IF(NBNN0.NE.NBNN)THEN
  199. WRITE(IOIMP,*) 'subroutine rlexc1.eso'
  200. CALL ERREUR(5)
  201. GOTO 9999
  202. ENDIF
  203. C
  204. DO I3=1,NBNN,1
  205. NG=MLENTI.LECT(I3)
  206. MELEME.NUM(I3,I2)=NG
  207. MELVA1.VELCHE(I3,I2)=MATRIX.MAT(2,I3)
  208. MELVA2.VELCHE(I3,I2)=MATRIX.MAT(3,I3)
  209. IF(IDIM.EQ.3) MELVA3.VELCHE(I3,I2)=MATRIX.MAT(4,I3)
  210. ENDDO
  211. SEGSUP MLENTI
  212. SEGSUP MATRIX
  213. ENDDO
  214. C
  215. IFAC=MLEELT.LECT(IFAC)
  216. IF(IFAC.NE.0)THEN
  217. WRITE(IOIMP,*) 'subroutine rlexc1.eso'
  218. CALL ERREUR(5)
  219. GOTO 9999
  220. ENDIF
  221. SEGDES MCHAML
  222. SEGDES MELEME
  223. SEGDES MELVA1
  224. SEGDES MELVA2
  225. IF(IDIM.EQ.3) SEGDES MELVA3
  226. ENDIF
  227. ENDDO
  228. C
  229. SEGDES MCHELM
  230. C
  231. SEGSUP MLEPOI
  232. SEGSUP MLECOE
  233. SEGSUP MLEELT
  234. SEGSUP MLECON
  235. SEGSUP MLELAS
  236. C
  237. 9999 RETURN
  238. END
  239.  
  240.  
  241.  
  242.  
  243. C
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  

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