Sources Esope | Cast3M

devtr1
C DEVTR1    SOURCE    BP208322  20/03/26    21:15:36     10562          
      SUBROUTINE DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES,
     &                  NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA,
     &                  XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,
     &                  ILIREB,NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB,
     &                  WEXT,WINT,XCHPFB,NPLB)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Opérateur DYNE :                                               *
*     Transfert des quantités calculées durant le pas dans le        *
*     tableau de sauvegarde, si l'on souhaite les garder ...         *
*                                                                    *
*--------------------------------------------------------------------*
*                                                                    *
*     Paramètres:                                                    *
*                                                                    *
* e   Q1(.,.) Vecteur de déplacements généralisés                    *
* e   Q2(.,.) Vecteur de vitesses généralisés                        *
* e   Q3(.,.) Vecteur de 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   NINS    On veut une sortie tous les NINS pas de calcul         *
* 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                                *
* es  XREP    Valeurs des variables de reprise de calcul             *
* e   NREP    Nombre de variables de reprise                         *
* e   XMREP   Paramètres de liaison nécessaire @ une reprise         *
* e   IMREP   Paramètres de liaison nécessaire @ une reprise         *
* e   XPALB   Paramètres de liaison                                  *
* e   IPALB   Paramètres de liaison                                  *
* e   XVALA   Tableau contenant les variables internes de liaison A  *
* 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 base A                    *
* es  XRESLA  Valeurs de variables de liaisons sauvegardées base A   *
* e   XVALB   Tableau contenant les variables internes de liaison B  *
* 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 base 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 )
*                                                                    *
*--------------------------------------------------------------------*
      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,*),XREP(NREP,*)
      REAL*8 XPALB(NLIAB,*),XMREP(NLIAB,4,*)
      INTEGER ICHRES(*),INULA(*),INULB(*)
      INTEGER ILIREA(NLSA,*),ILIREB(NLSB,*)
      INTEGER IPALB(NLIAB,*),IMREP(NLIAB,*)
      REAL*8 WEXT(NA1,2),WINT(NA1,2),XCHPFB(2,NLIAB,4,*)
*
*--------------------------------------------------------------------
*     Sauvegarde pour un pas courant :
*--------------------------------------------------------------------
*
      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,1)
 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,1)
 12            CONTINUE
*           end do
         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,2)
 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,2)
 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,1)
 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,2)
 20         CONTINUE
         ENDIF
 
c       +travail exterieur
         IF (ICHRES(7).GE.1) THEN
            KRES = KRES + 1
            DO 60 I=1,NA1
               XRES(KRES,I,IINS2) = WEXT(I,1)
 60         CONTINUE
         ENDIF
c       +travail interieur
         IF (ICHRES(8).GE.1) THEN
            KRES = KRES + 1
            DO 70 I=1,NA1
               XRES(KRES,I,IINS2) = WINT(I,1)
 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,1,IV)
               ENDIF
 32         CONTINUE
 30      CONTINUE
      ENDIF
 
c    +liaisons_B
      IF (ICHRES(10).GE.1) THEN
c        boucle sur les liaisons B
         DO 40 IL = 1,NLSB
            IIL = INULB(IL)
            II = 0
c           boucle sur les grandeurs a sortir pour cette liaison
            DO 42 IV = 1,NTVAR
*             -sortie d'un LISTREEL
               IF (ILIREB(IL,IV).EQ.1) THEN
                  II = II + 1
                  XRESLB(IL,IINS2,II) = XVALB(IIL,1,IV)
c *              --- bp debut du write ---
c                    if(IINS2.le.2) then
c                     write(*,*) '--------- liaison B',IL,'-------'
c                     write(*,*) 'grandeur  ',II,'issue de XVALB',IIL,IV
c                    endif
c *              --- --- --- --- --- --- 
*             -sortie d'un CHPOINT
               ELSEIF (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,1,IP)
 44                 CONTINUE
 43                CONTINUE
               ENDIF
 42          CONTINUE
 40       CONTINUE
      ENDIF
 
*
*--------------------------------------------------------------------
*     Sauvegarde pour une reprise
*--------------------------------------------------------------------
*
      IF (IINS2.EQ.NPRES) THEN
         DO 50 I=1,NA1
            XREP(1,I) = Q1(I,1)
            XREP(2,I) = Q2(I,1)
            XREP(3,I) = Q1(I,2)
            XREP(4,I) = Q2(I,2)
            XREP(5,I) = Q3(I,1)
            XREP(6,I) = Q3(I,2)
            XREP(7,I) = FTOTA(I,1)
            XREP(8,I) = FTOTA(I,2)
            XREP(9,I) = WEXT(I,1)
            XREP(10,I)= WINT(I,1)
 50      CONTINUE 
         IF (NLIAB.NE.0) THEN
            DO 51 I = 1,NLIAB
               ITYP = IPALB(I,1)
               IMREP(I,1) = ITYP
               IMREP(I,2) = IPALB(I,2)
