1 : C SI SOURCE CHAT 11/04/13 21:15:01 6941 2 : C INSTRUCTION SI 3 : C 4 : SUBROUTINE SI 5 : IMPLICIT INTEGER(I-N) 6 : -INC CCOPTIO 7 : -INC CCNOYAU 8 : -INC SMBLOC 9 : -INC CCREDLE 10 : * 11 : character*40 chauer 12 : LOGICAL LOG 13 : CHARACTER*8 IJCH 14 : CHARACTER*4 MCLE(7) 15 : DIMENSION IMOTCO(7) 16 : SAVE IMOTCO 17 : DATA IMOTCO(1)/-1/ 18 : DATA MCLE /'SI ','SINO','FINS','REPE','FIN ','FINP','FINM'/ 18 : CALL LIRLOG(LOG,1,IRETOU) 19 : IF (IERR.NE.0) RETURN 20 : IPSI=0 21 : IREPET=0 22 : ilupoy=0 23 : IF (LOG) RETURN 24 : 1 CONTINUE 24 : CALL NOUTRU 25 : if(ilupoy.eq.0) then 26 : lectab=1 26 : call quetyp (ijch, 1,iretou) 27 : sredle=iredle 28 : chauer = text(1:40) 29 : endif 30 : C POUR NE PAS ETRE PAR LA RECHERCHE DE L'INDICE DES TABLES 31 : LECTAB=1 31 : CALL LIRMO3(MCLE,7,IRET,0,IMOTCO) 32 : ilupoy=ilupoy+1 33 : IF (IERR.NE.0) RETURN 34 : GOTO (10,20,30,40,50,60,60),IRET 35 : 10 CONTINUE 36 : IPSI=IPSI+1 37 : GOTO 1 38 : 20 CONTINUE 39 : LECTAB=0 40 : IF (IPSI.EQ.0) THEN 41 : IF(IREPET.NE.0) THEN 42 : moterr(1:40)=chauer 42 : CALL ERREUR(520) 43 : ENDIF 44 : RETURN 45 : ENDIF 46 : GOTO 1 47 : 30 CONTINUE 48 : LECTAB=0 49 : IF (IPSI.EQ.0) THEN 50 : IF(IREPET.NE.0) THEN 51 : moterr(1:40)=chauer 51 : CALL ERREUR(520) 52 : ENDIF 53 : RETURN 54 : ENDIF 55 : IF (IPSI.EQ.0) RETURN 56 : IPSI=IPSI-1 57 : GOTO 1 58 : 40 CONTINUE 58 : CALL REPETE 59 : C NE LIRE QU'UNE FOIS LA BOUCLE 60 : MBCONT=1 61 : IREPET=IREPET+1 62 : GOTO 1 63 : 50 CONTINUE 63 : CALL QUETYP( IJCH, 0, IRETOU) 64 : IF( IRETOU.EQ.0) GO TO 1 65 : IF(IREPET.EQ.0) THEN 66 : MBCOUR = MBCOUR -1 67 : moterr(1:40)=chauer 67 : CALL ERREUR(520) 68 : RETURN 69 : ENDIF 69 : CALL FIN 70 : IREPET=IREPET-1 71 : GOTO 1 72 : 60 CONTINUE 73 : MBCOUR = MBCOUR - 1 74 : moterr(1:40)=chauer 74 : CALL ERREUR(521) 75 : RETURN 76 : END 77 : 78 : 79 : 80 : 81 : 82 : 83 : 84 : 85 : 86 :
© Cast3M 2003 - All rights reserved.
Disclaimer