Télécharger entnom.eso

Retour à la liste

Numérotation des lignes :

  1. C ENTNOM SOURCE JC220346 18/12/04 21:15:17 9991
  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 CCNOYAU
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMLENTI
  28. SEGMENT/NOMM1/(NOM1(NOBJN1))
  29. SEGMENT NOMM2
  30. CHARACTER*(LONOM) NOM2(NOBJN1)
  31. ENDSEGMENT
  32. C-------------------------------------------------------------------
  33. IRETOU=0
  34. SEGACT NOMM1
  35. SEGACT NOMM2
  36. NOBJN1=NOBJN
  37. SEGADJ NOMM1
  38. SEGADJ NOMM2
  39.  
  40. IF (NOBJN.EQ.0) GO TO 1
  41.  
  42. IF(IONIVE.LE.2) THEN
  43. JG=NOBJN1*2
  44. SEGINI MLENTI
  45. CALL LFANC(IBAND,NOBJN1,LECT,IRETOU,IFORM,NOM2)
  46. SEGSUP MLENTI
  47. ELSE
  48. CALL LFNOMS(IBAND,NOBJN1,NOM2,IRETOU,IFORM)
  49. ENDIF
  50. IF(IRETOU.NE.0) GO TO 1
  51.  
  52. CALL LFCDIE(IBAND,NOBJN1,NOM1,IRETOU,IFORM)
  53. IF(IRETOU.NE.0)GO TO 1
  54.  
  55. C -------------------------
  56. IF(IIMPI.EQ.5) THEN
  57. WRITE(IOIMP,101)
  58. DO 2 I=1,NOBJN
  59. WRITE(IOIMP,100) NOM2(I),NOM1(I)
  60. 2 CONTINUE
  61. ENDIF
  62. C -------------------------
  63. 1 CONTINUE
  64. SEGDES NOMM1
  65. SEGDES NOMM2
  66. RETURN
  67. 100 FORMAT(2X,A24,2X,I6)
  68. 101 FORMAT(' OBJETS NOMMES ET LEUR RANG DANS LA PILE : ')
  69. END
  70.  
  71.  
  72.  

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