Sources Esope | Cast3M

rempl6
C REMPL6    SOURCE    FD218221  26/09/21    21:15:18     12650          
      SUBROUTINE REMPL6 (IPOINT,IEME,IOBJE,IPLISE,XREE,IPOS)
************************************************************************
*
*                             R E M P L 6
*                             -----------
*
* FONCTION:
* ---------
*
*     REMPLACER LE I-EME ELEMENT D'UN OBJET DE TYPE "LISTOBJE".
*
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*
*     IPOINT  ENTIER    (E)  POINTEUR DE L'OBJET DE TYPE "LISTOBJE"
*     IEME    ENTIER    (E)  NUMERO D'ORDRE DE L'ELEMENT A REMPLACER
*                            DANS L'OBJET DE TYPE "LISTOBJE"
*     IOBJE   ENTIER    (E)  POINTEUR DE L'OBJET REMPLACANT
*     IPLISE  ENTIER    (E)  POINTEUR VERS UN "LISTOBJE" DE REMPLACANTS
*     XREE    FLOTTANT  (E)  FLOTTANT REMPLACANT
*                            SERA UTILISE DANS LE CAS D'UN LISTOBJE DE
*                            FLOTTANT ET SI IOBJE=IPLISE=0
*     IPOS    ENTIER    (E)  SI NEGATIF, IEME EST UN POINTEUR "LISTENTI"
*
* SOUS-PROGRAMMES APPELES:
* ------------------------
*
*     ERREUR
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     5 DECEMBRE 1984
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
-INC SMLOBJE
*
      REAL*8 XREE
 
      MLOBJE=IPOINT
      SEGACT,MLOBJE*MOD
*
*     Y a-t-il plusieurs remplacements a faire ?
      NBRMPL=1
      IF (IPOS.LT.0) THEN
          MLENT1=IEME
          SEGACT,MLENT1
          NBRMPL=MLENT1.LECT(/1)
*         Y a-t-il des valeurs de remplacement distinctes ?
          IF (IPLISE.NE.0) THEN
              MLOBJ1=IPLISE
              SEGACT,MLOBJ1
              IF (MLOBJ1.TYPOBJ.NE.TYPOBJ) THEN
                  MOTERR(1:8)=TYPOBJ
                  CALL ERREUR(1156)
                  RETURN
              ENDIF
          ENDIF
      ENDIF
*
*     Mise a jour du LISTOBJE
      DO II=1,NBRMPL
          IF (IPOS.LT.0) IEME=MLENT1.LECT(II)
*         Cas des LISTOBJE de FLOTTANT
          IF (TYPOBJ.EQ.'FLOTTANT') THEN
              IF (IPLISE.NE.0) XREE=MLOBJ1.RLIREE(II)
              IF (0.LT.IEME.AND.IEME.LE.RLIREE(/1)) THEN
                  RLIREE(IEME)=XREE
              ELSE
                  INTERR(1)=IEME
                  CALL ERREUR(36)
              ENDIF
*         Cas des autres LISTOBJE
          ELSE
              IF (IPLISE.NE.0) IOBJE=MLOBJ1.LISOBJ(II)
              IF (0.LT.IEME.AND.IEME.LE.LISOBJ(/1)) THEN
                  LISOBJ(IEME)=IOBJE
              ELSE
                  INTERR(1)=IEME
                  CALL ERREUR(36)
              ENDIF
          ENDIF
      ENDDO
*
      SEGDES,MLOBJE
      IF (IPOS.LT.0) SEGDES,MLENT1
      IF (IPLISE.NE.0) SEGDES,MLOBJ1
*
      END