Sources Esope | Cast3M

devfb8
C DEVFB8    SOURCE    BP208322  20/09/18    21:15:33     10718          
C DEVFB7    SOURCE    PITO1  97/05/15    13:42:00     2237
      SUBROUTINE DEVFB8(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
c      &     NPLB,IND,PDT,NUML,IERREU)
     &     NPLB,IND,IND2,PDTS2,NUML,IERREU)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMLREEL
*--------------------------------------------------------------------*
*                                                                    *
*     Opérateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Calcul sur la base B des forces hydrodynamiques engendrées     *
*     dans un palier par le film fluide sur l'arbre                  *
*     (liaisons de type PALIER)                                      *
*                                                                    *
*     Paramètres:                                                    *
*                                                                    *
* e   ITYP    type de la liaison (=60 ici).                          *
* 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   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   IND     Indice du pas                                          *
* e   IND2    Indice du pas precedent                                *
* e   PDTS2   Durée du pas de temps.                                 *
* e   NUML    Numéro de la liaison.                                  *
* s   IERREU  Indicateur d'erreur                                    *
*                                                                    *
*     Auteur, date de création:                                      *
*                                                                    *
*     Valérie BOISSON : le 15 mai 1997 : Création (Rhode et Li)      *
*     Benoit PRABEL   : janvier 2015   : correction                  *
*                                        + ajout palier court        *
*                                                                    *
*--------------------------------------------------------------------*
*
C On fixe localement les nombres maximum de lobes pour un palier
C et de mailles pour un lobe afin de dimensionner les tableaux
C locaux. Ce choix est arbitraire mais doit permettre la resolution
C de la majorite des problemes reels (on trouve rarement des paliers
C de plus de cinq lobes a ce jour). En cas de modification ulterieure,
C il sera obligatoire de mettre a jour les nouvelles valeurs dans la
C procedure RHODELI.
C
      INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
      REAL*8  XPALB(NLIAB,*),XPTB(NPLB,2,*),FTOTB(NPLB,*)
      REAL*8  XVALB(NLIAB,4,*)
      LOGICAL ARCPAR
      REAL*8 PDT
*
* ----- Récupération des paramètres généraux
*
 
      VISCDY = XPALB(NUML,1)
      XMASVO = XPALB(NUML,2)
      PALM   = XPALB(NUML,3)
      XLONG  = XPALB(NUML,4)
      RARBRE = XPALB(NUML,6)
      VITROT = XPALB(NUML,7)
      EPS1   = XPALB(NUML,8)
      PHI1   = XPALB(NUML,9)
c IMOD renseigne sur le type de palier (rodeli ou court ...)
      IMOD   = IPALB(NUML,5)
C NUMP designe le numero "local" du point support de la liaison
      NUMP = IPLIB(NUML,1)
C NUMO designe le numero "local" du point origine de la liaison
* =0 si il n existe pas
      NUMO = IPLIB(NUML,2)
*
* ----- Initialisations
*
      FNLX=0.D0
      FNLY=0.D0
      PDT=0.D0
 
************************************************************************
*     CAS DES PALIERS CYLINDRIQUES OU A LOBES
*     RESOLU AVEC LE MODELE DE RHODE ET LI
************************************************************************
      IF (IMOD.EQ.1) THEN
 
        NLOBES = IPALB(NUML,6)
        NPARRE = IPALB(NUML,7)
        PRECIS = XPALB(NUML,10)
 
C Soit (R,TETA) le decalage initial du centre du coussinet par rapport
C a l'axe de reference de la structure, exprime en coordonnees polaires :
C R et TETA sont stockees respectivement dans XPALB(NUML,8) et
C XPALB(NUML,9)
*
* ----- Calcul du deplacement et de la vitesse dans le repere local du palier
C
C ------------------->    ------------------>    -------------------->
C DEPLACEMENT_LOCAL(m)  = DECALAGE_COUSSINET  +  DEPLACEMENT_BASE_B(m)
C
        X = EPS1*COS(PHI1)-XPTB(NUMP,1,3)
        Y = EPS1*SIN(PHI1)+XPTB(NUMP,1,2)
