1 : C REMPLA SOURCE JC220346 12/06/27 21:15:00 7414 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. 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 CCOPTIO 65 : * 66 : REAL*8 REELDP 67 : CHARACTER *4 LEMOT 68 : * 69 : * 70 : * IPOS<>0 => on autorise IPOIN2 à contenir un LISTENTI 71 : IPOS=1 72 : 72 : CALL LIRE01(IPOIN1,IPOS,IPOIN2) 73 : IF (IERR.NE.0) RETURN 74 : * 75 : ICODE=1 76 : IF (IPOS.LT.0) ICODE=0 77 : IPLIS1=0 78 : * 79 : * REMPLACEMENT(S) DANS UN LISTREEL 80 : IF (IABS(IPOS).EQ.1) THEN 80 : CALL LIRREE(REELDP,ICODE,IRETOU) 81 : IF (IERR.NE.0) RETURN 82 : IF (IRETOU.EQ.0) THEN 82 : CALL LIROBJ('LISTREEL',IPLIS1,1,IRETOU) 83 : IF (IERR.NE.0) RETURN 84 : ENDIF 84 : CALL REMPL1(IPOIN1,IPOIN2,REELDP,IPLIS1,IPOS) 85 : * 86 : * REMPLACEMENT(S) DANS UN LISTENTI 87 : ELSEIF (IABS(IPOS).EQ.2) THEN 87 : CALL LIRENT(IPOIN3,ICODE,IRETOU) 88 : IF (IERR.NE.0) RETURN 89 : IF (IRETOU.EQ.0) THEN 89 : CALL LIROBJ('LISTENTI',IPLIS1,1,IRETOU) 90 : IF (IERR.NE.0) RETURN 91 : ENDIF 91 : CALL REMPL2(IPOIN1,IPOIN2,IPOIN3,IPLIS1,IPOS) 92 : * 93 : * REMPLACEMENT(S) DANS UN LISTMOTS 94 : ELSEIF (IABS(IPOS).EQ.3) THEN 94 : CALL LIRCHA(LEMOT,ICODE,IRETOU) 95 : IF (IERR.NE.0) RETURN 96 : IF (IRETOU.EQ.0) THEN 96 : CALL LIROBJ('LISTMOTS',IPLIS1,1,IRETOU) 97 : IF (IERR.NE.0) RETURN 98 : ENDIF 98 : CALL REMPL3(IPOIN1,IPOIN2,LEMOT,IPLIS1,IPOS) 99 : * 100 : * REMPLACEMENT(S) DANS UN LISTCHPO 101 : ELSEIF (IABS(IPOS).EQ.4) THEN 101 : CALL LIROBJ('CHPOINT',IPOIN3,ICODE,IRETOU) 102 : IF (IERR.NE.0) RETURN 103 : IF (IRETOU.EQ.0) THEN 103 : CALL LIROBJ('LISTCHPO',IPLIS1,1,IRETOU) 104 : IF (IERR.NE.0) RETURN 105 : ENDIF 105 : CALL REMPL4(IPOIN1,IPOIN2,IPOIN3,IPLIS1,IPOS) 106 : * 107 : * ERREUR (ARGUMENT DE TYPE INCOMPATIBLE) 108 : ELSEIF (IPOS.NE.0) THEN 108 : CALL ERREUR(196) 109 : ENDIF 110 : * 111 : END 112 : 113 : 114 : 115 :
© Cast3M 2003 - All rights reserved.
Disclaimer