Télécharger lliste.eso

Retour à la liste

Numérotation des lignes :

lliste
  1. C LLISTE SOURCE CHAT 11/03/16 21:27:04 6902
  2. SUBROUTINE LLISTE(IPCHCO)
  3. C____________________________________________________________________
  4. C
  5. C IMPRESSION D'UN CHAMP DE CONNECTIVITE
  6. C
  7. C ENTREE : IPCHCO pointeur sur un champ de connectivite
  8. C
  9. C APPELE PAR : CONNEC
  10. C
  11. C PP 5/9/92
  12. C____________________________________________________________________
  13. C
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8(A-H,O-Z)
  16. LOGICAL LCOPLX
  17. C
  18. -INC SMMODEL
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMCHAML
  23. -INC SMLENTI
  24. C
  25. C CREATION DU MCHELM
  26. C
  27. MCHELM=IPCHCO
  28. SEGACT,MCHELM
  29. NSOUS=IMACHE(/1)
  30. WRITE(IOIMP,*)
  31. WRITE(IOIMP,*)'Liste du MCHAML cree par CONN'
  32. WRITE(IOIMP,*)
  33. WRITE(IOIMP,'(A50)')'ss type '//TITCHE
  34. WRITE(IOIMP,*)
  35. C____________________________________________________________________
  36. C
  37. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  38. C____________________________________________________________________
  39. C
  40. DO 500 ISOUS=1,NSOUS
  41. MCHAML=ICHAML(ISOUS)
  42. C
  43. SEGACT,MCHAML
  44. MELVA1=IELVAL(1)
  45. MELVA2=IELVAL(2)
  46. MELVA3=IELVAL(3)
  47. MELVA4=IELVAL(4)
  48. SEGACT,MELVA1,MELVA2,MELVA3,MELVA4
  49. C
  50. WRITE(IOIMP,*)
  51. WRITE(IOIMP,*)'SS-ZONE ',ISOUS, ' POINTEUR ',IMACHE(ISOUS)
  52. WRITE(IOIMP,*)' CONSTITUENT ',CONCHE(ISOUS)
  53. C PP WRITE(IOIMP,*)
  54. C PP WRITE(IOIMP,*)'NLAR ',MELVA1.VELCHE(1,1)
  55. C PP WRITE(IOIMP,*)
  56. WRITE(IOIMP,*)'PMOD'
  57. MMODEL=MELVA2.IELCHE(1,1)
  58. SEGACT,MMODEL
  59. DO 1 IE1=1,KMODEL(/1)
  60. IMODEL=KMODEL(IE1)
  61. SEGACT,IMODEL
  62. WRITE(IOIMP,*)IE1,IMAMOD
  63. SEGDES,IMODEL
  64. 1 CONTINUE
  65. SEGDES,MMODEL
  66. WRITE(IOIMP,*)
  67. NBELEM=MELVA3.IELCHE(/2)
  68. C
  69. C____________________________________________________________________
  70. C
  71. C BOUCLE SUR LES ELEMENTS DE LA SS ZONE
  72. C____________________________________________________________________
  73. C
  74. DO 499 IB=1,NBELEM
  75. MLENT1=MELVA3.IELCHE(1,IB)
  76. MLENT2=MELVA4.IELCHE(1,IB)
  77. IF(MLENT1.NE.0)THEN
  78. SEGACT,MLENT1,MLENT2
  79. C PP WRITE(IOIMP,*)'ELEMENT ',IB, ' NPNI et NPLI'
  80. C
  81. WRITE(IOIMP,*)'ELEMENT ',IB
  82. WRITE(IOIMP,*)' NLAR ',
  83. > (MELVA1.VELCHE(IG,MIN(IB,MELVA1.VELCHE(/2))),
  84. > IG=1,MELVA1.VELCHE(/1))
  85. WRITE(IOIMP,*)' NPNI et NPLI'
  86. C
  87. WRITE(IOIMP,*)
  88. II=1
  89. DO 200 IE1=1,MLENT1.LECT(/1)
  90. NII=MLENT2.LECT(II)
  91. WRITE(IOIMP,*)IE1,MLENT1.LECT(IE1),NII,' -->'
  92. WRITE(IOIMP,'(5(1X,I3))')(MLENT2.LECT(IE2),
  93. > IE2=II+1,II+NII)
  94. II=II+NII+1
  95. 200 CONTINUE
  96. WRITE(IOIMP,*)
  97. SEGDES,MLENT1,MLENT2
  98. ELSE
  99. WRITE(IOIMP,*)'ELEMENT ',IB, 'PAS DE CONNECTION'
  100. ENDIF
  101. 499 CONTINUE
  102. C
  103. SEGDES,MELVA1,MELVA2,MELVA3,MELVA4
  104. SEGDES,MCHAML
  105. 500 CONTINUE
  106. C____________________________________________________________________
  107. C
  108. C DESACTIVATION DES CHAMPS GLOBAUX
  109. C____________________________________________________________________
  110. C
  111. SEGDES,MCHELM
  112. RETURN
  113. END
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  

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