Sources Esope | Cast3M

ordshi
C ORDSHI    SOURCE    BP208322  11/06/06    21:15:01     6994
c
      subroutine ordshi(idist,imoshi,frshif)
c
**********************************************************************
c                               ORDSHI
c
c fonction : tri des modes contenus dans idist en fonction de
c            imoshi = nombre de modes de frequence inferieur a frshif Hz
c            (fourni par DIAGN1 dans le cas Hermitien)
c
c creation : bp 13.12.2010
c
**********************************************************************
c
      IMPLICIT INTEGER (I-N)
      IMPLICIT REAL*8(A-H,O-Z)
c
c     idist = reunion des ipsolu des differents cycles
c             (actif et *mod en entrée)
      segment idist
        integer  iexis(jg),ipomod(jg),immode(jg),ipve(jg),imil,ienc
        integer  ialter
        real*8   dist(jg),frequ(jg),shifin,dismin
      endsegment
c
      REAL*8  FRSHIF
c
        jg=iexis(/1)
 
c      -on regarde les numeros de modes &lt; imoshi
        if(imoshi.eq.0) goto 19
        iou = min(imoshi,jg)
        iou = iou + 1
 10     iou = iou - 1
        if(iou.eq.0) goto 19
        if(iexis(iou).eq.0) goto 10
        if(frequ(iou).le.frshif) goto 19
c       on a décelé une incohérence qu il faut corriger
c         write(6,*) 'incoherence 1 pour iou=',iou
        jou = imoshi
 11     jou = jou + 1
        if (jou.gt.jg) then
          jg=jou
          segadj,idist
        endif
        if(iexis(jou).ne.0) goto 11
c       jou est libre : on décale tout, libérant ainsi imoshi+1
        if ((jou-1).ge.(imoshi+1)) then
          do jj=jou-1,imoshi+1,-1
             iexis(jj+1) = iexis(jj)
             frequ(jj+1) = frequ(jj)
             dist (jj+1) = dist (jj)
             ipve (jj+1) = ipve (jj)
             ipomod(jj+1)= ipomod(jj)
             immode(jj+1)= immode(jj)
          enddo
        endif
c       et on insere iou en imoshi+1
        iexis(imoshi+1) = iexis(iou)
        frequ(imoshi+1) = frequ(iou)
        dist (imoshi+1) = dist (iou)
        ipve (imoshi+1) = ipve (iou)
        ipomod(imoshi+1)= ipomod(iou)
        immode(imoshi+1)= immode(iou)
        iexis(iou) = 0
        frequ(iou) = 0.D0
c       on boucle
        goto 10
c       jusqu'a la fin
 19     continue
 
c      -on regarde les numeros de modes > imoshi
        iou = imoshi
 20     iou = iou + 1
        if(iou.gt.jg) goto 29
        if(iexis(iou).eq.0) goto 20
        if(frequ(iou).gt.frshif) goto 29
c       on a décelé une incohérence qu il faut corriger
c         write(6,*) 'incoherence 2 pour iou=',iou
        jou = imoshi + 1
 21     jou = jou - 1
        if (jou.le.0) then
          write(6,*) 'ERREUR de positionnement dans ordshi (strate)'
          write(6,*) 'iexis=',(iexis(iio),iio=1,jg)
          write(6,*) 'frequ=',(frequ(iio),iio=1,jg)
          call erreur(6)
          return
        endif
        if(iexis(jou).ne.0) goto 21
c       jou est libre : on décale tout, libérant ainsi imoshi
        if (jou.lt.imoshi) then
          do jj=jou+1,imoshi
             iexis(jj-1) = iexis(jj)
             frequ(jj-1) = frequ(jj)
             dist (jj-1) = dist (jj)
             ipve (jj-1) = ipve (jj)
             ipomod(jj-1)= ipomod(jj)
             immode(jj-1)= immode(jj)
          enddo
        endif
c       et on insere iou en imoshi
        iexis(imoshi) = iexis(iou)
        frequ(imoshi) = frequ(iou)
        dist (imoshi) = dist (iou)
        ipve (imoshi) = ipve (iou)
        ipomod(imoshi)= ipomod(iou)
        immode(imoshi)= immode(iou)
        iexis(iou) = 0
        frequ(iou) = 0.D0
c       on boucle
        goto 20
c       jusqu'a la fin
 29     continue
 
c
      return
 
      end