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