Télécharger amor1.eso

Retour à la liste

Numérotation des lignes :

amor1
  1. C AMOR1 SOURCE JK148537 23/08/21 21:15:03 11723
  2.  
  3. SUBROUTINE AMOR1(MODORI,IPCHE1,ICAS,IPRIG)
  4.  
  5. *---------------------------------------------------------------------*
  6. * *
  7. * OPERATEUR AMORTISSEMENT VISQUEUX *
  8. * *
  9. *---------------------------------------------------------------------*
  10. * *
  11. * CE SOUS-PROGRAMME SERT A TRAITER ET A METTRE EN FORME *
  12. * LES INFORMATIONS NECESSAIRES POUR LES CALCULS *
  13. * *
  14. *---------------------------------------------------------------------*
  15. * *
  16. * ENTREES : *
  17. * ________ *
  18. * *
  19. * IPMODL Pointeur sur le modele *
  20. * IPCHE1 Pointeur sur le chamelem de carateristiques *
  21. * ICAS 1 si matrice d amortissement *
  22. * 2 si matrice de rigidite antisymetrique *
  23. * 3 si matrice d amortissement en frequentiel *
  24. * (amortissement corotatif) *
  25. * *
  26. * SORTIES : *
  27. * ________ *
  28. * *
  29. * IPRIG pointeur sur la rigidite construite *
  30. * =0 en cas d'erreur (et IERR non nul) *
  31. * *
  32. *---------------------------------------------------------------------*
  33.  
  34. IMPLICIT INTEGER(I-N)
  35. IMPLICIT REAL*8(A-H,O-Z)
  36. *
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC CCHAMP
  41. -INC CCGEOME
  42. -INC CCREEL
  43. *
  44. -INC SMCHAML
  45. -INC SMINTE
  46. -INC SMELEME
  47. -INC SMRIGID
  48. -INC SMMODEL
  49. -INC SMCOORD
  50. -INC SMLREEL
  51. *
  52. INTEGER oooval
  53.  
  54. SEGMENT INFO
  55. INTEGER INFELL(JG)
  56. ENDSEGMENT
  57. *
  58. SEGMENT NOTYPE
  59. CHARACTER*16 TYPE(NBTYPE)
  60. ENDSEGMENT
  61. *
  62. SEGMENT MPTVAL
  63. INTEGER IPOS(NS) ,NSOF(NS)
  64. INTEGER IVAL(NCOSOU)
  65. CHARACTER*16 TYVAL(NCOSOU)
  66. ENDSEGMENT
  67. *
  68. segment modsta
  69. integer pimoda(nmoda),pistat(nstat)
  70. integer ivmoda(nmoda),ivstat(nstat)
  71. endsegment
  72. *
  73. CHARACTER*8 CMATE
  74. CHARACTER*(NCONCH) CONM
  75.  
  76. PARAMETER ( INTTYP=3 )
  77. * INTTYP DEFINIT LE TYPE DE POINTS D'INTEGRATION
  78. * UTILISE PAR RIGI
  79. PARAMETER ( NINF=3 )
  80. INTEGER INFOS(NINF)
  81. *
  82. LOGICAL lsupfo,lsupde,BDPGE,brend,lsupma,dcmate,dcmat2
  83. *
  84. IPRIG = 0
  85. *
  86. * ACTIVATION DU MODELE
  87. * --------------------
  88. * MODORI = Modele initial complet
  89. * IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX")
  90. CALL PIMODL(MODORI,IPMODL,0)
  91. IF (IPMODL.EQ.0) RETURN
  92. *
  93. * VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  94. * ZZZZZZZZ PEUT ETRE A FAIRE PLUTOT SUR LES SOUS-ZONES
  95. *
  96. ISUP1 = 0
  97. CALL QUESUP(IPMODL,IPCHE1,INTTYP,0,ISUP1,IRET1)
  98. IF (ISUP1.GT.1) RETURN
  99. *
  100. ISUPM = ISUP1
  101. ISUPC = ISUP1
  102. IPCHE2 = 0
  103. * IPMODL est ACTIF en retour (nouveau pointeur pouvant etre detruit)
  104. MMODEL=IPMODL
  105. NSOUS = KMODEL(/1)
  106. *
  107. * INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE
  108. * ---------------------------------------------
  109. JRIGE = 0
  110. NRIGEL = 0
  111. SEGINI MRIGID
  112. MTYMAT = 'AMORTISS'
  113. IFORIG = IFOUR
  114. ICHOLE = 0
  115. IMGEO1 = 0
  116. IMGEO2 = 0
  117. ISUPEQ = 0
  118. * termes croises STATIQUE et/ou MODAL
  119. nstat = 100
  120. kstat = 0
  121. nmoda = 100
  122. kmoda = 0
  123. segini modsta
  124. *
  125. *--------------------------------------------------------------------*
  126. *
  127. * BOUCLE SUR LES ZONES ELEMENTAIRES ( MEME TYPE D'EF )
  128. *
  129. *--------------------------------------------------------------------*
  130. *
  131. DO 500 ISOMO=1,NSOUS
  132.  
  133. IMODEL = KMODEL(ISOMO)
  134. SEGACT,IMODEL
  135. *
  136. IF (FORMOD(1).EQ.'LIAISON') GOTO 5990
  137. *
  138. * INITIALISATIONS
  139. *
  140. IPMINT = 0
  141. IPMIN1 = 0
  142.  
  143. MOMATR = 0
  144. MOCARA = 0
  145. MOTYPM = 0
  146. MOTYPC = 0
  147.  
  148. MODEPL = 0
  149. MOFORC = 0
  150. lsupde = .false.
  151. lsupfo = .false.
  152.  
  153. IDESCR = 0
  154.  
  155. C- Recuperation d'informations sur le maillage elementaire
  156. IPMAIL = imodel.IMAMOD
  157. CONM = imodel.CONMOD
  158.  
  159. IPT1 = imodel.IMAMOD
  160. SEGACT,IPT1
  161. NBNOE1 = IPT1.NUM(/1)
  162. NBELE1 = IPT1.NUM(/2)
  163.  
  164. C- Quelques informations sur le modele
  165.  
  166. IIPDPG = imodel.IPDPGE
  167. IIPDPG = IPTPOI(IIPDPG)
  168.  
  169. CMATE = CMATEE
  170. MATE = IMATEE
  171. INAT = INATUU
  172.  
  173. dcmate = .false.
  174. dcmat2 = .false.
  175. do im = 1,matmod(/2)
  176. if (matmod(im).eq.'IMPEDANCE') then
  177. dcmate =.true.
  178. if(tymode(/2).gt.0)then
  179. if(tymode(1).eq.'LISTMOTS') dcmat2 = .true.
  180. endif
  181. endif
  182. enddo
  183.  
  184. IRTD = 1
  185. CALL IDENT(IPT1,CONM,IPCHE1,IPCHE2, INFOS,IRTD)
  186. IF (IRTD.EQ.0) GOTO 5991
  187. C
  188. C- Recuperation d'informations sur l'element fini
  189. MELE = NEFMOD
  190. C Cas particulier : POI1/SEG2 et IMPEDANCE
  191. IF (dcmate) THEN
  192. IF (ipt1.itypel.EQ.1) MELE = 45
  193. IF (ipt1.itypel.EQ.2) MELE = 2
  194. ENDIF
  195. c
  196. C COQUE INTEGREE OU PAS ?
  197. IF (INFMOD(/1).NE.0)THEN
  198. NPINT=INFMOD(1)
  199. ELSE
  200. NPINT=0
  201. ENDIF
  202.  
  203. if (infmod(/1).lt.2+inttyp) then
  204. CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL)
  205. IF ( IERR.NE.0 ) GOTO 5991
  206. INFO = IPINF
  207. LHOOK = INFELL(10)
  208. NSTRS = INFELL(16)
  209. MFR = INFELL(13)
  210. LW = INFELL(7)
  211. LRE = INFELL(9)
  212. NDDL = INFELL(15)
  213. IELE = INFELL( 14)
  214. IPORE = INFELL(8)
  215. IPMINT= INFELL(11)
  216. IPMIN1= INFELL(12)
  217. NBPGAU= INFELL( 6)
  218. C* ICARA = INFELL( 5)
  219. segsup info
  220. ELSE
  221. LHOOK = INFELE(10)
  222. NSTRS = INFELE(16)
  223. MFR = INFELE(13)
  224. LW = INFELE(7)
  225. LRE = INFELE(9)
  226. NDDL = INFELE(15)
  227. IELE = INFELE( 14)
  228. IPORE = INFELE(8)
  229. IPMINT=INFMOD(2+INTTYP)
  230. C* IPMINT = INFELE(11)
  231. IPMIN1= INFMOD(8)
  232. NBPGAU= INFELE( 6)
  233. C* ICARA = INFELE( 5)
  234. ENDIF
  235. c* LHOO2 = LHOOK*LHOOK
  236.  
  237. CALL INFDPG(MFR,IFOUR, BDPGE,NDPGE)
  238. IF (BDPGE) THEN
  239. IF (IIPDPG.LE.0) THEN
  240. CALL ERREUR(925)
  241. GOTO 5991
  242. ENDIF
  243. ENDIF
  244.  
  245. IPPORE=0
  246. IF(MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN
  247. IPPORE=NBNNE(NUMGEO(MELE))
  248. ENDIF
  249.  
  250. MINTE = IPMINT
  251. IF (IPMINT.NE.0) SEGACT,MINTE
  252. *
  253. C- RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX
  254. *
  255. if (lnomid(1).ne.0) then
  256. modepl=lnomid(1)
  257. else
  258. lsupde=.true.
  259. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  260. endif
  261. nomid=MODEPL
  262. segact nomid
  263. ndepl=lesobl(/2)
  264. c* ndum = lesfac(/2)
  265. *
  266. if (lnomid(2).ne.0) then
  267. moforc = lnomid(2)
  268. else
  269. lsupfo=.true.
  270. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  271. endif
  272. nomid=MOFORC
  273. segact nomid
  274. nforc=lesobl(/2)
  275. c* ndum = lesfac(/2)
  276. *
  277. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  278. CALL ERREUR(5)
  279. GOTO 598
  280. ENDIF
  281. *
  282. * REMPLISSAGE DU SEGMENT DESCRIPTEUR
  283. *
  284. NCOMP = NDEPL
  285. NBNNS = NBNOE1
  286. NBNN = NBNOE1
  287. *PV idecap pas defini
  288. ** IF (MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN
  289. ** NCOMP = NDEPL-IDECAP
  290. ** ENDIF
  291. IF (BDPGE) THEN
  292. NCOMP = NDEPL - NDPGE
  293. NBNN = NBNOE1 + 1
  294. ENDIF
  295. IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  296. NBNNS = NBNN / 2
  297. ENDIF
  298. *
  299. NFAC = NBNNS
  300. IF (MELE.GE.108.AND.MELE.LE.110)
  301. & NFAC = MIN(NFAC,(3*NBNN-IPORE)/2)
  302. *
  303. NLIGRP = LRE
  304. NLIGRD = LRE
  305. * erreur dans les dimensions de DESCR
  306. * le mode de calcul n'est pas correct
  307. IF (NBNNS*NCOMP .GT. NLIGRD) THEN
  308. CALL ERREUR(717)
  309. GOTO 598
  310. ENDIF
  311.  
  312. SEGINI,DESCR
  313.  
  314. IDDL = 1
  315. DO 1004 INOEUD=1,NFAC
  316. DO 1005 ICOMP=1,NCOMP
  317. NOMID=MODEPL
  318. LISINC(IDDL)=LESOBL(ICOMP)
  319. if (dcmat2) then
  320. if (inoeud.eq.2) then
  321. LISINC(IDDL)=LESFAC(ICOMP)
  322. endif
  323. endif
  324. NOMID=MOFORC
  325. LISDUA(IDDL)=LESOBL(ICOMP)
  326. if (dcmat2) then
  327. if (inoeud.eq.2) then
  328. LISDUA(IDDL)=LESFAC(ICOMP)
  329. endif
  330. endif
  331. NOELEP(IDDL)=INOEUD
  332. NOELED(IDDL)=INOEUD
  333. IDDL=IDDL+1
  334. 1005 CONTINUE
  335. 1004 CONTINUE
  336. *
  337. * CAS DES ELEMENT RACCORD
  338. *
  339. IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  340. CALL IDPRIM(IMODEL,MFR+1000,MODPL,NDEPL,NDUM)
  341. CALL IDDUAL(IMODEL,MFR+1000,MOFRC,NFORC,NDUM)
  342. NOMID=MODPL
  343. SEGACT NOMID
  344. NOMID=MOFRC
  345. SEGACT NOMID
  346. DO 1106 INOEUD=NBNNS+1,NBNN
  347. DO 1107 ICOMP=1,NDEPL
  348. NOMID=MODPL
  349. LISINC(IDDL)=LESOBL(ICOMP)
  350. NOMID=MOFRC
  351. LISDUA(IDDL)=LESOBL(ICOMP)
  352. NOELEP(IDDL)=INOEUD
  353. NOELED(IDDL)=INOEUD
  354. IDDL=IDDL+1
  355. 1107 CONTINUE
  356. 1106 CONTINUE
  357. NOMID=MODPL
  358. SEGSUP,NOMID
  359. NOMID=MOFRC
  360. SEGSUP,NOMID
  361. ENDIF
  362. *
  363. SEGDES,DESCR
  364. IDESCR = DESCR
  365. 1999 continue
  366. *
  367. * TRAITEMENT DES CHAMPS EN ENTREE
  368. * -------------------------------
  369. *
  370. NBROBL = 0
  371. NBRFAC = 0
  372. NOMID = 0
  373. NOTYPE = 0
  374. *
  375. * >>> CHAMP DE MATERIAU
  376. *
  377. C* IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
  378. IF (FORMOD(1).EQ.'MECANIQUE'.AND.MATE.EQ.1.AND..NOT.dcmate) THEN
  379. IF (MFR.EQ.35) THEN
  380. NBROBL=2
  381. SEGINI NOMID
  382. LESOBL(1)='KS '
  383. LESOBL(2)='KN '
  384. ELSE IF(MFR.EQ.53) THEN
  385. NBROBL=1
  386. SEGINI,NOMID
  387. LESOBL(1)='KS '
  388. ELSE
  389. NBROBL=2
  390. SEGINI NOMID
  391. LESOBL(1)='VISQ'
  392. LESOBL(2)='NU '
  393. ENDIF
  394. NBTYPE=1
  395. SEGINI NOTYPE
  396. TYPE(1)='REAL*8'
  397. C* ELSE IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
  398. ELSE IF (FORMOD(1).EQ.'MECANIQUE'.AND.MATE.EQ.4) THEN
  399. IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  400. NBROBL=7
  401. SEGINI NOMID
  402. LESOBL(1)='VISQ'
  403. LESOBL(2)='V1X '
  404. LESOBL(3)='V1Y '
  405. LESOBL(4)='V1Z '
  406. LESOBL(5)='V2X '
  407. LESOBL(6)='V2Y '
  408. LESOBL(7)='V2Z '
  409. ELSE
  410. NBROBL=3
  411. SEGINI NOMID
  412. LESOBL(1)='VISQ'
  413. LESOBL(2)='V1X '
  414. LESOBL(3)='V1Y '
  415. ENDIF
  416. NBTYPE=1
  417. SEGINI NOTYPE
  418. TYPE(1)='REAL*8'
  419. *
  420. C* ELSE IF (INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  421. ELSEIF(INAT.EQ.67.AND. MATE.EQ.2) THEN
  422. NBROBL=6
  423. SEGINI NOMID
  424. LESOBL(1)='YG1 '
  425. LESOBL(2)='YG2 '
  426. LESOBL(3)='NU12'
  427. LESOBL(4)='G12 '
  428. LESOBL(5)='V1X '
  429. LESOBL(6)='V1Y '
  430. NBTYPE=1
  431. SEGINI NOTYPE
  432. TYPE(1)='REAL*8'
  433. *
  434. C* ELSEIF (CMATE.EQ.'SECTION') THEN
  435. ELSE IF (MATE.EQ.11) THEN
  436. C
  437. C MODELE ET MATERIAU DE LA SECTION DU MODELE A FIBRE
  438. C
  439. NBROBL=2
  440. SEGINI NOMID
  441. LESOBL(1)='MODS'
  442. LESOBL(2)='MATS'
  443. NBTYPE=2
  444. SEGINI NOTYPE
  445. TYPE(1)='POINTEURMMODEL'
  446. TYPE(2)='POINTEURMCHAML'
  447. C
  448. ELSEIF (CMATE.EQ.'MODAL') THEN
  449. NBROBL=3
  450. NBRFAC=1
  451. SEGINI NOMID
  452. LESOBL(1)='FREQ'
  453. LESOBL(2)='MASS'
  454. LESOBL(3)='DEFO'
  455. LESFAC(1) ='AMOR'
  456. NBTYPE=4
  457. SEGINI NOTYPE
  458. TYPE(1)='REAL*8'
  459. TYPE(2)='REAL*8'
  460. TYPE(3)='POINTEURCHPOINT'
  461. TYPE(4)='REAL*8'
  462.  
  463. ELSEIF (CMATE.EQ.'STATIQUE') THEN
  464. NBROBL=3
  465. NBRFAC=1
  466. SEGINI NOMID
  467. LESOBL(1)='DEFO'
  468. LESOBL(2)='RIDE'
  469. LESOBL(3)='MADE'
  470. LESFAC(1) ='AMOR'
  471. NBTYPE=4
  472. SEGINI NOTYPE
  473. TYPE(1)='POINTEURCHPOINT'
  474. TYPE(2)='POINTEURCHPOINT'
  475. TYPE(3)='POINTEURCHPOINT'
  476. TYPE(4)='REAL*8'
  477.  
  478. ELSE IF (dcmate) THEN
  479. IF (CMATE.EQ.'IMPCOMPL') THEN
  480. *
  481. * IMPEDANCE COMPLEXE
  482. *
  483. NBROBL=0
  484. NBRFAC=1
  485. SEGINI NOMID
  486. MOMATR=NOMID
  487. LESFAC(1)='VISC'
  488. *
  489. NBTYPE=1
  490. SEGINI NOTYPE
  491. MOTYPE=NOTYPE
  492. TYPE(1)='REAL*8'
  493.  
  494. ELSE
  495. NBROBL=0
  496. NBRFAC=2
  497. SEGINI NOMID
  498. MOMATR=NOMID
  499. LESFAC(1) ='AMOR'
  500. LESFAC(2) ='AROT'
  501. *
  502. NBTYPE=1
  503. SEGINI NOTYPE
  504. MOTYPE=NOTYPE
  505. TYPE(1)='REAL*8'
  506.  
  507. ENDIF
  508.  
  509. *
  510. ELSE
  511. C* CALL IDMATR(MFR,IMODEL,MOMATR,NBROBL,NBRFAC)
  512. C* NOMID = MOMATR
  513. C* NBTYPE=1
  514. C* SEGINI NOTYPE
  515. C* TYPE(1)='REAL*8'
  516. ENDIF
  517. *
  518. *
  519. MOMATR = NOMID
  520. MOTYPM = NOTYPE
  521. *
  522. NMATR = NBROBL
  523. NMATF = NBRFAC
  524. NMATT = NMATR+NMATF
  525. *
  526. * >>> CHAMPS DE CARACTERISTIQUES
  527. *
  528. NBROBL = 0
  529. NBRFAC = 0
  530. IVECT = 0
  531. NOMID = 0
  532. NOTYPE = 0
  533. *
  534. * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  535. *
  536. IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.
  537. + ((MELE.GE.79.AND.MELE.LE.83).OR.
  538. + (MELE.GE.173.AND.MELE.LE.182)))
  539. + .AND.IFOUR.EQ.-2)THEN
  540. NBRFAC=1
  541. SEGINI NOMID
  542. LESFAC(1)='DIM3'
  543. *
  544. NBTYPE=1
  545. SEGINI NOTYPE
  546. TYPE(1)='REAL*8'
  547. *
  548. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  549. *
  550. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  551. NBROBL=1
  552. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  553. NBRFAC=2
  554. ELSE
  555. NBRFAC=1
  556. ENDIF
  557. SEGINI NOMID
  558. LESOBL(1)='EPAI'
  559. LESFAC(1)='EXCE'
  560. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) LESFAC(2)='DIM3'
  561. *
  562. NBTYPE=1
  563. SEGINI NOTYPE
  564. TYPE(1)='REAL*8'
  565. *
  566. * SECTION POUR LES BARRES ET LES CERCES
  567. *
  568. ELSE IF (MFR.EQ.27) THEN
  569. IF(.NOT.dcmate) THEN
  570. NBROBL=1
  571. SEGINI NOMID
  572. LESOBL(1)='SECT'
  573. *
  574. NBTYPE=1
  575. SEGINI NOTYPE
  576. TYPE(1)='REAL*8'
  577. ENDIF
  578. *
  579. * section, excentrements et orientation pour les barres excentrees
  580. *
  581. ELSE IF (MFR.EQ.49) THEN
  582. NBROBL=6
  583. SEGINI NOMID
  584. LESOBL(1)='SECT'
  585. LESOBL(2)='EXCZ'
  586. LESOBL(3)='EXCY'
  587. LESOBL(4)='VX '
  588. LESOBL(5)='VY '
  589. LESOBL(6)='VZ '
  590.  
  591. NBTYPE=1
  592. SEGINI NOTYPE
  593. TYPE(1)='REAL*8'
  594.  
  595. * CARACTERISTIQUES POUR LES POUTRES
  596. *
  597. ELSE IF (MFR.EQ.7 ) THEN
  598. if (dcmate) then
  599. NBROBL=0
  600. NBRFAC=1
  601. SEGINI NOMID
  602. MOCARA=NOMID
  603. LESFAC(1)='VECT'
  604. IVECT=1
  605. *
  606. NBTYPE=1
  607. SEGINI NOTYPE
  608. MOTYPE=NOTYPE
  609. TYPE(1)='POINTEURPOINT '
  610. else
  611. C MODELE A FIBRE
  612. C* IF (CMATE.EQ.'SECTION') THEN
  613. IF (MATE.EQ.11) THEN
  614. IF (ICAS.EQ.2) THEN
  615. NBRFAC=2
  616. SEGINI NOMID
  617. LESFAC(1)='OMEG'
  618. LESFAC(2)='VECT'
  619. IVECT=1
  620. NBTYPE=2
  621. SEGINI NOTYPE
  622. TYPE(1)='REAL*8'
  623. TYPE(2)='POINTEURPOINT '
  624. ELSE
  625. NBRFAC=1
  626. SEGINI NOMID
  627. LESFAC(1)='VECT'
  628. IVECT=1
  629. NBTYPE=1
  630. SEGINI NOTYPE
  631. TYPE(1)='POINTEURPOINT '
  632. ENDIF
  633. *
  634. * POUTRE STANDARD
  635. * CAS 2D
  636. *
  637. ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  638. NBROBL=2
  639. NBRFAC=1
  640. SEGINI NOMID
  641. LESOBL(1)= 'SECT'
  642. LESOBL(2)= 'INRZ'
  643. LESFAC(1)= 'SECY'
  644. *
  645. NBTYPE=1
  646. SEGINI NOTYPE
  647. TYPE(1)='REAL*8'
  648.  
  649. * CAS 3D
  650. *
  651. ELSE
  652. *
  653. * AMORTISSEMENT COROTATIF
  654. *
  655. IF (ICAS.EQ.2) THEN
  656. NBROBL=4
  657. NBRFAC=4
  658. SEGINI NOMID
  659. LESOBL(1)='TORS'
  660. LESOBL(2)='INRY'
  661. LESOBL(3)='INRZ'
  662. LESOBL(4)='SECT'
  663. LESFAC(1)='SECY'
  664. LESFAC(2)='SECZ'
  665. LESFAC(3)='OMEG'
  666. LESFAC(4)='VECT'
  667. IVECT=1
  668. *
  669. NBTYPE=8
  670. SEGINI NOTYPE
  671. TYPE(1)='REAL*8'
  672. TYPE(2)='REAL*8'
  673. TYPE(3)='REAL*8'
  674. TYPE(4)='REAL*8'
  675. TYPE(5)='REAL*8'
  676. TYPE(6)='REAL*8'
  677. TYPE(7)='REAL*8'
  678. TYPE(8)='POINTEURPOINT '
  679. ELSE
  680. *
  681. * AMORTISSEMENT STANDARD
  682. *
  683. NBROBL=4
  684. NBRFAC=3
  685. SEGINI NOMID
  686. LESOBL(1)='TORS'
  687. LESOBL(2)='INRY'
  688. LESOBL(3)='INRZ'
  689. LESOBL(4)='SECT'
  690. LESFAC(1)='SECY'
  691. LESFAC(2)='SECZ'
  692. LESFAC(3)='VECT'
  693. IVECT=1
  694. *
  695. NBTYPE=7
  696. SEGINI NOTYPE
  697. TYPE(1)='REAL*8'
  698. TYPE(2)='REAL*8'
  699. TYPE(3)='REAL*8'
  700. TYPE(4)='REAL*8'
  701. TYPE(5)='REAL*8'
  702. TYPE(6)='REAL*8'
  703. TYPE(7)='POINTEURPOINT '
  704. ENDIF
  705. ENDIF
  706. endif
  707. *
  708. * CARACTERISTIQUES POUR LES TUYAUX
  709. *
  710. ELSE IF (MFR.EQ.13) THEN
  711. IF (ICAS.EQ.2) THEN
  712. NBROBL=2
  713. NBRFAC=5
  714. SEGINI NOMID
  715. LESOBL(1)='EPAI'
  716. LESOBL(2)='RAYO'
  717. LESFAC(1)='RACO'
  718. LESFAC(2)='PRES'
  719. LESFAC(3)='CISA'
  720. LESFAC(4)='OMEG'
  721. LESFAC(5)='VECT'
  722. IVECT=1
  723. *
  724. NBTYPE=7
  725. SEGINI NOTYPE
  726. TYPE(1)='REAL*8'
  727. TYPE(2)='REAL*8'
  728. TYPE(3)='REAL*8'
  729. TYPE(4)='REAL*8'
  730. TYPE(5)='REAL*8'
  731. TYPE(6)='REAL*8'
  732. TYPE(7)='POINTEURPOINT '
  733. ELSE
  734. NBROBL=2
  735. NBRFAC=4
  736. SEGINI NOMID
  737. LESOBL(1)='EPAI'
  738. LESOBL(2)='RAYO'
  739. LESFAC(1)='RACO'
  740. LESFAC(2)='PRES'
  741. LESFAC(3)='CISA'
  742. LESFAC(4)='VECT'
  743. IVECT=1
  744. *
  745. NBTYPE=6
  746. SEGINI NOTYPE
  747. TYPE(1)='REAL*8'
  748. TYPE(2)='REAL*8'
  749. TYPE(3)='REAL*8'
  750. TYPE(4)='REAL*8'
  751. TYPE(5)='REAL*8'
  752. TYPE(6)='POINTEURPOINT '
  753. ENDIF
  754. *
  755. ELSE IF (MFR.EQ.39) THEN
  756. IF (ICAS.EQ.2) THEN
  757. NBROBL=2
  758. NBRFAC=4
  759. SEGINI NOMID
  760. LESOBL(1)='EPAI'
  761. LESOBL(2)='RAYO'
  762. LESFAC(1)='RACO'
  763. LESFAC(2)='PRES'
  764. LESFAC(3)='OMEG'
  765. LESFAC(4)='VECT'
  766. IVECT=1
  767.  
  768. NBTYPE=6
  769. SEGINI NOTYPE
  770. TYPE(1)='REAL*8'
  771. TYPE(2)='REAL*8'
  772. TYPE(3)='REAL*8'
  773. TYPE(4)='REAL*8'
  774. TYPE(5)='REAL*8'
  775. TYPE(6)='POINTEURPOINT '
  776.  
  777. ELSE
  778. NBROBL=2
  779. NBRFAC=3
  780. SEGINI NOMID
  781. LESOBL(1)='EPAI'
  782. LESOBL(2)='RAYO'
  783. LESFAC(1)='RACO'
  784. LESFAC(2)='PRES'
  785. LESFAC(3)='VECT'
  786. IVECT=1
  787.  
  788. NBTYPE=5
  789. SEGINI NOTYPE
  790. TYPE(1)='REAL*8'
  791. TYPE(2)='REAL*8'
  792. TYPE(3)='REAL*8'
  793. TYPE(4)='REAL*8'
  794. TYPE(5)='POINTEURPOINT '
  795. ENDIF
  796. ENDIF
  797.  
  798. * Rendement :
  799. * Notion non utilisee actuellement (mais conserver a titre historique !)
  800. IF (NOMID.LE.0) THEN
  801. NBROBL = 0
  802. NBRFAC = 0
  803. SEGINI,NOMID
  804. NBTYPE = 0
  805. SEGINI,NOTYPE
  806. ENDIF
  807. ncar1 = NBROBL + NBRFAC + 1
  808. ifac = NBRFAC
  809. NBRFAC = NBRFAC + 10
  810. SEGADJ,NOMID
  811. LESFAC(ifac + 1) = 'REND'
  812. LESFAC(ifac + 2) = 'W1X '
  813. LESFAC(ifac + 3) = 'W1Y '
  814. LESFAC(ifac + 4) = 'W1Z '
  815. LESFAC(ifac + 5) = 'W2X '
  816. LESFAC(ifac + 6) = 'W2Y '
  817. LESFAC(ifac + 7) = 'W2Z '
  818. LESFAC(ifac + 8) = 'REN1'
  819. LESFAC(ifac + 9) = 'REN2'
  820. LESFAC(ifac + 10) = 'REN3'
  821. NBTYPE = NBTYPE + 1
  822. SEGADJ,NOTYPE
  823. TYPE(NBTYPE) = 'REAL*8'
  824. *
  825. MOCARA = NOMID
  826. MOTYPC = NOTYPE
  827. NCARA = NBROBL
  828. NCARF = NBRFAC
  829. NCARR = NCARA+NCARF
  830.  
  831. C- Partionnement si necessaire de la matrice d'amortissement
  832. C- determinant ainsi le nombre d'objets elementaires de MRIGID
  833. LTRK = oooval(1,4)
  834. IF (LTRK.EQ.0) LTRK = oooval(1,1)
  835. LTRK=MAX(LTRK,2**24)
  836. * Ajout a la taille en mots de la matrice des infos du segment
  837. LSEG = LRE*LRE*NBELE1 + 16
  838. NBLPRT = (LSEG-1)/LTRK + 1
  839. NBLMAX = (NBELE1-1)/NBLPRT + 1
  840. NBLPRT = (NBELE1-1)/NBLMAX + 1
  841. * write(ioimp,*) ' amor1 : nblprt nblmax = ',nblprt,nblmax,nbele1
  842.  
  843. descr = IDESCR
  844. meleme = IPT1
  845. nbnn = NBNOE1
  846. nbelem = NBELE1
  847. nbsous = 0
  848. nbref = 0
  849. *
  850. ************************************************************************
  851. * P H A S E 2
  852. *
  853. * Boucle sur les PARTITIONS elementaires de la matrice
  854. *
  855. ************************************************************************
  856. isous = 0
  857. DO irige = 1, NBLPRT
  858.  
  859. IF (NBLPRT.GT.1) THEN
  860. C- Partitionnement du maillage support de la matrice elementaire
  861. C- (IPT1 peut etre desactive suite a l'appel a KOMCHA !)
  862. SEGACT,IPT1
  863. ielem = (irige-1)*NBLMAX
  864. nbelem = MIN(NBLMAX,NBELE1-ielem)
  865. * write(ioimp,*) ' creation segment ',nbnn,nbelem
  866. SEGINI,meleme
  867. itypel = IPT1.itypel
  868. DO ielt = 1, nbelem
  869. jelt = ielt + ielem
  870. DO inoe = 1, nbnn
  871. num(inoe,ielt) = IPT1.NUM(inoe,jelt)
  872. ENDDO
  873. icolor(ielt) = IPT1.ICOLOR(jelt)
  874. ENDDO
  875. C- Recopie du descripteur
  876. des1 = IDESCR
  877. SEGINI,descr=des1
  878. SEGDES,descr
  879. ENDIF
  880.  
  881. C- Cas particulier en DEFO PLAN GENE
  882. IF (BDPGE) THEN
  883. c* nbelem = NUM(/2)
  884. nbnn = NBNOE1 + 1
  885. SEGINI,ipt2
  886. ipt2.itypel = 28
  887. DO ielt = 1,nbelem
  888. DO inoe = 1,NBNOE1
  889. ipt2.num(inoe,ielt) = NUM(inoe,ielt)
  890. ENDDO
  891. ipt2.num(nbnn,ielt) = IIPDPG
  892. ipt2.icolor(ielt) = ICOLOR(jelt)
  893. ENDDO
  894. SEGDES,IPT2
  895. nbnn = NBNOE1
  896. ELSE
  897. ipt2 = meleme
  898. ENDIF
  899.  
  900. ipmail = meleme
  901. ipdesc = descr
  902. ipmadg = ipt2
  903.  
  904. C- Initialisation de la matrice de rigidite elementaire (xmatri)
  905. NELRIG = nbelem
  906. SEGINI,xmatri
  907. ipmatr = xmatri
  908.  
  909. C- Recuperation des valeurs des proprietes materiau et geometriques
  910. IVAMAT = 0
  911. IVACAR = 0
  912. brend = .FALSE.
  913. *
  914. CALL KOMCHA(IPCHE1,ipmail,CONM,MOMATR,MOTYPM,1,INFOS,3,IVAMAT)
  915. IF (IERR.NE.0) GOTO 597
  916. IF (ISUPM.EQ.1) THEN
  917. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  918. IF (IERR.NE.0) THEN
  919. ISUPM = 0
  920. GOTO 597
  921. ENDIF
  922. ENDIF
  923.  
  924. if (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') then
  925. mptval = ivamat
  926. segact mptval
  927. if (ival(/1).lt.3) call erreur(5)
  928. endif
  929. if (cmate.eq.'STATIQUE') then
  930. kstat = kstat + 1
  931. ivstat(kstat) = ivamat
  932. pistat(kstat) = imodel
  933. if (kstat.eq.nstat) then
  934. nstat = nstat + 100
  935. segadj modsta
  936. endif
  937. endif
  938. if (cmate.eq.'MODAL') then
  939. kmoda = kmoda + 1
  940. ivmoda(kmoda) = ivamat
  941. pimoda(kmoda) = imodel
  942. if (kmoda.eq.nmoda) then
  943. nmoda = nmoda + 100
  944. segadj modsta
  945. endif
  946. endif
  947. if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') then
  948. if (ival(4).eq.0) goto 519
  949. endif
  950.  
  951. MPTVAL = IVAMAT
  952. NBGMAT = 0
  953. NELMAT = 0
  954. DO i = 1,NMATT
  955. IF (IVAL(i).NE.0) THEN
  956. MELVAL = IVAL(i)
  957. C* IF (CMATE.EQ.'SECTION') THEN
  958. IF (MATE.EQ.11) THEN
  959. NBGMAT = MAX(NBGMAT,IELCHE(/1))
  960. NELMAT = MAX(NELMAT,IELCHE(/2))
  961. ELSE
  962. NBGMAT = MAX(NBGMAT,VELCHE(/1))
  963. NELMAT = MAX(NELMAT,VELCHE(/2))
  964. ENDIF
  965. ENDIF
  966. ENDDO
  967.  
  968. IF (MOCARA.NE.0) THEN
  969. CALL KOMCHA(IPCHE1,ipmail,CONM,MOCARA,MOTYPC,1,
  970. & INFOS,3,IVACAR)
  971. IF (IERR.NE.0) GOTO 597
  972. IF (ISUPC.EQ.1) THEN
  973. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  974. IF (IERR.NE.0) THEN
  975. ISUPC = 0
  976. GOTO 597
  977. ENDIF
  978. ENDIF
  979. * Rendement :
  980. mptval = IVACAR
  981. IF (ival(/1).GE.ncar1+9) THEN
  982. brend = ival(ncar1+7).GT.0 .OR. ival(ncar1+8).GT.0 .OR.
  983. & ival(ncar1+9).GT.0
  984. ENDIF
  985. ENDIF
  986.  
  987. isous = isous + 1
  988. imod = imodel
  989. if (dcmate.and.mele.eq.2) goto 29
  990.  
  991. ************************************************************************
  992. * P H A S E 3
  993. *
  994. * CALCUL DES RIGIDITES ELEMENTAIRES
  995. *
  996. ************************************************************************
  997. *
  998. * NUMERO DES ETIQUETTES :
  999. * Les elements sont groupes comme suit :
  1000. * - massif,liquide 'surface libre' poreux ----------------------> r
  1001. * - coq3,dkt,coq4,coq8,coq2,dst --------------------------------> r
  1002. * - poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,jot3> r
  1003. * - joi4,joi2,poutre de timoschenko,joi3
  1004. *
  1005. * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  1006. GOTO ( 99, 99, 99, 4, 99, 4, 99, 4, 99, 4, 99
  1007. * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  1008. & , 99, 99, 4 , 4, 4, 4, 99, 99, 99, 99, 99
  1009. * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6
  1010. & , 4, 4, 4, 4, 27, 27, 29, 29, 99, 99, 99
  1011. * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  1012. & , 99, 4, 4, 4, 4, 4, 4, 27, 29, 29, 27
  1013. * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  1014. & , 29, 29, 99, 4, 27, 99, 99, 99, 4, 4, 99
  1015. * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  1016. & , 27, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1017. * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  1018. & , 99, 99, 4, 4, 4, 4, 99, 99, 99, 99, 99
  1019. * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  1020. & , 99, 99, 99, 99, 99, 99, 29, 29, 29, 29, 29
  1021. * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3
  1022. & , 99, 99, 99, 29, 27, 99, 29, 29, 29, 29, 99
  1023. * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  1024. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1025. * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  1026. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1027. * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  1028. & , 99, 29, 29, 29, 99, 99, 99, 99, 99, 99, 99
  1029. * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  1030. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1031. * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  1032. & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99
  1033. * TE56 PY91 TRH6
  1034. & , 99, 99, 99),MELE
  1035. C
  1036. C CASE OF THE NEW JOINT ELEMENTS (JCT3 AND JCI4 IN 2D SHEAR)
  1037. C (JGI2 2D GENERALIZED)
  1038. C (JGT3 AND JGI4 GENERALIZED)
  1039. IF (MELE.GE.168.AND.MELE.LE.172)GOTO 29
  1040. IF (MELE.GE.173.OR.MELE.LE.184) GO TO 4
  1041. C
  1042. 99 CONTINUE
  1043. MOTERR(1:4) = NOMTP(MELE)
  1044. MOTERR(9:12)= 'AMOR1'
  1045. CALL ERREUR(86)
  1046. GOTO 510
  1047. C_______________________________________________________________________
  1048. C
  1049. C massif
  1050. C_______________________________________________________________________
  1051. C
  1052. 4 CONTINUE
  1053. IF (ICAS.EQ.2) GOTO 99
  1054. CALL AMOR2 (MATE,MELE,ipmail,IPMINT,NBPGAU,LRE,NSTRS,IVAMAT,
  1055. & IVACAR,CMATE,MFR,NBGMAT,NELMAT,1,LHOOK,NMATT,
  1056. & IPORE,NDDL,IPMATR,IIPDPG,ncar1)
  1057. GOTO 510
  1058. C_______________________________________________________________________
  1059. C
  1060. C coq3,dkt,coq4,coq8,coq2,dst
  1061. C_______________________________________________________________________
  1062. C
  1063. 27 CONTINUE
  1064. IF (ICAS.EQ.2) GOTO 99
  1065. CALL RIGI3(MATE,MELE,ipmail,IPMINT,IPMIN1,NBPGAU,LRE,NSTRS,
  1066. & IVAMAT,IVACAR,CMATE,MFR,NBGMAT,NELMAT,1,LHOOK,
  1067. & NMATT,LW,NPINT,IPMATR,IIPDPG)
  1068. GOTO 510
  1069. C_______________________________________________________________________
  1070. C
  1071. C poutre,tuyau,linespring,tuyau fissure,barre,joints 2-3D
  1072. C poutre de Timoschenko,point
  1073. C_______________________________________________________________________
  1074. C
  1075. 29 CONTINUE
  1076. n_z = ncar1 - 1
  1077. CALL AMOR4(MATE,MELE,ipmail,IPMINT,NBPGAU,LRE,NSTRS,
  1078. & IVAMAT,IVACAR,IVECT,CMATE,MFR,ICAS,NBGMAT,NELMAT,
  1079. & LHOOK,NMATT,n_z,ISOUS,LW,IPORE,IPMATR,IIPDPG,IMOD)
  1080. GOTO 510
  1081. *
  1082. ************************************************************************
  1083. * P H A S E 4
  1084. *
  1085. * DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  1086. *
  1087. ***********************************************************************
  1088. 510 CONTINUE
  1089. 597 CONTINUE
  1090. if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') goto 518
  1091. IF (ISUPM.EQ.1 .OR. nblprt.GT.1) THEN
  1092. CALL DTMVAL(IVAMAT,3)
  1093. ELSE
  1094. CALL DTMVAL(IVAMAT,1)
  1095. ENDIF
  1096. IF (ISUPC.EQ.1 .OR. nblprt.GT.1) THEN
  1097. CALL DTMVAL(IVACAR,3)
  1098. ELSE
  1099. CALL DTMVAL(IVACAR,1)
  1100. ENDIF
  1101. c* xmatri = ipmatr
  1102. 518 continue
  1103. IF (NBLPRT.GT.1) THEN
  1104. meleme = ipmail
  1105. SEGDES,meleme
  1106. ENDIF
  1107.  
  1108. C- Sortie prematuree en cas d'erreur
  1109. IF (IERR.NE.0) GOTO 598
  1110. C Ajout de la matrice d'AMORTISSEMENT a la matrice globale
  1111. C ========================================================
  1112. NRIGE0 = IRIGEL(/2)
  1113. c NRIGEL = NRIGE0 + NBLPRT
  1114. NRIGEL = NRIGE0 + 1
  1115. SEGADJ,MRIGID
  1116.  
  1117. C- Stockage de la matrice
  1118. c jrige = NRIGE0 + isous
  1119. jrige = NRIGE0 + 1
  1120. COERIG(jrige) = 1.
  1121. IF (BDPGE) THEN
  1122. IRIGEL(1,jrige) = ipmadg
  1123. ELSE
  1124. IRIGEL(1,jrige)=IPMAIL
  1125. ENDIF
  1126. IRIGEL(2,jrige) = 0
  1127. IRIGEL(3,jrige) = ipdesc
  1128. IRIGEL(4,jrige) = ipmatr
  1129. IRIGEL(5,jrige) = NIFOUR
  1130. IRIGEL(6,jrige) = 0
  1131. IF (ICAS.EQ.2) THEN
  1132. IRIGEL(7,jrige) = 2
  1133. xmatri.symre=2
  1134. ELSE IF (MFR.EQ.57.OR.MFR.EQ.59) THEN
  1135. IRIGEL(7,jrige) = 2
  1136. xmatri.symre=2
  1137. ELSE IF (brend) THEN
  1138. IRIGEL(7,jrige) = 2
  1139. xmatri.symre=2
  1140. ELSE
  1141. IRIGEL(7,jrige) = 0
  1142. xmatri.symre=0
  1143. ENDIF
  1144. segdes xmatri
  1145. IRIGEL(8,jrige) = 0
  1146.  
  1147. ENDDO
  1148. C- Fin de la boucle sur les partitions
  1149. *
  1150. 519 continue
  1151. 598 CONTINUE
  1152. IF (MOMATR.NE.0) THEN
  1153. nomid = MOMATR
  1154. SEGSUP,nomid
  1155. notype = MOTYPM
  1156. SEGSUP,notype
  1157. ENDIF
  1158. IF (MOCARA.NE.0) THEN
  1159. nomid = MOCARA
  1160. SEGSUP,nomid
  1161. notype = MOTYPC
  1162. SEGSUP,notype
  1163. ENDIF
  1164. NOMID = MODEPL
  1165. SEGDES,NOMID
  1166. IF (lsupde) SEGSUP,NOMID
  1167. NOMID = MOFORC
  1168. SEGDES,NOMID
  1169. IF (lsupfo) SEGSUP,NOMID
  1170.  
  1171. *
  1172. * Fin de la boucle (5000) de PARTITIONNEMENT du segment XMATRI
  1173. 5000 CONTINUE
  1174.  
  1175. 5991 CONTINUE
  1176. IF (IPMINT.NE.0) SEGDES,MINTE
  1177. SEGDES,IPT1
  1178. 5990 CONTINUE
  1179. SEGDES,IMODEL
  1180.  
  1181. C EN CAS D'ERREUR
  1182. IF (IERR.NE.0) GOTO 999
  1183.  
  1184. 500 CONTINUE
  1185. C* Fin de la boucle sur les modeles elementaires
  1186. NRIGEL = jrige
  1187. segadj mrigid
  1188.  
  1189. *termes croises 'STATIQUE'/'MODAL'
  1190. nstat = kstat
  1191. nmoda = kmoda
  1192. segadj modsta
  1193. ir2 = 0
  1194. if (nstat.ne.0) then
  1195. if (nstat.gt.0) call ricroi(modsta, ir2,3)
  1196. if (nstat.gt.0) then
  1197. do kstat=1,nstat
  1198. mptval = ivstat(kstat)
  1199. segact mptval
  1200. IF (ISUPM.EQ.1) THEN
  1201. CALL DTMVAL(mptval,3)
  1202. ELSE
  1203. CALL DTMVAL(mptval,1)
  1204. ENDIF
  1205. enddo
  1206. endif
  1207. if (nmoda.gt.0) then
  1208. do kmoda=1,nmoda
  1209. mptval = ivmoda(kmoda)
  1210. segact mptval
  1211. IF (ISUPM.EQ.1) THEN
  1212. CALL DTMVAL(mptval,3)
  1213. ELSE
  1214. CALL DTMVAL(mptval,1)
  1215. ENDIF
  1216. enddo
  1217. endif
  1218. endif
  1219.  
  1220. if (ierr.eq.0.and.ir2.gt.0) then
  1221. ir1 = mrigid
  1222. call fusrig(ir1,ir2,ir3)
  1223. mrigid = ir3
  1224. endif
  1225. segsup modsta
  1226.  
  1227. 999 CONTINUE
  1228. IF (IERR.NE.0) THEN
  1229. SEGSUP,MRIGID
  1230. IPRIG = 0
  1231. ELSE
  1232. SEGDES,MRIGID
  1233. IPRIG = MRIGID
  1234. ENDIF
  1235.  
  1236. SEGDES,MMODEL
  1237.  
  1238. RETURN
  1239. END
  1240.  
  1241.  
  1242.  
  1243.  
  1244.  
  1245.  
  1246.  

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