Télécharger la plaquette Cast3M


fr en

Télécharger rempla.eso

Retour à la liste

Numérotation des lignes : 

rempla

  1. C REMPLA    SOURCE    BP208322  23/03/13    21:15:02     11627          
  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 PPARAM
  65. -INC CCOPTIO
  66. *
  67.       REAL*8 REELDP
  68.       CHARACTER*(LOCHAI) LEMOT
  69.       CHARACTER*8 CTYP
  70. *
  71. *     CAS PARTICULIER DU REMPLACEMENT DANS UN MOT
  72. *     => LE/LES INDICES NE SONT PAS DES ENTIERS
  73. *     => REMPLACER EST UN OPERATEUR PLUTOT QU'UNE DIRECTIVE
  74.       CALL QUETYP(CTYP,0,IRETOU)
  75.       IF (IRETOU.EQ.0) THEN
  76.           CALL ERREUR(533)
  77.           RETURN
  78.       ENDIF
  79.       IF (CTYP.EQ.'MOT') THEN
  80. *         REMPL5 LIT LES ARGUMENTS ET ECRIT LE RESULTAT DANS LA PILE
  81.           CALL REMPL5
  82.           RETURN
  83.       ENDIF
  84. *
  85. *     ================================================================
  86. *
  87. *     IPOS<>0 => on autorise IPOIN2 a contenir un LISTENTI
  88.       IPOS=1
  89.  
  90.       CALL LIRE01(IPOIN1,IPOS,IPOIN2)
  91.       IF (IERR.NE.0) RETURN
  92. *
  93.       ICODE=1
  94.       IF (IPOS.LT.0) ICODE=0
  95.       IPLIS1=0
  96. *
  97. *     REMPLACEMENT(S) DANS UN LISTREEL
  98.       IF (IABS(IPOS).EQ.1) THEN
  99.           CALL LIRREE(REELDP,ICODE,IRETOU)
  100.           IF (IERR.NE.0) RETURN
  101.           IF (IRETOU.EQ.0) THEN
  102.               CALL LIROBJ('LISTREEL',IPLIS1,1,IRETOU)
  103.               IF (IERR.NE.0) RETURN
  104.           ENDIF
  105.           CALL REMPL1(IPOIN1,IPOIN2,REELDP,IPLIS1,IPOS)
  106. *
  107. *     REMPLACEMENT(S) DANS UN LISTENTI
  108.       ELSEIF (IABS(IPOS).EQ.2) THEN
  109.           CALL LIRENT(IPOIN3,ICODE,IRETOU)
  110.           IF (IERR.NE.0) RETURN
  111.           IF (IRETOU.EQ.0) THEN
  112.               CALL LIROBJ('LISTENTI',IPLIS1,1,IRETOU)
  113.               IF (IERR.NE.0) RETURN
  114.           ENDIF
  115.           CALL REMPL2(IPOIN1,IPOIN2,IPOIN3,IPLIS1,IPOS)
  116. *
  117. *     REMPLACEMENT(S) DANS UN LISTMOTS
  118.       ELSEIF (IABS(IPOS).EQ.3) THEN
  119.           CALL LIRCHA(LEMOT,ICODE,IRETOU)
  120.           IF (IERR.NE.0) RETURN
  121.           IF (IRETOU.EQ.0) THEN
  122.               CALL LIROBJ('LISTMOTS',IPLIS1,1,IRETOU)
  123.               IF (IERR.NE.0) RETURN
  124.           ENDIF
  125.           CALL REMPL3(IPOIN1,IPOIN2,LEMOT,IPLIS1,IPOS)
  126. *
  127. *     REMPLACEMENT(S) DANS UN LISTCHPO
  128.       ELSEIF (IABS(IPOS).EQ.4) THEN
  129.           CALL LIROBJ('CHPOINT',IPOIN3,ICODE,IRETOU)
  130.           IF (IERR.NE.0) RETURN
  131.           IF (IRETOU.EQ.0) THEN
  132.               CALL LIROBJ('LISTCHPO',IPLIS1,1,IRETOU)
  133.               IF (IERR.NE.0) RETURN
  134.           ENDIF
  135.           CALL REMPL4(IPOIN1,IPOIN2,IPOIN3,IPLIS1,IPOS)      
  136. *
  137. *     ERREUR (ARGUMENT DE TYPE INCOMPATIBLE)
  138.       ELSEIF (IPOS.NE.0) THEN
  139.           CALL ERREUR(196)
  140.       ENDIF
  141. *
  142.       END
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  

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