1 : C MSHEA1 SOURCE CHAT 05/01/13 01:52:55 5004 2 : SUBROUTINE MSHEA1(DEP,ICAS,FOR,DPLUS,DMOIN, DTRANP,DTRANM, 3 : > APLUS,CURFP,NCURFP,CURKP,NCURKP,CURLP,NCURLP, 4 : > AMOIN,CURFM,NCURFM,CURKM,NCURKM,CURLM,NCURLM, 5 : > FCINI,FCAMP,KCINE) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8(A-H,O-Z) 8 : C 9 : C====================================================================== 10 : C calcul des caracteristiques de la surface 11 : C cinematique en tenant compte de la zone de transition 12 : C WARNING: moyenne arithmetique pour l'amplitude 13 : C et geometrique pour la raideur 14 : C2003??? WARNING: il faut iterer parceque KCINE0 depend de ALPHP et que 15 : C2003??? ALPHP depend de KCINE0 16 : C====================================================================== 17 : C======================================================================= 18 : C 19 : C LISTE D'ECHANGE 20 : C --------------- 21 : C 22 : C DEP = Deplacement 23 : C ICAS = Numero de la branche 24 : C FOR = Effort 25 : C DPLUS = Deplacement de reference + 26 : C DMOIN = Deplacement de reference - 27 : C DTRANP = zone de transition (sens positif) 28 : C DTRANM = (sens négatif) 29 : C 30 : C CURFP,NCURFP = courbe de charge + (x>0,y>0) 31 : C CURKP,NCURKP = courbe de raideur + (x>0,y>0) 32 : C CURLP,NCURLP = courbe de domaine elastique + (x>0,y>0) 33 : C CURFM,NCURFM = courbe de charge - (x<0,y<0) 34 : C CURKM,NCURKM = courbe de raideur - (x<0,y>0) 35 : C CURLM,NCURLM = courbe de domaine elastique - (x<0,y>0) 36 : C 37 : C FCINI = Force de reference pour la surface cinematique 38 : C FCAMP = Taille de la surface cinematique 39 : C KCINE = Raideur de la surface cinematique 40 : C2003 ALPHP = Valeur de alpha + 41 : C 42 : C======================================================================= 43 : C 44 : REAL*8 KCINE,KCINEP,KCINEM 45 : PARAMETER (XZER=0.D0,UN=1.D0) 46 : DIMENSION CURFP(2,NCURFP),CURKP(2,NCURKP),CURLP(2,NCURLP) 47 : DIMENSION CURFM(2,NCURFM),CURKM(2,NCURKM),CURLM(2,NCURLM) 48 : C 49 : FCINI=FOR 49 : CALL YOFXCU(DPLUS,CURFP,NCURFP, FPLUS ,DYSDX,KERRE) 50 : FPLUS=FPLUS*(UN-APLUS) 50 : CALL YOFXCU(DPLUS,CURLP,NCURLP, FCAMPP,DYSDX,KERRE) 51 : FCAMPP=FCAMPP*(UN-APLUS) 51 : CALL YOFXCU(DPLUS,CURKP,NCURKP, KCINEP,DYSDX,KERRE) 51 : CALL YOFXCU(DMOIN,CURFM,NCURFM, FMOIN ,DYSDX,KERRE) 52 : FMOIN=FMOIN*(UN-AMOIN) 52 : CALL YOFXCU(DMOIN,CURLM,NCURLM, FCAMPM,DYSDX,KERRE) 53 : FCAMPM=FCAMPM*(UN-AMOIN) 53 : CALL YOFXCU(DMOIN,CURKM,NCURKM, KCINEM,DYSDX,KERRE) 54 : DDPLUS=DPLUS-FCAMPP/KCINEP 55 : DDMOIN=DMOIN+FCAMPM/KCINEM 56 : C 57 : IF (ICAS.EQ.1)THEN 58 : C CHARGEMENT MONOTONE DIRECTION + 59 : FCAMP=FCAMPP 60 : KCINE=KCINEP 61 : ELSEIF(ICAS.EQ.3)THEN 62 : C BRANCHE DE UNLOADING ANELASTIQUE - 63 : ALPHP=(DEP-DMOIN)/(DDPLUS-DMOIN) 64 : FCAMP=ALPHP*FCAMPP+(UN-ALPHP)*FCAMPM 65 : KCINE=FCAMP/(ALPHP*FCAMPP/KCINEP+(UN-ALPHP)*FCAMPM/KCINEM) 66 : ELSEIF(ICAS.EQ.4)THEN 67 : C CHARGEMENT MONOTONE DIRECTION - 68 : FCAMP=FCAMPM 69 : KCINE=KCINEM 70 : ELSEIF(ICAS.EQ.6)THEN 71 : C BRANCHE DE UNLOADING ANELASTIQUE + 72 : ALPHP=(DEP-DDMOIN)/(DPLUS-DDMOIN) 73 : FCAMP=ALPHP*FCAMPP+(UN-ALPHP)*FCAMPM 74 : KCINE=FCAMP/(ALPHP*FCAMPP/KCINEP+(UN-ALPHP)*FCAMPM/KCINEM) 75 : ENDIF 76 : C 77 : C 2003DEPP=DEP-FCINI/KCINE 78 : C 2003ALPHP=(DEPP-DTRANM)/(DTRANP-DTRANM) 79 : C 2003ALPHP=MAX(XZER,ALPHP) 80 : C 2003ALPHP=MIN(UN ,ALPHP) 81 : C 82 : RETURN 83 : END 84 : 85 :
© Cast3M 2003 - All rights reserved.
Disclaimer