Télécharger asns1.eso

Retour à la liste

Numérotation des lignes :

  1. C ASNS1 SOURCE PV 17/06/16 14:33:36 9460
  2. SUBROUTINE ASNS1 ( IPOIRI,MMATRX,INUINY,ITOPOY,IMINIY,IPOY,
  3. & INCTRY,INCTRZ,IITOPY,ITOPOD,IITOPD,IPODD)
  4.  
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C CE SUBROUTINE SERT A L'ASSEMBLAGE DE MATRICES SYMETRIQUES
  7. C EN VUE D'UNE INVERSION PAR UNE METHODE DE CROUT
  8. C
  9. C EN ENTREE:
  10. C **** IPOIRI: POINTEUR SUR OBJET MRIGIDITE,NON MODIFIE
  11. C EN SORTIE:
  12. C **** INUINV IMINI ITOPO IPOY INCTRY SONT DES POINTEURS DES SEGMENTS
  13. C DE TRAVAIL SERVANT A L'ASSEMBLAGE ILS SONT DETRUITS EN FIN
  14. C D'ASSEMBLAGE OU DE TRIANGULARISATION
  15. C **** MMATRI EST LE POINTEUR DE L'OBJET FUTUR MATRICE TRIANGULARISEE.
  16. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  17.  
  18. IMPLICIT INTEGER(I-N)
  19. -INC CCOPTIO
  20. -INC SMELEME
  21. -INC SMCOORD
  22.  
  23. SEGMENT,IMIN(NNOE)
  24. SEGMENT,IMINB(NNOE)
  25. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  26. C
  27. -INC SMRIGID
  28. -INC SMMATRI
  29. C
  30. SEGMENT,INUINV(NNGLOB)
  31. SEGMENT,ITOPO(IENNO)
  32. SEGMENT,IITOP(NNOE+1)
  33. SEGMENT,ITOPOB(IENNO)
  34. SEGMENT,IITOPB(NNOE+1)
  35. SEGMENT,IMINI(INC)
  36. SEGMENT,IPOS(NNOE1)
  37. SEGMENT,IPOD(NNOE1)
  38. SEGMENT,INCTRR(NIRI)
  39. SEGMENT,INCTRD(NIRI)
  40. SEGMENT,INCTRA(NLIGRE)
  41. segment mondu
  42. character*4 mondua(nnn)
  43. integer ipris(nnn),inosel(nnn)
  44. endsegment
  45.  
  46. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  47. C **** CES TABLEAUX SERVENT AU REPERAGE DE LA MATRICE POUR L'ASSEMBLAG
  48. C **** IL SERONT TOUS SUPPRIMES EN FIN D'ASSEMBLAGE.
  49. C
  50. C
  51. C **** MAXINC= MAXIMUM DE COMPOSANTES CONCERNANT UN NOEUD
  52. C
  53. C
  54. C **** IITOP(K)=I LE 1ER ELEMENT TOUCHANT LE NOEUD K SE TROUVE EN
  55. C IEME POSITION DANS ITOPO
  56. C **** ITOPO(I)=L: LE 1ER ELEMENT TOUCHANT LE K EME NOEUD DE LA
  57. C ITOPO(I+1)=M MATRICE EST LE LIEME DE L'OBJET GEOMETRIE
  58. C DEFINI PAR LE POINTEUR M
  59. C **** IPOS(I)=J : LA 1 ERE INCONNUE DU NOEUD I EST EN J+1 EME
  60. C POSITION
  61. C **** IMINI(I)=J LA PLUS PETITE INCONNUE QUI EST RELIEE A LA IEME
  62. C EST L'INCONNUE J.
  63. C **** INUINV(I)=J J EST LE NOUVEAU NUMERO DU NOEUD I
  64. C
  65. C **** INCTRR(NIRI) - NIRI=NRIGEL du IPOIRI (objet MRIGID passé en argument)
  66. C pointeurs sur INCTRA
  67. C
  68. C Variables locales :
  69. C --------------------
  70. C * NNVA = NRIGEL (nombre d'objets MRIGID élémentaires) dans IPOIRI (objet
  71. C MRIGID) passé en argument)
  72. C * NLIGRE = NLIGRP - nombre de variables primales (dans un segment DESCR)
  73. C * IMELP = pointeur d'un MELEME contenant un noeud "normal"
  74. C * ICDOUR = ???
  75. C
  76. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  77.  
  78. CHARACTER*4 CNOHA,lisi
  79. integer*4 noha
  80. equivalence (cnoha,noha)
  81. DATA CNOHA/'NOHA'/
  82. DATA IPOIN/1/
  83.  
  84. NNGLOB=XCOOR(/1)/(IDIM+1)
  85.  
  86. MRIGID=IPOIRI
  87. SEGACT,MRIGID
  88.  
  89. NNVA=IRIGEL(/2)
  90. NIRI=NNVA
  91. SEGINI,INCTRR
  92. SEGINI,INCTRD
  93.  
  94. MELEME=IRIGEL(1,1)
  95. SEGACT MELEME
  96. C ... ITYPEL = 27 correspond aux éléments 'ATTA' ...
  97. IF(ITYPEL.NE.27) GO TO 801
  98. SEGDES MELEME
  99. C
  100. C **** ASSEMBLAGE DANS LE CAS DE L'ANALYSE MODALE. ON COMPTE LES POINTS
  101. C **** DANS ICPR
  102. C
  103. SEGINI INUINV,ICPR
  104. IKI=0
  105. DO 700 I=1,NNVA
  106. MELEME=IRIGEL(1,I)
  107. SEGACT MELEME
  108. NBNN=NUM(/1)
  109. NBELEM=NUM(/2)
  110. DO 701 I1=1,NBELEM
  111. DO 701 I2=1,NBNN
  112. IP1=NUM(I2,I1)
  113. IF(ICPR(IP1).NE.0) GO TO 701
  114. IKI=IKI+1
  115. ICPR(IP1)=IKI
  116. 701 CONTINUE
  117. SEGDES MELEME
  118. 700 CONTINUE
  119. C
  120. C **** FABRICATION DU TABLEAU INUINV
  121. C **** ON MET LES POINTS QUI ONT POUR INCONNUE ALFA EN TETE
  122. C
  123. NNOE=IKI
  124. NBETA=0
  125. DO 710 I=1,NNVA
  126. MELEME=IRIGEL(1,I)
  127. DESCR =IRIGEL(3,I)
  128. SEGACT MELEME,DESCR
  129. NBNN=NUM(/1)
  130. NBELEM=NUM(/2)
  131. NLIGRE=LISINC(/2)
  132. DO 711 I1=1,NBELEM
  133. DO 711 I2=1,NBNN
  134. IP1=NUM(I2,I1)
  135. IF(ICPR(IP1).EQ.0) GO TO 711
  136. 715 CONTINUE
  137. NBETA=NBETA+1
  138. IKI=NNOE-NBETA+1
  139. 716 CONTINUE
  140. INUINV(IP1)=IKI
  141. ICPR(IP1)=0
  142. 711 CONTINUE
  143. SEGDES MELEME,DESCR
  144. * SEGSUP IPB
  145. 710 CONTINUE
  146. SEGSUP ICPR
  147. ICDOUR=NNOE
  148. GO TO 800
  149. C
  150. C **** ON FABRIQUE UN NOUVEL OBJET GEOMETRIE CONTENANT TOUTES LES
  151. C **** GEOMETRIES ELEMENTAIRES. CET OBJET CONTIENT NNVA OBJETS
  152. C **** GEOMETRIQUES ELEMENTAIRES. PUIS ON ENVOIE DANS NUMOPT QUI
  153. C **** FOURNIT EN RETOUR INUINV(NUM(I,J))=K DONNE LE NOUVEAU
  154. C **** NUMERO LOCAL DU POINT NUM(I,J).K VARIE DE 1 A ICDOUR.
  155. C **** LE PREMIER NOEUD DE L'OBJET GEOMETRIQUE EST LE PREMIER NOEUD
  156. C **** DE LA MATRICE, ETC...
  157. C
  158. 801 CONTINUE
  159. IKK=1
  160. 722 CONTINUE
  161. MELEME=IRIGEL(1,IKK)
  162. SEGACT,MELEME
  163.  
  164. DESCR=IRIGEL(3,IKK)
  165. SEGACT,DESCR
  166.  
  167. NLIGRE=LISINC(/2)
  168. DO 720 K=1,NLIGRE
  169. IF(LISINC(K).NE.'LX ') GO TO 721
  170. 720 CONTINUE
  171. SEGDES,MELEME
  172. SEGDES,DESCR
  173. IKK=IKK+1
  174. IF(IKK.LE.NNVA) GO TO 722
  175. DO 4862 I=1,NNVA
  176. MELEME= IRIGEL(1,I)
  177. SEGACT MELEME
  178. IF(ITYPEL.EQ.22) THEN
  179. DESCR=IRIGEL(3,I )
  180. SEGACT,DESCR
  181. K = 3
  182. GO TO 721
  183. ELSE
  184. SEGDES MELEME
  185. ENDIF
  186. 4862 CONTINUE
  187. K=1
  188. MELEME= IRIGEL(1,1)
  189. DESCR= IRIGEL(3,1)
  190. SEGACT MELEME,DESCR
  191.  
  192. C ... On arrive ici si :
  193. C * LISINC(K) != 'LX ' => K est le premier parmi K tels que LISINC(K) != 'LX '
  194. C * ITYPEL d'un des maillages = 22 (élément 'MULT') => K = 3
  195. C * tous les autres cas => K = 1
  196.  
  197. C ... IA = numéro (dans l'élément) du noeud concerné par le DDL No K ...
  198. C ... I1 = numéro (absolu) du noeud concerné par le DDL No K,
  199. C Ce noeud sera mis dans un MELEME dont le pointeur est stocké dans IMELP ...
  200.  
  201. 721 IA=NOELEP(K)
  202. I1=NUM(IA,1)
  203. SEGDES,MELEME,DESCR
  204.  
  205. NBSOUS=0
  206. NBNN=1
  207. NBREF=0
  208. NBELEM=1
  209. SEGINI,MELEME
  210. ITYPEL=1
  211. NUM(1,1)=I1
  212. SEGDES,MELEME
  213. IMELP=MELEME
  214.  
  215. C ... Le MELEME créé ici est un MELEME composé qui contiendra le MELEME
  216. C pointé par IMELP et tous les MELEME pointés par IRIGEL(1,*) ...
  217. NBSOUS=NNVA+1
  218. NBREF=0
  219. NBNN=0
  220. NBELEM=0
  221. SEGINI,MELEME
  222. LISOUS(1)=IMELP
  223. DO 12 I=1,NNVA
  224. LISOUS(I+1)=IRIGEL(1,I)
  225. 12 CONTINUE
  226. SEGDES,MELEME
  227.  
  228. ICDOUR=0
  229. SEGINI,INUINV
  230. SEGDES,INUINV
  231. CALL NUMOPT(MELEME,INUINV,ICDOUR)
  232. C ... A la sortie INUINV contient l'ordre des noeuds et ICDOUR le nombre de noeuds présents dans MELEME ...
  233. SEGACT INUINV
  234. SEGSUP,MELEME
  235. MELEME=IMELP
  236. SEGDES,MELEME
  237. C
  238. C **** CREATION D'UN OBJET GEOMETRIE QU'IL FAUDRA CHANGER EN CAS DE
  239. C **** RENUMEROTATION GENERALE.ON PROFITE DE LA BOUCLE POUR CREE LE
  240. C **** TABLEAU IMIN(I)=J QUI DIT QUE J ELEMENTS TOUCHE LE NOEUD I(NU-
  241. C **** MEROTATION LOCALE).
  242. C
  243. 800 CONTINUE
  244. NNOE=ICDOUR
  245. SEGINI,IMIN,IMINB
  246. NNOE1=NNOE+1
  247. SEGINI,IPOS,IPOD
  248. NBSOUS=0
  249. NBREF=0
  250. NBNN=1
  251. NBELEM=ICDOUR
  252. SEGINI,IPT1
  253. IPT1.ITYPEL=IPOIN
  254. DO 16 IRI=1,NNVA
  255. DO 170 I=1,NNOE
  256. ipod(I)=0
  257. 170 IPOS(I)=0
  258. MELEME=IRIGEL(1,IRI)
  259. SEGACT,MELEME
  260. DESCR=IRIGEL(3,IRI)
  261. segact descr
  262. N1=NUM(/1)
  263. N2=NUM(/2)
  264. * write(6,*) 'noelep', ( noelep(iu),iu=1,noelep(/1))
  265. * write(6,*) 'noeled', ( noeled(iu),iu=1,noeled(/1))
  266. DO 17 I=1,N2
  267. DO 171 J=1,NOELEP(/1)
  268. K = NUM( NOELEP(J),I)
  269. M=INUINV(K)
  270. IF(IPOS(M).NE.I) THEN
  271. IMIN(M)=IMIN(M)+1
  272. IPT1.NUM(1,M)=K
  273. IPOS(M)=I
  274. ENDIF
  275. 171 CONTINUE
  276. DO 172 J=1,NOELED(/1)
  277. K = NUM( NOELED(J),I)
  278. M=INUINV(K)
  279. IF(IPOD(M).NE.I) THEN
  280. IMINB(M)=IMINB(M)+1
  281. IPOD(M)=I
  282. ENDIF
  283. 172 CONTINUE
  284. 17 CONTINUE
  285. SEGDES,MELEME
  286. 16 CONTINUE
  287. C
  288. C **** INITIALISATION DE ITOPO. ON UTILISE IMIN POUR SE POSITIONNER
  289. C **** DANS ITOPO .
  290. C ... ITOPO contiendra pour chaque noeud et chaque élément contenant
  291. C ce noeud 2 nombres :
  292. C 1. numéro de l'élément dans son maillage
  293. C 2. numéro du maillage (dans IRIGEL) de cet élément
  294. C
  295. C ... IITOP servira pour déterminer la taille de ITOPO ainsi que pour
  296. C se retrouver dedans ...
  297. C
  298. SEGINI,IITOP,IITOPB
  299. IITOP(1)=1
  300. IITOPB(1)=1
  301. * write(6,*) ' imin', ( imin(iu),iu=1,imin(/1))
  302. * write(6,*) ' iminb', ( iminb(iu),iu=1,iminb(/1))
  303. DO 18 I=1,NNOE
  304. IITOP(I+1)=IMIN(I)* 2 + IITOP(I)
  305. IITOPB(I+1)=IMINB(I)* 2 + IITOPB(I)
  306. 18 CONTINUE
  307. DO 19 I=1,NNOE
  308. IMINB(I)=0
  309. 19 IMIN(I)=0
  310. C ... IENNO = taille d'ITOPO ...
  311. IENNO=IITOP(NNOE+1)
  312. SEGINI,ITOPO
  313. IENNO=IITOPB(NNOE+1)
  314. SEGINI ITOPOB
  315. DO 21 IRI=1,NNVA
  316. DO 220 I=1,NNOE
  317. IPOD(I)=0
  318. 220 IPOS(I)=0
  319. MELEME=IRIGEL(1,IRI)
  320. SEGACT,MELEME
  321. DESCR = IRIGEL(3,IRI)
  322. N2=NUM(/2)
  323. DO 22 I=1,N2
  324. DO 221 J=1,NOELEP(/1)
  325. M=INUINV(NUM(NOELEP(J),I))
  326. IF(IPOS(M).NE.I) THEN
  327. IMIN(M)=IMIN(M)+1
  328. IUY= 2* ( IMIN(M)-1 ) + IITOP(M)
  329. C ... Remplissage d'ITOPO ...
  330. ITOPO(IUY)=I
  331. ITOPO(IUY+1)=IRI
  332. IPOS(M)=I
  333. ENDIF
  334. 221 CONTINUE
  335. DO 222 J=1,NOELED(/1)
  336. M=INUINV(NUM(NOELED(J),I))
  337. IF(IPOD(M).NE.I) THEN
  338. IMINB(M)=IMINB(M)+1
  339. IUY= 2* ( IMINB(M)-1 ) + IITOPB(M)
  340. C ... Remplissage d'ITOPO ...
  341. ITOPOB(IUY)=I
  342. ITOPOB(IUY+1)=IRI
  343. IPOD(M)=I
  344. ENDIF
  345. 222 CONTINUE
  346. 22 CONTINUE
  347. SEGDES,MELEME
  348. 21 CONTINUE
  349. C
  350. C RECHERCHE DE LA VALEUR PAR DEFAUT DE L'HARMONIQUE DANS LE CAS
  351. C DE L'UTILISATION DE " OPTION MODE FOUR NOHAR "
  352. C
  353. C ... On passe cette boucle sans erreur si tous les IRIGEL(5,*) sont égaux
  354. C soit à NOHA soit à une autre valeur fixe (IARDEF) ...
  355. C
  356. DO 230 IRI=1,NNVA
  357. IHARIR=IRIGEL(5,IRI)
  358. IF( IHARIR . NE. NOHA) THEN
  359. IARDEF = IHARIR
  360. GO TO 231
  361. ENDIF
  362. 230 CONTINUE
  363. CALL ERREUR ( 21)
  364. RETURN
  365.  
  366. 231 CONTINUE
  367. DO 232 IRI=1,NNVA
  368. IF( IRIGEL(5,IRI) .EQ.NOHA) GO TO 232
  369. IF( IRIGEL(5,IRI).EQ.IARDEF ) GO TO 232
  370. CALL ERREUR (21)
  371. RETURN
  372. 232 CONTINUE
  373. C
  374. C **** RECHERCHE DE LA VALEUR MAXINC QUI PERMET DE DIMENSIONNER INCPOS
  375. C
  376. C ... Les quatre segments sont à l'origine de longueur nulle ...
  377. SEGINI,MIDUA
  378. SEGINI,MIMIK
  379. SEGINI,MHARK
  380. SEGINI,MHAR1
  381.  
  382. DESCR=IRIGEL(3,1)
  383. SEGACT,DESCR
  384.  
  385. IMIK(**)=LISINC(1)
  386. IAAR=IRIGEL(5,1)
  387. IF(IAAR.EQ.NOHA) IAAR = IARDEF
  388. IHAR(**)= IAAR
  389. IDUA(**)=LISDUA(1)
  390. MHAR1.IHAR(**)= IAAR
  391.  
  392. MAXINC=1
  393. DO 23 IRI=1,NNVA
  394. DESCR=IRIGEL(3,IRI)
  395. IHARIR=IRIGEL(5,IRI)
  396. IF(IHARIR. EQ.NOHA ) IHARIR = IARDEF
  397. SEGACT,DESCR
  398. NLIGRE=LISINC(/2)
  399. DO 26 I=1,NLIGRE
  400. DO 24 J=1,MAXINC
  401. IF(IMIK(J).NE.LISINC(I)) GO TO 24
  402. IF(IHAR(J).EQ.IHARIR) GO TO 26
  403. 24 CONTINUE
  404. C ... On empile les valeurs d'IHARIR et LISINC dans
  405. C leurs segments si le couple (IHARIR,LISINC) n'y est pas
  406. C encore représenté ...
  407. MAXINC=MAXINC+1
  408. IHAR(**)=IHARIR
  409. IMIK(**)=LISINC(I)
  410. 26 CONTINUE
  411. 23 CONTINUE
  412.  
  413. MAXDUA=1
  414. DO 2322 IRI=1,NNVA
  415. DESCR=IRIGEL(3,IRI)
  416. IHARIR=IRIGEL(5,IRI)
  417. IF(IHARIR. EQ.NOHA ) IHARIR = IARDEF
  418. SEGACT,DESCR
  419. NLIGRE=LISDUA(/2)
  420. DO 262 I=1,NLIGRE
  421. DO 242 J=1,MAXDUA
  422. IF(IDUA(J).NE.LISDUA(I)) GO TO 242
  423. IF(MHAR1.IHAR(J).EQ.IHARIR) GO TO 262
  424. 242 CONTINUE
  425. C ... On empile les valeurs d'IHARIR et LISDUA dans
  426. C leurs segments si le couple (IHARIR,LISDUA) n'y est pas
  427. C encore représenté ...
  428. MAXDUA=MAXDUA+1
  429. MHAR1.IHAR(**)=IHARIR
  430. IDUA(**)=LISDUA(I)
  431. 262 CONTINUE
  432. SEGDES,DESCR
  433. 2322 CONTINUE
  434. * write(6,*) ' imik'
  435. * write(6,*) ( imik(iu),iu=1,imik(/2))
  436. * write(6,*) ' idua avant'
  437. * write(6,*) ( idua(iu),iu=1,idua(/2))
  438. nnn = idua(/2)
  439. nqq = imik(/2)
  440. if(nnn.ne.nqq) then
  441. * on verra plus tard
  442. call erreur(5)
  443. stop
  444. endif
  445. * petit travail pour mettre dans le meme ordre les inconnues
  446. segini mondu
  447. do 476 iu=1,imik(/2)
  448. lisi=imik(iu)
  449. do 477 io=1,idua(/2)
  450. if( idua(io).eq.lisi) go to 478
  451. 477 continue
  452. inosel(iu)=1
  453. go to 476
  454. 478 mondua(iu)= idua(io)
  455. ipris(io)=1
  456. 476 continue
  457. do 472 iu=1,inosel(/1)
  458. if( inosel(iu).eq.0) go to 472
  459. do 473 io=1,ipris(/1)
  460. if( ipris(io).eq.1) go to 473
  461. ipris(io)=1
  462. mondua(iu)=idua(io)
  463. go to 472
  464. 473 continue
  465. 472 continue
  466. do 479 iu=1,idua(/2)
  467. idua(iu)=mondua(iu)
  468. 479 continue
  469. segsup mondu
  470. * write(6,*) ' idua apres'
  471. * write(6,*) ( idua(iu),iu=1,idua(/2))
  472. C
  473. C **** INITIALISATION DE INCPOS ET DE INCTRA.
  474. C
  475. C ... Les dimensions des segments MINCPO initialisés ci-dessous sont les
  476. C suivantes : MAXI = nombre de différentes variables primales (ou duales)
  477. C NNOE = nombre de noeuds effectivement présents
  478. MAXI=MAXINC
  479. SEGINI,MINCPO
  480.  
  481. MAXI=MAXDUA
  482. SEGINI,MIPO1
  483.  
  484. DO 29 IRI=1,NNVA
  485. IHARIR=IRIGEL(5,1)
  486. IF(IHARIR.EQ.NOHA ) IHARIR = IARDEF
  487.  
  488. DESCR=IRIGEL(3,IRI)
  489. SEGACT,DESCR
  490.  
  491. NLIGRE=LISINC(/2)
  492. SEGINI,INCTRA
  493. INCTRR(IRI)=INCTRA
  494.  
  495. MELEME=IRIGEL(1,IRI)
  496. SEGACT,MELEME
  497. N2=NUM(/2)
  498.  
  499. DO 34 J=1,NLIGRE
  500. DO 33 K=1,MAXINC
  501. IF(LISINC(J).NE.IMIK(K)) GO TO 33
  502. IF(IHAR(K).EQ.IHARIR) GO TO 32
  503. 33 CONTINUE
  504. 32 CONTINUE
  505. C ... K est tel que LISINC(J)=IMIK(K) et IHARIR=IHAR(K),
  506. C on le met dans INCTRA(J) (J numérote les variables) correspondant ...
  507. INCTRA(J)=K
  508. C ... Dans la boucle ci-dessous on met à 1 les INCPO correspondants à la
  509. C variable K pour les noeuds des éléments du maillage ...
  510. DO 31 I=1,N2
  511. IJ=INUINV(NUM(NOELEP(J),I))
  512. 31 INCPO(K,IJ)=1
  513. 34 CONTINUE
  514.  
  515. SEGDES,INCTRA
  516.  
  517. NLIGRE=LISDUA(/2)
  518. SEGINI,INCTRA
  519. INCTRD(IRI)=INCTRA
  520.  
  521. DO 342 J=1,NLIGRE
  522. DO 332 K=1,MAXDUA
  523. IF(LISDUA(J).NE.IDUA(K)) GO TO 332
  524. IF(MHAR1.IHAR(K).EQ.IHARIR) GO TO 322
  525. 332 CONTINUE
  526. 322 CONTINUE
  527. C ... K est tel que LISDUA(J)=IDUA(K) et IHARIR=IHAR(K),
  528. C on le met dans INCTRA(J) (J numérote les variables) correspondant ...
  529. INCTRA(J)=K
  530. C ... Dans la boucle ci-dessous on met à 1 les INCPO correspondants à la
  531. C variable K pour les noeuds des éléments du maillage ...
  532. DO 312 I=1,N2
  533. IJ=INUINV(NUM(NOELED(J),I))
  534. 312 MIPO1.INCPO(K,IJ)=1
  535. 342 CONTINUE
  536.  
  537. SEGDES,DESCR
  538. SEGDES,INCTRA
  539. SEGDES,MELEME
  540. 29 CONTINUE
  541. C
  542. C **** INITIALISATION DE IPOS
  543. C
  544. C ... IPOS(I+1)-IPOS(I) = nombre de colonnes liées au noeud I ...
  545. C ... IPOS(I)+1 = numéro de la première colonne concernant le noeud I ...
  546. IPOS(1)=0
  547. C ... NA = nombre de 1 dans INCPO => nombre de colonnes de la matrice ...
  548. NA=0
  549. DO 37 I=1,NNOE
  550. DO 35 K=1,MAXINC
  551. IF(INCPO(K,I).NE.0) THEN
  552. NA=NA+1
  553. C ... INCPO(K,I) = numéro de l'équation ...
  554. INCPO(K,I)=NA
  555. ENDIF
  556. 35 CONTINUE
  557. IPOS(I+1)=NA
  558. 37 CONTINUE
  559. IPOD(1)=0
  560. C ... ND = nombre de 1 dans MIPO1.INCPO => nombre de lignes de la matrice ...
  561. ND=0
  562. DO 372 I=1,NNOE
  563. DO 352 K=1,MAXDUA
  564. IF(MIPO1.INCPO(K,I).NE.0) THEN
  565. ND=ND+1
  566. C ... MIPO1.INCPO(K,I) = numéro de l'équation ...
  567. MIPO1.INCPO(K,I)=ND
  568. ENDIF
  569. 352 CONTINUE
  570. IPOD(I+1)=ND
  571. 372 CONTINUE
  572. * write(*,*) 'Nb de colonnes de la matrice : ',NA,maxinc
  573. * write(*,*) 'Nb de lignes de la matrice : ',ND,maxdua
  574.  
  575.  
  576. SEGDES,MIDUA,MIMIK,MHARK,MHAR1
  577.  
  578. C ... On va tester que tout est OK pour la suite ...
  579.  
  580. IF(NA.NE.ND) THEN
  581. * write(6,*) ' ipos'
  582. * write(6,*) ( ipos(IU),IU=1,ipos(/1))
  583. * write(6,*) ' ipod '
  584. * write(6,*) ( ipod(IU),IU=1,ipod(/1))
  585. CALL ERREUR(756)
  586. RETURN
  587. ENDIF
  588.  
  589. DO 567 IINO=1,NNOE1
  590. IF(IPOS(IINO).NE.IPOD(IINO)) THEN
  591. WRITE(*,*) 'ERREUR dans ASNS1 !!! IPOS != IPOD !!!'
  592. RETURN
  593. ENDIF
  594. 567 CONTINUE
  595. C
  596. C **** INITIALISATION DE IMINI a été supprimée car ce segment
  597. C ne servait à rien ...
  598. * write(6,*) ' ipos', ( ipos(iu),iu=1,ipos(/1))
  599. * write(6,*) ' ipod', ( ipod(iu),iu=1,ipod(/1))
  600. * write(6,*) ' itopo', ( itopo(iu),iu=1,itopo(/1))
  601. * write(6,*) ' itopob', ( itopob(iu),iu=1,itopob(/1))
  602. * write(6,*) ' iitop', ( iitop(iu),iu=1,iitop(/1))
  603. * write(6,*) ' iitopb', ( iitopb(iu),iu=1,iitopb(/1))
  604. SEGDES,MRIGID
  605. SEGDES,IPOS,IPOD
  606. SEGDES,ITOPO,ITOPOB
  607. SEGDES,IITOP,IITOPB
  608. SEGDES,INUINV
  609. SEGDES,IPT1
  610. SEGDES,MINCPO
  611. SEGDES,MIPO1
  612. SEGSUP,IMIN,IMINB
  613. SEGDES,INCTRR
  614. INCTRY=INCTRR
  615. SEGDES,INCTRD
  616. INCTRZ=INCTRD
  617. SEGINI,MMATRI
  618. NENS=0
  619. IGEOMA=IPT1
  620. IIDUA=MIDUA
  621. IINCPO=MINCPO
  622. IDUAPO=MIPO1
  623. IIMIK=MIMIK
  624. IHARK=MHARK
  625. IHARDU=MHAR1
  626. INUINY=INUINV
  627. ITOPOY=ITOPO
  628. ITOPOD=ITOPOB
  629. IITOPD=IITOPB
  630. IITOPY=IITOP
  631. MMATRX=MMATRI
  632. ccc IMINIY=IMINI
  633. iminiy=0
  634. IPOY=IPOS
  635. IPODD=IPOD
  636. SEGDES,MMATRI
  637. RETURN
  638. END
  639.  
  640.  
  641.  
  642.  
  643.  
  644.  
  645.  
  646.  
  647.  
  648.  
  649.  
  650.  
  651.  
  652.  
  653.  
  654.  
  655.  
  656.  

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