Télécharger devalo.eso

Retour à la liste

Numérotation des lignes :

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

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