C DEVLK0    SOURCE    BP208322  15/07/22    21:15:24     8586
C DEVLK0    SOURCE    PLAF      89/08/01    21:13:53
      SUBROUTINE DEVLK0(Q1,XK,FTOTA,NA1,NB1K,IND)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Operateur DYNE                                                 *
*     ________________________________________________               *
*                                                                    *
*     Actualisation des forces exterieures totalisees sur la base A  *
*     FTOTA = FTOTA - K*q                                            *
*     Calcule le produit matrice vecteur                             *
*     Distingue le cas matrice diagonal et pleine                    *
*                                                                    *
*     Parametres:                                                    *
*                                                                    *
* e   Q1(,)     Deplacement generalise                               *
* e   XK        Matrice de raideur generalisee                       *
* es  FTOTA     Forces totalisees                                    *
* e   NA1,NB1K  Dimension de la matrice                              *
*               (si NB1K=1, alors matrice diagonale)                 *
* e   IND       Indice du pas                                        *
*                                                                    *
*    -Auteur, date de creation:                                      *
*     Denis ROBERT-MOUGIN, le 22 mai 1989.                           *
*    -Modifs : distinction cas diago et plein                        *
*     Benoit PRABEL, 11/02/2015                                      *
*                                                                    *
*--------------------------------------------------------------------*
      REAL*8 Q1(NA1,*),XK(NA1,*),FTOTA(NA1,*)
*
*
      IF (NB1K.EQ.1) THEN
         DO 100 I=1,NA1
           FTOTA(I,IND) = FTOTA(I,IND) - XK(I,1)*Q1(I,IND)
 100     CONTINUE
c       ELSEIF(NB1K.NE.NA1) THEN
c         CALL ERREUR(832)
c on ne va pas tester a chaque fois que cette subroutine est appelee
      ELSE
         DO 200 I=1,NA1
         DO 200 J=1,NB1K
           FTOTA(I,IND) = FTOTA(I,IND) - XK(I,J)*Q1(J,IND)
 200     CONTINUE
      ENDIF

      END