Télécharger dyne17.eso

Retour à la liste

Numérotation des lignes :

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

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