Télécharger rlexco.eso

Retour à la liste

Numérotation des lignes :

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

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