Download fillno.eso

Back to the list

   1 : C FILLNO    SOURCE    CHAT      05/01/13    00:00:14     5004           
   2 :       SUBROUTINE FILLNO (ICOLAC)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : C-----------------------------------------------------------------------
   6 : C
   7 : C   BUT  :VA A LA PECHE DES NOMS DES OBJETS
   8 : C         DEJA CONTENUS DANS LES PILES
   9 : C LOGIQUE:
  10 : C       ON SE POINTE SUR UNE PILE
  11 : C       ON CREE LA TABLE DES OBJETS DU TYPE DE CETTE PILE
  12 : C--    CAS GENERAL
  13 : C       ON TESTE SI LE POINTEUR DANS L OBJET EST DANS LA PILE
  14 : C       SI NON, ON PASSE A  L OBJET SUIVANT.
  15 : C       SI OUI, ON MET LE NOM S IL N Y EST DEJA DANS LE ISGTR ASSOCIE
  16 : C
  17 : C   PROGRAMME PAR :  FARVACQUE-REPRIS PAR LENA
  18 : C   APPELE PAR    :  SAUV
  19 : C   APPELLE       :  FNOMOB    ERREUR  REPERT
  20 : C
  21 : C=======================================================================
  22 : C  TABLEAU KCOLA :
  23 : C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6 MCLSTR
  24 : C    7  MELSTR  8 MSOLUT  9 MSTRUC 10        11 MAFFEC 12 MSOSTU
  25 : C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  26 : C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL
  27 : C=======================================================================
  28 : -INC TMCOLAC
  29 :       DIMENSION ILENA(1)
  30 :       SEGMENT ILISNB
  31 :         INTEGER ILISOB(MLON)
  32 :         CHARACTER*8 ILISNO(MLON)
  33 :       ENDSEGMENT
  34 : C
  35 :       CHARACTER*(8) ITYPE
  36 : C
  37 :       SEGACT ICOLAC
  38 :       NITLAC=ICOLA(/1)
  38 :       CALL LISTOB(ITYPE,MLON,ILENA,0)
  39 :       SEGINI ILISNB
  40 : 
  41 : C
  42 :       DO 600 IFILE=1,NITLAC
  43 :          ITITI=0
  44 :          ITLACC=KCOLA(IFILE)
  45 :          ISGTR=ICOLA(IFILE)
  46 :          IMAX1=ITLAC(/1)
  47 :          IF(IMAX1.NE.0) THEN
  48 :              ITYPE='        '
  48 :              CALL TYPFIL (ITYPE,IFILE)
  48 :              CALL FNOMOB (ITITI,ITLACC,ISGTR,ITYPE,ILISNB)
  49 :          ENDIF
  50 :  600  CONTINUE
  51 :       SEGSUP ILISNB
  52 :       SEGDES ICOLAC
  53 :       RETURN
  54 :       END
  55 :  
  56 :  
  57 :  
  58 :  
  59 :  

© Cast3M 2003 - All rights reserved.
Disclaimer