Télécharger maxin2.eso

Retour à la liste

Numérotation des lignes :

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

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