Télécharger epthp.eso

Retour à la liste

Numérotation des lignes :

  1. C EPTHP SOURCE CB215821 18/09/21 21:15:46 9930
  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. C SEGDES,MELEME
  839. 220 CONTINUE
  840. if (IPMINT.NE.0) SEGDES,MINTE
  841. 210 CONTINUE
  842. C 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. SEGACT,MCHELM
  857. 300 CONTINUE
  858. C SEGDES,MMODEL
  859. NOTYPE=MOTYTE
  860. SEGSUP,NOTYPE
  861.  
  862. RETURN
  863. END
  864.  
  865.  
  866.  
  867.  
  868.  
  869.  
  870.  
  871.  
  872.  
  873.  
  874.  

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