1 : C TUFIPA SOURCE CHAT 05/01/13 03:56:03 5004 2 : SUBROUTINE TUFIPA(XM,XP,DELTAM,DELTAP,THETA0,XJP,EP,FIP, 3 : $ DL1,DL2,PRECIS,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN,KERRE,THETA 4 : $ ) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : C====================================================================== 8 : C CE SOUS-PROGRAMME PILOTE L ECOULEMENT PLASTIQUE SANS 9 : C PROPAGATION POUR L ELEMENT TUYAU FISSURE 10 : C IL EST APPELE PAR TUFIPL 11 : C 12 : C ENTREES : XM,XP POINT SUR LA SURFACE DE CHARGE 13 : C DELTAM,DELTAP INCREMENT ELASTIQUE 14 : C THETA ANGLE DE LA FISSURE 15 : C XJP VALEUR DE JP AU DEBUT 16 : C 17 : C SORTIES : XM,XP CONTRAINTES A LA FIN 18 : C DELTAM,DELTAP CE QUI RESTE A ECOULER 19 : C XJP VALEUR DE JP A LA FIN 20 : C EP,FIP INCREMENT DE DEFORMATIONS PLASTIQUES 21 : C DL1,DL2 INCREMENT DE LAMBDA 22 : C======================================================================= 23 : -INC CCREEL 24 : -INC CCOPTIO 25 : SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D) 26 : XMS=XM 27 : XPS=XP 28 : DMS=DELTAM 29 : DPS=DELTAP 30 : XJPS=XJP 31 : IF(IIMPI.EQ.999) WRITE (IOIMP,*)'ENTREE DANS TUFIPA' 32 : C 33 : C ON CHERCHE OU L ON VA ECOULER 34 : C 34 : CALL TUFINO(XM,XP,THETA0,IRET,XM0,XP0) 35 : C 36 : C ON REALISE L ECOULEMENT 37 : C 37 : CALL TUFIEC(XM,XP,DELTAM,DELTAP,THETA,XJP,EP,FIP, 38 : $ DL1,DL2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN, 39 : $ THETA0,KERRE) 40 : IF(KERRE.NE.0) RETURN 41 : C 42 : C ON VERIFIE OU ON ARRIVE 43 : C 43 : CALL TUFINO(XM,XP,THETA0,IR1,XM0,XP0) 44 : IF(IRET.EQ.IR1) THEN 45 : IF(IIMPI.EQ.999) WRITE (IOIMP,*)'SORTIE DE TUFIPA' 46 : DELTAM=0.D0 47 : DELTAP=0.D0 48 : RETURN 49 : ENDIF 50 : C 51 : C ON EST ALLE TROP LOIN ET ON CHERCHE LA PARTIE DE 52 : C L INCREMENT QUI NOUS RAMENE SUR LA POINTE 53 : C 54 : IF(IRET.EQ.1) THEN 55 : GOTO 1 56 : ELSE 57 : GOTO 2 58 : ENDIF 59 : C 60 : C 61 : 1 CONTINUE 62 : XMU1=0.5D0 63 : XMU2=1.0D0 64 : XM1=XMS 65 : XP1=XPS 66 : DM1=XMU1*DMS 67 : DP1=XMU1*DPS 67 : CALL TUFIEC(XM1,XP1,DM1,DP1,THETA0,XJPS,EP,FIP, 68 : $ DL1,DL2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN, 69 : $ THETA0,KERRE) 70 : IF(KERRE.NE.0) RETURN 71 : F1=TUFP2(XM1,XP1,THETA0,XM0,XP0) 72 : F2=TUFP2(XM,XP,THETA0,XM0,XP0) 73 : TEST=F1*F2 74 : IF(TEST.GT.XZERO) THEN 75 : F2=F1 76 : F1=TUFP2(XMS,XPS,THETA0,XM0,XP0) 77 : XMU1=0.D0 78 : XMU2=0.5D0 79 : ENDIF 80 : 10 CONTINUE 81 : FP=(F2-F1)/(XMU2-XMU1) 82 : XMU3=XMU2-F2/FP 83 : IF (IIMPI.EQ.999) WRITE(IOIMP,*)'MU',XMU3 84 : XM3=XMS 85 : XP3=XPS 86 : DM3=XMU3*DMS 87 : DP3=XMU3*DPS 87 : CALL TUFIEC(XM3,XP3,DM3,DP3,THETA0,XJPS,EP,FIP, 88 : $ DL1,DL2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN, 89 : $ THETA0,KERRE) 90 : IF(KERRE.NE.0) RETURN 91 : F3=TUFP2(XM3,XP3,THETA0,XM0,XP0) 92 : CRU=ABS((XMU3-XMU2)/XMU2) 93 : CRI=ABS(F3) 94 : IF(CRI.GE.PRECIS.OR.CRU.GE.PRECIS) THEN 95 : XMU1=XMU2 96 : XMU2=XMU3 97 : F1=F2 98 : F2=F3 99 : GO TO 10 100 : ELSE 101 : XJP=XJPS 102 : IF(XP3.GE.XZERO) THEN 103 : XP=XP0*(1.D0-THETA0/XPI) 104 : XM=-XM0*SIN(THETA0)/2.D0 105 : IF(IIMPI.EQ.999) WRITE(IOIMP,*)'P ET M A LA POINTE',XP,XM 106 : ELSE 107 : XP=-XP0*(1.D0-THETA0/XPI) 108 : XM=XM0*SIN(THETA0)/2.D0 109 : IF(IIMPI.EQ.999) WRITE(IOIMP,*)'P ET M A LA POINTE',XP,XM 110 : ENDIF 111 : DELTAM=(1.D0-XMU3)*DMS 112 : DELTAP=(1.D0-XMU3)*DPS 113 : IF(IIMPI.EQ.999)WRITE (IOIMP,*)'SORTIE DE TUFIPA' 114 : RETURN 115 : ENDIF 116 : C 117 : 2 CONTINUE 118 : XMU1=0.5D0 119 : XMU2=1.0D0 120 : XM1=XMS 121 : XP1=XPS 122 : DM1=XMU1*DMS 123 : DP1=XMU1*DPS 123 : CALL TUFIEC(XM1,XP1,DM1,DP1,THETA0,XJPS,EP,FIP, 124 : $ DL1,DL2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN, 125 : $ THETA0,KERRE) 126 : IF(KERRE.NE.0) RETURN 127 : F1=TUFP1(XM1,XP1,THETA0,XM0,XP0) 128 : F2=TUFP1(XM,XP,THETA0,XM0,XP0) 129 : TEST=F1*F2 130 : IF(TEST.GT.XZERO) THEN 131 : F2=F1 132 : F1=TUFP1(XMS,XPS,THETA0,XM0,XP0) 133 : XMU1=0.D0 134 : XMU2=0.5D0 135 : ENDIF 136 : 20 CONTINUE 137 : FP=(F2-F1)/(XMU2-XMU1) 138 : XMU3=XMU2-F2/FP 139 : IF (IIMPI.EQ.999) WRITE(IOIMP,*)'MU',XMU3 140 : XM3=XMS 141 : XP3=XPS 142 : DM3=XMU3*DMS 143 : DP3=XMU3*DPS 143 : CALL TUFIEC(XM3,XP3,DM3,DP3,THETA0,XJPS,EP,FIP, 144 : $ DL1,DL2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN, 145 : $ THETA0,KERRE) 146 : IF(KERRE.NE.0) RETURN 147 : F3=TUFP1(XM3,XP3,THETA0,XM0,XP0) 148 : CRI=ABS(F3) 149 : CRU=ABS((XMU3-XMU2)/XMU2) 150 : IF(CRI.GE.PRECIS.OR.CRU.GE.PRECIS) THEN 151 : XMU1=XMU2 152 : XMU2=XMU3 153 : F1=F2 154 : F2=F3 155 : GO TO 20 156 : ELSE 157 : XJP=XJPS 158 : IF(XP3.GE.XZERO) THEN 159 : XP=XP0*(1.D0-THETA0/XPI) 160 : XM=-XM0*SIN(THETA0)/2.D0 161 : IF(IIMPI.EQ.999) WRITE(IOIMP,*)'P ET M A LA POINTE',XP,XM 162 : ELSE 163 : XP=-XP0*(1.D0-THETA0/XPI) 164 : XM=XM0*SIN(THETA0)/2.D0 165 : IF(IIMPI.EQ.999) WRITE(IOIMP,*)'P ET M A LA POINTE',XP,XM 166 : ENDIF 167 : DELTAM=(1.D0-XMU3)*DMS 168 : DELTAP=(1.D0-XMU3)*DPS 169 : IF(IIMPI.EQ.999) WRITE(IOIMP,*)'SORTIE DE TUFIPA' 170 : RETURN 171 : ENDIF 172 : END 173 : 174 : 175 : 176 : 177 :
© Cast3M 2003 - All rights reserved.
Disclaimer