C DEVEQ6    SOURCE    BP208322  18/12/20    21:15:27     10048          
C
c       SUBROUTINE DEVEQ6(Q2,NA1,XK,XASM,XM,PDT,NPAS,FTOTA,FAMOR,
      SUBROUTINE DEVEQ6(Q2,NA1,XM,PDT,NPAS,FTOTA,FAMOR,
     &                  XOPM1,NB1,NB1M)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Operateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Calcul des vitesses generalisees pour le premier demi-pas      *
*     de temps.                                                      *
*                                                                    *
*     Param}tres:                                                    *
*                                                                    *
* es  Q2(.,.) Vecteur des vitesses generalisees                      *
* e   NA1     Nombre total d'inconnues dans la base A                *
* e   XM      Vecteur des masses generalisees                        *
* e   PDT     pas de temps                               *
* e   NPAS    Numero du pas de temps                                 *
* e   FTOTA   Forces exterieures totalisees, sur la base A           *
*                                                                    *
*     Auteur, date de creation:                                      *
*     Benoit PRABEL, 16/02/2015                                      *
*                                                                    *
*--------------------------------------------------------------------*
c       REAL*8 XK(*),XASM(NA1,*),XM(*),FTOTA(NA1,*),Q2(NA1,*)
      REAL*8 XM(*),FTOTA(NA1,*),Q2(NA1,*)
      REAL*8 XOPM1(NB1,NB1,*),FAMOR(NA1,*),F2ND(NB1)
*
*
*     .
*     Q        = [4 + dt M^-1 C]^-1 *
*      i,m+1/2
*                        .                                    .
*                    ( 4 Q    + h M^-1 ( F    + F        - C  Q   ) )
*                         i,m             i,m    i,m+1/2    j  j,m
*
c C     CALCUL DU TERME AVEC C (MATRICE C PLEINE)
c       IF(NB1C.GT.1) THEN
c         DO 11 IA=1,NA1
c           FAMOR(IA) = 0.D0
c         DO 11 IB=1,NB1
c           FAMOR(IA) = FAMOR(IA) + (XASM(IA,IB)*Q2(IB,3))
c  11     CONTINUE
c C     CALCUL DU TERME AVEC C (MATRICE C DIAGO)
c       ELSE
c         DO 10 IA=1,NA1
c           FAMOR(IA) = XASM(IA,1)*Q2(IB,3)
c  10     CONTINUE
c       ENDIF
c  --> deja fait par devlc0

C     CALCUL DU 2ND MEMBRE

C     MATRICE M PLEINE
      IF(NB1M.GT.1) THEN

        DO 31 IA=1,NA1
          AUX = 0.D0
          DO 32 IB=1,NB1
            AUX = AUX
     &      + XOPM1(IA,IB,3)*(FTOTA(IB,3) + FTOTA(IB,2) - FAMOR(IB,3))
 32       CONTINUE
          F2ND(IA) = 4.D0*Q2(IA,3) + PDT*AUX
 31     CONTINUE


C     MATRICE M DIAGO
      ELSE

        DO 30 I=1,NA1
           F2ND(I) =  (4.D0*Q2(I,3))
     &     + (PDT*(FTOTA(I,3) + FTOTA(I,2) - FAMOR(I,3))/XM(I))
 30     CONTINUE

      ENDIF

      DO 20 IA = 1,NA1
        Q2(IA,2) = 0.D0
      DO 20 IB = 1,NA1
        Q2(IA,2) = Q2(IA,2) + (XOPM1(IA,IB,1)*F2ND(IB))
 20   CONTINUE


      END