1 : C REMPL2 SOURCE JC220346 12/05/15 21:15:03 7370 2 : SUBROUTINE REMPL2 (IPOINT,IEME,INTEGR,IPLISE,IPOS) 3 : ************************************************************************ 4 : * 5 : * R E M P L 2 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * REMPLACER LE I-EME ELEMENT D'UN OBJET DE TYPE "LISTENTI". 12 : * 13 : * MODE D'APPEL: 14 : * ------------- 15 : * 15 : * CALL REMPL2 (IPOINT,IEME,INTEGR) 16 : * 17 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 18 : * ----------- 19 : * 20 : * IPOINT ENTIER (E) POINTEUR DE L'OBJET DE TYPE "LISTENTI". 21 : * IEME ENTIER (E) NUMERO D'ORDRE DE L'ELEMENT A REMPLACER 22 : * DANS L'OBJET DE TYPE "LISTENTI". 23 : * INTEGR ENTIER (E) ELEMENT REMPLACANT. 24 : * IPLISE ENTIER (E) POINTEUR VERS UN "LISTENTI" DE REMPLACANTS 25 : * IPOS ENTIER (E) SI NEGATIF, IEME EST UN POINTEUR "LISTENTI" 26 : * 27 : * SOUS-PROGRAMMES APPELES: 28 : * ------------------------ 29 : * 30 : * ERREUR 31 : * 32 : * AUTEUR, DATE DE CREATION: 33 : * ------------------------- 34 : * 35 : * PASCAL MANIGOT 5 DECEMBRE 1984 36 : * 37 : * LANGAGE: 38 : * -------- 39 : * 40 : * ESOPE + FORTRAN77 41 : * 42 : ************************************************************************ 43 : * 44 : IMPLICIT INTEGER(I-N) 45 : -INC CCOPTIO 46 : -INC SMLENTI 47 : * 48 : MLENTI=IPOINT 49 : SEGACT,MLENTI*MOD 50 : * 51 : * Y a-t-il plusieurs remplacements a faire ? 52 : NBRMPL=1 53 : IF (IPOS.LT.0) THEN 54 : MLENT1=IEME 55 : SEGACT,MLENT1 56 : NBRMPL=MLENT1.LECT(/1) 57 : * 58 : * Y a-t-il des valeurs de remplacement distinctes ? 59 : IF (IPLISE.NE.0) THEN 60 : MLENT2=IPLISE 61 : SEGACT,MLENT2 62 : IF (MLENT2.LECT(/1).NE.NBRMPL) THEN 63 : MOTERR(1:8)='LISTENTI' 63 : CALL ERREUR(1015) 64 : RETURN 65 : ENDIF 66 : ENDIF 67 : ENDIF 68 : * 69 : * Mise a jour du LISTENTI 70 : DO II=1,NBRMPL 71 : IF (IPOS.LT.0) IEME=MLENT1.LECT(II) 72 : IF (IPLISE.NE.0) INTEGR=MLENT2.LECT(II) 73 : IF (0.LT.IEME.AND.IEME.LE.LECT(/1)) THEN 74 : LECT(IEME)=INTEGR 75 : ELSE 76 : INTERR(1)=IEME 76 : CALL ERREUR(36) 77 : ENDIF 78 : ENDDO 79 : * 80 : SEGDES,MLENTI 81 : IF (IPOS.LT.0) SEGDES,MLENT1 82 : IF (IPLISE.NE.0) SEGDES,MLENT2 83 : * 84 : END 85 : 86 : 87 :
© Cast3M 2003 - All rights reserved.
Disclaimer