1 : C XMNG6 SOURCE PV 10/06/16 21:15:08 6693 2 : SUBROUTINE XMNG6(ILISSE,ITLACC,ISLIS) 3 : * 4 : IMPLICIT INTEGER(I-N) 5 : DIMENSION LIDMAT(10),LKMMT(10) 6 : * 7 : * 8 : SEGMENT ISLIS(NP) 9 : * SEGMENT IBLIS(ISLIS(/1)) 10 : * SEGMENT BIDON POUR REMPLACER LES TROP NOMBREUSES 11 : * DECLARATION 12 : * SEGMENT ISEG(0) 13 : * 14 : * POINTEUR PTR.MATRAK 15 : *-INC CCOPTIO 16 : *-INC CCNOYAU 17 : -INC TMCOLAC 18 : -INC SMMATRIK 19 : * 20 : * CAS DES MATRIK 21 : * 22 : * 23 : C WRITE(IOIMP,*)' ON FAIT LE MENAGE DES MATRIK ' 24 : 25 : IF (ITLAC(/1).EQ.0) RETURN 26 : DO 421 I=1,ITLAC(/1) 27 : MATRIK=ITLAC(I) 28 : ISLIS((MATRIK-1)/npgcd)=1 29 : C WRITE(IOIMP,*)' MATRIK=',MATRIK 30 : SEGACT MATRIK 31 : C WRITE(IOIMP,*)' liste : ksym,kminc,kmincp,kmincd,kizm=', 32 : C &ksym,kminc,kmincp,kmincd,kizm 33 : C WRITE(IOIMP,*)' liste : kispgt,kispgp,kispgd=', 34 : C &kispgt,kispgp,kispgd 35 : C WRITE(IOIMP,*)' liste : knttt,knttp,knttd=', 36 : C &knttt,knttp,knttd 37 : C WRITE(IOIMP,*)' KIDMAT :',(kidmat(i1),i1=1,9) 38 : C WRITE(IOIMP,*)' KKMMT :',(kkmmt (i1),i1=1,7) 39 : 40 : 41 : 42 : 43 : NMATRI=IRIGEL(/2) 44 : DO 422 N=1,NMATRI 45 : C WRITE(IOIMP,*)' N=',N 46 : C WRITE(IOIMP,*)' IRIGEL(i1,n)=',(IRIGEL(i1,n),i1=1,7) 47 : IMATRI=IRIGEL(4,N) 48 : IF (IMATRI.NE.0) THEN 49 : SEGACT IMATRI 50 : ISLIS((IMATRI-1)/npgcd)=1 51 : C WRITE(IOIMP,*)' IMATRI=',IMATRI 52 : NBSOUS=LIZAFM(/1) 53 : NBME =LIZAFM(/2) 54 : DO 423 L=1,NBSOUS 55 : DO 4231 M=1,NBME 56 : IZAFM=LIZAFM(L,M) 57 : IF (IZAFM.NE.0) THEN 58 : ISLIS((IZAFM-1)/npgcd)=1 59 : C WRITE(IOIMP,*)' IZAFM=',IZAFM 60 : SEGDES IZAFM 61 : ENDIF 62 : 4231 CONTINUE 63 : 423 CONTINUE 64 : C WRITE(IOIMP,*)' KSPGP,KSPGD=',KSPGP,KSPGD 65 : SEGDES IMATRI 66 : ENDIF 67 : 422 CONTINUE 68 : 69 : IF(KMINC.NE.0)THEN 70 : MINC=KMINC 71 : ISLIS((MINC-1)/npgcd)=1 72 : C WRITE(IOIMP,*)' KMINC=',MINC 73 : SEGDES MINC 74 : ENDIF 75 : IF(KMINCP.NE.0)THEN 76 : MINC=KMINCP 77 : ISLIS((MINC-1)/npgcd)=1 78 : C WRITE(IOIMP,*)' KMINCP=',MINC 79 : SEGDES MINC 80 : ENDIF 81 : IF(KMINCD.NE.0)THEN 82 : MINC=KMINCD 83 : ISLIS((MINC-1)/npgcd)=1 84 : C WRITE(IOIMP,*)' KMINCD=',MINC 85 : SEGDES MINC 86 : ENDIF 87 : 88 : N1=7 89 : LIDMAT(1)=1 90 : LIDMAT(2)=2 91 : LIDMAT(3)=3 92 : LIDMAT(4)=4 93 : LIDMAT(5)=5 94 : LIDMAT(6)=6 95 : LIDMAT(7)=7 96 : 97 : DO 425 I1=1,N1 98 : II=LIDMAT(I1) 99 : IF(KIDMAT(II).NE.0)THEN 100 : MINC=KIDMAT(II) 101 : ISLIS((MINC-1)/npgcd)=1 102 : SEGDES MINC 103 : ENDIF 104 : 425 CONTINUE 105 : 106 : 107 : N1=4 108 : LKMMT(1)=4 109 : LKMMT(2)=5 110 : LKMMT(3)=6 111 : LKMMT(4)=7 112 : 113 : DO 424 I1=1,N1 114 : II=LKMMT(I1) 115 : IF(KKMMT(II).NE.0)THEN 116 : MINC=KKMMT(II) 117 : ISLIS((MINC-1)/npgcd)=1 118 : SEGDES MINC 119 : ENDIF 120 : 424 CONTINUE 121 : 122 : IF(KIDMAT(1).NE.0)THEN 123 : IDMAT=KIDMAT(1) 124 : SEGACT IDMAT 125 : IF (IDIAG.NE.0) THEN 126 : MINC=IDIAG 127 : ISLIS((MINC-1)/npgcd)=1 128 : SEGDES MINC 129 : ENDIF 130 : NBLK=IDESCL(/1) 131 : DO 426 I1=1,NBLK 132 : MINC=IDESCL(I1) 133 : ISLIS((MINC-1)/npgcd)=1 134 : SEGDES MINC 135 : IF(KSYM.NE.2)GO TO 426 136 : MINC=IDESCU(I1) 137 : ISLIS((MINC-1)/npgcd)=1 138 : SEGDES MINC 139 : 426 CONTINUE 140 : SEGDES IDMAT 141 : ENDIF 142 : 143 : IF(KIDMAT(2).NE.0)THEN 144 : IDMAT=KIDMAT(2) 145 : SEGACT IDMAT 146 : IF (IDIAG.NE.0) THEN 147 : MINC=IDIAG 148 : ISLIS((MINC-1)/npgcd)=1 149 : SEGDES MINC 150 : ENDIF 151 : NBLK=IDESCL(/1) 152 : DO 427 I1=1,NBLK 153 : MINC=IDESCL(I1) 154 : ISLIS((MINC-1)/npgcd)=1 155 : SEGDES MINC 156 : IF(KSYM.NE.2)GO TO 427 157 : MINC=IDESCU(I1) 158 : ISLIS((MINC-1)/npgcd)=1 159 : SEGDES MINC 160 : 427 CONTINUE 161 : SEGDES IDMAT 162 : ENDIF 163 : 164 : 165 : 166 : SEGDES MATRIK 167 : 168 : 421 CONTINUE 169 : 170 : 171 : * 172 : RETURN 173 : END 174 : 175 : 176 :
© Cast3M 2003 - All rights reserved.
Disclaimer