ireper
C IREPER SOURCE CHAT 05/01/13 00:43:49 5004 $ LISINT,LISREP, $ KRINRE, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : IREPER C PROJET : Noyau linéaire NLIN C DESCRIPTION : C C On construit KRINRE, liste d'entier de repérage des C entiers stockés dans LISINT, par rapport C aux entiers (supposées sans doublons) C de LISREP. C C Exemple : LISINC = 1 7 9 7 C LISREP = 1 3 7 9 12 C KRINRE = 1 3 4 3 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 : CORINC C*********************************************************************** C ENTREES : LNINT, LNREP, LISINT, LISREP C SORTIES : KRINRE C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 17/11/99, version initiale C HISTORIQUE : v1, 17/11/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 LNINT,LNREP INTEGER LISINT(LNINT) INTEGER LISREP(LNREP) * INTEGER KRINRE(LNINT) * INTEGER IMPR,IRET * LOGICAL LFOUND INTEGER IINT,IREP * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ireper' * DO 1 IINT=1,LNINT LFOUND=.FALSE. IREP=0 12 CONTINUE IREP=IREP+1 IF (LISINT(IINT).EQ.LISREP(IREP)) THEN LFOUND=.TRUE. ELSE IF (IREP.LT.LNREP) THEN GOTO 12 ENDIF ENDIF IF (.NOT.LFOUND) THEN WRITE(IOIMP,*) 'Un élément de LISINT n''est pas dans LISREP' GOTO 9999 ELSE KRINRE(IINT)=IREP ENDIF 1 CONTINUE * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine ireper' RETURN * * End of subroutine IREPER * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales