Télécharger minmax.eso

Retour à la liste

Numérotation des lignes :

  1. C MINMAX SOURCE CB215821 19/06/17 21:15:18 10229
  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. XGPOS = XGRAND
  18. XGNEG =-XGRAND
  19.  
  20. *-----activation
  21. MLREEL=IPTR
  22. SEGACT MLREEL
  23. JG=PROG(/1)
  24.  
  25. *-----initialisation
  26. IDEB = 0
  27. 2 CONTINUE
  28. IDEB = IDEB + 1
  29. IF(IDEB.gt.JG) THEN
  30. WRITE(IOIMP,*) 'le listreel ',IPTR,
  31. & ' n a pas de valeur reelle finie !'
  32. MOTERR(1:8)='EVOLUTIO'
  33. CALL ERREUR(1012)
  34. ENDIF
  35. XI=PROG(IDEB)
  36. IF((XI.LT.0.D0).EQV.(XI.GE.0.D0)) THEN
  37. WRITE(IOIMP,*) IDEB,'eme valeur du listreel',IPTR,'est un NaN!'
  38. GOTO 2
  39. ENDIF
  40. IF(XI.GT.XGPOS) GOTO 2
  41. IF(XI.LT.XGNEG) GOTO 2
  42. AMINI=PROG(IDEB)
  43. AMAXI=PROG(IDEB)
  44.  
  45. *-----on boucle sur les autres valeurs
  46. IFIN=PROG(/1)
  47. IF(IDEB.GE.IFIN) RETURN
  48.  
  49. DO 1 I=IDEB+1,IFIN
  50. XI=PROG(I)
  51. * Verification que les valeurs entrees ne sont pas des NaN
  52. IF((XI.LT.0.D0).EQV.(XI.GE.0.D0)) THEN
  53. WRITE(IOIMP,*) I,'eme valeur du listreel',IPTR,'est un NaN!'
  54. IF(IERPER.GE.3) GOTO 1
  55. MOTERR(1:8)='EVOLUTIO'
  56. CALL ERREUR(1012)
  57. IF(IERR.NE.0) RETURN
  58. GOTO 1
  59. ENDIF
  60. * Si Infini, on ne prend pas en compte pour le min et max
  61. * on prend XSGRAND et pas XGRAND car DESSIN en simple precision
  62. c write(ioimp,*) I,XI,'>',XGPOS,(XI.GE.XGPOS)
  63. c write(ioimp,*) I,XI,'<',XGNEG,(XI.GE.XGNEG)
  64. IF(XI.GE.XGPOS) GOTO 1
  65. IF(XI.LE.XGNEG) GOTO 1
  66. * on realise ici le travail
  67. IF(AMINI.GT.XI) AMINI=XI
  68. IF(AMAXI.LT.XI) AMAXI=XI
  69. 1 CONTINUE
  70.  
  71. END
  72.  
  73.  

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