C RIGIB SOURCE FANDEUR 10/08/31 21:19:28 6734 SUBROUTINE RIGIB(MATE,MELE,MELEM,IPMAIL,IPMITC,NBPGAC,LRE, & NSTRS,IVACAR,IVAMAT,CMATE,MFR,NBGMAT,NELMAT,IMAT,NMATT, & NDDL,IPMATR,ISOUS,ISOU1,NNUMS,IMMD) C=====================================================================C C C C CALCUL DE LA RIGIDITE C C C C ENTREES : C C C C MATE Numero du materiau (Initialise dans NOMATE) C C MELE Numero de l'element fini C C IPNNUM Pointeurs sur des segments NNUM C C IPMAIL Pointeur sur MELEME (massif contenant le cable) C C IPMITC Pointeur sur un segment MINTE du cable C C NBPGAC Nombre de point d'integration pour la rigidite C C LRE Nombre de ddl dans la matrice de rigidite C C NSTRS Nombre de composante de contraintes/deformations C C IVAMAT Pointeur sur un segment MPTVAL pour le materiau C C (acier) C C IVACAR Pointeur sur les sections C C CMATE Nom du materiau(dans NOMATE: isortrope, orthotrope.)C C MFR Numero de la formulation element fini C C NBGMAT Taille maxi des melval du materiau (pt de gauss) C C NELMAT Taille maxi des melval du materiau (No d'element) C C IMAT (2 il y a une matrice de HOOKE,1 non ) C C NMATT Nombre de composante de materiau (IMAT=1) (RIGIA) C C NDDL Nombre de degre de liberte C C C C SORTIES : C C C C IPMATR pointeur sur la rigidite de la sous-zone C C C C=====================================================================C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C -INC CCREEL -INC CCOPTIO -INC CCHAMP -INC SMCHAML -INC SMINTE -INC SMELEME -INC SMRIGID -INC SMCOORD C SEGMENT WRK1 REAL*8 REL(LRE,LRE) , XE(3,NBBB),shpk(6,20,5),qqq(3) REAL*8 XEC(3,2),QSIG(6),XX(3,2),SHPC(6,20,5),SGA(3,5,5) ENDSEGMENT C SEGMENT MVELCH REAL*8 VALMAT(NV1) ENDSEGMENT C SEGMENT MPTVAL INTEGER IPOS(NS),NSOF(NS) INTEGER IVAL(NCOSOU) ENDSEGMENT C SEGMENT NNUM INTEGER NNM(NBN,NBELE),NBEM(2,NBELE) ENDSEGMENT C CHARACTER*8 CMATE C NNUM=NNUMS SEGACT NNUM NBN=NNM(/1) NBELE=NNM(/2) MELEME=IPMAIL SEGACT MELEME NBNN=NUM(/1) NBELEM=NUM(/2) C NV1=NMATT SEGINI, MVELCH xMATRI=IPMATR SEGACT xMATRI*MOD C NHRM=NIFOUR MINTE=IPMITC SEGACT MINTE NBPGAC=POIGAU(/1) IRTD=1 C_______________________________________________________________________ C C NUMERO DES ETIQUETTES : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR : C 5 CONTINUE C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ... C 44 CONTINUE C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ... C_______________________________________________________________________ C GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99, 1 99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,35,35,35,35,35,35, 2 99,99,99,99,99,99,99,48,99,99,99,99,48,48,99,99,99,99,99,99, 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,79,79, 4 79,79,79,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 5 99,99,99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 6 4, 4),MELE GOTO 99 C C --- SECTEUR DE CALCUL POUR LES ELEMENTS MASSIFS C 4 CONTINUE C NBNO=NBNN NBBB=NBNN SEGINI WRK1 DO 5001 I=1,NBPGAC 5001 QSIG(I)=QSIGAU(I) C IF(IMMD.EQ.2.AND.ISOU1.EQ.1) THEN if(immd.eq.2) then DO 3004 IB=1,NBELEM CALL ZERO(REL,LRE,LRE) C C --- REMPLISSAGE DE XMATRI C CALL REMPMT(REL,LRE,RE(1,1,ib)) 3004 CONTINUE END IF IF(MELEM.NE.95) THEN DO 3005 IC=1,NBELE IF(NBEM(2,IC).NE.ISOUS) GOTO 3005 C --- IB: LE NUMERO D'ELEMENT BETON CONTENANT LE SEGMENT DU CABLE IC IB=NBEM(1,IC) CALL ZERO(REL,LRE,LRE) C C --- ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB C C write(6,*) 'cable ', ic , 'noeuds' ,NNM(1,IC),NNM(2,IC) C write(6,*) 'beton ', ib , 'noeuds' ,(NUM(j,IB),j=1,NUM(/1)) CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) CALL DOXE(XCOOR,IDIM,2 ,NNM,IC,XEC) CALL SHPCAB(NBPGAC,XE,XEC,MELE,NBNN,IDIM,QSIG,SHPC,XX,SGA,1) C C --- BOUCLE SUR LES POINTS DE GAUSS C DO 4004 IGAU=1,NBPGAC MPTVAL=IVAMAT DO 9004 IM=1,NMATT IF (IVAL(IM).NE.0) THEN MELVAL=IVAL(IM) IBMN=MIN(IC ,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) VALMAT(IM)=VELCHE(IGMN,IBMN) ELSE VALMAT(IM)=0.D0 ENDIF 9004 CONTINUE C write(6,*) ' youn ' , valmat(1) C recuperation de le section mptval=ivacar melval=ival(1) igmn=min(igau,velche(/1)) ibmn=min(ic,velche(/2)) ssect=velche(igmn,ibmn) * write(6,*) (VALMAT(I),i=1,NMATT),ssect YOUN=VALMAT(1)*ssect CALL BMATSJ(NBPGAC,IGAU,NBNN,IDIM,IFOUR,LRE,NSTRS, & SHPC,SGA,YOUN,REL) 4004 CONTINUE C C --- REMPLISSAGE DE XMATRI C CALL REMPM1(REL,LRE,RE(1,1,ib)) 3005 CONTINUE C ELSE IF(MELEM.EQ.95) THEN C C --- CALCUL DE LA CONTRIBUTION D'UN CABLE CIRCONFERENTIEL A LA C MATRICE DE RIGIDITE C DO 4235 IC=1,NBELE IF(nbem(2,ic).NE.ISOUS) GOTO 4235 CALL ZERO(REL,LRE,LRE) IB=NBEM(1,IC) C write(6,*) 'cable ', ic , 'noeuds' ,NNM(1,IC) C write(6,*) 'beton ', ib , 'noeuds' ,(NUM(j,IB),j=1,NUM(/1)) C CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) call doxe(xcoor,idim,1,nnm,ic,xec) C write(6,*) xec(1,1), xec(2,1) MPTVAL=IVAMAT DO 9005 IM=1,1 IF (IVAL(IM).NE.0) THEN MELVAL=IVAL(IM) IBMN=MIN(ic,VELCHE(/2)) IGMN=MIN(1 ,VELCHE(/1)) VALMAT(IM)=VELCHE(IGMN,IBMN) ELSE VALMAT(IM)=0.D0 ENDIF 9005 CONTINUE C recuperation de le section mptval=ivacar melval=ival(1) igmn=min(1,velche(/1)) ibmn=min(ic,velche(/2)) ssect=velche(igmn,ibmn) YOUNR=VALMAT(1)*ssect/xec(1,1)*2.D0*XPI C write(6,*) ' section youn younr' ,ssect,valmat(1),younr * CALL SHPCAB(1,XE,XEC,MELE,NBNN,IDIM,QSIG,SHPC,XX,SGA,0) call qsijs(xe,mele,nbnn,idim,xec,shpk,qqq,irout) call bmatsc(nbnn,lre,shpk,younr,rel) C C --- REMPLISSAGE DE XMATRI CALL REMPM1(REL,LRE,RE(1,1,ib)) 4235 CONTINUE END IF C IF(IRTD.EQ.0) THEN MOTERR(1:8)=CMATE MOTERR(9:16)=NOMFR(MFR/2+1) INTERR(1)=IFOUR CALL ERREUR(81) ENDIF SEGSUP WRK1 GOTO 510 C C --- SECTEUR DE CALCUL POUR LES ELEMENTS LIQUIDES C 35 CONTINUE c supression GOTO 510 C C --- SECTEUR DE CALCUL POUR LES ELEMENTS DE SURFACE LIBRE C 48 CONTINUE c supression GOTO 510 C C --- MILIEUX POREUX C 79 CONTINUE c supression GOTO 510 C 99 CONTINUE MOTERR(1:4)=NOMTP(MELE) MOTERR(9:12)='RIGIB' CALL ERREUR(86) C 510 CONTINUE SEGSUP,MVELCH SEGDES,MELEME SEGDES,MINTE SEGDES,xMATRI SEGDES,NNUM RETURN END