Télécharger fefp1.eso

Retour à la liste

Numérotation des lignes :

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

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