C DEVPRO    SOURCE    CHAT      05/01/12    22:47:04     5004
      SUBROUTINE DEVPRO(XPHILB,FTOTB,FTOTBA,IBASB,INMSB,IPLSB,IORSB,
     &                  NSB,NPLSB,NA2,IDIMB,NPLB,NA1)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Projection des forces base r{elle sur base A.                  *
*                                                                    *
*     Param}tres:                                                    *
*                                                                    *
* e   XPHILB  Tableau des vecteurs propres aux points de liaisons.   *
* e   FTOTB   Tableau des forces sur base B.                         *
*  s  FTOTBA  Tableau des forces base B projet{es sur base A.        *
* e   IBASB   Indique dans quelle sous base appartient le point de   *
*             liaison.                                               *
* e   INMSB   Nombre de modes par sous base.                         *
* e   IORSB   Donne l'indice du premier mode de la sous base dans    *
*             l'ensemble des modes.                                  *
* e   NSB     Nombre total de sous base.                             *
* e   NPLSB   Nombre total de points intervenant dans les liaisons   *
*             d'une sous base.                                       *
* e   NPLB    Nombre total de points intervenant dans les liaisons.  *
* e   IDIMB   Nombre de ddl retenus.                                 *
* e   NA1     Nombre total d'inconnues en base A.                    *
*                                                                    *
*                                                                    *
*     Auteur, date de cr{ation:                                      *
*                                                                    *
*     Lionel VIVAN, le 22 Septembre 1989.                            *
*                                                                    *
*--------------------------------------------------------------------*
*
      INTEGER IBASB(*),INMSB(*),IPLSB(*),IORSB(*)
      REAL*8  XPHILB(NSB,NPLSB,NA2,*),FTOTB(NPLB,*),FTOTBA(*)
*
      DO 10 IN = 1,NA1
         FTOTBA(IN) = 0.D0
 10      CONTINUE
*     end do
      DO 20 IP = 1,NPLB
         ISB  = IBASB(IP)
         IPLB = IPLSB(IP)
         NA3  = INMSB(ISB)
         INA2 = IORSB(ISB) - 1
         DO 30 IN = 1,NA3
            XRET = 0.D0
            DO 40 ID = 1,IDIMB
               XRET = XRET + XPHILB(ISB,IPLB,IN,ID) * FTOTB(IP,ID)
 40            CONTINUE
*           end do
            IN2 = INA2 + IN
            FTOTBA(IN2) = FTOTBA(IN2) + XRET
 30         CONTINUE
*        end do
 20      CONTINUE
*     end do
*
      END

