Esope source files

   1 : C ORDSHI    SOURCE    BP208322  11/06/06    21:15:01     6994           
   2 : c      
   3 :       subroutine ordshi(idist,imoshi,frshif)
   4 : c
   5 : **********************************************************************  
   6 : c                               ORDSHI  
   7 : c
   8 : c fonction : tri des modes contenus dans idist en fonction de 
   9 : c            imoshi = nombre de modes de frequence inferieur a frshif Hz 
  10 : c            (fourni par DIAGN1 dans le cas Hermitien) 
  11 : c
  12 : c creation : bp 13.12.2010
  13 : c
  14 : **********************************************************************  
  15 : c 
  16 :       IMPLICIT INTEGER (I-N)
  17 :       IMPLICIT REAL*8(A-H,O-Z)
  18 : c
  19 : c     idist = reunion des ipsolu des differents cycles 
  20 : c             (actif et *mod en entrée) 
  21 :       segment idist
  22 :         integer  iexis(jg),ipomod(jg),immode(jg),ipve(jg),imil,ienc
  23 :         integer  ialter
  24 :         real*8   dist(jg),frequ(jg),shifin,dismin
  25 :       endsegment
  26 : c      
  27 :       REAL*8  FRSHIF 
  28 : c
  29 :         jg=iexis(/1)
  30 :         
  31 : c      -on regarde les numeros de modes < imoshi 
  32 :         if(imoshi.eq.0) goto 19
  33 :         iou = min(imoshi,jg)
  34 :         iou = iou + 1
  35 :  10     iou = iou - 1
  36 :         if(iou.eq.0) goto 19
  37 :         if(iexis(iou).eq.0) goto 10
  38 :         if(frequ(iou).le.frshif) goto 19
  39 : c       on a décelé une incohérence qu il faut corriger
  40 : c         write(6,*) 'incoherence 1 pour iou=',iou
  41 :         jou = imoshi
  42 :  11     jou = jou + 1
  43 :         if (jou.gt.jg) then
  44 :           jg=jou
  45 :           segadj,idist
  46 :         endif
  47 :         if(iexis(jou).ne.0) goto 11
  48 : c       jou est libre : on décale tout, libérant ainsi imoshi+1
  49 :         if ((jou-1).ge.(imoshi+1)) then 
  50 :           do jj=jou-1,imoshi+1,-1
  51 :              iexis(jj+1) = iexis(jj)
  52 :              frequ(jj+1) = frequ(jj)
  53 :              dist (jj+1) = dist (jj)
  54 :              ipve (jj+1) = ipve (jj)
  55 :              ipomod(jj+1)= ipomod(jj)
  56 :              immode(jj+1)= immode(jj)        
  57 :           enddo
  58 :         endif 
  59 : c       et on insere iou en imoshi+1  
  60 :         iexis(imoshi+1) = iexis(iou)
  61 :         frequ(imoshi+1) = frequ(iou)
  62 :         dist (imoshi+1) = dist (iou)
  63 :         ipve (imoshi+1) = ipve (iou)
  64 :         ipomod(imoshi+1)= ipomod(iou)
  65 :         immode(imoshi+1)= immode(iou)        
  66 :         iexis(iou) = 0 
  67 :         frequ(iou) = 0.D0 
  68 : c       on boucle
  69 :         goto 10        
  70 : c       jusqu'a la fin
  71 :  19     continue
  72 :  
  73 : c      -on regarde les numeros de modes > imoshi 
  74 :         iou = imoshi
  75 :  20     iou = iou + 1
  76 :         if(iou.gt.jg) goto 29
  77 :         if(iexis(iou).eq.0) goto 20
  78 :         if(frequ(iou).gt.frshif) goto 29
  79 : c       on a décelé une incohérence qu il faut corriger        
  80 : c         write(6,*) 'incoherence 2 pour iou=',iou
  81 :         jou = imoshi + 1
  82 :  21     jou = jou - 1
  83 :         if (jou.le.0) then
  84 :           write(6,*) 'ERREUR de positionnement dans ordshi (strate)' 
  85 :           write(6,*) 'iexis=',(iexis(iio),iio=1,jg)
  86 :           write(6,*) 'frequ=',(frequ(iio),iio=1,jg)
  86 :           call erreur(6)
  87 :           return
  88 :         endif
  89 :         if(iexis(jou).ne.0) goto 21
  90 : c       jou est libre : on décale tout, libérant ainsi imoshi
  91 :         if (jou.lt.imoshi) then 
  92 :           do jj=jou+1,imoshi
  93 :              iexis(jj-1) = iexis(jj)
  94 :              frequ(jj-1) = frequ(jj)
  95 :              dist (jj-1) = dist (jj)
  96 :              ipve (jj-1) = ipve (jj)
  97 :              ipomod(jj-1)= ipomod(jj)
  98 :              immode(jj-1)= immode(jj)        
  99 :           enddo
 100 :         endif 
 101 : c       et on insere iou en imoshi  
 102 :         iexis(imoshi) = iexis(iou)
 103 :         frequ(imoshi) = frequ(iou)
 104 :         dist (imoshi) = dist (iou)
 105 :         ipve (imoshi) = ipve (iou)
 106 :         ipomod(imoshi)= ipomod(iou)
 107 :         immode(imoshi)= immode(iou)        
 108 :         iexis(iou) = 0 
 109 :         frequ(iou) = 0.D0 
 110 : c       on boucle
 111 :         goto 20        
 112 : c       jusqu'a la fin
 113 :  29     continue
 114 : 
 115 : c
 116 :       return
 117 :       
 118 :       end
 119 :       
 120 :  
 121 :  
 122 :  
 123 :