Télécharger assem4.eso

Retour à la liste

Numérotation des lignes :

  1. C ASSEM4 SOURCE PV 19/01/25 21:15:04 10084
  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*NNOE)
  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. ** write(6,*) ' ntotma ',ntotma(/1)
  363. ** write(6,*) ' nttmai ',nttmai(/1)
  364.  
  365.  
  366. IF(NTOTMA(/1).NE.0) THEN
  367. NBNN=1
  368. NBSOUS=0
  369. NBREF=0
  370. NBELEM=1
  371. SEGINI,IPT5
  372. IPT5.ITYPEL=28
  373. DO 221 J=1,ILOCAL(/1)
  374. IF (ILOCAL(J).EQ.NTOTMA(1)) GOTO 222
  375. 221 CONTINUE
  376. CALL ERREUR(5)
  377. 222 CONTINUE
  378. IPT5.NUM(1,1)=J
  379. NBELEM=NTOTMA(/1)
  380. SEGINI,IPT3
  381. IPT3.ITYPEL=0
  382. DO 200 I=1,NTOTMA(/1)
  383. DO 201 J=1,ILOCAL(/1)
  384. IF (ILOCAL(J).EQ.NTOTMA(I)) GOTO 202
  385. 201 CONTINUE
  386. CALL ERREUR(5)
  387. RETURN
  388. 202 CONTINUE
  389. IPT3.NUM(1,I)=J
  390. 200 CONTINUE
  391.  
  392. ELSE
  393.  
  394. IKK=1
  395. 722 CONTINUE
  396. MELEME=IRIGEL(1,IKK)
  397. SEGACT,MELEME
  398. DESCR=IRIGEL(3,IKK)
  399. SEGACT,DESCR
  400. NLIGRE=LISINC(/2)
  401. DO 720 K=1,NLIGRE
  402. IF(LISINC(K).NE.'LX ') GO TO 721
  403. 720 CONTINUE
  404. SEGDES,MELEME
  405. SEGDES,DESCR
  406. IKK=IKK+1
  407. IF(IKK.LE.NNVA) GO TO 722
  408. DO 4862 I=1,NNVA
  409. MELEME= IRIGEL(1,I)
  410. SEGACT MELEME
  411. IF(ITYPEL.EQ.22) THEN
  412. DESCR=IRIGEL(3,I )
  413. SEGACT,DESCR
  414. K = 3
  415. GO TO 4863
  416. ELSE
  417. SEGDES MELEME
  418. ENDIF
  419. 4862 CONTINUE
  420. K=1
  421. MELEME= IRIGEL(1,1)
  422. DESCR= IRIGEL(3,1)
  423. SEGACT MELEME,DESCR
  424. 4863 CONTINUE
  425. 721 IA=NOELEP(K)
  426. I1=NUM(IA,1)
  427. NBSOUS=0
  428. NBNN=1
  429. NBREF=0
  430. NBELEM=1
  431. SEGDES,MELEME,DESCR
  432. SEGINI,IPT3
  433. IPT3.ITYPEL=1
  434. IPT3.NUM(1,1)=I1
  435. ipt5=ipt3
  436. ENDIF
  437. SEGDES IPT3
  438. NBSOUS=NNVA+2
  439. NBREF=0
  440. NBNN=0
  441. NBELEM=0
  442. SEGINI,IPT2
  443. IPT2.LISOUS(1)=IPT5
  444. IPT2.LISOUS(2)=IPT3
  445. NOSOUS=3
  446. DO 210 I=1,NNVA
  447. IPT2.LISOUS(NOSOUS)=IRIGEL(1,I)
  448. NOSOUS=NOSOUS+1
  449. 210 CONTINUE
  450. SEGDES IPT2
  451.  
  452. NNGLOB=ILOCAL(/1)
  453. SEGINI,INUINV
  454. DO 450 I=1,NNGLOB
  455. INUINV(I)=ILOCAL(I)
  456. 450 CONTINUE
  457.  
  458. CALL NUMOPT(IPT2,INUINV,NNOE)
  459. segact inuinv*mod
  460. IF(NTOTMA(/1).NE.0) THEN
  461. * on remet les noeuds totalement maitre a la fin, ce que numopt ne fait
  462. * pas
  463. nbtmai=ntotma(/1)
  464. segact ipt3
  465. do i=1,nbtmai
  466. ** write(6,*) ' assem4 nnglob ',nnoe-ntotma(/1),
  467. ** > inuinv(ipt3.num(1,i))
  468. inuinv(ipt3.num(1,i))= inuinv(ipt3.num(1,i))+nnoe
  469. enddo
  470. segini inuin2
  471. do i=1,nnglob
  472. if (inuinv(i).ne.0) inuin2(inuinv(i))=i
  473. enddo
  474. icour=0
  475. do 803 i=1,2*nnoe
  476. if (inuin2(i).eq.0) goto 803
  477. icour=icour+1
  478. inuin2(icour)=inuin2(i)
  479. 803 continue
  480. do i=1,nnglob
  481. inuinv(i)=0
  482. enddo
  483. do i=1,nnoe
  484. if (inuin2(i).ne.0) inuinv(inuin2(i))=i
  485. enddo
  486. segsup inuin2
  487. ENDIF
  488.  
  489.  
  490. 800 CONTINUE
  491.  
  492. ** ON APPLIQUE LA NOUVELLE NUMEROTATION A INCPO ET A NTTMAI
  493.  
  494. SEGINI,MIPO1=MINCPO
  495. DO 600 I=1,NNGLOB
  496. IF (INUINV(I).EQ.0) GOTO 600
  497. DO 610 II=1,MAXINC
  498. INCPO(II,INUINV(I))=MIPO1.INCPO(II,ILOCAL(I))
  499. 610 CONTINUE
  500. 600 CONTINUE
  501.  
  502. SEGSUP,MIPO1
  503. DO 615 I=1,NTTMAI(/1)
  504. DO 616 II=1,ILOCAL(/1)
  505. IF (NTTMAI(I).EQ.ILOCAL(II)) THEN
  506. NTTMAI(I)=INUINV(II)
  507. GOTO 615
  508. ENDIF
  509. 616 CONTINUE
  510. 615 CONTINUE
  511.  
  512. DO 617 I=1,NTOTMA(/1)
  513. DO 618 II=1,ILOCAL(/1)
  514. IF (NTOTMA(I).EQ.ILOCAL(II)) THEN
  515. NTOTMA(I)=INUINV(II)
  516. GOTO 617
  517. ENDIF
  518. 618 CONTINUE
  519. 617 CONTINUE
  520. C
  521. C **** CREATION D'UN OBJET GEOMETRIE (IPT1) QU'IL FAUDRA CHANGER EN CAS DE
  522. C **** RENUMEROTATION GENERALE. ON PROFITE DE LA BOUCLE POUR CREER LE
  523. C **** TABLEAU IMIN(I)=J QUI DIT QUE J ELEMENTS TOUCHE LE NOEUD I (NU-
  524. C **** MEROTATION LOCALE).
  525. C
  526. SEGINI,IMIN
  527. NBSOUS=0
  528. NBREF=0
  529. NBNN=1
  530. NBELEM=NNOE
  531. SEGINI,IPT1
  532. IPT1.ITYPEL=IPOIN
  533. DO 316 IRI=1,NNVA
  534. MELEME=IRIGEL(1,IRI)
  535. SEGACT,MELEME
  536. N1=NUM(/1)
  537. N2=NUM(/2)
  538. DO 317 I=1,N2
  539. DO 317 J=1,N1
  540. K=NUM(J,I)
  541. M=INUINV(K)
  542. IMIN(M)=IMIN(M)+1
  543. IPT1.NUM(1,M)=K
  544. 317 CONTINUE
  545. SEGDES,MELEME
  546. 316 CONTINUE
  547. DO 3161 I=1,NOMAI(/1)
  548. IF(NOMAI(I).EQ.0) GO TO 3161
  549. IPT1.NUM(1,INUINV(I))=I
  550. 3161 CONTINUE
  551.  
  552.  
  553. C **** INITIALISATION DE ITOPO. ON UTILISE IMIN POUR SE POSITIONNER
  554. C **** DANS ITOPO .
  555. C
  556. SEGINI,IITOP
  557. IITOP(1)=1
  558. DO 318 I=1,NNOE
  559. IITOP(I+1)=IMIN(I)* 2 + IITOP(I)
  560. 318 CONTINUE
  561. DO 319 I=1,NNOE
  562. 319 IMIN(I)=0
  563. IENNO=IITOP(NNOE+1)
  564. SEGINI,ITOPO
  565. DO 321 IRI=1,NNVA
  566. MELEME=IRIGEL(1,IRI)
  567. SEGACT,MELEME
  568. N1=NUM(/1)
  569. N2=NUM(/2)
  570. DO 322 I=1,N2
  571. DO 322 J=1,N1
  572. K=NUM(J,I)
  573. M=INUINV(K)
  574. IMIN(M)=IMIN(M)+1
  575. IUY= 2* ( IMIN(M)-1 ) + IITOP(M)
  576. ITOPO(IUY)=I
  577. ITOPO(IUY+1)=IRI
  578. 322 CONTINUE
  579. SEGDES,MELEME
  580. 321 CONTINUE
  581. C
  582. C *** NUMEROTATION DES INCONNUES DE INCPO
  583. C
  584. NA=0
  585.  
  586. DO 337 I=1,NNOE
  587. nad=na
  588. DO 335 K=1,MAXINC
  589. IF(INCPO(K,I).EQ.0) GO TO 335
  590. IF (INCPO(K,I).LT.MAXPOD) THEN
  591. NA=NA+1
  592. INCPO(K,I)=NA
  593. itrv1(na-nad)=k
  594. dtrv1(na-nad)= -abs(diatmp(k,i))
  595. ENDIF
  596. 335 CONTINUE
  597. ** write(6,*) ' avant ',(incpo(k,i),k=1,maxinc)
  598. * trier incpo suivant les val de diatmp
  599. call triflo(dtrv1,dtrv2,itrv1,itrv2,na-nad)
  600. do k=1,na-nad
  601. incpo(itrv1(k),i)=k+nad
  602. enddo
  603. ** write(6,*) ' apres ',(incpo(k,i),k=1,maxinc)
  604. 337 CONTINUE
  605. DO 339 I=1,NTTMAI(/1)
  606. NAD=NA
  607. N1=NTTMAI(I)
  608. DO 338 K=1,MAXINC
  609. IF(INCPO(K,N1).EQ.0) GO TO 338
  610. IF (INCPO(K,N1).EQ.MAXPOD) THEN
  611. NA=NA+1
  612. INCPO(K,N1)=NA
  613. itrv1(na-nad)=k
  614. dtrv1(na-nad)= -abs(diatmp(k,n1))
  615. ENDIF
  616. 338 CONTINUE
  617. ** write(6,*) ' avant ',(incpo(k,i),k=1,maxinc)
  618. * trier incpo suivant les val de diatmp
  619. call triflo(dtrv1,dtrv2,itrv1,itrv2,na-nad)
  620. do k=1,na-nad
  621. incpo(itrv1(k),n1)=k+nad
  622. enddo
  623. ** write(6,*) ' apres ',(incpo(k,i),k=1,maxinc)
  624. 339 CONTINUE
  625. C
  626. C CREATION DU DESCRIPTEUR DE LA RIGIDITE EQUIVALENTE
  627. C
  628. NLIGRD=NLIGRA
  629. NLIGRP=NLIGRA
  630. SEGINI,DES1
  631. DO 341 IGLOB=1,NOMAI(/1)
  632. IF(NOMAI(IGLOB).EQ.0) GOTO 341
  633. ILOC=INUINV(IGLOB)
  634. DO 342 I=1,INCPO(/1)
  635. IF(INCPO(I,ILOC).GT.NBNNMA) THEN
  636. ICOL=INCPO(I,ILOC)-NBNNMA
  637. DES1.NOELEP(ICOL)=NOMAI(IGLOB)
  638. DES1.NOELED(ICOL)=NOMAI(IGLOB)
  639. DES1.LISINC(ICOL)=IMIK(I)
  640. DES1.LISDUA(ICOL)=IDUA(I)
  641. ENDIF
  642. 342 CONTINUE
  643. 341 CONTINUE
  644. segsup diatmp,strv
  645. SEGDES DES1
  646.  
  647. SEGDES,MIDUA,MIMIK,MHARK
  648.  
  649. SEGDES,MRIGID
  650.  
  651. SEGDES,ITOPO
  652. SEGDES,IITOP
  653. SEGDES,INUINV
  654. SEGDES,IPT1
  655. SEGDES,MINCPO
  656. SEGSUP,IMIN
  657. SEGDES,INCTRR
  658. INCTRY=INCTRR
  659. SEGINI,MMATRI
  660. NENS=0
  661. IGEOMA=IPT1
  662. IIDUA=MIDUA
  663. IINCPO=MINCPO
  664. IIMIK=MIMIK
  665. IHARK=MHARK
  666. INUINY=INUINV
  667. ITOPOY=ITOPO
  668. IITOPY=IITOP
  669. MMATRX=MMATRI
  670. SEGDES,MMATRI
  671. SEGDES,ILOCAL
  672. SEGDES,MELEME
  673. SEGDES,DESCR
  674. SEGDES,SNTT
  675. SEGDES,SNTO
  676. SEGDES NOMAI
  677. SEGDES SNOMIN
  678. RETURN
  679. END
  680.  
  681.  
  682.  
  683.  
  684.  
  685.  
  686.  
  687.  
  688.  
  689.  
  690.  
  691.  
  692.  
  693.  
  694.  
  695.  
  696.  
  697.  
  698.  
  699.  
  700.  
  701.  
  702.  
  703.  
  704.  
  705.  

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