Sources Esope | Cast3M

noepr2e
C NOEPR2E   SOURCE    PV090527  25/09/17    21:15:01     12360          
      subroutine noepr2e(iadj,jadjc,pivot,nrelong,noelon,isens,
     > dimlon,nodes,ipos,nbtot,lfront,lfron,londim,fcout2,lpiv,
     > ipoint,noel2,bool,fcout,ldim2,ith,nbthr,npoint,npoint2,
     > imax,iccon,icouch)
       implicit real*8 (a-h,o-z)
       integer dimlon,diml2,bool
       integer pivot(*),pivots
       integer iadj(*),jadjc(*),nrelong(*),noelon(*),noel2(*)
       integer ipos(*),londim(*)
-INC PPARAM
-INC CCOPTIO
       ifront = londim(2)-londim(1)
       if (ifront.le.2) then
         elong2 = 1
       else
         xfront=ifront
       profon = dimlon / xfront
       elong2 = profon*profon/xfront
**     write (6,*) 'noepr2 dimlon londim elong',dimlon,
**   > londim(2)-londim(1),elong2
       endif
       diml2=dimlon
       nbz=  (diml2+1)/2
       nbess=      nbz**0.42 +8
       nbess=min(nbess,int(icouch**(1.33333333333333333333)))
       nbess = ((nbess-1)/nbthr+1)*nbthr
       if (elong2.gt.9) then
** si le domaine est elance, on reduit le nombre d'essais
**     write(6,*) 'dimlon xfront elong2 ',dimlon,xfront,elong2
       nbess = nbz**0.35 +8
       endif
       nbess=max(nbess,1)
       do i=1,dimlon
         noelon(i)=0
       enddo
         isig=2*mod(ipoint,2)-1
       idec=((ipoint-1)*nbz)/npoint
**     write(6,*) 'npoint ipoint ith idec',npoint,ipoint,ith,idec,nbz
       do 520 ii=ith,nbess,nbthr
        fcout2=1d50
       i= (ii*nbz+idec)/nbess+1
       i= mod(i,diml2+1)
       if (isig.eq.1.and.i.le.nbz) i=diml2+1-i
       if (isig.eq.-1.and.i.ge.nbz) i=diml2+1-i
       pivots=pivot(ipoint)
** la situation arrive vraiment!
       if (pivots.eq.noel2(i)) then
**      write(6,*) 'pivot invariant ii dimlon ipoint ',ii,dimlon,ipoint
        goto 520
       endif
       pivot(ipoint)=noel2(i)
       dimlon=diml2
       call noepr2(iadj(1),jadjc(1),pivot,nrelong(1),noelon(1),
     >   isens,dimlon,nodes,ipos(1+nodes),nbtot,lfront,lfron,
     >   londim(1),fcout2,lpiv,iccon,icouch)
**     write (6,*) ' noepr2  ipoint ii i fcout fcout2 ',
**   >       ipoint,fcout,fcout2,londim(1),londim(2),londim(3)
       if (fcout2.lt.fcout.or.(fcout2.le.fcout.and.
     >    pivots*isig.lt.pivot(ipoint)*isig)) then
**     write (6,*) 'amelioration dimlon iii i nbz ith ',
**   >        dimlon,iii,i,nbz,ith
        if (ierr.ne.0) return
        if (fcout2.ne.fcout) bool=2
        fcout=fcout2
        ldim2=londim(2)
        if (npoint.lt.50.and.imax.eq.0) then
         npoint2=npoint+1
         pivot(npoint2)=0
        endif
        if (fcout.lt.5 ) return
       else
        pivot(ipoint)=pivots
       endif
 520   continue
*      write (6,*) ' noepr2 dimlon londim ',dimlon,londim(2)-londim(1)
       end