1 : C KMORS SOURCE MAGN 09/07/30 21:17:37 6458 2 : SUBROUTINE KMORS(ASSTAB,MATRIK,LL) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C *********************************************** 6 : C * Routine de remplissage du tableau de ASSTAB * 7 : C * avec le profil de MATRIK. * 8 : C * Entree/sortie : MATRIK * 9 : C * Sortie : ASSTAB * 10 : C *********************************************** 11 : 12 : -INC SMMATRIK 13 : 14 : -INC SMELEME 15 : POINTEUR MELEMP.MELEME,MELEMD.MELEME 16 : POINTEUR SPGD.MELEME 17 : -INC SMLENTI 18 : POINTEUR IPADP.MLENTI,IPADD.MLENTI 19 : 20 : SEGMENT ASSTAB 21 : INTEGER ITAB(NBCOMP,NTA) 22 : ENDSEGMENT 23 : 24 : INTEGER PRI,DUA 25 : 26 : C ********************************* 27 : C On active le segment MATRIK et on 28 : C pointe sur tous les elements dont 29 : C on a besoin 30 : C ********************************* 31 : 32 : SEGACT MATRIK 33 : MELEMP=IRIGEL(1,LL) 34 : MELEMD=IRIGEL(2,LL) 35 : 36 : C On prend le segment IMATRI 37 : IMATRI=IRIGEL(4,LL) 38 : SEGACT IMATRI 39 : NBSOUS=LIZAFM(/1) 40 : IF (NBSOUS.EQ.0) NBSOUS=1 41 : 42 : C Le support dual contient le nombre de ligne de la matrice 43 : C pour une variable scalaire uniquement 44 : SPGD=KSPGD 45 : SEGACT SPGD 46 : NBCOMP=10 47 : NTA=SPGD.NUM(/2) 48 : SEGDES SPGD 49 : 50 : C On initialise ASSTAB 51 : SEGINI ASSTAB 52 : IPT1=MELEMP 53 : IPT2=MELEMD 54 : 55 : C On active les connectivites primales et duales pour 56 : C prendre les NBSOUS1 et NBSOUS2 57 : SEGACT MELEMP,MELEMD 58 : NBSOUS1=MELEMP.LISOUS(/1) 59 : NBSOUS2=MELEMD.LISOUS(/1) 60 : IF (NBSOUS1.EQ.0) NBSOUS1=1 61 : IF (NBSOUS2.EQ.0) NBSOUS2=1 62 : 63 : NBEL1=0 64 : NBEL2=0 65 : NTTD=0 66 : 67 : DO L=1,NBSOUS 68 : C Si NBSOUS n est pas egal a 1 c est que l on est en 69 : C multi-elements cependant, il se peut que les connectivites 70 : C (aucune, une seule ou les deux) soit un support (par 71 : C exemple l inconue primale est sur les CENTRE). Dans ce cas 72 : C le MELEME n'a pas de LISOUS. 73 : IF (NBSOUS.NE.1) THEN 74 : IF (NBSOUS1.NE.1) THEN 75 : IPT1=MELEMP.LISOUS(L) 76 : END IF 77 : IF (NBSOUS2.NE.1) THEN 78 : IPT2=MELEMD.LISOUS(L) 79 : END IF 80 : END IF 81 : 81 : CALL KRIPAD(IPT1,IPADP) 81 : CALL KRIPAD(IPT2,IPADD) 82 : 83 : SEGACT IPT1,IPT2 84 : SEGACT IPADP,IPADD 85 : 86 : NP=IPT1.NUM(/1) 87 : MP=IPT2.NUM(/1) 88 : 89 : C Il faut faire attention pour le nombre d elements 90 : IF (NBSOUS.EQ.1) THEN 91 : NBEL=IPT1.NUM(/2) 92 : ELSE 93 : IF (NBSOUS1.NE.1) THEN 94 : NBEL=IPT1.NUM(/2) 95 : ELSEIF (NBSOUS2.NE.1) THEN 96 : NBEL=IPT2.NUM(/2) 97 : END IF 98 : END IF 99 : 100 : DO K=1,NBEL 101 : DO I=1,NP 102 : DO J=1,MP 103 : IF (NBSOUS.EQ.1) THEN 104 : PRI=IPADP.LECT(IPT1.NUM(I,K)) 105 : DUA=IPADD.LECT(IPT2.NUM(J,K)) 106 : ELSE 107 : IF (NBSOUS1.NE.1) THEN 108 : PRI=IPADP.LECT(IPT1.NUM(I,K)) 109 : ELSE 110 : PRI=IPADP.LECT(IPT1.NUM(I,NBEL1+K)) 111 : END IF 112 : IF (NBSOUS2.NE.1) THEN 113 : DUA=IPADD.LECT(IPT2.NUM(J,K)) 114 : ELSE 115 : DUA=IPADD.LECT(IPT2.NUM(J,NBEL2+K)) 116 : END IF 117 : END IF 118 : NTTD=MAX(NTTD,DUA) 119 : 120 : NB=ITAB(1,DUA) 121 : 100 CONTINUE 122 : IF (NB+2.GT.NBCOMP) THEN 123 : NBCOMP=NBCOMP+10 124 : SEGADJ ASSTAB 125 : GOTO 100 126 : END IF 127 : 128 : IFLAG=0 129 : DO II=1,NB 130 : IF (ITAB(II+1,DUA).EQ.PRI) THEN 131 : IFLAG=1 132 : END IF 133 : END DO 134 : 135 : IF (IFLAG.EQ.0) THEN 136 : ITAB(1,DUA)=NB+1 137 : ITAB(NB+2,DUA)=PRI 138 : END IF 139 : 140 : END DO 141 : END DO 142 : END DO 143 : 144 : NBEL1=NBEL1+NBEL 145 : NBEL2=NBEL2+NBEL 146 : SEGDES IPADP,IPADD 147 : SEGDES IPT1,IPT2 148 : END DO 149 : 150 : DO I=1,NTTD 150 : CALL ORDOTA(ITAB(2,I),ITAB(1,I)) 151 : END DO 152 : 153 : SEGDES ASSTAB 154 : SEGDES MELEMP,MELEMD 155 : SEGDES IMATRI 156 : SEGDES MATRIK 157 : END 158 : 159 : 160 :
© Cast3M 2003 - All rights reserved.
Disclaimer