C NOEPR2    SOURCE    PV        13/11/29    21:15:05     7872           
C****************************************************************************
C****************************************************************************
C*************NOEPERI ..NOEuds PERIpheriques*********************************
C****************************************************************************
C****************************************************************************

C  NOEPERI part de PIVOT,lui associe l=1, associe l=l+1 a ses voisins directs,
C  repart des voisins directs pour associer un l a leur voisins....
C  LONG=max(l).
C  NRELONG(I)=l ,NOELON contient les noeuds tels que l=LONG.
*  noepr2 rend en prime la distance a la frontiere, sa taille et le
*  desequilibre des domaines
*  si nbtot n'est pas nul, noepr2 s'arrete des qu'il a trouve la
*  frontiere (il a remplis nbtot/2) pts. nrelong est alors remis a
*  zero

        SUBROUTINE NOEPR2(IADJ,JADJC,PIVOT,NRELONG,NOELON,isens,dimlon,
     >  MASQ,NODES,IPOS,NBTOT,lfront,lfron,londim,fcout,lpiv)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

        integer iadj(1),jadjc(1)
        integer pivot(lpiv)

        INTEGER LONG,DIMLON,Y,X,dimini,diminj
        integer nrelong(1),noelon(1)
          
        integer ipos(1)
        logical masq(1)
        integer londim(1)
        INTEGER NODES

        INTEGER DIML2
        LOGICAL bool2

        MDOMN=IPOS(PIVOT(1)+NODES)
        DIMLON=0
        DIML2=0
        LONG=1
        do 10 i=1,lpiv
         if (pivot(i).le.0) goto 10
         if (ipos(pivot(i)+nodes).ne.mdomn) goto 10
         do j=1,diml2
          if (pivot(i).eq.noelon(j)) then
            goto 10
          endif
         enddo
         diml2=diml2+1
         noelon(diml2)=pivot(i)
         nrelong(pivot(i))=long*2
  10   continue
       londim(1)=diml2
       mode=1
       if (nbtot.eq.0) mode=2
       if (nbtot.eq.-1) mode=3

20      CONTINUE
           DIMINI=DIMLON+1
           DIMLON=DIML2
           LONG=LONG+1
           DO 30 I=DIMINI,DIMLON
                X=NOELON(I)
                BOOL2=.false.
                DO 40 J=IADJ(X),IADJ(X+1)-1
                  Y=JADJC(J)
                  if (y.eq.0) goto 40
C                 Y: voisin d'un noeud de profondeur LONG-1.
                 IF(NRELONG(Y).EQ.LONG*2) then
                   BOOL2=.true.
                   goto 40
                 elseif (NRELONG(Y).ne.0) then
                   goto 40
                 elseif (MDOMN.EQ.IPOS(Y+NODES)) THEN
                    BOOL2=.TRUE.
                    DIML2=DIML2+1
                    NOELON(DIML2)=Y
                    NRELONG(Y)=LONG*2
                 ENDIF
40              CONTINUE
                if (bool2) nrelong(X)=long*2-1
30         CONTINUE
        londim(long)=diml2
        IF (DIML2.GT.DIMLON) goto 20
        long=long-1
C       on s'arrete si il n'y a plus rien a faire
*
        if (mode.ne.2.and.nbtot.ne.diml2) then
*  dans le cas ou la zone n'est pas connexe on va completer par
*  la partie non connexe
        do Y=1,NODES
          IF((NRELONG(Y).EQ.0).AND.(MDOMN.EQ.IPOS(Y+NODES))) THEN
                    DIML2=DIML2+1
                    NOELON(DIML2)=Y
                    NRELONG(Y)=LONG*2
                    goto 20
          ENDIF
        enddo
        endif
**      write (6,*) ' noepr2 nbtot diml2 long ',nbtot,diml2,long
        londim(long)=diml2
        dimlon=diml2
        nbtot=dimlon
*  recherche de la distance de la frontiere
        decent=1.0
        nbcher=nbtot*decent/(decent+1)
       do 101 lfron=1,long
          nbpar=londim(lfron)
          if (nbpar.gt.nbcher) goto 102
 101    continue
 102    continue
*  identification de la frontiere
      fcout=1d50
      ld=max(2,((lfron-3)*15)/16)
      lf=max(min(((lfron+2)*17)/16,long-2),2)
      do 100 lfront2=ld,lf
        lfront1=lfront2
        nbpar=londim(lfront1)
        n1bz2=nbtot-nbpar
        if (n1bz2.eq.0) then
          lfront1=lfront2-1
          nbpar=londim(lfront1)
          n1bz2=nbtot-nbpar
        endif
        nbfr=0
        if (lfront1.le.1) then
             id=1
        else
             id=londim(lfront1-1)+1
        endif
        do 120 i=id,londim(lfront1)
          x=noelon(i)
          if (mod(nrelong(x),2).eq.1)  nbfr=nbfr+1
 120    continue
* verification zone 2 connexe
*       if (londim(lfront1)+1.lt.lf) then
*       iconn=0
*       idep=noelon(londim(lfront1)+1)
*       x=idep
*       nrel=nrelong(x)
*       nrelong(x)=-nrel
*127    continue
*       irb=0
*       do 125 i=londim(lfront1)+1,londim(min(lfront1+1,lf))
*       x=noelon(i)
*       if (nrelong(x).lt.0) then
*        do 126 j=iadj(x),iadj(x+1)-1
*          y=jadjc(j)
*          if (nrelong(y)/2.eq.nrel/2) then
*             nrelong(y)=-nrelong(y)
*             irb=1
*          endif
*126     continue
*       endif
*125    continue
*       if (irb.eq.1) goto 127
*       do 128 i=londim(lfront1)+1,londim(min(lfront1+1,lf))
*        x=noelon(i)
*        if (nrelong(x).lt.0) then
*          nrelong(x)=abs(nrelong(x))
*        else
*          iconn=iconn+1
*        endif
*128    continue
*       endif
        n1bz1=nbtot-n1bz2-nbfr
*       if (n1bz1.eq.0) goto 100
        ideseq=n1bz1-n1bz2*decent
*       if (iconn.ne.0) then
*         n1bz2=nbtot-n1bz1-nbfr-iconn
*         ideseq=max(n1bz1,n1bz2,iconn)
*       endif  
        xbtot=nbtot
        xbfr=nbfr
        xdeseq=abs(ideseq)
*       x1bz1=n1bz1
*       x1bz2=n1bz2
**      fcouu=(xbfr        )**4  +  (xdeseq )**3
**   >    -lfront1
        fcouu= 2*xbtot*xbfr+xbfr*xbfr*xbfr/3.0 +xdeseq**2
     >    -lfront1
        if (nbfr.eq.0) then
**       write (6,*) ' frontiere vide ',n1bz1,n1bz2,nbtot,mdomn
         fcouu=1
        endif
        if (fcouu.le.fcout) then
         nbz1=n1bz1
         nbz2=n1bz2
         lfront=lfront1
         fcout=fcouu
        endif
 100  continue
*       write (6,*) ' noepr2 ',nbz1,nbz2,nbfr,lfront,
*    >              long,nbtot,MDOMN
        isens=2
        if (nbz1.lt.nbz2) isens=1
*  mise a zero eventuel de nrelong
        if (mode.eq.1) then
         do i=1,londim(long)
          x=noelon(i)
          if (x.ne.0) nrelong(x)=0
         enddo
        endif
        if (mode.ne.1) then
         do i=1,londim(long)
          x=noelon(i)
          if (x.ne.0) nrelong(x)=nrelong(x)/2
         enddo
        endif
        lfron = long
        return
        end