C LIRBAS    SOURCE    CHAT      05/01/13    01:20:37     5004
      SUBROUTINE LIRBAS(ICOND,IRET1 ,IRET2 )
C
C     LECTURE D'UNE BASE ELEMENTAIRE
C     ICOND LECTURE IMPERATIVE OU NON
C     IRET1=MSOBAS     : POINTEURS DE LA BASE ELEMENTAIRE
C     IRET2=MSOBAS     :
C
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMBASEM
-INC SMSTRUC
C
      IRET1=0
      IRET2=0
      CALL LIROBJ('BASEMODA',IP2,ICOND,IRETOU)
      IF(IERR.NE.0) RETURN
      IF(IRETOU.EQ.0) RETURN
      MBASEM=IP2
      SEGACT MBASEM
      NBAS=LISBAS(/1)
      MSOBAS=LISBAS(1)
      IF(NBAS.EQ.1) GOTO 40
C   BASE COMPLEXE
      CALL LIROBJ('STRUCTUR',IRET,1,IRETOU)
      IF(IERR.NE.0) GOTO 4000
      MSTRUC=IRET
      SEGACT MSTRUC
      NSTRU=LISTRU(/1)
      MSOSTU=LISTRU(1)
      IF(NSTRU.EQ.1) GOTO 20
C   STRUCTURE COMPLEXE
      CALL LIRENT(IP3,1,IRETOU)
      IF(IERR.NE.0) GOTO 3000
C  ON VERIFIE QU'IL S'AGIT DE SOUS-STRUCTURES IDENTIQUES
      SEGACT MSOSTU
      ISRAI1=ISRAID
      SEGDES MSOSTU
      DO 10 NS=2,NSTRU
      MSOSTU=LISTRU(NS)
      SEGACT MSOSTU
      IF(ISRAI1.NE.ISRAID) GOTO 2000
      SEGDES MSOSTU
  10  CONTINUE
      IF(IP3.LE.0.OR.IP3.GT.NSTRU) GOTO 4000
      MSOSTU=LISTRU(IP3)
   20 CONTINUE
      SEGDES MSTRUC
C  ON VERIFIE QUE LA SOUS-STRUCTURE EST DANS LA BASE
      DO 85 NB=1,NBAS
      MSOBAS=LISBAS(NB)
      SEGACT MSOBAS
      IF(IBSTRM(1).EQ.MSOSTU) GOTO 35
      SEGDES MSOBAS
   85 CONTINUE
C  *** INCOHERENCE ENTRE LA BASE ET LA STRUCTURE
      GOTO 4000
 2000 CONTINUE
      SEGDES MSOSTU
 3000 CONTINUE
      SEGDES MSTRUC
 4000 CALL ERREUR(216)
      SEGDES MBASEM
      GOTO 5000
C
   35 CONTINUE
      SEGDES MSOBAS
   40 CONTINUE
      SEGDES MBASEM
      IRET1=MSOBAS
      IRET2=MBASEM
 5000 CONTINUE
      RETURN
      END