Télécharger dyne19.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE19 SOURCE BP208322 15/07/22 21:15:32 8586
  2. SUBROUTINE DYNE19(ILIA,KCPR,PDT,KTLIAA)
  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 a partir des informations contenues dans la *
  12. * table ILIA. *
  13. * *
  14. * Parametres: *
  15. * *
  16. * e ILIA Table rassemblant la description des liaisons *
  17. * e KCPR Segment descriptif des points. *
  18. * e PDT Pas de temps. *
  19. * es KTLIAA Segment descriptif des liaisons sur la base A. *
  20. * *
  21. * Parametres de dimensionnement pour une liaison sur base: *
  22. * *
  23. * NIPALA : nombre de parametres pour definir le type des *
  24. * liaisons (NIPALA est fixe a 3). *
  25. * NXPALA : nombre maxi de parametres internes pour definir *
  26. * les liaisons. *
  27. * NPLAA : nombre maxi de points intervenant dans une liaison. *
  28. * *
  29. * NPLA : nombre total de points. *
  30. * NLIAA : nombre total de liaisons. *
  31. * *
  32. * *
  33. * Tableaux fortran pour les liaisons sur base: *
  34. * *
  35. * XPALA(NLIAA,NXPALA) : param}tres de la liaison. *
  36. * IPALA(NLIAA,NIPALA) : renseigne sur le type de liaison. *
  37. * JPLIA(NPLA) : num{ro global des points. *
  38. * IPLIA(NLIAA,NPLAA) : num{ros locaux des points concern{s par *
  39. * la liaison. *
  40. * *
  41. * Auteur, date de cr{ation: *
  42. * *
  43. * Lionel VIVAN, le 21 aout 1989. *
  44. * *
  45. *--------------------------------------------------------------------*
  46. *
  47. -INC CCOPTIO
  48. -INC CCNOYAU
  49. -INC SMCOORD
  50. -INC SMTABLE
  51. -INC CCASSIS
  52. *
  53. SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
  54. *
  55. SEGMENT MTLIAA
  56. INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
  57. REAL*8 XPALA(NLIAA,NXPALA)
  58. ENDSEGMENT
  59. SEGMENT icorres (nliaa)
  60. *
  61. LOGICAL L0,L1
  62. CHARACTER*8 MONAMO,MONOBJ,TYPIND,TYPOBJ,CHARRE
  63. CHARACTER*40 CMOT,MONMOT
  64. CHARACTER*(20) CHAI1
  65. CHARACTER*(18) CHAI2
  66. CHARACTER*(15) CHAI3
  67. CHARACTER*(16) CHAI4
  68. CHARACTER*(14) CHAI5
  69. CHARACTER*(11) CHAI6
  70. PARAMETER (XZERO = 0.D0)
  71. DATA CHAI1 /'EXPOSANT_DEPLACEMENT'/
  72. DATA CHAI2 /'RETARD_DEPLACEMENT'/
  73. DATA CHAI3 /'JEU_DEPLACEMENT'/
  74. DATA CHAI4 /'EXPOSANT_VITESSE'/
  75. DATA CHAI5 /'RETARD_VITESSE'/
  76. DATA CHAI6 /'JEU_VITESSE'/
  77. *
  78. ICPR = KCPR
  79. MTLIAA = KTLIAA
  80. NLIAA = IPALA(/1)
  81. NXPALA = XPALA(/2)
  82. NIPALA = IPALA(/2)
  83. NPLAA = IPLIA(/2)
  84. NPLA = JPLIA(/1)
  85. XPDTS2 = 0.5 * PDT
  86.  
  87. segini icorres
  88. *
  89. * Boucle sur le nombre de liaisons
  90. *
  91. II = 0
  92. DO 10 I = 1,NLIAA
  93. CALL ACCTAB(ILIA,'ENTIER',I,X0,' ',L0,IP0,
  94. & 'TABLE',I0,X0,' ',L1,ITLIAI)
  95. IF (IERR.NE.0) RETURN
  96. icorres ( i ) = itliai
  97.  
  98. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  99. & 'MOT',I1,X0,MONMOT,L1,IP1)
  100. IF (IERR.NE.0) RETURN
  101. *
  102. * Liaison {l{mentaire
  103. *
  104. IF (MONMOT(1:19).EQ.'LIAISON_ELEMENTAIRE') THEN
  105. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0,
  106. & 'MOT',I1,X0,CMOT,L1,IP1)
  107. IF (IERR.NE.0) RETURN
  108. *
  109. IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN
  110. *
  111. * ------------ choc POINT_PLAN_FLUIDE
  112. *
  113. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  114. & 'POINT',I1,X1,' ',L1,IMOD)
  115. IF (IERR.NE.0) RETURN
  116. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_INERTIE',
  117. & L0,IP0,'FLOTTANT',I0,XINER,' ',L1,IP1)
  118. IF (IERR.NE.0) RETURN
  119. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_CONVECTION',
  120. & L0,IP0,'FLOTTANT',I0,XCONV,' ',L1,IP1)
  121. IF (IERR.NE.0) RETURN
  122. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_VISCOSITE',
  123. & L0,IP0,'FLOTTANT',I0,XVISC,' ',L1,IP1)
  124. IF (IERR.NE.0) RETURN
  125. CALL ACCTAB(ITLIAI,'MOT',I1,X0,
  126. & 'COEFFICIENT_P_D_C_ELOIGNEMENT',L0,IP0,
  127. & 'FLOTTANT',I0,XPCEL,' ',L1,IP1)
  128. IF (IERR.NE.0) RETURN
  129. CALL ACCTAB(ITLIAI,'MOT',I1,X0,
  130. & 'COEFFICIENT_P_D_C_RAPPROCHEMENT',L0,IP0,
  131. & 'FLOTTANT',I0,XPCRA,' ',L1,IP1)
  132. IF (IERR.NE.0) RETURN
  133. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU_FLUIDE',L0,IP0,
  134. & 'FLOTTANT',I0,XJEU,' ',L1,IP1)
  135. IF (IERR.NE.0) RETURN
  136. *
  137. IPALA(I,1) = 3
  138. XPALA(I,1) = XINER
  139. XPALA(I,2) = XCONV
  140. XPALA(I,3) = XVISC
  141. XPALA(I,4) = XPCEL
  142. XPALA(I,5) = XPCRA
  143. XPALA(I,6) = XJEU
  144. IK = ICPR(IMOD)
  145. IPLIA(I,1) = IK
  146. JPLIA(IK) = IMOD
  147. ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN
  148. MONAMO = ' '
  149. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0,
  150. & MONAMO,I1,XAMO,CHARRE,L1,IP1)
  151. IF (IERR.NE.0) RETURN
  152. *
  153. * ------------ choc POINT_PLAN avec amortissement
  154. *
  155. IF (MONAMO.EQ.'FLOTTANT') THEN
  156. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  157. & 'POINT',I1,X1,' ',L1,IMOD)
  158. IF (IERR.NE.0) RETURN
  159. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  160. & 'FLOTTANT',I0,XRAID,' ',L1,IP1)
  161. IF (IERR.NE.0) RETURN
  162. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU',L0,IP0,
  163. & 'FLOTTANT',I0,XJEU,' ',L1,IP1)
  164. IF (IERR.NE.0) RETURN
  165. *
  166. IPALA(I,1) = 2
  167. XPALA(I,1) = XRAID
  168. XPALA(I,2) = XJEU
  169. XPALA(I,3) = XAMO
  170. IK = ICPR(IMOD)
  171. IPLIA(I,1) = IK
  172. JPLIA(IK) = IMOD
  173. *
  174. * ------------ choc POINT_PLAN sans amortissement
  175. *
  176. ELSE
  177. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  178. & 'POINT',I1,X1,' ',L1,IMOD)
  179. IF (IERR.NE.0) RETURN
  180. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  181. & 'FLOTTANT',I0,XRAID,' ',L1,IP1)
  182. IF (IERR.NE.0) RETURN
  183. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU',L0,IP0,
  184. & 'FLOTTANT',I0,XJEU,' ',L1,IP1)
  185. IF (IERR.NE.0) RETURN
  186. *
  187. IPALA(I,1) = 1
  188. XPALA(I,1) = XRAID
  189. XPALA(I,2) = XJEU
  190. IK = ICPR(IMOD)
  191. IPLIA(I,1) = IK
  192. JPLIA(IK) = IMOD
  193. ENDIF
  194. *
  195. * --------- liaison de couplage en vitesse
  196. *
  197. ELSE IF (CMOT(1:16).EQ.'COUPLAGE_VITESSE') THEN
  198. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  199. & 'POINT',I1,X1,' ',L1,ISUPP)
  200. IF (IERR.NE.0) RETURN
  201. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'ORIGINE',L0,IP0,
  202. & 'POINT',I1,X1,' ',L1,IORIG)
  203. IF (IERR.NE.0) RETURN
  204. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0,
  205. & 'FLOTTANT',I1,XCPLGE,' ',L1,IP1)
  206. IF (IERR.NE.0) RETURN
  207. *
  208. IPALA(I,1) = 4
  209. XPALA(I,1) = XCPLGE
  210. IKX = ICPR(ISUPP)
  211. IPLIA(I,1) = IKX
  212. JPLIA(IKX) = ISUPP
  213. IKY = ICPR(IORIG)
  214. IPLIA(I,2) = IKY
  215. JPLIA(IKY) = IORIG
  216. *
  217. * --------- liaison de couplage en d{placement
  218. *
  219. ELSE IF (CMOT(1:20).EQ.'COUPLAGE_DEPLACEMENT') THEN
  220. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  221. & 'POINT',I1,X1,' ',L1,ISUPP)
  222. IF (IERR.NE.0) RETURN
  223. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'ORIGINE',L0,IP0,
  224. & 'POINT',I1,X1,' ',L1,IORIG)
  225. IF (IERR.NE.0) RETURN
  226. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0,
  227. & 'FLOTTANT',I1,XCPLGE,' ',L1,IP1)
  228. IF (IERR.NE.0) RETURN
  229. *
  230. IPALA(I,1) = 5
  231. XPALA(I,1) = XCPLGE
  232. IKX = ICPR(ISUPP)
  233. IPLIA(I,1) = IKX
  234. JPLIA(IKX) = ISUPP
  235. IKY = ICPR(IORIG)
  236. IPLIA(I,2) = IKY
  237. JPLIA(IKY) = IORIG
  238. *
  239. * lectures facultatives
  240. TYPOBJ = ' '
  241. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'FONCTION',L0,IP0,
  242. & TYPOBJ,I1,X1,CHARRE,L1,IP1)
  243. IF (IERR.NE.0) RETURN
  244. IF(TYPOBJ.EQ.'MOT') THEN
  245. IF(CHARRE.EQ.'COS') THEN
  246. IPALA(I,3) = 1
  247. ELSEIF(CHARRE.EQ.'SIN') THEN
  248. IPALA(I,3) = 2
  249. ELSE
  250. WRITE(IOIMP,*) 'FONCTION non reconnue !'
  251. CALL ERREUR(21)
  252. RETURN
  253. ENDIF
  254. IF(IPALA(I,3).EQ.1.OR.IPALA(I,3).EQ.2) THEN
  255. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  256. & 'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  257. IF (IERR.NE.0) RETURN
  258. XPALA(I,2) = XFREQ
  259. ENDIF
  260. ENDIF
  261. *
  262. * --------- liaison de type force POLYNOMIALE
  263. *
  264. ELSE IF (CMOT(1:11).EQ.'POLYNOMIALE') THEN
  265. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  266. & 'POINT',I1,X1,' ',L1,ISUPP)
  267. IF (IERR.NE.0) RETURN
  268. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0,
  269. & 'FLOTTANT',I1,XCOEF,' ',L1,IP1)
  270. IF (IERR.NE.0) RETURN
  271. * on met un flag reconnaissable ( cf dypol1) pour
  272. * reconnaissance du temps de demmarrage de la liaison
  273. do 101 ip = 1 , nxpala
  274. xpala(i,ip) = 123456.7
  275. 101 continue
  276.  
  277. IPALA(I,1) = 6
  278. IKX = ICPR(ISUPP)
  279. IPLIA(I,1) = IKX
  280. JPLIA(IKX) = ISUPP
  281. XPALA(I,1) = XCOEF
  282. MTABLE = ITLIAI
  283. SEGACT MTABLE
  284. NIND1 = MLOTAB
  285. *
  286. * contributions des autres modes
  287. *
  288. K1 = 2
  289. K2 = 1
  290. if(nbesc.ne.0) segact ipiloc
  291. DO 20 J=1,NIND1
  292. * -- valeurs nulles par défaut
  293. XPALA(I,K1) = 0d0
  294. XPALA(I,K1+1) = 0d0
  295. XPALA(I,K1+2) = 0d0
  296. XPALA(I,K1+3) = 0d0
  297. XPALA(I,K1+4) = 0d0
  298. XPALA(I,K1+5) = 0d0
  299. TYPIND = MTABTI(J)
  300. IF (TYPIND.EQ.'POINT ') THEN
  301. TYPOBJ = MTABTV(J)
  302. IF (TYPOBJ.EQ.'TABLE ') THEN
  303. K2 = K2 + 1
  304. IORIG = MTABII(J)
  305. IKX = ICPR(IORIG)
  306. IPLIA(I,K2) = IKX
  307. JPLIA(IKX) = IORIG
  308. MTAB1 = MTABIV(J)
  309. SEGACT MTAB1
  310. NIND2 = MTAB1.MLOTAB
  311. RD = XZERO
  312. RV = XZERO
  313. DO 30 K=1,NIND2
  314. TYPIND = MTAB1.MTABTI(K)
  315. IF (TYPIND.EQ.'MOT ') THEN
  316. IP = MTAB1.MTABII(K)
  317. ID = IPCHAR(IP)
  318. IFI = IPCHAR(IP+1)
  319. IL1 = IFI - ID
  320. IF (IL1.EQ.20) THEN
  321. IF (CHAI1.EQ.ICHARA(ID:ID+19)) THEN
  322. TYPOBJ = MTAB1.MTABTV(K)
  323. IF (TYPOBJ.EQ.'FLOTTANT') THEN
  324. XPALA(I,K1) = MTAB1.RMTABV(K)
  325. ENDIF
  326. ENDIF
  327. ELSE IF (IL1.EQ.18) THEN
  328. IF (CHAI2.EQ.ICHARA(ID:ID+17)) THEN
  329. TYPOBJ = MTAB1.MTABTV(K)
  330. IF (TYPOBJ.EQ.'FLOTTANT') THEN
  331. RD = MTAB1.RMTABV(K)
  332. XPALA(I,K1+1) = RD
  333. ENDIF
  334. ENDIF
  335. ELSE IF (IL1.EQ.15) THEN
  336. IF (CHAI3.EQ.ICHARA(ID:ID+14)) THEN
  337. TYPOBJ = MTAB1.MTABTV(K)
  338. IF (TYPOBJ.EQ.'FLOTTANT') THEN
  339. XPALA(I,K1+2) = MTAB1.RMTABV(K)
  340. ENDIF
  341. ENDIF
  342. ELSE IF (IL1.EQ.16) THEN
  343. IF (CHAI4.EQ.ICHARA(ID:ID+15)) THEN
  344. TYPOBJ = MTAB1.MTABTV(K)
  345. IF (TYPOBJ.EQ.'FLOTTANT') THEN
  346. XPALA(I,K1+3) = MTAB1.RMTABV(K)
  347. ENDIF
  348. ENDIF
  349. ELSE IF (IL1.EQ.14) THEN
  350. IF (CHAI5.EQ.ICHARA(ID:ID+13)) THEN
  351. TYPOBJ = MTAB1.MTABTV(K)
  352. IF (TYPOBJ.EQ.'FLOTTANT') THEN
  353. RV = MTAB1.RMTABV(K)
  354. XPALA(I,K1+4) = RV
  355. ENDIF
  356. ENDIF
  357. ELSE IF (IL1.EQ.11) THEN
  358. IF (CHAI6.EQ.ICHARA(ID:ID+10)) THEN
  359. TYPOBJ = MTAB1.MTABTV(K)
  360. IF (TYPOBJ.EQ.'FLOTTANT') THEN
  361. XPALA(I,K1+5) = MTAB1.RMTABV(K)
  362. ENDIF
  363. ENDIF
  364. ENDIF
  365. ENDIF
  366. 30 CONTINUE
  367. ND = INT(RD/XPDTS2) + 1
  368. NV = INT(RV/XPDTS2) + 2
  369. NMAX = MAX(ND,NV)
  370. K1 = K1 + 6 + NMAX
  371. ENDIF
  372. ENDIF
  373. 20 CONTINUE
  374. if(nbesc.ne.0)segdes ipiloc
  375. SEGDES MTABLE
  376. *
  377. * Nombre de modes "origine"
  378. *
  379. IPALA(I,2) = K2 - 1
  380. *
  381. * --------- choc ...........
  382. *
  383. * ELSE IF (CMOT(1: ).EQ.' ') THEN
  384. * .......
  385. * .......
  386. *
  387. ELSE
  388. CALL ERREUR(490)
  389. RETURN
  390. ENDIF
  391. *
  392. * Liaison ...........
  393. *
  394. * ELSE IF (MONMOT(1: ).EQ.' ') THEN
  395. * .......
  396. * .......
  397. *
  398. ELSE
  399. CALL ERREUR(489)
  400. RETURN
  401. ENDIF
  402. 10 CONTINUE
  403. *
  404. *
  405. *
  406. * ----- liaisons conditionnelles ?
  407. *
  408. *
  409. DO 11 I = 1,NLIAA
  410. ksi = 0
  411. CALL ACCTAB(ILIA,'ENTIER',I,X0,' ',L0,IP0,
  412. & 'TABLE',I0,X0,' ',L1,ITLIAI)
  413.  
  414. DO 111 j = 1,NLIAA
  415. jtliai = icorres ( j )
  416. monmot = ' '
  417. CALL ACCTAB(ITLIAI,'TABLE',I0,x0,' ',L0,jtliai,
  418. & monmot,I1,X0,CHARRE,L1,IP1)
  419. IF (IERR.NE.0) RETURN
  420. * ------- si on trouve un logique en face d'une table
  421. * de liaison , c'est bon
  422. IF (MONMOT.EQ.'LOGIQUE ') THEN
  423. ksi = ksi + 1
  424. ipala(i,2) = 1
  425. IF (L1 ) tHEN
  426. ipala (i,3+ksi) = j
  427. ELSE IF (.NOT. L1) THEN
  428. ipala (i,3+ksi) = -1 * j
  429. ENDIF
  430. ENDIF
  431. 111 CONTINUE
  432. 11 CONTINUE
  433. *
  434. *
  435. *
  436. *
  437. * end do
  438. IF (IIMPI.EQ.333) THEN
  439. DO 1000 IN = 1,NLIAA
  440. DO 1002 II = 1,NIPALA
  441. WRITE(IOIMP,*)'DYNE19 : IPALA(',IN,',',II,') =',IPALA(IN,II)
  442. 1002 CONTINUE
  443. DO 1004 IX = 1,NXPALA
  444. WRITE(IOIMP,*)'DYNE19 : XPALA(',IN,',',IX,') =',XPALA(IN,IX)
  445. 1004 CONTINUE
  446. DO 1006 IP = 1,NPLAA
  447. WRITE(IOIMP,*)'DYNE19 : IPLIA(',IN,',',IP,') =',IPLIA(IN,IP)
  448. 1006 CONTINUE
  449. 1000 CONTINUE
  450. DO 1008 IP = 1,NPLA
  451. WRITE(IOIMP,*)'DYNE19 : JPLIA(',IP,') =',JPLIA(IP)
  452. 1008 CONTINUE
  453. ENDIF
  454. *
  455. END
  456.  
  457.  
  458.  
  459.  
  460.  

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