C CALSIG SOURCE FANDEUR 11/04/12 21:15:08 6938 SUBROUTINE CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT, 1 VALCAR,N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST, 2 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR, 3 XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD) *_______________________________________________________________________ * * * ENTREES : * --------- * * DEPST = INCREMENT DE DEFORMATIONS TOTALES * DDAUX = MATRICE DE HOOKE ELASTIQUE * NSTRS = NBRE DE COMPOSANTES DES DEFORMATIONS * CMATE = NOM DU MATERIAU * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE * MFR = NUMERO DE LA FORMULATION * IFOU = OPTION DE CALCUL * IB = NUMERO DE L ELEMENT COURANT * IGAU = NUMERO DU POINT COURANT * EPAIST= EPAISSEUR * NBPGAU= NBRE DE POINTS DE GAUSS * MELE = NUMERO DE L ELEMENT FINI * NPINT = NBRE DE POINTS D INTEGRATION * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES * SECT = SECTION * LHOOK = TAILLE DE LA MATRICE DE HOOKE * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX UTILISES * POUR LE CALCUL DE LA MATRICE DE HOOKE * * SORTIE : * -------- * * DSIGT = INCREMENT DE CONTRAINTES TOTALES * *_______________________________________________________________________ * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * -INC CCREEL -INC CCOPTIO * *_______________________________________________________________________ * DIMENSION VALMAT(*),VALCAR(*),VAR(1) DIMENSION TXR(IDIM,*),CRIGI(*),S(3) DIMENSION DEPST(*),DSIGT(*) DIMENSION COBMA(20),DDAUX(LHOOK,LHOOK) DIMENSION DDHOMU(LHOOK,LHOOK) DIMENSION XLOC(IDIM,*),XGLOB(IDIM,*) DIMENSION D1HOOK(LHOOK,*),ROTHOO(LHOOK,*) * PARAMETER(DEUX=2.D0,UNDEMI=.5D0) PARAMETER(X774=.774596669241483D0) PARAMETER(SIX=6.D0) * CHARACTER*8 CMATE C C IRTD=1 CALL ZERO(COBMA,LHOOK,1) CALL ZERO(DSIGT,NSTRS,1) * IF(MFR.EQ.15.AND.NBPGAU.EQ.1) THEN S(1)= XZERO ELSE IF(MFR.EQ.15.AND.NBPGAU.EQ.3) THEN S(1)=-X774 S(2)= XZERO S(3)= X774 ENDIF * IF (IB.EQ.1.AND.IGAU.EQ.1) THEN GOTO 1000 * ELSEIF (N2PTEL.EQ.1.AND.N2EL.EQ.1) THEN GOTO 2000 * ELSEIF (N2PTEL.EQ.1.AND.N2EL.NE.1) THEN IF (IGAU.EQ.1) THEN GOTO 1000 ELSE GOTO 2000 ENDIF * ELSE GOTO 1000 * ENDIF C 1000 CONTINUE * * write(6,*) ' calsi , nstrs mfr, nbgmat,nelmat mele , lhook' * write(6,*) ' calsig' , nstrs ,mfr, nbgmat,nelmat, mele ,lhook IRET=1 CALL ZERO(DDAUX,LHOOK,LHOOK) * IF (CMATE.EQ.'ISOTROPE') THEN * Les modeles de comportement necessaitant l'appel a CALSIG ne * correspondent pas aux modeles de comportement dont la valeur * de INAT est referencee dans HOOKIS. Par consequent, nous * CHOISISSONS de fixer ARBITRAIREMENT INAT a 0 dans le present * sous-programme ! INAT = 0 CALL HOOKIS(VALMAT,VALCAR,VAR,MFR,IB,IGAU,0.D0,EPAIST, + INAT,MELE,NPINT,IFOU,1,NBGMAT,NELMAT, + S,SECT,LHOOK,DDHOMU,DDAUX, + COBMA,XMOB,IRET) * write(6,*) ' calsig apres hookis iret ' , iret C ELSE IF (CMATE.EQ.'ORTHOTRO') THEN CALL HOOKOR(VALMAT,IB,IGAU,MFR,0.D0,EPAIST, + MELE,NPINT,IFOU,1,NBGMAT,NELMAT,SECT,LHOOK, + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDAUX, + COBMA,XMOB,IRET) C ELSE IF (CMATE.EQ.'ANISOTRO') THEN CALL HOOKAN(VALMAT,IB,IGAU,MFR,IFOU,1,NBGMAT,NELMAT, + SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDAUX, + MELE,COBMA,XMOB,IRET) C ELSE IF (CMATE.EQ.'UNIDIREC') THEN CALL HOOKUN(VALMAT,IB,IGAU,MFR,0.D0,EPAIST, + MELE,NPINT,IFOU,1,NBGMAT,NELMAT,SECT,LHOOK, + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDAUX, + COBMA,XMOB,IRET) C ELSE IF (CMATE.EQ.'HOMOGENE') THEN CALL HOOKHO(VALMAT,IB,IGAU,MFR,NBGMAT,NELMAT,SECT, + LHOOK,DDAUX,IRET) C ELSE IF (CMATE.EQ.'SECTION') THEN CALL HOOKSE(VALMAT,IB,IGAU,MFR,CRIGI,IFOU, + NBGMAT,NELMAT,SECT,LHOOK,DDAUX,IRET) C ENDIF * IF (IRET.LE.0 ) GOTO 9990 C * * cas des champs uniformes -> on ne recalcule pas DDAUX * 2000 CONTINUE * * cas des milieux poreux : 2 cas selon la valeur de NSTRS * IF(MFR.EQ.33.AND.LHOOK.LT.NSTRS) THEN * * cas sigeff * IF(XMOB.EQ.0.D0) THEN UNSURM=0.D0 ELSE UNSURM=1.D0/XMOB ENDIF * DO 4500 I=1,LHOOK DSIGT(I)=-COBMA(I)*DEPST(NSTRS) DO 45001 J=1,LHOOK DSIGT(I)=DSIGT(I)+DDAUX(I,J)*DEPST(J) 45001 CONTINUE 4500 CONTINUE DSIGT(NSTRS)=DEPST(NSTRS)*UNSURM DO 4502 I=1,LHOOK DSIGT(NSTRS)=DSIGT(NSTRS)+COBMA(I)*DEPST(I) 4502 CONTINUE * * autres cas * ELSE DO 5500 I=1,LHOOK DSIGT(I)=0.D0 DO 55001 J=1,LHOOK DSIGT(I)=DSIGT(I)+DDAUX(I,J)*DEPST(J) 55001 CONTINUE 5500 CONTINUE ENDIF * * CAS DES TUYAUX FISSURES * IF (MFR.EQ.17) THEN * YOU=VALMAT(1) RAYO=VALCAR(1) EPAI=VALCAR(2) TETA1=VALCAR(9)*UNDEMI C CONVERSION DE TETA1 EN RADIAN TETA = (TETA1 * XPI)/180.D0 TESPI = TETA/XPI C ON MET DANS 'RAYMO' LE RAYON MOYEN DU TUYAU. RAYMO =RAYO - (EPAI/DEUX) C CALCUL DE A COEFIICIENT ZAHOR RSURT=RAYMO / EPAI IF(RSURT.LE.10.D0.AND.RSURT.GE.4.9D0) THEN AXX = ( .125D0*RSURT - .25D0 ) **.25D0 ELSE IF(RSURT.GT.10.D0.AND.RSURT.LE.35.D0) THEN AXX = ( .4D0*RSURT - 3.D0 ) **.25D0 ELSE KERRE=3 ENDIF CALL TUFIFP(TESPI,AXX,FP,FM,FMP,FOP,FOM) C C C FACTEUR D INTENSITE DES CONTRAINTES C IF(TETA1.LE.(0.5D0))THEN DSIGT(7)=XZERO DSIGT(8)=XZERO GOTO 9992 ENDIF SQQ= XPI * RAYMO * TETA SQQ= SQRT(SQQ) XEX= SQQ * FOP/(DEUX * XPI * RAYMO *EPAI) XFL= SQQ * FOM/(XPI * RAYMO * RAYMO *EPAI) DSIGT(7)=XEX * DSIGT(1) - XFL * DSIGT(6) C C CALCUL DES AIRES DE BRECHE NOTE TECHNIQUE DRE/STRE/LMA 85/695 C SIGM=DSIGT(1)/( DEUX * XPI * RAYMO * EPAI ) SIGF=DSIGT(6)/( XPI * RAYMO * RAYMO * EPAI ) XIM= XPI * RAYMO * RAYMO * DEUX * TETA * TETA * FP /YOU XIF= XIM * ( .75D0 +(.25D0 * COS ( TETA ))) DSIGT(8)=XIM * SIGM - XIF * SIGF ENDIF C * * CAS DES LISP ET LISM * IF (MFR.EQ.15) THEN EPA1=VALCAR(1) EPA2=VALCAR(6) FISS1=VALCAR(2) FISS2=VALCAR(7) FISS1 = (FISS1*(UNDEMI +UNDEMI/X774))+ + (FISS2*(UNDEMI-UNDEMI/X774)) FISS2 = (FISS1*(UNDEMI -UNDEMI/X774))+ + (FISS2*(UNDEMI+UNDEMI/X774)) W=(EPA1+EPA2)*UNDEMI H1=UNDEMI-UNDEMI*S(IGAU) H2=UNDEMI+UNDEMI*S(IGAU) A= H1*FISS1+H2*FISS2 ASURW=(H1*FISS1+H2*FISS2)/W CALL LISPFI(ASURW,FM,FF) X1=DSIGT(1)/W X4=DSIGT(4)*SIX/(W*W) XXX=XPI*A XXX=SQRT(XXX) XKIE=(X1*FM+X4*FF)*XXX DSIGT(6)= XKIE * ENDIF * GOTO 9992 * * ERREUR , RETOUR * 9990 CONTINUE IRTD=0 * 9992 RETURN END