Télécharger lirabj.eso

Retour à la liste

Numérotation des lignes :

lirabj
  1. C LIRABJ SOURCE PV 20/04/03 21:15:37 10571
  2. SUBROUTINE LIRABJ( ITYPE , IRET , ICODE , IRETOU )
  3.  
  4. IMPLICIT INTEGER(I-N)
  5.  
  6. -INC PPARAM
  7. -INC CCNOYAU
  8. -INC CCOPTIO
  9. -INC SMBLOC
  10. -INC CCASSIS
  11. -INC SMCOORD
  12. LOGICAL JTYP
  13. CHARACTER*(*) ITYPE
  14. CHARACTER*(8) ITYP,INTERM,MOVID8
  15. CHARACTER*8 JTYOBI
  16. * SAVE IPLAC
  17. LOGICAL LOMISA,ILOREMP
  18. integer desrev
  19. character*(8) desret
  20.  
  21. MOVID8=' '
  22.  
  23. IF(LEN(ITYPE).LT.8) THEN
  24. CALL ERREUR(5)
  25. RETURN
  26. ENDIF
  27.  
  28. iextab=0
  29. * initialisation de lotesc
  30. lotesc=.false.
  31. ith=0
  32. if (nbesc.ne.0) ith = oothrd
  33. if (ith .ne.0) lotesc=.true.
  34. * write (6,*) ' dans lirabj ',ith
  35. if (lotesc) then
  36. call liresc(itype,iret,icode,iretou)
  37. return
  38. endif
  39. IF (NOMLU.EQ.0) CALL LIRNOM
  40. IRETOU=0
  41. IF (IERR.GT.1) RETURN
  42. INSTAB=0
  43. IF (ITYPE(1:5).EQ.'TEXTE') INTEXT=1
  44. ITYP=' '
  45. JTYP=.FALSE.
  46. C DANS LE CAS DE LECTURE D'UN FLOTTANT ON ADMET DE LIRE UN ENTIER
  47. IF (ITYPE(1:8).EQ.'FLOTTANT') THEN
  48. ITYP='ENTIER'
  49. JTYP=.TRUE.
  50. ENDIF
  51. C DANS LE CAS DE LECTURE D'UN MOT ON ADMET DE LIRE UNE PROCEDURE
  52. IF (ITYPE(1:4).EQ.'MOT ') THEN
  53. ITYP='PROCEDUR'
  54. JTYP=.TRUE.
  55. ENDIF
  56. * if ( iimpi.eq.1876) THEN
  57. * write(6,*) ' lirabj on demande ',itype
  58. * write(6,*) ' ibpile,ihpile ',ibpile,ihpile
  59. * write(6,*) ' instab,lectab,iextab' ,instab,lectab,iextab
  60. * endif
  61. 5 L = IHPILE-IBPILE
  62. ILTTA = 0
  63. INSTAB= 0
  64. IF (L .lt. 0) goto 2
  65. C********************** ON CHERCHE SI UN OBJET DU TYPE DESIRE EST
  66. C********************** DEJA DANS LA PILE
  67. 1 IBPILN=0
  68. * write(6,*) ' apres 1 lectab instab iextab ibpile ihpile'
  69. * write(6,*) lectab ,instab, iextab, ibpile,ihpile
  70. DO 10 I=IBPILE,IHPILE
  71. * write(6,*) 'bcl 10 i jpoob1(i) iva' ,i,JPOOB1(I),jpoob4(i)
  72. IF(.NOT.JPOOB1(I)) THEN
  73. * ON MET A 0 INSTAB CAR LA SPECIFICATION PRECISE QUE LA DONNEE INDICE
  74. * DOIT IMMEDIATEMENT SUIVRE LA DONNEE DE LA TABLE
  75. INSTAB=0
  76. GO TO 10
  77. ENDIF
  78. IF (IBPILN.EQ.0) IBPILN=I
  79. IF (INSTAB.NE.0.AND.LECTAB.EQ.0 ) THEN
  80. * LA DONNEE QUI PRECEDE EST UNE TABLE ou un objet ON REGARDE SI
  81. * CELLE CI EST UN SEPARATEUR SUIVI D'UN INDICE
  82. * DANS CE CAS ON SE CONTENTE DE REMPLACER CE NOUVEL OBJET PAR CELUI
  83. * CONTENU DANS LA TABLE SINON ON REND CE NOUVEL OBJET
  84. * DANS TOUS LES CAS ON POSITIONNE INSTAB A 0
  85. ISUCC=INSTAB
  86. * write (6,*) ' lirabj appel a rempil '
  87. CALL REMPIL(I-1,ISUCC)
  88. * write(6,*) ' apres rempil i isucc',i,isucc
  89. iextab=0
  90. if (i+1.le.ihpile) then
  91. if (jtyobj(i+1).eq.'TABLE '.and.isucc.eq.1) iextab=1
  92. endif
  93. * if( iimpi.eq.1876) call ecpil ('lirabj boucle')
  94. INSTAB=0
  95. IF(IERR.NE.0) RETURN
  96. IF(ISUCC.EQ.1.AND.ILTTA.EQ.I-1) ILTTA=0
  97. IF(ISUCC.EQ.1) GO TO 1
  98. ENDIF
  99. C JYY
  100. IF ( jtyobj(I) .eq. 'ESCLAVE ' ) then
  101. MESRES = JPOOB4(I)
  102. if (iimpi .eq. 1234)
  103. & write(ioimp,*) ' un objet esclave utilise !!!',mesres
  104. LOMISA = .FALSE.
  105. if (.not.lodesl.or.ith.ne.0) lomisa =.true.
  106. C * il faut faire la mise a jour pour continuer le travail
  107. C * mise a jour eventuelle et menage eventuel
  108. IF ( LOMISA ) THEN
  109. * on essaye de recuperer un travail d'assistant. A priori mcoord est
  110. * actif et le pauvre assistant risque d'etre bloque dessus
  111. * on va donc desactiver mcoord puis le reactiver son etat
  112. * de même pour la tétralogie ipflo...
  113. *
  114. call oooeta(mcoord,ieta,imod)
  115. if (ieta.eq.1) segdes mcoord
  116. SEGACT MESRES
  117. if (.not.loremp) then
  118. 15 continue
  119. segdes mesres*record
  120. SEGACT MESRES*(ECR=1,MOD)
  121. if (.not.loremp) then
  122. write(6,*) ' loremp pas vrai dans lirabj '
  123. goto 15
  124. endif
  125. endif
  126. if (ieta.eq.1) segact mcoord
  127. if (iimpi .eq. 1234)
  128. & write(ioimp,*) 'le segment a ete mis a jour ',MESRES
  129. call decesc(mesres,desret,desrev)
  130. JPOOB4(I) = desrev
  131. JTYOBJ(I) = desret
  132. * c'est un element d'une table on ne fais pas de mise a jour de celle ci
  133. indic1 = JPOOB2(I)
  134. if (indic1.eq.0) then
  135. * write (6,*) 'lirabj esclave mais pas de nom '
  136. else
  137. iouep2(indic1)=desrev
  138. inoob2(indic1)=desret
  139. endif
  140. SEGDES MESRES
  141. END IF
  142. END IF
  143. C JYYY
  144.  
  145. JTYOBI=JTYOBJ(I)
  146. * write(6,*) ' jtyobi itype iextab ',jtyobi,itype ,iextab
  147. IF(ITYPE(1:8).EQ.JTYOBI.and.iextab.eq.0) GO TO 11
  148. IF(JTYP) THEN
  149. IF(ITYP.EQ.JTYOBI.and.iextab.eq.0) GO TO 11
  150. ENDIF
  151. IF(INTEXT.EQ.0.AND.JTYOBI.EQ.'TEXTE ') THEN
  152. C ON VIENT DE TOMBER SUR UN OBJET DE TYPE TEXTE
  153. IIO=JPOOB4(I)
  154. CALL INSPIL(IIO,I)
  155. GO TO 5
  156. ENDIF
  157. IF(ITYPE(1:8).EQ.MOVID8) THEN
  158. IF(JTYOBI.NE.'SEPARATE'.AND.JTYOBI.NE.'TABLE '.AND.
  159. $ JTYOBI.NE.'METHODOL' ) GO TO 11
  160. ENDIF
  161. * write(6,*) ' iblqm ' , iblqm
  162. if (iblqm.eq.1) then
  163. IF (JTYOBI.EQ.'MOT ') GOTO 20
  164. IF (JTYOBI.EQ.'PROCEDUR') GOTO 20
  165. endif
  166. IF(JTYOBI.EQ.'TABLE '.OR.JTYOBI.EQ.'OBJET ') THEN
  167. INSTAB=1
  168. * write(6,*) ' on positionne instab à 1'
  169. IF(ILTTA.EQ.0) ILTTA=I
  170. ENDIF
  171. IF(JTYOBI.EQ.'METHODOL') THEN
  172. IF(MOBJCO.NE.0) THEN
  173. IF(ITYPE(1:6).EQ.'OBJET ') THEN
  174. JPOOB4(I) =MOBJCO
  175. GO TO 11
  176. ENDIF
  177. INSTAB=2
  178. IF(ILTTA.EQ.0) ILTTA=I
  179. ELSE
  180. IF(ITYPE(1:8).EQ.MOVID8) GO TO 11
  181. ENDIF
  182. ENDIF
  183. 10 CONTINUE
  184. 2 CONTINUE
  185. C********************** IL N'EN EXISTE PAS
  186. C********************** ON VA LIRE DANS LA TABLE INTERMEDIAIRE
  187. IF(ISTOP.EQ.1) GO TO 20
  188. IPLAC=ITINTE(IINTPO)
  189. * write (6,*) ' iplac dans lirabj apres 2 ',iplac
  190. IRAZ=IPLAC
  191. IF(IRAZ.LE.0) GO TO 28
  192. N= JTYOBJ(/2)
  193. IF( IHPILE.GE.N) THEN
  194. N=N+1
  195. SEGADJ JPOOB
  196. JTYOBJ(N)=' '
  197. ENDIF
  198. IIP=IOUEP2(IPLAC)
  199. IF(INOOB2(IPLAC).EQ.MOVID8) THEN
  200. * ON MET INSTAB A ZERO
  201. INSTAB=0
  202. IINTPO=IINTPO+1
  203. GO TO 2
  204. ENDIF
  205. IHPILE=IHPILE+1
  206. interm=inoob2(iplac)
  207. JTYOBJ(IHPILE)=interm
  208. JPOOB1(IHPILE)=.TRUE.
  209. JPOOB2(IHPILE)=IPLAC
  210. JPOOB4(IHPILE)=IIP
  211. I=IHPILE
  212. IINTPO=IINTPO+1
  213. C************************** ON VIENT DE LIRE UN OBJET
  214. INSTAB=0
  215. * write (6,*) ' lirabj iintpo itinte interm ',iintpo,itinte(iintpo),
  216. * > interm
  217. if( interm.eq.ITYPE(1:8)) go to 1
  218. if (itinte(iintpo).gt.0.and.
  219. > (interm.eq.'TABLE '.or.interm.eq.'SEPARATE')) goto 2
  220. if (jtyobj(ihpile-2).eq.'TABLE '.AND.
  221. > jtyobj(ihpile-1).eq.'SEPARATE') iextab=1
  222. * write (6,*) ' jtyobj instab ',jtyobj(ihpile-2),
  223. * > jtyobj(ihpile-1),jtyobj(ihpile),instab
  224. GO TO 1
  225. 11 CONTINUE
  226. C**************************** ON A TROUVE L'INFORMATION DEMANDE
  227. * write (6,*) ' ancien ibpile ',ibpile,' nouveau ',ibpiln
  228. IPLAC=JPOOB2(I)
  229. * write (6,*) ' iplac dans lirabj apres 11 ',iplac,jtyobj(i)
  230. IF (IBPILN.NE.0) IBPILE=IBPILN
  231. IRETOU=1
  232. IF(ITYPE(1:8).EQ.MOVID8.AND.ILTTA.NE.0) THEN
  233. I = ILTTA
  234. ENDIF
  235. * write(6,*) ' i ' , i
  236. JPOOB1(I)=.FALSE.
  237. IF(ITYPE(1:8).EQ.'FLOTTANT'.AND.JTYOBJ(I).EQ.'ENTIER ') THEN
  238. ITYPE='ENTIER '
  239. ENDIF
  240. IRET=JPOOB4(I)
  241. MESERR=0
  242. IF(JTYOBJ(I).EQ.'PROCEDUR'.AND.ITYPE(1:4).EQ.'MOT ') THEN
  243. C FAIRE ATTENTION POUR REMPLACEMENT D'UNE PROCEDURE PAR SON NOM
  244. C DE TYPE MOT
  245. * IF(iimpi.eq.1754.OR.iimpi.eq.1876)
  246. * $ write (6,fmt='('' remplacement ''
  247. * $ ,'' d une procedure par son nom'')')
  248. IRET=INOOB1(IPLAC)
  249.  
  250. ITYPE='MOT '
  251. IMOTLU=I
  252. if(iimpi.eq.1876) write(6,*) ' imotlu ', imotlu
  253. * IF(IIMPI.EQ.1876)THEN
  254. * do 255 IK=IBPILE,IHPILE
  255. * write(6,*) 'lirabj IK JTYOBj JPOOB1 JPOOB2 JPOOB4',
  256. * $ ik, JTYOBJ(IK),JPOOB1(IK),JPOOB2(IK),JPOOB4(IK)
  257. * 255 continue
  258. * write(6,*) 'on a trouver type valeur',itype,iret
  259. * ENDIF
  260. RETURN
  261. ENDIF
  262. IMOTLU=I
  263. IF(ITYPE(1:8).EQ.'TEXTE ') INTEXT=0
  264. IF(ITYPE(1:8).NE.MOVID8) RETURN
  265. ITYPE=JTYOBJ(I)
  266. * IF(IIMPI.EQ.1876)THEN
  267. * do 254 IK=IBPILE,IHPILE
  268. * write(6,*) 'lirabj IK JTYOBj JPOOB1 JPOOB2 JPOOB4',
  269. * $ ik, JTYOBJ(IK),JPOOB1(IK),JPOOB2(IK),JPOOB4(IK)
  270. * 254 continue
  271. * write(6,*) 'on a trouver type valeur',itype,iret
  272. * ENDIF
  273. RETURN
  274. C******************************** LECTURE DU POINT VIRGULE
  275. 28 ISTOP=1
  276.  
  277. C******************************** ON N'A PAS TROUVEE L'INFORMATION
  278. 20 CONTINUE
  279. C DANS LE CAS DE LECTURE BLANCHE ET DE LA SEULE PRESENCE D'UNE TABLE
  280. C ON ARRIVE ICI AVEC ILTTA NE 0
  281. IF(ILTTA.NE.0) THEN
  282. IF(ITYPE(1:8).EQ.MOVID8) THEN
  283. ISTOP=0
  284. ITYPE = 'TABLE '
  285. IMOTLU= ILTTA
  286. IRETOU=1
  287. JPOOB1(IMOTLU)=.FALSE.
  288. IRET=JPOOB4(IMOTLU)
  289. MESERR=0
  290. RETURN
  291. ENDIF
  292. ENDIF
  293. IRETOU=0
  294. IF(ICODE.gt.0) goto 31
  295. 30 IF (ITYPE(1:8).EQ.'TEXTE ') INTEXT=0
  296. RETURN
  297. 31 CONTINUE
  298. MOTERR(1:8)=ITYPE
  299. CALL ERREUR(37)
  300. IF (ITYPE(1:8).EQ.'TEXTE ') INTEXT=0
  301. MESERR=0
  302.  
  303. END
  304.  
  305.  
  306.  
  307.  

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