Télécharger assist.eso

Retour à la liste

Numérotation des lignes :

assist
  1. C ASSIST SOURCE CB215821 24/07/17 21:15:04 11961
  2. C operateur assistant
  3. C
  4. SUBROUTINE ASSIST(irtous)
  5. IMPLICIT INTEGER(I-N)
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC CCNOYAU
  10. -INC SMTABLE
  11. -INC SMLMOTS
  12. -INC CCASSIS
  13. -INC SMCOORD
  14. -INC SMBLOC
  15. -INC SMLOBJE
  16.  
  17. character*8 ityp,mparam,typob,TYPLOB
  18. logical ilog,BMAXI,BMINI,bsouc
  19. real*8 reel
  20. character*(LOCHAI) chaine,CHARIN,CHARRE
  21. logical LOGIN,LOGRE
  22. real*8 XVALIN,XVALRE
  23. C
  24. C logique pour l option TOUS
  25. logical LOTOUS
  26. C integer pour existence de table esclave (pointe sur table esclave)
  27. integer ITABESC
  28. C table de stockage du numero des assistants
  29. C SP 2016 : on cree un segment pour ne plus avoir de limitation
  30. C sur le nombnre d'assistants par la taille du tableau
  31. SEGMENT TABASSI
  32. integer ITABASS(NASS)
  33. ENDSEGMENT
  34. C nombre total d operations a distribue
  35. integer inbass
  36. C table de stockage des tables resultats
  37. integer itabres(20)
  38. BMAXI = .FALSE.
  39. BMINI = .FALSE.
  40. Bsouc = .FALSE.
  41. ITABESC = 0
  42. ILISTOB = 0
  43. inbass = 0
  44. C* test si assistants deja demarres. Sion on les demarre
  45. if (nbesc.eq.0.and.nbescr.ne.0) then
  46. call iniass(nbescr)
  47. nbesc=nbescr
  48. endif
  49. C
  50. C lecture du n° de process ou de l option tous
  51. C
  52. C l'opti assi a-t-il été défini ? non ? pas un probleme - PV
  53. C if (.not. LODEFE) then
  54. C JYY print*,'pas d''assistants déclarés !!!!'
  55. C CALL ERREUR (893)
  56. C return
  57. C end if
  58.  
  59. call quetyp(ityp,0,iretou)
  60. if (iretou.eq.0) then
  61. C JYY print*,'erreur de syntaxe dans l operateur'
  62. CALL ERREUR ( 880 )
  63. return
  64. end if
  65. if(irtous.eq.0) then
  66. if (ityp .EQ. 'MOT ') then
  67. call lircha(mparam,1,iretou)
  68. if (mparam.EQ.'TOUS ') then
  69. LOTOUS = .TRUE.
  70. else
  71. C JYY print*,'erreur de syntaxe dans l operateur'
  72. CALL ERREUR ( 880 )
  73. return
  74. end if
  75. else
  76. LOTOUS = .FALSE.
  77. call lirent(iproc0,1,iretou)
  78. if (iproc0.eq.0) iproc0=1
  79. end if
  80. else
  81. LOTOUS=.TRUE.
  82. endif
  83. C pv si on n'a pas d'assistants, on rend la main
  84. if (nbesc.eq.0) return
  85. C
  86. C Prevenir les instructions qu l'on est dans l'assistant
  87. C LODESL = .TRUE.
  88. call setass(1)
  89. C pour la trace des erreurs
  90. CALL ANABAC
  91. C Lecture de la pile
  92. C ------------------
  93. segini mescla
  94. mescl1 = mescla
  95. jjjerr = 0
  96.  
  97. C mettre les operandes
  98. C On va utiliser esoplu pour determiner la position des tables ESCLAVE
  99. do 5 iop=1,100
  100. esoplu(iop)=.true.
  101. 5 continue
  102. do 10 iop=1,90
  103. call quetyp(ityp,0,iretou)
  104. if (iretou.eq.0) goto 11
  105. esoplu(iop+10)=.false.
  106. esopty(iop+10)=ityp
  107. if (ityp.eq.'LOGIQUE ') then
  108. call lirlog(ilog,1,iretou)
  109. esoplo(iop+10)=ilog
  110. elseif(ityp.eq.'FLOTTANT') then
  111. call lirree(reel,1,iretou)
  112. esopre(iop+10)=reel
  113. elseif (ityp.eq.'MOT ') then
  114. call lircha(chaine,1,iretou)
  115. esopch(iop+10)=chaine
  116. esopva(iop+10)=iretou
  117. if (chaine.eq.'MAXI ') then
  118. bmaxi=.TRUE.
  119. elseif (chaine.eq.'MINI ') then
  120. bmini=.TRUE.
  121. elseif (chaine(1:4).eq.'SOUC') then
  122. bsouc=.TRUE.
  123. endif
  124. else
  125. C cas des objets
  126. call lirobj(ityp,iob,1,iretou)
  127. C write(6,*) 'ASSIST : ityp =',ityp
  128. esopva(iop+10)=iob
  129. IF (ityp .EQ. 'TABLE ') then
  130. C recherche du sous type
  131. typob = ' '
  132. call acctab(iob,'MOT ',IVALIN,XVALIN,'SOUSTYPE',LOGIN,
  133. & IOBIN,typob,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  134. if ((typob .EQ. 'MOT ') .AND.
  135. & (CHARRE .EQ. 'ESCLAVE')) then
  136. esoplu(iop+10) = .true.
  137. ITABESC = iob
  138. endif
  139. else if (ityp .EQ. 'LISTOBJE') then
  140. esoplu(iop+10) = .true.
  141. ILISTOB = iob
  142. ENDIF
  143. endif
  144. 10 continue
  145. 11 continue
  146. C sauvegarde du nombre d arguments
  147. inbargu = iop-1
  148. C
  149. C recherche de la liste des assistants sur lesquels il faut
  150. C envoyer les donnees
  151. C
  152. if (LOTOUS) then
  153. if (ITABESC .NE. 0) then
  154. C write(6,*) 'ASSIST: ITABESC=',ITABESC
  155. mtable = ITABESC
  156. segact mtable
  157. C il faut retenir tous les indices entiers
  158. indtot = mlotab
  159. NASS=indtot
  160. SEGINI,TABASSI
  161. do 30 ind=1,indtot
  162. if (MTABTI(ind) .EQ. 'ENTIER ') then
  163. inbass = inbass + 1
  164. itabass(inbass) = MTABII(ind)
  165. end if
  166. 30 continue
  167. NASS=inbass
  168. C SP On n'ajuste pas car le cout en place est marginal
  169. C SP au regard du cout en temps d'execution
  170. C SP SEGADJ,TABASSI
  171. C** segdes mtable
  172. else if (ILISTOB .NE. 0) then
  173. MLOBJE = ILISTOB
  174. SEGACT, MLOBJE
  175. TYPLOB = TYPOBJ
  176. indtot = LISOBJ(/1)
  177. C write(6,*) 'ASSIST: MLOBJE, TYPOBJ, NOBJ=',MLOBJE,TYPOBJ,indtot
  178. NASS=indtot
  179. SEGINI,TABASSI
  180. do 40 ind=1,indtot
  181. itabass(ind) = ind
  182. C write(6,*) 'ASSIST: ind, itabass(ind)=',ind,itabass(ind)
  183. 40 continue
  184. else
  185. CC print*,'pas de tables esclaves !!'
  186. CC print*,'envoie sur tous les assistants et sur le maitre'
  187. C* inbass = nbesc+1
  188. C* do 32 j=1,inbass
  189. C* itabass(j)=j-1
  190. C* 32 continue
  191. C pv on laisse tomber le maitre pour le moment
  192. NASS=nbesc
  193. SEGINI,TABASSI
  194. do ind=1,NASS
  195. itabass(ind)=ind
  196. enddo
  197. end if
  198. else
  199. NASS = 1
  200. SEGINI,TABASSI
  201. itabass(1)=iproc0
  202. end if
  203. inbass=NASS
  204.  
  205.  
  206. C COMPTE DES RESULTATS ET CREATION DES TABLES
  207. C--------------------------------------------
  208. C combien de résultats ?
  209. C il faut compter correctement les tables
  210. C on ne crée pas d'objets temporaires
  211. nbnomr=nbnom
  212. do 50 inom=1,nbnom
  213. ipos=ITANO1(inom)
  214. if (INOOB2(ITANO1(inom)).eq.'SEPARATE') nbnomr=nbnomr-2
  215. 50 continue
  216. if (LOTOUS) then
  217. do 51 inbres=1,nbnomr
  218. if (ILISTOB .NE. 0) THEN
  219.  
  220. NOBJ = NASS
  221. SEGINI, MLOBJ1
  222. itabres(inbres) = MLOBJ1
  223. C write(6,*) 'ASSIST : MLOBJ1=',MLOBJ1
  224. call ecrobj('LISTOBJE',MLOBJ1)
  225.  
  226. else
  227.  
  228. call crtabl(itabres(inbres))
  229. call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN,
  230. & 'SOUSTYPE',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE,
  231. & 'ESCLAVE',LOGRE,IOBRE)
  232. if (bmaxi) then
  233. call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN,
  234. & 'CREATEUR',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE,
  235. & 'MAXI ',LOGRE,IOBRE)
  236. elseif (bmini) then
  237. call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN,
  238. & 'CREATEUR',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE,
  239. & 'MINI ',LOGRE,IOBRE)
  240. elseif (bsouc) then
  241. call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN,
  242. & 'CREATEUR',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE,
  243. & 'SOUC ',LOGRE,IOBRE)
  244. else
  245. call ecctab(itabres(inbres),'MOT ',IVALIN,XVALIN,
  246. & 'CREATEUR',LOGIN,IOBIN,'MOT ',IVALRE,XVALRE,
  247. & 'ASSIST ',LOGRE,IOBRE)
  248. endif
  249. call ecrobj('TABLE ',itabres(inbres))
  250.  
  251. endif
  252. 51 continue
  253. end if
  254. C
  255. C EXPEDITION DES DONNEES
  256. C-----------------------
  257. C on va enoyer l'instruction sur l'assistant itabass(inbass)
  258. 1122 continue
  259. iproc0 = itabass(inbass)
  260. if (nbesc .eq. 0) then
  261. iproc = 0
  262. else
  263. iproc = mod(iproc0-1,nbesc)+1
  264. end if
  265. if (iproc .eq.0) LOTRMA = .true.
  266. if (inbass .ne. 0) then
  267. segini, mescla=mescl1
  268. MLMOTS = ipcar1
  269. segini, MLMOT1=MLMOTS
  270. segdes MLMOT1,MLMOTS
  271. jpcar1 = MLMOT1
  272. else
  273. mescla = mescl1
  274. end if
  275. mesins=mescl(iproc)
  276. SEGACT MESINS*MOD
  277. NINS = lismes(/1)
  278. IF ( nbins .eq. nins) then
  279. nins = nins + 5
  280. segadj MESINS
  281. END IF
  282. NBINS = NBINS + 1
  283. C JYY print*, 'NBINS,iproc,mescla' , NBINS , iproc, mescla
  284. C** call savseg ( mescla )
  285. LISMES(NBINS) = MESCLA
  286. SEGDES MESINS*RECORD
  287. C decryptage des tables esclaves
  288. if (ITABESC .NE. 0) then
  289. do 130 iop=1,inbargu
  290. C write(6,*) 'ASSIST:esoplu(iop+10),inbargu=',esoplu(iop+10),inbargu
  291. if (esoplu(iop+10)) then
  292. itab = esopva(iop+10)
  293. C write(6,*) 'ASSIST: itab=',itab
  294. typob = ' '
  295. call acctab(itab,'ENTIER ',iproc0,XVALIN,CHARIN,
  296. & LOGIN,IOBIN,typob,IVALRE,XVALRE,CHARRE,
  297. & LOGRE,IOBRE)
  298. if (typob .ne. ' ') then
  299. esoplu(iop+10) = .false.
  300. esopty(iop+10)=typob
  301. if (typob .eq. 'ENTIER ') then
  302. esopva(iop+10)=IVALRE
  303. elseif (typob .eq. 'LOGIQUE ') then
  304. esoplo(iop+10)=LOGRE
  305. elseif (typob .eq. 'FLOTTANT') then
  306. esopre(iop+10)=XVALRE
  307. elseif (typob .eq. 'MOT ') then
  308. esopch(iop+10)=CHARRE
  309. esopva(iop+10)=len(CHARRE)
  310. else
  311. C write(6,*) 'ASSIST: iproc0, typob, IOBRE=',iproc0,typob,IOBRE
  312. esopva(iop+10)=IOBRE
  313. end if
  314. else
  315. C JYY print*,'assistant non repertorie dans la table ESCLAVE'
  316. interr(1)=iproc0
  317. CALL ERREUR (914)
  318. endif
  319. endif
  320. 130 continue
  321.  
  322. else if (ILISTOB .NE. 0) then
  323. do 135 iop=1,inbargu
  324. C write(6,*) 'ASSIST:esoplu(iop+10),inbargu=',esoplu(iop+10),inbargu
  325. if (esoplu(iop+10)) then
  326. mlobj2 = esopva(iop+10)
  327. segact mlobj2
  328. esoplu(iop+10) = .false.
  329. esopty(iop+10) = mlobj2.typobj
  330. esopva(iop+10) = mlobj2.LISOBJ(iproc0)
  331. C write(6,*) 'ASSIST: iproc0,mlobj2, typobj=',iproc0,mlobj2,
  332. C & mlobj2.typobj
  333. endif
  334. 135 continue
  335. endif
  336.  
  337. C on colle les resultats
  338. do 140 inom=1,nbnomr
  339. segini mesres
  340. LOREMP = .FALSE.
  341. if (iproc.ne.0) then
  342. C write (6,*) ' assist segdes record mesres ',mesres
  343. segdes mesres*record
  344. else
  345. C write (6,*) ' assist segdes mesres ',mesres
  346. segdes mesres
  347. endif
  348. esrees(nbnomr-inom+1)=mesres
  349. C write(6,*) 'ASSIST : iproc0,nbnomr, mesres=',iproc0,nbnomr,mesres
  350. if (LOTOUS) then
  351. if (ILISTOB .NE. 0) then
  352. mlobj1.typobj = 'ESCLAVE'
  353. mlobj1.lisobj(iproc0) = mesres
  354. else
  355. call ecctab(itabres(inom),'ENTIER ',iproc0,XVALIN,
  356. & CHARIN,LOGIN,IOBIN,'ESCLAVE ',IVALRE,XVALRE,
  357. & CHARRE,LOGRE,mesres)
  358. endif
  359. else
  360. call ecrobj('ESCLAVE ',mesres)
  361. endif
  362. 140 continue
  363. do 150 inom=nbnomr+1,100
  364. esrees(inom)=0
  365. 150 continue
  366. C transfert du mescla
  367. segdes mescla
  368.  
  369. C passage a l assistant suivant si necessaire
  370. if (inbass .ne. 1) then
  371. inbass = inbass-1
  372. goto 1122
  373. end if
  374.  
  375. C suppression du segment TABASSI ?
  376. SEGSUP,TABASSI
  377.  
  378. C* LODESL = .FALSE.
  379. call setass(0)
  380.  
  381. end
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales