Télécharger fcoul1.eso

Retour à la liste

Numérotation des lignes :

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

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