Download mshea1.eso

Back to the list

   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