C ASSIST SOURCE PV 11/04/15 21:15:01 6945 C operateur assistant C SUBROUTINE ASSIST(irtous) IMPLICIT INTEGER(I-N) -INC CCOPTIO -INC CCNOYAU -INC SMTABLE -INC SMLMOTS -INC CCASSIS -INC SMCOORD character*8 ityp,mparam,typobj logical ilog real*8 reel character*72 chaine logical LOGIN,LOGRE character*72 CHARIN,CHARRE real*8 XVALIN,XVALRE * C logique pour l option TOUS logical LOTOUS C integer pour existence de table esclave (pointe sur table esclave) integer ITABESC C table de stockage du numero des assistants integer ITABASS(16384) C nombre total d operations a distribue integer inbass C table de stockage des tables resultats integer itabres(20) ITABESC = 0 inbass = 0 * * lecture du n° de process ou de l option tous * * l'opti assi a-t-il été défini ? non ? pas un probleme - PV * if (.not. LODEFE) then C JYY print*,'pas d''assistants déclarés !!!!' * CALL ERREUR (893) * return * end if call quetyp(ityp,0,iretou) if (iretou.eq.0) then C JYY print*,'erreur de syntaxe dans l operateur' CALL ERREUR ( 880 ) return end if if(irtous.eq.0) then if (ityp .EQ. 'MOT ') then call lircha(mparam,1,iretou) if (mparam.EQ.'TOUS ') then LOTOUS = .TRUE. else C JYY print*,'erreur de syntaxe dans l operateur' CALL ERREUR ( 880 ) return end if else LOTOUS = .FALSE. call lirent(iproc0,1,iretou) if (iproc0.eq.0) iproc0=1 end if else LOTOUS=.TRUE. endif * pv si on n'a pas d'assistants, on rend la main if (nbesc.eq.0) return C C Prevenir les instructions qu l'on est dans l'assistant * LODESL = .TRUE. call setass(1) C pour la trace des erreurs CALL ANABAC * Lecture de la pile * ------------------ segini mescla mescl1 = mescla jjjerr = 0 * mettre les operandes * On va utiliser esoplu pour determiner la position des tables ESCLAVE do 5 iop=1,100 esoplu(iop)=.true. 5 continue do 10 iop=1,90 call quetyp(ityp,0,iretou) if (iretou.eq.0) goto 11 esoplu(iop+10)=.false. esopty(iop+10)=ityp if (ityp.eq.'LOGIQUE ') then call lirlog(ilog,1,iretou) esoplo(iop+10)=ilog elseif(ityp.eq.'FLOTTANT') then call lirree(reel,1,iretou) esopre(iop+10)=reel elseif (ityp.eq.'MOT ') then call lircha(chaine,1,iretou) esopch(iop+10)=chaine esopva(iop+10)=iretou else * cas des objets call lirobj(ityp,iob,1,iretou) esopva(iop+10)=iob IF (ityp .EQ. 'TABLE ') then * recherche du sous type typobj = ' ' call acctab(iob,'MOT ',IVALIN,XVALIN,'SOUSTYPE', & LOGIN,IOBIN,typobj,IVALRE,XVALRE,CHARRE, & LOGRE,IOBRE) if ((typobj .EQ. 'MOT ') .AND. & (CHARRE .EQ. 'ESCLAVE')) then esoplu(iop+10) = .true. ITABESC = iob end if END IF endif 10 continue 11 continue * sauvegarde du nombre d arguments inbargu = iop-1 * * recherche de la liste des assistants sur lesquels il faut * envoyer les donnees * if (LOTOUS) then if (ITABESC .NE. 0) then mtable = ITABESC segact mtable C il faut retenir tous les indices entiers indtot = mlotab do 30 ind=1,indtot if (MTABTI(ind) .EQ. 'ENTIER ') then inbass = inbass + 1 itabass(inbass) = MTABII(ind) end if 30 continue segdes mtable else CC print*,'pas de tables esclaves !!' CC print*,'envoie sur tous les assistants et sur le maitre' ** inbass = nbesc+1 ** do 32 j=1,inbass ** itabass(j)=j-1 ** 32 continue * pv on laisse tomber le maitre pour le moment inbass=nbesc end if else inbass = 1 itabass(1)=iproc0 end if * COMPTE DES RESULTATS ET CREATION DES TABLES *-------------------------------------------- * combien de résultats ? * il faut compter correctement les tables * on ne crée pas d'objets temporaires nbnomr=nbnom do 50 inom=1,nbnom ipos=ITANO1(inom) if (INOOB2(ITANO1(inom)).eq.'SEPARATE') nbnomr=nbnomr-2 50 continue if (LOTOUS) then do 51 inbres=1,nbnomr call crtabl(itabres(inbres)) call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN, & 'SOUSTYPE',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE, & 'ESCLAVE',LOGRE,IOBRE) call ecrobj('TABLE ',itabres(inbres)) 51 continue end if * * EXPEDITION DES DONNEES *----------------------- * on va enoyer l'instruction sur l'assistant itabass(inbass) 1122 continue iproc0 = itabass(inbass) if (nbesc .eq. 0) then iproc = 0 else iproc = mod(iproc0-1,nbesc)+1 end if if (iproc .eq.0) LOTRMA = .true. if (inbass .ne. 0) then segini, mescla=mescl1 MLMOTS = ipcar1 segini, MLMOT1=MLMOTS segdes MLMOT1,MLMOTS jpcar1 = MLMOT1 else mescla = mescl1 end if mesins=mescl(iproc) * write (6,*) ' assist iproc mescl(iproc) ',iproc,mescl(iproc) SEGACT MESINS*MOD NINS = lismes(/1) IF ( nbins .eq. nins) then nins = nins + 5 segadj MESINS END IF NBINS = NBINS + 1 C JYY print*, 'NBINS,iproc,mescla' , NBINS , iproc, mescla *** call savseg ( mescla ) LISMES(NBINS) = MESCLA SEGDES MESINS*RECORD * decryptage des tables esclaves if (ITABESC .NE. 0) then do 130 iop=1,inbargu if (esoplu(iop+10)) then itab = esopva(iop+10) typobj = ' ' call acctab(itab,'ENTIER ',iproc0,XVALIN,CHARIN, & LOGIN,IOBIN,typobj,IVALRE,XVALRE,CHARRE, & LOGRE,IOBRE) if (typobj .ne. ' ') then esoplu(iop+10) = .false. esopty(iop+10)=typobj if (typobj .eq. 'ENTIER ') then esopva(iop+10)=IVALRE elseif (typobj .eq. 'LOGIQUE ') then esoplo(iop+10)=LOGRE elseif (typobj .eq. 'FLOTTANT') then esopre(iop+10)=XVALRE elseif (typobj .eq. 'MOT ') then esopch(iop+10)=CHARRE esopva(iop+10)=len(CHARRE) else esopva(iop+10)=IOBRE end if else C JYY print*,'assistant non repertorie dans la table ESCLAVE' interr(1)=iproc0 CALL ERREUR (914) end if end if 130 continue end if * on colle les resultats do 140 inom=1,nbnomr segini mesres ESIERR = 0 LOREMP = .FALSE. segini nesres if (iproc.ne.0) then * write (6,*) ' assist segdes record nesres ',nesres segdes nesres*record else * write (6,*) ' assist segdes nesres ',nesres segdes nesres endif IESRES = nesres esrees(nbnomr-inom+1)=mesres segdes mesres if (LOTOUS) then call ecctab(itabres(inom),'ENTIER ',iproc0,XVALIN, & CHARIN,LOGIN,IOBIN,'ESCLAVE ',IVALRE,XVALRE, & CHARRE,LOGRE,mesres) else call ecrobj('ESCLAVE ',mesres) end if 140 continue do 150 inom=nbnomr+1,100 esrees(inom)=0 150 continue * transfert du mescla segdes mescla * passage a l assistant suivant si necessaire if (inbass .ne. 1) then inbass = inbass-1 goto 1122 end if ** ** LODESL = .FALSE. call setass(0) return end