Télécharger la plaquette Cast3M


fr en

Télécharger prpave.eso

Retour à la liste

Numérotation des lignes : 

prpave

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

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