Download lirmo3.eso

Back to the list

   1 : C LIRMO3    SOURCE    CHAT      06/06/01    21:17:53     5450           
   2 :       SUBROUTINE LIRMO3(MOTCLE,MOTDIM,IVAL,ICOND,ICOHCO)               
   3 : C     MOTCLE TABLEAU DES MOTS CLES POSSIBLES                           
   4 : C     MOTDIM DIMENSION DE MOTCLE                                       
   5 : C     IVAL   POSITION DU MOT TROUVE DANS MOTCLE (0) SI ECHEC           
   6 : C     ICOND  LECTURE IMPERATIVE OU NON
   7 :       IMPLICIT INTEGER(I-N)
   8 :       DIMENSION ICOHCO(*)                                          
   9 :       CHARACTER*(*) MOTCLE(*)                                          
  10 :       CHARACTER*72 MOT
  11 :       CHARACTER*8 ITOMO                                                
  12 : -INC CCOPTIO
  13 : -INC CCNOYAU
  14 : -INC CCASSIS 
  15 :         L=LEN(MOTCLE(1))
  16 : *        WRITE(6,FMT='('' lirmo3 ico(1) '',i5)') icohco(1)
  17 :         IF(ICOHCO(1).EQ.-1) THEN
  18 :          DO 5198 I=1,MOTDIM
  19 :          IA=0
  20 :          DO 5199 J=1,L
  21 :          IA = IA + ICHAR(MOTCLE(I)(J:J))
  22 :  5199    CONTINUE
  23 :          ICOHCO(I) = IA
  24 :  5198    CONTINUE   
  25 :       ENDIF                                                        
  26 :       IVAL=0
  27 :                                                                        
  28 : *                                                                      
  29 :       ICONDO=ICOND                                                                                                               
  30 : *
  31 :       DO 36 K=1,100000
  32 :       ITOMO ='MOT     '
  32 :       CALL LIRABJ(ITOMO,IRAT,ICONDO,IRETOU) 
  33 :       if(nbesc.ne.0) segact ipiloc                                 
  34 :       IF (IERR.NE.0) RETURN                                            
  35 : *                                                                      
  36 :       IF (IRETOU.EQ.0) GO TO 35
  37 :       JF=IPCHAR(IRAT+1)-1                                              
  38 :       ID=IPCHAR(IRAT)
  39 :       MOT= ICHARA(ID:JF)                                 
  40 : * 
  41 :       IA=0                                                             
  42 :       DO 65 I=1,L
  43 :       IA=IA + ICHAR(MOT(I:I))
  44 :   65  CONTINUE                                  
  45 : *                                                                      
  46 :       DO 1 I=1,MOTDIM 
  47 :       IF(IA.NE.ICOHCO(I)) GO TO 1                                      
  48 :       IF (MOT(1:L).EQ.MOTCLE(I)) GOTO 2                                
  49 :    1  CONTINUE
  49 :   35  CALL NOUTRU
  50 :       if(nbesc.ne.0) segdes ipiloc
  51 :   36  CONTINUE                                                   
  52 :    2  CONTINUE                                                         
  53 :       IVAL=I 
  54 :       RETURN                                                           
  55 :       END      
  56 :  
  57 :  
  58 :  

© Cast3M 2003 - All rights reserved.
Disclaimer