Sources Esope | Cast3M

lirtab
C LIRTAB    SOURCE    PV        21/04/19    21:15:00     10971          
      SUBROUTINE LIRTAB(ITYP,IRETA,ICODE,IRETOU)
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC CCNOYAU
 
 
      CHARACTER*(*)ITYP
      CHARACTER*8 TYPE,TAPIND,TYPOBJ,CHARIN
      CHARACTER*(LOCHAI) CHARRE
      CHARACTER*8 LETYPE
      REAL*8 XVALIN,XVALRE
      LOGICAL IV,LOGIN,LOGRE
 
      SEGMENT IVAL1
        INTEGER     IVAL(NCLE)
        INTEGER     NOVAL(NCLE)
        CHARACTER*8 TYVAL(NCLE)
      ENDSEGMENT
 
      IRET  =0
      ireta =0
      iretou=0
      IFIN  =0
      LE    =LEN(ITYP)
      N     =0
      NCLE  =10
      SEGINI,IVAL1
      TYPE=ITYP
    1 CONTINUE
      MOTERR(1:8)=TYPE
      if (icode.ne.0) CALL MESLIR(-173)
      CALL LIROBJ ('TABLE',IRET,ICODE,IRETO)
*      write(6,*) ' lecture de la table ' , iret
      IF(IERR.NE.0) GO TO 10
      IF(IRETO.EQ.0)GO TO 10
      TYPOBJ = ' '
      CALL ACCTAB(IRET,'MOT     ',IVALIN,XVALIN,'SOUSTYPE',LOGIN,
     $              IOBIN, TYPOBJ,IVALRE,XVALRE,CHARRE    ,LOGRE,IOBRE)
      IF(TYPOBJ.EQ.'MOT     ') THEN
*         write(6,*) ' le  ivalre ' , le , ivalre
        IF(IVALRE.EQ.LE) THEN
          IF(CHARRE(1:LE).EQ.ITYP) THEN
*           ON A TROUVE LA TABLE RECHERCHEE IL FAUT METTRE A JOUR LA
*           LECTURE DES TABLES PRECEDEMMENT LUES
             ireta=iret
             iretou=1
*             write(6,*) ' c est celle la'
              GO TO 10
          ENDIF
        ENDIF
      ENDIF
*   CE N EST PAS UNE BONNE TABLE  ON REMPLIT IVAL ET ON RETOURNE EN
*   LECTURE
      N = N + 1
      IF (N.GT.NCLE)THEN
        SEGADJ IVAL1
      ENDIF
      IVAL(N) =IMOTLU
      NOVAL(N)=INOOB1(IMOTLU)
      TYVAL(N)=INOOB2(IMOTLU)
      GO TO 1
*
*  AVANT DE SORTIR ON REMET LES TABLES LUES PAS(DU BON SOUSTYPE) EN
*  LECTURE
*
   10 CONTINUE
      IF(N.EQ.0) GO TO 20
      DO 2 J=1,N
      IV=.TRUE.
      imola= IVAL(J)
      IF(INOOB1(imola).NE.NOVAL(J)) IV=.FALSE.
      IF(INOOB2(imola).NE.TYVAL(J)) IV=.FALSE.
      IF(IV)  THEN
           JPOOB1(imola)=.TRUE.
           IF(IBPILE.GT.imola) IBPILE=imola
           IF(IHPILE.LT.imola) IHPILE=imola
      ELSE
           NN = JPOOB1(/1)
           DO 5 KK=1,NN
             IF(INOOB1(KK).NE.NOVAL(KK))  GOTO 5
             IF(INOOB2(KK).NE.TYVAL(KK))  GOTO 5
             IF(JPOOB1(KK)) GOTO 5
             JPOOB1(KK)=.TRUE.
             GOTO 6
    5      CONTINUE
           CALL ERREUR(5)
    6      CONTINUE
      ENDIF
    2 CONTINUE
   20 CONTINUE
      SEGSUP IVAL1     
      END