Numérotation des lignes :

C MOCE      SOURCE    BP208322  16/11/18    21:19:16     9177           C  MODI RECENTRAGE DES POINTS MILIEUX (SAUF LE CONTOUR)C      SUBROUTINE MOCE(MELEME,XPROJ,ICPR,IBOUJ)      IMPLICIT INTEGER(I-N)-INC CCOPTIO-INC SMELEME-INC CCGEOME-INC SMCOORD      SEGMENT ICPR(0)      SEGMENT IBOUJ(0)      SEGMENT XPROJ(3,0)      SEGMENT IAUX(XCOOR(/1)/(IDIM+1))      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 21C  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

© Cast3M 2003 - Tous droits réservés.
Mentions légales