1 : C ARGU SOURCE GOUNAND 14/01/29 21:15:01 7923 2 : SUBROUTINE ARGU 3 : C 4 : C LECTURE (AUTANT QUE PASSIBLE) DE TRIPLET DE MOT 5 : C LE PREMIER EST LE NOM DE L'OBJET A LIRE 6 : C LE DEUXIEME EST LE CARACTERE: * POUR UNE LECTURE OBLIGATOIRE 7 : C OU : / POUR UNE LECTURE FACULTATIVE 8 : C LE TROISIEME EST LE TYPE DE L'OBJET ATTENDU 9 : C 10 : C (SEUL LE PREMIER EST OBLIGATOIRE) 11 : C 12 : C EXEMPLE : IJK * ENTIER 13 : IMPLICIT REAL*8 (A-H,O-Z) 14 : IMPLICIT INTEGER (I-N) 15 : -INC CCOPTIO 16 : -INC SMBLOC 17 : -INC CCNOYAU 18 : -INC CCASSIS 19 : CHARACTER*8 CHAINE,NOM,CHAANC 20 : * CHARACTER*72 CHAMOT 21 : CHARACTER*512 CHAMOT 22 : CHARACTER*1 MOTCLE(2) 23 : REAL*8 XRET 24 : LOGICAL LOGI 25 : DATA MOTCLE/'/','*'/ 26 : C 27 : C APPEL A LIRCHA POUR CONNAITRE LE NOM DE L'OBJET( DANS LIRNOM ON A 28 : C PRIS SOIN DE D'IMPOSER LE TYPE MOT AUX DONNEES QUI SUIVAIENT LE MOT 29 : C "ARGU" 30 : C 31 : * pour autoriser les segsup sur les vieux segments 31 : call ooohor(0,0) 32 : 1 CONTINUE 33 : C DEBUT DE MODIF TC 33 : CALL QUETYP (CHAANC ,0,IRETOU) 34 : IF(IRETOU.EQ.0) RETURN 35 : IF(IERR.NE.0) RETURN 36 : IF(CHAANC.EQ.'ENTIER ') THEN 36 : CALL LIRENT ( II,1,IRETOU) 37 : ELSEIF(CHAANC.EQ.'FLOTTANT') THEN 37 : CALL LIRREE(XRET,1,IRETOU) 38 : ELSEIF(CHAANC.EQ.'MOT ') THEN 38 : CALL LIRCHA(NOM,1,IRETOU) 39 : ELSEIF(CHAANC.EQ.'LOGIQUE ') THEN 39 : CALL LIRLOG(LOGI,1,IRETOU) 40 : ELSE 40 : CALL LIROBJ(CHAANC,IRET,1,IRETOU) 41 : ENDIF 41 : CALL QUENOM ( NOM) 41 : * CALL LIRCHA (NOM,0,IRETOU) 42 : IF(IRETOU.EQ.0) RETURN 42 : CALL NOMOBJ('ANNULE ',NOM,IRETOU) 42 : CALL LIRMOT(MOTCLE,2,IR,0) 43 : IF (IERR.NE.0) RETURN 44 : IF (IR.GT.0) THEN 45 : ICODE=IR-1 45 : CALL LIRCHA(CHAINE,1,IRETOU) 46 : IF (IERR.NE.0) RETURN 47 : ELSE 48 : ICODE=0 49 : CHAINE=' ' 50 : ENDIF 51 : MPROCI=MPROCD 52 : MBLO1=MBLOC 53 : IF(MPROCD.EQ.0) THEN 54 : C RECHERCHE DU SEGMENT MPROCE QUI DOIT ETRE REACTIVE 55 : MBLO1=MBLSUP 56 : 2 CONTINUE 57 : IF(MBLO1.EQ.0) THEN 57 : CALL ERREUR(5) 58 : RETURN 59 : ENDIF 60 : SEGACT MBLO1*MOD 61 : IF(MBLO1.MPROCD.NE.0) GO TO 3 62 : MMM= MBLO1.MBLSUP 63 : SEGDES MBLO1 64 : MBLO1=MMM 65 : GO TO 2 66 : 3 CONTINUE 67 : MPROCI=MBLO1.MPROCD 68 : SEGDES MBLO1 69 : ENDIF 70 : C APPEL A ARGU1 QUI FERA LA LECTURE 71 : CHAANC=CHAINE 71 : CALL ARGU1(CHAINE,IRET,ICODE,IRETOU,MPROCI) 72 : SEGACT MBLO1*MOD 73 : MBLO1.MPROCD=MPROCI 74 : IF(MBLO1.NE.MBLOC) SEGDES MBLO1 75 : IF(IERR.NE.0) RETURN 76 : IF(IRETOU.NE.0) THEN 77 : if(nbesc.ne.0) segact ipiloc 78 : IF(CHAINE.EQ.'ENTIER ') THEN 79 : IF (CHAANC.EQ.'FLOTTANT') THEN 80 : XRET=IRET 80 : CALL NOMREE(NOM,XRET) 81 : ELSE 82 : IVAL=IRET 82 : CALL NOMENT(NOM,IVAL) 83 : ENDIF 84 : ELSEIF(CHAINE.EQ.'FLOTTANT')THEN 85 : XRET=XIFLOT(IRET) 85 : CALL NOMREE(NOM,XRET) 86 : ELSEIF(CHAINE.EQ.'LOGIQUE ')THEN 87 : LOGI=IPLOGI(IRET) 87 : CALL NOMLOG(NOM,LOGI) 88 : ELSEIF(CHAINE.EQ.'MOT ')THEN 89 : JF=IPCHAR(IRET+1) 90 : ID=IPCHAR(IRET) 91 : *sg Avant, il y avait : ILO=JF-ID => pas de garde-fou, écrasement possible 92 : ILO=MIN(JF-ID,LEN(CHAMOT)) 93 : CHAMOT(1:ILO)=ICHARA(ID:ID+ILO-1) 93 : CALL NOMCHA(NOM,CHAMOT(1:ILO)) 94 : ELSE 94 : CALL NOMOBJ(CHAINE,NOM,IRET) 95 : ENDIF 96 : if(nbesc.ne.0) segdes ipiloc 97 : ENDIF 98 : GO TO 1 99 : END 100 : 101 : 102 :
© Cast3M 2003 - All rights reserved.
Disclaimer