Download lirmot.eso

Back to the list

   1 : C LIRMOT    SOURCE    PV        14/02/20    21:15:01     7973           
   2 : C  CE PROGRAMME PERMET DE SIMULER UN SOUS-TYPAGE AU NIVEAU DES MOTS       
   3 : C                                                                         
   4 :       SUBROUTINE LIRMOT(MOTCLE,MOTDI ,IVAL,ICOND)
   5 : C     MOTCLE TABLEAU DES MOTS CLES POSSIBLES                              
   6 : C     MOTDIM DIMENSION DE MOTCLE                                          
   7 : C     IVAL   POSITION DU MOT TROUVE DANS MOTCLE (0) SI ECHEC              
   8 : C     ICOND  LECTURE IMPERATIVE OU NON                                    
   9 :       IMPLICIT INTEGER(I-N)
  10 :       CHARACTER*(*) MOTCLE(*)                                             
  11 :       CHARACTER*500 MOT                                                   
  12 :       EXTERNAL LONG
  13 : -INC CCOPTIO                                                              
  14 :       motdim=abs(motdi)
  15 :       IVAL=0 
  16 :       ICONDO=ICOND                                                             
  17 :       LMOT=LEN(MOTCLE(1))                    
  17 :       CALL LIRCHA(MOT(1:LMOT),ICONDO,IRETOU)                              
  18 :       IF (IERR.NE.0) RETURN                                                                                                                        
  19 :       IF (IRETOU.EQ.0) RETURN                                                                                                          
  20 :       DO 1 I=1,MOTDIM                                                     
  21 :       IF (MOT(1:LMOT).EQ.MOTCLE(I)) GOTO 2                                
  22 :    1  CONTINUE  
  23 :       if (motdi.gt.0) goto 3
  24 :       LLU=LONG(MOT(1:LMOT))
  25 :       ITROUV=0
  26 :       DO 5 I=1,MOTDIM
  27 :       IF (MOT(1:LLU).NE.MOTCLE(I)(1:MIN(LLU,LMOT))) GOTO 5
  28 :       ITROUV=ITROUV+1
  29 :       IV=I
  30 :    5  CONTINUE
  31 :       I=IV
  32 :       IF (ITROUV.EQ.1) GOTO 2
  33 : 
  34 :       IF (MOT(1:2).NE.'? ') GOTO 3                                                                                                                 
  35 :       WRITE (IOIMP,100) (MOTCLE(I),I=1,MOTDIM)
  36 :  100  FORMAT(/,' LISTE DES MOTS RECONNUS',/,(1H ,10A8))                                                                                            
  36 :    3  CALL REFUS                                                          
  37 :       I=0                                                                                                                                          
  38 :       MOTERR(1:8)=MOT(1:8)                                                
  39 :       IF (ICOND.EQ.1) THEN 
  39 :        CALL ERREUR(7)
  40 :        if (mot(1:2).ne.'? ')WRITE(IOIMP,110) (MOTCLE(I),I=1,MOTDIM)
  41 :  110   FORMAT(10(1H ,A8))
  42 :       ENDIF
  43 :    2  CONTINUE                                                            
  44 :       IVAL=I                                                              
  45 :       RETURN                                                                                        
  46 :       END                                                                 
  47 :  
  48 :  
  49 :  
  50 :  
  51 :  

© Cast3M 2003 - All rights reserved.
Disclaimer