Télécharger minmax.eso

Retour à la liste

Numérotation des lignes :

  1. C MINMAX SOURCE BP208322 14/09/09 21:15:08 8139
  2. SUBROUTINE MINMAX (IPTR,AMINI,AMAXI)
  3. *
  4. *=============================================================
  5. * IPTR (E/S) POINTEUR SUR UNE LISTE DE REELS
  6. * AMINI (S) MINI DE LA LISTE
  7. * AMAXI (S) MAXI DE LA LISTE
  8. *=============================================================
  9. *
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8 (A-H,O-Y)
  12.  
  13. -INC CCOPTIO
  14. -INC SMLREEL
  15. -INC CCREEL
  16.  
  17. *-----on prend XSGRAND et pas XGRAND car DESSIN en simple precision
  18. c WRITE(IOIMP,*) 'XPETIT,XSPETI=',XPETIT,XSPETI
  19. c WRITE(IOIMP,*) 'XGRAND,XSGRAN=',XGRAND,XSGRAN
  20. XGPOS = 1.D0*XSGRAN
  21. XGNEG = -1.D0*XSGRAN
  22. c WRITE(IOIMP,*) 'XGPOS,XGNEG=',XGPOS,XGNEG
  23.  
  24. *-----activation
  25. MLREEL=IPTR
  26. SEGACT MLREEL
  27. JG=PROG(/1)
  28.  
  29. *-----initialisation
  30. IDEB = 0
  31. 2 CONTINUE
  32. IDEB = IDEB + 1
  33. IF(IDEB.gt.JG) THEN
  34. WRITE(IOIMP,*) 'le listreel ',IPTR,
  35. & ' n a pas de valeur reelle finie !'
  36. MOTERR(1:8)='EVOLUTIO'
  37. CALL ERREUR(1012)
  38. ENDIF
  39. XI=PROG(IDEB)
  40. IF((XI.LT.0.D0).EQV.(XI.GE.0.D0)) THEN
  41. WRITE(IOIMP,*) IDEB,'eme valeur du listreel',IPTR,'est un NaN!'
  42. GOTO 2
  43. ENDIF
  44. IF(XI.GT.XGPOS) GOTO 2
  45. IF(XI.LT.XGNEG) GOTO 2
  46. AMINI=PROG(IDEB)
  47. AMAXI=PROG(IDEB)
  48.  
  49. *-----on boucle sur les autres valeurs
  50. IFIN=PROG(/1)
  51. IF(IDEB.GE.IFIN) GOTO 3
  52. DO 1 I=IDEB+1,IFIN
  53. XI=PROG(I)
  54. * Verification que les valeurs entrees ne sont pas des NaN
  55. IF((XI.LT.0.D0).EQV.(XI.GE.0.D0)) THEN
  56. WRITE(IOIMP,*) I,'eme valeur du listreel',IPTR,'est un NaN!'
  57. IF(IERPER.GE.3) GOTO 1
  58. MOTERR(1:8)='EVOLUTIO'
  59. CALL ERREUR(1012)
  60. IF(IERR.NE.0) RETURN
  61. GOTO 1
  62. ENDIF
  63. * Si Infini, on ne prend pas en compte pour le min et max
  64. * on prend XSGRAND et pas XGRAND car DESSIN en simple precision
  65. c write(ioimp,*) I,XI,'>',XGPOS,(XI.GE.XGPOS)
  66. c write(ioimp,*) I,XI,'<',XGNEG,(XI.GE.XGNEG)
  67. IF(XI.GE.XGPOS) GOTO 1
  68. IF(XI.LE.XGNEG) GOTO 1
  69. * on realise ici le travail
  70. IF(AMINI.GT.XI) AMINI=XI
  71. IF(AMAXI.LT.XI) AMAXI=XI
  72. 1 CONTINUE
  73.  
  74. * fin du programme
  75. 3 CONTINUE
  76. SEGDES MLREEL
  77. END
  78.  
  79.  
  80.  
  81.  

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