Télécharger dyne17.eso

Retour à la liste

Numérotation des lignes :

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

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