Télécharger matcar.eso

Retour à la liste

Numérotation des lignes :

matcar
  1. C MATCAR SOURCE JK148537 25/02/17 21:15:07 12156
  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. *
  236. MOCHOI = ' '
  237. *
  238. IMIL = 1
  239.  
  240. 10 CONTINUE
  241. IF(IMIL.EQ.0) CALL MESLIR(-175)
  242. INCM1 = 0
  243. INCM2 = 0
  244. INCM3 = 0
  245. INCM4 = 0
  246. *
  247. IRBUF = 0
  248. IRCHOI = 0
  249.  
  250. C Concaténation des MOTS attendus pour le LIRMOT discriminant
  251. NOMID = MOMATR
  252. NBOBL1 = NOMID.LESOBL(/2)
  253. NBFAC1 = NOMID.LESFAC(/2)
  254.  
  255. NOMID1 = MOCARA
  256. NBOBL2 = NOMID1.LESOBL(/2)
  257. NBFAC2 = NOMID1.LESFAC(/2)
  258.  
  259. JGM = NBOBL1 + NBFAC1 + NBOBL2 + NBFAC2
  260. IF(JGM .GT. NMOT1)THEN
  261. WRITE(*,*)'AUGMENTER LA TAILLE DE CMOTS1 DANS MATCAR.ESO'
  262. CALL ERREUR(5)
  263. ENDIF
  264.  
  265. DO IOBL=1,NBOBL1
  266. CMOTS1(IOBL)=NOMID.LESOBL(IOBL)
  267. ENDDO
  268.  
  269. DO IFAC=1,NBFAC1
  270. CMOTS1(NBOBL1+IFAC)=NOMID.LESFAC(IFAC)
  271. ENDDO
  272.  
  273. DO IOBL=1,NBOBL2
  274. CMOTS1(NBOBL1+NBFAC1+IOBL)=NOMID1.LESOBL(IOBL)
  275. ENDDO
  276.  
  277. DO IFAC=1,NBFAC2
  278. CMOTS1(NBOBL1+NBFAC1+NBOBL2+IFAC)=NOMID1.LESFAC(IFAC)
  279. ENDDO
  280.  
  281. MJGM=-JGM
  282. C LIRMOT appele avec MJGM<0 => on utilise des abreviations
  283. CALL LIRMOT(CMOTS1,MJGM,IPLACE,0)
  284. IF(IERR.NE.0) GOTO 99
  285. ** write(6,*) 'matcar apres lirmot ',iplace
  286. IF(IPLACE .EQ. 0)THEN
  287. CALL LIRCHA(MOBUF,0,IRBUF)
  288. MOBUF=MOBUF(1:4)
  289. IF(IERR .NE.0) GOTO 99
  290. IF(IRBUF.EQ.0) GOTO 20
  291. MOCHOI=MOBUF
  292. IRCHOI=IRBUF
  293.  
  294. ELSE
  295. IF (IPLACE.GT.0 .AND. IPLACE.LE.NBOBL1)THEN
  296. INCM1 = IPLACE
  297. ELSEIF(IPLACE.GT.NBOBL1 .AND. IPLACE.LE.NBOBL1+NBFAC1)THEN
  298. INCM3 = IPLACE - NBOBL1
  299. ELSEIF(IPLACE.GT.NBOBL1+NBFAC1 .AND.
  300. & IPLACE.LE.NBOBL1+NBFAC1+NBOBL2)THEN
  301. INCM2 = IPLACE - NBOBL1 - NBFAC1
  302. ELSE
  303. INCM4 = IPLACE - NBOBL1 - NBFAC1 - NBOBL2
  304. ENDIF
  305. MOBUF=CMOTS1(IPLACE)
  306. IRBUF=LONG(MOBUF)
  307. ** write(6,*) 'matcar 305 ',mobuf
  308. if (mobuf(1:4).eq.'VECT') ivect=1
  309. ENDIF
  310. *
  311. IMIL=0
  312. *
  313. * PETIT TEST POUR COQ3 NON EXCENTRABLE MILL 21 / 2 /92
  314. *
  315. IF(MELE.EQ.27.AND.MFR1.EQ.3)THEN
  316. IF(MOBUF.EQ.'EXCE')THEN
  317. CALL ERREUR(474)
  318. GOTO 99
  319. ENDIF
  320. ENDIF
  321. *
  322. * On desire lire une composante "quelconque":
  323. *
  324. IF(IPLACE .EQ. 0)THEN
  325. IF(MOCHOI.EQ.'PARA'.AND.IRCHOI.NE.0)THEN
  326. NUDIR2=1
  327. GOTO 10
  328. ENDIF
  329. IF(MOCHOI.EQ.'PERP'.AND.IRCHOI.NE.0)THEN
  330. NUDIR2=2
  331. GOTO 10
  332. ENDIF
  333. ENDIF
  334. *
  335. * kich test mot cle
  336. *
  337. IF(MOBUF.EQ.'REND'.AND.IRBUF.NE.0)THEN
  338. RFLAG = .TRUE.
  339. ENDIF
  340. *
  341. * Lecture eventuelle d'un flottant
  342. *
  343. CALL LIRREE(RECOM,0,IRET2)
  344. IF(IRET2.EQ.1)THEN
  345. *
  346. * kich rendement cas isotrope
  347. *
  348. IF(RFLAG.AND.MOBUF.EQ.'REND'.AND.IRBUF.NE.0) RFLAG = .FALSE.
  349. *
  350. * Dans le cas ou on lit le mot incline on peut eventuellement trouver
  351. * en plus de l'angle un point donnant la direction de la normal
  352. * exterieur @ la coque
  353. *
  354. IF(MOCHOI.EQ.'INCL'.AND.IRCHOI.NE.0)THEN
  355. NUDIR2=3
  356. ANG=RECOM*XPI/180.D0
  357. IF((IDIM.EQ.3.AND.MFR1.EQ.3).OR.MFR1.EQ.9.OR.
  358. . MFR1.EQ.5.OR.(IDIM.EQ.3.AND.MFR1.EQ.35))THEN
  359. CALL LIROBJ('POINT',NUMP3,0,IRET)
  360. IF(IERR.NE.0) GOTO 99
  361. ENDIF
  362. * en 2D, 2eme angle possible pour rotation hors plan
  363. IF(IFOUR.EQ.1)THEN
  364. CALL LIRREE(RECOM2,0,IRET22)
  365. IF(IRET22.NE.0) ANG2=RECOM2*XPI/180.D0
  366. ENDIF
  367. GOTO 10
  368. ENDIF
  369. IF(IFLAG.NE.2)THEN
  370. NOMID=MOMATR
  371. IF(INCM1.NE.0) MLMOT1.MOTS(**) = LESOBL(INCM1)
  372. IF(INCM3.NE.0) MLMOT1.MOTS(**) = LESFAC(INCM3)
  373. ELSE
  374. IF(INCM1.NE.0)THEN
  375. MOTERR =LESOBL(INCM1)
  376. CALL ERREUR (197)
  377. GOTO 99
  378. ELSE
  379. IF(INCM3.NE.0)THEN
  380. MOTERR =LESFAC(INCM3)
  381. CALL ERREUR (197)
  382. GOTO 99
  383. ENDIF
  384. ENDIF
  385. ENDIF
  386. *
  387. NOMID=MOCARA
  388. IF(INCM2.NE.0) MLMOT1.MOTS(**) = LESOBL(INCM2)
  389. IF(INCM4.NE.0) MLMOT1.MOTS(**) = LESFAC(INCM4)
  390. *
  391. IF(IFLAG.EQ.0)THEN
  392. IF(IRCHOI.NE.0) MLMOT1.MOTS(**) = MOCHOI
  393. ELSE
  394. IF(IRCHOI.NE.0)THEN
  395. MOTERR =MOCHOI
  396. CALL ERREUR (197)
  397. GOTO 99
  398. ENDIF
  399. ENDIF
  400. *
  401. JG=MLREE1.PROG(/1)+1
  402. SEGADJ MLREE1
  403. MLREE1.PROG(JG)=RECOM
  404.  
  405. ELSE
  406. CALL QUETYP(CAR,0,IRET1)
  407. IF(IERR.NE.0) GO TO 99
  408. IF(RFLAG)THEN
  409. IF(CAR.EQ.'MOT ')THEN
  410. GOTO 10
  411. ELSE
  412. * kich matrice rendement
  413. IF(MOCHOI.EQ.'REND'.AND.IRCHOI.NE.0) RFLAG = .FALSE.
  414. ENDIF
  415. ENDIF
  416. CALL LIROBJ(CAR,IPTRUC,0,IRET1)
  417. IF(IRET1 .EQ. 1) CALL ACTOBJ(CAR,IPTRUC,1)
  418. IF(IERR.NE.0) GO TO 99
  419. *
  420. * On a lu un objet de type autre qu' un flottant
  421. *
  422. IF(IRACOR.EQ.1.AND.MOCHOI.EQ.'LIQU' .AND.IRCHOI.NE.0)THEN
  423. IF(CAR.NE.'MAILLAGE')THEN
  424. MOTERR ='MAILLAGE'
  425. CALL ERREUR(37)
  426. GOTO 99
  427. ELSE
  428. IPLIQU=IPTRUC
  429. GOTO 10
  430. ENDIF
  431.  
  432. ELSEIF (MOCHOI.EQ.'DIRE'.AND.IRCHOI.NE.0)THEN
  433. IF(MATE.NE.1.AND.MATE.NE.2.AND.MATE.NE.3.AND.MATE.NE.4.AND.
  434. > .NOT.RFLAG)THEN
  435. CALL ERREUR(728)
  436. GOTO 99
  437. ENDIF
  438. IF(CAR.NE.'POINT')THEN
  439. MOTERR ='POINT'
  440. CALL ERREUR(37)
  441. GOTO 99
  442. ELSE
  443. NUDIR1=1
  444. NUMP1=IPTRUC
  445. ENDIF
  446. *
  447. * DANS LE CAS DES ELEMENTS MASSIFS 3D IL FAUT DEUX POINTS
  448. *
  449. IF ((MFR1.EQ.1 .OR. MFR1.EQ.31 .OR.
  450. & MFR1.EQ.33 .OR. MFR1.EQ.45.OR. MFR1.EQ.75)
  451. S .AND. IDIM.EQ.3)THEN
  452. CALL LIROBJ(CAR,NUMP2,0,IRET)
  453. IF(IERR.NE.0.OR.IRET.EQ.0)GO TO 99
  454. ENDIF
  455. GOTO 10
  456.  
  457. ELSEIF (MOCHOI.EQ.'RADI'.AND.IRCHOI.NE.0)THEN
  458. IF(CAR.NE.'POINT')THEN
  459. MOTERR ='POINT'
  460. CALL ERREUR(37)
  461. GOTO 99
  462. ELSE
  463. NUDIR1=2
  464. NUMP1=IPTRUC
  465. ENDIF
  466. *
  467. * DANS LE CAS DES ELEMENTS MASSIFS 3D IL FAUT DEUX POINTS
  468. *
  469. IF ((MFR1.EQ.1 .OR. MFR1.EQ.31 .OR.
  470. & MFR1.EQ.33 .OR. MFR1.EQ.45.OR. MFR1.EQ.75)
  471. S .AND. IDIM.EQ.3)THEN
  472. CALL LIROBJ(CAR,NUMP2,0,IRET)
  473. IF(IERR.NE.0.OR.IRET.EQ.0)GO TO 99
  474. ENDIF
  475. GOTO 10
  476. ENDIF
  477. *
  478. IF(IFLAG.NE.2)THEN
  479. NOMID=MOMATR
  480. IF(INCM1.NE.0) MLMOT2.MOTS(**) = LESOBL(INCM1)
  481. IF(INCM3.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM3)
  482. ELSE
  483. IF(INCM1.NE.0)THEN
  484. MOTERR =LESOBL(INCM1)
  485. CALL ERREUR (197)
  486. GOTO 99
  487. ELSE
  488. IF(INCM3.NE.0)THEN
  489. MOTERR =LESFAC(INCM3)
  490. CALL ERREUR (197)
  491. GOTO 99
  492. ENDIF
  493. ENDIF
  494. ENDIF
  495. *
  496. NOMID=MOCARA
  497. IF(INCM2.NE.0) MLMOT2.MOTS(**) = LESOBL(INCM2)
  498. IF(INCM4.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM4)
  499. *
  500. IF(IFLAG.EQ.0)THEN
  501. IF(IRCHOI.NE.0) MLMOT2.MOTS(**) = MOCHOI
  502. ELSE
  503. IF(IRCHOI.NE.0)THEN
  504. MOTERR =MOCHOI
  505. CALL ERREUR (197)
  506. GOTO 99
  507. ENDIF
  508. ENDIF
  509. *
  510.  
  511. JGM = MLMOT3.MOTS(/2)
  512. MLMOT3.MOTS(**)=CAR(1:4)
  513. MOTS(**) =CAR(5:8)
  514. JG=MLENT2.LECT(/1)+1
  515. SEGADJ MLENT2
  516. MLENT2.LECT(JG)=IPTRUC
  517. ENDIF
  518. GOTO 10
  519. * END DO
  520. *
  521. 20 CONTINUE
  522. *
  523. * DANS LE CAS DES TUYAUX 3D ,ON REGARDE SI LES CARACTERISTIQUES
  524. * GEOMETRIQUES ONT ETE DONNEES ,SI OUI ON VERIFIE SI ON EST
  525. * DANS LE CAS DES COUDES
  526. *
  527. IF(MFR1.EQ.13.AND.IDIM.EQ.3)THEN
  528. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IGEO,'RAYO')
  529. IF(IGEO.NE.0)THEN
  530. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICOUD,'RACO')
  531. ENDIF
  532. ENDIF
  533. *
  534. * DANS LE CAS DES POUTRES 3D ,ON REGARDE SI LES CARACTERISTIQUES
  535. * GEOMETRIQUES ONT ETE DONNEES
  536. *
  537. IF(MFR1.EQ.7)THEN
  538. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IGEO,'SECT')
  539. ENDIF
  540.  
  541. *
  542. * TRAITEMENT MODELE DDI
  543. *
  544. IF(INAT.EQ.63)THEN
  545. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDP1,'DP1')
  546. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDP2,'DP2')
  547. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDV1,'DV1')
  548. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDV2,'DV2')
  549. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICP1,'CP1')
  550. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICP2,'CP2')
  551. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICV1,'CV1')
  552. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICV2,'CV2')
  553.  
  554. IF((MLREE1.PROG(ICP1).EQ.0.D0).AND.(MLREE1.PROG(IDP1).NE.0.D0))
  555. & THEN
  556. CALL ERREUR(906)
  557. RETURN
  558. ENDIF
  559. IF((MLREE1.PROG(ICP2).EQ.0.D0).AND.(MLREE1.PROG(IDP2).NE.0.D0))
  560. & THEN
  561. CALL ERREUR(906)
  562. RETURN
  563. ENDIF
  564. IF((MLREE1.PROG(ICV1).EQ.0.D0).AND.(MLREE1.PROG(IDV1).NE.0.D0))
  565. & THEN
  566. CALL ERREUR(906)
  567. RETURN
  568. ENDIF
  569. IF((MLREE1.PROG(ICV2).EQ.0.D0).AND.(MLREE1.PROG(IDV2).NE.0.D0))
  570. & THEN
  571. CALL ERREUR(906)
  572. RETURN
  573. ENDIF
  574. ENDIF
  575.  
  576. * VERIFICATIONS CAS D'UN MODELE MODAL
  577. IF(MFR1.EQ.27.AND.MELE.EQ.45)THEN
  578. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IPLA1,'FREQ')
  579. IF(IPLA1.gt.0.and.IPLA1.le.MLREE1.PROG(/1))THEN
  580. IF(MLREE1.PROG(IPLA1).LT.0.D0)THEN
  581. MOTERR ='FREQ '
  582. CALL ERREUR(549)
  583. RETURN
  584. ENDIF
  585. ENDIF
  586. CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IPLA1,'MASS')
  587. IF(IPLA1.gt.0.and.IPLA1.le.MLREE1.PROG(/1))THEN
  588. IF(MLREE1.PROG(IPLA1).LT.0.D0)THEN
  589. MOTERR ='MASS '
  590. CALL ERREUR(549)
  591. RETURN
  592. ENDIF
  593. ENDIF
  594. ENDIF
  595.  
  596. *
  597. * tri redondance mlmot1
  598. JGM=mlmot1.mots(/2)
  599. JG = mlree1.prog(/1)
  600. IF(jgm.ge.2)THEN
  601. segini mlmot5
  602. mlmot5.mots(1) = mlmot1.mots(1)
  603. ik5 = 1
  604. do 151 jj = 2, jgm
  605. do jj5 = 1, ik5
  606. IF(mlmot1.mots(jj).eq.mlmot5.mots(jj5))THEN
  607. call erreur(674)
  608. return
  609. endif
  610. enddo
  611. ik5 = ik5 + 1
  612. mlmot5.mots(ik5) = mlmot1.mots(jj)
  613. 151 continue
  614. segsup mlmot5
  615. endif
  616.  
  617. C Traitement particulier pour le modele de Gurson2
  618. IF(INAT.EQ.64)THEN
  619. NCOMP = MLREE1.PROG(/1)
  620. CALL PLACE(MLMOT1.MOTS, MLMOT1.MOTS(/2), IQ1, 'Q ')
  621. CALL PLACE(MLMOT1.MOTS, MLMOT1.MOTS(/2), IQ2, 'Q2 ')
  622. CALL PLACE(MLMOT1.MOTS, MLMOT1.MOTS(/2), IQ3, 'Q3 ')
  623. IF(IQ2.EQ.0)THEN
  624. JG = MLREE1.PROG(/1) + 1
  625. SEGADJ MLREE1
  626. MLREE1.PROG(JG) = 1.D0
  627. JGM = MLMOT1.MOTS(/2) + 1
  628. SEGADJ MLMOT1
  629. MLMOT1.MOTS(JGM) = 'Q2 '
  630. ENDIF
  631. IF(IQ3.EQ.0)THEN
  632. Q1 = MLREE1.PROG(IQ1)
  633. JG = MLREE1.PROG(/1) + 1
  634. SEGADJ MLREE1
  635. MLREE1.PROG(JG) = Q1**2
  636. JGM = MLMOT1.MOTS(/2) + 1
  637. SEGADJ MLMOT1
  638. MLMOT1.MOTS(JGM) = 'Q3 '
  639. ENDIF
  640. ENDIF
  641.  
  642. IF((IRACOR.EQ.0.AND.IPLIQU.EQ.0.and.nefmod.ne.45).OR.
  643. & MLMOT1.MOTS(/2) .NE. 0 .OR. MLMOT2.MOTS(/2).NE.0)THEN
  644.  
  645. IF(ITHER.NE.0 .OR. IDIFF.NE.0 .OR. IMETA.NE.0)THEN
  646. IF(MFR1 .EQ. 75)THEN
  647. C Cas des JOI1 (MFR=75) ==> Ressorts THERMIQUES
  648. C ====================
  649. ISUP=1
  650.  
  651. ELSE
  652. CALL PLACE(matmod,NMAT,iray,'RAYONNEMENT')
  653. C Support 6 SAUF pour le RAYONNEMENT...
  654. C Les cas-tests de RAYONNEMENT sont en erreur sans ca...
  655. IF(iray.EQ.0)THEN
  656. ISUP = 6
  657. ELSE
  658. ISUP = 3
  659. ENDIF
  660. ENDIF
  661.  
  662. ELSEIF(ICONT.NE.0 .OR. ICHPH.NE.0)THEN
  663. ISUP=1
  664.  
  665. ELSE
  666. ISUP=3
  667. ENDIF
  668.  
  669. LETYP ='CARACTERISTIQUES'
  670. itart=0
  671. CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1,
  672. & MLENT2,LETYP,JER1,ISUP,ICARA,itart)
  673. IF(IERR.NE.0) GO TO 99
  674. ENDIF
  675. *
  676. * TRAITEMENT POUR LES ELEMENTS RACCORDS FLUIDE/STRUCTURE
  677. *
  678. IF(IRACOR.NE.0.AND.IPLIQU.NE.0)THEN
  679. CALL VRACOR(IPMODE,IPLIQU,IFLAG,ICARA)
  680. IF(IERR.NE.0)GOTO 99
  681. ENDIF
  682. *
  683. * TRAITEMENT PARTICULIER POUR LES POUTRES ET TUYAUX
  684. * PB DU VECTEUR LOCAL - MILL FEV 92
  685. *
  686. ** write(6,*) 'matcar avant pouvlo',mfr1,icoud,igeo
  687. ** IF((MFR1.EQ.7.OR.(MFR1.EQ.13.AND.ICOUD.EQ.0))
  688. IF((MFR1.EQ.7.OR.(MFR1.EQ.13 ))
  689. & .and.(ivect.ne.0.or.IGEO.NE.0).AND.IDIM.EQ.3)THEN
  690. ** & .AND.IDIM.EQ.3)THEN
  691. CALL POUVLO(IPMODE,MLMOT2,ISUP,ICARA)
  692. IF(IERR.NE.0) GO TO 99
  693. ENDIF
  694. *
  695. * Traitement pour les materiaux orthotropes
  696. *
  697. C= Dans le cas IDIM=1, on ne traite pas les mots cles PARA,DIRE,PERP...
  698. C= car les directions d'orthotropie correspondent au repere global
  699. d_mela = formod(1).ne.'MELANGE'
  700. d_nast = formod(1).ne.'NAVIER_STOKES'
  701. IF(IFLAG.NE.2.and.nefmod.ne.45.and.d_mela.and.d_nast.and.
  702. & IMETA.eq.0.AND.ICHPH.EQ.0) THEN
  703. IF(IDIM.NE.1)THEN
  704. CALL IDMAT2(IPMODE,ICARA,NUDIR1,NUMP1,NUMP2,NUDIR2,
  705. & NUMP3,ANG,ANG2,IPCARA,RFLAG)
  706. IF(IERR.NE.0) GO TO 99
  707. IF(IPCARA.NE.0)THEN
  708. CALL DTCHAM(ICARA)
  709. ICARA=IPCARA
  710. ENDIF
  711. ENDIF
  712.  
  713. * romain gontero & sellier
  714. * preconditionnement pour modele de fibres dans FLDO3D
  715. * tester si on a un modele de fibre
  716. * extraire variable prefibr dans fluendo si=1
  717.  
  718. IF((IFLAG.NE.2).and.(formod(1).eq.'MECANIQUE').and.(INAT.eq.187))
  719. # THEN
  720.  
  721. CALL CPREFIB (IPMODE,MLMOT2,ISUP,ICARA)
  722. * IERR=0
  723. IF(IERR.NE.0) GO TO 99
  724. ENDIF
  725.  
  726. * fin Romain & sellier
  727. ENDIF
  728. *
  729. * MODAL - traitement direct a partir de la table BASE MODALE
  730. *
  731. IF(nefmod.eq.45.and.MFR1.EQ.27.and.icara.eq.0)THEN
  732. IF(itbas.eq.0)THEN
  733. CALL LIRTAB('BASE_MODALE',ITBAS,0,IRETOU)
  734. IF(IRETOU.NE.0)THEN
  735. CALL ACCTAB(ITBAS,'MOT',IM,X0,'MODES',L0,IP0,
  736. & 'TABLE',I1,X1,CHARRE,L1,ITMOD)
  737. itbas = itmod
  738.  
  739. ELSE
  740. CALL LIRTAB('BASE_DE_MODES',ITBAS,0,IRETOU)
  741. ENDIF
  742. endif
  743.  
  744. jg = 0
  745. segini mlreel,mlree1,mlree2,mlenti,mlent2
  746. n1 = 1
  747. segini mmode1
  748. C segini mlchpo
  749.  
  750. do 49 ii = 1, kmodel(/1)
  751. IMODEL=KMODEL(ii)
  752. mmode1.kmodel(1) = imodel
  753. segact imodel
  754. nobmod = ivamod(/1)
  755. if (nobmod.gt.0) then
  756. if (tymode(1).eq.'TABLE ') then
  757. itbas = ivamod(1)
  758. CALL ACCTAB(ITBAS,'MOT',IM,X0,'MODES',L0,IP0,
  759. & 'TABLE',I1,X1,CHARRE,L1,ITMOD)
  760. itbas = itmod
  761. endif
  762. endif
  763. meleme = imamod
  764. segact meleme
  765. do 48 jj = 1,num(/2)
  766. ipoi1 = num(1,jj)
  767.  
  768. * de quel mode s agit-il ?
  769. mtable = itbas
  770. segact mtable
  771. mlo = mlotab
  772. IM = 0
  773. 40 CONTINUE
  774. IM = IM + 1
  775. TYPRET = ' '
  776. CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',L0,IP0,
  777. & TYPRET,I1,X1,CHARRE,L1,ITMOD)
  778. IF(ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ')THEN
  779. CALL ACCTAB(ITMOD,'MOT' ,I0,X0,'POINT_REPERE',L0,IP0,
  780. & 'POINT',I1,X1,' ' ,L1,IPTS)
  781. IF(ipts.eq.ipoi1) goto 45
  782. ENDIF
  783. IF(im.lt.mlo) goto 40
  784. interr(1) = ipoi1
  785. * pas trouve de caracteristiques pour le point support
  786. call erreur(3)
  787. return
  788.  
  789. 45 continue
  790.  
  791. CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  792. & 'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  793. if(xfreq.lt.0.D0)THEN
  794. MOTERR ='FREQ '
  795. CALL ERREUR(549)
  796. RETURN
  797. endif
  798. mlree1.prog(**)= xfreq
  799. CALL ACCTAB(ITMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
  800. & 'FLOTTANT',I1,XMGEN,' ',L1,IP1)
  801. mlree2.prog(**)= xmgen
  802. CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  803. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  804. lect(**) = itdepl
  805. 48 continue
  806. 49 continue
  807.  
  808. NOMID=MOMATR
  809. * voir aussi idmatr
  810. MLMOT2.MOTS(**) = 'FREQ'
  811. MLMOT2.MOTS(**) = 'MASS'
  812. MLMOT2.MOTS(**) = 'DEFO'
  813. * IF(INCM3.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM3)
  814. JG=MLENT2.LECT(/1)+3
  815. SEGADJ MLENT2
  816. MLENT2.LECT(JG-2) = mlree1
  817. MLENT2.LECT(JG-1) = mlree2
  818. MLENT2.LECT(JG) = mlenti
  819.  
  820. MLMOT3.MOTS(**)='LIST'
  821. MOTS(**) ='REEL'
  822. MLMOT3.MOTS(**)='LIST'
  823. MOTS(**) ='REEL'
  824. MLMOT3.MOTS(**)='CHPO'
  825. MOTS(**) ='INT '
  826.  
  827. ISUP=3
  828.  
  829. LETYP ='CARACTERISTIQUES'
  830. itart = 1
  831. CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREEL,
  832. & MLENT2,LETYP, JER1, ISUP, ICARA, itart)
  833. IF(IERR.NE.0) GO TO 99
  834. segsup mlreel,mlent2
  835. ENDIF
  836.  
  837. C=DEB==== FORMULATION HHO ==== Ajout de composantes ====================
  838. CALL HHOMAT(IPMODE,ICARA,iret)
  839. IF (iret.ne.0) GOTO 99
  840. C=FIN==== FORMULATION HHO ==============================================
  841.  
  842. IF(IERR.EQ.0)THEN
  843. CALL ACTOBJ('MCHAML ',ICARA,1)
  844. CALL ECROBJ('MCHAML ',ICARA)
  845. ENDIF
  846.  
  847. 99 CONTINUE
  848.  
  849. * Suppression des segments
  850. *
  851. SEGSUP,MLMOTS,MLMOT1,MLMOT2,MLMOT3,MLREE1,MLENT2
  852.  
  853. IF(MOMATR.NE.0)THEN
  854. NOMID = MOMATR
  855. IF(lsupma) SEGSUP,NOMID
  856. ENDIF
  857. IF(MOCARA.NE.0)THEN
  858. NOMID = MOCARA
  859. IF(lsupca) SEGSUP,NOMID
  860. ENDIF
  861.  
  862. END
  863.  
  864.  
  865.  
  866.  

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