Télécharger d2vtra.eso

Retour à la liste

Numérotation des lignes :

  1. C D2VTRA SOURCE BP208322 15/07/22 21:15:12 8586
  2. C
  3. SUBROUTINE D2VTRA(ITBAS,ITKM,ITA,KTKAM,IPMAIL,KTRES,KTNUM,KPREF,
  4. & KTPHI,KTLIAB,RIGIDE,ITCARA,LMODYN)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. *--------------------------------------------------------------------*
  8. * *
  9. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  10. * ________________________________________________ *
  11. * *
  12. * Transpose l'information des objets de Castem2000 dans des *
  13. * tableaux de travail. *
  14. * *
  15. * Parametres: *
  16. * *
  17. * e ITBAS Table representant une base modale *
  18. * e ITKM Table contenant les matrices XK et XM *
  19. * e ITA Table contenant la matrice XASM *
  20. * es KTKAM Segment contenant les matrices XK, XASM et XM *
  21. * e IPMAIL Maillage de reference pour les CHPOINTs resultats *
  22. * es KTRES Segment de sauvegarde des resultats *
  23. * e KPREF Segment des points de reference *
  24. * es KTPHI Segment des deformees modales *
  25. * e KTLIAB Segment des liaisons sur base B *
  26. * e RIGIDE Vrai si corps rigide, faux sinon *
  27. * *
  28. * Auteur, date de creation: *
  29. * *
  30. * Denis ROBERT-MOUGIN, le 26 mai 1989. *
  31. * *
  32. *--------------------------------------------------------------------*
  33. -INC SMRIGID
  34. -INC SMELEME
  35. -INC CCOPTIO
  36. -INC CCREEL
  37. *
  38. SEGMENT,MTKAM
  39. REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M)
  40. REAL*8 XOPER(NB1,NB1,NOPER)
  41. ENDSEGMENT
  42. SEGMENT,MTPHI
  43. INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  44. INTEGER IAROTA(NSB)
  45. REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  46. ENDSEGMENT
  47. SEGMENT MTLIAB
  48. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  49. REAL*8 XPALB(NLIAB,NXPALB)
  50. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  51. ENDSEGMENT
  52. SEGMENT,MTNUM
  53. REAL*8 XDT(NPC1),XTEMPS(NPC1)
  54. ENDSEGMENT
  55. SEGMENT,MPREF
  56. INTEGER IPOREF(NPREF)
  57. ENDSEGMENT
  58. *
  59. *
  60. segment mtbas
  61. integer itbmod,lsstru(np1),nsstru
  62. endsegment
  63.  
  64. c segment local : enregistre les positions d'indices
  65. segment IN2IA(LVAL)
  66. c segment local : calcule l operateur et son inverse
  67. SEGMENT MOP
  68. REAL*8 XOP(NB1,NB1)
  69. INTEGER INVOP(NB1)
  70. REAL*8 XOPM1(NB1,NB1)
  71. ENDSEGMENT
  72.  
  73. LOGICAL L0,L1,RIGIDE,LMODYN,LPLEIN(3)
  74. CHARACTER*4 CMOT,MOINC
  75. CHARACTER*8 TYPRET,CHARRE
  76. CHARACTER*40 MONMOT
  77. *
  78. MTKAM = KTKAM
  79. MTPHI = KTPHI
  80. MTLIAB = KTLIAB
  81. MPREF = KPREF
  82. MTNUM = KTNUM
  83. *
  84. NPLB = IBASB(/1)
  85. NSB = INMSB(/1)
  86. NA2 = XPHILB(/3)
  87. IDIMB = XPHILB(/4)
  88. NLIAB = IPALB(/1)
  89. NA1 = XASM(/1)
  90. NB1K = XK(/2)
  91. NB1C = XASM(/2)
  92. NB1M = XM(/2)
  93. NB1 = XOPER(/1)
  94. NOPER= XOPER(/3)
  95. NPREF=IPOREF(/1)
  96. *
  97. IA1 = 0
  98. DEUXPI = 2.D0 * XPI
  99. RIGIDE =.FALSE.
  100. LPLEIN(1)=.FALSE.
  101. LPLEIN(2)=.FALSE.
  102. LPLEIN(3)=.FALSE.
  103. *
  104. * Traitement des matrices de variables generalisees:
  105. *
  106. IF (ITBAS.NE.0 .AND.ITKM.EQ.0.AND.(.NOT.LMODYN)) THEN
  107. CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'SOUSTYPE',L0,IP0,
  108. & 'MOT',I1,X1,MONMOT,L1,IP1)
  109. IF (IERR.NE.0) RETURN
  110. *
  111. * Cas o: la base est unique
  112. *
  113. IF (MONMOT(1:11).EQ.'BASE_MODALE') THEN
  114. *
  115. * On recupere la base de modes
  116. *
  117. CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'MODES',L0,IP0,
  118. & 'TABLE',I1,X1,' ',L1,IBAS)
  119. IF (IERR.NE.0) RETURN
  120. CALL DYNE26(IBAS,KTKAM,KTLIAB,KTPHI,IA1,1,ICOMP,
  121. & RIGIDE,ITCARA,LMODYN,ITKM)
  122. c IF (RIGIDE) THEN
  123. c RIGIDE =.FALSE.
  124. c DO 80 ILIA =1,NLIAB
  125. c ITYP = IPALB(ILIA,1)
  126. c IF (ITYP.EQ.35.OR.ITYP.EQ.36) THEN
  127. c RIGIDE =.TRUE.
  128. c ENDIF
  129. c 80 CONTINUE
  130. c ENDIF
  131. IF (IERR.NE.0) RETURN
  132. *
  133. * Cas o: on a un ensemble de bases
  134. *
  135. ELSE IF (MONMOT(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
  136. *
  137. * On boucle sur le nombre de bases
  138. *
  139. IT = 0
  140. NPLSB = 0
  141. 10 CONTINUE
  142. TYPRET = ' '
  143. IT = IT + 1
  144. CALL ACCTAB(ITBAS,'ENTIER',IT,X0,' ',L0,IP0,
  145. & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  146. IF (IERR.NE.0) RETURN
  147. IF (ITTBAS.NE.0) THEN
  148. IF (TYPRET.EQ.'TABLE ') THEN
  149. CALL ACCTAB(ITTBAS,'MOT',IMODE,X0,'MODES',L0,IP0,
  150. & 'TABLE',I1,X1,' ',L1,IBAS)
  151. IF (IERR.NE.0) RETURN
  152. CALL DYNE26(IBAS,KTKAM,KTLIAB,KTPHI,IA1,IT,ICOMP,
  153. & RIGIDE,ITCARA,LMODYN,ITKM)
  154. IF (IERR.NE.0) RETURN
  155. NPLSB = MAX(NPLSB,ICOMP)
  156. GOTO 10
  157. ELSE
  158. CALL ERREUR(491)
  159. RETURN
  160. ENDIF
  161. ENDIF
  162.  
  163. * le segadj n'est plus necessaire
  164. * on le fait dans dyne26
  165. * MP
  166. * SEGADJ,MTPHI
  167. ENDIF
  168. c write(ioimp,*) 'fin du traitement de la base',ITBAS
  169. *
  170. * ELSE IF (ITBAS.NE.0.AND.ITKM.NE.0) THEN
  171. * WRITE(IOIMP,*)
  172. * & 'DYNE : TBAS et TKM coexistent ---> @ implementer.'
  173. * IERR = 2
  174. * RETURN
  175. *
  176. ELSE IF (LMODYN) THEN
  177. mtbas = itbas
  178. NPLSB = 0
  179. do isstru = 1,nsstru
  180. CALL DYNE26(itbas,KTKAM,KTLIAB,KTPHI,IA1,isstru,ICOMP,
  181. & RIGIDE,ITCARA,LMODYN,ITKM)
  182. IF (IERR.NE.0) RETURN
  183. NPLSB = MAX(NPLSB,ICOMP)
  184. enddo
  185. *
  186. *
  187. ELSE IF (ITKM.NE.0) THEN
  188. TYPRET = ' '
  189. CALL ACCTAB(ITKM,'MOT',I0,X0,'RAIDEUR',L0,IP0,
  190. & TYPRET,I1,X1,CHARRE,L1,IRIGI)
  191. IF (IERR.NE.0) RETURN
  192. IF (IRIGI.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN
  193. c nature de la matrice : DIAGONALE (defaut) ou PLEINE ...
  194. TYPRET= ' '
  195. CALL ACCTAB(ITKM,'MOT',I0,X0,'NATURE_RAIDEUR',L0,IP0,
  196. & TYPRET,I1,X1,CHARRE,L1,IP1)
  197. IF(TYPRET(1:3).eq.'MOT') THEN
  198. if(iimpi.EQ.333) write(ioimp,*) 'Nature de K =',CHARRE
  199. IF(CHARRE(1:6).eq.'PLEINE') THEN
  200. LPLEIN(1)=.TRUE.
  201. NB1K=NA1
  202. NB1=max(NB1,NB1K)
  203. SEGADJ,MTKAM
  204. ELSEIF(CHARRE(1:6).ne.'DIAGONALE') THEN
  205. write(ioimp,*) 'Nature de K =',CHARRE,' non comprise !'
  206. call erreur(251)
  207. ENDIF
  208. ELSEIF(TYPRET(1:8).NE.' ') THEN
  209. write(ioimp,*) 'NATURE doit etre un MOT (DIAGONALE ou PLEINE)'
  210. write(ioimp,*) 'et pas un ',TYPRET
  211. MOTERR(1:8)='MOT '
  212. call erreur(37)
  213. ENDIF
  214. MRIGID = IRIGI
  215. SEGACT,MRIGID
  216. NRIGI = IRIGEL(/2)
  217. DO 20 I=1,NRIGI
  218. COEF = COERIG(I)
  219. MELEME = IRIGEL(1,I)
  220. DESCR = IRIGEL(3,I)
  221. XMATRI = IRIGEL(4,I)
  222. SEGACT,DESCR,MELEME,XMATRI
  223. NRIG = RE(/3)
  224. LVAL = RE(/1)
  225. DO 30 IRIG=1,NRIG
  226. IF(LPLEIN(1)) segini,IN2IA
  227. c boucle sur les lignes (ddls duals)
  228. DO 35 IN=1,LVAL
  229. INODE=NOELED(IN)
  230. IF(INODE.ne.NOELEP(IN)) THEN
  231. WRITE(IIOMP,*) 'Incoherence entre les inconnues',
  232. & 'primales et duales de la matrice RAIDEUR'
  233. CALL ERREUR(47)
  234. RETURN
  235. ENDIF
  236. NNODE=NUM(INODE,IRIG)
  237. c position de cette inconnue dans IPOREF de MPREF
  238. DO 36 IA=1,NPREF
  239. IF (IPOREF(IA).EQ.NNODE) GOTO 39
  240. 36 CONTINUE
  241. write(ioimp,*) 'D2VTRA: Incoherence entre les ',
  242. & 'points de reference et la matrice RAIDEUR'
  243. CALL ERREUR(504)
  244. 39 CONTINUE
  245. c write(ioimp,*) 'DEVTRA: + noeud dual trouvé en position',IA
  246. IF(LPLEIN(1)) THEN
  247. c on enregistre la position
  248. IN2IA(IN)=IA
  249. c boucle sur les ddl duals JN >= IN (depuis le coin)
  250. DO 37 JN=1,IN
  251. IB = IN2IA(JN)
  252. * Matrice pleine ...
  253. XK(IA,IB) = XK(IA,IB)
  254. & + (RE(IN,JN,IRIG) * COEF)
  255. c attention a ne pas remplir 2 fois la diagonale...
  256. IF(IA.eq.IB) GOTO 37
  257. XK(IB,IA) = XK(IB,IA)
  258. & + (RE(JN,IN,IRIG) * COEF)
  259. 37 CONTINUE
  260. ELSE
  261. * Partie diagonale seulement ...
  262. XK(IA,1) = XK(IA,1) + (RE(IN,IN,IRIG) * COEF)
  263. ENDIF
  264. 35 CONTINUE
  265. IF(LPLEIN(1)) segsup,IN2IA
  266. 30 CONTINUE
  267. SEGDES,XMATRI,MELEME,DESCR
  268. 20 CONTINUE
  269. SEGDES,MRIGID
  270. ELSE
  271. CALL ERREUR(483)
  272. RETURN
  273. ENDIF
  274. *
  275. TYPRET = ' '
  276. CALL ACCTAB(ITKM,'MOT',I0,X0,'MASSE',L0,IP0,
  277. & TYPRET,I1,X1,CHARRE,L1,IMASS)
  278. IF (IERR.NE.0) RETURN
  279. IF (IMASS.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN
  280. c nature de la matrice : DIAGONALE (defaut) ou PLEINE ...
  281. TYPRET= ' '
  282. CALL ACCTAB(ITKM,'MOT',I0,X0,'NATURE_MASSE',L0,IP0,
  283. & TYPRET,I1,X1,CHARRE,L1,IP1)
  284. IF(TYPRET(1:3).eq.'MOT') THEN
  285. if(iimpi.EQ.333) write(ioimp,*) 'Nature de M =',CHARRE
  286. IF(CHARRE(1:6).eq.'PLEINE') THEN
  287. LPLEIN(3)=.TRUE.
  288. NB1M=NA1
  289. NB1=max(NB1,NB1M)
  290. NOPER=1
  291. SEGADJ,MTKAM
  292. ELSEIF(CHARRE(1:6).ne.'DIAGONALE') THEN
  293. write(ioimp,*) 'Nature de M =',CHARRE,' non comprise !'
  294. call erreur(251)
  295. ENDIF
  296. ELSEIF(TYPRET(1:8).NE.' ') THEN
  297. write(ioimp,*) 'NATURE doit etre un MOT (DIAGONALE ou PLEINE)'
  298. write(ioimp,*) 'et pas un ',TYPRET
  299. MOTERR(1:8)='MOT '
  300. call erreur(37)
  301. ENDIF
  302. MRIGID = IMASS
  303. SEGACT,MRIGID
  304. NMASS = IRIGEL(/2)
  305. DO 40 I=1,NMASS
  306. COEF = COERIG(I)
  307. MELEME = IRIGEL(1,I)
  308. DESCR = IRIGEL(3,I)
  309. XMATRI = IRIGEL(4,I)
  310. SEGACT,DESCR,MELEME,XMATRI
  311. NRIG = RE(/3)
  312. LVAL = RE(/1)
  313. DO 50 IRIG=1,NRIG
  314. IF(LPLEIN(3)) segini,IN2IA
  315. c boucle sur les lignes (ddls duals)
  316. DO 55 IN=1,LVAL
  317. INODE=NOELED(IN)
  318. IF(INODE.ne.NOELEP(IN)) THEN
  319. WRITE(IIOMP,*) 'Incoherence entre les inconnues',
  320. & 'primales et duales de la matrice MASSE'
  321. CALL ERREUR(47)
  322. RETURN
  323. ENDIF
  324. NNODE=NUM(INODE,IRIG)
  325. c position de cette inconnue dans IPOREF de MPREF
  326. DO 56 IA=1,NPREF
  327. IF (IPOREF(IA).EQ.NNODE) GOTO 59
  328. 56 CONTINUE
  329. write(ioimp,*) 'D2VTRA: Incoherence entre les ',
  330. & 'points de reference et la matrice MASSE'
  331. CALL ERREUR(504)
  332. 59 CONTINUE
  333. IF(LPLEIN(3)) THEN
  334. c on enregistre la position
  335. IN2IA(IN)=IA
  336. c boucle sur les ddl duals JN >= IN (depuis le coin)
  337. DO 57 JN=1,IN
  338. IB = IN2IA(JN)
  339. * Matrice pleine ...
  340. XM(IA,IB) = XM(IA,IB)
  341. & + (RE(IN,JN,IRIG) * COEF)
  342. c attention a ne pas remplir 2 fois la diagonale...
  343. IF(IA.eq.IB) GOTO 57
  344. XM(IB,IA) = XM(IB,IA)
  345. & + (RE(JN,IN,IRIG) * COEF)
  346. 57 CONTINUE
  347. ELSE
  348. * Partie diagonale seulement ...
  349. XM(IA,1) = XM(IA,1) + (RE(IN,IN,IRIG) * COEF)
  350. ENDIF
  351. 55 CONTINUE
  352. IF(LPLEIN(3)) segsup,IN2IA
  353. 50 CONTINUE
  354. SEGDES,XMATRI,MELEME,DESCR
  355. 40 CONTINUE
  356. SEGDES,MRIGID
  357. ELSE
  358. CALL ERREUR(484)
  359. RETURN
  360. ENDIF
  361.  
  362. * traitement de la base modale (necessaire si liaison B)
  363. * --> remplissage de XPHILB
  364. TYPRET = ' '
  365. CALL ACCTAB(ITKM,'MOT',I0,X0,'BASE_MODALE',L0,IP0,
  366. & TYPRET,I1,X1,CHARRE,L1,ITBAS2)
  367. IF(ITBAS2.eq.0) GOTO 599
  368. TYPRET = ' '
  369. CALL ACCTAB(ITBAS2,'MOT',IMODE,X0,'SOUSTYPE',L0,IP0,
  370. & 'MOT',I1,X1,MONMOT,L1,IP1)
  371. IF (IERR.NE.0) RETURN
  372. * Cas ou la base est unique
  373. IF (MONMOT(1:11).EQ.'BASE_MODALE') THEN
  374. * On recupere la base de modes
  375. CALL ACCTAB(ITBAS2,'MOT',IMODE,X0,'MODES',L0,IP0,
  376. & 'TABLE',I1,X1,' ',L1,IBAS2)
  377. IF (IERR.NE.0) RETURN
  378. CALL DYNE26(IBAS2,KTKAM,KTLIAB,KTPHI,IA1,1,ICOMP,
  379. & RIGIDE,ITCARA,LMODYN,ITKM)
  380. * Cas ou la base est un ensemble de bases
  381. ELSEIF(MONMOT(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
  382. IT = 0
  383. NPLSB = 0
  384. 510 CONTINUE
  385. TYPRET = ' '
  386. IT = IT + 1
  387. CALL ACCTAB(ITBAS2,'ENTIER',IT,X0,' ',L0,IP0,
  388. & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  389. IF (IERR.NE.0) RETURN
  390. IF (ITTBAS.NE.0) THEN
  391. IF (TYPRET.EQ.'TABLE ') THEN
  392. CALL ACCTAB(ITTBAS,'MOT',IMODE,X0,'MODES',L0,IP0,
  393. & 'TABLE',I1,X1,' ',L1,IBAS2)
  394. IF (IERR.NE.0) RETURN
  395. CALL DYNE26(IBAS2,KTKAM,KTLIAB,KTPHI,IA1,IT,ICOMP,
  396. & RIGIDE,ITCARA,LMODYN,ITKM)
  397. IF (IERR.NE.0) RETURN
  398. NPLSB = MAX(NPLSB,ICOMP)
  399. GOTO 510
  400. ELSE
  401. CALL ERREUR(491)
  402. RETURN
  403. ENDIF
  404. ENDIF
  405. ENDIF
  406. 599 CONTINUE
  407. IF (IERR.NE.0) RETURN
  408. ENDIF
  409. *
  410. * Traitement de la matrice d'amortissement
  411. *
  412. IF (ITA.NE.0) THEN
  413. if (lmodyn) then
  414. iamor = ita
  415. typret='RIGIDITE'
  416. else
  417. TYPRET = ' '
  418. CALL ACCTAB(ITA,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0,
  419. & TYPRET,I1,X1,CHARRE,L1,IAMOR)
  420. IF (IERR.NE.0) RETURN
  421. endif
  422. IF (IAMOR.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN
  423. c nature de la matrice : DIAGONALE (defaut) ou PLEINE ...
  424. if(.not.lmodyn) then
  425. TYPRET= ' '
  426. CALL ACCTAB(ITA,'MOT',I0,X0,'NATURE',L0,IP0,
  427. & TYPRET,I1,X1,CHARRE,L1,IP1)
  428. IF(TYPRET(1:3).eq.'MOT') THEN
  429. if(iimpi.EQ.333) write(ioimp,*) 'Nature de C =',CHARRE
  430. IF(CHARRE(1:6).eq.'PLEINE') THEN
  431. LPLEIN(2)=.TRUE.
  432. NB1C=NA1
  433. NB1=max(NB1,NB1C)
  434. NOPER=max(1,NOPER)
  435. SEGADJ,MTKAM
  436. ELSEIF(CHARRE(1:6).ne.'DIAGONALE') THEN
  437. write(ioimp,*) 'Nature de C =',CHARRE,' non comprise !'
  438. call erreur(251)
  439. ENDIF
  440. ELSEIF(TYPRET(1:8).NE.' ') THEN
  441. write(ioimp,*) 'NATURE doit etre un MOT (DIAGONALE ou PLEINE)'
  442. write(ioimp,*) 'et pas un ',TYPRET
  443. MOTERR(1:8)='MOT '
  444. call erreur(37)
  445. ENDIF
  446. endif
  447. MRIGID = IAMOR
  448. SEGACT,MRIGID
  449. NAMOR = IRIGEL(/2)
  450. DO 60 I=1,NAMOR
  451. COEF = COERIG(I)
  452. c write(ioimp,*) 'D2VTRA: sous rigidite ',I,'/',NAMOR,COEF
  453. MELEME = IRIGEL(1,I)
  454. DESCR = IRIGEL(3,I)
  455. XMATRI = IRIGEL(4,I)
  456. SEGACT,DESCR,MELEME,XMATRI
  457. NRIG = RE(/3)
  458. LVAL = RE(/1)
  459. DO 70 IRIG=1,NRIG
  460. c write(ioimp,*) 'D2VTRA: + element',IRIG,'/',NRIG
  461. IF(LPLEIN(2)) segini,IN2IA
  462. c boucle sur les lignes (ddls duals)
  463. DO 75 IN=1,LVAL
  464. INODE=NOELED(IN)
  465. IF(INODE.ne.NOELEP(IN)) THEN
  466. WRITE(IIOMP,*) 'Incoherence entre les inconnues',
  467. & 'primales et duales de la matrice AMORTISSEMENT'
  468. CALL ERREUR(47)
  469. RETURN
  470. ENDIF
  471. NNODE=NUM(INODE,IRIG)
  472. c write(ioimp,*) 'D2VTRA: + noeud dual',IN,'/',LVAL,' #',NNODE
  473. c position de cette inconnue dans IPOREF de MPREF
  474. DO 76 IA=1,NPREF
  475. IF (IPOREF(IA).EQ.NNODE) GOTO 79
  476. 76 CONTINUE
  477. write(ioimp,*) 'D2VTRA: Incoherence entre les ',
  478. & 'points de reference et la matrice AMORTISSEMENT'
  479. CALL ERREUR(504)
  480. 79 CONTINUE
  481. c write(ioimp,*) 'D2VTRA: + noeud dual trouvé en position',IA
  482. IF(LPLEIN(2)) THEN
  483. c on enregistre la position
  484. IN2IA(IN)=IA
  485. c boucle sur les ddl duals JN >= IN (depuis le coin)
  486. DO 77 JN=1,IN
  487. IB = IN2IA(JN)
  488. * Matrice pleine ...
  489. XASM(IA,IB) = XASM(IA,IB)
  490. & + (RE(IN,JN,IRIG) * COEF)
  491. c attention a ne pas remplir 2 fois la diagonale...
  492. IF(IA.eq.IB) GOTO 77
  493. XASM(IB,IA) = XASM(IB,IA)
  494. & + (RE(JN,IN,IRIG) * COEF)
  495. 77 CONTINUE
  496. ELSE
  497. * Partie diagonale seulement ...
  498. XASM(IA,1) = XASM(IA,1) + (RE(IN,IN,IRIG) * COEF)
  499. ENDIF
  500. 75 CONTINUE
  501. IF(LPLEIN(2)) segsup,IN2IA
  502. 70 CONTINUE
  503. SEGDES,XMATRI,MELEME,DESCR
  504. 60 CONTINUE
  505. SEGDES,MRIGID
  506. ELSE
  507. CALL ERREUR(485)
  508. RETURN
  509. ENDIF
  510. ENDIF
  511.  
  512. * on calcule l'operateur = inverse de
  513. * 1: XOP = M + 0.5dt*C
  514. c IF(LPLEIN(2).OR.LPLEIN(3)) THEN
  515. IF(NOPER.GT.0) THEN
  516. SEGINI,MOP
  517. c le pas de temps est constant (seule possibilite aujourd'hui)
  518. pdt05 = 0.5D0*xdt(1)
  519. c ...C pleine, M pleine
  520. IF(LPLEIN(2).AND.LPLEIN(3)) THEN
  521. DO 61 IA=1,NA1
  522. DO 61 IB=1,NA1
  523. XOP(IA,IB) = XM(IA,IB) + pdt05*XASM(IA,IB)
  524. 61 CONTINUE
  525. c ...C pleine, M diago
  526. ELSEIF(LPLEIN(2)) THEN
  527. DO 62 IA=1,NA1
  528. XOP(IA,IA) = XM(IA,1)
  529. DO 62 IB=1,NA1
  530. XOP(IA,IB) = XOP(IA,IB) + pdt05*XASM(IA,IB)
  531. 62 CONTINUE
  532. c ...C diago, M pleine
  533. ELSEIF(LPLEIN(3)) THEN
  534. DO 63 IA=1,NA1
  535. XOP(IA,IA) = pdt05*XASM(IA,1)
  536. DO 63 IB=1,NA1
  537. XOP(IA,IB) = XOP(IA,IB) + XM(IA,IB)
  538. 63 CONTINUE
  539. ELSE
  540. WRITE(IOIMP,*) 'D2VTRA: option PLEINE incoherente !'
  541. CALL ERREUR(5)
  542. RETURN
  543. ENDIF
  544. * -Inversion de l'operateur
  545. CALL IVMAT(NA1,XOP,INVOP,XOPM1,DETOP,0,IRET)
  546. IF(IRET.ne.0) RETURN
  547. * rem : ici IVMAT, mais il existe aussi INVER, INVER1 ...
  548. DO 69 IA=1,NA1
  549. DO 69 IB=1,NB1
  550. XOPER(IA,IB,1)=XOPM1(IA,IB)
  551. 69 CONTINUE
  552. SEGSUP,MOP
  553. ENDIF
  554. *
  555. IF (IIMPI.EQ.333) THEN
  556. WRITE(IOIMP,*)' segment MTPHI'
  557. WRITE(IOIMP,*)'D2VTRA : valeur de NPLB :',IBASB(/1)
  558. WRITE(IOIMP,*)'D2VTRA : valeur de NSB :',XPHILB(/1)
  559. WRITE(IOIMP,*)'D2VTRA : valeur de NPLSB :',XPHILB(/2)
  560. WRITE(IOIMP,*)'D2VTRA : valeur de NA2 :',XPHILB(/3)
  561. WRITE(IOIMP,*)'D2VTRA : valeur de IDIMB :',XPHILB(/4)
  562. if(NB1K.gt.1) then
  563. do iou=1,NA1
  564. WRITE(IOIMP,*) 'XK=',(XK(iou,jou),jou=1,NB1K)
  565. enddo
  566. else
  567. do iou=1,NA1
  568. WRITE(IOIMP,*) 'XK(',iou,',1)=',XK(iou,1)
  569. enddo
  570. endif
  571. if(NB1C.gt.1) then
  572. do iou=1,NA1
  573. WRITE(IOIMP,*) 'XASM=',(XASM(iou,jou),jou=1,NB1C)
  574. enddo
  575. else
  576. do iou=1,NA1
  577. WRITE(IOIMP,*) 'XASM(',iou,',1)=',XASM(iou,1)
  578. enddo
  579. endif
  580. if(NB1M.gt.1) then
  581. do iou=1,NA1
  582. WRITE(IOIMP,*) 'XM=',(XM(iou,jou),jou=1,NB1M)
  583. enddo
  584. else
  585. do iou=1,NA1
  586. WRITE(IOIMP,*) 'XM(',iou,',1)=',XM(iou,1)
  587. enddo
  588. endif
  589. if(NOPER.ge.1) then
  590. do iop=1,NOPER
  591. do iou=1,NB1
  592. WRITE(IOIMP,*) 'XOPER(',iou,',:,',iop,')=',
  593. & (XOPER(iou,jou,iop),jou=1,NB1)
  594. enddo
  595. enddo
  596. endif
  597. ENDIF
  598. *
  599. END
  600.  
  601.  
  602.  
  603.  
  604.  
  605.  
  606.  
  607.  
  608.  
  609.  
  610.  
  611.  
  612.  
  613.  
  614.  
  615.  

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