Télécharger ecctab.eso

Retour à la liste

Numérotation des lignes :

  1. C ECCTAB SOURCE CHAT 06/03/16 21:17:04 5336
  2. SUBROUTINE ECCTAB(MTABLE,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  3. $ TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  4. C
  5. C **** MET UN OBJET DANS UNE TABLE
  6. C **** TAPIND TYPE DE L'INDICE CHARACTER*(*)
  7. C **** PUIS LA VALEUR DE L'INDICE IVALIN SI ENTIER
  8. C **** XVALIN SI FLOTTANT
  9. C **** CHARIN SI MOT
  10. C **** LOGIN SI LOGIQUE
  11. C **** IOBIN POUR TOUT AUTRE TYPE
  12. C **** TAPOBJ TYPE DE L'OBJET CHARACTER*(*)
  13. C **** PUIS LA VALEUR DE L'INDICE IVALRE SI ENTIER
  14. C **** XVALRE SI FLOTTANT
  15. C **** CHARRE SI MOT
  16. C **** LOGRE SI LOGIQUE
  17. C **** IOBRE POUR TOUT AUTRE TYPE
  18. C ****
  19. C
  20. C
  21. IMPLICIT INTEGER(I-N)
  22. -INC CCNOYAU
  23. -INC SMTABLE
  24. -INC CCOPTIO
  25. -INC CCASSIS
  26. external long
  27. REAL*8 XVALIN,XVALRE
  28. LOGICAL LOGRE,LOGIN
  29. CHARACTER*(*) TAPIND,TAPOBJ,CHARIN,CHARRE
  30. CHARACTER*(8) CHARA,TYPIND,TYPOBJ
  31. if(nbesc.ne.0) segact ipiloc
  32. TYPIND=TAPIND
  33. TYPOBJ=TAPOBJ
  34. SEGACT MTABLE*MOD
  35. IN = MLOTAB
  36. C
  37. C ***** RECHERCHE DE L'INDICE S'IL EXISTE
  38. C
  39. IA=4
  40. IF(TYPIND.EQ.'ENTIER ') IA=1
  41. IF(TYPIND.EQ.'FLOTTANT') IA=2
  42. IF(TYPIND.EQ.'MOT ') IA=3
  43. IF(TYPIND.EQ.'METHODE ') IA=3
  44. IF(TYPIND.EQ.'LOGIQUE ') IA=5
  45. C ****** dans le cas des mots on ignore les blancs situes a la fin
  46. IF(IA.EQ.3) IL=LONG(CHARIN)
  47. IF(IN.EQ.0) GO TO 10
  48. DO 1 I=1,IN
  49. MT=I
  50. IF(MTABTI(I).NE.TYPIND ) GO TO 1
  51. GO TO (11,12,13,14,15),IA
  52. 11 CONTINUE
  53. IF(MTABII(I).NE.IVALIN) GO TO 1
  54. GOTO 20
  55. 12 CONTINUE
  56. IF(RMTABI(I).NE.XVALIN ) GO TO 1
  57. GO TO 20
  58. 15 CONTINUE
  59. IF(IPLOGI(MTABII(I)).NEQV.LOGIN ) GO TO 1
  60. GO TO 20
  61. 14 CONTINUE
  62. IF(MTABII(I).NE.IOBIN) GO TO 1
  63. GOTO 20
  64. 13 CONTINUE
  65. IP=MTABII(I)
  66. ID=IPCHAR(IP)
  67. IFI=IPCHAR(IP+1)
  68. IL1=LONG(ICHARA(ID:IFI-1))
  69. IF(IL1.NE.IL) GO TO 1
  70. IF(CHARIN(1:IL).NE.ICHARA(ID:ID+IL-1)) GO TO 1
  71. GO TO 20
  72. 1 CONTINUE
  73. 10 CONTINUE
  74. C
  75. C ***** L'INDICE N'EXISTE PAS ON L'AJOUTE
  76. C
  77. MLOTAB=MLOTAB+1
  78. M=MTABII(/1)
  79. IF (M.LT.MLOTAB) THEN
  80. M=M+50
  81. SEGADJ MTABLE
  82. ENDIF
  83. M=MLOTAB
  84. MT=M
  85. MTABTI(M)=TYPIND
  86. IF(IA.EQ.1) THEN
  87. IRET=IVALIN
  88. ELSEIF(IA.EQ.2) THEN
  89. RMTABI(MT)=XVALIN
  90. GO TO 20
  91. ELSEIF(IA.EQ.3) THEN
  92. CALL POSCHA( CHARIN(1:IL),IRET)
  93. GO TO 200
  94. ELSEIF(IA.EQ.5) THEN
  95. call poslog(login,iret)
  96. GO TO 200
  97. ELSEIF(IA.EQ.4) THEN
  98. IRET=IOBIN
  99. ENDIF
  100. 200 MTABII(MT)=IRET
  101. * if(nbesc.ne.0) segact ipiloc
  102. 20 CONTINUE
  103.  
  104. C
  105. C ***** FINI POUR L'INDICE FAIRE LA VALEUR
  106. C
  107. IA=4
  108. IF(TYPOBJ.EQ.'ENTIER ') IA=1
  109. IF(TYPOBJ.EQ.'FLOTTANT') IA=2
  110. IF(TYPOBJ.EQ.'MOT ') IA=3
  111. IF(TYPOBJ.EQ.'LOGIQUE ') IA=5
  112. IF(IA.EQ.3) IL=LEN(CHARRE)
  113. MTABTV(MT)= TYPOBJ
  114. IF(IA.EQ.1) THEN
  115. IRET=IVALRE
  116. ELSEIF(IA.EQ.2) THEN
  117. IRET=0
  118. RMTABV(MT)=XVALRE
  119. GO TO 300
  120. ELSEIF(IA.EQ.3) THEN
  121. CALL POSCHA(CHARRE,IRET)
  122. GO TO 300
  123. ELSEIF(IA.EQ.5) THEN
  124. call poslog(logre,iret)
  125. GO TO 300
  126. ELSEIF(IA.EQ.4) THEN
  127. IRET=IOBRE
  128. ENDIF
  129. 300 MTABIV(MT)=IRET
  130. SEGDES MTABLE
  131. If(nbesc.ne.0) segdes ipiloc
  132. RETURN
  133. END
  134.  
  135.  

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