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

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