Télécharger epthp.eso

Retour à la liste

Numérotation des lignes :

epthp
  1. C EPTHP SOURCE SP204843 23/11/30 21:15:09 11798
  2.  
  3. C=======================================================================
  4. C= E P T H P =
  5. C= --------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcul des deformations d'origine thermique. =
  10. C= Sous-programme appele par EPTH (epth.eso). =
  11. C= =
  12. C= Parametres : (E)=Entree (S)=Sortie =
  13. C= ------------ =
  14. C= IPMODL (E) Pointeur sur le segment MMODEL =
  15. C= IPCHE1 (E) Pointeur sur le segment MCHELM de CARACTERISTIQUES =
  16. C= IPCHE2 (E) Pointeur sur le segment MCHELM de TEMPERATURES =
  17. C= IPEPTH (S) Pointeur sur le segment MCHPOI de forces nodales =
  18. C= IRET (S) Entier valant 1 en cas de succes, 0 sinon (et un =
  19. C= message d'erreur est imprime dans ce cas) =
  20. C= =
  21. C= Remarque : Variation parabolique de la temperature dans les COQUES =
  22. C ---------- Cas ORTHOTROPE et ANISOTROPE traites pour les MASSIFS =
  23. C=======================================================================
  24.  
  25. SUBROUTINE EPTHP (IPMODL,IPCHE1,IPCHE2,IPEPTH,IRET)
  26.  
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8 (A-H,O-Z)
  29.  
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCGEOME
  34. -INC CCREEL
  35. -INC CCHAMP
  36. -INC SMCHAML
  37. -INC SMELEME
  38. -INC SMINTE
  39. -INC SMMODEL
  40. -INC SMCOORD
  41.  
  42. SEGMENT NOTYPE
  43. CHARACTER*16 TYPE(NBTYPE)
  44. ENDSEGMENT
  45.  
  46. SEGMENT MPTVAL
  47. INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  48. CHARACTER*16 TYVAL(NCOSOU)
  49. ENDSEGMENT
  50.  
  51. SEGMENT MVELCH
  52. REAL*8 VALMAT(NV1)
  53. ENDSEGMENT
  54.  
  55. SEGMENT MWRK2
  56. REAL*8 XE(3,NBNN)
  57. REAL*8 TXR(IDIM,IDIM),XLOC(3,3),XGLOB(3,3)
  58. REAL*8 ROTS(NEPTH,NEPTH)
  59. ENDSEGMENT
  60.  
  61. SEGMENT MWRK3
  62. REAL*8 RES(NEPTH)
  63. ENDSEGMENT
  64.  
  65. SEGMENT ISEG(0)
  66.  
  67. PARAMETER (NINF=3)
  68. INTEGER INFOS(NINF)
  69. DIMENSION CRIGI(12)
  70. CHARACTER*8 CMATE,PHAM
  71. CHARACTER*(NCONCH) CONM
  72. LOGICAL LOGMA,LOGMF,lsupde,lsupma,lsupte
  73.  
  74. IRET=0
  75.  
  76. c preliminaire : modèle effectif
  77.  
  78. C 1 - VERIFICATIONS DES DONNEES DE L'OPERATEUR
  79. C ==============================================
  80. C 1.1 - Verification du lieu support du MCHAML de caracteristiques
  81. C =====
  82. ISupC=0
  83. CALL QUESUP(IPMODL,IPCHE1,5,0,ISupC,iOK)
  84. IF (ISupC.GT.1) RETURN
  85. C =====
  86. C 1.2 - Verification du lieu support du MCHAML de temperatures
  87. C =====
  88. ISupT=0
  89. CALL QUESUP(IPMODL,IPCHE2,5,0,ISupT,iOK)
  90. IF (ISupT.GT.1) RETURN
  91.  
  92. C 2 - QUELQUES INITIALISATIONS
  93. C ==============================
  94. C 2.1 - Activation du MMODEL
  95. C =====
  96. MMODEL=IPMODL
  97. NSOUS =KMODEL(/1)
  98. C =====
  99. C 2.2 - Activation du MCHELM associe au champ de deformations
  100. C =====
  101. L1=12
  102. N1=NSOUS
  103. N3=6
  104. SEGINI,MCHELM
  105. TITCHE='DEFORMATIONS'
  106. IFOCHE=IFOUR
  107. IPEPTH=MCHELM
  108. C =====
  109. C 2.3 - Initialisation du segment du type des composantes du champ de
  110. C temperatures et defini une seule fois (identique sur IPMODL)
  111. C =====
  112. NBTYPE=1
  113. SEGINI,NOTYPE
  114. TYPE(1)='REAL*8'
  115. MOTYTE=NOTYPE
  116.  
  117. C 3 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (iSou)
  118. C ========================================================
  119. KSOU = 0
  120. DO iSou=1,NSOUS
  121. C =====
  122. C 3.1 - Quelques initialisations
  123. C =====
  124. lsupma =.true.
  125. lsupte =.true.
  126. MOTEMP = 0
  127. IVATEM = 0
  128. MOMATR = 0
  129. IVAMAT = 0
  130. MOCARA = 0
  131. IVACAR = 0
  132. MOEPTH = 0
  133. IVAETH = 0
  134. MCHAML = 0
  135. TEMP = XZero
  136. THM = XZero
  137. THIF = XZero
  138. THSU = XZero
  139. IPMINT = 0
  140. C =====
  141. C 3.2 - Activation du sous-modele (iSou)
  142. C =====
  143. IMODEL = KMODEL(iSou)
  144. MELE = NEFMOD
  145. IPMAIL = IMAMOD
  146. CONM = CONMOD
  147.  
  148. PHAM =conm(17:24)
  149. NPINT =0
  150. * l operateur sait ce qu il peut traiter
  151. if(formod(1)(1:9).ne.'MECANIQUE'.and.
  152. &formod(1)(1:6).ne.'POREUX'.and.formod(1)(1:7).ne.'LIQUIDE')
  153. & goto 98
  154. KSOU = KSOU + 1
  155. IF (INFMOD(/1).NE.0) NPINT=INFMOD(1)
  156. C =====
  157. C 3.3 - Determination ...
  158. C =====
  159. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,iOK)
  160. IF (iOK.EQ.0) GOTO 210
  161. iOK=0
  162. C =====
  163. C 3.4 - Determination de la nature du materiau et verification
  164. C =====
  165. C* NFOR=FORMOD(/2)
  166. C* NMAT=MATMOD(/2)
  167. C* CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
  168. CMATE = CMATEE
  169. MATE = IMATEE
  170. INAT = INATUU
  171. C* IF (CMATE.EQ.' ') THEN
  172. C* CALL ERREUR(251)
  173. C* GOTO 210
  174. C* ENDIF
  175. LOGMA = CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  176. & CMATE.EQ.'UNIDIREC'
  177. C =====
  178. C 3.5 - Recuperation d'informations sur l'element fini du sous-modele
  179. C Activation du segment d'integration
  180. C =====
  181. * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  182. * IF (IERR.NE.0) GOTO 210
  183. * INFO=IPINF
  184. NBGS=INFELE(4)
  185. IPORE=INFELE(8)
  186. * IPMINT=INFELE(11)
  187. IPMINT=infmod(7)
  188. MINTE=IPMINT
  189. if (mele.eq.260) then
  190. nbpgau=5
  191. else
  192. NBPGAU=POIGAU(/1)
  193. endif
  194. MFR=INFELE(13)
  195. NEPTH=INFELE(16)
  196. LOGMF = MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33.OR.MFR.EQ.63
  197. C =====
  198. C 3.6 - Recuperation d'informations liees au maillage IPMAIL
  199. C =====
  200. MELEME=IPMAIL
  201. NBNN=NUM(/1)
  202. NBELEM=NUM(/2)
  203. NBNO=NBNN
  204. IPPORE=0
  205. IF (MFR.EQ.33) THEN
  206. NBNO=IPORE
  207. IPPORE=NBNN
  208. ENDIF
  209. IF (MFR.EQ.63) THEN
  210. C NBNO=IPORE
  211. IPPORE=NBNN
  212. ENDIF
  213. C =====
  214. C 3.7 - Recuperation des temperatures associees au sous-modele
  215. C Verification de leur presence dans le MCHAML (IPCHE2)
  216. C =====
  217. NFAC=0
  218. if(lnomid(8).ne.0) then
  219. lsupte=.false.
  220. nomid =lnomid(8)
  221. motemp=nomid
  222. ntem =lesobl(/2)
  223. nfac =lesfac(/2)
  224. else
  225. CALL IDTEMP(MFR,IFOUR,NPINT,MOTEMP,NTEM,NFAC)
  226. endif
  227. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOTEMP,MOTYTE,1,INFOS,3,IVATEM)
  228. IF (IERR.NE.0) GOTO 230
  229. IF (ISupT.EQ.1)THEN
  230. CALL VALCHE(IVATEM,NTEM,IPMINT,IPPORE,MOTEMP,MELE)
  231. IF (IERR.NE.0) THEN
  232. ISupT=0
  233. GOTO 230
  234. ENDIF
  235. ENDIF
  236. C =====
  237. C 3.8 - Recuperation des noms des caracteristiques MATERIAU
  238. C Traitement suivant la formulation MFR et l'element fini MELE
  239. C Verification de leur presence dans le MCHAML (IPCHE1)
  240. C =====
  241. NBROBL=0
  242. NBRFAC=0
  243. NOMID =0
  244. C= 3.8.1 - Elements POUTRE,BARRE,POI1,TUYAUX...
  245. IF (MELE.EQ.29.OR.MELE.EQ. 42.OR.MELE.EQ. 45.OR.MELE.EQ. 46.OR.
  246. . MELE.EQ.95.OR.MELE.EQ.123.OR.MELE.EQ.124) THEN
  247. NBROBL=2
  248. SEGINI,NOMID
  249. LESOBL(1)='ALPH'
  250. LESOBL(2)='TALP'
  251.  
  252. C= 3.8.2 - Materiau isotrope
  253. ELSEIF (CMATE.EQ.'ISOTROPE') THEN
  254. NBROBL=2
  255. SEGINI,NOMID
  256. IF (MFR.EQ.35) THEN
  257. LESOBL(1)='ALPN'
  258. ELSE
  259. LESOBL(1)='ALPH'
  260. ENDIF
  261. LESOBL(2)='TALP'
  262.  
  263. C= 3.8.3 - Materiau orthotrope
  264. ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  265. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  266. NBROBL=5
  267. SEGINI,NOMID
  268. LESOBL(1)='ALP1'
  269. LESOBL(2)='ALP2'
  270. LESOBL(3)='V1X'
  271. LESOBL(4)='V1Y'
  272. LESOBL(5)='TALP'
  273. ELSEIF (MFR.EQ.75) THEN
  274. IF (IDIM.EQ.3) THEN
  275. NBROBL=7
  276. SEGINI,NOMID
  277. LESOBL(1)='ALPN'
  278. LESOBL(2)='ALP1'
  279. LESOBL(3)='ALP2'
  280. LESOBL(4)='ALQN'
  281. LESOBL(5)='ALQ1'
  282. LESOBL(6)='ALQ2'
  283. LESOBL(7)='TALP'
  284. ELSEIF (IDIM.EQ.2) THEN
  285. NBROBL=4
  286. SEGINI,NOMID
  287. LESOBL(1)='ALPN'
  288. LESOBL(2)='ALPS'
  289. LESOBL(3)='ALQS'
  290. LESOBL(4)='TALP'
  291. ENDIF
  292. ELSEIF (MFR.EQ.35) THEN
  293. NBROBL=4
  294. SEGINI,NOMID
  295. LESOBL(1)='ALPN'
  296. LESOBL(2)='V1X'
  297. LESOBL(3)='V1Y'
  298. LESOBL(4)='TALP'
  299. ELSEIF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  300. IF (IFOUR.EQ.-2) THEN
  301. NBROBL=5
  302. SEGINI,NOMID
  303. LESOBL(1)='ALP1'
  304. LESOBL(2)='ALP2'
  305. LESOBL(3)='V1X'
  306. LESOBL(4)='V1Y'
  307. LESOBL(5)='TALP'
  308. ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.-3.OR.
  309. . IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  310. NBROBL=6
  311. SEGINI,NOMID
  312. LESOBL(1)='ALP1'
  313. LESOBL(2)='ALP2'
  314. LESOBL(3)='ALP3'
  315. LESOBL(4)='V1X'
  316. LESOBL(5)='V1Y'
  317. LESOBL(6)='TALP'
  318. ELSEIF (IFOUR.EQ.2) THEN
  319. NBROBL=10
  320. SEGINI,NOMID
  321. LESOBL(1 )='ALP1'
  322. LESOBL(2 )='ALP2'
  323. LESOBL(3 )='ALP3'
  324. LESOBL(4 )='V1X '
  325. LESOBL(5 )='V1Y '
  326. LESOBL(6 )='V1Z '
  327. LESOBL(7 )='V2X '
  328. LESOBL(8 )='V2Y '
  329. LESOBL(9 )='V2Z '
  330. LESOBL(10)='TALP'
  331. ELSEIF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  332. IF (IFOUR.EQ.6) THEN
  333. NBROBL=2
  334. SEGINI,NOMID
  335. LESOBL(1)='ALP1'
  336. LESOBL(2)='TALP'
  337. ELSEIF (IFOUR.EQ.5.OR.IFOUR.EQ.10) THEN
  338. NBROBL=3
  339. SEGINI,NOMID
  340. LESOBL(1)='ALP1'
  341. LESOBL(2)='ALP3'
  342. LESOBL(3)='TALP'
  343. ELSEIF (IFOUR.EQ.4.OR.IFOUR.EQ.8.OR.IFOUR.EQ.13) THEN
  344. NBROBL=3
  345. SEGINI,NOMID
  346. LESOBL(1)='ALP1'
  347. LESOBL(2)='ALP2'
  348. LESOBL(3)='TALP'
  349. ELSE
  350. NBROBL=4
  351. SEGINI,NOMID
  352. LESOBL(1)='ALP1'
  353. LESOBL(2)='ALP2'
  354. LESOBL(3)='ALP3'
  355. LESOBL(4)='TALP'
  356. ENDIF
  357. ENDIF
  358. ENDIF
  359.  
  360. C= 3.8.4 - Materiau anisotrope
  361. ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  362. IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  363. IF (IFOUR.EQ.-2) THEN
  364. NBROBL=6
  365. SEGINI,NOMID
  366. LESOBL(1)='ALP1'
  367. LESOBL(2)='ALP2'
  368. LESOBL(3)='AL12'
  369. LESOBL(4)='V1X '
  370. LESOBL(5)='V1Y '
  371. LESOBL(6)='TALP'
  372. ELSEIF (IFOUR.EQ.-3 .OR.IFOUR.EQ.-1.OR.
  373. . IFOUR.EQ. 0 .OR.IFOUR.EQ. 1) THEN
  374. NBROBL=7
  375. SEGINI,NOMID
  376. LESOBL(1)='ALP1'
  377. LESOBL(2)='ALP2'
  378. LESOBL(3)='AL12'
  379. LESOBL(4)='ALP3'
  380. LESOBL(5)='V1X '
  381. LESOBL(6)='V1Y '
  382. LESOBL(7)='TALP'
  383. ELSEIF (IFOUR.EQ.2) THEN
  384. NBROBL=13
  385. SEGINI,NOMID
  386. LESOBL(1 )='ALP1'
  387. LESOBL(2 )='ALP2'
  388. LESOBL(3 )='ALP3'
  389. LESOBL(4 )='AL12'
  390. LESOBL(5 )='AL13'
  391. LESOBL(6 )='AL23'
  392. LESOBL(7 )='V1X '
  393. LESOBL(8 )='V1Y '
  394. LESOBL(9 )='V1Z '
  395. LESOBL(10)='V2X '
  396. LESOBL(11)='V2Y '
  397. LESOBL(12)='V2Z '
  398. LESOBL(13)='TALP'
  399. ENDIF
  400. ELSEIF (MFR.EQ.75) THEN
  401. IF (IDIM.EQ.3) THEN
  402. NBROBL=7
  403. SEGINI,NOMID
  404. LESOBL(1)='ALP1'
  405. LESOBL(2)='ALP2'
  406. LESOBL(3)='ALP3'
  407. LESOBL(4)='ALQ1'
  408. LESOBL(5)='ALQ2'
  409. LESOBL(6)='ALQ3'
  410. LESOBL(7)='TALP'
  411. ELSEIF (IDIM.EQ.2) THEN
  412. NBROBL=4
  413. SEGINI,NOMID
  414. LESOBL(1)='ALP1'
  415. LESOBL(2)='ALP2'
  416. LESOBL(3)='ALQ3'
  417. LESOBL(4)='TALP'
  418. ENDIF
  419. ENDIF
  420.  
  421. C= 3.8.5 - Materiau unidirectionnel
  422. ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  423. IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  424. NBROBL=8
  425. SEGINI,NOMID
  426. LESOBL(1)='ALPH'
  427. LESOBL(2)='V1X '
  428. LESOBL(3)='V1Y '
  429. LESOBL(4)='V1Z '
  430. LESOBL(5)='V2X '
  431. LESOBL(6)='V2Y '
  432. LESOBL(7)='V2Z '
  433. LESOBL(8)='TALP'
  434. ELSE
  435. NBROBL=4
  436. SEGINI,NOMID
  437. LESOBL(1)='ALPH'
  438. LESOBL(2)='V1X '
  439. LESOBL(3)='V1Y '
  440. LESOBL(4)='TALP'
  441. ENDIF
  442.  
  443. ELSE
  444. if(lnomid(6).ne.0) then
  445. lsupma=.false.
  446. nomid=lnomid(6)
  447. momatr=nomid
  448. nmatr=lesobl(/2)
  449. nmatf=lesfac(/2)
  450. else
  451. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  452. endif
  453. NOMID =MOMATR
  454. NBROBL=NMATR
  455. NBRFAC=NMATF
  456. ENDIF
  457.  
  458. MOMATR = NOMID
  459. NMATR = NBROBL
  460. NMATF = NBRFAC
  461. NMATT = NMATR + NMATF
  462. NBGMAT = 0
  463. NELMAT = 0
  464. C= 3.8.6 - Verification de la presence des caracteristiques dans IPCHE1
  465. IF (MOMATR.NE.0) THEN
  466. IF (CMATE.EQ.'SECTION') THEN
  467. NBTYPE=3
  468. SEGINI,NOTYPE
  469. TYPE(1)='POINTEURMMODEL'
  470. TYPE(2)='POINTEURMCHAML'
  471. TYPE(3)='POINTEURLISTREEL'
  472. ELSE
  473. NBTYPE=1
  474. SEGINI,NOTYPE
  475. TYPE(1)='REAL*8'
  476. ENDIF
  477. MOTYPE=NOTYPE
  478. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,
  479. . INFOS,3,IVAMAT)
  480. SEGSUP,NOTYPE
  481. IF (IERR.NE.0) GOTO 240
  482. IF (ISupC.EQ.1) THEN
  483. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  484. IF (IERR.NE.0)THEN
  485. ISupC=0
  486. GOTO 240
  487. ENDIF
  488. ENDIF
  489. MPTVAL=IVAMAT
  490. MELVAL=IVAL(1)
  491. DO i=1,NMATT
  492. IF (IVAL(i).NE.0) THEN
  493. MELVAL=IVAL(i)
  494. IF (CMATE.EQ.'SECTION') THEN
  495. NBGMAT=MAX(NBGMAT,IELCHE(/1))
  496. NELMAT=MAX(NELMAT,IELCHE(/2))
  497. ELSE
  498. NBGMAT=MAX(NBGMAT,VELCHE(/1))
  499. NELMAT=MAX(NELMAT,VELCHE(/2))
  500. ENDIF
  501. ENDIF
  502. ENDDO
  503. ENDIF
  504. C =====
  505. C 3.9 - Recuperation des noms des caracteristiques
  506. C =====
  507. NBROBL=0
  508. NBRFAC=0
  509. IVECT =0
  510. NOMID =0
  511. NOTYPE=0
  512. C= 3.9.1 - Elements COQUES : epaisseur
  513. IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  514. NBROBL=1
  515. SEGINI,NOMID
  516. LESOBL(1)='EPAI'
  517. NBTYPE=1
  518. SEGINI,NOTYPE
  519. TYPE(1)='REAL*8'
  520. C= 3.9.2 - Elements BARREs et CERCEs : section
  521. ELSEIF (MFR.EQ.27) THEN
  522. NBROBL=1
  523. SEGINI,NOMID
  524. LESOBL(1)='SECT'
  525. NBTYPE=1
  526. SEGINI,NOTYPE
  527. TYPE(1)='REAL*8'
  528. C= 3.9.3 - Elements BAEX : section, excentrements et orientation
  529. ELSEIF (MFR.EQ.49) THEN
  530. NBROBL=6
  531. SEGINI,NOMID
  532. LESOBL(1)='SECT'
  533. LESOBL(2)='EXCZ'
  534. LESOBL(3)='EXCY'
  535. LESOBL(4)='VX '
  536. LESOBL(5)='VY '
  537. LESOBL(6)='VZ '
  538. NBTYPE=1
  539. SEGINI,NOTYPE
  540. TYPE(1)='REAL*8'
  541. C= 3.9.4 - Elements POUTREs
  542. ELSEIF (MFR.EQ.7) THEN
  543. IF (CMATE.NE.'SECTION') THEN
  544. NBROBL=1
  545. SEGINI,NOMID
  546. LESOBL(1)='SECT'
  547. NBTYPE=1
  548. SEGINI,NOTYPE
  549. TYPE(1)='REAL*8'
  550. ENDIF
  551. C= 3.9.5 - Elements TUYAUx
  552. ELSEIF (MFR.EQ.13) THEN
  553. NBROBL=2
  554. NBRFAC=2
  555. SEGINI,NOMID
  556. LESOBL(1)='EPAI'
  557. LESOBL(2)='RAYO'
  558. LESFAC(1)='RACO'
  559. LESFAC(2)='VECT'
  560. IVECT=1
  561. NBTYPE=4
  562. SEGINI,NOTYPE
  563. TYPE(1)='REAL*8'
  564. TYPE(2)='REAL*8'
  565. TYPE(3)='REAL*8'
  566. TYPE(4)='POINTEURPOINT '
  567. ENDIF
  568. MOCARA= NOMID
  569. NCARA = NBROBL
  570. NCARF = NBRFAC
  571. NCARR = NCARA + NCARF
  572.  
  573. C= 3.9.6 - Verification de leur presence dans IPCHE1
  574. IF (MOCARA.NE.0) THEN
  575. MOTYPE=NOTYPE
  576. IF (IPCHE1.NE.0) THEN
  577. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,
  578. . INFOS,3,IVACAR)
  579. SEGSUP,NOTYPE
  580. IF (IERR.NE.0) GOTO 250
  581. IF (IVECT.EQ.1) THEN
  582. MPTVAL=IVACAR
  583. IF (IVAL(NCARR).EQ.0) THEN
  584. IVECT=2
  585. NOMID=MOCARA
  586. NBRFAC=NBRFAC+2
  587. SEGADJ,NOMID
  588. LESFAC(NBRFAC-2)='VX '
  589. LESFAC(NBRFAC-1)='VY '
  590. LESFAC(NBRFAC) ='VZ '
  591. MOCARA=NOMID
  592. NBTYPE=1
  593. SEGINI,NOTYPE
  594. TYPE(1)='REAL*8'
  595. MOTYPE=NOTYPE
  596. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,
  597. . INFOS,3,IVACAR)
  598. SEGSUP,NOTYPE
  599. IF (IERR.NE.0) GOTO 250
  600. NCARA=NBROBL
  601. NCARF=NBRFAC
  602. NCARR=NCARA+NCARF
  603. ENDIF
  604. ENDIF
  605.  
  606. ELSE
  607. MOTERR(1:4)='CARA'
  608. MOTERR(5:8)='CARA'
  609. MOTERR(9:12)=NOMTP(MELE)
  610. MOTERR(13:20)='EPTH'
  611. CALL ERREUR(145)
  612. SEGSUP,NOTYPE
  613. GOTO 250
  614. ENDIF
  615.  
  616. IF (ISupC.EQ.1) THEN
  617. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  618. IF (IERR.NE.0) THEN
  619. ISupC=0
  620. GOTO 250
  621. ENDIF
  622. ENDIF
  623. ENDIF
  624. C ======
  625. C 3.10 - Recuperation des noms des composantes de deformations
  626. C ======
  627. if(lnomid(5).ne.0) then
  628. nomid=lnomid(5)
  629. moepth=nomid
  630. lsupde=.false.
  631. nstr=lesobl(/2)
  632. else
  633. CALL IDDEFO(IMODEL,IFOUR,MOEPTH,NSTR,NFAC)
  634. lsupde=.true.
  635. endif
  636.  
  637. C Meme verification que dans modeli.eso (On a eu un BUG une fois)
  638. IF(NSTR .NE. NEPTH)THEN
  639. IPT1 =IMAMOD
  640. MOTERR =NOMS(IPT1.ITYPEL)
  641. INTERR(1)=NSTR
  642. INTERR(2)=NEPTH
  643. CALL ERREUR(1098)
  644. RETURN
  645. ENDIF
  646. C ======
  647. C 3.11 - Initialisation du MCHAML des contraintes de Von Mises (MCHAML)
  648. C associe au modele elementaire iSou (de maillage IPMAIL)
  649. C Remplissage des donnees associees a MCHAML dans MCHELM(global)
  650. C ======
  651. C= 3.11.1 - Initialisation de MCHAML
  652. N2=NEPTH
  653. SEGINI,MCHAML
  654. C= 3.11.2 - Remplissage de MCHEML (KSou)
  655. CONCHE(KSou)=CONM
  656. IMACHE(KSou)=IPMAIL
  657. ICHAML(KSou)=MCHAML
  658. INFCHE(KSou,1)=0
  659. INFCHE(KSou,2)=0
  660. INFCHE(KSou,3)=NIFOUR
  661. INFCHE(KSou,4)=IPMINT
  662. INFCHE(KSou,5)=0
  663. INFCHE(KSou,6)=5
  664. C= 3.11.3 - Initialisation des N2 MELVAL associes a MCHAML
  665. C= Fin du remplissage de MCHAML
  666. N1PTEL=NBGS
  667. N1EL=NBELEM
  668. IF (MELE.EQ.30.OR.MELE.EQ.43) THEN
  669. N1PTEL=1
  670. N1EL =1
  671. ENDIF
  672. N2PTEL=0
  673. N2EL =0
  674. NS =1
  675. NCOSOU=N2
  676. SEGINI,MPTVAL
  677. IVAETH=MPTVAL
  678. NOMID=MOEPTH
  679. DO i=1,N2
  680. NOMCHE(i)=LESOBL(i)
  681. TYPCHE(i)='REAL*8'
  682. SEGINI,MELVAL
  683. IELVAL(i)=MELVAL
  684. IVAL(i) =MELVAL
  685. ENDDO
  686. C ======
  687. C 3.12 - Initialisation de quelques segments de travail
  688. C Recuperation des fonctions de forme et de leurs derivees au
  689. C centre de l'element pour le calcul des axes locaux
  690. C ======
  691. IF (LOGMA) THEN
  692. IF (LOGMF) THEN
  693. IELE=NUMGEO(MELE)
  694. CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPT1,IRT1)
  695. IF (IERR.NE.0) GOTO 260
  696. MINTE2=IPT1
  697. ENDIF
  698. SEGINI,MWRK2
  699. ENDIF
  700. NV1=NMATT
  701. SEGINI,MVELCH,MWRK3
  702. C ======
  703. C 3.13 - Boucle sur les elements du sous-modele elementaire
  704. C ======
  705. DO 10 iElt=1,NBELEM
  706. C= 3.13.1 - Cas des elements MASSIFs - materiau a "TROPIE"
  707. C= Recuperation des coordonnees des noeuds de l element iElt
  708. C= Determination des axes locaux aux noeuds
  709. IF (LOGMA.AND.LOGMF) THEN
  710. CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE)
  711. NBSH=MINTE2.SHPTOT(/2)
  712. CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  713. IF (nbsh.EQ.-1) THEN
  714. CALL ERREUR(525)
  715. GOTO 260
  716. ENDIF
  717. ENDIF
  718. C= 3.13.2 - Cas de la poutre TIMO et modele SECTION
  719. IF (CMATE.EQ.'SECTION') THEN
  720. MPTVAL=IVAMAT
  721. MELVAL=IVAL(1)
  722. IBMN=MIN(iElt,IELCHE(/2))
  723. IPMODL=IELCHE(1,IBMN)
  724. MELVAL=IVAL(2)
  725. IBMN=MIN(iElt,IELCHE(/2))
  726. IPMAT=IELCHE(1,IBMN)
  727. CALL FRIGTH(IPMODL,IPMAT,CRIGI,0,0)
  728. ENDIF
  729.  
  730.  
  731. C= 3.13.3 - Boucle sur les points de Gauss
  732.  
  733. DO 100 iGau=1,NBPGAU
  734. C= 3.13.3.1 - Remplissage du tableau des caracteristiques du materiau
  735. IF (CMATE.NE.'SECTION') THEN
  736. MPTVAL=IVAMAT
  737. DO i=1,NMATT
  738. MELVAL=IVAL(i)
  739. IBMN=MIN(iElt,VELCHE(/2))
  740. IGMN=MIN(iGau,VELCHE(/1))
  741. VALMAT(i)=VELCHE(IGMN,IBMN)
  742. ENDDO
  743. ENDIF
  744. C= 3.13.3.2 - Prise en compte des epaisseur et excentrement dans le cas
  745. C= des coques minces avec ou sans cisaillement transverse
  746. IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.
  747. $ OR.CMATE.EQ.'UNIDIREC') .AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
  748. MPTVAL=IVACAR
  749. MELVAL=IVAL(1)
  750. IF (MELVAL.NE.0) THEN
  751. IBMN=MIN(iElt,VELCHE(/2))
  752. IGMN=MIN(iGau,VELCHE(/1))
  753. EPAIST=VELCHE(IGMN,IBMN)
  754. ELSE
  755. CALL ERREUR(527)
  756. GOTO 260
  757. ENDIF
  758. ENDIF
  759. C= 3.13.3.3 - Recuperation des temperatures du point de Gauss iGau (T et TALP)
  760. C TEMP = T_courant - T_ALPHA_REFERENCE
  761. MPTVAL=IVAMAT
  762. MELVAL=IVAL(IVAL(/1))
  763. TALP =VELCHE(IGMN,IBMN)
  764.  
  765. MPTVAL=IVATEM
  766. MELVAL=IVAL(1)
  767. IGMN=MIN(iGau,VELCHE(/1))
  768. IBMN=MIN(iElt,VELCHE(/2))
  769. TEMP=VELCHE(IGMN,IBMN) - TALP
  770.  
  771. C write(6,*) 'EPTHP',ielt,igau,igmn,ibmn,temp
  772. IF (((MFR.EQ.3.OR.MFR.EQ.9).AND.(CMATE.EQ.'ISOTROPE'.
  773. $ OR.CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'UNIDIREC')).
  774. $ OR.(MFR.EQ.5.AND.
  775. $ (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'))) THEN
  776. IF (NPINT.EQ.0) THEN
  777. THIF=TEMP
  778. TEMP=XZero
  779. MELVAL=IVAL(2)
  780. IGMN=MIN(iGau,VELCHE(/1))
  781. IBMN=MIN(iElt,VELCHE(/2))
  782. THM=VELCHE(IGMN,IBMN)
  783. MELVAL=IVAL(3)
  784. IGMN=MIN(iGau,VELCHE(/1))
  785. IBMN=MIN(iElt,VELCHE(/2))
  786. THSU=VELCHE(IGMN,IBMN)
  787. ENDIF
  788. E3=DZEGAU(iGau)
  789. ELSE
  790. IF (CMATE.EQ.'SECTION') TEMP=TEMP*CRIGI(1)
  791. ENDIF
  792.  
  793. C= 3.13.3.4 - Cas ISOTROPE : calcul des deformations thermiques
  794. IF (CMATE.EQ.'ISOTROPE') THEN
  795. CALL EPTHIS(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  796. . E3,EPAIST,RES,NPINT,KERRE)
  797. C= 3.13.3.5 - Cas ORTHOTROPE : calcul des deformations thermiques
  798. ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  799. IF (NPINT.EQ.0) THEN
  800. CALL EPTHOR(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  801. . E3,EPAIST,TXR,XLOC,XGLOB,ROTS,RES,KERRE)
  802. ELSE
  803. KERRE=19
  804. ENDIF
  805. C= 3.13.3.6 - Cas ANISOTROPE : calcul des deformations thermiques
  806. ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  807. IF (NPINT.EQ.0) THEN
  808. CALL EPTHAN(MFR,MELE,VALMAT,NEPTH,TEMP,TXR,XLOC,XGLOB,
  809. . ROTS,RES,KERRE)
  810. ELSE
  811. KERRE=19
  812. ENDIF
  813. C= 3.13.3.7 - Cas UNIDIRECTIONNEL : calcul des deformations thermiques
  814. ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  815. IF (NPINT.EQ.0) THEN
  816. CALL EPTHUN(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  817. . EPAIST,TXR,XLOC,XGLOB,ROTS,RES,KERRE)
  818. ELSE
  819. KERRE=19
  820. ENDIF
  821. C= 3.13.3.8 - Cas HOMOGENEISE et SECTION : calcul des deformations ther.
  822. ELSEIF (CMATE.EQ.'HOMOGENE'.OR.CMATE.EQ.'SECTION') THEN
  823. IF (NPINT.EQ.0) THEN
  824. CALL EPTHHS(MELE,VALMAT,NEPTH,TEMP,RES,KERRE)
  825. ELSE
  826. KERRE=19
  827. ENDIF
  828. C= 3.13.3.9 - Cas non prevus et traitement des ERREURS
  829. ELSE
  830. KERRE=19
  831. ENDIF
  832. IF (KERRE.EQ.19) THEN
  833. CALL ERREUR(19)
  834. GOTO 260
  835. ELSEIF (KERRE.EQ.86) THEN
  836. MOTERR(1:4)=NOMTP(MELE)
  837. MOTERR(5:12)='EPTH'
  838. CALL ERREUR(86)
  839. GOTO 260
  840. ENDIF
  841. C= 3.13.3.10 - Stockage des deformations dans les MELVAL
  842. MPTVAL=IVAETH
  843. DO i=1,NEPTH
  844. MELVAL=IVAL(i)
  845. VELCHE(iGau,iElt)=RES(i)
  846. ENDDO
  847.  
  848. C Fin boucle sur les points de Gauss
  849. 100 CONTINUE
  850.  
  851. C Fin boucle sur les elements
  852. 10 CONTINUE
  853.  
  854. C Traitement elements ICompressibles (methode BBAR)
  855. IF (MFR.EQ.31) THEN
  856. IELE=NUMGEO(MELE)
  857. CALL RESHPT(NBPGAU,NBNO,IELE,MELE,NPINT,IPMINT,IRT1)
  858. IF (IERR.NE.0) RETURN
  859. IPCHA1 = MCHAML
  860. CALL EPTBBA(MELE,IPCHA1,IPMINT,IPMAIL,IPCHA2)
  861. IF (IERR.NE.0) RETURN
  862. IF (IPCHA2.NE.MCHAML) SEGSUP,MCHAML
  863. MCHAML = IPCHA2
  864. ICHAML(KSou)=MCHAML
  865. ENDIF
  866.  
  867. C ======
  868. C 3.14 - Desactivation/suppression de segments associes a iSou
  869. C Sortie prematuree en cas d'ERREUR (iOK=0)
  870. C ======
  871. IF (IERR.EQ.0) iOK=1
  872. 260 SEGSUP,MVELCH,MWRK3
  873. IF (MOEPTH.NE.0) THEN
  874. NOMID=MOEPTH
  875. if(lsupde)SEGSUP,NOMID
  876. ENDIF
  877. IF (LOGMA) THEN
  878. SEGSUP,MWRK2
  879. ENDIF
  880. 250 IF (MOCARA.NE.0) THEN
  881. NOMID=MOCARA
  882. SEGSUP,NOMID
  883. IF (ISupC.EQ.1) THEN
  884. CALL DTMVAL(IVACAR,3)
  885. ELSE
  886. CALL DTMVAL(IVACAR,1)
  887. ENDIF
  888. ENDIF
  889. 240 IF (MOMATR.NE.0) THEN
  890. NOMID=MOMATR
  891. if(lsupma)SEGSUP,NOMID
  892. IF (ISupC.EQ.1) THEN
  893. CALL DTMVAL(IVAMAT,3)
  894. ELSE
  895. CALL DTMVAL(IVAMAT,1)
  896. ENDIF
  897. ENDIF
  898. 230 IF (MOTEMP.NE.0) THEN
  899. NOMID=MOTEMP
  900. if(lsupte)SEGSUP,NOMID
  901. ENDIF
  902. IF (ISupT.EQ.1) THEN
  903. CALL DTMVAL(IVATEM,3)
  904. ELSE
  905. CALL DTMVAL(IVATEM,1)
  906. ENDIF
  907. 220 CONTINUE
  908. 210 CONTINUE
  909. IF (iOK.EQ.0) THEN
  910. CALL DTMVAL(IVAETH,3)
  911. IF (MCHAML.NE.0) SEGSUP,MCHAML
  912. SEGSUP,MCHELM
  913. GOTO 300
  914. ENDIF
  915. CALL DTMVAL(IVAETH,1)
  916. 98 CONTINUE
  917. ENDDO
  918.  
  919. C 4 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
  920. C ====================================================
  921. IRET=1
  922. N1 = KSOU
  923. SEGADJ MCHELM
  924. 300 CONTINUE
  925. NOTYPE=MOTYTE
  926. SEGSUP,NOTYPE
  927.  
  928. END
  929.  
  930.  
  931.  
  932.  

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