Télécharger d2vini.eso

Retour à la liste

Numérotation des lignes :

  1. C D2VINI SOURCE BP208322 15/07/22 21:15:08 8586
  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. IF (NLIAA.NE.0) THEN
  303. CALL D2VLFA(Q1,Q2,FTOTA,NA1,IPALA,IPLIA,XPALA,XVALA,
  304. & NLIAA,XDT,1,2,FINERT,IVINIT,FTEST,FTOTA0)
  305. ENDIF
  306. IF (NLIAB.NE.0) THEN
  307. IF (RIGIDE) THEN
  308. DO 13 IP=1,NPLB
  309. DO 15 ID=1,IDIM
  310. FEXB(IP,2,ID) = FTEXB(IP,1,2,ID)
  311. 15 CONTINUE
  312. 13 CONTINUE
  313. ENDIF
  314. CALL D2VLF2(Q1,Q2,FTOTA,NA1,IPALB,IPLIB,XPALB,XVALB,
  315. & NLIAB,XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,XPTB,
  316. & XDT,1,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,2,
  317. & FEXPSM,NPC1,IERRD,FTEST2,FTOTB0,XABSCI,XORDON,
  318. & NIP,IAROTA,RIGIDE,FEXB,XCHPFB)
  319. IF (IERRD.NE.0) THEN
  320. IF (IERRD.EQ.1) CALL ERREUR(528)
  321. RETURN
  322. ENDIF
  323. ENDIF
  324. *
  325. * Calcul des deplacements et des vitesses au pas debut du initial
  326. *
  327. IF (IIMPI.EQ.333) THEN
  328. DO 91 I=1,NA1
  329. WRITE(IOIMP,*)'D2VINI :'
  330. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',3) =',FTOTA(I,3)
  331. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',4) =',FTOTA(I,4)
  332. WRITE(IOIMP,*)'D2VINI : Fexa (',I,',1) =',Fexa(I,1)
  333. WRITE(IOIMP,*)'D2VINI : Fexa (',I,',2) =',Fexa(I,2)
  334. 91 CONTINUE
  335. * end do
  336. ENDIF
  337.  
  338. c Cas selon nature (pleine ou diag) des matrices K,C et M :
  339. c------- Cas K,C ou M pleine -----------------------------------
  340. IF(NB1K.GT.1.OR.NB1C.GT.1.OR.NB1M.GT.1) THEN
  341.  
  342. c F_0 = F^liaison_0 + F^ext_0 - K * Q_0
  343. DO 61 I = 1,NA1
  344. FTOTA(I,2) = FTOTA(I,2) + FEXA(I,1,2)
  345. 61 CONTINUE
  346. CALL DEVLK0(Q1,XK,FTOTA,NA1,NB1K,2)
  347. SEGINI,FAMOR
  348. c CALL DEVLC0(Q2,XASM,FAMOR,NA1,NB1C,2)
  349. IF (NB1C.EQ.1) THEN
  350. DO 611 I=1,NA1
  351. FAMOR(I) = XASM(I,1)*Q2(I,2)
  352. 611 CONTINUE
  353. ELSE
  354. DO 612 I=1,NA1
  355. FAMOR(I) = 0.D0
  356. DO 612 IB=1,NB1
  357. FAMOR(I) = FAMOR(I) + XASM(I,IB)*Q2(IB,2)
  358. 612 CONTINUE
  359. ENDIF
  360. c \ddot Q_0 = [M+dt/2C]-1 * (F_0 - F^AMOR_0)
  361. c -cas matrice M ou C pleine
  362. IF(NB1.NE.1) THEN
  363. DO 63 I=1,NA1
  364. Q3(I,2) = 0.D0
  365. DO 63 J=1,NB1
  366. Q3(I,2) = Q3(I,2) + XOPER(I,J,1)*(FTOTA(J,2)-FAMOR(J))
  367. 63 CONTINUE
  368. ELSE
  369. DO 62 I=1,NA1
  370. Q3(I,2) = (FTOTA(I,2)-FAMOR(I))/(XM(I,1)-FINERT(I,2))
  371. 62 CONTINUE
  372. ENDIF
  373. SEGSUP,FAMOR
  374.  
  375. c -cas matrices M et C diagonales
  376.  
  377. c------- Cas K,C et M diagonal -----------------------------------
  378. ELSE
  379.  
  380. DO 10 I = 1,NA1
  381. UNSM = 1.D0 / ( XM(I,1) - FINERT(I,2) )
  382. FTOTA(I,2) = FTOTA(I,2) + FEXA(I,1,2) - XK(I,1)*Q1(I,2)
  383. & - XASM(I,1)*Q2(I,2)
  384. Q3(I,2) = FTOTA(I,2)*UNSM
  385. 10 CONTINUE
  386.  
  387. ENDIF
  388. *
  389. ENDIF
  390. IF (IIMPI.EQ.333) THEN
  391. DO 30 I=1,NA1
  392. WRITE(IOIMP,*)'D2VINI :'
  393. WRITE(IOIMP,*)'D2VINI : Q1(',I,',1) =',Q1(I,1)
  394. WRITE(IOIMP,*)'D2VINI : Q2(',I,',1) =',Q2(I,1)
  395. WRITE(IOIMP,*)'D2VINI : Q3(',I,',1) =',Q3(I,1)
  396. WRITE(IOIMP,*)'D2VINI :'
  397. WRITE(IOIMP,*)'D2VINI :'
  398. WRITE(IOIMP,*)'D2VINI : Q1(',I,',2) =',Q1(I,2)
  399. WRITE(IOIMP,*)'D2VINI : Q2(',I,',2) =',Q2(I,2)
  400. WRITE(IOIMP,*)'D2VINI : Q3(',I,',2) =',Q3(I,2)
  401. WRITE(IOIMP,*)'D2VINI :'
  402. WRITE(IOIMP,*)'D2VINI :'
  403. WRITE(IOIMP,*)'D2VINI : Q1(',I,',3) =',Q1(I,3)
  404. WRITE(IOIMP,*)'D2VINI : Q2(',I,',3) =',Q2(I,3)
  405. WRITE(IOIMP,*)'D2VINI : Q3(',I,',3) =',Q3(I,3)
  406. WRITE(IOIMP,*)'D2VINI :'
  407. WRITE(IOIMP,*)'D2VINI : Q1(',I,',4) =',Q1(I,4)
  408. WRITE(IOIMP,*)'D2VINI : Q2(',I,',4) =',Q2(I,4)
  409. WRITE(IOIMP,*)'D2VINI : Q3(',I,',4) =',Q3(I,4)
  410. 30 CONTINUE
  411. * end do
  412. DO 31 I=1,NA1
  413. WRITE(IOIMP,*)'D2VINI :',FTOTA(/1),FTOTA(/2)
  414. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',1) =',FTOTA(I,1)
  415. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',2) =',FTOTA(I,2)
  416. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',3) =',FTOTA(I,3)
  417. WRITE(IOIMP,*)'D2VINI : FTOTA(',I,',4) =',FTOTA(I,4)
  418. 31 CONTINUE
  419. * end do
  420. ENDIF
  421. *
  422. ICPR = KCPR
  423. SEGSUP,ICPR
  424. *
  425. END
  426.  
  427.  
  428.  
  429.  
  430.  

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