C NOUINS2 SOURCE CHAT 12/03/26 21:15:15 7335 C nouins version esclave C SUBROUTINE NOUINS2 IMPLICIT INTEGER(I-N) -INC CCASSIS -INC CCOPTIO -INC CCNOYAU -INC SMCOORD -INC SMLMOTS logical ilog , LLLERR real*8 reel character*72 chaine character*8 ityp * * initialisation de lotesc ith=0 call ooonth(ith) call ooohor(0,ith) * write (6,*) ' dans nouins2 ',ith if ((ith.eq.0) .and. lotrma) then call erreur(5) * le maitre travaille comme un assistant mesins = mescl(ith) mestra = imestr lotrma = .false. lotesc = .true. goto 3457 end if * mescla = imescl(ith) mestra = imestr mesins = mescl(ith) * est on en situation d'erreur???? merres = ierres segact merres LLLERR = LOSIER segdes merres * mettre les resultats dans la pile de l'esclave IIRES = 0 do 10 iop=1,90 call quetyp(ityp,0,iretou) if (iretou.eq.0) goto 11 IIRES = IIRES + 1 mesres=esrees(iop) if (mesres.eq.0) then moterr(1:8) = ityp moterr(9:16) = ' ' call erreur(11) goto 11 end if * Il faut activer mesres avant nesres pour eviter des problemes * d'interferences et de validiter de LOREMP if (iimpi .eq. 1234) write(ioimp,*) 'mise a jour de',mesres segact mesres*mod nesres = iesres segact nesres*mod LOREMP = .TRUE. esrety=ityp if (ityp.eq.'LOGIQUE ') then call lirlog(ilog,1,iretou) esrelo=ilog elseif(ityp.eq.'FLOTTANT') then call lirree(reel,1,iretou) esrere=reel elseif (ityp.eq.'MOT ') then call lircha(chaine,1,iretou) esrech=chaine else call lirobj(ityp,iob,1,iretou) esreva=iob endif ****** CJY if (ith.ne.0) then segdes nesres*record else segdes nesres endif segdes mesres 10 continue 11 continue * en situation d'erreur on genere des objets de type ANNULE IF ( LLLERR ) IIRES = 0 C - C - il faut verifier si il ne reste pas d'objets ESCLAVE dans la pile DO II = IIRES+1 , 90 MESRES = esrees(II) IF ( MESRES .EQ. 0 ) THEN GO TO 4321 ELSE SEGACT MESRES*MOD nesres = iesres SEGACT NESRES*MOD LOREMP = .TRUE. ESRETY = 'ANNULE ' ESIERR = JJJERR if (ith.ne.0) then SEGDES NESRES*RECORD else SEGDES NESRES endif SEGDES MESRES END IF END DO 4321 CONTINUE * Y a t il eu une erreur ? MLMOT1 = jpcar1 IF ( JJJERR .NE. 0 .OR. LLLERR ) THEN C JYYY segact mesins merres = ierres segact merres*mod NERR = liserr(/2) IF ( NBERR .eq. NERR) then NERR = NERR + 2 segadj merres END IF NBERR = NBERR + 1 LISERR(1,NBERR) = JJJERR LISERR(2,NBERR) = MLMOT1 LISERR(3,NBERR) = ith segdes mlmot1 C JYYY segdes mesins*record segdes merres ELSE SEGSUP MLMOT1 END IF ** plus utile menage travaille correctement sur les mescla *** CALL LIBSEG ( mescla ) SEGSUP mescla segdes mcoord * recherche d une nouvelle instruction segact mesins*mod INSCOU = 0 3456 CONTINUE * write (6,*) ' ith nbins dans nouins2 ',ith,nbins IF ( NBINS .EQ. 0 ) THEN if (inass .eq. 0) then * write(6,*) 'nouins2, on ne doit pas passer la ' lotesc = .false. * write (6,*) ' desactivation mesins ith ',mesins,ith segdes mestra segdes mesins*record return else if (iospi .ne. 0) & write(ioimp,*) ' il faut attendre une instruction' SEGDES MESINS*RECORD * write (6,*) ' activation mesins ith ',mesins,ith segdes mestra SEGACT MESINS*(MOD,ECR=1) segact mestra * menage a peut-etre desactive mesins le temps que mestra soit accessible SEGACT MESINS*(MOD,ECR=1) GOTO 3456 endif END IF *------------ 3457 continue * est on en situation d'erreur???? merres = ierres segact merres LLLERR = LOSIER segdes merres ** print*, ' il y a du travail a faire, NBINS =', NBINS mescla = LISMES(1) imescl(ith) = mescla INSCOU = MESCLA NBINS = NBINS - 1 IF ( NBINS .NE. 0 ) THEN do i = 1 , NBINS lismes(i) = lismes(i+1) end do END IF lismes (NBINS+1) = 0 SEGDES MESINS*RECORD ** segact mescla*(mod) ** ierr=0 segdes mescla ***** segact mestra segact mescla*(mod) return end