Télécharger adfefp.eso

Retour à la liste

Numérotation des lignes :

  1. C ADFEFP SOURCE CB215821 16/04/21 21:15:05 8920
  2.  
  3. c**************************************************************************
  4. subroutine apf_driver_fefp(BE,VARF,SIGF,DDHOOK,
  5. . NDEF,NVARI,NSTRS,LHOOK,
  6. . XMAT,xdensi,PRECIS,NITMAX,KERRE,
  7. . nescri,nues,nmodel,nnumer,deltax,
  8. . level,kmax,iaugla,caugla,ib,igau,izone)
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8 (A-H,O-Z)
  11. c IN:
  12. c be(NDEF) = deformaciones trial
  13. c VARF(NVARI) = variables internas trial
  14. c XMAT(*) = propiedades materiales
  15. c PRECIS = precision nivel local
  16. c NITMAX = numero maximo de iteraciones
  17. c KERRE = control de error
  18. c nescri,nues,nmodel,nnumer,deltax,level,kmax,iaugla,caugla
  19. c = parametros varios
  20. c OUT:
  21. c be(NDEF) = deformaciones finales
  22. c VARF(NVARI) = variables internas finales
  23. c SIGF(NSTRS) = tensiones de kirkhoff finales
  24. c DDHOOK(LHOOK,LHOOK) = MTC
  25.  
  26. integer NDEF,NVARI,NSTRS,LHOOK,NITMAX,KERRE,nescri,
  27. . nues,nmodel,nnumer,level,kmax,iaugla,ib,igau,izone
  28. real*8 be(NDEF),VARF(NVARI),SIGF(NSTRS),DDHOOK(LHOOK,LHOOK)
  29. real*8 XMAT(*),PRECIS,deltax,caugla,xdensi
  30. integer i,j,k,ndimx,iterlocal
  31. real*8 bpr(3),qen(3,3),q(6,6),qt(6,6),xlamt(3),xeps(4),xsig(4),
  32. . beta(3),cep(3,3),xepstr(4),aap(6,6)
  33. real*8 p,void(1),resu,lini
  34. real*8 sigy0,kiso,siginf,velo,cpar,mpar
  35. common /miehdata/sigy0,kiso,siginf,velo,cpar,mpar
  36. integer lev,kma,iau
  37. real*8 cau
  38. common /linesearch/lev,kma
  39. common /auglagrang1/iau
  40. common /auglagrang2/cau
  41. c nescri=0
  42. 10 continue
  43. call zzero (qen,9)
  44. call zzero (cep,9)
  45. call zzero (q,36)
  46. call zzero (qt,36)
  47. call zzero (aap,36)
  48. lev=level
  49. kma=kmax
  50. iau=iaugla
  51. cau=caugla
  52. c calcula direc-prales, valores y bases
  53. call prin35(be,bpr,qen,q,qt)
  54. c pasa a espacio direc-prales
  55. do i = 1,3
  56. xlamt(i) = LOG(bpr(i))/2.D0
  57. end do
  58. c inicializa variables generales
  59. ndimx=3
  60. p=0.D0
  61. c inicializa epsilon y var_interna
  62. if (nmodel.eq.2) then
  63. call equv(xeps,xlamt,3)
  64. call carac_mate_rhmc(XMAT)
  65. elseif (nmodel.eq.5) then
  66. call equv(xeps,xlamt,3)
  67. call carac_mate_densi(XMAT,xdensi,nmodel)
  68. elseif (nmodel.eq.6) then
  69. call equv(xeps,xlamt,3)
  70. call carac_mate_densi(XMAT,xdensi,nmodel)
  71. elseif (nmodel.eq.8) then
  72. call invari_p(xlamt,3,p)
  73. call desviador(xlamt,xeps,3)
  74. call carac_mate_miehe(XMAT)
  75. if ((kiso.ne.0.D0).or.(velo.ne.0.D0)) ndimx=4
  76. else
  77. write(nues,*)' Model not defined',nmodel
  78. endif
  79. c trial
  80. call der_enerelas_dpral(xeps,xsig,nmodel)
  81. if (nmodel.eq.6) then
  82. call determina_ls_kma(xsig,nescri,kma,izone)
  83. else
  84. izone = 0
  85. endif
  86. if (ndimx.eq.3) then
  87. void(1) =0.D0
  88. call yieldd(xsig,3,void,1,resu,nmodel)
  89. else
  90. call yieldd(xsig,3,VARF,1,resu,nmodel)
  91. endif
  92. c elastico
  93. if (resu.le.0.D0) then
  94. call equv(beta,xsig,3)
  95. VARF(2)=-1.D0
  96. iterlocal=0
  97. call der2_enerelas_dpral(xeps,cep,3,nmodel)
  98. else
  99. c plastico
  100. lini=0.D0
  101. if (ndimx.eq.4) xeps(ndimx)=VARF(1)
  102. call equv(xepstr,xeps,ndimx)
  103. if (level.eq.2) then
  104. call Integra_ls_2levels(xepstr,xeps,ndimx,lini,nmodel,precis,
  105. . nitmax,nescri,nues,nnumer,deltax,kerre,iterlocal)
  106. else
  107. call Integra_ls_dpral(xepstr,xeps,ndimx,lini,nmodel,precis,
  108. . nitmax,nescri,nues,nnumer,deltax,kerre,iterlocal)
  109. endif
  110. if (kerre.eq.1) then
  111. write(*,*) ' GP LEVEL - Problems ',iterlocal,ib,igau
  112. write(nues,*) ' GP LEVEL - Problems ',iterlocal,ib,igau
  113. read(*,*) kk
  114. if (kk.eq.1) stop
  115. nescri=1
  116. goto 10
  117. endif
  118. call der_enerelas_dpral(xeps,beta,nmodel)
  119. if ( ((nmodel.eq.2).and.(xdensi.ge.0.D0)) .or.
  120. . (nmodel.eq.5) .or. (nmodel.eq.6)) then
  121. call mtc_ls_dpral_densi(cep,3,xeps,ndimx,lini,xdensi,xmat,
  122. . nmodel,nescri,nues,nnumer,deltax)
  123. else
  124. call mtc_ls_dpral(cep,3,xeps,ndimx,lini,
  125. . nmodel,nescri,nues,nnumer,deltax)
  126. endif
  127. if (ndimx.eq.3) then
  128. VARF(1)=VARF(1)+SQRT(2.D0/3.D0)*lini
  129. else
  130. VARF(1)=xeps(ndimx)
  131. endif
  132. VARF(2)=lini
  133. c actualizar deformaciones plasticas (en referencia)
  134. call zzero(be,4)
  135. do i = 1,3
  136. xlamt(i)= EXP(2.D0*(xeps(i)-p))
  137. do j = 1,4
  138. be(j) = be(j) + xlamt(i) * q(j,i)
  139. enddo
  140. enddo
  141. endif
  142. VARF(3)=iterlocal
  143. if (NVARI.gt.3) then
  144. do i=4,NVARI
  145. VARF(i)=0.D0
  146. enddo
  147. endif
  148. c construye CTM a partir del nucleo
  149. do i=1,3
  150. k=1+mod(i,3)
  151. j=i+3
  152. if(abs(bpr(i)-bpr(k)).gt.1.d-10)then
  153. aap(j,j)=2.d0*(bpr(i)*beta(k)-bpr(k)*beta(i))/(bpr(k)-bpr(i))
  154. else
  155. aap(j,j)=cep(i,i)-cep(k,i)-2.d0*beta(i)
  156. endif
  157. aap(i,i)=-2.d0*beta(i)
  158. do j=1,3
  159. aap(i,j)=aap(i,j)+cep(i,j)
  160. end do
  161. end do
  162. c pasa las tensiones y el CTM de dprales a generales
  163. do j = 1,4
  164. SIGF(j)=0.D0
  165. do i = 1,3
  166. SIGF(j) = SIGF(j) + beta(i)*q(j,i)
  167. end do
  168. end do
  169. do i=1,4
  170. do j=1,4
  171. DDHOOK(i,j)=0.D0
  172. do k=1,6
  173. do l=1,6
  174. DDHOOK(i,j) = DDHOOK(i,j) + q(i,k)*aap(k,l)*qt(l,j)
  175. end do
  176. end do
  177. end do
  178. end do
  179. * do i=2,4
  180. * do j=1,i
  181. * aux = (DDHOOK(i,j) + DDHOOK(j,i))*0.5D0
  182. * DDHOOK(i,j) = aux
  183. * DDHOOK(j,i) = aux
  184. * end do
  185. * end do
  186.  
  187. return
  188. end
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  

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