Télécharger fefp1.eso

Retour à la liste

Numérotation des lignes :

  1. C FEFP1 SOURCE PV 17/09/29 21:15:11 9578
  2.  
  3. SUBROUTINE FEFP1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCAR,
  4. . IPCHE7,IPCHE8,IPCHE9,IPRIGI,
  5. . PRECIS,NITMAX,NUPDATE)
  6. *************************************************************************
  7. * entrees:
  8. * ipmodl = pointeur sur un objet mmodel
  9. * ipche1 = pointeur sur un mchaml de deformations
  10. * ipche2 = pointeur sur un mchaml de variables internes initiales
  11. * ipche3 = pointeur sur un mchaml de deplacements entre depart et arrivee
  12. * ipcar = pointeur sur un mchaml de caracteristiques
  13. * precis = precision des iterations internes
  14. * nitmax = maximum number of iterations at local level
  15. * nupdate = total (0) / update (1) lagrangian formulation
  16. * sorties:
  17. * ipche7 = pointeur sur un mchaml de contraintes
  18. * ipche8 = pointeur sur un mchaml de variables internes
  19. * ipche9 = pointeur sur un mchaml de deformations
  20. * iprigi = pointeur sur l'objet de type rigidite
  21. *************************************************************************
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCGEOME
  29. -INC SMCHAML
  30. -INC SMCOORD
  31. -INC SMELEME
  32. -INC SMINTE
  33. -INC SMMODEL
  34. -INC SMRIGID
  35. SEGMENT NOTYPE
  36. CHARACTER*16 TYPE(NBTYPE)
  37. ENDSEGMENT
  38. SEGMENT MPTVAL
  39. INTEGER IPOS(NS), NSOF(NS), IVAL(NCOSOU)
  40. CHARACTER*16 TYVAL(NCOSOU)
  41. ENDSEGMENT
  42. CHARACTER*8 CMATE
  43. CHARACTER*(NCONCH) CONM
  44. PARAMETER (NINF=3)
  45. INTEGER INFOS(NINF)
  46. LOGICAL lsupfo,lsupva,lsupdp,lsupma,lsupco,lsupdd
  47.  
  48. ************************
  49. * Activar el modelo
  50. ************************
  51. MMODEL=IPMODL
  52. SEGACT MMODEL
  53. c Usa N1
  54. NSOUS=MMODEL.KMODEL(/1)
  55.  
  56. ************************
  57. * Creation de los 3 mchelms de salida
  58. ************************
  59. N1=NSOUS
  60. L1=11
  61. N3=6
  62. SEGINI MCHELM
  63. c Usa L1, N1, N3
  64. MCHELM.TITCHE='CONTRAINTES'
  65. MCHELM.IFOCHE=IFOUR
  66. IPCHE7=MCHELM
  67. L1=18
  68. SEGINI MCHEL1
  69. MCHEL1.TITCHE='VARIABLES INTERNES'
  70. MCHEL1.IFOCHE=IFOUR
  71. IPCHE8=MCHEL1
  72. L1=25
  73. SEGINI MCHEL2
  74. MCHEL2.TITCHE='DEFORMATIONS INELASTIQUES'
  75. MCHEL2.IFOCHE=IFOUR
  76. IPCHE9=MCHEL2
  77.  
  78. ************************
  79. * Creacion del objeto rigidite
  80. ************************
  81. NRIGE =7
  82. NRIGEL=NSOUS
  83. SEGINI MRIGID
  84. c Usa NRIGE, NRIGEL
  85. MRIGID.MTYMAT = 'RIGIDITE'
  86. MRIGID.ICHOLE=0
  87. MRIGID.IMGEO1=0
  88. MRIGID.IMGEO2=0
  89. MRIGID.IFORIG=IFOUR
  90. DO ISOUS=1,NSOUS
  91. MRIGID.COERIG(ISOUS)=1.D0
  92. MRIGID.IRIGEL(4,ISOUS)=0
  93. ENDDO
  94. IPRIGI=MRIGID
  95.  
  96. c*****************************************************************
  97. c INICIO bucle sobre zonas
  98. c*****************************************************************
  99. DO 1000 ISOUS=1,NSOUS
  100. c*****************************************************************
  101.  
  102. ************************
  103. * Recuperar la informacion general de la zona
  104. ************************
  105. c Activa el modelo de la zona
  106. IMODEL=KMODEL(ISOUS)
  107. SEGACT IMODEL
  108. c Usa MN3, NFOR, NMAT
  109. MELE =IMODEL.NEFMOD
  110. MELEME=IMODEL.IMAMOD
  111. c malla
  112. CONM =IMODEL.CONMOD
  113. c nombre del componente (blanco por defecto)
  114.  
  115. c Activa la malla
  116. SEGACT MELEME
  117. c Usa NBNN,NBELEM,NBSOUS,NBREF
  118. NBNN =MELEME.NUM(/1)
  119. NBELEM=MELEME.NUM(/2)
  120.  
  121. c Tipo de material
  122. NFOR =IMODEL.FORMOD(/2)
  123. c tamanyo nombre formulacion
  124. NMAT =IMODEL.MATMOD(/2)
  125. c tamanyo nombre material
  126. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INPLAS)
  127. c entra: FORMOD,NFOR,MATMOD,NMAT
  128. c sale : CMATE,MATE,INPLAS
  129.  
  130. * Controla que sea material de trabajo:
  131. * VMT_FEFP, RHMC_FEFP, POWDERCAP_FEFP,POWDER_FEFP
  132. IF ((INPLAS.ne.114).and.(INPLAS.ne.115).and.
  133. . (INPLAS.ne.116).and.(INPLAS.ne.117)) then
  134. write(*,*) ' Material no disponible',inplas
  135. ENDIF
  136.  
  137. ************************
  138. * informacion de elementos finitos
  139. ************************
  140. * activa un segmento q se llama luego INFO, q tiene INFELE
  141. * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  142. c entra: MELE,IMODEL
  143. c sale : IPINF
  144. * INFO =IPINF
  145. * MELE =INFO.INFELE(1)
  146. MELE =INFELE(1)
  147. c numero de elemento finito
  148. * NBGS =INFO.INFELE(4)
  149. NBGS =INFELE(4)
  150. c num de puntos de integracion para sigma
  151. * NBG =INFO.INFELE(6)
  152. NBG =INFELE(6)
  153. c num de puntos de integracion para rigidite
  154. * IPORE=INFO.INFELE(8)
  155. IPORE=INFELE(8)
  156. c nombre funciones de forma
  157. * LRE =INFO.INFELE(9)
  158. LRE =INFELE(9)
  159. c grados libertad en rigidite
  160. * LHOOK=INFO.INFELE(10)
  161. LHOOK=INFELE(10)
  162. c tamaño matriz de hook
  163. * MINTE=INFO.INFELE(11)
  164. minte=infmod(7)
  165. c segmento de integracion
  166. * MFR =INFO.INFELE(13)
  167. MFR =INFELE(13)
  168. c formulacion de los elementos
  169. * NDDL =INFO.INFELE(15)
  170. NDDL =INFELE(15)
  171. c numero maximo de grados de libertad por nodo
  172. * NSTRS=INFO.INFELE(16)
  173. NSTRS=INFELE(16)
  174. c componentes de sigma y defor
  175.  
  176. * Controla que sean elementos masivos
  177. IF ((MFR.lt.1).or.(MFR.gt.1)) then
  178. write(*,*) ' Tipo de elemento no disponible'
  179. ENDIF
  180.  
  181. ************************
  182. * Llena informacion base en los 3 campos de salida
  183. ************************
  184. MCHELM.IMACHE(ISOUS)=MELEME
  185. MCHELM.CONCHE(ISOUS)=CONM
  186. MCHEL1.IMACHE(ISOUS)=MELEME
  187. MCHEL1.CONCHE(ISOUS)=CONM
  188. MCHEL2.IMACHE(ISOUS)=MELEME
  189. MCHEL2.CONCHE(ISOUS)=CONM
  190. MCHELM.INFCHE(ISOUS,1)=0
  191. MCHELM.INFCHE(ISOUS,2)=0
  192. MCHELM.INFCHE(ISOUS,3)=NIFOUR
  193. MCHELM.INFCHE(ISOUS,4)=MINTE
  194. MCHELM.INFCHE(ISOUS,5)=0
  195. MCHELM.INFCHE(ISOUS,6)=5
  196. MCHEL1.INFCHE(ISOUS,1)=0
  197. MCHEL1.INFCHE(ISOUS,2)=0
  198. MCHEL1.INFCHE(ISOUS,3)=NIFOUR
  199. MCHEL1.INFCHE(ISOUS,4)=MINTE
  200. MCHEL1.INFCHE(ISOUS,5)=0
  201. MCHEL1.INFCHE(ISOUS,6)=5
  202. MCHEL2.INFCHE(ISOUS,1)=0
  203. MCHEL2.INFCHE(ISOUS,2)=0
  204. MCHEL2.INFCHE(ISOUS,3)=NIFOUR
  205. MCHEL2.INFCHE(ISOUS,4)=MINTE
  206. MCHEL2.INFCHE(ISOUS,5)=0
  207. MCHEL2.INFCHE(ISOUS,6)=5
  208.  
  209. ************************
  210. * Llena informacion base de la rigidite
  211. ************************
  212. * Activa segmento MINTE
  213. NBNO =NBNN
  214. SEGACT MINTE
  215. c Usa NBPGAU,NBNO
  216. NBPGAU=MINTE.POIGAU(/1)
  217. * Inicializa segmento descr, descripcion incognitas matriz rigidite
  218. NLIGRP=LRE
  219. NLIGRD=LRE
  220. SEGINI DESCR
  221. c Usa NLIGRP,NLGRD
  222. IPDESCR=DESCR
  223. if(lnomid(1).ne.0) then
  224. nomid=lnomid(1)
  225. segact nomid
  226. modepl=nomid
  227. ndepl=lesobl(/2)
  228. ndum=lesfac(/2)
  229. lsupdp=.false.
  230. else
  231. lsupdp=.true.
  232. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  233. endif
  234. c entra: MFR,IFOUR
  235. c sale : MODEPL (nombres comp. despl),NDEPL (numero obli),NDUM (n. opta)
  236. if(lnomid(2).ne.0) then
  237. nomid=lnomid(2)
  238. segact nomid
  239. moforc=nomid
  240. nforc=lesobl(/2)
  241. lsupfo=.false.
  242. else
  243. CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  244. lsupfo=.true.
  245. endif
  246. c entra: MFR,IFOUR
  247. c sale : MOFORC (nombres comp. fuerz),NFORC (numero obli),NDUM (n. opta)
  248. * Llena el segmento descr con los nombres de las incognitas
  249. IDDL=1
  250. NCOMP =NDEPL
  251. NBNNS =NBNN
  252. NOMID =MODEPL
  253. SEGACT NOMID
  254. NOMID =MOFORC
  255. SEGACT NOMID
  256. * write(6,*)'nbnns ncomp nligrp nligrd',nbnns,ncomp,nligrp,nligrd
  257. DO INOEUD=1,NBNNS
  258. DO ICOMP=1,NCOMP
  259. NOMID=MODEPL
  260. DESCR.LISINC(IDDL)=LESOBL(ICOMP)
  261. NOMID=MOFORC
  262. DESCR.LISDUA(IDDL)=LESOBL(ICOMP)
  263. NOELEP(IDDL)=INOEUD
  264. NOELED(IDDL)=INOEUD
  265. IDDL=IDDL+1
  266. ENDDO
  267. ENDDO
  268. NOMID =MODEPL
  269. SEGDES NOMID
  270. NOMID =MOFORC
  271. SEGDES NOMID
  272. * Inicializa segment xmatri, le segment
  273. * contenant les matrices de rigidite elementaires
  274. NELRIG =NBELEM
  275. SEGINI xMATRI
  276. c usa NELRIG
  277. * Trata la rigidite
  278. MRIGID.IRIGEL(1,ISOUS)=MELEME
  279. MRIGID.IRIGEL(2,ISOUS)=0
  280. MRIGID.IRIGEL(3,ISOUS)=IPDESCR
  281. MRIGID.IRIGEL(4,ISOUS)=xMATRI
  282. MRIGID.IRIGEL(5,ISOUS)=NIFOUR
  283. MRIGID.IRIGEL(6,ISOUS)=0
  284. c no simetricas = 2, simetricas = 0
  285. IRIGE7=0
  286. c con friccion tiene que usarse simetrizadas...
  287. c queda pendiente de arreglar
  288. if (INPLAS.eq.116.or.INPLAS.eq.117) IRIGE7=2
  289. MRIGID.IRIGEL(7,ISOUS)=IRIGE7
  290. xmatri.symre=irige7
  291. ************************
  292. * tratamiento de los 4 campos dados
  293. ************************
  294. c DUDAS ESTE TROZO
  295. c creation du tableau infos: no se para q, pero evita error en komcha
  296. c nbno, no se pq!
  297. NBNO=NBNNE(NUMGEO(MELE))
  298. c aqui se miraba que las tensiones y las var int ini fuesen compatibles ??
  299. c ahora no hay campo de tensiones iniciales pero si campo de def plasticas
  300. c se ha de hacer eso igualmente????. => Si no se hace da un error en comcha !
  301. CALL IDENT(MELEME,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  302. c entra:
  303. c meleme = puntero zona considerada
  304. c conm = nombre del constituyente?
  305. c ipche1 y ipche2 = puntero campos
  306. c sale
  307. c INFOS = tabla de infche para komcha
  308. c IRTD = 0 si no son compatibles
  309. c IF (IRTD.EQ.0)THEN
  310. c write(*,*)' no compatibles'
  311. c SEGDES IMODEL*NOMOD,MMODEL*NOMOD
  312. c SEGSUP MCHELM,MCHEL1,MCHEL2
  313. c INFO=IPINF
  314. c SEGSUP INFO
  315. c RETURN
  316. c ENDIF
  317. c DUDAS ESTE TROZO
  318. **********************************************
  319. c tipo de variables de trabajo
  320. NBTYPE =1
  321. SEGINI NOTYPE
  322. NOTYPE.TYPE(1)='REAL*8'
  323. ********************************************** IPCHE1 => IVADPI
  324. * deformaciones plasticas iniciales
  325. if(lnomid(13).ne.0) then
  326. nomid=lnomid(13)
  327. segact nomid
  328. modein=nomid
  329. ndef=lesobl(/2)
  330. nfac=lesfac(/2)
  331. lsupdd=.false.
  332. else
  333. lsupdd=.true.
  334. CALL IDDEIN(IMODEL,IFOUR,MODEIN,NDEF,NFAC)
  335. endif
  336.  
  337. CALL KOMCHA(IPCHE1,MELEME,CONM,MODEIN,NOTYPE,1,INFOS,3,IVADPI)
  338. ********************************************** IPCHE2 => IVARI
  339. * variables internes
  340. if(lnomid(10).ne.0) then
  341. nomid=lnomid(10)
  342. segact nomid
  343. movari=nomid
  344. nvari=lesobl(/2)
  345. nvarf=lesfac(/2)
  346. lsupva=.false.
  347. else
  348. lsupva=.true.
  349. CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  350. endif
  351. CALL KOMCHA(IPCHE2,MELEME,CONM,MOVARI,NOTYPE,1,INFOS,3,IVARI)
  352. NVART=NVARI+NVARF
  353. ********************************************** IPCHE3 => IVADESP
  354. * campo de desplazamientos
  355. if(lnomid(1).ne.0) then
  356. nomid=lnomid(1)
  357. segact nomid
  358. modepl=nomid
  359. ndep=lesobl(/2)
  360. nfac=lesfac(/2)
  361. lsupdp=.false.
  362. else
  363. lsupdp=.true.
  364. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEP,NFAC)
  365. endif
  366. CALL KOMCHA(IPCHE3,MELEME,CONM,MODEPL,NOTYPE,1,INFOS,3,IVADESP)
  367. ********************************************** IPMODL => IVAMAT
  368. * caracteristiques materielles
  369. if(lnomid(6).ne.0) then
  370. nomid=lnomid(6)
  371. segact nomid
  372. momatr=nomid
  373. nmatr=lesobl(/2)
  374. nmatf=lesfac(/2)
  375. lsupma=.false.
  376. else
  377. lsupma=.true.
  378. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  379. endif
  380. CALL KOMCHA(IPCAR,MELEME,CONM,MOMATR,NOTYPE,1,INFOS,3,IVAMAT)
  381. NMATT=NMATR+NMATF
  382. SEGSUP NOTYPE
  383. ********************************************** IPCAR => no hay...
  384. * caracteristiques geometriques
  385.  
  386. **********************************************
  387. * Creacion de los mchamls de las zonas
  388. **********************************************
  389. NBPTEL=NBGS
  390. NEL =NBELEM
  391. N1PTEL=NBPTEL
  392. N1EL =NEL
  393. *********************************
  394. * tensiones
  395. *********************************
  396. if(lnomid(4).ne.0) then
  397. nomid=lnomid(4)
  398. segact nomid
  399. mostrs=nomid
  400. nstrs=lesobl(/2)
  401. nfac=lesfac(/2)
  402. lsupco=.false.
  403. else
  404. lsupco=.true.
  405. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTRS,NFAC)
  406. endif
  407. c entra: IMODEL,IFOUR
  408. c sale : MOSTRS,NSTRS,NFAC
  409. N2 =NSTRS
  410. SEGINI MCHAML
  411. c usa N2
  412. MCHELM.ICHAML(ISOUS)=MCHAML
  413. NS =1
  414. NCOSOU=NSTRS
  415. SEGINI MPTVAL
  416. c usa NS, NCOSOU
  417. IVASTF=MPTVAL
  418. NOMID =MOSTRS
  419. SEGACT NOMID
  420. c usa NBROBL, NBRFAC
  421. DO ICOMP=1,NSTRS
  422. MCHAML.NOMCHE(ICOMP)=NOMID.LESOBL(ICOMP)
  423. MCHAML.TYPCHE(ICOMP)='REAL*8'
  424. N2PTEL=0
  425. N2EL =0
  426. SEGINI MELVAL
  427. c usa N1PTEL, N1EL, N2PTEL, N2EL
  428. MCHAML.IELVAL(ICOMP)=MELVAL
  429. IVAL(ICOMP)=MELVAL
  430. enddo
  431. SEGDES NOMID
  432. *********************************
  433. * variables internes
  434. N2 =NVART
  435. SEGINI MCHAM1
  436. MCHEL1.ICHAML(ISOUS)=MCHAM1
  437. NS =1
  438. NCOSOU=NVART
  439. SEGINI MPTVAL
  440. IVARIF=MPTVAL
  441. NOMID =MOVARI
  442. SEGACT NOMID
  443. DO ICOMP=1,NVARI
  444. MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
  445. MCHAM1.TYPCHE(ICOMP)='REAL*8'
  446. N2PTEL=0
  447. N2EL =0
  448. SEGINI MELVAL
  449. MCHAM1.IELVAL(ICOMP)=MELVAL
  450. IVAL(ICOMP)=MELVAL
  451. enddo
  452. if (nvari.lt.nvart) then
  453. DO ICOMP=NVARI+1,NVART
  454. MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP)
  455. MCHAM1.TYPCHE(ICOMP)='REAL*8'
  456. N2PTEL=0
  457. N2EL =0
  458. SEGINI MELVAL
  459. MCHAM1.IELVAL(ICOMP)=MELVAL
  460. IVAL(ICOMP)=MELVAL
  461. enddo
  462. endif
  463. SEGDES NOMID
  464. *********************************
  465. * deformations inelastiques
  466. N1PTEL=NBPTEL
  467. N1EL =NEL
  468. N2 =NDEF
  469. SEGINI MCHAM2
  470. MCHEL2.ICHAML(ISOUS)=MCHAM2
  471. NS =1
  472. NCOSOU=NDEF
  473. SEGINI MPTVAL
  474. IVADPF=MPTVAL
  475. NOMID =MODEIN
  476. SEGACT NOMID
  477. DO ICOMP=1,NDEF
  478. MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP)
  479. MCHAM2.TYPCHE(ICOMP)='REAL*8'
  480. N2PTEL=0
  481. N2EL =0
  482. SEGINI MELVAL
  483. MCHAM2.IELVAL(ICOMP)=MELVAL
  484. IVAL(ICOMP)=MELVAL
  485. enddo
  486. SEGDES NOMID
  487. ******************************************************************
  488. KERRE=0
  489. CALL FEFP2(MATE,INPLAS,MELE,MELEME,MINTE,xMATRI,
  490. . NBELEM,NBPTEL,NBNN,LRE,MFR,
  491. . IVADESP,IVADPI,IVARI,IVAMAT,
  492. . IVASTF,IVARIF,IVADPF,LHOOK,IRIGE7,
  493. . NDEP,NDEF,NSTRS,NVART,NMATT,PRECIS,NITMAX,
  494. . NUPDATE,KERRE)
  495.  
  496. ******************************************************************
  497. * Desactivar segmentos
  498. c desactiva malla y modelo de la zona (*NOMOD?)
  499. SEGDES MELEME
  500. SEGDES IMODEL
  501. c desactiva las entradas
  502. CALL DTMVAL (IVADPI ,1)
  503. CALL DTMVAL (IVARI ,1)
  504. CALL DTMVAL (IVADESP,1)
  505. CALL DTMVAL (IVAMAT ,1)
  506. c desactiva/elimina las salidas
  507. CALL DTMVAL (IVASTF ,1)
  508. CALL DTMVAL (IVARIF ,1)
  509. CALL DTMVAL (IVADPF ,1)
  510. SEGDES MCHAML,MCHAM1,MCHAM2,MINTE,xMATRI,DESCR
  511. IF (KERRE.NE.0) THEN
  512. CALL DTMVAL (IVASTF,3)
  513. CALL DTMVAL (IVARIF,3)
  514. CALL DTMVAL (IVADPF,3)
  515. SEGSUP MCHAML,MCHAM1,MCHAM2,MINTE,xMATRI,DESCR
  516. GO TO 888
  517. END IF
  518. c elimina auxiliares
  519. NOMID=MODEPL
  520. IF (MODEPL.NE.0.and.lsupdp) SEGSUP NOMID
  521. NOMID=MOFORC
  522. IF (lsupfo.and.MOFORC.NE.0) SEGSUP NOMID
  523. NOMID=MOSTRS
  524. IF (MOSTRS.NE.0.and.lsupco) SEGSUP NOMID
  525. NOMID=MOVARI
  526. IF (lsupva.and.MOVARI.NE.0) SEGSUP NOMID
  527. NOMID=MODEIN
  528. IF (MODEIN.NE.0.and.lsupdd) SEGSUP NOMID
  529. NOMID=MOMATR
  530. IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID
  531. * INFO=IPINF
  532. * IF (IPINF .NE.0) SEGSUP INFO
  533. c*****************************************************************
  534. c FIN bucle sobre zonas
  535. 1000 continue
  536. c*****************************************************************
  537. 888 CONTINUE
  538.  
  539. c desactiva el modelo
  540. SEGDES MMODEL
  541. c desactiva/elimina las salidas
  542. SEGDES MCHELM,MCHEL1,MCHEL2,MRIGID
  543. IF(KERRE.NE.0) SEGSUP MCHELM,MCHEL1,MCHEL2,MRIGID
  544.  
  545. RETURN
  546. END
  547.  
  548.  
  549.  
  550.  
  551.  
  552.  
  553.  
  554.  
  555.  
  556.  

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