Télécharger assem4.eso

Retour à la liste

Numérotation des lignes :

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

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