1 : C SUPMAS SOURCE PV 10/10/13 21:15:49 6781 2 : SUBROUTINE SUPMAS 3 : c 4 : c sous routine pour calculer la masse 5 : c sur les ddl maitres d'un super element 6 : c option MASS de SUPE 7 : c 8 : c Pierre Pegon (CCR d'Ispra), Juin 1997 9 : c 10 : c l'option LCHP permet d'avoir les vecteurs de MSUPCH dans un LCHPO 11 : c 12 : c 13 : IMPLICIT INTEGER(I-N) 14 : IMPLICIT REAL*8(A-H,O-Z) 15 : c 16 : -INC CCOPTIO 17 : -INC SMELEME 18 : -INC SMRIGID 19 : -INC SMSUPER 20 : -INC SMMATRI 21 : -INC SMVECTD 22 : -INC SMCHPOI 23 : -INC TMTRAV 24 : c 25 : CHARACTER*4 INCL 26 : c 27 : SEGMENT MSUPCH(NBINMA) 28 : SEGMENT ISECO(LL) 29 : SEGMENT VSE(LL)*D 30 : c 31 : -INC SMLCHPO 32 : PARAMETER(NOLIS=1) 33 : CHARACTER*4 MOLIS(NOLIS) 34 : DATA MOLIS/'LCHP'/ 35 : c 36 : c *** lecture des objets en entre 37 : c 37 : CALL LIROBJ ('SUPERELE',MSUPER,1,IRETOU) 38 : IF(IERR.NE.0) RETURN 38 : CALL LIROBJ ('RIGIDITE',RI2,1,IRETOU) 39 : IF(IERR.NE.0) RETURN 40 : c 41 : c *** option LCHP 42 : c 42 : CALL LIRMOT(MOLIS,NOLIS,LCHP,0) 43 : c 44 : c *** mcrout contient la decomposition modifiee de la rigidite 45 : c 46 : SEGACT MSUPER*MOD 47 : MMATRI=MCROUT 48 : c 49 : c *** dimension de la matrice condensee 50 : c 51 : MRIGID=MSURAI 52 : SEGACT MRIGID 53 : xMATRI=IRIGEL(4,1) 54 : MOHAR=IRIGEL(5,1) 55 : SEGACT xMATRI 56 : * XMATRI=IMATTT(1) 57 : * SEGACT XMATRI 58 : NLIGRA=RE(/1) 59 : SEGDES XMATRI*NOMOD 60 : * SEGDES IMATRI*NOMOD 61 : SEGDES MRIGID*NOMOD 62 : c 63 : c *** autres dimensions 64 : c 65 : SEGACT MMATRI 66 : MILIGN=IILIGN 67 : SEGACT MILIGN 68 : NBNNMA=IPNO(/1)-NLIGRA 69 : NNOEU=ILIGN(/1) 70 : MINCPO=IINCPO 71 : SEGACT MINCPO 72 : MDNOR=IDNORM 73 : SEGACT MDNOR 74 : c 75 : c *** lecture de la geometrie et du descripteur lies a 76 : c la matrice de rigidite complete 77 : c 78 : IPT1=IGEOMA 79 : SEGACT IPT1 80 : MIDUA=IIDUA 81 : MIMIK=IIMIK 82 : SEGACT MIDUA,MIMIK 83 : c 84 : c *** on cherche a partir de ou commence les ligne au dela de NBNNMA 85 : c et on en profite pour activer TOUTES les lignes 86 : c 87 : I1=0 88 : ILA=0 89 : DO I=1,NNOEU 90 : LIGN=ILIGN(I) 91 : SEGACT LIGN 92 : NA=IMMM(/1) 93 : ILA=ILA+NA 94 : IF(ILA.GT.NBNNMA.AND.I1.EQ.0) THEN 95 : I1=I 96 : ILA1=ILA-NA 97 : ENDIF 98 : ENDDO 99 : c 100 : c *** creation du segment de travail et debut de son remplissage 101 : c 102 : NNNOE=IPT1.NUM(/2) 103 : NNIN=IMIK(/2) 104 : SEGINI MTRAV 105 : DO I=1,NNNOE 106 : IGEO (I)=IPT1.NUM(1,I) 107 : ENDDO 108 : DO I=1,NNIN 109 : INCO(I)=IMIK(I) 110 : NHAR(I)=MOHAR 111 : ENDDO 112 : DO I=1,NNNOE 113 : DO J=1,NNIN 114 : NUM1=INCPO(J,I) 115 : IF (NUM1.NE.0) IBIN(J,I)=1 116 : ENDDO 117 : ENDDO 118 : c 119 : c *** on initialise le segment des chpo "intermediaires de calcul" 120 : c que l'on va remplir successivement avec le vecteur formant les 121 : c ligne de la matrice rectangulaire [ -R*(L**-1) I ] 122 : c 123 : NBINMA=NLIGRA 124 : SEGINI MSUPCH 125 : c 126 : c *** on loop sur les lignes qui represente R ... 127 : c 128 : INC=IPNO(/1) 129 : SEGINI,MVECTD 130 : c 131 : DO INOEUD=I1,NNOEU 132 : LIG1=ILIGN(INOEUD) 133 : NA1=LIG1.IMMM(/1) 134 : IDEB1=1 135 : LPREC1=0 136 : DO IDDL=1,NA1 137 : ILA1=ILA1+1 138 : IF(ILA1.LE.NBNNMA)GOTO 50 139 : c 140 : c *** ... et on remplie VECTBB avec EN CHANGEANT LE SIGNE 141 : c 141 : CALL ZERO(VECTBB,1,INC) 142 : IFIN1=LIG1.IPPVV(IDDL+1)-1 143 : IDEB21=LIG1.IVPO(2*IDEB1) 144 : LONG1=LIG1.IVPO(2*(IFIN1+1)-1)-LIG1.IVPO(2*IDEB1-1) 145 : IPRECOL1=ILA1-LONG1 146 : DO INDIC1=IDEB1,IFIN1 147 : IFIN21=LIG1.IVPO(2*(INDIC1+1))-1 148 : ICOL1=LIG1.IVPO(2*INDIC1-1)+IPRECOL1-LPREC1 149 : IF (ICOL1.GT.NBNNMA) GOTO 1 150 : DO K1=IDEB21,IFIN21 151 : VECTBB(ICOL1)=-LIG1.VAL(K1) 152 : ICOL1=ICOL1+1 153 : IF(ICOL1.GT.NBNNMA) GOTO 1 154 : ENDDO 155 : IDEB21=IFIN21+1 156 : ENDDO 157 : 1 CONTINUE 158 : c 159 : c *** on de-normalise la ligne 160 : c 161 : XNORM1=DNOR(ILA1) 162 : DO I=1,NBNNMA 163 : VECTBB(I)=VECTBB(I)/XNORM1 164 : ENDDO 165 : c 166 : c *** on resout avec L transpose sur ce vecteur ("MOND1") 167 : c 168 : ILA=NBNNMA+NLIGRA+1 169 : c 170 : DO I=NNOEU,1,-1 171 : LIGN=ILIGN(I) 172 : NA=IMMM(/1) 173 : IFIB=IVPO(/1) 174 : IF(ILA-NA.GT.NBNNMA)THEN 175 : ILA=ILA-NA 176 : GOTO 5 177 : ENDIF 178 : IMOI1=IVPO(2*IPPVV(NA+1)-1) 179 : DO J=NA,1,-1 180 : ILA=ILA-1 181 : IDEB2=IPPVV(J)*2 182 : IMOI2=IVPO(IDEB2-1) 183 : LLOM=IMOI1-IMOI2-1 184 : IF (LLOM.LE.0)GOTO 3 185 : IF (ILA.GT.NBNNMA)GOTO 3 186 : IPOSM=IMOI2-1 187 : VKON=VECTBB(ILA) 188 : IPLAC=IVPO(IDEB2)-1 189 : IDEBZ=1 190 : IPLAC2=ILA-LLOM-1 191 : DO IDEB3=IDEB2,IFIB-1,2 192 : IMOI = IVPO ( IDEB3+2 ) 193 : ILONZ=IMOI -IPLAC-IDEBZ 194 : IPLAC=IPLAC-IPLAC2 195 : IDEBZC=IDEBZ+IPLAC2 196 : DO K=IDEBZC,MIN(IDEBZC+ILONZ,ILA)-1 197 : VECTBB(K)=VECTBB(K)-VKON*VAL(IPLAC+K) 198 : ENDDO 199 : IF (IDEBZ.GE.LLOM) GOTO 3 200 : IDEBZ=IVPO(IDEB3+1)-IPOSM 201 : IPLAC=IMOI-IDEBZ 202 : ENDDO 203 : 3 CONTINUE 204 : IMOI1=IMOI2 205 : ENDDO 206 : 5 CONTINUE 207 : ENDDO 208 : c 209 : c *** on normalise la colonne resultat 210 : c 211 : XNORM1=DNOR(ILA1) 212 : DO I=1,NBNNMA 213 : VECTBB(I)=VECTBB(I)*DNOR(I) 214 : ENDDO 215 : c 216 : c *** on met 1 en position ILA1 217 : c 218 : VECTBB(ILA1)=1.D0 219 : c 220 : c *** on cree le chpoint resultat 221 : c 222 : DO I=1,NNNOE 223 : DO J=1,NNIN 224 : NUM1=INCPO(J,I) 225 : IF (NUM1.NE.0) BB(J,I)=VECTBB(NUM1) 226 : ENDDO 227 : ENDDO 227 : CALL CRECHP(MTRAV,ISOLU) 228 : SEGACT MTRAV*MOD 229 : c 230 : c *** ce champ de nature discrete est stocke dans MSUPCH 231 : c 232 : MCHPOI = ISOLU 233 : SEGACT,MCHPOI*MOD 234 : JATTRI(1)=2 235 : SEGDES MCHPOI 236 : MSUPCH(ILA1-NBNNMA)=MCHPOI 237 : c 238 : c *** fin de la boucle sur les lignes representant R 239 : c 240 : 50 CONTINUE 241 : IDEB1=IFIN1+1 242 : LPREC1=LPREC1+LONG1 243 : ENDDO 244 : ENDDO 245 : c 246 : c *** desactivations diverses et variees 247 : c 248 : DO I=1,NNOEU 249 : LIGN=ILIGN(I) 250 : SEGDES LIGN*NOMOD 251 : ENDDO 252 : SEGDES MIDUA*NOMOD,MIMIK*NOMOD 253 : SEGDES MDNOR*NOMOD 254 : SEGDES MINCPO*NOMOD 255 : SEGDES MILIGN*NOMOD 256 : SEGDES IPT1 257 : SEGDES MMATRI*NOMOD 258 : SEGSUP MVECTD,MTRAV 259 : c 260 : c *** on attaque la condensation de la masse que l'on trouve 261 : c en effectuant les produits scalaires entre V et M*W ou 262 : c V et W sont des vecteurs de MSUPCH 263 : c 264 : RI1=MSURAI 265 : SEGACT RI1 266 : SEGINI,MRIGID=RI1 267 : SEGDES RI1 268 : MTYMAT='MASSE' 269 : NELRIG=1 270 : LL=MSUPCH(/1) 271 : SEGINI ISECO,VSE 272 : DO IH=1,LL 273 : ISECO(IH)=MSUPCH(IH) 274 : ENDDO 275 : NLIGRP=LL 276 : NLIGRD=LL 277 : SEGINI XMATRI 278 : * SEGINI IMATRI 279 : * IMATTT(1)=XMATRI 280 : DO J=1,LL 281 : SEGACT ISECO 282 : MCH1= ISECO(J) 283 : SEGDES ISECO,VSE 283 : CALL YTMXMU(MCH1,ISECO,J,RI2,VSE) 284 : SEGACT VSE 285 : DO K=1,J 286 : RE(J,K,1)=VSE(K) 287 : RE(K,J,1)=VSE(K) 288 : ENDDO 289 : ENDDO 290 : SEGDES XMATRI 291 : * SEGDES IMATRI 292 : IRIGEL(4,1)=xMATRI 293 : ICHOLE=0 294 : SEGDES MRIGID 295 : MSUMAS=MRIGID 295 : CALL ECROBJ('RIGIDITE',MSUMAS) 296 : c 297 : c *** on fait le menage 298 : c 299 : SEGDES MSUPER 300 : SEGSUP ISECO,VSE 301 : c 302 : c *** option LCHP ou non 303 : c 304 : IF(LCHP.EQ.1)THEN 305 : N1=NBINMA 306 : SEGINI MLCHPO 307 : DO I=1,NBINMA 308 : MCHPOI=MSUPCH(I) 309 : ICHPOI(I)=MCHPOI 310 : SEGDES MCHPOI 311 : ENDDO 312 : SEGDES MLCHPO 312 : CALL ECROBJ('LISTCHPO',MLCHPO) 313 : ELSE 314 : DO I=1,NBINMA 315 : MCHPOI=MSUPCH(I) 315 : CALL DTCHPO(MCHPOI) 316 : ENDDO 317 : ENDIF 318 : SEGSUP MSUPCH 319 : c 320 : c *** au revoir 321 : c 322 : RETURN 323 : END 324 : 325 : 326 :
© Cast3M 2003 - All rights reserved.
Disclaimer