C D2VTRI    SOURCE    CHAT      05/01/12    22:35:57     5004           
C DEVTRI    SOURCE    LAVARENN  96/10/30    21:22:46     2349           
      SUBROUTINE D2VTRI(Q1,Q2,Q3,NA1,IINS2,FTOTA,XRES,ICHRES,NRES,              
     &                  NCRES,NPRES,XVALA,INULA,NLIAA,NLSA,XRESLA,              
     &                  XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,ILIREB,            
     &                  NTVAR,WEXT,WINT,XCHPFB,NPLB)                                                  
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
*--------------------------------------------------------------------*          
*                                                                    *          
*     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *          
*     ________________________________________________               *          
*                                                                    *          
*     Transfert des quantit{s initiales dans le tableau de           *          
*     sauvegarde, si l'on souhaite les garder ...                    *          
*                                                                    *          
*     Param}tres:                                                    *          
*                                                                    *          
* e   Q1(.,.) Vecteur des d{placements g{n{ralis{s                   *          
* e   Q2(.,.) Vecteur des vitesses g{n{ralis{s                       *          
* e   Q3(.,.) Vecteur des acc{l{rations g{n{ralis{s                  *          
* e   NA1     Nombre total d'inconnues en base A                     *          
* e   IINS2   Num{ro du pas de sortie                                *          
* e   FTOTA   Forces ext{rieures totalis{es en base A                *          
* es  XRES    Valeurs des variables sauvegard{es                     *          
* e   ICHRES  Indique quelles variables seront sauvegard{es          *          
* e   NRES    Nombre de variables ( principales et auxilliaires )    *          
* e   NCRES   Nombre de valeurs prises par les variables             *          
* e   NPRES   Nombre de pas de sortie                                *          
* e   XVALA   Tableau contenant les variables internes de liaison    *          
* e   INULA   Tableau contenant les rep}res des liaisons             *          
* e   NLIAA   Nombre de liaisons sur la base A                       *          
* e   NLSA    Nombre de liaisons en sortie bas A                     *          
* es  XRESLA  Valeurs de variables de liaisons sauvegard{es base B   *          
* e   XVALB   Tableau contenant les variables internes de liaison    *          
* e   INULB   Tableau contenant les rep}res des liaisons             *          
* e   NLIAB   Nombre de liaisons sur la base B                       *          
* e   NLSB    Nombre de liaisons en sortie bas B                     *          
* es  XRESLB  Valeurs de variables de liaisons sauvegard{es base B   *
* e,s WEXT   travail des forces exterieures 
* e,s WINT   travail des forces interieures (rigidite et
*            amortissement et forces de liaison )              
*                                                                    *          
*     Auteur, date de cr{ation:                                      *          
*                                                                    *          
*     Lionel VIVAN, le 1 septembre 1989.                             *          
*                                                                    *          
*--------------------------------------------------------------------*          
      REAL*8 Q1(NA1,*),Q2(NA1,*),Q3(NA1,*)                                      
      REAL*8 XVALA(NLIAA,4,*),XRESLA(NLSA,NPRES,*)                              
      REAL*8 XVALB(NLIAB,4,*),XRESLB(NLSB,NPRES,*)                              
      REAL*8 FTOTA(NA1,*),XRES(NRES,NCRES,*)   
      REAL*8 XCHPFB(2,NLIAB,4,*)                                 
      INTEGER ICHRES(*),INULA(*),INULB(*),ILIREA(NLSA,*),ILIREB(NLSB,*)         
*                                                                               
*     Sauvegarde des valeurs initiales                                          
*                                                                               
      IF (NRES.NE.0) THEN                                                       
         KRES = 0                                                               
         IF (ICHRES(1).EQ.1) THEN                                               
            KRES = KRES + 1                                                     
            DO 10 I=1,NA1                                                       
               XRES(KRES,I,IINS2) = Q1(I,2)                                     
 10            CONTINUE                                                         
*           end do                                                              
         ENDIF                                                                  
         IF (ICHRES(2).EQ.1) THEN                                               
            KRES = KRES + 1                                                     
            DO 12 I=1,NA1                                                       
               XRES(KRES,I,IINS2) = Q2(I,2)                                     
 12            CONTINUE                                                         
*           end do                                                              
         ENDIF                                                                  
                                 
         IF (ICHRES(5).EQ.1) THEN                                               
            KRES = KRES + 1                                                     
            DO 18 I=1,NA1                                                       
               XRES(KRES,I,IINS2) = Q3(I,2)                                     
 18            CONTINUE                                                         
*           end do                                                              
         ENDIF                                                                  


cc travaux
         IF (ICHRES(7).EQ.1) THEN                                               
            KRES = KRES + 1                                                     
            DO 60 I=1,NA1                                                       
               XRES(KRES,I,IINS2) = 0.d0                                     
 60            CONTINUE                                                                                                                     
         ENDIF                    
         IF (ICHRES(7).EQ.1) THEN                                               
            KRES = KRES + 1                                                     
            DO 70 I=1,NA1                                                       
               XRES(KRES,I,IINS2) = 0.d0                                     
 70            CONTINUE                                                                                                                     
         ENDIF 
                                                                 
      ENDIF                                                                     
      IF (ICHRES(9).EQ.1) THEN                                                  
         DO 30 IL = 1,NLSA                                                      
            IIL = INULA(IL)                                                     
            II = 0                                                              
            DO 32 IV = 1,NTVAR                                                  
               IF (ILIREA(IL,IV).EQ.1) THEN                                     
                  II = II + 1                                                   
                  XRESLA(IL,IINS2,II) = XVALA(IIL,2,IV)                         
               ENDIF                                                            
 32            CONTINUE                                                         
*           end do                                                              
 30         CONTINUE                                                            
*        end do                                                                 
      ENDIF                                                                     
      IF (ICHRES(10).EQ.1) THEN                                                 
         DO 40 IL = 1,NLSB                                                      
            IIL = INULB(IL)                                                     
            II = 0                                                              
            DO 42 IV = 1,NTVAR                                                  
               IF (ILIREB(IL,IV).EQ.1) THEN                                     
                  II = II + 1                                                   
                  XRESLB(IL,IINS2,II) = XVALB(IIL,2,IV)                         
               ELSE
                  IF (ILIREB(IL,IV).EQ.2) THEN
                   DO 43 IP=1,NPLB
                    DO 44 ID=1,2
                      II = II + 1                                                   
                      XRESLB(IL,IINS2,II) = XCHPFB(ID,IIL,2,IP) 
 44                 CONTINUE 
 43                CONTINUE
                  ENDIF
*                              
               ENDIF                                                            
 42            CONTINUE                                                         
*           end do                                                              
 40         CONTINUE                                                            
*        end do                                                                 
      ENDIF                                                                     
*                                                                               
      END