Sources Esope | Cast3M

devlb1
C DEVLB1    SOURCE    BP208322  20/09/18    21:15:36     10718          
 
      SUBROUTINE DEVLB1(FTOTB,XPTB,IPALB,IPLIB,JPLIB,XPALB,XVALB,NLIAB,
     &                  NPLB,IDIMB,PDT,NPAS,IND,FEXPSM,NPC1,IERRD,
     &                  FTEST,XABSCI,XORDON,NIP,XCHPFB)
 
*--------------------------------------------------------------------*
*     Opérateur DYNE (de Vogelaere)                                  *
*     Calcul des forces de choc base B                               *
*--------------------------------------------------------------------*
*                                                                    *
*     Paramètres:                                                    *
*                                                                    *
* es  FTOTB   Forces extérieures totalisées sur la base B.           *
* e   XPTB    Tableau des déplacements des points                    *
* e   IPALB   Renseigne sur la liaison.                              *
* e   IPLIB   Tableau contenant les numéros "DYNE" de la liaison.    *
* e   JPLIB   Tableau contenant les numéros "GIBI" de la liaison.    *
* e   XPALB   Tableau contenant les paramètres de la liaison.        *
* es  XVALB   Tableau contenant les variables internes de liaisons.  *
* e   NLIAB   Nombre de liaisons sur la base B.                      *
* e   NPLB    Nombre total de points intervenant dans les liaisons.  *
* e   IDIMB   Nombre de directions.                                  *
* e   PDT     pas de temps.                                          *
* e   NPAS    Numéro du pas de temps.                                *
* e   IND     Indice du pas.                                         *
* e   FEXPSM  Tableau contenant les pseudo-modes.                    *
* e   NPC1                                                           *
* e   XABSCI  Tableau contenant les abscisses de la loi plastique    *
*             pour la liaison point-point- ... -plastique            *
* e   XORDON  Tableau contenant les ordonnees de la loi plastique    *
*             pour la liaison point-point- ... -plastique            *
*                                                                    *
* -   FTEST   Pour tester la force qui sert a enclencher             *
*             les liaisons conditionnelles                           *
*                                                                    *
*--------------------------------------------------------------------*
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
      INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*),JPLIB(*)
      REAL*8  XPALB(NLIAB,*),XPTB(NPLB,2,*),FTOTB(NPLB,*)
      REAL*8  XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
      REAL*8  XABSCI(NLIAB,*),XORDON(NLIAB,*)
      REAL*8  FTEST(NPLB,6)
      REAL*8  XCHPFB(2,NLIAB,4,*)
*     tableaux fortran locaux pour l'instant -> a mettre dans LOCLFB ?
      REAL*8  KTOTXB(NPLB,IDIMB,IDIMB),KTOTVB(NPLB,IDIMB,IDIMB) 
 
*--------------------------------------------------------------------*
*old  IND  ,IND2  : indice courant et precedent
*new  IND  ,IND2  : depl et vitesse courant
*                        |_______________ pas de temps _______________|
*     ____ algorithme ___|__ ind=1 __|__ ind=2  __|_ind=3_|__ ind=4 __|
*old  De_Vogelaere       |  t_{n+1}  |  t_{n+1/2} |  t_n  | t_{n-1/2} |
*                                       ~.                  ~.
*new  De_Vogelaere       |  x_{n+1}  |  x_{n+1}   |  x_n  | x_{n-1/2} |
*     ~. 
*     x =estimation de la vitesse
*---------------------------------------------------------------------*
*     NPA  ,IND1  : pas et indice courant pour les pseudo-modes
*     NPAM1,INDM1 : pas et indice precedent pour les pseudo-modes
*---------------------------------------------------------------------*
      IF (IND.EQ.1) THEN
         NPA = NPAS + 1
         NPAM1 = NPAS + 1
         IND1 = 1
         INDM1 = 2
      ELSEIF (IND.EQ.2) THEN
         NPA = NPAS + 1
         NPAM1 = NPAS
         IND1 = 2
         INDM1 = 1
      ELSE
c        cas particulier de l'initialisation
         NPA = NPAS
         NPAM1 = NPAS
         IND1 = 1
         INDM1 = 2
      ENDIF
      IND2  = IND + 1
      PDTS2 = 0.5D0 * PDT
 
*--------------------------------------------------------------------*
*
*     Boucle sur le nombre de liaisons
*
*--------------------------------------------------------------------*
      DO 10 I = 1,NLIAB
 
         ITYP = IPALB(I,1)
         icond= IPALB(I,4)
         iannul= 0
 
*    --- cas des liaisons conditionnelles
         if (icond .eq. 1 ) then
c  20 car on a defini nipalb = 20 dans dyne22
           DO 101 j = 5,20
             jliai = ipalb(i,j)
             jpliai = abs ( jliai)
             if ( jliai . EQ. 0 ) then
                goto 101
             else
                 jtyp = ipalb(jpliai,1)
                do 102 ik = 1,nplb
                  do 103 jk = 1,idimb
                        ftest(ik,jk) = 0d0
cbp, supprime le 2019-01-15  ftotb0 (ik,jk) = ftotb(ik,jk)
 103              continue
 102            continue
             IF   (jTYP.EQ.1   .OR. jTYP.EQ.3   .OR. jTYP.EQ.103
     &        .OR. jTYP.EQ.5   .OR. jTYP.EQ.6   .OR. jTYP.EQ.7
     &        .OR. jTYP.EQ.100 .OR. jTYP.EQ.101 .OR. jTYP.EQ.102) THEN
             CALL DEVFB1(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
     &               NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
     &               FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul,
     &               KTOTXB,KTOTVB,IDIMB,.false.)
             ELSEIF (jTYP.EQ.11 .or. jTYP.EQ.111
     &   .or. (abs(jTYP)).EQ.13 .OR. jTYP.EQ.113) THEN
              CALL DEVFB2(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
     &               NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
     &               FEXPSM,NPC1,XABSCI,XORDON,NIP,jpliai,iannul)
             ELSEIF (jTYP.EQ.21 .OR. jTYP.EQ.22 .OR. jTYP.EQ.23 
     &          .OR. jTYP.EQ.24 .OR. jTYP.EQ.25 .OR. jTYP.EQ.26
     &          .OR. jTYP.EQ.33 .OR. jTYP.EQ.34 .OR. jTYP.EQ.123
     &          .OR. jTYP.EQ.124 .OR. jTYP.EQ.125 .OR. jTYP.EQ.126
     &          .OR. jTYP.EQ.133 .OR. jTYP.EQ.134 ) THEN
             CALL DEVFB3(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,Nliab,
     &                NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
     &                FEXPSM,NPC1,jpliai,iannul,
     &                KTOTXB,KTOTVB,IDIMB,.false.)
             ELSEIF (jTYP.EQ.31 .OR. jTYP.EQ.32) THEN
             CALL DEVFB4(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
     &               NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
     &               FEXPSM,NPC1,jpliai,IERRD,iannul)
             ELSEIF (ITYP.EQ.16 .OR. ITYP.EQ.17 
     &          .OR. ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
             CALL DEVFB5(jTYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
     &                   NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
     &                   FEXPSM,NPC1,I,XABSCI,XORDON,NIP,iannul)
             ELSEIF (jTYP.EQ.35 .OR. jTYP.EQ.36) THEN
             CALL DEVFB6(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
     &               NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB)
             ELSEIF (jTYP.EQ.37 .OR. jTYP.EQ.38 
     &          .OR. jTYP.EQ.39 .OR. JTYP.EQ.40) THEN
             CALL DEVFB7(jTYP,ftest,XPTB,IPALB,IPLIB,XPALB,XVALB,nliab,
     &               NPLB,IND,IND2,PDTS2,jpliai,iannul,XCHPFB)
             IF (IERRD.NE.0) RETURN
             ENDIF
 
                xff = 0.d0
                do 104 ik = 1,nplb
                  do 105 jk = 1,idimb
                       xff = xff + ( ftest(ik,jk) ** 2)
 105              continue
 104            continue
                xff = xff ** .5
               if (   ((xff .le. 1e-20 ) .and. ( jliai .gt. 0) )
     &           .OR. ((xff .gt. 1e-20 ) .and. ( jliai .lt. 0) )  )
     &            then
                  iannul = 1
               endif
 
             endif
 101       continue
 
        endif
*   --- fin du cas  des  liaisons conditionnelles
 
 
* ------ choc ..._PLAN
*
         IF (ITYP.EQ.1 .OR. ITYP.EQ.3 .OR. ITYP.EQ.103
     &  .OR. ITYP.EQ.5 .OR. ITYP.EQ.6 .OR. ITYP.EQ.7
     &  .OR. ITYP.EQ.100 .OR. ITYP.EQ.101 .OR. ITYP.EQ.102) THEN
*
             CALL DEVFB1(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
     &                  NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
     &                  FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul,
     &                  KTOTXB,KTOTVB,IDIMB,.false.)
*
* ------ choc ..._POINT
*
         ELSEIF (ITYP.EQ.11 .or. ITYP.EQ.111
     &       .or. (abs(ITYP)).EQ.13 .OR. ITYP.EQ.113) THEN
             CALL DEVFB2(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
     &                  NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
     &                  FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul)
*
* ------ choc ..._CERCLE(sauf ligne_cercle)
*
         ELSEIF (ITYP.EQ.21 .OR. ITYP.EQ.22 .OR. ITYP.EQ.23 
     &          .OR. ITYP.EQ.24 .OR. ITYP.EQ.25 .OR. ITYP.EQ.26
     &          .OR. ITYP.EQ.33 .OR. ITYP.EQ.34 .OR. jTYP.EQ.123
     &          .OR. jTYP.EQ.124 .OR. jTYP.EQ.125 .OR. jTYP.EQ.126
     &          .OR. jTYP.EQ.133 .OR. jTYP.EQ.134 ) THEN
 
             CALL DEVFB3(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
     &                  NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
     &                  FEXPSM,NPC1,I,iannul,
     &                  KTOTXB,KTOTVB,IDIMB,.false.)
*
* ------ choc PROFIL_PROFIL_...
*
         ELSEIF (ITYP.EQ.31 .OR. ITYP.EQ.32) THEN
             CALL DEVFB4(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
     &                  NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
     &                  FEXPSM,NPC1,I,IERRD,iannul)
             IF (IERRD.NE.0) RETURN
*
* ------ choc POINT_POINT_ ... _PLASTIQUE
*
         ELSEIF (ITYP.EQ.16 .OR. ITYP.EQ.17 .OR.
     &           ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
*
       CALL DEVFB5(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,NPLB,
     &             IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,FEXPSM,NPC1,
     &             I,XABSCI,XORDON,NIP,iannul)
*
* ------ choc LIGNE_LIGNE
*
         ELSEIF (ITYP.EQ.35 .OR. ITYP.EQ.36) THEN
             CALL DEVFB6(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
     &                  NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
 
*
*------- choc LIGNE_CERCLE
*
         ELSEIF (ITYP.EQ.37 .OR. ITYP.EQ.38
     &      .OR. ITYP.EQ.39 .OR. ITYP.EQ.40) THEN
             CALL DEVFB7(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
     &                  NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)
*
* ------ liaison PALIER_FLUIDE
 
         ELSEIF (ITYP.EQ.60) THEN
            CALL DEVFB8(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
     &                  NPLB,IND,IND2,PDTS2,I,iannul)
 
*
* ------ choc ...........
*
*        ELSEIF (ITYP.EQ.  ) THEN
*            CALL DEVFB (ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
*    &                  NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
*    &                  FEXPSM,NPC1,I,iannul)
         ENDIF
 
 
 10      CONTINUE
 
 
      END