Télécharger sigmap.eso

Retour à la liste

Numérotation des lignes :

  1. C SIGMAP SOURCE PV 19/01/25 21:15:22 10085
  2. SUBROUTINE SIGMAP(IBID2,IPMODL,IPCHP1,IPCHE1,IPCHE2,IMAT,
  3. 1 IPSTRS,IRET,inoer)
  4. C_______________________________________________________________________
  5. C
  6. C OPERATEUR CONTRAINTES LINEAIRES APPELE PAR SIGMA
  7. C
  8. C Entr{es:
  9. C ________
  10. C
  11. C IPMODL Pointeur sur un MMODEL
  12. C IPCHP1 Pointeur sur un CHAMPOINT d{placements
  13. C IPCHE1 Pointeur sur un MCHAML de caract{ristiques
  14. C IPCHE2 Pointeur sur un MCHAML de HOOKE
  15. C IMAT Flag de HOOKE (2 si oui, 1 sinon)
  16. C
  17. C Sorties:
  18. C ________
  19. C
  20. C IPSTRS Pointeur sur un MCHAML de CONTRAINTES
  21. C IRET 1 ou 0 suivant succes ou pas
  22. C
  23. C AUTEURS L.EBERSOLT(JANVIER 84 ) POUR LE CALCUL
  24. C D.BROCHARD (FEVRIER 87 ) POUR LA MISE EN FORME
  25. C SIGMA-SIGMAP
  26. C Passage aux nouveaux chamelems par i.monnier le 7.6.90
  27. C
  28. C ELEMENTS MASSIFS ANISOTROPES PAR P.DOWLATYARI DEC. 90
  29. C_______________________________________________________________________
  30. C
  31. IMPLICIT INTEGER(I-N)
  32. IMPLICIT REAL*8(A-H,O-Z)
  33. *
  34. -INC CCOPTIO
  35. -INC CCHAMP
  36. -INC CCREEL
  37. -INC SMCHAML
  38. -INC SMCHPOI
  39. -INC SMELEME
  40. -INC SMCOORD
  41. -INC SMMODEL
  42. -INC SMINTE
  43. -INC SMLREEL
  44. C
  45. SEGMENT NOTYPE
  46. CHARACTER*16 TYPE(NBTYPE)
  47. ENDSEGMENT
  48. *
  49. SEGMENT MPTVAL
  50. INTEGER IPOS(NS) ,NSOF(NS)
  51. INTEGER IVAL(NCOSOU)
  52. CHARACTER*16 TYVAL(NCOSOU)
  53. ENDSEGMENT
  54. *
  55. CHARACTER*8 CMATE
  56. CHARACTER*(NCONCH) CONM
  57. PARAMETER ( NINF=3 )
  58. INTEGER INFOS(NINF)
  59. LOGICAL LDPGE,lsupdp,lsupco,lsupma
  60. C
  61. IRET = 0
  62. IPSTRS = 0
  63. C
  64. NHRM=NIFOUR
  65. ISUP=0
  66. ISUP1=0
  67. MCHAML=0
  68. C
  69. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE HOOKE
  70. C
  71. IF (IMAT.EQ.2) THEN
  72. CALL QUESUP(IPMODL,IPCHE2,5,1,ISUP,IRETHO)
  73. IF (ISUP.NE.0) RETURN
  74. ENDIF
  75. C
  76. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUE
  77. C
  78. IF (IPCHE1.NE.0) THEN
  79. CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRETCA)
  80. IF (ISUP1.GT.1) RETURN
  81. ENDIF
  82.  
  83. C____________________________________________________________________
  84. C
  85. C ON CONVERTIT LE CHAMP POINT EN CHAMP PAR ELEMENT
  86. C____________________________________________________________________
  87. C
  88. CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHA1,1)
  89. IF (IERR.NE.0) RETURN
  90. C
  91. C ACTIVATION DU MODELE
  92. C
  93. MMODEL=IPMODL
  94. SEGACT MMODEL
  95. NSOUS=KMODEL(/1)
  96. C
  97. C CREATION DU MCHELM
  98. C
  99. C=============================================
  100. N1=NSOUS
  101. DO IJKL=1,NSOUS
  102. IMODEL=KMODEL(IJKL)
  103. SEGACT IMODEL
  104. IF (NEFMOD.EQ.22.OR.NEFMOD.EQ.259) N1=N1-1
  105. IF (FORMOD(1).EQ.'CHARGEMENT') N1=N1-1
  106. END DO
  107. C WRITE(*,*) 'NSOUS=',NSOUS
  108. C WRITE(*,*) 'N1=',N1
  109. C=============================================
  110. L1=11
  111. N3=6
  112. SEGINI MCHELM
  113. TITCHE='CONTRAINTES'
  114. IFOCHE=IFOUR
  115. C
  116. C____________________________________________________________________
  117. C
  118. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  119. C____________________________________________________________________
  120. C
  121. ISOUS=0
  122. DO 500 KISOUS=1,NSOUS
  123. *
  124. * INITIALISATION
  125. *
  126. IVAMAT=0
  127. IVACAR=0
  128. IVASTR=0
  129. IVADEP=0
  130. IPMING=0
  131. MOSTRS=0
  132. MODEPL=0
  133. MOMATR=0
  134. MOCARA=0
  135. C
  136. C ON RECUPERE L INFORMATION GENERALE
  137. C
  138. IMODEL=KMODEL(KISOUS)
  139. C* SEGACT IMODEL
  140. C=============================================
  141. MELE=NEFMOD
  142. if((MELE.eq.22).OR.(MELE.eq.259)) go to 500
  143. IF (FORMOD(1).EQ.'CHARGEMENT') GOTO 500
  144. ISOUS=ISOUS+1
  145. C==============================================
  146. C
  147. C TRAITEMENT DU MODELE
  148. C
  149. IIPDPG=imodel.IPDPGE
  150. IIPDPG=IPTPOI(IIPDPG)
  151. IPMAIL=IMAMOD
  152. CONM =CONMOD
  153. ideri=ideriv
  154. ireps2=0
  155. if(ideri.eq.2.and.ibid2.eq.0) ireps2=1
  156. IMACHE(ISOUS)=IPMAIL
  157. CONCHE(ISOUS)=CONMOD
  158. C
  159. C COQUE INTEGREE OU PAS ?
  160. C
  161. IF(INFMOD(/1).NE.0)THEN
  162. NPINT=INFMOD(1)
  163. ELSE
  164. NPINT=0
  165. ENDIF
  166. C
  167. C NATURE DU MATERIAU
  168. C
  169. * NFOR=FORMOD(/2)
  170. * NMAT=MATMOD(/2)
  171. * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
  172. CMATE = CMATEE
  173. MATE = IMATEE
  174. INAT = INATUU
  175. IF (CMATE.EQ.' ')THEN
  176. CALL ERREUR(251)
  177. GOTO 9990
  178. ENDIF
  179. C____________________________________________________________________
  180. C
  181. C INFORMATION SUR L'ELEMENT FINI
  182. C____________________________________________________________________
  183. * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  184. * IF (IERR.NE.0) GOTO 9990
  185. * INFO=IPINF
  186. MFR =INFELE(13)
  187. IELE =INFELE(14)
  188. IPORE=INFELE(8)
  189. NBG =INFELE(6)
  190. NBGS =INFELE(4)
  191. NSTRS=INFELE(16)
  192. LRE =INFELE(9)
  193. LW =INFELE(7)
  194. LHOOK=INFELE(10)
  195. NDDL =INFELE(15)
  196. * MINTE=INFELE(11)
  197. MINTE=INFMOD(7)
  198. MINTE1=INFMOD(8)
  199. IPMINT=MINTE
  200. IPMIN1=MINTE1
  201. C
  202. CALL INFDPG(MFR,IFOUR, LDPGE,ndpge)
  203. C
  204. C CREATION DU TABLEAU INFOS
  205. C
  206. CALL IDENT(IPMAIL,CONM,IPCHA1,IPCHE1,INFOS,IRTD)
  207. IF (IRTD.EQ.0) GOTO 9990
  208. C
  209. INFCHE(ISOUS,1)=0
  210. INFCHE(ISOUS,2)=0
  211. INFCHE(ISOUS,3)=NHRM
  212. INFCHE(ISOUS,4)=MINTE
  213. INFCHE(ISOUS,5)=0
  214. INFCHE(ISOUS,6)=5
  215. C
  216. C INITIALISATION DE MINTE
  217. C
  218. if(mele.ne.260) then
  219. SEGACT MINTE
  220. NBPGAU=POIGAU(/1)
  221. endif
  222. C
  223. C ACTIVATION DU MELEME
  224. C
  225. MELEME=IPMAIL
  226. SEGACT MELEME
  227. NBNN =NUM(/1)
  228. NBELEM=NUM(/2)
  229. IPPORE=0
  230. IF(MFR.EQ.33) THEN
  231. IPPORE=NBNN
  232. ELSE IF(MFR.EQ.57.OR.MFR.EQ.59) THEN
  233. IPPORE=NBNN
  234. LHOOK=4
  235. IF(IFOUR.EQ.1.OR.IFOUR.EQ.-3) LHOOK=6
  236. ENDIF
  237. LHOO2=LHOOK*LHOOK
  238. C
  239. C EXTRACTION DES DEPLACEMENTS DU NOEUD SUPPORT DE LA
  240. C DEFORMATION PLANE GENERALISEE
  241. C
  242. IF (LDPGE) THEN
  243. IF (IIPDPG.LE.0) THEN
  244. CALL ERREUR(925)
  245. ELSE
  246. CALL DEPDPG(IPCHP1,UZDPG,RXDPG,RYDPG,IIPDPG)
  247. ENDIF
  248. IF (IERR.NE.0) GOTO 9990
  249. ELSE
  250. UZDPG=XZero
  251. RXDPG=XZero
  252. RYDPG=XZero
  253. ENDIF
  254. C____________________________________________________________________
  255. C
  256. C RECHERCHE DES NOMS DE COMPOSANTES
  257. C____________________________________________________________________
  258. C
  259. if(lnomid(4).ne.0) then
  260. lsupco=.false.
  261. nomid=lnomid(4)
  262. segact nomid
  263. mostrs=nomid
  264. nstr=lesobl(/2)
  265. nfac=lesfac(/2)
  266. else
  267. lsupco=.true.
  268. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  269. endif
  270. C
  271. if(lnomid(1).ne.0) then
  272. lsupdp=.false.
  273. nomid=lnomid(1)
  274. segact nomid
  275. modepl=nomid
  276. ndep=lesobl(/2)
  277. nfac=lesfac(/2)
  278. else
  279. lsupdp=.true.
  280. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEP,NFAC)
  281. endif
  282. C____________________________________________________________________
  283. C
  284. C VERIFICATION DE LEUR PRESENCE
  285. C____________________________________________________________________
  286. C
  287. NBTYPE=1
  288. SEGINI NOTYPE
  289. MOTYPE=NOTYPE
  290. TYPE(1)='REAL*8'
  291. CALL KOMCHA(IPCHA1,IPMAIL,CONM,MODEPL,MOTYPE,1,INFOS,3,IVADEP)
  292. SEGSUP NOTYPE
  293. IF (IERR.NE.0) GOTO 9990
  294. C
  295. C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  296. C
  297. N1PTEL=NBGS
  298. N1EL=NBELEM
  299. NBPTEL=N1PTEL
  300. NEL=N1EL
  301. C
  302. C CREATION DU MCHAML DE LA SOUS ZONE
  303. C
  304. N2=NSTRS
  305. SEGINI MCHAML
  306. ICHAML(ISOUS)=MCHAML
  307. NS=1
  308. NCOSOU=NSTRS
  309. SEGINI MPTVAL
  310. IVASTR=MPTVAL
  311. NOMID=MOSTRS
  312. SEGACT NOMID
  313. DO 100 ICOMP=1,NSTRS
  314. NOMCHE(ICOMP)=LESOBL(ICOMP)
  315. TYPCHE(ICOMP)='REAL*8'
  316. N2PTEL=0
  317. N2EL=0
  318. SEGINI MELVAL
  319. IELVAL(ICOMP)=MELVAL
  320. IVAL(ICOMP)=MELVAL
  321. 100 CONTINUE
  322. C____________________________________________________________________
  323. C
  324. * RANGEMENT DE LA MATRICE DE HOOKE DANS UN TABLEAU DE TRAVAIL *
  325. C____________________________________________________________________
  326. *
  327. lsupma=.true.
  328. IF (IMAT.EQ.2) THEN
  329. IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN
  330. NBROBL=3
  331. NBRFAC=0
  332. SEGINI NOMID
  333. LESOBL(1)='MAHO'
  334. LESOBL(2)='V1X '
  335. LESOBL(3)='V1Y '
  336. ELSE
  337. NBROBL=1
  338. NBRFAC=0
  339. SEGINI NOMID
  340. LESOBL(1)='MAHO'
  341. ENDIF
  342. MOMATR=NOMID
  343. NMATR=NBROBL
  344. NMATF=NBRFAC
  345. IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN
  346. NBTYPE=3
  347. SEGINI NOTYPE
  348. TYPE(1)='POINTEURLISTREEL'
  349. TYPE(2)='REAL*8'
  350. TYPE(3)='REAL*8'
  351. ELSE
  352. NBTYPE=1
  353. SEGINI NOTYPE
  354. TYPE(1)='POINTEURLISTREEL'
  355. ENDIF
  356. MOTYPE=NOTYPE
  357. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  358. SEGSUP NOTYPE
  359. IF (IERR.NE.0) GOTO 9990
  360. MPTVAL=IVAMAT
  361. MELVAL=IVAL(1)
  362. NBGMAT=IELCHE(/1)
  363. NELMAT=IELCHE(/2)
  364. NMATT=NMATR+NMATF
  365. ELSE
  366. C____________________________________________________________________
  367. *
  368. * SINON TRAITEMENT DES CHAMPS DE MATERIAU
  369. C____________________________________________________________________
  370. *
  371. IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
  372. NBROBL=2
  373. NBRFAC=0
  374. SEGINI NOMID
  375. MOMATR=NOMID
  376. IF (MFR.EQ.35) THEN
  377. LESOBL(1)='KS '
  378. LESOBL(2)='KN '
  379. ELSE IF(MFR.EQ.53) THEN
  380. NBROBL=1
  381. SEGADJ,NOMID
  382. LESOBL(1)='KS '
  383. ELSE
  384. LESOBL(1)='YOUN'
  385. LESOBL(2)='NU '
  386. ENDIF
  387. NMATR=NBROBL
  388. NMATF=NBRFAC
  389. ELSE
  390. $ IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
  391. IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  392. NBROBL=7
  393. NBRFAC=0
  394. SEGINI NOMID
  395. MOMATR=NOMID
  396. LESOBL(1)='YOUN'
  397. LESOBL(2)='V1X '
  398. LESOBL(3)='V1Y '
  399. LESOBL(4)='V1Z '
  400. LESOBL(5)='V2X '
  401. LESOBL(6)='V2Y '
  402. LESOBL(7)='V2Z '
  403. ELSE
  404. NBROBL=3
  405. NBRFAC=0
  406. SEGINI NOMID
  407. MOMATR=NOMID
  408. LESOBL(1)='YOUN'
  409. LESOBL(2)='V1X '
  410. LESOBL(3)='V1Y '
  411. ENDIF
  412. NMATR=NBROBL
  413. NMATF=NBRFAC
  414. ELSE
  415. $ IF (FORMOD(1).EQ.'POREUX '.AND.CMATE.EQ.'ISOTROPE') THEN
  416. IF (MELE.GE.79.AND.MELE.LE.83) THEN
  417. NBROBL=4
  418. NBRFAC=0
  419. SEGINI NOMID
  420. MOMATR=NOMID
  421. LESOBL(1)='YOUN'
  422. LESOBL(2)='NU '
  423. LESOBL(3)='COB '
  424. LESOBL(4)='MOB '
  425. ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  426. NBROBL=4
  427. NBRFAC=0
  428. SEGINI NOMID
  429. MOMATR=NOMID
  430. LESOBL(1)='KS '
  431. LESOBL(2)='KN '
  432. LESOBL(3)='COB '
  433. LESOBL(4)='MOB '
  434. ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN
  435. NBROBL=10
  436. NBRFAC=0
  437. SEGINI NOMID
  438. MOMATR=NOMID
  439. LESOBL(1)='YOUN'
  440. LESOBL(2)='NU '
  441. LESOBL(3)='COP1'
  442. LESOBL(4)='COP2'
  443. LESOBL(5)='CPP1'
  444. LESOBL(6)='CPP2'
  445. LESOBL(7)='KK11'
  446. LESOBL(8)='KK12'
  447. LESOBL(9)='KK21'
  448. LESOBL(10)='KK22'
  449. ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN
  450. NBROBL=17
  451. NBRFAC=0
  452. SEGINI NOMID
  453. MOMATR=NOMID
  454. LESOBL(1)='YOUN'
  455. LESOBL(2)='NU '
  456. LESOBL(3)='COP1'
  457. LESOBL(4)='COP2'
  458. LESOBL(5)='COP3'
  459. LESOBL(6)='CPP1'
  460. LESOBL(7)='CPP2'
  461. LESOBL(8)='CPP3'
  462. LESOBL(9)='KK11'
  463. LESOBL(10)='KK12'
  464. LESOBL(11)='KK13'
  465. LESOBL(12)='KK21'
  466. LESOBL(13)='KK22'
  467. LESOBL(14)='KK23'
  468. LESOBL(15)='KK31'
  469. LESOBL(16)='KK32'
  470. LESOBL(17)='KK33'
  471. ELSE IF (MELE.GE.185.AND.MELE.LE.187) THEN
  472. NBROBL=10
  473. NBRFAC=0
  474. SEGINI NOMID
  475. MOMATR=NOMID
  476. LESOBL(1)='KS '
  477. LESOBL(2)='KN '
  478. LESOBL(3)='COP1'
  479. LESOBL(4)='COP2'
  480. LESOBL(5)='CPP1'
  481. LESOBL(6)='CPP2'
  482. LESOBL(7)='KK11'
  483. LESOBL(8)='KK12'
  484. LESOBL(9)='KK21'
  485. LESOBL(10)='KK22'
  486. ELSE IF (MELE.GE.188.AND.MELE.LE.190) THEN
  487. NBROBL=17
  488. NBRFAC=0
  489. SEGINI NOMID
  490. MOMATR=NOMID
  491. LESOBL(1)='KS '
  492. LESOBL(2)='KN '
  493. LESOBL(3)='COP1'
  494. LESOBL(4)='COP2'
  495. LESOBL(5)='COP3'
  496. LESOBL(6)='CPP1'
  497. LESOBL(7)='CPP2'
  498. LESOBL(8)='CPP3'
  499. LESOBL(9)='KK11'
  500. LESOBL(10)='KK12'
  501. LESOBL(11)='KK13'
  502. LESOBL(12)='KK21'
  503. LESOBL(13)='KK22'
  504. LESOBL(14)='KK23'
  505. LESOBL(15)='KK31'
  506. LESOBL(16)='KK32'
  507. LESOBL(17)='KK33'
  508. ENDIF
  509. NMATR=NBROBL
  510. NMATF=NBRFAC
  511. *
  512. ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  513. NBROBL=6
  514. NBRFAC=0
  515. SEGINI NOMID
  516. MOMATR=NOMID
  517. LESOBL(1)='YG1 '
  518. LESOBL(2)='YG2 '
  519. LESOBL(3)='NU12'
  520. LESOBL(4)='G12 '
  521. LESOBL(5)='V1X '
  522. LESOBL(6)='V1Y '
  523. NMATR=NBROBL
  524. NMATF=NBRFAC
  525. *
  526. * ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  527. * Pour l'instant, lnomid(6) ou appel a IDMATR suffisent.
  528. *
  529. ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
  530. lsupma = .true.
  531. CALL IDDILI(MATE,1,MOMATR,NMATR,NMATF)
  532. *
  533. * Autres cas :
  534. ELSE
  535. if(lnomid(6).ne.0) then
  536. nomid=lnomid(6)
  537. segact nomid
  538. momatr=nomid
  539. nmatr=lesobl(/2)
  540. nmatf=lesfac(/2)
  541. lsupma=.false.
  542. else
  543. lsupma=.true.
  544. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  545. endif
  546. ENDIF
  547. *
  548. IF (CMATE.EQ.'SECTION') THEN
  549. NBTYPE=3
  550. SEGINI NOTYPE
  551. TYPE(1)='POINTEURMMODEL'
  552. TYPE(2)='POINTEURMCHAML'
  553. TYPE(3)='POINTEURLISTREEL'
  554. ELSE
  555. NBTYPE=1
  556. SEGINI NOTYPE
  557. TYPE(1)='REAL*8'
  558. ENDIF
  559. MOTYPE=NOTYPE
  560. *
  561. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  562. SEGSUP NOTYPE
  563. IF (IERR.NE.0) GOTO 9990
  564. *
  565. NMATT=NMATR+NMATF
  566. * C
  567. IF(ISUP1.EQ.1)THEN
  568. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  569. IF(IERR.NE.0)THEN
  570. ISUP1=0
  571. GOTO 9990
  572. ENDIF
  573. ENDIF
  574. MPTVAL=IVAMAT
  575. NBGMAT = 0
  576. NELMAT = 0
  577. DO 1108 IM=1,NMATT
  578. IF(IVAL(IM).NE.0)THEN
  579. MELVAL=IVAL(IM)
  580. IF (CMATE.EQ.'SECTION') THEN
  581. NBGMAT=MAX(NBGMAT,IELCHE(/1))
  582. NELMAT=MAX(NELMAT,IELCHE(/2))
  583. ELSE
  584. NBGMAT=MAX(NBGMAT,VELCHE(/1))
  585. NELMAT=MAX(NELMAT,VELCHE(/2))
  586. ENDIF
  587. ENDIF
  588. 1108 CONTINUE
  589. ENDIF
  590. C____________________________________________________________________
  591. C
  592. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
  593. C____________________________________________________________________
  594. C
  595. NBROBL=0
  596. NBRFAC=0
  597. MOCARA=0
  598. IVECT=0
  599. *
  600. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  601. *
  602. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  603. NBROBL=1
  604. NBRFAC=1
  605. SEGINI NOMID
  606. MOCARA=NOMID
  607. LESOBL(1)='EPAI'
  608. LESFAC(1)='EXCE'
  609. *
  610. NBTYPE=1
  611. SEGINI NOTYPE
  612. MOTYPE=NOTYPE
  613. TYPE(1)='REAL*8'
  614. *
  615. * SECTION POUR LES BARRES
  616. *
  617. ELSE IF (MFR.EQ.27) THEN
  618. NBROBL=1
  619. SEGINI NOMID
  620. MOCARA=NOMID
  621. LESOBL(1)='SECT'
  622. *
  623. NBTYPE=1
  624. SEGINI NOTYPE
  625. MOTYPE=NOTYPE
  626. TYPE(1)='REAL*8'
  627. *
  628. * section, excentrements et orientation pour les barres excentrees
  629. *
  630. ELSE IF (MFR.EQ.49) THEN
  631. NBROBL=6
  632. SEGINI NOMID
  633. MOCARA=NOMID
  634. LESOBL(1)='SECT'
  635. LESOBL(2)='EXCZ'
  636. LESOBL(3)='EXCY'
  637. LESOBL(4)='VX '
  638. LESOBL(5)='VY '
  639. LESOBL(6)='VZ '
  640. *
  641. NBTYPE=1
  642. SEGINI NOTYPE
  643. MOTYPE=NOTYPE
  644. TYPE(1)='REAL*8'
  645. *
  646. * raideurs locales et orientation pour l'element LIA2
  647. * de liaison a 2 noeuds
  648. *
  649. ELSE IF (MFR.EQ.51) THEN
  650. NBROBL=9
  651. SEGINI NOMID
  652. MOCARA=NOMID
  653. LESOBL(1)='RLUX'
  654. LESOBL(2)='RLUY'
  655. LESOBL(3)='RLUZ'
  656. LESOBL(4)='RLRX'
  657. LESOBL(5)='RLRY'
  658. LESOBL(6)='RLRZ'
  659. LESOBL(7)='VX '
  660. LESOBL(8)='VY '
  661. LESOBL(9)='VZ '
  662. *
  663. NBTYPE=1
  664. SEGINI NOTYPE
  665. MOTYPE=NOTYPE
  666. TYPE(1)='REAL*8'
  667. *
  668. * CARACTERISTIQUES POUR LES POUTRES
  669. *
  670. ELSE IF (MFR.EQ.7 ) THEN
  671. IF ((CMATE.EQ.'SECTION')) THEN
  672. NBROBL=0
  673. NBRFAC=1
  674. SEGINI NOMID
  675. MOCARA=NOMID
  676. LESFAC(1)='VECT'
  677. IVECT=1
  678. *
  679. NBTYPE=1
  680. SEGINI NOTYPE
  681. MOTYPE=NOTYPE
  682. TYPE(1)='POINTEURPOINT '
  683. *
  684. * CAS 2D
  685. *
  686. ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  687. NBRFAC=1
  688. NBROBL=2
  689. SEGINI NOMID
  690. MOCARA=NOMID
  691. LESOBL(1)= 'SECT'
  692. LESOBL(2)= 'INRZ'
  693. LESFAC(1)= 'SECY'
  694. *
  695. NBTYPE=1
  696. SEGINI NOTYPE
  697. MOTYPE=NOTYPE
  698. TYPE(1)='REAL*8'
  699. *
  700. ELSE
  701. NBROBL=4
  702. NBRFAC=3
  703. SEGINI NOMID
  704. MOCARA=NOMID
  705. LESOBL(1)='TORS'
  706. LESOBL(2)='INRY'
  707. LESOBL(3)='INRZ'
  708. LESOBL(4)='SECT'
  709. LESFAC(1)='SECY'
  710. LESFAC(2)='SECZ'
  711. LESFAC(3)='VECT'
  712. IVECT=1
  713. *
  714. NBTYPE=7
  715. SEGINI NOTYPE
  716. MOTYPE=NOTYPE
  717. TYPE(1)='REAL*8'
  718. TYPE(2)='REAL*8'
  719. TYPE(3)='REAL*8'
  720. TYPE(4)='REAL*8'
  721. TYPE(5)='REAL*8'
  722. TYPE(6)='REAL*8'
  723. TYPE(7)='POINTEURPOINT '
  724. ENDIF
  725. *
  726. * CARACTERISTIQUES POUR LES TUYAUX
  727. *
  728. ELSE IF (MFR.EQ.13) THEN
  729. NBROBL=2
  730. NBRFAC=4
  731. SEGINI NOMID
  732. MOCARA=NOMID
  733. LESOBL(1)='EPAI'
  734. LESOBL(2)='RAYO'
  735. LESFAC(1)='RACO'
  736. LESFAC(2)='PRES'
  737. LESFAC(3)='CISA'
  738. LESFAC(4)='VECT'
  739. IVECT=1
  740. *
  741. NBTYPE=6
  742. SEGINI NOTYPE
  743. MOTYPE=NOTYPE
  744. TYPE(1)='REAL*8'
  745. TYPE(2)='REAL*8'
  746. TYPE(3)='REAL*8'
  747. TYPE(4)='REAL*8'
  748. TYPE(5)='REAL*8'
  749. TYPE(6)='POINTEURPOINT '
  750. *
  751. * CARACTERISTIQUES POUR LES LINESPRING
  752. *
  753. ELSE IF (MFR.EQ.15) THEN
  754. NBROBL=5
  755. SEGINI NOMID
  756. MOCARA=NOMID
  757. LESOBL(1)='EPAI'
  758. LESOBL(2)='FISS'
  759. LESOBL(3)='VX '
  760. LESOBL(4)='VY '
  761. LESOBL(5)='VZ '
  762. *
  763. NBTYPE=1
  764. SEGINI NOTYPE
  765. MOTYPE=NOTYPE
  766. TYPE(1)='REAL*8'
  767. *
  768. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  769. *
  770. ELSE IF (MFR.EQ.17) THEN
  771. NBROBL=9
  772. SEGINI NOMID
  773. MOCARA=NOMID
  774. LESOBL(1)='RAYO'
  775. LESOBL(2)='EPAI'
  776. LESOBL(3)='VX '
  777. LESOBL(4)='VY '
  778. LESOBL(5)='VZ '
  779. LESOBL(6)='VXF '
  780. LESOBL(7)='VYF '
  781. LESOBL(8)='VZF '
  782. LESOBL(9)='ANGL'
  783. *
  784. NBTYPE=1
  785. SEGINI NOTYPE
  786. MOTYPE=NOTYPE
  787. TYPE(1)='REAL*8'
  788. *
  789. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  790. *
  791. ELSE IF (MFR.EQ.37) THEN
  792. IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  793. NBROBL=4
  794. SEGINI NOMID
  795. MOCARA=NOMID
  796. LESOBL(1)='SCEL'
  797. LESOBL(2)='SFLU'
  798. LESOBL(3)='EPS '
  799. LESOBL(4)='XINE'
  800. ELSE
  801. NBROBL=3
  802. SEGINI NOMID
  803. MOCARA=NOMID
  804. LESOBL(1)='SCEL'
  805. LESOBL(2)='SFLU'
  806. LESOBL(3)='EPS '
  807. ENDIF
  808. *
  809. NBTYPE=1
  810. SEGINI NOTYPE
  811. MOTYPE=NOTYPE
  812. TYPE(1)='REAL*8'
  813. *
  814. *
  815. * EPAISSEUR POUR LES JOINTS GENERALISES
  816. *
  817. ELSE IF (MFR.EQ.55) THEN
  818. CcPPj NBROBL=1
  819. CcPPj NBRFAC=0
  820. CcPPj SEGINI NOMID
  821. CcPPj MOCARA=NOMID
  822. CcPPj LESOBL(1)='EPAI'
  823. NBROBL=0
  824. NBRFAC=1
  825. SEGINI NOMID
  826. MOCARA=NOMID
  827. LESFAC(1)='EPAI'
  828. *
  829. NBTYPE=1
  830. SEGINI NOTYPE
  831. MOTYPE=NOTYPE
  832. TYPE(1)='REAL*8'
  833. *
  834. * CARACTERISTIQUE MACRO_EL (element CIFL)
  835. *
  836. ELSE IF (MFR.EQ.61)THEN
  837. NBRFAC=0
  838. NBROBL=2
  839. SEGINI NOMID
  840. MOCARA=NOMID
  841. LESOBL(1)= 'SECT'
  842. LESOBL(2)= 'INRZ'
  843. *
  844. NBTYPE=1
  845. SEGINI NOTYPE
  846. MOTYPE=NOTYPE
  847. TYPE(1)='REAL*8'
  848. *
  849. ENDIF
  850. *
  851. IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN
  852. *
  853. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  854. $ IVACAR)
  855. SEGSUP NOTYPE
  856. IF (IERR.NE.0) GOTO 9990
  857. IF (IVECT.EQ.1) THEN
  858. MPTVAL=IVACAR
  859. IF (IVAL(NBROBL+NBRFAC).EQ.0) THEN
  860. *
  861. * MOT CLE VECT EN CAS DE CONVERSION
  862. *
  863. IVECT=2
  864. NOMID=MOCARA
  865. SEGACT NOMID
  866. NBRFAC=NBRFAC+2
  867. SEGADJ NOMID
  868. MOCARA=NOMID
  869. LESFAC(NBRFAC-2)='VX '
  870. LESFAC(NBRFAC-1)='VY '
  871. LESFAC(NBRFAC )='VZ '
  872. *
  873. NBTYPE=1
  874. SEGINI NOTYPE
  875. MOTYPE=NOTYPE
  876. TYPE(1)='REAL*8'
  877. *
  878. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  879. $ IVACAR)
  880. SEGSUP NOTYPE
  881. IF (IERR.NE.0) GOTO 9990
  882. ENDIF
  883. ENDIF
  884. ENDIF
  885. *
  886. NCARA=NBROBL
  887. NCARF=NBRFAC
  888. NCARR=NCARA+NCARF
  889. IF(ISUP1.EQ.1.AND.(MOCARA.NE.0.AND.IPCHE1.NE.0))THEN
  890. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  891. IF(IERR.NE.0)THEN
  892. ISUP1=0
  893. GOTO 9990
  894. ENDIF
  895. ENDIF
  896. *
  897. C_______________________________________________________________________
  898. C
  899. C NUMERO DES ETIQUETTES :
  900. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  901. C Les elements sont groupes comme suit :
  902. C - massif, poreux, joints poreux ------------------> sigma1
  903. C - coq3,dkt,coq4,coq8,coq2,joints -----------------> sigma2
  904. C - poutre,tuyau,linespring,tuyau fissure,barre ----> sigma3
  905. C et poutre de Timoschenko
  906. C_______________________________________________________________________
  907. C
  908. IF (MELE.LE.100)
  909. &GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  910. 1 99,99, 4, 4, 4, 4,27,27,29,29,99,99,99,99,99,99,99,99,99,99,
  911. 2 27,29,29,27,29,29,99,99,27,29,99,99,99,99,99,27,99,99,99,99,
  912. 3 99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  913. 4 4, 4, 4,29,27,27,27,27,99,99,99,99,27,99,29,29,99,99,99,99
  914. 5 ),MELE
  915. IF (MELE.LE.200)
  916. &GOTO (99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  917. 1 4, 4,29,29,29,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  918. 2 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  919. 3 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  920. 4 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34
  921. 5 ),MELE-100
  922. IF (MELE.LE.300)
  923. &GOTO (34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  924. 1 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  925. 2 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
  926. 3 34,34,34,34,29,34,34,34,34,34,34,34, 4, 4),MELE-200
  927. C
  928. C CASE OF THE NEW JOINT ELEMENTS (JCT3 AND JCI4)
  929. C (JGI2 2D GENERALIZED)
  930. C (JGT3 AND JGI4 GENERALIZED)
  931. C
  932. 34 CONTINUE
  933. IF (MELE.GE.168.AND.MELE.LE.172)GOTO 27
  934. *
  935. IF (MELE.GE.173.AND.MELE.LE.190) GOTO 4
  936. C Elements mecaniques 1D (M1Dx)
  937. IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
  938. C
  939. IF (MELE.EQ.258.OR.MELE.EQ.260) GOTO 29
  940. C POUR les XFEM on fait un cas particuliers
  941. IF(MFR.EQ.63) THEN
  942. CALL SIGMAX (MATE,IMAT,NBGMAT,NELMAT,NMATT,CMATE,
  943. & IVAMAT,IMODEL,IREPS2,IVADEP,
  944. & IVASTR,UZDPG,RYDPG,RXDPG,IIPDPG,IRETER)
  945. * write(*,*) 'retour de SIGMAX'
  946. IF(IRETER.NE.0) RETURN
  947. GO TO 9990
  948. ENDIF
  949. C fin des XFEM
  950. C
  951. 99 CONTINUE
  952. MOTERR(1:4)=NOMTP(MELE)
  953. MOTERR(9:12)='SIGM'
  954. CALL ERREUR(86)
  955. GOTO 9990
  956. C_______________________________________________________________________
  957. C
  958. C massifs, poreux, joints poreux
  959. C_______________________________________________________________________
  960. C
  961. 4 CONTINUE
  962. IF (MFR.EQ.71) THEN
  963. CALL SIGELE (MELE,IELE,IPMAIL,NBPGAU,IPMINT,NDEP,IVADEP,LHOOK,
  964. & LRE,MATE,IVAMAT,NMATT, IVASTR)
  965. ELSE IF (MFR.EQ.73) THEN
  966. CALL SIGDIF (MELE,IELE,IPMAIL,NBPGAU,IPMINT,NDEP,IVADEP,LHOOK,
  967. & LRE,MATE,IVAMAT,NMATT, IVASTR)
  968. ELSE
  969. CALL SIGMA1(MATE,IMAT,IPMAIL,IPMINT,MELE,IELE,IVADEP,
  970. & NBPTEL,LRE,NSTRS,IVAMAT,NBGMAT,NELMAT,LHOOK,NMATT,CMATE,
  971. & MFR,NDEP,IPORE,IREPS2,NBPGAU,IVASTR,UZDPG,RYDPG,RXDPG
  972. & , IIPDPG,inoer)
  973. ENDIF
  974. GOTO 9990
  975. C_______________________________________________________________________
  976. C
  977. C coq3,dkt,coq4,coq8,coq2 ,dst,joint 3D,joints 2D
  978. C_______________________________________________________________________
  979. C
  980. 27 CONTINUE
  981. CALL SIGMA2(IPMAIL,IVADEP,IVACAR,NELMAT,NBGMAT,IVAMAT,
  982. & LHOOK,IMAT,MATE,CMATE,NMATT,NSTRS,MFR,IPMINT,IPMIN1,
  983. & NDEP,NBPGAU,NBPTEL,MELE,LRE,LW,IREPS2,NPINT,IVASTR
  984. & ,UZDPG,RYDPG,RXDPG,IIPDPG,inoer)
  985. GOTO 9990
  986. C_______________________________________________________________________
  987. C
  988. C poutres,tuyau,linespring,tuyau fissure,barre
  989. C_______________________________________________________________________
  990. C
  991. 29 CONTINUE
  992. CALL SIGMA3(IPMAIL,IVADEP,NDEP,IVACAR,NCARR,IPMINT,IVECT,IVAMAT,
  993. & MELE,IMAT,NELMAT,NBGMAT,LHOOK,CMATE,IREPS2,NBPTEL,NSTRS,
  994. & MFR,NMATT,NBPGAU,ISOUS,LRE,LW,IVASTR,UZDPG,RYDPG,RXDPG
  995. & , IIPDPG,inoer)
  996. GOTO 9990
  997. C____________________________________________________________________
  998. C
  999. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  1000. C____________________________________________________________________
  1001. C
  1002. 9990 CONTINUE
  1003. SEGDES MELEME
  1004. if( mele.ne.260)SEGDES MINTE
  1005. *
  1006. IF(ISUP1.EQ.1.AND.IMAT.NE.2)THEN
  1007. CALL DTMVAL(IVAMAT,3)
  1008. ELSE
  1009. CALL DTMVAL(IVAMAT,1)
  1010. ENDIF
  1011. *
  1012. IF(ISUP1.EQ.1)THEN
  1013. CALL DTMVAL(IVACAR,3)
  1014. ELSE
  1015. CALL DTMVAL(IVACAR,1)
  1016. ENDIF
  1017. *
  1018. IF(IERR.NE.0)THEN
  1019. CALL DTMVAL(IVASTR,3)
  1020. ELSE
  1021. CALL DTMVAL(IVASTR,1)
  1022. ENDIF
  1023. *
  1024. CALL DTMVAL(IVADEP,1)
  1025. *
  1026. IF(MOMATR.NE.0)THEN
  1027. NOMID=MOMATR
  1028. if(lsupma)SEGSUP NOMID
  1029. ENDIF
  1030. *
  1031. IF(MOCARA.NE.0)THEN
  1032. NOMID=MOCARA
  1033. SEGSUP NOMID
  1034. ENDIF
  1035. *
  1036. IF(MOSTRS.NE.0)THEN
  1037. NOMID=MOSTRS
  1038. if(lsupco)SEGSUP NOMID
  1039. ENDIF
  1040. *
  1041. IF(MODEPL.NE.0)THEN
  1042. NOMID=MODEPL
  1043. if(lsupdp)SEGSUP NOMID
  1044. ENDIF
  1045. C
  1046. C DANS LE CAS D'ERREUR
  1047. C
  1048. IF(IERR.NE.0)THEN
  1049. IF (MCHAML.NE.0) SEGSUP MCHAML
  1050. GOTO 888
  1051. ELSE
  1052. SEGDES MCHAML
  1053. ENDIF
  1054. C
  1055. 500 CONTINUE
  1056.  
  1057. 888 CONTINUE
  1058. IF (IERR.NE.0) THEN
  1059. IRET = 0
  1060. SEGSUP MCHELM
  1061. IPSTRS = 0
  1062. ELSE
  1063. IRET = 1
  1064. SEGDES MCHELM
  1065. IPSTRS = MCHELM
  1066. ENDIF
  1067.  
  1068. MMODEL=IPMODL
  1069. NSOUS=KMODEL(/1)
  1070. DO I=1,NSOUS
  1071. IMODEL=KMODEL(I)
  1072. SEGDES,IMODEL
  1073. END DO
  1074. SEGDES,MMODEL
  1075.  
  1076. CALL DTCHAM(IPCHA1)
  1077.  
  1078. RETURN
  1079. END
  1080.  
  1081.  
  1082.  
  1083.  
  1084.  
  1085.  
  1086.  
  1087.  
  1088.  
  1089.  
  1090.  
  1091.  

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