Sources Esope | Cast3M

fus
C FUS       SOURCE    CHAT      05/01/13    00:12:27     5004
 
      SUBROUTINE FUS(TRAC1,TRAC2,FUS1,FUS2,N1,N2,NFUS)
C
C-------------------------------------------------------------------------
C Objet:fusion de deux tableaux de reels de la forme (X1,F(X1),X2,F(X2),...)
C       et (Y1,G(Y1),Y2,G(Y2),....);ils contiennent en fait les points de
C       2 courbes de traction definies aux 2 temperatures TINF et TSUP
C       encadrant la temperature T,pour laquelle on veut determiner la
C       courbe de traction.
C---------------------------------------------------------------------------
C
C---------------------------------------------------------------------------
C Entrees:
C -------
C N1        = nbre de points de la courbe de traction a la temperature TINF.
C TRAC1(N1) = tableau de dimension 2N1 de la forme (X1,F(X1),X2,F(X2),..)
C             contenant les points de la courbe de traction a la temperature
C             TINF.
C N2        = nbre de points de la courbe de traction a la temperature TSUP.
C TRAC2(N2) = tableau de dimension 2N2 de la forme (Y1,G(Y1),Y2,G(Y2),..)
C             contenant les points de la courbe de traction a la temperature
C             TSUP.
C---------------------------------------------------------------------------
C
C---------------------------------------------------------------------------
C Sorties:
C -------
C NFUS
C FUS1      = tableau contenant les abscisses completes dans l'ordre croissant
C             (i.e. X1,X2,... et Y1,Y2,...) et pour chacune d'elles la valeur
C             de la fonction F.
C FUS2      = tableau contenant les abscisses completes dans l'ordre croissant
C             (i.e. X1,X2,... et Y1,Y2,...) et pour chacune d'elles la valeur
C             de la fonction G.
C---------------------------------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION TRAC1(*),TRAC2(*),FUS1(*),FUS2(*)
C
C----------------------------------------------------------------------
C on commence par determiner la dimension des tableaux finaux FUS1 et FUS2
C------------------------------------------------------------------------
      NFUS=N1+N2
      DO 1 I1=1,2*N1-1,2
        DO 2 I2=1,2*N2-1,2
          IF (TRAC1(I1).EQ.TRAC2(I2)) THEN
            NFUS=NFUS-1
          ENDIF
2       CONTINUE
1     CONTINUE
C
      I1=1
      I2=1
      I=1
100   CONTINUE
C-----------------------------------------------------------------
C tant que l'on ne depasse pas la limite des tableaux ...
C-----------------------------------------------------------------
      DO WHILE ((I1.LE.(2*N1-1)).AND.(I2.LE.(2*N2-1)))
C
C------------------------------------------------------------------------
C si l'element du tableau1 ,sur lequel on pointe, est &lt; a l'element du
C tableau2 sur lequel on pointe,on remplit FUS1 avec le plus petit des
C elements sur lesquels on pointe suivi de la valeur de la fonction F
C en ce point;on procede de meme avec FUS2 en le remplissant avec le plus
C petit element suivi de la valeur de la fonction G en ce point;
C le sous-programme DERTRA est ainsi utilise pour calculer la valeur de la
C fonction F ou G aux points ou elles ne sont pas connues
C------------------------------------------------------------------------
         IF (TRAC1(I1).LT.TRAC2(I2)) THEN
            FUS1(I)=TRAC1(I1)
            FUS1(I+1)=TRAC1(I1+1)
            FUS2(I)=TRAC1(I1)
            IF (TRAC1(I1).LT.TRAC2(1)) THEN
               X=TRAC2(1)
               CALL DERTRA(2*N2,TRAC2,X,Y,YPRIM,XINF,XSUP)
               WRITE(*,*)  'T1&lt;T2',I,X,Y,YPRIM
               FUS2(I+1)=YPRIM*(TRAC1(I1)-X)+TRAC2(I2+1)
            ELSE
               X=TRAC1(I1)
               CALL DERTRA(2*N2,TRAC2,X,Y,YPRIM,XINF,XSUP)
               FUS2(I+1)=Y
            ENDIF
            I=I+2
            I1=I1+2
 
 
            ELSEIF (TRAC1(I1).GT.TRAC2(I2)) THEN
 
              FUS1(I)=TRAC2(I2)
              FUS2(I)=TRAC2(I2)
              FUS2(I+1)=TRAC2(I2+1)
              IF (TRAC2(I2).LT.TRAC1(1)) THEN
                 X=TRAC1(1)
                 CALL DERTRA(2*N1,TRAC1,X,Y,YPRIM,XINF,XSUP)
                 WRITE(*,*) 'T1>T2',I,X,Y,YPRIM
                 FUS1(I+1)=YPRIM*(TRAC2(I2)-X)+TRAC1(I1+1)
              ELSE
                 X=TRAC2(I2)
                 CALL DERTRA(2*N1,TRAC1,X,Y,YPRIM,XINF,XSUP)
                 FUS1(I+1)=Y
              ENDIF
              I=I+2
              I2=I2+2
 
           ELSEIF (TRAC1(I1).EQ.TRAC2(I2)) THEN
              FUS1(I)=TRAC1(I1)
              FUS1(I+1)=TRAC1(I1+1)
              FUS2(I)=TRAC2(I2)
              FUS2(I+1)=TRAC2(I2+1)
 
 
              I1=I1+2
              I2=I2+2
              I=I+2
 
           ENDIF
      ENDDO
C
      IF (I1.GT.(2*N1-1)) THEN
           DO 10 K=I2,2*N2,2
              II1=(I-1)
              FUS2(I)=TRAC2(K)
              FUS2(I+1)=TRAC2(K+1)
              FUS1(I)=TRAC2(K)
              X=FUS1(I-2)
              CALL DERTRA(II1,FUS1,X,Y,YPRIM,XINF,XSUP)
              FUS1(I+1)=YPRIM*(FUS2(I)-X)+FUS1(I-1)
              I=I+2
 
10         CONTINUE
 
        ELSEIF (I2.GT.(2*N2)) THEN
           DO 20 K=I1,2*N1,2
              II1=(I-1)
              FUS1(I)=TRAC1(K)
              FUS1(I+1)=TRAC1(K+1)
              FUS2(I)=TRAC1(K)
              X=FUS2(I-2)
              CALL DERTRA(II1,FUS2,X,Y,YPRIM,XINF,XSUP)
              FUS2(I+1)=YPRIM*(FUS1(I)-X)+FUS2(I-1)
              I=I+2
 
20         CONTINUE
 
 
        ENDIF
        RETURN
        END
************************************************************************