1 : C CMCT1 SOURCE CHAT 09/10/09 21:16:23 6519 2 : SUBROUTINE CMCT1(ICHP,IRIG,IRIG2) 3 : *_______________________________________________________________________ 4 : c 5 : c opérateur cmct 6 : c 7 : c entrée 8 : c ICHP : champ par point qui stocke la masse inversée 9 : c IRIG : rigidité contenant les blocages 10 : c 11 : c sortie 12 : c IRIG2 : rigidité contenant la matrice condensée 13 : c 14 : *_______________________________________________________________________ 15 : 16 : IMPLICIT INTEGER(I-N) 17 : IMPLICIT REAL*8(A-H,O-Z) 18 : * 19 : -INC CCOPTIO 20 : -INC SMRIGID 21 : -INC SMELEME 22 : -INC SMCOORD 23 : -INC SMCHPOI 24 : * stockage des noms de tous les composantes primales. 25 : SEGMENT LSINCP 26 : CHARACTER*4 LISINP(NLIGP) 27 : ENDSEGMENT 28 : * correspondance entre les noms de composantes locale LISINC 29 : * et les nom de composantes dans LSINCP 30 : SEGMENT CORES1 31 : INTEGER IPCOR2(NRIGEL) 32 : ENDSEGMENT 33 : SEGMENT CORES2 34 : INTEGER COR2(NLIGRP) 35 : ENDSEGMENT 36 : * tableau pour dire en chaque point si la composante du tableau LISINP 37 : * est implquée 38 : SEGMENT MTOPTS 39 : * nombre d'occurence de la compoosante 40 : INTEGER ITOPTS(NBPTS,NLIGP) 41 : * valeur de l'inverse la masse en ce point 42 : REAL*8 XTOPTS(NBPTS,NLIGP+1) 43 : ENDSEGMENT 44 : * 45 : * tableau pour pointer vers MCOEF à partir du nombre d'inconnues 46 : * 47 : SEGMENT LSINCO 48 : INTEGER LESINC(NINC,2) 49 : REAL*8 XMAS(NINC) 50 : ENDSEGMENT 51 : * 52 : * tableau des coefficient de la matrice C 53 : * ordonné dans l'ordre des inconnues 54 : SEGMENT MCOEF 55 : * numero du noeud support du multiplicateur ligne 1 56 : * est il en marié avec un autre multiplicateur ligne 2 57 : INTEGER ICOEF(2,NCOEF) 58 : * valeur des coefficients 59 : REAL*8 XCOEF(NCOEF) 60 : ENDSEGMENT 61 : * 62 : *_______________________________________________________________________ 63 : * 64 : * la première etape consiste à établir la liste de tous les noms 65 : * d'inconnue primale dans la rigidité 66 : * cette liste est stockée dans LSINCP 67 : * la correspondance locale -> globale dans CORES1 68 : * 69 : * la rigidité est déjà active (cmct) 70 : MRIGID = IRIG 71 : NRIGEL = IRIGEL(/2) 72 : SEGINI CORES1 73 : * NLIGP1 est la taille effective de LSINCP 74 : * on évite ainsi de faire trop de segadj 75 : NLIGP1 = 0 76 : NLIGP = 0 77 : NCOEF = 0 78 : 79 : 80 : DO 50 I=1,NRIGEL 81 : DESCR = IRIGEL(3,I) 82 : SEGACT DESCR*NOMOD 83 : NLIGRP = LISINC(/2) 84 : NLIGP = NLIGP + NLIGRP 85 : MELEME = IRIGEL(1,I) 86 : NCOEF = NCOEF + (NUM(/2) * NLIGRP) 87 : * les coeffficients sur les multiplicateurs 88 : * ne nous interessent pas 89 : IF (ITYPEL .EQ. 22) NCOEF=NCOEF-NUM(/2) 90 : 50 CONTINUE 91 : * 92 : SEGINI LSINCP 93 : DO 300 I=1,NRIGEL 94 : DESCR = IRIGEL(3,I) 95 : NLIGRP = LISINC(/2) 96 : MELEME = IRIGEL(1,I) 97 : IMULT=1 98 : IF (ITYPEL .EQ.22) IMULT = 2 99 : SEGINI CORES2 100 : DO 200 J=IMULT,NLIGRP 101 : DO 100 K=1,NLIGP 102 : IF (LISINC(J) .EQ. LISINP(K)) THEN 103 : COR2(J) = K 104 : GOTO 200 105 : ENDIF 106 : 100 CONTINUE 107 : NLIGP1 = NLIGP1 + 1 108 : LISINP(NLIGP1) = LISINC(J) 109 : COR2(J) = NLIGP1 110 : 200 CONTINUE 111 : IPCOR2(I) = CORES2 112 : 300 CONTINUE 113 : * 114 : * ajustement de la taille de LSINCP 115 : * on purrait suprimer cette ligne 116 : NLIGP = NLIGP1 117 : SEGADJ LSINCP 118 : * 119 : * 120 : *_______________________________________________________________________ 121 : * on remplit maintenant le tableau itopts en bouclant sur les sous zones de 122 : * la rigidité 123 : * 124 : NBPTS = XCOOR(/1) / (IDIM +1) 125 : SEGINI MTOPTS 126 : * 127 : DO 600 I=1,NRIGEL 128 : * les maillages sont actifs depuis cmct 129 : MELEME = IRIGEL(1,I) 130 : imult=1 131 : IF (ITYPEL .EQ.22) IMULT = 2 132 : DESCR = IRIGEL(3,I) 133 : CORES2 = IPCOR2(I) 134 : DO 500 K=1,NUM(/2) 135 : DO 400 J=IMULT,NOELEP(/1) 136 : ITOPTS(NUM(NOELEP(J),K),COR2(J)) = 137 : & ITOPTS(NUM(NOELEP(J),K),COR2(J)) + 1 138 : 400 CONTINUE 139 : 500 CONTINUE 140 : 600 CONTINUE 141 : * 142 : * on remplit maintenant la masse inversée 143 : * 144 : MCHPOI = ICHP 145 : SEGACT MCHPOI*NOMOD 146 : * boucle sur les sous zones du champ par point 147 : DO 1100 I=1,IPCHP(/1) 148 : MSOUPO = IPCHP(I) 149 : SEGACT MSOUPO 150 : MELEME = IGEOC 151 : SEGACT MELEME 152 : MPOVAL = IPOVAL 153 : SEGACT MPOVAL 154 : * boucle sur les composantes de la sous zone 155 : DO 1000 J=1,NOCOMP(/2) 156 : * recuperation du numéro de la composante dans LISINP 157 : DO 700 K=1,NLIGP 158 : IF (NOCOMP(J) .EQ. LISINP(K)) THEN 159 : IDK = K 160 : GOTO 800 161 : ENDIF 162 : 700 CONTINUE 163 : IDK = NLIGP + 1 164 : * 165 : 800 CONTINUE 166 : * boucle sur les points de la sous zone 167 : DO 900 K=1,NUM(/2) 168 : XTOPTS(NUM(1,K),IDK) = VPOCHA(K,J) 169 : 900 CONTINUE 170 : * 171 : 1000 CONTINUE 172 : SEGDES MPOVAL,MELEME,MSOUPO 173 : 1100 CONTINUE 174 : * 175 : SEGDES MCHPOI 176 : * 177 : *_______________________________________________________________________ 178 : * 179 : * calcul du nombre d'inconnues et creation de LESINC 180 : * correspondance entre les inconnues et MCOEF 181 : * 182 : * 183 : NINC = 0 184 : DO 1300 I=1,NLIGP 185 : DO 1200 J=1,NBPTS 186 : NINC = NINC + SIGN(1,(ITOPTS(J,I)-1)) 187 : 1200 CONTINUE 188 : 1300 CONTINUE 189 : NINC = ((NLIGP * NBPTS) + NINC )/ 2 190 : ** 191 : * on remplit LSINCO 192 : SEGINI LSINCO 193 : IND1 = 1 194 : IDUM = 1 195 : DO 1600 I=1,NRIGEL 196 : MELEME = IRIGEL(1,I) 197 : imult=1 198 : IF (ITYPEL .EQ.22) IMULT = 2 199 : DESCR = IRIGEL(3,I) 200 : CORES2 = IPCOR2(I) 201 : DO 1500 K=1,NUM(/2) 202 : DO 1400 J=IMULT,NOELEP(/1) 203 : IF ( ITOPTS(NUM(NOELEP(J),K),COR2(J)) .GT. 0 ) THEN 204 : LESINC(IND1,1) = IDUM 205 : IDUM = IDUM + ITOPTS(NUM(NOELEP(J),K),COR2(J)) 206 : * ITOPTS va desormais contenir le numéro de l'inconnue dans LESINC 207 : ITOPTS(NUM(NOELEP(J),K),COR2(J)) = -1 * IND1 208 : XMAS(IND1) = XTOPTS(NUM(NOELEP(J),K),COR2(J)) 209 : IND1 = IND1 + 1 210 : ENDIF 211 : 1400 CONTINUE 212 : 1500 CONTINUE 213 : 1600 CONTINUE 214 : *===== 215 : * if ( (IND1-1) .NE. NINC ) then 216 : * write(*,*) 'erreur dans boucle lsinco' 217 : * endif 218 : *====== 219 : * 220 : * 221 : *_______________________________________________________________________ 222 : * remplissage de MCOEF 223 : * 224 : SEGINI MCOEF 225 : DO 1900 I=1,NRIGEL 226 : MELEME = IRIGEL(1,I) 227 : imult=1 228 : IF (ITYPEL .EQ.22) IMULT = 2 229 : DESCR = IRIGEL(3,I) 230 : CORES2 = IPCOR2(I) 231 : xMATRI = IRIGEL(4,I) 232 : SEGACT xMATRI 233 : DO 1800 K=1,NUM(/2) 234 : * XMATRI = IMATTT(K) 235 : * SEGACT XMATRI 236 : DO 1700 J=IMULT,NOELEP(/1) 237 : NNINC = -1 * ITOPTS(NUM(NOELEP(J),K),COR2(J)) 238 : IDMCOE = LESINC(NNINC,1)+LESINC(NNINC,2) 239 : LESINC(NNINC,2) = LESINC(NNINC,2) + 1 240 : ICOEF(1,IDMCOE)=NUM(1,K) 241 : XCOEF(IDMCOE)=RE(1,J,k)*COERIG(I) 242 : 1700 CONTINUE 243 : * SEGDES XMATRI 244 : 1800 CONTINUE 245 : * on referme la boutique 246 : SEGDES xMATRI,MELEME,DESCR 247 : SEGSUP CORES2 248 : 1900 CONTINUE 249 : SEGSUP CORES1,LSINCP,MTOPTS 250 : * 251 : *===== 252 : * do 2001 i=1,ninc 253 : * write(*,2003) i,lesinc(i,1),lesinc(i,2),xmas(i) 254 : * 2001 continue 255 : * 2003 format(I3,1X,I3,1X,I3,2X,E12.5) 256 : * 257 : * do 2005 i=1,ncoef 258 : * write(*,2003) i,icoef(1,i),icoef(2,i),xcoef(i) 259 : * 2005 continue 260 : *===== 261 : *_______________________________________________________________________ 262 : * 263 : * il ne reste plus qu' a creer les matrices élémentaires 264 : * 264 : CALL CMCT2(MCOEF,LSINCO,IRIG2) 265 : IF (IERR .NE.0 ) RETURN 266 : * 267 : *_______________________________________________________________________ 268 : RETURN 269 : END 270 : 271 : 272 : 273 : 274 : 275 : 276 : 277 : 278 :
© Cast3M 2003 - All rights reserved.
Disclaimer