Télécharger kopdik.eso

Retour à la liste

Numérotation des lignes :

  1. C KOPDIK SOURCE PV 16/11/17 22:00:15 9180
  2. SUBROUTINE KOPDIK(MCHPOI,MATRIK)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : KOPDIK
  7. C DESCRIPTION : Transforme un CHPOINt MCHPOI en matrice
  8. C diagonale MATRIK
  9. C
  10. C
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C ENTREES : MCHPOI
  17. C ENTREES/SORTIES :
  18. C SORTIES : MATRIK
  19. C***********************************************************************
  20. C VERSION : v1, 10/05/2011, version initiale
  21. C HISTORIQUE : v1, 10/05/2011, création
  22. C HISTORIQUE :
  23. C HISTORIQUE :
  24. C***********************************************************************
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMCHPOI
  28. -INC SMELEME
  29. *
  30. * Executable statements
  31. *
  32. SEGACT MCHPOI
  33. NSOUPO = IPCHP(/1)
  34. NRIGE = 7
  35. NMATRI = NSOUPO
  36. NKID = 9
  37. NKMT = 7
  38. SEGINI MATRIK
  39. C
  40. DO ISOUPO = 1, NSOUPO
  41. MSOUPO = IPCHP(ISOUPO)
  42. SEGACT MSOUPO
  43. NC=NOCOMP(/2)
  44. NBME=NC
  45. NBSOUS=1
  46. SEGINI IMATRI
  47. IRIGEL(4,ISOUPO)=IMATRI
  48. MELEME=IGEOC
  49. MPOVAL=IPOVAL
  50. SEGACT MPOVAL
  51. IRIGEL(1,ISOUPO)=MELEME
  52. IRIGEL(2,ISOUPO)=MELEME
  53. * Diagonal
  54. IRIGEL(7,ISOUPO)=5
  55. SEGACT MELEME
  56. NBEL=NUM(/2)
  57. SEGDES MELEME
  58. NP=1
  59. MP=1
  60. DO IC=1,NC
  61. LISPRI(IC)=NOCOMP(IC)//' '
  62. LISDUA(IC)=NOCOMP(IC)//' '
  63. SEGINI IZAFM
  64. LIZAFM(1,IC)=IZAFM
  65. DO IBEL=1,NBEL
  66. AM(IBEL,1,1)=VPOCHA(IBEL,IC)
  67. ENDDO
  68. SEGDES IZAFM
  69. ENDDO
  70. SEGDES MPOVAL
  71. SEGDES IMATRI
  72. SEGDES MSOUPO
  73. ENDDO
  74. SEGDES MATRIK
  75. SEGDES MCHPOI
  76. *
  77. * Normal termination
  78. *
  79. RETURN
  80. *
  81. * End of subroutine KOPDIK
  82. *
  83. END
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  

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