Télécharger d2chpo.eso

Retour à la liste

Numérotation des lignes :

  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 ============================
  61. CALL DIFFVE(COORD((NUMP2-1)*IDIMC+1),
  62. > COORD((NUMP1-1)*IDIMC+1) ,IDIMC,V)
  63. DMAX = XNORVE(V,IDIMC)
  64. CALL DIFFVE(COORD((NUMP3-1)*IDIMC+1),
  65. > COORD((NUMP2-1)*IDIMC+1) ,IDIMC,V)
  66. D = XNORVE(V,IDIMC)
  67. DMAX = MAX( D, DMAX )
  68. CALL DIFFVE(COORD((NUMP1-1)*IDIMC+1),
  69. > COORD((NUMP3-1)*IDIMC+1) ,IDIMC,V)
  70. D = XNORVE(V,IDIMC)
  71. DMAX = MAX( D, DMAX )
  72. C
  73. COEF = TS / DMAX
  74. iarr = 0
  75. C write (6,*) 'TS = ',TS,' RC = ',RC,
  76. C > ' DMAX = ',DMAX,' COEF = ',COEF
  77. C
  78. 999 END
  79.  
  80.  
  81.  
  82.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales