Télécharger la plaquette Cast3M


fr en

Télécharger dyn208.eso

Retour à la liste

Numérotation des lignes : 

dyn208

  1. C DYN208    SOURCE    BP208322  19/02/25    21:15:58     10120          
  2.       SUBROUTINE DYN208(I,ITLB,ITYP,KTLIAB,NPLB)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Operateur DYNE : algorithme de Fu - de Vogelaere               *
  8. *     ________________________________________________               *
  9. *                                                                    *
  10. *     Remplissage des tableaux de description des liaisons sur       *
  11. *     la base des informations contenues dans la table ILIB          *
  12. *     Liaison de type PALIER).                                       *
  13. *                                                                    *
  14. *     Paramètres:                                                    *
  15. *                                                                    *
  16. * e   I       Numéro de la liaison.                               *
  17. * e   ITLB    Table rassemblant la description d'une liaison.        *
  18. * e   ITYP    Type de la liaison.                                    *
  19. *  s  KTLIAB  Segment descriptif des liaisons sur base B.            *
  20. * e   NPLB    Nombre total de points.                                *
  21. *                                                                    *
  22. *                                                                    *
  23. *     Auteur, date de création:  Valérie BOISSON, le 14 mai 1997     *
  24. *     Modif : BP, 2015 : ajout palier court/long et point_origine    *
  25. *                        certains parametres deviennent optionnels   *
  26. *                                                                    *
  27. *--------------------------------------------------------------------*
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. *
  32.       SEGMENT MTLIAB
  33.          INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  34.          REAL*8 XPALB(NLIAB,NXPALB)
  35.          REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  36.       ENDSEGMENT
  37.       PARAMETER (X2Pi= 6.283185307179586476925286766559D0)
  38. *
  39.       LOGICAL L1,L0
  40.       CHARACTER*40 MODPAL
  41.       CHARACTER*10 MOCAVI
  42.       CHARACTER*8  TYPRET,CHARRE      
  43.  
  44.       CALL ACCTAB(ITLB,'MOT',I0,X0,'MODELE_PALIER',L0,IP0,
  45.      &                    'MOT',I1,X1,MODPAL,L1,IP1)
  46.  
  47.       IF (IERR.NE.0) RETURN
  48.       MTLIAB = KTLIAB
  49. *
  50.       CALL ACCTAB(ITLB,'MOT',I0,X0,'POINT_SUPPORT',L0,IP0,
  51.      &                    'POINT',I1,X1,CHARRE,L1,IP1)
  52.       IF (IERR.NE.0) RETURN
  53.       CALL PLACE2(JPLIB,NPLB,IPLAC,IP1)
  54.       IPLIB(I,1) = IPLAC
  55.         if (iimpi.eq.333) write(ioimp,*) 'liaison ',I,
  56.      &        ' p_support #',IP1,'->IPLAC=',IPLAC
  57. *
  58. *
  59.       TYPRET='        '
  60.       CALL ACCTAB(ITLB,'MOT',I0,X0,'POINT_ORIGINE',L0,IP0,
  61.      &                 TYPRET,I1,X1,CHARRE,L1,IP2)
  62.       IF (IERR.NE.0) RETURN
  63.       IF(TYPRET.EQ.'POINT') THEN
  64.         CALL PLACE2(JPLIB,NPLB,IPLAC,IP2)
  65.         IPLIB(I,2) = IPLAC
  66.         if (iimpi.eq.333) write(ioimp,*) 'liaison ',I,
  67.      &        ' p_origine #',IP2,'->IPLAC=',IPLAC
  68.       ELSE
  69.         IPLIB(I,2) = 0
  70.       ENDIF
  71. *
  72. * Valeurs de IPALB et XPALB communes à tous les types de paliers fluides :
  73. *
  74.       IPALB(I,1) = ITYP
  75.       IPALB(I,2) = 0
  76.       IPALB(I,3) = 3
  77.       IPALB(I,4) = 0
  78. *
  79.       CALL ACCTAB(ITLB,'MOT',I0,X0,'VISCOSITE_FLUIDE',L0,IP0,
  80.      &                    'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  81.       IF (IERR.NE.0) RETURN
  82.       XPALB(I,1) = X1
  83.  
  84.       CALL ACCTAB(ITLB,'MOT',I0,X0,'RHO_FLUIDE',L0,IP0,
  85.      &                    'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  86.       IF (IERR.NE.0) RETURN
  87.       XPALB(I,2) = X1
  88.  
  89.       CALL ACCTAB(ITLB,'MOT',I0,X0,'PRESSION_ADMISSION',L0,IP0,
  90.      &                    'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  91.       IF (IERR.NE.0) RETURN
  92.       XPALB(I,3) = X1
  93.  
  94.       CALL ACCTAB(ITLB,'MOT',I0,X0,'LONGUEUR_PALIER',L0,IP0,
  95.      &                    'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  96.       IF (IERR.NE.0) RETURN
  97.       XPALB(I,4) = X1
  98.  
  99.       TYPRET='        '
  100.       CALL ACCTAB(ITLB,'MOT',I0,X0,'AFFICHAGE',L0,IP0,
  101.      &                 TYPRET,I1,X1,CHARRE,L1,IP1)
  102.       IF (IERR.NE.0) RETURN
  103.       IF(TYPRET.EQ.'FLOTTANT') XPALB(I,5) = X1
  104.  
  105.       CALL ACCTAB(ITLB,'MOT',I0,X0,'RAYON_ARBRE',L0,IP0,
  106.      &                    'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  107.       IF (IERR.NE.0) RETURN
  108.       XPALB(I,6) = X1
  109.  
  110.  
  111.       CALL ACCTAB(ITLB,'MOT',I0,X0,'VITESSE_ROTATION',L0,IP0,
  112.      &                    'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  113.       IF (IERR.NE.0) RETURN
  114.       XPALB(I,7) = X1
  115.  
  116.       TYPRET='        '
  117.       CALL ACCTAB(ITLB,'MOT' ,I0,X0,'EPSI',L0,IP0,
  118.      &                 TYPRET,I1,X1,CHARRE,L1,IP1)
  119.       IF (IERR.NE.0) RETURN
  120.       IF(TYPRET.EQ.'FLOTTANT') THEN
  121.         XPALB(I,8) = X1
  122.       ELSE
  123.         XPALB(I,8) = 0.D0
  124.       ENDIF
  125.  
  126.       TYPRET='        '
  127.       CALL ACCTAB(ITLB,'MOT',I0,X0,'PHII',L0,IP0,
  128.      &                 TYPRET,I1,X1,CHARRE,L1,IP1)
  129.       IF (IERR.NE.0) RETURN
  130.       IF(TYPRET.EQ.'FLOTTANT') XPALB(I,9) = X1
  131.  
  132. *
  133. *---- Cas du palier cylindrique ou à lobes, avec modèle de Rhode et Li
  134.       IF (MODPAL.EQ.'RODELI') THEN
  135. *
  136.        IPALB(I,5) = 1
  137.        CALL ACCTAB(ITLB,'MOT',I0,X0,'GEOMETRIE_PALIER',L0,IP0,
  138.      &                    'TABLE',I1,X1,CHARRE,L1,ITGEOM)
  139.        IF (IERR.NE.0) RETURN
  140.  
  141.        CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0,
  142.      &                    'ENTIER',NLOB,X1,CHARRE,L1,IP1)
  143.        IF (IERR.NE.0) RETURN
  144.        IPALB(I,6) = NLOB
  145.  
  146. C Nombre de parametres reels :
  147.        NBPR = 6
  148.        IPALB(I,7) = NBPR
  149.  
  150.        TYPRET='        '
  151.        CALL ACCTAB(ITGEOM,'MOT',I0,X0,'CRITERE_ARRET',L0,IP0,
  152.      &                    TYPRET,I1,X1,CHARRE,L1,IP1)
  153.        IF (IERR.NE.0) RETURN
  154.        IF(TYPRET.EQ.'FLOTTANT') THEN
  155.          XPALB(I,10) = X1
  156.        ELSE
  157.          XPALB(I,10) = 1.D-5
  158.        ENDIF
  159.  
  160. c      boucle sur les eventuels lobes
  161.        DO 10 ILOB = 1, NLOB
  162. *
  163.           CALL ACCTAB(ITGEOM,'ENTIER',ILOB,X0,' ',L0,IP0,
  164.      &                    'TABLE',I1,X1,CHARRE,L1,ITLOB)
  165.           IF (IERR.NE.0) RETURN
  166.  
  167. c         remplissage des parametres reels dans XPALB
  168.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0,
  169.      &              'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  170.           IF (IERR.NE.0) RETURN
  171.           XPALB(I,11+NBPR*(ILOB-1)) = X1
  172.  
  173.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'ASYMETRIE',L0,IP0,
  174.      &              'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  175.           IF (IERR.NE.0) RETURN
  176.           XPALB(I,12+NBPR*(ILOB-1)) = X1
  177.  
  178.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'PRECHARGE',L0,IP0,
  179.      &              'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  180.           IF (IERR.NE.0) RETURN
  181.           XPALB(I,13+NBPR*(ILOB-1)) = X1
  182.  
  183.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'ANGLE_DEBUT',L0,IP0,
  184.      &              'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  185.           IF (IERR.NE.0) RETURN
  186.           XPALB(I,14+NBPR*(ILOB-1)) = X1
  187.           ANGDEB = X1
  188.  
  189.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'AMPL_ANGLE',L0,IP0,
  190.      &              'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  191.           IF (IERR.NE.0) RETURN
  192.           XPALB(I,15+NBPR*(ILOB-1)) = X1
  193.           AMPLIT=X1
  194.  
  195.           TYPRET='        '
  196.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'COEF_SUR',L0,IP0,
  197.      &                       TYPRET,I1,X1,CHARRE,L1,IP1)
  198.           IF (IERR.NE.0) RETURN
  199.           IF(TYPRET.EQ.'FLOTTANT') THEN
  200.             XPALB(I,16+NBPR*(ILOB-1)) = X1
  201.           ELSE
  202.             XPALB(I,16+NBPR*(ILOB-1)) = 1.715D0
  203.           ENDIF
  204.  
  205. c         creation de la liste {... cos(teta_i) sin(teta_i) ...}
  206. c         pour eviter son recalcul a chaque pas de temps
  207. c         et stockage du listreel dans IPALB (au lieu de NB_MAILLES)
  208.           TYPRET='        '
  209.           CALL ACCTAB(ITLOB,'MOT',I0,X0,'NB_MAILLES',L0,IP0,
  210.      &                      TYPRET,I1,X1,CHARRE,L1,IP1)
  211.           IF (IERR.NE.0) RETURN
  212.           IF(TYPRET.EQ.'ENTIER') THEN
  213.             NMAIL=I1
  214.           ELSE
  215.             NMAIL=100
  216.           ENDIF
  217.           CALL COS208(ANGDEB,AMPLIT,NMAIL,KLREEL)
  218.           IPALB(I,7+ILOB)=KLREEL
  219.  
  220. c         on ecrit ce listreel dans la table afin qu'il ne soit pas
  221. c         supprime si menage pendant l'execution 
  222. c         (concerne surtout pasapas et donc cyne20)
  223.           CALL ECCTAB(ITLOB,'MOT',I0,X0,'COSSIN',L0,IP0,
  224.      &                      'LISTREEL',I1,X1,CHARRE,L1,KLREEL)
  225.  
  226. 10     CONTINUE
  227. *
  228. *---- Cas du palier court ou long
  229.       ELSEIF (MODPAL.EQ.'PALIER_COURT'.OR.MODPAL.EQ.'PALIER_LONG') THEN
  230.  
  231.           IF (MODPAL.EQ.'PALIER_COURT') THEN
  232.             IPALB(I,5) = 2
  233.           ELSEIF(MODPAL.EQ.'PALIER_LONG') THEN
  234.             IPALB(I,5) = 3
  235.           ENDIF
  236.  
  237.           CALL ACCTAB(ITLB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0,
  238.      &              'FLOTTANT',I1,X1,CHARRE,L1,IP1)
  239.           IF (IERR.NE.0) RETURN
  240.           XPALB(I,10) = X1
  241.  
  242.           TYPRET='        '
  243.           MOCAVI='        '
  244.           CALL ACCTAB(ITLB,'MOT',I0,X0,'CAVITATION',L0,IP0,
  245.      &              TYPRET,I1,X1,MOCAVI,L1,IP1)
  246.           IF (IERR.NE.0) RETURN
  247.           IF(MOCAVI.EQ.'SOMMERFELD') THEN
  248.             IPALB(I,6) = 1
  249.           ELSEIF(MOCAVI.EQ.'GUMBEL') THEN
  250.             IPALB(I,6) = 2
  251.           ELSE
  252. *           par defaut on prend Gumbel
  253.             IPALB(I,6) = 2
  254.           ENDIF
  255.  
  256. c         creation de la liste {... cos(teta_i) sin(teta_i) ...}
  257. c         pour eviter son recalcul a chaque pas de temps
  258. c         et stockage du listreel dans IPALB (au lieu de NB_MAILLES)
  259.           TYPRET='        '
  260.           CALL ACCTAB(ITLB,'MOT',I0,X0,'NB_MAILLES',L0,IP0,
  261.      &                      TYPRET,I1,X1,CHARRE,L1,IP1)
  262.           IF (IERR.NE.0) RETURN
  263.           IF(TYPRET.EQ.'ENTIER') THEN
  264.             if(I1.lt.36) then
  265.              write(ioimp,*) 'NB_MAILLES doit etre >36, on prend 36'
  266.              I1=36
  267.             elseif(I1.gt.1800) then
  268.              write(ioimp,*) 'NB_MAILLES doit etre <1800, on prend 1800'
  269.              I1=1800
  270.             endif
  271.             NMAIL=I1
  272.           ELSE
  273.             IF(IIMPI.EQ.333)
  274.      &      write(ioimp,*) 'NB_MAILLES non précisé, on prend 120'
  275.             NMAIL=120
  276.           ENDIF
  277.           CALL COS208(0.D0,X2Pi,NMAIL,KLREEL)
  278.           IPALB(I,7)=KLREEL
  279.  
  280.  
  281. *---- Autres cas, non définis à ce jour
  282. *
  283. C      ELSE IF (MODPAL.EQ.'...') THEN
  284. *
  285.       ENDIF
  286. *
  287.       END
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales