Esope source files

   1 : C TABGAU    SOURCE    FANDEUR   10/12/06    21:15:34     6804           
   2 :       SUBROUTINE TABGAU(IPMINT,IREREF,IRECHAM,NBNN,IREF,
   3 :      +        ICHAM,NBPGAU,IRET,wTRAV)
   4 : *
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8(A-H,O-Z)
   7 : *
   8 : *  modif PV la creation suppression de wtrav se fait dans testma
   9 : *  les definitions doivent donc être coherentes
  10 : -INC CCOPTIO
  11 : -INC SMELEME
  12 : -INC SMCOORD
  13 : -INC SMINTE
  14 : *
  15 :       SEGMENT WTRAV
  16 :         REAL*8 QSIREF(NBPGAU),QSICHAM(NBPGAU),ETAREF(NBPGAU)
  17 :         REAL*8 ETACHAM(NBPGAU),DZEREF(NBPGAU),DZECHAM(NBPGAU)
  18 :         REAL*8 XECHAM(3,NBNN),XEREF(3,NBNN)
  19 :         INTEGER TABOK(NBPGAU),TAB(NBPGAU)
  20 :       ENDSEGMENT
  21 : *
  22 :       MINTE=IPMINT
  23 :       MELEME=IREF
  24 :       IPT2=ICHAM
  25 : *
  26 : *     RECUPERER LES COORD HOMOGENES DES 2 SERIES DE PTS DE GAUSS
  27 : *
  27 :        CALL DOXE(XCOOR,IDIM,NBNN,IPT2.NUM,IRECHAM,XECHAM) 
  27 :        CALL DOXE(XCOOR,IDIM,NBNN,NUM,IREREF,XEREF)
  28 : * 
  29 :        DO 1 I=1,NBPGAU
  30 :         c1cham=0.
  31 :         c2cham=0.
  32 :         c3cham=0.
  33 :         c1ref =0.
  34 :         c2ref =0.
  35 :         c3ref =0.
  36 :         DO 11 J=1,NBNN 
  37 :           r_z = SHPTOT(1,J,I)
  38 :           c1CHAM= c1CHAM + r_z * XECHAM(1,J)
  39 :           c2CHAM= c2CHAM + r_z * XECHAM(2,J) 
  40 :           c1REF = c1REF  + r_z * XEREF(1,J)
  41 :           C2REF = C2REF  + r_z * XEREF(2,J)  
  42 :           IF (IDIM.EQ.3) THEN
  43 :             C3CHAM = C3CHAM + r_z * XECHAM(3,J)
  44 :             C3REF  = C3REF  + r_z * XEREF(3,J)
  45 :          ENDIF
  46 :  11    CONTINUE 
  47 :         qsicham(i)=c1cham
  48 :         etacham(i)=c2cham
  49 :         dzecham(i)=c3cham
  50 :         qsiref(i) =c1ref
  51 :         etaref(i) =c2ref
  52 :         dzeref(i) =c3ref
  53 :  1    CONTINUE        
  54 : *
  55 :       PREC=1.E-10
  56 :       DO 10 I=1,NBPGAU
  57 :        tab(i)=0
  58 :        tabok(i)=0
  59 :        PRECA= ABS(PREC*QSIREF(I))
  60 :        PRECB= ABS(PREC*ETAREF(I))
  61 :        PRECC= ABS(PREC*DZEREF(I))
  62 :        DO 10 J=1,NBPGAU
  63 :          IF (TABOK(I).EQ.0) THEN
  64 :            A= ABS(QSIREF(I)-QSICHAM(J))
  65 :            B= ABS(ETAREF(I)-ETACHAM(J))
  66 :            C= ABS(DZEREF(I)-DZECHAM(J))
  67 :            IF (A.LE.PRECA.AND.B.LE.PRECB.AND.C.LE.PRECC)   THEN
  68 :              TAB(I)=J
  69 :              TABOK(I)=1
  70 :            ENDIF
  71 :          ENDIF
  72 :  10    CONTINUE
  73 : *
  74 :       IRET=1
  75 :        DO 20 I=1,NBPGAU 
  76 :          IF (TABOK(I).EQ.0) THEN
  77 :             IRET=0 
  78 :             GOTO 30
  79 :          ENDIF
  80 :  20    CONTINUE
  81 : * 
  82 :  30    CONTINUE  
  83 : 
  84 :       RETURN
  85 :       END
  86 : 
  87 :