Télécharger sigmap.eso

Retour à la liste

Numérotation des lignes :

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

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