1 : C ECOMRS SOURCE CHAT 05/01/12 23:25:07 5004 2 : CCC 3 : C ********************************************************************** 4 : CCC 5 : SUBROUTINE ECO_MRSMAC (SIGINI,VARINI,DSIGTR,SIGFIN,VARFIN, 6 : . ddefpl,iplast,ndims,xmat,kerre, 7 : . precis,nitmax,nescri,ues,nnumer,deltax, 8 : . iterlocal) 9 : CCC 10 : C kerre control de errores 'KERRE 11 : C = 0 integracion correcta 12 : C = 1 sobrepasado el num max de iteraciones/no conv. local 13 : C = 102 apex 14 : CCC 15 : IMPLICIT INTEGER(I-N) 16 : integer ndims,kerre,nitmax,nescri,nnumer,ues,kdummy,ndimv 17 : integer iplast,kerr,i,iplcon,iplcap,iplapex,ndimx,nmodel 18 : integer iplcon2,iplcap2,iplapex2,iterlocal 19 : real*8 sigini(ndims),varini(4),ddefpl(ndims), 20 : . dsigtr(ndims),sigfin(ndims),varfin(ndims), 21 : . xmat(*),precis,deltax,void 22 : real*8 sigtri(6),xtri(8),xini(8),lini,siginv(3) 23 : real*8 exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco, 24 : . exl,xnn,aaa,bbb,pc0,exr,cca,phi,alp,pcc2,paa2,qaa2, 25 : . exm2,eww2,cpr,cpm,cfr,you,xnu 26 : common /elasdata/ you,xnu 27 : common /MRScone/ exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco, 28 : . exl,xnn,aaa,bbb 29 : common /MRScapp/ pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,exm2,eww2, 30 : . cpr,cpm,cfr 31 : do i=1,3 32 : siginv(i)=0.D0 33 : enddo 34 : do i=1,6 35 : sigtri(i)=0.D0 36 : enddo 37 : do i=1,8 38 : xtri(i)=0.D0 39 : xini(i)=0.D0 40 : enddo 41 : kerre=0 42 : iplast=1 42 : call CaracmateMAC(xmat) 43 : nmodel=20 44 : do i=1,ndims 45 : sigtri(i)=sigini(i)+dsigtr(i) 46 : enddo 47 : if (nescri.eq.1) then 47 : call InvariantesPQT(sigtri,ndims,siginv) 48 : write(ues,*)' Sigma trial invari' 49 : write(ues,'(1x,3(E24.16,1x))')(siginv(i),i=1,3) 50 : endif 51 : kdummy=0 51 : call DeterzonaMAC(sigtri,ndims,varini,iplcon,iplcap,iplapex, 52 : . kdummy,ues) 53 : c ELASTICO 54 : 10 continue 55 : if (iplapex.ne.0) goto 900 56 : if ((iplcon.eq.0).and.(iplcap.eq.0)) then 57 : if (nescri.eq.1) write(*,*)' Paso elastico' 58 : iplast=0 59 : do i=1,ndims 60 : sigfin(i) = sigtri(i) 61 : enddo 62 : varfin(1)=varini(1) 63 : varfin(2)=varini(2) 64 : varfin(3)=-1.D0 65 : varfin(4)=-1.D0 66 : iterlocal=0 67 : return 68 : endif 69 : c PLASTICO 70 : do i=1,ndims 71 : xtri(i)=sigtri(i) 72 : xini(i)=sigtri(i) 73 : enddo 74 : lini =0.D0 75 : if (nescri.eq.1) write(ues,*)' Modelo MAC: cone-cap harde' 76 : ndimx=ndims+2 77 : xtri(ndims+1)=varini(1) 78 : xini(ndims+1)=varini(1) 79 : xtri(ndims+2)=varini(2) 80 : xini(ndims+2)=varini(2) 81 : c prediccion para la var interna del cone: 82 : c se trata de esquivar una zona de no convergencia del n-r local 83 : c if ((xini(ndims+1).gt.1.D0).and.(xini(ndims+1).lt.5.D0)) 84 : c . xini(ndims+1)=5.D0 85 : if ((iplcon.eq.1).and.(iplcap.eq.0)) then 86 : if (nescri.eq.1) write(*,*)' Paso plastico: CONE' 87 : kdummy=21 88 : elseif ((iplcon.eq.0).and.(iplcap.eq.1)) then 89 : if (nescri.eq.1) write(*,*)' Paso plastico: CAP' 90 : kdummy=22 91 : else 92 : write(*,*)' Paso plastico: CONE-CAP',iplcon,iplcap 93 : kerre=1 94 : return 95 : endif 95 : call Integra21(xtri,xini,ndimx,lini,ddefpl,ndims, 96 : . kdummy,precis,nitmax,nescri,ues,nnumer, 97 : . deltax,kerre,iterlocal) 98 : varfin(1)=xini(ndims+1) 99 : varfin(2)=xini(ndims+2) 100 : do i=1,ndims 101 : sigfin(i)=xini(i) 102 : enddo 103 : kdummy=0 103 : call DeterzonaMAC(xtri,ndims,varfin,iplcon2,iplcap2,iplapex2, 104 : . kdummy,ues) 105 : if ((iplcon.eq.0).and.(iplcon2.eq.1)) then 106 : if (nescri.eq.1) 107 : . write(*,*)' Cambio de zona de CAP a CONE' 108 : iplcap=0 109 : iplcon=1 110 : goto 10 111 : endif 112 : if (kerre.eq.1) return 113 : if ((iplcon.eq.1).and.(iplcap.eq.0)) then 114 : varfin(3)=lini 115 : varfin(4)=-1.D0 116 : elseif ((iplcon.eq.0).and.(iplcap.eq.1)) then 117 : varfin(3)=-1.D0 118 : varfin(4)=lini 119 : endif 120 : return 121 : c APEX 122 : 900 continue 123 : if (nescri.eq.1) write(*,*)' Paso plastico: APEX' 124 : write(*,*)' Paso plastico: APEX' 125 : do i=1,3 126 : sigfin(i)=-xmat(5) 127 : enddo 128 : do i=4,ndims 129 : sigfin(i)=0.d0 130 : enddo 131 : varfin(1)=varini(1) 132 : varfin(2)=varini(2) 133 : varfin(3)=-2.D0 134 : varfin(4)=-2.D0 135 : kerre=1 136 : return 137 : 1000 continue 138 : return 139 : return 140 : end 141 : 142 : 143 :
© Cast3M 2003 - All rights reserved.
Disclaimer