C DEMCHA SOURCE PV 20/04/04 21:15:01 10567 SUBROUTINE DEMCHA(IPT8,MELEME) * * met en element quadratique un maillage meleme. * on teste dans ipt8 si des elements quadratiques existent deja * * SG 2016/07/21 : ajout gestion des elements QUAF * IMPLICIT INTEGER(I-N) -INC SMELEME -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC SMCOORD logical ltelq SEGMENT KONPOS(NBPTS) SEGMENT KONFIN(IKOUR) SEGMENT KONMIL(IKOUR) SEGMENT KONSUI(IKOUR) SEGMENT INOU(NBS) * PARAMETER(NQUAF=2+4) * Tableau indiquant les numeros des elements QUAFs (quadratiques * fluides) et des QUADs (quadratiques normaux) correspondant * cf. tableau NOMS de bdata.eso * INTEGER ITQUAF(NQUAF) INTEGER ITQUAD(NQUAF) * TRI7 QUA9 CU27 PR21 TE15 PY19 DATA ITQUAF/ 7 , 11, 33, 34, 35, 36/ * TRI6 QUA8 CU20 PR15 TE10 PY13 DATA ITQUAD/ 6 , 10, 15, 17, 24, 26/ * * * I PRISE EN COMPTE DU MAILLAGE DE SURFACE 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) GOTO 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.NE.0) THEN SEGSUP IPT7 ENDIF 60 CONTINUE * MAINTENANT ON S'ATTAQUE A LA TRANSFORMATION DU MAILLAGE lineaire * SG 2016/07/21 et/ou des QUAF (dans ce dernier cas, il suffit * d'oublier les noeuds au centre des faces et de l'element) 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) ITY=IPT7.ITYPEL * l'element est-il un quadratique fluide (quaf) ? iquaf=0 do i=1,nquaf if (ity.eq.itquaf(i)) then iquaf=i goto 666 endif enddo 666 continue * oui, c'est un quaf, on ne garde que les noeuds quadratiques * "normaux" (par chance de la definition des quaf, ce sont les n premiers) if (iquaf.ne.0) then itype=itquad(iquaf) NBNN=NBNNE(ITYPE) NBSOUS=0 NBREF=0 SEGINI IPT6 IPT6.ITYPEL=ITYPE INOU(ISOUS)=IPT6 DO J=1,NBELEM DO I=1,NBNN IPT6.NUM(I,J)=IPT7.NUM(I,J) IPT6.ICOLOR(J)=IPT7.ICOLOR(J) ENDDO ENDDO goto 101 endif 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 101 CONTINUE 100 CONTINUE SEGSUP KONFIN,KONMIL,KONSUI,KONPOS * on fusionne les sous parties 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