Télécharger ordshi.eso

Retour à la liste

Numérotation des lignes :

  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)
  87. call erreur(6)
  88. return
  89. endif
  90. if(iexis(jou).ne.0) goto 21
  91. c jou est libre : on décale tout, libérant ainsi imoshi
  92. if (jou.lt.imoshi) then
  93. do jj=jou+1,imoshi
  94. iexis(jj-1) = iexis(jj)
  95. frequ(jj-1) = frequ(jj)
  96. dist (jj-1) = dist (jj)
  97. ipve (jj-1) = ipve (jj)
  98. ipomod(jj-1)= ipomod(jj)
  99. immode(jj-1)= immode(jj)
  100. enddo
  101. endif
  102. c et on insere iou en imoshi
  103. iexis(imoshi) = iexis(iou)
  104. frequ(imoshi) = frequ(iou)
  105. dist (imoshi) = dist (iou)
  106. ipve (imoshi) = ipve (iou)
  107. ipomod(imoshi)= ipomod(iou)
  108. immode(imoshi)= immode(iou)
  109. iexis(iou) = 0
  110. frequ(iou) = 0.D0
  111. c on boucle
  112. goto 20
  113. c jusqu'a la fin
  114. 29 continue
  115.  
  116. c
  117. return
  118.  
  119. end
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales