Télécharger ddotpw.eso

Retour à la liste

Numérotation des lignes :

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

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