Télécharger moce.eso

Retour à la liste

Numérotation des lignes :

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

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