Télécharger fefp1.eso

Retour à la liste

Numérotation des lignes :

fefp1
  1. C FEFP1 SOURCE CB215821 24/04/12 21:15:57 11897
  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. NOMID =MOFORC
  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. * passer en ro
  280. segact descr
  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 SEGSUP MCHELM,MCHEL1,MCHEL2
  312. c INFO=IPINF
  313. c SEGSUP INFO
  314. c RETURN
  315. c ENDIF
  316. c DUDAS ESTE TROZO
  317. **********************************************
  318. c tipo de variables de trabajo
  319. NBTYPE =1
  320. SEGINI NOTYPE
  321. NOTYPE.TYPE(1)='REAL*8'
  322. ********************************************** IPCHE1 => IVADPI
  323. * deformaciones plasticas iniciales
  324. if(lnomid(13).ne.0) then
  325. nomid=lnomid(13)
  326. segact nomid
  327. modein=nomid
  328. ndef=lesobl(/2)
  329. nfac=lesfac(/2)
  330. lsupdd=.false.
  331. else
  332. lsupdd=.true.
  333. CALL IDDEIN(IMODEL,IFOUR,MODEIN,NDEF,NFAC)
  334. endif
  335.  
  336. CALL KOMCHA(IPCHE1,MELEME,CONM,MODEIN,NOTYPE,1,INFOS,3,IVADPI)
  337. ********************************************** IPCHE2 => IVARI
  338. * variables internes
  339. if(lnomid(10).ne.0) then
  340. nomid=lnomid(10)
  341. segact nomid
  342. movari=nomid
  343. nvari=lesobl(/2)
  344. nvarf=lesfac(/2)
  345. lsupva=.false.
  346. else
  347. lsupva=.true.
  348. CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  349. endif
  350. CALL KOMCHA(IPCHE2,MELEME,CONM,MOVARI,NOTYPE,1,INFOS,3,IVARI)
  351. NVART=NVARI+NVARF
  352. ********************************************** IPCHE3 => IVADESP
  353. * campo de desplazamientos
  354. if(lnomid(1).ne.0) then
  355. nomid=lnomid(1)
  356. segact nomid
  357. modepl=nomid
  358. ndep=lesobl(/2)
  359. nfac=lesfac(/2)
  360. lsupdp=.false.
  361. else
  362. lsupdp=.true.
  363. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEP,NFAC)
  364. endif
  365. CALL KOMCHA(IPCHE3,MELEME,CONM,MODEPL,NOTYPE,1,INFOS,3,IVADESP)
  366. ********************************************** IPMODL => IVAMAT
  367. * caracteristiques materielles
  368. if(lnomid(6).ne.0) then
  369. nomid=lnomid(6)
  370. segact nomid
  371. momatr=nomid
  372. nmatr=lesobl(/2)
  373. nmatf=lesfac(/2)
  374. lsupma=.false.
  375. else
  376. lsupma=.true.
  377. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  378. endif
  379. CALL KOMCHA(IPCAR,MELEME,CONM,MOMATR,NOTYPE,1,INFOS,3,IVAMAT)
  380. NMATT=NMATR+NMATF
  381. SEGSUP NOTYPE
  382. ********************************************** IPCAR => no hay...
  383. * caracteristiques geometriques
  384.  
  385. **********************************************
  386. * Creacion de los mchamls de las zonas
  387. **********************************************
  388. NBPTEL=NBGS
  389. NEL =NBELEM
  390. N1PTEL=NBPTEL
  391. N1EL =NEL
  392. *********************************
  393. * tensiones
  394. *********************************
  395. if(lnomid(4).ne.0) then
  396. nomid=lnomid(4)
  397. segact nomid
  398. mostrs=nomid
  399. nstrs=lesobl(/2)
  400. nfac=lesfac(/2)
  401. lsupco=.false.
  402. else
  403. lsupco=.true.
  404. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTRS,NFAC)
  405. endif
  406. c entra: IMODEL,IFOUR
  407. c sale : MOSTRS,NSTRS,NFAC
  408. N2 =NSTRS
  409. SEGINI MCHAML
  410. c usa N2
  411. MCHELM.ICHAML(ISOUS)=MCHAML
  412. NS =1
  413. NCOSOU=NSTRS
  414. SEGINI MPTVAL
  415. c usa NS, NCOSOU
  416. IVASTF=MPTVAL
  417. NOMID =MOSTRS
  418. SEGACT NOMID
  419. c usa NBROBL, NBRFAC
  420. DO ICOMP=1,NSTRS
  421. MCHAML.NOMCHE(ICOMP)=NOMID.LESOBL(ICOMP)
  422. MCHAML.TYPCHE(ICOMP)='REAL*8'
  423. N2PTEL=0
  424. N2EL =0
  425. SEGINI MELVAL
  426. c usa N1PTEL, N1EL, N2PTEL, N2EL
  427. MCHAML.IELVAL(ICOMP)=MELVAL
  428. IVAL(ICOMP)=MELVAL
  429. enddo
  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. *********************************
  462. * deformations inelastiques
  463. N1PTEL=NBPTEL
  464. N1EL =NEL
  465. N2 =NDEF
  466. SEGINI MCHAM2
  467. MCHEL2.ICHAML(ISOUS)=MCHAM2
  468. NS =1
  469. NCOSOU=NDEF
  470. SEGINI MPTVAL
  471. IVADPF=MPTVAL
  472. NOMID =MODEIN
  473. SEGACT NOMID
  474. DO ICOMP=1,NDEF
  475. MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP)
  476. MCHAM2.TYPCHE(ICOMP)='REAL*8'
  477. N2PTEL=0
  478. N2EL =0
  479. SEGINI MELVAL
  480. MCHAM2.IELVAL(ICOMP)=MELVAL
  481. IVAL(ICOMP)=MELVAL
  482. enddo
  483. ******************************************************************
  484. KERRE=0
  485. CALL FEFP2(MATE,INPLAS,MELE,MELEME,MINTE,xMATRI,
  486. . NBELEM,NBPTEL,NBNN,LRE,MFR,
  487. . IVADESP,IVADPI,IVARI,IVAMAT,
  488. . IVASTF,IVARIF,IVADPF,LHOOK,IRIGE7,
  489. . NDEP,NDEF,NSTRS,NVART,NMATT,PRECIS,NITMAX,
  490. . NUPDATE,KERRE)
  491.  
  492. ******************************************************************
  493. * Desactivar segmentos
  494. c desactiva malla y modelo de la zona (*NOMOD?)
  495. c desactiva las entradas
  496. CALL DTMVAL (IVADPI ,1)
  497. CALL DTMVAL (IVARI ,1)
  498. CALL DTMVAL (IVADESP,1)
  499. CALL DTMVAL (IVAMAT ,1)
  500. c desactiva/elimina las salidas
  501. CALL DTMVAL (IVASTF ,1)
  502. CALL DTMVAL (IVARIF ,1)
  503. CALL DTMVAL (IVADPF ,1)
  504. SEGDES,xMATRI
  505. IF (KERRE.NE.0) THEN
  506. CALL DTMVAL (IVASTF,3)
  507. CALL DTMVAL (IVARIF,3)
  508. CALL DTMVAL (IVADPF,3)
  509. SEGSUP MCHAML,MCHAM1,MCHAM2,MINTE,xMATRI,DESCR
  510. GO TO 888
  511. END IF
  512. c elimina auxiliares
  513. NOMID=MODEPL
  514. IF (MODEPL.NE.0.and.lsupdp) SEGSUP NOMID
  515. NOMID=MOFORC
  516. IF (lsupfo.and.MOFORC.NE.0) SEGSUP NOMID
  517. NOMID=MOSTRS
  518. IF (MOSTRS.NE.0.and.lsupco) SEGSUP NOMID
  519. NOMID=MOVARI
  520. IF (lsupva.and.MOVARI.NE.0) SEGSUP NOMID
  521. NOMID=MODEIN
  522. IF (MODEIN.NE.0.and.lsupdd) SEGSUP NOMID
  523. NOMID=MOMATR
  524. IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID
  525. * INFO=IPINF
  526. * IF (IPINF .NE.0) SEGSUP INFO
  527. c*****************************************************************
  528. c FIN bucle sobre zonas
  529. 1000 continue
  530. c*****************************************************************
  531. 888 CONTINUE
  532.  
  533. c desactiva el modelo
  534. c desactiva/elimina las salidas
  535. SEGDES,MRIGID
  536. IF(KERRE.NE.0) SEGSUP MCHELM,MCHEL1,MCHEL2,MRIGID
  537.  
  538. RETURN
  539. END
  540.  
  541.  
  542.  
  543.  
  544.  

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