C KDOM SOURCE PV 20/03/31 14:33:32 10567 SUBROUTINE KDOM C************************************************************************ C C OBJET : Cree une table de soustype DOMAINE C SYNTAXE : A = KDOM OBJ1 C C OBJ1 objet 'MAILLAGE' C IMPR impressions de controle C La table cree contient les informations suivantes: C C Indice Objet C Type Valeur Type Valeur C MOT SOUSTYPE MOT DOMAINE C MOT MAILLAGE MAILLAGE C MOT SOMMET MAILLAGE C MOT CENTRE MAILLAGE C MOT FACE MAILLAGE C MOT FACEL MAILLAGE C MOT NPTD ENTIER C MOT NELD ENTIER C MOT NBFD ENTIER C MOT OBJINCLU LISTMOTS C************************************************************************ IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCNOYAU -INC PPARAM -INC CCOPTIO -INC SMCOORD PARAMETER (NMO1=4) CHARACTER*8 MO1(NMO1) CHARACTER*(LONOM) NOMDOM CHARACTER*8 NOM,TYPEL(20),TYPE,NOMI,MTYP PARAMETER (LM1=9) CHARACTER*8 LIST1(LM1),LIST2(LM1) C*** DATA MO1/'IMPR ','INCL ','MACRO ',' '/ DATA LIST1/'VOLUME ','COTE ','DIAMAX ','DIAMIN ', & 'NORMALE ','SURFACE ','ORIENTAT','DSOMMET ','DCENTRE '/ DATA LIST2/'XXVOLUM ','XXCOTE ','XXDIAME ','XXDIEMIN', & 'XXNORMAF','XXSURFAC','XXNORMAE','XXDIAGSI','XXVOLUM '/ CHARACTER*8 CHAI * segact mcoord * C C**** Cas VF C CALL LIRCHA(CHAI,0,IRET) IF(IRET.NE.0)THEN IF(CHAI.EQ. 'VF ')THEN CALL KDOM0 RETURN ELSE CALL REFUS ENDIF ENDIF C C****** Fin cas VF C MMODEL=0 MTABI=0 MACRO=0 CALL LIROBJ('MAILLAGE',MELEME,0,IRET) IF(IRET.EQ.0)THEN C write(6,*)' 2eme utilisation de DOMA ' TYPE=' ' CALL QUETYP(TYPE,1,IRET) IF(IRET.EQ.0)THEN WRITE(6,*)' On attend un objet TABLE ou MMODEL' RETURN ENDIF IF(TYPE.EQ.'TABLE')THEN CALL LIROBJ(TYPE,MTABLE,1,IRET) INEFMD=0 ELSEIF(TYPE.EQ.'MMODEL') THEN CALL LIROBJ(TYPE,MMODEL,1,IRET) CALL LEKMOD(MMODEL,MTABLE,INEFMD) IF(MTABLE.EQ.0)RETURN ELSE WRITE(6,*)' On attend un objet TABLE ou MMODEL' RETURN ENDIF CALL LIRCHA(NOM,1,LCHAR) IF(LCHAR.EQ.0)THEN WRITE(6,*)' On attend une CHAINE' RETURN ENDIF IF(NOM.EQ.'IMPR ')THEN CALL KDIMPR(MTABLE) RETURN ENDIF IF(NOM.EQ.'TABLE '.AND.MMODEL.NE.0)THEN CALL LEKMOD(MMODEL,MTABD,INEFMD) CALL ECROBJ('TABLE ',MTABD) RETURN ENDIF CALL OPTLI(IP,LIST1,NOM,LM1) IF(IP.NE.0)THEN NOMI=LIST2(IP) ELSE NOMI=NOM ENDIF MTB = -MTABLE CALL LEKTAB(MTB,NOMI,IPOINT) RETURN ENDIF CALL QUENOM(NOMDOM) CALL XDIAMM(MELEME,DIAM) DIAM=DIAM*0.0003D0 CALL LIRREE(TOLER,0,IRET) IF(IRET.EQ.0)TOLER=DIAM IMPR=0 1 CONTINUE 21 CONTINUE CALL QUETYP(MTYP,0,IRET) IP=0 IF(MTYP.EQ.'MOT')THEN CALL LIRCHA(NOM,1,LCHAR) IF(NOM.EQ.' ')GO TO 21 CALL OPTLI(IP,MO1,NOM,NMO1) IF(IP.EQ.4)IP=0 c IF(IP.EQ.9999)CALL KDAM ENDIF IF(IP.EQ.1)THEN IMPR=1 GO TO 1 ELSEIF(IP.EQ.2)THEN CALL LIROBJ('TABLE',MTABI,1,IRET) IF(IRET.EQ.0)RETURN CALL LIRREE(TOLER,0,IRET) IF(IRET.EQ.0)TOLER=DIAM GO TO 1 ELSEIF(IP.EQ.3)THEN MACRO=1 GO TO 1 ELSE GO TO 2 ENDIF 2 CONTINUE CALL KKDOM(MELEME,MACRO,TOLER,NOMDOM,MTABI,MTABD,INEFMD) CALL ECME(MTABD,'PRECONDI',1) C? CALL KKDOM(MELEME,MACRO,TOLER,NOMDOM,MTABI,MTABD) IF(IMPR.NE.0)CALL KDIMPR(MTABD) CALL ECROBJ('TABLE ',MTABD) C write(6,*)' FIN DOMA ' RETURN END