Télécharger ddotpw.eso

Retour à la liste

Numérotation des lignes :

  1. C DDOTPW SOURCE PV 16/11/17 21:58:58 9180
  2. function ddotpw(lon,val1,val2,imasq,idep,nbo)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. -INC CCHOLE
  6. logical nul
  7. dimension val1(*),val2(*),imasq(*)
  8. resu1=0.d0
  9. if (lon.le.0) goto 100
  10. jini=idep/masdim
  11. * write (6,*) ' entree dans ddotpw ',idep,lon
  12. 5 continue
  13. * write (6,*) ' apres 5 dans ddotpw',jini,imasq(jini+1)
  14. jinii=jini
  15. nul=.false.
  16. *** if (imasq(jini+1).lt.0) jini=-imasq(jini+1)/masdim+1
  17. 6 continue
  18. j=jini
  19. do 10 j=jini,(idep+lon-1)/masdim
  20. jm=imasq(j+1)
  21. if (jm.gt.0) goto 20
  22. if (jm.eq.0) goto 10
  23. * write (6,*) ' acc 1 ',jini,-imasq(j+1)/masdim+1
  24. jinio=-jm/masdim+1
  25. if (jinio.gt.j+7) then
  26. ** if (j-jini.gt.100) write (6,*) ' rien trouve 2 jini ',jini,j
  27. jini=jinio
  28. goto 6
  29. endif
  30. 10 continue
  31. ** if (j-jini.gt.100) write (6,*) ' rien trouve jini ',jini,j
  32. nul=.true.
  33. 20 continue
  34. nmasq=min(imasq(j-1+1),-(j-1)*masdim)
  35. do jj=jinii,j-1
  36. if (imasq(jj+1).le.nmasq) goto 22
  37. imasq(jj+1)=nmasq
  38. enddo
  39. 22 continue
  40. 21 continue
  41. * tous les masques nuls
  42. if (nul) goto 100
  43. jini=j
  44. jfines=jini+1
  45. jfin=jfines
  46. if (jfines.gt.(idep+lon-1)/masdim) goto 32
  47. * write (6,*) ' apres 21 dans ddotpw ',j,imasq(jfines+1)
  48. *** if (imasq(jfines+1).gt.1) jfines=imasq(jfines+1)/masdim+1
  49. 31 continue
  50. jfin=jfines
  51. do 30 jfin=jfines,(idep+lon-1)/masdim
  52. jm=imasq(jfin+1)
  53. if (jm.le.0) goto 40
  54. if (jm.eq.1) goto 30
  55. * write (6,*) ' acc 2 ',idep,jfines,imasq(jfin+1)/masdim+1
  56. jfineo=jm/masdim+1
  57. if (jfineo.gt.jfin+7) then
  58. jfines=jfineo
  59. goto 31
  60. endif
  61. 30 continue
  62. ** if (jfin-jfines.gt.10) write (6,*) 'rien trouve jfin ',
  63. ** > jfin,jfines
  64. 40 continue
  65. nmasq=max(imasq(jfin-1+1),(jfin-1)*masdim)
  66. do jj=j,jfin-1
  67. if (imasq(jj+1).ge.nmasq) goto 33
  68. imasq(jj+1)=nmasq
  69. enddo
  70. 33 continue
  71. 32 continue
  72. jfin=jfin-1
  73. ideb=max(1,jini*masdim-idep+1)
  74. ifin=min((jfin+1)*masdim-idep,lon)
  75. * write (6,*) ' ddotpw ideb ifin lon ',ideb,ifin,lon,jini,jfines,
  76. * > jfin
  77. ** do i=ideb,ifin
  78. ** resu1=resu1+val1(i)*val2(i)
  79. ** enddo
  80.  
  81. resu2=0.d0
  82. resu3=0.d0
  83. resu4=0.d0
  84. lonl=ifin-ideb+1
  85. if (lonl.gt.0) then
  86. * unrolling desactive sur gfortran car inhibe la vectorisation
  87. * do 210 i=ideb-1,ifin-4,4
  88. * resu1=resu1+val1(i+1)*val2(i+1)
  89. * resu2=resu2+val1(i+2)*val2(i+2)
  90. * resu3=resu3+val1(i+3)*val2(i+3)
  91. * resu4=resu4+val1(i+4)*val2(i+4)
  92. *210 continue
  93. * indeb=ideb+(lonl/4)*4
  94. indeb=ideb
  95. do 220 i=indeb,ifin
  96. resu1=resu1+val1(i)*val2(i)
  97. 220 continue
  98. if (ifin-indeb.ge.0) nbo=nbo+ifin-indeb+1
  99. if (indeb.gt.ifin+100000) write (6,*) ' ddotpw indeb ifin ',
  100. > ideb,ifin
  101. * resu1=resu1+resu2+resu3+resu4
  102. endif
  103. if (ifin.ge.lon) goto 100
  104. jini=jfin+1
  105. goto 5
  106. 100 continue
  107. ddotpw=resu1
  108. return
  109. end
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  

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