1 : C MENAGE SOURCE PV 13/04/12 21:15:44 7756 2 : C SUPPRIMER LES SEGMENTS INDESIRABLES 3 : C 4 : SUBROUTINE MENAGE(IAUTOM) 5 : * 6 : IMPLICIT INTEGER(I-N) 7 : -INC CCOPTIO 8 : -INC TMLCHA8 9 : -INC SMELEME 10 : -INC CCNOYAU 11 : -INC CCASSIS 12 : -INC SMTABLE 13 : -INC SMLENTI 14 : -INC SMCOORD 15 : 16 : SEGMENT ITLAC(0) 17 : INTEGER OOOVAL 18 : * 19 : CHARACTER*4 CMOT 20 : CHARACTER*8 TYPE 21 : SAVE IPLAOC,MACTIP 22 : DATA IPLAOC /0/ 23 : * 23 : call lircha(cmot, 0,iretou) 24 : if( iretou.ne.0) then 25 : if( cmot .eq.'OBLI')go to 1 25 : call refus 26 : endif 27 : if(iautom.eq.0) then 28 : IF(IPLAOC.EQ.0) THEN 29 : IPLAOC= OOOVAL(3,1) 30 : MACTIP= OOOVAL(3,3) 31 : RETURN 32 : ELSE 33 : IPLAOB=OOOVAL(3,1) 34 : IF( IPLAOB . LT . IPLAOC + MACTIP*0.05) RETURN 35 : ENDIF 35 : call chleha(1,0,0,0) 36 : iautom=1 37 : endif 38 : 1 CONTINUE 39 : * horodatage 39 : call ooohor(0,0) 40 : 41 : C * attention aux assistants .... 42 : if (NBESC.NE.0) then 43 : if (iimpi .eq. 1234) 44 : & write(ioimp,*) ' il faut bloquer les assistants' 45 : mestra=imestr 46 : SEGACT MESTRA*MOD 47 : if (iimpi .eq. 1234) 48 : & write(ioimp,*) ' assistants en attente' 49 : * on passe en mode force 49 : call ooofrc(1) 50 : * lodesl=.true. 50 : call setass(1) 51 : end if 52 : 53 : * on passe en mode force 54 : * on met NOMLU a 1 pour bloquer le decodage des instructions 55 : NOMLUS=NOMLU 56 : nomlu=1 57 : segini itlac 57 : call ecrcha('NOOP') 57 : call tasspo(itlac,icolac,meleme,1) 58 : segdes meleme 59 : * 60 : * icolac ,cree dans tasspo pointe sur les piles d'objets accessibles 61 : * 61 : CALL MENAG5(ICOLAC,0) 62 : * 63 : * QUELLE PLACE RESTE T'IL MAINTENANT 64 : IPLAOC=OOOVAL(3,1) 65 : IF(IIMPI.NE.0) write(IOIMP,12) IPLAOB,IPLAOC 66 : 12 FORMAT( ' place occupée avant apres ',2I8) 66 : * CALL PLAC 66 : * CALL LIRENT(IPLRES,1,IRETOU) 67 : * EST-CE SUFFISANT ?? 68 : * INTERR(1)=IPLRES 68 : * IF (IPLADE.NE.0.AND.IPLRES.LT.IPLADE) CALL ERREUR(436) 69 : * restauration de nomlu 70 : NOMLU=NOMLUS 71 : C * attention aux assistants .... 72 : if (NBESC.NE.0) then 73 : C * il faut liberer le segment de dialogue 74 : mestra=imestr 75 : * repasser en mode normal 75 : call ooofrc(0) 76 : SEGDES MESTRA 77 : * lodesl=.false. 77 : call setass(0) 78 : end if 79 : C JYY 80 : SEGDES MCOORD 81 : END 82 : 83 : 84 : 85 : 86 : 87 : 88 : 89 : 90 :
© Cast3M 2003 - All rights reserved.
Disclaimer