Download kdimpr.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer