Télécharger la plaquette Cast3M


fr en

Télécharger redlec.eso

Retour à la liste

Numérotation des lignes : 

redlec

  1. C REDLEC    SOURCE    JC220346  18/12/04    21:16:08     9991           
  2. C  LECTURE DE DONNEES EN FORMAT LIBRE
  3. C
  4.       SUBROUTINE REDLEC(SREDLE)
  5. C
  6. C  LECTURE DE DONNEES EN FORMAT LIBRE
  7. C  LES RESULTATS SONT DANS LE COMMON /COPTIO/
  8. C  LE TYPE DE LA DONNEE EFFECTIVEMENT LUE EST IRE
  9. C  IRE=1 : ENTIER  IRE=2 : FLOTTANT  IRE=3 : MOT  IRE=4 : TEXTE
  10. C  IRE=5 : LOGIQUE  IRE=0 : FIN DE DIRECTIVE
  11. C
  12. C  - ENTIER NFIX AU PLUS NEUF CHIFFRES SIGNIFICATIFS
  13. C  - FLOTTANT AU PLUS SEIZE CHIFFRES SIGNIFICATIFS
  14. C  - MOT OU TEXTE AU PLUS SOIXANTE-DOUZE CARACTERES
  15. C  - LE NOMBRE DE CARACTERE DU MOT OU DU TEXTE EST NCAR
  16. C  - LES SEPARATEURS (QUI SONT TRANSMIS COMME DES MOTS) SONT :
  17. C    ' ','=','+','-','*','/','%'
  18. C     LE POINT '.' DANS UN MOT EST PRIS COMME SEPARATEUR IL EST MEME
  19. C     RENVOYE COMMME TYPE SEPARATEUR IRE = 6
  20. C
  21. C
  22.       IMPLICIT INTEGER(I-N)
  23.  
  24. -INC PPARAM
  25. -INC CCREDLE
  26. -INC CCNOYAU
  27.  
  28. *     SAVE          SEPARA,EPSI,CARAC
  29. *     LOGICAL       SEPARA
  30.       CHARACTER*25  CARAC
  31.       CHARACTER*117 CAROK
  32.       REAL*8        DP
  33. C                            1111111111222
  34. C                  1 234567890123456789012
  35.       DATA CARAC /' ''+-/*=.0123456789DEQdeq%'/
  36.       DATA CAROK/'1234567890°+&é(-è_çà)=~#{[|`\\^@]}¤?azertyuiop^$qsdfgh
  37.      >jklmù*wxcvbn,;:!AZERTYUIOPQSDFGHJKLM%µWXCVBN?.§<>äëÿüïöâêûîô£''/'/
  38. C
  39.  
  40. *     ith=0
  41. *     call ooonth(ith)
  42. *     write (6,*) ' thread ',ith, 'redlec pointeur ',sredle
  43.       MOT(1:LONOM)=' '
  44.    5  NRAN=NRAN+1
  45.       IF (NRAN.GT.ICOUR) GOTO 2
  46.       INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  47.       IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  48.       INDIN=23
  49.       IND=INDEX(CARAC,TEXT(NRAN:NRAN))
  50. *  SI SEPARA EST VRAI ON CONSIDERE + ET -  ET . COMME DES MOTS
  51.        IF (SEPARA.AND.(IND.EQ.3.OR.IND.EQ.4.OR.IND.EQ.8)) THEN
  52.            INDIN=IND
  53.            GOTO 60
  54.        ENDIF
  55.        SEPARA=.FALSE.
  56.       IF (IND.EQ.0) GOTO 60
  57.       IF (IND.EQ.1) GOTO 5
  58.       INDIN=IND
  59.       IF(IND.EQ.2) GOTO 60
  60.       IF(IND.GT.18) GOTO 60
  61.       IF (IND.GE.5.AND.IND.LE.7) GOTO 60
  62. C
  63. C     ON A LU UN NOMBRE
  64. C
  65.       IRE=1
  66.       IDE=NRAN
  67.       NFIX=0
  68.       ISGN=0
  69.       IDEC=-1
  70.       IEXP=0
  71.       KSGN=1
  72.       IF (IND.EQ.4) KSGN=-1
  73.       IF (IND.NE.3.AND.IND.NE.4) GOTO 25
  74.   22  NRAN=NRAN+1
  75.       IF(NRAN.GT.ICOUR) GOTO 30
  76.       INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  77.       IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  78.       IND=INDEX(CARAC,TEXT(NRAN:NRAN))
  79.       IF (IND.NE.0) GOTO 25
  80.    24 CONTINUE
  81.       NRAN=IDE
  82.       IND=INDIN
  83.       GOTO 60
  84.   25  IF(IND.LT.9.OR.IND.GT.18) GOTO 28
  85.       ISGN=ISGN+1
  86.       IF(IDEC.GE.0) IDEC=IDEC+1
  87.       IF(ISGN-10) 26,252,255
  88.   252 MFIX=NFIX
  89.       NFIX=0
  90.       GOTO 26
  91.   255 IF(ISGN.LT.19) GOTO 26
  92.       IF(IDEC.LT.0) IEXP=IEXP+1
  93.       IF(IDEC.GE.0) IDEC=IDEC-1
  94.       GOTO 22
  95.   26  NFIX=10*NFIX+IND-9
  96.       GOTO 22
  97.   28  IF(IND.EQ.1) GOTO 30
  98.       IF (IND.EQ.8) GOTO 29
  99.       IF(IND.LE.7.AND.IND.GE.3) GOTO 300
  100.       IF(IND.GT.18) GOTO 40
  101.       GOTO 24
  102.   29  IF (IDEC.GE.0) GOTO 24
  103.       IDEC=0
  104.       GOTO 22
  105.  300  IF (IDEC.LT.0) NRAN=NRAN-1
  106.       SEPARA=.TRUE.
  107.   30  IF (ISGN.EQ.0) GOTO 24
  108.       IF (IDEC.GE.0) GOTO 40
  109. C
  110. C     ON A LU UN ENTIER
  111. C
  112.       NCAR=NRAN-IDE
  113.       IRE=1
  114.       IF(ISGN.GT.9) GOTO 40
  115.       IF(KSGN.LT.0) NFIX=-NFIX
  116.       FLOT=NFIX
  117.       RETURN
  118. C
  119. C     ON A LU UN FLOTTANT
  120. C
  121.   40  IRE=2
  122.       FLOT=NFIX
  123.       IF(ISGN.LT.10) GOTO 41
  124.       DP=MFIX
  125.       IF(ISGN.GT.18) ISGN=18
  126.       FLOT=FLOT+DP*1D1**(ISGN-9)
  127.   41  IF(IDEC.LT.0) IDEC=0
  128.       IEXP=IEXP-IDEC
  129.       IF(IND.EQ.1) GOTO 55
  130.       IF (IND.LE.7.AND.IND.GE.3) GOTO 550
  131.       ISGN=1
  132.       NFIX=0
  133.       NRAN=NRAN+1
  134.       IF (NRAN.GT.ICOUR) GOTO 53
  135.       IND=INDEX(CARAC(3:4),TEXT(NRAN:NRAN))+2
  136.       IF (IND.EQ.2) GOTO 305
  137.       IF (IND.EQ.4) ISGN=-1
  138.   42  NRAN=NRAN+1
  139.       IF(NRAN.GT.ICOUR) GOTO 53
  140.  305  CONTINUE
  141.       INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  142.       IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  143.       IND=INDEX(CARAC,TEXT(NRAN:NRAN))
  144.       IF (IND.EQ.0) GOTO 24
  145.       IF(IND.EQ.1) GOTO 52
  146.       IF (IND.LE.7.AND.IND.GE.3) GOTO 520
  147.       IF(IND.LT.9.OR.IND.GT.18) GOTO 24
  148.       NFIX=10*NFIX+IND-9
  149.       GOTO 42
  150.   52  NRAN1=NRAN-1
  151.        IF (INDEX(CARAC(19:24),TEXT(NRAN1:NRAN1)).NE.0) GOTO 42
  152.       GOTO 521
  153.  520  NRAN=NRAN-1
  154.        SEPARA=.TRUE.
  155.  521  CONTINUE
  156.   53  IF(ISGN.LT.0) NFIX=-NFIX
  157.       IEXP=IEXP+NFIX
  158.       GOTO 55
  159.  550  NRAN=NRAN-1
  160.       SEPARA=.TRUE.
  161.   55  FLOT=FLOT*1D1**IEXP
  162.       IF(KSGN.LT.0) FLOT=-FLOT
  163.       NCAR=NRAN-IDE
  164.       RETURN
  165. C
  166. C     ON A LU UN MOT OU UN TEXT
  167. C
  168.   60  MOT=' '
  169.       IF (IND.EQ.2) GOTO 70
  170. C
  171. C     ON A LU UN MOT
  172. C
  173.       IRE=3
  174.       IDEB=NRAN
  175.       IF ((INDIN.LT.3.OR.INDIN.GT.8).AND.INDIN.NE.25) GOTO 66
  176.       NRAN=NRAN+1
  177.       IF (INDIN.NE.6) GOTO 68
  178.       IF (NRAN.GT.ICOUR) GOTO 68
  179.       IF (TEXT(NRAN:NRAN).NE.CARAC(6:6)) GOTO 68
  180.       NRAN=NRAN+1
  181.       GOTO 68
  182.   66  NRAN=NRAN+1
  183.       IF(NRAN.GT.ICOUR) GOTO 68
  184.       INDC=INDEX(CAROK,TEXT(NRAN:NRAN))
  185.       IF (INDC.EQ.0) TEXT(NRAN:NRAN)=' '
  186.       INDAUX=INDEX(CARAC,TEXT(NRAN:NRAN))
  187.       IF (INDAUX.EQ.1.OR.INDAUX.EQ.2) GOTO 68
  188.       IF  ((INDAUX.LT.3.OR.INDAUX.GT.8).AND.INDAUX.NE.25)  GOTO 66
  189.       SEPARA=.TRUE.
  190.       IFIN=NRAN-1
  191.       GO TO  680
  192.   68  IFIN=NRAN-1
  193.       SEPARA=.FALSE.
  194.   680 CONTINUE
  195.       NCAR=IFIN-IDEB+1
  196.       NCAR=MIN(LOCHAI,NCAR)
  197.       MOT(1:NCAR)=TEXT(IDEB:IFIN)
  198.       NRAN=NRAN-1
  199.       IF(MOT(1:1).EQ.'.') IRE=6
  200.       IF(MOT(1:1).EQ.'%') IRE=7
  201. C
  202. C     CE MOT EST-IL 'VRAI' OU 'FAUX' AUQUEL CAS ON A LU UN LOGIQUE
  203. C
  204.       IF (MOT(1:5).EQ.'VRAI ') THEN
  205.       BOOL=.TRUE.
  206.       IRE=5
  207.       ELSEIF (MOT(1:5).EQ.'FAUX ') THEN
  208.       BOOL=.FALSE.
  209.       IRE=5
  210.       ENDIF
  211.       RETURN
  212.   70  IRE=4
  213.       NRAN=NRAN+1
  214.       IDEB=NRAN
  215.       icar=1
  216.       jcar=ideb
  217.   71  NRAN=NRAN+1
  218.       IF (NRAN.GT.ICOUR) GOTO 72
  219.       IF (TEXT(NRAN:NRAN).EQ.CARAC(2:2)) then
  220.        if (nran+1.gt.icour) goto 72
  221.        if (text(nran+1:nran+1).ne.carac(2:2)) goto 72
  222. *  double quote ==> une seule dans le texte rendu
  223.        nran=nran+1
  224.        ifin=nran-1
  225.        ncar=icar+ifin-jcar
  226.        mot(icar:ncar)=text(jcar:ifin)
  227.        icar=ncar+1
  228.        jcar=ifin+2
  229.        goto 71
  230.       endif
  231.       GOTO 71
  232.   72  IFIN=NRAN-1
  233.       NCAR=IFIN-IDEB+1
  234.       NCAR=MIN(LOCHAI,NCAR)
  235.       MOT(icar:NCAR)=TEXT(jcar:IFIN)
  236.       RETURN
  237.    2  IRE=0
  238.       END
  239.  

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