1 : C SINON SOURCE CHAT 11/04/13 21:15:07 6941 2 : C INSTRUCTION SINON 3 : C 4 : SUBROUTINE SINON 5 : IMPLICIT INTEGER(I-N) 6 : -INC CCOPTIO 7 : -INC CCNOYAU 8 : -INC SMBLOC 9 : -INC CCREDLE 10 : character*40 chauer 11 : CHARACTER*8 IJCH 12 : CHARACTER*4 MCLE(7),ICHG 13 : DIMENSION IMOTCO(7) 14 : SAVE IMOTCO 15 : DATA MCLE/'SI ','SINO','FINS','REPE','FIN ','FINP','FINM'/ 16 : DATA IMOTCO(1)/-1/ 17 : * TC on met en commentaire la suite car pas possible 18 : * de tester l'imbrication des bloc et des si ( les cartes des 19 : * procedurzes sont deja lues mais pas execute 20 : C IF(MBFONC.EQ.0) THEN 21 : C NOMLU=0 22 : C MTXBLC=MTXBL 23 : C NN=NINSTV 24 : C IIPS=1 25 : C IREPET=0 26 : C 106 CONTINUE 27 : C MBCOUR=MBCOUR+1 28 : C IF(MBCOUR.GT.NN) THEN 28 : C CALL ERREUR(520) 29 : C MBCOUR=MBCOUR-1 30 : C RETURN 31 : C ENDIF 32 : C IDEF= MTXBA(MBCOUR) 33 : C IPLAC=MTXBLA(IDEF+1) 34 : C IF(INOOB2(IPLAC).NE.'MOT ') GO TO 106 35 : C IP=IOUEP2(IPLAC) 36 : C IDEBCH=IPCHAR(IP) 37 : C IFINCH=IPCHAR(IP+1)-1 38 : C ICHG=ICHARA(IDEBCH:IFINCH) 39 : C IF(ICHG.EQ.'FINS') THEN 40 : C IIPS=IIPS-1 41 : C ELSEIF(ICHG.EQ.'SI ') THEN 42 : C IIPS=IIPS+1 43 : C ELSEIF(ICHG.EQ.'FINP'.OR.ICHG.EQ.'FINM') THEN 44 : CC MBCOUR=MBCOUR-1 44 : C CALL ERREUR (521) 45 : C RETURN 46 : C ENDIF 47 : C IF(IIPS.EQ.0) RETURN 48 : C GO TO 106 49 : C ENDIF 50 : IPSI=0 51 : IREPET=0 52 : ilupoy=0 53 : 1 CONTINUE 53 : CALL NOUTRU 54 : if(ilupoy.eq.0) then 55 : lectab=1 55 : call quetyp (ijch, 1,iretou) 56 : sredle=iredle 57 : chauer = ' ' 58 : chauer = text(1:40) 59 : endif 60 : * POUR NE PAS ETRE GENE PAR LA RECHERCHE DE L'INDICE DE LA TABLE 61 : LECTAB=1 61 : CALL LIRMO3(MCLE,7,IR,0,IMOTCO) 62 : ilupoy=ilupoy+1 63 : IF (IERR.NE.0) RETURN 64 : GOTO (10,20,30,40,50,60,60),IR 65 : 10 CONTINUE 66 : IPSI=IPSI+1 67 : GOTO 1 68 : 20 CONTINUE 69 : GOTO 1 70 : 30 CONTINUE 71 : IF (IPSI.EQ.0) THEN 72 : IF(IREPET.NE.0) THEN 73 : moterr(1:40)=chauer 73 : CALL ERREUR(520) 74 : ENDIF 75 : RETURN 76 : ENDIF 77 : IPSI=IPSI-1 78 : GOTO 1 79 : 40 CONTINUE 79 : CALL REPETE 80 : C NE FAIRE QU'UNE SEULE FOIS LA BOUCLE 81 : IREPET=IREPET + 1 82 : MBCONT=1 83 : GOTO 1 84 : 50 CONTINUE 84 : CALL QUETYP( IJCH, 0, IRETOU) 85 : IF( IRETOU.EQ.0) GO TO 1 86 : IF(IREPET.EQ.0) THEN 87 : MBCOUR = MBCOUR - 1 88 : moterr(1:40)=chauer 88 : CALL ERREUR (520) 89 : RETURN 90 : ENDIF 90 : CALL FIN 91 : IREPET=IREPET -1 92 : GOTO 1 93 : 60 CONTINUE 94 : MBCOUR = MBCOUR - 1 95 : moterr(1:40)=chauer 95 : CALL ERREUR (521) 96 : RETURN 97 : END 98 : 99 : 100 :
© Cast3M 2003 - All rights reserved.
Disclaimer