1 : C LECTUR SOURCE CHAT 05/01/13 01:14:30 5004 2 : C FABRIQUE UN OBJET DE TYPE LISTENTI (LISTE D'ENTIERS) 3 : C 4 : SUBROUTINE LECTUR 5 : C 6 : IMPLICIT INTEGER(I-N) 7 : -INC CCOPTIO 8 : -INC SMLENTI 9 : CHARACTER*4 MOTC(2),MOTF(2) 10 : DATA MOTC/'PAS ','* '/ 11 : DATA MOTF/'NPAS',' '/ 12 : C 13 : JG=0 14 : IP=0 15 : IBEGIN=0 16 : SEGINI MLENTI 17 : 999 CONTINUE 17 : CALL LIRENT(IPP,IBEGIN,IRETOU) 18 : IF(IRETOU.EQ.0) GO TO 30 19 : C 20 : C LECTURE D'UN ENTIER 21 : C 22 : 1 CONTINUE 23 : IP=IPP 24 : JG=LECT(/1)+1 25 : SEGADJ MLENTI 26 : LECT(JG)=IP 27 : GO TO 999 28 : C 29 : 30 CONTINUE 29 : CALL LIRMOT(MOTC,2,IRET,0) 30 : IF(IRET.EQ.0) GO TO 20 31 : IF (IRET.EQ.2) GOTO 50 32 : C 33 : C LECTURE DU MOT "PAS " 34 : C 34 : CALL LIRENT(IPAS,1,IRETOU) 35 : IF(IERR.NE.0) RETURN 35 : CALL LIRENT(IQ,0,IRETOU) 36 : IF(IRETOU.EQ.1)GOTO 10 36 : CALL LIRMOT(MOTF(1),1,INPA,1) 37 : C 38 : C LECTURE DE NPAS 39 : C 39 : CALL LIRENT(NP,1,IRETOU) 40 : IF(IERR.NE.0)RETURN 41 : NP=MAX(0,NP) 42 : KIP=IP 43 : KIPAS=IPAS 44 : JG0=JG 45 : JG=JG+NP 46 : SEGADJ MLENTI 47 : DO 11 IJ=1,NP 48 : LECT(JG0+IJ)=IJ*KIPAS+KIP 49 : 11 CONTINUE 50 : C 51 : C ON DOIT LIRE UN ENTIER OU RIEN 52 : C 52 : CALL LIRENT(IPP,0,IRETOU) 53 : IF(IRETOU.EQ.1) GOTO 1 54 : GOTO 20 55 : C 56 : C VOIR SI IQ EST SUIVI PAR "* " 57 : C 58 : 10 CONTINUE 58 : CALL LIRENT(IQ2,0,IRETX) 59 : IF (IRETX.EQ.1) GOTO 60 59 : CALL LIRMOT(MOTC(2),1,IRF,0) 60 : IF (IRF.EQ.0) GOTO 60 61 : NFOIS=IQ 61 : CALL LIRENT(IQ,1,IRETOU) 62 : IF (IERR.NE.0) RETURN 63 : 60 CONTINUE 64 : IA=IQ-IP 65 : IF(IA*IPAS) 6,7,8 66 : 6 CONTINUE 66 : CALL ERREUR(36) 67 : C IQ ET IP SONT DE SIGNE CONTRAIRE 68 : RETURN 69 : 7 CONTINUE 70 : IF(IPAS.NE.0) THEN 71 : if( ipas.eq.1) go to 99 71 : CALL ERREUR(21) 72 : C IQ ET IP SONT IDENTIQUES 73 : RETURN 74 : ENDIF 75 : 8 CONTINUE 76 : IF(IPAS.NE.0)IA=MOD(IA,IPAS) 77 : IF(IA.NE.0) THEN 77 : CALL ERREUR(21) 78 : C IQ-IP N EST PAS DIVISIBLE PAR IPAS 79 : RETURN 80 : ENDIF 81 : IF(IPAS.EQ.0)JQ=2 82 : IF(IPAS.NE.0)JQ=ABS((IQ-IP)/IPAS)+1 83 : JA=IP+IPAS 84 : JG1=LECT(/1)-1 85 : JG=JG1+JQ 86 : SEGADJ MLENTI 87 : DO 9 IA=2,JQ 88 : LECT(JG1+IA)=JA 89 : JA=JA+IPAS 90 : 9 CONTINUE 91 : 99 continue 92 : IPP=IQ2 93 : IP=IQ 94 : IF (IRF.EQ.1) GOTO 65 95 : IF (IRETX.EQ.1) GOTO 1 96 : GO TO 999 97 : 50 CONTINUE 98 : C 99 : C ON A LU "* " 100 : C 101 : IMAX=LECT(/1) 102 : NFOIS=LECT(IMAX) 102 : CALL LIRENT(IP,1,IRETOU) 103 : IF (IERR.NE.0) RETURN 104 : LECT(IMAX)=IP 105 : 65 CONTINUE 106 : IF (NFOIS.LE.0) GOTO 6 107 : NF=NFOIS-1 108 : IF (NF.EQ.0) GOTO 51 109 : JG1=LECT(/1) 110 : JG=JG1+NF 111 : SEGADJ MLENTI 112 : DO 52 I=1,NF 113 : LECT(JG1+I)=IP 114 : 52 CONTINUE 115 : 51 CONTINUE 116 : GOTO 999 117 : C 118 : 20 CONTINUE 118 : CALL ECROBJ('LISTENTI',MLENTI) 119 : SEGDES MLENTI 120 : RETURN 121 : END 122 : 123 : 124 :
© Cast3M 2003 - All rights reserved.
Disclaimer