Télécharger noepr2e.eso

Retour à la liste

Numérotation des lignes :

  1. C NOEPR2E SOURCE PV 16/06/15 21:15:07 8961
  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)
  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. ** write (6,*) ' noepr2e nbthr ',nbthr
  17. diml2=dimlon
  18. do i=1,dimlon
  19. noelon(i)=0
  20. enddo
  21. nbz= (diml2+1)/2
  22. isig=2*mod(ipoint,2)-1
  23. do 520 ii=ith,nbess,nbthr
  24. fcout2=1d50
  25. i= (( ii-1)*(nbz))/(nbess)+1+((ipoint-1)*nbz)/(npoint*nbess)
  26. i=mod(i-1,diml2)+1
  27. if (mod(ipoint,2).eq.1) i=diml2+1-i
  28. ** write (6,*) ' nbthr nbess nbz ith ii i',nbthr,nbess,nbz,ith,ii,i
  29.  
  30. pivots=pivot(ipoint)
  31. pivot(ipoint)=noel2(i)
  32. dimlon=diml2
  33. ** if (ii.ne.0) pivot(ipoint)=noelon(i)
  34. call noepr2(iadj(1),jadjc(1),pivot,nrelong(1),noelon(1),
  35. > isens,dimlon,masq(1),nodes,ipos(1),nbtot,lfront,lfron,
  36. > londim(1),fcout2,lpiv,iccon)
  37. ** write (6,*) ' noepr2 ipoint ii i fcout fcout2 ',
  38. ** > ipoint,fcout,fcout2,londim(1),londim(2),londim(3)
  39. if (fcout2.lt.fcout.or.(fcout2.le.fcout.and.
  40. > pivots*isig.lt.pivot(ipoint)*isig)) then
  41. ** write (6,*) 'amelioration dimlon iii i nbz ith ',
  42. ** > dimlon,iii,i,nbz,ith
  43. if (fcout2.ne.fcout) bool=2
  44. fcout=fcout2
  45. ldim2=londim(2)
  46. if (npoint.lt.50.and.imax.eq.0) then
  47. npoint2=npoint+1
  48. pivot(npoint2)=0
  49. endif
  50. if (fcout.lt.2) return
  51. else
  52. pivot(ipoint)=pivots
  53. endif
  54. 520 continue
  55. end
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  

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