Download lircha.eso

Back to the list

   1 : C LIRCHA    SOURCE    PV        11/04/08    21:16:08     6934           
   2 :       SUBROUTINE LIRCHA(ITYP , ICODE , IRETOU )                          
   3 : C                                                                        
   4 : C   EN RETOUR IRETOU EST NUL SI PAS DE MOT TROUVE SINON C'EST LA LONGUEU 
   5 : C   DU MOT                                                               
   6 : C                                                                        
   7 :       IMPLICIT INTEGER(I-N)
   8 : -INC CCNOYAU                                                             
   9 : -INC CCOPTIO                                                             
  10 : -INC CCASSIS
  11 :       external long
  12 :       CHARACTER*(*) ITYP                                                 
  13 :       CHARACTER*(8)  ICHA                                                
  14 :       ICHA='MOT'                                                         
  14 :       CALL LIRABJ(ICHA,IRAT,ICODE,IRETOU)                                
  15 :       IF(IERR.NE.0) RETURN                                               
  16 :       IF(IRETOU.EQ.0) RETURN 
  17 : *  initialisation de lotesc
  18 :       lotesc=.false.
  19 :       ith=0
  19 :       if (nbesc.ne.0) call ooonth(ith)
  20 :       if (ith.ne.0) lotesc=.true.
  21 : *     write (6,*) ' dans lircha ',ith
  22 :        if (.not. lotesc) then
  23 :           if(nbesc.ne.0) segact ipiloc
  24 :           IL=LEN(ITYP)                                                   
  25 :           JF=IPCHAR(IRAT+1)                                              
  26 :           ID=IPCHAR(IRAT)                                       
  27 :           ILO=MIN(IL,JF-ID)                                              
  28 :           ITYP=ICHARA(ID:JF-1)                                           
  29 :           IRETOU=ILO 
  30 :           if(nbesc.ne.0) segdes ipiloc                                   
  31 :        else
  32 :           mescla=imescl(ith)
  33 :           ityp=esopch(irat)
  34 :           iretou=long(ityp)
  35 :        endif
  36 :       RETURN                                                             
  37 :       END
  38 :  
  39 :  
  40 :  
  41 :  

© Cast3M 2003 - All rights reserved.
Disclaimer