Esope source files

   1 : C D2CHPO    SOURCE    CHAT      06/03/29    21:18:04     5360           
   2 :       SUBROUTINE D2CHPO(IT,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
   3 :      >            COORD,IDIMC,SPH,NBSMAX,ITAB,RTAB,COEF,TS,iarr)
   4 : C     ****************************************************************
   5 : C     OBJET :   TAILLE SOUHAITE / CONCENTRATION CHAMPS DE POINTS
   6 : C               FONCTION PARAMETRE POUR RAF2D MODE ITERATIF
   7 : C
   8 : C     EN ENTREE :
   9 : C         --------- L'ELEMENT A RAFFINER -------------------
  10 : C         IT   : NUMERO DE L'ELEMENT A RAFFINER
  11 : C         ITRNOE,NBNMAX,ITRTRI,NBCMAX : LE MAILLAGE
  12 : C         ITRTRI,NBCMAX (INUTILISES)
  13 : C         COORD,IDIMC : COORDONNEES DANS L'ESPACE DE DIMENSION IDIMC
  14 : C         SPH,NBSMAX  : VECTEUR DIAMETRE DES SPHERES CIRCONSCRITES
  15 : C         RTAB(1)     :  TAILLE SOUHAITEE AU NOEUD 1 
  16 : C         RTAB(2)     : TAILLE SOUHAITEE AU NOEUD 2
  17 : C         RTAB(3...)  : ....
  18 : C       
  19 : C     EN SORTIE :
  20 : C         TS      : TAILLE SOUHAITE POUR L'ELEMENT IT
  21 : C                   ELLE EST DONNE PAR LA CONCENTRATION (ITAB,RTAB)
  22 : C         COEF    : A * TS /  RC (RAYON DU CERCLE CIRCONSCRIT A IT)
  23 : C                   "A" EST TEL QUE 0 <= COEF <=1
  24 : C                   PLUS COEF EST PETIT PLUS ON RAFFINE
  25 : C         iarr    : CODE D'ERREUR 0 SI OK, 
  26 : C                   -1 SI TAILLE SOUHAITE EST NEGATIVE
  27 : C                      OU SI LE RAYON CIRCONSCRIT EST NUL 
  28 : C
  29 : C     NIVEAU : INTERFACE UTILISATEUR    
  30 : C     ****************************************************************
  31 :       IMPLICIT INTEGER(I-N)
  32 :       REAL*8      COORD(*),SPH(*),COEF,TS
  33 :       INTEGER   IT,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NBSMAX
  34 :       INTEGER   IDIMC,ITAB(*)
  35 :       REAL*8      RTAB(*)
  36 :       INTEGER   iarr
  37 : C
  38 :       INTEGER NUMP1,NUMP2,NUMP3
  39 :       REAL*8 V(3),DMAX,D
  40 :       EXTERNAL XNORVE
  41 :       REAL*8     XNORVE
  42 : C
  43 :       NUMP1 = ITRNOE((IT-1)*NBNMAX+1)
  44 :       NUMP2 = ITRNOE((IT-1)*NBNMAX+2)      
  45 :       NUMP3 = ITRNOE((IT-1)*NBNMAX+3)      
  46 :       TS = (RTAB(NUMP1) + RTAB(NUMP2) + RTAB(NUMP3)) / 3.D0
  47 : C        
  48 : C           ============================
  49 : C     ------ SUR LE RAYON CIRCONSCRIT   ------
  50 : C           ============================
  51 : C      DIAM2 = SPH((IT-1)*NBSMAX+1)**2 + SPH((IT-1)*NBSMAX+2)**2
  52 : C      RC = SQRT( DIAM2 ) / 2.0
  53 : C      IF( NULLVECT(RC,1) .NE. 0 )GOTO 999
  54 : C      COEF = TS / RC
  55 : C      iarr = 0
  56 : C
  57 : C      
  58 : C           ============================
  59 : C     ------ ARETE LA PLUS LONGUE       ------
  60 : C           ============================
  60 :       CALL DIFFVE(COORD((NUMP2-1)*IDIMC+1),
  61 :      >              COORD((NUMP1-1)*IDIMC+1) ,IDIMC,V)
  62 :       DMAX = XNORVE(V,IDIMC)
  62 :       CALL DIFFVE(COORD((NUMP3-1)*IDIMC+1),
  63 :      >              COORD((NUMP2-1)*IDIMC+1) ,IDIMC,V)
  64 :       D = XNORVE(V,IDIMC)
  65 :       DMAX = MAX( D, DMAX )
  65 :       CALL DIFFVE(COORD((NUMP1-1)*IDIMC+1),
  66 :      >              COORD((NUMP3-1)*IDIMC+1) ,IDIMC,V)
  67 :       D = XNORVE(V,IDIMC) 
  68 :       DMAX = MAX( D, DMAX )
  69 : C      
  70 :       COEF = TS / DMAX
  71 :       iarr = 0
  72 : C      write (6,*) 'TS = ',TS,' RC = ',RC,
  73 : C     >            ' DMAX = ',DMAX,' COEF = ',COEF
  74 : C
  75 :   999 END
  76 :  
  77 :  
  78 :