Sources Esope | Cast3M

fispla
C FISPLA    SOURCE    CB215821  16/04/21    21:16:51     8920
C FISPLA     SOURCE    INSL       24/10/96
      SUBROUTINE FISPLA(EPSR,STRN,STRNR,SIGR,SIGM,S1,NSTRS,IFOUR,
     A ITES,XE,NBNN,MELE,wrk12)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
      DIMENSION EPSR(6),STRN(NSTRS),SIGM(NSTRS),S1(NSTRS),STRNR(6)
      DIMENSION SIGR(6),XE(3,NBNN),ST0X(6),SI0X(6)
      DIMENSION ST(3),ST0(3),SI0(3),SI(3),DSI(3),DSI0X(6),DST(3)
C
       segment wrk12
       real*8 AA,BB,DK1,DK2,RB,ALPHA,EX,PXY,EMAX
       real*8 EPSU,FTC,EPO,EPO1,ENGF,RMOY,PHIF,TEMP0
       real*8 DTEMP1,TEMP1,POAR,SCT,TETA,RMT1,RMT2,EDC1
       real*8 EDC2,ETS1,ETS2,EDT1,EDT2,OUV1,OUV2,TANG1
       real*8 TANG2,DEFR1,DEFR2,EPSC1,EPSC2,EPST1,EPST2,EQSTR1
       real*8 EQSTR2,EPSEQ1,EPSEQ2,EQSTR3,EPSEQ3,EPST3,EPSC3,DEFR3
       real*8 RTM3,EDC3,ETS3,EDT3,OUV3,TANG3
       integer ICU,ILOI,IOUV,ICAL,IFLU,IPLA2,IPLA1,IFISU2
       integer IFISU1,JFISU,JFISU2,IPLA3,IFISU3,JFISU3,IBB1,IGAU1
       endsegment
*      COMMON /CINSA/ AA,BB,DK1,DK2,RB,ALPHA,EX,PXY,EMAX,EPSU,FTC,EPO,
*     1       EPO1,ENGF,RMOY,PHIF,TEMP0,DTEMP1,TEMP1,POAR,SCT,TETA,
*     2       RTM1,RTM2,EDC1,EDC2,ETS1,ETS2,EDT1,EDT2,OUV1,OUV2,TANG1,
*     3       TANG2,DEFR1,DEFR2,EPSC1,EPSC2,EPST1,EPST2,EQSTR1,EQSTR2,
*     4       EPSEQ1,EPSEQ2,EQSTR3,EPSEQ3,EPST3,EPSC3,DEFR3,RTM3,EDC3,
*     5       ETS3,EDT3,OUV3,TANG3,
*     6       ICU,ILOI,IOUV,ICAL,IFLU,IPLA2,IPLA1,IFISU2,IFISU1,
*     7       JFISU,JFISU2,IPLA3,IFISU3,JFISU3,IBB1,IGAU1
C--------------------------------------------------------------------
C           ############################################
C           *           POINT DEJA FISSURE             *
C           *      COMPORTEMENT   ELASTOPLASTIQUE      *
C           ############################################
C----------------------------------------------------------
*
* Calibrage de la deformation plastique et de la pente
* poste pic : Gf
*
      IF(ENGF.NE.0.D0) CALL LONCA(EX,RB,ALPHA,EPSU,XE,NBNN,ENGF,MELE)
*
      TU=RB
      FPT=ALPHA*RB
      EB1=0.D0
      EB2=0.D0
C----------------------------------------------------------
      CALL ZERO(ST0X,6,1)
      CALL ZERO(SI0X,6,1)
      CALL ZERO(DSI0X,6,1)
      CALL ZERO(SI,3,1)
      CALL ZERO(DSI,3,1)
      CALL ZERO(DST,3,1)
C----------------------------------------------------------
      IF(ITES.EQ.1) SCT=0.D0
      DO 11 I=1,NSTRS
          DSI0X(I)=(1.D0-SCT)*SIGM(I)
          ST0X(I) =EPSR(I)+SCT*STRN(I)
          SI0X(I) =SIGR(I)+SCT*SIGM(I)
  11  CONTINUE
C
      IF(NSTRS.EQ.4.OR.NSTRS.EQ.6) THEN
          ST0X(3) =EPSR(4)+SCT*STRN(4)
          ST0X(4) =EPSR(3)+SCT*STRN(3)
          SI0X(3) =SIGR(4)+SCT*SIGM(4)
          SI0X(4) =SIGR(3)+SCT*SIGM(3)
          DSI0X(3)=(1.D0-SCT)*SIGM(4)
          DSI0X(4)=(1.D0-SCT)*SIGM(3)
      ENDIF
