Télécharger cfl1.eso

Retour à la liste

Numérotation des lignes :

  1. C CFL1 SOURCE BP208322 16/11/18 21:15:26 9177
  2. SUBROUTINE CFL1(IPMODL,IPCHA1,IPCHA2,IPCHA3,IPCHA4,ICAS)
  3. *
  4. *-----------------------------------------------------------------------
  5. *
  6. * calcul du pas de temps de stabilité operateur CFL
  7. * de la vitesse du son operateur CSON
  8. * de la taille de propagation de l'information opérateur TAILLE
  9. *
  10. * en entrée
  11. * ipmodl objet model
  12. * ipcha1 champ de caractéristiques
  13. * ipcha2 champ de vitesse du son composante 'CSON'
  14. * ipcha3 champ de taille du maillage composante 'L' ( et 'L2H' facultatif)
  15. * icas décrit le cas de figure
  16. * entree -------> sortie
  17. * = 1 ipcha1 pas de temps cfl
  18. * = 2 ipcha2 ( et ipcha1 si cara geom ) " " "
  19. * = 3 ipcha3 et ipcha1 " " "
  20. * = 4 ipcha1 vitesse du son
  21. * = 5 ( et ipcha1 si cara geom ) parametre de taille
  22. * en sortie
  23. * ipcha4 le champ par element demandé
  24. *
  25. *-----------------------------------------------------------------------
  26. *
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8(A-H,O-Z)
  29. -INC CCOPTIO
  30. -INC CCHAMP
  31. -INC CCGEOME
  32. -INC CCREEL
  33. -INC SMCHAML
  34. -INC SMINTE
  35. -INC SMELEME
  36. -INC SMRIGID
  37. -INC SMMODEL
  38. -INC SMCOORD
  39. -INC SMLREEL
  40. C
  41. * SEGMENT INFO
  42. * INTEGER INFELE(JG)
  43. * ENDSEGMENT
  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*(NCONCH) CONM
  56. CHARACTER*8 CMATE
  57. PARAMETER ( NINF=3 )
  58. INTEGER INFOS(NINF)
  59. CHARACTER*4 CMOT
  60. LOGICAL DEUCMP,lsupma
  61. *--------------------------------------------------------------------*
  62. *
  63. * call tcloc2(' ',-1,it)
  64. deucmp=.FALSE.
  65. IF ( ICAS .EQ. 1) THEN
  66. IPCHE1 = IPCHA1
  67. IPCHE2 = 0
  68. ELSE IF ( ICAS .EQ. 2 ) THEN
  69. IPCHE1 = IPCHA1
  70. IPCHE2 = IPCHA2
  71. ELSE IF ( ICAS .EQ. 3 ) THEN
  72. IPCHE1 = IPCHA1
  73. IPCHE2 = IPCHA3
  74. ELSE IF ( ICAS .EQ. 4 ) THEN
  75. IPCHE1 = IPCHA1
  76. IPCHE2 = 0
  77. ELSE IF ( ICAS .EQ. 5 ) THEN
  78. IPCHE1 = IPCHA1
  79. IPCHE2 = 0
  80. ENDIF
  81.  
  82. MMODEL = IPMODL
  83. SEGACT MMODEL
  84. NSOUS = KMODEL(/1)
  85. *
  86. * initialisation de l'objet résultat
  87. *
  88.  
  89. N1 = NSOUS
  90. N3 = 6
  91. L1 = 16
  92. SEGINI MCHELM
  93. IF ( ICAS .LE. 3 .OR. ICAS .GE. 1 ) THEN
  94. TITCHE = 'PAS DE TEMPS CFL'
  95. ELSE IF ( ICAS .EQ. 4 ) THEN
  96. TITCHE = 'VITESSE DU SON'
  97. ELSE IF ( ICAS .EQ. 5 ) THEN
  98. TITCHE = 'TAILLE CFL'
  99. ENDIF
  100. *
  101. IFOCHE = IFOUR
  102. *--------------------------------------------------------------------*
  103. *
  104. * BOUCLE SUR LES ZONES ELEMENTAIRES ( MEME TYPE D'EF )
  105. *
  106. *--------------------------------------------------------------------*
  107. *
  108. DO 500 ISOUS=1,NSOUS
  109. IMODEL=KMODEL(ISOUS)
  110. SEGACT IMODEL
  111. lsupma=.true.
  112. *
  113. * INITIALISATIONS
  114. *
  115. IVAM1 = 0
  116. IVAM2 = 0
  117. *
  118. MELE = NEFMOD
  119. IPMAIL= IMAMOD
  120. CONM = CONMOD
  121. NFOR = FORMOD(/2)
  122. NMAT = MATMOD(/2)
  123. *
  124. IVAMAT=0
  125. IVACAR=0
  126. NMATR=0
  127. NMATF=0
  128. NCARA=0
  129. NCARF=0
  130. MOCARA=0
  131. MOMATR=0
  132. DESCR=0
  133. IMATRI=0
  134. *
  135. C
  136. C COQUE INTEGREE OU PAS ?
  137. C
  138. IF(INFMOD(/1).NE.0)THEN
  139. NPINT=INFMOD(1)
  140. ELSE
  141. NPINT=0
  142. ENDIF
  143. *
  144. * formulation et matériau ( ca peut servir par la suite )
  145. *
  146. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
  147. *
  148. * sortie cmate : Nom du materiau (isotrope, orthotrope....)
  149. * mate : Numero du materiau
  150. * intau : Numero de nature
  151. *
  152. *
  153. IF (CMATE.EQ.' ')THEN
  154. CALL ERREUR(251)
  155. SEGSUP MCHELM
  156. SEGDES IMODEL,MMODEL
  157. IRET=0
  158. RETURN
  159. ENDIF
  160. *
  161. * information sur l'élément finis : nécessaire pour les tests
  162. * qui donnent les noms de composantes
  163. *
  164. *
  165. INTTYP = 2
  166. * CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL)
  167. *
  168. IF ( IERR.NE.0 ) THEN
  169. SEGSUP MCHELM
  170. SEGDES IMODEL,MMODEL
  171. IPCHA4=0
  172. RETURN
  173. ENDIF
  174. *
  175. * INFO = IPINF
  176. * LHOOK = INFELE(10)
  177. * LHOO2 = LHOOK*LHOOK
  178. * NSTRS = INFELE(16)
  179. MFR = INFELE(13)
  180. * LW = INFELE(7)
  181. * NDDL = INFELE(15)
  182. IELE = INFELE(14)
  183. * LRE = INFELE(9)
  184. * IPORE = INFELE(8)
  185. * IPINT = INFELE(11)
  186. ipint=infmod(4)
  187. *
  188. *
  189. * Verification de compatibilite de MCHAML du point de vue des
  190. *
  191. * tableaux INFCHE et creation du tableau INFOS pour COMCHA
  192. *
  193. CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,IRTD)
  194. IF (IRTD.EQ.0) THEN
  195. * incompatibilité entre le modele et le chamelem
  196. SEGDES IMODEL,MMODEL
  197. SEGSUP MCHELM
  198. RETURN
  199. ENDIF
  200.  
  201. * call tcloc2('Apres ident',6,it)
  202.  
  203. *
  204. *
  205. *--------------------------------------------------------------------*
  206. * determination des noms de composantes dans les champs
  207. *
  208. * on commence par le champ 2 qui n'existe que dans le cas 2 et 3
  209. IF (ICAS.EQ.2 .OR.ICAS.EQ.3) THEN
  210. IF (ICAS.EQ.2) THEN
  211. * le champ 2 contient la vitesse du son
  212. NBROBL=1
  213. NBRFAC=0
  214. SEGINI NOMID
  215. LESOBL(1)='CSON'
  216. NBTYPE=1
  217. SEGINI NOTYPE
  218. TYPE(1) = 'REAL*8'
  219. ELSE IF(ICAS.EQ.3) THEN
  220. * le champ 2 contient le parametre de taille
  221. NBROBL=1
  222. NBRFAC=1
  223. SEGINI NOMID
  224. LESOBL(1)='L'
  225. LESFAC(1) = 'L2H'
  226. NBTYPE=1
  227. SEGINI NOTYPE
  228. TYPE(1) = 'REAL*8'
  229. ENDIF
  230. MOTYPE = NOTYPE
  231. MOMATR = NOMID
  232. *
  233. *
  234. * ===>
  235. * write(6,*) 'Sous zone' ,isous,' Composante obligatoire ipche2'
  236. * write(6,7001) (lesobl(i),i=1,nbrobl)
  237. * write(6,*) 'facultatives'
  238. * write(6,7001) (lesfac(i),i=1,nbrfac)
  239. * 7001 format(4(A4,2X))
  240. * Recherche des valeurs des composantes dans les MELVAL d'un
  241. * CHAMELEM. On distingue les composantes obligatoires des
  242. * composantes facultatives.
  243. CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAM2)
  244. SEGSUP NOTYPE,NOMID
  245. IF (IERR.NE.0) THEN
  246. SEGSUP MCHELM
  247. SEGDES IMODEL,MMODEL
  248. RETURN
  249. ENDIF
  250. ENDIF
  251. * call tcloc2('Apres komcha1',6,it)
  252. *
  253. * dans les cas 1,2 ou 5 il peut y avoir des caractéristiques geometriques
  254. * dans les cas 1,3 ou 4 il y a des caractéristiques matériau
  255. * on commence par traiter les caractéristiques matériau
  256. IF (ICAS .EQ. 1 .OR. ICAS .EQ. 3 .OR. ICAS .EQ. 4) THEN
  257. IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
  258. NBROBL=3
  259. NBRFAC=0
  260. SEGINI NOMID
  261. MOMATR=NOMID
  262. LESOBL(1)='YOUN'
  263. LESOBL(2)='NU'
  264. LESOBL(3)='RHO'
  265. NMATR=NBROBL
  266. NMATF=NBRFAC
  267. ELSE
  268. $ IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
  269. * indisponible! pour les volontaies voir voir rigi1.eso
  270. * SEGSUP MCHELM
  271. SEGDES MMODEL,IMODEL
  272. CALL ERREUR(251)
  273. RETURN
  274. ELSE
  275. $ IF (FORMOD(1).EQ.'POREUX '.AND.CMATE.EQ.'ISOTROPE') THEN
  276. * indisponible! pour les volontaies voir rigi1.eso
  277. CALL ERREUR(251)
  278. SEGSUP MCHELM
  279. SEGDES MMODEL,IMODEL
  280. RETURN
  281. *
  282. ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  283. * indisponible! pour les volontaies voir rigi1.eso
  284. SEGSUP MCHELM
  285. SEGDES MMODEL,IMODEL
  286. CALL ERREUR(251)
  287. RETURN
  288. *
  289. ELSE
  290. if(lnomid(6).ne.0) then
  291. nomid=lnomid(6)
  292. segact nomid
  293. momatr=nomid
  294. nmatr=lesobl(/2)
  295. nmatf=lesfac(/2)
  296. lsupma=.false.
  297. else
  298. lsupma=.true.
  299. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  300. endif
  301. ENDIF
  302. *
  303. * type des composantes
  304. *
  305. IF (CMATE.EQ.'SECTION') THEN
  306. SEGSUP MCHELM
  307. SEGDES MMODEL,IMODEL
  308. CALL ERREUR(251)
  309. RETURN
  310. ELSE
  311. NBTYPE=1
  312. SEGINI NOTYPE
  313. TYPE(1)='REAL*8'
  314. MOTYPE=NOTYPE
  315. ENDIF
  316.  
  317. *
  318. * dans le cas ou il y des caractéristiques géometriques on augmente
  319. * motype
  320. *
  321. ELSE IF((ICAS.EQ.2 .OR. ICAS.EQ.5).AND.IPCHE1.NE.0)THEN
  322. * dans ces cas il faut eventuellement récuperer les caractéristiques
  323. * geométriques et avoir initialiser notype avant
  324. NBROBL=0
  325. NBRFAC=0
  326. SEGINI NOMID
  327. MOMATR=NOMID
  328. NBTYPE=1
  329. SEGINI NOTYPE
  330. MOTYPE=NOTYPE
  331. TYPE(1)='REAL*8'
  332. NMATR=NBROBL
  333. NMATF=NBRFAC
  334. ENDIF
  335. *
  336. IF((IPCHE1.NE.0).AND.(ICAS.NE.4).AND.(ICAS.NE.3))THEN
  337. *
  338. *
  339. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  340. *
  341. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  342. NBROBL=NBROBL+1
  343. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  344. NBRFAC=NBRFAC+2
  345. ELSE
  346. NBRFAC=NBRFAC+1
  347. ENDIF
  348. SEGADJ NOMID
  349. MOCARA=NOMID
  350. LESOBL(NBROBL)='EPAI'
  351. LESFAC(NBRFAC)='EXCE'
  352. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  353. LESFAC(NBRFAC-1)='EXCE'
  354. LESFAC(NBRFAC)='DIM3'
  355. ELSE
  356. LESFAC(NBRFAC)='EXCE'
  357. ENDIF
  358. *
  359. * SECTION POUR LES BARRES ET LES CERCES
  360. *
  361. ELSE IF (MFR.EQ.27) THEN
  362. NBROBL=NBROBL+1
  363. SEGADJ NOMID
  364. LESOBL(NBROBL)='SECT'
  365. *
  366. * section, excentrements et orientation pour les barres excentrees
  367. *
  368. ELSE IF (MFR.EQ.49) THEN
  369. NBROBL=NBROBL+6
  370. SEGADJ NOMID
  371. LESOBL(NBROBL-5)='SECT'
  372. LESOBL(NBROBL-4)='EXCZ'
  373. LESOBL(NBROBL-3)='EXCY'
  374. LESOBL(NBROBL-2)='VX '
  375. LESOBL(NBROBL-1)='VY '
  376. LESOBL(NBROBL)='VZ '
  377. *
  378. * CARACTERISTIQUES POUR LES POUTRES
  379. *
  380. ELSE IF (MFR.EQ.7 ) THEN
  381. NBROBL=NBROBL+4
  382. NBRFAC=NBRFAC+2
  383. SEGADJ NOMID
  384. LESOBL(NBROBL-3)='TORS'
  385. LESOBL(NBROBL-2)='INRY'
  386. LESOBL(NBROBL-1)='INRZ'
  387. LESOBL(NBROBL)='SECT'
  388. LESFAC(NBRFAC-1)='SECY'
  389. LESFAC(NBRFAC)='SECZ'
  390. *
  391. * CARACTERISTIQUES POUR LES TUYAUX
  392. *
  393. ELSE IF (MFR.EQ.13) THEN
  394. * pour les autres on ne ient pas compte des modification
  395. * qui assouplissent le tuyau donc omega max diminue
  396. NBROBL=NBROBL+2
  397. SEGADJ NOMID
  398. LESOBL(NBROBL-1)='EPAI'
  399. LESOBL(NBROBL)='RAYO'
  400. ELSE IF (MFR.EQ.39) THEN
  401. NBROBL=NBROBL+2
  402. NBRFAC=NBRFAC+2
  403. SEGADJ NOMID
  404. LESOBL(NBROBL-1)='EPAI'
  405. LESOBL(NBROBL)='RAYO'
  406. LESFAC(NBRFAC-1)='RACO'
  407. LESFAC(NBRFAC)='PRES'
  408. ENDIF
  409. *
  410. MOMATR=NOMID
  411. NMATR=NBROBL
  412. NMATF=NBRFAC
  413. *
  414. * ===>
  415. * write(6,*) 'Sous zone' ,isous,' Composante obligatoire ipche1'
  416. * write(6,7001) (lesobl(i),i=1,nbrobl)
  417. * write(6,*) 'facultatives'
  418. * write(6,7001) (lesfac(i),i=1,nbrfac)
  419. *
  420. *
  421. ENDIF
  422. *
  423. IF (NMATR.NE.0) THEN
  424. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAM1)
  425. SEGSUP NOTYPE
  426. nomid=momatr
  427. if(lsupma)segsup NOMID
  428. IF (IERR.NE.0) THEN
  429. SEGDES IMODEL,MMODEL
  430. SEGSUP MCHELM
  431. RETURN
  432. ENDIF
  433. * call tcloc2('Apres komcha2',6,it)
  434. ENDIF
  435.  
  436. *
  437. *
  438. *--------------------------------------------------------------------*
  439. * remplissage de la description du sous champ résultat
  440. *
  441. * dimension
  442. * = 2 si taille et coque ou poutre
  443. * mfr obtenu par elquoi nous renseigne
  444. *
  445. IF ((ICAS.EQ.5).AND.
  446. & (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.7.OR.MFR.EQ.9.OR.MFR.EQ.13))
  447. & THEN
  448. DEUCMP = .TRUE.
  449. N2 = 2
  450. SEGINI MCHAML
  451. NOMCHE(1) = 'L'
  452. NOMCHE(2) = 'L2H'
  453. TYPCHE(1) = 'REAL*8'
  454. TYPCHE(2) = 'REAL*8'
  455. ELSE IF (ICAS.EQ.5) THEN
  456. N2 = 1
  457. SEGINI MCHAML
  458. NOMCHE(1) = 'L'
  459. TYPCHE(1) = 'REAL*8'
  460. ELSE IF (ICAS.EQ.4) THEN
  461. N2 = 1
  462. SEGINI MCHAML
  463. NOMCHE(1) = 'CSON'
  464. TYPCHE(1) = 'REAL*8'
  465. ELSE IF (ICAS.EQ.1.OR.ICAS.EQ.2.OR.ICAS.EQ.3) THEN
  466. N2 = 1
  467. SEGINI MCHAML
  468. NOMCHE(1) = 'TCFL'
  469. TYPCHE(1) = 'REAL*8'
  470. ENDIF
  471. ICHAML(ISOUS) = MCHAML
  472. *
  473. * le chamelem est defini au centre de gravité
  474. *
  475. INFCHE(ISOUS,6) = 2
  476. * il faut brancher sur le segment d'intégration
  477. INFCHE(ISOUS,4)=IPINT
  478. * nom du constituant
  479. CONCHE(ISOUS) = CONMOD
  480. * maillage
  481. IMACHE(ISOUS) = IPMAIL
  482. * a priori info ne set plus
  483. * SEGSUP INFO
  484. *
  485. *--------------------------------------------------------------------*
  486. * appel au sous routine spécifiques
  487. *
  488. * NUMERO DES ETIQUETTES :
  489. * Les elements sont groupes comme suit :
  490. * - massif,liquide 'surface libre' poreux ----------------------> 4
  491. * - coq3,dkt,coq4,coq8,coq2,dst --------------------------------> 12
  492. * - poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,jot3> 27
  493. * - joi4,joi2,poutre de timoschenko,joi3 29
  494. *
  495. * 1 5 0 5 0
  496. GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,12,99, 4, 4, 4, 4,99,99,99,
  497. 2 99,99, 4, 4, 4, 4,27,27,29,99,99,99,99,99,99,99,99,99,99,99,
  498. 4 27,29,99,27,99,29,12,99,27,99,99,99,99,99,12,27,99,99,99,99,
  499. 6 99,99,99,99,99,99,99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,
  500. 8 99,99,99,29,99,99,99,99,99,99,99,99,27,12,99,99,99,99,99,99,
  501. 1 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  502. 2 99,99,99,99,99,99,99),MELE
  503. 99 CONTINUE
  504. MOTERR(1:4)=NOMTP(MELE)
  505. MOTERR(9:12)='CFL1'
  506. CALL ERREUR(86)
  507. SEGDES IMODEL,MMODEL
  508. SEGSUP MCHELM,MCHAML
  509. RETURN
  510. C
  511. C_______________________________________________________________________
  512. C
  513. C massif
  514. C_______________________________________________________________________
  515. C
  516. 4 CONTINUE
  517. * write(6,*) 'Appel a cfl2'
  518. CALL CFL2(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  519. IF (IERR.NE.0) RETURN
  520. GOTO 400
  521.  
  522. C_______________________________________________________________________
  523. C
  524. C ELTS DE RACCORD LIQUIDE SOLIDE RAC2 RACO LIA3 LIA4 LICO LIC4
  525. C PAS DE RIGIDITE
  526. C_______________________________________________________________________
  527. C
  528. 12 CONTINUE
  529. * write(6,*) 'Appel a cfl3'
  530. CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  531. IF (IERR.NE.0) RETURN
  532. GOTO 400
  533. C_______________________________________________________________________
  534. C
  535. C coq3,dkt,coq4,coq8,coq2,dst
  536. C_______________________________________________________________________
  537. C
  538. 27 CONTINUE
  539. * write(6,*) 'Appel a cfl4'
  540. CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  541. IF (IERR.NE.0) RETURN
  542. GOTO 400
  543. C_______________________________________________________________________
  544. C
  545. C poutre,barre,homogeneise
  546. C poutre de Timoschenko
  547. C_______________________________________________________________________
  548. C
  549. 29 CONTINUE
  550. * write(6,*) 'Appel a cfl5'
  551. * ivam1 et 2 sont actifs , ipmail descativé
  552. CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  553. * en sortie melv1 et melv2 sont inactifs
  554. IF (IERR.NE.0) RETURN
  555. GOTO 400
  556. *
  557. *
  558. *
  559. 400 CONTINUE
  560. * on raccroche le résultat
  561. IELVAL(1) = MELV1
  562. IF (DEUCMP) IELVAL(2) = MELV2
  563. SEGDES MCHAML
  564. SEGDES IMODEL
  565. IF (IVAM1.NE.0) THEN
  566. MPTVAL = IVAM1
  567. SEGSUP MPTVAL
  568. ENDIF
  569. IF (IVAM2.NE.0) THEN
  570. MPTVAL = IVAM2
  571. SEGSUP MPTVAL
  572. ENDIF
  573. * fin boucle sur les sous zone des champs
  574. 500 CONTINUE
  575. *
  576. *
  577. *
  578. IPCHA4 = MCHELM
  579. SEGDES MCHELM,MMODEL
  580. RETURN
  581. END
  582.  
  583.  
  584.  
  585.  
  586.  
  587.  
  588.  
  589.  
  590.  
  591.  
  592.  
  593.  
  594.  
  595.  
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602.  
  603.  
  604.  
  605.  
  606.  
  607.  
  608.  
  609.  

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