Télécharger lirtab.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRTAB SOURCE CHAT 09/06/17 21:15:05 6428
  2. SUBROUTINE LIRTAB(ITYP,IRETA,ICODE,IRETOU)
  3. IMPLICIT INTEGER(I-N)
  4. -INC CCOPTIO
  5. -INC CCNOYAU
  6. CHARACTER*(*)ITYP
  7. CHARACTER*8 TYPE,TAPIND,TYPOBJ,CHARIN
  8. CHARACTER*72 CHARRE
  9. CHARACTER*8 LETYPE
  10. REAL*8 XVALIN,XVALRE
  11. LOGICAL IV,LOGIN,LOGRE
  12. SEGMENT IVAL1
  13. INTEGER NOVAL(N)
  14. ENDSEGMENT
  15. SEGMENT IVAL2
  16. CHARACTER*8 TYVAL(N)
  17. ENDSEGMENT
  18. SEGMENT IVAL3
  19. INTEGER IVAL(N)
  20. ENDSEGMENT
  21. IRET = 0
  22. ireta=0
  23. iretou=0
  24. N=0
  25. IFIN=0
  26. LE= LEN(ITYP)
  27. SEGINI IVAL1,IVAL2,IVAL3
  28. TYPE=ITYP
  29. 1 CONTINUE
  30. MOTERR(1:8)=TYPE
  31. CALL MESLIR(-173)
  32. CALL LIROBJ ('TABLE',IRET,ICODE,IRETO)
  33. * write(6,*) ' lecture de la table ' , iret
  34. IF(IERR.NE.0) GO TO 10
  35. IF(IRETO.EQ.0)GO TO 10
  36. TYPOBJ = ' '
  37. CALL ACCTAB(IRET,'MOT ',IVALIN,XVALIN,'SOUSTYPE',LOGIN,
  38. $ IOBIN, TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  39. IF(TYPOBJ.EQ.'MOT ') THEN
  40. * write(6,*) ' le ivalre ' , le , ivalre
  41. IF(IVALRE.EQ.LE) THEN
  42. IF(CHARRE(1:LE).EQ.ITYP) THEN
  43. * ON A TROUVE LA TABLE RECHERCHEE IL FAUT METTRE A JOUR LA
  44. * LECTURE DES TABLES PRECEDEMMENT LUES
  45. ireta=iret
  46. iretou=1
  47. * write(6,*) ' c est celle la'
  48. GO TO 10
  49. ENDIF
  50. ENDIF
  51. ENDIF
  52. * CE N EST PAS UNE BONNE TABLE ON REMPLIT IVAL ET ON RETOURNE EN
  53. * LECTURE
  54. N = N + 1
  55. SEGADJ IVAL1,IVAL2,IVAL3
  56. IVAL(N)=IMOTLU
  57.  
  58. NOVAL(N)=INOOB1(IMOTLU)
  59. TYVAL(N)=INOOB2(IMOTLU)
  60. GO TO 1
  61. *
  62. * AVANT DE SORTIR ON REMET LES TABLES LUES PAS(DU BON SOUSTYPE) EN
  63. * LECTURE
  64. *
  65. 10 CONTINUE
  66. ID = IVAL(/1)
  67. IF(ID.EQ.0) GO TO 20
  68. DO 2 J=1,ID
  69. IV=.TRUE.
  70. imola= IVAL(J)
  71. IF(INOOB1(imola).NE.NOVAL(J)) IV=.FALSE.
  72. IF(INOOB2(imola).NE.TYVAL(J)) IV=.FALSE.
  73. IF(IV) THEN
  74. JPOOB1(imola)=.TRUE.
  75. IF(IBPILE.GT.imola) IBPILE=imola
  76. IF(IHPILE.LT.imola) IHPILE=imola
  77. ELSE
  78. NN = JPOOB1(/1)
  79. DO 5 KK=1,NN
  80. IF(INOOB1(KK).NE.NOVAL(KK)) GO TO 5
  81. IF(INOOB2(KK).NE.TYVAL(KK)) GO TO 5
  82. IF(JPOOB1(KK)) GO TO 5
  83. JPOOB1(KK)=.TRUE.
  84. GO TO 6
  85. 5 CONTINUE
  86. CALL ERREUR(5)
  87. RETURN
  88. 6 CONTINUE
  89. ENDIF
  90. 2 CONTINUE
  91. 20 CONTINUE
  92. SEGSUP IVAL1,IVAL2,IVAL3
  93. RETURN
  94. END
  95.  
  96.  
  97.  

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