Télécharger la plaquette Cast3M


fr en

Télécharger noepr2e.eso

Retour à la liste

Numérotation des lignes : 

noepr2e

  1. C NOEPR2E   SOURCE    PV        20/11/26    21:15:09     10699          
  2.       subroutine noepr2e(iadj,jadjc,pivot,nrelong,noelon,isens,
  3.      > dimlon,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.        integer ipos(*),londim(*)
  11.  
  12. *      write (6,*) ' noepr2 dimlon lfront ipoint ',dimlon,lfront,ipoint
  13.        diml2=dimlon
  14.        nbz=  (diml2+1)/2
  15.        nbess= int(nbz**0.42)+8 
  16.        nbess=min(nbess,int((icouch)**(1.33333333333333333333)))
  17.        nbess=max(nbess,1)
  18.        do i=1,dimlon
  19.          noelon(i)=0
  20.        enddo
  21.          isig=2*mod(ipoint,2)-1
  22.        idec=((ipoint-1)*nbz)/npoint
  23. **     write(6,*) 'npoint ipoint ith idec',npoint,ipoint,ith,idec,nbz
  24.        do 520 ii=ith,nbess,nbthr
  25.         fcout2=1d50
  26.        i= (ii*nbz+idec)/nbess+1
  27.        if (isig.eq.1.and.i.lt.nbz) i=diml2+1-i
  28.        if (isig.eq.-1.and.i.gt.nbz) i=diml2+1-i
  29.        pivots=pivot(ipoint)
  30. ** la situation arrive vraiment!
  31.        if (pivots.eq.noel2(i)) then
  32. **      write(6,*) 'pivot invariant ii dimlon ipoint ',ii,dimlon,ipoint
  33.         goto 520
  34.        endif
  35.        pivot(ipoint)=noel2(i)
  36.        dimlon=diml2
  37.        call noepr2(iadj(1),jadjc(1),pivot,nrelong(1),noelon(1),
  38.      >   isens,dimlon,nodes,ipos(1),nbtot,lfront,lfron,
  39.      >   londim(1),fcout2,lpiv,iccon,icouch)
  40. **     write (6,*) ' noepr2  ipoint ii i fcout fcout2 ',
  41. **   >       ipoint,fcout,fcout2,londim(1),londim(2),londim(3)
  42.        if (fcout2.lt.fcout.or.(fcout2.le.fcout.and.
  43.      >    pivots*isig.lt.pivot(ipoint)*isig)) then
  44. **     write (6,*) 'amelioration dimlon iii i nbz ith ',
  45. **   >        dimlon,iii,i,nbz,ith
  46.         if (fcout2.ne.fcout) bool=2
  47.         fcout=fcout2
  48.         ldim2=londim(2)
  49.         if (npoint.lt.50.and.imax.eq.0) then
  50.          npoint2=npoint+1
  51.          pivot(npoint2)=0
  52.         endif
  53.         if (fcout.lt.5 ) return
  54.        else
  55.         pivot(ipoint)=pivots
  56.        endif
  57.  520   continue
  58.        end
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  

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