Télécharger r2rch.eso

Retour à la liste

Numérotation des lignes :

  1. C R2RCH SOURCE CHAT 05/01/13 02:43:58 5004
  2. SUBROUTINE R2RCH(IDIMC,ITRNOE,NBNMAX,NBE,COORD,SPH,
  3. > NBSMAX,IT,XPT,COEF,IERR)
  4. C **********************************************************************
  5. C OBJET : RECHERCHE DE L'ELEMENT A RAFINER
  6. C EN ENTREE :
  7. C COORD : COORDONNEES DES POINTS
  8. C IDIMC : DIMENSION DE L'ESPACE
  9. C ITRNOE,NBNMAX : SOMMETS DES ELEMENTS
  10. C NBE : NOMBRE D'ELEMENTS
  11. C SPH,NBSMAX : CERCLES CIRCONSCRITS AUX ELEMENTS
  12. C
  13. C EN SORTIE :
  14. C IT : L'ELEMENT A REFFINER
  15. C XPT : LE POINT A AJOUTER
  16. C COEF : LA VALEUR DU RAFFINEMENT [0-1]
  17. C PLUS COEF EST PETIT PLUS ON RAFFINE
  18. C IERR : CODE D'ERREUR (INUTILISE)
  19. C **********************************************************************
  20. IMPLICIT INTEGER(I-N)
  21. REAL*8 COORD(*),SPH(*)
  22. INTEGER IDIMC,ITRNOE(*),NBNMAX,NBE,NBSMAX,IT,IERR
  23. REAL*8 COEF,XPT(*)
  24. C
  25. INTEGER I,NUMP3
  26. REAL*8 CLRC,LRCMIN,XDEMI
  27. C
  28. LRCMIN = 1.0D0
  29. XDEMI = 0.5D0
  30. IT = 0
  31. DO 10 I=1,NBE
  32. CLRC = SPH((I-1)*NBSMAX+3)
  33. IF( CLRC .LT. LRCMIN )THEN
  34. IT = I
  35. LRCMIN = CLRC
  36. ENDIF
  37. 10 CONTINUE
  38. C
  39. IF( IT.EQ. 0 )THEN
  40. COEF = 1.D0
  41. GOTO 999
  42. ENDIF
  43. C --- CENTRE = PT3 + SPH / 2 ------------------
  44. CALL MUSCVE(SPH((IT-1)*NBSMAX+1),XDEMI,IDIMC,XPT)
  45. NUMP3 = ITRNOE((IT-1)*NBNMAX+3)
  46. CALL SOMMVE(COORD((NUMP3-1)*IDIMC+1),XPT,IDIMC,XPT)
  47. C
  48. COEF = LRCMIN
  49. 999 END
  50.  
  51.  
  52.  

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