Télécharger d2vini.eso

Retour à la liste

Numérotation des lignes :

  1. C D2VINI SOURCE CB215821 18/09/13 21:15:30 9917
  2. C DEVINI SOURCE KK2000 97/09/08 21:17:20 2809
  3. SUBROUTINE D2VINI(ITINIT,KTKAM,KTQ,KTFEX,KTPAS,KTNUM,KTLIAA,
  4. & KTLIAB,KTPHI,KCPR,KOCLFA,KOCLB1,REPRIS,
  5. & RIGIDE,lmodyn)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8(A-H,O-Z)
  8. *--------------------------------------------------------------------*
  9. * *
  10. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  11. * ________________________________________________ *
  12. * *
  13. * Initialisation de l'algorithme ou reprise de calcul. *
  14. * *
  15. * Parametres: *
  16. * *
  17. * e ITINIT Table contenant les conditions initiales ou les *
  18. * champs necessaires a la reprise du calcul *
  19. * es KTKAM Segment contenant les vecteurs XK, XASM et XM *
  20. * es KTQ Segment des variables de mouvement generalisees *
  21. * (et des travaux)
  22. * es KTFEX Segment contenant les chargements libres *
  23. * es KTPAS Segment des variables au cours d'un pas de temps *
  24. * es KTNUM Segment contenant les parametres numeriques *
  25. * e KTLIAA Segment descriptif des liaisons en base A *
  26. * e KTLIAB Segment descriptif des liaisons en base B *
  27. * e KTPHI Segment contenant les deformees modales *
  28. * e KCPR Segment des points *
  29. * - KOCLFA Segment contenant les tableaux locaux de la subroutine *
  30. * D2VLFA *
  31. * - KOCLB1 Segment contenant les tableaux locaux de la subroutine *
  32. * D2VLB1 *
  33. * e REPRIS Vrai si reprise de calcul *
  34. * e RIGIDE Vrai si corps rigide
  35. * *
  36. * Auteur, date de creation: *
  37. * *
  38. * Denis ROBERT-MOUGIN, le 25 mai 1989. *
  39. * *
  40. *--------------------------------------------------------------------*
  41. -INC CCOPTIO
  42. -INC CCNOYAU
  43. -INC SMCOORD
  44. -INC SMTABLE
  45. -INC CCASSIS
  46. *
  47. SEGMENT,MTQ
  48. REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4)
  49. REAL*8 WEXT(NA1,2),WINT(NA1,2)
  50. ENDSEGMENT
  51. SEGMENT,MTFEX
  52. REAL*8 FEXA(NPFEXA,NPC1,2)
  53. REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB)
  54. REAL*8 FTEXB(NPLB,NPC1,2,IDIM)
  55. INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
  56. ENDSEGMENT
  57. SEGMENT,MTPAS
  58. REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1)
  59. REAL*8 XPTB(NPLB,4,IDIMB),FINERT(NA1,4)
  60. REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR)
  61. REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB)
  62. ENDSEGMENT
  63. SEGMENT,MTNUM
  64. REAL*8 XDT(NPC1),XTEMPS(NPC1)
  65. ENDSEGMENT
  66. SEGMENT,MTKAM
  67. REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M)
  68. REAL*8 XOPER(NB1,NB1,NOPER)
  69. ENDSEGMENT
  70. SEGMENT,MTLIAA
  71. INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
  72. REAL*8 XPALA(NLIAA,NXPALA)
  73. ENDSEGMENT
  74. SEGMENT,MTLIAB
  75. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  76. REAL*8 XPALB(NLIAB,NXPALB)
  77. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  78. ENDSEGMENT
  79. SEGMENT,MTPHI
  80. INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  81. INTEGER IAROTA(NSB)
  82. REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  83. ENDSEGMENT
  84. SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
  85.  
  86. * Segment "local" pour D2VLFA ...
  87. SEGMENT,LOCLFA
  88. REAL*8 FTEST(NA1,4),FTOTA0(NA1,4)
  89. ENDSEGMENT
  90. * Segment "local" pour D2VLB1 ...
  91. SEGMENT,LOCLB1
  92. REAL*8 FTEST2(NPLB,6),FTOTB0(NPLB,6)
  93. ENDSEGMENT
  94. segment mwinit
  95. integer jpdep,jpvit,jrepr
  96. endsegment
  97. c SEGMENT FAMOR(NA1,4)
  98. SEGMENT FAMOR(NA1)
  99. *
  100. LOGICAL L0,L1,REPRIS,RIGIDE,lmodyn
  101. CHARACTER*8 TYPRET,TYPIND,CHARRE
  102. CHARACTER*(19) CHAI1
  103. ILC1 = 19
  104. DATA CHAI1 /'VARIABLES_LIAISON_A'/
  105. *
  106. MTFEX = KTFEX
  107. MTPAS = KTPAS
  108. MTNUM = KTNUM
  109. MTKAM = KTKAM
  110. MTQ = KTQ
  111. MTLIAA = KTLIAA
  112. MTLIAB = KTLIAB
  113. MTPHI = KTPHI
  114. LOCLFA = KOCLFA
  115. LOCLB1 = KOCLB1
  116. IDEPL = 0
  117. IVITE = 0
  118. ITABL = 0
  119. ICH1 = 0
  120. ICH2 = 0
  121. ICH3 = 0
  122. ICH4 = 0
  123. ICH5 = 0
  124. ICH6 = 0
  125. NA1 = Q1(/1)
  126. NB1K = XK(/2)
  127. NB1C = XASM(/2)
  128. NB1M = XM(/2)
  129. NB1 = XOPER(/1)
  130. NLIAA = IPALA(/1)
  131. NLIAB = IPALB(/1)
  132. NPLB = JPLIB(/1)
  133. NSB = XPHILB(/1)
  134. NPLSB = XPHILB(/2)
  135. NA2 = XPHILB(/3)
  136. IDIMB = XPHILB(/4)
  137. NPFEXA = FEXA(/1)
  138. NPC1 = FEXPSM(/2)
  139. NIP = XABSCI(/2)
  140. IERRD = 0
  141. *
  142. * S'agit-il d'une initialisation ou d'une reprise de calcul ?
  143. *
  144. IF ( REPRIS ) THEN
  145. IF (IIMPI.EQ.333) THEN
  146. WRITE(IOIMP,*)'D2VINI : ---> reprise de calcul'
  147. ENDIF
  148. if (lmodyn) then
  149. mwinit = itinit
  150. segact mwinit
  151. ITABL = jrepr
  152. else
  153. CALL ACCTAB(ITINIT,'MOT',I0,X0,'REPRISE',L0,IP0,
  154. & 'TABLE',I1,X1,' ',L1,ITABL)
  155. endif
  156. *
  157. * Reprise du calcul, on remplit: info initiales
  158. *
  159. CALL ACCTAB(ITABL,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  160. & 'CHPOINT',I1,X1,' ',L1,ICH1)
  161. IF (IERR.NE.0) RETURN
  162. *
  163. CALL ACCTAB(ITABL,'MOT',I0,X0,'VITESSE',L0,IP0,
  164. & 'CHPOINT',I1,X1,' ',L1,ICH2)
  165. IF (IERR.NE.0) RETURN
  166.  
  167. *
  168. CALL ACCTAB(ITABL,'MOT',I0,X0,'FORCES_BASE_A',L0,IP0,
  169. & 'CHPOINT',I1,X1,' ',L1,ICH5)
  170. IF (IERR.NE.0) RETURN
  171.  
  172. CALL ACCTAB(ITABL,'MOT',I0,X0,'ACCELERATION',L0,IP0,
  173. & 'CHPOINT',I1,X1,' ',L1,ICH7)
  174. IF (IERR.NE.0) RETURN
  175.  
  176. *
  177. CALL ACCTAB(ITABL,'MOT',I0,X0,'TRAVAIL_EXTERIEUR',L0,IP0,
  178. & 'CHPOINT',I1,X1,' ',L1,ICH9)
  179. IF (IERR.NE.0) RETURN
  180. *
  181. CALL ACCTAB(ITABL,'MOT',I0,X0,'TRAVAIL_INTERIEUR',L0,IP0,
  182. & 'CHPOINT',I1,X1,' ',L1,ICH10)
  183. IF (IERR.NE.0) RETURN
  184. *
  185. IF (ICH1.NE.0) THEN
  186. CALL DYNE18(ICH1,KTQ,1,2,KCPR)
  187. ELSE
  188. CALL ERREUR(487)
  189. RETURN
  190. ENDIF
  191. *
  192. IF (ICH2.NE.0) THEN
  193. CALL DYNE18(ICH2,KTQ,2,2,KCPR)
  194. ELSE
  195. CALL ERREUR(487)
  196. RETURN
  197. ENDIF
  198.  
  199. IF (ICH5.NE.0) THEN
  200. CALL DYNE23(ICH5,KTPAS,2)
  201. ELSE
  202. CALL ERREUR(487)
  203. RETURN
  204. ENDIF
  205.  
  206. IF (ICH7.NE.0) THEN
  207. CALL DYNE18(ICH7,KTQ,3,2,KCPR)
  208. ELSE
  209. CALL ERREUR(487)
  210. RETURN
  211. ENDIF
  212.  
  213. IF (ICH9.NE.0) THEN
  214. CALL DYNE18(ICH9,KTQ,4,2,KCPR)
  215. ENDIF
  216. IF (ICH10.NE.0) THEN
  217. CALL DYNE18(ICH10,KTQ,5,2,KCPR)
  218. ENDIF
  219. *
  220. *
  221. IF (NLIAA.NE.0) THEN
  222. *
  223. * l'indice VARIABLES_LIAISON_A n'existe que pour
  224. * les liaisons POLYNOMIALES
  225. *
  226. IPOLY = 0
  227. MTABLE = ITABL
  228. SEGACT,MTABLE
  229. NIND1 = MLOTAB
  230. if(nbesc.ne.0)segact ipiloc
  231. DO 100 I=1,NIND1
  232. TYPIND = MTABTI(I)
  233. IF (TYPIND.EQ.'MOT ') THEN
  234. IP = MTABII(I)
  235. ID = IPCHAR(IP)
  236. IFI = IPCHAR(IP+1)
  237. IL1 = IFI - ID
  238. IF (IL1.EQ.ILC1) THEN
  239. IF (CHAI1.EQ.ICHARA(ID:IFI-1)) THEN
  240. IPOLY = 1
  241. ENDIF
  242. ENDIF
  243. ENDIF
  244. 100 CONTINUE
  245. if(nbesc.ne.0)SEGDES,IPILOC
  246. SEGDES,MTABLE
  247. IF (IIMPI.EQ.333) THEN
  248. WRITE(IOIMP,*) 'D2VINI : IPOLY = ',IPOLY
  249. ENDIF
  250. IF (IPOLY.NE.0) THEN
  251. CALL ACCTAB(ITABL,'MOT',I0,X0,'VARIABLES_LIAISON_A',
  252. & L0,IP0,'TABLE',I1,X1,' ',L1,ITREFR)
  253. CALL DYNA14(ITREFR,KTLIAA)
  254. IF (IERR.NE.0) RETURN
  255. ENDIF
  256. ENDIF
  257. IF (NLIAB.NE.0) THEN
  258. CALL DEVRCO(Q1,NA1,XPTB,NPLB,XPHILB,NSB,NPLSB,NA2,IDIMB,
  259. & IBASB,IPLSB,INMSB,IORSB,2,IAROTA)
  260. CALL ACCTAB(ITABL,'MOT',I0,X0,'VARIABLES_LIAISON_B',
  261. & L0,IP0,'TABLE',I1,X1,' ',L1,ITREFR)
  262. IF (IERR.NE.0) RETURN
  263. CALL DYNE14(ITREFR,KTLIAB)
  264. IF (IERR.NE.0) RETURN
  265. ENDIF
  266. *
  267. ELSE
  268. *
  269. * Chpoints initiaux de deplacement et de vitesse:
  270. *
  271. IF (ITINIT.NE.0) THEN
  272. if (lmodyn) then
  273. mwinit = itinit
  274. segact mwinit
  275. idepl = jpdep
  276. ivite = jpvit
  277. else
  278. TYPRET=' '
  279. CALL ACCTAB(ITINIT,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  280. & TYPRET,I1,X1,CHARRE,L1,IDEPL)
  281. *
  282. TYPRET=' '
  283. CALL ACCTAB(ITINIT,'MOT',I0,X0,'VITESSE',L0,IP0,
  284. & TYPRET,I1,X1,CHARRE,L1,IVITE)
  285. endif
  286. ENDIF
  287. *
  288. * Mise des valeurs initiales au pas m (indice 3)
  289. *
  290. IF (IDEPL.NE.0) THEN
  291. CALL DYNE18(IDEPL,KTQ,1,2,KCPR)
  292. MTQ = KTQ
  293. ENDIF
  294. IVINIT = 0
  295. IF (IVITE.NE.0) THEN
  296. CALL DYNE18(IVITE,KTQ,2,2,KCPR)
  297. IVINIT = 1
  298. ENDIF
  299. *
  300. * Ajout des forces de liaison
  301. *
  302. PDT=XDT(1)
  303. T=XTEMPS(1)
  304. IF (NLIAA.NE.0) THEN
  305. CALL D2VLFA(Q1,Q2,FTOTA,NA1,IPALA,IPLIA,XPALA,XVALA,
  306. & NLIAA,PDT,T,1,2,FINERT,IVINIT,FTEST,FTOTA0)
  307. ENDIF
  308. IF (NLIAB.NE.0) THEN
  309. IF (RIGIDE) THEN
  310. DO 13 IP=1,NPLB
  311. DO 15 ID=1,IDIM
  312. FEXB(IP,2,ID) = FTEXB(IP,1,2,ID)
  313. 15 CONTINUE
  314. 13 CONTINUE
  315. ENDIF
  316. CALL D2VLF2(Q1,Q2,FTOTA,NA1,IPALB,IPLIB,XPALB,XVALB,
  317. & NLIAB,XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,XPTB,
  318. & PDT,T,1,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,2,
  319. & FEXPSM,NPC1,IERRD,FTEST2,FTOTB0,XABSCI,XORDON,
  320. & NIP,IAROTA,RIGIDE,FEXB,XCHPFB)
  321. IF (IERRD.NE.0) THEN
  322. IF (IERRD.EQ.1) CALL ERREUR(528)
  323. RETURN
  324. ENDIF
  325. ENDIF
  326. *
  327. * Calcul des deplacements et des vitesses au pas debut du initial
  328. *
  329. IF (IIMPI.EQ.333) THEN
  330. DO 91 I=1,NA1
  331. WRITE(IOIMP,*)'D2VINI :'
  332. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',3) =',FTOTA(I,3)
  333. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',4) =',FTOTA(I,4)
  334. WRITE(IOIMP,*)'D2VINI : Fexa (',I,',1) =',Fexa(I,1)
  335. WRITE(IOIMP,*)'D2VINI : Fexa (',I,',2) =',Fexa(I,2)
  336. 91 CONTINUE
  337. * end do
  338. ENDIF
  339.  
  340. c Cas selon nature (pleine ou diag) des matrices K,C et M :
  341. c------- Cas K,C ou M pleine -----------------------------------
  342. IF(NB1K.GT.1.OR.NB1C.GT.1.OR.NB1M.GT.1) THEN
  343.  
  344. c F_0 = F^liaison_0 + F^ext_0 - K * Q_0
  345. DO 61 I = 1,NA1
  346. FTOTA(I,2) = FTOTA(I,2) + FEXA(I,1,2)
  347. 61 CONTINUE
  348. CALL DEVLK0(Q1,XK,FTOTA,NA1,NB1K,2)
  349. SEGINI,FAMOR
  350. c CALL DEVLC0(Q2,XASM,FAMOR,NA1,NB1C,2)
  351. IF (NB1C.EQ.1) THEN
  352. DO 611 I=1,NA1
  353. FAMOR(I) = XASM(I,1)*Q2(I,2)
  354. 611 CONTINUE
  355. ELSE
  356. DO 612 I=1,NA1
  357. FAMOR(I) = 0.D0
  358. DO 612 IB=1,NB1
  359. FAMOR(I) = FAMOR(I) + XASM(I,IB)*Q2(IB,2)
  360. 612 CONTINUE
  361. ENDIF
  362. c \ddot Q_0 = [M+dt/2C]-1 * (F_0 - F^AMOR_0)
  363. c -cas matrice M ou C pleine
  364. IF(NB1.NE.1) THEN
  365. DO 63 I=1,NA1
  366. Q3(I,2) = 0.D0
  367. DO 63 J=1,NB1
  368. Q3(I,2) = Q3(I,2) + XOPER(I,J,1)*(FTOTA(J,2)-FAMOR(J))
  369. 63 CONTINUE
  370. ELSE
  371. DO 62 I=1,NA1
  372. Q3(I,2) = (FTOTA(I,2)-FAMOR(I))/(XM(I,1)-FINERT(I,2))
  373. 62 CONTINUE
  374. ENDIF
  375. SEGSUP,FAMOR
  376.  
  377. c -cas matrices M et C diagonales
  378.  
  379. c------- Cas K,C et M diagonal -----------------------------------
  380. ELSE
  381.  
  382. DO 10 I = 1,NA1
  383. UNSM = 1.D0 / ( XM(I,1) - FINERT(I,2) )
  384. FTOTA(I,2) = FTOTA(I,2) + FEXA(I,1,2) - XK(I,1)*Q1(I,2)
  385. & - XASM(I,1)*Q2(I,2)
  386. Q3(I,2) = FTOTA(I,2)*UNSM
  387. 10 CONTINUE
  388.  
  389. ENDIF
  390. *
  391. ENDIF
  392. IF (IIMPI.EQ.333) THEN
  393. DO 30 I=1,NA1
  394. WRITE(IOIMP,*)'D2VINI :'
  395. WRITE(IOIMP,*)'D2VINI : Q1(',I,',1) =',Q1(I,1)
  396. WRITE(IOIMP,*)'D2VINI : Q2(',I,',1) =',Q2(I,1)
  397. WRITE(IOIMP,*)'D2VINI : Q3(',I,',1) =',Q3(I,1)
  398. WRITE(IOIMP,*)'D2VINI :'
  399. WRITE(IOIMP,*)'D2VINI :'
  400. WRITE(IOIMP,*)'D2VINI : Q1(',I,',2) =',Q1(I,2)
  401. WRITE(IOIMP,*)'D2VINI : Q2(',I,',2) =',Q2(I,2)
  402. WRITE(IOIMP,*)'D2VINI : Q3(',I,',2) =',Q3(I,2)
  403. WRITE(IOIMP,*)'D2VINI :'
  404. WRITE(IOIMP,*)'D2VINI :'
  405. WRITE(IOIMP,*)'D2VINI : Q1(',I,',3) =',Q1(I,3)
  406. WRITE(IOIMP,*)'D2VINI : Q2(',I,',3) =',Q2(I,3)
  407. WRITE(IOIMP,*)'D2VINI : Q3(',I,',3) =',Q3(I,3)
  408. WRITE(IOIMP,*)'D2VINI :'
  409. WRITE(IOIMP,*)'D2VINI : Q1(',I,',4) =',Q1(I,4)
  410. WRITE(IOIMP,*)'D2VINI : Q2(',I,',4) =',Q2(I,4)
  411. WRITE(IOIMP,*)'D2VINI : Q3(',I,',4) =',Q3(I,4)
  412. 30 CONTINUE
  413. * end do
  414. DO 31 I=1,NA1
  415. WRITE(IOIMP,*)'D2VINI :',FTOTA(/1),FTOTA(/2)
  416. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',1) =',FTOTA(I,1)
  417. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',2) =',FTOTA(I,2)
  418. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',3) =',FTOTA(I,3)
  419. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',4) =',FTOTA(I,4)
  420. 31 CONTINUE
  421. * end do
  422. ENDIF
  423. *
  424. ICPR = KCPR
  425. SEGSUP,ICPR
  426. *
  427. END
  428.  
  429.  
  430.  
  431.  
  432.  
  433.  
  434.  
  435.  

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