Télécharger argu.eso

Retour à la liste

Numérotation des lignes :

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

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