Télécharger asns1.eso

Retour à la liste

Numérotation des lignes :

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

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