Télécharger fefp1.eso

Retour à la liste

Numérotation des lignes :

fefp1
  1. C FEFP1 SOURCE PV090527 26/04/30 21:15:32 12529
  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 PPARAM
  26. -INC CCOPTIO
  27. -INC CCGEOME
  28.  
  29. -INC SMCHAML
  30. -INC SMCOORD
  31. -INC SMELEME
  32. -INC SMINTE
  33. -INC SMMODEL
  34. -INC SMRIGID
  35.  
  36. -INC TMPTVAL
  37.  
  38. SEGMENT NOTYPE
  39. CHARACTER*16 TYPE(NBTYPE)
  40. ENDSEGMENT
  41.  
  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. NOMID =MOFORC
  270. * Inicializa segment xmatri, le segment
  271. * contenant les matrices de rigidite elementaires
  272. NELRIG =NBELEM
  273. RIGREL=0
  274. SEGINI xMATRI
  275. c usa NELRIG
  276. * Trata la rigidite
  277. MRIGID.IRIGEL(1,ISOUS)=MELEME
  278. MRIGID.IRIGEL(2,ISOUS)=0
  279. MRIGID.IRIGEL(3,ISOUS)=IPDESCR
  280. * passer en ro
  281. segact descr
  282. MRIGID.IRIGEL(4,ISOUS)=xMATRI
  283. MRIGID.IRIGEL(5,ISOUS)=NIFOUR
  284. MRIGID.IRIGEL(6,ISOUS)=0
  285. c no simetricas = 2, simetricas = 0
  286. IRIGE7=0
  287. c con friccion tiene que usarse simetrizadas...
  288. c queda pendiente de arreglar
  289. if (INPLAS.eq.116.or.INPLAS.eq.117) IRIGE7=2
  290. MRIGID.IRIGEL(7,ISOUS)=IRIGE7
  291. xmatri.symre=irige7
  292. ************************
  293. * tratamiento de los 4 campos dados
  294. ************************
  295. c DUDAS ESTE TROZO
  296. c creation du tableau infos: no se para q, pero evita error en komcha
  297. c nbno, no se pq!
  298. NBNO=NBNNE(NUMGEO(MELE))
  299. c aqui se miraba que las tensiones y las var int ini fuesen compatibles ??
  300. c ahora no hay campo de tensiones iniciales pero si campo de def plasticas
  301. c se ha de hacer eso igualmente????. => Si no se hace da un error en comcha !
  302. CALL IDENT(MELEME,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  303. c entra:
  304. c meleme = puntero zona considerada
  305. c conm = nombre del constituyente?
  306. c ipche1 y ipche2 = puntero campos
  307. c sale
  308. c INFOS = tabla de infche para komcha
  309. c IRTD = 0 si no son compatibles
  310. c IF (IRTD.EQ.0)THEN
  311. c write(*,*)' no compatibles'
  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. NSR =1
  414. NCOSOR=NSTRS
  415. SEGINI MPTVAL
  416. c usa NSR, NCOSOR
  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. *********************************
  432. * variables internes
  433. N2 =NVART
  434. SEGINI MCHAM1
  435. MCHEL1.ICHAML(ISOUS)=MCHAM1
  436. NSR =1
  437. NCOSOR=NVART
  438. SEGINI MPTVAL
  439. IVARIF=MPTVAL
  440. NOMID =MOVARI
  441. SEGACT NOMID
  442. DO ICOMP=1,NVARI
  443. MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
  444. MCHAM1.TYPCHE(ICOMP)='REAL*8'
  445. N2PTEL=0
  446. N2EL =0
  447. SEGINI MELVAL
  448. MCHAM1.IELVAL(ICOMP)=MELVAL
  449. IVAL(ICOMP)=MELVAL
  450. enddo
  451. if (nvari.lt.nvart) then
  452. DO ICOMP=NVARI+1,NVART
  453. MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP)
  454. MCHAM1.TYPCHE(ICOMP)='REAL*8'
  455. N2PTEL=0
  456. N2EL =0
  457. SEGINI MELVAL
  458. MCHAM1.IELVAL(ICOMP)=MELVAL
  459. IVAL(ICOMP)=MELVAL
  460. enddo
  461. endif
  462. *********************************
  463. * deformations inelastiques
  464. N1PTEL=NBPTEL
  465. N1EL =NEL
  466. N2 =NDEF
  467. SEGINI MCHAM2
  468. MCHEL2.ICHAML(ISOUS)=MCHAM2
  469. NSR =1
  470. NCOSOR=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. ******************************************************************
  485. KERRE=0
  486. CALL FEFP2(MATE,INPLAS,MELE,MELEME,MINTE,xMATRI,
  487. . NBELEM,NBPTEL,NBNN,LRE,MFR,
  488. . IVADESP,IVADPI,IVARI,IVAMAT,
  489. . IVASTF,IVARIF,IVADPF,LHOOK,IRIGE7,
  490. . NDEP,NDEF,NSTRS,NVART,NMATT,PRECIS,NITMAX,
  491. . NUPDATE,KERRE)
  492.  
  493. ******************************************************************
  494. * Desactivar segmentos
  495. c desactiva malla y modelo de la zona (*NOMOD?)
  496. c desactiva las entradas
  497. CALL DTMVAL (IVADPI ,1)
  498. CALL DTMVAL (IVARI ,1)
  499. CALL DTMVAL (IVADESP,1)
  500. CALL DTMVAL (IVAMAT ,1)
  501. c desactiva/elimina las salidas
  502. CALL DTMVAL (IVASTF ,1)
  503. CALL DTMVAL (IVARIF ,1)
  504. CALL DTMVAL (IVADPF ,1)
  505. SEGDES,xMATRI
  506. IF (KERRE.NE.0) THEN
  507. CALL DTMVAL (IVASTF,3)
  508. CALL DTMVAL (IVARIF,3)
  509. CALL DTMVAL (IVADPF,3)
  510. SEGSUP MCHAML,MCHAM1,MCHAM2,MINTE,xMATRI,DESCR
  511. GO TO 888
  512. END IF
  513. c elimina auxiliares
  514. NOMID=MODEPL
  515. IF (MODEPL.NE.0.and.lsupdp) SEGSUP NOMID
  516. NOMID=MOFORC
  517. IF (lsupfo.and.MOFORC.NE.0) SEGSUP NOMID
  518. NOMID=MOSTRS
  519. IF (MOSTRS.NE.0.and.lsupco) SEGSUP NOMID
  520. NOMID=MOVARI
  521. IF (lsupva.and.MOVARI.NE.0) SEGSUP NOMID
  522. NOMID=MODEIN
  523. IF (MODEIN.NE.0.and.lsupdd) SEGSUP NOMID
  524. NOMID=MOMATR
  525. IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID
  526. * INFO=IPINF
  527. * IF (IPINF .NE.0) SEGSUP INFO
  528. c*****************************************************************
  529. c FIN bucle sobre zonas
  530. 1000 continue
  531. c*****************************************************************
  532. 888 CONTINUE
  533.  
  534. c desactiva el modelo
  535. c desactiva/elimina las salidas
  536. SEGDES,MRIGID
  537. IF(KERRE.NE.0) SEGSUP MCHELM,MCHEL1,MCHEL2,MRIGID
  538.  
  539. RETURN
  540. END
  541.  
  542.  
  543.  
  544.  
  545.  

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