C DEMCHA SOURCE BP208322 13/02/07 21:15:11 7696 SUBROUTINE DEMCHA(IPT8,MELEME) * * met en element quadratique un maillage meleme. * on teste dans ipt8 si des elements quadratiques existent deja * IMPLICIT INTEGER(I-N) -INC SMELEME -INC CCOPTIO -INC CCGEOME -INC SMCOORD logical ltelq SEGMENT KONPOS(NBPTS) SEGMENT KONFIN(IKOUR) SEGMENT KONMIL(IKOUR) SEGMENT KONSUI(IKOUR) SEGMENT INOU(NBS) * I PRISE EN COMPTE DU MAILLAGE DE SURFACE NBPTS=XCOOR(/1)/(IDIM+1) SEGINI KONPOS IKOUR=4*NBPTS SEGINI KONFIN,KONMIL,KONSUI KONCOU=0 * * traitement des elements deja quadratiques * SEGACT IPT8 IPT7=IPT8 NBSOUS=IPT8.LISOUS(/1) DO 60 ISOUS=1,MAX(1,NBSOUS) IF (NBSOUS.NE.0) IPT7=IPT8.LISOUS(ISOUS) SEGACT IPT7 ITY= IPT7.ITYPEL ISUP=0 IF( KDEGRE(ITY) . NE. 3) GO TO 61 IF( ITY.NE.3) THEN ISUP=1 CALL ECROBJ('MAILLAGE', IPT7) CALL CHANLG CALL LIROBJ('MAILLAGE',IPT7,1,IRETOU) IF(IERR.NE.0) RETURN SEGACT IPT7 ENDIF DO 70 J=1,IPT7.NUM(/2) I1=IPT7.NUM(1,J) I3=IPT7.NUM(3,J) J1=MIN(I1,I3) J3=MAX(I1,I3) ITFA=KONPOS(J1) IF (ITFA.EQ.0) GOTO 90 85 CONTINUE ITF=KONSUI(ITFA) IF (KONFIN(ITFA).EQ.J3) GOTO 70 IF (ITF.EQ.0) GOTO 90 ITFA=ITF GOTO 85 90 KONCOU=KONCOU+1 IF (KONCOU.GE.KONFIN(/1)) THEN IKOUR=KONCOU+500 SEGADJ KONFIN,KONMIL,KONSUI ENDIF IF (ITFA.EQ.0) THEN KONPOS(J1)=KONCOU ELSE KONSUI(ITFA)=KONCOU ENDIF KONFIN(KONCOU)=J3 KONMIL(KONCOU)=IPT7.NUM(2,J) 70 CONTINUE 61 CONTINUE IF(ISUP.EQ.0) THEN SEGDES IPT7 ELSE SEGSUP IPT7 ENDIF 60 CONTINUE SEGDES IPT8 * MAINTENANT ON S'ATTAQUE A LA TRANSFORMATION DU MAILLAGE lineaire IPT7=MELEME SEGACT MELEME NBSOU7=LISOUS(/1) NBSOUS=NBSOU7 NBS = MAX(1,NBSOU7) SEGINI INOU NBREF=0 NBELEM=0 NBNN=0 DO 100 ISOUS=1,MAX(1,NBSOU7) IF (NBSOU7.NE.0) IPT7=LISOUS(ISOUS) SEGACT IPT7 INOU(ISOUS)=IPT7 NBELEM=IPT7.NUM(/2) ITYPE=IPT7.ITYPEL+1 IF(IPT7.ITYPEL.EQ.4 . OR. IPT7.ITYPEL.EQ.5. OR . # IPT7.ITYPEL.EQ.8 . OR. IPT7.ITYPEL.EQ.9. OR. # IPT7.ITYPEL.EQ.18 . OR. IPT7.ITYPEL.EQ.19) ITYPE=ITYPE+1 NBNN=NBNNE(ITYPE) NBSOUS=0 NBREF=0 SEGINI IPT6 IPT6.ITYPEL=ITYPE * IF (NBSOU7.NE.0) IPT1.LISOUS(ISOUS)=IPT6 * CAS DES TETRAEDRES IF (IPT7.ITYPEL.EQ.23) THEN INOU(ISOUS)=IPT6 DO 200 J=1,NBELEM I1=IPT7.NUM(1,J) I2=IPT7.NUM(2,J) I3=IPT7.NUM(3,J) I4=IPT7.NUM(4,J) CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(1,J)=I1 IPT6.NUM(2,J)=I5 IPT6.NUM(3,J)=I2 CALL DEMCH1(I2,I3,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(4,J)=I5 IPT6.NUM(5,J)=I3 CALL DEMCH1(I3,I1,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(6,J)=I5 CALL DEMCH1(I1,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(7,J)=I5 CALL DEMCH1(I2,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(8,J)=I5 CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(9,J)=I5 IPT6.NUM(10,J)=I4 IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 200 CONTINUE * CAS DES PYRAMIDES ELSEIF (IPT7.ITYPEL.EQ.25) THEN INOU(ISOUS)=IPT6 DO 210 J=1,NBELEM I1=IPT7.NUM(1,J) I2=IPT7.NUM(2,J) I3=IPT7.NUM(3,J) I4=IPT7.NUM(4,J) I5=IPT7.NUM(5,J) CALL DEMCH1(I1,I2,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(1,J)=I1 IPT6.NUM(2,J)=I6 IPT6.NUM(3,J)=I2 CALL DEMCH1(I2,I3,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(4,J)=I6 IPT6.NUM(5,J)=I3 CALL DEMCH1(I3,I4,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(6,J)=I6 IPT6.NUM(7,J)=I4 CALL DEMCH1(I4,I1,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(8,J)=I6 CALL DEMCH1(I1,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(9,J)=I6 CALL DEMCH1(I2,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(10,J)=I6 CALL DEMCH1(I3,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(11,J)=I6 CALL DEMCH1(I4,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(12,J)=I6 IPT6.NUM(13,J)=I5 IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 210 CONTINUE * CAS DES PRISMES ELSEIF (IPT7.ITYPEL.EQ.16) THEN INOU(ISOUS)=IPT6 DO 220 J=1,NBELEM I1=IPT7.NUM(1,J) I2=IPT7.NUM(2,J) I3=IPT7.NUM(3,J) I4=IPT7.NUM(4,J) I5=IPT7.NUM(5,J) I6=IPT7.NUM(6,J) CALL DEMCH1(I1,I2,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(1,J)=I1 IPT6.NUM(2,J)=I7 IPT6.NUM(3,J)=I2 CALL DEMCH1(I2,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(4,J)=I7 IPT6.NUM(5,J)=I3 CALL DEMCH1(I3,I1,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(6,J)=I7 CALL DEMCH1(I1,I4,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(7,J)=I7 CALL DEMCH1(I2,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(8,J)=I7 CALL DEMCH1(I3,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(9,J)=I7 CALL DEMCH1(I4,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(10,J)=I4 IPT6.NUM(11,J)=I7 IPT6.NUM(12,J)=I5 CALL DEMCH1(I5,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(13,J)=I7 IPT6.NUM(14,J)=I6 CALL DEMCH1(I6,I4,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(15,J)=I7 IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 220 CONTINUE * CAS DES CUBES ELSEIF (IPT7.ITYPEL.EQ.14) THEN INOU(ISOUS)=IPT6 DO 230 J=1,NBELEM I1=IPT7.NUM(1,J) I2=IPT7.NUM(2,J) I3=IPT7.NUM(3,J) I4=IPT7.NUM(4,J) I5=IPT7.NUM(5,J) I6=IPT7.NUM(6,J) I7=IPT7.NUM(7,J) I8=IPT7.NUM(8,J) CALL DEMCH1(I1,I2,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(1,J)=I1 IPT6.NUM(2,J)=I9 IPT6.NUM(3,J)=I2 CALL DEMCH1(I2,I3,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(4,J)=I9 IPT6.NUM(5,J)=I3 CALL DEMCH1(I3,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(6,J)=I9 IPT6.NUM(7,J)=I4 CALL DEMCH1(I4,I1,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(8,J)=I9 CALL DEMCH1(I1,I5,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(9,J)=I9 CALL DEMCH1(I2,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(10,J)=I9 CALL DEMCH1(I3,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(11,J)=I9 CALL DEMCH1(I4,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(12,J)=I9 CALL DEMCH1(I5,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(13,J)=I5 IPT6.NUM(14,J)=I9 IPT6.NUM(15,J)=I6 CALL DEMCH1(I6,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(16,J)=I9 IPT6.NUM(17,J)=I7 CALL DEMCH1(I7,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(18,J)=I9 IPT6.NUM(19,J)=I8 CALL DEMCH1(I5,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(20,J)=I9 IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 230 CONTINUE * CAS DES SEG2 ELSEIF (IPT7.ITYPEL.EQ.2) THEN INOU(ISOUS)=IPT6 DO 240 J=1,NBELEM I1=IPT7.NUM(1,J) I2=IPT7.NUM(2,J) CALL DEMCH1(I1,I2,I3,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(1,J)=I1 IPT6.NUM(2,J)=I3 IPT6.NUM(3,J)=I2 IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 240 CONTINUE * CAS DES TRI3 ou des tri4 ELSEIF (IPT7.ITYPEL.EQ.4.OR.IPT7.ITYPEL.EQ.5) THEN INOU(ISOUS)=IPT6 DO 250 J=1,NBELEM I1=IPT7.NUM(1,J) I2=IPT7.NUM(2,J) I3=IPT7.NUM(3,J) CALL DEMCH1(I1,I2,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(1,J)=I1 IPT6.NUM(2,J)=I4 IPT6.NUM(3,J)=I2 CALL DEMCH1(I2,I3,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(4,J)=I4 IPT6.NUM(5,J)=I3 CALL DEMCH1(I1,I3,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(6,J)=I4 IF(IPT7.ITYPEL.EQ.5)IPT6.NUM(7,J)=IPT7.NUM(4,J) IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 250 CONTINUE * CAS DES QUA4 ou des QUA5 ELSEIF (IPT7.ITYPEL.EQ.8.OR.IPT7.ITYPEL.EQ.9) THEN INOU(ISOUS)=IPT6 DO 260 J=1,NBELEM I1=IPT7.NUM(1,J) I2=IPT7.NUM(2,J) I3=IPT7.NUM(3,J) I4=IPT7.NUM(4,J) CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(1,J)=I1 IPT6.NUM(2,J)=I5 IPT6.NUM(3,J)=I2 CALL DEMCH1(I2,I3,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(4,J)=I5 IPT6.NUM(5,J)=I3 CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(6,J)=I5 IPT6.NUM(7,J)=I4 CALL DEMCH1(I1,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(8,J)=I5 IF(IPT7.ITYPEL.EQ.9)IPT6.NUM(9,J)=IPT7.NUM(5,J) IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 260 CONTINUE * CAS des RAC2 ELSEIF (IPT7.ITYPEL.EQ.12) THEN INOU(ISOUS)=IPT6 DO 270 J=1,NBELEM I1=IPT7.NUM(1,J) I2=IPT7.NUM(2,J) I3=IPT7.NUM(3,J) I4=IPT7.NUM(4,J) CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(1,J)=I1 IPT6.NUM(2,J)=I5 IPT6.NUM(3,J)=I2 CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(4,J)=I3 IPT6.NUM(5,J)=I5 IPT6.NUM(5,J)=I4 IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 270 CONTINUE * CAS des lia3 ELSEIF (IPT7.ITYPEL.EQ.18) THEN INOU(ISOUS)=IPT6 DO 280 J=1,NBELEM I1=IPT7.NUM(1,J) I2=IPT7.NUM(2,J) I3=IPT7.NUM(3,J) I4=IPT7.NUM(4,J) I5=IPT7.NUM(5,J) I6=IPT7.NUM(6,J) CALL DEMCH1(I1,I2,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(1,J)=I1 IPT6.NUM(2,J)=I7 IPT6.NUM(3,J)=I2 CALL DEMCH1(I2,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(4,J)=I7 IPT6.NUM(5,J)=I3 CALL DEMCH1(I1,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(6,J)=I7 CALL DEMCH1(I4,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(7,J)=I4 IPT6.NUM(8,J)=I7 IPT6.NUM(9,J)=I5 CALL DEMCH1(I5,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(10,J)=I7 IPT6.NUM(11,J)=I5 CALL DEMCH1(I4,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(12,J)=I7 IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 280 CONTINUE * CAS des lia4 ELSEIF (IPT7.ITYPEL.EQ.18) THEN INOU(ISOUS)=IPT6 DO 290 J=1,NBELEM I1=IPT7.NUM(1,J) I2=IPT7.NUM(2,J) I3=IPT7.NUM(3,J) I4=IPT7.NUM(4,J) I5=IPT7.NUM(5,J) I6=IPT7.NUM(6,J) I7=IPT7.NUM(7,J) I8=IPT7.NUM(8,J) CALL DEMCH1(I1,I2,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(1,J)=I1 IPT6.NUM(2,J)=I9 IPT6.NUM(3,J)=I2 CALL DEMCH1(I2,I3,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(4,J)=I9 IPT6.NUM(5,J)=I3 CALL DEMCH1(I3,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(6,J)=I9 IPT6.NUM(7,J)=I4 CALL DEMCH1(I1,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(8,J)=I9 CALL DEMCH1(I5,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(9,J)=I5 IPT6.NUM(10,J)=I9 IPT6.NUM(11,J)=I6 CALL DEMCH1(I6,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(12,J)=I9 IPT6.NUM(13,J)=I7 CALL DEMCH1(I7,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(14,J)=I9 IPT6.NUM(15,J)=I8 CALL DEMCH1(I5,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) IPT6.NUM(16,J)=I9 IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 290 CONTINUE ENDIF SEGDES IPT7 SEGDES IPT6 100 CONTINUE SEGSUP KONFIN,KONMIL,KONSUI,KONPOS * on fusionne les sous parties SEGDES MELEME II=INOU(/1) IRETOU=INOU(1) IF(II.EQ.1) GO TO 15 DO 16 J=2,II INN=INOU(J) ltelq=.false. CALL FUSE( IRETOU,INN,IPT5,ltelq) IRETOU=IPT5 16 CONTINUE 15 CONTINUE MELEME=IRETOU END