Télécharger d2vini.eso

Retour à la liste

Numérotation des lignes :

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

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