Télécharger fcoul1.eso

Retour à la liste

Numérotation des lignes :

  1. C FCOUL1 SOURCE AM 16/04/12 21:15:38 8903
  2. SUBROUTINE FCOUL1(DEPSI,IPMODL,IPCHE1,IPCHE2,IPCAR,
  3. & SIGMA,IPCHE7,IPCHE8,IRETO,NSTRS2)
  4. **********************************************************************
  5. *
  6. * ECOULEMENT INELASTIQUE POUR LES MODELE A SECTION
  7. * Boucle sur les ss-zone du modele de section
  8. *
  9. **********************************************************************
  10. * Pierre Pegon (ISPRA) Juillet/Aout 1993
  11. **********************************************************************
  12. *
  13. * ENTREES:
  14. *
  15. * DEPSI(6) INCREMENT DE DEFORMATION POUR LA FIBRE CENTRALE
  16. * IPMODL = POINTEUR SUR UN OBJET MMODEL
  17. * IPCHE1 = POINTEUR SUR UN MCHAML DE CONTRAINTES INITIALES
  18. * IPCHE2 = POINTEUR SUR UN MCHAML DE VARIABLES INTERNES INITIALES
  19. * IPCAR = POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
  20. *
  21. * SORTIES:
  22. *
  23. * SIGMA(6) ELEMENT DE REDUCTION DES EFFORT POUR LA FIBRE CENTRALE
  24. * IPCHE7 = POINTEUR SUR UN MCHAML DE CONTRAINTES
  25. * IPCHE8 = POINTEUR SUR UN MCHAML DE VARIABLES INTERNES
  26. *
  27. ************************************************************************
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8(A-H,O-Z)
  30. *
  31. -INC CCOPTIO
  32. -INC SMCHAML
  33. -INC SMELEME
  34. -INC SMCOORD
  35. -INC SMMODEL
  36. -INC SMINTE
  37. -INC CCHAMP
  38. C
  39. DIMENSION DEPSI(NSTRS2),SIGMA(NSTRS2)
  40.  
  41. SEGMENT NOTYPE
  42. CHARACTER*16 TYPE(NBTYPE)
  43. ENDSEGMENT
  44. *
  45. SEGMENT MPTVAL
  46. INTEGER IPOS(NS) ,NSOF(NS)
  47. INTEGER IVAL(NCOSOU)
  48. CHARACTER*16 TYVAL(NCOSOU)
  49. ENDSEGMENT
  50. *
  51. CHARACTER*8 CMATE
  52. CHARACTER*(NCONCH) CONM
  53. CHARACTER*16 MOMODL(10)
  54. PARAMETER ( NINF=3 )
  55. INTEGER INFOS(NINF)
  56. LOGICAL lsupva,lsupco,lsupma,lsupca
  57. C
  58. IRETO=0
  59. NHRM=NIFOUR
  60. C
  61. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CONTRAINTES
  62. C
  63. CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1)
  64. IF (ISUP1.GT.1) RETURN
  65. *
  66. * VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES
  67. *
  68. CALL QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2)
  69. IF (ISUP2.GT.1) RETURN
  70. C
  71. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  72. C
  73. CALL QUESUP(IPMODL,IPCAR,5,0,ISUP5,IRET5)
  74. IF (ISUP5.GT.1) RETURN
  75. C
  76. C ACTIVATION DU MODELE
  77. C
  78. MMODEL=IPMODL
  79. SEGACT MMODEL
  80. NSOUS=KMODEL(/1)
  81. C
  82. C CREATION DES 2 MCHELMS
  83. C
  84. N1=NSOUS
  85. L1=11
  86. N3=6
  87. SEGINI MCHELM
  88. TITCHE='CONTRAINTES'
  89. IFOCHE=IFOUR
  90. IPCHE7=MCHELM
  91. L1=18
  92. SEGINI MCHEL1
  93. MCHEL1.TITCHE='VARIABLES INTERNES'
  94. MCHEL1.IFOCHE=IFOUR
  95. IPCHE8=MCHEL1
  96. C
  97. C MISE A ZERO DES CONTRAINTES
  98. C
  99. DO IE1=1,NSTRS2
  100. SIGMA(IE1)=0.D0
  101. ENDDO
  102. C____________________________________________________________________
  103. C
  104. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  105. C____________________________________________________________________
  106. C
  107. *-DC-
  108. EPSUP=-1.0D10
  109. EPINF= 1.0D10
  110. *
  111. DAMAG= 0.0D0
  112. ETIQE= 0.0D0
  113. *-DC-
  114.  
  115. DO 1000 ISOUS=1,NSOUS
  116. *
  117. * INITIALISATION
  118. *
  119. NSTR=0
  120. MOSTRS=0
  121. IVASTR=0
  122. MOVARI=0
  123. NVARI=0
  124. NVARF=0
  125. IVARI=0
  126. NMATF=0
  127. NMATR=0
  128. MOMATR=0
  129. IVAMAT=0
  130. NCARA=0
  131. NCARF=0
  132. MOCARA=0
  133. IVACAR=0
  134. IVASTF=0
  135. IVARIF=0
  136. C
  137. C ON RECUPERE L INFORMATION GENERALE
  138. C
  139. IMODEL=KMODEL(ISOUS)
  140. SEGACT IMODEL
  141. IPMAIL=IMAMOD
  142. CONM =CONMOD
  143. IMACHE(ISOUS)=IPMAIL
  144. CONCHE(ISOUS)=CONMOD
  145. MCHEL1.IMACHE(ISOUS)=IPMAIL
  146. MCHEL1.CONCHE(ISOUS)=CONMOD
  147. *
  148. MELE=NEFMOD
  149. MELEME=IMAMOD
  150. SEGACT MELEME
  151. NBNN=NUM(/1)
  152. NBELEM=NUM(/2)
  153. C+PPf
  154. C ON EVACUE LE CAS DU SEGS EN 3D
  155. IF(MELE.EQ.166.AND.IDIM.EQ.3)THEN
  156. SEGDES IMODEL
  157. CALL ERREUR(832)
  158. GOTO 888
  159. ENDIF
  160. C+PPf
  161. C
  162. C TRAITEMENT DU MODELE
  163. C
  164. NFOR=FORMOD(/2)
  165. NMAT=MATMOD(/2)
  166. C
  167. C NATURE DU MATERIAU
  168. C
  169. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR)
  170. IF (CMATE.EQ.' ')THEN
  171. SEGDES IMODEL
  172. CALL ERREUR(251)
  173. GOTO 888
  174. ENDIF
  175. IF(MATE.NE.1)THEN
  176. SEGDES,IMODEL
  177. CALL ERREUR(635)
  178. GOTO 888
  179. ENDIF
  180. CALL TEMANF(INFIBR,NIFIBR)
  181. IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  182. CALL ERREUR(636)
  183. SEGDES,IMODEL
  184. GOTO 888
  185. ENDIF
  186. INFIBR=NIFIBR
  187. *
  188. C____________________________________________________________________
  189. C
  190. C INFORMATION SUR L'ELEMENT FINI
  191. C____________________________________________________________________
  192. C
  193. * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  194. * IF (IERR.NE.0) THEN
  195. * SEGDES,IMODEL
  196. * GOTO 888
  197. * ENDIF
  198. * INFO=IPINF
  199. MFR =INFELE(13)
  200. IPPORE=0
  201. IF(MFR.EQ.33) IPPORE=NBNN
  202. IF (MFR.NE.47)THEN
  203. CALL ERREUR(637)
  204. SEGDES IMODEL,MMODEL
  205. SEGSUP MCHELM,MCHEL1
  206. RETURN
  207. ENDIF
  208. NBG =INFELE(6)
  209. NBGS =INFELE(4)
  210. NSTRS=INFELE(16)
  211. LRE =INFELE(9)
  212. LHOOK=INFELE(10)
  213. LHOO2=LHOOK*LHOOK
  214. * MINTE=INFELE(11)
  215. MINTE=infmod(7)
  216. IPMINT=MINTE
  217. SEGACT,MINTE
  218. *
  219. * REMPLISSAGE DES TABLEAUX INFCHE
  220. *
  221. INFCHE(ISOUS,1)=0
  222. INFCHE(ISOUS,2)=0
  223. INFCHE(ISOUS,3)=NHRM
  224. INFCHE(ISOUS,4)=IPMINT
  225. INFCHE(ISOUS,5)=0
  226. INFCHE(ISOUS,6)=5
  227. *
  228. MCHEL1.INFCHE(ISOUS,1)=0
  229. MCHEL1.INFCHE(ISOUS,2)=0
  230. MCHEL1.INFCHE(ISOUS,3)=NHRM
  231. MCHEL1.INFCHE(ISOUS,4)=IPMINT
  232. MCHEL1.INFCHE(ISOUS,5)=0
  233. MCHEL1.INFCHE(ISOUS,6)=5
  234. C
  235. C CREATION DU TABLEAU INFOS
  236. C
  237. CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  238. IF (IRTD.EQ.0)THEN
  239. SEGDES IMODEL,MINTE
  240. * INFO=IPINF
  241. * SEGSUP INFO
  242. GOTO 888
  243. ENDIF
  244. *
  245. * TRAITEMENT DU CHAMP DE CONTRAINTES
  246. *
  247. if(lnomid(4).ne.0) then
  248. nomid=lnomid(4)
  249. segact nomid
  250. mostrs=nomid
  251. nstr=lesobl(/2)
  252. nfac=lesfac(/2)
  253. lsupco=.false.
  254. else
  255. lsupco=.true.
  256. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  257. endif
  258. IF (MOSTRS.EQ.0) THEN
  259. MOTERR(1:4)='CONT'
  260. MOTERR(5:8)=NOMTP(MELE)
  261. CALL ERREUR (76)
  262. SEGDES,IMODEL,MINTE
  263. * INFO=IPINF
  264. * SEGSUP INFO
  265. GOTO 888
  266. ENDIF
  267. *
  268. NBTYPE=1
  269. SEGINI NOTYPE
  270. MOTYPE=NOTYPE
  271. TYPE(1)='REAL*8'
  272. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  273. IF(IERR.NE.0)THEN
  274. SEGSUP NOTYPE
  275. GOTO 9990
  276. ENDIF
  277. *
  278. IF (ISUP1.EQ.1) THEN
  279. CALL VALCHE(IVASTR,NSTR,IPMINT,IPPORE,MOSTRS,MELE)
  280. IF(IERR.NE.0)THEN
  281. SEGSUP NOTYPE
  282. ISUP1=0
  283. GOTO 9990
  284. ENDIF
  285. ENDIF
  286. *
  287. * TRAITEMENT DU CHAMP DE VARIABLES INTERNES
  288. *
  289. if(lnomid(10).ne.0) then
  290. nomid=lnomid(10)
  291. segact nomid
  292. movari=nomid
  293. nvari=lesobl(/2)
  294. nvarf=lesfac(/2)
  295. lsupva=.false.
  296. else
  297. lsupva=.true.
  298. CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  299. endif
  300. * write(6,*) ' lnomid(10) nvari nvarf ', lnomid(10),nvari,nvarf
  301. IF (MOVARI.EQ.0) THEN
  302. MOTERR(1:4)='VARI'
  303. MOTERR(5:8)=NOMTP(MELE)
  304. CALL ERREUR (76)
  305. SEGSUP NOTYPE
  306. GOTO 9990
  307. ENDIF
  308. *
  309. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI)
  310. IF(IERR.NE.0)THEN
  311. SEGSUP NOTYPE
  312. GOTO 9990
  313. ENDIF
  314. *
  315. NVART=NVARI+NVARF
  316. IF (ISUP2.EQ.1) THEN
  317. CALL VALCHE(IVARI,NVART,IPMINT,IPPORE,MOVARI,MELE)
  318. IF(IERR.NE.0)THEN
  319. SEGSUP NOTYPE
  320. ISUP2=0
  321. GOTO 9990
  322. ENDIF
  323. ENDIF
  324. *
  325. * TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  326. *
  327. if(lnomid(6).ne.0) then
  328. nomid=lnomid(6)
  329. segact nomid
  330. momatr=nomid
  331. nmatr=lesobl(/2)
  332. nmatf=lesfac(/2)
  333. lsupma=.false.
  334. else
  335. lsupma=.true.
  336. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  337. endif
  338. IF (MOMATR.EQ.0) THEN
  339. MOTERR(1:4)='MATE'
  340. MOTERR(5:8)=NOMTP(MELE)
  341. CALL ERREUR (76)
  342. GOTO 9990
  343. ENDIF
  344. *
  345. IF (NIFIBR.NE.8) THEN
  346. NBTYPE=1
  347. SEGINI NOTYPE
  348. MOTYPE=NOTYPE
  349. TYPE(1)='REAL*8'
  350. *
  351. ELSE
  352. NBTYPE=13
  353. SEGINI NOTYPE
  354. MOTYPE=NOTYPE
  355. DO I=1,NBTYPE
  356. TYPE(I)='REAL*8'
  357. ENDDO
  358. TYPE(10)='POINTEUREVOLUTIO'
  359. TYPE(11)='POINTEUREVOLUTIO'
  360. *
  361. ENDIF
  362. *
  363. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  364. & INFOS,3,IVAMAT)
  365. SEGSUP NOTYPE
  366. IF(IERR.NE.0)THEN
  367. GOTO 9990
  368. ENDIF
  369. NMATT=NMATR+NMATF
  370. *
  371. IF (ISUP5.EQ.1) THEN
  372. CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  373. IF(IERR.NE.0)THEN
  374. ISUP5=0
  375. GOTO 9990
  376. ENDIF
  377. ENDIF
  378. *
  379. * TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  380. *
  381. if(lnomid(7).ne.0) then
  382. nomid=lnomid(7)
  383. segact nomid
  384. mocara=nomid
  385. ncara=lesobl(/2)
  386. ncarf=lesfac(/2)
  387. lsupca=.false.
  388. else
  389. lsupca=.true.
  390. CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
  391. endif
  392. *
  393. * write(6,*) ' lnomid(7) ncara ncarf ' , lnomid(7),ncara,ncarf
  394. NBTYPE=1
  395. SEGINI NOTYPE
  396. MOTYPE=NOTYPE
  397. TYPE(1)='REAL*8'
  398. *
  399. CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  400. & INFOS,3,IVACAR)
  401. SEGSUP NOTYPE
  402. IF(IERR.NE.0)THEN
  403. GOTO 9990
  404. ENDIF
  405. NCARR=NCARA+NCARF
  406. *
  407. IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  408. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  409. IF(IERR.NE.0)THEN
  410. ISUP5=0
  411. GOTO 9990
  412. ENDIF
  413. ENDIF
  414. *
  415. * CREATION DES MCHAMLS DE LA SOUS ZONE
  416. *
  417. NBPTEL=NBGS
  418. NEL=NBELEM
  419. N1PTEL=NBPTEL
  420. N1EL=NEL
  421. *
  422. * CONTRAINTES
  423. *
  424. N2=NSTRS
  425. SEGINI MCHAML
  426. ICHAML(ISOUS)=MCHAML
  427. NS=1
  428. NCOSOU=NSTRS
  429. SEGINI MPTVAL
  430. IVASTF=MPTVAL
  431. NOMID=MOSTRS
  432. SEGACT NOMID
  433. DO 1100 ICOMP=1,NSTRS
  434. NOMCHE(ICOMP)=LESOBL(ICOMP)
  435. TYPCHE(ICOMP)='REAL*8'
  436. N2PTEL=0
  437. N2EL=0
  438. SEGINI MELVAL
  439. IELVAL(ICOMP)=MELVAL
  440. IVAL(ICOMP)=MELVAL
  441. 1100 CONTINUE
  442. SEGDES NOMID
  443. *
  444. * VARIABLES INTERNES
  445. *
  446. N2=NVART
  447. SEGINI MCHAM1
  448. MCHEL1.ICHAML(ISOUS)=MCHAM1
  449. NS=1
  450. NCOSOU=NVART
  451. SEGINI MPTVAL
  452. IVARIF=MPTVAL
  453. NOMID=MOVARI
  454. SEGACT NOMID
  455. DO 1200 ICOMP=1,NVARI
  456. MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
  457. MCHAM1.TYPCHE(ICOMP)='REAL*8'
  458. N2PTEL=0
  459. N2EL=0
  460. SEGINI MELVAL
  461. MCHAM1.IELVAL(ICOMP)=MELVAL
  462. IVAL(ICOMP)=MELVAL
  463. 1200 CONTINUE
  464. DO 1201 ICOMP=NVARI+1,NVART
  465. MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP)
  466. MCHAM1.TYPCHE(ICOMP)='REAL*8'
  467. N2PTEL=0
  468. N2EL=0
  469. SEGINI MELVAL
  470. MCHAM1.IELVAL(ICOMP)=MELVAL
  471. IVAL(ICOMP)=MELVAL
  472. 1201 CONTINUE
  473. SEGDES NOMID
  474. *
  475. * APPEL A L'ECOULEMENT PROPREMENT DIT
  476. *
  477. CALL FCOUL2(DEPSI,INFIBR,MELE,IPMAIL,IPMINT,NBPTEL,IVASTR,
  478. 1 IVARI,IVAMAT,IVACAR,NSTRS,NVART,NMATT,NCARR,
  479. 2 SIGMA,IVASTF,IVARIF,EPSUP,EPINF,DAMAG,NSTRS2)
  480. *
  481. 9990 CONTINUE
  482. *
  483. ckich contraction eventuelle des melval
  484. MPTVAL = IVASTF
  485. do ICOMP=1,NSTRS
  486. ichin = ival(icomp)
  487. call comred(ichin)
  488. ielval(icomp) = ichin
  489. C* ival(icomp) = ichin
  490. enddo
  491.  
  492. MPTVAL=IVARIF
  493. do ICOMP=1,NVARI
  494. ichin = ival(icomp)
  495. call comred(ichin)
  496. mcham1.ielval(icomp) = ichin
  497. C* ival(icomp) = ichin
  498. enddo
  499. do ICOMP=NVARI+1,NVART
  500. ichin = ival(icomp)
  501. call comred(ichin)
  502. mcham1.ielval(icomp) = ichin
  503. C* ival(icomp) = ichin
  504. enddo
  505. * DESACTIVATION DES SEGMENTS
  506. *
  507. IF(ISUP1.EQ.1)THEN
  508. CALL DTMVAL (IVASTR,3)
  509. ELSE
  510. CALL DTMVAL (IVASTR,1)
  511. ENDIF
  512. IF(ISUP2.EQ.1)THEN
  513. CALL DTMVAL (IVARI,3)
  514. ELSE
  515. CALL DTMVAL (IVARI,1)
  516. ENDIF
  517. IF(ISUP5.EQ.1)THEN
  518. CALL DTMVAL (IVAMAT,3)
  519. CALL DTMVAL (IVACAR,3)
  520. ELSE
  521. CALL DTMVAL (IVAMAT,1)
  522. CALL DTMVAL (IVACAR,1)
  523. ENDIF
  524. IF (IERR.EQ.0) THEN
  525. CALL DTMVAL (IVASTF,1)
  526. CALL DTMVAL (IVARIF,1)
  527. ELSE
  528. CALL DTMVAL (IVASTF,3)
  529. CALL DTMVAL (IVARIF,3)
  530. END IF
  531. *
  532. IF (MOCARA.NE.0) THEN
  533. NOMID=MOCARA
  534. if(lsupca)SEGSUP NOMID
  535. END IF
  536. *
  537. IF (MOMATR.NE.0) THEN
  538. NOMID=MOMATR
  539. if(lsupma)SEGSUP NOMID
  540. END IF
  541. *
  542. IF (MOVARI.NE.0) THEN
  543. NOMID=MOVARI
  544. if(lsupva)SEGSUP NOMID
  545. END IF
  546. *
  547. IF (MOSTRS.NE.0) THEN
  548. NOMID=MOSTRS
  549. if(lsupco)SEGSUP NOMID
  550. END IF
  551. *
  552. * IF (IPINF .NE.0) THEN
  553. * INFO=IPINF
  554. * SEGSUP INFO
  555. * END IF
  556. *
  557. SEGDES,MINTE
  558. SEGDES MELEME,IMODEL
  559. *
  560. IF (IERR.EQ.0) THEN
  561. SEGDES MCHAML,MCHAM1
  562. ELSE
  563. SEGSUP MCHAML,MCHAM1
  564. GOTO 888
  565. ENDIF
  566. 1000 CONTINUE
  567. *
  568. 888 CONTINUE
  569. SEGDES MMODEL
  570. IF (IERR.EQ.0)THEN
  571. IRETO=1
  572. SEGDES MCHELM,MCHEL1
  573. ELSE
  574. IRETO=0
  575. SEGSUP MCHELM,MCHEL1
  576. ENDIF
  577. *
  578. RETURN
  579. END
  580.  
  581.  
  582.  
  583.  
  584.  
  585.  

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