Download entnom.eso

Back to the list

   1 : C ENTNOM    SOURCE    CHAT      05/01/12    23:40:34     5004           
   2 :       SUBROUTINE ENTNOM(IBAND,NOBJN,NOMM1,NOMM2,IRETOU,IFORM)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : C-------------------------------------------------------------------
   6 : C     LECTURE DES NOBJN NOMS D OBETS ( SI NOBJN NON NUL)
   7 : C
   8 : C   Entrée :
   9 : C     IBAND - l'unité de lecture
  10 : C     NOBJN - le nombre de noms à lire
  11 : C     IFORM - flag décrivant le format du fichier
  12 : C
  13 : C   Sortie :
  14 : C     NOMM1 - SEGMENT QUI CONTIENT LES NUMEROS DES OBJETS DS LEUR PILE
  15 : C     NOMM2 - SEGMENT QUI CONTIENT LE NOM DE CES OBJETS
  16 : C     IRETOU =0 SI TOUT S'EST BIEN PASSE. IRETOU=1 SINON.
  17 : C
  18 : C     APPELE     LFCDIE LFCDIM
  19 : C     APPELE PAR LIPIL
  20 : C     ECRIT PAR FARVACQUE     - REPRIS PAR LENA
  21 : C
  22 : C-------------------------------------------------------------------
  23 : -INC CCOPTIO
  24 : -INC SMLENTI
  25 :       SEGMENT/NOMM1/(NOM1(NOBJN1))
  26 :       SEGMENT NOMM2
  27 :        CHARACTER*(8) NOM2(NOBJN1)
  28 :       ENDSEGMENT
  29 : C-------------------------------------------------------------------
  30 :       IRETOU=0
  31 :       SEGACT NOMM1
  32 :       SEGACT NOMM2
  33 :       NOBJN1=NOBJN
  34 :       SEGADJ NOMM1
  35 :       SEGADJ NOMM2
  36 : 
  37 :       IF (NOBJN.EQ.0) GO TO 1
  38 : 
  39 :       IF(IONIVE.LE.2) THEN
  40 :          JG=NOBJN1*2
  41 :          SEGINI MLENTI
  41 :          CALL LFANC(IBAND,NOBJN1,LECT,IRETOU,IFORM,NOM2)
  42 :          SEGSUP MLENTI
  43 :       ELSE
  43 :          CALL LFCDIN(IBAND,NOBJN1,NOM2,IRETOU,IFORM)
  44 :       ENDIF
  45 :       IF(IRETOU.NE.0) GO TO 1
  46 : 
  46 :       CALL LFCDIE(IBAND,NOBJN1,NOM1,IRETOU,IFORM)
  47 :       IF(IRETOU.NE.0)GO TO 1
  48 : 
  49 : C -------------------------
  50 :       IF(IIMPI.EQ.5) THEN
  51 :          WRITE(IOIMP,101)
  52 :          DO 2 I=1,NOBJN
  53 :             WRITE(IOIMP,100) NOM2(I),NOM1(I)
  54 :    2     CONTINUE
  55 :       ENDIF
  56 : C -------------------------
  57 :    1  CONTINUE
  58 :       SEGDES NOMM1
  59 :       SEGDES NOMM2
  60 :       RETURN
  61 :  100  FORMAT(2X,A8,2X,I6)
  62 :  101  FORMAT('  OBJETS NOMMES ET LEUR RANG DANS LA PILE   :  ')
  63 :       END
  64 :  

© Cast3M 2003 - All rights reserved.
Disclaimer