Download fus.eso
Back to the list
1 : C FUS SOURCE CHAT 05/01/13 00:12:27 5004
2 :
3 : SUBROUTINE FUS(TRAC1,TRAC2,FUS1,FUS2,N1,N2,NFUS)
4 : C
5 : C-------------------------------------------------------------------------
6 : C Objet:fusion de deux tableaux de reels de la forme (X1,F(X1),X2,F(X2),...)
7 : C et (Y1,G(Y1),Y2,G(Y2),....);ils contiennent en fait les points de
8 : C 2 courbes de traction definies aux 2 temperatures TINF et TSUP
9 : C encadrant la temperature T,pour laquelle on veut determiner la
10 : C courbe de traction.
11 : C---------------------------------------------------------------------------
12 : C
13 : C---------------------------------------------------------------------------
14 : C Entrees:
15 : C -------
16 : C N1 = nbre de points de la courbe de traction a la temperature TINF.
17 : C TRAC1(N1) = tableau de dimension 2N1 de la forme (X1,F(X1),X2,F(X2),..)
18 : C contenant les points de la courbe de traction a la temperature
19 : C TINF.
20 : C N2 = nbre de points de la courbe de traction a la temperature TSUP.
21 : C TRAC2(N2) = tableau de dimension 2N2 de la forme (Y1,G(Y1),Y2,G(Y2),..)
22 : C contenant les points de la courbe de traction a la temperature
23 : C TSUP.
24 : C---------------------------------------------------------------------------
25 : C
26 : C---------------------------------------------------------------------------
27 : C Sorties:
28 : C -------
29 : C NFUS
30 : C FUS1 = tableau contenant les abscisses completes dans l'ordre croissant
31 : C (i.e. X1,X2,... et Y1,Y2,...) et pour chacune d'elles la valeur
32 : C de la fonction F.
33 : C FUS2 = tableau contenant les abscisses completes dans l'ordre croissant
34 : C (i.e. X1,X2,... et Y1,Y2,...) et pour chacune d'elles la valeur
35 : C de la fonction G.
36 : C---------------------------------------------------------------------------
37 : C
38 : IMPLICIT INTEGER(I-N)
39 : IMPLICIT REAL*8 (A-H,O-Z)
40 : DIMENSION TRAC1(*),TRAC2(*),FUS1(*),FUS2(*)
41 : C
42 : C----------------------------------------------------------------------
43 : C on commence par determiner la dimension des tableaux finaux FUS1 et FUS2
44 : C------------------------------------------------------------------------
45 : NFUS=N1+N2
46 : DO 1 I1=1,2*N1-1,2
47 : DO 2 I2=1,2*N2-1,2
48 : IF (TRAC1(I1).EQ.TRAC2(I2)) THEN
49 : NFUS=NFUS-1
50 : ENDIF
51 : 2 CONTINUE
52 : 1 CONTINUE
53 : C
54 : I1=1
55 : I2=1
56 : I=1
57 : 100 CONTINUE
58 : C-----------------------------------------------------------------
59 : C tant que l'on ne depasse pas la limite des tableaux ...
60 : C-----------------------------------------------------------------
61 : DO WHILE ((I1.LE.(2*N1-1)).AND.(I2.LE.(2*N2-1)))
62 : C
63 : C------------------------------------------------------------------------
64 : C si l'element du tableau1 ,sur lequel on pointe, est < a l'element du
65 : C tableau2 sur lequel on pointe,on remplit FUS1 avec le plus petit des
66 : C elements sur lesquels on pointe suivi de la valeur de la fonction F
67 : C en ce point;on procede de meme avec FUS2 en le remplissant avec le plus
68 : C petit element suivi de la valeur de la fonction G en ce point;
69 : C le sous-programme DERTRA est ainsi utilise pour calculer la valeur de la
70 : C fonction F ou G aux points ou elles ne sont pas connues
71 : C------------------------------------------------------------------------
72 : IF (TRAC1(I1).LT.TRAC2(I2)) THEN
73 : FUS1(I)=TRAC1(I1)
74 : FUS1(I+1)=TRAC1(I1+1)
75 : FUS2(I)=TRAC1(I1)
76 : IF (TRAC1(I1).LT.TRAC2(1)) THEN
77 : X=TRAC2(1)
77 : CALL DERTRA(2*N2,TRAC2,X,Y,YPRIM,XINF,XSUP)
78 : WRITE(*,*) 'T1DERTRA(2*N2,TRAC2,X,Y,YPRIM,XINF,XSUP)
82 : FUS2(I+1)=Y
83 : ENDIF
84 : I=I+2
85 : I1=I1+2
86 :
87 :
88 : ELSEIF (TRAC1(I1).GT.TRAC2(I2)) THEN
89 :
90 : FUS1(I)=TRAC2(I2)
91 : FUS2(I)=TRAC2(I2)
92 : FUS2(I+1)=TRAC2(I2+1)
93 : IF (TRAC2(I2).LT.TRAC1(1)) THEN
94 : X=TRAC1(1)
94 : CALL DERTRA(2*N1,TRAC1,X,Y,YPRIM,XINF,XSUP)
95 : WRITE(*,*) 'T1>T2',I,X,Y,YPRIM
96 : FUS1(I+1)=YPRIM*(TRAC2(I2)-X)+TRAC1(I1+1)
97 : ELSE
98 : X=TRAC2(I2)
98 : CALL DERTRA(2*N1,TRAC1,X,Y,YPRIM,XINF,XSUP)
99 : FUS1(I+1)=Y
100 : ENDIF
101 : I=I+2
102 : I2=I2+2
103 :
104 : ELSEIF (TRAC1(I1).EQ.TRAC2(I2)) THEN
105 : FUS1(I)=TRAC1(I1)
106 : FUS1(I+1)=TRAC1(I1+1)
107 : FUS2(I)=TRAC2(I2)
108 : FUS2(I+1)=TRAC2(I2+1)
109 :
110 :
111 : I1=I1+2
112 : I2=I2+2
113 : I=I+2
114 :
115 : ENDIF
116 : ENDDO
117 : C
118 : IF (I1.GT.(2*N1-1)) THEN
119 : DO 10 K=I2,2*N2,2
120 : II1=(I-1)
121 : FUS2(I)=TRAC2(K)
122 : FUS2(I+1)=TRAC2(K+1)
123 : FUS1(I)=TRAC2(K)
124 : X=FUS1(I-2)
124 : CALL DERTRA(II1,FUS1,X,Y,YPRIM,XINF,XSUP)
125 : FUS1(I+1)=YPRIM*(FUS2(I)-X)+FUS1(I-1)
126 : I=I+2
127 :
128 : 10 CONTINUE
129 :
130 : ELSEIF (I2.GT.(2*N2)) THEN
131 : DO 20 K=I1,2*N1,2
132 : II1=(I-1)
133 : FUS1(I)=TRAC1(K)
134 : FUS1(I+1)=TRAC1(K+1)
135 : FUS2(I)=TRAC1(K)
136 : X=FUS2(I-2)
136 : CALL DERTRA(II1,FUS2,X,Y,YPRIM,XINF,XSUP)
137 : FUS2(I+1)=YPRIM*(FUS1(I)-X)+FUS2(I-1)
138 : I=I+2
139 :
140 : 20 CONTINUE
141 :
142 :
143 : ENDIF
144 : RETURN
145 : END
146 : ************************************************************************
147 :