Télécharger kdimpr.eso

Retour à la liste

Numérotation des lignes :

  1. C KDIMPR SOURCE BP208322 16/11/18 21:18:05 9177
  2. SUBROUTINE KDIMPR(MTABD)
  3. C************************************************************************
  4. C
  5. C OBJET : Impression des caracteristiques du DOMAINE
  6. C Appele par KDOM
  7. C
  8. C************************************************************************
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8 (A-H,O-Z)
  11. CHARACTER*8 NOMDOM
  12. CHARACTER*8 NOM,TYPEL(20),NEM,TYPE
  13. C***
  14. -INC CCOPTIO
  15. -INC CCGEOME
  16. -INC SMLMOTS
  17. POINTEUR TABOG.MLMOTS
  18. -INC SMELEME
  19. -INC SMLENTI
  20. C***
  21.  
  22. NOMDOM=' '
  23. CALL ACME(MTABD,'NPTD',NPTD)
  24. CALL ACME(MTABD,'NELD',NELD)
  25. CALL ACME(MTABD,'NBFD',NBFD)
  26.  
  27. TYPE='MAILLAGE'
  28. CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME)
  29. TYPE=' '
  30. CALL ACMO(MTABD,'MACRO',TYPE,MACRO)
  31. IF(TYPE.NE.'MAILLAGE')MACRO=0
  32.  
  33. TYPE=' '
  34. CALL ACMO(MTABD,'OBJINCLU',TYPE,TABOG)
  35. IF(TYPE.NE.'LISTMOTS')THEN
  36. CALL ECROBJ('MAILLAGE',MELEME)
  37. CALL REFE
  38. CALL LIROBJ('LISTMOTS',TABOG,0,IRET)
  39. CALL ECMO(MTABD,'OBJINCLU','LISTMOTS',TABOG)
  40. ENDIF
  41.  
  42. NBTYP=0
  43. SEGACT MELEME
  44. NBSOUS=LISOUS(/1)
  45. IF(NBSOUS.EQ.0)NBSOUS=1
  46. DO 3 L=1,NBSOUS
  47. IF(NBSOUS.NE.1)THEN
  48. IPT1=LISOUS(L)
  49. SEGACT IPT1
  50. ELSE
  51. IPT1=MELEME
  52. ENDIF
  53. NBTYP=NBTYP+1
  54. NEM=NOMS(IPT1.ITYPEL)//' '
  55. TYPEL(NBTYP)=NEM
  56. IF(NBSOUS.NE.1)SEGDES IPT1
  57. 3 CONTINUE
  58. SEGDES MELEME
  59. C write(6,*)' Apres 3 '
  60.  
  61. WRITE(6,1909)NOMDOM,IDIM,NPTD,NELD
  62. 1909 FORMAT(/1X,9(8H********)/5X,'DOMAINE ',A8,' CREE DIM ESPACE:',
  63. & I2,' NB DE NOEUDS :',I8,/40X,
  64. & ' NB D ELEMENTS :',I8,/)
  65. WRITE(6,1919)
  66. IF(MACRO.NE.0)WRITE(6,*)' Eléments MACRO '
  67. DO M=1,NBTYP
  68. WRITE(6,1920) TYPEL(M)
  69. ENDDO
  70. 1919 FORMAT(5X,'TYPE DES ELEMENTS GEOMETRIQUES CONSTITUANT LE ',
  71. & 'DOMAINE DE MODELISATION',/)
  72. 1920 FORMAT(5X,A8/)
  73. IF(TABOG.NE.0) THEN
  74. WRITE(6,1983)
  75. 1983 FORMAT(10X,' LISTE DES OBJETS INCLUS DANS LE DOMAINE DE ',
  76. & 'MODELISATION',/)
  77. SEGACT TABOG
  78. NBO=TABOG.MOTS(/2)
  79. WRITE(6,1982)(TABOG.MOTS(MM),MM=1,NBO)
  80. 1982 FORMAT(7(2X,A8))
  81. SEGDES TABOG
  82. WRITE(6,1928)
  83. 1928 FORMAT(//1X,9('********')/)
  84. ENDIF
  85. RETURN
  86. END
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  

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