Télécharger inomid.eso

Retour à la liste

Numérotation des lignes :

  1. C INOMID SOURCE CB215821 19/02/25 21:16:11 10119
  2. SUBROUTINE INOMID(iqmod,ityp,iret,luvari,lumato,lumatf,lupaex)
  3. *
  4. * iqmod est un pointeur sur un segment imodel de l'objet modele, il est
  5. * supposé actif
  6. *
  7. * A) ITYP= ' '
  8. * creation des segments de noms de composantes des MCHAML
  9. * CREES PAR LE MODELE ELEMENTAIRE
  10. * en entree luvari ,lumate et lupaex sont des listmots pour les :
  11. * variables internes , materiaux ,parametre externes s'ils ont été définis
  12. * attention : une modele de mecanique ne peut creer de composantes thermiques
  13. * ou phases metallurgiques !
  14. * fortement inspire de comou2
  15. *
  16. * B) ITYP different de ' ' on renvoie dans iret le nomid associé.
  17. *
  18. IMPLICIT INTEGER(I-N)
  19. IMPLICIT REAL*8(A-H,O-Z)
  20.  
  21. -INC CCOPTIO
  22.  
  23. -INC SMMODEL
  24. pointeur nomid1.nomid
  25. -INC SMLMOTS
  26.  
  27. parameter(ninc=13)
  28. logical dcmate
  29. character*8 nomtyp(14),ityp
  30. CHARACTER*4 lesinc(ninc),lesdua(ninc)
  31. CHARACTER*5 FMT1
  32.  
  33. EXTERNAL LONG
  34.  
  35. DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR','UT','RT',
  36. & 'LX','P','ALFA','BETA'/
  37. DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR','FT','MT',
  38. & 'FLX','FP','FALF','FBET'/
  39. data nomtyp/ 'DEPLACEM', 'FORCES ', 'GRADIENT', 'CONTRAIN',
  40. & 'DEFORMAT', 'MATERIAU', 'CARACTER', 'TEMPERAT',
  41. & 'PRINCIPA', 'VARINTER', 'GRAFLEXI', 'VINMETAL',
  42. & 'DEFINELA', 'PARAMEXT' /
  43.  
  44. C modele metallurgie ajoute par T.L. en mai 2018
  45. C Donnees pour la metallurgie :
  46. parameter(NBMET=2)
  47. CHARACTER*4 TYPMET(NBMET),LEBLON(3),KOISTI(2)
  48. DATA TYPMET/'LEBL', 'KOIS'/
  49. DATA LEBLON/'PEQ ', 'TAU ', 'F '/
  50. DATA KOISTI/'MS ', 'KM '/
  51.  
  52. dcmate = .false.
  53. nimcom = 0
  54. *
  55. * on suppose le sous-modele (imodel) est actif
  56. imodel = iqmod
  57. segact imodel*mod
  58. do im = 1,matmod(/2)
  59. if (matmod(im).eq.'IMPEDANCE') then
  60. dcmate = .true.
  61. if (luvari.gt.0) then
  62. mlmot5 = luvari
  63. luvari = 0
  64. mlmot6 = lumato
  65. lumato = 0
  66. segact mlmot5,mlmot6
  67. nimcom = mlmot5.mots(/2)
  68. nbrobl = nimcom
  69. nbrfac = nimcom
  70. segini nomid,nomid1
  71. do inim = 1,nimcom
  72. CALL PLACE(lesinc,ninc,IMOT,mlmot5.mots(inim))
  73. if (imot.eq.0) call erreur(26)
  74. lesobl(inim) = mlmot5.mots(inim)
  75. nomid1.lesobl(inim) = lesdua(imot)
  76. CALL PLACE(lesinc,ninc,IMOT,mlmot6.mots(inim))
  77. if (imot.eq.0) call erreur(26)
  78. lesfac(inim) = mlmot6.mots(inim)
  79. nomid1.lesfac(inim) = lesdua(imot)
  80. enddo
  81. segdes nomid,nomid1
  82. endif
  83. endif
  84. enddo
  85.  
  86. if (ityp.eq.' ') then
  87. ideb=1
  88. ifin=14
  89. else
  90. do ideb=1,14
  91. if(ityp.eq.nomtyp(ideb))go to 100
  92. enddo
  93. * write(ioimp,*) ' INOMID demande incompatible'
  94. stop
  95. 100 iret = lnomid (IDEB)
  96. nomid=iret
  97. segact nomid
  98. return
  99. endif
  100.  
  101. NFOR=formod(/2)
  102. CALL PLACE(formod,NFOR,ITHHY,'THERMOHYDRIQUE ')
  103. CALL PLACE(formod,NFOR,ITHER,'THERMIQUE ')
  104. CALL PLACE(formod,NFOR,IMAGN,'MAGNETODYNAMIQUE')
  105. CALL PLACE(formod,NFOR,IELEC,'ELECTROSTATIQUE ')
  106. CALL PLACE(formod,NFOR,IDIFF,'DIFFUSION ')
  107. CALL PLACE(formod,NFOR,ILIAI,'LIAISON ')
  108. CALL PLACE(formod,NFOR,ICONT,'CONTACT ')
  109. CALL PLACE(formod,NFOR,ICHGM,'CHARGEMENT ')
  110. CALL PLACE(formod,NFOR,IMETA,'METALLURGIE ')
  111. CALL PLACE(formod,NFOR,ICHPH,'CHANGEMENT_PHASE')
  112.  
  113. IF(ICHPH .NE. 0)THEN
  114. C Initialisation avec NOMID vide
  115. NBROBL=0
  116. NBRFAC=0
  117. SEGINI,NOMID
  118. SEGACT,NOMID*NOMOD
  119. DO ii=1,LNOMID(/1)
  120. LNOMID(ii)=NOMID
  121. ENDDO
  122.  
  123. MLMOT1=IMODEL.IVAMOD(1)
  124. C COMPOSANTES PRIMALES
  125. NBROBL=1
  126. NBRFAC=0
  127. SEGINI,NOMID
  128. LNOMID(1)=NOMID
  129. NOMID.LESOBL(1)=MLMOT1.MOTS(1)
  130. SEGACT,NOMID*NOMOD
  131.  
  132. C COMPOSANTES DUALES
  133. NBROBL=1
  134. NBRFAC=0
  135. SEGINI,NOMID
  136. LNOMID(2)=NOMID
  137. NOMID.LESOBL(1)=MLMOT1.MOTS(2)
  138. SEGACT,NOMID*NOMOD
  139.  
  140. C COMPOSANTES MATERIAU
  141. NBROBL=2
  142. NBRFAC=0
  143. SEGINI,NOMID
  144. LNOMID(6)=NOMID
  145. NOMID.LESOBL(1)='PRIM'
  146. NOMID.LESOBL(2)='DUAL'
  147. SEGACT,NOMID*NOMOD
  148.  
  149. C COMPOSANTES VARINTER
  150. NBROBL=1
  151. NBRFAC=0
  152. SEGINI,NOMID
  153. LNOMID(10)=NOMID
  154. NOMID.LESOBL(1)='PPHA'
  155. SEGACT,NOMID*NOMOD
  156.  
  157. RETURN
  158. ENDIF
  159.  
  160. *
  161. MELE=nefmod
  162.  
  163. C Formulation GENERALE
  164. MFR3=nummfr(mele)
  165.  
  166. C Determination de la Formulation Specifique MFR2
  167. MFR2=MFR3
  168. do jn=1,matmod(/2)
  169. if (matmod(jn).eq.'MODAL'.or.matmod(jn).eq.'STATIQUE'.or.
  170. & matmod(jn).eq.'IMPEDANCE') MFR2= infele(13)
  171. enddo
  172.  
  173. IF (ITHHY.EQ.1) MFR2=65
  174. IF (IELEC.EQ.1) MFR2=71
  175.  
  176. IF (IDIFF.EQ.1) THEN
  177. IF (MFR3.EQ.1) THEN
  178. C Cas MASSIF
  179. MFR2=73
  180. ELSEIF (MFR3.EQ.3 .OR. MFR3.EQ.5 .OR. MFR3.EQ.9 .OR.
  181. & MFR3.EQ.27) THEN
  182. C Cas COQUES ET BARRES
  183. MFR2=MFR3
  184. ELSE
  185. CALL ERREUR(21)
  186. RETURN
  187. ENDIF
  188. ENDIF
  189. *
  190. * Modele CHARGEMENT PRESSION, dans certains cas, il est necessaire
  191. * de definir les noms des composantes CARACTERISTIQUES, d'ou les
  192. * distinctions ci-apres
  193. IF (ICHGM.NE.0) THEN
  194. IF (IFOUR.EQ.-2) THEN
  195. MFR2 = MFR3
  196. ELSE
  197. IF (MFR3.EQ.1) THEN
  198. MFR2 = 72
  199. ELSEIF (MFR3.EQ.3 .OR. MFR3.EQ.7 .OR.
  200. & MFR3.EQ.9 .OR. MFR3.EQ.13) THEN
  201. MFR2 = 74
  202. ELSEIF (MFR3.EQ.5) THEN
  203. MFR2 = MFR3
  204. ELSE
  205. CALL ERREUR(21)
  206. RETURN
  207. ENDIF
  208. ENDIF
  209. ENDIF
  210. *
  211. npint3=0
  212. if(infmod(/1).ne.0) npint3=infmod(1)
  213. * write(6,*) ' inomid formod', (formod(iou),iou=1,nfor)
  214. * write(6,*) ' mele MFR2 ',mele,mfr2
  215.  
  216. DO 200 ino = ideb,ifin
  217. mocomp=0
  218. *
  219. * AIGUILLAGE SUIVANT MOT CLE
  220. GOTO ( 1, 2,3,4,5,6,7,8,9, 10,11,12,13,14) ino
  221.  
  222. C Composantes PRIMALES (DEPLACEMENT en MECANIQUE, etc...)
  223. 1 if (dcmate.and.nimcom.gt.0) then
  224. nobl = nimcom*2
  225. nfac = 0
  226. mocomp=nomid
  227. else
  228. if(icont.eq.0) then
  229. CALL IDPRIM(IMODEL,MFR2,MOCOMP,NOBL,NFAC)
  230. NOMID=MOCOMP
  231. endif
  232. endif
  233. * write(6,*) ' modepl MFR2 ' , mocomp,MFR2
  234. GOTO 120
  235.  
  236.  
  237. C Composantes DUALES (FORCES en MECANIQUE, etc...)
  238. 2 if (dcmate.and.nimcom.gt.0) then
  239. nobl = nimcom*2
  240. nfac = 0
  241. mocomp=nomid1
  242. elseif(icont.eq.0) then
  243. CALL IDDUAL(IMODEL,MFR2,MOCOMP,NOBL,NFAC)
  244. endif
  245. * write(6,*) ' moforc MFR2 ' , mocomp,MFR2
  246. GOTO 120
  247.  
  248. C Composantes GRADIENTS des grandeurs PRIMALES
  249. 3 if(ither.ne.0) then
  250. IF (MFR2.EQ.1) THEN
  251. MDM=29
  252. ELSE IF (MFR2.EQ.3.OR.MFR2.EQ.5.OR.MFR2.EQ.9) THEN
  253. MDM=39
  254. ENDIF
  255.  
  256. ELSEIF(IMAGN.NE.0)then
  257. MDM=69
  258.  
  259. ELSEIF(IDIFF.NE.0)then
  260. MDM=73
  261.  
  262. ELSE
  263. MDM=MFR2
  264. ENDIF
  265.  
  266. IF( IMETA .NE. 0) THEN
  267. NBRFAC=0
  268. NBROBL=0
  269. SEGINI NOMID
  270. MOCOMP=NOMID
  271. ENDIF
  272.  
  273. IF( icont.eq.0 .AND. ICHGM.EQ.0 .AND. IMETA.EQ.0) THEN
  274. CALL IDGRAD(MDM,IFOUR,MOCOMP,NOBL,NFAC)
  275. ENDIF
  276.  
  277. IF (IDIFF.NE.0) THEN
  278. NOMID=MOCOMP
  279. SEGACT,NOMID
  280. nomid = mocomp
  281. segact,nomid*MOD
  282. j = LONG(TYMODE(1))
  283. DO i = 1,lesobl(/2)
  284. lesobl(i)(j+1:j+2) = lesobl(i)(1:2)
  285. lesobl(i)(1:j) = TYMODE(1)(1:j)
  286. ENDDO
  287. ENDIF
  288. * write(6,*) ' mograd mfr ' , mocomp,mdm
  289. GOTO 120
  290. *
  291.  
  292. C Composantes CONTRAINTES
  293. 4 if(icont.eq.0)
  294. + CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  295. * write(6,*) ' mocont ' , mocomp
  296. if (dcmate.and.nimcom.gt.0) then
  297. nbrobl = nimcom
  298. nbrfac = nfac
  299. nomid = mocomp
  300. segadj nomid
  301. endif
  302. GOTO 120
  303. *
  304.  
  305. C Composantes DEFORMATION
  306. 5 if(icont.eq.0.AND.ICHGM.EQ.0)
  307. + CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  308. * write(6,*) ' modefo ',mocomp
  309. if (dcmate.and.nimcom.gt.0) then
  310. nbrobl = nimcom
  311. nbrfac = nfac
  312. nomid = mocomp
  313. segadj nomid
  314. endif
  315. GOTO 120
  316. *
  317.  
  318. C Composantes MATERIAU
  319. 6 IF(lumato.EQ.0) THEN
  320. CALL IDMATR(MFR2,IMODEL,MOCOMP,NOBL,NFAC)
  321. NOMID=MOCOMP
  322. ELSE
  323. C Cas de la metallurgie
  324. if( IMETA .ne. 0 ) then
  325. mlmot5 = lumato
  326. lumato = 0
  327. segact mlmot5
  328. nimcom = mlmot5.mots(/2)
  329. C On a au plus (Nb_modele*3) vars internes materiaux obl
  330. nbrobl = nimcom*3
  331. nbrfac = 0
  332. segini nomid
  333. i_obl = 1
  334. if(nimcom .GE. 1 .AND. nimcom .LT. 10 )then
  335. FMT1 = '(I1)'
  336. else
  337. INTERR(1)=nimcom
  338. INTERR(2)=10
  339. CALL ERREUR(1076)
  340. RETURN
  341. endif
  342.  
  343. do inim = 1,nimcom
  344. CALL PLACE(TYPMET,NBMET,IMOT,mlmot5.mots(inim))
  345. if (IMOT.eq.0) then
  346. MOTERR(1:4)=mlmot5.mots(inim)
  347. CALL erreur(1082)
  348. RETURN
  349. else if( imot .eq. 1) then
  350. C la formulation est LEBLOND
  351. LESOBL(i_obl) = LEBLON(1)
  352. WRITE(LESOBL(i_obl )(4:4), fmt=FMT1) inim
  353. LESOBL(i_obl+1) = LEBLON(2)
  354. WRITE(LESOBL(i_obl+1)(4:4), fmt=FMT1) inim
  355. LESOBL(i_obl+2) = LEBLON(3)
  356. WRITE(LESOBL(i_obl+2)(2:2), fmt=FMT1) inim
  357. i_obl = i_obl + 3
  358. else if( imot .eq. 2) then
  359. C la formulation est KOISTINEN
  360. LESOBL(i_obl) = KOISTI(1)
  361. WRITE(LESOBL(i_obl )(3:3), fmt=FMT1) inim
  362. LESOBL(i_obl+1) = KOISTI(2)
  363. WRITE(LESOBL(i_obl+1)(3:3), fmt=FMT1) inim
  364. i_obl = i_obl + 2
  365. endif
  366. enddo
  367. C on ajuste la taille du tableau LESOBL(nbrobl)
  368. nbrobl = i_obl
  369. segadj nomid
  370. segdes nomid
  371. mocomp=nomid
  372. else if( IMETA .eq. 0 ) then
  373. mlmots=lumato
  374. segact MLMOTS
  375. nbrobl=mots(/2)
  376. nbrfac=0
  377. IF (lumatf.NE.0) THEN
  378. mlmot1=lumatf
  379. segact mlmot1
  380. nbrfac=mlmot1.mots(/2)
  381. ENDIF
  382. SEGINI,nomid
  383. DO io=1,nbrobl
  384. lesobl(io)=mots(io)
  385. enddo
  386. segdes,mlmots
  387. if(lumatf.ne.0) then
  388. do io=1,nbrfac
  389. lesfac(io)=mlmot1.mots(io)
  390. enddo
  391. segdes,mlmot1
  392. endif
  393. mocomp=nomid
  394. endif
  395.  
  396. ENDIF
  397. * write(6,*) ' momatr ',mocomp
  398. GOTO 120
  399. *
  400.  
  401. C Composantes CARACTERISTIQUES GEOMETRIQUES
  402. 7 CONTINUE
  403. * attention pas de caracteristiques pour materiaux modal,statique,impedance
  404. * et pour formulation liaison on bidonne en appelant avec mele = 14 (cub8)
  405.  
  406. C CB215821 : FTNCHEK dit que melee sert a rien ? on le commente alors
  407. C melee=mele
  408. C do jn=1,matmod(/2)
  409. C if (matmod(jn).eq.'MODAL'.or.matmod(jn).eq.'STATIQUE'.or.
  410. C & (inatuu.ge.161.and.inatuu.le.164)) Melee=14
  411. C enddo
  412. C if(iliai .ne.0) melee=14
  413. if(icont.eq.0.AND.(ICHGM.EQ.0.OR.(ICHGM.EQ.1.AND.MFR2.EQ.5)))
  414. & THEN
  415. CALL IDCARA(IMODEL,MFR2,MOCOMP,NOBL,NFAC)
  416. endif
  417. * write(6,*) ' mocara ',mocomp
  418. GOTO 120
  419. *
  420.  
  421. C Composante TEMPERATURE
  422. 8 mocomp=0
  423. if(ither.eq.0 .AND. icont.eq.0 .AND. ICHGM.EQ.0) THEN
  424. CALL IDTEMP(MFR2,IFOUR,npint3,MOCOMP,NOBL,NFAC)
  425. endif
  426. * write(6,*) ' motemp ',mocomp
  427. GOTO 120
  428. *
  429.  
  430. C Composantes des contraintes PRINCIPALES
  431. 9 if(icont.eq.0.AND.ICHGM.EQ.0.AND.IMETA.EQ.0.AND.ITHER.EQ.0) then
  432. CALL IDPRIN(MFR2,IFOUR,MOCOMP,NOBL,NFAC)
  433. else if( IMETA .NE. 0 .OR. ITHER .NE. 0) then
  434. NOMID = IMODEL.LNOMID(3)
  435. NBRFAC=0
  436. NBROBL=0
  437. SEGINI NOMID
  438. MOCOMP=NOMID
  439. endif
  440. * write(6,*) ' moprin ',mocomp
  441. GOTO 120
  442. *
  443.  
  444. C Composantes des VARIABLES INTERNES
  445. 10 CONTINUE
  446. * if(LUVARI.EQ.0) then
  447. if(icont.eq.0.AND.ICHGM.EQ.0.AND.IMETA.EQ.0)
  448. + CALL IDVARI(MFR2,IMODEL,MOCOMP,NOBL,NFAC)
  449. * else
  450. if(luvari.ne.0) then
  451. mlmots=luvari
  452. segact MLMOTS
  453. nomid= mocomp
  454. if (nomid.ne.0) then
  455. segact nomid*mod
  456. ndej=lesobl(/2)
  457. if(ndej.eq.1) ndej=0
  458. nbrobl=mots(/2)+ndej
  459. nbrfac=0
  460. ista=ndej+1
  461. segadj nomid
  462. iau=1
  463. do io=ista,nbrobl
  464. lesobl(io)=mots(iau)
  465. iau=iau+1
  466. enddo
  467. else
  468. nbrobl=mots(/2)
  469. nbrfac=0
  470. segini nomid
  471. do io=1,nbrobl
  472. lesobl(io)=mots(io)
  473. enddo
  474. endif
  475. segdes mlmots
  476. mocomp=nomid
  477. endif
  478. * endif
  479. * write(6,*) ' movari ', mocomp
  480. GOTO 120
  481. *
  482. C Composantes des GRADIENTS de FLEXION
  483. 11 if(icont.eq.0.AND.ICHGM.EQ.0)
  484. + CALL IDGRAF(MFR2,IFOUR,MOCOMP,NOBL,NFAC)
  485. * write(6,*) ' movari ', mocomp
  486. GOTO 120
  487. *
  488.  
  489. C Composantes des DES PHASES en loi de MELANGE
  490. 12 if(icont.eq.0.AND.ICHGM.EQ.0)
  491. + CALL IDPHAS(MFR2,IMODEL,MOCOMP,NOBL,NFAC)
  492. * write(6,*) ' mophas ', mocomp
  493. GOTO 120
  494. *
  495.  
  496. C Composantes des DEFORMATIONS INELASTIQUES
  497. 13 if(icont.eq.0.AND.ICHGM.EQ.0)
  498. + CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  499. * write(6,*) ' modein ', mocomp
  500. GOTO 120
  501.  
  502. C Composantes des PARAMETRES EXTERNES (LISTMOTS)
  503. 14 MOCOMP=LUPAEX
  504. if (LUPAEX.NE.0) THEN
  505. mlmots=lupaex
  506. segact MLMOTS
  507. nbrobl=mots(/2)
  508. nbrfac=0
  509. segini nomid
  510. do io=1,nbrobl
  511. lesobl(io)=mots(io)
  512. enddo
  513. mocomp=nomid
  514. * write(6,*)' mopaex ',nomid
  515. ENDIF
  516. GOTO 120
  517. *
  518. 120 CONTINUE
  519. nomid = mocomp
  520.  
  521. lnomid(ino)=mocomp
  522. IF (nomid.NE.0) SEGDES,nomid
  523.  
  524. * if (nomid.NE.0) THEN
  525. * segact nomid
  526. * write(6,*) ' type ' , nomtyp(ino)
  527. * write(6,*) ' lesobl(/2) ', lesobl(/2)
  528. * write(6,*) (lesobl(iou),iou=1,lesobl(/2))
  529. * write(6,*) ' lesfac ' , (lesfac(iou),iou=1,lesfac(/2))
  530. * segdes,nomid
  531. * endif
  532.  
  533. C Fin du DO 200 ino=1,14
  534. 200 CONTINUE
  535.  
  536. RETURN
  537. END
  538.  
  539.  

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