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 :
© Cast3M 2003 - All rights reserved.
Disclaimer