Sources Esope | Cast3M

genrd2
C GENRD2    SOURCE    CHAT      05/01/13    00:17:40     5004
      SUBROUTINE GENRD2(FAC1,BAR1,NUM1,BAR2,NUM2,NPTO,TOL)
C--------------------------------------------------------------------
C
C     ON NUMEROTE CORRECTEMENT LES NOEUDS POUR ORIENTER LE JOINT
C     SUIVANT BAR1-BAR2
C
C     PP 9/97
C     Pierre Pegon/JRC Ispra
C--------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
 
-INC PPARAM
-INC CCOPTIO
C
      DIMENSION FAC1(3,NPTO),NUM1(NPTO),NUM2(NPTO)
      DIMENSION BAR1(3),BAR2(3)
      DIMENSION XNORM(3),YNORM(3)
C
      XXORM=0.D0
      DO IE1=1,3
        XNORM(IE1)=BAR1(IE1)-BAR2(IE1)
      ENDDO
C
      YNORM(1)=(FAC1(2,2)-FAC1(2,1))*(FAC1(3,NPTO)-FAC1(3,1))
     >        -(FAC1(3,2)-FAC1(3,1))*(FAC1(2,NPTO)-FAC1(2,1))
      YNORM(2)=(FAC1(3,2)-FAC1(3,1))*(FAC1(1,NPTO)-FAC1(1,1))
     >        -(FAC1(1,2)-FAC1(1,1))*(FAC1(3,NPTO)-FAC1(3,1))
      YNORM(3)=(FAC1(1,2)-FAC1(1,1))*(FAC1(2,NPTO)-FAC1(2,1))
     >        -(FAC1(2,2)-FAC1(2,1))*(FAC1(1,NPTO)-FAC1(1,1))
C
      PSCAL=XNORM(1)*YNORM(1)+XNORM(2)*YNORM(2)+XNORM(3)*YNORM(3)
C
      IF(PSCAL.LT.0.D0)THEN
        DO IE1=1,NPTO/2
          JE1=NPTO+1-IE1
          IDUM=NUM1(IE1)
          NUM1(IE1)=NUM1(JE1)
          NUM1(JE1)=IDUM
          IDUM=NUM2(IE1)
          NUM2(IE1)=NUM2(JE1)
          NUM2(JE1)=IDUM
        ENDDO
      ENDIF
C
C     ON VERIFIE S'IL N'Y-A-PAS DE DOUBLON
C
      IDOUB=0
      DO IE1=1,NPTO
        IF(NUM1(IE1).EQ.NUM2(IE1))THEN
          IDOUB=IDOUB+1
          WRITE(IOIMP,*)
     >'GENRD2: il y a ',IDOUB,' doublon(s) dans un joint-->',NUM1(IE1)
        ENDIF
      ENDDO
C
      RETURN
      END