Télécharger amor1.eso

Retour à la liste

Numérotation des lignes :

amor1
  1. C AMOR1 SOURCE CB215821 20/11/25 13:18:18 10792
  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)
  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 = IFOMOD
  114. IFORIG = IFOUR
  115. ICHOLE = 0
  116. IMGEO1 = 0
  117. IMGEO2 = 0
  118. ISUPEQ = 0
  119. * termes croises STATIQUE et/ou MODAL
  120. nstat = 100
  121. kstat = 0
  122. nmoda = 100
  123. kmoda = 0
  124. segini modsta
  125. *
  126. *--------------------------------------------------------------------*
  127. *
  128. * BOUCLE SUR LES ZONES ELEMENTAIRES ( MEME TYPE D'EF )
  129. *
  130. *--------------------------------------------------------------------*
  131. *
  132. DO 500 ISOMO=1,NSOUS
  133.  
  134. IMODEL = KMODEL(ISOMO)
  135. SEGACT,IMODEL
  136. *
  137. IF (FORMOD(1).EQ.'LIAISON') GOTO 5990
  138. *
  139. * INITIALISATIONS
  140. *
  141. IPMINT = 0
  142. IPMIN1 = 0
  143.  
  144. MOMATR = 0
  145. MOCARA = 0
  146. MOTYPM = 0
  147. MOTYPC = 0
  148.  
  149. MODEPL = 0
  150. MOFORC = 0
  151. lsupde = .false.
  152. lsupfo = .false.
  153.  
  154. IDESCR = 0
  155.  
  156. C- Recuperation d'informations sur le maillage elementaire
  157. IPMAIL = imodel.IMAMOD
  158. CONM = imodel.CONMOD
  159.  
  160. IPT1 = imodel.IMAMOD
  161. SEGACT,IPT1
  162. NBNOE1 = IPT1.NUM(/1)
  163. NBELE1 = IPT1.NUM(/2)
  164.  
  165. C- Quelques informations sur le modele
  166.  
  167. IIPDPG = imodel.IPDPGE
  168. IIPDPG = IPTPOI(IIPDPG)
  169.  
  170. CMATE = CMATEE
  171. MATE = IMATEE
  172. INAT = INATUU
  173.  
  174. dcmate = .false.
  175. dcmat2 = .false.
  176. do im = 1,matmod(/2)
  177. if (matmod(im).eq.'IMPEDANCE') then
  178. dcmate =.true.
  179. if(tymode(/2).gt.0)then
  180. if(tymode(1).eq.'LISTMOTS') dcmat2 = .true.
  181. endif
  182. endif
  183. enddo
  184.  
  185. IRTD = 1
  186. CALL IDENT(IPT1,CONM,IPCHE1,IPCHE2, INFOS,IRTD)
  187. IF (IRTD.EQ.0) GOTO 5991
  188. C
  189. C- Recuperation d'informations sur l'element fini
  190. MELE = NEFMOD
  191. C Cas particulier : POI1/SEG2 et IMPEDANCE
  192. IF (dcmate) THEN
  193. IF (ipt1.itypel.EQ.1) MELE = 45
  194. IF (ipt1.itypel.EQ.2) MELE = 2
  195. ENDIF
  196. c
  197. C COQUE INTEGREE OU PAS ?
  198. IF (INFMOD(/1).NE.0)THEN
  199. NPINT=INFMOD(1)
  200. ELSE
  201. NPINT=0
  202. ENDIF
  203.  
  204. if (infmod(/1).lt.2+inttyp) then
  205. CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL)
  206. IF ( IERR.NE.0 ) GOTO 5991
  207. INFO = IPINF
  208. LHOOK = INFELL(10)
  209. NSTRS = INFELL(16)
  210. MFR = INFELL(13)
  211. LW = INFELL(7)
  212. LRE = INFELL(9)
  213. NDDL = INFELL(15)
  214. IELE = INFELL( 14)
  215. IPORE = INFELL(8)
  216. IPMINT= INFELL(11)
  217. IPMIN1= INFELL(12)
  218. NBPGAU= INFELL( 6)
  219. C* ICARA = INFELL( 5)
  220. segsup info
  221. ELSE
  222. LHOOK = INFELE(10)
  223. NSTRS = INFELE(16)
  224. MFR = INFELE(13)
  225. LW = INFELE(7)
  226. LRE = INFELE(9)
  227. NDDL = INFELE(15)
  228. IELE = INFELE( 14)
  229. IPORE = INFELE(8)
  230. IPMINT=INFMOD(2+INTTYP)
  231. C* IPMINT = INFELE(11)
  232. IPMIN1= INFMOD(8)
  233. NBPGAU= INFELE( 6)
  234. C* ICARA = INFELE( 5)
  235. ENDIF
  236. c* LHOO2 = LHOOK*LHOOK
  237.  
  238. CALL INFDPG(MFR,IFOUR, BDPGE,NDPGE)
  239. IF (BDPGE) THEN
  240. IF (IIPDPG.LE.0) THEN
  241. CALL ERREUR(925)
  242. GOTO 5991
  243. ENDIF
  244. ENDIF
  245.  
  246. IPPORE=0
  247. IF(MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN
  248. IPPORE=NBNNE(NUMGEO(MELE))
  249. ENDIF
  250.  
  251. MINTE = IPMINT
  252. IF (IPMINT.NE.0) SEGACT,MINTE
  253. *
  254. C- RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX
  255. *
  256. if (lnomid(1).ne.0) then
  257. modepl=lnomid(1)
  258. else
  259. lsupde=.true.
  260. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  261. endif
  262. nomid=MODEPL
  263. segact nomid
  264. ndepl=lesobl(/2)
  265. c* ndum = lesfac(/2)
  266. *
  267. if (lnomid(2).ne.0) then
  268. moforc = lnomid(2)
  269. else
  270. lsupfo=.true.
  271. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  272. endif
  273. nomid=MOFORC
  274. segact nomid
  275. nforc=lesobl(/2)
  276. c* ndum = lesfac(/2)
  277. *
  278. IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  279. CALL ERREUR(5)
  280. GOTO 598
  281. ENDIF
  282. *
  283. * REMPLISSAGE DU SEGMENT DESCRIPTEUR
  284. *
  285. NCOMP = NDEPL
  286. NBNNS = NBNOE1
  287. NBNN = NBNOE1
  288. *PV idecap pas defini
  289. ** IF (MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN
  290. ** NCOMP = NDEPL-IDECAP
  291. ** ENDIF
  292. IF (BDPGE) THEN
  293. NCOMP = NDEPL - NDPGE
  294. NBNN = NBNOE1 + 1
  295. ENDIF
  296. IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  297. NBNNS = NBNN / 2
  298. ENDIF
  299. *
  300. NFAC = NBNNS
  301. IF (MELE.GE.108.AND.MELE.LE.110)
  302. & NFAC = MIN(NFAC,(3*NBNN-IPORE)/2)
  303. *
  304. NLIGRP = LRE
  305. NLIGRD = LRE
  306. * erreur dans les dimensions de DESCR
  307. * le mode de calcul n'est pas correct
  308. IF (NBNNS*NCOMP .GT. NLIGRD) THEN
  309. CALL ERREUR(717)
  310. GOTO 598
  311. ENDIF
  312.  
  313. SEGINI,DESCR
  314.  
  315. IDDL = 1
  316. DO 1004 INOEUD=1,NFAC
  317. DO 1005 ICOMP=1,NCOMP
  318. NOMID=MODEPL
  319. LISINC(IDDL)=LESOBL(ICOMP)
  320. if (dcmat2) then
  321. if (inoeud.eq.2) then
  322. LISINC(IDDL)=LESFAC(ICOMP)
  323. endif
  324. endif
  325. NOMID=MOFORC
  326. LISDUA(IDDL)=LESOBL(ICOMP)
  327. if (dcmat2) then
  328. if (inoeud.eq.2) then
  329. LISDUA(IDDL)=LESFAC(ICOMP)
  330. endif
  331. endif
  332. NOELEP(IDDL)=INOEUD
  333. NOELED(IDDL)=INOEUD
  334. IDDL=IDDL+1
  335. 1005 CONTINUE
  336. 1004 CONTINUE
  337. *
  338. * CAS DES ELEMENT RACCORD
  339. *
  340. IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  341. CALL IDPRIM(IMODEL,MFR+1000,MODPL,NDEPL,NDUM)
  342. CALL IDDUAL(IMODEL,MFR+1000,MOFRC,NFORC,NDUM)
  343. NOMID=MODPL
  344. SEGACT NOMID
  345. NOMID=MOFRC
  346. SEGACT NOMID
  347. DO 1106 INOEUD=NBNNS+1,NBNN
  348. DO 1107 ICOMP=1,NDEPL
  349. NOMID=MODPL
  350. LISINC(IDDL)=LESOBL(ICOMP)
  351. NOMID=MOFRC
  352. LISDUA(IDDL)=LESOBL(ICOMP)
  353. NOELEP(IDDL)=INOEUD
  354. NOELED(IDDL)=INOEUD
  355. IDDL=IDDL+1
  356. 1107 CONTINUE
  357. 1106 CONTINUE
  358. NOMID=MODPL
  359. SEGSUP,NOMID
  360. NOMID=MOFRC
  361. SEGSUP,NOMID
  362. ENDIF
  363. *
  364. SEGDES,DESCR
  365. IDESCR = DESCR
  366. 1999 continue
  367. *
  368. * TRAITEMENT DES CHAMPS EN ENTREE
  369. * -------------------------------
  370. *
  371. NBROBL = 0
  372. NBRFAC = 0
  373. NOMID = 0
  374. NOTYPE = 0
  375. *
  376. * >>> CHAMP DE MATERIAU
  377. *
  378. C* IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
  379. IF (FORMOD(1).EQ.'MECANIQUE'.AND.MATE.EQ.1.AND..NOT.dcmate) THEN
  380. IF (MFR.EQ.35) THEN
  381. NBROBL=2
  382. SEGINI NOMID
  383. LESOBL(1)='KS '
  384. LESOBL(2)='KN '
  385. ELSE IF(MFR.EQ.53) THEN
  386. NBROBL=1
  387. SEGINI,NOMID
  388. LESOBL(1)='KS '
  389. ELSE
  390. NBROBL=2
  391. SEGINI NOMID
  392. LESOBL(1)='VISQ'
  393. LESOBL(2)='NU '
  394. ENDIF
  395. NBTYPE=1
  396. SEGINI NOTYPE
  397. TYPE(1)='REAL*8'
  398. C* ELSE IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
  399. ELSE IF (FORMOD(1).EQ.'MECANIQUE'.AND.MATE.EQ.4) THEN
  400. IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  401. NBROBL=7
  402. SEGINI NOMID
  403. LESOBL(1)='VISQ'
  404. LESOBL(2)='V1X '
  405. LESOBL(3)='V1Y '
  406. LESOBL(4)='V1Z '
  407. LESOBL(5)='V2X '
  408. LESOBL(6)='V2Y '
  409. LESOBL(7)='V2Z '
  410. ELSE
  411. NBROBL=3
  412. SEGINI NOMID
  413. LESOBL(1)='VISQ'
  414. LESOBL(2)='V1X '
  415. LESOBL(3)='V1Y '
  416. ENDIF
  417. NBTYPE=1
  418. SEGINI NOTYPE
  419. TYPE(1)='REAL*8'
  420. *
  421. C* ELSE IF (INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  422. ELSEIF(INAT.EQ.67.AND. MATE.EQ.2) THEN
  423. NBROBL=6
  424. SEGINI NOMID
  425. LESOBL(1)='YG1 '
  426. LESOBL(2)='YG2 '
  427. LESOBL(3)='NU12'
  428. LESOBL(4)='G12 '
  429. LESOBL(5)='V1X '
  430. LESOBL(6)='V1Y '
  431. NBTYPE=1
  432. SEGINI NOTYPE
  433. TYPE(1)='REAL*8'
  434. *
  435. C* ELSEIF (CMATE.EQ.'SECTION') THEN
  436. ELSE IF (MATE.EQ.11) THEN
  437. C
  438. C MODELE ET MATERIAU DE LA SECTION DU MODELE A FIBRE
  439. C
  440. NBROBL=2
  441. SEGINI NOMID
  442. LESOBL(1)='MODS'
  443. LESOBL(2)='MATS'
  444. NBTYPE=2
  445. SEGINI NOTYPE
  446. TYPE(1)='POINTEURMMODEL'
  447. TYPE(2)='POINTEURMCHAML'
  448. C
  449. ELSEIF (CMATE.EQ.'MODAL') THEN
  450. NBROBL=3
  451. NBRFAC=1
  452. SEGINI NOMID
  453. LESOBL(1)='FREQ'
  454. LESOBL(2)='MASS'
  455. LESOBL(3)='DEFO'
  456. LESFAC(1) ='AMOR'
  457. NBTYPE=4
  458. SEGINI NOTYPE
  459. TYPE(1)='REAL*8'
  460. TYPE(2)='REAL*8'
  461. TYPE(3)='POINTEURCHPOINT'
  462. TYPE(4)='REAL*8'
  463.  
  464. ELSEIF (CMATE.EQ.'STATIQUE') THEN
  465. NBROBL=3
  466. NBRFAC=1
  467. SEGINI NOMID
  468. LESOBL(1)='DEFO'
  469. LESOBL(2)='RIDE'
  470. LESOBL(3)='MADE'
  471. LESFAC(1) ='AMOR'
  472. NBTYPE=4
  473. SEGINI NOTYPE
  474. TYPE(1)='POINTEURCHPOINT'
  475. TYPE(2)='POINTEURCHPOINT'
  476. TYPE(3)='POINTEURCHPOINT'
  477. TYPE(4)='REAL*8'
  478.  
  479. ELSE IF (dcmate) THEN
  480. IF (CMATE.EQ.'IMPCOMPL') THEN
  481. *
  482. * IMPEDANCE COMPLEXE
  483. *
  484. NBROBL=0
  485. NBRFAC=1
  486. SEGINI NOMID
  487. MOMATR=NOMID
  488. LESFAC(1)='VISC'
  489. *
  490. NBTYPE=1
  491. SEGINI NOTYPE
  492. MOTYPE=NOTYPE
  493. TYPE(1)='REAL*8'
  494.  
  495. ELSE
  496. NBROBL=0
  497. NBRFAC=2
  498. SEGINI NOMID
  499. MOMATR=NOMID
  500. LESFAC(1) ='AMOR'
  501. LESFAC(2) ='AROT'
  502. *
  503. NBTYPE=1
  504. SEGINI NOTYPE
  505. MOTYPE=NOTYPE
  506. TYPE(1)='REAL*8'
  507.  
  508. ENDIF
  509.  
  510. *
  511. ELSE
  512. C* CALL IDMATR(MFR,IMODEL,MOMATR,NBROBL,NBRFAC)
  513. C* NOMID = MOMATR
  514. C* NBTYPE=1
  515. C* SEGINI NOTYPE
  516. C* TYPE(1)='REAL*8'
  517. ENDIF
  518. *
  519. *
  520. MOMATR = NOMID
  521. MOTYPM = NOTYPE
  522. *
  523. NMATR = NBROBL
  524. NMATF = NBRFAC
  525. NMATT = NMATR+NMATF
  526. *
  527. * >>> CHAMPS DE CARACTERISTIQUES
  528. *
  529. NBROBL = 0
  530. NBRFAC = 0
  531. IVECT = 0
  532. NOMID = 0
  533. NOTYPE = 0
  534. *
  535. * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  536. *
  537. IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.
  538. + ((MELE.GE.79.AND.MELE.LE.83).OR.
  539. + (MELE.GE.173.AND.MELE.LE.182)))
  540. + .AND.IFOUR.EQ.-2)THEN
  541. NBRFAC=1
  542. SEGINI NOMID
  543. LESFAC(1)='DIM3'
  544. *
  545. NBTYPE=1
  546. SEGINI NOTYPE
  547. TYPE(1)='REAL*8'
  548. *
  549. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  550. *
  551. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  552. NBROBL=1
  553. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  554. NBRFAC=2
  555. ELSE
  556. NBRFAC=1
  557. ENDIF
  558. SEGINI NOMID
  559. LESOBL(1)='EPAI'
  560. LESFAC(1)='EXCE'
  561. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) LESFAC(2)='DIM3'
  562. *
  563. NBTYPE=1
  564. SEGINI NOTYPE
  565. TYPE(1)='REAL*8'
  566. *
  567. * SECTION POUR LES BARRES ET LES CERCES
  568. *
  569. ELSE IF (MFR.EQ.27) THEN
  570. IF(.NOT.dcmate) THEN
  571. NBROBL=1
  572. SEGINI NOMID
  573. LESOBL(1)='SECT'
  574. *
  575. NBTYPE=1
  576. SEGINI NOTYPE
  577. TYPE(1)='REAL*8'
  578. ENDIF
  579. *
  580. * section, excentrements et orientation pour les barres excentrees
  581. *
  582. ELSE IF (MFR.EQ.49) THEN
  583. NBROBL=6
  584. SEGINI NOMID
  585. LESOBL(1)='SECT'
  586. LESOBL(2)='EXCZ'
  587. LESOBL(3)='EXCY'
  588. LESOBL(4)='VX '
  589. LESOBL(5)='VY '
  590. LESOBL(6)='VZ '
  591.  
  592. NBTYPE=1
  593. SEGINI NOTYPE
  594. TYPE(1)='REAL*8'
  595.  
  596. * CARACTERISTIQUES POUR LES POUTRES
  597. *
  598. ELSE IF (MFR.EQ.7 ) THEN
  599. if (dcmate) then
  600. NBROBL=0
  601. NBRFAC=1
  602. SEGINI NOMID
  603. MOCARA=NOMID
  604. LESFAC(1)='VECT'
  605. IVECT=1
  606. *
  607. NBTYPE=1
  608. SEGINI NOTYPE
  609. MOTYPE=NOTYPE
  610. TYPE(1)='POINTEURPOINT '
  611. else
  612. C MODELE A FIBRE
  613. C* IF (CMATE.EQ.'SECTION') THEN
  614. IF (MATE.EQ.11) THEN
  615. IF (ICAS.EQ.2) THEN
  616. NBRFAC=2
  617. SEGINI NOMID
  618. LESFAC(1)='OMEG'
  619. LESFAC(2)='VECT'
  620. IVECT=1
  621. NBTYPE=2
  622. SEGINI NOTYPE
  623. TYPE(1)='REAL*8'
  624. TYPE(2)='POINTEURPOINT '
  625. ELSE
  626. NBRFAC=1
  627. SEGINI NOMID
  628. LESFAC(1)='VECT'
  629. IVECT=1
  630. NBTYPE=1
  631. SEGINI NOTYPE
  632. TYPE(1)='POINTEURPOINT '
  633. ENDIF
  634. *
  635. * POUTRE STANDARD
  636. * CAS 2D
  637. *
  638. ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  639. NBROBL=2
  640. NBRFAC=1
  641. SEGINI NOMID
  642. LESOBL(1)= 'SECT'
  643. LESOBL(2)= 'INRZ'
  644. LESFAC(1)= 'SECY'
  645. *
  646. NBTYPE=1
  647. SEGINI NOTYPE
  648. TYPE(1)='REAL*8'
  649.  
  650. * CAS 3D
  651. *
  652. ELSE
  653. *
  654. * AMORTISSEMENT COROTATIF
  655. *
  656. IF (ICAS.EQ.2) THEN
  657. NBROBL=4
  658. NBRFAC=4
  659. SEGINI NOMID
  660. LESOBL(1)='TORS'
  661. LESOBL(2)='INRY'
  662. LESOBL(3)='INRZ'
  663. LESOBL(4)='SECT'
  664. LESFAC(1)='SECY'
  665. LESFAC(2)='SECZ'
  666. LESFAC(3)='OMEG'
  667. LESFAC(4)='VECT'
  668. IVECT=1
  669. *
  670. NBTYPE=8
  671. SEGINI NOTYPE
  672. TYPE(1)='REAL*8'
  673. TYPE(2)='REAL*8'
  674. TYPE(3)='REAL*8'
  675. TYPE(4)='REAL*8'
  676. TYPE(5)='REAL*8'
  677. TYPE(6)='REAL*8'
  678. TYPE(7)='REAL*8'
  679. TYPE(8)='POINTEURPOINT '
  680. ELSE
  681. *
  682. * AMORTISSEMENT STANDARD
  683. *
  684. NBROBL=4
  685. NBRFAC=3
  686. SEGINI NOMID
  687. LESOBL(1)='TORS'
  688. LESOBL(2)='INRY'
  689. LESOBL(3)='INRZ'
  690. LESOBL(4)='SECT'
  691. LESFAC(1)='SECY'
  692. LESFAC(2)='SECZ'
  693. LESFAC(3)='VECT'
  694. IVECT=1
  695. *
  696. NBTYPE=7
  697. SEGINI NOTYPE
  698. TYPE(1)='REAL*8'
  699. TYPE(2)='REAL*8'
  700. TYPE(3)='REAL*8'
  701. TYPE(4)='REAL*8'
  702. TYPE(5)='REAL*8'
  703. TYPE(6)='REAL*8'
  704. TYPE(7)='POINTEURPOINT '
  705. ENDIF
  706. ENDIF
  707. endif
  708. *
  709. * CARACTERISTIQUES POUR LES TUYAUX
  710. *
  711. ELSE IF (MFR.EQ.13) THEN
  712. IF (ICAS.EQ.2) THEN
  713. NBROBL=2
  714. NBRFAC=5
  715. SEGINI NOMID
  716. LESOBL(1)='EPAI'
  717. LESOBL(2)='RAYO'
  718. LESFAC(1)='RACO'
  719. LESFAC(2)='PRES'
  720. LESFAC(3)='CISA'
  721. LESFAC(4)='OMEG'
  722. LESFAC(5)='VECT'
  723. IVECT=1
  724. *
  725. NBTYPE=7
  726. SEGINI NOTYPE
  727. TYPE(1)='REAL*8'
  728. TYPE(2)='REAL*8'
  729. TYPE(3)='REAL*8'
  730. TYPE(4)='REAL*8'
  731. TYPE(5)='REAL*8'
  732. TYPE(6)='REAL*8'
  733. TYPE(7)='POINTEURPOINT '
  734. ELSE
  735. NBROBL=2
  736. NBRFAC=4
  737. SEGINI NOMID
  738. LESOBL(1)='EPAI'
  739. LESOBL(2)='RAYO'
  740. LESFAC(1)='RACO'
  741. LESFAC(2)='PRES'
  742. LESFAC(3)='CISA'
  743. LESFAC(4)='VECT'
  744. IVECT=1
  745. *
  746. NBTYPE=6
  747. SEGINI NOTYPE
  748. TYPE(1)='REAL*8'
  749. TYPE(2)='REAL*8'
  750. TYPE(3)='REAL*8'
  751. TYPE(4)='REAL*8'
  752. TYPE(5)='REAL*8'
  753. TYPE(6)='POINTEURPOINT '
  754. ENDIF
  755. *
  756. ELSE IF (MFR.EQ.39) THEN
  757. IF (ICAS.EQ.2) THEN
  758. NBROBL=2
  759. NBRFAC=4
  760. SEGINI NOMID
  761. LESOBL(1)='EPAI'
  762. LESOBL(2)='RAYO'
  763. LESFAC(1)='RACO'
  764. LESFAC(2)='PRES'
  765. LESFAC(3)='OMEG'
  766. LESFAC(4)='VECT'
  767. IVECT=1
  768.  
  769. NBTYPE=6
  770. SEGINI NOTYPE
  771. TYPE(1)='REAL*8'
  772. TYPE(2)='REAL*8'
  773. TYPE(3)='REAL*8'
  774. TYPE(4)='REAL*8'
  775. TYPE(5)='REAL*8'
  776. TYPE(6)='POINTEURPOINT '
  777.  
  778. ELSE
  779. NBROBL=2
  780. NBRFAC=3
  781. SEGINI NOMID
  782. LESOBL(1)='EPAI'
  783. LESOBL(2)='RAYO'
  784. LESFAC(1)='RACO'
  785. LESFAC(2)='PRES'
  786. LESFAC(3)='VECT'
  787. IVECT=1
  788.  
  789. NBTYPE=5
  790. SEGINI NOTYPE
  791. TYPE(1)='REAL*8'
  792. TYPE(2)='REAL*8'
  793. TYPE(3)='REAL*8'
  794. TYPE(4)='REAL*8'
  795. TYPE(5)='POINTEURPOINT '
  796. ENDIF
  797. ENDIF
  798.  
  799. * Rendement :
  800. * Notion non utilisee actuellement (mais conserver a titre historique !)
  801. IF (NOMID.LE.0) THEN
  802. NBROBL = 0
  803. NBRFAC = 0
  804. SEGINI,NOMID
  805. NBTYPE = 0
  806. SEGINI,NOTYPE
  807. ENDIF
  808. ncar1 = NBROBL + NBRFAC + 1
  809. ifac = NBRFAC
  810. NBRFAC = NBRFAC + 10
  811. SEGADJ,NOMID
  812. LESFAC(ifac + 1) = 'REND'
  813. LESFAC(ifac + 2) = 'W1X '
  814. LESFAC(ifac + 3) = 'W1Y '
  815. LESFAC(ifac + 4) = 'W1Z '
  816. LESFAC(ifac + 5) = 'W2X '
  817. LESFAC(ifac + 6) = 'W2Y '
  818. LESFAC(ifac + 7) = 'W2Z '
  819. LESFAC(ifac + 8) = 'REN1'
  820. LESFAC(ifac + 9) = 'REN2'
  821. LESFAC(ifac + 10) = 'REN3'
  822. NBTYPE = NBTYPE + 1
  823. SEGADJ,NOTYPE
  824. TYPE(NBTYPE) = 'REAL*8'
  825. *
  826. MOCARA = NOMID
  827. MOTYPC = NOTYPE
  828. NCARA = NBROBL
  829. NCARF = NBRFAC
  830. NCARR = NCARA+NCARF
  831.  
  832. C- Partionnement si necessaire de la matrice d'amortissement
  833. C- determinant ainsi le nombre d'objets elementaires de MRIGID
  834. LTRK = oooval(1,4)
  835. IF (LTRK.EQ.0) LTRK = oooval(1,1)
  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.  

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