Télécharger rafden.eso

Retour à la liste

Numérotation des lignes :

  1. C RAFDEN SOURCE CHAT 07/09/04 21:15:00 5847
  2. SUBROUTINE RAFDEN(ICHPO,XPT,YPT,ZPT,NDIM,DENPT)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. -INC CCREEL
  6. -INC CCOPTIO
  7. SEGMENT ICHPO
  8. REAL*8 XR(NBPTCH),YR(NBPTCH),ZR(NBPTCH),DEN(NBPTCH)
  9. ENDSEGMENT
  10. DENF=0.
  11. DENOM=0.
  12. DENM=XPETIT
  13. DO 1 I=1,DEN(/1)
  14. DENM=MAX(DENM,DEN(I))
  15. 1 CONTINUE
  16. DENM=MAX(1.D0,DENM)
  17. XCORR=DEN(/1)*DENM*1D17
  18. C
  19. C ** MODIFICATIONS
  20. C
  21. C GOTO 10
  22. SEGMENT XWORK
  23. REAL*8 XTAB(NLIGN)
  24. INTEGER ITAB(NLIGN)
  25. ENDSEGMENT
  26. NLIGN=3
  27. NCOLO=2
  28. SEGINI XWORK
  29. DO 7 I=1,NLIGN
  30. XTAB(I)=XGRAND
  31. 7 CONTINUE
  32. SEGACT XWORK*MOD
  33. DO 6 I=1,XR(/1)
  34. di2=(XR(I)-XPT)**2+(YR(I)-YPT)**2
  35. if(ndim.eq.3)di2=di2 + (ZR(I)-ZPT)**2
  36. DIST=SQRT(di2)
  37. IF (DIST.LT.XTAB(1)) THEN
  38. XTAB(3)=XTAB(2)
  39. ITAB(3)=ITAB(2)
  40. ITAB(2)=ITAB(1)
  41. XTAB(2)=XTAB(1)
  42. XTAB(1)=DIST
  43. ITAB(1)=I
  44. ELSEIF (DIST.LT.XTAB(2)) THEN
  45. XTAB(3)=XTAB(2)
  46. ITAB(3)=ITAB(2)
  47. XTAB(2)=DIST
  48. ITAB(2)=I
  49. ELSEIF (DIST.LT.XTAB(3)) THEN
  50. XTAB(3)=DIST
  51. ITAB(3)=I
  52. ENDIF
  53. 6 CONTINUE
  54. DO 8 I=1,3
  55. J= ITAB(I)
  56. di2=(XR(J)-XPT)**2+(YR(J)-YPT)**2
  57. if(ndim.eq.3)di2=di2 + (ZR(J)-ZPT)**2
  58. DIST=SQRT(di2)
  59. IF (ABS(DIST).LT.XPETIT*XCORR) DIST=XPETIT*XCORR
  60. DENF=DENF+DEN(J)/DIST
  61. DENOM=DENOM+1/DIST
  62. 8 CONTINUE
  63. SEGSUP XWORK
  64. GOTO 5
  65. 10 CONTINUE
  66. C
  67. C ** FIN DES MODIFICATIONS
  68. C
  69. IF (NDIM.NE.3) GOTO 3
  70. DO 2 I=1,DEN(/1)
  71. DIST=SQRT((XR(I)-XPT)**2+(YR(I)-YPT)**2+(ZR(I)-ZPT)**2)
  72. IF (ABS(DIST).LT.XPETIT*XCORR) DIST=XPETIT*XCORR
  73. DENF=DENF+DEN(I)/DIST
  74. DENOM=DENOM+1/DIST
  75. 2 CONTINUE
  76. GOTO 5
  77. 3 CONTINUE
  78. DO 4 I=1,DEN(/1)
  79. DIST=SQRT((XR(I)-XPT)**2+(YR(I)-YPT)**2)
  80. IF (ABS(DIST).LT.XPETIT*XCORR) DIST=XPETIT*XCORR
  81. DENF=DENF+DEN(I)/DIST
  82. DENOM=DENOM+1/DIST
  83. 4 CONTINUE
  84. 5 CONTINUE
  85. DENPT=DENF/DENOM
  86. IF (IIMPI.NE.0)
  87. # wrIte (6,*) ' rafden retour ',denf,denom,Xpt,ypt,zpt,den(/1)
  88. RETURN
  89. END
  90.  
  91.  
  92.  
  93.  

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