C DYCHEC SOURCE CHAT 05/01/12 23:05:18 5004 SUBROUTINE DYCHEC(XDEP,XDPLAS,XDPLAC,XJEU,IPERM,XABSCI, & XORDON,I,XFLA,NLIAB,NIP,XVIT,XAMO,iannul) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Operateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Calcul de la force de choc pour un choc elementaire * * point-point- ... -plastique. On recupere en entree * * la loi de comportement sous la forme d'une evolution. * * * * Parametres: * * * * e XDEP Valeur du deplacement. * * es XDPLAS Valeur du deplacement plastique (du pas precedent * * en entree, du pas actuel en sortie) * * es XDPLAC Valeur du deplacement plastique cumulé (du pas * * precedent en entree, du pas actuel en sortie) * * e XRAID Valeur de la raideur. * * e XJEU Valeur de la limite de force elastique (positive) * * e XABSCI Tableau contenant les abscisses de la loi plastique * * pour la liaison point-point-plastique * * e XORDON Tableau contenant les ordonnees de la loi plastique * * e I numero de la liaison. * * pour la liaison point-point-plastique * * e IPERM Indice du type de liaison (permanence et ecrouissage) * * * * iperm = -2 : liaison elastique permanente * * iperm = -1 : choc elastique * * iperm = 1 : choc plastique * * iperm = 2 : liaison plastique isotrope * * iperm = 3 : liaison plastique cinematique * * * * s XFLA Valeur de la force de choc. * * * * * * Auteur, date de creation: * * * * Lenaic FICHET 09/97 point-point- ... -plastique * * * *--------------------------------------------------------------------* * REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*) if (iannul.eq.1) then xfla = 0.D0 return endif XRAID = XORDON(I,2)/XABSCI(I,2) * *********** CHOC PLASTIQUE *********** c une sorte d'ecrouissage cinematique en supposant que la c decharge jusqu' a la contrainte 0 est toujours lineaire IF (IPERM.EQ.1) THEN XTOT = XDEP - XJEU XVAL = XTOT - XDPLAS IF (XVAL.GE.0.D0) THEN XFLAT = XRAID*XVAL xdpla2 = xval + xdplas CALL LIRANG(xdpla2,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP) XFLAC = abs(XORDON(I,NRG) + XPENTE*(xdpla2-XABSCI(I,NRG))) IF (ABS(XFLAT).GT.XFLAC) THEN xfla = xflac XDPLAS = XTOT - XFLA/XRAID XDPLAC = XDPLAS ELSE XFLA = XFLAT ENDIF xfla = xfla + xamo*xvit if (xfla.lt.0.d0) xfla = 0.d0 else xfla = 0.d0 endif xfla = -xfla ************** Cas ecrouissage isotrope ************** ELSE IF (IPERM.EQ.2) THEN XVAL = XDEP - XDPLAS XFLAT = XRAID*XVAL xdpla2 = abs(xval) + xdplac CALL LIRANG(xdpla2,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP) XFLAC = abs(XORDON(I,NRG) + XPENTE*(xdpla2-XABSCI(I,NRG))) IF (ABS(XFLAT).GT.XFLAC) THEN if (xflat.gt.0) xfla = xflac if (xflat.le.0) xfla = -xflac XDPLA0 = XDPLAS XDPLAS = XDEP - XFLA/XRAID XDPLAC = XDPLAC + ABS(XDPLAS - XDPLA0 ) ELSE XFLA = XFLAT ENDIF xfla = xfla + xamo*xvit xfla = -xfla ********** Cas ecrouissage cinematique (bilineaire) ********** ELSE IF (IPERM.EQ.3) THEN XRAID2 = (XORDON(I,3)-XORDON(I,2))/ & (XABSCI(I,3)-XABSCI(I,2)) xraidp = xraid*xraid2 /(xraid - xraid2) bacstr = xraidp*xdplas XVAL = XDEP - XDPLAS XFLAT = XRAID*XVAL xstres = xflat - bacstr if (xstres.ge.0) xcrit = XORDON(I,2) if (xstres.lt.0) xcrit = -XORDON(I,2) dxfl = xstres - xcrit IF (abs(xstres) .LE. abs(xcrit)) THEN XFLA = XFLAT ELSE xdp2 = dxfl/xraid XFLA = xflat - dxfl + xdp2*xraid2 XDPLA0 = XDPLAS XDPLAS = XDEP - XFLA/XRAID XDPLAC = XDPLAC + ABS(XDPLAS - XDPLA0 ) ENDIF xfla = xfla + xamo*xvit XFLA = -XFLA ********** Cas elastique permanent ********** ELSE IF (IPERM.EQ.-2) THEN XVAL = abs(XDEP) CALL LIRANG(XVAL,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP) XFLA = (XORDON(I,NRG) + XPENTE*(XVAL-XABSCI(I,NRG))) if (xdep.lt.0d0) xfla = -xfla xfla = -xfla - XAMO * XVIT ********** Choc elastique ********** ELSE IF (IPERM.EQ.-1) THEN IF (XDEP.GE.XJEU) THEN XVAL = XDEP - XJEU CALL LIRANG(XVAL,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP) XFLA = - (XORDON(I,NRG) + XPENTE*(XVAL-XABSCI(I,NRG))) & - XAMO * XVIT IF ( XFLA.GT.0.D0) XFLA = 0.D0 ELSE XFLA = 0.D0 ENDIF ********* autre cas ******* * ELSE IF (IPERM.EQ. ) THEN ENDIF END