Télécharger rempla.eso

Retour à la liste

Numérotation des lignes :

  1. C REMPLA SOURCE JC220346 19/12/29 21:15:07 10441
  2. SUBROUTINE REMPLA
  3. ************************************************************************
  4. *
  5. * R E M P L A
  6. * -----------
  7. *
  8. * SOUS-PROGRAMME ASSOCIE A LA DIRECTIVE "REMPLACER"
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * REMPLACER UN ELEMENT D'UN OBJET (QUAND CELA A UN SENS).
  14. *
  15. * PHRASE D'APPEL (EN GIBIANE):
  16. * ----------------------------
  17. *
  18. * REMPLACER OBJET RANG ELEM ;
  19. *
  20. * OPERANDES:
  21. * ----------
  22. *
  23. * OBJET TYPE1 OBJET DONT ON REMPLACE UN ELEMENT.
  24. * RANG TYPE2 INDICE DE POSITION DE L'ELEMENT A REMPLACER
  25. * DE L'OBJET "OBJET".
  26. * ELEM TYPE3 OBJET REMPLACANT.
  27. *
  28. * SI TYPE1 = ... ALORS, TYPE2 = ... ET TYPE3 = ...
  29. * LISTREEL ENTIER FLOTTANT
  30. * LISTENTI ENTIER ENTIER
  31. * LISTMOTS ENTIER MOT
  32. * LISTCHPO ENTIER CHPOINT
  33. *
  34. * MODE DE FONCTIONNEMENT:
  35. * -----------------------
  36. *
  37. * APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET
  38. * "OBJET".
  39. *
  40. * IPLIS1 CONTIENT UNE LISTE DE VALEURS DE REMPLACEMENT, SI FOURNIE
  41. * SINON, IPLIS3 VAUT ZERO
  42. *
  43. * IPOIN2 CONTIENT LA LISTE DES INDICES A REMPLACER, SI IPOS<0
  44. * SINON, IPOIN2 CONTIENT UN SEUL INDICE
  45. *
  46. * SOUS-PROGRAMMES APPELES:
  47. * ------------------------
  48. *
  49. * ERREUR, LIRE01, REMPL1, REMPL2, REMPL3, REMPL4, REMPL5
  50. *
  51. * AUTEUR, DATE DE CREATION:
  52. * -------------------------
  53. *
  54. * PASCAL MANIGOT 5 DECEMBRE 1984
  55. * MODIF LE 22 JANVIER 1988
  56. * LANGAGE:
  57. * --------
  58. *
  59. * FORTRAN77
  60. *
  61. ************************************************************************
  62. *
  63. IMPLICIT INTEGER(I-N)
  64. -INC CCOPTIO
  65. *
  66. REAL*8 REELDP
  67. CHARACTER*4 LEMOT
  68. CHARACTER*8 CTYP
  69. *
  70. * CAS PARTICULIER DU REMPLACEMENT DANS UN MOT
  71. * => LE/LES INDICES NE SONT PAS DES ENTIERS
  72. * => REMPLACER EST UN OPERATEUR PLUTOT QU'UNE DIRECTIVE
  73. CALL QUETYP(CTYP,0,IRETOU)
  74. IF (IRETOU.EQ.0) THEN
  75. CALL ERREUR(533)
  76. RETURN
  77. ENDIF
  78. IF (CTYP.EQ.'MOT') THEN
  79. * REMPL5 LIT LES ARGUMENTS ET ECRIT LE RESULTAT DANS LA PILE
  80. CALL REMPL5
  81. RETURN
  82. ENDIF
  83. *
  84. * ================================================================
  85. *
  86. * IPOS<>0 => on autorise IPOIN2 à contenir un LISTENTI
  87. IPOS=1
  88.  
  89. CALL LIRE01(IPOIN1,IPOS,IPOIN2)
  90. IF (IERR.NE.0) RETURN
  91. *
  92. ICODE=1
  93. IF (IPOS.LT.0) ICODE=0
  94. IPLIS1=0
  95. *
  96. * REMPLACEMENT(S) DANS UN LISTREEL
  97. IF (IABS(IPOS).EQ.1) THEN
  98. CALL LIRREE(REELDP,ICODE,IRETOU)
  99. IF (IERR.NE.0) RETURN
  100. IF (IRETOU.EQ.0) THEN
  101. CALL LIROBJ('LISTREEL',IPLIS1,1,IRETOU)
  102. IF (IERR.NE.0) RETURN
  103. ENDIF
  104. CALL REMPL1(IPOIN1,IPOIN2,REELDP,IPLIS1,IPOS)
  105. *
  106. * REMPLACEMENT(S) DANS UN LISTENTI
  107. ELSEIF (IABS(IPOS).EQ.2) THEN
  108. CALL LIRENT(IPOIN3,ICODE,IRETOU)
  109. IF (IERR.NE.0) RETURN
  110. IF (IRETOU.EQ.0) THEN
  111. CALL LIROBJ('LISTENTI',IPLIS1,1,IRETOU)
  112. IF (IERR.NE.0) RETURN
  113. ENDIF
  114. CALL REMPL2(IPOIN1,IPOIN2,IPOIN3,IPLIS1,IPOS)
  115. *
  116. * REMPLACEMENT(S) DANS UN LISTMOTS
  117. ELSEIF (IABS(IPOS).EQ.3) THEN
  118. CALL LIRCHA(LEMOT,ICODE,IRETOU)
  119. IF (IERR.NE.0) RETURN
  120. IF (IRETOU.EQ.0) THEN
  121. CALL LIROBJ('LISTMOTS',IPLIS1,1,IRETOU)
  122. IF (IERR.NE.0) RETURN
  123. ENDIF
  124. CALL REMPL3(IPOIN1,IPOIN2,LEMOT,IPLIS1,IPOS)
  125. *
  126. * REMPLACEMENT(S) DANS UN LISTCHPO
  127. ELSEIF (IABS(IPOS).EQ.4) THEN
  128. CALL LIROBJ('CHPOINT',IPOIN3,ICODE,IRETOU)
  129. IF (IERR.NE.0) RETURN
  130. IF (IRETOU.EQ.0) THEN
  131. CALL LIROBJ('LISTCHPO',IPLIS1,1,IRETOU)
  132. IF (IERR.NE.0) RETURN
  133. ENDIF
  134. CALL REMPL4(IPOIN1,IPOIN2,IPOIN3,IPLIS1,IPOS)
  135. *
  136. * ERREUR (ARGUMENT DE TYPE INCOMPATIBLE)
  137. ELSEIF (IPOS.NE.0) THEN
  138. CALL ERREUR(196)
  139. ENDIF
  140. *
  141. END
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  

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