Télécharger epthp.eso

Retour à la liste

Numérotation des lignes :

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

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