C----------------------------------------------------------
      PHI=TETA-90.D0
      CALL CDRF(SI0X,PHI,SI0)
      CALL CDRF(DSI0X,PHI,DSI)
      CALL DDRF(ST0X,PHI,ST0)
C----------------------------------------------------------
      IF(ITES.EQ.0) THEN
         ST0(1)=ST0(1)+PXY*SI0(2)/EX
         ST0(2)=ST0(2)+PXY*SI0(1)/EX
      ENDIF
C----------------------------------------------------------
C----------------------------------------------------------
      IPASN =0
      IELM1 =0
C----------------------------------------------------------
      IF(IPASN.EQ.1.AND.IBB1.EQ.IELM1) THEN
      WRITE(*,*) '=========================================='
     & ,'=================================================='
        WRITE(*,*) '***   ST0X / SI0X  '
        WRITE(*,1991) (ST0X(I),I=1,NSTRS),(SI0X(I),I=1,NSTRS)
        WRITE(*,*) ' ** SIGR  / SIGM  ITES =',ITES
        WRITE(*,1991) (SIGR(IC),IC=1,NSTRS),(SIGM(IC),IC=1,NSTRS)
        WRITE(*,*) '***   SI0 (AVANT DECHINT2) / ST0  RTM1=',RTM1
     &   ,' TETA=',TETA,' SCALT=',SCT
        IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
         WRITE(*,1991) ((SI0(I),I=1,3),SI0X(4),ST0(J),J=1,3),ST0X(4)
        ELSE
         WRITE(*,1991) (SI0(I),I=1,3),(ST0(I),I=1,3)
        ENDIF
      ENDIF
C----------------------------------------------------------
C----------------------------------------------------------
      IF(ITES.EQ.0) THEN
C----------------------------------------------------------
C       INITIALISATIONS POUR  PLAEND
        TANG1=EX
        TANG2=EX
        CALL EPSEQU(EPST,FPT,0,ICAL,1,EX,RB,EPO1,EPO1,EMAX)
        EPST1= -1.D0*EPST
        EPST2= EPST1
C
        JFISU=2
        JFISU2=0
        JFISU3=0
        IFISU1=0
        IFISU2=0
        IPLA1=0
        IPLA2=0
        EPSEQ1=0.D0
        EQSTR1=0.D0
        EDC1=0.D0
        EDT1=0.D0
        EPSC1=0.D0
        DEFR1=0.D0
        EPSEQ2=0.D0
        EQSTR2=0.D0
        EDC2=0.D0
        EDT2=0.D0
        EPSC2=0.D0
        DEFR2=0.D0
        ETS2 = 1.D+20
        RTM2 =FPT
        EEP2=RTM2/EX-EPSU
        IF(ABS(EEP2).GT.1.D-20) ETS2=ABS(RTM2/EEP2)
        ETS1=ETS2
C
C       INITIALISATIONS DES VARIABLES INTERNES (DIRECTION 1)
C
        CALL DECHIN(SI0(1),ST0(1),ETS1,EDC1,EPST1,IFISU1,JFISU,
     1  RTM1,EPSC1,DEFR1,TANG1,IPLA1,EQSTR1,EPSEQ1,EX,RB,ALPHA,EPO1,
     2  EMAX,ICAL,IBB1,IGAU1,1)
C
C       INITIALISATIONS DES VARIABLES INTERNES (DIRECTION 2)
C
        CALL DECHIN(SI0(2),ST0(2),ETS2,EDC2,EPST2,IFISU2,JFISU2,
     1  RTM2,EPSC2,DEFR2,TANG2,IPLA2,EQSTR2,EPSEQ2,EX,RB,ALPHA,EPO1,
     2  EMAX,ICAL,IBB1,IGAU1,2)
C
        IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
C
C         INITIALISATIONS DES VARIABLES INTERNES
C          (DIRECTION 3) EN DEFORMATION PLANES
C
         EPST3 = -1.D0*EPST
         TANG3 =EX
         JFISU3=0
         IFISU3=0
         IPLA3 =0
         EPSEQ3=0.D0
         EQSTR3=0.D0
         EDC3  =0.D0
         EDT3  =0.D0
         EPSC3 =0.D0
         DEFR3 =0.D0
         RTM3  =FPT
         ETS3  =ETS2
C
         IF(SI0X(4).LT.0.D0.AND.SI0X(4).GE.(-1.D0*RB)) THEN
         CALL EPSEQU(EPEQ4,ABS(SI0X(4)),0,ICAL,1,EX,RB,EPO1,EPO1,EMAX)
         ST0X(4) = -1.D0*EPEQ4
         ELSE
         ST0X(4) = SI0X(4)/EX
         ENDIF
         CALL DECHIN(SI0X(4),ST0X(4),ETS3,EDC3,EPST3,IFISU3,JFISU3,
     1   RTM3,EPSC3,DEFR3,TANG3,IPLA3,EQSTR3,EPSEQ3,EX,RB,
     2   ALPHA,EPO1,EMAX,ICAL,IBB1,IGAU1,3)
