Télécharger cqf2ln.eso

Retour à la liste

Numérotation des lignes :

  1. C CQF2LN SOURCE CHAT 05/01/12 22:27:26 5004
  2. SUBROUTINE CQF2LN(MELEME,MLINE)
  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 construits à parir des sommets
  12. C
  13. C SEG2 TRI3 QUA4 CUB8 PRI6 TET4 PYR5
  14. C 2 4 8 14 16 23 25
  15. C************************************************************************
  16. -INC SMELEME
  17. POINTEUR MLINE.MELEME
  18.  
  19. SEGACT MELEME
  20. NBSOU1=LISOUS(/1)
  21. IF(NBSOU1.EQ.0)NBSOU1=1
  22.  
  23. C write(6,*)'CQF2MC il y a a faire '
  24.  
  25. NBSOUS=NBSOU1
  26. NBNN=0
  27. NBELEM=0
  28. NBREF=0
  29. SEGINI MLINE
  30. DO 200 L=1,NBSOU1
  31. IPT1=MELEME
  32. IF(NBSOU1.NE.1)IPT1=LISOUS(L)
  33. SEGACT IPT1
  34. ITYP=IPT1.ITYPEL
  35. NBNN0=IPT1.NUM(/1)
  36. NBELEM=IPT1.NUM(/2)
  37. MLINE.LISOUS(L)=IPT1
  38.  
  39. IF(ITYP.EQ.3)THEN
  40. C SEG3 -> SEG2
  41. NBNN=2
  42. NBSOUS=0
  43. NBREF=0
  44. SEGINI IPT2
  45. MLINE.LISOUS(L)=IPT2
  46. IPT2.ITYPEL=2
  47. DO 202 K=1,NBELEM
  48. IPT2.NUM(1,K)=IPT1.NUM(1,K)
  49. IPT2.NUM(2,K)=IPT1.NUM(3,K)
  50. 202 CONTINUE
  51.  
  52. ELSEIF(ITYP.EQ.7)THEN
  53. C TRI7 -> TRI3
  54. NBNN=3
  55. NBSOUS=0
  56. NBREF=0
  57. SEGINI IPT2
  58. MLINE.LISOUS(L)=IPT2
  59. IPT2.ITYPEL=4
  60. DO 204 K=1,NBELEM
  61. I1=0
  62. DO 204 I=1,6,2
  63. I1=I1+1
  64. IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  65. 204 CONTINUE
  66.  
  67. ELSEIF(ITYP.EQ.11)THEN
  68. C QUA9 -> QUA4
  69. NBNN=4
  70. NBSOUS=0
  71. NBREF=0
  72. SEGINI IPT2
  73. MLINE.LISOUS(L)=IPT2
  74. IPT2.ITYPEL=8
  75. DO 208 K=1,NBELEM
  76. I1=0
  77. DO 208 I=1,8,2
  78. I1=I1+1
  79. IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  80. 208 CONTINUE
  81.  
  82. ELSEIF(ITYP.EQ.33)THEN
  83. C CU27 -> CUB8
  84. NBNN=8
  85. NBSOUS=0
  86. NBREF=0
  87. SEGINI IPT2
  88. MLINE.LISOUS(L)=IPT2
  89. IPT2.ITYPEL=14
  90. DO 214 K=1,NBELEM
  91. I1=0
  92. DO 214 I=1,8,2
  93. I1=I1+1
  94. IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  95. IPT2.NUM(I1+4,K)=IPT1.NUM(I+12,K)
  96. 214 CONTINUE
  97.  
  98. ELSEIF(ITYP.EQ.34)THEN
  99. C PR21 -> PRI6
  100. NBNN=6
  101. NBSOUS=0
  102. NBREF=0
  103. SEGINI IPT2
  104. MLINE.LISOUS(L)=IPT2
  105. IPT2.ITYPEL=16
  106. DO 216 K=1,NBELEM
  107. I1=0
  108. DO 216 I=1,6,2
  109. I1=I1+1
  110. IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  111. IPT2.NUM(I1+3,K)=IPT1.NUM(I+9,K)
  112. 216 CONTINUE
  113.  
  114. ELSEIF(ITYP.EQ.35)THEN
  115. C TE15 -> TET4
  116. NBNN=4
  117. NBSOUS=0
  118. NBREF=0
  119. SEGINI IPT2
  120. MLINE.LISOUS(L)=IPT2
  121. IPT2.ITYPEL=23
  122. DO 2230 K=1,NBELEM
  123. I1=0
  124. DO 223 I=1,6,2
  125. I1=I1+1
  126. IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  127. 223 CONTINUE
  128. IPT2.NUM(4,K)=IPT1.NUM(10,K)
  129. 2230 CONTINUE
  130.  
  131. ELSEIF(ITYP.EQ.36)THEN
  132. C PY19 -> PYR5
  133. NBNN=5
  134. NBSOUS=0
  135. NBREF=0
  136. SEGINI IPT2
  137. MLINE.LISOUS(L)=IPT2
  138. IPT2.ITYPEL=25
  139. DO 2250 K=1,NBELEM
  140. I1=0
  141. DO 225 I=1,8,2
  142. I1=I1+1
  143. IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  144. 225 CONTINUE
  145. IPT2.NUM(5,K)=IPT1.NUM(13,K)
  146. 2250 CONTINUE
  147.  
  148.  
  149. ENDIF
  150.  
  151. 200 CONTINUE
  152.  
  153. IF(NBSOU1.EQ.1)THEN
  154. IPT3=MLINE
  155. MLINE=MLINE.LISOUS(1)
  156. SEGSUP IPT3
  157. ENDIF
  158.  
  159. RETURN
  160. 1001 FORMAT(20(1X,I5))
  161. 1002 FORMAT(10(1X,1PE11.4))
  162. END
  163.  
  164.  
  165.  
  166.  
  167.  

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