Télécharger argu.eso

Retour à la liste

Numérotation des lignes :

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

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