Télécharger rempl1.eso

Retour à la liste

Numérotation des lignes :

  1. C REMPL1 SOURCE JC220346 12/05/15 21:15:03 7370
  2. SUBROUTINE REMPL1 (IPOINT,IEME,REELDP,IPLISR,IPOS)
  3. ************************************************************************
  4. *
  5. * R E M P L 1
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * REMPLACER LE I-EME ELEMENT D'UN OBJET DE TYPE "LISTREEL".
  12. *
  13. * MODE D'APPEL:
  14. * -------------
  15. *
  16. * CALL REMPL1 (IPOINT,IEME,REELDP)
  17. *
  18. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  19. * -----------
  20. *
  21. * IPOINT ENTIER (E) POINTEUR DE L'OBJET DE TYPE "LISTREEL".
  22. * IEME ENTIER (E) NUMERO D'ORDRE DE L'ELEMENT A REMPLACER
  23. * DANS L'OBJET DE TYPE "LISTREEL".
  24. * REELDP REEL DP (E) ELEMENT REMPLACANT.
  25. * IPLISR ENTIER (E) POINTEUR VERS UN "LISTREEL" DE REMPLACANTS
  26. * IPOS ENTIER (E) SI NEGATIF, IEME EST UN POINTEUR "LISTENTI"
  27. *
  28. * SOUS-PROGRAMMES APPELES:
  29. * ------------------------
  30. *
  31. * ERREUR
  32. *
  33. * AUTEUR, DATE DE CREATION:
  34. * -------------------------
  35. *
  36. * PASCAL MANIGOT 6 DECEMBRE 1984
  37. *
  38. * LANGAGE:
  39. * --------
  40. *
  41. * ESOPE + FORTRAN77
  42. *
  43. ************************************************************************
  44. *
  45. IMPLICIT INTEGER(I-N)
  46. -INC CCOPTIO
  47. -INC SMLENTI
  48. -INC SMLREEL
  49. *
  50. REAL*8 REELDP
  51. *
  52. MLREEL=IPOINT
  53. SEGACT,MLREEL*MOD
  54. *
  55. * Y a-t-il plusieurs remplacements a faire ?
  56. NBRMPL=1
  57. IF (IPOS.LT.0) THEN
  58. MLENT1=IEME
  59. SEGACT,MLENT1
  60. NBRMPL=MLENT1.LECT(/1)
  61. *
  62. * Y a-t-il des valeurs de remplacement distinctes ?
  63. IF (IPLISR.NE.0) THEN
  64. MLREE1=IPLISR
  65. SEGACT,MLREE1
  66. IF (MLREE1.PROG(/1).NE.NBRMPL) THEN
  67. MOTERR(1:8)='LISTxxxx'
  68. CALL ERREUR(1015)
  69. RETURN
  70. ENDIF
  71. ENDIF
  72. ENDIF
  73. *
  74. * Mise a jour du LISTREEL
  75. DO II=1,NBRMPL
  76. IF (IPOS.LT.0) IEME=MLENT1.LECT(II)
  77. IF (IPLISR.NE.0) REELDP=MLREE1.PROG(II)
  78. IF (0.LT.IEME.AND.IEME.LE.PROG(/1)) THEN
  79. PROG(IEME)=REELDP
  80. ELSE
  81. INTERR(1)=IEME
  82. CALL ERREUR(36)
  83. ENDIF
  84. ENDDO
  85. *
  86. SEGDES,MLREEL
  87. IF (IPOS.LT.0) SEGDES,MLENT1
  88. IF (IPLISR.NE.0) SEGDES,MLREE1
  89. *
  90. END
  91.  
  92.  
  93.  
  94.  

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