Sources Esope | Cast3M

rempla
C REMPLA    SOURCE    FD218221  26/09/21    21:15:19     12650          
      SUBROUTINE REMPLA
************************************************************************
*
*                             R E M P L A
*                             -----------
*
*            SOUS-PROGRAMME ASSOCIE A LA DIRECTIVE "REMPLACER"
*
* FONCTION:
* ---------
*
*     REMPLACER UN ELEMENT D'UN OBJET (QUAND CELA A UN SENS).
*
* PHRASE D'APPEL (EN GIBIANE):
* ----------------------------
*
*     REMPLACER OBJET RANG ELEM ;
*
* OPERANDES:
* ----------
*
*     OBJET     TYPE1       OBJET DONT ON REMPLACE UN ELEMENT.
*     RANG      TYPE2       INDICE DE POSITION DE L'ELEMENT A REMPLACER
*                           DE L'OBJET "OBJET".
*     ELEM      TYPE3       OBJET REMPLACANT.
*
*     SI TYPE1 = ...   ALORS, TYPE2 = ...   ET TYPE3 = ...
*        LISTREEL             ENTIER           FLOTTANT
*        LISTENTI             ENTIER           ENTIER
*        LISTMOTS             ENTIER           MOT
*        LISTCHPO             ENTIER           CHPOINT
*        LISTOBJE             ENTIER           OBJET
*
* MODE DE FONCTIONNEMENT:
* -----------------------
*
*     APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET
*     "OBJET".
*
*     IPLIS1 CONTIENT UNE LISTE DE VALEURS DE REMPLACEMENT, SI FOURNIE
*     SINON, IPLIS3 VAUT ZERO
*
*     IPOIN2 CONTIENT LA LISTE DES INDICES A REMPLACER, SI IPOS&lt;0
*     SINON, IPOIN2 CONTIENT UN SEUL INDICE
*
* SOUS-PROGRAMMES APPELES:
* ------------------------
*
*     ERREUR, LIRE01, REMPL1, REMPL2, REMPL3, REMPL4, REMPL5, REMPL6
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     5 DECEMBRE 1984
*               MODIF LE 22 JANVIER 1988
* LANGAGE:
* --------
*
*     FORTRAN77
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
-INC PPARAM
-INC CCOPTIO
-INC SMLOBJE
*
      REAL*8 REELDP
      CHARACTER*(LOCHAI) LEMOT
      CHARACTER*8 CTYP
*
*     CAS PARTICULIER DU REMPLACEMENT DANS UN MOT
*     => LE/LES INDICES NE SONT PAS DES ENTIERS
*     => REMPLACER EST UN OPERATEUR PLUTOT QU'UNE DIRECTIVE
      CALL QUETYP(CTYP,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
          CALL ERREUR(533)
          RETURN
      ENDIF
      IF (CTYP.EQ.'MOT') THEN
*         REMPL5 LIT LES ARGUMENTS ET ECRIT LE RESULTAT DANS LA PILE
          CALL REMPL5
          RETURN
      ENDIF
*
*     ================================================================
*
*     IPOS&lt;>0 => on autorise IPOIN2 a contenir un LISTENTI
      IPOS=1
 
      CALL LIRE01(IPOIN1,IPOS,IPOIN2)
      IF (IERR.NE.0) RETURN
*
      ICODE=1
      IF (IPOS.LT.0) ICODE=0
      IPLIS1=0
*
*     REMPLACEMENT(S) DANS UN LISTREEL
      IF (IABS(IPOS).EQ.1) THEN
          CALL LIRREE(REELDP,ICODE,IRETOU)
          IF (IERR.NE.0) RETURN
          IF (IRETOU.EQ.0) THEN
              CALL LIROBJ('LISTREEL',IPLIS1,1,IRETOU)
              IF (IERR.NE.0) RETURN
          ENDIF
          CALL REMPL1(IPOIN1,IPOIN2,REELDP,IPLIS1,IPOS)
*
*     REMPLACEMENT(S) DANS UN LISTENTI
      ELSEIF (IABS(IPOS).EQ.2) THEN
          CALL LIRENT(IPOIN3,ICODE,IRETOU)
          IF (IERR.NE.0) RETURN
          IF (IRETOU.EQ.0) THEN
              CALL LIROBJ('LISTENTI',IPLIS1,1,IRETOU)
              IF (IERR.NE.0) RETURN
          ENDIF
          CALL REMPL2(IPOIN1,IPOIN2,IPOIN3,IPLIS1,IPOS)
*
*     REMPLACEMENT(S) DANS UN LISTMOTS
      ELSEIF (IABS(IPOS).EQ.3) THEN
          CALL LIRCHA(LEMOT,ICODE,IRETOU)
          IF (IERR.NE.0) RETURN
          IF (IRETOU.EQ.0) THEN
              CALL LIROBJ('LISTMOTS',IPLIS1,1,IRETOU)
              IF (IERR.NE.0) RETURN
          ENDIF
          CALL REMPL3(IPOIN1,IPOIN2,LEMOT,IPLIS1,IPOS)
*
*     REMPLACEMENT(S) DANS UN LISTCHPO
      ELSEIF (IABS(IPOS).EQ.4) THEN
          CALL LIROBJ('CHPOINT',IPOIN3,ICODE,IRETOU)
          IF (IERR.NE.0) RETURN
          IF (IRETOU.EQ.0) THEN
              CALL LIROBJ('LISTCHPO',IPLIS1,1,IRETOU)
              IF (IERR.NE.0) RETURN
          ENDIF
          CALL REMPL4(IPOIN1,IPOIN2,IPOIN3,IPLIS1,IPOS)      
*
*     REMPLACEMENT(S) DANS UN LISTOBJE
      ELSEIF (IABS(IPOS).EQ.5) THEN
          MLOBJE=IPOIN1
          SEGACT,MLOBJE
          IF (TYPOBJ.EQ.'FLOTTANT') THEN
            CALL LIRREE(REELDP,ICODE,IRETOU)
          ELSE
            CALL LIROBJ(TYPOBJ,IPOIN3,ICODE,IRETOU)
          ENDIF
          IF (IERR.NE.0) RETURN
          IF (IRETOU.EQ.0) THEN
              CALL LIROBJ('LISTOBJE',IPLIS1,1,IRETOU)
              IF (IERR.NE.0) RETURN
          ENDIF
          CALL REMPL6(IPOIN1,IPOIN2,IPOIN3,IPLIS1,REELDP,IPOS)
*
*     ERREUR (ARGUMENT DE TYPE INCOMPATIBLE)
      ELSEIF (IPOS.NE.0) THEN
          CALL ERREUR(196)
      ENDIF
*
      END