Sources Esope | Cast3M

ddotip
C DDOTIP    SOURCE    PV090527  24/04/16    21:15:02     11902          
      function ddotip(lon,val1,ind,val2)
*  produit scalaire sparse. ind est le tableau de pointeur. 
*  si lon est negatif, on fait la boucle à l'envers.
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      dimension val1(*),val2(*),ind(*)
      resu1=0.d0
      resu2=0.d0
      resu3=0.d0
      resu4=0.d0
      resu5=0.d0
      resu6=0.d0
      resu7=0.d0
      resu8=0.d0
      if (lon.gt.0) then
       do    i=0,lon-8,8
        indn1=ind(i+1)
        indn2=ind(i+2)
        indn3=ind(i+3)
        indn4=ind(i+4)
        indn5=ind(i+5)
        indn6=ind(i+6)
        indn7=ind(i+7)
        indn8=ind(i+8)
        resu1=resu1+val1(i+1)*val2(indn1)
        resu2=resu2+val1(i+2)*val2(indn2)
        resu3=resu3+val1(i+3)*val2(indn3)
        resu4=resu4+val1(i+4)*val2(indn4)
        resu5=resu5+val1(i+5)*val2(indn5)
        resu6=resu6+val1(i+6)*val2(indn6)
        resu7=resu7+val1(i+7)*val2(indn7)
        resu8=resu8+val1(i+8)*val2(indn8)
       enddo    
       if(i.le.lon-4) then
        indn1=ind(i+1)
        indn2=ind(i+2)
        indn3=ind(i+3)
        indn4=ind(i+4)
        resu1=resu1+val1(i+1)*val2(indn1)
        resu2=resu2+val1(i+2)*val2(indn2)
        resu3=resu3+val1(i+3)*val2(indn3)
        resu4=resu4+val1(i+4)*val2(indn4)
        i=i+4
       endif
       if(i.le.lon-2) then
        indn1=ind(i+1)
        indn2=ind(i+2)
        resu1=resu1+val1(i+1)*val2(indn1)
        resu2=resu2+val1(i+2)*val2(indn2)
        i=i+2
       endif
       if(i.le.lon-1) then
        indn1=ind(i+1)
        resu1=resu1+val1(i+1)*val2(indn1)
        i=i+1
       endif
      elseif (lon.lt.0) then
       lon=-lon
       do    i=lon+1,9,-8
        indn1=ind(i-1)
        indn2=ind(i-2)
        indn3=ind(i-3)
        indn4=ind(i-4)
        indn5=ind(i-5)
        indn6=ind(i-6)
        indn7=ind(i-7)
        indn8=ind(i-8)
        resu1=resu1+val1(i-1)*val2(indn1)
        resu2=resu2+val1(i-2)*val2(indn2)
        resu3=resu3+val1(i-3)*val2(indn3)
        resu4=resu4+val1(i-4)*val2(indn4)
        resu5=resu5+val1(i-5)*val2(indn5)
        resu6=resu6+val1(i-6)*val2(indn6)
        resu7=resu7+val1(i-7)*val2(indn7)
        resu8=resu8+val1(i-8)*val2(indn8)
        enddo    
       if(i.ge.5) then
        indn1=ind(i-1)
        indn2=ind(i-2)
        indn3=ind(i-3)
        indn4=ind(i-4)
        resu1=resu1+val1(i-1)*val2(indn1)
        resu2=resu2+val1(i-2)*val2(indn2)
        resu3=resu3+val1(i-3)*val2(indn3)
        resu4=resu4+val1(i-4)*val2(indn4)
        i=i-4
       endif
       if(i.ge.3) then
        indn1=ind(i-1)
        indn2=ind(i-2)
        resu1=resu1+val1(i-1)*val2(indn1)
        resu2=resu2+val1(i-2)*val2(indn2)
        i=i-2
       endif
       if(i.ge.2) then
        indn1=ind(i-1)
        resu1=resu1+val1(i-1)*val2(indn1)
        i=i-1
       endif
10    continue
      endif
      ddotip=resu1+resu2+resu3+resu4+resu5+resu6+resu7+resu8
      return
      end