Télécharger la plaquette Cast3M


fr en

Télécharger moce.eso

Retour à la liste

Numérotation des lignes : 

moce

  1. C MOCE      SOURCE    PV        20/03/30    21:21:17     10567          
  2. C  MODI RECENTRAGE DES POINTS MILIEUX (SAUF LE CONTOUR)
  3. C
  4.       SUBROUTINE MOCE(MELEME,XPROJ,ICPR,IBOUJ)
  5.       IMPLICIT INTEGER(I-N)
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC SMELEME
  10. -INC CCGEOME
  11. -INC SMCOORD
  12.       SEGMENT ICPR(0)
  13.       SEGMENT IBOUJ(0)
  14.       SEGMENT XPROJ(3,0)
  15.       SEGMENT IAUX(nbpts)
  16.       CALL ECROBJ('MAILLAGE',MELEME)
  17.       CALL PRCONT
  18.       CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  19.       IF (IERR.NE.0) RETURN
  20.       SEGACT IPT1
  21. *  REACTIVONS LE  MAILLAGE A TOUT HASARD
  22.       SEGACT MELEME
  23.       DO 100 I=1,LISOUS(/1)
  24.          IPT2=LISOUS(I)
  25.          SEGACT IPT2
  26.  100  CONTINUE
  27.       IF (IPT1.ITYPEL.NE.3) THEN
  28.         SEGDES IPT1
  29.         RETURN
  30.       ENDIF
  31.       SEGINI IAUX
  32.       DO 110 I=1,IPT1.NUM(/2)
  33.          IAUX(IPT1.NUM(2,I))=1
  34.  110  CONTINUE
  35.       SEGDES IPT1
  36.       IPT1=MELEME
  37.       DO 30 IO=1,MAX(1,LISOUS(/1))
  38.          IF (LISOUS(/1).NE.0) IPT1=LISOUS(IO)
  39.          K=IPT1.ITYPEL
  40.          IF (K.NE.KSURF(K)) GOTO 21
  41. C  LE NOMBRE DE FACE EST 1 QUEL EST SON TYPE
  42.          KK=LTEL(2,K)
  43.          ITYP=LDEL(1,KK)
  44.          NBNN=KDEGRE(K)
  45.          IF (NBNN.NE.3) GOTO 21
  46.          IPAS=NBNN-1
  47.          IDEP=LDEL(2,KK)
  48.          IFEP=IDEP+KDFAC(1,ITYP)-1
  49. *     SG 20160711 pour les faces TRI7 et QUA9, on ignore le dernier
  50. *     point (centre de la face)
  51.          IF (ITYP.EQ.7.OR.ITYP.EQ.8) IFEP=IFEP-1
  52.          DO 22 I=1,IPT1.NUM(/2)
  53.             DO 221 J=IDEP,IFEP,IPAS
  54.                N1=IPT1.NUM(LFAC(J),I)
  55.                JSUIV=J+IPAS
  56.                IF (JSUIV.GT.IFEP) JSUIV=IDEP
  57.                N2=IPT1.NUM(LFAC(JSUIV),I)
  58.                NMIL=IPT1.NUM(LFAC(J+1),I)
  59.                IF (IAUX(NMIL).NE.0) GOTO  221
  60.                IP1=ICPR(N1)
  61.                IP2=ICPR(N2)
  62.                IPMIL=ICPR(NMIL)
  63.                XPROJ(1,IPMIL)=(XPROJ(1,IP1)+XPROJ(1,IP2))/2
  64.                XPROJ(2,IPMIL)=(XPROJ(2,IP1)+XPROJ(2,IP2))/2
  65.                XPROJ(3,IPMIL)=(XPROJ(3,IP1)+XPROJ(3,IP2))/2
  66.                CALL PROMOD(ICPR,XPROJ,NMIL,4,IBOUJ)
  67.                IAUX(NMIL)=1
  68.  221        CONTINUE
  69.  22      CONTINUE
  70.  21      CONTINUE
  71.  30   CONTINUE
  72.       SEGSUP IAUX
  73.       RETURN
  74.       END
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  

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