Télécharger chanli.eso

Retour à la liste

Numérotation des lignes :

  1. C CHANLI SOURCE GOUNAND 14/01/31 21:15:01 7924
  2. SUBROUTINE CHANLI
  3. *
  4. * ce sub fait passer tous les elemnts quadratique en lineaire,
  5. * il conserve le nombre d'elements
  6. * modif SG 01/2014 : passage des QUAFs aux linéaires
  7.  
  8. IMPLICIT INTEGER(I-N)
  9. -INC CCOPTIO
  10. -INC SMELEME
  11. logical ltelq
  12. SEGMENT INOO
  13. INTEGER INOU(NA)
  14. ENDSEGMENT
  15.  
  16. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  17. IF(IERR.NE.0) RETURN
  18. SEGACT IPT1
  19. MELEME=IPT1
  20. NBNN= NUM(/1)
  21. NBELEM=NUM(/2)
  22. NBSOUS=LISOUS(/1)
  23. NBREF=0
  24. NA= MAX(NBSOUS,1)
  25. SEGINI INOO
  26. DO 100 I=1,MAX(IPT1.LISOUS(/1),1)
  27. IF( IPT1.LISOUS(/1).NE.0) THEN
  28. MELEME=IPT1.LISOUS(I)
  29. SEGACT MELEME
  30. ENDIF
  31. NBELEM=NUM(/2)
  32. NBSOUS=0
  33. NBREF=0
  34. IF( ITYPEL.EQ.3)THEN
  35. * cas des seg3 ---> seg2
  36. NBNN=2
  37. SEGINI IPT2
  38. IPT2.ITYPEL=2
  39. INOU(I) = IPT2
  40. DO 1 K=1,NBELEM
  41. IPT2.NUM(1,K)=NUM(1,K)
  42. IPT2.NUM(2,K)=NUM(3,K)
  43. IPT2.ICOLOR(K)=ICOLOR(K)
  44. 1 CONTINUE
  45. SEGDES IPT2
  46. ELSEIF( ITYPEL.EQ.6. OR. ITYPEL.EQ.7) THEN
  47. * cas des tri6,tri7 ---> tri3
  48. NBNN=3
  49. SEGINI IPT2
  50. IPT2.ITYPEL=4
  51. INOU(I) = IPT2
  52. DO 2 K=1,NBELEM
  53. IPT2.NUM(1,K)=NUM(1,K)
  54. IPT2.NUM(2,K)=NUM(3,K)
  55. IPT2.NUM(3,K)=NUM(5,K)
  56. IPT2.ICOLOR(K)=ICOLOR(K)
  57. 2 CONTINUE
  58. SEGDES IPT2
  59. ELSEIF( ITYPEL.EQ.10 . OR. ITYPEL.EQ.11) THEN
  60. * cas des qua8,qua9-----> qua4
  61. NBNN=4
  62. SEGINI IPT2
  63. IPT2.ITYPEL=8
  64. INOU(I) = IPT2
  65. DO 3 K=1,NBELEM
  66. IPT2.NUM(1,K)=NUM(1,K)
  67. IPT2.NUM(2,K)=NUM(3,K)
  68. IPT2.NUM(3,K)=NUM(5,K)
  69. IPT2.NUM(4,K)=NUM(7,K)
  70. IPT2.ICOLOR(K)=ICOLOR(K)
  71. 3 CONTINUE
  72. SEGDES IPT2
  73. ELSEIF( ITYPEL.EQ.13) THEN
  74. *4 cas des rac3 ---> rac2
  75. NBNN=4
  76. SEGINI IPT2
  77. IPT2.ITYPEL=12
  78. INOU(I) = IPT2
  79. DO 4 K=1,NBELEM
  80. IPT2.NUM(1,K)=NUM(1,K)
  81. IPT2.NUM(2,K)=NUM(3,K)
  82. IPT2.NUM(3,K)=NUM(4,K)
  83. IPT2.NUM(4,K)=NUM(6,K)
  84. IPT2.ICOLOR(K)=ICOLOR(K)
  85. 4 CONTINUE
  86. SEGDES IPT2
  87. ELSEIF( ITYPEL.EQ.15.OR.ITYPEL.EQ.33) THEN
  88. *5 cas des cu20, cu27 ---> cub8
  89. NBNN=8
  90. SEGINI IPT2
  91. IPT2.ITYPEL=14
  92. INOU(I) = IPT2
  93. DO 5 K=1,NBELEM
  94. IPT2.NUM(1,K)=NUM(1,K)
  95. IPT2.NUM(2,K)=NUM(3,K)
  96. IPT2.NUM(3,K)=NUM(5,K)
  97. IPT2.NUM(4,K)=NUM(7,K)
  98. IPT2.NUM(5,K)=NUM(13,K)
  99. IPT2.NUM(6,K)=NUM(15,K)
  100. IPT2.NUM(7,K)=NUM(17,K)
  101. IPT2.NUM(8,K)=NUM(19,K)
  102. IPT2.ICOLOR(K)=ICOLOR(K)
  103. 5 CONTINUE
  104. SEGDES IPT2
  105. ELSEIF( ITYPEL.EQ.17.OR.ITYPEL.EQ.34) THEN
  106. *6 cas des pr15, pr21 ---> pri6
  107. NBNN=6
  108. SEGINI IPT2
  109. IPT2.ITYPEL=16
  110. INOU(I) = IPT2
  111. DO 6 K=1,NBELEM
  112. IPT2.NUM(1,K)=NUM(1,K)
  113. IPT2.NUM(2,K)=NUM(3,K)
  114. IPT2.NUM(3,K)=NUM(5,K)
  115. IPT2.NUM(4,K)=NUM(10,K)
  116. IPT2.NUM(5,K)=NUM(12,K)
  117. IPT2.NUM(6,K)=NUM(14,K)
  118. IPT2.ICOLOR(K)=ICOLOR(K)
  119. 6 CONTINUE
  120. SEGDES IPT2
  121. ELSEIF( ITYPEL.EQ.20. OR. itypel.eq.21) THEN
  122. *7 cas des lia6,lia8 ---> lia3,lia4
  123. NBNN=6
  124. IF(ITYPEL.EQ.21) NBNN=8
  125. SEGINI IPT2
  126. IPT2.ITYPEL=18
  127. IF(ITYPEL.EQ.21)IPT2.ITYPEL=19
  128. INOU(I) = IPT2
  129. DO 7 K=1,NBELEM
  130. IPT2.NUM(1,K)=NUM(1,K)
  131. IPT2.NUM(2,K)=NUM(3,K)
  132. IPT2.NUM(3,K)=NUM(5,K)
  133. IPT2.NUM(4,K)=NUM(7,K)
  134. IPT2.NUM(5,K)=NUM(9,K)
  135. IPT2.NUM(6,K)=NUM(11,K)
  136. IPT2.ICOLOR(K)=ICOLOR(K)
  137. IF( ITYPEL.EQ.21) THEN
  138. IPT2.NUM(7,K)=NUM(13,K)
  139. IPT2.NUM(8,K)=NUM(15,K)
  140. ENDIF
  141. 7 CONTINUE
  142. SEGDES IPT2
  143. ELSEIF( ITYPEL.EQ.24.OR.ITYPEL.EQ.35) THEN
  144. *8 cas des te10, te15 ---> te4
  145. NBNN=4
  146. SEGINI IPT2
  147. IPT2.ITYPEL=23
  148. INOU(I) = IPT2
  149. DO 8 K=1,NBELEM
  150. IPT2.NUM(1,K)=NUM(1,K)
  151. IPT2.NUM(2,K)=NUM(3,K)
  152. IPT2.NUM(3,K)=NUM(5,K)
  153. IPT2.NUM(4,K)=NUM(10,K)
  154. IPT2.ICOLOR(K)=ICOLOR(K)
  155. 8 CONTINUE
  156. SEGDES IPT2
  157. ELSEIF( ITYPEL.EQ.26.OR.ITYPEL.EQ.36) THEN
  158. *9 cas des py13, py19 ---> pyr5
  159. NBNN=5
  160. SEGINI IPT2
  161. IPT2.ITYPEL=25
  162. INOU(I) = IPT2
  163. DO 9 K=1,NBELEM
  164. IPT2.NUM(1,K)=NUM(1,K)
  165. IPT2.NUM(2,K)=NUM(3,K)
  166. IPT2.NUM(3,K)=NUM(5,K)
  167. IPT2.NUM(4,K)=NUM(7,K)
  168. IPT2.NUM(5,K)=NUM(13,K)
  169. IPT2.ICOLOR(K)=ICOLOR(K)
  170. 9 CONTINUE
  171. SEGDES IPT2
  172. ELSE
  173. *tous les autres elements : on engrange
  174. INOU(I) = MELEME
  175. ENDIF
  176. SEGDES MELEME
  177. 100 CONTINUE
  178. SEGDES IPT1
  179. * on fusionne les sous parties
  180. II=INOU(/1)
  181. IRETOU=INOU(1)
  182. IF(II.EQ.1) GO TO 15
  183. DO 16 J=2,II
  184. INN=INOU(J)
  185. ltelq=.false.
  186. CALL FUSE( IRETOU,INN,IPT5,ltelq)
  187. IRETOU=IPT5
  188. 16 CONTINUE
  189. 15 CONTINUE
  190. CALL ECROBJ('MAILLAGE',IRETOU)
  191. RETURN
  192. END
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  

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