C TABGAU    SOURCE    FANDEUR   10/12/06    21:15:34     6804
      SUBROUTINE TABGAU(IPMINT,IREREF,IRECHAM,NBNN,IREF,
     +        ICHAM,NBPGAU,IRET,wTRAV)
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
*  modif PV la creation suppression de wtrav se fait dans testma
*  les definitions doivent donc être coherentes

-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCOORD
-INC SMINTE
*
      SEGMENT WTRAV
        REAL*8 QSIREF(NBPGAU),QSICHAM(NBPGAU),ETAREF(NBPGAU)
        REAL*8 ETACHAM(NBPGAU),DZEREF(NBPGAU),DZECHAM(NBPGAU)
        REAL*8 XECHAM(3,NBNN),XEREF(3,NBNN)
        INTEGER TABOK(NBPGAU),TAB(NBPGAU)
      ENDSEGMENT
*
      MINTE=IPMINT
      MELEME=IREF
      IPT2=ICHAM
*
*     RECUPERER LES COORD HOMOGENES DES 2 SERIES DE PTS DE GAUSS
*
       CALL DOXE(XCOOR,IDIM,NBNN,IPT2.NUM,IRECHAM,XECHAM)
       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IREREF,XEREF)
*
       DO 1 I=1,NBPGAU
        c1cham=0.
        c2cham=0.
        c3cham=0.
        c1ref =0.
        c2ref =0.
        c3ref =0.
        DO 11 J=1,NBNN
          r_z = SHPTOT(1,J,I)
          c1CHAM= c1CHAM + r_z * XECHAM(1,J)
          c2CHAM= c2CHAM + r_z * XECHAM(2,J)
          c1REF = c1REF  + r_z * XEREF(1,J)
          C2REF = C2REF  + r_z * XEREF(2,J)
          IF (IDIM.EQ.3) THEN
            C3CHAM = C3CHAM + r_z * XECHAM(3,J)
            C3REF  = C3REF  + r_z * XEREF(3,J)
         ENDIF
 11    CONTINUE
        qsicham(i)=c1cham
        etacham(i)=c2cham
        dzecham(i)=c3cham
        qsiref(i) =c1ref
        etaref(i) =c2ref
        dzeref(i) =c3ref
 1    CONTINUE
*
      PREC=1.E-10
      DO 10 I=1,NBPGAU
       tab(i)=0
       tabok(i)=0
       PRECA= ABS(PREC*QSIREF(I))
       PRECB= ABS(PREC*ETAREF(I))
       PRECC= ABS(PREC*DZEREF(I))
       DO 10 J=1,NBPGAU
         IF (TABOK(I).EQ.0) THEN
           A= ABS(QSIREF(I)-QSICHAM(J))
           B= ABS(ETAREF(I)-ETACHAM(J))
           C= ABS(DZEREF(I)-DZECHAM(J))
           IF (A.LE.PRECA.AND.B.LE.PRECB.AND.C.LE.PRECC)   THEN
             TAB(I)=J
             TABOK(I)=1
           ENDIF
         ENDIF
 10    CONTINUE
*
      IRET=1
       DO 20 I=1,NBPGAU
         IF (TABOK(I).EQ.0) THEN
            IRET=0
            GOTO 30
         ENDIF
 20    CONTINUE
*
 30    CONTINUE

      RETURN
      END