Télécharger ddotip.eso

Retour à la liste

Numérotation des lignes :

ddotip
  1. C DDOTIP SOURCE PV090527 24/04/16 21:15:02 11902
  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. resu5=0.d0
  13. resu6=0.d0
  14. resu7=0.d0
  15. resu8=0.d0
  16. if (lon.gt.0) then
  17. do i=0,lon-8,8
  18. indn1=ind(i+1)
  19. indn2=ind(i+2)
  20. indn3=ind(i+3)
  21. indn4=ind(i+4)
  22. indn5=ind(i+5)
  23. indn6=ind(i+6)
  24. indn7=ind(i+7)
  25. indn8=ind(i+8)
  26. resu1=resu1+val1(i+1)*val2(indn1)
  27. resu2=resu2+val1(i+2)*val2(indn2)
  28. resu3=resu3+val1(i+3)*val2(indn3)
  29. resu4=resu4+val1(i+4)*val2(indn4)
  30. resu5=resu5+val1(i+5)*val2(indn5)
  31. resu6=resu6+val1(i+6)*val2(indn6)
  32. resu7=resu7+val1(i+7)*val2(indn7)
  33. resu8=resu8+val1(i+8)*val2(indn8)
  34. enddo
  35. if(i.le.lon-4) then
  36. indn1=ind(i+1)
  37. indn2=ind(i+2)
  38. indn3=ind(i+3)
  39. indn4=ind(i+4)
  40. resu1=resu1+val1(i+1)*val2(indn1)
  41. resu2=resu2+val1(i+2)*val2(indn2)
  42. resu3=resu3+val1(i+3)*val2(indn3)
  43. resu4=resu4+val1(i+4)*val2(indn4)
  44. i=i+4
  45. endif
  46. if(i.le.lon-2) then
  47. indn1=ind(i+1)
  48. indn2=ind(i+2)
  49. resu1=resu1+val1(i+1)*val2(indn1)
  50. resu2=resu2+val1(i+2)*val2(indn2)
  51. i=i+2
  52. endif
  53. if(i.le.lon-1) then
  54. indn1=ind(i+1)
  55. resu1=resu1+val1(i+1)*val2(indn1)
  56. i=i+1
  57. endif
  58. elseif (lon.lt.0) then
  59. lon=-lon
  60. do i=lon+1,9,-8
  61. indn1=ind(i-1)
  62. indn2=ind(i-2)
  63. indn3=ind(i-3)
  64. indn4=ind(i-4)
  65. indn5=ind(i-5)
  66. indn6=ind(i-6)
  67. indn7=ind(i-7)
  68. indn8=ind(i-8)
  69. resu1=resu1+val1(i-1)*val2(indn1)
  70. resu2=resu2+val1(i-2)*val2(indn2)
  71. resu3=resu3+val1(i-3)*val2(indn3)
  72. resu4=resu4+val1(i-4)*val2(indn4)
  73. resu5=resu5+val1(i-5)*val2(indn5)
  74. resu6=resu6+val1(i-6)*val2(indn6)
  75. resu7=resu7+val1(i-7)*val2(indn7)
  76. resu8=resu8+val1(i-8)*val2(indn8)
  77. enddo
  78. if(i.ge.5) then
  79. indn1=ind(i-1)
  80. indn2=ind(i-2)
  81. indn3=ind(i-3)
  82. indn4=ind(i-4)
  83. resu1=resu1+val1(i-1)*val2(indn1)
  84. resu2=resu2+val1(i-2)*val2(indn2)
  85. resu3=resu3+val1(i-3)*val2(indn3)
  86. resu4=resu4+val1(i-4)*val2(indn4)
  87. i=i-4
  88. endif
  89. if(i.ge.3) then
  90. indn1=ind(i-1)
  91. indn2=ind(i-2)
  92. resu1=resu1+val1(i-1)*val2(indn1)
  93. resu2=resu2+val1(i-2)*val2(indn2)
  94. i=i-2
  95. endif
  96. if(i.ge.2) then
  97. indn1=ind(i-1)
  98. resu1=resu1+val1(i-1)*val2(indn1)
  99. i=i-1
  100. endif
  101. 10 continue
  102. endif
  103. ddotip=resu1+resu2+resu3+resu4+resu5+resu6+resu7+resu8
  104. return
  105. end
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  

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