Télécharger clinb.eso

Retour à la liste

Numérotation des lignes :

  1. C CLINB SOURCE CHAT 05/01/12 22:08:16 5004
  2. SUBROUTINE CLINB
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C************************************************************************
  6. C Ce sp transforme des éléments QUAF pris
  7. C dans la liste ci-dessous
  8. C SEG3 TRI7 QUA9 CU27 PR21 TE15 PY19
  9. C 3 7 11 33 34 35 36
  10. C
  11. C en les éléments linéaires bulle construits à parir des sommets
  12. C
  13. C SEG2 TRI4 QUA5 CUB9 PRI7 TET5 PYR6
  14. C 2 5 9 48 49 50 51
  15. C************************************************************************
  16. -INC SMELEME
  17. POINTEUR MLINB.MELEME
  18.  
  19. CALL LIROBJ('MAILLAGE',MELEME,1,IRET)
  20. IF(IRET.EQ.0)RETURN
  21.  
  22. SEGACT MELEME
  23. NBSOU1=LISOUS(/1)
  24. IF(NBSOU1.EQ.0)NBSOU1=1
  25.  
  26. C write(6,*)'CLINB il y a a faire '
  27.  
  28. NBSOUS=NBSOU1
  29. NBNN=0
  30. NBELEM=0
  31. NBREF=0
  32. SEGINI MLINB
  33. DO 200 L=1,NBSOU1
  34. IPT1=MELEME
  35. IF(NBSOU1.NE.1)IPT1=LISOUS(L)
  36. SEGACT IPT1
  37. ITYP=IPT1.ITYPEL
  38. NBNN0=IPT1.NUM(/1)
  39. NBELEM=IPT1.NUM(/2)
  40. MLINB.LISOUS(L)=IPT1
  41.  
  42. C write(6,*)' CLINB ITYP=',ityp
  43. IF(ITYP.EQ.3)THEN
  44. C SEG3 -> SEG2
  45. NBNN=2
  46. NBSOUS=0
  47. NBREF=0
  48. SEGINI IPT2
  49. MLINB.LISOUS(L)=IPT2
  50. IPT2.ITYPEL=2
  51. DO 202 K=1,NBELEM
  52. IPT2.NUM(1,K)=IPT1.NUM(1,K)
  53. IPT2.NUM(2,K)=IPT1.NUM(3,K)
  54. 202 CONTINUE
  55.  
  56. ELSEIF(ITYP.EQ.7)THEN
  57. C TRI7 -> TRI4
  58. NBNN=4
  59. NBSOUS=0
  60. NBREF=0
  61. SEGINI IPT2
  62. MLINB.LISOUS(L)=IPT2
  63. IPT2.ITYPEL=5
  64. DO 304 K=1,NBELEM
  65. I1=0
  66. DO 204 I=1,6,2
  67. I1=I1+1
  68. IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  69. 204 CONTINUE
  70. IPT2.NUM(4,K)=IPT1.NUM(7,K)
  71. 304 CONTINUE
  72.  
  73. ELSEIF(ITYP.EQ.11)THEN
  74. C QUA9 -> QUA5
  75. NBNN=5
  76. NBSOUS=0
  77. NBREF=0
  78. SEGINI IPT2
  79. MLINB.LISOUS(L)=IPT2
  80. IPT2.ITYPEL=9
  81. DO 308 K=1,NBELEM
  82. I1=0
  83. DO 208 I=1,8,2
  84. I1=I1+1
  85. IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  86. 208 CONTINUE
  87. IPT2.NUM(5,K)=IPT1.NUM(9,K)
  88. 308 CONTINUE
  89.  
  90. ELSEIF(ITYP.EQ.33)THEN
  91. C CU27 -> CUB8
  92. NBNN=8
  93. NBSOUS=0
  94. NBREF=0
  95. SEGINI IPT2
  96. MLINB.LISOUS(L)=IPT2
  97. IPT2.ITYPEL=14
  98. DO 214 K=1,NBELEM
  99. I1=0
  100. DO 214 I=1,8,2
  101. I1=I1+1
  102. IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  103. IPT2.NUM(I1+4,K)=IPT1.NUM(I+12,K)
  104. 214 CONTINUE
  105.  
  106. ELSEIF(ITYP.EQ.34)THEN
  107. C PR21 -> PRI6
  108. NBNN=6
  109. NBSOUS=0
  110. NBREF=0
  111. SEGINI IPT2
  112. MLINB.LISOUS(L)=IPT2
  113. IPT2.ITYPEL=16
  114. DO 216 K=1,NBELEM
  115. I1=0
  116. DO 216 I=1,6,2
  117. I1=I1+1
  118. IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  119. IPT2.NUM(I1+3,K)=IPT1.NUM(I+9,K)
  120. 216 CONTINUE
  121.  
  122. ELSEIF(ITYP.EQ.35)THEN
  123. C TE15 -> TET5
  124. NBNN=5
  125. NBSOUS=0
  126. NBREF=0
  127. SEGINI IPT2
  128. MLINB.LISOUS(L)=IPT2
  129. IPT2.ITYPEL=9
  130. DO 2230 K=1,NBELEM
  131. IPT2.NUM(1,K)=IPT1.NUM(1,K)
  132. IPT2.NUM(2,K)=IPT1.NUM(3,K)
  133. IPT2.NUM(3,K)=IPT1.NUM(5,K)
  134. IPT2.NUM(4,K)=IPT1.NUM(10,K)
  135. IPT2.NUM(5,K)=IPT1.NUM(15,K)
  136. 2230 CONTINUE
  137.  
  138. ELSEIF(ITYP.EQ.36)THEN
  139. C PY19 -> PYR5
  140. NBNN=5
  141. NBSOUS=0
  142. NBREF=0
  143. SEGINI IPT2
  144. MLINB.LISOUS(L)=IPT2
  145. IPT2.ITYPEL=25
  146. DO 2250 K=1,NBELEM
  147. I1=0
  148. DO 225 I=1,8,2
  149. I1=I1+1
  150. IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  151. 225 CONTINUE
  152. IPT2.NUM(5,K)=IPT1.NUM(13,K)
  153. 2250 CONTINUE
  154.  
  155.  
  156. ENDIF
  157.  
  158. 200 CONTINUE
  159.  
  160. IF(NBSOU1.EQ.1)THEN
  161. IPT3=MLINB
  162. MLINB=MLINB.LISOUS(1)
  163. SEGSUP IPT3
  164. ENDIF
  165.  
  166. CALL ECROBJ('MAILLAGE',MLINB)
  167.  
  168. RETURN
  169. 1001 FORMAT(20(1X,I5))
  170. 1002 FORMAT(10(1X,1PE11.4))
  171. END
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  

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