Télécharger ddotip.eso

Retour à la liste

Numérotation des lignes :

ddotip
  1. C DDOTIP SOURCE PV090527 23/08/01 21:15:02 11387
  2. function ddotip(lon,val1,ind,val2)
  3. * produit scalaire sparse. ind est le tableau de pointeur.
  4. * si lon est negatif, on fait la boucle à l'envers.
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. dimension val1(*),val2(*),ind(*)
  8. resu1=0.d0
  9. resu2=0.d0
  10. resu3=0.d0
  11. resu4=0.d0
  12. if (lon.gt.0) then
  13. do 10 i=0,lon-4,4
  14. indn1=ind(i+1)
  15. indn2=ind(i+2)
  16. indn3=ind(i+3)
  17. indn4=ind(i+4)
  18. resu1=resu1+val1(i+1)*val2(indn1)
  19. resu2=resu2+val1(i+2)*val2(indn2)
  20. resu3=resu3+val1(i+3)*val2(indn3)
  21. resu4=resu4+val1(i+4)*val2(indn4)
  22. 10 continue
  23. if(i.le.lon-2) then
  24. indn1=ind(i+1)
  25. indn2=ind(i+2)
  26. resu1=resu1+val1(i+1)*val2(indn1)
  27. resu2=resu2+val1(i+2)*val2(indn2)
  28. i=i+2
  29. endif
  30. if(i.le.lon-1) then
  31. indn1=ind(i+1)
  32. resu1=resu1+val1(i+1)*val2(indn1)
  33. i=i+1
  34. endif
  35. elseif (lon.lt.0) then
  36. lon=-lon
  37. do 20 i=lon+1,5,-4
  38. indn1=ind(i-1)
  39. indn2=ind(i-2)
  40. indn3=ind(i-3)
  41. indn4=ind(i-4)
  42. resu1=resu1+val1(i-1)*val2(indn1)
  43. resu2=resu2+val1(i-2)*val2(indn2)
  44. resu3=resu3+val1(i-3)*val2(indn3)
  45. resu4=resu4+val1(i-4)*val2(indn4)
  46. 20 continue
  47. if(i.ge.3) then
  48. indn1=ind(i-1)
  49. indn2=ind(i-2)
  50. resu1=resu1+val1(i-1)*val2(indn1)
  51. resu2=resu2+val1(i-2)*val2(indn2)
  52. i=i-2
  53. endif
  54. if(i.ge.2) then
  55. indn1=ind(i-1)
  56. resu1=resu1+val1(i-1)*val2(indn1)
  57. i=i-1
  58. endif
  59.  
  60. endif
  61. ddotip=resu1+resu2+resu3+resu4
  62. return
  63. end
  64.  
  65.  
  66.  
  67.  
  68.  

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