c
C -------------->   -------------->
C VITESSE_LOCALE  = VITESSE_BASE_B
C
C                   DEPL(t) - DEPL(t-1)
C                 = ---------------------
C                         PDT
cbp,2020-09          VX = (XPTB(NUMP,IND2,3)-XPTB(NUMP,IND,3))/PDTS2
cbp,2020-09          VY = (XPTB(NUMP,IND,2)-XPTB(NUMP,IND2,2))/PDTS2
          VX = -XPTB(NUMP,2,3)
          VY =  XPTB(NUMP,2,2)
*
* ----- Calcul successif des efforts engendrés par chacun des lobes
*
        DO 1 I=1,NLOBES
*
* -- Récupération des paramètres propres aux lobes
*
            XJEU   = XPALB(NUML,11+NPARRE*(I-1))
            RAYLOB = RARBRE+XPALB(NUML,11+NPARRE*(I-1))
cbp            ASYM   = -XPALB(NUML,14+NPARRE*(I-1))
            ASYM   = XPALB(NUML,12+NPARRE*(I-1))
            PRECHA = XPALB(NUML,13+NPARRE*(I-1))
cbp            ANGDEB = XPALB(NUML,12+NPARRE*(I-1))-ASYM
            ANGDEB = XPALB(NUML,14+NPARRE*(I-1))
            AMPLIT = XPALB(NUML,15+NPARRE*(I-1))
            SURREL = XPALB(NUML,16+NPARRE*(I-1))
            MLREEL = IPALB(NUML,7+I)
            NMAIL  = PROG(/1)/2
*
* -- Calcul de la position et la vitesse du centre de la section
*    dans le repère local
*
            XAD=(X-PRECHA*COS(ASYM))/XJEU
            YAD=(Y-PRECHA*SIN(ASYM))/XJEU
            VXAD=VX/XJEU
            VYAD=VY/XJEU
            IERREU=0
            ARCPAR = AMPLIT.LT.(2.D0*XPI)
            E=XAD*XAD+YAD*YAD
            IF(E.GT.1.D0)GOTO 999
*         rem : il faudrait mieux limiter XAD YAD (cf. palier court)
*
* -- Calcul des efforts hydrodynamiques engendres par le film fluide
* -- pour le lobe I
*
            CALL RHODLI(XAD,YAD,VXAD,VYAD,FX,FY,AMPLIT,ANGDEB,I,XLONG,
     &           VISCDY,RAYLOB,XJEU,VITROT,PRECIS,NMAIL,PALM,XMASVO,
     &           ARCPAR,SURREL,PROG)
*
* -- Totalisation des efforts pour le palier dans sa globalite
*
            FNLX=FNLX+FX
            FNLY=FNLY+FY
*
 1      CONTINUE
 
************************************************************************
*     CAS PALIER COURT
************************************************************************
c       ELSEIF (IMOD.EQ.2.OR.IMOD.EQ.3) THEN
      ELSEIF (IMOD.EQ.2) THEN
 
*       deplacement X,Y du rotor dans le repere OXY du palier
*       X = -z_global
*       Y = +y_global
        X = -XPTB(NUMP,1,3)
        Y =  XPTB(NUMP,1,2)
*       deplacement X,Y du rotor relatif au stator mobile (dans OXY)
*       X = X^rot - X^sta
        IF(NUMO.GT.0) THEN
          XSTA = -XPTB(NUMO,1,3)
          YSTA = XPTB(NUMO,1,2)
          X = X+XPTB(NUMO,1,3)
          Y = Y-XPTB(NUMO,1,2)
        ENDIF
        XJEU   = XPALB(NUML,10)
c         WRITE(ioimp,*) ' x,y^rot=',X,Y,' Jeu=',XJEU
c         WRITE(ioimp,*)' x,y^sta=',XSTA,YSTA
 
*       vitesse dans le repere OXY : on recupere la position passee
cbp,2020-09        XPAST = -XPTB(NUMP,IND2,3)
cbp,2020-09        YPAST =  XPTB(NUMP,IND2,2)
        VX = -XPTB(NUMP,2,3)
        VY =  XPTB(NUMP,2,2)
        IF(NUMO.GT.0) THEN