C
        ENDIF
        SI0(3)=0.D0
      ENDIF
C------------------------------------------------------------------
C------------------------------------------------------------------
      IF(IPASN.EQ.1.AND.IBB1.EQ.IELM1) THEN
         WRITE(*,404) JFISU,IFISU1,IPLA1,RTM1,ETS1,EDC1,EDT1,DEFR1,
     &   EPST1,EPSC1,EQSTR1,EPSEQ1
         WRITE(*,405) JFISU2,IFISU2,IPLA2,RTM2,ETS2,EDC2,EDT2,DEFR2,
     &   EPST2,EPSC2,EQSTR2,EPSEQ2
         IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
            WRITE(*,406) JFISU3,IFISU3,IPLA3,RTM3,ETS3,EDC3,EDT3,DEFR3,
     &      EPST3,EPSC3,EQSTR3,EPSEQ3
         ENDIF
404      FORMAT('AVANT JFISU1=',I1,' IFISU1=',I1,' IPLA1=',I1,' RTM1=',
     *   E9.3,' ETS1=',E9.3,' EDC1=',E9.3,' EDT1=',E9.3,' DEFR1=',E9.3,
     *   ' EPST1=',E9.3,' EPSC1=',E9.3,' EQSTR1=',E9.3,' EPSEQ1=',E9.3)
405      FORMAT('AVANT JFISU2=',I1,' IFISU2=',I1,' IPLA2=',I1,' RTM2=',
     *   E9.3,' ETS2=',E9.3,' EDC2=',E9.3,' EDT2=',E9.3,' DEFR2=',E9.3,
     * ' EPST2=',E9.3,' EPSC2=',E9.3,' EQSTR2=',E9.3,' EPSEQ2=',E9.3)
406      FORMAT('AVANT JFISU3=',I1,' IFISU3=',I1,' IPLA3=',I1,' RTM3=',
     *   E9.3,' ETS3=',E9.3,' EDC3=',E9.3,' EDT3=',E9.3,' DEFR3=',E9.3,
     * ' EPST3=',E9.3,' EPSC3=',E9.3,' EQSTR3=',E9.3,' EPSEQ3=',E9.3)
         WRITE(*,*) '***   ST0 (APRES DECHINT2) / SI0  '
         IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
           WRITE(*,1991) (ST0(I),I=1,3),ST0X(4),(SI0(I),I=1,3),SI0X(4)
         ELSE
           WRITE(*,1991) (ST0(I),I=1,3),(SI0(I),I=1,3)
         ENDIF
      ENDIF
C------------------------------------------------------------------
C------------------------------------------------------------------
      DST(1)=DSI(1)/EX
      DST(2)=DSI(2)/EX
      DST(3)=DSI(3)*2.D0*(1.D0+PXY)/EX
C
      ST(1)=ST0(1)+DST(1)
      ST(2)=ST0(2)+DST(2)
      ST(3)=ST0(3)+DST(3)
C------------------------------------------------------------------
      PENT=ETS1
      SIGMRX=SI0(1)+DSI(1)
      CALL PLAEND(ST0(1),SI0(1),DST(1),SI(1),IFISU1,IPLA1,EQSTR1,
     1 EPSEQ1,JFISU,TANG1,EPST1,EPSC1,EDC1,EDT1,RTM1,DEFR1,SIGMRX,
     2 ETS1,EX,RB,ALPHA,EMAX,EPSU,EPO1,ICAL,IBB1,IGAU1,1)
C
      SIGMRX=SI0(2)+DSI(2)
      PENT=ETS2
      CALL PLAEND(ST0(2),SI0(2),DST(2),SI(2),IFISU2,IPLA2,EQSTR2,
     1 EPSEQ2,JFISU2,TANG2,EPST2,EPSC2,EDC2,EDT2,RTM2,DEFR2,SIGMRX,
     2 ETS2,EX,RB,ALPHA,EMAX,EPSU,EPO1,ICAL,IBB1,IGAU1,2)
C------------------------------------------------------------------
      IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
         SIGMRX=SI0X(4)+DSI0X(4)
         DST4  =DSI0X(4)/EX
         ST4   =ST0X(4)+DST4
         PENT  =ETS3
         CALL PLAEND(ST0X(4),SI0X(4),DST4,SI4,IFISU3,IPLA3,EQSTR3,
     1   EPSEQ3,JFISU3,TANG3,EPST3,EPSC3,EDC3,EDT3,RTM3,DEFR3,SIGMRX,
     2   ETS3,EX,RB,ALPHA,EMAX,EPSU,EPO1,ICAL,IBB1,IGAU1,3)
      ENDIF
