1 : C MSHEA2 SOURCE CHAT 05/01/13 01:52:58 5004 2 : SUBROUTINE MSHEA2(DEP,ETRANP,ETRANM,FCINI,FCAMP,KCINE,ICAS, 3 : ) ALPHP,ALPHM) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : C 7 : C====================================================================== 8 : C calcul de ALPHP et ALPHM 9 : C====================================================================== 10 : C======================================================================= 11 : C 12 : C LISTE D'ECHANGE 13 : C --------------- 14 : C 15 : C DEP = Deplacement 16 : C ETRANP = zone de transition effective (sens positif) 17 : C ETRANM = (sens négatif) 18 : C FCINI = Force de reference pour la surface cinematique 19 : C FCAMP = Taille de la surface cinematique 20 : C KCINE = Raideur de la surface cinematique 21 : C ICAS = Numero de la branche (3 ou 6) 22 : C 23 : C ALPHP = Valeur de alpha + 24 : C ALPHM = Valeur de alpha - 25 : C 26 : C Warning: valable pour ICAS=3 ou 6 27 : C Warning: on prend comme deplacement celui du centre de la surface elastique 28 : C 29 : C======================================================================= 30 : REAL*8 KCINE,KCINEP,KCINEM 31 : PARAMETER (XZER=0.D0,UN=1.D0) 32 : C 33 : IF(ICAS.EQ.3)THEN 34 : DEPP=DEP+FCAMP/2/KCINE 35 : ELSE 36 : DEPP=DEP-FCAMP/2/KCINE 37 : ENDIF 38 : C DEPP=DEP-FCINI/KCINE 39 : IF (ETRANP.GT.ETRANM)THEN 40 : ALPHP=(DEPP-ETRANM)/(ETRANP-ETRANM) 41 : ALPHP=MAX(XZER,ALPHP) 42 : ALPHP=MIN(UN ,ALPHP) 43 : ALPHM=UN-ALPHP 44 : ELSE 45 : IF(DEPP.GE.ETRANP)THEN 46 : ALPHP=UN 47 : ELSE 48 : ALPHP=XZER 49 : ENDIF 50 : IF(DEPP.LE.ETRANM)THEN 51 : ALPHM=UN 52 : ELSE 53 : ALPHM=XZER 54 : ENDIF 55 : ENDIF 56 : C 57 : RETURN 58 : END 59 : 60 :
© Cast3M 2003 - All rights reserved.
Disclaimer