Télécharger rempla.eso

Retour à la liste

Numérotation des lignes :

  1. C REMPLA SOURCE JC220346 12/06/27 21:15:00 7414
  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.
  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. *
  69. *
  70. * IPOS<>0 => on autorise IPOIN2 à contenir un LISTENTI
  71. IPOS=1
  72.  
  73. CALL LIRE01(IPOIN1,IPOS,IPOIN2)
  74. IF (IERR.NE.0) RETURN
  75. *
  76. ICODE=1
  77. IF (IPOS.LT.0) ICODE=0
  78. IPLIS1=0
  79. *
  80. * REMPLACEMENT(S) DANS UN LISTREEL
  81. IF (IABS(IPOS).EQ.1) THEN
  82. CALL LIRREE(REELDP,ICODE,IRETOU)
  83. IF (IERR.NE.0) RETURN
  84. IF (IRETOU.EQ.0) THEN
  85. CALL LIROBJ('LISTREEL',IPLIS1,1,IRETOU)
  86. IF (IERR.NE.0) RETURN
  87. ENDIF
  88. CALL REMPL1(IPOIN1,IPOIN2,REELDP,IPLIS1,IPOS)
  89. *
  90. * REMPLACEMENT(S) DANS UN LISTENTI
  91. ELSEIF (IABS(IPOS).EQ.2) THEN
  92. CALL LIRENT(IPOIN3,ICODE,IRETOU)
  93. IF (IERR.NE.0) RETURN
  94. IF (IRETOU.EQ.0) THEN
  95. CALL LIROBJ('LISTENTI',IPLIS1,1,IRETOU)
  96. IF (IERR.NE.0) RETURN
  97. ENDIF
  98. CALL REMPL2(IPOIN1,IPOIN2,IPOIN3,IPLIS1,IPOS)
  99. *
  100. * REMPLACEMENT(S) DANS UN LISTMOTS
  101. ELSEIF (IABS(IPOS).EQ.3) THEN
  102. CALL LIRCHA(LEMOT,ICODE,IRETOU)
  103. IF (IERR.NE.0) RETURN
  104. IF (IRETOU.EQ.0) THEN
  105. CALL LIROBJ('LISTMOTS',IPLIS1,1,IRETOU)
  106. IF (IERR.NE.0) RETURN
  107. ENDIF
  108. CALL REMPL3(IPOIN1,IPOIN2,LEMOT,IPLIS1,IPOS)
  109. *
  110. * REMPLACEMENT(S) DANS UN LISTCHPO
  111. ELSEIF (IABS(IPOS).EQ.4) THEN
  112. CALL LIROBJ('CHPOINT',IPOIN3,ICODE,IRETOU)
  113. IF (IERR.NE.0) RETURN
  114. IF (IRETOU.EQ.0) THEN
  115. CALL LIROBJ('LISTCHPO',IPLIS1,1,IRETOU)
  116. IF (IERR.NE.0) RETURN
  117. ENDIF
  118. CALL REMPL4(IPOIN1,IPOIN2,IPOIN3,IPLIS1,IPOS)
  119. *
  120. * ERREUR (ARGUMENT DE TYPE INCOMPATIBLE)
  121. ELSEIF (IPOS.NE.0) THEN
  122. CALL ERREUR(196)
  123. ENDIF
  124. *
  125. END
  126.  
  127.  
  128.  
  129.  
  130.  

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