*
* ------ choc élémentaire POINT_PLAN_FROTTEMENT
               IF (ITYP.EQ.3 .OR. ITYP.EQ.103 ) THEN
                  IDIM = IPALB(I,3)
                  ID0 = 9 + 5*IDIM
                  ID1 = 9 + 6*IDIM
                  ID2 = 9 + 7*IDIM
*
c * ------ choc élémentaire POINT_CERCLE_FROTTEMENT sans amortissement
c                ELSEIF (ITYP.EQ.23.OR.ITYP.EQ.123) THEN
c                   IDIM = IPALB(I,3)
c                   ID0 = 6 + 6*IDIM
c                   ID1 = 6 + 7*IDIM
c                   ID2 = 6 + 8*IDIM
cbp,2020
*
* ------ choc élémentaire POINT_CERCLE_FROTTEMENT avec amortissement
               ELSE IF (ITYP.EQ.24.OR.ITYP.EQ.124) THEN
                  IDIM = IPALB(I,3)
c                   ID0 = 7 + 6*IDIM
c                   ID1 = 7 + 7*IDIM
c                   ID2 = 7 + 8*IDIM
                  ID0 = 10 + 6*IDIM
                  ID1 = 10 + 7*IDIM
                  ID2 = 10 + 8*IDIM
 
* ------ choc élémentaire CERCLE_PLAN_FROTTEMENT avec amortissement
* ------ choc élémentaire POINT_POINT_FROTTEMENT
               ELSE IF (ITYP.EQ.13.OR. ITYP.EQ.113 .OR. ITYP.EQ.-13
     &              .OR.ITYP.EQ.6) THEN
                  IDIM = IPALB(I,3)
                  ID0 = 7 + 4*IDIM
                  ID1 = 7 + 5*IDIM
                  ID2 = 7 + 6*IDIM
 
* ------ choc élémentaire CERCLE_PLAN_FROTTEMENT sans amortissement
               ELSE IF (ITYP.EQ.5 ) THEN
                  IDIM = IPALB(I,3)
                  ID0 = 6 + 4*IDIM
                  ID1 = 6 + 5*IDIM
                  ID2 = 6 + 6*IDIM
*
* ------ choc élémentaire LIGNE_LIGNE_FROTTEMENT
*
*               ELSE IF (ITYP.EQ.35 .OR. ITYP.EQ.36) THEN
*
* Ne sert pas pour l 'instant car  modele d'ODEN de frottement
 
 
* ------ choc élémentaire CERCLE_CERCLE_FROTTEMENT
 
              ELSE IF (ITYP.EQ.25  .OR. ITYP.EQ.26 
     &            .or. ITYP.EQ.125 .OR. ITYP.EQ.126) THEN
                  IDIM = IPALB(I,3)
                  IF (ITYP.EQ.25) THEN
                      IDD = 6
                  ELSE
                      IDD = 7
                  ENDIF
                  ID0 = IDD + 6*IDIM
                  ID1 = IDD + 7*IDIM
                  ID2 = IDD + 8*IDIM
                  ID3 = IDD + 2*IDIM
               DO 82 ID = 1,IDIMB
                  XMREP(I,1,ID) = XPALB(I,ID0+ID)
                  XMREP(I,2,ID) = XPALB(I,ID1+ID)
                  XMREP(I,3,ID) = XPALB(I,ID2+ID)
                  XMREP(I,4,ID) = XPALB(I,ID3+ID)
  82              CONTINUE
*              end do
                  GOTO 51
 
* ------ choc élémentaire POINT_PLAN_FLUIDE
*
               ELSE IF (ITYP.EQ.7) THEN
                  IDIM = IPALB(I,3)
                  ID1 = 6 + IDIM
                  XMREP(I,1,1) = XPALB(I,ID1+1)
                  XMREP(I,2,1) = XPALB(I,ID1+2)
                  XMREP(I,3,1) = XPALB(I,ID1+3)
                  GOTO 51
C   si ityp = 100, on sauvegarde le depl. plastique
C                  directement dans devso4
C   NW idem si ITYP = 50/51 ou 16/17  --> dans devso4
C
*
*
* ------ choc ....
*
*              ELSE IF (ITYP.EQ.  ) THEN
*                 ...
*
               ELSE
                  GOTO 51
               ENDIF
 
c  ID0+j : x_adhe  
c  ID1+j : Vglissement
c  ID2+j : Fglissement
               DO 52 ID = 1,IDIMB
                  XMREP(I,1,ID) = XPALB(I,ID0+ID)
                  XMREP(I,2,ID) = XPALB(I,ID1+ID)
                  XMREP(I,3,ID) = XPALB(I,ID2+ID)
  52              CONTINUE
*              end do
  51           CONTINUE
*           end do
         ENDIF
      ENDIF
*
      END