1 : C RELAMI SOURCE CHAT 09/10/09 21:22:46 6519 2 : 3 : SUBROUTINE RELAMI 4 : 5 : C======================================================================= 6 : C CE SOUS-PROGRAMME CONSTRUIT LA RIGIDITE LIANT LINEAIREMENT LES DDL 7 : C DES NOEUDS MILIEUX D'UN MAILLAGE QUADRATIQUE AUX NOEUDS SOMMETS 8 : C 9 : C SYNTHAXE GIBIANE : RIG1 = RELA MILI (LMOTS1) GEO1 ; 10 : C======================================================================= 11 : 12 : C======================== ZONE DE DECLARATIONS ========================= 13 : 14 : IMPLICIT INTEGER(I-N) 15 : IMPLICIT REAL*8 (A-H,O-Z) 16 : 17 : -INC CCOPTIO 18 : -INC CCHAMP 19 : -INC CCGEOME 20 : -INC SMLMOTS 21 : -INC SMCOORD 22 : -INC SMELEME 23 : -INC SMRIGID 24 : 25 : CHARACTER*4 LESDDL(10),LESDUA(10) 26 : 27 : SEGMENT IMILI(NBDDL) 28 : 29 : C========================= CORPS DU PROGRAMME ========================== 30 : 31 : C==== LECTURE DES ARGUMENTS 32 : 32 : CALL LIROBJ('LISTMOTS',IP0,0,IRETOU) 33 : IF (IERR.NE.0) RETURN 34 : 34 : CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU) 35 : IF (IERR.NE.0) RETURN 36 : 37 : C==== NOMS DES INCONNUES DE LA RIGIDITE 38 : 39 : C Si pas de LISTMOTS, je prends le inconnues de la meca. 40 : IF (IP0.EQ.0) THEN 41 : IF (IFOUR.LT.0) THEN 42 : NBDDL=2 43 : LESDDL(1)='UX ' 44 : LESDDL(2)='UY ' 45 : LESDUA(1)='FX ' 46 : LESDUA(2)='FY ' 47 : ELSEIF (IFOUR.EQ.0) THEN 48 : NBDDL=2 49 : LESDDL(1)='UR ' 50 : LESDDL(2)='UZ ' 51 : LESDUA(1)='FR ' 52 : LESDUA(2)='FZ ' 53 : ELSEIF (IFOUR.EQ.1) THEN 54 : NBDDL=3 55 : LESDDL(1)='UR ' 56 : LESDDL(2)='UT ' 57 : LESDDL(3)='UZ ' 58 : LESDUA(1)='FR ' 59 : LESDUA(2)='FT ' 60 : LESDUA(3)='FZ ' 61 : ELSE 62 : NBDDL=3 63 : LESDDL(1)='UX ' 64 : LESDDL(2)='UY ' 65 : LESDDL(3)='UZ ' 66 : LESDUA(1)='FX ' 67 : LESDUA(2)='FY ' 68 : LESDUA(3)='FZ ' 69 : ENDIF 70 : ELSE 71 : C Sinon, on prends les DDL specifies et on cherche les duals 72 : MLMOTS=IP0 73 : SEGACT,MLMOTS 74 : NBDDL=MOTS(/2) 75 : DO I=1,NBDDL 76 : DO J=1,LNOMDD 77 : IF (MOTS(I).EQ.NOMDD(J)) THEN 78 : LESDDL(I)=NOMDD(J) 79 : LESDUA(I)=NOMDU(J) 80 : ENDIF 81 : ENDDO 82 : ENDDO 83 : SEGDES,MLMOTS 84 : ENDIF 85 : 86 : C==== TRANSFORMATION DU MAILLAGE INI. EN SEGMENTS SI BESOIN 87 : 88 : IF (IDIM.GE.2) THEN 88 : CALL ECROBJ('MAILLAGE',IPT1) 88 : CALL CHANLG 89 : IF (IPT1.EQ.0) THEN 89 : CALL ERREUR(16) 90 : END IF 90 : CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU) 91 : IF (IERR.NE.0) RETURN 92 : ENDIF 93 : 94 : C==== CONSTRUCTION DU MAILLAGE SUPPORT DE LA RIGIDITE 95 : 96 : C J'initialise un vecteur que je vais remplir de maillages elem. 97 : SEGINI,IMILI 98 : 99 : IDIMP1=IDIM+1 100 : C Je parcours le maillage ini. et construis les maillages elem. 101 : SEGACT,IPT1 102 : NBSOUS1=IPT1.LISOUS(/1) 103 : C J'ai un maillage simple 104 : IF (NBSOUS1.EQ.0) THEN 105 : IF (IPT1.ITYPEL.EQ.3) THEN 106 : NBEL1=IPT1.NUM(/2) 107 : NBPTI=XCOOR(/1)/IDIMP1 108 : NBPTS=NBPTI+NBDDL*NBEL1 109 : SEGADJ,MCOORD 110 : NBSOUS=0 111 : NBREF=0 112 : NBELEM=NBEL1 113 : NBNN=4 114 : ICPT1=0 115 : DO I=1,NBDDL 116 : SEGINI,IPT2 117 : IPT2.ITYPEL=22 118 : DO J=1,NBEL1 119 : IP=NBPTI+ICPT1+J 120 : IREF=(IP-1)*IDIMP1 121 : IREF2=(IPT1.NUM(2,J)-1)*IDIMP1 122 : DO K=1,IDIMP1 123 : XCOOR(IREF+K)=XCOOR(IREF2+K) 124 : ENDDO 125 : IPT2.NUM(1,J)=IP 126 : IPT2.NUM(2,J)=IPT1.NUM(2,J) 127 : IPT2.NUM(3,J)=IPT1.NUM(1,J) 128 : IPT2.NUM(4,J)=IPT1.NUM(3,J) 129 : ENDDO 130 : SEGDES,IPT2 131 : IMILI(I)=IPT2 132 : ICPT1=ICPT1+NBEL1 133 : ENDDO 134 : ELSE 135 : C Si pas de SEG3, ERREUR 136 : SEGSUP,IMILI 137 : SEGDES,IPT1 137 : CALL ERREUR(16) 138 : RETURN 139 : ENDIF 140 : C J'ai un maillage complexe 141 : ELSE 142 : NBEL1=0 143 : DO ISOUS=1,NBSOUS1 144 : IPT3=IPT1.LISOUS(ISOUS) 145 : SEGACT,IPT3 146 : IF (IPT3.ITYPEL.EQ.3) THEN 147 : NBEL1=NBEL1+IPT3.NUM(/2) 148 : ENDIF 149 : ENDDO 150 : C Si pas de SEG3, ERREUR 151 : IF (NBEL1.EQ.0) THEN 152 : SEGSUP,IMILI 153 : SEGDES,IPT1 153 : CALL ERREUR(16) 154 : RETURN 155 : ENDIF 156 : NBPTI=XCOOR(/1)/IDIMP1 157 : NBPTS=NBPTI+NBDDL*NBEL1 158 : SEGADJ,MCOORD 159 : NBSOUS=0 160 : NBREF=0 161 : NBELEM=NBEL1 162 : NBNN=4 163 : ICPT1=0 164 : DO I=1,NBDDL 165 : ICEL1=0 166 : SEGINI,IPT2 167 : IPT2.ITYPEL=22 168 : DO ISOUS=1,NBSOUS1 169 : IPT3=IPT1.LISOUS(ISOUS) 170 : IF (IPT3.ITYPEL.EQ.3) THEN 171 : NBEL3=IPT3.NUM(/2) 172 : DO J=1,NBEL3 173 : IP=NBPTI+ICPT1+J 174 : IREF=(IP-1)*IDIMP1 175 : IREF2=(IPT3.NUM(2,J)-1)*IDIMP1 176 : DO K=1,IDIMP1 177 : XCOOR(IREF+K)=XCOOR(IREF2+K) 178 : ENDDO 179 : IPT2.NUM(1,ICEL1+J)=IP 180 : IPT2.NUM(2,ICEL1+J)=IPT3.NUM(2,J) 181 : IPT2.NUM(3,ICEL1+J)=IPT3.NUM(1,J) 182 : IPT2.NUM(4,ICEL1+J)=IPT3.NUM(3,J) 183 : ENDDO 184 : ICPT1=ICPT1+NBEL3 185 : ICEL1=ICEL1+NBEL3 186 : ENDIF 187 : SEGDES,IPT3 188 : ENDDO 189 : SEGDES,IPT2 190 : IMILI(I)=IPT2 191 : ENDDO 192 : ENDIF 193 : SEGDES,IPT1 194 : 195 : C==== CONSTRUCTION DE LA RIGIDITE ASSOCIEE AUX RELA. 196 : 197 : NRIGEL=NBDDL 198 : NRIGE=8 199 : SEGINI,RI1 200 : RI1.MTYMAT='RIGIDITE' 201 : RI1.IFORIG=IFOUR 202 : NLIGRP=4 203 : NLIGRD=NLIGRP 204 : DO I=1,NRIGEL 205 : C On a un segment DESCR par DDL 206 : SEGINI,DES1 207 : DES1.LISINC(1)='LX' 208 : DES1.LISDUA(1)='FLX' 209 : DES1.NOELEP(1)=1 210 : DES1.NOELED(1)=1 211 : DO J=2,4 212 : DES1.LISINC(J)=LESDDL(I) 213 : DES1.LISDUA(J)=LESDUA(I) 214 : DES1.NOELEP(J)=J 215 : DES1.NOELED(J)=J 216 : ENDDO 217 : SEGDES,DES1 218 : C On a un segment XMATRI par DDL 219 : nelrig=nbel1 220 : SEGINI,XMATR1 221 : XMATR1.RE(1,2,1)=1. 222 : XMATR1.RE(1,3,1)=-0.5 223 : XMATR1.RE(1,4,1)=-0.5 224 : XMATR1.RE(2,1,1)=XMATR1.RE(1,2,1) 225 : XMATR1.RE(3,1,1)=XMATR1.RE(1,3,1) 226 : XMATR1.RE(4,1,1)=XMATR1.RE(1,4,1) 227 : * SEGDES,XMATR1 228 : C On a NBEL1 matrice(s) elementaire(s) 229 : do ioup=2,nelrig 230 : do io=1,xmatr1.re(/2) 231 : do iu=1,xmatr1.re(/1) 232 : xmatr1.re(iu,io,ioup)=xmatr1.re(iu,io,1) 233 : enddo 234 : enddo 235 : enddo 236 : * NELRIG=NBEL1 237 : * SEGINI,IMATR1 238 : * DO J=1,NELRIG 239 : * IMATR1.IMATTT(J)=XMATR1 240 : * ENDDO 241 : SEGDES,xMATR1 242 : C On remplit la rigidite 243 : RI1.COERIG(I)=1. 244 : RI1.IRIGEL(1,I)=IMILI(I) 245 : RI1.IRIGEL(2,I)=0 246 : RI1.IRIGEL(3,I)=DES1 247 : RI1.IRIGEL(4,I)=xMATR1 248 : RI1.IRIGEL(5,I)=NIFOUR 249 : RI1.IRIGEL(6,I)=0 250 : RI1.IRIGEL(7,I)=0 251 : RI1.IRIGEL(8,I)=0 252 : ENDDO 253 : SEGDES,RI1 254 : IPRIG=RI1 255 : SEGSUP IMILI 256 : 257 : C==== JE SORS LA RIGIDITE 258 : 258 : CALL ECROBJ('RIGIDITE',IPRIG) 259 : 260 : RETURN 261 : END 262 : 263 :
© Cast3M 2003 - All rights reserved.
Disclaimer