Télécharger la plaquette Cast3M


fr en

Télécharger lectur.eso

Retour à la liste

Numérotation des lignes : 

lectur

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

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