C RIMB      SOURCE    PV090527  26/04/30    21:16:23     12529          
      subroutine rimb(MYRIG)

********************************************
*   traduction objet rigi en matrik
*              ou    matrik en rigi
*
*******************************************

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


-INC PPARAM
-INC CCOPTIO
-INC SMELEME
      POINTEUR MYMEL.MELEME
-INC SMRIGID
      POINTEUR MYRIG.MRIGID
      POINTEUR MDESCR.DESCR
      POINTEUR MIMAT.xMATRI
*      POINTEUR MXMAT.XMATRI
-INC SMLENTI
      POINTEUR KRINCP.MLENTI
      POINTEUR KRINCD.MLENTI
-INC SMLMOTS
      POINTEUR LIPTOT.MLMOTS
      POINTEUR LIDTOT.MLMOTS
*INC SMMATRIK

      SEGMENT MATRIK
      REAL*8  COEMTK(NMATRI)
      INTEGER jRIGEL(NRIGE,NMATRI)
      INTEGER KSYM,KMINC,KMINCP,KMINCD,KIZM
      INTEGER KISPGT,KISPGP,KISPGD
      INTEGER KNTTT,KNTTP,KNTTD
      INTEGER KIDMAT(NKID)
      INTEGER KKMMT(NKMT)
      ENDSEGMENT
      POINTEUR MYMTK.MATRIK

      SEGMENT jMATRI
      CHARACTER*8 LISPRj(NBME),LISDUb(NBME)
      INTEGER LIZAFM(NBSOUS,NBME)
      INTEGER KSPGP,KSPGD
      ENDSEGMENT
      POINTEUR MJMAT.JMATRI
C Stokage matrices elementaires non assemblees (valeurs)
      SEGMENT IZAFM
      REAL*8  AM(NBEL,NP,MP)
      ENDSEGMENT
      POINTEUR MIZAFM.IZAFM
C
      SEGMENT GMEL
      POINTEUR MELS(NMEL).MELEME
      ENDSEGMENT
      POINTEUR LMLPRI.GMEL
      POINTEUR LMLDUA.GMEL
      POINTEUR LMELP.GMEL
      POINTEUR LMELD.GMEL
      POINTEUR MYMELP.MELEME
      POINTEUR MYMELD.MELEME

      SEGMENT GJMAT
      POINTEUR JMATS(NJMAT).JMATRI
      ENDSEGMENT
      POINTEUR LJMAT.GJMAT
      SEGMENT GIZA
      POINTEUR IZAS(NIZA).IZAFM
      ENDSEGMENT
      POINTEUR LIZA.GIZA
      POINTEUR MIZA.IZAFM
C
      SEGMENT GLENT
      POINTEUR LENTS(NLENT).MLENTI
      ENDSEGMENT
      POINTEUR LLEPRI.GLENT
      POINTEUR LLEDUA.GLENT
      POINTEUR LKRPRI.GLENT
      POINTEUR LKRDUA.GLENT
      POINTEUR MYLNTP.MLENTI
      POINTEUR MYLNTD.MLENTI
      POINTEUR MYKRP.MLENTI
      POINTEUR MYKRD.MLENTI
*
* Déclaration des variables
*
      INTEGER NRIG,NRIGEL,NBME,NNOEL,NP,MP
      INTEGER      KRIGEL,IBME,      IP,ID,IP2,ID2
      INTEGER NLIGRP,NLIGRD
      INTEGER ILIGRP,ILIGRD
      INTEGER NPUNIQ,NDUNIQ,NBEL,NBNN
      INTEGER IPUNIQ,IDUNIQ,IBEL,IBNN,IEL,IELRIG
      INTEGER NPOPQ,NPODQ
      REAL*8 COEF,VAL

      CHARACTER*8 TYPE,TYPP

*
* Passage Rigidité en MATRIK
*
*      write(6,*) ' entree dans rimb nrig',nrig
      IMPR=0
      SEGACT MYRIG
      NRIG  =MYRIG.IRIGEL(/1)
      NRIGEL=MYRIG.IRIGEL(/2)
* Un tests pour voir si on peut faire la conversion
      IF (NRIG.EQ.6) THEN
*            WRITE(IOIMP,*) 'NRIGE.EQ.6, check the output matrix'
      ENDIF
      IMATRI=0
