Télécharger noepr2e.eso

Retour à la liste

Numérotation des lignes :

  1. C NOEPR2E SOURCE PV 18/03/08 21:15:05 9772
  2. subroutine noepr2e(iadj,jadjc,pivot,nrelong,noelon,isens,
  3. > dimlon,masq,nodes,ipos,nbtot,lfront,lfron,londim,fcout2,lpiv,
  4. > ipoint,noel2,bool,fcout,ldim2,ith,nbthr,npoint,npoint2,
  5. > imax,iccon,icouch)
  6. implicit real*8 (a-h,o-z)
  7. integer dimlon,diml2,bool
  8. integer pivot(*),pivots
  9. integer iadj(*),jadjc(*),nrelong(*),noelon(*),noel2(*)
  10. logical masq(*)
  11. integer ipos(*),londim(*)
  12.  
  13. * write (6,*) ' noepr2 dimlon lfront ipoint ',dimlon,lfront,ipoint
  14. nbess= int(dimlon**0.42+8)
  15. nbess=min(nbess,dimlon/2)
  16. nbess=min(nbess,(icouch-4)*3)
  17. nbess=max(nbess,1)
  18. ** write (6,*) ' noepr2e nbthr ',nbthr
  19. diml2=dimlon
  20. do i=1,dimlon
  21. noelon(i)=0
  22. enddo
  23. nbz= (diml2+1)/2
  24. isig=2*mod(ipoint,2)-1
  25. do 520 ii=ith,nbess,nbthr
  26. fcout2=1d50
  27. i= (( ii-1)*(nbz))/(nbess)+1+((ipoint-1)*nbz)/(npoint*nbess)
  28. i=mod(i-1,diml2)+1
  29. if (mod(ipoint,2).eq.1) i=diml2+1-i
  30. ** write (6,*) ' nbthr nbess nbz ith ii i',nbthr,nbess,nbz,ith,ii,i
  31.  
  32. pivots=pivot(ipoint)
  33. pivot(ipoint)=noel2(i)
  34. dimlon=diml2
  35. ** if (ii.ne.0) pivot(ipoint)=noelon(i)
  36. call noepr2(iadj(1),jadjc(1),pivot,nrelong(1),noelon(1),
  37. > isens,dimlon,masq(1),nodes,ipos(1),nbtot,lfront,lfron,
  38. > londim(1),fcout2,lpiv,iccon,icouch)
  39. ** write (6,*) ' noepr2 ipoint ii i fcout fcout2 ',
  40. ** > ipoint,fcout,fcout2,londim(1),londim(2),londim(3)
  41. if (fcout2.lt.fcout.or.(fcout2.le.fcout.and.
  42. > pivots*isig.lt.pivot(ipoint)*isig)) then
  43. ** write (6,*) 'amelioration dimlon iii i nbz ith ',
  44. ** > dimlon,iii,i,nbz,ith
  45. if (fcout2.ne.fcout) bool=2
  46. fcout=fcout2
  47. ldim2=londim(2)
  48. if (npoint.lt.50.and.imax.eq.0) then
  49. npoint2=npoint+1
  50. pivot(npoint2)=0
  51. endif
  52. if (fcout.lt.2) return
  53. else
  54. pivot(ipoint)=pivots
  55. endif
  56. 520 continue
  57. end
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  

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