Télécharger la plaquette Cast3M


fr en

Télécharger filllu.eso

Retour à la liste

Numérotation des lignes : 

filllu

  1. C FILLLU    SOURCE    PV        17/12/05    21:16:19     9646           
  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.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC TMCOLAC
  26.  
  27. C=======================================================================
  28. C ----DANS ISORTA LES VALEURS VONT TROIS PAR TROIS
  29.       SEGMENT ISORTA
  30.        CHARACTER*8 ISORTC(KS)
  31.        INTEGER ISORTI(KS)
  32.       ENDSEGMENT
  33. C
  34.       pointeur pile.ITLACC
  35. C
  36.       SEGACT ISORTA
  37.       NSORTA=ISORTI(/1)
  38.       IF(NSORTA.EQ.0) GOTO 5000
  39. C
  40. C  **** BOUCLE SUR LES OBJETS A SORTIR : ON TESTE LEUR TYPE ET ON
  41. C  **** INITIALISE LE REMPLISSAGE DES PILES ITLACC
  42.       SEGACT ICOLAC
  43.       ILISSE=ILISSG
  44.       SEGACT ILISSE*MOD
  45.  
  46. C
  47.       DO 200 ISORT=1,NSORTA
  48.  
  49.          ITYPE(1:8)=ISORTC(ISORT)
  50. C
  51.          N1=0
  52.          CALL TYPFIL(ITYPE,N1)
  53.          IF (N1.LT.0) THEN
  54.             MOTERR(1:8)=ITYPE
  55.             CALL ERREUR (336)
  56.             GO TO 200
  57.          ENDIF
  58.  
  59.          IVAL=ISORTI(ISORT)
  60.          ICO=KCOLA(N1)
  61.          NUMLIS=1
  62.           ilissd=ilissg
  63.          ITYP=N1
  64.          IF (ITYP.EQ.24) NUMLIS=6
  65.          IF (ITYP.EQ.25) NUMLIS=4
  66.          IF (ITYP.EQ.26) NUMLIS=2
  67.          IF (ITYP.EQ.27) NUMLIS=5
  68.          IF (ITYP.EQ.32) then
  69.            NUMLIS=3
  70.            ilissd=ilissp
  71.          endif
  72.          IF (ITYP.EQ.36) NUMLIS=7
  73.          pile = ICO
  74.          segact pile*mod
  75.          CALL AJOUN(ICO,IVAL,ILISSd,NUMLIS)
  76.  
  77.  200  CONTINUE
  78. C
  79. *      SEGDES ILISSE
  80.       SEGDES ICOLAC
  81. C
  82.  5000 CONTINUE
  83.       SEGDES ISORTA
  84.  
  85.       RETURN
  86.       END
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  

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