C PRPAVE    SOURCE    CHAT      05/01/13    02:35:17     5004
C      PRPAVE POSITIONNE CORRECTEMENT 6 FACES DONNEES ET REGULARISE
C      (PAR L'APPEL DE PAVE) LE MAILLAGE DU CUBE CORRESPONDANT EN
C      EVITANT QUE DES POINTS DU MAILLAGE NE SE TROUVENT A L'EXTERIEUR
C      DANS LE CAS DE FACES CONCAVES.
C
       SUBROUTINE PRPAVE
      IMPLICIT INTEGER(I-N)
-INC SMELEME
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
C
       CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
       CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
       CALL LIROBJ('MAILLAGE',IPT3,1,IRETOU)
       CALL LIROBJ('MAILLAGE',IPT4,1,IRETOU)
       CALL LIROBJ('MAILLAGE',IPT5,1,IRETOU)
       CALL LIROBJ('MAILLAGE',IPT6,1,IRETOU)
       IF (IERR.NE.0) RETURN
       SEGACT IPT1,IPT2,IPT3,IPT4,IPT5,IPT6
       IF (IPT1.LISOUS(/1).NE.0) CALL ERREUR(16)
       IF (IPT2.LISOUS(/1).NE.0) CALL ERREUR(16)
       IF (IPT3.LISOUS(/1).NE.0) CALL ERREUR(16)
       IF (IPT4.LISOUS(/1).NE.0) CALL ERREUR(16)
       IF (IPT5.LISOUS(/1).NE.0) CALL ERREUR(16)
       IF (IPT6.LISOUS(/1).NE.0) CALL ERREUR(16)
       IF (IPT1.LISREF(/1).NE.4) CALL ERREUR(16)
       IF (IPT2.LISREF(/1).NE.4) CALL ERREUR(16)
       IF (IPT3.LISREF(/1).NE.4) CALL ERREUR(16)
       IF (IPT4.LISREF(/1).NE.4) CALL ERREUR(16)
       IF (IPT5.LISREF(/1).NE.4) CALL ERREUR(16)
       IF (IPT6.LISREF(/1).NE.4) CALL ERREUR(16)
       IF ((IPT1.ITYPEL.NE.8).AND.(IPT1.ITYPEL.NE.10)) CALL ERREUR(16)
       IF ((IPT2.ITYPEL.NE.8).AND.(IPT2.ITYPEL.NE.10)) CALL ERREUR(16)
       IF ((IPT3.ITYPEL.NE.8).AND.(IPT3.ITYPEL.NE.10)) CALL ERREUR(16)
       IF ((IPT4.ITYPEL.NE.8).AND.(IPT4.ITYPEL.NE.10)) CALL ERREUR(16)
       IF ((IPT5.ITYPEL.NE.8).AND.(IPT5.ITYPEL.NE.10)) CALL ERREUR(16)
       IF ((IPT6.ITYPEL.NE.8).AND.(IPT6.ITYPEL.NE.10)) CALL ERREUR(16)
       IF (IERR.NE.0) RETURN
      SEGACT MCOORD
C
C    POSITIONNEMENT DES FACES ET CONTROLES DES COTES.
C
C    IPT1:FACE 1 DU CUBE
       CALL COIN(IPT1,I1,I2,I3,I4,NX,NY)
      IF (IIMPI.NE.0) WRITE(IOIMP,9) I1,I2,I3,I4,NX,NY
9     FORMAT (' COINS : ',4(I3,1X),3X,'DIM :',I2,1X,I2)
C
C    RECHERCHE DE LA POSITION DES FACES (POINTEES PAR IPT2,IPT3,IPT4
C    IPT5 ET IPT6) PAR RAPPORT A LA FACE 1.
C
      IF (IIMPI.NE.0) WRITE(IOIMP,29) IPT1,IPT2,IPT3,IPT4,IPT5,IPT6
       CALL POSIT(IPT2,I1,I2,I3,I4,J2)
       CALL POSIT(IPT3,I1,I2,I3,I4,J3)
       CALL POSIT(IPT4,I1,I2,I3,I4,J4)
       CALL POSIT(IPT5,I1,I2,I3,I4,J5)
       CALL POSIT(IPT6,I1,I2,I3,I4,J6)
      IF (IIMPI.NE.0) WRITE(IOIMP,29) IPT1,IPT2,IPT3,IPT4,IPT5,IPT6
      IF (IIMPI.NE.0) WRITE(IOIMP,19) J2,J3,J4,J5,J6
19    FORMAT('  J2=',I3,' J3=',I3,' J4=',I3,' J5=',I3,' J6=',I3)
29    FORMAT('IPT1=',I3,' IPT2=',I3,' IPT3=',I3,' IPT4=',I3,
     1 'IPT5=',I3,' IPT6=',I3)
       IF ((J2.EQ.J3).OR.(J2.EQ.J4).OR.(J2.EQ.J5).OR.(J2.EQ.J6).OR.
     1 (J3.EQ.J4).OR.(J3.EQ.J5).OR.(J3.EQ.J6).OR.(J4.EQ.J5).OR.
     2 (J4.EQ.J6).OR.(J5.EQ.J6)) CALL ERREUR(21)
       IF (IERR.NE.0) RETURN
       IP2=IPT2
       IP3=IPT3
       IP4=IPT4
       IP5=IPT5
       IP6=IPT6
       CALL AFFPAV(J2,IP2,IPT2,IPT3,IPT4,IPT5,IPT6)
       CALL AFFPAV(J3,IP3,IPT2,IPT3,IPT4,IPT5,IPT6)
       CALL AFFPAV(J4,IP4,IPT2,IPT3,IPT4,IPT5,IPT6)
       CALL AFFPAV(J5,IP5,IPT2,IPT3,IPT4,IPT5,IPT6)
       CALL AFFPAV(J6,IP6,IPT2,IPT3,IPT4,IPT5,IPT6)
      IF (IIMPI.NE.0) WRITE(IOIMP,29) IPT1,IPT2,IPT3,IPT4,IPT5,IPT6
C
C    CONTROLE COTES FACE 1 AVEC LES COTES 1 DES FACES 2,3,4,5 ET 6
       CALL CTRLE(IPT5,IPT1,1,1)
       CALL CTRLE(IPT4,IPT1,1,2)
       CALL CTRLE(IPT6,IPT1,1,3)
       CALL CTRLE(IPT3,IPT1,1,4)
C
C    POINTS I5,I6 ET DIMENSION NZ.
       CALL COIN(IPT5,IP1,IP2,I6,I5,N1,NZ)
C
C    CONTROLE DES ARETES VERTICALES
       CALL CTRLE(IPT5,IPT4,2,4)
       CALL CTRLE(IPT4,IPT6,2,2)
       CALL CTRLE(IPT3,IPT6,2,4)
       CALL CTRLE(IPT3,IPT5,4,4)
C
C    POSITIONNEMENT DE LA FACE 2
       CALL POS(IPT2,I5,I6,IND)
       IF (IND.EQ.0) CALL ERREUR(21)
       IF (IERR.NE.0) RETURN
C
C    CONTROLE COTES FACE 2 AVEC COTES 3 DES FACES 3,4,5 ET 6
       CALL CTRLE(IPT2,IPT5,1,3)
       CALL CTRLE(IPT2,IPT4,2,3)
       CALL CTRLE(IPT2,IPT6,3,3)
       CALL CTRLE(IPT3,IPT2,3,4)
C
C    MAILLAGE DU VOLUME.
       CALL PAVE(NX,NY,NZ,IPT1,IPT2,IPT3,IPT4,IPT5,IPT6)
       SEGDES IPT1,IPT2,IPT3,IPT4,IPT5,IPT6
       RETURN
       END
C
C