1 : C ASSIST SOURCE PV 11/04/15 21:15:01 6945 2 : C operateur assistant 3 : C 4 : SUBROUTINE ASSIST(irtous) 5 : IMPLICIT INTEGER(I-N) 6 : -INC CCOPTIO 7 : -INC CCNOYAU 8 : -INC SMTABLE 9 : -INC SMLMOTS 10 : -INC CCASSIS 11 : -INC SMCOORD 12 : character*8 ityp,mparam,typobj 13 : logical ilog 14 : real*8 reel 15 : character*72 chaine 16 : logical LOGIN,LOGRE 17 : character*72 CHARIN,CHARRE 18 : real*8 XVALIN,XVALRE 19 : * 20 : C logique pour l option TOUS 21 : logical LOTOUS 22 : C integer pour existence de table esclave (pointe sur table esclave) 23 : integer ITABESC 24 : C table de stockage du numero des assistants 25 : integer ITABASS(16384) 26 : C nombre total d operations a distribue 27 : integer inbass 28 : C table de stockage des tables resultats 29 : integer itabres(20) 30 : ITABESC = 0 31 : inbass = 0 32 : * 33 : * lecture du n° de process ou de l option tous 34 : * 35 : * l'opti assi a-t-il été défini ? non ? pas un probleme - PV 36 : * if (.not. LODEFE) then 37 : C JYY print*,'pas d''assistants déclarés !!!!' 37 : * CALL ERREUR (893) 38 : * return 39 : * end if 40 : 40 : call quetyp(ityp,0,iretou) 41 : if (iretou.eq.0) then 42 : C JYY print*,'erreur de syntaxe dans l operateur' 42 : CALL ERREUR ( 880 ) 43 : return 44 : end if 45 : if(irtous.eq.0) then 46 : if (ityp .EQ. 'MOT ') then 46 : call lircha(mparam,1,iretou) 47 : if (mparam.EQ.'TOUS ') then 48 : LOTOUS = .TRUE. 49 : else 50 : C JYY print*,'erreur de syntaxe dans l operateur' 50 : CALL ERREUR ( 880 ) 51 : return 52 : end if 53 : else 54 : LOTOUS = .FALSE. 54 : call lirent(iproc0,1,iretou) 55 : if (iproc0.eq.0) iproc0=1 56 : end if 57 : else 58 : LOTOUS=.TRUE. 59 : endif 60 : * pv si on n'a pas d'assistants, on rend la main 61 : if (nbesc.eq.0) return 62 : C 63 : C Prevenir les instructions qu l'on est dans l'assistant 64 : * LODESL = .TRUE. 64 : call setass(1) 65 : C pour la trace des erreurs 65 : CALL ANABAC 66 : * Lecture de la pile 67 : * ------------------ 68 : segini mescla 69 : mescl1 = mescla 70 : jjjerr = 0 71 : 72 : * mettre les operandes 73 : * On va utiliser esoplu pour determiner la position des tables ESCLAVE 74 : do 5 iop=1,100 75 : esoplu(iop)=.true. 76 : 5 continue 77 : do 10 iop=1,90 77 : call quetyp(ityp,0,iretou) 78 : if (iretou.eq.0) goto 11 79 : esoplu(iop+10)=.false. 80 : esopty(iop+10)=ityp 81 : if (ityp.eq.'LOGIQUE ') then 81 : call lirlog(ilog,1,iretou) 82 : esoplo(iop+10)=ilog 83 : elseif(ityp.eq.'FLOTTANT') then 83 : call lirree(reel,1,iretou) 84 : esopre(iop+10)=reel 85 : elseif (ityp.eq.'MOT ') then 85 : call lircha(chaine,1,iretou) 86 : esopch(iop+10)=chaine 87 : esopva(iop+10)=iretou 88 : else 89 : * cas des objets 89 : call lirobj(ityp,iob,1,iretou) 90 : esopva(iop+10)=iob 91 : IF (ityp .EQ. 'TABLE ') then 92 : * recherche du sous type 93 : typobj = ' ' 93 : call acctab(iob,'MOT ',IVALIN,XVALIN,'SOUSTYPE', 94 : & LOGIN,IOBIN,typobj,IVALRE,XVALRE,CHARRE, 95 : & LOGRE,IOBRE) 96 : if ((typobj .EQ. 'MOT ') .AND. 97 : & (CHARRE .EQ. 'ESCLAVE')) then 98 : esoplu(iop+10) = .true. 99 : ITABESC = iob 100 : end if 101 : END IF 102 : endif 103 : 10 continue 104 : 11 continue 105 : * sauvegarde du nombre d arguments 106 : inbargu = iop-1 107 : * 108 : * recherche de la liste des assistants sur lesquels il faut 109 : * envoyer les donnees 110 : * 111 : if (LOTOUS) then 112 : if (ITABESC .NE. 0) then 113 : mtable = ITABESC 114 : segact mtable 115 : C il faut retenir tous les indices entiers 116 : indtot = mlotab 117 : do 30 ind=1,indtot 118 : if (MTABTI(ind) .EQ. 'ENTIER ') then 119 : inbass = inbass + 1 120 : itabass(inbass) = MTABII(ind) 121 : end if 122 : 30 continue 123 : segdes mtable 124 : else 125 : CC print*,'pas de tables esclaves !!' 126 : CC print*,'envoie sur tous les assistants et sur le maitre' 127 : ** inbass = nbesc+1 128 : ** do 32 j=1,inbass 129 : ** itabass(j)=j-1 130 : ** 32 continue 131 : * pv on laisse tomber le maitre pour le moment 132 : inbass=nbesc 133 : end if 134 : else 135 : inbass = 1 136 : 137 : 138 : itabass(1)=iproc0 139 : end if 140 : * COMPTE DES RESULTATS ET CREATION DES TABLES 141 : *-------------------------------------------- 142 : * combien de résultats ? 143 : * il faut compter correctement les tables 144 : * on ne crée pas d'objets temporaires 145 : nbnomr=nbnom 146 : do 50 inom=1,nbnom 147 : ipos=ITANO1(inom) 148 : if (INOOB2(ITANO1(inom)).eq.'SEPARATE') nbnomr=nbnomr-2 149 : 50 continue 150 : if (LOTOUS) then 151 : do 51 inbres=1,nbnomr 151 : call crtabl(itabres(inbres)) 151 : call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN, 152 : & 'SOUSTYPE',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE, 153 : & 'ESCLAVE',LOGRE,IOBRE) 153 : call ecrobj('TABLE ',itabres(inbres)) 154 : 51 continue 155 : end if 156 : * 157 : * EXPEDITION DES DONNEES 158 : *----------------------- 159 : * on va enoyer l'instruction sur l'assistant itabass(inbass) 160 : 1122 continue 161 : iproc0 = itabass(inbass) 162 : if (nbesc .eq. 0) then 163 : iproc = 0 164 : else 165 : iproc = mod(iproc0-1,nbesc)+1 166 : end if 167 : if (iproc .eq.0) LOTRMA = .true. 168 : if (inbass .ne. 0) then 169 : segini, mescla=mescl1 170 : MLMOTS = ipcar1 171 : segini, MLMOT1=MLMOTS 172 : segdes MLMOT1,MLMOTS 173 : jpcar1 = MLMOT1 174 : else 175 : mescla = mescl1 176 : end if 177 : 178 : mesins=mescl(iproc) 179 : * write (6,*) ' assist iproc mescl(iproc) ',iproc,mescl(iproc) 180 : SEGACT MESINS*MOD 181 : NINS = lismes(/1) 182 : IF ( nbins .eq. nins) then 183 : nins = nins + 5 184 : segadj MESINS 185 : END IF 186 : NBINS = NBINS + 1 187 : C JYY print*, 'NBINS,iproc,mescla' , NBINS , iproc, mescla 187 : *** call savseg ( mescla ) 188 : LISMES(NBINS) = MESCLA 189 : SEGDES MESINS*RECORD 190 : * decryptage des tables esclaves 191 : if (ITABESC .NE. 0) then 192 : do 130 iop=1,inbargu 193 : if (esoplu(iop+10)) then 194 : itab = esopva(iop+10) 195 : typobj = ' ' 195 : call acctab(itab,'ENTIER ',iproc0,XVALIN,CHARIN, 196 : & LOGIN,IOBIN,typobj,IVALRE,XVALRE,CHARRE, 197 : & LOGRE,IOBRE) 198 : if (typobj .ne. ' ') then 199 : esoplu(iop+10) = .false. 200 : esopty(iop+10)=typobj 201 : if (typobj .eq. 'ENTIER ') then 202 : esopva(iop+10)=IVALRE 203 : elseif (typobj .eq. 'LOGIQUE ') then 204 : esoplo(iop+10)=LOGRE 205 : elseif (typobj .eq. 'FLOTTANT') then 206 : esopre(iop+10)=XVALRE 207 : elseif (typobj .eq. 'MOT ') then 208 : esopch(iop+10)=CHARRE 209 : esopva(iop+10)=len(CHARRE) 210 : else 211 : esopva(iop+10)=IOBRE 212 : end if 213 : else 214 : C JYY print*,'assistant non repertorie dans la table ESCLAVE' 215 : interr(1)=iproc0 215 : CALL ERREUR (914) 216 : end if 217 : end if 218 : 130 continue 219 : end if 220 : 221 : * on colle les resultats 222 : do 140 inom=1,nbnomr 223 : segini mesres 224 : ESIERR = 0 225 : LOREMP = .FALSE. 226 : segini nesres 227 : if (iproc.ne.0) then 228 : * write (6,*) ' assist segdes record nesres ',nesres 229 : segdes nesres*record 230 : else 231 : * write (6,*) ' assist segdes nesres ',nesres 232 : segdes nesres 233 : endif 234 : IESRES = nesres 235 : esrees(nbnomr-inom+1)=mesres 236 : segdes mesres 237 : if (LOTOUS) then 237 : call ecctab(itabres(inom),'ENTIER ',iproc0,XVALIN, 238 : & CHARIN,LOGIN,IOBIN,'ESCLAVE ',IVALRE,XVALRE, 239 : & CHARRE,LOGRE,mesres) 240 : else 240 : call ecrobj('ESCLAVE ',mesres) 241 : end if 242 : 140 continue 243 : do 150 inom=nbnomr+1,100 244 : esrees(inom)=0 245 : 150 continue 246 : * transfert du mescla 247 : segdes mescla 248 : 249 : 250 : * passage a l assistant suivant si necessaire 251 : if (inbass .ne. 1) then 252 : inbass = inbass-1 253 : goto 1122 254 : end if 255 : ** 256 : 257 : ** LODESL = .FALSE. 257 : call setass(0) 258 : return 259 : end 260 : 261 : 262 : 263 : 264 : 265 : 266 : 267 : 268 : 269 : 270 :
© Cast3M 2003 - All rights reserved.
Disclaimer