C COPMAT    SOURCE    BP208322  12/10/03    21:15:05     7517           
      SUBROUTINE COPMAT(MELEME,X1,RI1,DELTI,DELTJ,XMATRI)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
*
*****************************************************************************
*            POSITIONNEMENT D'UNE MATRICE NxN DANS UN ANGLE                 *
*                    D'UNE MATRICE 2Nx2N POUR LE QZ                         *
* _________________________________________________________________________ *
*                                                                           *
*      DATE : le 24 Fevrier 1995                                            *
*      AUTEUR : Nicolas BENECH                                              *
* _________________________________________________________________________ *
*                                                                           *
*      MODULE(S) APPELANT(S) : ASSMAT                                       *
*                                                                           *
*      MODULE(S) APPELE(S) : POSPT                                          *
*                                                                           *
* _________________________________________________________________________ *
*                                                                           *
*      EN ENTREE :                                                          *
*         MELEME : maillage permettant d'ordonner les valeurs               *
*         X1, RI1 : coefficient et matrice a inserer                        *
*         DELTI, DELTJ : decalage ligne/colonne pour l'insertion            *
* _________________________________________________________________________ *
*                                                                           *
*      EN SORTIE :                                                          *
*         XMATRI : matrice 2nx2n subissant l'insertion                      *
*                  (actif et modifiable en entree/sortie)                   *
*                                                                           *
*****************************************************************************
*
*
-INC CCOPTIO
-INC SMELEME
-INC SMRIGID
*
      INTEGER DELTI,DELTJ,I,J
      REAL*8  X1,X1P
      LOGICAL EXISTE
*
cbp       EXISTE = (RI1*X1.NE.0)
      EXISTE = (RI1.NE.0.and.X1.ne.0.)
c       SEGACT, XMATRI*MOD
        N1=INT(XMATRI.RE(/1)/2)
        N2=INT(XMATRI.RE(/2)/2)
        IF (EXISTE) THEN
*
* Tester DELTI / N1 (DELTI<N1), et DELTJ/N2
*
          IF ((DELTI .GT. N1) .OR. (DELTI .LT. 0)
     &      .OR. (DELTJ .GT. N2) .OR. (DELTJ .LT. 0)) THEN
            CALL ERREUR(47)
            RETURN
          ENDIF
*
          SEGACT,RI1
            X1P = X1*RI1.COERIG(1)
            IPT1 = RI1.IRIGEL(1,1)
            XMATR1 = RI1.IRIGEL(4,1)
          SEGDES,RI1
          SEGACT,IPT1,XMATR1
*            XMATR1 = IMATR1.IMATTT(1)
*          SEGDES, IMATR1
*
*          SEGACT, XMATR1
            DO 10, I=DELTI+1,DELTI+N1
              CALL POSPT (MELEME,I-DELTI,IPT1,IP)
              IF (IP .EQ. 0) THEN
                CALL ERREUR(47)
                RETURN
              ENDIF
              DO 10, J=DELTJ+1,DELTJ+N2
                CALL POSPT (MELEME,J-DELTJ,IPT1,JP)
                IF (JP .EQ. 0) THEN
                  CALL ERREUR(47)
                  RETURN
                ENDIF
                XMATRI.RE(I,J,1)=X1P*XMATR1.RE(IP,JP,1)
 10         CONTINUE
          SEGDES,IPT1,XMATR1
*
        ELSE
          DO 20, I=DELTI+1,DELTI+N1
            DO 20, J=DELTJ+1,DELTJ+N2
              XMATRI.RE(I,J,1)=0.d0
 20       CONTINUE
        ENDIF
*
c       SEGDES, XMATRI
*
      RETURN
      END