Download fusmtk.eso

Back to the list

   1 : C FUSMTK    SOURCE    MAGN      09/07/30    21:17:01     6458           
   2 :       SUBROUTINE FUSMTK(IP1,IP2,MATRIK)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : -INC SMMATRIK
   6 :       POINTEUR IP1.MATRIK,IP2.MATRIK
   7 :       POINTEUR IMATR1.MATRIK
   8 :       POINTEUR IMATR2.MATRIK
   9 :       SEGACT IP1
  10 :       SEGACT IP2
  11 :       N1=IP1.IRIGEL(/2)
  12 :       N2=IP2.IRIGEL(/2)
  13 :       NMATRI=N1+N2
  14 :       NRIGE=7
  15 :       NKID =9
  16 :       NKMT =7
  17 :       SEGINI MATRIK
  18 : * Copie des IRIGEL de l'un dans l'autre
  19 :       DO 1 I=1,N1
  19 :          CALL RSETI(IRIGEL(1,I),IP1.IRIGEL(1,I),7)
  20 :  1    CONTINUE
  21 :       DO 2 I=1,N2
  21 :          CALL RSETI(IRIGEL(1,N1+I),IP2.IRIGEL(1,I),7)
  22 :  2    CONTINUE
  23 : * On effectue une copie des segments IMATRI car ils pointent sur
  24 : * d'autres objets élémentaires (les valeurs des matrices élémentaires)
  25 :       DO 3 I=1,N1
  26 :          IMATR1=IP1.IRIGEL(4,I)
  27 :          SEGINI,IMATR2=IMATR1
  28 :          SEGDES IMATR2
  29 :          IRIGEL(4,I)=IMATR2
  30 :  3    CONTINUE
  31 :       DO 4 I=1,N2
  32 :          IMATR1=IP2.IRIGEL(4,I)
  33 :          SEGINI,IMATR2=IMATR1
  34 :          SEGDES IMATR2
  35 :          IRIGEL(4,N1+I)=IMATR2
  36 :  4    CONTINUE
  37 :       SEGDES MATRIK
  38 :       SEGDES IP2
  39 :       SEGDES IP1
  40 :       RETURN
  41 :       END
  42 :  
  43 :  
  44 :  
  45 :  
  46 :  
  47 :  

© Cast3M 2003 - All rights reserved.
Disclaimer