Télécharger matcar.eso

Retour à la liste

Numérotation des lignes :

matcar
  1. C MATCAR SOURCE OF166741 24/05/06 21:15:22 11082
  2.  
  3. *--------------------------------------------------------------------*
  4. * *
  5. * Sous-programme associe @ l'operateur MATR et CARB *
  6. * __________________________________________________ *
  7. * *
  8. * Creation d'un champ de caracteristiques materielles et/ou *
  9. * geometriques. *
  10. * *
  11. * Commentaire : *
  12. * *
  13. * - En utilisant MATR : On est autorise a donner des caracteristi-*
  14. * ques materielles et geometriques. *
  15. * MONCAS = 'MATERIAU' *
  16. * Toutes les autres composantes ne seront *
  17. * pas prises en comptes. *
  18. * *
  19. * - En utilisant CARB : On est autorise a donner des caracteristi-*
  20. * ques geometriques. *
  21. * MONCAS = 'CARACTER' *
  22. * Toutes les autres composantes ne seront *
  23. * pas prise en comptes. *
  24. * *
  25. * Remarque importante: *
  26. * *
  27. * Un certain nombre de composantes par defaut est requis lors *
  28. * d'un processus de calcul. Il est possible d'en definir d'autres *
  29. * @ la convenance de l'utilisateur.(l'appel a matcar devra alors *
  30. * se faire avec MONCAS <> 'CARACTER' et MONCAS <> 'MATERIAU' *
  31. * *
  32. * Auteur, date de creation: *
  33. * ------------------------- *
  34. * *
  35. * Denis ROBERT-MOUGIN, le 21 decembre 1987. *
  36. * *
  37. * - Mise a niveau avec MATE pour les materiaux ORTHOTROPES par : *
  38. * jm CAMPENON le 29 08 90 *
  39. * *
  40. * - Autoriser uniquement la prise en compte des : *
  41. * - carac. geom. quand provenance de CARB (MONCAS = 'CARACTER') *
  42. * - carac. geom. et mater. quand provenance de MATR *
  43. * (MONCAS = 'MATERIAU') *
  44. * jm CAMPENON le 23 10 90 *
  45. * *
  46. * -MISE A NIVEAU POUR L'ANISOTROPIE ET L'ORTHOTROPIE DANS LES *
  47. * ELEMENTS MASSIFS PAR P. DOWLATYARI OCT. 90 *
  48. *--------------------------------------------------------------------*
  49.  
  50. SUBROUTINE MATCAR(MONCAS)
  51.  
  52. IMPLICIT INTEGER(I-N)
  53. IMPLICIT REAL*8 (A-H,O-Z)
  54.  
  55. -INC PPARAM
  56. -INC CCOPTIO
  57. -INC CCREEL
  58. -INC CCHAMP
  59.  
  60. -INC SMLMOTS
  61. -INC SMLREEL
  62. -INC SMLENTI
  63. -INC SMMODEL
  64. POINTEUR NOMID1.NOMID
  65. C-INC SMLCHPO
  66. -INC SMTABLE
  67. -INC SMELEME
  68.  
  69. * MOMATR pointera sur la liste des caracteristiques materielles
  70. * MOCARA pointera sur la liste des caracteristiques geometriques
  71.  
  72. PARAMETER ( JER1=16 )
  73. REAL*8 RECOM,RECOM2
  74. LOGICAL RFLAG,lsupma,lsupca,d_mela,d_nast
  75. CHARACTER*(LOCOMP) MOCHOI,MOBUF
  76. CHARACTER*8 CAR,MONCAS,CMATE
  77. CHARACTER*16 LETYP
  78. LOGICAL L0,L1
  79. CHARACTER*8 TYPRET,CHARRE
  80.  
  81. C Tableau fixe pour appel a LIRMOT sans ARGUMENT ELEMENT DE SEGMENT
  82. PARAMETER ( NMOT1=500 )
  83. CHARACTER*(LOCOMP) CMOTS1(NMOT1)
  84.  
  85. EXTERNAL LONG
  86. *
  87. * MONCAS='MATERIAU' --> IFLAG=1 (SEULEMENT LES CARAC. GEOM. ET
  88. * MATER. : MATE)
  89. * MONCAS='CARACTER' --> IFLAG=2 (SEULEMENT LES CARAC. GEOM. : CARA)
  90. * IFLAG=0 tous les noms composantes voulues
  91. *
  92. IFLAG=0
  93. IF(MONCAS.EQ.'CARACTER') IFLAG=2
  94. IF(MONCAS.EQ.'MATERIAU') IFLAG=1
  95. *
  96. * Lecture d'un MODELE :
  97. *
  98. MOTERR =' MODELE '
  99. CALL MESLIR(-137)
  100. CALL LIROBJ('MMODEL ',IPMODE,1,IRET)
  101. CALL ACTOBJ('MMODEL ',IPMODE,1)
  102. IF(IERR.NE.0) RETURN
  103. *
  104. * Initialisation des segments
  105. *
  106. JG =0
  107. JGN=LOCOMP
  108. JGM=0
  109. SEGINI,MLMOTS
  110. SEGINI,MLMOT1
  111. SEGINI,MLMOT2
  112. SEGINI,MLMOT3
  113. SEGINI,MLREE1
  114. SEGINI,MLENT2
  115. *
  116. ICARA = 0
  117. IVECT=0
  118. *
  119. NUDIR1=0
  120. NUDIR2=0
  121. NUMP1=0
  122. NUMP2=0
  123. NUMP3=0
  124. ANG=0.D0
  125. ANG2=0.D0
  126. IPLIQU=0
  127. IRACOR=0
  128. ITHER = 0
  129. IDIFF = 0
  130. IMETA = 0
  131. ICHPH = 0
  132. ICONT = 0
  133. IMELA = 0
  134. ** ILIMA = 0
  135. ICOUD = 0
  136. RFLAG = .FALSE.
  137. ITBAS = 0
  138. ITMOD = 0
  139. *
  140. MOMATR = 0
  141. lsupma = .false.
  142. MOCARA = 0
  143. lsupca = .false.
  144.  
  145. MMODEL = IPMODE
  146. c debut romain AM sellier
  147. SEGACT,MMODEL
  148. N1 = mmodel.KMODEL(/1)
  149. DO I = 1, N1
  150. IMODEL = mmodel.KMODEL(I)
  151. SEGACT,IMODEL
  152. ENDDO
  153. c fin romain AM sellier
  154. *
  155. * QUID ici si N1 = 0 : mmodel VIDE ?
  156. * IF(N1.EQ.0)THEN
  157. * CALL ERREUR(xx)
  158. * GOTO 99
  159. * ENDIF
  160. * Ici on ne travaille que sur le 1er sous-modele !
  161. * Ce qui suppose que tous les autres sont identiques au 1er !!! Aie ou Ouille ?
  162. IMODEL = mmodel.KMODEL(1)
  163.  
  164. NFOR = imodel.FORMOD(/2)
  165. NMAT = imodel.MATMOD(/2)
  166. if (CMATEE.NE.' ') then
  167. CMATE = CMATEE
  168. MATE = IMATEE
  169. INAT = INATUU
  170. else
  171. CALL NOMATE(imodel.FORMOD,NFOR,imodel.MATMOD,NMAT,CMATE,MATE,INAT)
  172. endif
  173. * Normalement ici, pas de souci ?
  174. IF(CMATE.EQ.' ')THEN
  175. CALL ERREUR(251)
  176. GOTO 99
  177. ENDIF
  178.  
  179. IF(NFOR.EQ.2)THEN
  180. IF((FORMOD(1).EQ.'MECANIQUE '.AND.
  181. 1 FORMOD(2).EQ.'LIQUIDE ').OR.
  182. 2 (FORMOD(1).EQ.'LIQUIDE '.AND.
  183. 3 FORMOD(2).EQ.'MECANIQUE '))IRACOR=1
  184. ENDIF
  185. *
  186. CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE')
  187. CALL PLACE(FORMOD,NFOR,IDIFF,'DIFFUSION')
  188. CALL PLACE(FORMOD,NFOR,ICONT,'CONTACT')
  189. CALL PLACE(FORMOD,NFOR,IMELA,'MELANGE')
  190. ** CALL PLACE(FORMOD,NFOR,ILIMA,'LIAISON_MATERIELLE')
  191. C Modele METALLURGIE, cree par T.L. en mai 2018
  192. CALL PLACE(FORMOD,NFOR,IMETA,'METALLURGIE')
  193. CALL PLACE(FORMOD,NFOR,ICHPH,'CHANGEMENT_PHASE')
  194. *
  195. C= Element fini et formulation associee
  196. C= En DIMEnsion 1, on force formulation MASSIVE pour les elements POI1
  197. C= (utilises en convection et en rayonnement).
  198. MELE = imodel.NEFMOD
  199. MFR1 = NUMMFR(MELE)
  200. IF(IDIM.EQ.1.AND.MELE.EQ.45) MFR1=1
  201. *
  202. IF(lnomid(6).ne.0.and.imela.eq.0)THEN
  203. lsupma=.false.
  204. momatr = lnomid(6)
  205. nomid = momatr
  206. segact nomid
  207. nbrmat=lesobl(/2)
  208. nbrmatf=lesfac(/2)
  209. else
  210. lsupma=.true.
  211. CALL IDMATR(MFR1,IMODEL,MOMATR,NBRMAT,NBRMATF)
  212. NOMID=MOMATR
  213. SEGACT NOMID
  214. endif
  215. IF(nbrmat+nbrmatf .EQ. 0)THEN
  216. MOTERR ='MATE'
  217. MOTERR(5:8)=NOMTP(MELE)
  218. CALL ERREUR(76)
  219. GO TO 99
  220. ENDIF
  221. *
  222. if(lnomid(7).ne.0)THEN
  223. lsupca=.false.
  224. mocara=lnomid(7)
  225. nomid = mocara
  226. segact nomid
  227. nbrcar = lesobl(/2)
  228. nbrcarf = lesfac(/2)
  229. else
  230. lsupca=.true.
  231. CALL IDCARB(MELE,IFOUR,MOCARA,NBRCAR,NBRCARF)
  232. NOMID = MOCARA
  233. SEGACT NOMID
  234. endif
  235. * write(6,*) 'matcar nbrcar,nbrcarf',nbrcar,nbrcarf
  236. *
  237. MOCHOI = ' '
  238. *
  239. IMIL = 1
  240.  
  241. 10 CONTINUE
  242. IF(IMIL.EQ.0) CALL MESLIR(-175)
  243. INCM1 = 0
  244. INCM2 = 0
  245. INCM3 = 0
  246. INCM4 = 0
  247. *
  248. IRBUF = 0
  249. IRCHOI = 0
  250.  
  251. C Concaténation des MOTS attendus pour le LIRMOT discriminant
  252. NOMID = MOMATR
  253. NBOBL1 = NOMID.LESOBL(/2)
  254. NBFAC1 = NOMID.LESFAC(/2)
  255.  
  256. NOMID1 = MOCARA
  257. NBOBL2 = NOMID1.LESOBL(/2)
  258. NBFAC2 = NOMID1.LESFAC(/2)
  259.  
  260. JGM = NBOBL1 + NBFAC1 + NBOBL2 + NBFAC2
  261. IF(JGM .GT. NMOT1)THEN
  262. WRITE(*,*)'AUGMENTER LA TAILLE DE CMOTS1 DANS MATCAR.ESO'
  263. CALL ERREUR(5)
  264. ENDIF
  265.  
  266. DO IOBL=1,NBOBL1
  267. CMOTS1(IOBL)=NOMID.LESOBL(IOBL)
  268. ENDDO
  269.  
  270. DO IFAC=1,NBFAC1
  271. CMOTS1(NBOBL1+IFAC)=NOMID.LESFAC(IFAC)
  272. ENDDO
  273.  
  274. DO IOBL=1,NBOBL2
  275. CMOTS1(NBOBL1+NBFAC1+IOBL)=NOMID1.LESOBL(IOBL)
  276. ENDDO
  277.  
  278. DO IFAC=1,NBFAC2
  279. CMOTS1(NBOBL1+NBFAC1+NBOBL2+IFAC)=NOMID1.LESFAC(IFAC)
  280. ENDDO
  281.  
  282. MJGM=-JGM
  283. C LIRMOT appele avec MJGM<0 => on utilise des abreviations
  284. CALL LIRMOT(CMOTS1,MJGM,IPLACE,0)
  285. IF(IERR.NE.0) GOTO 99
  286. ** write(6,*) 'matcar apres lirmot ',iplace
  287. IF(IPLACE .EQ. 0)THEN
  288. CALL LIRCHA(MOBUF,0,IRBUF)
  289. MOBUF=MOBUF(1:4)
  290. IF(IERR .NE.0) GOTO 99
  291. IF(IRBUF.EQ.0) GOTO 20
  292. MOCHOI=MOBUF
  293. IRCHOI=IRBUF
  294.  
  295. ELSE
  296. IF (IPLACE.GT.0 .AND. IPLACE.LE.NBOBL1)THEN
  297. INCM1 = IPLACE
  298. ELSEIF(IPLACE.GT.NBOBL1 .AND. IPLACE.LE.NBOBL1+NBFAC1)THEN
  299. INCM3 = IPLACE - NBOBL1
  300. ELSEIF(IPLACE.GT.NBOBL1+NBFAC1 .AND.
  301. & IPLACE.LE.NBOBL1+NBFAC1+NBOBL2)THEN
  302. INCM2 = IPLACE - NBOBL1 - NBFAC1
  303. ELSE
  304. INCM4 = IPLACE - NBOBL1 - NBFAC1 - NBOBL2
  305. ENDIF
  306. MOBUF=CMOTS1(IPLACE)
  307. IRBUF=LONG(MOBUF)
  308. ** write(6,*) 'matcar 305 ',mobuf
  309. if (mobuf(1:4).eq.'VECT') ivect=1
  310. ENDIF
  311. *
  312. IMIL=0
  313. *
  314. * PETIT TEST POUR COQ3 NON EXCENTRABLE MILL 21 / 2 /92
  315. *
  316. IF(MELE.EQ.27.AND.MFR1.EQ.3)THEN
  317. IF(MOBUF.EQ.'EXCE')THEN
  318. CALL ERREUR(474)
  319. GOTO 99
  320. ENDIF
  321. ENDIF
  322. *
  323. * On desire lire une composante "quelconque":
  324. *
  325. IF(IPLACE .EQ. 0)THEN
  326. IF(MOCHOI.EQ.'PARA'.AND.IRCHOI.NE.0)THEN
  327. NUDIR2=1
  328. GOTO 10
  329. ENDIF
  330. IF(MOCHOI.EQ.'PERP'.AND.IRCHOI.NE.0)THEN
  331. NUDIR2=2
  332. GOTO 10
  333. ENDIF
  334. ENDIF
  335. *
  336. * kich test mot cle
  337. *
  338. IF(MOBUF.EQ.'REND'.AND.IRBUF.NE.0)THEN
  339. RFLAG = .TRUE.
  340. ENDIF
  341. *
  342. * Lecture eventuelle d'un flottant
  343. *
  344. CALL LIRREE(RECOM,0,IRET2)
  345. IF(IRET2.EQ.1)THEN
  346. *
  347. * kich rendement cas isotrope
  348. *
  349. IF(RFLAG.AND.MOBUF.EQ.'REND'.AND.IRBUF.NE.0) RFLAG = .FALSE.
  350. *
  351. * Dans le cas ou on lit le mot incline on peut eventuellement trouver
  352. * en plus de l'angle un point donnant la direction de la normal
  353. * exterieur @ la coque
  354. *
  355. IF(MOCHOI.EQ.'INCL'.AND.IRCHOI.NE.0)THEN
  356. NUDIR2=3
  357. ANG=RECOM*XPI/180.D0
  358. IF((IDIM.EQ.3.AND.MFR1.EQ.3).OR.MFR1.EQ.9.OR.
  359. . MFR1.EQ.5.OR.(IDIM.EQ.3.AND.MFR1.EQ.35))THEN
  360. CALL LIROBJ('POINT',NUMP3,0,IRET)
  361. IF(IERR.NE.0) GOTO 99
  362. ENDIF
  363. * en 2D, 2eme angle possible pour rotation hors plan
  364. IF(IFOUR.EQ.1)THEN
  365. CALL LIRREE(RECOM2,0,IRET22)
  366. IF(IRET22.NE.0) ANG2=RECOM2*XPI/180.D0
  367. ENDIF
  368. GOTO 10
  369. ENDIF
  370. IF(IFLAG.NE.2)THEN
  371. NOMID=MOMATR
  372. IF(INCM1.NE.0) MLMOT1.MOTS(**) = LESOBL(INCM1)
  373. IF(INCM3.NE.0) MLMOT1.MOTS(**) = LESFAC(INCM3)
  374. ELSE
  375. IF(INCM1.NE.0)THEN
  376. MOTERR =LESOBL(INCM1)
  377. CALL ERREUR (197)
  378. GOTO 99
  379. ELSE
  380. IF(INCM3.NE.0)THEN
  381. MOTERR =LESFAC(INCM3)
  382. CALL ERREUR (197)
  383. GOTO 99
  384. ENDIF
  385. ENDIF
  386. ENDIF
  387. *
  388. NOMID=MOCARA
  389. IF(INCM2.NE.0) MLMOT1.MOTS(**) = LESOBL(INCM2)
  390. IF(INCM4.NE.0) MLMOT1.MOTS(**) = LESFAC(INCM4)
  391. *
  392. IF(IFLAG.EQ.0)THEN
  393. IF(IRCHOI.NE.0) MLMOT1.MOTS(**) = MOCHOI
  394. ELSE
  395. IF(IRCHOI.NE.0)THEN
  396. MOTERR =MOCHOI
  397. CALL ERREUR (197)
  398. GOTO 99
  399. ENDIF
  400. ENDIF
  401. *
  402. JG=MLREE1.PROG(/1)+1
  403. SEGADJ MLREE1
  404. MLREE1.PROG(JG)=RECOM
  405.  
  406. ELSE
  407. CALL QUETYP(CAR,0,IRET1)
  408. IF(IERR.NE.0) GO TO 99
  409. IF(RFLAG)THEN
  410. IF(CAR.EQ.'MOT ')THEN
  411. GOTO 10
  412. ELSE
  413. * kich matrice rendement
  414. IF(MOCHOI.EQ.'REND'.AND.IRCHOI.NE.0) RFLAG = .FALSE.
  415. ENDIF
  416. ENDIF
  417. CALL LIROBJ(CAR,IPTRUC,0,IRET1)
  418. IF(IRET1 .EQ. 1) CALL ACTOBJ(CAR,IPTRUC,1)
  419. IF(IERR.NE.0) GO TO 99
  420. *
  421. * On a lu un objet de type autre qu' un flottant
  422. *
  423. IF(IRACOR.EQ.1.AND.MOCHOI.EQ.'LIQU' .AND.IRCHOI.NE.0)THEN
  424. IF(CAR.NE.'MAILLAGE')THEN
  425. MOTERR ='MAILLAGE'
  426. CALL ERREUR(37)
  427. GOTO 99
  428. ELSE
  429. IPLIQU=IPTRUC
  430. GOTO 10
  431. ENDIF
  432.  
  433. ELSEIF (MOCHOI.EQ.'DIRE'.AND.IRCHOI.NE.0)THEN
  434. IF(MATE.NE.1.AND.MATE.NE.2.AND.MATE.NE.3.AND.MATE.NE.4.AND.
  435. > .NOT.RFLAG)THEN
  436. CALL ERREUR(728)
  437. GOTO 99
  438. ENDIF
  439. IF(CAR.NE.'POINT')THEN
  440. MOTERR ='POINT'
  441. CALL ERREUR(37)
  442. GOTO 99
  443. ELSE
  444. NUDIR1=1
  445. NUMP1=IPTRUC
  446. ENDIF
  447. *
  448. * DANS LE CAS DES ELEMENTS MASSIFS 3D IL FAUT DEUX POINTS
  449. *
  450. IF ((MFR1.EQ.1 .OR. MFR1.EQ.31 .OR.
  451. & MFR1.EQ.33 .OR. MFR1.EQ.45.OR. MFR1.EQ.75)
  452. S .AND. IDIM.EQ.3)THEN
  453. CALL LIROBJ(CAR,NUMP2,0,IRET)
  454. IF(IERR.NE.0.OR.IRET.EQ.0)GO TO 99
  455. ENDIF
  456. GOTO 10
  457.  
  458. ELSEIF (MOCHOI.EQ.'RADI'.AND.IRCHOI.NE.0)THEN
  459. IF(CAR.NE.'POINT')THEN
  460. MOTERR ='POINT'
  461. CALL ERREUR(37)
  462. GOTO 99
  463. ELSE
  464. NUDIR1=2
  465. NUMP1=IPTRUC
  466. ENDIF
  467. *
  468. * DANS LE CAS DES ELEMENTS MASSIFS 3D IL FAUT DEUX POINTS
  469. *
  470. IF ((MFR1.EQ.1 .OR. MFR1.EQ.31 .OR.
  471. & MFR1.EQ.33 .OR. MFR1.EQ.45.OR. MFR1.EQ.75)
  472. S .AND. IDIM.EQ.3)THEN
  473. CALL LIROBJ(CAR,NUMP2,0,IRET)
  474. IF(IERR.NE.0.OR.IRET.EQ.0)GO TO 99
  475. ENDIF
  476. GOTO 10
  477. ENDIF
  478. *
  479. IF(IFLAG.NE.2)THEN
  480. NOMID=MOMATR
  481. IF(INCM1.NE.0) MLMOT2.MOTS(**) = LESOBL(INCM1)
  482. IF(INCM3.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM3)
  483. ELSE
  484. IF(INCM1.NE.0)THEN
  485. MOTERR =LESOBL(INCM1)
  486. CALL ERREUR (197)
  487. GOTO 99
  488. ELSE
  489. IF(INCM3.NE.0)THEN
  490. MOTERR =LESFAC(INCM3)
  491. CALL ERREUR (197)
  492. GOTO 99
  493. ENDIF
  494. ENDIF
  495. ENDIF
  496. *
  497. NOMID=MOCARA
  498. IF(INCM2.NE.0) MLMOT2.MOTS(**) = LESOBL(INCM2)
  499. IF(INCM4.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM4)
  500. *
  501. IF(IFLAG.EQ.0)THEN
  502. IF(IRCHOI.NE.0) MLMOT2.MOTS(**) = MOCHOI
  503. ELSE
  504. IF(IRCHOI.NE.0)THEN
  505. MOTERR =MOCHOI
  506. CALL ERREUR (197)
  507. GOTO 99
  508. ENDIF
  509. ENDIF
  510. *
  511.  
  512. JGM = MLMOT3.MOTS(/2)
  513. MLMOT3.MOTS(**)=CAR(1:4)
  514. MOTS(**) =CAR(5:8)
  515. JG=MLENT2.LECT(/1)+1
  516. SEGADJ MLENT2
  517. MLENT2.LECT(JG)=IPTRUC
  518. ENDIF
  519. GOTO 10
  520. * END DO
  521. *
  522. 20 CONTINUE
  523. *
  524. * DANS LE CAS DES TUYAUX 3D ,ON REGARDE SI LES CARACTERISTIQUES
  525. * GEOMETRIQUES ONT ETE DONNEES ,SI OUI ON VERIFIE SI ON EST
  526. * DANS LE CAS DES COUDES
  527. *
  528. IF(MFR1.EQ.13.AND.IDIM.EQ.3)THEN
  529. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IGEO,'RAYO')
  530. IF(IGEO.NE.0)THEN
  531. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICOUD,'RACO')
  532. ENDIF
  533. ENDIF
  534. *
  535. * DANS LE CAS DES POUTRES 3D ,ON REGARDE SI LES CARACTERISTIQUES
  536. * GEOMETRIQUES ONT ETE DONNEES
  537. *
  538. IF(MFR1.EQ.7)THEN
  539. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IGEO,'SECT')
  540. ENDIF
  541.  
  542. *
  543. * TRAITEMENT MODELE DDI
  544. *
  545. IF(INAT.EQ.63)THEN
  546. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDP1,'DP1')
  547. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDP2,'DP2')
  548. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDV1,'DV1')
  549. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDV2,'DV2')
  550. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICP1,'CP1')
  551. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICP2,'CP2')
  552. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICV1,'CV1')
  553. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICV2,'CV2')
  554.  
  555. IF((MLREE1.PROG(ICP1).EQ.0.D0).AND.(MLREE1.PROG(IDP1).NE.0.D0))
  556. & THEN
  557. CALL ERREUR(906)
  558. RETURN
  559. ENDIF
  560. IF((MLREE1.PROG(ICP2).EQ.0.D0).AND.(MLREE1.PROG(IDP2).NE.0.D0))
  561. & THEN
  562. CALL ERREUR(906)
  563. RETURN
  564. ENDIF
  565. IF((MLREE1.PROG(ICV1).EQ.0.D0).AND.(MLREE1.PROG(IDV1).NE.0.D0))
  566. & THEN
  567. CALL ERREUR(906)
  568. RETURN
  569. ENDIF
  570. IF((MLREE1.PROG(ICV2).EQ.0.D0).AND.(MLREE1.PROG(IDV2).NE.0.D0))
  571. & THEN
  572. CALL ERREUR(906)
  573. RETURN
  574. ENDIF
  575. ENDIF
  576.  
  577. * VERIFICATIONS CAS D'UN MODELE MODAL
  578. IF(MFR1.EQ.27.AND.MELE.EQ.45)THEN
  579. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IPLA1,'FREQ')
  580. IF(IPLA1.gt.0.and.IPLA1.le.MLREE1.PROG(/1))THEN
  581. IF(MLREE1.PROG(IPLA1).LT.0.D0)THEN
  582. MOTERR ='FREQ '
  583. CALL ERREUR(549)
  584. RETURN
  585. ENDIF
  586. ENDIF
  587. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IPLA1,'MASS')
  588. IF(IPLA1.gt.0.and.IPLA1.le.MLREE1.PROG(/1))THEN
  589. IF(MLREE1.PROG(IPLA1).LT.0.D0)THEN
  590. MOTERR ='MASS '
  591. CALL ERREUR(549)
  592. RETURN
  593. ENDIF
  594. ENDIF
  595. ENDIF
  596.  
  597. *
  598. * tri redondance mlmot1
  599. JGM=mlmot1.mots(/2)
  600. JG = mlree1.prog(/1)
  601. IF(jgm.ge.2)THEN
  602. segini mlmot5
  603. mlmot5.mots(1) = mlmot1.mots(1)
  604. ik5 = 1
  605. do 151 jj = 2, jgm
  606. do jj5 = 1, ik5
  607. IF(mlmot1.mots(jj).eq.mlmot5.mots(jj5))THEN
  608. call erreur(674)
  609. return
  610. endif
  611. enddo
  612. ik5 = ik5 + 1
  613. mlmot5.mots(ik5) = mlmot1.mots(jj)
  614. 151 continue
  615. segsup mlmot5
  616. endif
  617.  
  618. C Traitement particulier pour le modele de Gurson2
  619. IF(INAT.EQ.64)THEN
  620. NCOMP = MLREE1.PROG(/1)
  621. CALL PLACE(MLMOT1.MOTS, MLMOT1.MOTS(/2), IQ1, 'Q ')
  622. CALL PLACE(MLMOT1.MOTS, MLMOT1.MOTS(/2), IQ2, 'Q2 ')
  623. CALL PLACE(MLMOT1.MOTS, MLMOT1.MOTS(/2), IQ3, 'Q3 ')
  624. IF(IQ2.EQ.0)THEN
  625. JG = MLREE1.PROG(/1) + 1
  626. SEGADJ MLREE1
  627. MLREE1.PROG(JG) = 1.D0
  628. JGM = MLMOT1.MOTS(/2) + 1
  629. SEGADJ MLMOT1
  630. MLMOT1.MOTS(JGM) = 'Q2 '
  631. ENDIF
  632. IF(IQ3.EQ.0)THEN
  633. Q1 = MLREE1.PROG(IQ1)
  634. JG = MLREE1.PROG(/1) + 1
  635. SEGADJ MLREE1
  636. MLREE1.PROG(JG) = Q1**2
  637. JGM = MLMOT1.MOTS(/2) + 1
  638. SEGADJ MLMOT1
  639. MLMOT1.MOTS(JGM) = 'Q3 '
  640. ENDIF
  641. ENDIF
  642.  
  643. IF((IRACOR.EQ.0.AND.IPLIQU.EQ.0.and.nefmod.ne.45).OR.
  644. & MLMOT1.MOTS(/2) .NE. 0 .OR. MLMOT2.MOTS(/2).NE.0)THEN
  645.  
  646. IF(ITHER.NE.0 .OR. IDIFF.NE.0 .OR. IMETA.NE.0)THEN
  647. IF(MFR1 .EQ. 75)THEN
  648. C Cas des JOI1 (MFR=75) ==> Ressorts THERMIQUES
  649. C ====================
  650. ISUP=1
  651.  
  652. ELSE
  653. CALL PLACE(matmod,NMAT,iray,'RAYONNEMENT')
  654. C Support 6 SAUF pour le RAYONNEMENT...
  655. C Les cas-tests de RAYONNEMENT sont en erreur sans ca...
  656. IF(iray.EQ.0)THEN
  657. ISUP = 6
  658. ELSE
  659. ISUP = 3
  660. ENDIF
  661. ENDIF
  662.  
  663. ELSEIF(ICONT.NE.0 .OR. ICHPH.NE.0)THEN
  664. ISUP=1
  665.  
  666. ELSE
  667. ISUP=3
  668. ENDIF
  669.  
  670. LETYP ='CARACTERISTIQUES'
  671. itart=0
  672. CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1,
  673. & MLENT2,LETYP,JER1,ISUP,ICARA,itart)
  674. IF(IERR.NE.0) GO TO 99
  675. ENDIF
  676. *
  677. * TRAITEMENT POUR LES ELEMENTS RACCORDS FLUIDE/STRUCTURE
  678. *
  679. IF(IRACOR.NE.0.AND.IPLIQU.NE.0)THEN
  680. CALL VRACOR(IPMODE,IPLIQU,IFLAG,ICARA)
  681. IF(IERR.NE.0)GOTO 99
  682. ENDIF
  683. *
  684. * TRAITEMENT PARTICULIER POUR LES POUTRES ET TUYAUX
  685. * PB DU VECTEUR LOCAL - MILL FEV 92
  686. *
  687. ** write(6,*) 'matcar avant pouvlo',mfr1,icoud,igeo
  688. ** IF((MFR1.EQ.7.OR.(MFR1.EQ.13.AND.ICOUD.EQ.0))
  689. IF((MFR1.EQ.7.OR.(MFR1.EQ.13 ))
  690. & .and.(ivect.ne.0.or.IGEO.NE.0).AND.IDIM.EQ.3)THEN
  691. ** & .AND.IDIM.EQ.3)THEN
  692. CALL POUVLO(IPMODE,MLMOT2,ISUP,ICARA)
  693. IF(IERR.NE.0) GO TO 99
  694. ENDIF
  695. *
  696. * Traitement pour les materiaux orthotropes
  697. *
  698. C= Dans le cas IDIM=1, on ne traite pas les mots cles PARA,DIRE,PERP...
  699. C= car les directions d'orthotropie correspondent au repere global
  700. d_mela = formod(1).ne.'MELANGE'
  701. d_nast = formod(1).ne.'NAVIER_STOKES'
  702. IF(IFLAG.NE.2.and.nefmod.ne.45.and.d_mela.and.d_nast.and.
  703. & IMETA.eq.0.AND.ICHPH.EQ.0) THEN
  704. IF(IDIM.NE.1)THEN
  705. CALL IDMAT2(IPMODE,ICARA,NUDIR1,NUMP1,NUMP2,NUDIR2,
  706. & NUMP3,ANG,ANG2,IPCARA,RFLAG)
  707. IF(IERR.NE.0) GO TO 99
  708. IF(IPCARA.NE.0)THEN
  709. CALL DTCHAM(ICARA)
  710. ICARA=IPCARA
  711. ENDIF
  712. ENDIF
  713.  
  714. * romain gontero & sellier
  715. * preconditionnement pour modele de fibres dans FLDO3D
  716. * tester si on a un modele de fibre
  717. * extraire variable prefibr dans fluendo si=1
  718.  
  719. IF((IFLAG.NE.2).and.(formod(1).eq.'MECANIQUE').and.(INAT.eq.187))
  720. # THEN
  721.  
  722. CALL CPREFIB (IPMODE,MLMOT2,ISUP,ICARA)
  723. * IERR=0
  724. IF(IERR.NE.0) GO TO 99
  725. ENDIF
  726.  
  727. * fin Romain & sellier
  728. ENDIF
  729. *
  730. * MODAL - traitement direct a partir de la table BASE MODALE
  731. *
  732. IF(nefmod.eq.45.and.MFR1.EQ.27.and.icara.eq.0)THEN
  733. IF(itbas.eq.0)THEN
  734. CALL LIRTAB('BASE_MODALE',ITBAS,0,IRETOU)
  735. IF(IRETOU.NE.0)THEN
  736. CALL ACCTAB(ITBAS,'MOT',IM,X0,'MODES',L0,IP0,
  737. & 'TABLE',I1,X1,CHARRE,L1,ITMOD)
  738. itbas = itmod
  739.  
  740. ELSE
  741. CALL LIRTAB('BASE_DE_MODES',ITBAS,0,IRETOU)
  742. ENDIF
  743. endif
  744.  
  745. jg = 0
  746. segini mlreel,mlree1,mlree2,mlenti,mlent2
  747. n1 = 1
  748. segini mmode1
  749. C segini mlchpo
  750.  
  751. do 49 ii = 1, kmodel(/1)
  752. IMODEL=KMODEL(ii)
  753. mmode1.kmodel(1) = imodel
  754. segact imodel
  755. meleme = imamod
  756. segact meleme
  757. do 48 jj = 1,num(/2)
  758. ipoi1 = num(1,jj)
  759.  
  760. * de quel mode s agit-il ?
  761. mtable = itbas
  762. segact mtable
  763. mlo = mlotab
  764. IM = 0
  765. 40 CONTINUE
  766. IM = IM + 1
  767. TYPRET = ' '
  768. CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',L0,IP0,
  769. & TYPRET,I1,X1,CHARRE,L1,ITMOD)
  770. IF(ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ')THEN
  771. CALL ACCTAB(ITMOD,'MOT' ,I0,X0,'POINT_REPERE',L0,IP0,
  772. & 'POINT',I1,X1,' ' ,L1,IPTS)
  773. IF(ipts.eq.ipoi1) goto 45
  774. ENDIF
  775. IF(im.lt.mlo) goto 40
  776. interr(1) = ipoi1
  777. * pas trouve de caracteristiques pour le point support
  778. call erreur(3)
  779. return
  780.  
  781. 45 continue
  782.  
  783. CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  784. & 'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  785. if(xfreq.lt.0.D0)THEN
  786. MOTERR ='FREQ '
  787. CALL ERREUR(549)
  788. RETURN
  789. endif
  790. mlree1.prog(**)= xfreq
  791. CALL ACCTAB(ITMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
  792. & 'FLOTTANT',I1,XMGEN,' ',L1,IP1)
  793. mlree2.prog(**)= xmgen
  794. CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  795. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  796. lect(**) = itdepl
  797. 48 continue
  798. 49 continue
  799.  
  800. NOMID=MOMATR
  801. * voir aussi idmatr
  802. MLMOT2.MOTS(**) = 'FREQ'
  803. MLMOT2.MOTS(**) = 'MASS'
  804. MLMOT2.MOTS(**) = 'DEFO'
  805. * IF(INCM3.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM3)
  806. JG=MLENT2.LECT(/1)+3
  807. SEGADJ MLENT2
  808. MLENT2.LECT(JG-2) = mlree1
  809. MLENT2.LECT(JG-1) = mlree2
  810. MLENT2.LECT(JG) = mlenti
  811.  
  812. MLMOT3.MOTS(**)='LIST'
  813. MOTS(**) ='REEL'
  814. MLMOT3.MOTS(**)='LIST'
  815. MOTS(**) ='REEL'
  816. MLMOT3.MOTS(**)='CHPO'
  817. MOTS(**) ='INT '
  818.  
  819. ISUP=3
  820.  
  821. LETYP ='CARACTERISTIQUES'
  822. itart = 1
  823. CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREEL,
  824. & MLENT2,LETYP, JER1, ISUP, ICARA, itart)
  825. IF(IERR.NE.0) GO TO 99
  826. segsup mlreel,mlent2
  827. ENDIF
  828.  
  829. C=DEB==== FORMULATION HHO ==== Ajout de composantes ====================
  830. CALL HHOMAT(IPMODE,ICARA,iret)
  831. IF (iret.ne.0) GOTO 99
  832. C=FIN==== FORMULATION HHO ==============================================
  833.  
  834. IF(IERR.EQ.0)THEN
  835. CALL ACTOBJ('MCHAML ',ICARA,1)
  836. CALL ECROBJ('MCHAML ',ICARA)
  837. ENDIF
  838.  
  839. 99 CONTINUE
  840.  
  841. * Suppression des segments
  842. *
  843. SEGSUP,MLMOTS,MLMOT1,MLMOT2,MLMOT3,MLREE1,MLENT2
  844.  
  845. IF(MOMATR.NE.0)THEN
  846. NOMID = MOMATR
  847. IF(lsupma) SEGSUP,NOMID
  848. ENDIF
  849. IF(MOCARA.NE.0)THEN
  850. NOMID = MOCARA
  851. IF(lsupca) SEGSUP,NOMID
  852. ENDIF
  853.  
  854. END
  855.  
  856.  
  857.  

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