Numérotation des lignes :

C LUMPIN    SOURCE    CHAT      09/10/09    21:20:30     6519      SUBROUTINE LUMPIN(IRIG,LMOT,ILUM)**************************************************************************     LUMPING D'UNE MATRICE*             ENTREE : IRIG POINTEUR SUR LA MATRICE A LUMPER*                      LMOT POINTEUR SUR LISTMOTS, 0 SI PAS DONNE**             SORTIE : ILUM POINTEUR SUR LA MATRICE LUMPEE**     M. PETIT DECEMBRE 89*************************************************************************      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)-INC SMRIGID-INC SMLMOTS**    NE PAS ENLEVER LA CARTE DEBILE QUI SUIT*      MLMOTS=IRIG*      NMOT=0      IF (LMOT.NE.0) THEN        MLMOTS=LMOT        SEGACT MLMOTS        NMOT=MOTS(/2)      ENDIF*      RI1=IRIG      SEGACT RI1      NRIGE=RI1.IRIGEL(/1)      NRIGEL=RI1.IRIGEL(/2)      SEGINI MRIGID      ILUM=MRIGID      DO 100 I=1,NRIGEL      DESCR=RI1.IRIGEL(3,I)      SEGACT DESCR      NLIGRP=LISINC(/2)      NLIGRD=LISDUA(/2)**  TEST DE MATRICE CARREE*      IF(NLIGRP.NE.NLIGRD) THEN        CALL ERREUR(26)        SEGDES DESCR,RI1        SEGSUP MRIGID        IF(LMOT.NE.0) SEGDES MLMOTS        RETURN      ENDIF*      xMATR1=RI1.IRIGEL(4,I)      SEGACT xMATR1      NELRIG=xMATR1.re(/3)      SEGINI xMATRI      IRIGEL(4,I)=xMATRI      DO 200 J=1,NELRIG*      XMATR1=IMATR1.IMATTT(J)*      SEGACT XMATR1*      SEGINI XMATRI*      IMATTT(J)=XMATRI*         DO 300 K=1,NLIGRP         SOMM=0.D0         IF (LMOT.EQ.0) THEN           DO 40 JJ=1,NLIGRP            RE(K,JJ)=0.D0            SOMM=SOMM+XMATR1.RE(K,JJ,j)40         CONTINUE           RE(K,K,j)=SOMM         ELSE           KDIAG=0           DO 21 KK=1,NMOT             IF (MOTS(KK).EQ.LISINC(K)) THEN                KDIAG=1                GO TO 20             ENDIF 21        CONTINUE 20        CONTINUE*           IF(KDIAG.EQ.0) THEN             DO 50 JJ=1,NLIGRP             RE(K,JJ)=0.D0             DO 51 JJJ=1,NMOT               IF (MOTS(JJJ).EQ.LISINC(JJ)) GOTO 5051           CONTINUE             SOMM=SOMM+XMATR1.RE(K,JJ,j)50           CONTINUE             RE(K,K,j)=SOMM           ELSE             DO 52 JJ=1,NLIGRP             RE(K,JJ,j)=0.D0 52          CONTINUE             RE(K,K,j)=XMATR1.RE(K,K,j)           ENDIF         ENDIF300      CONTINUE*      SEGDES XMATR1,XMATRI200   CONTINUE      SEGDES xMATR1,xMATRI      SEGINI,DES1=DESCR      IRIGEL(3,I)=DES1      SEGDES DESCR,DES1      IRIGEL(1,I)=RI1.IRIGEL(1,I)      IRIGEL(2,I)=RI1.IRIGEL(2,I)      IRIGEL(5,I)=RI1.IRIGEL(5,I)      IRIGEL(6,I)=RI1.IRIGEL(6,I)      COERIG(I)=RI1.COERIG(I)100   CONTINUE      MTYMAT=RI1.MTYMAT      IFORIG=RI1.IFORIG      ISUPEQ=RI1.ISUPEQ      SEGDES RI1      IMGEO1=0      IMGEO2=0      ICHOLE=0      SEGDES MRIGID      IF (LMOT.NE.0) SEGDES MLMOTS      RETURN      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales