C ASSIST SOURCE SP204843 26/02/03 21:15:05 12461 C operateur assistant C SUBROUTINE ASSIST(irtous) IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC CCNOYAU -INC SMTABLE -INC SMLMOTS -INC CCASSIS -INC SMCOORD -INC SMBLOC -INC SMLOBJE character*8 ityp,mparam,typob,TYPLOB logical ilog,BMAXI,BMINI,bsouc real*8 reel character*(LOCHAI) chaine,CHARIN,CHARRE logical LOGIN,LOGRE real*8 XVALIN,XVALRE C 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 C SP 2016 : on cree un segment pour ne plus avoir de limitation C sur le nombnre d'assistants par la taille du tableau SEGMENT TABASSI integer ITABASS(NASS) ENDSEGMENT C nombre total d operations a distribue integer inbass C table de stockage des tables resultats integer itabres(20) BMAXI = .FALSE. BMINI = .FALSE. Bsouc = .FALSE. ITABESC = 0 ILISTOB = 0 inbass = 0 C* test si assistants deja demarres. Sion on les demarre if (nbesc.eq.0.and.nbescr.ne.0) then call iniass(nbescr) nbesc=nbescr endif C C lecture du n° de process ou de l option tous C C l'opti assi a-t-il été défini ? non ? pas un probleme - PV C if (.not. LODEFE) then C JYY print*,'pas d''assistants déclarés !!!!' C CALL ERREUR (893) C return C 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 C 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 C LODESL = .TRUE. call setass(1) C pour la trace des erreurs CALL ANABAC C Lecture de la pile C ------------------ segini mescla mescl1 = mescla jjjerr = 0 C mettre les operandes C 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 if (chaine.eq.'MAXI ') then bmaxi=.TRUE. elseif (chaine.eq.'MINI ') then bmini=.TRUE. elseif (chaine(1:4).eq.'SOUC') then bsouc=.TRUE. endif else C cas des objets call lirobj(ityp,iob,1,iretou) C write(6,*) 'ASSIST : ityp =',ityp esopva(iop+10)=iob IF (ityp .EQ. 'TABLE ') then C recherche du sous type typob = ' ' call acctab(iob,'MOT ',IVALIN,XVALIN,'SOUSTYPE',LOGIN, & IOBIN,typob,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) if ((typob .EQ. 'MOT ') .AND. & (CHARRE .EQ. 'ESCLAVE')) then esoplu(iop+10) = .true. ITABESC = iob endif else if (ityp .EQ. 'LISTOBJE') then esoplu(iop+10) = .true. ILISTOB = iob ENDIF endif 10 continue 11 continue C sauvegarde du nombre d arguments inbargu = iop-1 C C recherche de la liste des assistants sur lesquels il faut C envoyer les donnees C IK = 0 TYPLOB = ' ' if (LOTOUS) then if (ITABESC .NE. 0) then C write(6,*) 'ASSIST: ITABESC=',ITABESC mtable = ITABESC segact mtable C il faut retenir tous les indices entiers indtot = mlotab NASS=indtot SEGINI,TABASSI do 30 ind=1,indtot if (MTABTI(ind) .EQ. 'ENTIER ') then inbass = inbass + 1 itabass(inbass) = MTABII(ind) end if 30 continue NASS=inbass C SP On n'ajuste pas car le cout en place est marginal C SP au regard du cout en temps d'execution C SP SEGADJ,TABASSI C** segdes mtable else if (ILISTOB .NE. 0) then MLOBJE = ILISTOB SEGACT, MLOBJE TYPLOB = TYPOBJ IK = 1 IF (TYPLOB.EQ.'FLOTTANT') IK = 2 IF (IK.EQ.1) indtot = LISOBJ(/1) IF (IK.EQ.2) indtot = RLIREE(/1) C write(6,*) 'ASSIST: MLOBJE, TYPOBJ, NOBJ=',MLOBJE,TYPOBJ,indtot NASS=indtot SEGINI,TABASSI do 40 ind=1,indtot itabass(ind) = ind C write(6,*) 'ASSIST: ind, itabass(ind)=',ind,itabass(ind) 40 continue else CC print*,'pas de tables esclaves !!' CC print*,'envoie sur tous les assistants et sur le maitre' C* inbass = nbesc+1 C* do 32 j=1,inbass C* itabass(j)=j-1 C* 32 continue C pv on laisse tomber le maitre pour le moment NASS=nbesc SEGINI,TABASSI do ind=1,NASS itabass(ind)=ind enddo end if else NASS = 1 SEGINI,TABASSI itabass(1)=iproc0 end if inbass=NASS C COMPTE DES RESULTATS ET CREATION DES TABLES C-------------------------------------------- C combien de résultats ? C il faut compter correctement les tables C 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 if (ILISTOB .NE. 0) THEN IF (IK.EQ.0) THEN write(iimpi,*) 'Dans assist' CALL ERREUR(5) RETURN ENDIF NOBJ = 0 NREE = 0 IF (IK.EQ.1) NOBJ = NASS IF (IK.EQ.2) NREE = NASS SEGINI, MLOBJ1 itabres(inbres) = MLOBJ1 C write(6,*) 'ASSIST : MLOBJ1=',MLOBJ1 call ecrobj('LISTOBJE',MLOBJ1) else call crtabl(itabres(inbres)) call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN, & 'SOUSTYPE',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE, & 'ESCLAVE',LOGRE,IOBRE) if (bmaxi) then call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN, & 'CREATEUR',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE, & 'MAXI ',LOGRE,IOBRE) elseif (bmini) then call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN, & 'CREATEUR',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE, & 'MINI ',LOGRE,IOBRE) elseif (bsouc) then call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN, & 'CREATEUR',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE, & 'SOUC ',LOGRE,IOBRE) else call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN, & 'CREATEUR',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE, & 'ASSIST ',LOGRE,IOBRE) endif call ecrobj('TABLE ',itabres(inbres)) endif 51 continue end if C C EXPEDITION DES DONNEES C----------------------- C 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) 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 C** call savseg ( mescla ) LISMES(NBINS) = MESCLA SEGDES MESINS*RECORD C decryptage des tables esclaves if (ITABESC .NE. 0) then do 130 iop=1,inbargu C write(6,*) 'ASSIST:esoplu(iop+10),inbargu=',esoplu(iop+10),inbargu if (esoplu(iop+10)) then itab = esopva(iop+10) C write(6,*) 'ASSIST: itab=',itab typob = ' ' call acctab(itab,'ENTIER ',iproc0,XVALIN,CHARIN, & LOGIN,IOBIN,typob,IVALRE,XVALRE,CHARRE, & LOGRE,IOBRE) if (typob .ne. ' ') then esoplu(iop+10) = .false. esopty(iop+10)=typob if (typob .eq. 'ENTIER ') then esopva(iop+10)=IVALRE elseif (typob .eq. 'LOGIQUE ') then esoplo(iop+10)=LOGRE elseif (typob .eq. 'FLOTTANT') then esopre(iop+10)=XVALRE elseif (typob .eq. 'MOT ') then esopch(iop+10)=CHARRE esopva(iop+10)=len(CHARRE) else C write(6,*) 'ASSIST: iproc0, typob, IOBRE=',iproc0,typob,IOBRE esopva(iop+10)=IOBRE end if else C JYY print*,'assistant non repertorie dans la table ESCLAVE' interr(1)=iproc0 CALL ERREUR (914) endif endif 130 continue else if (ILISTOB .NE. 0) then do 135 iop=1,inbargu C write(6,*) 'ASSIST:esoplu(iop+10),inbargu=',esoplu(iop+10),inbargu if (esoplu(iop+10)) then mlobj2 = esopva(iop+10) segact mlobj2 esoplu(iop+10) = .false. esopty(iop+10) = mlobj2.typobj ik = 1 if ((mlobj2.typobj).EQ.'FLOTTANT') ik = 2 if (ik.EQ.1) esopva(iop+10) = mlobj2.LISOBJ(iproc0) if (ik.EQ.2) esopre(iop+10) = mlobj2.RLIREE(iproc0) C write(6,*) 'ASSIST: iproc0,mlobj2, typobj=',iproc0,mlobj2, C & mlobj2.typobj endif 135 continue endif C on colle les resultats do 140 inom=1,nbnomr segini mesres LOREMP = .FALSE. if (iproc.ne.0) then C write (6,*) ' assist segdes record mesres ',mesres segdes mesres*record else C write (6,*) ' assist segdes mesres ',mesres segdes mesres endif esrees(nbnomr-inom+1)=mesres C write(6,*) 'ASSIST : iproc0,nbnomr, mesres=',iproc0,nbnomr,mesres if (LOTOUS) then if (ILISTOB .NE. 0) then mlobj1.typobj = 'ESCLAVE' mlobj1.lisobj(iproc0) = mesres else call ecctab(itabres(inom),'ENTIER ',iproc0,XVALIN, & CHARIN,LOGIN,IOBIN,'ESCLAVE ',IVALRE,XVALRE, & CHARRE,LOGRE,mesres) endif else call ecrobj('ESCLAVE ',mesres) endif 140 continue do 150 inom=nbnomr+1,100 esrees(inom)=0 150 continue C transfert du mescla segdes mescla C passage a l assistant suivant si necessaire if (inbass .ne. 1) then inbass = inbass-1 goto 1122 end if C suppression du segment TABASSI ? SEGSUP,TABASSI C* LODESL = .FALSE. call setass(0) end