Télécharger filllu.eso

Retour à la liste

Numérotation des lignes :

  1. C FILLLU SOURCE PV 16/11/26 21:15:51 9205
  2. SUBROUTINE FILLLU (ISORTA,ICOLAC)
  3. C=======================================================================
  4. C CE SOUPROGRAMME REMPLIT LES PILES ICOLAC A
  5. C PARTIR DU TABLEAU ISORTA : TYPE-TYPE-POINTEUR CREE PAR SAUV
  6. C LES OBJETS LOGIQUES SONT CHANGES PAR LA VALEUR VRAI OU FAUX
  7. C
  8. C ENTREE :ISORTA TABLEAU (TYPE-TYPE-POINTEUR)
  9. C ICOLAC POINTEUR SUR UN SEGMENT A CREER
  10. C INCTAB INCREMENT DANS LA TABLE
  11. C PROGRAMME PAR FARVACQUE - REPRIS PAR LENA
  12. C APPELE PAR SAUV
  13. C APPELLE : AJOUN TYPFIL ERREUR
  14. C=======================================================================
  15. C TABLEAU KCOLA : VOIR SIGNIFATION DANS SOUS-PROGRAMME TYPFIL
  16. C=======================================================================
  17. IMPLICIT INTEGER(I-N)
  18. IMPLICIT REAL*8(A-H,O-Z)
  19. character*(8) itype
  20. integer ico, isort, ityp, ival, n1, nsorta, numlis
  21.  
  22. -INC CCOPTIO
  23. -INC TMCOLAC
  24.  
  25. C=======================================================================
  26. C ----DANS ISORTA LES VALEURS VONT TROIS PAR TROIS
  27. SEGMENT ISORTA
  28. CHARACTER*8 ISORTC(KS)
  29. INTEGER ISORTI(KS)
  30. ENDSEGMENT
  31. C
  32. pointeur pile.ITLACC
  33. C
  34. SEGACT ISORTA
  35. NSORTA=ISORTI(/1)
  36. IF(NSORTA.EQ.0) GOTO 5000
  37. C
  38. C **** BOUCLE SUR LES OBJETS A SORTIR : ON TESTE LEUR TYPE ET ON
  39. C **** INITIALISE LE REMPLISSAGE DES PILES ITLACC
  40. SEGACT ICOLAC
  41. ILISSE=ILISSG
  42. SEGACT ILISSE*MOD
  43.  
  44. C
  45. DO 200 ISORT=1,NSORTA
  46.  
  47. ITYPE(1:8)=ISORTC(ISORT)
  48. C
  49. N1=0
  50. CALL TYPFIL(ITYPE,N1)
  51. IF (N1.LT.0) THEN
  52. MOTERR(1:8)=ITYPE
  53. CALL ERREUR (336)
  54. GO TO 200
  55. ENDIF
  56.  
  57. IVAL=ISORTI(ISORT)
  58. ICO=KCOLA(N1)
  59. NUMLIS=1
  60. ilissd=ilissg
  61. ITYP=N1
  62. IF (ITYP.EQ.24) NUMLIS=6
  63. IF (ITYP.EQ.25) NUMLIS=4
  64. IF (ITYP.EQ.26) NUMLIS=2
  65. IF (ITYP.EQ.27) NUMLIS=5
  66. IF (ITYP.EQ.32) then
  67. NUMLIS=3
  68. ilissd=ilissp
  69. endif
  70. IF (ITYP.EQ.36) NUMLIS=7
  71. pile = ICO
  72. segact pile*mod
  73. CALL AJOUN(ICO,IVAL,ILISSd,NUMLIS)
  74.  
  75. 200 CONTINUE
  76. C
  77. * SEGDES ILISSE
  78. SEGDES ICOLAC
  79. C
  80. 5000 CONTINUE
  81. SEGDES ISORTA
  82.  
  83. RETURN
  84. END
  85.  
  86.  
  87.  
  88.  
  89.  

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