Télécharger cv2maa.eso

Retour à la liste

Numérotation des lignes :

  1. C CV2MAA SOURCE BP208322 15/06/22 21:16:54 8543
  2. SUBROUTINE CV2MAA(CGEOME,TABVDC,TABMAT,
  3. $ MYFALS,
  4. $ MATLSA,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : CV2MAA
  10. C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments)
  11. C représentant un ensemble de matrices élémentaires en
  12. C RIGIDITE...
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES :
  19. C APPELES (E/S) :
  20. C APPELE PAR : CV2MCA
  21. C***********************************************************************
  22. C ENTREES :
  23. C ENTREES/SORTIES : -
  24. C SORTIES :
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION : v1, 06/03/06, version initiale
  28. C HISTORIQUE : v1, 06/03/06, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36. -INC CCOPTIO
  37. -INC CCHAMP
  38. -INC SMLMOTS
  39. POINTEUR NCVAPR.MLMOTS
  40. POINTEUR NCVADU.MLMOTS
  41. -INC SMELEME
  42. POINTEUR CGEOME.MELEME
  43. POINTEUR MYMEL.MELEME
  44. POINTEUR RIGMEL.MELEME
  45. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  46. -INC SMLENTI
  47. INTEGER JG
  48. POINTEUR LINCPR.MLENTI,LINCDU.MLENTI
  49. POINTEUR KINCPR.MLENTI,KINCDU.MLENTI
  50. POINTEUR LPOQUF.MLENTI,KPOQUF.MLENTI
  51. POINTEUR NOFSPR.MLENTI,NOFSDU.MLENTI
  52. POINTEUR COPRDU.MLENTI,LINCD2.MLENTI
  53. -INC SMRIGID
  54. POINTEUR MATLSA.MRIGID
  55. POINTEUR MYDSCR.DESCR
  56. POINTEUR MYIMAT.IMATRI
  57. POINTEUR MYXMAT.XMATRI
  58. INTEGER NRIGE,NRIGEL,NELRIG,NLIGRP,NLIGRD
  59. *
  60. * Includes persos
  61. *
  62. CBEGININCLUDE SMPOUET
  63. SEGMENT TABGEO
  64. CHARACTER*4 DISGEO
  65. POINTEUR IGEO.MCHAEL
  66. ENDSEGMENT
  67. SEGMENT TABVDC
  68. INTEGER VVARPR(NUMVPR)
  69. INTEGER VVARDU(NUMVDU)
  70. INTEGER VDATPR(NUMDPR)
  71. INTEGER VDATDU(NUMDDU)
  72. INTEGER VCOFPR(NUMCPR)
  73. INTEGER VCOFDU(NUMCDU)
  74. INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  75. INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  76. POINTEUR VLCOF(JLCOF).MLENTI
  77. POINTEUR VCOMP(JGCOF).COMP
  78. POINTEUR VLDAT(JGCOF).MLENTI
  79. INTEGER DJSVD(JGVD)
  80. POINTEUR NOMVD(JGVD).MLMOTS
  81. POINTEUR MVD(JGVD).MCHPOI
  82. REAL*8 XVD(JGVD)
  83. CHARACTER*4 DISVD(KGVD)
  84. ENDSEGMENT
  85. SEGMENT TATRAV
  86. POINTEUR VVCOF(JLCOF).MCHEVA
  87. POINTEUR VCOF(JGCOF).MCHEVA
  88. POINTEUR IVD(JGVD).MCHAEL
  89. POINTEUR VD(JGVD).MCHEVA
  90. POINTEUR DVD(JGVD).MCHEVA
  91. POINTEUR FFVD(KGVD).MCHEVA
  92. POINTEUR DFFVD(KGVD).MCHEVA
  93. LOGICAL LVCOF(JGCOF)
  94. LOGICAL LVD(JGVD)
  95. LOGICAL LDVD(JGVD)
  96. LOGICAL LFFVD(KGVD)
  97. LOGICAL LDFFVD(KGVD)
  98. ENDSEGMENT
  99. SEGMENT TABMAT
  100. POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  101. ENDSEGMENT
  102. CENDINCLUDE SMPOUET
  103. CBEGININCLUDE SMCHAEL
  104. SEGMENT MCHAEL
  105. POINTEUR IMACHE(N1).MELEME
  106. POINTEUR ICHEVA(N1).MCHEVA
  107. ENDSEGMENT
  108. SEGMENT MCHEVA
  109. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  110. ENDSEGMENT
  111. SEGMENT LCHEVA
  112. POINTEUR LISCHE(NBCHE).MCHEVA
  113. ENDSEGMENT
  114. CENDINCLUDE SMCHAEL
  115. POINTEUR IMTLSA.MCHAEL
  116. POINTEUR JMTLSA.MCHEVA
  117. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  118. CBEGININCLUDE SFALRF
  119. SEGMENT FALRF
  120. CHARACTER*(LNNFA) NOMFA
  121. INTEGER NUQUAF(NBLRF)
  122. POINTEUR ELEMF(NBLRF).ELREF
  123. ENDSEGMENT
  124. SEGMENT FALRFS
  125. POINTEUR LISFA(0).FALRF
  126. ENDSEGMENT
  127. CENDINCLUDE SFALRF
  128. POINTEUR MYFALS.FALRFS
  129. CBEGININCLUDE SELREF
  130. SEGMENT ELREF
  131. CHARACTER*(LNNOM) NOMLRF
  132. CHARACTER*(LNFORM) FORME
  133. CHARACTER*(LNTYPL) TYPEL
  134. CHARACTER*(LNESP) ESPACE
  135. INTEGER DEGRE
  136. REAL*8 XCONOD(NDIMEL,NBNOD)
  137. INTEGER NPQUAF(NBDDL)
  138. INTEGER NUMCMP(NBDDL)
  139. INTEGER QUENOD(NBDDL)
  140. INTEGER ORDDER(NDIMEL,NBDDL)
  141. POINTEUR MBPOLY.POLYNS
  142. ENDSEGMENT
  143. SEGMENT ELREFS
  144. POINTEUR LISEL(0).ELREF
  145. ENDSEGMENT
  146. CENDINCLUDE SELREF
  147. POINTEUR LRFPR.ELREF
  148. POINTEUR LRFDU.ELREF
  149. *
  150. CHARACTER*4 MDISPR,MDISDU,MOPR,MODU
  151. INTEGER IMPR,IRET
  152. *
  153. INTEGER IBNN,IBELEM
  154. INTEGER ITQUAF,NDDLPR,NDDLDU
  155. INTEGER IDDLPR,IDDLDU
  156. INTEGER NSOUS,NPOQUF
  157. INTEGER ISOUS
  158. INTEGER ILIGRP,ILIGRD,IELRIG,ICMPP,ICMPD
  159. LOGICAL LOK,LFOUND,LCORES,LEQ1,LEQ2,LFIRST
  160.  
  161. *
  162. * Executable statements
  163. *
  164. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2maa'
  165. *
  166. * Vérification sur les inconnues
  167. *
  168. SEGACT TABVDC
  169. SEGACT TABMAT
  170. * SEGPRT,TABVDC
  171. * SEGPRT,TABMAT
  172.  
  173. NUMVPR=TABMAT.VMAT(/2)
  174. NUMVDU=TABMAT.VMAT(/1)
  175. *
  176. * Construction des listes d'inconnues primales et duales
  177. * qui interviennent dans la matrice et dont la valeur n'est pas
  178. * donnée
  179. JG=0
  180. SEGINI LINCPR
  181. SEGINI LINCDU
  182. DO IVARPR=1,NUMVPR
  183. IPR=TABVDC.VVARPR(IVARPR)
  184. IF (TABVDC.MVD(IPR).EQ.0) THEN
  185. DO IVARDU=1,NUMVDU
  186. IDU=TABVDC.VVARDU(IVARDU)
  187. IF (TABVDC.MVD(IDU).EQ.0) THEN
  188. IF (TABMAT.VMAT(IVARDU,IVARPR).NE.0) THEN
  189. LINCDU.LECT(**)=IDU
  190. LINCPR.LECT(**)=IPR
  191. ENDIF
  192. ENDIF
  193. ENDDO
  194. ENDIF
  195. ENDDO
  196. NINCPR=LINCPR.LECT(/1)
  197. NINCDU=LINCDU.LECT(/1)
  198. * Sortie anticipée s'il n'y a pas de matrices à construire
  199. IF (NINCPR.EQ.0.AND.NINCDU.EQ.0) THEN
  200. * SEGACT LINCPR
  201. * SEGACT LINCDU
  202. SEGSUP LINCPR
  203. SEGSUP LINCDU
  204. MATLSA=0
  205. RETURN
  206. ENDIF
  207. *
  208. * WRITE(IOIMP,*) 'LINCPR et LINCDU'
  209. * SEGPRT,LINCPR
  210. * SEGPRT,LINCDU
  211. * Suppression des doublons
  212. CALL IUNIQ(LINCPR.LECT,LINCPR.LECT(/1),
  213. $ LINCPR.LECT,NINCPR,
  214. $ IMPR,IRET)
  215. IF (IRET.NE.0) GOTO 9999
  216. JG=NINCPR
  217. SEGADJ,LINCPR
  218. CALL IUNIQ(LINCDU.LECT,LINCDU.LECT(/1),
  219. $ LINCDU.LECT,NINCDU,
  220. $ IMPR,IRET)
  221. IF (IRET.NE.0) GOTO 9999
  222. JG=NINCDU
  223. SEGADJ,LINCDU
  224. * WRITE(IOIMP,*) 'LINCPR et LINCDU sans doublons'
  225. * SEGPRT,LINCPR
  226. * SEGPRT,LINCDU
  227. *
  228. * Si les listes d'inconnues ont même taille, on se fatigue
  229. * à chercher une permutation des inconnues duales qui les
  230. * recollent sur les primales
  231. * Ca ne marche pas pour l'instant : COPRDU n'est pas forcément
  232. * une permutation ex : primale = 'TN' ; duale = 'SCAL'
  233. *
  234. IF (.FALSE.) THEN
  235. IF (NINCPR.EQ.NINCDU) THEN
  236. JG=NINCPR
  237. SEGINI COPRDU
  238. LOK=.TRUE.
  239. IINCPR=0
  240. 3 CONTINUE
  241. IF (LOK.AND.IINCPR.LT.NINCPR) THEN
  242. IINCPR=IINCPR+1
  243. JGVDPR=LINCPR.LECT(IINCPR)
  244. NCVAPR=TABVDC.NOMVD(JGVDPR)
  245. SEGACT NCVAPR
  246. * SEGPRT,NCVAPR
  247. NMOVPR=NCVAPR.MOTS(/2)
  248. IINCDU=0
  249. LFOUND=.FALSE.
  250. 1 CONTINUE
  251. * WRITE(IOIMP,*) '1'
  252. IF (.NOT.LFOUND.AND.IINCDU.LT.NINCDU) THEN
  253. IINCDU=IINCDU+1
  254. JGVDDU=LINCDU.LECT(IINCDU)
  255. NCVADU=TABVDC.NOMVD(JGVDDU)
  256. SEGACT NCVADU
  257. * SEGPRT,NCVADU
  258. NMOVDU=NCVADU.MOTS(/2)
  259. LCORES=.FALSE.
  260. IF (NMOVDU.EQ.NMOVPR) THEN
  261. LCORES=.TRUE.
  262. IMOV=0
  263. 2 CONTINUE
  264. * WRITE(IOIMP,*) '2'
  265. IF (LCORES.AND.IMOV.LT.NMOVDU) THEN
  266.  
  267. IMOV=IMOV+1
  268. MOPR=NCVAPR.MOTS(IMOV)
  269. MODU=NCVADU.MOTS(IMOV)
  270. * WRITE(IOIMP,*) 'avant fimot2'
  271. CALL FIMOT2(MOPR,NOMDD,LNOMDD,
  272. $ IPR,IMPR,IRET)
  273. IF (IRET.NE.0) GOTO 9999
  274. * WRITE(IOIMP,*) 'apres fimot2'
  275. LEQ1=MOPR.EQ.MODU
  276. * WRITE(IOIMP,*) 'LEQ1=',LEQ1
  277. * WRITE(IOIMP,*) 'IPR=',IPR
  278. IF (IPR.NE.0) THEN
  279. LEQ2=MODU.EQ.NOMDU(IPR)
  280. ELSE
  281. LEQ2=.FALSE.
  282. ENDIF
  283. * WRITE(IOIMP,*) 'LEQ2=',LEQ2
  284. LCORES=LCORES.AND.(LEQ1.OR.LEQ2)
  285. GOTO 2
  286. ENDIF
  287. ENDIF
  288. SEGDES NCVADU
  289. LFOUND=LCORES
  290. GOTO 1
  291. ENDIF
  292. IF (LFOUND) THEN
  293. COPRDU.LECT(IINCPR)=IINCDU
  294. ENDIF
  295. SEGDES NCVAPR
  296. LOK=LOK.AND.LFOUND
  297. GOTO 3
  298. ENDIF
  299. * SEGPRT,COPRDU
  300. *
  301. * On permute LINCDU
  302. *
  303. LINCD2=LINCDU
  304. JG=NINCDU
  305. SEGINI LINCDU
  306. DO IINCDU=1,NINCDU
  307. LINCDU.LECT(IINCDU)=LINCD2.LECT(COPRDU.LECT(IINCDU))
  308. ENDDO
  309. SEGSUP LINCD2
  310. SEGSUP COPRDU
  311. ENDIF
  312. * WRITE(IOIMP,*) 'LINCDU permuté'
  313. * SEGPRT,LINCPR
  314. * SEGPRT,LINCDU
  315. ENDIF
  316. *
  317. * Maintenant on construit la table de repérage dans LINCPR et LINCDU
  318. *
  319. JG=TABVDC.DJSVD(/1)
  320. SEGINI KINCPR
  321. CALL RSETXI(KINCPR.LECT,LINCPR.LECT,LINCPR.LECT(/1))
  322. SEGINI KINCDU
  323. CALL RSETXI(KINCDU.LECT,LINCDU.LECT,LINCDU.LECT(/1))
  324. * WRITE(IOIMP,*) 'KINCPR et KINCDU'
  325. * SEGPRT,KINCPR
  326. * SEGPRT,KINCDU
  327. *
  328. SEGACT CGEOME
  329. NSOUS=CGEOME.LISOUS(/1)
  330. *
  331. * Initialisation de la matrice
  332. *
  333. NRIGE=7
  334. NRIGEL=NSOUS
  335. SEGINI,MATLSA
  336. MATLSA.MTYMAT='LEASTSQU'
  337. * Parcours
  338. DO ISOUS=1,NSOUS
  339. * WRITE(IOIMP,*) 'ISOUS=',ISOUS
  340. MYMEL=CGEOME.LISOUS(ISOUS)
  341. SEGACT MYMEL
  342. * SEGPRT,MYMEL
  343. ITQUAF=MYMEL.ITYPEL
  344. *
  345. * Maintenant on construit :
  346. * - L'objet géométrie
  347. * - La table d'offset pour les variables primales et duales
  348. * - Le segment descripteur
  349. *
  350. * Liste des points du QUAF sur lequels il y a des ddl
  351. JG=0
  352. SEGINI LPOQUF
  353. * Tables d'offset
  354. JG=NINCPR+1
  355. SEGINI NOFSPR
  356. NOFSPR.LECT(1)=0
  357. JG=NINCDU+1
  358. SEGINI NOFSDU
  359. NOFSDU.LECT(1)=0
  360. NLIGRP=0
  361. NLIGRD=0
  362. * Primale
  363. DO IINCPR=1,NINCPR
  364. IJGVD=LINCPR.LECT(IINCPR)
  365. IKGVD=TABVDC.DJSVD(IJGVD)
  366. MDISPR=TABVDC.DISVD(IKGVD)
  367. CALL KEEF(ITQUAF,MDISPR,MYFALS,
  368. $ LRFPR,IMPR,IRET)
  369. IF (IRET.NE.0) GOTO 9999
  370. SEGACT LRFPR
  371. NDDLPR=LRFPR.NPQUAF(/1)
  372. DO IDDLPR=1,NDDLPR
  373. LPOQUF.LECT(**)=LRFPR.NPQUAF(IDDLPR)
  374. ENDDO
  375. SEGDES LRFPR
  376. NLIGRP=NLIGRP+NDDLPR
  377. NOFSPR.LECT(IINCPR+1)=NLIGRP
  378. ENDDO
  379. * Duale
  380. DO IINCDU=1,NINCDU
  381. IJGVD=LINCDU.LECT(IINCDU)
  382. IKGVD=TABVDC.DJSVD(IJGVD)
  383. MDISDU=TABVDC.DISVD(IKGVD)
  384. CALL KEEF(ITQUAF,MDISDU,MYFALS,
  385. $ LRFDU,IMPR,IRET)
  386. IF (IRET.NE.0) GOTO 9999
  387. SEGACT LRFDU
  388. NDDLDU=LRFDU.NPQUAF(/1)
  389. DO IDDLDU=1,NDDLDU
  390. LPOQUF.LECT(**)=LRFDU.NPQUAF(IDDLDU)
  391. ENDDO
  392. SEGDES LRFDU
  393. NLIGRD=NLIGRD+NDDLDU
  394. NOFSDU.LECT(IINCDU+1)=NLIGRD
  395. ENDDO
  396. * Suppression des doublons de LPOQUF
  397. CALL IUNIQ(LPOQUF.LECT,LPOQUF.LECT(/1),
  398. $ LPOQUF.LECT,NPOQUF,
  399. $ IMPR,IRET)
  400. IF (IRET.NE.0) GOTO 9999
  401. JG=NPOQUF
  402. SEGADJ,LPOQUF
  403. * Segment de repérage dans LPOQUF
  404. JG=MYMEL.NUM(/1)
  405. SEGINI,KPOQUF
  406. CALL RSETXI(KPOQUF.LECT,LPOQUF.LECT,LPOQUF.LECT(/1))
  407. * SEGPRT,LPOQUF
  408. * SEGPRT,KPOQUF
  409. *
  410. * Remplissage de l'objet géométrie
  411. *
  412. NBNN=NPOQUF
  413. NBELEM=MYMEL.NUM(/2)
  414. NBSOUS=0
  415. NBREF=0
  416. SEGINI,RIGMEL
  417. * Type 32 POLY
  418. RIGMEL.ITYPEL=32
  419. DO IBELEM=1,NBELEM
  420. DO IBNN=1,NBNN
  421. RIGMEL.NUM(IBNN,IBELEM)=
  422. $ MYMEL.NUM(LPOQUF.LECT(IBNN),IBELEM)
  423. ENDDO
  424. ENDDO
  425. SEGDES RIGMEL
  426. SEGSUP LPOQUF
  427. * SEGPRT,RIGMEL
  428. *
  429. * Remplissage du segment DESCR
  430. *
  431. SEGINI MYDSCR
  432. * Primale
  433. DO IINCPR=1,NINCPR
  434. IJGVD=LINCPR.LECT(IINCPR)
  435. IKGVD=TABVDC.DJSVD(IJGVD)
  436. MDISPR=TABVDC.DISVD(IKGVD)
  437. CALL KEEF(ITQUAF,MDISPR,MYFALS,
  438. $ LRFPR,IMPR,IRET)
  439. IF (IRET.NE.0) GOTO 9999
  440. SEGACT LRFPR
  441. NCVAPR=TABVDC.NOMVD(IJGVD)
  442. SEGACT NCVAPR
  443. NDDLPR=LRFPR.NPQUAF(/1)
  444. DO IDDLPR=1,NDDLPR
  445. ILIGPR=IDDLPR+NOFSPR.LECT(IINCPR)
  446. ICMPR=LRFPR.NUMCMP(IDDLPR)
  447. MYDSCR.LISINC(ILIGPR)=NCVAPR.MOTS(ICMPR)
  448. MYDSCR.NOELEP(ILIGPR)=
  449. $ KPOQUF.LECT(LRFPR.NPQUAF(IDDLPR))
  450. ENDDO
  451. SEGDES NCVAPR
  452. SEGDES LRFPR
  453. ENDDO
  454. * Duale
  455. DO IINCDU=1,NINCDU
  456. IJGVD=LINCDU.LECT(IINCDU)
  457. IKGVD=TABVDC.DJSVD(IJGVD)
  458. MDISDU=TABVDC.DISVD(IKGVD)
  459. CALL KEEF(ITQUAF,MDISDU,MYFALS,
  460. $ LRFDU,IMPR,IRET)
  461. IF (IRET.NE.0) GOTO 9999
  462. SEGACT LRFDU
  463. NCVADU=TABVDC.NOMVD(IJGVD)
  464. SEGACT NCVADU
  465. NDDLDU=LRFDU.NPQUAF(/1)
  466. DO IDDLDU=1,NDDLDU
  467. ILIGDU=IDDLDU+NOFSDU.LECT(IINCDU)
  468. ICMDU=LRFDU.NUMCMP(IDDLDU)
  469. MYDSCR.LISDUA(ILIGDU)=NCVADU.MOTS(ICMDU)
  470. MYDSCR.NOELED(ILIGDU)=
  471. $ KPOQUF.LECT(LRFDU.NPQUAF(IDDLDU))
  472. ENDDO
  473. SEGDES NCVADU
  474. SEGDES LRFDU
  475. ENDDO
  476. SEGDES MYDSCR
  477. * SEGPRT,MYDSCR
  478. SEGSUP KPOQUF
  479. *
  480. * Remplissage du IMATRI
  481. *
  482. NELRIG=MYMEL.NUM(/2)
  483. SEGDES MYMEL
  484. SEGINI MYxMAT
  485. * NLIGRP et NLIGRD déjà calculés
  486. DO IVARPR=1,NUMVPR
  487. * write(ioimp,*) 'ivarpr=',ivarpr
  488. JGVDPR=TABVDC.VVARPR(IVARPR)
  489. IF (TABVDC.MVD(JGVDPR).EQ.0) THEN
  490. IINCPR=KINCPR.LECT(JGVDPR)
  491. * write(ioimp,*) 'iincpr=',iincpr
  492. DO IVARDU=1,NUMVDU
  493. * write(ioimp,*) 'ivardu=',ivardu
  494. JGVDDU=TABVDC.VVARDU(IVARDU)
  495. IF (TABVDC.MVD(JGVDDU).EQ.0) THEN
  496. IINCDU=KINCDU.LECT(JGVDDU)
  497. * write(ioimp,*) 'iincdu=',iincdu
  498. IMTLSA=TABMAT.VMAT(IVARDU,IVARPR)
  499. IF (IMTLSA.NE.0) THEN
  500. SEGACT IMTLSA
  501. JMTLSA=IMTLSA.ICHEVA(ISOUS)
  502. SEGACT JMTLSA
  503. NBLIG=JMTLSA.VELCHE(/1)
  504. NBCOL=JMTLSA.VELCHE(/2)
  505. N2LIG=JMTLSA.VELCHE(/3)
  506. N2COL=JMTLSA.VELCHE(/4)
  507. NBPOI=JMTLSA.VELCHE(/5)
  508. NBELM=JMTLSA.VELCHE(/6)
  509. IOFSPR=NOFSPR.LECT(IINCPR)
  510. IOFSDU=NOFSDU.LECT(IINCDU)
  511. * write(ioimp,*) 'iofspr=',iofspr
  512. * write(ioimp,*) 'iofsdu=',iofsdu
  513. NDDLPR=NOFSPR.LECT(IINCPR+1)-IOFSPR
  514. NDDLDU=NOFSDU.LECT(IINCDU+1)-IOFSDU
  515. IF (NBLIG.NE.NDDLDU.OR.NBCOL.NE.NDDLPR.OR.N2LIG
  516. $ .NE.1.OR.N2COL.NE.1.OR.NBPOI.NE.1.OR.NBELM
  517. $ .NE.NELRIG) THEN
  518. WRITE(IOIMP,*) 'NBLIG=',NBLIG
  519. WRITE(IOIMP,*) 'NBCOL=',NBCOL
  520. WRITE(IOIMP,*) 'NBELM=',NBELM
  521. WRITE(IOIMP,*) 'NDDLDU=',NDDLDU
  522. WRITE(IOIMP,*) 'NDDLPR=',NDDLPR
  523. WRITE(IOIMP,*) 'NELRIG=',NELRIG
  524.  
  525.  
  526. WRITE(IOIMP,*) 'Erreur dims JMTLSA'
  527. GOTO 9999
  528. ENDIF
  529. * WRITE(IOIMP,*) 'IINCPR=',IINCPR
  530. * WRITE(IOIMP,*) 'IINCDU=',IINCDU
  531. DO IELRIG=1,NELRIG
  532. * WRITE(IOIMP,*) 'IELRIG=',IELRIG
  533. * MYXMAT=MYIMAT.IMATTT(IELRIG)
  534. * IF (MYXMAT.EQ.0) THEN
  535. * LFIRST=.TRUE.
  536. * SEGINI MYXMAT
  537. * ELSE
  538. * LFIRST=.FALSE.
  539. * SEGACT MYXMAT*MOD
  540. * ENDIF
  541. DO IDDLPR=1,NDDLPR
  542. * write(ioimp,*) 'iddlpr=',iddlpr
  543. DO IDDLDU=1,NDDLDU
  544. * write(ioimp,*) 'iddldu=',iddldu
  545. MYXMAT.RE(IOFSDU+IDDLDU,IOFSPR+IDDLPR
  546. $ ,ielrig)=JMTLSA.VELCHE(IDDLDU
  547. $ ,IDDLPR,1,1,1,IELRIG)
  548. ENDDO
  549. ENDDO
  550. * IF (LFIRST) THEN
  551. * SEGDES MYXMAT
  552. * MYIMAT.IMATTT(IELRIG)=MYXMAT
  553. * ELSE
  554. * SEGDES MYXMAT
  555. * ENDIF
  556. * SEGPRT,MYXMAT
  557. ENDDO
  558. SEGDES JMTLSA
  559. SEGDES IMTLSA
  560. ENDIF
  561. ENDIF
  562. ENDDO
  563. ENDIF
  564. ENDDO
  565. SEGSUP NOFSDU
  566. SEGSUP NOFSPR
  567. SEGDES MYxMAT
  568. * SEGPRT,MYIMAT
  569. *
  570. * Remplissage du chapeau
  571. *
  572. MATLSA.COERIG(ISOUS)=1.D0
  573. MATLSA.IRIGEL(1,ISOUS)=RIGMEL
  574. MATLSA.IRIGEL(2,ISOUS)=0
  575. MATLSA.IRIGEL(3,ISOUS)=MYDSCR
  576. MATLSA.IRIGEL(4,ISOUS)=MYxMAT
  577. MATLSA.IRIGEL(5,ISOUS)=0
  578. MATLSA.IRIGEL(6,ISOUS)=0
  579. *
  580. * la matrice ne possède pas de symétries (a priori...)
  581. *
  582. MATLSA.IRIGEL(7,ISOUS)=2
  583. ENDDO
  584. SEGDES MATLSA
  585. IF (IMPR.GT.3) THEN
  586. WRITE(IOIMP,*) 'On a créé MATLSA=',MATLSA
  587. CALL ECROBJ('RIGIDITE',MATLSA)
  588. CALL PRLIST
  589. ENDIF
  590.  
  591. SEGDES CGEOME
  592. SEGSUP KINCPR
  593. SEGSUP KINCDU
  594. SEGSUP LINCPR
  595. SEGSUP LINCDU
  596. SEGDES TABMAT
  597. SEGDES TABVDC
  598. *
  599. * Normal termination
  600. *
  601. IRET=0
  602. RETURN
  603. *
  604. * Format handling
  605. *
  606. *
  607. * Error handling
  608. *
  609. 9999 CONTINUE
  610. IRET=1
  611. WRITE(IOIMP,*) 'An error was detected in subroutine cv2maa'
  612. RETURN
  613. *
  614. * End of subroutine CV2MAA
  615. *
  616. END
  617.  
  618.  
  619.  
  620.  
  621.  
  622.  
  623.  
  624.  
  625.  

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