1 : C RIGIB SOURCE FANDEUR 10/08/31 21:19:28 6734 2 : SUBROUTINE RIGIB(MATE,MELE,MELEM,IPMAIL,IPMITC,NBPGAC,LRE, 3 : & NSTRS,IVACAR,IVAMAT,CMATE,MFR,NBGMAT,NELMAT,IMAT,NMATT, 4 : & NDDL,IPMATR,ISOUS,ISOU1,NNUMS,IMMD) 5 : C=====================================================================C 6 : C C 7 : C CALCUL DE LA RIGIDITE C 8 : C C 9 : C ENTREES : C 10 : C C 11 : C MATE Numero du materiau (Initialise dans NOMATE) C 12 : C MELE Numero de l'element fini C 13 : C IPNNUM Pointeurs sur des segments NNUM C 14 : C IPMAIL Pointeur sur MELEME (massif contenant le cable) C 15 : C IPMITC Pointeur sur un segment MINTE du cable C 16 : C NBPGAC Nombre de point d'integration pour la rigidite C 17 : C LRE Nombre de ddl dans la matrice de rigidite C 18 : C NSTRS Nombre de composante de contraintes/deformations C 19 : C IVAMAT Pointeur sur un segment MPTVAL pour le materiau C 20 : C (acier) C 21 : C IVACAR Pointeur sur les sections C 22 : C CMATE Nom du materiau(dans NOMATE: isortrope, orthotrope.)C 23 : C MFR Numero de la formulation element fini C 24 : C NBGMAT Taille maxi des melval du materiau (pt de gauss) C 25 : C NELMAT Taille maxi des melval du materiau (No d'element) C 26 : C IMAT (2 il y a une matrice de HOOKE,1 non ) C 27 : C NMATT Nombre de composante de materiau (IMAT=1) (RIGIA) C 28 : C NDDL Nombre de degre de liberte C 29 : C C 30 : C SORTIES : C 31 : C C 32 : C IPMATR pointeur sur la rigidite de la sous-zone C 33 : C C 34 : C=====================================================================C 35 : 36 : IMPLICIT INTEGER(I-N) 37 : IMPLICIT REAL*8 (A-H,O-Z) 38 : C 39 : -INC CCREEL 40 : -INC CCOPTIO 41 : -INC CCHAMP 42 : 43 : -INC SMCHAML 44 : -INC SMINTE 45 : -INC SMELEME 46 : -INC SMRIGID 47 : -INC SMCOORD 48 : C 49 : SEGMENT WRK1 50 : REAL*8 REL(LRE,LRE) , XE(3,NBBB),shpk(6,20,5),qqq(3) 51 : REAL*8 XEC(3,2),QSIG(6),XX(3,2),SHPC(6,20,5),SGA(3,5,5) 52 : ENDSEGMENT 53 : C 54 : SEGMENT MVELCH 55 : REAL*8 VALMAT(NV1) 56 : ENDSEGMENT 57 : C 58 : SEGMENT MPTVAL 59 : INTEGER IPOS(NS),NSOF(NS) 60 : INTEGER IVAL(NCOSOU) 61 : ENDSEGMENT 62 : C 63 : SEGMENT NNUM 64 : INTEGER NNM(NBN,NBELE),NBEM(2,NBELE) 65 : ENDSEGMENT 66 : C 67 : CHARACTER*8 CMATE 68 : C 69 : NNUM=NNUMS 70 : SEGACT NNUM 71 : NBN=NNM(/1) 72 : NBELE=NNM(/2) 73 : 74 : MELEME=IPMAIL 75 : SEGACT MELEME 76 : NBNN=NUM(/1) 77 : NBELEM=NUM(/2) 78 : C 79 : NV1=NMATT 80 : SEGINI, MVELCH 81 : 82 : xMATRI=IPMATR 83 : SEGACT xMATRI*MOD 84 : C 85 : NHRM=NIFOUR 86 : MINTE=IPMITC 87 : SEGACT MINTE 88 : NBPGAC=POIGAU(/1) 89 : 90 : IRTD=1 91 : C_______________________________________________________________________ 92 : C 93 : C NUMERO DES ETIQUETTES : 94 : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT 95 : C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR : 96 : C 5 CONTINUE 97 : C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ... 98 : C 44 CONTINUE 99 : C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ... 100 : C_______________________________________________________________________ 101 : C 102 : GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99, 103 : 1 99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,35,35,35,35,35,35, 104 : 2 99,99,99,99,99,99,99,48,99,99,99,99,48,48,99,99,99,99,99,99, 105 : 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,79,79, 106 : 4 79,79,79,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 107 : 5 99,99,99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 108 : 6 4, 4),MELE 109 : GOTO 99 110 : C 111 : C --- SECTEUR DE CALCUL POUR LES ELEMENTS MASSIFS 112 : C 113 : 4 CONTINUE 114 : C 115 : NBNO=NBNN 116 : NBBB=NBNN 117 : 118 : SEGINI WRK1 119 : DO 5001 I=1,NBPGAC 120 : 5001 QSIG(I)=QSIGAU(I) 121 : 122 : C IF(IMMD.EQ.2.AND.ISOU1.EQ.1) THEN 123 : if(immd.eq.2) then 124 : DO 3004 IB=1,NBELEM 124 : CALL ZERO(REL,LRE,LRE) 125 : C 126 : C --- REMPLISSAGE DE XMATRI 127 : C 127 : CALL REMPMT(REL,LRE,RE(1,1,ib)) 128 : 3004 CONTINUE 129 : END IF 130 : 131 : IF(MELEM.NE.95) THEN 132 : DO 3005 IC=1,NBELE 133 : IF(NBEM(2,IC).NE.ISOUS) GOTO 3005 134 : C --- IB: LE NUMERO D'ELEMENT BETON CONTENANT LE SEGMENT DU CABLE IC 135 : IB=NBEM(1,IC) 136 : 136 : CALL ZERO(REL,LRE,LRE) 137 : C 138 : C --- ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 139 : C 140 : C write(6,*) 'cable ', ic , 'noeuds' ,NNM(1,IC),NNM(2,IC) 141 : C write(6,*) 'beton ', ib , 'noeuds' ,(NUM(j,IB),j=1,NUM(/1)) 141 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 141 : CALL DOXE(XCOOR,IDIM,2 ,NNM,IC,XEC) 141 : CALL SHPCAB(NBPGAC,XE,XEC,MELE,NBNN,IDIM,QSIG,SHPC,XX,SGA,1) 142 : C 143 : C --- BOUCLE SUR LES POINTS DE GAUSS 144 : C 145 : DO 4004 IGAU=1,NBPGAC 146 : 147 : MPTVAL=IVAMAT 148 : DO 9004 IM=1,NMATT 149 : IF (IVAL(IM).NE.0) THEN 150 : MELVAL=IVAL(IM) 151 : IBMN=MIN(IC ,VELCHE(/2)) 152 : IGMN=MIN(IGAU,VELCHE(/1)) 153 : VALMAT(IM)=VELCHE(IGMN,IBMN) 154 : ELSE 155 : VALMAT(IM)=0.D0 156 : ENDIF 157 : 9004 CONTINUE 158 : C write(6,*) ' youn ' , valmat(1) 159 : C recuperation de le section 160 : mptval=ivacar 161 : melval=ival(1) 162 : igmn=min(igau,velche(/1)) 163 : ibmn=min(ic,velche(/2)) 164 : ssect=velche(igmn,ibmn) 165 : 166 : * write(6,*) (VALMAT(I),i=1,NMATT),ssect 167 : 168 : YOUN=VALMAT(1)*ssect 168 : CALL BMATSJ(NBPGAC,IGAU,NBNN,IDIM,IFOUR,LRE,NSTRS, 169 : & SHPC,SGA,YOUN,REL) 170 : 4004 CONTINUE 171 : C 172 : C --- REMPLISSAGE DE XMATRI 173 : C 173 : CALL REMPM1(REL,LRE,RE(1,1,ib)) 174 : 3005 CONTINUE 175 : C 176 : ELSE IF(MELEM.EQ.95) THEN 177 : C 178 : C --- CALCUL DE LA CONTRIBUTION D'UN CABLE CIRCONFERENTIEL A LA 179 : C MATRICE DE RIGIDITE 180 : C 181 : DO 4235 IC=1,NBELE 182 : IF(nbem(2,ic).NE.ISOUS) GOTO 4235 182 : CALL ZERO(REL,LRE,LRE) 183 : IB=NBEM(1,IC) 184 : C write(6,*) 'cable ', ic , 'noeuds' ,NNM(1,IC) 185 : C write(6,*) 'beton ', ib , 'noeuds' ,(NUM(j,IB),j=1,NUM(/1)) 186 : C 186 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 186 : call doxe(xcoor,idim,1,nnm,ic,xec) 187 : C write(6,*) xec(1,1), xec(2,1) 188 : 189 : MPTVAL=IVAMAT 190 : DO 9005 IM=1,1 191 : IF (IVAL(IM).NE.0) THEN 192 : MELVAL=IVAL(IM) 193 : IBMN=MIN(ic,VELCHE(/2)) 194 : IGMN=MIN(1 ,VELCHE(/1)) 195 : VALMAT(IM)=VELCHE(IGMN,IBMN) 196 : ELSE 197 : VALMAT(IM)=0.D0 198 : ENDIF 199 : 9005 CONTINUE 200 : C recuperation de le section 201 : mptval=ivacar 202 : melval=ival(1) 203 : igmn=min(1,velche(/1)) 204 : ibmn=min(ic,velche(/2)) 205 : ssect=velche(igmn,ibmn) 206 : 207 : YOUNR=VALMAT(1)*ssect/xec(1,1)*2.D0*XPI 208 : C write(6,*) ' section youn younr' ,ssect,valmat(1),younr 208 : * CALL SHPCAB(1,XE,XEC,MELE,NBNN,IDIM,QSIG,SHPC,XX,SGA,0) 208 : call qsijs(xe,mele,nbnn,idim,xec,shpk,qqq,irout) 208 : call bmatsc(nbnn,lre,shpk,younr,rel) 209 : C 210 : C --- REMPLISSAGE DE XMATRI 210 : CALL REMPM1(REL,LRE,RE(1,1,ib)) 211 : 4235 CONTINUE 212 : END IF 213 : C 214 : IF(IRTD.EQ.0) THEN 215 : MOTERR(1:8)=CMATE 216 : MOTERR(9:16)=NOMFR(MFR/2+1) 217 : INTERR(1)=IFOUR 217 : CALL ERREUR(81) 218 : ENDIF 219 : SEGSUP WRK1 220 : GOTO 510 221 : C 222 : C --- SECTEUR DE CALCUL POUR LES ELEMENTS LIQUIDES 223 : C 224 : 35 CONTINUE 225 : c supression 226 : GOTO 510 227 : C 228 : C --- SECTEUR DE CALCUL POUR LES ELEMENTS DE SURFACE LIBRE 229 : C 230 : 48 CONTINUE 231 : c supression 232 : GOTO 510 233 : C 234 : C --- MILIEUX POREUX 235 : C 236 : 79 CONTINUE 237 : c supression 238 : GOTO 510 239 : C 240 : 99 CONTINUE 241 : MOTERR(1:4)=NOMTP(MELE) 242 : MOTERR(9:12)='RIGIB' 242 : CALL ERREUR(86) 243 : C 244 : 510 CONTINUE 245 : SEGSUP,MVELCH 246 : SEGDES,MELEME 247 : SEGDES,MINTE 248 : SEGDES,xMATRI 249 : SEGDES,NNUM 250 : 251 : RETURN 252 : END 253 : 254 :
© Cast3M 2003 - All rights reserved.
Disclaimer