Télécharger la plaquette Cast3M


fr en

Télécharger lirabj.eso

Retour à la liste

Numérotation des lignes : 

lirabj

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

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