C RICOLO    SOURCE    PV090527  26/04/30    21:16:17     12529          
C
      SUBROUTINE RICOLO(MCHPOI,ICLE,MRIGID)

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

C***********************************************************************
C NOM         : RICOLO
C DESCRIPTION : Transforme un CHPOINT MCHPOI en matrice colonne MRIGID
C               En pratique on fait plein de matrices carrees 2x2
C LANGAGE     : ESOPE
C
C AUTEUR, DATE, MODIF :
C  16/02/2012, Benoit Prabel : creation
C
C  ... merci de completer les evolutions futures ...
C
C***********************************************************************
C ENTREES            : MCHPOI (+ autres lectures internes a ricolo)
C ENTREES/SORTIES    :
C SORTIES            : MRIGID
C***********************************************************************

-INC PPARAM
-INC CCOPTIO
-INC CCHAMP

-INC SMRIGID
-INC SMCOORD
-INC SMCHPOI
-INC SMELEME
-INC SMLMOTS

      CHARACTER*(LOCOMP) MODUAL,MOPRIM
      CHARACTER*4 MOSYM(3),MOOPT(2)
      CHARACTER*4 MOMOT(1)
      CHARACTER*8 LETYPE
      DATA MOSYM/'SYME','ANTI','QUEL'/
      DATA MOOPT/'PRIM','DUAL'/
      DATA MOMOT(1) /'TYPE'/
      LOGICAL     fldiag

c***********************************************************************
c Executable statements
c***********************************************************************

c======================================================================c
c RECUPERATION DES AUTRES OBJETS d ENTREE ET VERIFICATION DES DONNEES

c     colonne ou ligne = seuls choix possibles
      IF(ICLE.ne.2.and.ICLE.ne.3) THEN
        write(IOIMP,*) 'VALEUR DE ICLE ERRONNEE =',ICLE
     &                ,' LORS DE L APPEL A RICOLO ERRONNE'
        CALL ERREUR(21)
        RETURN
      ENDIF

c     symetrique, antisymetrique ou quelconque (syme par defaut)
      ISYM = 0
      CALL LIRMOT(MOSYM,3,ISYM,0)
      if(ISYM.eq.0) ISYM=1

*     LECTURE DU SUPPORT GEOMETRIQUE (1 seul point admis pour l instant)
      CALL LIROBJ('POINT   ',KPOINT,1,IRETOU)
      IF(IRETOU.EQ.0)THEN
        CALL ERREUR(20)
        RETURN
      ENDIF
      IF(IERR.NE.0)   RETURN
c       CALL CRELEM(KPOINT)
c       IPELEM=KPOINT

*     LECTURE DU NOM DU PRIMAL/DUAL (selon option colonne/ligne )
*      ASSOCIE A KPOINT  + deduction de l'autre
      idd1=0
c     option colonne : on cherche l inconnue primale
      IF(ICLE.eq.2) THEN
         CALL LIRMOT(NOMDD,LNOMDD,idd1,0)
         if (idd1.ne.0) then
           MOPRIM=NOMDD(idd1)
           MODUAL=NOMDU(idd1)
c          si mot cle 'DUAL' + nom du dual alors MODUAL prend ce nom-la
           CALL LIRMOT(MOOPT(2),1,IOPT,0)
           if(iopt.ne.0) then
             CALL LIRCHA(MODUAL,1,IRETOU)
             IF(IERR.NE.0) RETURN
           endif
         else
           CALL LIRCHA(MOPRIM,1,IRETOU)
           CALL LIRMOT(MOOPT(2),1,IOPT,0)
           if(iopt.ne.0) then
             CALL LIRCHA(MODUAL,1,IRETOU)
             IF(IERR.NE.0) RETURN
           else
             MODUAL=MOPRIM
           write(IOIMP,*) 'Attention vous utilisez l inconnue PRIMale '
     $                   ,MOPRIM,' non definie dans NOMDD du bdata...'
           write(IOIMP,*) 'On utilise ',MODUAL,' comme DUALe associee'
           endif
         endif
      ENDIF
