Sources Esope | Cast3M

devtri
C DEVTRI    SOURCE    BP208322  17/07/18    21:15:09     9498           
      SUBROUTINE DEVTRI(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)
*--------------------------------------------------------------------*
*                                                                    *
*     Operateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Transfert des quantites initiales dans le tableau de           *
*     sauvegarde, si l'on souhaite les garder ...                    *
*                                                                    *
*     Param}tres:                                                    *
*                                                                    *
* e   Q1(.,.) Vecteur des deplacements generalises                   *
* e   Q2(.,.) Vecteur des vitesses generalises                       *
* e   Q3(.,.) Vecteur des accelerations generalises                  *
* e   NA1     Nombre total d'inconnues en base A                     *
* e   IINS2   Numero du pas de sortie                                *
* e   FTOTA   Forces exterieures totalisees en base A                *
* es  XRES    Valeurs des variables sauvegardees                     *
* e   ICHRES  Indique quelles variables seront sauvegardees          *
* 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 sauvegardees 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 sauvegardees 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 creation:                                      *
*                                                                    *
*     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
 
c       +deplacement 
         IF (ICHRES(1).GE.1) THEN
            KRES = KRES + 1
            DO 10 I=1,NA1
               XRES(KRES,I,IINS2) = Q1(I,3)
 10         CONTINUE
         ENDIF
c       +vitesse 
         IF (ICHRES(2).GE.1) THEN
            KRES = KRES + 1
            DO 12 I=1,NA1
               XRES(KRES,I,IINS2) = Q2(I,3)
 12         CONTINUE
         ENDIF
c       +deplacement demi-pas 
         IF (ICHRES(3).GE.1) THEN
            KRES = KRES + 1
            DO 14 I=1,NA1
               XRES(KRES,I,IINS2) = Q1(I,4)
 14         CONTINUE
         ENDIF
c       +vitesse demi-pas 
         IF (ICHRES(4).GE.1) THEN
            KRES = KRES + 1
            DO 16 I=1,NA1
               XRES(KRES,I,IINS2) = Q2(I,4)
 16         CONTINUE
         ENDIF
c       +acceleration 
         IF (ICHRES(5).GE.1) THEN
            KRES = KRES + 1
            DO 18 I=1,NA1
               XRES(KRES,I,IINS2) = Q3(I,3)
 18         CONTINUE
         ENDIF
c       +acceleration demi-pas
         IF (ICHRES(6).GE.1) THEN
            KRES = KRES + 1
            DO 20 I=1,NA1
               XRES(KRES,I,IINS2) = Q3(I,4)
 20         CONTINUE
         ENDIF
 
c       +travail exterieur
         IF (ICHRES(7).GE.1) THEN
            KRES = KRES + 1
            DO 60 I=1,NA1
               XRES(KRES,I,IINS2) = 0.d0
 60         CONTINUE
         ENDIF
c       +travail interieur
         IF (ICHRES(8).GE.1) THEN
            KRES = KRES + 1
            DO 70 I=1,NA1
               XRES(KRES,I,IINS2) = 0.d0
 70         CONTINUE
         ENDIF
 
      ENDIF
 
c    +liaisons_A
      IF (ICHRES(9).GE.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,3,IV)
               ENDIF
 32         CONTINUE
 30      CONTINUE
      ENDIF
c    +liaisons_B
      IF (ICHRES(10).GE.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,3,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,3,IP)
 44                 CONTINUE
 43                CONTINUE
                  ENDIF
*
               ENDIF
 42          CONTINUE
 40       CONTINUE
      ENDIF
*
      END