Télécharger epthp.eso

Retour à la liste

Numérotation des lignes :

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

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