1 : C CLISPP SOURCE KICH 09/09/11 21:16:08 6505 2 : SUBROUTINE CLISPP(WRK52,WRK53,WRK54,WRK2,IFOU,IB,IGAU, 3 : 1 NBPGAU,iecou) 4 : C LISPP0 SOURCE KICH 98/06/30 23:19:33 3239 5 : c SUBROUTINE LISPP0(WRK1,WRK0,WRK2,WTRAV,INPLAS,PRECIS, 6 : c 1 KERRE,NSTRS,CMATE,N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST, 7 : c 2 MELE,NPINT,NBGMAT,NBPGAU,NELMAT,SECT,LHOOK,CRIGI) 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL*8(A-H,O-Z) 10 : C====================================================================== 11 : C PLASTICITE LINESPRING 12 : C 13 : C ENTREES 14 : C SIG0(NSTRS1) = CONTRAINTES INITIALES 15 : C NSTRS1 = NOMBRE DE CONTRAINTES 16 : C DEPST(NSTRS1)= INCREMENT DE DEFORMATIONS TOTALES 17 : C VAR0(NVARI) = VARIABLES INTERNES DEBUT 18 : C XMAT(NCOMAT)= COMPOSANTES DE MATERIAU 19 : C NCOMAT = NOMBRE DE COMPOSANTES DE MATERIAU 20 : C xcarb(ICARA) = CARACTERISTIQUES 21 : C ICARA = NOMBRE DE CARACTERISTIQUES 22 : C MALI = NUMERO DU MATERIAU LINEAIRE 23 : C INPLAS = NUMERO DU MATERIAU PLASTIQUE 24 : C NCOURB = NOMBRE DE POINTS SUR LA COURBE DE TRACTION 25 : C TRAC = COURBE DE TRACTION 26 : C PRECIS = PRECISION DES ITERATIONS 27 : * CMATE = NOM DU MATERIAU 28 : * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU 29 : * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES 30 : * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE 31 : * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE 32 : * MFR = NUMERO DE LA FORMULATION 33 : * IFOU = OPTION DE CALCUL 34 : * IB = NUMERO DE L ELEMENT COURANT 35 : * IGAU = NUMERO DU POINT COURANT 36 : * EPAIST= EPAISSEUR 37 : * NBPGAU= NBRE DE POINTS DE GAUSS 38 : * MELE = NUMERO DE L ELEMENT FINI 39 : * NPINT = NBRE DE POINTS D INTEGRATION 40 : * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES 41 : * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES 42 : * SECT = SECTION 43 : * LHOOK = TAILLE DE LA MATRICE DE HOOKE 44 : * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX 45 : * UTILISES POUR LE CALCUL DE LA MATRICE DE HOOKE 46 : C 47 : C SORTIES 48 : C SIGF(NSTRS1) = CONTRAINTES FINALES ET J 49 : C VARF(NVARI) = VARIABLES INTERNES FINALES 50 : C DEFP(NSTRS1) = DEFORMATIONS PLASTIQUES 51 : C KERRE = 0 TOUT OK 52 : C 1 SI DLAMBDA NEGATIF 53 : C 2 NOMBRE MAX D ITERATIONS INTERNES DEPASSE 54 : C 21 ON NE TROUVE PAS L INTERSECTION AVEC LA SRFCE DE CHRG 55 : C 22 SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE 56 : C 30 LIMITE ELASTIQUE NULLE 57 : C 75 SORTIE DE LA COURBE DE TRACTION 58 : C======================================================================= 59 : -INC CCREEL 60 : -INC DECHE 61 : SEGMENT IECOU 62 : * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK, 63 : INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7, 64 : C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK, 65 : 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16, 66 : C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND, 67 : 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24, 68 : C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT, 69 : 3 icow25,icow26,icow27,icow28,icow29,icow30,icow31, 70 : C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA, 71 : 4 icow32,icow33,NSTRS1,icow35,NBGMAT,NELMAT,icow38, 72 : C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA, 73 : 5 icow39,icow40,icow41,icow42,icow43,icow44 74 : C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME 75 : INTEGER icow45,icow46,icow47,icow48,icow49,icow50, 76 : . icow51,icow52,icow53,icow54,icow55,icow56 77 : . icow57,icow58 78 : ENDSEGMENT 79 : 80 : SEGMENT/WRK2/(TRAC(LTRAC)*D) 81 : SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D) 82 : PARAMETER(UNDEMI=.5D0,UN=1.D0) 83 : PARAMETER(SIX=6.D0) 84 : PARAMETER(NITERC=50) 85 : C 86 : PREC = PRECIS*UNDEMI 87 : PRECM =-PRECIS*UNDEMI 88 : C 89 : KERRE=0 90 : C ON RECUPERE L EPAISSEUR 91 : C 92 : * write(6,*) ' entree dans clispp iecou', iecou 93 : W = xcarb(1) 94 : FI = xcarb(2) 95 : QSI= FI / W 96 : C 97 : C A PARTIR DE LA COURBE DE TRACTION , ON CONSTRUIT (SIG0,PHIP) 98 : C 99 : YOU =XMAT(1) 100 : XNU =XMAT(2) 101 : IF(INPLAS.EQ.2) THEN 102 : CCC CAS DE LA PLASTICITE PARFAITE 103 : IF(XMAT(5).EQ.XZERO) THEN 104 : KERRE=30 105 : RETURN 106 : ENDIF 107 : NCOURB=2 108 : TRAC(1)=XMAT(5) 109 : TRAC(2)=XZERO 110 : TRAC(3)=XMAT(5) 111 : TRAC(4)=UN 112 : ELSE 113 : IF(INPLAS.EQ.27) THEN 114 : CCC CAS DE LA PLASTICITE AVEC ECROUISSAGE 115 : C 116 : C ON CALCULE LA RAIDEUR KMM ET ON REMPLIT XMAT(1)=KMM POUR VERIF 117 : C PENTE A L ORIGINE DE LA COURBE (M,PHI) 118 : C 118 : CALL LISPAL(QSI,ALMM,ALMF,ALFF,DELTA) 119 : DDX= 2.D0*(1.D0 -XNU* XNU)/YOU 120 : CMM= ALFF*DDX*SIX*SIX/(W*W) 121 : XMAT(1)=1.D0/CMM 121 : call ccotra(wrk52,wrk2,NCOURB,wrk53) 122 : XMAT(1)=YOU 123 : IF(KERRE.NE.0) RETURN 124 : ENDIF 125 : PMOMM=TRAC(2*NCOURB-1) 126 : IF(PMOMM.EQ.0.D0) THEN 127 : KERRE=30 128 : RETURN 129 : ENDIF 130 : C 131 : C ON CALCULE SIG0 POUR LE MOMENT MAXI 132 : C 133 : XM0SS0=W*W/4.D0 133 : CALL LISPML(QSI,A) 134 : VSIG0=PMOMM/XM0SS0/A 135 : DO 100 I=1,NCOURB 136 : TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0 137 : 100 CONTINUE 138 : ENDIF 139 : C 140 : C REMPLISSAGE DE LA COURBE DE (SIG0,PHIP) 141 : C 142 : SEGINI WORK 143 : DO 2 I=1,NCOURB 144 : SIG(I)=TRAC(2*I-1) 145 : XLAM(I)=TRAC(2*I) 146 : 2 CONTINUE 147 : C 148 : C ON RECUPERE LES VARIABLES INTERNES 149 : C 150 : XLAM0=VAR0(1) 151 : IBI=0 151 : CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI) 152 : IF(IBI.EQ.1) THEN 153 : KERRE=75 154 : GOTO 666 155 : ENDIF 156 : C 157 : C CALCUL DES INCREMENTS DE CONTRAINTES 158 : C 159 : nstrbi=nstrs1 160 : nbgmab=nbgmat 161 : nlmatb=nelmat 162 : * write(6,*) ' clispp appel a calsig mfr ', mfr 162 : CALL CALSIG(DEPST,DDAUX,NSTRbi,CMATE,VALMAT,VALCAR, 163 : 1 N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,NBPGAU, 164 : 2 MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC, 165 : 3 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD) 166 : * write(6,*) ' clispp apres calsig irtd ',irtd 167 : nstrs1=nstrbi 168 : nbgmat=nbgmab 169 : nelmat=nlmatb 170 : * 171 : IF(IRTD.NE.1) THEN 172 : KERRE=69 173 : GOTO 666 174 : ENDIF 175 : * 176 : C 177 : C ON TRAVAILLE AVEC LES 2 CONTRAINTES MEMBRANE ET FLEXION 178 : C SOLLICITANT LA FISSURE 179 : SIGF(2)=DSIGT(2) + SIG0(2) 180 : SIGF(3)=DSIGT(3) + SIG0(3) 181 : SIGF(5)=DSIGT(5) + SIG0(5) 182 : DEFP(2)=XZERO 183 : DEFP(3)=XZERO 184 : DEFP(5)=XZERO 185 : C 186 : C ON CALCULE LES PARAMETRES POUR CALCULER LE CRITERE 187 : C ET SA DERIVEE 187 : CALL LISPPA(QSI,W,SIGMA0,GA,GB,A,B,C,D,E,F) 188 : C 189 : XN0=SIG0(1) 190 : XM0=SIG0(4) 191 : DNT=DSIGT(1) 192 : DMT=DSIGT(4) 193 : XNT=XN0+DNT 194 : XMT=XM0+DMT 195 : C 196 : C POSITION DE XN0 XM0 XNT XMT DANS OU HORS DE LA SURFACE DE CHARGE 197 : C 197 : CALL LISPQ(XN0,XM0,W,SIGMA0,GA,GB,QSI,Q1) 197 : CALL LISPQ(XNT,XMT,W,SIGMA0,GA,GB,QSI,Q2) 198 : C 199 : IF(Q1.GT.PREC) THEN 200 : KERRE=22 201 : ELSE IF(Q1.LE.PREC.AND.Q2.LE.PREC) THEN 202 : XNE =XNT 203 : XME =XMT 204 : XNP=XZERO 205 : XMP=XZERO 206 : DLAM=XZERO 207 : C 208 : ELSE IF(Q1.LE.PRECM.AND.Q2.GT.PREC) THEN 209 : C 210 : C ON CHERCHE INTERSECTION AVEC SURFACE DE CHARGE 211 : C 212 : DQDLAM=(A*XNT+B*XMT+E)*DNT+(B*XNT+D*XMT+F)*DMT 213 : DLAM= 1.D0 - Q2 / DQDLAM 214 : DO 101 IA=1,NITERC 215 : XNTRA=XN0+DLAM*DNT 216 : XMTRA=XM0+DLAM*DMT 216 : CALL LISPQ(XNTRA,XMTRA,W,SIGMA0,GA,GB,QSI,QQ) 217 : DQDLAM=(A*XNTRA+B*XMTRA+E)*DNT+(B*XNTRA+D*XMTRA+F)*DMT 218 : DLA1=DLAM - QQ / DQDLAM 219 : XNN = ABS(DLA1-DLAM) 220 : DLAM=DLA1 221 : IF(XNN.LT.PREC) GOTO 200 222 : 101 CONTINUE 223 : C 224 : C ON NE TROUVE PAS XN0 XM0 EN MOINS DE NITERC ITERATIONS 225 : C 226 : KERRE=21 227 : GOTO 444 228 : 200 CONTINUE 229 : C 230 : C ON INTEGRE 231 : C 232 : C 233 : prec1 = PRECIS 234 : kerre1 = KERRE 234 : CALL LISPP1(XNTRA,XMTRA,XNT,XMT,QSI,W,YOU,XNU,WORK, 235 : 1 XLAM0,prec1,XNE,XME,XNP,XMP,DLAM,kerre1) 236 : PRECIS = prec1 237 : KERRE = kerre1 238 : C 239 : C 240 : 444 CONTINUE 241 : ELSE IF(Q1.GT.PRECM.AND.Q1.LE.PREC.AND.Q2.GT.PREC) THEN 242 : C 243 : C ON INTEGRE 244 : C 245 : prec1 = PRECIS 246 : kerre1 = KERRE 246 : CALL LISPP1(XN0,XM0,XNT,XMT,QSI,W,YOU,XNU,WORK, 247 : 1 XLAM0,prec1,XNE,XME,XNP,XMP,DLAM,kerre1) 248 : PRECIS = prec1 249 : KERRE = kerre1 250 : C 251 : C 252 : ENDIF 253 : C 254 : C ON TRANSFORME LES EFFORTS EN CONTRAINTES 255 : C ET ON RECALCULE KI 256 : IF(KERRE.EQ.0) THEN 257 : SIGF(1)=XNE 258 : S1=XNE/W 259 : SIGF(4)=XME 260 : S4=XME*SIX/(W*W) 261 : C 261 : CALL LISPFI(QSI,FM,FF) 262 : XXX=XPI*FI 263 : XXX = SQRT(XXX) 264 : XKIEL = XXX*(FM*S1+FF*S4) 265 : C 266 : DEFP(1)=XNP 267 : DEFP(4)=2.D0*XMP/W 268 : C 268 : CALL LISPDF(XNE,XME,GA,GB,QSI,W,SIGMA0,DFIDQS,DFIDM) 269 : VARF(1)=ABS(DLAM)+VAR0(1) 270 : DJP=DFIDQS*DLAM/DFIDM/W 271 : VARF(2)=VAR0(2)+DJP 272 : C 273 : DEFP(6)=DJP 274 : SIGF(6)=XKIEL 275 : ENDIF 276 : C 277 : 666 RETURN 278 : END 279 : 280 : 281 : 282 : 283 : 284 : 285 : 286 : 287 : 288 : 289 : 290 : 291 : 292 : 293 : 294 : 295 : 296 : 297 :
© Cast3M 2003 - All rights reserved.
Disclaimer