Esope source files

   1 : C GENRD2    SOURCE    CHAT      05/01/13    00:17:40     5004           
   2 :       SUBROUTINE GENRD2(FAC1,BAR1,NUM1,BAR2,NUM2,NPTO,TOL)
   3 : C--------------------------------------------------------------------
   4 : C
   5 : C     ON NUMEROTE CORRECTEMENT LES NOEUDS POUR ORIENTER LE JOINT
   6 : C     SUIVANT BAR1-BAR2
   7 : C
   8 : C     PP 9/97
   9 : C     Pierre Pegon/JRC Ispra
  10 : C--------------------------------------------------------------------
  11 :       IMPLICIT INTEGER(I-N)
  12 :       IMPLICIT REAL*8 (A-H,O-Z)
  13 : C
  14 : -INC CCOPTIO
  15 : C
  16 :       DIMENSION FAC1(3,NPTO),NUM1(NPTO),NUM2(NPTO)
  17 :       DIMENSION BAR1(3),BAR2(3)
  18 :       DIMENSION XNORM(3),YNORM(3)
  19 : C
  20 :       XXORM=0.D0
  21 :       DO IE1=1,3
  22 :         XNORM(IE1)=BAR1(IE1)-BAR2(IE1)
  23 :       ENDDO
  24 : C
  25 :       YNORM(1)=(FAC1(2,2)-FAC1(2,1))*(FAC1(3,NPTO)-FAC1(3,1))
  26 :      >        -(FAC1(3,2)-FAC1(3,1))*(FAC1(2,NPTO)-FAC1(2,1))
  27 :       YNORM(2)=(FAC1(3,2)-FAC1(3,1))*(FAC1(1,NPTO)-FAC1(1,1))
  28 :      >        -(FAC1(1,2)-FAC1(1,1))*(FAC1(3,NPTO)-FAC1(3,1))
  29 :       YNORM(3)=(FAC1(1,2)-FAC1(1,1))*(FAC1(2,NPTO)-FAC1(2,1))
  30 :      >        -(FAC1(2,2)-FAC1(2,1))*(FAC1(1,NPTO)-FAC1(1,1))
  31 : C
  32 :       PSCAL=XNORM(1)*YNORM(1)+XNORM(2)*YNORM(2)+XNORM(3)*YNORM(3)
  33 : C
  34 :       IF(PSCAL.LT.0.D0)THEN
  35 :         DO IE1=1,NPTO/2
  36 :           JE1=NPTO+1-IE1
  37 :           IDUM=NUM1(IE1)
  38 :           NUM1(IE1)=NUM1(JE1)
  39 :           NUM1(JE1)=IDUM
  40 :           IDUM=NUM2(IE1)
  41 :           NUM2(IE1)=NUM2(JE1)
  42 :           NUM2(JE1)=IDUM
  43 :         ENDDO
  44 :       ENDIF
  45 : C
  46 : C     ON VERIFIE S'IL N'Y-A-PAS DE DOUBLON
  47 : C
  48 :       IDOUB=0
  49 :       DO IE1=1,NPTO
  50 :         IF(NUM1(IE1).EQ.NUM2(IE1))THEN
  51 :           IDOUB=IDOUB+1
  52 :           WRITE(IOIMP,*)
  53 :      >'GENRD2: il y a ',IDOUB,' doublon(s) dans un joint-->',NUM1(IE1)
  54 :         ENDIF
  55 :       ENDDO
  56 : C
  57 :       RETURN
  58 :       END
  59 :  
  60 :