Numérotation des lignes :

C LECTUR    SOURCE    CHAT      05/01/13    01:14:30     5004C     FABRIQUE UN OBJET DE TYPE LISTENTI (LISTE D'ENTIERS)C      SUBROUTINE LECTURC      IMPLICIT INTEGER(I-N) -INC PPARAM-INC CCOPTIO-INC SMLENTI      CHARACTER*4 MOTC(2),MOTF(2)      DATA MOTC/'PAS ','*   '/      DATA MOTF/'NPAS','    '/C      JG=0      IP=0      IBEGIN=0      SEGINI MLENTI 999  CONTINUE      CALL LIRENT(IPP,IBEGIN,IRETOU)      IF(IRETOU.EQ.0) GO TO 30CC     LECTURE D'UN ENTIERC 1    CONTINUE      IP=IPP      JG=LECT(/1)+1      SEGADJ MLENTI      LECT(JG)=IP      GO TO 999C 30   CONTINUE      CALL LIRMOT(MOTC,2,IRET,0)      IF(IRET.EQ.0) GO TO 20      IF (IRET.EQ.2) GOTO 50CC     LECTURE DU MOT "PAS "C      CALL LIRENT(IPAS,1,IRETOU)      IF(IERR.NE.0) RETURN      CALL LIRENT(IQ,0,IRETOU)      IF(IRETOU.EQ.1)GOTO 10      CALL LIRMOT(MOTF(1),1,INPA,1)CC     LECTURE DE NPASC      CALL LIRENT(NP,1,IRETOU)      IF(IERR.NE.0)RETURN      NP=MAX(0,NP)      KIP=IP      KIPAS=IPAS      JG0=JG      JG=JG+NP      SEGADJ MLENTI      DO 11 IJ=1,NP        LECT(JG0+IJ)=IJ*KIPAS+KIP 11   CONTINUECC ON DOIT LIRE UN ENTIER OU RIENC      CALL LIRENT(IPP,0,IRETOU)      IF(IRETOU.EQ.1) GOTO 1      GOTO 20CC  VOIR SI IQ EST SUIVI PAR "*   "C  10  CONTINUE      CALL LIRENT(IQ2,0,IRETX)      IF (IRETX.EQ.1) GOTO 60      CALL LIRMOT(MOTC(2),1,IRF,0)      IF (IRF.EQ.0) GOTO 60      NFOIS=IQ      CALL LIRENT(IQ,1,IRETOU)      IF (IERR.NE.0) RETURN  60  CONTINUE      IA=IQ-IP      IF(IA*IPAS) 6,7,8   6  CONTINUE      CALL ERREUR(36)C     IQ ET IP SONT DE SIGNE CONTRAIRE      RETURN   7  CONTINUE      IF(IPAS.NE.0) THEN         if( ipas.eq.1) go to 99        CALL ERREUR(21)C       IQ ET IP SONT IDENTIQUES        RETURN      ENDIF   8  CONTINUE      IF(IPAS.NE.0)IA=MOD(IA,IPAS)      IF(IA.NE.0) THEN        CALL ERREUR(21)C       IQ-IP N EST PAS DIVISIBLE PAR IPAS        RETURN      ENDIF      IF(IPAS.EQ.0)JQ=2      IF(IPAS.NE.0)JQ=ABS((IQ-IP)/IPAS)+1      JA=IP+IPAS      JG1=LECT(/1)-1      JG=JG1+JQ      SEGADJ MLENTI      DO 9 IA=2,JQ        LECT(JG1+IA)=JA        JA=JA+IPAS   9  CONTINUE  99  continue      IPP=IQ2      IP=IQ      IF (IRF.EQ.1) GOTO 65      IF (IRETX.EQ.1) GOTO 1      GO TO 999  50  CONTINUECC   ON A LU "*   "C      IMAX=LECT(/1)      NFOIS=LECT(IMAX)      CALL LIRENT(IP,1,IRETOU)      IF (IERR.NE.0) RETURN      LECT(IMAX)=IP  65  CONTINUE      IF (NFOIS.LE.0) GOTO 6      NF=NFOIS-1      IF (NF.EQ.0) GOTO 51      JG1=LECT(/1)      JG=JG1+NF      SEGADJ MLENTI      DO 52 I=1,NF        LECT(JG1+I)=IP  52  CONTINUE  51  CONTINUE      GOTO 999C  20  CONTINUE      CALL ECROBJ('LISTENTI',MLENTI)      SEGDES MLENTI      RETURN      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales