Télécharger la plaquette Cast3M


fr en

Télécharger d2chpo.eso

Retour à la liste

Numérotation des lignes : 

d2chpo

  1. C D2CHPO    SOURCE    CB215821  17/11/30    21:15:50     9639           
  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.  
  83.  

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