Download dechat.eso

Back to the list

   1 : C DECHAT    SOURCE    CHAT      05/01/12    22:39:01     5004           
   2 : C DECHAT     SOURCE    INSL       24/10/96    
   3 :       SUBROUTINE DECHAT(EPSRX,STRNX,STRNRX,SIGMRX,TANG,S1X,EDT,EDC,
   4 :      1 EPST,DEFR,IFISU,IPLA,EQSTR,RTM,EPSC,IREFE,EX,RB,ALPHA,EPSU,
   5 :      2 EPO1,ICAL,IBB1,IGAU1,IDIR,PASDT)
   6 : C
   7 :       IMPLICIT INTEGER(I-N)
   8 :       IMPLICIT REAL*8(A-H,O-Z)
   9 :       CHARACTER*8 PASDT
  10 : C
  11 : C       CE SOUS-PROGRAMME GERE LA REFERMETURE DES FISSURES.
  12 : C       CALCUL DE LA NOUVELLE PENTE EDT (RESTAURATION PROGRESSIVE
  13 : C         DE LA RAIDEUR DE LA FISSURE
  14 : C
  15 :       IREFE=0
  16 :       RBT=ALPHA*RB
  17 :       REFERM=3.D0*EPSU
  18 :       IF(DABS(EDC).LT.0.1D-06) EDC=0.D0
  19 :       IF(EDC.NE.0.D0) REFERM=REFERM+DEFR
  20 :       IF(STRNRX.GT.EPSRX) RETURN
  21 :       IF(STRNRX.GT.REFERM) THEN
  22 :         IREFE=1
  23 :         S1X=0.D0
  24 :         RETURN
  25 :       ENDIF
  26 :       IFISU=0
  27 :       IF(EDC.NE.0.D0) EPST=DEFR-RBT/EDC
  28 : C
  29 : C       REFERMETURE POUR UN POINT INITIALLEMENT TENDU
  30 : C
  31 : C       CALCUL DU MODULE EDT LORS DE LA REFERMETURE
  32 : C
  33 : C     
  34 :        IF(STRNRX.GT.EPST) THEN
  35 :         IF(EPSRX.LE.REFERM)THEN
  36 :          EDT=(RBT+RTM)/(EPSRX-EPST)
  37 :          IF(IPLA.EQ.2.AND.EQSTR.LT.RBT) EDT=EQSTR/(EPSRX-EPST)
  38 :          S1X=EDT*STRNX+RTM
  39 :         ELSE
  40 :          EDT=RBT/(REFERM-EPST)
  41 :          IF(IPLA.EQ.2.AND.EQSTR.LT.RBT) EDT=EQSTR/(REFERM-EPST)
  42 :          S1X=EDT*(STRNRX-REFERM)
  43 :         ENDIF
  44 :         TANG=EDT
  45 :        ELSE
  46 :         IF(STRNRX.LT.EPSC) THEN
  47 :          EPEQ=DABS(STRNRX)
  47 :          CALL CDCY(EPEQ,SEQ,IPLA,TANG,EX,RB,EMAX,EPO1,ICAL)
  48 : C
  49 : C       ACTUALISATION DE EQSTR
  50 : C
  51 :          EQSTR=SEQ
  52 :          S1X=-SEQ
  53 :         ELSE
  54 : C
  55 : C ON EST SUR LA PENTE EDC
  56 : C
  57 :          S1X=EDC*(STRNRX-DEFR)
  58 :          TANG=EDC
  59 :         ENDIF
  60 :        ENDIF
  61 :        IF(EDT.LT.0.D0) THEN
  62 :          WRITE(*,*) ' !!!!  ATTENTION DANS DECHART EDT < 0 APPELE PAR'
  63 :      &  ,PASDT  
  64 :            WRITE(*,94) IBB1,IGAU1,IDIR
  65 :  94        FORMAT(' ELEME=',I3,'POINT=',I2,' IDIR=',I2)
  66 :            WRITE(*,*)'RTM=',RTM,'RBT=',RBT,'IPLA=',IPLA,'IFISU=',IFISU
  67 :            WRITE(*,*) 'EPSRX= ',EPSRX,' SIGMRX= ',SIGMRX
  68 :            WRITE(*,*) 'STRNRX= ',STRNRX,' EPSC= ',EPSC
  69 :            WRITE(*,*) 'EQSTR= ',EQSTR,' EPST= ',EPST,' DEFR=',DEFR
  70 :            WRITE(*,*) 'ERREUR EDT<0 ! EDT=',EDT,' EDC=',EDC
  71 :            STOP
  72 :           ENDIF
  73 :       RETURN
  74 :       END
  75 :  
  76 :  

© Cast3M 2003 - All rights reserved.
Disclaimer