* Calcule de maniere a limiter le nombre de SEGADJ dans la boucle
      INCNMA=MAX(1000,NRIGEL*3)
      NMATRI=INCNMA
      NRIGE = 7
      NKID=9
      NKMT=7
      SEGINI MYMTK
*
      DO 1 KRIGEL=1,NRIGEL
* D'autres tests pour voir si on peut faire la conversion
         IF(MYRIG.IRIGEL(5,KRIGEL).NE.0) THEN
            WRITE(IOIMP,*) 'Harmonique de fourier non nulle'
*  19 2
*Option indisponible
            CALL ERREUR(19)
         ENDIF
         IF(MYRIG.IRIGEL(6,KRIGEL).NE.0) THEN
            WRITE(IOIMP,*) 'Matrice definie par une inegalite'
            CALL ERREUR(19)
         ENDIF
         COEF  =MYRIG.COERIG(KRIGEL)
         MYMEL =MYRIG.IRIGEL(1,KRIGEL)
         SEGACT MYMEL
         NNOEL = MYMEL.NUM(/1)
         NEL   = MYMEL.NUM(/2)
***            MYMTK.JRIGEL(1,KRIGEL)=MYMEL
***            MYMTK.JRIGEL(2,KRIGEL)=MYMEL
* Analyse du segment descripteur
         MDESCR=MYRIG.IRIGEL(3,KRIGEL)
         SEGACT MDESCR
         NLIGRP=MDESCR.NOELEP(/1)
         NLIGRD=MDESCR.NOELED(/1)
