1 : C SSTE2 SOURCE CHAT 11/03/16 21:31:50 6902 2 : 3 : ************************************************************************* 4 : ************************************************************************* 5 : ************************************************************************* 6 : SUBROUTINE SSTE2 (MATE,INPLAS,MELE,MELEME,MINTE,xMATRI, 7 : . NBELEM,NBPTEL,NBNN,LRE,MFR, 8 : . IVASTR,IVARI,IVADS,IVAMAT,NSTRS,NVARI,NMATT, 9 : . IVASTF,IVARIF,IVADEP,LHOOK,IRIGE7, 10 : . PRECIS,NITMAX,NMAXSSTEPS,NNUMER,DELTAX,KERRE) 11 : * entrees : 12 : * mate = numero de materiau elastique 13 : * inplas = numero de materiau inelastique 14 : * mele = numero element fini 15 : * meleme = pointeur du maillage 16 : * minte 17 : * nbelem = numero de elementos 18 : * nbptel = nombre de points par element 19 : * nbnn 20 : * lre 21 : * mfr 22 : * ivastr =pointeur sur un segment mptval de contraintes 23 : * ivari =pointeur sur un segment mptval de variables internes 24 : * ivads =pointeur sur un segment mptval de increments deformations 25 : * ivamat =pointeur sur un segment mptval de materiau 26 : * lhook =taille de la matrice de hooke 27 : * nstrs =nombre de composantes de contraintes 28 : * nvari =nombre de composantes de variables internes 29 : * nmatt =nombre de composnates de proprietes de materiau 30 : * precis =precision dans les iterations internes 31 : * sorties : 32 : * ivastf =pointeur sur un segment mptval de contraintes 33 : * ivarif =pointeur sur un segment mptval de variables internes 34 : * ivadep =pointeur sur un segment mptval de deformations inelastiques 35 : * kerre =indicateur d'erreur 36 : * 37 : ************************************************************************ 38 : IMPLICIT INTEGER(I-N) 39 : IMPLICIT REAL*8(A-H,O-Z) 40 : * 41 : -INC CCOPTIO 42 : -INC SMCHAML 43 : -INC SMELEME 44 : -INC SMCOORD 45 : -INC SMMODEL 46 : -INC SMINTE 47 : c-INC CCHAMP 48 : -INC SMRIGID 49 : * 50 : SEGMENT MPTVAL 51 : INTEGER IPOS(NS) 52 : INTEGER NSOF(NS) 53 : INTEGER IVAL(NCOSOU) 54 : CHARACTER*16 TYVAL(NCOSOU) 55 : ENDSEGMENT 56 : SEGMENT WRK0 57 : REAL*8 XMAT(NMATT+2) 58 : ENDSEGMENT 59 : SEGMENT WRK1 60 : REAL*8 DDHOOK(LHOOK,LHOOK) 61 : REAL*8 SIG0(NSTRS) 62 : REAL*8 DEPST(NSTRS) 63 : REAL*8 DSIGT(NSTRS) 64 : REAL*8 SIGF(NSTRS) 65 : REAL*8 VAR0(NVARI) 66 : REAL*8 VARF(NVARI) 67 : REAL*8 DEFP(NSTRS) 68 : ENDSEGMENT 69 : SEGMENT WRK3 70 : REAL*8 DDHOOK2(LHOOK,LHOOK) 71 : REAL*8 SIGini(NSTRS) 72 : REAL*8 DSIGTr(NSTRS) 73 : REAL*8 VARini(NVARI) 74 : ENDSEGMENT 75 : SEGMENT WRK2 76 : REAL*8 REL(LRE,LRE) 77 : REAL*8 SHPWRK(6,NBNN) 78 : REAL*8 BGENE(NSTRS,LRE) 79 : REAL*8 XE(3,NBNN) 80 : ENDSEGMENT 81 : DIMENSION E(6,6) 81 : call zero(E ,6,6 ) 82 : SEGINI WRK0,WRK1,WRK2,WRK3 83 : **************************************** 84 : nescri =0 85 : nues =6 86 : if (inplas.eq.111) then 87 : c MODELE MRS_LADE 88 : nmodel =21 89 : ndimv =4 90 : nsubpos =5 91 : if (NNUMER.eq.0) THEN 92 : nnumer=3 93 : deltax=2.D0**(int(log10(1.D-6)/log10(2.D0))) 94 : endif 95 : else if (inplas.eq.112) then 96 : c MODELE J2 97 : nmodel =1 98 : ndimv =2 99 : nsubpos =3 100 : else if (inplas.eq.113) then 101 : c MODELE RH_COULOMB 102 : nmodel =2 103 : ndimv =2 104 : nsubpos =3 105 : endif 106 : 107 : **************************************** 108 : * bucle elementos 109 : DO 1000 IB=1,NBELEM 110 : DO IA1=1,NBNN 111 : JA=(IDIM+1)*(MELEME.NUM(IA1,IB)-1) 112 : DO IA2=1,IDIM 113 : wrk2.XE(IA2,IA1)=MCOORD.XCOOR(JA+IA2) 114 : ENDDO 115 : wrk2.XE(3,IA1)=0.D0 116 : ENDDO 116 : CALL ZERO(REL,LRE,LRE) 117 : **************************************** 118 : * bucle puntos de gauss 119 : DO 1100 IGAU=1,NBPTEL 120 : * sig0 = tensiones iniciales 121 : MPTVAL=IVASTR 122 : DO IC=1,NSTRS 123 : MELVAL=IVAL(IC) 124 : IBMN=MIN(IB,VELCHE(/2)) 125 : IGMN=MIN(IGAU,VELCHE(/1)) 126 : SIG0(IC)=VELCHE(IGMN,IBMN) 127 : enddo 128 : * var0 = variables internas iniciales 129 : MPTVAL=IVARI 130 : DO IC=1,NVARI 131 : MELVAL=IVAL(IC) 132 : IBMN=MIN(IB,VELCHE(/2)) 133 : IGMN=MIN(IGAU,VELCHE(/1)) 134 : VAR0(IC)=VELCHE(IGMN,IBMN) 135 : enddo 136 : * depst = incremento de deformacion total 137 : MPTVAL=IVADS 138 : DO IC=1,NSTRS 139 : MELVAL=IVAL(IC) 140 : IBMN=MIN(IB,VELCHE(/2)) 141 : IGMN=MIN(IGAU,VELCHE(/1)) 142 : DEPST(IC)=VELCHE(IGMN,IBMN) 143 : enddo 144 : * xmat = caracteristicas materiales 145 : MPTVAL=IVAMAT 146 : DO IC=1,2 147 : MELVAL=IVAL(IC) 148 : IGMN=MIN(IGAU,VELCHE(/1)) 149 : IBMN=MIN(IB ,VELCHE(/2)) 150 : XMAT(IC)=VELCHE(IGMN,IBMN) 151 : ENDDO 152 : XMAT(3)=0.D0 153 : XMAT(4)=0.D0 154 : DO IC=3,NMATT-3 155 : MELVAL=IVAL(IC) 156 : IGMN=MIN(IGAU,VELCHE(/1)) 157 : IBMN=MIN(IB ,VELCHE(/2)) 158 : XMAT(IC+2)=VELCHE(IGMN,IBMN) 159 : ENDDO 160 : **************************************** 160 : call MatHok(E,6,NSTRS,1) 161 : do i=1,NSTRS 162 : r_z =0.D0 163 : do j=1,NSTRS 164 : r_z = r_z+E(i,j)*DEPST(j) 165 : enddo 166 : DSIGT(i)=r_z 167 : enddo 168 : iincre=nint(VAR0(nsubpos+1)) 169 : if (iincre.le.0) iincre=NMAXSSTEPS 170 : iincreold = iincre 171 : iincreold2 = iincre 172 : iflagrec=0 173 : 100 continue 174 : nsub=0 174 : call substep (SIG0,VAR0,DSIGT,SIGF,VARF,DEFP, 175 : . DDHOOK,NSTRS,ndimv,LHOOK, 176 : . XMAT,KERRE,PRECIS,NITMAX,nescri, 177 : . nues,nmodel,NNUMER,DELTAX,NMAXSSTEPS, 178 : . nsub,ntotiter,iincre) 179 : 180 : c numero de substeps hechos: nsub 181 : c numero total de iteraciones: ntotiter 182 : c tamańo del ultimo step !!: iincre 183 : 184 : if (kerre.eq.1) then 185 : write(*,*)' Error tras substepping' 186 : if ((inplas.eq.111).and. 187 : . ((nsub.ge.NMAXSSTEPS).or.(iflagrec.eq.1))) then 188 : write(*,9998)'STOP',IB,IGAU,iincre,nsub,ntotiter 188 : call DeterzonaMAC(sig0,4,var0,iplcon,iplcap, 189 : . iplapex,1,6) 190 : do i=1,NSTRS 191 : DSIGT(i)=SIG0(i)+DSIGT(i) 192 : enddo 192 : call DeterzonaMAC(dsigt,4,var0,iplcon,iplcap, 193 : . iplapex,1,6) 194 : iflagrec=0 195 : return 196 : else 197 : write(*,9998)'Recompute',IB,IGAU,iincre,nsub,ntotiter 197 : call DeterzonaMAC(sig0,4,var0,iplcon,iplcap, 198 : . iplapex,1,6) 199 : iincre=1 200 : iflagrec=1 201 : goto 100 202 : endif 203 : endif 204 : 205 : if (iincre.ne.iincreold) 206 : . write(*,9999)'CHANGED',IB,IGAU,iincre,nsub 207 : 208 : ratio = float(ntotiter)/float(nsub) 209 : if (ratio.gt.NITMAX) then 210 : iincren=max(nint(iincre/(ratio-4.D0)),1) 211 : write(*,9999)'More iincre',IB,IGAU,iincre,iincren,ratio 212 : iincre=iincren 213 : else if ((ratio.lt.4.).and.(nsub.gt.1)) then 214 : iincren=min(nint(iincre*(5.D0-ratio)),NMAXSSTEPS) 215 : write(*,9999)'Less iincre',IB,IGAU,iincre,iincren,ratio 216 : iincre=iincren 217 : endif 218 : VARF(nsubpos) =nsub 219 : VARF(nsubpos+1)=iincre 220 : 9998 format(1x,a10,1x,5I9) 221 : 9999 format(1x,a10,1x,4I9,2x,E10.4) 222 : **************************************** 223 : * sigf = tensiones finales 224 : MPTVAL=IVASTF 225 : DO IC=1,NSTRS 226 : MELVAL=MPTVAL.IVAL(IC) 227 : MELVAL.VELCHE(IGAU,IB)=SIGF(IC) 228 : enddo 229 : * varf = variables internas finales 230 : MPTVAL=IVARIF 231 : DO IC=1,NVARI 232 : MELVAL=MPTVAL.IVAL(IC) 233 : MELVAL.VELCHE(IGAU,IB)=VARF(IC) 234 : enddo 235 : * defp = incremento de deformations plasticas 236 : MPTVAL=IVADEP 237 : DO IC=1,NSTRS 238 : MELVAL=MPTVAL.IVAL(IC) 239 : MELVAL.VELCHE(IGAU,IB)=DEFP(IC) 240 : enddo 241 : c calcula la matriz b = BGENE y el jacobiano DJAC 242 : XDPGE=0.D0 243 : YDPGE=0.D0 244 : DIM3=1.D0 244 : CALL BMATST(IGAU,NBPTEL,POIGAU,QSIGAU,ETAGAU,DZEGAU, 245 : 1 MELE,MFR,NBNN,LRE,IFOUR,NSTRS,NIFOUR,DIM3, 246 : 2 XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 247 : IF(abs(DJAC).LT.1.E-17) then 248 : write(*,*)' Jacobiano cero, en elem', ib,' gauss',igau 249 : endif 250 : DJAC=ABS(DJAC)*MINTE.POIGAU(IGAU) 251 : IF (IRIGE7.EQ.2)THEN 251 : CALL BDBSTS(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL) 252 : ELSE 252 : CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL) 253 : ENDIF 254 : **************************************** 255 : c fin bucle puntos de gauss 256 : 1100 continue 257 : c guarda la matriz de rigidez elemental REL en XMATRI.RE 258 : IF (IRIGE7.EQ.2)THEN 258 : CALL REMPMS(REL,LRE,RE(1,1,ib)) 259 : ELSE 259 : CALL REMPMT(REL,LRE,RE(1,1,ib)) 260 : ENDIF 261 : **************************************** 262 : c fin bucle elementos 263 : 1000 continue 264 : segdes xmatri 265 : c desactivar segmentos de trabajo 266 : SEGSUP WRK0,WRK1,WRK2 267 : RETURN 268 : END 269 : 270 : 271 : 272 : 273 :
© Cast3M 2003 - All rights reserved.
Disclaimer