Download kopdik.eso

Back to the list

   1 : C KOPDIK    SOURCE    GOUNAND   11/05/25    21:15:16     6980           
   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 CCOPTIO
  26 : -INC SMMATRIK
  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 :  

© Cast3M 2003 - All rights reserved.
Disclaimer