calsig
C CALSIG SOURCE PV 22/04/22 21:15:02 11344 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 PPARAM -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(3,3),XGLOB(3,3) 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 * 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,cmate' * write(6,*) 'calsig' ,nstrs,mfr, nbgmat,nelmat, mele ,lhook,cmate IRET=1 * IF (CMATE.EQ.'ISOTROPE'.or.CMATE.EQ.'IMPELAST') 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 + INAT,MELE,NPINT,IFOU,1,NBGMAT,NELMAT, + S,SECT,LHOOK,DDHOMU,DDAUX, + COBMA,XMOB,IRET) C ELSE IF (CMATE.EQ.'ORTHOTRO') THEN + 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 + SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDAUX, + MELE,COBMA,XMOB,IRET) C ELSE IF (CMATE.EQ.'UNIDIREC') THEN + 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 + LHOOK,DDAUX,IRET) C ELSE IF (CMATE.EQ.'SECTION') THEN + 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,min(LHOOK,NSTRS) DSIGT(I)=0.D0 DO 55001 J=1,min(LHOOK,NSTRS) 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 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 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= 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 ) 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 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
© Cast3M 2003 - Tous droits réservés.
Mentions légales