Esope source files

   1 : C PINOTO    SOURCE    CHAT      05/01/13    02:13:59     5004           
   2 : C PINOTO     SOURCE    INSL       24/10/96
   3 :       SUBROUTINE PINOTO(EPSR,STRN,STRNR,SIGR,SIGMR,SIGM,S1,V1,D,IPLA,
   4 :      1 JFRIS,NSTRS,IFOUR,EPEQC,SEQC,EBC,EPEQ0,SEQ0,SEQB1,XE,NBNN,MELE,
   5 :      2 EQSTR1,EPSEQ1,AA,BB,DK1,DK2,ILOI,ALPHA,RB,EX,PXY,EPO,ICAL,wrk12)
   6 : C
   7 :       IMPLICIT INTEGER(I-N)
   8 :       IMPLICIT REAL*8(A-H,O-Z)
   9 :       DIMENSION S1(NSTRS),D(NSTRS,NSTRS),S2(6),EPSR(6)
  10 :       DIMENSION STRN(NSTRS),SIGMR(6),SIGR(6),STRNR(6)
  11 :       DIMENSION V1(4),V3(4),SIGM(NSTRS),XE(3,NBNN)
  12 :       DIMENSION SI0(6),ST0(6),DST(6),DSI(6),D1(6,6)
  13 : C
  14 :       SEGMENT WRK12
  15 :       real*8  bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9
  16 :       real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17
  17 :       real*8 bbet18,bbet19,bbet20,sct,teta,DTR1,dtr2,bbet25
  18 :       real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33
  19 :       real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41
  20 :       real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49
  21 :       real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55
  22 :       integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8
  23 :       integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16
  24 :       ENDSEGMENT
  25 : *      COMMON /CINSA/ POUI(20),SCT,TETA,DTR1,DTR2,POUJ(31),IPOU(16)
  26 : C
  27 : C           ########################################################
  28 : C           *     TRACTION-COMPRESSION  OU  BI-TRACTION            *
  29 : C           *                                                      *
  30 : C           *       IPLA          = INDICE DE PLASTICITE           *
  31 : C           *                     =1 ECROUISSAGE                   *
  32 : C           *                     =2 SOFTENING                     *
  33 : C           *                     =3 RUPTURE (deformation > EMAX)  *
  34 : C           *                                                      *
  35 : C           *       JFRIS          = INDICE DE FISSURATION         *
  36 : C           *                     =0 PAS DE FISSURE                *
  37 : C           *                     =2 POINT FISSURE                 *
  38 : C           ########################################################
  39 : C----------------------------------------------------------------------
  40 :       SEQ00=SEQ0
  41 :       EPEQ00=EPEQ0
  41 :       CALL ZERO(S2,6,1)
  42 :       DO 11 I=1,NSTRS
  43 :         S1(I) =SIGMR(I)
  44 :         DSI(I)=SIGM(I)
  45 :         S2(I) =STRNR(I)
  46 :    11 CONTINUE
  47 :       IF(NSTRS.EQ.4.OR.NSTRS.EQ.6) THEN
  48 :         S2(3)=STRNR(4)
  49 :         S2(4)=STRNR(3)
  50 :       ENDIF
  51 :       S2(3)=S2(3)/2.D0
  51 :       CALL PRINC(S2,V3,NSTRS)
  52 :       S2(3)=S2(3)*2.D0
  53 : C----------------------------------------------------------------------
  54 :       IPLA =0
  55 :       TU=RB
  56 :       ITES=0
  57 :       IRUP=0
  57 :       CALL CRIOTO(SIGMR,SEQB1,FCRI,NSTRS,TU,AA,BB,DK1,DK2)
  58 : C----------------------------------------------------------------------
  59 :       IF(EPEQC.GE.EPO) THEN
  60 : C   --------------------------------------------------------------
  61 : C   *  ON TEST SI ON A DEPASSE LE PIC EN DEFORMATION EQUIVALENTE *
  62 : C   --------------------------------------------------------------
  63 :         IRUP=1
  64 :         ITES=1
  65 :         IPLA=2
  65 :         CALL SCALT(SIGM,SIGR,SI0,V1,SCT,NSTRS,DTAU,RB,AA,BB,DK1,DK2,
  66 :      &  ALPHA,RB,DTR1,DTR2,TETA)
  67 :         DO 10 I=1,NSTRS
  68 :           S1(I)=SI0(I)
  69 :   10    CONTINUE
  70 :         GOTO 300
  71 :       ENDIF
  72 : C==================================================================
  73 :       IF(ICAL.EQ.1) GOTO 200
  74 : C----------------------------------------------------------------------
  74 :       CALL CALPIN(IFOUR,STRN,SIGM,SIGR,S1,D,NSTRS,EBC,AA,BB,DK1,DK2,
  75 :      1 ILOI,RB,EX,PXY)
  75 :       CALL CRIOTO(S1,SEQB,FCRI,NSTRS,TU,AA,BB,DK1,DK2)
  76 :       IF(SEQB.LT.TU) GOTO 200
  77 : C----------------------------------------------------------------------
  78 :       DO  I=1,NSTRS
  79 :          DSI(I)=S1(I)-SIGR(I)
  80 :       END DO
  80 :       CALL SCALT(DSI,SIGR,SI0,V1,SCT,NSTRS,DTAU,RB,AA,BB,DK1,DK2,
  81 :      & ALPHA,RB,DTR1,DTR2,TETA)
  82 :       DO 21 I=1,NSTRS
  83 :          S1(I)=SI0(I)
  84 :   21  CONTINUE
  85 : C==================================================================
  86 :   300 CONTINUE
  87 : C              ***************************
  88 : C              * LE CRITERE EST VIOLE    *
  89 : C              ***************************
  90 : C
  91 :       IF(V1(1).GE.0.D0.OR.V1(2).GE.0.D0.OR.JFRIS.NE.0) THEN
  92 : C              *******************************************
  93 : C              * LE CRITERE EST VIOLE PAR FISSURATION    *
  94 : C              *******************************************
  95 :        TETA=V1(4)
  96 :        JFRIS=2
  97 :        IPLA=0
  97 :        CALL FISPLA(EPSR,STRN,STRNR,SIGR,DSI,S1,NSTRS,IFOUR,0,
  98 :      &  XE,NBNN,MELE,wrk12)
  99 :        GOTO 200
 100 :       ENDIF
 101 : C----------------------------------------------------------
 102 :       TETA=0.D0
 103 :       DTR1=0.D0
 104 :       DTR2=0.D0
 105 :       SCT =0.D0
 106 :       IF(IRUP.EQ.0) GOTO 200
 107 : C==================================================================
 108 : C              *******************************************
 109 : C              * LE CRITERE EST VIOLE EN BICOMPRESSION   *
 110 : C              *******************************************
 111 : C
 111 :       CALL CALPEC(IFOUR,STRN,SIGR,SIGM,S1,D,NSTRS,SEQC,EBC,EPEQC,
 112 :      1 EPSR,STRNR,JFRIS,IPLA,EPEQ00,SEQ00,XE,NBNN,MELE,EQSTR1,EPSEQ1,
 113 :      2 AA,BB,DK1,DK2,ILOI,RB,ALPHA,EX,PXY,EPO,wrk12)
 114 : C
 115 : C==================================================================
 116 :   200 CONTINUE
 117 : 1991  FORMAT(18(1X,E12.5))
 118 : C----------------------------------------------------------------------
 119 :       RETURN
 120 :       END
 121 : 
 122 : 
 123 : 
 124 : 
 125 : 
 126 :  
 127 :