C------------------------------------------------------------------
C------------------------------------------------------------------
      IF(IPASN.EQ.1.AND.IBB1.EQ.IELM1) THEN
          WRITE(*,*) '***   ST (APRES PLAEND2) /  SI '
          IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
            WRITE(*,1991) (ST(I),I=1,3),ST4,(SI(I),I=1,3),SI4
          ELSE
            WRITE(*,1991) (ST(I),I=1,3),(SI(I),I=1,3)
          ENDIF
C
          WRITE(*,401) JFISU,IFISU1,IPLA1,RTM1,ETS1,EDC1,EDT1,DEFR1,
     &    EPST1,EPSC1,EQSTR1,EPSEQ1
          WRITE(*,403) JFISU2,IFISU2,IPLA2,RTM2,ETS2,EDC2,EDT2,DEFR2,
     &    EPST2,EPSC2,EQSTR2,EPSEQ2
          IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
            WRITE(*,402) JFISU3,IFISU3,IPLA3,RTM3,ETS3,EDC3,EDT3,DEFR3,
     &      EPST3,EPSC3,EQSTR3,EPSEQ3
          ENDIF
401       FORMAT('APRES JFISU1=',I1,' IFISU1=',I1,' IPLA1=',I1,' RTM1=',
     *    E9.3,' ETS1=',E9.3,' EDC1=',E9.3,' EDT1=',E9.3,' DEFR1=',E9.3,
     *   ' EPST1=',E9.3,' EPSC1=',E9.3,' EQSTR1=',E9.3,' EPSEQ1=',E9.3)
403       FORMAT('APRES JFISU2=',I1,' IFISU2=',I1,' IPLA2=',I1,' RTM2=',
     *    E9.3,' ETS2=',E9.3,' EDC2=',E9.3,' EDT2=',E9.3,' DEFR2=',E9.3,
     *  ' EPST2=',E9.3,' EPSC2=',E9.3,' EQSTR2=',E9.3,' EPSEQ2=',E9.3,/)
402       FORMAT('APRES JFISU3=',I1,' IFISU3=',I1,' IPLA3=',I1,' RTM3=',
     *    E9.3,' ETS3=',E9.3,' EDC3=',E9.3,' EDT3=',E9.3,' DEFR3=',E9.3,
     *  ' EPST3=',E9.3,' EPSC3=',E9.3,' EQSTR3=',E9.3,' EPSEQ3=',E9.3,/)
      ENDIF
C------------------------------------------------------------------
C------------------------------------------------------------------
C       Calcul des ouvertures de fissure dir. 1 et dir. 2
C-----------------------------------------------------------------
      IF(IFISU1.EQ.1) THEN
        OUV1=ST(1)-DEFR1-EPSU
        IF(OUV1.LT.0.D0) OUV1=0.D0
      ENDIF
      IF(IFISU2.EQ.1) THEN
        OUV2=ST(2)-DEFR2-EPSU
        IF(OUV2.LT.0.D0) OUV2=0.D0
      ENDIF
C------------------------------------------------------------------
c++mdj
      ALRT1 = 2.D0 * EPSU
      ALRT2 = 4.D0 * EPSU
c++mdj
      IF(OUV1.GT.ALRT1.OR.OUV2.GT.ALRT1) FTC   =0.D0
c++mdj
C!!      IF(OUV1.GT.ALRT2.OR.OUV2.GT.ALRT2) SI0(3)=0.D0
c++mdj
*        IF(FTC.EQ.0.D0) WRITE(*,407) IBB1,IGAU1,OUV1,OUV2,ALRT1,ALRT2
*407     FORMAT('IB  =',I3,'IGAU =',I2,' OUV1=',E9.3,' OUV2=',E9.3,
*     &   ' ALRT1=',E9.3,' ALRT2=',E9.3)
C
      D33=EX/(1.D0+PXY)/2.D0
      SI(3)=SI0(3)+FTC*D33*DST(3)
C-------------------------------------------------------------------
      CALL DDRG(ST,PHI,STRNR)
      CALL CDRG(SI,PHI,S1)
      IF(NSTRS.EQ.4.AND.(IFOUR.EQ.-1.OR.IFOUR.EQ.0)) THEN
        STRNR(4)=STRNR(3)
        STRNR(3)=ST4
        S1(4)   =S1(3)
        S1(3)   =SI4
      ENDIF
C-------------------------------------------------------------------
C-------------------------------------------------------------------
1991  FORMAT(18(1X,E12.5))
1000  CONTINUE
C-------------------------------------------------------------------
      RETURN
      END