1 : C TRACTT SOURCE CHAT 05/01/13 03:44:25 5004 2 : 3 : SUBROUTINE TRACTT(COURB,NPTEUR,TRAC,NCOURB,NC,NNFUS,T) 4 : C 5 : C 6 : C--------------------------------------------------------------------- 7 : C Objet: 8 : C ----- 9 : C Ce sous-programme determine la courbe de traction a la temp.T 10 : C a partir de celles aux temperatures TINF et TSUP qui encadrent 11 : C T.Il utilise le sous-programme FUSION qui effectue la fusion 12 : C des 2 courbes de traction definies aux temperatures TINF et 13 : C TSUP,TINF < T < TSUP. 14 : C--------------------------------------------------------------------- 15 : C 16 : C--------------------------------------------------------------------- 17 : C Entrees: 18 : C ------- 19 : C NPTEUR(NC) = tableau contenant les nombres de points de discretisation 20 : C pour chaque courbe a T fixee. 21 : C Ex: si NPTEUR(1)=20 alors pour la valeur T=T1 la fonction 22 : C Y=F(X,T1) est discretisee sur 20 points. 23 : C NC = nombre de courbes connues pour T1,T2,.... 24 : C NCOURB = dimension du tableau COURB 25 : C COURB(NCOURB) = tableau contenant les courbes de traction a differentes 26 : C temperatures T1,T2,T3,... 27 : C X,T = point et parametre d'interpolation. 28 : C--------------------------------------------------------------------- 29 : C 30 : C--------------------------------------------------------------------- 31 : C Sorties: 32 : C ------- 33 : C NNFUS = dimension du tableau TRAC. 34 : C TRAC(NNFUS)= courbe de traction a la temperature T;c'est la courbe 35 : C (espp,sigma). 36 : C--------------------------------------------------------------------- 37 : C 38 : IMPLICIT INTEGER(I-N) 39 : IMPLICIT REAL*8(A-H,O-Z) 40 : DIMENSION NPTEUR(*),COURB(*),COURB1(260),COURB2(260) 41 : DIMENSION FUS1(520),FUS2(520),TRAC(*) 42 : 43 : EPS1 = 1.D-8 44 : 45 : C 46 : C-------------------------------------- 47 : C Courbe independante de la temperature 48 : C-------------------------------------- 49 : IF (NC.EQ.1) THEN 50 : TINF=T 51 : TSUP=T 52 : LTINF=0 53 : LTSUP=0 54 : NPTINF=NPTEUR(1) 55 : NPTSUP=NPTEUR(1) 56 : GOTO 100 57 : ENDIF 58 : C 59 : C------------------------------------------------------ 60 : C Recherche des temperatures extremes connues TMIN,TMAX 61 : C------------------------------------------------------ 62 : TMIN=COURB(1) 63 : KT=0 64 : DO 5 I=1,NC-1 65 : 5 KT=KT+NPTEUR(I) 66 : KT=2*KT 67 : KT=KT+NC 68 : TMAX=COURB(KT) 69 : C 70 : C--------------------------------------------------------------------- 71 : C T plus petit que la plus petite des temperatures ou plus grande que 72 : C la plus grande des temperatures 73 : C--------------------------------------------------------------------- 74 : IF (T.LT.TMIN) THEN 75 : TINF=T 76 : TSUP=T 77 : LTINF=1 78 : LTSUP=1 79 : NPTINF=NPTEUR(1) 80 : NPTSUP=NPTEUR(1) 81 : GOTO 100 82 : ENDIF 83 : IF (T.GT.TMAX) THEN 84 : TINF=T 85 : TSUP=T 86 : LTINF=KT 87 : LTSUP=KT 88 : NPTINF=NPTEUR(NC) 89 : NPTSUP=NPTEUR(NC) 90 : GOTO 100 91 : ENDIF 92 : C 93 : C--------------------------------------------------------------------- 94 : C Recherche de l'intervalle de temperature [TINF,TSUP] comprenant T 95 : C--------------------------------------------------------------------- 96 : I=1 97 : KC=1 98 : 30 CONTINUE 99 : NPTINF=NPTEUR(KC) 100 : IF ( T.LT.COURB(I+2*NPTINF+1) ) THEN 101 : LTINF=I 102 : LTSUP=I+2*NPTINF+1 103 : TINF=COURB(LTINF) 104 : TSUP=COURB(LTSUP) 105 : NPTSUP=NPTEUR(KC+1) 106 : GOTO 100 107 : ELSE 108 : I=I+2*NPTINF+1 109 : KC=KC+1 110 : GOTO 30 111 : ENDIF 112 : C 113 : 100 CONTINUE 114 : C 115 : C-------------------------------------------------------------------- 116 : C Sauvegarde des courbes de F(X,T) pour TINF et TSUP 117 : C-------------------------------------------------------------------- 118 : N1=2*NPTINF 119 : DO 50 J=1,N1 120 : 50 COURB1(J)=COURB(J+LTINF) 121 : C 122 : N2=2*NPTSUP 123 : DO 60 J=1,N2 124 : 60 COURB2(J)=COURB(J+LTSUP) 125 : C 126 : C--------------------------------------------------------------------- 127 : C calcul des courbes de F(X,TINF) et de F(X,TSUP) pour les abscisses 128 : C completes i.e. pour la reunion des abscisses moins leur intersection 129 : C---------------------------------------------------------------------- 129 : CALL FUS(COURB1,COURB2,FUS1,FUS2,NPTINF,NPTSUP,NFUS) 130 : C 131 : C---------------------------------------------------------------------- 132 : C Les courbes de F(X,TINF) et de F(X,TSUP) ayant maintenant les memes 133 : C abscisses,on pretend la chose suivante : 134 : C si l'on a la relation T=(1-teta)TINF+(teta)TSUP , alors on ecrit 135 : C F(X,T) = (1-TETA)F(X,TINF) + (TETA)F(X,TSUP) 136 : C---------------------------------------------------------------------- 137 : IF (TINF.EQ.TSUP) THEN 138 : TETA=0. 139 : ELSE 140 : TETA=(T-TINF)/(TSUP-TINF) 141 : ENDIF 142 : DO 88 M=1,2*NFUS-1,2 143 : TRAC(M)=FUS1(M) 144 : TRAC(M+1)=(1-TETA)*FUS1(M+1)+TETA*FUS2(M+1) 145 : 88 CONTINUE 146 : 147 : C 148 : C--------------------------------------------------------------------- 149 : C determination de la courbe (epsp,sigma) à T à partir de la courbe 150 : C (eps,sigma) à T 151 : C--------------------------------------------------------------------- 152 : 153 : DE=TRAC(4)/TRAC(3) 154 : NNFUS=NFUS-1 155 : DO 27 I=1,2*NNFUS-1,2 156 : TRAC(I)=TRAC(I+2)-TRAC(I+3)/DE 157 : TRAC(I+1)=TRAC(I+3) 158 : 27 CONTINUE 159 : 160 : C Suppression des doublons 161 : 162 : I1 = 1 163 : 29 CONTINUE 164 : IF (I1.GE.NNFUS) GOTO 31 165 : XI = ABS(TRAC(I1) - TRAC(I1+2)) 166 : EPS2 = (ABS ( MIN(TRAC(I1),TRAC(I1+2)) ))*EPS1 167 : IF ( (XI.LE.EPS2) .OR. 168 : * ( (TRAC(I1).LE.EPS1).AND.(TRAC(I1+2).LE.EPS1))) THEN 169 : DO 28 I=I1,2*NNFUS-1,2 170 : TRAC(I)=TRAC(I+2) 171 : TRAC(I+1)=TRAC(I+3) 172 : 28 CONTINUE 173 : NNFUS=NNFUS - 1 174 : ELSE 175 : I1 = I1 + 2 176 : ENDIF 177 : GOTO 29 178 : 31 CONTINUE 179 : 180 : C Mise à zero du premier point si necessaire 181 : 182 : TRAC(1)=0.D0 183 : C 184 : END 185 : C********************************************************************* 186 : 187 : 188 :
© Cast3M 2003 - All rights reserved.
Disclaimer