Download nommef.eso

Back to the list

   1 : C NOMMEF    SOURCE    CHAT      09/05/15    21:15:03     6387           
   2 :       SUBROUTINE NOMMEF(ISGTR,IMAX,IPIL,IFORM,IDEB,isilen)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : C------------------------------------------------------------------
   6 : C
   7 : C  BUT : ECRIRE SUR IOSAUV DESC ENREGS CARACTERISTIQUES DE LA PILE
   8 : C
   9 : C  ENTREE : ISGTR   TABLE ASSOCIEE A LA PILE EXAMINEE
  10 : C           IMAX    VALEUR MAX  DE LA PILE
  11 : C           IPIL    NUMERO DE LA PILE EXAMINEE
  12 : C           IFORM   INDICE 0 OU 1 POUR SORTIE AVEC OU SANS FORMAT
  13 : C
  14 : C   CHERCHE DANS LA LISTE ISGTR (NOM-NOM-IVAL=RANG DANS LA PILE) LES
  15 : C   OBJETS TELS QUE IVAL.LE.IMAX
  16 : C   ECRIT CES OBJETS SUR IOSAU AVEC OU SANS FORMAT :
  17 : C  1- NUMERO DE LA PILE,NBRE OBJETS NOMMES, NBRE OBJETS DANS LA PILE
  18 : C  2- LISTE DES NOMS DES OBJETS NOMMES S IL Y EN A
  19 : C  3- LISTE DES POINTEURS DES OBJETS NOMMES  S IL Y EN A
  20 : C------------------------------------------------------------------
  21 : C
  22 : -INC CCOPTIO
  23 :       SEGMENT ISGTR
  24 :          CHARACTER*8 ISGTRC(KS)
  25 :          INTEGER ISGTRI(KS)
  26 :       ENDSEGMENT
  27 :       SEGMENT ISTMP
  28 :          CHARACTER*8 ISTMPC(NTMP)
  29 :       ENDSEGMENT
  30 :       DIMENSION ILENA(3)
  31 : C
  32 : C
  33 :       IQUOI=2
  33 :       CALL ECDES (IOSAU,IQUOI,IFORM)
  34 :       NI=0
  35 :       IF(ISGTR.NE.0) THEN
  36 :          NI=ISGTRI(/1)
  37 :       ENDIF
  38 :       ILENA(1)= IPIL
  39 :       ILENA(2)= NI
  40 :       ILENA(3)= IMAX-IDEB+1
  41 :       ILLL    = 3
  41 :       CALL ECDIFP (IOSAU,ILLL,ILENA,IFORM)
  42 :       IF(ISGTR.NE.0) THEN
  43 :          IF (NI.NE.0) THEN
  44 :             NTMP=ISGTRI(/1)
  45 :             SEGINI ISTMP
  46 :             DO 999 ITMP=1,NTMP
  47 :               ISTMPC(ITMP)=ISGTRC(ITMP)
  48 :  999        CONTINUE
  48 :             CALL ECDIFN(IOSAU,NI,ISTMP,IFORM)
  49 :             SEGSUP ISTMP
  49 :             CALL ECDIFE(IOSAU,NI,ISGTRI,IFORM)
  50 : C       ... Rappel sur le terminal ...
  51 :             IF( ISILEN.NE.1)WRITE(IOIMP,800) NI
  52 : *            WRITE(IOIMP,801)(ISGTRC(I),ISGTRI(I),I=1,NI)
  53 :          ENDIF
  54 :       ENDIF
  55 :       RETURN
  56 : 
  57 : C-OLD  800 FORMAT('  IL Y A ',I5,'  OBJET(S) NOMME(S) :')
  58 :   800 FORMAT('  IL Y A ',I8,'  OBJET(S) NOMME(S) :')
  59 :   801 FORMAT(5(2X,A8,I5))
  60 :       END
  61 :  
  62 :  
  63 :  
  64 :  
  65 :  
  66 :  

© Cast3M 2003 - All rights reserved.
Disclaimer