Télécharger la plaquette Cast3M


fr en

Télécharger kdimpr.eso

Retour à la liste

Numérotation des lignes : 

kdimpr

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

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