1 : C TUFICO SOURCE CHAT 05/01/13 03:55:26 5004 2 : SUBROUTINE TUFICO(XM,XP,DELTAM,DELTAP,THETA,XM0,XP0) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C===================================================================== 6 : C CE SOUS PROGRAMME SERT A TROUVER L INTERSECTION AVEC LA 7 : C SURFACE DE CHARGE 8 : C 9 : C ENTREES : XM,XP LES CONTRAINTES 10 : C DELTAM,DELTAP L INCREMENT 11 : C THETA ANGLE DE LA FISSURE 12 : C 13 : C SORTIES : XM,XP LES CONTRAINTES SUR LA SURFACE 14 : C DELTAM,DELTAP LE RESTE DE L INCREMENT 15 : C====================================================================== 16 : ZERO=0.D0 17 : PRECIS=1.D-3 18 : XL1=1.D0 19 : XL2=0.5D0 20 : 1 CONTINUE 21 : XM1=XM+XL1*DELTAM 22 : XP1=XP+XL1*DELTAP 23 : XM2=XM+XL2*DELTAM 24 : XP2=XP+XL2*DELTAP 25 : F1=CRIT1(XM1,XP1,THETA,XM0,XP0) 26 : F2=CRIT1(XM2,XP2,THETA,XM0,XP0) 27 : FP=(F2-F1)/(XL2-XL1) 28 : XL3=XL2-F2/FP 29 : XM3=XM+XL3*DELTAM 30 : XP3=XP+XL3*DELTAP 31 : F3=CRIT1(XM3,XP3,THETA,XM0,XP0) 32 : CRI=ABS(F3) 33 : CRU=ABS((XL3-XL2)/XL2) 34 : IF(CRI.GE.PRECIS.OR.CRU.GE.PRECIS) THEN 35 : XL1=XL2 36 : XL2=XL3 37 : GO TO 1 38 : ELSE 39 : XM=XM3 40 : XP=XP3 41 : DELTAM=(1.D0-XL3)*DELTAM 42 : DELTAP=(1.D0-XL3)*DELTAP 43 : RETURN 44 : ENDIF 45 : END 46 :
© Cast3M 2003 - All rights reserved.
Disclaimer