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

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