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