C MOCE SOURCE PV 20/03/30 21:21:17 10567 C MODI RECENTRAGE DES POINTS MILIEUX (SAUF LE CONTOUR) C SUBROUTINE MOCE(MELEME,XPROJ,ICPR,IBOUJ) IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC SMELEME -INC CCGEOME -INC SMCOORD SEGMENT ICPR(0) SEGMENT IBOUJ(0) SEGMENT XPROJ(3,0) SEGMENT IAUX(nbpts) CALL ECROBJ('MAILLAGE',MELEME) CALL PRCONT CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU) IF (IERR.NE.0) RETURN SEGACT IPT1 * REACTIVONS LE MAILLAGE A TOUT HASARD SEGACT MELEME DO 100 I=1,LISOUS(/1) IPT2=LISOUS(I) SEGACT IPT2 100 CONTINUE IF (IPT1.ITYPEL.NE.3) THEN SEGDES IPT1 RETURN ENDIF SEGINI IAUX DO 110 I=1,IPT1.NUM(/2) IAUX(IPT1.NUM(2,I))=1 110 CONTINUE SEGDES IPT1 IPT1=MELEME DO 30 IO=1,MAX(1,LISOUS(/1)) IF (LISOUS(/1).NE.0) IPT1=LISOUS(IO) K=IPT1.ITYPEL IF (K.NE.KSURF(K)) GOTO 21 C LE NOMBRE DE FACE EST 1 QUEL EST SON TYPE KK=LTEL(2,K) ITYP=LDEL(1,KK) NBNN=KDEGRE(K) IF (NBNN.NE.3) GOTO 21 IPAS=NBNN-1 IDEP=LDEL(2,KK) IFEP=IDEP+KDFAC(1,ITYP)-1 * SG 20160711 pour les faces TRI7 et QUA9, on ignore le dernier * point (centre de la face) IF (ITYP.EQ.7.OR.ITYP.EQ.8) IFEP=IFEP-1 DO 22 I=1,IPT1.NUM(/2) DO 221 J=IDEP,IFEP,IPAS N1=IPT1.NUM(LFAC(J),I) JSUIV=J+IPAS IF (JSUIV.GT.IFEP) JSUIV=IDEP N2=IPT1.NUM(LFAC(JSUIV),I) NMIL=IPT1.NUM(LFAC(J+1),I) IF (IAUX(NMIL).NE.0) GOTO 221 IP1=ICPR(N1) IP2=ICPR(N2) IPMIL=ICPR(NMIL) XPROJ(1,IPMIL)=(XPROJ(1,IP1)+XPROJ(1,IP2))/2 XPROJ(2,IPMIL)=(XPROJ(2,IP1)+XPROJ(2,IP2))/2 XPROJ(3,IPMIL)=(XPROJ(3,IP1)+XPROJ(3,IP2))/2 CALL PROMOD(ICPR,XPROJ,NMIL,4,IBOUJ) IAUX(NMIL)=1 221 CONTINUE 22 CONTINUE 21 CONTINUE 30 CONTINUE SEGSUP IAUX RETURN END