C ELKONV SOURCE CHAT 05/01/12 23:33:25 5004 SUBROUTINE ELKONV(ELTFA,FACEL,MELEMF,MELEMC,MELEME) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC SMLENTI -INC SMELEME POINTEUR ELTFA.MELEME,FACEL.MELEME,MELEMC.MELEME DIMENSION NTYP(7) C SEG2,TRI3,QUA4,TET4,PYR5,PRI6,CUB8 DATA NTYP/3 ,8 ,9 ,25 ,16 ,7 ,11 / C SEG3,QUA4,QUA5,PYR5,PRI6,TRI7,QUA9 CALL KRIPAD(MELEMF,MLENTI) SEGACT ELTFA,FACEL,MELEMC NBSOUS=ELTFA.LISOUS(/1) IF(NBSOUS.EQ.0)THEN NBNN=ELTFA.NUM(/1)+1 NBELEM=ELTFA.NUM(/2) NBREF=0 SEGINI MELEME ITYPEL=NTYP(NBNN) K0=0 DO 1 K=1,NBELEM K0=K0+1 I0=MELEMC.NUM(1,K0) NUM(NBNN,K)=I0 DO 1 I=1,NBNN-1 I1=ELTFA.NUM(I,K) I2=LECT(I1) I3=FACEL.NUM(1,I2) NUM(I,K)=I3 IF(I3.EQ.I0)NUM(I,K)=FACEL.NUM(3,I2) C write(6,*)K,I0,I1,I2,FACEL.NUM(1,I2),FACEL.NUM(3,I2) 1 CONTINUE SEGDES MELEME,MELEMC,ELTFA,FACEL SEGSUP MLENTI C call ecrobj('MAILLAGE',meleme) C call prlist ELSEIF(NBSOUS.NE.0)THEN NBREF=0 NBNN=0 NBELEM=0 SEGINI MELEME NBS=NBSOUS K0=0 DO 2 L=1,NBS NBSOUS=0 IPT2=ELTFA.LISOUS(L) SEGACT IPT2 NBELEM=IPT2.NUM(/2) NBREF=0 NBNN=IPT2.NUM(/1)+1 SEGINI IPT1 IPT1.ITYPEL=NTYP(NBNN) LISOUS(L)=IPT1 DO 3 K=1,NBELEM K0=K0+1 I0=MELEMC.NUM(1,K0) IPT1.NUM(NBNN,K)=I0 DO 3 I=1,NBNN-1 I1=IPT2.NUM(I,K) I2=LECT(I1) I3=FACEL.NUM(1,I2) IPT1.NUM(I,K)=I3 IF(I3.EQ.I0)IPT1.NUM(I,K)=FACEL.NUM(3,I2) C write(6,*)K,I0,I1,I2,FACEL.NUM(1,I2),FACEL.NUM(3,I2) 3 CONTINUE SEGDES IPT1,IPT2 2 CONTINUE C call ecrobj('MAILLAGE',meleme) C call prlist SEGDES MELEME,MELEMC,ELTFA,FACEL SEGSUP MLENTI ENDIF RETURN END