Télécharger devalo.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVALO SOURCE BP208322 15/07/22 21:15:14 8586
  2. SUBROUTINE DEVALO(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,NINS,
  3. & ITSORT,ITREDU,KPREF,KTQ,KTKAM,KTPHI,KTLIAA,
  4. & KTLIAB,KTFEX,KTPAS,KTRES,KTNUM,IPMAIL,REPRIS,
  5. & ICHAIN,KOCLFA,KOCLB1,ITCARA,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. * Dimensionnement des tableaux de travail ( allocation de la *
  14. * memoire ). *
  15. * *
  16. * Parametres: *
  17. * *
  18. * e ITBAS Table representant une base modale *
  19. * e ITKM Table contenant les matrices XK et XM *
  20. * e ITA Table contenant la matrice XASM *
  21. * e ITLIA Table rassemblant la description des liaisons *
  22. * e ITCHAR Table contenant les chargements *
  23. * e ITINIT Table donnant les conditions initiales *
  24. * e NP Nombre de pas de calcul *
  25. * e PDT Valeur du pas de temps *
  26. * e NINS On veut une sortie tous les NINS pas de calcul *
  27. * e ITSORT Table definissant les resultats attendus *
  28. * e ITREDU Table contenant les noms d'inconnues de la base B *
  29. * auxquelles on se restreint *
  30. * e KPREF Segment des points de reference *
  31. * s MTQ Segment contenant les variables generalisees *
  32. * (et les travaux)
  33. * s MTKAM Segment contenant les vecteurs XK, XASM et XM *
  34. * s MTPHI Segment contenant les deformees modales *
  35. * s MTLIAA Segment descriptif des liaisons en base A *
  36. * s MTLIAB Segment descriptif des liaisons en base B *
  37. * s MTFEX Segment contenant les chargements libres *
  38. * s MTPAS Segment des variables au cours d'un pas de temps *
  39. * s MTRES Segment de sauvegarde des resultats *
  40. * s MTNUM Segment contenant les parametres temporels *
  41. * s IPMAIL Maillage de reference pour les CHPOINTs resultats *
  42. * s REPRIS Vrai si reprise de calcul, faux sinon *
  43. * s ICHAIN Segment MLENTI (ACTIF) contenant les adresses des *
  44. * chaines dans la pile des mots de CCNOYAU *
  45. * s KOCLFA Segment contenant les tableaux locaux de la subroutine *
  46. * DEVLFA *
  47. * s KOCLB1 Segment contenant les tableaux locaux de la subroutine *
  48. * DEVLB1 *
  49. * *
  50. * Auteur, date de creation: *
  51. * *
  52. * Denis ROBERT-MOUGIN, le 25 mai 1989. *
  53. * NTRA passe a 10000 le 28/1/93 par D. R. *
  54. *--------------------------------------------------------------------*
  55. -INC CCOPTIO
  56. -INC SMCOORD
  57. -INC SMMODEL
  58. -INC SMELEME
  59. -INC SMCHAML
  60. -INC SMLENTI
  61. *
  62. * Segment des variables generalisees:
  63. *
  64. SEGMENT,MTQ
  65. REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4)
  66. REAL*8 WEXT(NA1,2),WINT(NA1,2)
  67. ENDSEGMENT
  68. *
  69. * Segment contenant les matrices XK, XASM et XM:
  70. *
  71. SEGMENT,MTKAM
  72. REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M)
  73. REAL*8 XOPER(NB1,NB1,NOPER)
  74. ENDSEGMENT
  75. *
  76. * Segment des deformees modales:
  77. *
  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. *
  84. * Segment descriptif des liaisons en base A:
  85. *
  86. SEGMENT,MTLIAA
  87. INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
  88. REAL*8 XPALA(NLIAA,NXPALA)
  89. ENDSEGMENT
  90. *
  91. * Segment descriptif des liaisons en base B:
  92. *
  93. SEGMENT MTLIAB
  94. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  95. REAL*8 XPALB(NLIAB,NXPALB)
  96. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  97. ENDSEGMENT
  98. *
  99. * Segment representant les chargements libres:
  100. *
  101. SEGMENT,MTFEX
  102. REAL*8 FEXA(NPFEXA,NPC1,2)
  103. REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB)
  104. REAL*8 FTEXB(NPLB,NPC1,2,IDIM)
  105. INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
  106. ENDSEGMENT
  107. *
  108. * Segment contenant les variables au cours d'un pas de temps:
  109. *
  110. SEGMENT,MTPAS
  111. REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1)
  112. REAL*8 XPTB(NPLB,4,IDIMB),FINERT(NA1,4)
  113. REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR)
  114. REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB)
  115. ENDSEGMENT
  116. *
  117. * Segment de sauvegarde des resultats (active dans DYNE15) :
  118. *
  119. SEGMENT,MTRES
  120. REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES)
  121. REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB)
  122. REAL*8 XMREP(NLIAB,4,IDIMB)
  123. INTEGER ICHRES(NVES),IPORES(NRES,NPRES),IPOREP(NREP)
  124. INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA)
  125. INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB)
  126. INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR)
  127. INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR)
  128. INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4)
  129. INTEGER ILPOLA(NLIAA,2)
  130. ENDSEGMENT
  131. *
  132. * Segment contenant les parametres temporels:
  133. *
  134. SEGMENT,MTNUM
  135. REAL*8 XDT(NPC1),XTEMPS(NPC1)
  136. ENDSEGMENT
  137. *
  138. * Segment des points de reference:
  139. *
  140. SEGMENT,MPREF
  141. INTEGER IPOREF(NPREF)
  142. ENDSEGMENT
  143. *
  144. * Segment de points
  145. *
  146. SEGMENT,NCPR(XCOOR(/1)/(IDIM+1))
  147. *
  148. * Segment de travail pour reprise force POLYNOMIALE base A
  149. *
  150. SEGMENT,MTRA
  151. INTEGER IPLA(NTRA)
  152. ENDSEGMENT
  153. *
  154. * Segment "local" pour DEVLFA ...
  155. SEGMENT,LOCLFA
  156. REAL*8 FTEST(NA1,4),FTOTA0(NA1,4)
  157. ENDSEGMENT
  158. * Segment "local" pour DEVLB1 ...
  159. SEGMENT,LOCLB1
  160. REAL*8 FTEST2(NPLB,6),FTOTB0(NPLB,6)
  161. ENDSEGMENT
  162. * Segment pour Champoints
  163. SEGMENT,MSAM
  164. integer jplibb(NPLB)
  165. ENDSEGMENT
  166. * segment chapeau modeles liaisons
  167. SEGMENT MOLIAI
  168. integer modtla,modtlb
  169. ENDSEGMENT
  170. *
  171. segment mwinit
  172. integer jpdep,jpvit,jrepr
  173. endsegment
  174. segment mtbas
  175. integer itbmod,lsstru(np1),nsstru
  176. endsegment
  177. segment icma(0)
  178. segment icnna2(0)
  179. LOGICAL L0,L1,REPRIS,LMODYN
  180. CHARACTER*6 MO2
  181. CHARACTER*8 TYPRET,CHARRE
  182. CHARACTER*10 MO1
  183. CHARACTER*40 MONMOT
  184. *
  185. ITREP = 0
  186. MTQ = 0
  187. MTKAM = 0
  188. MTPHI = 0
  189. MTLIAA = 0
  190. MTLIAB = 0
  191. MTFEX = 0
  192. MTPAS = 0
  193. MTRES = 0
  194. MTNUM = 0
  195. MTRA = 0
  196. XTINI = 0.D0
  197. ITLA = 0
  198. ITLB = 0
  199. REPRIS = .FALSE.
  200. *
  201. ************************************************************************
  202. * On recupere le cas echeant, le temps de reprise:
  203. ************************************************************************
  204. *
  205. IF (ITINIT.NE.0) THEN
  206. if (lmodyn) then
  207. mwinit = itinit
  208. segact mwinit
  209. if (jrepr.gt.0) then
  210. itrep = jrepr
  211. REPRIS = .TRUE.
  212. CALL ACCTAB(ITREP,'MOT',I0,X0,'TEMPS_DE_REPRISE',L0,IP0,
  213. & 'FLOTTANT',I1,XTINI,CHARRE,L1,IP1)
  214. IF (IERR.NE.0) RETURN
  215. endif
  216. else
  217. TYPRET = ' '
  218. CALL ACCTAB(ITINIT,'MOT',I0,X0,'REPRISE',L0,IP0,
  219. & TYPRET,I1,X1,CHARRE,L1,ITREP)
  220. IF (IERR.NE.0) RETURN
  221. IF (ITREP.NE.0) THEN
  222. IF (TYPRET.EQ.'TABLE ') THEN
  223. REPRIS = .TRUE.
  224. CALL ACCTAB(ITREP,'MOT',I0,X0,'TEMPS_DE_REPRISE',L0,IP0,
  225. & 'FLOTTANT',I1,XTINI,CHARRE,L1,IP1)
  226. IF (IERR.NE.0) RETURN
  227. ELSE
  228. CALL ERREUR(487)
  229. RETURN
  230. ENDIF
  231. ENDIF
  232. endif
  233. ENDIF
  234. IF (IIMPI.EQ.333) write(ioimp,*)'devalo: TEMPS_DE_REPRISE=',XTINI
  235. *
  236. ************************************************************************
  237. * Parametres temporels: pas de temps constant
  238. ************************************************************************
  239. *
  240. NPC1 = NP + 1
  241. SEGINI,MTNUM
  242. KTNUM = MTNUM
  243. XDT(1) = PDT
  244. XTEMPS(1) = XTINI
  245. DO 10 I = 2,NPC1
  246. XDT(I) = PDT
  247. XTEMPS(I) = XTEMPS(I-1) + PDT
  248. 10 CONTINUE
  249. * end do
  250. *
  251. ************************************************************************
  252. * Recherche du nombre de modes: autant que de points de reference
  253. ************************************************************************
  254. *
  255. MPREF = KPREF
  256. NA1 = IPOREF(/1)
  257. c on intialise NB1 a 1; le segment sera eventuellement ajuste
  258. c lors du remplissage par DEVTRA (OU D2VTRA)
  259. NB1 = 1
  260. NB1K = 1
  261. NB1C = 1
  262. NB1M = 1
  263. NOPER=0
  264. SEGINI,MTQ,MTKAM
  265. SEGINI,LOCLFA
  266. KOCLFA = LOCLFA
  267. KTQ = MTQ
  268. KTKAM = MTKAM
  269. *
  270. ************************************************************************
  271. * Gestion des segments descriptifs des liaisons
  272. ************************************************************************
  273. *
  274. NLIAA = 0
  275. NIPALA = 0
  276. NXPALA = 0
  277. NPLAA = 0
  278. NPLA = 0
  279. NLIAB = 0
  280. NIPALB = 0
  281. NXPALB = 0
  282. NIP = 0
  283. NPLBB = 0
  284. NPLB = 0
  285. NPLSB = 0
  286. IDIMB = 0
  287. NA2 = 0
  288. NSB = 0
  289. KCPR = 0
  290. NTVAR = 6 + 4 * IDIM
  291. *
  292. * MTRA indiquera la presence de liaisons POLYNOMIALEs
  293. * (on suppose un maximum de 100 liaisons en base A)
  294. *+* passe a 10000 le 28/1/93
  295. NTRA = 10000
  296. SEGINI,MTRA
  297. *
  298. IF (ITLIA.NE.0) THEN
  299. if (lmodyn) then
  300. mtbas = itbas
  301. ipbmod = itbmod
  302. call ecrcha('MAIL')
  303. call ecrobj('MMODEL',ipbmod)
  304. call extrai
  305. call lirobj('MAILLAGE',ipt1,0,iret)
  306. if (ierr.ne.0) return
  307. if (iret.ne.1) then
  308. write(6,*) 'pb developpement devalo'
  309. return
  310. endif
  311. itmail = ipt1
  312. segact ipt1
  313. segini ncpr
  314. do ie = 1,ipt1.num(/2)
  315. ncpr(ipt1.num(1,ie)) = 1
  316. enddo
  317.  
  318. mmodel = itlia
  319. segact mmodel
  320. n1 = kmodel(/1)
  321. segini mmode1,mmode2
  322. klia = 0
  323. klib = 0
  324. do ik = 1,kmodel(/1)
  325. imodel = kmodel(ik)
  326. segact imodel
  327. meleme = imamod
  328. segact meleme
  329.  
  330. if (ncpr(num(1,1)).gt.0) then
  331. klia = klia + 1
  332. mmode1.kmodel(klia) = imodel
  333. else
  334. klib = klib + 1
  335. mmode2.kmodel(klib) = imodel
  336. endif
  337.  
  338. enddo
  339. segdes mmodel
  340. n1 = klia
  341. itla = mmode1
  342. segadj mmode1
  343. n1 = klib
  344. segadj mmode2
  345. itlb = mmode2
  346. segsup ncpr
  347. segini moliai
  348. modtla = itla
  349. if (klia.eq.0) modtla = 0
  350. modtlb = itlb
  351. if (klib.eq.0) modtlb = 0
  352. * distingue liasons A et B
  353. ITLIA = MOLIAI
  354. *
  355. else
  356. *
  357. TYPRET = ' '
  358. CALL ACCTAB(ITLIA,'MOT',I0,X0,'LIAISON_A',L0,IP0,
  359. & TYPRET,I1,X1,CHARRE,L1,ITLA)
  360. IF (IERR.NE.0) RETURN
  361. *
  362. * Liaisons sur la base A : determination des parametres
  363. *
  364. IF (ITLA.NE.0.and.(.not.lmodyn)) THEN
  365. IF (TYPRET.EQ.'TABLE ') THEN
  366. CALL DYNE21(ITLA,PDT,MTRA,KLIAA,KXPALA,KPLAA,KIPALA)
  367. IF (IERR.NE.0) RETURN
  368. NLIAA = KLIAA
  369. NIPALA = KIPALA
  370. NXPALA = KXPALA
  371. NPLAA = KPLAA
  372. NPLA = NA1
  373. ELSE
  374. CALL ERREUR(492)
  375. RETURN
  376. ENDIF
  377. ENDIF
  378. *
  379. * Liaisons sur la base B : determination des parametres
  380. *
  381. TYPRET = ' '
  382. CALL ACCTAB(ITLIA,'MOT',I0,X0,'LIAISON_B',L0,IP0,
  383. & TYPRET,I1,X1,CHARRE,L1,ITLB)
  384. IF (IERR.NE.0) RETURN
  385. IF (ITLB.NE.0.and.(.not.lmodyn)) THEN
  386. IF (TYPRET.EQ.'TABLE ') THEN
  387. CALL DYNE22(ITLB,KLIAB,KXPALB,KPLBB,KPLB,KDIMB,KCPR,
  388. & KIPALB,KNIP)
  389. IF (IERR.NE.0) RETURN
  390. NLIAB = KLIAB
  391. NIPALB = KIPALB
  392. NXPALB = KXPALB
  393. NPLBB = KPLBB
  394. NPLB = KPLB
  395. IDIMB = KDIMB
  396. NIP = KNIP
  397. ELSE
  398. CALL ERREUR(493)
  399. RETURN
  400. ENDIF
  401. ENDIF
  402. *
  403. endif
  404. *
  405. if (lmodyn.and.klia.gt.0) then
  406. CALL DYNE71(ITLA,PDT,MTRA,KLIAA,KXPALA,KPLAA,KIPALA)
  407. IF (IERR.NE.0) RETURN
  408. NLIAA = KLIAA
  409. NIPALA = KIPALA
  410. NXPALA = KXPALA
  411. NPLAA = KPLAA
  412. NPLA = NA1
  413. endif
  414. if (lmodyn.and.klib.gt.0) then
  415. CALL DYNE72(ITLB,KLIAB,KXPALB,KPLBB,KPLB,KDIMB,KCPR,
  416. & KIPALB,KNIP,ITCARA)
  417. IF (IERR.NE.0) RETURN
  418. NLIAB = KLIAB
  419. NIPALB = KIPALB
  420. NXPALB = KXPALB
  421. NPLBB = KPLBB
  422. NPLB = KPLB
  423. IDIMB = KDIMB
  424. NIP = KNIP
  425. endif
  426. ENDIF
  427. SEGINI,LOCLB1
  428. KOCLB1 = LOCLB1
  429. *
  430. * Les segments seront remplis dans le s-p DEVLIA:
  431. *
  432. SEGINI,MTLIAA
  433. SEGINI,MTLIAB
  434. KTLIAA = MTLIAA
  435. KTLIAB = MTLIAB
  436. IF (NLIAB.NE.0) THEN
  437. NCPR = KCPR
  438. LCPR = XCOOR(/1) / (IDIM + 1)
  439. IN = 0
  440. DO 20 I = 1,LCPR
  441. IF (NCPR(I).NE.0) THEN
  442. IN = IN + 1
  443. JPLIB(IN) = I
  444. ENDIF
  445. 20 CONTINUE
  446. * en do
  447. SEGSUP,NCPR
  448. ENDIF
  449. *
  450. ************************************************************************
  451. * Segment des deformees modales:
  452. ************************************************************************
  453.  
  454. ***** Cas table BASE_MODALE et RAIDEUR_ET_MASSE *****
  455.  
  456. IF (ITKM.GT.0) THEN
  457. TYPRET = ' '
  458. CALL ACCTAB(ITKM,'MOT',I0,X0,'BASE_MODALE',L0,IP0,
  459. & TYPRET,I1,X1,CHARRE,L1,ITBAS2)
  460. ELSE
  461. ITBAS2=ITBAS
  462. ENDIF
  463.  
  464. c IF (ITBAS.NE.0.and.(.not.lmodyn)) THEN
  465. IF (ITBAS2.NE.0.and.(.not.lmodyn)) THEN
  466.  
  467. CALL ACCTAB(ITBAS2,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  468. & 'MOT',I1,X1,MONMOT,L1,IP1)
  469. IF (IERR.NE.0) RETURN
  470. IF (IIMPI.EQ.333) write(ioimp,*) ITBAS2,'de SOUSTYPE',MONMOT
  471. *
  472. * -Cas ou la base est unique
  473. IF (MONMOT(1:11).EQ.'BASE_MODALE') THEN
  474. NSB = 1
  475. NA2 = NA1
  476. * changement de dimension en cas de corps rigide
  477. CALL ACCTAB(ITBAS2,'MOT',I0,X0,'MODES',L0,IP0,
  478. & 'TABLE',I1,X1,' ',L1,IBAS)
  479. IP = 0
  480. 22 CONTINUE
  481. IP = IP + 1
  482. TYPRET = ' '
  483. CALL ACCTAB(IBAS,'ENTIER',IP,X0,' ',L0,IP0,
  484. & TYPRET,I1,X1,CHARRE,L1,ITP1)
  485. IF (IERR.NE.0) RETURN
  486. IF (TYPRET.NE.'TABLE') GOTO 23
  487. IF (ITP1.LE.0) GOTO 23
  488. TYPRET = ' '
  489. CALL ACCTAB(ITP1,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0,
  490. & TYPRET,I1,X1,MONMOT,L1,IP1)
  491. IF (IERR.NE.0) RETURN
  492. IF (TYPRET.EQ.'MOT') THEN
  493. IF (MONMOT(1:4).EQ.'VRAI') THEN
  494. if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3
  495. if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6
  496. GOTO 23
  497. ENDIF
  498. ENDIF
  499. GOTO 22
  500. 23 CONTINUE
  501.  
  502. * -Cas ou la base est un ensemble de bases
  503. ELSE
  504. IB = 0
  505. NA2 = 0
  506. * changement de dimension en cas de corps rigide
  507. IR = 0
  508. 30 CONTINUE
  509. IB = IB + 1
  510. c write(ioimp,*) IB,'ieme base de l ensemble'
  511. TYPRET = ' '
  512. CALL ACCTAB(ITBAS2,'ENTIER',IB,X0,' ',L0,IP0,
  513. & TYPRET,I1,X1,CHARRE,L1,ITBB)
  514. IF (IERR.NE.0) RETURN
  515. c --cas lecture table de la IB ieme base modale ok
  516. IF (ITBB.NE.0) THEN
  517. IF (TYPRET.EQ.'TABLE ') THEN
  518. CALL ACCTAB(ITBB,'MOT',I0,X0,'MODES',L0,IP0,
  519. & 'TABLE',I1,X1,' ',L1,IBAS)
  520. IF (IERR.NE.0) RETURN
  521. NNA2 = 0
  522. IP = 0
  523. 32 CONTINUE
  524. IP = IP + 1
  525. c write(ioimp,*) ' +',IP,'ieme mode de la ',IB,'ieme base'
  526. TYPRET = ' '
  527. CALL ACCTAB(IBAS,'ENTIER',IP,X0,' ',L0,IP0,
  528. & TYPRET,I1,X1,CHARRE,L1,ITPP)
  529. IF (IERR.NE.0) RETURN
  530. c --cas lecture table du IP ieme mode ok
  531. IF (ITPP.NE.0) THEN
  532. IF (TYPRET.EQ.'TABLE ') THEN
  533. * changement de dimension en cas de corps rigide
  534. IF (IR.GT.1) GOTO 24
  535. TYPRET = ' '
  536. CALL ACCTAB(ITPP,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0,
  537. & TYPRET,I1,X1,MONMOT,L1,IP1)
  538. IF (IERR.NE.0) RETURN
  539. IF (TYPRET.EQ.'MOT') THEN
  540. IF (MONMOT(1:4).EQ.'VRAI') THEN
  541. if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3
  542. if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6
  543. ENDIF
  544. ENDIF
  545. 24 CONTINUE
  546. NNA2 = NNA2 + 1
  547. GOTO 32
  548. c --fin du cas lecture table du IP ieme mode ok
  549. ELSE
  550. CALL ERREUR(491)
  551. RETURN
  552. ENDIF
  553. ENDIF
  554. c --fin du cas lecture table du IP ieme mode non ok
  555. NA2 = MAX(NNA2,NA2)
  556. GOTO 30
  557. c --fin du cas lecture table de la IB ieme base modale ok
  558. ELSE
  559. CALL ERREUR(491)
  560. RETURN
  561. ENDIF
  562. ENDIF
  563. c --fin du cas lecture table de la IB ieme base modale non ok
  564. NSB = IB - 1
  565. ENDIF
  566. * -fin distinction base modale simple / ensemble de bases
  567. NPLSB = NPLB
  568.  
  569.  
  570. ***** Cas table PASAPAS *****
  571.  
  572. ELSEIF (LMODYN) THEN
  573.  
  574. mchelm = itcara
  575. segact mchelm
  576. n1 = imache(/1)
  577. segini icma,icnna2
  578. mtbas = ITBAS
  579. MMODEL = ITBMOD
  580. segact MMODEL
  581. kstru = 0
  582. do im = 1,kmodel(/1)
  583. imodel = kmodel(im)
  584. segact imodel
  585. * recherche sommaire nombre de sous-structures independantes
  586. do 46 in = 1,n1
  587. meleme = imache(in)
  588. if (meleme.ne.imamod) goto 46
  589. if (conche(in).ne.conmod) goto 46
  590. segact meleme
  591. mchaml = ichaml(in)
  592. segact mchaml
  593. n2 = ielval(/1)
  594.  
  595. do io = 1,n2
  596. if (nomche(io)(1:4).eq.'CGRA') then
  597. * recherche corps rigide
  598. if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3
  599. if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6
  600. else if (nomche(io)(1:4).eq.'DEFO') then
  601. melval = ielval(io)
  602. segact melval
  603. * assume que le maillage modèle se réduit au point support
  604. icdef1 = ielche(1,1)
  605. call ecrcha('NOMU')
  606. call ecrcha('MAIL')
  607. call ecrobj('CHPOINT ',icdef1)
  608. call extrai
  609. call lirobj('MAILLAGE', icmaio,1,iret)
  610. if (ierr.ne.0) return
  611. if (kstru.eq.0) then
  612. kstru = 1
  613. icma(**)=icmaio
  614. icnna2(**)=1
  615. lsstru(im) = kstru
  616. endif
  617. if (in.gt.1) then
  618. ipt5 = icmaio
  619. do ic = 1,kstru
  620. icmic = icma(ic)
  621. CALL INTERB(icmaio,icmic,IRETIB,icinte)
  622. if (iretib.eq.0) then
  623. ipt6 = icinte
  624. segact ipt6,ipt5
  625. if (ipt5.num(/2).eq.ipt6.num(/2)) then
  626. segsup ipt6
  627. icnna2(ic) = icnna2(ic) + 1
  628. lsstru(im) = ic
  629. goto 47
  630. endif
  631. segsup ipt6
  632. endif
  633. enddo
  634. kstru = kstru + 1
  635. icma(**) = icmaio
  636. icnna2(**) = 1
  637. lsstru(im) = kstru
  638. endif
  639. goto 47
  640. endif
  641. enddo
  642. 46 continue
  643. 47 continue
  644. segdes imodel
  645. enddo
  646. NSB = icma(/1)
  647. NA2 = icnna2(1)
  648. do ic = 1,icnna2(/1)
  649. na2 = MAX(icnna2(ic),NA2)
  650. enddo
  651. nsstru = kstru
  652. segsup icma,icnna2
  653. segdes mmodel
  654. *
  655. ENDIF
  656. *
  657. * on met NPLSB a 1 car le calcul actuel est debile
  658. * on ajuste la dimension dans dyne26
  659. *
  660. * MP
  661. *
  662. NPLSB=1
  663. SEGINI,MTPHI
  664. KTPHI = MTPHI
  665. *
  666. ************************************************************************
  667. * Variables au cours d'un pas de temps:
  668. ************************************************************************
  669. *
  670. SEGINI,MTPAS
  671. KTPAS = MTPAS
  672. *
  673. ************************************************************************
  674. * Initialisation du segment representant les chargements ( bases A
  675. * et B ), il sera rempli dans le s-p DEVFX0:
  676. ************************************************************************
  677. *
  678. NPFEXA = NA1
  679. NPFEXB = 0
  680. SEGINI,MTFEX
  681. KTFEX = MTFEX
  682. *
  683. ************************************************************************
  684. * Gestion de la table definissant les resultats attendus:
  685. * ( par la suite, on s'occupera de TREDU )
  686. ************************************************************************
  687. *
  688. CALL DYNE15(ITSORT,KPREF,NA1,NP,NINS,ITLIA,KTRES,IPMAIL,REPRIS,
  689. & ICHAIN,NTVAR,NLIAA,NLIAB,NPLB,IDIMB,MTRA,ITCARA,lmodyn,
  690. & na1)
  691. IF (IERR.NE.0) RETURN
  692. MTRES = KTRES
  693. *
  694. ************************************************************************
  695. * Creation des objets resultats :
  696. ************************************************************************
  697. *
  698. SEGINI,MSAM
  699. KSAM=MSAM
  700. DO 100 IP=1,NPLB
  701. JPLIBB(IP)=JPLIB(IP)
  702. 100 CONTINUE
  703. CALL DYNE17(ITBAS,ITKM,IPMAIL,KTRES,KPREF,NPLAA,NXPALA,KSAM,
  704. & lmodyn)
  705. IF (IERR.NE.0) RETURN
  706. MSAM=KSAM
  707. SEGSUP,MSAM
  708. *
  709. ************************************************************************
  710. * Impressions :
  711. ************************************************************************
  712.  
  713. IF (IIMPI.EQ.333) THEN
  714. WRITE(IOIMP,*)'DEVALO : nombre de pas de temps ',NP
  715. WRITE(IOIMP,*)'DEVALO : temps de reprise ',XTINI
  716. *
  717. WRITE(IOIMP,*)' segment MTLIAB'
  718. WRITE(IOIMP,*)' NLIAB =',IPALB(/1)
  719. WRITE(IOIMP,*)' NIPALB =',IPALB(/2)
  720. WRITE(IOIMP,*)' NXPALB =',XPALB(/2)
  721. WRITE(IOIMP,*)' NPLBB =',IPLIB(/2)
  722. WRITE(IOIMP,*)' NPLB =',JPLIB(/1)
  723. WRITE(IOIMP,*)' NIP =',XABSCI(/2)
  724. *
  725. WRITE(IOIMP,*)' segment MTLIAA'
  726. WRITE(IOIMP,*)' NLIAA =',IPALA(/1)
  727. WRITE(IOIMP,*)' NIPALA =',IPALA(/2)
  728. WRITE(IOIMP,*)' NXPALA =',XPALA(/2)
  729. WRITE(IOIMP,*)' NPLAA =',IPLIA(/2)
  730. WRITE(IOIMP,*)' NPLA =',JPLIA(/1)
  731. *
  732. WRITE(IOIMP,*)' segment MTRES'
  733. WRITE(IOIMP,*)' NLSA =',XRESLA(/1)
  734. WRITE(IOIMP,*)' NVALA =',XRESLA(/3)
  735. WRITE(IOIMP,*)' NLSB =',XRESLB(/1)
  736. WRITE(IOIMP,*)' NVALB =',XRESLB(/3)
  737. WRITE(IOIMP,*)' NRES =',XRES(/1)
  738. WRITE(IOIMP,*)' NCRES =',XRES(/2)
  739. WRITE(IOIMP,*)' NPRES =',XRES(/3)
  740. WRITE(IOIMP,*)' NREP =',XREP(/1)
  741. WRITE(IOIMP,*)' NTVAR =',ILIREB(/2)
  742. WRITE(IOIMP,*)' NLIAB =',XMREP(/1)
  743. WRITE(IOIMP,*)' IDIMB =',XMREP(/3)
  744. WRITE(IOIMP,*)' NLIAA =',ILPOLA(/1)
  745. *
  746. WRITE(IOIMP,*)' segment MTFEX'
  747. WRITE(IOIMP,*)' NPC1 =',FEXA(/2)
  748. WRITE(IOIMP,*)' NPLB =',FEXPSM(/1)
  749. WRITE(IOIMP,*)' IDIMB =',FEXPSM(/4)
  750. WRITE(IOIMP,*)' NPFEXA =',IFEXA(/1)
  751. WRITE(IOIMP,*)' NPFEXB =',IFEXB(/1)
  752. *
  753. DO 1000 IP = 1,NPLB
  754. WRITE(IOIMP,*)'DEVALO : JPLIB(',IP,') =',JPLIB(IP)
  755. 1000 CONTINUE
  756. ENDIF
  757. *
  758. RETURN
  759. END
  760.  
  761.  
  762.  
  763.  
  764.  

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