c     option ligne : on cherche l inconnue duale
      IF(ICLE.eq.3) THEN
         CALL LIRMOT(NOMDU,LNOMDU,idd1,0)
         if (idd1.ne.0) then
           MOPRIM=NOMDD(idd1)
           MODUAL=NOMDU(idd1)
c          si mot cle 'PRIM' + nom du primal alors MOPRIM prend ce nom-la
           CALL LIRMOT(MOOPT(1),1,IOPT,0)
           if(iopt.ne.0) then
             CALL LIRCHA(MOPRIM,1,IRETOU)
             IF(IERR.NE.0) RETURN
           endif
         else
           CALL LIRCHA(MODUAL,1,IRETOU)
           CALL LIRMOT(MOOPT(1),1,IOPT,0)
           if(iopt.ne.0) then
             CALL LIRCHA(MOPRIM,1,IRETOU)
             IF(IERR.NE.0) RETURN
           else
             MOPRIM=MODUAL
           write(IOIMP,*) 'Attention vous utilisez l inconnue DUALe '
     $                    ,MODUAL,' non definie dans NOMDU du bdata...'
           write(IOIMP,*) 'On utilise ',MOPRIM,' comme PRIMale associee'
           endif
         endif
      ENDIF
      if(iimpi.ge.1)write(IOIMP,*)'ICLE,PRIMAL,DUAL',ICLE,MOPRIM,MODUAL
      IF(IERR.NE.0) RETURN


      MLMOT1=0
      MLMOT2=0
      CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETOU)
      IF(MLMOT1.ne.0) THEN
        CALL LIROBJ('LISTMOTS',MLMOT2,1,IRETOU)
        IF(IERR.NE.0) RETURN
        segact,MLMOT1,MLMOT2
        NLMOT1=MLMOT1.MOTS(/2)
        NLMOT2=MLMOT2.MOTS(/2)
      ENDIF


c======================================================================c
C TRAVAIL SUR LE CHPOINT

      SEGACT MCHPOI
      NSOUPO = IPCHP(/1)
C On compte le nombre de matrices a generer
      NRIGEL=0
      DO ISOUPO = 1, NSOUPO
         MSOUPO = IPCHP(ISOUPO)
         SEGACT MSOUPO
         NC=NOCOMP(/2)
         NRIGEL=NRIGEL+NC
         SEGDES MSOUPO
      ENDDO
      SEGINI MRIGID
* BP 01/04/2014 ajout d'un type a la rigidite (recopie de manuri.eso)
*     -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
      ITYP = 0
      CALL LIRMOT(MOMOT,1,ITYP,0)
      IF(ITYP.EQ.1) THEN
         ICODE = 1
         CALL LIRCHA (LETYPE,ICODE,IRETOU)
         IF (IERR .NE. 0) RETURN
      ELSE
C ... Si on n'a rien trouve, on met un sous type par defaut dedans
        IF(ICLE.eq.2) LETYPE='COLONNE '
        IF(ICLE.eq.3) LETYPE='LIGNE   '
      ENDIF
      MTYMAT=LETYPE
      IFORIG = IFOPOI
C
      IRIG=0
C====> BOUCLE SUR LES ZONES DU CHPOINT ======================
      DO ISOUPO = 1, NSOUPO
         if(iimpi.ge.2) write(IOIMP,*)' Sous-zone',ISOUPO,'/',NSOUPO
         MSOUPO = IPCHP(ISOUPO)
         SEGACT MSOUPO
         NC=NOCOMP(/2)
         MELEME=IGEOC
         SEGACT MELEME
         NBEL=NUM(/2)
c Le meleme d un chpoint est constitue de poi1 (=elements a 1 noeud)
c creation d une geometrie IPT1 avec KPOINT + IGEOC (=> 1+1=2 noeuds)
           NBNN=2
           NBSOUS=0
           NBREF=0
           NBELEM=NBEL
           SEGINI,IPT1
           IPT1.ITYPEL=28
           Jdiag = 0
           DO JEL=1,NBEL
              IPT1.NUM(1,JEL)=KPOINT
              IPT1.NUM(2,JEL)=NUM(1,JEL)
