Télécharger rlexco.eso

Retour à la liste

Numérotation des lignes :

  1. C RLEXCO SOURCE PV 09/03/12 21:33:51 6325
  2. SUBROUTINE RLEXCO(MLEFC,MACOE2,MCHELM)
  3. C
  4. C**** Definition de MCHAML qui contient les coefficients
  5. C pour le calcul du gradient
  6. C
  7. C
  8. C**** Variables de COOPTIO
  9. C
  10. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  11. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  12. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  13. C & ,IECHO, IIMPI, IOSPI
  14. C & ,IDIM
  15. C & ,MCOORD
  16. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  17. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  18. C & ,NORINC,NORVAL,NORIND,NORVAD
  19. C & ,NUCROU, IPSAUV
  20. C
  21. IMPLICIT INTEGER(I-N)
  22. -INC CCOPTIO
  23. INTEGER NBL, NBTPOI
  24. SEGMENT MLELEM
  25. INTEGER INDEX(NBL+1)
  26. INTEGER LESPOI(NBTPOI)
  27. ENDSEGMENT
  28. POINTEUR MLEFC.MLELEM
  29. C
  30. INTEGER N1,N2
  31. SEGMENT MATRIX
  32. REAL*8 MAT(N1,N2)
  33. ENDSEGMENT
  34. POINTEUR MACOE2.MATRIX
  35. C
  36. INTEGER N3,L1,N1PTEL,N1EL,N2PTEL,N2EL
  37. -INC SMCHAML
  38. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  39. -INC SMELEME
  40. INTEGER JG
  41. -INC SMLENTI
  42. POINTEUR MLELAS.MLENTI, MLECON.MLENTI, MLEELT.MLENTI
  43. C
  44. INTEGER NMAX, IELEM, IPOS, IPOS1, ISOUS, NTSOUS, NG
  45. & , I1, I2, I3, IPOS2
  46. C
  47. SEGACT MLEFC
  48. SEGACT MACOE2
  49. NBL=MLEFC.INDEX(/1)-1
  50. C
  51. NMAX=0
  52. IPOS1=MLEFC.INDEX(1)
  53. DO IELEM = 1, NBL
  54. IPOS=IPOS1
  55. IPOS1=MLEFC.INDEX(1+IELEM)
  56. NMAX=MAX(NMAX,IPOS1-IPOS)
  57. ENDDO
  58. C
  59. C**** L'elt le plus grand a NMAX point
  60. C
  61. JG=NMAX
  62. SEGINI MLELAS
  63. SEGINI MLECON
  64. JG=NBL
  65. SEGINI MLEELT
  66. C
  67. C**** Les MLENTI ici initialisé
  68. C
  69. C MLELAS+MLEELT = structure pour definir les MAILLAGEs
  70. C du MCHELM
  71. C
  72. C NELT1=MLELAS.LECT(I) = 0 -> il n'y a pas d'elts avec I points
  73. C > 0 -> NELT1 a I points
  74. C Les autres elts avec I points sont
  75. C dedans MLEELT (liste chaînée qui
  76. C est lié à MLEELT)
  77. C
  78. C MLECON.LECT(I) = nombre de elts avec I points
  79. C
  80. C N.B: MLECON.LECT(I) est une information redondantemais pratique
  81. C
  82. C
  83. IPOS1=MLEFC.INDEX(1)
  84. DO IELEM = 1, NBL, 1
  85. IPOS=IPOS1
  86. IPOS1=MLEFC.INDEX(1+IELEM)
  87. NBNN=IPOS1-IPOS
  88. MLECON.LECT(NBNN)=MLECON.LECT(NBNN)+1
  89. MLEELT.LECT(IELEM)= MLELAS.LECT(NBNN)
  90. MLELAS.LECT(NBNN)=IELEM
  91. ENDDO
  92. C
  93. C**** Les supports
  94. C
  95. NTSOUS=0
  96. DO ISOUS=1,NMAX,1
  97. IF(MLECON.LECT(ISOUS).NE.0) NTSOUS=NTSOUS+1
  98. ENDDO
  99. C
  100. C**** Initialisation du MCHELM
  101. C
  102. N1=NTSOUS
  103. N2=IDIM
  104. N3=6
  105. L1=8
  106. SEGINI MCHELM
  107. MCHELM.TITCHE='Gradient'
  108. MCHELM.IFOCHE=IFOUR
  109. C
  110. ISOUS=0
  111. NBSOUS=0
  112. NBREF=0
  113. DO I1 = 1, NMAX, 1
  114. NBELEM=MLECON.LECT(I1)
  115. IF(NBELEM .GT. 0)THEN
  116. ISOUS=ISOUS+1
  117. NBNN=I1
  118. SEGINI MELEME
  119. C ITYPEL=32 -> 'POLY'
  120. ITYPEL=32
  121. MCHELM.IMACHE(ISOUS)=MELEME
  122. SEGINI MCHAML
  123. MCHELM.ICHAML(ISOUS)=MCHAML
  124. MCHAML.NOMCHE(1)='alphax '
  125. MCHAML.NOMCHE(2)='alphay '
  126. MCHAML.TYPCHE(1)='REAL*8 '
  127. MCHAML.TYPCHE(2)='REAL*8 '
  128. N1PTEL=NBNN
  129. N1EL=NBELEM
  130. N2PTEL=0
  131. N2EL=0
  132. SEGINI MELVA1
  133. SEGINI MELVA2
  134. MCHAML.IELVAL(1)=MELVA1
  135. MCHAML.IELVAL(2)=MELVA2
  136. IF(IDIM.EQ.3)THEN
  137. MCHAML.NOMCHE(3)='alphaz '
  138. MCHAML.TYPCHE(3)='REAL*8 '
  139. SEGINI MELVA3
  140. MCHAML.IELVAL(3)=MELVA3
  141. ENDIF
  142. IELEM=MLELAS.LECT(I1)
  143. IPOS=MLEFC.INDEX(IELEM)
  144. IPOS1=MLEFC.INDEX(IELEM+1)
  145. IF((IPOS1-IPOS).NE.NBNN)THEN
  146. WRITE(IOIMP,*) 'subroutine rlexco.eso'
  147. CALL ERREUR(5)
  148. GOTO 9999
  149. ENDIF
  150. C
  151. C********** MELEME.NUM(1,*) est le point face
  152. C
  153. DO I3=1,NBNN,1
  154. IPOS2=IPOS+I3-1
  155. NG=MLEFC.LESPOI(IPOS2)
  156. MELEME.NUM(I3,1)=NG
  157. MELVA1.VELCHE(I3,1)=MACOE2.MAT(1,IPOS2)
  158. MELVA2.VELCHE(I3,1)=MACOE2.MAT(2,IPOS2)
  159. IF(IDIM.EQ.3) MELVA3.VELCHE(I3,1)=MACOE2.MAT(3,IPOS2)
  160. ENDDO
  161. C
  162. DO I2=2,NBELEM,1
  163. IELEM=MLEELT.LECT(IELEM)
  164. IPOS=MLEFC.INDEX(IELEM)
  165. IPOS1=MLEFC.INDEX(IELEM+1)
  166. IF((IPOS1-IPOS).NE.NBNN)THEN
  167. WRITE(IOIMP,*) 'subroutine rlexco.eso'
  168. CALL ERREUR(5)
  169. GOTO 9999
  170. ENDIF
  171. C
  172. DO I3=1,NBNN,1
  173. IPOS2=IPOS+I3-1
  174. NG=MLEFC.LESPOI(IPOS2)
  175. MELEME.NUM(I3,I2)=NG
  176. MELVA1.VELCHE(I3,I2)=MACOE2.MAT(1,IPOS2)
  177. MELVA2.VELCHE(I3,I2)=MACOE2.MAT(2,IPOS2)
  178. IF(IDIM.EQ.3) MELVA3.VELCHE(I3,I2)=MACOE2.MAT(3,IPOS2)
  179. ENDDO
  180. ENDDO
  181. C
  182. IELEM=MLEELT.LECT(IELEM)
  183. IF(IELEM.NE.0)THEN
  184. WRITE(IOIMP,*) 'subroutine rlexco.eso'
  185. CALL ERREUR(5)
  186. GOTO 9999
  187. ENDIF
  188. SEGDES MCHAML
  189. SEGDES MELEME
  190. SEGDES MELVA1
  191. SEGDES MELVA2
  192. IF(IDIM.EQ.3) SEGDES MELVA3
  193. ENDIF
  194. ENDDO
  195. C
  196. SEGDES MCHELM
  197. C
  198. SEGSUP MLEFC
  199. SEGSUP MACOE2
  200. SEGSUP MLEELT
  201. SEGSUP MLECON
  202. SEGSUP MLELAS
  203. C
  204. 9999 RETURN
  205. END
  206.  
  207.  
  208.  
  209.  
  210. C
  211.  
  212.  
  213.  
  214.  
  215.  

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