1 : C LISPP0 SOURCE CHAT 05/01/13 01:23:06 5004 2 : SUBROUTINE LISPP0(WRK1,WRK0,WRK2,WTRAV,INPLAS,PRECIS, 3 : 1 KERRE,NSTRS,CMATE,N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST, 4 : 2 MELE,NPINT,NBGMAT,NBPGAU,NELMAT,SECT,LHOOK,CRIGI) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : C====================================================================== 8 : C PLASTICITE LINESPRING 9 : C 10 : C ENTREES 11 : C SIG0(NSTRS) = CONTRAINTES INITIALES 12 : C NSTRS = NOMBRE DE CONTRAINTES 13 : C DEPST(NSTRS)= INCREMENT DE DEFORMATIONS TOTALES 14 : C VAR0(NVARI) = VARIABLES INTERNES DEBUT 15 : C XMAT(NCOMAT)= COMPOSANTES DE MATERIAU 16 : C NCOMAT = NOMBRE DE COMPOSANTES DE MATERIAU 17 : C XCAR(ICARA) = CARACTERISTIQUES 18 : C ICARA = NOMBRE DE CARACTERISTIQUES 19 : C MALI = NUMERO DU MATERIAU LINEAIRE 20 : C INPLAS = NUMERO DU MATERIAU PLASTIQUE 21 : C NCOURB = NOMBRE DE POINTS SUR LA COURBE DE TRACTION 22 : C TRAC = COURBE DE TRACTION 23 : C PRECIS = PRECISION DES ITERATIONS 24 : * CMATE = NOM DU MATERIAU 25 : * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU 26 : * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES 27 : * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE 28 : * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE 29 : * MFR = NUMERO DE LA FORMULATION 30 : * IFOU = OPTION DE CALCUL 31 : * IB = NUMERO DE L ELEMENT COURANT 32 : * IGAU = NUMERO DU POINT COURANT 33 : * EPAIST= EPAISSEUR 34 : * NBPGAU= NBRE DE POINTS DE GAUSS 35 : * MELE = NUMERO DE L ELEMENT FINI 36 : * NPINT = NBRE DE POINTS D INTEGRATION 37 : * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES 38 : * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES 39 : * SECT = SECTION 40 : * LHOOK = TAILLE DE LA MATRICE DE HOOKE 41 : * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX 42 : * UTILISES POUR LE CALCUL DE LA MATRICE DE HOOKE 43 : C 44 : C SORTIES 45 : C SIGF(NSTRS) = CONTRAINTES FINALES ET J 46 : C VARF(NVARI) = VARIABLES INTERNES FINALES 47 : C DEFP(NSTRS) = DEFORMATIONS PLASTIQUES 48 : C KERRE = 0 TOUT OK 49 : C 1 SI DLAMBDA NEGATIF 50 : C 2 NOMBRE MAX D ITERATIONS INTERNES DEPASSE 51 : C 21 ON NE TROUVE PAS L INTERSECTION AVEC LA SRFCE DE CHRG 52 : C 22 SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE 53 : C 30 LIMITE ELASTIQUE NULLE 54 : C 75 SORTIE DE LA COURBE DE TRACTION 55 : C======================================================================= 56 : -INC CCREEL 57 : SEGMENT/WRK0/(XMAT(NCXMAT)*D) 58 : SEGMENT/WRK1/(DDHOOK(LHOOK,LHOOK)*D,SIG0(NSTRS)*D, 59 : . DEPST(NSTRS)*D,SIGF(NSTRS)*D,VAR0(NVARI)*D, 60 : . VARF(NVARI)*D,DEFP(NSTRS)*D,XCAR(ICARA)*D) 61 : SEGMENT/WRK2/(TRAC(LTRAC)*D) 62 : SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D) 63 : SEGMENT/WTRAV/(DDAUX(LHOOK,LHOOK)*D,VALMAT(NUMAT)*D, 64 : . VALCAR(NUCAR)*D,DSIGT(NSTRS)*D,TXR(IDIM,IDIM)*D, 65 : . DDHOMU(LHOOK,LHOOK)*D,XLOC(IDIM,IDIM)*D, 66 : . XGLOB(IDIM,IDIM)*D,D1HOOK(LHOOK,LHOOK)*D, 67 : . ROTHOO(LHOOK,LHOOK)*D) 68 : PARAMETER(UNDEMI=.5D0,UN=1.D0) 69 : PARAMETER(SIX=6.D0) 70 : PARAMETER(NITERC=50) 71 : C 72 : DIMENSION CRIGI(*) 73 : CHARACTER*8 CMATE 74 : PREC = PRECIS*UNDEMI 75 : PRECM =-PRECIS*UNDEMI 76 : C 77 : KERRE=0 78 : C ON RECUPERE L EPAISSEUR 79 : C 80 : W = XCAR(1) 81 : FI = XCAR(2) 82 : QSI= FI / W 83 : C 84 : C A PARTIR DE LA COURBE DE TRACTION , ON CONSTRUIT (SIG0,PHIP) 85 : C 86 : YOU =XMAT(1) 87 : XNU =XMAT(2) 88 : IF(INPLAS.EQ.2) THEN 89 : CCC CAS DE LA PLASTICITE PARFAITE 90 : IF(XMAT(5).EQ.XZERO) THEN 91 : KERRE=30 92 : RETURN 93 : ENDIF 94 : NCOURB=2 95 : TRAC(1)=XMAT(5) 96 : TRAC(2)=XZERO 97 : TRAC(3)=XMAT(5) 98 : TRAC(4)=UN 99 : ELSE 100 : IF(INPLAS.EQ.27) THEN 101 : CCC CAS DE LA PLASTICITE AVEC ECROUISSAGE 102 : C 103 : C ON CALCULE LA RAIDEUR KMM ET ON REMPLIT XMAT(1)=KMM POUR VERIF 104 : C PENTE A L ORIGINE DE LA COURBE (M,PHI) 105 : C 105 : CALL LISPAL(QSI,ALMM,ALMF,ALFF,DELTA) 106 : DDX= 2.D0*(1.D0 -XNU* XNU)/YOU 107 : CMM= ALFF*DDX*SIX*SIX/(W*W) 108 : XMAT(1)=1.D0/CMM 108 : CALL COTRAC(WRK0,WRK2,NCOURB,KERRE) 109 : XMAT(1)=YOU 110 : IF(KERRE.NE.0) RETURN 111 : ENDIF 112 : PMOMM=TRAC(2*NCOURB-1) 113 : IF(PMOMM.EQ.0.D0) THEN 114 : KERRE=30 115 : RETURN 116 : ENDIF 117 : C 118 : C ON CALCULE SIG0 POUR LE MOMENT MAXI 119 : C 120 : XM0SS0=W*W/4.D0 120 : CALL LISPML(QSI,A) 121 : VSIG0=PMOMM/XM0SS0/A 122 : DO 100 I=1,NCOURB 123 : TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0 124 : 100 CONTINUE 125 : ENDIF 126 : C 127 : C REMPLISSAGE DE LA COURBE DE (SIG0,PHIP) 128 : C 129 : SEGINI WORK 130 : DO 2 I=1,NCOURB 131 : SIG(I)=TRAC(2*I-1) 132 : XLAM(I)=TRAC(2*I) 133 : 2 CONTINUE 134 : C 135 : C ON RECUPERE LES VARIABLES INTERNES 136 : C 137 : XLAM0=VAR0(1) 138 : IBI=0 138 : CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI) 139 : IF(IBI.EQ.1) THEN 140 : KERRE=75 141 : GOTO 666 142 : ENDIF 143 : C 144 : C CALCUL DES INCREMENTS DE CONTRAINTES 145 : C 145 : CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,VALCAR, 146 : 1 N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,NBPGAU, 147 : 2 MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC, 148 : 3 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD) 149 : * 150 : IF(IRTD.NE.1) THEN 151 : KERRE=69 152 : GOTO 666 153 : ENDIF 154 : * 155 : C 156 : C ON TRAVAILLE AVEC LES 2 CONTRAINTES MEMBRANE ET FLEXION 157 : C SOLLICITANT LA FISSURE 158 : SIGF(2)=DSIGT(2) + SIG0(2) 159 : SIGF(3)=DSIGT(3) + SIG0(3) 160 : SIGF(5)=DSIGT(5) + SIG0(5) 161 : DEFP(2)=XZERO 162 : DEFP(3)=XZERO 163 : DEFP(5)=XZERO 164 : C 165 : C ON CALCULE LES PARAMETRES POUR CALCULER LE CRITERE 166 : C ET SA DERIVEE 166 : CALL LISPPA(QSI,W,SIGMA0,GA,GB,A,B,C,D,E,F) 167 : C 168 : XN0=SIG0(1) 169 : XM0=SIG0(4) 170 : DNT=DSIGT(1) 171 : DMT=DSIGT(4) 172 : XNT=XN0+DNT 173 : XMT=XM0+DMT 174 : C 175 : C POSITION DE XN0 XM0 XNT XMT DANS OU HORS DE LA SURFACE DE CHARGE 176 : C 176 : CALL LISPQ(XN0,XM0,W,SIGMA0,GA,GB,QSI,Q1) 176 : CALL LISPQ(XNT,XMT,W,SIGMA0,GA,GB,QSI,Q2) 177 : C 178 : IF(Q1.GT.PREC) THEN 179 : KERRE=22 180 : ELSE IF(Q1.LE.PREC.AND.Q2.LE.PREC) THEN 181 : XNE =XNT 182 : XME =XMT 183 : XNP=XZERO 184 : XMP=XZERO 185 : DLAM=XZERO 186 : C 187 : ELSE IF(Q1.LE.PRECM.AND.Q2.GT.PREC) THEN 188 : C 189 : C ON CHERCHE INTERSECTION AVEC SURFACE DE CHARGE 190 : C 191 : DQDLAM=(A*XNT+B*XMT+E)*DNT+(B*XNT+D*XMT+F)*DMT 192 : DLAM= 1.D0 - Q2 / DQDLAM 193 : DO 101 IA=1,NITERC 194 : XNTRA=XN0+DLAM*DNT 195 : XMTRA=XM0+DLAM*DMT 195 : CALL LISPQ(XNTRA,XMTRA,W,SIGMA0,GA,GB,QSI,QQ) 196 : DQDLAM=(A*XNTRA+B*XMTRA+E)*DNT+(B*XNTRA+D*XMTRA+F)*DMT 197 : DLA1=DLAM - QQ / DQDLAM 198 : XNN = ABS(DLA1-DLAM) 199 : DLAM=DLA1 200 : IF(XNN.LT.PREC) GOTO 200 201 : 101 CONTINUE 202 : C 203 : C ON NE TROUVE PAS XN0 XM0 EN MOINS DE NITERC ITERATIONS 204 : C 205 : KERRE=21 206 : GOTO 444 207 : 200 CONTINUE 208 : C 209 : C ON INTEGRE 210 : C 211 : C 211 : CALL LISPP1(XNTRA,XMTRA,XNT,XMT,QSI,W,YOU,XNU,WORK, 212 : 1 XLAM0,PRECIS,XNE,XME,XNP,XMP,DLAM,KERRE) 213 : C 214 : C 215 : 444 CONTINUE 216 : ELSE IF(Q1.GT.PRECM.AND.Q1.LE.PREC.AND.Q2.GT.PREC) THEN 217 : C 218 : C ON INTEGRE 219 : C 219 : CALL LISPP1(XN0,XM0,XNT,XMT,QSI,W,YOU,XNU,WORK, 220 : 1 XLAM0,PRECIS,XNE,XME,XNP,XMP,DLAM,KERRE) 221 : C 222 : C 223 : ENDIF 224 : C 225 : C ON TRANSFORME LES EFFORTS EN CONTRAINTES 226 : C ET ON RECALCULE KI 227 : IF(KERRE.EQ.0) THEN 228 : SIGF(1)=XNE 229 : S1=XNE/W 230 : SIGF(4)=XME 231 : S4=XME*SIX/(W*W) 232 : C 232 : CALL LISPFI(QSI,FM,FF) 233 : XXX=XPI*FI 234 : XXX = SQRT(XXX) 235 : XKIEL = XXX*(FM*S1+FF*S4) 236 : C 237 : DEFP(1)=XNP 238 : DEFP(4)=2.D0*XMP/W 239 : C 239 : CALL LISPDF(XNE,XME,GA,GB,QSI,W,SIGMA0,DFIDQS,DFIDM) 240 : VARF(1)=ABS(DLAM)+VAR0(1) 241 : DJP=DFIDQS*DLAM/DFIDM/W 242 : VARF(2)=VAR0(2)+DJP 243 : C 244 : DEFP(6)=DJP 245 : SIGF(6)=XKIEL 246 : ENDIF 247 : C 248 : 666 RETURN 249 : END 250 : 251 : 252 : 253 : 254 : 255 :
© Cast3M 2003 - All rights reserved.
Disclaimer