1 : C DYCHEC SOURCE CHAT 05/01/12 23:05:18 5004 2 : SUBROUTINE DYCHEC(XDEP,XDPLAS,XDPLAC,XJEU,IPERM,XABSCI, 3 : & XORDON,I,XFLA,NLIAB,NIP,XVIT,XAMO,iannul) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : *--------------------------------------------------------------------* 7 : * * 8 : * Operateur DYNE : algorithme de Fu - de Vogelaere * 9 : * ________________________________________________ * 10 : * * 11 : * Calcul de la force de choc pour un choc elementaire * 12 : * point-point- ... -plastique. On recupere en entree * 13 : * la loi de comportement sous la forme d'une evolution. * 14 : * * 15 : * Parametres: * 16 : * * 17 : * e XDEP Valeur du deplacement. * 18 : * es XDPLAS Valeur du deplacement plastique (du pas precedent * 19 : * en entree, du pas actuel en sortie) * 20 : * es XDPLAC Valeur du deplacement plastique cumulé (du pas * 21 : * precedent en entree, du pas actuel en sortie) * 22 : * e XRAID Valeur de la raideur. * 23 : * e XJEU Valeur de la limite de force elastique (positive) * 24 : * e XABSCI Tableau contenant les abscisses de la loi plastique * 25 : * pour la liaison point-point-plastique * 26 : * e XORDON Tableau contenant les ordonnees de la loi plastique * 27 : * e I numero de la liaison. * 28 : * pour la liaison point-point-plastique * 29 : * e IPERM Indice du type de liaison (permanence et ecrouissage) * 30 : * * 31 : * iperm = -2 : liaison elastique permanente * 32 : * iperm = -1 : choc elastique * 33 : * iperm = 1 : choc plastique * 34 : * iperm = 2 : liaison plastique isotrope * 35 : * iperm = 3 : liaison plastique cinematique * 36 : * * 37 : * s XFLA Valeur de la force de choc. * 38 : * * 39 : * * 40 : * Auteur, date de creation: * 41 : * * 42 : * Lenaic FICHET 09/97 point-point- ... -plastique * 43 : * * 44 : *--------------------------------------------------------------------* 45 : * 46 : REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*) 47 : if (iannul.eq.1) then 48 : xfla = 0.D0 49 : return 50 : endif 51 : XRAID = XORDON(I,2)/XABSCI(I,2) 52 : * 53 : *********** CHOC PLASTIQUE *********** 54 : c une sorte d'ecrouissage cinematique en supposant que la 55 : c decharge jusqu' a la contrainte 0 est toujours lineaire 56 : 57 : IF (IPERM.EQ.1) THEN 58 : XTOT = XDEP - XJEU 59 : XVAL = XTOT - XDPLAS 60 : 61 : IF (XVAL.GE.0.D0) THEN 62 : 63 : XFLAT = XRAID*XVAL 64 : xdpla2 = xval + xdplas 65 : 65 : CALL LIRANG(xdpla2,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP) 66 : XFLAC = abs(XORDON(I,NRG) + XPENTE*(xdpla2-XABSCI(I,NRG))) 67 : 68 : IF (ABS(XFLAT).GT.XFLAC) THEN 69 : xfla = xflac 70 : XDPLAS = XTOT - XFLA/XRAID 71 : XDPLAC = XDPLAS 72 : ELSE 73 : XFLA = XFLAT 74 : ENDIF 75 : xfla = xfla + xamo*xvit 76 : if (xfla.lt.0.d0) xfla = 0.d0 77 : else 78 : xfla = 0.d0 79 : endif 80 : xfla = -xfla 81 : 82 : 83 : 84 : ************** Cas ecrouissage isotrope ************** 85 : ELSE IF (IPERM.EQ.2) THEN 86 : 87 : XVAL = XDEP - XDPLAS 88 : XFLAT = XRAID*XVAL 89 : xdpla2 = abs(xval) + xdplac 90 : 90 : CALL LIRANG(xdpla2,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP) 91 : XFLAC = abs(XORDON(I,NRG) + XPENTE*(xdpla2-XABSCI(I,NRG))) 92 : 93 : IF (ABS(XFLAT).GT.XFLAC) THEN 94 : if (xflat.gt.0) xfla = xflac 95 : if (xflat.le.0) xfla = -xflac 96 : XDPLA0 = XDPLAS 97 : XDPLAS = XDEP - XFLA/XRAID 98 : XDPLAC = XDPLAC + ABS(XDPLAS - XDPLA0 ) 99 : ELSE 100 : XFLA = XFLAT 101 : ENDIF 102 : xfla = xfla + xamo*xvit 103 : xfla = -xfla 104 : 105 : 106 : ********** Cas ecrouissage cinematique (bilineaire) ********** 107 : ELSE IF (IPERM.EQ.3) THEN 108 : XRAID2 = (XORDON(I,3)-XORDON(I,2))/ 109 : & (XABSCI(I,3)-XABSCI(I,2)) 110 : xraidp = xraid*xraid2 /(xraid - xraid2) 111 : bacstr = xraidp*xdplas 112 : XVAL = XDEP - XDPLAS 113 : XFLAT = XRAID*XVAL 114 : xstres = xflat - bacstr 115 : if (xstres.ge.0) xcrit = XORDON(I,2) 116 : if (xstres.lt.0) xcrit = -XORDON(I,2) 117 : dxfl = xstres - xcrit 118 : 119 : IF (abs(xstres) .LE. abs(xcrit)) THEN 120 : XFLA = XFLAT 121 : ELSE 122 : xdp2 = dxfl/xraid 123 : XFLA = xflat - dxfl + xdp2*xraid2 124 : XDPLA0 = XDPLAS 125 : XDPLAS = XDEP - XFLA/XRAID 126 : XDPLAC = XDPLAC + ABS(XDPLAS - XDPLA0 ) 127 : ENDIF 128 : xfla = xfla + xamo*xvit 129 : 130 : XFLA = -XFLA 131 : 132 : ********** Cas elastique permanent ********** 133 : ELSE IF (IPERM.EQ.-2) THEN 134 : XVAL = abs(XDEP) 134 : CALL LIRANG(XVAL,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP) 135 : XFLA = (XORDON(I,NRG) + XPENTE*(XVAL-XABSCI(I,NRG))) 136 : if (xdep.lt.0d0) xfla = -xfla 137 : xfla = -xfla - XAMO * XVIT 138 : 139 : ********** Choc elastique ********** 140 : ELSE IF (IPERM.EQ.-1) THEN 141 : IF (XDEP.GE.XJEU) THEN 142 : XVAL = XDEP - XJEU 142 : CALL LIRANG(XVAL,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP) 143 : XFLA = - (XORDON(I,NRG) + XPENTE*(XVAL-XABSCI(I,NRG))) 144 : & - XAMO * XVIT 145 : IF ( XFLA.GT.0.D0) XFLA = 0.D0 146 : ELSE 147 : XFLA = 0.D0 148 : ENDIF 149 : 150 : 151 : ********* autre cas ******* 152 : * ELSE IF (IPERM.EQ. ) THEN 153 : 154 : ENDIF 155 : 156 : END 157 : 158 : 159 : 160 : 161 : 162 : 163 : 164 : 165 :
© Cast3M 2003 - All rights reserved.
Disclaimer