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

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