Télécharger dyn208.eso

Retour à la liste

Numérotation des lignes :

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

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