C LICHAM    SOURCE    PV090527  25/03/04    21:15:02     12169          

*--------------------------------------------------------------------*
*                                                                    *
*     LECTURE D'UN NOUVEAU CHAMELEM SUR LE FICHIER IORES.            *
*                                                                    *
*     Parametres:                                                    *
*                                                                    *
*     IORES   NUMERO DU FICHIER DE LECTURE                           *
*     ITLACC  Pile contenant les nouveaux CHAMELEMs                  *
*     IMAX1   Nombre de CHAMELEMs dans la pile                       *
*     IFORM   Si sauvegarde en format ou non                         *
*                                                                    *
*     APPELE PAR: LIPIL                                              *
*                                                                    *
*     Auteur, date de creation:                                      *
*     Denis ROBERT-MOUGIN, le 29 juin 1989.                          *
*--------------------------------------------------------------------*
      SUBROUTINE LICHAM(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCFXDR
-INC SMCOORD
-INC SMCHAML

      SEGMENT,ITLACC
        INTEGER ITLAC(0)
      ENDSEGMENT
      SEGMENT,MTABE1
        INTEGER ITABE1(NM1)
      ENDSEGMENT
      SEGMENT,MTABE2
         INTEGER ITABE2(NM2)
      ENDSEGMENT
      SEGMENT,MTABE4
        CHARACTER*(8) ITABE4(NM4)
      ENDSEGMENT
      SEGMENT,MTABE5
        CHARACTER*(8) ITABE5(NM5)
      ENDSEGMENT
      SEGMENT,MTABE6
        CHARACTER*(8) ITABE6(NM6)
      ENDSEGMENT

      INTEGER IDAN(5)

      IRETOU=0

      NM4=0
      NM6=0
      NM5=0

*     Boucle sur les CHAMELEMs contenus dans la pile:

      DO 10 IEL=1,IMAX1

         MCHELM  = 0

*  CREATION ET REMPLISSAGE DU SEGMENT MCHELM
         idan(5)=0
         if (niveau.le.26) CALL LFCDIE(IORES,4,IDAN,IRETOU,IFORM)
         if (niveau.gt.26) CALL LFCDIE(IORES,5,IDAN,IRETOU,IFORM)
         IF (IRETOU.NE.0) RETURN

         N1 = IDAN(1)
         N3LU = IDAN(3)
         IF (N3LU.GT.6) THEN
           write(ioimp,*) 'LICHAM : N3 LU > 6 !'
           call erreur(5)
         ENDIF
         N3 = MAX(N3LU,6)
         L1 = IDAN(4)

         SEGINI MCHELM
         mclcnf=idan(5)
         IFOCHE = IDAN(2)

         CALL LFCDIC(IORES,TITCHE,IRETOU,IFORM)
         IF (IRETOU.NE.0) RETURN

         N6 = 3 + N3LU
         NM1 = N1 * N6
         SEGINI,MTABE1
         CALL LFCDIE(IORES,NM1,ITABE1,IRETOU,IFORM)
         IF (IRETOU.NE.0) RETURN
         IF (NIVEAU.GE.4) THEN
            NM5 = N1 * 2
            SEGINI,MTABE5
            CALL LFCDIN(IORES,NM5,ITABE5,IRETOU,IFORM)
            IF (IRETOU.NE.0) RETURN
         ENDIF
         if (niveau.ge.15) then
            nm6=n1
            segini mtabe6
            CALL LFCDIN(IORES,NM6,ITABE6,IRETOU,IFORM)
         endif

         DO ISOUEL=1,N1
            ISOU = N6 * (ISOUEL - 1)
            IMACHE(ISOUEL) = ITABE1(ISOU+1)
            N2             = ITABE1(ISOU+3)
            SEGINI MCHAML
            ICHAML(ISOUEL)=MCHAML
            DO IJ=1,N3LU
               INFCHE(ISOUEL,IJ) = ITABE1(ISOU+3+IJ)
            ENDDO
*  Par defaut : support = 1 = aux noeuds
            IF (N3LU.LT.6) THEN
               INFCHE(ISOUEL,6) = 1
            ELSE
               ISUPLU = INFCHE(ISOUEL,6)
               IF (ISUPLU.LT.1 .OR. ISUPLU.GT.9) THEN
                  write(ioimp,*) 'LICHAM : SUPPORT LU inconnu',ISUPLU
                  INFCHE(ISOUEL,6) = 1
               ENDIF
            ENDIF
            IF (INFCHE(ISOUEL,4).EQ.0) INFCHE(ISOUEL,6) = 1
            CONCHE(ISOUEL) = '                        '
            IF (NIVEAU.GE.4) THEN
               CONCHE(ISOUEL)(1:8) = ITABE5(2*ISOUEL-1)
               CONCHE(ISOUEL)(9:16)= ITABE5(2*ISOUEL  )
            ENDIF
            if (niveau.ge.15) then
               conche(isouel)(17:24) =itabe6(isouel)
            endif
         ENDDO

         SEGSUP MTABE1
         IF (NIVEAU.GE.4) SEGSUP MTABE5
         if (niveau.ge.15) segsup mtabe6

*       BOUCLE SUR LES ZONES ELEMENTAIRES DU CHAMELEM :

         DO ISOUEL=1,N1
            MCHAML = ICHAML(ISOUEL)
            N2     = NOMCHE(/2)
            NM2    = N2
            NM4    = N2*2
            SEGINI MTABE2,MTABE4
            CALL LFCDIE(IORES,NM2,ITABE2,IRETOU,IFORM)
            IF (IRETOU.NE.0) RETURN
            CALL LFCDIN(IORES,NM2,NOMCHE,IRETOU,IFORM)
            IF (IRETOU.NE.0) RETURN
            CALL LFCDIN(IORES,NM4,ITABE4,IRETOU,IFORM)
            IF (IRETOU.NE.0) RETURN

            DO ICO = 1, N2
               if (iform.ne.2) then
                  WRITE(TYPCHE(ICO),FMT='(2A8)') ITABE4(2*ICO-1),
     &                                           ITABE4(2*ICO)
               else
                  TYPCHE(ICO)(1:8) =ITABE4(2*ICO-1)
                  TYPCHE(ICO)(9:16)=ITABE4(2*ICO  )
               endif
               IF (TYPCHE(ICO).EQ.'POINTEUR MLREEL' )
     &            TYPCHE(ICO)='POINTEURLISTREEL'
               IF (TYPCHE(ICO).EQ.'POINTEUR MEVOLUT' )
     &            TYPCHE(ICO)='POINTEUREVOLUTIO'
            ENDDO

            SEGSUP MTABE4

*         BOUCLE SUR LES COMPOSANTES :

            DO ICO = 1, N2
               IF (ITABE2(ICO).GE.0) THEN
*pas de ielval separe
                  CALL LFCDIE(IORES,4,IDAN,IRETOU,IFORM)
                  IF (IRETOU.NE.0) RETURN
                  N1PTEL = IDAN (1)
                  N1EL   = IDAN (2)
                  N2PTEL = IDAN (3)
                  N2EL   = IDAN (4)
                  L1 = IDAN(1) * IDAN(2)
                  L2 = IDAN(3) * IDAN(4)
                  SEGINI MELVAL
                  IELVAL(ICO) = MELVAL

*         LECTURE DU CONTENU DU SEGMENT MELVAL :

                  IF (L1.NE.0) THEN
                     CALL LFCDI2(IORES,L1,VELCHE,IRETOU,IFORM)
                     IF (IRETOU.NE.0) RETURN
                  ENDIF
                  IF (L2.NE.0) THEN
                     CALL LFCDIE(IORES,L2,IELCHE,IRETOU,IFORM)
                     IF (IRETOU.NE.0) RETURN
                  ENDIF
                  SEGDES MELVAL
               ELSE
* on va pointer sur la pile des ielval.
                  IELVAL(ICO)=ITABE2(ICO)
               ENDIF
            ENDDO
            SEGSUP MTABE2

            SEGDES MCHAML
         ENDDO

         DO ISOUEL=1,N1
         ENDDO

         SEGDES MCHELM
         ITLAC(**)=MCHELM

 10   CONTINUE

      RETURN
      END