Sources Esope | Cast3M

ctrle
C CTRLE     SOURCE    BP208322  16/11/18    21:16:10     9177           
C
C    CETTE PROCEDURE EST UTILISEE PAR PRPAVE POUR LE CONTROLE DES
C    ARETES DE L'OBJET; ELLE VERIFIE QUE LE COTE I1 DE IPT1 EST LE
C    MEME QUE LE COTE I2 DE IPT2 (IL FAUT I1&lt;=I2).
C    IL FAUDRAIT TRAVAILLER SUR LES ELEMENTS ET PAS SUR LES REFERENCES
C    QUI NE SONT PAS FORCEMENT DANS L'ORDRE
C
       SUBROUTINE CTRLE(IPT1,IPT2,I1,I2)
      IMPLICIT INTEGER(I-N)
-INC SMELEME
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
       SEGACT IPT1,IPT2
       IPT3=IPT1.LISREF(1)
       IPT4=IPT1.LISREF(2)
       IPT5=IPT2.LISREF(1)
       IPT6=IPT2.LISREF(2)
       SEGACT IPT3,IPT4,IPT5,IPT6
       NEL1X=IPT3.NUM(/2)
       NEL1Y=IPT4.NUM(/2)
       NEL2X=IPT5.NUM(/2)
       NEL2Y=IPT6.NUM(/2)
       SEGDES IPT3,IPT4,IPT5,IPT6
       NBN=KDEGRE(IPT1.ITYPEL)
       IF (KDEGRE(IPT2.ITYPEL).NE.NBN) CALL ERREUR(264)
       NEL=NEL1X
       IF (I1.EQ.2.OR.I1.EQ.4) NEL=NEL1Y
       NEL2=NEL2X
       IF (I2.EQ.2.OR.I2.EQ.4) NEL2=NEL2Y
       IF (NEL.NE.NEL2) CALL ERREUR(264)
       IF (IERR.NE.0) RETURN
       IF (((I1.EQ.1).AND.(I2.EQ.3)).OR.((I1.EQ.1).AND.(I2.EQ.4)).OR.
     1 ((I1.EQ.2).AND.(I2.EQ.3)).OR.((I1.EQ.2).AND.(I2.EQ.4))) GOTO 30
       DO 20 J=1,NEL
      IF (I1.EQ.1) ITEST1=IPT1.NUM(1,J)
      IF (I1.EQ.2) ITEST1=IPT1.NUM(NBN,NEL1X*J)
      IF (I1.EQ.3) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*NEL1Y+1-J)
      IF (I1.EQ.4) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*NEL1Y+1-J*NEL1X)
      IF (I2.EQ.1) ITEST2=IPT2.NUM(1,J)
      IF (I2.EQ.2) ITEST2=IPT2.NUM(NBN,NEL2X*J)
      IF (I2.EQ.3) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*NEL2Y+1-J)
      IF (I2.EQ.4) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*NEL2Y+1-J*NEL2X)
       IF (ITEST1.NE.ITEST2) CALL ERREUR(264)
       IF (IERR.NE.0) RETURN
      IF (I1.EQ.1) ITEST1=IPT1.NUM(NBN,J)
      IF (I1.EQ.2) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*J)
      IF (I1.EQ.3) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*NEL1Y+1-J)
      IF (I1.EQ.4) ITEST1=IPT1.NUM(1,NEL1X*NEL1Y+1-J*NEL1X)
      IF (I2.EQ.1) ITEST2=IPT2.NUM(NBN,J)
      IF (I2.EQ.2) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*J)
      IF (I2.EQ.3) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*NEL2Y+1-J)
      IF (I2.EQ.4) ITEST2=IPT2.NUM(1,NEL2X*NEL2Y+1-J*NEL2X)
       IF (ITEST1.NE.ITEST2) CALL ERREUR(264)
       IF (IERR.NE.0) RETURN
20     CONTINUE
       SEGDES IPT3,IPT4
       RETURN
30     DO 40 J=1,NEL
      IF (I1.EQ.1) ITEST1=IPT1.NUM(1,J)
      IF (I1.EQ.2) ITEST1=IPT1.NUM(NBN,NEL1X*J)
      IF (I1.EQ.3) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*NEL1Y+1-J)
      IF (I1.EQ.4) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*NEL1Y+1-J*NEL1X)
      IF (I2.EQ.1) ITEST2=IPT2.NUM(NBN,NEL2X+1-J)
      IF (I2.EQ.2) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*NEL2Y-(J-1)*NEL2X)
      IF (I2.EQ.3) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*(NEL2Y-1)+J)
      IF (I2.EQ.4) ITEST2=IPT2.NUM(1,(J-1)*NEL2X+1)
       IF (ITEST1.NE.ITEST2) CALL ERREUR(264)
       IF (IERR.NE.0) RETURN
      IF (I1.EQ.1) ITEST1=IPT1.NUM(NBN,NEL1X+1-J)
      IF (I1.EQ.2) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*NEL1Y-(J-1)*NEL1X)
      IF (I1.EQ.3) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*(NEL1Y-1)+J)
      IF (I1.EQ.4) ITEST1=IPT1.NUM(1,(J-1)*NEL1X+1)
      IF (I2.EQ.1) ITEST2=IPT2.NUM(1,J)
      IF (I2.EQ.2) ITEST2=IPT2.NUM(NBN,NEL2X*J)
      IF (I2.EQ.3) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*NEL2Y+1-J)
      IF (I2.EQ.4) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*NEL2Y+1-J*NEL2X)
       IF (ITEST1.NE.ITEST2) CALL ERREUR(264)
       IF (IERR.NE.0) RETURN
40     CONTINUE
       SEGDES IPT3,IPT4
       RETURN
       END