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