C KMACRO SOURCE BP208322 16/11/18 21:18:14 9177 SUBROUTINE KMACRO(MELEME,MELEMM,MTABZ) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*8 TYPE,TYP2 -INC CCGEOME -INC SMELEME POINTEUR MELEMM.MELEME TYPE=' ' CALL ACMO(MTABZ,'MACRO1',TYPE,MELEMM) IF(MELEMM.NE.0)RETURN CALL ACMF(MTABZ,'TOLER',TOLER) TYP2='MAILLAGE' CALL ACMO(MTABZ,'SOMMET',TYP2,MELEMS) ICHAN=0 SEGACT MELEME NBSOUS=LISOUS(/1) NBREF =0 IF(NBSOUS.EQ.0)THEN NBSOUL=1 ELSE NBSOUL=NBSOUS ENDIF NBREF=0 NBNN=0 NBELEM=0 SEGINI MELEMM DO 1 L=1,NBSOUL IPT1=MELEME IF(NBSOUL.NE.1)IPT1=LISOUS(L) SEGACT IPT1 IPT2=IPT1 IF(NOMS(IPT1.ITYPEL).EQ.'QUA8')THEN ICHAN=1 CALL ECRCHA('QUA9') CALL ECROBJ('MAILLAGE',IPT1) CALL PRCHAN CALL LIROBJ('MAILLAGE',IPT2,1,IRET) IF(IRET.NE.1)RETURN CALL ECROBJ('MAILLAGE',IPT2) CALL ECROBJ('MAILLAGE',MELEMS) CALL PRFUSE CALL ECRREE(TOLER) CALL PRELIM(0) CALL LIROBJ('MAILLAGE',IPT0,1,IRET) IF(IRET.NE.1)RETURN ENDIF IF(NBSOUL.NE.1)THEN MELEMM.LISOUS(L)=IPT2 ELSE MELEMM=IPT2 ENDIF 1 CONTINUE CALL ECMO(MTABZ,'MACRO1','MAILLAGE',MELEMM) RETURN END