Télécharger vmispo.eso

Retour à la liste

Numérotation des lignes :

  1. C VMISPO SOURCE PASCAL 18/11/09 21:15:10 9987
  2. SUBROUTINE VMISPO(IPMODL,IPCHE1,IPCHE2,ICONV,IPCHE3,IRET)
  3. C_______________________________________________________________________
  4. C
  5. C Entrées:
  6. C ________
  7. C
  8. C IPMODL Pointeur sur un MMODEL
  9. C IPCHE1 Pointeur sur un MCHAML de contraintes
  10. C IPCHE2 Pointeur sur un MCHAML de caractéristiques
  11. C ICONV Flag précisant s'il y a eu conversion
  12. C
  13. C SORTIES:
  14. C ________
  15. C
  16. C IPCHE3 Pointeur sur un MCHAML de VONMISES
  17. C IRET =1 OU 0 suivant succes ou pas (Message d'erreur
  18. C imprimé dans ce cas)
  19. C
  20. C Passage aux nouveaux CHAMELEMs par I.Monnier le 13.06.90
  21. C
  22. *_______________________________________________________________________
  23. *
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. *
  27. -INC CCOPTIO
  28. -INC CCHAMP
  29. -INC CCGEOME
  30. -INC SMCHAML
  31. -INC SMMODEL
  32. -INC SMCOORD
  33. -INC SMINTE
  34. *
  35. SEGMENT NOTYPE
  36. CHARACTER*16 TYPE(NBTYPE)
  37. ENDSEGMENT
  38. *
  39. SEGMENT MPTVAL
  40. INTEGER IPOS(NS) ,NSOF(NS)
  41. INTEGER IVAL(NCOSOU)
  42. CHARACTER*16 TYVAL(NCOSOU)
  43. ENDSEGMENT
  44. *
  45. CHARACTER*(NCONCH) CONM
  46. PARAMETER ( NINF=3 )
  47. DIMENSION SIG(9)
  48. DIMENSION CARAC(25),DIV(7)
  49. INTEGER INFOS(NINF)
  50. LOGICAL lsupco
  51. INTEGER ISUP1,ISUP2
  52. DATA ALPH1/.4444444444444444D0/
  53. DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/
  54.  
  55. * WRITE(*,*) 'Entrée dans VMISPO.'
  56. IRET = 0
  57. IPCHE3 = 0
  58. *
  59. * Verification du lieu support du MCHAML de CONTRAINTES
  60. *
  61. ISUP1 = 0
  62. ISUP2=0
  63. IRET1 = 0
  64. CALL QUESUP (IPMODL,IPCHE1,0,0,ISUP1,IRET1)
  65. * IF (ISUP1.GT.0) RETURN
  66. *
  67. * Verification du lieu support du MCHAML de CARACTERISTIQUES
  68. *
  69. IF (IPCHE2.NE.0) THEN
  70. ISUP2 = 0
  71. IRET2 = 0
  72. CALL QUESUP (IPMODL,IPCHE2,IRET1,1,ISUP2,IRET2)
  73. IF (ISUP2.GT.0) RETURN
  74. ENDIF
  75.  
  76. *_______________________________________________________________________
  77. *
  78. * ACTIVATION DU MODELE
  79. *_______________________________________________________________________
  80. *
  81. MMODEL=IPMODL
  82. SEGACT,MMODEL
  83. NSOUS=KMODEL(/1)
  84. KEL22 = 0
  85. DO ISOUS = 1, NSOUS
  86. IMODEL=KMODEL(ISOUS)
  87. SEGACT,IMODEL
  88. IF (NEFMOD.EQ.22.or.nefmod.eq.259) KEL22 = KEL22 + 1
  89. IF (formod.ne.'MECANIQUE') KEL22 = KEL22 + 1
  90. ENDDO
  91. *
  92. * ACTIVATION DES CONTRAINTES
  93. *
  94. IRET=1
  95. MCHEL1=IPCHE1
  96. SEGACT MCHEL1
  97. *
  98. * INITIALISATION DU MCHELM DE VON MISES
  99. *
  100. L1=9
  101. N1=NSOUS - KEL22
  102. N3=6
  103. SEGINI MCHELM
  104. IFOCHE=IFOUR
  105. TITCHE='VON MISES'
  106.  
  107. *_______________________________________________________________________
  108. *
  109. * BOUCLE SUR LES SOUS ZONES
  110. *_______________________________________________________________________
  111. *
  112. isouss=0
  113. DO 200 ISOUS=1,NSOUS
  114. C
  115. C QUELQUES INITIALISATIONS
  116. C
  117. MOSTRS = 0
  118. MOCARA = 0
  119. IVASTR = 0
  120. IVACAR = 0
  121. IVAMIS = 0
  122. C
  123. C TRAITEMENT DU MODELE
  124. C
  125. IMODEL=KMODEL(ISOUS)
  126. C* SEGACT IMODEL
  127. MELE=NEFMOD
  128. IF (NEFMOD.EQ.22.or.nefmod.eq.259) goto 200
  129. IF (formod.ne.'MECANIQUE') goto 200
  130. ISOUSS=ISOUSS+1
  131. *
  132. IPMAIL=IMAMOD
  133. CONM =CONMOD
  134. C
  135. C CREATION DU TABLEAU INFOS
  136. C
  137. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  138. IF (IRTD.EQ.0) GOTO 9990
  139. C
  140. C COQUE INTEGREE OU PAS ?
  141. C
  142. IF(INFMOD(/1).NE.0)THEN
  143. NPINT=INFMOD(1)
  144. ELSE
  145. NPINT=0
  146. ENDIF
  147.  
  148. C_______________________________________________________________________
  149. C
  150. C INFORMATIONS SUR L'ELEMENT FINI
  151. C_______________________________________________________________________
  152. C
  153. * CALL ELQUOI(MELE,0,IRET1,IPINF,IMODEL)
  154. * IF (IERR.NE.0) THEN
  155. * SEGDES IMODEL,MMODEL
  156. * SEGSUP MCHELM
  157. * SEGDES MCHEL1
  158. * RETURN
  159. * ENDIF
  160. * INFO=IPINF
  161. MFR =INFELE(13)
  162. NSTRS =INFELE(16)
  163. NBPGAU=INFELE( 4)
  164. * MINTE =INFELE(11)
  165. MINTE=INFMOD(iret1+2)
  166. IPPORE=0
  167. IF(MFR.EQ.33)IPPORE=NBNNE(NUMGEO(MELE))
  168. IPMINT=MINTE
  169. SEGACT,MINTE
  170. * SEGSUP INFO
  171. C
  172. C RECOPIE DU MCHELM
  173. C
  174. IMACHE(ISOUSS)=IPMAIL
  175. CONCHE(ISOUSS)=CONMOD
  176. C
  177. INFCHE(ISOUSS,1)=0
  178. INFCHE(ISOUSS,2)=0
  179. INFCHE(ISOUSS,3)=NIFOUR
  180. INFCHE(ISOUSS,4)=MINTE
  181. INFCHE(ISOUSS,5)=0
  182. INFCHE(ISOUSS,6)=IRET1
  183. C
  184. C CREATION DU MCHAML
  185. C
  186. N2=1
  187. SEGINI MCHAML
  188. ICHAML(ISOUSS)=MCHAML
  189. NOMCHE(1)='SCAL'
  190. TYPCHE(1)='REAL*8'
  191.  
  192. C_______________________________________________________________________
  193. C
  194. C NOMS DE COMPOSANTES DE CONTRAINTES NECESSAIRES
  195. C_______________________________________________________________________
  196. C
  197. if(lnomid(4).ne.0) then
  198. nomid=lnomid(4)
  199. segact nomid
  200. mostrs=nomid
  201. nstr=lesobl(/2)
  202. nfac=lesfac(/2)
  203. lsupco=.false.
  204. else
  205. lsupco=.true.
  206. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  207. endif
  208. C
  209. C VERIFICATION DE LEUR PRESENCE
  210. C
  211. NBTYPE=1
  212. SEGINI NOTYPE
  213. MOTYPE=NOTYPE
  214. TYPE(1)='REAL*8'
  215. C
  216. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  217. SEGSUP NOTYPE
  218. IF (IERR.NE.0) GOTO 9990
  219. *
  220. IF (ISUP1.EQ.1) CALL VALCHE (IVASTR,NSTR,IPMINT,IPPORE,
  221. & MOSTRS,MELE)
  222. C
  223. C RECHERCHE DES TAILLES DE MELVAL
  224. C
  225. N1EL=0
  226. N1PTEL=0
  227. MPTVAL=IVASTR
  228. DO 20 IO=1,NSTRS
  229. MELVAL=IVAL(IO)
  230. N1PTEL=MAX(N1PTEL,VELCHE(/1))
  231. N1EL =MAX(N1EL ,VELCHE(/2))
  232. 20 CONTINUE
  233. IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN
  234. N1PTEL=1
  235. ELSE
  236. *PVPVPV N1PTEL=NBPGAU
  237. ENDIF
  238. NBPTEL=N1PTEL
  239. NEL =N1EL
  240. C
  241. C CREATION DU MELVAL VMISES
  242. C
  243. N2PTEL=0
  244. N2EL=0
  245. SEGINI MELVAL
  246. IELVAL(1)=MELVAL
  247. IVAMIS =MELVAL
  248. *
  249. * ON TRAITE LES COQUES INTEGREES COMME LES MASSIFS
  250. *
  251. IF(NPINT.NE.0)THEN
  252. MFR1=1
  253. ELSE
  254. MFR1=MFR
  255. ENDIF
  256.  
  257. C_______________________________________________________________________
  258. C
  259. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  260. C_______________________________________________________________________
  261. *
  262. NBROBL=0
  263. NBRFAC=0
  264. MOCARA=0
  265. IVECT=0
  266. *
  267. * EPAISSEUR ET ALFA DANS LE CAS DES COQUES
  268. *
  269. IF (MFR1.EQ.3.OR.MFR1.EQ.5.OR.MFR1.EQ.9) THEN
  270. NBROBL=1
  271. NBRFAC=1
  272. SEGINI NOMID
  273. MOCARA=NOMID
  274. LESOBL(1)='EPAI'
  275. LESFAC(1)='CALF'
  276. *
  277. NBTYPE=1
  278. SEGINI NOTYPE
  279. TYPE(1)='REAL*8'
  280. *
  281. * CARACTERISTIQUES POUR LES POUTRES
  282. *
  283. ELSE IF (MFR1.EQ.7 ) THEN
  284. IF(IFOUR.EQ.2) THEN
  285. NBROBL=4
  286. NBRFAC=3
  287. SEGINI NOMID
  288. MOCARA=NOMID
  289. LESOBL(1)='TORS'
  290. LESOBL(2)='INRY'
  291. LESOBL(3)='INRZ'
  292. LESOBL(4)='SECT'
  293. LESFAC(1)='DX '
  294. LESFAC(2)='DZ '
  295. LESFAC(3)='DY '
  296. ELSE
  297. NBROBL=2
  298. NBRFAC=1
  299. SEGINI NOMID
  300. MOCARA=NOMID
  301. LESOBL(1)='SECT'
  302. LESOBL(2)='INRZ'
  303. LESFAC(1)='DY '
  304. ENDIF
  305. *
  306. NBTYPE=1
  307. SEGINI NOTYPE
  308. TYPE(1)='REAL*8'
  309. *
  310. * CARACTERISTIQUES POUR LES TUYAUX
  311. *
  312. ELSE IF (MFR1.EQ.13) THEN
  313. NBROBL=2
  314. NBRFAC=9
  315. SEGINI NOMID
  316. MOCARA=NOMID
  317. LESOBL(1)='EPAI'
  318. LESOBL(2)='RAYO'
  319. LESFAC(1)='RACO'
  320. LESFAC(2)='PRES'
  321. LESFAC(3)='CISA'
  322. LESFAC(4)='CFFX'
  323. LESFAC(5)='CFMX'
  324. LESFAC(6)='CFMY'
  325. LESFAC(7)='CFMZ'
  326. LESFAC(8)='CFPR'
  327. c LESFAC(9)='VECT'
  328. c IVECT=1
  329. c BP, 2016-10-17: pour le calcul de VMISES, on se fiche de l'orientation
  330. c du repere local car les composantes sont deja toutes locales !
  331. c Afin d'utiliser tuycar, on met des valeurs de VX VY et VZ bidons
  332. *
  333. NBTYPE=11
  334. SEGINI NOTYPE
  335. TYPE(1)='REAL*8'
  336. TYPE(2)='REAL*8'
  337. TYPE(3)='REAL*8'
  338. TYPE(4)='REAL*8'
  339. TYPE(5)='REAL*8'
  340. TYPE(6)='REAL*8'
  341. TYPE(7)='REAL*8'
  342. TYPE(8)='REAL*8'
  343. TYPE(9)='REAL*8'
  344. TYPE(10)='REAL*8'
  345. TYPE(11)='POINTEURPOINT '
  346. ENDIF
  347. *
  348. NCARA=NBROBL
  349. NCARF=NBRFAC
  350. NCARR=NCARA+NCARF
  351. IF (MOCARA.NE.0) THEN
  352. MOTYPE=NOTYPE
  353. IF (IPCHE2.NE.0) THEN
  354. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,
  355. 1 1,INFOS,3,IVACAR)
  356. SEGSUP NOTYPE
  357. IF (IERR.NE.0) GOTO 9990
  358. ELSE
  359. SEGSUP NOTYPE
  360. MOTERR(1:8)='CARACTER'
  361. MOTERR(9:12)=NOMTP(MELE)
  362. MOTERR(13:20)='VMIS'
  363. CALL ERREUR(145)
  364. GOTO 9990
  365. ENDIF
  366. *
  367. IF (ISUP2.EQ.1) THEN
  368. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  369. IF(IERR.NE.0)THEN
  370. ISUP2=0
  371. GOTO 9990
  372. ENDIF
  373. ENDIF
  374. ENDIF
  375. *
  376. C_______________________________________________________________________
  377. C
  378. C BRANCHEMENT SUIVANT LA FORMULATION
  379. C_______________________________________________________________________
  380. C
  381. C MASSI COQUE COQEP POUT CIST THER TUYA LISP
  382. GOTO (30,22,60,22,80,22,100,22,70,22,22,22,120,22,90,22,22,
  383. C INCO PORE
  384. . 22,22,22,22,22,22,22,22,22,22,22,22,22,30,22,30),MFR1
  385. c cas XFEM : identique au cas massif
  386. IF(MFR.EQ.63) goto 30
  387. C
  388. 22 CONTINUE
  389. MOTERR(1:8)=NOMFR(MFR1/2+1)
  390. CALL ERREUR(193)
  391. GOTO 9990
  392.  
  393. C_______________________________________________________________________
  394. C
  395. C FORMULATION MASSIVE
  396. C_______________________________________________________________________
  397. C
  398. 30 CONTINUE
  399. DO 31 IB=1,NEL
  400. DO 31 IGAU=1,NBPTEL
  401. MPTVAL=IVASTR
  402. DO 35 ICOMP=1,NSTRS
  403. MELVAL=IVAL(ICOMP)
  404. IGMN=MIN(IGAU,VELCHE(/1))
  405. IBMN=MIN(IB ,VELCHE(/2))
  406. SIG(ICOMP)=VELCHE(IGMN,IBMN)
  407. 35 CONTINUE
  408. VONMIS=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)-SIG(1)*SIG(2)
  409. + -SIG(1)*SIG(3)-SIG(2)*SIG(3)
  410. C
  411. IF (IDIM.NE.1) THEN
  412. DO 33 IE=4,NSTRS
  413. VONMIS=VONMIS+3.D0*(SIG(IE)*SIG(IE))
  414. 33 CONTINUE
  415. ENDIF
  416. C
  417. XXXX=SQRT(ABS(VONMIS))
  418. MELVAL=IVAMIS
  419. VELCHE(IGAU,IB)=XXXX
  420. 31 CONTINUE
  421. GOTO 150
  422.  
  423. C_______________________________________________________________________
  424. C
  425. C FORMULATION COQUE MINCE
  426. C_______________________________________________________________________
  427. C
  428. 60 CONTINUE
  429. C
  430. DO 61 IB=1,NEL
  431. DO 61 IGAU=1,NBPTEL
  432. MPTVAL=IVASTR
  433. DO 62 ICOMP=1,NSTRS
  434. MELVAL=IVAL(ICOMP)
  435. IGMN=MIN(IGAU,VELCHE(/1))
  436. IBMN=MIN(IB ,VELCHE(/2))
  437. SIG(ICOMP)=VELCHE(IGMN,IBMN)
  438. 62 CONTINUE
  439. C
  440. MPTVAL=IVACAR
  441. MELVAL=IVAL(1)
  442. IGMN=MIN(IGAU,VELCHE(/1))
  443. IBMN=MIN(IB ,VELCHE(/2))
  444. EPAIST=VELCHE(IGMN,IBMN)
  445. *
  446. CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
  447. MPTVAL=IVACAR
  448. MELVAL=IVAL(2)
  449. IF (MELVAL.NE.0) THEN
  450. IGMN=MIN(IGAU,VELCHE(/1))
  451. IBMN=MIN(IB ,VELCHE(/2))
  452. ALPHA=VELCHE(IGMN,IBMN)
  453. ELSE
  454. ALPHA=0.666666666666666666D0
  455. ENDIF
  456. C
  457. IF(IFOUR.GT.0) THEN
  458. VONMIS=SQRT(ABS(SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+
  459. + 3.D0*SIG(3)*SIG(3)+ALPHA*(SIG(4)*SIG(4)+SIG(5)*SIG(5)-
  460. + SIG(4)*SIG(5)+3.D0*SIG(6)*SIG(6))))
  461. ELSE IF(IFOUR.LE.0) THEN
  462. VONMIS= SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+
  463. + ALPHA*(SIG(3)*SIG(3)+SIG(4)*SIG(4)-SIG(3)*SIG(4))
  464. VONMIS=SQRT(VONMIS)
  465. ENDIF
  466. C
  467. MELVAL=IVAMIS
  468. VELCHE(IGAU,IB)=VONMIS
  469. 61 CONTINUE
  470. GOTO 150
  471.  
  472. C_______________________________________________________________________
  473. C
  474. C FORMULATION COQUE AVEC CISAILLEMENT TRANSVERSE (COQ4)
  475. C_______________________________________________________________________
  476. C
  477. 70 CONTINUE
  478. C
  479. DO 71 IB=1,NEL
  480. DO 71 IGAU=1,NBPTEL
  481. MPTVAL=IVASTR
  482. DO 72 ICOMP=1,NSTRS
  483. MELVAL=IVAL(ICOMP)
  484. IGMN=MIN(IGAU,VELCHE(/1))
  485. IBMN=MIN(IB ,VELCHE(/2))
  486. SIG(ICOMP)=VELCHE(IGMN,IBMN)
  487. 72 CONTINUE
  488. C
  489. MPTVAL=IVACAR
  490. MELVAL=IVAL(1)
  491. IGMN=MIN(IGAU,VELCHE(/1))
  492. IBMN=MIN(IB ,VELCHE(/2))
  493. EPAIST=VELCHE(IGMN,IBMN)
  494. *
  495. CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
  496. MPTVAL=IVACAR
  497. MELVAL=IVAL(2)
  498. IF (MELVAL.NE.0) THEN
  499. IGMN=MIN(IGAU,VELCHE(/1))
  500. IBMN=MIN(IB ,VELCHE(/2))
  501. ALPHA=VELCHE(IGMN,IBMN)
  502. ELSE
  503. ALPHA=0.666666666666666666D0
  504. ENDIF
  505. C
  506. VONMIS=SQRT(ABS(SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+
  507. + 3.D0*SIG(7)*SIG(7)+3.D0*SIG(8)*SIG(8)+
  508. + 3.D0*SIG(3)*SIG(3)+ALPHA*(SIG(4)*SIG(4)+SIG(5)*SIG(5)-
  509. + SIG(4)*SIG(5)+3.D0*SIG(6)*SIG(6))))
  510. C
  511. MELVAL=IVAMIS
  512. VELCHE(IGAU,IB)=VONMIS
  513. 71 CONTINUE
  514. GOTO 150
  515.  
  516. C_______________________________________________________________________
  517. C
  518. C FORMULATION COQUE EPAISSE
  519. C_______________________________________________________________________
  520. C
  521. 80 CONTINUE
  522. DO 81 IB=1,NEL
  523. DO 81 IGAU=1,NBPTEL
  524. MPTVAL=IVASTR
  525. DO 85 ICOMP=1,NSTRS
  526. MELVAL=IVAL(ICOMP)
  527. IGMN=MIN(IGAU,VELCHE(/1))
  528. IBMN=MIN(IB ,VELCHE(/2))
  529. SIG(ICOMP)=VELCHE(IGMN,IBMN)
  530. 85 CONTINUE
  531. VONMIS=SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)
  532. 1 + 3.D0*(SIG(3)*SIG(3)+SIG(4)*SIG(4)+SIG(5)*SIG(5))
  533. C
  534. XXXX=SQRT(ABS(VONMIS))
  535. MELVAL=IVAMIS
  536. VELCHE(IGAU,IB)=XXXX
  537. 81 CONTINUE
  538. GOTO 150
  539.  
  540. C_______________________________________________________________________
  541. C
  542. C FORMULATION LINESPRING
  543. C_______________________________________________________________________
  544. C
  545. 90 CONTINUE
  546. DO 91 IB=1,NEL
  547. DO 91 IGAU=1,NBPTEL
  548. MPTVAL=IVASTR
  549. DO 95 ICOMP=1,NSTRS
  550. MELVAL=IVAL(ICOMP)
  551. IGMN=MIN(IGAU,VELCHE(/1))
  552. IBMN=MIN(IB ,VELCHE(/2))
  553. SIG(ICOMP)=VELCHE(IGMN,IBMN)
  554. 95 CONTINUE
  555. VONMIS=SQRT(ABS(SIG(1)*SIG(1)+ALPH1*SIG(4)*SIG(4)))
  556. C
  557. MELVAL=IVAMIS
  558. VELCHE(IGAU,IB)=VONMIS
  559. 91 CONTINUE
  560. GOTO 150
  561.  
  562. C_______________________________________________________________________
  563. C
  564. C FORMULATION POUTRE 2D ET 3D
  565. C_______________________________________________________________________
  566. C
  567. 100 CONTINUE
  568.  
  569. C____ FORMULATION POUTRE 3D = idem TUYAU 3D --> GOTO 120 _______________
  570. IF (IFOUR.EQ.2) GOTO 120
  571. C
  572. C____ FORMULATION POUTRE 2D ____________________________________________
  573. C
  574. c -- boucle sur les pt de Gauss --
  575. DO 101 IB=1,NEL
  576. DO 101 IGAU=1,NBPTEL
  577.  
  578. c CONTRAINTES --> SIG() : EFFX,EFFY,MOMZ
  579. MPTVAL=IVASTR
  580. DO 102 ICOMP=1,NSTRS
  581. MELVAL=IVAL(ICOMP)
  582. IGMN=MIN(IGAU,VELCHE(/1))
  583. IBMN=MIN(IB ,VELCHE(/2))
  584. SIG(ICOMP)=VELCHE(IGMN,IBMN)
  585. 102 CONTINUE
  586. C
  587. c CARACTERISTIQUES --> CARAC() : SECT, INRZ, (DZ)
  588. MPTVAL=IVACAR
  589. DO 103 ICOMP=1,NCARR
  590. MELVAL=IVAL(ICOMP)
  591. IF (MELVAL.NE.0) THEN
  592. IGMN=MIN(IGAU,VELCHE(/1))
  593. IBMN=MIN(IB ,VELCHE(/2))
  594. CARAC(ICOMP)=VELCHE(IGMN,IBMN)
  595. ELSE
  596. CARAC(ICOMP)=0.D0
  597. ENDIF
  598. 103 CONTINUE
  599. C
  600. DIV(1)=1.D0/CARAC(1)
  601. DIV(3)=CARAC(3)/CARAC(2)
  602. C
  603. VONMIS=SQRT(ABS((SIG(1)*DIV(1))**2+(SIG(3)*DIV(3))**2))
  604. C
  605. MELVAL=IVAMIS
  606. VELCHE(IGAU,IB)=VONMIS
  607. C
  608. 101 CONTINUE
  609. GOTO 150
  610.  
  611. C_______________________________________________________________________
  612. C
  613. C FORMULATION POUTRE 3D et TUYAU 3D
  614. C_______________________________________________________________________
  615. C
  616. 120 CONTINUE
  617.  
  618. c initialisations bidons
  619. DIV(1)=0.D0
  620. DIV(2)=0.D0
  621. DIV(3)=0.D0
  622. c vecteur bidon
  623. VX = 1.D0
  624. VY = 1.D0
  625. VZ = 1.D0
  626.  
  627. c -- boucle sur les pt de Gauss --
  628. DO 121 IB=1,NEL
  629. DO 121 IGAU=1,NBPTEL
  630.  
  631. c CONTRAINTES --> SIG()
  632. MPTVAL=IVASTR
  633. DO 122 ICOMP=1,NSTRS
  634. MELVAL=IVAL(ICOMP)
  635. IGMN=MIN(IGAU,VELCHE(/1))
  636. IBMN=MIN(IB ,VELCHE(/2))
  637. SIG(ICOMP)=VELCHE(IGMN,IBMN)
  638. 122 CONTINUE
  639.  
  640. c CARACTERISTIQUES --> CARAC()
  641. MPTVAL=IVACAR
  642. c NCARR1=NCARR
  643. c IF(IVECT.EQ.1) NCARR1=NCARR-1
  644. c DO 123 ICOMP=1,NCARR1
  645. DO 123 ICOMP=1,NCARR
  646. MELVAL=IVAL(ICOMP)
  647. IF (MELVAL.NE.0) THEN
  648. IGMN=MIN(IGAU,VELCHE(/1))
  649. IBMN=MIN(IB ,VELCHE(/2))
  650. CARAC(ICOMP)=VELCHE(IGMN,IBMN)
  651. ELSE
  652. CARAC(ICOMP)=0.D0
  653. ENDIF
  654. 123 CONTINUE
  655. C
  656. c C CAS OU ON A LU LE MOT VECTEUR
  657. c C
  658. c IF (IVECT.EQ.1) THEN
  659. c IF (IVAL(NCARR).NE.0) THEN
  660. c MELVAL=IVAL(NCARR)
  661. c IBMN=MIN(IB,IELCHE(/2))
  662. c IP=IELCHE(1,IBMN)
  663. c IREF=(IP-1)*(IDIM+1)
  664. c DO 124 IC=1,IDIM
  665. c CARAC(NCARR+IC-1)=XCOOR(IREF+IC)
  666. c 124 CONTINUE
  667. c ELSE
  668. c DO 125 IC=1,IDIM
  669. c CARAC(NCARR+IC-1)=0.D0
  670. c 125 CONTINUE
  671. c ENDIF
  672. c ENDIF
  673. C
  674. SIGPRE=0.D0
  675. IF(MFR1.EQ.7) THEN
  676. DIV(1)=1.D0/CARAC(4)
  677. c DIV(2)=1.D0
  678. c DIV(3)=1.D0
  679. DIV(4)=CARAC(5)/CARAC(1)
  680. DIV(5)=CARAC(6)/CARAC(2)
  681. DIV(6)=CARAC(7)/CARAC(3)
  682. ELSE IF(MFR1.EQ.13) THEN
  683. EPAIS=CARAC(1)
  684. REXT =CARAC(2)
  685. RMOY =REXT-EPAIS*0.5D0
  686. RACO =CARAC(3)
  687. PRES =CARAC(4)
  688. CISA =CARAC(5)
  689. C
  690. GAM=1.D0
  691. IF(RACO.EQ.0.D0) GO TO 126
  692. XLAM=RMOY*RMOY/EPAIS/RACO
  693. GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0
  694. IF(GAM.LT.1.D0) GAM=1.D0
  695. 126 CONTINUE
  696. C
  697. C NB 23/09/98
  698. C VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY
  699. C CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES
  700. C CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS
  701. C DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE
  702. C DUE A LA PRESSION )
  703. C
  704. c DIV(1)=1.D0
  705. c DIV(2)=1.D0
  706. DIV(3)=1.D0
  707. DIV(4)=R33
  708. DIV(5)=PI4*GAM
  709. DIV(6)=DIV(5)
  710. DIV(7)=0.D0
  711. C
  712. DO 127 ICOMP=6,10
  713. MELVAL=IVAL(ICOMP)
  714. IF (MELVAL.NE.0) DIV(ICOMP-3)=CARAC(ICOMP)
  715. 127 CONTINUE
  716. C
  717. C NB 23/09/98
  718. C TRANSFERT DE CFFX DANS DIV(1) ET REMISE A
  719. C 1.D0 DE DIV(3)
  720. DIV(1)=DIV(3)
  721. c DIV(3)=1.D0
  722. C
  723. C RE-ARRANGEMENT DE CARAC POUR TUYCAR
  724. C
  725. CISA=CARAC(5)
  726. c CARAC(4)=CARAC(11)
  727. c CARAC(5)=CARAC(12)
  728. c CARAC(6)=CARAC(13)
  729. c VX=CARAC(4)
  730. c VY=CARAC(5)
  731. c VZ=CARAC(6)
  732. CALL TUYCAR(CARAC,CISA,VX,VY,VZ,KERRE,1)
  733. DIV(1)=DIV(1)/CARAC(4)
  734. DIV(4)=DIV(4)*RMOY/CARAC(1)
  735. DIV(5)=DIV(5)*RMOY/CARAC(2)
  736. DIV(6)=DIV(6)*RMOY/CARAC(3)
  737. SIGPRE=DIV(7)*RMOY*PRES/EPAIS
  738. ENDIF
  739. C
  740. VONMIS=SQRT(ABS((SIG(1)*DIV(1))**2+(SIG(4)*DIV(4))**2+
  741. . (SIG(5)*DIV(5))**2+(SIG(6)*DIV(6))**2+
  742. . SIGPRE**2 ))
  743. C
  744. MELVAL=IVAMIS
  745. VELCHE(IGAU,IB)=VONMIS
  746. C
  747. 121 CONTINUE
  748. GOTO 150
  749. C
  750. C_______________________________________________________________________
  751. C
  752. C AUTRE FORMULATION
  753. C_______________________________________________________________________
  754. C
  755. 150 CONTINUE
  756. C
  757. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  758. C
  759. IF(ISUP1.EQ.1)THEN
  760. CALL DTMVAL(IVASTR,3)
  761. ELSE
  762. CALL DTMVAL(IVASTR,1)
  763. ENDIF
  764. *
  765. MELVAL=IVAMIS
  766. SEGDES MELVAL
  767. *
  768. IF(ISUP2.EQ.1)THEN
  769. CALL DTMVAL(IVACAR,3)
  770. ELSE
  771. CALL DTMVAL(IVACAR,1)
  772. ENDIF
  773. *
  774. NOMID =MOSTRS
  775. if(lsupco)SEGSUP NOMID
  776. NOMID =MOCARA
  777. IF (MOCARA.NE.0) SEGSUP NOMID
  778. *
  779. SEGDES MCHAML
  780. 201 CONTINUE
  781. SEGDES,MINTE
  782. C
  783. 200 CONTINUE
  784.  
  785. SEGDES MCHELM
  786. SEGDES MCHEL1
  787. IRET = 1
  788. IPCHE3 = MCHELM
  789. GOTO 888
  790. *
  791. * ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  792. *
  793. 9990 CONTINUE
  794. *
  795. IF(ISUP1.EQ.1)THEN
  796. CALL DTMVAL(IVASTR,3)
  797. ELSE
  798. CALL DTMVAL(IVASTR,1)
  799. ENDIF
  800. *
  801. IF(ISUP2.EQ.1)THEN
  802. CALL DTMVAL(IVACAR,3)
  803. ELSE
  804. CALL DTMVAL(IVACAR,1)
  805. ENDIF
  806. *
  807. NOMID =MOSTRS
  808. if(lsupco)SEGSUP NOMID
  809. NOMID =MOCARA
  810. IF (MOCARA.NE.0) SEGSUP NOMID
  811. *
  812. IF (IVAMIS.NE.0) THEN
  813. MELVAL=IVAMIS
  814. SEGSUP MELVAL
  815. ENDIF
  816. *
  817. SEGDES,MINTE
  818. SEGSUP MCHAML
  819. *
  820. SEGDES MCHEL1
  821. SEGSUP MCHELM
  822.  
  823. IRET = 0
  824. IPCHE3 = 0
  825. *
  826. 888 CONTINUE
  827. DO ISOUS = 1, NSOUS
  828. IMODEL=KMODEL(ISOUS)
  829. SEGDES,IMODEL
  830. ENDDO
  831. SEGDES MMODEL
  832.  
  833. RETURN
  834. END
  835.  
  836.  
  837.  
  838.  
  839.  
  840.  
  841.  
  842.  
  843.  
  844.  
  845.  
  846.  
  847.  
  848.  

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