Télécharger la plaquette Cast3M


fr en

Télécharger maxin3.eso

Retour à la liste

Numérotation des lignes : 

maxin3

  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