Télécharger assem4.eso

Retour à la liste

Numérotation des lignes :

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

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