1C 2C This file is issued from the MODULEF library, but has been 3C subsequently modified 4C 5 SUBROUTINE FONDID(NIDENT) 6C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 7C S.P. FONDID (FONCTIONS INTERPRETEES) 8C ----------- 9C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 10C BUT : 11C DETRUIRE DE LA TABLE DES IDENTIFICATEURS 12C LES NIDENT DERNIERS IDENTIFICATEURS RENCONTRES 13C 14C PARAMETRES D ENTREE : 15C NIDENT : NOMBRE D IDENTIFICATEURS A DETRUIRE 16C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 17C PROGRAMMEUR : PATRICK LAUG ; INRIA (3) 954 90 20 POSTE 508 18C ...................................................................... 19 PARAMETER (LIDN=8) 20 CHARACTER*256 MIDN(LIDN) 21 COMMON /FONIDN/ MIDN 22 COMMON /FONNUM/ IDLIG,IFLIG,NITEMS,NBIDEN,IMPLIC 23 COMMON /FONLC / LCI,LCR,LCL,LCC,LCD,LCOPN,LCOPT,LCSYM,LCEXP,LCIDN 24 COMMON /FONLM / LMI,LMR,LML,LMC,LMD,LMOPN,LMOPT,LMSYM,LMEXP,LMIDN 25C 26 IF (NIDENT.LE.0) RETURN 27 NBIDEN = MAX(NBIDEN-NIDENT, 0) 28 IIDENT = 0 29C 30C PARCOURS INVERSE DE LA CHAINE 31 100 IFIN = INDEX(MIDN(LCIDN), '||') 32 200 IFIN = IFIN - 1 33 IF (IFIN .LE. 0) THEN 34 LCIDN = LCIDN - 1 35 IF (LCIDN .LE. 0) THEN 36 LCIDN = 1 37 MIDN(1)(1:2) = '||' 38 RETURN 39 END IF 40 GOTO 100 41 END IF 42 IF (MIDN(LCIDN)(IFIN:IFIN) .EQ. '|') THEN 43 IIDENT = IIDENT + 1 44 IF (IIDENT .EQ. NIDENT) THEN 45 MIDN(LCIDN)(IFIN+1:IFIN+1) = '|' 46 RETURN 47 END IF 48 END IF 49 GOTO 200 50 END 51