Télécharger rpelem.eso

Retour à la liste

Numérotation des lignes :

  1. C RPELEM SOURCE CB215821 18/09/27 21:15:49 9936
  2. SUBROUTINE RPELEM(NUELG,RPMAIL,
  3. $ NOSOUS,NOELEM,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : RPELEM
  9. C DESCRIPTION : Numéro "global" d'un élément + liste d'entiers(inirpl)
  10. C => numéro de la partition + numéro "local" de
  11. C l'élément.
  12. C
  13. C On donne un numéro d'élément NUELG d'un maillage MAIL
  14. C repéré par RPMAIL (construit avec inirpl.eso).
  15. C On sort : - NOSOUS : le numéro du LISOUS (peut être nul)
  16. C où se trouve NUELG.
  17. C - NOELEM : le numéro de NUELG dans le LISOUS.
  18. C LANGAGE : ESOPE
  19. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  20. C mél : gounand@semt2.smts.cea.fr
  21. C***********************************************************************
  22. C APPELES (ESOPE) : OOOETA
  23. C APPELE PAR : PONBPO,
  24. C***********************************************************************
  25. C ENTREES : NUELG, RPMAIL
  26. C SORTIES : NOSOUS, NOELEM
  27. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  28. C***********************************************************************
  29. C VERSION : v1, 12/05/99, version initiale
  30. C HISTORIQUE : v1, 12/05/99, création
  31. C HISTORIQUE : 05/01/00 : modif. algorithme de recherche du numéro de
  32. C partition : séquentiel (O(n)) -> Binary search (O(log n))
  33. C HISTORIQUE :
  34. C HISTORIQUE :
  35. C***********************************************************************
  36. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  37. C en cas de modification de ce sous-programme afin de faciliter
  38. C la maintenance !
  39. C***********************************************************************
  40. -INC CCOPTIO
  41. -INC SMLENTI
  42. POINTEUR RPMAIL.MLENTI
  43. *
  44. INTEGER RPETA
  45. INTEGER IMPR,IRET
  46.  
  47. *
  48. INTEGER NOELEM,NOSOUS
  49. INTEGER NUELG ,NBSOUS
  50. INTEGER NUMAX
  51. INTEGER IDX,IDXMIL,IDXINF,IDXSUP
  52. INTEGER VAL,VALMIL
  53. *
  54. * Executable statements
  55. *
  56. IF (IMPR.GT.3) THEN
  57. WRITE(IOIMP,*) 'Entrée dans rpelem.eso'
  58. ENDIF
  59. CALL OOOETA(RPMAIL,RPETA,IMOD)
  60. IF (RPETA.NE.1) SEGACT RPMAIL
  61. NBSOUS=RPMAIL.LECT(/1)-1
  62. NUMAX=RPMAIL.LECT(NBSOUS+1)
  63. IF ((NUELG.GE.NUMAX).OR.(NUELG.LE.0)) THEN
  64. WRITE(IOIMP,*) 'NUELG=',NUELG,' trop grand ou trop petit'
  65. GOTO 9999
  66. ENDIF
  67. IF (NBSOUS.EQ.1) THEN
  68. NOSOUS=0
  69. NOELEM=NUELG
  70. ELSE
  71. VAL=NUELG
  72. IDX=-1
  73. IDXINF=1
  74. IDXSUP=NBSOUS
  75. *
  76. * Algorithme de recherche modifié (binary search)
  77. * (cf. ifidic.eso)
  78. *
  79. 1 CONTINUE
  80. IF (IDXSUP.GE.IDXINF) THEN
  81. IDXMIL=(IDXINF+IDXSUP)/2
  82. VALMIL=RPMAIL.LECT(IDXMIL)
  83. IF (VAL.LT.VALMIL) THEN
  84. IDXSUP=IDXMIL-1
  85. GOTO 1
  86. ELSEIF (VAL.GT.VALMIL) THEN
  87. IDXINF=IDXMIL+1
  88. GOTO 1
  89. ELSE
  90. IDX=IDXMIL
  91. ENDIF
  92. ENDIF
  93. IF (IDX.NE.-1) THEN
  94. NOSOUS=IDX
  95. NOELEM=1
  96. ELSE
  97. NOSOUS=IDXSUP
  98. NOELEM=NUELG-RPMAIL.LECT(NOSOUS)+1
  99. ENDIF
  100. ENDIF
  101. IF (RPETA.NE.1) SEGDES RPMAIL
  102. IF (IMPR.GT.5) THEN
  103. WRITE(IOIMP,*) 'NOSOUS=',NOSOUS,' NOELEM=',NOELEM
  104. ENDIF
  105. *
  106. * Normal termination
  107. *
  108. IRET=0
  109. RETURN
  110. *
  111. * Format handling
  112. *
  113. *
  114. * Error handling
  115. *
  116. 9999 CONTINUE
  117. IRET=1
  118. WRITE(IOIMP,*) 'An error was detected in subroutine rpelem'
  119. RETURN
  120. *
  121. * End of subroutine RPELEM
  122. *
  123. END
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  

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