Télécharger assem4.eso

Retour à la liste

Numérotation des lignes :

  1. C ASSEM4 SOURCE PV 17/06/16 14:33:41 9460
  2. SUBROUTINE ASSEM4(IPOIRI,NOINC,SNOMIN,NOMAI,MMATRX,
  3. # INUINY,ITOPOY,INCTRY,IITOPY,NBNNMA,NLIGRA,SNTT,SNTO,DES1)
  4.  
  5. ** CETTE SUBROUTINE EFFECTUE LA PREPARATION A L'ASSEMBLAGE DANS LE CAS DU CALCUL DU
  6. ** SUPER-ELEMENT
  7.  
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8(A-H,O-Z)
  10. CHARACTER*4 CMOT
  11.  
  12. -INC CCOPTIO
  13. -INC SMELEME
  14. -INC SMCOORD
  15. -INC SMRIGID
  16. -INC SMMATRI
  17. SEGMENT,IMIN(NNOE)
  18. SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
  19. SEGMENT,INUINV(NNGLOB)
  20. SEGMENT,INUIN2(2*NNGLOB)
  21. SEGMENT,ITOPO(IENNO)
  22. SEGMENT,IITOP(NNOE+1)
  23. SEGMENT,INCTRR(NIRI)
  24. SEGMENT,INCTRA(NLIGRE)
  25. C
  26. C **** CES TABLEAUX SERVENT AU REPERAGE DE LA MATRICE POUR L'ASSEMBLAG
  27. C **** IL SERONT TOUS SUPPRIMES EN FIN D'ASSEMBLAGE.
  28. C
  29. C
  30. C **** MAXINC= MAXIMUM DE COMPOSANTES CONCERNANT UN NOEUD
  31. C
  32. C **** IITOP(K)=I LE 1ER ELEMENT TOUCHANT LE NOEUD K SE TROUVE EN
  33. C IEME POSITION DANS ITOPO
  34. C **** ITOPO(I)=L: LE 1ER ELEMENT TOUCHANT LE K EME NOEUD DE LA
  35. C ITOPO(I+1)=M MATRICE EST LE LIEME DE L'OBJET GEOMETRIE
  36. C DEFINI PAR LE POINTEUR M
  37. C **** INUINV(I)=J J EST LE NOUVEAU NUMERO DU NOEUD I
  38. C
  39.  
  40. ** SEGMENTS DE TRAVAIL
  41.  
  42. SEGMENT NOMAI(XCOOR(/1)/(IDIM+1))
  43. SEGMENT NOINC(NNIN,ITA)
  44. SEGMENT SNOMIN
  45. CHARACTER*4 NOMIN(M)
  46. ENDSEGMENT
  47. SEGMENT SNTO
  48. INTEGER NTOTMA(NN)
  49. ENDSEGMENT
  50. C
  51. SEGMENT SNTT
  52. INTEGER NTTMAI(NN)
  53. ENDSEGMENT
  54. C
  55. SEGMENT ILOCAL(NBNUM)
  56. C
  57. ** NOMAI(I)<>0 SI LE NOEUD I EST MAITRE (I=N° ABSOLU)
  58. C
  59. ** NOINC(I,J)=1 SI L'INCONNUE I EXISTE POUR LE NOEUD J (J=N° LOCAL)
  60. C
  61. ** NOMIN(I)= INCO : L'INCONNUE N°I EST L'INCONNUE DE NOM 'INCO'
  62. ** CE SEGMENT NE CONTIENT QUE LES INCONNUES MAITRESSES
  63. ** NTOTMA : SEGMENT DES NOEUDS MAITRES POUR LESQUELS TOUTES LES INCONNUES
  64. ** SONT MAITRESSES
  65. ** NTTMAI : SEGMENT DES NOEUDS MAITRES QUI N'ONT PAS TOUTES LEURS INCONNUES
  66. ** MAITRESSES
  67. ** ILOCAL : SEGMENT DES NUMEROS LOCAUX
  68.  
  69.  
  70. * DATA MOALFA/'ALFA'/
  71. CHARACTER*4 CNOHA
  72. integer*4 noha
  73. equivalence (cnoha,noha)
  74. DATA CNOHA/'NOHA'/
  75. DATA IPOIN/1/
  76.  
  77. NNGLOB=XCOOR(/1)/(IDIM+1)
  78.  
  79. MRIGID=IPOIRI
  80. SEGACT,MRIGID
  81.  
  82. NNVA=IRIGEL(/2)
  83. NIRI=NNVA
  84. SEGINI,INCTRR
  85. MVA=IRIGEL(/1)
  86. MELEME=IRIGEL(1,1)
  87. SEGACT,MELEME
  88. IF(ITYPEL.NE.27) GO TO 801
  89. SEGDES MELEME
  90. C
  91. C **** ASSEMBLAGE DANS LE CAS DE L'ANALYSE MODALE. ON COMPTE LES POINTS
  92. C **** DANS ICPR
  93. C
  94. SEGINI,INUINV,ICPR
  95. IKI=0
  96. DO 700 I=1,NNVA
  97. MELEME=IRIGEL(1,I)
  98. SEGACT,MELEME
  99. NBNN=NUM(/1)
  100. NBELEM=NUM(/2)
  101. DO 701 I1=1,NBELEM
  102. DO 701 I2=1,NBNN
  103. IP1=NUM(I2,I1)
  104. IF(ICPR(IP1).NE.0) GO TO 701
  105. IKI=IKI+1
  106. ICPR(IP1)=IKI
  107. 701 CONTINUE
  108. SEGDES MELEME
  109. 700 CONTINUE
  110. C
  111. C **** FABRICATION DU TABLEAU INUINV
  112. C **** ON MET LES POINTS QUI ONT POUR INCONNUE ALFA EN TETE
  113. C
  114. NNOE=IKI
  115. NALFA=0
  116. NBETA=0
  117. DO 710 I=1,NNVA
  118. MELEME=IRIGEL(1,I)
  119. DESCR =IRIGEL(3,I)
  120. SEGACT,MELEME,DESCR
  121. NBNN=NUM(/1)
  122. NBELEM=NUM(/2)
  123. NLIGRE=LISINC(/2)
  124. DO 711 I1=1,NBELEM
  125. DO 711 I2=1,NBNN
  126. IP1=NUM(I2,I1)
  127. IF(ICPR(IP1).EQ.0) GO TO 711
  128. 715 CONTINUE
  129. NBETA=NBETA+1
  130. IKI=NNOE-NBETA+1
  131. 716 CONTINUE
  132. INUINV(IP1)=IKI
  133. ICPR(IP1)=0
  134. 711 CONTINUE
  135. SEGDES MELEME,DESCR
  136. 710 CONTINUE
  137. SEGSUP,ICPR
  138. ICDOUR=NNOE
  139. GO TO 800
  140. C
  141. C **** ON FABRIQUE UN NOUVEL OBJET GEOMETRIE CONTENANT TOUTES LES
  142. C **** GEOMETRIES ELEMENTAIRES. CET OBJET CONTIENT NNVA OBJETS
  143. C **** GEOMETRIQUES ELEMENTAIRES. PUIS ON ENVOIE DANS NUMOPT QUI
  144. C **** FOURNIT EN RETOUR INUINV(NUM(I,J))=K DONNE LE NOUVEAU
  145. C **** NUMERO LOCAL DU POINT NUM(I,J).K VARIE DE 1 A ICDOUR.
  146. C **** LE PREMIER NOEUD DE L'OBJET GEOMETRIQUE EST LE PREMIER NOEUD
  147. C **** DE LA MATRICE, ETC...
  148. C
  149.  
  150. 801 CONTINUE
  151.  
  152. NUMDEB=INT(XCOOR(/1)/(IDIM+1))
  153. MAXNUM=NUMDEB
  154.  
  155. NBNUM=NUMDEB
  156. SEGINI,ILOCAL
  157.  
  158. ** NUMEROTATION LOCALE DE TOUS LES NOEUDS
  159. IKOU=0
  160. SEGACT NOMAI
  161. SEGADJ NOMAI
  162. *** write (6,*) ' dimension de nomai ',nomai(/1),nnglob
  163. DO 50 I0=1,NNVA
  164. MELEME=IRIGEL(1,I0)
  165. SEGACT,MELEME
  166. DO 51 I2=1,NUM(/2)
  167. DO 51 I1=1,NUM(/1)
  168. IJ=NUM(I1,I2)
  169. IF (ILOCAL(IJ).NE.0.or.nomai(ij).ne.0) GOTO 51
  170. IKOU=IKOU+1
  171. ILOCAL(IJ)=IKOU
  172. 51 CONTINUE
  173. SEGDES MELEME
  174. 50 CONTINUE
  175. NNOE=IKOU
  176. DO 52 I=1,NOMAI(/1)
  177. IF(NOMAI(I).NE.0.AND.ILOCAL(I).EQ.0) THEN
  178. NNOE=NNOE+1
  179. ILOCAL(I)=ikou+nomai(i)
  180. ENDIF
  181. 52 CONTINUE
  182. SEGDES NOMAI
  183. C
  184. C RECHERCHE DE LA VALEUR PAR DEFAUT DE L'HARMONIQUE DANS LE CAS
  185. C DE L'UTILISATION DE " OPTION MODE FOUR NOHAR "
  186. C
  187. DO 230 IRI=1,NNVA
  188. IHARIR=IRIGEL(5,IRI)
  189. IF(IHARIR.NE.NOHA) THEN
  190. IARDEF = IHARIR
  191. GO TO 231
  192. ENDIF
  193. 230 CONTINUE
  194. CALL ERREUR ( 21)
  195. RETURN
  196. 231 CONTINUE
  197. DO 232 IRI=1,NNVA
  198. IF( IRIGEL(5,IRI).EQ.NOHA) GO TO 232
  199. IF( IRIGEL(5,IRI).EQ.IARDEF ) GO TO 232
  200. CALL ERREUR (21)
  201. RETURN
  202. 232 CONTINUE
  203. C
  204. C **** RECHERCHE DE LA VALEUR MAXINC QUI PERMET DE DIMENSIONNER INCPOS
  205. C
  206. SEGINI,MIDUA
  207. SEGINI,MIMIK
  208. SEGINI,MHARK
  209. DESCR=IRIGEL(3,1)
  210. SEGACT,DESCR
  211. IMIK(**)=LISINC(1)
  212. IAAR=IRIGEL(5,1)
  213. IF(IAAR.EQ.NOHA) IAAR = IARDEF
  214. IHAR(**)= IAAR
  215. IDUA(**)=LISDUA(1)
  216. MAXINC=1
  217. DO 323 IRI=1,NNVA
  218. DESCR=IRIGEL(3,IRI)
  219. IHARIR=IRIGEL(5,IRI)
  220. IF(IHARIR. EQ.NOHA ) IHARIR = IARDEF
  221. SEGACT,DESCR
  222. NLIGRE=LISINC(/2)
  223. DO 326 I=1,NLIGRE
  224. DO 324 J=1,MAXINC
  225. IF(IMIK(J).NE.LISINC(I)) GO TO 324
  226. IF(IHAR(J).EQ.IHARIR) GO TO 326
  227. 324 CONTINUE
  228. MAXINC=MAXINC+1
  229. IHAR(**)=IHARIR
  230. IMIK(**)=LISINC(I)
  231. IDUA(**)=LISDUA(I)
  232. 326 CONTINUE
  233. SEGDES,DESCR
  234. 323 CONTINUE
  235. NDUA=IDUA(/2)
  236.  
  237. C
  238. C **** INITIALISATION DE INCPOS ET DE INCTRA.
  239. C
  240. MAXI=MAXINC
  241. SEGINI,MINCPO
  242. DO 329 IRI=1,NNVA
  243. DESCR=IRIGEL(3,IRI)
  244. IHARIR=IRIGEL(5,1)
  245. IF(IHARIR.EQ.NOHA ) IHARIR = IARDEF
  246. SEGACT,DESCR
  247. MELEME=IRIGEL(1,IRI)
  248. SEGACT,MELEME
  249. NLIGRE=LISINC(/2)
  250. SEGINI,INCTRA
  251. INCTRR(IRI)=INCTRA
  252. N2=NUM(/2)
  253. IADS=XCOOR(/1)/(IDIM+1)
  254. DO 334 J=1,NLIGRE
  255. DO 333 K=1,MAXINC
  256. IF(LISINC(J).NE.IMIK(K)) GO TO 333
  257. IF(IHAR(K).EQ.IHARIR) GO TO 332
  258. 333 CONTINUE
  259. 332 CONTINUE
  260. INCTRA(J)=K
  261. DO 331 I=1,N2
  262. IJ=ILOCAL(NUM(NOELEP(J),I))
  263. 331 INCPO(K,IJ)=1
  264. 334 CONTINUE
  265. SEGDES,DESCR
  266. SEGDES,INCTRA
  267. 329 CONTINUE
  268. C
  269. SEGACT,SNOMIN
  270. SEGACT,NOMAI
  271. SEGACT,NOINC
  272. DO 3301 I=1,NOMAI(/1)
  273. IF(NOMAI(I).EQ.0) GOTO 3301
  274. N1=NOMAI(I)
  275. DO 3302 J=1,NOMIN(/2)
  276. IF(NOINC(J,N1).EQ.0) GOTO 3302
  277. DO 3303 K=1,IMIK(/2)
  278. IF(NOMIN(J).EQ.IMIK(K)) GO TO 3304
  279. 3303 CONTINUE
  280. 3304 CONTINUE
  281. INCPO(K,ILOCAL(I))=1
  282. 3302 CONTINUE
  283. 3301 CONTINUE
  284. C
  285. C
  286. MAXPOD=MAXINC*NNOE+1
  287. MAXPO=MAXPOD
  288. NBNNMA=0
  289. DO 299 I=1,INCPO(/1)
  290. DO 2991 J=1,INCPO(/2)
  291. NBNNMA=NBNNMA+INCPO(I,J)
  292. 2991 CONTINUE
  293. 299 CONTINUE
  294. C
  295. C ** ON EFFECTUE UN TRI DES NOEUDS MAITRES POUR DISTINGUER LES NOEUDS
  296. C ** "TOTALEMENT MAITRES" DES NOEUDS "NON TOTALEMENT MAITRES"
  297. C
  298. NLIGRA=0
  299. DO 30 I=1,NOMAI(/1)
  300. IF (NOMAI(I).EQ.0) GOTO 30
  301. 32 CONTINUE
  302. NINCMA=0
  303. NINC = 0
  304. DO 33 J=1,INCPO(/1)
  305. N2=J
  306. IF (INCPO(J,ILOCAL(I)).NE.1) GOTO 33
  307. NINC=NINC+1
  308. DO 34 JJ=1,NOMIN(/2)
  309. N3=JJ
  310. IF (IMIK(J).EQ.NOMIN(JJ)) GOTO 35
  311. ** IF (IMIK(J).EQ.NOMIN(JJ).AND.IHAR(J).EQ.IHARMA(JJ)) GOTO 35
  312. 34 CONTINUE
  313. GOTO 33
  314. 35 CONTINUE
  315. IF (NOINC(N3,NOMAI(I)).EQ.1) THEN
  316. INCPO(N2,ILOCAL(I))=MAXPOD
  317. NINCMA=NINCMA+1
  318. NLIGRA=NLIGRA+1
  319. NBNNMA=NBNNMA-1
  320. ENDIF
  321. 33 CONTINUE
  322. IF(NINCMA.GT.0) THEN
  323. IF(NINCMA.EQ.NINC) THEN
  324. NTOTMA(**)=ILOCAL(I)
  325. DO 3333 J=1,INCPO(/1)
  326. IF(INCPO(J,ILOCAL(I)).EQ.MAXPOD)
  327. & INCPO(J,ILOCAL(I))=1
  328. 3333 CONTINUE
  329. ELSE
  330. NTTMAI(**)=ILOCAL(I)
  331. ENDIF
  332. ENDIF
  333. 30 CONTINUE
  334. NODDEB=NNOE
  335. SEGDES NOINC
  336. C
  337. C **** ON FABRIQUE UN NOUVEL OBJET GEOMETRIE CONTENANT TOUTES LES
  338. C **** GEOMETRIES ELEMENTAIRES. CET OBJET CONTIENT NNVA+1 OBJETS
  339. C **** GEOMETRIQUES ELEMENTAIRES. LE PREMIER SOUS-OBJET CONTIENT
  340. C **** LES NOEUDS TOTALEMENT MAITRES (S'IL Y EN A), QUI SERONT
  341. C **** PLACES EN FIN DE NUMEROTATION. ON APPELLE NUMOPT2 (OU NUMOPT)
  342. C **** QUI FOURNIT EN RETOUR INUINV(NUM(I,J))=K DONNE LE NOUVEAU
  343. C **** NUMERO LOCAL DU POINT NUM(I,J).K VARIE DE 1 A ICDOUR.
  344. C **** LE PREMIER NOEUD DE L'OBJET GEOMETRIQUE EST LE PREMIER NOEUD
  345. C **** DE LA MATRICE, ETC...
  346. C
  347. C on met d'abord en tete un point bidon pour etre coherent
  348. C avec le precontionnement dans numopt
  349. C
  350. IF(NTOTMA(/1).NE.0) THEN
  351. NBNN=1
  352. NBSOUS=0
  353. NBREF=0
  354. NBELEM=1
  355. SEGINI,IPT5
  356. IPT5.ITYPEL=28
  357. DO 221 J=1,ILOCAL(/1)
  358. IF (ILOCAL(J).EQ.NTOTMA(1)) GOTO 222
  359. 221 CONTINUE
  360. CALL ERREUR(5)
  361. 222 CONTINUE
  362. IPT5.NUM(1,1)=J
  363. NBELEM=NTOTMA(/1)
  364. SEGINI,IPT3
  365. IPT3.ITYPEL=28
  366. DO 200 I=1,NTOTMA(/1)
  367. DO 201 J=1,ILOCAL(/1)
  368. IF (ILOCAL(J).EQ.NTOTMA(I)) GOTO 202
  369. 201 CONTINUE
  370. CALL ERREUR(5)
  371. RETURN
  372. 202 CONTINUE
  373. IPT3.NUM(1,I)=J
  374. 200 CONTINUE
  375.  
  376. ELSE
  377.  
  378. IKK=1
  379. 722 CONTINUE
  380. MELEME=IRIGEL(1,IKK)
  381. SEGACT,MELEME
  382. DESCR=IRIGEL(3,IKK)
  383. SEGACT,DESCR
  384. NLIGRE=LISINC(/2)
  385. DO 720 K=1,NLIGRE
  386. IF(LISINC(K).NE.'LX ') GO TO 721
  387. 720 CONTINUE
  388. SEGDES,MELEME
  389. SEGDES,DESCR
  390. IKK=IKK+1
  391. IF(IKK.LE.NNVA) GO TO 722
  392. DO 4862 I=1,NNVA
  393. MELEME= IRIGEL(1,I)
  394. SEGACT MELEME
  395. IF(ITYPEL.EQ.22) THEN
  396. DESCR=IRIGEL(3,I )
  397. SEGACT,DESCR
  398. K = 3
  399. GO TO 4863
  400. ELSE
  401. SEGDES MELEME
  402. ENDIF
  403. 4862 CONTINUE
  404. K=1
  405. MELEME= IRIGEL(1,1)
  406. DESCR= IRIGEL(3,1)
  407. SEGACT MELEME,DESCR
  408. 4863 CONTINUE
  409. 721 IA=NOELEP(K)
  410. I1=NUM(IA,1)
  411. NBSOUS=0
  412. NBNN=1
  413. NBREF=0
  414. NBELEM=1
  415. SEGDES,MELEME,DESCR
  416. SEGINI,IPT3
  417. IPT3.ITYPEL=1
  418. IPT3.NUM(1,1)=I1
  419. ipt5=ipt3
  420. ENDIF
  421. SEGDES IPT3
  422. NBSOUS=NNVA+2
  423. NBREF=0
  424. NBNN=0
  425. NBELEM=0
  426. SEGINI,IPT2
  427. IPT2.LISOUS(1)=IPT5
  428. IPT2.LISOUS(2)=IPT3
  429. NOSOUS=3
  430. DO 210 I=1,NNVA
  431. IPT2.LISOUS(NOSOUS)=IRIGEL(1,I)
  432. NOSOUS=NOSOUS+1
  433. 210 CONTINUE
  434. SEGDES IPT2
  435.  
  436. NNGLOB=ILOCAL(/1)
  437. SEGINI,INUINV
  438. DO 450 I=1,NNGLOB
  439. INUINV(I)=ILOCAL(I)
  440. 450 CONTINUE
  441.  
  442. CALL NUMOPT(IPT2,INUINV,NNOE)
  443. segact inuinv*mod
  444. IF(NTOTMA(/1).NE.0) THEN
  445. * on remet les noeuds totalement maitre a la fin, ce que numopt ne fait
  446. * pas
  447. nbtmai=ntotma(/1)
  448. segact ipt3
  449. do i=1,nbtmai
  450. ** inuinv(ipt3.num(1,i))= inuinv(ipt3.num(1,i))+nnglob
  451. inuinv(ipt3.num(1,i))= ipt3.num(1,i)+nnglob
  452. enddo
  453. segini inuin2
  454. do i=1,nnglob
  455. if (inuinv(i).ne.0) inuin2(inuinv(i))=i
  456. enddo
  457. icour=0
  458. do 803 i=1,2*nnglob
  459. if (inuin2(i).eq.0) goto 803
  460. icour=icour+1
  461. inuin2(icour)=inuin2(i)
  462. 803 continue
  463. do i=1,nnglob
  464. inuinv(i)=0
  465. enddo
  466. do i=1,nnglob
  467. if (inuin2(i).ne.0) inuinv(inuin2(i))=i
  468. enddo
  469. segsup inuin2
  470. ENDIF
  471.  
  472.  
  473.  
  474. 800 CONTINUE
  475.  
  476. ** ON APPLIQUE LA NOUVELLE NUMEROTATION A INCPO ET A NTTMAI
  477.  
  478. SEGINI,MIPO1=MINCPO
  479. DO 600 I=1,NNGLOB
  480. IF (INUINV(I).EQ.0) GOTO 600
  481. DO 610 II=1,MAXINC
  482. INCPO(II,INUINV(I))=MIPO1.INCPO(II,ILOCAL(I))
  483. 610 CONTINUE
  484. 600 CONTINUE
  485.  
  486. SEGSUP,MIPO1
  487. DO 615 I=1,NTTMAI(/1)
  488. DO 616 II=1,ILOCAL(/1)
  489. IF (NTTMAI(I).EQ.ILOCAL(II)) THEN
  490. NTTMAI(I)=INUINV(II)
  491. GOTO 615
  492. ENDIF
  493. 616 CONTINUE
  494. 615 CONTINUE
  495.  
  496. DO 617 I=1,NTOTMA(/1)
  497. DO 618 II=1,ILOCAL(/1)
  498. IF (NTOTMA(I).EQ.ILOCAL(II)) THEN
  499. NTOTMA(I)=INUINV(II)
  500. GOTO 617
  501. ENDIF
  502. 618 CONTINUE
  503. 617 CONTINUE
  504. C
  505. C **** CREATION D'UN OBJET GEOMETRIE (IPT1) QU'IL FAUDRA CHANGER EN CAS DE
  506. C **** RENUMEROTATION GENERALE. ON PROFITE DE LA BOUCLE POUR CREER LE
  507. C **** TABLEAU IMIN(I)=J QUI DIT QUE J ELEMENTS TOUCHE LE NOEUD I (NU-
  508. C **** MEROTATION LOCALE).
  509. C
  510. SEGINI,IMIN
  511. NBSOUS=0
  512. NBREF=0
  513. NBNN=1
  514. NBELEM=NNOE
  515. SEGINI,IPT1
  516. IPT1.ITYPEL=IPOIN
  517. DO 316 IRI=1,NNVA
  518. MELEME=IRIGEL(1,IRI)
  519. SEGACT,MELEME
  520. N1=NUM(/1)
  521. N2=NUM(/2)
  522. DO 317 I=1,N2
  523. DO 317 J=1,N1
  524. K=NUM(J,I)
  525. M=INUINV(K)
  526. IMIN(M)=IMIN(M)+1
  527. IPT1.NUM(1,M)=K
  528. 317 CONTINUE
  529. SEGDES,MELEME
  530. 316 CONTINUE
  531. DO 3161 I=1,NOMAI(/1)
  532. IF(NOMAI(I).EQ.0) GO TO 3161
  533. IPT1.NUM(1,INUINV(I))=I
  534. 3161 CONTINUE
  535.  
  536.  
  537. C **** INITIALISATION DE ITOPO. ON UTILISE IMIN POUR SE POSITIONNER
  538. C **** DANS ITOPO .
  539. C
  540. SEGINI,IITOP
  541. IITOP(1)=1
  542. DO 318 I=1,NNOE
  543. IITOP(I+1)=IMIN(I)* 2 + IITOP(I)
  544. 318 CONTINUE
  545. DO 319 I=1,NNOE
  546. 319 IMIN(I)=0
  547. IENNO=IITOP(NNOE+1)
  548. SEGINI,ITOPO
  549. DO 321 IRI=1,NNVA
  550. MELEME=IRIGEL(1,IRI)
  551. SEGACT,MELEME
  552. N1=NUM(/1)
  553. N2=NUM(/2)
  554. DO 322 I=1,N2
  555. DO 322 J=1,N1
  556. K=NUM(J,I)
  557. M=INUINV(K)
  558. IMIN(M)=IMIN(M)+1
  559. IUY= 2* ( IMIN(M)-1 ) + IITOP(M)
  560. ITOPO(IUY)=I
  561. ITOPO(IUY+1)=IRI
  562. 322 CONTINUE
  563. SEGDES,MELEME
  564. 321 CONTINUE
  565. C
  566. C *** NUMEROTATION DES INCONNUES DE INCPO
  567. C
  568. NA=0
  569.  
  570. DO 337 I=1,NNOE
  571. DO 335 K=1,MAXINC
  572. IF(INCPO(K,I).EQ.0) GO TO 335
  573. IF (INCPO(K,I).LT.MAXPOD) THEN
  574. NA=NA+1
  575. INCPO(K,I)=NA
  576. ENDIF
  577. 335 CONTINUE
  578. 337 CONTINUE
  579. DO 339 I=1,NTTMAI(/1)
  580. N1=NTTMAI(I)
  581. DO 338 K=1,MAXINC
  582. IF(INCPO(K,N1).EQ.0) GO TO 338
  583. IF (INCPO(K,N1).EQ.MAXPOD) THEN
  584. NA=NA+1
  585. INCPO(K,N1)=NA
  586. ENDIF
  587. 338 CONTINUE
  588. 339 CONTINUE
  589. C
  590. C CREATION DU DESCRIPTEUR DE LA RIGIDITE EQUIVALENTE
  591. C
  592. NLIGRD=NLIGRA
  593. NLIGRP=NLIGRA
  594. SEGINI,DES1
  595. DO 341 IGLOB=1,NOMAI(/1)
  596. IF(NOMAI(IGLOB).EQ.0) GOTO 341
  597. ILOC=INUINV(IGLOB)
  598. DO 342 I=1,INCPO(/1)
  599. IF(INCPO(I,ILOC).GT.NBNNMA) THEN
  600. ICOL=INCPO(I,ILOC)-NBNNMA
  601. DES1.NOELEP(ICOL)=NOMAI(IGLOB)
  602. DES1.NOELED(ICOL)=NOMAI(IGLOB)
  603. DES1.LISINC(ICOL)=IMIK(I)
  604. DES1.LISDUA(ICOL)=IDUA(I)
  605. ENDIF
  606. 342 CONTINUE
  607. 341 CONTINUE
  608.  
  609. SEGDES DES1
  610.  
  611. SEGDES,MIDUA,MIMIK,MHARK
  612.  
  613. SEGDES,MRIGID
  614.  
  615. SEGDES,ITOPO
  616. SEGDES,IITOP
  617. SEGDES,INUINV
  618. SEGDES,IPT1
  619. SEGDES,MINCPO
  620. SEGSUP,IMIN
  621. SEGDES,INCTRR
  622. INCTRY=INCTRR
  623. SEGINI,MMATRI
  624. NENS=0
  625. IGEOMA=IPT1
  626. IIDUA=MIDUA
  627. IINCPO=MINCPO
  628. IIMIK=MIMIK
  629. IHARK=MHARK
  630. INUINY=INUINV
  631. ITOPOY=ITOPO
  632. IITOPY=IITOP
  633. MMATRX=MMATRI
  634. SEGDES,MMATRI
  635. SEGDES,ILOCAL
  636. SEGDES,MELEME
  637. SEGDES,DESCR
  638. SEGDES,SNTT
  639. SEGDES,SNTO
  640. SEGDES NOMAI
  641. SEGDES SNOMIN
  642. RETURN
  643. END
  644.  
  645.  
  646.  
  647.  
  648.  
  649.  
  650.  
  651.  
  652.  
  653.  
  654.  
  655.  
  656.  
  657.  
  658.  
  659.  
  660.  
  661.  
  662.  
  663.  
  664.  
  665.  
  666.  

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