C REMPL4 SOURCE JC220346 12/05/15 21:15:04 7370 SUBROUTINE REMPL4 (IPOINT,IEME,IPCHPO,IPLISC,IPOS) ************************************************************************ * * R E M P L 4 * ----------- * * FONCTION: * --------- * * REMPLACER LE I-EME "CHPOINT" D'UNE SUITE DE TYPE "LISTCHPO". * * MODE D'APPEL: * ------------- * * CALL REMPL4 (IPOINT,IEME,IPCHPO) * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * IPOINT ENTIER (E) POINTEUR DE LA SUITE DE TYPE "LISTCHPO". * IEME ENTIER (E) NUMERO D'ORDRE DU "CHPOINT" A REMPLACER * DANS LA SUITE DE TYPE "LISTCHPO". * IPCHPO ENTIER (E) POINTEUR DU "CHPOINT" REMPLACANT. * IPLISC ENTIER (E) POINTEUR VERS UN "LISTCHPO" DE REMPLACANTS * IPOS ENTIER (E) SI NEGATIF, IEME EST UN POINTEUR "LISTENTI" * * SOUS-PROGRAMMES APPELES: * ------------------------ * * ERREUR * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 22 FEVRIER 1985 * * LANGAGE: * -------- * * ESOPE + FORTRAN77 * ************************************************************************ * IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC SMLENTI -INC SMLCHPO * MLCHPO=IPOINT SEGACT,MLCHPO*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 (IPLISC.NE.0) THEN MLCHP1=IPLISC SEGACT,MLCHP1 IF (MLCHP1.ICHPOI(/1).NE.NBRMPL) THEN MOTERR(1:8)='LISTxxxx' CALL ERREUR(1015) RETURN ENDIF ENDIF ENDIF * * Mise a jour du LISTCHPO DO II=1,NBRMPL IF (IPOS.LT.0) IEME=MLENT1.LECT(II) IF (IPLISC.NE.0) IPCHPO=MLCHP1.ICHPOI(II) IF (0.LT.IEME.AND.IEME.LE.ICHPOI(/1)) THEN ICHPOI(IEME)=IPCHPO ELSE INTERR(1)=IEME CALL ERREUR(36) ENDIF ENDDO * SEGDES,MLCHPO IF (IPOS.LT.0) SEGDES,MLENT1 IF (IPLISC.NE.0) SEGDES,MLCHP1 * END