cbp,2020-09          XPAST = XPAST+XPTB(NUMO,IND2,3)
cbp,2020-09          YPAST = YPAST-XPTB(NUMO,IND2,2)
          VX = VX+XPTB(NUMO,2,3)
          VY = VY-XPTB(NUMO,2,2) 
        ENDIF
cbp,2020-09        VX = (X-XPAST)/PDTS2
cbp,2020-09        VY = (Y-YPAST)/PDTS2
 
c *       prise en compte d'un eventuel defaut d'alignement du coussinet :
c *       X = [P]U^global + decalage(defaut)
c         IF(ABS(EPS1).GT.EMIN*XJEU) THEN
c           X = X + EPS1*COS(PHI1)
c           Y = Y + EPS1*SIN(PHI1)
c         ENDIF
 
*       coordonnees adimensionnees
        XAD = X/XJEU
        YAD = Y/XJEU
        VXAD=VX/XJEU
        VYAD=VY/XJEU
 
*       Récupération du reste des paramètres du palier
        XJEU   = XPALB(NUML,10)
        ICAVIT = IPALB(NUML,6)
        MLREEL = IPALB(NUML,7)
        NMAIL  = PROG(/1)/2
 
*       Appel a la subroutine PALIER
        CALL PALIER(X,Y,VX,VY,XAD,YAD,VXAD,VYAD,FX,FY,PDT,ICAVIT,
     &     XLONG,VISCDY,RARBRE,XJEU,VITROT,NMAIL,PALM,PROG)
 
c         IF(NUMO.GT.0) THEN
c           FNLX = 0.5D0*FX
c           FNLY = 0.5D0*FY
c         ELSE
          FNLX = FX
          FNLY = FY
c         ENDIF
 
 
********************************************************************************
*                                                                              *
*     Pour d'autres types de paliers fluides non definis a ce jour ...
*                                                                              *
********************************************************************************
C      ELSE IF (IMOD.EQ...) THEN
C
      ELSE
        WRITE(IOIMP,*) 'MODELE NON RECONNU ',IMOD
        CALL ERREUR(21)
        RETURN
 
      ENDIF
*
* ----- Stockage des variables locales a sortir
*
      XVALB(NUML,IND,1) = FNLY
      XVALB(NUML,IND,2) = -FNLX
      XVALB(NUML,IND,3) = Y
      XVALB(NUML,IND,4) = -X
      XVALB(NUML,IND,5) = VY
      XVALB(NUML,IND,6) = -VX
      XVALB(NUML,IND,7) = ((FNLY*VY)+(FNLX*VX))*PDT
      IF (XPALB(NUML,5).NE.0) THEN
         XPALB(NUML,5) = XPALB(NUML,5) + 0.5D0
         IF (IND.EQ.2) WRITE (IOIMP,*) NINT(XPALB(NUML,5)-1)
      ENDIF
*
* ----- Totalisation des forces sur la base B
*
      FTOTB(NUMP,2) = FTOTB(NUMP,2)+FNLY
      FTOTB(NUMP,3) = FTOTB(NUMP,3)-FNLX
      IF(NUMO.GT.0) THEN
         FTOTB(NUMO,2) = FTOTB(NUMO,2)-FNLY
         FTOTB(NUMO,3) = FTOTB(NUMO,3)+FNLX
      ENDIF
      IF(iimpi.eq.333)
     &  WRITE(ioimp,*)'X,Y,VX,VY=',X,Y,VX,VY,' --> FX,FY=',FNLX,FNLY
 
      GOTO 9999
 
C --> Cas ou l'arbre touche le coussinet
 999  IERREU=1
      WRITE (IOIMP,*)'EXCENTRICITE > 1 =',E,X,Y,XJEU,PRECHA,ASYM
      write(ioimp,*) 'on met les forces de paliers a 0 !'
      XVALB(NUML,IND,1) = 0.D0
      XVALB(NUML,IND,2) = 0.D0
*
* ----- Fin !!!
*
 9999 CONTINUE
      RETURN
      END
*
**********************************************************************