Télécharger inomid.eso

Retour à la liste

Numérotation des lignes :

  1. C INOMID SOURCE AM 17/04/20 21:15:17 9407
  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.  
  32. EXTERNAL LONG
  33.  
  34. DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR','UT','RT',
  35. & 'LX','P','ALFA','BETA'/
  36. DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR','FT','MT',
  37. & 'FLX','FP','FALF','FBET'/
  38. data nomtyp/ 'DEPLACEM', 'FORCES ', 'GRADIENT', 'CONTRAIN',
  39. & 'DEFORMAT', 'MATERIAU', 'CARACTER', 'TEMPERAT',
  40. & 'PRINCIPA', 'VARINTER', 'GRAFLEXI', 'VINMETAL',
  41. & 'DEFINELA', 'PARAMEXT' /
  42.  
  43. dcmate = .false.
  44. nimcom = 0
  45. *
  46. * on suppose le sous-modele (imodel) est actif
  47. imodel = iqmod
  48. segact imodel*mod
  49. do im = 1,matmod(/2)
  50. if (matmod(im).eq.'IMPEDANCE') then
  51. dcmate = .true.
  52. if (luvari.gt.0) then
  53. mlmot5 = luvari
  54. luvari = 0
  55. mlmot6 = lumato
  56. lumato = 0
  57. segact mlmot5,mlmot6
  58. nimcom = mlmot5.mots(/2)
  59. nbrobl = nimcom
  60. nbrfac = nimcom
  61. segini nomid,nomid1
  62. do inim = 1,nimcom
  63. CALL PLACE(lesinc,ninc,IMOT,mlmot5.mots(inim))
  64. if (imot.eq.0) call erreur(26)
  65. lesobl(inim) = mlmot5.mots(inim)
  66. nomid1.lesobl(inim) = lesdua(imot)
  67. CALL PLACE(lesinc,ninc,IMOT,mlmot6.mots(inim))
  68. if (imot.eq.0) call erreur(26)
  69. lesfac(inim) = mlmot6.mots(inim)
  70. nomid1.lesfac(inim) = lesdua(imot)
  71. enddo
  72. segdes nomid,nomid1
  73. endif
  74. endif
  75. enddo
  76.  
  77. if (ityp.eq.' ') then
  78. ideb=1
  79. ifin=14
  80. else
  81. do ideb=1,14
  82. if(ityp.eq.nomtyp(ideb))go to 100
  83. enddo
  84. * write(ioimp,*) ' INOMID demande incompatible'
  85. stop
  86. 100 iret = lnomid (IDEB)
  87. nomid=iret
  88. segact nomid
  89. return
  90. endif
  91.  
  92. NFOR=formod(/2)
  93. CALL PLACE(formod,NFOR,ITHHY,'THERMOHYDRIQUE' )
  94. CALL PLACE(formod,NFOR,ITHER,'THERMIQUE' )
  95. CALL PLACE(formod,NFOR,IMAGN,'MAGNETODYNAMIQUE')
  96. CALL PLACE(formod,NFOR,IELEC,'ELECTROSTATIQUE' )
  97. CALL PLACE(formod,NFOR,IDIFF,'DIFFUSION' )
  98. CALL PLACE(formod,NFOR,ILIAI,'LIAISON' )
  99. CALL PLACE(formod,NFOR,ICONT,'CONTACT' )
  100. CALL PLACE(formod,NFOR,ICHGM,'CHARGEMENT' )
  101. *
  102. MELE=nefmod
  103.  
  104. C Formulation GENERALE
  105. MFR3=nummfr(mele)
  106.  
  107. C Determination de la Formulation Specifique MFR2
  108. MFR2=MFR3
  109. do jn=1,matmod(/2)
  110. if (matmod(jn).eq.'MODAL'.or.matmod(jn).eq.'STATIQUE'.or.
  111. & matmod(jn).eq.'IMPEDANCE') MFR2= infele(13)
  112. enddo
  113.  
  114. IF (ITHHY.EQ.1) MFR2=65
  115. IF (IELEC.EQ.1) MFR2=71
  116.  
  117. IF (IDIFF.EQ.1) THEN
  118. IF (MFR3.EQ.1) THEN
  119. C Cas MASSIF
  120. MFR2=73
  121. ELSEIF (MFR3.EQ.3 .OR. MFR3.EQ.5 .OR. MFR3.EQ.9 .OR.
  122. & MFR3.EQ.27) THEN
  123. C Cas COQUES ET BARRES
  124. MFR2=MFR3
  125. ELSE
  126. CALL ERREUR(21)
  127. RETURN
  128. ENDIF
  129. ENDIF
  130. *
  131. IF (ICHGM.NE.0) THEN
  132. IF (MFR3.EQ.1) THEN
  133. MFR2 = 72
  134. ELSEIF (MFR3.EQ.3 .OR. MFR3.EQ.5 .OR. MFR3.EQ.7 .OR.
  135. & MFR3.EQ.9 .OR. MFR3.EQ.13) THEN
  136. MFR2 = 74
  137. ELSE
  138. CALL ERREUR(21)
  139. RETURN
  140. ENDIF
  141. ENDIF
  142. *
  143. npint3=0
  144. if(infmod(/1).ne.0) npint3=infmod(1)
  145. * write(6,*) ' inomid formod', (formod(iou),iou=1,nfor)
  146. * write(6,*) ' mele MFR2 ',mele,mfr2
  147.  
  148. DO 200 ino = ideb,ifin
  149. mocomp=0
  150. *
  151. * AIGUILLAGE SUIVANT MOT CLE
  152. GOTO ( 1, 2,3,4,5,6,7,8,9, 10,11,12,13,14) ino
  153.  
  154. C Composantes PRIMALES (DEPLACEMENT en MECANIQUE, etc...)
  155. 1 if (dcmate.and.nimcom.gt.0) then
  156. nobl = nimcom*2
  157. nfac = 0
  158. mocomp=nomid
  159. else
  160. if(icont.eq.0) then
  161. CALL IDPRIM(IMODEL,MFR2,MOCOMP,NOBL,NFAC)
  162. NOMID=MOCOMP
  163. endif
  164. endif
  165. * write(6,*) ' modepl MFR2 ' , mocomp,MFR2
  166. GOTO 120
  167.  
  168.  
  169. C Composantes DUALES (FORCES en MECANIQUE, etc...)
  170. 2 if (dcmate.and.nimcom.gt.0) then
  171. nobl = nimcom*2
  172. nfac = 0
  173. mocomp=nomid1
  174. elseif(icont.eq.0) then
  175. CALL IDDUAL(IMODEL,MFR2,MOCOMP,NOBL,NFAC)
  176. endif
  177. * write(6,*) ' moforc MFR2 ' , mocomp,MFR2
  178. GOTO 120
  179.  
  180. C Composantes GRADIENTS des grandeurs PRIMALES
  181. 3 if(ither.ne.0) then
  182. IF (MFR2.EQ.1) THEN
  183. MDM=29
  184. ELSE IF (MFR2.EQ.3.OR.MFR2.EQ.5.OR.MFR2.EQ.9) THEN
  185. MDM=39
  186. ENDIF
  187.  
  188. ELSEIF(IMAGN.NE.0)then
  189. MDM=69
  190.  
  191. ELSEIF(IDIFF.NE.0)then
  192. MDM=73
  193.  
  194. ELSE
  195. MDM=MFR2
  196. ENDIF
  197.  
  198. IF( icont.eq.0.AND.ICHGM.EQ.0)
  199. + CALL IDGRAD(MDM,IFOUR,MOCOMP,NOBL,NFAC)
  200. IF (IDIFF.NE.0) THEN
  201. NOMID=MOCOMP
  202. SEGACT,NOMID
  203. nomid = mocomp
  204. segact,nomid*MOD
  205. j = LONG(TYMODE(1))
  206. DO i = 1,lesobl(/2)
  207. lesobl(i)(j+1:j+2) = lesobl(i)(1:2)
  208. lesobl(i)(1:j) = TYMODE(1)(1:j)
  209. ENDDO
  210. ENDIF
  211. * write(6,*) ' mograd mfr ' , mocomp,mdm
  212. GOTO 120
  213. *
  214.  
  215. C Composantes CONTRAINTES
  216. 4 if(icont.eq.0)
  217. + CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  218. * write(6,*) ' mocont ' , mocomp
  219. if (dcmate.and.nimcom.gt.0) then
  220. nbrobl = nimcom
  221. nbrfac = nfac
  222. nomid = mocomp
  223. segadj nomid
  224. endif
  225. GOTO 120
  226. *
  227.  
  228. C Composantes DEFORMATION
  229. 5 if(icont.eq.0.AND.ICHGM.EQ.0)
  230. + CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  231. * write(6,*) ' modefo ',mocomp
  232. if (dcmate.and.nimcom.gt.0) then
  233. nbrobl = nimcom
  234. nbrfac = nfac
  235. nomid = mocomp
  236. segadj nomid
  237. endif
  238. GOTO 120
  239. *
  240.  
  241. C Composantes MATERIAU
  242. 6 IF(lumato.EQ.0) THEN
  243. CALL IDMATR(MFR2,IMODEL,MOCOMP,NOBL,NFAC)
  244. NOMID=MOCOMP
  245.  
  246. ELSE
  247. mlmots=lumato
  248. segact MLMOTS
  249. nbrobl=mots(/2)
  250. nbrfac=0
  251. IF (lumatf.NE.0) THEN
  252. mlmot1=lumatf
  253. segact mlmot1
  254. nbrfac=mlmot1.mots(/2)
  255. ENDIF
  256. SEGINI,nomid
  257. DO io=1,nbrobl
  258. lesobl(io)=mots(io)
  259. enddo
  260. segdes,mlmots
  261. if(lumatf.ne.0) then
  262. do io=1,nbrfac
  263. lesfac(io)=mlmot1.mots(io)
  264. enddo
  265. segdes,mlmot1
  266. endif
  267. mocomp=nomid
  268. ENDIF
  269. * write(6,*) ' momatr ',mocomp
  270. GOTO 120
  271. *
  272.  
  273. C Composantes CARACTERISTIQUES GEOMETRIQUES
  274. 7 CONTINUE
  275. * attention pas de caracteristiques pour materiaux modal,statique,impedance
  276. * et pour formulation liaison on bidonne en appelant avec mele = 14 (cub8)
  277. melee=mele
  278. do jn=1,matmod(/2)
  279. if (matmod(jn).eq.'MODAL'.or.matmod(jn).eq.'STATIQUE'.or.
  280. & (inatuu.ge.161.and.inatuu.le.164)) Melee=14
  281. enddo
  282. if(iliai .ne.0) melee=14
  283. if(icont.eq.0.AND.ICHGM.EQ.0) THEN
  284. CALL IDCARA(IMODEL,MFR2,MOCOMP,NOBL,NFAC)
  285. endif
  286. * write(6,*) ' mocara ',mocomp
  287. GOTO 120
  288. *
  289.  
  290. C Composante TEMPERATURE
  291. 8 mocomp=0
  292. if((ither.eq.0.and.icont.eq.0).AND.
  293. $ (ITHER.EQ.0.AND.ICHGM.EQ.0))
  294. $ CALL IDTEMP(MFR2,IFOUR,npint3,MOCOMP,NOBL,NFAC)
  295. * write(6,*) ' motemp ',mocomp
  296. GOTO 120
  297. *
  298.  
  299. C Composantes des contraintes PRINCIPALES
  300. 9 if(icont.eq.0.AND.ICHGM.EQ.0)
  301. + CALL IDPRIN(MFR2,IFOUR,MOCOMP,NOBL,NFAC)
  302. * write(6,*) ' moprin ',mocomp
  303. GOTO 120
  304. *
  305.  
  306. C Composantes des VARIABLES INTERNES
  307. 10 CONTINUE
  308. * if(LUVARI.EQ.0) then
  309. if(icont.eq.0.AND.ICHGM.EQ.0)
  310. + CALL IDVARI(MFR2,IMODEL,MOCOMP,NOBL,NFAC)
  311. * else
  312. if(luvari.ne.0) then
  313. mlmots=luvari
  314. segact MLMOTS
  315. nomid= mocomp
  316. if (nomid.ne.0) then
  317. segact nomid*mod
  318. ndej=lesobl(/2)
  319. if(ndej.eq.1) ndej=0
  320. nbrobl=mots(/2)+ndej
  321. nbrfac=0
  322. ista=ndej+1
  323. segadj nomid
  324. iau=1
  325. do io=ista,nbrobl
  326. lesobl(io)=mots(iau)
  327. iau=iau+1
  328. enddo
  329. else
  330. nbrobl=mots(/2)
  331. nbrfac=0
  332. segini nomid
  333. do io=1,nbrobl
  334. lesobl(io)=mots(io)
  335. enddo
  336. endif
  337. segdes mlmots
  338. mocomp=nomid
  339. endif
  340. * endif
  341. * write(6,*) ' movari ', mocomp
  342. GOTO 120
  343. *
  344. C Composantes des GRADIENTS de FLEXION
  345. 11 if(icont.eq.0.AND.ICHGM.EQ.0)
  346. + CALL IDGRAF(MFR2,IFOUR,MOCOMP,NOBL,NFAC)
  347. * write(6,*) ' movari ', mocomp
  348. GOTO 120
  349. *
  350.  
  351. C Composantes des DES PHASES en loi de MELANGE
  352. 12 if(icont.eq.0.AND.ICHGM.EQ.0)
  353. + CALL IDPHAS(MFR2,IMODEL,MOCOMP,NOBL,NFAC)
  354. * write(6,*) ' mophas ', mocomp
  355. GOTO 120
  356. *
  357.  
  358. C Composantes des DEFORMATIONS INELASTIQUES
  359. 13 if(icont.eq.0.AND.ICHGM.EQ.0)
  360. + CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  361. * write(6,*) ' modein ', mocomp
  362. GOTO 120
  363.  
  364. C Composantes des PARAMETRES EXTERNES (LISTMOTS)
  365. 14 MOCOMP=LUPAEX
  366. if (LUPAEX.NE.0) THEN
  367. mlmots=lupaex
  368. segact MLMOTS
  369. nbrobl=mots(/2)
  370. nbrfac=0
  371. segini nomid
  372. do io=1,nbrobl
  373. lesobl(io)=mots(io)
  374. enddo
  375. mocomp=nomid
  376. * write(6,*)' mopaex ',nomid
  377. ENDIF
  378. GOTO 120
  379. *
  380. 120 CONTINUE
  381. nomid = mocomp
  382.  
  383. lnomid(ino)=mocomp
  384. IF (nomid.NE.0) SEGDES,nomid
  385.  
  386. * if (nomid.NE.0) THEN
  387. * segact nomid
  388. * write(6,*) ' type ' , nomtyp(ino)
  389. * write(6,*) ' lesobl(/2) ', lesobl(/2)
  390. * write(6,*) (lesobl(iou),iou=1,lesobl(/2))
  391. * write(6,*) ' lesfac ' , (lesfac(iou),iou=1,lesfac(/2))
  392. * segdes,nomid
  393. * endif
  394.  
  395. C Fin du DO 200 ino=1,14
  396. 200 CONTINUE
  397.  
  398. RETURN
  399. END
  400.  
  401.  
  402.  
  403.  

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