Télécharger epthp.eso

Retour à la liste

Numérotation des lignes :

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

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