Download mcopy.eso

Back to the list

   1 : C MCOPY     SOURCE    MAGN      09/07/30    21:19:17     6458           
   2 :       SUBROUTINE MCOPY(M1,M2)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : 
   6 : C     *******************************
   7 : C     * Routine de copie de MATRIK  *
   8 : C     * M1 : entree                 *
   9 : C     * M2 : Sortie                 *
  10 : C     *     M2 = M1                 *
  11 : C     *******************************
  12 : 
  13 : -INC SMMATRIK
  14 :       POINTEUR M1.MATRIK,M2.MATRIK,IMAT.IMATRI
  15 : 
  16 :       SEGACT M1
  17 :       NMATRI=M1.IRIGEL(/2)
  18 :       NRIGE=7
  19 :       NKID=9
  20 :       NKMT=7
  21 :       SEGINI M2
  22 : 
  23 :       DO IMATE = 1, NMATRI, 1
  24 : C     On copie tout IRIGEL
  24 :          CALL RSETI(M2.IRIGEL(1,IMATE),M1.IRIGEL(1,IMATE),7)
  25 :          IMATRI=M1.IRIGEL(4,IMATE)
  26 :          SEGACT IMATRI
  27 : 
  28 :          IF (M1.IRIGEL(5,IMATE).NE.0) THEN
  29 : C     Si la matrice est en morse, on recopie les PMORS et IZA
  30 : C     dans PMS1 et IZA1 pour M2
  31 :             PMORS=M1.IRIGEL(5,IMATE)
  32 :             IZA=M1.IRIGEL(6,IMATE)
  33 :             SEGACT PMORS
  34 :             SEGACT IZA
  35 :             NTT=IA(/1)-1
  36 :             NJA=JA(/1)
  37 :             NBVA=A(/1)
  38 : 
  39 :             SEGINI PMS1,IZA1
  40 : 
  41 :             DO I=1,NTT+1
  42 :                PMS1.IA(I)=IA(I)
  43 :             END DO
  44 :             
  45 :             DO I=1,NBVA
  46 :                IZA1.A(I)=A(I)
  47 :                PMS1.JA(I)=JA(I)
  48 :             END DO
  49 : 
  50 :             M2.IRIGEL(5,IMATE)=PMS1
  51 :             M2.IRIGEL(6,IMATE)=IZA1
  52 :             SEGDES PMORS,PMS1
  53 :             SEGDES IZA,IZA1
  54 :          END IF
  55 :          NBSOUS=LIZAFM(/1)
  56 :          NBME=LIZAFM(/2)
  57 : 
  58 : C     On initialise le segment IMAT pour M2
  59 :          SEGINI IMAT
  60 :          DO I=1,NBME
  61 :             IMAT.LISPRI(I) = LISPRI(I)
  62 :             IMAT.LISDUA(I) = LISDUA(I)
  63 :             DO J=1,NBSOUS
  64 :                IZAFM=LIZAFM(J,I)
  65 : C     Si la matrice est pas uniquement morse, on recopie
  66 : C     les IZAFM de M1 dans M2
  67 :                IF (IZAFM.NE.0) THEN
  68 :                   SEGACT IZAFM
  69 :                   NBEL=AM(/1)
  70 :                   NP=AM(/2)
  71 :                   MP=AM(/3)
  72 :                   SEGINI IPM1
  73 :                   DO K=1,NBEL
  74 :                      DO L=1,NP
  75 :                         DO M=1,MP
  76 :                            IPM1.AM(K,L,M)=AM(K,L,M)
  77 :                         END DO
  78 :                      END DO
  79 :                   END DO
  80 :                   IMAT.LIZAFM(J,I)=IPM1
  81 :                   SEGDES IPM1
  82 :                   SEGDES IZAFM
  83 :                END IF   
  84 :             END DO
  85 :          END DO
  86 : 
  87 : C     On ajuste ce qui reste du segment MATRIK
  88 :          IMAT.KSPGP= KSPGP
  89 :          IMAT.KSPGD= KSPGD
  90 : 
  91 : C     On fait pointer M2 sur le bon IMATRI.
  92 :          M2.IRIGEL(4,IMATE) = IMAT
  93 :          M2.KNTTT=M1.KNTTT
  94 :          M2.KNTTP=M1.KNTTP
  95 :          M2.KNTTD=M1.KNTTD
  96 :          M2.KMINCP=M1.KMINCP
  97 :          M2.KMINCD=M1.KMINCD
  98 :       ENDDO
  99 : 
 100 :       SEGDES IMATRI,IMAT
 101 :       SEGDES M1,M2
 102 :       RETURN
 103 :       END
 104 : 
 105 :  
 106 :  
 107 :  
 108 :  

© Cast3M 2003 - All rights reserved.
Disclaimer