Télécharger mcopy.eso

Retour à la liste

Numérotation des lignes :

  1. C MCOPY SOURCE PV 16/11/17 22:00:42 9180
  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. POINTEUR M1.MATRIK,M2.MATRIK,IMAT.IMATRI
  14.  
  15. SEGACT M1
  16. NMATRI=M1.IRIGEL(/2)
  17. NRIGE=7
  18. NKID=9
  19. NKMT=7
  20. SEGINI M2
  21.  
  22. DO IMATE = 1, NMATRI, 1
  23. 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.  
  109.  
  110.  
  111.  

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