Télécharger dyne19.eso

Retour à la liste

Numérotation des lignes :

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

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