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