Télécharger rpenle.eso

Retour à la liste

Numérotation des lignes :

  1. C RPENLE SOURCE CHAT 05/01/13 03:07:08 5004
  2. SUBROUTINE RPENLE(LENTI,KREF,NREF,
  3. $ LIREEN,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : RPENLE
  9. C DESCRIPTION : On construit LIREEN :
  10. C LIREEN(IREF)=liste des entiers i
  11. C tels que : KREF(LENTI(i))=IREF
  12. C Construction d'un liste indexée qui, à un entier associe les positions
  13. C des occurences de cet entier dans une liste d'entiers.
  14. C
  15. C LANGAGE : ESOPE
  16. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES : -
  20. C APPELE PAR : PROMAT
  21. C***********************************************************************
  22. C ENTREES : LENTI, KREF, NREF
  23. C SORTIES : LIREEN
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION : v1, 04/02/2000, version initiale
  27. C HISTORIQUE : v1, 04/02/2000, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35. -INC CCOPTIO
  36. -INC SMLENTI
  37. POINTEUR LENTI.MLENTI
  38. POINTEUR KREF.MLENTI
  39. * Includes persos
  40. * Segment LSTIND (liste séquentielle indexée)
  41. INTEGER NBM,NBTVAL
  42. SEGMENT LSTIND
  43. INTEGER IDX(NBM+1)
  44. INTEGER IVAL(NBTVAL)
  45. ENDSEGMENT
  46. *-INC SLSTIND
  47. POINTEUR LIREEN.LSTIND
  48. *
  49. INTEGER NREF
  50. INTEGER IMPR,IRET
  51. *
  52. INTEGER NENTI
  53. INTEGER IENTI,IREF,IEGLO
  54. *
  55. * Executable statements
  56. *
  57. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans rpenle.eso'
  58. * Construction de l'indexation de la liste séquentielle
  59. * Pour l'instant LIREEN.IDX(IREF+1)=nombre d'éléments de LENTI()
  60. * tels que KREF(LENTI())=IREF
  61. SEGACT LENTI
  62. NENTI=LENTI.LECT(/1)
  63. SEGACT KREF
  64. NBM=NREF
  65. NBTVAL=0
  66. SEGINI LIREEN
  67. DO 1 IENTI=1,NENTI
  68. IEGLO=LENTI.LECT(IENTI)
  69. IREF=KREF.LECT(IEGLO)
  70. LIREEN.IDX(IREF+1)=LIREEN.IDX(IREF+1)+1
  71. 1 CONTINUE
  72. * SEGPRT,LIREEN
  73. * LIREEN.IDX est transformé en la liste d'indexation sur
  74. * LIREEN.IVAL
  75. LIREEN.IDX(1)=1
  76. DO 3 IREF=1,NREF
  77. LIREEN.IDX(IREF+1)=LIREEN.IDX(IREF+1)+LIREEN.IDX(IREF)
  78. 3 CONTINUE
  79. NBM=NREF
  80. NBTVAL=LIREEN.IDX(NREF+1)-1
  81. SEGADJ,LIREEN
  82. * SEGPRT,LIREEN
  83. * LIREEN.IDX est désormais la liste des index courants sur
  84. * LIREEN.IVAL que l'on remplit.
  85. DO 5 IENTI=1,NENTI
  86. IEGLO=LENTI.LECT(IENTI)
  87. IREF=KREF.LECT(IEGLO)
  88. LIREEN.IVAL(LIREEN.IDX(IREF))=IENTI
  89. LIREEN.IDX(IREF)=LIREEN.IDX(IREF)+1
  90. 5 CONTINUE
  91. * SEGPRT,LIREEN
  92. * On restaure les valeurs de LIREEN.IDX
  93. DO 7 IREF=NREF,2,-1
  94. LIREEN.IDX(IREF)=LIREEN.IDX(IREF-1)
  95. 7 CONTINUE
  96. LIREEN.IDX(1)=1
  97. SEGDES LIREEN
  98. SEGDES LENTI
  99. SEGDES KREF
  100. *
  101. * Normal termination
  102. *
  103. IRET=0
  104. RETURN
  105. *
  106. * Format handling
  107. *
  108. *
  109. * Error handling
  110. *
  111. 9999 CONTINUE
  112. IRET=1
  113. WRITE(IOIMP,*) 'An error was detected in subroutine rpenle'
  114. RETURN
  115. *
  116. * End of subroutine RPENLE
  117. *
  118. END
  119.  
  120.  
  121.  
  122.  

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