Télécharger maxin3.eso

Retour à la liste

Numérotation des lignes :

  1. C MAXIN3 SOURCE KICH 07/10/12 21:15:14 5912
  2. SUBROUTINE MAXIN3 (IPLREE,IPLACE,PGRAND,KPLUS,LABSO)
  3. ************************************************************************
  4. *
  5. * M A X I N 3
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * FOURNIR LA PLUS GRANDE VALEUR D'UN 'LISTREEL'
  12. * COMPLETEMENT INSPIRE DE MAXIM3 QUI RECHERCHE LE MAXIMUM
  13. * EN VALEUR ABSOLUE ( POUR COMMENTAIRES VOIR MAXIM3 )
  14. *
  15. *
  16. ************************************************************************
  17. *
  18. IMPLICIT INTEGER(I-N)
  19. -INC SMLREEL
  20. *
  21. REAL*8 PGRAND,XVAL
  22. *
  23. MLREEL = IPLREE
  24. SEGACT,MLREEL
  25. LDIM = PROG(/1)
  26. *
  27. PGRAND = 0.D0
  28. IPLACE = 0
  29. IF(LDIM.EQ.0) GO TO 400
  30. *
  31. IF(LABSO.EQ.0) THEN
  32. PGRAND=PROG(1)
  33. ELSE
  34. PGRAND=ABS(PROG(1))
  35. ENDIF
  36. IPLACE = 1
  37. DO 100 IB100=1,LDIM
  38. IF(LABSO.EQ.0) THEN
  39. XVAL =PROG(IB100)
  40. ELSE
  41. XVAL =ABS(PROG(IB100))
  42. ENDIF
  43. IF((KPLUS.EQ. 1.AND.XVAL.GT.PGRAND).
  44. $ OR.(KPLUS.EQ.-1.AND.XVAL.LT.PGRAND)) THEN
  45. PGRAND = XVAL
  46. IPLACE = IB100
  47. END IF
  48. 100 CONTINUE
  49. * END DO
  50. *
  51. * RQ: POUR L'INSTANT, ON DECIDE DE RENVOYER (PGRAND = 0.) ET
  52. * (IPLACE = 0) SI LE 'LISTREEL' EST VIDE.
  53. * ON NE FAIT PAS DE MESSAGE D'ERREUR.
  54. *
  55. 400 CONTINUE
  56. SEGDES,MLREEL
  57. *
  58. END
  59.  
  60.  
  61.  

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