Télécharger dyn208.eso

Retour à la liste

Numérotation des lignes :

  1. C DYN208 SOURCE BP208322 15/07/22 21:15:31 8586
  2. SUBROUTINE DYN208(NUML,ITLB,ITYP,KTLIAB,NPLB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
  8. * ________________________________________________ *
  9. * *
  10. * Remplissage des tableaux de description des liaisons sur *
  11. * la base B partir des informations contenues dans la *
  12. * TABLE ILIB (LIAISON DE TYPE PALIER). *
  13. * *
  14. * Paramètres: *
  15. * *
  16. * e NUML 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. -INC CCOPTIO
  29. -INC SMCOORD
  30. -INC SMEVOLL
  31. -INC SMLREEL
  32. *
  33. SEGMENT MTLIAB
  34. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  35. REAL*8 XPALB(NLIAB,NXPALB)
  36. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  37. ENDSEGMENT
  38. *
  39. LOGICAL L1,L0
  40. CHARACTER*40 MONMOT
  41. CHARACTER*10 MOCAVI
  42. CHARACTER*8 TYPRET
  43. TYPRET=' '
  44. *
  45. CALL ACCTAB(ITLB,'MOT',I0,X0,'MODELE_PALIER',L0,IP0,
  46. & 'MOT',I1,X1,MONMOT,L1,IP1)
  47.  
  48. IF (IERR.NE.0) RETURN
  49. MTLIAB = KTLIAB
  50. *
  51. CALL ACCTAB(ITLB,'MOT',I0,X0,'POINT_SUPPORT',L0,IP0,
  52. & 'POINT',I1,X1,' ',L1,IP1)
  53. IF (IERR.NE.0) RETURN
  54. CALL PLACE2(JPLIB,NPLB,IPLAC,IP1)
  55. IPLIB(NUML,1) = IPLAC
  56. if (iimpi.eq.333) write(ioimp,*) 'liaison ',NUML,
  57. & ' p_support #',IP1,'->IPLAC=',IPLAC
  58. *
  59. *
  60. TYPRET=' '
  61. CALL ACCTAB(ITLB,'MOT',I0,X0,'POINT_ORIGINE',L0,IP0,
  62. & TYPRET,I1,X1,' ',L1,IP2)
  63. IF (IERR.NE.0) RETURN
  64. IF(TYPRET.EQ.'POINT') THEN
  65. CALL PLACE2(JPLIB,NPLB,IPLAC,IP2)
  66. IPLIB(NUML,2) = IPLAC
  67. if (iimpi.eq.333) write(ioimp,*) 'liaison ',NUML,
  68. & ' p_origine #',IP2,'->IPLAC=',IPLAC
  69. ELSE
  70. IPLIB(NUML,2) = 0
  71. ENDIF
  72. *
  73. * Valeurs de IPALB et XPALB communes à tous les types de paliers fluides :
  74. *
  75. IPALB(NUML,1) = ITYP
  76. IPALB(NUML,2) = 0
  77. IPALB(NUML,3) = 3
  78. IPALB(NUML,4) = 0
  79. *
  80. CALL ACCTAB(ITLB,'MOT',I0,X0,'VISCOSITE_FLUIDE',L0,IP0,
  81. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  82. IF (IERR.NE.0) RETURN
  83. XPALB(NUML,1) = X1
  84.  
  85. CALL ACCTAB(ITLB,'MOT',I0,X0,'RHO_FLUIDE',L0,IP0,
  86. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  87. IF (IERR.NE.0) RETURN
  88. XPALB(NUML,2) = X1
  89.  
  90. CALL ACCTAB(ITLB,'MOT',I0,X0,'PRESSION_ADMISSION',L0,IP0,
  91. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  92. IF (IERR.NE.0) RETURN
  93. XPALB(NUML,3) = X1
  94.  
  95. CALL ACCTAB(ITLB,'MOT',I0,X0,'LONGUEUR_PALIER',L0,IP0,
  96. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  97. IF (IERR.NE.0) RETURN
  98. XPALB(NUML,4) = X1
  99.  
  100. TYPRET=' '
  101. CALL ACCTAB(ITLB,'MOT',I0,X0,'AFFICHAGE',L0,IP0,
  102. & TYPRET,I1,X1,MONMOT,L1,IP1)
  103. IF (IERR.NE.0) RETURN
  104. IF(TYPRET.EQ.'FLOTTANT') XPALB(NUML,5) = X1
  105.  
  106. CALL ACCTAB(ITLB,'MOT',I0,X0,'RAYON_ARBRE',L0,IP0,
  107. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  108. IF (IERR.NE.0) RETURN
  109. XPALB(NUML,6) = X1
  110.  
  111.  
  112. CALL ACCTAB(ITLB,'MOT',I0,X0,'VITESSE_ROTATION',L0,IP0,
  113. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  114. IF (IERR.NE.0) RETURN
  115. XPALB(NUML,7) = X1
  116.  
  117. TYPRET=' '
  118. CALL ACCTAB(ITLB,'MOT' ,I0,X0,'EPSI',L0,IP0,
  119. & TYPRET,I1,X1,MONMOT,L1,IP1)
  120. IF (IERR.NE.0) RETURN
  121. IF(TYPRET.EQ.'FLOTTANT') THEN
  122. XPALB(NUML,8) = X1
  123. ELSE
  124. XPALB(NUML,8) = 0.D0
  125. ENDIF
  126.  
  127. TYPRET=' '
  128. CALL ACCTAB(ITLB,'MOT',I0,X0,'PHII',L0,IP0,
  129. & TYPRET,I1,X1,MONMOT,L1,IP1)
  130. IF (IERR.NE.0) RETURN
  131. IF(TYPRET.EQ.'FLOTTANT') XPALB(NUML,9) = X1
  132.  
  133. *
  134. *---- Cas du palier cylindrique ou à lobes, avec modèle de Rhode et Li
  135. IF (MONMOT.EQ.'RODELI') THEN
  136. *
  137. IPALB(NUML,5) = 1
  138. CALL ACCTAB(ITLB,'MOT',I0,X0,'GEOMETRIE_PALIER',L0,IP0,
  139. & 'TABLE',I1,X1,' ',L1,ITGEOM)
  140. IF (IERR.NE.0) RETURN
  141.  
  142. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0,
  143. & 'ENTIER',NLOB,X1,' ',L1,IP1)
  144. IF (IERR.NE.0) RETURN
  145. IPALB(NUML,6) = NLOB
  146.  
  147. C Nombre de parametres reels :
  148. NBPR = 6
  149. IPALB(NUML,7) = NBPR
  150.  
  151. TYPRET=' '
  152. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'CRITERE_ARRET',L0,IP0,
  153. & TYPRET,I1,X1,MONMOT,L1,IP1)
  154. IF (IERR.NE.0) RETURN
  155. IF(TYPRET.EQ.'FLOTTANT') THEN
  156. XPALB(NUML,10) = X1
  157. ELSE
  158. XPALB(NUML,10) = 1.D-5
  159. ENDIF
  160.  
  161. DO 10 ILOB = 1, NLOB
  162. *
  163. CALL ACCTAB(ITGEOM,'ENTIER',ILOB,X0,MONMOT,L0,IP0,
  164. & 'TABLE',I1,X1,' ',L1,ITLOB)
  165. IF (IERR.NE.0) RETURN
  166.  
  167. TYPRET=' '
  168. CALL ACCTAB(ITLOB,'MOT',I0,X0,'NB_MAILLES',L0,IP0,
  169. & TYPRET,I1,X1,' ',L1,IP1)
  170. IF (IERR.NE.0) RETURN
  171. IF(TYPRET.EQ.'ENTIER') THEN
  172. IPALB(NUML,7+ILOB) = I1
  173. ELSE
  174. IPALB(NUML,7+ILOB) = 100
  175. ENDIF
  176.  
  177. CALL ACCTAB(ITLOB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0,
  178. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  179. IF (IERR.NE.0) RETURN
  180. XPALB(NUML,11+NBPR*(ILOB-1)) = X1
  181.  
  182. CALL ACCTAB(ITLOB,'MOT',I0,X0,'ASYMETRIE',L0,IP0,
  183. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  184. IF (IERR.NE.0) RETURN
  185. XPALB(NUML,12+NBPR*(ILOB-1)) = X1
  186.  
  187. CALL ACCTAB(ITLOB,'MOT',I0,X0,'PRECHARGE',L0,IP0,
  188. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  189. IF (IERR.NE.0) RETURN
  190. XPALB(NUML,13+NBPR*(ILOB-1)) = X1
  191.  
  192. CALL ACCTAB(ITLOB,'MOT',I0,X0,'ANGLE_DEBUT',L0,IP0,
  193. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  194. IF (IERR.NE.0) RETURN
  195. XPALB(NUML,14+NBPR*(ILOB-1)) = X1
  196.  
  197. CALL ACCTAB(ITLOB,'MOT',I0,X0,'AMPL_ANGLE',L0,IP0,
  198. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  199. IF (IERR.NE.0) RETURN
  200. XPALB(NUML,15+NBPR*(ILOB-1)) = X1
  201.  
  202. TYPRET=' '
  203. CALL ACCTAB(ITLOB,'MOT',I0,X0,'COEF_SUR',L0,IP0,
  204. & TYPRET,I1,X1,MONMOT,L1,IP1)
  205. IF (IERR.NE.0) RETURN
  206. IF(TYPRET.EQ.'FLOTTANT') THEN
  207. XPALB(NUML,16+NBPR*(ILOB-1)) = X1
  208. ELSE
  209. XPALB(NUML,16+NBPR*(ILOB-1)) = 1.715D0
  210. ENDIF
  211.  
  212. 10 CONTINUE
  213. *
  214. *---- Cas du palier court ou long
  215. ELSEIF (MONMOT.EQ.'PALIER_COURT'.OR.MONMOT.EQ.'PALIER_LONG') THEN
  216.  
  217. IF (MONMOT.EQ.'PALIER_COURT') THEN
  218. IPALB(NUML,5) = 2
  219. ELSEIF(MONMOT.EQ.'PALIER_LONG') THEN
  220. IPALB(NUML,5) = 3
  221. ENDIF
  222.  
  223. CALL ACCTAB(ITLB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0,
  224. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  225. IF (IERR.NE.0) RETURN
  226. XPALB(NUML,10) = X1
  227.  
  228. TYPRET=' '
  229. MOCAVI=' '
  230. CALL ACCTAB(ITLB,'MOT',I0,X0,'CAVITATION',L0,IP0,
  231. & TYPRET,I1,X1,MOCAVI,L1,IP1)
  232. IF (IERR.NE.0) RETURN
  233. IF(MOCAVI.EQ.'SOMMERFELD') THEN
  234. IPALB(NUML,6) = 1
  235. ELSEIF(MOCAVI.EQ.'GUMBEL') THEN
  236. IPALB(NUML,6) = 2
  237. ELSE
  238. * par defaut on prend Gumbel
  239. IPALB(NUML,6) = 2
  240. ENDIF
  241.  
  242. TYPRET=' '
  243. CALL ACCTAB(ITLB,'MOT',I0,X0,'NB_MAILLES',L0,IP0,
  244. & TYPRET,I1,X1,' ',L1,IP1)
  245. IF (IERR.NE.0) RETURN
  246. IF(TYPRET.EQ.'ENTIER') THEN
  247. if(I1.lt.36) then
  248. write(ioimp,*) 'NB_MAILLES doit etre >36, on prend 36'
  249. I1=36
  250. elseif(I1.gt.1800) then
  251. write(ioimp,*) 'NB_MAILLES doit etre <1800, on prend 1800'
  252. I1=1800
  253. endif
  254. IPALB(NUML,7) = I1
  255. ELSE
  256. IF(IIMPI.EQ.333)
  257. & write(ioimp,*) 'NB_MAILLES non précisé, on prend 120'
  258. IPALB(NUML,7) = 120
  259. ENDIF
  260.  
  261.  
  262. *---- Autres cas, non définis à ce jour
  263. *
  264. C ELSE IF (MONMOT.EQ.'...') THEN
  265. *
  266. ENDIF
  267. *
  268. END
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  

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