Télécharger prpave.eso

Retour à la liste

Numérotation des lignes :

  1. C PRPAVE SOURCE CHAT 05/01/13 02:35:17 5004
  2. C PRPAVE POSITIONNE CORRECTEMENT 6 FACES DONNEES ET REGULARISE
  3. C (PAR L'APPEL DE PAVE) LE MAILLAGE DU CUBE CORRESPONDANT EN
  4. C EVITANT QUE DES POINTS DU MAILLAGE NE SE TROUVENT A L'EXTERIEUR
  5. C DANS LE CAS DE FACES CONCAVES.
  6. C
  7. SUBROUTINE PRPAVE
  8. IMPLICIT INTEGER(I-N)
  9. -INC SMELEME
  10. -INC CCOPTIO
  11. -INC SMCOORD
  12. C
  13. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  14. CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  15. CALL LIROBJ('MAILLAGE',IPT3,1,IRETOU)
  16. CALL LIROBJ('MAILLAGE',IPT4,1,IRETOU)
  17. CALL LIROBJ('MAILLAGE',IPT5,1,IRETOU)
  18. CALL LIROBJ('MAILLAGE',IPT6,1,IRETOU)
  19. IF (IERR.NE.0) RETURN
  20. SEGACT IPT1,IPT2,IPT3,IPT4,IPT5,IPT6
  21. IF (IPT1.LISOUS(/1).NE.0) CALL ERREUR(16)
  22. IF (IPT2.LISOUS(/1).NE.0) CALL ERREUR(16)
  23. IF (IPT3.LISOUS(/1).NE.0) CALL ERREUR(16)
  24. IF (IPT4.LISOUS(/1).NE.0) CALL ERREUR(16)
  25. IF (IPT5.LISOUS(/1).NE.0) CALL ERREUR(16)
  26. IF (IPT6.LISOUS(/1).NE.0) CALL ERREUR(16)
  27. IF (IPT1.LISREF(/1).NE.4) CALL ERREUR(16)
  28. IF (IPT2.LISREF(/1).NE.4) CALL ERREUR(16)
  29. IF (IPT3.LISREF(/1).NE.4) CALL ERREUR(16)
  30. IF (IPT4.LISREF(/1).NE.4) CALL ERREUR(16)
  31. IF (IPT5.LISREF(/1).NE.4) CALL ERREUR(16)
  32. IF (IPT6.LISREF(/1).NE.4) CALL ERREUR(16)
  33. IF ((IPT1.ITYPEL.NE.8).AND.(IPT1.ITYPEL.NE.10)) CALL ERREUR(16)
  34. IF ((IPT2.ITYPEL.NE.8).AND.(IPT2.ITYPEL.NE.10)) CALL ERREUR(16)
  35. IF ((IPT3.ITYPEL.NE.8).AND.(IPT3.ITYPEL.NE.10)) CALL ERREUR(16)
  36. IF ((IPT4.ITYPEL.NE.8).AND.(IPT4.ITYPEL.NE.10)) CALL ERREUR(16)
  37. IF ((IPT5.ITYPEL.NE.8).AND.(IPT5.ITYPEL.NE.10)) CALL ERREUR(16)
  38. IF ((IPT6.ITYPEL.NE.8).AND.(IPT6.ITYPEL.NE.10)) CALL ERREUR(16)
  39. IF (IERR.NE.0) RETURN
  40. SEGACT MCOORD
  41. C
  42. C POSITIONNEMENT DES FACES ET CONTROLES DES COTES.
  43. C
  44. C IPT1:FACE 1 DU CUBE
  45. CALL COIN(IPT1,I1,I2,I3,I4,NX,NY)
  46. IF (IIMPI.NE.0) WRITE(IOIMP,9) I1,I2,I3,I4,NX,NY
  47. 9 FORMAT (' COINS : ',4(I3,1X),3X,'DIM :',I2,1X,I2)
  48. C
  49. C RECHERCHE DE LA POSITION DES FACES (POINTEES PAR IPT2,IPT3,IPT4
  50. C IPT5 ET IPT6) PAR RAPPORT A LA FACE 1.
  51. C
  52. IF (IIMPI.NE.0) WRITE(IOIMP,29) IPT1,IPT2,IPT3,IPT4,IPT5,IPT6
  53. CALL POSIT(IPT2,I1,I2,I3,I4,J2)
  54. CALL POSIT(IPT3,I1,I2,I3,I4,J3)
  55. CALL POSIT(IPT4,I1,I2,I3,I4,J4)
  56. CALL POSIT(IPT5,I1,I2,I3,I4,J5)
  57. CALL POSIT(IPT6,I1,I2,I3,I4,J6)
  58. IF (IIMPI.NE.0) WRITE(IOIMP,29) IPT1,IPT2,IPT3,IPT4,IPT5,IPT6
  59. IF (IIMPI.NE.0) WRITE(IOIMP,19) J2,J3,J4,J5,J6
  60. 19 FORMAT(' J2=',I3,' J3=',I3,' J4=',I3,' J5=',I3,' J6=',I3)
  61. 29 FORMAT('IPT1=',I3,' IPT2=',I3,' IPT3=',I3,' IPT4=',I3,
  62. 1 'IPT5=',I3,' IPT6=',I3)
  63. IF ((J2.EQ.J3).OR.(J2.EQ.J4).OR.(J2.EQ.J5).OR.(J2.EQ.J6).OR.
  64. 1 (J3.EQ.J4).OR.(J3.EQ.J5).OR.(J3.EQ.J6).OR.(J4.EQ.J5).OR.
  65. 2 (J4.EQ.J6).OR.(J5.EQ.J6)) CALL ERREUR(21)
  66. IF (IERR.NE.0) RETURN
  67. IP2=IPT2
  68. IP3=IPT3
  69. IP4=IPT4
  70. IP5=IPT5
  71. IP6=IPT6
  72. CALL AFFPAV(J2,IP2,IPT2,IPT3,IPT4,IPT5,IPT6)
  73. CALL AFFPAV(J3,IP3,IPT2,IPT3,IPT4,IPT5,IPT6)
  74. CALL AFFPAV(J4,IP4,IPT2,IPT3,IPT4,IPT5,IPT6)
  75. CALL AFFPAV(J5,IP5,IPT2,IPT3,IPT4,IPT5,IPT6)
  76. CALL AFFPAV(J6,IP6,IPT2,IPT3,IPT4,IPT5,IPT6)
  77. IF (IIMPI.NE.0) WRITE(IOIMP,29) IPT1,IPT2,IPT3,IPT4,IPT5,IPT6
  78. C
  79. C CONTROLE COTES FACE 1 AVEC LES COTES 1 DES FACES 2,3,4,5 ET 6
  80. CALL CTRLE(IPT5,IPT1,1,1)
  81. CALL CTRLE(IPT4,IPT1,1,2)
  82. CALL CTRLE(IPT6,IPT1,1,3)
  83. CALL CTRLE(IPT3,IPT1,1,4)
  84. C
  85. C POINTS I5,I6 ET DIMENSION NZ.
  86. CALL COIN(IPT5,IP1,IP2,I6,I5,N1,NZ)
  87. C
  88. C CONTROLE DES ARETES VERTICALES
  89. CALL CTRLE(IPT5,IPT4,2,4)
  90. CALL CTRLE(IPT4,IPT6,2,2)
  91. CALL CTRLE(IPT3,IPT6,2,4)
  92. CALL CTRLE(IPT3,IPT5,4,4)
  93. C
  94. C POSITIONNEMENT DE LA FACE 2
  95. CALL POS(IPT2,I5,I6,IND)
  96. IF (IND.EQ.0) CALL ERREUR(21)
  97. IF (IERR.NE.0) RETURN
  98. C
  99. C CONTROLE COTES FACE 2 AVEC COTES 3 DES FACES 3,4,5 ET 6
  100. CALL CTRLE(IPT2,IPT5,1,3)
  101. CALL CTRLE(IPT2,IPT4,2,3)
  102. CALL CTRLE(IPT2,IPT6,3,3)
  103. CALL CTRLE(IPT3,IPT2,3,4)
  104. C
  105. C MAILLAGE DU VOLUME.
  106. CALL PAVE(NX,NY,NZ,IPT1,IPT2,IPT3,IPT4,IPT5,IPT6)
  107. SEGDES IPT1,IPT2,IPT3,IPT4,IPT5,IPT6
  108. RETURN
  109. END
  110. C
  111. C
  112.  
  113.  

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