1 : C ADFEFP SOURCE CHAT 05/01/12 21:18:15 5004 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 42 : call zzero (qen,9) 42 : call zzero (cep,9) 42 : call zzero (q,36) 42 : call zzero (qt,36) 42 : call zzero (aap,36) 43 : lev=level 44 : kma=kmax 45 : iau=iaugla 46 : cau=caugla 47 : c calcula direc-prales, valores y bases 47 : call prin35(be,bpr,qen,q,qt) 48 : c pasa a espacio direc-prales 49 : do i = 1,3 50 : xlamt(i) = dlog(bpr(i))/2.D0 51 : end do 52 : c inicializa variables generales 53 : ndimx=3 54 : p=0.D0 55 : c inicializa epsilon y var_interna 56 : if (nmodel.eq.2) then 56 : call equv(xeps,xlamt,3) 56 : call carac_mate_rhmc(XMAT) 57 : elseif (nmodel.eq.5) then 57 : call equv(xeps,xlamt,3) 57 : call carac_mate_densi(XMAT,xdensi,nmodel) 58 : elseif (nmodel.eq.6) then 58 : call equv(xeps,xlamt,3) 58 : call carac_mate_densi(XMAT,xdensi,nmodel) 59 : elseif (nmodel.eq.8) then 59 : call invari_p(xlamt,3,p) 59 : call desviador(xlamt,xeps,3) 59 : call carac_mate_miehe(XMAT) 60 : if ((kiso.ne.0.D0).or.(velo.ne.0.D0)) ndimx=4 61 : else 62 : write(nues,*)' Model not defined',nmodel 63 : endif 64 : c trial 64 : call der_enerelas_dpral(xeps,xsig,nmodel) 65 : if (nmodel.eq.6) then 65 : call determina_ls_kma(xsig,nescri,kma,izone) 66 : else 67 : izone = 0 68 : endif 69 : if (ndimx.eq.3) then 70 : void(1) =0.D0 70 : call yieldd(xsig,3,void,1,resu,nmodel) 71 : else 71 : call yieldd(xsig,3,VARF,1,resu,nmodel) 72 : endif 73 : c elastico 74 : if (resu.le.0.D0) then 74 : call equv(beta,xsig,3) 75 : VARF(2)=-1.D0 76 : iterlocal=0 76 : call der2_enerelas_dpral(xeps,cep,3,nmodel) 77 : else 78 : c plastico 79 : lini=0.D0 80 : if (ndimx.eq.4) xeps(ndimx)=VARF(1) 80 : call equv(xepstr,xeps,ndimx) 81 : if (level.eq.2) then 81 : call Integra_ls_2levels(xepstr,xeps,ndimx,lini,nmodel,precis, 82 : . nitmax,nescri,nues,nnumer,deltax,kerre,iterlocal) 83 : else 83 : call Integra_ls_dpral(xepstr,xeps,ndimx,lini,nmodel,precis, 84 : . nitmax,nescri,nues,nnumer,deltax,kerre,iterlocal) 85 : endif 86 : if (kerre.eq.1) then 87 : write(*,*) ' GP LEVEL - Problems ',iterlocal,ib,igau 88 : write(nues,*) ' GP LEVEL - Problems ',iterlocal,ib,igau 89 : read(*,*) kk 90 : if (kk.eq.1) stop 91 : nescri=1 92 : goto 10 93 : endif 93 : call der_enerelas_dpral(xeps,beta,nmodel) 94 : if ( ((nmodel.eq.2).and.(xdensi.ge.0.D0)) .or. 95 : . (nmodel.eq.5) .or. (nmodel.eq.6)) then 95 : call mtc_ls_dpral_densi(cep,3,xeps,ndimx,lini,xdensi,xmat, 96 : . nmodel,nescri,nues,nnumer,deltax) 97 : else 97 : call mtc_ls_dpral(cep,3,xeps,ndimx,lini, 98 : . nmodel,nescri,nues,nnumer,deltax) 99 : endif 100 : if (ndimx.eq.3) then 101 : VARF(1)=VARF(1)+dsqrt(2.D0/3.D0)*lini 102 : else 103 : VARF(1)=xeps(ndimx) 104 : endif 105 : VARF(2)=lini 106 : c actualizar deformaciones plasticas (en referencia) 106 : call zzero(be,4) 107 : do i = 1,3 108 : xlamt(i)= dexp(2.D0*(xeps(i)-p)) 109 : do j = 1,4 110 : be(j) = be(j) + xlamt(i) * q(j,i) 111 : enddo 112 : enddo 113 : endif 114 : VARF(3)=iterlocal 115 : if (NVARI.gt.3) then 116 : do i=4,NVARI 117 : VARF(i)=0.D0 118 : enddo 119 : endif 120 : c construye CTM a partir del nucleo 121 : do i=1,3 122 : k=1+mod(i,3) 123 : j=i+3 124 : if(abs(bpr(i)-bpr(k)).gt.1.d-10)then 125 : aap(j,j)=2.d0*(bpr(i)*beta(k)-bpr(k)*beta(i))/(bpr(k)-bpr(i)) 126 : else 127 : aap(j,j)=cep(i,i)-cep(k,i)-2.d0*beta(i) 128 : endif 129 : aap(i,i)=-2.d0*beta(i) 130 : do j=1,3 131 : aap(i,j)=aap(i,j)+cep(i,j) 132 : end do 133 : end do 134 : c pasa las tensiones y el CTM de dprales a generales 135 : do j = 1,4 136 : SIGF(j)=0.D0 137 : do i = 1,3 138 : SIGF(j) = SIGF(j) + beta(i)*q(j,i) 139 : end do 140 : end do 141 : do i=1,4 142 : do j=1,4 143 : DDHOOK(i,j)=0.D0 144 : do k=1,6 145 : do l=1,6 146 : DDHOOK(i,j) = DDHOOK(i,j) + q(i,k)*aap(k,l)*qt(l,j) 147 : end do 148 : end do 149 : end do 150 : end do 151 : * do i=2,4 152 : * do j=1,i 153 : * aux = (DDHOOK(i,j) + DDHOOK(j,i))*0.5D0 154 : * DDHOOK(i,j) = aux 155 : * DDHOOK(j,i) = aux 156 : * end do 157 : * end do 158 : 159 : return 160 : end 161 : 162 : 163 :
© Cast3M 2003 - All rights reserved.
Disclaimer