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