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    PV090527  24/01/09    21:15:13     11817          
  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.  
  114.           if (MLOBJE.TYPOBJ .eq. 'ESCLAVE ' .and. NOBJ1 .GT. 0) then
  115.             if (iimpi .eq. 1234) write(ioimp,*)
  116.      &       'Liste d''objets esclaves utilisee en sequentiel !!',MLOBJE
  117.             LOMISA = .FALSE.
  118.             if (.not.lodesl.or.ith.ne.0) lomisa = .true.
  119.  
  120.             IF ( LOMISA ) THEN
  121.               call oooeta(mcoord,ieta,imod)
  122.               if (ieta.eq.1) segdes mcoord
  123.  
  124. C             On attend que les NOBJ1 objets soient disponibles en partant du dernier
  125.               DO 13 IOB1=NOBJ1,1,-1
  126.                 MESRES =MLOBJE.LISOBJ(IOB1)
  127.                 SEGACT MESRES
  128.                 if (.not.loremp) then
  129.   130           continue
  130.                   segdes mesres*record
  131.                   SEGACT MESRES*(ECR=1,MOD)
  132.                   if (.not.loremp) then
  133.                    write(6,*) ' loremp pas vrai dans lirabj '
  134.                    goto 130
  135.                   endif
  136.                 endif
  137.                 if (ieta.eq.1) segact mcoord
  138.                 if (iimpi .eq. 1234)
  139.      &          write(ioimp,*) 'le segment a ete mis a jour ',MESRES
  140.                 call decesc(mesres,desret,desrev)
  141.  
  142. C               Remplacement de l'objet et placement du type
  143.                 segact, MLOBJE*MOD
  144.                 MLOBJE.LISOBJ(IOB1) = desrev
  145.                 if(MLOBJE.TYPOBJ .eq.'ESCLAVE ') MLOBJE.TYPOBJ = desret
  146.  
  147.                 SEGDES, MESRES
  148.  13           continue
  149.             ENDIF
  150.           endif
  151.  
  152.           SEGACT, MLOBJE
  153.           IF (LISOBJ(/1).NE.0) THEN
  154.             CALL PLAMO8(LTYPOB,NTYPOB,IPLA,MLOBJE.TYPOBJ)
  155. **          IF (IPLA.EQ.0) THEN
  156. **            CALL ERREUR(1138)
  157. **            RETURN
  158. **          ENDIF
  159.           ENDIF
  160.         ENDIF
  161.  
  162. C----------------------------
  163. C Actualisation objet ESCLAVE
  164. C----------------------------
  165. C
  166. C JYY
  167.         IF ( jtyobj(I) .eq. 'ESCLAVE ' ) then
  168.           MESRES = JPOOB4(I)
  169.           if (iimpi .eq. 1234)
  170.      &      write(ioimp,*) ' un objet esclave utilise !!!',mesres
  171.           LOMISA = .FALSE.
  172.           if (.not.lodesl.or.ith.ne.0) lomisa    =.true.
  173. C *           il faut faire la mise a jour pour continuer le travail
  174. C *       mise a jour eventuelle et menage eventuel
  175.           IF ( LOMISA ) THEN
  176. *           on essaye de recuperer un travail d'assistant. A priori mcoord est
  177. *           actif et le pauvre assistant risque d'etre bloque dessus
  178. *           on va donc desactiver mcoord puis le reactiver son etat
  179. *           de même pour la tétralogie ipflo...
  180. *
  181.             call oooeta(mcoord,ieta,imod)
  182.             if (ieta.eq.1) segdes mcoord
  183.             SEGACT MESRES
  184.             if (.not. loremp) then
  185.   15          continue
  186.               segdes mesres*record
  187.               SEGACT MESRES*(ECR=1,MOD)
  188.               if (.not. loremp) then
  189.                 write(6,*) ' loremp pas vrai dans lirabj '
  190.                 goto 15
  191.               endif
  192.             endif
  193.             if (ieta.eq.1) segact,mcoord
  194.             if (iimpi .eq. 1234)
  195.      &        write(ioimp,*) 'le segment a ete mis a jour ',MESRES
  196.  
  197.             call decesc(mesres,desret,desrev)
  198.             JPOOB4(I) = desrev
  199.             JTYOBJ(I) = desret
  200. *           c'est un element d'une table on ne fais pas de mise a jour de celle ci
  201.             indic1 = JPOOB2(I)
  202.             if (indic1.eq.0) then
  203. *              write (6,*) 'lirabj esclave mais pas de nom '
  204.             else
  205.               iouep2(indic1)=desrev
  206.               inoob2(indic1)=desret
  207.             endif
  208.             SEGDES MESRES
  209.           ENDIF
  210.         ENDIF
  211. C JYYY
  212.  
  213.       JTYOBI=JTYOBJ(I)
  214. *      write(6,*) ' jtyobi itype iextab ',jtyobi,itype ,iextab
  215.       IF(ITYPE(1:8).EQ.JTYOBI.and.iextab.eq.0)  GO TO 11
  216.       IF(JTYP) THEN
  217.        IF(ITYP.EQ.JTYOBI.and.iextab.eq.0)  GO TO 11
  218.       ENDIF
  219.       IF(INTEXT.EQ.0.AND.JTYOBI.EQ.'TEXTE   ') THEN
  220. C ON VIENT DE TOMBER  SUR UN OBJET DE TYPE TEXTE
  221.          IIO=JPOOB4(I)
  222.          CALL INSPIL(IIO,I)
  223.          GO TO 5
  224.       ENDIF
  225.       IF(ITYPE(1:8).EQ.MOVID8) THEN
  226.          IF(JTYOBI.NE.'SEPARATE'.AND.JTYOBI.NE.'TABLE   '.AND.
  227.      $       JTYOBI.NE.'METHODOL' ) GO TO 11
  228.       ENDIF
  229. *      write(6,*) ' iblqm ' , iblqm
  230.       if (iblqm.eq.1) then
  231.        IF (JTYOBI.EQ.'MOT     ') GOTO 20
  232.        IF (JTYOBI.EQ.'PROCEDUR') GOTO 20
  233.       endif
  234.       IF(JTYOBI.EQ.'TABLE   '.OR.JTYOBI.EQ.'OBJET   ')  THEN
  235.           INSTAB=1
  236. *          write(6,*) ' on positionne instab à 1'
  237.           IF(ILTTA.EQ.0) ILTTA=I
  238.       ENDIF
  239.       IF(JTYOBI.EQ.'METHODOL') THEN
  240.           IF(MOBJCO.NE.0) THEN
  241.              IF(ITYPE(1:6).EQ.'OBJET ')  THEN
  242.                 JPOOB4(I) =MOBJCO
  243.                  GO TO 11
  244.              ENDIF
  245.              INSTAB=2
  246.              IF(ILTTA.EQ.0) ILTTA=I
  247.           ELSE
  248.              IF(ITYPE(1:8).EQ.MOVID8) GO TO 11
  249.           ENDIF
  250.       ENDIF
  251.    10 CONTINUE
  252.     2 CONTINUE
  253. C**********************    IL N'EN EXISTE PAS
  254. C**********************    ON VA LIRE DANS LA TABLE INTERMEDIAIRE
  255.       IF(ISTOP.EQ.1) GO TO 20
  256.       IPLAC=ITINTE(IINTPO)
  257. *     write (6,*) ' iplac dans lirabj apres 2 ',iplac
  258.       IRAZ=IPLAC
  259.       IF(IRAZ.LE.0) GO TO 28
  260.       N= JTYOBJ(/2)
  261.       IF( IHPILE.GE.N)  THEN
  262.          N=N+1
  263.          SEGADJ JPOOB
  264.          JTYOBJ(N)=' '
  265.       ENDIF
  266.       IIP=IOUEP2(IPLAC)
  267.       IF(INOOB2(IPLAC).EQ.MOVID8) THEN
  268. * ON MET INSTAB A ZERO
  269.          INSTAB=0
  270.          IINTPO=IINTPO+1
  271.          GO TO 2
  272.       ENDIF
  273.       IHPILE=IHPILE+1
  274.       interm=inoob2(iplac)
  275.       JTYOBJ(IHPILE)=interm
  276.       JPOOB1(IHPILE)=.TRUE.
  277.       JPOOB2(IHPILE)=IPLAC
  278.       JPOOB4(IHPILE)=IIP
  279.       I=IHPILE
  280.       IINTPO=IINTPO+1
  281. C**************************   ON VIENT DE LIRE UN OBJET
  282.       INSTAB=0
  283. *      write (6,*) ' lirabj iintpo itinte interm ',iintpo,itinte(iintpo),
  284. *     >      interm
  285.       if( interm.eq.ITYPE(1:8)) go to 1
  286.       if (itinte(iintpo).gt.0.and.
  287.      >      (interm.eq.'TABLE   '.or.interm.eq.'SEPARATE')) goto 2
  288.       if (jtyobj(ihpile-2).eq.'TABLE   '.AND.
  289.      > jtyobj(ihpile-1).eq.'SEPARATE') iextab=1
  290. *      write (6,*) ' jtyobj instab ',jtyobj(ihpile-2),
  291. *     > jtyobj(ihpile-1),jtyobj(ihpile),instab
  292.       GO TO 1
  293.    11 CONTINUE
  294. C****************************   ON A TROUVE L'INFORMATION DEMANDE
  295. *     write (6,*) ' ancien ibpile ',ibpile,' nouveau ',ibpiln
  296.       IPLAC=JPOOB2(I)
  297. *     write (6,*) ' iplac dans lirabj apres 11 ',iplac,jtyobj(i)
  298.       IF (IBPILN.NE.0) IBPILE=IBPILN
  299.       IRETOU=1
  300.       IF(ITYPE(1:8).EQ.MOVID8.AND.ILTTA.NE.0) THEN
  301.           I = ILTTA
  302.       ENDIF
  303. *      write(6,*) '   i   ' , i
  304.       JPOOB1(I)=.FALSE.
  305.       IF(ITYPE(1:8).EQ.'FLOTTANT'.AND.JTYOBJ(I).EQ.'ENTIER  ') THEN
  306.          ITYPE='ENTIER  '
  307.       ENDIF
  308.       IRET=JPOOB4(I)
  309.       MESERR=0
  310.       IF(JTYOBJ(I).EQ.'PROCEDUR'.AND.ITYPE(1:4).EQ.'MOT ') THEN
  311. C  FAIRE ATTENTION POUR REMPLACEMENT D'UNE PROCEDURE PAR SON NOM
  312. C  DE TYPE MOT
  313. *            IF(iimpi.eq.1754.OR.iimpi.eq.1876)
  314. *     $ write (6,fmt='('' remplacement ''
  315. *     $      ,'' d une procedure par son nom'')')
  316.             IRET=INOOB1(IPLAC)
  317.  
  318.             ITYPE='MOT     '
  319.             IMOTLU=I
  320.            if(iimpi.eq.1876) write(6,*) ' imotlu ', imotlu
  321. *      IF(IIMPI.EQ.1876)THEN
  322. *      do 255 IK=IBPILE,IHPILE
  323. *      write(6,*) 'lirabj IK JTYOBj JPOOB1 JPOOB2 JPOOB4',
  324. *     $ ik, JTYOBJ(IK),JPOOB1(IK),JPOOB2(IK),JPOOB4(IK)
  325. * 255   continue
  326. *      write(6,*) 'on a trouver type valeur',itype,iret
  327. *      ENDIF
  328.        RETURN
  329.       ENDIF
  330.       IMOTLU=I
  331.       IF(ITYPE(1:8).EQ.'TEXTE   ') INTEXT=0
  332.       IF(ITYPE(1:8).NE.MOVID8)  RETURN
  333.       ITYPE=JTYOBJ(I)
  334. *      IF(IIMPI.EQ.1876)THEN
  335. *      do 254 IK=IBPILE,IHPILE
  336. *      write(6,*) 'lirabj IK JTYOBj JPOOB1 JPOOB2 JPOOB4',
  337. *     $ ik, JTYOBJ(IK),JPOOB1(IK),JPOOB2(IK),JPOOB4(IK)
  338. * 254   continue
  339. *      write(6,*) 'on a trouver type valeur',itype,iret
  340. *     ENDIF
  341.       RETURN
  342. C********************************   LECTURE DU POINT VIRGULE
  343.   28  ISTOP=1
  344.  
  345. C********************************   ON N'A PAS TROUVEE L'INFORMATION
  346.    20 CONTINUE
  347. C DANS LE CAS DE LECTURE BLANCHE ET DE LA SEULE PRESENCE D'UNE TABLE
  348. C ON ARRIVE ICI AVEC ILTTA NE 0
  349.       IF(ILTTA.NE.0) THEN
  350.          IF(ITYPE(1:8).EQ.MOVID8) THEN
  351.              ISTOP=0
  352.              ITYPE = 'TABLE   '
  353.              IMOTLU=  ILTTA
  354.              IRETOU=1
  355.              JPOOB1(IMOTLU)=.FALSE.
  356.              IRET=JPOOB4(IMOTLU)
  357.              MESERR=0
  358.              RETURN
  359.          ENDIF
  360.       ENDIF
  361.       IRETOU=0
  362.       IF(ICODE.gt.0) goto 31
  363.    30 IF (ITYPE(1:8).EQ.'TEXTE   ') INTEXT=0
  364.       RETURN
  365.    31 CONTINUE
  366.       MOTERR(1:8)=ITYPE
  367.       CALL ERREUR(37)
  368.       IF (ITYPE(1:8).EQ.'TEXTE   ') INTEXT=0
  369.       MESERR=0
  370.  
  371.       END
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  

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