1 : C NOUINS2 SOURCE CHAT 12/03/26 21:15:15 7335 2 : C nouins version esclave 3 : C 4 : SUBROUTINE NOUINS2 5 : IMPLICIT INTEGER(I-N) 6 : -INC CCASSIS 7 : -INC CCOPTIO 8 : -INC CCNOYAU 9 : -INC SMCOORD 10 : -INC SMLMOTS 11 : logical ilog , LLLERR 12 : real*8 reel 13 : character*72 chaine 14 : character*8 ityp 15 : * 16 : * initialisation de lotesc 17 : ith=0 17 : call ooonth(ith) 17 : call ooohor(0,ith) 18 : * write (6,*) ' dans nouins2 ',ith 19 : if ((ith.eq.0) .and. lotrma) then 19 : call erreur(5) 20 : * le maitre travaille comme un assistant 21 : mesins = mescl(ith) 22 : mestra = imestr 23 : lotrma = .false. 24 : lotesc = .true. 25 : goto 3457 26 : end if 27 : * 28 : mescla = imescl(ith) 29 : mestra = imestr 30 : mesins = mescl(ith) 31 : * est on en situation d'erreur???? 32 : merres = ierres 33 : segact merres 34 : LLLERR = LOSIER 35 : segdes merres 36 : * mettre les resultats dans la pile de l'esclave 37 : IIRES = 0 38 : do 10 iop=1,90 38 : call quetyp(ityp,0,iretou) 39 : if (iretou.eq.0) goto 11 40 : IIRES = IIRES + 1 41 : mesres=esrees(iop) 42 : if (mesres.eq.0) then 43 : moterr(1:8) = ityp 44 : moterr(9:16) = ' ' 44 : call erreur(11) 45 : goto 11 46 : end if 47 : * Il faut activer mesres avant nesres pour eviter des problemes 48 : * d'interferences et de validiter de LOREMP 49 : if (iimpi .eq. 1234) write(ioimp,*) 'mise a jour de',mesres 50 : segact mesres*mod 51 : nesres = iesres 52 : segact nesres*mod 53 : LOREMP = .TRUE. 54 : esrety=ityp 55 : if (ityp.eq.'LOGIQUE ') then 55 : call lirlog(ilog,1,iretou) 56 : esrelo=ilog 57 : elseif(ityp.eq.'FLOTTANT') then 57 : call lirree(reel,1,iretou) 58 : esrere=reel 59 : elseif (ityp.eq.'MOT ') then 59 : call lircha(chaine,1,iretou) 60 : esrech=chaine 61 : else 61 : call lirobj(ityp,iob,1,iretou) 62 : esreva=iob 63 : endif 64 : ****** CJY 65 : if (ith.ne.0) then 66 : segdes nesres*record 67 : else 68 : segdes nesres 69 : endif 70 : segdes mesres 71 : 10 continue 72 : 11 continue 73 : * en situation d'erreur on genere des objets de type ANNULE 74 : IF ( LLLERR ) IIRES = 0 75 : C - 76 : C - il faut verifier si il ne reste pas d'objets ESCLAVE dans la pile 77 : DO II = IIRES+1 , 90 78 : MESRES = esrees(II) 79 : IF ( MESRES .EQ. 0 ) THEN 80 : GO TO 4321 81 : ELSE 82 : SEGACT MESRES*MOD 83 : nesres = iesres 84 : SEGACT NESRES*MOD 85 : LOREMP = .TRUE. 86 : ESRETY = 'ANNULE ' 87 : ESIERR = JJJERR 88 : if (ith.ne.0) then 89 : SEGDES NESRES*RECORD 90 : else 91 : SEGDES NESRES 92 : endif 93 : SEGDES MESRES 94 : END IF 95 : END DO 96 : 4321 CONTINUE 97 : * Y a t il eu une erreur ? 98 : MLMOT1 = jpcar1 99 : IF ( JJJERR .NE. 0 .OR. LLLERR ) THEN 100 : C JYYY segact mesins 101 : merres = ierres 102 : segact merres*mod 103 : NERR = liserr(/2) 104 : IF ( NBERR .eq. NERR) then 105 : NERR = NERR + 2 106 : segadj merres 107 : END IF 108 : NBERR = NBERR + 1 109 : LISERR(1,NBERR) = JJJERR 110 : LISERR(2,NBERR) = MLMOT1 111 : LISERR(3,NBERR) = ith 112 : segdes mlmot1 113 : C JYYY segdes mesins*record 114 : segdes merres 115 : ELSE 116 : SEGSUP MLMOT1 117 : END IF 118 : ** plus utile menage travaille correctement sur les mescla 118 : *** CALL LIBSEG ( mescla ) 119 : SEGSUP mescla 120 : segdes mcoord 121 : * recherche d une nouvelle instruction 122 : segact mesins*mod 123 : INSCOU = 0 124 : 3456 CONTINUE 125 : 126 : * write (6,*) ' ith nbins dans nouins2 ',ith,nbins 127 : IF ( NBINS .EQ. 0 ) THEN 128 : if (inass .eq. 0) then 129 : * write(6,*) 'nouins2, on ne doit pas passer la ' 130 : lotesc = .false. 131 : * write (6,*) ' desactivation mesins ith ',mesins,ith 132 : segdes mestra 133 : segdes mesins*record 134 : return 135 : else 136 : if (iospi .ne. 0) 137 : & write(ioimp,*) ' il faut attendre une instruction' 138 : SEGDES MESINS*RECORD 139 : * write (6,*) ' activation mesins ith ',mesins,ith 140 : segdes mestra 141 : SEGACT MESINS*(MOD,ECR=1) 142 : segact mestra 143 : * menage a peut-etre desactive mesins le temps que mestra soit accessible 144 : SEGACT MESINS*(MOD,ECR=1) 145 : GOTO 3456 146 : endif 147 : END IF 148 : *------------ 149 : 3457 continue 150 : * est on en situation d'erreur???? 151 : merres = ierres 152 : segact merres 153 : LLLERR = LOSIER 154 : segdes merres 155 : ** print*, ' il y a du travail a faire, NBINS =', NBINS 156 : mescla = LISMES(1) 157 : imescl(ith) = mescla 158 : INSCOU = MESCLA 159 : NBINS = NBINS - 1 160 : IF ( NBINS .NE. 0 ) THEN 161 : do i = 1 , NBINS 162 : lismes(i) = lismes(i+1) 163 : end do 164 : END IF 165 : lismes (NBINS+1) = 0 166 : SEGDES MESINS*RECORD 167 : ** segact mescla*(mod) 168 : ** ierr=0 169 : segdes mescla 170 : ***** segact mestra 171 : segact mescla*(mod) 172 : return 173 : end 174 : 175 : 176 : 177 : 178 : 179 : 180 : 181 : 182 : 183 : 184 :
© Cast3M 2003 - All rights reserved.
Disclaimer