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 < 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