*             on repere une eventuelle diagonale
              if(IPT1.NUM(1,JEL).eq.IPT1.NUM(2,JEL)) Jdiag=JEL
           ENDDO
c fin de fabrication de IPT1
         SEGDES,MELEME,IPT1
         MPOVAL=IPOVAL
         SEGACT MPOVAL

C   ---> BOUCLE SUR LES COMPOSANTES ---------
         DO IC=1,NC

            IRIG=IRIG+1
            if(iimpi.ge.2)
     &      write(IOIMP,*)' Composante',IC,'/',NC,' -> rigidite ',IRIG

c        ---infos generales---
            COERIG(IRIG)=1.D0
            IRIGEL(1,IRIG)=IPT1
            IRIGEL(5,IRIG)=NIFOUR
            IRIGEL(7,IRIG)=ISYM-1
            NLIGRP=2
            NLIGRD=2

c        ---segment DESCRipteur---
            SEGINI DESCR
            LISINC(1)=MOPRIM
            LISDUA(1)=MODUAL
            NOELEP(1)=1
            NOELED(1)=1
            NOELEP(2)=2
            NOELED(2)=2

*          -Cas colonne : on a un chpoint de dual : il faut retrouver le primal
            IF(ICLE.eq.2) THEN

              idd2=0
c             cas ou on a fourni MLMOT1 et MLMOT2
              IF(MLMOT1.ne.0) THEN
                CALL PLACE(MLMOT1.MOTS,NLMOT1,idd2,NOCOMP(IC))
                IF (idd2.NE.0) THEN
                   LISINC(2)=MLMOT2.MOTS(idd2)
                ELSE
                  write(IOIMP,*) 'On ne trouve pas ',NOCOMP(IC),
     $                           ' dans le listmot ',MLMOT1
                  call erreur(488)
                  return
                ENDIF
c             cas ou cherche la correspondance
              ELSE
                CALL PLACE(NOMDU,LNOMDU,idd2,NOCOMP(IC))
                IF (idd2.NE.0) THEN
                   LISINC(2)=NOMDD(idd2)
                ELSE
                   LISINC(2)=NOCOMP(IC)
             write(IOIMP,*) 'Attention le chpoint utilise la duale '
     $          ,NOCOMP(IC),' non definie dans NOMDU du bdata...'
             write(IOIMP,*) 'On utilise ',NOCOMP(IC)
     $                     ,' comme primale associee'
                ENDIF
              ENDIF
              LISDUA(2)=NOCOMP(IC)

*          -Cas ligne : on a un chpoint de primal : il faut retrouver le dual
            ELSE

              idd2=0
c             cas ou on a fourni MLMOT1 et MLMOT2
              IF(MLMOT1.ne.0) THEN
                CALL PLACE(MLMOT1.MOTS,NLMOT1,idd2,NOCOMP(IC))
                IF (idd2.NE.0) THEN
                   LISDUA(2)=MLMOT2.MOTS(idd2)
                ELSE
                  write(IOIMP,*) 'On ne trouve pas ',NOCOMP(IC),
     $                           ' dans le listmot ',MLMOT1
                  call erreur(488)
                  return
                ENDIF
c             cas ou cherche la correspondance
              ELSE
                CALL PLACE(NOMDD,LNOMDD,idd2,NOCOMP(IC))
                IF (idd2.NE.0) THEN
                   LISDUA(2)=NOMDU(idd2)
                ELSE
                   LISDUA(2)=NOCOMP(IC)
             write(IOIMP,*) 'Attention le chpoint utilise la primale '
     $         ,NOCOMP(IC),' non definie dans NOMDD du bdata...'
             write(IOIMP,*) 'On utilise ',NOCOMP(IC)
     $                     ,' comme duale associee'
                ENDIF
              ENDIF
              LISINC(2)=NOCOMP(IC)

            ENDIF

            if(iimpi.ge.2) then
              write(IOIMP,*)' LISINC = ',(LISINC(iou),iou=1,2)
              write(IOIMP,*)' LISDUA = ',(LISDUA(iou),iou=1,2)
            endif
