Télécharger argu.eso

Retour à la liste

Numérotation des lignes :

  1. C ARGU SOURCE GOUNAND 14/01/29 21:15:01 7923
  2. SUBROUTINE ARGU
  3. C
  4. C LECTURE (AUTANT QUE PASSIBLE) DE TRIPLET DE MOT
  5. C LE PREMIER EST LE NOM DE L'OBJET A LIRE
  6. C LE DEUXIEME EST LE CARACTERE: * POUR UNE LECTURE OBLIGATOIRE
  7. C OU : / POUR UNE LECTURE FACULTATIVE
  8. C LE TROISIEME EST LE TYPE DE L'OBJET ATTENDU
  9. C
  10. C (SEUL LE PREMIER EST OBLIGATOIRE)
  11. C
  12. C EXEMPLE : IJK * ENTIER
  13. IMPLICIT REAL*8 (A-H,O-Z)
  14. IMPLICIT INTEGER (I-N)
  15. -INC CCOPTIO
  16. -INC SMBLOC
  17. -INC CCNOYAU
  18. -INC CCASSIS
  19. CHARACTER*8 CHAINE,NOM,CHAANC
  20. * CHARACTER*72 CHAMOT
  21. CHARACTER*512 CHAMOT
  22. CHARACTER*1 MOTCLE(2)
  23. REAL*8 XRET
  24. LOGICAL LOGI
  25. DATA MOTCLE/'/','*'/
  26. C
  27. C APPEL A LIRCHA POUR CONNAITRE LE NOM DE L'OBJET( DANS LIRNOM ON A
  28. C PRIS SOIN DE D'IMPOSER LE TYPE MOT AUX DONNEES QUI SUIVAIENT LE MOT
  29. C "ARGU"
  30. C
  31. * pour autoriser les segsup sur les vieux segments
  32. call ooohor(0,0)
  33. 1 CONTINUE
  34. C DEBUT DE MODIF TC
  35. CALL QUETYP (CHAANC ,0,IRETOU)
  36. IF(IRETOU.EQ.0) RETURN
  37. IF(IERR.NE.0) RETURN
  38. IF(CHAANC.EQ.'ENTIER ') THEN
  39. CALL LIRENT ( II,1,IRETOU)
  40. ELSEIF(CHAANC.EQ.'FLOTTANT') THEN
  41. CALL LIRREE(XRET,1,IRETOU)
  42. ELSEIF(CHAANC.EQ.'MOT ') THEN
  43. CALL LIRCHA(NOM,1,IRETOU)
  44. ELSEIF(CHAANC.EQ.'LOGIQUE ') THEN
  45. CALL LIRLOG(LOGI,1,IRETOU)
  46. ELSE
  47. CALL LIROBJ(CHAANC,IRET,1,IRETOU)
  48. ENDIF
  49. CALL QUENOM ( NOM)
  50. * CALL LIRCHA (NOM,0,IRETOU)
  51. IF(IRETOU.EQ.0) RETURN
  52. CALL NOMOBJ('ANNULE ',NOM,IRETOU)
  53. CALL LIRMOT(MOTCLE,2,IR,0)
  54. IF (IERR.NE.0) RETURN
  55. IF (IR.GT.0) THEN
  56. ICODE=IR-1
  57. CALL LIRCHA(CHAINE,1,IRETOU)
  58. IF (IERR.NE.0) RETURN
  59. ELSE
  60. ICODE=0
  61. CHAINE=' '
  62. ENDIF
  63. MPROCI=MPROCD
  64. MBLO1=MBLOC
  65. IF(MPROCD.EQ.0) THEN
  66. C RECHERCHE DU SEGMENT MPROCE QUI DOIT ETRE REACTIVE
  67. MBLO1=MBLSUP
  68. 2 CONTINUE
  69. IF(MBLO1.EQ.0) THEN
  70. CALL ERREUR(5)
  71. RETURN
  72. ENDIF
  73. SEGACT MBLO1*MOD
  74. IF(MBLO1.MPROCD.NE.0) GO TO 3
  75. MMM= MBLO1.MBLSUP
  76. SEGDES MBLO1
  77. MBLO1=MMM
  78. GO TO 2
  79. 3 CONTINUE
  80. MPROCI=MBLO1.MPROCD
  81. SEGDES MBLO1
  82. ENDIF
  83. C APPEL A ARGU1 QUI FERA LA LECTURE
  84. CHAANC=CHAINE
  85. CALL ARGU1(CHAINE,IRET,ICODE,IRETOU,MPROCI)
  86. SEGACT MBLO1*MOD
  87. MBLO1.MPROCD=MPROCI
  88. IF(MBLO1.NE.MBLOC) SEGDES MBLO1
  89. IF(IERR.NE.0) RETURN
  90. IF(IRETOU.NE.0) THEN
  91. if(nbesc.ne.0) segact ipiloc
  92. IF(CHAINE.EQ.'ENTIER ') THEN
  93. IF (CHAANC.EQ.'FLOTTANT') THEN
  94. XRET=IRET
  95. CALL NOMREE(NOM,XRET)
  96. ELSE
  97. IVAL=IRET
  98. CALL NOMENT(NOM,IVAL)
  99. ENDIF
  100. ELSEIF(CHAINE.EQ.'FLOTTANT')THEN
  101. XRET=XIFLOT(IRET)
  102. CALL NOMREE(NOM,XRET)
  103. ELSEIF(CHAINE.EQ.'LOGIQUE ')THEN
  104. LOGI=IPLOGI(IRET)
  105. CALL NOMLOG(NOM,LOGI)
  106. ELSEIF(CHAINE.EQ.'MOT ')THEN
  107. JF=IPCHAR(IRET+1)
  108. ID=IPCHAR(IRET)
  109. *sg Avant, il y avait : ILO=JF-ID => pas de garde-fou, écrasement possible
  110. ILO=MIN(JF-ID,LEN(CHAMOT))
  111. CHAMOT(1:ILO)=ICHARA(ID:ID+ILO-1)
  112. CALL NOMCHA(NOM,CHAMOT(1:ILO))
  113. ELSE
  114. CALL NOMOBJ(CHAINE,NOM,IRET)
  115. ENDIF
  116. if(nbesc.ne.0) segdes ipiloc
  117. ENDIF
  118. GO TO 1
  119. END
  120.  
  121.  
  122.  
  123.  

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