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