c           debut du test pour savoir si on se situe sur une diagonale
            fldiag = LISINC(1).eq.LISINC(2).and.LISDUA(1).eq.LISDUA(2)
            SEGDES DESCR
            IRIGEL(3,IRIG)=DESCR

c        ---matrice XMATRI proprement dite ---
            NELRIG=NBEL
            rigrel=0
            SEGINI XMATRI
c          -cas symetrique (cas par defaut)
            IF(ISYM.le.1) THEN
              DO JEL=1,NBEL
c                  RE(1,1,JEL)=0.D0
                 RE(1,2,JEL)=VPOCHA(JEL,IC)
                 RE(2,1,JEL)=VPOCHA(JEL,IC)
c                  RE(2,2,JEL)=0.D0
              ENDDO
c             petite correction pour ne pas remplir 2 fois la meme case !
c             (=cas de la diagonale)
c             rem : inutile dans les cas antisymetrique et quelconque
              if(Jdiag.ne.0.and.fldiag) then
                 RE(1,1,Jdiag)=VPOCHA(Jdiag,IC)
                 RE(1,2,Jdiag)=0.D0
                 RE(2,1,Jdiag)=0.D0
                 RE(2,2,Jdiag)=0.D0
              endif
            ENDIF
c          -cas antisymetrique
            IF(ISYM.eq.2) THEN
            IF(ICLE.eq.2) THEN
              DO JEL=1,NBEL
c                  RE(1,1,JEL)=0.D0
                 RE(1,2,JEL)=-1.D0*VPOCHA(JEL,IC)
                 RE(2,1,JEL)=VPOCHA(JEL,IC)
c                  RE(2,2,JEL)=0.D0
              ENDDO
            ELSE
              DO JEL=1,NBEL
c                  RE(1,1,JEL)=0.D0
                 RE(1,2,JEL)=VPOCHA(JEL,IC)
                 RE(2,1,JEL)=-1.D0*VPOCHA(JEL,IC)
c                  RE(2,2,JEL)=0.D0
              ENDDO
            ENDIF
            ENDIF
c          -cas quelconque
            IF(ISYM.eq.3) THEN
            IF(ICLE.eq.2) THEN
              DO JEL=1,NBEL
c                  RE(1,1,JEL)=0.D0
c                  RE(1,2,JEL)=0.D0
                 RE(2,1,JEL)=VPOCHA(JEL,IC)
c                  RE(2,2,JEL)=0.D0
              ENDDO
            ELSE
              DO JEL=1,NBEL
c                  RE(1,1,JEL)=0.D0
                 RE(1,2,JEL)=VPOCHA(JEL,IC)
c                  RE(2,1,JEL)=0.D0
c                  RE(2,2,JEL)=0.D0
              ENDDO
            ENDIF
            ENDIF
            if(iimpi.ge.2) then
              write(IOIMP,*)' RE(1,:) = ',(RE(1,iou),iou=1,2)
              write(IOIMP,*)' RE(2,:) = ',(RE(2,iou),iou=1,2)
            endif
            IRIGEL(4,IRIG)=XMATRI
            xmatri.symre=irigel(7,irig)
            SEGDES XMATRI

         ENDDO
C   <--- FIN DE BOUCLE SUR LES COMPOSANTES ---------
         SEGDES MPOVAL
         SEGDES MSOUPO

      ENDDO
C<==== FIN DE BOUCLE SUR LES ZONES DU CHPOINT ======================
      SEGDES MRIGID
      SEGDES MCHPOI

      IF(MLMOT1.ne.0) THEN
         segdes,MLMOT1,MLMOT2
      ENDIF

c***********************************************************************
C Normal termination
c***********************************************************************

      RETURN

c***********************************************************************
c End of subroutine
c***********************************************************************

      END