1 : C CREPE2 SOURCE GOUNAND 07/07/30 21:15:11 5819 2 : SUBROUTINE CREPE2(LNMOTS,LNINC,LNREP, 3 : $ LISINC,LISREP, 4 : $ KRINRE, 5 : $ IMPR,IRET) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : C*********************************************************************** 9 : C NOM : CREPE2 10 : C PROJET : Noyau linéaire NLIN 11 : C DESCRIPTION : Deux tableaux de mots => un tableau d'entiers qui sont 12 : C les indices des mots du premier tableau dans le deuxième 13 : C tableau. 14 : C On construit KRINRE, liste d'entier de repérage des 15 : C chaines de caractères stockées dans LISINC, par rapport 16 : C aux chaines de caractères (supposées sans doublons) 17 : C de LISREP. 18 : C 19 : C Exemple : LISINC = 'UN' 'PN' 'DN' 'TN' 'PN' 20 : C LISREP = 'UN' 'VN' 'PN' 'TN' 21 : C KRINRE = 1 3 0 4 3 22 : C 23 : C Cette subroutine est identique à creper mais elle ne génère pas 24 : C d'erreurs. 25 : C 26 : C 27 : C LANGAGE : FORTRAN 77 (sauf E/S) 28 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 29 : C mél : gounand@semt2.smts.cea.fr 30 : C*********************************************************************** 31 : C APPELE PAR : PRASEM 32 : C*********************************************************************** 33 : C ENTREES : LNMOTS, LNINC, LNREP, LISINC, LISREP 34 : C SORTIES : KRINRE 35 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 36 : C*********************************************************************** 37 : C VERSION : v1, 05/10/99, version initiale 38 : C HISTORIQUE : v1, 05/10/99, création 39 : C HISTORIQUE : 40 : C HISTORIQUE : 41 : C*********************************************************************** 42 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 43 : C en cas de modification de ce sous-programme afin de faciliter 44 : C la maintenance ! 45 : C*********************************************************************** 46 : -INC CCOPTIO 47 : INTEGER LNMOTS,LNINC,LNREP 48 : CHARACTER*(*) LISINC(LNINC) 49 : CHARACTER*(*) LISREP(LNREP) 50 : * 51 : INTEGER KRINRE(LNINC) 52 : * 53 : INTEGER IMPR,IRET 54 : * 55 : LOGICAL LFOUND 56 : INTEGER IINC,IREP 57 : * 58 : * Executable statements 59 : * 60 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans crepe2' 61 : * 62 : DO 1 IINC=1,LNINC 63 : LFOUND=.FALSE. 64 : IREP=0 65 : 12 CONTINUE 66 : IREP=IREP+1 67 : IF (LISINC(IINC)(1:LNMOTS).EQ.LISREP(IREP)(1:LNMOTS)) THEN 68 : LFOUND=.TRUE. 69 : ELSE 70 : IF (IREP.LT.LNREP) THEN 71 : GOTO 12 72 : ENDIF 73 : ENDIF 74 : IF (.NOT.LFOUND) THEN 75 : KRINRE(IINC)=0 76 : ELSE 77 : KRINRE(IINC)=IREP 78 : ENDIF 79 : 1 CONTINUE 80 : * 81 : * Normal termination 82 : * 83 : IRET=0 84 : RETURN 85 : * 86 : * Format handling 87 : * 88 : * 89 : * Error handling 90 : * 91 : 9999 CONTINUE 92 : IRET=1 93 : WRITE(IOIMP,*) 'An error was detected in subroutine crepe2' 94 : RETURN 95 : * 96 : * End of subroutine CREPE2 97 : * 98 : END 99 : 100 : 101 : 102 :
© Cast3M 2003 - All rights reserved.
Disclaimer