1 : C ASSMOR SOURCE MAGN 09/07/30 21:15:09 6458 2 : SUBROUTINE ASSMOR(MATRIK,LL) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : 6 : -INC SMMATRIK 7 : -INC SMELEME 8 : POINTEUR MELEMP.MELEME,MELEMD.MELEME 9 : -INC SMLENTI 10 : POINTEUR IPADP.MLENTI,IPADD.MLENTI 11 : 12 : INTEGER PRI,DUA,LI,CO 13 : 14 : C ********************************* 15 : C On active le segment MATRIK et on 16 : C pointe sur tous les elements dont 17 : C on a besoin 18 : C ********************************* 19 : 20 : SEGACT MATRIK*MOD 21 : MELEMP=IRIGEL(1,LL) 22 : MELEMD=IRIGEL(2,LL) 23 : PMORS=IRIGEL(5,LL) 24 : SEGACT PMORS 25 : NBVA=JA(/1) 26 : SEGINI IZA 27 : 28 : C On recupere les segment MINCP et MINCD 29 : MINCP=KMINCP 30 : MINCD=KMINCD 31 : 32 : SEGACT MINCP,MINCD 33 : NPTP=MINCP.MPOS(/1) 34 : NPTD=MINCD.MPOS(/1) 35 : NBIP=MINCP.MPOS(/2)-1 36 : NBID=MINCD.MPOS(/2)-1 37 : 38 : C On prend le segment IMATRI 39 : IMATRI=IRIGEL(4,LL) 40 : SEGACT IMATRI 41 : NBSOUS=LIZAFM(/1) 42 : NBME=LIZAFM(/2) 43 : IF (NBSOUS.EQ.0) NBSOUS=1 44 : 45 : IPT1=MELEMP 46 : IPT2=MELEMD 47 : 48 : C On active les connectivites primales et duales pour 49 : C prendre les NBSOUS1 et NBSOUS2 50 : SEGACT MELEMP,MELEMD 51 : NBSOUS1=MELEMP.LISOUS(/1) 52 : NBSOUS2=MELEMD.LISOUS(/1) 53 : IF (NBSOUS1.EQ.0) NBSOUS1=1 54 : IF (NBSOUS2.EQ.0) NBSOUS2=1 55 : 56 : NBEL1=0 57 : NBEL2=0 58 : 59 : DO L=1,NBSOUS 60 : C Si NBSOUS n est pas egal a 1 c est que l on est en 61 : C multi-elements cependant, il se peut que les connectivites 62 : C (aucune, une seule ou les deux) soit un support (par 63 : C exemple l inconue primale est sur les CENTRE). Dans ce cas 64 : C le MELEME n'a pas de LISOUS. 65 : IF (NBSOUS.NE.1) THEN 66 : IF (NBSOUS1.NE.1) THEN 67 : IPT1=MELEMP.LISOUS(L) 68 : END IF 69 : IF (NBSOUS2.NE.1) THEN 70 : IPT2=MELEMD.LISOUS(L) 71 : END IF 72 : END IF 73 : 73 : CALL KRIPAD(IPT1,IPADP) 73 : CALL KRIPAD(IPT2,IPADD) 74 : 75 : SEGACT IPT1,IPT2 76 : SEGACT IPADP,IPADD 77 : 78 : NP=IPT1.NUM(/1) 79 : MP=IPT2.NUM(/1) 80 : 81 : C Il faut faire attention pour le nombre d elements 82 : IF (NBSOUS.EQ.1) THEN 83 : NBEL=IPT1.NUM(/2) 84 : ELSE 85 : IF (NBSOUS1.NE.1) THEN 86 : NBEL=IPT1.NUM(/2) 87 : ELSEIF (NBSOUS2.NE.1) THEN 88 : NBEL=IPT2.NUM(/2) 89 : END IF 90 : END IF 91 : 92 : c WRITE(6,*) 'IRIGEL',IRIGEL(7,LL),NP,MP,NBEL 93 : c IF (IRIGEL(7,LL.EQ.5) THEN 94 : c DO NL=1,NBME 95 : c IZAFM=LIZAFM(L,NL) 96 : c SEGACT IZAFM 97 : c DO K=1,NBEL 98 : c IF (NBSOUS.EQ.1) THEN 99 : c PRI=IPADP.LECT(IPT1.NUM(1,K)) 100 : c DUA=IPADD.LECT(IPT2.NUM(1,K)) 101 : c ELSE 102 : c IF (NBSOUS1.NE.1) THEN 103 : c PRI=IPADP.LECT(IPT1.NUM(1,K)) 104 : c ELSE 105 : c PRI=IPADP.LECT(IPT1.NUM(1,NBEL1+K)) 106 : c END IF 107 : c IF (NBSOUS2.NE.1) THEN 108 : c DUA=IPADD.LECT(IPT2.NUM(1,K)) 109 : c ELSE 110 : c DUA=IPADD.LECT(IPT2.NUM(1,NBEL2+K)) 111 : c END IF 112 : c END IF 113 : c 114 : c WRITE(6,*) 'PRI',PRI,'DUA',DUA 115 : c 116 : c END DO 117 : c SEGDES IZAFM 118 : c END DO 119 : c ELSE 120 : DO NL=1,NBME 121 : IZAFM=LIZAFM(L,NL) 122 : SEGACT IZAFM 123 : DO K=1,NBEL 124 : DO I=1,NP 125 : DO J=1,MP 126 : IF (NBSOUS.EQ.1) THEN 127 : PRI=IPADP.LECT(IPT1.NUM(I,K)) 128 : DUA=IPADD.LECT(IPT2.NUM(J,K)) 129 : ELSE 130 : IF (NBSOUS1.NE.1) THEN 131 : PRI=IPADP.LECT(IPT1.NUM(I,K)) 132 : ELSE 133 : PRI=IPADP.LECT(IPT1.NUM(I,NBEL1+K)) 134 : END IF 135 : IF (NBSOUS2.NE.1) THEN 136 : DUA=IPADD.LECT(IPT2.NUM(J,K)) 137 : ELSE 138 : DUA=IPADD.LECT(IPT2.NUM(J,NBEL2+K)) 139 : END IF 140 : END IF 141 : 142 : C NINCP et NINCD sont les numero des inconnues primales et 143 : C duale traite. 144 : IFLAG=0 145 : DO JJ=1,NBIP 146 : IF ((LISPRI(NL).EQ.MINCP.LISINC(JJ)).AND. 147 : & (IFLAG.EQ.0)) THEN 148 : IFLAG=1 149 : NINCP=JJ 150 : END IF 151 : END DO 152 : 153 : IFLAG=0 154 : DO JJ=1,NBID 155 : IF ((LISDUA(NL).EQ.MINCD.LISINC(JJ)).AND. 156 : & (IFLAG.EQ.0)) THEN 157 : IFLAG=1 158 : NINCD=JJ 159 : END IF 160 : END DO 161 : 162 : LI=MINCD.NPOS(DUA)+MINCD.MPOS(DUA,NINCD)-1 163 : CO=MINCP.NPOS(PRI)+MINCP.MPOS(PRI,NINCP)-1 164 : NB=IA(LI+1)-IA(LI) 165 : 166 : M=IA(LI) 167 : c WRITE(6,*) 'LI',LI,'CO',CO,'M',M,'NB',NB 168 : 169 : IFLAG=0 170 : DO KK=1,NB 171 : c WRITE(6,*) 'JA(',M+KK-1,')=',JA(M+KK-1) 172 : IF ((JA(M+KK-1).EQ.CO).AND.(IFLAG.EQ.0)) THEN 173 : IFLAG=1 174 : A(M+KK-1)=A(M+KK-1)+AM(K,I,J) 175 : M=M+KK-1 176 : END IF 177 : END DO 178 : c WRITE(6,*) 'AFFECT: M ',M 179 : 180 : END DO 181 : END DO 182 : END DO 183 : SEGDES IZAFM 184 : END DO 185 : NBEL1=NBEL1+NBEL 186 : NBEL2=NBEL2+NBEL 187 : SEGDES IPADP,IPADD 188 : SEGDES IPT1,IPT2 189 : c END IF 190 : END DO 191 : 192 : SEGDES MELEMP,MELEMD 193 : SEGDES IMATRI 194 : SEGDES MINCP,MINCD 195 : SEGDES IZA 196 : SEGDES PMORS 197 : IRIGEL(6,LL)=IZA 198 : SEGDES MATRIK 199 : RETURN 200 : 201 : END 202 : 203 : 204 :
© Cast3M 2003 - All rights reserved.
Disclaimer