Télécharger dyne17.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE17 SOURCE BP208322 18/01/30 21:15:24 9719
  2. SUBROUTINE DYNE17(ITBAS,ITKM,IPMAIL,KTRES,KPREF,NPLAA,NXPALA,
  3. &KSAM,lmodyn)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Creation des CHPOINTs qui contiendront les resultats. *
  12. * Creation des LISTREELs qui contiendront les resultats. *
  13. * Creation des POINTS qui contiendront les variables de liaison *
  14. * necessaires a une reprise. *
  15. * *
  16. * Parametres: *
  17. * *
  18. * e ITBAS Table representant une base modale *
  19. * e ITKM Table contenant les matrices XK et XM *
  20. * e IPMAIL Maillage de reference *
  21. * es KTRES Segment de sauvegarde des resultats *
  22. * e KPREF Segment des points de reference *
  23. * e NPLAA Nombre max de pts pour les liaisons en base A *
  24. * e NXPALA Nombre max de var internes pour ces memes liaisons *
  25. * *
  26. * Remarque importante: tous les CHPOINTs crees vont pointer *
  27. * sur le meme MELEME afin de limiter au maximum la memoire *
  28. * utilisee. *
  29. * *
  30. * Auteur, date de creation: *
  31. * *
  32. * Denis ROBERT-MOUGIN, le 30 juin 1989. *
  33. * *
  34. *--------------------------------------------------------------------*
  35. -INC CCOPTIO
  36. -INC SMCHARG
  37. -INC SMCHPOI
  38. -INC SMELEME
  39. -INC SMRIGID
  40. -INC SMLREEL
  41. -INC SMLENTI
  42. -INC SMCOORD
  43. -INC SMTABLE
  44. *
  45. * IPORES contient les pointeurs sur les CHPOINTs qui
  46. * representeront chaque variable pour chaque pas de sortie.
  47. * IPOREP contient les pointeurs sur les CHPOINTs
  48. * necessaires a une reprise eventuelle de calcul.
  49. *
  50. SEGMENT,MTRES
  51. REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES)
  52. REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB)
  53. REAL*8 XMREP(NLIAB,4,IDIMB)
  54. INTEGER ICHRES(NVES),IPORES(NRESPO,NPRES),IPOREP(NREP)
  55. INTEGER ILIRES(NRESLI,NCRES)
  56. INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA)
  57. INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB)
  58. INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR)
  59. INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR)
  60. INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4)
  61. INTEGER ILPOLA(NLIAA,2)
  62. ENDSEGMENT
  63. SEGMENT,MPREF
  64. INTEGER IPOREF(NPREF)
  65. ENDSEGMENT
  66. * Segment pour Champoints
  67. SEGMENT,MSAM
  68. integer jplibb(NPLB)
  69. ENDSEGMENT
  70. c segment local pour verifier que les matrices sont deja assemblees et
  71. c pas 2 fois la meme inconnue (composante + noeud) dans 2 sous-matrices
  72. SEGMENT MVU
  73. c CHARACTER*4 COMPVU(NCVU)
  74. c INTEGER IDEJVU(NIVU,NCVU)
  75. INTEGER IDEJVU(NIVU)
  76. ENDSEGMENT
  77. *
  78. LOGICAL L0,L1,lmodyn
  79. *
  80. MTRES = KTRES
  81. MPREF = KPREF
  82. MSAM = KSAM
  83. NPREF = IPOREF(/1)
  84. NVES = ICHRES(/1)
  85. NRES = XRES(/1)
  86. NCRES = XRES(/2)
  87. NPRES = XRES(/3)
  88. NREP = XREP(/1)
  89. NLSA = IPLRLA(/1)
  90. NLSB = IPLRLB(/1)
  91. NLIAB = XMREP(/1)
  92. NLIAA = ILPOLA(/1)
  93. NPLBB = JPLIBB(/1)
  94. NTVAR = ILIRNB(/2)
  95.  
  96. *
  97. *=========== CAS D'UNE BASE MODALE ===========
  98. *
  99. IF (ITBAS.NE.0.AND.ITKM.EQ.0) THEN
  100.  
  101. * --- syntaxe table PASAPAS ---
  102. IF(LMODYN) THEN
  103.  
  104. * maillage
  105. meleme = ipmail
  106. segact meleme
  107. if (lisous(/1).eq.0) then
  108. ipmmod = ipmail
  109. ipmsta = 0
  110. else
  111. ipmmod = lisous(1)
  112. ipmsta = lisous(2)
  113. endif
  114. *
  115. * production chpoint forces base A (devso2)
  116. NSOUPO = 1
  117. if(ipmmod.gt.0.and.ipmsta.gt.0) nsoupo = 2
  118. NAT=1
  119. SEGINI,MCHPOI
  120. IPCHPO = MCHPOI
  121. MTYPOI = 'FLIAISONS'
  122. IFOPOI = IFOUR
  123. * nature diffuse
  124. JATTRI(1) = 1
  125. nmost0 = 0
  126. KIPCHP = 0
  127. if (ipmmod.gt.0) then
  128. NC = 1
  129. SEGINI,MSOUPO
  130. KIPCHP = KIPCHP + 1
  131. IPCHP(KIPCHP) = MSOUPO
  132. NOCOMP(1) = 'ALFA'
  133. NOHARM(1) = NIFOUR
  134. IGEOC = ipmmod
  135. ipt1 = ipmmod
  136. segact ipt1
  137. N = ipt1.num(/2)
  138. nmost0 = N
  139. SEGINI,MPOVAL
  140. IPOVAL = MPOVAL
  141. endif
  142.  
  143. if (ipmsta.gt.0) then
  144. NC = 1
  145. SEGINI,MSOUPO
  146. KIPCHP = KIPCHP + 1
  147. IPCHP(KIPCHP) = MSOUPO
  148. NOCOMP(1) = 'BETA'
  149. NOHARM(1) = NIFOUR
  150. IGEOC = ipmsta
  151. ipt1 = ipmsta
  152. segact ipt1
  153. N = ipt1.num(/2)
  154. SEGINI,MPOVAL
  155. IPOVAL = MPOVAL
  156. endif
  157.  
  158. * --- syntaxe tables DYNE normales ---
  159. ELSE
  160. *
  161. * Cas de la base modale, on n'a qu'une composante: 'ALFA'
  162. IF (IIMPI.EQ.333) THEN
  163. WRITE(IOIMP,*)'DYNE17: cas de la base modale'
  164. ENDIF
  165. NSOUPO = 1
  166. NAT=1
  167. SEGINI,MCHPOI
  168. IPCHPO = MCHPOI
  169. MTYPOI = ' '
  170. IFOPOI = IFOUR
  171. * nature diffuse
  172. JATTRI(1) = 1
  173. NC = 1
  174. SEGINI,MSOUPO
  175. IPCHP(1) = MSOUPO
  176. NOCOMP(1) = 'ALFA'
  177. NOHARM(1) = NIFOUR
  178. NOCOMP(1) = 'ALFA'
  179. NOHARM(1) = NIFOUR
  180. IGEOC = IPMAIL
  181. N = NPREF
  182. SEGINI,MPOVAL
  183. IPOVAL = MPOVAL
  184.  
  185. ENDIF
  186.  
  187. *
  188. *=========== CAS DE MATRICES MODALES EN ENTREE ===========
  189. *
  190. ELSE IF (ITKM.NE.0) THEN
  191. *
  192. * On se refere au descripteur de la rigidite, mais attention:
  193. * les composantes peuvent differer d'une zone elementaire a
  194. * une autre.
  195. *
  196. CALL ACCTAB(ITKM,'MOT',I0,X0,'RAIDEUR',L0,IP0,
  197. & 'RIGIDITE',I1,X1,' ',L1,IRIGI)
  198. *
  199. * Creation du CHPOINT de reference:
  200. *
  201. IF (IIMPI.EQ.333) THEN
  202. WRITE(IOIMP,*)
  203. & 'DYNE17: creation selon un descripteur de rigidite'
  204. ENDIF
  205. MRIGID = IRIGI
  206. SEGACT,MRIGID
  207. NRIGI = IRIGEL(/2)
  208. IF (IIMPI.EQ.333) THEN
  209. WRITE(IOIMP,*)
  210. & 'DYNE17: nombre de rigidites elementaires ',NRIGI
  211. ENDIF
  212. NSOUPO = NRIGI
  213. NAT=1
  214. SEGINI,MCHPOI
  215. IPCHPO = MCHPOI
  216. MTYPOI = ' '
  217. * nature diffuse
  218. JATTRI(1) = 1
  219. IFOPOI = IFOUR
  220. c creation du segment de verif
  221. NIVU = NPREF
  222. SEGINI,MVU
  223. DO 30 I=1,NRIGI
  224. NYSONT = 0
  225. DESCR = IRIGEL(3,I)
  226. IPT1 = IRIGEL(1,I)
  227. SEGACT,DESCR,IPT1
  228. * NTOTC est le nombre total d'inconnues
  229. * NBNO est le nombre de noeuds par element
  230. * NBEL est le nombre d'elements dans la zone
  231. * NC est le nombre de composantes par noeud dans la zone
  232. NBNO = IPT1.NUM(/1)
  233. NBEL = IPT1.NUM(/2)
  234. NTOTC = LISINC(/2)
  235. NC = NTOTC / NBNO
  236. IF (IIMPI.EQ.333) THEN
  237. WRITE(IOIMP,*)'DYNE17: nombre total d''inconnues ',NTOTC
  238. WRITE(IOIMP,*)'DYNE17: nombre de noeuds par element ',NBNO
  239. WRITE(IOIMP,*)'DYNE17: nombre d''elements dans la zone ',NBEL
  240. WRITE(IOIMP,*)'DYNE17: nombre de composantes par noeud ',NC
  241. ENDIF
  242. SEGINI,MSOUPO
  243. IPCHP(I) = MSOUPO
  244. DO 40 IC=1,NC
  245. IF (LISINC(IC).NE.'ALFA'.and.LISINC(IC).NE.'BETA') THEN
  246. WRITE(IOIMP,*) 'DYNE: la raideur K de la table RAIDEUR_ET_MASSE',
  247. & ' ne peut avoir que ALFA ou BETA pour composante!'
  248. CALL ERREUR(483)
  249. RETURN
  250. ENDIF
  251. NOCOMP(IC) = LISINC(IC)
  252. NOHARM(IC) = NIFOUR
  253. 40 CONTINUE
  254. *
  255. * Combien de noeuds references dans cette zone ?
  256. *
  257. c BP : le chpoint repose necessairement sur des elements POI1
  258. NBSOUS=0
  259. NBREF =0
  260. NBNN =1
  261. NBELEM=NBNO*NBEL
  262. SEGINI,MELEME
  263. ITYPEL=1
  264. IGEOC = MELEME
  265. DO 50 IEL=1,NBEL
  266. DO 50 INO=1,NBNO
  267. c ce noeud appartient-il bien a la liste MPREF.IPOREF ?
  268. CALL PLACE2(IPOREF,NPREF,ILYEST,IPT1.NUM(INO,IEL))
  269. IF (ILYEST.EQ.0) GOTO 50
  270. c rem : si ILYEST = 0 , on a un pb --> erreur dans devtra
  271. c BP : ce noeud a t'il deja ete vu dans une autre zone?
  272. IF(IDEJVU(ILYEST).EQ.0) THEN
  273. c tout va bien on ajoute ce noeud pour ces composantes
  274. NYSONT = NYSONT + 1
  275. NUM(1,NYSONT) = IPT1.NUM(INO,IEL)
  276. IDEJVU(ILYEST)=NYSONT
  277. ELSE
  278. c noeud deja vu a l element NYSONT : on ne fait rien
  279. c on suppose qu'1 noeud => 1 inconnue
  280. ENDIF
  281. 50 CONTINUE
  282. IF(NYSONT.lt.NBELEM) THEN
  283. NBELEM=NYSONT
  284. SEGADJ,MELEME
  285. ENDIF
  286. IF (IIMPI.EQ.333) THEN
  287. WRITE(IOIMP,*)'DYNE17: nombre de noeuds dans la zone ',NYSONT
  288. ENDIF
  289. N = NYSONT
  290. SEGINI,MPOVAL
  291. IPOVAL = MPOVAL
  292. SEGDES,DESCR,IPT1,MELEME,MSOUPO
  293. 30 CONTINUE
  294. SEGDES,MRIGID
  295. SEGSUP,MVU
  296.  
  297. ENDIF
  298. *=========== FIN DES CAS BASE MODALE / MATRICES MODALES ===========
  299.  
  300. *
  301. * Variables demandees en sortie:
  302. c II = 0
  303. IIPO = 0
  304. c IILI = 0
  305. c boucle sur les variables (deplacement, vitesse ... )
  306. DO 60 ICR=1,8
  307. * - Duplication du CHPOINT pour les variables demandees
  308. * a tous les pas de sortie
  309. IF (ICHRES(ICR).EQ.1) THEN
  310. c II = II + 1
  311. IIPO=IIPO+1
  312. DO 70 IPAS=1,NPRES
  313. CALL COPIE5(IPCHPO,IPCHP1)
  314. IPORES(IIPO,IPAS) = IPCHP1
  315. 70 CONTINUE
  316. * - creation des LISTREEL pour les variables demandees
  317. * et tous les modes
  318. ELSEIF(ICHRES(ICR).EQ.2) THEN
  319. c II = II + 1
  320. c IILI=IILI+1
  321. c if (NCRES.gt.IPORES(/2)) then
  322. c write(ioimp,*) 'il faut plus de pas que de modes !'
  323. c call erreur(481)
  324. c return
  325. c endif
  326. c DO 71 IMODE=1,NCRES
  327. c JG=NPRES
  328. c segini,MLREEL
  329. c ILIRES(IILI,IMODE) = MLREEL
  330. c c rem : on range le MLREEL ici en supposant qu'il y a plus
  331. c c de pas que de modes
  332. cbp : on ne fait quasi-rien ici, on travaillera dans devso2
  333. 71 CONTINUE
  334. ENDIF
  335.  
  336. 60 CONTINUE
  337. *
  338. * Cas des CHPOINTs necessaires a la reprise du calcul:
  339. *
  340. DO 80 I = 1,NREP
  341. CALL COPIE5(IPCHPO,IPCHP1)
  342. IPOREP(I) = IPCHP1
  343. 80 CONTINUE
  344. *
  345. * Cas des POINTS necessaires a la reprise du calcul:
  346. *
  347. IDIM1 = IDIM + 1
  348. NPTS = XCOOR(/1) / IDIM1
  349. NBPTS = NPTS + 4 * NLIAB
  350. SEGADJ MCOORD
  351. DO 90 I = 1,NLIAB
  352. DO 90 II = 1,4
  353. NPTS = NPTS + 1
  354. IPPREP(I,II) = NPTS
  355. 90 CONTINUE
  356. *
  357. MCHPOI = IPCHPO
  358. SEGSUP,MCHPOI
  359. *
  360. * Creation des LISTREELs qui contiendront les resultats
  361. *
  362. JG = NPRES
  363. SEGINI,MLREEL
  364. IPOLR(1) = MLREEL
  365. *
  366. * liaisons en base A
  367. DO 100 IL = 1,NLSA
  368. NLR = ICHRES(10 + IL)
  369. DO 105 IN = 1,NLR
  370. JG = NPRES
  371. SEGINI,MLREEL
  372. IPLRLA(IL,IN) = MLREEL
  373. 105 CONTINUE
  374. 100 CONTINUE
  375.  
  376. * DO 110 IL = 1,NLSB
  377. * NLR = ICHRES(10 + NLSA + IL)
  378. * DO 115 IN = 1,NLR
  379. * JG = NPRES
  380. * SEGINI,MLREEL
  381. * IPLRLB(IL,IN) = MLREEL
  382. * 115 CONTINUE
  383. * end do
  384. * 110 CONTINUE
  385. * end do
  386. *
  387. * Creation des LISTENTIs et des LISTREELs pour sauvegarde
  388. * des liaisons en base A en vue d'une reprise
  389. *
  390. DO 200 I = 1,NLIAA
  391. * liaisons POLYNOMIALEs
  392. IF (ILPOLA(I,1).EQ.1) THEN
  393. JG = NPLAA * 2
  394. SEGINI,MLENTI
  395. ILPOLA(I,1) = MLENTI
  396. JG = NXPALA
  397. SEGINI,MLREEL
  398. ILPOLA(I,2) = MLREEL
  399. * liaisons COUPLAGE_DEPLACEMENT + CONVOLUTION
  400. ELSEIF(ILPOLA(I,1).EQ.2) THEN
  401. * on ne fait rien ici :
  402. * on branchera les listreels creees par dyne19 dans devso4
  403. ENDIF
  404. 200 CONTINUE
  405. *
  406. * liaisons en base B
  407. DO 300 IL=1,NLSB
  408. II=0
  409. DO 310 IV = 1,NTVAR
  410.  
  411. * -Creation de listreels
  412. IF (ILIREB(IL,IV).EQ.1) THEN
  413. II=II+1
  414. JG = NPRES
  415. SEGINI,MLREEL
  416. IPLRLB(IL,II) = MLREEL
  417.  
  418. * -Creation d'une table de chpoints
  419. ELSEIF (ILIREB(IL,IV).EQ.2) THEN
  420. M=NPRES
  421. SEGINI,MTABLE
  422. MLOTAB=M
  423. DO 320 IM=1,NPRES
  424. MTABTI(IM)='ENTIER'
  425. MTABTV(IM)='CHPOINT'
  426. MTABII(IM)=IM
  427. 320 CONTINUE
  428. SEGDES,MTABLE
  429. IPLRLB(IL,II+1)=MTABLE
  430. * Creation d un champoint
  431. NSOUPO=1
  432. SEGINI,MCHPOI
  433. IPCHPO = MCHPOI
  434. MOCHDE = 'Force_de_choc'
  435. * nature diffuse
  436. NC=2
  437. SEGINI,MSOUPO
  438. NOCOMP(1)='NORM'
  439. NOCOMP(2)='TANG'
  440. IPCHP(1)=MSOUPO
  441. N=NPLBB
  442. SEGINI,MPOVAL
  443. IPOVAL=MPOVAL
  444. NBELEM=NPLBB
  445. NBNN=1
  446. NBREF=0
  447. NBSOUS=0
  448. SEGINI,MELEME
  449. DO 330 IE=1,NPLBB
  450. NUM(1,IE)=JPLIBB(IE)
  451. 330 CONTINUE
  452. IGEOC=MELEME
  453. JG=NPRES
  454. SEGINI,MLENTI
  455. DO 340 I = 1,NPRES
  456. CALL COPIE5(IPCHPO,IPCHP1)
  457. LECT(I) = IPCHP1
  458. 340 CONTINUE
  459. SEGDES,MLENTI
  460. IPLRLB(IL,II+2)=MLENTI
  461. MCHPOI=IPCHPO
  462. SEGSUP,MCHPOI
  463. II=II+NPLBB*2
  464. ENDIF
  465.  
  466. 310 CONTINUE
  467. 300 CONTINUE
  468. *
  469. END
  470.  
  471.  
  472.  
  473.  
  474.  
  475.  
  476.  
  477.  
  478.  
  479.  
  480.  
  481.  
  482.  
  483.  
  484.  
  485.  
  486.  

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