Télécharger rempl4.eso

Retour à la liste

Numérotation des lignes :

  1. C REMPL4 SOURCE JC220346 12/05/15 21:15:04 7370
  2. SUBROUTINE REMPL4 (IPOINT,IEME,IPCHPO,IPLISC,IPOS)
  3. ************************************************************************
  4. *
  5. * R E M P L 4
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * REMPLACER LE I-EME "CHPOINT" D'UNE SUITE DE TYPE "LISTCHPO".
  12. *
  13. * MODE D'APPEL:
  14. * -------------
  15. *
  16. * CALL REMPL4 (IPOINT,IEME,IPCHPO)
  17. *
  18. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  19. * -----------
  20. *
  21. * IPOINT ENTIER (E) POINTEUR DE LA SUITE DE TYPE "LISTCHPO".
  22. * IEME ENTIER (E) NUMERO D'ORDRE DU "CHPOINT" A REMPLACER
  23. * DANS LA SUITE DE TYPE "LISTCHPO".
  24. * IPCHPO ENTIER (E) POINTEUR DU "CHPOINT" REMPLACANT.
  25. * IPLISC ENTIER (E) POINTEUR VERS UN "LISTCHPO" 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 22 FEVRIER 1985
  37. *
  38. * LANGAGE:
  39. * --------
  40. *
  41. * ESOPE + FORTRAN77
  42. *
  43. ************************************************************************
  44. *
  45. IMPLICIT INTEGER(I-N)
  46. -INC CCOPTIO
  47. -INC SMLENTI
  48. -INC SMLCHPO
  49. *
  50. MLCHPO=IPOINT
  51. SEGACT,MLCHPO*MOD
  52. *
  53. * Y a-t-il plusieurs remplacements a faire ?
  54. NBRMPL=1
  55. IF (IPOS.LT.0) THEN
  56. MLENT1=IEME
  57. SEGACT,MLENT1
  58. NBRMPL=MLENT1.LECT(/1)
  59. *
  60. * Y a-t-il des valeurs de remplacement distinctes ?
  61. IF (IPLISC.NE.0) THEN
  62. MLCHP1=IPLISC
  63. SEGACT,MLCHP1
  64. IF (MLCHP1.ICHPOI(/1).NE.NBRMPL) THEN
  65. MOTERR(1:8)='LISTxxxx'
  66. CALL ERREUR(1015)
  67. RETURN
  68. ENDIF
  69. ENDIF
  70. ENDIF
  71. *
  72. * Mise a jour du LISTCHPO
  73. DO II=1,NBRMPL
  74. IF (IPOS.LT.0) IEME=MLENT1.LECT(II)
  75. IF (IPLISC.NE.0) IPCHPO=MLCHP1.ICHPOI(II)
  76. IF (0.LT.IEME.AND.IEME.LE.ICHPOI(/1)) THEN
  77. ICHPOI(IEME)=IPCHPO
  78. ELSE
  79. INTERR(1)=IEME
  80. CALL ERREUR(36)
  81. ENDIF
  82. ENDDO
  83. *
  84. SEGDES,MLCHPO
  85. IF (IPOS.LT.0) SEGDES,MLENT1
  86. IF (IPLISC.NE.0) SEGDES,MLCHP1
  87. *
  88. END
  89.  
  90.  
  91.  

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