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