* Construction de la liste d'inconnues primales sans doublons
* et du segment de repérage dans cette liste
         JGN=4
         JGM=NLIGRP
         SEGINI LIPTOT
         CALL CUNIQ(MDESCR.LISINC,4,NLIGRP,
     $        LIPTOT.MOTS,NPUNIQ,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         JGN=4
         JGM=NPUNIQ
         SEGADJ,LIPTOT
         JG=NLIGRP
         SEGINI KRINCP
         CALL CREPER(4,NLIGRP,NPUNIQ,MDESCR.LISINC,LIPTOT.MOTS,
     $        KRINCP.LECT,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
* Construction de la liste d'inconnues duales sans doublons
* et du segment de repérage dans cette liste
         JGN=4
         JGM=NLIGRD
         SEGINI LIDTOT
         CALL CUNIQ(MDESCR.LISDUA,4,NLIGRD,
     $        LIDTOT.MOTS,NDUNIQ,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         JGN=4
         JGM=NDUNIQ
         SEGADJ,LIDTOT
         JG=NLIGRD
         SEGINI KRINCD
         CALL CREPER(4,NLIGRD,NDUNIQ,MDESCR.LISDUA,LIDTOT.MOTS,
     $        KRINCD.LECT,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
* Pour chaque inconnue PRIMALE, construction de la liste des noeuds
* (locaux par élément) sur lequel il porte
         NLENT=NPUNIQ
         SEGINI,LLEPRI
         JG=0
         SEGINI,LLEPRI.LENTS(*)
         DO ILIGRP=1,NLIGRP
            IPUNIQ=KRINCP.LECT(ILIGRP)
            MYLNTP=LLEPRI.LENTS(IPUNIQ)
            MYLNTP.LECT(**)=MDESCR.NOELEP(ILIGRP)
         ENDDO
* Suppression des doublons éventuels
         DO IPUNIQ=1,NPUNIQ
            CALL IUNIQ(LLEPRI.LENTS(IPUNIQ).LECT,
     $           LLEPRI.LENTS(IPUNIQ).LECT(/1),
     $           LLEPRI.LENTS(IPUNIQ).LECT,NPOPQ,
     $           IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
            JG=NPOPQ
            SEGADJ,LLEPRI.LENTS(IPUNIQ)
         ENDDO
* segment de repérage dans cette liste
         NLENT=NPUNIQ
         SEGINI,LKRPRI
         JG=NNOEL
         SEGINI,LKRPRI.LENTS(*)
         DO IPUNIQ=1,NPUNIQ
            CALL RSETXI(LKRPRI.LENTS(IPUNIQ).LECT,
     $           LLEPRI.LENTS(IPUNIQ).LECT,
     $           LLEPRI.LENTS(IPUNIQ).LECT(/1))
         ENDDO
* Pour chaque inconnue DUALE, construction de la liste des noeuds
* (locaux par élément) sur lequel il porte
         NLENT=NDUNIQ
         SEGINI,LLEDUA
         JG=0
         SEGINI,LLEDUA.LENTS(*)
         DO ILIGRD=1,NLIGRD
            IDUNIQ=KRINCD.LECT(ILIGRD)
            MYLNTD=LLEDUA.LENTS(IDUNIQ)
            MYLNTD.LECT(**)=MDESCR.NOELED(ILIGRD)
         ENDDO
* Suppression des doublons éventuels
         DO IDUNIQ=1,NDUNIQ
            CALL IUNIQ(LLEDUA.LENTS(IDUNIQ).LECT,
     $           LLEDUA.LENTS(IDUNIQ).LECT(/1),
     $           LLEDUA.LENTS(IDUNIQ).LECT,NPODQ,
     $           IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
            JG=NPODQ
            SEGADJ,LLEDUA.LENTS(IDUNIQ)
         ENDDO
* segment de repérage dans cette liste
         NLENT=NDUNIQ
         SEGINI,LKRDUA
         JG=NNOEL
         SEGINI,LKRDUA.LENTS(*)
         DO IDUNIQ=1,NDUNIQ
            CALL RSETXI(LKRDUA.LENTS(IDUNIQ).LECT,
     $           LLEDUA.LENTS(IDUNIQ).LECT,
     $           LLEDUA.LENTS(IDUNIQ).LECT(/1))
         ENDDO
* Pour chaque inconnue PRIMALE, construction de l'objet géométrie
         NMEL=NPUNIQ
         SEGINI,LMLPRI
         DO IPUNIQ=1,NPUNIQ
            NBNN=LLEPRI.LENTS(IPUNIQ).LECT(/1)
            NBELEM=NEL
            NBSOUS=0
            NBREF=0
            SEGINI,LMLPRI.MELS(IPUNIQ)
            DO IEL=1,NEL
               DO IBNN=1,NBNN
                  MYMELP=LMLPRI.MELS(IPUNIQ)
                  MYLNTP=LLEPRI.LENTS(IPUNIQ)
                  MYMELP.NUM(IBNN,IEL)=
     $                 MYMEL.NUM(MYLNTP.LECT(IBNN),IEL)
               ENDDO
            ENDDO
            SEGDES,LMLPRI.MELS(IPUNIQ)
         ENDDO
* Pour chaque inconnue DUALE, construction de l'objet géométrie
         NMEL=NDUNIQ
         SEGINI,LMLDUA
         DO IDUNIQ=1,NDUNIQ
            NBNN=LLEDUA.LENTS(IDUNIQ).LECT(/1)
            NBELEM=NEL
            NBSOUS=0
            NBREF=0
            SEGINI,LMLDUA.MELS(IDUNIQ)
            DO IEL=1,NEL
               DO IBNN=1,NBNN
                  MYMELD=LMLDUA.MELS(IDUNIQ)
                  MYLNTD=LLEDUA.LENTS(IDUNIQ)
                  MYMELD.NUM(IBNN,IEL)=
     $                 MYMEL.NUM(MYLNTD.LECT(IBNN),IEL)
               ENDDO
            ENDDO
            SEGDES,LMLDUA.MELS(IDUNIQ)
         ENDDO
*
* Initialisation des objets que l'on concatènera dans MATRIK
*
         NMAT=NPUNIQ*NDUNIQ
         NMEL=NMAT
         SEGINI,LMELP
         SEGINI,LMELD
         NJMAT=NMAT
         SEGINI,LJMAT
         NBME=1
         NBSOUS=1
         SEGINI,LJMAT.JMATS(*)
         NIZA=NMAT
         SEGINI,LIZA
         DO IPUNIQ=1,NPUNIQ
            DO IDUNIQ=1,NDUNIQ
*   Initialisation de LIZA
               IMAT=(IPUNIQ-1)*NDUNIQ+IDUNIQ
               NBEL=NEL
               NP=LLEPRI.LENTS(IPUNIQ).LECT(/1)
               MP=LLEDUA.LENTS(IDUNIQ).LECT(/1)
               rigrel=0
               SEGINI,LIZA.IZAS(IMAT)
*   Initialisation de LJMAT
               MJMAT=LJMAT.JMATS(IMAT)
               MJMAT.LISPRJ(1)=LIPTOT.MOTS(IPUNIQ)//'    '
               MJMAT.LISDUB(1)=LIDTOT.MOTS(IDUNIQ)//'    '
               MJMAT.LIZAFM(1,1)=LIZA.IZAS(IMAT)
*   Initialisation de LMELP et LMELD
               LMELP.MELS(IMAT)=LMLPRI.MELS(IPUNIQ)
               LMELD.MELS(IMAT)=LMLDUA.MELS(IDUNIQ)
            ENDDO
         ENDDO
*
* Boucle sur les matrices élémentaires de MYRIG
* et recopie des valeurs dans les IZAS de LIZA
*
         MIMAT=MYRIG.IRIGEL(4,KRIGEL)
         SEGACT MIMAT
         NELRIG=MIMAT.re(/3)
         DO IELRIG=1,NELRIG
*            MXMAT=MIMAT.IMATTT(IELRIG)
*            SEGACT MXMAT
            DO ILIGRP=1,NLIGRP
               IPUNIQ=KRINCP.LECT(ILIGRP)
               IP=MDESCR.NOELEP(ILIGRP)
               MYKRP=LKRPRI.LENTS(IPUNIQ)
               DO ILIGRD=1,NLIGRD
                  IDUNIQ=KRINCD.LECT(ILIGRD)
                  ID=MDESCR.NOELED(ILIGRD)
                  MYKRD=LKRDUA.LENTS(IDUNIQ)
                  IMAT=(IPUNIQ-1)*NDUNIQ+IDUNIQ
                  MIZA=LIZA.IZAS(IMAT)
                  IBEL=IELRIG
                  IP2=MYKRP.LECT(IP)
                  ID2=MYKRD.LECT(ID)
                  VAL=MIMAT.RE(ILIGRD,ILIGRP,ielrig)
                  MIZA.AM(IBEL,IP2,ID2)=VAL*COEF
               ENDDO
            ENDDO
*            SEGDES MXMAT
         ENDDO
         SEGDES MIMAT
         SEGDES,LIZA.IZAS(*)
         SEGSUP,LIZA
         SEGDES,LJMAT.JMATS(*)
*
* Concaténation des valeurs dans l'objet MATRIK
*
         NMATAV=IMATRI
*         NMATAP=IMATRI+NMAT
         IMATRI=IMATRI+NMAT
         IF (IMATRI.GT.NMATRI) THEN
            NMATRI=IMATRI+INCNMA
            NRIGE = 7
            NKID=9
            NKMT=7
            SEGADJ,MYMTK
         ENDIF
         DO IMAT=1,NMAT
            MYMTK.JRIGEL(1,NMATAV+IMAT)=LMELP.MELS(IMAT)
            MYMTK.JRIGEL(2,NMATAV+IMAT)=LMELD.MELS(IMAT)
            MYMTK.JRIGEL(4,NMATAV+IMAT)=LJMAT.JMATS(IMAT)
            MYMTK.JRIGEL(7,NMATAV+IMAT)=3
         ENDDO
         SEGSUP,LJMAT
         SEGSUP,LMELD
         SEGSUP,LMELP
         SEGSUP,LMLDUA
         SEGSUP,LMLPRI
         SEGSUP,LKRDUA.LENTS(*)
         SEGSUP,LKRDUA
         SEGSUP,LLEDUA.LENTS(*)
         SEGSUP,LLEDUA
         SEGSUP,LKRPRI.LENTS(*)
         SEGSUP,LKRPRI
         SEGSUP,LLEPRI.LENTS(*)
         SEGSUP,LLEPRI
         SEGSUP KRINCP
         SEGSUP LIDTOT
         SEGSUP KRINCD
         SEGSUP LIPTOT
         SEGDES MDESCR
         SEGDES MYMEL
 1    CONTINUE
      NMATRI=IMATRI
      NRIGE = 7
      NKID=9
      NKMT=7
      SEGADJ,MYMTK
*
      SEGDES MYMTK
      SEGDES MYRIG
      CALL ECROBJ('MATRIK',MYMTK)
      RETURN
*
* Error handling
*
 9999 CONTINUE
      WRITE(IOIMP,*) 'An error was detected in subroutine rima'
      RETURN
      END