Télécharger la plaquette Cast3M


fr en

Télécharger mcopy.eso

Retour à la liste

Numérotation des lignes : 

mcopy

  1. C MCOPY     SOURCE    PV        20/09/26    21:18:45     10724          
  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.  
  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
  25.          CALL RSETI(M2.IRIGEL(1,IMATE),M1.IRIGEL(1,IMATE),7)
  26.          IMATRI=M1.IRIGEL(4,IMATE)
  27.          SEGACT IMATRI
  28.  
  29.          IF (M1.IRIGEL(5,IMATE).NE.0) THEN
  30. C     Si la matrice est en morse, on recopie les PMORS et IZA
  31. C     dans PMS1 et IZA1 pour M2
  32.             PMORS=M1.IRIGEL(5,IMATE)
  33.             IZA=M1.IRIGEL(6,IMATE)
  34.             SEGACT PMORS
  35.             SEGACT IZA
  36.             NTT=IA(/1)-1
  37.             NJA=JA(/1)
  38.             NBVA=A(/1)
  39.  
  40.             SEGINI PMS1,IZA1
  41.  
  42.             DO I=1,NTT+1
  43.                PMS1.IA(I)=IA(I)
  44.             END DO
  45.  
  46.             DO I=1,NBVA
  47.                IZA1.A(I)=A(I)
  48.                PMS1.JA(I)=JA(I)
  49.             END DO
  50.  
  51.             M2.IRIGEL(5,IMATE)=PMS1
  52.             M2.IRIGEL(6,IMATE)=IZA1
  53.             SEGDES PMORS,PMS1
  54.             SEGDES IZA,IZA1
  55.          END IF
  56.          NBSOUS=LIZAFM(/1)
  57.          NBME=LIZAFM(/2)
  58.  
  59. C     On initialise le segment IMAT pour M2
  60.          SEGINI IMAT
  61.          DO I=1,NBME
  62.             IMAT.LISPRI(I) = LISPRI(I)
  63.             IMAT.LISDUA(I) = LISDUA(I)
  64.             DO J=1,NBSOUS
  65.                IZAFM=LIZAFM(J,I)
  66. C     Si la matrice est pas uniquement morse, on recopie
  67. C     les IZAFM de M1 dans M2
  68.                IF (IZAFM.NE.0) THEN
  69.                   SEGACT IZAFM
  70.                   NBEL=AM(/1)
  71.                   NP=AM(/2)
  72.                   MP=AM(/3)
  73.                   SEGINI IPM1
  74.                   DO K=1,NBEL
  75.                      DO L=1,NP
  76.                         DO M=1,MP
  77.                            IPM1.AM(K,L,M)=AM(K,L,M)
  78.                         END DO
  79.                      END DO
  80.                   END DO
  81.                   IMAT.LIZAFM(J,I)=IPM1
  82.                   SEGDES IPM1
  83.                   SEGDES IZAFM
  84.                END IF
  85.             END DO
  86.          END DO
  87.  
  88. C     On ajuste ce qui reste du segment MATRIK
  89.          IMAT.KSPGP= KSPGP
  90.          IMAT.KSPGD= KSPGD
  91.  
  92. C     On fait pointer M2 sur le bon IMATRI.
  93.          M2.IRIGEL(4,IMATE) = IMAT
  94.          M2.KNTTT=M1.KNTTT
  95.          M2.KNTTP=M1.KNTTP
  96.          M2.KNTTD=M1.KNTTD
  97.          M2.KMINCP=M1.KMINCP
  98.          M2.KMINCD=M1.KMINCD
  99.       ENDDO
  100.  
  101.       SEGDES IMATRI,IMAT
  102.       SEGDES M1,M2
  103.       RETURN
  104.       END
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales