ifidic
C IFIDIC SOURCE CHAT 05/01/13 00:32:50 5004 $ IDX, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : IFIDIC C DESCRIPTION : Recherche l'index d'une valeur dans un tableau ordonné C d'entiers. C C Cherche IDX dans un tableau ordonné d'entiers TAB C tel que : TAB(IDX)=VAL C La méthode utilisée est un binary search decrite dans C The art of Programming Vol.3 (D. Knuth) C C C LANGAGE : FORTRAN 77 (sauf (E/S) C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELE PAR : MKIZA C*********************************************************************** C ENTREES : LONTAB, TAB, VAL C SORTIES : IDX C*********************************************************************** C VERSION : v1, 08/10/99, version initiale C HISTORIQUE : v1, 08/10/99, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC PPARAM -INC CCOPTIO INTEGER LONTAB INTEGER TAB(LONTAB) INTEGER VAL,IDX * INTEGER IMPR,IRET * INTEGER IDXINF,IDXMIL,IDXSUP INTEGER VALMIL C C Executable statements C IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans ifidic' IDXINF=1 IDXSUP=LONTAB 1 CONTINUE IF (IDXSUP.LT.IDXINF) GOTO 9998 IDXMIL=(IDXINF+IDXSUP)/2 VALMIL=TAB(IDXMIL) IF (VAL.LT.VALMIL) THEN IDXSUP=IDXMIL-1 GOTO 1 ELSEIF (VAL.GT.VALMIL) THEN IDXINF=IDXMIL+1 GOTO 1 ELSE IDX=IDXMIL ENDIF * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9998 CONTINUE WRITE(IOIMP,*) 'La valeur n''est pas dans le tableau ', $ 'ou le tableau n''est pas ordonnée...' 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine ifidic' RETURN * * End of subroutine IFIDIC * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales